Topspeed_JPI/TS/SRC/SCRIPTCO.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  SCRIPTCO.MOD - COMMS Toolkit Script compiler                            *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE ScriptCompiler; (* Compile a Procomm type Script *)
  IMPORT CommUtil,FIO,IO,Lib,Scanner,Storage,Str;
  FROM Scanner          IMPORT Symbols;

  CONST
    MaxStringLnth       = 80;
    MaxLabels           = 20;

  TYPE
    SymSet              = SET OF Scanner.Symbols;
    LabelDef            = RECORD
                            Label      : Scanner.Alpha;
                            Defined    : BOOLEAN;
                            Addr       : CARDINAL;
                          END;

  VAR
    StatBegSyms         : SymSet;
    LblCnt              : CARDINAL;
    Labels              : ARRAY[0..MaxLabels-1] OF LabelDef;

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

  PROCEDURE FindLabel(VAR Lbl:Scanner.Alpha; PC:CARDINAL):CARDINAL;
    VAR
      Found             : BOOLEAN;
      i,a               : CARDINAL;
    BEGIN
      i:=0;
      Found:=FALSE;
      WHILE (NOT Found) AND (i<LblCnt) DO
        IF Scanner.StrCompare(Lbl,Labels[i].Label)=0 THEN
          Found:=TRUE;
        ELSE
          INC(i);
        END;
      END;
      WITH Labels[i] DO
        IF Found THEN
          IF Defined THEN
            RETURN Addr;
          ELSE
            a := Addr;
            Addr := PC;
            RETURN a;
          END
        ELSE
          Label := Lbl;
          Defined:=FALSE;
          Addr:=PC;
          INC(LblCnt);
          RETURN 0FFFFH;
        END;
      END;
    END FindLabel;

