%#######################################################################00001000          
%                                                                       00001010          
%                   B-5700 ESPOL COMPILER                               00001020          
%                        MARK XVI.0.00                                  00001030          
%                        OCT  1, 1974                                   00001040          
%                                                                       00001050          
%#######################################################################00001060          
%                                                                       00001070          
  COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE            *    00001072          
           * FILE ID: SYMBOL/ESPOL TAPE ID: SYMBOL1/FILE000        *    00001073          
           * THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION *    00001074          
           * AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED       *    00001075          
           * EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON     *    00001076          
           * WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF       *    00001077          
           * BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232        *    00001078          
           *                                                       *    00001079          
           * COPYRIGHT (C)  1971, 1972, 1974                       *    00001080          
           *       BURROUGHS CORPORATION                           *    00001081          
           *  AA320206    AA393180   AA332366                      *;   00001082          
COMMENT#################################################################00001110          
                   ERROR MESSAGES                                       00001120          
########################################################################00001130          
%                                                                       00001140          
ERROR NUMBER  ROUTINE:ERROR MESSAGE                                     00002000          
 000          BLOCK:  DECLARATION NOT FOLLOWED BY SEMICOLON.            00003000          
 001          BLOCK:  IDENTIFIER DECLARED TWICE IN SAME BLOCK.          00004000          
 002          PROCEDUREDEC: SPECIFICATION PART CONTAINS                 00005000          
                            IDENTIFIER NOT APPEARING IN                 00006000          
                            FORMAL PARAMETER PART.                      00007000          
 003          BLOCK:  NON-IDENTIFIER APPEARS IN IDENTIFIER              00008000          
                      LIST OF DECLARATION.                              00009000          
 004          PROCEDUREDEC: STREAM PROCEDURE DECLARATION                00010000          
                            PRECEDED BY ILLEGAL DECLARATOR.             00011000          
 005          PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED              00012000          
                            BY ILLEGAL DECLARATOR.                      00013000          
 006          PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE            00014000          
                            IN SAME BLOCK(NOT FORWARD).                 00015000          
 007          PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED           00016000          
                            BY ( OR SEMICOLON IN PROCEDURE              00017000          
                            DECLARATION.                                00018000          
 008          PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED          00019000          
                            BY ).                                       00020000          
 009          PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED          00021000          
                            BY SEMICOLON.                               00022000          
 010          PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER              00023000          
                            WHICH DID NOT APPEAR IN FORMAL              00024000          
                            PARAPART.                                   00025000          
 011          PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON.          00026000          
 012          PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION            00027000          
                            PART.                                       00028000          
 013          PROCEDUREDEC: OWN USED IN ARRAY SPECIFICATION.            00029000          
 014          PROCEDUREDEC: SAVE USED IN ARRAY SPECIFICATION.           00030000          
 015          BLOCK:  DECLARATION PRECEDED BY ILLEGAL DECLARATOR.       00031000          
 016          ARRAYDEC:     ARRAY ID IN DECLARATION NOT FOLLOWED        00032000          
                            BY [ .                                      00033000          
 017          ARRAYDEC:     LOWER BOUND IN ARRAY DEC NOT                00034000          
                            FOLLOWED BY : .                             00035000          
 018          ARRAYDEC:     BOUND PAIR LIST NOT FOLLOWED BY ].          00036000          
 019          ARRAYSPEC:    ILLEGAL LOWER BOUND DESIGNATOR IN           00037000          
                            ARRAY SPECIFICATION.                        00038000          
 020          BLOCK:        OWN APPEARS IMMEDIATELY BEFORE              00039000          
                            IDENTIFIER(NO TYPE).                        00040000          
 021          BLOCK:        SAVE APPEARS IMMEDIATELY BEFORE             00041000          
                            IDENTIFIER(NO TYPE).                        00042000          
 022          BLOCK:        STREAM APPEARS IMMEDIATELY BEFORE           00043000          
                            IDENTIFIER(THE WORD PROCEDURE LEFT          00044000          
                            OUT).                                       00045000          
 023          BLOCK:        DECLARATOR PRECEDED ILLEGALLY BY            00046000          
                            ANOTHER DECLARATOR.                         00047000          
 024          PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION.         00048000          
 025          BLOCK:        DECLARATOR OR SPECIFIER ILLEGALLY           00049000          
                            PRECEDED BY OWN OR SAVE OR SOME             00050000          
                            OTHER DECLARATOR.                           00051000          
 026          FILEDEC:      MISSING ( IN FILE DEC.                      00052000          
 027          FILEDEC:      NO. OF BUFFERS IN FILE DEC MUST BE          00053000          
                            AN UNSIGNED INTEGER.                        00054000          
 028          FILEDEC:      ILLEGAL BUFFER PART OR SAVE FACTOR          00055000          
                            IN FILE DEC.                                00056000          
 029          FILEDEC:      MISSING ) IN FILE DEC.                      00057000          
 030          PROCEDUREDEC: PROCEDURE TYPE AT ACTUAL DECLARATION        00058000          
                            TIME DIFFERENT THAN AT FORWARD DEC.         00059000          
 031          LISTDEC:      MISSING ( IN LISTDEC.                       00060000          
 032          FORMATDEC:    MISSING ( IN FORMAT DEC.                    00061000          
 033          SWITCHDEC:    SWITCH DEC DOES NOT HAVE ~ OR               00062000          
                            FORWARD AFTER IDENTIFIER.                   00063000          
 034          SWITCHFILEDEC:MISSING ~ AFTER FILED.                      00064000          
 035          SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION        00065000          
                            OF SWITCHFILE.                              00066000          
 036          SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~   .            00067000          
 037          SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE .       00068000          
 038          SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS.                00069000          
 040          SEGMENT:      SAVE CODE EXCEEDS 4080 WHICH KERNEL CAN H/L 00069100          
050    ANYWHERE:   OUT OF RANGE OF C RELATIVE ADDRESSING FOR CONSTANT   00069500          
051    BLOCK    :  ILLEGAL F RELATIVE ADDRESS EXP IN DECLARATION        00069510          
052  BLOCK:    PROCEDURE WHOSE BODY NOT A BLOCK                         00069520          
053      ARRAYDEC:  CANT FIND RIGHT BRACKET IN SAVE ARRAY DEC           00069530          
054      ARRAYDEC: FILL PART OF SAVE ARRAY DEC LONGER THAN SIZE         00069540          
056      ARRAYDEC: ILLEGAL DIMENSION INDICATOR IN ARRAY DEC             00069560          
057      SEGMENTSTART:SAVE STORAGE NOT ALLOWED WITH INTRINSIC OPTION    00069570          
 098          IOSTMT:  ILLEGAL SPECIFIER IN SCOPE STMT: MUST BE }15.    00069980          
 099          INLINE:  EXTRA : IN STREAM HEAD.                          00069990          
 100          ANYWHERE:  UNDECLARED IDENTIFIER.                         00070000          
 101          CHECKER:  AN ATTEMPT HAS BEEN MADE TO ADDRESS AN          00071000          
                   IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000          
                   TO ANOTHER.  IF THE QUANTITY IS A PROCEDURE NAME OR  00073000          
                   AN OWN VARIABLE THIS RESTRICTION IS RELAXED.         00074000          
 102          AEXP:  CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH  00075000          
 103          PRIMARY:  PRIMARY MAY NOT BEGIN WITH A QUANTITY OF THIS   00076000          
                   TYPE.                                                00077000          
 104          ANYWHERE:  MISSING RIGHT PARENTHESIS.                     00078000          
 105          ANYWHERE:  MISSING LEFT PARENTHESIS.                      00079000          
 106          PRIMARY:  PRIMARY MAY NOT START WITH DECLARATOR.          00080000          
 107          BEXP:  THE EXPRESSION IS NOT OF BOOLEAN TYPE.             00081000          
 108          EXPRSS:  A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS  00082000          
                   AS THE ARITHMETIC EXPRESSIONS.                       00083000          
 109          BOOSEC,SIMPBOO, AND BOOCOMP:   THE PRIMARY IS NOT BOOLEAN.00084000          
 110          BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN       00085000          
                   EXPRESSION.                                          00086000          
 111          BOOPRIM:  NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000          
                   TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE.      00088000          
 112          BOOPRIM:  NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000          
                   TIONAL) MAY BEGIN WITH A DECLARATOR.                 00090000          
 113          PARSE:  EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000          
                   A CONCATENATE OPERATOR IS INCORRECT.                 00092000          
 114          DOTSYNTAX:  EITHER THE SYNTAX OR THE RANGE OF THE LITERALS00093000          
                   FOR A PARTIAL WORD DESIGNATOR IS INCORRECT.          00094000          
 115          DEXP:  THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE.       00095000          
 116          IFCLAUSE:  MISSING THEN.                                  00096000          
 117          BANA:  MISSING LEFT BRAKET.                               00097000          
 118          BANA:  MISSING RIGHT BRAKET.                              00098000          
 119          COMPOUNDTAIL:  MISSING SEMICOLON OR END.                  00099000          
 120          COMPOUNDTAIL:  MISSING END.                               00100000          
 121          ACTUALPARAPART:  AN INDEXED FILE MAY BE PASSED BY NAME    00101000          
                   ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM     00102000          
                   PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA-    00103000          
                   METER.                                               00104000          
 122          ACTUALPARAPART:  STREAM PROCEDURE MAY NOT HAVE AN         00105000          
                   EXPRESSION PASSED TO IT BY NAME.                     00106000          
 123          ACTUALPARAPART:  THE ACTUAL AND FORMAL PARAMETERS DO NOT  00107000          
                   AGREE AS TO TYPE.                                    00108000          
 124          ACTUALPARAPART:  ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000          
                   NUMBER OF DIMENSIONS.                                00110000          
 125          ACTUALPARAPART:  STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000          
                   PARAMETER TO A PROCEDURE.                            00112000          
 126          ACTUALPARAPART:  NO ACTUAL PARAMETER MAY BEGIN WITH A     00113000          
                   QUANTITY OF THIS TYPE.                               00114000          
 127          ACTUALPARAPART:  THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000          
                   STREAM PROCEDURE.                                    00116000          
 128          ACTUALPARAPART:  EITHER ACTUAL AND FORMAL PARAMETERS DO   00117000          
                   NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS.  00118000          
 129          ACTUALPARAPART:  ILLEGAL PARAMETER DELIMITER.             00119000          
 130          RELSESTMT:  NO FILE NAME.                                 00120000          
 131          DOSTMT:  MISSING UNTIL.                                   00121000          
 132          WHILESTMT:  MISSING DO.                                   00122000          
 133          LABELR:  MISSING C OLON.                                  00123000          
 134          LABELR:  THE LABEL WAS NOT DECLARED IN THIS BLOCK.        00124000          
 135          LABELR:  THE LABEL HAS ALREADY OCCURED.                   00125000          
 136          FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE.             00126000          
 137          FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN    00127000          
                   INTEGER WHERE AN INTEGER IS REQUIRED.                00128000          
 138          FORMATPHRASE:  THE WIDTH IS TOO SMALL IN E OR F EDITING   00129000          
                   PHRASE.                                              00130000          
 139          TABLE:  DEFINE IS NESTED MORE THAN EIGHT DEEP.            00131000          
 140          NEXTENT:  AN INTEGER IN A FORMAT IS GREATER THAN 1023.    00132000          
 141          SCANNER:  INTEGER OR IDENTIFIER HAS MORE THAN 63          00133000          
                   CHARACTORS.                                          00134000          
 142          DEFINEGEN:  A DEFINE CONTAINS MORE THAN 2047 CHARACTORS   00135000          
                   (BLANK SUPPRESSED).                                  00136000          
 143          COMPOUNDTAIL:  EXTRA END.                                 00137000          
 144          STMT:  NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER.  00138000          
 145          STMT:  NO STATEMENT MAY START WITH THIS TYPE QUANTITY.    00139000          
 146          STMT:  NO STATEMENT MAY START WITH A DECLARATOR - MAY BE  00140000          
                   A MISSING END OF A PROCEDURE OR A MISPLACED          00141000          
                   DECLARATION.                                         00142000          
 147          SWITCHGEN:  MORE THAN 256 EXPRESSIONS IN A SWITCH         00143000          
                   DECLARATION.                                         00144000          
 148          GETSPACE:  MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS   00145000          
                   ARE REQUIRED FOR THIS PROGRAM.                       00146000          
 149          GETSPACE:  MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000          
                   PROCEDURE.                                           00148000          
 150          ACTUALPARAPART:  CONSTANTS MAY NOT BE PASSED BY NAME TO   00149000          
                   STREAM PROCEDURES.                                   00150000          
 151          FORSTMT:  IMPROPER FOR INDEX VARIABLE.                    00151000          
 152          FORSTMT:  MISSING LEFT ARROW FOLLOWING INDEX VARIABLE.    00152000          
 153          FORSTMT:  MISSING UNTIL OR WHILE IN STEP ELEMENT.         00153000          
 154          FORSTMT:  MISSING DO IN FOR CLAUSE.                       00154000          
 155          IFEXP:  MISSING ELSE                                      00155000          
 156          LISTELEMENT:  A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST00156000          
                   ELEMENT.                                             00157000          
 157          LISTELEMENT:  A ROW DESIGNATOR MAY NOT BE A LIST ELEMENT  00158000          
 158          LISTELEMENT:  MISSING RIGHT BRAKET IN GROUP OF ELEMENTS   00159000          
 159          PROCSTMT:  ILLEGAL USE OF PROCEDURE OR FUNCTION IDENTIFIER00160000          
 160          PURGE:  DECLARED LABEL DOES NOT OCCUR.                    00161000          
 161          PURGE:  DECLARED FORWARD PROCEDURE DOES NOT OCCUR.        00162000          
 163          ZIPSTMT:  MISSING COMMA IN ZIP STATEMENT                  00163000          
 163          FORMATPHRASE:  THE WIDTH OF A FIELD IS MORE THAN 63.      00164000          
 200          EMIT:   SEGMENT TOO LARGE ( > 4093SYLLABLES).             00165000          
 201          SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT  LEFT-MOST   00166000          
                        IN A LEFT PART LIST.                            00167000          
 202          SIMPLE VARIABLE: MISSING . OR ~ .                         00168000          
 203          SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000          
                        DESIGNATOR.                                     00170000          
 204          SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR.      00171000          
 205          SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000          
                        AN ACTUAL PARAMETER LIST OR FILL STATEMENT.     00173000          
 206          SUBSCRIPTED VARIABLE: MISSING ].                          00174000          
 207          SUBSCRIPTED VARIABLE: MISSING [.                          00175000          
 208          SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS.         00176000          
 209          SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-   00177000          
                        MOST IN A LEFT PART LIST.                       00178000          
 210          SUBSCRIPTED VARIABLE: MISSING . OR ~ .                    00179000          
 211          VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00180000          
 250          STREAM STMT:ILLEGAL STREAM STATEMENT.                     00181000          
 251          ANY STREAM STMT PROCEDURE: MISSING ~.                     00182000          
 252          INDEX: MISSING + OR - .                                   00183000          
 253          INDEX: MISSING NUMBER OR STREAM VARIABLE.                 00184000          
 254          EMITC: NUMBER>63 OR NUMBER OF LABELS+LOCALS+FORMALS>63.   00185000          
 255          DSS: MISSING STRING IN DS~ LIT STATEMENT.                 00186000          
 256          RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT   00187000          
                        A FORMAL PARAMETER.                             00188000          
 257          GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000          
                        NEST LEVEL AS A PRECEDING APPEARANCE OF THE     00190000          
                        LABEL.                                          00191000          
 258          LABELS: MISSING :.                                        00192000          
 259          LABELS: LABEL APPEARS MORE THAN ONCE.                     00193000          
 260          GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000          
 261          JUMPS: MISSING OUT IN JUMP OUT STATEMENT.                 00195000          
 262          NESTS: MISSING PARENTHESIS.                               00196000          
 263          IFS:MISSING SC IN IF STATEMENT.                           00197000          
 264          IFS: MISSING RELATIONAL IN IF STATEMENT.                  00198000          
 265          IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT.          00199000          
 266          IFS: MISSING THEN INIF STATEMENT.                         00200000          
 267          FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000          
                   UNDEFINED.                                           00202000          
 268          EMITC:  A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY     00203000          
                   FORMAL PARAMETERS,LOCALS AND LABELS.                 00204000          
 269          TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE         00205000          
                   OR TOO SMALL.                                        00206000          
 281          DBLSTMT:  MISSING (.                                      00207000          
 282          DBLSTMT:  TOO MANY OPERATORS.                             00208000          
 283          DBLSTMT:  TOO MANY OPERANDS.                              00209000          
 284          DBLSTMT:  MISSING , .                                     00210000          
 285          DBLSTMT:  MISSING ) .                                     00211000          
 300          FILLSTMT:  THE IDENTIFIER FOLLOWING "FILL" IS NOT         00212000          
                         AN ARRAY IDENTIFIER.                           00213000          
 301          FILLSTMT:  MISSING "WITH" IN FILL STATEMENT.              00214000          
 302          FILLSTMT:  IMPROPER FILL ELEMENT.                         00215000          
 303          FILLSTMT:  NON-OCTAL CHARACTER IN OCTAL FILL.             00216000          
 304          FILLSTMT:  IMPROPER ARRAY ROW DESIGNATOR IN FILL.         00217000          
 305          FILLSTMT:  DATA IN FILL EXCEEDS 1023 WORDS.               00218000          
 306          FILLSTMT:  ODD NUMBER OF PARENTHESES IN FILL.             00218110          
 400          MERRIMAC:MISSING FILE ID IN MONITOR DEC.                  00219000          
 401          MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC.         00220000          
 402          MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT.     00221000          
 403          MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN       00222000          
                   MONITOR LIST ELEMENT.                                00223000          
 404          MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST    00224000          
                   ELEMENT.                                             00225000          
 405          MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL.     00226000          
 406          MERRIMAC:IMPROPER MONITOR LIST ELEMENT.                   00227000          
 407          MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00228000          
 408          MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER.          00229000          
 409          DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION.         00230000          
 410          DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION.        00231000          
 411          DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00232000          
                   SUBSCRIPTS.                                          00233000          
 412          DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00234000          
                   SUBSCRIPTS.                                          00235000          
 413          DMUP:IMPROPER ARRAY DUMP LIST ELEMENT.                    00236000          
 414          DMUP:ILLEGAL DUMP LIST ELEMENT.                           00237000          
 415          DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS    00238000          
                   IN ONE DUMP DECLARATION.                             00239000          
 416          DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER.                 00240000          
 417          DMUP:MISSING DUMP LABEL IN DUMP DECLARATION.              00241000          
 418          DMUP:MISSING COLON IN DUMP DECLARATION.                   00242000          
 419          DMUP:IMPROPER DUMP DECLARATION DELIMITER.                 00243000          
 420          READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT.      00244000          
 421          READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE         00245000          
                   STATEMENT.                                           00246000          
 422          READSTMT:MISSING FILE IN READ STATEMENT.                  00247000          
 423          READSTMT:IMPROPER RELEASE INDICATOR.                      00248000          
 424          READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT        00249000          
 425          READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT.     00250000          
 426          READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ  00251000          
                   STATEMENT.                                           00252000          
 427          READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT.       00253000          
 428          READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ        00254000          
                   STATEMENT.                                           00255000          
 429          READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT.        00256000          
 430          READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00257000          
                   STATEMENT.                                           00258000          
 431          HANDLETHETAILENDOFAREADORSPACESTATEMENT:IMPROPER END OF   00259000          
                   FILE LABEL IN READ OR SPACE STATEMENT.               00260000          
 432          HANDLETHETAILENDOFAREADORSPACESTATEMENT:IMPROPER PARITY   00261000          
                   LABEL IN READ OR SPACE STATEMENT.                    00262000          
 433          HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT     00263000          
                   BRACKET IN READ OR SPACE STATEMENT.                  00264000          
 434          SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT.    00265000          
 435          SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT.    00266000          
 436          SPACESTMT:MISSING COMMA IN SPACE STATEMENT.               00267000          
 437          SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT.   00268000          
 438          WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT.  00269000          
 439          WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT.  00270000          
 440          WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A     00271000          
                   WRITE STATEMENT.                                     00272000          
 441          WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART  00273000          
                   OF A WRITE STATEMENT.                                00274000          
 442          WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE   00275000          
                   STATEMENT.                                           00276000          
 443          WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE    00277000          
                   STATEMENT.                                           00278000          
 444          WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT.   00279000          
 445          WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00280000          
                   IN A WRITE STATEMENT.                                00281000          
 446          WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT.    00282000          
 447          WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00283000          
                   STATEMENT.                                           00284000          
 448          WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT.   00285000          
 449          READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT.     00286000          
 450          LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT.    00287000          
 451          LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT.          00288000          
 452          LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT.               00289000          
 453          LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK         00290000          
                   STATEMENT.                                           00291000          
 454          LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT.   00292000          
 455          CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT.  00293000          
 456          CLOSESTMT:IMPROPER FILE PART IN A CLOSE STATEMENT.        00294000          
 457          CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT.             00295000          
 458          CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE       00296000          
                   STATEMENT.                                           00297000          
 459          CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00298000          
 460          RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT.  00299000          
 461          RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT.        00300000          
 462          RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00301000          
 463          BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION  00302000          
                   PART OF A PROCEDURE.                                 00303000          
 464          BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00304000          
                   OF A PROCEDURE.                                      00305000          
 465          INLINE: MISSING PARAMETER IDENTIFIER IN INLINE STREAM     00305001          
                      STATEMENT PARAMETER LIST.                         00305002          
500           .ID:  NEEDS DOUBLE PERIOD FOR PRTE IF PAST 512            00305100          
 520     TABLE: STRING LONGER THAN ONE WORD (48 BITS).                  00305200          
 521     TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER.            00305300          
 600     DOLLARCARD: NUMBER EXPECTED.                                   00400000          
 601     DOLLARCARD: OPTION IDENTIFIER EXPECTED.                        00401000          
 602     DOLLARCARD: TOO MANY USER-DEFINED OPTIONS.                     00403000          
 603     DOLLARCARD: UNRECOGNIZED WORD OR CHARACTER.                    00404000          
 604     DOLLARCARD: MISMATCHED PARENTHESES.                            00405000          
 605     DOLLARCARD:  $ IN CARD COLUMN 1 FOR OMIT CARD                  00406000          
 610     READACARD: SEQUENCE ERROR.                                     00410000          
 611     READACARD: ERROR LIMIT HAS BEEN EXCEEDED.                      00411000          
 ;                                                                      00490000          
BEGIN COMMENT OUTERMOST BLOCK;                                          00500000          
 INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE        00501000          
                   SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000          
 INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP.     00503000          
                   IF COMPILE & GO =0. FOR SYNTAX, =-1. MUST BE AT R+26;00504000          
INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED.                    00504100          
INTEGER CARDCOUNT;   % NUMBER OF CARDS PROCESSED.                       00504150          
 BOOLEAN BUILDLINE;                                                     00504700          
    COMMENT RR1-RR11 ARE USED IN SOME PROCEDURES IN                     00505000          
    PLACE OF LOCALS TO SAVE STACK SPACE;                                00506000          
REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11;                     00507000          
    COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION           00508000          
         TO THE MAIN BLOCK;                                             00509000          
    COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR;       00510000          
REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR;                           00511000          
         BEGIN SI~NCR;DI~LOC EXAMIN;DI~DI+7; DS~CHR END;                00512000          
INTEGER STREAM PROCEDURE GETF(Q);VALUE Q;                               00523000          
    BEGIN SI~LOC GETF; SI~SI-7;DI~LOC Q;DI~DI+5;                        00524000          
         SKIP 3 DB; 9(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB);        00525000          
         DI~LOC Q;SI~Q;DS~WDS;SI~Q;GETF~SI                              00526000          
    END GETF;                                                           00527000          
COMMENT START SETTING UP FILE PARAMETERS;                               00528000          
         IF EXAMIN(RR11~GETF(3)+"Y08") !12 THEN RR1~5 ELSE              00529000          
         BEGIN RR1~2;RR2~150 END;                                       00530000          
         IF EXAMIN(RR11+5) !12 THEN RR3~4 ELSE                          00531000          
         BEGIN RR3~2; RR4~150 END;                                      00532000          
         IF EXAMIN(RR11+10)=12 THEN                                     00533000          
              BEGIN RR5~2;RR6~10;RR7~150 END ELSE                       00534000          
         BEGIN RR5~1;RR6~56;RR7~10 END;                                 00535000          
         IF EXAMIN(RR11+15)=12 THEN                                     00536000          
              BEGIN RR8~10;RR9~150 END ELSE                             00537000          
              BEGIN RR8~56;RR9~10 END;                                  00538000          
BEGIN COMMENT MAIN BLOCK;                                               01000000          
INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY.                  01000800          
BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTION"S SETTING           01000802          
 INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO;                            01000860          
DEFINE OPARSIZE = 200 #;                                                01000902          
ARRAY OPTIONS[0:OPARSIZE];                                              01000904          
BOOLEAN OPTIONWORD;                                                     01000910          
DEFINE   CHECKBIT       =  1#,                                          01000920          
         DEBUGBIT       =  2#,                                          01000930          
         DECKBIT        =  3#,                                          01000940          
         FORMATBIT      =  4#,                                          01000950          
         INTBIT         =  5#,                                          01000960          
         LISTABIT       =  6#,                                          01000970          
         LISTBIT        =  7#,                                          01000980          
         LISTPBIT       =  8#,                                          01000990          
         MCPBIT         =  9#,                                          01001000          
         MERGEBIT       = 10#,                                          01001010          
         NESTBIT        = 11#,                                          01001020          
         NEWBIT         = 12#,                                          01001030          
         NEWINCLBIT     = 13#,                                          01001040          
         OMITBIT        = 14#,                                          01001050          
         PRINTDOLLARBIT = 15#,                                          01001060          
         PRTBIT         = 16#,                                          01001070          
         PUNCHBIT       = 17#,                                          01001080          
         PURGEBIT       = 18#,                                          01001090          
         SEGSBIT        = 19#,                                          01001100          
         SEQBIT         = 20#,                                          01001110          
         SEQERRBIT      = 21#,                                          01001120          
         SINGLBIT       = 22#,                                          01001130          
         STUFFBIT       = 23#,                                          01001140          
         VOIDBIT        = 24#,                                          01001150          
         VOIDTBIT       = 25#,                                          01001160          
         USEROPINX      = 26#;                                          01001170          
COMMENT  IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX    01001180          
         AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN         01001190          
         FILL STATEMENT IN INITIALIZATION OF COMPILER;                  01001200          
DEFINE   CHECKTOG       = OPTIONWORD.[CHECKBIT:1] #,                    01001210          
         DEBUGTOG       = OPTIONWORD.[DEBUGBIT:1] #,                    01001220          
         DECKTOG        = OPTIONWORD.[DECKBIT:1] #,                     01001230          
         FORMATOG       = OPTIONWORD.[FORMATBIT:1] #,                   01001240          
         INTOG          = OPTIONWORD.[INTBIT:1] #,                      01001250          
         LISTATOG       = OPTIONWORD.[LISTABIT:1] #,                    01001260          
         LISTOG         = OPTIONWORD.[LISTBIT:1] #,                     01001270          
         LISTPTOG       = OPTIONWORD.[LISTPBIT:1] #,                    01001280          
         MCPTOG         = OPTIONWORD.[MCPBIT:1] #,                      01001290          
         MERGETOG       = OPTIONWORD.[MERGEBIT:1] #,                    01001300          
       % NESTOG         = OPTIONWORD.[NESTBIT:1] #,     % DUP DECL.     01001310          
         NEWTOG         = OPTIONWORD.[NEWBIT:1] #,                      01001320          
         NEWINCL        = OPTIONWORD.[NEWINCLBIT:1] #,                  01001330          
         OMITTING       = OPTIONWORD.[OMITBIT:1] #,                     01001340          
         PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #,              01001350          
         PRTOG          = OPTIONWORD.[PRTBIT:1] #,                      01001360          
         PUNCHTOG       = OPTIONWORD.[PUNCHBIT:1] #,                    01001370          
         PURGETOG       = OPTIONWORD.[PURGEBIT:1] #,                    01001380          
         SEGSTOG        = OPTIONWORD.[SEGSBIT:1] #,                     01001390          
         SEQTOG         = OPTIONWORD.[SEQBIT:1] #,                      01001400          
COMMENT  SEQTOG INDICATES RESEQUENCING IS TO BE DONE;                   01001410          
         SEQERRTOG      = OPTIONWORD.[SEQERRBIT:1] #,                   01001420          
         SINGLTOG       = OPTIONWORD.[SINGLBIT:1] #,                    01001430          
         STUFFTOG       = OPTIONWORD.[STUFFBIT:1] #,                    01001440          
         VOIDING        = OPTIONWORD.[VOIDBIT:1] #,                     01001450          
         VOIDTAPE       = OPTIONWORD.[VOIDTBIT:1] #,                    01001460          
         DUMMY          = #;                                            01001470          
BOOLEAN NOHEADING;    % TRUE IF DATIME HAS NOT BEEN CALLED.             01001480          
BOOLEAN NEWBASE;      % NEW BASENUM FOUND ON A NEW $-CARD.              01001490          
BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE            01001500          
                      % LAST CARD FROM SYMBOLIC LIBRARY READ            01001510          
                      % IS PATCHED FROM THE CARD READER.                01001520          
INTEGER XMODE;        % TELLS DOLLARCARD HOW TO SET OPTIONS.            01001530          
BOOLEAN DOLLARTOG;    % TRUE IF SCANNING A DOLLAR CARD.                 01001540          
INTEGER ERRMAX;       % COMPILATION STOPS IF EXCEEDED.                  01001550          
BOOLEAN SEQXEQTOG;    % GIVE SEQ. NO. WHEN DS-ING OBJ.                  01001560          
BOOLEAN LISTER;       % LISTOG OR LISTATOG OR DEBUGTOG.                 01001570          
ALPHA MEDIUM;         % INPUT IS: T,C,P,CA,CB,CC.                       01001580          
INTEGER MYCLASS;      % USED IN DOLLARCARD EVALUATION.                  01001590          
REAL BATMAN;          % USED IN DOLLARCARD EVALUATION.                  01001600          
 ARRAY SPECIAL[0:31];                                                   01003000          
    COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL          01004000          
              CHARACTORS: IT IS FILLED DURING INITIALIZATION;           01005000          
                                                                        01006000          
ARRAY INFO [0:127,0:255];                                               01007000          
    COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER  01008000          
              OR RESERVED WORD.  THE FIRST WORD OF A GIVEN ENTRY IS     01009000          
              THE INTERNAL CODE ( OR ELBAT WORD AS IT IS USUALLY        01010000          
              CALLED).  THE SECOND WORD CONTAINS THE FORWARD BIT (IN    01011000          
              [1:1]) FOR PROCEDURES, THE LINK TO PREVIOUS ENTRY (IN     01012000          
              [4:8]), THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000          
              TION (IN [12:6]), AND THE FIRST 5 CHARACTORS OF ALPHA.    01014000          
              SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000          
              FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD    01016000          
              AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLIT ACROSS A ROW 01017000          
              OF INFO.  FOR PURPOSES OF FINDING AN IDENTIFIER OR        01018000          
              RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125       01019000          
              DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000          
              IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER   01021000          
              OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF      01022000          
              ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED.     01023000          
              THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX.       01024000          
              THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES.  THE    01025000          
              RESERVED WORDS OCCUPY THE SECOND ROW. IT IS FILLED DURING 01026000          
              INITIALIZATION;                                           01027000          
COMMENT              INFO FORMAT                                        01028000          
  FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES      01029000          
  ENTERED IN INFO:                                                      01030000          
     THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD.                   01031000          
     THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN           01032000          
     ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY          01033000          
     ADDITIONAL INFO (IF ANY) FOR THIS ENTRY.                           01034000          
      E.G. IF THE INDEX IS  IX  THEN  INFO[(IX+INCR).LINKR,(IX+INCR).   01035000          
          LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO.        01036000          
     THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM         01037000          
     THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT      01038000          
     POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO.                     01039000          
     THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.,THE             01040000          
     LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED.              01041000          
     FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL        01042000          
     ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN     01043000          
     WILL NOT DETRACT FROM THE DISCUSSION.                              01044000          
        ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO         01045000          
     THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE.            01046000          
       FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO           01047000          
     THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE               01048000          
                         S[L]                                           01049000          
     NOW THE DECLARATION                                                01050000          
          BEGIN REAL A,B,C  IS ENCOUNTERED                              01051000          
         IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO            01052000          
      THEN  A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN    01053000          
                                     CONSTRUCTED FOR A)                 01054000          
                         T.LINK~ S[L]. (WHICH IS ZERO AT FIRST).        01055000          
    INFO[NEXTINFO]~T.    S[L]~NEXTINFO.                                 01056000          
                         NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS      01057000          
                                  ENTRY.                                01058000          
       NOW  S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY        01059000          
                 ITSELF CONTAINS THE STOP FLAG ZERO.                    01060000          
      B IS ENTERED SIMILARLY TO A.                                      01061000          
       NOW  S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE         01062000          
                               ENTRY FOR A.                             01063000          
      SIMILARLY,AFTER C IS ENTERED                                      01064000          
                S[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY    01065000          
                     POINTS TO A.                                       01066000          
   THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS:         01067000          
      FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED          01068000          
                   FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL        01069000          
                   FULL DECLARATION.                                    01070000          
      PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE      01071000          
                   INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBTRACTED     01072000          
                   FROM THE CURRENT ENTRY INDEX.                        01073000          
     [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY.(<64)           01074000          
     [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY      01075000          
             AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED.       01076000          
             THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED.      01077000          
            THUS,AN ENTRY FOR  SYMBOL FOLLOWED BY AN ENTRY              01078000          
                          FOR  X      WOULD APPEAR AS FOLLOWS:          01079000          
     INFO[I] =     ELBATWRD      (MADE FOR SYMBOL)                      01080000          
         I+1 =     OP6SYMBO     (P DEPENDS ON PREVIOUS ENTRY)           01081000          
         I+2 =     L                                                    01082000          
         I+3 =     ELBATWRD      (MADE FOR X)                           01083000          
         I+4 =     031X                                                 01084000          
       THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF        01085000          
       THE ENTRY BEFORE SYMBOL, AND                                     01086000          
       INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL.                      01087000          
  ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE       01088000          
  THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST        01089000          
  FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF         01090000          
   NECESSARY.                                                           01091000          
  THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES,                01092000          
        REAL                                                            01093000          
        BOOLEAN                                                         01094000          
        INTEGER                                                         01095000          
        ALPHA                                                           01096000          
        FILE                                                            01097000          
        FORMAT                                                          01098000          
        LIST                                                            01099000          
    OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION.                       01100000          
 ARRAYS:                                                                01101000          
     THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF           01102000          
     DIMENSIONS(IN THE LOW ORDER PART).[40:8]                           01103000          
    EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER          01104000          
    BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND.         01105000          
    THESE WORDS ARE MADE UP AS FOLLOWS:                                 01106000          
          [23:12] =ADD OPERATOR SYLLABLE (0101) OR                      01107000          
                   SUB OPERATOR SYLLABLE (0301) CORRESPONDING           01108000          
                   RESPECTIVELY TO WHETHER THE LOWER BOUND IS           01109000          
                   TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR          01110000          
                   SUBTRACTED.                                          01111000          
         [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND      01112000          
                   REQUIRES A PRT OR STACK CELL,OTHERWISE THE BIT       01113000          
                   35 IS IGNORED AND THE NEXT TEN BITS([36:10])         01114000          
                   REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND        01115000          
          [46:2] =00 OR 10  DEPENDING ON WHETHER THE [35:11] VALUE      01116000          
                   IS A LITERAL OR OPERAND,RESPECTIVELY.                01117000          
 PROCEDURES:                                                            01118000          
      THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF          01119000          
      PARAMETERS [40:8]                                                 01120000          
      IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN             01121000          
      [13:11] ENDING  PRT ADDRESS FOR LABELS,                           01122000          
      [ 7:6]  NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER    01123000          
      OF LOCALS.                                                        01124000          
      SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER          01125000          
                         OF APPEARANCE IN FORMAL PARAPART) ARE          01126000          
      ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER         01127000          
      VALUE OR NOT([10:1]).                                             01128000          
      THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH.                  01129000          
      IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8])          01130000          
      CONTAINS THE NUMBER OF DIMENSIONS.OTHERWISE INCR IS MEANINGLESS.  01131000          
      LINK([35:13]) IS MEANINGLESS.                                     01132000          
      IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMATER IS         01133000          
      THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000          
      IS DONE IN THE STREAM PROCEDURE.                                  01135000          
 LABELS:                                                                01136000          
      AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0.  THE SIGN     01137000          
      BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED.   01138000          
      IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A   01139000          
      LIST OF FORWARD REFERENCES TO THIS LABEL.  THE END OF LIST FLAG IS01140000          
      0.  IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL.           01141000          
 SWITCHES:                                                              01142000          
      THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR-  01143000          
      ATION.  [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH.  01144000          
      IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL.  HERE SIMPLE MEANS  01145000          
      NO POSSIBILITY OF JUMPING OUT OF A BLOCK.                        ;01146000          
              DEFINE MON   =[ 1: 1]#,                                   01147000          
                     CLASS =[ 2: 7]#,                                   01148000          
                     FORMAL=[ 9: 1]#,                                   01149000          
                     VO    =[10: 1]#,                                   01150000          
                     LVL   =[11: 5]#,                                   01151000          
                    ADDRESS=[16:11]#,                                   01152000          
                     INCR  =[27: 8]#,                                   01153000          
                     LINK  =[35:13]#,                                   01154000          
                     LINKR =[35: 5]#,                                   01155000          
                     LINKC =[40: 8]#;                                   01156000          
 COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD.           01157000          
              MON IS THE BIT WHICH IS ON IF THE QUANTITY IS MONITORED.  01158000          
              CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN          01159000          
                  QUANTITY.                                             01160000          
              FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000          
                  PARAMETER.                                            01162000          
              VO IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT       01163000          
                  DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF        01164000          
                  FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES   01165000          
                  FROM OTHERS.                                          01166000          
              LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED.     01167000          
              ADDRESS GIVES THE STACK OR PRT ADDRESS.                   01168000          
              INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION  01169000          
                  NEEDED, RELATIVE TO THE LOCATION IN INFO.             01170000          
              LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE       01171000          
                  QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE     01172000          
                  NEXT ITEM IN THE STACK. ZERO IS AN END FLAG.          01173000          
              LINKR AND LINKC ARE SUBDIVISIONS OF LINK.;                01174000          
 COMMENT  CLASSES FOR ALL QUANTITIES  -  OCTAL CLASS IS IN COMMENT;     01175000          
    COMMENT   CLASSES FOR IDENTIFIERS;                                  01176000          
 DEFINE  UNKNOWNID      =00#,    COMMENT 000;                           01177000          
         STLABID        =01#,    COMMENT 001;                           01178000          
         LOCLID         =02#,    COMMENT 002;                           01179000          
         DEFINEDID      =03#,    COMMENT 003;                           01180000          
         LISTID         =04#,    COMMENT 004;                           01181000          
         FRMTID         =05#,    COMMENT 005;                           01182000          
         SUPERFRMTID    =06#,    COMMENT 006;                           01183000          
         REALSUBID      =07#,    COMMENT 007;                           01184000          
         SUBID          =08#,    COMMENT 010;                           01185000          
         SWITCHID       =09#,    COMMENT 011;                           01186000          
         PROCID         =10#,    COMMENT 012;                           01187000          
         INTRNSICPROCID =11#,    COMMENT 013;                           01188000          
         STRPROCID      =12#,    COMMENT 014;                           01189000          
         BOOSTRPROCID   =13#,    COMMENT 015;                           01190000          
         REALSTRPROCID  =14#,    COMMENT 016;                           01191000          
         ALFASTRPROCID  =15#,    COMMENT 017;                           01192000          
         INTSTRPROCID   =15#,    COMMENT 017;                           01193000          
         BOOPROCID      =17#,    COMMENT 021;                           01194000          
         REALPROCID     =18#,    COMMENT 022;                           01195000          
         ALFAPROCID     =19#,    COMMENT 023;                           01196000          
         INTPROCID      =19#,    COMMENT 023;                           01197000          
         BOOID          =21#,    COMMENT 025;                           01198000          
         REALID         =22#,    COMMENT 026;                           01199000          
         ALFAID         =23#,    COMMENT 027;                           01200000          
         INTID          =23#,    COMMENT 027;                           01201000          
         BOOARRAYID     =25#,    COMMENT 031;                           01202000          
         REALARRAYID    =26#,    COMMENT 032;                           01203000          
         ALFAARRAYID    =27#,    COMMENT 033;                           01204000          
         INTARRAYID     =27#,    COMMENT 033;                           01205000          
         NAMEID         =30#,    COMMENT 036;                           01205200          
         INTNAMEID      =31#,    COMMENT 037;                           01205400          
         LABELID        =32#,    COMMENT 040;                           01206000          
    COMMENT   CLASSES FOR PRIMARY BEGINNERS;                            01207000          
         TRUTHV         =33#,    COMMENT 041;                           01208000          
         NONLITNO       =34#,    COMMENT 042;                           01209000          
         LITNO          =35#,    COMMENT 043;                           01210000          
         STRNGCON       =36#,    COMMENT 044;                           01211000          
         LEFTPAREN      =37#,    COMMENT 045;                           01212000          
         POLISHV        =38#,    COMMENT 046;                           01212100          
         ASTRISK        =39#,    COMMENT 047;                           01212200          
    COMMENT   CLASS FOR ALL DECLARATORS;                                01213000          
         DECLARATORS    =40#,    COMMENT 050;                           01214000          
    COMMENT   CLASSES FOR STATEMENT BEGINNERS                           01215000          
         DOUBLEV        =42#,    COMMENT 052;                           01222000          
         FORV           =43#,    COMMENT 053;                           01223000          
         WHILEV         =44#,    COMMENT 054;                           01224000          
         DOV            =45#,    COMMENT 055;                           01225000          
         UNTILV         =46#,    COMMENT 056;                           01226000          
         ELSEV          =47#,    COMMENT 057;                           01227000          
         ENDV           =48#,    COMMENT 060;                           01228000          
         SEMICOLON      =50#,    COMMENT 062;                           01230000          
         IFV            =51#,    COMMENT 063;                           01231000          
         GOV            =52#,    COMMENT 064;                           01232000          
         IOCLASS        =53#,    COMMENT 065;                           01233000          
         BEGINV         =54#,    COMMENT 066;                           01234000          
    COMMENT   CLASSES FOR STREAM RESERVED WORDS;                        01235000          
         SIV            =55#,    COMMENT 067;                           01236000          
         DIQ            =56#,    COMMENT 070;                           01237000          
         CIV            =57#,    COMMENT 071;                           01238000          
         TALLYV         =58#,    COMMENT 072;                           01239000          
         DSV            =59#,    COMMENT 073;                           01240000          
         SKIPV          =60#,    COMMENT 074;                           01241000          
         JUMPV          =61#,    COMMENT 075;                           01242000          
         DBV            =62#,    COMMENT 076;                           01243000          
         SBV            =63#,    COMMENT 077;                           01244000          
         TOGGLEV        =64#,    COMMENT 100;                           01245000          
         SCV            =65#,    COMMENT 101;                           01246000          
         LOCV           =66#,    COMMENT 102;                           01247000          
         DCV            =67#,    COMMENT 103;                           01248000          
         LOCALV         =68#,    COMMENT 104;                           01249000          
         LITV           =69#,    COMMENT 105;                           01250000          
         TRNSFER        =70#,    COMMENT 106;                           01251000          
    COMMENT   CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES;             01252000          
         COMMENTV       =71#,    COMMENT 107;                           01253000          
         FORWARDV       =72#,    COMMENT 110;                           01254000          
         STEPV          =73#,    COMMENT 111;                           01255000          
         THENV          =74#,    COMMENT 112;                           01256000          
         TOV            =75#,    COMMENT 113;                           01257000          
         VALUEV         =76#,    COMMENT 114;                           01258000          
         WITHV          =77#,    COMMENT 115;                           01259000          
         COLON          =78#,    COMMENT 116;                           01260000          
         COMMA          =79#,    COMMENT 117;                           01261000          
         CROSSHATCH     =80#,    COMMENT 120;                           01262000          
         LFTBRKET       =81#,    COMMENT 121;                           01263000          
         PERIOD         =82#,    COMMENT 122;                           01264000          
         RTBRKET        =83#,    COMMENT 123;                           01265000          
         RTPAREN        =84#,    COMMENT 124;                           01266000          
         AMPERSAND      =85#,    COMMENT 125;                           01266500          
    COMMENT   CLASSES FOR OPERATORS;                                    01267000          
         HEXOP          =86#,    COMMENT 126;                           01268000          
         BITOP          =87#,    COMMENT 127;                           01269000          
         ISOLATE        =88#,    COMMENT 130;                           01270000          
         OPERATOR       =89#,    COMMENT 131;                           01271000          
         NOTOP          =90#,    COMMENT 132;                           01272000          
         ASSIGNOP       =91#,    COMMENT 133;                           01273000          
         EQVOP          =92#,    COMMENT 134;                           01274000          
         OROP           =93#,    COMMENT 135;                           01275000          
         ANDOP          =94#,    COMMENT 136;                           01276000          
         RELOP          =95#,    COMMENT 137;                           01277000          
         ADOP           =96#,    COMMENT 140;                           01278000          
         MULOP          =97#,    COMMENT 141;                           01278500          
%        STRING         =99#,    COMMENT 143;                           01278600          
    COMMENT   SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS);             01279000          
         OWNV           =01#,    COMMENT  01;                           01280000          
         SAVEV          =02#,    COMMENT  02;                           01281000          
         BOOV           =03#,    COMMENT  03;                           01282000          
         REALV          =04#,    COMMENT  04;                           01283000          
         ALFAV          =05#,    COMMENT  05;                           01284000          
         INTV           =05#,    COMMENT  05;                           01285000          
         LABELV         =07#,    COMMENT  07;                           01286000          
         DUMPV          =08#,    COMMENT  10;                           01287000          
         SUBV           =09#,    COMMENT  11;                           01288000          
         OUTV           =10#,    COMMENT  12;                           01289000          
         INV            =11#,    COMMENT  13;                           01290000          
         MONITORV       =12#,    COMMENT  14;                           01291000          
         SWITCHV        =13#,    COMMENT  15;                           01292000          
         PROCV          =14#,    COMMENT  16;                           01293000          
         ARRAYV         =15#,    COMMENT  17;                           01294000          
         NAMEV          =16#,    COMMENT  20;                           01295000          
         FILEV          =17#,    COMMENT  21;                           01296000          
         STREAMV        =18#,    COMMENT  22;                           01297000          
         DEFINEV        =19#;    COMMENT  23;                           01298000          
DEFINE DDES         =  8#,                                              01299000          
       ADES         = 28#,                                              01299010          
       PDES         = 29#,                                              01299020          
       LDES         = 30#,                                              01299030          
       CHAR         = 31#,                                              01299040          
       FACTOP       = ASTRISK#,                                         01299100          
       OPERATORS    = HEXOP#,                                           01299200          
       FILEID       = 0#,                                               01299300          
       MAXINTRINSIC = 150#, % USED IN BUILDING INTABLE @ 09414120       01299400          
       INTRINSICADR = (MAXINTRINSIC DIV 30)#; % RESERVES SEG FOR INTABLE01299500          
 REAL TIME1;                                                            01300000          
 BOOLEAN ASTOG;                                                         01300100          
 BOOLEAN SAF;                                                           01300200          
 INTEGER SCRAM;                                                         01301000          
    COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER   01302000          
              OR RESERVED WORD SCANNED;                                 01303000          
 ALPHA ARRAY ACCUM[0:10];                                               01304000          
    COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST       01305000          
              SCANNED ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE     01306000          
              IN INFO, THAT IS ACCUM[1] = 00NAAAAA. ACCUM[I] , I> 1,    01307000          
              HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR       01308000          
              THE ELBAT WORD BY THE ENTER ROUTINES;                     01309000          
ARRAY STACKHEAD[0:125];                                                 01310000          
    COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO GIVING THE TOP     01311000          
              ITEM IN THE N-TH STACK;                                   01312000          
 INTEGER COUNT;                                                         01313000          
    COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM    01314000          
              SCANNED;                                                  01315000          
 ALPHA Q;                                                               01316000          
    COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED     01317000          
              WORD SCANNED;                                             01318000          
 ARRAY ELBAT[0:75]; INTEGER I, NXTELBT;                                 01319000          
    COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED  01320000          
              QUANTITIES.  THE TABLE ROUTINE MAINTAINS THIS ARRAY.      01321000          
              (ELBAT IS TABLE SPELLED BACKWARDS.)  THE TABLE ROUTINE    01322000          
              GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS     01323000          
              FOR THE LAST 10 QUANTITIES SCANNED.  NXTELBT IS AN INDEX  01324000          
              POINTING TO THE NEXT AVAILABLE WORD IN ELBAT.  I IS AN    01325000          
              INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS    01326000          
              FROM ELBAT.  I IS ALSO MAINTAINED BY THE TABLE ROUTINE;   01327000          
 INTEGER ELCLASS;                                                       01328000          
    COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS;                    01329000          
 INTEGER FCR, NCR, LCR,TLCR,CLCR;                                       01330000          
 INTEGER MAXTLCR;                                                       01331000          
    COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF     01332000          
              THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS   01333000          
              OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST     01334000          
              CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF   01335000          
              THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS.  MAXTLCR 01336000          
              IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED;         01337000          
 ARRAY TEN[-46:69];                                                     01340000          
                                                                        01341000          
 DEFINE PRTBASE=129#,PRTOP=896#;  COMMENT PASE AND TOP OF PRT;          01342000          
ARRAY PRT[PRTBASE:PRTOP];                                               01343000          
INTEGER DISKADR,CORADR; COMMENT GLOBALS FOR PROGDESCBLDR;               01344000          
INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER;                    01369000          
INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER;                01370000          
         ARRAY  COP,WOP[0:127];                                         01371000          
    COMMENT  THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY  01372000          
              AS SPECIFIED BY "L".                                      01373000          
              IF THE DEBUGTOG IS TRUE COP AND WOP ARE FILLED WITH       01374000          
              THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED;    01375000          
 REAL  LASTENTRY ;                                                      01376000          
    COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS   01377000          
              INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS;  01378000          
 BOOLEAN MRCLEAN ;                                                      01379000          
    COMMENT  NO  CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS      01380000          
              FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE       01381000          
              POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO]    01382000          
              DURING AN ARRAY DECLARATION ;                             01383000          
 REAL GT1,GT2,GT3,GT4,GT5;                                              01384000          
 INTEGER GTI1;                                                          01384500          
    COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE;             01385000          
 INTEGER RESULT;                                                        01386000          
    COMMENT THIS VARIABLE IS USED FOR A DUAL PURPOSE BY THE TABLE       01387000          
              ROUTINE AND THE SCANNER.  THE TABLE ROUTINE USES THIS     01388000          
              VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER    01389000          
              USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN;  01390000          
 INTEGER LASTUSED;                                                      01391000          
    COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF          01392000          
              READACARD, THE ROUTINE WHICH READS CARDS AND INITIALIZES  01393000          
              OR PREPARES THE CARD FOR THE SCANNER.                     01394000          
          LASTUSED  LAST CARD READ FROM                                 01394500          
          --------  -------------------                                 01394600          
              1     CARD READER ONLY, NO TAPE.                          01395000          
              2     CARD READER, TAPE AND CARD MERGE.                   01396000          
              3     TAPE, TAPE AND CARD MERGE.                          01397000          
              4     INITIALIZATION ONLY, CARD ONLY.                     01398000          
 ;                                                                      01398300          
 BOOLEAN LINKTOG;                                                       01399000          
    COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK,       01400000          
              OTHERWISE IT IS TRUE;                                     01401000          
 INTEGER LEVEL,FRSTLEVEL,SUBLEVEL,MODE;                                 01402000          
    COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 01403000          
              TRACK OF LEVELS OF DEFINITION.  LEVEL GIVES THE DEPTH OF  01404000          
              NESTING IN DEFINITION, WHERE EACH BLOCK AND EACH PROCEDURE01405000          
              GIVES RISE TO A NEW LEVEL.  SUBLEVEL GIVES THE LEVEL OF   01406000          
              THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 01407000          
              FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST      01408000          
              GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED.  MODE  01409000          
              IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE     01410000          
              NESTED (AT COMPILE TIME);                                 01411000          
BOOLEAN ERRORTOG;                                                       01412000          
    COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000          
              ERROR ROUTINES.  ERRORCOUNT IS THE COUNT OF ERROR MSSGS;  01414000          
BOOLEAN ENDTOG;    COMMENT ENDTOG TELLS THE TABLE TO ALLOW              01415000          
                   COMMENT TO BE PASSED BACK TO COMPOUNDTAIL;           01416000          
 BOOLEAN STREAMTOG;                                                     01417000          
    COMMENT STREAMTOG IS TRUE IF WE ARE COMPILING STREAM STATEMENT.  IT 01418000          
              IS USED TO CONTROL COUMPOUNDTAIL;                         01419000          
 DEFINE FS = 1#, FP = 2#, FL = 3#, FR =4#;                              01420000          
    COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE.   01421000          
              THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING.        01422000          
              THEIR MEANING IS:                                         01423000          
              FS MEANS FROM STATEMENT,                                  01424000          
              FP MEANS FROM PRIMARY,                                    01425000          
              FL MEANS FROM LIST,                                       01426000          
              FR MEANS FROM FOR;                                        01427000          
 INTEGER L;                                                             01428000          
    COMMENT   L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED;     01429000          
 DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#;         01430000          
 DEFINE ATYPE =3#, BTYPE=ATYPE#,DTYPE=ATYPE#;                           01452000          
 BOOLEAN TB1;                                                           01457000          
    COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE;                        01458000          
 INTEGER JUMPCTR;                                                       01459000          
    COMMENT   JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK01460000          
              AND GENGO.  IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS    01461000          
              BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED      01462000          
              SEGMENT.  THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000          
              MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION   01464000          
              OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED01465000          
              IF LEVEL = JUMPCTR;                                       01466000          
                                                                        01467000          
                                                                        01468000          
                                                                        01469000          
                                                                        01470000          
 REAL STLB;                                                             01471000          
    COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE  01472000          
              THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000          
              ARRAY INVOLVED IN A ROW DESIGNATOR.  THE FORMAT OF THE    01474000          
              INFORMATION IS THAT OF INFO.  STLB IS ALSO SOMETIMES USED 01475000          
              FOR TEMPORARY STORAGE;                                    01476000          
 DEFINE BUMPL = L~L+2#;                                                 01477000          
    COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP;             01478000          
 DEFINE IDMAX =   LABELID#;                                             01479000          
    COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS;          01480000          
 INTEGER DEFINECTR,DEFINEINDEX;                                         01481000          
    REAL  JOINFO,       COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS;   01482000          
         LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ;    01483000          
      NESTLEVEL,        COMMENT  COUNTS NESTING FOR GO TO AND JUMP OUTS;01484000          
          JUMPLEVEL;    COMMENT NUMBER OF LEVELS TO BE JUMPED OUT;      01485000          
    COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT;                   01486000          
    ARRAY  MACRO[0:35];                                                 01487000          
    COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT;        01488000          
REAL  P,     COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS;       01489000          
        Z;     COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS;  01490000          
      ARRAY NEWTAPBUF[0:9];                                             01490510          
 SAVE ARRAY DEFINEARRAY[0:23];                                          01491000          
    COMMENT   THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000          
              DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS.      01493000          
              THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR   01494000          
              TO DETERMINE THE MEANING OF A CROSSHATCH.  DEFINEINDEX IS 01495000          
              THE NEXT AVAILABLE CELL IN THE DEFINEARRAY.  THE DEFINE-  01496000          
              ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND   01497000          
              THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR;            01498000          
 INTEGER BEGINCTR;                                                      01499000          
    COMMENT   BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS.  IT IS USED01500000          
              FOR ERROR CONTROL ONLY;                                   01501000          
 INTEGER DIALA,DIALB;                                                   01502000          
    COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE   01503000          
              DIALED.  THIS GIVES SOME LOCAL OPTIMIZATION.  EMITD       01504000          
              WORRIES ABOUT THIS.  OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000          
              BY SETTING DIALA AND DIALB TO ZERO;                       01506000          
BOOLEAN RRB1;  COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000          
              SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES.  SEE       01523000          
              COMMENT AT RR1;                                           01524000          
         BOOLEAN RRB2;  COMMENT SEE COMMENT AT RRB1 DECLARATION;        01525000          
DEFINE ARRAYMONFILE = [27:11]#;  COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000          
                                THE ADDRESS OF THE FILE DESCRIPTOR IN   01527000          
                                THE FIRST WORD OF ADDITIONAL INFO;      01528000          
DEFINE SVARMONFILE = [37:11]#;  COMMENT MONITORFILE IS THE DEFINE FOR   01529000          
                               THE ADDRESS OF THE FILE DESCRIPTOR IN    01530000          
                               INFO FOR MONITORED SIMPLE VARIABLES;     01531000          
DEFINE NODIMPART = [40:8]#;  COMMENT THE FIRST ADDITIONAL WORD OF INFO  01532000          
                            FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000          
                            IN NODIMPART;                               01534000          
DEFINE LABLMONFILE = [13:11]#;  COMMENT LABLMONFILE DESIGNATES THE BIT  01535000          
                               POSITION IN THE FIRST WORD OF ADDITIONAL 01536000          
                               INFO THAT CONTAINS THE MONITOR FILE      01537000          
                               ADDRESS FOR LABELS;                      01538000          
DEFINE SWITMONFILE = [13:11]#;  COMMENT SWITMONFILE DESIGNATES THE BIT  01539000          
                               POSITION IN THE FIRST WORD OF ADDITIONAL 01540000          
                               INFO THAT CONTAINS THE MONITOR FILE      01541000          
                               ADDRESS FOR LABELS;                      01542000          
DEFINE FUNCMONFILE = [27:11]#;  COMMENT FUNCMONFILE DESIGNATES THE BIT  01543000          
                               POSITION IN THE FIRST WORD OF ADDITIONAL 01544000          
                               INFO THAT CONTAINS THE MONITOR FILE      01545000          
                               ADDRESS FOR LABELS;                      01546000          
DEFINE DUMPEE = [2:11]#;  COMMENT THE DUMPEE FIELD IN THE FIRST         01547000          
                         ADDITIONAL WORD OF INFO FOR LABELS CONTAINS    01548000          
                         THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000          
                         EACH TIME THE LABEL IS PASSED IF THAT LABEL    01550000          
                         APPEARS IN A DUMP DECLARATION;                 01551000          
DEFINE DUMPOR = [24:11]#;  COMMENT THE DUMPOR FIELD IN THE FIRST        01552000          
                         ADDITIONAL WORD OF INFO FOR LABELS CONTAINS    01553000          
                         THE ADDRESS OF THE ROUTINE THAT IS GENERATED   01554000          
                         FROM THE DUMP DECLARATION THAT IN TURN CALLS   01555000          
                         THE PRINTI ROUTINE;                            01556000          
DEFINE SUBOP=48#;                                                       01556500          
 FILE OUT CODE DISK SERIAL[1:1](1,1023);                                01556900          
FILE IN CARD(RR1,10,RR2);                                               01557000          
FILE OUT LINE DISK SERIAL[20:2400](RR3,15,RR4,SAVE 10);                 01558000          
 ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN;                    01559010          
INTEGER DA;                                                             01559020          
SAVE FILE OUT NEWTAPE DISK SERIAL[20:2400](RR5,RR6,RR7,SAVE 1);         01560000          
FILE IN TAPE "0CRDIMG"(2,RR8,RR9);                                      01561000          
SAVE ARRAY CBUFF,TBUFF[0:9]; % INPUT BUFFERS.                           01561056          
FILE OUT CODISK DISK SERIAL [20:600] (2,30,300);                        01561300          
FILE OUT DISK DISK [1:2100] "MCP""DISK"(3,30,300,SAVE 99);              01561400          
DEFINE    MCPTYPE              = 63#,                                   01561410          
          DCINTYPE             = 62#,                                   01561420          
          TSSINTYPE            = 61#;                                   01561430          
COMMENT  ESPOL CODE FILES ARE UNIQUELY TYPED IN THEIR FILE              01561440          
         HEADERS.   HEADER[4].[36:6] IS THE FIELD USED TO CONTAIN       01561450          
         THE TYPE;                                                      01561460          
FILE OUT DECK 0 (2,10);                                                 01561500          
FILE STUFF DISK SERIAL[20:150](2,10,30,SAVE 15);                        01561600          
ARRAY TWXA[0:16];                                                       01561700          
 REAL C;                                                                01562000          
    COMMENT  C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED;          01563000          
 REAL T;                                                                01564000          
    COMMENT  T IS A TEMPORARY CELL;                                     01565000          
 INTEGER TCOUNT;                                                        01566000          
    REAL STACKCT;                                                       01566010          
    COMMENT  TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000          
              FOR THE USE OF CONVERT;                                   01568000          
 DEFINE LASTSEQUENCE = 145#,                                            01569000          
        LASTSEQROW = 2#;                                                01570000          
                                                                        01571000          
                                                                        01572000          
                                                                        01573000          
                                                                        01574000          
                                                                        01575000          
                                                                        01576000          
                                                                        01577000          
                                                                        01578000          
                                                                        01579000          
                                                                        01580000          
                                                                        01581000          
                                                                        01582000          
                                                                        01583000          
 REAL FOULED;                                                           01583100          
                                                                        01584000          
 BOOLEAN                                                                01585000          
       FUNCTOG,    COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A  01586000          
                           FUNCTION;                                    01587000          
       P2,         COMMENT GENERALY TELLS WHETHER OWN WAS SEEN;         01588000          
       P3,         COMMENT TELLS WHETHER SAVE WAS SEEN;                 01589000          
       VONF,       COMMENT VALUE OR OWN FIELD OF ELBAT WORD;            01590000          
       FORMALF,    COMMENT FORMAL FIELD OF ELBAT WORD;                  01591000          
       PTOG,       COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000          
SPECTOG,                                                                01593000          
       STOPENTRY,  COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY    01594000          
                           ONE ID AND THEN EIXT;                        01595000          
       AJUMP;      COMMENT TELLS WHETHER A JUMP IS HANGING;             01596000          
BOOLEAN STOPDEFINE;                                                     01597000          
INTEGER MAXSAVE;                                                        01598000          
           COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY     01599000          
           DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS  01600000          
           FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM;      01601000          
 REAL                                                                   01602000          
      KLASSF,      COMMENT CLASS IN LOW ORDER 7 BITS;                   01603000          
      ADDRSF,      COMMENT ADDRESS IN LOW ORDER 11 BITS;                01604000          
      LEVELF,      COMMENT LVL IN LOW ORDER 5 BITS;                     01605000          
      LINKF,       COMMENT LINK IN LOW ORDER 13 BITS;                   01606000          
      INCRF,       COMMENT INCR CN LOW ORDER 8 BITS;                    01607000          
      PROINFO,     COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING      01608000          
                           DECLARED;                                    01609000          
      G,           COMMENT GLOBAL TEMPORARY FOR BLOCK;                  01610000          
      TYPEV,       COMMENT USED TO CARRY CLASS OF IDENTIFIER            01611000          
                           BEING DECLARED;                              01612000          
    PROADO,          COMMENT CONTAINS ADDRESS OF PROCEDURE BEING        01613000          
                           DECLARED;                                    01614000          
      MARK ,       COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD    01615000          
                           OF ADDITIONAL INFO FOR A PROCEDURE ENTRY;    01616000          
      PJ,          COMMENT FORMAL PARAMETER COUNTER;                    01617000          
       J,          COMMENT ARRAY COUNTER;                               01618000          
      LASTINFO,    COMMENT INDEX TO LAST ENTRY IN INFO;                 01619000          
      NEXTINFO,    COMMENT INDEX FOR NEXT ENTRYIN INFO;                 01620000          
      FIRSTX,      COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE        01621000          
                           IN BLOCK,INITIALIZED TO 4095 EACH TIME;      01622000          
      SAVEL;       COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK;           01623000          
INTEGER NCII;      COMMENT THIS CONTAINS THE COUNT OF CONSTANTS         01624000          
                           ENTERED IN INFO AT ANY GIVEN TIME;           01625000          
PROCEDURE UNHOOK;FORWARD;                                               01626000          
PROCEDURE MAKEUPACCUM;FORWARD;                                          01627000          
DEFINE PURPT=[4:8]#,SECRET=2#;                                          01628000          
 COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS.  THE  01629000          
    NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS.  THE 01630000          
    FULL NAME IS ALSO GIVEN;                                            01631000          
 DEFINE                                                                 01632000          
   ADD =  16#,    COMMENT (0101) 7.4.2.1    ADD;                        01633000          
   BBC =  22#,    COMMENT (0131) 7.4.5.4    BRANCH BACKWARD CONDITIONAL;01634000          
   BBW = 534#,    COMMENT (4131) 7.4.5.2    BRANCH BACKWARD;            01635000          
   BFC =  38#,    COMMENT (0231) 7.4.5.3    BRANCH FORWARD CONDITIONAL; 01636000          
   BFW = 550#,    COMMENT (4231) 7.4.5.1    BRANCH FORWARD;             01637000          
   CDC = 168#,    COMMENT (1241) 7.4.10.4   CONSTRUCT DESCRIPTOR CALL;  01638000          
   CHS = 134#,    COMMENT (1031) 7.4.7.11   CHANGE SIGN;                01639000          
   COC =  40#,    COMMENT (0241) 7.4.10.3   CONSTRUCT OPERAND CALL;     01640000          
   COM = 130#,    COMMENT (1011) 7.4.10.5   COMMUNICATION OPERATOR;     01641000          
   DEL =  10#,    COMMENT (0045) 7.4.9.3    DELETE;                     01642000          
   DUP = 261#,    COMMENT (2025) 7.4.9.2    DUPLICATE;                  01643000          
   EQL = 581#,    COMMENT (4425) 7.4.4.3    EQUAL;                      01644000          
   LBC = 278#,    COMMENT(2131) 7.4.5.9     GO BACKWARD CONDITIONAL;    01645000          
   LBU = 790#,    COMMENT(6131) 7.4.5.7     GO BACKWARD (WORD);         01646000          
   GEQ =  21#,    COMMENT (0125) 7.4.4.2    GREATER THAN OR EQUAL TO;   01647000          
   LFC = 294#,    COMMENT(2231) 7.4.5.8     GO FORWARD CONDITIONAL;     01648000          
    LFU = 806#,   COMMENT(6231) 7.4.5.6     GO FORWARD (WORD);          01649000          
   GTR =  37#,    COMMENT (0225) 7.4.4.1    GREATER THAN;               01650000          
   IDV = 384#,    COMMENT (3001) 7.4.2.5    INTEGER DIVIDE;             01651000          
   INX =  24#,    COMMENT (0141) 7.4.10.2   INDEX;                      01652000          
   ISD = 532#,    COMMENT (4121) 7.4.6.3    INTEGER STORE DESTRUCTIVE;  01653000          
   ISN = 548#,    COMMENT (4221) 7.4.6.4    INTEGER STORE NON-DESTRUCT; 01654000          
   LEQ = 533#,    COMMENT (4125) 7.4.4.4    LESS THAN OR EQUAL TO;      01655000          
   LND =  67#,    COMMENT (0415) 7.4.3.1    LOGICAL AND;                01656000          
   LNG =  19#,    COMMENT (0115) 7.4.3.4    LOGICAL NEGATE;             01657000          
   LOD = 260#,    COMMENT (2021) 7.4.10.1   LOAD OPERATOR;              01658000          
   LOR =  35#,    COMMENT (0215) 7.4.3.2    LOGICAL OR;                 01659000          
   LQV = 131#,    COMMENT (1015) 7.4.3.3    LOGICAL EQIVALENCE;         01660000          
   LSS = 549#,    COMMENT (4225) 7.4.4.5    LESS THAN;                  01661000          
   MKS =  72#,    COMMENT (0441) 7.4.8.1    MARK STACK;                 01662000          
   MUL =  64#,    COMMENT (0401) 7.4.2.3    MULTIPLY;                   01663000          
   NEQ =  69#,    COMMENT (0425) 7.4.4.6    NOT EQUAL TO;               01664000          
   NOP =  11#,    COMMENT (0055) 7.4.7.1    NO OPERATION;               01665000          
   PRL =  18#,    COMMENT (0111) 7.4.10.6   PROGRAM RELEASE;            01666000          
   PRTE=  12#,    COMMENT (0061) 7.4.10.9   EXTEND PRT;                 01667000          
   RDV = 896#,    COMMENT (7001) 7.4.2.6    REMAINDER DIVIDE;           01668000          
   RTN =  39#,    COMMENT (0235) 7.4.8.3    RETURN NORMAL;              01669000          
   RTS = 167#,    COMMENT (1235) 7.4.8.4    RETURN SPECIAL;             01670000          
   SND = 132#,    COMMENT (1021) 7.4.6.2    STORE NON-DESTRUCTIVE;      01671000          
   SSP = 582#,    COMMENT (4431) 7.4.7.10   SET SIGN PLUS;              01672000          
   STD =  68#,    COMMENT (0421) 7.4.6.1    STORE DESTRUCTIVE;          01673000          
   SUB =  48#,    COMMENT (0301) 7.4.2.2    SUBTRACT;                   01674000          
   XCH = 133#,    COMMENT (1025) 7.4.9.1    EXCHANGE;                   01675000          
   XIT =  71#,    COMMENT (0435) 7.4.8.2    EXIT;                       01676000          
   ZP1 = 322#,    COMMENT (2411) 7.4.10.8   CONDITIONAL HALT;           01677000          
   SCI =1003#,    COMMENT (7655)            SCAN OUT INITIALIZE;        01677050          
   SAN =1004#,    COMMENT (7661)            SYSTEM ATTENTION NEEDED;    01677100          
   SCS =1019#;    COMMENT (7755)            SCAN OUT STOP;              01677150          
 COMMENT  THESE DEFINES ARE USED BY EMITD;                              01678000          
 DEFINE                                                                 01679000          
   DIA =  45#,    COMMENT (XX55) 7.4.7.1    DIAL A;                     01680000          
   DIB =  49#,    COMMENT (XX61) 7.4.7.2    DIAL B;                     01681000          
   TRB =  53#;    COMMENT (XX65) 7.4.7.3    TRANSFER BITS;              01682000          
REAL MAXSTACK,STACKCTR;                                                 01683000          
INTEGER MAXROW;                                                         01684000          
           COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE   01685000          
           ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE;            01686000          
INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE;                  01687000          
INTEGER F;                                                              01688000          
              REAL NLO,NHI,TLO,THI;                                     01689000          
              BOOLEAN DPTOG;                                            01690000          
              COMMENT  THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;01691000          
BOOLEAN DOLLAR2TOG;                                                     01691500          
DEFINE FZERO=896#;                                                      01692000          
REAL T1,T2,N,K,AKKUM;                                                   01693000          
BOOLEAN STOPGSP;                                                        01694000          
INTEGER BUP;                                                            01695000          
BOOLEAN INLINETOG;                                                      01695500          
           COMMENT UNIQUE GLOBAL TEMP FOR BLOCK;                        01696000          
ARRAY GTA1[0:10];                                                       01697000          
 BOOLEAN ARRAY SPRT[0:31];                                              01698000          
    COMMENT  SPRT IS TO BE CONSIDERED TO BE AN ARRAY OF 32 32 BIT       01699000          
              FIELDS.  THE 32 BITS ARE IN THE LOW ORDER PART OF EACH    01700000          
              WORD.  THE BIT IS ON IF AND ONLY IF THE CORRESPONDING     01701000          
              PRT CELL HAS A PERMANENT ASSIGNMENT;                      01702000          
 INTEGER PRTI,PRTIMAX;                                                  01703000          
    COMMENT  PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-01704000          
              MENT.  PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR    01705000          
              TEMPORARY ASSIGNMENT;                                     01706000          
DEFINE ALPHASIZE = [12:6]#;  COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000          
                            POSITION IN THE SECOND WORD OF INFO WHICH   01708000          
                            CONTAINS THE LENGTH OF ALPHA;               01709000          
DEFINE EDOCINDEX = L.[36:3],L.[39:7]#;  COMMENT EDOCINDEX IS THE WORD   01710000          
                                       PORTION OF L SPLIT INTO A ROW AND01711000          
                                       COLUMN INDEX FOR EDOC;           01712000          
DEFINE CPLUS1 = 769#;  COMMENT SEE COMMENT AT CPLUS2 DEFINE;            01713000          
DEFINE CPLUS2 = 770#;  COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000          
                      USED IN THE GENERATION OF C-RELATIVE CODE;        01715000          
 PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD;         01716000          
 ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD;                      01717000          
 REAL PROCEDURE TAKE(W); VALUE W; INTEGER W; FORWARD;                   01717700          
 BOOLEAN MACROID;                                                       01717800          
 REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD;             01717900          
 PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD;         01718000          
 INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD;                    01719000          
 ARRAY CALLA[0:31,0:255];                                               01720000          
 DEFINE CALL[CALL1]=CALLA[(GT3~CALL1).LINKR,GT3.LINKC]#;                01721000          
 REAL CALLX,CALLINFO,NESTCTR,NESTCUR;                                   01722000          
 BOOLEAN NESTOG;                                                        01723000          
 ARRAY NESTPRT[PRTBASE:PRTOP];                                          01724000          
 ARRAY  SORTPRT[0:PRTOP-PRTBASE];                                       01725000          
COMMENT  "BLANKET" BLANKS OUT N+1 WORDS IN "THERE";                     01737300          
STREAM PROCEDURE BLANKET(N,THERE); VALUE N;                             01737350          
    BEGIN                                                               01737400          
    DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS;                      01737450          
    END BLANKET;                                                        01737500          
STREAM PROCEDURE CHANGESEQ(VAL,OLDSEQ); VALUE OLDSEQ;                   01741200          
         BEGIN  DI:=OLDSEQ; SI:=VAL; DS:=8 DEC  END CHANGESEQ;          01741300          
STREAM PROCEDURE SEQUENCEERROR(L);                                      01742100          
    BEGIN  DI:=L; DS:=16 LIT"SEQUENCE ERROR  ";  END SEQUENCEERROR;     01742110          
STREAM PROCEDURE GETVOID(VP,NCR,LCR,SEQ);  VALUE NCR,LCR;               01756000          
    BEGIN                                                               01757000          
    LABEL L,EXIT;                                                       01758000          
    LOCAL N;                                                            01759000          
    SI:=NCR; DI:=VP; DS:=8 LIT "0";                                     01761000          
    2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L));                01762000          
    GO TO EXIT;                   % NO VOID RANGE GIVEN, RETURN ZERO.   01763000          
L:                                                                      01764000          
    IF SC="%" THEN GO TO EXIT;    % STILL NO RANGE.                     01764500          
    IF SC=""" THEN                                                      01765000          
         BEGIN                                                          01766000          
         SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN            01767000          
         NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID.     01768000          
         8(IF SC=""" THEN JUMP OUT ELSE                                 01769000          
              BEGIN  TALLY:=TALLY+1; SI:=SI+1 END);                     01770000          
         END                                                            01771000          
    ELSE BEGIN                                                          01772000          
         NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID.     01773000          
         DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN                      01774000          
         8(IF SC=" " THEN JUMP OUT ELSE                                 01775000          
              BEGIN  TALLY:=TALLY+1; SI:=SI+1 END);                     01776000          
         END;                                                           01777000          
    SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS.                      01780000          
    N:=TALLY; DI:=DI-N; DS:=N CHR;                                      01781000          
EXIT:                                                                   01782000          
    END OF GETVOID;                                                     01784000          
REAL VOIDCR,VOIDPLACE,VOIDTCR,VOIDTPLACE;                               01785000          
FORMAT                                                                  01800000          
         BUG(X24,4(A4,X2));                                             01802000          
PROCEDURE DATIME;                                                       01820000          
    BEGIN                                                               01821000          
    INTEGER H,MIN,Q; ALPHA N1,N2;                                       01822000          
    ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE;                     01823000          
         BEGIN                                                          01824000          
         DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2;                         01825000          
         2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR;                           01826000          
         END OF DATER;                                                  01827000          
    H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60;                  01828000          
    N1:=DISK.MFID; N2:=DISK.FID;                                        01828500          
    WRITE(LINE,                                                         01829000          
          <X22,"BURROUGHS B-5700 ESPOL COMPILER MARK ",                 01830000          
"XVI.0.00"                                                              01831000          
           ,"  ",A6,"DAY, ",O,",  ",I2,":",A2,X1,A3,                    01832000          
          ////X45,A1,A6,"/",A1,A6,/X45,15("=")//>,                      01832500          
           TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q,             01833000          
           Q:=MIN MOD 10+(MIN DIV 10)|64,                               01834000          
           IF H}12 THEN "PM." ELSE "AM.",                               01835000          
           N1.[6:6],N1,N2.[6:6],N2);                                    01835500          
    NOHEADING:=FALSE;                                                   01836000          
    END OF DATIME;                                                      01837000          
 COMMENT  THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS    02000000          
              AND SCANNING THEM;                                        02001000          
COMMENT  OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS;                    02001836          
BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT;            02001838          
    BEGIN                                                               02001840          
    SI:=S; SI:=SI+4; DI:=D; SKP(DS:=3 RESET); % RIGHT JUSTIFY.          02001842          
    CNT(IF SC}"8" THEN TALLY:=1 ELSE IF SC<"0" THEN TALLY:=1; SKIP 3 SB;02001844          
        3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));                 02001846          
    SI:=D; IF SB THEN                                                   02001848          
         BEGIN  TALLY:=1; DI:=D; DS:=RESET   END; % PREVENT FLAG BIT.   02001850          
    OCTIZE:=TALLY; % "1" = NON OCTAL CHARACTER OR FLAG BIT.             02001852          
    END OCTIZE;                                                         02001854          
COMMENT  HEXIZE REFORMATS ACCUM FOR HEXADECIMAL CONSTANTS;              02001856          
BOOLEAN STREAM PROCEDURE HEXIZE(S,D,SKP,CNT); VALUE SKP,CNT;            02001858          
    BEGIN  LOCAL T1,T2,TEMP2,TEMP1; LABEL AGIN;                         02001860          
COMMENT  LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE          02001862          
         WAY THEY ARE DECLARED IN STREAM PROCEDURES;                    02001864          
    DI:=LOC TEMP1; CNT(DS:=LIT"1"); % IN CASE A CHAR=A,B,C,D,OR F.      02001866          
    SI:=S; SI:=SI+3; DI:=LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2.       02001868          
    CNT(IF SC<"0" THEN IF SC}"A" THEN IF SC{"F" THEN % WORK HARD.       02001870          
         BEGIN                                                          02001872          
         T1:=SI; T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN.                   02001874          
         DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK.                      02001876          
         DS:=1 ADD; DI:=DI-1; SKIP 2 DB; DS:=1 SET; SKIP 3 DB;          02001878          
         GO AGIN;                                                       02001880          
         END;                                                           02001882          
         IF SC<"0" THEN TALLY:=1; DS:=CHR; % < 0 = NON-HEX CHARACTER.   02001884          
AGIN:                                                                   02001886          
     );                                                                 02001888          
    SI:=LOC TEMP1; DI:=D; SKP(DS:=4 RESET); % RIGHT ADJUST CONSTANT.    02001890          
    CNT(SKIP 2 SB;                                                      02001892          
      4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));% FINAL CONVERT.   02001894          
    SI:=D; IF SB THEN                                                   02001895          
         BEGIN  TALLY:=1; DI:=D; DS:=RESET   END; % PREVENT FLAG BIT.   02001896          
    HEXIZE:=TALLY; % "1" IF PROGRAMMER GOOFED.                          02001897          
    END HEXIZE;                                                         02001898          
COMMENT  PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE            02002000          
         CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE            02003000          
         IT IS NEEDED FOR FUTURE REFERENCE;                             02004000          
STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR;                         02005000          
    BEGIN  DI:=INFO; SI:=LCR; DS:=WDS;  END PUTSEQNO;                   02006000          
COMMENT  TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER".         02007000          
         I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER-          02008000          
         CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR          02009000          
         THE SCANNER;                                                   02010000          
STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER;         02011000          
    BEGIN  DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR  END;          02012000          
    COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER      02014000          
              AND REPORTS IF THE CARD MIGHT BE CONTROL CARD;            02015000          
 BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR;                  02016000          
         BEGIN SI ~ FCR; IF SC ! "$" THEN TALLY ~ 1;                    02017000          
         DI~NEW;DS~10 WDS;                                              02018000          
               WRITNEW ~ TALLY END WRITNEW;                             02020000          
    COMMENT MKABS CONVERTS A DESCRIPTOR  TO AN ABSOLUTE ADDRESS;        02021000          
 REAL STREAM PROCEDURE MKABS(A);                                        02022000          
              BEGIN DI ~ A; MKABS ~ DI END MKABS;                       02023000          
REAL STREAM PROCEDURE CONV(ACCUM,SKP,N);VALUE SKP,N;                    02041000          
              BEGIN                                                     02042000          
                   SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV;DS~N OCT    02043000          
              END;                                                      02044000          
 STREAM PROCEDURE  MOVECHARACTERS(N,SORCE,SSKIP,DEST,DSKIP);            02045000          
                   VALUE  N,SSKIP,DSKIP;                                02046000          
                   BEGIN                                                02047000          
                   SI~SORCE ; DI~DEST;                                  02048000          
                   SI~SI+SSKIP; DI~ DI+DSKIP ;                          02049000          
                   DS ~ N CHR ;                                         02050000          
                   END ;                                                02051000          
 COMMENT  MOVECHARACTERS MOVES  N CHARACTERS FROM THE SSKIP-TH CHAR IN  02052000          
             "SORCE" TO THE DSKIP-TH CHAR IN "DEST".           ;        02053000          
 STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W;               02054000          
              BEGIN SI ~ A; DI ~ B; DS ~ W WDS END;                     02055000          
 STREAM PROCEDURE RESIZE(FIEL);                                         02056000          
 BEGIN LOCAL T;                                                         02057000          
  SI~FIEL; DI~LOC T; DS~WDS;                                            02058000          
 SI~T;DI~FIEL;DI~DI+1; SKIP 2 DB; DS~10 SET                             02059000          
 END;                                                                   02060000          
COMMENT  EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR         02061000          
         EQUALITY.  THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA        02061500          
         QUANTITIES IN THE DIRECTORY;                                   02062000          
BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT;                 02062500          
    BEGIN                                                               02063000          
    TALLY:=1; SI:=A; DI:=B;                                             02063500          
    IF COUNT SC=DC THEN EQUAL:=TALLY                                    02064000          
    END EQUAL;                                                          02064500          
PROCEDURE READACARD;  FORWARD;                                          02065000          
PROCEDURE DOLLARCARD; FORWARD;                                          02065500          
BOOLEAN PROCEDURE BOOLEXP; FORWARD;                                     02065600          
PROCEDURE SCANNER;                                                      02066000          
    BEGIN                                                               02066500          
COMMENT  "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 02067000          
         IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER",  02067500          
         WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 02068000          
         IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO       02068500          
         INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE, 02069000          
         HENCE THE VARIABLE "RESULT" IS PASSED BY BOTH NAME AND VALUE.  02069500          
         THE MEANING OF "RESULT" AS INPUT IS:                           02070000          
            VALUE    MEANING                                            02070500          
            =====    ========================================           02071000          
              0      INITIAL CODE - DEBLANK AND START TO FETCH THE      02071500          
                     NEXT QUANTITY.                                     02072000          
              1      CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY    02072500          
                     END-OF-CARD BREAK).                                02073000          
              2      LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE,  02073500          
                     EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT     02074000          
                     IMPORTANT).                                        02074500          
              3      CONTINUE BUILDING A NUMBER (INTERRUPTED BY END-OF- 02075000          
                     CARD BREAK).                                       02075500          
              4      LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE,02076000          
                     EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT        02076500          
                     IMPORTANT).                                        02077000          
              5      GET NEXT CHARACTER AND EXIT.                       02077500          
              6      SCAN A COMMENT.                                    02078000          
              7      DEBLANK ONLY.                                      02078500          
         THE MEANING OF "RESULT" AS OUTPUT IS:                          02079000          
            VALUE    MEANING                                            02079500          
            =====    ========================================           02080000          
              1      AN IDENTIFIER WAS BUILT.                           02080500          
              2      A SPECIAL CHARACTER WAS OBTAINED.                  02081000          
              3      A NUMBER (INTEGER) WAS BUILT.                      02081500          
         "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND         02082000          
         DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR"           02082500          
         FOR THE REST OF THIS DISCUSSION).                              02083000          
         "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS    02083500          
         "SCAN" HAS PUT INTO THE "ACCUMULATOR".  SINCE "SCAN" NEEDS     02084000          
         THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM-  02084500          
         ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD.     02085000          
         "COUNT" IS PASSED BY BOTH NAME AND VALUE.  IT IS ALSO          02085500          
         CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT".      02086000          
         "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY         02086500          
         NAME AND VALUE SO THAT IT MAY BE UPDATED.                      02087000          
         "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY    02087500          
         PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK     02088000          
         ARRANGEMENT.                                                   02088500          
         ;                                                              02089000          
    STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV,     02089500          
                          COUNT,ST2,NCRV,ST1);                          02090000          
                     VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1;       02090500          
         BEGIN                                                          02091000          
         LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR,         02091500          
               COMMENTS,COMMANTS;                                       02092000          
         DI:=RESULT; DI:=DI+7; SI:=NCRV;                                02092500          
COMMENT  SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT     02093000          
         THE BUFFER;                                                    02093500          
         CI:=CI+RESULTV;   % SWITCH ON VALUE OF RESULT;                 02094000          
         GO DEBLANK;  % 0 IS INITIAL CODE.                              02094500          
         GO IDBLDR;   % 1 IS ID CODE.                                   02095000          
         GO FINIS;    % 2 IS SPECIAL CHARACTER CODE.                    02095500          
         GO NUMBERS;  % 3 IS NUMBER CODE.                               02096000          
         GO FINIS;    % 4 IS ERROR CODE.                                02096500          
         GO GNC;      % 5 IS GET NEXT CHARACTER CODE.                   02097000          
         GO COMMANTS; % 6 IS COMMENT CODE.                              02097500          
                      % 7 IS DEBLANK ONLY CODE.                         02098000          
         IF SC=" " THEN                                                 02098500          
K:            BEGIN  SI:=SI+1; IF SC=" " THEN GO K  END;                02099000          
         GO FINIS;                                                      02099500          
DEBLANK:                                                                02100000          
         IF SC=" " THEN                                                 02100500          
L:            BEGIN  SI:=SI+1; IF SC=" " THEN GO L  END;                02101000          
COMMENT  IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER;               02101500          
         NCRV:=SI;                                                      02102000          
         IF SC } "0" THEN GO NUMBERS;                                   02102500          
         IF SC=ALPHA THEN GO IDBLDR;                                    02103000          
COMMENT  IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC);        02103500          
GNC:                                                                    02104000          
         DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT;                       02104500          
COMMANTS:                                                               02105000          
         IF SC!";" THEN                                                 02105500          
              BEGIN                                                     02106000          
COMMENTS:                                                               02106500          
              SI:=SI+1;                                                 02107000          
              IF SC > "%" THEN GO COMMENTS;                             02107500          
              IF SC < ";" THEN GO COMMENTS;                             02108000          
COMMENT  CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD-        02108500          
         MODE PART OF COMMENT ROUTINE;                                  02109000          
              END;                                                      02109500          
         GO FINIS;                                                      02110000          
IDBLDR:                                                                 02110500          
         TALLY:=63; DS:=LIT "1";                                        02111000          
         COMCOUNT(TALLY:=TALLY+1;                                       02111500          
                  IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO EXIT);     02112000          
         TALLY:=TALLY+1;                                                02112500          
         IF SC=ALPHA THEN                                               02113000          
              BEGIN                                                     02113500          
ERROR:                                                                  02114000          
              DI:=DI-1; DS:=LIT "4"; GO EXIT;                           02114500          
              END                                                       02115000          
         ELSE GO EXIT;                                                  02115500          
COMMENT  IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS          02116000          
         IN AN IDENTIFIER OR NUMBER;                                    02116500          
NUMBERS:                                                                02117000          
         TALLY:=63; DS:=LIT "3";                                        02117500          
         COMCOUNT(TALLY:=TALLY+1;                                       02118000          
                  IF SC <"0"THEN JUMP OUT TO EXIT; SI:=SI+1);           02118500          
         GO ERROR;                                                      02119000          
EXIT:                                                                   02119500          
         ST1:=TALLY; % "ST1" CONTAINS NUMBER OF CHARACTERS WE ARE       02120000          
                     % GOING TO MOVE INTO THE "ACCUMULATOR".            02120500          
         TALLY:=TALLY+COUNTV; ST2:=TALLY;                               02121000          
         DI:=COUNT; SI:=LOC ST2; DS:=WDS;                               02121500          
COMMENT  THIS CODE UPDATED "COUNT";                                     02122000          
         DI:=ACCUM; SI:=SI-3; DS:=3 CHR;                                02122500          
COMMENT  THIS CODE PLACES "COUNT" IN "ACCUM" AS WELL;                   02123000          
         DI:=DI+COUNTV; % POSITION "DI" PAST CHARACTERS ALREADY         02123500          
                        % IN THE "ACCUMULATOR", IF ANY.                 02124000          
         SI:=NCRV; DS:=ST1 CHR;                                         02124500          
COMMENT  MOVE CHARACTERS INTO "ACCUM";                                  02125000          
FINIS:                                                                  02125500          
         DI:=NCR; ST1:=SI; SI:=LOC ST1; DS:=WDS;                        02126000          
COMMENT  RESET "NCR" TO LOCATION OF NEXT CHARACTER TO BE SCANNED;       02126500          
         END OF SCAN;                                                   02127000          
    LABEL L;%                                                           02127500          
L:                                                                      02128000          
    SCAN(NCR,COUNT,ACCUM[1],63-COUNT,RESULT,                            02128500          
         RESULT,COUNT,0,NCR,0);                                         02129000          
    IF NCR=LCR THEN                                                     02129500          
         BEGIN                                                          02130000          
         READACARD;                                                     02130500          
         GO TO L; % GO DIRECTLY TO L, DO NOT PASS GO,                   02135500          
                  % DO NOT COLLECT $200.                                02136000          
         END;                                                           02136500          
    END SCANNER;                                                        02137000          
DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*])               02181000          
                     ELSE WRITE(LINE[DBL],15,LIN[*])#,                  02181250          
       PRINTCARD = BEGIN                                                02182500          
                   EDITLINE(LIN,FCR,L DIV 4,L.[46:2],MEDIUM,OMITTING);  02182750          
                   IF NOHEADING THEN DATIME; WRITELINE;                 02183000          
                   END #;                                               02183250          
STREAM PROCEDURE EDITLINE(LINE,NCR,R,L,SYMBOL,OMIT);                    02183500          
                        VALUE  NCR,R,L,SYMBOL,OMIT;                     02183750          
    BEGIN                                                               02184000          
    DI := LINE; DS := 16 LIT " ";                                       02184250          
    SI := NCR; DS := 9 WDS;                                             02184500          
    DS := 8 LIT " ";                                                    02184750          
    DS := WDS; % SEQUENCE NUMBER.                                       02185000          
    DS:=LIT" "; SI:=LOC SYMBOL; SI:=SI+6;                               02185250          
    DS:=2 CHR; DS:=LIT" ";                                              02185500          
    SI~LOC R;  DS~4 DEC;  DS~LIT ":";                                   02185750          
    SI~LOC L;  DS~1 DEC;                                                02186000          
    DS~6 LIT " ";                                                       02186250          
    OMIT(DI:=DI-12; DS:=8 LIT"    OMIT");                               02186750          
    END EDITLINE;                                                       02187000          
COMMENT  COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF         02187250          
         TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER        02187500          
         RESULT = 1 ELSE RESULT = 2;                                    02187750          
REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD;              02188000          
    BEGIN                                                               02188250          
    SI := TAPE; DI := CARD;                                             02188500          
    IF 8 SC } DC THEN                                                   02188750          
         BEGIN                                                          02189000          
         SI := SI-8; DI := DI-8; TALLY := 1;                            02189250          
         IF 8 SC = DC THEN TALLY := 2                                   02189500          
         END;                                                           02189750          
    COMPARE := TALLY                                                    02190000          
    END COMPARE;                                                        02190250          
PROCEDURE OUTPUTSOURCE;                                                 02190500          
    BEGIN                                                               02190750          
    LABEL LCARD,LTAPE,AWAY;                                             02191000          
    SWITCH SW:=LCARD,LCARD,LTAPE,AWAY,LCARD,LTAPE;                      02191250          
    IF SEQTOG THEN % RESEQUENCING.                                      02191500          
         BEGIN                                                          02191750          
         IF TOTALNO = -10 OR NEWBASE THEN                               02192000          
              BEGIN                                                     02192250          
              NEWBASE := FALSE; GTI1:= TOTALNO:=BASENUM                 02192500          
              END                                                       02192750          
         ELSE GTI1:= TOTALNO:= TOTALNO + ADDVALUE;                      02193000          
         CHANGESEQ(GTI1,LCR);                                           02193250          
         END;                                                           02193500          
    IF NEWTOG THEN                                                      02193750          
      IF WRITNEW(LIN,FCR) THEN WRITE(NEWTAPE,10,LIN[*]);                02194000          
    IF OMITTING THEN IF NOT LISTATOG THEN GO AWAY;                      02194250          
    GO SW[LASTUSED];                                                    02194500          
LCARD:                                                                  02194750          
    IF LISTER OR LISTPTOG THEN PRINTCARD;                               02195000          
    GO AWAY;                                                            02195250          
LTAPE:                                                                  02195500          
    IF LISTER THEN PRINTCARD;                                           02195750          
%   GO AWAY;                                                            02196000          
AWAY:                                                                   02196250          
    END OUTPUTSOURCE;                                                   02196500          
PROCEDURE READACARD;                                                    02196750          
COMMENT  READACARD READS CARDS FROM EITHER THE CARD READER OR THE       02197000          
         TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND          02197250          
         LISTING IF REQUESTED.  READACARD ALSO INSERTS A PERCENT        02197500          
         SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS          02197750          
         FCR,NCR,LCR,TLCR, AND CLCR;                                    02198000          
    BEGIN                                                               02198250          
    PROCEDURE READTAPE;                                                 02198500          
              BEGIN                                                     02201500          
LABEL ENDREADTAPE, EOFT;                                                02201510          
READ (TAPE, 10, TBUFF[*])[EOFT];                                        02201750          
                LCR:=MKABS(TBUFF[9]);                                   02202000          
GO TO ENDREADTAPE;                                                      02202010          
EOFT:                                                                   02202020          
DEFINEARRAY[25]:="ND;END."& "E"[1:43:5];                                02202030          
DEFINEARRAY[34]:="9999" & "9999"[1:25:23];                              02202040          
TLCR:= MKABS(DEFINEARRAY[34]);                                          02202050          
PUTSEQNO (DEFINEARRAY[33],TLCR-8);                                      02202060          
TURNONSTOPLIGHT("%", TLCR-8);                                           02202070          
ENDREADTAPE:                                                            02202080          
              END READTAPE;                                             02202250          
    PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB;       02202500          
                                          REAL TLCR, CLCR ;             02202750          
         BEGIN                                                          02203000          
         MEDIUM:="C "; % CARD READER.                                   02203250          
         IF GT1:=COMPARE(TLCR,CLCR)=0 THEN  % TAPE HAS LOW SEQUENCE NUMB02203500          
              BEGIN                                                     02203750          
              LCR:=TLCR; LASTUSED:=3;                                   02204000          
              MEDIUM:="T "; % TAPE INPUT.                               02204250          
              END                                                       02204500          
         ELSE BEGIN                                                     02204750          
              IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ             02205000          
                   BEGIN                                                02205250          
                   MEDIUM:="P "; % CARD PATCHES TAPE.                   02205500          
                   READTAPE;                                            02208500          
                   END;                                                 02208750          
              LCR:=CLCR;                                                02209000          
              LASTUSED:=2;                                              02209250          
              END;                                                      02209500          
         END OF SEQCOMPARE;                                             02209750          
    LABEL CARDONLY, CARDLAST, TAPELAST,  EXIT, FIRSTTIME,               02210000          
          EOF, USETHESWITCH,                                            02210250          
          COMPAR, TESTVOID, XIT;                                        02210500          
    SWITCH USESWITCH:=CARDONLY,CARDLAST,TAPELAST,FIRSTTIME;             02210750          
    IF ERRORCOUNT}ERRMAX THEN ERR(611); % ERR LIMIT EXCEEDED - STOP.    02211500          
USETHESWITCH:                                                           02211750          
    DOLLAR2TOG:=FALSE;                                                  02211800          
    GO TO USESWITCH[LASTUSED];                                          02212000          
    MOVE(1,INFO[LASTUSED.LINKR,LASTUSED.LINKC],                         02212250          
         DEFINEARRAY[DEFINEINDEX-2]);                                   02212500          
    LASTUSED := LASTUSED + 1;                                           02212750          
    NCR := LCR-1;                                                       02213000          
    GO TO XIT;                                                          02213250          
FIRSTTIME:                                                              02213500          
    READ(CARD,10,CBUFF[*]);                                             02213750          
    FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9;                                 02214000          
    MEDIUM:="C ";                                                       02214100          
    IF EXAMIN(FCR)!"$" AND LISTER THEN PRINTCARD;                       02214200          
    PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR);                        02214250          
    TURNONSTOPLIGHT("%",LCR);                                           02214500          
    GO XIT;                                                             02214750          
COMMENT  WE HAVE JUST INITIALIZED CARD INPUT;                           02215000          
CARDONLY:                                                               02215250          
    READ(CARD,10,CBUFF[*]);                                             02215500          
    LCR := MKABS(CBUFF[9]); GO EXIT;                                    02215750          
CARDLAST:                                                               02216000          
    READ(CARD,10,CBUFF[*])[EOF];                                        02216250          
    CLCR := MKABS(CBUFF[9]);                                            02216500          
    GO COMPAR;                                                          02216750          
EOF:                                                                    02217000          
    DEFINEARRAY[25]:="ND;END."&"E"[1:43:5];                             02217250          
    DEFINEARRAY[34]:="9999"&"9999"[1:25:23];                            02217500          
    CLCR:=MKABS(DEFINEARRAY[34]);                                       02217750          
    PUTSEQNO(DEFINEARRAY[33],CLCR-8);                                   02218000          
    TURNONSTOPLIGHT("%",CLCR-8);                                        02218250          
%                                                                       02218400          
    GO COMPAR;                                                          02218500          
COMMENT  THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND       02218750          
         SETS UP CLCR;                                                  02219000          
TAPELAST:                                                               02219250          
    READTAPE;                                                           02219500          
COMMENT  THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR;    02219750          
COMPAR:                                                                 02224250          
    SEQCOMPARE(TLCR,CLCR,FALSE);                                        02224500          
EXIT:                                                                   02225000          
    NCR := FCR:= LCR - 9;                                               02225250          
COMMENT  SETS UP NCR AND FCR;                                           02225500          
    IF EXAMIN(FCR)!"$" THEN % $-CARDS DON"T COUNT.                      02225750          
      IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN       02226000          
        BEGIN                                                           02226250          
        FLAG(610); % SEQUENCE ERROR.                                    02226500          
        SEQUENCEERROR(LIN);                                             02226750          
        END;                                                            02227000          
    CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8);              02228000          
    IF LASTUSED=3 THEN                                                  02228050          
         BEGIN                                                          02228075          
         IF VOIDTAPE THEN GO USETHESWITCH;                              02228100          
         IF VOIDTCR!0 THEN                                              02228125          
           IF COMPARE(LCR,VOIDTCR)=0 THEN GO USETHESWITCH;              02228150          
         END;                                                           02228175          
    IF EXAMIN(FCR)="$" THEN                                             02228250          
         BEGIN                                                          02228500          
         IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD;                  02228750          
         NCR:=NCR+32768; DOLLARCARD;                                    02229000          
COMMENT  DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250          
         GO USETHESWITCH;                                               02229500          
         END;                                                           02229750          
    IF EXAMIN(FCR)=" " THEN                                             02230000          
      IF DOLLAR2TOG:=EXAMIN(FCR+32768)="$" THEN                         02230100          
         BEGIN                                                          02230250          
         OUTPUTSOURCE;                                                  02230500          
         NCR:=NCR+65536; % SCAN PAST " $" (CHARACTER MODE).             02230750          
         DOLLARCARD;                                                    02231000          
         END;                                                           02231250          
    IF VOIDING THEN GO USETHESWITCH;                                    02231500          
    IF VOIDCR!0 THEN                                                    02231750          
         IF COMPARE(LCR,VOIDCR)>0 THEN VOIDCR:=VOIDPLACE:=0             02232000          
           ELSE GO USETHESWITCH;                                        02232250          
    IF VOIDTAPE THEN GO TESTVOID;                                       02232500          
    IF VOIDCR!0 THEN                                                    02233000          
         IF COMPARE(LCR,VOIDTCR)>0 THEN VOIDTCR:=VOIDPLACE:=0 ELSE      02233500          
TESTVOID:  IF LASTUSED=3 THEN GO USETHESWITCH;                          02234000          
    CARDCOUNT:=CARDCOUNT+1;                                             02234500          
    IF DOLLAR2TOG THEN GO USETHESWITCH;                                 02234600          
    PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR);                        02234750          
    OUTPUTSOURCE;                                                       02235000          
    IF OMITTING THEN GO USETHESWITCH;                                   02235250          
%                                                                       02235500          
    TURNONSTOPLIGHT("%",LCR);                                           02235750          
XIT:                                                                    02237750          
    END READACARD;                                                      02238000          
REAL PROCEDURE CONVERT;                                                 02248000          
              BEGIN   REAL  T;  INTEGER  N;                             02249000          
              TLO~0;   THI~                                             02250000          
                   T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8);      02251000          
                   FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO             02252000          
              IF DPTOG THEN                                             02253000          
              BEGIN                                                     02254000          
              DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~,  02255000          
                           THI,TLO);                                    02256000          
              T~THI;                                                    02257000          
              END  ELSE                                                 02258000          
                   T~  T|100000000+ CONV(ACCUM[1],N,8);                 02259000          
                   CONVERT~T;                                           02260000          
              END;                                                      02261000          
REAL STREAM PROCEDURE FETCH(F); VALUE F;                                02262000          
    BEGIN  SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS  END FETCH;          02263000          
PROCEDURE DUMPINFO;                                                     02264000          
    BEGIN                                                               02264050          
    ARRAY A[0:14]; INTEGER JEDEN,DWA;                                   02264100          
    STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N;                        02264400          
         BEGIN                                                          02264450          
         SI:=S; DI:=D;                                                  02264500          
         N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE                 02264550          
              DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" ");   02264600          
         END OF OCTALWORDS;                                             02264650          
    STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N;                        02264700          
         BEGIN                                                          02264750          
         SI:=S; DI:=D;                                                  02264800          
         N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" ");  02264850          
         END OF ALPHAWORDS;                                             02264900          
    IF NOHEADING THEN DATIME;WRITE(LINE[DBL],<//"ELBAT">);              02264950          
    FOR JEDEN:=0 STEP 6 UNTIL 71 DO                                     02265000          
         BEGIN                                                          02265050          
         BLANKET(14,A); OCTALWORDS(ELBAT[JEDEN],A,6);                   02265100          
         WRITE(LINE[DBL],15,A[*]);                                      02265150          
         END;                                                           02265200          
    BLANKET(14,A); OCTALWORDS(ELBAT[72],A,4);                           02265250          
    WRITE(LINE[DBL],15,A[*]);                                           02265300          
    FOR JEDEN:=0 STEP 1 UNTIL NEXTINFO DIV 256 DO                       02265350          
         BEGIN                                                          02265400          
         WRITE(LINE[DBL],<//"INFO[",I2,",*]">,JEDEN);                   02265450          
         FOR DWA:=0 STEP 6 UNTIL 251 DO                                 02265500          
              BEGIN                                                     02265550          
              BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6);           02265600          
              WRITE(LINE,15,A[*]);                                      02265650          
              BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6);           02265700          
              WRITE(LINE[DBL],15,A[*]);                                 02265750          
              END;                                                      02265800          
         BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4);                02265850          
         WRITE(LINE,15,A[*]);                                           02265900          
         BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4);                02265950          
         WRITE(LINE[DBL],15,A[*]);                                      02266000          
         END;                                                           02266050          
    END OF DUMPINFO;                                                    02266100          
DEFINE SKAN = BEGIN                                                     02277000          
              COUNT:=RESULT:=ACCUM[1]:=0;                               02278000          
              SCANNER;                                                  02279000          
              Q:=ACCUM[1];                                              02280000          
              END #;                                                    02281000          
COMMENT  DOLLARCARD HANDLES THE COMPILER CONTROL CARDS.                 02282000          
         ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT                02283000          
         IN THE ARRAY "OPTIONS".                                        02284000          
         EACH OPTION HAS A TWO-WORD ENTRY:                              02285000          
                                                                        02286000          
           WORD           CONTAINS                                      02287000          
           ----           --------                                      02288000          
             1            ENTRY FROM ACCUM[1]: 00XZZZZ, WHERE           02289000          
                          X IS THE SIZE OF THE ID AND                   02290000          
                          ZZZZZ IS THE FIRST FIVE CHARS OF THE ID.      02291000          
             2            PUSH-DOWN, 47-BIT STACK CONTAINING THE        02292000          
                          HISTORY OF THE SETTINGS OF THIS OPTION.       02293000          
                                                                        02294000          
         IN "FINDOPTION", ALL COMPILER-DEFINED OPTIONS ARE USUALLY      02295000          
         LOCATED BASED UPON A UNIQUE NUMBER ASSIGNED TO EACH.           02296000          
         FOR ALL USER-DEFINED OPTIONS, A SEQUENTIAL TABLE SEARCH IS     02297000          
         INITIATED USING "USEROPINX" AS THE INITIAL INDEX INTO THE      02298000          
         "OPTIONS" ARRAY. IF THE NUMBER OF COMPILER-DEFINED OPTIONS     02299000          
         IS CHANGED, THEN "USEROPINX" MUST BE ACCORDINGLY CHANGED.      02300000          
         THE NUMBER OF USER DEFINED OPTIONS ALLOWED CAN BE              02301000          
         CHANGED BY CHANGING THE DEFINE "OPARSIZE".                     02302000          
         THE VARIABLE "OPTIONWORD" CONTAINS THE CURRENT TRUE OR FALSE   02303000          
         SETTING OF ALL OF THE COMPILER-DEFINED OPTIONS, ONE BIT PER    02304000          
         OPTION.                                                        02305000          
 ;                                                                      02306000          
BOOLEAN PROCEDURE FINDOPTION(BIT); VALUE BIT; INTEGER BIT;              02307000          
    BEGIN                                                               02308000          
    LABEL FOUND;                                                        02309000          
    REAL ID;                                                            02310000          
    OPINX:=2|BIT-4;                                                     02311000          
    WHILE ID:=OPTIONS[OPINX:=OPINX+2]!0 DO                              02312000          
         IF Q=ID THEN GO FOUND;                                         02313000          
    OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION.                       02314000          
FOUND:                                                                  02315000          
     IF OPINX +1>OPARSIZE THEN FLAG(602) ELSE % TOO MANY USER OPTIONS   02316000          
    FINDOPTION:=BOOLEAN(OPTIONS[OPINX+1]);                              02317000          
    END FINDOPTION;                                                     02318000          
PROCEDURE DOLLARCARD;                                                   02319000          
    BEGIN                                                               02320000          
    STREAM PROCEDURE RESTORESEQNUM(LCR,INFO);  VALUE LCR;               02320200          
         BEGIN                                                          02320400          
         DI:=LCR; SI:=INFO; DS:=WDS;                                    02320600          
         END;                                                           02320800          
    PROCEDURE SWITCHIT(XBIT); VALUE XBIT; INTEGER XBIT;                 02321000          
         BEGIN                                                          02322000          
         BOOLEAN B,T;                                                   02323000          
         INTEGER SAVEINX;                                               02324000          
         LABEL XMODE0,XMODE1,XMODE2,XMODE3,XMODE4,ALONG;                02325000          
         SWITCH SW:=XMODE0,XMODE1,XMODE2,XMODE3,XMODE4;                 02326000          
         SETTING:=FINDOPTION(XBIT); SKAN;                               02327000          
         GO SW[XMODE+1];                                                02328000          
XMODE0:  % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP.            02329000          
         OPTIONWORD:=BOOLEAN(0);                                        02330000          
         FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO OPTIONS[SAVEINX]:=0;   02331000          
         XMODE:=LASTUSED:=1; % CARD INPUT ONLY.                         02332000          
XMODE1:  % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED.        02333000          
         OPTIONS[OPINX+1]:=REAL(TRUE);                                  02334000          
         IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & TRUE[XBIT:1];  02335000          
         GO ALONG;                                                      02336000          
XMODE2:  % RESET;                                                       02337000          
         OPTIONS[OPINX+1]:=REAL(FALSE & SETTING[1:2:46]);               02338000          
         IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & FALSE[XBIT:1]; 02339000          
         GO ALONG;                                                      02340000          
XMODE3:  % SET.                                                         02341000          
         SAVEINX:=OPINX; % REMEMBER OPTION WE ARE SETTING.              02342000          
         B:=IF Q="1=0000" THEN BOOLEXP ELSE TRUE;                       02343000          
         OPTIONS[SAVEINX+1]:=REAL(B & SETTING[1:46]);                   02352000          
         IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & B [XBIT:1];    02353000          
         GO ALONG;                                                      02354000          
XMODE4:  % POP.                                                         02355000          
         OPTIONS[OPINX+1]:=REAL(B:=SETTING.[1:46]);                     02356000          
         IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & B [XBIT:1];    02357000          
ALONG:                                                                  02358000          
         END SWITCHIT;                                                  02359000          
    LABEL EXIT,AGAIN,SKANAGAIN,LENGTH1,LENGTH2,LENGTH3,LENGTH4,         02360000          
          LENGTH5,LENGTH6,LENGTH7,LENGTH8,LENGTH9,                      02361000          
          WHATISIT,                                                     02362000          
          CARDOPTION,MERGEOPTION;                                       02363000          
    SWITCH OPTIONLENGTH:=LENGTH1,WHATISIT,LENGTH3,LENGTH4,LENGTH5,      02364000          
                         LENGTH6,LENGTH7,WHATISIT,LENGTH9,WHATISIT;     02365000          
    INTEGER SRESULT,SCOUNT;                                             02365100          
    ALPHA VOIDRANGE;                                                    02365200          
    DOLLARTOG:=TRUE;                                                    02366000          
    MOVE(10,ACCUM[0],DEFINEARRAY[0]); % SAVE INFORMATION FOR            02366100          
    SCOUNT:=COUNT; SRESULT:=RESULT;   % "TABLE" TO RESUME SCAN.         02366200          
    XMODE:=0;                                                           02367000          
    PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR);                        02368000          
    TURNONSTOPLIGHT("%",LCR);                                           02369000          
SKANAGAIN:                                                              02370000          
    SKAN;                                                               02371000          
AGAIN:                                                                  02372000          
    GO OPTIONLENGTH[MIN(COUNT,10)];                                     02373000          
LENGTH1:                                                                02374000          
    IF Q = "1%0000" THEN GO EXIT;                                       02375000          
    IF Q = "1$0000" THEN                                                02376000          
         BEGIN SWITCHIT(PRINTDOLLARBIT); GO AGAIN END;                  02377000          
    IF Q = "1,0000" THEN GO SKANAGAIN;                                  02378000          
    GO WHATISIT;                                                        02379000          
LENGTH2: % NO OPTIONS OF THIS LENGTH ARE CURRENTLY IMPLEMENTED.         02380000          
LENGTH3:                                                                02381000          
    IF Q = "3SET00" THEN                                                02382000          
         BEGIN XMODE:=3; GO SKANAGAIN END;                              02383000          
    IF Q = "3POP00" THEN                                                02384000          
         BEGIN XMODE:=4; GO SKANAGAIN END;                              02385000          
    IF Q = "3NEW00" THEN                                                02386000          
         BEGIN                                                          02387000          
         SWITCHIT(NEWBIT);                                              02388000          
         IF Q = "4TAPE0" THEN GO SKANAGAIN;                             02389000          
         GO AGAIN;                                                      02390000          
         END;                                                           02391000          
    IF Q = "3SEQ00" THEN                                                02392000          
         BEGIN SWITCHIT(SEQBIT); GO AGAIN END;                          02393000          
    IF Q = "3PRT00" THEN                                                02394000          
         BEGIN SWITCHIT(PRTBIT); GO AGAIN END;                          02395000          
    IF Q = "3MCP00" THEN                                                02396000          
         BEGIN SWITCHIT(MCPBIT); GO AGAIN END;                          02397000          
    GO WHATISIT;                                                        02398000          
LENGTH4:                                                                02399000          
    IF Q = "4LIST0" THEN                                                02400000          
         BEGIN                                                          02401000          
         SWITCHIT(LISTBIT);                                             02402000          
         GO AGAIN;                                                      02404000          
         END;                                                           02405000          
    IF Q = "4VOID0" THEN                                                02406000          
         BEGIN                                                          02407000          
         IF XMODE=0 THEN                                                02408000          
              BEGIN                                                     02409000          
              GETVOID(VOIDRANGE,NCR,LCR,INFO[LASTSEQROW,LASTSEQUENCE]); 02410000          
              IF VOIDCR=0 THEN VOIDCR:=MKABS(VOIDPLACE) ELSE            02410500          
                IF COMPARE(MKABS(VOIDRANGE),VOIDCR)!1 THEN GO TO EXIT;  02411000          
              MOVE(1,VOIDRANGE,VOIDPLACE);                              02412000          
              GO EXIT;                                                  02413000          
              END;                                                      02414000          
         SWITCHIT(VOIDBIT);                                             02415000          
         GO AGAIN;                                                      02418000          
         END;                                                           02419000          
    IF Q = "4OMIT0" THEN                                                02420000          
         BEGIN IF NOT DOLLAR2TOG THEN BEGIN PRINTCARD; FLAG(605); END;  02421000          
              SWITCHIT(OMITBIT); GO AGAIN END;                          02421100          
    IF Q = "4CARD0" THEN                                                02422000          
         BEGIN                                                          02423000          
         Q:="4TAPE0"; % FAKE OUT SWITCHIT.                              02424000          
         SWITCHIT(MERGEBIT);                                            02425000          
         IF XMODE!2 THEN MERGETOG:=NOT MERGETOG;                        02425500          
         OPTIONS[2|MERGEBIT-1]:=               % CARD IS                02426000          
           REAL(SETTING & (MERGETOG)[47:1]);   % INVERSE OF MERGE.      02427000          
         IF MERGETOG THEN GO MERGEOPTION;                               02428000          
CARDOPTION:                                                             02429000          
         LASTUSED:=1;                                                   02430000          
         GO AGAIN;                                                      02431000          
         END;                                                           02432000          
    IF Q = "4TAPE0" THEN                                                02433000          
         BEGIN                                                          02434000          
         SWITCHIT(MERGEBIT);                                            02435000          
         IF NOT MERGETOG THEN GO CARDOPTION;                            02436000          
MERGEOPTION:                                                            02437000          
         LASTUSED:=2; % NEXT CARD IS READ FROM READER.                  02438000          
         IF MAXTLCR=0 THEN                                              02439000          
              BEGIN                                                     02440000          
              INTEGER STREAM PROCEDURE FEJ(F,T); VALUE T;               02441000          
                   BEGIN                                                02442000          
                   SI:=F; DI:=LOC T; DS:=WDS;                           02443000          
                   SI:=T; SI:=SI-16; DI:=LOC FEJ; DS:=WDS;              02444000          
                   END FEJ;                                             02445000          
              STREAM PROCEDURE FIX(F,T); VALUE T;                       02446000          
                   BEGIN                                                02447000          
                   SI:=F; SI:=SI-24; DI:=LOC T; DS:=WDS;                02448000          
                   DI:=T; DI:=DI+47; SKIP 4 DB; DS:=2 RESET;            02449000          
                   2(DI:=DI+48); DS:=8 LIT"00#01+0#";                   02450000          
                   END FIX;                                             02451000          
              IF GT1:=FEJ(TAPE,0)=10 THEN                               02452000          
                   BEGIN                                                02453000          
                   REWIND(TAPE); FIX(TAPE,0);                           02454000          
                   END;                                                 02455000          
              MAXTLCR:=GT1+TLCR:=9+MKABS(TBUFF[0]);                     02456000          
              READ(TAPE,10,TBUFF[*]); % INITIALIZE TAPE INPUT.          02457000          
              LASTUSED:=2;                                              02458000          
              END;                                                      02459000          
         GO AGAIN;                                                      02460000          
         END;                                                           02461000          
    IF Q = "4PAGE0" THEN                                                02462000          
         BEGIN                                                          02463000          
         IF LISTER THEN WRITE(LINE[PAGE]);                              02464000          
         GO SKANAGAIN;                                                  02465000          
         END;                                                           02466000          
    IF Q = "4INFO0" THEN                                                02467000          
         BEGIN DUMPINFO; GO SKANAGAIN END;                              02468000          
    IF Q = "4SEGS0" THEN                                                02469000          
         BEGIN SWITCHIT(SEGSBIT); GO AGAIN END;                         02470000          
    IF Q = "4NEST0" THEN                                                02471000          
         BEGIN SWITCHIT(NESTBIT); GO AGAIN END;                         02472000          
    IF Q = "4DECK0" THEN                                                02473000          
         BEGIN SWITCHIT(DECKBIT); GO AGAIN END;                         02474000          
    GO WHATISIT;                                                        02475000          
LENGTH5:                                                                02476000          
    IF Q = "5RESET" THEN                                                02477000          
         BEGIN XMODE:=2; GO SKANAGAIN END;                              02478000          
    IF Q = "5LISTP" THEN                                                02479000          
         BEGIN SWITCHIT(LISTPBIT); GO AGAIN; END;                       02480000          
    IF Q = "5VOIDT" THEN                                                02481000          
         BEGIN                                                          02482000          
         IF XMODE=0 THEN                                                02483000          
              BEGIN                                                     02484000          
              GETVOID(VOIDRANGE,NCR,LCR,INFO[LASTSEQROW,LASTSEQUENCE]); 02485000          
              IF VOIDTCR=0 THEN VOIDTCR:=MKABS(VOIDTPLACE) ELSE         02485500          
                IF COMPARE(MKABS(VOIDRANGE),VOIDTCR)!1 THEN GO TO EXIT; 02486000          
              MOVE(1,VOIDRANGE,VOIDTPLACE);                             02487000          
              GO EXIT;                                                  02488000          
              END;                                                      02489000          
         SWITCHIT(VOIDTBIT);                                            02490000          
         GO AGAIN;                                                      02493000          
         END;                                                           02494000          
    IF Q = "5CHECK" THEN                                                02495000          
         BEGIN SWITCHIT(CHECKBIT); GO AGAIN END;                        02496000          
    IF Q = "5LIMIT" THEN                                                02497000          
         BEGIN                                                          02498000          
         SKAN;                                                          02499000          
         IF RESULT!3 THEN % SHOULD BE NUMBER.                           02500000          
               BEGIN FLAG(600); GO AGAIN END;                           02501000          
         ERRMAX:=CONV(ACCUM[1],0,ACCUM[1].[12:6]);                      02502000          
         GO SKANAGAIN;                                                  02503000          
         END;                                                           02504000          
    IF Q = "5PUNCH" THEN                                                02505000          
         BEGIN SWITCHIT(PUNCHBIT); GO AGAIN; END;                       02506000          
    IF Q = "5PURGE" THEN                                                02507000          
         BEGIN SWITCHIT(PURGEBIT); GO AGAIN; END;                       02508000          
    IF Q = "5LISTA" THEN                                                02509000          
         BEGIN                                                          02510000          
         SWITCHIT(LISTABIT);                                            02511000          
         GO AGAIN;                                                      02513000          
         END;                                                           02514000          
    IF Q = "5STUFF" THEN                                                02515000          
         BEGIN SWITCHIT(STUFFBIT); GO AGAIN; END;                       02516000          
    GO WHATISIT;                                                        02517000          
LENGTH6:                                                                02518000          
    IF Q = "6SEQER" THEN                                                02519000          
         BEGIN SWITCHIT(SEQERRBIT); GO AGAIN END;                       02520000          
    IF Q = "6SINGL" THEN                                                02521000          
         BEGIN SWITCHIT(SINGLBIT); GO AGAIN  END;                       02522000          
    IF Q = "6SEQXE" THEN                                                02523000          
         BEGIN                                                          02524000          
         SEQXEQTOG:=XMODE!2 AND XMODE! 4 OR SEQXEQTOG;%NEVER RESET.     02525000          
         IF BUILDLINE.[45:1] THEN BUILDLINE:=TRUE;                      02526000          
         GO SKANAGAIN;                                                  02527000          
         END;                                                           02528000          
    IF Q = "6DEBUG" THEN                                                02529000          
         BEGIN                                                          02530000          
         SWITCHIT(DEBUGBIT);                                            02531000          
         IF DEBUGTOG THEN                                               02533000          
              IF WOP[0]=0 THEN                                          02534000          
                   BEGIN                                                02535000          
                   FILL WOP[*] WITH                                     02536000          
         "LITC","    ",                                                 02537000          
         "OPDC","DESC",                                                 02538000          
 11, "NOP ", 12, "PRT ", 13, "DEL ", 16, "ADD ", 18, "PRL ", 19, "LNG ",02539000          
 21, "GEQ ", 22, "BBC ", 24, "INX ", 35, "LOR ", 37, "GTR ", 38, "BFC ",02540000          
 39, "RTN ", 40, "COC ", 48, "SUB ", 64, "MUL ", 67, "LND ", 68, "STD ",02541000          
 69, "NEQ ", 71, "XIT ", 72, "MKS ",128, "DIV ",130, "COM ",131, "LQV ",02542000          
132, "SND ",133, "XCH ",134, "CHS ",167, "RTS ",168, "CDC ",260, "LOD ",02543000          
261, "DUP ",278, "LBC ",294,"LFC ",322,"ZP1 ",384, "IDV ",532, "ISD ",  02544000          
533, "LEQ ",534, "BBW ",548, "ISN ",549, "LSS ",550, "BFW ",581, "EQL ",02545000          
582, "SSP ",790, "LBU ",806, "LFU ",896, "RDV ",                        02546000          
1003,"SCI ",1004,"SAN ",1019,"SCS ",                                    02547000          
 1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 02548000          
         1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023;  02549000          
                   FILL COP[*] WITH  % CHARACTER MODE MNEMONICS         02550000          
  0,"   ",0,0,                                                          02551000          
  0,"EXC ", 2,"BSD ", 3,"BSS ", 4,"RDA ", 5,"TRW ",6,"SED ", 7,"TDA ",  02552000          
 12,"SDA ",13,"SSA ",14,"SFD ",15,"SRD ",18,"SES ",20,"TEQ ",21, "TNE ",02553000          
 22,"TEG ",23,"TGR ",24,"SRS ",25,"SFS ",28,"TEL ",29,"TLS ",30,"TAN ", 02554000          
 31,"BIT ",32,"INC ",33,"STC ",34,"SEC ",35,"CRF ",36,"JNC ",37,"JFC ", 02555000          
 38,"JNS ",39,"JFW ",40,"RCA ",41,"ENS ",42,"BNS ",43,"RSA ",44,"SCA ", 02556000          
 45,"JRC ",46,"TSA ",47,"JRV ",48,"CEQ ",49,"CNE ",50,"CEG ",51,"CGR ", 02557000          
52,"BIT ",53,"BIR ",54,"OCV ",55,"ICV ",56,"CEL ",57,"CLS ",58,"FSU ",  02558000          
 59,"FAD ",60,"TRP ",61,"TRN ",62,"TRZ ",63,"TRS ",64,0,64,0,64,0,64,0, 02559000          
 64,0,64,0,64,0,64,0;                                                   02560000          
                   END;                                                 02563000          
         GO AGAIN;                                                      02564000          
         END;                                                           02565000          
    IF Q = "6FORMA" THEN                                                02566000          
         BEGIN SWITCHIT(FORMATBIT); GO AGAIN; END;                      02567000          
    GO WHATISIT;                                                        02568000          
LENGTH7:                                                                02569000          
%   IF Q = "7INCLU" THEN                                                02570000          
%        BEGIN DOLLARCARD:=STARTINCLUDING;  GO EXIT;  END;              02571000          
%   IF Q = "7INCLN" THEN                                                02572000          
%        BEGIN SWITCHIT(NEWINCLBIT);  GO AGAIN; END;                    02573000          
LENGTH8: % NO OPTIONS OF THIS LENGTH ARE CURRENTLY IMPLEMENTED.         02574000          
LENGTH9:                                                                02575000          
    IF Q = "9INTRI" THEN                                                02576000          
         BEGIN                                                          02576500          
         INTOG:=XMODE!2 AND XMODE! 4 OR INTOG; % NEVER RESET.           02577000          
         GO SKANAGAIN;                                                  02577250          
         END;                                                           02577500          
WHATISIT:                                                               02578000          
    IF RESULT=3 THEN                                                    02579000          
        BEGIN                                                           02580000          
        BASENUM:=CONV(ACCUM[1],0,ACCUM[1].[12:6]);                      02581000          
        TOTALNO:=-10;                                                   02582000          
        NEWBASE:=TRUE;                                                  02583000          
        GO SKANAGAIN;                                                   02584000          
        END;                                                            02585000          
    IF RESULT=2 THEN                                                    02586000          
         BEGIN                                                          02587000          
         IF Q = "1+0000" THEN                                           02588000          
              BEGIN                                                     02589000          
              SKAN;                                                     02590000          
              IF RESULT=3 THEN                                          02591000          
               ADDVALUE:=CONV(ACCUM[1],0,ACCUM[1].[12:6])               02592000          
          ELSE FLAG(600); % NUMBER EXPECTED.                            02593000          
              END;                                                      02594000          
         GO SKANAGAIN;                                                  02595000          
         END;                                                           02596000          
COMMENT  DID NOT RECOGNIZE OPTION;                                      02597000          
    IF RESULT!1 THEN % NOT AN IDENTIFIER.                               02598000          
         BEGIN FLAG(601); GO SKANAGAIN END;                             02599000          
    SWITCHIT(USEROPINX); % USEROPINX MEANS A USER-DEFINED OPTION.       02600000          
    GO AGAIN;                                                           02601000          
 EXIT:                                                                  02602000          
    LISTER:=DEBUGTOG OR LISTOG OR LISTATOG;                             02602500          
    MOVE(10,DEFINEARRAY[0],ACCUM[0]); % RESTORE INFORMATION FOR         02602600          
    COUNT:=SCOUNT; RESULT:=SRESULT;   % "TABLE" TO RESUME SCAN.         02602700          
    RESTORESEQNUM(LCR,INFO[LASTSEQROW,LASTSEQUENCE]); % FOR VOID TESTS  02602800          
    DOLLARTOG:=FALSE;                                                   02603000          
    END DOLLARCARD;                                                     02604000          
COMMENT  TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER            02605000          
       USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY.        02606000          
       THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED.            02607000          
       TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY        02608000          
       ELBAT.  ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR             02609000          
       COMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD.  NXTELBT       02610000          
       IS ALMOST EXCLUSIVELY USED BY TABLE, ALTHOUGH AN OCCASION-       02611000          
       AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS       02612000          
       SCANNED.  (SEE, FOR EXAMPLE, COMPOUNDTAIL). FOR FURTHER          02613000          
       GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES.       02614000          
         THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY            02615000          
       DESIRED (USUALLY I-1,I, OR I+1).                                 02616000          
         THE GENERAL PLAN OF TABLE IS THIS:                             02617000          
           I) IF P < NXTELBAT GO ON TO III).                            02618000          
          II) PROCESS ONE QUANTITY.                                     02619000          
            A) SCAN.                                                    02620000          
            B) TEST FOR IDENTIFIER, NUMBER, OR SPECIAL CHARACTER.       02621000          
             1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS            02622000          
                  IN SPECIAL MANNER IF COMMENT OR DEFINED ID.           02623000          
             2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART,         02624000          
                  AND EXPONENT PART.                                    02625000          
             3) TEST IF SPECIAL CHARACTER REQUIRES SPECIAL              02626000          
                  PROCESSING - OTHERWISE GET ELBAT WORD FROM            02627000          
                  SPECIAL.                                              02628000          
            C) LOAD ELBAT AND INCREMENT NXTELBT.                        02629000          
            D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P.        02630000          
            E) GO BACK TO I).                                           02631000          
         III) RETURN WITH CLASS OF ELBAT[P].                            02632000          
       FURTHER DETAILS ARE GIVEN IN BODY OF TABLE.                      02633000          
 ;                                                                      02634000          
INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P;                         02635000          
    BEGIN                                                               02636000          
    LABEL PERCENT,SPECIALCHAR,COMPLETE,COLON,DOT,ATSIGN,QUOTE,          02637000          
          STRNGXT,MOVEIT,ARGH,FINISHNUMBER,                             02638000          
          SCANAGAIN,FPART,EPART,IPART,IDENT,ROSE,COMPOST,DOLLAR,RTPAREN,02639000          
          CROSSHATCH,NUMBEREND;                                         02640000          
    SWITCH SPECIALSWITCH:=PERCENT,DOLLAR,DOT,ATSIGN,COLON,QUOTE,        02641000          
                            RTPAREN,CROSSHATCH;                         02642000          
    SWITCH RESULTSWITCH:=IDENT,SPECIALCHAR,IPART;                       02643000          
    WHILE P } NXTELBT                                                   02644000          
    DO   BEGIN                                                          02645000          
SCANAGAIN:                                                              02646000          
         COUNT:=RESULT:=ACCUM[1]:=0; SCANNER;                           02647000          
         GO RESULTSWITCH[RESULT];                                       02648000          
ARGH:                                                                   02649000          
         Q:=ACCUM[1]; FLAG(141); GO SCANAGAIN;                          02650000          
SPECIALCHAR:                                                            02651000          
         GT1:=ACCUM[1].[18:6] - 2;                                      02652000          
         ENDTOG:=GT1 = 57 AND ENDTOG;                                   02653000          
COMMENT  OBTAIN ACTUAL CHARACTER FROM ACCUM;                            02654000          
         T:=SPECIAL[GT1&GT1[42:41:3]];                                  02655000          
COMMENT  NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF          02656000          
         ELBAT WORDS FOR SPECIAL CHARACTERS;                            02657000          
         IF GT1:=T.INCR = 0 THEN GO COMPLETE;                           02658000          
         GO SPECIALSWITCH[GT1];                                         02659000          
COMMENT  INCR FIELD OF SPECIAL CHARACTER IS NON-ZERO FOR SPECIAL        02660000          
         CHARACTERS REQUIRING SPECIAL HANDLING.  INCR IS SWITCHED       02661000          
         ON TO OBTAIN DISCRIMINATION;                                   02662000          
COLON:   RESULT:=7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING        02663000          
                                       FOR := IN PLACE OF ~ ;           02664000          
         IF EXAMIN (NCR) = "=" THEN                                     02665000          
              BEGIN RESULT:=0; SCANNER; T:=SPECIAL[13]  END;            02666000          
         RESULT:=2; GO COMPLETE;                                        02667000          
DOT:                                                                    02668000          
         IF EXAMIN(NCR)>9 OR ENDTOG THEN GO COMPLETE;                   02680000          
         NHI:=NLO:=0;                                                   02681000          
         C:=0; GO FPART;                                                02682000          
ATSIGN:                                                                 02683000          
         RESULT:=0; SCANNER;        % SCAN PAST "@".                    02684000          
         IF COUNT>17 THEN GO ARGH;  % 16 CHARS, + "@".                  02685000          
         IF OCTIZE(ACCUM[1],C,17-COUNT,COUNT-1) THEN                    02686000          
              BEGIN  Q:=ACCUM[1]; FLAG(521); GO SCANAGAIN  END;         02686500          
         GO NUMBEREND;                                                  02687000          
COMMENT  DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT;        02689000          
QUOTE:                                                                  02690000          
         COUNT:=0;                                                      02691000          
         T:=IF STREAMTOG THEN 63                                        02692000          
    ELSE IF REAL(STREAMTOG)>1 THEN 8 ELSE 7;                            02692500          
         DO   BEGIN                                                     02693000          
              RESULT:=5; SCANNER;                                       02694000          
              IF COUNT>T THEN                                           02695000          
                   BEGIN  Q:=ACCUM[1]; FLAG(520); GO SCANAGAIN  END;    02696000          
              END UNTIL EXAMIN(NCR) = """;                              02697000          
         Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1;               02698000          
         IF COUNT<0 THEN COUNT:=COUNT+64;                               02699000          
         ACCUM[1]:=Q; RESULT:=4;                                        02700000          
STRNGXT: T:=C:=0;                                                       02701000          
         IF COUNT < 8 THEN                                              02703000          
MOVEIT:                                                                 02704000          
         MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT);                    02705000          
         T.CLASS:=STRNGCON;                                             02705100          
         GO COMPLETE;                                                   02705200          
COMMENT  CROSSHATCH HANDLES TWO SITUATIONS:                             02707000          
         THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND               02708000          
         THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS.       02709000          
         THE TWO CASES ARE PROCESSED DIFFERENTLY.  THE FIRST CASE       02710000          
         MERELY PLACES THE CROSSHATCH IN ELBAT.  THE SECOND CASE        02711000          
         CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID.     02712000          
         FOR A FULL DISCUSSION SEE DEFINEGEN;                           02713000          
CROSSHATCH:                                                             02714000          
         IF DEFINECTR!0 THEN GO COMPLETE;                               02715000          
         PUTSEQNO(GT1,LCR);                                             02716000          
         TURNONSTOPLIGHT(0,LCR);                                        02717000          
         IF DEFINEINDEX = 0 THEN GO ARGH;                               02718000          
         LCR:=(GT1:=DEFINEARRAY[DEFINEINDEX-1]) DIV 262144;             02719000          
         NCR:=GT1 MOD 262144;                                           02720000          
         GT2:=0&(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3])[33:18:15]; 02721000          
         LASTUSED:=T.[33:15];                                           02722000          
         FOR GT1:=1 STEP 1 UNTIL GT2 DO                                 02723000          
              BEGIN                                                     02723500          
              STACKHEAD[(T:=TAKE(LASTINFO+1)).[12:36] MOD 125]:=        02724000          
                         TAKE(LASTINFO).LINK;                           02725000          
              LASTINFO:=(NEXTINFO:=LASTINFO)-T.PURPT;                   02726000          
              END;                                                      02727000          
         GO SCANAGAIN;                                                  02728000          
DOLLAR:  COMMENT THIS CODE HANDLES CONTROL CARDS;                       02729000          
         DOLLARCARD;                                                    02730000          
PERCENT: IF NCR ! FCR THEN READACARD;                                   02731000          
         GO SCANAGAIN;                                                  02737000          
COMMENT  MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO      02738000          
         PERCENT.  PERCENT READS THE NEXT CARD AND STARTS OVER.  A      02739000          
         SIDE EFFECT IS THAT ALL CHARACTERS ON A CARD ARE IGNORED       02740000          
         AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR     02741000          
         COMMENT);                                                      02742000          
COMMENT  MIGHT BE FUNNY COMMA - HANDLE HERE;                            02743000          
RTPAREN: RESULT:=7; SCANNER;                                            02744000          
         IF EXAMIN(NCR) = """ THEN                                      02745000          
              BEGIN                                                     02746000          
              RESULT:=0; SCANNER;                                       02747000          
              DO   BEGIN                                                02748000          
                   RESULT:=5; SCANNER                                   02749000          
                   END UNTIL EXAMIN(NCR) = """;                         02750000          
              RESULT:=0; SCANNER;                                       02751000          
              RESULT:=7; SCANNER;                                       02752000          
              IF EXAMIN(NCR) ! "(" THEN GO ARGH;                        02753000          
              RESULT:=0; SCANNER;  Q:=ACCUM[1];                         02754000          
              T:=SPECIAL[24]                                            02755000          
              END;                                                      02756000          
         RESULT:=2; GO COMPLETE;                                        02757000          
IPART:   TCOUNT:=0; C:=CONVERT;                                         02758000          
%        RESULT:=7; SCANNER; % DEBLANK.                                 02759000          
%        IF DEFINECTR=0 THEN                                            02760000          
%         IF (C=3 OR C=4) AND EXAMIN(NCR)=""" THEN %OCTAL OR HEX STRING.02761000          
%             BEGIN    INTEGER SIZ;                                     02762000          
%             RESULT:=5; SCANNER; % SKIP QUOTE.                         02763000          
%             COUNT:=0;                                                 02764000          
%             DO   BEGIN                                                02765000          
%                  RESULT:=5; SCANNER;                                  02766000          
%                  IF COUNT > SIZ:=48 DIV C THEN % > 1 WORD LONG.       02767000          
%                       BEGIN  ERR(520); GO SCANAGAIN  END;             02768000          
%                  END UNTIL EXAMIN(NCR)=""";                           02769000          
%             Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1;          02770000          
%             IF C=3 THEN % OCTAL STRING.                               02771000          
%               IF OCTIZE(ACCUM[1],ACCUM[4],16-COUNT,COUNT) THEN        02772000          
%                 FLAG(521) % NON OCTAL CHARACTER IN STRING.            02773000          
%        ELSE ELSE IF HEXIZE(ACCUM[1],ACCUM[4],12-COUNT,COUNT) THEN     02774000          
%                  FLAG(521); % NON CHARACTER IN HEX STRING.            02775000          
%             IF COUNT < SIZ THEN                                       02776000          
%                  BEGIN                                                02777000          
%                  C:=ACCUM[4]; GO FINISHNUMBER;                        02778000          
%                  END;                                                 02779000          
%             T.INCR:=COUNT:=8; T.CLASS:=STRING;                        02780000          
%             MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3);                  02781000          
%             GO COMPLETE;                                              02782000          
%             END OCTAL OR HEX STRING;                                  02783000          
         IF DPTOG THEN                                                  02784000          
              BEGIN NHI:=THI; NLO:=TLO; END;                            02785000          
         IF EXAMIN(NCR)="." THEN                                        02786000          
              BEGIN                                                     02787000          
              RESULT:=0; SCANNER;                                       02788000          
              C:=1.0| C;                                                02789000          
FPART:        TCOUNT:=COUNT;                                            02790000          
              IF EXAMIN(NCR){9 THEN                                     02791000          
                   BEGIN                                                02792000          
                   RESULT:=0; SCANNER;                                  02793000          
                   IF DPTOG THEN                                        02794000          
                        BEGIN                                           02795000          
                        DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12],   02796000          
                                        0,/,:=,THI,TLO);                02797000          
                        FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO       02798000          
                          DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO);       02799000          
                        DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO);           02800000          
                        C:=NHI                                          02801000          
                        END                                             02802000          
                   ELSE C:=TEN[TCOUNT-COUNT]|CONVERT+C;                 02803000          
                   END                                                  02804000          
              END;                                                      02805000          
         RESULT:=7; SCANNER;                                            02806000          
         IF EXAMIN(NCR)="@" THEN                                        02807000          
              BEGIN                                                     02808000          
              RESULT:=0; SCANNER;                                       02809000          
EPART:        TCOUNT:=COUNT;                                            02810000          
              C:=C|1.0;                                                 02811000          
              RESULT:=7; SCANNER;                                       02812000          
              IF T:=EXAMIN(NCR)>9 THEN                                  02813000          
                   BEGIN                                                02815000          
                   RESULT:=0; SCANNER;                                  02816000          
                   TCOUNT:=COUNT;                                       02817000          
                   END;                                                 02818000          
              RESULT:=0; SCANNER;                                       02820000          
              Q:=ACCUM[1];                                              02822000          
              IF GT1:=T:=(IF T="-"THEN -CONVERT ELSE CONVERT)<-46 OR    02823000          
                T>69 THEN FLAG(269)                                     02824000          
              ELSE BEGIN                                                02825000          
                   T:=TEN[T];                                           02826000          
                   IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]&T[1:2:1]     02827000          
                     + 12) >63 THEN FLAG(269)                           02828000          
              ELSE IF DPTOG THEN                                        02829000          
                     IF GT1<0 THEN                                      02830000          
                        BEGIN                                           02831000          
                        GT1:=-GT1;                                      02832000          
                        DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000          
                        FOR GT2:=12 STEP 12 UNTIL GT1 DO                02834000          
                          DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO);       02835000          
                        END                                             02836000          
                   ELSE BEGIN                                           02837000          
                        DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,:=,NHI,NLO); 02838000          
                        FOR GT2:=12 STEP 12 UNTIL GT1 DO                02839000          
                          DOUBLE( NHI,NLO,TEN[12],0,|,:=,NHI,NLO);      02840000          
                        END                                             02841000          
              ELSE C:=C|T;                                              02842000          
                   END;                                                 02843000          
              END;                                                      02844000          
NUMBEREND:                                                              02845000          
         Q:=ACCUM[1]; RESULT:=3;                                        02846000          
FINISHNUMBER:                                                           02847000          
         T:=0;                                                          02848000          
         IF C.[1:37]=0 THEN                                             02849000          
              BEGIN   T.CLASS:=LITNO ; T.ADDRESS:=C  END                02850000          
         ELSE T.CLASS:=NONLITNO ;                                       02851000          
         GO COMPLETE;                                                   02852000          
COMMENT  THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO.      02853000          
         IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE          02854000          
         ZERO.  THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING       02855000          
         TO BE DONE. THEN THE LOOP BETWEEN COMPOST AND                  02859000          
         ROSE IS ENTERED.  THE LAST THING DONE FOR ANY                  02860000          
         IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION             02861000          
         OF THE ELBATWORD IN INFO INTO THE LINK FIELD.  THIS            02862000          
         ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA,             02863000          
         SHOULD THIS BE REQUIRED.                           ;           02864000          
IDENT:   T:=STACKHEAD[SCRAM:=(Q:=ACCUM[1])MOD 125];                     02865000          
ROSE:    GT1:=T.LINKR;                                                  02875000          
         IF(GT2:=T.LINKC)+GT1= 0 THEN                                   02876000          
              BEGIN T:=0; GO COMPLETE END;                              02877000          
       IF T = INFO[GT1, GT2] THEN BEGIN                                 02877010          
           T:=0; GO TO COMPLETE END;                                    02877020          
         T:=INFO[GT1,GT2];                                              02878000          
         IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO ROSE;                 02879000          
         IF COUNT { 5 THEN GO COMPOST ;                                 02880000          
         IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE;    02881000          
COMPOST: T:=T&GT1[35:43:5]&GT2[40:40:8];                                02882000          
COMMENT  CHECK HERE FOR COMMENTS AND DEFINED IDS;                       02883000          
         IF NOT ENDTOG THEN                                             02884000          
              BEGIN                                                     02885000          
              IF GT1:=T.CLASS = COMMENTV THEN                           02886000          
                   BEGIN                                                02887000          
                   WHILE EXAMIN(NCR) ! ";" DO                           02888000          
                        BEGIN RESULT:=6; COUNT:=0; SCANNER END;         02889000          
                   RESULT:=0;SCANNER;GO SCANAGAIN                       02890000          
                   END                                                  02891000          
              END;                                                      02892000          
         IF STOPDEFINE THEN GO COMPLETE;                                02893000          
         IF GT1 ! DEFINEDID THEN GO COMPLETE;                           02894000          
COMMENT  SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS;        02895000          
         IF T.ADDRESS!0 THEN T:=FIXDEFINEINFO(T);                       02896000          
         IF DEFINEINDEX = 24 THEN                                       02898000          
              BEGIN FLAG(139);GO ARGH END;                              02899000          
         DEFINEARRAY[DEFINEINDEX]:=LASTUSED&T.ADDRESS [18:33:15];       02900000          
         LASTUSED:=GIT(T);                                              02901000          
         DEFINEARRAY[DEFINEINDEX+2]:=262144|LCR+NCR;                    02902000          
         LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1;               02903000          
         PUTSEQNO(GT4,LCR);                                             02904000          
         TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3;          02905000          
         GO PERCENT;                                                    02906000          
COMPLETE:                                                               02909000          
         ELBAT[NXTELBT]:=T;                                             02910000          
         STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN;                02911000          
         IF NXTELBT:=NXTELBT+1 > 74 THEN                                02912000          
           IF NOT MACROID THEN                                          02913000          
              BEGIN                                                     02914000          
COMMENT  ELBAT IS FULL:  ADJUST IT;                                     02915000          
              MOVE(10,ELBAT[65],ELBAT);                                 02916000          
              I:=I-65; P:=P-65; NXTELBT:=10;                            02917000          
              END                                                       02918000          
         END;                                                           02919000          
    IF TABLE:=ELBAT[P].CLASS = COMMENTV THEN                            02920000          
         BEGIN                                                          02921000          
COMMENT  SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS;      02922000          
         C:=INFO[0,ELBAT[P].ADDRESS];                                   02923000          
         ELBAT[P].CLASS:=TABLE:=NONLITNO                                02924000          
         END;                                                           02925000          
    STOPDEFINE:=FALSE;  COMMENT ALLOW DEFINE;                           02926000          
    END TABLE ;                                                         02927000          
    BOOLEAN PROCEDURE BOOLPRIM;       FORWARD;                          02955000          
    PROCEDURE BOOLCOMP(B); BOOLEAN B; FORWARD;                          02955500          
    INTEGER PROCEDURE NEXT;                                             02956000          
         BEGIN                                                          02956500          
         LABEL EXIT;                                                    02957000          
         INTEGER T;                                                     02957500          
         DEFINE ERROR = BEGIN  FLAG(603); GO EXIT  END#;                02958000          
         SKAN;                                                          02958500          
         IF RESULT=3 THEN ERROR; % NUMBERS NOT ALLOWED.                 02959000          
         IF RESULT=2 THEN % SPECIAL CHARACTER.                          02959500          
              BEGIN                                                     02960000          
              T:=IF Q="1,0000" OR Q="1%0000" THEN 20 % FAKE OUT BOOLEXP.02960500          
                 ELSE ((T:=Q.[18:6]-2) & T[42:41:3]);                   02961000          
              IF T=11 OR T=19 OR T=20 THEN BATMAN:=SPECIAL[T] % (,),OR ;02961500          
         ELSE FLAG(603);                                                02962000          
              GO EXIT                                                   02962500          
              END SPECIAL CHARACTERS;                                   02963000          
COMMENT  LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS;                      02963500          
         T:=     IF Q="3NOT00" THEN NOTOP                               02964000          
            ELSE IF Q="3AND00" THEN ANDOP                               02964500          
            ELSE IF Q="2OR000" THEN OROP                                02965000          
            ELSE IF Q="3EQV00" THEN EQVOP                               02965500          
            ELSE 0;                                                     02966000          
         IF T!0 THEN BATMAN.CLASS:=T                                    02966500          
    ELSE BATMAN:=1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION.   02967000          
EXIT:                                                                   02967500          
         NEXT:=MYCLASS:=BATMAN.CLASS;                                   02968000          
    END NEXT;                                                           02968500          
    BOOLEAN PROCEDURE BOOLEXP;                                          02969000          
         BEGIN                                                          02969500          
         BOOLEAN B;                                                     02970000          
         B:=BOOLPRIM;                                                   02970500          
         WHILE MYCLASS}EQVOP AND MYCLASS{ANDOP DO BOOLCOMP(B);          02971000          
         BOOLEXP:=B                                                     02971500          
         END BOOLEXP;                                                   02972000          
    BOOLEAN PROCEDURE BOOLPRIM;                                         02972500          
         BEGIN                                                          02973000          
         BOOLEAN B,KNOT;                                                02973500          
         DEFINE SKIPIT = MYCLASS:=NEXT #;                               02974000          
         IF KNOT:=(NEXT=NOTOP) THEN SKIPIT;                             02974500          
         IF MYCLASS=LEFTPAREN THEN                                      02975000          
              BEGIN                                                     02975500          
              B:=BOOLEXP;                                               02976000          
              IF MYCLASS!RTPAREN THEN FLAG(604);                        02976500          
              END                                                       02977000          
    ELSE IF MYCLASS!BOOID THEN FLAG(601)                                02977500          
    ELSE B:=BATMAN<0;                                                   02978000          
         IF KNOT THEN B:=NOT B; SKIPIT;                                 02978500          
         BOOLPRIM:=B                                                    02979000          
         END BOOLPRIM;                                                  02979500          
    PROCEDURE BOOLCOMP(B); BOOLEAN B;                                   02980000          
         BEGIN                                                          02980500          
         REAL OPCLASS;                                                  02981000          
         BOOLEAN T;                                                     02981500          
         OPCLASS:=MYCLASS;                                              02982000          
         T:=BOOLPRIM;                                                   02982500          
         WHILE OPCLASS<MYCLASS DO BOOLCOMP(T);                          02983000          
         B:=     IF OPCLASS=ANDOP THEN (B AND T)                        02983500          
            ELSE IF OPCLASS=OROP  THEN (B OR T)                         02984000          
            ELSE                       (B EQV T);                       02984500          
         END BOOLCOMP;                                                  02985000          
%                                                                       02985500          
COMMENT#################################################################02986000          
              FORWARD DECLARATIONS                                      02986500          
#######################################################################;02987000          
%                                                                       02987500          
 PROCEDURE AEXP; FORWARD;                                               03001000          
 PROCEDURE ARITHSEC; FORWARD;                                           03002000          
 PROCEDURE SIMPARITH; FORWARD;                                          03003000          
 PROCEDURE ARITHCOMP; FORWARD;                                          03004000          
 PROCEDURE PRIMARY; FORWARD;                                            03005000          
 DEFINE BEXP = AEXP#;                                                   03006000          
 INTEGER PROCEDURE EXPRSS; FORWARD;                                     03007000          
 PROCEDURE POLISHER(EXPECT); VALUE EXPECT; REAL EXPECT; FORWARD;        03009000          
 PROCEDURE INLINE; FORWARD;                                             03010000          
 PROCEDURE SUBHAND(FROM); VALUE FROM; BOOLEAN FROM; FORWARD;            03011000          
 PROCEDURE IOSTMT; FORWARD;                                             03012000          
 INTEGER PROCEDURE IFEXP; FORWARD;                                      03013000          
 PROCEDURE PARSE; FORWARD;                                              03014000          
 PROCEDURE DOT; FORWARD;                                                03015000          
 PROCEDURE  IFCLAUSE; FORWARD;                                          03018000          
INTEGER PROCEDURE GET(SYLLABLE);VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03019000          
INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; FORWARD;                    03020000          
 PROCEDURE PANA; FORWARD;                                               03021000          
 PROCEDURE IFSTMT; FORWARD;                                             03022000          
 PROCEDURE GOGEN(LABELBAT,BRANCHTYPE);                                  03023000          
              VALUE LABELBAT,BRANCHTYPE;                                03024000          
              REAL LABELBAT,BRANCHTYPE; FORWARD;                        03025000          
 BOOLEAN PROCEDURE SIMPGO; FORWARD;                                     03026000          
 PROCEDURE STMT; FORWARD;                                               03027000          
 PROCEDURE EMIT(SYLLABLE); VALUE SYLLABLE; REAL SYLLABLE; FORWARD;      03028000          
 PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; FORWARD;           03029000          
 PROCEDURE STRMPROCSTMT; FORWARD;                                       03030000          
 PROCEDURE CONSTANTCLEAN; FORWARD;                                      03034000          
 PROCEDURE SCATTERELBAT; FORWARD;                                       03035000          
 PROCEDURE EMITB(BRANCH,FROM,TOWARDS); VALUE BRANCH,FROM,TOWARDS;       03036000          
              INTEGER BRANCH,FROM,TOWARDS; FORWARD;                     03037000          
 PROCEDURE VARIABLE(FROM); INTEGER FROM; FORWARD;                       03038000          
 PROCEDURE IMPFUN; FORWARD;                                             03039000          
PROCEDURE RIGHT(L); VALUE L; INTEGER L; FORWARD;                        03039500          
 PROCEDURE STREAMSTMT; FORWARD;                                         03040000          
PROCEDURE SEGMENTSTART(B);VALUE B;BOOLEAN B;FORWARD;                    03041000          
PROCEDURE SEGMENT(SIZE,FR); VALUE SIZE,FR; INTEGER SIZE,FR; FORWARD;    03042000          
                                                                        03043000          
                                                                        03044000          
                                                                        03045000          
INTEGER PROCEDURE BAE; FORWARD;                                         03046000          
     PROCEDURE PROGDESCBLDR(A,B,C,D);VALUE A,B,C,D;                     03047000          
                    INTEGER A,C,D; BOOLEAN B; FORWARD;                  03047100          
 PROCEDURE BANA; FORWARD;                                               03048000          
 PROCEDURE EMITNUM(A); VALUE A; REAL A; FORWARD;                        03049000          
 PROCEDURE EMITD(A,B,T); VALUE A,B,T; INTEGER A,B,T; FORWARD;           03050000          
INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L;                             03051000          
                                 INTEGER L; BOOLEAN S; FORWARD;         03051001          
 PROCEDURE FORSTMT; FORWARD;                                            03052000          
REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; FORWARD;        03053000          
PROCEDURE E;  FORWARD;                                                  03054000          
PROCEDURE ENTRY(TYPE); VALUE TYPE;REAL TYPE; FORWARD;                   03055000          
PROCEDURE PUTNBUMP(P1);  VALUE P1;  REAL P1;  FORWARD;                  03057000          
PROCEDURE JUMPCHKNX;  FORWARD;                                          03058000          
PROCEDURE JUMPCHKX;  FORWARD;                                           03059000          
 PROCEDURE DBLSTMT; FORWARD;                                            03060000          
 PROCEDURE BLOCK(S); VALUE S; BOOLEAN S; FORWARD;                       03067000          
PROCEDURE PURGE(STOPPER);VALUE STOPPER;REAL STOPPER;FORWARD;            03068000          
PROCEDURE ENTER(TYPEV);                                                 03069000          
          VALUE TYPEV;                                                  03070000          
REAL TYPEV;FORWARD;                                                     03071000          
                                                                        03072000          
                                                                        03073000          
                                                                        03074000          
                                                                        03075000          
 COMMENT THIS SECTION CONTAINS THE EMITTERS.  THEY ARE THE AGENTS WHICH 04000000          
              ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT;                04001000          
 COMMENT EMITL EMITS A LIT CALL;                                        04002000          
 PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL;              04003000          
              EMIT(0&LITERAL[36:38:10]);                                04004000          
 COMMENT EMITO EMIT AN OPERATOR;                                        04005000          
 PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR;           04006000          
              EMIT(1&OPERATOR[36:38:10]);                               04007000          
 COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTOR MODE  04008000          
              OPERATORS.  HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB;    04009000          
PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR;                04010000          
              INTEGER REPEAT,OPERATOR;                                  04011000          
              BEGIN                                                     04012000          
                IF REPEAT}64 THEN FLAG(268);                            04013000          
                EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC;               04014000          
 COMMENT EMITV EMITS AN OPERAND CALL.  IF THE ADDRESS IS FOR THE SECOND 04015000          
              HALF OF THE PRT, THEN IT ALSO EMITS A PRTE;               04016000          
 PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS;              04017000          
              BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE);                 04018000          
                   EMIT(2 & ADDRESS [36:38:10]) END EMITV;              04019000          
 COMMENT EMITN EMITS A DESCRIPTOR CALL.  IF THE ADDRESS IS FOR THE      04020000          
              SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE;        04021000          
 PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS;              04022000          
              BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE);                 04023000          
                   EMIT(3 & ADDRESS [36:38:10]) END EMITN;              04024000          
 COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR.  IF THE    04025000          
              ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO   04026000          
              EMITS PRTE;                                               04027000          
 PROCEDURE EMITPAIR(ADDRESS,OPERATOR);                                  04028000          
              VALUE ADDRESS,OPERATOR;                                   04029000          
              INTEGER ADDRESS,OPERATOR;                                 04030000          
              BEGIN                                                     04031000          
                   EMITL(ADDRESS);                                      04032000          
                   IF ADDRESS > 1023 THEN EMITO(PRTE);                  04033000          
                   EMITO(OPERATOR) END EMITPAIR;                        04034000          
 COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE     04080000          
              INERVENING SPACE WITH NOPS. IT CHECKS STREAMTOG TO DECIDE 04081000          
              WHICH SORT OF NOP TO USE;                                 04082000          
 PROCEDURE ADJUST;                                                      04083000          
              BEGIN                                                     04084000          
                                                                        04085000          
WHILE L.[46:2]!0 DO EMIT(45);                                           04086000          
              END ADJUST;                                               04087000          
 PROCEDURE EMITLNG;                                                     04098000          
              BEGIN LABEL E;                                            04099000          
                IF NOT LINKTOG THEN GO TO E;                            04100000          
    COMMENT  GO TO E IF LAST THING IS A LINK;                           04101000          
                IF GET(L) ! 0 THEN GO TO E;                             04102000          
    COMMENT  EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO      04103000          
             LNG OR RELATIONAL OPERATOR;                                04104000          
                IF GT1 ~ GET(L-1) = 77 THEN L ~ L-1                     04105000          
    COMMENT LAST THING WAS AN LNG - SO CANCEL IT;                       04106000          
         ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA              04107000          
    COMMENT LAST THING WAS A RELATIONAL;                                04108000          
                   BEGIN L~L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV     04109000          
                      BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463)))    04110000          
    COMMENT NEGATE THE RELATIONAL; END ELSE                             04111000          
  E:          EMITO(LNG) END EMITLNG;                                   04112000          
    COMMENT   EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER;  04113000          
 PROCEDURE EMITB(BRANCH,FROM,TOWARDS);                                  04114000          
              VALUE BRANCH,FROM,TOWARDS;                                04115000          
              INTEGER BRANCH,FROM,TOWARDS;                              04116000          
              BEGIN                                                     04117000          
                INTEGER TL;                                             04118000          
                TL ~ L;                                                 04119000          
              IF TOWARDS > FOULED THEN FOULED ~ TOWARDS;                04119500          
                L ~ FROM-2;                                             04120000          
                GT1 ~ TOWARDS-FROM;                                     04120100          
                IF TOWARDS.[46:2] = 0                                   04120200          
                  THEN BEGIN                                            04120300          
                   BRANCH ~ BRANCH&1[39:47:1];                          04120400          
                   GT1 ~ TOWARDS DIV 4 - (FROM-1) DIV 4 END;            04120500          
                EMITNUM(ABS(GT1));                                      04121000          
                EMITO(BRANCH&(REAL(GT1} 0)+1)[42:46:2]);                04122000          
                                                                        04123000          
                L ~ TL                                                  04124000          
              END EMITB;                                                04125000          
    COMMENT   DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN      04126000          
              OCTAL, NAMELY :                                           04127000          
                   1. 4 CHARACTERS FOR THE L REGISTER.                  04128000          
                   2.16 CHARACTERS FOR THE WORD BEING EMITTED.   ;      04129000          
 STREAM  PROCEDURE DEBUGWORD( SEQ,CODE,FEIL); VALUE SEQ,CODE ;          04130000          
                   BEGIN                                                04131000          
                     DI~FEIL; SI~ LOC SEQ; SI~ SI+4; DS ~ 4 CHR;        04132000          
                     DS ~ 2 LIT"  ";                                    04133000          
                     SI ~ LOC CODE ;                                    04134000          
                     16(  DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE       04135000          
                          DS ~ RESET ; SKIP 1 SB));                     04136000          
                  29(DS ~ 2 LIT"  " );                                  04137000          
                   END ;                                                04138000          
    COMMENT   EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF        04139000          
              DEBUGGING IS REQUIRED, "L" AND "WORD" ARE OUTPUT ON       04140000          
              THE  PRINTER FILE IN OCTAL FORMAT.     ;                  04141000          
 PROCEDURE  EMITWORD (WORD); VALUE WORD; REAL WORD;                     04142000          
              BEGIN                                                     04143000          
              ADJUST;                                                   04144000          
              IF L} 4088 THEN BEGIN ERR(200); L~0; END                  04145000          
                   ELSE BEGIN                                           04146000          
         MOVE(1,WORD, CODE(L DIV 4+1));                                 04147000          
                   IF DEBUGTOG THEN                                     04148000          
                   BEGIN DEBUGWORD(B2D(L),WORD,LIN);                    04149000          
                        WRITELINE  END;                                 04150000          
                   FOULED ~ L ~ L+4; END                                04151000          
              END  EMITWORD;                                            04152000          
    COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS   04153000          
              BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY   04154000          
              EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX  THE CHAIN   04155000          
              OF  C-RELATIVE  OPDC S LEFT BY EMITNUM. IF  C-RELATIVE    04156000          
              ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS                04157000          
              IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH   04158000          
              THE  1ST  LINK OF THE OPDC CHAIN IS ENTERED IN INFO.      04159000          
              AT  PURGE  TIME THE REMAINING OPDC S ARE EMITTED WITH     04160000          
              F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE      04161000          
              CONSTANTS INTO THE PROPER F-RELATIVE CELLS.  ;            04162000          
 PROCEDURE CONSTANTCLEAN ;                                              04163000          
              IF MRCLEAN THEN                                           04164000          
                BEGIN                                                   04165000          
                   INTEGER J,TEMPL,D,LINK;                              04166000          
                  BOOLEAN CREL;                                         04167000          
                  LABEL  ALLTHU ;                                       04168000          
                                                                        04169000          
                  FOR J ~ 1 STEP 2 UNTIL LASTENTRY DO                   04170000          
                    BEGIN                                               04171000          
                   ADJUST; TEMPL~L; L~INFO[0,255-J+1];                  04172000          
                      CREL ~ FALSE;                                     04173000          
                      DO BEGIN                                          04174000          
                          IF D~(TEMPL-L+3)DIV 4}128 THEN                04175000          
                   IF MODE ! 0 THEN                                     04175500          
       BEGIN  FLAG(50);      GO TO ALLTHU END;                          04176000          
                                                                        04177000          
                                                                        04178000          
                                                                        04179000          
                                                                        04180000          
                                                                        04181000          
                           LINK~GET(L);                                 04182000          
                           CREL ~ TRUE;                                 04183000          
                             IF MODE ! 0 THEN EMITV(D+768) ELSE         04184000          
                             EMITV(REAL(TEMPL}2048)|1024+TEMPL DIV 4);  04184500          
                         END  UNTIL L~   LINK   = 4095  ;               04185000          
         ALLTHU:      L ~ TEMPL;                                        04186000          
                     IF  CREL  THEN  EMITWORD( INFO[0,255-J ]);         04187000          
                    END;                                                04188000          
                  LASTENTRY ~ 0;                                        04189000          
                END ;                                                   04190000          
    COMMENT   EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH   04191000          
                   EXPLICIT AND IMPLICIT. IN EVERY CASE,EMITNUM WILL    04192000          
                   PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF   04193000          
                   THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC  04194000          
                   SYLLABLE IS PRODUCED. HOWEVER,NON-LITERALS ARE KEPT  04195000          
                   IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE         04196000          
                   POSITION,L. THE FIRST EMITNUM ON A PARTICULAR        04197000          
                   CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT     04198000          
                   TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED     04199000          
                   IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN     04200000          
                   ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL      04201000          
                   OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ;     04202000          
 PROCEDURE EMITNUM( C ); VALUE C; REAL C;                               04203000          
              BEGIN LABEL FINISHED,FOUND ; REAL N;                      04204000          
              IF C.[1:37]=0 THEN EMITL(C)                               04205000          
              ELSE                                                      04206000          
                   BEGIN                                                04207000          
                   FOULED ~ L;                                          04207500          
                   FOR  N ~ 1 STEP 2 UNTIL LASTENTRY DO                 04208000          
                IF INFO[0,255-N] = C THEN  GO TO FOUND ;                04209000          
                   INFO[0,255 -LASTENTRY] ~ L;                          04210000          
                   INFO[0,255 -LASTENTRY-1]~ C ;                        04211000          
                   EMITN(1023);                                         04212000          
                   IF MODE=0 THEN EMITO(NOP);                           04212100          
                   LINKTOG~FALSE;                                       04213000          
                   IF LASTENTRY ~ LASTENTRY+2 } 128  THEN               04214000          
                        BEGIN                                           04215000          
                        C ~ BUMPL;                                      04216000          
                        CONSTANTCLEAN;                                  04217000          
                        EMITB(BFW,C,L);                                 04218000          
                        END;                                            04219000          
                   GO TO FINISHED;                                      04220000          
      FOUND:       EMIT(INFO[0,255 -N+1]);                              04221000          
                   LINKTOG~FALSE;                                       04222000          
                   INFO[0,255-N+1]~ L-1;                                04223000          
                   IF MODE=0 THEN EMITO(NOP);                           04223100          
                   END;                                                 04224000          
     FINISHED:END  EMITNUM  ;                                           04225000          
    COMMENT   SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP        04226000          
              ARRAYS. GIVEN THE OPERATOR BITS SEARCH  YIELDS THE BCD    04227000          
              MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT       04228000          
              BE FOUND SEARCH YIELDS BLANKS.                            04229000          
              NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS.        ;        04230000          
 ALPHA PROCEDURE   SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ;    04231000          
              BEGIN  LABEL L;                                           04232000          
    COMMENT   GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED   04233000          
              BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.)       04234000          
              AND THAT THE FIRST ARGUMENT IS IN Q[4].  FURTHERMORE      04235000          
              THE LENGTH OF Q IS 128.                             ;     04236000          
              INTEGER N,I ;                                             04237000          
              N ~ 64 ;                                                  04238000          
              FOR I ~ 66 STEP IF Q[I]<KEY THEN N ELSE - N               04239000          
                        WHILE N~N DIV 2 } 1 DO                          04240000          
              IF Q[ I ]= KEY THEN GO TO L ;                             04241000          
               I ~0;   COMMENT ARGUMENT NOT FOUND,SEARCH=Q[1] ;         04242000          
       L:     SEARCH~Q[  I +1] ;                                        04243000          
              END       SEARCH  ;                                       04244000          
    COMMENT   B2D  CONVERTS THE FOUR LOW ORDER OCTAL DIGITS TO BCD      04245000          
              CODE ;                                                    04246000          
 ALPHA   PROCEDURE   B2D(B); VALUE B; REAL B;                           04247000          
              B2D~0&B[45:45:3]&B[39:42:3]&B[33:39:3]&B[27:36:3] ;       04248000          
    COMMENT   PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE     04265000          
              INTO THE EDOC ARRAY.   THE SPECIFIC ELEMENT OF EDOC       04266000          
              IS  PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128]  04267000          
              SYLLABLE  POSITION=(L MOD 4 ), WHERE L IS THE SYLLABLE    04268000          
              NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT;          04269000          
 STREAM PROCEDURE PACK(WORD,POSITION,SYLLABLE);                         04270000          
              VALUE POSITION,SYLLABLE;                                  04271000          
              BEGIN                                                     04272000          
              DI~WORD ; DI ~ DI+POSITION ; DI ~ DI+POSITION;            04273000          
              SI~LOC SYLLABLE ; SI~SI+6;                                04274000          
              DS~2 CHR ;                                                04275000          
              END  PACK  ;                                              04276000          
COMMENT DEBUG PRINTS OUT OBJECT CODE IF "DEBUGN" IS SET;                04277000          
PROCEDURE DEBUG(S); VALUE S; REAL S;                                    04277500          
    BEGIN  REAL T1;                                                     04278000          
    IF SINGLTOG THEN                                                    04278500          
      WRITE(LINE,BUG,B2D(L),                                            04279000          
            IF STREAMTOG THEN                                           04279500          
               SEARCH(COP,S.[42:6])                                     04280000          
         ELSE IF T1:=S.[46:2]=1 THEN SEARCH(WOP,S.[36:10])              04280500          
         ELSE WOP[T1] , IF STREAMTOG THEN                               04281000          
        B2D(S.[36:6]) ELSE IF T1=1 THEN WOP[1]                          04281500          
   ELSE B2D(S.[36:10]),B2D(S))                                          04282000          
 ELSE WRITE(LINE,BUG,B2D(L),                                            04282500          
            IF STREAMTOG THEN                                           04283000          
               SEARCH(COP,S.[42:6])                                     04283500          
         ELSE IF T1:=S.[46:2]=1 THEN SEARCH(WOP,S.[36:10])              04284000          
         ELSE WOP[T1] , IF STREAMTOG THEN                               04284500          
        B2D(S.[36:6]) ELSE IF T1=1 THEN WOP[1]                          04285000          
   ELSE B2D(S.[36:10]),B2D(S));                                         04285500          
    END DEBUG;                                                          04286000          
    COMMENT   EMIT PLACES SYLLABLES INTO EDOC, CALLS DEBUG FOR          04288000          
              DEBUGGING OUTPUT ON THE PRINTER, AND CHECKS FOR SEGMENTS  04289000          
              GREATER THAN 4093 SYLLABLES.        ;                     04290000          
 PROCEDURE EMIT ( S ) ; VALUE S; REAL   S  ;                            04291000          
              BEGIN                                                     04292000          
              IF L < 4088 THEN                                          04293000          
              BEGIN                                                     04294000          
              LINKTOG ~ TRUE;                                           04295000          
         PACK(CODE(L DIV 4+1),L.[46:2],S);                              04296000          
              IF DEBUGTOG THEN DEBUG(S);                                04297000          
              L~L+1;                                                    04298000          
              END  ELSE                                                 04299000          
              BEGIN ERR(200); L~1; END;                                 04300000          
    COMMENT   200 EMIT - SEGMENT GREATER THAN 4093 SYLLABLES          *;04301000          
              END  EMIT ;                                               04302000          
    COMMENT   EMITD EMITS THE DIA,DIB,TRB SEQUENCE OF CODE. THE         04305000          
              PREVIOUS SETTING OF THE G-H AND K-V REGISTERS IS COMPARED 04306000          
              THE CURRENT . IF THE G-H,K-V OR BOTH ARE ALREADY SET THEN 04307000          
              THE APPROIATE SYLLABLE(S) ARE OMITTED                     04308000          
              IF 0 BITS ARE TO BE TRANSFERED THEN NO SYLLABLES ARE      04309000          
              EMITTED     ;                                             04310000          
 PROCEDURE    EMITD(A,B,T); VALUE A,B,T ; INTEGER A,B,T;                04311000          
         BEGIN LABEL EXIT,NORMAL;                                       04311010          
              REAL Q;                                                   04311020          
              IF T = 15 THEN                                            04311030          
              BEGIN                                                     04311040          
              IF A = 33 THEN Q ~ 512                                    04311050          
              ELSE IF A ! 18 THEN GO TO NORMAL;                         04311060          
              IF B = 18 THEN Q ~ Q+256                                  04311070          
              ELSE IF B ! 33 THEN GO TO NORMAL;                         04311080          
              EMITO(Q+197);  COMMENT -- THIS GETS OUT FIXED FIELD;      04311090          
              GO TO EXIT;                                               04311100          
              END;                                                      04311110          
    NORMAL:                                                             04311120          
              IF  T! 0 THEN                                             04312000          
              BEGIN                                                     04313000          
                                                                        04314000          
               EMIT(((DIALA~A) DIV 6)|512 + ( A~ A MOD 6)| 64 + DIA);   04315000          
                                                                        04316000          
               EMIT(((DIALB~B) DIV 6)|512 + ( B~ B MOD 6)| 64 + DIB);   04317000          
               EMIT(TRB+64|T);                                          04318000          
                                                                        04319000          
                                                                        04320000          
                                                                        04321000          
              END       EMITD  ;                                        04322000          
    EXIT:     END;                                                      04322100          
 PROCEDURE EMITI(E,A,B); VALUE E,A,B; REAL E,A,B;                       04500000          
         BEGIN LABEL EXIT,IS;                                           04501000          
              INTEGER S,T1,T2;                                          04502000          
              PROCEDURE EMIT21(E,B); VALUE E,B;                         04503000          
                   REAL E;                                              04504000          
                   BOOLEAN B;                                           04505000          
                   BEGIN IF E = 0 THEN                                  04506000          
                             BEGIN IF B THEN EMITO(XCH); END            04507000          
                        ELSE BEGIN GT1 ~ E.ADDRESS;                     04508000          
                                  IF E ~ E.CLASS { INTID THEN           04509000          
                                       EMITV(GT1)                       04521000          
                                  ELSE IF E { INTARRAYID THEN           04522000          
                                       EMITPAIR(GT1,LOD) ELSE           04523000          
                                  EMITN(GT1)                            04524000          
                             END                                        04525000          
                   END;                                                 04526000          
              IF B = 0 THEN                                             04526100          
                   BEGIN EMIT21(E,FALSE); GO TO EXIT END;               04526200          
              IF STACKCT ! 0 THEN GO TO IS;                             04527000          
              IF B = 15 THEN                                            04528000          
                   BEGIN IF A = 33 THEN                                 04529000          
                             BEGIN EMIT21(E,FALSE);                     04530000          
                                  EMIT(0); EMITO(INX);                  04531000          
                                  GO TO EXIT;                           04532000          
                             END;                                       04533000          
                        IF A = 18 THEN                                  04534000          
                             BEGIN EMIT(0);                             04535000          
                                  EMIT21(E,TRUE);                       04536000          
                                  EMITO(197);                           04537000          
                                  GO TO EXIT;                           04538000          
                             END;                                       04539000          
                        GO TO IS;                                       04540000          
                   END;                                                 04541000          
              IF B { 10 AND A+B = 48 THEN                               04542000          
                   BEGIN EMIT21(E,FALSE);                               04543000          
                        EMITL(2*B-1);                                   04544000          
                        EMITO(LND);                                     04545000          
                        GO TO EXIT;                                     04546000          
                   END;                                                 04547000          
    IS:       IF (S ~ (48-A-B) MOD 6)+B { 39 THEN                       04548000          
                   BEGIN EMIT21(E,FALSE);                               04549000          
                        EMIT(T2~(T1~A DIV 6)|512+(A MOD 6)|64+DIA);     04550000          
                        EMIT(((A+B-1) DIV 6 -T1+1)|512+64|S+37);        04551000          
                        GO TO EXIT;                                     04552000          
                   END;                                                 04553000          
              EMIT(0);                                                  04554000          
              EMIT21(E,TRUE);                                           04555000          
              EMITD(A,48-B,B);                                          04556000          
                                                                        04557000          
    EXIT: END;                                                          04558000          
 COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES;          05000000          
 COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE;                     05001000          
 PROCEDURE STEPIT; ELCLASS ~ TABLE(I~I+1);                              05002000          
 INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1);                   05003000          
 COMMENT TAKE FETCHS A WORD FROM INFO;                                  05004000          
 REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX;                05005000          
              TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC];                     05006000          
 COMMENT PUT PLACES A WORD INTO INFO;                                   05007000          
 PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX;          05008000          
              INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD;                     05009000          
 COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPPRESS FUTURE     05010000          
              ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000          
 PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM;                  05012000          
              BEGIN                                                     05013000          
    COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES   05014000          
              THE ERROR MESSAGE ON THE PRINTER;                         05015000          
      STREAM PROCEDURE WRITERROR(ERRNUM,ACCUM,LINE,COUNT,LSTSEQ);       05016000          
              VALUE ERRNUM,COUNT;                                       05017000          
              BEGIN                                                     05018000          
                   DI ~ LINE; 44(DS~2LIT" "); COMMENT CLEAR BUFFER;     05019000          
                   SI ~LSTSEQ; SI ~ SI-8; DS ~WDS;                      05020000          
                   SI ~ LINE; DS ~ 2 WDS;                               05021000          
                   4(DS ~ 2 LIT "XX"); COMMENT  SET RIGHT MARGIN FLAG;  05022000          
                   SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS;       05023000          
                   DI ~ LINE; DI ~ DI+8; COMMENT INDENT MESSAGE;        05024000          
                   DS ~ 13 LIT "ERROR NUMBER ";                         05025000          
                   SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000          
                   DS ~ 4 LIT " -- ";                                   05027000          
                   SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR;               05028000          
                      COMMENT PLACE ALPHA IN BUFFER;                    05029000          
                   DS ~ LIT "."                                         05030000          
              END WRITERROR;                                            05031000          
              IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS.       05032000          
                   BEGIN                                                05033000          
                   SPECTOG := FALSE;                                    05034000          
                   ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS;    05035000          
                   IF NOT LISTER THEN                                   05036000          
                        BEGIN                                           05037000          
                        EDITLINE(LIN,FCR,L DIV 4,L.[46:2],MEDIUM,0);    05038000          
                       MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]);   05039500          
                       IF NOHEADING THEN DATIME; WRITELINE;             05039600          
                       END;                                             05041000          
    COMMENT   PRINT CARDIMAGE IF WE ARE NOT LISTING;                    05042000          
                   ACCUM[1] ~ Q;    COMMENT RESTORE ACCUMULATOR;        05043000          
                   WRITERROR(ERRNUM,ACCUM[1],LIN[*],Q.[12:6],           05044000          
                         INFO[LASTSEQROW,LASTSEQUENCE]);                05045000          
         IF NOT NOHEADING THEN WRITELINE ;                              05046000          
                   ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES;          05047000          
IF PUNCHTOG THEN                                                        05048000          
     BEGIN REAL T1,T2,T3,T4; LABEL L,L1,EXIT;                           05049000          
STREAM PROCEDURE P1(L,P); VALUE P;                                      05050000          
      BEGIN DI ~ L; 15(DS~8LIT" ");                                     05051000          
SI ~ LOC P; DI~L; SI~SI+5; SKIP 3 SB;                                   05052000          
5                                                                       05053000          
(DS~3 RESET;3(IF SB THEN DS~SET ELSE DS~RESET;SKIP 1 SB));              05054000          
SI~P;                                                                   05055000          
DI~DI+2; 2(8                                                            05056000          
(DS~3 RESET;3(IF SB THEN DS~SET ELSE DS~RESET;SKIP 1 SB));              05057000          
DS~LIT" ") END;                                                         05058000          
STREAM PROCEDURE P2(L,P); VALUE P;                                      05059000          
    BEGIN DI~L; DI ~DI+26;DS~LIT"0";                                    05060000          
       SI~P; SI~SI-2; SKIP 1SB;                                         05061000          
3                                                                       05062000          
(DS~3 RESET;3(IF SB THEN DS~SET ELSE DS~RESET;SKIP 1 SB));              05063000          
END;                                                                    05064000          
REAL STREAM PROCEDURE ABS(A); VALUE A;                                  05065000          
     BEGIN DI ~ LOC ABS; SI ~A; DS~ WDS;DI~DI-8; DS~RESET END;          05066000          
STREAM PROCEDURE  BITEDUST(X,N,ID,LINE,COUNT); VALUE ID,N,COUNT;        05067000          
 BEGIN  LOCAL  T,F,H;                                                   05068000          
         DI~LOC F; SI~LINE; DS~WDS;DI~F;                                05069000          
SI~LOC ID;SI~SI+2;DS~ 6CHR;  57(DS~2 LIT"  ");                          05070000          
              SI ~ LOC COUNT ;SI~SI+8 ;                                 05071000          
              DI ~LOC H ; DS ~WDS ;                                     05071100          
              DI ~ LOC LINE ; SI ~ H;                                   05071200          
       SI~LOC X;SKIP 2 SB;                                              05072000          
      IF SB THEN                                                        05073000          
        BEGIN   SI~X;  T~SI;                                            05074000          
             N(                                                         05075000          
         DI~LOC F; SI~LINE; DS~WDS;DI~F;                                05076000          
             SI~ LOC COUNT; SI~SI+6;                                    05077000          
4                                                                       05078000          
(DS~3 RESET;3(IF SB THEN DS~SET ELSE DS~RESET;SKIP 1 SB));              05079000          
                 DS~2 LIT" "; SI~COUNT; SI~SI+48;COUNT~SI;              05080000          
SI~T;                                                                   05081000          
        6(2(8                                                           05082000          
(DS~3 RESET;3(IF SB THEN DS~SET ELSE DS~RESET;SKIP 1 SB));              05083000          
DS~ LIT" "); DS~LIT" " );                                               05084000          
              DI ~ LOC LINE ; SI ~ H;                                   05085000          
SI~T;SI~SI+48;T~SI);END END;                                            05086000          
           BITEDUST(ERRORCOUNT, 63 ,"PRT   ",LINE, 21);                 05087000          
FOR  T1~ 0 STEP 1 UNTIL 31DO BITEDUST(INFO[ T1,*],43,"INFO  ",LINE,0);  05088000          
BITEDUST(      ELBAT[*],13,"ELBAT ",LINE,0);                            05089000          
      BITEDUST(STACKHEAD[*],21,"STHEAD",LINE,0);                        05090000          
         T1~MKABS(ERRNUM)-1; T3~T1;                                     05091000          
L:    T2~ABS(T3);                                                       05092000          
      IF T2.[33:15]=0 THEN BEGIN T3~T2.[18:15];                         05093000          
         IF T3=0 THEN GO TO EXIT ELSE GO TO L END ;                     05094000          
   T4 ~ IF T2.[33:15] < 512 THEN 0 ELSE T2.[33:15]&T2[30:10:2];         05095000          
 L1:P1(LIN[0],T1);IF T1=T3 THEN BEGIN IF T!0 THEN P2(LIN[0],T4);        05096000          
    T1~T1-1;                                                            05097000          
     WRITELINE;                                                         05097500          
                      T3~T2.[18:15];GO TO L  END;                       05098000          
     T1:=T1-1; WRITELINE;                                               05099000          
     GO TO L1;                                                          05099100          
EXIT: END ;                                                             05100000          
                   END END FLAG;                                        05101000          
                   LABEL ENDOFITALL;                                    05101100          
 COMMENT ERR,IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO     05102000          
              RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A          05103000          
              SEMICOLON, END, OR BEGIN;                                 05104000          
 PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM;                   05105000          
              BEGIN FLAG(ERRNUM);                                       05106000          
                   I ~ I-1;                                             05107000          
                   IF ERRNUM = 200 THEN I:=I/0;% SEGMENT TOO LARGE      05107100          
                   IF ERRNUM = 611 THEN I:=I/0;% ERRMAX EXCEEDED        05107200          
                   DO IF STEPI = BEGINV THEN STMT UNTIL                 05108000          
                      ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR;    05109000          
 DEFINE ERROR = ERR#;  COMMENT ERROR IS A SYNONM FOR ERR;               05110000          
 COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE       05111000          
              UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED;                05112000          
 PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD;         05113000          
              BEGIN                                                     05114000          
                   IF MODE } 2 THEN                                     05115000          
                   IF GT1 ~ ELBATWORD.LVL } FRSTLEVEL THEN              05116000          
                   IF GT1 < SUBLEVEL THEN                               05117000          
              IF ELBATWORD.[9:2] ! 1                                    05118000          
                     THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END          05119000          
              END CHECKER;                                              05120000          
    COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION   05121000          
              GIVEN THE LINK TO THE ELBAT WORD;                         05122000          
 INTEGER PROCEDURE GIT(L); VALUE L; REAL L;                             05123000          
              GIT ~ TAKE(L).INCR+L.LINK;                                05124000          
 COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR.  05125000          
              IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES        05126000          
              GETSPACE TO OBTAIN THE PRT ADDRESS;                       05127000          
 INTEGER PROCEDURE GNAT(L); VALUE L; REAL L;                            05128000          
              BEGIN                                                     05129000          
              REAL A;                                                   05130000          
              IF GNAT ~(A~TAKE(L)).ADDRESS=0                            05131000          
              THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11],L)   05132000          
              END GNAT;                                                 05133000          
 REAL PROCEDURE TAKEFRST;                                               05188000          
              TAKEFRST ~ TAKE(ELBAT[I].LINK+ELBAT[I].INCR);             05189000          
 COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A     05196000          
              DESCRIPTOR.  THE DESCRIPTOR REMAINS ON THE TOP OF THE     05197000          
              STACK;                                                    05198000          
 PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS;             05199000          
              BEGIN                                                     05200000          
                   EMITPAIR(ADDRESS,LOD);                               05201000          
                        EMITN(512);                                     05202000          
                        EMITD(33,18,15) END STUFFF;                     05203000          
 COMMENT    LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000          
             PRESENT CODE;                                              05205000          
 BOOLEAN PROCEDURE    LOCAL(ELBATWORD);                                 05206000          
              VALUE ELBATWORD; REAL ELBATWORD;                          05207000          
              BEGIN IF ELBATWORD.LVL = LEVEL AND                        05208000          
                    NOT BOOLEAN(ELBATWORD.FORMAL) THEN                  05209000          
                        LOCAL ~ TRUE END    LOCAL;                      05210000          
 COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT.  TWO ITEMS ARE  05211000          
              PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE       05212000          
              STARTING INDEX.  THE ROUTINE HANDLES SUPERFORMATS ALSO;   05213000          
 PROCEDURE PASSFORMAT;                                                  05214000          
              BEGIN INTEGER ADRES;                                      05215000          
                   CHECKER(ELBAT[I]);                                   05216000          
                   ADRES ~ ELBAT[I].ADDRESS;                            05217000          
                   IF BOOLEAN(ELBAT[I].FORMAL)                          05218000          
                      THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END      05219000          
                      ELSE BEGIN                                        05220000          
                        IF TABLE(I) = SUPERFRMTID                       05221000          
                          THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000          
                      END;                                              05223000          
                   IF TABLE(I) = SUPERFRMTID                            05224000          
                      THEN BEGIN  BANA; I ~ I-1;                        05225000          
                        EMITO(SSP); EMITO(ADD); EMITV(ADRES) END;       05226000          
                   EMITPAIR(ADRES,LOD) END PASSFORMAT;                  05227000          
 COMMENT  STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED     05228000          
              WORDS - IT COMPLEMENTS THEIR STATE;                       05229000          
 PROCEDURE STREAMWORDS;                                                 05230000          
              BEGIN GT1 ~ 0;                                            05231000          
               DO BEGIN                                                 05232000          
                INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000          
                STACKHEAD[GT2] ~ T.LINK;                                05234000          
                GT1 ~ GT1+2;                                            05235000          
               END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS;             05236000          
                                                                        05237000          
                                                                        05238000          
                                                                        05239000          
                                                                        05240000          
                                                                        05241000          
                                                                        05242000          
                                                                        05243000          
                                                                        05244000          
PROCEDURE PROGDESCBLDR(PRTADR,SAV,SIZE,TYPE);                           05245000          
                        VALUE PRTADR,SAV,SIZE,TYPE;                     05246000          
                        INTEGER PRTADR,SIZE,TYPE; BOOLEAN SAV;          05247000          
              BEGIN PRTADR~PRTADR.[38:10];                              05247500          
              IF SAV THEN BEGIN PRT[PRTADR] ~ ( IF TYPE = LDES          05248000          
                   THEN SIZE ELSE CORADR)                               05248500          
                     &SIZE[8:38:10]&TYPE[1:43:5]&3[6:46:2];             05249000          
                    IF TYPE!LDES THEN CORADR~CORADR+SIZE;               05250000          
              END                                                       05251000          
         ELSE BEGIN PRT[PRTADR]~0&DISKADR[18:33:15]&SIZE[8:38:10]       05252000          
                               &TYPE[1:43:5]&1[6:46:2];                 05253000          
                    DISKADR~(SIZE+29) DIV 30+DISKADR;                   05254000          
              END;                                                      05254500          
              END PROGDESCBLDR;                                         05255000          
 COMMENT  DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR.   05267000          
              IT REPORTS IF AN ERROR IS FOUND.  IT RETURNS WITH THE     05268000          
              LITERALS INVOLVED;                                        05269000          
 BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND);                             05270000          
              INTEGER FIRST,SECOND;                                     05271000          
              BEGIN                                                     05272000          
                LABEL EXIT;                                             05273000          
                   IF STEPI = LFTBRKET THEN                             05274000          
                   IF STEPI = LITNO THEN                                05275000          
                   IF STEPI = COLON THEN                                05276000          
                   IF STEPI = LITNO THEN                                05277000          
                   IF STEPI = RTBRKET THEN                              05278000          
    COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT;                 05279000          
                   IF (FIRST ~ ELBAT[I-3].ADDRESS) |                    05280000          
                     (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN               05281000          
                   IF FIRST + SECOND { 48 THEN                          05282000          
    COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.;       05283000          
                     GO TO EXIT;                                        05284000          
                   ERR(114);  COMMENT ERROR IF SYNTAX OR RANGE FAILS;   05285000          
                   DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX;               05286000          
                                                                        05287000          
                                                                        05288000          
                                                                        05289000          
                                                                        05290000          
                                                                        05291000          
                                                                        05292000          
                                                                        05293000          
                                                                        05294000          
                                                                        05295000          
                                                                        05296000          
BOOLEAN PROCEDURE RANGE(LOWER,UPPER);                                   05297000          
                  VALUE LOWER,UPPER;                                    05298000          
                   REAL LOWER,UPPER;                                    05299000          
        COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000          
       IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO    05301000          
       UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY.  THE ITEMS    05302000          
       CLASS MUST BE IN ELCLASS;                                        05303000          
       RANGE~ELCLASS } LOWER AND ELCLASS { UPPER;                       05304000          
 COMMENT GET OBTAINS A SYLLABLE FROM EDOC, THE ARRAY INTO WHICH CODE IS 05305000          
              EMITTED;                                                  05306000          
 INTEGER PROCEDURE GET(L); VALUE L; REAL L;                             05307000          
         BEGIN                                                          05308000          
           INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S;               05309000          
              BEGIN DI ~ LOC GETSYL; DI ~ DI+6;                         05310000          
                    SI ~ W; SI ~ SI+S; SI ~ SI+S; DS ~ 2 CHR END;       05311000          
         GET~GETSYL(CODE(    L DIV 4+1),L.[46:2]); END  GET;            05312000          
 COMMENT  CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE-   05313000          
              SCRIPTOR TO THE TOP OF THE STACK;                         05314000          
 PROCEDURE CALLSWITCH(H); VALUE H; REAL H;                              05315000          
         BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH;  05316000          
                                                                        05317000          
                                                                        05318000          
                                                                        05319000          
                                                                        05320000          
                                                                        05321000          
                                                                        05322000          
                                                                        05323000          
                                                                        05324000          
                                                                        05325000          
PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS;      05325010          
    BEGIN                                                               05325020          
    LABEL EXIT;                                                         05325030          
    STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID);                        05325040          
                            VALUE PORS,CELL,N;                          05325050          
         BEGIN                                                          05325060          
         LOCAL COUNT;                                                   05325070          
         LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT;                             05325080          
         SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK".           05325090          
         IF SC="P" THEN                                                 05325100          
              BEGIN  DS:=3 CHR; DS:=LIT"(";  END                        05325110          
         ELSE BEGIN                                                     05325120          
              DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5;            05325130          
              IF SC}"6" THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+";          05325140          
              COUNT:=DI; DI:=LOC CELL; DI:=DI+4;                        05325150          
              DS:=11 RESET; DI:=COUNT;                                  05325160          
              END;                                                      05325170          
         SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION.                  05325180          
         3(IF SC="0" THEN % DONT PRINT LEADING ZEROES.                  05325190          
              BEGIN SI:=SI+1; TALLY:=TALLY+63  END ELSE JUMP OUT);      05325200          
         COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY;           05325210          
         DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE.                   05325220          
         CI:=CI+N;                                                      05325230          
         GO M0;                                                         05325240          
         GO M1;                                                         05325250          
         GO M2;                                                         05325260          
         GO M3;                                                         05325270          
         GO M4;                                                         05325280          
         GO M5;                                                         05325290          
         GO M6;                                                         05325300          
         GO M7;                                                         05325310          
M0:      SI:=ID; SI:=SI+2; DI:=LOC COUNT;                               05325320          
         DI:=DI+7; DS:=CHR; DI:=CELL;  DS:=COUNT CHR;                   05325330          
         GO XIT;                                                        05325340          
M1:      DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT;             05325350          
M2:      DI:=CELL;                                                      05325360          
           DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT;    05325370          
M3:      DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT;     05325380          
M4:      DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT;             05325390          
M5:      DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT;        05325400          
M6:      DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT;            05325410          
M7:      DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*";                      05325420          
XIT:                                                                    05325430          
         END FILLIT;                                                    05325440          
     BLANKET(14,LIN);                                                   05325450          
     IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1])                         05325460          
ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC])            05325470          
ELSE FILLIT(LIN,PORS,GS,ABS(N),N);                                      05325480          
    IF NOHEADING THEN DATIME; WRITELINE;                                05325490          
    END WRITEPRT;                                                       05325500          
 COMMENT  GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN    05326000          
              THE STACK AND PRT.  PERMANENT TELLS WHETHER IT IS A       05327000          
              PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT.  NON    05328000          
              PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO   05329000          
              MODE.  CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS;    05330000          
INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L;             05331000          
                                         BOOLEAN PERMANENT; INTEGER L;  05333000          
         BEGIN LABEL L1,L2,EXIT;                                        05334000          
         STREAM PROCEDURE DOIT(C,A,I,S); VALUE C,A;                     05334100          
         BEGIN LOCAL N;                                                 05334200          
              DI~S; DS~8 LIT" "; SI~S; DS~9 WDS;                        05334300          
              SI~I; SI~SI+2; DI~LOC N; DI~DI+7; DS~CHR;                 05334400          
              DI~S; SI~LOC C; 2(DS~4 DEC);                              05334500          
              SI~I; SI~SI+3; DS~N CHR;                                  05334600          
         END;                                                           05334700          
           BOOLEAN M,Q;                                                 05343000          
           INTEGER ROW,COL,GS;                                          05344000          
IF NOT(STREAMTOG AND (LEVEL>2))THEN                                     05344400          
     IF STEPI=RELOP THEN                                                05344500          
              BEGIN                                                     05344510          
                   IF STEPI>IDMAX                                       05344520          
                     THEN                                               05344530          
                         BEGIN                                          05344540          
                             IF ELCLASS=ADOP                            05344550          
                                  THEN                                  05344560          
                                       IF ELBAT[I].ADDRESS=SUBOP        05344570          
                                            THEN GS~FZERO ELSE GS~512   05344580          
                        ELSE                                            05344590          
                  BEGIN GS~0;I~I-1 END;                                 05344600          
                        IF STEPI!LITNO THEN FLAG(51);                   05344610          
                        IF ELBAT[I].ADDRESS}512 THEN GS~1024;           05344615          
                        GS~GS+ELBAT[I].ADDRESS                          05344620          
                   END                                                  05344630          
                     ELSE                                               05344640          
                        BEGIN                                           05344650          
                             GS~ELBAT[I].ADDRESS;                       05344660          
                             IF GS=0 THEN FLAG(51);                     05344661          
                             IF GS}FZERO AND GS{1023 THEN GS~-GS;       05344662          
                             IF STEPI!ADOP THEN I~I-1 ELSE              05344670          
                                  BEGIN                                 05344680          
                                  STEPIT;                               05344690          
                                  GS~ELBAT[I].ADDRESS+                  05344700          
                                       (IF ELBAT[I-1].ADDRESS=SUBOP     05344710          
                                            THEN -GS ELSE +GS);         05344720          
                                  END;                                  05344730          
                             GS~ABS(GS);                                05344740          
                        END; Q~GS<512 OR GS>1023;                       05344750          
              GO TO EXIT                                                05344760          
              END ELSE I~I-1;                                           05344770          
         IF MODE = 0 OR PERMANENT                                       05345000          
             THEN BEGIN                                                 05346000          
              IF PRTIMAX > 1023 THEN FLAG(148);                         05347000          
              IF ASTOG THEN FLAG(505);                                  05348000          
              PRTI ~                                                    05349000          
              PRTIMAX~(GS~PRTIMAX)+1;                                   05350000          
              IF STUFFTOG THEN IF (M~(LEVEL=1 AND KLASSF>19)) OR        05350100          
                 (LEVEL}3 AND ELBAT[I].CLASS=LABELID) THEN BEGIN        05350120          
               IF NOT M THEN                                            05350140          
              DOIT(LABELID,GS,INFO[(ELBAT[I]).LINKR,                    05350160          
              (ELBAT[I].LINKC+1)],TWXA[0])  ELSE                        05350180          
              DOIT(KLASSF,GS,INFO[(LASTINFO+1).LINKR,(LASTINFO+1).LINKC]05350200          
                         ,TWXA[0]);  WRITE(STUFF,10,TWXA[*]) END; END   05350300          
           ELSE BEGIN                                                   05369000          
              IF STACKCTR > 767 THEN FLAG(149);                         05370000          
              STACKCTR ~ (GS ~ STACKCTR)+1; Q ~ FALSE;                  05371000          
              GO TO EXIT END;                                           05372000          
    L2:    IF GS } 512 THEN GS ~ GS+1024;                               05373000          
           Q ~ TRUE;                                                    05374000          
    EXIT:  GETSPACE ~ GS;                                               05375000          
           IF GS}NESTCTR AND GS<FZERO THEN NESTCTR~GS+1;                05375100          
           IF GS > 1023 THEN GS ~ GS-1024;                              05376000          
    IF PRTOG THEN WRITEPRT(IF Q THEN "PRT  " ELSE "STACK",L,B2D(GS));   05376100          
         END GETSPACE;                                                  05378000          
 REAL PROCEDURE DEPTH(I); VALUE I; REAL I;                              05400000          
         BEGIN REAL   J,K,T,S,M;                                        05401000          
              IF T~NESTPRT[I]<0 THEN                                    05402000          
                   BEGIN DEPTH~CALL[T.[22:13]-1].[35:13];               05402100          
                        IF NESTPRT[I].[2:1]=0 THEN NESTCUR~NESTCUR+1;   05402200          
                        NESTPRT[I].[2:1]~1;                             05402300          
                   END                                                  05402400          
              ELSE IF T.[9:13]!0 THEN DEPTH~T.[9:13]                    05403000          
              ELSE BEGIN M~0; NESTPRT[I]~-T;                            05404000          
                   J~T.[22:13]; K~CALL[J-1].[22:13];                    05405000          
                   FOR J~J STEP 1 UNTIL K DO                            05406000          
                   IF S~DEPTH(CALL[J])>M THEN M~S;                      05407000          
                    M~DEPTH~M+CALL[T.[22:13]-1].[35:13];                05409000          
                   IF NESTCUR!0 THEN                                    05409100          
                   IF NESTPRT[I].[2:1]=0 THEN ELSE                      05409200          
                   BEGIN T~T&M[9:35:13]; NESTCUR~NESTCUR-1 END          05409300          
                   ELSE T~T&M[9:35:13];                                 05409400          
                   NESTPRT[I]~T;                                        05409500          
                   END;                                                 05410000          
         END;                                                           05411000          
 PROCEDURE NESTSORT(L,U); VALUE L,U; REAL L,U; FORWARD;                 05411100          
 PROCEDURE SORTNEST;                                                    05412000          
         BEGIN ARRAY A[0:14];                                           05413000          
              REAL I,J,K,T;                                             05414000          
              REAL P,Q;                                                 05414100          
   STREAM PROCEDURE NESTFORM(I,N,L,A); VALUE I,N;                       05415000          
         BEGIN LOCAL S;                                                 05416000          
              DI~A; 15(DS~8 LIT " ");                                   05417000          
              DI~LOC S; DI~DI+7; SI~L; SI~SI+10; DS~CHR;                05418000          
              DI~A; DI~DI+I; A~DI;                                      05419000          
              DI~DI+6; DS~ S CHR;                                       05420000          
              DI~A; SI~LOC N; DS~4 DEC;                                 05421000          
              DI~A; DS~3 FILL;                                          05422000          
         END;                                                           05423000          
         FOR I~PRTBASE STEP 1 UNTIL PRTOP DO                            05424000          
         IF   NESTPRT[I]!0 THEN                                         05425000          
              BEGIN SORTPRT[Q]~I; Q~Q+1 END;                            05425100          
         NESTSORT(0,Q~Q-1);                                             05425200          
         FOR P~0 STEP 1 UNTIL Q DO                                      05425300          
         BEGIN I~SORTPRT[P]; T~NESTPRT[I];                              05425400          
              NESTFORM(0,DEPTH(I),INFO[T.LINKR,T.LINKC],A);             05426000          
              WRITE(LINE[DBL],15,A[*]);                                 05427000          
              J~T.[22:13]; K~CALL[J-1].[22:13];                         05428000          
              FOR J~J STEP 1 UNTIL K DO                                 05429000          
              BEGIN I~CALL[J];                                          05430000          
                   T~NESTPRT[I];                                        05430500          
                   NESTFORM(32,DEPTH(I),INFO[T.LINKR,T.LINKC],A);       05431000          
                   WRITE(LINE,15,A[*]);                                 05432000          
              END;                                                      05433000          
              WRITE(LINE[DBL]);                                         05434000          
         END;                                                           05435000          
         END;                                                           05436000          
 PROCEDURE NESTSORT(L,U); VALUE L,U; REAL L,U;                          05437000          
         BEGIN REAL I,J,K,M;                                            05438000          
              LABEL AGAIN,TOP,BOTTOM,EXIT;                              05439000          
              IF L!U THEN                                               05440000          
              BEGIN M~ (U+L) DIV 2;                                     05441000          
                   NESTSORT(L,M);                                       05442000          
                   NESTSORT(M+1,U);                                     05443000          
                   I~K~L; J~M+1;                                        05444000          
    AGAIN:         IF I>M THEN GO TO TOP;                               05445000          
                   IF J>U THEN GO TO BOTTOM;                            05446000          
                   GT1~NESTPRT[SORTPRT[I].[33:15]].LINK;                05447000          
                   GT2~NESTPRT[SORTPRT[J].[33:15]].LINK;                05448000          
                   IF INFO[GT1.LINKR,(GT1+1).LINKC].[18:30]{            05449000          
                      INFO[GT2.LINKR,(GT2+1).LINKC].[18:30] THEN        05450000          
                        GO TO BOTTOM;                                   05451000          
    TOP:           SORTPRT[K].[18:15]~SORTPRT[J];                       05452000          
                   J~J+1;                                               05453000          
                   IF K~K+1{U THEN GO TO AGAIN ELSE GO TO EXIT;         05454000          
    BOTTOM:        SORTPRT[K].[18:15]~SORTPRT[I];                       05455000          
                   I~I+1;                                               05456000          
                   IF K~K+1{U THEN GO TO AGAIN ELSE GO TO EXIT;         05457000          
    EXIT:          FOR I~L STEP 1 UNTIL U DO                            05458000          
                   SORTPRT[I]~SORTPRT[I].[18:15];                       05459000          
              END;                                                      05460000          
         END;                                                           05461000          
 COMMENT      ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000          
 COMMENT   AEXP IS THE ARITHMETIC EXPRESSION ROUTINE;                   06001000          
 PROCEDURE AEXP;                                                        06002000          
              BEGIN                                                     06003000          
                   IF ELCLASS = IFV                                     06004000          
                     THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END      06005000          
                     ELSE BEGIN ARITHSEC; SIMPARITH END                 06006000          
              END AEXP;                                                 06007000          
 COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION.   06008000          
              IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P      06009000          
              AND Q ARE PRIMARIES;                                      06010000          
 PROCEDURE ARITHSEC;                                                    06011000          
              BEGIN                                                     06012000          
                IF ELCLASS = ADOP                                       06013000          
                   THEN BEGIN                                           06014000          
                     STEPIT;                                            06015000          
                     IF ELBAT[I-1].ADDRESS ! SUB THEN PRIMARY           06016000          
                       ELSE BEGIN                                       06017000          
                         PRIMARY;                                       06018000          
                         ENDTOG ~ LINKTOG; EMITO(CHS);                  06021000          
                         LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END       06022000          
                   ELSE PRIMARY END ARITHSEC;                           06023000          
 COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE        06024000          
              ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN    06025000          
              COMPILED.  IT ALSO HANDLES THE CASE OF A CONCATENATE      06026000          
              WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO       06027000          
              COMPILE ONLY PART OF A PRIMARY.  MOST OF THE WORK OF      06028000          
              SIMPARITH IS DONE BY ARITHCOMP, AN ARTIFIAL ROUTINE       06029000          
              WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION.        06030000          
              ARITHCOMP IS A SUBROUTINE ONLY TO GET THIS RECURSION;     06031000          
 PROCEDURE SIMPARITH;                                                   06032000          
              BEGIN                                                     06033000          
                WHILE ELCLASS = AMPERSAND                               06034000          
                   DO BEGIN STEPIT; PRIMARY; PARSE END;                 06035000          
                WHILE ELCLASS } EQVOP DO ARITHCOMP END;                 06036000          
 COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE     06037000          
              ANALYSIS.  IT CALLS PRIMARY AT APPROPRIATE TIMES AND      06038000          
              EMITS THE ARITHMETIC OPERATORS.  THE HIERARCHY ANALYSIS   06039000          
              IS OBTAINED BY RECURSION;                                 06040000          
 PROCEDURE ARITHCOMP;                                                   06041000          
              BEGIN INTEGER OPERATOR, OPCLASS;                          06042000          
               DO BEGIN                                                 06043000          
                OPERATOR ~ 1 & ELBAT[I] [36:17:10];                     06044000          
    COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED.  THE HIGH  06045000          
              ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10]     06046000          
              OF THE ELBAT WORD;                                        06047000          
                OPCLASS ~ ELCLASS;                                      06048000          
                STEPIT; PRIMARY;                                        06049000          
                   BEGIN                                                06051000          
                     WHILE OPCLASS < ELCLASS DO ARITHCOMP;              06052000          
    COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY;             06053000          
                     EMIT(OPERATOR);                                    06054000          
                     EMIT(0); L ~ L-1;                                  06054100          
              STACKCT ~ 1;                                              06054150          
                   END;                                                 06054200          
               END UNTIL OPCLASS ! ELCLASS END ARITHCOMP;               06055000          
    INTEGER PROCEDURE EXPRSS; BEGIN AEXP; EXPRSS ~ ATYPE END;           06057000          
 PROCEDURE POLISHER(EXPECT); VALUE EXPECT; REAL EXPECT;                 06060000          
         BEGIN LABEL EXIT;                                              06061000          
              LABEL EL;                                                 06061900          
              REAL COUNT,T1, T2;                                        06062000          
              BOOLEAN S;                                                06063000          
              REAL SSS;   INTEGER Z;                                    06063500          
              STREAM PROCEDURE WRITEOUT(C,N,L); VALUE C,N;              06064000          
                   BEGIN DI ~ L; DS ~ 2 LIT "S=";                       06065000          
                        SI ~ LOC C; SI ~ SI+7; DS ~ CHR;                06066000          
                        SI ~ LOC N; DS ~ DEC;                           06067000          
                        58(DS~2LIT " ");                                06067500          
                   END;                                                 06068000          
              SSS~ STACKCTR;                                            06068500          
              IF STEPI ! LEFTPAREN THEN GO TO EXIT;                     06069000          
              DO BEGIN                                                  06070000          
                   IF STEPI } OPERATORS THEN                            06071000          
                        BEGIN T1 ~ (T2 ~ ELBAT[I]).ADDRESS;             06072000          
                             S ~ S OR COUNT - T2.[11:3] < 0;            06074000          
                             COUNT ~ T2.[14:2]+COUNT-2;                 06075000          
                             IF ELCLASS } OPERATOR THEN                 06076000          
                             BEGIN IF T1 ! 0 THEN EMITO(T1)             06077000          
                             ELSE BEGIN                                 06078000          
                                   T1 ~ T2.LINK+2;                      06079000          
                                   T2 ~ T2.INCR+T1;                     06080000          
                                   FOR T1 ~ T1 STEP 1 UNTIL T2 DO       06081000          
                                       EMIT(TAKE(T1));                  06082000          
                                   END;                                 06083000          
                              END ELSE BEGIN T2 ~ ELCLASS;              06084000          
                                   IF STEPI ! LITNO THEN                06085000          
                                       BEGIN ERR(500); GO TO EXIT END;  06086000          
                                   IF T2 = BITOP THEN EMIT(T1&C         06087000          
                                       [36:42:6]) ELSE                  06088000          
                                   IF T2 = HEXOP THEN EMIT(T1&          06089000          
                                       (T2~C DIV 6)[36:45:3]&(C-T2|6)   06090000          
                                       [39:45:3]) ELSE                  06091000          
                                  IF T2 = ISOLATE THEN                  06092000          
                                       BEGIN T2 ~ C;                    06093000          
                                            IF STEPI ! LITNO            06094000          
                                            THEN BEGIN ERR(500);        06095000          
                                            GO TO EXIT END;             06096000          
                                                                        06097000          
                                                                        06098000          
                                                                        06099000          
                                            EMIT(Z~((T2+C-1)DIV 6-C DIV 06099100          
                                          6+1)|512+(48-T2-C)MOD 6|64+   06099200          
                                            37);                        06100000          
                                       END END;                         06101000          
                              STEPIT;                                   06102000          
                              S ~ S OR COUNT < 0;                       06103000          
                        END ELSE BEGIN                                  06104000          
                             IF ELCLASS = LABELID THEN                  06104100          
                                  BEGIN T1:=2;                          06104200          
                   EL:                 GT4 ~ TAKE(T2~GIT(ELBAT[I]));    06104300          
                                       PUT(L,T2);                       06104400          
                                       IF GT4 = 0 THEN GT4 ~ L;         06104500          
                                       IF (GT4:=L-GT4)DIV 4 } 128 THEN  06104510          
                                          BEGIN GT4:=0;FLAG(50);END;    06104520          
                                       EMIT(GT4|4+T1);                  06104600          
                                       STEPIT;                          06104700          
                                  END ELSE                              06104800          
                             IF ELCLASS ! PERIOD THEN AEXP ELSE BEGIN   06105000          
                             T2~0;                                      06106000          
                             IF STEPI=PERIOD THEN                       06106100          
                             BEGIN T2~1; STEPIT END;                    06106200          
                             IF ELCLASS>IDMAX THEN                      06106300          
                                  BEGIN ERR(500); GO TO EXIT END;       06107000          
                             IF ELCLASS = LABELID THEN                  06107100          
                                  BEGIN T1 ~ 0; GO TO EL END;           06107200          
                             IF T1 ~ ELBAT[I].ADDRESS = 0 THEN          06108000          
                                  BEGIN ERR(100); GO TO EXIT END;       06109000          
                              EMITL(T1);                                06110000          
                             IF T1>1023 THEN                            06110100          
                             IF T2=0THEN FLAG(500)                      06110200          
                             ELSE EMITO(PRTE);                          06110300          
                              STEPIT;                                   06111000          
                             END; COUNT ~ COUNT+1;                      06112000          
                             END;                                       06113000          
              END UNTIL ELCLASS ! COMMA;                                06114000          
              IF ELCLASS ! RTPAREN THEN                                 06115000          
                   BEGIN ERR(104); GO TO EXIT END;                      06116000          
              STEPIT;                                                   06117000          
              IF FALSE THEN                                             06118000          
                   BEGIN COUNT ~ COUNT-EXPECT;                          06119000          
                        WRITEOUT(IF COUNT < 0 THEN "-" ELSE             06120000          
                                  IF COUNT = 0 THEN " " ELSE "+",       06121000          
                                  ABS(COUNT),LIN[0]);                   06122000          
                        WRITELINE;                                      06123000          
                   END;                                                 06124000          
    EXIT: STACKCTR ~ SSS; END;                                          06125000          
 PROCEDURE PRIMARY;                                                     06126000          
         BEGIN LABEL                                                    06127000          
              L1,  L2,  L3,  L4,  L5,  L6,  L7,  L8,  L9,  L10,         06128000          
              L11, L12, L13, L14, L15, L16, L17, L18, L19, L20,         06129000          
              L21, L22, L23, L24, L25, L26, L27, L28, L29, L30,         06130000          
              L31, L32, L33, L34, L35, L36, L37, L38, L39;              06131000          
              SWITCH S ~                                                06132000          
              L1,  L2,  L3,  L4,  L5,  L6,  L7,  L8,  L9,  L10,         06133000          
              L11, L12, L13, L14, L15, L16, L17, L18, L19, L20,         06134000          
              L21, L22, L23, L24, L25, L26, L27, L28, L29, L30,         06135000          
              L31, L32, L33, L34, L35, L36, L37, L38, L39;              06136000          
              LABEL EXIT,RP,LDOT,LAMPER;                                06137000          
              GO TO S[ELCLASS];                                         06138000          
              IF ELCLASS = LFTBRKET THEN                                06139000          
                   BEGIN STEPIT; VARIABLE(FL);                          06140000          
                        IF ELCLASS ! RTBRKET THEN                       06141000          
                             BEGIN ERR(118); GO TO EXIT END;            06142000          
                        STEPIT;                                         06143000          
                        GO TO LDOT;                                     06144000          
                   END;                                                 06145000          
              IF ELCLASS = NOTOP THEN                                   06146000          
                   BEGIN STEPIT; PRIMARY;                               06147000          
                        EMITLNG; EMIT(0); L~L-1;                        06148000          
                        GO TO EXIT;                                     06149000          
                   END;                                                 06150000          
              IF ELCLASS = UNKNOWNID THEN ERR(100);                     06151000          
 L1:L2:L3:L4:L5:L6:L8:L9:L10:L12:L13:L16:L17:L20:L21:L24:L25:L28:L29:   06152000          
 L32:                                                                   06153000          
              ERR(103); GO TO EXIT;                                     06154000          
         L7:                                                            06155000          
              SUBHAND(FALSE); GO TO LDOT;                               06156000          
         L11:                                                           06157000          
              IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT;                  06158000          
         L14:L15:                                                       06159000          
              STRMPROCSTMT; GO TO LDOT;                                 06160000          
         L18:L19:                                                       06161000          
              PROCSTMT(FALSE); GO TO LDOT;                              06162000          
         L22:L23:L26:L27:L30:L31:                                       06163000          
              VARIABLE(FP); GO TO LAMPER;                               06164000          
         L33:L35:                                                       06165000          
              EMIT(0&ELBAT[I] [36:17:10]); STEPIT; GO TO LAMPER;        06166000          
         L34:L36:                                                       06167000          
              EMITNUM(C); STEPIT; GO TO LAMPER;                         06168000          
         L38:                                                           06169000          
              POLISHER(1); GO TO LDOT;                                  06170000          
         L39:                                                           06171000          
              STEPIT; PRIMARY; STACKCT ~ STACKCT-1;                     06172000          
              EMITO(LOD); GO TO LDOT;                                   06172500          
         L37:                                                           06173000          
              STEPIT; AEXP;                                             06174000          
              STACKCT ~ STACKCT-1;                                      06174500          
              IF ELCLASS ! RTPAREN THEN                                 06175000          
                   BEGIN ERR(104); GO TO EXIT END;                      06176000          
              STEPIT;                                                   06177000          
         LDOT:DOT;                                                      06178000          
         LAMPER:                                                        06179000          
              STACKCT ~ STACKCT +1;                                     06179500          
              WHILE ELCLASS = AMPERSAND DO                              06180000          
                   BEGIN STEPIT; PRIMARY; PARSE END;                    06181000          
 EXIT: END PRIMARY;                                                     06182000          
 PROCEDURE IMPFUN;                                                      06183000          
         BEGIN REAL T1,T2;                                              06184000          
              T1 ~ (T2 ~ ELBAT[I]).ADDRESS;                             06185000          
              PANA;                                                     06186000          
              IF T1 ! 0 THEN EMITO(T1)                                  06187000          
                   ELSE BEGIN                                           06188000          
                   T1 ~ T2.LINK+T2.INCR+1;                              06189000          
                   T2 ~ T2.LINK+2;                                      06190000          
                   FOR T2 ~ T2 STEP 1 UNTIL T1 DO EMIT(TAKE(T2));       06191000          
                   END;                                                 06192000          
         END;                                                           06193000          
 PROCEDURE SUBHAND(FROM); VALUE FROM; BOOLEAN FROM;                     06194000          
         BEGIN LABEL EXIT;                                              06195000          
              REAL T1;                                                  06196000          
              T1 ~ TAKEFRST;                                            06197000          
              IF ELCLASS ! SUBID AND FROM THEN                          06198000          
                   BEGIN IF STEPI ! ASSIGNOP THEN                       06199000          
                        BEGIN FLAG(503); GO TO EXIT END;                06200000          
                        STEPIT;                                         06201000          
                        AEXP;                                           06202000          
                        EMITO(XCH);                                     06203000          
                        GO TO EXIT;                                     06204000          
                   END;                                                 06205000          
              EMITL((L+6) DIV 4-(T1.[24:12]-1) DIV 4);                  06206000          
              EMITB(BBW,BUMPL,T1.[36:12]);                              06207000          
              STEPIT;                                                   06208000          
              ADJUST;                                                   06208500          
 EXIT:   END SUBHAND;                                                   06209000          
 COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS.  IT REPORTS THE TYPE   06292000          
              OF EXPRESSIONS AS EXPRSS REPORTS;                         06293000          
 INTEGER PROCEDURE IFEXP;                                               06294000          
              BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH;                 06295000          
                   IFCLAUSE;                                            06296000          
              STACKCT ~ 0;                                              06296500          
                   THENBRANCH ~ BUMPL;                                  06297000          
    COMMENT SAVE L FOR LATER FIXUP;                                     06298000          
                   IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS;   06299000          
              STACKCT ~ 0;                                              06299500          
                   ELSEBRANCH ~ BUMPL;                                  06300000          
                   EMITB(BFC,THENBRANCH,L);                             06301000          
                   IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN          06302000          
                   STEPIT;                                              06303000          
              AEXP; STACKCT ~ 1;                                        06305000          
                   COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS;     06306000          
                   EMITB(BFW,ELSEBRANCH,L);                             06307000          
                   EMIT(1); L ~ L-1;                                    06308000          
    COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE.  COMPARE WITH      06309000          
              BOOSEC, BOOCOMP, AND RELATION;                            06310000          
              END END IFEXP;                                            06311000          
 COMMENT PARSE COMPILES CODE FOR THE CONCATENATE;                       06312000          
 PROCEDURE PARSE;                                                       06313000          
              BEGIN INTEGER FIRST,SECOND,THIRD;                         06314000          
                   LABEL EXIT;                                          06315000          
                   IF ELCLASS = LFTBRKET THEN                           06316000          
                   IF STEPI = LITNO THEN                                06317000          
                   IF STEPI = COLON THEN                                06318000          
                   IF STEPI = LITNO THEN                                06319000          
                   IF STEPI = COLON THEN                                06320000          
                   IF STEPI = LITNO THEN                                06321000          
                   IF STEPI = RTBRKET THEN                              06322000          
    COMMENT IF TEST ARE PASSED THEN SYNTAX IS CORRECT;                  06323000          
                   IF (FIRST  ~ ELBAT[I-5].ADDRESS) |                   06324000          
                      (SECOND ~ ELBAT[I-3].ADDRESS) |                   06325000          
                      (THIRD  ~ ELBAT[I-1].ADDRESS) ! 0 THEN            06326000          
                   IF FIRST + THIRD { 48 THEN                           06327000          
                   IF SECOND+ THIRD { 48 THEN                           06328000          
    COMMENT IF TEST ARE PASSED THEN RANGES OF LITERALS ARE O.K.;        06329000          
                     BEGIN                                              06330000          
                       STEPIT;                                          06331000          
                        EMITD(SECOND,FIRST,THIRD);                      06332000          
              STACKCT ~ 1;                                              06332500          
                       GO TO EXIT END;                                  06333000          
                   ERR(113); COMMENT ERROR IF SYNTAX OR RANGE FAILS;    06334000          
    EXIT:     END PARSE;                                                06335000          
 COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS, EXCEPT FOR     06336000          
              THOSE CASES HANDLED BY THE VARIABLE ROUTINE;              06337000          
 PROCEDURE DOT;                                                         06338000          
              BEGIN INTEGER FIRST,SECOND; LABEL EXIT;                   06339000          
                IF ELCLASS = PERIOD THEN BEGIN                          06340000          
                        IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT;     06341000          
                                                                        06342000          
                                                                        06343000          
              EMITI(0,FIRST,SECOND);                                    06344000          
                        STEPIT;                                         06345000          
    EXIT: END END DOT;                                                  06346000          
 PROCEDURE IFCLAUSE;                                                    06409000          
              BEGIN STEPIT; BEXP;                                       06410000          
                IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000          
 COMMENT  PANA COMPILES THE CONSTRUCT: (<ARIT. EXP.>);                  06412000          
 PROCEDURE PANA;                                                        06413000          
              BEGIN                                                     06414000          
               IF STEPI ! LEFTPAREN THEN ERR(105)                       06415000          
               ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN       06416000          
                   ERR(104) ELSE STEPIT END END PANA;                   06417000          
 COMMENT  BANA COMPILES THE CONSTRUCT:  [<ARITH. EXP.>];                06418000          
 PROCEDURE BANA;                                                        06419000          
              BEGIN                                                     06420000          
               IF STEPI ! LFTBRKET THEN ERR(117)                        06421000          
                   ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN   06422000          
                     ERR(118) ELSE STEPIT END END BANA      ;           06423000          
 COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES;                  07000000          
 COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS.  IT ALSO ELIMINATES       07001000          
              COMMENTS FOLLOWING ENDS.  AFTER ANY ERROR, ERROR MESSAGES 07002000          
              ARE SUPPRESSED.  COMPOUNDTAIL IS PARTIALLY RESPONSIBLE    07003000          
              FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES.  SOME  07004000          
              CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END.";  07005000          
PROCEDURE COMPOUNDTAIL;                                                 07006000          
              BEGIN LABEL ANOTHER;                                      07007000          
                I ~ I-1; BEGINCTR ~ BEGINCTR+1;                         07008000          
  ANOTHER:      ERRORTOG ~ TRUE;   COMMENT  ALLOW ERROR MESSAGES;       07009000          
                STEPIT;                                                 07010000          
                IF STREAMTOG THEN STREAMSTMT ELSE STMT;                 07011000          
                IF ELCLASS = SEMICOLON THEN GO TO ANOTHER;              07012000          
                IF ELCLASS ! ENDV                                       07013000          
                  THEN BEGIN                                            07014000          
                   ERR(119); GO TO ANOTHER END;                         07015000          
              ENDTOG~TRUE;                                              07016000          
              DO STOPDEFINE~TRUE UNTIL                                  07017000          
                   STEPI{ENDV AND ELCLASS}UNTILV                        07018000          
                   OR NOT ENDTOG;                                       07019000          
              ENDTOG~FALSE;                                             07020000          
                   IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD    07021000          
                     THEN BEGIN                                         07022000          
                        IF BEGINCTR = 0 THEN                            07023000          
                         BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000          
FLAG (120);                                                             07025000          
FCR:= (LCR:=MKABS(CBUFF[9]))-9;                                         07025010          
    IF LISTER THEN PRINTCARD;                                           07025020          
FCR:= (LCR:=MKABS(TBUFF[9]))-9  END;                                    07025030          
                   IF ELCLASS = PERIOD THEN                             07026000          
                     BEGIN                                              07027000          
                        GT5 ~ "ND;END."&"E"[1:43:5];                    07028000          
                        MOVE(1,GT5,CBUFF[0]);                           07029000          
                        LASTUSED~4;                                     07030000          
                        ELBAT[I~I-2] ~SPECIAL[20];                      07031000          
                        ELCLASS ~ SEMICOLON END                         07032000          
              END COMPOUNDTAIL;                                         07033000          
 REAL AXNUM;                                                            07034000          
 PROCEDURE ACTUALPARAPART(SBIT,INDEX); VALUE SBIT,INDEX;                07035000          
         BOOLEAN SBIT; REAL INDEX;                                      07036000          
         BEGIN LABEL EXIT,COMMON,ANOTHER,POL;                           07037000          
              REAL PCTR,SCLASS,ACLASS;                                  07038000          
 STREAM PROCEDURE WRITEAX(LINE,ACCUM,N,SEQ); VALUE N;                   07038100          
         BEGIN DI ~ LINE; 15(DS ~ 8 LIT " ");                           07038200          
              DI ~ LINE; SI ~ SEQ; SI ~ SI-16; DS ~ WDS;                07038300          
              DI ~ DI+4; DS ~ 20 LIT "ACCIDENTAL ENTRY AT ";            07038400          
                        SI ~ ACCUM; SI ~ SI+3; DS ~ N CHR;              07038500          
              SI ~ SEQ; DI ~ SEQ; DI ~ DI-16; DS ~ WDS;                 07038600          
         END;                                                           07038700          
              BOOLEAN VBIT,IDBIT;                                       07039000          
              PCTR ~ 1;                                                 07040000          
    ANOTHER:  ACLASS ~ STEPI&0[47:47:1];                                07041000          
              STACKCT ~ 0;                                              07041200          
              GT1 ~ TAKE(INDEX+PCTR);                                   07042000          
              VBIT ~ BOOLEAN(GT1.VO);                                   07043000          
              SCLASS ~ GT1.CLASS&0[47:47:1];                            07044000          
              IF VBIT THEN BEGIN AEXP; GO TO COMMON END;                07045000          
              IF SBIT THEN SCLASS ~ NAMEID;                             07046000          
              IDBIT ~ BOOID < ACLASS AND ACLASS < LABELID;              07047000          
              IF SCLASS = NAMEID THEN                                   07048000          
                   BEGIN                                                07049000          
                        IF IDBIT THEN VARIABLE(FL)                      07050000          
                        ELSE                                            07051000          
    POL:                     IF ELCLASS = POLISHV THEN POLISHER(1)      07052000          
                        ELSE       ERR(IF ELCLASS=0 THEN 0 ELSE 123);   07053000          
                        GO TO COMMON;                                   07054000          
                   END;                                                 07055000          
              IF SCLASS = REALARRAYID THEN                              07056000          
                   IF ACLASS = REALARRAYID THEN                         07057000          
                        BEGIN VARIABLE(FL); GO TO COMMON END            07058000          
                   ELSE GO TO POL;                                      07059000          
              IF SCLASS ! REALID THEN                                   07060000          
                   BEGIN FLAG(503);                                     07061000          
                        AEXP;                                           07062000          
                        ERRORTOG ~ TRUE;                                07063000          
                        GO TO COMMON;                                   07064000          
                   END;                                                 07065000          
              GT1 ~ TABLE(I+1);                                         07066000          
              IF GT1 = COMMA OR GT1 = RTPAREN THEN                      07067000          
                   BEGIN IF IDBIT THEN                                  07068000          
                             BEGIN IF ACLASS = REALID AND               07069000          
                                  BOOLEAN(ELBAT[I].FORMAL)THEN BEGIN    07070000          
                                  CHECKER (ELBAT[I]);                   07070500          
                                  EMITPAIR(ELBAT[I].ADDRESS,LOD);       07071000          
                                  STEPIT; END                           07072000          
                                  ELSE VARIABLE(FL);                    07073000          
                                  GO TO COMMON END;                     07074000          
                        IF ELCLASS { STRNGCON AND ELCLASS > LABELID     07075000          
                             THEN BEGIN PRIMARY; GO TO COMMON END;      07076000          
                   END;                                                 07077000          
              EMITO(NOP); EMITO(NOP);                                   07078000          
              SCLASS ~ L;                                               07079000          
              ADJUST;                                                   07080000          
              ACLASS ~ L.[36:10];                                       07081000          
              IF IDBIT THEN                                             07082000          
                   BEGIN VARIABLE(FL);                                  07083000          
                        IF ELCLASS < AMPERSAND THEN GO TO COMMON;       07084000          
                                                                        07084500          
                        SIMPARITH;                                      07085000          
                   END ELSE AEXP;                                       07086000          
              IF LISTER THEN                                            07086100          
                   BEGIN ACCUM[1] ~ Q;                                  07086200          
                        WRITEAX(LIN[0],ACCUM[1],Q.[12:6],               07086300          
                             INFO[LASTSEQROW,LASTSEQUENCE]);            07086400          
                        WRITELINE;                                      07086500          
                   END;                                                 07086600          
              AXNUM ~ AXNUM+1;                                          07086700          
              EMITO(RTS);                                               07087000          
              EMITB(BFW,SCLASS,L);                                      07088000          
              EMITNUM(ACLASS);                                          07089000          
              EMITPAIR(TAKE(PROINFO).ADDRESS,LOD);                      07090000          
              EMITO(INX);                                               07091000          
              EMITN(512);                                               07092000          
              EMITD(33,18,15);                                          07093000          
              EMIT(0);                                                  07093100          
              EMITD(5,5,1);                                             07093200          
    COMMON:   PCTR ~ PCTR+1;                                            07094000          
              IF ELCLASS = COMMA THEN GO TO ANOTHER;                    07095000          
              IF ELCLASS ! RTPAREN THEN                                 07096000          
                   BEGIN ERR(129); GO TO EXIT END;                      07097000          
              IF TAKE(INDEX).NODIMPART+1 ! PCTR THEN                    07098000          
                   BEGIN ERR(128); GO TO EXIT END;                      07099000          
              STEPIT;                                                   07100000          
              STACKCT ~ 0;                                              07100500          
 EXIT:   END ACTUAL PARAPART;                                           07101000          
 PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM;                    07391000          
         BEGIN                                                          07392000          
              REAL HOLE,ADDRESS;                                        07393000          
              REAL J; LABEL OK;                                         07393100          
              LABEL EXIT;                                               07394000          
              SCATTERELBAT;                                             07395000          
              HOLE~ ELBAT[I];                                           07396000          
              ADDRESS ~ ADDRSF;                                         07397000          
              IF NESTOG THEN                                            07397100          
              IF MODE!0 THEN                                            07397200          
              IF TABLE(I+1)!ASSIGNOP THEN                               07397210          
              BEGIN FOR J~CALLINFO STEP 1 UNTIL CALLX DO                07397300          
                        IF CALL[J]=ADDRESS THEN GO TO OK;               07397400          
                   CALL[CALLX~CALLX+1]~ADDRESS;                         07397500          
    OK:       END;                                                      07397600          
              CHECKER(HOLE);                                            07398000          
              IF ELCLASS ! PROCID THEN                                  07399000          
              IF NOT FORMALF THEN                                       07400000          
              IF TABLE(I+1) = ASSIGNOP THEN                             07401000          
                   BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END;        07402000          
    COMMENT  CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION;         07403000          
              IF ELCLASS ! PROCID EQV FROM                              07404000          
                   THEN BEGIN ERR(159); GO TO EXIT END;                 07405000          
    COMMENT   IT IS PROCEDURE IF AND ONLY WE COME FROM STMT;            07406000          
              STEPIT;                                                   07407000          
              EMITO(MKS);                                               07408000          
              IF ELCLASS = LEFTPAREN                                    07409000          
                   THEN ACTUALPARAPART(FALSE,GIT(HOLE))                 07410000          
                   ELSE IF FORMALF THEN L ~ L-1                         07411000          
                     ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000          
              EMITV(ADDRESS);                                           07413000          
 EXIT:   END  PROCSTMT;                                                 07425000          
 PROCEDURE STRMPROCSTMT;                                                07426000          
         BEGIN REAL WHOLE,FIX,T1;                                       07427000          
                                                                        07428000          
                                                                        07429000          
              WHOLE ~ ELBAT[I]; FIX ~ -1;                               07430000          
              IF ELCLASS ! STRPROCID THEN EMIT(0);                      07431000          
              IF WHOLE. LVL  ! 1 THEN                                   07432000          
                   BEGIN FIX ~ L; L ~ L+1 END;                          07433000          
              EMITO(MKS);                                               07434000          
              T1 ~ TAKEFRST.[1:6];                                      07435000          
              FOR GT1 ~ 1 STEP 1 UNTIL T1 DO EMIT(0);                   07436000          
              IF STEPI ! LEFTPAREN THEN ERR(128)                        07437000          
              ELSE BEGIN ACTUALPARAPART(TRUE,GIT(WHOLE));               07438000          
                   IF FIX < 0 THEN EMITV(WHOLE.ADDRESS)                 07439000          
                   ELSE BEGIN T1 ~ L; L ~ FIX;                          07440000          
                        WHOLE ~ TAKE(GIT(WHOLE));                       07441000          
                        EMITNUM(T1+2-WHOLE.[16:12]);                    07442000          
                        L ~ T1;                                         07443000          
                        EMITB(BBW,BUMPL,WHOLE.[28:12]);                 07444000          
                   END;                                                 07445000          
         END END STRMPROCSTMT;                                          07446000          
 INTEGER PROCEDURE BAE;                                                 07458000          
              BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE;         07459000          
 COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT;                      07460000          
 COMMENT DOSTMT HANDLES THE DO STATEMENT;                               07481000          
 PROCEDURE DOSTMT;                                                      07482000          
              BEGIN INTEGER TL;                                         07483000          
              FOULED ~ L;                                               07483500          
                                                                        07484000          
                   STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000          
                   ELSE BEGIN                                           07486000          
                     STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END              07487000          
              END DOSTMT;                                               07488000          
 COMMENT  WHILESTMT COMPILES THE WHILE STATEMENT;                       07489000          
 PROCEDURE WHILESTMT;                                                   07490000          
         BEGIN INTEGER BACK,FRONT;                                      07491000          
              FOULED ~ L;                                               07491500          
                                                                        07492000          
              STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL;                    07493000          
              IF ELCLASS ! DOV THEN ERR(132) ELSE                       07494000          
                BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK);              07495000          
                   CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000          
 COMMENT  GOSTMT COMPILES GO TO STATEMENTS.  GOSTMT LOOKS AT THE        07497000          
              EXPRESSION.  IF IT IS SIMPLE ENOUGH WE GO DIRECTLY.       07498000          
              OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET  07499000          
              STORAGE RETURNED.  SEE DEXP AND GENGO;                    07500000          
 PROCEDURE GOSTMT;                                                      07501000          
         BEGIN                                                          07502000          
              REAL ELBW;                                                07503000          
              LABEL GOMCP,EXIT;                                         07504000          
              IF STEPI = TOV THEN STEPIT;                               07505000          
              IF ELCLASS = LABELID THEN TB1 ~ TRUE                      07506000          
              ELSE IF ELCLASS = SWITCHID THEN TB1 ~ FALSE               07507000          
              ELSE BEGIN IF ELCLASS = POLISHV THEN                      07511000          
                        BEGIN POLISHER(1); EMITO(BFW) END               07512000          
                        ELSE ERR(501);                                  07513000          
                        GO TO EXIT                                      07514000          
                   END;                                                 07515000          
              IF NOT LOCAL(ELBAT[I]) THEN                               07516000          
                   BEGIN                                                07516100          
                        IF TB1 THEN                                     07516200          
                             BEGIN EMITV(GNAT(ELBAT[I]));               07516300          
                                  EMITO(BFW);                           07516400          
                                  STEPIT;                               07516500          
                                  GO TO EXIT END;                       07516600          
                   BEGIN ERR(501); GO TO EXIT END;                      07517000          
                   END;                                                 07517500          
              IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT;            07518000          
                   CONSTANTCLEAN; GO EXIT END                           07519000          
              ELSE BEGIN                                                07520000          
                   ELBW ~ ELBAT[I];                                     07521000          
                                                                        07522000          
                   BANA;                                                07523000          
                   EMITO(DUP);                                          07524000          
                   EMITO(ADD);                                          07525000          
                        EMITO(BFW);                                     07526000          
                   GT3 ~ TAKE(GT4~GIT(ELBW))+GT4;                       07527000          
                   FOR GT4 ~ GT4+1 STEP 1 UNTIL GT3 DO                  07528000          
                        GOGEN(TAKE(GT4),BFW);                           07529000          
              END;                                                      07530000          
 EXIT: END GOSTMT;                                                      07531000          
 PROCEDURE GOGEN(LABELBAT,BRANCHTYPE);                                  07535000          
              VALUE LABELBAT,BRANCHTYPE;                                07536000          
              REAL LABELBAT,BRANCHTYPE;                                 07537000          
              BEGIN                                                     07538000          
                IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1]           07539000          
                  THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12])              07540000          
    COMMENT  LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL    07541000          
              NEGATIVE WHEN THE LABEL IS ENCOUNTERED.  SO THIS MEANS    07542000          
              THAT WE NOW KNOW WHERE TO GO;                             07543000          
                   ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE);              07544000          
                   PUT(GT1&L[36:36:12],GT2) END END GOGEN;              07545000          
 COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE.  IT DETERMINES IF  07546000          
              A STATEMENT IS A SIMPLE GO TO STATEMENT;                  07547000          
 BOOLEAN PROCEDURE SIMPGO;                                              07548000          
         BEGIN LABEL EXIT;                                              07549000          
              IF ELCLASS = GOV                                          07550000          
                THEN BEGIN                                              07551000          
                   IF STEPI = TOV THEN STEPIT;                          07552000          
                   IF ELCLASS = LABELID THEN                            07553000          
                   IF LOCAL(ELBAT[I]) THEN                              07554000          
                      BEGIN SIMPGO ~ TRUE; GO EXIT END;                 07555000          
                        I ~ I-1; ELCLASS ~ GOV END;                     07556000          
  EXIT:  END SIMPGO;                                                    07557000          
 COMMENT IFSTMT COMPILES IF STATEMENTS.  SPECIAL CARE IS TAKEN TO       07558000          
              OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS.  TO SOME  07559000          
              EXTENT SUPPERFULOUS BRANCHING IS AVOIDED;                 07560000          
 PROCEDURE IFSTMT;                                                      07561000          
         BEGIN REAL T1,T2; LABEL EXIT;                                  07562000          
              IFCLAUSE;                                                 07563000          
              IF SIMPGO                                                 07564000          
                THEN BEGIN                                              07565000          
                   T1 ~ ELBAT[I];                                       07566000          
              IF STEPI = ELSEV                                          07567000          
                     THEN BEGIN                                         07568000          
                        STEPIT;                                         07569000          
                        IF SIMPGO                                       07570000          
                          THEN BEGIN                                    07571000          
                            GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW);         07572000          
              STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC);  07573000          
                   STMT ; GO TO EXIT  END END ;                         07574000          
                   EMITLNG; GOGEN(T1,BFC);                              07575000          
                   GO EXIT END;                                         07576000          
              T1 ~ BUMPL; STMT;                                         07577000          
              IF ELCLASS ! ELSEV THEN                                   07578000          
                BEGIN IF L-T1>1023 THEN ADJUST; EMITB(BFC,T1,L);        07579000          
                             GO EXIT END;                               07579100          
              STEPIT;                                                   07580000          
              IF SIMPGO                                                 07581000          
                THEN BEGIN                                              07582000          
                   T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2;         07583000          
                   STEPIT; GO EXIT END;                                 07584000          
              T2 ~ BUMPL; CONSTANTCLEAN;                                07585000          
              IF L-T1>1023 THEN ADJUST; EMITB(BFC,T1,L); STMT;          07585100          
              IF L-T2>1023 THEN ADJUST; EMITB(BFW,T2,L);                07586000          
  EXIT:  END  IFSTMT;                                                   07587000          
 COMMENT  LABELR HANDLES LABELED STATEMENTS.  IT PUTS L INTO THE        07588000          
              ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE.  IT COMPILES 07589000          
              AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET  07590000          
              UP FOR IT BY GOGEN.  (THE ADDITIONAL INFO LINKS TO A LIST 07591000          
              IN THE CODE ARRAY OF ALL FORWARD REFERENCES);             07592000          
 PROCEDURE LABELR;                                                      07593000          
         BEGIN LABEL EXIT, ROUND;                                       07594000          
DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL                   07595000          
                   =GT4#,NEXTLINK=GT5#;                                 07596000          
              REAL OLDL;                                                07596500          
              DO BEGIN OLDL ~ L;                                        07597000          
                   IF STEPI ! COLON THEN                                07597500          
                        BEGIN ERR(133); GO TO EXIT END;                 07598000          
                   IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1])                 07599000          
                     THEN BEGIN FLAG(134); GO TO ROUND END;             07600000          
                   IF STEPI = COLON THEN                                07600100          
                        BEGIN I ~ I-1; ADJUST END ELSE                  07600200          
                   IF ELCLASS = LITNO THEN L ~ 4|C ELSE                 07600300          
                   IF ELCLASS=ASTRISK THEN                              07600400          
                        BEGIN IF MODE ! 0 OR ASTOG THEN                 07600410          
                             FLAG(505);                                 07600420          
                             ASTOG ~ TRUE;                              07600430          
                             L ~ 4|PRTI;                                07600440          
                        END ELSE                                        07600450          
                   I ~ I-2;                                             07600500          
                   IF STEPI ! COLON THEN                                07600600          
                        BEGIN ERR(133); GO TO EXIT END;                 07600700          
                   IF L < OLDL THEN                                     07600800          
                        BEGIN FLAG(504); GO TO ROUND END;               07600900          
              GT1 ~ TABLE(I+1);                                         07600950          
                   LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD)))   07601000          
                         .[36:12];                                      07602000          
                   IF ADDITIONAL < 0 THEN                               07603000          
                       BEGIN FLAG(135); GO TO ROUND END;                07604000          
                   FOULED ~ L;                                          07604010          
                   IF TABLE(I+1) = COLON THEN                           07604020          
                        BEGIN                                           07604030          
                             IF LINK!0 THEN BEGIN OLDL ~ L;             07604040          
                             DO BEGIN  NEXTLINK ~ GET(LINK);            07604050          
                                       L ~ LINK;                        07604060          
                                       IF OLDL.[36:10]-L.[36:10]}128    07604067          
                                       THEN FLAG(50) ELSE               07604068          
                                      EMIT(OLDL-LINK&0[46:46:2]+        07604070          
                                            0&NEXTLINK[46:46:2]+3072);  07604080          
                                       L ~ L-1;                         07604085          
                                 END UNTIL LINK~LINK-NEXTLINK DIV 4=L;  07604090          
                             L ~ OLDL; END; STEPIT;                     07604100          
                             DO IF STEPI { STRNGCON AND ELCLASS }       07604110          
                                  NONLITNO THEN EMITWORD(C)             07604120          
                                  ELSE BEGIN ERR(500); I ~ I-1 END      07604130          
                             UNTIL STEPI ! COMMA;                       07604140          
                             I ~ I-1 ;                                  07604150          
                        END ELSE                                        07604160          
                   WHILE LINK ! 0                                       07605000          
                     DO BEGIN                                           07606000          
                        NEXTLINK ~ GET(LINK-2);                         07607000          
                        IF L-LINK>1023 THEN ADJUST;                     07607100          
                       EMITB(GET(LINK-1),LINK,L);                       07608000          
                        LINK ~ NEXTLINK END;                            07609000          
                   PUT(-ADDITIONAL&L[36:36:12],INDEX);                  07610000          
 ROUND:       ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID;                07645000          
   EXIT: END LABELR;                                                    07646000          
PROCEDURE FILLSTMT(SIZE); VALUE SIZE; INTEGER SIZE;                     07647000          
    BEGIN                                                               07647500          
COMMENT  "COCT" PERFORMS THE OCTAL CONVERT FOR THE FILL STATEMENT.      07648000          
         IF THERE ARE ANY NON-OCTAL DIGITS, THIS PROCEDURE RETURNS      07648500          
         A ZERO AND THEN THE 3 LOW-ORDER BITS OF THE BAD DIGIT ARE      07649000          
         RESET AND IGNORED AND ERROR NUMBER 303 IS PRINTED. "COCT"      07649500          
         ALLOWS FLAG BITS TO BE SET, WHEREAS "OCTIZE" DOES NOT.         07650000          
           N       NUMBER OF CHARACTERS TO BE CONVERTED.                07650500          
           SKBIT   NUMBER OF BITS TO SKIP BEFORE STARTING CONVERSION.   07651000          
                   THIS IS BECAUSE THE NO. OF CHARS. MAY BE LESS THAN   07651500          
                   8 AND IT MUST BE RIGHT JUSTIFIED IN CD(CODEFILE).    07652000          
           ACC     ADDRESS OF THE ACCUM WHERE ALPHA INFO IS KEPT.       07652500          
 ;                                                                      07653000          
    REAL STREAM PROCEDURE COCT(N,SKBIT,ACC,CD);VALUE N,SKBIT;           07653500          
         BEGIN                                                          07654000          
         SI:=ACC; SI:=SI+6;  DI:=CD;  DS:=8 LIT"00000000";              07654500          
         DI:=CD ; SKIP SKBIT DB;TALLY:=1;                               07655000          
         N(IF SC>"7"THEN TALLY:=0; SKIP 3 SB;                           07655500          
           3(IF SB   THEN DS:=1 SET ELSE SKIP 1 DB; SKIP 1 SB));        07656000          
         COCT:=TALLY                                                    07656500          
         END COCT;                                                      07657000          
    REAL T2;                                                            07657500          
    LABEL L1;                                                           07658000          
    STREAM PROCEDURE ZEERO(D);                                          07658500          
         BEGIN                                                          07659000          
         DI:=D;DS:=8 LIT"00000000";                                     07659500          
         SI:=D;31(32(DS:=WDS)); DS:=30 WDS;                             07660000          
         END ZEERO;                                                     07660500          
    STREAMTOG:=BOOLEAN(2);                                              07661000          
    SEGMENTSTART(TRUE);                                                 07661500          
    IF STEPI!ASSIGNOP THEN ZEERO(CODE(1))                               07662000          
ELSE     BEGIN                                                          07662500          
         FOR T2:=1 STEP 1 UNTIL SIZE DO                                 07663000          
              BEGIN                                                     07663500          
              IF STEPI>IDMAX THEN                                       07664000          
                   BEGIN                                                07664500          
                   IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN           07665000          
                     IF ELCLASS!STRNGCON THEN                           07665500          
                       IF ELCLASS=ADOP AND                              07666000          
                         (STEPI=NONLITNO OR ELCLASS=LITNO) THEN         07666500          
                           C:=C & ELBAT[I-1][1:21:1]                    07667000          
                  ELSE      BEGIN  ERROR(302); GO TO L1  END;           07667500          
                   IF ELCLASS=STRNGCON AND COUNT=8 THEN                 07668000          
                     MOVECHARACTERS(8,ACCUM[1],3,CODE(T2),0)            07668500          
              ELSE MOVE(1,C,CODE(T2))                                   07669000          
                   END                                                  07669500          
         ELSE IF COUNT{19 AND ACCUM[1].[18:18]="OCT" THEN               07670000          
                   BEGIN                                                07670500          
                   IF COCT(COUNT-3,48-(COUNT-3)|3,ACCUM[1],             07671000          
                     CODE(T2))=0 THEN FLAG(303)                         07671500          
                   END                                                  07672000          
              ELSE BEGIN  ERROR(302); GO TO L1  END;                    07672500          
              IF STEPI!COMMA THEN GO TO L1                              07673000          
              END;                                                      07673500          
         ERROR(54);                                                     07674000          
         END;                                                           07674500          
L1:                                                                     07675000          
    RIGHT(SIZE|4);                                                      07675500          
    STREAMTOG:=FALSE;                                                   07676000          
    SEGMENT(SIZE,0);                                                    07676500          
    PROGDESCBLDR(ADDRSF,TRUE,SIZE,DDES);                                07677000          
    END FILLSTMT;                                                       07677500          
 PROCEDURE STMT;                                                        07711000          
         BEGIN LABEL                                                    07712000          
              L1,  L2,  L3,  L4,  L5,  L6,  L7,  L8,  L9,  L10,         07713000          
              L11, L12, L13, L14, L15, L16, L17, L18, L19, L20,         07714000          
              L21, L22, L23, L24, L25, L26, L27, L28, L29, L30,         07715000          
              L31, L32, L33, L34, L35, L36, L37, L38, L39, L40,         07716000          
              L41, L42, L43, L44, L45, L46, L47, L48, L49, L50,         07717000          
              L51, L52, L53, L54;                                       07718000          
              SWITCH S ~                                                07719000          
              L1,  L2,  L3,  L4,  L5,  L6,  L7,  L8,  L9,  L10,         07720000          
              L11, L12, L13, L14, L15, L16, L17, L18, L19, L20,         07721000          
              L21, L22, L23, L24, L25, L26, L27, L28, L29, L30,         07722000          
              L31, L32, L33, L34, L35, L36, L37, L38, L39, L40,         07723000          
              L41, L42, L43, L44, L45, L46, L47, L48, L49, L50,         07724000          
              L51, L52, L53, L54;                                       07725000          
              LABEL AGAIN,EXIT;                                         07726000          
              STACKCT ~ 0;                                              07726990          
    AGAIN:    GO TO S[ELCLASS];                                         07727000          
              IF ELCLASS = COLON THEN                                   07727010          
                   BEGIN STEPIT; GT1 ~ L;                               07727020          
                        IF ELCLASS = COLON THEN                         07727030          
                             BEGIN ADJUST; I ~ I-1 END                  07727040          
                        ELSE IF ELCLASS = LITNO THEN L ~ 4|C            07727050          
                        ELSE I ~ I-1;                                   07727060          
                        IF L < GT1 OR STEPI ! COLON THEN                07727070          
                             BEGIN ERR(504); GO TO EXIT END;            07727080          
                        STEPIT;                                         07727090          
                        GO TO AGAIN;                                    07727100          
                   END;                                                 07727110          
              IF ELCLASS = 0 THEN FLAG(100); FLAG(145);                 07728000          
 L1:L2:L3:L4:L5:L6:L9:L11:L13:L14:L15:L16:L17:L20:L21:L25:L28:L29:L24:  07729000          
 L33:L34:L35:L36:L37:L39:                                               07730000          
              ERR(144); GO TO EXIT;                                     07731000          
    L7:L8:                                                              07732000          
              SUBHAND(TRUE); GO TO EXIT;                                07733000          
    L10:L18:L19:                                                        07734000          
              PROCSTMT(TRUE); GO TO EXIT;                               07735000          
    L12:                                                                07736000          
              STRMPROCSTMT; GO TO EXIT;                                 07737000          
    L22:L23:L26:L27:L30:L31:                                            07738000          
              VARIABLE(FS); GO TO EXIT;                                 07739000          
    L32:                                                                07740000          
              LABELR; GO TO AGAIN;                                      07741000          
    L38:                                                                07742000          
              POLISHER(0); GO TO EXIT;                                  07743000          
    L40:                                                                07744000          
              IF ELBAT[I].ADDRESS = STREAMV THEN                        07745000          
                   BEGIN INLINE; GO TO EXIT END;                        07746000          
              FLAG(146);                                                07747000          
              IF TABLE(I-2) = ENDV AND MODE > 0 THEN                    07748000          
                   BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END;       07749000          
              I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE);                   07750000          
              ELCLASS ~ TABLE(I~I-1); GO TO EXIT;                       07751000          
    L42:                                                                07752000          
              DBLSTMT; GO TO EXIT;                                      07753000          
    L43:                                                                07754000          
              FORSTMT; GO TO EXIT;                                      07755000          
    L44:                                                                07756000          
              WHILESTMT; GO TO EXIT;                                    07757000          
    L45:                                                                07758000          
              DOSTMT; GO TO EXIT;                                       07759000          
    L51:                                                                07760000          
              IFSTMT; GO TO EXIT;                                       07761000          
    L52:                                                                07762000          
              GOSTMT; GO TO EXIT;                                       07763000          
    L53:                                                                07764000          
              IOSTMT; GO TO EXIT;                                       07765000          
    L54:                                                                07766000          
              IF STEPI = DECLARATORS THEN                               07767000          
          BEGIN                                                         07768000          
               IF ELBAT[I].ADDRESS = STREAMV THEN IF STEPI =        % 6 07768100          
                 LEFTPAREN THEN                                     % 6 07768110          
          BEGIN                                                     % 6 07768120          
               ELCLASS~TABLE(I~I-1) ;                                   07768130          
               COMPOUNDTAIL ;                                           07768140          
               GO TO EXIT ;                                             07768160          
          END  ELSE I ~ I - 1;                                      % 6 07768170          
               I ~ I - 1;                                           % 6 07768180          
               BLOCK(FALSE);    END ELSE COMPOUNDTAIL;                  07768200          
 L46:L47:L48:L50:                                                       07769000          
 L49:L41:                                                               07770000          
 EXIT: END STMT;                                                        07771000          
                                                                        07991000          
 PROCEDURE IOSTMT;                                                      07993000          
         IF STEPI ! LITNO OR (GT1~ELBAT[I].ADDRESS)>15 THEN ERR(98)ELSE 07994000          
         BEGIN EMIT(ELBAT[I-1].ADDRESS&GT1[41:47:1]&GT1[36:44:3]);      07995000          
              STEPIT                                                    07996000          
         END SCOPE STATEMENT;                                           07997000          
 PROCEDURE FORSTMT;                                                     08008000          
         BEGIN                                                          08009000          
          OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET,          08010000          
                   BRET;                                                08011000          
         OWN BOOLEAN SIGNA,SIGNB,SIGNC, INT,                            08012000          
                   CONSTANA,CONSTANB,CONSTANC;                          08013000          
              DEFINE SIMPLEB = SIGNC#,          FORMALV = SIGNA#,       08014000          
                     SIMPLEV = CONSTANA#, A = V#, Q = REGO#,            08015000          
                     OPDC = TRUE#, DESC = FALSE#, K = BRET#;            08016000          
              LABEL EXIT;                                               08017000          
 COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 08018000          
              CONSTANT DEPENDING ON THE REQUIREMENTS;                   08019000          
 PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C;                     08020000          
              IF C THEN EMITNUM(A) ELSE EMITV(A.ADDRESS);               08021000          
 COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A      08022000          
              CONSTANT OR A SIMPLE VARIABLE.  IT MAKES A THROUGH REPORT 08023000          
              ON ITS ACTIVITY.  IT ALSO MAKES PROVISION FOR THE RESCAN  08024000          
              OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE     08025000          
              TABLE ROUTINE FOR FURTHER DETAILS);                       08026000          
 BOOLEAN PROCEDURE SIMPLE(B,A,S); BOOLEAN B,S; REAL A;                  08027000          
              BEGIN                                                     08028000          
                   S ~ IF STEPI ! ADOP THEN FALSE ELSE ELBAT[I].ADDRESS 08029000          
                                      = SUB;                            08030000          
                   IF ELCLASS = ADOP THEN STEPIT;                       08031000          
                   IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON         08032000          
                     THEN BEGIN K ~ K+1; SIMPLE ~ TRUE;                 08033000          
                        ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11];      08034000          
                        INFO[0,K] ~ A ~ C; B ~ TRUE END                 08035000          
                   ELSE BEGIN                                           08036000          
                    B ~ FALSE; A ~ ELBAT[I];                            08037000          
                    SIMPLE ~ REALID { ELCLASS AND ELCLASS { INTID END;  08038000          
              STEPIT END SIMPLE;                                        08039000          
 COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST;                        08040000          
 PROCEDURE TEST;                                                        08041000          
         BEGIN                                                          08042000          
              IF NOT CONSTANB THEN                                      08043000          
                BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS)      08044000          
                   ELSE BEGIN                                           08045000          
                     EMITL(2+L-BRET);                                   08046000          
                     EMITB(BBW,BUMPL,B);                                08047000          
                   END;                                                 08048000          
                   EMITO(MUL); EMIT(0) END;                             08049000          
                   EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1   08050000          
         END TEST;                                                      08051000          
 BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL;                     08052000          
         BEGIN                                                          08053000          
              CHECKER(VRET~ALL);                                        08054000          
              ADDRES ~ ALL.ADDRESS;                                     08055000          
              FORMALV ~ ALL.[9:2] = 2;                                  08056000          
              IF T ~ ALL.CLASS > INTARRAYID OR T < BOOID OR             08057000          
                 GT1 ~ (T-BOOID) MOD 4 < 1 THEN                         08058000          
                   ERR(REAL(T ! 0) | 51 + 100);                         08059000          
              INT ~ GT1 = 2;                                            08060000          
              SIMPI ~ T { INTID END SIMPI;                              08061000          
 COMMENT  STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX;        08062000          
 PROCEDURE STORE(S); VALUE S; BOOLEAN S;                                08063000          
              BEGIN                                                     08064000          
                IF FORMALV THEN BEGIN EMITO(XCH); S ~ FALSE END         08065000          
                 ELSE BEGIN                                             08066000          
                   EMITL(ADDRES);                                       08067000          
                   IF ADDRES  > 1023 THEN EMITO(PRTE) END;              08068000          
                    T  ~ (REAL(S)+1)|16;                                08069000          
                   EMITO((IF INT THEN T+512 ELSE 4|T)+4) END STORE;     08070000          
 COMMENT CALL EFFECTS A CALL ON THE INDEX;                              08071000          
 PROCEDURE CALL(S); VALUE S; BOOLEAN S;                                 08072000          
              BEGIN                                                     08073000          
               IF SIMPLEV                                               08074000          
                 THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES)        08075000          
                 ELSE BEGIN                                             08076000          
                   EMITL(2+L-VRET);                                     08077000          
                   EMITB(BBW,BUMPL,V);                                  08078000          
                   IF S THEN EMITO(LOD) END END CALL;                   08079000          
 PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE;                  08080000          
         BEGIN                                                          08081000          
 PROCEDURE FIX(STORE,BACK,FORWART,START);                               08082000          
         VALUE STORE,BACK,FORWART,START;                                08083000          
         REAL  STORE,BACK,FORWART,START;                                08084000          
         BEGIN                                                          08085000          
              EMITB(GET(FORWART-1),FORWART,START);                      08086000          
              IF RETURNSTORE ! 0                                        08087000          
                THEN BEGIN                                              08088000          
                   L ~ STORE; EMITNUM(B-BACK);                          08089000          
                   EMITPAIR(RETURNSTORE,STD) END END FIX;               08090000          
              INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX;           08091000          
              LABEL BRNCH,EXIT;                                         08092000          
              STOREFIX ~ L; Q ~ REAL(MODE=0)+3;                         08093000          
              FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP);                   08094000          
              IF NUMLE                                                  08095000          
               THEN BEGIN                                               08096000          
                   BACKFIX ~ L;                                         08097000          
                   IF FORMALV THEN CALL(DESC) END                       08098000          
               ELSE BACKFIX ~ V + REAL(SIMPLEV)-1;                      08099000          
                                                                        08100000          
              AEXP;                                                     08101000          
    COMMENT   PICK UP FIRST ARITHMETIC EXPRESSION;                      08102000          
              IF  ELCLASS = STEPV                                       08103000          
                 THEN BEGIN                                             08104000          
    COMMENT   HERE WE HAVE A STEP ELEMENT;                              08105000          
                   BACKFIX ~ BUMPL;                                     08106000          
    COMMENT   LEAVE ROOM FOR FORWARD JUMP;                              08107000          
                   IF FORMALV THEN CALL(DESC); CALL(OPDC);              08108000          
    COMMENT   FETCH INDEX;                                              08109000          
                   IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END          08110000          
                       ELSE REGO ~ I;                                   08111000          
                   IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND            08112000          
                    (ELCLASS = UNTILV OR ELCLASS = WHILEV)              08113000          
                     THEN BEGIN                                         08114000          
    COMMENT   WE HAVE A SIMPLE STEP FUNCTION;                           08115000          
                       PLUG(CONSTANB ,B);                               08116000          
                     END ELSE BEGIN                                     08117000          
    COMMENT   THE STEP FUNCTION IS NOT SIMPLE:  WE CONSTRUCT A          08118000          
                   SUBROUTINE;                                          08119000          
                       I ~ IF I < 4 THEN 0 ELSE REGO; STEPIT;           08120000          
                       SIGNB ~ CONSTANB ~ FALSE;                        08121000          
                       EMIT(0); B ~ L;                                  08122000          
                       AEXP; EMITO(XCH);                                08123000          
                       BRET ~ L;                                        08124000          
                       EMITO(BFW) END;                                  08125000          
                   EMITO(REAL(SIGNB)|32+ADD);                           08126000          
                   EMITB(BFW,BACKFIX,L);                                08127000          
                   IF ELCLASS = UNTILV                                  08128000          
                     THEN BEGIN  COMMENT  STEP-UNTIL ELEMENT;           08129000          
                        STORE(TRUE); IF FORMALV THEN CALL(OPDC);        08130000          
                        STEPIT; AEXP; TEST END                          08131000          
                     ELSE BEGIN  COMMENT  STEP-WHILE ELEMENT;           08132000          
                        IF ELCLASS ! WHILEV THEN                        08133000          
                          BEGIN ERR(153); GO TO EXIT END;               08134000          
                        STEPIT; STORE(FALSE); BEXP END END              08135000          
                 ELSE BEGIN                                             08136000          
    COMMENT   WE DO NOT HAVE A STEP ELEMENT;                            08137000          
                   STORE(FALSE);                                        08138000          
                   IF ELCLASS = WHILEV                                  08139000          
                     THEN BEGIN                                         08140000          
    COMMENT   WE HAVE A WHILE ELEMENT;                                  08141000          
                        STEPIT; BEXP END                                08142000          
                     ELSE BEGIN                                         08143000          
    COMMENT   ONE EXPRESSION ELEMENT;                                   08144000          
                       IF ELCLASS ! COMMA THEN BEGIN                    08145000          
                            EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END       08146000          
                        ELSE BACKFIX ~ L + 2;                           08147000          
                       L ~ L+1; EMIT(BFW); GO TO BRNCH END END;         08148000          
    COMMENT   THIS IS THE COMMON POINT;                                 08149000          
              IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1;                 08150000          
              EMIT(BFC);                                                08151000          
 BRNCH:       FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0;                     08152000          
              IF ELCLASS = COMMA                                        08153000          
                THEN BEGIN                                              08154000          
                   STEPIT;                                              08155000          
                   FORLIST(TRUE);                                       08156000          
                   FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END    08157000          
                ELSE BEGIN                                              08158000          
                   IF ELCLASS ! DOV                                     08159000          
                        THEN BEGIN ERR(154); REGO~L; GO EXIT END;       08160000          
                   STEPIT;                                              08161000          
                   IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP.    08162000          
              STMT;                                                     08163000          
                                                                        08164000          
                   IF NUMLE THEN BEGIN                                  08165000          
                     EMITV(RETURNSTORE ~ FOOT); EMITO(BBW) END          08166000          
                   ELSE BEGIN                                           08167000          
                     EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END;     08168000          
                   STMTSTART ~ FORWARDBRANCH; B ~ L;                    08169000          
                   CONSTANTCLEAN; REGO ~ L;                             08170000          
                   FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END;           08171000          
 EXIT:        END FORLIST;                                              08172000          
 REAL T1,T2,T3,T4;                                                      08173000          
              NXTELBT ~ 1; I ~ 0;                                       08174000          
              STEPIT;                                                   08175000          
              IF SIMPI(VRET~ELBAT[I])                                   08176000          
                THEN BEGIN                                              08177000          
                   IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000          
                   T1 ~ L; IF FORMALV THEN EMITN(ADDRES);               08179000          
                   K ~ 0;                                               08180000          
                   IF SIMPLE(CONSTANA,A,SIGNA) THEN                     08181000          
                   IF ELCLASS = STEPV THEN                              08182000          
                   IF SIMPLE(CONSTANB,B,SIGNB) THEN                     08183000          
                   IF ELCLASS = UNTILV THEN                             08184000          
                   IF SIMPLE(CONSTANC,Q,SIGNC) THEN                     08185000          
                   IF ELCLASS = DOV THEN                                08186000          
                     BEGIN                                              08187000          
                        PLUG(CONSTANA,A);                               08188000          
                        IF SIGNA THEN EMITO(CHS);                       08189000          
                        RETURNSTORE  ~ BUMPL; ADJUST; CONSTANTCLEAN;    08190000          
                        STMTSTART ~ L;                                  08191000          
              STEPIT;                                                   08192000          
              T1 ~ ((((4096 | RETURNSTORE+STMTSTART)|2+                 08193000          
                   REAL(CONSTANB))|2+                                   08194000          
                   REAL(CONSTANC))|2+                                   08195000          
                   REAL(SIGNB))|2+                                      08196000          
                   REAL(SIGNC);                                         08197000          
              T2 ~ VRET;                                                08198000          
              T3 ~ B;                                                   08199000          
              T4 ~ Q;                                                   08200000          
              STMT;                                                     08201000          
              SIGNC ~ BOOLEAN(T1.[47:1]);                               08202000          
              SIGNB ~ BOOLEAN(T1.[46:1]);                               08203000          
              CONSTANC ~ BOOLEAN(T1.[45:1]);                            08204000          
              CONSTANB ~ BOOLEAN(T1.[44:1]);                            08205000          
              STMTSTART ~ T1.[32:12];                                   08206000          
              RETURNSTORE ~ T1.[20:12];                                 08207000          
              VRET ~ T2;                                                08208000          
              B ~ T3;                                                   08209000          
              Q ~ T4;                                                   08210000          
              SIMPLEV~ SIMPI(VRET);                                     08211000          
                        IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES);   08212000          
                        PLUG(CONSTANB,B);                               08213000          
                        EMITO(IF SIGNB THEN SUB ELSE ADD);              08214000          
                        EMITB(BFW,RETURNSTORE,L);                       08215000          
                        STORE(TRUE);                                    08216000          
                        IF FORMALV THEN CALL(OPDC);                     08217000          
                        PLUG(CONSTANC,Q);                               08218000          
                        IF SIGNC THEN EMITO(CHS);                       08219000          
                       SIMPLEB ~ TRUE; TEST; EMITLNG;                   08220000          
                       EMITB(BBC,BUMPL,STMTSTART);                      08221000          
                       GO TO EXIT END;                                  08222000          
                   I ~ 2; K ~ 0;                                        08223000          
                   SIMPLEV ~ SIMPI(VRET);                               08224000          
                   V ~ T1 END                                           08225000          
                ELSE BEGIN                                              08226000          
                   EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE;     08227000          
                   VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW);      08228000          
                   IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000          
                   END;                                                 08230000          
                STEPIT; FORLIST(FALSE); L ~ REGO;                       08231000          
  EXIT:  K ~ 0 END FORSTMT;                                             08232000          
REAL PROCEDURE REED;                                                    08999000          
    BEGIN                                                               08999025          
    LABEL EOF; INTEGER I,J,K;                                           08999050          
    STREAM PROCEDURE MOVE(N,F,T); VALUE N,T;                            08999075          
         BEGIN  SI:=F; DI:=T; DS:=N WDS  END MOVE;                      08999100          
    J:=-1;                                                              08999125          
    READ(CODISK[NO])[EOF];                                              08999150          
    REED:=I:=FETCH(MKABS(CODISK(1)));                                   08999175          
    K:=MKABS(CODE(0))-1;                                                08999200          
    WHILE I-J>30 DO                                                     08999225          
         BEGIN                                                          08999250          
         MOVE(30,CODISK(0),K); K:=K+30; J:=J+30;                        08999275          
         READ(CODISK);                                                  08999300          
         END;                                                           08999325          
    MOVE(I-J,CODISK(0),K);                                              08999350          
    READ(CODISK)[EOF];                                                  08999375          
EOF:                                                                    08999400          
END REED;                                                               08999425          
PROCEDURE RIGHT(L); VALUE L; INTEGER L;                                 08999450          
    BEGIN                                                               08999475          
    INTEGER I,J;                                                        08999500          
    I:=(L+7) DIV 4;                                                     08999525          
    MOVE(1,I,CODISK(0));                                                08999550          
    MOVE(29,CODE(0),CODISK(1));                                         08999575          
    WRITE(CODISK);                                                      08999600          
    J:=29;                                                              08999625          
    WHILE I-J>0 DO                                                      08999650          
         BEGIN                                                          08999675          
         MOVE(30,CODE(J),CODISK(0));                                    08999700          
         WRITE(CODISK);                                                 08999725          
         J:=J+30;                                                       08999750          
         END;                                                           08999775          
    END RIGHT;                                                          08999800          
 COMMENT THE PROGRAM ROUTINE DOES THE INITIALIZATION AND THE WRAPUP     09000000          
         FOR THE REST OF THE COMPILER.  THE MAIN PROGRAM OF THE COMPILER09001000          
         IS SIMPLY A CALL ON THE PROGRAM ROUTINE;                       09002000          
 PROCEDURE PROGRAM;                                                     09003000          
         BEGIN                                                          09004000          
 STREAM PROCEDURE MDESC(WD,TOLOC);VALUE WD;                             09005000          
   BEGIN DI~LOC WD; DS~  SET;SI~ LOC WD; DI~TOLOC;DS~WDS END;           09006000          
              DEFINE STARTINTRSC=426#;                                  09024000          
              LABEL L1;                                                 09025000          
              LISTOG:=LISTER:=BOOLEAN(1-ERRORCOUNT.[46:1]);             09028000          
COMMENT  LISTOG IS NOT SET BY DEFAULT ON TIMESHARING;                   09028010          
              NOHEADING := TRUE;                                        09028050          
              ERRORCOUNT := 0;                                          09028900          
              ERRMAX:=999; % MAY BE CHANGED IN DOLLARCARD.              09028910          
              BASENUM:=10000; ADDVALUE:=1000; NEWBASE:=TRUE;            09028920          
COMMENT  DEFAULT VALUES FOR "$SEQ" OPTION;                              09028930          
              LASTUSED := 4; % FOR INITIALIZATION.                      09029000          
              NEXTINFO ~ LASTINFO ~ LASTSEQROW|256+LASTSEQUENCE+1;      09033000          
              PUTNBUMP(0);                                              09034000          
              GT1 ~ -"       ";                                         09034100          
              MDESC(GT1,INFO[LASTSEQROW,LASTSEQUENCE]);                 09034200          
              BLANKET(0,INFO[LASTSEQROW,LASTSEQUENCE]); % FOR "$ CHECK".09034500          
              READACARD; % INITIALIZATION OF NCR,FCR, AND LCR, AND      09035000          
                         % READS FIRST CARD INTO CARD BUFFER.           09036000          
              LASTUSED := 1; % ASSUMES CARD ONLY UNTIL TOLD DIFFERENTLY.09037000          
              NXTELBT ~ 1;                                              09038000          
              PRTI~PRTIMAX~PRTBASE;                                     09039000          
              MRCLEAN ~ TRUE;                                           09040000          
COMMENT  START FILLING TABLES NEEDED TO COMPILE A PROGRAM;              09040100          
              FILL TEN[*] WITH                                          09041000          
   OCT1771110463422054,    OCT1761332600326467,    OCT1751621340414205, 09042000          
   OCT1742165630517247,    OCT1732623176643120,    OCT1723370036413744, 09043000          
   OCT1714266046116735,    OCT1705343457542525,    OCT1676634373473252, 09044000          
   OCT1651040347241213,    OCT1641250441111455,    OCT1631522551333770, 09045000          
   OCT1622047303622767,    OCT1612461164567564,    OCT1603175421725521, 09046000          
   OCT1574034726313046,    OCT1565044113775657,    OCT1556255136775233, 09047000          
   OCT1547730366574502,    OCT1521171646433362,    OCT1511430220142257, 09048000          
   OCT1501736264172732,    OCT1472325741231521,    OCT1463013331500045, 09049000          
   OCT1453616220020057,    OCT1444561664024072,    OCT1435716241031111, 09050000          
   OCT1427301711237333,    OCT1401116227350722,    OCT1371341675243107, 09051000          
   OCT1361632254513731,    OCT1352200727636717,    OCT1342641115606502, 09052000          
   OCT1333411341150223,    OCT1324313631402270,    OCT1315376577702746, 09053000          
   OCT1306676337663537,    OCT1261045602764047,    OCT1251257143561061, 09054000          
   OCT1241532774515275,    OCT1232061573640554,    OCT1222476132610706, 09055000          
   OCT1213215561353071,    OCT1204061115645707,    OCT1175075341217270, 09056000          
   OCT1166314631463146,    OCT1141000000000000,    OCT1131200000000000, 09057000          
   OCT1121440000000000,    OCT1111750000000000,    OCT1102342000000000, 09058000          
   OCT1073032400000000,    OCT1063641100000000,    OCT1054611320000000, 09059000          
   OCT1045753604000000,    OCT1037346545000000,    OCT1011124027620000, 09060000          
    OCT0001351035564000,    OCT0011643245121000,    OCT0022214116345200,09061000          
    OCT0032657142036440,    OCT0043432772446150,    OCT0054341571157602,09062000          
    OCT0065432127413543,    OCT0076740555316473,    OCT0111053071060221,09063000          
   OCT0121265707274266,    OCT0131543271153343,    OCT0142074147406234, 09064000          
   OCT0152513201307703,    OCT0163236041571663,    OCT0174105452130240, 09065000          
   OCT0205126764556310,    OCT0216354561711772,    OCT0231004771627437, 09066000          
   OCT0241206170175347,    OCT0251447626234641,    OCT0261761573704011, 09067000          
   OCT0272356132665013,    OCT0303051561442216,    OCT0313664115752661, 09068000          
   OCT0324641141345435,    OCT0336011371636745,    OCT0347413670206536, 09069000          
   OCT0361131664625027,    OCT0371360241772234,    OCT0401654312370703, 09070000          
   OCT0412227375067064,    OCT0422675274304701,    OCT0433454553366062, 09071000          
   OCT0444367706263476,    OCT0455465667740415,    OCT0467003245730521, 09072000          
   OCT0501060411731665,    OCT0511274514320242,    OCT0521553637404312, 09073000          
   OCT0532106607305375,    OCT0542530351166674,    OCT0553256443424453, 09074000          
   OCT0564132154331566,    OCT0575160607420123,    OCT0606414751324150, 09075000          
   OCT0621012014361120,    OCT0631214417455344,    OCT0641457523370635, 09076000          
   OCT0651773450267005,    OCT0662372362344606,    OCT0673071057035747, 09077000          
   OCT0703707272645341,    OCT0714671151416632,    OCT0726047403722400, 09078000          
   OCT0737461304707100,    OCT0751137556607072,    OCT0761367512350710, 09079000          
   OCT0771665435043072;                                                 09080000          
COMMENT  THIS IS THE FILL FOR THE SECOND ROW OF INFO:                   09081000          
              THE FIRST ITEMS ARE STREAM RESERVED WORDS,                09082000          
              THEN ORDINARY RESERVED WORDS,                             09083000          
              THEN INTRINSIC FUNCTIONS;                                 09084000          
 FILL INFO[1,*] WITH                                                    09085000          
    OCT0670000600000002, "2SI000",                           %256       09086000          
    OCT0700001040000002, "2DI000",                           %258       09087000          
    OCT0710001460000002, "2CI000",                           %260       09088000          
    OCT0720001630000002, "5TALLY",                           %262       09089000          
    OCT0730000530000002, "2DS000",                           %264       09090000          
    OCT0740000150000002, "4SKIP0",                           %266       09091000          
    OCT0750001620000002, "4JUMP0",                           %268       09092000          
    OCT0760000740000002, "2DB000",                           %270       09093000          
    OCT0770000500000002, "2SB000",                           %272       09094000          
    OCT1010000730000002, "2SC000",                           %274       09095000          
    OCT1020001160000002, "3LOC00",                           %276       09096000          
    OCT1030001170000002, "2DC000",                           %278       09097000          
    OCT1040001430000002, "5LOCAL",                           %280       09098000          
    OCT1050000340000002, "3LIT00",                           %282       09099000          
    OCT1060001036400002, "3SET00",                           %284       09100000          
    OCT1060001066500002, "5RESET",                           %286       09101000          
    OCT1060001020500002, "3WDS00",                           %288       09102000          
    OCT1060001357700002, "3CHR00",                           %290       09103000          
    OCT1060001057300002, "3ADD00",                           %292       09104000          
    OCT1060001617200002, "3SUB00",                           %294       09105000          
    OCT1060000727600002, "3ZON00",                           %296       09106000          
    OCT1060000417500002, "3NUM00",                           %298       09107000          
    OCT1060000766700002, "3OCT00",                           %300       09108000          
    OCT1060000176600002, "3DEC00",                           %302       09109000          
    OCT1004000260000003, "6TOGGL", "E0000000",               %304       09110000          
    OCT0130311060000002, "3ABS00",                           %307       09110001          
    OCT1360441030000002, "3AND00",                           %309       09112000          
    OCT0500000170000002, "5ARRAY",                           %311       09112100          
    OCT0660000000000002, "5BEGIN",                           %313       09112200          
    OCT0500000040000003, "7BOOLE", "AN000000",               %315       09112300          
    OCT1070000000000003, "7COMME", "NT000000",               %318       09112400          
    OCT0500000230000003, "6DEFIN", "E0000000",               %321       09112500          
    OCT1410446000000002, "3DIV00",                           %324       09112600          
    OCT0550000000000002, "2DO000",                           %326       09112700          
    OCT0520000000000003, "6DOUBL", "E0000000",               %328       09112800          
    OCT0570000000000002, "4ELSE0",                           %331       09112900          
    OCT0600000000000002, "3END00",                           %333       09113000          
    OCT1340442030000002, "3EQV00",                           %335       09113100          
    OCT0410000000000002, "5FALSE",                           %337       09113200          
    OCT0130310030000002, "4FLAG0",                           %339       09113300          
    OCT0530000000000002, "3FOR00",                           %341       09113400          
    OCT1100000000000003, "7FORWA", "RD      ",               %343       09113500          
    OCT0640000000000002, "2GO000",                           %346       09113600          
    OCT0130316060320002, "4HUNT0",                           %348       09113700          
    OCT0630000000000002, "2IF000",                           %350       09113800          
    OCT0500000040000002, "4REAL0",                           %352       09113900          
    OCT0500000050000003, "7INTEG", "ER000000",               %354       09114000          
    OCT0500000070000002, "5LABEL",                           %357       09114100          
    OCT0360002000020003, "6MEMOR", "Y       ",               %359       09114200          
    OCT1410456000000002, "3MOD00",                           %362       09114300          
    OCT0500000140000003, "7MONIT", "OR      ",               %364       09114400          
    OCT0130301060000002, "4NABS0",                           %367       09114500          
    OCT0500000200000002, "4NAME0",                           %369       09114600          
    OCT0130304030000002, "5NFLAG",                           %371       09114700          
    OCT1320300230000002, "3NOT00",                           %373       09114800          
    OCT1350440430000002, "2OR000",                           %375       09114900          
    OCT0500000020000002, "4SAVE0",                           %377       09115000          
    OCT0500000010000002, "3OWN00",                           %379       09115100          
    OCT0460000000000003, "6POLIS", "H       ",               %381       09115200          
    OCT0500000160000003, "9PROCE", "DURE    ",               %384       09115300          
    OCT0130300000160011, "4SIGN0",                           %387       09115400          
              OCT2025,   COMMENT  DUP   ;                               09115500          
              OCT0000,   COMMENT  LITC 0;                               09115600          
              OCT0425,   COMMENT  NEQ   ;                               09115700          
              OCT1025,   COMMENT  XCH   ;                               09115800          
              OCT0155,   COMMENT  DIA  1;                               09115900          
              OCT0161,   COMMENT  DIB  1;                               09116000          
              OCT0165,   COMMENT  TRB  1;                               09116100          
    OCT1110000000000002, "4STEP0",                           %396       09116200          
    OCT0500000220000003, "6STREA", "M       ",               %398       09116300          
    OCT0500000110000003, "#SUBRO", "UTINE   ",               %401       09116400          
    OCT0500000150000003, "6SWITC", "H       ",               %404       09116500          
    OCT1120000000000002, "4THEN0",                           %407       09116600          
    OCT1130000000000002, "2TO000",                           %409       09116700          
    OCT0410000010000002, "4TRUE0",                           %411       09116800          
    OCT0560000000000002, "5UNTIL",                           %413       09116900          
    OCT1140000000000002, "5VALUE",                           %415       09117000          
    OCT0540000000000002, "5WHILE",                           %417       09117100          
    OCT1310440200000002, "3ADD00",                           %419       09117200          
    OCT1310240270000002, "3BRT00",                           %421       09117300          
    OCT1310453050000002, "3CCX00",                           %423       09117400          
    OCT1310442500000002, "3CDC00",                           %425       09117500          
    OCT1310457050000002, "3CFX00",                           %427       09117600          
    OCT1310302060000002, "3CHS00",                           %429       09117700          
    OCT1310440500000002, "3COC00",                           %431       09117800          
    OCT1310242020000002, "3COM00",                           %433       09117900          
    OCT1310302060000002, "3CSB00",                           %435       09118000          
    OCT1310240120000002, "3DEL00",                           %437       09118100          
    OCT1260100550000002, "3DIA00",                           %439       09118200          
    OCT1260100610000002, "3DIB00",                           %441       09118300          
    OCT1310344050000002, "3DUP00",                           %443       09118400          
    OCT1310451050000002, "3EQL00",                           %445       09118500          
    OCT1310443050000002, "3FCX00",                           %447       09118600          
    OCT1310447050000002, "3FFX00",                           %449       09118700          
    OCT1310440250000002, "3GEQ00",                           %451       09118800          
    OCT1310440450000002, "3GTR00",                           %453       09118900          
    OCT1310104420000002, "3HLB00",                           %455       09119000          
    OCT1310104420000002, "3HP200",                           %457       09119050          
    OCT1310446000000002, "3IDV00",                           %459       09119100          
    OCT1310251020000002, "3IIO00",                           %461       09119200          
    OCT1310250220000002, "3INA00",                           %463       09119300          
    OCT1310250420000002, "3INB00",                           %465       09119400          
    OCT1310100420000002, "3INI00",                           %467       09119500          
    OCT1400440300000002, "3INX00",                           %469       09119600          
    OCT1310244220000002, "3IOR00",                           %471       09119700          
    OCT1310250220000002, "3IP100",                           %473       09119800          
    OCT1310250420000002, "3IP200",                           %475       09119900          
    OCT1310145060000002, "3IPS00",                           %477       09120000          
    OCT1310410240000002, "3ISD00",                           %479       09120100          
    OCT1310450440000002, "3ISN00",                           %481       09120200          
    OCT1310100420000002, "3ITI00",                           %483       09120300          
    OCT1310450250000002, "3LEQ00",                           %485       09120400          
    OCT1310505300000002, "3LLL00",                           %487       09120500          
    OCT1310441030000002, "3LND00",                           %489       09120600          
    OCT1310300230000002, "3LNG00",                           %491       09120700          
    OCT1310304040000002, "3LOD00",                           %493       09120800          
    OCT1310440430000002, "3LOR00",                           %495       09120900          
    OCT1310442030000002, "3LQV00",                           %497       09121000          
    OCT1310450450000002, "3LSS00",                           %499       09121100          
    OCT1310101100000002, "3MKS00",                           %501       09121200          
    OCT1310441000000002, "3MUL00",                           %503       09121300          
    OCT1310441050000002, "3NEQ00",                           %505       09121400          
    OCT1310100130000002, "3NOP00",                           %507       09121500          
    OCT0650006550000003, "6SCOPO", "N.......";               %509       09121600          
 FILL INFO[2,*] WITH                                                    09121650          
    OCT1310300000020004, "3RDF00",                           %512       09121700          
              OCT0000,   COMMENT  LITC 0;                               09121800          
              OCT2141,   COMMENT  FXS   ;                               09121900          
    OCT1310300000020004, "3RDS00",                           %516       09122000          
              OCT0004,   COMMENT  LITC 1;                               09122100          
              OCT2141,   COMMENT  FXS   ;                               09122200          
    OCT1310456000000002, "3RDV00",                           %520       09122300          
    OCT1310304030000002, "3RFB00",                           %522       09122400          
    OCT1310240470000002, "3RNO00",                           %524       09122500          
    OCT1310145060000002, "3RRR00",                           %526       09122600          
    OCT1310311060000002, "3RSB00",                           %528       09122700          
    OCT1310242470000002, "3RSP00",                           %530       09122800          
    OCT1310141020000002, "3RTM00",                           %532       09122900          
    OCT1310240470000002, "3RTN00",                           %534       09123000          
    OCT1310141020000002, "3RTR00",                           %536       09123100          
    OCT1310242470000002, "3RTS00",                           %538       09123200          
    OCT1310310030000002, "3SFB00",                           %540       09123300          
    OCT1310442040000002, "3SND00",                           %542       09123400          
    OCT1310301060000002, "3SSB00",                           %544       09123500          
    OCT1310316060000002, "3SSF00",                           %546       09123600          
    OCT1310301060000002, "3SSN00",                           %548       09123700          
    OCT1310311060000002, "3SSP00",                           %550       09123800          
    OCT1310401040000002, "3STD00",                           %552       09123900          
    OCT1310240000020004, "3STF00",                           %554       09124000          
              OCT0010,   COMMENT  LITC 2;                               09124100          
              OCT2141,   COMMENT  FXS   ;                               09124200          
    OCT1310442040000002, "3STN00",                           %558       09124300          
    OCT1310240000020004, "3STS00",                           %560       09124400          
              OCT0014,   COMMENT LITC 3;                                09124500          
              OCT2141,   COMMENT FXS   ;                                09124600          
    OCT1310440600000002, "3SUB00",                           %564       09124700          
    OCT1310344060000002, "3TFB00",                           %566       09124800          
    OCT1270440650000002, "3TFR00",                           %568       09124900          
    OCT1310155060000002, "3TIO00",                           %570       09125000          
    OCT1310344060000002, "3TOP00",                           %572       09125050          
    OCT1270440650000002, "3TRB00",                           %574       09125100          
    OCT1300300000000002, "3VFI00",                           %576       09125200          
    OCT1310502050000002, "3XCH00",                           %578       09125300          
    OCT1310101070000002, "3XIT00",                           %580       09125400          
    OCT1310105020000002, "3ZIP00",                           %582       09125500          
    OCT1310105020000002, "3ZP100",                           %584       09125600          
    OCT1270500750000002, "3CFE00",                           %586       09125700          
    OCT1270500750000002, "3FCE00",                           %588       09125800          
    OCT1270500710000002, "3CFL00",                           %590       09125900          
    OCT1270500710000002, "3FCL00",                           %592       09126000          
    OCT1310440210000002, "3DLA00",                           %594       09126100          
    OCT1310440210000002, "3ADL00",                           %596       09126200          
    OCT1310440610000002, "3DLS00",                           %598       09126300          
    OCT1310440610000002, "3SDL00",                           %600       09126400          
    OCT1310441010000002, "3DLM00",                           %602       09126500          
    OCT1310441010000002, "3MDL00",                           %604       09126600          
    OCT1310442010000002, "3DLD00",                           %606       09126700          
    OCT1310442010000002, "3DDL00",                           %608       09126800          
    OCT0460000000000002, "1P0000",                           %610       09126900          
    OCT0360002000020002, "1M0000",                           %612       09127000          
    OCT1310240000020004, "3PRL00",                           %614       09127100          
              OCT0111,   COMMENT  PRL;                                  09127200          
              OCT0055,   COMMENT  NOP;                                  09127300          
    OCT0650006610000003, "7SCOPO", "FF......",               %618       09127400          
    OCT0030000000040003, "2LB000", "[#      ",               %621       09127500          
    OCT0030000000040003, "2RB000", "]#      ",               %624       09127600          
    OCT0030000000040003, "3GTR00", ">#      ",               %627       09127700          
    OCT0030000000040003, "3GEQ00", "}#      ",               %630       09127800          
    OCT0030000000040003, "3EQL00", "=#      ",               %633       09127900          
    OCT0030000000040003, "3NEQ00", "!#      ",               %636       09128000          
    OCT0030000000040003, "3LEQ00", "{#      ",               %639       09128100          
    OCT0030000000040003, "3LSS00", "<#      ",               %642       09128200          
    OCT0030000000040003, "5TIMES", "|#      ",               %645       09128300          
    OCT1310117530000002, "3SCI00",                           %648       09128400          
    OCT1310117540000002, "3SAN00",                           %650       09128500          
    OCT1310157730000000, "3SCS00",                           %652       09128600          
                                                                        09128700          
                                                                        09128800          
                                                                        09128900          
                                                                        09129000          
                                                                        09129100          
                                                                        09129200          
                                                                        09129300          
                                                                        09129400          
                                                                        09129500          
                                                                        09129600          
                                                                        09129700          
                                                                        09129800          
                                                                        09129900          
                                                                        09130000          
                                                                        09130100          
                                                                        09130200          
                                                                        09130300          
                                                                        09130400          
                                                                        09130500          
                                                                        09130600          
                                                                        09130700          
                                                                        09130800          
                                                                        09130900          
                                                                        09131000          
                                                                        09131100          
                                                                        09131200          
                                                                        09131300          
                                                                        09131400          
                                                                        09131500          
                                                                        09131600          
                                                                        09131700          
                                                                        09131800          
                                                                        09131900          
                                                                        09132000          
                                                                        09132100          
                                                                        09132200          
                                                                        09132300          
                                                                        09132400          
                                                                        09132500          
                                                                        09132600          
                                                                        09132700          
                                                                        09132800          
                                                                        09132900          
                                                                        09133000          
                                                                        09133100          
                                                                        09133200          
                                                                        09133300          
                                                                        09133400          
                                                                        09133450          
                                                                        09133500          
                                                                        09133600          
 0;   % END OF INFO FILL.                                               09133700          
         FOR GT2~256 STEP GT1.LINK WHILE NOT BOOLEAN(GT1.FORMAL) DO     09133800          
              PUT((GT1~TAKE(GT2))&GT2[35:35:13],GT2);                   09133900          
         FOR GT1~GT2 STEP GT2.LINK WHILE GT2.LINK!0 DO                  09134000          
              PUT((GT2~TAKE(GT1))&STACKHEAD[GT3~TAKE(GT1+1).[12:36]     09134100          
                      MOD 125][35:35:13],STACKHEAD[GT3]~GT1);           09134200          
 COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS;                   09197000          
 FILL SPECIAL[*] WITH                                                   09198000          
  OCT1200000000200000,  COMMENT  #;   OCT0000000000100000,  COMMENT  @; 09199000          
  OCT0000000000000000,                OCT1160000000120000,  COMMENT  :; 09200000          
  OCT1370440450002763,  COMMENT  >;   OCT1370440250002662,  COMMENT  }; 09201000          
  OCT1400440200000000,  COMMENT  +;   OCT0000000000000000,              09202000          
  OCT1220000000060000,  COMMENT  .;   OCT1210000000000000,  COMMENT  [; 09203000          
  OCT1250000000000000,  COMMENT  &;   OCT0450000000000000,  COMMENT  (; 09204000          
  OCT1370450450003571,  COMMENT  <;   OCT1330401040000000,  COMMENT  ~; 09205000          
  OCT1410441000000000,  COMMENT  |;   OCT0000000000000000,              09206000          
  OCT0000000000040000,  COMMENT  $;   OCT0470000000000000,  COMMENT  *; 09207000          
  OCT1400440600000000,  COMMENT  -;   OCT1240000000160000,  COMMENT  ); 09208000          
  OCT0620000000000000,  COMMENT .,;   OCT1370450250003470,  COMMENT  {; 09209000          
  OCT0000000000000000,                OCT1410442000000000,  COMMENT  /; 09210000          
  OCT1170000000000000,  COMMENT  ,;   OCT0000000000020000,  COMMENT  %; 09211000          
  OCT1370441050002561,  COMMENT  !;   OCT1370451050002460,  COMMENT  =; 09212000          
  OCT1230000000000000,  COMMENT  ];   OCT0000000000140000,  COMMENT  "; 09213000          
   0,0;                                                                 09214000          
    FILL MACRO[*] WITH                                                  09215000          
         OCT0131,            COMMENT SFS A       00             ;       09216000          
         OCT0116,            COMMENT SFD A       01             ;       09217000          
         OCT0000,            COMMENT SYNTAX ERROR02             ;       09218000          
         OCT0140,            COMMENT INC A       03             ;       09219000          
         OCT0130,            COMMENT SRS A       04             ;       09220000          
         OCT0117,            COMMENT SRD A       05             ;       09221000          
         OCT0000,            COMMENT SYNTAX ERROR06             ;       09222000          
         OCT0000,            COMMENT SYNTAX ERROR07             ;       09223000          
         OCT00310143,        COMMENT CRF A, SFS 008             ;       09224000          
         OCT00160143,        COMMENT CRF A, SFD 009             ;       09225000          
         OCT00470143,          COMMENT CRF A,  JFW 0  10         ;      09226000          
         OCT00400143,        COMMENT CRF A, INC 011             ;       09227000          
         OCT00300143,        COMMENT CRF A, SRS 012             ;       09228000          
         OCT00170143,        COMMENT CRF A, SRD 013             ;       09229000          
         OCT0000,            COMMENT SYNTAX ERROR14             ;       09230000          
         OCT0000,            COMMENT SYNTAX ERROR15             ;       09231000          
         OCT0153,            COMMENT RSA A       16             ;       09232000          
         OCT0104,            COMMENT RDA A       17             ;       09233000          
         OCT0150,            COMMENT RCA A       18             ;       09234000          
    OCT004201430042,         COMMENT SEC 0, CRF A, SEC 0 19     ;       09235000          
         OCT0122,            COMMENT SES A       20             ;       09236000          
         OCT0106,            COMMENT SED A       21             ;       09237000          
         OCT0000,            COMMENT SYNTAX ERROR22             ;       09238000          
         OCT0000,            COMMENT SYNTAX ERROR23             ;       09239000          
         OCT0056,            COMMENT TSA 0       24             ;       09240000          
         OCT0000,            COMMENT SYNTAX ERROR25             ;       09241000          
         OCT0000,            COMMENT SYNTAX ERROR26             ;       09242000          
         OCT0000,            COMMENT SYNTAX ERROR27             ;       09243000          
         OCT0000,            COMMENT SYNTAX ERROR28             ;       09244000          
         OCT0007,            COMMENT TDA 0       29             ;       09245000          
         OCT0000,            COMMENT SYNTAX ERROR30             ;       09246000          
         OCT0000,            COMMENT SYNTAX ERROR31             ;       09247000          
         OCT0115,            COMMENT SSA A       32             ;       09248000          
         OCT0114,            COMMENT SDA A       33             ;       09249000          
         OCT0154,            COMMENT SCA A       34             ;       09250000          
         OCT0141;            COMMENT STC A       35             ;       09251000          
FILL OPTIONS[*] WITH "5CHECK",0,          % 0,1                         09251208          
                     "6DEBUG",0,          % 2,3                         09251212          
                     "4DECK0",0,          % 4,5                         09251214          
                     "6FORMA",0,          % 6,7                         09251216          
                     "9INTRI",0,          % 8,9                         09251218          
                     "5LISTA",0,          % 10,11                       09251220          
                     "4LIST0",0,          % 12,13                       09251224          
                     "5LISTP",0,          % 14,15                       09251228          
                     "3MCP00",0,          % 16,17                       09251230          
                     "4TAPE0",0,          % 18,19                       09251232          
                     "4NEST0",0,          % 20,21                       09251234          
                     "3NEW00",0,          % 22,23                       09251236          
                     "7NEWIN",0,          % 24,25                       09251240          
                     "4OMIT0",0,          % 26,27                       09251244          
                     "1$0000",0,          % 28,29                       09251248          
                     "3PRT00",0,          % 30,31                       09251252          
                     "5PUNCH",0,          % 32,33                       09251256          
                     "5PURGE",0,          % 34,35                       09251260          
                     "4SEGS0",0,          % 36,37                       09251264          
                     "3SEQ00",0,          % 38,39                       09251268          
                     "6SEQER",0,          % 40,41                       09251272          
                     "6SINGL",0,          % 42,43                       09251276          
                     "5STUFF",0,          % 44,45                       09251378          
                     "4VOID0",0,          % 46,47                       09251380          
                     "5VOIDT",0,          % 48,49                       09251384          
 0;                                                                     09251388          
              DO UNTIL STEPI = BEGINV;                                  09252000          
              GT1 ~-"       ";                                          09253000          
              INTOG ~ INTOG AND TRUE; %                                 09253050          
              DISKADR ~ IF INTOG THEN INTRINSICADR ELSE 2;              09253100          
              MDESC(GT1,INFO[LASTSEQROW,LASTSEQUENCE]);                 09253500          
              MDESC(GT1,INFO[LASTSEQROW,LASTSEQUENCE-1]);               09254000          
              MDESC(GT1,INFO[LASTSEQROW,LASTSEQUENCE-2]);               09255000          
             STMT;                                                      09275000          
              LOCK(STUFF);                                              09281000          
              CLOSE(CARD,RELEASE);                                      09281500          
              IF LASTUSED ! 1 THEN CLOSE(TAPE,RELEASE);                 09282000          
              IF NEWTOG THEN LOCK(NEWTAPE,*);                           09282500          
              IF T~((L+3)DIV 4) + CORADR > 4080 THEN FLAG(040);         09282600          
              IF NOT NOHEADING THEN % PRINT THESE THINGS IF ANY         09362000          
                   BEGIN            % LISTING HAS BEEN DONE.            09363000          
 STREAM PROCEDURE PAN(T,FIEL,NER,LSQ); VALUE NER,T;                     09364000          
        BEGIN DI ~ FIEL; 44(DS~2LIT" ");                                09365000          
        SI ~ LSQ; DS ~ WDS; SI ~FIEL; DS ~ 3 WDS;                       09366000          
        DI ~ FIEL; DS~ 28 LIT"NUMBER OF ERRORS DETECTED = ";            09367000          
        SI ~ LOC NER; DS ~ 3 DEC; DS ~ 22 LIT ".  COMPILATION TIME = "; 09368000          
        SI ~ LOC T; DS ~ 4 DEC; DS ~ 9 LIT " SECONDS."; END;            09369000          
STREAM PROCEDURE PEN(FIL,PRTSIZ,BASE,CORE,DISK);                        09370000          
                   VALUE PRTSIZ,BASE,CORE,DISK;                         09371000          
              BEGIN DI~FIL; DS ~ 9 LIT"PRT SIZE="; SI~LOC PRTSIZ;       09372000          
                    DS ~ 3 DEC; DS~14 LIT" BASE ADDRESS=";              09373000          
                    SI~LOC BASE; DS~4 DEC; DS~10 LIT" CORE REQ=";       09374000          
                    SI~LOC CORE; DS~4 DEC; DS~10 LIT" DISK REQ=";       09375000          
                    SI~LOC DISK; DS~5 DEC; DS~61 LIT " ";               09376000          
              END  PEN;                                                 09377000          
 STREAM PROCEDURE FINALAX(LINE,N,SEQ); VALUE N;                         09378000          
         BEGIN DI ~ LINE; 15(DS ~ 8 LIT " ");                           09379000          
              DI ~ LINE; DS ~ 31 LIT "NUMBER OF ACCIDENTAL ENTRIES = "; 09380000          
              SI ~ LOC N; DS ~ 3 DEC; DI ~ DI+8;                        09381000          
              SI ~ SEQ; SI ~ SI-16; DS ~ 8 CHR;                         09382000          
         END;                                                           09383000          
         IF AXNUM !0 THEN                                               09384000          
              BEGIN                                                     09384050          
              FINALAX(LIN[0],AXNUM,INFO[LASTSEQROW,LASTSEQUENCE]);      09384100          
              WRITELINE;                                                09384500          
              END;                                                      09384600          
         SCRAM := (TIME(1)-TIME1)/60;                                   09385000          
         PAN(SCRAM,LIN[0],ERRORCOUNT,INFO[LASTSEQROW,LASTSEQUENCE-1])   09386000          
             ;                                                          09386500          
             WRITELINE;                                                 09387000          
                   PEN(LIN[0],PRTIMAX,T:=(L+3)DIV 4,T:=CORADR+T,        09388000          
           ((T+29)DIV 30+DISKADR)|30);                                  09389000          
                   WRITELINE;                                           09389500          
                   LOCK(LINE,RELEASE); END;                             09390000          
IF ERRORCOUNT ! 0 THEN I~0/0 ELSE                                       09391000          
    BEGIN                                                               09392000          
    ARRAY SAVINFO[0:31,0:255],                                          09392300          
    INFO[0:200,0:255];  % FOR LARGE MCP"S.                              09392500          
                    INTEGER SAVNDX,NONSAVNDX,N;                         09393000          
    INTEGER Q,J,K,M;                                                    09393010          
    BOOLEAN TSSTOG; REAL T;                                             09393020          
    REAL PROCEDURE PUSHER(GRINCH,GOT,XMAS); VALUE XMAS; REAL XMAS;      09393050          
                             ARRAY GOT[0]; ARRAY GRINCH [0,0];          09393060          
         BEGIN                                                          09393070          
         REAL WHO,WHAT;                                                 09393080          
         DEFINE LINKR = [32:8]#;                                        09393090          
%                                                                       09393100          
         IF WHO:=XMAS.LINKC { 225 THEN                                  09393110          
              BEGIN                                                     09393120          
              MOVE(30,GRINCH[XMAS.LINKR,WHO],GOT[0]);                   09393130          
              PUSHER:=XMAS + 30;                                        09393140          
              END                                                       09393150          
         ELSE BEGIN                                                     09393160          
              MOVE(WHAT:=256-WHO,GRINCH[XMAS.LINKR,WHO],GOT[0]);        09393170          
              XMAS:=XMAS + WHAT;                                        09393180          
              MOVE(WHO:=30-WHAT, GRINCH[XMAS.LINKR,0], GOT[WHAT]);      09393190          
              PUSHER:=XMAS + WHO;                                       09393200          
              END;                                                      09393220          
         END PUSHER;                                                    09393230          
    PROCEDURE PUSHEE(GRINCH,N,B,Y); VALUE N,B,Y; REAL N,B,Y;            09393240          
         ARRAY GRINCH[0,0];                                             09393250          
         BEGIN                                                          09393260          
         REAL I,J,X;                                                    09393270          
         DEFINE LINKR = [32:8]#;                                        09393280          
         J:=Y;                                                          09393290          
         I:=B + N;                                                      09393300          
         WHILE B < I DO                                                 09393310          
              BEGIN                                                     09393320          
              IF Y:=B.LINKC { 225 THEN                                  09393330          
              BEGIN                                                     09393340          
              MOVE(30,CODE(J),GRINCH[B.LINKR,Y]);                       09393350          
              J:=J + 30;                                                09393360          
              B:=B + 30;                                                09393370          
              END                                                       09393380          
         ELSE BEGIN                                                     09393390          
              MOVE(X:=256-Y,CODE(J),GRINCH[B.LINKR,Y]);                 09393400          
              B:=B + X;                                                 09393410          
              J:=J + X;                                                 09393420          
              MOVE(Y:=30-X,CODE(J),GRINCH[B.LINKR,0]);                  09393430          
              B:=B + Y;                                                 09393440          
              J:=J + Y;                                                 09393450          
              END;                                                      09393460          
         END;                                                           09393470          
    END PUSHEE;                                                         09393480          
STREAM PROCEDURE FIXHDR(F,N); VALUE N;                                  09393700          
    BEGIN SI~F; SI~SI-24; DI~LOC F; DS~WDS;                             09393710          
          SI~F; 14(SI~SI+8); DI~LOC F; DS~WDS;                          09393720          
          DI~F; DI~DI+38; SI~ LOC N;                                    09393730          
          SI~SI+7; DS~CHR;                                              09393740          
    END FIXHDR;                                                         09393750          
                    LABEL EOF;                                          09394000          
              IF NOT INTOG THEN                                         09394100          
         BEGIN                                                          09394200          
                   L~(L+3)DIV 4; COMMENT L~NUM. OF WORDS IN OUTER BLOCK;09395000          
                   FILL SAVINFO[0,*] WITH                               09395100          
                        OCT7700000000000015,                            09395200          
                        OCT0253010477527705,                            09395300          
                        OCT0051000000000000,                            09395400          
                        OCT0441070001000062;                            09395500          
                   Q ~ -1;                                              09395700          
              PUSHEE(SAVINFO,L,4,5);                                    09396000          
              SAVNDX:=L;                                                09397000          
         END;                                                           09397100          
                   REWIND(CODISK);                                      09398000          
          DO BEGIN IF   REED=0 THEN GO TO EOF;                          09399000          
                    N~FETCH(MKABS(CODE(0)))-1;                          09400000          
                    IF BOOLEAN(FETCH(MKABS(CODE(1)))) THEN              09401000          
         BEGIN                                                          09402000          
              PUSHEE(SAVINFO,N,SAVNDX,1);                               09402100          
              SAVNDX:=SAVNDX +N;                                        09403000          
         END ELSE BEGIN                                                 09404000          
              IF DECKTOG THEN                                           09405000          
                        STACKHEAD[Q~Q+1] ~ 1024|NONSAVNDX+N;            09405500          
                   PUSHEE(INFO,N,NONSAVNDX,1);                          09406000          
                   NONSAVNDX:=((NONSAVNDX + N + 29)DIV 30)|30;          09407000          
              END;                                                      09408000          
              END UNTIL FALSE;                                          09412000          
         EOF:      N~(SAVNDX+29) DIV 30; COMMENT NUMBER OF DISK SEGMENTS09413000          
                    OCCUPIED BY SAVE PROCEDURES AND ARRAYS;             09414000          
         IF INTOG AND NOT DECKTOG THEN                                  09414010          
    BEGIN    % INTRINSIC FUNCTION OPTION                                09414020          
         FOR J:=USEROPINX STEP 2 UNTIL OPARSIZE DO % IS TIMESHARING SET 09414022          
         IF OPTIONS[J] = "@TIMES" THEN                                  09414024          
         BEGIN TSSTOG:=BOOLEAN(OPTIONS[J+1]); J:=OPARSIZE END;          09414026          
         I ~ PRTBASE + 1; J ~ 0;                                        09414030          
         DO IF GT1 ~ PRT[I] !0 THEN                                     09414040          
         BEGIN                                                          09414050          
              J ~ J+1;                                                  09414060          
               SAVINFO[J.LINKR,J.LINKC] ~                               09414070          
                0&GT1[8:8:10]                                           09414080          
                &GT1[33:18:15];                                         09414090          
         END UNTIL I:=I +1 } PRTIMAX;                                   09414100          
          SAVINFO[0,0] ~ J;     % # OF INTRINSICS                       09414110          
         SAVNDX ~ MAXINTRINSIC;                                         09414120          
    END ELSE BEGIN                                                      09414130          
                   I~PRTBASE; DO IF GT1~PRT[I]!0 THEN                   09415000          
              BEGIN IF GT1.[1:5]!LDES THEN                              09415500          
             BEGIN IF (GT1~GT1&(GT1.[33:15]+L)[33:33:15]).[6:2]!3 THEN  09416000          
                      GT1~GT1&(GT1.[18:15]+N)[18:33:15];                09417000          
              END;                                                      09417500          
                   MDESC(GT1,SAVINFO[I.LINKR,I.LINKC]);                 09418000          
              END ELSE SAVINFO[I.LINKR,I.LINKC]:=0 UNTIL I:=I+1}PRTIMAX;09419000          
                   MDESC(0&1[2:47:1],SAVINFO[0,PRTBASE-1]);             09419100          
                   SAVNDX ~ 30 | N;                                     09420000          
            END;                                                        09420010          
                   I ~ 0; J ~ -1;                                       09420020          
                                                                        09420100          
                   IF NOT DECKTOG THEN                                  09421000          
              BEGIN                                                     09421500          
                  DO                                                    09422000          
              BEGIN                                                     09423000          
                   I:=PUSHER(SAVINFO,ELBAT,I);                          09424000          
                   J:=J + 1;                                            09425000          
                   WRITE(DISK,30,ELBAT[*]);                             09425900          
              END UNTIL I } SAVNDX;                                     09426000          
                   I:=0;                                                09427000          
                   WHILE I < NONSAVNDX DO                               09427100          
              BEGIN                                                     09427200          
                   I:=PUSHER(INFO,ELBAT,I);                             09427500          
                   J:=J + 1;                                            09428000          
                   WRITE(DISK,30,ELBAT[*]);                             09429000          
              END;                                                      09430000          
                   N~IF INTOG THEN IF TSSTOG THEN                       09430050          
                        TSSINTYPE ELSE DCINTYPE ELSE MCPTYPE;           09430060          
                   FIXHDR(DISK,N);                                      09430075          
                   LOCK(DISK,*);                                        09430100          
              END  ELSE                                                 09431000          
              BEGIN ELBAT[0]~0; I~16;                                   09432000          
                    DO BEGIN MOVE(8,SAVINFO[I.LINKR,I.LINKC],ELBAT[1]); 09433000          
                        ELBAT[9]~B2D(I+96)&1[11:47:1]&(I+96)[23:35:1];  09434000          
                             WRITE(DECK,10,ELBAT[*]);                   09435000          
                       END UNTIL I~I+8}SAVNDX;                          09436000          
                    FILL ELBAT[*] WITH 0,                               09437000          
                         OCT7500000000000012,                           09438000          
                         OCT0004535530611765,                           09439000          
                         OCT7006000404210435,                           09440000          
                         OCT7700000000000015,                           09441000          
                         OCT0253010477527705,                           09442000          
                         OCT0051000004410046,                           09443000          
                         OCT0441070001000062,                           09444000          
                         OCT0040413100000000,                           09445000          
                         OCT0001000000000101;                           09446000          
                    WRITE(DECK,10,ELBAT[*]);                            09447000          
                   ELBAT[0] ~0&REAL(DECKTOG)[1:19:17];                  09447010          
                   FOR I ~ 0 STEP 1 UNTIL Q DO                          09447020          
                        BEGIN K ~ STACKHEAD[I].[23:15];                 09447030          
                             M ~ STACKHEAD[I].[38:10];                  09447040          
                             FOR J ~ 0 STEP 8 UNTIL M DO BEGIN          09447050          
                                  MOVE(8,INFO[(J+K).LINKR,(J+K).LINKC], 09447060          
                                        ELBAT [1]);                     09447070          
                                  ELBAT[9] ~ B2D(J)&"310"[1:31:17];     09447080          
                                  WRITE(DECK,10,ELBAT[*]) END;          09447090          
                        END;                                            09447100          
              END END END PROGRAM;                                      09448000          
 COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE;    10000000          
 PROCEDURE DEFINEGEN(MACRO,J); VALUE MACRO,J; BOOLEAN MACRO; REAL J;    10228000          
         BEGIN                                                          10229000          
            OWN INTEGER CHARCOUNT, REMCOUNT;                            10230000          
    COMMENT CHARCOUNT CONTAINS NUMBER OFCHARACTORS OF THE DEFINE THAT WE10231000          
              HAVE PUT INTO INFO.  REMCOUNT CONTAINS NUMBER OF CHARACT- 10232000          
              ORS REMAINING IN THIS ROW OF INFO;                        10233000          
 PROCEDURE PUTOGETHER(CHAR); REAL CHAR;                                 10234000          
         BEGIN                                                          10235000          
 STREAM PROCEDURE PACKINFO(INFO,ISKIP,COUNT,ASKIP,ACCUM);               10236000          
              VALUE ISKIP,COUNT,ASKIP;                                  10237000          
              BEGIN DI ~ INFO; DI ~ DI+ISKIP;                           10238000          
                    SI ~ ACCUM;SI ~ SI+ASKIP; SI ~ SI+3;                10239000          
                    DS ~ COUNT CHR END PACKINFO;                        10240000          
            INTEGER COUNT,SKIPCOUNT;                                    10241000          
              IF (COUNT ~ CHAR.[12:6]) + CHARCOUNT > 2047               10242000          
                THEN BEGIN FLAG(142);  TB1~ TRUE  END                   10243000          
                ELSE BEGIN                                              10244000          
                   IF COUNT > REMCOUNT                                  10245000          
                     THEN BEGIN                                         10246000          
                        SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT);             10247000          
                        REMCOUNT ~ 2047 END                             10248000          
                     ELSE REMCOUNT ~ REMCOUNT-COUNT;                    10249000          
                   GT1 ~ CHARCOUNT DIV 8 + NEXTINFO;                    10250000          
                   PACKINFO(INFO[GT1.LINKR,GT1.LINKC],CHARCOUNT.[45:3], 10251000          
                   COUNT,0,CHAR);                                       10252000          
                   IF SKIPCOUNT ! 0 THEN                                10253000          
                       PACKINFO(INFO[NEXTINFO.LINKR+1,0],0,SKIPCOUNT,   10254000          
                          COUNT,CHAR);                                  10255000          
                   CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END            10256000          
           END PUTOGETHER;                                              10257000          
 STREAM PROCEDURE SCAN(D,S,Q,N,J); VALUE J,N,Q;                         10257100          
         BEGIN DI~D;DI~DI+11;SI~S;SI~SI+3;                              10257200          
              IF N SC=DC THEN                                           10257300          
              IF SC>"0" THEN                                            10257400          
              BEGIN DI~LOC J; DI~DI+7;                                  10257500          
                   IF SC{DC THEN                                        10257600          
                   BEGIN J~SI;DI~J;SI~LOC Q;SI~SI+6;DS~CHR;             10257700          
                        DI~S;DI~DI+2;DS~CHR;                            10257800          
         END  END  END;                                                 10257900          
            INTEGER LASTRESULT;                                         10258000          
              REAL K,N,ELCLASS;                                         10258100          
              DEFINE I=NXTELBT#;                                        10258200          
              LABEL FINAL,PACKIN;                                       10258300          
              LABEL BACK,SKSC,EXIT;                                     10259000          
              TB1~ FALSE;                                               10260000          
              CHARCOUNT~(NEXTINFO-LASTINFO)|8;                          10261000          
              DEFINECTR ~ 1; LASTRESULT ~ 2;                            10262000          
              REMCOUNT ~ (256 - NEXTINFO MOD 256) | 8;                  10263000          
              NEXTINFO~LASTINFO;                                        10263100          
              IF J!0 THEN N~TAKE(LASTINFO+1).[12:6];                    10263110          
              K~0;                                                      10263200          
 BACK:        STOPDEFINE~TRUE;                                          10263300          
              ELCLASS~TABLE(NXTELBT);                                   10263400          
 SKSC:        NXTELBT~NXTELBT-1;                                        10263500          
              IF MACRO THEN                                             10263600          
              BEGIN IF ELCLASS=COMMA THEN                               10263700          
                   IF K=0 THEN                                          10263800          
 FINAL:            BEGIN PUTOGETHER("1#0000"); GO TO EXIT END           10263900          
                   ELSE GO PACKIN;                                      10264000          
                   IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN        10264100          
                   BEGIN K~K+1; GO TO PACKIN END;                       10264200          
                   IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN           10264300          
                   IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN;             10264400          
                   IF ELCLASS=SEMICOLON THEN                            10264410          
                        BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420          
              END;                                                      10264500          
                   IF J!0 THEN                                          10264600          
                   IF ACCUM[1].[12:6]-1=N THEN                          10264700          
                        SCAN(INFO[LASTINFO. LINKR ,LASTINFO. LINKC],    10264800          
                             ACCUM[1],N+770,N,J);                       10264900          
 PACKIN:                                                                10264910          
                   IF RESULT = 4                                        10265000          
                     THEN BEGIN                                         10266000          
    COMMENT  INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000;         10267000          
                       PUTOGETHER(2130706432);                          10268000          
                       PUTOGETHER(ACCUM[1]);                            10269000          
                       PUTOGETHER(2130706432) END                       10270000          
                   ELSE BEGIN                                           10271000          
                     IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT)         10272000          
                       THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000          
                     PUTOGETHER(ACCUM[1]) END;                          10274000          
                   IF TB1 THEN GO TO EXIT;                              10275000          
                   LASTRESULT ~ RESULT;                                 10276000          
                   IF MACRO THEN GO BACK;                               10276500          
                   IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV10277000          
                     THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END;   10278000          
                   IF ELCLASS ! CROSSHATCH THEN GO BACK;                10279000          
                   IF DEFINECTR ! 1                                     10280000          
                     THEN BEGIN STOPDEFINE ~ TRUE;                      10281000          
                        IF ELCLASS~TABLE(I)!COMMA THEN                  10282000          
                        DEFINECTR~DEFINECTR-1; GO SKSC END;             10283000          
 EXIT:        DEFINECTR~ 0;                                             10284000          
              NEXTINFO ~(CHARCOUNT+7) DIV 8+NEXTINFO;                   10285000          
         END  DEFINEGEN;                                                10286000          
 PROCEDURE DBLSTMT;                                                     12002000          
         BEGIN                                                          12003000          
         REAL S,T;                                                      12004000          
         LABEL L1,L2,L3,EXIT;                                           12005000          
         S~0;                                                           12006000          
         IF STEPI!LEFTPAREN THEN ERR(281)                               12007000          
         ELSE                                                           12008000          
    L1:  BEGIN                                                          12009000          
              IF STEPI=COMMA THEN                                       12010000          
              BEGIN                                                     12011000          
              DPTOG~TRUE;                                               12012000          
              IF STEPI=ADOP THEN STEPIT;                                12013000          
              EMITNUM(NLO);                                             12014000          
              EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI);   12015000          
              DPTOG~FALSE;                                              12016000          
              STEPIT;                                                   12017000          
                   GO TO L2;                                            12018000          
              END;                                                      12019000          
              IF TABLE(I+1)=COMMA THEN                                  12020000          
                   BEGIN                                                12021000          
                   IF ELCLASS=ADOP  OR ELCLASS=MULOP THEN               12022000          
                        BEGIN                                           12023000          
                        EMITO(ELBAT[I].ADDRESS+1);                      12024000          
                        IF S~S-1{0 THEN FLAG(282); STEPIT;              12025000          
                        GO TO L3;                                       12026000          
                        END;                                            12027000          
                   IF ELCLASS=ASSIGNOP THEN                             12028000          
                        BEGIN                                           12029000          
                        IF S!1 THEN FLAG(283); S~0;   STEPIT;           12030000          
                        DO                                              12031000          
                        BEGIN                                           12032000          
                    IF ELCLASS  !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000          
                        STEPIT;                                         12034000          
                        IF ELCLASS{INTID AND ELCLASS}REALID THEN        12035000          
                        BEGIN  EMITN(ELBAT[I].ADDRESS); STEPIT END      12036000          
                                                ELSE VARIABLE(FL);      12037000          
                                      EMITO(STD) END UNTIL S~S+1=2 ;    12038000          
                        IF ELCLASS!RTPAREN THEN ERR(285) ELSE STEPIT;   12039000          
                        GO TO EXIT;                                     12040000          
                        END;                                            12041000          
                   IF ELCLASS{INTID AND ELCLASS}BOOID THEN              12042000          
                        BEGIN                                           12043000          
                        CHECKER(T~ELBAT[I]);                            12044000          
                        STEPIT;STEPIT;                                  12045000          
                        AEXP;                                           12046000          
                        EMITV(T.ADDRESS);                               12047000          
                        GO TO L2;                                       12048000          
                        END;                                            12049000          
                   END    ;                                             12050000          
                        AEXP;                                           12051000          
                        IF ELCLASS!COMMA THEN BEGIN ERR(284);GO EXIT    12052000          
                                                                 END;   12053000          
                        STEPIT; AEXP; EMITO(XCH);                       12054000          
    L2:       S~S+1;                                                    12055000          
    L3:       IF ELCLASS!COMMA THEN BEGIN ERR(284);GO TO EXIT END;      12056000          
              GO TO L1;                                                 12057000          
    EXIT:END                                                            12058000          
         END  DBLSTMT;                                                  12059000          
 REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T;                      12101000          
         BEGIN REAL K,S,P,J,EL;                                         12102000          
    STREAM PROCEDURE SET(S,D,K,E); VALUE K,E;                           12103000          
         BEGIN SI~S;SI~SI+11;DI~D;DI~DI+3;DS~K CHR;                     12104000          
              SI~LOC E; SI~SI+6; DS~2 CHR;                              12105000          
         END;                                                           12106000          
              MACROID~TRUE;                                             12107000          
              P~(FIXDEFINEINFO~T).ADDRESS;                              12108000          
              K~COUNT;                                                  12109000          
              S~SCRAM;                                                  12110000          
              STREAMTOG~TRUE & STREAMTOG[1:3:45] ;                      12110100          
              STOPDEFINE~TRUE;                                          12111000          
              EL~TABLE(NXTELBT);                                        12112000          
              NXTELBT~NXTELBT-1;                                        12113000          
              IF EL!LEFTPAREN AND EL!LFTBRKET THEN                      12114000          
                    FLAG(141)                                           12115000          
              ELSE DO BEGIN J~J+1;                                      12116000          
                   SET(INFO[T.LINKR,T.LINKC],ACCUM[1],K,64|J+12);       12117000          
                   ACCUM[1].[12:6]~K+2;                                 12118000          
                   ACCUM[0]~0;                                          12119000          
                   ACCUM[0].CLASS~DEFINEDID;                            12120000          
                   COUNT~K+2;                                           12121000          
                   SCRAM~ACCUM[1] MOD 125;                              12122000          
                   E;                                                   12123000          
                   DEFINEGEN(TRUE,0);                                   12124000          
              END UNTIL EL~ELBAT[NXTELBT].CLASS!COMMA;                  12125000          
              IF EL!RTPAREN AND EL!RTBRKET OR J!P THEN FLAG(141);       12126000          
              MACROID~FALSE;                                            12127000          
              STREAMTOG~STREAMTOG.[1:45] ;                              12127100          
         END;                                                           12128000          
 PROCEDURE SCATTERELBAT;                                                13197000          
         BEGIN                                                          13198000          
              REAL T;                                                   13199000          
              T ~ ELBAT[I];                                             13200000          
              KLASSF ~ T.CLASS;                                         13201000          
              FORMALF ~ BOOLEAN(T.FORMAL);                              13202000          
              VONF ~ BOOLEAN(T.VO);                                     13203000          
              LEVELF ~ T.LVL;                                           13204000          
              ADDRSF ~ T.ADDRESS;                                       13205000          
              INCRF ~ T.INCR;                                           13206000          
              LINKF ~ T.LINK;                                           13207000          
         END  SCATTERELBAT;                                             13208000          
PROCEDURE CHKSOB;                                                       13209000          
       IF GTA1[J~J-1]!0 THEN FLAG(23);                                  13210000          
DEFINE                                                                  13211000          
       ADDC=532480#,                                                    13212000          
       SUBC=1581056#,                                                   13213000          
       EMITSTORE=EMITPAIR#;                                             13214000          
 PROCEDURE PURGE(STOPPER);                                              13215000          
           VALUE STOPPER;                                               13216000          
           REAL STOPPER;                                                13217000          
 BEGIN                                                                  13218000          
   INTEGER POINTER;                                                     13219000          
   LABEL RECOV; DEFINE ELCLASS = KLASSF#;                               13220000          
   REAL J,N,OCR,TL,ADD;                                                 13221000          
      POINTER~LASTINFO;                                                 13222000          
    WHILE POINTER } STOPPER                                             13223000          
    DO                                                                  13224000          
      BEGIN                                                             13225000          
              IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO             13226000          
              THEN BEGIN                                                13227000          
              NCII~NCII-1;                                              13228000          
                   EMITNUM(TAKE(POINTER+1));                            13229000          
                   EMITSTORE(MAXSTACK,STD);                             13230000          
                   MAXSTACK~(G~MAXSTACK)+1;                             13231000          
                   J~L; L~GT1.LINK;                                     13232000          
                   DO                                                   13233000          
                     BEGIN                                              13234000          
                        GT4~GET(L);                                     13235000          
                        EMITV(G)                                        13236000          
                     END                                                13237000          
                   UNTIL (L~GT4)=4095;                                  13238000          
                   L~J;                                                 13239000          
                   POINTER~POINTER-GT1.INCR                             13240000          
                   END                                                  13241000          
              ELSE                                                      13242000          
              BEGIN                                                     13243000          
              IF NOT BOOLEAN(GT1.FORMAL)                                13244000          
                THEN BEGIN                                              13245000          
                   IF ELCLASS = LABELID                                 13246000          
                     THEN BEGIN                                         13247000          
                       ADD ~ GT1.ADDRESS;                               13248000          
                       IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1]     13249000          
                          THEN IF OCR.[36:12] ! 0 OR ADD ! 0            13250000          
                             THEN BEGIN GT1 ~ 160; GO TO RECOV END;     13251000          
                   IF ADD ! 0 THEN                                      13252000          
              PROGDESCBLDR(ADD,TRUE,OCR.[36:10],LDES) END               13252500          
              ELSE IF FALSE                                             13253000          
                     THEN BEGIN                                         13254000          
                        IF TAKE(POINTER+1) < 0                          13255000          
                          THEN BEGIN GT1 ~ 162; GO TO RECOV END;        13256000          
                        OCR ~(J ~  TAKE(GIT(POINTER))).[24:12];         13257000          
                        N ~ GET( (J~J.[36:12])+4); TL ~ L;              13258000          
                        IF ADD ~ GT1.ADDRESS ! 0                        13259000          
                         THEN BEGIN                                     13260000          
                                                                        13261000          
                           IF OCR ! 0                                   13262000          
              THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END;  13263000          
                           L~J+11; EMITL(15); EMITO(RTS);               13264000          
                           FOR J ~ 4 STEP 4 UNTIL N                     13265000          
                             DO BEGIN                                   13266000          
                               EMITL(GNAT(GET(L)|4096+GET(L+1)));       13267000          
                               EMITO(RTS) END END                       13268000          
                         ELSE BEGIN                                     13269000          
                           L ~ J+13;                                    13270000          
                           FOR J ~ 4 STEP 4 UNTIL N                     13271000          
                             DO BEGIN                                   13272000          
                               GT1 ~ GET(L)|4096+GET(L+1);              13273000          
                               GOGEN(GT1,BFW) END;END;                  13274000          
                       L ~ TL END                                       13277000          
                   ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID     13278000          
                    THEN IF TAKE(POINTER+1) < 0                         13279000          
                      THEN BEGIN GT1 ~ 161;                             13280000          
    RECOV:              MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM);13281000          
                        Q ~ ACCUM[1]; FLAG(GT1); ERRORTOG ~ TRUE END    13282000          
              END;                                                      13283000          
        GT2~TAKE(POINTER+1);                                            13284000          
        GT3~GT2.PURPT;                                                  13285000          
    STACKHEAD[(0&GT2[12:12:36])MOD 125]~TAKE(POINTER).LINK;             13286000          
        POINTER~POINTER-GT3                                             13287000          
              END                                                       13288000          
      END ;                                                             13289000          
   LASTINFO~POINTER;                                                    13290000          
   NEXTINFO~STOPPER                                                     13291000          
 END;                                                                   13292000          
PROCEDURE E;                                                            13293000          
COMMENT                                                                 13294000          
       E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND             13295000          
       HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK             13296000          
       IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY          13297000          
       E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE       13298000          
       BEGINNING OF THE NEXT ROW IF NECESSARY                          ;13299000          
 BEGIN                                                                  13300000          
    REAL WORDCOUNT,RINX;                                                13301000          
       IF RINX~(NEXTINFO+WORDCOUNT~(COUNT+18)DIV 8    ).LINKR !         13302000          
               NEXTINFO.LINKR                                           13303000          
THEN BEGIN PUT(125&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO);              13304000          
         NEXTINFO~256|RINX END;                                         13305000          
         IF SPECTOG THEN                                                13305100          
         IF NOT MACROID THEN                                            13305200          
              UNHOOK;                                                   13305300          
                                                                        13306000          
         ACCUM[0].INCR~WORDCOUNT;                                       13307000          
         IF NOT INLINETOG OR MACROID THEN BEGIN                         13307500          
          ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO;    13308000          
                            END;                                        13308500          
          ACCUM[1].PURPT~NEXTINFO-LASTINFO;                             13309000          
MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]);              13310000          
          LASTINFO~NEXTINFO;                                            13311000          
           NEXTINFO~NEXTINFO+WORDCOUNT                                  13312000          
 END;                                                                   13313000          
PROCEDURE ENTRY(TYPE);                                                  13314000          
          VALUE TYPE;                                                   13315000          
          REAL TYPE;                                                    13316000          
COMMENT                                                                 13317000          
       ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH          13318000          
       IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT            13319000          
       ACCORD TO TYPE        .IF THE ENTRY IS AN ARRAY AND NOT          13320000          
       A SPECIFICATION THEN A DESCRIPTOR IS PLACED IN THE STACK         13321000          
       FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S)    ;13322000          
 BEGIN                                                                  13323000          
     J~0;I~I-1;                                                         13324000          
     DO                                                                 13325000          
       BEGIN                                                            13326000          
            STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT;                     13327000          
            IF FORMALF~SPECTOG                                          13328000          
               THEN                                                     13329000          
                BEGIN                                                   13330000          
                 IF ELCLASS!SECRET                                      13331000          
                    THEN FLAG(002);                                     13332000          
                              BUP~BUP+1                                 13333000          
;    KLASSF~TYPE;MAKEUPACCUM; E;J~J+1;                                  13333500          
                END                                                     13334000          
               ELSE                                                     13335000          
                BEGIN                                                   13336000          
                 IF ELCLASS>IDMAX                                       13337000          
               THEN IF ELCLASS= POLISHV THEN ELCLASS~TYPE ELSE FLAG(3); 13338000          
                 IF LEVELF=LEVEL                                        13339000          
                   THEN FLAG(001);                                      13340000          
                 VONF~P2;                                               13341000          
                FORMALF~PTOG;                                           13341100          
     KLASSF~TYPE; MAKEUPACCUM;E; J~J+1;                                 13342000          
     IF ((FORMALF~PTOG) OR(STREAMTOG AND NOT STOPGSP)) AND NOT P2       13343000          
       THEN ADDRSF~PJ~PJ+1                                              13344000          
       ELSE IF STOPGSP                                                  13345000          
              THEN ADDRSF~0                                             13346000          
                         ELSE ADDRSF:=GETSPACE(P2,LASTINFO+1);          13347000          
       PUT(TAKE(LASTINFO)& ADDRSF[16:37:11],LASTINFO);                  13348000          
     END END                                                            13349000          
                                                                        13350000          
      UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J                         13351000          
 END;                                                                   13352000          
  PROCEDURE UNHOOK;                                                     13353000          
COMMENT                                                                 13354000          
   UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY    13355000          
   FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT         13356000          
   E WILL WORK AS NORMAL.                                              ;13357000          
  BEGIN                                                                 13358000          
    REAL LINKT,A,LINKP;                                                 13359000          
    LABEL L;                                                            13360000          
                 LINKT~STACKHEAD[SCRAM]     ; LINKP~ELBAT[I].LINK;      13361000          
                 IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK  13362000          
                                ELSE                                    13363000          
             L: IF A~TAKE(LINKT).LINK=LINKP                             13364000          
                THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT)       13365000          
                ELSE BEGIN LINKT~A; GO TO L END;                        13366000          
  END;                                                                  13367000          
PROCEDURE MAKEUPACCUM;                                                  13368000          
  BEGIN                                                                 13369000          
     IF PTOG                                                            13370000          
       THEN GT1~LEVELF ELSE GT1~LEVEL;                                  13371000          
     ACCUM[0]~ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1]    13372000          
                  & REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11]13373000          
                  )                                                     13374000          
  END;                                                                  13375000          
PROCEDURE ARRAE;                                                        13376000          
 BEGIN                                                                  13377000          
     INTEGER SAVEINFO;                                                  13378000          
     LABEL BETA1;                                                       13379000          
             TYPEV~REALARRAYID;                                         13380000          
              IF T1~GTA1[J~J-1]=0 THEN J~J+1                            13381000          
                               ELSE                                     13382000          
                                 IF T1=OWNV THEN                        13383000          
                                       BEGIN                            13384000          
                                            P2~TRUE;IF SPECTOG THEN     13385000          
                                            FLAG(13)                    13386000          
                                         END                            13387000          
                                             ELSE                       13388000          
                                       TYPEV~REALARRAYID+T1-REALV;      13389000          
 BETA1: ENTER(TYPEV);                                                   13390000          
          IF ELCLASS!LFTBRKET THEN FLAG(16);                            13391000          
          IF STEPI=LITNO THEN                                           13392000          
              BEGIN                                                     13393000          
                 SAVEINFO~ELBAT[I].ADDRESS;                             13394000          
                 IF STEPI!RTBRKET THEN FLAG(53);                        13395000          
                                            FILLSTMT(SAVEINFO);         13396000          
SAVEINFO~1;                                                             13397000          
          END                                                           13398000          
              ELSE                                                      13399000          
         BEGIN IF ELCLASS!ASTRISK THEN FLAG(56);                        13400000          
               SAVEINFO~1;                                              13401000          
              WHILE STEPI!RTBRKET DO                                    13402000          
                   BEGIN IF ELCLASS!COMMA AND                           13403000          
                        STEPI!ASTRISK THEN FLAG(56);                    13404000          
                        SAVEINFO~SAVEINFO+1                             13405000          
                   END;STEPIT;                                          13406000          
                                                                        13407000          
END;      PUT(TAKE(LASTINFO)&SAVEINFO[27:40:8],LASTINFO);               13408000          
J ~ 1 ;     GTA1[0] ~ 0    ;                                            13408500          
IF ELCLASS=COMMA THEN BEGIN STEPIT;GO TO BETA1 END                      13409000          
 END ARRAE;                                                             13410000          
 PROCEDURE PUTNBUMP(X);                                                 13589000          
             VALUE X;                                                   13590000          
             REAL X;                                                    13591000          
  BEGIN                                                                 13592000          
        INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X;                          13593000          
        NEXTINFO~NEXTINFO+1                                             13594000          
  END ;                                                                 13595000          
 PROCEDURE JUMPCHKX;                                                    13596000          
COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE    13597000          
        WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS      13598000          
        ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT        13599000          
        IS THE FIRST EXECUTABLE CODE;                                   13600000          
IF NOT SPECTOG THEN                                                     13601000          
BEGIN                                                                   13602000          
   IF AJUMP                                                             13603000          
       THEN                                                             13604000          
   BEGIN ADJUST;                                                        13605000          
         EMITB(BFW,SAVEL,L)                                             13606000          
   END ELSE                                                             13607000          
         IF FIRSTX=4095                                                 13608000          
           THEN                                                         13609000          
             BEGIN                                                      13610000          
               ADJUST;                                                  13611000          
               FIRSTX~L;                                                13612000          
             END;                                                       13613000          
       AJUMP~FALSE                                                      13614000          
END;                                                                    13615000          
 PROCEDURE JUMPCHKNX;                                                   13616000          
COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN       13617000          
        EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE           13618000          
        NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED     13619000          
        AND SAVED FOR A LATER BRANCH;                                   13620000          
IF NOT SPECTOG THEN                                                     13621000          
BEGIN                                                                   13622000          
   IF FIRSTX!4095                                                       13623000          
     THEN                                                               13624000          
      BEGIN                                                             13625000          
       IF NOT AJUMP                                                     13626000          
         THEN                                                           13627000          
            SAVEL~BUMPL;                                                13628000          
      AJUMP~TRUE                                                        13629000          
      END;ADJUST                                                        13630000          
END;                                                                    13631000          
PROCEDURE SEGMENTSTART(SAVECODE);VALUE SAVECODE;BOOLEAN SAVECODE;       13632000          
    BEGIN                                                               13632100          
    STREAM PROCEDURE PRINT(SAVECODE,ADR,FIEL); VALUE SAVECODE,ADR;      13633000          
         BEGIN                                                          13634000          
         LABEL L1;                                                      13635000          
         DI:=FIEL; DS:=8 LIT" ";                                        13636000          
         SI:=FIEL; DS:=9 WDS; DI:=DI-3;                                 13637000          
         SAVECODE(DS:=38 LIT "START OF SAVE SEGMENT; BASE ADDRESS = ";  13638000          
           JUMP OUT TO L1);                                             13639000          
         DS:=38 LIT " START OF REL SEGMENT; DISK ADDRESS = ";           13640000          
L1:                                                                     13641000          
         SI:=LOC ADR; DS:=5 DEC;                                        13642000          
         END PRINT;                                                     13643000          
    MOVE(1,SAVECODE,CODE(0));                                           13651000          
    IF SAVECODE AND INTOG AND NOT DECKTOG THEN FLAG(57);                13651100          
    IF LISTER OR SEGSTOG THEN                                           13652000          
         BEGIN                                                          13652500          
         PRINT(SAVECODE,IF SAVECODE THEN CORADR ELSE DISKADR,LIN[*]);   13653000          
         IF NOHEADING THEN DATIME; WRITELINE;                           13653500          
         END;                                                           13654000          
    END SEGMENTSTART;                                                   13655000          
PROCEDURE SEGMENT(SIZE,FR); VALUE SIZE,FR; INTEGER SIZE,FR;             13657000          
    BEGIN                                                               13660000          
    STREAM PROCEDURE PRINT(SIZE,FIEL); VALUE SIZE;                      13661000          
         BEGIN                                                          13663000          
         DI:=FIEL; DS:=8 LIT" ";                                        13665000          
         SI:=FIEL; DS:=14 WDS;                                          13667000          
         DI:=DI-16; DS:=6 LIT"SIZE= ";                                  13668000          
         SI:=LOC SIZE; DS:=4 DEC; DS:=6 LIT" WORDS"                     13670000          
         END PRINT;                                                     13673000          
    STREAM PROCEDURE DOIT(C,A,I,S,F,W); VALUE C,A,F,W;                  13673100          
         BEGIN  LOCAL N;                                                13673150          
         DI:=S; DS:=8 LIT" "; SI:=S; DS:=9 WDS;                         13673200          
         DI:=DI-8; SI:=LOC W; DS:=4 DEC;                                13673250          
         SI:=I; SI:=SI+10;DI:=LOC N; DI:=DI+7; DS:=CHR;                 13673300          
         DI:=S; SI:=LOC F; SI:=SI+7; DS:=CHR; SI:=LOC C;                13673350          
         DS:=3 DEC; DS:=4 DEC;SI:=I; SI:=SI+11;DS:=N CHR;               13673400          
         END DOIT;                                                      13673450          
    IF LISTER OR SEGSTOG THEN                                           13674000          
         BEGIN                                                          13674500          
         PRINT(SIZE,LIN[*]);                                            13675000          
         IF NOHEADING THEN DATIME; WRITELINE;                           13676000          
         END;                                                           13677000          
    IF STUFFTOG THEN IF FR>0 THEN IF LEVEL>1 THEN                       13677100          
         BEGIN                                                          13677150          
         KLASSF:=TAKE(PROINFO).CLASS;                                   13677200          
        IF FR > 1024 THEN FR~FR-1024;                                   13677250          
         DOIT(KLASSF,FR,INFO[PROINFO.LINKR,PROINFO.LINKC],              13677300          
              TWXA[0],SAF,SIZE);                                        13677400          
         WRITE(STUFF,10,TWXA[*]);                                       13677500          
         END;                                                           13677600          
    IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE;                           13678000          
    END SEGMENT;                                                        13681000          
 STREAM PROCEDURE MOVECODE(EDOC,TEDOC);                                 13683000          
  BEGIN LOCAL T1,T2,T3;                                                 13684000          
    SI~EDOC;T1~SI;                                                      13685000          
    SI~TEDOC;T2~SI;                                                     13686000          
    SI~LOC EDOC;                                                        13687000          
    SI~SI+3;                                                            13688000          
    DI~LOC T3;                                                          13689000          
    DI~DI+5;                                                            13690000          
    SKIP 3 DB;                                                          13691000          
  15(IF SB THEN DS~ 1 SET ELSE DS~1 RESET;SKIP 1 SB);                   13692000          
    SI~ LOC EDOC;                                                       13693000          
    DI~ LOC T2;                                                         13694000          
    DS~ 5 CHR;                                                          13695000          
    3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);                   13696000          
    DI~T3;                                                              13697000          
    SI~LOC T2;                                                          13698000          
    DS~WDS;                                                             13699000          
    DI~LOC T3;                                                          13700000          
    DI~DI+5;                                                            13701000          
    SKIP 3 DB;                                                          13702000          
    SI~LOC EDOC;                                                        13703000          
    SI~SI+3;                                                            13704000          
  15(IF SB THEN DS~1 SET ELSE DS~ 1 RESET;SKIP 1 SB);                   13705000          
    SI~ LOC TEDOC;                                                      13706000          
    DI~ LOC T1;                                                         13707000          
    DS~ 5 CHR;                                                          13708000          
   3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);                    13709000          
    DI~T3;                                                              13710000          
    SI~LOC T1;                                                          13711000          
    DS~WDS                                                              13712000          
  END;                                                                  13713000          
 PROCEDURE ENTER(TYPE);                                                 13714000          
              VALUE TYPE;                                               13715000          
         REAL TYPE;                                                     13716000          
 BEGIN                                                                  13717000          
        G~GTA1[J~J-1];                                                  13718000          
        IF NOT SPECTOG                                                  13719000          
          THEN                                                          13720000          
            BEGIN                                                       13721000          
              IF NOT P2                                                 13722000          
                 THEN IF P2~(G=OWNV)                                    13723000          
                         THEN G~GTA1[J~J-1];                            13724000          
              IF NOT P3                                                 13725000          
                 THEN IF P3~(G=SAVEV)                                   13726000          
                         THEN G~GTA1[J~J-1]                             13727000          
            END;                                                        13728000          
        IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE)                           13729000          
 END;                                                                   13730000          
PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD);                      13731000          
           VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD;                        13732000          
           BOOLEAN GOTSTORAGE;                                          13733000          
           REAL RELAD,STOPPER,PRTAD;                                    13734000          
  BEGIN                                                                 13735000          
              IF FUNCTOG                                                13736000          
                THEN                                                    13737000          
                   BEGIN                                                13738000          
                       EMITV(513);                                      13739000          
                       EMITO(RTN)                                       13740000          
                   END                                                  13741000          
                ELSE                                                    13742000          
                        EMITO(XIT);                                     13743000          
              CONSTANTCLEAN;                                            13744000          
              PURGE(STOPPER);                                           13745000          
     MOVE(1,CODE(0),Z); PROGDESCBLDR(PRTAD,BOOLEAN(Z),(L+3)DIV 4,PDES); 13746000          
     END HTTEOAP;                                                       13747000          
PROCEDURE INLINE;                                                       13748000          
 BEGIN                                                                  13749000          
  INTEGER SN,LN,P,LS,J; BOOLEAN MKST;                                   13750000          
         BOOLEAN FLIPFLOP;                                              13750500          
    INTEGER PN;                                                         13750600          
  LABEL L1,L2,L3;                                                       13751000          
    PN~1 ;                                                              13751100          
         FLIPFLOP~INLINETOG~TRUE;P~0;MKST~FALSE;LS~L;EMITO(NOP);        13752000          
   IF STEPI!LEFTPAREN THEN FLAG(59);                                    13753000          
   IF TABLE(I+1)=COLON THEN BEGIN STEPIT;GO TO L2 END ;                 13753100          
L1: IF STEPI>IDMAX THEN BEGIN FLAG(465); GO TO L2 END ;                 13754000          
      ACCUM[0]~0&P[16:37:11]&LOCLID[2:41:7]&SCRAM[35:35:13];            13755000          
         E;IF FLIPFLOP THEN BEGIN FLIPFLOP~FALSE;LN~SN~LASTINFO END;    13755500          
         IF STEPI=COMMA OR ELCLASS=COLON OR ELCLASS=RTPAREN             13756000          
      THEN BEGIN I~I-2;STEPIT END                                       13757000          
      ELSE IF ELCLASS!ASSIGNOP THEN FLAG(60) ELSE STEPIT;               13758000          
      AEXP;                                                             13759000          
 L2:  IF ELCLASS=COLON THEN                                             13760000          
      BEGIN IF MKST THEN FLAG(99); MKST~TRUE; EMITO(MKS); P~P+2;        13761000          
            IF TABLE(I+1)!RTPAREN THEN GO TO L1; STEPIT                 13761100          
            ;PN~2;                                                      13761110          
      END ELSE P~P+1;                                                   13761200          
      IF ELCLASS=COMMA THEN GO TO L1;                                   13762000          
      IF ELCLASS!RTPAREN THEN FLAG(61);                                 13763000          
      IF NOT MKST THEN                                                  13764000          
         BEGIN J~L;L~LS;EMITO(MKS);L~J END;                             13765000          
    IF STEPI ! SEMICOLON THEN FLAG(62);                                 13766000          
              EMITO(584);                                               13766100          
                                                                        13766200          
                                                                        13766300          
                                                                        13766400          
                                                                        13766500          
  L3:ELBAT[I]~TAKE(SN);SCATTERELBAT;ADDRSF~P-ADDRSF;                    13767000          
      PUT(ELBAT[I]&ADDRSF[16:37:11]&STACKHEAD[LINKF][33:33:15],SN);     13768000          
         STACKHEAD[LINKF]~SN;  SN~SN+INCRF;                             13769000          
         IF ADDRSF!PN THEN GO TO L3 ;                                   13770000          
         INLINETOG~  FALSE;                                             13770500          
         PN~NEXTINFO;                                                   13770600          
         STREAMTOG~TRUE;STREAMWORDS;IF STEPI!BEGINV THEN STREAMSTMT     13771000          
         ELSE BEGIN STEPIT;COMPOUNDTAIL END;                            13772000          
         STREAMTOG~FALSE;PURGE(PN);STREAMWORDS;PURGE(LN);EMITL(16);     13773000          
                                                                        13773500          
END INLINE;                                                             13774000          
 COMMENT THIS SECTION CONTAINS THE BLOCK ROUTINE  ;                     14000000          
PROCEDURE BLOCK(SOP);                                                   14001000          
          VALUE SOP;                                                    14002000          
          BOOLEAN SOP;                                                  14003000          
COMMENT SOP IS TRUE IF THE BLOCK WAS CALLED BY ITSELF THROUGH THE       14004000          
        PROCEDURE DECLARATION-OTHERWISE IT WAS CALLED BY STATEMENT.     14005000          
        THE BLOCK ROUTINE IS RESPONSIBLE FOR HANDLING THE BLOCK         14006000          
        STRUCTURE OF AN ALGOL PROGRAM-SEGMENTING EACH BLOCK,HANDLING    14007000          
        ALL DECLARATIONS,DOING NECESSARY BOOKKEEPING REGARDING EACH     14008000          
        BLOCK, AND SUPPLYING THE SCANNER WITH ALL NECESSARY INFORMATION 14009000          
        ABOUT DECLARED IDENTIFIERS.                                     14010000          
        IT ALSO WRITES EACH SEGMENT ONTO THE PCT;                       14011000          
BEGIN                                                                   14012000          
 LABEL OWNERR,SAVERR,BOOLEANDEC,REALDEC,ALPHADEC,INTEGERDEC,            14013000          
    LABELDEC,DUMPDEC,SUBDEC,OUTDEC,INDEC,MONITORDEC,                    14014000          
    SWITCHDEC,PROCEDUREDEC,ARRAYDEC,NAMEDEC,FILEDEC,                    14015000          
      GOTSCHK,                                                          14016000          
       STREAMERR,DEFINEDEC,CALLSTATEMENT,HF,START;                      14017000          
 SWITCH DECLSW ~ OWNERR,SAVERR,BOOLEANDEC,REALDEC,INTEGERDEC,ALPHADEC,  14018000          
                 LABELDEC,DUMPDEC,SUBDEC,OUTDEC,INDEC,MONITORDEC,       14019000          
                 SWITCHDEC,PROCEDUREDEC,ARRAYDEC,NAMEDEC,FILEDEC,       14020000          
               STREAMERR,DEFINEDEC;                                     14021000          
DEFINE NLOCS=10#,LOCBEGIN=PRTI#,                                        14022000          
       LBP=[36:12]#,                                                    14023000          
       SPACEITDOWN = BEGIN   WRITE(LINE[DBL]); WRITE(LINE[DBL])  END#;  14023100          
                                                                        14024000          
BOOLEAN GOTSTORAGE;                                                     14025000          
 INTEGER PINFOO,BLKAD;                                                  14026000          
           COMMENT LOCAL TO BLOCK TO SAVE WHERE A PROCEDURE IS EMTERED  14027000          
           IN INFO;                                                     14028000          
REAL MAXSTACKO,LASTINFOT,RELAD,LO,TSUBLEVEL,STACKCTRO;                  14029000          
INTEGER SGNOO,LOLD,SAVELO,PRTIO,NINFOO;                                 14030000          
  INTEGER NCIIO;                                                        14031000          
   INTEGER PROAD ;                                                      14032000          
     INTEGER FIRSTXO;                                                   14033000          
BOOLEAN FUNCTOGO,AJUMPO;                                                14034000          
         BEGINCTR~BEGINCTR+1;                                           14035000          
         IF SOP                                                         14036000          
                            THEN BEGIN BLKAD~PROADO;                    14037000          
                        IF LASTENTRY ! 0                                14038000          
                           THEN BEGIN GT1~BUMPL;                        14039000          
                                      CONSTANTCLEAN;                    14040000          
                                      EMITB(BFW,GT1,L)                  14041000          
                                END                                     14042000          
                  END                                                   14043000          
             ELSE BEGIN BLKAD:=GETSPACE(TRUE,-6); % SEG. DESCR.         14044000          
                                                                        14045000          
                                                                        14046000          
                                                                        14047000          
                  END;                                                  14048000          
                                                                        14049000          
                                                                        14050000          
        FIRSTXO~FIRSTX;                                                 14051000          
     FIRSTX~0;                                                          14052000          
 LEVEL~LEVEL+1;                                                         14053000          
     LOLD~L;FUNCTOGO~FUNCTOG;AJUMPO~AJUMP;PRTIO~PRTI;SGNOO~SGNO;        14054000          
     SAVELO~SAVEL;AJUMP~FALSE; L~0;NINFOO~NEXTINFO;                     14055000          
  NCIIO~NCII;                                                           14056000          
  NCII~0;                                                               14057000          
  STACKCTRO~STACKCTR;                                                   14058000          
                                                                        14059000          
                                                                        14061000          
 ELBAT[I].CLASS~SEMICOLON;                                              14062000          
START: IF TABLE(I)!SEMICOLON                                            14063000          
         THEN                                                           14064000          
           BEGIN                                                        14065000          
             FLAG(0);                                                   14066000          
             I~I-1                                                      14067000          
           END;                                                         14068000          
       GTA1[0]~J~0;                                                     14069000          
       IF SPECTOG                                                       14070000          
          THEN                                                          14071000          
            BEGIN                                                       14072000          
              IF BUP=PJ                                                 14073000          
                THEN                                                    14074000          
                  BEGIN                                                 14075000          
                     BEGIN LABEL GETLP;                                 14076000          
                             IF STREAMTOG THEN F~0 ELSE                 14077000          
                       F~FZERO;                                         14078000          
                    BUP~LASTINFO;                                       14079000          
                       DO                                               14080000          
                        BEGIN                                           14081000          
                    IF NOT STREAMTOG THEN                               14082000          
                         BUP~LASTINFO;                                  14083000          
                         GETLP: G~TAKE(BUP);                            14084000          
                                IF K~G.ADDRESS!PJ                       14085000          
                                  THEN                                  14086000          
                                    BEGIN                               14087000          
   IF BUP ! BUP:=BUP- TAKE(BUP + 1).PURPT THEN                          14088000          
                                      GO TO GETLP                       14089000          
                                    END;                                14090000          
    TYPEV~G.CLASS;                                                      14091000          
                                       G.ADDRESS~F~F+1;                 14115000          
                                PUT(G,BUP); G.INCR~GT1;                 14116000          
                                PUT(G,MARK+PJ)                          14117000          
                              ;BUP~BUP-TAKE(BUP+1).PURPT                14118000          
                        END                                             14119000          
                       UNTIL PJ~PJ-1=0                                  14120000          
                     END;                                               14121000          
                          SPECTOG~FALSE;                                14122000          
                   GO TO HF                                             14123000          
                  END                                                   14124000          
            END;                                                        14125000          
              STACKCT ~ 0;                                              14125500          
    WHILE STEPI=DECLARATORS                                             14126000          
    DO                                                                  14127000          
     BEGIN                                                              14128000          
       GTA1[J~J+1]~ELBAT[I].ADDRESS;                                    14129000          
       STOPDEFINE~ERRORTOG~TRUE;                                        14130000          
     END;                                                               14131000          
IF J =0 THEN GO TO CALLSTATEMENT;                                       14132000          
    P2~P3~FALSE;                                                        14133000          
    GO TO DECLSW[GTA1[J]];                                              14134000          
OWNERR:FLAG(20);J~J+1;GO TO REALDEC;                                    14135000          
SAVERR:FLAG(21);J~J+1;GO TO REALDEC;                                    14136000          
STREAMERR:     IF ELCLASS = LEFTPAREN THEN                          % 6 14137000          
          BEGIN                                                     % 6 14137100          
               I ~ I - 1;                                           % 6 14137200          
               GO TO CALLSTATEMENT;                                 % 6 14137300          
          END;                                                      % 6 14137400          
               FLAG(22);                                            % 6 14137500          
               J ~ J + 1;                                           % 6 14137600          
               GO TO PROCEDUREDEC;                                  % 6 14137700          
REALDEC:P3~TRUE;ENTER(REALID);GO TO START;                              14138000          
ALPHADEC:P3~TRUE;ENTER(ALFAID);GO TO START;                             14139000          
BOOLEANDEC:P3~TRUE;ENTER(BOOID);GO TO START;                            14140000          
INTEGERDEC:P3~TRUE;ENTER(INTID);GO TO START;                            14141000          
        MONITORDEC:IF SPECTOG                                           14142000          
                  THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR     14143000          
                            DECLARATION APPEARS IN THE SPECIFICATION    14144000          
                            PART OF A PROCEDURE;                        14145000          
                          FLAG(463);                                    14146000          
                       END;                                             14147000          
              DO UNTIL FALSE;                                           14148000          
       DUMPDEC:IF SPECTOG                                               14149000          
               THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION    14150000          
                         APPEARS IN THE SPECIFICATION PART OF A         14151000          
                         PROCEDURE;                                     14152000          
                        FLAG(464);                                      14153000          
                    END;                                                14154000          
              DO UNTIL FALSE;                                           14155000          
ARRAYDEC: ARRAE; GO TO START;                                           14156000          
FILEDEC: INDEC: OUTDEC:                                                 14158000          
GOTSCHK:GOTSTORAGE~ NOT SPECTOG OR GOTSTORAGE;GO TO START;              14160000          
NAMEDEC: IF T1~GTA1[J~J-1]!ARRAYV THEN J~J+1;                           14161000          
          TYPEV~NAMEID;                                                 14161010          
          IF T1~GTA1[J~J-1]=0 THEN J~J+1                                14161020          
                                    ELSE                                14161030          
                                  IF T1=OWNV                            14161040          
                                    THEN                                14161050          
                                       BEGIN                            14161060          
                                         P2~TRUE; IF SPECTOG THEN       14161070          
                                                    FLAG(013)           14161080          
                                       END                              14161090          
                                    ELSE                                14161100          
                                                                        14161110          
                                        TYPEV~NAMEID+T1-REALV;          14161120          
            ENTER(TYPEV); GO TO START;                                  14162000          
SUBDEC:                                                                 14163000          
    BEGIN REAL TYPEV,T;                                                 14163500          
     IF GTA1[J~J-1]=REALV THEN TYPEV~REALSUBID ELSE TYPEV~SUBID;        14164000          
STOPGSP~TRUE;                                                           14164500          
    JUMPCHKNX;ENTRY(TYPEV);IF ELCLASS!SEMICOLON THEN FLAG(57);          14165000          
STOPGSP~FALSE;                                                          14165499          
     STEPIT;                                                            14166000          
          T~NEXTINFO;                                                   14166500          
PUTNBUMP(L); STMT; EMITO(LFU);    IF TYPEV=REALSUBID THEN               14167000          
          IF GET(L-2)!533 THEN FLAG(58);PUT(TAKE(T)&L[24:36:12],T);     14168000          
CONSTANTCLEAN;                                                          14168500          
    END;                                                                14169000          
     GO TO START;                                                       14170000          
                                                                        14171000          
                                                                        14172000          
                                                                        14173000          
                                                                        14174000          
                                                                        14175000          
                                                                        14176000          
                                                                        14177000          
                                                                        14178000          
                                                                        14179000          
                                                                        14180000          
                                                                        14181000          
                                                                        14182000          
                                                                        14183000          
                                                                        14184000          
                                                                        14185000          
                                                                        14186000          
LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24);                          14187000          
         STOPENTRY~STOPGSP~TRUE;                                        14188000          
         I~I-1;                                                         14189000          
         DO                                                             14190000          
           BEGIN                                                        14191000          
              STOPDEFINE~TRUE;                                          14192000          
            STEPIT;                                                     14193000          
              ENTRY(LABELID);                                           14194000          
              PUTNBUMP(0)                                               14195000          
           END                                                          14196000          
         UNTIL ELCLASS!COMMA;                                           14197000          
         STOPENTRY~STOPGSP~FALSE;                                       14198000          
         GO TO START;                                                   14199000          
SWITCHDEC:                                                              14200000          
  BEGIN                                                                 14201000          
    LABEL START;                                                        14202000          
       INTEGER GT1,GT2,GT4,GT5;                                         14203000          
     BOOLEAN TB1;                                                       14204000          
     STOPENTRY~NOT SPECTOG;STOPGSP~TRUE;                                14205000          
    SCATTERELBAT; GT1~0; TB1~FALSE;                                     14206000          
        ENTRY(SWITCHID);                                                14207000          
 GT2~NEXTINFO; PUTNBUMP(0);                                             14217000          
   DO                                                                   14218000          
      BEGIN                                                             14219000          
         IF STEPI!LABELID OR ELBAT[I].LVL!LEVEL THEN FLAG(63);          14220000          
         PUTNBUMP(ELBAT[I]);GT1~GT1+1                                   14221000          
      END                                                               14222000          
              COMMENT                                                   14222500          
   UNTIL STEPI!COMMA;                                                   14223000          
                                                                        14223500          
      PUT(GT1,GT2);                                                     14224000          
       STOPENTRY ~ STOPGSP ~ FALSE;                                     14251000          
  END SWITCHDEC;                                                        14252000          
GO TO START;                                                            14253000          
  DEFINEDEC:                                                            14254000          
    BEGIN LABEL START;                                                  14254050          
         REAL J,K;                                                      14254100          
    BOOLEAN STREAM PROCEDURE PARM(S,D,K,J); VALUE K,J;                  14254200          
         BEGIN SI~S;SI~SI+2; DI~D;DI~DI+2;                              14254300          
              IF K SC!DC THEN TALLY~1;                                  14254400          
              DI~LOC J;DI~DI+7;                                         14254500          
              IF SC!DC THEN TALLY~1;                                    14254600          
              PARM~TALLY;                                               14254700          
         END;                                                           14254800          
    STOPENTRY~STOPGSP~TRUE;I~I-1;                                       14255000          
     DO                                                                 14256000          
      BEGIN                                                             14257000          
              STOPDEFINE~TRUE;                                          14258000          
         STEPIT; MOVE(9,ACCUM[1],GTA1);                                 14259000          
         K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID);                        14259010          
         GTA1[0]~J+"100000"; J~0;                                       14259015          
         IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN                  14259020          
         BEGIN                                                          14259030          
              DO BEGIN STOPDEFINE~TRUE;                                 14259060          
                   STEPIT;                                              14259070          
                   IF (J~J+1)>9 OR PARM(ACCUM[1],GTA1,K,J) OR           14259080          
                        K>62 THEN BEGIN ERR(141); GO TO START END;      14259090          
                   STOPDEFINE~TRUE;                                     14259100          
              END UNTIL STEPI!COMMA;                                    14259110          
              IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(141);     14259120          
              STOPDEFINE~TRUE;                                          14259130          
              STEPIT;                                                   14259140          
              PUT(TAKE(LASTINFO)&J[16:37:11],LASTINFO);                 14259150          
         END;                                                           14259160          
        IF ELCLASS!RELOP                                                14260000          
          THEN                                                          14261000          
             BEGIN                                                      14262000          
               FLAG(30);                                                14263000          
               I~I-1;                                                   14264000          
             END;                                                       14265000          
         MACROID~TRUE;                                                  14265900          
         DEFINEGEN(FALSE,J);                                            14266000          
         MACROID~FALSE;                                                 14266100          
      END                                                               14267000          
     UNTIL STEPI!COMMA;                                                 14268000          
 START: STOPENTRY~STOPGSP~FALSE; END; GO TO START;                      14269000          
                                                                        14269499          
PROCEDUREDEC:                                                           14270000          
  BEGIN                                                                 14271000          
    LABEL START,START1;                                                 14272000          
      LABEL START2;                                                     14273000          
    BOOLEAN FWDTOG; COMMENT THIS TOGGLE IS THE FORWARD DEC INDICATOR;   14274000          
         IF NOT SPECTOG THEN FUNCTOG~FALSE;                             14275000          
   FWDTOG~FALSE  ;                                                      14276000          
              MAXSTACKO~ MAXSTACK;                                      14277000          
   IF G~GTA1[J~J-1]=STREAMV                                             14278000          
    THEN                                                                14279000          
      BEGIN STREAMTOG~TRUE;                                             14280000          
        IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID                         14281000          
                           ELSE                                         14282000          
                            BEGIN                                       14283000          
                             IF TYPEV~PROCID +G>INTSTRPROCID OR         14284000          
                                TYPEV <BOOSTRPROCID                     14285000          
                              THEN FLAG(004);                           14286000          
                         IF NOT SPECTOG THEN                            14287000          
                              FUNCTOG~TRUE;                             14288000          
                              CHKSOB                                    14289000          
      END                   END                                         14290000          
      ELSE                                                              14291000          
     IF G=SAVEV OR G=0 THEN TYPEV~PROCID                                14292000          
               ELSE                                                     14293000          
                IF TYPEV~REALSTRPROCID+G<BOOPROCID OR TYPEV>INTPROCID   14294000          
                  THEN FLAG(005)                                        14295000          
            ELSE BEGIN FUNCTOG~TRUE;G~GTA1[J~J-1];                      14296000          
                       END;                                             14297000          
     IF NOT STREAMTOG THEN SEGMENTSTART(G=SAVEV);                       14298000          
     SAF ~ G=SAVEV;                                                     14299000          
                                                                        14300000          
                                                                        14301000          
                                                                        14302000          
   MODE~MODE+1;                                                         14303000          
   LO~PROINFO;                                                          14304000          
   SCATTERELBAT;                                                        14305000          
COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY                    ;14306000          
   IF LEVELF=LEVEL                                                      14307000          
     THEN                                                               14308000          
       BEGIN                                                            14309000          
         IF G~TAKE(LINKF+1)}0                                           14310000          
           THEN FLAG(006);                                              14311000          
         FWDTOG~TRUE;                                                   14312000          
         PROAD~ADDRSF;                                                  14313000          
         PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT                       14314000          
              ;PUT(-G,LINKF+1);                                         14315000          
       END                                                              14316000          
     ELSE                                                               14317000          
       BEGIN STOPENTRY~TRUE; P2~TRUE;                                   14318000          
         STOPGSP~LEVEL>1 AND STREAMTOG;                                 14318500          
         ENTRY(TYPEV);    MARK~NEXTINFO;PUTNBUMP(0);                    14319000          
         STOPGSP~FALSE;                                                 14319500          
         PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF;       14320000          
      P2~STOPENTRY~FALSE                                                14321000          
       END;                                                             14322000          
                 PJ~0; LEVEL~LEVEL+1;                                   14323000          
          IF STREAMTOG THEN STREAMWORDS;                                14324000          
      IF ELCLASS=SEMICOLON THEN GO TO START1;                           14325000          
     IF ELCLASS!LEFTPAREN THEN FLAG(007);                               14326000          
COMMENT: THE FOLLOWING 8  STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000          
         FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO;              14328000          
        RR1~NEXTINFO;                                                   14329000          
      LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1;                          14330000          
                PUTNBUMP(0);                                            14331000          
              PTOG~TRUE;   I~I+1;                                       14332000          
      ENTRY(SECRET);                                                    14333000          
    IF FWDTOG THEN                                                      14333100          
         BEGIN                                                          14333200          
         IF GT1:=TAKE(MARK).[40:8] ! PJ THEN FLAG(48); % WRONG          14333300          
           % NUMBER OF PARAMETERS. WE DON"T WANT TO CLOBBER INFO.       14333400          
         END                                                            14333500          
ELSE                                                                    14333600          
  PUT(PJ,MARK);                                                         14334000          
           P~PJ;                                                        14335000          
    IF ELCLASS!RTPAREN                                                  14336000          
      THEN FLAG(008);                                                   14337000          
    IF STEPI!SEMICOLON                                                  14338000          
       THEN FLAG(009);                                                  14339000          
COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART;                 14340000          
   IF STEPI=VALUEV                                                      14341000          
      THEN                                                              14342000          
        BEGIN                                                           14343000          
          DO                                                            14344000          
            IF STEPI!SECRET                                             14345000          
              THEN FLAG(010)                                            14346000          
              ELSE                                                      14347000          
                 BEGIN                                                  14348000          
                    IF G~ELBAT[I].ADDRESS=0 OR G>PJ                     14349000          
                     THEN                                               14350000          
                        FLAG(010);                                      14351000          
                                    G~TAKE(ELBAT[I]);                   14352000          
                                    PUT(G&1[10:47:1],ELBAT[I])          14353000          
                 END                                                    14354000          
          UNTIL                                                         14355000          
             STEPI!COMMA;                                               14356000          
   IF ELCLASS!SEMICOLON                                                 14357000          
       THEN FLAG(011)                                                   14358000          
       ELSE STEPIT                                                      14359000          
         END;I~I-1;                                                     14360000          
    IF STREAMTOG                                                        14361000          
       THEN                                                             14362000          
         BEGIN                                                          14363000          
                   BUP~PJ; SPECTOG~TRUE;GO TO START1                    14364000          
         END                                                            14365000          
       ELSE                                                             14366000          
         BEGIN                                                          14367000          
           SPECTOG~TRUE;                                                14368000          
           BUP~0;                                                       14369000          
           IF ELCLASS!DECLARATORS                                       14370000          
              THEN FLAG(012)                                            14371000          
       END;                                                             14372000          
START:PTOG~FALSE;LASTINFO~LASTINFOT;NEXTINFO~IF FWDTOG THEN RR1 ELSE    14373000          
           MARK+PJ+1;                                                   14374000          
START1:PINFOO~NEXTINFO;                                                 14375000          
START2: END;                                                            14376000          
     IF SPECTOG OR STREAMTOG                                            14377000          
        THEN                                                            14378000          
              GO TO START;                                              14379000          
COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION  14380000          
        PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS;  14381000          
HF:                                                                     14382000          
   BEGIN                                                                14383000          
     LABEL START,STOP;                                                  14384000          
         DEFINE  TESTLEV = LEVEL>2 #;                                   14384100          
  IF STREAMTOG                                                          14385000          
    THEN BEGIN                                                          14386000          
     IF TESTLEV THEN JUMPCHKNX ELSE SEGMENTSTART(TRUE);PJ~P;            14387000          
                     PTOG~FALSE;                                        14388000          
         PUT(TAKE(GIT(PROINFO))&L[28:36:12],GIT(PROINFO));              14388100          
    IF TESTLEV THEN BEGIN EMITO(584);         END;                      14389000          
              IF STEPI=BEGINV                                           14393000          
                THEN                                                    14394000          
                   BEGIN                                                14395000          
                     WHILE STEPI=DECLARATORS OR ELCLASS=LOCALV          14396000          
                        DO                                              14397000          
                         BEGIN                                          14398000          
                           IF ELBAT[I].ADDRESS=LABELV                   14399000          
                            THEN                                        14400000          
                               BEGIN                                    14401000          
                                 STOPDEFINE~STOPGSP~STOPENTRY~TRUE;     14402000          
    DO BEGIN STOPDEFINE~TRUE;STEPIT;ENTRY(STLABID);PUTNBUMP(0) END UNTIL14403000          
                  ELCLASS!COMMA;STOPGSP~STOPENTRY~FALSE                 14404000          
                                      END                               14405000          
                             ELSE                                       14406000          
                               BEGIN                                    14407000          
                                        I~I+1;                          14408000          
                                 ENTRY(LOCLID)                          14409000          
                               END                                      14410000          
                         END;                                           14411000          
         IF FUNCTOG  THEN                                               14411100          
              PUT((Z~TAKE(PROINFO))&LOCLID[2:41:7] &                    14411200          
                        (PJ+2+REAL(TESTLEV))[16:37:11],PROINFO);        14411300          
                      COMPOUNDTAIL                                      14412000          
                   END                                                  14413000          
                ELSE                                                    14414000          
         BEGIN                                                          14415000          
         IF   FUNCTOG  THEN                                             14415100          
              PUT(( Z~TAKE(PROINFO))& LOCLID[2:41:7]&                   14415200          
                        (PJ+2+REAL(TESTLEV))[16:37:11],PROINFO);        14415300          
         STREAMSTMT;                                                    14415400          
         END;                                                           14415500          
    COMMENT THE FOLLOWING BLOCK CONSTITUTES THE STREAM PROCEDURE PURGE; 14416000          
         BEGIN                                                          14417000          
         REAL NLOC,NLAB;                                                14418000          
         DEFINE SES=18#,SED=6#,TRW=5#;                                  14419000          
         DEFINE LOC=[36:12]#,LASTGT=[24:12]#;                           14420000          
         J~  LASTINFO;                                                  14421000          
              NLOC~NLAB~0;                                              14422000          
         DO                                                             14423000          
         BEGIN                                                          14424000          
         IF(GT1~TAKE(J)).CLASS=LOCLID THEN                              14425000          
              BEGIN                                                     14426000          
              IF BOOLEAN(GT1.FORMAL) THEN                               14427000          
                   BEGIN                                                14428000          
                   IF GT1<0 THEN                                        14429000          
                   PUT(TAKE(GT2~MARK+P-GT1.ADDRESS+1)&FILEID[2:41:7]    14430000          
                        ,GT2);                                          14431000          
                   END                                                  14432000          
              ELSE  NLOC~NLOC+1;                                        14433000          
              END                                                       14434000          
         ELSE                                                           14435000          
              BEGIN                                                     14436000          
              IF  GT1.ADDRESS!0 THEN NLAB~NLAB+1;                       14437000          
              IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN         14438000          
                   BEGIN                                                14439000          
                   MOVE(9,INFO[0,J],ACCUM[0]);                          14440000          
                   Q~ACCUM[1];                                          14441000          
                   FLAG(267);                                           14442000          
                   ERRORTOG~TRUE;                                       14443000          
                   END;                                                 14444000          
              END;                                                      14445000          
         G~(GT2~TAKE(J+1)).PURPT;                                       14446000          
         IF  GT1.[2:8] ! STLABID|2+1  THEN                              14447000          
              STACKHEAD[(0&GT2[12:12:36])MOD 125]~TAKE(J).LINK;         14448000          
         END UNTIL J~J-G{1;                                             14449000          
                                                                        14450000          
         IF   TESTLEV   THEN BEGIN EMITC(1,0); EMITO(BFW) END           14451000          
                        ELSE  EMIT(0);                                  14451100          
PUT(TAKE(MARK)&NLOC[1:42:6]&L[16:36:12]&P[40:40:8],MARK);               14451200          
         IF FUNCTOG THEN                                                14452000          
              PUT(Z, PROINFO);                                          14457000          
         STREAMWORDS;                                                   14460000          
         STREAMTOG~FALSE;                                               14461000          
     IF NOT TESTLEV THEN BEGIN PROGDESCBLDR(PROAD,TRUE,(L+3)DIV 4,CHAR);14461100          
                                  SEGMENT((L+3)DIV 4,PROINFO.ADDRESS);  14461200          
                                       RIGHT(L); L~0;                   14461300          
                        END;                                            14461400          
         IF LISTER AND FORMATOG THEN SPACEITDOWN;                       14461500          
         END;                                                           14462000          
             LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1;                      14463000          
         END                                                            14464000          
     ELSE                                                               14465000          
         BEGIN                                                          14466000          
      IF STEPI=FORWARDV                                                 14467000          
        THEN                                                            14468000          
         BEGIN                                                          14469000          
           PUT(-TAKE(G~PROINFO.LINK+1),G);                              14470000          
                PURGE(PINFOO);                                          14471000          
           STEPIT                                                       14472000          
         END                                                            14473000          
        ELSE                                                            14474000          
         BEGIN                                                          14475000          
      PROADO~PROAD;                                                     14476000          
          TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR;        14477000          
     IF MODE=1 THEN FRSTLEVEL~LEVEL;STACKCTR~513+REAL(FUNCTOG);         14478000          
           IF ELCLASS = BEGINV THEN                                     14479000          
      BEGIN                                                             14481000          
              CALLINFO~(CALLX~CALLX+1)+1;                               14481100          
              NESTCTR~STACKCTR;                                         14481200          
                BLOCK(TRUE)                                             14482000          
              ; PURGE(PINFOO);                                          14483000          
              IF NESTOG THEN                                            14483100          
              BEGIN GT1~TAKE(PROINFO).ADDRESS;                          14483200          
                   NESTPRT[GT1]~0&PROINFO[35:35:13]&CALLINFO[22:35:13]; 14483300          
                   CALL[CALLINFO-1]~(TAKE(GIT(PROINFO))+NESTCTR-511)&   14483400          
                        CALLX[22:35:13];                                14483500          
              END;                                                      14483600          
              L~0;                                                      14483700          
                GO TO STOP END;                                         14484000          
                 BEGIN                                                  14485000          
 FLAG(052);                                                             14486000          
                    RELAD~L  ;                                          14487000          
          STMT;                                                         14488000          
                HTTEOAP(FALSE,RELAD,PINFOO,PROAD);                      14489000          
                 END;                                                   14490000          
   STOP:                                                                14491000          
       SUBLEVEL~TSUBLEVEL;                                              14492000          
       STACKCTR~STACKCTRO;                                              14493000          
       IF LISTER AND FORMATOG THEN SPACEITDOWN;                         14493500          
         END;                                                           14494000          
         END;                                                           14495000          
      PROINFO~LO;                                                       14496000          
      IF JUMPCTR=LEVEL                                                  14497000          
         THEN                                                           14498000          
                  JUMPCTR~LEVEL-1;                                      14499000          
             LEVEL~LEVEL-1;                                             14500000          
           MODE~MODE-1;                                                 14501000          
              MAXSTACK~MAXSTACKO;                                       14502000          
START:END;                                                              14503000          
          GO TO START;                                                  14504000          
 CALLSTATEMENT: FOULED ~ L;                                             14505000          
     JUMPCHKX;IF SOP THEN BEGIN Z~STACKCTR-513;WHILE Z~Z-1}0            14506000          
                                   DO EMITL(0)   END;                   14506500          
             IF SPECTOG THEN BEGIN                                      14507000          
                               FLAG(12);GO TO HF                        14508000          
                             END;                                       14509000          
             BEGINCTR ~ BEGINCTR-1;                                     14510000          
             IF ERRORTOG                                                14511000          
               THEN COMPOUNDTAIL                                        14512000          
               ELSE                                                     14513000          
                 BEGIN                                                  14514000          
                  STMT;                                                 14515000          
                  IF ELCLASS~TABLE(I+1)=DECLARATORS                     14516000          
                    THEN                                                14517000          
                      BEGIN                                             14518000          
                        ELBAT[I].CLASS~SEMICOLON;                       14519000          
                        BEGINCTR~BEGINCTR+1;                            14520000          
                        GO TO START                                     14521000          
                      END                                               14522000          
                    ELSE                                                14523000          
                      COMPOUNDTAIL                                      14524000          
                 END;                                                   14525000          
     FUNCTOG~FUNCTOGO;                                                  14599000          
     IF SOP THEN HTTEOAP(FALSE,FIRSTX,NINFOO,BLKAD)                     14600000          
         ELSE BEGIN IF NESTOG THEN SORTNEST; PURGE(NINFOO); END;        14601000          
     SEGMENT((L+3)DIV 4,PROADO);                                        14602000          
         IF LEVEL>1 THEN RIGHT(L);                                      14603000          
    IF LEVEL ~ LEVEL-1 = 0 THEN CONSTANTCLEAN;                          14604000          
                                                                        14605000          
    AJUMP~AJUMPO;                                                       14606000          
                                                                        14607000          
       FIRSTX~FIRSTXO;                                                  14608000          
    SAVEL~SAVELO;                                                       14609000          
    STACKCTR~STACKCTRO;                                                 14610000          
                                                                        14611000          
                                                                        14612000          
END BLOCK;                                                              14613000          
 COMMENT THIS SECTION CONTAINS THE VARIABLE ROUTINE AND ITS SIDEKICKS;  15000000          
                                                                        15001000          
                                                                        15002000          
                                                                        15003000          
                                                                        15004000          
                                                                        15005000          
                                                                        15006000          
                                                                        15007000          
                                                                        15008000          
                                                                        15009000          
                                                                        15012000          
                                                                        15013000          
                                                                        15014000          
                                                                        15015000          
                                                                        15016000          
                                                                        15017000          
                                                                        15018000          
                                                                        15019000          
                                                                        15020000          
                                                                        15021000          
                                                                        15022000          
                                                                        15023000          
                                                                        15024000          
                                                                        15025000          
                                                                        15026000          
                                                                        15027000          
                                                                        15028000          
                                                                        15029000          
                                                                        15030000          
                                                                        15031000          
                                                                        15032000          
                                                                        15033000          
                                                                        15034000          
                                                                        15035000          
                                                                        15036000          
                                                                        15037000          
                                                                        15038000          
    COMMENT  THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES            15039000          
              OF SIMPLE VARIABLES:                                      15040000          
                 1. V ~ EXP       ,WHERE V IS FORMAL-CALL BY NAME.      15041000          
                 2. V ~ EXP       ,ALL V EXCEPT FORMAL-NAME.            15042000          
                 3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME.      15043000          
                 4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME.            15044000          
                 5. V.[S:L]       ,ALL V.                               15045000          
                 6. V             ,ALL V.                               15046000          
              CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS:            15047000          
                 1. VN,EXP,M*,XCH,~.                                    15048000          
                 2. EXP,M*,VL,~.                                        15049000          
                 3. VN,DUP,COC,EXP,T,M*,XCH,~.                          15050000          
                 4. VV,EXP,T,M*,VL,~.                                   15051000          
                 5. ZEROL,VV,T .                                        15052000          
                 6. VV .                                                15053000          
                 WHERE VN = DESC V                                      15054000          
                        EXP= ARITH. OR BOOLEAN EXPRESSION,AS REQUIRED.  15055000          
                        M* = CALL ON MONITOR ROUTINE,IF REQUIRED.       15056000          
                        VL = LITC V                                     15057000          
                        VV = OPDC V                                     15058000          
                        ~  = STORE INSTRUCTION(ISD,ISN,SND OR STD).     15059000          
                        T  = BIT TRANSFER CODE(DIA,DIB,TRB).            15060000          
                        ZEROL = LITC 0                                  15061000          
                        DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000          
              OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS   15063000          
              THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A   15064000          
              GLOBAL FASHION.                                           15065000          
              THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE     15066000          
              WHO CALLED IT.  SOME OF THE CODE GENERATION AND SOME      15067000          
              SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 .      15068000          
                                                            ;           15069000          
 PROCEDURE VARIABLE(P1); INTEGER P1;                                    15070000          
              BEGIN                                                     15071000          
              REAL TALL,  COMMENT ELBAT WORD FOR VARIABLE;              15072000          
                   T1  ,  COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX;   15073000          
                   T2  ,  COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX;   15074000          
                   J   ;  COMMENT SUBSCRIPT COUNTER ;                   15075000          
              LABEL EXIT,L1,LAST,NEXT,JAZZ,ITUP,LASS;                   15076000          
              DEFINE FORMALNAME=[9:2]=2#, LONGID=NAMEID#;               15076100          
              BOOLEAN SPCLMON;                                          15076200          
              TALL~ELBAT[I] ;                                           15077000          
              IF   ELCLASS { INTPROCID  THEN                            15078000          
                 BEGIN                                                  15079000          
                   IF TALL.LINK !PROINFO.LINK THEN                      15080000          
                        BEGIN ERR(211); GO TO EXIT END;                 15081000          
COMMENT  211  VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*;  15082000          
              TALL~TALL &(ELCLASS+4)[2:41:7] & 513[16:37:11];           15083000          
                 END                                                    15084000          
              ELSE  CHECKER(TALL);                                      15085000          
              IF TALL.CLASS { INTID  THEN                               15086000          
         BEGIN                                                          15087000          
                                                                        15088000          
                                                                        15089000          
              IF  STEPI= ASSIGNOP THEN                                  15090000          
              BEGIN STACKCT ~ 1;                                        15091000          
      L1:          IF  TALL.FORMALNAME  THEN                            15092000          
                   BEGIN                                                15093000          
                   EMITN(TALL.ADDRESS);                                 15094000          
                   IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END;        15095000          
                   END                                                  15096000          
                   ELSE IF T1!0 THEN EMITV(TALL.ADDRESS)                15097000          
              ; STACKCT ~ REAL(T1!0); STEPIT;                           15098000          
              AEXP;                                                     15099000          
                   EMITD(48-T2 ,T1 ,T2);                                15100000          
                                                                        15101000          
              STACKCT ~ 0;                                              15101500          
              GT1 ~ IF  TALL.CLASS =INTID  THEN IF  P1= FS              15102000          
                        THEN ISD ELSE ISN ELSE                          15103000          
                        IF P1 = FS THEN STD ELSE SND ;                  15104000          
              IF TALL.FORMALNAME  THEN                                  15105000          
                   BEGIN                                                15106000          
                   EMITO(XCH); IF TALL.ADDRESS>1023 THEN EMITO(PRTE);   15106100          
                   EMITO(GT1);                                          15106200          
                   END                                                  15106300          
              ELSE EMITPAIR(TALL.ADDRESS,GT1);                          15107000          
              END                                                       15108000          
         ELSE                                                           15109000          
              BEGIN                                                     15110000          
              IF P1=FL THEN BEGIN                                       15110100          
                   IF ELCLASS < AMPERSAND THEN EMITN(TALL.ADDRESS)      15110200          
                        ELSE EMITV(TALL.ADDRESS);                       15110300          
                   GO TO EXIT   END;                                    15110400          
              IF  ELCLASS= PERIOD THEN                                  15111000          
                 BEGIN  IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ;           15112000          
                        IF STEPI=ASSIGNOP  THEN                         15113000          
                            IF P1! FS  THEN                             15114000          
                            BEGIN ERR(201);GO  TO  EXIT END             15115000          
                                ELSE  GO TO L1                          15116000          
                                                                        15117000          
                 END ;                                                  15118000          
              IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END;            15119000          
COMMENT  202  VARIABLE- A  VARIABLE APPEARS WHICH IS NOT FOLLOWED     * 15120000          
                        BY A LEFT ARROW OR PERIOD                     *;15121000          
COMMENT  201  VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE          * 15122000          
                        LEFT-MOST OF A LEFT PART LIST                 *;15123000          
              EMITI(TALL,T1,T2);                                        15124000          
                                                                        15125000          
              END      ;                                                15126000          
              END  OF SIMPLE VARIABLES                                  15127000          
              ELSE                                                      15128000          
              IF TALL.CLASS!LABELID THEN                                15128100          
    COMMENT   THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED    15129000          
              VARIABLES:                                                15130000          
                 1. V[*]         ,ROW DESIGNATOR FOR SINGLE-DIMENSION.  15131000          
                 2. V[R,*]       ,ROW DESIGNATOR FOR MULTI-DIMENSION.   15132000          
                 3. V[R]         ,ARRAY ELEMENT,NAME OR VALUE.          15133000          
                 4. V[R].[S:L]   ,PARTIAL WORD DESIGNATOR, VALUE.       15134000          
                 5. V[R] ~       ,ASSIGNMENT TO ARRAY ELEMENT.          15135000          
                 6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000          
              R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK.       15137000          
              IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE     15138000          
              IS EMITTED FOR THE ABOVE CASES:                           15139000          
                      1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE  15140000          
                         DIMENSION. THE CODE EMITTED IS:                15141000          
                            VL,LOD .                                    15142000          
                         EXECUTION: PLACES ARRAY DESCRIPTER IN REG A.   15143000          
                      2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.15144000          
                         EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE15145000          
                         OF CODE:                                       15146000          
                            AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000          
                              ,LOD.                                     15148000          
                         FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE    15149000          
                         PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO  15150000          
                         THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000          
                         PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000          
                         [* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000          
                         NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT       15154000          
                         EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000          
                         EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A15156000          
                                   . THE SPECIFIC ROW DEPENDS UPON THE  15157000          
                                   VALUES OF THE K-1 SUBSCRIPTS.        15158000          
              FOR THE REMAINING CASES,                                  15159000          
                         SEQUENCES OF CODE ARE EMITED AS IN CASE #2.    15160000          
                         HOWEVER,THE ACTUAL SEQUENCES ARE:              15161000          
                          ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.15162000          
                          K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN     15163000          
                          ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING      15164000          
                          SUBSCRIPTS,IF K>1.                            15165000          
                         AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED   15166000          
                         AND ADDITION CODE,PARTICULAR TO EACH CASE,IS   15167000          
                         EMITTED.                                       15168000          
                      3. ADD THE SEQUENCE:                              15169000          
                           IF FIRST SUBSCRIPT THEN VV ELSE COC.         15170000          
                         EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A.  15171000          
                      4. ADD THE SEQUENCE:                              15172000          
                           IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL,   15173000          
                             XCH,T.                                     15174000          
                      5. ADD THE SEQUENCE:                              15175000          
                           IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP,     15176000          
                             XCH,~.                                     15177000          
                      6. ADD THE SEQUENCE:                              15178000          
                           IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD, 15179000          
                             EXP,T, XCH,~.                              15180000          
              EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN       15181000          
              SIMPLE VARIABLE BLOCK.                                ;   15182000          
         BEGIN                                                          15183000          
                                                                        15184000          
                                                                        15184100          
                                                                        15184200          
                                                                        15184300          
                                                                        15184400          
         IF STEPI ! LFTBRKET THEN                                       15233000          
         BEGIN                                                          15233002          
         IF ELCLASS = PERIOD THEN                                       15233003          
              BEGIN                                                     15233004          
              IF DOTSYNTAX(T1,T2) THEN GO TO EXIT;                      15233005          
              IF STEPI = ASSIGNOP THEN                                  15233006          
                   BEGIN                                                15233007          
                   IF  P1!FS  THEN BEGIN ERR(209); GO EXIT END;         15233008          
                   IF TALL.CLASS { INTARRAYID THEN                      15233009          
                   BEGIN EMITPAIR(TALL.ADDRESS,LOD)  END                15233010          
              ELSE EMITN(TALL.ADDRESS); STACKCT ~ STACKCT+1;            15233011          
    JAZZ:          STEPIT;   AEXP;                                      15233012          
                   EMITD(48-T2,T1,T2);                                  15233013          
                   EMITPAIR(TALL.ADDRESS,                               15233014          
                         IF P1=FS THEN STD ELSE SND);                   15233015          
              STACKCT ~ 0; END                                          15233016          
              ELSE BEGIN                                                15233017          
    ITUP:     EMITI(TALL,T1,T2);                                        15233018          
                                                                        15233019          
                                                                        15233020          
                                                                        15233021          
                                                                        15233022          
                   END;                                                 15233023          
              GO TO EXIT ;                                              15233024          
              END;                                                      15233025          
         IF ELCLASS = ASSIGNOP THEN  GO TO JAZZ ELSE GO TO ITUP ;       15233026          
         END;                                                           15233027          
              J ~ 0;                                                    15234000          
              STACKCT ~ 0;                                              15234500          
COMMENT  207  VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE  *;  15235000          
    NEXT:     IF STEPI = FACTOP THEN                                    15253000          
                   BEGIN                                                15254000          
                   IF   J+1! TALL.INCR THEN                             15255000          
                                BEGIN ERR(203);GO EXIT END;             15256000          
COMMENT  203  VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW        * 15257000          
                        ROW DESIGNATER  DOES NOT MATCH THE ARRAY      * 15258000          
                        DECLARATION.                                  *;15259000          
                        IF STEPI ! RTBRKET THEN                         15260000          
                                BEGIN ERR(204);GO EXIT END;             15261000          
COMMENT  204  VARIABLE- COMPILER EXPECTS A  ]  IN A ROW DESIGNATER    *;15262000          
                                                                        15263000          
COMMENT  205  VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL    * 15264000          
                        STATEMENT OR ACTUAL PARAMETER LIST.           *;15265000          
                        IF  J=0  THEN                                   15266000          
                                  EMITPAIR(TALL.ADDRESS,LOD);           15267000          
                   STLB~0;                                              15273000          
                        STEPIT;                                         15274000          
                        GO TO EXIT;                                     15275000          
                   END OF ROW DESIGNATOR PORTION  ;                     15276000          
         IF ELCLASS=LITNO AND ELBAT[I].ADDRESS=0 AND TABLE(I+1)=RTBRKET 15276010          
              AND TALL.CLASS}NAMEID THEN                                15276020          
              BEGIN                                                     15276030          
              I~I+1;                                                    15276040          
              IF STEPI=ASSIGNOP THEN BEGIN                              15276050          
 LASS:             IF T1!0 THEN EMITV(TALL.ADDRESS);                    15276060          
                   STEPIT;  AEXP;  EMITD(48-T2,T1,T2);                  15276070          
                   EMITN(TALL.ADDRESS);                                 15276080          
                   EMITO(IF TALL.CLASS!NAMEID THEN                      15276090          
                        IF P1=FS THEN ISD ELSE ISN ELSE                 15276100          
                        IF P1=FS THEN STD ELSE SND);                    15276110          
              STACKCT ~ 0;                                              15276115          
                   GO TO EXIT     END                                   15276120          
              ELSE                                                      15276130          
              IF ELCLASS = PERIOD THEN BEGIN                            15276140          
                   IF DOTSYNTAX(T1,T2) THEN GO TO EXIT;                 15276150          
                   IF STEPI = ASSIGNOP THEN IF P1=FS THEN GO TO LASS    15276160          
                   ELSE BEGIN ERR(209); GO EXIT END;                    15276170          
                                  END;                                  15276180          
              IF P1=FS THEN BEGIN ERR(210); GO EXIT END;                15276190          
                                                                        15276200          
              EMITI(IF P1=FL THEN TALL ELSE TALL&REALID[2:41:7],T1,T2); 15276210          
                                                                        15276220          
              GO TO EXIT;                                               15276230          
              END;                                                      15276240          
              AEXP;                                                     15277000          
              STACKCT ~ 1;                                              15278000          
              J ~ J + 1;                                                15280000          
              IF  ELCLASS = COMMA THEN                                  15287000          
                   BEGIN                                                15288000          
COMMENT  *****     MONITOR FUNCTION M4 GOES HERE ;                      15289000          
    IF J = 1 THEN EMITV(TALL.ADDRESS) ELSE EMITO(COC);                  15290000          
                                                                        15291000          
                        GO TO NEXT;                                     15292000          
                   END OF SUBSCRIPT COMMA HANDLER ;                     15293000          
              IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END;     15294000          
COMMENT  206  VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000          
         GT1~IF TALL.CLASS}NAMEID THEN 1 ELSE TALL.INCR;                15295100          
         IF J!GT1  THEN                                                 15296000          
                             BEGIN ERR(208);GO TO EXIT END;             15297000          
COMMENT  208  VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH WITH      * 15298000          
                        ARRAY DECLARATION.                            *;15299000          
              IF STEPI = ASSIGNOP  THEN                                 15300000          
                 BEGIN                                                  15301000          
  LAST:  IF J=1 THEN EMITN(TALL.ADDRESS) ELSE EMITO(CDC);               15302000          
         IF  TALL.CLASS } LONGID THEN EMITO(INX);                       15303000          
              IF  T1= 0 THEN                                            15304000          
                        BEGIN IF P1= FR THEN GO TO EXIT END             15305000          
                   ELSE BEGIN EMITO(DUP);EMITO(LOD)END;   STEPIT;       15306000          
              AEXP;                                                     15307000          
                   EMITD(48-T2,T1,T2) ;                                 15308000          
                   EMITO(XCH);                                          15309000          
                   IF TALL.ADDRESS>1023 THEN EMITO(PRTE);               15310000          
         EMITO(IF TALL.CLASS MOD 2 = INTARRAYID MOD 2 THEN              15333000          
                        IF  P1 = FS THEN ISD ELSE ISN ELSE              15334000          
                        IF P1=FS THEN STD ELSE SND);                    15335000          
              STACKCT ~ 0;                                              15335500          
                   P1~0  ;                                              15336000          
                   GO TO EXIT ;                                         15337000          
                 END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES;     15338000          
              IF  ELCLASS=PERIOD  THEN                                  15339000          
                 BEGIN                                                  15340000          
                   IF DOTSYNTAX(T1,T2) THEN GO TO EXIT;                 15341000          
                   IF STEPI = ASSIGNOP THEN IF P1=FS THEN GO TO LAST    15342000          
                        ELSE BEGIN ERR(209); GO EXIT END;               15343000          
         IF J!1 THEN EMITO(COC) ELSE IF TALL.CLASS } LONGID THEN        15344000          
              BEGIN EMITN(TALL.ADDRESS);EMITO(INX);EMITO(LOD) END       15344100          
              ELSE  EMITV(TALL.ADDRESS);                                15344200          
                 END                                                    15345000          
              ELSE                                                      15346000          
COMMENT  *****     MONITOR FUNCTION M10 GOES HERE   ;                   15347000          
                   BEGIN COMMENT MONITOR FUNCTION M10;                  15348000          
                        SPCLMON~P1 = FP OR ELCLASS } AMPERSAND;         15349000          
                        IF J = 1                                        15350000          
         THEN IF TALL.CLASS } LONGID THEN                               15351000          
              BEGIN                                                     15351100          
              EMITN(TALL.ADDRESS); EMITO(INX);                          15351200          
              IF SPCLMON   THEN  EMITO(LOD) ;                           15351300          
              END   ELSE  IF  SPCLMON                                   15351400          
                             THEN EMITV(TALL.ADDRESS)                   15352000          
                             ELSE EMITN(TALL.ADDRESS)                   15353000          
                        ELSE EMITO(IF SPCLMON                           15354000          
                                  THEN COC                              15355000          
                                  ELSE CDC);                            15356000          
                        IF P1 =FS THEN ERR(210);                        15364000          
                        GO TO     EXIT;                                 15365000          
                   END;                                                 15366000          
              IF P1=FS THEN BEGIN ERR(210); GO TO EXIT END ;            15367000          
COMMENT  210  VARIABLE-MISSING LEFT ARROW OR PERIOD.                  *;15368000          
              STACKCT ~ 0;                                              15369000          
              IF T1 ! 0 THEN BEGIN EMITI(0,T1,T2); P1 ~ 0 END;          15370000          
              END OF SUBSCRIPTED VARIABLES                              15376000          
              ELSE                                                      15376100          
              BEGIN COMMENT LABELID;                                    15376200          
              T1:=TAKE(T2:=GIT(TALL));                                  15376300          
              PUT(L,T2);                                                15376400          
              IF T1=0 THEN T1:=L;                                       15376500          
              IF (T1~L-T1) DIV 4 > 127 THEN BEGIN T1~0;FLAG(50);END;    15376600          
              EMIT(T1|4+3);                                             15376700          
              STEPIT;                                                   15376800          
              END OF LABELID;                                           15376900          
    EXIT  :  END  OF THE VARIABLE ROUTINE;                              15377000          
COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES;              16000000          
COMMENT  DO  LABEL DECS UPON APPEARANCE OF LABEL  ;                     16000050          
PROCEDURE DECLARELABEL ;                                                16000100          
              BEGIN                                                     16000200          
              KLASSF ~ STLABID;                                         16000300          
              VONF ~ FORMALF ~ FALSE;                                   16000400          
              ADDRSF ~ 0;                                               16000500          
              MAKEUPACCUM;  E; PUTNBUMP(0);                             16000600          
              ELBAT[I] ~ ACCUM[0]& LASTINFO[35:35:13];                  16000700          
              END;                                                      16000800          
 PROCEDURE STREAMSTMT ;                                                 16001000          
         BEGIN                                                          16002000          
         DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#,       16003000          
              LOCFLD=36:36:12#,LGTFLD=24:24:12#;                        16004000          
         DEFINE LEVEL=LVL#,ADDOP=ADOP#;                                 16005000          
 DEFINE                                                                 16006000          
         JFW  =  39#,   COMMENT  7.5.5.1  JUMP FORWARD UNCONDITIONAL  ; 16007000          
          RCA =  40#, COMMENT    7.5.7.6  RECALL CONTROL ADDRESS      ; 16008000          
         JRV  =  47#,  COMMENT   7.5.5.2  JUMP REVERSE UNCONDITIONAL  ; 16009000          
         CRF  =  35#,  COMMENT    7.5.10.6 CALL REPEAT FIELD          ; 16010000          
          BNS =  42#,  COMMENT   7.5.5.5  BEGIN LOOP                  ; 16011000          
         NOP  =   1#,  COMMENT                                        ; 16012000          
         ENS  =  41#,  COMMENT   7.5.5.6  END LOOP                    ; 16013000          
         TAN  =  30#,  COMMENT   7.5.3.7  TEST FOR ALPHAMERIC         ; 16014000          
         BIT  =  31#,  COMMENT   7.5.3.8  TEST BIT                    ; 16015000          
          JFC =  37#,  COMMENT   7.5.5.3  JUMP FORWARD CONDITIONAL    ; 16016000          
         SED  =  06#,  COMMENT   7.5.7.8  SET DESTINATION ADDRESS     ; 16017000          
         RSA  =  43#,  COMMENT   7.5.7.4  RECALL SOURCE ADDRESS       ; 16018000          
         TRP  =  60#,  COMMENT   7.5.2.2  TRANSFER PROGRAM CHARACTERS ; 16019000          
         BSS  =   3#,  COMMENT   7.5.6.6  SKIP SOURCE BIT             ; 16020000          
         BSD  =   2#,  COMMENT   7.5.6.5  SKIP DESTINATION BITS       ; 16021000          
         SEC  =  34#,     COMMENT   7.5.10.1  SET COUNT             ;   16022000          
         JNS  =  38#;   COMMENT  7.5.5.7  JUMP OUT LOOP               ; 16023000          
PROCEDURE ADJUST;;                                                      16023100          
    COMMENT FIXC EMITS  BASICLY FORWARD JUMPS. HOWEVER IN THE CASE      16024000          
              OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON    16025000          
              A VALUE = 0 AND THE JUMP } 64 SYLLABLES A JFW 1 AND       16026000          
              A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH       16027000          
              MUST ALSO BE MANUFACTURED) IS EMITTED.  ;                 16028000          
 PROCEDURE FIXC(S); VALUE S; REAL S;                                    16029000          
         BEGIN                                                          16030000          
         REAL SAVL,D,F;                                                 16031000          
              IF D~ (SAVL~L) - (L~S)-1 { 63 THEN EMITC(D,GET(S))        16032000          
                   ELSE  FLAG(700);                                     16033000          
              L~SAVL ;                                                  16034000          
         END  FIXC  ;                                                   16057000          
    COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN.                  16058000          
              THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63     16059000          
              SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE   16060000          
              STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN   16061000          
              RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000          
              INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000          
              POINTING TO OUR LABEL IN QUESTION.  ;                     16064000          
 PROCEDURE EMITJUMP( E); VALUE E; REAL E;                               16065000          
         BEGIN                                                          16066000          
         REAL T,D;                                                      16067000          
         REAL ADDR;                                                     16068000          
         IF ABS(                                                        16069000          
         D~(T~TAKE(GIT(E)).LOC)-L-1)}64 THEN                            16070000          
              FLAG(700)                                                 16071000          
         ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW);                       16079000          
         END  EMIT JUMP;                                                16080000          
    COMMENT   WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE16081000          
              ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED  16082000          
              TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000          
              LINK IS = 4096.  ;                                        16084000          
 PROCEDURE JUMPCHAIN( E); VALUE E;REAL E;                               16085000          
         BEGIN                                                          16086000          
         REAL SAVL ,LINK;                                               16087000          
         SAVL ~ L;                                                      16088000          
         L ~  TAKE(GIT(E)).LASTGT ;                                     16089000          
         WHILE L! 4095 DO                                               16090000          
              BEGIN                                                     16091000          
              LINK ~ GET(L);                                            16092000          
              EMITJUMP( E);                                             16093000          
              L ~ LINK                                                  16094000          
              END;                                                      16095000          
         L~SAVL;                                                        16096000          
         END  JUMPCHAIN  ;                                              16097000          
    COMMENT NESTS COMPILES THE NEST STATEMENT.                          16098000          
              A VARIABLE NEST INDEX CAUSES THE CODE,                    16099000          
                   CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY.    16100000          
              AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF    16101000          
              THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH {63,OTHERWISE16102000          
              IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1,    16103000          
              RCA P.  THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION  16104000          
              MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST.      16105000          
              JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND        16106000          
              NEST LEVEL INCREASED BY ONE.                              16107000          
              WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN     16108000          
              THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE   16109000          
              OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS     16110000          
              ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED     16111000          
              JUMPS.                                                    16112000          
              FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL       16113000          
              AND JOINFO RESTORED TO THEIR ORIGINAL VALUES.  ;          16114000          
 PROCEDURE NESTS;                                                       16115000          
         BEGIN                                                          16116000          
         LABEL EXIT;                                                    16117000          
         REAL JOINT,BNSFIX;                                             16118000          
         IF ELCLASS!LITNO THEN                                          16119000          
              BEGIN                                                     16120000          
              EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L;                   16121000          
              EMIT(BNS);                                                16122000          
              END                                                       16123000          
         ELSE EMITC(ELBAT[I].ADDRESS,BNS);                              16124000          
         IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END;       16125000          
         NESTLEVEL~NESTLEVEL + 1;                                       16126000          
         JOINT ~ JOINFO;                                                16127000          
         JOINFO ~ 0;                                                    16128000          
         DO   BEGIN                                                     16129000          
              STEPIT; ERRORTOG ~ TRUE; STREAMSTMT                       16130000          
              END UNTIL ELCLASS ! SEMICOLON ;                           16131000          
         IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END;       16132000          
         EMIT (  ENS);                                                  16133000          
         IF JOINFO ! 0 THEN                                             16134000          
              BEGIN                                                     16135000          
    COMMENT   PREPARE TO CALL JUMPCHAIN FORJUMPOUTS;                    16136000          
              ADJUST;                                                   16137000          
              PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO));             16138000          
              JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]);                 16139000          
              END;                                                      16140000          
         IF BNSFIX ! 0 THEN FIXC(BNSFIX);                               16141000          
         NESTLEVEL ~ NESTLEVEL-1;                                       16142000          
         JOINFO ~ JOINT ;                                               16143000          
   EXIT: END  NESTS  ;                                                  16144000          
    COMMENT   LABELS HANDLES STREAM LABELS.                             16145000          
              ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT       16146000          
              WORD (IN THE PROGRAMSTREAM).                              16147000          
              IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL      16148000          
              THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000          
              [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO    16150000          
              HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000          
              MATCHES THE LEVEL OF THE LABEL.                           16152000          
              MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED.     16153000          
              FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS  16154000          
              AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES.  ;    16155000          
PROCEDURE LABELS;                                                       16156000          
         BEGIN                                                          16157000          
         REAL GT1;                                                      16157100          
         ADJUST;                                                        16158000          
         GT1 ~ ELBAT[I];                                                16159000          
         IF STEPI ! COLON THEN ERR(258)                                 16160000          
         ELSE                                                           16161000          
              BEGIN                                                     16162000          
              IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259);             16163000          
              IF GT1>0 THEN                                             16164000          
                   BEGIN                                                16165000          
                   PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1);            16166000          
                   PUT(-L,GT2)                                          16167000          
                   END                                                  16168000          
              ELSE                                                      16169000          
                   BEGIN                                                16170000          
                   IF GT1.LEVEL!NESTLEVEL THEN FLAG(257);               16171000          
                   PUT((-L)&TAKE(GT2)[LGTFLD],GT2);                     16172000          
                   JUMPCHAIN(GT1);                                      16173000          
                   END;                                                 16174000          
              END                                                       16175000          
         ;  STEPIT;                                                     16176000          
         END  LABELS  ;                                                 16177000          
    COMMENT   IFS COMPILES IF STATEMENTS.                               16178000          
              FIRST THE TEST IS COMPILED. NOTE THAT IN THE              16179000          
              CONSTRUCTS  "SC RELOP DC" AND  "SC RELOP STRING" THAT     16180000          
              THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS    16181000          
              IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR. OTHERWISE  16182000          
              THE CODE IS EMITTED STRAIGHTAWAY.                         16183000          
              A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE     16184000          
              "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF  16185000          
              SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE   16186000          
              TO BE GENERATED.                                          16187000          
              THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES          16188000          
              IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR        16189000          
              IF THEN GO TO L1 ELSE GO TO L2   ;                        16190000          
 PROCEDURE  IFS;   BEGIN                                                16191000          
         DEFINE COMPARECODE=[42:6]#,TESTCODE=[36:6]#;                   16192000          
         LABEL  IFSB,IFTOG,IFSC,EXIT;                                   16193000          
         SWITCH IFSW ~ IFSB,IFTOG,IFSC;                                 16194000          
         REAL ADDR,FIX1,FIX2  ;                                         16195000          
         ADDR~1  ;                                                      16196000          
         GO TO IFSW[STEPI -SBV+1] ;                                     16197000          
         IF ELCLASS=LOCLID THEN                                         16198000          
              BEGIN                                                     16199000          
              EMITC(ELBAT[I].ADDRESS,CRF);                              16200000          
              ADDR~0;                                                   16201000          
              END                                                       16202000          
         ELSE                                                           16203000          
              IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS             16204000          
         ELSE BEGIN ERR(250); GO TO EXIT END;                           16205000          
         IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END;             16206000          
   IFSC: IF STEPI ! RELOP THEN BEGIN ERR(264);GO TO EXIT END;           16207000          
         IF STEPI = DCV THEN EMITC( ADDR,ELBAT[I-1].COMPARECODE)        16208000          
         ELSE                                                           16209000          
              IF ELCLASS = STRNGCON THEN                                16210000          
                   EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE)           16211000          
         ELSE                                                           16212000          
         IF ELCLASS=LITNO THEN EMITC(C,ELBAT[I-1].TESTCODE) ELSE        16212500          
         IF ELCLASS{IDMAX AND Q="5ALPHA" THEN EMITC(17,TAN)             16213000          
         ELSE BEGIN ERR(265);GO TO EXIT END;                            16214000          
         GO TO IFTOG  ;                                                 16215000          
   IFSB: EMITC(1,BIT);                                                  16216000          
  IFTOG: IF STEPI ! THENV THEN BEGIN ERR(266); GO TO EXIT  END;         16217000          
         FIX1 ~ L;                                                      16218000          
         EMIT(JFC);                                                     16219000          
         IF STEPI!ELSEV THEN%                                           16220000          
         STREAMSTMT;                                                    16229000          
         IF ELCLASS= ELSEV THEN                                         16230000          
              BEGIN                                                     16231000          
              FIX2 ~ L;  EMIT(JFW);                                     16232000          
              FIXC(FIX1);                                               16233000          
              STEPIT;                                                   16234000          
              STREAMSTMT;                                               16235000          
              FIXC(FIX2);                                               16236000          
              END                                                       16237000          
         ELSE FIXC(FIX1);                                               16238000          
    EXIT:END   IFS  ;                                                   16239000          
    COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO        16240000          
              STATEMENTS.                                               16241000          
              IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000          
              AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL  16243000          
              ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS    16244000          
              GO TOS IN THE CASE OF FORWARD JUMPS.                      16245000          
              FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED  16246000          
              AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO   16247000          
              BE JUMPED OUT. OTHERWISE,NEST LEVEL IS DEFINED.  ;        16248000          
 PROCEDURE GOTOS;                                                       16249000          
         BEGIN                                                          16250000          
         LABEL EXIT;                                                    16251000          
         IF STEPI !TOV THEN I~I-1 ;                                     16252000          
              IF STEPI ! STLABID THEN IF ELCLASS { IDMAX THEN           16253000          
                   DECLARELABEL ELSE BEGIN ERR(260); GO TO EXIT END;    16253100          
         IF(GT2~TAKE(GIT(GT1~ELBAT[I]))).MON=1                          16254000          
         OR GT2.LOC!0 THEN EMITJUMP(GT1)                                16255000          
         ELSE                                                           16256000          
           BEGIN   PUT(0&L[24:36:12],GIT(GT1));                         16257000          
              IF GT1>0 THEN                                             16258000          
                   BEGIN                                                16259000          
                   PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEVEL)[11:43:5]),GT1);16260000          
                   EMITN(1023);                                         16261000          
                   END                                                  16262000          
              ELSE                                                      16263000          
                   BEGIN                                                16264000          
                   IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257);   16265000          
                   EMIT(GT2.LASTGT);                                    16266000          
              END;                                                      16267000          
           END;                                                         16268000          
         JUMPLEVEL~0 ;                                                  16269000          
   EXIT: END  GOTOS   ;                                                 16270000          
    COMMENT  RELEASES COMPILES THE STREAM RELEASE STATEMENT.            16271000          
              THE CODE GENERATED IS :                                   16272000          
                   SED  FILE                                            16273000          
                   RSA  0.                                              16274000          
              AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000          
              INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000          
              BY THE DESTINATION ADDRESS.                               16277000          
              THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO  16278000          
              THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE    16279000          
              MUST BE PASSED FOR THIS FORMAL PARAMETER;                 16280000          
                                                                        16281000          
                                                                        16282000          
                                                                        16283000          
                                                                        16284000          
                                                                        16285000          
                                                                        16286000          
                                                                        16287000          
                                                                        16288000          
                                                                        16289000          
    COMMENT   INDEXS  COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY   16290000          
              OR LOCALIDS .                                             16291000          
              THREE CASES PRESENT THEMSELVES,                           16292000          
                   LETING X BE EITHER OF  SI,DI,CI OR TALLY, THEY ARE:  16293000          
                   CASE I    LOCLID ~ X                                 16294000          
                   CASE II   X ~ X ...                                  16295000          
                   CASE III  X ~ EITHER LOC,LOCLID,SC OR DC.            16296000          
              THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH     16297000          
              CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS16298000          
              THE CODE TO BE EMITTED.                                   16299000          
              EACH ELEMENT OF MACRO HAS  1-3 SYLLABLES ORDERED FROM     16300000          
              RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0.    EACH MACRO   16301000          
              MAY REQUIRE AT MOST ONE REPEAT PART.                      16302000          
              IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000          
              PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE" IS    16304000          
              ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE]   16305000          
              ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS    16306000          
              USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH     16307000          
              THE PROPER  ADDRESS AND OPERATOR .                        16308000          
              NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX     16309000          
                    ERROR.                                      ;       16310000          
PROCEDURE INDEXS;                                                       16311000          
         BEGIN                                                          16312000          
         LABEL EXIT,GENERATE,L,L1;                                      16313000          
         INTEGER TCLASS,INDEX,ADDR,J;                                   16314000          
         TCLASS ~ ELCLASS ;                                             16315000          
         IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END;       16316000          
         IF TCLASS = LOCLID THEN                                        16317000          
              BEGIN                                                     16318000          
              IF SIV>STEPI OR ELCLASS>TALLYV THEN GO TO L;              16319000          
              INDEX ~ 32 + ELCLASS-SIV;                                 16320000          
              ADDR ~ ELBAT[I-2].ADDRESS;                                16321000          
              GO TO GENERATE;                                           16322000          
              END;                                                      16323000          
         IF TCLASS = STEPI THEN                                         16324000          
              BEGIN                                                     16325000          
              IF STEPI ! ADDOP OR STEPI! LITNO AND ELCLASS ! LOCLID THEN16326000          
                   GO TO L;                                             16327000          
              INDEX ~ TCLASS-SIV                                        16328000          
                   +REAL(ELBAT[I-1].ADDRESS=SUB) | 4                    16329000          
                   + REAL(ELCLASS =LOCLID) | 8;                         16330000          
              END                                                       16331000          
         ELSE                                                           16332000          
              BEGIN                                                     16333000          
              INDEX ~ TCLASS -SIV                                       16334000          
                  + ( IF ELCLASS = LOCLID THEN 16 ELSE                  16335000          
                   IF ELCLASS = LOCV THEN 20 ELSE                       16336000          
                   IF ELCLASS = SCV THEN 24 ELSE                        16337000          
                   IF ELCLASS= DCV  THEN 28 ELSE 25);                   16338000          
              IF ELCLASS = LOCV THEN                                    16339000          
                   IF STEPI ! LOCLID THEN GO TO L;                      16340000          
              IF ELCLASS = LITNO AND TCLASS = TALLYV THEN               16341000          
                   BEGIN EMITC(ELBAT[I].ADDRESS,SEC);GO TO EXIT END;    16342000          
              END ;                                                     16343000          
         ADDR ~ ELBAT[I].ADDRESS;                                       16344000          
    GENERATE:                                                           16345000          
         IF MACRO[INDEX]= 0 THEN                                        16346000          
      L:      BEGIN ERR(250);GO TO EXIT END;                            16347000          
         J ~ 8; TCLASS ~0 ;                                             16348000          
     L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 );                16349000          
         IF TCLASS!0 THEN                                               16350000          
              BEGIN                                                     16351000          
              EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS);              16352000          
              GO TO L1                                                  16353000          
              END;                                                      16354000          
    EXIT:END  INDEXS ;                                                  16355000          
    COMMENT  DSS COMPILES DESTINATION STREAM STATEMENTS.                16356000          
              DS~  LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE  16357000          
              STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF    16358000          
              NECESSARY, AND EMITTED TO THE PROGRAM STREAM.  IN         16359000          
              ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN   16360000          
              THE OPCODE FIELD  ;                                       16361000          
PROCEDURE DSS;                                                          16362000          
         BEGIN                                                          16363000          
         INTEGER ADDR,J,K,L,T;                                          16364000          
         LABEL EXIT,L1;                                                 16365000          
         DEFINE OPCODE=[27:6]#;                                         16366000          
         IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END;       16367000          
         IF STEPI = LOCLID THEN                                         16368000          
              BEGIN                                                     16369000          
              EMITC(ELBAT[I].ADDRESS,CRF);                              16370000          
              ADDR~ 0;                                                  16371000          
              IF STEPI = LITV THEN GO TO L1                             16372000          
              END                                                       16373000          
         ELSE IF ELCLASS= LITNO THEN                                    16374000          
              BEGIN                                                     16375000          
              ADDR ~ ELBAT[I].ADDRESS; STEPIT ;                         16376000          
              END                                                       16377000          
         ELSE ADDR ~ 1 ;                                                16378000          
         IF Q = "4FILL0" THEN EMITC(ADDR,10) ELSE                    %E 16378500          
         IF ELCLASS = TRNSFER THEN EMITC(ADDR,ELBAT[I].OPCODE)          16379000          
         ELSE                                                           16380000          
         IF ELCLASS = LITV THEN                                         16381000          
              BEGIN                                                     16382000          
              EMITC(ADDR,TRP);                                          16383000          
              IF STEPI!STRNGCON THEN                                    16384000          
                   BEGIN ERR(255);GO TO EXIT END;                       16384500          
              IF ADDR MOD 2 ! 0 THEN                                    16385000          
                   BEGIN                                                16386000          
                   EMIT(ACCUM[1].[18:6]);  J ~ 1;                       16387000          
                   END ;                                                16388000          
              FOR K ~J+2 STEP 2 UNTIL ADDR DO                           16389000          
                   BEGIN                                                16390000          
                   FOR L ~6,7 DO                                        16391000          
                   MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000          
                             ELSE J),T,L  );                            16393000          
                   EMIT(T);                                             16394000          
              END  END                                                  16395000          
         ELSE                                                           16396000          
       L1:    ERR(250);                                                 16397000          
    EXIT:END  DSS  ;                                                    16398000          
    COMMENT SKIPS  COMPILES THE SKIP BIT STATEMENT.                     16399000          
              IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED.   16400000          
              A  BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB)   16401000          
              OR   SKIP DESTINATION BITS (DB) RESPECTIVELY ;            16402000          
PROCEDURE SKIPS ;                                                       16403000          
         BEGIN                                                          16404000          
         REAL ADDR;                                                     16405000          
         IF STEPI = LOCLID THEN                                         16406000          
              BEGIN                                                     16407000          
              EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT;              16408000          
              END                                                       16409000          
         ELSE IF ELCLASS = LITNO THEN                                   16410000          
              BEGIN                                                     16411000          
              ADDR~ ELBAT[I].ADDRESS; STEPIT                            16412000          
              END                                                       16413000          
         ELSE ADDR ~ 1 ;                                                16414000          
         IF ELCLASS =SBV THEN EMITC(ADDR,BSS)                           16415000          
         ELSE                                                           16416000          
         IF ELCLASS =DBV THEN  EMITC(ADDR,BSD)                          16417000          
         ELSE ERR(250);                                                 16418000          
         END  SKIPS  ;                                                  16419000          
    COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS.         16420000          
              JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO      16421000          
              THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF       16422000          
              JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE        16423000          
              JUMP INSTRUCTION.                                         16424000          
              SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000          
              A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT   16426000          
              THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING    16427000          
              UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000          
              THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING16429000          
              GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED.     ;         16430000          
PROCEDURE JUMPS;                                                        16431000          
         BEGIN                                                          16432000          
         JUMPLEVEL~1;                                                   16433000          
              IF STEPI!DECLARATORS THEN IF ACCUM[1]!"3OUT00" THEN       16434000          
                                         FLAG(261);                     16434100          
         IF STEPI = LITNO THEN JUMPLEVEL~ ELBAT[I].ADDRESS              16435000          
         ELSE BEGIN                                                     16436000          
              IF ELCLASS! TOV AND ELCLASS! STLABID THEN                 16437000          
              BEGIN                                                     16438000          
    COMMENT   SIMPLE JUMP OUT STATEMENT;                                16439000          
              IF JOINFO = 0 THEN                                        16440000          
                   BEGIN                                                16441000          
                   JOINFO ~ NEXTINFO ;                                  16442000          
                   PUTNBUMP(STACKHEAD[0].LINK&(STLABID|2+1)             16443000          
                        [2:40:8]&2[27:40:8 ]);                          16444000          
                   PUTNBUMP(0&(JOINFO-LASTINFO   )[ 4:40:8]);           16445000          
                   PUTNBUMP (0);                                        16446000          
                   LASTINFO ~ JOINFO;                                   16447000          
                   END;                                                 16448000          
              ELBAT[I~  I-1]~  TAKE(JOINFO)&JOINFO[35:35:13];           16449000          
              END; I~I-1 ;                                              16450000          
         END;                                                           16451000          
         FOR GT1~ 1 STEP 1 UNTIL JUMPLEVEL DO                           16452000          
              EMIT(  JNS);                                              16453000          
         GOTOS;                                                         16454000          
         END JUMPS;                                                     16455000          
    COMMENT STREAMSTMT  ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE     16456000          
              THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS.       16457000          
              THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS:                16458000          
                   IDENTIFIED BY          PROCEDURE ENVOKED             16459000          
                     END                    GO TO FINI                  16460000          
                     SEMICOLON              GO TO FINI                  16461000          
                     )                      GO TO FINI                  16462000          
                     IF                     IFS                         16463000          
                     GO                     GOTOS                       16464000          
                     RELEASE                RELEASES                    16465000          
                   BEGIN                    COMPOUNDTAIL                16466000          
                   SI,DI,CI,TALLY,LOCALID INDEXS                        16467000          
                   DS                       DSS                         16468000          
                   SKIP                     SKIPS                       16469000          
                     JUMP                   JUMPS                       16470000          
                     LABELID                LABELS                      16471000          
                     LITERAL NO.,LOCALID(   NESTS                       16472000          
              UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO        16473000          
              THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 16474000          
         LABEL  L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,EXIT,FINI,START;       16475000          
         SWITCH TYPE ~ FINI,L,FINI,L3,L4,L5,L6,L7,L7,L7,L7,L8,L9,L10;   16476000          
    START:    GO TO TYPE[ ELCLASS-ENDV+1];                              16477000          
              IF ELCLASS= RTPAREN THEN GO TO FINI ;                     16478000          
              IF ELCLASS= STLABID THEN GO TO L2 ;                       16481000          
                                                                        16482000          
         IF ELCLASS <IDMAX AND ELCLASS!LOCLID THEN BEGIN                16482100          
              DECLARELABEL; GO TO L2;  END;                             16482200          
         IF ELCLASS = LITNO OR ELCLASS = LOCLID AND TABLE(I+1)          16482300          
                = LFTPAREN THEN GO TO L1;                               16482400          
         IF ELCLASS = LOCLID  THEN  GO TO L7;                           16482500          
       L:     ERR( 250 ); GO TO FINI ;                                  16483000          
       L1:    NESTS;    GO TO EXIT;                                     16484000          
       L2:    LABELS;   GO TO START;                                    16485000          
       L3:    IFS;      GO TO FINI;                                     16486000          
       L4:    GOTOS;    GO TO EXIT;                                     16487000          
L5:                                                                     16488000          
       L6:    I~I+1 ; COMPOUNDTAIL; GO TO FINI;                         16489000          
       L7:    INDEXS;   GO TO EXIT;                                     16490000          
       L8:    DSS;      GO TO EXIT;                                     16491000          
       L9:    SKIPS;    GO TO EXIT;                                     16492000          
       L10:   JUMPS;    GO TO EXIT;                                     16493000          
     EXIT:    STEPIT;                                                   16494000          
     FINI:    END   STREAMSTMT;                                         16495000          
MOVE(1,I,CODE(0));                                                      16495100          
TIME1 ~ TIME(1); PROGRAM;                                               16495200          
ENDOFITALL:END MAIN BLOCK                                               16495210          
END.                                                                    16495300          
