home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s3.arc / PROCESS3.MOD < prev    next >
Text File  |  1988-02-19  |  48KB  |  1,407 lines
  1. (*----------------------------------------------------------------------*)
  2. (*            Dispose_Proc_Stuff --- Dispose of proc stuff              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Dispose_Proc_Stuff( Start, Last : INTEGER );
  6.  
  7. VAR
  8.    I: INTEGER;
  9.  
  10. BEGIN (* Dispose_Proc_Stuff *)
  11.  
  12.    FOR I := Start TO Last DO
  13.       IF ( Script_Procs[I].NArgs > 0 ) THEN
  14.          DISPOSE( Script_Procs[I].Type_Ptr );
  15.  
  16. END   (* Dispose_Proc_Stuff *);
  17.  
  18. (*----------------------------------------------------------------------*)
  19. (*            Label_Fixup --- Debug code for label fixups               *)
  20. (*----------------------------------------------------------------------*)
  21.  
  22. PROCEDURE Label_Fixup( IPos : INTEGER );
  23.  
  24. BEGIN (* Label_Fixup *)
  25. {--IMP
  26.    WRITELN( Script_Debug_File ,
  27.             '      Fixup at ', IPos:4,
  28.             ' to be ',NextP_Bytes[1]:4,
  29.             NextP_Bytes[2]:4, ' = ',NextP:8 );
  30. }
  31. END   (* Label_Fixup *);
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*           Emit_Proc --- Emit procedure call command                  *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. PROCEDURE Emit_Proc;
  38.  
  39. (*----------------------------------------------------------------------*)
  40. (*                                                                      *)
  41. (*     Procedure:  Emit_Proc                                            *)
  42. (*                                                                      *)
  43. (*     Purpose:    Emits procedure header code                          *)
  44. (*                                                                      *)
  45. (*     Calling Sequence:                                                *)
  46. (*                                                                      *)
  47. (*        Emit_Proc;                                                    *)
  48. (*                                                                      *)
  49. (*----------------------------------------------------------------------*)
  50.  
  51. VAR
  52.    I          : INTEGER;
  53.    J          : INTEGER;
  54.    QGotS      : BOOLEAN;
  55.    Token      : AnyStr;
  56.    PToken     : AnyStr;
  57.    Token_Type : OperandType;
  58.    Oper_Type  : OperType;
  59.    Index      : LONGINT;
  60.    NPArgs     : INTEGER;
  61.    PArgs      : Proc_Arg_Type_Vector;
  62.    PName      : ARRAY[1..MaxScriptArgs] OF STRING[12];
  63.    ProcName   : AnyStr;
  64.  
  65. BEGIN (* Emit_Proc *)
  66.                                    (* Assume command is bad.   *)
  67.    OK_Script_Command := FALSE;
  68.                                    (* Back up over ProcedureSy *)
  69.  
  70.    DEC( Script_Buffer_Pos );
  71.  
  72.                                    (* Increment count of defined procs *)
  73.  
  74.    INC( Script_Proc_Count );
  75.  
  76.                                    (* Increment procedure nesting level *)
  77.  
  78.    INC( Script_Proc_Level );
  79.  
  80.                                    (* since it must be called to be *)
  81.                                    (* executed.                     *)
  82.  
  83.    Copy_Byte_To_Buffer( ORD( GoToSy ) );
  84.  
  85.    Script_Proc_Start := SUCC( Script_Buffer_Pos );
  86.  
  87.    Copy_Integer_To_Buffer( 0 , IntegerConsOnly );
  88.  
  89.                                    (* Record information on this script level *)
  90.  
  91.    WITH Script_Proc_Stack[Script_Proc_Level] DO
  92.       BEGIN
  93.          Old_VCount := Script_Variable_Kount;
  94.          Old_PCount := Script_Proc_Count;
  95.          GOTO_Pos   := Script_Proc_Start;
  96.       END;
  97.                                    (* Pick up procedure name *)
  98.  
  99.    QGotS := Get_Next_Token( ProcName, Token_Type, Oper_Type, Index );
  100.  
  101.                                    (* Pick up procedure arguments *)
  102.    NPArgs := 0;
  103.    QGots  := TRUE;
  104.  
  105.    WHILE( QGots AND ( NPArgs <= MaxScriptArgs ) ) DO
  106.       BEGIN
  107.                                    (* Get next argument. *)
  108.  
  109.          QGots := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  110.  
  111.          IF QGots THEN
  112.             BEGIN
  113.                                    (* Increment argument count. *)
  114.  
  115.                INC( NPArgs );
  116.  
  117.                                    (* Must be a name type *)
  118.  
  119.                IF ( NOT ( Token_Type IN [String_Variable_Type,
  120.                                         Integer_Variable_Type] ) ) THEN
  121.                   BEGIN
  122.                      Parse_Error( Token + ' <-- ' + S12 );
  123.                      EXIT;
  124.                   END;
  125.  
  126.                PName[NPArgs] := Token;
  127.  
  128.             END;
  129.                                    (* Get argument type *)
  130.          IF QGotS THEN
  131.             BEGIN
  132.  
  133.                PToken := Token;
  134.  
  135.                QGots  := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  136.  
  137.                Token  := UpperCase( Token );
  138.  
  139.                IF ( Token = 'STRING' ) THEN
  140.                   PArgs[NPArgs] := String_Variable_Type
  141.                ELSE IF ( Token = 'INTEGER' ) THEN
  142.                   PArgs[NPArgs] := Integer_Variable_Type
  143.                ELSE
  144.                   BEGIN
  145.                      Parse_Error( S10 + 'type after ' + PToken );
  146.                      EXIT;
  147.                   END;
  148.  
  149.             END;
  150.  
  151.       END;
  152.                                    (* Generate declares for arguments *)
  153.    FOR I := 1 TO NPArgs DO
  154.       BEGIN
  155.          IF ( PArgs[I] = String_Variable_Type ) THEN
  156.             Token := 'STRING '
  157.          ELSE
  158.             Token := 'INTEGER ';
  159.          Copy_Byte_To_Buffer( ORD( PImportSy ) );
  160.          Script_Line        := PName[I] + ' ' + Token;
  161.          Length_Script_Line := LENGTH( Script_Line );
  162.          IS                 := 0;
  163.          OK_Script_Command  := Parse_Declare_Command;
  164.       END;
  165.                                    (* Record information on this script *)
  166.    OK_Script_Command := TRUE;
  167.  
  168.    WITH Script_Procs[Script_Proc_Count] DO
  169.      BEGIN
  170.         Name       := UpperCase( ProcName );
  171.         Buffer_Pos := Script_Proc_Start + SIZEOF( LONGINT );
  172.         NArgs      := NPargs;
  173.         IF ( NPArgs = 0 ) THEN
  174.            Type_Ptr   := NIL
  175.         ELSE
  176.            BEGIN
  177.               NEW( Type_Ptr );
  178.               IF ( Type_Ptr <> NIL ) THEN
  179.                  FOR I := 1 TO NPArgs DO
  180.                     Type_Ptr^[I] := PArgs[I]
  181.               ELSE
  182.                  OK_Script_Command := FALSE;
  183.            END;
  184.      END;
  185.  
  186. END   (* Emit_Proc *);
  187.  
  188. (*----------------------------------------------------------------------*)
  189. (*           Emit_Return --- Emit procedure return command              *)
  190. (*----------------------------------------------------------------------*)
  191.  
  192. PROCEDURE Emit_Return( EndType : AnyStr );
  193.  
  194. (*----------------------------------------------------------------------*)
  195. (*                                                                      *)
  196. (*     Procedure:  Emit_Return                                          *)
  197. (*                                                                      *)
  198. (*     Purpose:    Emits return from procedure code                     *)
  199. (*                                                                      *)
  200. (*     Calling Sequence:                                                *)
  201. (*                                                                      *)
  202. (*        Emit_Return( EndType : AnyStr );                              *)
  203. (*                                                                      *)
  204. (*----------------------------------------------------------------------*)
  205.  
  206. BEGIN (* Emit_Return *)
  207.                                    (* Back up over command *)
  208.  
  209.    DEC( Script_Buffer_Pos );
  210.  
  211.                                    (* See if we have an open procedure    *)
  212.  
  213.    IF ( Script_Proc_Level <= 0 ) THEN
  214.       BEGIN
  215.          Parse_Error( S15 + EndType );
  216.          OK_Script_Command := FALSE;
  217.          EXIT;
  218.       END;
  219.                                    (* Issue ZapVars for local variables *)
  220.  
  221.    WITH Script_Proc_Stack[Script_Proc_Level] DO
  222.       BEGIN
  223.          IF ( Script_Variable_Kount > Old_VCount ) THEN
  224.             BEGIN
  225.                Copy_Byte_To_Buffer( ORD( ZapVarSy ) );
  226.                Copy_Integer_To_Buffer( Old_VCount + 1        , IntegerConstant );
  227.                Copy_Integer_To_Buffer( Script_Variable_Kount , IntegerConstant );
  228.             END;
  229.       END;
  230.                                    (* Emit ReturnSy so run-time goes back *)
  231.  
  232.    Copy_Byte_To_Buffer( ORD( ReturnSy ) );
  233.  
  234. END   (* Emit_Return *);
  235.  
  236. (*----------------------------------------------------------------------*)
  237. (*           Emit_EndProc --- Emit end of procedure code                *)
  238. (*----------------------------------------------------------------------*)
  239.  
  240. PROCEDURE Emit_EndProc;
  241.  
  242. (*----------------------------------------------------------------------*)
  243. (*                                                                      *)
  244. (*     Procedure:  Emit_EndProc                                         *)
  245. (*                                                                      *)
  246. (*     Purpose:    Emits end of procedure code                          *)
  247. (*                                                                      *)
  248. (*     Calling Sequence:                                                *)
  249. (*                                                                      *)
  250. (*        Emit_EndProc;                                                 *)
  251. (*                                                                      *)
  252. (*----------------------------------------------------------------------*)
  253.  
  254. VAR
  255.    I          : INTEGER;
  256.    J          : INTEGER;
  257.    QGotS      : BOOLEAN;
  258.    Token      : AnyStr;
  259.    Token_Type : OperandType;
  260.    Oper_Type  : OperType;
  261.    Index      : INTEGER;
  262.  
  263. BEGIN (* Emit_EndProc *)
  264.                                    (* Issue ReturnSy *)
  265.    Emit_Return( 'ENDPROC' );
  266.                                    (* Issue ZapVars for any local variables *)
  267.                                    (* declared in procedure.  Also, return  *)
  268.                                    (* variable count to count prior to the  *)
  269.                                    (* procedure declaration.                *)
  270.  
  271.    WITH Script_Proc_Stack[Script_Proc_Level] DO
  272.       BEGIN
  273.          IF ( Script_Variable_Kount > Old_VCount ) THEN
  274.             Script_Variable_Kount := Old_VCount;
  275.          IF ( Script_Proc_Count > Old_PCount ) THEN
  276.             BEGIN
  277.                Dispose_Proc_Stuff( Old_PCount + 1 , Script_Proc_Count );
  278.                Script_Proc_Count := Old_PCount;
  279.             END;
  280.          Script_Proc_Start := GOTO_Pos;
  281.       END;
  282.  
  283.    DEC( Script_Proc_Level );
  284.  
  285.                                    (* Now we know where procedure ends, *)
  286.                                    (* do a fixup                        *)
  287.  
  288.    NextP := SUCC( Script_Buffer_Pos );
  289.  
  290.    MOVE( NextP, Script_Buffer^[ Script_Proc_Start ], SIZEOF( LONGINT ) );
  291.  
  292. {--IMP
  293.    IF Script_Debug_Mode THEN
  294.       Label_Fixup( Script_Proc_Start );
  295. }
  296. END   (* Emit_EndProc *);
  297.  
  298. (*----------------------------------------------------------------------*)
  299. (*           Emit_Call --- Emit procedure call command                  *)
  300. (*----------------------------------------------------------------------*)
  301.  
  302. PROCEDURE Emit_Call;
  303.  
  304. (*----------------------------------------------------------------------*)
  305. (*                                                                      *)
  306. (*     Procedure:  Emit_Call                                            *)
  307. (*                                                                      *)
  308. (*     Purpose:    Emits procedure call command                         *)
  309. (*                                                                      *)
  310. (*     Calling Sequence:                                                *)
  311. (*                                                                      *)
  312. (*        Emit_Call;                                                    *)
  313. (*                                                                      *)
  314. (*----------------------------------------------------------------------*)
  315.  
  316. VAR
  317.    I          : LONGINT;
  318.    J          : INTEGER;
  319.    QGotS      : BOOLEAN;
  320.    Token      : AnyStr;
  321.    Token_Type : OperandType;
  322.    Oper_Type  : OperType;
  323.    Index      : LONGINT;
  324.  
  325. BEGIN (* Emit_Call *)
  326.                                    (* Back up over CallSy *)
  327.  
  328.    DEC( Script_Buffer_Pos );
  329.  
  330.                                    (* Get name of procedure to call *)
  331.  
  332.    QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  333.  
  334.                                    (* Look up procedure name *)
  335.    J     := 0;
  336.  
  337.    Token := UpperCase( Token );
  338.  
  339.    FOR I := Script_Proc_Count DOWNTO 1 DO
  340.       IF ( Token = Script_Procs[I].Name ) THEN
  341.          J := I;
  342.                                    (* Error if not found *)
  343.    IF ( J = 0 ) THEN
  344.       BEGIN
  345.          OK_Script_Command := FALSE;
  346.          Parse_Error( S21 + Token + S5 );
  347.          EXIT;
  348.       END
  349.    ELSE
  350.       I := Script_Procs[J].Buffer_Pos;
  351.  
  352.    Process_Call_List( '', Token_Type, I, J, OK_Script_Command );
  353.  
  354. END   (* Emit_Call *);
  355.  
  356. (*----------------------------------------------------------------------*)
  357. (*   Parse_Script_Command --- Parse and convert script to internal code *)
  358. (*----------------------------------------------------------------------*)
  359.  
  360. PROCEDURE Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );
  361.  
  362. (*----------------------------------------------------------------------*)
  363. (*                                                                      *)
  364. (*     Procedure:  Parse_Script_Command                                 *)
  365. (*                                                                      *)
  366. (*     Purpose:    Parse and convert script line to internal code.      *)
  367. (*                                                                      *)
  368. (*     Calling Sequence:                                                *)
  369. (*                                                                      *)
  370. (*        Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );      *)
  371. (*                                                                      *)
  372. (*           OK_Script_Command --- set TRUE if legitimate command       *)
  373. (*                                                                      *)
  374. (*----------------------------------------------------------------------*)
  375.  
  376. VAR
  377.    Qnum       : BOOLEAN;
  378.    QGotS      : BOOLEAN;
  379.    IntVal     : LONGINT;
  380.    ByteVal    : BYTE;
  381.    L          : INTEGER;
  382.    I          : LONGINT;
  383.    J          : INTEGER;
  384.    Index      : LONGINT;
  385.    SvPos      : INTEGER;
  386.    Token      : AnyStr;
  387.    Token_Type : OperandType;
  388.    Oper_Type  : OperType;
  389.    IntType    : INTEGER;
  390.  
  391. (* STRUCTURED *) CONST
  392.    Handle_Mess : STRING[21] = 'Handle not specified';
  393.  
  394. (*----------------------------------------------------------------------*)
  395. (*     Get_File_Reference --- Get file reference in I/O statement       *)
  396. (*----------------------------------------------------------------------*)
  397.  
  398. PROCEDURE Get_File_Reference( Empty_Allowed : BOOLEAN );
  399.  
  400. VAR
  401.    File_Ref : LONGINT;
  402.    Ref_Type : INTEGER;
  403.  
  404. BEGIN (* Get_File_Reference *)
  405.  
  406.    SvPos    := IS;
  407.    File_Ref := 0;
  408.    Ref_Type := IntegerConstant;
  409.  
  410.    QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  411.  
  412.    IF ( NOT QGots ) THEN
  413.       IF Empty_Allowed THEN
  414.          IS := SvPos
  415.       ELSE
  416.          Parse_Error( Handle_Mess )
  417.    ELSE
  418.       CASE Token_Type OF
  419.  
  420.          Integer_Variable_Type : BEGIN
  421.                                     File_Ref := Index;
  422.                                     Ref_Type := IntegerVariable;
  423.                                  END;
  424.  
  425.          Integer_Constant_Type: BEGIN
  426.                                    File_Ref := Index;
  427.                                    Ref_Type := IntegerConstant;
  428.                                 END;
  429.  
  430.          ELSE                   IS       := SvPos;
  431.  
  432.       END (* CASE *);
  433.  
  434.    Copy_Integer_To_Buffer( File_Ref , Ref_Type );
  435.  
  436. END   (* Get_File_Reference *);
  437.  
  438. (*----------------------------------------------------------------------*)
  439. (*            Emit_EndIf --- Emit code for ENDIF statement              *)
  440. (*----------------------------------------------------------------------*)
  441.  
  442. PROCEDURE Emit_EndIf;
  443.  
  444. VAR
  445.    J : INTEGER;
  446.  
  447. BEGIN (* Emit_EndIf *)
  448.  
  449.    IF ( Script_If_Level > 0 ) THEN
  450.       BEGIN
  451.  
  452.          J := Script_If_Stack[ Script_If_Level ];
  453.          DEC( Script_If_Level );
  454.  
  455.                                    (* Fixup GoTo before ELSE or   *)
  456.                                    (* FALSE branch in original IF *)
  457.                                    (* if no else.                 *)
  458.  
  459.          NextP := Script_Buffer_Pos;
  460.  
  461.          IF ( J > 0 ) THEN
  462.             BEGIN
  463.  
  464.                MOVE( NextP, Script_Buffer^[ J ], SIZEOF( LONGINT ) );
  465. {--IMP
  466.                IF Script_Debug_Mode THEN
  467.                   Label_Fixup( J );
  468. }
  469.             END
  470.          ELSE
  471.             BEGIN
  472.  
  473.                J := -J;
  474.  
  475.                MOVE( NextP, Script_Buffer^[ J + False_Offset ], SIZEOF( LONGINT ) );
  476. {--IMP
  477.                IF Script_Debug_Mode THEN
  478.                   Label_Fixup( J + False_Offset );
  479. }
  480.             END;
  481.  
  482.                                    (* Erase EndIf from buffer *)
  483.  
  484.          DEC( Script_Buffer_Pos );
  485.  
  486.       END
  487.    ELSE
  488.       OK_Script_Command := FALSE;
  489.  
  490. END   (* Emit_EndIf *);
  491.  
  492. (*----------------------------------------------------------------------*)
  493. (*            Emit_Else --- Emit code for ELSE statement                *)
  494. (*----------------------------------------------------------------------*)
  495.  
  496. PROCEDURE Emit_Else;
  497.  
  498. VAR
  499.    J: INTEGER;
  500.  
  501. BEGIN (* Emit_Else *)
  502.  
  503.    IF ( Script_If_Level > 0 ) THEN
  504.       BEGIN
  505.  
  506.                                    (* Get address of IF statement *)
  507.                                    (* Remember offset is negative *)
  508.  
  509.          J := -Script_If_Stack[ Script_If_Level ];
  510.  
  511.                                    (* Back up over Else *)
  512.  
  513.          DEC( Script_Buffer_Pos );
  514.  
  515.                                    (* around FALSE code.          *)
  516.  
  517.          Copy_Byte_To_Buffer( ORD( GoToSy ) );
  518.  
  519.                                    (* Address of GoTo not defined   *)
  520.                                    (* since we don't know it yet -- *)
  521.                                    (* leave it zero, and stuff the  *)
  522.                                    (* address of cell to receive    *)
  523.                                    (* fixup address later on IF     *)
  524.                                    (* stack.                        *)
  525.  
  526.          Script_If_Stack[ Script_If_Level ] := SUCC( Script_Buffer_Pos );
  527.  
  528.          Copy_Integer_To_Buffer( 0 , IntegerConsOnly );
  529.  
  530.                                    (* Fixup FALSE branch address in IF *)
  531.  
  532.          NextP := SUCC( Script_Buffer_Pos );
  533.  
  534.          MOVE( NextP, Script_Buffer^[ J + False_Offset ], SIZEOF( LONGINT ) );
  535.  
  536. {--IMP
  537.          IF Script_Debug_Mode THEN
  538.             Label_Fixup( J + False_Offset );
  539. }
  540.       END
  541.    ELSE
  542.       OK_Script_Command := FALSE;
  543.  
  544. END   (* Emit_Else *);
  545.  
  546. (*----------------------------------------------------------------------*)
  547. (*            Emit_An_If --- Setup code for IF statement                *)
  548. (*----------------------------------------------------------------------*)
  549.  
  550. PROCEDURE Emit_An_If;
  551.  
  552. BEGIN (* Emit_An_If *)
  553.                                    (* Increment IF level *)
  554.  
  555.    INC( Script_If_Level );
  556.    Script_If_Stack[Script_If_Level]     := -Script_Buffer_Pos;
  557.    Script_ElseIf_Stack[Script_If_Level] := 0;
  558.  
  559.                                    (* Emit a conditional *)
  560.  
  561.    Emit_If_Command( 0 , OK_Script_Command );
  562.  
  563. END   (* Emit_An_If *);
  564.  
  565. (*----------------------------------------------------------------------*)
  566. (*            Emit_A_While --- Emit code for WHILE statement            *)
  567. (*----------------------------------------------------------------------*)
  568.  
  569. PROCEDURE Emit_A_While;
  570.  
  571. BEGIN (* Emit_A_While *)
  572. {--IMP
  573.    IF Script_Debug_Mode THEN
  574.       WRITELN( Script_Debug_File , 'Entered Emit_A_While' );
  575. }
  576.                                    (* Increment While level *)
  577.  
  578.    INC( Script_While_Level );
  579.    Script_While_Stack[Script_While_Level] := Script_Buffer_Pos;
  580.  
  581.                                    (* Emit conditional command *)
  582.  
  583.    Emit_If_Command( 0 , OK_Script_Command );
  584.  
  585. END   (* Emit_A_While *);
  586.  
  587. (*----------------------------------------------------------------------*)
  588. (*       Emit_An_EndWhile --- Emit code for ENDWHILE statement          *)
  589. (*----------------------------------------------------------------------*)
  590.  
  591. PROCEDURE Emit_An_EndWhile;
  592.  
  593. VAR
  594.    J: INTEGER;
  595.  
  596. BEGIN (* Emit_An_EndWhile *)
  597.  
  598.    IF ( Script_While_Level > 0 ) THEN
  599.       BEGIN
  600.  
  601.          J := Script_While_Stack[ Script_While_Level ];
  602.          DEC( Script_While_Level );
  603.  
  604.          Script_Buffer^[Script_Buffer_Pos] := ORD( GoToSy );
  605.          Copy_Integer_To_Buffer( J , IntegerConsOnly );
  606.  
  607.          NextP := SUCC( Script_Buffer_Pos );
  608.  
  609.          MOVE( NextP, Script_Buffer^[ J + False_Offset ], SIZEOF( LONGINT ) );
  610.  
  611. {--IMP
  612.          IF Script_Debug_Mode THEN
  613.             Label_Fixup( J + False_Offset );
  614. }
  615.       END
  616.    ELSE
  617.       Parse_Error( S15 + 'ENDWHILE');
  618.  
  619. END   (* Emit_An_EndWhile *);
  620.  
  621. (*----------------------------------------------------------------------*)
  622. (*           Emit_A_For --- Emit code for FOR statement                 *)
  623. (*----------------------------------------------------------------------*)
  624.  
  625. PROCEDURE Emit_A_For;
  626.  
  627. VAR
  628.    Ascending : BOOLEAN;
  629.    Dir_Chars : STRING[2];
  630.    L         : INTEGER;
  631.  
  632. BEGIN (* Emit_A_For *)
  633.                                    (* Generate initial SET *)
  634.    DEC( Script_Buffer_Pos );
  635.  
  636.    Copy_Byte_To_Buffer( ORD( SetSy ) );
  637.  
  638.    IS := 0;
  639.  
  640.    Ascending := ( POS( 'DOWNTO' , UpperCase( Script_Line ) ) = 0 );
  641.  
  642.    CASE Ascending OF
  643.       TRUE:  BEGIN
  644.                 OK_Script_Command := Parse_Set_Command( 'TO' );
  645.                 Dir_Chars         := '<=';
  646.              END;
  647.       FALSE: BEGIN
  648.                 OK_Script_Command := Parse_Set_Command( 'DOWNTO' );
  649.                 Dir_Chars         := '>=';
  650.              END;
  651.    END (* CASE *);
  652. {
  653. IF Script_Debug_Mode THEN
  654.    BEGIN
  655.       WRITELN( Script_Debug_File, 'IS = ',IS,' after generating SET for FOR');
  656.       WRITELN( Script_Debug_File, 'Script_Line = <', Script_Line, '>');
  657.    END;
  658. }
  659.                                    (* If OK, generate WHILE *)
  660.    IF OK_Script_Command THEN
  661.       BEGIN
  662.                                    (* Get termination condition.       *)
  663.                                    (* We need to strip the trailing DO *)
  664.                                    (* if it appears.                   *)
  665.  
  666.          Script_Line := Trim( COPY( Script_Line, SUCC( IS ),
  667.                                       Length_Script_Line - IS ) );
  668. {
  669.          IF Script_Debug_Mode THEN
  670.             WRITELN( Script_Debug_File, 'Script_Line = <', Script_Line, '>');
  671. }
  672.          L           := LENGTH( Script_Line );
  673.  
  674.          IF ( UpperCase( COPY( Script_Line, L - 1, 2 ) ) = 'DO' ) THEN
  675.             Script_Line := COPY( Script_Line, 1, L - 2 );
  676. {
  677.          IF Script_Debug_Mode THEN
  678.                WRITELN( Script_Debug_File, 'Script_Line = <', Script_Line, '>');
  679. }
  680.          Script_Line := '( ' +
  681.                         Script_Vars[Result_Index].Var_Name +
  682.                         Dir_Chars +
  683.                         Script_Line +
  684.                         ' ) DO ';
  685. {--IMP
  686.          IF Script_Debug_Mode THEN
  687.             BEGIN
  688.                WRITELN( Script_Debug_File ,
  689.                         '      For generates <',
  690.                         Script_Line,'>' );
  691.             END;
  692. }
  693.          Length_Script_Line := LENGTH( Script_Line );
  694.          IS                 := 0;
  695.  
  696.          INC( Script_Buffer_Pos );
  697.  
  698.          Emit_A_While;
  699.  
  700.          IF OK_Script_Command THEN
  701.             BEGIN
  702.                INC( Script_For_Level );
  703.                IF ( NOT Ascending ) THEN
  704.                   Result_Index := (-Result_Index);
  705.                Script_For_Stack[Script_For_Level] := Result_Index;
  706.             END;
  707.  
  708.       END;
  709.  
  710. END   (* Emit_A_For *);
  711.  
  712. (*----------------------------------------------------------------------*)
  713. (*           Emit_An_EndFor --- Emit code for ENDFOR statement          *)
  714. (*----------------------------------------------------------------------*)
  715.  
  716. PROCEDURE Emit_An_EndFor;
  717.  
  718. VAR
  719.    I         : INTEGER;
  720.    Dir_Chars : STRING[4];
  721.  
  722. BEGIN (* Emit_An_EndFor *)
  723.                                    (* Generate SET Statement *)
  724.  
  725.    IF ( Script_For_Level > 0 ) THEN
  726.       BEGIN
  727.  
  728.          I := Script_For_Stack[Script_For_Level];
  729.  
  730.          IF ( I > 0 ) THEN
  731.             Dir_Chars := '+ 1 '
  732.          ELSE
  733.             BEGIN
  734.                Dir_Chars := '- 1 ';
  735.                I         := -I;
  736.             END;
  737.  
  738.          DEC( Script_For_Level );
  739.  
  740.          Script_Line         := Script_Vars[I].Var_Name +
  741.                                 '=' +
  742.                                 Script_Vars[I].Var_Name +
  743.                                 Dir_Chars;
  744.  
  745.          DEC( Script_Buffer_Pos );
  746.  
  747.          Copy_Byte_To_Buffer( ORD( SetSy ) );
  748.  
  749.          IS                  := 0;
  750.          Length_Script_Line  := LENGTH( Script_Line );
  751.          OK_Script_Command   := Parse_Set_Command( '' );
  752. {
  753.          IF Script_Debug_Mode THEN
  754.             BEGIN
  755.                WRITELN( Script_Debug_File ,
  756.                         '      EndFor generates <',
  757.                         Script_Line,'>' );
  758.             END;
  759. }
  760.                                    (* Generate ENDWHILE command *)
  761.  
  762.          INC( Script_Buffer_Pos );
  763.  
  764.          Emit_An_EndWhile;
  765.  
  766.       END
  767.    ELSE
  768.       Parse_Error( S15 + 'ENDFOR' );
  769.  
  770. END   (* Emit_An_EndFor *);
  771.  
  772. (*----------------------------------------------------------------------*)
  773. (*               Emit_Menu --- Emit code for MENU statement             *)
  774. (*----------------------------------------------------------------------*)
  775.  
  776. PROCEDURE Emit_Menu;
  777.  
  778. VAR
  779.    Qnum    : BOOLEAN;
  780.    IntVal  : LONGINT;
  781.    IntType : INTEGER;
  782.    ICountP : INTEGER;
  783.    SCount  : BYTE;
  784.    QGotS   : BOOLEAN;
  785.    MaxP    : INTEGER;
  786.    I       : LONGINT;
  787.  
  788. BEGIN (* Emit_Menu *)
  789.                                    (* Get variable index to receive *)
  790.                                    (* menu index                    *)
  791.    OK_Script_Command := FALSE;
  792.  
  793.    Get_Integer( QNum, I, IntType, TRUE );
  794.  
  795.    IF ( NOT Qnum ) THEN
  796.       BEGIN
  797.          IF ( IntType = IntegerMissing ) THEN
  798.             Parse_Error( S8 + COPY( S9, 2, LENGTH( S9 ) - 1 ) );
  799.          EXIT;
  800.       END;
  801.                                    (* Copy result index to buffer *)
  802.  
  803.    Copy_Integer_To_Buffer( I , IntType );
  804.  
  805.                                    (* Get column position *)
  806.  
  807.    Get_Integer( QNum, I, IntType, FALSE );
  808.    Copy_Integer_To_Buffer( I , IntType );
  809.  
  810.                                    (* Get row position *)
  811.  
  812.    Get_Integer( QNum, I, IntType, FALSE );
  813.    Copy_Integer_To_Buffer( I , IntType );
  814.  
  815.                                    (* Get default item *)
  816.  
  817.    Get_Integer( QNum, I, IntType, FALSE );
  818.    Copy_Integer_To_Buffer( I , IntType );
  819.  
  820.                                    (* Get title        *)
  821.  
  822.    Get_And_Copy_String_To_Buffer( FALSE , FALSE, QGotS );
  823.  
  824.                                    (* Leave space for # menu items *)
  825.    ICountP  := Script_Buffer_Pos;
  826.    Copy_Byte_To_Buffer( 0 );
  827.                                    (* Get menu item strings;   *)
  828.                                    (* may be strings or string *)
  829.                                    (* variables.               *)
  830.    OK_Script_Command := TRUE;
  831.    SCount            := 0;
  832.    QGots             := TRUE;
  833.                                    (* Get legitimate waitstrings *)
  834.  
  835.    WHILE( QGots AND OK_Script_Command AND ( SCount <= Max_Menu_Items ) ) DO
  836.       BEGIN
  837.          Get_And_Copy_String_To_Buffer( FALSE , FALSE, QGotS );
  838.          IF QGots THEN
  839.             INC( SCount );
  840.       END;
  841.                                    (* Enter count into buffer *)
  842.  
  843.    IntVal            := Script_Buffer_Pos;
  844.    Script_Buffer_Pos := ICountP;
  845.  
  846.    Copy_Byte_To_Buffer( SCount );
  847.  
  848.    Script_Buffer_Pos := IntVal;
  849.  
  850. END   (* Emit_Menu *);
  851.  
  852. (*----------------------------------------------------------------------*)
  853.  
  854. BEGIN (* Parse_Script_Command *)
  855.                                    (* Assume command is OK to start   *)
  856.    OK_Script_Command := TRUE;
  857.                                    (* Insert command type into buffer *)
  858.  
  859.    Copy_Byte_To_Buffer( ORD( Current_Script_Command ) );
  860.  
  861.                                    (* Pick up and insert command-dependent *)
  862.                                    (* information into script buffer.      *)
  863.    IS := 0;
  864.  
  865.    CASE Current_Script_Command OF
  866.  
  867.        AddCommandSy: IF Get_Next_Token( Token, Token_Type, Oper_Type, Index ) THEN
  868.                         IF ( Script_New_Command_Count < MaxNewCommands ) THEN
  869.                            BEGIN
  870.                               INC( Script_New_Command_Count );
  871.                               Script_New_Commands[Script_New_Command_Count] :=
  872.                                  UpperCase( Trim( Token ) );
  873.                               DEC( Script_Buffer_Pos );
  874.                            END
  875.                         ELSE
  876.                               Parse_Error('No room to store new command definition.')
  877.                      ELSE
  878.                         Parse_Error( S10 + 'new command name to define.');
  879.  
  880.        ImportSy    : IF ( Script_Proc_Count > 0 ) THEN
  881.                         IF ( Script_Proc_Level = 0 ) THEN
  882.                            BEGIN
  883.                               OK_Script_Command := FALSE;
  884.                               Parse_Error( 'IMPORT' + S22 );
  885.                            END
  886.                         ELSE
  887.                            BEGIN
  888.                               OK_Script_Command := FALSE;
  889.                               Parse_Error( S23 );
  890.                            END
  891.                      ELSE
  892.                         BEGIN
  893.                            OK_Script_Command := Parse_Declare_Command;
  894.                            IF OK_Script_Command THEN
  895.                               INC( Import_Count );
  896.                         END;
  897.  
  898.        DeclareSy   : IF ( ( Script_Proc_Count > 0 ) AND
  899.                           ( Script_Proc_Level = 0 ) ) THEN
  900.                         BEGIN
  901.                            OK_Script_Command := FALSE;
  902.                            Parse_Error( 'DECLARE' + S22 );
  903.                         END
  904.                      ELSE
  905.                         OK_Script_Command := Parse_Declare_Command;
  906.  
  907.        SuspendSy   ,
  908.        DelaySy     ,
  909.        WaitCountSy ,
  910.        WaitQuietSy : BEGIN
  911.                         Get_Integer( Qnum, IntVal, IntType, FALSE );
  912.                         IF ( NOT Qnum ) THEN
  913.                            BEGIN
  914.                               IntVal  := 1;
  915.                               IntType := IntegerConstant;
  916.                            END;
  917.                         Copy_Integer_To_Buffer( IntVal , IntType );
  918.                      END;
  919.  
  920.        CaptureSy   ,
  921.        CopyFileSy  ,
  922.        FreeSpaceSy ,
  923.        GetDirSy    ,
  924.        GetParamSy  ,
  925.        KeyDefSy    ,
  926.        ReceiveSy   ,
  927.        SendSy      ,
  928.        SetParamSy  ,
  929.        SetVarSy    ,
  930.        WhenSy      : BEGIN
  931.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  932.                         IF OK_Script_Command THEN
  933.                            Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  934.                      END;
  935.  
  936.        DialSy      : BEGIN
  937.  
  938.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  939.  
  940.                         IF OK_Script_Command THEN
  941.  
  942.                                    (* See if NOSCRIPT appears *)
  943.  
  944.                            QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  945.  
  946.                         IF ( UpperCase( Token ) = 'NOSCRIPT' ) THEN
  947.                            I := 1
  948.                         ELSE
  949.                            I := 0;
  950.                                    (* Insert noscript flag in buffer *)
  951.  
  952.                         Copy_Integer_To_Buffer( I , IntegerConsOnly );
  953.  
  954.  
  955.                      END;
  956.  
  957.        ChDirSy     ,
  958.        DosSy       ,
  959.        EditFileSy  ,
  960.        EraseFileSy ,
  961.        KeySy       ,
  962.        KeySendSy   ,
  963.        MessageSy   ,
  964.        PrintFileSy ,
  965.        ReDialSy    ,
  966.        STextSy     ,
  967.        TextSy      ,
  968.        TranslateSy ,
  969.        ViewFileSy  ,
  970.        WaitSy      ,
  971.        WhenDropSy  ,
  972.        WriteLogSy  : Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  973.  
  974.        InputSy     : BEGIN
  975.                                    (* Copy prompt string to script buffer *)
  976.  
  977.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  978.  
  979.                                    (* See if variable name follows.  If so, *)
  980.                                    (* that will be receiving variable.      *)
  981.                                    (* If not, just leave in standard input  *)
  982.                                    (* buffer.                               *)
  983.  
  984.                         IF ( OK_Script_Command ) THEN
  985.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  986.  
  987.  
  988.                      END;
  989.  
  990.        RInputSy    : BEGIN
  991.                                    (* Copy prompt string to script buffer *)
  992.  
  993.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  994.  
  995.                                    (* Assume echo mode *)
  996.                         I := 1;
  997.                                    (* See if NOECHO appears *)
  998.  
  999.                         QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  1000.  
  1001.                         IF ( UpperCase( Token ) = 'NOECHO' ) THEN
  1002.                            I := 0;
  1003.  
  1004.                                    (* Insert echo/noecho flag in buffer *)
  1005.  
  1006.                         Copy_Integer_To_Buffer( I , IntegerConsOnly );
  1007.  
  1008.                                    (* See if var name follows.          *)
  1009.  
  1010.                         IF OK_Script_Command THEN
  1011.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1012.  
  1013.  
  1014.                      END;
  1015.  
  1016.        IfOpSy      : Emit_An_If;
  1017.  
  1018.        ElseSy      : Emit_Else;
  1019.  
  1020.        EndIfSy     : Emit_Endif;
  1021.  
  1022.        GoToXYSy    : BEGIN
  1023.                         Get_Integer( QNum, I, IntType, FALSE );
  1024.                         IF ( NOT Qnum ) THEN
  1025.                            BEGIN
  1026.                               IntVal  := 1;
  1027.                               IntType := IntegerConstant;
  1028.                            END;
  1029.                         Copy_Integer_To_Buffer( I , IntType );
  1030.                         Get_Integer( QNum, I, IntType, FALSE );
  1031.                         IF ( NOT Qnum ) THEN
  1032.                            BEGIN
  1033.                               IntVal  := 1;
  1034.                               IntType := IntegerConstant;
  1035.                            END;
  1036.                         Copy_Integer_To_Buffer( I , IntType );
  1037.                      END;
  1038.  
  1039.        WaitStrSy   : Emit_Wait_String_Command( OK_Script_Command );
  1040.  
  1041.        SetSy       : BEGIN
  1042.                         IS                := 0;
  1043.                         OK_Script_Command := Parse_Set_Command( '' );
  1044.                      END;
  1045.  
  1046.        RepeatSy    : BEGIN
  1047.                                    (* Increment repeat level *)
  1048.  
  1049.                         INC( Script_Repeat_Level );
  1050.  
  1051.                                    (* Remember where repeat starts. *)
  1052.  
  1053.                         Script_Repeat_Stack[Script_Repeat_Level] :=
  1054.                            Script_Buffer_Pos;
  1055.  
  1056.                                    (* Erase repeat command *)
  1057.  
  1058.                         DEC( Script_Buffer_Pos );
  1059.  
  1060.  
  1061.                      END;
  1062.  
  1063.        UntilSy     : BEGIN
  1064.                         IF ( Script_Repeat_Level > 0 ) THEN
  1065.                            BEGIN
  1066.  
  1067.                                    (* Pop REPEAT address off stack *)
  1068.  
  1069.                               J := Script_Repeat_Stack[ Script_Repeat_Level ];
  1070.                               DEC( Script_Repeat_Level );
  1071.  
  1072.                                    (* Emit end of loop test *)
  1073.  
  1074.                               Emit_If_Command( J , OK_Script_Command );
  1075.  
  1076.                           END
  1077.                         ELSE
  1078.                            OK_Script_Command := FALSE;
  1079.  
  1080.  
  1081.                      END;
  1082.  
  1083.        WhileSy     : Emit_A_While;
  1084.  
  1085.        EndWhileSy  : Emit_An_EndWhile;
  1086.  
  1087.        ParamSy     : BEGIN
  1088.  
  1089.                         QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  1090.  
  1091.                         Copy_Byte_To_Buffer( ORD( Token[1] ) );
  1092.                         Copy_Byte_To_Buffer( ORD( Token[2] ) );
  1093.  
  1094.                         QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  1095.  
  1096.                         IF ( Token <> '=' ) THEN
  1097.                            Parse_Error( S10 + '=' )
  1098.                         ELSE
  1099.                            BEGIN
  1100.                               Token := COPY( Script_Line, IS + 1,
  1101.                                                Length_Script_Line - IS );
  1102.                               L     := LENGTH( Token );
  1103.                               Copy_Byte_To_Buffer( L );
  1104.                               FOR I := 1 TO L DO
  1105.                                  Copy_Byte_To_Buffer( ORD( Token[I] ) );
  1106.                            END;
  1107.  
  1108.  
  1109.                      END;
  1110.  
  1111.        ProcedureSy : Emit_Proc;
  1112.  
  1113.        EndProcSy   : Emit_EndProc;
  1114.  
  1115.        CallSy      : Emit_Call;
  1116.  
  1117.        ScriptSy    : BEGIN
  1118.  
  1119.                         QGotS := Get_Next_Token( Token, Token_Type, Oper_Type, Index );
  1120.  
  1121.                         Copy_Byte_To_Buffer( ORD( Token[1] ) );
  1122.  
  1123.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1124.  
  1125.                      END;
  1126.  
  1127.        CloseSy     : BEGIN
  1128.  
  1129.                         Get_Integer( QNum, I, IntType, FALSE );
  1130.  
  1131.                         IF ( NOT Qnum ) THEN
  1132.                            Parse_Error( Handle_Mess );
  1133.  
  1134.                         Copy_Integer_To_Buffer( I , IntType );
  1135.  
  1136.                      END;
  1137.  
  1138.        ReadLnSy    : BEGIN
  1139.  
  1140.                         Get_File_Reference( FALSE );
  1141.  
  1142.                         Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1143.  
  1144.                      END;
  1145.  
  1146.        ReadSy      : BEGIN
  1147.  
  1148.                         Get_File_Reference( FALSE );
  1149.  
  1150.                         Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1151.  
  1152.                         Get_Integer( QNum, I, IntType, FALSE );
  1153.  
  1154.                         IF ( NOT Qnum ) THEN
  1155.                            I := 1;
  1156.  
  1157.                         Copy_Integer_To_Buffer( I , IntType );
  1158.  
  1159.                      END;
  1160.  
  1161.        WriteSy,
  1162.        WriteLnSy   : BEGIN
  1163.  
  1164.                         Get_File_Reference( TRUE );
  1165.  
  1166.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1167.  
  1168.                      END;
  1169.  
  1170.        OpenSy      : BEGIN
  1171.  
  1172.                         Get_Integer( QNum, I, IntType, FALSE );
  1173.  
  1174.                         IF ( NOT Qnum ) THEN
  1175.                            Parse_Error( Handle_Mess );
  1176.  
  1177.                         Copy_Integer_To_Buffer( I , IntType );
  1178.  
  1179.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1180.  
  1181.                         IF ( NOT Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  1182.                            Parse_Error( S10 + '"input", "output", or "append"' )
  1183.                         ELSE
  1184.                            BEGIN
  1185.                               CASE UpCase(Token[1]) OF
  1186.                                  'I':  I := 0;
  1187.                                  'A':  I := 2;
  1188.                               ELSE
  1189.                                  I := 1;
  1190.                               END (* CASE *);
  1191.                               Copy_Integer_To_Buffer( I , IntType );
  1192.                            END;
  1193.  
  1194.                      END;
  1195.  
  1196.        DoCaseSy    : BEGIN
  1197.                                    (* Back up over DoCaseSy *)
  1198.  
  1199.                         DEC( Script_Buffer_Pos );
  1200.  
  1201.                                    (* Increment count of defined cases *)
  1202.  
  1203.                         INC( Script_Case_Level );
  1204.  
  1205.                                    (* Pick up case variable name *)
  1206.  
  1207.                         IF ( NOT Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  1208.                            Parse_Error( S10 + 'case variable.' )
  1209.                         ELSE
  1210.                            BEGIN
  1211.                               IF ( Token_Type IN [String_Variable_Type,
  1212.                                                   Integer_Variable_Type] ) THEN
  1213.                                  BEGIN
  1214.                                     Script_Case_Var_Stack[Script_Case_Level] := Index;
  1215.                                     Script_Case_Cnt_Stack[Script_Case_Level] := 0;
  1216.                                  END
  1217.                               ELSE
  1218.                                  Parse_Error( S18 + Token + S3 );
  1219.                            END;
  1220.  
  1221.  
  1222.                      END;
  1223.  
  1224.        EndDoCaseSy : BEGIN
  1225.  
  1226.                         IF ( Script_Case_Level > 0 ) THEN
  1227.                            BEGIN
  1228.                               FOR J := 1 TO Script_Case_Cnt_Stack[Script_Case_Level] DO
  1229.                                  BEGIN
  1230.                                     Emit_EndIf;
  1231.                                     INC( Script_Buffer_Pos );
  1232.                                  END;
  1233.                               DEC( Script_Case_Level );
  1234.                               DEC( Script_Buffer_Pos );
  1235.                            END
  1236.                         ELSE
  1237.                            Parse_Error( S15 + 'ENDDOCASE' );
  1238.  
  1239.                      END;
  1240.  
  1241.        CaseSy      : BEGIN
  1242.                                    (* See if this is ELSE -- in which *)
  1243.                                    (* case, generate nothing.         *)
  1244.  
  1245.                         IF ( NOT Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  1246.                            Parse_Error( S10 + 'case expression.' )
  1247.  
  1248.                         ELSE IF ( UpperCase( Token ) <> 'ELSE') THEN
  1249.                            BEGIN
  1250.  
  1251.                                    (* Increment count of cases found  *)
  1252.  
  1253.                               INC( Script_Case_Cnt_Stack[Script_Case_Level] );
  1254.  
  1255.                                    (* Increment IF level *)
  1256.  
  1257.                               INC( Script_If_Level );
  1258.                               Script_If_Stack[Script_If_Level] :=
  1259.                                  -Script_Buffer_Pos;
  1260.  
  1261.                                    (* Generate IF Statement *)
  1262.  
  1263.                               I := Script_Case_Var_Stack[Script_Case_Level];
  1264.  
  1265.                               Script_Line := '(' +
  1266.                                              Script_Vars[I].Var_Name +
  1267.                                              '=' + Script_Line + ') THEN ';
  1268.  
  1269.                               IS                 := 0;
  1270.                               Length_Script_Line := LENGTH( Script_Line );
  1271. {--IMP
  1272.                               IF Script_Debug_Mode THEN
  1273.                                  BEGIN
  1274.                                     WRITELN( Script_Debug_File ,
  1275.                                              '      Case generates <',
  1276.                                              Script_Line,'>' );
  1277.                                  END;
  1278. }
  1279.                                    (* Emit a conditional *)
  1280.  
  1281.                               Emit_If_Command( 0 , OK_Script_Command );
  1282.  
  1283.                            END
  1284.                         ELSE
  1285.                            Script_Case_Var_Stack[Script_Case_Level] := 0;
  1286.  
  1287.                      END;
  1288.  
  1289.        EndCaseSy   : IF ( Script_Case_Var_Stack[Script_Case_Level] <> 0 ) THEN
  1290.                         Emit_Else
  1291.                      ELSE
  1292.                         DEC( Script_Buffer_Pos );
  1293.  
  1294.        ForSy       : Emit_A_For;
  1295.  
  1296.        EndForSy    : Emit_An_EndFor;
  1297.  
  1298.        WhereXYSy   : BEGIN
  1299.  
  1300.                         Get_Integer( QNum, I, IntType, TRUE );
  1301.  
  1302.                         Copy_Integer_To_Buffer( I , IntType );
  1303.  
  1304.                         Get_Integer( QNum, I, IntType, TRUE );
  1305.  
  1306.                         Copy_Integer_To_Buffer( I , IntType );
  1307.  
  1308.  
  1309.                      END;
  1310.  
  1311.        ExecuteSy   : Emit_Execute_Command ( OK_Script_Command );
  1312.  
  1313.        WaitListSy  : Emit_WaitList_Command( OK_Script_Command );
  1314.  
  1315.        ExeNewSy    : BEGIN
  1316.  
  1317.                         Copy_String_To_Buffer( Script_Command_Token, String_Constant_Type, 0 );
  1318.  
  1319.                         Copy_String_To_Buffer( Script_Line, String_Constant_Type, 0 );
  1320.  
  1321.                      END;
  1322.  
  1323.        WaitTimeSy  : BEGIN
  1324.  
  1325.                         Get_Integer( QNum, I, IntType, FALSE );
  1326.  
  1327.                         IF ( NOT QNum ) THEN
  1328.                            BEGIN
  1329.                               I       := 30;
  1330.                               IntType := IntegerConstant;
  1331.                            END;
  1332.  
  1333.                         Copy_Integer_To_Buffer( I , IntType );
  1334.  
  1335.                      END;
  1336.  
  1337.        CommDrainSy : BEGIN
  1338.  
  1339.                         Get_Integer( QNum, I, IntType, FALSE );
  1340.  
  1341.                         IF ( NOT QNum ) THEN
  1342.                            BEGIN
  1343.                               I       := 5;
  1344.                               IntType := IntegerConstant;
  1345.                            END;
  1346.  
  1347.                         Copy_Integer_To_Buffer( I , IntType );
  1348.  
  1349.                      END;
  1350.  
  1351.        CommFlushSy : BEGIN
  1352.  
  1353.                         IF ( NOT Get_Next_Token( Token, Token_Type, Oper_Type, Index ) ) THEN
  1354.                            I := 3
  1355.                         ELSE
  1356.                            BEGIN
  1357.                               CASE UpCase(Token[1]) OF
  1358.                                  'I':  I := 1;
  1359.                                  'O':  I := 2;
  1360.                                  'B':  I := 3;
  1361.                                  ELSE  I := 1;
  1362.                               END (* CASE *);
  1363.                            END;
  1364.  
  1365.                         Copy_Integer_To_Buffer( I , IntType );
  1366.  
  1367.                      END;
  1368.  
  1369.        MenuSy      : Emit_Menu;
  1370.  
  1371.        ReturnSy    : Emit_Return( 'RETURN' );
  1372.  
  1373.        GetVarSy    : BEGIN
  1374.                         Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1375.                         IF OK_Script_Command THEN
  1376.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1377.                         IF OK_Script_Command THEN
  1378.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1379.                      END;
  1380.  
  1381.        DirFirstSy,
  1382.        DirNextSy   : BEGIN
  1383.                         IF ( Current_Script_Command = DirFirstSy ) THEN
  1384.                            BEGIN
  1385.                               Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1386.                               IF OK_Script_Command THEN
  1387.                                  Get_And_Copy_String_To_Buffer( FALSE , TRUE, QGotS );
  1388.                            END;
  1389.                         IF OK_Script_Command THEN
  1390.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1391.                         IF OK_Script_Command THEN
  1392.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1393.                         IF OK_Script_Command THEN
  1394.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1395.                         IF OK_Script_Command THEN
  1396.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1397.                         IF OK_Script_Command THEN
  1398.                            Get_And_Copy_String_To_Buffer( TRUE , TRUE, QGotS );
  1399.                      END;
  1400.  
  1401.        ELSE;
  1402.  
  1403.    END (* CASE *);
  1404.  
  1405. END   (* Parse_Script_Command *);
  1406.  
  1407.