(************************************************)

  PROCEDURE Statement(TermSyms:SymSet);

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

    PROCEDURE Value(VAR s:ARRAY OF CHAR):CARDINAL;
      VAR
        i,x             : CARDINAL;
        c               : CHAR;
      BEGIN
        x := 0;
        FOR i:=0 TO HIGH(s) DO
          c := s[i];
          IF c=0C THEN
            RETURN x
          ELSIF (c>='0') AND (c<='9') THEN
            x := x*10+ORD(c)-48;
          END;
        END;
        RETURN x;
      END Value;

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

    PROCEDURE Gen(op:SHORTCARD);
      BEGIN
        CodeBuff^[PC] := op;
        INC(PC);
      END Gen;

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

    PROCEDURE GenW(op:CARDINAL);
      BEGIN
        Gen(SHORTCARD(op MOD 100H));
        Gen(SHORTCARD(op DIV 100H));
      END GenW;

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

    PROCEDURE PatchW(Addr,op:CARDINAL);
      VAR
        Temp            : CARDINAL;
      BEGIN
        Temp:=PC;
        PC:=Addr;
        GenW(op);
        PC:=Temp;
      END PatchW;

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

    PROCEDURE GenS(VAR op:ARRAY OF CHAR);
      VAR
        Lnth            : CARDINAL;
      BEGIN
        Lnth := Str.Length(op)+1;
        Gen(255);
        Lib.Move(ADR(op),ADR(CodeBuff^[PC]),Lnth);
        INC(PC,Lnth);
      END GenS;

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

    PROCEDURE StringVar(VAR StringNo:SHORTCARD):BOOLEAN;
      VAR
        c               : CHAR;
      BEGIN
        IF (Scanner.Sy=Ident) AND (Str.Length(Scanner.Id)=2) AND (CAP(Scanner.Id[0])='S') THEN
          c := Scanner.Id[1];
          IF (c>='0') AND (c<='9') THEN
            StringNo:=SHORTCARD(ORD(c)-48);
            RETURN TRUE
          END;
        END;
        RETURN FALSE;
      END StringVar;

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

    PROCEDURE String;
      VAR
        Sno             : SHORTCARD;
      BEGIN
        IF StringVar(Sno) THEN
          Gen(Sno)
        ELSIF Scanner.Sy=StringConst THEN
          GenS(Scanner.LastStringConst)
        ELSE
          Scanner.Error(6);
        END;
        Scanner.GetSym;
      END String;

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

    PROCEDURE DefineLabel(VAR Lbl:Scanner.Alpha; PC:CARDINAL);
      VAR
        Found           : BOOLEAN;
        i,nextp,p       : CARDINAL;
      BEGIN
        i:=0;
        Found:=FALSE;
        WHILE (NOT Found) AND (i<LblCnt) DO
          IF Scanner.StrCompare(Lbl,Labels[i].Label)=0 THEN
            Found:=TRUE;
          ELSE
            INC(i);
          END;
        END;
        WITH Labels[i] DO
          IF Found THEN
            IF Defined THEN
              Scanner.Error(11);
            ELSE
              (* Chain through patch list, fixing addresses *)
              nextp := Addr;
              WHILE nextp<>0FFFFH DO
                p:=nextp;
                nextp := CARDINAL(CodeBuff^[p])+CARDINAL(CodeBuff^[p+1])*100H;
                PatchW(p,PC);
              END;
            END
          ELSE
            Label:=Lbl;
            INC(LblCnt);
          END;
          Defined:=TRUE;
          Addr:=PC;
        END;
      END DefineLabel;

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

    PROCEDURE Label;
      BEGIN
        IF Scanner.Sy=Colon THEN
          DefineLabel(Scanner.Id,PC);
          Scanner.GetSym;
        ELSE
          Scanner.Error(12);
        END;
      END Label;

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

    PROCEDURE SimpleCommand(Op,Default:SHORTCARD);
      VAR
        x               : CARDINAL;
      BEGIN
        Gen(Op);
        IF Scanner.Sy=IntConst THEN
          x := Value(Scanner.LastNumConst);
          IF x<=255 THEN
            Gen(SHORTCARD(x));
          ELSE
            Scanner.Error(4);
          END;
          Scanner.GetSym;
        ELSE
          Gen(Default); (* default to three second alarm *)
        END;
      END SimpleCommand;

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

    PROCEDURE Assign;
      VAR
        SNo             : SHORTCARD;
      BEGIN
        IF StringVar(SNo) THEN
          Gen(1);
          Gen(SNo);
          Scanner.GetSym;
          String;
        ELSE
          Scanner.Error(5);
        END;
      END Assign;

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

    PROCEDURE Clear;
      VAR
        Bg,Fg           : CARDINAL;
      BEGIN
        IF Scanner.Sy=IntConst THEN
          Bg := Value(Scanner.LastNumConst);
          IF Bg<=7 THEN
            Scanner.GetSym;
            IF Scanner.Sy=IntConst THEN
              Fg:=Value(Scanner.LastNumConst);
              IF Fg<=15 THEN
                Gen(7);
                Gen(SHORTCARD(Bg*16+Fg));
              ELSE
                Scanner.Error(7);
              END;
            ELSE
              Scanner.Error(8);
            END;
          ELSE
            Scanner.Error(7);
          END;
          Scanner.GetSym;
        ELSE
          Gen(6);
        END;
      END Clear;

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

    PROCEDURE Locate;
      VAR
        y,x             : CARDINAL;
      BEGIN
        IF Scanner.Sy=IntConst THEN
          y := Value(Scanner.LastNumConst);
          IF y<=23 THEN
            Scanner.GetSym;
            IF Scanner.Sy=IntConst THEN
              x:=Value(Scanner.LastNumConst);
              IF x<=79 THEN
                Gen(35);
                Gen(SHORTCARD(y));
                Gen(SHORTCARD(x));
              ELSE
                Scanner.Error(7);
              END;
            ELSE
              Scanner.Error(8);
            END;
          ELSE
            Scanner.Error(7);
          END;
          Scanner.GetSym;
        ELSE
          Scanner.Error(8);
        END;
      END Locate;

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

    PROCEDURE DosOrRun(op:SHORTCARD);
      VAR
        SNo             : SHORTCARD;
      BEGIN
        Gen(op);
        IF NOT StringVar(SNo) THEN
          SNo:=255;
        END;
        Scanner.GetSym;
        IF Scanner.Sy=WaitSy THEN
          Gen(1);
        ELSE
          Gen(0);
        END;
        IF SNo=255 THEN
          GenS(Scanner.LastStringConst);
        ELSE
          Gen(SNo);
        END;
        IF Scanner.Sy=WaitSy THEN
          Scanner.GetSym;
        END;
      END DosOrRun;

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

    PROCEDURE WaitFor;
      VAR
        SNo             : SHORTCARD;
        x               : CARDINAL;
      BEGIN
        Gen(11);
        IF NOT StringVar(SNo) THEN
          SNo:=255;
        END;
        Scanner.GetSym;
        IF Scanner.Sy=IntConst THEN
          x := Value(Scanner.LastNumConst);
          IF x<=255 THEN
            Gen(SHORTCARD(x));
          ELSE
            Scanner.Error(4);
          END;
        ELSE
          Gen(30);
        END;
        IF SNo=255 THEN
          GenS(Scanner.LastStringConst);
        ELSE
          Gen(SNo);
        END;
        IF Scanner.Sy=IntConst THEN
          Scanner.GetSym;
        END;
      END WaitFor;

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

    PROCEDURE If;
      VAR
        ElseAllowed     : BOOLEAN;
        JumpOp          : SHORTCARD;
        StartPC,JumpPC  : CARDINAL;
      BEGIN
        StartPC := PC;
        IF Scanner.Sy=NotSy THEN
          JumpOp:=18;
          Scanner.GetSym;
        ELSE
          JumpOp:=19;
        END;
        CASE Scanner.Sy OF
          LinkedSy      : Gen(12);     |
          SuccessSy     : Gen(13);     |
          FailureSy     : Gen(14);     |
          FoundSy       : Gen(15);     |
          ConnectSy     : Gen(16);     |
          WaitForSy     : Gen(17);     |
        ELSE
          Scanner.Error(3);
        END;
        Scanner.GetSym;
        ElseAllowed := (Scanner.Sy<>ElseSy);
        IF Scanner.Sy=ElseSy THEN (* Empty if, but we have an else clause *)
          IF JumpOp=18 THEN
            JumpOp:=19;
          ELSE
            JumpOp:=18;
          END;
          Scanner.GetSym;
        END;
        IF Scanner.Sy=EndifSy THEN
          PC := StartPC; (* completely empty if statement - optimise out *)
        ELSE
          Gen(JumpOp);
          JumpPC:=PC;
          GenW(0);
          Statement(SymSet{ElseSy,EndifSy});
          IF Scanner.GotError THEN
            RETURN;
          END;
          IF (ElseAllowed) AND (Scanner.Sy=ElseSy) THEN
            Scanner.GetSym;
            IF Scanner.Sy<>EndifSy THEN
              PatchW(JumpPC,PC+3);
              Gen(3);
              JumpPC:=PC;
              GenW(0);
              Statement(SymSet{ElseSy,EndifSy});
              IF Scanner.GotError THEN
                RETURN;
              END;
              PatchW(JumpPC,PC);
            END
          ELSE
            PatchW(JumpPC,PC);
          END;
        END;
        IF Scanner.Sy=EndifSy THEN
          Scanner.GetSym;
        ELSE
          Scanner.Error(3);
        END;
      END If;

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

    PROCEDURE Emulate;
      BEGIN
        Gen(22);
        IF Scanner.Sy=Ident THEN
          GenS(Scanner.Id);
          Scanner.GetSym;
        ELSE
          String;
        END;
      END Emulate;

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

    PROCEDURE Find;
      VAR
        sno             : SHORTCARD;
      BEGIN
        Gen(24);
        IF StringVar(sno) THEN
          Gen(sno);
          Scanner.GetSym;
          String;
        ELSE
          Scanner.Error(5);
        END;
      END Find;

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

    PROCEDURE Get(op:SHORTCARD);
      VAR
        sno             : SHORTCARD;
        x               : CARDINAL;
      BEGIN
        Gen(op);
        IF StringVar(sno) THEN
          Gen(sno);
          Scanner.GetSym;
          IF Scanner.Sy=IntConst THEN
            x := Value(Scanner.LastNumConst);
            IF x<256 THEN
              Gen(SHORTCARD(x));
            ELSE
              Scanner.Error(4);
            END;
            Scanner.GetSym;
          ELSE
            Gen(80);
          END;
        ELSE
          Scanner.Error(5);
        END;
      END Get;

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

    PROCEDURE RGet;
      VAR
        x               : CARDINAL;
      BEGIN
        Get(47);
        IF Scanner.Sy=IntConst THEN
          x:=Value(Scanner.LastNumConst);
          Scanner.GetSym;
          IF x<256 THEN
            Gen(SHORTCARD(x));
          ELSE
            Scanner.Error(4);
          END;
        ELSE
          Gen(30);
        END;
      END RGet;

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

    PROCEDURE FileTransfer(op:SHORTCARD; FileRequired:BOOLEAN);
      VAR
        sno             : SHORTCARD;
        Dummy           : ARRAY[0..1] OF CHAR;
      BEGIN
        Gen(op);
        IF (Scanner.Sy>=FTAscii) AND (Scanner.Sy<=FTBYmodem) THEN
          Gen(SHORTCARD(ORD(Scanner.Sy)-ORD(FTAscii)));
          Scanner.GetSym;
          IF StringVar(sno) OR (Scanner.Sy=StringConst) THEN
            String
          ELSIF FileRequired THEN
            Scanner.Error(6);
          ELSE
            Dummy[0]:=0C;
            GenS(Dummy);
