home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s3.arc / PROCESSS.MOD < prev    next >
Text File  |  1988-02-23  |  60KB  |  1,441 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Process_Script --- Convert PibTerm script file to in-core code.    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Process_Script( Script_FName  : AnyStr;
  6.                           Script_ComLet : CHAR     );
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Procedure:  Process_Script                                       *)
  11. (*                                                                      *)
  12. (*     Purpose:    Convert PibTerm script file to in-core instructions. *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*         Process_Script( Script_FName  : AnyStr;                      *)
  17. (*                         Script_ComLet : CHAR     );                  *)
  18. (*                                                                      *)
  19. (*            Script_FName  --- Script name                             *)
  20. (*            Script_ComLet --- Script command to execute               *)
  21. (*                                                                      *)
  22. (*                                                                      *)
  23. (*      Remarks:                                                        *)
  24. (*                                                                      *)
  25. (*         The entire script file is read and converted to an in-core   *)
  26. (*         representation which can be executed.                        *)
  27. (*                                                                      *)
  28. (*----------------------------------------------------------------------*)
  29.  
  30. CONST
  31.    Max_Script_Labels = 20          (* Maximum # of labels allowed *);
  32.    Max_Script_Stack  = 128         (* Maximum script stack depth  *);
  33.    MaxStack          = 64          (* Maximum expression stack    *);
  34.    Max_Script_Procs  = 64          (* Maximum procedures here     *);
  35.  
  36.    IntegerMissing    = 0           (* No integer at all           *);
  37.    IntegerVariable   = 1           (* Convenient synonym          *);
  38.    IntegerConstant   = 2           (* "" ""                       *);
  39.    IntegerConsOnly   = 3           (* "" ""                       *);
  40.  
  41.    False_Offset      = 9           (* Offset for FALSE in IFs     *);
  42.  
  43. CONST
  44.    LongZero : LONGINT = 0          (* Long integer constant zero  *);
  45.  
  46. TYPE
  47.                                    (* Argument types for internal procedures *)
  48.  
  49.    Proc_Arg_Type_Vector = ARRAY[1..MaxScriptArgs] OF OperandType;
  50.    Proc_Arg_Type_Ptr    = ^Proc_Arg_Type_Vector;
  51.  
  52.                                    (* Records procedure reference *)
  53.    Script_Proc_Type = RECORD
  54.                          Name       : ShortStr  (* Name                   *);
  55.                          Buffer_Pos : INTEGER   (* Offset in code         *);
  56.                          NArgs      : INTEGER   (* # of arguments         *);
  57.                          Type_Ptr   : Proc_Arg_Type_Ptr (* Argument types *);
  58.                       END;
  59.  
  60.                                    (* Records procedure nesting information *)
  61.    Script_Proc_Stack_Type = RECORD
  62.                                Old_VCount : INTEGER   (* Var count before proc  *);
  63.                                Old_PCount : INTEGER   (* Proc count before proc *);
  64.                                GOTO_Pos   : INTEGER   (* Where GOTO is located  *);
  65.                             END;
  66.  
  67.    Script_Var_Record   = RECORD
  68.                             Var_Name   : STRING[10]    (* Name *);
  69.                             Var_Type   : OperandType   (* Type *);
  70.                          END;
  71.  
  72. VAR
  73.                                    (* Script procedure definition vector *)
  74.  
  75.    Script_Procs           : ARRAY[1..Max_Script_Procs] OF Script_Proc_Type;
  76.  
  77.                                    (* Number of procedures currently defined *)
  78.  
  79.    Script_Proc_Count      : INTEGER;
  80.  
  81.                                    (* Where current procedure starts *)
  82.  
  83.    Script_Proc_Start      : INTEGER;
  84.  
  85.                                    (* Current stack levels, conditional     *)
  86.                                    (* script commands.                      *)
  87.  
  88.    Script_Repeat_Level    : INTEGER;
  89.    Script_If_Level        : INTEGER;
  90.    Script_While_Level     : INTEGER;
  91.    Script_Case_Level      : INTEGER;
  92.    Script_For_Level       : INTEGER;
  93.    Script_Proc_Level      : INTEGER;
  94.  
  95.                                    (* Stacks for conditional commands       *)
  96.  
  97.    Script_Repeat_Stack    : ARRAY[1..Max_Script_Stack] OF INTEGER;
  98.    Script_If_Stack        : ARRAY[1..Max_Script_Stack] OF INTEGER;
  99.    Script_ElseIf_Stack    : ARRAY[1..Max_Script_Stack] OF INTEGER;
  100.    Script_While_Stack     : ARRAY[1..Max_Script_Stack] OF INTEGER;
  101.    Script_Case_Var_Stack  : ARRAY[1..Max_Script_Stack] OF INTEGER;
  102.    Script_Case_Cnt_Stack  : ARRAY[1..Max_Script_Stack] OF INTEGER;
  103.    Script_For_Stack       : ARRAY[1..Max_Script_Stack] OF INTEGER;
  104.    Script_Proc_Stack      : ARRAY[1..Max_Script_Stack] OF Script_Proc_Stack_Type;
  105.  
  106.    L                      : INTEGER;
  107.    I                      : INTEGER;
  108.    K                      : INTEGER;
  109.    IS                     : INTEGER;
  110.    Local_Save             : Saved_Screen_Ptr;
  111.    Ch                     : CHAR;
  112.    Text_Line              : AnyStr;
  113.    Spill_File             : FILE;
  114.    OK_Script_Command      : BOOLEAN;
  115.    Script_Command_Token   : AnyStr;
  116.    Script_Line            : AnyStr;
  117.    Saved_Script_Line      : AnyStr;
  118.    Length_Script_Line     : INTEGER;
  119.    Script_Line_Number     : INTEGER;
  120.    Current_Script_Command : PibTerm_Command_Type;
  121.    NextP                  : LONGINT;
  122.    NextP_Bytes            : ARRAY[1..4] OF BYTE ABSOLUTE NextP;
  123.  
  124.    Script_Debug_File      : TEXT;
  125.    Script_Debug_Mode      : BOOLEAN;
  126.  
  127.    Use_Script_Library     : BOOLEAN;
  128.    Script_Short_Name      : AnyStr;
  129.    Script_File_Name_Given : BOOLEAN;
  130.    Script_EOF             : BOOLEAN;
  131.    Script_Buffer_Hold     : Script_Buffer_Ptr;
  132.    Script_Memory_Avail    : LONGINT;
  133.    Got_Script             : BOOLEAN;
  134.    Script_File_OK         : BOOLEAN;
  135.    Save_BPos              : INTEGER;
  136.    ICode                  : INTEGER;
  137.    LCode                  : INTEGER;
  138.    Result_Index           : LONGINT;
  139.    Save_Script_File_Mode  : BOOLEAN;
  140.  
  141.                                    (* Script variables *)
  142.  
  143.    Script_Vars              : ARRAY[0..MaxScriptVariables] OF Script_Var_Record;
  144.    Script_Variable_Kount    : INTEGER;
  145.    Script_Variable_MaxKount : INTEGER;
  146.  
  147.                                    (* Indices of script arguments *)
  148.  
  149.    Arg_Index                : ARRAY[1..MaxScriptArgs] OF INTEGER;
  150.  
  151.    Import_Count             : INTEGER (* Number of variables imported *);
  152.  
  153. (* STRUCTURED *) CONST
  154.  
  155.    OperNames    : ARRAY[0..MaxOperNames1] OF String12 =
  156.                   ('**NOOP**', '+','-','*','/','=','<','<=','>','>=','<>',
  157.                    'AND','NOT','OR','XOR',
  158.                    'SUBSTR','INDEX','LENGTH','CONCAT','CONNECTED','WAITFOUND',
  159.                    'STRING','NUMBER','ATTENDED','FILEEXISTS','EOF','IORESULT',
  160.                    'DUPL'  , 'UPPERCASE', 'TRIM', 'PARAMCOUNT', 'PARAMSTR',
  161.                    'PARAMLINE','DIALED','LTRIM', 'DATE', 'TIME', 'DIALENTRY',
  162.                    'ORD', 'CHR', 'READCTRL', 'WRITECTRL', 'ENHKEYBD',
  163.                    'KEYSTRING');
  164.  
  165.    OperNames2   : ARRAY[OperType] OF String12 =
  166.                   ('**NOOP**', '+','-','*','/','=','<','<=','>','>=','<>',
  167.                    '=','<','<=','>','>=','<>',
  168.                    'AND','NOT','OR','XOR',
  169.                    'SUBSTR','INDEX','LENGTH','CONCAT','CONNECTED','WAITFOUND',
  170.                    'STRING','NUMBER','ATTENDED','FILEEXISTS','EOF','IORESULT',
  171.                    'DUPL'  , 'UPPERCASE', 'TRIM', 'PARAMCOUNT', 'PARAMSTR',
  172.                    'PARAMLINE', 'DIALED', 'LTRIM','DATE','TIME','DIALENTRY',
  173.                    'ORD', 'CHR', 'READCTRL', 'WRITECTRL', 'ENHKEYBD',
  174.                    'KEYSTRING' );
  175.  
  176.    OperPrecs    : ARRAY[OperType] OF BYTE
  177.                 = ( 0, 4, 4, 5, 5, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
  178.                     3, 6, 3, 3, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
  179.                     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7 );
  180.  
  181.    OperSyms     : ARRAY[0..MaxOperNames1] OF OperType
  182.                 = ( NoOpSy, AddSy, SubtractSy, MultSy, DivideSy,
  183.                     EqualISy, LessISy, LessEqualISy, GreaterISy, GreaterEqualISy,
  184.                     NotEqualISy,
  185.                     AndSy, NotSy, OrSy, XorSy,
  186.                     SubStrSy, IndexSy, LengthSy, ConcatSy, ConnectedSy,
  187.                     WaitFoundSy, StringSy, NumberSy, AttendedSy,
  188.                     FileExistsSy, EofSy, IOResultSy, DuplSy, UpperCaseSy,
  189.                     TrimSy, ParamCountSy, ParamStrSy, ParamLineSy, DialedSy,
  190.                     LTrimSy, DateSy, TimeSy, DialEntrySy,
  191.                     OrdSy, ChrSy, ReadCtrlSy, WriteCtrlSy, EnhKeybdSy,
  192.                     KeyStringSy );
  193.  
  194.    Number_Args : ARRAY[OperType] OF BYTE =
  195.                  ( 0,
  196.                    2, 2, 2, 2,
  197.                    2, 2, 2, 2, 2, 2,
  198.                    2, 2, 2, 2, 2, 2,
  199.                    2, 1, 2, 2,
  200.                    3, 2, 1, 2, 0, 0,
  201.                    1, 1, 0, 1, 1, 0, 2,
  202.                    1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 2, 1, 1, 1, 0, 1 );
  203.  
  204.                                    (* Valid command names for scripts *)
  205.  
  206.    Script_File_Command_Names : ARRAY[1..Max_Script_File_Commands] OF STRING[8]
  207.                              = ( 'ADDCOMMA',
  208.                                  'ADDLF',     'ALARM',    'BREAK',     'CALL',
  209.                                  'CAPTURE',   'CASE',     'CHDIR',     'CLEAR',
  210.                                  'CLOSE',     'CLREOL',   'COMDRAIN',
  211.                                  'COMFLUSH',  'COPYFILE',
  212.                                  'DECLARE',   'DELAY',    'DELLINE',   'DIAL',
  213.                                  'DIRFIRST',  'DIRNEXT',  'DOCASE',    'DOS',
  214.                                  'ECHO',      'EDITFILE', 'ELSE',      'ELSEIF',
  215.                                  'ENDCASE',   'ENDDOCAS', 'ENDFOR',    'ENDIF',
  216.                                  'ENDPROC',   'ENDWHILE', 'ERASEFIL',  'EXECUTE',
  217.                                  'EXIT',      'EXITALL',  'FILE',      'FOR',
  218.                                  'FREESPAC',  'GETDIR',   'GETPARAM',  'GETVAR',
  219.                                  'GOTOXY',    'HANGUP',   'HOST',      'IF',
  220.                                  'IMPORT',    'INPUT',    'INSLINE',   'KEY',
  221.                                  'KEYDEF',    'KEYFLUSH', 'KEYSEND',   'LABEL',
  222.                                  'LOG',       'MENU',     'MESSAGE',   'MUTE',
  223.                                  'OPEN',      'PARAM',    'PRINTFIL',  'PROCEDUR',
  224.                                  'QUIT',      'READ',     'READLN',    'RECEIVE',
  225.                                  'REDIAL',    'REPEAT',   'RESET',     'RETURN',
  226.                                  'RINPUT',    'SCRIPT',   'SCREENDU',  'SEND' ,
  227.                                  'SET',       'SETPARAM', 'SETVAR',    'STEXT',
  228.                                  'SUSPEND',   'TEXT',     'TRANSLAT',  'UNTIL',
  229.                                  'VIEWFILE',  'WAIT',     'WAITCOUNT', 'WAITLIST',
  230.                                  'WAITQUIET', 'WAITSTRI', 'WAITTIME',  'WHEN',
  231.                                  'WHENDROP',  'WHENLIST', 'WHEREXY',   'WHILE',
  232.                                  'WRITE',     'WRITELN',  'WRITELOG'
  233.                                 );
  234.  
  235.                                    (* Corresponding command types *)
  236.  
  237.    Script_File_Commands      : ARRAY[1..Max_Script_File_Commands] OF
  238.                                PibTerm_Command_Type =
  239.       ( AddCommandSy,
  240.         AddLFSy,     AlarmSy,      BreakSy,      CallSy,
  241.         CaptureSy,   CaseSy,       ChDirSy,      ClearSy,
  242.         CloseSy,     ClrEolSy,     CommDrainSy,
  243.         CommFlushSy, CopyFileSy,
  244.         DeclareSy,   DelaySy,      DelLineSy,    DialSy,
  245.         DirFirstSy,  DirNextSy,    DoCaseSy,     DosSy,
  246.         EchoSy,      EditFileSy,   ElseSy,       ElseIfSy,
  247.         EndCaseSy,   EndDoCaseSy,  EndForSy,     EndIfSy,
  248.         EndProcSy,   EndWhileSy,   EraseFileSy,  ExecuteSy,
  249.         ExitSy,      ExitAllSy,    FileSy,       ForSy,
  250.         FreeSpaceSy, GetDirSy,     GetParamSy,   GetVarSy,
  251.         GoToXYSy,    HangUpSy,     HostSy,       IfOpSy,
  252.         ImportSy,    InputSy,      InsLineSy,    KeySy,
  253.         KeyDefSy,    KeyFlushSy,   KeySendSy,    LabelSy,
  254.         LogSy,       MenuSy,       MessageSy,    MuteSy,
  255.         OpenSy,      ParamSy,      PrintFileSy,  ProcedureSy,
  256.         QuitAllSy,   ReadSy,       ReadLnSy,     ReceiveSy,
  257.         RedialSy,    RepeatSy,     ResetSy,      ReturnSy,
  258.         RInputSy,    ScriptSy,     SDumpSy,      SendSy,
  259.         SetSy,       SetParamSy,   SetVarSy,     STextSy,
  260.         SuspendSy,   TextSy,       TranslateSy,  UntilSy,
  261.         ViewFileSy,  WaitSy,       WaitCountSy,  WaitListSy,
  262.         WaitQuietSy, WaitStrSy,    WaitTimeSy,   WhenSy,
  263.         WhenDropSy,  WhenListSy,   WhereXYSy,    WhileSy,
  264.         WriteSy,     WriteLnSy,    WriteLogSy
  265.       );
  266.  
  267. (* STRUCTURED *) CONST
  268.    S1         : STRING[36] = 'Expected integer variable but found ';
  269.    S2         : STRING[48] = 'Expected integer variable or constant but found ';
  270.    S3         : STRING[ 9] = ' instead.';
  271.    S4         : STRING[ 9] = 'Variable ';
  272.    S5         : STRING[14] = ' not declared.';
  273.    S6         : STRING[24] = ' should be integer type.';
  274.    S7         : STRING[23] = ' should be string type.';
  275.    S8         : STRING[16] = 'Result variable ';
  276.    S9         : STRING[12] = ' is missing.';
  277.    S10        : STRING[ 8] = 'Missing ';
  278.    S11        : STRING[18] = 'Bad variable name.';
  279.    S12        : STRING[ 9] = 'Bad type.';
  280.    S13        : STRING[15] = ' is wrong type.';
  281.    S14        : STRING[23] = 'Bad boolean expression.';
  282.    S15        : STRING[11] = 'Unattached ';
  283.    S16        : STRING[35] = 'Expected string variable but found ';
  284.    S17        : STRING[47] = 'Expected string variable or constant but found ';
  285.    S18        : STRING[28] = 'Expected variable but found ';
  286.    S19        : STRING[16] = 'Bad script name.';
  287.    S20        : STRING[13] = 'Bad argument.';
  288.    S21        : STRING[10] = 'Procedure ';
  289.    S22        : STRING[40] = ' must precede all PROCEDURE definitions.';
  290.    S23        : STRING[38] = 'IMPORT cannot appear inside procedure.';
  291.    S24        : STRING[35] = 'Wrong number of arguments in CALL.';
  292.    S25        : STRING[18] = 'Bad initial value.';
  293.  
  294.    Blank_Set              : SET OF CHAR = [' ', ','];
  295.    Letters_Set            : SET OF CHAR = ['A'..'Z', 'a'..'z'];
  296.  
  297. (*----------------------------------------------------------------------*)
  298. (*             Parse_Error --- Report error in parsing expression       *)
  299. (*----------------------------------------------------------------------*)
  300.  
  301. PROCEDURE Parse_Error( Error_Mess : AnyStr );
  302.  
  303. BEGIN (* Parse_Error *)
  304.  
  305.    WRITELN;
  306.    WRITELN('>>Error>> ',Error_Mess);
  307.    WRITELN;
  308.  
  309.    OK_Script_Command := FALSE;
  310.  
  311. END   (* Parse_Error *);
  312.  
  313. (*----------------------------------------------------------------------*)
  314. (*             Skip_Blanks --- Skip blanks anb commas in script text    *)
  315. (*----------------------------------------------------------------------*)
  316.  
  317. PROCEDURE Skip_Blanks;
  318.  
  319. BEGIN (* Skip_Blanks *)
  320.  
  321.    WHILE ( IS <= Length_Script_Line ) AND
  322.          ( Script_Line[IS] IN Blank_Set ) DO
  323.       INC( IS );
  324.  
  325. END   (* Skip_Blanks *);
  326.  
  327. (*----------------------------------------------------------------------*)
  328. (*              LookUpVarName  ---   Look up variable name              *)
  329. (*----------------------------------------------------------------------*)
  330.  
  331. FUNCTION LookUpVarName(     Var_Name : AnyStr;
  332.                         VAR Var_Type : OperandType ) : INTEGER;
  333.  
  334. VAR
  335.    I: INTEGER;
  336.  
  337. BEGIN (* LookUpVarName *)
  338. {
  339.    IF Script_Debug_Mode THEN
  340.       BEGIN
  341.          WRITELN( Script_Debug_File ,
  342.                   '>>> Entered LookUpVarName:  Var_Name              = <',
  343.                        Var_Name, '>' );
  344.          WRITELN( Script_Debug_File ,
  345.                   '                            Script_Variable_Kount = ',
  346.                        Script_Variable_Kount );
  347.       END;
  348. }
  349.    LookUpVarName := 0;
  350.    Var_Type      := Bad_Operand_Type;
  351.    Var_Name      := UpperCase( Var_Name );
  352.  
  353.    FOR I := Script_Variable_Kount DOWNTO 1 DO
  354.       BEGIN
  355.          IF Var_Name = Script_Vars[I].Var_Name THEN
  356.             BEGIN
  357.                LookUpVarName := I;
  358.                Var_Type      := Script_Vars[I].Var_Type;
  359.                EXIT;
  360.             END;
  361.       END;
  362.  
  363. END   (* LookUpVarName *);
  364.  
  365. (*----------------------------------------------------------------------*)
  366. (*        Get_Next_Token  ---  Get next token from script command       *)
  367. (*----------------------------------------------------------------------*)
  368.  
  369. FUNCTION Get_Next_Token( VAR Token      : AnyStr;
  370.                          VAR Token_Type : OperandType;
  371.                          VAR Oper_Type  : OperType;
  372.                          VAR Index      : LONGINT   ) : BOOLEAN;
  373.  
  374. (*----------------------------------------------------------------------*)
  375. (*                                                                      *)
  376. (*     Function:   Get_Next_Token                                       *)
  377. (*                                                                      *)
  378. (*     Purpose:    Extracts next element from script line.              *)
  379. (*                                                                      *)
  380. (*     Calling Sequence:                                                *)
  381. (*                                                                      *)
  382. (*        Get_Next_Token( VAR Token      : AnyStr;                      *)
  383. (*                        VAR Token_Type : OperandType;                 *)
  384. (*                        VAR Oper_Type  : OperType;                    *)
  385. (*                        VAR Index      : LONGINT  ) : BOOLEAN;        *)
  386. (*                                                                      *)
  387. (*            Token       --- Token extracted from script line          *)
  388. (*            Token_Type  --- Type of token                             *)
  389. (*            Oper_Type   --- Type of operator if token is operator     *)
  390. (*            Index       --- Variable index if token is variable or    *)
  391. (*                            value of integer constant                 *)
  392. (*                                                                      *)
  393. (*----------------------------------------------------------------------*)
  394.  
  395. VAR
  396.    Ch         : CHAR;
  397.    Quote      : CHAR;
  398.    UToken     : AnyStr;
  399.    End_String : BOOLEAN;
  400.    I          : INTEGER;
  401.  
  402. BEGIN (* Get_Next_Token *)
  403.                                    (* Set defaults *)
  404.    Token      := '';
  405.    Oper_Type  := NoOpSy;
  406.    Token_Type := Bad_Operand_Type;
  407.    INC( IS );
  408.    Index      := 0;
  409.                                    (* Skip leading blanks *)
  410.    Skip_Blanks;
  411.                                    (* If we ran off end of line, *)
  412.                                    (* no more tokens to extract. *)
  413.  
  414.    IF IS > Length_Script_Line THEN
  415.       Get_Next_Token := FALSE
  416.    ELSE
  417.       BEGIN
  418.                                    (* Otherwise, pick up first char     *)
  419.                                    (* and figure out token type from it *)
  420.          Get_Next_Token := TRUE;
  421.  
  422.          Ch := Script_Line[IS];
  423.  
  424.          IF ( Ch = ',' ) THEN
  425.             BEGIN
  426.                Token      := Script_Line[IS];
  427.                Token_Type := Comma_Type;
  428.             END
  429.          ELSE IF Ch IN ['+','-','/','*','=','<','>'] THEN
  430.             BEGIN
  431.                Token      := Script_Line[IS];
  432.                Token_Type := Operator_Type;
  433.                CASE Ch OF
  434.                   '<':  BEGIN
  435.                            INC( IS );
  436.                            CASE Script_Line[IS] OF
  437.                               '=': Token := '<=';
  438.                               '>': Token := '<>';
  439.                               ELSE
  440.                                    DEC( IS );
  441.                            END (* CASE *);
  442.                         END;
  443.                   '>':  BEGIN
  444.                            INC( IS );
  445.                            IF ( Script_Line[IS] = '=' ) THEN
  446.                               Token := '>='
  447.                            ELSE
  448.                               DEC( IS );
  449.                            END (* CASE *);
  450.                         END;
  451.  
  452.             END
  453.          ELSE IF ( Ch = '(' ) THEN
  454.             BEGIN
  455.                Token      := Script_Line[IS];
  456.                Token_Type := Left_Paren_Type;
  457.             END
  458.          ELSE IF ( Ch = ')' ) THEN
  459.             BEGIN
  460.                Token      := Script_Line[IS];
  461.                Token_Type := Right_Paren_Type;
  462.             END
  463.          ELSE IF ( Ch IN ['0'..'9'] ) THEN
  464.             BEGIN
  465.                WHILE ( Ch IN ['0'..'9'] ) DO
  466.                   BEGIN
  467.                      Token    := Token + Ch;
  468.                      Index    := Index * 10 + ( ORD( Ch ) - ORD('0') );
  469.                      INC( IS );
  470.                      Ch       := Script_Line[IS];
  471.                   END;
  472.                DEC( IS );
  473.                Token_Type := Integer_Constant_Type;
  474.             END
  475.          ELSE IF ( Ch IN ['''','"'] ) THEN
  476.             BEGIN                  (* Quoted string constant *)
  477.  
  478.                Token_Type := String_Constant_Type;
  479.                Quote      := Ch;
  480.                End_String := FALSE;
  481.  
  482.                REPEAT
  483.  
  484.                   INC( IS );
  485.  
  486.                                    (* Note:  two quotes in a row used   *)
  487.                                    (*        to indicate single quote   *)
  488.                                    (*        to be inserted into string *)
  489.  
  490.                   IF ( IS <= Length_Script_Line ) THEN
  491.                      IF ( Script_Line[IS] <> Quote ) THEN
  492.                         Token := Token + Script_Line[IS]
  493.                      ELSE
  494.                         BEGIN
  495.                            IF ( SUCC( IS ) <= Length_Script_Line ) THEN
  496.                               IF ( Script_Line[ SUCC( IS ) ] = Quote ) THEN
  497.                                  BEGIN
  498.                                     Token := Token + Quote;
  499.                                     INC( IS );
  500.                                  END
  501.                               ELSE
  502.                                  End_String := TRUE
  503.                            ELSE
  504.                               End_String := TRUE;
  505.                         END
  506.                   ELSE
  507.                      End_String := TRUE;
  508.  
  509.                UNTIL End_String;
  510.  
  511.             END
  512.          ELSE
  513.             BEGIN                  (* Pick up variable/keyword/function name *)
  514.  
  515.                WHILE ( Ch IN ['a'..'z', 'A'..'Z', '0'..'9'] ) DO
  516.                   BEGIN
  517.                      Token    := Token + Ch;
  518.                      INC( IS );
  519.                      Ch       := Script_Line[IS];
  520.                   END;
  521.  
  522.                DEC( IS );
  523.  
  524.                                    (* Look up name and see if it is a *)
  525.                                    (* variable or not.                *)
  526.  
  527.                Index      := LookUpVarName( Token , Token_Type );
  528.  
  529.                                    (* If not there, assume it's a string *)
  530.                                    (* variable = keyword.                *)
  531.  
  532.                IF ( Index = 0 ) THEN
  533.                   Token_Type := String_Variable_Type;
  534.  
  535.             END;
  536.                                    (* Check if variable is possibly *)
  537.                                    (* a function.                   *)
  538.  
  539.             IF ( ( Token_Type IN [Operator_Type, String_Variable_Type] ) AND
  540.                  ( Index = 0 ) ) THEN
  541.                BEGIN
  542.                   UToken := UpperCase( Token );
  543.                   FOR I := 1 TO MaxOperNames DO
  544.                      BEGIN
  545.                         IF ( UToken = OperNames[I] ) THEN
  546.                            BEGIN
  547.                               Oper_Type  := OperSyms[I];
  548.                               Token_Type := Operator_Type;
  549.                               Index      := ORD( Operator_Type );
  550.                            END;
  551.                      END;
  552.                END;
  553.  
  554.       END;
  555.  
  556. END   (* Get_Next_Token *);
  557.  
  558. (*----------------------------------------------------------------------*)
  559. (*        Get_Integer --- pick up integer constant or variable          *)
  560. (*----------------------------------------------------------------------*)
  561.  
  562. PROCEDURE Get_Integer( VAR QNum      : BOOLEAN;
  563.                        VAR IntVal    : LONGINT;
  564.                        VAR IntType   : INTEGER;
  565.                            MustBeVar : BOOLEAN );
  566.  
  567. (*----------------------------------------------------------------------*)
  568. (*                                                                      *)
  569. (*     Procedure:  Get_Integer                                          *)
  570. (*                                                                      *)
  571. (*     Purpose:    Extracts integer from a string.                      *)
  572. (*                                                                      *)
  573. (*     Calling Sequence:                                                *)
  574. (*                                                                      *)
  575. (*        Get_Integer(  VAR QNum      : BOOLEAN;                        *)
  576. (*                      VAR IntVal    : LONGINT;                        *)
  577. (*                      VAR IntType   : BOOLEAN;                        *)
  578. (*                          MustBeVar : BOOLEAN );                      *)
  579. (*                                                                      *)
  580. (*            QNum      --- TRUE if a number extracted                  *)
  581. (*            IntVal    --- integer extracted or 0 if none              *)
  582. (*            IntType   --- Type of constant found                      *)
  583. (*            MustBeVar --- TRUE if integer variable required rather    *)
  584. (*                          than just constant.                         *)
  585. (*                                                                      *)
  586. (*----------------------------------------------------------------------*)
  587.  
  588. VAR
  589.    Token      : AnyStr;
  590.    Token_Type : OperandType;
  591.    Index      : LONGINT;
  592.    Oper_Type  : OperType;
  593.  
  594. BEGIN (* Get_Integer *)
  595.                                    (* Initialize.          *)
  596.    IntType := IntegerMissing;
  597.    IntVal  := 0;
  598.    QNum    := FALSE;
  599.                                    (* Pick up next token.  *)
  600.  
  601.    IF ( Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  602.       BEGIN                        (* Got token -- check if integer *)
  603.  
  604.          CASE Token_Type OF
  605.  
  606.             Integer_Variable_Type : BEGIN
  607.                                        QNum    := TRUE;
  608.                                        IntVal  := Index;
  609.                                        IntType := IntegerVariable;
  610.                                     END;
  611.  
  612.             Integer_Constant_Type : IF MustBeVar THEN
  613.                                        Parse_Error( S1 + Token + S3 )
  614.                                     ELSE
  615.                                        BEGIN
  616.                                           QNum    := TRUE;
  617.                                           IntVal  := Index;
  618.                                           IntType := IntegerConstant;
  619.                                        END;
  620.  
  621.             String_Variable_Type  : IF ( Index = 0 ) THEN
  622.                                        Parse_Error( S4 + Token + S5 )
  623.                                     ELSE
  624.                                        Parse_Error( S4 + Token + S6 );
  625.  
  626.             ELSE                    IF MustBeVar THEN
  627.                                        Parse_Error( S1 + Token + S3 )
  628.                                     ELSE
  629.                                        Parse_Error( S2 + Token + S3 );
  630.          END (* CASE *);
  631.  
  632.       END;
  633.  
  634. END   (* Get_Integer *);
  635.  
  636. (*----------------------------------------------------------------------*)
  637. (*    Copy_String_To_Buffer --- Copy string from script line to buffer  *)
  638. (*----------------------------------------------------------------------*)
  639.  
  640. PROCEDURE Copy_String_To_Buffer( S     : AnyStr;
  641.                                  SType : OperandType;
  642.                                  SIndex: LONGINT );
  643.  
  644. (*----------------------------------------------------------------------*)
  645. (*                                                                      *)
  646. (*     Procedure:  Copy_String_To_Buffer                                *)
  647. (*                                                                      *)
  648. (*     Purpose:    Copies string from script line to buffer             *)
  649. (*                                                                      *)
  650. (*     Calling Sequence:                                                *)
  651. (*                                                                      *)
  652. (*        Copy_String_To_Buffer( S     : AnyStr;                        *)
  653. (*                               SType : OperandType;                   *)
  654. (*                               SIndex: LONGINT );                     *)
  655. (*                                                                      *)
  656. (*           S      --- String to insert                                *)
  657. (*           SType  --- Type of string                                  *)
  658. (*           SIndex --- Variable index if Stype = String_Variable       *)
  659. (*                                                                      *)
  660. (*----------------------------------------------------------------------*)
  661.  
  662. VAR
  663.    L     : INTEGER;
  664.    I     : INTEGER;
  665.    IType : INTEGER;
  666.  
  667. BEGIN (* Copy_String_To_Buffer *)
  668.                                    (* Mark string type *)
  669.    CASE SType OF
  670.       String_Variable_Type : BEGIN
  671.                                 IF ( S = '$LOC' ) THEN
  672.                                    IType := 1
  673.                                 ELSE IF ( S = '$REM' ) THEN
  674.                                    IType := 2
  675.                                 ELSE
  676.                                    IType := 3;
  677.                              END;
  678.       String_Constant_Type : IType := 0;
  679.    END (* CASE *);
  680.  
  681.    INC( Script_Buffer_Pos );
  682.  
  683.    Script_Buffer^[Script_Buffer_Pos] := IType;
  684. {--IMP
  685.    IF Script_Debug_Mode THEN
  686.       WRITELN( Script_Debug_File , Script_Buffer_Pos:4 , 'string type = ', IType:4 );
  687. }
  688.                                    (* Insert length, string if *)
  689.                                    (* quoted string type       *)
  690.    IF ( IType = 0 ) THEN
  691.       BEGIN
  692.  
  693.          L                                 := LENGTH( S );
  694.          INC( Script_Buffer_Pos );
  695.          Script_Buffer^[Script_Buffer_Pos] := L;
  696. {--IMP
  697.          IF Script_Debug_Mode THEN
  698.              WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', L:4 );
  699. }
  700.          FOR I := 1 TO L DO
  701.             BEGIN
  702.  
  703.                INC( Script_Buffer_Pos );
  704.                Script_Buffer^[Script_Buffer_Pos] := ORD( S[I] );
  705.             END;
  706. {--IMP
  707.          IF Script_Debug_Mode THEN
  708.             BEGIN
  709.                WRITE  ( Script_Debug_File , ' ', S );
  710.                WRITELN( Script_Debug_File );
  711.             END;
  712. }
  713.       END
  714.                                    (* Insert variable index *)
  715.    ELSE IF ( IType = 3 ) THEN
  716.       BEGIN
  717.          INC( Script_Buffer_Pos );
  718.          Script_Buffer^[Script_Buffer_Pos] := SIndex;
  719. {--IMP
  720.          IF Script_Debug_Mode THEN
  721.             WRITELN( Script_Debug_File , Script_Buffer_Pos:4 ,
  722.                      'Variable index = ', SIndex:3 );
  723. }
  724.       END;
  725.  
  726. END   (* Copy_String_To_Buffer *);
  727.  
  728. (*----------------------------------------------------------------------*)
  729. (*           Get_String --- Get script line string                      *)
  730. (*----------------------------------------------------------------------*)
  731.  
  732. PROCEDURE Get_String(     MustBeVar  : BOOLEAN;
  733.                       VAR Token      : AnyStr;
  734.                       VAR Token_Type : OperandType;
  735.                       VAR Oper_Type  : OperType;
  736.                       VAR Index      : LONGINT;
  737.                       VAR Got_String : BOOLEAN );
  738.  
  739. (*----------------------------------------------------------------------*)
  740. (*                                                                      *)
  741. (*     Procedure:  Get_String                                           *)
  742. (*                                                                      *)
  743. (*     Purpose:    Get script line string                               *)
  744. (*                                                                      *)
  745. (*     Calling Sequence:                                                *)
  746. (*                                                                      *)
  747. (*        Get_String(     MustBeVar  : BOOLEAN;                         *)
  748. (*                    VAR Token      : AnyStr;                          *)
  749. (*                    VAR Token_Type : OperandType;                     *)
  750. (*                    VAR Oper_Type  : OperType;                        *)
  751. (*                    VAR Index      : LONGINT;                         *)
  752. (*                    VAR Got_String : BOOLEAN );                       *)
  753. (*                                                                      *)
  754. (*           MustBeVar   --- TRUE if string must be variable rather than*)
  755. (*                           constant.                                  *)
  756. (*           Token       --- Token extracted from script line           *)
  757. (*           Token_Type  --- Type of token                              *)
  758. (*           Oper_Type   --- Type of operator if token is operator      *)
  759. (*           Index       --- Variable index if token is variable or     *)
  760. (*                           value of integer constant                  *)
  761. (*           Got_String  --- TRUE if string found and stored.           *)
  762. (*                                                                      *)
  763. (*----------------------------------------------------------------------*)
  764.  
  765. BEGIN (* Get_String *)
  766.                                    (* Get string if possible *)
  767.    Got_String := FALSE;
  768.  
  769.    IF ( Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  770.       BEGIN                        (* Got token -- check if string *)
  771.  
  772.          CASE Token_Type OF
  773.  
  774.             Integer_Variable_Type : IF ( ( Index = 0 ) AND MustBeVar ) THEN
  775.                                        Parse_Error( S4 + Token + S5 )
  776.                                     ELSE
  777.                                        Parse_Error( S4 + Token + S7 );
  778.  
  779.             String_Variable_Type  : IF ( Index = 0 ) THEN
  780.                                        Parse_Error( S4 + Token + S5 )
  781.                                     ELSE
  782.                                        Got_String := TRUE;
  783.  
  784.             String_Constant_Type  : IF MustBeVar THEN
  785.                                        Parse_Error( S16 + Token + S3 )
  786.                                     ELSE
  787.                                        Got_String := TRUE;
  788.  
  789.             ELSE                    IF MustBeVar THEN
  790.                                        Parse_Error( S16 + Token + S3 )
  791.                                     ELSE
  792.                                        Parse_Error( S17 + Token + S3 );
  793.          END (* CASE *);
  794.  
  795.       END;
  796.  
  797. END   (* Get_String *);
  798.  
  799. (*----------------------------------------------------------------------*)
  800. (*  Get_And_Copy_String_To_Buffer --- Copy script line string to buffer *)
  801. (*----------------------------------------------------------------------*)
  802.  
  803. PROCEDURE Get_And_Copy_String_To_Buffer(     MustBeVar : BOOLEAN;
  804.                                              CopyEmpty : BOOLEAN;
  805.                                          VAR GotString : BOOLEAN );
  806.  
  807. (*----------------------------------------------------------------------*)
  808. (*                                                                      *)
  809. (*     Procedure:  Get_And_Copy_String_To_Buffer                        *)
  810. (*                                                                      *)
  811. (*     Purpose:    Copies quoted string from script line to buffer      *)
  812. (*                                                                      *)
  813. (*     Calling Sequence:                                                *)
  814. (*                                                                      *)
  815. (*        Get_And_Copy_String_To_Buffer(     MustBeVar : BOOLEAN;       *)
  816. (*                                           CopyEmpty : BOOLEAN );     *)
  817. (*                                       VAR GotString : BOOLEAN );     *)
  818. (*                                                                      *)
  819. (*           MustBeVar --- TRUE if string must be variable rather than  *)
  820. (*                         constant.                                    *)
  821. (*           CopyEmpty --- Copy empty string if none found.             *)
  822. (*           GotString --- TRUE if string found and stored.             *)
  823. (*                                                                      *)
  824. (*----------------------------------------------------------------------*)
  825.  
  826. VAR
  827.    Token      : AnyStr;
  828.    Token_Type : OperandType;
  829.    Index      : LONGINT;
  830.    Oper_Type  : OperType;
  831.  
  832. BEGIN (* Get_And_Copy_String_To_Buffer *)
  833.  
  834.    Get_String( MustBeVar, Token, Token_Type, Oper_Type, Index, GotString );
  835.  
  836.                                    (* If we got a string, copy it *)
  837.                                    (* to script buffer.           *)
  838.  
  839.    IF ( ( NOT GotString ) AND CopyEmpty ) THEN
  840.       BEGIN
  841.          Token_Type := String_Constant_Type;
  842.          GotString  := TRUE;
  843.       END;
  844.  
  845.    IF GotString THEN
  846.       Copy_String_To_Buffer( Token, Token_Type, Index );
  847.  
  848. END   (* Get_And_Copy_String_To_Buffer *);
  849.  
  850. (*----------------------------------------------------------------------*)
  851. (*     Copy_Integer_To_Buffer --- Copy integer to script line buffer    *)
  852. (*----------------------------------------------------------------------*)
  853.  
  854. PROCEDURE Copy_Integer_To_Buffer( IntVal   : LONGINT;
  855.                                   Variable : INTEGER );
  856.  
  857. (*----------------------------------------------------------------------*)
  858. (*                                                                      *)
  859. (*     Procedure:  Copy_Integer_To_Buffer                               *)
  860. (*                                                                      *)
  861. (*     Purpose:    Copies integer to script line buffer                 *)
  862. (*                                                                      *)
  863. (*     Calling Sequence:                                                *)
  864. (*                                                                      *)
  865. (*        Copy_Integer_To_Buffer( IntVal   : INTEGER;                   *)
  866. (*                                Variable : INTEGER  );                *)
  867. (*                                                                      *)
  868. (*           IntVal   --- Value to place in script buffer               *)
  869. (*           Variable --- Type of constant to store                     *)
  870. (*                                                                      *)
  871. (*----------------------------------------------------------------------*)
  872.  
  873. BEGIN (* Copy_Integer_To_Buffer *)
  874.  
  875.    CASE Variable OF
  876.  
  877.       IntegerVariable : BEGIN
  878.  
  879.                            INC( Script_Buffer_Pos );
  880.                            Script_Buffer^[Script_Buffer_Pos] := IntVal;
  881.  
  882.                         END;
  883.  
  884.       IntegerConstant : BEGIN
  885.  
  886.                            INC( Script_Buffer_Pos );
  887.                            Script_Buffer^[Script_Buffer_Pos] := 0;
  888.  
  889.                            MOVE( IntVal,
  890.                                  Script_Buffer^[ Script_Buffer_Pos + 1 ],
  891.                                  SIZEOF( LONGINT ) );
  892.  
  893.                            INC( Script_Buffer_Pos , 4 );
  894.  
  895.                         END;
  896.  
  897.       IntegerConsOnly : BEGIN
  898.  
  899.                            MOVE( IntVal,
  900.                                  Script_Buffer^[ Script_Buffer_Pos + 1 ],
  901.                                  SIZEOF( LONGINT ) );
  902.  
  903.                            INC( Script_Buffer_Pos , 4 );
  904.  
  905.                         END;
  906.  
  907.       ELSE;
  908.  
  909.    END (* CASE *);
  910.  
  911. END   (* Copy_Integer_To_Buffer *);
  912.  
  913. (*----------------------------------------------------------------------*)
  914. (*        Copy_Byte_To_Buffer --- Copy byte to script line buffer       *)
  915. (*----------------------------------------------------------------------*)
  916.  
  917. PROCEDURE Copy_Byte_To_Buffer( ByteVal : INTEGER );
  918.  
  919. (*----------------------------------------------------------------------*)
  920. (*                                                                      *)
  921. (*     Procedure:  Copy_Byte_To_Buffer                                  *)
  922. (*                                                                      *)
  923. (*     Purpose:    Copies byte to script line buffer                    *)
  924. (*                                                                      *)
  925. (*     Calling Sequence:                                                *)
  926. (*                                                                      *)
  927. (*        Copy_Byte_To_Buffer( IntVal : INTEGER );                      *)
  928. (*                                                                      *)
  929. (*           ByteVal --- Value to place in script buffer                *)
  930. (*                                                                      *)
  931. (*----------------------------------------------------------------------*)
  932.  
  933. BEGIN (* Copy_Byte_To_Buffer *)
  934.  
  935.    INC( Script_Buffer_Pos );
  936.    Script_Buffer^[Script_Buffer_Pos] := ByteVal;
  937. {--IMP
  938.    IF Script_Debug_Mode THEN
  939.        BEGIN
  940.           WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', ByteVal,
  941.                  ' (Byte)' );
  942.           IF ( ByteVal > 32 ) AND ( ByteVal < 127 ) THEN
  943.              WRITE( Script_Debug_File , ' (',CHR( ByteVal ),')' );
  944.           WRITELN( Script_Debug_File );
  945.        END;
  946. }
  947. END   (* Copy_Byte_To_Buffer *);
  948.  
  949. (*----------------------------------------------------------------------*)
  950. (*        Parse_Expression --- Parse variable in script command         *)
  951. (*----------------------------------------------------------------------*)
  952.  
  953. FUNCTION Parse_Expression ( Stop_Token : AnyStr ) : BOOLEAN;
  954.  
  955. CONST
  956.    MaxOperatorStack = 10;
  957.  
  958. VAR
  959.    PC             : INTEGER;
  960.    Token          : AnyStr;
  961.    Token_Type     : OperandType;
  962.    Operator_Stack : ARRAY[0..MaxOperatorStack] OF OperType;
  963.    Prec_Stack     : ARRAY[0..MaxOperatorStack] OF BYTE;
  964.    Paren_Stack    : ARRAY[0..MaxOperatorStack] OF INTEGER;
  965.    Stack_Size     : INTEGER;
  966.    Num            : INTEGER;
  967.    Op             : INTEGER;
  968.    Ierr           : INTEGER;
  969.    Polish         : AnyStr;
  970.    I              : LONGINT;
  971.    Oper_Type      : OperType;
  972.    Found_Stop     : BOOLEAN;
  973.    Found_Token    : BOOLEAN;
  974.  
  975. LABEL
  976.    Parsing_Error;
  977.  
  978. (*----------------------------------------------------------------------*)
  979.  
  980. PROCEDURE Dump_Paren_Stack;
  981.  
  982. BEGIN (* Dump_Paren_Stack *)
  983.  
  984.    WHILE ( ( Stack_Size > 0 ) AND ( Paren_Stack[Stack_Size] >= PC ) ) DO
  985.       BEGIN
  986.          Copy_Byte_To_Buffer( ORD( Operator_Type ) );
  987.          Copy_Byte_To_Buffer( ORD(Operator_Stack[Stack_Size]) );
  988.          Polish      := Polish + OperNames2[Operator_Stack[Stack_Size]] + ';';
  989.          DEC( Stack_Size );
  990.       END;
  991.  
  992. END   (* Do_Right_Parens *);
  993.  
  994. (*----------------------------------------------------------------------*)
  995.  
  996. BEGIN (* Parse_Expression *)
  997.  
  998.    PC             := 0;
  999.    Stack_Size     := 0;
  1000.    Polish         := '';
  1001.    Save_BPos      := Script_Buffer_Pos;
  1002.  
  1003.    Prec_Stack[0]  := 0;
  1004.    Paren_Stack[0] := 0;
  1005.    Found_Stop     := FALSE;
  1006.  
  1007.    Blank_Set      := [' '];
  1008.    Found_Token    := Get_Next_Token( Token , Token_Type , Oper_Type, I );
  1009.  
  1010.    WHILE ( Found_Token AND ( NOT Found_Stop ) ) DO
  1011.       BEGIN
  1012. {--IMP
  1013.          IF Script_Debug_Mode THEN
  1014.             WRITELN( Script_Debug_File , 'Next token: ',Token,
  1015.                      ', type is: ',ORD(Token_Type), ' oper is ',
  1016.                      ORD( Oper_Type ) );
  1017. }
  1018.          CASE Token_Type OF
  1019.             Left_Paren_Type       : PC := PC + MaxPrec;
  1020.             Comma_Type            : Dump_Paren_Stack;
  1021.             Right_Paren_Type      : BEGIN
  1022.                                        PC := PC - MaxPrec;
  1023.                                        Dump_Paren_Stack;
  1024.                                     END;
  1025.             Integer_Constant_Type : BEGIN
  1026.                                        Copy_Byte_To_Buffer   ( ORD( Integer_Constant_Type ) );
  1027.                                        Copy_Integer_To_Buffer( I , IntegerConsOnly);
  1028.                                        Polish      := Polish + Token + ';';
  1029.                                     END;
  1030.             String_Constant_Type  : BEGIN
  1031.                                        Copy_Byte_To_Buffer( ORD( String_Constant_Type ) );
  1032.                                        Copy_Byte_To_Buffer( LENGTH( Token ) );
  1033.                                        FOR I := 1 TO LENGTH( Token ) DO
  1034.                                           Copy_Byte_To_Buffer( ORD( Token[I] ) );
  1035.                                        Polish      := Polish + Token + ';';
  1036.                                     END;
  1037.             String_Variable_Type,
  1038.             Integer_Variable_Type : BEGIN
  1039.                                        IF ( UpperCase( Token ) = Stop_Token ) THEN
  1040.                                           Found_Stop := TRUE
  1041.                                        ELSE
  1042.                                           BEGIN
  1043.                                              IF ( I = 0 ) THEN
  1044.                                                 BEGIN
  1045.                                                    PC := 99;
  1046.                                                    GOTO Parsing_Error;
  1047.                                                 END
  1048.                                              ELSE
  1049.                                                 BEGIN
  1050.                                                    Copy_Byte_To_Buffer( ORD( Script_Vars[I].Var_Type ) );
  1051.                                                    Copy_Byte_To_Buffer( I );
  1052.                                                    Polish      := Polish + Token + ';';
  1053.                                                 END;
  1054.                                           END;
  1055.                                     END;
  1056.             Operator_Type         : BEGIN
  1057.                                        Op := OperPrecs[ Oper_Type ] + PC;
  1058.                                        WHILE ( ( Stack_Size > 0 ) AND
  1059.                                                ( Prec_Stack[Stack_Size] >= OP ) ) DO
  1060.                                            BEGIN
  1061.                                               Copy_Byte_To_Buffer( ORD( Operator_Type ) );
  1062.                                               Copy_Byte_To_Buffer( ORD( Operator_Stack[Stack_Size] ) );
  1063.                                               Polish      := Polish +
  1064.                                                              OperNames2[Operator_Stack[Stack_Size]] + ';';
  1065.                                               DEC( Stack_Size );
  1066.                                            END;
  1067.                                        INC( Stack_Size );
  1068.                                        Operator_Stack[Stack_Size] := Oper_Type;
  1069.                                        Prec_Stack    [Stack_Size] := Op;
  1070.                                        Paren_Stack   [Stack_Size] := PC;
  1071.                                     END;
  1072.             ELSE;
  1073.          END (* CASE *);
  1074.  
  1075.          IF ( NOT Found_Stop ) THEN
  1076.             Found_Token    := Get_Next_Token( Token , Token_Type , Oper_Type, I );
  1077.  
  1078.       END;
  1079.  
  1080.    WHILE( Stack_Size > 0 ) DO
  1081.       BEGIN
  1082.          Copy_Byte_To_Buffer( ORD( Operator_Type ) );
  1083.          Copy_Byte_To_Buffer( ORD( Operator_Stack[Stack_Size] ) );
  1084.          Polish      := Polish + OperNames2[ Operator_Stack[Stack_Size] ] + ';';
  1085.          DEC( Stack_Size );
  1086.       END;
  1087.  
  1088. Parsing_Error:
  1089.    Copy_Byte_To_Buffer( ORD( StackEnd_Type ) );
  1090.    Parse_Expression := ( PC = 0 );
  1091.  
  1092.    IF ( PC <> 0 ) THEN
  1093.       WRITELN('Parentheses don''t balance.');
  1094. {--IMP
  1095.    IF Script_Debug_Mode THEN
  1096.       BEGIN
  1097.          WRITELN( Script_Debug_File , 'PC      = ',PC );
  1098.          WRITELN( Script_Debug_File , 'Postfix = ',Polish );
  1099.       END;
  1100. }
  1101. {
  1102.    IF Debug_Mode THEN
  1103.       Write_Log('Polish = ' + Polish, FALSE, FALSE );
  1104. }
  1105.    LCode := Script_Buffer_Pos;
  1106.    ICode := Save_BPos;
  1107.  
  1108.    Blank_Set      := [' ', ','];
  1109.  
  1110. END   (* Parse_Expression *);
  1111.  
  1112. (*----------------------------------------------------------------------*)
  1113. (*    Check_Types --- Check argument and result types in emitted code   *)
  1114. (*----------------------------------------------------------------------*)
  1115.  
  1116. FUNCTION Check_Types( VAR Result_Type : OperandType ) : BOOLEAN;
  1117.  
  1118. VAR
  1119.    Stack         : ARRAY[1..MaxStack] OF OperandType;
  1120.    End_Of_Stack  : BOOLEAN;
  1121.    Stack_Index   : INTEGER;
  1122.    Operand_Type  : OperandType;
  1123.    Index         : LONGINT;
  1124.    Bad_Operands  : BOOLEAN;
  1125.  
  1126. VAR
  1127.    Operand_Type_Names : ARRAY[OperandType] OF STRING[12];
  1128.  
  1129. (*----------------------------------------------------------------------*)
  1130. (*                 Push_Type --- Push type onto stack                   *)
  1131. (*----------------------------------------------------------------------*)
  1132.  
  1133. PROCEDURE Push_Type( Operand : OperandType );
  1134.  
  1135. BEGIN (* Push_Type *)
  1136.  
  1137.    INC( Stack_Index );
  1138.    Stack[Stack_Index] := Operand;
  1139.  
  1140. END   (* Push_Type *);
  1141.  
  1142. (*----------------------------------------------------------------------*)
  1143. (*                 Pop_Type --- Pop type off stack                      *)
  1144. (*----------------------------------------------------------------------*)
  1145.  
  1146. PROCEDURE Pop_Type( VAR Operand : OperandType );
  1147.  
  1148. BEGIN (* Pop_Type *)
  1149.  
  1150.    IF ( Stack_Index > 0 ) THEN
  1151.       BEGIN
  1152.          Operand     := Stack[Stack_Index];
  1153.          DEC( Stack_Index );
  1154.       END
  1155.    ELSE
  1156.       Operand := Bad_Operand_Type;
  1157.  
  1158. END   (* Pop_Type *);
  1159.  
  1160. (*----------------------------------------------------------------------*)
  1161. (*    Pseudo_Perform_Operator --- Check arguments and result types      *)
  1162. (*----------------------------------------------------------------------*)
  1163.  
  1164. PROCEDURE Pseudo_Perform_Operator(     Operator     : OperType;
  1165.                                    VAR Bad_Operands : BOOLEAN  );
  1166.  
  1167. VAR
  1168.    Op1_Type : OperandType;
  1169.    Op2_Type : OperandType;
  1170.    Op3_Type : OperandType;
  1171.    NArgs    : INTEGER;
  1172.  
  1173. BEGIN (* Pseudo_Perform_Operator *)
  1174.  
  1175.    Bad_Operands := FALSE;
  1176.  
  1177.    NArgs        := Number_Args[Operator];
  1178.  
  1179.    Op1_Type     := Bad_Operand_Type;
  1180.    Op2_Type     := Bad_Operand_Type;
  1181.    Op3_Type     := Bad_Operand_Type;
  1182.  
  1183.    IF Nargs > 0 THEN
  1184.       BEGIN
  1185.          Pop_Type( Op1_Type );
  1186.          IF Nargs > 1 THEN
  1187.             BEGIN
  1188.                Pop_Type( Op2_Type );
  1189.                IF Nargs > 2 THEN
  1190.                   Pop_Type( Op3_Type );
  1191.             END;
  1192.       END;
  1193. {
  1194.    IF Debug_Mode THEN
  1195.       BEGIN
  1196.          Write_Log('     Op1_Type = ' + IToS( ORD(Op1_Type) ), FALSE, FALSE );
  1197.          Write_Log('     Op2_Type = ' + IToS( ORD(Op2_Type) ), FALSE, FALSE );
  1198.          Write_Log('     Op3_Type = ' + IToS( ORD(Op3_Type) ), FALSE, FALSE );
  1199.          Write_Log('     Operator = ' + IToS( ORD(Operator) ), FALSE, FALSE );
  1200.       END;
  1201. }
  1202.    CASE Operator OF
  1203.  
  1204.       NoOpSy         : ;
  1205.  
  1206.       AndSy,
  1207.       OrSy,
  1208.       XorSy,
  1209.       AddSy,
  1210.       SubtractSy,
  1211.       MultSy,
  1212.       DivideSy       : BEGIN
  1213.                           IF ( Op1_Type = Integer_Variable_Type ) AND
  1214.                              ( Op2_Type = Integer_Variable_Type ) THEN
  1215.                              Push_Type( Integer_Variable_Type )
  1216.                           ELSE
  1217.                              Bad_Operands := TRUE;
  1218.                         END;
  1219.  
  1220.       SubStrSy       :  BEGIN
  1221.                            IF ( Op1_Type = Integer_Variable_Type ) AND
  1222.                               ( Op2_Type = Integer_Variable_Type ) AND
  1223.                               ( Op3_Type = String_Variable_Type  ) THEN
  1224.                               Push_Type( String_Variable_Type )
  1225.                            ELSE
  1226.                               Bad_Operands := TRUE;
  1227.                         END;
  1228.  
  1229.       OrdSy          :  BEGIN
  1230.                            IF ( Op1_Type = Integer_Variable_Type ) AND
  1231.                               ( Op2_Type = String_Variable_Type  ) THEN
  1232.                               Push_Type( Integer_Variable_Type )
  1233.                            ELSE
  1234.                               Bad_Operands := TRUE;
  1235.                         END;
  1236.  
  1237.       ConcatSy       :  BEGIN
  1238.                            IF ( Op1_Type = String_Variable_Type ) AND
  1239.                               ( Op2_Type = String_Variable_Type ) THEN
  1240.                               Push_Type( String_Variable_Type )
  1241.                            ELSE
  1242.                               Bad_Operands := TRUE;
  1243.                         END;
  1244.  
  1245.       IndexSy        :  BEGIN
  1246.                            IF ( Op1_Type = String_Variable_Type ) AND
  1247.                               ( Op2_Type = String_Variable_Type ) THEN
  1248.                               Push_Type( Integer_Variable_Type )
  1249.                            ELSE
  1250.                               Bad_Operands := TRUE;
  1251.                         END;
  1252.  
  1253.       FileExistsSy,
  1254.       LengthSy       :  BEGIN
  1255.                            IF ( Op1_Type = String_Variable_Type ) THEN
  1256.                               Push_Type( Integer_Variable_Type )
  1257.                            ELSE
  1258.                               Bad_Operands := TRUE;
  1259.                         END;
  1260.  
  1261.       EqualISy,
  1262.       LessEqualISy,
  1263.       LessISy,
  1264.       GreaterISy,
  1265.       GreaterEqualISy,
  1266.       NotEqualISy    :  IF ( Op1_Type <> Op2_Type ) THEN
  1267.                            Bad_Operands := TRUE
  1268.                         ELSE
  1269.                            BEGIN
  1270.                               IF ( Op1_Type = String_Variable_Type ) THEN
  1271.                                  Script_Buffer^[ICode] := Script_Buffer^[ICode] + 6;
  1272.                               Push_Type( Integer_Variable_Type );
  1273.                            END;
  1274.  
  1275.       NotSy          :  IF ( Op1_Type = Integer_Variable_Type ) THEN
  1276.                            Push_Type( Integer_Variable_Type )
  1277.                         ELSE
  1278.                            Bad_Operands := TRUE;
  1279.  
  1280.       AttendedSy,
  1281.       ConnectedSy,
  1282.       DialedSy,
  1283.       EnhKeybdSy,
  1284.       WaitFoundSy,
  1285.       IOResultSy,
  1286.       ParamCountSy   : Push_Type( Integer_Variable_Type );
  1287.  
  1288.       DateSy,
  1289.       TimeSy,
  1290.       ParamLineSy    : Push_Type( String_Variable_Type );
  1291.  
  1292.  
  1293.       ChrSy,
  1294.       DialEntrySy,
  1295.       ParamStrSy,
  1296.       StringSy       : IF ( Op1_Type = Integer_Variable_Type ) THEN
  1297.                           Push_Type( String_Variable_Type )
  1298.                        ELSE
  1299.                           Bad_Operands := TRUE;
  1300.  
  1301.       NumberSy       : IF ( Op1_Type = String_Variable_Type ) THEN
  1302.                           Push_Type( Integer_Variable_Type )
  1303.                        ELSE
  1304.                           Bad_Operands := TRUE;
  1305.  
  1306.       EofSy          : IF ( Op1_Type = Integer_Variable_Type ) THEN
  1307.                           Push_Type( Integer_Variable_Type )
  1308.                        ELSE
  1309.                           Bad_Operands := TRUE;
  1310.  
  1311.       ReadCtrlSy,
  1312.       WriteCtrlSy,
  1313.       UpperCaseSy,
  1314.       TrimSy,
  1315.       LTrimSy,
  1316.       KeyStringSy    : IF ( Op1_Type = String_Variable_Type ) THEN
  1317.                           Push_Type( String_Variable_Type )
  1318.                        ELSE
  1319.                           Bad_Operands := TRUE;
  1320.  
  1321.       DuplSy         : IF ( Op2_Type = String_Variable_Type ) AND
  1322.                           ( Op1_Type = Integer_Variable_Type ) THEN
  1323.                           Push_Type( String_Variable_Type )
  1324.                        ELSE
  1325.                           Bad_Operands := TRUE;
  1326.       ELSE;
  1327.  
  1328.    END (* CASE *);
  1329.  
  1330. END   (* Pseudo_Perform_Operator *);
  1331.  
  1332. (*----------------------------------------------------------------------*)
  1333. (*    Get_Next_Operand_Type --- Get type of next operand                *)
  1334. (*----------------------------------------------------------------------*)
  1335.  
  1336. PROCEDURE Get_Next_Operand_Type( VAR Operand_Type : OperandType;
  1337.                                  VAR Index        : LONGINT );
  1338.  
  1339. BEGIN (* Get_Next_Operand_Type *)
  1340.  
  1341.    INC( ICode );
  1342.  
  1343.    IF ( ICode > LCode ) THEN
  1344.       BEGIN
  1345.          Operand_Type := StackEnd_Type;
  1346.          Index        := 0;
  1347.       END
  1348.    ELSE
  1349.       BEGIN
  1350.  
  1351.          Operand_Type := Operands[Script_Buffer^[ICode]];
  1352.  
  1353.          CASE Operand_Type OF
  1354.  
  1355.             Operator_Type,
  1356.             Integer_Variable_Type,
  1357.             String_Variable_Type : BEGIN
  1358.                                       INC( ICode );
  1359.                                       Index := Script_Buffer^[ICode];
  1360.                                    END;
  1361.  
  1362.             Integer_Constant_Type: BEGIN
  1363.                                       INC( ICode );
  1364.                                       MOVE( Script_Buffer^[ICode], Index,
  1365.                                             SIZEOF( Index ) );
  1366.                                       INC( ICode , PRED( SIZEOF( Index ) ) );
  1367.                                    END;
  1368.  
  1369.             String_Constant_Type:  BEGIN
  1370.                                       INC( ICode );
  1371.                                       ICode := ICode + Script_Buffer^[ICode];
  1372.                                    END;
  1373.  
  1374.          END (* CASE *);
  1375.  
  1376.       END;
  1377.  
  1378. END   (* Get_Next_Operand_Type *);
  1379.  
  1380. (*----------------------------------------------------------------------*)
  1381.  
  1382. BEGIN (* Check_Types *)
  1383.  
  1384.    End_Of_Stack := FALSE;
  1385.    Stack_Index  := 0;
  1386.    Bad_Operands := FALSE;
  1387.    Result_Type  := Bad_Operand_Type;
  1388.  
  1389.    DEC( ICode );
  1390.  
  1391.    Operand_Type_Names[Bad_Operand_Type]      := 'BAD OPERAND';
  1392.    Operand_Type_Names[Integer_Variable_Type] := 'INTEGER';
  1393.    Operand_Type_Names[String_Variable_Type]  := 'STRING';
  1394.  
  1395.    WHILE ( NOT ( End_Of_Stack OR Bad_Operands ) ) DO
  1396.       BEGIN
  1397.  
  1398.          Get_Next_Operand_Type( Operand_Type , Index );
  1399.  
  1400.          CASE Operand_Type OF
  1401.  
  1402.             Integer_Variable_Type,
  1403.             Integer_Constant_Type:  Push_Type( Integer_Variable_Type );
  1404.  
  1405.             String_Variable_Type,
  1406.             String_Constant_Type :  Push_Type( String_Variable_Type );
  1407.  
  1408.             Operator_Type        :  Pseudo_Perform_Operator( OperSyms2[Index],
  1409.                                                              Bad_Operands );
  1410.  
  1411.             StackEnd_Type        :  End_Of_Stack := TRUE;
  1412.  
  1413.          END (* CASE *);
  1414.  
  1415.       END;
  1416.  
  1417.    Check_Types := NOT Bad_Operands;
  1418.  
  1419. {
  1420.    WRITELN('Before final POP, Stack_Index = ',Stack_Index);
  1421. }
  1422.    Pop_Type( Result_Type );
  1423. {
  1424.    IF Debug_Mode THEN
  1425.       BEGIN
  1426.  
  1427.          Write_Log( 'Check_Type:  Final result type is ', FALSE, FALSE );
  1428.  
  1429.          CASE Result_Type OF
  1430.             Integer_Variable_Type: Write_Log( ' Integer result variable.', FALSE, FALSE );
  1431.             String_Variable_Type : Write_Log( ' String result variable.',
  1432.                                               FALSE, FALSE );
  1433.             Bad_Operand_Type     : Write_Log( 'Bad operand type.',
  1434.                                               FALSE, FALSE );
  1435.          END (* CASE *);
  1436.  
  1437.       END;
  1438. }
  1439. END   (* Check_Types *);
  1440.  
  1441.