cs2.pas

Delphi script parser

        if Parser^.CurrTokenId = CSTI_SyntaxError then
        begin RunError(ESyntaxError); Exit; end;
        if Parser^.CurrTokenId = CSTI_CommentEOFError then
        begin RunError(ESyntaxError); Exit; end;
        if Parser^.CurrTokenId = CSTI_CharError then
        begin RunError(ESyntaxError); Exit; end;
        if Parser^.CurrTokenId = CSTI_StringError then
        begin RunError(EStringError); Exit; end;
        if Parser^.CurrTokenId = CSTI_SemiColon then
          Break;
        if Parser^.CurrTokenId = CSTII_Begin then
        begin
          if not RunBegin(Vars, True) then
            Exit;
        end;
        if Parser^.CurrTokenId = CSTII_Else then
        begin
          Dec(IPos);
          if Ipos <= 0 then
            Break;
        end;
        if Parser^.CurrTokenId = CSTII_If then
          Inc(IPos);
        if Parser^.CurrTokenId = CSTII_End then
          Break;
        NextNoJunk(Parser);
      end; {While}
    end; {If}
    RunBegin := True;
    Exit;
  end; {If}
  if Parser^.CurrTokenId = CSTII_Begin then
  begin
    StopOnSemicolon := False;
    NextNoJunk(Parser); {skip begin}
  end else
    StopOnSemicolon := True;
  while True do begin
    case Parser^.CurrTokenId of
      CSTI_EOF: begin RunError(EUnexpectedEndOfFile); Exit; end;
      CSTI_SyntaxError: begin RunError(ESyntaxError); Exit; end;
      CSTI_CommentEOFError: begin RunError(ESyntaxError); Exit; end;
      CSTI_CharError: begin RunError(ESyntaxError); Exit; end;
      CSTI_StringError: begin RunError(EStringError); Exit; end;
      CSTII_Else: begin
          if StopOnSemicolon then
          begin
            RunBegin := True;
            Exit;
          end;
          RunError(EErrorInStatement);
          Exit;
        end;
      CSTII_End:
        begin
          RunBegin := True;
          NextNoJunk(Parser);
          Exit;
        end; {CSTII_End}
      CSTI_Semicolon:
        begin
          if StopOnSemicolon then
          begin
            RunBegin := True;
            Exit;
          end;
          NextNojunk(Parser);
        end; {CSTI_SemiColon}
      CSTII_If:
        begin
          if Assigned(OnRunLine) then
          begin
            RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
              Parser^.CurrTokenPos));
            if ErrorCode <> ENoError then
              Exit;
          end;
          NextNoJunk(Parser);
          c := CreateCajVariant(CSV_Bool, 0);
          if not Calc(vars, c, CSTII_Then) then
          begin
            DestroyCajVariant(c);
            Exit;
          end; {if}
          if Parser^.CurrTokenId <> CSTII_then
            then
          begin
            RunError(EThenExpected);
            DestroyCajVariant(c);
            Exit;
          end;
          NextNoJunk(Parser); {skip THEN}
          if c^.Cv_Bool then
          begin
            DestroyCajVariant(c);
            if not RunBegin(Vars, False) then
            begin
              Exit;
            end; {if}
            if Parser^.CurrTokenId = CSTII_Else then
            begin
              if Assigned(OnRunLine) then
              begin
                RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                  Parser^.CurrTokenPos));
                if ErrorCode <> ENoError then
                  Exit;
              end;
              NextnoJunk(Parser);
              if not RunBegin(Vars, True) then
              begin
                Exit;
              end; {if}
            end; {if}
          end {if}
          else
          begin
            DestroyCajVariant(c);
            if not RunBegin(Vars, True) then
            begin
              Exit;
            end; {if}
            if Parser^.CurrTokenId = CSTII_Else then
            begin
              NextnoJunk(Parser);
              if Assigned(OnRunLine) then
              begin
                RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                  Parser^.CurrTokenPos));
                if ErrorCode <> ENoError then
                  Exit;
              end;
              if not RunBegin(Vars, False) then
              begin
                Exit;
              end; {if}
            end; {if}
          end; {if}
        end; {CSTII_If}
      CSTII_While:
        begin
          NextNoJunk(Parser);
          C := CreateCajVariant(CSV_Bool, 0);
          Ipos := Parser^.CurrTokenPos;
          if not Calc(Vars, c, CSTII_Do) then
          begin
            DestroyCajVariant(c);
            Exit;
          end; {if}
          if Parser^.CurrTokenID <> CSTII_Do then
          begin
            RunError(EDoExpected);
            DestroyCajVariant(c);
            Exit;
          end; {if}
          NextNoJunk(Parser);
          IStart := Parser^.CurrTokenPos;
          while C^.Cv_Bool do begin
            if Assigned(OnRunLine) then
            begin
              RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                Parser^.CurrTokenPos));
              if ErrorCode <> ENoError then
                Exit;
            end;
            if not RunBegin(Vars, False) then
            begin
              DestroyCajVariant(c);
              Exit;
            end;
            Parser^.CurrTokenPos := IPos;
            ParseToken(Parser);
            if not Calc(Vars, c, CSTII_Do) then
            begin
              DestroyCajVariant(c);
              Exit;
            end; {if}
            Parser^.CurrTokenPos := IStart;
            ParseToken(Parser);
          end; {While}
          DestroyCajVariant(c);
          if not RunBegin(Vars, True) then
            Exit;
        end; {CSTII_While}
      CSTII_For:
        begin
          NextNoJunk(Parser);
          if Parser^.CurrTokenId <> CSTI_Identifier then
          begin
            RunError(EIdentifierExpected);
            Exit;
          end; {if}
          if Assigned(Vars) and (VM_Find(Vars, FastUppercase(GetToken(Parser)))
            <> -1) then
            C := GetVarLink(VM_Get(Vars, VM_Find(Vars,
              FastUppercase(GetToken(Parser)))))
          else if VM_Find(Variables, FastUppercase(GetToken(Parser))) <> -1 then
            c := GetVarLink(VM_Get(Variables, VM_Find(Variables,
              FastUppercase(GetToken(Parser)))))
          else
          begin
            RunError(EUnknownIdentifier);
            Exit;
          end; {if}
          if (c^.Flags and $1) <> 0 then
          begin
            RunError(EVariableExpected);
            Exit;
          end; {if}
          if not IsIntegerType(c) then
          begin
            RunError(ETypeMismatch);
          end; {if}
          NextNoJunk(Parser);
          if Parser^.CurrTokenId <> CSTI_Assignment then
          begin
            RunError(EAssignmentExpected);
            Exit;
          end; {if}
          NextNoJunk(Parser);
          if not Calc(Vars, c, CSTII_To) then
            Exit;
          IStart := GetInt(c);
          if (Parser^.CurrTokenId <> CSTII_To) and
            (Parser^.CurrTokenId = CSTII_DownTo) then
          begin
            RunError(EToExpected);
            Exit;
          end; {if}
          B := Parser^.CurrTokenId = CSTII_DownTo;
          NextNoJunk(Parser);
          if not Calc(Vars, c, CSTII_Do) then
            Exit;
          IEnd := GetInt(c);
          if Parser^.CurrTokenId <> CSTII_Do then
          begin
            RunError(EDoExpected);
            Exit;
          end; {if}
          NextNoJunk(Parser);
          IPos := Parser^.CurrTokenPos;
          if B then
          begin
            c^.Flags := c^.Flags or $1;
            for II := IStart downto IEnd do begin
              if Assigned(OnRunLine) then
              begin
                RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                  Parser^.CurrTokenPos));
                if ErrorCode <> ENoError then
                  Exit;
              end;
              SetInteger(C, II);
              if not RunBegin(Vars, False) then
              begin
                c^.Flags := c^.Flags and not $1;
                Exit;
              end;
              Parser^.CurrTokenPos := IPos;
              ParseToken(Parser);
            end;
            c^.Flags := c^.Flags and not $1;
            if not RunBegin(Vars, True) then
              Exit;
          end {if}
          else
          begin
            c^.Flags := c^.Flags or $1;
            for II := IStart to IEnd do begin
              if Assigned(OnRunLine) then
              begin
                RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                  Parser^.CurrTokenPos));
                if ErrorCode <> ENoError then
                  Exit;
              end;
              SetInteger(C, II);
              if not RunBegin(Vars, False) then
              begin
                c^.Flags := c^.Flags and not $1;
                Exit;
              end;
              Parser^.CurrTokenPos := IPos;
              ParseToken(Parser);
            end;
            c^.Flags := c^.Flags and not $1;
            if not RunBegin(Vars, True) then
              Exit;
          end {if}
        end;
      CSTII_Repeat:
        begin
          RunError(EErrorInStatement);
          Exit;
        end; {CSTII_Repeat}
      CSTII_Begin:
        begin
          if not RunBegin(Vars, False) then
            Exit;
        end; {CSTII_Begin}
      CSTII_Case:
        begin
          NextNoJunk(Parser);
          c := CreateCajVariant(CSV_Var, 0);
          c^.CV_Var := nil; {Say that calc can assign any type}
          if not Calc(vars, c, CSTII_Of) then
          begin
            DestroyCajVariant(c);
            Exit;
          end; {If}
          if Parser^.CurrTokenId <> CSTII_OF then
          begin
            RunError(EOfExpected);
            exit;
          end; {If}
          NextNoJunk(Parser);
          B := False;
          while Parser^.CurrTokenId <> CSTII_End do begin
            if Parser^.CurrTokenId = CSTII_Else then
            begin
              NextNoJunk(Parser);
              DestroyCajVariant(c);
              if not RunBegin(Vars, B) then
                Exit;
              if Parser^.CurrTokenId = CSTI_SemiColon then
              begin
                NextNoJunk(Parser);
              end;
              if Parser^.CurrTokenId <> CSTII_End then
              begin
                RunError(EEndExpected);
                Exit;
              end;
              Exit;
            end;
            if Assigned(OnRunLine) then
            begin
              RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
                Parser^.CurrTokenPos));
              if ErrorCode <> ENoError then
                Exit;
            end;
            c2 := CreateCajVariant(C^.VType, 0);
            if not Calc(vars, c2, CSTI_Colon) then
            begin
              DestroyCajVariant(c);
              DestroyCajVariant(c2);
              Exit;
            end; {If}
            if Parser^.CurrTokenId <> CSTI_Colon then
            begin
              RunError(EColonExpected);
              DestroyCajVariant(c);
              DestroyCajVariant(c2);
              Exit;
            end; {If}
            NextNoJunk(Parser);
            if not Perform(c2, c, ptEqual) then
            begin
              RunError(ETypeMismatch);
              DestroyCajVariant(c);
              DestroyCajVariant(c2);
              Exit;
            end; {If}
            if not RunBegin(Vars, (not c2^.CV_Bool or B)) then
            begin
              DestroyCajVariant(c);
              DestroyCajVariant(c2);
              Exit;
            end;
            if c2^.CV_Bool then
              B := True;
            if Parser^.CurrTokenid = CSTI_SemiColon then
            begin
              NextNoJunk(Parser);
            end;
            DestroyCajVariant(c2);
          end; {While}
          DestroyCajVariant(c);
          NextNoJunk(Parser); {Skip end}
        end; {CSTII_Case}
      CSTI_Identifier:
        begin
          if Assigned(OnRunLine) then
          begin
            RunError(OnRunLine(fId, {$IFNDEF CLASS}@{$ENDIF}Self,
              Parser^.CurrTokenPos));
            if ErrorCode <> ENoError then
              Exit;
          end;
          if PM_Find(InternalProcedures, FastUppercase(GetToken(Parser))) <> -1
            then
          begin
            DestroyCajVariant(DoProc(Vars, True));
            if ErrorCode <> ENoError then
              Exit;
          end {if}
          else if Assigned(vars) and (Vm_Find(Vars,
            FastUppercase(GetToken(Parser))) <> -1) then
          begin
            c := GetVarLink(VM_Get(Vars, Vm_Find(Vars,
              FastUppercase(GetToken(Parser)))));
            if (1 and c^.Flags) <> 0 then
            begin
              RunError(EErrorInStatement);
              Exit;
            end; {else if}
            if not CalcArrayInt(Vars, c) then
              Exit;
            NextNoJunk(Parser);
            if Parser^.CurrTokenId <> CSTI_Assignment then
            begin
              RunError(EAssignmentExpected);
              Exit;
            end; {if}
            NextNoJunk(Parser);
            if not Calc(vars, c, CSTI_Semicolon) then
              Exit;
          end {if}
          else if Vm_Find(Variables, FastUppercase(GetToken(Parser))) <> -1 then
          begin
            c := GetVarLink(VM_Get(Variables,
              Vm_Find(Variables, FastUppercase(GetToken(Parser)))));
            if (1 and c^.Flags) <> 0 then
            begin
              RunError(EErrorInStatement);
              Exit;
            end; {else if}
            if not CalcArrayInt(Vars, c) then
              Exit;
            NextNoJunk(Parser);
            if Parser^.CurrTokenId <> CSTI_Assignment then
            begin
              RunError(EAssignmentExpected);
              Exit;