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