$SET OMIT LISTA = LIST %121-00000999 %#######################################################################00001000 % 00001010 % B-5700 ALGOL/TSPOL SYMBOLIC 00001020 % MARK XVI.0.122 %123-00001030 % MAY 9, 1977 %123-00001040 % 00001050 %#######################################################################00001060 % 00001070 COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00001072 * FILE ID: SYMBOL/ALGOL 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) 1965, 1971, 1972, 1974 * 00001080 * BURROUGHS CORPORATION * 00001081 * AA759915 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, SAVE, OR AUXMEM USED IN 00029000 ARRAY SPECIFICATION. 00029500 014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00030000 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00030500 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: MISSING RECORD SIZE. 00053000 00054000 028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000 IN FILE DEC. 00056000 029 FILEDEC: MISSING ) IN FILE DEC. 00057000 030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00058000 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 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200 041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600 045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00069700 046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800 047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931 ACTUAL DECLARATION 00069932 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933 IDENTIFIER. 00069934 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938 060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950 INTOVR, OR INDEX. 00069960 070 CASESTMT: MISSING BEGIN. 00069970 071 CASESTMT: MISSING END. 00069980 080 PRIMARY: MISSING COMMA . 00069990 090 PARSE: MISSING LEFT BRACKET 00069991 091 PARSE: MISSING COLON 00069992 092 PARSE: ILLEGAL BIT NUMBER 00069993 093 PARSE: FIELD SIZE MUST BE LITERAL 00069994 094 PARSE: MISSING RIGHT BRACKET 00069995 095 PARSE: ILLEGAL FIELD SIZE 00069996 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 BEING 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 LITERALS 00093000 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: INDEX VARIABLE MAY NOT BE BOOLEAN 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 LIST 00156000 ELEMENT. 00157000 157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00158000 158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000 159 PROCSTMT: ILLEGAL USE OF PROCEDURE OF FUNCTION IDENTIFIER00160000 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720 DECLARATION. 00164725 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730 AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740 PARAMETRIC DEFINE INVOCATION. 00164745 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00164850 VARIABLE, OR A TYPE PROCEDURE IDENTIFIER. 00164851 199 E: INFO ARRAY HAS OVERFLOWED. 00164900 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 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100 PARAMETER ONLY. 00180200 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 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 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 NEXT 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 EMITO: 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 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00206100 271 IFS: IMPROPER CONSTRUCT FOR . 00206200 281 DBLSTMT: MISSING (. 00207000 282 DBLSTMT: TOO MANY OPERATORS. 00208000 283 DBLSTMT: TOO MANY OPERANDS. 00209000 284 DBLSTMT: MISSING , . 00210000 285 DBLSTMT: TOO FEW OPERANDS. 00211000 286 DBLSTMT: ILLEGAL PARAMETER . 00211100 290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00211510 291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE00211520 292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00211530 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551 IN A LEFT PART LIST. 00211552 300 FILLSTMT: THE IDENTIFIER FOLLOWING "FILL" IS NOT 00212000 AN ARRAY IDENTIFER. 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 304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100 306 FILLSTMT: ODD NUMBER OF PARENTHESES IN FILL. 00218110 307 WHIPOUT: FORMAT > 1023 WORDS. 00218112 350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00218200 SORT OR MERGE STATEMENT. 00218210 351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00218220 352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00218230 NOT HAVE EXACTLY TWO PARAMETERS. 00218240 353 OUTPROCHECK: FIRST PAREMETER OF OUTPUT PROCEDURE MUST 00218250 BE BOOLEAN. 00218260 354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00218270 ONE-DIM ARRAY. 00218280 355 SORTSTMT: MISSING (. 00218290 356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO00218300 357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00218310 PARAMETER. 00218320 358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00218330 359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00218340 360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00218350 TWO PARAMETERS. 00218360 361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00218370 362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00218380 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400 PARAMETER. 00218410 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420 366 SORTSTMT: MISSING ). 00218430 367 MERGESTMT: MISSING (. 00218440 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450 369 MERGESTMT: MISSING ). 00218460 381 CMPLXSTMT: MISSING (. 00218500 382 CMPLXSTMT: TOO MANY OPERATORS. 00218505 383 CMPLXSTMT: TOO MANY OPERANDS. 00218510 384 CMPLXSTMT: MISSING , . 00218515 385 CMPLXSTMT: TOO FEW OPERANDS. 00218520 386 CMPLXSTMT: ILLEGAL PARAMETER. 00218525 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 OR NON-LOCAL 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 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 00259000 00260000 00261000 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 STATEMETN. 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 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003 SIMPLE VARIABLE 00305004 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050 505 SEARCHLIB: MISSING BRACKET. 00305060 00305070 507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00305100 520 TABLE: STRING LONGER THAN ONE WORD (48 BITS). 00306200 521 TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER. 00306300 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 610 READACARD: SEQUENCE ERROR. 00410000 611 READACARD: ERROR LIMIT HAS BEEN EXCEEDED. 00411000 612 INCLUDECARD: TOOMANY NESTED INCLUDES. %107-00412000 613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. %107-00413000 614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. %107-00414000 615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. %107-00415000 616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD %107-00416000 617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00417000 618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00418000 ; 00490000 $POP OMIT LISTA %121-00499999 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 COMPILER & 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 INTEGER LASTADDRESS; 00504200 ARRAY ENIL[0:7,0:127]; 00504300 INTEGER ENILPTR; 00504400 DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500 ARRAY LDICT[0:7,0:127]; 00504600 BOOLEAN BUILDLINE; 00504700 BOOLEAN REL; 00504801 COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00505000 TO SAVE SOME 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 TO 00508000 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 REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100 BEGIN 00512200 SI ~ AC; SI ~ SI + CT; 00512300 DI ~ LOC EXAMINELAST; DI ~ DI+7; 00512400 DS ~ 1 CHR; 00512500 END EXAMINELAST; 00512600 COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000 IN SORCE TO THE DK-TH CHARACTER IN DEST, 0{N{63,0{SK{127; 00514000 DEFINE DK=DSK#; 00514500 STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000 VALUE N, SK, DSK ; 00516000 BEGIN SI~LOC SK; SI~SI+6; 00517000 IF SC!"0" THEN BEGIN SI~SORCE; 2(SI~SI+32);SORCE~SI END; 00518000 SI~LOC DK; SI~SI+6; DI~DEST; 00519000 IF SC!"0" THEN 2(DI~DI+32); 00520000 SI~SORCE; SI~SI+SK; DI~DI+DK; DS~N CHR; 00521000 END MOVECHARACTERS; 00522000 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~150END; 00530000 IF EXAMIN(RR11+5)!12 THEN RR3~4 ELSE 00531000 BEGIN RR3~2; RR4~150END; 00532000 IF EXAMIN(RR11+10)!12 THEN 00533000 BEGIN RR5~2; RR6~10; RR7~150END ELSE 00534000 BEGIN RR5~1; RR6~56; RR7~10 END; 00535000 IF EXAMIN(RR11+15)=12 THEN 00536000 BEGIN RR8~10; RR9~150END ELSE 00537000 BEGIN RR8~56; RR9~10 END; 00538000 IF EXAMIN(RR11+20)=12 THEN RR10~150; 00539000 BEGIN 01000000 01000100 01000200 01000300 01000400 01000500 01000600 INTEGER NUMSEQUENCEERRORS; 01000700 INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01000800 BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTIONS SETTING 01000802 BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810 PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830 BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840 % EVALUATING AN ARRAY BOUND 01000850 INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860 COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870 BASENUM IS STARTING VALUE 01000880 TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890 CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900 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 XREFBIT = 26#, 01001170 BENDBIT = 27#, 01001171 CODEFILEBIT = 29#, %106-01001172 USEROPINX = 30#, %106-01001173 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 FORMATTOG = 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 NESTTOG = 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 XREF = OPTIONWORD.[XREFBIT:1] #, 01001461 BEND = OPTIONWORD.[BENDBIT:1] #, 01001462 CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, %106-01001463 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 SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000 ARRAY INFO[0:31,0:255]; 01007000 %***********************************************************************01007005 % X R E F S T U F F %116-01007010 %***********************************************************************01007015 % %116-01007020 ARRAY %116-01007025 XREFAY2[0:29], % ARRAY OF ONE WORD REFERENCE RECORDS. %116-01007030 % THE LAYOUT OF EACH WORD IS %116-01007035 % %116-01007040 % .[1:5] TYPE OF REFERENCE %116-01007045 % = 0 FOR FORWARD DECL %116-01007050 % = 1 FOR LABEL OCCURENCE %116-01007051 % = 2 FOR NORMAL DECL %116-01007055 % = 4 FOR NORMAL REFERENCE %116-01007060 % = 5 FOR ASSIGNMENT %116-01007065 % %116-01007070 % NOTE: THE LOWER ORDER BIT 01007075 % OF THIS FIELD IS ON 01007080 % IF YOU WANT STARS %116-01007085 % AROUND THIS REFERENCE 01007090 % IN THE XREF %116-01007095 % %116-01007100 % .[6:16] IDENTIFIER ID. NO. %116-01007105 % THIS IS A UNIQUE NUMBER THAT 01007110 % IS ASSIGNED WHEN THE %116-01007115 % IDENTIFIER IS ENCOUNTERE %116-01007120 % FOR THE FIRST TIME. %116-01007125 % %116-01007130 % .[21:27] SEQUENCE NUMBER %116-01007135 % %116-01007140 XREFAY1[0:9], % RECORD BUFFER AREA FOR WRITING OUT THE %116-01007145 % NAME INFORMATION RECORDS, ONE RECORD %116-01007150 % IS WRITTEN FOR EACH IDENTIFIER IN THE SYMBOL 01007155 % TABLE WHEN THE IDENTIFIER IS PURGED FROM THE 01007160 % SYMBOL TABLE, I.E., WHEN LEAVING THE BLOCK%116-01007165 % IN WHICH THE IDENTIFIER IS DECLARED. %116-01007170 % %116-01007175 % THE LAYOUT OF EACH IS: %116-01007180 % %116-01007185 % WORDS 0-7 THE IDENTIFIER WITH BLANK%116-01007190 % FILE ON THE RIGHT %116-01007195 % %116-01007200 % WORD 8 %116-01007205 % .[21:12] SEGMENT NUMBER IN WHICH %116-01007210 % THIS IDENTIFIER WAS DECLARED01007215 % %116-01007220 % .[33:15] IDENTIFIER ID. NO. %116-01007225 % %116-01007230 % WORD 9 ELBAT WORD %116-01007235 % %116-01007240 XINFO[0:31,0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 01007245 % IN THE INFO TABLE. IF YOU HAVE THE INDEX %116-01007250 % OF THE ELBAT WORD FOR AN IDENTIFIER IN %116-01007255 % THE INFO TABLE YOU CAN FIND THE XINFO WORD%116-01007260 % FOR THE IDENTIFIER BY REFERRING TO: %116-01007265 % %116-01007270 % XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] %116-01007275 % %116-01007280 % EACH ENTRY CONTAINS: %116-01007285 % %116-01007290 % .[21:12] SEGMENT NUMBER IN WHICH 01007295 % THIS IDENTIFIER WAS DECL01007300 % %116-01007305 % .[33:15] IDENTIFIER ID. NO. %116-01007310 % IF THIS ID. NO. IS ZERO 01007315 % THEN XREF WAS NOT ON 01007320 % AT THE TIME THE IDENT 01007325 % WAS DECLARED AND ALL 01007330 % FUTURE REFERENCES WILL 01007335 % BE DISCARDED. %116-01007340 % %116-01007345 INTEGER % %116-01007350 XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN %116-01007355 % XREFAY2, WHEN THIS BECOMES GREATER %116-01007360 % THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365 % AND XREFPT IS RESET TO ZERO. %116-01007370 % %116-01007375 XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF %116-01007380 % ID. NO. TO IDENTIFIERS. IT IS INCREMENTED %116-01007385 % EACH TIME A NEW IDENTIFIER IS ENCOUNTERED.%116-01007390 % %116-01007395 DEFINE % %116-01007400 SEGNOF = [21:12]#, % FIELDS IN XINFO ENTRIES AND WORD 8 OF %116-01007405 IDNOF = [33:15]#, % IDENTIFIER RECORDS. %116-01007410 % %116-01007415 TYPEREF = [1:5]#, % FIELDS OF REFERENCE WORDS %116-01007420 REFIDNOF =[6:15]#, % %116-01007425 SEQNOF = [21:27]#, % %116-01007430 % %116-01007435 XREFIT(INDEX,SEQNO,REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE %116-01007440 BEGIN IF XREF THEN CROSSREFIT(INDEX,SEQNO,REFTYPE); END#, %116-01007445 % %116-01007450 XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 01007455 BEGIN IF XREF THEN XREFAY2[XREFPT-1].TYPEREF := REFTYPE END#, %116-01007460 % %116-01007465 XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER01007470 BEGIN IF DEFINING.[1:1] THEN CROSSREFDUMP(INDEX); END#, %116-01007475 % %116-01007480 XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO%116-01007481 XINFO[(INDEX),LINKR,(INDEX).LINKC DIV 2]#, % XINFO ROW AND COL %116-01007482 % %116-01007483 FORWARDREF = 0#, % DEFINES FOR DIFFERENCE REFERENCE TYPES %116-01007485 LBLREF = 1#, % %116-01007486 DECLREF = 2#, % %116-01007490 NORMALREF = 4#, % %116-01007495 ASSIGNREF = 5#, % %116-01007500 ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600 BOOLEAN DEFINING; 01007650 COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000 THE INTERNAL CODE (OR ELBAT WORD AS IT IS USUALLY 01010000 CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000 [1:1]) FOR PROCEDURES. THE LINK TO PREVIOUS ENTRY (IN 01012000 [4:8]). THE NUMBER OF CHARACTERS IN THE ALPHA REPRESENTA- 01013000 TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 01014000 SUCCEDING WORDS CONTAIN THE REMAINING CHARACTERS OF ALPHA,01015000 FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000 AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLUT 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 AAAAAIS HTE 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 A[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 SUBSTRACTED 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 = O31X 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 DYNAM =[11:16]#, 01154100 SBITF =[21:6]#, % STARTING BIT FOR FIELD ID. %117-01154200 NBITF =[27:6]#, % NUMBER OF BITS FOR FIELD ID.%117-01154300 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 TURNED ON IF: 01158000 1. THE QUANTITY IS TO BE MONITORED, OR 01158100 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200 A DEFINE WITHOUT PARAMETERS. 01158300 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 V0 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 DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100 DEFINE PARAMETER ENTRIES, ONLY, IT IS AN INDEX 01168200 INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300 THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400 DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500 NOT USE THE LVL FIELD, BUT MAKES USE OF NINF00 01168600 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 DEFINEID =03#, COMMENT 003; 01180000 LISTID =04#, COMMENT 004; 01181000 FRMTID =05#, COMMENT 005; 01182000 SUPERFRMTID =06#, COMMENT 006; 01183000 FILEID =07#, COMMENT 006; 01184000 SUPERFILEID =08#, COMMENT 007; 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 =16#, COMMENT 020; 01193000 BOOPROCID =17#, COMMENT 021; 01194000 REALPROCID =18#, COMMENT 022; 01195000 ALFAPROCID =19#, COMMENT 023; 01196000 INTPROCID =20#, COMMENT 024; 01197000 BOOID =21#, COMMENT 025; 01198000 REALID =22#, COMMENT 026; 01199000 ALFAID =23#, COMMENT 027; 01200000 INTID =24#, COMMENT 030; 01201000 BOOARRAYID =25#, COMMENT 031; 01202000 REALARAYID =26#, COMMENT 032; 01203000 ALFARRAYID =27#, COMMENT 033; 01204000 INTARRAYID =28#, COMMENT 034; 01205000 LABELID =29#, COMMENT 035; 01206000 COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000 TRUTHV =30#, COMMENT 036; 01208000 NONLITNO =31#, COMMENT 037; 01209000 LITNO =32#, COMMENT 040; 01210000 STRNGCON =33#, COMMENT 041; 01211000 LEFTPAREN =34#, COMMENT 042; 01212000 COMMENT CLASSES FOR ALL DECLARATORS; 01213000 DECLARATORS =35#, COMMENT 043; 01214000 COMMENT CLASSES FOR STATEMENT BEGINNERS 01215000 READV =36#, COMMENT 044; 01216000 WRITEV =37#, COMMENT 045; 01217000 SPACEV =38#, COMMENT 046; 01218000 CLOSEV =39#, COMMENT 047; 01219000 LOCKV =40#, COMMENT 050; 01220000 REWINDV =41#, COMMENT 051; 01221000 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 FILLV =49#, COMMENT 061; 01229000 SEMICOLON =50#, COMMENT 062; 01230000 IFV =51#, COMMENT 063; 01231000 GOV =52#, COMMENT 064; 01232000 RELEASEV =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 COMMENT CLASSES FOR OPERATORS; 01267000 NOTOP =85#, COMMENT 125; 01268000 ASSIGNOP =86#, COMMENT 126; 01269000 AMPERSAND =87#, COMMENT 127; 01270000 EQVOP =88#, COMMENT 130; 01271000 IMPOP =89#, COMMENT 131; 01272000 OROP =90#, COMMENT 132; 01273000 ANDOP =91#, COMMENT 133; 01274000 RELOP =92#, COMMENT 134; 01275000 ADOP =93#, COMMENT 135; 01276000 MULOP =94#, COMMENT 136; 01277000 FACTOP =95#, COMMENT 137; 01278000 STRING =99#, COMMENT 143; 01278050 FIELDID =125#, COMMENT 175; %117-01278090 FAULTID =126#, COMMENT 176; 01278100 SUPERLISTID =127#, COMMENT 177; 01278500 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 =06#, COMMENT 06; 01285000 LABELV =07#, COMMENT 07; 01286000 DUMPV =08#, COMMENT 10; 01287000 LISTV =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 FORMATV =16#, COMMENT 20; 01295000 FILEV =17#, COMMENT 21; 01296000 STREAMV =18#, COMMENT 22; 01297000 DEFINEV =19#, COMMENT 23; 01298000 AUXMEMV =20#, COMMENT 24; %117-01298500 FIELDV =21#, COMMENT 25; %117-01298600 DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000 REAL TIME1; 01300000 INTEGER SCRAM; 01301000 COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000 OR RESERVED WORD SCANNED; 01303000 ARRAY FILEATTRIBUTES[0:30] ; 01303500 ALPHA ARRAY ACCUM[0:10]; 01304000 COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000 SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000 IN INFO. THAT IS ACCUN[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,SUPERSTACK[0:124]; %WF 01310000 COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX %WF 01311000 POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100 LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200 BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300 AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400 WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500 1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700 3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800 STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900 FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE %WF 01312000 COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100 INTEGER COUNT; 01313000 COMMENT COUNT CONTAINS THE NUMBER OF CHARACTERS OF THE LAST ITEM 01314000 SCANNED; 01315000 ALPHA Q; 01316000 COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000 WORD SCANNED; 01318000 ARRAY ELBAT[0:76]; INTEGER I,NEXTELBT; 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 LASTELCLASS; 01329100 COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200 INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000 INTEGER MAXTCLR; 01331000 COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTER OF 01332000 THE CARD IMAGE CURRENTLY BEING SCANNED. NCR THE ADDRESS 01333000 OF THE NEXT 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 DEFINE BUFFSIZE = 56#; 01338000 INTEGER GTIX; 01339050 ARRAY TEN[0:69]; 01340000 INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050 DECLARED IN THE OBJECT PROGRAM; 01340060 INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070 GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080 REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500 INTEGER IDLOC,IDLOCTEMP; 01341000 ARRAY PDPRT[0:31,0:63]; 01342000 COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000 IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000 BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000 OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000 TYPE 1 ENTRY 01347000 BIT POSITION KIND OF ENTRY 01348000 0-3 ZERO 01349000 4 MODE BIT(1=CHAR 0=WORD) 01350000 5 ARGUMENT BIT 01351000 6-7 ZERO 01352000 8-17 RELATIVE ADDRESS IN PRT 01353000 18-27 RELATIVE ADDRESS IN SEGMENT 01354000 28-37 SEGMENT NUMBER 01355000 38-47 ZERO 01356000 TYPE 2 ENTRY 01357000 BIT POSITION KIND OF ENTRY 01358000 0 EMPTY 01359000 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000 2 ON IFF INTRINSIC PROCEDURE 01361000 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050 4-12 EMPTY 01361100 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200 28-37 SEGMENT NUMBER 01361300 38-47 NUMBER OF WORDS IN SEGMENT 01362000 THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000 IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000 ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000 DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000 IS READY FOR OUTPUT; 01367000 COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010 COMPILATION IS AS FOLLOWS: 01367020 SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030 BIT POSITIONS CONTENTS OF FIELD 01367040 [0:1] EMPTY 01367050 [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060 [2:1] ON IFF INTRINSIC PROCEDURE 01367070 [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075 [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080 [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085 [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 01367090 [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100 [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110 PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120 BIT POSITIONS CONTENTS OF FIELD 01367130 [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. IDBITS 01367140 [4:2] MODE AND ARGUMENT BITS 01367150 [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160 [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170 PRT ENTRY FOR SEGMENT I 01367180 [18:15] I 01367190 [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200 COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210 WORD CONTENTS 01367220 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230 1 SIZE OF SEGMENT DICTIONARY 01367240 2 RELATIVE LOCATION OF PRT 01367250 3 SIZE OF PRT 01367260 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270 5 SIZE OF FILE PARAMETER BLOCK 01367280 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290 7 N 01367300 . O U 01367310 . T S 01367320 . E 01367330 29 D; 01367340 INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000 INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000 INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000 ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000 COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000 AS SPECIFIED BY "L". 01373000 IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 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 VARIALE 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 READ 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 5 CARD READER - MAKCAST, MERGING. 01398100 6 TAPE - MAKCAST, MERGING. 01398200 ; 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 INTEGER AUXMEMREQ; 01411010 BOOLEAN SAVEPRTOG; 01411020 COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030 ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040 AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050 WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060 "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070 TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080 TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090 ROUTINE IS "PSEUDO-SAVE". 01411100 ; 01411110 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; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500 % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000 % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500 % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000 % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500 % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000 DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000 FI = 6#, FIO = 7#; 01420500 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 FIO MEANS FROM IODEC. 01427250 FA MEANS FROM ACTUALPARAPART. 01427500 FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600 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 COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000 PROGRAMS. 01432000 BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000 BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000 IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000 BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T301436000 INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 01437000 JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 01438000 IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 01439000 THINGS ON THE TOP OF THE STACK. 01440000 XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 01441000 WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 01442000 USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 01443000 THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE01444000 STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 01445000 LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 01446000 THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 01447000 BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW, THIS CARRIES YOU 01448000 TO THE PROPOER ITEM IN THE LIST. THE FORMATING ROUTINES 01449000 SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 01450000 LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 01451000 DEFINE BTYPE =1#, DTYPE =2#, ATYPE =3#; 01452000 COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 01453000 ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 01454000 BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 01455000 FOR ARITHMETIC EXPRESSIONS; 01456000 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 BOOLEAN GOTOG; 01467000 COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 01468000 LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000 MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 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 ALPHA ARRAY DEFINFO[0:89]; 01481100 ALPHA ARRAY TEXT[0:31,0:255]; 01481200 INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300 INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400 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 SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000 COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000 DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE=# PAIRS. 01493000 THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000 TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000 THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000 ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000 THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000 INTEGER BEGINCTR; 01499000 COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED 01500000 FOR ERROR CONTROL ONLY; 01501000 INTEGER DIALA,DIALB; 01502000 COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000 DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000 WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY 01505000 BY SETTING DIALA AND DIALB TO ZERO; 01506000 01507000 01508000 01509000 01510000 01511000 01512000 01513000 01514000 01515000 01516000 01517000 01518000 01519000 01520000 01521000 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 CHUNK = 180#; 01556100 FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200 FILE IN CARD (RR1,10,RR2); 01557000 SAVE 01558000 FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000 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 FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005 COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010 FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020 FILE IN CASTB(1,BUFFSIZE); 01561030 FILE IN CASTC(1,BUFFSIZE); 01561040 SWITCH FILE LIBRARY~CASTA,CASTB,CASTC; 01561050 FILE OUT REMOTE 19 (2,10); 01561055 SAVE ARRAY CBUF,TBUFF[0:9]; % INPUT BUFFERS. 01561056 BOOLEAN REMOTEG; 01561060 ARRAY LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 01561065 % TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070 % EACH ENTRY CONSISTS OF THREE WORDS CONTAINING: 01561080 FILE DSK1 DISK SERIAL [20:816](2,10,30); %116-01561085 FILE DSK2 DISK SERIAL [20:450](2,30,30); %116-01561087 DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090 NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100 DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110 INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120 COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 01561130 INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140 LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150 MAXTLCR USED IN READACARD, FILEINX IS THE 01561160 LIBRARY SWITCH FILE INDEX, SEQSUM IS THE 01561170 SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180 FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190 REAL RECOUNT,FINISHPT; 01561200 BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202 PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204 BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206 CARD READER ELSE FALSE; 01561208 COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210 BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215 OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217 DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220 BLOCKS PER LIBRARY TAPE; 01561230 ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240 DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250 A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260 B: 2 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270 IDENTIFIER NAME. 01561280 C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 01561290 D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300 ENTRIES. 01561310 ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320 LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330 DIRECTORY BLOCKS. 01561340 ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350 AND THE ITEM D WILL FOLLOW INDICATING THE 01561360 LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370 ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380 BLOCK. 01561390 IN ORDER TO CHANGE: 01561400 NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410 01561020 - 01561050. 01561420 - CHANGE "3" AT 01561430 NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440 AT ; 01561450 DEFINE %107-01561500 INSERTMAX = 20#, % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 01561510 INSERTCOP = INSERTINFO[INSERTDEPTH,4]#, % = 1 IF COPY TO NEWTAPE 01561520 INSERTMID = INSERTINFO[INSERTDEPTH,0]#, % MFID OF THE LIBRARY FILE 01561530 INSERTFID = INSERTINFO[INSERTDEPTH,1]#, % FID OF THE LIBRARY FILE 01561540 INSERTINX = INSERTINFO[INSERTDEPTH,2]#, % POINTER TO THE RECORD%107-01561550 INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#, % LAST SEQUENCE TO BE INCLUD01561560 INTEGER SAVECARD, INSERTDEPTH; %107-01561570 ARRAY INSERTINFO[0:INSERTMAX,0:4]; %107-01561580 FILE LIBRARYFIL DISK RANDOM(2,10,30); %107-01561590 DEFINE LF = LIBRARYFIL#; %107-01561600 SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER %107-01561610 REAL STREAM PROCEDURE CMPD(A,B); %107-01561620 BEGIN %107-01561630 SI:=A; DI:=B; %107-01561640 IF 8 SC } DC THEN %107-01561650 BEGIN %107-01561660 SI:=SI-8; DI=DI-8; TALLY:=2; %107-01561670 IF 8 SC = DC THEN TALLY:=1; %107-01561680 END; %107-01561690 CMPD:=TALLY; %107-01561700 END CMPD; %107-01561710 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 COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000 FOR THE USE OF CONVERT; 01568000 REAL STACKCT; %A01568500 DEFINE LOGI =443#, 01569000 EXPI =440#, 01570000 XTOTHEI =480#, 01571000 GOTOSOLVER =484#, 01572000 PRINTI =477#, 01573000 MERGEI =500#, 01573100 POWERSOFTEN =670#, 01574000 LASTSEQUENCE =166#, %117-01575000 LASTSEQROW = 2#, 01576000 INTERPTO =461#, 01577000 SUPERMOVER =555#, 01577500 CHARI =465#, 01578000 INTERPTI =469#, 01579000 SORTI =473#, 01579100 DIALER =559#, 01579200 FILEATTINT =563#, 01579300 POWERALL =567#, 01579350 SPECIALMATH =570#, 01579355 SORTA =673#, %117-01580000 COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000 IN INFO OF THE CORRESPONDING ROUTINE; 01582000 INTEGER KOUNT,BUFFACCUM; 01583000 INTEGER FILENO; 01584000 BOOLEAN 01585000 FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000 FUNCTION; 01587000 P2, COMMENT GNERALLY TELLS WHETHER OWN WAS SEEN; 01588000 P3, COMMENT TELSS WHETHER SAVE WAS SEEN; 01589000 P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500 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 REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100 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 GLOBALNINFOO,COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 01620100 GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 01620200 CAN CHECK FOR DUPLICATE DECLARATIONS; %118-01620300 OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; %118-01620400 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 REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100 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 REFERS TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE01630000 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 (0051) 7.4.9.3 DELETE; %A 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 MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100 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 SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100 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 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 STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010 BEGIN LOCAL T1,T2,T3; 01688020 SI~EDOC;T1~SI;SI+TEDOC;T2~SI;SI~LOC EDOC;SI~SI+3;DI~LOC T3; 01688030 DI~DI+5;SKIP 3 DB;15(IF SB THEN DS~1 SET ELSE DS~1 RESET; 01688040 SKIP 1 SB);SI~LOC EDOC;DI~LOC T2; DS~5 CHR;3(IF SB THEN DS~ 01688050 1 SET ELSE DS ~ 1 RESET; SKIP 1 SB);DI~T3;SI~LOC T2;DS~WDS; 01688060 DI~LOC T3;DI~DI+5;SKIP 3 DB;SI~LOCL TEDOC;SI~SI+3;15(IF SB 01688070 THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);SI~ LOC TEDOC;DI~LOC 01688080 T1; DS~5 CHR;3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB); 01688090 DI~T3;SI~LOC T1;DS~WDS 01688100 END; 01688110 REAL NLO,NHI,TLO,THI; 01689000 BOOLEAN DPTOG; 01690000 COMMENT THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;01691000 DEFINE FZERO=896#; 01692000 REAL T1,T2,N,K,AKKUM; 01693000 BOOLEAN STOPGSP; 01694000 INTEGER BUP; 01695000 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. ORTI 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 BOOLEAN MACROID; 01717800 REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900 PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950 PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000 REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100 PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200 INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000 BOOLEAN LISTMODE; 01720000 COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000 IS BEING GENERATED OR A STATEMENT; 01722000 INTEGER LSTR; 01723000 COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000 USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000 PROCEDURE SCANNER; FORWARD; 01730000 COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 01732000 REAL STREAM PROCEDURE MKABS(A); 01733000 BEGIN DI ~ A; MKABS ~ DI END MKABS; 01734000 STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000 BEGIN LOCAL T; 01736000 SI~LOC W; DI~LOC T; SI~SI+6; DI~DI+7; DS~CHR; 01736100 SI~A; DI~B; T(DS~32 WDS; DS~32 WDS); DS~W WDS; 01736200 END MOVE; 01736300 STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000 VALUE NDIV32,NMOD32 ; 01737050 BEGIN DI := DEST; 01737100 NDIV32(32(DS :=8 LIT"0")); 01737150 NMOD32(DS := 8 LIT"0"); 01737200 END; 01737250 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 01738000 01739000 01740000 PROCEDURE STEPIT; FORWARD; 01741000 COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100 STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200 BEGIN 01741300 DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400 END; 01741500 STREAM PROCEDURE SEQUENCEWARNING(L); 01742100 BEGIN DI:=L; DI:=DI-8; DS:=24 LIT "SEQUENCE WARNING<<<<<<<<"; END; 01742110 BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200 COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300 TRUE IF ANY VISIBLE CHARACTER ; 01742400 BEGIN 01742500 LABEL NED; 01742600 SI~FCR; 01742700 TALLY~0; 01742800 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900 TALLEY~63; 01743000 NED: TALLY~TALLY+1; 01743100 NONBLANK~TALLY 01743200 END NONBLANK; 01743300 INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE** 01750000 GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000 FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000 BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000 ABOUT FAULTLEVEL; 01754000 INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000 STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR,SEQ); VALUE NCR; 01756000 BEGIN 01757000 LABEL L,TRANS; 01758000 LOCAL N; 01759000 SI:=SEQ; DI:=LCR; DI:=DI-1; DS:=LIT"%"; % PUT "%" IN CC 72. 01759100 DS:=WDS; % RESTORE SEQ. NO. FOR $VOID(T) CARDS. 01759200 SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000 SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000 2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000 SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-80. 01763000 L: 01764000 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 TRANS: 01778000 SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000 SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000 N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000 DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000 DI:=VR; SI:=LOC VP; DS:=WDS; % ADDRESS OF VOID RANGE. 01783000 END OF GETVOID; 01784000 REAL VOIDCR,VOIDPLACE; 01785000 BOOLEAN SORTMERGETOG; 01786000 FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000 PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000 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:=CODE.MFID; N2:=CODE.FID; 01828500 WRITE(LINE, 01829000 $ SET OMIT = NOT ALGOL 01829900 "XVI.0.122" %123-01831000 ," ",A6,"DAY, ",0,", ",I2.":",A2,X1,A3, 01832000 ////X45,A1,A6,"/",A1,A6,/X45,15("=")//>, 01832500 TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000 Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000 IF H}12THEN "PM." ELSE "AM.", 01835000 N1,[6:6],N1,N2,[6:6],N2); 01835500 IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. %120-01835600 WRITE(LINE,, %120-01835700 (N1:=TAPE.MFID),[6:6],N1,(N2:=TAPE.FID),[6:6],N2); %120-01835800 NOHEADING:=FALSE; 01836000 END OF DATIME; 01837000 DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000 COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000 AND SCANNING THEM; 02001000 BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020 VALUE ROW ; 02001030 BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040 REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050 ; 02001060 LOCAL DPPOS,TEMP,LGTH; 02001070 LABEL LOOP,EXIT; 02001080 SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090 DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100 SI~SI+8; 02001110 LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120 DI~ACC1; DI~DI+2; SI~SI-1; 02001130 IF SC = DC 02001140 THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150 IF LGTH SC = DC 02001160 THEN BEGIN COMMENT FOUND IT; 02001170 DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180 IF SC = "0" 02001190 THEN BEGIN COMMENT WE MAY BE IN THE02001200 WRONG ROW; 02001210 SI~SI+1;DI~LOC LOOK; 02001220 IF 3 SC = DC 02001230 THEN BEGIN COMMENT WE ARE02001240 IN THE WRONG 02001250 ROW; 02001260 SI~DPPOS; 02001270 SI~SI+8; 02001280 DPPOS~SI; 02001290 DI~LOC TEMP; 02001300 DS~WDS; 02001310 SI~TEMP; 02001320 END 02001330 ELSE SI~SI-4; 02001340 END; 02001350 DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360 SI~SI+ LGTH; 02001370 DI~STOPOS; DS~5 LIT"0"; 02001375 DS~3 CHR; GO TO EXIT; 02001380 END; 02001390 SI~SI+3; 02001400 END 02001410 ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420 SI~SI-1; 02001430 IF SC = "0" 02001440 THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450 SI~SI+1; DI~LOC LOOK; 02001460 IF 3 SC = DC 02001470 THEN BEGIN COMMENT CHANGE ROWS; 02001480 SI~DPPOS;SI~SI+8;DPPOS~SI;02001490 DI~LOC TEMP; DS~WDS; 02001500 SI~TEMP; 02001510 END 02001520 ELSE BEGIN COMMENT IT IS NOT HERE; 02001530 TALLY~1; LOOK~TALLY; 02001540 GO TO EXIT; 02001550 END; 02001560 GO TO LOOP; 02001563 END; 02001565 SI~SI~LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568 END; 02001570 GO TO LOOP; 02001580 EXIT:; 02001590 END LOOK; 02001600 %***********************************************************************02001605 % %116-02001610 % MISCELLANEOUS CROSS REFERENCE PROCEDURES %116-02001615 % %116-02001620 %***********************************************************************02001630 % %116-02001635 PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); %116-02001640 VALUE INDEX,SEQNO,REFTYPE; %116-02001645 REAL INDEX,SEQNO,REFTYPE; %116-02001650 BEGIN %116-02001655 IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE %116-02001660 BEGIN %116-02001665 IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. %116-02001670 BEGIN %116-02001675 WRITE(DSK2,30,XREFAY2[*]); %116-02001680 XREFPT := 0; %116-02001685 END; %116-02001690 XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] %116-02001695 REFIDNOF; %116-02001700 XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE %116-02001705 % CANT WRITE IT OUT BECAUSE SOME ROUTINES %116-02001710 % WILL LOOK BACK AT THE ENTRY WE JUST PUT %116-02001715 % IN AND FIX IT UP. %116-02001720 END; %116-02001725 END OF CROSSREFIT; %116-02001730 % %116-02001735 PROCEDURE CROSSREFDUMP(INDEX); %116-02001740 VALUE INDEX; %116-02001745 REAL INDEX; %116-02001750 BEGIN %116-02001755 STREAM PROCEDURE MOVEREFINFO(S,D,N); %116-02001760 VALUE N; %116-02001765 BEGIN %116-02001770 SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD %116-02001775 SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER %116-02001780 END OF MOVEXREFINFO; %116-02001785 % %116-02001790 IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT %116-02001795 BEGIN %116-02001800 MOVEXREFINFO(INFO[INDEX,LINKR,INDEX,LINKC+1],XREFAY1[*], %116-02001805 TAKE(INDEX+1),[12:6]); %116-02001810 XREFAY1[8] := XREFINFO[INDEX]; %116-02001815 XREFAY1[9] := TAKE(INDEX); % ELBAT WORD %116-02001820 WRITE(DSK1,10,XREFAY1[*]); %116-02001821 XREFINFO[INDEX] := 0; %116-02001822 END; %116-02001825 END OF CROSSREFDUMP; %116-02001830 REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831 BEGIN 02001832 SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833 END CONV; 02001834 COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 02001836 BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001838 BEGIN 02001840 SI:=S; SI:=SI+3; DI:=D; SK(DS:=3 RESET); % RIGHT JUSTIFY. 02001842 CNT(IF SC}"8"THEN TALLY:=1 ELSE IF SC{"0"THEN TALLY:=1; SKIP 3 SB; 02001844 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02001846 % 02001848 % 02001850 OCTIZE:=TALLY; % "1" = NON OCTAL CHARACTER. 02001852 END OCTIZE; 02001854 COMMENT HEXIZE REFORMATS ACCUM FOR HEXADECIMAL CONSTANTS; 02001856 BOOLEAN STREAM PROCEDURE HEXIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001858 BEGIN LOCAL T1,T2,TEMP2,TEMP1; LABEL AGIN; 02001860 COMMENT LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE 02001862 WAY THEY ARE DECLARED IN STREAM PROCEDURES; 02001864 DI:=LOC TEMP1; CNT(DS:=LIT"1"); % IN CASE A CHAR=A,B,C,D,OR F. 02001866 SI:=S; SI:=SI+3; DI:=LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2. 02001868 CNT(IF SC<"0" THEN IF SC}"A"THEN IF SC{"F"THEN % WORK HARD. 02001870 BEGIN 02001872 T1:=SIL T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN. 02001874 DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK. 02001876 DS:=1 ADD; DI:=DI-1; SKIP 2 DB; DS:=1 SET; SKIP 3 DB; 02001878 GO AGIN; 02001880 END; 02001882 IF SC<"0" THEN TALLY:=1; DS:=CHR; % < 0 = NON-HEX CHARACTER. 02001884 AGIN: 02001886 ); 02001888 SI:=LOC TEMP1; DI:=D; SKP(DS:=4 RESET); % RIGHT ADJUST CONSTANT. 02001890 CNT(SKIP 2 SB; 02001892 4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));% FINAL CONVERT. 02001894 HEXIZE:=TALLY; % "1" IF PROGRAMMER GOOFED. 02001896 END HEXIZE; 02001898 COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 02002000 CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 02003000 IT IS NEEDED FOR FUTURE REFERENCE; 02004000 STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR; 02005000 BEGIN DI:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000 COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 02007000 I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 02008000 CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02009000 THE SCANNER; 02010000 STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000 BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000 COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010 IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020 THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030 NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040 VARIABLE AD; 02013050 STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060 VALUE AD,DESCRP; 02013065 BEGIN 02013070 LOCAL HOLD,ZONEP; 02013073 DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074 COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075 DI~SUM; DI~DI+7; DS~2 RESET; 02013076 COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077 SI~LOC DESCRP; SI~SI+7; 02013078 IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080 DS~WDS; DI~HOLD; END 02013085 ELSE DI~SEQLOC; 02013090 COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091 HOLD~DI; DI~DI+7; DS~2 RESET; DI~HOLD; 02013095 SI ~ LOC AD; 02013100 SI ~ SI + 7; 02013110 IF SC = "1" THEN BEGIN SI~ SUM; DS~8 ADD; END 02013120 ELSE BEGIN SI~ SUM; DS~8 SUB; END; 02013130 SI~LOC ZONEP; DI~HOLD; DS~8 ZON; 02013135 SI~LOC ZONEP; DI~SUM; DS~8 ZON; 02013136 COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137 END ADDER; 02013140 COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150 COMPILABLE QUANTITIES. THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155 A LIBRARY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160 PROCEDURE SEARCHLIB(DOLLAR); VALUE DOLLAR; BOOLEAN DOLLAR; 02013165 BEGIN 02013170 LABEL EXIT,EXITOUT, NOPARTIAL; 02013175 PROCEDURE FLAGIT(N); VALUE N; INTEGER N; 02013176 BEGIN 02013177 BOOLEAN TL,TS; 02013178 TL:=LISTOG; TS:=SINGLTOG; LISTOG:=FALSE; SINGLTOG:=FALSE; 02013179 Q:=ACCUM[1]; FLAG(N); 02013180 LISTOG:=TL; SINGLTOG:=TS; 02013181 END FLAGIT; 02013183 IF DOLLAR THEN 02013184 BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190 RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195 RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200 IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205 FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210 COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219 FLAGIT(500); GO EXIT; 02013222 END; 02013225 FILEINX ~ FILEINX -1; 02013230 IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235 BEGIN COMMENT MUST READ DIRECTORY; 02013240 GT3~MKABS(LIBRARY[FILEINX](0)); 02013245 MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250 GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255 WHILE GT2 ~ GT2-1 > 0 DO 02013260 BEGIN 02013265 READ(LIBRARY[FILEINX]); 02013270 MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275 END; 02013280 END; 02013285 RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROD.ID.; 02013290 IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295 BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300 FLAGIT(501); GO EXIT; 02013305 END; 02013310 WHILE LCR.[33:15] - NCR.[33:15] !1 OR NCR.[30:3] ! 7 02013313 DO BEGIN 02013315 IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317 RESULT~5; SCANNER; 02013318 END; 02013319 GO TO NOPARTIAL; 02013320 EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325 RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT SPACE PAST "[" ;02013330 RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET START POINT;02013335 IF RESULT ! 3 THEN 02013340 BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345 FLAGIT(502); GO EXIT; 02013350 END; 02013355 GT1 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360 RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013365 IF RESULT ! 2 THEN 02013370 BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375 FLAGIT(503); GO EXIT; 02013380 END; 02013385 RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET LENGTH; 02013390 IF RESULT ! 3 THEN 02013395 BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400 FLAGIT(504); GO EXIT; 02013405 END; 02013410 GT2 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415 RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013420 IF ACCUM[1] ! "1D0000" THEN 02013425 BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430 FLAGIT(505); GO EXIT; 02013435 END; 02013440 WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013445 DO BEGIN RESULT ~ 5; SCANNER END; 02013446 END; 02013450 NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475 LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480 LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490 LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495 LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497 FINISHPT ~ GT2; 02013500 IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3],FILEINDEX) 02013505 |3,0] ~ RECOUNT -1; 02013510 RECOUNT~GT1; 02013515 IF EXAMIN(LCR) ! "%" THEN 02013516 PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525 IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526 ELSE IF MAXLTLCR.[33:15]=NCR.[33:15]<11 THEN 02013527 GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528 LIBARRAY[LIBINDEX+2],NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530 IF LASTUSED{2 OR LASTUSED=5 THEN 02013533 LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534 LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535 IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536 LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537 LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538 END ELSE BEGIN 02013539 LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540 ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541 LIBINDEX ~ LIBINDEX + 3; 02013542 END 02013545 ELSE 02013550 BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555 LIBINDEX ~ LIBINDEX -3; 02013560 RECOUNT~RECOUNT-1; 02013563 LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565 IF LASTUSED =1 THEN MEDIUM := "C "; %112-02013566 IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567 DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568 DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570 IF LIBINDEX > 0 THEN 02013575 FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580 FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600 IF LIBINDEX ! 0 THEN 02013610 MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615 IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617 NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620 IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621 LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625 NORELEASE~TRUE; 02013627 IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628 END OF UNLINK; 02013630 IF LIBINDEX = 0 THEN 02013635 BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640 SEQSUM~0; 02013645 END 02013650 ELSE 02013655 BEGIN 02013660 GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665 GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670 GT3 ~(GT2 - GT1)DIV 5; 02013675 SPACE(LIBRARY[FILEINX],GT3); 02013680 02013681 02013682 READ(LIBRARY[FILEINX],GT3); 02013685 02013690 02013693 MOVE(1,LIBRARY[FILEINX](0),GTI1); 02013697 IF GTI1!GT2 AND GTI1 !0 THEN 02013699 BEGIN COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 02013701 FLAG(507); GO TO EXIT; 02013702 END; 02013703 LTLCR~MKABS(LIBRARY[FILEINX](10))+(GTI1~(((RECOUNT-1) MOD 5) |11)); 02013705 MAXLTLCR~MKABS(LIBRARY[FILEINX](0))+54; 02013710 ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713 IF LASTUSED= 6 THEN BEGIN 02013714 NCR~LCR~MKABS(LIBRARY[FILEINX](0)); 02013715 PUTSEQNO(GT1,LCR); 02013716 TURNONSTOPLIGHT("%",LCR); 02013717 END; END; 02013718 EXIT: END SEARCHLIB; 02013720 COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000 AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000 BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000 BEGIN SI~FCR; IF SC!"$" THEN TALLY~1; 02017000 DI~NEW; DS~10 WDS; WRITNEW~TALLY 02018000 END WRITNEW; 02019000 02020000 02021000 02022000 02023000 02041000 02042000 02043000 02044000 02045000 02046000 02047000 02047050 02047055 02047060 02047065 02047070 02047075 02048000 02049000 02050000 02051000 02052000 02053000 02054000 02055000 02055100 02055200 02055300 02056000 02057000 02058000 02059000 02060000 COMMENT EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR 02061000 EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02061500 QUANTITIES IN THE DIRECTORY; 02062000 BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02062500 BEGIN 02063000 TALLY:=1; SI:=A; DI:=B; 02063500 IF COUNT SC=DC THEN EQUAL:=TALLY 02064000 END EQUAL; 02064500 PROCEDURE READACARD; FORWARD; 02065000 PROCEDURE DOLLARCARD; FORWARD; 02065500 BOOLEAN PROCEDURE BOOLEXP; FORWARD; 02065600 PROCEDURE SCANNER; 02066000 BEGIN 02066500 COMMENT "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 02067000 IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER". 02067500 WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 02068000 IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO 02068500 INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE. 02069000 HENCE THE VARIABLE "RESULTS" IS PASSED BY BOTH NAME AND VALUE. 02069500 THE MEANING OF "RESULT" AS INPUT IS: 02070000 VALUE MEANING 02070500 ===== ========================================= 02071000 0 INITIAL CODE - DEBLANK AND START TO FETCH THE 02071500 NEXT QUANTITY. 02072000 1 CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02072500 END-OF-CARD BREAK). 02073000 2 LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE, 02073500 EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT 02074000 IMPORTANT). 02074500 3 CONTINUE BUILDING A NUMBER (INTERRUPTED YB END-OF- 02075000 CARD BREAK). 02075500 4 LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE,02076000 EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT 02076500 IMPORTANT). 02077000 5 GET NEXT CHARACTER AND EXIT. 02077500 6 SCAN A COMMENT. 02078000 7 DEBLANK ONLY. 02078500 THE MEANING OF "RESULT" AS OUTPUT IS: 02079000 VALUE MEANING 02079500 ===== ======================================= 02080000 1 AN IDENTIFIER WAS BUILT. 02080500 2 A SPECIAL CHARACTER WAS OBTAINED. 02081000 3 A NUMBER (INTEGER) WAS BUILT. 02081500 "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02082000 DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR" 02082500 FOR THE REST OF THIS DISCUSSION). 02083000 "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS 02083500 "SCAN" HAS PUT INTO THE "ACCUMULATOR". SINCE "SCAN" NEEDS 02084000 THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM- 02084500 ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD. 02085000 "COUNT" IS PASSED BY BOTH NAME AND VALUE/ IT IS ALSO 02085500 CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT". 02086000 "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY 02086500 NAME AND VALUE SO THAT IT MAY BE UPDATED. 02087000 "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02087500 PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK 02088000 ARRANGEMENT. 02088500 ; 02089000 STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02089500 COUNT,ST2,NCRV,ST1); 02090000 VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02090500 BEGIN 02091000 LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS.L,ERROR, 02091500 COMMENTS,COMMANTS; 02092000 DI:=RESULT; DI:=DI+7; SI:=NCRV; 02092500 COMMENT SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT 02093000 THE BUFFER; 02093500 CI:=CI+RESULTV; % SWITCH ON VALUE OF RESULT; 02094000 GO DEBLANK; % 0 IS INITIAL CODE. 02094500 GO IDBLDR; % 1 IS ID CODE. 02095000 GO FINIS; % 2 IS SPECIAL CHARACTER CODE. 02095500 GO NUMBERS; % 3 IS NUMBER CODE. 02096000 GO FINIS; % 4 IS ERROR CODE. 02096500 GO GNC; % 5 IS GET NEXT CHARACTER CODE. 02097000 GO COMMANTS; % 6 IS COMMENT CODE. 02097500 % 7 IS DEBLANK ONLY CODE. 02098000 IF SC=" " THEN 02098500 K: BEGIN SI:=SI+1; IF SC=" " THEN GO K END; 02099000 GO FINIS; 02099500 DEBLANK: 02100000 IF SC=" " THEN 02100500 L: BEGIN SI:=SI+1; IF SC=" " THEN GO L END; 02101000 COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 02101500 NCRV:=SI; 02102000 IF SC } "0" THEN GO NUMBERS; 02102500 IF SC=ALPHA THEN GO IDBLDR; 02103000 COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 02103500 GNC: 02104000 DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT; 02104500 COMMANTS: 02105000 IF SC!";" THEN 02105500 BEGIN 02106000 COMMENTS: 02106500 SI:=SI+1; 02107000 IF SC > "%" THEN GO COMMENTS; 02107500 IF SC < ";" THEN GO COMMENTS; 02108000 COMMENT CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD- 02108500 MODE PART OF COMMENT ROUTINE; 02109000 END; 02109500 GO FINIS; 02110000 IDBLDR: 02110500 TALLY:=63; DS:=LIT "1"; 02111000 COMCOUNT(TALLY:=TALLY+1; 02111500 IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO EXIT); 02112000 TALLY:=TALLY+1; 02112500 IF SC=ALPHA THEN 02113000 BEGIN 02113500 ERROR: 02114000 DI:=DI-1; DS:=LIT "4"; GO EXIT; 02114500 END 02115000 ELSE GO EXIT; 02115500 COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS 02116000 IN AN IDENTIFIER OR NUMBER; 02116500 NUMBERS: 02117000 TALLY:=63; DS:=LIT "3"; 02117500 COMCOUNT(TALLY:=TALLY+1; 02118000 IF SC <"0"THEN JUMP OUT TO EXIT; SI:=SI+1); 02118500 GO ERROR; 02119000 EXIT: 02119500 ST1:=TALLY; % "ST1" CONTAINS THE 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 IF LIBINDEX!0 THEN 02131500 IF RECOUNT=FINISHPT THEN 02132000 BEGIN 02132500 SEARCHLIB(FALSE); 02133000 READACARD; 02133500 NORELEASE:=FALSE; 02134000 END; 02134500 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 MAKCAST = BEGIN 02181500 CARDCALL:=IF LASTUSED=5 THEN TRUE ELSE FALSE; 02181750 SEARCHLIB(TRUE); 02182000 END #, 02182250 PRINTCARD = BEGIN 02182500 EDITLINE(LIN,FCR,L.[36:10], %114-02182750 SGNO,L.[45:2],MEDIUM,OMITTING); %114-02182760 IF NOHEADING THEN DATIME; WRITELINE; 02183000 END #; 02183250 STREAM PROCEDURE EDITLINE(LINE,NGR,R,S,L,SYMBOL,OMIT); %114-02183500 VALUE NCR,R,S,L,SYMBOL,OMIT; %114-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; SI:=SI+4; 02185750 IF SC=" " THEN DS:=12 LIT" " ELSE %114-02186000 BEGIN %114-02186250 SI:=LOC S; DS:=4 DEC; DS:=LIT ":"; %114-02186300 SI:=LOC R; DS:=4 DEC; DS:=LIT ":"; %114-02186400 SI:=LOC L; DS:=1 DEC; DS:=LIT " "; %114-02186500 END; %114-02186600 OMIT(DI := DI - 12; DS := 12 LIT " :OMIT: "; DI:= LINE; %114-02186750 DS := 8 LIT " :OMIT:"); %114-02186760 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 INSERTDEPTH > 0 AND INSERTCOP=1 OR INSERTDEPTH=0 THEN %107- 02193800 IF WRITNEW(LIN,FCR) THEN WRITF(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 BEGINPRINT; 02196510 BEGIN 02196520 STREAM PROCEDURE STUFF(N,L); VALUE N; 02196530 BEGIN 02196540 DI:=L; DS:=8 LIT " "; SI:=L; DS:=13 WDS; 02196550 SI:=LOC N; DS:=8 DEC; 02196560 END; 02196570 STUFF(BEGINSTACK[BSPOINT],LIN); 02196580 IF NOHEADING THEN DATIME; WRITELINE; 02196590 END BEGINPRINT; 02196610 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(LCR,MAXLCR,LIB); VALUE LIB; BOOLEAN LIB; 02198500 REAL LCR, MAXLCR; 02198750 BEGIN %105-02198755 LABEL ENDREADTAPE, EOFT; %105-02198760 IF LIB THEN 02199000 BEGIN 02199250 RECOUNT:=RECOUNT+1; 02199500 IF LCR:=LCR+11>MAXLCR THEN 02199750 BEGIN 02200000 READ(LIBRARY,FILEINX); 02200250 MAXLCR:=46+LCR:=MKABS(LIBRARY[FILEINX](0))+10; 02200500 END; 02200750 ADDER(SEQSUM,LCR,TRUE,TRUE); 02201000 END 02201250 ELSE BEGIN 02201500 READ (TAPE, 10, TBUFF[*])[EOFT]; %105-02201750 MAXLCR:=LCR:=MKABS(TBUFF[9]); %105-02202000 GO TO ENDREADTAPE; %105-02202010 EOFT: %105-02202020 DEFINEARRAY[25]:="ND;END."& "E"[1:43:5]; %105-02202030 DEFINEARRAY[34]:="9999" & "9999"[1:25:23]; %105-02202040 TLCR:= MKABS(DEFINEARRAY[34]); %105-02202050 PUTSEQNO (DEFINEARRAY[33],TLCR-8); %105-02202060 TURNONSTOPLIGHT("%", TLCR-8); %105-02202070 ENDREADTAPE: %105-02202080 END; %105-02202090 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:=IF LIB THEN 6 ELSE 3; 02204000 MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T.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 IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750 LASTCRDPATCH:=TRUE ELSE 02208000 READTAPE(LTLCR,MAXLTLCR,TRUE) ELSE 02208250 READTAPE(TLCR,MAXTLCR,FALSE); 02208500 END; 02208750 LCR:=CLCR; 02209000 LASTUSED:=IF LIB THEN 5 ELSE 2; 02209250 END; 02209500 END OF SEQCOMPARE; 02209750 LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02210000 EOF, USETHESWITCH, 02210250 COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02210500 LABEL COPYLIB, COPYEOF; %107-02210600 SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750 LIBCLAST, LIBTLAST, COPYLIB; %107-02211000 BOOLEAN DOLLAR2TOG; 02211250 IF ERRORCOUNT}ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500 USETHESWITCH: 02211750 GO TO USESWITCH[LASTUSED]; 02212000 MOVE(1,TEXT[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,LASTSEQENCE],LCR); 02214250 CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02214260 TURNONSTOPLIGHT("%",LCR); 02214500 GO XIT; 02214750 COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000 CARDONLY: 02215250 IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*]); 02215500 LCR := MKABS(CBUFF[9]); GO EXIT; 02215750 CARDLAST: 02216000 IF NORELEASE THEN GO TO EXIT; 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(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02219500 COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02219750 LIBCLAST: 02220000 IF FIRSTIMEX THEN 02220250 BEGIN FIRSTIMEX:=FALSE; GO COMPAR END; 02220500 READ(CARD,10,CBUFF[*])[EOF]; 02220750 CLCR := MKABS(CBUFF[9]); 02221000 IF LASTCRDPATCH THEN 02221250 BEGIN 02221500 LASTCRDPATCH:=FALSE; 02221750 RECOUNT:=RECOUNT+1; 02222000 GO TO XIT 02222250 END; 02222500 GO TO COMPAR; 02222750 LIBTLAST: 02223000 IF FIRSTIMEX THEN 02223250 BEGIN FIRSTIMEX:=FALSE; GO TO COMPAR END; 02223500 READTAPE(LTLCR,MAXLTLCR,TRUE); 02223750 IF RECOUNT=FINISHPT THEN GO TO XIT; 02224000 GO COMPAR; %107-02224010 COPYLIB: %107-02224020 READ(LF[INSERTINX:=INSERTINX+1],10,LBUFF[*])[COPYEOF]; %107-02224030 READ SEEK(LF[INSERTINX+1]); %107-02224032 IF(CMPD(INSERTSEQ,LBUFF[9]) = 0) THEN GO COPYEOF; %107-02224040 LCR:=MKABS(LBUFF[9]); %107-02224050 GO TO EXIT; %107-02224060 COPYEOF: %107-02224070 CLOSE(LF,RELEASE); %107-02224080 IF((INSERTDEPTH:=INSERTDEPTH-1) = 0) THEN %107-02224090 BEGIN LASTUSED:=SAVECARD; MEDIUM:=MEDIUM.[24:12]; %107-02224100 GO USETHESWITCH; %107-02224102 END; %107-02224104 FILL LF WITH INSERTMID, INSERTFID; %107-02224110 GO COPYLIB; %107-02224120 COMPAR: 02224250 IF LASTUSED = 2 OR LASTUSED = 3 THEN SEQCOMPARE(TLCR,CLCR,FALSE) 02224500 ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02224750 EXIT: 02225000 NCR := FCR:= LCR - 9; 02225250 COMMENT SETS UP NCR AND FCR; 02225500 IF CHECKTOG AND EXAMIN(FCR)!"$" THEN %$=CARDS DON"T COUNT. 02225750 IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000 IF SEQERRTOG THEN BEGIN FLAG(610); 02226250 NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300 ELSE BEGIN % SEQUENCE WARNING 02226500 BLANKET(14,LIN); 02226750 SEQUENCEWARNING(LIN[13]); 02227000 IF NOHEADING THEN DATIME; WRITELINE; 02227250 IF NOT LISTER THEN PRINTCARD; 02227500 NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1; 02227600 END; 02227750 IF EXAMIN(FCR)="$" THEN 02228250 BEGIN 02228500 IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD; 02228750 IF EXAMIN(NCR:=NCR+32768)="$" THEN MAKCAST ELSE DOLLARCARD; 02229000 NORELEASE := FALSE; 02229100 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 IF EXAMIN(NCR:=NCR+65536)="$" THEN MAKCAST ELSE 02230750 DOLLARCARD; 02231000 END; 02231250 IF VOIDING OR VOIDTAPE THEN 02231500 BEGIN 02231750 IF COMPARE(LCR,VOIDCR)=0 THEN 02232000 BEGIN 02232250 IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN 02232500 GO USETHESWITCH; 02232750 END 02233000 ELSE BEGIN 02233250 VOIDCR:=VOIDPLACE:=0; 02233500 VOIDING:=FALSE; VOIDTAPE:=FALSE 02233750 END; 02234000 END; 02234250 CARDCOUNT:=CARDCOUNT+1; 02234500 IF DOLLAR2TOG THEN 02234600 BEGIN DOLLAR2TOG:=NORELEASE:=FALSE; GO USETHESWITCH;END; 02234650 PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02234750 CARDNUMBER:=IF SEQTOG THEN TOTALNO+ADDVALUE ELSE 02234800 CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02234900 OUTPUTSOURCE; 02235000 IF OMITTING THEN GO USETHESWITCH; 02235250 % 02235500 TURNONSTOPLIGHT("%",LCR); 02235750 IF BUILDLINE THEN 02236000 IF LASTADDRESS ! (LASTADDRESS := L.[36:10]) THEN 02236250 BEGIN 02236500 ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750 IF (ENILPTR := ENILPTR+1)}1023 THEN 02237000 BEGIN FLAG(80); ENILPTR := 512; END; 02237250 END; 02237500 XIT: 02237750 END READACARD; 02238000 PROCEDURE INCLUDECARD; %107-02238100 BEGIN %107-02238110 REAL V; %107-02238112 LABEL EEXIT,AGAIN,GETEM,EOF,EXIT,DONTSCAN; %107-02238120 REAL STREAM PROCEDURE SCNN(A,B); VALUE B; %107-02238130 BEGIN %107-02238140 SI:=A; DI:=LOC SCNN; DS:=8 LIT"0 "; %107-02238150 DI:=DI-7; SI:=SI+3; DS:=8 CHR; %107-02238160 END; %107-02238170 STREAM PROCEDURE MVE(A,B,C,D); VALUE B,C; %107-02238180 BEGIN %107-02238190 SI:=A; SI:=SI+3; DI:=D; C(DS:=LIT"0"); DS:=B CHR; %107-02238200 END; %107-02238210 STREAM PROCEDURE MVEWD(A,B); VALUE A; %107-02238212 BEGIN SI:=A; DI:=B; DS:=10 WDS; END; %107-02238214 DEFINE SKAN = BEGIN %107-02238220 COUNT:=RESULT:=ACCUM[0]:=0; %107-02238230 SCANNER; %107-02238240 V:=SCNN(ACCUM[1],MIN(COUNT,7)); %107-02238250 END#; %107-02238260 DEFINE ERR(ERR1) = BEGIN FLAG(ERR1); GO TO EEXIT; END#; %107-02238270 IF((INSERTDEPTH:=INSERTDEPTH+1) > INSERTMAX) THEN ERR(612); %107-02238280 INSERTMID:=INSERTFID:=INSERTINX:=INSERTCOP:=0; %107-02238290 INSERTSEQ:="9999"&"9999"[1:23]; %107-02238300 AGAIN: %107-02238330 SKAN; %107-02238340 DONTSCAN: %107-02238342 IF V="% " THEN GO GETEM; %107-02238350 IF V="/ " THEN GO AGAIN; %107-02238360 IF RESULT=3 THEN % SEQ RANGE %107-02238370 BEGIN %107-02238380 MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTINX); %107-02238385 SKAN; %107-02238390 IF V="- " THEN %107-02238400 BEGIN %107-02238410 SKAN; %107-02238420 IF RESULT ! 3 THEN ERR(614); %107-02238430 MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); %107-02238440 END ELSE GO TO DONTSCAN; %107-02238450 GO AGAIN; %107-02238460 END; % SEQ RANGE %107-02238470 IF V="+ " THEN % WE HAVE COPY FORM %107-02238480 BEGIN %107-02238490 SKAN; %107-02238500 IF V="COPY " THEN %107-02238510 IF EXAMIN(LCR-9)="$" THEN %107-02238512 INSERTCOP:=INSERTINFO[INSERTDEPTH-1,4] %107-02238514 ELSE ERR(617) %107-02238520 ELSE ERR(616); %107-02238522 GO AGAIN; %107-02238530 END; %107-02238540 IF INSERTMID=0 THEN INSERTMID:=V %107-02238550 ELSE IF INSERTFID=0 THEN INSERTFID:=V ELSE ERR(616); %107-02238552 GO AGAIN; %107-02238555 GETEM: %107-02238560 IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN %107-02238570 IF EXAMIN(FCR) = "$" THEN % ONLY IF "$" IS IN COLUMN ONE %107-02238572 IF BOOLEAN(INSERTINFO[INSERTDEPTH-1,4]) THEN % ONLY IF LAST HAD COPY02238574 BEGIN MVEWD(FCR,LBUFF[0]); %107-02238580 PUTSEQNO(LBUFF[9],MKABS(INFO[LASTSEQROW,LASTSEQUENCE])); %107-02238582 WRITE(NEWTAPE,10,LBUFF[*]); %107-02238590 END; %107-02238600 IF INSERTMID=0 THEN ERR(613); %107-02238602 IF INSERTMID=0 THEN INSERTFID:=TIME(-1); %107-02238610 IF INSERTMID=0 THEN %107-02238620 BEGIN INSERTFID:=INSERTMID; INSERTMID:=0; END; %107-02238630 IF INSERTDEPTH > 1 THEN CLOSE(LF,RELEASE); %107-02238640 FILL LF WITH INSERTMID,INSERTFID; %107-02238650 READ(LF[0],10,LBUFF[*])[EEXIT]; % DO THE FOLLOWING SO THAT %107-02238652 INSERTMID:=LF.MFID; % IF THE OPERATOR IL-ED US %107-02238654 INSERTFID:=LF.FID; % WE WILL HAVE THE PROPER NAMES. 02238656 V:=-1; %107-02238658 IF INSERTINX > 0 THEN %107-02238660 BEGIN %107-02238670 DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] %107-02238680 UNTIL CMPD(INSERTINX,LBUFF[9]) { 1; %107-02238690 V:=V-1; %107-02238700 END; %107-02238702 INSERTINX:=V; %107-02238704 IF INSERTDEPTH = 1 THEN %107-02238710 BEGIN SAVECARD:=LASTUSED; LASTUSED:=7; MEDIUM:="L "& MEDIUM[24:12]; 02238720 END; %107-02238730 GO TO EXIT; %107-02238760 EEXIT: %107-02238770 IF((INSERTDEPTH:=INSERTDEPTH-1) > 0) THEN %107-02238780 BEGIN %107-02238790 CLOSE(LF,RELEASE); %107-02238800 FILL LF WITH INSERTMID,INSERTFID; %107-02238810 END; %107-02238820 EXIT: %107-02238830 Q:="1%0000"; %107-02238832 END; %107-02238840 REAL PROCEDURE CONVERT; 02248000 BEGIN REAL T; INTEGER N; 02249000 TL0~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; SKIP 1 SB)); DS:=1 LIT " "); DS:=2 LIT " ");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 LOCATION 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 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] ! D0 02312000 IF Q=ID THEN GO FOUND; 02313000 OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION. 02314000 FOUND: %103-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 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 IF BUILDLINE.[45:1] THEN %108-02331050 BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; %108-02331060 XMODE:=1; IF LASTUSED < 5 AND LASTUSED ! 3 THEN LASTUSED:=1; 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; FSAVE:=0; GO FPART; 02682000 ATSIGN: 02683000 % RESULT:0; SCANNER; 02684000 % IF COUNT>17 THEN GO ARGH; 02685000 % IF OCTIZE(ACCUM[1],COUNT-1,17-COUNT,C) THEN GO ARGH 02686000 % ELSE GO NUMBEREND; 02687000 NHI:=C:=1; NLO:=FSAVE:=0; GO EPART; 02688000 COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02689000 QUOTE: 02690000 COUNT := 0; T := IF STREAMTOG THEN 63 ELSE 8; %111-02691000 % 02692000 % 02692500 DO BEGIN 02693000 RESULT:=5; SCANNER; 02694000 IF COUNT=T THEN 02695000 IF EXAMIN(NCR) ! """ THEN GO ARGH; 02696000 END UNTIL EXAMIN(NCR) = """; 02697000 IF NOT STREAMTOG AND COUNT=8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 02697500 BEGIN Q := ACCUM[1]; FLAG(254); GO TO SCANAGAIN; END; %111-02697600 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 T.CLASS:=STRNGCON; 02702000 IF COUNT < 8 OR (COUNT = 8 AND NOT BOOLEAN %111-02703000 (ACCUM[1].[18:1])) THEN % FLAG BIT NOT SET, FULL WORD CONST. 02703050 MOVEIT: 02704000 MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT) 02705000 ELSE T.CLASS:=STRING; 02705100 T.INCR:=COUNT; GO COMPLETE; 02705200 % 02706000 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 LASTUSED:=(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3]).[33:15];02721000 IF (GT2 := T.[18:15]) ! 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500 BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD %122-02722000 GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500 DO %122-02723000 PUT(TEXT[(NEXTTEXT:=(GT1:=TAKE(DEFSTACKHEAD)),DYNAM-1) 02723500 ,LINKR,NEXTTEXT,LINKC],DEFSTACKHEAD) %122-02724000 % THIS RESTORES THE PREVIOUS ELBAT WORD FOR %122-02724500 % THIS PARAMETER IN CASE OF NESTED DEFINE. %122-02725000 UNTIL %122-02725500 GT2 = (DEFSTACKHEAD := GT1.LINK); %122-02726000 END; %122-02727000 GO SCANAGAIN; 02728000 DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02729000 IF GT1:=EXAMIN(NCR)="$" THEN GO DBLDOLLAR ELSE DOLLARCARD; 02730000 PERCENT: IF NCR ! FCR THEN READACARD; 02731000 IF LIBINDEX!0 THEN 02732000 IF RECOUNT=FINISHPT THEN 02733000 BEGIN 02734000 SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000 END; 02736000 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:=FSAVE:=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 IF NOT (ACCUM[0].CLASS=FILEID AND INFO[LASTINFO. % 1641 02761500 LINKR, LASTINFO.LINKC] = ACCUM[0])THEN % 1641 02761501 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 EXMAIN(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-HEX CHARACTER IN HEX STRING. 02775000 T.INCR := COUNT := (C|COUNT-1)DIV 6 + 1; % # OF CHARS. 02776100 T.CLASS:= STRNGCON; %111-02776200 MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); %111-02776300 IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. %111-02776400 IF STREAMTOG THEN %111-02776500 T.CLASS := STRING %111-02776600 ELSE %111-02776700 FLAG(254) %111-02776800 ELSE %111-02776900 C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000 MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); %111-02777050 GO TO COMPLETE; %111-02777100 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:=CONVERT+C|TEN[FSAVE:=COUNT-TCOUNT]; 02803000 END 02804000 END; 02805000 RESULT:=7; SCANNER; 02806000 IF EXAMIN(NCR)="@" THEN 02807000 BEGIN 02808000 RESULT:=0; SCANNER; 02809000 FPART: TCOUNT:=COUNT; 02810000 C:=C|1.0; 02811000 RESULT:=7; SCANNER; 02812000 IF T:=EXAMIN(NCR)>9 THEN 02813000 IF T="-" OR T = "+" THEN 02814000 BEGIN 02815000 RESULT:=0; SCANNER; 02816000 TCOUNT:=COUNT; 02817000 END 02818000 ELSE FLAG(47); 02819000 RESULT:=0; SCANNER; 02820000 IF RESULT ! 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000 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[ABS(GT3:=T-FSAVE)]; 02826000 IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1: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:=IF GT3<0 THEN C/T ELSE C|T; 02842000 END; 02843000 END 02844000 ELSE IF FSAVE ! 0 THEN C:=C/TEN[FSAVE]; 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 A CHECK IS MADE, USING SUPERSTACK. 02856000 TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR 02857000 COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO 02858000 COMPLETE, OTHERWISE 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: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!0 THEN 02865000 BEGIN 02866000 IF INFO[GT1:=T.LINKR,(GT2:=T.LINKC)+1]=Q THEN 02867000 BEGIN 02868000 T:=INFO[GT1,GT2]&T[35:35:13]; 02869000 GO COMPLETE 02870000 END 02871000 END; 02872000 IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN T:=DEFSTACKHEAD 02873000 ELSE T:=STACKHEAD[SCRAM]; 02874000 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 %101-02877010 T:= 0; GO TO COMPLETE END; %101-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 IF GT1 !1 AND NOT MACROID THEN % NOT RESERVED WORD %116-02882100 XREFIT(T,LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY %116-02882200 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 BOOLEAN(T,MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000 GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000 IF DEFINEINDEX = 24 THEN 02898000 BEGIN FLAG(139);GO ARGH END; 02899000 DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000 LASTUSED:=T.DYNAM; 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 DBLDOLLAR: 02907000 MAKCAST; GO SCANAGAIN; 02908000 COMPLETE: 02909000 ELBAT[NXTELBT]:=T; 02910000 IF NOT DEFINING THEN 02910100 IF T.CLASS = BEGINV THEN 02910200 BEGINSTACK[BSPOINT:=BSPOINT+1]:=CARDNUMBER ELSE 02910300 IF T.CLASS = ENDV THEN 02910400 BEGIN 02910500 IF LISTER THEN IF BEND THEN BEGINPRINT; 02910600 BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700 END; 02910800 STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000 IF NXTELBT:=NXTELBT+ ! > 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 INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE,NAME) %106-02927100 VALUE SIZE,NAME; REAL SIZE,NAME; ARRAY FROM [0,0]; %106-02927110 BEGIN %106-02927120 INTEGER NSEGS,I,J,K; %106-02927130 ARRAY A[0:14]; %106-02927140 SWITCH FORMAT FMT := %106-02927150 (/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), %106-02927160 (/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927170 (/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927180 (/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), %106-02927190 (/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927200 (/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), %106-02927210 (/,"SEGMENT ZERO",I*,/), %106-02927220 (/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); %106-02927230 STREAM PROCEDURE OCTALWORDS(N,W,S,D); VALUE N,W; %106-02927240 BEGIN %106-02927250 DI:=D; DS:=LIT" "; %106-02927260 SI:=LOC N; SI:=SI+6; %106-02927270 4(DS:=3 RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02927272 DI:=DI-4; DS:=3 FILL; %106-02927280 DI:=D; DI:=DI+5; DS:=4 LIT" "; %106-02927290 SI:=S; %106-02927300 W(2(8(DS:=3 RESET; %106-02927310 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); %106-02927320 ); %106-02927330 DS:=LIT" "); %106-02927340 DS:=2 LIT" "); %106-02927350 END OF OCTALWORDS; %106-02927360 %********** S T A R T ********** %106-02927370 NSEGS:=(SIZE+29) DIV 30; %106-02927380 IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN %106-02927390 DA:=CHUNK|T; %106-02927400 MOVEANDBLOCK:=DA; %106-02927410 IF CODEFILE THEN %106-02927420 IF NAME}0 THEN %106-02927430 WRITE(LINE,FMT[NAME],DA) %106-02927440 ELSE %106-02927450 WRITE(LINE,FMT[7],ABS(NAME),DA); %106-02927460 IF SIZE!0 THEN %106-02927470 BEGIN %106-02927480 FOR J:=0 STEP 30 WHILE J < SIZE DO %106-02927490 BEGIN %106-02927500 IF (K:=(128-(J MOD 128))) < 30 THEN %106-02927510 BEGIN %106-02927520 MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927530 MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); %106-02927540 END %106-02927550 ELSE %106-02927560 MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927570 IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION %106-02927580 BEGIN %106-02927590 K:=0; %106-02927600 MOVE(1,K,CODE(SIZE-J)); %106-02927610 IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD %106-02927612 MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); %106-02927620 END; %106-02927630 IF CODEFILE THEN %106-02927640 BEGIN %106-02927650 FOR K:=0 STEP 5 WHILE K{25 AND (J+K){SIZE DO %106-02927660 BEGIN %106-02927670 BLANKET(14,A); %106-02927680 OCTALWORDS(J+K,IF (J~K+5){SIZE THEN 5 ELSE %106-02927690 SIZE-J-K,CODE(K),A); %106-02927700 WRITE(LINE,15,A[*]); %106-02927710 END; %106-02927720 WRITE(LINE); %106-02927722 END; %106-02927730 WRITE(CODE[DA]); DA:=DA+1; %106-02927740 END; %106-02927750 END; %106-02927760 END OF MOVEANDBLOCK; %106-02927770 COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02928000 IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000 PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000 NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000 PROCEDURE NEXTENT; 02932000 BEGIN LABEL DEBLANK; 02933000 COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02934000 DEBLANK: 02935000 IF EXAMIN(NCR)=" "THEN 02936000 BEGIN 02937000 RESULT:=7; SCANNER; 02938000 END; 02939000 IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000 BEGIN 02941000 RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000 IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000 ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000 END 02945000 ELSE IF EXAMIN(NCR)="%" THEN 02946000 BEGIN 02947000 READACARD; COUNT:=ACCUM[1]:=0; GO DEBLANK; 02948000 END 02949000 ELSE BEGIN 02950000 RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02951000 Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02952000 END 02953000 END OF NEXTENT; 02954000 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="3OR000" 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 EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000 EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000 OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000 CODE CONSISTS OF A SERIES OF DUPS AND MULS, AS WITH 04038000 EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000 AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000 NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHE, 04041000 IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000 (APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000 OTHERWISE IT CALLS LN AND EXP; 04044000 PROCEDURE EMITUP; 04045000 BEGIN INTEGER BACKUP, CTR; 04046000 LABEL E; 04047000 IF NOT LINKTOG THEN GO TO E; 04048000 COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000 IF GET(L-1) = 537 THEN 04050000 COMMENT LAST OPERATOR IS CHS; 04051000 BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000 IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000 THEN BEGIN 04054000 COMMENT IT IS A LITERAL; 04055000 BACKUP ~ BACKUP+1; L ~ L-1; 04056000 IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000 COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000 CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000 WHILE GT4 DIV 2 ! 0 04060000 DO BEGIN 04061000 EMITO(DUP); 04062000 IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000 EMITO(MUL); 04064000 GT4 ~ GT4 DIV 2 END; 04065000 IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000 ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000 IF BACKUP = 2 04068000 THEN BEGIN 04069000 EMITL(1); 04070000 EMITO(XCH); 04071000 EMITO(128) END END 04072000 ELSE BEGIN 04073000 E: L ~ L+BACKUP; 04074000 EMITO(MKS); 04075000 EMITPAIR(GNAT(LOGI),LOD); 04076000 EMITPAIR(GNAT(EXPI),LOD); 04077000 EMITV(GNAT(XTOTHEI)); 04078000 STACKCT ~ 0; %A 04078500 EMITO(DEL) END END EMITUP; 04079000 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 DIALA ~ DIALB ~ 0; 04085000 WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000 END ADJUST; 04087000 COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000 NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000 BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000 (FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000 OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000 ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000 COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000 EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,04095000 AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000 EMITLNG; 04097000 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 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 IF BOOLEAN(BRANCH.[38:1]) THEN DIALA ~ DIALB ~ 0; 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( SFQ,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 49(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}4092 THEN ERR(200); 04145000 ELSE BEGIN 04146000 MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000 IF DEBUGTOG THEN 04148000 BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000 WRITELINE END; 04150000 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 DIALA ~ DIALB ~ 0; 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 BEGIN 04176000 NCII~NCII+1; 04177000 PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000 PUTNBUMP(TAKE(255-J)); LASTINFO~NEXTINFO-2; 04179000 GO TO ALLTHU; 04180000 END; 04181000 LINK~GET(L); 04182000 CREL ~ TRUE; 04183000 EMITV(D + 768); 04184000 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 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 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 END; 04224000 FINSIHED: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] SUBLEVEL+1 THEN 04611000 BEGIN 04612000 EMIT(0); 04613000 EMITPAIR(A,STD); 04614000 END; 04615000 EMITN(A); 04616000 END CHECKDISJOINT; 04617000 COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000 COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000 PROCEDURE STEPIT; ELCASS ~ TABLE(I~I+1); 05002000 INTEGER PROCEDURE STEPI; STEPI+ELCLASS~TABLE(I~I+1); 05003000 COMMENT TAKE FETCHS A WORD FROM INFO; 05004000 REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000 TAKE ~ INFO[INDEX,LINKR,INDEX,LINKC]; 05006000 COMMENT PUT PLACES A WORD INTO INFO; 05007000 PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000 INFO[INDEX,LINKR,INDEX,LINKC] ~ WORD; 05009000 COMMENT FLAG FLAGS ERROR MESSAGES. COUNTS THEM AND SUPRESS FUTURE 05010000 ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000 PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000 BEGIN 05013000 COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000 THE ERROR MESSAGE ON THE PRINTER; 05015000 STREAM PROCEDURE WRITERROR(RMT,ERRNUM,ACCUM,LINE,COUNT,LSTSEQ); 05016000 VALUE ERRNUM,COUNT; 05017000 BEGIN 05018000 DI:=LINE; 11(DS:=8 LIT " "); % BLANK LINE 05019000 SI ~LSTSEQ; SI ~ SI-8; DS ~WDS; 05020000 DS:=24 LIT " <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 05021000 SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000 DI~LINE; SI~RMT; SI~SI+7; 05024000 IF SC="1" THEN 05024100 BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200 7(IF SC>"0" THEN JUMP OUT; 05024300 SI~SI+1; TALLY~TALLY+1); 05024400 RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500 END ELSE DI~DI+7; 05024600 DS~14 LIT " ERROR NUMBER "; 05025000 SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000 DS ~ 4 LIT " -- "; 05027000 SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000 COMMENT PLACE ALPHA IN BUFFER; 05029000 DS ~ LIT "." 05030000 END WRITERROR; 05031000 IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000 BEGIN 05033000 SPECTOG := FALSE; 05034000 ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000 IF NOT(LISTER OR REMOTOG) THEN 05036000 BEGIN 05037000 EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); %114-05038000 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039000 IF NOHEADING THEN DATIME; WRITELINE; 05039500 END; 05041000 COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000 ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000 WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000 INFO[LASTSEQROW,LASTSEQUENCE]); 05045000 IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900 IF NOT NOHEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000 ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000 IF PUNCHTOG THEN 05048000 BEGIN 05049000 STREAM PROCEDURE PUNCH(FL,ST); 05050000 VALUE ST; 05051000 BEGIN 05052000 DI ~ FL; 05053000 SI ~ ST; 05054000 DS ~ 9 WDS 05055000 END PUNCH; 05056000 PUNCH(PNCH(0),FCR); 05057000 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000 WRITE(PNCH) 05059000 END 05060000 END END FLAG; 05101000 LABEL ENDOFITALL; 05101100 COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000 RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000 SEMICOLON, END, OR BEGIN; 05104000 PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000 BEGIN FLAG(ERRNUM); 05106000 I ~ I-1; 05107000 IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100 IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200 DO IF STEPI = BEGINV THEN STMT UNTIL 05108000 ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000 DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000 COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000 UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000 PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000 BEGIN 05114000 IF MODE } 2 THEN 05115000 IF GTI1 ~ ELBATWORD.LVL }FRSTLEVEL THEN 05116000 IF GTI1 < SUBLEVEL THEN 05117000 IF ELBATWORD.[9:2] ! 1 05118000 THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000 END CHECKER; 05120000 COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000 GIVEN THE LINK TO THE ELBAT WORD; 05122000 INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000 GIT ~ TAKE(L).INCR+L.LINK; 05124000 COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000 IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000 GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000 INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000 BEGIN 05129000 REAL A; 05130000 IF FNAT ~(A~TAKE(L)).ADDRESS=0 05131000 THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11].L) 05132000 END GNAT; 05133000 COMMENT PASSFILE COMPILES CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR05134000 POINTING AT THE I/O DESCRIPTOR (ON TOP), IT HANDLES 05135000 SUPERFILES AS WELL AS ORDINARY FILES; 05136000 PROCEDURE PASSFILE; 05137000 BEGIN INTEGER ADDRES; 05138000 CHECKER(ELBAT[I]); 05139000 ADRES ~ ELBAT[I].ADDRESS; 05140000 IF ELCLASS = SUPERFILEID 05141000 THEN BEGIN 05142000 BANA; EMITN(ADDRESS); EMITO(LOD) END 05143000 ELSE BEGIN 05144000 IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000 STEPIT; 05146000 EMITN(DDRES) END END PASSFILE; 05147000 PROCEDURE PASSMONFILE(ADDRESS); 05148000 VALUE ADDRESS ; 05149000 REAL ADDRESS ; 05150000 BEGIN COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 05151000 FILE TO PRINTI; 05152000 IF ADDRESS < 768 OR ADDRESS > 1023 05153000 THEN EMITL(5); 05154000 EMITN(ADDRESS); 05155000 END PASSMONFILE; 05156000 PROCEDURE PASFILE; 05157000 BEGIN COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 05158000 MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 05159000 DEFINE ELBATWORD = RR1#; COMMENT ELBATWORD CONTAINS THE 05160000 ELBATWORD FOR THE FILE BEING 05161000 OPERATED ON; 05162000 DEFINE LTEMP = RR2#; COMMENT LTEMP IS USED TO HOLD THE L 05163000 REGISTER SETTING FOR THE SAVE OR 05164000 RELEASE LITERAL THAT GETS PASSED TO 05165000 KEN MYERS; 05166000 EMITO(MKS); L~(LTEMP~L)+1; EMITL(0); 05167000 EMITL(2); CHECKER(ELBATWORD~ELBAT[I]); 05168000 IF RRB1~(RRB2~ ELCLASS = SUPERFILEID)OR 05169000 BOOLEAN(ELBATWORD.FORMAL) 05170000 THEN EMITO(LNG); 05171000 IF RRB2 05172000 THEN BANA 05173000 ELSE STEPIT; 05174000 EMITN(ELBATWORD.ADDRESS); 05175000 IF RRB2 05176000 THEN EMITO(LOD); 05177000 IF RRB1 05178000 THEN EMITO(INX); 05179000 EMITL(4); EMITV(14); 05180000 END PASFILE; 05181000 COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE05182000 PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000 PROCEDURE CHECKPRESENCE; 05184000 BEGIN 05185000 EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000 END CHECKPRESENCE; 05187000 COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 05187500 TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510 PROCEDURE PASSLIST; 05187520 BEGIN 05187530 INTEGER LISTADDRESS; 05187540 COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 05187550 CHECKER(ELBAT[I]); 05187560 LISTADDRESS:=ELBAT[I].ADDRESS; 05187570 IF FLCLASS = SUPERLISTID THEN % SUBSCRIPTED LIST ID. 05187580 BEGIN 05187590 BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600 END 05187610 ELSE BEGIN EMITL(LISTADDRESS); STEPIT END; 05187620 END OF PASSLIST; 05187630 REAL PROCEDURE TAKEFRST; 05188000 TAKEFRST ~ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000 COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000 DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000 STACK; 05198000 PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000 BEGIN 05200000 EMITPAIR(ADDRESS,LOD); 05201000 EMITN(512); 05202000 EMITD(33,18,15) END STUFFF; 05203000 COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000 PRESENT CODE; 05205000 BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000 VALUE ELBATWORD; REAL ELBATWORD; 05207000 BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000 NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000 LOCAL ~ TRUE END LOCAL; 05210000 COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000 PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000 STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000 PROCEDURE PASSFORMAT; 05214000 BEGIN INTEGER ADRES; 05215000 CHECKER(ELBAT[I]); 05216000 ADRES ~ ELBAT[I].ADDRESS; 05217000 IF BOOLEAN(ELBAT[I].FORMAL) 05218000 THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END 05219000 ELSE BEGIN 05220000 IF TABLE(I) = SUPERFRMTID 05221000 THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000 END; 05223000 IF TABLE(I) = SUPERFRMTID 05224000 THEN BEGIN BANA; I ~ I-1; 05225000 EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000 EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000 COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000 WORDS - IT COMPLEMENTS THEIR STATE; 05229000 PROCEDURE STREAMWORDS; 05230000 BEGIN GT1 ~ 0; 05231000 DO BEGIN 05232000 INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000 STACKHEAD[GT2] ~ T.LINK; 05234000 GT1 ~ GT1+2; 05235000 END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000 STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000 VALUE PRT,TYP,RELAD,SGNO; 05237500 BEGIN LOCAL COUNT; 05238000 DI:=LIN; DS:=6 LIT" PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 05238500 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05239000 BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05239500 COUNT:=TALLY; DS:=COUNT CHR; 05240000 DS:= 31 LIT") = SEGMENT DESCRIPTOR, TYPE = "; 05240500 SI:=LOC TYP; SI:=SI+7; DS:=CHR; % TYPE. 05241000 DS:=21 LIT", RELATIVE ADDRESS = "; 05241500 SI:=LOC RELAD; SI:=SI+4; DS:=4 CHR; % REL. ADDR. 05242000 DS:=19 LIT", SEGMENT NUMBER = "; 05242500 SI:=LOC SGNO; SI:=SI+4; DS:=4 CHR; DS:=LIT"."; 05243000 END DEBUGDESC; 05243500 REAL PROCEDURE PROGDESCBLDR(TYPE,RELAD,SPAC); 05245000 COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE, IT IS 05246000 CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 05247000 BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 05248000 SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 05249000 THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 05250000 TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE05251000 AND ARGUMENT BIT FOR THE PROGRAM 05252000 DESCRIPTOR TO BE BUILT. 05253000 RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 05254000 SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 05255000 IF!0 THEN SPACE IS ALREADY GOTTON 05256000 ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000 PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000 VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000 BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000 PDPRT[PDINX,[37:5],PDINX.[42:6]]~0&RELAD[18:36:10] 05261000 &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000 IF DEBUGTOG THEN 05263000 BEGIN 05263500 BLANKET(14,LIN); 05264000 DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO));05264500 IF NOHEADING THEN DATIME; WRITELINE; 05265000 END; 05265100 PDINX~PDINX+1;PROGDESCBLDR~SPAC END PROGDESCBLDR; 05266000 COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000 IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000 LITERALS INVOLVED; 05269000 BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000 INTEGER FIRST,SECOND; 05271000 BEGIN 05272000 LABEL EXIT; 05273000 IF STEPI = FIELDID THEN % GET INFO FROM INFO %117-05273100 BEGIN %117-05273200 FIRST := ELBAT[I].SBITF; %117-05273300 SECOND := ELBAT[I].NBITF; %117-05273400 GO TO EXIT; %117-05273500 END %117-05273600 ELSE %117-05273700 IF ELCLASS = LFTBRKET THEN %117-05273800 IF STEPI = FIELDID THEN %117-05273900 BEGIN %117-05274000 FIRST := ELBAT[I].SBITF; %117-05274100 SECOND := ELBAT[I].NBITF; %117-05274200 IF STEPI = RTBRKET THEN %117-05274300 GO TO EXIT; %117-05274400 END %117-05274500 ELSE %117-05274600 IF ELCLASS = LITNO THEN %117-05275000 IF STEPI = COLON THEN 05276000 IF STEPI = LITNO THEN 05277000 IF STEPI = RTBRKET THEN 05278000 COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000 IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000 (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000 IF FIRST ~ SECOND {48 THEN 05282000 COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000 GO TO EXIT; 05284000 ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000 DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000 BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000 VALUE ELBATCLASS,ERRORNUMBER; 05288000 REAL ELBATCLASS,ERRORNUMBER; 05289000 BEGIN COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 05290000 ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 05291000 CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET05292000 FALSE; 05293000 IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000 THEN ERR(ERRORNUMBER); 05295000 END; 05296000 BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000 VALUE LOWER,UPPER; 05298000 REAL LOWER,UPPER; 05299000 COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000 IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000 UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000 CLASS MUST BE IN ELCLASS; 05303000 RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000 COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 05305000 EMITTED; 05306000 INTEGER PROCEDURE GET(L); VALUE L; REAL; 05307000 BEGIN 05308000 INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000 BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000 SI ~ W; SI ~ SI+S; SI + SI+S; DS ~ 2 CHR END; 05311000 GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000 COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000 SCRIPTOR TO THE TOP OF THE STACK; 05314000 PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000 BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000 REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000 VALUE SIZE ; 05318000 BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000 FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000 CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000 ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000 DI~LOC GETALPHA; DS~8 LIT"0 "; D~DI-7; 05323000 SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000 END GETALPHA; 05325000 PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010 BEGIN 05325020 LABEL EXIT; 05325030 STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040 VALUE PORS,CELL,N; 05325050 BEGIN 05325060 LOCAL COUNT; 05325070 LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080 SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090 IF SC="P" THEN 05325100 BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110 ELSE BEGIN 05325120 DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130 IF SC}"6"THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140 COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150 DS:=11 RESET; DI:=COUNT; 05325160 END; 05325170 SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190 BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200 COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210 DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220 CI:=CI+N; 05325230 GO M0; 05325240 GO M1; 05325250 GO M2; 05325260 GO M3; 05325270 GO M4; 05325280 GO M5; 05325290 GO M6; 05325300 GO M7; 05325310 M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320 DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330 GO XIT; 05325340 M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350 M2: DI:=CELL; 05325360 DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370 M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380 M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390 M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400 M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410 M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420 XIT: 05325430 END FILLIT; 05325440 BLANKET(14,LIN); 05325450 IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460 ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470 ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480 IF NOHEADING THEN DATIME; WRITELINE; 05325490 END WRITEPRT; 05325500 COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 05326000 THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 05327000 PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 05328000 PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 05329000 MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 05330000 INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000 BOOLEAN PERMANENT; INTEGER L; 05333000 BEGIN LABEL L1,L2,EXIT; 05334000 BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000 DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000 BOOLEAN M,Q; 05343000 INTEGER ROW,COL,GS; 05344000 IF PERMANENT 05345000 THEN BEGIN 05346000 IF PRTIMAX>1022 THEN FLAG(148);% 05347000 SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000 OR SPRT[GS]; 05349000 PRTIMAX ~ (GS ~ PRTIMAX)+1 END 05350000 ELSE IF MODE = 0 THEN BEGIN 05351000 Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000 M ~ MASK(COL ~ PRTI.[43:4]-35); 05353000 COL ~ COL+35; 05354000 L1: IF REAL(M AND Q) ! 0 05355000 THEN BEGIN 05356000 IF REAL(BOOLEAN(GS~4294967296-REAL(M)) AND Q) =GS 05357000 THEN BEGIN 05358000 COL ~ 0; M ~ TRUE; 05359000 IF ROW ~ ROW+1 > 31 05360000 THEN BEGIN FLAG(148); GS ~ PRTIMAX; 05361000 GO TO L2 END; 05362000 Q ~ SPRT[ROW]; 05363000 GO TO L1 END; 05364000 COL ~ COL+1; M ~ BOOLEAN(REAL(M)+REAL(M)); 05365000 GO TO L1 END; 05366000 PRTI ~ (GS ~ 32|ROW+COL)+1; 05367000 IF PRTI > PRTIMAX THEN PRTIMAX ~ PRTI END 05368000 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 > 1023 THEN GS ~ GS-1024; 05376000 IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100 END GETSPACE; 05378000 COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 05379000 BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000 ARRAYCHECK~AAW.CLASSINTARRAYID 05381000 OR AAW.INCR !1; 05382000 COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000 BOOLEAN PROCEDURE COMMACHECK; 05384000 BEGIN IF NOT(COMMACHECK~(STEPI=COMMA)) THEN ERR(350); 05385000 STEPIT 05386000 END COMMACHECK; 05387000 COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000 BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000 IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000 IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK~TRUE ELSE 05390100 IF TAKE(GT1~GIT(ELBW)!1 THEN ERR(537) ELSE 05391000 IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000 HVCHECK~TRUE; 05393000 COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000 BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000 IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000 IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100 IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000 IF TAKE(GT1~1).CLASS!BOOID THEN ERR(353) ELSE 05398000 IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000 OUTPROCHECK~TRUE; 05400000 COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000 BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000 IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000 IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100 IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000 IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000 IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000 EQLESCHECK~TRUE; 05407000 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 = ADD THEN PRIMARY 06016000 ELSE BEGIN 06017000 PRIMARY; 06018000 WHILE ELCLASS = FACTOP DO %WF 06019000 BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000 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 ARITHOCMP 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}ADOP AND ELCLASS{FACTOP 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 IF OPCLASS = FACTOP THEN EMITUP 06050000 ELSE BEGIN 06051000 WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000 COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000 STACKCT ~ 1; %A06053500 EMIT(OPERATOR) END 06054000 END UNTIL OPCLASS ! ELCLASS END ARITHCOMP; 06055000 COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 06056000 PROCEDURE IMPFUN; 06057000 BEGIN 06058000 REAL T1,T2,T3 ; 06059000 BOOLEAN B ; 06059050 DEFINE ERRX(ERRX1)=BEGIN T1~ERRX1; GO ERROR END #; 06059100 LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000 MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100 LABEL ERROR,L1,L2,L3 ; 06060110 SWITCH S ~ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000 MAXANDMIN, MAXANDMIN, DELAY;% 06061100 DEFINE MAXV = 6#;% 06061200 IF T2~(T1~ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000 IF T2!25 THEN EMITO(MKS) ; 06062110 IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120 IF T2<24 THEN 06062125 BEGIN 06062130 L3: IF TABLE(I+1)=COMMA THEN 06062135 IF ELCLASS>BOOID AND ELCLASSBOOPROCID THEN 06062370 IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)06062380 ELSE BEGIN EMITL(514); STEPIT END 06062385 ELSE IF ELCLASSBOOARRAYID 06062390 THEN VARIABLE(FL) 06062400 ELSE ERRX(185) ; 06062420 IF ELCLASS!RTPAREN THEN ERRX(104); STEPIT ; 06062430 EMITO(IF B THEN ISD ELSE STD); EMITV(17); GO EXIT ;06062435 END ; 06062440 IF T2<23 THEN 06062470 BEGIN % DMOD, DARCTAN2 06062480 B~TRUE; GO L3 ; 06062500 END ; 06062535 IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540 EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560 ERROR: ERR(T1); GO EXIT ; 06062565 OTHERS: EMITO(MKS) ; 06064000 PANA; 06065000 EMITV(GNAT(T1)); GO TO EXIT; 06066000 ABS: PANA; EMITO(SSP); GO TO EXIT; 06067000 SIGN: PANA; 06068000 EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000 EMITD(1,1,1); GO TO EXIT; 06070000 ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000 EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000 MAXANDMIN:% 06072010 IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030 BEGIN STEPIT; AEXP;% 06072040 WHILE ELCLASS=COMMA DO% 06072050 BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060 EMITPAIR(JUNK, SND);% 06072070 IF T2=MAXV THEN EMITO(LSS) ELSE EMITO(GTR) ; 06072080 EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090 END;% 06072100 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110 END;% 06072120 GO TO EXIT;% 06072130 DELAY: IF STEPI!LEFTPAREN THEN% 06072200 BEGIN ERR(105); GO TO EXIT END;% 06072210 STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220 BEGIN ERR(165); GO TO EXIT END;% 06072230 STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240 BEGIN ERR(165); GO TO EXIT END;% 06072250 STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260 BEGIN ERR(104); GO TO EXIT END ELSE STEPIT;% 06072270 EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280 GO TO EXIT;% 06072290 TIME: PANA; EMITL(1); EMITO(COM); 06073000 GO TO EXIT; 06073100 STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200 IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250 BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300 EMITPAIR(32, COM); T1~3; 06073350 END ELSE BEGIN EMIT(4); EMIT(0); T1~0; 06073400 IF ELCLASS}BOOARRAYID AND ELCLASS{INTARRAYID THEN 06073450 BEGIN T1~FI; VARIABLE(T1); END ELSE AEXP; 06073500 IF T1=FI THEN 06073550 BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1~3 06073600 END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650 BEGIN EMIT(0); EMITPAIR(32, COM); T1~3 END 06073700 ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750 EMITO(XCH); EMITO(DEL); 06073800 IF ELCLASS!COMMA THEN 06073810 BEGIN ERR(129); GO TO EXIT END; 06073820 STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830 END; END; END; 06073840 GTI1~0; 06073845 DO EMITO(DEL) UNTIL GTI1~GTI1-1=T1;% 06073850 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860 GO TO EXIT; 06073870 EXIT: END IMPFUN; 06074000 COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000 OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000 DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000 CASES; 06078000 PROCEDURE PRIMARY; 06079000 BEGIN 06080000 LABEL 06081000 L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000 L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000 L30, L31, L32, L33, L34, L35; 06084000 SWITCH S ~ 06085000 L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000 L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000 L30, L31, L32, L33, L34, L35; 06088000 COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000 LABEL EXIT,RP,LDOT,LAMPER; 06090000 GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000 IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005 BEGIN 06092010 IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015 GO TO LAMPER ; 06092020 END ; 06092025 L12: L13: L17: L21: L25: L29: L30: 06093000 COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000 IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950 ERR(103); GO TO EXIT; 06095000 L11: 06096000 COMMENT INTRINSIC FUNCTIONS; 06097000 IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A06098000 L14: L15: L16: 06099000 COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100 STRMPROCSTMT; GO TO LDOT 06101000 L18: L19: L20: 06102000 COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100 PROCSTMT(FALSE); GO TO LDOT; 06104000 L22: L23: L24: L26: L27: L28: 06105000 COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100 VARIABLE(FP); GO TO LAMPER; 06107000 L32: 06108000 COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000 EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000 L31: L33: 06111000 COMMENT STRINGS AND NONLITERALS; 06112000 EMITNUM(C); STEPIT; GO TO LAMPER; 06113000 L35: 06114000 COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000 EXPRESSION - OTHERWISE AN ERROR; 06116000 IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000 IF STEPI ! LEFTPAREN 06118000 THEN BEGIN ERR(105); GO TO EXIT END; 06119000 STEPIT; BEXP; GO TO RP END; 06120000 IF ELBAT[I].ADDRESS = INTV THEN 06120100 BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200 ERR(106); GO TO EXIT; 06121000 L34: 06122000 COMMENT (; 06123000 STEPIT; AEXP; 06124000 STACKCT ~ STACKCT-1; %A 06124500 RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000 STEPIT; 06126000 LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000 LAMPER: STACKCT ~ STACKCT+1; %A 06128000 WHILE ELCLASS = AMPERSAND %A 06128500 DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000 COMMENT THIS CODE HANDLES CANCATENATES; 06130000 EXIT: END PRIMARY; 06131000 COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000 PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000 COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000 ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000 BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000 DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000 OR DESIGNATIONAL EXPRESSION; 06138000 INTEGER PROCEDURE EXPRSS; 06139000 BEGIN 06140000 IF ELCLASS = IFV 06141000 THEN BEGIN 06142000 IF EXPRSS ~ IFEXP = ATYPE 06143000 THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000 ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000 END EXPRSS; 06146000 COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000 EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000 AS EXPRSS REPORTS; 06149000 INTEGER PROCEDURE BOOSEC; 06150000 BEGIN BOOLEAN N; 06151000 IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000 GT4 ~ BOOSEC ~ BOOPRIM; 06153000 IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000 COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000 RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000 IF GT4 ! BTYPE THEN ERR(109) 06157000 COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000 LOGICALLY NEGATED; 06159000 END END BOOSEC; 06160000 COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000 THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000 ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000 PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000 A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000 COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000 LYSIS USING RECURSION; 06167000 PROCEDURE SIMPBOO; 06168000 BEGIN 06169000 WHILE ELCLASS = AMPERSAND 06170000 DO BEGIN 06171000 STEPIT; 06172000 IF BOOPRIM ! BTYPE THEN ERR(109); 06173000 PARSE END; 06174000 WHILE ELCLASS }EQVOP AND ELCLASS {ANDOP DO BOOCOMP 06175000 END BOOCOMP; 06176000 COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000 IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000 OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000 SION; 06180000 PROCEDURE BOOCOMP; 06181000 BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000 DO BEGIN 06183000 OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000 COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000 ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000 OF THE ELBAT WORD; 06187000 OPCLASS ~ ELCLASS; 06188000 STEPIT; 06189000 IF BOOSEC ! BTYPE 06190000 THEN BEGIN ERR(109); GO TO EXIT END; 06191000 WHILE OPCLASS < ELCLASS 06192000 DO IF ELCLASS {ANDOP THEN BOOCOMP 06193000 ELSE BEGIN ERR(110); GO TO EXIT END; 06194000 COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000 STACKCT ~ 1; %A 06195500 IF OPCLASS = IMPOP 06196000 THEN BEGIN 06197000 COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000 ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000 THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000 EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000 FUTURE. (SEE CODE FOR EMITLNG); 06202000 EMITLNG; 06203000 EMITO(LND); 06204000 EMITO(LNG); 06205000 EMITO(0); 06206000 L ~ L-1 END 06207000 ELSE EMIT(OPERATOR) 06208000 END UNTIL OPCLASS ! ELCLASS; 06209000 EXIT: END BOOCOMP; 06210000 COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000 DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000 INTEGER PROCEDURE BOOPRIM; 06213000 BEGIN INTEGER TYPE; 06214000 LABEL L9, 06215000 L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000 L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000 L30, L31, L32, L33, L34, L35; 06218000 SWITCH S ~ L9, 06219000 L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000 L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000 L30, L31, L32, L33, L34, L35; 06222000 COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000 LABEL EXIT,LE,D,TD,T; 06224000 LABEL FAH ; 06224500 GO TO S[ELCLASS-SUPERFILEID]; 06225000 IF ELCLASS = ADOP THEN GO TO L11; 06226000 IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500 BEGIN 06227510 BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520 GO FAH ; 06227530 END ; 06227540 LE: L10: L12: 06228000 COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000 EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000 ERR(111); GO TO EXIT; 06231000 L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000 THEN BEGIN PANA; GO TO TD END; 06233000 IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000 L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000 L31: L32: L33: 06236000 COMMENT ARITHMETIC TYPE STUFF; 06237000 AEXP; 06238000 D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000 RELATION; 06240000 BOOPRIM ~ BTYPE; GO TO EXIT; 06241000 L13: 06242000 COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100 STRMPROCSTMT; GO TO TD; 06244000 L17: 06245000 COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100 PROCSTMT(FALSE); GO TO TD; 06247000 L21: L25: 06248000 COMMENT BOOLEAN VARIABLES; 06249000 IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100 VARIABLE(FP); GO TO T; 06250000 L9: L29: 06251000 COMMENT LABELS AND SWITCHES; 06252000 DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000 L30: 06254000 COMMENT TRUE OR FALSE; 06255000 EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000 L34: 06257000 COMMENT (; 06258000 STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000 COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000 STACKCT ~ STACKCT-1; %A 06260500 IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000 STEPIT; 06262000 FAH: 06262500 IF TYPE = DTYPE THEN GO TO EXIT; 06263000 COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000 IF TYPE = BTYPE THEN BEGIN 06265000 TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000 T: STACKCT ~ STACKCT+1; %A 06267000 WHILE ELCLASS = AMPERSAND DO %A 06267500 COMMENT HANDLES CONCATENATE; 06268000 BEGIN 06269000 STEPIT; 06270000 IF BOOPRIM ! BTYPE 06271000 THEN BEGIN ERR(109); GO TO EXIT END; 06272000 PARSE END; 06273000 BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000 COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000 EXPRESSION; 06276000 DOT; SIMPARITH; GO TO D; 06277000 EXIT: END BOOPRIM; 06278000 COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000 EXPRESSION HAS ALREADY BEEN COMPILED; 06280000 PROCEDURE RELATION; 06281000 BEGIN 06282000 INTEGER OPERATOR; 06282200 REAL A; 06282400 BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600 DEFINE FORMALNAME = [9:2]=2#; 06282800 PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S: REAL A; 06283000 BEGIN 06283200 IF C THEN EMITNUM(A) 06283400 ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600 IF S THEN EMITO(CHS); 06283800 END PLUG; 06284000 DO BEGIN 06284200 OPERATOR:=1&ELBAT[I][36:17:10]; 06284400 COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600 EMITTED LATER (AFTER PROCESSING SECOND HALF). 06284800 THE HIGH-ORDER BITS OF THE BINARY OPERATOR 06285000 ARE TAKEN FROM THE [17:10] FIELD OF THE 06285200 ELBAT WORD FRO THE RELATIONAL SYMBOL; 06285400 IF MANY THEN 06285600 IF SIMPLE THEN PLUG(CONSTANA,A,SIGNA) ELSE EMITV(JUNK); 06285800 SIGNA:=FALSE; 06286000 IF STEPI=ADOP THEN SIGNA:=ELBAT[I].ADDRESS=SUB; 06286200 IF SIGN:=ELCLASS=ADOP THEN STEPIT; 06286400 CONSTANA:=ELCLASS}NONLITNO AND ELCLASS{STRNGCON; 06286600 A:=REAL(ELCLASS}REALID AND ELCLASS{INTID 06286800 AND NOT ELBAT[I].FORMALNAME); 06287000 SIMPLE:=(CONSTANA OR BOOLEAN(A)) AND STEPI=RELOP; 06287200 IF SIMPLE THEN 06287400 BEGIN 06287600 IF CONSTANA THEN A:=C ELSE A:=ELBAT[I-1]; 06287800 PLUG(CONSTANA,A,SIGNA) 06288000 END 06288200 ELSE BEGIN 06288400 I:=I-REAL(SIGN)-2; STEPIT; AEXP; 06288600 IF ELCLASS=RELOP THEN EMITPAIR(JUNK,SND); 06288800 END; 06289000 STACKCT:=1; EMIT(OPERATOR); 06289200 IF MANY THEN EMITO(LND); 06289400 ELSE BEGIN EMIT(0); L:=L-1 END; 06289600 MANY:=TRUE; 06289800 END UNTIL ELCASS!RELOP 06290000 END RELATION; 06290200 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; %A 06296500 THENBRANCH ~ BUMPL; 06297000 COMMENT SAVE L FOR LATER FIXUP; 06298000 IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000 STACKCT ~ 0; %A 06299500 ELSEBRANCH ~ BUMPL; 06300000 EMITB(BFC,THEBRANCH,L); 06301000 IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000 STEPIT; 06303000 IF TYPE = ATYPE THEN AEXP ELSE 06304000 IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000 STACKCT ~ 1; %A 06305500 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 PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000 BEGIN INTEGER FIRST,SECOND,THIRD; 06312500 BOOLEAN P1,P2,P3; 06313000 LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500 IF ELCLASS = FIELDID THEN %117 06313550 BEGIN %117 06313600 FIRST := ELBAT[I].SBITF; %117 06313650 SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06313700 GO TO SKIP1; %117 06313750 END %117 06313800 ELSE %117 06313850 IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000 IF STEPI = FIELDID THEN %117 06314050 BEGIN %117 06314100 FIRST := ELBAT[I].SBITF; %117 06314150 SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06314200 IF STEPI ! RTBRKET THEN %117 06314250 BEGIN %117 06314300 ERR(94); %117 06314350 GO TO EXIT; %117 06314400 END; %117 06314450 GO TO SKIP1; %117 06314500 END %117 06314550 ELSE %117 06314600 IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL %117 06314650 GO TO L1; %117 06314700 FIRST ~ C; 06315000 IF TABLE(I+1) = COLON THEN 06315500 BEGIN 06316000 STEPIT; 06316500 IF FIRST{0 THEN FLAG(92); 06317000 END ELSE 06317500 BEGIN 06318000 L1: EMITO(MKS); 06318500 AEXP; 06319000 P1 ~ TRUE; 06319500 IF ELCLASS ! COLON THEN BEGIN ERR(91); GO TO EXIT END; 06320000 END; 06320500 IF STEPI ! LITNO THEN GO TO L2; 06321000 06321100 SECOND ~ C ; 06321500 IF GT1 ~ TABLE(I+1) = COLON THEN 06322000 BEGIN 06322500 STEPIT; 06323000 IF SECOND{0 THEN FLAG(092); 06323500 END ELSE 06324000 BEGIN 06324500 IF GT1 = RTBRKET THEN 06325000 BEGIN 06325500 STEPIT; 06326000 SECOND ~ 48 - (THIRD ~ SECOND); 06326500 GO TO SKIP2; 06327000 END; 06327500 L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000 AEXP; 06328500 P1 ~ P2 ~ TRUE; 06329000 IF ELCLASS = COLON THEN 06329100 06329200 06329300 ELSE 06329350 IF ELCLASS = RTBRKET THEN 06329400 BEGIN 06329450 EMITO(DUP); 06329500 EMITL(48) ;EMITO(SUB); 06329550 EMITO(CHS);EMITO(XCH); 06329600 P3 ~ TRUE; 06329700 GO TO SKIP1; 06329800 END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900 END; 06330000 IF STEPI ! LITNO THEN GO L3 ; 06330500 THIRD ~ C; 06330600 IF TABLE(I+1) = RTBRKET THEN 06330700 BEGIN 06330800 STEPIT; 06331000 SKIP2: IF THIRD{0 OR THIRD > 47 THEN FLAG(95); 06331100 END ELSE 06331200 BEGIN 06331300 L3: IF NOT P2 THEN 06331500 BEGIN 06331600 IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700 EMITL(SECOND); 06331800 END; 06332000 AEXP; 06332100 P1~ P2~P3 ~TRUE; 06332200 IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300 END; 06332400 SKIP1: IF P1 THEN 06332500 BEGIN 06333000 IF NOT P2 THEN EMITL(SECOND); 06333500 IF NOT P3 THEN 06334000 BEGIN 06334100 EMITL(THIRD);EMITL(1); 06334200 EMITV(GNAT(DIALER)); 06334500 EMIT(TRB & THIRD[36:42:6]); 06334600 END ELSE 06334700 BEGIN 06335000 EMITL(0); 06335100 EMITV(GNAT(DIALER)); 06335200 EMITO(DEL); 06335500 END; 06335700 END ELSE 06336000 BEGIN 06336100 IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200 EMITD(SECOND,FIRST,THIRD); 06336300 END; 06336400 STEPIT; 06336500 EXIT: STACKCT ~ 1; 06336600 END PARSE; 06336700 COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000 THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100 PROCEDURE DOTIT; 06338000 BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000 IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000 %A 06342000 EMITI(0,FIRST,SECOND); %A 06343000 %A 06344000 STEPIT; 06345000 EXIT: END DOTIT; 06346000 COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000 PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000 THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000 SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000 IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000 IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000 BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000 THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000 IS ALSO STORED IN F+1; 06355000 PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000 BEGIN INTEGER TLEVEL; 06357000 EMITO(MKS); 06358000 IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000 JUMPCTR ~ TLEVEL; 06360000 COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000 INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000 BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000 JUMPING; 06364000 IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000 THEN BEGIN 06366000 COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000 EMIT(0); 06368000 EMIT(TLEVEL); END 06369000 ELSE BEGIN 06370000 EMITN(512); 06371000 EMITV(513); COMENT PICK UP BLOCKCTR AT ENTRY 06372000 FROM F+1; 06373000 IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000 THEN BEGIN 06375000 EMITL(TLEVEL); 06376000 EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000 AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000 END END; 06379000 EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000 END GENGO; 06381000 COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000 IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000 THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000 STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000 SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000 COMMUNICATE WILL BE DONE; 06387000 PROCEDURE DEXP; 06388000 BEGIN 06389000 LABEL EXIT; 06390000 BOOLEAN S,F; 06391000 REAL ELBW; 06392000 IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000 THEN BEGIN 06394000 CHECKER(ELBW ~ ELBAT[I]); 06395000 SCATTERELBAT; 06396000 IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000 IF FAULTOG THEN 06397100 IF S OR F THEN FAULTLEVEL~1 ELSE 06397200 IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300 IF S THEN BEGIN 06398000 BANA; EMITPAIR(JUNK,ISD); 06399000 EMITV(GNAT(ELBW)); 06400000 IF F THEN GO TO EXIT; END 06401000 ELSE BEGIN 06402000 STEPIT; 06403000 IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000 EMITL(GNAT(ELBW)) END; 06405000 GENGO(ELBW); 06406000 END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000 EXIT: END DEXP; 06408000 PROCEDURE IFCLAUSE; 06409000 BEGIN STEPIT; STACKCT ~ 0; BEXP; %A 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 PROCEDURE MAKEALABEL; 06500000 BEGIN LABEL EXIT; REAL I; 06501000 STREAMTOG~FALSE; 06502000 EMITO(MKS); PASSFILE; 06503000 IF ELCLASS!WITHV THEN 06504000 BEGIN ERR(301); GO TO EXIT END; 06505000 FOR I~1 STEP 1 UNTIL 6 DO 06506000 BEGIN IF STEPI=FACTOP THEN 06507000 BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000 ELSE AEXP; 06509000 IF ELCLASS!COMMA THEN GO TO EXIT; 06510000 END; 06511000 EXIT: FOR I:=I STEP 1 UNTIL 5 DO 06512000 BEGIN EMIT(4);EMITO(CHS) END; 06512100 EMITL(11); 06512200 EMITV(5); 06513000 END; 06514000 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 STEPTIT; 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{END 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); %104-07025000 FCR:= (LCR:=MKABS(CBUFF[9]))-9; %104-07025010 IF LISTER THEN PRINTCARD; %104-07025020 FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; %104-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 COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000 PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000 ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000 NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000 CONCERNING THE PARAMETERS: 07038000 FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000 OR NOT. 07040000 SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000 PROCEDURE OR NOT. 07042000 INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000 INFORMATION; 07044000 PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000 VALUE FBIT,SBIT,INDEX; 07046000 BOOLEAN FBIT,SBIT; 07047000 INTEGER INDEX; 07048000 BEGIN 07049000 INTEGER PCTR,ACLASS,SCLASS; 07050000 COMMENT 07051000 PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000 COMPILED. 07053000 ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000 SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 07055000 THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000 TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000 SIMILAR MEANINGS; 07058000 REAL WHOLE; 07059000 COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000 PARAMETERS; 07061000 BOOLEAN VBIT; 07062000 COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000 BE CALLED BY VALUE OR BY NAME; 07064000 LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000 LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000 CERR,FGEN; 07067000 LABEL 07068000 L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000 L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000 L31,L32,L33; 07071000 SWITCH S ~ 07072000 L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000 L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000 L31,L32,L33; 07075000 REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000 TO REDUCING TOTAL NUMBER; 07077000 PCTR ~ 1; 07078000 ANOTHER: ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 07079000 STACKCT ~ 0; %A 07079500 COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000 IF FBIT THEN BEGIN VBIT ~ FALSE; SCLASS ~ LOCLID END 07081000 COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000 IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000 METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK; 07084000 ELSE BEGIN 07085000 VBIT ~ BOOLEAN(GT1~ TAKE(INDEX+PCTR)).V0; 07086000 IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000 SCLASS } BOOSTRPROCID 07088000 THEN IF GT1 ~ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000 THEN SCLASS ~ SCLASS-GT1+1 07090000 COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-07091000 AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000 SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000 END; 07094000 IF T1 ~ TABLE(I+1) ! COMMA THEN 07095000 IF T1 ! RTPAREN THEN 07096000 COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000 HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000 BEGIN IF ACLASS { IDMAX OR ACLESS = SUPERLISTID THEN 07099000 CHECKER(WHOLE); 07099500 IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000 THEN BEGIN 07101000 COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000 HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000 SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000 IF ACLASS = SUPERFRMTID THEN 07105000 BEGIN ACLASS ~ FRMTID; GO TO FGEN END; 07106000 IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000 THEN BEGIN 07108000 T4~L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500 IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505 ACLASS ~ FILEID; 07109000 COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000 PASSFILE; 07111000 IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200 BEGIN 07111210 IF VBIT THEN 07111220 BEGIN 07111225 T5~L; L~T4; EMITO(MKS); L~T5; T5~0 ; 07111230 END ; 07111235 ACLASS~IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240 THEN REALID ELSE BOOID ; 07111250 IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255 IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260 BEGIN 07111265 SIMPARITH ; 07111270 IF ELCLASS=RELOP THEN 07111275 BEGIN 07111280 ACLASS~BOOID; RELATION ; 07111285 SIMPBOO ; 07111290 END ; 07111295 END ; 07111300 IF NOT VBIT THEN 07111303 BEGIN 07111307 EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310 EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315 EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320 EMITB(BFW,T4+2,L) ; 07111325 STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330 END ; 07111335 GO BS ; 07111340 END OF FILE ATTRIBUTE PARAMETER EXPRESSION;07111345 IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000 I ~ I-1; 07113000 COMMENT IF WE ARE HERE IT IS INDEXED; 07114000 CHECKPRESENCE; 07115000 EMITO(LOD); PANA; EMITO(CDC); 07116000 IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000 THEN BEGIN ERR(121); GO TO CERR END 07118000 COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000 STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000 RELEASE ON THIS DESCRIPTOR; 07121000 ELSE GO TO COMMON END ; 07122000 IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500 EMITV(WHOLE.ADDRESS); 07122510 IF WHOLE.ADDRESS>1023 THEN EMITO(PRTE); 07122520 EMITO(LOD); 07122530 ACLASS~LISTID; GO TO BS END; 07122540 COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000 NORMAL: IF VBIT THEN 07124000 VE: T1 ~ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000 ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000 IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000 COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;07128000 T2 ~ BAE; 07129000 T3 ~ PROGDESCBLDR(0,L,0); 07130000 COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000 AROUND CODE FOR EXPRESSION; 07132000 T1 ~ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000 STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000 COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000 PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000 INTO JUNK; 07137000 LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000 COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000 THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000 EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000 THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000 OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000 END OF NAME CALL EXPRESSIONS; 07144000 ACLASS ~ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000 THEN BOOID ELSE LABELID; GO TO BS; 07146000 END OF EXPRESSION CALL CODE; 07147000 COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000 ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000 IF SCLASS } BOOARRAYID THEN 07150000 IF SCLASS {INTARRAYID THEN 07151000 BEGIN T2 ~ TAKE(INDEX+PCTR).INCR; 07152000 COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.07153000 THUS WE MUST HAVE A ROW DESIGNATOR; 07154000 IF ACLASS ! BOOARRAYID THEN ACLASS ~ REALARRAYID; 07155000 COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000 VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000 THEN BEGIN ERR(123); GO TO EXIT END; 07158000 COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000 COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000 STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000 LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000 THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000 ELSE GO TO BS END; 07167000 IF VBIT THEN GO TO VE; 07168000 COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000 VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000 IF SBIT 07171000 THEN BEGIN 07172000 T6 ~ FL; VARIABLE(T6); 07173000 IF T6 ! 0 THEN GO TO BS; 07174000 FLAG(122);GO TO CERR END; 07175000 COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000 CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000 VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000 THAN THIS IT SETS T6 TO ZERO; 07179000 COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000 WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 07182000 2) A SUBSCRIPTED VARIABLE, OR 07183000 3) A GENUINE NAME CALL EXPRESSION; 07184000 IF TABLE(I+2) = LITNO AND 07185000 ( GT1 ~ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000 THEN BEGIN 07187000 COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000 CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000 ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000 VARIABLE(FL); 07191000 ACLASS ~ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000 REALID; GO TO BS END; 07193000 T2 ~ BAE; T3 ~ L; 07194000 COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000 IF WE HAVE ROW DESIGNATOR; 07196000 T6 ~ FA; VARIABLE(T6); 07197000 IF TABLE(I-2) = FACTOP 07198000 THEN BEGIN 07199000 COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000 EMITB(BFW,T2,T3); T2 ~ STLB; GO TO LOWBD END; 07201000 COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000 T3 ~ PROGDESCBLDR(0,T3,0); 07203000 T1 ~ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000 IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000 COMMENT WE ARE AT END OF PARAMETER; 07206000 IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000 GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000 GO TO LRTS; 07209000 IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000 IF ELCLASS = RELOP THEN BEGIN T1 ~ BTYPE; RELATION; 07211000 FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000 COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000 ACTUAL PARAMETER; 07214000 IF ACLASS { IDMAX OR ACLASS = SUPERLISTID THEN 07215000 CHECKER(WHOLE); STEPIT; 07215500 GO TO S[ACLASS-3]; 07216000 IF ACLASS = 0 THEN FLAG(100) ELSE 07217000 IF ACLASS= SUPERLISTID THEN 07217500 BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510 FLAG(126); 07217520 CERR: 07218000 L12:L13:L14:L15:L16: 07219000 COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000 FLAG(125); ERRORTOG ~ TRUE; GO TO COMMON; 07221000 LODPOINT: 07222000 L4:L8: 07223000 COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000 EMITPAIR(ADDRSF,LOD); 07225000 NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000 COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000 STREAM PROCEDURES; 07228000 BS: IF SCLASS ! ACLASS THEN 07229000 IF SCLASS ! LOCLID THEN 07230000 COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000 AGREE; 07232000 BEGIN FLAG(123); GO TO CERR END; 07233000 COMMON: 07234000 COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000 PCTR ~ PCTR+1; 07236000 IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000 IF ELCLASS ! RTPAREN 07238000 THEN BEGIN ERROR(129); GO TO EXIT END; 07239000 IF NOT FBIT THEN 07240000 IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000 THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000 ERR(128); GO TO EXIT END; 07243000 STEPIT; GO TO EXIT; 07244000 L5: 07245000 COMMENT FORMATS; 07246000 I~I-1; 07247000 FGEN: PASSFORMAT; 07248000 IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000 I~I+1; 07250000 GO TO BS; 07251000 L6: 07252000 COMMENT SUPERFORMAT; 07253000 IF FBIT 07254000 THEN BEGIN EMITV(ADDRSF); ADDRSF ~ ADDRSF-1 END 07255000 ELSE BEGIN I ~ I -1; EMITL(TAKEFRST); I ~ I+1 END; 07256000 GO TO LODPOINT; 07257000 L7: 07258000 COMMENT FILE; 07259000 I ~ I-1; ELCLASS ~ FILEID; 07260000 PASSFILE; GO TO BS; 07261000 L9: 07262000 COMMENT SWITCH; 07263000 IF FORMALF THEN GO TO LODPOINT; 07264000 COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000 MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000 DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000 ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000 THEY ARE OR NOT; 07269000 T2 ~ BAE; T3~PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000 GENGO(WHOLE); 07271000 EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000 L10: 07273000 COMMENT PROCEDURE; 07274000 TB1 ~ TRUE; IF FORMALF THEN GO LODPOINT; 07275000 LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000 THEN BEGIN 07277000 COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000 IF TB1 THEN GO TO LODPOINT; 07279000 COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000 DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);07281000 IF NOT FBIT THEN 07281900 IF SCLASS { INTPROCID THEN SCLASS ~ SCLASS+4; 07282000 I ~ I-2; STEPIT; 07283000 GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000 EXPRESSIONS HANDLE THIS CASE; 07285000 END THE CASE OF ZERO PARAMETERS; 07286000 TB1 ~ TRUE; 07287000 FOR T2 ~ 1 STEP 1 UNTIL T1 07288000 DO BEGIN 07289000 IF BOOLEAN(T3~TAKE(WHOLE+T2)).V0 07290000 THEN 07291000 IF T4 ~ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000 THEN BEGIN 07293000 COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000 IF TB1 THEN 07295000 BEGIN 07296000 COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000 VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000 PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000 VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000 PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK07301000 CONSTRUCTIONS; 07302000 GOBBLE: 07303000 TB1 ~ FALSE; T5 ~ BAE; 07304000 T6 ~ PROGDESCBLDR(1,L,0) END; 07305000 EMITV(T4 ~ T3.ADDRESS); EMITPAIR(T4,STD)END END;07306000 COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000 IF NOT TB1 07308000 THEN BEGIN 07309000 COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000 EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000 CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000 GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000 L11: 07314000 COMMENT INTRINSIC PROCEDURE; 07315000 ADDRSF ~ GNAT(WHOLE); 07316000 COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000 ACLASS ~ REALPROCID; 07318000 T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000 COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000 PROCEDURES; 07321000 L19:L20: 07322000 COMMENT ALFAPROC AND INTPROC; 07323000 ACLASS ~ REALPROCID; 07324000 L17:L18: 07325000 COMMENT BOOPROC AND REAL PROC; 07326000 IF FORMALF 07327000 THEN BEGIN 07328000 COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000 IF SCLASS > INTPROCID THEN ACLASS ~ ACLASS+4; 07330000 COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000 EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000 PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000 IF VBIT 07334000 THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000 ELSE GO TO LODPOINT; 07336000 COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000 DESCRIPTOR ALONG; 07338000 END; 07339000 TB1 ~ FALSE; GO TO LP; 07340000 L23:L24: 07341000 COMMENT INTEGER AND ALPHA IDS; 07342000 ACLASS ~ REALID; 07343000 L21:L22: 07344000 COMMENT BOOLEAN AND REAL IDS; 07345000 IF VBIT THEN EMITV(ADDRSF) 07346000 ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000 THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000 COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000 AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000 THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000 GO TO BS; 07352000 L27:L28: 07353000 COMMENT INTEGER AND ALPHA ARRAYS; 07354000 ACLASS ~ REALARRAYID; 07355000 L25:L26: 07356000 COMMENT BOOLEAN AND REAL ARRAYS; 07357000 EMITPAIR(ADDRSF,LOD); 07358000 IF SBIT THEN GO TO BS; 07359000 COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000 T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000 FOR T2 ~ 1 STEP 1 UNTIL T1 07362000 DO BEGIN 07363000 IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000 THEN EMITV(T3) ELSE EMIT(STLB); 07365000 IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000 COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000 IF FBIT THEN GO TO BS; 07368000 IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000 COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000 OF DIMENSIONS; 07371000 L29: 07372000 COMMENT LABEL; 07373000 ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000 L30: 07375000 COMMENT TRUTH VALUE; 07376000 EMITL(ADDRSF); ACLASS ~ BOOID; GO TO BSX; 07377000 L32: 07378000 COMMENT LITERAL; 07379000 EMITL(ADDRSF); 07380000 BSXXX: ACLASS ~ REALID; 07381000 BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000 L31:L33: 07383000 EMITNUM(C); GO TO BSXXX; 07384000 EXIT: STACKCT ~ 0 END OF ACTUALPARAPART; %A 07385000 COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000 FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000 PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000 IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000 OPERATIONS; 07390000 PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000 BEGIN 07392000 REAL HOLE,ADDRESS; 07393000 LABEL EXIT; 07394000 SCATTERELBAT; 07395000 HOLE~ ELBAT[I]; 07396000 ADDRESS ~ ADDRSF; 07397000 CHECKER(HOLE); 07398000 IF ELCLASS ! PROCID THEN 07399000 IF NOT FORMALF THEN 07400000 IF TABLE(I+1) = ASSIGNOP THEN 07401000 BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000 COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000 IF ELCLASS ! PROCID EQV FROM 07404000 THEN BEGIN ERR(159); GO TO EXIT END; 07405000 COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000 STEPIT; 07407000 EMITO(MKS); 07408000 IF ELCLASS = LEFTPAREN 07409000 THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000 ELSE IF FORMALF THEN 07411000 IF FROM THEN ELSE L~L-1 07411100 ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000 EMITV(ADDRESS); 07413000 COMMENT MONITOR CODE GOES HERE; 07414000 IF HOLE < 0 07415000 THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR07416000 ; 07417000 EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000 EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000 EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000 EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000 (GIT(HOLE)),FUNCMONFILE); %109-07422000 EMITNUM(1&CARDNUMBER[1:4:44]); %109-07422100 EMITV(GNAT(PRINTI)); 07423000 END; 07424000 EXIT: END PROCSTMT; 07425000 COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000 PROCEDURE STRMPROCSTMT; 07427000 BEGIN 07428000 INTEGER ADDRS; 07429000 IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000 THEN BEGIN 07431000 UNKNOWNSTMT; 07432000 END 07433000 07434000 07435000 07436000 07437000 07438000 07439000 ELSE BEGIN 07440000 IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000 GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000 GT4 ~ GT1-GT2.[7:6]; 07443000 FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000 DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000 COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000 JUMPS INSIDE OF STREAM PROCEDURES; 07447000 GT4 ~ GT2.[1:6]; 07448000 FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000 COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE07450000 OF STREAM PROCEDURES; 07451000 IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000 ELSE BEGIN 07453000 ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000 END END STRMPROCSTMT; 07455000 COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000 ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000 INTEGER PROCEDURE BAE; 07458000 BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000 COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000 RELEASE() % AUXMEM RELEASE STATEMENT. 07460250 RELEASE() % DATACOM RELEASE STATEMENT. 07460500 RELEASE() % FILE RELEASE STATEMENT. 07460750 ; 07461000 PROCEDURE RELSESTMT; 07461250 BEGIN 07461500 LABEL DCR,PARENCHECK,EXIT; 07461750 IF STEPI!LEFTPAREN THEN 07462000 BEGIN ERR(105); GO EXIT END; 07462250 IF STEPI=UNKNOWNID THEN 07462500 BEGIN ERR(100); GO EXIT END; 07462750 IF ELCLASS=PROCID OR RANGE(BOOPROCID,INTPROCID) THEN 07463000 BEGIN 07463250 EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITPAIR(38,COM); 07463500 EMITO(DEL); STEPIT; GO PARENCHECK; 07463750 END; 07464000 IF RANGE(BOOARRAYID,INTARRAYID) THEN 07464250 BEGIN 07464500 REL:=TRUE;AEXP; REL:=FALSE; 07464750 IF TABLE(I-2) = FACTOP THEN 07465000 BEGIN STACKCT:=STACKCT-1; 07465250 EMITPAIR(38,COM); EMIT0(DEL); GO PARENCHECK; 07465500 END 07465750 ELSE BEGIN % DATACOM RELEASE. 07466000 DCR: 07466250 EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500 EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750 EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000 END; 07467250 END; 07467500 IF FLCLASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750 BEGIN AEXP; GO DCR; END; 07468000 CHECKER(ELBAT[I]); PASSFILE; 07468250 IF ELCLASS = COMMA THEN EMITO(DUP); 07468500 COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750 CHECKPRESENCE; 07469000 COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250 NOT COMPLETED; 07469500 EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750 IF ELCLASS = COMMA THEN 07470000 BEGIN 07470250 EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500 EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750 END; 07471000 EMITO(PRL); EMITO(DEL); 07471250 PARENCHECK: 07471500 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750 EXIT: 07472000 END RELSESTMT; 07472250 COMMENT DOTSTMT HANDLES THE DO STATEMENT; 07481000 PROCEDURE DOSTMT; 07482000 BEGIN INTEGER TL; 07483000 DIALA ~ DIALB ~ 0; 07484000 ADJUST; 07484100 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 DIALA ~ DIALB ~ 0; 07492000 ADJUST; 07492100 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 ELSE GO GOCMP;07507000 IF NOT LOCAL(ELBAT[I]) THEN GO GOCMP; 07508000 IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000 CONSTANTCLEAN; GO EXIT END; 07510000 ELBW ~ ELBAT[I]; 07511000 IF ELBW < 0 07512000 THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000 EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000 CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)), 07515000 SWITMONFILE); %109-07516000 EMITNUM(0&CARDNUMBER[1:4:44]); %109-07516100 EMITV(GNAT( %109-07516200 PRINTI)); 07517000 END; 07518000 BANA; EMITPAIR(JUNK,ISD); 07519000 IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000 AND ELBW.ADDRESS = 0 THEN BEGIN 07521000 PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000 EMITB(BBW,L,GT4~GT1.[36:12]); 07523000 EMITB(BFW,GT4+13,L+3); 07524000 EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000 ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000 GO EXIT; 07527000 GOMCP: GOTOG ~ FALSE; DEXP; 07528000 IF GOTOG THEN 07529000 BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100 ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200 EXIT:END GOSTMT; 07530000 COMMENT GOGEN GENERATES CODE TO GO TO A LABEL. GIVEN THAT LABEL AS A 07531000 PARAMETER. GOGEN ASSUMES THA THE LABEL IS LOCAL. THE 07532000 PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000 OR NOT; 07534000 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 DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000 STEPTIT; 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 EMITB(BFC,T1,L); STMT; 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 DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000 BEGIN ERR(133); GO TO EXIT END; 07598000 XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION %116-07598100 % WHEN WE GET AROUND TO THE XREF. %116-07598200 IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000 THEN BEGIN FLAG(134); GO TO ROUND END; 07600000 LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD))) 07601000 .[36:12]; 07602000 IF ADDITIONAL < 0 THEN 07603000 BEGIN FLAG(135); GO TO ROUND END; 07604000 WHILE LINK ! 0 07605000 DO BEGIN 07606000 NEXTLINK ~ GET(LINK-2); 07607000 EMITB(GET(LINK-1),LINK,L); 07608000 LINK ~ NEXTLINK; 07609000 IF LASTENTRY } 126 THEN % DONT LET EMITNUM DO IT 07609100 BEGIN REAL C; % HOLD L FOR A WHILE 07609200 COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300 (>1023 WORD) FORWARD REFERENCES TO A LABEL;07609400 C ~ BUMPL; 07609500 CONSTANTCLEAN; 07609600 EMITB(BFW,C,L) END;END; 07609700 PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000 IF ELBATWORD < 0 07611000 THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000 OR MONITOR DECLARATION; 07613000 IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000 THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000 LABELS; 07616000 EMITO(MKS); PASSALPHA(ELBATWORD); 07617000 EMITPAIR(GNAT(CHARI),LOD); 07618000 PASSMONFILE(RR1); %109-07619000 EMITNUM(0&CARDNUMBER[1:4:44]); %109-07619100 EMITV(GNAT(PRINTI)); 07620000 END; 07621000 IF RR1~ADDITIONAL.DUMPEE ! 0 07622000 THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000 LABEL COUNTER; 07624000 EMITV(RR1); EMITL(1); EMITO(ADD); 07625000 EMITPAIR (RR1,STD); 07626000 IF RR1~ADDITIONAL.DUMPOR ! 0 07627000 THEN BEGIN COMMENT EMIT CODE TO CALL 07628000 THE DUMP ROUTINE; 07629000 07630000 07631000 07632000 STUFFF(RR1); EMITO07633000 (XCH);EMITO(COC); 07634000 07635000 07636000 07637000 07638000 07639000 07640000 EMITO(DEL); 07641000 END; 07642000 END; 07643000 END; 07644000 ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000 EXIT: END LABELR; 07646000 PROCEDURE CASESTMT; 07646100 BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110 CASE OF BEGIN 07646120 AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130 IN THE , DEPENDING ON THE VALUE OF THE , 07646140 ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150 THE . IF THERE ARE N STATEMENTS IN THE 07646160 , THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1. 07646170 AND THE MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 07646180 WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 07646190 THE STATEMENTS IN THE MAY BE ANY EXECUTABLE 07646200 STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210 AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220 07646230 OPDC ARRAY 07646240 BFW 07646250 STMT 0 07646260 BRANCH TO RESUME 07646270 STMT 1 07646280 BRANCH TO RESUME 07646290 . 07646300 . 07646310 . 07646320 STMT N-1 07646330 RESUME: 07646340 "ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 07646350 CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 07646360 BY THE VALUE OF AND CONTAINS SYLLABLE COUNTS 07646370 FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 07646375 IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 07646380 TRANSFERS TO RESUME DIRECTLY; 07646385 REAL LINK, TEMP, N, ADR, PRT, NULL; 07646390 BOOLEAN GOTOG; 07646395 REAL ARRAY TEDOC[0:7, 0:127]; 07646400 LABEL LOOP, XIT; 07646410 LINK ~ N ~ NULL ~ 0; 07646420 STEPIT; AEXP; 07646430 IF STEPI ! BEGINV THEN BEGIN ERR( 70); GO TO XIT END; 07646440 EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450 EMITO(BFW); ADR ~ L; 07646460 LOOP: 07646470 ERRORTOG ~ TRUE; 07646475 IF STEPI = SEMICOLON THEN 07646480 BEGIN COMMENT NULL STATEMENT; 07646485 TEDOC[N,[38:3], N.[41:7]] ~ NULL; 07646490 NULL ~ N ~ N+1; GO TO LOOP; 07646495 END; 07646500 TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510 IF GOTOG := SIMPGO THEN ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646515 STMT; 07646520 IF ELCLASS = SEMICOLON THEN 07646525 BEGIN IF NOT GOTOG THEN 07646530 BEGIN EMIT(LINK);LINK ~ L ~ L+1; END; 07646533 GO TO LOOP; 07646535 END ELSE IF ELCLASS = ENDV THEN 07646538 BEGIN IF NOT GOTOG THEN 07646540 BEGIN EMIT(LINK); LINK ~ L ~ L+1; END; 07646543 TEDOC[N,[38:3], N.[41:7]]~ L-ADR; 07646545 N ~ N+1; 07646548 END; 07646550 IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555 N := N-1 ; 07646556 WHILE NULL ! 0 DO 07646560 BEGIN TEMP ~ TEDOC[(NULL~NULL-1).[38:3], NULL.[41:7]]; 07646565 TEDOC[NULL.[38:3], NULL.[41:7]] ~ L-ADR; 07646570 NULL ~ TEMP; 07646575 END; 07646580 ENDTOG ~ TRUE; 07646585 COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590 DO STOPDEFINE ~ TRUE UNTIL STEPI { ENDV AND ELCLASS }UNTILV 07646595 OR NOT ENDTOG; 07646600 ENDTOG ~ FALSE; 07646610 COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620 MOVECODE(TEDOC, EDOC); 07646630 BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07646635 TEMP := SGNO; IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07646640 SGNO ~ SGAVL; 07646650 Z ~ PROGDESCBLDR(LDES, 0, PRT); 07646660 SEGMENT(-N, SGNO, TEMP); 07646670 SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680 BUILDLINE ~ BUILDLINE.[46:1] ; 07646685 MOVECODE(TEDOC, EDOC); 07646690 COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700 IF (L-ADR)>1019 THEN ADJUST;% 07646705 WHILE LINK ! 0 DO 07646710 BEGIN TEMP ~ GET(LINK-2); 07646720 EMITB(BFW, LINK, L); 07646730 LINK ~ TEMP; 07646740 IF LASTENTRY }126 THEN 07646750 BEGIN REAL C; 07646760 COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770 C ~ BUMPL; 07646780 CONSTANTCLEAN; 07646790 EMITB(BFW, C, L); 07646800 END; 07646810 END; 07646820 XIT: 07646830 END CASESTMT; 07646840 COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07647000 IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07647500 THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07648000 THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07648500 NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07649000 RESIDES ON THE DISK AND IS READ INTO THE ROW DESIGNATED 07649500 BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07650000 EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07650500 ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07651000 NUMBERS LOOK LIKE IDENITIFERS TO FILLSTMT AND ARE CONVERTED 07651500 BY OCTIZE.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN 07652000 PDPRT TO SUPPLY INFO TO BUILD A DISK DESCRIPTOR IN THE 07652500 SEGMENT DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07653000 PROCEDURE FILLSTMT; 07653500 BEGIN 07654000 LABEL EXIT; 07654500 DEFINE PARENCOUNTER = RR1#, 07655000 T = RR2#, 07655500 J = RR3#; 07656000 ARRAY TEDOC[0:7,0:127], FILLTEMP[0:1022]; 07656500 BOOLEAN PROCEDURE FILLIT(A); ARRAY A[0]; 07657000 BEGIN 07657500 REAL T1, T2, T3; 07658000 BOOLEAN BOO; 07658500 LABEL CHECK, GOOFUP, EXIT; 07659000 PARENCOUNTER:=PARENCOUNTER+1; 07659500 WHILE T<1023 DO 07660000 BEGIN 07660500 IF STEPI>IDMAX THEN 07661000 BEGIN 07661500 IF ELCLASS=LITNO THEN 07662000 IF TABLE(I+1)=LEFTPAREN THEN 07662500 BEGIN 07663000 T1:=ELBAT[I].ADDRESS; T2:=T; 07663500 STEPIT; IF FILLIT(A) THEN GO GOOFUP; 07664000 IF T1=0 THEN T:=T2 07664500 ELSE BEGIN 07665000 IF (T3:=(T1-1)|(T-T2))+T>1022 THEN 07665500 BEGIN ERROR(305); GO GOOFUP END;%>102307666000 MOVE(T3,A[T2],A[T]); T:=T+T3; 07666500 END; 07667000 GO CHECK; 07667500 END REPEAT PART; 07668000 IF (BOO:=ELCLASS=ADOP) THEN STEPIT; 07668500 IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN 07669000 IF ELCASS!STRING AND(ELCASS!STRNGCON OR BOO) THEN 07669500 BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07670000 IF BOO THEN C:=C&ELBAT[I-1][1:21:1]; 07670500 IF ELCLASS=STRING THEN 07671000 BEGIN 07671500 IF (T2:=T+(COUNT+7)DIV 8-1)>1022 THEN 07672000 BEGIN ERROR(305); GO GOOFUP END; % > 1023. 07672500 T3:=" "; MOVE(1,T3,A[T2]); 07673000 MOVECHARACTERS(COUNT,ACCUM[1],3,A[T],0); 07673500 T:=T2; 07674000 END 07674500 ELSE MOVE(1,C,A[T]); 07675000 END 07675500 ELSE IF COUNT{19 AND ACCUM[1].[18:18]="OCT" THEN 07676000 BEGIN % GET RID OF "OCT" FOR OCTIZE. 07676500 MOVECHARACTERS(COUNT-3,ACCUM[1],6,ACCUM[1],3); 07677000 IF OCTIZE(ACCUM[1],A[T],19-COUNT,COUNT-3) THEN 07677500 FLAG(303); % NON-OCTAL CHARACTER. 07678000 END 07678500 ELSE BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07679000 T:=T+1; 07679500 CHECK: 07680000 IF STEPI!COMMA THEN GO EXIT; 07680500 END T LOOP; 07681000 ERROR(305); % > 1023 ITEMS IN LIST. 07681500 GOOFUP: 07682000 FILLIT:=TRUE; 07682500 EXIT: 07683000 PARENCOUNTER:=PARENCOUNTER-REAL(ELCLASS=RTPAREN); 07683500 END RECURSIVE FILLIT; 07684000 IF STEPIINTARRAYID THEN 07684500 BEGIN 07685000 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07685500 MAKEALABEL ELSE ERROR(300); % NO ARRAY ID. 07686000 GO EXIT; 07686500 END; 07687000 VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN FLAG(304); % NOT ARR. ROW. 07687500 XMARK(ASSIGNREF); % FILL STATEMENT %116-07687600 IF ELCLASS!WITHV THEN 07688000 BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500 STREAMTOG:=TRUE; 07689000 IF TABLE(I+1){IDMAX THEN 07689500 IF Q="7INQUI" THEN 07690000 BEGIN 07690500 STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000 EMITPAIR(9,COM); EMITO(DEL); 07691500 GO EXIT; 07692000 END; 07692500 EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000 IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500 MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000 BUILDLINE:=BOOLEAN(2|REAL(BUILDLINE)) ; 07694500 IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000 ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500 ELSE BEGIN 07696000 FOR J:=0 STEP 32 UNTIL T DO 07696500 MOVE(32,FILLTEMP[J],EDOC[J.[38:3],J.[41:7]]); 07697000 SEGMENT(T,SGAVL,SGNO); 07697500 END; 07698000 MOVECODE(TEDOC,EDOC); STREAMTOG:=FALSE; 07698500 BUILDLINE:=BUILDLINE.[46:1] ; SGAVL:=SGAVL+1; 07699000 EXIT: 07699500 END FILLSTMT; 07700000 COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000 CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000 WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000 AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000 PROCEDURE STMT ; 07714000 BEGIN 07715000 LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000 LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000 LGO, LRELSE, LBEG, LBRK, EXIT; 07718000 SWITCH S ~ 07719000 LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000 LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000 LVAR, 07722000 LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000 LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000 LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000 EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000 LRELSE,LBEG; 07727000 COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010 CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020 GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030 ADDRESSING IS NOT POSSIBLE; 07727040 IF LASTENTRY !0 THEN 07727050 BEGIN GT2 ~ INFO [0,255]; 07727055 DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060 IF L- GT1 > 400 THEN 07727065 BEGIN GT1 ~ BUMPL; 07727070 CONSTANTCLEAN; 07727075 EMITB(BFW, GT1,L); 07727080 END; 07727085 END; 07727090 STACKCT ~ 0; %A 07727100 AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000 IF ELCLASS = 0 THEN 07728500 BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000 IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100 IF ELCLASS=FILEDID OR ECLASS=SUPERFILEID THEN 07729190 BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200 FLAG(145); 07729500 LERR: ERR(144); GO TO EXIT; 07730000 LDEC: FLAG(146); 07731000 IF TABLE(I-2) = ENV AND MODE > 0 07732000 THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000 I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000 ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000 07735500 07735510 07735520 LPROC: PROCSTMT(TRUE); GO TO EXIT; 07736000 LSPROC: STRMPROCSTMT; GO TO EXIT; 07737000 LVAR: VARIABLE(FS); GO TO EXIT; 07738000 LAB: LABELR; GO TO AGAIN; 07739000 LREAD: READSTMT; GO TO EXIT; 07740000 LWRITE: WRITESTMT; GO TO EXIT; 07741000 LSPACE: SPACESTMT; GO TO EXIT; 07742000 LCLOSE: CLOSESTMT; GO TO EXIT; 07743000 LLOCK: LOCKSTMT; GO TO EXIT; 07744000 LRWND: RWNDSTMT; GO TO EXIT; 07745000 LDBL: DBLSTMT; GO TO EXIT; 07746000 LFOR: FORSTMT; GO TO EXIT; 07747000 LWHILE: WHILESTMT; GO TO EXIT; 07748000 LDO: DOSTMT; GO TO EXIT; 07749000 LFILL: FILLSTMT; GO TO EXIT; 07750000 LIF: IFSTMT; GO TO EXIT; 07751000 LGO: GOSTMT; GO TO EXIT; 07752000 LRELSE: RELSESTMT; GO TO EXIT; 07753000 LBEG: IF STEPI = DECLARATORS 07754000 THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000 ELSE COMPOUNDTIAL; 07756000 EXIT: END STMT; 07757000 PROCEDURE CMPLXSTMT; FORWARD ; 07777777 PROCEDURE UNKNOWNSTMT; 07800000 BEGIN LABEL XXX,E; 07801000 REAL J,N,C; 07802000 IF Q = "5BREAK" THEN 07803000 BEGIN EMIT(0); 07804000 EMIT(48); 07805000 EMITO(COM); 07806000 EMITO(DEL); 07807000 STEPIT; 07808000 GO TO XXX; 07809000 END; 07810000 IF Q="7COMPL" THEN BEGIN CMPLXSTMT; GO XXX END ; 07810100 IF Q = "3ZIPOO" THEN 07811000 BEGIN IF TABLE(I+1) = WITHV THEN 07812000 BEGIN STEPIT; 07813000 IF STEPI < BOOARRAYID OR ELCLASS > 07814000 INTARRAYID THEN 07814100 IF ELCLASS=FILEID OR 07814200 ELCLASS=SUPERFILEID THEN 07814300 PASSFILE ELSE 07814400 GO E ELSE 07814500 BEGIN 07814600 VARIABLE(FL); 07815000 IF TABLE(I-2) ! FACTOP THEN GO TO E; 07816000 END; 07816100 EMIT(16); EMITO(COM); EMITO(DEL); 07817000 GO TO XXX; 07818000 END; 07819000 N ~ 1; C ~ 8 07820000 END ELSE 07821000 IF Q = "5CHAIN" THEN 07821100 BEGIN N ~ 1; C ~ 37 END ELSE 07821200 IF Q = "4WHEN0" THEN 07822000 BEGIN N ~ 0; C ~ 6 END ELSE 07823000 IF Q = "4WAIT0" THEN 07824000 BEGIN N ~ 1; C ~ 2 END ELSE 07825000 IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500 IF Q = "4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000 IF Q = "5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000 IF Q = "6SEARC" THEN 07828000 BEGIN IF STEPI!LEFTPAREN THEN 07829000 BEGIN ERR(105); GO TO XXX END; 07830000 IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000 PASSFILE ELSE GO TO E; 07832000 IF ELCLASS!COMMA THEN GO TO E; 07833000 IF STEPIINTARRAYID THEN 07834000 GO TO E; 07835000 XMARK(ASSIGNREF); % SEARCH STATEMENT %116-07835500 VARIABLE(FL); 07836000 IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000 IF ELCLASS!RTPAREN THEN 07838000 BEGIN ERR(104); GO TO XXX END; 07839000 EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000 STEPIT; GO TO XXX; 07841000 END ELSE 07842000 IF Q="4SEEK0" THEN 07843000 BEGIN IF STEPI!LEFTPAREN THEN 07844000 BEGIN ERR(105); GO TO XXX; END; 07845000 IF STEPI!FILEID AND ELCLASS!SUPERFILED THEN 07846000 GO TO E ELSE 07847000 BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000 IF ELCLASS!LEFTPAREN THEN 07849000 BEGIN ERR(105); GO TO XXX; END; 07850000 STEPIT; AEXP; EMITO(XCH); 07851000 IF ELCLASS!RTPAREN THEN 07852000 BEGIN ERR(104); GO TO XXX; END; 07853000 IF STEPI!RTPAREN THEN 07854000 BEGIN ERR(104); GO TO XXX; END; 07855000 EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000 EMITO(DEL); EMITO(DEL); STEPIT; 07857000 END; GO TO XXX; 07858000 END ELSE 07859000 IF Q="6UNLOC" THEN 07859010 BEGIN IF STEPI!LEFTPAREN THEN 07859020 BEGIN ERR(105); GO TO XXX END; 07859030 STEPIT; VARIABLE(FL); L ~ L-1; 07859040 IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050 EMITO(DUP); EMITO(LOD); EMITL(0); 07859060 EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080 GO TO XXX 07859090 END ELSE 07859100 $ SET OMIT = NOT TSPOL 07859900 BEGIN ERROR(100); GO TO XXX END; 07900000 IF STEPI ! LEFTPAREN THEN 07901000 BEGIN ERR(105); GO TO XXX END; 07902000 STEPIT; AEXP; 07903000 FOR J ~ 1 STEP 1 UNTIL N DO 07904000 BEGIN IF ELCLASS ! COMMA THEN 07905000 E: BEGIN ERR(164); GO TO XXX END; 07906000 STEPIT; AEXP; 07907000 END; 07908000 IF ELCLASS ! RTPAREN THEN 07909000 BEGIN ERR(104); GO TO XXX END; 07910000 EMITL(C); EMITO(COM); 07911000 FOR J ~ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000 STEPIT; 07913000 XXX: END; 07914000 PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"~" 07920000 KIND OF STATEMENT. FOR THE RUN-TIME ERROR MESS; 07921000 BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000 CHECKER(ELBW~ELBAT[I]); STR~IF FAULTOG THEN SND ELSE STD; 07923000 FAULTOG ~ BOOLEAN(1) OR FAULTOG; COMMENT TELLS DEXP TO MESS 07923100 WITH FAULTLEVEL; 07923150 IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000 IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000 IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100 EMITPAIR(ADRES,STR); 07926000 FAULTOG~FALSE&(ELBW.LVLINTARRAYID THEN 07939000 BEGIN ERR(429); GO TO EXIT; END; 07940000 VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN 07941000 BEGIN ERR(427); GO TO EXIT; END; 07942000 IF ELCLASS!RTPAREN THEN BEGIN ERR(428); GO TO EXIT; END; 07943000 EMITO(XCH); 07944000 IF T<0 THEN COMMENT FROM WRITE...(<0 IS FROM READ); 07945000 BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITV(JUNK); END; 07946000 IF T>0 THEN IF TABLE(I+1)=LFTBRKET THEN 07947000 BEGIN GOGOGO ~ FALSE;% JUST TO MAKE SURE... 07948000 HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000 L ~ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000 EMITO(DEL); EMITO(DEL);% REMOVE LABEL WORDS... 07951000 END ELSE STEPIT ELSE STEPIT;% WALTZ ON BY... 07952000 EMITV(GNAT(SUPERMOVER));% BET YOU THOUGHT I"D NEVER DO IT 07953000 EXIT: END THIS HAIRY KLUDGE;% 07954000 COMMENT FORSTMT IS RESPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 08000000 IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 08001000 THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 08002000 ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 08003000 CONSTANT, THEN THE CODE TAKES ON MORE EFFICIENT FORM. 08004000 IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 08005000 THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 08006000 STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 08007000 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 FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 08017100 IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 08017200 INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 08017300 RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 08017400 BOOLEAN PROCEDURE FORCLASS(CLSS); VALUE CLSS; INTEGER CLSS; 08017500 IF STEPI = CLSS THEN FORCLASS ~ TRUE ELSE 08017600 IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON THEN 08017700 BEGIN INFO[0,K~K+1] ~ C; 08017800 ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11] 08017900 END FORCLASS; 08017950 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 BEGIN 08021000 CHECKER (A); 08021100 EMITV(A.ADDRESS) END; 08021200 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 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 = 3; 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 DIALA + DIALB ~ 0; 08100000 AEXP; DIALA ~ DIALB ~ 0; 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(OPOC); 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 (STEPI = 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 IF LISTMODE THEN LISTELEMENT ELSE 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 XMARK(ASSIGNREF); % FOR STATEMENT %116-08178100 T1 ~ L; IF FORMALV THEN EMITN(ADDRES); 08179000 K ~ 0; 08180000 IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000 IF FORCLASS(STEPV) THEN 08182000 IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000 IF FORCLASS(UNTILV) THEN 08184000 IF SIMPLE(CONSTANC,C,SIGNC) THEN 08185000 IF FORCLASS(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 IF LISTMODE THEN LISTELEMENT ELSE 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 PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000 BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000 SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000 LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000 COLON HAS JUST BEEN DETECTED; 08237000 LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08238000 EXECUTABLE STATEMENT IN THIS ROUTINE; 08239000 IF STEPI = LFTBRKET 08240000 THEN BEGIN COMMENT THIS CODE HANDLES PARITY AND END OF 08241000 FILE LABELS; 08242000 IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08243000 IF ELCLASS ! COLON THEN EMIT(0) ELSE 08244000 BEGIN STEPIT; DEXP END; 08245000 08246000 08247000 08248000 08249000 08250000 08251000 08252000 08253000 08254000 08255000 08256000 08257000 08258000 08259000 08260000 08261000 08262000 08263000 08264000 08265000 08266000 08267000 08268000 08269000 08270000 08271000 08272000 08273000 08274000 08275000 08276000 IF CHECK(RTBRKET,433) 08277000 THEN GO TO EXIT; 08278000 COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 08279000 IN READ OR SPACE STATEMENT; 08280000 STEPIT; 08281000 END 08282000 ELSE BEGIN COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS08283000 CASE; 08284000 EMITL(0); EMITL(0); 08285000 END; 08286000 IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000 EMITV(13) 08287100 END ELSE EMITV(GNAT(INTERPTI)); 08287200 GOGOGO ~ FALSE;% 08287300 EXIT:; 08288000 END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000 DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010 EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020 EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030 PROCEDURE READSTMT; 08290000 BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS08291000 SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000 DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000 THE READ OR SPACE STATEMENT. 08294000 THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000 STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000 REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000 EXPRESSION IN THE SPACE STATEMENT. 08298000 I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000 READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000 ARE PASSED TO INTERPTI. 08301000 **********************************************************08302000 ::=REVERSE/ 08303000 ::=/ 08304000 ::=[NO]/ 08305000 ::=[:<[PARITY LABEL>]/ 08306000 []/[:]/08307000 08308000 CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000 POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000 CONVERSION. 08311000 FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000 ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000 REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000 VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000 PROCESSED. 08317000 END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL08318000 DESCRIPTOR FOR THE END OF FILE JUMPS. 08319000 PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000 DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000 + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT08322000 DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE08323000 GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS08324000 IN ACTION TYPE. 08325000 LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000 DESCRIPTRO WHICH WILL EITHER RETURN08327000 AN ADDRESS OR VALUE DEPENDING ON 08328000 THE CALL. 08329000 N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000 READ() 08331000 08332000 - - - - - - - - - - - - - - 08333000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000 ,PARITY LABEL) 08335000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000 READ(, 08337000 ) 08338000 - - - - - - - - - - - - - - 08339000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000 ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000 SPACE(,) 08343000 - - - - - - - - - - - - - - 08344000 (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000 PARITY LABEL) 08346000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000 READ(, 08348000 ,) 08349000 - - - - - - - - - - - - - - 08350000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000 ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000 LABEL,PARITY LABEL) 08353000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000 READ(, 08355000 *,) 08356000 - - - - - - - - - - - - - - 08357000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000 DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000 READ(, 08361000 ,) 08363000 - - - - - - - - - - - - - - 08364000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000 END OF FILE LABEL,PARITY LABEL) 08366000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000 READ(, 08368000 ,) 08369000 - - - - - - - - - - - - - - 08370000 (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000 DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000 *********************************************************;08373000 DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE08374000 IF THE STATEMENT BEING COMPILED08375000 IS A READ REVERSE, OTHERWISE IT08376000 IS SET FALSE; 08377000 LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08378000 EXECUTABLE STATEMENT IN READSTMT; 08379000 LABEL CHKACTIONLABELS; COMMENT THE CODE AT THIS LABEL 08380000 ASSUMES I IS POINTING AT THE RIGHT 08381000 PARENTHESIS; 08382000 LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I TO08383000 BE POINTING AT THE LAST QUANTITY IN THE 08384000 SECOND PARAMETER; 08385000 LABEL READXFORM; 08385100 INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500 BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600 BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700 INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800 IF STEPI = LEFTPAREN 08386000 THEN REVERSETOG~SEEKTOG~FALSE; 08387000 ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000 REVERSETOG~ACCUM[1]="7REVER"; 08389000 LOCKTOG~ELCLASS=LOCKV; 08390000 SEEKTOG~ACCUM[1]="4SEEK0"; 08390500 IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000 ELSE BEGIN ERR(420); 08392000 GO TO EXIT; 08393000 END; 08394000 IF CHECK(LEFTPAREN,421); 08395000 THEN GO TO EXIT; 08396000 COMMENT ERROR 421 MEANS MISSING LEFT 08397000 PARENTHESIS IN READ REVERSE STATEMENT; 08398000 END; 08399000 EMITO(MKS); 08400000 IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08401000 BEGIN VARIABLE(FL); 08401020 IF TABLE(I-2) ! FACTOP THEN 08401030 BEGIN ERR(422); GO TO EXIT END; 08401040 WAYI ~ TRUE; HOLD ~ L; 08401045 EMIT(11); EMIT(4); EMITO(280); 08401050 EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060 EMITO(XCH); EMITL(0); EMITL(1); 08401070 END ELSE 08401080 BEGIN 08401090 EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000 IF NOT RANGE(FILEID,SUPERFILEID) 08403000 THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000 STATEMENT; 08405000 ERR(422); GO TO EXIT; 08406000 END; 08407000 PASSFILE; 08408000 IF ELCLASS = LFTBRKET 08409000 THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000 %%% [*],[*,*],[*,],[],[,*], 08410010 %%% AND [,]. THE FIRST (LEFTMOST) 08410020 %%% IS THE READSEEKDISTADDRESS, RESIDING 08410030 %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000 %%% IS THE WAIT-TIME, RESIDING IN THE 08411010 %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 08411020 %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 08411030 %%% IN THE ABOVE, NS = NO OR STOP. 08411040 STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000 IF RR1~IF ACCUM[1]="2N0000" THEN 1 ELSE 08412010 IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020 0 ! 0 THEN %%% HAVE [NS 08412030 IF STEPI=COMMA THEN %%% HAVE [NS, 08412040 IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050 BEGIN 08412060 IF RR1=1 THEN EMITNO(1) 08412070 ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080 STEPIT ; 08412090 END 08413000 ELSE 08413010 IF ACCUM[1]="4LOCK0" THEN 08413012 BEGIN %%% [NS,LOCK 08413014 EMITL(1); EMITD(47,4,1); 08413016 STEPIT; 08413018 END ELSE 08413020 BEGIN %%% HAVE [NS,AEXP 08413022 IF RR1=2 THEN EMITL(1) ; 08413030 EMITTIME ; 08413040 IF RR1=2 THEN 08413050 BEGIN EMITO(LOR); EMITL(2) END 08413060 ELSE EMITL(1) ; 08413080 END 08413090 ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100 ELSE BEGIN EMITL(1); EMITL(2) END 08413110 ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120 IF STEPI=COMMA THEN %%% HAVE [*, 08413130 IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000 BEGIN EMITNO(2); STEPIT END 08414010 ELSE IF ACCUM[1]="4LOCK0" THEN 08414012 BEGIN %%% [*,LOCK 08414014 EMITL(1); EMITD(47,4,1); 08414016 STEPIT; 08414018 END ELSE 08414020 BEGIN EMITTIME; EMITL(2); END % [*,A 08414022 ELSE EMITNO(2) %%% HAVE ONLY [* 08414030 ELSE BEGIN %%% HAVE [AEXP 08415000 AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010 IF SEEKTOG THEN EMITO(CHS) ; 08415020 EMITPAIR(JUNK,ISN) ; 08415030 IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000 IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010 ELSE IF ACCUM[1]="4LOCK0" THEN 08416012 BEGIN %%% [AEXP,LOCK 08416014 EMITL(1); EMITD(47,4,1); 08416016 STEPIT; 08416018 END ELSE 08416020 BEGIN EMITTIME; EMITO(LOR) END ; 08416022 EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030 END ; 08417000 IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010 END 08418000 ELSE IF ELCLASS=LEFTPAREN THEN 08418100 BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200 IF STEPI!FACTOP THEN% 08418250 BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300 BEGIN EMITL(1); GRABTOG~TRUE; STEPIT END ELSE 08418350 EMITPAIR(0,LNG); 08418400 EMITD(33,33,15); 08418500 EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600 EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650 IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700 EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800 END 08418900 ELSE BEGIN EMITL(0); EMITL(2); END; 08419000 IF REVERSETOG 08420000 THEN EMITO(CHS); 08421000 END; 08421500 IF ELCLASS = RTPAREN 08422000 THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000 EMITL(0); EMITL(0); EMITL(0); 08424000 GOGOGO ~ NOT MAYI;% 08424100 GO CHKACTIONLABELS; 08425000 END; 08426000 IF CHECK(COMMA,424) 08427000 THEN GO TO EXIT; 08428000 COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000 STATEMENT; 08430000 IF STEPI = FACTOP 08431000 THEN BEGIN COMMENT *,LIST CASE; 08432000 EMITL(0); EMITL(0); GO PASSLIST; 08433000 END; 08434000 IF ELCLASS = MULOP 08435000 THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000 IF STEPI=MULOP THEN EMITL(2) ELSE 08437000 BEGIN EMITL(1); I~I-1; END ; 08437050 EMITL(0); GO TO PASSLIST ; 08437075 END; 08438000 IF RANGE(FRMTID,SUPERFRMTID) 08439000 THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000 PASSFORMAT; 08441000 READXFORM: IF TABLE(I+1) = COMMA 08442000 THEN GO PASSLIST; 08443000 STEPIT; 08444000 IF CHECK(RTPAREN,425) 08445000 THEN GO TO EXIT; 08446000 COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000 DELIMITER IN READ STATEMENT; 08448000 EMITL(0); GO CHKACTIONLABELS; 08449000 END; 08450000 IF Q:=ACCUM[1]="1<0000" THEN 08450010 BEGIN EXPLICITFORMAT; GO TO READXFORM; END; 08450020 IF MAYI THEN 08450100 BEGIN KLUDGE(HOLD); 08450200 GO TO EXIT; 08450300 END ARRAY TO ARRAY CASE; 08450400 EMITL(0); AEXP; 08451000 IF CHECK(COMMA,426) 08452000 THEN GO TO EXIT; 08453000 COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000 PARAMETER; 08455000 STEPIT; 08456000 IF RANGE(BOOARRAYID,INTARRAYID) 08457000 THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000 VARIABLE(FL); 08459000 IF TABLE(I-2) ! FACTOP 08460000 THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000 ROW DESIGNATOR IN READ; 08462000 ERROR(427); GO TO EXIT; 08463000 END; 08464000 IF CHECK(RTPAREN,428) 08465000 THEN GO TO EXIT; 08466000 COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000 DELIMITER IN READ STATEMENT; 08468000 GOGOGO ~ TRUE;% 08468100 GO CHKACTIONLABELS; 08469000 END 08470000 ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000 ERROR(429); GO TO EXIT; 08472000 END; 08473000 PASSLIST:STEPIT; 08474000 IF CHECK(COMMA,430) 08475000 THEN GO TO EXIT; 08476000 COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000 THE LIST IN A READ STATEMENT; 08478000 IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000 THEN BEGIN 08480000 RR1~LISTGEN; 08481000 I~I-1; 08482000 GO TO CHKACTIONLABELS 08483000 END; 08484000 CHECKER(ELBAT[I]); 08484500 IF ELCLASS = SUPERLISTID THEN 08485000 BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000 LISTADDRESS ~ELBAT[I].ADDRESS; 08488000 BANA; 08489000 EMITV(LISTADDRESS); 08489500 IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08489510 EMITO(LOD); I~I-1 END 08489520 ELSE BEGIN COMMENT A COMMON LIST; 08489530 EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550 END; 08489560 STEPIT; 08489570 IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580 COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590 08490000 CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000 EXIT:; 08492000 END READSTMT; 08493000 REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND08493010 VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015 BEGIN % RETURNS THE ASSOCIATED INDEX IF 08493020 REAL I ; % IT IS A FILE ATTRIBUTE. 08493030 LABEL EXIT ; 08493040 STOPDEFINE~T ; % MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 08493050 STEPIT ; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 08493060 IF I~FILEATTRIBUTES[0]=0 THEN 08493070 BEGIN 08493080 FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090 % BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091 % ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092 % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093 17 08493094 ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095 ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096 ,"4SAVE0" 08493097 ,"8OTHER" % "OTHERUSE". 08493098 ,"404MFID0" 08493099 ,"403FID00" 08493100 ,"4REEL0" 08493101 ,"4DATE0" 08493102 ,"5CYCLE" 08493103 ,"4TYPE0" 08493104 ,"5AREAS" 08493105 ,"8AREAS" % "AREASIZE". 08493106 ,"2EU000" 08493107 ,"5SPEED" 08493108 ,"9TIMEL" % "TIMELIMIT" 08493109 ,"+08IOSTA" % "IOSTATUS" 08493110 ,"9SENSI" % "SENSITIVE" 08493111 % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120 ; % END OF FILL STATEMENT. 08493130 I~FILEATTRIBUTES[0] ; 08493140 END ; 08493150 FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160 BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170 EXIT: 08493180 END OF FILEATTRIBUTEINDX ; 08493190 COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200 A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210 1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220 FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230 AND XIT. 08493240 2. ACTUALPARAPART: 08493250 PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260 ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270 THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280 3. PRIMARY: 08493290 PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300 IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310 ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320 THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330 TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340 IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350 ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360 ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370 FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380 (ATYPE OR BTYPE). 08493390 4. BOOPRIM: 08493400 PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410 5. IODEC: 08493420 PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430 HAVE ALREADY BEEN EMITTED, THE ATTRIBUTEINDX IS 08493440 DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450 END OF COMMENT ; 08493460 INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470 BEGIN 08493480 REAL ATTRIBUTEINDX ; 08493490 BOOLEAN ASSOP ; 08493500 LABEL DONESOME,DONEMORE,EXIT ; 08493510 IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520 BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530 EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540 GO TO DONEMORE ; 08493550 END ; 08493560 EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570 IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580 BEGIN 08493590 DONESOME: 08493600 IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610 BEGIN 08493620 STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625 IF STEPI=LFTBRKET THEN 08493630 BEGIN 08493640 STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650 END 08493660 ELSE EMITL(0) ; 08493670 EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675 IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680 BEGIN 08493700 IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705 DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710 THEN FLAG(293) ; 08493720 STEPIT ; 08493730 IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740 THEN BEXP ELSE AEXP ; 08493750 END 08493760 ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770 ELSE EMITL(0) ; 08493780 EMITNUM(IF ATTRIBUTEINDX= 1 THEN "6ACCESS" ELSE 08493790 IF ATTRIBUTEINDX= 4 THEN "6OTHRUS" ELSE 08493795 IF ATTRIBUTEINDX=12 THEN "6ARASIZ" ELSE 08493800 IF ATTRIBUTEINDX=15 THEN "6TIMLMT" ELSE 08493805 IF ATTRIBUTEINDX=16 THEN "6IOSTAT" ELSE 08493810 IF ATTRIBUTEINDX=17 THEN "6SNSTIV" ELSE 08493812 0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820 & FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830 EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840 & REAL(ASSOP)[38:47:1]) ; 08493850 EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860 FILEATTRIBUTEHANDLER~ 08493870 IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880 THEN BTYPE ELSE ATYPE ; 08493890 END ; 08493900 END ; 08493910 EXIT: 08493920 END OF FILEATTRIBUTEHANDLER ; 08493930 PROCEDURE SPACESTMT; 08494000 BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000 SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000 FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000 PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000 FOR THE READ STATEMENT; 08499000 LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000 EXECUTABLE STATEMENT IN SPACESTMT; 08501000 STEPIT; 08502000 IF CHECK(LEFTPAREN,434) 08503000 THEN GO TO EXIT; 08504000 COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000 SPACE STATEMENT; 08506000 STEPIT; 08507000 IF NOT RANGE(FILEID,SUPERFILEID) 08508000 THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000 IDENTIFIER IN SPACE STATEMENT; 08510000 ERROR(435); GO TO EXIT; 08511000 END; 08512000 EMITO(MKS); 08513000 EMITPAIR(GNAT( 08514000 POWERSOFTEN),LOD); PASSFILE; 08515000 EMITL(0); 08515100 IF CHECK(COMMA,436) 08516000 THEN GO TO EXIT; 08517000 COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000 STEPIT; AEXP; 08519000 IF CHECK(RTPAREN,437) 08520000 THEN GO TO EXIT; 08521000 COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000 SPACE STATEMENT; 08523000 EMITL(0); EMITL(0); EMITL(1); 08524000 HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000 EXIT:; 08526000 END SPACESTMT; 08527000 PROCEDURE WRITESTMT; 08528000 BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000 INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000 DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000 I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000 WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000 ARE PASSED TO INTERPTO. 08534000 **********************************************************08535000 FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000 UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000 READSTMT ROUTINE. 08538000 ::= [DBL]/[PAGE]/[NO]// 08540000 CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000 TO CIMI FOR INPUT. 08542000 [DBL] [PAGE] [NO] 08543000 CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000 LINESKIP 1 2 4 8 0 08545000 WRITE()/ 08546000 - - - - - - - - - - - - - - 08547000 (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000 WRITE(,)/ 08550000 - - - - - - - - - - - - - - 08551000 (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000 INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000 WRITE(,,)/08555000 - - - - - - - - - - - - - - 08556000 (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000 INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000 WRITE(,*,)/ 08560000 - - - - - - - - - - - - - - 08561000 (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000 ROUTINE DESCRIPTOR) 08563000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000 WRITE((CARRIAGE CONTROL>,,) 08566000 - - - - - - - - - - - - - - 08567000 (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 08568000 ROW DESCRIPTOR) 08569000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08570000 LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08571000 EXECUTABLE STATEMENT IN WRITESTMT; 08572000 LABEL CHKSECOND; COMMENT I IS NOW POINTING AT THE COMMA 08573000 SEPARATING THE FIRST AND SECOND 08574000 PARAMETERS; 08575000 LABEL ONEPARENSH; COMMENT I IS POINT AT THE RIGHT 08576000 PARENTHESIS AT THIS POINT AND I HAVE 08577000 JUST DISCOVERED THAT THIS IS THE ONE 08578000 PARAMETER CASE; 08579000 DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000 TEMPORARY CELL FOR ACCUM[1]; 08581000 %VOID 08582000 %VOID 08583000 %VOID 08584000 %VOID 08585000 LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000 PRECEEDING THE LIST WHEN THIS LABEL IS 08587000 REACHED; 08588000 LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000 DELIMITER. THE CODE AT EMITCALL EMITS THE08590000 CODE TO CALL INTERPTO; 08591000 LABEL CHKRTPAREN; 08591100 LABEL WRITXFORM; 08591200 INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 BOOLEAN LOCKTOG,ARC; 08591600 INTEGER HOLD;% 08591700 IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000 IF CHECK(LEFTPAREN,438) 08593000 THEN GO TO EXIT; 08594000 COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000 WRITE STATEMENT; 08596000 EMITO(MKS); 08597000 IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08597100 BEGIN VARIABLE(FL); 08597200 IF TABLE(I-2) ! FACTOP THEN 08597300 BEGIN ERR(439); GO TO EXIT END; 08597400 ARC ~ TRUE; HOLD ~ L; 08597450 EMIT(11); EMIT(4); EMITO(280); 08597500 EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600 EMITO(XCH); 08597700 END ELSE 08597800 BEGIN 08597900 IF NOT RANGE(FILEID,SUPERFILEID) 08598000 THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000 IDENTIFIER IN A WRITE STATEMENT; 08600000 ERR(439); GO TO EXIT; 08601000 END; 08602000 08603000 EMITPAIR(GNAT( 08604000 POWERSOFTEN),LOD); PASSFILE; 08605000 END; 08605500 IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000 THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000 EMITL(0); EMITL(1); 08608000 IF RRB1 08609000 THEN GO CHKSECOND; 08610000 ONEPARENSH:STEPIT; EMITL(0); EMITL(0); 08611000 GOGOGO ~ NOT ARC;% 08611100 EMITL(0); GO EMITCALL; 08612000 END; 08613000 IF ELCLASS=LEFTPAREN THEN 08613100 BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200 IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300 EMITPAIR(0,LNG); 08613400 EMITD(33,33,15); EMIT(0); 08613500 IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN08613600 END; 08613700 IF CHECK(LFTBRKET,440) 08614000 THEN GO TO EXIT; 08615000 COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000 PARAMETER IN A WRITE STATEMENT; 08617000 STEPIT; 08618000 %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 %%% [DPN,],[*],[*,*],[*,],[],[,*] 08619010 %%% AND [,], WHERE DPN IN STOP, DBL, PAGE, OR 08619020 %%% NO. THE FIRST (LEFTMOST) IS THE CHANNELSKIP, 08619030 %%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND IS 08619040 %%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP,08619050 %%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP, 08619060 %%% *"S ARE CONSIDERED TO BE EMPTIES. 08619070 IF ACCUM1~IF ACCUM1~ACCUM[1]="3DBL00" THEN 2 ELSE 08619080 IF ACCUM1="4PAGE0" THEN 4 ELSE 08619090 IF ACCUM1="4STOP0" THEN 16 ELSE 08619095 IF ACCUM1="2NO000" THEN 8 ELSE 0!0 THEN %%% [DPN08620000 IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010 IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020 BEGIN EMITNO(ACCUM1); STEPIT END 08621000 ELSE IF ACCUM[1]="6UNLOC" THEN %%% [NS,UNLOCK 08621002 BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08621004 ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP08621010 ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020 ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000 IF STEPI=COMMA THEN %%% HAVE [*, 08622010 IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000 BEGIN EMITNO(1); STEPIT END 08624000 ELSE IF ACCUM[1]="6UNLOC" THEN %%% [*,UNLOCK 08624002 BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08624004 ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000 ELSE EMITNO(1) %%% HAVE ONLY [* 08626000 ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000 %% HAVE [AEXP 08627100 IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000 IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,*08629000 ELSE IF ACCUM[1]="6UNLOC" THEN %%% [AEXP,UNLOCK 08629002 BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08629004 ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A08630000 EMITL(0) ; %%% 0 IS NO DPN. 08631000 END ; 08632000 IF CHECK(RTBRKET,441) 08633000 THEN GO TO EXIT; 08634000 COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE08635000 CONTROL PART; 08636000 CHKRTPAREN:IF STEPI = RTPAREN 08637000 THEN GO TO ONEPARENSH; 08638000 IF CHECK(COMMA,442) 08639000 THEN GO TO EXIT; 08640000 COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000 DELIMITER IN A WRITE STATEMENT; 08642000 CHKSECOND:STEPIT; 08643000 IF RANGE(FRMTID,SUPERFRMTID) 08644000 THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 PASSFORMAT; 08646000 WRITXFORM: IF STEPI = RTPAREN 08647000 THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000 CASE OF THE WRITE; 08649000 STEPIT; EMITL(0); GO EMITCALL; 08650000 END; 08651000 GO PASSLIST; 08652000 END; 08653000 IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100 BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110 IF ELCLASS!MULOP THEN ERR(443) 08653120 ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125 IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130 BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140 ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150 GO TO PASSLIST ; 08653160 END 08653170 ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180 BEGIN EMITL(1) ; 08653190 IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195 IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200 BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210 ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220 GO TO PASSLIST ; 08653230 END OF SCANNING FOR FREE FIELD FORMAT ; 08653240 IF ELCLASS = FACTOP 08654000 THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;08655000 EMITL(0); EMITL(0); STEPIT; 08656000 GO PASSLIST; 08657000 END; 08658000 IF ACCUM[1]="1<0000" THEN 08658010 BEGIN EXPLICITFORMAT; GO TO WRITXFORM; END; 08658020 IF ARC THEN 08658100 BEGIN KLUDGE(-HOLD); 08658200 GO TO EXIT; 08658300 END ARRAY TO ARRAY CASE; 08658400 EMITL(0); AEXP; 08659000 IF CHECK(COMMA,443) 08660000 THEN GO TO EXIT; 08661000 COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000 PARAMETER IN WRITE STATEMENT; 08663000 STEPIT; 08664000 IF RANGE(BOOARRAYID,INTARRAYID) 08665000 THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 VARIABLE(FL); 08667000 IF TABLE(I-2) ! FACTOP 08668000 THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000 DESIGNATOR IN A WRITE STATEMENT; 08670000 ERROR(444); GO TO EXIT; 08671000 END; 08672000 IF CHECK(RTPAREN,445) 08673000 THEN GO TO EXIT; 08674000 COMMENT ERROR 445 MEANS MISSING RIGHT 08675000 PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000 STATEMENT; 08677000 GOGOGO ~ TRUE;% 08677100 STEPIT; GO EMITCALL; 08678000 END 08679000 ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000 ERROR(446); GO TO EXIT; 08681000 END; 08682000 PASSLIST:IF CHECK(COMMA,447) 08683000 THEN GO TO EXIT; 08684000 COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000 LIST IN A WRITE STATEMENT; 08686000 IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000 THEN BEGIN RR1~LISTGEN; GO TO EMITCALL END; 08688000 CHECKER(ELBAT[I]); 08688500 IF ELCLASS = SUPERLISTID THEN 08689000 BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000 LISTADDRESS~ELBAT[I].ADDRESS; 08692000 BANA; 08693000 EMITV(LISTADDRESS); 08694000 IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08694500 EMITO(LOD); 08695000 I~I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500 END ELSE 08696000 BEGIN COMMENT A COMMON LIST ID; 08696500 EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520 END; 08696530 STEPIT; 08696540 IF CHECK(RTPAREN,448( THEN GO TO EXIT; 08696550 COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560 STEPIT; 08697000 EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000 BEGIN EMITO(MKS); 08698100 IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200 IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300 BEGIN STEPIT; DEXP END; 08698400 IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500 EMITL(15); EMITV(5); STEPIT; 08698600 END;% 08698700 IF GOGOGO THEN% 08698750 BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800 EMIT(0); EMIT(0); EMITV(12);% 08698850 END ELSE EMITV(GNAT(INTERPTO));% 08698900 GOGOGO ~ FALSE;% 08698950 EXIT:; 08699000 END WRITESTMT; 08700000 PROCEDURE LOCKSTMT; 08701000 BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000 CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000 FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000 **********************************************************08705000 ::=LOCK(,SAVE)/ 08706000 - - - - - - - - - - - - - - 08707000 (2,0,FILE,4) 08708000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000 LOCK(,RELEASE) 08710000 - - - - - - - - - - - - - - 08711000 (6,0,FILE,4); 08712000 LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08713000 EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000 DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000 FOR THE CURRENT L REGISTER; 08716000 DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000 L REGISTER SETTING FOR THE 08718000 SAVE OR RELEASE LITERAL THAT 08719000 GETS PASSED TO KEN MEYERS; 08720000 STEPIT; 08721000 IF CHECK(LEFTPAREN,45) 08722000 THEN GO TO EXIT; 08723000 COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 08724000 IN A LOCK STATEMENT; 08725000 STEPIT; 08726000 IF NOT RANGE(FILEID,SUPERFILEID) 08727000 THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000 IF NOT RANGE(BOOARRAYID,INTARRAYID) THEN 08728100 BEGIN ERR(451); GO TO EXIT END; 08728200 VARIABLE(FL); L ~ L-1; 08728300 IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400 EMITO(DUP); EMITO(LOD); EMITL(24); 08728500 EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000 GO TO EXIT 08730000 END; 08731000 PASFILE; 08732000 IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08732100 RELEASEV ELSE 08732200 IF CHECK(COMMA,452) 08733000 THEN GO TO EXIT; 08734000 COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT08735000 ; 08736000 THISL~L; L~LTEMP; 08737000 IF(RRB1~STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000 ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000 THEN EMITL(IF RRB1 08740000 THEN 6 08741000 ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000 ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000 DISPOSITION PART; 08744000 ERROR(453); GO TO EXIT; 08745000 END; 08746000 L~THISL; 08747000 STEPIT; 08748000 IF CHECK(RTPAREN,454) 08749000 THEN GO TO EXIT; 08750000 COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000 LOCK STATEMENT; 08752000 STEPIT; 08753000 EXIT:; 08754000 END LOCKSTMT; 08755000 PROCEDURE CLOSESTMT; 08756000 BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000 CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000 FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000 **********************************************************08760000 ::=CLOSE(,SAVE)/ 08761000 - - - - - - - - - - - - - - 08762000 (3,0,FILE,4) 08763000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000 CLOSE(,RELEASE)/ 08765000 - - - - - - - - - - - - - - 08766000 (7,0,FILE,4) 08767000 ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000 CLOSE(,*) 08769000 - - - - - - - - - - - - - - 08770000 (1,0,FILE,4) 08771000 ::= CLOSE(, PURGE) 08771100 -- -- -- -- -- --- -- -- -- -- -- -- 08771200 (4,0,FILE,4) 08771300 ** ** ** ** ** ** *** ** ** ** ** ** ; 08771400 LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08772000 EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE; 08773000 DEFINE THISL = RR1#; COMMENT THUSL IS A TEMP CELL 08774000 FOR THE CURRENT LREGISTER; 08775000 DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08776000 L REGISTER SETTING FOR THE 08777000 SAVE OR RELEASE LITERAL THAT 08778000 GETS PASSED TO KEN MEYERS; 08779000 LABEL EMITREST; COMMENT I IS POINTING AT THE UNIT 08780000 DISPOTION PART AND CODE FOR THE LAST THREE08781000 PARAMETERS TO THE FILE CONTROL ROUTINE 08782000 MUST NOW BE GENERATED; 08783000 STEPIT; 08784000 IF CHECK(LEFTPAREN,455) 08785000 THEN GO TO EXIT; 08786000 COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 08787000 CLOSE STATEMENT; 08788000 STEPIT; 08789000 IF NOT RANGE(FILEID,SUPERFILEID) 08790000 THEN BEGIN COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A08791000 CLOSE STATEMENT; 08792000 ERROR(456); GO TO EXIT; 08793000 END; 08794000 PASFILE; 08795000 IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08795100 RELEASEV ELSE 08795200 IF CHECK(COMMA,457) 08796000 THEN GO TO EXIT; 08797000 COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000 STATEMENT; 08799000 THISL~L; L~LTEMP; 08800000 IF STEPI = RELEASEV 08801000 THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000 EMITL(7); GO EMITREST; 08803000 END; 08804000 IF ELCLASS = FACTOP 08805000 THEN BEGIN COMMENT ASTERISK UNTI DISPOSITION PART CASE; 08806000 EMITL(1); GO EMITREST; 08807000 END; 08808000 IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000 THEN BEGIN COMMENT SAVE UNIT DISPOSITION PART CASE; 08810000 EMITL(3); GO EMITREST; 08811000 END; 08812000 IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100 EMITL(4); GO EMITREST; 08812200 END; 08812300 ERROR(458); GO TO EXIT; 08813000 COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000 IN A CLOSE STATEMENT; 08815000 EMITREST:STEPIT; 08816000 L~THISL; 08817000 IF CHECK(RTPAREN,459) 08818000 THEN GO TO EXIT; 08819000 COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000 CLOSE STATEMENT; 08821000 STEPIT; 08822000 EXIT:; 08823000 END CLOSESTMT; 08824000 PROCEDURE RWNDSTMT; 08825000 BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000 CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000 FOLLOWING PARAMETERS. 08828000 **********************************************************08829000 ::=REWIND() 08830000 - - - - - - - - - - - - - - 08831000 (0,0,FILE,4); 08832000 LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08833000 EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000 DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08835000 FOR THE CURRENT L REGISTER; 08836000 DEFINE LTEMP = RR2#; COMMENT LTEMP SETTING FOR THE08837000 L REGISTER SETTING FOR THE 08838000 SAVE OR RELEASE LITERAL THAT 08839000 GETS PASSED TO KEN MEYERS; 08840000 STEPIT; 08841000 IF CHECK(LEFTPAREN,460) 08842000 THEN GO TO EXIT; 08843000 COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000 REWIND STATEMENT; 08845000 STEPIT; 08846000 IF NOT RANGE(FILEID,SUPERFILEID) 08847000 THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A08848000 REWIND STATEMENT; 08849000 ERROR(461); GO TO EXIT; 08850000 END; 08851000 PASFILE; 08852000 IF CHECK(RTPAREN,462) 08853000 THEN GO TO EXIT; 08854000 COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000 REWIND STATEMENT; 08856000 STEPIT; THISL~L; L~LTEMP; 08857000 EMITL(0); L~THISL; 08858000 EXIT:; 08859000 END RWNDSTMT; 08860000 PROCEDURE EXPLICITFORMAT; 08860050 BEGIN INTEGER PRT; ARRAY TEDOC[0:7,0:127]; 08860100 MOVECODE(TEDOC,EDOC); 08860150 GT5:=SGNO; GT1:=(2|SGAVL-1)&2[4:46:2]; SGNO:=SGAVL; 08860200 F := 0; PRT := GETSPACE(TRUE,-4); % FORMAT DESCR. 08860250 PRT := PROGDESCBLDR(LDES,0,PRT); 08860300 ELCLASS := "<"; TB1 := FORMATPHRASE; 08860350 SEGMENT(-F,SGNO,GT5); SGAVL := SGAVL+1; 08860400 SGNO := GT5; MOVECODE(TEDOC,EDOC); 08860450 IF LASTELCLASS ! ">" THEN ERR(136); 08860500 IF ELCLASS = "," THEN ELBAT[I].CLASS := COMMA ELSE 08860600 IF ELCLASS = ")" THEN ELBAT[I].CLASS := RTPAREN ELSE 08860650 ELBAT[I].CLASS := 0; I:=I-1; 08860700 EMITL(0); EMITPAIR(PRT,LOD); 08860750 END EXPLICITFORMAT; 08860800 COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 08861000 AND CALL SORTI, PASSING THE FOLLOWING: 08862000 SORT: MERGE: 08863000 0 DISK SIZE,IF SPECIFIED 08864000 0 CORE SIZE,IF SPECIFIED 08865000 0 0 ALFA FLAG 08866000 RECORD SIZE 08867000 PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 08868000 PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 08869000 ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000 TP5 FL7 SCRATCH TAPES FOR SORT, 08872000 TP4 FL6 OR MERGE FILES, POINTERS TO 08873000 TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000 TP2 FL4 IF NOT USED. 08875000 TP1 FL3 08876000 0 FL2 DISK FILES FOR SORT 08877000 DK0 FL1 08878000 0/1 0 TRUE IF INPUT PROCEDURE 08879000 0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000 INF 0 POINTER TO I/O DESC FOR INPUT 08881000 OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000 OF WORK ARRAY. 08883000 PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000 PD/0 PD/0 OUTPUT PROCEDURE 08885000 0 0 08886000 0 0 08887000 0 0 08888000 LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000 0 0 08890000 0 1 SORT/MERGE FLAG 08891000 ... MSCW 08892000 0 SORT-FILE MOTHER 08893000 0 DESCRIPTORS 08894000 0 " 08895000 0 " 08896000 0 " 08897000 0 " 08898000 MSCW; 08900000 PROCEDURE MERGESTMT; 08901000 BEGIN INTEGER J,K,FILER,FILEND; 08902000 BOOLEAN OPTOG; 08903000 LABEL QUIT; 08904000 STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000 EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000 EMIT(0); EMIT(0); EMIT(0); 08907000 IF OPTOG~(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000 ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000 EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000 EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I+I-1 END ELSE 08911000 EMITN(GNAT(SORTA)); 08911100 IF NOT COMMACHECK THEN GO QUIT; 08912000 EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000 FILE~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000 EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000 IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000 EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000 AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000 FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000 BEGIN STEPIT; PASSFILE END; 08920000 FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000 IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000 EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000 IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000 EMIT(0); EMIT(0); EMIT(0); 08925000 QUIT: EMITV(GNAT(SORTI)); 08926000 END MERGESTMT; 08927000 PROCEDURE SORTSTMT; 08928000 BEGIN BOOLEAN INPRO,OUTPRO; 08929000 INTEGER A,J; 08930000 LABEL QUIT; DEFINE RDS=1,280#; 08931000 STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000 VALUE FN, SFN ; 08933000 BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000 SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000 DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000 DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000 DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000 END STUFFILE; 08939000 BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000 IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000 IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100 IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000 IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000 INPROCHECK~TRUE; 08944000 IF SFILENO=0 THEN 08945000 BEGIN SFILENO~FILENO; 08946000 FOR J~1 STEP 1 UNTIL 7 DO 08947000 IF MKABS(IDARRAY[127]); OCT1340000250002662, COMMENT }; 09201000 OCT1350000200000000, COMMENT +; OCT0000000000000000, 09202000 OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 09203000 OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT (; 09204000 OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT ~; 09205000 OCT1360001000000000, COMMENT |; OCT0000000000000000, 09206000 OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT *; 09207000 OCT1350000600000000, COMMENT -; OCT1240000000160000, COMMENT ); 09208000 OCT0620000000000000, COMMENT .,; OCT1340010250003470, COMMENT {; 09209000 OCT0000000000000000, OCT1360002000000000, COMMENT /; 09210000 OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 09211000 OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT =; 09212000 OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 09213000 0,0; 09214000 COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;09214100 FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 09214105 OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 09214110 OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115 OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 09214120 OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 09214125 OCT0030000170000000, "3NEQ00", 09214130 OCT0030000200000000, "3LEQ00", 09214135 OCT0030000210000000, "3LSS00", 09214140 OCT0030000220000000, "5TIMES", 09214145 OCT0030000230000000, "5INPUT", 09214150 OCT0030000240000000, "2IO000", 09214155 OCT0030000250000000, "6SERIA","L0000000", 09214160 OCT0030000260000000, "6RANDO","M0000000", 09214165 OCT0030000270000000, "6UPDAT","E0000000", 09214170 OCT0030000300000000, "6OUTPU","T0000000", 09214180 OCT0030000310000000, "7CANTU","SE000000", 09214190 OCT0130000000740000, "3MIN00", OCT0000000003200000,%549 09214200 OCT0130000001040000, "5DELAY", OCT0000000003300000,%552 09214210 OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%555 09214220 OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%559 09214230 OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%563 09214240 OCT0000000000040000, "5DCPWR", OCT0000000005600000,%567 09214250 OCT0000000000040000, "5DCMTH", OCT0000000005500000,%570 09214255 OCT0130000001140000, "5DSQRT", OCT0000000012300000,%573 09214260 OCT0130000001240000, "4CEXP0", OCT0000000010000000,%576 09214270 OCT0130000001340000, "3CLN00", OCT0000000010200000,%579 09214295 OCT0130000001440000, "4CSIN0", OCT0000000010600000,%582 09214300 OCT0130000001540000, "4CCOS0", OCT0000000011000000,%585 09214305 OCT0130000001640000, "5CSQRT", OCT0000000012400000,%588 09214310 OCT0130000001740000, "4DEXP0", OCT0000000007700000,%591 09214315 OCT0130000002040000, "3DLN00", OCT0000000010100000,%594 09214320 OCT0130000002140000, "4DSIN0", OCT0000000010500000,%597 09214325 OCT0130000002240000, "4DCOS0", OCT0000000010700000,%600 09214330 OCT0130000002360000, "7DARCT","AN0000000", OCT0000000011300000,%603 09214340 OCT0130000002460000, "6DLOG1","000000000", OCT0000000010400000,%607 09214345 OCT0130000002560000, "8DARCT","AN2000000", OCT0000000011500000,%611 09214350 OCT0130000002640000, "4DMOD0", OCT0000000006500000,%615 09214355 OCT0130000002740000, "4CABS0", OCT0000000005300000,%618 09214360 OCT0130000003060000, "7ARCTA","N20000000", OCT0000000011400000,%621 09214365 OCT0130000003160000, "6DROUN","D00000000", OCT0000000006100000,%625 09214370 OCT0130000000040000, "5LOG10", OCT0000000010300000,%629 09214375 OCT0130000000040000, "5COTAN", OCT0000000011200000,%632 09214380 OCT0130000000060000, "6ARCSI","N00000000", OCT0000000011600000,%635 09214385 OCT0130000000040000, "5ARCOS", OCT0000000011700000,%639 09214390 OCT0130000000040000, "4SINH0", OCT0000000012000000,%642 09214395 OCT0130000000040000, "4COSH0", OCT0000000012100000,%645 09214400 OCT0130000000040000, "4TANH0", OCT0000000012200000,%648 09214405 OCT0130000000040000, "3ERF00", OCT0000000012500000,%651 09214410 OCT0130000000040000, "5GAMMA", OCT0000000012600000,%654 09214415 OCT0130000000040000, "5LNGAM", OCT0000000012700000,%657 09214420 OCT0130000000040000, "3TAN00", OCT0000000011100000,%660 09214425 OCT0130000260000000, "4FAST0", %663 09214426 OCT0130000270000000, "4SLOW0", %665 09214427 OCT0130000240000000, "7PROTE", "CT000000", %667 09214428 OCT2000000000004050, COMMENT POWERS OF TEN ; %670 09214430 OCT0430000250000000, "5FIELD", %671 09214432 0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %673 09214435 " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %674 09214440 COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500 FOR NEXTINFO~512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510 ,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,635, 09214515 639 STEP 3 UNTIL 660,663 STEP 2 UNTIL 667, 671 %117-09214516 DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], 09214520 LASTINFO~STACKHEAD[GT2]~NEXTINFO); 09214530 NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980 BUILDLINE.[45:1]~TRUE ; 09214985 PUTNBUMP(0); 09214990 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 TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010 "[# ", 09251020 "]# ", 09251030 "># ", 09251040 "}# ", 09251050 "=# ", 09251060 "!# ", 09251070 "{# ", 09251080 "<# ", 09251090 "|# ", 09251100 "1# ", 09251101 "3# ", 09251102 "0# ", 09251103 "1# ", 09251104 "2# ", 09251105 "2# ", 09251106 "0# " 09251107 ; 09251200 NEXTTEXT~26 ; 09251300 DO UNTIL STEPI = BEGINV; 09252000 BUILDLINE.[45:1]~FALSE; 09252050 09252100 COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000 THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000 LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000 AND IS ALSO USED AS A ONE SYLLABLE 09256000 CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000 ITS PRIMARY FUNCTION IS TO CUT BACK 09258000 THE STACK AFTER A COMMUNICATE OPERATOR. 09259000 MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000 IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000 C-RELATIVE ADDRESSING FOR CONSTANTS 09262000 IN THE PROGRAM STREAM 09263000 OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000 THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000 LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000 CELL.AT THE START OF COMPILATION XXXX IS 09267000 ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000 IT IS CHANGED BEFORE COMPILATION IS 09269000 COMPLETE TO LOOK LIKE A WORD MODE 09270000 PROGRAM DESCRIPTOR; 09271000 EMITL(0);EMIT0(MKS); 09272000 GT1~PROGDESCBLDR(3,0,0); 09273000 GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000 INSERTCO:=1; %107-09274100 ERRORTOG~TRUE; BLOCK(FALSE); 09275000 COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100 THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200 THE END. CARD OFF AN INPUT TAPE; 09275250 IF NEWTOG THEN 09275300 BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350 "D ON OCR","DING TAPE","E ", " "," ", 09275400 " ","999999999"; 09275450 WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500 END; 09275550 09275600 09275700 09275750 09275800 09275850 09275900 09275950 09276000 COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000 WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000 USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000 THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000 IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000 PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000 INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000 ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000 FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 09285000 INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000 THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000 PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000 DRUM ADDRESSES TO THE INTRINSICS; 09289000 09290000 GT1 ~ GT3 ~ STARTINTRSC; 09291000 L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000 IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000 BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000 BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000 GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000 | 2 + 1, 0, GT2.ADDRESS); 09296100 PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000 & SGNO[28:38:10] & 1[2:47:1]; 09298100 PDINX ~ PDINX + 1; 09299000 IF PRTOG THEN % WRITE OUT INTRINSICS USED. 09300000 BEGIN GT3 ~ GT3 + 1; 09300100 BLANKET(14,LIN); % BLANK BUFFER. 09300150 WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200 B2D(GT2.[38:10]), LIN); 09301000 IF NOHEADING THEN DATIME; WRITELINE; 09302000 END 09303000 END; 09304000 GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000 GO TO L1; 09305100 END; 09306000 L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100 EMITL(5);EMITO(COM); 09307000 ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100 SEGMENT((L+3) DIV 4,1,0); 09308000 COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000 AT THIS TIME AS A TYPE 2 SEGMENT; 09310000 IF GT1~GT2.ADDRESS!0 THEN 09311000 BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000 GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000 MOVE(69,TEN,EDOC[0,0]); 09314000 BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100 SEGMENT(-69, SGNO,0); 09315000 BUILDLINE ~ BUILDLINE.[46:1] ; 09315100 END; 09316000 BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000 INTEGER PRTADR,SEGMNT,LINK; 09318000 COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000 09334000 09335000 09336000 09337000 09338000 09339000 09340000 09341000 09342000 09343000 09344000 09345000 09346000 09347000 FOR I~0 STEP 1 UNTIL PDINX DO 09348000 IF (GT1~PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000 BEGIN PR[ADR~GT1.[8:10]; SEGMNT~GT1.[28:10]; 09350000 LINK~SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000 MDESC(GT1.[18:10]&SEGMNT[18:33:15] 09352000 &(IF LINK=0 THEN SEGMNT+2048 ELSE LINK) 09353000 [6:36:12]>1[4:4:2]&5[1:45:3], 09354000 PRT[PRTADR DIV 128,PRTADR MOD 128]); 09354100 SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]~PRTADR; 09355000 END ELSE 09356000 BEGIN SEGMNT~GT1.[28:10]; 09357000 SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]~ 09358000 SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]>1[23:38:10] 09359000 & GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 09360000 END; 09361000 COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX~AKKUM; 09361005 COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 09361010 GTI1~0; 09361020 COMMENT ADD IN ARRAYS; 09361030 GTI1~GTI1+( IF NOOFARRAYS =0 THEN 0 ELSE IF NOOFARRAYS{4 09361040 THEN 2000 ELSE IF NOOFARRAYS { 8 THEN 3500 09361050 ELSE 5000); 09361060 COMMENT ADD IN SEGMENT SIZE REQUIREMENTS; 09361070 GTI1~GTI1+ (IF NEWINX { 1000 THEN NEWINX ELSE IF NEWINX{2000 09361080 THEN 1000 ELSE NEWINX/2); 09361100 COMMENT ADD IN STACK AND PRT; 09361110 GTI1~GTI1+ 512 + PRTIMAX; 09361120 COMMENT ADD IN JRT; 09361130 GTI1~GTI1 + ( (FILENO +1)| 5); 09361140 COMMENT ADD IN I/O BUFFER REQUIREMENTS; 09361150 GTI1~GTI1+IOBUFFSIZE; COMMENT I/O SIZE CAL. IN P.IODEC; 09361160 COMMENT ADD SEGMENT DICT.SIZE; 09361170 GTI1~GTI1+ SGAVL-1; 09361180 COMMENT ADD IN CORE ESTIMATE FOR SORT; 09361181 GTI1:=GTI1+CORESZ; 09361182 COMMENT CHECK IF TOTAL IS MORE THAN 8 MODS; 09361190 IF GTI1 } 32000 THEN GTI1~ 32000; 09361200 COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 09361210 COMMENT WRITE OUT FILE PARAMETER BLOCK; 09393000 GTI1~MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000 MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000 ZEROUT(IDARRAY[0],0,30); 09395500 IDARRAY[4]:=MOVEANDBLOCK(EDOC,GT1,0); %106-09396000 IDARRAY[5]~GT1; 09397000 COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000 IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); %106-09399000 IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100 (LDICT,SGAVL,2)[18:33:15]; %106-09399150 IDARRAY[1]~SGAVL; 09400000 COMMENT WRITE OUT PRT; 09401000 IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); %106-09402000 IDARRAY[3]~PRTIMAX; 09403000 COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000 IDARRAY[6]~1; 09405000 COMMENT PASS NUMBER OF FILES; 09405100 IDARRAY[7] ~ (FILENO-1)>I1[18:27:15]; 09405200 COMMENT WRITE DISK SEGMENT ZERO; 09406000 GT1:=DA; DA:=0; MOVE(30,IDARRAY[0],PRT[0,0]); %106-09407000 GT2:=MOVEANDBLOCK(PRT,30,6); DA:=GT1; %106-09407010 IF CODEFILE THEN WRITE(LINE); %106-09407020 IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050 LOCK(CODE,SAVE); 09407100 CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. %119-09407200 CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. %119-09407300 LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. %119-09407400 IF LISTER OR NOT NOHEADING THEN 09408000 BEGIN FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT"09409000 ,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000 "PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000 " WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000 I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 09413000 /"ESTIMATED AUXILIARY MEMORY REQUIRED =",I6," WORDS.", 09414000 /"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 09414100 FOMRAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 09414101 MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4);09415000 MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4);09416000 IF CHECKTOG THEN 09416001 WRITE(LINE[DBL] ,SERR,IF NUMSEQUENCEERRORS = 0 09416002 THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004 THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006 WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2,09417000 PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000 DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000 END END END PROGRAM; 09420000 COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000 COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000 FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000 WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000 ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000 RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000 STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000 EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000 THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000 TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000 S = [1:1], 10010000 REPEAT = [38:10], 10011000 SKIP = [32:6], 10012000 CODE = [2:4], 10013000 W = [6:6], 10014000 W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000 S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000 TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000 BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000 WORDS. GIVEN S = 1 WE HAVE: 10019000 IF CODE = 0 THEN RIGHTPAREN, 10020000 IF CODE = 2 THEN STRING, 10021000 IF CODE = 4 THEN LEFTPAREN, 10022000 IF CODE = 6 THEN STROKE, 10023000 IF CODE = 8 THEN SCALE. 10023100 GIVEN S = 0 WE HAVE 10024000 IF CODE = 0 THEN D, 10025000 IF CODE=1 THEN T, 10025010 IF CODE = 2 THEN X, 10026000 IF CODE = 4 THEN A, 10027000 IF CODE = 6 THEN I, 10028000 IF CODE = 8 THEN F, 10029000 IF CODE =10 THEN E, 10030000 IF CODE = 11 THEN U, 10030100 IF CODE =12 THEN O, 10031000 IF CODE = 13 THEN V, 10031100 IF CODE =14 THEN L, 10032000 IF CODE = 15 THEN R, 10032100 W IS THE FIELD WIDTH. 10033000 FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000 ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000 REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000 REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000 HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000 IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000 A NON-ZERO REPEAT FIELDS. 10040000 THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000 FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000 D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000 THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000 FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000 W2 = D1 = D2 =0. 10046000 FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010 W2=D1=D2=0. 10046020 FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000 W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000 FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000 IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000 IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000 FOR F IF D < 8 THEN D1 = D, D2=0, 10052000 IF D > 8 THEN D1 = 8, D2=D-8, 10053000 IF D >16 THEN ERROR. 10054000 IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000 SKIP=0. 10056000 IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000 IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000 FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000 D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000 FOR O, W1=W2=D1=D2=SKIP=0, 10061000 FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000 SKIP = W-W1, 10063000 FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100 FOR B: SEE U-PHRASE DESCRIPTION. 10063110 FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200 FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300 F-PHRASE DESCRIPTION. 10063400 FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000 WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000 BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000 IF IT NOTICES AN ERROR; 10067000 PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000 BEGIN 10069000 10070000 MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000 IF DEBUGTOG 10072000 THEN BEGIN 10073000 DEBUGWORD(B2D(F),W,LIN); 10074000 WRITELINE END; 10075000 IF (F~F+1) > 1024 THEN FLAG(307); 10076000 10077000 10078000 10079000 10080000 10081000 END WHIPOUT; 10082000 BOOLEAN PROCEDURE FORMATPHRASE; 10083000 BEGIN 10084000 LABEL EL,EX,EXIT,L1,L2,L3; 10085000 PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000 VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000 REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000 BOOLEAN S; 10089000 BEGIN IF W > 63 THEN FLAG(163); 10090000 W ~ REPEAT & W [ 6:42:6] 10091000 & SKIP [32:42:6] 10092000 & W1 [28:44:4] 10093000 & W2 [28:44:4] 10094000 & D1 [20:44:4] 10095000 & D2 [16:44:4] 10096000 & CODE [ 2:44:4] 10097000 & REAL(S) [ 1:47:1]; 10098000 WHIPOUT(W) END EMITFORMAT; 10099000 STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000 VALUE LETTER, CTR; 10101000 BEGIN DI ~ PLACE; DS ~ LIT "B"; 10102000 SI ~ LOC CTR; SI ~ SI+7; DS ~ CHR; 10103000 SI ~ PLACE; SI ~ SI+3; DS ~ 5 CHR; 10104000 SI ~ LOC LETTER; SI ~ SI+7; DS ~ CHR END PACKALPHA; 10105000 INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000 DEFINE RRIGHT = 0#, 10107000 RLEFT = 4#, 10108000 RSTROKE = 6#; 10109000 DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500 DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000 RT=1 #, 10110010 RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000 IF ELCLASS < 0 THEN BEGIN REPEAT ~ -ELCLASS;NEXTENT; 10112000 IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100 ELSE BEGIN REPEAT:=REAL(ELCLASS!"<"); 10113000 IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100 NEXTENT; 10113200 END END; 10113300 IF ELCLASS="(" OR ELCLASS="<" 10114000 THEN BEGIN 10115000 SKIP ~ F; 10116000 EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000 DO BEGIN NEXTENT; 10118000 EL: IF FORMATPHRASE THEN GO TO EX END 10119000 UNTIL ELCLASS ! ","; 10120000 WHILE ELCLASS = "/" 10121000 DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000 NEXTENT END; 10123000 IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000 THEN GO TO EL; 10124100 IF LASTELCLASS = "," THEN GO TO EX; 10124200 IF REPEAT = 0 THEN 10125000 EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000 REPEAT~F-SKIP; F~SKIP; 10127000 WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100 F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200 ELSE IF ELCLASS = "0" 10128000 THEN BEGIN CODE~RO; W~8 END 10129000 ELSE IF ELCLASS = "D" 10130000 THEN BEGIN CODE~RD; W~8 END 10131000 ELSE IF ELCLASS = "," THEN GO TO L2 10132000 ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000 ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 10134000 IF LASTELCLASS="," THEN GO EX ELSE GO EXIT 10134100 ELSE IF ELCLASS = "S" THEN 10134500 BEGIN 10134510 NEXTENT; 10134520 W ~ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530 IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540 IF ELCLASS="*" THEN REPEAT.[12:1]~1 ELSE 10134545 IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550 GO TO EXIT 10134560 END 10134570 ELSE REPEAT ~ - ELCLASS; 10134580 EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590 GO TO L2 10134600 END 10134610 ELSE IF ELCLASS = """ 10135000 THEN BEGIN 10136000 IF REPEAT ! 1 THEN FLAG(136); 10136500 CODE ~ 100; 10137000 DO BEGIN 10138000 SKIP ~ 1; 10139000 DO BEGIN RESULT ~ 5; COUNT ~ 0; SCANNER; 10140000 IF ELCLASS ~ ACCUM[1].[18:6] = CODE 10141000 THEN BEGIN 10142000 IF SKIP ! 1 THEN WHIPOUT(W); 10143000 GO TO L2 END; 10144000 CODE ~ """; 10145000 PACKALPHA(W,ELCLASS,SKIP); 10146000 END UNTIL SKIP ~ SKIP+1 = 7; 10147000 WHIPOUT(W) 10148000 END UNTIL FALSE END 10149000 ELSE BEGIN CODE~ELCLASS; 10150000 IF CODE = "U" OR CODE = "B" THEN 10150100 BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 10150110 NEXTENT ; 10150120 SKIP ~ 0 ; 10150125 IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150130 BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135 IF ELCLASS = "*" THEN REPEAT.[13:1] ~ 1 10150140 ELSE W ~ -ELCLASS ; 10150145 NEXTENT ; 10150150 IF ELCLASS = "." THEN 10150155 BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 10150160 NEXTENT ; 10150165 IF ELCLASS = "*" OR ELCLASS{0 THEN 10150170 BEGIN %%% PHRASE IS UW*.D*. 10150175 IF ELCLASS = "*" THEN REPEAT.[14:1]~1 10150185 ELSE SKIP ~ -ELCLASS ; 10150190 NEXTENT ; 10150195 END 10150200 ELSE GO TO EX 10150205 END 10150210 END 10150215 ELSE W ~-63 ; %%% PHRASE IS D. 10150220 EMITFORMAT(FALSE,RD,REPEAT,SKIP,W,REAL(CODE="B"), 10150225 REAL(W<0),0,0) ; 10150230 GO TO EXIT ; 10150260 END OF U PHRASE HANDLER ; 10150270 IF GETINT THEN BEGIN W~11; REPEAT.[13:1]~1 END 10150280 ELSE ELCLASS := -(W := ELCLASS); 10150290 IF CODE = "I" 10151000 THEN BEGIN 10152000 SKIP ~ DIVIDE(W,W1,W2); CODE ~ RI END 10153000 ELSE IF CODE = "F" 10154000 THEN BEGIN CODE ~ RF; GO TO L1 END 10155000 ELSE IF CODE = "R" THEN BEGIN CODE ~ RR; GO TO L1 END 10155500 ELSE IF CODE = "E" 10156000 THEN BEGIN CODE ~ RE; D1~1; 10157000 L1: NEXTENT; 10158000 IF ELCLASS!"." THEN GO EX; 10159000 IF GETINT THEN BEGIN ELCLASS~3; REPEAT.[14:1]~1 END; 10159100 IF DIVIDE(ELCLASS+D1,D1,D2) > 0 THEN GO TO EX; 10160000 IF CODE = RF OR CODE = RR THEN 10161000 SKIP ~ DIVIDE(W-ELCLASS-1,W1,W2) 10161500 ELSE IF SKIP ~ W-ELCLASS-6 < 0 THEN GO TO EX END 10162000 ELSE IF CODE = "X" 10163000 THEN BEGIN CODE ~ RX; W1 ~ W.[38:4]; 10164000 SKIP ~ W ~ W.[42:6] END 10165000 ELSE IF CODE="T" THEN IF W~ABS(W)-1<0 THEN FLAG(136) 10165500 ELSE BEGIN CODE~RT; W1~W.[38:4]; W~W.[42:6] END 10165505 ELSE IF CODE = "A" 10166000 THEN BEGIN CODE ~ RA; W1 ~6; GO TO L3 END 10167000 ELSE IF CODE="V" THEN 10167100 BEGIN CODE ~ RV ; 10167200 COUNT~ACCUM[1]~0; 10167300 IF EXAMIN(NCR)=" " THEN 10167400 BEGIN RESULT~7; SCANNER END; 10167500 IF EXAMIN(NCR)="." THEN 10167600 BEGIN NEXTENT; 10167700 IF GETINT THEN REPEAT.[14:1]~1 ELSE 10167800 GT1~DIVIDE(ELCLASS,D1,D2); 10167900 ELCLASS :=-ELCLASS; 10167910 END; END ELSE IF CODE="L" 10168000 THEN BEGIN CODE ~ RL; W1 ~ 5; 10169000 L3: IF W 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 ~ 2048 END 10248000 ELSE REMCOUNT ~ REMCOUNT-COUNT; 10249000 GT1 ~ CHARCOUNT DIV 8 ~ NEXTTEXT; 10250000 PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3],10251000 COUNT,0,CHAR); 10252000 IF SKIPCOUNT ! 0 THEN 10253000 PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000 COUNT,CHAR); 10255000 CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END 10256000 END PUTOGETHER; 10257000 INTEGER LASTRESULT; 10258000 REAL K,N,ELCLASS; 10258100 DEFINE I=NXTELBT#; 10258200 LABEL FINAL,PACKIN; 10258300 LABEL BACK,SKSC,EXIT; 10259000 REAL DINFO; 10259200 BOOLEAN TSSTREAMTOG; % 1289 10259400 DINFO ~ J.[18:15]; 10259600 J ~ J.[33:15]; 10259700 TB1~ FALSE; 10260000 TSSTREAMTOG~ STREAMTOG; % 1289 10260050 STREAMTOG~TRUE; 10260100 CHARCOUNT ~ 0; 10261000 DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000 REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000 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 RESULT = 1 THEN IF J ! 0 THEN 10264600 FOR N ~ 1 STEP 1 UNTIL J DO 10264650 BEGIN 10264700 IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1]. 10264750 DEFINFO[(N-1)|10]) THEN 10264760 BEGIN 10264800 DEFINEPARAM(DINFO+1, N); 10264810 GO PACKIN; 10264820 END; 10264830 END; 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; STREAMTOG~TSSTREAMTOG; % 1289 10284000 NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 END DEFINEGEN; 10286000 COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000 ELEMENTS; 10288000 PROCEDURE LISTELEMENT; 10289000 BEGIN 10290000 REAL T1,T2,T3; 10291000 LABEL BOOFINISH,STORE,LRTS; 10292000 DIALA ~ DIALB ~ 0; 10293000 IF ELCLASS= FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000 ELSE IF ELCLASS = LFTBRKET 10295000 THEN BEGIN COMMENT GORUP OF LIST ELEMENTS; 10296000 DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000 IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 ELSE BEGIN COMMENT THE MEAT OF THE MATTER; 10299000 VARIABLES AND EXPRESSIONS; 10300000 L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000 EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000 NEXT TIME AROUND; 10303000 IF(GT1 ~ TABLE(I+1) = COMMA 10304000 OR GT1 = RTPAREN 10305000 OR GT1 = RTBRKET) 10306000 AND ELCLASS } BOOID AND ELCLASS { INTID 10307000 THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 CHECKER(ELBAT[I]); 10308100 EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 ELSE BEGIN IF ELCLASS } BOOARRAYID 10310000 AND ELCLASS { INTARRAYID 10311000 THEN BEGIN COMMENT IS EITHER A SUBSCRIPTED VARIABLE10312000 OR THE BEGINNING OF AN EXPRESSION. THIS10313000 SITUATION IS VERY SIMILAR TO THAT IN 10314000 ACTUALPARAPART (SEE COMMENTS THERE FOR 10315000 FURTHER DETAILS); 10316000 T2 ~ FL; T3 ~ ELCLASS; VARIABLE(T2); 10317000 IF TABLE(I-2)=FACTOP AND TABLE(I-1)=RTBRKET THEN ERR(157);10318000 IF ELCLASS = COMMA OR 10319000 ELCLASS = RTPAREN OR 10320000 ELCLASS = RTBRKET THEN 10321000 IF T2 = 0 THEN GO TO STORE ELSE GO TO LRTS; 10322000 IF T3 = BOOARRAYID THEN GO TO BOOFINISH; 10323000 SIMPARITH; 10324000 IF ELCLASS = RELOP THEN BEGIN RELATION; 10325000 BOOFINISH: SIMPBOO END END 10326000 ELSE IF EXPRSS = DTYPE THEN ERR(156); 10327000 STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000 LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000 T2 ~ L; L ~ T1; EMITNUM(T2-LSTR); L~T2 END END LSTELMT; 10330000 COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000 LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000 LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000 CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000 LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000 FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000 THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000 FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000 DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR, 10339000 LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000 LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000 VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000 ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000 REAL PROCEDURE LISTGEN; 10344000 BEGIN 10345000 INTEGER JUMPLACE,LISTPLACE; 10346000 JUMPLACE ~ BAE; 10347000 LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000 COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 EMITV(LSTRTN); EMITO(BFW); LSTR ~ L; 10350000 COMMENT INITIAL JUMP OF A LIST; 10351000 LISTMODE ~ TRUE; 10352000 COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000 I~I-1; 10354000 DO BEGIN 10355000 STEPIT; 10356000 LISTELEMENT 10357000 END UNTIL ELCLASS ! COMMA; 10358000 EMITL(1); EMITO(CHS); 10359000 EMITPAIR(LSTRTN,SND); 10360000 EMITO(RTS); 10361000 COMMENT SET END FLAG OF -1; 10362000 CONSTANTCLEAN; 10363000 DIALA ~ DIALB ~ 0; 10364000 LISTMODE ~ FALSE; 10365000 ADJUST; 10365100 EMITB(BFW,JUMPLACE,L); 10366000 STUFFF(LISTPLACE); 10367000 IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT 10368000 END LISTGEN; 10369000 BOOLEAN PROCEDURE MERRIMAC; 10370000 BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000 03 JULY 1963 10372000 THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000 LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,10374000 ARRAYS, AND FUNCTION DESIGNATORS. 10375000 WITH ONE EXCEPTION, THE MERRIMAX ROUTINES ONLY FUNCTION 10376000 IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE10377000 VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000 THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000 THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000 A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN10381000 ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000 ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000 THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000 INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000 FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000 EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000 AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000 POSSIBLE CALLS ON PRINTI. 10389000 ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000 THE IDENTIFIER TO BE PRINTED. 10391000 N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000 ARRAY OR SUBSCRIPTED VARIABLE. 10393000 V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000 S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000 PRINTED. 10396000 S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000 MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000 ONLY IF THEY ARE EQUAL. 10399000 FORMAT TYPE MONITOR DUMP 10400000 ----------- ------- ---- 10401000 0 LABELS 10402000 SWITCHES 10403000 --------- ----- -- 10404000 1 SIMPLE VARIABLES LABELS 10405000 FUNCTION SIMPLE VARIABLES 10406000 --------- ----- -- 10407000 2 ARRAYS SUBSCRIPTED VARS 10408000 --------- ----- -- 10409000 3 SUBSCRIPTED VARS 10410000 --------- ----- -- 10411000 4 ARRAYS 10412000 ********* ***** ** 10413000 FORMAT TYPE PRINTOUT 10414000 ----------- -------- 10415000 0 ID 10416000 --------- ----- 10417000 1 ID=V 10418000 --------- ----- 10419000 2 ID[S1---SN]=V 10420000 --------- ----- 10421000 3 ID[S1---SN]=V 10422000 --------- ----- 10423000 4 ID=V1---VN 10424000 *********** ******** 10425000 THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY10426000 THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000 PASSING THE TYPEV TO PRINTI. 10428000 TYPE TYPEV 10429000 ---- ----- 10430000 BOOLEAN 0 10431000 -- --- 10432000 REAL 1 10433000 -- --- 10434000 ALPHA 2 10435000 -- --- 10436000 INTEGER 3 10437000 **** ***** 10438000 POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000 AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000 FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000 ----------- --------------------------- 10442000 0 10443000 --------- ------------------------- 10444000 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000 --------- ------------------------- 10446000 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000 FILE,2) 10448000 --------- ------------------------- 10449000 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000 ,ID,CHARI,FILE,3) 10451000 --------- ------------------------- 10452000 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000 POWERSOFTEN,ID,CHARI,FILE,4) 10454000 *********** *************************** 10455000 SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000 MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000 THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000 THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000 ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000 ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000 MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000 MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000 WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000 MONITORING INFORMATION. 10465000 *********FORMAT OF INFO FOR MONITORED ITEMS**********10466000 ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000 WORD WILL BE SET. 10468000 SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000 ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000 THE MONITOR FILE IN [37:11], I WILL HAVE A 10471000 DEFINE SVARMONFILE = [37:11]#. 10472000 ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000 NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000 MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000 FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000 DEFINE ARRAYMONFILE = [27:11]#. 10477000 SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000 SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000 TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000 OF INFO CONTAINING LOWER BOUND INFORMATION10481000 ALSO CONTAINS MONITOR INFORMATION. EITHER10482000 A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000 IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000 DESIGNATES WHETHER AN OPDC OR A LITC 10485000 SHOULD BE GENERATED USING [12:11]. IF THE10486000 BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000 ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000 MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000 ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000 PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000 SI* TO THE PRINTI ROUTINE. 10492000 LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000 THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000 ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000 DEFINE LABLMONFILE = [13:11]#. 10496000 SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000 I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000 FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000 WITH THE SAME NUMBER OF WORDS AS THE 10500000 ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000 REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000 ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000 FUNCMONFILE = [27:11]#; 10504000 DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000 ADDRESS OF THE MONITOR FILE; 10506000 DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000 SAVE THE ADDRESS OR VALUE OF A 10508000 SUBSCRIPT. ONE ADDITIONAL BIT IS10509000 USED TO TELL WHETHER TO EMIT AN 10510000 OPDC OR A LITC ON THIS ADDRESS OR10511000 VALUE; 10512000 DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000 DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000 VARIABLE APPEARING IN A MONITOR LIST;10515000 DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000 ADDITIONAL INFO AND IS USED WHEN MAKING10517000 A NEW ENTRY IN INFO FOR ARRAYS; 10518000 DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000 ELBAT WORD FOR A MONITOR LIST 10520000 ELEMENT; 10521000 DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000 SUBSCRIPTED VARIABLES TO TELL ME 10523000 WHETHER TO EMIT AN OPDC OR A LITC.10524000 0 IS USED FOR OPDC, 1 FOR LITC; 10525000 DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000 POINTING AT THE END OF ADDITIONAL 10527000 INFO AND IS USED TO TELL WHEN TO 10528000 STOP MOVING INFO FOR THE NEW ENTRY10529000 FOR MONITORED ARRAYS; 10530000 DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000 LINK POINTING AT THE FIRST 10532000 ADDITIONAL WORD OF INFO FOR 10533000 MONITORED ARRAYS; 10534000 DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000 CONCATENATE DEFINE FOR 10536000 STUFFING THE MONITOR FILE 10537000 ADDRESS INTO THE FIRST 10538000 ADDITIONAL INFO WORD FOR 10539000 ARRAYS AND FUNCTIONS; 10540000 DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000 PARTIAL WORD DESIGNATOR [4010542000 :8] USED TO EXTRACT THE 10543000 NUMBER OF PARAMETERS FOR A 10544000 GIVEN PROCEDURE FROM INFO; 10545000 DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000 OF PARAMETERS FOR A FUNCTION 10547000 DESIGNATOR APPEARING IN A MONITOR 10548000 LIST; 10549000 LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000 POINTING AT THE FILE IDENTIFIER IN THE 10551000 MONITOR DECLARATION; 10552000 LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000 TURNS ON THE MONITOR BIT OF THE ELBAT10554000 WORD IN THE MONITOR LIST AND STORES 10555000 IT IN ACCUM[0] FOR THE E ROUTINE; 10556000 LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000 REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000 EACH SUBSCRIPT EXPRESSION; 10559000 LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000 POINTING THE LAST LOGICAL QUANTITY OF THE 10561000 MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000 PROCESSED; 10563000 LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000 START:IF ELCLASS!FILEID THEN 10565000 BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100 "6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200 ERR(400); GO EXIT; 10565300 END 10566000 COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000 CHECKER(ELBAT[I]); 10568000 FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000 IF CHECK(LEFTPAREN,401) 10570000 THEN GO TO EXIT; 10571000 COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000 MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000 IF RANGE(BOOID,INTID) 10574000 THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000 E; PUTNBUMP(FILEIDENT); 10576000 GO CHKCOMMA; 10577000 END; 10578000 IF RANGE(BOOARRAYID,INTARRAYID) 10579000 THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000 SUBSCRIPTED VARIABLES; 10581000 E; NXTINFOTEMP~NEXTINFO; 10582000 PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000 TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000 ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000 DO PUTNBUMP(TAKE(INC~INC+1)) 10586000 UNTIL INC } TESTVARB; 10587000 IF TABLE(I+1) ! LFTBRKET 10588000 THEN GO CHKCOMMA; 10589000 TESTVARB~NODIM+NXTINFOTEMP; 10590000 STEPIT; 10591000 STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000 STEPI ! NONLITNO 10593000 THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000 SUBSCRIPTED VARIABLES. EITHER A LITC 10595000 OR AN OPDC ON A VARIABLE IS ALL THAT 10596000 IS NEEDED TO CALL THE SUBSCRIPT; 10597000 SUBSCRIPT~ELBAT[I].ADDRESS; 10598000 OPLIT~0; 10598500 IF NOT RANGE( INTRNSICPROCID,INTID) 10599000 THEN IF CHECK(LITNO,402) 10600000 THEN GO TO EXIT 10601000 ELSE COMMENT MARK FOR LITC; 10602000 OPLIT~1; 10603000 COMMENT ERROR 402 IS BAD 10604000 SUBSCRIPT IN MONITOR DECLARATION;10605000 STEPIT; 10606000 END 10607000 ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000 SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000 SUBSCRIPT EXPRESSION MUST BE GENERATED10610000 AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000 PROGRAM DESCRIPTOR CREATED AND THE 10612000 ADDRESS SAVED IN SUBSCRIPT, SUBSCRIPT10613000 MUST BE MARKED FOR AN OPDC; 10614000 JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000 ADES,L,0); AEXP; EMITO(RTS); 10616000 JUMPCHKX; 10616500 OPLIT~0; 10617000 IF MODE > 0 10618000 THEN BEGIN COMMENT STUFF F AT THIS 10619000 POINT IF MODE > 0; 10620000 STUFFF(SUBSCRIPT);EMITPAIR( 10621000 SUBSCRIPT,STD); 10622000 END; 10623000 END; 10624000 PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000 SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000 NXTINFOTEMP); 10627000 IF ELCLASS = COMMA 10628000 THEN GO TO STORESUBS; 10629000 IF CHECK(RTBRKET,403) 10630000 THEN GO TO EXIT; 10631000 COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000 EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000 IF NXTINFOTEMP ! TESTVARB 10634000 THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000 ELEMENT HAS IMPROPER NUMBER OF 10636000 SUBSCRIPTS; 10637000 I~I-1; ERROR(404); GO TO EXIT; 10638000 END; 10639000 GO CHKCOMMA; 10640000 END; 10641000 IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000 THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000 IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000 THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000 SWITCH MONITORED AT IMPROPER LEVEL; 10646000 ERROR(405); GO TO EXIT; 10647000 END; 10648000 PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000 ); 10650000 PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000 ELBATWORD); GO CHKCOMMA; 10652000 END; 10653000 IF RANGE(BOOPROCID,INTPROCID) 10654000 THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000 E ;% 10656000 IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010 BEGIN 10656011 %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012 %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013 PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014 PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015 END ; 10656016 PUTNBUMP(NOPAR ~ TAKEFRST & 10656030 FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR10657000 ~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000 LINK+ELBATWORD.INCR); 10659000 DO PUTNBUMP(TAKE(INC~INC+1)) 10660000 UNTIL INC } TESTVARB; 10661000 GO CHKCOMMA; 10662000 END; 10663000 ERROR(406); GO TO EXIT; 10664000 COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000 CHKCOMMA:IF STEPI = COMMA 10666000 THEN GO MARKMONITORED; 10667000 IF CHECK(RTPAREN,407) 10668000 THEN GO TO EXIT; 10669000 COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000 DECLARATION; 10671000 IF STEPI = SEMICOLON 10672000 THEN GO TO EXIT; 10673000 IF CHECK(COMMA,408) 10674000 THEN GO TO EXIT; 10675000 COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000 DELIMITER; 10677000 STEPIT; GO TO START; 10678000 EXIT:; 10679000 END MERRIMAC; 10680000 PROCEDURE DMUP; 10681000 BEGIN COMMENT 15 JULY 1963 10682000 THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000 ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000 ARRAYS. 10685000 THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000 THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000 OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000 THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000 A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000 HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000 BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000 COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000 WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000 THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000 FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000 THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000 INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000 ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000 OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000 . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000 DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000 IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000 FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000 SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000 LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000 POINTING AT THE FILE IDENTIFIER IN THE DUMP 10707000 DECLARATION; 10708000 LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000 ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000 IS REACHED; 10711000 DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000 ADDRESS OF THE MONITOR FILE; 10713000 LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000 CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000 STARTCALL IS REACHED, I MUST BE POINTING 10716000 AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000 DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000 DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000 DIMENSIONS OF AN ARRAY OR A 10720000 SUBSCRIPTED VARIABLE APPEARING IN A 10721000 DUMP LIST; 10722000 DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000 COUNTER SETTING AT WHICH CODE IS 10724000 GENERATED TO EXIT THE ROUTINE EMITTED10725000 BY DMUP; 10726000 DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000 LOCATION OF THE COUNTER 10728000 ASSOCIATED WITH THIS LABEL IF 10729000 SPACE HAS BEEN ASSIGNED FOR IT; 10730000 DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000 NODIM. IT IS THEN COUNTED DOWN TO 10732000 ZERO AS SUBSCRIPT CODE IS GENERATED;10733000 LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000 NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000 LABEL SUBSLOOP; COMMENT THE CODE AT SUBLOOP PASSES 10736000 SUBSCRIPTS TO PRINTI; 10737000 ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000 HOLDS THE ADDRESSES OF ALL LABEL 10739000 COUNTERS FOR LABELS APPEARING IN 10740000 THIS DUMP DECLARATION. IT IS 10741000 NECESSARY TO RETAIN THIS 10742000 INFORMATION SO THAT CODE MAY BE 10743000 GENERATED AT THE END OF THE 10744000 DECLARATION TO INITIALIZE THE 10745000 COUNTERS; 10746000 DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000 VARIABLE USED TO INDEX INTO THE10748000 LABELCTR ARRAY; 10749000 DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000 CONCATENATE DEFINE FOR INSERTING10751000 THE COUNTER ASSOCIATED WITH THIS10752000 LABEL INTO THE FIRST ADDITIONAL 10753000 WORD OF INFO; 10754000 DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000 BOUND FOR MONITORED SUBSCRIPTED 10756000 VARIABLES; 10757000 DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000 FORMAT TYPE REFERRED TO IN THE 10759000 COMMENTS FOR THE MERRIMAC 10760000 ROUTINE DESCRIBING PRINTI; 10761000 DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000 USED TO HOLD L WHILE THE DUMP 10763000 INDICATOR TEST CODE IS BEING 10764000 GENERATED; 10765000 DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000 LOCATION OF THE CODE THAT MUST BE 10767000 GENERATED TO MAKE THE TEST TO 10768000 DETERMINE WHETHER OR NOT DUMPING 10769000 SHOULD OCCUR; 10770000 DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000 CONCATENATE DEFINE USED TO 10772000 INSERT THE ADDRESS OF THE 10773000 PROGRAM DESCRIPTOR FOR THE CODE 10774000 GENERATED FROM THE DUMP 10775000 DECLARATION; 10776000 DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000 ADDRESS OF THE PROGRAM DESCRIPTOR 10778000 THAT DESCRIBES THE CODE GENERATED 10779000 BY DMUP; 10780000 DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000 ELBAT WORD FOR THE DUMP LIST 10782000 ELEMENT CURRENTLY BEING OPERATED 10783000 ON; 10784000 LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000 ON PRINTI. IT GENERATES THE CODE TO 10786000 PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000 FILE, AND FORMAT TYPE; 10788000 DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000 DIMENSION NUMBER THAT IS CURRENTLY 10790000 BEING WORKED ON; 10791000 START:IF CHECK(FILEID,409) 10792000 THEN GO TO EXIT; 10793000 COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000 CHECKER(ELBAT[I]); 10795000 FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000 IF CHECK(LEFTPAREN,410) 10797000 THEN GO TO EXIT; 10798000 COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000 JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000 (ADES,L,0); TESTLOC~L; L~L+3; 10801000 LABELCTRINX~1; EMITO(NOP); BUMPL; 10802000 STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000 [I]); 10804000 IF RANGE(BOOARRAYID,INTARRAYID) 10805000 THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000 SUBSCRIPTED VARIABLES; 10807000 NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000 IF STEPI = LFTBRKET 10809000 THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000 VARIABLES; 10811000 STEPIT; AEXP; EMITO(DUP); 10812000 SUBSCTR~1; 10813000 IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000 ).[35:13] ! 0 10815000 THEN BEGIN COMMENT SUBTRACT OFF THE 10816000 LOWER BOUND BEFORE INDEXING;10817000 IF LWRBND.[46:2] = 0 10818000 THEN EMIT(LWRBND) 10819000 ELSE EMITV(LWRBND.[35:11]); 10820000 EMIT(LWRBND.[23:12]); 10821000 END; 10822000 IF DIMCTR-SUBSCTR = 0 10823000 THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000 VALUE,N; 10825000 EMITV(ELBATWORD.ADDRESS); 10826000 PASSN:EMITL(NODIM); 10827000 IF CHECK(RTBRKET,411) 10828000 THEN GO TO EXIT; 10829000 COMMENT ERROR 411 MEANS 10830000 DUMP LIST ELEMENT HAS WRONG 10831000 NUMBER OF SUBSCRIPTS; 10832000 FORMATTYPE~2; GO CALLPRINTI10833000 END; 10834000 EMITN(ELBATWORD.ADDRESS); 10835000 SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000 EMITL(JUNK); EMITO(SND); 10837000 SUBSCTR~SUBSCTR+1; 10838000 IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000 ).[35:13] ! 0 10840000 THEN BEGIN COMMENT SUBTRACT OFF THE 10841000 LOWER BOUND BEFORE INDEXING;10842000 IF LWRBND.[46:2] = 0 10843000 THEN EMIT(LWRBND) 10844000 ELSE EMITV(LWRBND.[35:11]); 10845000 EMIT(LWRBND.[23:12]); 10846000 END; 10847000 IF DIMCTR-SUBSCTR = 0 10848000 THEN BEGIN COMMENT EMIT COC; 10849000 EMITO(COC); EMITV(JUNK10850000 ); EMITO(XCH); 10851000 GO PASSN; 10852000 END; 10853000 EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000 IF CHECK(COMMA,412) 10855000 THEN GO TO EXIT 10856000 ELSE GO TO SUBSLOOP; 10857000 COMMENT ERROR 412 MEANS DUMP LIST 10858000 ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000 ; 10860000 END; 10861000 COMMENT THIS CODE HANDLES ARRAYS; 10862000 IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000 THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000 ARRAY DUMP LIST ELEMENT; 10865000 ERR(413); GO TO EXIT; 10866000 END; 10867000 EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000 FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000 END; 10870000 FORMATTYPE~1; 10871000 IF RANGE(BOOID,INTID) 10872000 THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000 EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000 END; 10875000 IF CHECK(LABELID,414) 10876000 THEN GO TO EXIT; 10877000 COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000 CODE HANDLES LABELS; 10879000 PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]- 10880000 IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000 THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000 ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000 EMITV(LABELCTR[ 10884000 LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000 ,ELBATWORD); 10886000 EMITL(3); IF FALSE THEN 10887000 CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000 POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000 EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000 FILEIDENT); %109-10891000 EMITNUM(FORMATTYPE&CARDNUMBER[1:4:44]); %109-10891100 EMITV(GNAT(PRINTI)); %109-10891200 IF STEPI = COMMA 10892000 THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000 IF LABELCTRINX = 100 10894000 THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000 ABOUT TO OVERFLOW WITH LABEL 10896000 INFORMATION; 10897000 ERR(415); GO TO EXIT; 10898000 END; 10899000 GO STARTCALL; 10900000 END; 10901000 IF CHECK(RTPAREN,416) 10902000 THEN GO TO EXIT; 10903000 COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000 DELIMETER; 10905000 LEXIT~L; EMITL(0); EMITO(RTS); 10906000 JUMPCHKX; STEPIT; 10907000 IF CHECK(LABELID,417) 10908000 THEN GO TO EXIT; 10909000 COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000 PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000 ELBATWORD); 10912000 IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100 PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000 IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000 THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000 ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000 EMITL(0); 10917000 DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000 EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000 END 10920000 UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000 L~L-1; EMITO(STD); STEPIT; 10922000 IF CHECK(COLON,418) 10923000 THEN GO TO EXIT; 10924000 COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000 FINALL~L; L~TESTLOC; STEPIT; 10926000 IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500 AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510 ! COMMA AND GT1 ! SEMICOLON) 10926520 THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530 UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540 FLAG(465); GO TO EXIT; 10926550 END; 10926560 PRIMARY; EMITV(DUMPETEMP); 10927000 EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000 L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000 DUMPR],GIT(ELBAT[I-3])); 10930000 IF ELCLASS = COMMA 10931000 THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000 STEPIT; GO TO START; 10933000 END; 10934000 IF CHECK(SEMICOLON,419) 10935000 THEN; 10936000 COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000 EXIT:; 10938000 END DMUP; 10939000 COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000 AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000 OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000 SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000 OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000 IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000 A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000 SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 10947000 SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000 SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000 THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000 JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000 TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113-10954000 VALUE BEFORE; BOOLEAN BEFORE; REAL PD; %113-10954100 BEGIN 10955000 LABEL LX,EXIT,BEF; 10956000 REAL K,N,T1,TL; 10957000 TL ~ L; 10958000 EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000 L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000 EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000 AND PREPARATION FOR SWITCH-JUMP; 10962000 GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000 IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000 LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000 THEN BEGIN 10966000 INFO[0,N] ~ ELBAT[I]; 10967000 IF N ~ N+1 = 256 10968000 THEN BEGIN ERR(147); GO TO EXIT END; 10969000 IF STEPI = COMMA THEN GO TO LX; 10970000 EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000 FOR K ~ 0 STEP 1 UNTIL N 10972000 DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000 EMIT((GT1~INFO[0,K]).[35:1]); 10974000 EMIT(GT1) END; 10975000 SWITCHGEN ~ FALSE END 10976000 ELSE BEGIN 10977000 BEF: L ~ BUMPL; N ~ N-1; 10978000 PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500 [16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600 FOR K ~ 0 STEP 1 UNTIL N 10979000 DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000 ADJUST; T1 ~ L; 10981000 EMITL(GNAT(GT1~INFO[0,K])); 10982000 GENGO(GT1); 10983000 INFO[0,K] ~ T1; 10984000 EMITO(RTS); 10985000 CONSTANTCLEAN END; 10986000 I ~ I-1; N ~ N+1; 10987000 DO BEGIN ADJUST; 10988000 STEPIT; INFO[0,N] ~ L; 10989000 IF N ~ N+1 = 256 10990000 THEN BEGIN ERR(147); GO TO EXIT END; 10991000 DEXP; EMITO(RTS) END 10992000 UNTIL ELCLASS ! COMMA; ADJUST; 10993000 EMITB(BFW,TL+12,L); EMITO(BFC); 10994000 EMIT(0); EMITO(RTS); N ~ N-1; 10995000 FOR K ~ 0 STEP 1 UNTIL N 10996000 DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000 SWITCHGEN ~ TRUE END; 10998000 T1 ~ L; 10999000 L ~ TL+4; 11000000 EMITL(N+1); 11001000 L ~ T1; 12000000 EXIT: END SWITCHGEN; 12001000 PROCEDURE DBLSTMT; 12002000 BEGIN 12003000 REAL S,T; 12004000 BOOLEAN B ; 12004100 LABEL L1,L2,L3,L4,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 L4: IF (S~S-1){0THEN FLAG(282); STEPIT ; 12025000 GO TO L3; 12026000 END; 12027000 IF ELCLASS=ASSIGNOP THEN 12028000 BEGIN 12029000 IF S~S-1<0 THEN FLAG(285); T~0; STEPIT ; 12030000 DO 12031000 BEGIN 12032000 IF ELCLASS !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000 STEPIT; 12034000 B~ELCLASS=INTID OR ELCLASS=INTARRAYID 12034100 OR ELCLASS=INTPROCID ; 12034110 IF ELCLASS{INTID AND ELCLASS}REALID THEN 12035000 BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000 ELSE IF ELCLASS{INTPROCID AND ELCLASS}REALPROCID THEN12036100 IF ELBAT[I].LINK ! PROINFO.LINK THEN FLAG(211) 12036200 ELSE BEGIN EMITL(514); STEPIT END 12036300 ELSE IF ELCLASS>INTARRAYID OR ELCLASSBOOID AND ELCLASSBOOPROCID AND ELCLASSBOOARRAYID 12063000 THEN VARIABLE(FL) 12063100 ELSE ERRX(386) ; 12063200 EMITO(IF B THEN ISD ELSE STD) ; 12063300 END 12063400 UNTIL T~T+1=2 ; 12063500 IF ELCLASS!RTPAREN THEN GO L3 ; 12063600 IF S!0 THEN FLAG(383) ELSE BEGIN STEPIT; GO EXIT END ; 12063610 END ; 12063700 IF ELCLASS=FACTOP THEN 12063800 BEGIN 12063900 EMITO(MKS); EMITL(8); EMITV(GNAT(POWERALL)); GO L5 ; 12064000 END ; 12064100 IF ELCLASS>BOOID AND ELCLASS IOTEMP THEN 13157030 IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040 ELSE BEGIN 13158000 EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000 EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000 END ; 13161000 WHILE ELCLASS=COMMA DO 13162000 IF GT1~FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000 BEGIN ERR(291); GO START END 13164000 ELSE BEGIN 13165000 EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000 GT1~FILEATTRIBUTEHANDLER(FIO); 13167000 END ; 13168000 END ; 13169000 END ; 13170000 ARRAYFLAG~FALSE ; 13181000 IF ELCLASS!RTPAREN THEN FLAG(29); 13182000 COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000 IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000 % VOID 13185000 % VOID 13186000 END 13187000 UNTIL STEPI!COMMA; 13188000 STOPENTRY~FALSE; 13189000 END ELSE 13190000 BEGIN 13191000 IF G!FORMATV THEN FLAG(33) ELSE 13192000 IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN13193000 END; 13194000 START: 13195000 END; 13196000 PROCEDURE HANDLESWLIST; 13196300 BEGIN 13196310 LABEL OVER; 13196320 13196330 JUMPCHKX; 13196340 STOPENTRY~ NOT SPECTOG; 13196350 ENTRY(SUPERLISTID); 13196360 IF SPECTOG THEN GO TO OVER; 13196370 IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380 COMMENT MISSING ~; 13196390 EMITO(MKS); 13196400 CHECKDISJOINT(ADDRSF); 13196410 G~L; L~L+1; 13196420 EMITL(1); 13196430 EMITL(1); 13196440 EMITL(1); 13196450 EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460 LIST DESCRIPTORS FOR SWITCH LIST; 13196470 COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480 J~-1; STOPENTRY ~ FALSE; 13196490 DO 13196500 BEGIN 13196510 IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520 THEN BEGIN ERR(42); GO TO OVER END; 13196530 PASSLIST; 13196540 EMITL(J~J+1); 13196550 EMITN(ADDRSF); 13196560 EMITO(STD); COMMENT STORE LIST DESC IN ARRAY;13196570 END 13196580 UNTIL ELCLASS ! COMMA; 13196590 GT2~L; L~G; EMITL(J+1); L~GT2; 13196600 OVER: END OF HANDLESWLIST; 13196610 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 SUBOP=48#, 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 GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000 ELSE IF ELCLASS = SWITCHID 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 GT5 ~ PROGDESCBLDR(0,J,ADD); 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 13275000 13276000 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 XREFDUMP(POINTER); % DUMP XREF INFO %116-13283500 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(0&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO); 13304000 NEXTINFO~256|RINX END; 13305000 IF SPECTOG THEN 13305100 IF NOT MACROID THEN 13305200 UNHOOK; 13305300 KOUNT~COUNT; 13306000 ACCUM[0].INCR~WORDCOUNT; 13307000 ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO; 13308000 ACCUM[1].PURPT~NEXTINFO~LASTINFO; 13309000 MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000 IF XREF THEN % MAKE DECLARATION REFERENCE %116-13310050 IF (ACCUM[0].CLASS ! DEFINEID OR NOT %116-13310075 BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER%116-13310080 BEGIN %116-13310100 XREFINFO[NEXTINFO] := %116-13310200 IF SPECTOG THEN %116-13310300 XREFINFO[ELBAT[I]] %116-13310350 ELSE %116-13310400 ((XLUN := XLUN + 1) & SGNO SEGNOF); %116-13310450 IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY %116-13310500 XMARK(DECLREF) %116-13310525 ELSE %116-13310550 XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG%116-13310575 THEN NORMALREF ELSE DECLREF); %116-13310580 END %116-13310600 ELSE % DEFINE PARAMETERS - DONT CROSS REF. %116-13310700 XREFINFO[NEXTINFO] := 0 %116-13310750 ELSE %116-13310800 IF DEFINING.[1:1] THEN % WE ARE DOING XREFING %116-13310900 XREFINFO[NEXTINFO] := 0; %116-13310950 LASTINFO~NEXTINFO; 13311000 IF NEXTINFO ~ NEXTINFO+WORDCOUNT }8192 THEN 13312000 BEGIN FLAG(199); GO TO ENDOFITALL END; 13312500 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 PALCED IN THE STACK 13321000 FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) ;13322000 BEGIN 13323000 BOOLEAN SVTOG;% 13323010 J~0;I~I-1; 13324000 DO 13325000 BEGIN 13326000 STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT; 13327000 IF FORMALF~SPECTOG 13328000 THEN 13329000 BEGIN 13330000 IF TYPE{INTARRAYID AND TYPE}BOOARRAYID THEN% 13330550 IF VONF THEN BEGIN SVTOG ~ ERRORTOG; FLAG(15);% 13330600 SPECTOG ~ ERRORTOG ~ SVTOG; END;% 13330650 IF ELCLASS!SECRET 13331000 THEN FLAG(002); 13332000 BUP~BUP+1 13333000 END 13334000 ELSE 13335000 BEGIN 13336000 IF ELCLASS>IDMAX AND ELCLASS{FACTOP 13337000 THEN FLAG(003); 13338000 IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 13339000 IF NOT (PTOG OR STREAMTOG) AND LINKF } GLOBALNINFOO 13339100 THEN FLAG(1) %118-13339200 ELSE %118-13339300 ELSE %118-13339400 IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION %118-13339500 FLAG(1); %118-13340000 VONF~P2; 13341000 IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000 THEN ADDRSF ~ PG ~PG+1 13343000 ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000 ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000 IF TYPE{INTARRAYID AND TYPE>BOOARRAYID 13346000 THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000 EMITL(ADDRSF); EMITN(10); 13347500 END 13347510 ELSE CHECKDISJOINT(ADDRSF); 13347520 END; 13348000 IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100 XREFPT~XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200 KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000 END 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 COMMENT 13377000 ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000 IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000 STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000 MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000 EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000 ARRAY A[0:10], 13383000 MKS (THIS MARKS STACK TO CUT BACK AFTER COM)13384000 DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000 THE ADDRESS OF A) 13386000 LITC 11 (SIZE OF ARRAY) 13387000 LITC 1 (NUMBER OF DIMENSIONS) 13388000 LITC 1 (NUMBER OF ARRAYS) 13389000 LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000 NON OWN ARRAYS) 13391000 COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000 DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000 STACK) 13394000 OWN ARRAY B,C[0:X,-1:10], 13395000 MKS 13396000 DESC B 13397000 DESC C 13398000 LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000 OPDC X 13400000 LITC JUNK (JUNK CELL) 13401000 ISN (INTEGERIZE UPPER BOUND) 13402000 LITC 1 (COMPUTE SIZE 13403000 ADD OF DIMENSION 13404000 LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000 CHS 13406000 LITC 12 (SIZE SECOND DIMENSION) 13407000 LITC 2 (NUMBER DIMENSIONS) 13408000 LITC 2 (NUMBER ARRAYS) 13409000 LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000 COM 13411000 DESC XITR 13412000 SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000 MKS 13414000 DESC D 13415000 DESC E 13416000 DESC F 13417000 OPDC X 13418000 LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000 ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000 DUP (MUST PASS LOWER BOUND FOR OWN) 13421000 OPDC Y (INTEGERIZE 13422000 LITC JUNK UPPER 13423000 ISN BOUND) 13424000 XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000 SUB UPPER 13426000 LITC 1 -LOWER 13427000 ADD +1) 13428000 OPDC M (COMPUTER LOWER BOUND 13429000 OPDC N SECOND DIM) 13430000 ADD 13431000 LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000 ISN (INTEGERIZE) 13433000 DUP (PASS LOWER BOUND FOR OWN) 13434000 OPDC T 13435000 MUL V 13436000 LITC JUNK (INTEGERIZE 13437000 ISN UPPER) 13438000 XCH (COMPUTE 13439000 SUB SIZE 13440000 LITC 1 13441000 ADD ) 13442000 LITC 2 (NUMBER DIMENSIONS) 13443000 LITC 3 (NUMBER ARRAYS) 13444000 LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000 COM 13446000 DESC XITR ; 13447000 BEGIN 13448000 REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000 BOOLEAN LLITOG,ULITOG; 13450000 REAL ADDCON; 13451000 LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000 ARRAYFLAG ~ TRUE; 13452100 TYPEV~REALARRAYID; 13453000 IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000 ELSE 13455000 IF T1=OWNV THEN 13456000 BEGIN P2:=TRUE;IF SPECTOG THE FLAG(13) END 13457000 ELSE 13458000 IF T1= SAVEV THEN 13459000 BEGIN 13460000 P3:=TRUE; 13461000 IF SPECTOG THEN FLAG(13); 13462000 % IF REMOTOG THEN FLAG(508); % NOT ALLOWED IN XALGOL ON TSS. 13463000 END 13464000 ELSE 13465000 IF T1= AUXMEMV THEN 13466000 BEGIN P4:=TRUE; IF SPECTOG THEN FLAG(13) END 13467000 ELSE 13468000 TYPEV :=REALID+T1; 13469000 IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000 ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000 BETA1: 13472000 IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ~0;SAVEDIM~1; 13473000 TWO:IF STEPI=ADOP THEN 13474000 BEGIN 13475000 T1~ELBAT[I].ADDRESS; I~I+1 13476000 END 13477000 ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000 APROGS~L; 13479000 IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000 BEGIN 13481000 LLITOG~TRUE; 13482000 IF T3~ELBAT[I].ADDRESS!0 13483000 THEN 13484000 BEGIN 13485000 EMITL(T3); 13486000 IF T1=SUBOP THEN 13487000 BEGIN 13488000 EMITO(CHS); 13489000 ADDCON~ADDC 13490000 END ELSE 13491000 ADDCON~SUBC 13492000 END; 13493000 T2~T3|4+ADDCON 13494000 END 13495000 ELSE 13496000 BEGIN 13497000 LLITOG~FALSE; 13498000 IF T1!0 THEN I~I-1; 13499000 T2:=GETSPACE(P2,-1);%TEMP. 13500000 AEXP;EMITSTORE(T2,ISN); 13501000 T2~T2|4+SUBC+2; 13502000 IF ELCLASS!COLON THEN 13503000 FLAG(017);I~I-1 13504000 END; 13505000 IF P2 THEN 13506000 BEGIN 13507000 IF LLITOG AND T3=0 THEN EMITL(0);13508000 ARPROGS~L;EMITO(DUP); 13509000 END; 13510000 IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000 BEGIN 13512000 IF T~TABLE(I~I+1)=COMMA OR 13513000 T~RTBRKET 13514000 THEN 13515000 BEGIN 13516000 EMITL(T4~ELBAT[I-1].ADDRESS);13517000 ULITOG~TRUE;GO TO CSZ 13518000 END 13519000 ELSE 13520000 I~I-1 13521000 END; 13522000 ULITOG~FALSE; 13523000 AEXP; 13524000 EMITL(JUNK); 13525000 EMITL(ISN); 13526000 CSZ: IF LLITOG AND ULITOG THEN 13527000 BEGIN 13528000 L~ARPROGS; 13529000 IF(T~IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000 T4-T3+1){0 OR T>1023 THEN FLAG(59); 13531000 EMITL(T); 13531100 IF P3 THEN BEGIN SAVEDIM~SAVEDIM|T; 13532000 IF SAVEDIM>MAXSAVE 13533000 THEN MAXSAVE~SAVEDIM 13534000 END 13535000 ELSE 13536000 IF T>MAXROW THEN MAXROW~T; 13537000 END 13538000 ELSE 13539000 BEGIN IF NOT(LLITOG AND T3=) 13540000 OR P2 13541000 THEN 13542000 BEGIN 13543000 EMITO(XCH);EMITO(SUB) 13544000 END;EMITL(1);EMITO(ADD) 13545000 END; 13546000 SLB:PUTNBUMP(T2);LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547000 ELSE 13548000 IF T!RTBRKET THEN FLAG(018); 13549000 IF NOT SPECTOG THEN 13550000 BEGIN 13551000 COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400 NOOFARRAYS:=NOOFARRAYS + GTA1[0]; 13551500 EMITL(LBJ);EMITL(GTA1[0]); 13552000 IF P3 AND P4 THEN FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 13552500 EMITL(REAL(P3)+2|REAL(P2)+REAL(P4)|64); 13553000 EMITV(5) 13554000 END; 13555000 PUT(LBJ,SAVEINFO2-1); 13556000 DO BEGIN 13557000 T~TAKE(SAVEINFO); 13558000 K~T.INCR; 13559000 T.INCR~SAVEINFO2-SAVEINFO-1; 13560000 PUT(T,SAVEINFO); 13561000 END 13562000 UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000 IF STEPI!COMMA THEN GO TO START; 13564000 IF NOT SPECTOG THEN EMITO(MKS); 13565000 SAVEINFO~NEXTINFO; 13566000 I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO+1;GO TO BETA1; 13567000 BETA2: 13568000 IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000 THEN 13570000 BEGIN 13571000 IF ELCLASS~TABLE(I-1)=LITNO 13572000 THEN 13573000 BEGIN 13574000 T3~ELBAT[I-1].ADDRESS; 13575000 IF T1= SUBOP THEN 13576000 ADDCON ~ADDC 13577000 ELSE 13578000 ADDCON ~SUBC; 13579000 T2~T3|4+ADDCON; GO TO SLB; 13580000 END; 13581000 IF ELCLASS=FACTOP THEN 13582000 BEGIN 13583000 T2~-SUBC; GO TO SLB 13584000 END 13585000 END; 13586000 FLAG(019); 13587000 START: ARRAYFLAG ~ FALSE END; 13588000 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 JUMPCHX; 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 HTEN 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; 13632000 BEGIN 13632100 IF NOHEADING THEN DATIME; 13633000 IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 END SEGMENTSTART; 13633300 PROCEDURE SEGMENT(SIZE,NO,NOO); %106-13634000 VALUE SIZE,NO,NOO; %106-13635000 REAL SIZE,NO,NOO; %106-13636000 BEGIN %106-13637000 INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT %106-13637100 % IS NOT TOO BIG %106-13637200 PDPRT[PDINX.[37:5],PDINX.[42:6]] := %106-13638000 SIZE & NO[28:38:10] & %106-13639000 MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & %106-13640000 REAL(SAVEPRTOG)[3:47:1]; %106-13641000 PDINX:=PDINX+1; SIZE:=ABS(SIZE); %106-13642000 IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; %106-13643000 AKKUM:=AKKUM+SIZE; %106-13644000 IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16|(SIZE.[38:6]+1); %106-13645000 IF LISTER OR SEGSTOG THEN %106-13646000 BEGIN %106-13647000 IF NOHEADING THEN DATIME; %106-13648000 IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) %106-13649000 ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); %106-13650000 END; %106-13651000 LDICT[NO.[38:3],NO.[41:7]] := %106-13652000 IF BUILDLINE THEN %106-13653000 MOVENADBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] %106-13654000 ELSE -1; %106-13655000 END OF SEGMENT; %106-13656000 13697000 13698000 13699000 13700000 13701000 13702000 13703000 13704000 13705000 13706000 13707000 13708000 13709000 13710000 13711000 13712000 13713000 PROCEDURE ENTER(TYPE); VALUE TYPE; INTEGER TYPE; 13714000 BEGIN 13715000 G:=GTA1[J:=J-1]; 13716000 IF NOT SPECTOG THEN 13717000 BEGIN 13718000 IF NOT P2 THEN 13719000 IF P2:=(G=OWNV) THEN G:=GTA1[J:=J-1]; 13720000 IF NOT P3 THEN 13721000 IF P3:=(G=SAVEV) THEN G:=GTA1[J:=J-1]; 13722000 IF NOT P4 THEN 13723000 IF P4:=(G=AUXMEMV) THEN G:=GTA1[J:=J-1]; 13724000 END; 13725000 IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE) 13726000 END ENTER; 13727000 13728000 13729000 13730000 PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000 VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD; 13732000 BOOLEAN GOTSTORAGE; 13733000 REAL RELAD,STOPPER,PRTAD; 13734000 BEGIN 13735000 BOOLEAN BT; 13736000 REAL K,LS; 13737000 LS~RELAD; 13738000 BT~JUMPCTR=LEVEL; 13739000 IF FUNCTOG 13740000 THEN 13741000 BEGIN 13742000 EMITV(514); 13743000 EMITO(RTN) 13744000 END 13745000 ELSE 13746000 EMITO(XIT); 13747000 IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000 CONSTANTCLEAN; 13749000 IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000 THEN 13751000 BEGIN ADJUST;LS~L; 13752000 IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000 THEN 13754000 BEGIN 13755000 % 13755500 EMITV(BLOCKCTR); 13756000 EMITL(1); 13757000 EMITO(ADD); 13758000 IF GOTSTORAGE OR FAULTOG.[46:1] 13759000 THEN 13760000 EMITSTORE(BLOCKCTR,SND) 13761000 END 13762000 % 13762500 ELSE EMITL(0); 13763000 K~K+NCII; 13764000 WHILE K~K-1}0 13765000 DO EMITL(0); 13766000 PURGE(STOPPER); 13767000 IF FAULTLEVEL{LEVEL THEN 13767100 BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200 EMITPAIR(0,MDS); EMITO(CHS); 13767300 END OF THIS PART OF ERROR KLUDGE; 13767400 EMIT(0); % DC & DISK 13767500 BUMPL; 13768000 13768100 EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000 CONSTANTCLEAN 13770000 END ELSE PURGE(STOPPER); 13771000 Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000 END HTTEOAP; 13773000 PROCEDURE FORMATGEN; 13774000 BEGIN 13775000 INTEGER PRT;LABEL L; 13776000 BOOLEAN TB2; 13777000 ARRAY TEDOC[0:7,0:127]; 13777500 MOVECODE(TEDOC,EDOC); 13777600 BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700 TB2~GTA1[J-1]=SWITCHV; 13778000 GT5~SGNO; 13779000 L: GT1:=(2|SGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000 IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002 SGNO~SGAVL; 13781000 13782000 F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000 Z~PROGDESCBLDR(LDES,0,PRT); 13784000 IF TB2 THEN 13785000 BEGIN 13786000 ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(37); 13787000 PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000 RR4~NEXTINFO;PUTNBUMP(0); 13789000 DO 13790000 BEGIN PUTNBUMP(F); IF STEPI=LEFTPAREN THEN FLAG(37); 13791000 ELCLASS:="<"; 13791050 TB1~FORMATPHRASE; 13792000 END 13793000 UNTIL ELCLASS!","; 13794000 RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000 DO 13796000 WHIPOUT(TAKE(RR4~RR4+1)) 13797000 UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000 13799000 END ELSE 13800000 BEGIN 13801000 I~I-1; 13802000 DO 13803000 BEGIN 13804000 STOPDEFINE~TRUE;STEPIT ; 13805000 ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="<";13806000 PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000 TB1~FORMATPHRASE; 13808000 END 13809000 UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000 13811000 13812000 END; 13813000 SEGMENT(-F,SGNO,GT5);SGAVL~SGAVL+1; 13814000 IF TB1 AND ELCLASS="," THEN BEGIN I~I+1;GO TO L END; 13815000 IF ELCLASS!";" THEN ELBAT[I]~0 ELSE ELBAT[I].CLASS~SEMICOLON; 13816000 STOPGSP~STOPENTRY~FALSE; 13817000 SGNO~GT5; 13818000 MOVECODE(TEDOC,EDOC); 13818500 BUILDLINE ~ BUILDLINE.[46:1] ; 13818600 END FORMATGEN; 13819000 PROCEDURE CHECKBOUNDLVL ; 13819100 COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200 DECLARED AT SAME LEVEL; 13819300 IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400 THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410 COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 ARARY DECLARATION; 13819600 PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR 13900000 THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 13901000 PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 13902000 INTRINSIC, WHO WILL BUILD AIT ENTRIES; 13903000 BEGIN INTEGER TP; REAL A; 13903100 J~0; JUMPCHKX; EMITO(MKS); 13904000 IF FAULTLEVEL>LEVEL THEN FAULTLEVEL~LEVEL; 13905000 IF MODE=0 THEN FAULTLEVEL~1; 13906000 DO BEGIN IF J>0 THEN STEPIT; J~J+1; 13907000 SCATTERELBAT; A~ACCUM[1]; 13908000 IF TP~REAL((Q="6INTOV")&(Q="6EXPOV")[46:47:1]&(Q="5INDEX" 13909000 )[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1])=0 13910000 THEN ERR (61) ELSE 13911000 BEGIN IF TABLE(I+1)=ASSIGNOP THEN 13911100 BEGIN STEPIT; COMMENT OVER THE ~; 13911200 IF GT1~STEPI>IDMAX AND GT10 14229000 THEN 14230000 IF TB1 THEN GT1~GT2 ELSE 14231000 GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000 EMITSTORE(GT1,STD) 14233000 END; 14234000 END 14235000 ELSE 14236000 BEGIN 14237000 IF ELCLASS!FORWARDV THEN FLAG(33); 14238000 PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000 PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000 IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000 STEPIT; 14242000 FORMALF~TRUE 14243000 END; 14244000 PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]>1[16:37:11],LASTINFO); 14245000 IF TB1 THEN 14246000 BEGIN 14247000 NEXTINFO~GT5; 14248000 LASTINFO~GT4; 14249000 END; 14250000 START: 14251000 END SWITCHDEC; 14252000 GO TO START; 14253000 DEFINEDEC: 14254000 BEGIN LABEL START; 14254050 REAL J,K,DINFO,LINKA,LINKB; %118 14254100- STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000 DEFINING := BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 14255500 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 DINFO ~ LASTINFO; 14259017 IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020 BEGIN 14259030 IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040 DO BEGIN STOPDEFINE~TRUE; 14259060 STEPIT; 14259070 IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075 MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080 DEFINEPARAM(DINFO+1, J); 14259085 ACCUM[0] := 0 & DEFINEDID CLASS & 1 FORMAL; %116-14259090 LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094 E; 14259096 IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098 PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100 STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102 STOPDEFINE ~ TRUE; 14259104 END UNTIL STEPI!COMMA; 14259110 IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120 STOPDEFINE~TRUE; 14259130 STEPIT; 14259140 PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150 PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155 END; 14259160 IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000 THEN 14261000 BEGIN 14262000 FLAG(45); 14263000 COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100 I~I-1; 14264000 END; 14265000 MACROID~TRUE; 14265900 LASTINFO ~ DINFO; 14265930 PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950 DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000 MACROID~FALSE; 14266100 END 14267000 UNTIL STEPI!COMMA; 14268000 DEFINING := BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 14268500 START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000 FIELDDEC: %117-14269020 BEGIN %117-14269040 REAL SAVEINFO, SB, NB; %117-14269060 BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC.%117-14269080 LABEL EXIT, SAVEIT; %117-14269100 STOPENTRY := STOPGSP := TRUE; %117-14269120 I := I - 1; %117-14269140 DO %117-14269160 BEGIN %117-14269180 STOPDEFINE := TRUE; %117-14269200 STEPIT; %117-14269220 ENTRY(FIELDID); %117-14269240 SAVEINFO := LASTINFO; %117-14269260 IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN %117-14269280 BEGIN %117-14269300 IF STEPI = LFTBRKET THEN % REMEMBER THIS %117-14269320 BEGIN %117-14269340 FOUNDLB := TRUE; %117-14269360 STEPIT; %117-14269380 END %117-14269400 ELSE %117-14269420 FOUNDLB := FALSE; %117-14269440 IF ELCLASS = FIELDID THEN %117-14269442 BEGIN %117-14269444 SB := ELBAT[I].SBITF; %117-14269446 NB := ELBAT[I].NBITF; %117-14269448 GO TO SAVEIT; %117-14269450 END; %117-14269452 IF ELCLASS = LITNO THEN %117-14269460 IF STEPI = COLON THEN %117-14269480 IF STEPI = LITNO THEN %117-14269500 IF (SB := ELBAT[I-2].ADDRESS) | %117-14269520 (NB := ELBAT[I].ADDRESS) ! 0 AND %117-14269540 SB + NB { 48 THEN %117-14269560 BEGIN %117-14269580 SAVEIT: %117-14269590 PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, %117-14269600 SAVEINFO); %117-14269620 STEPIT; %117-14269640 IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. %117-14269660 IF ELCLASS = RTBRKET THEN %117-14269680 BEGIN %117-14269700 STEPIT; %117-14269705 GO TO EXIT; %117-14269710 END %117-14269715 ELSE %117-14269720 ELSE %117-14269740 GO TO EXIT; %117-14269760 END; %117-14269780 END; %117-14269800 FLAG(114); %117-14269820 DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; %117-14269840 EXIT: %117-14269860 END %117-14269880 UNTIL %117-14269900 ELCLASS ! COMMA; %117-14269920 STOPENTRY := STOPGSP := FALSE; %117-14269940 END; %117-14269960 GO TO START; %117-14269980 PROCEDUREDEC: 14270000 BEGIN 14271000 LABEL START,START1; 14272000 LABEL START2, DOITANYWAY; 14273000 COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000 IF NOT SPECTOG THEN FUNCTOG~FALSE; 14275000 FWDTOG := NEXTSAVE := FALSE; 14276000 IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500 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>INSTRPROCID OR 14284000 TYPEV INTRPROCID THEN FLAG(005) 14295000 ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100 IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000 END; 14297000 IF SPECTOG 14298000 THEN 14299000 BEGIN 14300000 ENTRY(TYPEV); GO TO START2 14301000 END; 14302000 MODE~MODE+1; 14303000 LO~PROINFO; 14304000 SCATTERELBAT; 14305000 COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000 IF LEVELF=LEVEL 14307000 THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000 BEGIN 14309000 IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000 XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST %116-14310500 % XREF ENTRY AS A DECLARATION. %116-14310501 IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100 FWDTOG~TRUE; 14312000 PROAD~ADDRSF; 14313000 PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT 14314000 END 14316000 ELSE 14317000 DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000 ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000 PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000 P2~STOPENTRY~FALSE 14321000 END; 14322000 IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000 ELSE FLAG(039); 14323100 PJ ~ 0; 14323200 IF STREAMTOG THEN STREAMWORDS; 14324000 IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000 IF ECLASS!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 BEGIN IF GT1 ~ TAKE(MARK).[40:8] ! PJ THEN% 14333100 FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200 COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300 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 IF STREAMTOG 14385000 THEN BEGIN 14386000 JUMPCHKNX~PROGDESCBLDR(CHAR,L,PROAD);PJ~P; 14387000 PTOG~FALSE; 14388000 IF FUNCTOG 14389000 THEN 14390000 PUT((Z~TAKE(PROINFO))&LOCLID[2:41:7]&(PJ~PJ+1)[16:37:11] 14391000 , PROINFO); 14392000 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 COMPOUNDTAIL 14412000 END 14413000 ELSE 14414000 STREAMSTMT ; 14415000 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 RSA = 43 #; 14419100 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+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 XREFDUMP(J); % DUMP XREF INFO %116-14445100 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 PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000 [13:37:11],MARK); 14451000 GT1~ L; L ~ FILETHING ; 14451100 WHILE L ! 4095 DO 14451200 BEGIN FILETHING ~ GET(L); 14451300 EMITC(PJ+1,RSA); 14451400 L ~ FILETHING; 14451500 END; 14451600 L ~ GT1; FILETHING ~ 4095 ; 14451700 IF FUNCTOG THEN 14452000 BEGIN 14453000 EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000 EMITC(PJ+2,SED); 14455000 EMITC(1,TRW); 14456000 PUT(Z, PROINFO); 14457000 END; 14458000 EMIT(0); 14459000 STREAMWORDS; 14460000 STREAMTOG~FALSE; 14461000 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 XREFIT(PROINFO,0,FORWARDREF); % WE NEED THIS SO WE CAN FIND 14469100 % THE FORWARD DECL. DURING XREF 14469101 PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000 PURGE(PINFOO); 14471000 STEPIT 14472000 END 14473000 ELSE 14474000 BEGIN 14475000 PROADO~PROAD; 14476000 TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000 % 14478000 COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010 COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020 IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030 MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040 IF ELCLASS = BEGINV THEN 14479000 IF TABLE(I+1) = DECLARATORS THEN 14480000 BEGIN 14481000 BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000 ; PURGE(PINFOO); 14483000 GO TO STOP END; 14484000 BEGIN 14485000 JUMPCHKNX; 14486000 RELAD~L ; 14487000 IF NEXTSAVE THEN FLAG(052); 14487010 STMT; 14488000 IF FAULTOG.[46:1] THEN BEGIN EMITL(10); EMITO(COM); END;14488500 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: 14505000 JUMPCHKX; 14506000 IF SPECTOG THEN BEGIN 14507000 IF (PJ ! BUP) THEN 14507010 BEGIN 14507020 INTEGER II,SSCRAM,SCOUNT; 14507030 MOVE(10,ACCUM,INFO[31,240]); 14507040 II :=I;SSCRAM:=SCRAM;SCOUNT:=COUNT; 14507050 FOR SCRAM := 0 STEP 1 UNTIL 124 14507060 DO IF((I~STACKHEAD[SCRAM]) < 256) 14507070 THEN IF I ! 0 THEN 14507080 BEGIN ELBAT[76]:=INFO[0,I]&I[35:35:14507090 13]; 14507095 COUNT:=INFO[0,I+1].[12:6]; 14507100 MOVE(COUNT,INFO[0,I],ACCUM); 14507105 I:=76; SCATTERELBAT; 14507110 FORMALF := TRUE; 14507120 KLASSF := REALID; 14507130 MAKEUPACCUM; E; 14507140 END; 14507150 I~II;SCRAM~SSCRAM;COUNT~SCOUNT; 14507160 MOVE(10,INFO[31,240],ACCUM); 14507170 BUP~PJ; FLAG(12);SPECTOG~TRUE; 14507180 GO TO START; 14507190 END ; 14507200 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 BEGIN 14526000 RELAD~FIRSTX; 14534000 IF STACKCTR>MAXSTACK 14535000 THEN MAXSTACK~STACKCTR; 14536000 IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000 THEN 14538000 IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000 THEN 14540000 BEGIN 14541000 EMITV(BLOCKCTR); 14542000 EMITL(1); 14543000 EMITO(SUB); 14544000 EMITSTORE(BLOCKCTR,STD); 14545000 GOTSTORAGE~TRUE 14546000 END 14547000 ELSE 14548000 BEGIN 14549000 EMITL(10); 14550000 EMITO(COM) 14551000 END; 14552000 FUNCTOG~FUNCTOGO; 14553000 IF SOP 14554000 THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000 ELSE 14556000 BEGIN 14557000 IF LEVEL = 1 THEN EMITO(XIT) 14557500 ELSE BEGIN 14557600 EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000 EMITO(BFW); 14558500 END; 14558600 CONSTANTCLEAN; 14559000 IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000 OR FAULTOG.[46:1] THEN 14561000 BEGIN 14562000 ADJUST; RELAD~L; 14563000 IF GOTSTORAGE OR FAULTOG.[46:1] 14564000 THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100 EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000 END; 14566000 IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000 =0; 14568000 PURGE(NINFOO); 14569000 IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100 BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200 BUMPL; 14570000 EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000 CONSTANTCLEAN 14572000 END ELSE PURGE(NINFOO); 14573000 IF RELAD =4095 THEN RELAD~0; 14574000 NEXTTEXT ~ NTEXTO; 14574500 G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000 END; 14576000 ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100 SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000 14578000 14579000 14580000 14581000 14582000 14583000 14584000 14585000 14586000 14587000 14588000 14589000 14590000 14591000 14592000 ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000 MOVECODE(TENIL,ENIL); 14594000 MOVECODE(TEDOC,EDOC);L~LOLD; 14595000 DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000 IF NOT SOP AND LEVEL ! 1 14597000 THEN 14598000 BEGIN 14599000 ADJUST; 14600000 G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000 IF ELCLASS = FACTOP THEN 14601100 BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200 14601300 14601400 14601500 14601600 14601610 STEPIT; 14601700 END; 14601800 END; 14602000 IF JUMPCTR=LEVEL THEN JUMPCTR~LEVEL-1; 14603000 LEVEL~LEVEL-1; 14604000 FUNCTOG~FUNCTOGO; 14605000 AJUMP~AJUMPO; 14606000 GLOBALNINFOO := OLDNINFOO; %118-14606100 PRTI~PRTIO; 14607000 FIRSTX~FIRSTXO; 14608000 SAVEL~SAVELO; 14609000 STACKCTR~STACKCTRO; 14610000 SAVEPRTOG := SAVEPRTOGO; 14610100 NCII~NCIIO; FAULTOG~FAULTOGO AND(FALSE&FAULTLEVEL 7 15035000 THEN 7 15036000 ELSE SIZEALPHA)); EMITB(BFW.LTEMP,L); 15037000 END PASSALPHA; 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); REAL 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 REAL X, Z; 15075500 REAL REMEMBERSEQNO; % REMEMBERS SEQUENCE NUMBER OF VARIABLE %116-15075550 % ON LEFT HAND SIDE OF ASSIGNMENT SO WE %116-15075551 % CAN XREF IT CORRECTLY. %116-15075552 LABEL EXIT; 15076000 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] & 514 [16:37:11]; 15083000 END 15084000 ELSE CHECKER(TALL); 15085000 REMEMBERSEQNO := CARDNUMBER %116-15085100 IF TALL.CLASS { INTID THEN 15086000 BEGIN 15087000 LABEL L1, EXIT ; 15088000 DEFINE FORMALNAME=[9:2]=2 #; 15089000 J ~ ELCLASS ; 15089010 IF STEPI= ASSIGNOP THEN 15090000 BEGIN STACKCT ~ 1; %A 15091000 XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. %116-15091100 L1: 15092000 IF TALL.FORMALNAME THEN 15092020 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; %A 15098000 IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000 EMITD(48-T2 ,T1 ,T2); 15100000 IF TALL<0 THEN CLSMPMN(TALL,J}BOOPROCID AND J{INTPROCID) ; 15101000 STACKCT ~ 0; %A 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 EMITO(XCH); EMITO(GT1) END 15106000 ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000 END 15108000 ELSE 15109000 BEGIN 15110000 IF ELCLASS= PERIOD THEN 15111000 BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000 IF STEPI=ASSIGNOP THEN 15113000 BEGIN %116-15113100 IF P1 ! FS THEN 15114000 BEGIN %116-15115000 ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100 GO TO EXIT; %116-15115200 END; %116-15115300 XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); %116-15116000 GO TO L1; %116-15116100 END; %116-15116200 %A 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); %A 15124000 %A 15125000 END ; 15126000 EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000 ELSE 15128000 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 LABEL EXIT,LAST,NEXT ; 15184000 INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100 DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF15185000 DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000 VARIABLE; 15187000 DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000 INDEX OF THE LAST ENTRY IN INFO 15189000 FOR A MONITORED SUBSCRIPTED 15190000 VARIABLE; 15191000 DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX15192000 INTO INFO TO PICK OUT SPECIAL MONITOR 15193000 INFORMATION; 15194000 DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT15195000 POSITION OF THE SPECIAL MONITOR 15196000 INFORMATION FOR SUBSCRIPTED 15197000 VARIABLES; 15198000 DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000 EMIT AN OPDC OR LITC FOR PASSING 15200000 THE SUBSCRIPTS FOR MONITORED 15201000 SUBSCRIPTED VARIABLES.1 MEANS 15202000 LITC, 0 MEANS OPDC; 15203000 DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000 BOUND WORD FROM INFO FOR MONITORED 15205000 SUBSCRIPTED VARIABLES; 15206000 DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000 THE ADDRESS THAT WILL BE 15208000 EMITTED IN AN OPDC OR LITC 15209000 DEPENDING ON OPBIT; 15210000 BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT15211000 IS SET TRUE IF THE VARIABLE IN 15212000 TALL IS SPECIAL MONITORED. 15213000 ; 15214000 PROCEDURE M4(TALL,J); 15215000 VALUE TALL,J ; 15216000 REAL TALL,J ; 15217000 BEGIN STACKCT ~ 1; %A 15217500 IF J = 1 15218000 THEN BEGIN COMMENT FIRST TIME AROUND; 15219000 IF TALL < 0 15220000 THEN BEGIN COMMENT TALL IS MONITORED; 15221000 EMITV(JUNK); EMITO(XCH); 15222000 END; 15223000 EMITN(TALL.ADDRESS ) 15224000 END 15225000 ELSE BEGIN COMMENT NOT THE FIRST TIME AROUND; 15226000 EMITO(CDC); 15227000 IF TALL < 0 15228000 THEN BEGIN COMMENT CALL SUBSCRIPT; 15229000 EMITV(JUNK); EMITO(XCH); 15230000 END; 15231000 END; END; %A 15232000 IF STEPI ! LFTBRKET THEN BEGIN ERR(207);GO TO EXIT END; 15233000 THENUMBEROFDECLAREDDIMENSIONS ~ TAKE(GIT(TALL)).[40:8]; 15233100 J ~ 0; 15234000 STACKCT ~ 0; %A 15234500 COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000 IF P1 > FP THEN TALL ~ ABS(TALL) ELSE 15236000 IF TALL < 0 THEN 15237000 COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000 BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000 VARIABLE; 15240000 EMITO(MKS); 15241000 IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000 THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000 TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000 .NODIMPART)+INC; 15245000 DO IF BOOLEAN(LWRBND~TAKE(INC~INC+1)).15246000 OPBIT 15247000 THEN EMITL(LWRBND,SPMONADR) 15248000 ELSE EMITV(LWRBND,SPMONADR) 15249000 UNTIL INC } TESTVARB 15250000 END; 15251000 END; 15252000 NEXT: IF STEPI = FACTOP THEN 15253000 BEGIN 15254000 STLB ~ 1; 15254400 WHILE TABLE(I+1) = COMMA DO 15254500 BEGIN STEPIT; 15254600 IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700 BEGIN ERR(204); GO TO EXIT END; 15254800 END; 15254900 IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000 BEGIN ERR(203);GO EXIT END; 15256000 COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000 ROW DESIGNATOR 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 IF P1 ! FA THEN 15262500 IF STLB > 1 THEN FLAG(212) ELSE 15262600 IF P1!FI AND P1!FL THEN 15263000 IF P1 = FP AND REL THEN ELSE 15263050 BEGIN ERR(205); GO TO EXIT; END; 15263100 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 COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000 IF TALL < 0 THEN 15269000 BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000 EMITNUM(5&CARDNUMBER[1:4:44]); %109-15271000 EMITN(GNAT(PRINTI)); %109-15271100 END; 15272000 IF P1 = FA THEN 15272900 FOR X ~ 1 STEP 1 UNTIL STLB DO 15273000 BEGIN IF (Z~TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100 THEN EMITV(Z) ELSE EMIT(Z); 15273200 IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300 END; 15273400 STEPIT; 15274000 GO TO EXIT; 15275000 END OF ROW DESIGNATOR PORTION ; 15276000 AEXP: 15277000 COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000 IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000 J ~ J + 1; 15280000 IF(GT1 ~ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000 BEGIN 15282000 IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000 ELSE EMITV(GT1.[35:11]) ; 15284000 EMIT(GT1.[23:12]); 15285000 END OF LOWER BOUND ADJUSTMENT ; 15286000 IF ELCLASS = COMMA THEN 15287000 BEGIN 15288000 COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000 M4 (TALL,J); 15290000 EMITO(LOD) ; 15291000 IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100 BEGIN ERR(208); GO TO EXIT END; 15291200 COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300 DECLARATION *;15291400 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 IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000 BEGIN ERR(208); GO TO EXIT END; 15297000 15298000 15299000 STACKCT ~ 0; %A 15299500 IF STEPI = ASSIGNOP THEN 15300000 BEGIN 15301000 XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO15301100 % SUBSCRIPTED VARIABLE. %116-15301200 COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000 LAST: M4(TALL,J); 15303000 IF T1= 0 THEN 15304000 BEGIN IF P1= FR THEN GO TO EXIT END 15305000 ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; %WF 15306000 IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000 EMITD(48-T2,T1,T2) ; 15308000 EMITO(XCH); 15309000 COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000 IF TALL < 0 15311000 THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000 IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000 VALUE FROM JUNK; 15314000 EMITO( 15315000 IF TALL.CLASS = INTARRAYID 15316000 THEN ISN 15317000 ELSE SND); 15318000 IF P1 ! FS 15319000 THEN EMITPAIR(JUNK,SND); 15320000 EMITL(J); EMITL(PASSTYPE(TALL)); 15321000 EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000 PASSALPHA(TALL); EMITPAIR(GNAT( 15323000 CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000 ARRAYMONFILE); 15325000 EMITNUM((IF SPCLMON THEN 3 ELSE 2) %109-15326000 &CARDNUMBER[1:4:44]); %109-15327000 EMITV(GNAT(PRINTI)); %109-15328000 IF P1 ! FS 15329000 THEN EMITV(JUNK); 15330000 P1~0; GO TO EXIT; 15331000 END; 15332000 EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000 IF P1 = FS THEN ISD ELSE ISN ELSE 15334000 IF P1=FS THEN STD ELSE SND); 15335000 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 %116-15342000 IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST %116-15342100 BEGIN %116-15342200 XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % PARTIAL15342300 % WORD ASSIGNMENT TO SUBSCR. VAR. 15342400 GO TO LAST; %116-15342500 END %116-15342600 ELSE BEGIN ERR(209); GO EXIT END; 15343000 IF J=1 THEN EMITV(TALL.ADDRESS)ELSE EMITO(COC); 15344000 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 SPCLMON 15351000 THEN EMITV(TALL.ADDRESS) 15352000 ELSE EMITN(TALL.ADDRESS) 15353000 ELSE EMITO(IF SPCLMON 15354000 THEN COC 15355000 ELSE CDC); 15356000 IF TALL < 0 15357000 THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000 EMITNUM(5&CARDNUMBER[1:4:44]); %109-15359000 IF SPCLMON 15360000 THEN EMITV(GNAT(PRINTI)) 15361000 ELSE EMITN(GNAT(PRINTI)) 15362000 END; 15363000 IF P1 =FS THEN ERR(210); 15364000 IF P1 = FI THEN P1~0; 15364500 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 IF T1!0 THEN BEGIN EMITI(0,T1,T2); 15369000 IF P1!FI THEN P1~0; 15369100 END; 15369200 IF P1=FI THEN 15369300 IF ELCLASS!COMMA AND ELCLASS!RTPAREN 15369400 THEN SIMPARITH; 15369500 IF P1=FI THEN P1~0;% 15369600 %A 15370000 COMMENT ***** MONITOR FUNCTION M9 ; 15371000 IF TALL < 0 15372000 THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000 EMITNUM(5&CARDNUMBER[1:4:44]); %109-15374000 EMITV(GNAT(PRINTI)); %109-15374100 END ; 15375000 EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000 EXIT : END OF THE VARIABLE ROUTINE; 15377000 COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000 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 SFD = 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 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 SAVL~L; 16032000 F~GET( S); 16033000 IF D ~ L -( L~S) -1{63 THEN 16034000 BEGIN 16035000 IF F=BNS THEN 16036000 BEGIN 16037000 S~GET(L~L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D~D-2; 16038000 END; 16039000 EMITC(D,F); L ~ SAVL 16040000 END 16041000 ELSE BEGIN 16042000 IF F!JFW THEN BEGIN 16043000 EMITC(1,F); 16044000 EMITC(1,JFW) END ; 16045000 EMITC(PJ~PJ+1,RCA); 16046000 L ~ SAVL; 16047000 ADJUST; 16048000 LPRT ~ PROGDESCBLDR(2,L,0); 16049000 COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000 PUTNBUMP(0&(STLABID|2+1) 16051000 [2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000 PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000 PUTNBUMP(0); 16054000 LASTINFO ~ NEXTINFO-3; 16055000 END; 16056000 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 BEGIN 16071000 IF ADDR~TAKE(E).ADDRESS=0 THEN 16072000 BEGIN 16073000 PUT(TAKE(E)&(ADDR~PJ~PJ+1)[16:37:11],E); 16074000 LPRT ~ PROGDESCBLDR(2,T,0); 16075000 END ; 16076000 EMITC(ADDR,RCA); 16077000 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,OTHERWISE 16102000 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 RESOTRED 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); EMIT(NOP);EMIT(NOP); 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 ADJUST; 16158000 GT1 ~ ELBAT[I]; 16159000 XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF %116-16159100 IF STEPI ! COLON THEN ERR(258) 16160000 ELSE 16161000 BEGIN 16162000 IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 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]#,EQUALV=48#; 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: 16207000 IF STEPI!RELOP THEN BEGIN ERR(264);GO EXIT END; 16208000 IF STEPI=DCV THEN EMITC(ADDR,ELBAT[I-1],COMPARECODE) 16209000 ELSE IF ELCLASS=STRNGCON THEN 16210000 BEGIN 16211000 IF ACCUM[1].[12:6]!1 OR ELBAT[I-3].CLASS!IFV THEN 16211100 BEGIN ERR(271); GO EXIT END 16211200 ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 END 16211400 ELSE IF ELCLASS=LOCLID THEN 16212000 BEGIN 16212100 IF ELBAT[I-3].CLASS!IFV THEN 16212200 BEGIN ERR(271); GO EXIT END 16212300 ELSE BEGIN 16212400 EMITC(0,ELBAT[I-1].TESTCODE); % RESET TFFF. 16212500 EMITC(ELBAT[I].ADDRESS,CRF); 16212600 EMITC(0,ELBAT[I-1].TESTCODE); % COMPARE. 16212700 END 16212800 END 16212900 ELSE IF ACCUM[1]!"5ALPHA" THEN 16213000 BEGIN ERR(265);GO EXIT END 16213100 ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 ELSE BEGIN FLAG(270); ERRORTOG:=TRUE END; 16214100 GO IFTOG; 16215000 IFSB: EMITC(1,BIT); 16216000 IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000 FIX1 ~ L; 16218000 EMIT(JFC); 16219000 STEPIT; 16220000 IF ELCLASS = BEGINV OR 16221000 ELCLASS = IFV OR 16222000 ELCLASS = LITNO OR 16223000 ELCLASS = STLABID OR 16224000 ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000 BEGIN 16226000 EMIT (NOP); EMIT (NOP) 16227000 END; 16228000 IF ELCLASS= ELSEV THEN ELSE 16228500 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 FIRNALLY, 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 BEGIN ERR(260); GO TO EXIT END; 16253000 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 PROCEDURE RELEASES; 16281000 IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000 (GT1~ELBAT[I-1]).FORMAL=0 16283000 THEN ERR(256) ELSE 16284000 BEGIN 16285000 EMITC( GT1.ADDRESS,SED); 16286000 EMIT(FILETHING); FILETHING~L-1; 16287000 INFO[GT1.LINKR,GT1.LINKC].MON ~ 1; 16288000 END RELEASES; 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 SYLLABES 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 XMARK(ASSIGNREF); %116-16318500 IF SIV>STEPI OR ELCASS>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 THEN BEGIN ERR(252); GO EXIT END ELSE 16326000 IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100 BEGIN ERR(253); GO EXIT END; 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 DESINTATION 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:16]#; 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 ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000 EMITC(ADDR,ELBAT[I],OPCODE) %A 16379500 ELSE 16380000 IF ELCLASS = LITV THEN 16381000 BEGIN 16382000 EMITC(ADDR,TRP); 16383000 IF STEPI!STRING AND ELCLASS!STRNGCON AND %111-16384000 ELCLASS ! LITNO AND ELCLASS ! NONLITNO THEN %111-16384100 BEGIN ERR(255); GO TO EXIT END; 16384500 IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %111-16384700 MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800 C,8-COUNT,ACCUM[1],3); %111-16384900 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 LEBEL 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 TOSD WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 16430000 PROCEDURE JUMPS; 16431000 BEGIN 16432000 JUMPLEVEL~1; 16433000 IF STEPI!DECLARATORS THEN FLAG(261); 16434000 IF STEPI!LITNO THEN JUMPLEBEL~ 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(0&(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 = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 = LFTPAREN THEN GO TO L1; 16480000 IF ELCLASS= STLABID THEN GO TO L2 ; 16481000 IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000 L: ERR( 250 ); GO TO FINI ; 16483000 L1: NESTS; GO TO EXIT; 16484000 L2: LABELS; GO TO START; 16485000 L3: IFS; GO TO FINI; 16486000 L4: GOTOS; GO TO EXIT; 16487000 L5: RELEASES; GO TO EXIT; 16488000 L6: I~I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000 L7: INDEXS; GO TO EXIT; 16490000 L8: DSS; GO TO EXIT; 16491000 L9: SKIPS; GO TO EXIT; 16492000 L10: JUMPS; GO TO EXIT; 16493000 EXIT: STEPIT; 16494000 FINI: END STREAMSTMT; 16495000 16496000 TIME1 ~ TIME(1); PROGRAM; 17000000 ENDOFITALL: 17000100 IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000 BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ={#; %DFB 17002000 DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], %116-17002005 ((INDEX).CF DIV 2).LINKC]#, %116-17002006 CF = [33:15]#, %116-17002007 FF = [18:15]#, %116-17002008 NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF 17002009 ELSE XREFINFO[INDEX].CF)#; %116-17002010 ARRAY TIMINGS[0:2,0:3]; %116-17002012 PROCEDURE SAVETIMES(I); %116-17002015 VALUE I; INTEGER I; %116-17002020 BEGIN %116-17002025 INTEGER J; %116-17002030 FOR J := 1 STEP 1 UNTIL 3 DO %116-17002035 TIMINGS[I,J] := TIME(J); %116-17002040 END; %116-17002045 PROCEDURE UPDATETIMES(I); %116-17002050 VALUE I; INTEGER I; %116-17002055 BEGIN %116-17002060 INTEGER J; %116-17002065 FOR J := 1 STEP 1 UNTIL 3 DO %116-17002070 TIMINGS[I,J] := TIME(J) - TIMINGS[I,J]; %116-17002075 END; %116-17002080 WRITE(LINE[PAGE]); 17002520 SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. %116-17002525 LASTADDRESS~0; 17002530 FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000 WRITE(DSK2,30,XREFAY2[*]); %DFB17004000 TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. %116-17004500 XREFPT~XLUN~0; %DFB17004600 FOR I:= 0 STEP 1 UNTIL 8191 DO %116-17004700 XREFINFO[I] := 0; %116-17004710 BEGIN %DFB17005000 BOOLEAN PROCEDURE INPUT1(A); %DFB17006000 ARRAY A[0]; %DFB17007000 BEGIN %DFB17008000 LABEL L,EOF; %DFB17009000 READ(DSK1,10,A[*])[EOF]; %DFB17010000 GO TO L; %DFB17011000 EOF: INPUT1:=TRUE; %DFB17012000 REWIND(DSK1); %DFB17013000 L: %DFB17014000 END; %DFB17015000 PROCEDURE OUTPUT1(B,A); %DFB17016000 VALUE B; %DFB17017000 BOOLEAN B; %DFB17018000 ARRAY A[0]; %DFB17019000 BEGIN %DFB17020000 IF B THEN %DFB17021000 BEGIN %116-17022000 REWIND(DSK1); %116-17022100 UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 17022200 TIMINGS[0,0] := XLUN; % NUMBER OF IDENTIFIERS SORTED. 17022300 END %116-17022400 ELSE %DFB17023000 BEGIN %DFB17024000 IF BOOLEAN(A[8]) THEN %116-17025000 XREFINFO[A[8]].FF := XLUN := XLUN + 1 %116-17025100 ELSE %116-17025200 XREFINFO[A[8]].CF := XLUN := XLUN + 1; %116-17025300 A[8].IDNOF := XLUN; %116-17025400 WRITE(DSK1,10,A[*]); %DFB17026000 END; %DFB17027000 END; %DFB17028000 BOOLEAN STREAM PROCEDURE COMPS1(A,B); %DFB17029000 BEGIN %DFB17030000 SI:=A; %DFB17031000 DI:=B; %DFB17032000 IF 63 SC < DC THEN %116-17033000 TALLY := 1 %116-17033100 ELSE %116-17033200 BEGIN %116-17033300 SI := A; %116-17033400 DI := B; %116-17033500 IF 63 SC = DC THEN %116-17033600 TALLY := 2; %116-17033700 END; %116-17033800 COMPS1:=TALLY; %DFB17034000 END; %DFB17035000 STREAM PROCEDURE HVS1(A); %DFB17036000 BEGIN %DFB17037000 DI:=A; %DFB17038000 DS:=8 LIT "9"; %DFB17039000 SI:=A; %DFB17040000 DS:= 7 WDS; %DFB17041000 DS := 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS %116-17041100 END; %DFB17042000 BOOLEAN PROCEDURE COMP1(A,B); %DFB17042100 ARRAY A,B[0]; %DFB17042200 IF REAL(COMP1:=COMPS1(A,B)) = 2 THEN % IDS EQUAL %116-17042300 COMP1 := A[8].IDNOF < B[8].IDNOF; %116-17042350 PROCEDURE HV1(A); %DFB17042400 ARRAY A[0]; %DFB17042500 HVS1(A); %DFB17042600 XLUN:=0; %DFB17043000 REWIND(DSK1); %DFB17044000 SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN %116-17045000 7000 ELSE 10000); %116-17045100 END; %DFB17046000 BEGIN %DFB17047000 ARRAY IDTYPE[0:(IDMAX+4)|4-1]; %117-17047100 STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, %116-17047200 FWDSEQNO,TYPE,OWNTOG,PARAMTOG, %116-17047300 VALTOG); %116-17047350 VALUE SEQG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, %116-17047400 VALTOG; %116-17047450 BEGIN %116-17047500 SI := S; %116-17047700 DI := D; %116-17047800 63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); %116-17047900 DS := 6 LIT " -- "; %116-17048000 OWNTOG (DS := 4 LIT "OWN "); %116-17048100 SI := TYPE; %116-17049300 32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); %116-17049400 PARAMTOG (DS := 6 LIT " -- "; %116-17049410 DS := 4 LIT "NAME"; %116-17049420 VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); %116-17049430 DS := 10 LIT " PARAMETER"); %116-17049440 DS := 26 LIT " -- DECLARED IN SEGMENT "; %116-17049500 SI := LOC SEG; %116-17049600 S := SI; %116-17049700 DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800 DI := DI + 8; % TO FORCE STORE OF LAST WORD %116-17049900 SI := S; %116-17050000 DI := S; %116-17050100 4(IF SC ! " " THEN DS:= CHR ELSE SI := SI + 1); %116-17050200 DS := 4 LIT " AT "; %116-17050300 SI := LOC SEQNO; %116-17050400 DS := 8 DEC; %116-17050500 FWDTOG (DS := 17 LIT " -- FORWARD AT "; %116-17050600 SI := LOC FWDSEQNO; %116-17050700 DS := 8 DEC); %116-17050800 LBLTOG (DS := 16 LIT " -- OCCURS AT "; %116-17050900 SI := LOC FWDSEQNO; %116-17051000 DS := 8 DEC); %116-17051100 END OF SETUPHEADING; %116-17051200 %116-17051300 STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); %116-17051400 VALUE SEQNO,N,STARS; %116-17051500 BEGIN %116-17051600 DI := D; %116-17051700 DI := DI + 8; %116-17051800 N (DI := DI + 10); %116-17051900 STARS(DO := DI - 1; DS := LIT "*"); %116-17052000 SI := LOC SEQNO; %116-17052100 DS := 8 DEC; %116-17052200 DS := LIT " "; %116-17052300 STARS (DI := DS - 1; DS := LIT "*"); %116-17052400 END; %116-17052500 STREAM PROCEDURE BLANKET(D); %116-17052600 BEGIN %116-17052700 DI := D; %116-17052800 DS := 8 LIT " "; %116-17052900 SI := D; %116-17053000 DS := 16 WDS; %116-17053100 END OF BLANKET; %116-17053200 PROCEDURE PRINTXREFSTATISTICS; %116-17053300 BEGIN %116-17053400 SWITCH FORMAT STATS := %116-17053500 (///, "CROSS REFERENCE STATISTICS", /, %116-17053600 "----- --------- ----------", /), %116-17053700 ("PHASE ONE - SORT",I6," IDENTIFIERS"), %116-17053800 ("PHASE TWO - SORT",I7," REFERENCES"), %116-17053900 ("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), %116-17054000 (X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), %116-17054100 (X5,I4,":",2I1," PROCESSOR TIME"), %116-17054200 (X5,I4,":",2I1," I/O TIME",/); %116-17054300 INTEGER I,J,K; %116-17054400 WRITE(LINE,STATS[0]); %116-17054500 FOR I := 0 STEP 1 UNTIL 2 DO %116-17054600 BEGIN %116-17054700 WRITE(LINE,STATS[I+1],TIMINGS[I,0]); %116-17054800 FOR J := 1 STEP 1 UNTIL 3 DO %116-17054900 BEGIN %116-17055000 K := (TIMINGS[I,J] + 30) DIV 60; % ROUND TO NEAREST SECON17055010 WRITE(LINE,STATS[J+3],K DIV 60,(K:=K MOD 60) DIV 10,%116-17055020 K MOD 10); %116-17055025 END; %116-17055030 END; %116-17055100 END PRINTXREFSTATISTICS; %116-17055200 DEFINE REFCOUNT = TIMINGS[1,0]#; % NUMBER OF REFERENCES SORTED.17069300 BOOLEAN FIRSTTIME; % TRUE ON FIRST CALL OF OUTPUT PROCEDURE. 17069400 ARRAY PAY[0:17]; %DFB17069500 REAL LASTADDRESS; %116-17069600 BOOLEAN PROCEDURE INPUT2(A); %DFB17070000 ARRAY A[0]; %DFB17071000 BEGIN %DFB17072000 LABEL L,EOF; %DFB17073000 DEFINE I = LASTADDRESS#; %116-17073100 IF XREFPT:=XREFPT+1=30 THEN %DFB17074000 BEGIN %DFB17075000 READ(DSK2,30,XREFAY2[*])[EOF]; %DFB17076000 XREFPT:=0; %DFB17077000 END; %DFB17078000 IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF;17079000 A[0] := I & NEWID[I,REFIDNOF] REFIDNOF; %116-17080000 REFCOUNT := REFCOUNT + 1; %116-17080100 GO TO L; %DFB17081000 EOF: INPUT2:=TRUE; %DFB17082000 BLANKET(PAY); %DFB17083000 XREFAY1[8] := XREFPT := LASTADDRESS := 0; %116-17084000 FILL IDTYPE[*] WITH %116-17084010 "UNKNOWN. ", % 0 %116-17084020 "STREAM LABEL. ", % 1 %116-17084030 "STREAM VARIABLE. ", % 2 %116-17084040 "DEFINE. ", % 3 %116-17084050 "LIST. ", % 4 %116-17084060 "FORMAT. ", % 5 %116-17084070 "SWITCH FORMAT. ", % 6 %116-17084080 "FILE. ", % 7 %116-17084090 "SWITCH FILE. ", % 8 %116-17084100 "SWITCH LABEL. ", % 9 %116-17084110 "PROCEDURE. ", % 10 %116-17084120 "INTRINSIC. ", % 11 %116-17084130 "STREAM PROCEDURE. ", % 12 %116-17084140 "BOOLEAN STREAM PROCEDURE. ", % 13 %116-17084150 "REAL STREAM PROCEDURE. ", % 14 %116-17084160 "ALPHA STREAM PROCEDURE. ", % 15 %116-17084170 "INTEGER STREAM PROCEDURE. ", % 16 %116-17084180 "BOOLEAN PROCEDURE. ", % 17 %116-17084182 "REAL PROCEDURE. ", % 18 %116-17084184 "ALPHA PROCEDURE. ", % 19 %116-17084186 "INTEGER PROCEDURE. ", % 20 %116-17084188 "BOOLEAN. ", % 21 %116-17084190 "REAL. ", % 22 %116-17084200 "ALPHA. ", % 23 %116-17084210 "INTEGER. ", % 24 %116-17084220 "BOOLEAN ARRAY. ", % 25 %116-17084230 "REAL ARRAY. ", % 26 %116-17084240 "ALPHA ARRAY. ", % 27 %116-17084250 "INTEGER ARRAY. ", % 28 %116-17084260 "LABEL. ", % 29 %116-17084270 "FAULT. ", % 30 (CLASS = 125) %117-17084275 "SWITCH LIST. ", % 32 (CLASS = 126) %117-17084280 "SWITCH LIST. "; % 31 (CLASS = 127) %117-17084290 L: %DFB17085000 END; %DFB17086000 PROCEDURE OUTPUT2(B,A); %DFB17087000 VALUE B; %DFB17088000 BOOLEAN B; %DFB17089000 ARRAY A[0]; %DFB17090000 BEGIN DEFINE PRINTER=LINE#; %DFB17091000 LABEL EOF2, SKIP; %116-17091100 OWN BOOLEAN B2, FWDTOG, LBLTOG, WAITINGFORFWDREF; %116-17091110 DEFINE MATCH(A,B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = %116-17091115 REAL(NOT FALSE)#; %116-17091116 REAL I; %116-17091120 DEFINE LINECOUNT = TIMINGS[2,0]#; % NUMBER OF LINES PRINTED. 17091140 OWN REAL FWDSEQNO; %116-17091150 IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. %116-17091155 BEGIN %116-17091160 FIRSTTIME := FALSE; %116-17091162 TIME1 := TIME(1); %116-17091165 DATIME; %116-17091170 UPDATETIMES(1); %116-17091175 SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. %116-17091180 END; %116-17091200 IF NOT B2 THEN %116-17091210 IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. %116-17091300 IF XREFPT ! 0 THEN % WE GOT SOME TO LIST OUT %116-17091400 BEGIN %116-17091500 WRITE(LINE[DBL],15,PAY[*]); %116-17091510 LINECOUNT := LINECOUNT + 1; %116-17091520 END %116-17091530 ELSE % NOTHING TO LIST OUT %116-17091600 ELSE % NOT END OF SORT %116-17091700 IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF ! 0 AND 17091800 A[0].REFIDNOF } XREFAY1[8].IDNOF THEN %116-17091900 IF A[0].TYPEREF = FORWARDREF THEN % %116-17092000 WAITINGFORFWDREF := TRUE %116-17092100 ELSE %116-17092200 IF A[0].TYPEREF = LBLREF THEN % %116-17092300 BEGIN %116-17092400 LBLTOG := TRUE; %116-17092500 FWDSEQNO := A[0].SEQNOF; %116-17092600 END %116-17092700 ELSE %116-17092800 IF A[0].TYPEREF = DECLREF THEN %116-17092900 IF WAITINGFORFWDREF THEN % THIS MUST BE IT %116-17093000 BEGIN %116-17093100 WAITINGFORFWDREF := FALSE; %116-17093200 FWDTOG := TRUE; %116-17093300 FWDSEQNO := A[0].SEQNOF; %116-17093400 END %116-17093500 ELSE % ITS A NORMAL DECLARATION - NOT FORWARD%116-17093600 BEGIN %116-17093700 IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN %116-17093850 DO %116-17093900 READ(DSK1,10,XREFAY1[*]) [EOF2] %116-17093950 UNTIL %116-17094000 A[0].REFIDNOF { XREFAY1[8].IDNOF; %116-17094050 IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN%116-17094100 GO TO SKIP; %116-17094150 IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200 BEGIN %116-17094240 IF SINGLTOG THEN %116-17094250 WRITE(LINE,15,PAY[*]) %116-17094300 ELSE %116-17094350 WRITE(LINE[DBL],15,PAY[*]); %116-17094400 LINECOUNT := LINECOUNT + 1; %116-17094410 END %116-17094420 ELSE %116-17094450 IF NOT SINGLTOG THEN %116-17094500 WRITE(LINE); %116-17094550 XREFPT := 0; %116-17094600 BLANKET(PAY[*]); %116-17094650 SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8], 17094700 SEGNOF,A[0],SEQNOF,FWDTOG,LBLTOG, %116-17094800 FWDSEQNO.IDTYPE[(IF (I := %116-17094900 XREFAY1[9].CLASS) } FIELDID THEN %117-17095000 (IDMAX + I - FIELDID + 1) ELSE %117-17095100 IF I > IDMAX THEN 0 ELSE I) | 4], %116-17095200 REAL(I } BOOID AND XREFAY1[9].[9:2] = 1), 17095300 REAL((I } BOOID OR I = LOCLID) AND BOOLEAN 17095310 (XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 17095320 FWDTOG := LBLTOG := FALSE; %116-17095400 WRITE(LINE,15,PAY[*]); %116-17095500 LINECOUNT := LINECOUNT + 1; %116-17095510 BLANKET(PAY[*]); %116-17095550 END %116-17095600 ELSE % IT MUST BE A NORMAL REFERENCE %116-17095700 IF A[0].SEQNOF ! LASTADDRESS.SEQNOF THEN %116-17095750 BEGIN %116-17095800 ADDASEQNO(A[0],SEQNOF,XREFPT,A[0].[5:1], 17095900 PAY[*]); %116-17096000 IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100 BEGIN %116-17096200 WRITE(LINE,15,PAY[*]); %116-17096300 LINECOUNT := LINECOUNT + 1; %116-17096350 XREFPT := 0; %116-17096400 BLANKET(PAY[*]); %116-17096450 END %116-17096500 END %116-17096550 ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT %116-17096575 ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 17096600 ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 17096700 EOF2: B2 := TRUE; % SO SORT CAN GO TO NORMAL EOJ %116-17096800 IF NOT B THEN SKIP: LASTADDRESS := A[0]; %116-17096850 END OF OUTPUT2; %116-17096900 PROCEDURE HV2(A); %DFB17112000 ARRAY A[0]; %DFB17113000 A[0] := 3"777777777777777"; % BIGGEST FLOATING PT. NO. %116-17114000 BOOLEAN PROCEDURE COMP2(A,B); %DFB17115000 ARRAY A,B[0]; %DFB17116000 COMP2 := IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 17117000 TRUE %116-17117100 ELSE %116-17117200 IF A[0].REFIDNOF = B[0].REFIDNOF THEN %116-17117300 IF A[0].[1:4] LSS B[0].[1:4] THEN %116-17117400 TRUE %116-17117500 ELSE %116-17117600 IF A[0].[1:4] = B[0].[1:4] THEN %116-17117700 IF A[0].SEQNOF < B[0].SEQNOF THEN %116-17117702 TRUE %116-17117704 ELSE %116-17117706 IF A[0].SEQNOF = B[0].SEQNOF THEN%116-17117708 BOOLEAN(A[0].[5:1]) %116-17117710 ELSE %116-17117712 FALSE %116-17117714 ELSE %116-17117720 FALSE %116-17117730 ELSE %116-17117800 FALSE; %116-17117900 SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT %116-17117910 FIRSTTIME := TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 17117920 XREFPT:=20; REWIND(DSK2); %DFB17118000 SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,6000); %116-17119000 UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE%116-17119100 PRINTXREFSTATISTICS; %116-17119200 END; %DFB17120000 END; %DFB17121000 END OF MAIN BLOCK; 17121500 END. %DFB17122000 %NUMBER OF ERRORS DETECTED = 1. COMPILATION TIME = 532 SECONDS. 99990000 %NUMBER OF CARD-IMAGES PROCESSED = 12712. 99991000