(****          Scanner.GetSym;  shouldn't advance here	****)
          END;
        ELSE
          Scanner.Error(10);
        END;
      END FileTransfer;

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

    PROCEDURE ReferenceLabel(op:SHORTCARD);
      BEGIN
        Gen(op);
        IF Scanner.Sy=Ident THEN
          GenW(FindLabel(Scanner.Id,PC));
          Scanner.GetSym;
        ELSE
          Scanner.Error(13);
        END;
      END ReferenceLabel;

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

    PROCEDURE Log;
      VAR
        sno             : SHORTCARD;
        Dummy           : ARRAY[0..1] OF CHAR;
      BEGIN
        Dummy[0] := 0C;
        CASE Scanner.Sy OF
          OpenSy          : Gen(36);
                            Scanner.GetSym;
                            IF StringVar(sno) OR (Scanner.Sy=StringConst) THEN
                              String
                            ELSE
                              GenS(Dummy);
                            END;                                            |
          CloseSy         : Gen(37);
                            Scanner.GetSym;                                 |
          SuspendSy       : Gen(38);
                            Scanner.GetSym;                                 |
          ResumeSy        : Gen(39);
                            Scanner.GetSym;                                 |
        ELSE
          Scanner.Error(3);
        END;
      END Log;

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

    PROCEDURE Macro;
      VAR
        x               : CARDINAL;
      BEGIN
        IF Scanner.Sy=IntConst THEN
          Gen(40);
          x:=Value(Scanner.LastNumConst);
          IF x<10 THEN
            Gen(SHORTCARD(x));
          ELSE
            Scanner.Error(7);
          END;
          Scanner.GetSym;
        ELSE
          Gen(41);
          String;
        END;
      END Macro;

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

    PROCEDURE OnOff(opOn,opOff:SHORTCARD);
      BEGIN
        IF Scanner.Sy=OnSy THEN
          Gen(opOn);
        ELSIF Scanner.Sy=OffSy THEN
          Gen(opOff);
        ELSE
          Scanner.Error(3);
        END;
        Scanner.GetSym;
      END OnOff;

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

    PROCEDURE Switch;
      VAR
        sno             : SHORTCARD;
        GotDefault      : BOOLEAN;

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

      PROCEDURE CaseSelection;
        VAR
          PatchLoc      : CARDINAL;
        BEGIN
          IF (NOT GotDefault) AND (Scanner.Sy=CaseSy) THEN
            Scanner.GetSym;
            Gen(52);
            Gen(sno);
            String;
            IF NOT Scanner.GotError THEN
              Gen(19);
              PatchLoc:=PC;
              GenW(0);
              Statement(SymSet{EndCaseSy});
              IF Scanner.Sy=EndCaseSy THEN
                Scanner.GetSym;
              ELSE
                Scanner.Error(3);
              END;
              PatchW(PatchLoc,PC+3);
              Gen(3);
              PatchLoc:=PC;
              GenW(0);
              CaseSelection;
              PatchW(PatchLoc,PC);
            END
          ELSIF Scanner.Sy=DefaultSy THEN
            IF GotDefault THEN
              Scanner.Error(14);
              RETURN;
            END;
            GotDefault := TRUE;
            Scanner.GetSym;
            Statement(SymSet{EndCaseSy});
            IF Scanner.Sy=EndCaseSy THEN
              Scanner.GetSym;
            ELSE
              Scanner.Error(3);
            END;
          END;
        END CaseSelection;

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

      BEGIN (* Switch *)
        GotDefault := FALSE;
        IF StringVar(sno) THEN
          Scanner.GetSym;
          CaseSelection;
          IF Scanner.Sy=EndSwitchSy THEN
            Scanner.GetSym;
          ELSE
            Scanner.Error(3);
          END;
        ELSE
          Scanner.Error(5);
        END;
      END Switch;

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

    VAR
      Sym               : Scanner.Symbols;
    BEGIN (* Statement *)
      WHILE (NOT Scanner.GotError) AND (Scanner.Sy IN StatBegSyms) DO
        Sym:=Scanner.Sy;
        Scanner.GetSym;
        CASE Sym OF
          Ident         : Label;                                          |
          AlarmSy       : SimpleCommand(0,3);                             |
          AssignSy      : Assign;                                         |
          BreakSy       : SimpleCommand(4,1);                             |
          ChDirSy       : Gen(5);
                          String;                                         |
          ClearSy       : Clear;                                          |
          CWhenSy       : Gen(54);                                        |
          DialSy        : Scanner.Error(9);                               |
          DosSy         : DosOrRun(8);                                    |
          EmulateSy     : Emulate;                                        |
          ExecuteSy     : Gen(23);
                          String;                                         |
          ExitSy        : Gen(20);                                        |
          FindSy        : Find;                                           |
          GetSy         : Get(25);                                        |
          MGetSy        : Get(26);                                        |
          GetFileSy     : FileTransfer(27,FALSE);                         |
          GosubSy       : ReferenceLabel(29);                             |
          GotoSy        : ReferenceLabel(30);                             |
          HangupSy      : Gen(31);                                        |
          IfSy          : If;                                             |
          IsFileSy      : Gen(33);
                          String;                                         |
          KermServSy    :                                                 |
          KFlushSy      : Gen(34);                                        |
          LocateSy      : Locate;                                         |
          LogSy         : Log;                                            |
          MacroSy       : Macro;                                          |
          MessageSy     : Gen(9);
                          String;                                         |
          MLoadSy       : Gen(42);
                          String;                                         |
          PauseSy       : SimpleCommand(21,1);                            |
          PrinterSy     : OnOff(43,44);                                   |
          QuitSy        : Gen(45);                                        |
          ReturnSy      : Gen(32);                                        |
          RFlushSy      : Gen(46);                                        |
          RGetSy        : RGet;                                           |
          RunSy         : DosOrRun(48);                                   |
          SendFileSy    : FileTransfer(28,TRUE);                          |
          SetSy         :                                                 |
          SnapshotSy    : Gen(49);                                        |
          SwitchSy      : Switch;                                         |
          TraceSy       : OnOff(50,51);                                   |
          TransmitSy    : Gen(10);
                          String;                                         |
          WaitForSy     : WaitFor;                                        |
          WhenSy        : Gen(53);
                          String;
                          String;                                         |
        END;
      END;
      IF NOT (Scanner.Sy IN TermSyms) THEN
        Scanner.Error(3);
      END;
    END Statement;

(************************************************)

  PROCEDURE Initialise;
    BEGIN
      PC := 0;
      Scanner.InitScanner;
      Scanner.GetSym;
      LblCnt := 0;
      StatBegSyms := SymSet{Ident,AlarmSy,AssignSy,BreakSy,ChDirSy,ClearSy,CWhenSy,DialSy,
                            DosSy,EmulateSy,ExecuteSy,ExitSy,FindSy,GetSy,MGetSy,GetFileSy,
                            GosubSy,GotoSy,HangupSy,IfSy,IsFileSy,KermServSy,KFlushSy,LocateSy,
                            LogSy,MacroSy,MessageSy,MLoadSy,PauseSy,PrinterSy,QuitSy,ReturnSy,
                            RFlushSy,RGetSy,RunSy,SendFileSy,SetSy,SnapshotSy,SwitchSy,TraceSy,
                            TransmitSy,WaitForSy,WhenSy};
    END Initialise;

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

  PROCEDURE CheckLabels;
    VAR
      i                 : CARDINAL;
    BEGIN
      i:=0;
      WHILE i<LblCnt DO
        WITH Labels[i] DO
          IF NOT Defined THEN
            IO.WrStr('Label "');
            IO.WrStr(Label);
            IO.WrStr('" is not defined');
            IO.WrLn;
            Scanner.GotError := TRUE;
          END;
          INC(i);
        END;
      END;
    END CheckLabels;

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

  PROCEDURE Compile(VAR Filename:ARRAY OF CHAR):BOOLEAN;
    BEGIN
      FIO.IOcheck := FALSE;
      Scanner.infile := FIO.Open(Filename);
      IF FIO.IOresult()=0 THEN
        FIO.EOF := FALSE;
        IF CodeBuff=NIL THEN
          IF NOT Storage.Available(MaxCodeBytes) THEN
            FIO.Close(Scanner.infile);
            CommUtil.ErrorMessage('Not enough memory to compile script!!');
            RETURN(FALSE)
          END;
          Storage.ALLOCATE(CodeBuff,MaxCodeBytes);
        END;
        Initialise;
        IF Scanner.Sy<>EndOfFile THEN
          Statement(SymSet{EndOfFile})
        ELSE
          Scanner.Error(3);
        END;
        CodeBuff^[PC]:=20;
        INC(PC); (* insert an EXIT command *)
        FIO.Close(Scanner.infile);
        IF NOT Scanner.GotError THEN
          CheckLabels;
        END;
        IF Scanner.GotError THEN
          Storage.DEALLOCATE(CodeBuff,MaxCodeBytes);
          CodeBuff := NIL;
        END;
        RETURN (NOT Scanner.GotError);
      ELSE
        CommUtil.ErrorMessage('Script File not found!');
        RETURN FALSE;
      END;
    END Compile;

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

  BEGIN
    CodeBuff := NIL;
  END ScriptCompiler.