Topspeed_JPI/TS-V3/SRC/SCANNER.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  SCANNER.MOD - COMMS Toolkit script file scanner                         *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

(*# check(range=>off,overflow=>off,index=>off)*)
IMPLEMENTATION MODULE Scanner;
  IMPORT Lib,Str,IO,Window;
  FROM Window           IMPORT Color;

  CONST
    MaxResWords         = 70;
    TAB                 = 11C;
    ErrWin              = Window.WinDef(5,5,74,19,White,Red,TRUE,FALSE,FALSE,TRUE,Window.SingleFrame,White,Red);

  TYPE
    LineBuff            = ARRAY[0..255] OF CHAR;
    ResWordRec          = RECORD
                            WordId     : ARRAY[0..20] OF CHAR;
                            RSy        : Symbols;
                          END;

  VAR
    Ch                  : CHAR;
    FirstSymOnLine      : BOOLEAN;
    Stdwords,Lnth,Max   : CARDINAL;
    TokenPos,LineLength,
    LineIndex,LineNumber: CARDINAL;
    History             : ARRAY[0..3] OF LineBuff;
    CurrentLine         : LineBuff;
    Reswords            : ARRAY[0..MaxResWords-1] OF ResWordRec;

(*................................................*)

  PROCEDURE ShowTokenPos;
    VAR
      i                 : CARDINAL;
      Blank             : LineBuff;
    BEGIN
      FOR i:=0 TO 3 DO
        IO.WrStr(History[i]);
        IO.WrLn;
      END;
      IF TokenPos<=80 THEN
        CurrentLine[LineLength] := 0C;
        IO.WrStr(CurrentLine);
        IO.WrLn;
        IF TokenPos>0 THEN
          Lib.Fill(ADR(Blank),TokenPos,' ');
        END;
        Blank[TokenPos]:='^';
        Blank[TokenPos+1]:=0C;
        IO.WrStr(Blank);
        IO.WrLn;
      END;
    END ShowTokenPos;

(*................................................*)

  PROCEDURE WriteCard(c:CARDINAL);
    BEGIN
      IF c>9 THEN
        WriteCard(c DIV 10);
      END;
      IO.WrChar(CHR((c MOD 10)+48));
    END WriteCard;

(*................................................*)

  PROCEDURE Error(Errnum:CARDINAL);
    VAR
      Ch                : CHAR;
      Err               : Window.WinType;
      s                 : ARRAY[0..79] OF CHAR;
    BEGIN
      IF GotError THEN
        RETURN;
      END;
      Err := Window.Open(ErrWin);
      Window.GotoXY(1,2);
      ShowTokenPos;
      IO.WrLn;
      IO.WrStr('Error ');
      WriteCard(Errnum);
      IO.WrStr(': ');
      CASE Errnum OF
        1               : s:='String constant must not exceed source line';|
        2               : s:='Illegal char in text';                      |
        3               : s:='This Symbol not expected here';             |
        4               : s:='Value too large! (max 255)';                |
        5               : s:='String variable expected';                  |
        6               : s:='String or String variable expected';        |
        7               : s:='Value out of range';                        |
        8               : s:='Parameter Missing';                         |
        9               : s:='DIAL command not supported.';               |
        10              : s:='Unknown File Protocol';                     |
        11              : s:='Label already defined!';                    |
        12              : s:='Label or Statement expected';               |
        13              : s:='Label name expected';                       |
        14              : s:='Switch statement must have only one default!';|
        15              : s:='Could not open Script file.';               |
      ELSE
        s:='Unknown error (program bug)';
      END;
      IO.WrStr(s);
      IO.WrLn;
      IO.WrLn;
      IO.WrStr('Press any key...');
      Ch:=IO.RdKey();
      Window.Close(Err);
      GotError := TRUE;
    END Error;

(*................................................*)

  PROCEDURE StrCompare(VAR S1,S2:ARRAY OF CHAR):INTEGER;
    VAR
      i,Chrs,Lnth1,Lnth2,
      diff                : INTEGER;
      Ch1,Ch2             : CHAR;
    BEGIN
      Lnth1:=Str.Length(S1);
      Lnth2:=Str.Length(S2);
      IF Lnth1>8 THEN
        Lnth1:=8;
      END;
      IF Lnth2>8 THEN
        Lnth2:=8;
      END;
      diff := Lnth1-Lnth2;
      IF Lnth1<Lnth2 THEN
        Chrs:=Lnth1;
      ELSE
        Chrs:=Lnth2;
      END;
      i:=0;
      WHILE i<Chrs DO
        Ch1:=CAP(S1[i]);
        Ch2:=CAP(S2[i]);
        IF Ch1<>Ch2 THEN
          RETURN INTEGER(ORD(Ch1))-INTEGER(ORD(Ch2));
        END;
        INC(i);
      END;
      RETURN diff;
    END StrCompare;

(*.................................................*)

  PROCEDURE InitSymbolTable;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Symbol(Tipe:Symbols; Name:ARRAY OF CHAR);
      BEGIN
        WITH Reswords[Stdwords] DO
          Lib.Move(ADR(Name),ADR(WordId),Str.Length(Name)+1);
          RSy:=Tipe;
        END;
        INC(Stdwords);
      END Symbol;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* InitSymbolTable *)
      Stdwords := 0;
      (* NOTE: because I was too lazy to include a sort procedure to be  *)
      (* used once only, the words in this reserved word table have been *)
      (* manually entered in alphabetical order. Be careful when adding  *)
      (* new words!                                                      *)
      Symbol(AlarmSy,'ALARM');
      Symbol(FTAscii,'ASCII');
      Symbol(AssignSy,'ASSIGN');
      Symbol(BreakSy,'BREAK');
      Symbol(FTBYmodem,'BYMODEM');
      Symbol(CaseSy,'CASE');
      Symbol(ChDirSy,'CHDIR');
      Symbol(ClearSy,'CLEAR');
      Symbol(CloseSy,'CLOSE');
      Symbol(ConnectSy,'CONNECTED');
      Symbol(CWhenSy,'CWHEN');
      Symbol(DefaultSy,'DEFAULT');
      Symbol(DialSy,'DIAL');
      Symbol(DosSy,'DOS');
      Symbol(ElseSy,'ELSE');
      Symbol(EmulateSy,'EMULATE');
      Symbol(EndCaseSy,'ENDCASE');
      Symbol(EndifSy,'ENDIF');
      Symbol(EndSwitchSy,'ENDSWITCH');
      Symbol(ExecuteSy,'EXECUTE');
      Symbol(ExitSy,'EXIT');
      Symbol(FailureSy,'FAILURE');
      Symbol(FindSy,'FIND');
      Symbol(FoundSy,'FOUND');
      Symbol(GetSy,'GET');
      Symbol(GetFileSy,'GETFILE');
      Symbol(GosubSy,'GOSUB');
      Symbol(GotoSy,'GOTO');
      Symbol(HangupSy,'HANGUP');
      Symbol(HostSy,'HOST');
      Symbol(IfSy,'IF');
      Symbol(IsFileSy,'ISFILE');
      Symbol(FTKermit,'KERMIT');
      Symbol(KermServSy,'KERMSERV');
      Symbol(KFlushSy,'KFLUSH');
      Symbol(LinkedSy,'LINKED');
      Symbol(LocateSy,'LOCATE');
      Symbol(LogSy,'LOG');
      Symbol(MacroSy,'MACRO');
      Symbol(MessageSy,'MESSAGE');
      Symbol(MGetSy,'MGET');
      Symbol(MLoadSy,'MLOAD');
      Symbol(NotSy,'NOT');
      Symbol(OffSy,'OFF');
      Symbol(OnSy,'ON');
      Symbol(OpenSy,'OPEN');
      Symbol(PauseSy,'PAUSE');
      Symbol(PrinterSy,'PRINTER');
      Symbol(QuitSy,'QUIT');
      Symbol(ResumeSy,'RESUME');
      Symbol(ReturnSy,'RETURN');
      Symbol(RFlushSy,'RFLUSH');
      Symbol(RGetSy,'RGET');
      Symbol(RunSy,'RUN');
      Symbol(SendFileSy,'SENDFILE');
      Symbol(SetSy,'SET');
      Symbol(SnapshotSy,'SNAPSHOT');
      Symbol(SuccessSy,'SUCCESS');
      Symbol(SuspendSy,'SUSPEND');
      Symbol(SwitchSy,'SWITCH');
      Symbol(TraceSy,'TRACE');
      Symbol(TransmitSy,'TRANSMIT');
      Symbol(WaitSy,'WAIT');
      Symbol(WaitForSy,'WAITFOR');
      Symbol(WhenSy,'WHEN');
      Symbol(FTWXmodem,'WXMODEM');
      Symbol(FTXmodem,'XMODEM');
      Symbol(FTYmodem,'YMODEM');
    END InitSymbolTable;

