cs2_utl.pas

Delphi script parser

    #75, #76, #77, #78, #79, #80, #81, #82, #83, #84, #85, #86, #87, #88, #89,
    #90, #123, #124, #125, #126, #127, #128, #129, #130, #131, #132, #133, #134,
    #135, #136, #137, #138, #139, #140, #141, #142, #143, #144, #145, #146,
    #147, #148, #149, #150, #151, #152, #153, #154, #155, #156, #157, #158,
    #159, #160, #161, #162, #163, #164, #165, #166, #167, #168, #169, #170,
    #171, #172, #173, #174, #175, #176, #177, #178, #179, #180, #181, #182,
    #183, #184, #185, #186, #187, #188, #189, #190, #191, #192, #193, #194,
    #195, #196, #197, #198, #199, #200, #201, #202, #203, #204, #205, #206,
    #207, #208, #209, #210, #211, #212, #213, #214, #215, #216, #217, #218,
    #219, #220, #221, #222, #223, #224, #225, #226, #227, #228, #229, #230,
    #231, #232, #233, #234, #235, #236, #237, #238, #239, #240, #241, #242,
    #243, #244, #245, #246, #247, #248, #249, #250, #251, #252, #253, #254,
    #255);

function FastUpperCase(const s: string): string;
{Fast uppercase}
var
  i: Integer;
begin
  FastUpperCase := s;
  for i := 1 to Length(s) do FastUpperCase[i] := chartab[s[i]]; {Fast uppercase}
end;

function CheckIdent(data: PCs2PascalParser): Boolean;
{Check if an identifier is a reserved word}
var
  s: string;
begin
  s := FastUppercase(GetToken(Data));
  if s = 'AND' then
    Data^.CurrTokenId := CSTII_and else ;

  if s = 'BEGIN' then
    Data^.CurrTokenId := CSTII_begin
  else

    if s = 'CASE' then
      Data^.CurrTokenId := CSTII_case
    else

      if s = 'CONST' then
        Data^.CurrTokenId := CSTII_const
      else

        if s = 'DIV' then
          Data^.CurrTokenId := CSTII_div
        else

          if s = 'DO' then
            Data^.CurrTokenId := CSTII_do
          else

            if s = 'DOWNTO' then
              Data^.CurrTokenId := CSTII_downto
            else

              if s = 'ELSE' then
                Data^.CurrTokenId := CSTII_else
              else

                if s = 'END' then
                  Data^.CurrTokenId := CSTII_end
                else

                  if s = 'FOR' then
                    Data^.CurrTokenId := CSTII_for
                  else

                    if s = 'FUNCTION' then
                      Data^.CurrTokenId := CSTII_function
                    else

                      if s = 'IF' then
                        Data^.CurrTokenId := CSTII_if
                      else

                        if s = 'IN' then
                          Data^.CurrTokenId := CSTII_in
                        else

                          if s = 'MOD' then
                            Data^.CurrTokenId := CSTII_mod
                          else

                            if s = 'NOT' then
                              Data^.CurrTokenId := CSTII_not
                            else

                              if s = 'OF' then
                                Data^.CurrTokenId := CSTII_of
                              else

                                if s = 'OR' then
                                  Data^.CurrTokenId := CSTII_or
                                else

                                  if s = 'PROCEDURE' then
                                    Data^.CurrTokenId := CSTII_procedure
                                  else

                                    if s = 'PROGRAM' then
                                      Data^.CurrTokenId := CSTII_program
                                    else

                                      if s = 'REPEAT' then
                                        Data^.CurrTokenId := CSTII_repeat
                                      else

                                        if s = 'SET' then
                                          Data^.CurrTokenId := CSTII_set
                                        else

                                          if s = 'SHL' then
                                            Data^.CurrTokenId := CSTII_shl
                                          else

                                            if s = 'SHR' then
                                              Data^.CurrTokenId := CSTII_shr
                                            else

                                              if s = 'THEN' then
                                                Data^.CurrTokenId := CSTII_then
                                              else

                                                if s = 'TO' then
                                                  Data^.CurrTokenId := CSTII_to
                                                else

                                                  if s = 'TYPE' then
                                                    Data^.CurrTokenId := CSTII_type else

                                                    if s = 'UNTIL' then
                                                      Data^.CurrTokenId := CSTII_until else

                                                      if s = 'USES' then
                                                        Data^.CurrTokenId := CSTII_uses else

                                                        if s = 'VAR' then
                                                          Data^.CurrTokenId := CSTII_var else

                                                          if s = 'WHILE' then
                                                            Data^.CurrTokenId := CSTII_while else

                                                            if s = 'WITH' then
                                                              Data^.CurrTokenId := CSTII_with else

                                                              if s = 'XOR' then
                                                                Data^.CurrTokenId := CSTII_xor else

                                                              begin
                                                                CheckIdent := False;
                                                                Exit;
                                                              end;
  CheckIdent := True;
