home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG030.ARK / BASSYN.PLM < prev    next >
Text File  |  1984-04-29  |  55KB  |  1,640 lines
  1. BASSYN:
  2. DO;
  3.  /* SYMBOL TABLE AND CODE SYNTHESIS MODULE */
  4. $INCLUDE (:F1:BASCOM.LIT)
  5.  
  6.  /* EXTERNAL PROCEDURES (DEFINED IN BASIC.PLM) */
  7. MON3: PROCEDURE EXTERNAL;
  8.     END MON3;
  9.  
  10. MOVE: PROCEDURE(S,D,C) EXTERNAL;
  11.     DECLARE (S,D) ADDRESS, C BYTE;
  12.     END MOVE;
  13.  
  14. FILL: PROCEDURE(D,CH,CNT) EXTERNAL;
  15.     DECLARE D ADDRESS, (CH, CNT) BYTE;
  16.     END FILL;
  17.  
  18. EMIT: PROCEDURE(C) EXTERNAL;
  19.     DECLARE C BYTE;
  20.     END EMIT;
  21.  
  22. SETFLAGS: PROCEDURE EXTERNAL;
  23.     END SETFLAGS;
  24.  
  25. SETUP$INT$FILE: PROCEDURE EXTERNAL;
  26.     END SETUP$INT$FILE;
  27.  
  28. ERROR: PROCEDURE(ERR) EXTERNAL;
  29.     DECLARE ERR ADDRESS;
  30.     END ERROR;
  31.  
  32. SCANNER: PROCEDURE EXTERNAL;
  33.     END SCANNER;
  34.  
  35. PRINT: PROCEDURE(A) EXTERNAL;
  36.     DECLARE A ADDRESS;
  37.     END PRINT;
  38.  
  39. PRINT$DEC: PROCEDURE(VAL) EXTERNAL;
  40.     DECLARE VAL ADDRESS;
  41.     END PRINT$DEC;
  42.  
  43. CRLF: PROCEDURE EXTERNAL;
  44.     END CRLF;
  45.  
  46. REWIND$SOURCE$FILE: PROCEDURE EXTERNAL;
  47.     END REWIND$SOURCE$FILE;
  48.  
  49. GETCHAR: PROCEDURE BYTE EXTERNAL;
  50.     END GETCHAR;
  51.  
  52. WRITE$INT$FILE: PROCEDURE EXTERNAL;
  53.     END WRITE$INT$FILE;
  54.  
  55. CLOSE$INT$FILE: PROCEDURE EXTERNAL;
  56.     END CLOSE$INT$FILE;
  57.  
  58.  
  59.         /*
  60.          *********************************************************
  61.          *                                                       *
  62.          *    SYMBOL TABLE PROCEDURES                            *
  63.          *                                                       *
  64.          *    THE SYMBOL TABLE IS BUILT FROM .MEMORY TOWARD      *
  65.          *    THE LARGEST USABLE ADDRESS WHICH IS STORED IN MAX. *
  66.          *    INFORMATION REQUIRED DURING FOR STATEMENT CODE     *
  67.          *    GENERATION IS MAINTAINED STARTING AT MAX AND       *
  68.          *    WORKING DOWN TOWARD THE TOP OF THE SYMBOL TABLE    *
  69.          *    THE FOLLOWING ARE MAJOR GLOBAL VARIABLES USED      *
  70.          *    BY THE SYMBOL TABLE AND THEIR MEANING:             *
  71.          *         SBTBLTOP - CURRENT POSITION OF FOR/NEXT       *
  72.          *                    STACK.                             *
  73.          *         SBTBL - CURRENT "TOP" OF SYMBOL TABLE         *
  74.          *         BASE - ADDRESS OF BEGINNING OF ENTRY. THIS    *
  75.          *                MUST BE SET BEFORE AN ENTRY MAY BE     *
  76.          *                ACCESSED.                              *
  77.          *         PRINTNAME - ADDRESS OF PRINTNAME OF AN ENTRY  *
  78.          *                     TO BE USED IN REFERENCE TO THE    *
  79.          *                     SYMBOL TABLE.                     *
  80.          *         SYMHASH - HASH OF TOKEN REFERENCE BY          *
  81.          *                   PRINTNAME                           *
  82.          *                                                       *
  83.          *    THE FOLLOWING IS THE STRUCTURE OF A SYMBOL         *
  84.          *    TABLE ENTRY:                                       *
  85.          *           LENGTH OF PRINTNAME   - 1 BYTE              *
  86.          *           COLLISION FIELD  -  2 BYTES                 *
  87.          *           PRINTNAME    -  VARIABLE LENGTH             *
  88.          *           TYPE   -  1 BYTE                            *
  89.          *               LEFTMOST BIT OF THIS BYTE IS A FLAG     *
  90.          *               TO INDICATE IF THE ADDRESS HAS BEEN     *
  91.          *               SET.                                    *
  92.          *           LOCATION - 2 BYTES                          *
  93.          *           SUBTYPE - 1 BYTES                           *
  94.          *                                                       *
  95.          *      THE FOLLOWING GLOBAL ROUTINES ARE PROVIDED       *
  96.          *      FOR SYMBOL TABLE MANIPULATION:                   *
  97.          *         LOOKUP      ENTER     GETLEN     GETYPE       *
  98.          *         SETYPE      GETRES    GETADDR    SETADDR      *
  99.          *         SETSUBTYPE  GETSUBTYPE UNLINK    RELINK       *
  100.          *                                                       *
  101.          *********************************************************
  102.         */
  103.  
  104.  
  105.  
  106.  /* GLOBAL VARIABLES (DEFINED IN BASIC.PLM) */
  107. DECLARE
  108.     BEXT LITERALLY 'BYTE EXTERNAL',
  109.     AEXT LITERALLY 'ADDRESS EXTERNAL',
  110.     /* LITERAL DECLARATIONS FOR PARSE TABLE ENTRIES */
  111.     FLOATPT LITERALLY '49',
  112.     STRING LITERALLY '50',
  113.  
  114.     PASS1    BEXT,
  115.     PASS2    BEXT,
  116.     LISTPROD BEXT,
  117.     ERRORCOUNT AEXT,
  118.     DEBUGLN  BEXT,
  119.     COMPILING BEXT,
  120.     DATACT   AEXT,     /* COUNTS SIZE OF DATA AREA */
  121.     FORSTMT  BEXT,
  122.     RANDOMFILE  BEXT,
  123.     FILEIO      BEXT,
  124.     INPUTSTMT   BEXT,
  125.     GOSUBSTMT   BEXT,
  126.     NEXTCHAR    BEXT,
  127.     FUNCOP      BEXT,
  128.     ACCLEN      BEXT,
  129.     ACCUM(IDENTSIZE) BEXT,
  130.     CONT        BEXT,
  131.     LINENO      BEXT,
  132.     SEPARATOR   BEXT;
  133.  
  134. DECLARE /* LOCAL VARIABLES */
  135.     MAX ADDRESS AT (6H),       /* DOS ADDRESS */
  136.     ULERRORFLAG BYTE INITIAL(FALSE),
  137.     CODESIZE    ADDRESS,  /* COUNTS SIZE OF CODE AREA */
  138.     PRTCT       ADDRESS,  /* COUNTS PRT ENTRIES */
  139.     FDACT       ADDRESS,  /* COUNTS FDA ENTRIES */
  140.     NEXTSTMTPTR ADDRESS,
  141.     NEXTADDRESS BASED NEXTSTMTPTR (4) ADDRESS,
  142.     NEXTBYTEV   BASED NEXTSTMTPTR(2) BYTE,
  143.     NEXTBYTE    BASED NEXTSTMTPTR BYTE, /* SIMPLE VERSION OF 'V' */
  144.     FORCOUNT    BYTE INITIAL(0),
  145.  
  146.     BASE        ADDRESS,  /* BASE OF CURRENT ENTRY IN SYMBOL */
  147.     HASHTABLE(HASHTBLSIZE) ADDRESS,
  148.     SBTBLTOP    ADDRESS,  /* CURRENT TOP OF SYMBOL TABLE */
  149.     FORADDRESS  BASED SBTBLTOP (4) ADDRESS, /* FOR STMT INFO */
  150.     SBTBL       ADDRESS,
  151.     PTRV        BASED BASE (2) BYTE, /* FIRST BYTE OF ENTRY */
  152.     PTR         BASED BASE BYTE, /* SIMPLE PTRV */
  153.     APTRADDR    ADDRESS,  /* UTILITY VARIABLE TO ACCESS TABLE */
  154.     BYTEPTRV    BASED APTRADDR (2) BYTE,
  155.     BYTEPTR     BASED APTRADDR BYTE, /* SIMPLE BYTEPTRV */
  156.     ADDRPTR     BASED APTRADDR ADDRESS,
  157.     PRINTNAME   ADDRESS,  /* SET PRIOR TO LOOKUP OR ENTER */
  158.     SYMHASH     BYTE;     /* ALSO SET PRIOR TO LOOKUP OR ENTER */
  159.  
  160. IN$SYMTBL: PROCEDURE PUBLIC;
  161.     /* FILL HASHTABLE WITH 0'S */
  162.     IF PASS1 THEN
  163.          DO;
  164.               CALL FILL(.HASHTABLE,0,SHL(HASHTBLSIZE,1));
  165.               SBTBL = .MEMORY;
  166.          END;
  167.     /* INITIALIZE POINTER TO TOP OF SYMBOL TABLE */
  168.     SBTBLTOP, NEXTSTMTPTR = MAX - 2;
  169.     NEXTBYTEV(1) =0;
  170.     RETURN;
  171. END IN$SYMTBL;
  172.  
  173. SETADDRPTR: PROCEDURE(OFFSET);   /* SET PTR FOR ADDR REFERENCE */
  174.     DECLARE
  175.             OFFSET BYTE;
  176.     APTRADDR = BASE + PTR + OFFSET; /* POSITION FOR ADDR REFERENCE */
  177.     RETURN;
  178. END SETADDRPTR;
  179.  
  180.  
  181. GETHASH: PROCEDURE BYTE;
  182.     DECLARE HASH BYTE,
  183.             I    BYTE;
  184.     HASH = 0;
  185.     APTRADDR = BASE + 2;
  186.     DO I = 1 TO PTR;
  187.          HASH = (HASH + BYTEPTRV(I)) AND HASHMASK;
  188.          END;
  189.     RETURN HASH;
  190. END GETHASH;
  191.  
  192.  
  193. NEXTENTRY: PROCEDURE;
  194.     BASE = BASE + PTR + 7;
  195.     RETURN;
  196. END NEXTENTRY;
  197.  
  198.  
  199. SETLINK: PROCEDURE;
  200.     APTRADDR = BASE + 1;
  201.     RETURN;
  202. END SETLINK;
  203.  
  204.  
  205. HASHTBL$OF$SYMHASH: PROCEDURE ADDRESS;
  206.     RETURN HASHTABLE(SYMHASH);
  207. END HASHTBL$OF$SYMHASH;
  208.  
  209. LIMITS: PROCEDURE(COUNT);
  210.         /*
  211.          CHECK TO SEE IF ADDITIONAL SBTBL WILL OVERFLOW LIMITS OF
  212.          MEMORY. IF SO THEN PUNT ELSE RETURN
  213.         */
  214.  
  215.          DECLARE COUNT  BYTE;     /*SIZE BEING ADDED IS COUNT  */
  216.          IF SBTBLTOP <= (SBTBL + COUNT) THEN
  217.               DO;
  218.                    PASS2 = TRUE;  /* TO PRINT ERROR MSG */
  219.                    CALL ERROR('TO');
  220.                     CALL MON3;
  221.               END;
  222.     RETURN;
  223. END LIMITS;
  224.  
  225.  
  226. SETADDR: PROCEDURE(LOC);
  227.          /*SET THE ADDRESS FIELD AND RESOLVED BIT*/
  228.     DECLARE    LOC       ADDRESS;
  229.     CALL SETADDRPTR (4);
  230.     ADDRPTR=LOC;
  231.     APTRADDR = APTRADDR - 1;
  232.     BYTEPTR=BYTEPTR OR 80H;
  233.     RETURN;
  234. END SETADDR;
  235.  
  236.  
  237. LOOKUP: PROCEDURE BYTE;
  238.           /*
  239.            CHECK TO SEE IF P/N LOCATED AT ADDR IN PRINTNAME IS IN SBTBL
  240.                    RETURN TRUE IF IN SBTBL
  241.                    RETURN FALSE IF NOT IN SBTBL.
  242.                    BASE=ADDRESS IF IN SBTBL
  243.          */
  244.  
  245.       DECLARE
  246.               LEN               BYTE,
  247.               N BASED PRINTNAME (2) BYTE; /* N IS LENGTH OF P/N */
  248.      BASE = HASHTBL$OF$SYMHASH;
  249.      DO WHILE BASE <> 0;
  250.           IF(LEN := PTR) = N(0) THEN
  251.           DO WHILE (PTRV(LEN + 2) = N(LEN));
  252.                IF (LEN := LEN - 1) = 0 THEN
  253.                     RETURN TRUE;
  254.                END;
  255.           CALL SETLINK;
  256.           BASE = ADDRPTR;
  257.      END;
  258.      RETURN FALSE;
  259. END LOOKUP;
  260.  
  261.  
  262. ENTER: PROCEDURE;
  263.           /*
  264.              ENTER TOKEN REFERENCE BY PRINTNAME AND SYMHASH
  265.              INTO NEXT AVAILABLE LOCATION IN THE SYMBOL TABLE.
  266.              SET BASE TO BEGINNING OF THIS ENTRY AND INCREMENT
  267.              SBTBL.  ALSO CHECK FOR SYMBOL TABLE FULL.
  268.           */
  269.     DECLARE
  270.              I                 BYTE,
  271.              N BASED PRINTNAME BYTE;
  272.     CALL LIMITS(I:=N+7);
  273.     BASE = SBTBL; /* BASE FOR NEW ENTRY */
  274.     CALL MOVE(PRINTNAME + 1,SBTBL + 3,(PTR := N));
  275.     CALL SETADDRPTR(3);/* SET RESOLVE BIT TO 0 */
  276.     BYTEPTR = 0;
  277.     CALL SETLINK;
  278.     ADDRPTR = HASHTBL$OF$SYMHASH;
  279.     HASHTABLE(SYMHASH) = BASE;
  280.     SBTBL = SBTBL + I;
  281.     RETURN;
  282. END ENTER;
  283.  
  284.  
  285. GETLEN: PROCEDURE       BYTE;     /*RETURN LENGTH OF THE P/N  */
  286.     RETURN PTR;
  287. END GETLEN;
  288.  
  289.  
  290. GETYPE: PROCEDURE       BYTE;          /*RETURNS TYPE OF VARIABLE  */
  291.    CALL SETADDRPTR (3);
  292.    RETURN (BYTEPTR AND 7FH);
  293. END GETYPE;
  294.  
  295.  
  296. SETYPE: PROCEDURE (TYPE);        /*SET TYPEFIELD = TYPE  */
  297.     DECLARE    TYPE      BYTE;
  298.     CALL SETADDRPTR (3);
  299.     BYTEPTR = BYTEPTR OR TYPE;
  300.               /*THIS SETS THE TYPE AND PRESERVES RESOLVED BIT */
  301.     RETURN;
  302. END SETYPE;
  303.  
  304.  
  305. GETRES: PROCEDURE  BYTE;
  306.          /*
  307.            RETURN TRUE IF RESOLVED BIT = 1,
  308.            RETURN FALSE IF RESOLVED BIT = 0
  309.         */
  310.     CALL SETADDRPTR(3);
  311.     RETURN ROL(BYTEPTR,1);
  312. END GETRES;
  313.  
  314.  
  315. GETADDR: PROCEDURE ADDRESS;
  316.          /*RETURN THE ADDRESS OF THE P/N LOCATION */
  317.     CALL SETADDRPTR(4);
  318.     RETURN ADDRPTR;
  319. END GETADDR;
  320.  
  321.  
  322. SETSUBTYPE: PROCEDURE(STYPE);       /*INSERT THE SUBTYPE IN SBTBL */
  323.     DECLARE    STYPE     BYTE;
  324.     CALL SETADDRPTR (6);
  325.     BYTEPTR=STYPE;
  326.     RETURN;
  327. END SETSUBTYPE;
  328.  
  329.  
  330. GETSUBTYPE: PROCEDURE BYTE;          /*RETURN THE SUB TYPE */
  331.     CALL SETADDRPTR (6);
  332.     RETURN BYTEPTR;
  333. END GETSUBTYPE;
  334.  
  335.  
  336. UNLINK: PROCEDURE;
  337.     DECLARE NEXTA   ADDRESS,
  338.             NUMPARM BYTE,
  339.             I       BYTE,
  340.             ENTRYPT BASED NEXTA ADDRESS;
  341.     NUMPARM = GETYPE;
  342.     DO I = 1 TO NUMPARM;
  343.          CALL NEXTENTRY;
  344.          NEXTA = SHL(GETHASH,1) + .HASHTABLE; /* ITS ON THIS CHAIN */
  345.          DO WHILE ENTRYPT <> BASE;
  346.               NEXTA = ENTRYPT + 1;
  347.               END;
  348.          CALL SETLINK;
  349.          ENTRYPT = ADDRPTR;
  350.     END;
  351.     RETURN;
  352. END UNLINK;
  353.  
  354.  
  355. RELINK: PROCEDURE;
  356.     DECLARE
  357.             TEMPA           ADDRESS,
  358.             I               BYTE,
  359.             NUMPARM         BYTE,
  360.             LOC BASED TEMPA ADDRESS;
  361.     NUMPARM = GETYPE;
  362.     DO I = 1 TO NUMPARM;
  363.          CALL NEXTENTRY;
  364.          TEMPA = BASE + 1;
  365.          LOC = HASHTABLE(GETHASH);
  366.          HASHTABLE(GETHASH) = BASE;
  367.          END;
  368.     RETURN;
  369. END RELINK;
  370.         /*
  371.          *********************************************************
  372.          *                                                       *
  373.          *   ****   PARSER AND CODE GENERATION  SECTION  ****    *
  374.          *                                                       *
  375.          *********************************************************
  376.         */
  377.          /*
  378.             MNEMMONICS FOR BASIC-E MACHINE
  379.          */
  380. DECLARE
  381.         FAD LIT '0', DUP LIT '18', WST LIT '36',
  382.         FMI LIT '1', XCH LIT '19', RDF LIT '37',
  383.         FMU LIT '2', STD LIT '20', RDB LIT '38',
  384.         FDI LIT '3', SLT LIT '21', ECR LIT '39',
  385.         EXP LIT '4', SGT LIT '22', WRB LIT '40',
  386.         LSS LIT '5', SEQ LIT '23', RDN LIT '41',
  387.         GTR LIT '6', SNE LIT '24', RDS LIT '42',
  388.         EQU LIT '7', SGE LIT '25', WRN LIT '43',
  389.         NEQ LIT '8', SLE LIT '26', WRS LIT '44',
  390.         GEQ LIT '9', STS LIT '27', OPN LIT '45',
  391.         LEQ LIT '10', ILS LIT '28', CON LIT '46',
  392.        NOTO LIT '11', CAT LIT '29', RST LIT '47',
  393.        ANDO LIT '12', PRO LIT '30', NEG LIT '48',
  394.         BOR LIT '13', RTN LIT '31', RES LIT '49',
  395.         LOD LIT '14', ROW LIT '32', NOP LIT '50',
  396.         STO LIT '15', SUBO LIT '33', DAT LIT '51',
  397.         XIT LIT '16', RDV LIT '34', DBF LIT '52',
  398.         DEL LIT '17', WRV LIT '35', NSP LIT '53',
  399.         BRS LIT '54', BRC LIT '55', BFC LIT '56',
  400.         BFN LIT '57', CVB LIT '58', RCN LIT '59',
  401.         DRS LIT '60', DRF LIT '61', EDR LIT '62',
  402.         EDW LIT '63', CLS LIT '64', RON LIT '91',
  403.         CKO LIT '92', EXR LIT '93', DEF LIT '94',
  404.         BOL LIT '95', ADJ LIT '96', POT LIT '40',
  405.         IRN LIT '77';
  406. DECLARE
  407.         STATE STATESIZE PUBLIC,
  408.          /*
  409.            THE FOLLOWING VECTORS ARE USED AS PARSE STACKS
  410.            SYNTHESIZE AND THE PARSER ACCESS THESE ARRAYS
  411.          */
  412.         STATESTACK(PSTACKSIZE) STATESIZE PUBLIC,
  413.         HASH(PSTACKSIZE) BYTE PUBLIC,
  414.         SYMLOC(PSTACKSIZE) ADDRESS PUBLIC,
  415.         SRLOC(PSTACKSIZE) ADDRESS PUBLIC,
  416.         VAR(PSTACKSIZE) BYTE PUBLIC,
  417.         TYPE(PSTACKSIZE) BYTE PUBLIC,
  418.         STYPE(PSTACKSIZE) BYTE PUBLIC,
  419.         VARC(VARCSIZE) BYTE PUBLIC,
  420.         ONSTACK(MAXONCOUNT) BYTE,
  421.         ONSP BYTE AT (.ONSTACK(0)),
  422.         VARINDEX BYTE PUBLIC,  /* INDEX INTO VAR */
  423.         SP        BYTE PUBLIC,
  424.         MP        BYTE PUBLIC,
  425.         MPP1      BYTE PUBLIC,
  426.         NOLOOK    BYTE PUBLIC,
  427.         IFLABLNG BYTE INITIAL(2),
  428.          /*
  429.            THE FOLLOWING VARABLES ARE USED TO GENERATE
  430.            COMPILER LABELS.
  431.          */
  432.         IFLAB2 BYTE INITIAL(23),
  433.         IFLABLE BYTE;
  434.  
  435. EMITCON: PROCEDURE(CHAR);
  436.      /*
  437.        WRITES NUMERIC CONSTANTS DURING PASS1
  438.      */
  439.     DECLARE CHAR BYTE;
  440.     IF PASS1 THEN
  441.          CALL EMIT(CHAR);
  442.     RETURN;
  443. END EMITCON;
  444.  
  445. IN$SYN: PROCEDURE PUBLIC;
  446.     DECLARE CONZERO(*) BYTE DATA(01H,30H);
  447.     DECLARE CONONE(*) BYTE DATA(01H,31H);
  448.     CODESIZE,DATACT,ONSP,IFLABLE = 0;
  449.     FDACT = 1;
  450.     PRTCT = 0FFFFH;
  451.     CALL SET$FLAGS;
  452.     IF PASS1 THEN
  453.          DO;
  454.               CALL SETUP$INT$FILE;
  455.               PRINTNAME = .CONONE(0);
  456.               SYMHASH = 31H;
  457.               CALL ENTER;
  458.               CALL EMITCON(31H);
  459.               CALL EMITCON('$');
  460.               CALL SETADDR(0);  /* CONSTANT 1 IS AT FDA POS 0 */
  461.               CALL SETYPE(4); /* TYPE CONST */
  462.               PRINTNAME = .CONZERO(0);
  463.               SYMHASH = 30H;
  464.               CALL ENTER;
  465.               CALL EMITCON(30H);
  466.               CALL EMITCON('$');
  467.               CALL SETADDR(1);
  468.               CALL SETYPE(4);
  469.          END;
  470.     RETURN;
  471. END IN$SYN;
  472.  
  473.  
  474. SYNTHESIZE: PROCEDURE(PRODUCTION) PUBLIC;
  475.     DECLARE
  476.             PRODUCTION BYTE;
  477.  
  478.  
  479.      DECLARE
  480.             /*
  481.               THESE LITERALS DEFINE DIFFERENT "TYPES" WHICH
  482.               MAY BE PLACED IN THE TYPE FIELD OF THE SYMBOL
  483.               TABLE BY ROUTINES IN SYNTHESIZE
  484.             */
  485.              SIMVAR LIT '00H',
  486.              SUBVAR LIT '02',
  487.              CONST LIT '04',
  488.              LABLE LIT '08',
  489.              UNFUNC LIT '0AH';
  490.  
  491.      DECLARE
  492.               /*
  493.                 THE FOLLOWING VARIABLES ARE USED TO HOLD THE
  494.                 CONTENTS OF THE PARSE STACKS DURING EXECUTION
  495.                 OF SYNTHESIZE. THE PROCEDURE COPY IS CALLED
  496.                 TO UPDATE EACH OF THESE VARIABLES ON EACH CALL
  497.                 TO SYNTHESIZE.  THIS REDUCES THE NUMBER OF
  498.                 SUBSCRIPT REFERENCES REQUIRED
  499.               */
  500.              (TYPESP,TYPEMP,TYPEMP1) BYTE,
  501.              (STYPESP,STYPEMP,STYPEMP1) BYTE,
  502.              (HASHSP,HASHMP,HASHMP1) BYTE,
  503.              (SYMLOCSP,SYMLOCMP, SYMLOCMP1) ADDRESS,
  504.              (SRLOCSP,SRLOCMP) ADDRESS;
  505.  
  506.         /*
  507.          *********************************************************
  508.          *                                                       *
  509.          *    THE FOLLOWING PROCEDURES ARE USED BY SYTHESIZE     *
  510.          *    TO GENERATE CODE REQUIRED BY THE PRODUCTIONS       *
  511.          *                                                       *
  512.          *     THE FIRST GROUP OF PROCEDURES CONSISTING OF       *
  513.          *     COPY AND THE SET-------- PROCEDURES ARE USED      *
  514.          *     TO PREVENT THE LARGE AMOUNT OF SUBSCRIPTING       *
  515.          *     THAT WOULD BE REQUIRED TO ACCESS THE PARSE        *
  516.          *     STACKS DURING CODE GENERATION.                    *
  517.          *                                                       *
  518.          *     THE REMAINING PROCEDURES DIRECTLY SUPPORT CODE    *
  519.          *     GENERATION AND ARE ARRANGED IN LOGICAL GROUPS     *
  520.          *     SUCH AS THOSE WHICH ASSIST IN ACCESSING THE       *
  521.          *     SYMBOL TABLE OR THOSE USED TO GENERATE INTERNAL   *
  522.          *     COMPILER LABLES.                                  *
  523.          *                                                       *
  524.          *********************************************************
  525.         */
  526.      COPY: PROCEDURE;
  527.           TYPESP = TYPE(SP);
  528.           TYPEMP1 = TYPE(MPP1);
  529.           TYPEMP = TYPE(MP);
  530.           STYPESP = STYPE(SP);
  531.           STYPEMP1 = STYPE(MPP1);
  532.           STYPEMP = STYPE(MP);
  533.           SYMLOCSP = SYMLOC(SP);
  534.           SYMLOCMP1 = SYMLOC(MPP1);
  535.           SYMLOCMP = SYMLOC(MP);
  536.           HASHMP = HASH(MP);
  537.           HASHMP1 = HASH(MPP1);
  538.           HASHSP = HASH(SP);
  539.           SRLOCSP = SRLOC(SP);
  540.           SRLOCMP = SRLOC(MP);
  541.           RETURN;
  542.      END COPY;
  543.  
  544.  
  545.     SETSYMLOCSP: PROCEDURE(A);
  546.          DECLARE A ADDRESS;
  547.          SYMLOC(SP) = A;
  548.          RETURN;
  549.     END SETSYMLOCSP;
  550.  
  551.  
  552.     SETSYMLOCMP: PROCEDURE(A);
  553.          DECLARE A ADDRESS;
  554.          SYMLOC(MP) = A;
  555.          RETURN;
  556.     END SETSYMLOCMP;
  557.  
  558.  
  559.     SETTYPESP: PROCEDURE(B);
  560.          DECLARE B BYTE;
  561.          TYPE(SP) = B;
  562.          RETURN;
  563.     END SETTYPESP;
  564.  
  565.  
  566.     SETSTYPESP: PROCEDURE(B);
  567.          DECLARE B BYTE;
  568.          STYPE(SP) = B;
  569.          RETURN;
  570.     END SETSTYPESP;
  571.  
  572.  
  573.     SETSTYPEMP: PROCEDURE(B);
  574.          DECLARE B BYTE;
  575.          STYPE(MP) = B;
  576.          RETURN;
  577.     END SETSTYPEMP;
  578.  
  579.  
  580.     SETTYPEMP: PROCEDURE(B);
  581.          DECLARE B BYTE;
  582.          TYPE(MP) = B;
  583.          RETURN;
  584.     END SETTYPEMP;
  585.  
  586.  
  587.     SETHASHMP: PROCEDURE(B);
  588.          DECLARE B BYTE;
  589.          HASH(MP) = B;
  590.          RETURN;
  591.     END SETHASHMP;
  592.  
  593.  
  594.     SETHASHSP: PROCEDURE(B);
  595.          DECLARE B BYTE;
  596.          HASH(SP) = B;
  597.          RETURN;
  598.     END SETHASHSP;
  599.  
  600.  
  601.     SETSRLOCSP: PROCEDURE(A);
  602.          DECLARE A ADDRESS;
  603.          SRLOC(SP) = A;
  604.          RETURN;
  605.     END SETSRLOCSP;
  606.  
  607. GENERATE: PROCEDURE(OBJCODE);
  608.      /*
  609.         WRITES GENERATED CODE AND COUNTS SIZE
  610.         OF CODE AREA.
  611.      */
  612.     DECLARE OBJCODE BYTE;
  613.     CODESIZE = CODESIZE + 1;
  614.     IF NOT PASS1 THEN
  615.          CALL EMIT(OBJCODE);
  616.     RETURN;
  617. END GENERATE;
  618.  
  619.     CALC$VARC: PROCEDURE(B) ADDRESS;
  620.          DECLARE B BYTE;
  621.          RETURN VAR(B) + .VARC;
  622.     END CALC$VARC;
  623.  
  624.  
  625.     SETLOOKUP: PROCEDURE(A);
  626.          DECLARE A BYTE;
  627.          PRINTNAME = CALC$VARC(A);
  628.          SYMHASH = HASH(A);
  629.          RETURN;
  630.     END SETLOOKUP;
  631.  
  632.  
  633.     LOOKUP$ONLY: PROCEDURE(A) BYTE;
  634.          DECLARE A BYTE;
  635.          CALL SETLOOKUP(A);
  636.          IF LOOKUP THEN
  637.               RETURN TRUE;
  638.          RETURN FALSE;
  639.     END LOOKUP$ONLY;
  640.  
  641.  
  642.     NORMAL$LOOKUP: PROCEDURE(A) BYTE;
  643.          DECLARE A BYTE;
  644.          IF LOOKUP$ONLY(A) THEN
  645.               RETURN TRUE;
  646.          CALL ENTER;
  647.          RETURN FALSE;
  648.      END NORMAL$LOOKUP;
  649.  
  650.  
  651.     COUNTPRT: PROCEDURE ADDRESS;
  652.     /* COUNTS THE SIZE OF THE PRT */
  653.          RETURN (PRTCT := PRTCT + 1);
  654.     END COUNTPRT;
  655.  
  656.  
  657.      GENTWO: PROCEDURE(A);
  658.         /* WRITES TWO BYTES OF OBJECT CODE ON DISK FOR LITERALS */
  659.          DECLARE A ADDRESS;
  660.          CALL GENERATE(HIGH(A));
  661.          CALL GENERATE(LOW(A));
  662.          RETURN;
  663.      END GENTWO;
  664.  
  665.  
  666.      LITERAL: PROCEDURE(A);
  667.          DECLARE A ADDRESS;
  668.          CALL GENTWO(A OR 8000H);
  669.          RETURN;
  670.      END LITERAL;
  671.  
  672.  
  673.      LITLOAD: PROCEDURE(A);
  674.          DECLARE A ADDRESS;
  675.          CALL GENTWO(A OR 0C000H);
  676.          RETURN;
  677.      END LITLOAD;
  678.  
  679.  
  680.     LINE$NUMBER: PROCEDURE;
  681.          IF DEBUGLN THEN
  682.               DO;
  683.                    CALL LITERAL(LINENO);
  684.                    CALL GENERATE(BOL);
  685.               END;
  686.          RETURN;
  687.     END LINE$NUMBER;
  688.  
  689.  
  690.     SETIFNAME: PROCEDURE;
  691.          PRINTNAME = .IFLABLNG;
  692.          SYMHASH = IFLABLE AND HASHMASK;
  693.          RETURN;
  694.     END SETIFNAME;
  695.  
  696.  
  697.     ENTER$COMPILER$LABEL: PROCEDURE(B);
  698.          DECLARE B BYTE;
  699.          IF PASS1 THEN
  700.                DO;
  701.                    CALL SETIFNAME;
  702.                    CALL ENTER;
  703.                    CALL SETADDR(CODESIZE + B);
  704.                 END;
  705.          RETURN;
  706.     END ENTER$COMPILER$LABEL;
  707.  
  708.  
  709.     SET$COMPILER$LABEL: PROCEDURE;
  710.          DECLARE X BYTE;
  711.          IFLABLE = IFLABLE + 1;
  712.          CALL SETIFNAME;
  713.          X = LOOKUP;
  714.          RETURN;
  715.     END SET$COMPILER$LABEL;
  716.  
  717.  
  718.     COMPILER$LABEL: PROCEDURE;
  719.          CALL SET$COMPILER$LABEL;
  720.          CALL GEN$TWO(GETADDR);
  721.           RETURN;
  722.     END COMPILER$LABEL;
  723.  
  724.  
  725.     CHKTYP1: PROCEDURE BYTE; /* CHECK MP,SP BOTH FLOATING PT */
  726.           IF((STYPEMP <> FLOATPT) OR (STYPESP <> FLOATPT)) THEN
  727.                DO;
  728.                     CALL ERROR('MF');
  729.                     RETURN FALSE;
  730.                END;
  731.          RETURN TRUE;
  732.     END CHKTYP1;
  733.  
  734.  
  735.     CHKTYP2: PROCEDURE BYTE; /* CHECK MP,SP BOTH SAME TYPE */
  736.            IF STYPESP <> STYPEMP THEN
  737.                DO;
  738.                     CALL ERROR('MM');
  739.                     RETURN FALSE;
  740.                END;
  741.               RETURN TRUE;
  742.     END CHKTYP2;
  743.  
  744.  
  745.     CHKTYP3: PROCEDURE BYTE;
  746.          CALL SETSTYPEMP(STYPESP);
  747.          IF STYPESP = FLOATPT THEN
  748.               RETURN TRUE;
  749.          CALL ERROR('MF');
  750.          RETURN FALSE;
  751.     END CHKTYP3;
  752.  
  753.     CHKTYP4: PROCEDURE;
  754.          IF STYPEMP1 = STRING THEN
  755.               CALL ERROR('MF');
  756.          CALL GENERATE(RON);
  757.     END CHKTYP4;
  758.  
  759.     CHKTYP5: PROCEDURE;
  760.          CALL CHKTYP4;
  761.          CALL SETTYPEMP(TYPEMP := TYPEMP + 1);
  762.          END CHKTYP5;
  763.  
  764.  
  765.     SUBCALC: PROCEDURE;
  766.          CALL SETSUBTYPE(TYPESP);
  767.          CALL GENERATE(ROW);
  768.          CALL GENERATE(TYPESP);
  769.          CALL GENERATE(STD);
  770.          RETURN;
  771.     END SUBCALC;
  772.  
  773.  
  774.     GEN$STORE: PROCEDURE;
  775.          IF STYPEMP1 = FLOATPT THEN
  776.               CALL GENERATE(STD);
  777.          ELSE
  778.               CALL GENERATE(STS);
  779.          RETURN;
  780.     END GEN$STORE;
  781.  
  782.  
  783.     SETUP$INPUT: PROCEDURE;
  784.          CALL GENERATE(DBF);
  785.          INPUTSTMT = TRUE;
  786.          CALL GENERATE(RCN);
  787.     END SETUP$INPUT;
  788.  
  789.  
  790.     GET$FIELD: PROCEDURE;
  791.  
  792.          GEN$READ: PROCEDURE(I,J);
  793.               DECLARE (I,J) BYTE;
  794.               IF STYPESP = STRING THEN
  795.                    DO;
  796.                         CALL GENERATE(I);
  797.                         CALL GENERATE(STS);
  798.                    END;
  799.               ELSE
  800.                    DO;
  801.                         CALL GENERATE(J);
  802.                         CALL GENERATE(STD);
  803.                    END;
  804.               RETURN;
  805.          END GEN$READ;
  806.  
  807.          IF(TYPESP = SIMVAR) THEN
  808.               CALL LITERAL(SYMLOCSP);
  809.          IF INPUTSTMT THEN
  810.               CALL GEN$READ(RES,RDV);
  811.          ELSE
  812.               IF FILEIO THEN
  813.                    CALL GEN$READ(RDS,RDN);
  814.               ELSE
  815.                    CALL GEN$READ(DRS,DRF);
  816.          RETURN;
  817.     END GET$FIELD;
  818.  
  819.  
  820.     GEN$ON: PROCEDURE;
  821.          CALL GENERATE(RON);
  822.          CALL LITERAL(ONSTACK(ONSP := ONSP + 1));
  823.          CALL GENERATE(CKO);
  824.          CALL GENERATE(BFN);
  825.          RETURN;
  826.     END GEN$ON;
  827.  
  828.  
  829.     GEN$ON$2: PROCEDURE;
  830.          ONSTACK(ONSP) = TYPESP;
  831.          RETURN;
  832.     END GEN$ON$2;
  833.  
  834.  
  835.     GENNEXT: PROCEDURE;
  836.          IF(FORCOUNT := FORCOUNT - 1) = 255 THEN
  837.               DO;
  838.                    FORCOUNT = 0;
  839.                    CALL ERROR('NU');
  840.               END;
  841.          ELSE
  842.               DO;
  843.                    CALL GENERATE(BRS);
  844.                    CALL GEN$TWO(NEXTADDRESS(2));
  845.                    NEXTADDRESS(0) = CODESIZE OR 8000H;
  846.                    DO WHILE NEXTBYTEV(1) > 127;
  847.                         NEXTSTMTPTR = NEXTSTMTPTR + 8;
  848.                         END;
  849.               END;
  850.          RETURN;
  851.     END GENNEXT;
  852.  
  853.  
  854.     GEN$NEXT$WITH$IDENT: PROCEDURE;
  855.          IF LOOKUP$ONLY(MPP1) AND (BASE = NEXTADDRESS(3)) THEN
  856.               CALL GENNEXT;
  857.          ELSE
  858.               CALL ERROR('NI');
  859.          RETURN;
  860.     END GEN$NEXT$WITH$IDENT;
  861.  
  862.  
  863.     CHECK$UL$ERROR: PROCEDURE;
  864.          IF ULERRORFLAG THEN
  865.               CALL ERROR('UL');
  866.          ULERRORFLAG = FALSE;
  867.     END CHECK$UL$ERROR;
  868.  
  869.  
  870.     FINDLABEL: PROCEDURE;
  871.          IF NORMAL$LOOKUP(SP) THEN
  872.               DO;
  873.                    IF PASS2 AND (NOT GETRES) THEN
  874.                          ULERRORFLAG = TRUE;
  875.               END;
  876.          RETURN;
  877.     END FINDLABEL;
  878.  
  879.  
  880.      RESOLVE$LABEL: PROCEDURE;
  881.          CALL FINDLABEL;
  882.          IF GOSUBSTMT THEN
  883.               CALL GENERATE(PRO);
  884.          ELSE
  885.               CALL GENERATE(BRS);
  886.          CALL GEN$TWO(GETADDR);
  887.          RETURN;
  888.      END RESOLVE$LABEL;
  889.  
  890.  
  891.     PROCESS$SIMPLE$VARIABLE: PROCEDURE(LOC);
  892.          DECLARE LOC BYTE;
  893.          IF NORMALLOOKUP(LOC) THEN
  894.                    DO;
  895.                         IF GETYPE <> SIMVAR THEN
  896.                              CALL ERROR('IU');
  897.                   END;
  898.              ELSE
  899.                    DO;
  900.                         CALL SETADDR(COUNTPRT);
  901.                         CALL SETYPE(SIMVAR);
  902.                    END;
  903.               CALL SETSYMLOCSP(SYMLOCSP:=GETADDR);
  904.               CALL SETTYPESP(SIMVAR);
  905.               IF FORSTMT THEN
  906.                    DO;
  907.                         FORSTMT = FALSE;
  908.                         FORADDRESS(3) = BASE;
  909.                    END;
  910.     END PROCESS$SIMPLE$VARIABLE;
  911.  
  912.  
  913.     GEN$ILS: PROCEDURE(WHERE);
  914.           DECLARE STRPTR BYTE,
  915.                   WHERE ADDRESS,
  916.                   STRINGTOSPOOL BASED WHERE (2) BYTE;
  917.          CALL SETSTYPESP(STRING);
  918.          CALL GENERATE(ILS);
  919.          DO FOREVER;
  920.               DO STRPTR = 1 TO STRINGTOSPOOL(0);
  921.                    CALL GENERATE(STRINGTOSPOOL(STRPTR));
  922.                    END;
  923.                IF CONT THEN
  924.                    CALL SCANNER;
  925.                ELSE
  926.                    DO;
  927.                         CALL GENERATE(0);
  928.                         RETURN;
  929.                    END;
  930.          END; /* OF DO FOREVER */
  931.     END GEN$ILS;
  932.  
  933.  
  934.     GENCON: PROCEDURE;
  935.          DECLARE I BYTE;
  936.          CALL GENERATE(CON);
  937.          CALL SETTYPESP(CONST);
  938.          CALL SETSTYPESP(FLOATPT);
  939.          IF LOOKUP$ONLY(SP) AND (GETYPE = CONST) THEN
  940.               CALL GEN$TWO(GETADDR);
  941.          ELSE
  942.               DO;
  943.                    DO I = 1 TO ACCLEN;
  944.                         CALL EMITCON(ACCUM(I));
  945.                         END;
  946.                    CALL EMITCON('$');
  947.                    CALL GEN$TWO(FDACT := FDACT + 1);
  948.               END;
  949.          RETURN;
  950.     END GENCON;
  951.  
  952.  
  953.     PUT$FIELD: PROCEDURE;
  954.          IF FILEIO THEN
  955.               DO;
  956.                    IF STYPESP = FLOATPT THEN
  957.                         CALL GENERATE(WRN);
  958.                    ELSE
  959.                         CALL GENERATE(WRS);
  960.               END;
  961.          ELSE
  962.               IF STYPESP = FLOATPT THEN
  963.                     DO;
  964.                          IF TYPESP <> 74 THEN /* IS IT A TAB */
  965.                               CALL GENERATE(WRV);
  966.                     END;
  967.               ELSE
  968.                    CALL GENERATE(WST);
  969.          RETURN;
  970.      END PUT$FIELD;
  971.  
  972.  
  973.     GEN$PARM: PROCEDURE;
  974.          IF TYPEMP = UNFUNC THEN
  975.               DO;
  976.                    BASE = SYMLOCMP;
  977.                    CALL NEXTENTRY;
  978.                    CALL SETSYMLOCMP(BASE);
  979.                    CALL SETHASHMP(HASHMP := HASHMP - 1);
  980.                    CALL LITERAL(GETADDR);
  981.               END;
  982.          RETURN;
  983.     END GEN$PARM;
  984.  
  985.  
  986.     CHECKPARM: PROCEDURE;
  987.          IF TYPEMP = UNFUNC THEN
  988.               DO;
  989.                    BASE = SYMLOCMP;
  990.                    IF(GETSUBTYPE <> STYPEMP1) THEN
  991.                         CALL ERROR('FP');
  992.                    CALL GEN$STORE;
  993.                    RETURN;
  994.               END;
  995.          IF(HASHMP XOR (STYPEMP1 <> FLOATPT)) THEN
  996.               CALL ERROR('FP');
  997.          CALL SETHASHMP(SHR(HASHMP,1));
  998.          CALL SETSTYPEMP(STYPEMP := STYPEMP -1);
  999.          RETURN;
  1000.     END CHECKPARM;
  1001.  
  1002.  
  1003.     FUNCGEN: PROCEDURE;
  1004.          IF TYPEMP = UNFUNC THEN
  1005.               DO;
  1006.                    IF HASHMP <> 0 THEN
  1007.                         CALL ERROR('FN');
  1008.                    CALL GENERATE(PRO);
  1009.                    BASE = SRLOCSP;
  1010.                    CALL GEN$TWO(GETADDR);
  1011.                    RETURN;
  1012.               END;
  1013.          IF((STYPEMP AND 03H) <>0) THEN
  1014.               CALL ERROR('FN');
  1015.          CALL GENERATE(TYPEMP);
  1016.          IF ROL(STYPEMP,2) THEN
  1017.               CALL SETSTYPEMP(STRING);
  1018.          ELSE
  1019.               CALL SETSTYPEMP(FLOATPT);
  1020.          RETURN;
  1021.     END FUNCGEN;
  1022.  
  1023.  
  1024.     ENTER$PARM: PROCEDURE;
  1025.          IF PASS1 THEN
  1026.               DO;
  1027.                    CALL SETLOOKUP(MPP1);
  1028.                    CALL ENTER;
  1029.                    CALL SETADDR(COUNTPRT);
  1030.                    CALL SETSUBTYPE(STYPEMP1);
  1031.                    CALL SETYPE(SIMVAR);
  1032.                    CALL SETTYPEMP(TYPEMP + 1);
  1033.               END;
  1034.          RETURN;
  1035.     END ENTER$PARM;
  1036.  
  1037.         /*
  1038.          **********************************************************
  1039.          *                                                        *
  1040.          *    EXECUTION OF SYNTHESIS BEGINS HERE.....             *
  1041.          *                                                        *
  1042.          **********************************************************
  1043.         */
  1044.  
  1045.     IF LISTPROD AND PASS2 THEN
  1046.          DO;  /*  IF LISTPROD SET PRINT OUT PRODUCTIONS */
  1047.               CALL PRINT(.('PROD $'));
  1048.               CALL PRINTDEC(PRODUCTION);
  1049.               CALL CRLF;
  1050.         END;
  1051.     CALL COPY;  /*  SETUP FOR ACCESSING PARSE TABLES */
  1052.     DO CASE PRODUCTION;  /* CALL TO SYNTHESIS HANDLES ONE PROD */
  1053.     /* CASE 0 NOT USED */ ;
  1054.  /*      1   <PROGRAM> ::= <LINE NUMBER> <STATEMENT> _|_              */
  1055.          ;
  1056.  /*      2   <LINE NUMBER> ::= <NUMBER>                               */
  1057.          DO;
  1058.               IF LOOKUP$ONLY(SP) THEN
  1059.                   DO;
  1060.                        IF GETRES THEN
  1061.                              DO;
  1062.                                   IF CODESIZE <> GETADDR THEN
  1063.                                        CALL ERROR('DL');
  1064.                              END;
  1065.                        ELSE
  1066.                              DO;
  1067.                                   CALL SETADDR(CODESIZE);
  1068.                                   CALL SETYPE(LABLE);
  1069.                              END;
  1070.                   END;
  1071.               ELSE
  1072.                    SEPARATOR = ASTRICK;
  1073.              CALL LINE$NUMBER;
  1074.         END;
  1075.  /*      3                   |                                        */
  1076.          CALL LINE$NUMBER;
  1077.  /*      4   <STATEMENT> ::= <STATEMENT LIST>                         */
  1078.           CALL CHECK$UL$ERROR;
  1079.  /*      5                 | <IF STATEMENT>                           */
  1080.           ;
  1081.  /*      6                 | <END STATEMENT>                          */
  1082.           ;
  1083.  /*      7                 | <DIMENSION STATEMENT>                    */
  1084.           ;
  1085.  /*      8                 | <DEFINE STATEMENT>                       */
  1086.           ;
  1087.  /*      9   <STATEMENT LIST> ::= <SIMPLE STATEMENT>                  */
  1088.          ;
  1089.  /*     10                      | <STATEMENT LIST> :                  */
  1090.  /*     10                        <SIMPLE STATEMENT>                  */
  1091.            ;
  1092.  /*     11   <SIMPLE STATEMENT> ::= <LET STATEMENT>                   */
  1093.             ;
  1094.  /*     12                        | <ASSIGNMENT>                      */
  1095.             ;
  1096.  /*     13                        | <FOR STATEMENT>                   */
  1097.            ;
  1098.  /*     14                        | <NEXT STATEMENT>                  */
  1099.             ;
  1100.  /*     15                        | <FILE STATEMENT>                  */
  1101.             ;
  1102.  /*     16                        | <CLOSE STATEMENT>                 */
  1103.             ;
  1104.  /*     18                        | <PRINT STATEMENT>                 */
  1105.  /*     17                        | <READ STATEMENT>                  */
  1106.             ;
  1107.             ;
  1108.  /*     19                        | <GOTO STATEMENT>                  */
  1109.             ;
  1110.  /*     20                        | <GOSUB STATEMENT>                 */
  1111.             ;
  1112.  /*     21                        | <INPUT STATEMENT>                 */
  1113.             ;
  1114.  /*     22                        | <STOP STATEMENT>                  */
  1115.             ;
  1116.  /*     23                        | <RETURN STATEMENT>                */
  1117.          ;
  1118.  /*     24                        | <ON STATEMENT>                    */
  1119.          ;
  1120.  /*     25                        | <RESTORE STATEMENT>               */
  1121.             ;
  1122.  /*     26                        | <RANDOMIZE STATEMENT>             */
  1123.          ;
  1124.  /*     27                        | <OUT STATEMENT>                   */
  1125.          ;
  1126.  /*     28                        |                                   */
  1127.             ;
  1128.  /*     29   <LET STATEMENT> ::= LET <ASSIGNMENT>                     */
  1129.          ;
  1130.  /*     30   <ASSIGNMENT> ::= <ASSIGN HEAD> <EXPRESSION>              */
  1131.          IF CHKTYP2 THEN
  1132.               CALL GEN$STORE;
  1133.  /*     31   <ASSIGN HEAD> ::= <VARIABLE> =                           */
  1134.          IF TYPEMP = SIMVAR THEN
  1135.               CALL LITERAL(SYMLOCMP);
  1136.  /*     32   <EXPRESSION> ::= <LOGICAL FACTOR>                        */
  1137.             ;
  1138.  /*     33                  | <EXPRESSION> <OR> <LOGICAL FACTOR>      */
  1139.           IF CHKTYP1 THEN
  1140.                CALL GENERATE(TYPEMP1);
  1141.  /*     34   <OR> ::= OR                                              */
  1142.           CALL SETTYPESP(BOR);
  1143.  /*     35          | XOR                                             */
  1144.           CALL SETTYPESP(EXR);
  1145.  /*     36   <LOGICAL FACTOR> ::= <LOGICAL SECONDARY>                 */
  1146.             ;
  1147.  /*     37                      | <LOGICAL FACTOR> AND                */
  1148.  /*     37                        <LOGICAL SECONDARY>                 */
  1149.          IF CHKTYP1 THEN
  1150.              CALL GENERATE(ANDO);
  1151.  /*     38   <LOGICAL SECONDARY> ::= <LOGICAL PRIMARY>                */
  1152.             ;
  1153.  /*     39                         | NOT <LOGICAL PRIMARY>            */
  1154.          IF CHKTYP3 THEN
  1155.               CALL GENERATE(NOTO);
  1156.  /*     40   <LOGICAL PRIMARY> ::= <ARITHMETIC EXPRESSION>            */
  1157.             ;
  1158.  /*     41                       | <ARITHMETIC EXPRESSION>            */
  1159.  /*     41                         <RELATION>                         */
  1160.  /*     41                         <ARITHMETIC EXPRESSION>            */
  1161.          IF CHKTYP2 THEN
  1162.               DO;
  1163.                    IF STYPESP = FLOATPT THEN
  1164.                         CALL GENERATE(TYPEMP1);
  1165.                    ELSE
  1166.                         DO;
  1167.                              CALL GENERATE(TYPEMP1 + 16);
  1168.                              CALL SETSTYPEMP(FLOATPT);
  1169.                         END;
  1170.               END;
  1171.  /*     42   <ARITHMETIC EXPRESSION> ::= <TERM>                       */
  1172.             ;
  1173.  /*     43                             | <ARITHMETIC EXPRESSION> +    */
  1174.  /*     43                               <TERM>                       */
  1175.          IF CHKTYP2 THEN
  1176.               DO;
  1177.                    IF STYPESP = FLOATPT THEN
  1178.                         CALL GENERATE(FAD);
  1179.                    ELSE
  1180.                         CALL GENERATE(CAT);
  1181.              END;
  1182.  /*     44                             | <ARITHMETIC EXPRESSION> -    */
  1183.  /*     44                               <TERM>                       */
  1184.          IF CHKTYP1 THEN
  1185.               CALL GENERATE(FMI);
  1186.  /*     45                             | + <TERM>                     */
  1187.          IF CHKTYP3 THEN   ; /* NO ACTION REQUIRED */
  1188.  /*     46                             | - <TERM>                     */
  1189.          IF CHKTYP3 THEN
  1190.               CALL GENERATE(NEG);
  1191.  /*     47   <TERM> ::= <PRIMARY>                                     */
  1192.          ;
  1193.  /*     48            | <TERM> * <PRIMARY>                            */
  1194.          IF CHKTYP1 THEN
  1195.               CALL GENERATE(FMU);
  1196.  /*     49            | <TERM> / <PRIMARY>                            */
  1197.          IF CHKTYP1 THEN
  1198.               CALL GENERATE(FDI);
  1199.  /*     50   <PRIMARY> ::= <ELEMENT>                                  */
  1200.             ;
  1201.  /*     51               | <PRIMARY> ** <ELEMENT>                     */
  1202.          IF CHKTYP1 THEN
  1203.               CALL GENERATE(EXP);
  1204.  /*     52   <ELEMENT> ::= <VARIABLE>                                 */
  1205.          IF TYPESP = SIMVAR THEN
  1206.               CALL LITLOAD(SYMLOCSP);
  1207.          ELSE
  1208.               CALL GENERATE(LOD);
  1209.  /*     53               | <CONSTANT>                                 */
  1210.             ;
  1211.  /*     54               | <FUNCTION CALL>                            */
  1212.          ;
  1213.  /*     55               | ( <EXPRESSION> )                           */
  1214.          CALL SETSTYPEMP(STYPEMP1);
  1215.  /*     56   <VARIABLE> ::= <IDENTIFIER>                              */
  1216.          CALL PROCESS$SIMPLE$VARIABLE(SP);
  1217.  /*     57                | <SUBSCRIPT HEAD> <EXPRESSION> )           */
  1218.          DO;
  1219.               IF FORSTMT THEN
  1220.                    CALL ERROR('FI');
  1221.               CALL CHKTYP5;
  1222.               BASE = SYMLOCMP;
  1223.               IF GETSUBTYPE <> TYPEMP THEN
  1224.                    CALL ERROR('SN');
  1225.               CALL LITLOAD(GETADDR);
  1226.               CALL GENERATE(SUBO);
  1227.               CALL SETTYPEMP(SUBVAR);
  1228.          END;
  1229.  /*     58   <SUBSCRIPT HEAD> ::= <IDENTIFIER> (                      */
  1230.          DO;
  1231.               IF((NOT LOOKUP$ONLY(MP)) OR (GETYPE <> SUBVAR)) THEN
  1232.                    CALL ERROR('IS');
  1233.          CALL SETTYPEMP(0);
  1234.          CALL SETSYMLOCMP(BASE);
  1235.          END;
  1236.  /*     59                      | <SUBSCRIPT HEAD> <EXPRESSION> ,     */
  1237.          CALL CHKTYP5;
  1238.  /*     60   <FUNCTION CALL> ::= <FUNCTION HEADING> <EXPRESSION> )    */
  1239.          DO;
  1240.               CALL CHECKPARM;
  1241.               SRLOCSP = SRLOCMP;
  1242.               CALL FUNCGEN;
  1243.          END;
  1244.  /*     61                     | <FUNCTION NAME>                      */
  1245.          CALL FUNCGEN;
  1246.  /*     62   <FUNCTION HEADING> ::= <FUNCTION NAME> (                 */
  1247.          CALL GEN$PARM;
  1248.  /*     63                        | <FUNCTION HEADING> <EXPRESSION>   */
  1249.  /*     63                          ,                                 */
  1250.          DO;
  1251.               CALL CHECK$PARM;
  1252.               CALL GEN$PARM;
  1253.          END;
  1254.  /*     64   <FUNCTION NAME> ::= <USERDEFINED NAME>                   */
  1255.          IF LOOKUP$ONLY(SP) THEN
  1256.               DO;
  1257.                    CALL SETSRLOCSP(BASE);
  1258.                    CALL SETSYMLOCSP(BASE);
  1259.                    CALL SETTYPESP(UNFUNC);
  1260.                    CALL SETHASHSP(GETYPE);
  1261.               END;
  1262.          ELSE
  1263.               CALL ERROR('FU');
  1264.  /*     65                     | <PREDEFINED NAME>                    */
  1265.          DO;
  1266.               CALL SETTYPESP(FUNCOP);
  1267.               CALL SETHASHSP(SHR(STYPESP,2) AND 07H);
  1268.           END;
  1269.  /*     66   <CONSTANT> ::= <NUMBER>                                  */
  1270.          CALL GENCON;
  1271.  /*     67                | <STRING>                                  */
  1272.          CALL GEN$ILS(.ACCUM);
  1273.  /*     68   <RELATION> ::= =                                         */
  1274.          CALL SETTYPESP(7);
  1275.  /*     69                | > =                                       */
  1276.          CALL SETTYPEMP(9);
  1277.  /*     70                | GE                                        */
  1278.          CALL SETTYPEMP(9);
  1279.  /*     71                | < =                                       */
  1280.          CALL SETTYPEMP(10);
  1281.  /*     72                | LE                                        */
  1282.          CALL SETTYPEMP(10);
  1283.  /*     73                | >                                         */
  1284.          CALL SETTYPESP(6);
  1285.  /*     74                | <                                         */
  1286.          CALL SETTYPESP(5);
  1287.  /*     75                | < >                                       */
  1288.          CALL SETTYPEMP(8);
  1289.  /*     76                | NE                                        */
  1290.          CALL SETTYPEMP(8);
  1291.  /*     77   <FOR STATEMENT> ::= <FOR HEAD> TO <EXPRESSION>           */
  1292.  /*     77                       <STEP CLAUSE>                        */
  1293.          DO;
  1294.               BASE = FORADDRESS(3);
  1295.               IF TYPESP THEN
  1296.                    CALL GENERATE(DUP);
  1297.               CALL LITLOAD(GETADDR);
  1298.               CALL GENERATE(FAD);
  1299.                IF TYPESP THEN
  1300.                     DO;
  1301.                         CALL LITERAL(GETADDR);
  1302.                         CALL GENERATE(XCH);
  1303.                     END;
  1304.               CALL GENERATE(STO);
  1305.               IF TYPESP THEN
  1306.                    DO;
  1307.                         CALL GENERATE(XCH);
  1308.                         CALL LITERAL(0);
  1309.                         CALL GENERATE(LSS);
  1310.                         CALL LITERAL(5);
  1311.                         CALL GENERATE(BFC);
  1312.                         CALL GENERATE(LEQ);
  1313.                         CALL LITERAL(2);
  1314.                         CALL GENERATE(BFN);
  1315.                    END;
  1316.               CALL GENERATE(GEQ);
  1317.               CALL GENERATE(BRC);
  1318.               CALL GEN$TWO(FORADDRESS(0));
  1319.               FORADDRESS(1) = CODESIZE;
  1320.          END;
  1321.  /*     78   <FOR HEAD> ::= <FOR> <ASSIGNMENT>                        */
  1322.          DO;
  1323.               CALL GENERATE(BRS);
  1324.               CALL GEN$TWO(FORADDRESS(1));
  1325.               FORADDRESS(2) = CODESIZE;
  1326.          END;
  1327.  /*     79   <FOR> ::= FOR                                            */
  1328.          DO;
  1329.               FORSTMT = TRUE;
  1330.               SBTBLTOP,NEXTSTMTPTR = SBTBLTOP - 8;
  1331.               NEXTBYTEV(1) = NEXTBYTEV(1) AND 7FH;
  1332.               CALL LIMITS(0);
  1333.               FORCOUNT = FORCOUNT + 1;
  1334.          END;
  1335.  /*     80   <STEP CLAUSE> ::= STEP <EXPRESSION>                      */
  1336.          CALL SETTYPEMP(TRUE);
  1337.  /*     81                   |                                        */
  1338.          DO;
  1339.               BASE = FORADDRESS(3);
  1340.               CALL LITERAL(GETADDR);
  1341.               CALL SETTYPESP(FALSE);
  1342.               CALL GENERATE(CON);
  1343.               CALL GEN$TWO(0);
  1344.          END;
  1345.  /*     82   <IF STATEMENT> ::= <IF GROUP>                            */
  1346.          CALL ENTER$COMPILER$LABEL(0);
  1347.  /*     83                    | <IF ELSE GROUP> <STATEMENT LIST>      */
  1348.          CALL ENTER$COMPILER$LABEL(0);
  1349.  /*     84                    | IF END # <EXPRESSION> THEN <NUMBER>   */
  1350.          DO;
  1351.               CALL GENERATE(RON);
  1352.               CALL GENERATE(DEF);
  1353.               CALL FINDLABEL;
  1354.               CALL GEN$TWO(GETADDR);
  1355.          END;
  1356.  /*     85   <IF GROUP> ::= <IF HEAD> <STATEMENT LIST>                */
  1357.             ;
  1358.  /*     86                | <IF HEAD> <NUMBER>                        */
  1359.          CALL RESOLVE$LABEL;
  1360.  /*     87   <IF ELSE GROUP> ::= <IF HEAD> <STATEMENT LIST> ELSE      */
  1361.          DO;
  1362.          CALL ENTER$COMPILER$LABEL(3);
  1363.               CALL GENERATE(BRS);
  1364.               CALL COMPILER$LABEL;
  1365.          END;
  1366.  /*     88   <IF HEAD> ::= IF <EXPRESSION> THEN                       */
  1367.          DO;
  1368.               IF STYPEMP1 = STRING THEN
  1369.                    CALL ERROR('IE');
  1370.               CALL GENERATE(BRC);
  1371.               CALL COMPILER$LABEL;
  1372.          END;
  1373.  /*     89   <DEFINE STATEMENT> ::= <UD FUNCTION NAME>                */
  1374.  /*     89                          <DUMMY ARG LIST> = <EXPRESSION>   */
  1375.          IF CHKTYP2 THEN
  1376.               DO;
  1377.                    BASE = SYMLOCMP;
  1378.                    CALL SETYPE(TYPEMP1);
  1379.                    CALL UNLINK;
  1380.                    CALL GENERATE(XCH);
  1381.                    CALL GENERATE(RTN);
  1382.                    CALL ENTER$COMPILER$LABEL(0);
  1383.               END;
  1384.  /*     90   <UD FUNCTION NAME> ::= DEF <USERDEFINED NAME>            */
  1385.          DO;
  1386.               DECLARE FLAG BYTE;
  1387.               CALL GENERATE(BRS);
  1388.               CALL COMPILER$LABEL;
  1389.               FLAG = NORMAL$LOOKUP(SP);
  1390.               CALL SETSTYPEMP(STYPESP);
  1391.               CALL SETSYMLOCMP(BASE);
  1392.               IF PASS1 THEN
  1393.                    DO;
  1394.                         IF FLAG THEN
  1395.                              CALL ERROR('FD');
  1396.                         CALL SETADDR(CODESIZE);
  1397.                    END;
  1398.               ELSE
  1399.                    CALL RELINK;
  1400.          END;
  1401.  /*     91   <DUMMY ARG LIST> ::= <DUMMY ARG HEAD> <IDENTIFIER> )     */
  1402.          CALL ENTER$PARM;
  1403.  /*     92                      |                                     */
  1404.          CALL SETTYPEMP(0);
  1405.  /*     93   <DUMMY ARG HEAD> ::= (                                   */
  1406.          CALL SETTYPEMP(0);
  1407.  /*     94                      | <DUMMY ARG HEAD> <IDENTIFIER> ,     */
  1408.          CALL ENTER$PARM;
  1409.  /*     95   <FILE STATEMENT> ::= <FILE HEAD> <FILE DECLERATION>      */
  1410.             ;
  1411.  /*     96   <FILE HEAD> ::= FILE                                     */
  1412.             ;
  1413.  /*     97                 | <FILE HEAD> <FILE DECLERATION> ,         */
  1414.             ;
  1415.  /*     98   <FILE DECLERATION> ::= <IDENTIFIER> <FILE REC SIZE>      */
  1416.          DO;
  1417.               CALL PROCESS$SIMPLE$VARIABLE(MP);
  1418.               IF STYPEMP = FLOATPT THEN
  1419.                    CALL ERROR('IF');
  1420.               CALL LITLOAD(SYMLOCSP);
  1421.               CALL GENERATE(OPN);
  1422.          END;
  1423.  /*     99   <FILE REC SIZE> ::= ( <EXPRESSION> )                     */
  1424.          CALL CHKTYP4;
  1425.  /*    100                     |                                      */
  1426.          CALL LITERAL(0);
  1427.  /*    101   <DIMENSION STATEMENT> ::= DIM                            */
  1428.  /*    101                             <DIMENSION VARIABLE LIST>      */
  1429.          ;
  1430.  /*    102   <DIMENSION VARIABLE LIST> ::= <DIMENSION VARIABLE>       */
  1431.          CALL SUBCALC;
  1432.  /*    103                               |                            */
  1433.  /*    103                                <DIMENSION VARIABLE LIST>   */
  1434.  /*    103                                 , <DIMENSION VARIABLE>     */
  1435.          CALL SUBCALC;
  1436.  /*    104   <DIMENSION VARIABLE> ::= <DIM VAR HEAD> <EXPRESSION> )   */
  1437.          DO;
  1438.               CALL CHKTYP5;
  1439.               BASE = SYMLOCMP;
  1440.          END;
  1441.  /*    105   <DIM VAR HEAD> ::= <IDENTIFIER> (                        */
  1442.               DO;
  1443.                    IF NORMAL$LOOKUP(MP) AND PASS1 THEN
  1444.                         CALL ERROR('DP');
  1445.                    CALL SETYPE(SUBVAR);
  1446.                    IF PASS1 THEN
  1447.                         CALL SETADDR(COUNTPRT);
  1448.                    CALL LITERAL(GETADDR);
  1449.                    CALL SETTYPEMP(0);
  1450.                    CALL SETSYMLOCMP(BASE);
  1451.               END;
  1452.  /*    106                    | <DIM VAR HEAD> <EXPRESSION> ,         */
  1453.          CALL CHKTYP5;
  1454.  /*    107   <CLOSE STATEMENT> ::= CLOSE <CLOSE LIST>                 */
  1455.             ;
  1456.  /*    108   <CLOSE LIST> ::= <EXPRESSION>                            */
  1457.          DO;
  1458.               IF STYPESP = STRING THEN
  1459.                      CALL ERROR('MF');
  1460.               CALL GENERATE(RON);
  1461.               CALL GENERATE(CLS);
  1462.          END;
  1463.  /*    109                  | <CLOSE LIST> , <EXPRESSION>             */
  1464.          DO;
  1465.               IF STYPESP = STRING THEN
  1466.                    CALL ERROR('MF');
  1467.               CALL GENERATE(RON);
  1468.               CALL GENERATE(CLS);
  1469.          END;
  1470.  /*    110   <READ STATEMENT> ::= READ <FILE OPTION> <READ LIST>      */
  1471.          IF FILEIO THEN
  1472.               DO;
  1473.                    CALL GENERATE(EDR);
  1474.                    FILEIO = FALSE;
  1475.               END;
  1476.  /*    111                      | READ <READ LIST>                    */
  1477.          ;
  1478.  /*    112   <INPUT STATEMENT> ::= INPUT <PROMPT OPTION>              */
  1479.  /*    112                         <READ LIST>                        */
  1480.          DO;
  1481.               CALL GENERATE(ECR);
  1482.               INPUTSTMT = FALSE;
  1483.          END;
  1484.  /*    113   <PROMPT OPTION> ::= <CONSTANT> ;                         */
  1485.          DO;
  1486.               CALL PUT$FIELD;
  1487.               CALL SETUP$INPUT;
  1488.          END;
  1489.  /*    114                     |                                      */
  1490.          CALL SETUP$INPUT;
  1491.  /*    115   <READ LIST> ::= <VARIABLE>                               */
  1492.          CALL GET$FIELD;
  1493.  /*    116                 | <READ LIST> , <VARIABLE>                 */
  1494.          CALL GET$FIELD;
  1495.  /*    117                 |                                          */
  1496.           FILEIO = FALSE;
  1497.  /*    118   <PRINT STATEMENT> ::= PRINT <PRINT LIST> <PRINT END>     */
  1498.          ;
  1499.  /*    119                       | PRINT <FILE OPTION> <FILE LIST>    */
  1500.          DO;
  1501.               CALL GENERATE(EDW);
  1502.               FILEIO = FALSE;
  1503.          END;
  1504.  /*    120   <PRINT LIST> ::= <EXPRESSION>                            */
  1505.          CALL PUT$FIELD;
  1506.  /*    121                  | <PRINT LIST> <PRINT DELIM>              */
  1507.  /*    121                    <EXPRESSION>                            */
  1508.          CALL PUT$FIELD;
  1509.  /*    122                  |                                         */
  1510.          ;
  1511.  /*    123   <FILE LIST> ::= <EXPRESSION>                             */
  1512.          CALL PUT$FIELD;
  1513.  /*    124                 | <EXPRESSION> , <EXPRESSION>              */
  1514.          CALL PUT$FIELD;
  1515.  /*    125   <PRINT END> ::= <PRINT DELIM>                            */
  1516.          ;
  1517.  /*    126                 |                                          */
  1518.               CALL GENERATE(DBF);
  1519.  /*    127   <FILE OPTION> ::= # <EXPRESSION> ;                       */
  1520.          DO;
  1521.               FILEIO = TRUE;
  1522.               CALL GENERATE(RON);
  1523.               CALL GENERATE(RDB);
  1524.          END;
  1525.  /*    128                   | # <EXPRESSION> , <EXPRESSION> ;        */
  1526.          DO;
  1527.               FILEIO = TRUE;
  1528.               CALL GENERATE(RON);
  1529.               CALL GENERATE(XCH);
  1530.               CALL GENERATE(RON);
  1531.               CALL GENERATE(RDF);
  1532.          END;
  1533.  /*    129   <PRINT DELIM> ::= ;                                      */
  1534.          ;
  1535.  /*    130                   | ,                                      */
  1536.          IF NOT FILEIO THEN
  1537.               CALL GENERATE(NSP);
  1538.  /*    131   <GOTO STATEMENT> ::= <GOTO> <NUMBER>                     */
  1539.          CALL RESOLVE$LABEL;
  1540.  /*    132   <ON STATEMENT> ::= <ON GOTO> <LABEL LIST>                */
  1541.          CALL GEN$ON$2;
  1542.  /*    133                    | <ON GOSUB> <LABEL LIST>               */
  1543.          DO;
  1544.               CALL GEN$ON$2;
  1545.               CALL ENTER$COMPILER$LABEL(0);
  1546.          END;
  1547.  /*    134   <ON GOTO> ::= ON <EXPRESSION> <GOTO>                     */
  1548.          CALL GEN$ON;
  1549.  /*    135   <ON GOSUB> ::= ON <EXPRESSION> <GOSUB>                   */
  1550.          DO;
  1551.               CALL SET$COMPILER$LABEL;
  1552.               CALL LITERAL(GETADDR);
  1553.                CALL GENERATE(ADJ);
  1554.                CALL GENERATE(XCH);
  1555.               CALL GEN$ON;
  1556.          END;
  1557.  /*    136   <LABEL LIST> ::= <NUMBER>                                */
  1558.          DO;
  1559.               CALL RESOLVE$LABEL;
  1560.               CALL SETTYPESP(1);
  1561.          END;
  1562.  /*    137                  | <LABEL LIST> , <NUMBER>                 */
  1563.          DO;
  1564.               CALL RESOLVE$LABEL;
  1565.               CALL SETTYPEMP(TYPEMP + 1);
  1566.          END;
  1567.  /*    138   <GOSUB STATEMENT> ::= <GOSUB> <NUMBER>                   */
  1568.          DO;
  1569.               GOSUBSTMT = TRUE;
  1570.               CALL RESOLVE$LABEL;
  1571.               GOSUBSTMT = FALSE;
  1572.          END;
  1573.  /*    139   <GOTO> ::= GOTO                                          */
  1574.          ;
  1575.  /*    140            | GO TO                                         */
  1576.          ;
  1577.  /*    141   <GOSUB> ::= GOSUB                                        */
  1578.          ;
  1579.  /*    142             | GO SUB                                       */
  1580.          ;
  1581.  /*    143   <NEXT STATEMENT> ::= <NEXT HEAD> <IDENTIFIER>            */
  1582.          CALL GEN$NEXT$WITH$IDENT;
  1583.  /*    144                      | NEXT                                */
  1584.          CALL GENNEXT;
  1585.  /*    145   <NEXT HEAD> ::= NEXT                                     */
  1586.          ;
  1587.  /*    146                 | <NEXT HEAD> <IDENTIFIER> ,               */
  1588.          CALL GEN$NEXT$WITH$IDENT;
  1589.  /*    147   <OUT STATEMENT> ::= OUT <EXPRESSION> , <EXPRESSION>      */
  1590.          IF STYPEMP1 <> FLOATPT OR STYPESP <> FLOATPT THEN
  1591.               CALL ERROR('MF');
  1592.          ELSE
  1593.          DO;
  1594.               CALL GENERATE(RON);
  1595.               CALL GENERATE(XCH);
  1596.               CALL GENERATE(RON);
  1597.               CALL GENERATE(POT);
  1598.          END;
  1599.  /*    148   <RETURN STATEMENT> ::= RETURN                            */
  1600.          CALL GENERATE(RTN);
  1601.  /*    149   <STOP STATEMENT> ::= STOP                                */
  1602.          CALL GENERATE(XIT);
  1603.  /*    150   <END STATEMENT> ::= END                                  */
  1604.          IF PASS1 THEN
  1605.               DO;
  1606.                    PASS1 = FALSE;
  1607.                    CALL REWIND$SOURCE$FILE;
  1608.                    IF FORCOUNT <> 0 THEN
  1609.                         DO;
  1610.                              CALL ERROR('FU');
  1611.                              FORCOUNT = 0;
  1612.                         END;
  1613.                    CALL GENERATE('*');
  1614.                    CALL GENTWO((CODESIZE + 3) AND 0FFFCH);
  1615.                    CALL GENTWO(DATACT);
  1616.                    CALL GENTWO(COUNTPRT);
  1617.               END;
  1618.          ELSE
  1619.               DO;
  1620.                    DO WHILE NEXTCHAR <> EOLCHAR;
  1621.                         NEXTCHAR = GETCHAR;
  1622.                         END;
  1623.                    CALL GENERATE(XIT);
  1624.                    CALL GENERATE(7FH);
  1625.                    CALL WRITE$INT$FILE;
  1626.                    CALL CLOSE$INT$FILE;
  1627.                    CALL PRINTDEC(ERRORCOUNT);
  1628.                    CALL PRINT(.(' ERRORS DETECTED$'));
  1629.                    CALL CRLF;
  1630.                    CALL MON3;
  1631.               END;
  1632.  /*    151   <RESTORE STATEMENT> ::= RESTORE                          */
  1633.          CALL GENERATE(RST);
  1634.  /*    152   <RANDOMIZE STATEMENT> ::= RANDOMIZE                      */
  1635.          CALL GENERATE(IRN);
  1636.     END /* OF CASES */;
  1637.  
  1638. END SYNTHESIZE;
  1639. END;
  1640.