(*.................................................*)

  PROCEDURE InitScanner;
    VAR
      i                 : CARDINAL;
    BEGIN
      FOR i:=0 TO 3 DO
        History[i,0] := 0C;
      END;
      CurrentLine[0] := 0C;
      Stdwords := 0;
      InitSymbolTable;
      LineLength := 0;
      LineNumber := 0;
      LineIndex := 0FFFFH;
      FirstSymOnLine := TRUE;
      GotError := FALSE;
    END InitScanner;

(*................................................*)

  PROCEDURE GetChar(VAR Ch:CHAR);
    VAR
      i                 : CARDINAL;
    BEGIN
      IF LineIndex>LineLength THEN
        IF FIO.EOF THEN
          Ch:=0C;
          LineIndex:=0FFFFH;
          LineLength:=0;
          RETURN
        END;
        FOR i:=0 TO 2 DO
          History[i] := History[i+1];
        END;
        History[3] := CurrentLine;
        History[3,LineLength] := 0C;
        FIO.RdStr(infile,CurrentLine);
        IF FIO.EOF THEN
          Ch := 0C;
          RETURN;
        END; (*IF*)
        INC(LineNumber);
        LineLength := Str.Length(CurrentLine);
        CurrentLine[LineLength] := CHR(13);
        LineIndex := Lib.ScanNeR(ADR(CurrentLine),LineLength,' ');
        FirstSymOnLine := TRUE;
      END;
      Ch := CurrentLine[LineIndex];
      INC(LineIndex);
    END GetChar;

