diff --git a/SYMBOL/ESPOL.alg_m b/SYMBOL/ESPOL.alg_m new file mode 100644 index 0000000..be5a357 --- /dev/null +++ b/SYMBOL/ESPOL.alg_m @@ -0,0 +1,6912 @@ +%#######################################################################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 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 DECLARATION. 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 OF 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 FORMAT PHRASE . 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 IS 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 TYPE 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 AVE CONDITIONAL EXPRESSIONS 00082000 + AS THE ARITHMETIC EXPRESSIONS. 00083000 + 109 BODSEC,SIMPBOD, AND BODCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000 + 110 BODCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000 + EXPRESSION. 00086000 + 111 BOOPRIM: 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 DECLARATION. 00090000 + 113 PARSE: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS FOR00091000 + 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 COLON. 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 + CHARACTERS 00134000 + 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTERS 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 BRACKET 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 ( > 4093 SYLLABLES). 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 NON 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 START 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 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 LEVEL. 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:ILLEGAL 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 PRECEDING 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 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 FIEL 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: 00298000 + 460 RWNDSTMT:MISSING LEFT PARENTHESES 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 INSIDE 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 + SYNTAX 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 OPTIONS 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 ELOW, 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] #, 01001460 + DUMMY = #; 01001470 + BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT YET 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 + CHARACTERS: 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 CHARACTERS 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 STACKS. WHICH STACK CONTAINS A QUANTITY 01020000 + IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000 + OF CHARACTERS AND AAAAA IS THE FIRST 5 CHARACTERS 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 WORD 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 ENTIRES 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 YELDS AN 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,BC 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 ERO 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 SIMILARILY TO A. 01061000 + NOW S[L} POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000 + ENTRY FOR A. 01063000 + SIMILARILY,AFTER C IS ENTERED 01064000 + S[L] POINTS TO C,WHOSE ENTRY PONTS 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 ALPA 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 IDENTIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000 + THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAINING 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 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 REFERENCE TO THIS LABEL. THE END OF LIST FLAG IS 01140000 + 0. IF SIGN =9, 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 DECLARATIONS (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 THEN 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 ELBIT 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 CHARACTERS 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 TE 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 CHARACTER OF 01332000 + THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS 01333000 + OF THE NEXT CHARACTER TO BE SCANNED, AND LCR THE LAST 01334000 + CHARACTOR IN THE TAPE AND CARD BUFFERS. MAXTLCR 01335000 + IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01336000 + ARRAY TEN[-46:69]; 01340000 + DEFINE PRTBASE=129#,PRTOP=896#; COMMENT PAGE AND TOP OF PRT; 01341000 +ARRAY PRT[PRTBASE:PRTOP]; 01342000 +INTEGER DISKADR,CORADR; COMMENT GLOBALS FOR PROGDESCBLOK; 01343000 +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 CONSTANCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000 + FALSE, THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000 + POSSIBILITY THE CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000 + DURING AN ARRAY DECLARATION ; 01383000 +REAL GT1,T2,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 + READCARD, 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 + OTHERWIDE 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 PROCEDURE 01405000 + 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 THE 01413000 + ERROR ROUTINES, ERRORCOUNT IS THE COUNT OF ERROR MESSAGES;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 A STREAM STATEMENT. IT01418000 + 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 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 ACTULAPARAPART 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 + NEXTLEVEL, COMMENT COUNTS NESTING FOR GO 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 FORMATS 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 USED 01500000 + 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 MEMORY 01505000 + 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 ILE 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 "OCRDING"(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 +FIEL 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 GENERALLY 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 PROCESSED;01592000 +SPECTOG, 01593000 + STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000 + ONE IO AND THEN EXIT; 01595000 + AJUMP; COMMENT TELL 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 ON 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 + PROADD, 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 ENTRY IN INFO; 01620000 + FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000 + IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000 + SAVEL; COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000 +INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000 + ENTERED IN INFO AT ANY GIVEN TIME; 01625000 +PROCEDURE UNHOOK; FORWARD; 01626000 +PROCEDURE MAKEUPACCUM;FORWARD; 01627000 +DEFINE PURPT=[4:8]#,SECRET=2#; 01628000 + COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000 + NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000 + FULL NAME IS ALSO GIVEN; 01631000 + DEFINE 01632000 + ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000 + BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000 + BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000 + BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000 + BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000 + CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000 + CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000 + COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000 + COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000 + DEL = 10#, COMMENT (0045) 7.4.9.3 DELETE; 01642000 + DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000 + EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000 + LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000 + LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000 + GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000 + LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000 + LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000 + GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000 + IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000 + INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000 + ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000 + ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000 + LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000 + LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000 + LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000 + LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000 + LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000 + LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL 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.0 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.9.2 EXIT; 01676000 + ZP1 = 322#, COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000 + SCI =1003#, COMMENT (7655) SCAN OUT INITIALIZE; 01677050 + SAN =1004#, COMMENT (7661) SYSTEM ATTENTION NEEDED 01677100 + SCS =1019#, COMMENT (7755) SCAN OUT STOP; 01677150 +COMMENT THESE DEFINES ARE USED BY EMITD; 01678000 +DEFINE 01679000 + DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000 + DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000 + TRB = 53#, COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000 +REAL MAXSTACK,STACKCTR; 01683000 +INTEGER MAXROW; 01684000 + COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000 + ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000 +INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000 +INTEGER F; 01688000 + REAL NLO,NHI,TLO,THI; 01689000 + BOOLEAN OPTOG; 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 S 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 CRELATIVE 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:=CI+8; % RESTORE POINTERS. 01780000 + N:= TALLY; DI~DI-N; CD:=N CHR; 01781000 +EXIT: 01782000 + END OF GETVOID; 01784000 +REAL VOIDCR,VOIDPLACE,VOIDTCR,VOIDPLACE; 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,[4612],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(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 CARD 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: 02202250 + END READTAPE; 02202500 + PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB; 02202750 + REAL TLCR, CLCR ; 02203000 + BEGIN 02203250 + MEDIUM:="C "; % CARD READER. 02203500 + IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMB02203750 + BEGIN 02204000 + LCR:=TLCR; LASTUSED:=3; 02204250 + MEDIUM:="T "; % TAPE INPUT. 02204500 + END 02204750 + ELSE BEGIN 02205000 + IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205250 + BEGIN 02205500 + MEDIUM:="P "; % CARD PATCHES TAPE. 02205750 + READTAPE; 02206000 + END; 02206250 + LCR:=CLCR; 02206500 + LASTUSED:=2; 02206750 + END; 02207000 + END OF SEQCOMPARE; 02207250 + LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02207500 + EOF, USETHESWITCH, 02207750 + COMPAR, TESTVOID, XIT; 02208000 + SWITCH USESSWITCH:=CARDONLY,CARDLAST,TAPELAST,FIRSTTIME; 02208250 + IF ERRORCOUNT}ERRMAX THEN ERR(611); % ERR LIMIT EXCEEDED - STOP. 02208500 +USETHESWITCH: 02208750 + DOLLAR2TOG:=FALSE; 02209000 + GO TO USESSWITCH(LASTUSED); 02209250 + MOVE(1,INFO[LASTUSED,LINKR,LASTUSED,LINKC], 02209500 + DEFINEARRAY[DEFINEINDEX-2]); 02209750 + LASTUSED := LASTUSED + 1; 02210000 + NCR := LCR-1; 02210250 + GO TO XIT; 02210500 +FIRSTTIME: 02210750 + READ(CARD,10,CBUFF[*]); 02211000 + FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9; 02211250 + MEDIUM:="C "; 02214100 + IF EXAMIN(FCR)!"$" AND LISTER THEN PRINTCARD; 02214200 + PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LR); 02214250 + TURNONSTOPLIGHT("%",LR); 02214500 + GO XIT; 02214750 +COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000 +CARDONLY: 02215250 + READ(CARD,1,CBUFF[*]); 02215500 + LR := 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 RELEASE THE PREVIOUS CARD FORM THE CARD READER AND 02218750 + SETS UP CLCR; 02219000 +TAPELAST: 02219250 + READTAPE; 02219500 +COMMENT THIS RELEASES THE PREVIOUS CARD FORM 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 CONT"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 02228350 + 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 FORM 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 TACK 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 DEFINE 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, BUTNOT 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 CONT>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 THE 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 DIGNS ACTING AT 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 EMBEDDED 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 TO ARGH; 02753000 + RESULT:=0; SCANNER; Q:=ACCUM[1]; 02754000 + T:=SPACIAL[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:=Q; 02764000 +% DO BEGIN 02765000 +% RESULT:=5; SCANNER; 02766000 +% IF COUNT > SIZ:=48 DIV C THEN % > 1 WORD LONG. 02767000 +% BEGIN ERR(420); 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 CHARACATER 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.0X 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 LINFILED. 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] ! 0 THEN GOTO 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 DETALS; 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 FUL: 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:=SPACIAL[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:17] & 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 ADDDRESS 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 BEGINNING OF A WORD AND FILLS IN THE 04080000 + INTERVENING SPACE WITH NOPS. IT CHECKS STREAMTOG TO DECIDE04081000 + 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 THIN 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 OUPTUT ON 04140000 + THE PRINTER FILE IN OCTAL FORAMT. ; 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 (E.E. THE ADDRESS 04157000 + IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WIHT 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+/68) 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 CASUES 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[9,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,RTRB 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 ASSUMING 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 + PERMENENT CELLS ARE EITHER IN STACK OR PRT ACORDING 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-1ELSE 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}NEXTCTR 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 + NESTPTR[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 NESTPTR[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 + NESTPTR[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 + D1~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 NESTPTR[I]!0 THEN 05425000 + BEGIN SORTPRT[Q]~1;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~NESTPTR[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~NESTPTR[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(M1:,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~NESTPTR[SORTPRT[I].[33:15]].LINK; 05447000 + GT2~NESTPTR[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]~SORTPTR[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 + SORTPTR[I]~SORTPTR[I].[18:15]; 05459000 + END; 05460000 + END; 05461000 +COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS; 06000000 +COMMENT AEXP IS THE ARITHEMTIC EXPRESSION ROUTINE; 06001000 +PROCEDURE AEXP; 06002000 + BEGIN 06003000 + IF ELCLASS = IFV 06004000 + THEN BEGIN IF IFEXP ! ATYPE THEN ERROR(102) END 06005000 + ELSE BEGIN ARITHSEC; SIMPARITH END 06006000 + END AEXP; 06007000 +COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSIONS. 06008000 + IN PARICULAR 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 COMILES 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 PAT OF A PRIMARY. MOST OF THE WORK OF 06028000 + SIMPARITH IS DOEN BY ARITHCOMP, AN ARTIFICIAL 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 OPBTAINED BY RECURSION; 06040000 +PROCEDURE ARITHCOMP; 06041000 + BEGIN INTEGER OPERATOR, OPCLASS; 06042000 + DO BEGIN 06043000 + OPERATOR ~ 1 & ELBAT[I] [36:7: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 POLISH(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); GOTO 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 THE 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 ~ "NO;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 IF 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; T1~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 NEIGHBOURHOOD 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 + STEPI; 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 PIUTS 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 ITS 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:=0;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 TST; 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 FORMALLY 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(MOD=0)+3; 08093000 + FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000 + IF NUMLE 08095000 + THEN BEGIN 08096000 + BACKFIX ~ L; 08097000 + IF FORMALLY 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 FORMALLY 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 +BRANCH: 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,T2,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)X2+ 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.[20: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 ROUITNE 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 INITILAIZATION. 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 CARDINTO 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, OCT1612451164567564, 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 FUNCTONS; 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", "RD000000", %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 + OCT0360002000000003, "6MEMOR", "Y ", %359 09114200 + OCT1410456000000002, "3MOD00", %362 09114300 + OCT0500000140000003, "7MONT0", "OR ", %364 09114400 + OCT0130301060000002, "4NABS0", %367 09114500 + OCT0500000200000002, "4NAME0", %369 09114600 + OCT0130304030000002, "5NFLAG", %371 09114700 + OCT1320300230000002, "3NOT00", %373 09114800 + OCT1250440430000002, "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, "3INT00", %467 09119500 + OCT1310440300000002, "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, "3NDP00", %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, "2LB.00", "[# ", %621 09127500 + OCT0030000000040003, "2RB.00", "]# ", %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, "5TIME0", "|# ", %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 + 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[T3~TAKE(GT1+1).[12:36] 09134100 + MOD 125][35:35:13],STACKHEAD[GT3]+GT1); 09134200 +COMMENT THIS IS THE FILL FOR SPECIAL CHARACTERS; 09197000 +FILL SPECIAL[*] WITH 09198000 + OCT1200000000200000, COMMENT #; OCT0000000000100000, COMMENT @; 09199000 + OCT0000000000000000, OCT1160000000120000, COMMENT :; 09200000 + OCT1370440450002763, COMMENT >; OCT1370440250002662, COMMENT }; 09201000 + OCT1400440200000000, COMMENT +; OCT0000000000000000, 09202000 + OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 09203000 + OCT1250000000000000, COMMENT &; OCT0450000000000000, COMMENT (; 09204000 + OCT1370450450003571, COMMENT <; OCT1330401040000000, COMMENT ~; 09205000 + OCT1410441000000000, COMMENT |; OCT0000000000000000, 09206000 + OCT0000000000040000, COMMENT $; OCT0470000000000000, COMMENT *; 09207000 + OCT1400440600000000, COMMENT -; OCT1240000000160000, COMMENT ); 09208000 + OCT0620000000000000, COMMENT .,; OCT1370450250003470, COMMENT {; 09209000 + OCT0000000000000000, OCT1410442000000000, COMMENT .; 09210000 + OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 09211000 + OCT1370441050002561, COMMENT !; OCT1370451050002460, COMMENT =; 09212000 + OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 09213000 + 0,0; 09214000 + FILL MACRO[*] WITH 09215000 + OCT0131, COMMENT SFS A 00 ; 09216000 + OCT0116, COMMENT SFD A 01 ; 09217000 + OCT0000, COMMENT SYNTAX ERROR02 ; 09218000 + OCT0140, COMMENT INC A 03 ; 09219000 + OCT0130, COMMENT SRS A 04 ; 09220000 + OCT0117, COMMENT SRD A 05 ; 09221000 + OCT0000, COMMENT SYNTAX ERROR06 ; 09222000 + OCT0000, COMMENT SYNTAX ERROR07 ; 09223000 + OCT00310143, COMMENT CRF A, SFS 008 ; 09224000 + OCT00160143, COMMENT CRF A, SFD 009 ; 09225000 + OCT00470143, COMMENT CRF A, JFN 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 + OCT00420130042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000 + OCT0122, COMMENT SES A 20 ; 09236000 + OCT0106, COMMENT SED A 21 ; 09237000 + OCT0000, COMMENT SYNTAX ERROR22 ; 09238000 + OCT0000, COMMENT SYNTAX ERROR23 ; 09239000 + OCT0056, COMMENT TSA 0 24 ; 09240000 + OCT0000, COMMENT SYNTAX ERROR25 ; 09241000 + OCT0000, COMMENT SYNTAX ERROR26 ; 09242000 + OCT0000, COMMENT SYNTAX ERROR27 ; 09243000 + OCT0000, COMMENT SYNTAX ERROR28 ; 09244000 + OCT0007, COMMENT TDA 0 29 ; 09245000 + OCT0000, COMMENT SYNTAX ERROR30 ; 09246000 + OCT0000, COMMENT SYNTAX ERROR31 ; 09247000 + OCT0115, COMMENT SSA A 32 ; 09248000 + OCT0114, COMMENT SDA A 33 ; 09249000 + OCT0154, COMMENT SCA A 34 ; 09250000 + OCT0141, COMMENT STC A 35 ; 09251000 +FILL OPTIONS[*] WITH "5CHECK",0, % 0,1 09251208 + "6DEBUG",0, % 2,3 09251212 + "4DECK0",0, % 4,5 09251214 + "6FORMA",0, % 6,7 09251216 + "9INTRI",0, % 8,9 09251218 + "5LISTA",0, % 10,11 09251220 + "4LIST0",0, % 12,13 09251224 + "5LISTP",0, % 14,15 09251228 + "3MCP00",0, % 15,17 09251230 + "4TAPEA",0, % 16,19 09251232 + "5NEST0",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, % 35,37 09251264 + "3SEQ00",0, % 38,39 09251268 + "6SEQER",0, % 40,41 09251272 + "6SINGL",0, % 42,43 09251276 + "5STUFF",0, % 44,45 09251378 + "4VOID0",0, % 45,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~3DEC; DS~22 LIT ". COMPILATION TIME = "; 09368000 + SI ~ LOC T; DS ~ 4 DEC; DS + 9 LIT " SECONDS."; END; 09369000 +STREAM PROCEDURE PEN(FIL,PRTSIZ,BASE,CODE,DISK); 09370000 + VALUE PRTSIZ,BASE,CORE,DISK; 09371000 + BEGIN DI~FIL; DS ~ 0 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 { 255 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 { 255 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; DS~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 ARAYS; 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(DEC,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 WE 10231000 + 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 + DS~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 TO BACK; 10276500 + IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV 10277000 + 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 + OPTOG~TRUE; 12012000 + IF STEPI=ADOP THEN STEPIT; 12013000 + EMITNUM(NLO); 12014000 + EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000 + OPTOG~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.VO); 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 CHKSDB; 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 + IF OCR = 0 13261000 + THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13262000 + L~J+11; EMITL(15); EMITO(RTS); 13263000 + FOR J ~ 4 STEP 4 UNTIL N 13264000 + DO BEGIN 13265000 + EMITL(GNAT(GET(L)|4096+GET(L+1))); 13266000 + EMITO(RTS) END END 13267000 + ELSE BEGIN 13268000 + L ~ J+13; 13269000 + FOR J ~ 4 STEP 4 UNTIL N 13270000 + DO BEGIN 13271000 + GT1 ~ GET(L)|4096+GET(L+1); 13272000 + GOGEN(GT1,BFW) END;END; 13273000 + L ~ TL END 13277000 + ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID 13278000 + THEN IF TAKE(POINTER+1) <0 13279000 + THEN BEGIN GT1 ~ 16; 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 ELTAB WORD IN THE NEW ENTRY 13297000 + E PREVENTS AN ENTRY FORM OVERFLOWING A ROW,STARTING AT THEN 13298000 + BEGINNING OF THE NEXT ROW ISNECESSARY ; 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 ON 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 PSEUDO ENTRY 13355000 + FOR APARAMETER,ITS JOB IS TO UNKOOK THAT FALSE ENTRY SO THAT 13356000 + E WILL WORK ASNORMAL. 13357000 + BEGIN 13358000 + REAL LINKT,A,LINKP; 13359000 + LABEL L; 13360000 + LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000 + IF LINK=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:] &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:4018],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 OFANY EXECUTABLE CODE 13597000 + WHICH THE BLOCKMIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000 + ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHEER IT 13599000 + IF 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 JUMPCHNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000 + EMITTED AND IF SO WHETHER IT WAS JUTS 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 FIRST!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:=9WDS; 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,TWXA[*]); 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 HTTEDAP(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 HTTEDAP; 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(2); 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 INTO 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 LOCALTO BLOCK TO SAVE WHERE A PROCEDURE IS ENTERED 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 FIRSTXD; 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 + FIRSTXD~FIRSTX; 14051000 + FIRSTX~0; 14052000 + LEVEL~LEVEL+1; 14053000 + LOLD~L;FUNCTOGO~FUNCTOG;AJUMPO~AJUMP;PRTIO~PRTI;SGNOO~SGNO; 14054000 + SAVELO~LEVEL;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~-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(0,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)>0 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~NETINFO;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 PARAMETERES. 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[1]) 14353000 + END 14354000 + UNTIL 14355000 + STEPI!COMMA; 14356000 + IF ELCLASS!SEMICOLON THEN 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 START; 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 VARAITIONS; 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 UNTIL 14403000 + 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 CNSTITUTES 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:18] ! 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;NETINFO~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 + PROADD~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 NEXTOG 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 + HTTEDAP(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 HTTEDAP(FALSE,FIRSTX,NINFOO,BLKAD) 14600000 + ELSE BEGIN IF NEXTOG 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~FIRSTXD; 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-CAL 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,DIP,CDC,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,CDC,CH = THE INSTRUCTIONS DUP,CDC,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 PARTICLAR 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 SYNTX; 15074000 + J ; COMMENT SUBSCRIPT COUNTER; 15075000 + LABEL EXIT,L1,LAST,NEXT,JAZZ,ITUP,CLASS; 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 + IF TALL.FORMALNAME THEN 15092000 + BEGIN 15093000 + EMITN(TALL.ADDRESS); 15094000 + IF T1!0 THEN BEGIN EMITO(DUP);EMITO(CDC) 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 DESCRIPTOR 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 REFERES TO 15150000 + THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000 + PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000 + L* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000 + NON-ZERO LOWER BOUNDS FORM 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 EMITTED AS IN CASE #2. 15160000 + HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000 + ONCE 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 CDC. 15170000 + EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000 + 4. ADD THE SEQUENCE: 15172000 + IF FIRST SUBSCRIPT THE VV ELSE CDC,ZEROL, 15173000 + XCH,T 15174000 + 5. ADD THE SEQUENCE: 15175000 + IF FIRST SUBSCRIPT THEN N ELSE CDC,EXP, 15176000 + XCH,~. 15177000 + 6. ADD SEQUENCE: 15178000 + IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD, 15179000 + EXP,T, XCH,~. 15180000 + EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFNED 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 OUSTIDE 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 DESIGNATER PORTION ; 15276000 + IF ELCLASS=LITNO AND ELBAT[1].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-72,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(CDC); 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 BRAKCET 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(CDC) 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) L 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:13#,LGTFLD=24:24:12#; 16004000 + DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000 + DEFINE 16006000 + JFW = 39#, COMMENT 7.5.5.1 JUMP FORWARAD 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 END LOOP ;16014000 + BIT = 31#, COMMENT 7.5.3.8 TEST FOR ALPHAMERIC ;16015000 + JFC = 37#, COMMENT 7.5.5.3 TEST BIT ;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.8.5 SKIP DESTINATION BITS ;16021000 + SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000 + JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ;16023000 +PROCEDURE ADJUST;; 16023100 + COMMENT FIXC EMIST BASICALY 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 WHCIH 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 TIMEACTUAL 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 CODE 16081000 + ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS PINTED 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 NEXT STATEMENT. 16098000 + A VARIABLE NEXT CAUSE THE CODE, 16099000 + CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000 + AT THE RIGHT PAREN THE BNS IS FIXED WIHT THE LENGTH OF 16101000 + THE NEXT (NUMBER OF SYLLABLES) IF THE LENGTH {63,OTHERWISE 16102000 + IT IS FIXED WITH A 1 AND THE NOPS REPLACED WIHT JFW 1, 16103000 + RCA P. THIS IS DONE BECASUE THE VALUE OF V AT EXECUTION 16104000 + MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THEN NEXT. 16105000 + JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 + NEXT LEVEL INCREASED BY ONE. 16107000 + WHEN THE RIGHT PAEN IS EACHED,(IF THE STATEMENTS IN 16108000 + THE NEXT 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 OIGINAL VALUE. ; 16114000 +PROCEDURE NEXT; 16115000 + BEGIN 16116000 + LABEL EXIT; 16117000 + REAL JOINT,BNSFIX; 16118000 + IF ELCLASS!LITNO THEN 16119000 + BEGIN 16120000 + EMITC(ELBAT[1].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 + NEXTLEVEL~NEXTLEVEL + 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 FORJUMPOUS; 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 + NEXTLEVEL ~ NEXTLEVEL-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 PROGRAM STREAM). 16147000 + IF A GOT TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000 + THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000 + [1:1], SETTO ONE.FOR DEFINED LABLES,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 CHECED 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:50),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 STIRNG" THAT 16180000 + THE SYLLABLE EMITTED IS FETCHED FOR 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 THAT 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 OPTIMIZATION IN THE CASES 16188000 + IF THEN GO TO L,IF THEN STATEMENT ELSE GOTO L,OR 16189000 + IF THEN GOTO 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[1].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 NEXT LEVEL IS DEFINED THEN T IS CHECKED 16246000 + AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000 + BE JUMPED OUT. OHERWISE,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)&(NEXTLEVEL-JUMPLEVEL)[11:43:5]),GT1); 16260000 + EMITN(1023); 16261000 + END 16262000 + ELSE 16263000 + BEGIN 16264000 + IF GT1.LEVEL ! NEXTLEVEL-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 + TEMONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000 + THAT ACTUAL 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 INDXS COMPILE STATEMENTS BEGINNING 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]"CONTAINS 16298000 + THE CODE TO BE EMITTED. 16299000 + EACH ELEMENT OF MACRO HAS 1-3 SYLLABLES ORDERED FROM 16300000 + RGHT TO LEFT. UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000 + MAY REQUIRE AT MOST ONE REPEAT PART. 16302000 + IN THIS PROCEDURE,INDEXS,THE VARIBALE "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 RPEAT 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 L; 16353000 + END; 16354000 + EXIT:END INDEXS; 16355000 + COMMENT DSS COMPILES DESTINATION STREAM SATEMENTS. 16356000 + DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUSE THE 16357000 + STRING MUST BE SCANNED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000 + NECESSARY, AND EMITTED TOT HE 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 L; 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 = LIT 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 EITTED. 16400000 + A BSS OR BSD IS EMITTED FOR SKIP SOURCE BITS (SB) 16401000 + OR SKIP DESTINATION ITS (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 CASUSE 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 HANDLES BY EMITTING ONE JNS,ENTERING 16425000 + A PSEUDO STLABID IN NFO 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 + THE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING 16429000 + GO TOS WHEN THE RIGHT PAREN IN 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 PROCEDUE TO HANDLE 16456000 + THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 16457000 + THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 16458000 + IDENTIFIED BY PROCEDUE 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 SYNTACTICALLY 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 GOT TO FINI ; 16478000 + IF ELCLASS=STLABID THEN GO TO L2 ; 16479000 + 16480000 + IF ELCLASS 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 is 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 type 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 ave conditional expressions 00082000 - as the arithmetic expressions. 00083000 - 109 BODSEC,SIMPBOD, and BODCOMP: The primary is not boolean. 00084000 - 110 BODCOMP: A non-boolean operator occurs in a boolean 00085000 - expression. 00086000 - 111 BOOPRIM: 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 declaration. 00090000 - 113 PARSE: Either the syntax or the range of the literals for00091000 - 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 colon. 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 - characters 00134000 - 142 DEFINEGEN: A define contains more than 2047 characters 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 bracket 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 ( > 4093 syllables). 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 non 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 start 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 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 level. 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:Illegal 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 preceding 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 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 fiel 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: 00298000 - 460 RWNDSTMT:Missing left parentheses 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 inside 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 - syntax 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 options 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 elow, 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] #, 01001460 - dummy = #; 01001470 - boolean noheading; % true if datime has not yet 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 - characters: 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 characters 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 stacks. Which stack contains a quantity 01020000 - is given by taking NAAAAA mod 125 where N is the number 01021000 - of characters and AAAAA is the first 5 characters 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 word 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 entires 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 yelds an 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,BC 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 ero 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 similarily to A. 01061000 - Now S[L} points to the entry for B and it points to the 01062000 - entry for A. 01063000 - Similarily,after C is entered 01064000 - S[L] points to C,whose entry ponts 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 alpa 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 identifiers have the information described above 01088000 - that is,the elbat word followed by the word containing 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 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 reference to this label. The end of list flag is 01140000 - 0. If sign =9, 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 declarations (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 then 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 elbit 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 characters 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 te 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 character of 01332000 - the card image currently being scanned, ncr the address 01333000 - of the next character to be scanned, and lcr the last 01334000 - charactor in the tape and card buffers. maxtlcr 01335000 - is the maximum of tlcr when the input is blocked; 01336000 - array ten[-46:69]; 01340000 - define prtbase=129#,prtop=896#; comment page and top of prt; 01341000 -array prt[prtbase:prtop]; 01342000 -integer diskadr,coradr; comment globals for progdescblok; 01343000 -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 constanclean action takes place while mrclean is 01380000 - false, this feature is used by block because of the 01381000 - possibility the constantclean will use info[nextinfo] 01382000 - during an array declaration ; 01383000 -real gt1,t2,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 - readcard, 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 - otherwide 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 procedure 01405000 - 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 the 01413000 - error routines, errorcount is the count of error messages;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 a stream statement. It01418000 - 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 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 actulaparapart 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 - nextlevel, comment counts nesting for go 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 formats 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 used 01500000 - 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 memory 01505000 - 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 ile 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); 01557000 - 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 "ocrding"(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 -fiel 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 generally 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 processed;01592000 -spectog, 01593000 - stopentry, comment this makes the entry procedure enter only 01594000 - one io and then exit; 01595000 - ajump; comment tell 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 on 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 - proadd, 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 entry in info; 01620000 - firstx, comment relative add of first executable code 01621000 - in block,initialized to 4095 each time; 01622000 - savel; comment save location for fixups in block; 01623000 -integer ncii; comment this contains the count of constants 01624000 - entered in info at any given time; 01625000 -procedure unhook; forward; 01626000 -procedure makeupaccum;forward; 01627000 -define purpt=[4:8]#,secret=2#; 01628000 - comment These defines give the names of the word mode operators. The 01629000 - numbers refer to the appropriate section of the product specs. The 01630000 - full name is also given; 01631000 - define 01632000 - add = 16#, comment (0101) 7.4.2.1 Add; 01633000 - bbc = 22#, comment (0131) 7.4.5.4 Branch backward conditional;01634000 - bbw = 534#, comment (4131) 7.4.5.2 Branch backward; 01635000 - bfc = 38#, comment (0231) 7.4.5.3 Branch forward conditional; 01636000 - bfw = 550#, comment (4231) 7.4.5.1 Branch forward; 01637000 - cdc = 168#, comment (1241) 7.4.10.4 Construct descriptor call; 01638000 - chs = 134#, comment (1031) 7.4.7.11 Change sign; 01639000 - coc = 40#, comment (0241) 7.4.10.3 Construct operand call; 01640000 - com = 130#, comment (1011) 7.4.10.5 Communication operator; 01641000 - del = 10#, comment (0045) 7.4.9.3 Delete; 01642000 - dup = 261#, comment (2025) 7.4.9.2 Duplicate; 01643000 - eql = 581#, comment (4425) 7.4.4.3 Equal; 01644000 - lbc = 278#, comment(2131) 7.4.5.9 Go backward conditional; 01645000 - lbu = 790#, comment(6131) 7.4.5.7 Go backward (word); 01646000 - geq = 21#, comment (0125) 7.4.4.2 Greater than or equal to; 01647000 - lfc = 294#, comment(2231) 7.4.5.8 Go forward conditional; 01648000 - lfu = 806#, comment(6231) 7.4.5.6 Go forward (word); 01649000 - gtr = 37#, comment (0225) 7.4.4.1 Greater than; 01650000 - idv = 384#, comment (3001) 7.4.2.5 Integer divide; 01651000 - inx = 24#, comment (0141) 7.4.10.2 Index; 01652000 - isd = 532#, comment (4121) 7.4.6.3 Integer store destructive; 01653000 - isn = 548#, comment (4221) 7.4.6.4 Integer store non-destruct; 01654000 - leq = 533#, comment (4125) 7.4.4.4 Less than or equal to; 01655000 - lnd = 67#, comment (0415) 7.4.3.1 Logical and; 01656000 - lng = 19#, comment (0115) 7.4.3.4 Logical negate; 01657000 - lod = 260#, comment (2021) 7.4.10.1 Load operator; 01658000 - lor = 35#, comment (0215) 7.4.3.2 Logical or; 01659000 - lqv = 131#, comment (1015) 7.4.3.3 Logical 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.0 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.9.2 Exit; 01676000 - zp1 = 322#, comment (2411) 7.4.10.8 Conditional halt; 01677000 - sci =1003#, comment (7655) Scan out initialize; 01677050 - san =1004#, comment (7661) System attention needed 01677100 - scs =1019#, comment (7755) Scan out stop; 01677150 -comment These defines are used by EMITD; 01678000 -define 01679000 - dia = 45#, comment (xx55) 7.4.7.1 Dial A; 01680000 - dib = 49#, comment (xx61) 7.4.7.2 Dial B; 01681000 - trb = 53#, comment (xx65) 7.4.7.3 Transfer bits; 01682000 -real maxstack,stackctr; 01683000 -integer maxrow; 01684000 - comment This contains the maximum row size of all non-save 01685000 - arrays declared. Its use is like that of maxsave; 01686000 -integer segsizemax; comment contains max segment size; 01687000 -integer f; 01688000 - real nlo,nhi,tlo,thi; 01689000 - boolean optog; 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 s 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 Crelative 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:=ci+8; % Restore pointers. 01780000 - n:= tally; di←di-n; cd:=n chr; 01781000 -exit: 01782000 - end of getvoid; 01784000 -real voidcr,voidplace,voidtcr,voidplace; 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,[4612],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(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 card 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: 02202250 - end readtape; 02202500 - procedure seqcompare(tlcr,clcr, lib); value lib; boolean lib; 02202750 - real tlcr, clcr ; 02203000 - begin 02203250 - medium:="C "; % Card reader. 02203500 - if gt1:=compare(tlcr,clcr)=0 then % Tape has low sequence numb02203750 - begin 02204000 - lcr:=tlcr; lastused:=3; 02204250 - medium:="T "; % Tape input. 02204500 - end 02204750 - else begin 02205000 - if gt1 ≠ 1 then % Tape and card have same seq 02205250 - begin 02205500 - medium:="P "; % card patches tape. 02205750 - readtape; 02206000 - end; 02206250 - lcr:=clcr; 02206500 - lastused:=2; 02206750 - end; 02207000 - end of seqcompare; 02207250 - label cardonly, cardlast, tapelast, exit, firsttime, 02207500 - eof, usetheswitch, 02207750 - compar, testvoid, xit; 02208000 - switch usesswitch:=cardonly,cardlast,tapelast,firsttime; 02208250 - if errorcount≥errmax then err(611); % err limit exceeded - stop. 02208500 -usetheswitch: 02208750 - dollar2tog:=false; 02209000 - go to usesswitch(lastused); 02209250 - move(1,info[lastused,linkr,lastused,linkc], 02209500 - definearray[defineindex-2]); 02209750 - lastused := lastused + 1; 02210000 - ncr := lcr-1; 02210250 - go to xit; 02210500 -firsttime: 02210750 - read(card,10,cbuff[*]); 02211000 - fcr:=ncr:=(lcr:=mkabs(cbuff[9]))-9; 02211250 - medium:="C "; 02214100 - if examin(fcr)≠"$" and lister then printcard; 02214200 - putseqno(info[lastseqrow,lastsequence],lr); 02214250 - turnonstoplight("%",lr); 02214500 - go xit; 02214750 -comment We have just initialized card input; 02215000 -cardonly: 02215250 - read(card,1,cbuff[*]); 02215500 - lr := 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 release the previous card form the card reader and 02218750 - sets up clcr; 02219000 -tapelast: 02219250 - readtape; 02219500 -comment This releases the previous card form 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 cont"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 02228350 - 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 form 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 tack 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 define 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, butnot 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 cont>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 the 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 digns acting at 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 embedded 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 to argh; 02753000 - result:=0; scanner; q:=accum[1]; 02754000 - t:=spacial[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:=q; 02764000 -% do begin 02765000 -% result:=5; scanner; 02766000 -% if count > siz:=48 div c then % > 1 word long. 02767000 -% begin err(420); 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 characater 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.0x 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 linfiled. 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] ≠ 0 then goto 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 detals; 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 ful: 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:=spacial[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:17] & 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 adddress 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 beginning of a word and fills in the 04080000 - intervening space with NOPs. It checks STREAMTOG to decide04081000 - 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 thin 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 ouptut on 04140000 - the printer file in octal foramt. ; 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 (e.e. the address 04157000 - if greater than 127 words) then the constant along wiht 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+/68) 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 casues 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[9,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,RTRB 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 assuming 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 - permenent cells are either in stack or PRT acording 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-1else 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≥nextctr 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 - nestptr[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 nestptr[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 - nestptr[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 - d1←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 nestptr[i]≠0 then 05425000 - begin sortprt[q]←1;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←nestptr[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←nestptr[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(m1:,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←nestptr[sortprt[i].[33:15]].link; 05447000 - gt2←nestptr[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]←sortptr[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 - sortptr[i]←sortptr[i].[18:15]; 05459000 - end; 05460000 - end; 05461000 -comment Routines in this section compile code for all expressions; 06000000 -comment AEXP is the arithemtic expression routine; 06001000 -procedure aexp; 06002000 - begin 06003000 - if elclass = ifv 06004000 - then begin if ifexp ≠ atype then error(102) end 06005000 - else begin arithsec; simparith end 06006000 - end aexp; 06007000 -comment ARITHSEC compiles first primary in an arithmetic expressions. 06008000 - in paricular 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 comiles 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 pat of a primary. Most of the work of 06028000 - SIMPARITH is doen by ARITHCOMP, an artificial 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 opbtained by recursion; 06040000 -procedure arithcomp; 06041000 - begin integer operator, opclass; 06042000 - do begin 06043000 - operator ← 1 & elbat[i] [36:7: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 polish(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); goto 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 the 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 ← "NO;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 if 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; t1←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 neighbourhood 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 - stepi; 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 piuts 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 its 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:=0;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 tst; 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 formally 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(mod=0)+3; 08093000 - for k ← 1 step 1 until q do emito(nop); 08094000 - if numle 08095000 - then begin 08096000 - backfix ← l; 08097000 - if formally 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 formally 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 -branch: 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,t2,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)x2+ 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.[20: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 rouitne 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 initilaization. 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 cardinto 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, oct1612451164567564, 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 functons; 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", "RD000000", %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 - oct0360002000000003, "6MEMOR", "Y ", %359 09114200 - oct1410456000000002, "3MOD00", %362 09114300 - oct0500000140000003, "7MONT0", "OR ", %364 09114400 - oct0130301060000002, "4NABS0", %367 09114500 - oct0500000200000002, "4NAME0", %369 09114600 - oct0130304030000002, "5NFLAG", %371 09114700 - oct1320300230000002, "3NOT00", %373 09114800 - oct1250440430000002, "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, "3INT00", %467 09119500 - oct1310440300000002, "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, "3NDP00", %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, "2LB.00", "[# ", %621 09127500 - oct0030000000040003, "2RB.00", "]# ", %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, "5TIME0", "×# ", %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 - 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[t3←take(gt1+1).[12:36] 09134100 - mod 125][35:35:13],stackhead[gt3]+gt1); 09134200 -comment This is the fill for special characters; 09197000 -fill special[*] with 09198000 - oct1200000000200000, comment #; oct0000000000100000, comment @; 09199000 - oct0000000000000000, oct1160000000120000, comment :; 09200000 - oct1370440450002763, comment >; oct1370440250002662, comment ≥; 09201000 - oct1400440200000000, comment +; oct0000000000000000, 09202000 - oct1220000000060000, comment .; oct1210000000000000, comment [; 09203000 - oct1250000000000000, comment &; oct0450000000000000, comment (; 09204000 - oct1370450450003571, comment <; oct1330401040000000, comment ←; 09205000 - oct1410441000000000, comment ×; oct0000000000000000, 09206000 - oct0000000000040000, comment $; oct0470000000000000, comment *; 09207000 - oct1400440600000000, comment -; oct1240000000160000, comment ); 09208000 - oct0620000000000000, comment .,; oct1370450250003470, comment ≤; 09209000 - oct0000000000000000, oct1410442000000000, comment .; 09210000 - oct1170000000000000, comment ,; oct0000000000020000, comment %; 09211000 - oct1370441050002561, comment ≠; oct1370451050002460, comment =; 09212000 - oct1230000000000000, comment ]; oct0000000000140000, comment "; 09213000 - 0,0; 09214000 - fill macro[*] with 09215000 - oct0131, comment SFS A 00 ; 09216000 - oct0116, comment SFD A 01 ; 09217000 - oct0000, comment syntax error02 ; 09218000 - oct0140, comment INC A 03 ; 09219000 - oct0130, comment SRS A 04 ; 09220000 - oct0117, comment SRD A 05 ; 09221000 - oct0000, comment syntax error06 ; 09222000 - oct0000, comment syntax error07 ; 09223000 - oct00310143, comment CRF A, SFS 008 ; 09224000 - oct00160143, comment CRF A, SFD 009 ; 09225000 - oct00470143, comment CRF A, JFN 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 - oct00420130042, comment SEC 0, CRF A, SEC 0 19 ; 09235000 - oct0122, comment SES A 20 ; 09236000 - oct0106, comment SED A 21 ; 09237000 - oct0000, comment syntax error22 ; 09238000 - oct0000, comment syntax error23 ; 09239000 - oct0056, comment TSA 0 24 ; 09240000 - oct0000, comment syntax error25 ; 09241000 - oct0000, comment syntax error26 ; 09242000 - oct0000, comment syntax error27 ; 09243000 - oct0000, comment syntax error28 ; 09244000 - oct0007, comment TDA 0 29 ; 09245000 - oct0000, comment syntax error30 ; 09246000 - oct0000, comment syntax error31 ; 09247000 - oct0115, comment SSA A 32 ; 09248000 - oct0114, comment SDA A 33 ; 09249000 - oct0154, comment SCA A 34 ; 09250000 - oct0141, comment STC A 35 ; 09251000 -fill options[*] with "5CHECK",0, % 0,1 09251208 - "6DEBUG",0, % 2,3 09251212 - "4DECK0",0, % 4,5 09251214 - "6FORMA",0, % 6,7 09251216 - "9INTRI",0, % 8,9 09251218 - "5LISTA",0, % 10,11 09251220 - "4LIST0",0, % 12,13 09251224 - "5LISTP",0, % 14,15 09251228 - "3MCP00",0, % 15,17 09251230 - "4TAPEA",0, % 16,19 09251232 - "5NEST0",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, % 35,37 09251264 - "3SEQ00",0, % 38,39 09251268 - "6SEQER",0, % 40,41 09251272 - "6SINGL",0, % 42,43 09251276 - "5STUFF",0, % 44,45 09251378 - "4VOID0",0, % 45,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); 09262600 - 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←3dec; ds←22 lit ". Compilation time = "; 09368000 - si ← loc t; ds ← 4 dec; ds + 9 lit " seconds."; end; 09369000 -stream procedure pen(fil,prtsiz,base,code,disk); 09370000 - value prtsiz,base,core,disk; 09371000 - begin di←fil; ds ← 0 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 ≤ 255 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 ≤ 255 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; ds←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 arays; 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(dec,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 we 10231000 - 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 - ds←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 to back; 10276500 - if elclass=declarators and elbat[i].address = definev 10277000 - 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 - optog←true; 12012000 - if stepi=adop then stepit; 12013000 - emitnum(nlo); 12014000 - emitnum(if elbat[i-1].address =sub then -nhi else nhi); 12015000 - optog←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.vo); 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 chksdb; 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 - if ocr = 0 13261000 - then begin l←ocr-2; callswitch(pointer); emito(bfw);end; 13262000 - l←j+11; emitl(15); emito(rts); 13263000 - for j ← 4 step 4 until n 13264000 - do begin 13265000 - emitl(gnat(get(l)×4096+get(l+1))); 13266000 - emito(rts) end end 13267000 - else begin 13268000 - l ← j+13; 13269000 - for j ← 4 step 4 until n 13270000 - do begin 13271000 - gt1 ← get(l)×4096+get(l+1); 13272000 - gogen(gt1,bfw) end;end; 13273000 - l ← tl end 13277000 - else if elclass ≥ procid and elclass ≤ intprocid 13278000 - then if take(pointer+1) <0 13279000 - then begin gt1 ← 16; 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 ELTAB word in the new entry 13297000 - E prevents an entry form overflowing a row,starting at then 13298000 - beginning of the next row isnecessary ; 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 on 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 pseudo entry 13355000 - for aparameter,its job is to unkook that false entry so that 13356000 - E will work asnormal. 13357000 - begin 13358000 - real linkt,a,linkp; 13359000 - label l; 13360000 - linkt←stackhead[scram] ; linkp←elbat[i].link; 13361000 - if link=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:] &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:4018],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 ofany executable code 13597000 - which the blockmight emit.It determines whether any jumps 13598000 - arround nonexecutable code may be waiting and wheer it 13599000 - if 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 JUMPCHNX determines whether any executable code has been 13617000 - emitted and if so whether it was juts 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 first≠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:=9wds; 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,twxa[*]); 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 httedap(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 httedap; 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(2); 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 into 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 Localto block to save where a procedure is entered 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 firstxd; 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 - firstxd←firstx; 14051000 - firstx←0; 14052000 - level←level+1; 14053000 - lold←l;functogo←functog;ajumpo←ajump;prtio←prti;sgnoo←sgno; 14054000 - savelo←level;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←-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; 14166 - 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(0,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)>0 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←netinfo;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 parameteres. 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[1]) 14353000 - end 14354000 - until 14355000 - stepi≠comma; 14356000 - if elclass≠semicolon then 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 start; 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 varaitions; 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 until 14403000 - 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 cnstitutes 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:18] ≠ 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;netinfo←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 - proadd←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 nextog 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 - httedap(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 httedap(false,firstx,ninfoo,blkad) 14600000 - else begin if nextog 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←firstxd; 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-cal 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,dip,cdc,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,cdc,ch = the instructions dup,cdc,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 particlar 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 syntx; 15074000 - j ; comment subscript counter; 15075000 - label exit,l1,last,next,jazz,itup,class; 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 - if tall.formalname then 15092000 - begin 15093000 - emitn(tall.address); 15094000 - if t1≠0 then begin emito(dup);emito(cdc) 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 descriptor 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 referes to 15150000 - the code produced by the arithmetic expression 15151000 - procedure for the actual subscript expressions,15152000 - L* refers to the code produced for subtracting 15153000 - non-zero lower bounds form 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 emitted as in case #2. 15160000 - However,the actual sequences are: 15161000 - Once 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 CDC. 15170000 - Execution: The array element is put in reg A. 15171000 - 4. Add the sequence: 15172000 - If first subscript the vv else CDC,zerol, 15173000 - XCH,t 15174000 - 5. Add the sequence: 15175000 - If first subscript then n else CDC,exp, 15176000 - XCH,←. 15177000 - 6. Add sequence: 15178000 - If first subscript then vn else CDC,DUP,LOD, 15179000 - EXP,t, XCH,←. 15180000 - exp,t,←,zerol,etc. have same meanings as defned 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 oustide 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 designater portion ; 15276000 - if elclass=litno and elbat[1].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-72,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(cdc); 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 brakcet 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(cdc) 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) l 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:13#,lgtfld=24:24:12#; 16004000 - define level=lvl#,addop=adop#; 16005000 - define 16006000 - jfw = 39#, comment 7.5.5.1 Jump forwarad 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 End loop ;16014000 - bit = 31#, comment 7.5.3.8 Test for alphameric ;16015000 - jfc = 37#, comment 7.5.5.3 Test bit ;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.8.5 Skip destination bits ;16021000 - sec = 34#, comment 7.5.10.1 Set count ; 16022000 - jns = 38#; comment 7.5.5.7 Jump out loop ;16023000 -procedure adjust;; 16023100 - comment FIXC emist basicaly 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 whcih 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 timeactual 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 code 16081000 - array where JFWs must be placed. The 1st link is pinted 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 next statement. 16098000 - A variable next cause the code, 16099000 - CRF V, BNS 0 ,NOP,NOP, to be generated initially. 16100000 - At the right paren the BNS is fixed wiht the length of 16101000 - the next (number of syllables) if the length ≤63,otherwise 16102000 - it is fixed with a 1 and the nops replaced wiht JFW 1, 16103000 - RCA P. THis is done becasue the value of V at execution 16104000 - may = 0 and this code causes a jump around then next. 16105000 - Jumpout info is remembered in a recursive cell and 16106000 - next level increased by one. 16107000 - When the right paen is eached,(if the statements in 16108000 - the next 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 oiginal value. ; 16114000 -procedure next; 16115000 - begin 16116000 - label exit; 16117000 - real joint,bnsfix; 16118000 - if elclass≠litno then 16119000 - begin 16120000 - emitc(elbat[1].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 - nextlevel←nextlevel + 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 forjumpous; 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 - nextlevel ← nextlevel-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 program stream). 16147000 - If a got to has not been encountered before the label 16148000 - then the nest level field is entered and the defined bit, 16149000 - [1:1], setto one.For defined lables,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 checed 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:50),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 stirng" that 16180000 - the syllable emitted is fetched for 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 that 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 optimization in the cases 16188000 - if then go to L,if then statement else goto l,or 16189000 - if then goto 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[1].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 next level is defined then t is checked 16246000 - against the current level minus the number of levels to 16247000 - be jumped out. Oherwise,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)&(nextlevel-jumplevel)[11:43:5]),gt1); 16260000 - emitn(1023); 16261000 - end 16262000 - else 16263000 - begin 16264000 - if gt1.level ≠ nextlevel-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 - Temonitor bit is set in INFO for the local variable so 16278000 - that actual 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 INDXS compile statements beginning 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]"contains 16298000 - the code to be emitted. 16299000 - Each element of macro has 1-3 syllables ordered from 16300000 - rght to left. Unused syllables must = 0. Each macro 16301000 - may require at most one repeat part. 16302000 - In this procedure,INDEXS,the varibale "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 rpeat 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 l; 16353000 - end; 16354000 - exit:end indexs; 16355000 - comment DSS compiles destination stream satements. 16356000 - ds← lit"string" is handled as a special case because the 16357000 - string must be scanned from right to left,repeatedly if 16358000 - necessary, and emitted tot he 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 l; 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 = lit 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 eitted. 16400000 - A BSS or BSD is emitted for skip source bits (SB) 16401000 - or skip destination its (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 casuse 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 handles by emitting one JNS,entering 16425000 - a pseudo STLABID in NFO 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 - the fix ups(if emitting of jump instructions) by calling 16429000 - go tos when the right paren in 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 procedue to handle 16456000 - the various and sundry stream procedure statements. 16457000 - The statements are broken down as follows: 16458000 - Identified by Procedue 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 syntactically 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 got to fini ; 16478000 - if elclass=stlabid then go to l2 ; 16479000 - 16480000 - if elclass