end;

procedure ParseToken(data: PCs2PascalParser);
{Parse the token}
var
  ct, ci: LongInt;
  hs: Boolean;
begin

  ct := data^.CurrTokenPos;
  case data^.Text[ct] of
    #0:
      begin
        Data^.CurrTokenId := CSTI_EOF;
        Data^.CurrTokenLen := 0;
      end;
    'A'..'Z', 'a'..'z', '_':
      begin
        ci := ct + 1;
        while (data^.Text[ci] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']) do begin
          Inc(ci);
        end;
        Data^.CurrTokenLen := ci - ct;
        if not CheckIdent(data) then
        begin
          Data^.CurrTokenId := CSTI_Identifier;
        end;
      end;
    '$':
      begin
        ci := ct + 1;
        while (data^.Text[ci] in ['0'..'9', 'a'..'z', 'A'..'Z']) do begin
          Inc(ci);
        end;
        Data^.CurrTokenId := CSTI_HexInt;
        Data^.CurrTokenLen := ci - ct;
      end;

    '0'..'9':
      begin
        hs := False;
        ci := ct;
        while (data^.Text[ci] in ['0'..'9']) do begin
          Inc(ci);
          if (data^.Text[ci] = '.') and (not hs) then
          begin
            hs := True;
            Inc(ci);
          end;
        end;
        if hs then
          Data^.CurrTokenId := CSTI_Real
  else

    Data^.CurrTokenId := CSTI_Integer;
    Data^.CurrTokenLen := ci - ct;
  end;
  #39:
  begin
    ci := ct + 1;
    while (data^.Text[ci] <> #0) and (data^.Text[ci] <> #13) and
      (data^.Text[ci] <> #10) and (data^.Text[ci] <> #39)
      do begin
      Inc(ci);
    end;
    if data^.Text[ci] = #39 then
      Data^.CurrTokenId := CSTI_String
    else

      Data^.CurrTokenId := CSTI_StringError;
    Data^.CurrTokenLen := ci - ct + 1;
  end;
  '#':
  begin
    ci := ct + 1;
    if data^.Text[ci] = '$' then
    begin
      while (data^.Text[ci] in ['A'..'Z', 'a'..'z', '0'..'9']) do begin
        Inc(ci);
      end;
      Data^.CurrTokenId := CSTI_Char;
      Data^.CurrTokenLen := ci - ct - 1;
    end else
    begin
      while (data^.Text[ci] in ['0'..'9']) do begin
        Inc(ci);
      end;
      if data^.Text[ci] in ['A'..'Z', 'a'..'z', '_'] then
        Data^.CurrTokenId := CSTI_CharError
      else

        Data^.CurrTokenId := CSTI_Char;
      Data^.CurrTokenLen := ci - ct;
    end;
  end;
  '=':
  begin
    Data^.CurrTokenId := CSTI_Equal;
    Data^.CurrTokenLen := 1;
  end;
  '>':
  begin
    if data^.Text[ct + 1] = '=' then
    begin
      Data^.CurrTokenid := CSTI_GreaterEqual;
      Data^.CurrTokenLen := 2;
    end else
    begin
      Data^.CurrTokenid := CSTI_Greater;
      Data^.CurrTokenLen := 1;
    end;
  end;
  '<':
  begin
    if data^.Text[ct + 1] = '=' then
    begin
      Data^.CurrTokenId := CSTI_LessEqual;
      Data^.CurrTokenLen := 2;
    end else
      if data^.Text[ct + 1] = '>' then
      begin
        Data^.CurrTokenId := CSTI_NotEqual;
        Data^.CurrTokenLen := 2;
      end else
      begin
        Data^.CurrTokenId := CSTI_Less;
        Data^.CurrTokenLen := 1;
      end;
  end;
  ')':
  begin
    Data^.CurrTokenId := CSTI_CloseRound;
    Data^.CurrTokenLen := 1;
  end;
  '(':
  begin
    if Data^.Text[ct + 1] = '*' then
    begin
      ci := ct + 1;
      while (Data^.Text[ci] <> #0) do begin
        if (Data^.Text[ci] = '*') and (Data^.Text[ci + 1] = ')') then
          Break;
        Inc(ci);
      end;
      if (Data^.Text[ci] = #0) then
        Data^.CurrTokenId := CSTI_CommentEOFError
      else
      begin
        Data^.CurrTokenId := CSTI_Comment;
        Inc(ci);
      end;
      Data^.CurrTokenLen := ci - ct;
    end
    else
    begin
      Data^.CurrTokenId := CSTI_OpenRound;
      Data^.CurrTokenLen := 1;
    end;
  end;
  '[':
  begin
    Data^.CurrTokenId := CSTI_OpenBlock;
    Data^.CurrTokenLen := 1;
  end;
  ']':
  begin
    Data^.CurrTokenId := CSTI_CloseBlock;
    Data^.CurrTokenLen := 1;
  end;
  ',':
  begin
    Data^.CurrTokenId := CSTI_Comma;
    Data^.CurrTokenLen := 1;
  end;
  '.':
  begin
    Data^.CurrTokenId := CSTI_Period;
    Data^.CurrTokenLen := 1;
  end;
  ';':
  begin
    Data^.CurrTokenId := CSTI_Semicolon;
    Data^.CurrTokenLen := 1;
  end;
  ':':
  begin
    if Data^.Text[ct + 1] = '=' then
    begin
      Data^.CurrTokenId := CSTI_Assignment;
      Data^.CurrTokenLen := 2;
    end else
    begin
      Data^.CurrTokenId := CSTI_Colon;
      Data^.CurrTokenLen := 1;
    end;
  end;
  '+':
  begin
    Data^.CurrTokenId := CSTI_Plus;
    Data^.CurrTokenLen := 1;
  end;
  '-':
  begin
    Data^.CurrTokenId := CSTI_Minus;
    Data^.CurrTokenLen := 1;
  end;
  '*':
  begin
    Data^.CurrTokenId := CSTI_Multiply;
    Data^.CurrTokenLen := 1;
  end;
  '/':
  begin
    if data^.Text[ct + 1] = '/' then
    begin
      ci := ct + 1;
      while (Data^.Text[ci] <> #0) and (Data^.Text[ci] <> #13) and
        (Data^.Text[ci] <> #10) do begin
        Inc(ci);
      end;
      if (Data^.Text[ci] = #0) then
        Data^.CurrTokenId := CSTI_CommentEOFError
      else
      begin
        if Data^.Text[ci + 1] = #10 then
          Inc(ci) else

          if Data^.Text[ci + 1] = #13 then
            Inc(ci);
        Data^.CurrTokenId := CSTI_Comment;
      end;
      Data^.CurrTokenLen := ci - ct + 1;
    end else
    begin
      Data^.CurrTokenId := CSTI_Divide;
      Data^.CurrTokenLen := 1;
    end;
  end;
  #32, #9, #13, #10:
  begin
    ci := ct + 1;
    while (Data^.Text[ci] in [#32, #9, #13, #10]) do begin
      Inc(ci);
    end;
    Data^.CurrTokenId := CSTI_Whitespace;
    Data^.CurrTokenLen := ci - ct;
  end;
  '{':
  begin
    ci := ct + 1;
    while (Data^.Text[ci] <> #0) and (Data^.Text[ci] <> '}') do begin
      Inc(ci);
    end;
    if (Data^.Text[ci] = #0) then
      Data^.CurrTokenId := CSTI_CommentEOFError
    else
      Data^.CurrTokenId := CSTI_Comment;
    Data^.CurrTokenLen := ci - ct + 1;
  end;
  else
    Data^.CurrTokenId := CSTI_SyntaxError;
    Data^.CurrTokenLen := 1;
end;
end;

function GetToken(data: PCs2PascalParser): string;
{Return the token}
var
  i: LongInt;
  len: LongInt;
  s: string;
begin
  len := data^.CurrTokenLen;
{$IFDEF SS}
  len := len and $FF;
  s[0] := Chr(len);
{$ELSE}
  setlength(s, len);
{$ENDIF}
  for i := 1 to Len do begin
    s[i] := data^.Text[data^.CurrTokenPos + i - 1];
  end;
  GetToken := s;
end;

procedure NextNoJunk(data: PCs2PascalParser);
{Next no junk}
begin
  Data^.CurrTokenPos := Data^.CurrTokenPos + Data^.CurrTokenLen;
  ParseToken(data);
  while (Data^.CurrTokenId = CSTI_COMMENT) or (Data^.CurrTokenId =
    CSTI_WHITESPACE) do
  begin
    if (Data^.CurrTokenId = CSTI_EOF) or (Data^.CurrTokenId = CSTI_SyntaxError)
      or
      (Data^.CurrTokenId = CSTI_CommentEOFError) or (Data^.CurrTokenId =
      CSTI_CharError) or
      (Data^.CurrTokenId = CSTI_StringError)
      then
    begin
      Break;
    end;
    Data^.CurrTokenPos := Data^.CurrTokenPos + Data^.CurrTokenLen;
    ParseToken(data);
  end;
end;


end.