(*................................................*)

  PROCEDURE PushBack;
    BEGIN
      IF LineIndex>0 THEN
        DEC(LineIndex);
      END;
    END PushBack;

(*................................................*)

  PROCEDURE GetSym;
    VAR
      GotSym            : BOOLEAN;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE AddChar(VAR S:ARRAY OF CHAR; Ch:CHAR);
      BEGIN
        IF Lnth<Max THEN
          S[Lnth]:=Ch;
          INC(Lnth);
          S[Lnth]:=0C;
        END;
      END AddChar;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE CopyString;
      VAR
        QuoteChar       : CHAR;
      BEGIN
        QuoteChar:=Ch;
        Lnth:=0;
        Max:=255;
        Sy:=StringConst;
        REPEAT
          GetChar(Ch);
          IF (Ch=0C) OR (Ch=CHR(13)) THEN
            Error(1);
          END;
          IF Ch<>QuoteChar THEN
            AddChar(LastStringConst,Ch);
          END;
        UNTIL Ch=QuoteChar;
      END CopyString;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Number;
      BEGIN
        LastNumConst:='';
        Lnth:=0;
        Max:=MaxSymLnth;
        Sy:=IntConst;
        REPEAT
          AddChar(LastNumConst,Ch);
          GetChar(Ch);
        UNTIL (Ch<'0') OR (Ch>'9');
        PushBack;
      END Number;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Identifier;

(*.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .*)

      PROCEDURE CheckResWords;
        VAR
          Result,K,L,R  : INTEGER;
        BEGIN
          L:=0;
          R:=Stdwords-1;
          REPEAT
            K := (L+R) DIV 2;
            Result := StrCompare(Id,Reswords[K].WordId);
            IF Result<=0 THEN
              R:=K-1;
            END;
            IF Result>=0 THEN
              L:=K+1;
            END;
          UNTIL R<L;
          IF L-R>1 THEN
            Sy := Reswords[K].RSy;
          END;
        END CheckResWords;

(*.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .*)

      BEGIN (* Identifier *)
        Sy:=Ident;
        Lnth:=0;
        Max:=MaxSymLnth;
        LOOP
          CASE Ch OF
            '_',
            'a'..'z',
            '0'..'9',
            'A'..'Z'    : AddChar(Id,CAP(Ch));
                          GetChar(Ch)            |
          ELSE
            EXIT;
          END;
        END;
        PushBack;
        CheckResWords;
      END Identifier;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE Comment;
      BEGIN
        (* Throw away remainder of line *)
        LineIndex := LineLength+1;
      END Comment;

(*. . . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* GetSym *)
      REPEAT
        Sy:=Other;
        GotSym:=TRUE;
        REPEAT
          GetChar(Ch);
        UNTIL (Ch=0C) OR ((Ch>' ') AND (Ch<=CHR(126)));
        TokenPos := LineIndex-1;
        CASE Ch OF
          0C            : Sy:=EndOfFile;         |
          '"'           : CopyString;            |
          '0'..'9'      : Number;                |
          'A'..'Z',
          'a'..'z'      : Identifier;            |
          ';'           : Comment;
                          GotSym := FALSE;       |
          ','           : Sy := Comma;
                          GotSym := FALSE;       |
          ':'           : Sy := Colon;           |
        ELSE
          Error(2)
        END; (* cases *)
        FirstSymOnLine := FALSE;
      UNTIL GotSym;
    END GetSym;

(*................................................*)

END Scanner.