diff --git a/tools/xem/ESPOLXEM.alg_m b/tools/xem/ESPOLXEM.alg_m new file mode 100644 index 0000000..213ddfc --- /dev/null +++ b/tools/xem/ESPOLXEM.alg_m @@ -0,0 +1,6926 @@ +%#######################################################################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 IS 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. 00069580 + 099 INLINE: EXTRA : IN STREAM HEAD. 00069590 + 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,SIMBOO, 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] #, 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 CHARACTERS 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 PARAMETER 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 + ADDOP =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 PAGE 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 COMPOUNDTAIL; 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 BLOCK 01460000 + 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 TALLIED 01465000 + 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 "OCRDIMG"(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 +$ RESET NEATUP 01631990120809PK + 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 EQUIVALENCE; 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 +$ SET NEATUP 01682100120809PK +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 + "%" 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],); 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],,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 XBIT9 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>1[35:43:5]>2[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 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]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 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 EXRESSION 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: (); 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: []; 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; GOTO 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 FORM 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>1[41:47:1]>1[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 + OCT0650006550000002, "6SCOPO", "N......."; %509 09121600 + FILL INFO[2,*] WITH 09121650 + OCT131030000020004., "3RDF00", %512 09121700 + OCT0000, COMMENT LITC 0; 09121800 + OCT2141, COMMENT FXS ; 09121900 + OCT131030000020004., "3RDS00", %516 09122000 + OCT0004, COMMENT LITC 1; 09122100 + OCT2141, COMMENT FXS ; 09122200 + OCT1310456000000002, "3RDV00", %520 09122300 + OCT1310304030000002, "3RFB00", %522 09122400 + OCT1310240470000002, "3RND00", %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", %688 09128400 + OCT1310117540000002, "3SAN00", %650 09128500 + OCT1310157730000002, "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))>2[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 +$ RESET NEATUP 09197100120809PK + 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 +$ SET NEATUP 09251100120809PK +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 DS ~ 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; DS~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(SAVEINFO,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>1[8:8:10] 09414080 + >1[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[D,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>2[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~PROADD; 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: INDEX: 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; 14165500 + 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 +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 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>2[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 + NEXTCTR~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,PROADD); 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 LEFT BRACKET 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 EMITI(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 +$ RESET NEATUP 16006100120809PK + 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 +$ SET NEATUP 16023050120809PK +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 STEP ! 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 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[1].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