% G T L C O M P I L E R M A R K X I I I . 3 6 10/11/71 %T9300000000 % 00000001 % WRITTEN BY MARTIN ALEXANDER GA TECH RECC 00000002 T03 $PUSH,POP,INCLUDE,OMIT, CHANGE PRINT LINE, CHECK CONSTRUCTS. %T0300000003 T07 CHANGE HEADER AND TRAILER PRINTOUTS. %T0700000007 T11 FIX SINGLE SPACING AND DISK FILE SIZE %T1100000011 T14 PRINT ERROR MESSAGE, NOT ERROR NUMBER %T1400000014 T29 COMMUNICATE STATEMENTS %T2900000029 T60 IMPLEMENT READ [V1,V2,...VN] FOR LIST-DIRECTED PRINT-READ. %T6000000060 T89 FIX USE OF PARAMETRIC DEFINES IN STREAMS. %T8900000089 T90 CHANGE FILE REMOTE TO TYPE 19 AND FIX OTHER GTL ERRORS %T9000000090 T91 ALLOW ARRAYS TO BE USED IN BOOLEAN STRING RELATION SYNTAX %T9100000091 T92 MAKE CHANGES TO GTL TO ACCEPT MARK XI & XII ALGOL PATCHES %T9200000092 T93 BRING GTL IN ACCORDS WITH MANUAL AND ADD MARK XIII PATCHES %T9300000093 T98 LIMIT MAX NUMBER OF ERRORS %T9800000098 RESTRICTED VERSION. DATE OF LATEST MODIFICATION: %M00000100 03/23/70 %T9000000101 W27 STEPI AND STEPIT DEFINES. %W2700000127 %09000000200 %#######################################################################00001000 % 00001010 % B-5700 G T L COMPILER %T9300001020 % MARK XIII.36 %T9300001030 % OCTOBER 11, 1971 %T9300001040 % 00001050 %#######################################################################00001060 % 00001070 COMMENT#################################################################00001110 G T L ERROR MESSAGES %T9300001120 ########################################################################00001130 % 00001140 ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000 000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000 001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000 002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000 IDENTIFIER NOT APPEARING IN 00006000 FORMAL PARAMETER PART. 00007000 003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000 LIST OF DECLARATION. 00009000 004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000 PRECEDED BY ILLEGAL DECLARATOR. 00011000 005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000 BY ILLEGAL DECLARATOR. 00013000 006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000 IN SAME BLOCK(NOT FORWARD). 00015000 007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000 BY ( OR SEMICOLON IN PROCEDURE 00017000 DECLARATION. 00018000 008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000 BY ). 00020000 009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000 BY SEMICOLON. 00022000 010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000 WHICH DID NOT APPEAR IN FORMAL 00024000 PARAPART. 00025000 011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000 012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000 PART. 00028000 013 PROCEDUREDEC: OWN USED IN ARRAY SPECIFICATION. 00029000 014 PROCEDUREDEC: SAVE USED IN ARRAY SPECIFICATION. 00030000 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. %D00030500 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. %P00058000 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 BEGIN WITH A QUANTITY OF THIS 00076000 TYPE. 00077000 104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000 105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000 106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000 107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000 108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000 AS THE ARITHMETIC EXPRESSIONS. 00083000 109 BOOSEC,SIMPBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000 110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000 EXPRESSION. 00086000 111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000 TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000 112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000 TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000 113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000 A CONCATENATE OPERATOR IS INCORRECT. 00092000 114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS00093000 FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000 115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE. 00095000 116 IFCLAUSE: MISSING THEN. 00096000 117 BANA: MISSING LEFT BRAKET. 00097000 118 BANA: MISSING RIGHT BRAKET. 00098000 119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000 120 COMPOUNDTAIL: MISSING END. 00100000 121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000 ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000 PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000 METER. 00104000 122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000 EXPRESSION PASSED TO IT BY NAME. 00106000 123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000 AGREE AS TO TYPE. 00108000 124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000 NUMBER OF DIMENSIONS. 00110000 125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000 PARAMETER TO A PROCEDURE. 00112000 126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000 QUANTITY OF THIS TYPE. 00114000 127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000 STREAM PROCEDURE. 00116000 128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000 NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000 129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000 130 RELSESTMT: NO FILE NAME. 00120000 131 DOSTMT: MISSING UNTIL. 00121000 132 WHILESTMT: MISSING DO. 00122000 133 LABELR: MISSING C OLON. 00123000 134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000 135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000 136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000 137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000 INTEGER WHERE AN INTEGER IS REQUIRED. 00128000 138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000 PHRASE. 00130000 139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000 140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000 141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000 CHARACTORS. 00134000 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000 (BLANK SUPPRESSED). 00136000 143 COMPOUNDTAIL: EXTRA END. 00137000 144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000 145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000 146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000 A MISSING END OF A PROCEDURE OR A MISPLACED 00141000 DECLARATION. 00142000 147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000 DECLARATION. 00144000 148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000 ARE REQUIRED FOR THIS PROGRAM. 00146000 149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000 PROCEDURE. 00148000 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000 STREAM PROCEDURES. 00150000 151 FORSTMT: 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 LIST00156000 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 OR 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 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 00185000 255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00186000 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000 A FORMAL PARAMETER. 00188000 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000 NEST LEVEL AS A PRECEDING APPEARANCE OF THE 00190000 LABEL. 00191000 258 LABELS: MISSING :. 00192000 259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000 260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000 261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000 262 NESTS: MISSING PARENTHESIS. 00196000 263 IFS:MISSING SC IN IF STATEMENT. 00197000 264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000 265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000 266 IFS: MISSING THEN INIF STATEMENT. 00200000 267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000 UNDEFINED. 00202000 268 EMITC: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00203000 FORMAL PARAMETERS,LOCALS AND LABELS. 00204000 269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000 OR TOO SMALL. 00206000 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00206100 271 IFS: IMPROPER CONSTRUCT FOR . 00206200 275 STRMSTMT: JUMP LONGER THAN 63 SYLLABLES %W1100206500 281 DBLSTMT: MISSING (. 00207000 282 DBLSTMT: TOO MANY OPERATORS. 00208000 283 DBLSTMT: TOO MANY OPERANDS. 00209000 284 DBLSTMT: MISSING , . 00210000 285 DBLSTMT: MISSING ) . 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 INDNTIFIER FOLLOWING THE WORD FILL IS NOT 00212000 AN ARRAY IDENTIFIER. 00213000 301 FILLSTMT: MISSING WITH IN FILL STATEMENT. 00214000 302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000 303 FILLSTMT: NON OCTAL CHARACTER IN OCTAL FILL. THE THREE 00216000 LOW ORDER BITS ARE CONVERTED AND COMPILATION 00217000 CONTINUES. 00218000 304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100 305 FILLSTMT: STRING FILL: STRING EXCEEDS 1023 CHARACTERS %M00218150 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 PARAMETER 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 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 STATEMENT. 00294000 457 CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT. 00295000 458 CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE 00296000 STATEMENT. 00297000 459 CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00298000 460 RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT. 00299000 461 RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT. 00300000 462 RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00301000 463 BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION 00302000 PART OF A PROCEDURE. 00303000 464 BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00304000 OF A PROCEDURE. 00305000 465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003 SIMPLE VARIABLE 00305004 475 FOR LISTNAME NOT FOLLOWED BY DO %W3300305006 476 LISTGEN: LISTGEN MAY NOT BE CALLED RECURSIVELY. %W3300305007 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. %B0200305095 510 FORSTLIST: FOR DO IN PROC BODY ONLY %73 %W3300305100 600 ARRAYDEC: ARRAY SIZE TOO LARGE %T9300306000 601 FORMALARRAY: NUMBER OF DIMENSIONS EXCEEDS 7 %A00307000 602 NEWINTRINSIC: RECALL CANNOT BE USED WITHOUT %A00308000 REMEMBER AND VICE VERSA %A00309000 603 EMIT: LOCAL STRING SEGMENT TOO LARGE %A00310000 604 EMIT: INTERNAL STRING EXPRESSION JUMP TOO FAR %A00311000 605 LIT: MISSING NUMBER OR NUMBER TOO LARGE %A00312000 606 ANYWHERE: MISSING COMMA %A00313000 607 ANYWHERE: MISSING RIGHT BRACKET %A00314000 608 RPROP: MISSING RECORD TYPE %A00315000 609 CONVAL: MISSING OR ILLEGAL NUMBER %A00316000 610 ARAY: ARRAY ROW NOT ALLOWED HERE %A00317000 611 DBLPRIM: DOUBLE PRIMARY MAY NOT BEGIN WITH QUANTITY %A00318000 OF THIS TYPE %A00319000 612 REXP: ILLEGAL RECORD EXPRESSION %A00320000 613 REXP: RECORD CLASSES DO NOT AGREE %A00321000 614 FIELDINDEX: MISSING RIGHT BRACKET %A00322000 615 GENQUOTE: ILLEGAL LIST ITEM %A00323000 616 GENQUOTE: TOO MANY RIGHT PARENTHESES IN LIST %A00324000 617 CHAINOP: MISSING ~ IN ASSIGNMENT STATEMENT %A00325000 618 SYMBOLEXP: ILLEGAL SYMBOL EXPRESSION %A00326000 619 RETURN: USED OUTSIDE OF SCOPE %A00327000 620 EXIT: USED OUTSIDE OF SCOPE %A00328000 621 RECLAIM: SYMBOL REFERENCES CANNOT BE EXPLICITLY RECLAIMED %A00329000 WHEN USING AUTOMATIC STORAGE RECLAMATION %A00330000 622 RECALL-REMEMBER: ILLEGAL FILE IDENTIFIER %A00331000 623 PRINT: PRINT STRING TOO LARGE %A00332000 624 IOSTMT: ILLEGAL FILE OR PROCEDURE IDENTIFIER IN %A00333000 INPUT OR OUTPUT STATEMENT %A00334000 625 IOSTMT: ILLEGAL STRING IDENTIFIER IN %A00335000 INPUT OR OUTPUT STATEMENT %A00336000 626 NOGO: THIS DESIGNATIONAL EXPRESSION NOT PERMITTED %A00337000 WHEN USING AUTOMATIC STORAGE RECLAMATION %A00338000 627 RECORDGEN: UNDEFINED FIELD IDENTIFIER IN RECORD GENERATOR %A00339000 628 FIELDGEN: A FIELD CANNOT BE A FORMAL PARAMETER %A00340000 629 FIELDGEN: ILLEGAL FIELD DECLARATION %A00341000 630 FIELDGEN: FIELD PREVIOUSLY DECLARED IN SAME BLOCK %A00342000 631 FIELDGEN: MISSING COLON %A00343000 632 FIELDGEN: FIELD TOO SMALL FOR REFERENCE VALUE %A00344000 633 RECORDGEN: NUMBER OF RECORD CLASSES EXCEEDS 30 %A00345000 634 STRINGEN: DECLARED STRING LENGTH EXCEEDS 8184 CHARACTERS %A00346000 635 RECORDGEN: ACTUAL NUMBER OF SUBSCRIPTS OF INDEXED FIELD %A00347000 IS NOT EQUAL TO DECLARED NUMBER %A00348000 636 FIELDC: FIELD NOT CONTAINED IN GIVEN RECORD CLASS %A00349000 637 GENQUOTE: MISSING " IN QUOTED SYMBOL EXPRESSION %A00350000 638 PRINT: UNPRINTABLE EXPRESSION %A00351000 639 SYMBOLDEFINE: ILLEGAL PROPERTY LIST ELEMENT %A00351100 640 SYMBOLDEFINE: MISSING ] %A00351200 641 SYMBOLDEFINE: ATOMIC SYMBOL MUST PRECEDE PROPERTY LIST PART %A00351300 642 SYMBOLDEFINE: MISSING : %A00351400 643 LISTELEMENT: ILLEGAL LIST ELEMENT %A00351410 644 IOSTMT: MISSING INPUT STATEMENT %A00351420 645 IOSTMT: MISSING OUTPUT STATEMENT %A00351430 700 AMONG: MISSING STRING %A00352000 701 BITXP: REPEAT INDICATOR TOO LARGE IN BIT EXPRESSION %A00353000 702 BITXP: BIT1 OR BIT0 EXPECTED %A00354000 703 STRINGINT: REPEAT INDICATOR NOT PERMITTED HERE %A00355000 704 STRINGXP: STRING EXPRESSION (LENGTH) OVERFLOW %A00356000 705 STRINGXP: QUOTED STRING TOO LONG %A00357000 706 STRINGLOOP: MISSING COLON %A00358000 707 STRINGLOOP: STRING EXPRESSION TOO LARGE %A00359000 708 STRINGXP: STRING EXPRESSION CANNOT CANTAIN %A00360000 THIS TYPE QUANTITY %A00361000 709 STRINGXP: REPEAT INDICATOR TOO LARGE %A00362000 710 STRINGVAR: SUBSTRING NOT IN DESIGNATED STRING OR %A00363000 MISSING OR FORMAL STRING IDENTIFIER %A00364000 711 STRINGVAR: ARRAY ROW DESIGNATOR NOT PERMITTED HERE %A00365000 712 STRINGVAR: STRING DESIGNATOR NOT PERMITTED HERE %A00366000 713 STRINGVAR: STARTING POSITION PLUS SUBSTRING LENGTH %A00367000 EXCEEDS LENGTH OF MAIN STRING %A00368000 714 STRINGXP: MISSING RELATIONAL OPERATOR IN STRING %A00369000 COMPARISON EXPRESSION %A00370000 715 STRINGLOOP: MISSING ] %A00371000 716 STRINGXP: STRINGS ON LEFT AND RIGHT HAND SIDES OF %A00372000 RELATIONAL OPERATOR KNOWN TO BE OF UNEQUAL %A00373000 LENGTH %A00374000 717 STRINGSEC: MISSING ~ %A00375000 ; %M00499000 BEGIN COMMENT OUTERMOST BLOCK; 00500000 INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000 SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000 INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000 IF COMPILE & GO =0. FOR SYNTAX, =-1. MUST BE AT R+26;00504000 INTEGER CARDNUMBER; 00504100 INTEGER LASTADDRESS; 00504200 INTEGER ERRORMAX; % %T9800504250 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 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 01000700 INTEGER LASTELCLASS; %SAVES ELCLASS %W4001000713 BOOLEAN CHECKTOG; 01000800 BOOLEAN GOGOGO;% TRUE FOR SPECIAL WRITES AND READS 01000810 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 BOOLEAN SEQTOG, NEWBASE; COMMENT SEQTOG INDICATES SEQUENCING IS 01000910 REQD. NEWBASE INDICATES A NEW BASENUM IS FOUND ON A NEW $ CRD;01000920 BOOLEAN LASTCRDPATCH; COMMENT NORMALLY FALSE, SET TO 01000960 TRUE WHEN THE LAST CARD FROM SYMBOLIC LIBRARY 01000970 READ IS PATCHED FROM THE CARD READER; 01000980 BOOLEAN LISTOG,PRTOG,DEBUGTOG,NEWTOG,PUNCHTOG,VOIDTAPE; 01001000 BOOLEAN SINGLTOG; 01001010 BOOLEAN NOTPNTED; 01001020 BOOLEAN REMOTERR; ARRAY BITS[0:22]; % %T1401001050 DEFINE NOHEADING=LISTOG.[46:1]# ; %%% TRUE IFF DATIME HAS NOT BEEN CALLD01001100 DEFINE XREFINFO[XREFINFO1,XREFINFO2]= 01001750 XINFO[XREFINFO1,(XREFINFO2)DIV 2]#, 01001760 XMARK= IF XREF THEN XREFAY2[XREFPT-1].[1:1]~1#; 01001770 COMMENT THESE TOGGLES SPECIFY THE ACTION REQUIRED BY A CONTROL CARD;01002000 REAL SEQERRORCOUNT ; BOOLEAN SEQERRORTOG ; % %T0301002010 BOOLEAN ARRAY OPTHOLD[0:31]; ARRAY BASHOLD,TOTHOLD,ADDHOLD[0:31]; % %T0301002020 INTEGER ZOPT; ARRAY L1N[0:9]; % %T0301002030 BOOLEAN GOTCHA,STREAMER; % %T0301002040 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 ARRAY XREFAY2[0:29],XREFAY1[0:10],XINFO[0:31,0:127]; 01007100 INTEGER XREFPT,XLUN; %DFB01007200 BOOLEAN XREF; %DFB01007500 COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000 THE INTERNAL CODE ( OR ELBAT WORD AS IT IS USUALLY 01010000 CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000 [1:1]) FOR PROCEDURES, THE LINK TO PREVIOUS ENTRY (IN 01012000 [4:8]), THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000 TION (IN [12:6]), AND THE FIRST 5 CHARACTORS OF ALPHA. 01014000 SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000 FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000 AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLIT ACROSS A ROW 01017000 OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000 RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000 DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000 IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000 OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 01022000 ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000 THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000 THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000 RESERVED WORDS OCCUPY THE SECOND ROW. IT IS FILLED DURING 01026000 INITIALIZATION; 01027000 COMMENT INFO FORMAT 01028000 FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000 ENTERED IN INFO: 01030000 THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000 THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000 ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000 ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000 E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 01035000 LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000 THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000 THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000 POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000 THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.,THE 01040000 LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000 FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000 ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000 WILL NOT DETRACT FROM THE DISCUSSION. 01044000 ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000 THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000 FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000 THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 01048000 S[L] 01049000 NOW THE DECLARATION 01050000 BEGIN REAL A,B,C IS ENCOUNTERED 01051000 IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000 THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000 CONSTRUCTED FOR A) 01054000 T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 01055000 INFO[NEXTINFO]~T. S[L]~NEXTINFO. 01056000 NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000 ENTRY. 01058000 NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000 ITSELF CONTAINS THE STOP FLAG ZERO. 01060000 B IS ENTERED SIMILARLY TO A. 01061000 NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000 ENTRY FOR A. 01063000 SIMILARLY,AFTER C IS ENTERED 01064000 S[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000 POINTS TO A. 01066000 THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000 FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000 FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL 01069000 FULL DECLARATION. 01070000 PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000 INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBTRACTED 01072000 FROM THE CURRENT ENTRY INDEX. 01073000 [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY.(<64) 01074000 [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000 AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000 THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000 THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000 FOR X WOULD APPEAR AS FOLLOWS: 01079000 INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000 I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000 I+2 = L 01082000 I+3 = ELBATWRD (MADE FOR X) 01083000 I+4 = 031X 01084000 THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000 THE ENTRY BEFORE SYMBOL, AND 01086000 INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000 ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000 THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000 FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000 NECESSARY. 01091000 THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000 REAL 01093000 BOOLEAN 01094000 INTEGER 01095000 ALPHA 01096000 FILE 01097000 FORMAT 01098000 LIST 01099000 OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000 ARRAYS: 01101000 THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000 DIMENSIONS(IN THE LOW ORDER PART).[40:8] 01103000 EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000 BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000 THESE WORDS ARE MADE UP AS FOLLOWS: 01106000 [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000 SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000 RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000 TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000 SUBTRACTED. 01111000 [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000 REQUIRES A PRT OR STACK CELL,OTHERWISE THE BIT 01113000 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000 REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000 [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000 IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000 PROCEDURES: 01118000 THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000 PARAMETERS [40:8] 01120000 IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000 [13:11] ENDING PRT ADDRESS FOR LABELS, 01122000 [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000 OF LOCALS. 01124000 SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000 OF APPEARANCE IN FORMAL PARAPART) ARE 01126000 ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000 VALUE OR NOT([10:1]). 01128000 THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000 IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000 CONTAINS THE NUMBER OF DIMENSIONS.OTHERWISE INCR IS MEANINGLESS. 01131000 LINK([35:13]) IS MEANINGLESS. 01132000 IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMATER IS 01133000 THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000 IS DONE IN THE STREAM PROCEDURE. 01135000 LABELS: 01136000 AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000 BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000 IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000 LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000 SWITCHES: 01142000 THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000 ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000 IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000 NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000 DEFINE MON =[ 1: 1]#, 01147000 CLASS =[ 2: 7]#, 01148000 FORMAL=[ 9: 1]#, 01149000 VO =[10: 1]#, 01150000 LVL =[11: 5]#, 01151000 ADDRESS=[16:11]#, 01152000 INCR =[27: 8]#, 01153000 LINK =[35:13]#, 01154000 DYNAM =[11:16]#, 01154100 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 VO IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000 DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000 FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000 FROM OTHERS. 01166000 LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000 ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000 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 NINFOO. 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 =000#, COMMENT 000; %M01177000 STLABID =001#, COMMENT 001; %M01178000 LOCLID =002#, COMMENT 002; %M01179000 DEFINEDID =003#, COMMENT 003; %M01180000 FAULTID =004#, COMMENT 004; %M01180100 LISTID =005#, COMMENT 005; %M01181000 SUPERLISTID =006#, COMMENT 006; %M01181010 FRMTID =007#, COMMENT 007; %M01182000 SUPERFRMTID =008#, COMMENT 010; %M01183000 FILEID =009#, COMMENT 011; %M01184000 SUPERFILEID =010#, COMMENT 012; %M01185000 SWITCHID =011#, COMMENT 013; %M01186000 PROCID =012#, COMMENT 014; %M01187000 STRPROCID =013#, COMMENT 015; %M01187100 FIELDID =014#, COMMENT 016; %M01187200 STRTRNS =015#, COMMENT 017; %M01187300 DBLPLXTRNS =016#, COMMENT 020; %M01187400 SYMTRNS =017#, COMMENT 021; %M01187500 RECTRNS =018#, COMMENT 022; %M01187600 BOOTRNS =019#, COMMENT 023; %M01187700 INTRNSICPROCID =020#, COMMENT 024; %M01188000 ALFATRNS =021#, COMMENT 025; %M01189000 INTRNS =022#, COMMENT 026; %M01189100 STRINGSTRPROCID =023#, COMMENT 027; %M01189200 DBLPLXSTRPROCID =024#, COMMENT 030; %M01189300 SYMSTRPROCID =025#, COMMENT 031; %M01189400 RECSTRPROCID =026#, COMMENT 032; %M01189500 BOOSTRPROCID =027#, COMMENT 033; %M01190000 REALSTRPROCID =028#, COMMENT 034; %M01191000 ALFASTRPROCID =029#, COMMENT 035; %M01192000 INTSTRPROCID =030#, COMMENT 036; %M01193000 STRINGPROCID =031#, COMMENT 037; %M01193100 DBLPLXPROCID =032#, COMMENT 040; %M01193200 SYMPROCID =033#, COMMENT 041; %M01193300 RECPROCID =034#, COMMENT 042; %M01193400 BOOPROCID =035#, COMMENT 043; %M01194000 REALPROCID =036#, COMMENT 044; %M01195000 ALFAPROCID =037#, COMMENT 045; %M01196000 INTPROCID =038#, COMMENT 046; %M01197000 STRINGID =039#, COMMENT 047; %M01197100 DBLPLXID =040#, COMMENT 050; %M01197200 SYMID =041#, COMMENT 051; %M01197300 RECID =042#, COMMENT 052; %M01197400 BOOID =043#, COMMENT 053; %M01198000 REALID =044#, COMMENT 054; %M01199000 ALFAID =045#, COMMENT 055; %M01200000 INTID =046#, COMMENT 056; %M01201000 STRINGARRAYID =047#, COMMENT 057; %M01201100 DBLPLXARRAYID =048#, COMMENT 060; %M01201200 SYMARRAYID =049#, COMMENT 061; %M01201300 RECARRAYID =050#, COMMENT 062; %M01201400 BOOARRAYID =051#, COMMENT 063; %M01202000 REALARRAYID =052#, COMMENT 064; %M01203000 ALFAARRAYID =053#, COMMENT 065; %M01204000 INTARRAYID =054#, COMMENT 066; %M01205000 LABELID =055#, COMMENT 067; %M01206000 COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000 TRUTHV =056#, COMMENT 070; %M01208000 NONLITNO =057#, COMMENT 071; %M01209000 LITNO =058#, COMMENT 072; %M01210000 STRNGCON =059#, COMMENT 073; %M01211000 LEFTPAREN =060#, COMMENT 074; %M01212000 NILV =061#, COMMENT 075; %M01212100 QUOTEOP =062#, COMMENT 076; %M01212200 CHAINOP =063#, COMMENT 077; %M01212300 COMMENT CLASS FOR ALL DECLARATORS; 01213000 DECLARATORS =064#, COMMENT 100; %M01214000 COMMENT CLASSES FOR STATEMENT BEGINNERS; %M01215000 READV =065#, COMMENT 101; %M01216000 WRITEV =066#, COMMENT 102; %M01217000 SPACEV =067#, COMMENT 103; %M01218000 CLOSEV =068#, COMMENT 104; %M01219000 LOCKV =069#, COMMENT 105; %M01220000 REWINDV =070#, COMMENT 106; %M01221000 CASEV =071#, COMMENT 107; %M01222000 FORV =072#, COMMENT 110; %M01223000 WHILEV =073#, COMMENT 111; %M01224000 DOV =074#, COMMENT 112; %M01225000 UNTILV =075#, COMMENT 113; %M01226000 ELSEV =076#, COMMENT 114; %M01227000 ENDV =077#, COMMENT 115; %M01228000 FILLV =078#, COMMENT 116; %M01229000 SEMICOLON =079#, COMMENT 117; %M01230000 IFV =080#, COMMENT 120; %M01231000 GOV =081#, COMMENT 121; %M01232000 RELEASEV =082#, COMMENT 122; %M01233000 BEGINV =083#, COMMENT 123; %M01234000 COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000 SIV =084#, COMMENT 124; %M01236000 DIQ =085#, COMMENT 125; %M01237000 CIV =086#, COMMENT 126; %M01238000 TALLYV =087#, COMMENT 127; %M01239000 DSV =088#, COMMENT 130; %M01240000 SKIPV =089#, COMMENT 131; %M01241000 JUMPV =090#, COMMENT 132; %M01242000 DBV =091#, COMMENT 133; %M01243000 SBV =092#, COMMENT 134; %M01244000 TOGGLEV =093#, COMMENT 135; %M01245000 SCV =094#, COMMENT 136; %M01246000 LOCV =095#, COMMENT 137; %M01247000 DCV =096#, COMMENT 140; %M01248000 LOCALV =097#, COMMENT 141; %M01249000 LITV =098#, COMMENT 142; %M01250000 TRNSFER =099#, COMMENT 143; %M01251000 COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000 COMMENTV =100#, COMMENT 144; %M01253000 FORWARDV =101#, COMMENT 145; %M01254000 STEPV =102#, COMMENT 146; %M01255000 THENV =103#, COMMENT 147; %M01256000 TOV =104#, COMMENT 150; %M01257000 VALUEV =105#, COMMENT 151; %M01258000 WITHV =106#, COMMENT 152; %M01259000 COLON =107#, COMMENT 153; %M01260000 COMMA =108#, COMMENT 154; %M01261000 CROSSHATCH =109#, COMMENT 155; %M01262000 LFTBRKET =110#, COMMENT 156; %M01263000 PERIOD =111#, COMMENT 157; %M01264000 RTBRKET =112#, COMMENT 160; %M01265000 RTPAREN =113#, COMMENT 161; %M01266000 COMMENT CLASSES FOR OPERATORS; 01267000 NOTOP =114#, COMMENT 162; %M01268000 ASSIGNOP =115#, COMMENT 163; %M01269000 AMPERSAND =116#, COMMENT 164; %M01270000 EQVOP =117#, COMMENT 165; %M01271000 IMPOP =118#, COMMENT 166; %M01272000 OROP =119#, COMMENT 167; %M01273000 ANDOP =120#, COMMENT 170; %M01274000 RELOP =121#, COMMENT 171; %M01275000 LRELOP =122#, COMMENT 172; %M01275100 DOTOP =123#, COMMENT 173; %M01275200 ADOP =124#, COMMENT 174; %M01276000 MULOP =125#, COMMENT 175; %M01277000 FACTOP =126#, COMMENT 176; %M01278000 %M01278100 %M01278500 COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000 OWNV =001#, COMMENT 001; %M01280000 SAVEV =002#, COMMENT 002; %M01281000 STRINGV =003#, COMMENT 003; %M01281100 DOUBLEV =004#, COMMENT 004; %M01281200 SYMV =005#, COMMENT 005; %M01281300 RECORDV =006#, COMMENT 006; %M01281400 BOOV =007#, COMMENT 007; %M01282000 REALV =008#, COMMENT 010; %M01283000 ALFAV =009#, COMMENT 011; %M01284000 INTV =010#, COMMENT 012; %M01285000 LABELV =011#, COMMENT 013; %M01286000 DUMPV =012#, COMMENT 014; %M01287000 LISTV =013#, COMMENT 015; %M01288000 OUTV =014#, COMMENT 016; %M01289000 INV =015#, COMMENT 017; %M01290000 MONITORV =016#, COMMENT 020; %M01291000 SWITCHV =017#, COMMENT 021; %M01292000 PROCV =018#, COMMENT 022; %M01293000 ARRAYV =019#, COMMENT 023; %M01294000 FORMATV =020#, COMMENT 024; %M01295000 FILEV =021#, COMMENT 025; %M01296000 STREAMV =022#, COMMENT 026; %M01297000 COMPLEXV =023#, COMMENT 027; %M01297100 DEFINEV =024#, COMMENT 030; %M01298000 FIELDV =025#; COMMENT 031; %M01298100 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 SAVE ARRAY ACCUM[0:11]; % %M01304000 COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000 SCANNED ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000 IN INFO, THAT IS ACCUM[1] = 00NAAAAA. ACCUM[I] , I> 1, 01307000 HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000 THE ELBAT WORD BY THE ENTER ROUTINES; 01309000 ARRAY STACKHEAD,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 SUPERSTACK, SEE %WF 01312000 COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100 INTEGER COUNT; 01313000 COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 01314000 SCANNED; 01315000 ALPHA Q; 01316000 COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000 WORD SCANNED; 01318000 ARRAY ELBAT[0:75]; INTEGER IZ, NXTELBT; DEFINE I=IZ#; %W2701319000 COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000 QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000 (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000 GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000 FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000 POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000 INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000 FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000 INTEGER ELCLASS; 01328000 COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000 INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000 INTEGER MAXTLCR; 01331000 COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF 01332000 THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS 01333000 OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000 CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000 THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000 IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000 DEFINE BUFFSIZE = 56#; 01338000 01339000 INTEGER GTIX; 01339050 ARRAY TEN[0:139]; %A01340000 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 A 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. ID BITS 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 VARIABLE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000 ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000 VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000 USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000 INTEGER LASTUSED; 01391000 COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000 READACARD, THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000 OR PREPARES THE CARD FOR THE SCANNER. 01394000 IF LASTUSED = 1 THEN READ CARDS ONLY 01395000 IF LASTUSED = 2 THEN LAST CARD IMAGE FROM READER (MERGING)01396000 IF LASTUSED = 3 THEN LAST CARD IMAGE FROM TAPE (MERGING) 01397000 IF LASTUSED = 4 THEN READ NO CARD (FOR INITIALIZATION); 01398000 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 SLABTOG; COMMENT USED TO SUPPRESS STREAM NOPS; %W1401411600 BOOLEAN ERRORTOG; 01412000 COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000 ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000 BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000 COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000 BOOLEAN STREAMTOG; 01417000 COMMENT STREAMTOG IS TRUE IF WE ARE COMPILING STREAM STATEMENT. IT 01418000 IS USED TO CONTROL COUMPOUNDTAIL; 01419000 DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, 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 LL; DEFINE L = LL#; % %T4001428000 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 PROPER 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 BLOCK01460000 AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000 BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000 SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000 MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000 OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED01465000 IF LEVEL = JUMPCTR; 01466000 BOOLEAN GOTOG; 01467000 COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY01468000 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 USED01500000 FOR ERROR CONTROL ONLY; 01501000 INTEGER DIALA,DIALB; 01502000 COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000 DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000 WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000 BY SETTING DIALA AND DIALB TO ZERO; 01506000 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 % %A01556300 FILE IN CARD (RR1,10,RR2); %M01557000 DEFINE LINESIZE = 900 # ; % SMALLER DISK AREA %T1101558000 SAVE FILE OUT LINE DISK SERIAL [20:LINESIZE] (RR3,15,RR4,SAVE 5) ; %T1101559000 SAVE ARRAY LIN[0:20];% PRINT OUTPUT BUILT IN LIN %T1101559010 INTEGER DA; 01559020 DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) ELSE 01559030 WRITE(LINE[DBL],15,LIN[*])#; 01559039 SAVE FILE OUT NEWTAPE DISK SERIAL [20:LINESIZE](RR5,RR6,RR7,SAVE 5);%T1101560000 FILE IN TAPE "0CRDIMG" (2,RR8,RR9); 01561000 SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005 FILE IN ERMDF DISK RANDOM "ALGOL ""ERRORS " (1,15,30) ; % %T1401561006 ARRAY ERARA [0:14] ; % %T1401561007 REAL PERR ; % %T1401561008 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 FILE IN CASTD DISK SERIAL "CASTD""LIBRARY" (1,BUFFSIZE); % %T0301561042 FILE IN CASTE DISK SERIAL "CASTE""LIBRARY" (1,BUFFSIZE); % %T0301561044 FILE IN CASTF DISK SERIAL "CASTF""LIBRARY" (1,BUFFSIZE); % %T0301561045 FILE IN CASTG DISK SERIAL "CASTG""LIBRARY" (1,BUFFSIZE); % %T0301561046 FILE IN CASTH DISK SERIAL "CASTH""LIBRARY" (1,BUFFSIZE); % %T0301561047 FILE IN RETNE DISK SERIAL (1,BUFFSIZE); % %T0301561048 SWITCH FILE LIBRARY ~ CASTA,CASTB,CASTC,CASTD,CASTE,CASTF,CASTG,%T0301561050 CASTH,RETNE; % %T0301561051 FILE OUT REMOTE 19 (2,9); % %T1401561055 BOOLEAN REMOTOG; 01561056 ARRAY LIBARRAY[0:24]; COMMENT LIBARRAY IS USED TO KEEP INFORMATION 01561060 AS TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070 EACH ENTRY CONSISTS OF THREE WORDS CONTAINING; 01561080 FILE DSK1 DISK SERIAL[20:150](2,10,30); %DFB01561085 FILE DSK2 DISK SERIAL [20:300](2,30,30); %DFB01561087 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 LIBARRAY 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 NOPATCH ; % %T0301561212 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 DEFINE NOTAPES = 9 #;%NUMBER OF SOURCE LIBRARY TAPES %T0301561240 ARRAY DIRECTORY[0:NOTAPES|NOROWS-1,0:55]; COMMENT IS THE ACTUAL %T0301561245 DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250 A: 1 CAR- NUMBER OF DIRECTORY BLOCKS, 01561260 B: 1 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 THEN 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 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; %A 01568500 DEFINE LOGI =443#, 01569000 EXPI =440#, 01570000 XTOTHEI =480#, 01571000 GOTOSOLVER =484#, 01572000 PRINTI =477#, 01573000 MERGEI =500#, 01573100 POWERSOFTEN =792#, %T9201574000 LASTSEQUENCE = 30#, %T9301575000 LASTSEQROW =3#, %A01576000 INTERPTO =461#, 01577000 SUPERMOVER =545#, %T9201577500 CHARI =465#, 01578000 INTERPTI =469#, 01579000 SORTI =473#, 01579100 SWAPPER =768#, %T9201579200 DIALER =763#, %T9201579300 FORTRANERR = 772#, %A01579400 MATDID =776#, %A01579500 MATINV = 780#, %A01579600 MATTRN =784#, %A01579700 MATMUL =788#, %A01579800 FILATTINT =535#, %T9201579900 SORTA =793#; %T9201580000 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 GENERALY TELLS WHETHER OWN WAS SEEN; 01588000 P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 01589000 VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000 FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000 PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000 SPECTOG, 01593000 STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000 ONE ID AND THEN EIXT; 01595000 AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000 BOOLEAN STOPDEFINE; 01597000 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 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 DEFINE PURPT=[4:8]#,SECRET=2#; 01628000 COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000 NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000 FULL NAME IS ALSO GIVEN; 01631000 DEFINE 01632000 ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000 BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000 BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000 BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000 BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000 CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000 CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000 COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000 COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000 DEL = 10#, COMMENT (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 EQIVALENCE; 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~LOC 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. PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000 TEMPORARY ASSIGNMENT; 01706000 DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000 POSITION IN THE SECOND WORD OF INFO WHICH 01708000 CONTAINS THE LENGTH OF ALPHA; 01709000 DEFINE STEPI = (ELCLASS ~ TABLE(IZ~IZ+1))#; % %60 %W2701709400 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 BEGIN % START SEGMENT HERE..... 01715001 PROCEDURE CHECKBOUNDLVL; FORWARD; % 01715010 PROCEDURE UNHOOK; FORWARD; % 01715020 PROCEDURE MAKEUPACCUM; FORWARD; % 01715030 PROCEDURE LISTPARA; FORWARD; %W3301715500 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 %T0301727000 %T0301728000 PROCEDURE SCANNER; FORWARD; 01730000 COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLUTE 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 DEFINE STEPIT= ELCLASS ~ TABLE(IZ~IZ+1)#; % %W2701741000 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 SEQERR(L); BEGIN DI~L;DI~DI+3;DS~LIT"S";END; % %T0301742100 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 TALLY~63; 01743000 NED: TALLY~TALLY+1; 01743100 NONBLANK~TALLY 01743200 END NONBLANK; 01743300 INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN-TIME 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); VALUE NCR; 01756000 BEGIN 01757000 LABEL L,TRANS; 01758000 LOCAL N; 01759000 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-8 . 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 GETV6ID. 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 OCTCON(F,R); VALUE F; BOOLEAN F; REAL R; BEGIN %W0301810810 COMMENT OCTCON SETS FLAG BIT ONLY IF CALLED FROM FILLSTMT(I.E. IF %W0301810820 F IS FALSE); %W0301810830 BOOLEAN STREAM PROCEDURE OC(AC,C1,C2,B,F,R); VALUE C1,C2,B,F; %W0301810840 BEGIN %W0301810850 SI ~ AC; SI ~ SI+C1; DI ~ R; SKIP B DB; %W0301810860 C2(IF SC>"7"THEN TALLY~1; IF SC<"0"THEN TALLY~1;SKIP 3SB; %W0301810870 3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); %W0301810880 DI ~ R; DS ~ F RESET; OC ~ TALLY %W0301810890 END OC; %W0301810900 INTEGER C1,C2; %W0301810910 IF COUNT>16 THEN BEGIN C1 ~ COUNT-13; C2 ~ 16 END %W0301810920 ELSE BEGIN C1 ~ 3; C2 ~ COUNT END; %W0301810930 R ~ 0; %W0301810940 IF OC(ACCUM[1],C1,C2,48-3|C2,F,R) THEN FLAG( 303) %W0301810950 END OCTCON; %W0301810960 PROCEDURE DATIME; 01820000 BEGIN 01821000 INTEGER H,MIN,Q; 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 WRITE(LINE[DBL], 01829000 , 01832000 TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000 Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000 IF H}12 THEN "P" ELSE "A"); 01835000 NOHEADING:=FALSE; 01836000 WRITE (LINE,<" *** ** **"X80" **** ******** * ****:* * ***"/ % %T0701837000 " E B L "X80" L N S N S A S S S "/ % %T0701838320 " R E E "X80" I U E U O D Y E E "/ % %T0701838330 " R G V "X80" N M Q M U D L Q G "/ % %T0701838340 " O I E "X80" E B U B R R L M "/ % %T0701838350 " R N L "X80" * E E E C E A E E "/ % %T0701838360 " S S * "X80" * R N R E S B R N "/ % %T0701838370 " * * * "X80" * * C * * S L R T "/ % %T0701838380 " * * * "X80" * * E * * * E * * "/ % %T0701838390 " *** ** **"X80" **** ******** * ****:* * ***">); END;%T0701838400 DEFINE DOT = BEGIN IF ELCLASS=PERIOD THEN DOTIT END#; %D01841000 % %A01842000 % %A01842100 COMMENT THE FOLLOWING DECLARATIONS ARE FOR GTL; %A01842200 REAL ARRAY %A01842300 DAC[0:22], % USED FOR REMOTE TERMINAL FILE INFO %T9001842350 DPI[0:107], % USED FOR OBJECT PROGRAM PRT ASSIGNMENTS %A01842400 % - SEE GNATA GNATP, AND GNATI %A01842500 FRD[0:31], % CONTAINS PRT AND STACK ADDRESS FOR %A01842600 %TEMPORARY FOR AND STRING PARAMETERS - SEE FORAD %A01842700 EDC[0:3,0:127], % TEMPORARY CODE ARRAY FOR STRING STUFF %A01842800 LNK[0:7,0:512], % CONTAINS COMPILE TIME SYMBOL CONSTANTS %A01842900 RECARRAY[30:60], % CONTAINS ADDITIONAL INFORMATION ABOUT %A01843000 % RECORD TYPES %A01843100 SYMSTACK[0:124]; % STACKHEAD FOR COMPILE TIME %A01843200 % SYMBOL CONSTANTS %A01843300 REAL %A01843500 INOUTUSED, %A01843550 DACP, % DATA-COMM POINTERS %A01843560 FORLEVEL, %A01843600 GPBV, %A01843650 JMPCH, %A01843700 LC, %A01843800 RECORDLINK, %A01843900 RECTYPE, %A01844000 RETLIST; %T9201844050 PROCEDURE PERMLINE(B); VALUE B; BOOLEAN B; 01844100 BEGIN 01844110 INTEGER LT; % %T1101844115 NOTPNTED ~ FALSE; 01844120 IF LT:=LINE.TYPE=10 OR LT=12 OR LT=13 % %T1101844130 THEN BEGIN 01844140 IF LT ! 12 THEN LINE.TYPE := 12; % %T1101844145 WRITE(LINE); LOCK(LINE); 01844150 LINE.AREAS ~ 0; LINE.AREASIZE ~ 0; 01844160 END; 01844170 IF B THEN DATIME; 01844180 END PERMLINE ; 01844190 REAL %T9201844195 SAVEQ, %A01844200 SFPL, % %A01844210 SFTRC, % SYMBOL FORMAT TRACE TOG %A01844220 HOLDFR, %A01844250 XITLIST; %A01844300 INTEGER %A01844400 DP, %A01844700 DL, %A01844800 DR, %A01844900 LFINAL, %A01845000 LNKNDX, %A01845100 MOREWORDS, %A01845200 NEWPART, %A01845300 STK, %A01845400 STRINGMAX, %A01845500 SYMFORM, %A01845600 SYMLOC, %A01845700 TABLEMARKV, %A01845800 SP, %A01845810 SL, %A01845820 WTYPE; %A01845900 BOOLEAN %A01846000 SPT, %A01846100 SLT, %A01846200 DPT, %A01846300 DLT, %A01846350 DRT, %A01846400 INTDEBUGTOG, %IF TRUE THEN DEBUGN ON GTL INTRINSICS %T9001846450 MARKSYM, %A01846500 PRINTOG, %A01846600 PRINFORM, %A01846650 QUOTETOG, %A01846700 RECLAIMTOG, %A01846800 SMT, %A01846900 SOPG, %A01847000 SYMFORMAT, %A01847050 SYMQUOTE, %A01847100 SYMSTK, % SYMBOL PLEX OPTION FLAG %A01847150 SYMSEC; %A01847200 % %A01847300 COMMENT ADDITIONAL INFORMATION FOR RECORD DECLARATORS: %A01847400 1ST WORD: [40:8] = NUMBER OF FIELDS %A01847500 OTHERS: [35:13] = LINK TO FIELDID, %A01847600 IN RECARRAY[R], WHERE R IS THE RECORD TYPE NUMBER,: %A01847700 [35:13] = LINK TO RECORD, %A01847800 [24:11] = ADDRESS OF ARRAY, %A01847900 [13:11] = ADDRESS OF FREELIST (COL, ROW), %A01848000 [10:3] = LENGTH OF RECORD (AS POWER OF 2), %A01848100 [3:7] = LENGTH OF RECORD; %A01848200 COMMENT ADDITIONAL WORDS IN INFO FOR FIELD IDENTIFIER: %A01848300 [1:1] = ON IF INDEXED, %A01848400 [8:7] = STARTING WORD, %A01848500 [15:7] = ENDING WORD, %A01848600 [22:13] = STARTING POSITION, %A01848700 [35:13] = NO OF POSITIONS; %A01848800 COMMENT SUBCLASS FOR RECID IN (18+COUNT)DIV 8,WHERE %A01848900 COUNT IS NO OF CHARACTERS IN IDENTIFIER %A01849000 [2:7] = ID NUMBER IF ID FIELD %A01849100 [1:1] = IF USED AS ID FIELD; %A01849200 COMMENT ADDITIONAL STRING INFO - IF NOT FORMAL: %A01849300 STRINGID: IF [1:1] =1 THEN SUBSTRING - %A01849400 [35:13]= LINK TO MAIN STRING, %A01849500 [22:13]= STARTING POSITION, %A01849600 [9:13] = STRING LENGTH IN CHAR, %A01849700 ELSE [35:13] = LENGTH %A01849800 STRING ARRAY: [35:13] = LENGTH AT %A01849900 INDEX + INCR + DIMENSION +1; %A01850000 % %A01850100 % %A01850200 DEFINE %A01850300 TRS = 63#, %A01850400 TRP = 60#, %A01850500 TRW = 05#, %A01850600 TGR = 23#, %A01850700 TEG = 22#, %A01850800 TEQ = 20#, %A01850900 TEL = 28#, %A01851000 TLS = 29#, %A01851100 TNE = 21#, %A01851200 TAN = 30#, %A01851300 BIT = 31#, %A01851400 TIB = BIT#, %A01851450 CGR = 51#, %A01851500 CEG = 50#, %A01851600 CEQ = 48#, %A01851700 CEL = 56#, %A01851800 CLS = 57#, %A01851900 CNE = 49#, %A01852000 JFW = 39#, %A01852100 JFC = 37#, %A01852200 BNS = 42#, %A01852300 ENS = 41#, %A01852400 JNS = 38#, %A01852500 JNC = 36#, %A01852600 SFS = 25#, %A01852700 SRS = 24#, %A01852800 SFD = 14#, %A01852900 SRD = 15#, %A01853000 BSD = 02#, %A01853100 BSS = 03#, %A01853200 SSA = 13#, %A01853300 SDA = 12#, %A01853400 SCA = 44#, %A01853500 RSA = 43#, %A01853600 RDA = 04#, %A01853700 RCA = 40#, %A01853800 SES = 18#, %A01853900 SED = 06#, %A01854000 TSA = 46#, %A01854100 TDA = 07#, %A01854200 FAD = 59#, %A01854300 FSV = 58#, %A01854400 ICV = 55#, %A01854500 OCV = 54#, %A01854600 SEC = 34#, %A01854700 INC = 32#, %A01854800 STC = 33#, %A01854900 BIR = 53#, %A01855000 BIS = 52#, %A01855100 CRF = 35#; %A01855200 DEFINE %A01855300 DATAN = GNATP( 0)#, %A01855400 DCOS = GNATP( 1)#, %A01855500 DXP = GNATP( 2)#, %A01855600 DLOG = GNATP( 3)#, %A01855700 DSIN = GNATP( 4)#, %A01855800 DSQRT = GNATP( 5)#, %A01855900 DLG10 = GNATP( 6)#, %A01856000 DATN2 = GNATP( 7)#, %A01856100 CABS = GNATP( 8)#, %A01856200 CCOS = GNATP( 9)#, %A01856300 CEXP = GNATP(10)#, %A01856400 CLOG = GNATP(11)#, %A01856500 CSIN = GNATP(12)#, %A01856600 CSQRT = GNATP(13)#, %A01856700 DMOD = GNATP(14)#; %A01856800 DEFINE NEWLINK = LNK[(LNKNDX~LNKNDX+1).[33:6],LNKNDX.[39:9]]#; %A01856900 DEFINE FRLEVEL = FORLEVEL+REAL(MARKSYM)#; %A01857000 DEFINE NEWFLD = [2:2]#; %A01857100 DEFINE DTV = 128#, %A01857200 TS = [41:2]#, %A01857300 NS = [43:2]#; %A01857400 % %A01857500 % %A01857600 DEFINE FCE = 61#, FCL = 57#, CBD = 3#, %A01857700 CBN = 1#, CFD = 2#, CFN = 0#; %A01857800 DEFINE %A01857900 SEXPN = SDNORM(SEXP)#, %A01857950 TEMP1 = TEMP(1)#, %A01858000 TEMP2 = TEMP(2)#, %A01858100 ECM = 584#, %A01858200 CTF = 965#, %A01858300 CTC = 709#, %A01858400 FTF = 453#, %A01858500 ML2 = 065#, %A01858600 AD2 = 017#, %A01858700 SB2 = 049#, %A01858800 DV2 = 129#, %A01858900 MOP = 259#, %A01859000 TOP = 262#, %A01859100 TIMEI = 455#, %A01859200 STKC = STK ~ STK + 1#, %A01859300 DCRFR = FORLEVEL ~ FORLEVEL -1 - REAL(RECLAIMTOG)#, %A01859400 TABR = CP#, %A01859500 COLR = CPI#, %A01859600 SINI = 449#, %A01859700 COSI = 433#; %A01859800 DEFINE %A01859900 PRTFL = 147#, %A01860000 ST1 = 148#, %A01860100 ST2 = 149#, %A01860200 ST3 = 150#, %A01860300 TMP = 141#, %A01860400 LNKA = GNATA(0)#, %A01860500 PTABLE = GNATA(1)#, %A01860600 SYMSTACKA = GNATA(1)#, %A01860700 INSTR = GNATA(2)#, %A01860800 OUTSTR = GNATA(3)#, %A01860900 TABLEMARK = GNATA(4)#, %A01861000 RND = GNATA(5)#, %A01861100 ADDPROPA = GNATI( 0)#, %A01861200 ALFPRINT = GNATI( 1)#, %A01861300 APPEND = GNATI( 2)#, %A01861400 ARITHPRINT = GNATI( 3)#, %A01861500 ATCON = GNATI( 4)#, %A01861600 ATN = GNATI( 5)#, %A01861700 ATSTRV = GNATI( 6)#, %A01861800 BOOPRINT = GNATI( 7)#, %A01861900 CHARPRINT = GNATI( 8)#, %A01862000 COLLECT = GNATI( 9)#, %A01862100 DBLFACT = GNATI(10)#, %A01862200 DBLPLXFACT = GNATI(11)#, %A01862300 DBLPLXPRINT = GNATI(12)#, %A01862400 DBLPRINT = GNATI(13)#, %A01862500 ERRPRO = GNATI(14)#, %A01862600 GENLINK = GNATI(15)#, %A01862700 GENSYM = GNATI(16)#, %A01862800 LENGTHV = GNATI(17)#, %A01862900 MRK = GNATI(18)#, %A01863000 MARKD = GNATI(19)#, %A01863100 MARKER = GNATI(20)#, %A01863200 MARKOB = GNATI(21)#, %A01863300 MEMBER = GNATI(22)#, %A01863400 MKATM = GNATI(23)#, %A01863500 MONPRO = GNATI(24)#, %A01863600 MONSYM = GNATI(25)#, %A01863700 NCONC = GNATI(26)#, %A01863800 NTA = GNATI(27)#, %A01863900 NTSER = GNATI(28)#, %A01864000 PLXFACT = GNATI(29)#, %A01864100 PLXPRINT = GNATI(30)#, %A01864200 PROPA = GNATI(31)#, %A01864300 RANDNO = GNATI(32)#, %A01864400 RANDOM = GNATI(33)#, %A01864500 READER = GNATI(34)#, %A01864600 READ1 = GNATI(35)#, %A01864700 READCON = GNATI(36)#, %A01864800 READN = GNATI(37)#, %A01864900 READSYM = GNATI(38)#, %A01865000 RECALL = GNATI(39)#, %A01865100 TWXLOOP = GNATI(40)#, %A01865200 RECLINK = GNATI(41)#, %A01865300 REMEMBER = GNATI(42)#, %A01865400 REMOB = GNATI(43)#, %A01865500 REMPROPER = GNATI(44)#, %A01865600 RITELINE = GNATI(45)#, %A01865700 SCANR = GNATI(46)#, %A01865800 SPACEPRINT = GNATI(47)#, %A01865900 STRINGPRINT = GNATI(48)#, %A01866000 SYMEQ = GNATI(49)#, %A01866100 SYMEQA = GNATI(50)#, %A01866200 SYMFIX = GNATI(51)#, %A01866300 SYMPRINT = GNATI(52)#, %A01866400 TERPRIN = GNATI(53)#, %A01866500 DACOMI = DPI[104]#, %A01866600 DACOMO = DPI[105]#, %A01866610 ARSTV = DPI[106]~104#, %A01866620 FORTERR = DPI[107] ~ 24#, %A01866630 POWERSOFTENI = 105#, %A01866700 SNGLSIG = 106#, %A01866800 DBLSIG = 107#, %A01866900 WSIGN = 108#, %A01867000 FREEN = 109#, %A01867100 FREENL = 110#, %A01867200 FREETIME = 111#, %A01867300 FREELIST = 112#, %A01867400 LNKCOL = 113#, %A01867500 LNKROW = 114#, %A01867600 CP = 115#, %A01867700 CPI = 116#, %A01867800 LMARG = 117#, %A01867900 LMARGI = 118#, %A01868000 RMARG = 119#, %A01868100 RMARGI = 120#, %A01868200 OUTOG = 121#, %A01868300 INITI = 122#, %A01868400 LGO = 123#, %A01868500 LGI = 124#, %A01868600 PROTOG = 125#, %A01868700 PROI = 126#, %A01868800 NSTR = 127#, %A01868900 COUNTI = 128#, %A01869000 FILPRO = 129#, %A01869100 FILPROI = 130#, %A01869200 STRP = 131#, %A01869300 STRI = 132#, %A01869400 GENOK = 133#, %A01869500 GENU = 134#, %A01869600 CPM = 135#, %A01869700 GENNO = 136#, %A01869800 COLSET = 142#, %A01869850 INSYM = 137#, %A01869900 INDBL = 138#, %A01870000 INREAL = 139#; %A01870100 DEFINE RTPARN = IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104)#; %A01870200 % %A01870300 DEFINE TPR = TRP#; %A01870400 % %A01870500 STREAM PROCEDURE CHAINFORM(A,B); %A01870600 BEGIN %A01870700 LOCAL T,R; LABEL OTHERS; %A01870800 SI ~ A; SI ~ SI + 2; DI ~ LOC T; DI ~ DI + 7; DS ~ CHR; %A01870900 IF SC ! "C" THEN GO TO OTHERS; SI ~ SI + T; SI ~ SI - 1; %A01871000 IF SC ! "R" THEN GO TO OTHERS; TALLY ~ T; %A01871100 2(TALLY ~ TALLY + 63); T ~ TALLY; DI ~ LOC R; DI ~ DI + 6; %A01871200 SI ~ SI - T; %A01871300 T(IF SC = "D" THEN SKIP 2 DB ELSE %A01871400 IF SC = "A" THEN BEGIN SKIP DB; DS ~ SET END ELSE %A01871500 IF SC = "T" THEN BEGIN DS ~ SET; SKIP DB END ELSE %A01871600 JUMP OUT TO OTHERS; SI ~ SI + 1); %A01871700 DI ~ B; SKIP 3 DB; DS ~ 6 SET; %A01871800 SI ~ LOC R; SI ~ SI + 6; DS ~ 2 SET; %A01871900 2(T(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); %A01872000 DS ~ 2 SET; %A01872100 OTHERS: END OF CHAINFORM; %A01872200 % %A01872300 % %A01872400 % %A01872500 % FIX RECORD CODE %A01872600 % 0 READ & SET POINTER PLUS %A01872700 % 1 READ & SET POINTER MINUS %A01872800 % 2 GENERATE RECORD %A01872900 % 4 RECLAIM RECORD %A01873000 % 5 WRITE IF NEGATIVE %A01873100 COMMENT RECARRAY[R] %A01873200 [35:13] = LINK TO RECORD %A01873300 [22:13] = LINK TO FILE %A01873400 [11:11] = ADDRESS OF ROW POINTER,(BUFF1 ADR,BUFF2 ADR) %A01873500 [6 : 5] = NO OF STARTING ROW %A01873600 [1 : 1] = 1 IF FIELDS NO CHECKED ; %A01873700 % ADDL INFO FOR RECORD DISK FILES %A01873800 % [37:11] = ADR OF ARRAY %A01873900 % [26:11] = ADR OF FREELIST,NXT AVL REC %A01874000 % [16:10] = BUFFER SIZE %A01874100 % [7 : 9] = NO OF INFO WORDS IN FILE %A01874200 % [2 : 5] = NO OF RECORD CLASSES %A01874300 % [1 : 1] = 1 IF ARRAY DECLARED %A01874400 % EL+1: [2:2]= 1 IF LOCAL %A01874500 % 2 IF NEW %A01874600 % 3 IF OLD %A01874700 % INFO IN DAC %A01874800 % 0 READ TO CLEAR TOG %A01874900 % 1 REMOTE IN TOG %A01875000 % 2 TOGGLE SET BY READ-CLEARED BY WRITE-SUPPRESS EXTRA LF %T9001875100 % 3 OWN J %A01875200 % 4 OWN K %A01875300 % 5 MAIN IN-STRING ADR %A01875400 % 6 MAIN STRING LENGTH - EQUAL TO FILE LENGTH %T9001875500 % 7 IN-FILE ADR %A01875600 % 8 REMOTE OUT-TOG %A01875700 % 9 AUX OUT-ARRAY ADR %A01875800 % 10 STATEWORD ADR %A01875900 % 11 BRKTOG ADR %A01876000 % 12 IMPTOG ADR %A01876100 % 13 OUT FILE ADR - SAME AS IN-FILE ADR %T9001876200 % 14 MAIN OUT-STRING ADR %A01876300 % 15 RMARG - LENGTH OF OUT STRING EQUALS FILE LENGTH %T9001876400 % 16 READ WAIT TIME IF ! 0 %A01876500 % 17 REMOTE NO INPUT LABEL IF ! 0 %A01876600 % 18 REMOTE ABNORMAL CONDITIONN LABLE IF ! 0 %A01876700 % 19 REMOTE INPUT EOF IF ! 0 %T9001876730 % 20 REMOTE INPUT PARITY IF ! 0 %T9001876760 % 21 REMOTE INPUT BUFFER OVERFLOW IF ! 0 %T9001876790 % %A01876800 % 22 RETURN END OF FILE TOG - IF FALSE THEN RETURN END OF FILE%T9001876900 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; 02001360 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 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 02001750 02001760 02001763 02001765 02001770 02001780 02001790 02001800 02001810 02001820 02001825 02001826 02001827 02001828 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 ZOT INSERTS THE CHARACTOR CHAR INTO THE POSITION GIVEN BY 02002000 LCR. IT RETURNS THE CHARACTOR PREVIOUSLY IN LCR THROUGH 02003000 RET. THE PRIMARY PURPOSE OF THE ROUTINE IS TO INSERT A 02004000 PERCENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02005000 THE SCANNER AND TO REMEMBER THE PREVIOUS CHARACTOR IN CASE02006000 IT IS NEEDED BY THE ERROR ROUTINES; 02007000 STREAM PROCEDURE ZOT(RET,CHAR,LCR); VALUE CHAR,LCR; 02008000 BEGIN DI ~ RET; SI ~ LCR; DS ~ WDS; 02009000 COMMENT BRING OUT THE CHARACTOR IN COLUMN 73; 02010000 DI~LCR; SI~LOC LCR; SI~SI-1; DS~CHR; 02011000 COMMENT CHANGE CHARACTOR IN COLUMN 73 TO CHAR; 02012000 END ZOT; 02013000 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 LIBRAY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160 PROCEDURE SEARCHLIB(DOLLAR); 02013165 VALUE DOLLAR; BOOLEAN DOLLAR; 02013170 BEGIN 02013175 REAL R1 ; % %3002013176 LABEL EXIT,EXITOUT, NOPARTIAL; 02013180 BOOLEAN TEMPLISTOG; 02013183 NOPATCH ~ REAL (DOLLAR) = 5; % %T0302013184 IF DOLLAR THEN 02013185 BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190 IF NOT NOPATCH THEN BEGIN % %T0302013193 IF REAL(DOLLAR) = 3 THEN BEGIN % %T0302013194 RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195 END; % %T0302013196 RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200 END; % %T0302013201 FILEINX~IF NOPATCH THEN NOTAPES-1 ELSE ACCUM[1].[18:6]; % %T0302013203 IF IF NOPATCH THEN FALSE ELSE % %T0302013205 FILEINX ~ FILEINX - 17 < 0 OR FILEINX>NOTAPES-2 THEN BEGIN %T0302013210 COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219 TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013220 FLAG(500); LISTOG~TEMPLISTOG; GO TO EXIT; 02013222 END; 02013225 % %T0302013230 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 PROG.ID.; 02013290 IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295 BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300 TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013303 FLAG(501); LISTOG~TEMPLISTOG; GO TO EXIT; 02013305 END; 02013310 WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013313 DO BEGIN 02013315 RESULT ~ 5; SCANNER; % %T0302013316 % %T0302013317 IF NOT NOPATCH THEN NOPATCH ~ EXAMIN(NCR) = "N"; % %T0302013318 END; 02013319 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 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520 IF NOPATCH THEN SEQSUM ~ 0 ELSE % %T0302013522 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 LASTUSED~5; 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 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 NCR~MKABS(CARD(0)) ELSE 02013617 NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620 IF LASTUSED{2 OR LASTUSED=5 THEN LCR~MKABS(CARD(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]); 02013685 02013690 02013693 02013695 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 ZOT(GT1, "%", LCR); 02013716 END; 02013717 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 DEFINE WRITNEW(WRITNEW1,WRITNEW2)=WRITENEW(WRITNEW1,WRITNEW2,NEWTOG)%T1102015500 #; % %T1102015600 BOOLEAN STREAM PROCEDURE WRITENEW(NEW,FCR,N);VALUE FCR,N; % %T1102016000 BEGIN SI ~ FCR; IF SC ! "$" THEN TALLY ~ 1 ELSE BEGIN % %T0302017000 L: SI ~ SI + 1; IF SC = " " THEN GO TO L; % %T0302017100 IF SC = "I" THEN TALLY ~ 1 ELSE % %T0302017200 IF SC = "O" THEN TALLY ~ 1 ELSE % %T0302017300 IF SC = "S" THEN TALLY ~ 1 ELSE % %T0302017400 IF SC = "G" THEN TALLY ~ 1 ELSE % %T0302017500 IF SC = "P" THEN TALLY ~ 1 ELSE % %T0302017600 IF SC = "E" THEN TALLY ~ 1 ELSE % %T0302017700 % OTHER OPTIONS GO HERE %T0302017880 ; SI ~ FCR; % %T0302017890 END; % %T0302017900 N(DI~NEW; DS~10WDS; SI~SI-8; %T1102018000 7(IF SC!"9" THEN JUMP OUT ELSE SI~SI+1); %T1102019000 IF SC="9"THEN TALLY~0);WRITENEW~TALLY; END; % WRITENEW%T1102020000 DEFINE PRINT(PRINT1,PRINT2,PRINT3,PRINT4) = % %T0302021000 PRINTLINE (ERRORCOUNT,BEGINCTR,LEVEL,LINENUMBER,L.[46:2],SGNO, % %T0302021500 PRINT1,PRINT2,PRINT4,L.[36:10])#; % %T0302022000 INTEGER LINENUMBER; BOOLEAN USELINO; % %T0302022500 STREAM PROCEDURE PRINTLINE (E,B,L,C,S,G, % %T0302023000 LINE,NCR,SYMBOL,R); % %T0302023500 VALUE E,B,L,C,S,G, % %T0302024000 NCR,SYMBOL,R ; % %T0302024500 BEGIN LOCAL Z; % %T0302025000 SI ~ LINE; DI ~ LINE; DS ~ 8 LIT " "; DS ~ 14 WDS; % %T0302025500 DI ~ LINE; SI ~ LOC E; % %T0302026000 DS ~ 4 DEC; Z ~ DI; DI ~ DI - 4; DS ~ 4 FILL; DI ~ Z; %%T0302026500 DS ~ 3 DEC; Z ~ DI; DI ~ DI - 3; DS ~ 3 FILL; DI ~ Z; %%T0302027000 DS ~ 3 DEC; Z ~ DI; DI ~ DI - 3; DS ~ 3 FILL; DI ~ Z; %%T0302027500 DI ~ DI + 5; % %T0302028000 DS ~ LIT "*";SI ~ NCR; DS ~ 9 WDS; DS ~ LIT "*"; DI ~ DI + 1; % %T0302028500 NCR ~ SI; SI ~ LOC C; % %T0302028700 DS ~ 5 DEC; Z ~ DI; DI ~ DI - 5; DS ~ 5 FILL; DI ~ Z; %%T0302028800 SI ~ NCR; DI ~ DI + 1; DS ~ WDS; % %T0302028900 DI ~ DI + 1; SI ~ LOC SYMBOL; SI ~ SI + 7; DS ~ CHR; % %T0302029000 DI ~ DI + 2; DS ~ 4 DEC; SI ~ LOC S; SI ~ SI + 7; % %T0302029500 DS ~ LIT ":"; DS ~ CHR; Z ~ DI; DI ~ DI - 6; DS ~ 6 FILL; DI ~ Z; %%T0302030000 DI ~ DI + 2; DS ~ 4 DEC; Z ~ DI; DI ~ DI - 4; DS ~ 4 FILL; DI ~ Z; %%T0302030100 END; % PRINTLINE %T0302030200 % %T0302030300 % %T0302030400 % %T0302031000 COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02032000 TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02033000 RESULT = 1 ELSE RESULT = 2; 02034000 REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02035000 BEGIN SI ~ TAPE; DI ~ CARD; 02036000 IF 8 SC } DC THEN 02037000 BEGIN SI ~ SI-8; DI ~ DI-8; TALLY ~ 1; 02038000 IF 8 SC = DC THEN TALLY ~ 2 END; 02039000 COMPARE ~ TALLY END COMPARE; 02040000 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 CHARACTORS LOCATED AT A AND B FOR 02061000 EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02062000 QUANTITIES IN THE DIRECTORY; 02063000 BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02064000 BEGIN TALLY ~ 1; SI~A; DI~B; 02065000 IF COUNT SC = DC THEN EQUAL ~ TALLY END; 02066000 PROCEDURE READACARD; FORWARD; %WF 02067000 PROCEDURE SCANNER; %WF 02068000 BEGIN %WF 02069000 02070000 COMMENT SCAN IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING.02071000 IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED SCAN- 02072000 NER, WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A 02073000 CARD. SCAN IS CONTROLED BY A VARIABLE CALLED RESULT. 02074000 SCAN ALSO INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE 02075000 SAME VARIABLE. HENCE THE VARIABLE, RESULT, IS PASSED BY 02076000 BOTH NAME AND VALUE. 02077000 THE MEANING OF RESULT AS INPUT IS: 02078000 0: INITIAL CODE - DEBLANK AND START TO FETCH THE 02079000 NEXT QUANTITY. 02080000 1: CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02081000 END OF CARD BREAK). 02082000 2: LAST QUANTITY BUILT WAS SPECIAL CHARACTOR. HENCE 02083000 EXIT (INTERRUPTION BY END OF CARD BREAK IS NOT 02084000 IMPORTANT). 02085000 3: CONTINUE BUILDING A NUMBER (INTERRUPTED BY END OF 02086000 CARD BREAK). 02087000 4: LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE02088000 EXIT (INTERRUPTION BY END OF CARD BREAK NOT 02089000 IMPORTANT). 02090000 5: GET NEXT CHARACTOR AND EXIT. 02091000 6: SCAN A COMMENT. 02092000 7: DEBLANK ONLY. 02093000 THE MEANING OF RESULT AS OUTPUT IS: 02094000 1: AN IDENTIFIER WAS BUILT. 02095000 2: A SPECIAL CHARACTOR WAS OBTAINED. 02096000 3: A NUMBER (INTEGER) WAS BUILT. 02097000 SCAN PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02098000 BLANK ELIMINATED) INTO ACCUM (CALLED ACCUMULATOR FOR REST 02099000 OF THIS DISCUSSION). 02100000 COUNT IS THE VARIABLE THAT GIVES THE NUMBER OF CHARAC- 02101000 TORS SCAN HAS PUT IN THE ACCUMULATOR. SINCE SCAN NEEDS 02102000 THE VALUE SO THAT IT CAN PUT MORE CHARACTORS IN THE ACCUM-02103000 ULATOR AND NEEDS TO UPDATE COUNT FOR THE OUTSIDE WORLD, 02104000 COUNT IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 02105000 CONVENIENT TO HAVE 63-COUNT. THIS IS CALLED COMCOUNT. 02106000 NCR (NEXT CHARACTOR TO BE SCANNED) IS ALSO PASSED BY 02107000 NAME AND VALUE SO THAT IT MAY BE UPDATED. 02108000 ST1 AND ST2 ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02109000 PASSED TO SCAN IN ORDER TO OBTAIN THE MOST USEFULL STACK 02110000 ARRANGEMENT; 02111000 STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02112000 COUNT,ST2,NCRV,ST1); 02113000 VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02114000 BEGIN 02115000 LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR, 02116000 COMMENTS,COMMANTS; 02117000 DI ~ RESULT; DI ~ DI+7; 02118000 SI ~ NCRV; 02119000 COMMENT SETUP DI FOR A CHANGE IN RESULT AND SI FOR A LOOK AT BUFFER;02120000 CI ~ CI+RESULTV; COMMENT SWITCH ON VALUE OF RESULT; 02121000 GO TO DEBLANK; COMMENT 0 IS INITIAL CODE; 02122000 GO TO IDBLDR; COMMENT 1 IS ID CODE; 02123000 GO TO FINIS; COMMENT 2 IS SPECIAL CHARACTER CODE; 02124000 GO TO NUMBERS; COMMENT 3 IS NUMBER CODE; 02125000 GO TO FINIS; COMMENT 4 IS ERROR CODE; 02126000 GO TO GNC; COMMENT 5 IS GET NEXT CHARACTOR CODE; 02127000 GO TO COMMANTS; COMMENT 6 IS COMMENT CODE; 02128000 COMMENT 7 IS DEBLANK ONLY CODE; 02129000 IF SC=" " THEN 02130000 BEGIN K: SI~SI+1; 02131000 IF SC =" " THEN GO TO K 02132000 END; 02133000 GO TO FINIS; 02134000 DEBLANK: IF SC = " " THEN 02135000 BEGIN L: SI~SI+1; IF SC = " " THEN GO TO L END; 02136000 COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTOR; 02137000 NCRV ~ SI; 02138000 IF SC } "0" THEN GO TO NUMBERS; 02139000 IF SC = ALPHA THEN GO TO IDBLDR; 02140000 COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTOR (OR GNC); 02141000 GNC: DS ~ LIT "2"; 02142000 TALLY ~ 1; SI ~ SI +1; GO TO EXIT; 02143000 COMMANTS: IF SC ! ";" THEN BEGIN 02144000 COMMENTS: SI ~ SI+1; 02145000 IF SC > "%" THEN GO TO COMMENTS; 02146000 IF SC < ";" THEN GO TO COMMENTS; 02147000 COMMENT CHARACTORS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD 02148000 MODE PART OF COMMENT ROUTINE; 02149000 END; 02150000 GO TO FINIS; 02151000 IDBLDR: TALLY ~ 63; DS ~ LIT "1"; 02152000 COMCOUNT( TALLY~ TALLY+1; 02153000 IF SC = ALPHA THEN SI~SI+1 ELSE JUMP OUT TO EXIT); 02154000 TALLY ~ TALLY+1; IF SC = ALPHA THEN BEGIN 02155000 ERROR: DI~DI-1; DS ~ LIT "4"; GO TO EXIT; 02156000 END ELSE GO TO EXIT; 02157000 COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTORS 02158000 IN AN IDENTIFIER OR NUMBER; 02159000 NUMBERS: TALLY ~ 63; DS ~ LIT "3"; 02160000 COMCOUNT( TALLY~ TALLY+1; 02161000 IF SC <"0"THEN JUMP OUT TO EXIT; SI~SI+1); 02162000 GO TO ERROR; 02163000 EXIT: ST1 ~ TALLY; COMMENT ST1 CONTAINS NUMBER OF CHAR- 02164000 ACTORS WE ARE GOING TO MOVE INTO THE 02165000 ACCUMULATOR; 02166000 TALLY ~ TALLY+COUNTV; ST2 ~ TALLY; 02167000 DI ~ COUNT; SI ~ LOC ST2; DS ~ WDS; 02168000 COMMENT THIS CODE UPDATED COUNT; 02169000 DI ~ ACCUM; SI ~ SI-3; DS ~ 3 CHR; 02170000 COMMENT THIS CODE PLACES COUNT IN ACCUM AS WELL; 02171000 DI ~ DI+COUNTV; COMMENT POSITION DI PAST CHARACTORS 02172000 ALREADY IN THE ACCUMULATOR, IF ANY; 02173000 SI ~ NCRV; DS ~ ST1 CHR; 02174000 COMMENT MOVE CHARACTORS INTO ACCUM; 02175000 FINIS: DI ~ NCR; ST1 ~ SI; SI ~ LOC ST1; DS ~ WDS; 02176000 COMMENT RESET NCR TO LOCATION OF NEXT CHARACTOR TO BE SCANNED; 02177000 END OF SCAN; 02178000 LABEL L;% %WF 02178100 L: SCAN(NCR, COUNT, ACCUM[1], 63-COUNT, RESULT, %WF 02178200 RESULT, COUNT, 0, NCR, 0); %WF 02178300 IF NCR=LCR THEN %WF 02178400 BEGIN READACARD; %WF 02179000 IF LIBINDEX!0 THEN %WF 02179100 IF RECOUNT=FINISHPT THEN %WF 02179200 BEGIN SEARCHLIB(FALSE); %WF 02179300 READACARD; %WF 02179400 NORELEASE ~ FALSE; %WF 02180000 END; %WF 02180100 GO TO L; %WF 02180200 END; %WF 02180300 END SCANNER; %WF 02180400 PROCEDURE READACARD; 02181000 COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02182000 TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02183000 LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02184000 SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02185000 FCR,NCR,LCR,TLCR, AND CLCR; 02186000 BEGIN 02187000 PROCEDURE READTAPE(LCR,MAXLCR,LIB); 02188000 VALUE LIB; 02189000 BOOLEAN LIB; 02190000 REAL LCR, MAXLCR; 02191000 IF LIB THEN 02192000 BEGIN RECOUNT~RECOUNT+1; 02193000 IF LCR~LCR+11>MAXLCR THEN 02194000 BEGIN READ(LIBRARY[FILEINX]); 02195000 MAXLCR~46+LCR~MKABS(LIBRARY[FILEINX](0))+10; 02196000 END; 02196010 ADDER(SEQSUM,LCR,TRUE,TRUE); 02196015 END ELSE 02196030 BEGIN READ(TAPE); 02196040 MAXLCR~LCR~MKABS(TAPE(9)) 02196050 END READTAPE; 02196060 02196070 02196080 02196090 02196100 02196110 02196120 02196130 02196140 02196141 02196142 PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); 02196150 VALUE LIB; 02196160 BOOLEAN LIB; 02196170 REAL TLCR, CLCR ; 02196180 BEGIN 02196190 IF IF NOPATCH THEN TRUE ELSE GT1 ~ COMPARE (TLCR,CLCR) = 0 THEN % %T0302196200 BEGIN 02196210 LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02196220 END 02196230 ELSE BEGIN 02196240 IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02196250 BEGIN 02196260 IF EXAMIN(GT1:=CLCR-9) = "$" % %T0302196270 IMP (EXAMIN(GT1+65536)="E" OR GT1~EXAMIN(GT1+32768)="$" OR GT1="E")%T0302196272 THEN % %T0302196273 BEGIN 02196275 IF LIB THEN 02196280 BEGIN 02196290 IF FINISHPT-RECOUNT=1 THEN 02196300 LASTCRDPATCH:=TRUE 02196305 ELSE READTAPE(LTLCR,MAXLTLCR,TRUE) 02196310 END 02196320 ELSE READTAPE(TLCR,MAXTLCR,FALSE); 02196330 END 02196340 ELSE IF LIB THEN READTAPE(LTLCR,MAXTLCR,TRUE) 02196345 ELSE READTAPE(TLCR,MAXTLCR,FALSE) 02196350 END; 02196360 LCR:=CLCR; 02196370 LASTUSED:=IF LIB THEN 5 ELSE 2; 02196380 END; 02196390 END OF SEQCOMPARE; 02196400 LABEL CARDONLY, CARDLAST, TAPELAST, FIRSTIME, EXIT, 02197000 EOF, USETHESWITCH, %D02197100 COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02198000 SWITCH USESWITCH ~ CARDONLY,CARDLAST,TAPELAST,FIRSTIME, 02199000 LIBCLAST, LIBTLAST; 02199010 USETHESWITCH: %D02199900 GO TO USESWITCH[LASTUSED]; 02200000 MOVE(1,TEXT[LASTUSED.LINKR,LASTUSED.LINKC], 02201000 DEFINEARRAY[DEFINEINDEX-2]); 02202000 LASTUSED ~ LASTUSED + 1; 02203000 NCR ~ LCR-1; 02204000 GO TO XIT; 02205000 CARDONLY: IF NORELEASE THEN GO TO EXIT; READ(CARD); 02206000 FIRSTIME: LCR ~ MKABS(CARD(9)); 02207000 GO TO EXIT; 02208000 COMMENT THIS RELEASES CARD FROM READER AND SETS LCR; 02209000 CARDLAST: IF NORELEASE THEN GO TO EXIT; READ(CARD)[EOF]; 02210000 CLCR ~ MKABS(CARD(9)); 02211000 GO COMPAR; 02212000 EOF: DEFINEARRAY[25]~"ND;END."&"E"[1:43:5]; 02212100 DEFINEARRAY[34]~"9999"&"9999"[1:25:23]; 02212200 CLCR~MKABS(DEFINEARRAY[34]); 02212300 ZOT(DEFINEARRAY[33],"%",CLCR-8); 02212400 GO COMPAR; 02212700 COMMENT THIS RELEASES THE PREVIOUS CARD FROM CARD READER AND SETS 02213000 UP CLCR; 02214000 TAPELAST: READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02215000 COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02216000 LIBCLAST: IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; 02217000 GO TO COMPAR END; 02217100 READ(CARD)[EOF]; 02217200 CLCR ~ MKABS(CARD(9)); 02218000 IF LASTCRDPATCH THEN BEGIN 02218100 LASTCRDPATCH~FALSE; 02218200 RECOUNT~RECOUNT+1; 02218300 GO TO XIT END; 02218400 GO TO COMPAR; 02219000 LIBTLAST: 02220000 IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; GO TO COMPAR END; 02220500 READTAPE(LTLCR,MAXLTLCR,TRUE); 02221000 IF RECOUNT=FINISHPT THEN GO TO XIT; 02221100 02222000 02223000 02224000 02225000 02226000 COMPAR: IF LASTUSED = 2 OR LASTUSED = 3 THEN 02227000 SEQCOMPARE(TLCR,CLCR,FALSE) 02228000 ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02229000 EXIT: NCR ~ FCR~ LCR - 9; 02229010 COMMENT SETS UP NCR AND FCR; 02230000 IF VOIDCR ! 0 THEN 02230010 BEGIN IF COMPARE(LCR,VOIDCR) = 0 THEN 02230020 BEGIN % %T0302230021 IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN BEGIN % %T0302230022 GO USETHESWITCH; % %T0302230030 END; % %T0302230032 END ELSE BEGIN 02230035 VOIDCR ~ VOIDPLACE ~ 0; 02230040 VOIDTAPE ~ FALSE; % %T0302230045 END; END; % %T0302230050 IF(IF SEQTOG THEN NONBLANK(FCR) ELSE TRUE) THEN 02230100 IF WRITNEW (L1N,FCR) THEN BEGIN % %T0302231000 IF NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); 02231050 IF SEQTOG THEN BEGIN IF TOTALNO = -10 OR NEWBASE THEN 02231100 BEGIN NEWBASE ~ FALSE; GTI1~ TOTALNO~BASENUM END ELSE 02231200 GTI1~ TOTALNO~ TOTALNO + ADDVALUE; 02231300 IF NEWTOG THEN CHANGESEQ(GTI1,MKABS(L1N[9])); % %T0302231350 CHANGESEQ(GTI1,LCR); END; 02231400 LINENUMBER ~ LINENUMBER + 1; % %T0302231450 IF LISTOG OR (IF CHECKTOG THEN GT1~ 02231500 COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR) = 1 02231600 ELSE FALSE) THEN 02232000 BEGIN PRINT(LIN,FCR,L.[36:10],IF LASTUSED=6 THEN FILEINX 02233000 +17 ELSE IF LASTUSED=3 THEN "T" ELSE IF LASTUSED02233100 =2 OR LASTUSED=5 THEN "R" ELSE 48); 02234000 IF CHECKTOG AND GT1 = 1 THEN BEGIN % %T0302235000 % %T0302235005 SEQERRORCOUNT ~ SEQERRORCOUNT + 1; % %T0302235010 SEQERR(LIN[14]); % %T0302235020 ERRORCOUNT ~ ERRORCOUNT + REAL(SEQERRORTOG); % %T0302235030 END; % %T0302235040 IF NOTPNTED THEN PERMLINE(NOHEADING); 02235100 WRITELINE; 02236000 END; 02237000 IF NEWTOG THEN 02238000 % %T0302239000 WRITE (NEWTAPE,10,L1N[*]); % %T0302240000 02241000 02242000 COMMENT WRITES NEW TAPE IF NECESSARY; 02243000 END; 02244000 ZOT(INFO[LASTSEQROW,LASTSEQUENCE],"%",LCR); 02245000 COMMENT PUTS % IN COLUMN 73 AND SEQUENCE NUMBER IN INFO; 02246000 IF USELINO THEN CARDNUMBER ~ LINENUMBER ELSE %T0302246050 CARDNUMBER ~ CONV(INFO[LASTSEQROW,LASTSEQUENCE-1], 5, 8); 02246100 IF BUILDLINE THEN 02246200 IF LASTADDRESS ! (LASTADDRESS ~ L) THEN 02246300 BEGIN ENILSPOT ~ L.[36:10] & CARDNUMBER[10:20:28]; 02246400 IF (ENILPTR ~ ENILPTR+1)}1023 THEN 02246500 BEGIN FLAG(80); ENILPTR ~ 512; END; 02246600 END; 02246700 XIT: END READACARD; 02247000 REAL PROCEDURE CONVERT; 02248000 BEGIN REAL T; INTEGER N; 02249000 TLO~0; THI~ 02250000 T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000 FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000 IF DPTOG THEN 02253000 BEGIN 02254000 DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~, 02255000 THI,TLO); 02256000 T~THI; 02257000 END ELSE 02258000 T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000 CONVERT~T; 02260000 END; 02261000 %T0302261500 LABEL ENDOFITALL; % %T1402261600 REAL STREAM PROCEDURE FETCH(F); VALUE F; %WF 02262000 BEGIN SI~F; SI~SI-8; DI~LOC FETCH; DS~WDS; END FETCH; %WF 02263000 PROCEDURE DUMPINFO; 02264000 BEGIN 02264050 ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100 STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400 BEGIN 02264450 SI:=S; DI:=D; 02264500 N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550 DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600 END OF OCTALWORDS; 02264650 STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700 BEGIN 02264750 SI:=S; DI:=D; 02264800 N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850 END OF ALPHAWORDS; 02264900 IF NOTPNTED THEN PERMLINE(NOHEADING);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 COMMENT TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER 02277000 USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY. 02278000 THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED. 02279000 TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY 02280000 ELBAT. ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR 02281000 COMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD. NXTELBT02282000 IS ALMOST EXCLUSIVELY USED BY TABLE, ALTHOUGH AN OCCASION-02283000 AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS02284000 SCANNED. (SEE FOR EXAMPLE COMPOUNDTAIL). FOR FURTHER 02285000 GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES.02286000 THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY 02287000 DESIRED (USUALLY I-1,I, OR I+1). 02288000 THE GENERAL PLAN OF TABLE IS THIS: 02289000 I) IF P < NXTELBAT GO ON TO III). 02290000 II) PROCESS ONE QUANTITY. 02291000 A) SCAN. 02292000 B) TEST FOR IDENTIFIER, NUMBER, 3R SPECIAL CHARACTOR.02293000 1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS 02294000 IN SPECIAL MANNER IF COMMENT OR DEFINED ID. 02295000 2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART, 02296000 AND EXPONENT PART. 02297000 3) TEST IF SPECIAL CHARACTOR REQUIRES SPECIAL 02298000 PROCESSING - OTHERWISE GET ELBAT WORD FROM 02299000 SPECIAL. 02300000 C) LOAD ELBAT AND INCREMENT NXTELBT. 02301000 D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P. 02302000 E) GO BACK TO I). 02303000 III) RETURN WITH CLASS OF ELBAT[P]. 02304000 FURTHER DETAILS ARE GIVEN IN BODY OF TABLE; 02305000 INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 02306000 BEGIN 02307000 LABEL PERCENT,SPECIALCHAR,COMPLETE,COLON,DOT,ATSIGN,QUOTE, 02308000 STRNGXT, MOVEIT, 02308100 SCANAGAIN,FPART,EPART,IPART,IDENT,ROSE,COMPOST,DOLLAR,RTPAREN,ARGH, 02309000 CROSSHATCH,DBLDOLLAR,LESSTHAN; %W0302310000 SWITCH SPECIALSWITCH ~ PERCENT,DOLLAR,DOT,ATSIGN,COLON,QUOTE,RTPAREN, 02311000 CROSSHATCH,DBLDOLLAR,LESSTHAN; %W0302312000 SWITCH RESULTSWITCH~ IDENT, SPECIALCHAR,IPART; 02313000 WHILE P } NXTELBT 02314000 DO BEGIN 02315000 SCANAGAIN: COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02316000 GO TO RESULTSWITCH[RESULT]; 02317000 ARGH: Q ~ ACCUM[1]; FLAG(141); GO TO SCANAGAIN; 02318000 SPECIALCHAR: GT1 ~ (Q ~ ACCUM[1]).[18:6] - 2; %T9002319000 ENDTOG ~ (GT1 = 57 OR GT1 = 24) AND ENDTOG; %M02320000 COMMENT OBTAIN ACTUAL CHARACTOR FROM ACCUM; 02321000 T ~ SPECIAL[GT1>1[42:41:3]]; 02322000 COMMENT NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF 02323000 ELBAT WORDS FOR SPECIAL CHARACTORS; 02324000 IF GT1 ~ T.INCR = 0 THEN GO TO COMPLETE; 02325000 GO TO SPECIALSWITCH[GT1]; 02326000 COMMENT INCR FIELD OF SPECIAL CHARACTOR IS NON-ZERO FOR SPECIAL 02327000 CHARACTORS REQUIRING SPECIAL HANDELING. INCR IS SWITCHED 02328000 ON TO OBTAIN DISCRIMINATION; 02329000 COLON: RESULT ~ 7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02330000 FOR := IN PLACE OR ~ ; 02331000 IF NOT SYMQUOTE THEN %M02331500 IF EXAMIN (NCR) = "=" THEN BEGIN RESULT ~0; SCANNER; 02332000 T ~ SPECIAL[13] END; 02333000 RESULT ~ 2; GO TO COMPLETE; 02334000 LESSTHAN: IF REAL(STOPDEFINE) ! 0 THEN GO TO COMPLETE; % %W0302334100 RESULT~7; SCANNER; %W0302334105 COUNT ~ 0; RESULT ~ 3; SCANNER; %W0302334110 RESULT~7; SCANNER; %W0302334115 IF EXAMIN(NCR)!">" THEN BEGIN %W0302334120 IF COUNT=0 THEN BEGIN ACCUM[1]~"1<0000"; %W0302334130 GO TO COMPLETE END; %W0302334140 ELBAT[NXTELBT] ~ T; NXTELBT ~ NXTELBT+1; %W0302334150 GO TO IPART END; %W0302334160 IF REAL(STREAMTOG)=2 THEN OCTCON(FALSE,ACCUM[0]) ELSE %W0302334170 OCTCON(TRUE,C); T ~ 0&TRUTHV[2:41:7]&2[25:46:2]; %W0302334180 RESULT ~ 0; SCANNER; GO TO COMPLETE; %W0302334190 DOT: IF ENDTOG THEN BEGIN ENDTOG ~ FALSE; GO TO COMPLETE END; %M02335000 IF EXAMIN(NCR)>9 THEN BEGIN RESULT ~ 7; SCANNER; %M02335100 IF QUOTETOG THEN %A02335150 IF EXAMIN(NCR)!"[" THEN T ~ 0&DOTOP[2:41:7]; %M02335200 GO TO COMPLETE END; %M02335300 NHI~NLO~0; 02336000 C~0; FSAVE~0; GO TO FPART; 02337000 ATSIGN: IF QUOTETOG THEN BEGIN T ~ PERIOD; GO TO COMPLETE END; %A02338000 NHI ~ C ~ 1; NLO ~ FSAVE ~ 0; GO TO EPART; %A02338500 COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02339000 02340000 QUOTE: IF QUOTETOG THEN BEGIN T~0"EOP[2:41:7]; %M02341000 GO TO COMPLETE END; %M02341100 COUNT ~ 0; T ~ IF STREAMTOG THEN 63 ELSE IF STREAMTOG.[2:1] %M02341200 THEN 16 ELSE 7+REAL(STREAMTOG.[46:1]); 02342000 DO BEGIN 02343000 RESULT ~ 5; SCANNER; 02344000 IF COUNT=T THEN IF EXAMIN(NCR) ! """ 02345000 THEN GO TO ARGH; 02345100 END UNTIL EXAMIN(NCR) = """; 02346000 Q ~ ACCUM[1]; RESULT ~ 5; SCANNER; COUNT~COUNT-1; 02347000 IF COUNT<0 THEN COUNT~COUNT+64; 02347100 ACCUM[1] ~ Q; RESULT ~ 4; 02348000 STRNGXT: T~C~0; 02349000 IF COUNT < 8 THEN 02350000 MOVEIT: 02350100 MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT); 02351000 T.CLASS ~ STRNGCON; GO TO COMPLETE; 02352000 COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02353000 THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02354000 THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02355000 THE TWO CASES ARE PROCESSED DIFERENTLY. THE FIRST CASE 02356000 MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02357000 CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID.02358000 FOR A FULL DISCUSSION SEE DEFINEGEN; 02359000 CROSSHATCH: IF DEFINECTR!0 THEN GO TO COMPLETE; 02360000 IF SYMQUOTE THEN GO TO COMPLETE; %M02360500 % %M02361000 IF DEFINEINDEX=0 THEN IF PRINTOG OR SYMFORMAT THEN GO TO COMPLETE ELSE%M02362000 GO TO ARGH; %M02362500 ZOT(GT1,0,LCR); %M02362600 LCR ~ (GT1 ~ DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02363000 NCR ~ GT1 - LCR | 262144; % %T0302364000 GT2~0&(T~DEFINEARRAY[DEFINEINDEX~DEFINEINDEX-3]) 02365000 [33:18:15]; 02365100 LASTUSED~T.[33:15]; 02365200 IF GT2 ! 0 THEN 02365300 BEGIN 02365400 NEXTTEXT ~ (GT2 ~ TAKE(GT2)).DYNAM; 02365500 DEFSTACKHEAD ~ GT2.LINK; 02365600 END; 02365700 GO TO SCANAGAIN; 02366000 DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02367000 IF SYMQUOTE THEN GO TO COMPLETE; %M02367005 BEGIN LABEL SEGMENT; SEGMENT: % %T0302367010 COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02368000 IF Q ~ ACCUM[1] = "1X0000" THEN GO SEGMENT; % %T0302369000 IF Q = "4VOID0" THEN 02369100 BEGIN GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369200 %T0302369300 GO TO PERCENT %T0302369400 END; 02369500 IF Q="5VOIDT" THEN BEGIN 02369600 VOIDTAPE~TRUE; 02369700 GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369800 READACARD;GO SCANAGAIN END; 02369900 %T0302369950 %T0302369960 IF Q = "4TAPE0" THEN 02370000 BEGIN 02371000 LASTUSED ~ 2; COMMENT NEXT CARD READ IS FROM RDR; 02372000 IF MAXTLCR = 0 THEN 02373000 BEGIN INTEGER STREAM PROCEDURE FEJ(F,T); VALUE T; 02374000 BEGIN SI~F; DI~LOC T; DS~WDS; SI~T; SI~SI-16; 02375000 DI~LOC FEJ; DS~WDS END FEJ; 02376000 STREAM PROCEDURE FIX(F,T); VALUE T; 02377000 BEGIN SI~F; SI~SI-24; DI~LOC T; DS~WDS; DI~T; 02378000 DI~DI+47; SKIP 4 DB; DS~2 RESET; DI~DI+48; 02379000 DI~DI+48; DS~8 LIT "00#01+0#"; END FIX; 02379100 IF GT1~FEJ(TAPE,0)=10 THEN 02379200 BEGIN REWIND(TAPE); FIX(TAPE,0) END; 02379300 MAXTLCR~GT1+TLCR~9+MKABS(TAPE(0)); 02379400 LASTUSED~2; 02379500 END; END 02380000 ELSE IF Q="3POP00" THEN BEGIN % %T0302380205 LISTOG.[47:1] ~ OPTHOLD[ZOPT ~ ZOPT - 1]; %%T0302380210 PRTOG ~ OPTHOLD[ZOPT].[46:1]; % %T0302380215 CHECKTOG ~ OPTHOLD[ZOPT].[45:1]; % %T0302380220 NEWTOG ~ OPTHOLD[ZOPT].[44:1]; % %T0302380225 SEQTOG ~ OPTHOLD[ZOPT].[43:1]; % %T0302380230 BASENUM ~ BASHOLD[ZOPT]; % %T0302380235 TOTALNO ~ TOTHOLD[ZOPT]; % %T0302380240 NEWBASE ~ OPTHOLD[ZOPT].[42:1]; % %T0302380245 ADDVALUE ~ ADDHOLD[ZOPT]; % %T0302380250 DEBUGTOG ~ OPTHOLD[ZOPT].[41:1]; % %T0302380255 PUNCHTOG ~ OPTHOLD[ZOPT].[40:1]; % %T0302380260 SEQERRORTOG ~ OPTHOLD[ZOPT].[39:1]; % %T0302380265 LASTUSED ~ REAL( % %T0302380270 OPTHOLD[ZOPT].[18:15]); % %T0302380275 STREAMER ~ OPTHOLD[ZOPT].[38:1]; % %T0302380280 SINGLTOG ~ OPTHOLD[ZOPT].[37:1]; % %T0302380390 GO TO PERCENT; % %T0302380400 END ELSE % %T0302380405 IF Q="4PUSH0" THEN BEGIN % %T0302380410 OPTHOLD[ZOPT] ~ LISTOG; % %T0302380415 OPTHOLD[ZOPT].[46:1] ~ PRTOG; % %T0302380420 OPTHOLD[ZOPT].[45:1] ~ CHECKTOG; % %T0302380425 OPTHOLD[ZOPT].[44:1] ~ NEWTOG; % %T0302380430 OPTHOLD[ZOPT].[43:1] ~ SEQTOG; % %T0302380435 BASHOLD[ZOPT] ~ BASENUM; % %T0302380440 TOTHOLD[ZOPT] ~ TOTALNO; % %T0302380445 OPTHOLD[ZOPT].[42:1] ~ NEWBASE; % %T0302380450 ADDHOLD[ZOPT] ~ ADDVALUE; % %T0302380455 OPTHOLD[ZOPT].[41:1] ~ DEBUGTOG; % %T0302380460 OPTHOLD[ZOPT].[40:1] ~ PUNCHTOG; % %T0302380465 OPTHOLD[ZOPT].[39:1] ~ SEQERRORTOG; % %T0302380470 OPTHOLD[ZOPT].[18:15] ~ BOOLEAN(LASTUSED); % %T0302380475 OPTHOLD[ZOPT].[38:1] ~ STREAMER; % %T0302380480 OPTHOLD[ZOPT].[37:1] ~ SINGLTOG; % %T0302380590 ZOPT ~ ZOPT + 1; % %T0302380600 GO TO PERCENT; % %T0302380605 END ELSE % %T0302380610 IF Q="5ENTER" THEN BEGIN % %T0302380620 GT1 ~ 5; % %T0302380630 GO TO DBLDOLLAR; % %T0302380640 END ELSE % %T0302380650 IF Q="1$0000" THEN BEGIN % %T0302380660 GT1 ~ 1; % %T0302380670 GO TO DBLDOLLAR; % %T0302380680 END % %T0302380690 ELSE BEGIN IF Q! "4CARD0" THEN GO TO PERCENT; 02381000 IF LASTUSED } 5 THEN ELSE LASTUSED ~1 END; 02382000 CHECKTOG~FALSE; 02382100 LISTOG.[47:1]~FALSE; 02382200 PRTOG~NEWTOG~DEBUGTOG~PUNCHTOG~FALSE; 02383000 SEQERRORTOG ~ FALSE ; % %T0302383010 % %T1102383100 DO BEGIN 02384000 COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; Q ~ ACCUM[1];02385000 IF Q = "1%0000" THEN GO TO PERCENT ELSE 02385100 IF Q = "4XREF0" THEN XREF := %HCG190 02385200 XREF OR BUILDLINE.[45:1] ELSE %HCG190 02385201 IF Q = "6SEQXE" THEN % 02385400 BUILDLINE.[47:1] ~ TRUE ELSE %HCG190 02385600 IF Q = "4LIST0" THEN LISTOG.[47:1]~TRUE ELSE 02386000 IF Q = "6SINGL" OR Q = "3SGL00" THEN 02386100 %T9302386105 LISTOG.[47:1]:=SINGLTOG:=TRUE ELSE 02386110 IF Q = "6DOUBL" OR Q = "3DBL00" THEN SINGLTOG := FALSE ELSE %T9302386115 02386120 02386130 02386140 02386150 02386160 02386170 02386180 02386190 02386200 02386210 IF Q = "3PRT00" THEN PRTOG:=TRUE ELSE 02387000 IF Q= "5CHECK" THEN CHECKTOG~TRUE ELSE 02387100 IF Q = "4INFO0" THEN DUMPINFO ELSE 02387200 IF Q.[18:18]="NEW" THEN NEWTOG~TRUE ELSE %T1102388000 IF Q = "5NOSEQ" THEN SEQTOG~FALSE ELSE 02388100 IF Q = "3SEQ00" THEN SEQTOG~ TRUE ELSE 02388200 IF RESULT = 3 THEN BEGIN 02388300 BASENUM~ CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388400 TOTALNO~-10; 02388450 NEWBASE ~ TRUE 02388500 END ELSE 02388600 IF RESULT = 2 THEN BEGIN 02388700 IF ACCUM[1]= "1+0000" THEN 02388800 BEGIN RESULT~ COUNT~ ACCUM[1]~0; 02388900 SCANNER; IF RESULT = 3 THEN 02388910 ADDVALUE~CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388920 END END ELSE 02388930 IF Q = "6DEBUG" OR Q = "7IDEBU" THEN %T9002389000 BEGIN LISTOG.[47:1] := PRTOG := TRUE; %T9302390000 IF Q="6DEBUG" THEN DEBUGTOG~TRUE ELSE %T9002390050 INTDEBUGTOG ~ TRUE; %T9002390080 FILL WOP[*] WITH 02391000 "LITC"," ", 02392000 "OPDC","DESC", 02393000 10,"DEL ", 11,"NOP ", 12,"XRT ", 16,"ADD ", 17,"AD2 ", 18,"PRL ", 02394000 19,"LNG ", 21,"GEQ ", 22,"BBC ", 24,"INX ", 35,"LOR ", 37,"GTR ", 02395000 38,"BFC ", 39,"RTN ", 40,"COC ", 48,"SUB ", 49,"SB2 ", 64,"MUL ", 02396000 65,"ML2 ", 67,"LND ", 68,"STD ", 69,"NEQ ", 71,"XIT ", 72,"MKS ", 02397000 128,"DIV ",129,"DV2 ",130,"COM ",131,"LQV ",132,"SND ",133,"XCH ", 02398000 134,"CHS ",167,"RTS ",168,"CDC ",197,"FTC ",260,"LOD ",261,"DUP ", 02399000 278,"LBC ",280,"SSF ",294,"LFC ",322,"ZP1 ",384,"IDV ",453,"FTF ", 02400000 515,"MDS ",532,"ISD ",533,"LEQ ",534,"BBW ",548,"ISN ",549,"LSS ", 02401000 550,"BFW ",581,"EQL ",582,"SSP ",584,"ECM ",709,"CTC ",790,"LBU ", 02401100 806,"LFU ",896,"RDV ",965,"CTF ", 02401200 1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023; 02402000 FILL COP[*] WITH % CHARACTER MODE MNEMONICS 02403000 "EXC ","NOP ","BSD ","BSS ","RDA ","TRW ","SED ","TDA ", 02404000 " "," ","TBN "," ","SDA ","SSA ","SFD ","SRD ", 02405000 " "," ","SES "," ","TEQ ","TNE ","TEG ","TGR ", 02406000 "SRS ","SFS "," "," ","TEL ","TLS ","TAN ","BIT ", 02407000 "INC ","STC ","SEC ","CRF ","JNC ","JFC ","JNS ","JFW ", 02408000 "RCA ","ENS ","BNS ","RSA ","SCA ","JRC ","TSA ","JRV ", 02409000 "CEQ ","CNE ","CEG ","CGR ","BIS ","BIR ","OCV ","ICV ", 02410000 "CEL ","CLS ","FSU ","FAD ","TRP ","TRN ","TRZ ","TRS "; 02411000 02412000 FILL POP[*] WITH 02412100 "ZFN ","ZBN ","ZFD ","ZBD ","ISO ",0,"DIA ","DIB ","TRB ","CFL ","CFE "02412200 ; 02412300 END ELSE 02413000 IF Q = "5PUNCH" THEN PUNCHTOG ~ TRUE ELSE 02414000 IF Q = "5ERROR" THEN SEQERRORTOG ~ TRUE ELSE % STXERR FOR SEQERR %T0302414100 IF Q = "7LIBLI" THEN LISTOG.[47:1] ~ LISTOG.[18:15] ELSE % %T0302414200 % %T0302414600 IF Q="6UNSAF" THEN STREAMER ~% %T0302414700 (LASTUSED}5 AND FILEINX=NOTAPES-1) ELSE % %T0302414800 IF Q="7LISTL" THEN LISTOG.[18:15] ~ TRUE ELSE % %T0302414850 IF Q="4SAFE0" THEN STREAMER ~ FALSE ELSE % %T0302414900 IF Q="6ERROR" THEN BEGIN % %T9802414910 COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; % %T9802414920 IF RESULT ! 3 THEN GO PERCENT; % %T9802414930 ERRORMAX ~ CONV(ACCUM[1],0,ACCUM[1].[12:6]); % %T9802414940 IF ERRORMAX < ERRORCOUNT THEN GO ENDOFITALL; % %T9802414945 END ELSE % %T9802414950 END UNTIL FALSE; 02415000 END; % %T0302415900 PERCENT: IF SYMQUOTE THEN IF NCR.[33:15] ! LCR.[33:15] THEN %T9202416000 GO TO COMPLETE; %T9202416100 IF NCR ! FCR THEN READACARD; %T9202416150 IF LIBINDEX!0 THEN 02416200 IF RECOUNT=FINISHPT THEN 02416400 BEGIN SEARCHLIB(FALSE); READACARD; NORELEASE~FALSE END; 02416600 GO TO SCANAGAIN; 02417000 COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02418000 PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02419000 SIDE AFFECT IS THAT ALL CHARACTORS ON A CARD ARE IGNORED 02420000 AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR02421000 COMMENT; 02422000 COMMENT MIGHT BE FUNNY COMMA - HANDEL HERE; 02423000 RTPAREN: RESULT ~ 7; SCANNER; 02424000 IF SYMQUOTE THEN GO TO COMPLETE; %M02424500 IF EXAMIN(NCR) = """ 02425000 THEN BEGIN 02426000 RESULT ~ 0; SCANNER; 02427000 DO BEGIN RESULT ~ 5; SCANNER END UNTIL EXAMIN(NCR) 02428000 = """; 02429000 RESULT ~ 0; SCANNER; 02430000 RESULT ~ 7; SCANNER; 02431000 IF EXAMIN(NCR) ! "(" THEN 02432000 GO TO ARGH; 02433000 RESULT ~ 0; SCANNER; Q ~ ACCUM[1]; 02434000 T ~ SPECIAL[24] 02435000 END; 02436000 RESULT ~ 2; GO TO COMPLETE; 02437000 IPART: TCOUNT~0; 02438000 FSAVE~0; 02438500 C~CONVERT; 02439000 IF DPTOG THEN BEGIN NHI~THI; NLO~TLO; END; 02440000 IF EXAMIN(NCR)="." THEN 02441000 BEGIN RESULT~0; 02442000 SCANNER; 02443000 C ~ 1.0| C; 02444000 FPART: TCOUNT~COUNT; 02445000 IF EXAMIN(NCR){9 THEN 02446000 BEGIN RESULT~0; 02447000 SCANNER; 02448000 IF DPTOG THEN 02449000 BEGIN 02450000 DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02451000 0,/,~,THI,TLO); 02452000 FOR T~12 STEP 12 UNTIL COUNT - TCOUNT DO 02453000 DOUBLE(THI,TLO,TEN[12],0,/,~,THI,TLO); 02454000 DOUBLE(THI,TLO,NHI,NLO,+,~,NHI,NLO); 02455000 C~NHI END ELSE 02456000 C~CONVERT+C|TEN[FSAVE~COUNT-TCOUNT]; 02457000 END 02458000 END; 02459000 RESULT ~7; SCANNER; 02460000 IF EXAMIN(NCR)="@" THEN 02461000 BEGIN RESULT~0; 02462000 SCANNER; 02463000 EPART: TCOUNT~COUNT; 02464000 C~C|1.0; 02465000 RESULT ~7; SCANNER; 02466000 IF T~EXAMIN(NCR)>9 THEN 02467000 IF T="-" OR T = "+" THEN 02467100 BEGIN RESULT~0; 02468000 SCANNER; 02469000 TCOUNT~COUNT; 02470000 END ELSE FLAG(47); RESULT ~ 0; 02471000 SCANNER; 02472000 IF RESULT ! 3 THEN FLAG (47);COMMENT NOT A NUMBER; 02472100 Q~ACCUM[1]; 02473000 IF GT1~T~(IF T="-"THEN -CONVERT ELSE CONVERT)<-46 OR T>69 02474000 THEN 02475000 FLAG(269) 02476000 ELSE BEGIN T~TEN[ABS(GT3~T-FSAVE)]; 02477000 IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] + 12) 02478000 >63 THEN 02479000 FLAG(269) ELSE 02480000 IF DPTOG THEN 02481000 IF GT1<0 THEN 02482000 BEGIN 02483000 GT1~-GT1; 02484000 DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,~,NHI,NLO); 02485000 FOR GT2~12 STEP 12 UNTIL GT1 DO 02486000 DOUBLE(NHI,NLO,TEN[12],0,/,~,NHI,NLO); 02487000 END ELSE 02488000 BEGIN 02489000 DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,~,NHI,NLO); 02490000 FOR GT2~12 STEP 12 UNTIL GT1 DO 02491000 DOUBLE( NHI,NLO,TEN[12],0,|,~,NHI,NLO); 02492000 END ELSE C~IF GT3<0 THEN C/T ELSE C|T; 02493000 END; 02494000 END ELSE IF FSAVE ! 0 THEN C~C/TEN[FSAVE]; 02495000 Q ~ ACCUM[1]; RESULT ~ 3; 02496000 T~0; 02497000 IF REAL(BOOLEAN(C)AND NOT BOOLEAN(1023))=0 THEN 02498000 BEGIN T.CLASS~LITNO ; T.ADDRESS~C.[38:10] END 02499000 ELSE T.CLASS~NONLITNO ; 02500000 GO TO COMPLETE; 02501000 COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02502000 IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02503000 ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02504000 TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK, %WF 02505000 TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR %WF 02505100 COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO %WF 02505200 COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND %WF 02506000 ROSE IS ENTERED. THE LAST THING DONE FOR ANY %WF 02506100 IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION %WF 02506200 OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS %WF 02507000 ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, %WF 02507100 SHOULD THIS BE REQUIRED. ; %WF 02507200 IDENT: IF T ~ SUPERSTACK[SCRAM ~ (Q ~ ACCUM[1]) MOD 125]!0 02508000 THEN BEGIN %WF 02508100 IF INFO[GT1 ~ T.LINKR,(GT2 ~ T.LINKC)+1]=Q %WF 02508200 THEN BEGIN %WF 02508300 T ~ INFO[GT1,GT2]&T[35:35:13]; %WF 02508400 GO TO COMPLETE %WF 02508500 END %WF 02508600 END; %WF 02508700 IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN 02508730 T ~ DEFSTACKHEAD ELSE 02508770 T ~ STACKHEAD[SCRAM]; %WF 02508800 ROSE : GT1 ~ T.LINKR; 02509000 IF(GT2 ~ T.LINKC)+GT1= 0 THEN 02510000 BEGIN T ~ 0; IF COUNT { 13 AND COUNT } 3 AND NOT %M02511000 SYMQUOTE THEN CHAINFORM(ACCUM[1],T); GO TO COMPLETE END; %M02511500 T ~ INFO[GT1,GT2]; 02512000 IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO TO ROSE; 02513000 IF COUNT { 5 THEN GO TO COMPOST ; 02514000 IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2]) 02515000 THEN GO TO ROSE; 02516000 COMPOST: T ~ T>1[35:43:5]>2[40:40:8]; 02517000 IF XREF THEN %DFB02517100 IF GT1 !1 THEN 02517150 IF GT1!1 OR GT2}LASTSEQUENCE THEN 02517170 BEGIN %DFB02517200 IF XREFPT=30 THEN %DFB02517300 BEGIN %DFB02517400 WRITE(DSK2,30,XREFAY2[*]); %DFB02517500 XREFPT:=0; %DFB02517600 END; %DFB02517700 XREFAY2[XREFPT]:=CARDNUMBER&XREFINFO[GT1,GT2] %DFB02517800 [10:37:11]; %DFB02517820 XREFPT:=XREFPT+1; %DFB02517840 END; %DFB02517860 COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02518000 IF SYMQUOTE THEN GO TO COMPLETE; %M02518500 IF NOT ENDTOG THEN BEGIN 02519000 IF GT1 ~ T.CLASS = COMMENTV THEN BEGIN 02520000 WHILE EXAMIN(NCR) ! ";" DO 02521000 BEGIN RESULT ~ 6; COUNT ~ 0; SCANNER END; 02522000 RESULT~0;SCANNER;GO TO SCANAGAIN END END; 02523000 IF STOPDEFINE THEN GO TO COMPLETE; 02524000 IF GT1 ! DEFINEDID THEN GO TO COMPLETE; 02525000 COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02526000 IF BOOLEAN(T.MON) THEN % THIS IS A PARAMETRIC DEFINE 02526500 GT1 ~ GIT(T ~ FIXDEFINEINFO(T)) ELSE GT1 ~ 0; 02526600 IF DEFINEINDEX = 24 THEN BEGIN FLAG(139);GO TO ARGH END; 02527000 DEFINEARRAY[DEFINEINDEX] ~ LASTUSED & GT1[18:33:15]; 02528000 LASTUSED ~ T.DYNAM; 02529000 DEFINEARRAY[DEFINEINDEX+2] ~ 262144|LCR+NCR; 02530000 LCR ~ (NCR ~ MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02531000 ZOT(GT4,"%",LCR); DEFINEINDEX ~ DEFINEINDEX+3; 02532000 GO TO PERCENT; 02533000 DBLDOLLAR: CARDCALL ~ LASTUSED = 5; % %T0302533010 SEARCHLIB(BOOLEAN(GT1)); GO SCANAGAIN; % %T0302533500 COMPLETE: ELBAT[NXTELBT] ~ T; 02534000 STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINES AGAIN; 02535000 IF NXTELBT ~ NXTELBT+1 > 74 02536000 THEN IF NOT MACROID 02536500 THEN BEGIN 02537000 COMMENT ELBAT IS FULL: ADJUST IT; 02538000 MOVE(11,ELBAT[65],ELBAT); %W0302539000 I~ I-65; 02540000 P~ P-65; 02541000 NXTELBT ~ NXTELBT-65 END END; %W0302542000 IF TABLE ~ ELBAT[P].CLASS = COMMENTV 02543000 THEN IF NOT SYMQUOTE %A02543500 THEN BEGIN 02544000 COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02545000 C ~ INFO[0,ELBAT[P].ADDRESS]; 02546000 ELBAT[P].CLASS ~ TABLE ~ NONLITNO END; 02547000 STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINE; 02547500 END TABLE ; 02548000 COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02549000 IT USED THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02550000 PLACES EITHER A CHARACTOR OR A CONVERTED NUMBER WITH A 02551000 NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESS BLANKS; 02552000 PROCEDURE NEXTENT; 02553000 BEGIN LABEL DEBLANK; 02554000 COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02555000 DEBLANK: 02556000 IF EXAMIN(NCR)=" " THEN 02557000 BEGIN 02558000 RESULT:=7; SCANNER; 02559000 END; 02560000 IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02561000 BEGIN 02562000 RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02563000 IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02564000 ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02565000 END 02566000 ELSE IF EXAMIN(NCR)="%" THEN 02567000 BEGIN 02568000 READACARD; GO DEBLANK; 02569000 END 02570000 ELSE BEGIN 02571000 RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02572000 Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02573000 END 02574000 END OF NEXTENT; 02575000 %T0302579000 COMMENT THIS SECTION CONTAINS FORWARD DECLARATIONS; 03000000 PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; FORWARD; %T9203000002 PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; FORWARD; 03000005 PROCEDURE EMITC(REPEAT,OPERATOR); VALUE OPERATOR,REPEAT; %T9203000010 INTEGER REPEAT,OPERATOR; FORWARD; %T9203000015 PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; FORWARD; %T9203000020 PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; FORWARD; %T9203000025 PROCEDURE EMITPAIR(ADDRESS,OPERATOR); VALUE ADDRESS,OPERATOR; %T9203000030 INTEGER ADDRESS,OPERATOR; FORWARD; %T9203000035 PROCEDURE EMITUP; FORWARD; %T9203000040 PROCEDURE EMITLNG; FORWARD; %T9203000045 PROCEDURE EMITWORD(WORD); VALUE WORD; REAL WORD; FORWARD; %T9203000050 PROCEDURE %T9203000058 EMITDIAL(A,B); VALUE A,B; INTEGER A,B; %T9203000060 FORWARD; %T9203000062 PROCEDURE %T9203000064 EMITFC(A,B); VALUE A,B; INTEGER A,B; %T9203000066 FORWARD; %T9203000068 PROCEDURE %T9203000070 EMITFB(TYPE,LENGTH,FROM,TOWARDS); %T9203000072 VALUE TYPE,LENGTH,FROM,TOWARDS; %T9203000074 INTEGER TYPE,LENGTH,FROM,TOWARDS; %T9203000076 FORWARD; %T9203000078 PROCEDURE AEXP; FORWARD; 03001000 PROCEDURE ARITHSEC; FORWARD; 03002000 PROCEDURE SIMPARITH; FORWARD; 03003000 PROCEDURE ARITHCOMP; FORWARD; 03004000 PROCEDURE PRIMARY; FORWARD; 03005000 PROCEDURE BEXP; FORWARD; 03006000 INTEGER PROCEDURE EXPRSS; FORWARD; 03007000 INTEGER PROCEDURE BOOSEC; FORWARD; 03008000 PROCEDURE SIMPBOO; FORWARD; 03009000 PROCEDURE BOOCOMP; FORWARD; 03010000 INTEGER PROCEDURE BOOPRIM; FORWARD; 03011000 PROCEDURE RELATION; FORWARD; 03012000 INTEGER PROCEDURE IFEXP; FORWARD; 03013000 PROCEDURE PARSE; FORWARD; 03014000 PROCEDURE DOTIT; FORWARD; %D03015000 PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; FORWARD; 03016000 PROCEDURE DEXP; FORWARD; 03017000 PROCEDURE IFCLAUSE; FORWARD; 03018000 INTEGER PROCEDURE GET(SYLLABLE);VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03019000 INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; FORWARD; 03020000 PROCEDURE PANA; FORWARD; 03021000 PROCEDURE IFSTMT; FORWARD; 03022000 PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 03023000 VALUE LABELBAT,BRANCHTYPE; 03024000 REAL LABELBAT,BRANCHTYPE; FORWARD; 03025000 BOOLEAN PROCEDURE SIMPGO; FORWARD; 03026000 PROCEDURE STMT; FORWARD; 03027000 PROCEDURE EMIT(SYLLABLE); VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03028000 PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; 03029000 PROCEDURE STRMPROCSTMT; FORWARD; 03030000 BOOLEAN PROCEDURE GETINT; FORWARD; 03031000 INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); VALUE NUMBER; 03032000 INTEGER P1,P2,NUMBER; FORWARD; 03033000 PROCEDURE CONSTANTCLEAN; FORWARD; 03034000 PROCEDURE SCATTERELBAT; FORWARD; 03035000 PROCEDURE EMITB(BRANCH,FROM,TOWARDS); VALUE BRANCH,FROM,TOWARDS; 03036000 INTEGER BRANCH,FROM,TOWARDS; FORWARD; 03037000 PROCEDURE VARIABLE(FROM); REAL FROM; FORWARD; 03038000 PROCEDURE IMPFUN; FORWARD; 03039000 PROCEDURE STREAMSTMT; FORWARD; 03040000 PROCEDURE SEGMENTSTART;FORWARD; 03041000 PROCEDURE SEGMENT(SIZE,NO,NOO); 03042000 VALUE SIZE,NO,NOO; 03043000 REAL SIZE,NO,NOO; 03044000 FORWARD; 03045000 INTEGER PROCEDURE BAE; FORWARD; 03046000 REAL PROCEDURE PROGDESCBLDR(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 03047000 PROCEDURE BANA; FORWARD; 03048000 PROCEDURE EMITNUM(A); VALUE A; REAL A; FORWARD; 03049000 PROCEDURE EMITD(A,B,T); VALUE A,B,T; INTEGER A,B,T; FORWARD; 03050000 INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L; 03051000 INTEGER L; BOOLEAN S; FORWARD; 03051001 PROCEDURE FORSTMT; FORWARD; 03052000 03053000 PROCEDURE E; FORWARD; 03054000 PROCEDURE ENTRY(TYPE); VALUE TYPE;REAL TYPE; FORWARD; 03055000 PROCEDURE FORMATGEN;FORWARD; 03056000 BOOLEAN PROCEDURE EXPLICITFORMAT; FORWARD; %W4003056500 BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; %W4003056600 PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000 PROCEDURE JUMPCHKNX; FORWARD; 03058000 PROCEDURE JUMPCHKX; FORWARD; 03059000 PROCEDURE DBLSTMT; FORWARD; 03060000 PROCEDURE READSTMT; FORWARD; 03061000 INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N; FORWARD ; 03061010 PROCEDURE WRITESTMT; FORWARD; 03062000 PROCEDURE SPACESTMT; FORWARD; 03063000 PROCEDURE CLOSESTMT; FORWARD; 03064000 PROCEDURE LOCKSTMT; FORWARD; 03065000 PROCEDURE RWNDSTMT; FORWARD; 03066000 PROCEDURE BLOCK(S); VALUE S; BOOLEAN S; FORWARD; 03067000 PROCEDURE PURGE(STOPPER);VALUE STOPPER;REAL STOPPER;FORWARD; 03068000 PROCEDURE ENTER(TYPEV); 03069000 VALUE TYPEV; 03070000 INTEGER TYPEV; FORWARD; 03071000 INTEGER PROCEDURE PASSTYPE(P); VALUE P; REAL P; FORWARD; 03074000 PROCEDURE PASSALPHA(P); VALUE P; REAL P; FORWARD; 03075000 PROCEDURE LISTELEMENT; FORWARD; 03076000 REAL PROCEDURE LISTGEN; FORWARD; 03077000 PROCEDURE UNKNOWNSTMT; FORWARD; 03078000 PROCEDURE FAULTSTMT; FORWARD; 03079000 PROCEDURE FAULTDEC; FORWARD; 03080000 PROCEDURE SORTSTMT; FORWARD; 03081000 PROCEDURE MERGESTMT; FORWARD; 03082000 PROCEDURE CASESTMT(R); VALUE R; REAL R; FORWARD; %M03083000 PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000 ALPHA PROCEDURE BUGGER(S); VALUE S; INTEGER S; FORWARD; 03100000 % %A03200000 % %A03201000 % %A03202000 PROCEDURE GENLIST; FORWARD; %A03203000 PROCEDURE SYMINT; FORWARD; %A03204000 PROCEDURE CONSIT; FORWARD; %A03205000 PROCEDURE PANSYM(MARK,TWOARG); VALUE MARK,TWOARG; BOOLEAN %A03206000 MARK,TWOARG; FORWARD; %A03207000 REAL PROCEDURE SYMPRIM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03208000 REAL PROCEDURE SEXP; FORWARD; %A03209000 PROCEDURE SYMVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03210000 REAL PROCEDURE MKCHAIN(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03211000 REAL PROCEDURE GENQUOTE(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03212000 REAL PROCEDURE MKNUM(R); VALUE R; REAL R; FORWARD; %A03213000 REAL PROCEDURE RSEXP; FORWARD; %A03214000 REAL PROCEDURE PORV; FORWARD; %A03215000 REAL PROCEDURE SNORM(R); VALUE R; REAL R; FORWARD; %A03216000 PROCEDURE SDNORM(R); VALUE R; REAL R; FORWARD; %A03217000 PROCEDURE FIELDC(EL,PR,FROM); VALUE EL,PR,FROM; REAL EL,PR; %A03218000 BOOLEAN FROM; FORWARD; %A03219000 PROCEDURE RECOM(R); VALUE R; REAL R; FORWARD; %A03220000 PROCEDURE GENRECORD(R,B); VALUE R,B; REAL R; BOOLEAN B; FORWARD; %A03222000 PROCEDURE RECVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03223000 PROCEDURE REXP; FORWARD; %A03224000 REAL PROCEDURE PLXPRIM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03225000 PROCEDURE PLXNORM(R,BV); %A03226000 VALUE R,BV; %A03227000 REAL R; %A03228000 BOOLEAN BV; FORWARD; %A03229000 REAL PROCEDURE PLXINT(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03230000 REAL PROCEDURE PANPLX(V,A); VALUE V,A; BOOLEAN V,A; FORWARD; %A03231000 INTEGER PROCEDURE PLXSEC(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03232000 INTEGER PROCEDURE PLXP(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03233000 PROCEDURE DBLPLXP(TYPE); VALUE TYPE; REAL TYPE; FORWARD; %A03234000 PROCEDURE PLXPN(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03235000 PROCEDURE PANDBL(V); VALUE V; BOOLEAN V; FORWARD; %A03236000 PROCEDURE EMITCONVAL; FORWARD; %A03237000 PROCEDURE IFXP(R); VALUE R; REAL R; FORWARD; %A03238000 PROCEDURE GENEXP(R); VALUE R; REAL R; FORWARD; %A03239000 BOOLEAN PROCEDURE ARAY(TALL,WDS,ROWTOG); %A03240000 VALUE TALL,WDS,ROWTOG; %A03241000 REAL TALL,WDS; BOOLEAN ROWTOG; FORWARD; %A03242000 REAL PROCEDURE GNATI(R); VALUE R; REAL R; FORWARD; %A03243000 REAL PROCEDURE GNATA(R); VALUE R; REAL R; FORWARD; %A03244000 REAL PROCEDURE TEMP(R); VALUE R; REAL R; FORWARD; %A03245000 REAL PROCEDURE GNATP(K); VALUE K; REAL K; FORWARD; %A03246000 REAL PROCEDURE GNATR(T); VALUE T; REAL T; FORWARD; %A03247000 PROCEDURE DBLPLXVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03248000 PROCEDURE DBLPRIM; FORWARD; %A03249000 PROCEDURE DBLSEC; FORWARD; %A03250000 PROCEDURE DBLINT; FORWARD; %A03251000 PROCEDURE DBLXP; FORWARD; %A03252000 BOOLEAN PROCEDURE RECRELATION(TYPE); VALUE TYPE; REAL TYPE; %A03253000 FORWARD; %A03254000 BOOLEAN PROCEDURE DBLRELATION; FORWARD; %A03255000 BOOLEAN PROCEDURE PLXRELATION; FORWARD; %A03256000 BOOLEAN PROCEDURE DBLPLXRELATION; FORWARD; %A03257000 BOOLEAN PROCEDURE SYMRELATION(TYPE); VALUE TYPE; REAL TYPE;FORWARD; %A03258000 PROCEDURE BOOINT; FORWARD; %A03259000 PROCEDURE NVALINT; FORWARD; %A03260000 PROCEDURE STRINGSEC(FROM); VALUE FROM; REAL FROM; FORWARD; %A03261000 PROCEDURE STRINGVAR(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03262000 PROCEDURE STRINGXP(DSV,NLP); VALUE DSV,NLP; %A03263000 BOOLEAN NLP; REAL DSV; FORWARD; %A03264000 PROCEDURE PUTADR(P,R); VALUE P,R; REAL R,P; FORWARD; %A03265000 PROCEDURE DBLSTO(BV,J,OPER); VALUE BV,J,OPER; BOOLEAN BV; %A03266000 INTEGER J,OPER; FORWARD ; %A03267000 PROCEDURE SIMPDBL; FORWARD; %A03268000 INTEGER PROCEDURE SIMPLX(R,BV); VALUE R,BV; INTEGER R; BOOLEAN BV; %A03269000 FORWARD; %A03270000 PROCEDURE CHKSOB; FORWARD; %A03271000 PROCEDURE EMITDACOM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03272000 PROCEDURE FIXRECORD(R,A); VALUE R,A; REAL R,A; FORWARD; %A03273000 REAL PROCEDURE SFTERM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03274000 PROCEDURE SFEXP(TOP,FT,BL) ; VALUE TOP,FT,BL;% %A03275000 BOOLEAN TOP,FT; REAL BL; FORWARD;% %A03276000 PROCEDURE EMITNONX; FORWARD; %A03277000 PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); %A03278000 VALUE FBIT,SBIT,INDEX; BOOLEAN FBIT,SBIT; INTEGER INDEX; %A03279000 FORWARD; %A03280000 COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 04000000 ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 04001000 COMMENT EMITL EMITS A LIT CALL; 04002000 PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; 04003000 EMIT(0&LITERAL[36:38:10]); 04004000 COMMENT EMITO EMIT AN OPERATOR; 04005000 PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; 04006000 EMIT(1&OPERATOR[36:38:10]); 04007000 COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTOR MODE 04008000 OPERATORS. HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB; 04009000 PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000 INTEGER REPEAT,OPERATOR; 04011000 BEGIN 04012000 IF REPEAT}64 THEN FLAG(268); 04013000 EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000 COMMENT EMITV EMITS AN OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND 04015000 HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04016000 PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04017000 BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04018000 EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000 COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000 SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000 PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000 BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000 EMIT(3 & ADDRESS [36:38:10]) END EMITN; 04024000 COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000 ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000 EMITS PRTE; 04027000 PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000 VALUE ADDRESS,OPERATOR; 04029000 INTEGER ADDRESS,OPERATOR; 04030000 BEGIN 04031000 EMITL(ADDRESS); 04032000 IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000 EMITO(OPERATOR) END EMITPAIR; 04034000 COMMENT 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, XTOTHEI, 04041000 IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000 (APROXIMATELY 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( SEQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000 BEGIN 04131000 DI:=FEIL; 3(DS:=8LIT" "); SI:=LOC SEQ; SI:=SI+4; DS:=4 CHR; %T9304132000 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 37(DS:= 2 LIT " "); %T9304137000 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 REAL(BOOLEAN(INFO[0,255-N])EQV BOOLEAN(C)) %W0304209000 = REAL(NOT FALSE) THEN GO TO FOUND; %W0304209500 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 FINISHED:END EMITNUM ; 04225000 COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000 ARRAYS. GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000 MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000 BE FOUND SEARCH YIELDS BLANKS. 04229000 NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000 ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000 BEGIN LABEL L; 04232000 COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000 BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000 AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000 THE LENGTH OF Q IS 128. ; 04236000 INTEGER N,I ; 04237000 N ~ 64 ; 04238000 FOR I ~ 66 STEP IF Q[I] SUBLEVEL+1 THEN 04609020 BEGIN 04609030 EMIT(0); 04609040 EMITPAIR(A, STD); 04609050 END; 04609060 EMITN(A); 04609070 END CHECKDISJOINT; 04609080 PROCEDURE EMITDIAL(A,B); VALUE A,B; INTEGER A,B; %A04610000 EMIT(B~A + (B DIV 6)|512 + (B MOD 6)|64); %A04611000 % %A04612000 PROCEDURE EMITFC(A,B); VALUE A,B; INTEGER A,B; %A04613000 EMIT(B ~ A + 64|B); %A04614000 % %A04615000 PROCEDURE EMITFB(TYPE,LENGTH,FROM,TOWARDS); %A04616000 VALUE TYPE,LENGTH,FROM,TOWARDS; %A04617000 INTEGER TYPE,LENGTH,FROM,TOWARDS; %A04618000 BEGIN INTEGER TL; TL ~ L; %A04619000 L ~ FROM - 2; %A04620000 EMITNUM(ABS(TOWARDS-FROM)); %A04621000 EMIT(TYPE~ LENGTH|256 + TYPE|64 + 41); L ~ TL END; %A04622000 % %A04623000 PROCEDURE DBLTSNGL(R); VALUE R; REAL R; %A04624000 BEGIN %A04625000 DEFINE STARTBLOCK = #; 04625500 EMIT(0); EMITNUM(1.0); EMITO( ML2); EMITO(XCH); EMITO(DEL); %A04626000 IF R > 4 THEN BEGIN EMITPAIR(JUNK,STD); EMIT(0); EMITNUM(1.0); %A04627000 EMITO(ML2); EMITO(XCH); EMITO(DEL); EMITV(JUNK) END; %A04628000 END; %A04629000 % %A04630000 PROCEDURE DBLNORM; %A04631000 BEGIN EMIT(0); EMITNUM(1.0); EMITO( ML2) END; %A04632000 % %A04633000 PROCEDURE MARKDESC(N); VALUE N; REAL N; %A04634000 BEGIN DEFINE STARTBLOCK = #; 04634500 IF RECLAIMTOG THEN BEGIN %A04635000 EMIT(11); EMIT(4); EMITO(280);% %A04636000 EMITV(TABLEMARK); %A04637000 IF N ! 0 THEN BEGIN %A04638000 EMITL(ABS(N)); %A04639000 EMITO(IF N < 0 THEN SUB ELSE ADD); %A04640000 EMITPAIR(TABLEMARK,SND); %A04641000 END; %A04642000 EMITN(PTABLE); EMITO(STD); END; %A04643000 END; % 04643500 % %A04644000 PROCEDURE MARKSYMNCR(N); VALUE N; REAL N; %A04645000 BEGIN DEFINE STARTBLOCK = #; 04645500 IF RECLAIMTOG THEN BEGIN IF N ! 0 THEN BEGIN %A04646000 EMITV(TABLEMARK); EMITL(ABS(N)); %A04647000 EMITO(IF N < 0 THEN SUB ELSE ADD); %A04648000 EMITPAIR(TABLEMARK,SND) END ELSE EMITV(TABLEMARK); %A04649000 EMITN(PTABLE); EMITO(SND); END; %A04650000 END; % 04650500 % %A04651000 PROCEDURE MARKSYMDCR(N); VALUE N; REAL N; %A04652000 BEGIN DEFINE STARTBLOCK = #; 04652500 IF N ! 0 AND RECLAIMTOG THEN BEGIN %A04653000 EMITV(TABLEMARK); EMITL(ABS(N)); %A04654000 EMITO(IF N < 0 THEN SUB ELSE ADD); %A04655000 EMITPAIR(TABLEMARK,STD); END; %A04656000 END; % 04656500 % %A04657000 PROCEDURE GETCONTENTS(R,V); VALUE R,V; REAL R; BOOLEAN V; %A04658000 BEGIN INTEGER K; %A04659000 STACKCT ~ 1; %A04660000 EMITO(DUP); EMITI(0,K~39-R|15,9); EMITO(XCH); %A04661000 EMITI(0,K~33-R|15,6); EMITN(LNKA); EMITO(LOD); EMITO(XCH); %A04662000 EMITO(IF V THEN CDC ELSE COC) END; %A04663000 % %A04664000 PROCEDURE EMITERR(SG,RELAD,NO); VALUE SG,RELAD,NO ; %A04665000 INTEGER SG,RELAD,NO; %A04666000 BEGIN RELAD ~ (RELAD + 3) DIV 4; %A04667000 EMITPAIR(5,BFC); EMITO(MKS); %A04668000 EMITL(SG); EMITL(RELAD); EMITL(NO); %A04669000 EMITV(ERRPRO); END; %A04670000 % %A04671000 PROCEDURE EMITREL(X); VALUE X; REAL X; %A04672000 BEGIN REAL T; %A04673000 EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 ELSE CPLUS1); %A04674000 T ~ BUMPL; %A04675000 EMITWORD(X); %A04676000 EMITB(BFW,T,L); %A04677000 END OF EMITREL; %A04678000 % %A04679000 PROCEDURE EMITCREL(N,T); VALUE N,T; REAL T,N; %A04680000 BEGIN %A04681000 INTEGER J,TL; %A04682000 EMITWORD(N); %A04683000 TL ~ L - 4; %A04684000 L ~ T - 1; %A04685000 EMITV(J~((L-TL+3) DIV 4) + 768); %A04686000 L ~ TL + 4; %A04687000 END OF EMITCREL; %A04688000 % %A04689000 PROCEDURE EMITARRAY(ADR,S,R,SAVETOG); VALUE ADR,S,R,SAVETOG; %A04690000 REAL ADR,S,R; BOOLEAN SAVETOG; %A04691000 BEGIN %A04692000 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B04692500 NOOFARRAYS ~ NOOFARRAYS + 1; %A04693000 EMITO(MKS); %A04694000 EMITN(ADR); %A04695000 EMITL(S); %A04696000 IF R ! 0 THEN EMITL(R); %A04697000 EMITL(REAL(R!0) + 1); %A04698000 EMITL(1); %A04699000 EMITL(REAL(SAVETOG)); %A04700000 EMITV(5); %A04701000 END OF EMITARRAY; %A04702000 % %A04703000 PROCEDURE EMITATN; %A04704000 BEGIN EMITO(MKS); EMITV(ATN) END; %A04705000 % %A04706000 PROCEDURE TRPRI; %A04707000 BEGIN EMITO(MKS); EMITV(TERPRIN); END; %A04708000 % %A04709000 PROCEDURE GENSYMLINK; %A04710000 BEGIN EMITO(MKS); EMITV(GENLINK); END ; %A04711000 % %A04712000 REAL PROCEDURE GETPC(R); VALUE R; REAL R; %A04713000 GETPC ~ IF BOOLEAN (R) THEN %A04714000 EDC[R.[36:4],R.[40:7]].[30:18] ELSE %A04715000 EDC[R.[36:4],R.[40:7]].[12:18]; %A04716000 % %A04717000 PROCEDURE EMT(X); VALUE X; REAL X; %A04718000 BEGIN %A04719000 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B04719500 IF BOOLEAN(LC) THEN %A04720000 EDC[LC.[36:4],LC.[40:7]].[30:18] ~ X ELSE %A04721000 EDC[LC.[36:4],LC.[40:7]].[12:18] ~ X; %A04722000 IF LC ! 2046 THEN IF LC ~ LC + 1 = 2046 THEN BEGIN %A04723000 FLAG(603); %A04724000 ERRORTOG~ TRUE END; END OF EMT; %A04725000 % %A04726000 PROCEDURE EC(X,Y); VALUE X,Y; REAL X,Y; EMT(Y&X[36:42:6]); %A04727000 % %A04728000 PROCEDURE ECR(X,Y); VALUE X,Y; REAL X,Y; %A04729000 BEGIN %A04730000 EMT(Y&X[36:42:6] & 1 [30:42:6]); %A04731000 IF X > 63 THEN BEGIN %A04732000 FLAG(604); %A04733000 ERRORTOG~ TRUE END END OF ECR; %A04734000 % %A04735000 PROCEDURE EMD(A,B); VALUE A,B; REAL A,B; %A04736000 BEGIN EMIT(0); ECR(B,SES); %A04737000 EC(6,SFS); ECR(A,SED); EC(7,SFD); EC(1,TRS); %A04738000 END OF EMD; %A04739000 % %A04740000 PROCEDURE EJ(T); VALUE T; REAL T; %A04741000 BEGIN EMT(JMPCH & T [30:42:6]); JMPCH ~ LC END; %A04742000 % %A04743000 PROCEDURE EMITJUMP(BV); VALUE BV; BOOLEAN BV; %A04744000 BEGIN LABEL EXIT; %A04745000 REAL JF; %A04745500 REAL R,P,T; %A04746000 T ~ P ~ LC; %A04747000 WHILE JMPCH ! 0 DO BEGIN %A04748000 R ~ GETPC(LC ~ JMPCH - 1); %A04749000 JF ~ R .[30:6]; %A04750000 IF BV THEN JF ~ IF JF=JFW THEN JNS ELSE JNC; %A04751000 IF T - JMPCH > 63 THEN %A04752000 IF T - P > 63 THEN BEGIN %A04753000 FLAG(604); %A04754000 ERRORTOG ~ TRUE; GO EXIT END ELSE %A04755000 EC(T-P,JF) ELSE EC(T-JMPCH,JF); %A04756000 P ~ LC - 1; %A04757000 JMPCH ~ R.[36:12]; END; %A04758000 LC ~ T; %A04759000 EXIT: %A04760000 END OF EMITJUMP ; %A04761000 % %A04762000 PROCEDURE EMTC; %A04763000 BEGIN REAL T,R; %A04764000 LC ~ LC - 1; STK ~ STK + 1; %A04765000 IF GET(L-1) = 289 THEN BEGIN % MKS %A04765100 EMIT(0); STK ~ STK + 1 END; %A04765200 EMITO(ECM); STREAMTOG ~ TRUE; %A04766000 FOR R ~ 0 STEP 1 UNTIL LC DO BEGIN %A04767000 IF BOOLEAN((T~GETPC(R)).[35:1]) THEN %A04768000 EMIT(T & (STK - T.[36:6])[36:42:6]) ELSE EMIT(T) %A04769000 END; %A04770000 EMITC(1,0); STREAMTOG ~ FALSE; %A04771000 END OF EMTC; %A04772000 % %A04773000 PROCEDURE MKALF(EL); VALUE EL; REAL EL; %A04774000 BEGIN REAL T,R,S; %A04775000 MOVECHARACTERS(IF S~TAKE(R~EL.LINK+1).[12:6]>7 THEN S~7 ELSE S, %A04776000 INFO[R.LINKR,R.LINKC],3,T,8-S); EMITNUM(T) %A04777000 END; %A04778000 COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000 COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000 COMMENT TO HANDLE PARA DEFINES MOVE STEPI W27; %60 %W2705002000 %W2705003000 COMMENT TAKE FETCHS A WORD FROM INFO; 05004000 REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000 TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC]; 05006000 COMMENT PUT PLACES A WORD INTO INFO; 05007000 PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000 INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD; 05009000 COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPPRESS FUTURE 05010000 ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000 PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000 BEGIN 05013000 COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000 THE ERROR MESSAGE ON THE PRINTER; 05015000 STREAM PROCEDURE WRITERROR (P,C,A,E1,N,M,R,D,L); % %T1405016000 VALUE C, N,M,R,D ; % %T1405017000 BEGIN % %T1405018000 SI~P ; DI~P ; DS~8 LIT " " ; DS~14 WDS ; % %T1405019000 SI~LOC R;DI~DI-3;DS~3DEC;DI~DI+1;SI~L;DS~WDS;% %T1405019500 DI~P ; DS~13 LIT "ERROR IN COL "; SI~LOC C ; DS~2 DEC ; DS~LIT ":" ;%T1405020000 DI~DI+32 ; DI~DI+40 ; SI~L ; SI~SI-8 ; DS~WDS ; % %T1405021000 DI~L ; DI~DI-8 ; DS~WDS ; % %T1405022000 % %T1405023000 DI~E1 ; DI~DI+M ; % %T1405025000 SI ~ A; SI ~ SI + 3; D(N( IF SC=ALPHA THEN DS~CHR ELSE %T1405026000 IF SC="}" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026010 IF SC="!" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026020 IF SC="~" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026030 IF SC="{" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026040 IF SC="<" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026050 IF SC=">" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026060 DS ~ CHR); JUMP OUT TO LL1); DS~N CHR; LL1: %T1405026500 D(DS :=2LIT" #"; SI:= LOC R; DS := 3 DEC; % %T1405026900 DS ~ LIT "~"; SI ~ L; DI ~ P; DS ~ WDS; DS ~ LIT ":"); % %T1405027000 END WRITERROR; % %T1405028000 DEFINE TESTIT = IF LISTOG OR NOT(REMOTOG OR REMOTERR) THEN BEGIN#; %T1405028990 REAL R1,R2,R3,R4,R5; % %T1405029000 BOOLEAN STREAM PROCEDURE TESTBIT(B,V); VALUE V; % %T1405030000 BEGIN SI:=B; SKIP V SB; IF SB THEN TALLY := 1 ELSE BEGIN % %T1405031000 DI:=B; SKIP V DB; DS:=SET; END; TESTBIT:=TALLY; END; % TESTBIT %T1405031100 IF ERRORTOG 05032000 THEN BEGIN COMMENT DO NOTHING IF WE SUPPRESS MSSGS;05033000 SPECTOG ~ FALSE; 05034000 ERRORCOUNT ~ ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000 IF NOT LISTOG AND NOT (REMOTOG OR REMOTERR) % %T1405036000 THEN BEGIN 05037000 PRINT(LIN,FCR," ",IF LASTUSED=6 THEN FILEINX+17 05038000 ELSE IF LASTUSED=3 THEN"T"ELSE IF LASTUSED=2 OR 05038500 LASTUSED=5 THEN"R"ELSE 48); 05039000 MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039500 IF NOTPNTED THEN PERMLINE(NOHEADING) ; 05039600 WRITELINE; 05040000 END; 05041000 COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000 ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000 % %T1405043100 % %T1405043200 % %T1405043300 % %T1405043400 IF DEFINEINDEX = 0 THEN R2 ~ NCR ELSE % %T1405044000 MOVECHARACTERS(3,DEFINEARRAY[2],5,R2,5);% %T1405044050 R1 ~ R2.[33:15] - FCR ; % %T1405044100 R2 ~ R2.[30:3] ; % %T1405044200 IF R3 ~ R1 | 8 + R2 } 72 THEN R3 ~ 71 ; % %T1405044400 R5 ~ MIN (Q.[12:6],31) ; % %T1405044450 IF NOT (REMOTOG OR REMOTERR) THEN % %T1405044475 R4 ~ IF R3+R5 { 71 THEN R3 ELSE R3-R5; % %T1405044500 R3 ~ R3 + 1 ; % %T1405044550 WRITERROR (LIN,R3,ACCUM[1],LIN[R4 DIV 8 + 2],R5,R4.[45:3],ERRNUM, % %T1405044900 (REMOTOG OR REMOTERR) AND TRUE, % %T1405044950 INFO[LASTSEQROW,LASTSEQUENCE]); 05045000 % %T1405045100 % %T1405045200 % %T1405045300 % %T1405045400 IF REMOTOG OR REMOTERR THEN WRITE(REMOTE[*,9],9,LIN[*])[ENDOFITALL];%T1405045900 TESTIT WRITELINE; END; % %T1405046000 IF ERRNUM ! PERR THEN READ (ERMDF[PERR ~ ERRNUM],15,ERARA [*]); % %T1405046400 TESTIT WRITE(LINE,15,ERARA[*]); END; % %T1405046600 IF REMOTOG OR REMOTERR THEN IF NOT TESTBIT(BITS[ERRNUM DIV 48], % %T1405046650 ENTIER(ERRNUM MOD 48)) THEN WRITE(REMOTE[*,9],9,ERARA[*]) % %T1405046700 [ENDOFITALL]; % %T1405046705 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 05061000 05062000 05063000 05064000 05065000 05066000 05067000 05068000 05069000 05070000 05071000 05072000 05073000 05074000 05075000 05076000 05077000 05078000 05079000 05080000 05081000 05082000 05083000 05084000 05085000 05086000 05087000 05088000 05089000 05090000 05091000 05092000 05093000 05094000 05095000 05096000 05097000 05098000 05099000 05100000 ; IF ERRORCOUNT > ERRORMAX THEN GO ENDOFITALL; % %T9805100005 END END FLAG; 05101000 % %T1405101100 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=200THEN AKKUM~AKKUM+1024+L~0;% %0705107100 DO IF STEPI = BEGINV THEN STMT UNTIL 05108000 ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000 DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000 COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000 UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000 PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000 BEGIN 05114000 IF MODE } 2 THEN 05115000 IF GT1 ~ ELBATWORD.LVL } FRSTLEVEL THEN 05116000 IF GT1 < SUBLEVEL THEN 05117000 IF ELBATWORD.[9:2] ! 1 05118000 THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000 END CHECKER; 05120000 COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000 GIVEN THE LINK TO THE ELBAT WORD; 05122000 INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000 GIT ~ TAKE(L).INCR+L.LINK; 05124000 COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000 IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000 GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000 INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000 BEGIN 05129000 REAL A; 05130000 IF L = XTOTHEI THEN PUTADR(XTOTHEI,GNAT~140) ELSE %M05130050 IF L = POWERSOFTEN THEN PUTADR(POWERSOFTEN,GNAT~105) ELSE %A05130100 IF (A ~ TAKE(L)).CLASS = 20 AND A.[33:2] ! 0 THEN BEGIN %M05130200 IF GNAT ~ A.ADDRESS = 0 THEN BEGIN %M05130300 IF A ~ TAKE(L.LINK + A.[33:2]).[3:6] = 0 THEN %M05130400 A:=GETSPACE(TRUE,L.LINK+1); PUTADR(L,GNAT:=A) END END ELSE%M05130500 IF GNAT ~(A~TAKE(L)).ADDRESS=0 05131000 THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11],L) 05132000 END GNAT; 05133000 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 ADDRES ~ ELBAT[I].ADDRESS; 05140000 IF ELCLASS = SUPERFILEID 05141000 THEN BEGIN 05142000 BANA; EMITN(ADDRES); EMITO(LOD) END 05143000 ELSE BEGIN 05144000 IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000 STEPIT; 05146000 EMITN(ADDRES) 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 MEYERS; 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 DESC 05187500 TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510 PROCEDURE PASTOLIST; 05187520 BEGIN 05187530 INTEGER LISTADDRESS; 05187540 COMMENT PASSLIST ASSUMES I POINTING AT LIST ID; 05187550 CHECKER(ELBAT[I]); 05187560 LISTADDRESS~ELBAT[I].ADDRESS; 05187570 IF ELCLASS = SUPERLISTID 05187580 THEN BEGIN COMMENT SUBSCRIPTED LIST ID; 05187590 BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600 END 05187610 ELSE BEGIN 05187620 IF LISTADDRESS<512 OR 05187630 LISTADDRESS>1023 THEN 05187640 BEGIN EMITL(LISTADDRESS); 05187650 EMITN(10); 05187660 END 05187670 ELSE BEGIN 05187680 IF LISTADDRESS<896 THEN 05187690 EMITL(LISTADDRESS-512) 05187700 ELSE BEGIN EMITL(LISTADDRESS- 05187710 897); EMITO(LNG) 05187720 END; 05187730 EMITN(512); EMITO(INX); 05187800 END; 05187810 STEPIT; 05187820 END; 05187830 END OF PASSTOLIST; 05187840 DEFINE % %4105188000 TAKEFRST = TAKE(ELBAT[I].LINK+ELBAT[I].INCR)#; %T9305189000 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 DEFINE STREAMWORDS = % %4105230000 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. %4105236000 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 GOTTEN 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 = LFTBRKET THEN 05274000 IF STEPI = LITNO THEN 05275000 IF STEPI = COLON THEN 05276000 IF STEPI = LITNO THEN 05277000 IF STEPI = RTBRKET THEN 05278000 COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000 IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000 (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000 IF FIRST + SECOND { 48 THEN 05282000 COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000 GO TO EXIT; 05284000 ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000 DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000 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 L; 05307000 BEGIN 05308000 INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000 BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000 SI ~ W; SI ~ SI+S; SI ~ SI+S; DS ~ 2 CHR END; 05311000 GET ~ GETSYL(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 "; DI~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 NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); WRITELINE; %T9305325490 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 LABEL L3; %M05334100 REAL GSO,CONSEC; %M05334200 BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000 BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000 BOOLEAN M,Q; 05343000 INTEGER ROW,COL,GS; 05344000 COMMENT MOREWORDS =1 IF DOUBLE OR COMPLEX %M05344100 =3 IF DOUBLE COMPLEX; %M05344200 IF PERMANENT 05345000 THEN BEGIN 05346000 IF PRTIMAX+MOREWORDS>1023 THEN FLAG(148); %M05347000 SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000 OR SPRT[GS]; 05349000 PRTIMAX~(GS~PRTIMAX)+MOREWORDS+1 END %M05350000 ELSE IF MODE = 0 THEN BEGIN 05351000 Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000 M ~ MASK(COL ~ PRTI.[43:5]-35); 05353000 COL ~ COL+35; 05354000 L1: IF REAL(M AND Q) ! 0 05355000 THEN BEGIN L3: %M05356000 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 MOREWORDS!0 THEN BEGIN %M05367650 IF CONSEC=0 THEN BEGIN GSO~GS; CONSEC ~ 1; GO TO L3 END; %M05367700 IF GS-GSO! 1 THEN BEGIN CONSEC~0; GO TO L3 END; %M05367750 IF CONSEC PRTIMAX THEN PRTIMAX ~ PRTI END 05368000 ELSE BEGIN 05369000 IF STACKCTR+MOREWORDS>767 THEN FLAG(149); %M05370000 STACKCTR~(GS~STACKCTR)+MOREWORDS+1; Q ~FALSE; %M05371000 GO TO EXIT END; 05372000 L2: IF GS } 512 THEN GS ~ GS+1024; 05373000 Q ~ TRUE; 05374000 EXIT: GETSPACE ~ GS; 05375000 IF MARKSYM THEN BEGIN JUMPCHKX; EMITN(GS); %M05375100 IF NOT (PERMANENT OR SOPG) THEN BEGIN EMITO(DUP); %M05375125 EMIT(0); EMITO(XCH); EMITO(STD) END; %M05375150 IF PERMANENT THEN EMITNUM(TABLEMARKV~TABLEMARKV+1) ELSE %M05375200 BEGIN EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M05375300 EMITPAIR(TABLEMARK,SND); END; EMITN(PTABLE); %M05375400 EMITO(STD); %A05375500 IF NOT PERMANENT THEN SYMLOC ~ SYMLOC + 1 END; %A05375600 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 PARAMETER-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 BEGIN %B05389100 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05389200 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(357) ELSE 05391000 IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000 HVCHECK~TRUE; 05393000 END; %B05393500 COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000 BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000 BEGIN %B05395100 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05395200 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 END; %B05400500 COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000 BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000 BEGIN %B05402100 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05402200 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 END; %B05407500 PROCEDURE ALFP(V); VALUE V ; REAL V; %A05408000 BEGIN REAL T; %A05409000 EMITO(MKS); %A05410000 EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 %A05411000 ELSE CPLUS1); %A05412000 T ~ BUMPL; %A05413000 EMITWORD(V); %A05414000 EMITB(BFW,T,L); %A05414500 EMITV(ALFPRINT); %A05415000 END OF ALFP; %A05416000 % %A05417000 PROCEDURE ARGLIST(TALL); VALUE TALL; REAL TALL; %A05418000 BEGIN REAL N,J,S,T; INTEGER R,K; %A05419000 DEFINE FP2 = 514#; %A05419500 EMITO(MKS); %A05420000 IF N ~ TAKE(J~ GIT(TALL)) ! 0 THEN BEGIN %A05421000 R ~ 2 | N + 3; %A05422000 FOR S ~ 1 STEP 1 UNTIL N DO %A05423000 IF BOOLEAN((T~TAKE(J+S)).VO) AND %A05424000 (K ~ T.CLASS = SYMID OR %A05425000 K = REALID OR K = BOOID) THEN BEGIN %A05426000 EMITL(T.ADDRESS + R); %A05427000 EMITL(IF K = REALID THEN 0 ELSE %A05428000 IF K = BOOID THEN 2 ELSE 4) END %A05429000 ELSE BEGIN EMITL(FP2); EMITL(6); END; %A05430000 END; %A05431000 MKALF(TALL); %A05432000 EMITL(N); %A05433000 EMITV(MONPRO); %A05434000 END OF ARGLIST; %A05435000 % %A05436000 PROCEDURE CHKND; %A05437000 IF NCR = LCR THEN BEGIN %A05438000 READACARD; %A05439000 IF LIBINDEX ! 0 THEN %A05440000 IF RECOUNT = FINISHPT THEN BEGIN %A05441000 SEARCHLIB(FALSE); READACARD; %A05442000 NORELEASE ~ FALSE END END; %A05443000 % %A05444000 BOOLEAN PROCEDURE DECLCHECK; %A05445000 DECLCHECK ~ IF ELBAT[I].ADDRESS=DOUBLEV AND %A05446000 ELCLASS = DECLARATORS THEN %A05446500 TABLE(I+1)! LEFTPAREN ELSE TRUE; %A05447000 % %A05448000 REAL PROCEDURE FORAD; %A05449000 BEGIN REAL VRET; %A05450000 FORLEVEL ~ FORLEVEL + 1 + REAL(RECLAIMTOG); %A05450500 IF MODE = 0 OR MARKSYM THEN BEGIN %A05451000 IF FORAD ~ FRD[ FRLEVEL].[11:11] = 0 THEN %A05452000 FRD[FRLEVEL].[11:11] := (FORAD:=GETSPACE(TRUE,-1)) END ELSE %T9305453000 BEGIN IF FORAD ~ (VRET ~ FRD[ FRLEVEL]).[22:11] = 0 OR %A05454000 VRET.[33:15] ! SGNO THEN %A05455000 FRD[ FRLEVEL] ~ VRET & SGNO[33:33:15] & %A05456000 (FORAD := GETSPACE(FALSE,-1))[22:37:11] END; %T9305457000 END OF FORAD; %A05458000 % %A05459000 INTEGER PROCEDURE GETLIT(B); VALUE B; REAL B; %A05460000 IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %A05461000 IF GETLIT ~ C > B THEN FLAG(605); STEPIT END ELSE ERR(605); %A05462000 % %A05463000 REAL PROCEDURE GETYPE(T); VALUE T; REAL T; %A05464000 GETYPE ~ TAKE(((TAKE((T ~ T.LINK)+1).[12:6]+18) DIV 8) + T); %A05465000 % %A05466000 PROCEDURE LITF(B); VALUE B; REAL B; %A05467000 BEGIN %A05468000 REAL R; %T9005468500 SLT ~ FALSE; %A05469000 IF STEPI = LEFTPAREN THEN BEGIN %A05470000 QUOTETOG~FALSE; STEPIT; R~ACCUM[1]; %T9005471000 IF ELCLASS=LITNO AND TABLE(I+1)=RTPAREN THEN BEGIN %T9005472000 IF SL ~ ELBAT[I].ADDRESS > B OR SL = 0 THEN BEGIN %A05473000 FLAG(605); %A05474000 ERRORTOG ~ TRUE; SL ~ 1 END; %A05475000 STEPIT; STEPIT END ELSE %A05476000 BEGIN %A05477000 ACCUM[1] ~ R; %T9005477500 AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); %A05478000 SLT ~ TRUE; %A05479000 RTPARN END; %A05480000 QUOTETOG ~ TRUE; END ELSE SL ~ 1; %A05481000 END OF LITF; %A05482000 % %A05483000 BOOLEAN PROCEDURE LITP(T); INTEGER T; %A05484000 BEGIN REAL R,S; %A05485000 IF (ELCLASS = LITNO OR ELCLASS = NONLITNO %A05486000 OR ELCLASS = STRNGCON) THEN %A05487000 IF (S ~ C).[1:37] = 0 THEN %A05488000 IF LITP ~ R ~ TABLE(I+1) = COMMA OR R = RTPAREN THEN %A05489000 BEGIN T ~ S; STEPIT END ELSE C ~ S; END; %A05490000 % %A05491000 BOOLEAN PROCEDURE MAKEROW; %A05492000 IF ELCLASS < BOOARRAYID THEN STRINGVAR( TRUE) ELSE %A05493000 BEGIN VARIABLE(FL); %A05494000 MAKEROW ~ TABLE(I-2)! FACTOP END; %A05495000 % %A05496000 REAL PROCEDURE NEWP(T); VALUE T; REAL T; %A05497000 NEWP ~ IF TAKE(T.LINK+1).[2:2]=2 THEN 3 ELSE 1; %A05498000 % %A05499000 PROCEDURE NOGO; %A05500000 IF RECLAIMTOG THEN BEGIN FLAG(626); ERRORTOG ~ TRUE END; %A05501000 %A05502000 BOOLEAN PROCEDURE NOTCOMMA; %A05503000 IF NOTCOMMA ~ ELCLASS ! COMMA THEN %A05504000 ERR(606) ELSE STEPIT; %A05505000 % %A05506000 PROCEDURE PROPER(V); VALUE V; REAL V; %A05507000 BEGIN LABEL EXIT; %A05508000 % MEANING OF V: 0 - SYMBOL, 1 - RECORD, 2 - NUMBER %A05509000 IF STEPI ! LEFTPAREN THEN BEGIN %A05510000 ERR(105); GO EXIT END; %A05511000 QUOTETOG~ TRUE; %A05512000 EMITO(MKS); STEPIT; SEXPN; %A05513000 IF ELCLASS ! COMMA AND V < 2 THEN BEGIN %A05514000 ERR(606); GO EXIT END; %A05515000 IF V=0 THEN BEGIN EMITL(2); QUOTETOG ~ TRUE; %A05516000 STEPIT; SEXPN; QUOTETOG ~ FALSE END ELSE %A05517000 IF V = 1 THEN BEGIN EMIT(0); QUOTETOG ~ FALSE; %A05518000 IF STEPI ! DECLARATORS OR %A05519000 RECTYPE ~ ELBAT[I].ADDRESS < 30 THEN %A05520000 BEGIN RECTYPE ~ 0; %A05521000 ERR(608); GO EXIT END; %A05522000 EMITNUM(RECTYPE&1[32:47:1]); END ELSE %A05523000 BEGIN EMITL(1); EMITL(3); QUOTETOG ~ FALSE END; %A05524000 IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT; %A05525000 EXIT: QUOTETOG ~ FALSE; RECTYPE ~ 0; %A05526000 EMITV(PROPA); %A05527000 END OF PROPER; %A05528000 % %A05529000 PROCEDURE PUTADR(P,R); VALUE P,R; REAL R,P; %A05530000 PUT(TAKE(P)&R[16:37:11],P); %A05531000 % %A05532000 PROCEDURE RCH(R,A,BV,B,T,OP); %A05533000 VALUE R,A,BV,B,T,OP; BOOLEAN R,BV; %A05534000 REAL A,B,T,OP; %A05535000 BEGIN %B05535100 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05535200 IF R THEN BEGIN %A05536000 ECR(A,CRF); EC(0,OP); %A05537000 IF BV THEN BEGIN ECR(B,CRF); %A05538000 EC(3,BNS); EC(32,OP); %A05539000 EC(32,OP); EC(0,ENS); END END ELSE %A05540000 BEGIN %A05541000 IF B ~ T.[42:6] ! 0 THEN EC(B,OP); %A05542000 IF B ~ T.[36:6] ! 0 THEN BEGIN EC(B,BNS); EC(32,OP); EC(32,OP);%A05543000 EC(0,ENS) END %A05544000 END; %B05544500 END OF RCH; %A05545000 % %A05546000 BOOLEAN PROCEDURE ROWD(BV); VALUE BV; BOOLEAN BV; %A05547000 BEGIN IF BV THEN STEPIT; %A05548000 IF ELCLASS = RECARRAYID OR ELCLASS=SYMARRAYID THEN BEGIN %A05548100 ROWD ~ TRUE; %A05548150 ELBAT[I].CLASS ~ ELCLASS ~ REALARRAYID END ELSE %A05548200 ROWD ~ (ELCLASS} BOOARRAYID AND ELCLASS { INTARRAYID) %A05549000 OR ELCLASS= STRINGID OR ELCLASS = STRINGARRAYID END; %A05550000 % %A05551000 PROCEDURE SYMAC; %A05552000 BEGIN REAL T; %A05553000 I ~ I - 1; %A05554000 DO BEGIN %A05555000 IF STEPI = SYMID OR ELCLASS = SYMARRAYID OR %A05556000 ELCLASS = SYMPROCID THEN BEGIN %A05557000 PUT(-TAKE(T~ ELBAT[I]),T); %A05558000 PUTNBUMP(T & FACTOP [2:41:7] & (NEXTINFO-LASTINFO)[27:40:8]); %A05558100 LASTINFO ~ NEXTINFO - 1; %A05558150 STEPIT END %A05558200 ELSE ERR(406); %A05559000 END UNTIL ELCLASS ! COMMA; %A05560000 END OF SYMAC; %A05561000 % %A05562000 PROCEDURE SYMONITOR(BV,TALL,N,V); VALUE BV,TALL,N,V; %A05563000 BOOLEAN BV; REAL TALL,N,V; %A05564000 BEGIN %A05565000 % CALLS ON SYMONITOR: %A05566000 % SIMPLE VARIABLE SYMONITOR(TRUE,TALL,0,0) %A05567000 % SYMBOL PROCEDURE SYMONITOR(TRUE,TALL,0,5) %A05568000 % ARRAY SYMONITOR(FALSE,TALL,N,0) %A05569000 IF BV THEN EMITO(MKS); %A05570000 EMITV(JUNK); MKALF(TALL); %A05571000 EMITL(N); EMITL(V); %A05572000 EMITV(MONSYM); %A05573000 END OF SYMONITOR; %A05574000 % %A05575000 PROCEDURE CALLSF(R); VALUE R; REAL R; %A05586000 BEGIN REAL T,P; LABEL EXIT; %A05587000 CHECKER(R); EMITO(MKS); STEPIT; %A05587500 IF P ~ SFTRC.[15:11] ! 0 THEN BEGIN EMITV(P); %A05588000 T ~ BUMPL; EMITO(MKS); %A05589000 MKALF(R); EMIT(0); EMITV(MONPRO); %A05590000 EMITB(BFC,T,L) END; %A05590100 IF NOT BOOLEAN(R).FORMAL THEN %A05590200 IF TAKE(T~GIT(R)).[40:8]!0 THEN BEGIN %A05590300 IF ELCLASS ! LEFTPAREN THEN BEGIN ERR(128); GO EXIT END; %A05590400 ACTUALPARAPART(FALSE,FALSE,T); END; %A05590500 EMITV(R.ADDRESS); %A05591000 IF P!0 THEN BEGIN EMITV(P);T~BUMPL;EMITO(DUP);EMITI(0,46,2); %A05591500 EMITPAIR(JUNK,STD); SYMONITOR(TRUE,R,0,4); %T9305592000 EMITB(BFC,T,L) END; %A05593000 EXIT: %A05594000 END OF CALLSF; %A05595000 % %A05596000 PROCEDURE FIXCLASS(CL,AD,B); VALUE CL,AD,B; REAL CL,AD; %A05597000 BOOLEAN B; %A05598000 BEGIN REAL T;% %A05599000 IF B THEN% %A05601000 IF B.[46:1] THEN% %A05601100 IF STEPI ! LEFTPAREN THEN ERR(105) ELSE BEGIN% %A05601150 IF STEPI = FILEID THEN BEGIN% %A05601200 IF TAKE((T~ELBAT[I]).LINK+1).[2:2] = 0 THEN FLAG(662)% %A05601250 ELSE ADDRSF ~ TAKE(GIT(T)).[26:11];% %A05601300 AD ~ ADDRSF ~ IF AD = "8FREEL" THEN ADDRSF ELSE ADDRSF+1;% %A05601350 END ELSE% %A05601400 IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SYMV% %A05601450 AND AD ! "8FREEL" AND SYMSTK THEN ADDRSF ~ AD ~ LNKROW% %A05601500 ELSE BEGIN ERR(662); I ~ I - 1 END;% %A05601550 IF STEPI ! RTPAREN THEN ERR(104) END ELSE% %A05601600 IF (T ~ ACCUM[1]).[12:6] = 5 THEN% %A05601650 IF T ~ T.[18:6] = "L" THEN AD ~ LMARG ELSE %A05602000 IF T = "R" THEN AD ~ RMARG ELSE ERR(100) ELSE %A05603000 IF T.[12:6] = 6 THEN %A05604000 IF T ~ T.[18:6] = "L" THEN AD ~ LMARGI ELSE %A05605000 IF T = "R" THEN AD ~ RMARGI ELSE ERR(100) %A05606000 ELSE ERR(100); %A05607000 ELCLASS ~ CL;% %A05607500 ELBAT[I] ~ ELBAT[I] & CL[2:41:7] & AD[16:37:11] %A05608000 END OF FIXCLASS; %A05609000 % %A05610000 PROCEDURE GTLSTAT; %A05611000 BEGIN REAL R; %A05612000 IF DACOMO = 0 THEN DACOMO := GETSPACE(TRUE,-6); %T9305613000 IF DAC[9] = 0 THEN BEGIN DAC[9] := GETSPACE(TRUE,-1); %T9305614000 IF DACP.LINK = 0 THEN FLAG(653); % %T9005619000 % %T9005620000 END; %A05620500 END OF GTLSTAT; %A05621000 % %A05622000 BOOLEAN PROCEDURE BASICMATRIX; %A05623000 BEGIN REAL A,B,T; LABEL LC,LR,EXIT; BASICMATRIX ~ TRUE; %A05624000 IF TAKE(GIT(A~ELBAT[I])).[40:8] = 2 THEN BEGIN %A05625000 EMITO(MKS); EMITPAIR(A.ADDRESS,LOD); BASICMATRIX ~ FALSE; %A05626000 IF STEPI ! ASSIGNOP THEN BEGIN ERR(717); GO EXIT END; %A05627000 IF STEPI = REALARRAYID THEN BEGIN %A05628000 IF TAKE(GIT(A~ELBAT[I])).[40:8] ! 2 THEN GO LR; %A05629000 EMITPAIR(A.ADDRESS,LOD); END ELSE %A05630000 IF ELCLASS = LITNO THEN T ~ MATINV ELSE BEGIN % %A05631000 EMIT (0); % %A05631100 IF T ~ ACCUM[0] = "3ZER00" THEN B ~ 64 ELSE % %A05631200 IF T = "3CON00" THEN B ~ 68 ELSE % %A05631300 IF T = "3IDN00" THEN B ~ 72 ELSE GO LR; % %A05631400 EMIT (B); % %A05631500 EMITV (5); % %A05631600 STEPIT; % %A05631700 GO EXIT; % %A05631800 END; % %A05631900 IF STEPI < ADOP THEN BEGIN EMIT(4); EMITO(XCH); B ~ 2; %T9005632000 IF T ! 0 THEN GO LR; T ~ MATDID; GO LC END; %A05633000 IF ELCLASS = FACTOP THEN T ~ MATTRN ELSE BEGIN %A05634000 IF ELCLASS = ADOP THEN BEGIN B ~ ELBAT[I].[21:1]; %A05635000 T ~ MATDID END ELSE %A05636000 IF BOOLEAN(ELBAT[I].[20:1]) THEN T ~ MATMUL ELSE %A05637000 IF T ! MATINV THEN GO LR; %A05638000 IF STEPI = REALARRAYID AND TABLE(I+1) ! LFTBRKET THEN BEGIN %A05639000 IF TAKE(GIT(A~ELBAT[I])).[40:8] ! 2 THEN GO LR; %A05640000 EMITPAIR(A.ADDRESS,LOD) END ELSE %A05641000 IF T = MATMUL THEN BEGIN PRIMARY; T ~ MATDID; B ~ 2; %A05642000 EMITO(XCH); GO LC END ELSE GO LR END; %A05643000 STEPIT; %A05644000 LC: IF T = MATDID THEN EMITL(B); EMITV(GNAT(T)); %A05645000 GO EXIT; %A05646000 LR: ERR(725) END; %A05647000 EXIT: END OF BASICMATRIX; %A05648000 % %A05649000 COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000 COMMENT AEXP IS THE ARITHMETIC EXPRESSION ROUTINE; 06001000 PROCEDURE AEXP; 06002000 BEGIN 06003000 IF ELCLASS=CROSSHATCH THEN BEGIN %W5206003200 STEPIT; SIMPARITH END ELSE %W5206003400 IF ELCLASS=CASEV THEN CASESTMT(7) ELSE %M06003500 IF ELCLASS = IFV 06004000 THEN IFXP(ATYPE) %M06005000 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 ARITHCOMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000 PROCEDURE SIMPARITH; 06032000 BEGIN 06033000 WHILE ELCLASS = AMPERSAND 06034000 DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000 WHILE ELCLASS}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; %A 06053500 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; 06059000 REAL R; DEFINE PUT = PUTADR#; %M06059500 LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000 L11,L12,L13,L14,L15,L16,L17,L20,L21,L22,L23,L24,L25,L26, %M06060025 L27,L30,L31,L32,L33,L34,L35,L36,RP,L37, %M06060050 MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100 SWITCH S ~ ABS, SIGN, ENTIER, TIME, STATUS,% 06061000 MAXANDMIN,MAXANDMIN,DELAY,L11,L12,L13,L14,L15,L16,L17,L20, %M06061100 L21,L22,L23,L24,L25,L26,L27,L30,L31,L32,L33,L34,L35,L36,L37; %M06061150 DEFINE MAXV = 6#;% 06061200 GO TO S[ELBAT[I].[27:6]];% 06062000 OTHERS: T1 ~ ELBAT[I]; 06063000 EMITO(MKS); 06064000 PANA; 06065000 IF R ~ T1.ADDRESS = 0 THEN BEGIN %M06065100 IF R:=TAKE(T1.LINK+T1.[33:2]).[3:6] = 0 THEN %T9306065200 R := GETSPACE(TRUE,T1.LINK+1); %T9306065250 PUTADR(T1,R) END; %M06065300 EMITV(R); GO TO EXIT; %M06066000 ABS: IF STEPI! LEFTPAREN THEN BEGIN ERR(105);GO EXIT END ELSE STEPIT; %M06067000 T1 ~L; EMITO(NOP); IF PLXP(FALSE) <4 THEN EMITO(SSP) ELSE %M06067100 BEGIN R ~ L; L ~ T1; EMITO(MKS); L ~ R; EMITV(GNATP(8)); %M06067200 END; GO RP; %M06067300 SIGN: PANA; 06068000 EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000 EMITD(1,1,1); GO TO EXIT; 06070000 L11: IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %M06070010 EMITO(MKS); PLXPN(FALSE); EMITV(36); PUTADR(551,36); %M06070020 PUTADR(429,31); %M06070030 RP: IF ELCLASS! RTPAREN THEN ERR(104) ELSE STEPIT; GO EXIT; %M06070040 L12: EMITO(MKS); PANA; EMITV(26); FORTERR; PUT(554,26); PUT(452,25); %A06070050 GO TO EXIT; % %A06070055 L13: EMITO(MKS); PANA; EMITV(32); PUT(561,32); PUT(449,28); %A06070060 FORTERR; GO TO EXIT; % %A06070065 L14: EMITO(MKS);PANA; EMITV(GNAT(564));PUT(558,30); %M06070070 GO EXIT; %M06070080 L15: EMITO(MKS);PANA;FORTERR;PUT(554,26);EMITV(GNAT(567));GO EXIT; %A06070090 L16: T1 ~ ELBAT[I]; EMITO(MKS); PANA; PUT(440,27); %M06070100 FORTERR; %A06070105 EMITV(GNAT(T1)); GO EXIT; %M06070110 L17: EMITO(MKS);PANA;FORTERR;PUT(443,29);EMITV(GNAT(583));GO EXIT; %A06070120 L20: PANDBL(TRUE); EMITV(GNATP(6)); EMITO(DEL); EMITV(JUNK); %M06070130 GO EXIT; %M06070140 L21: IF R ~ PANPLX(FALSE,FALSE) < 4 THEN %M06070150 IF BOOLEAN(R) THEN BEGIN %M06070160 IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END %M06070170 ELSE BEGIN EMITO(DEL); EMIT(0) END ELSE %M06070180 IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(XCH); %M06070190 EMITO(DEL); IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END %M06070200 ELSE BEGIN EMITO(DEL); %M06070210 IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END; GO EXIT; %M06070220 L22: IF R ~ PANPLX(FALSE,FALSE) < 4 THEN %M06070230 IF BOOLEAN(R) THEN BEGIN EMITO(DEL); EMIT(0) END ELSE %M06070240 BEGIN IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %M06070250 IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(DEL); %M06070260 IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END ELSE %M06070270 BEGIN EMITO(XCH); EMITO(DEL); %M06070280 IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END; GO EXIT; %M06070290 L23: PANDBL(FALSE); EMITO(XCH); EMITO(DEL); GO EXIT; %M06070300 L24: PANDBL(FALSE); EMITO(DEL); GO EXIT; %M06070310 L25: FIXCLASS(INTID,TABR,FALSE); %A06070320 VARIABLE(FP); GO EXIT; %A06070325 L26: FIXCLASS(INTID,COLR,FALSE); %A06070330 VARIABLE(FP); GO EXIT; %A06070335 L27: FIXCLASS(REALID,INREAL,FALSE); VARIABLE(FP); GO EXIT; %A06070340 L30: EMITO(MKS); EMITN(JUNK); EMITV(STRI); %M06070350 EMITO(PRTE); EMITO(LOD); EMITV(FILPROI); EMITO(PRTE); %M06070355 EMITO(LOD); EMITV(SCANR); STEPIT; GO EXIT; %M06070357 L31: IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %M06070360 EMITO(MKS); STEPIT; %M06070365 EMITPAIR(GNAT(POWERSOFTEN),LOD); BEXP; EMITV(READCON); %M06070370 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); GO EXIT; %M06070380 L32: IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A06070390 QUOTETOG ~ TRUE; IF STEPI = STRTRNS AND ELBAT[I].INCR } 8 THEN %M06070400 BEGIN %M06070405 EMITV(IF BOOLEAN(ELBAT[I].[34:1]) THEN COUNTI ELSE NSTR); %M06070410 STEPIT END ELSE %M06070420 IF (ELCLASS = STRINGID OR ELCLASS=STRINGARRAYID) %M06070425 AND BOOLEAN(ELBAT[I].FORMAL) THEN BEGIN %M06070430 EMITV(ELBAT[I].ADDRESS - REAL(ELCLASS=STRINGID AND %M06070435 NOT BOOLEAN(ELBAT[I].VO))-1); STEPIT END ELSE %A06070436 BEGIN EMITO(MKS); SEXPN; EMITV(LENGTHV) END; %M06070437 QUOTETOG ~ FALSE; IF ELCLASS! RTPAREN THEN ERR(104) ELSE STEPIT; %M06070438 GO EXIT; %M06070440 L33: PROPER(2); GO EXIT; %M06070450 L34: PANSYM(FALSE,FALSE); QUOTETOG~FALSE; GO EXIT; %M06070460 L35: IF STEPI!LEFTPAREN THEN %M06070470 BEGIN ERR(105); GO EXIT END; %M06070472 QUOTETOG~TRUE; STEPIT; GETCONTENTS(SNORM(SEXP),FALSE); %M06070474 QUOTETOG~FALSE; IF ELCLASS=RTPAREN THEN %M06070476 STEPIT ELSE ERR(104); GO EXIT; %M06070478 L36: EMITCONVAL; GO EXIT; %M06070480 L37: EMITO(MKS); IF STEPI = LEFTPAREN THEN BEGIN STEPIT; %A06070490 IF Q ~ ACCUM[1] = "3TWX00" THEN EMITL(5) ELSE %A06070510 IF Q = "4TWXA0" THEN EMITL(10) ELSE FLAG(665); %A06070520 IF STEPI! RTPAREN THEN ERR(104) ELSE STEPIT END ELSE EMIT(0); %A06070530 EMIT(0); EMITV(READN); GO EXIT; %A06070540 ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000 EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000 MAXANDMIN:% 06072010 T1 ~ ELBAT[I].[27:6];% 06072020 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 T1=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;% 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 IF DACP ! 0 THEN %A06073200 IF DAC[10]!0 THEN BEGIN EMITV(DAC[10]); GO EXIT END; %A06073210 ERR(105); GO EXIT END; %A06073220 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 REAL R; DEFINE V = IF ARRAYFLAG THEN CHECKBOUNDLVL#; %M06080500 LABEL 06081000 LSTR,LSYM,LDP,LE, LF, %M06081500 LTR, %M06081600 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 SF ~ LE,LE,LSTR,LDP,LSYM,LE,LE,LF,LF,LF; %M06084500 SWITCH S ~ 06085000 LSYM,LE,LE, %A06085500 L11,LSYM,LTR,LSTR,LDP,LSYM,LE,L13,L14,L15,L16,LSTR,LDP,LSYM, %M06086000 LE,L17,L18,L19,L20,LSTR,LDP,LSYM,LE,L21,L22,L23,L24,LSTR, %M06087000 LDP,LSYM,LE,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34,LE,LE, %M06088000 LSYM,L35,LSYM; %M06088500 COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000 INTEGER SL; %W5206089500 LABEL EXIT,RP,LDOT,LAMPER; 06090000 IF ELCLASS=FIELDID THEN BEGIN %M06090100 IF R ~ ELBAT[I].ADDRESS > 10 THEN GO LE; %M06090200 GO TO SF[R] END; %M06090300 GO TO S[ELCLASS-16]; %A06091000 IF ELCLASS=RELOP THEN BEGIN QUOTETOG ~ TRUE; STEPIT; %A06091100 EMITNUM(SFTERM(FALSE)); GO TO LAMPER END; %A06091150 IF ELCLASS=FACTOP THEN %W5206091200 IF LINKTOG THEN % LAST SYLLABLE IS NOT A LINK %W5206091300 IF (SL~GET(L-1)).[46:2]=3 OR SL=673 THEN BEGIN %LOOK FOR DESC OR CDC%W5206091400 ELBAT[I].CLASS~ELCLASS~CROSSHATCH; STEPIT; %W5206091500 EMITO(DUP); EMITO(LOD); GO EXIT END; %W5206091600 %T9206092000 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005 BEGIN 06092010 IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015 GO TO LAMPER ; 06092020 END ; 06092025 IF ELCLASS = UNKNOWNID THEN %T9206092099 IF (R ~ ACCUM[1]).[24:24] = "MARG" THEN BEGIN% %A06092100 FIXCLASS(INTID,0,TRUE); VARIABLE(FP); GO TO LDOT END %A06092200 ELSE IF R = "4JUNK0" THEN BEGIN STEPIT; EMITV(JUNK);GO LDOT END %T2906092201 ELSE IF R = "#LINEN" THEN BEGIN C~CARDNUMBER;GO L33 END %T9306092205 ELSE IF R = "3TEN00" THEN BEGIN BANA; EMITPAIR(JUNK,ISN); %T9306092210 EMITV(GNAT(POWERSOFTEN)) %T9306092213 ; GO LDOT; % %A06092215 END ELSE %T9206092220 IF R = "6SERIA" OR R = "7CANTU" THEN %T9206092222 BEGIN C ~ 0; GO L33; END ELSE %T9206092224 IF R = "6UPDAT" THEN BEGIN C~2; GO L33; END ELSE %T9206092226 IF R = "6RANDO" THEN BEGIN C ~1;GO L33; END ELSE %T9206092228 IF R = "2IO000" THEN BEGIN C~3; GO L33; END %T9206092230 ELSE IF R = "6SEARC" THEN BEGIN STRINGSEC(9); GO LDOT END 06092250 ELSE IF R = "8FREEL" OR R = "7NEXTA" THEN BEGIN% %A06092300 FIXCLASS (INTID,R,BOOLEAN(3)); VARIABLE(FP);% %A06092400 GO LDOT END ELSE ERR (100);% %A06092450 LTR: IF R ~ ACCUM[1] = "5INPUT" OR R = "6OUTPU" THEN %T9206092500 BEGIN C ~ 1 + REAL(R = "6OUTPU"); GO L33; END; %T9206092550 LE: %T9206092600 L12: L13: L17: L21: L25: L29: L30: 06093000 COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000 ERR(103); GO TO EXIT; 06095000 LDP: IF TAKE(ELBAT[I].LINK+1).[2:2] =0 THEN BEGIN V; %M06095100 DBLPRIM; DBLTSNGL(0); GO TO LDOT END; GO LE; %M06095150 LSTR: STRINGSEC(5); GO TO LDOT; %M06095200 LSYM: IF GT1 ~ SYMPRIM(TRUE) = 5 THEN GO LE ELSE %M06095250 IF GT1 = 4 THEN EMITNUM(SAVEQ) ELSE %M06095300 IF GT1 < 3 THEN BEGIN SDNORM(GT1); EMITO(MKS); EMITV(ATN); %M06095350 END; QUOTETOG ~ FALSE; GO TO LDOT; %M06095550 LF: V; FIELDC(ELBAT[I],0,FALSE); GO TO LAMPER; %M06095600 L11: 06096000 COMMENT INTRINSIC FUNCTIONS; 06097000 IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A 06098000 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 = INTV THEN BEGIN PANA; %M06116100 EMITPAIR(JUNK,ISN); GO TO LDOT END; %M06116200 IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000 IF STEPI ! LEFTPAREN 06118000 THEN BEGIN ERR(105); GO TO EXIT END; 06119000 IF STEPI = STRINGPROCID OR ELCLASS = STRINGID OR %M06120000 (ELCLASS = STRTRNS AND ELBAT[I].INCR } 8) OR %A06120050 (ELCLASS=FIELDID AND ELBAT[I].ADDRESS=STRINGV) OR %A06120070 (ELCLASS } BOOARRAYID AND ELCLASS { INTARRAYID %T9006120080 AND TABLE(I+1) ! LFTBRKET) OR %T9106120090 ELCLASS = STRINGARRAYID THEN STRINGSEC(6) ELSE %A06120100 IF ELCLASS = RECID THEN BEGIN RECVAR(FALSE);% %A06120110 RECTYPE ~ 0 END ELSE BEXP;% %A06120120 GO TO RP END; %M06120200 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 ELCLASS= CASEV THEN CASESTMT(3) ELSE %M06133000 IF ELCLASS= IFV THEN IFXP(BTYPE) ELSE %M06133250 IF EXPRSS! BTYPE THEN ERR(107); %M06133500 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 IF ELCLASS=CROSSHATCH THEN GT4~BOOSEC~BTYPE ELSE %W5206152500 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 EMIT(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 LSFP,LE,LSFM, %A06215100 LR1,LR2,LR3,LR4,LR5, %M06215250 LFIELD,LSTR,LDP,LDBL,LPLX,LDPX,LSYM,LREC,LBTRN,LBF,LR, %M06215500 BAS,LAS, % %T9106215750 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,L12,LFIELD,LSTR,LDBL,LSYM,LREC,LBTRN,L11,LSYM,LE,LSTR, %M06220000 LDP,LSFP,LSFM,L13,L14,L15,L16,LSTR,LDP,LSYM,LREC,L17,L18, %A06221000 % %M06222000 L19,L20,LSTR,LDP,LSYM,LREC,L21,L22,L23,L24,LSTR,LDP,LSYM, %M06222100 LREC,L25,LAS,LAS,LAS,L29,L30,L31,L32,L33,L34,LR,LSYM,LSYM, %T9106222200 L35,LSYM; %M06222300 SWITCH SF ~ LPLX,LDPX,LSTR,LDBL,LSYM,LREC,LBF,L33,L33,L33; %M06222400 DEFINE V = IF ARRAYFLAG THEN CHECKBOUNDLVL#; REAL R; %M06222500 COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000 LABEL EXIT,D,TD,T; %M06224000 LABEL FAH ; 06224500 GO TO S[ELCLASS-SUPERFILEID]; 06225000 IF ELCLASS = ADOP THEN GO TO L11; 06226000 IF ELCLASS = COLON THEN %M06226500 IF DPTOG THEN GO TO LDPX ELSE GO TO LPLX; %M06226600 IF ELCLASS = UNKNOWNID THEN %A06227000 IF ACCUM[1].[24:24] = "MARG" THEN BEGIN %A06227100 FIXCLASS(INTID,0,TRUE); GO L33 END ELSE %A06227200 IF ACCUM[1] = "6TWXNU" THEN BEGIN STEPIT; EMITO(MKS); %A06227210 EMITL(15); EMIT(0); EMITV(READN); GO TD END ELSE %A06227220 IF ACCUM[1] = "5SEARC" THEN GO L33 ELSE ERR(100); %A06227300 IF ELCLASS = RELOP THEN GO L33; %A06227400 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= SYMV OR GT1 = LISTV THEN GO TO LSYM; %M06233100 IF GT1= INTV THEN GO L33; %M06233200 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 IF DPTOG THEN GO TO LDBL; %M06237500 AEXP; 06238000 D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000 RELATION; 06240000 BOOPRIM ~ BTYPE; GO TO EXIT; 06241000 LFIELD: IF TYPE ~ ELBAT[I].ADDRESS > 29 THEN GO LREC; %M06241010 GO TO SF[TYPE]; %M06241020 COMMENT CHECK TO SEE IF AN ARRAY IS BEING USED IN STRING SYNTAX;%T9106241024 LAS: IF TABLE(I+1) ! LFTBRKET THEN GO BAS ELSE GO L26; % %T9106241025 LSTR: IF ELCLASS=STRTRNS AND ELBAT[I].INCR = 1 THEN BEGIN %A06241030 EMITI(0,33-15|PORV,15); QUOTETOG ~ FALSE; %A06241035 EMITO(DUP); EMITL(64); EMITO(LSS); TYPE ~ BUMPL; %A06241037 GETCONTENTS(0,FALSE); EMITI(0,18,15); EMITPAIR(2,BFW); %A06241040 EMITB(BFC,TYPE,L); EMITO(DEL); EMITL(1); END ELSE %A06241042 BAS: STRINGSEC(7); BOOPRIM ~ BTYPE; GO TD; % %T9106241044 LBTRN: BOOINT; BOOPRIM ~ BTYPE; GO TO TD; %M06241050 LR: IF QUOTETOG THEN GO TO LSYM ELSE GO TO LREC; %M06241060 LDP: IF TYPE ~ TAKE(ELBAT[I].LINK+1).[2:2] = 0 THEN GO LDBL ELSE %M06241070 IF TYPE=1 THEN GO LPLX ELSE GO LDPX; %M06241080 LBF: V; FIELDC(ELBAT[I],0,FALSE); BOOPRIM ~ BTYPE; GO TO T; %M06241090 LREC: REXP; LR1: TYPE ~ BOOPRIM ~ RECTYPE; RECTYPE~0; %M06241100 IF RECRELATION(TYPE) THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241110 LDBL: DPTOG ~ TRUE; DBLXP; DPTOG ~ FALSE; %M06241140 LR3: BOOPRIM~ 6; %M06241145 IF DBLRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241150 LPLX: IF DPTOG THEN GO TO LDPX; PLXNORM(PLXP(FALSE),FALSE); %NEW %M06241250 LR4: BOOPRIM ~ 7; %M06241255 IF PLXRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241260 LDPX: DPTOG ~ TRUE; PLXNORM(PLXP(TRUE),TRUE); DPTOG ~ FALSE; %M06241330 LR5: BOOPRIM~ 8; %M06241340 IF DBLPLXRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241350 LSYM: QUOTETOG ~ TRUE; TYPE ~ SEXP; %M06241440 LR2: BOOPRIM~ 5; %M06241450 IF SYMRELATION(TYPE) THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241460 LSFM: LSFP: CALLSF(ELBAT[I]); GO TO TD; %A06241500 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 BOOLEAN CONSTANT; %W0306255000 IF TYPE ~ 0&ELBAT[I][44:25:2]>7 THEN EMITNUM(C) %W0306255500 ELSE EMIT(TYPE); STEPIT; GO TO T; %W0306256000 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 IF TYPE > 29 THEN GO TO LR1; %M06262050 IF TYPE > 4 THEN %M06262100 CASE TYPE-5 OF BEGIN %M06262200 BEGIN SYMSEC ~ TRUE; TYPE ~ SEXP; %M06262300 GO TO LR2 END; %M06262400 BEGIN SIMPDBL; GO TO LR3 END; %T9206262500 BEGIN PLXNORM(SIMPLX(12,FALSE),FALSE); GO TO LR4 END; %M06262600 BEGIN PLXNORM(SIMPLX(12,TRUE),TRUE); GO TO LR5; END; END; %M06262700 FAH: %T9206262800 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 INTEGER OPERATOR; 06282000 BOOLEAN MULTIPLE; LABEL DOITAGAIN; %W5306282100 DOITAGAIN: %W5306282900 OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06283000 COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06284000 ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06285000 OF THE ELBAT WORD; 06286000 STEPIT; AEXP; %W5306287000 IF ELCLASS=RELOP THEN BEGIN %W5306287100 EMITPAIR(JUNK,SND); EMIT (OPERATOR); %W5306287200 IF MULTIPLE THEN EMITO(LND); EMITV(JUNK); %W5306287300 MULTIPLE ~ TRUE; GO DOITAGAIN; %W5306287400 END; %W5306287500 EMIT (OPERATOR); %W5306287600 IF MULTIPLE THEN EMITO(LND); %W5306287700 STACKCT ~ 1; %W5306287900 EMIT(REAL(MULTIPLE)); L~L-1; %W5306288000 COMMENT THE LAST LINE IS PREPARATORY. EMITLNG USES THIS TO IMPROVE06289000 CODE LATER; 06290000 END RELATION; 06291000 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,THENBRANCH,L); 06301000 IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000 GENEXP(TYPE); %M06303000 % REMOVED %M06304000 % REMOVED %M06305000 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 ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000 IF STEPI ! LITNO THEN GO TO L1; 06314500 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; %D06338000 BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000 % %D06340000 IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06341000 %A 06342000 EMITI(0,FIRST,SECOND); %A 06343000 %A 06344000 STEPIT; 06345000 EXIT: END DOTIT; %D06346000 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 EMITL(TLEVEL) END 06369000 ELSE BEGIN 06370000 EMITN(512); 06371000 EMITV(513); COMMENT 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 X; %W2706501000 STREAMTOG~FALSE; 06502000 EMITO(MKS); PASSFILE; 06503000 IF ELCLASS!WITHV THEN 06504000 BEGIN ERR(301); GO TO EXIT END; 06505000 FOR X~1 STEP 1 UNTIL 6 DO %W2706506000 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 X:=X STEP 1 UNTIL 5 DO %W2706512000 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 STEPIT; 07010000 IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000 IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000 IF ELCLASS ! ENDV 07013000 THEN BEGIN 07014000 ERR(119); GO TO ANOTHER END; 07015000 ENDTOG~TRUE; 07016000 DO STOPDEFINE~TRUE UNTIL 07017000 STEPI{ENDV AND ELCLASS}UNTILV 07018000 OR NOT ENDTOG; 07019000 ENDTOG~FALSE; 07020000 IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000 THEN BEGIN 07022000 IF BEGINCTR = 0 THEN 07023000 BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000 FLAG(120) END; 07025000 IF ELCLASS = PERIOD THEN 07026000 BEGIN 07027000 GT5 ~ "ND;END."&"E"[1:43:5]; 07028000 MOVE(1,GT5,CARD(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 INTEGER STYPE; LABEL LCH; BOOLEAN PART; LABEL M; %M07050500 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 THE 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 BOOLEAN DPTOGO,QUOTETOGO; REAL T7; %M07059500 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 BOOLEAN PROCEDURE COMPCLASS(ACLASS,SCLASS,T,WHOLE); %M07064100 VALUE ACLASS,SCLASS,T,WHOLE; %M07064150 REAL ACLASS,SCLASS,T,WHOLE; %M07064200 IF ACLASS=SCLASS THEN BEGIN %M07064250 IF SCLASS= RECID THEN BEGIN %M07064300 IF COMPCLASS ~ (T.[27:5]+30)! GETYPE(WHOLE) THEN %M07064400 FLAG(123) END ELSE %M07064500 IF SCLASS= DBLPLXID THEN BEGIN %M07064600 IF COMPCLASS ~ T.[27:5] ! TAKE( WHOLE .LINK+1).[2:2] %M07064700 THEN FLAG(123) END END ELSE %M07064800 IF COMPCLASS ~ SCLASS!LOCLID OR ACLASS < SYMID THEN FLAG(123); %M07064900 LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000 LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000 LFB, %M07066500 CERR,FGEN; 07067000 LABEL 07068000 A6,AER,A15,A21,A31,A32,A33,A34,A40,A41,A42,A47,A48,A49,A50, %M07068100 A61,A63, %M07068200 A25, %A07068300 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,A6,L5,L6,L7,L8,L9,L10,L12,AER,A15,AER,AER,AER,AER,L11, %M07073000 A21,AER,L12,L12,A25,L12,L13,L14,L15,L16,A31,A32,A33,A34,L17, %A07074000 L18,L19,L20,AER,A40,A41,A42,L21,L22,L23,L24,A47,A48,A49,A50, %M07075000 L25,L26,L27,L28,L29,L30,L31,L32,L33,AER,A61,AER,A63; %M07075500 REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000 TO REDUCING TOTAL NUMBER; 07077000 PCTR ~ 1; 07078000 DPTOGO ~ DPTOG; QUOTETOGO ~ QUOTETOG; DPTOG ~ QUOTETOG ~ FALSE; %M07078500 ANOTHER: DPTOG ~ QUOTETOG ~ FALSE; %M07079000 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)).VO; 07086000 T7 ~ GT1; %M07086500 IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000 SCLASS } STRINGSTRPROCID %M07088000 THEN BEGIN IF GT1 ~ (SCLASS-STRINGSTRPROCID).[45:3]}5 %M07089000 THEN SCLASS ~ SCLASS - GT1 + 5; %M07090000 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 % DELETE %M07094000 IF GT1 {2 THEN IF BOOLEAN(GT1) THEN DPTOG ~ T7.[27:5]!1 ELSE %M07094100 QUOTETOG ~ TRUE; %M07094150 END; %M07094155 IF SBIT THEN IF ACLASS~TABLE(I+1)=39 OR ACLASS=47 THEN BEGIN %M07094160 STEPIT; %M07094165 STRINGSEC(IF VBIT THEN 8 ELSE 1); %M07094170 IF VBIT THEN EMITO(DEL) ELSE BEGIN IF SPT THEN EMITO(DEL); %M07094180 IF SLT THEN EMITO(DEL) END; GO BS END ELSE %A07094190 IF VBIT THEN BEGIN STEPIT; GO VE END; %A07094195 IF VBIT THEN IF SCLASS}STRINGID AND SCLASS{REALID THEN BEGIN %M07094200 STEPIT; CASE SCLASS-STRINGID OF BEGIN %M07094250 STRINGSEC(8); %M07094300 IF T7.[27:5]=0 THEN DBLXP ELSE PLXNORM(PLXP(DPTOG),DPTOG); %M07094350 BEGIN SEXPN; IF RECLAIMTOG THEN BEGIN %M07094380 EMIT(11); EMIT(4); EMITO(280); % MAKE DESC %M07094400 EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M07094410 EMITPAIR(TABLEMARK,SND); EMITN(PTABLE); EMITO(SND) END; %M07094430 END; %M07094440 RECOM(T7.[27:5]+30); BEXP; AEXP; END; %M07094450 GO TO COMMON END; %M07094460 % %A07094465 IF SCLASS=STRINGID THEN BEGIN %M07094470 STEPIT; %M07094471 STRINGSEC(1); %M07094472 IF SPT THEN BEGIN IF NOT SLT THEN EMITNUM(SL) END ELSE %M07094474 BEGIN EMITNUM(SP); IF SLT THEN EMITO(XCH) ELSE %M07094476 EMITNUM(SL) END; GO TO COMMON END; %M07094480 END; %M07094525 IF SCLASS=FRMTID THEN IF EXPLICITFORMAT THEN %W4007094560 BEGIN STEPIT; GO TO COMMON END; %W4007094570 ACLASS~STEPI; WHOLE~ELBAT[I];SCATTERELBAT; %W4007094580 IF SCLASS=LISTID THEN BEGIN LISTPARA;GO TO COMMON END; %W3307094700 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 THEN %M07099000 CHECKER(WHOLE); 07099500 IF ACLASS < STRINGARRAYID OR ACLASS > INTARRAYID %M07100000 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 EMITN(WHOLE.ADDRESS); 07122510 EMITO(LOD); 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 BEGIN VE: ACLASS~ IF T1 ~EXPRSS = ATYPE THEN REALID ELSE %M07125000 IF T1 = BTYPE THEN BOOID ELSE IF T1 = DTYPE THEN %M07125100 LABELID ELSE IF T1=5 THEN SYMID ELSE 0; %M07125200 IF ACLASS=0 THEN GO AER; %M07125300 GO TO BS END %M07125400 ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000 IF FBIT THEN BEGIN %M07126100 IF(ACLASS} STRINGSTRPROCID AND ACLASS{INTARRAYID %M07126200 AND (ACLASS-STRINGSTRPROCID).[45:3]<4) OR ACLASS=COLON %M07126300 THEN GO TO LFB END; %M07126400 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 IF SCLASS = LABELID THEN BEGIN DEXP; ACLASS~ LABELID END ELSE %M07133000 IF FBIT THEN BEGIN IF EXPRSS>5 THEN GO AER END ELSE %M07133050 IF SCLASS} DBLPLXID AND SCLASS { REALID THEN BEGIN %M07133100 CASE SCLASS-DBLPLXID OF BEGIN %M07133200 BEGIN I~I-1; DBLPLXP( T7.[27:5]) END; %M07133300 SEXPN; %M07133400 RECOM(T7.[27:5]+30); %M07133500 BEXP; AEXP; END; END ELSE GO TO AER; %M07133600 STORE: IF SCLASS= DBLPLXID THEN BEGIN %M07134000 T7 ~ IF T7.[27:5]=2 THEN 4 ELSE 2; %M07134100 FOR STYPE ~T7 STEP -1 UNTIL 1 DO EMITPAIR(TEMP(STYPE),STD); %M07134200 EMITN(TEMP(1)) END ELSE %M07134300 BEGIN EMITPAIR(JUNK,STD); EMITN(JUNK) END; %M07134400 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 % REMOVE %M07145000 GO TO COMMON %M07146000 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 } STRINGARRAYID THEN %M07150000 IF SCLASS { INTARRAYID THEN 07151000 BEGIN T2 ~ TAKE(INDEX+PCTR).[32:3]; %M07152000 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; %M07155000 IF ACLASS = SCLASS THEN BEGIN %M07155100 IF SCLASS= RECARRAYID THEN BEGIN %M07155200 IF T7.[27:5]+30!GETYPE(ELBAT[I]) THEN BEGIN FLAG(123); %M07155300 ERRORTOG ~ TRUE END END ELSE %M07155400 IF SCLASS = DBLPLXARRAYID THEN BEGIN %M07155500 IF TAKE(ELBAT[I].LINK+1).[2:2]!T7.[27:5] THEN BEGIN %M07155600 FLAG(123); ERRORTOG ~ TRUE END END END ELSE %M07155700 BEGIN ERR(123); GO TO EXIT END; %M07155800 COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000 IF SCLASS < BOOARRAYID THEN BEGIN %M07157000 IF SCLASS = DBLPLXARRAYID THEN BEGIN %M07157100 IF NOT ARAY(ELBAT[I],IF T7.[27:5]=2 THEN 4 ELSE 2,BOOLEAN(5)) %M07157200 THEN BEGIN ERR(123); GO TO EXIT END END ELSE %M07157300 IF NOT ARAY(ELBAT[I],0,BOOLEAN(REAL(SCLASS=STRINGARRAYID)|2+5)) %M07157400 THEN BEGIN ERR(123); GO TO EXIT END END ELSE %M07157500 BEGIN VARIABLE(FA); IF TABLE(I-2) ! FACTOP THEN %M07157600 BEGIN ERR(123); GO EXIT END; END; %M07158000 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 ; GO TO COMMON END; %M07167000 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 THEN %M07171000 IF ACLASSREALID OR SCLASS< DBLPLXID THEN GO M; %M07200100 CASE(IF SCLASS=DBLPLXID THEN T7.[27:5] ELSE %M07200200 SCLASS-38) OF BEGIN %M07200300 IF ACLASS = DBLPLXID THEN BEGIN %M07200400 IF T6!0 THEN GO M; IF PART THEN SIMPDBL; END ELSE %M07200500 IF ACLASS = REALID OR ACLASS= SYMID THEN BEGIN %M07200600 IF ACLASS = SYMID THEN EMITATN; EMIT(0); EMITO(XCH); %M07200700 IF PART THEN SIMPDBL END ELSE GO M; %M07200800 BEGIN IF ACLASS = DBLPLXID THEN BEGIN %M07200900 IF T6 ! 1 THEN DBLTSNGL(T6|4); %M07201000 IF T6 ! 0 THEN T6 ~ 12; END ELSE %M07201100 IF ACLASS = REALID THEN T6 ~ 0 ELSE %M07201200 IF ACLASS = SYMID THEN BEGIN EMITATN; T6 ~0; END %M07201300 ELSE GO TO M; %M07201400 PLXNORM(IF PART THEN SIMPLX(T6,FALSE) ELSE T6, FALSE) %M07201500 END; %M07201600 BEGIN IF ACLASS = DBLPLXID THEN BEGIN %M07201700 IF T6 = 1 THEN BEGIN EMITPAIR(JUNK,STD); EMIT(0); %M07201800 EMITO(XCH); EMIT(0); EMITV(JUNK); END ELSE %M07201900 IF T6 ! 0 THEN T6 ~ 12 END ELSE %M07202000 IF ACLASS = REALID OR ACLASS = SYMID THEN BEGIN %M07202100 IF ACLASS= SYMID THEN EMITATN; EMIT(T6~0); %M07202200 EMITO(XCH) END ELSE GO TO M; %M07202300 PLXNORM(IF PART THEN SIMPLX(T6,TRUE) ELSE T6,TRUE) %M07202400 END; %M07202500 BEGIN IF(ACLASS= DBLPLXID AND T6=0) OR ACLASS=REALID THEN %M07202600 BEGIN IF ACLASS ! REALID THEN DBLTSNGL(0); SDNORM(3) END %M07202700 ELSE IF ACLASS! SYMID THEN GO TO M; %M07202800 IF PART THEN BEGIN QUOTETOG ~ SYMSEC ~ TRUE; SDNORM(SEXP) %M07202900 END END; %M07203000 IF ACLASS ! RECID OR T7.[27:5]+30 ! T6 THEN GO TO M; %M07203100 BEGIN CASE IF ACLASS= DBLPLXID THEN T6 ELSE %M07203200 ACLASS-38 OF BEGIN %M07203300 BEGIN SIMPDBL; IF DBLRELATION THEN GO TO M END; %M07203400 BEGIN PLXNORM(SIMPLX(0,FALSE),FALSE); %M07203500 IF PLXRELATION THEN GO TO M; END; %M07203600 BEGIN PLXNORM(SIMPLX(0,TRUE),TRUE); %M07203700 IF DBLPLXRELATION THEN GO TO M END; %M07203800 BEGIN QUOTETOG ~ SYMSEC ~ TRUE; %M07204000 IF SYMRELATION(SEXP) THEN GO TO M END; %M07205000 IF RECRELATION(T6) THEN GO TO M; ; %M07206000 IF ELCLASS ! RELOP THEN GO TO M ELSE RELATION; END; %M07207000 FINISHBOO: SIMPBOO END; %M07208000 BEGIN IF ACLASS= SYMID THEN EMITATN ELSE %M07209000 IF ACLASS= DBLPLXID AND T6=0 THEN DBLTSNGL(0) ELSE %M07210000 IF ACLASS! REALID THEN GO TO M; SIMPARITH END; %M07211000 END; %M07211500 GO TO STORE END; %M07212000 COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000 ACTUAL PARAMETER; 07214000 IF ACLASS { IDMAX THEN CHECKER(WHOLE); %M07215000 STEPIT; IF VBIT THEN GO AER; GO TO S[ACLASS-4]; %M07215500 IF ACLASS=0 THEN FLAG(100) ELSE %M07216000 IF ACLASS = READV THEN BEGIN I ~ I - 1; GO TO NORMAL END; %M07216100 IF ACLASS = SPACEV THEN BEGIN EMITL(" "); ACLASS ~ SYMID; %M07216200 GO TO BSX END; %M07216300 FLAG(126); GO TO CERR; %M07217000 A6: EMITPAIR(ADDRSF,LOD); GO TO BS; %M07217500 M: FLAG(123); ERRORTOG ~ TRUE; GO TO COMMON; %M07217510 AER: FLAG(126); %M07217520 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 ACLASS=SCLASS THEN BEGIN %M07229000 IF SCLASS>23 AND SCLASS <51 THEN %M07229100 IF SCLASS ~(SCLASS-23).[45:3]=1 THEN BEGIN %M07229200 IF TAKE(WHOLE.LINK+1).[2:2]! T7.[27:5] THEN GO M END %M07229300 ELSE IF SCLASS=3 THEN BEGIN %M07229400 IF GETYPE(WHOLE)! T7.[27:5]+30 THEN GO M END END ELSE %M07229500 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 LFB: IF ACLASS~ EXPRSS}29 THEN ACLASS ~4; %M07244100 IF LISTOG THEN BEGIN %M07244200 STREAM PROCEDURE MSG(PCTR,ACLASS,LIN); VALUE PCTR,ACLASS; %M07244250 BEGIN LABEL L1,L2,L3,L4,L5,L6,L7,L8,L9; %M07244300 DI ~ LIN; DS ~ 8 LIT " "; SI ~ LIN; DS ~ 14 WDS; %M07244350 DI ~ LIN; DS ~18 LIT "WARNING: ARGUMENT "; SI ~ LOC PCTR; %M07244400 DS ~ 3DEC; DS~37 LIT " OF FORMAL PROCEDURE MUST BE OF TYPE "; %M07244450 CI ~CI + ACLASS; GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; %M07244500 GO L7; GO L8; DS ~ 14 LIT "DOUBLE COMPLEX"; GO L9; %M07244550 L1: DS ~ 9 LIT "--ERROR--"; GO L9; L2: DS~7 LIT "BOOLEAN"; %M07244600 GO L9; L3: DS~13 LIT "DESIGNATIONAL"; GO L9; %M07244650 L4: DS ~ 4 LIT "REAL"; GO L9; L5: DS ~ 6 LIT "RECORD"; GO L9; %M07244700 L6: DS ~ 6 LIT "SYMBOL"; GO L9; L7: DS ~ 6 LIT "DOUBLE"; GO L9; %M07244750 L8: DS ~ 7 LIT "COMPLEX"; %M07244800 L9: DS ~ 16 LIT " CALLED BY VALUE"; END; %M07244850 IF ACLASS > 8 THEN ERR(123) ELSE BEGIN MSG(PCTR,ACLASS,LIN); %M07244900 WRITELINE END; END; GO TO COMMON; %M07244950 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 A25: IF FORMALF THEN GO LODPOINT; %A07257100 IF TAKE(LINKF+INCRF).[40:8]=0 THEN GO LODPOINT; %A07257200 ERR(731); GO EXIT; %A07257300 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 TO LODPOINT; 07275000 LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000 THEN BEGIN 07277000 COMMENT THE PROCEDURE 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 %R07281900 IF SCLASS { INTPROCID THEN SCLASS~ SCLASS + 8; %M07282000 I ~ I-2; STEPIT; 07283000 WHOLE ~ ELBAT[I]; %M07283500 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)).VO 07290000 THEN 07291000 IF T4 ~ T3.CLASS ! DBLPLXID %M07292000 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(T3 ~ T3.ADDRESS); EMITPAIR(T3,STD); %M07306000 IF T4 = SYMID AND RECLAIMTOG THEN BEGIN EMITN(T3); %M07306100 EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M07306200 EMITPAIR( TABLEMARK,SND); EMITN(PTABLE); %M07306300 EMITO(STD) END END END; %M07306400 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 WHOLE ~ ELBAT[I-1]; %M07312500 GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000 L11: 07314000 COMMENT INTRINSIC PROCEDURE; 07315000 IF WHOLE.[27:6]!0 THEN IF LINKF>542 THEN GO AER; T4 ~ 0; %M07316000 IF ADDRSF = 0 THEN BEGIN %M07316100 IF ADDRSF ~ TAKE(LINKF+INCRF.[46:2]).[3:6]=0 %M07316200 THEN ADDRSF := GETSPACE(TRUE,LINKF.LINK+1); %T9307316300 PUTADR(LINKF,ADDRSF); END; %T9307316350 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 A31: A32: A34: IF FBIT THEN BEGIN I~I-2; STEPIT; GO TO LFB END; %M07321100 GO TO L17; %M07321200 L19:L20: 07322000 COMMENT ALFAPROC AND INTPROC; 07323000 ACLASS ~ REALPROCID; 07324000 A33: %M07324500 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 +8; %M07330000 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 A40: COMMENT DBLPLXID; %M07340100 A42: COMMENT RECID; IF FBIT THEN BEGIN I~I-2; STEPIT; GO LFB END; %M07340200 A41: COMMENT SYMID; GO TO L21; %M07340400 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 A47: COMMENT STRINGARRAYID; %M07352100 A48: COMMENT DBLPLXARRAYID; %M07352200 A50: COMMENT RECARRAYID; IF FBIT THEN GO AER; %M07352300 A49: COMMENT SYMARRAYID; GO TO L25; %M07352600 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 IF ACLASS= STRINGARRAYID THEN %M07361100 IF FORMALF THEN EMITV(ADDRSF-1) ELSE %M07361200 EMITNUM(TAKE(WHOLE+T1+1).NODIMPART); %M07361300 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 T7.[32:3]!T1 THEN FLAG(124); WHOLE~ELBAT[I-1]; GO BS; %M07369000 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 BOOLEAN CONSTANT; %W0307376000 IF T2 ~ 0 & WHOLE[44:25:2] > 7 THEN EMITNUM(C) %W0307377000 ELSE EMIT(T2); ACLASS ~ BOOID; GO TO BSX; %W0307377050 A15: IF INCRF!0 THEN GO AER; EMITL(12); ACLASS~ SYMID; GO BSX; %M07377100 A21: EMITNUM(TAKE(GIT(WHOLE))); ACLASS ~ SYMID; GO TO BSX; %M07377200 A63: COMMENT CHAINOP; I ~ I-1; T5 ~ BAE; %M07377300 T6 ~ PROGDESCBLDR(1,L,0); EMITV(897); SYMSEC ~ TRUE; %M07377400 SDNORM(MKCHAIN(FALSE)); EMITO(RTN); CONSTANTCLEAN; %M07377500 EMITB(BFW,T5,L); STEPIT; ACLASS~ SYMPROCID; GO TO BS; %M07377600 A61: COMMENT NIL; EMIT(0); ACLASS~ SYMID; %M07377700 IF SCLASS = RECID THEN SCLASS ~ SYMID; GO TO BSX; %M07377800 L32: 07378000 COMMENT LITERAL; 07379000 EMITL(ADDRSF); 07380000 BSXX: ACLASS ~ REALID; 07381000 BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000 L31:L33: 07383000 EMITNUM(C); GO TO BSXX; 07384000 EXIT: STACKCT ~ 0; QUOTETOG~QUOTETOGO;DPTOG~DPTOGO END; %M07385000 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 REAL A,B; %M07393500 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 IF ELCLASS}BOOPROCID THEN VARIABLE(2-REAL(FROM)) ELSE %M07402000 IF HOLE.LINK!PROINFO.LINK THEN BEGIN ERR(211); %M07402100 GO EXIT END ELSE %M07402110 IF ELCLASS= STRINGPROCID THEN BEGIN STEPIT; QUOTETOG~TRUE; %M07402120 STEPIT; STRINGSEC(8); QUOTETOG ~ NOT FROM; EMITPAIR(514,STD); %M07402130 EMITPAIR(TAKE(GIT(PROINFO)).[30:10],IF FROM THEN STD ELSE SND); %M07402140 IF NOT FROM THEN EMITV(514) END ELSE %M07402150 IF ELCLASS=DBLPLXPROCID THEN DBLPLXVAR(FROM) ELSE %M07402200 BEGIN ELBAT[I] ~ABS(HOLE)&(ELCLASS+8)[2:41:7]&514[16:37:11]; %M07402300 IF ELCLASS=SYMPROCID THEN SYMVAR(FROM) ELSE RECVAR(FROM) %M07402400 END; GO TO EXIT END; %M07402500 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 IF ELCLASS=STRINGPROCID THEN B~1 ELSE %M07406100 IF ELCLASS=DBLPLXPROCID THEN B ~ NEWP(HOLE) ELSE B ~0; %M07406200 FOR A ~ 1 STEP 1 UNTIL B DO EMIT(0); %M07406300 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 IF HOLE.CLASS = SYMPROCID AND HOLE < 0 AND NOT %M07412100 BOOLEAN(HOLE.FORMAL) THEN %M07412150 ARGLIST(HOLE); %M07412200 EMITV(ADDRESS); 07413000 IF HOLE.CLASS=RECPROCID THEN RECTYPE ~ GETYPE(HOLE); %M07413500 COMMENT MONITOR CODE GOES HERE; 07414000 IF HOLE < 0 07415000 THEN IF HOLE.CLASS=SYMPROCID AND NOT BOOLEAN(HOLE.FORMAL) %M07416000 THEN BEGIN EMITPAIR(JUNK,SND); SYMONITOR(TRUE,HOLE,0,4);%T9307416500 END ELSE BEGIN %M07417000 EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000 EMITV(JUNK); EMITL(PASSTYPE(HOLE)); 07419000 EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000 EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000 (GIT(HOLE)).FUNCMONFILE); EMITL(1); 07422000 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 REAL HOLE; HOLE ~ ELBAT[I]; %M07429500 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 BEGIN %M07441000 GT2 ~ IF ELCLASS=DBLPLXSTRPROCID THEN NEWP(ELBAT[I])+1 ELSE 1; %M07441100 FOR GT1~1 STEP 1 UNTIL GT2 DO EMIT(0) END; EMITO(MKS); STEPIT; %M07441200 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 LITS TO MAKE SPACE FOR LOCALS INSIDE 07450000 OF STREAM PROCEDURES; 07451000 IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000 ELSE BEGIN 07453000 ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000 IF HOLE.CLASS=RECSTRPROCID THEN RECTYPE ~ GETYPE(HOLE) %M07454500 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 VARIABLE(FL); 07464750 IF TABLE(I-2)=FACTOP THEN % A[*] = AUXMEM RELEASE. 07465000 BEGIN 07465250 EMITPAIR(38,COM); EMITO(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 ELCLASS!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 DOSTMT HANDLES THE DO STATEMENT; 07481000 PROCEDURE DOSTMT; 07482000 BEGIN INTEGER TL; 07483000 DIALA ~ DIALB ~ 0; 07484000 STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000 ELSE BEGIN 07486000 STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000 END DOSTMT; 07488000 COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000 PROCEDURE WHILESTMT; 07490000 BEGIN INTEGER BACK,FRONT; 07491000 DIALA ~ DIALB ~ 0; 07492000 STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL; 07493000 IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000 BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000 CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000 COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000 EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000 OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000 STORAGE RETURNED. SEE DEXP AND GENGO; 07500000 PROCEDURE GOSTMT; 07501000 BEGIN 07502000 REAL ELBW; 07503000 REAL T,N; %A07503500 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 GOMCP;07507000 IF NOT LOCAL(ELBAT[I]) THEN GO GOMCP; 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); EMITL(0); EMITV(GNAT( 07516000 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 NOGO; %M07528500 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 THAT 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 STEPIT; 07580000 IF SIMPGO 07581000 THEN BEGIN 07582000 T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000 STEPIT; GO EXIT END; 07584000 T2 ~ BUMPL; CONSTANTCLEAN; 07585000 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 XMARK; 07596500 DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000 BEGIN ERR(133); GO TO EXIT END; 07598000 IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000 THEN BEGIN FLAG(134); GO TO ROUND END; 07600000 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); EMITL(0); 07619000 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(R); VALUE R; REAL R; %M07646100 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 REAL T; %M07646393 LABEL LX; %M07646395 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 FLAG(70);I~I-1; COMPOUNDTAIL; GO XIT END;%T9007646440 EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450 EMITO(BFW); ADR ~ L; 07646460 T ~ R.[41:6]; %M07646465 LOOP: 07646470 ERRORTOG ~ TRUE; 07646475 IF BOOLEAN(R) THEN BEGIN QUOTETOG ~ T = 5; %M07646476 DPTOG ~ T=6 OR T=8; IF STEPI = ENDV THEN BEGIN %M07646477 QUOTETOG ~ DPTOG ~ FALSE; GO LX END; I~ I -1 END ELSE BEGIN %M07646478 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; I ~ I-1 END; %M07646500 TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510 IF NOT BOOLEAN(R) THEN BEGIN STEPIT; %M07646512 IF SIMPGO THEN 07646515 BEGIN COMMENT SIMPLE GO TO. DO NOT EMIT BRANCH TO RESUME; 07646520 ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646525 STMT; IF ELCLASS = SEMICOLON THEN GO TO LOOP 07646530 ELSE GO TO LX %M07646532 END ELSE I ~ I-1 END; %M07646535 IF BOOLEAN(R) THEN GENEXP(R.[41:6]) ELSE BEGIN STEPIT; STMT END; %M07646540 IF ELCLASS = SEMICOLON THEN %M07646542 BEGIN EMIT (LINK); LINK ~ L ~ L+1; GO TO LOOP END 07646545 ; LX: %M07646550 IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555 % %D9907646556 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; 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;% %D07646705 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 PROCEDURE FILLSTMT;BEGIN 07647000 COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07648000 IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07649000 THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07650000 THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07651000 NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07652000 RESIDES ON THE DRUM AND IS READ INTO THE ROW DESIGNATED 07653000 BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07654000 EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07655000 ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07656000 NUMBERS LOOK LIKE IDENTIFIERS TO FILLSTMT AND ARE CONVERTED 07657000 BY COCT.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN PDPRT 07658000 TO SUPPLY INFO TO BUILD A DRUM DESCRIPTOR IN THE SEGMENT 07659000 DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07660000 LABEL L2,L3,L4; %W0307675000 INTEGER LX,SG; % %W0307675500 REAL T1,T3; 07676000 BOOLEAN V; %M07676100 ARRAY TEDOC[0:7,0:127]; DEFINE T2=T3.[38:3],T3.[41:7]#; 07676500 LABEL L,L1,EXIT; 07677000 IF STEPIINTARRAYID THEN 07678000 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07678100 BEGIN MAKEALABEL; GO TO EXIT END ELSE 07678200 BEGIN IF ELCLASS!STRINGID AND ELCLASS! STRINGARRAYID THEN %M07679000 BEGIN ERR(300); GO EXIT END END; %M07679500 IF ELCLASS < BOOARRAYID THEN %M07679600 STRINGVAR( TRUE) ELSE BEGIN %M07679700 VARIABLE(FL );COMMENT FL TELLS THE VARIABLE ROUTINE 07680000 IT IS COMING FROM THE FILL STATEMENT SO 07681000 IT MAY EXPECT A ROW DESIGNATOR.VARIABLE 07682000 THEN EMITS THE CODE; 07683000 IF TABLE(I - 2) ! FACTOP THEN FLAG(304); 07683100 END; %M07683150 IF ELCLASS!WITHV THEN BEGIN ERR(301); GO EXIT END; 07684000 STREAMTOG ~ BOOLEAN(2); 07684005 IF TABLE(I+1) { IDMAX THEN 07684010 IF Q = "7INQUI" THEN 07684020 BEGIN EMITL(9); EMITO(COM); EMITO(DEL); 07684030 STREAMTOG ~ FALSE; 07684035 I ~ I+1; STEPIT;GO TO EXIT END; 07684040 EMITNUM(SGAVL); T1 ~ 2|SGAVL-1; EMITL(7);T1~T1&1[5:47:1]; 07685000 EMITO(COM); EMITO(DEL); EMITO(DEL); SEGMENTSTART; 07686000 MOVECODE(TEDOC,EDOC); 07686500 BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); % 07686600 LX :=LL; SG := SGNO; SGNO := SGAVL; % %W0307686700 IF STEPI=DECLARATORS AND ELBAT[I].ADDRESS=STRINGV THEN BEGIN %M07687000 QUOTETOG~TRUE; STEPIT; QUOTETOG ~ FALSE; %M07687050 IF ELCLASS!QUOTEOP THEN BEGIN ERR(305); GO TO L1 END; T3~0; %M07687100 DO BEGIN %M07687200 COUNT ~ 0; %M07687300 DO BEGIN CHKND; RESULT~5; SCANNER; CHKND; %M07687400 END UNTIL (V ~ EXAMIN(NCR)=""") OR COUNT=8; %M07687500 MOVECHARACTERS(COUNT,ACCUM[1],3,EDOC[T2],0); %M07687600 END UNTIL T3 ~ T3 + 1 = 1022 OR V; %M07687700 IF V THEN BEGIN RESULT~5; SCANNER; STEPIT END ELSE ERR(305); %M07687800 GO TO L1 END ELSE I ~ I - 1; %M07687900 L:FOR T3~0 STEP 1 UNTIL 1022 DO 07688000 BEGIN LL:= T3 | 4; % %W0307688500 BEGIN IF STEPI=LITNO OR ELCLASS=NONLITNO THEN GO L2; %W0307689000 IF ELCLASS = STRNGCON THEN %W0307690000 IF COUNT=8 THEN BEGIN MOVECHARACTERS(8,ACCUM[1],3,%W0307690500 EDOC[T2],0); GO TO L3 END ELSE GO TO L2; %W0307691000 IF ELCLASS = ADOP THEN BEGIN %W0307691500 IF STEPI=LITNO OR ELCLASS=NONLITNO THEN BEGIN %W0307692000 C ~ C&ELBAT[I-1][1:21:1]; GO TO L2 END %W0307692500 END ELSE %W0307693000 IF ELCLASS{IDMAX THEN BEGIN %W0307693500 IF ACCUM[1].[18:18] ="OCT" THEN BEGIN %W0307694000 ACCUM[1].[18:18]~0; %W0307694500 OCTCON(FALSE,ACCUM[0]); GO TO L4 END %W0307695000 END ELSE %W0307695500 IF ELCLASS=TRUTHV THEN BEGIN %W0307696000 IF ELBAT[I].ADDRESS>1 THEN BEGIN %W0307697000 L4: MOVE(1,ACCUM[0],EDOC[T2]); GO TO L3 END END;%W0307698000 I ~ I-1; C ~ 0; COMMENT BLANK FIELD IS ZERO; %W0307699000 L2: MOVE(1,C,EDOC[T2]); %W0307700000 L3: C ~ 0; %W0307701000 IF STEPI!COMMA THEN GO TO L1 07702000 END; 07703000 END; % %W0307703500 L1: 07704000 07705000 LL:= LX; SGNO := SG; % %W0307705500 STREAMTOG~FALSE; 07706000 SEGMENT(T3+1,SGAVL,SGNO); 07707000 MOVECODE(TEDOC,EDOC); 07707500 BUILDLINE ~ BUILDLINE.[46:1] ; 07707650 SGAVL~SGAVL+1; 07708000 EXIT: END; 07709000 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 INTEGER T; %M07715500 LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000 LFIELD,LSTRING,LINDBL,LINSYM,LATRNS,LTRN,LCHAIN,LSDCV,LSYMV,LDCA, %M07716500 LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000 LRV,LATE, %A07717500 LGO, LRELSE, LBEG, LBRK, EXIT; 07718000 SWITCH S ~ 07719000 LPROC,LSPROC,LFIELD,LSTRING,LINDBL,LINSYM,LERR,LERR,LATRNS,LERR , %M07720000 LTRN,LERR,LERR,LERR,LERR,LERR,LERR,LERR,LERR,LPROC, %M07720100 LPROC,LPROC,LPROC,LPROC,LPROC,LPROC,LPROC,LSTRING,LSDCV,LSYMV, %M07721000 LRV,LVAR,LVAR,LVAR,LVAR,LSTRING,LDCA,LSYMV,LRV,LATE, %A07722000 LATE,LATE,LATE,LAB,LERR,LERR,LERR,LERR,LERR,LERR, %A07723000 LERR,LCHAIN,LDEC,LREAD,LWRITE,LSPACE, %M07724000 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=LFTBRKET THEN BEGIN SFEXP(TRUE,TRUE,0); GO EXIT END; %A07729050 IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100 IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07729190 BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200 FLAG(145); 07729500 LERR: ERR(144); GO TO EXIT; 07730000 LATRNS: IF T ~ ELBAT[I].[27:6] <21 OR T >23 THEN GO TO LERR; %M07730100 IF T < 23 THEN BEGIN %M07730150 IF STEPI ! ASSIGNOP THEN GO LERR; %M07730160 STEPIT; AEXP; EMITO(SSP); %M07730180 EMITPAIR(IF T=21 THEN TABR ELSE COLR,ISD); GO TO EXIT END; %M07730200 FIXCLASS(REALID,INREAL,FALSE); GO TO LVAR; %A07730250 LCHAIN: GT1 ~ MKCHAIN(TRUE); GO TO EXIT; %M07730300 LFIELD: IF ELBAT[I].ADDRESS=STRINGV THEN GO LSTRING; %M07730350 FIELDC(ELBAT[I],0,TRUE); GO TO EXIT; %M07730375 LINDBL: IF NOT BOOLEAN(ELBAT[I].INCR) THEN GO TO LERR; %M07730400 FIXCLASS(DBLPLXID,INDBL,FALSE); %A07730450 LSDCV: LDCA: DBLPLXVAR(TRUE); GO TO EXIT; %M07730500 LRV: RECVAR(TRUE); GO TO EXIT; %M07730550 LSYMV: SYMVAR(TRUE); GO TO EXIT; %M07730600 LSTRING: STRINGSEC(2); GO TO EXIT; %M07730650 LTRN: NVALINT; GO TO EXIT; %M07730700 LINSYM: IF ELBAT[I].INCR ! 9 THEN GO TO LERR; %M07730750 ELBAT[I].CLASS ~ SYMID; ELBAT[I].ADDRESS ~ INSYM; GO TO LSYMV; %M07730800 LDEC: IF DECLCHECK THEN FLAG(146) ELSE BEGIN DBLSTMT; GO TO EXIT END; %M07731000 IF TABLE(I-2) = ENDV 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 LATE: IF TABLE(I+1) ! LFTBRKET THEN BEGIN %A07735500 IF BASICMATRIX THEN STRINGSEC(2) END %A07735505 ELSE VARIABLE(FS); GO EXIT; %A07735510 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: CASESTMT(0); GO TO EXIT; %M07746000 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 IF DECLCHECK %M07754500 THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000 ELSE COMPOUNDTAIL %M07755500 ELSE COMPOUNDTAIL; 07756000 EXIT: END STMT; 07757000 PROCEDURE UNKNOWNSTMT; 07800000 BEGIN LABEL XXX,E; 07801000 REAL J,N,C; 07802000 IF Q="5ERROR" THEN BEGIN EMITO(MKS); EMITL(SGNO); %M07802100 EMITL((L+3)DIV 4); PANA; EMITV(ERRPRO); GO TO XXX END; %M07802200 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 = "3ZIP00" THEN 07811000 BEGIN IF TABLE(I+1) = WITHV THEN 07812000 BEGIN STEPIT; IF ROWD(TRUE) THEN BEGIN %A07813000 IF MAKEROW THEN GO TO E END ELSE %A07814000 IF ELCLASS=FILEID OR ELCLASS = SUPERFILEID %A07814100 THEN PASSFILE ELSE GO E; %A07814200 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 = "4SWAP0" THEN 07825600 BEGIN ALPHA C, D; 07825610 EMITO(MKS); %A07825615 IF STEPI ! LEFTPAREN THEN 07825620 BEGIN ERR(105); GO TO XXX END; 07825630 IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 07825640 BEGIN ERR(171); GO TO XXX END; 07825650 IF TAKE(GIT(C~ELBAT[I])).[40:8] ! 2 THEN FLAG(171); 07825660 EMITPAIR(C.ADDRESS,LOD); %A07825670 CHECKER(C); ERRORTOG~TRUE; %T9007825675 IF STEPI ! COMMA THEN 07825680 BEGIN ERR(170); GO TO XXX END; 07825690 IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 07825700 BEGIN ERR(171); GO TO XXX END; 07825710 IF TAKE(GIT(D~ELBAT[I])).[40:8] ! 2 THEN FLAG(171); 07825720 EMITPAIR(D.ADDRESS,LOD); %A07825730 CHECKER(D); ERRORTOG~TRUE; %T9007825735 IF STEPI ! RTPAREN THEN ERR(104) ELSE STEPIT; 07825740 EMITV(GNAT(SWAPPER)); 07825750 GO TO XXX; 07825760 END ELSE 07825770 IF Q .[24:24]="MARG" THEN BEGIN FIXCLASS(INTID,0,TRUE); %A07825790 VARIABLE(FS); GO TO XXX END ELSE %A07825800 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 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!SUPERFILEID 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 IF ROWD(TRUE) THEN BEGIN %T9207859040 IF MAKEROW THEN FLAG(208) ELSE L ~ L - 1; %T9207859050 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 END ELSE ERR(208); %T9207859085 GO TO XXX 07859090 END ELSE %T9207859095 IF Q = "7TWXLO" THEN BEGIN %T9207859100 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO XXX END; %A07859200 QUOTETOG ~ TRUE; STEPIT; QUOTETOG ~ FALSE; %A07859300 IF ELCLASS ! QUOTEOP THEN BEGIN ERR(637); GO XXX END; %A07859400 QUOTETOG ~ TRUE; EMITNUM(SFTERM(FALSE)); %A07859500 IF ELCLASS ! COMMA THEN BEGIN ERR(606); GO XXX END;% %A07859600 IF STEPI ! SYMSTRPROCID THEN BEGIN ERR(680); GO XXX END;% %A07859700 IF NOT BOOLEAN(J~ELBAT[I]).FORMAL THEN %A07859710 IF TAKE(GIT(J)).[40:8]!0 THEN BEGIN ERR(732); GO XXX END; %A07859720 EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITV(TWXLOOP); %A07859800 STEPIT; %A07859850 RTPARN; GO XXX END ELSE% %A07859900 IF Q = "8FREEL" OR Q = "7NEXTA" THEN BEGIN% %A07859910 FIXCLASS(INTID,Q,BOOLEAN(3)); VARIABLE(FS); GO XXX END ELSE %A07859920 IF Q="@COMMU" THEN BEGIN % %T2907860000 GOTCHA := GOTCHA AND NOT STREAMER; % %T0307860050 PANA; EMITO(COM); GO XXX END ELSE %T2907861000 %T9307862000 %T9307864000 %T9307865000 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 COMMENT FORSTLIST COMPILES THE CONSTRUCT FOR DO ; %W3307915000 PROCEDURE FORSTLIST(J); VALUE J; INTEGER J; %W3307915010 BEGIN %W3307915020 INTEGER LISTADDRESS,JUMPPLACE,LL,NAME; %W3307915030 REAL LINFO,TEMP,VOBIT; %W3307915040 CHECKER(ELBAT[I]); %W3307915050 COMMENT J=0 IF FORSTLIST CALLED BY FORSTMT %W3307915060 J!0 IF FORSTLIST CALLED BY FORSTLIST; %W3307915070 IF J=0 THEN %W3307915080 BEGIN %W3307915090 EMITL(0); ADJUST; JUMPPLACE ~ L; %W3307915100 END ELSE JUMPPLACE ~ J; %W3307915110 EMITPAIR(LSTRTN,SND); %W3307915120 LISTADDRESS ~ ELBAT[I].ADDRESS; %W3307915130 COMMENT SET UP THE LIST AS IF IT WERE A REAL VARIABLE; %W3307915140 TEMP ~ TAKE(LINFO ~ ELBAT[I].LINK); %W3307915150 IF MODE = 0 THEN FLAG(510) ELSE %73 %W3307915155 NAME ~ GETSPACE(FALSE,-1); %W3307915160 VOBIT ~ IF BOOLEAN(TEMP.FORMAL) THEN TEMP ELSE TEMP & 2[9:46:2];%W3307915170 PUT(VOBIT & LEVEL[11:43:5] & REALID[2:41:7] & NAME[16:37:11], %W3307915180 LINFO); %W3307915190 EMITN(LISTADDRESS); EMITPAIR(NAME,STD); %W3307915200 EMITV(LSTRTN); EMITPAIR(0,GEQ); LL ~ BUMPL; %W3307915210 IF STEPI = COMMA THEN %W3307915220 IF STEPI = LISTID THEN FORSTLIST(JUMPPLACE) ELSE ERR(475) %W3307915230 ELSE BEGIN %W3307915240 IF ELCLASS!DOV THEN ERR(475) ELSE STEPIT; EMITO(DEL); %W3307915250 COMMENT ERROR 475 INDICATES MISSING DO OR NON LIST ELEMENT; %W3307915260 DIALA ~ DIALB ~ 0; %W3307915270 STMT; %W3307915280 EMITL(5); EMITB(BBW,BUMPL,JUMPPLACE); %W3307915290 CONSTANTCLEAN; ADJUST; %W3307915300 EMITO(DEL); EMITL(5); %W3307915310 EMITPAIR(LSTRTN,STD); %W3307915320 END; %W3307915330 EMITB(BFC,LL,L-4); %W3307915340 COMMENT SET THE LIST BACK TO BE A LIST (NOW REAL); %W3307915350 PUT(TAKE(LINFO)& TEMP[1:1:34],LINFO); %W3307915360 DIALA ~ DIALB ~ 0; %W3307915370 END FORSTLIST; %W3307915380 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 := TRUE & (FAULTOG.[46:1]) [46:47:1]; % %D0107923100 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.LVL0 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 REPONSIBLE 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 A 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,XIT; %W3308017000 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 END SIMPLE; 08039000 COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000 PROCEDURE TEST; 08041000 BEGIN 08042000 IF NOT CONSTANB THEN 08043000 BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000 ELSE BEGIN 08045000 EMITL(2+L-BRET); 08046000 EMITB(BBW,BUMPL,B); 08047000 END; 08048000 EMITO(MUL); EMIT(0) END; 08049000 EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000 END TEST; 08051000 BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000 BEGIN 08053000 CHECKER(VRET~ALL); 08054000 ADDRES ~ ALL.ADDRESS; 08055000 FORMALV ~ ALL.[9:2] = 2; 08056000 IF T ~ ALL.CLASS > INTARRAYID OR T< REALID OR %M08057000 (T > INTID AND T< REALARRAYID) THEN %M08058000 ERR(REAL(T ! 0) | 51 + 100); 08059000 INT ~ T= INTID OR T= INTARRAYID; %M08060000 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(OPDC); 08108000 COMMENT FETCH INDEX; 08109000 IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END 08110000 ELSE REGO ~ I; 08111000 IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND 08112000 (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 LABEL NF; %M08173500 NXTELBT ~ 1; I ~ 0; 08174000 IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %M08175000 EMITNUM(C); %M08175050 NF: T1 ~ L; EMITPAIR(T3 ~FORAD,SND); EMIT(0); %M08175075 EMITO(GTR); T2 ~ BUMPL; %M08175100 IF STEPI= DOV THEN STEPIT ELSE BEGIN ERR(154); GO EXIT END; %M08175150 STMT; DCRFR; %M08175225 EMITV(T3); EMITL(1); EMITO(SUB); EMITB(BBW,BUMPL,T1); %M08175250 EMITB(BFC,T2,L); GO TO EXIT END; %M08175300 IF ELCLASS = SYMID THEN BEGIN CHECKER(VRET ~ ELBAT[I]); %M08175350 T4 ~ VRET.ADDRESS; FORMALV ~ VRET.[9:2]=2; %M08175400 IF (INT~ STEPI = DECLARATORS AND ELBAT[I].ADDRESS= INV) OR %M08175450 ACCUM[1] = "2ON000" THEN BEGIN QUOTETOG ~ TRUE; %M08175500 STEPIT; SEXPN; QUOTETOG ~ FALSE; %M08175510 IF INT THEN BEGIN MARKSYM ~ RECLAIMTOG; %M08175540 T3 ~ FORAD; MARKSYM ~ FALSE; %M08175550 T1 ~ L; GETCONTENTS(0,FALSE); %M08175560 EMITPAIR(T3,SND); EMIT(0); EMITO(GEQ); %M08175570 IF ELCLASS=WHILEV THEN BEGIN STEPIT; BEXP; EMITO(LND) END %M08175572 ELSE IF ELCLASS=UNTILV THEN BEGIN STEPIT; BEXP; EMITLNG; %M08175575 EMITO(LND) END; %M08175577 IF ELCLASS = DOV THEN STEPIT ELSE %M08175578 BEGIN ERR(154); GO EXIT END; %M08175579 T2 ~ BUMPL; EMITV(T3); EMITI(0,18,15); %M08175580 IF FORMALV THEN BEGIN EMITN(T4); EMITO(STD) END ELSE %M08175590 EMITPAIR(T4,STD); %M08175600 STMT; FORLEVEL ~ FORLEVEL-REAL(RECLAIMTOG)-1; EMITV(T3); %M08175610 EMITB(BBW,BUMPL,T1); EMITB(BFC,T2,L); %M08175620 IF RECLAIMTOG THEN BEGIN EMIT(0); EMITPAIR(T3,STD) END %M08175630 END ELSE %M08175640 BEGIN T1 ~ L; EMITI(0,33,15); %M08175650 IF FORMALV THEN BEGIN EMITN(T4); EMITO(SND) END ELSE %M08175660 EMITPAIR(T4,SND); EMIT(0); EMITO(NEQ); %M08175670 IF ELCLASS=WHILEV THEN BEGIN STEPIT; BEXP; EMITO(LND) END %M08175680 ELSE IF ELCLASS=UNTILV THEN BEGIN STEPIT; BEXP; EMITLNG; %M08175690 EMITO(LND) END; %M08175700 IF ELCLASS = DOV THEN STEPIT ELSE %M08175703 BEGIN ERR(154); GO EXIT END; %M08175705 T2 ~ BUMPL; %M08175710 STMT; %M08175720 EMITV(T4); GETCONTENTS(0,FALSE); %M08175730 EMITB(BBW,BUMPL,T1); %M08175740 EMITB(BFC,T2,L); %M08175750 END END ELSE ERR(151); %M08175760 GO TO EXIT END; %M08175780 IF ELCLASS = LISTID AND NOT LISTMODE THEN %W3308175785 BEGIN FORSTLIST(0); GO TO XIT END; %W3308175790 IF SIMPI(VRET~ELBAT[I]) 08176000 THEN BEGIN 08177000 IF STEPI!ASSIGNOP THEN BEGIN %M08178000 IF ELCLASS!DOV THEN BEGIN ERR(152); GO EXIT END; %M08178100 EMITV(ADDRES); I ~ I - 1; GO NF END; %M08178200 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,Q,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; XIT: END FORSTMT; %W3308232000 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 LISTPARA; %W3308289100 BEGIN %W3308289200 INTEGER LISTADDRESS; %W3308289300 IF ELCLASS=LFTBRKET THEN %W3308289400 BEGIN %W3308289500 STEPIT; RR1 ~ LISTGEN; %W3308289600 IF ELCLASS ! RTBRKET THEN ERR(158) ELSE STEPIT %W3308289700 END %W3308289800 ELSE IF ELCLASS ! LISTID AND ELCLASS ! SUPERLISTID %W3308289810 THEN RR1 ~ LISTGEN %W3308289820 ELSE BEGIN %W3308289830 CHECKER(ELBAT[I]); %W3308289840 LISTADDRESS ~ ELBAT[I].ADDRESS; %W3308289850 IF ELCLASS = SUPERLISTID THEN %W3308289860 BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; %W3308289870 BANA;EMITN(LISTADDRESS); %B8-6 %67 %W3308289880 EMITO(LOD); %B8-6 %67 %W3308289884 EMITO(LOD); %W3308289886 END ELSE %W3308289890 BEGIN COMMENT A COMMON LIST ID; %W3308289900 EMITL(LISTADDRESS); IF LISTADDRESS > 1023 THEN EMITO(PRTE); %W3308289910 EMITO (LOD); STEPIT; %W3308289915 END %W3308289920 END %W3308289930 END LISTPARA; %W3308289940 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 ::=[:]/ 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 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 INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500 LABEL EXPFORMR; %W4008385550 BOOLEAN SEEKTOG,LOCKTOG,GRABTOG; % %P08385600 BOOLEAN JR; LABEL REMT; %A08385650 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 IF JR ~ ACCUM[1] = "3TWX00" THEN BEGIN STEPIT; EMITO(MKS); %A08388100 GO REMT END; %A08388200 IF ELCLASS = LFTBRKET THEN BEGIN % %T6008388300 DO IF SYMID { STEPI AND ELCLASS { INTID THEN BEGIN % %T6008388350 CHECKER(RR9 ~ ELBAT[I]); % %T6008388400 EMITO(MKS); EMITV(TERPRIN); % %T6008388425 EMITO(MKS); MKALF(RR9); EMITV(ALFPRINT); % %T6008388450 EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); % %T6008388475 EMITO(MKS); EMITL("="); EMITV(CHARPRINT); % %T6008388500 EMITO(MKS); EMITV(TERPRIN); % %T6008388525 EMITO(MKS); % %T6008388550 IF ELCLASS = SYMID THEN EMITV(READ1) ELSE BEGIN % %T6008388554 EMIT(IF ELCLASS = ALFAID THEN 40 ELSE 20); % %T6008388558 EMIT(0); EMITV(READN); END; % %T6008388560 EMITN(RR9.ADDRESS); % %T6008388650 EMITO(IF ELCLASS = INTID THEN ISD ELSE STD); % %T6008388700 RR8 ~ BUMPL; CONSTANTCLEAN; EMITB(BFW,RR8,L); % %T6008388725 END ELSE BEGIN ERR(638); GO EXIT; END % %T6008388750 UNTIL STEPI ! COMMA; % %T6008388800 IF ELCLASS ! RTBRKET THEN ERR(118) ELSE STEPIT; % %T6008388850 GO EXIT; % %T6008388900 END; % %T6008388950 REVERSETOG~ACCUM[1]="7REVER"; 08389000 LOCKTOG ~ ELCLASS=LOCKV; %R08390000 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 ROWD(TRUE) THEN %M08401000 BEGIN %M08401020 IF ELCLASS = STRINGID THEN %A08401021 IF ACCUM[1] = "5TWXS1" AND DACP ! 0 THEN BEGIN %A08401022 REMT: DACP ~ -ABS(DACP); %A08401023 IF DAC[4]=0 OR DAC[5]=0 OR DACOMI = 0 THEN %A08401024 BEGIN FLAG(880); DACOMI := 1; END; %T9308401025 EMIT(0); EMITPAIR(CPI,STD); EMITL(1); EMITPAIR(DAC[4],STD); %A08401026 EMITV(DACOMI); EMITO(DEL); %A08401027 IF JR THEN GO EXIT; %T9308401028 IF TABLE(I+1) = RTPAREN THEN BEGIN STEPIT; GO EXIT END; %T9308401029 EMITO(MKS); END; %T9308401030 IF MAKEROW THEN %T9308401035 BEGIN ERR(422); GO TO EXIT END; 08401040 MAYI ~ 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,], %B0208410000 %%% [*],[*,*],[*,],[],[,*], 08410010 %%% AND [,]. THE FIRST (LEFTMOST) 08410020 %%% IS THE READSEEKDISTADDRESS, RESIDING08410030 %%% 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-ON08411020 %%% THE EXP-SIGN BIT OF DSKADDR.X"S ARE EMPTIES08411030 %%% IN THE ABOVE, NS = NO OR STOP. %B0208411040 STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000 IF RR1~IF ACCUM[1]="2NO000" THEN 1 ELSE %B0208412010 IF ACCUM[1]="4STOP0" THEN 2 ELSE %B0208412020 0 ! 0 THEN %%% HAVE [NS %B0208412030 IF STEPI=COMMA THEN %%% HAVE [NS, %B0208412040 IF STEPI=FACTOP THEN %%% HAVE [NS,* %B0208412050 BEGIN %B0208412060 IF RR1=1 THEN EMITNO(1) %B0208412070 ELSE BEGIN EMITL(1); EMITL(2) END;%B0208412080 STEPIT ; %B0208412090 END %B0208413000 ELSE %B0208413010 BEGIN %%% HAVE [NS,AEXP %B0208413020 IF RR1=2 THEN EMITL(1) ; %B0208413030 EMITTIME ; %B0208413040 IF RR1=2 THEN %B0208413050 BEGIN EMITO(LOR); EMITL(2) END %B0208413060 ELSE EMITL(1) ; %B0208413080 END %B0208413090 ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS %B0208413100 ELSE BEGIN EMITL(1); EMITL(2) END %B0208413110 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 BEGIN EMITTIME; EMITL(2) END%[*,A08414020 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 BEGIN EMITTIME; EMITO(LOR) END ; 08416020 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 % %P08418250 BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE % %P08418300 BEGIN EMITL(1); GRABTOG ~ TRUE; STEPIT END ELSE %P08418350 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 ; % %P08418800 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 EXPLICITFORMAT THEN GO TO EXPFORMR; %W4008430500 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 %B0208437000 BEGIN EMITL(1); I~I-1; END ; %B0208437050 EMITL(0); GO TO PASSLIST ; %B0208437075 END; 08438000 IF RANGE(FRMTID,SUPERFRMTID) 08439000 THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000 PASSFORMAT; 08441000 EXPFORMR: %W4008441500 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 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 ROWD(FALSE) %M08457000 THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000 IF MAKEROW %M08459000 % %M08460000 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 STEPIT; LISTPARA; %W3308479000 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 12 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 % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493110 % 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 IF 08493790 ATTRIBUTEINDX=4 THEN "6OTHRUS" ELSE IF ATTRIBUTEINDX=12 08493800 THEN "6ARASIZ" ELSE 08493810 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 ONEPARFNSH; COMMENT I IS POINTING 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 EXPFORMW; %W4008591150 INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 BOOLEAN LOCKTOG,ARC; 08591600 BOOLEAN REMOTE; %A08591650 INTEGER HOLD;% 08591700 IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000 IF REMOTE ~ ACCUM[1] = "3TWX00" THEN BEGIN STEPIT; GO EXIT END; %A08592500 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 ROWD(TRUE) THEN %M08597100 BEGIN %M08597200 IF ELCLASS = STRINGID THEN REMOTE ~ ACCUM[1] = "5TWXS2" %A08597250 AND DACP ! 0; %A08597260 IF MAKEROW THEN %M08597300 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 ONEPARFNSH: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 PARARAMETER IN A WRITE STATEMENT; 08617000 STEPIT; 08618000 %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 %%% [DPN,],[*],[*,*],[*,],[],[,*] 08619010 %%% AND [,], WHERE DPN IS 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 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 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 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 ONEPARFNSH; 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: IF EXPLICITFORMAT THEN GO TO EXPFORMW ELSE STEPIT; %W4008643000 IF RANGE(FRMTID,SUPERFRMTID) 08644000 THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 PASSFORMAT; 08646000 EXPFORMW: %W4008646500 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) %B0208653120 ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END;%B0208653125 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 ; %B0208653195 IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. %B0208653200 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 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 ROWD(FALSE) %M08665000 THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 IF MAKEROW %M08667000 % %M08668000 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 %W3308687000 STEPIT; LISTPARA; %W3308688000 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 IF REMOTE THEN BEGIN EMITL(RMARG ); EMITPAIR(TABR,STD); %T9008699100 EMITO(MKS); EMITV(TERPRIN) END; %A08699200 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,450) 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 ROWD(FALSE) THEN %T9208728100 BEGIN ERR(451); GO TO EXIT END; 08728200 IF MAKEROW THEN FLAG(208) ELSE L ~ L-1; %T9208728300 %T9208728400 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 LAST08772000 EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE;08773000 DEFINE THISL = RR1#; COMMENT THISL 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 UNIT 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 DISPOSTION 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 CONTAINS THE 08837000 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 %T9308860250 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 DKO 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 FILER~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]));%T0308999200 IF LISTOG OR NOT(REMOTOG OR REMOTERR) THEN BEGIN % %T0308999300 IF NOHEADING THEN DATIME; WRITELINE; END; % %T0308999400 IF REMOTOG OR REMOTERR THEN WRITE(REMOTE[*,9],10,LIN[*])[ENDOFITALL]%T0308999500 ; % %T0308999555 ERRORCOUNT := ERRORCOUNT + 1; % %T0308999600 END; % %T0308999700 COMMENT THE PROGRAM ROUTINE DOES THE INITIALIZATION AND THE WRAPUP 09000000 FOR THE REST OF THE COMPILER. THE MAIN PROGRAM OF THE COMPILER09001000 IS SIMPLY A CALL ON THE PROGRAM ROUTINE; 09002000 PROCEDURE PROGRAM; 09003000 BEGIN 09004000 STREAM PROCEDURE MDESC(WD,TOLOC);VALUE WD; 09005000 BEGIN DI~LOC WD; DS~ SET;SI~ LOC WD; DI~TOLOC;DS~WDS END; 09006000 COMMENT THE FOLLOWING PROCEDURE PRINTS OUT THE PRT, NAME, AND 09007000 SEGMENT NUMBER OF THE INTRINSIC PROCEDURES USED IN THE 09008000 OBJECT PROGRAM; 09009000 STREAM PROCEDURE WRTINTRSC(SGNO,ALFA,PRT,FIL); 09010000 VALUE SGNO,PRT; 09011000 BEGIN LOCAL COUNT,DEST; 09012000 DI:=FIL; DS:=4 LIT"PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 09013000 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 09014000 BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 09015000 COUNT:=TALLY; DS:=COUNT CHR; DS:=4 LIT") = "; 09016000 SI:=ALFA; SI:=SI+2; DEST:=DI; % SAVE DI. 09017000 DI:=LOC COUNT; DS:=7 LIT"0"; DS:=CHR; % NO OF CHARS IN NAME. 09018000 DI:=DEST; DS:=COUNT CHR; % INT. NAME. 09019000 DS:=29 LIT" INTRINSIC, SEGMENT NUMBER = "; 09020000 SI:= LOC SGNO; DS:=4 DEC; DS:=LIT"."; 09021000 DI:=DI-5; DS:=4 FILL; % JUNK LEADING BLANKS. 09022000 END WRTINTRSC; 09023000 DEFINE STARTINTRSC=426#; 09024000 LABEL L1; 09025000 IDLOC~MKABS(IDARRAY[0]); 09026000 IDLOCTEMP ~ IDLOC; 09027000 LISTOG ~ BOOLEAN(3-ERRORCOUNT.[46:1]); 09028000 BUILDLINE ~ REMOTOG ~ BOOLEAN(ERRORCOUNT.[47:1]); 09028100 REMOTERR ~ BOOLEAN(ERRORCOUNT.[45:1]); %T1409028110 BUILDLINE ~ BUILDLINE OR BOOLEAN(ERRORCOUNT.[44:1]); %T1409028120 ERRORMAX ~ 99 - 79 | REAL(REMOTOG OR REMOTERR); % %T9809028800 ERRORCOUNT ~ 0; 09028900 LASTUSED ~ 4; 09029000 SGNO~1;SGAVL~2;PDINX~0; 09030000 FILENO~DA~1; 09031000 FILETHING ~ 4095; 09031100 MAXSTACK ~ 513; 09032000 09032100 NEXTINFO ~ LASTINFO ~ LASTSEQROW|256+LASTSEQUENCE+1; 09033000 PUTNBUMP(0); 09034000 FILL RETNE WITH "ENTER ","LIBRARY",*,*,*,12; % %T0309034100 NOTPNTED ~ TRUE; %T0309034900 READACARD; COMMENT THIS IS INITIALIZATION OF NCR,FCR, AND 09035000 LCR. SINCE LASTUSED = 4 NO CARDS ARE ACTUALLY READ; 09036000 LASTUSED ~ 1; COMMENT ASSUMES CARD ONLY UNTIL TOLD; 09037000 NXTELBT~1; FAULTLEVEL~32; 09038000 PRTI ~ PRTIMAX ~ 18; 09039000 MRCLEAN ~ TRUE; 09040000 %T0309040100 LNKNDX ~ 63; %M09041000 RECORDLINK ~ 29; %M09041500 TABLEMARKV ~ 127; %A09042000 % %A09043000 % %A09044000 09045000 09046000 09047000 09048000 09049000 09050000 09051000 09052000 09053000 09054000 09055000 FILL TEN[*] WITH %M09056000 OCT1141000000000000, OCT1131200000000000, OCT1121440000000000, %A09057000 OCT1111750000000000, OCT1102342000000000, OCT1073032400000000, %A09058000 OCT1063641100000000, OCT1054611320000000, OCT1045753604000000, %A09059000 OCT1037346545000000, OCT1011124027620000, OCT0001351035564000, %A09060000 OCT0011643245121000, OCT0022214116345200, OCT0032657142036440, %A09061000 OCT0043432772446150, OCT0054341571157602, OCT0065432127413542, %A09062000 OCT0076740555316473, OCT0111053071060221, OCT0121265707274265, %A09063000 OCT0131543271153342, OCT0142074147406233, OCT0152513201307702, %A09064000 OCT0163236041571663, OCT0174105452130240, OCT0205126764556310, %A09065000 OCT0216354561711772, OCT0231004771627437, OCT0241206170175346, %A09066000 OCT0251447626234640, OCT0261761573704010, OCT0272356132665012, %A09067000 OCT0303051561442215, OCT0313664115752660, OCT0324641141345435, %A09068000 OCT0336011371636744, OCT0347413670206535, OCT0361131664625026, %A09069000 OCT0371360241772234, OCT0401654312370703, OCT0412227375067064, %A09070000 OCT0422675274304701, OCT0433454553366061, OCT0444367706263475, %A09071000 OCT0455465667740415, OCT0467003245730520, OCT0501060411731664, %A09072000 OCT0511274514320241, OCT0521553637404312, OCT0532106607305374, %A09073000 OCT0542530351166673, OCT0553256443424452, OCT0564132154331565, %A09074000 OCT0575160607420123, OCT0606414751324147, OCT0621012014361120, %A09075000 OCT0631214417455344, OCT0641457523370635, OCT0651773450267004, %A09076000 OCT0662372362344605, OCT0673071057035747, OCT0703707272645341, %A09077000 OCT0714671151416631, OCT0726047403722377, OCT0737461304707077, %A09078000 OCT0751137556607071, OCT0761367512350710, OCT0771665435043072, %A09078100 OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078200 OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078300 OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078400 OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078500 OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078600 OCT0000000000000000, OCT0000000000000000, OCT0004000000000000, %A09078700 OCT0001000000000000, OCT0001720000000000, OCT0004304000000000, %A09078800 OCT0007365000000000, OCT0005262200000000, OCT0004536640000000, %A09078900 OCT0001666410000000, OCT0000244112000000, OCT0000315134400000, %A09079000 OCT0000400363500000, OCT0000450046042000, OCT0006562057452400, %A09079100 OCT0004316473365100, OCT0005402212262320, OCT0006702654737004, %A09079200 OCT0004463430126605, OCT0007600336154346, OCT0001540425607437, %A09079300 OCT0004070533151346, OCT0005106662003637, OCT0005033043640460, %A09079400 OCT0002241654610574, OCT0002712227752733, OCT0001474675745521, %A09079500 OCT0002014055337045, OCT0004417070626656, OCT0007522706774431, %A09079600 OCT0003447470573537, OCT0006361406732466, OCT0005005571052120, %A09079700 OCT0006207127264544, OCT0001650755141675, OCT0006223150372254, %A09079800 OCT0007670002470727, OCT0007646003207114, OCT0005617404050737, %A09079900 OCT0001163305063126, OCT0007420166277753, OCT0001732422375774, %A09080000 OCT0002321127075373, OCT0003005354714671, OCT0005606650100047, %A09080100 OCT0007150422120060, OCT0003002526544074, OCT0001603254275113, %A09080200 OCT0004144127354335, OCT0007175155247424, OCT0007034410521331, %A09080300 OCT0007664351264561, OCT0003641443541715, OCT0004611754472300; %A09080400 COMMENT THIS IS THE FILL FOR THE SECOND ROW OF INFO: 09081000 THE FIRST ITEMS ARE STREAM RESERVED WORDS, 09082000 THEN ORDINARY RESERVED WORDS, 09083000 THEN INTRINSIC FUNCTIONS; 09084000 FILL INFO[1,*] WITH 09085000 OCT1240000600000400, "2SI000", %256 %M09086000 OCT1250001040000402, "2DI000", %258 %M09087000 OCT1260001460000404, "2CI000", %260 %M09088000 OCT1270001630000406, "5TALLY", %262 %M09089000 OCT1300000530000410, "2DS000", %264 %M09090000 OCT1310000150000412, "4SKIP0", %266 %M09091000 OCT1320001620000414, "4JUMP0", %268 %M09092000 OCT1330000740000416, "2DB000", %270 %M09093000 OCT1340000500000420, "2SB000", %272 %M09094000 OCT1360000730000422, "2SC000", %274 %M09095000 OCT1370001160000424, "3LOC00", %276 %M09096000 OCT1400001170000426, "2DC000", %278 %M09097000 OCT1410001430000430, "5LOCAL", %280 %M09098000 OCT1420000340000432, "3LIT00", %282 %M09099000 OCT1430001036400434, "3SET00", %284 %M09100000 OCT1430001066500436, "5RESET", %286 %M09101000 OCT1430001020500440, "3WDS00", %288 %M09102000 OCT1430001357700442, "3CHR00", %290 %M09103000 OCT1430001057300444, "3ADD00", %292 %M09104000 OCT1430001617200446, "3SUB00", %294 %M09105000 OCT1430000727600450, "3ZON00", %296 %M09106000 OCT1430000417500452, "3NUM00", %298 %M09107000 OCT1430000766700454, "3OCT00", %300 %M09108000 OCT1430000176600456, "3DEC00", %302 %M09109000 OCT1354000260000460, "6TOGGL", "E0000000", %304 %M09110000 OCT1000000110001236, "5ALPHA", %307 %M09111000 OCT1700001030001360, "3AND00", %309 %M09112000 OCT1000000230000525, "5ARRAY", %311 %M09113000 OCT1230000000001067, "5BEGIN", %313 %M09114000 OCT1000000070000503, "7BOOLE", "AN000000", %315 %M09115000 OCT1040000000001122, "5CLOSE", %318 %M09116000 OCT1440000000000655, "7COMME", "NT000000", %320 %M09117000 OCT1000000300000000, "6DEFIN", "E0000000", %323 %M09118000 OCT1750006000000000, "3DIV00", %326 %M09119000 OCT1120000000000000, "2DO000", %328 %M09120000 OCT1000000040000000, "6DOUBL", "E0000000", %330 %M09121000 OCT1000000140001255, "4DUMP0", %333 %M09122000 OCT1140000000001300, "4ELSE0", %335 %M09123000 OCT1150000000001047, "3END00", %337 %M09124000 OCT1650002030001163, "3EQV00", %339 %M09125000 OCT0700000000000644, "5FALSE", %341 %M09126000 OCT1000000250000000, "4FILE0", %343 %M09127000 OCT1160000001200000, "4FILL0", %345 %M09128000 OCT1100000000000000, "3FOR00", %347 %M09129000 OCT1000000240000554, "6FORMA", "T0000000", %349 %M09130000 OCT1450000000000000, "7FORWA", "RD000000", %352 %M09131000 OCT1210000000000604, "2GO000", %355 %M09132000 OCT1200000000000000, "2IF000", %357 %M09133000 OCT1000000170000000, "2IN000", %359 %M09134000 OCT1000000120000000, "7INTEG", "ER000000", %361 %M09135000 OCT1660000000000000, "3IMP00", %364 %M09136000 OCT1000000130000000, "5LABEL", %366 %M09137000 OCT1000000150000613, "4LIST0", %368 %M09138000 OCT1050000000000000, "4LOCK0", %370 %M09139000 OCT1750016000001343, "3MOD00",%372 %M09140000 OCT1000000200000000, "7MONIT", "OR000000", %374 %M09141000 OCT1620000000000000, "3NOT00", %377 %M09142000 OCT1670000430000624, "2OR000", %379 %M09143000 OCT1000000160000000, "3OUT00", %381 %M09144000 OCT1000000010000476, "3OWN00", %383 %M09145000 OCT1000000220000463, "9PROCE", "DURE0000", %385 %M09146000 OCT1010000000000000, "4READ0", %388 %M09147000 OCT1000000100000000, "4REAL0", %390 %M09148000 OCT1220000000001215, "7RELEA", "SE000000", %392 %M09149000 OCT1060000000000000, "6REWIN", "D0000000", %395 %M09150000 OCT1000000020000773, "4SAVE0", %398 %M09151000 OCT1030000000000000, "5SPACE", %400 %M09152000 OCT1460000000000000, "4STEP0", %402 %M09153000 OCT1000000260000000, "6STREA", "M0000000", %404 %M09154000 OCT1000000210000562, "6SWITC", "H0000000", %407 %M09155000 OCT1470000000001275, "4THEN0", %410 %M09156000 OCT1500000000000000, "2TO000", %412 %M09157000 OCT0700000010000000, "4TRUE0", %414 %M09158000 OCT1130000000000000, "5UNTIL", %416 %M09159000 OCT1510000000000000, "5VALUE", %418 %M09160000 OCT1110000000000540, "5WHILE", %420 %M09161000 OCT1520000000000000, "4WITH0", %422 %M09162000 OCT1020000000000531, "5WRITE", %424 %M09163000 OCT0240000000140673, "3ABS00", OCT0000202000700000,%426 %M09164000 OCT0240000000061331, "6ARCTA", "N0000000", OCT0370100001600000,%429 %M09165000 OCT0240000000041100, "3COS00", OCT0531101001500000,%433 %M09166000 OCT0240000000360000, "6ENTIE", "R0000000", OCT0000000001100000,%436 %M09167000 OCT0240000000040000, "3EXP00", OCT0332111002000000,%440 %M09168000 OCT0240000000041352, "2LN000", OCT0353121001700000,%443 %M09169000 OCT0240000000240000, "4SIGN0", OCT0000000001000000,%446 %M09170000 OCT0240000000040000, "3SIN00", OCT0344131001400000,%449 %M09171000 OCT0240000000040515, "4SQRT0", OCT0315141001300000,%452 %M09172000 OCT0240000000441113,"4TIME0", OCT0000000001200000, %455 %M09173000 OCT0150000000040000, "3ZIP00", 0, % 455 %A09174000 OCT0130000000060000, "9OUTPU", "T(W)0000", OCT0000000000100000,%461;09175000 OCT0130000050060000, ":BLOCK", " CONTROL", OCT0000000000200000,%465;09176000 OCT0130000000060000, "8INPUT", "(W)00000", OCT0000000000300000,%469;09177000 OCT0000000000061226, "4SORT0", 0, OCT0000000000400000, % 473 %M09178000 OCT0130000000040000, "4DUMP0", OCT0000000000500000,%477;09179000 OCT0130000000060000, "#X TO ", "THE I000", OCT0000000000600000,%480;09180000 OCT0240000000060000, ":GO TO"," SOLVER ", OCT0570000002100000, %484 %A09181000 OCT0130000140060000, ":ALGOL", " WRITE ", OCT0000000002200000,%488;09182000 OCT0130000150060000, ":ALGOL", " READ ", OCT0000000002300000,%492;09183000 OCT0130000160060000, ":ALGOL", " SELECT ", OCT0000000002400000,%496;09184000 OCT0000000000040000, "5MERGE", OCT0000000002700000,% 500 09184100 OCT0240000000560652, "6STATU", "S0000000", OCT0000000003000000, %M09184200 OCT0240000000641126, "3MAX00", OCT0000000003100031; %T9209185000 FILL INFO[3,*] WITH % %A09185100 OCT0240000000060000,"#SWAP ","ARRAYS ",OCT0000000004500000,% 768 %A09185200 OCT0240000000060000,":FORTE","RR ",OCT0300000013400000,% 772 %A09185300 OCT0240000000060000,":MATRI","XDIDDLER",OCT0000000014100000,% 776 %A09185400 OCT0240000000060000,":MATRI","X INVERT",OCT0000000014200000,% 780 %A09185500 OCT0240000000060000,":MTX T","RANSPOSE",OCT0000000014300000,% 784 %A09185600 OCT0240000000060000,"#MATRI","X MULT ",OCT0000000014400000,% 788 %A09185700 OCT2000000000004050, COMMENT POWERS OF TEN; % 792 %A09185800 0, ":SORT ","TEMPORAR","Y ", COMMENT SORTA; %793 %T9309185900 " "; COMMENT LASTSEQROW, LASTSEQUENCE; % 794 %A09186000 COMMENT THIS IS THE FILL FOR STACKHEAD; 09187000 FILL STACKHEAD[*] WITH 09188000 320,673,678,458,385, 0,337,347,383,361,621,412, 0, 0,681,372, %M09189000 335,758,666, 0,368,695,446, 0, 0,539,311,410, 0, 0,400,721,%T9209190000 0,608,570, 0,630,741,664,606,330,690, 0,579, 0, 0,727,440, %M09191000 390,646,659, 0,414, 0,683,737,452, 0,698, 0, 0, 0,733,561, %M09192000 381,328, 0, 0, 0,750, 0, 0, 0, 0,760,436, 0,402,744,633, %M09193000 748,639,711,573,718,756,416,455,355,687, 0,357,564,542,610, 0,%T9209194000 716, 0,433,602,418,398,343,618,692,326,339,648,714,725,366, 0, %M09195000 0,558, 0, 0, 0,754,656,392, 0,636, 0,675,644; %M09196000 FILL SUPERSTACK[*] WITH %WF 09196100 0,359,313, 0,307, 0,337,347,383, 0,397,412, 0, 0, 0,372,%T9209196200 335,309, 0, 0, 0, 0, 0, 0, 0, 0,420,410, 0, 0, 0, 0, %M09196300 0, 0, 0, 0,630, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %M09196400 390, 0,364, 0,414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %M09196500 0,328, 0, 0, 0, 0, 0, 0, 0, 0,760, 0, 0,402, 0,633, %M09196600 0, 0,377, 0, 0,756,416, 0,355, 0, 0,357, 0, 0, 0, 0, %M09196700 0, 0, 0, 0, 0,398, 0, 0, 0,326,339, 0, 0, 0,366, 0, %M09196800 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,424, 0; %M09196900 COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS; 09197000 FILL SPECIAL[*] WITH 09198000 OCT1550000000200000, COMMENT #; OCT0000000000100000, COMMENT @;%M09199000 OCT0000000000000000, OCT1530000000120000, COMMENT :;%M09200000 OCT1710000450002763, COMMENT >; OCT1710000250002662, COMMENT };%M09201000 OCT1740000200000000, COMMENT +; 0, %M09202000 OCT1570000000060000, COMMENT .; OCT1560000000000000, COMMENT [;%M09203000 OCT1640000000000000, COMMENT &; OCT0740000000000000, COMMENT (;%M09204000 OCT1710010450243571, COMMENT <; OCT1630000000000000, COMMENT ~; %M09205000 OCT1750001000000000, COMMENT |; 0, %M09206000 OCT0000000000040000, COMMENT $; OCT1760000000000000, COMMENT *; %M09207000 OCT1740000600000000, COMMENT -; OCT1610000000160000, COMMENT); %M09208000 OCT1170000000000000, COMMENT .,; OCT1710010250003470, COMMENT {;%M09209000 0, OCT1750002000000000, COMMENT/; %M09210000 OCT1540000000000000, COMMENT ,; OCT0000000000020000, COMMENT %;%M09211000 OCT1710001050002561, COMMENT !; OCT1710011050002460, COMMENT =;%M09212000 OCT1600000000000000, COMMENT ]; OCT0000000000140000, COMMENT ";%M09213000 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 0, %T9209214150 0, %T9209214155 0, %T9209214160 0, %T9209214165 0, %T9209214170 %T9209214180 OCT0240000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000, %T9209214190 OCT0240000000740000, "3MIN00",OCT0000000003200000, % 539 %T9209214200 OCT0240000001040000, "5DELAY", OCT0000000003300000, % 542 %T9209214210 OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400002, %T9209214220 0, 0, % FILLER %M09214225 OCT0240000001140000, "3ARG00", OCT0447500011400000, %551 %T9209214230 OCT0240000001261116, "6ARCSI", "N0000000", OCT0320000011600000,%554 %M09214235 OCT0240000000041107, "3TAN00", OCT0360000011100000, %558 %T9209214240 OCT0240000001340000, "5GAMMA", OCT0400000012600000,%561 %M09214245 OCT0240000001440000, "5COTAN", OCT0000000011200000, %564 %T9209214250 OCT0240000001540000, "5ARCOS", OCT0000000011700000,%567 %M09214255 OCT0240000001640000, "4SINH0", OCT0000000012000000, %570 %T9209214260 OCT0240000001640000, "4COSH0", OCT0000000012100000,%573 %M09214265 OCT0240000001641161, "4TANH0", OCT0000000012200000, %576 %T9209214270 OCT0240000001660000, "6ERROR", "F0000000", OCT0000000012500000,%579 %M09214275 OCT0240000001760000,"7LNGAM","MA ",OCT0000000012700260,% 583 %A09214280 OCT0240000002040000, "3LOG00", OCT0006100000000000,%587 %M09214285 OCT0240000002160000, "8IMAGP", "ART00000", OCT0000300000000000,%590 %M09214290 OCT0240000002261213, "8REALP", "ART00000", OCT0000400000000000,%594 %M09214295 OCT0240000002360000, "6HIPAR", "T0000000", OCT0000000000000000,%598 %M09214300 OCT0240000002460000, "6LOPAR", "T0000000", OCT0000000000000000,%602 %M09214305 OCT0240000002500000, "3TAB00", %606 %M09214310 OCT0240000002600000, "3COL00", %608 %M09214315 OCT0240000002700566, "6INREA", "L0000000", %610 %M09214320 OCT0240000003000571, "4SCAN0", %613 %M09214325 OCT0240000003100000, "7READC" , "ON000000", % 615 %A09214330 OCT0240000003200000, "6LENGT", "H0000000", %618 %M09214335 OCT0240000003300573, "5NPROP", %621 %M09214340 OCT0240000003400000, "4SMTA0", %623 %M09214345 OCT0240000003500000, "4CTSM0", %625 %M09214350 OCT0240000003600000, "6CONVA", "L0000000", %627 %M09214355 OCT1000000030000767, "6STRIN", "G0000000", %630 %M09214360 OCT1000000050001147, "6SYMBO", "L0000000", % 633 %A09214365 OCT1000000060000000, "6RECOR", "D0000000", %636 %M09214370 OCT1000000270000000, "7COMPL", "EX000000", %639 %M09214375 OCT1000000310000650, "5FIELD", %642 %M09214380 OCT0210000000001323, "4CONS0", %644 %M09214385 OCT0750000000000701, "3NIL00", %646 %M09214390 OCT0210000000040000, "6APPEN", "D0000000", %648 %M09214395 OCT0210000000060000, "5NCONC", %651 %M09214400 OCT0210000000101337, "6GENSY", "M0000000", %653 %M09214405 OCT0210000000120000, "6RANDO", "M0000000", %656 %M09214410 OCT0210000000140535, "6MKATO", "M0000000", %659 %M09214415 OCT0210000000160000, "4PROP0", %662 %M09214420 OCT0210000000200000, "5READ1", %664 %M09214425 OCT0210000000220731, "5INSYM", %666 %M09214430 OCT0210000000240000, "4ATSM0", %668 %M09214435 OCT0210000000260000, "6OBLIS", "T0000000", %670 %M09214440 OCT0230000000000547, "4NULL0", %673 %M09214445 OCT0230000000021202, "6MEMBE", "R0000000", %675 %M09214450 OCT0230000000040471, "7NUMBE", "RP000000", %678 %M09214455 OCT0230000000061157, "4ATOM0", %681 %M09214460 OCT0230000000100000, "5ATCON", %683 %M09214465 OCT0230000000121333, "5ATSYM", %685 %M09214470 OCT0260000000000000, "6RETUR", "N0000000", %687 %M09214475 OCT0260000000021234, "4EXIT0", %690 %M09214480 OCT0260000000040000, "7RECLA", "IM000000", %692 %M09214485 OCT0260000000060000, "6RECAL", "L0000000", %695 %M09214490 OCT0260000000100000, "8REMEM", "BER00000", %698 %M09214495 OCT0260000000120000, "7ADDPR", "OP000000", %701 %M09214500 OCT0260000000140000, "7REMPR", "OP000000", %704 %M09214505 OCT0260000000160465, "5PRINT", %707 %T9209214510 OCT0260000000201303, "4PRIN0", %709 %M09214515 OCT0260000000221145, "6TERPR", "I0000000", %711 %T9209214520 OCT0260000000240000, "3NTS00", %714 %M09214525 OCT0260000000260000, "5INPUT", %716 %M09214530 OCT0260000000300000, "6OUTPU", "T0000000", %718 %M09214535 OCT0260000000320000, "5REMOB", %721 %M09214540 OCT0220000000000000, "5RPROP", %723 %M09214545 OCT0170000000000000, "5QMARK", %725 %M09214550 OCT0170000000020000, "3ALF00", %727 %M09214555 OCT0170000000040000, "3DGT00", %729 %M09214560 OCT0170000000060000, "3VWL00", %731 %M09214565 OCT0170000000100000, "3LTR00", %733 %M09214570 OCT0170000000120000, "4BIT10", %735 %M09214575 OCT0170000000140000, "4BIT00", %737 %M09214580 OCT0170000000160000, "5AMONG", %739 %M09214585 OCT0170000000200473, "6OUTST", "R0000000", %741 %M09214590 OCT0170000000220627, "5INSTR", %744 %M09214595 OCT0200000000000000, "4CONJ0", %746 %M09214600 OCT0200000000020000, "5INDBL", %748 %M09214605 OCT1720000000001052, "2EQ000", %750 %M09214610 OCT1720000000020000, "4NEQL0", %752 %M09214615 OCT1070000000000646, "4CASE0", %754 %M09214620 OCT0776700000000000, "3CAR00",%756 %M09214625 OCT0776300000001305, "3CDR00", %758 %M09214630 OCT0240000003740000, "5READN", OCT0000600000000000, % 760 %M09214633 OCT0240000000060000,":DYNAM","IC DIALS",OCT0000000004000001;% 763 %A09214635 COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; %M09214640 FOR NEXTINFO ~ 512 STEP 2 UNTIL 530 DO PUT((TAKE(NEXTINFO))& %T9209214645 STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], %M09214650 LASTINFO ~ STACKHEAD[GT2] ~ NEXTINFO); %M09214655 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 OCT0047, % JFW A 02 09218000 OCT0140, COMMENT INC A 03 ; 09219000 OCT0130, COMMENT SRS A 04 ; 09220000 OCT0117, COMMENT SRD A 05 ; 09221000 OCT0057, % JRV A 06 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 OCT00570143, % CRF A, JRV O 14 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 FILL DPI[*] WITH %T9209251310 OCT41113, OCT42107, OCT47077, OCT51101, OCT43105, %T9209251315 OCT50123, OCT00104, OCT52115, OCT45053, OCT00110, %T9209251320 OCT00100, OCT00102, OCT00106, OCT00124, OCT46065, %T9209251325 "5DATAN", "4DCOS0", "4DEXP0", "4DLOG0", "4DSIN0", %T9209251330 "5DSQRT", "5DLG10", "5DATN2", "4CABS0", "4CCOS0", %M09251350 "4CEXP0", "4CLOG0", "4CSIN0", "5CSQRT", "4DMOD0", %M09251400 COMMENT FOLLOWING ARE TEMPS 1 - 10; %M09251450 143,144,145,146; %A09251500 %T9309251550 PERR ~ -1 ; % INITIALIZE ERRORMESS NUMBER %T1409251600 SINGLTOG ~ TRUE; % %T1109251700 DO UNTIL STEPI = BEGINV; 09252000 BUILDLINE.[45:1]~FALSE; 09252050 IF NOT BUILDLINE THEN BUILDLINE ~ USELINO ~ TRUE; % %T0309252060 IF STEPI=DECLARATORS AND ELBAT[I].ADDRESS = SYMV %M09252100 THEN IF (RECLAIMTOG ~ STEPI=INTRNS AND ELBAT[I].INCR=2) %A09252200 OR (SYMSTK ~ ACCUM[1] = "4PLEX0") THEN BEGIN %A09252300 IF STEPI ! SEMICOLON THEN ERR(0); %M09252400 ELBAT[I].CLASS ~ BEGINV END ELSE I ~ I-2 ELSE I~I-1; %M09252500 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 FUNTION 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);EMITO(MKS); 09272000 GT1~PROGDESCBLDR(3,0,0); 09273000 GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000 % %M09274050 PRTIMAX ~ 23; %A09274100 ENDTOG ~ PRTOG; PRTOG ~ FALSE; %M09274150 FOR GT1 := 23 STEP 1 UNTIL 151 DO GT2 := GETSPACE(TRUE,-1); %T9309274200 PRTOG ~ ENDTOG; ENDTOG ~ FALSE; %M09274250 ERRORTOG~TRUE; BLOCK(FALSE); 09275000 COMMENT THIS CODE WILL PUT AN EXTRA CARD ON 0CRDIMG 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 0CR","DING TAP","E ", " "," ", 09275400 " ","99999999"; 09275450 WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500 END; 09275550 IF INOUTUSED.[46:2]=1 THEN FLAG(645); %M09275600 ERRORTOG ~ TRUE; %A09275625 IF INOUTUSED.[44:2]=1 THEN FLAG(644); %M09275650 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 IF DPI[107] ! 0 THEN BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %A09289100 GT2 ~ PROGDESCBLDR(1,0,24); %A09289200 PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ % %A09289300 1 & 92 [19:39:9] & SGNO[28:38:10] & 1[2:47:1]; %A09289400 PDINX ~ PDINX + 1; END; %A09289500 FOR GT1 ~ 0 STEP 1 UNTIL 14 DO %M09290000 IF GT2 ~ (GT3 ~ DPI[GT1]).ADDRESS ! 0 THEN BEGIN %M09290100 SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %M09290200 GT2 ~ PROGDESCBLDR(1,0,GT2); %M09290300 PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ %M09290400 1 & GT3[19:39:9] &SGNO[28:38:10] & 1[2:47:1]; %M09290500 PDINX ~ PDINX + 1; %M09290600 IF LISTOG THEN BEGIN WRTINTRSC(SGNO,DPI[GT1+15], %M09290700 B2D(GT2.[38:10]),LIN); WRITELINE END END; %M09290800 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][16:21:12] %M09298000 & SGNO[28:38:10] & 1[2:47:1]; 09298100 PDINX ~ PDINX + 1; 09299000 IF LISTOG AND PRTOG THEN % %T0709300000 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 NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); WRITELINE; %T9309302000 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(128,TEN,EDOC[0,0]); MOVE(10,TEN[128],EDOC[1,0]); %A09314000 BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100 SEGMENT(-138,SGNO,0); %A09315000 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 INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE); VALUE SIZE; 09319000 ARRAY FROM[0,0]; INTEGER SIZE; 09320000 BEGIN INTEGER NSEGS,I,J; 09321000 REAL T; 09322000 NSEGS~(SIZE+29) DIV 30; 09323000 IF DA DIV CHUNK" AND LASTELCLASS ! ")" THEN ERR(136); %%W4009500800 ELBAT[I].CLASS ~ IF ELCLASS = "," THEN COMMA %W4009500900 ELSE IF ELCLASS = ")" THEN RTPAREN ELSE 0; %W4009501000 I ~ I-1; BUILDLINE~BUILDLINE.[1:46]; %W4009501100 EMITL(0); EMITPAIR(PRT,LOD); %W4009501200 END ELSE I := I - 1; % %W4009501250 END EXPLICITFORMAT; %W4009501300 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 CHARACTORS 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 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B10070000 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 F ~ F+1; 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 [24: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 ! "(" AND ELCLASS ! "<" ); %W4010113000 IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100 NEXTENT; 10113200 END END; 10113300 IF ELCLASS = "(" OR ELCLASS = "<" %W4010114000 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 ! ">" THEN GO TO EL; %W4010124000 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 = "O" 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 GO TO EXIT %W4010134000 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 U. 10150220 EMITFORMAT(FALSE,RU,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 10257100 10257200 10257300 10257400 10257500 10257600 10257700 10257800 10257900 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 TSTREAMTOG; % %T8910259400 DINFO ~ J.[18:15]; 10259600 J ~ J.[33:15]; 10259700 TB1~ FALSE; 10260000 TSTREAMTOG := STREAMTOG; % %T8910260050 STREAMTOG~TRUE; 10260100 CHARCOUNT ~ 0; 10261000 DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000 REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000 10263100 10263110 K~0; 10263200 BACK: STOPDEFINE~TRUE; 10263300 ELCLASS~TABLE(NXTELBT); 10263400 SKSC: NXTELBT~NXTELBT-1; 10263500 IF MACRO THEN 10263600 BEGIN IF ELCLASS=COMMA THEN 10263700 IF K=0 THEN 10263800 FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900 ELSE GO PACKIN; 10264000 IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100 BEGIN K~K+1; GO TO PACKIN END; 10264200 IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300 IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400 IF ELCLASS=SEMICOLON THEN 10264410 BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420 END; 10264500 IF 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 := TSTREAMTOG; % %T8910284000 NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 END DEFINEGEN; 10286000 INTEGER TEMPCELL, LISTPTR; %W3310286500 BOOLEAN LISTLVFLAG; %W3310286600 COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000 ELEMENTS; 10288000 PROCEDURE LISTELEMENT; 10289000 BEGIN 10290000 INTEGER LISTADDRESS; %W3310290500 REAL T1,T2,T3; 10291000 REAL T4; %M10291500 LABEL BOOFINISH,STORE,LRTS; 10292000 DIALA ~ DIALB ~ 0; 10293000 T4 ~ ACCUM[1];% %A10293100 LISTLVFLAG ~ LISTLVFLAG AND (ELCLASS = LISTID %W3310293200 OR ELCLASS = SUPERLISTID); %W3310293400 IF ELCLASS = FORV THEN BEGIN COMMENT FORCLAUSE; %W3310294000 FORSTMT; LISTLVFLAG ~ FALSE END %W3310294200 ELSE IF ELCLASS = LFTBRKET 10295000 THEN BEGIN COMMENT GROUP OF LIST ELEMENTS; 10296000 DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000 IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 ELSE IF ELCLASS=LISTID OR ELCLASS=SUPERLISTID THEN %W3310298100 BEGIN %W3310298120 IF LISTLVFLAG THEN L ~ L-3; %W3310298160 CHECKER(ELBAT[I]); LISTADDRESS~ELBAT[I].ADDRESS;%W3310298200 EMITL(0);EMITPAIR(LSTRTN,STD); %W3310298240 EMITNUM(L+3-LSTR+REAL(LISTPTR>1023)); %W3310298260 EMITPAIR(LISTPTR,STD); %W3310298280 IF ELCLASS=SUPERLISTID THEN %W3310298300 BEGIN BANA;EMITN(LISTADDRESS);IF LISTADDRESS>1023THEN EMITO(PRTE); %W3310298400 EMITO(LOD); %72 %W3310298430 EMITO(LOD); EMITO(XCH); EMITO(CDC) END %W3310298480 ELSE BEGIN EMITN(LISTADDRESS);STEPIT END; %W3310298500 EMITV(LSTRTN); EMITL(0); EMITO(GEQ); %W3310298600 EMITL(1); EMITO(BFC); EMITO(RTS); %W3310298700 EMITO(DEL); EMITL(5); EMITPAIR(LSTRTN,STD); %W3310298850 LISTLVFLAG ~ TRUE; %W3310298870 END %W3310298900 ELSE IF GT1 ~ TABLE(I+1) = RTPAREN AND L=LSTR %W3310298910 AND ELBAT[I].ADDRESS { 1023 %W3310298915 AND ELCLASS } SYMID AND ELCLASS { INTID THEN %T9310298920 COMMENT LIST CONSISTS OF A SINGLE SIMPLE VAR.; %W3310298930 BEGIN L ~ L-4-REAL(LISTPTR>1023); %W3310298940 CHECKER(ELBAT[I]); %W3310298945 EMITN(ELBAT[I].ADDRESS); EMITO(RTS); %W3310298950 STEPIT; %W3310298960 END %W3310298970 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(LISTPTR,STD); COMMENT PREPARE LISTPTR FOR %W3310302000 NEXT TIME AROUND; 10303000 IF (GT1 = COMMA %W3310304000 OR GT1 = RTPAREN 10305000 OR GT1 = RTBRKET) 10306000 AND ELCLASS } SYMID AND ELCLASS { INTID %T9310307000 THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 CHECKER(ELBAT[I]); 10308100 EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 ELSE IF ELCLASS = 0 THEN% %A10309100 IF T4 = "8FREEL" OR T4 = "7NEXTA" THEN BEGIN% %A10309200 FIXCLASS(INTID,T4,BOOLEAN(3));EMITN(ADDRSF);STEPIT END % %A10309300 ELSE ERR(100)% %A10309400 ELSE BEGIN IF ELCLASS } SYMARRAYID %T9310310000 AND ELCLASS { INTARRAYID 10311000 THEN BEGIN COMMENT IS EITHER A SUBCRIPTED VARIABLE 10312000 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 T4 ~ EXPRSS= DTYPE THEN ERR(156) ELSE %M10327000 IF T4 > 6 THEN ERR(643) ELSE %M10327100 IF T4 = 5 THEN BEGIN EMITO(MKS); EMITV(ATN) END ELSE %M10327200 IF T4 = 6 THEN DBLTSNGL(0); %M10327300 STORE: EMITPAIR(TEMPCELL,STD); EMITN(TEMPCELL) END; %W3310328000 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 COMMENT TEST TO INSURE LISTGEN NOT CALLED RECURSIVELY; %W3310346200 IF LISTMODE THEN ERR(476) ELSE %W3310346400 BEGIN %W3310346600 JUMPLACE ~ BAE; 10347000 LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000 TEMPCELL~GETSPACE(FALSE,-1);LISTPTR~GETSPACE(FALSE,-1);%W3310348500 COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 EMITV(LSTRTN); EMITO(BFW); %W3310349400 EMITL(5); EMITPAIR(LSTRTN,STD); %W3310349600 EMITPAIR(REAL(LISTPTR>1023)+2,BFW); %W3310349800 EMITV(LISTPTR); EMITO(BFW); LSTR ~ L; %W3310350000 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 IF LISTLVFLAG THEN BEGIN L~L-3; LISTLVFLAG~FALSE END; %W3310358500 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 END %W3310368000 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 MERRIMAC 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~(NOPAR 10657000 ~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 INDENTIFIER 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 SUBSLOOP 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); EMITL(FORMATTYPE); EMITV(GNAT(PRINTI));10891000 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 DELIMITER; 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 INTO A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 BOOLEAN PROCEDURE SWITCHGEN(BEFORE); VALUE BEFORE; BOOLEAN BEFORE; 10954000 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 LOCAL(ELBAT[I]) %M10965000 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: NOGO; L ~ BUMPL; N ~ N-1; %M10978000 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; %M10999100 EMITL(N+1); %M10999200 L ~ T1; %M10999300 EXIT: END SWITCHGEN; %M10999400 PROCEDURE BOOINT; %A11000000 BEGIN REAL T; LABEL EXIT; %A11000100 CASE ELBAT[I].INCR OF BEGIN %A11000200 BEGIN IF T ~ TABLE(I+1)=RECID OR T=RECARRAYID %A11000300 OR T=RECPROCID THEN BEGIN STEPIT; REXP; RECTYPE~0 END ELSE %A11000400 EMITI(0,33-PORV|15,15); EMIT(0); EMITO(EQL); END; %A11000500 BEGIN EMITO(MKS);PANSYM(FALSE,TRUE); EMITV(MEMBER ) END; %A11000600 BEGIN GETCONTENTS(PORV,FALSE); EMITI(0,1,2); EMITL(3); %A11000700 EMITO(EQL); END; %A11000800 BEGIN GETCONTENTS(PORV,FALSE); EMIT(0); %A11000900 EMITO(LSS) END; %A11001000 BEGIN QUOTETOG ~ TRUE; %A11001100 IF STEPI = LEFTPAREN THEN BEGIN STEPIT; STRINGSEC(4); %A11001200 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104) END; %A11001300 EMITO(MKS); EMITV(ATCON) END; %A11001400 BEGIN GETCONTENTS(PORV,FALSE); EMITI(0,1,2); EMITL(2); EMITO(EQL); %A11001500 END; END; %A11001600 EXIT: QUOTETOG ~ FALSE END OF BOOINT; %A11001700 % %A11001800 % %A11001900 COMMENT RELATIONAL EXPRESSIONS; %A11002000 % %A11002100 BOOLEAN PROCEDURE SYMRELATION(TYPE); VALUE TYPE; REAL TYPE; %A11002200 BEGIN REAL R; LABEL EXIT; %A11002300 IF ELCLASS=LRELOP THEN BEGIN QUOTETOG ~ TRUE; %A11002400 TYPE ~ SNORM(TYPE); R ~ ELBAT[I].INCR; %A11002500 STEPIT; GT1 ~ SNORM(SEXP); %A11002600 EMITDIAL(DIA,33-15|GT1); EMITDIAL(DIB,33-15|TYPE); %A11002700 EMITFC(FCE,15); EMITO(XCH); EMITO(DEL); %A11002800 IF BOOLEAN(R) THEN EMITO(LNG); %A11002900 QUOTETOG ~ FALSE; GO TO EXIT END ELSE %A11003000 IF ELCLASS ! RELOP OR %A11003100 (R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69) THEN BEGIN SDNORM(TYPE);%A11003200 SYMRELATION ~ TRUE; %A11003300 QUOTETOG ~ FALSE; GO EXIT END; QUOTETOG ~ TRUE; %A11003400 % %A11003500 IF TYPE {2 THEN SDNORM(TYPE) ELSE %A11003600 IF TYPE =5 THEN BEGIN EMITNUM(SAVEQ); TYPE ~0 END ELSE %A11003700 IF TYPE= 4 THEN BEGIN EMITNUM(SAVEQ); TYPE ~3 END; %A11003800 STEPIT; GT1 ~ SEXP; QUOTETOG ~ FALSE; %A11003900 IF GT1 { 2 THEN SDNORM(GT1) ELSE %A11004000 IF GT1}4 THEN BEGIN EMITNUM(SAVEQ); %A11004100 GT1 ~ IF GT1 = 5 THEN 0 ELSE 3 END; %A11004200 IF TYPE+GT1 = 6 THEN EMITO(R) ELSE BEGIN %A11004300 IF TYPE = 3 OR GT1 = 3 THEN BEGIN %A11004400 IF TYPE = 3 THEN EMITO(XCH); EMITO(MKS); %A11004500 EMITV(SYMEQA) END ELSE %A11004600 BEGIN EMITO(MKS); EMITV(SYMEQ); END; EMITO(DEL) END ; %A11004700 IF R = 69 THEN EMITO(LNG); %A11004800 EXIT: END OF SYMRELATION; %A11004900 BOOLEAN PROCEDURE DBLPLXRELATION; %A11005000 BEGIN LABEL EXIT; REAL R , TYPE; DBLPLXRELATION~TRUE; %A11005100 IF ELCLASS ! RELOP THEN GO EXIT; %A11005200 IF R ~ ELBAT[I].ADDRESS ! 581 AND R! 69 THEN GO EXIT; %A11005300 DPTOG ~ TRUE; STEPIT; PLXNORM(PLXP(TRUE),TRUE);%A11005400 FOR TYPE ~ 0 STEP 1 UNTIL 2 DO BEGIN %A11005500 DBLNORM; DBLSTO(TRUE,1+2|TYPE,STD)END; DBLNORM; %A11005600 TYPE ~ IF R=581 THEN LND ELSE LOR; DPTOG ~ FALSE; %A11005700 EMITV(TEMP(3)); EMITO(R); EMITO(XCH); EMITV(TEMP(4)); %A11005800 EMITO(R); EMITO(TYPE); EMITV(TEMP(5)); EMITV(TEMP(1)); %A11005900 EMITO(R); EMITO(TYPE); EMITV(TEMP(6)); EMITV(TEMP(2)); %A11006000 EMITO(TYPE); DBLPLXRELATION ~ FALSE; %A11006100 EXIT: END OF DBLPLXRELATION; %A11006200 % %A11006300 BOOLEAN PROCEDURE PLXRELATION; %A11006400 BEGIN REAL R; LABEL EXIT; PLXRELATION ~ TRUE; %A11006500 IF ELCLASS! RELOP THEN GO EXIT; %A11006600 IF R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69 THEN GO EXIT; %A11006700 STEPIT; PLXNORM(PLXP(FALSE),FALSE); %A11006800 EMITPAIR(TEMP1,STD); EMITO(XCH); EMITPAIR(TEMP2,STD); %A11006900 EMITO(R); EMITV(TEMP1); EMITV(TEMP2); EMITO(R); %A11007000 EMITO(IF R=581 THEN LND ELSE LOR); PLXRELATION~FALSE; %A11007100 EXIT: END OF PLXRELATION; %A11007200 % %A11007300 BOOLEAN PROCEDURE DBLRELATION; %A11007400 BEGIN REAL R; LABEL EXIT; DBLRELATION ~ TRUE; %A11007500 IF ELCLASS ! RELOP THEN GO EXIT; %A11007600 R ~ ELBAT[I].ADDRESS; %A11007700 DBLNORM; %A11007800 DPTOG ~ TRUE; STEPIT; DBLXP; DPTOG ~ FALSE; DBLNORM; %A11007900 EMITPAIR(TEMP1,STD); EMITO(XCH); EMITPAIR(TEMP2,STD); EMITO(R); %A11008000 EMITV(TEMP2); EMITV(TEMP1); %A11008100 IF R = 581 THEN BEGIN EMITO(581); EMITO(LND); END ELSE %A11008200 IF R = 69 THEN BEGIN EMITO(69); EMITO(LOR); END ELSE %A11008300 BEGIN EMITO(581); EMITO(LND); EMITV(TEMP2); EMITV(TEMP1); %A11008400 EMITO(R); EMITO(LOR) END; DPTOG ~ FALSE; %A11008500 DBLRELATION ~ FALSE; %A11008600 EXIT: END OF DBLRELATION; %A11008700 % %A11008800 BOOLEAN PROCEDURE RECRELATION(TYPE); VALUE TYPE; REAL TYPE; %A11008900 BEGIN REAL R; LABEL EXIT; %A11009000 RECRELATION ~ TRUE; %A11009100 IF ELCLASS ! RELOP THEN GO TO EXIT; %A11009200 IF R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69 THEN GO EXIT; %A11009300 STEPIT; RECOM(TYPE); EMITO(R); RECRELATION ~ FALSE; %A11009400 EXIT: END OF RECRELATION; %A11009500 % %A11009600 % %A11009700 % %A11009800 BOOLEAN PROCEDURE ARAY(TALL,WDS,ROWTOG); %A11009900 VALUE TALL,WDS,ROWTOG; %A11010000 REAL TALL,WDS; BOOLEAN ROWTOG; %A11010100 BEGIN LABEL LX,NEXT; %A11010200 REAL X,Z; %A11010300 INTEGER J,DM; %A11010400 BOOLEAN DPO,SM; %A11010500 BOOLEAN QO; QO ~ QUOTETOG; QUOTETOG ~ FALSE; %A11010600 DPO ~ DPTOG; IF SM~SMT THEN EMITO(MKS); %A11010700 DPTOG ~ SMT ~ FALSE; %A11010800 IF STEPI! LFTBRKET THEN BEGIN ERR(207); GO TO LX END; %A11010900 DM ~ TAKE(GIT(TALL)).[40:8]; J ~ 0; %A11011000 NEXT: IF ARAY ~ STEPI= FACTOP THEN BEGIN %A11011100 STLB ~ 1; %A11011200 WHILE TABLE(I+1) = COMMA DO %A11011300 BEGIN STEPIT; %A11011400 IF STEPI = FACTOP THEN STLB ~ STLB + 1 ELSE %A11011500 BEGIN ERR(204); GO TO LX END; END; %A11011600 IF J+STLB!DM THEN BEGIN ERR(203); GO TO LX END; %A11011700 IF STEPI!RTBRKET THEN BEGIN ERR(204); GO TO LX END; %A11011800 IF NOT ROWTOG.[45:1] THEN %A11011900 IF STLB > 1 THEN FLAG(212) ELSE %A11012000 IF NOT ROWTOG THEN BEGIN ERR(205); GO LX END; %A11012100 IF J=0 THEN EMITPAIR(TALL.ADDRESS,LOD); %A11012200 IF ROWTOG.[45:1] THEN BEGIN %A11012300 IF ROWTOG.[46:1] THEN BEGIN EMITNUM(TAKE(GIT(TALL)+DM+1).[35:13]) %A11012400 END; %A11012500 FOR X ~ 1 STEP 1 UNTIL STLB DO %A11012600 BEGIN IF (Z ~ TAKE(GIT(TALL)+J+X)).[35:11] > 1023 %A11012700 THEN EMITV(Z) ELSE EMIT(Z); %A11012800 IF Z.[23:10] = ADD THEN EMITO(CHS); END END; %A11012900 STEPIT; %A11013000 GO TO LX END; %A11013100 AEXP; IF SM THEN EMITPAIR(JUNK,SND); %A11013200 IF ELCLASS = RTBRKET THEN %A11013300 IF WDS!0 THEN BEGIN EMITL(WDS); EMITO(MUL) END; %A11013400 IF (GT1 ~ TAKE(GIT(TALL)+ J~J+1)).[35:13] ! 0 THEN BEGIN %A11013500 IF GT1.[46:2] =0 THEN EMIT(GT1) ELSE EMITV(GT1.[35:11]); %A11013600 EMIT(GT1.[23:12]) END; %A11013700 IF ELCLASS=COMMA THEN BEGIN %A11013800 IF J=1 THEN EMITN(TALL.ADDRESS) ELSE EMITO(CDC); %A11013900 EMITO(LOD); %A11014000 IF SM THEN BEGIN EMITV(JUNK); EMITO(XCH); END; %A11014100 IF J+1> DM THEN BEGIN ERR(206); GO TO LX END; %A11014200 GO TO NEXT END; %A11014300 IF ELCLASS!RTBRKET THEN BEGIN ERR(206); GO TO LX END; %A11014400 IF J!DM THEN ERR(208); %A11014500 ROWTOG ~ (STEPI=ASSIGNOP) OR ROWTOG OR %A11014600 ((ELCLASS = COMMA OR ELCLASS = RTPAREN) AND ROWTOG.[45:1]); %A11014700 IF ROWTOG THEN BEGIN IF J =1 THEN %A11014800 EMITN(TALL.ADDRESS) ELSE EMITO(CDC); %A11014900 IF SM THEN BEGIN EMITV(JUNK); EMITO(XCH); END; END ELSE %A11015000 IF WDS ! 0 THEN BEGIN %A11015100 IF J = 1 THEN BEGIN EMITPAIR(TMP,SND); %A11015200 EMITV(J ~ TALL.ADDRESS); WDS ~ WDS - 1; %A11015300 FOR GT1 ~ 1 STEP 1 UNTIL WDS DO BEGIN %A11015400 EMITV(TMP); EMITL(GT1); EMITO(ADD); EMITV(J) END END ELSE %A11015500 BEGIN %A11015600 WDS ~ WDS -2; %A11015700 EMITPAIR(TMP,STD); EMITO(DUP); EMITV(TMP); %A11015800 EMITO(COC); EMITO(XCH); %A11015900 FOR GT1 ~ 1 STEP 1 UNTIL WDS DO BEGIN %A11016000 EMITO(DUP); EMITV(TMP); EMITL(GT1); EMITO(ADD); %A11016100 EMITO(COC); EMITO(XCH); END; %A11016200 EMITV(TMP); EMITL(WDS+1); EMITO(ADD); EMITO(COC) END %A11016300 END %A11016400 ELSE IF J = 1 THEN EMITV(TALL.ADDRESS) ELSE EMITO(COC); %A11016500 IF ROWTOG.[46:1] THEN BEGIN %A11016600 IF GT1 ~ TAKE(GIT(TALL) + DM + 1).[35:13] > 8 THEN EMITO(LOD); %A11016700 EMITNUM(GT1) END; %A11016800 LX: QUOTETOG ~ QO; DPTOG ~ DPO; %A11016900 END OF ARAY; %A11017000 % %A11017100 PROCEDURE GENEXP(R); VALUE R; REAL R; %A11017200 BEGIN %B11017300 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11017400 IF R > 29 THEN BEGIN STEPIT; RECOM(R) END ELSE %A11017500 CASE R-1 OF BEGIN %A11017600 BEGIN STEPIT; BEXP END; %A11017700 BEGIN STEPIT; DEXP END; %A11017800 BEGIN STEPIT; AEXP END; %A11017900 ; BEGIN QUOTETOG ~ TRUE; STEPIT; SEXPN; QUOTETOG~FALSE END; %A11018000 DBLPLXP(0); %A11018100 DBLPLXP(1); %A11018200 DBLPLXP(2); END; %A11018300 END; %B11018400 % %A11018500 PROCEDURE IFXP(R); VALUE R; REAL R; %A11018600 BEGIN INTEGER B,S; %A11018700 QUOTETOG ~ DPTOG ~ FALSE; %A11018800 STEPIT; STACKCT ~ 0; BEXP; %A11018900 IF ELCLASS ! THENV THEN ERR(116); %A11019000 STACKCT ~ 0; B ~ BUMPL; GENEXP(R); STACKCT ~ 0; %A11019100 S ~ BUMPL; EMITB(BFC,B,L); %A11019200 IF ELCLASS ! ELSEV THEN ERR(155) ELSE %A11019300 BEGIN GENEXP(R); STACKCT ~1; EMITB(BFW,S,L); %A11019400 EMIT(1); L ~ L - 1 END %A11019500 END IFXP; %A11019600 % %A11019700 PROCEDURE EMITCONVAL; %A11019800 BEGIN LABEL EXIT,L; INTEGER T; %A11019900 IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11020000 BEGIN %A11020100 IF STEPI ! LITNO THEN BEGIN %A11020200 L: ERR(609); GO EXIT END; %A11020300 IF T ~ ELBAT[I].ADDRESS } 40 THEN GO L; %A11020400 STEPIT; %A11020500 IF T > 1 AND T < 36 THEN EMITV(T+104) ELSE %A11020600 IF T = 37 THEN BEGIN EMITV(COLSET); %A11020700 IF ELCLASS = COMMA THEN BEGIN STEPIT; AEXP; %A11020800 EMITPAIR(COLSET,STD) END END ELSE %A11020900 IF T = 0 THEN BEGIN %A11021000 IF ELCLASS = COMMA THEN BEGIN %A11021100 STEPIT; AEXP; EMITPAIR(RND,STD) END; %A11021200 EMITO(MKS); EMITV(RANDNO); END ELSE %A11021300 IF T = 1 THEN EMITV(RND) ELSE %A11021400 IF T = 36 THEN EMITV(TABLEMARK) ELSE %A11021500 ERR(686);% %A11021600 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11022200 END; %A11022300 EXIT: %A11022400 END OF EMITCONVAL; %A11022500 % %A11022600 % %A11022700 % %A11022800 COMMENT DOUBLE EXPRESSIONS; %A11022900 BOOLEAN PROCEDURE DIVOP(OP); VALUE OP; REAL OP; %A11023000 DIVOP ~ OP.[40:8]=128; %A11023100 % %A11023200 PROCEDURE DBLXCH(BV,J); %A11023300 VALUE BV,J; %A11023400 BOOLEAN BV; INTEGER J; %A11023500 IF BV THEN BEGIN %A11023600 EMITPAIR(TEMP(J),STD); EMITO(XCH); EMITPAIR(TEMP(J+1),STD); %A11023700 EMITO(XCH); EMITV(TEMP(J)); EMITO(XCH); %A11023800 EMITV(TEMP(J+1)); END %A11023900 ELSE EMITO(XCH); %A11024000 % %A11024100 PROCEDURE DBLSTO(BV,J,OPER); %A11024200 VALUE BV,J,OPER; %A11024300 BOOLEAN BV; INTEGER J,OPER; %A11024400 IF BV THEN BEGIN %A11024500 EMITPAIR(TEMP(J),OPER); IF OPER=SND THEN EMITO(XCH); %A11024600 EMITPAIR(TEMP(J+1),OPER); IF OPER=SND THEN EMITO(XCH) %A11024700 END %A11024800 ELSE EMITPAIR(TEMP(J),OPER); %A11024900 % %A11025000 PROCEDURE DBLEMITV(BV,J); %A11025100 VALUE BV,J; %A11025200 BOOLEAN BV; INTEGER J; %A11025300 BEGIN IF BV THEN %A11025400 EMITV(TEMP(J+1)); %A11025500 EMITV(TEMP(J)) END; %A11025600 % %A11025700 PROCEDURE DBLDUP; %A11025800 IF DPTOG THEN %A11025900 BEGIN %A11026000 EMITPAIR(JUNK,STD); EMITO(DUP); %A11026100 EMITV(JUNK); EMITO(XCH); EMITV(JUNK) %A11026200 END %A11026300 ELSE EMITO(DUP); %A11026400 % %A11026500 PROCEDURE EMITDV(OP,BV); VALUE OP,BV; REAL OP; BOOLEAN BV; %A11026600 BEGIN %B11026700 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11026800 IF OP ~ OP.[38:2]=0 THEN EMITO(128+REAL(BV)) ELSE %A11026900 IF OP = 1 THEN IF BV THEN BEGIN %A11027000 DBLTSNGL(5); EMITO(384); EMIT(0); EMITO(XCH) END ELSE %A11027100 EMITO(384) ELSE %A11027200 IF BV THEN BEGIN DBLSTO(TRUE,5,STD); %A11027300 DBLSTO(TRUE,7,STD); EMITO(MKS); %A11027400 DBLEMITV(TRUE,7); DBLEMITV(TRUE,5); EMITV(GNATP(14)) %A11027500 ; EMITV(JUNK); %A11027600 END ELSE EMITO(896); %A11027700 END; %B11027800 % %A11027900 PROCEDURE DBLPLXVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11028000 BEGIN REAL TALL,STR,ADR,TYPE,ADS; %A11028100 REAL R; %A11028200 BOOLEAN ARTOG,V; LABEL EXIT,L; %A11028300 ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); %A11028400 TYPE ~ TAKE(TALL.LINK+1).[2:2]; %A11028500 IF ELCLASS=DBLPLXPROCID THEN BEGIN STEPIT; %A11028600 DBLPLXP(TYPE); EMITPAIR(514,STD); %A11028700 ADS ~ TAKE(TALL.LINK+ TALL.INCR).[30:10]; %A11028800 IF TYPE!2 THEN TYPE~0; %A11028900 FOR ADR ~ 1 STEP 1 UNTIL TYPE DO BEGIN %A11029000 EMITPAIR(ADS,STD); ADS~ADS+1 END; %A11029100 IF FROM THEN EMITPAIR(ADS,STD) ELSE %A11029200 BEGIN EMITPAIR(ADS,SND); %A11029300 FOR ADR~1 STEP 1 UNTIL TYPE DO EMITV(ADS~ADS-1); %A11029400 EMITV(514) END END ELSE %A11029500 BEGIN V ~ TALL.[9:2]=2; %A11029600 ADR ~ ADR & TALL[1:9:1]; %A11029700 IF ARTOG ~ ELCLASS = DBLPLXARRAYID THEN BEGIN %A11029800 IF ARAY(TALL,IF TYPE=2 THEN 4 ELSE 2,FALSE) THEN %A11029900 BEGIN ERR(610); GO EXIT END END ELSE %A11030000 BEGIN IF V THEN EMITN(ADR); STEPIT END; %A11030100 IF ELCLASS=ASSIGNOP THEN BEGIN L: DPTOG ~ TYPE ! 1; STEPIT; %A11030200 IF ARTOG OR V THEN BEGIN EMITO(DUP); EMITL(1); %A11030300 EMITO(XCH); EMITO(INX); %A11030400 IF TYPE = 2 THEN BEGIN EMITO(DUP); EMITL(1); EMITO(XCH); %A11030500 EMITO(INX); EMITO(DUP); EMITL(1); EMITO(XCH); EMITO(INX); %A11030600 END END; %A11030700 IF TYPE=0 THEN BEGIN R ~ 12; DBLXP; END ELSE R ~ PLXP(TYPE=2); %A11030800 DPTOG ~ FALSE; %A11030900 IF ARTOG OR V THEN BEGIN %A11031000 PLXNORM(R,TYPE=2); %A11031100 IF TYPE = 2 THEN BEGIN EMITPAIR(JUNK,STD); EMITPAIR(NSTR,STD); %A11031200 EMITPAIR(39,STD); EMITPAIR(40,STD); EMITV(JUNK); %A11031300 EMITO(XCH); EMITO(STD); EMITV(NSTR); EMITO(XCH); %A11031400 EMITO(STD); EMITV(39); EMITO(XCH); EMITO(STD); %A11031500 EMITV(40); EMITO(XCH); %A11031600 IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); %A11031700 EMITV(39); EMITV(NSTR); EMITV(JUNK); END END ELSE %A11031800 BEGIN EMITO(XCH); EMITPAIR(JUNK,STD); EMITO(XCH); %A11031900 IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); EMITO(XCH); %A11032000 END; EMITV(JUNK); EMITO(XCH); %A11032100 IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); %A11032200 EMITO(XCH); END END END ELSE %A11032300 BEGIN V~ TYPE=2; TYPE ~ IF FROM THEN STD ELSE SND; %A11032400 IF R<4 THEN BEGIN IF R}2 THEN EMITO(CHS); %A11032500 IF BOOLEAN(R) THEN BEGIN EMITPAIR(ADR+REAL(V),TYPE); %A11032600 IF V THEN BEGIN IF NOT FROM THEN EMITO(XCH); %A11032700 EMITPAIR(ADR,TYPE); IF NOT FROM THEN EMITO(XCH); END; %A11032800 EMIT(0); %A11032900 IF V THEN BEGIN EMITPAIR(ADR+3,SND); EMITPAIR(ADR+2,TYPE); %A11033000 IF NOT FROM THEN EMITO(DUP) END ELSE %A11033100 EMITPAIR(ADR+1,TYPE); END ELSE %A11033200 BEGIN IF V THEN EMITPAIR(ADR+3,STD); %A11033300 EMITPAIR(ADR+1+REAL(V),STD); EMIT(0); %A11033400 IF V THEN EMITPAIR(ADR+1,SND); EMITPAIR(ADR,TYPE); %A11033500 IF NOT FROM THEN BEGIN IF V THEN EMIT(0); %A11033600 EMITV(ADR+1+REAL(V)); %A11033700 IF V THEN EMITV(ADR+3) END END END ELSE %A11033800 BEGIN IF BOOLEAN(R.[41:1]) THEN EMITO(CHS); %A11033900 ADS~ IF BOOLEAN(R.[42:1]) THEN 0 ELSE 1; %A11034000 IF V THEN BEGIN EMITPAIR(ADR+1+2|ADS,STD); %A11034100 EMITPAIR(2|ADS+ADR,STD) END ELSE %A11034200 BEGIN EMITPAIR(ADR+ADS,TYPE); IF NOT FROM THEN EMITO(XCH) %A11034300 END; IF BOOLEAN(R.[43:1]) THEN EMITO(CHS); ADS ~ 1-ADS; %A11034400 IF V THEN BEGIN %A11034500 IF FROM OR BOOLEAN(ADS) THEN BEGIN %A11034600 EMITPAIR(ADR+1+2|ADS,STD); EMITPAIR(ADR+2|ADS,STD); %A11034700 IF NOT FROM THEN BEGIN EMITV(ADR); EMITV(ADR+1) END %A11034800 END ELSE BEGIN EMITPAIR(ADR+1,SND); EMITO(XCH); %A11034900 EMITPAIR(ADR,SND); EMITO(XCH) END; %A11035000 IF NOT FROM THEN BEGIN EMITV(ADR+2); EMITV(ADR+3) END %A11035100 END ELSE %A11035200 BEGIN EMITPAIR(ADR+ADS,TYPE); %A11035300 IF NOT FROM THEN %A11035400 IF NOT BOOLEAN(ADS) THEN EMITO(XCH) END %A11035500 END END END ELSE %A11035600 IF FROM THEN ERR(145) ELSE %A11035700 IF NOT ARTOG THEN BEGIN %A11035800 TYPE ~ IF TYPE =2 THEN 3 ELSE 1; %A11035900 IF V THEN BEGIN %A11036000 FOR TALL~ 1 STEP 1 UNTIL TYPE DO BEGIN EMITO(DUP); %A11036100 EMITL(1); EMITO(INX); EMITO(XCH); EMITO(LOD); %A11036200 EMITO(XCH); END; %A11036300 EMITO(LOD) END ELSE %A11036400 FOR TALL ~ 0 STEP 1 UNTIL TYPE DO EMITV(ADR+TALL); %A11036500 END END; %A11036600 EXIT: END DBLPLXVAR; %A11036700 % %A11036800 PROCEDURE DBLINT; %A11036900 BEGIN REAL T,R; LABEL EXIT; %A11037000 IF GT1 ~ (T ~ ELBAT[I]).[33:2] = 0 THEN BEGIN %A11037100 DPTOG ~ FALSE; %A11037200 EMIT(0); IMPFUN END ELSE %A11037300 CASE (T ~ TAKE(T.LINK+GT1)).[12:3] OF BEGIN %A11037400 BEGIN DPTOG ~ FALSE; EMIT(0); IMPFUN END; %A11037500 BEGIN PANDBL(TRUE); EMITV(GNATP(T.[9:3])); EMITV(JUNK) END; %A11037600 BEGIN T ~ L; EMITO(NOP); %A11037700 IF PANPLX(FALSE,TRUE) < 4 THEN EMITO(SSP) ELSE %A11037800 BEGIN R ~ L; L ~ T; EMITO(MKS); L ~ R; %A11037900 DBLSTO(TRUE,1,STD); DPTOG ~ TRUE; DBLDUP; EMITO(ML2); %A11038000 DBLEMITV(TRUE,1); DBLEMITV(TRUE,1); EMITO(ML2); %A11038100 EMITO(AD2); EMITV(DSQRT); EMITV(JUNK) END; %A11038200 END; %A11038300 IF R ~ PANPLX(FALSE,TRUE) < 4 THEN %A11038400 IF BOOLEAN(R) THEN BEGIN %A11038500 IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %A11038600 BEGIN EMITO(DEL); EMITO(DEL); EMIT(0); EMIT(0) END ELSE %A11038700 IF BOOLEAN(R.[42:1]) THEN BEGIN EMITPAIR(JUNK,STD); %A11038800 EMITO(XCH); EMITO(DEL); EMITO(XCH); EMITO(DEL); EMITV(JUNK); %A11038900 IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END %A11039000 ELSE BEGIN EMITO(DEL); EMITO(DEL); %A11039100 IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END; %A11039200 IF R ~ PANPLX(FALSE,TRUE) < 4 THEN %A11039300 IF BOOLEAN(R) THEN BEGIN EMITO(DEL); EMITO(DEL); %A11039400 EMIT(0); EMIT(0) END ELSE %A11039500 BEGIN IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %A11039600 IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(DEL); EMITO(DEL); %A11039700 IF BOOLEAN(R.[43:1]) THEN EMITO(CHS); END ELSE %A11039800 BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITO(DEL); %A11039900 EMITO(XCH); EMITO(DEL); EMITV(JUNK); %A11040000 IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END; %A11040100 BEGIN PLXNORM(PANPLX(TRUE,TRUE),TRUE); EMITV(GNATP(7)); %A11040200 EMITV(17) END; %A11040300 BEGIN EMIT(0); EMITO(MKS); %A11040400 IF STEPI = LEFTPAREN THEN BEGIN STEPIT; %A11040410 IF Q ~ ACCUM[1] = "3TWX00" THEN EMITL(5) ELSE %A11040420 IF Q = "4TWXA0" THEN EMITL(10) ELSE FLAG(665); %A11040430 IF STEPI! RTPAREN THEN ERR(104) ELSE STEPIT END ELSE EMIT(0); %A11040440 EMITL(1); EMITV(READN); END; END; %A11040450 EXIT: END OF DBLINT; %A11040500 % %A11040600 PROCEDURE DBLPRIM; %A11040700 BEGIN LABEL EXIT; %A11040800 REAL T; %A11040900 IF ELCLASS= INTRNSICPROCID THEN DBLINT ELSE BEGIN %A11041000 IF ELCLASS}DBLPLXTRNS AND ELCLASS{DBLPLXARRAYID THEN %A11041100 IF (T ~ ELCLASS - STRTRNS).[45:3]= 1 THEN %A11041200 IF TAKE(ELBAT[I].LINK+1).[2:2]=0 THEN BEGIN %A11041300 CASE T DIV 8 OF BEGIN %A11041400 IF BOOLEAN(ELBAT[I].[34:1]) THEN BEGIN %A11041500 ELBAT[I].ADDRESS ~ INDBL; %A11041600 ELBAT[I].CLASS~ DBLPLXID; DBLPLXVAR(FALSE) END %A11041700 ELSE ERR(611); %A11041800 STRMPROCSTMT; %A11041900 PROCSTMT(FALSE); DBLPLXVAR(FALSE); DBLPLXVAR(FALSE); END; %A11042000 GO EXIT END; %A11042100 IF ELCLASS=LEFTPAREN THEN BEGIN I~I-1; PANDBL(FALSE) END ELSE %A11042200 IF ELCLASS=NONLITNO THEN BEGIN EMITNUM(NLO); EMITNUM(NHI); %A11042300 STEPIT END ELSE %A11042400 IF ACCUM[1] = "3TEN00" THEN BEGIN BANA; EMITPAIR(JUNK,ISN); %T9311042500 EMITO(DUP); %T9311042550 EMITL(69); EMITO(ADD); EMITV(GNAT(POWERSOFTEN)); EMITO(XCH);%A11042600 EMITV(105) END ELSE %A11042650 BEGIN EMIT(0); DPTOG ~ FALSE; PRIMARY END END; %A11042700 EXIT: END OF DBLPRIM; %A11042800 % %A11042900 PROCEDURE DBLEXP; %A11043000 BEGIN EMITO(MKS); DBLPRIM; EMITV(DBLFACT); END; %A11043100 % %A11043200 PROCEDURE DBLSEC; %A11043300 BEGIN %B11043400 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11043500 IF ELCLASS = ADOP THEN %A11043600 BEGIN %A11043700 STEPIT; %A11043800 IF ELBAT[I-1].ADDRESS ! ADD THEN %A11043900 BEGIN %A11044000 DBLPRIM; %A11044100 WHILE ELCLASS = FACTOP DO %A11044200 BEGIN DPTOG ~ TRUE; STEPIT; DBLEXP END; %A11044300 ENDTOG~LINKTOG; EMITO(CHS); %A11044400 LINKTOG~ENDTOG; ENDTOG~FALSE %A11044500 END %A11044600 ELSE DBLPRIM %A11044700 END %A11044800 ELSE DBLPRIM; %A11044900 END; %B11045000 % %A11045100 PROCEDURE DBLCOMP; %A11045200 BEGIN REAL OPCLASS, OPERATOR; %A11045300 DO BEGIN %A11045400 OPERATOR~ ELBAT[I].ADDRESS; %A11045500 OPCLASS ~ ELCLASS; %A11045600 DPTOG ~TRUE; %A11045700 STEPIT; %A11045800 IF OPCLASS = FACTOP %A11045900 THEN DBLEXP %A11046000 ELSE BEGIN %A11046100 DBLPRIM; %A11046200 DPTOG ~ TRUE; %A11046300 WHILE OPCLASS < ELCLASS DO DBLCOMP; %A11046400 IF DIVOP(OPERATOR) THEN %A11046500 EMITDV(OPERATOR,TRUE) ELSE EMITO(OPERATOR+1) %A11046600 END %A11046700 END UNTIL OPCLASS ! ELCLASS; %A11046800 END DBLCOMP; %A11046900 % %A11047000 PROCEDURE SIMPDBL; %A11047100 WHILE ELCLASS } ADOP DO DBLCOMP; %A11047200 % %A11047300 PROCEDURE DBLXP; %A11047400 BEGIN %A11047500 DPTOG~TRUE; %A11047600 IF ELCLASS = CASEV %A11047700 THEN CASESTMT(13) ELSE %A11047800 IF ELCLASS = IFV %A11047900 THEN IFXP(6) ELSE %A11048000 BEGIN DBLSEC; SIMPDBL END; %A11048100 % %A11048200 END DBLXP; %A11048300 % %A11048400 PROCEDURE PANDBL(V); VALUE V; BOOLEAN V; %A11048500 BEGIN %B11048600 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11048700 IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11048800 BEGIN IF V THEN EMITO(MKS); DPTOG ~ TRUE; %A11048900 STEPIT; DBLXP; %A11049000 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END; %A11049100 DPTOG ~ FALSE; %A11049200 END; %B11049300 COMMENT COMPLEX EXPRESSIONS; %A11049400 % %A11049500 INTEGER PROCEDURE PAIR(R1,R2); VALUE R1,R2; REAL R1,R2; %A11049600 PAIR~4 & R1[41:46:2] & R2[43:46:2]; %A11049700 % %A11049800 PROCEDURE PLXNORM(R,BV); %A11049900 VALUE R,BV; %A11050000 REAL R; %A11050100 BOOLEAN BV; %A11050200 BEGIN INTEGER T1,T2; %A11050300 IF R < 4 THEN %A11050400 BEGIN %A11050500 IF BOOLEAN(R.[46:1]) THEN EMITO(CHS); %A11050600 EMITL(0); %A11050700 IF BV THEN EMITL(0); %A11050800 IF BOOLEAN(R) THEN ELSE DBLXCH(BV,1); %A11050900 END ELSE %A11051000 BEGIN %A11051100 T1~R.TS; T2~R.NS; %A11051200 IF BOOLEAN(T1.[46:1]) THEN EMITO(CHS); %A11051300 IF BOOLEAN(T2.[46:1]) THEN %A11051400 BEGIN DBLXCH(BV,1); EMITO(CHS); %A11051500 IF BOOLEAN(T2) THEN DBLXCH(BV,1) END ELSE %A11051600 IF BOOLEAN(T1) THEN DBLXCH(BV,1) %A11051700 END %A11051800 END OF PLXNORM; %A11051900 % %A11052000 INTEGER PROCEDURE PLXOP(OP,R1,R2,BV); %A11052100 VALUE OP,R1,R2,BV; %A11052200 REAL OP,R1,R2; BOOLEAN BV; %A11052300 BEGIN %B11052400 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11052500 IF OP = MUL THEN BEGIN %A11052600 PLXOP~(R1+R2) MOD 4; %A11052700 EMITO(MUL + REAL(BV)) END ELSE %A11052800 IF DIVOP(OP) THEN BEGIN %A11052900 PLXOP~(4 + R1 - R2) MOD 4; %A11053000 EMITDV(OP,BV) END ELSE %A11053100 BEGIN PLXOP~R1; %A11053200 IF R1 = R2 THEN EMITO(OP + REAL(BV)) ELSE %A11053300 IF NOT BOOLEAN(R1 + R2) THEN %A11053400 EMITO(IF OP = ADD THEN (SUB + REAL(BV)) ELSE %A11053500 (ADD + REAL(BV))) ELSE %A11053600 PLXOP ~ PAIR(IF OP=ADD THEN R2 ELSE R2+2,R1) %A11053700 END; %A11053800 END; %B11053900 % %A11054000 INTEGER PROCEDURE PLXOP2(OPCLASS,R1,R2,BV); %A11054100 VALUE OPCLASS,R1,R2,BV; %A11054200 REAL OPCLASS,R1,R2; BOOLEAN BV; %A11054300 BEGIN %A11054400 REAL T1,T2,TS1,TS2,T; %A11054500 DEFINE OP= OPCLASS#, %A11054600 NS1 = T1#, %A11054700 NS2 = T2#; %A11054800 DPTOG ~ BV; %A11054900 IF R2 < 4 THEN %A11055000 IF R1 < 4 THEN %A11055100 PLXOP2~PLXOP(OP,R1,R2,BV) ELSE %A11055200 BEGIN %A11055300 T1~R1.TS; %A11055400 T2~R1.NS; %A11055500 IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11055600 IF BOOLEAN(T1+R2) THEN %A11055700 BEGIN %A11055800 DBLXCH(BV,1); %A11055900 DBLSTO(BV,1,STD); %A11056000 PLXOP2~PAIR(T1,PLXOP(OP,T2,R2,BV)); %A11056100 DBLEMITV(BV,1) %A11056200 END %A11056300 ELSE PLXOP2~PAIR(PLXOP(OP,T1,R2,BV),T2) %A11056400 ELSE BEGIN %A11056500 DBLSTO(BV,1,SND); %A11056600 R1 ~ PLXOP(OP,T1,R2,BV); %A11056700 DBLXCH(BV,3); %A11056800 DBLEMITV(BV,1); %A11056900 PLXOP2~PAIR(PLXOP(OP,T2,R2,BV),R1) %A11057000 END %A11057100 END %A11057200 ELSE %A11057300 IF R1 < 4 THEN %A11057400 BEGIN %A11057500 T1~R2.TS; %A11057600 T2~R2.NS; %A11057700 IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11057800 BEGIN %A11057900 IF BOOLEAN(T2+R1) THEN %A11058000 BEGIN %A11058100 DBLXCH(BV,1); %A11058200 T~T1; %A11058300 T1~T2; %A11058400 T2~T %A11058500 END; %A11058600 DBLSTO(BV,1,STD); %A11058700 IF OP = SUB THEN T1 ~ T1 + 2; %A11058800 PLXOP2~PAIR(T1,PLXOP(OP,R1,T2,BV)); %A11058900 DBLEMITV(BV,1) %A11059000 END %A11059100 ELSE BEGIN %A11059200 IF DIVOP(OP) THEN %A11059300 BEGIN %A11059400 T1~(4-T1) MOD 4; %A11059500 T2~(4-T2) MOD 4 %A11059600 END; %A11059700 DBLSTO(BV,1,STD); %A11059800 DBLSTO(BV,3,STD); %A11059900 DBLDUP; %A11060000 DBLEMITV(BV,3); %A11060100 R2~PLXOP(MUL,R1,T2,BV); %A11060200 DBLXCH(BV,5); %A11060300 DBLEMITV(BV,1); %A11060400 PLXOP2~PAIR(PLXOP(MUL,R1,T1,BV),R2); %A11060500 IF DIVOP(OP) THEN %A11060600 BEGIN %A11060700 DBLEMITV(BV,1); %A11060800 DBLDUP; %A11060900 EMITO(MUL + REAL(BV)); %A11061000 DBLEMITV(BV,3); %A11061100 IF BV THEN DBLEMITV(BV,3) ELSE EMITO(DUP); %A11061200 EMITO(MUL + REAL(BV)); %A11061300 EMITO(ADD + REAL(BV)); %A11061400 DBLSTO(BV,1,SND); %A11061500 EMITDV(OP,BV); %A11061600 DBLXCH(BV,5); %A11061700 DBLEMITV(BV,1); %A11061800 EMITDV(OP,BV); %A11061900 DBLXCH(BV,1) %A11062000 END %A11062100 END %A11062200 END %A11062300 ELSE BEGIN %A11062400 TS1~R1.TS; %A11062500 NS1~R1.NS; %A11062600 TS2~R2.TS; %A11062700 NS2~R2.NS; %A11062800 IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11062900 BEGIN %A11063000 IF BOOLEAN(NS2 + TS1) THEN %A11063100 BEGIN %A11063200 DBLXCH(BV,1); %A11063300 T~TS2; %A11063400 TS2~NS2; %A11063500 NS2~T %A11063600 END; %A11063700 DBLSTO(BV,1,STD); %A11063800 R2~PLXOP(OP,TS1,NS2,BV); %A11063900 DBLXCH(BV,3); %A11064000 DBLEMITV(BV,1); %A11064100 PLXOP2~PAIR(PLXOP(OP,NS1,TS2,BV),R2) %A11064200 END %A11064300 ELSE BEGIN %A11064400 IF DIVOP(OP) THEN %A11064500 BEGIN %A11064600 TS2~(4-TS2) MOD 4; %A11064700 NS2~(4-NS2) MOD 4 %A11064800 END; %A11064900 DBLSTO(BV,1,STD); %A11065000 DBLSTO(BV,3,STD); %A11065100 DBLSTO(BV,5,STD); %A11065200 DBLDUP; %A11065300 DBLEMITV(BV,3); %A11065400 R2~PLXOP(MUL,NS1,NS2,BV); %A11065500 DBLEMITV(BV,5); %A11065600 DBLEMITV(BV,1); %A11065700 R1~PLXOP(MUL,TS1,TS2,BV); %A11065800 R1~PLXOP(ADD,R2,R1,BV); %A11065900 DBLXCH(BV,7); %A11066000 DBLEMITV(BV,1); %A11066100 R2~PLXOP(MUL,NS1,TS2,BV); %A11066200 DBLEMITV(BV,5); %A11066300 DBLEMITV(BV,3); %A11066400 R2~PLXOP(ADD,R2,PLXOP(MUL,TS1,NS2,BV),BV); %A11066500 IF OP = MUL THEN PLXOP2~PAIR(R2,R1) %A11066600 ELSE BEGIN %A11066700 DBLEMITV(BV,1); %A11066800 IF BV THEN DBLEMITV(BV,1) ELSE EMITO(DUP); %A11066900 EMITO(MUL + REAL(BV)); %A11067000 DBLEMITV(BV,3); %A11067100 IF BV THEN DBLEMITV(BV,3) ELSE EMITO(DUP); %A11067200 EMITO(MUL + REAL(BV)); %A11067300 EMITO(ADD + REAL(BV)); %A11067400 DBLSTO(BV,1,SND); %A11067500 EMITDV(OP,BV); %A11067600 DBLXCH(BV,3); %A11067700 DBLEMITV(BV,1); %A11067800 EMITDV(OP,BV); %A11067900 PLXOP2~PAIR(R1,R2) %A11068000 END %A11068100 END %A11068200 END; %A11068300 END OF PLXOP2; %A11068400 % %A11068500 REAL PROCEDURE PLXINT(BV); VALUE BV; BOOLEAN BV; %A11068600 BEGIN %A11068700 REAL K; LABEL EXIT; %A11068800 DPTOG ~ FALSE; %A11068900 IF K ~ ELBAT[I].[33:2]! 0 THEN BEGIN %A11069000 CASE (K ~ TAKE(ELBAT[I].LINK+K)).[18:3] OF BEGIN %A11069100 IF BV THEN DBLINT ELSE IMPFUN; %A11069200 BEGIN PLXNORM(PANPLX(TRUE,FALSE),FALSE); EMITV(GNATP(K.[15:3]+9)); %A11069300 IF BV THEN BEGIN EMIT(0); EMITO(XCH); EMIT(0) END; %A11069400 EMITV(JUNK); PLXINT ~ 12 END; %A11069500 IF BV THEN DBLINT ELSE IMPFUN; END; %A11069600 GO EXIT END; %A11069700 IF BV THEN DBLINT ELSE IMPFUN; %A11069800 EXIT: END OF PLXINT; %A11069900 % %A11070000 REAL PROCEDURE PLXPRIM(BV); VALUE BV; BOOLEAN BV; %A11070100 BEGIN REAL J,R,K; LABEL EXIT, L; %A11070200 REAL T; %A11070300 DPTOG ~ FALSE; %A11070400 WHILE ELCLASS= COLON DO BEGIN J~J+1; STEPIT END; %A11070500 IF ELCLASS= INTRNSICPROCID THEN R ~ PLXINT(BV) ELSE BEGIN %A11070600 IF ELCLASS= FIELDID AND K ~ ELBAT[I].ADDRESS{ 2 THEN %A11070700 BEGIN R ~ 12; FIELDC(ELBAT[I],0,FALSE); GO L END ELSE %A11070800 IF ELCLASS}DBLPLXTRNS AND ELCLASS{DBLPLXARRAYID THEN %A11070900 IF (T ~ ELCLASS-STRTRNS).[45:3] =1 THEN BEGIN %A11071000 IF K ~ TAKE(ELBAT[I].LINK+1).[2:2] =0 THEN R ~0 ELSE R ~ 12; %A11071100 CASE T DIV 8 OF BEGIN BEGIN IF BV THEN K~0 ELSE K~1; %A11071200 IF BOOLEAN(ELBAT[I].[34:1]) THEN %A11071300 IF BV THEN DBLPRIM ELSE PRIMARY ELSE %A11071400 BEGIN R ~ PANPLX(FALSE,BV); %A11071500 IF R < 4 THEN BEGIN IF BOOLEAN(R) THEN R ~ (R+2)MOD 4 %A11071600 END ELSE %A11071700 IF BOOLEAN(R.[42:1]) THEN R ~ R & (R.TS+2)[41:46:2] ELSE %A11071800 R ~ R & (R.NS+2) [43:46:2] END; %A11071900 END; %A11072000 STRMPROCSTMT; PROCSTMT(FALSE); %A11072100 DBLPLXVAR(FALSE); DBLPLXVAR(FALSE); END; %A11072200 L: IF BV AND K=1 THEN %A11072300 IF R<4 THEN BEGIN EMIT(0); EMITO(XCH) END ELSE %A11072400 BEGIN EMITPAIR(JUNK,STD); EMIT(0); EMITO(XCH); %A11072500 EMIT(0); EMITV(JUNK) END ELSE %A11072600 IF K!1 AND NOT BV THEN DBLTSNGL(R); %A11072700 GO TO EXIT END; %A11072800 IF ELCLASS=LEFTPAREN THEN BEGIN I~I-1; R ~ PANPLX(FALSE,BV); %A11072900 GO EXIT END ELSE %A11073000 IF BV THEN DBLPRIM ELSE PRIMARY; R ~ 0; END; %A11073100 EXIT: IF R < 4 THEN PLXPRIM ~ (R+J).[46:2]ELSE %A11073200 PLXPRIM ~ R & (R.TS+J)[41:46:2] %A11073300 & (R.NS+J)[43:46:2] %A11073400 END OF PLXPRIM; %A11073500 % %A11073600 REAL PROCEDURE PLEXP(R,BV); VALUE R,BV; REAL R; BOOLEAN BV; %A11073700 BEGIN %B11073800 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11073900 % %A11074000 IF R > 4 OR BOOLEAN(R) THEN BEGIN PLEXP ~ 12; %A11074100 PLXNORM(R,BV); EMITO(MKS); IF BV THEN DBLPRIM ELSE PRIMARY; %A11074200 EMITV(IF BV THEN DBLPLXFACT ELSE PLXFACT) END ELSE %A11074300 BEGIN IF R = 2 THEN EMITO(CHS); %A11074400 IF BV THEN DBLEXP ELSE %A11074500 BEGIN PRIMARY; EMITUP END END; %A11074600 % %A11074700 END OF PLEXP; %A11074800 % %A11074900 INTEGER PROCEDURE PLXCOMP(R1,BV); %A11075000 VALUE R1,BV; INTEGER R1; BOOLEAN BV; %A11075100 BEGIN REAL OPERATOR,R2,OPCLASS; %A11075200 DO BEGIN %A11075300 OPERATOR~ELBAT[I].ADDRESS; %A11075400 OPCLASS ~ ELCLASS; %A11075500 DPTOG ~ BV; %A11075600 STEPIT; %A11075700 IF OPCLASS = FACTOP THEN R1~ PLEXP(R1,BV) %A11075800 ELSE BEGIN R2~PLXPRIM(BV); %A11075900 WHILE OPCLASS < ELCLASS DO %A11076000 R2~PLXCOMP(R2,BV); %A11076100 R1~PLXOP2(OPERATOR,R1,R2,BV) %A11076200 END %A11076300 END UNTIL OPCLASS ! ELCLASS; %A11076400 PLXCOMP~R1; %A11076500 END OF PLXCOMP; %A11076600 % %A11076700 INTEGER PROCEDURE SIMPLX(R,BV); VALUE R,BV; INTEGER R; BOOLEAN BV; %A11076800 BEGIN WHILE ELCLASS } ADOP DO R~PLXCOMP(R,BV); %A11076900 SIMPLX~R END; %A11077000 % %A11077100 INTEGER PROCEDURE PLXSEC(BV); VALUE BV; BOOLEAN BV; %A11077200 BEGIN REAL R; %A11077300 IF ELCLASS = ADOP THEN BEGIN %A11077400 IF ELBAT[I].ADDRESS ! ADD THEN %A11077500 BEGIN %A11077600 STEPIT; %A11077700 R~PLXPRIM(BV); %A11077800 WHILE ELCLASS = FACTOP DO BEGIN DPTOG ~ BV; %A11077900 STEPIT; R ~ PLEXP(R,BV) END; %A11078000 PLXSEC~IF R < 4 THEN (R+2) MOD 4 %A11078100 ELSE 4 & (R.[43:2] + 2)[43:46:2] %A11078200 & (R.[41:2] + 2)[41:46:2] %A11078300 END %A11078400 ELSE BEGIN STEPIT; PLXSEC~PLXPRIM(BV) END %A11078500 END ELSE PLXSEC~PLXPRIM(BV) %A11078600 END OF PLXSEC; %A11078700 % %A11078800 REAL PROCEDURE PANPLX(V,A); VALUE V,A; BOOLEAN V,A; %A11078900 BEGIN %B11079000 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11079100 IF STEPI! LEFTPAREN THEN ERR(105) ELSE BEGIN %A11079200 IF V THEN EMITO(MKS); %A11079300 DPTOG ~ A; %A11079400 STEPIT; PANPLX ~ PLXP(A); %A11079500 DPTOG ~ FALSE; %A11079600 IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT END; %A11079700 END; %B11079800 % %A11079900 PROCEDURE PLXPN(BV); VALUE BV; BOOLEAN BV; %A11080000 BEGIN DPTOG ~ BV; STEPIT; PLXNORM(PLXP(BV),BV); DPTOG ~ FALSE END; %A11080100 % %A11080200 PROCEDURE DBLPLXP(TYPE); VALUE TYPE; REAL TYPE; %A11080300 IF TYPE=0 THEN BEGIN DPTOG ~ TRUE; STEPIT; %A11080400 DBLXP; DPTOG ~ FALSE END ELSE PLXPN(TYPE=2); %A11080500 % %A11080600 INTEGER PROCEDURE PLXP(BV); VALUE BV; BOOLEAN BV; %A11080700 BEGIN %B11080800 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11080900 IF ELCLASS = CASEV %A11081000 THEN BEGIN PLXP~12; %A11081100 CASESTMT(1 & (7 + REAL(BV))[43:44:4]) %A11081200 END ELSE %A11081300 IF ELCLASS = IFV %A11081400 THEN BEGIN PLXP~12; %A11081500 IFXP(7 + REAL(BV)) END ELSE %A11081600 PLXP~SIMPLX(PLXSEC(BV),BV); %A11081700 END; %B11081800 % THE FOLLOWING FOR RECORD EXPRESSIONS %A11081900 % %A11082000 PROCEDURE FIELDC(EL,PR,FROM); VALUE EL,PR,FROM; REAL EL,PR; %A11082100 BOOLEAN FROM; %A11082200 BEGIN REAL T1,T2,T3,FCLASS; %A11082300 REAL T; BOOLEAN B; %A11082400 BOOLEAN PART; LABEL EXIT; REAL CR; %A11082500 LABEL LRX; BOOLEAN SYMTF; %A11082550 DEFINE TEMP1 = TMP#; %A11082600 BOOLEAN PROCEDURE CHECKTYPE(EL,RTYPE); VALUE EL,RTYPE; %A11082700 REAL EL,RTYPE; %A11082800 BEGIN REAL S; DEFINE T = RTYPE#; REAL R; %A11082900 LABEL EXIT; %A11083000 CHECKTYPE ~ TRUE; %A11083100 T ~ TAKE(R~GIT(RECARRAY[RTYPE])); %A11083200 FOR S ~ 1 STEP 1 UNTIL T DO %A11083300 IF TAKE(R+S) = EL THEN BEGIN CHECKTYPE~FALSE; GO EXIT END; %A11083400 EXIT: END OF CHECKTYPE; %A11083500 FCLASS ~ EL.ADDRESS; %A11083600 IF BOOLEAN(PR) THEN %A11083700 IF FCLASS=STRINGV THEN BEGIN EMITPAIR(TMP,SND); %A11083800 EMITO(MKS); EMITV(TMP); END %A11083900 ELSE EMITO(DUP); %A11084000 T1 ~ TAKE(GIT(EL)); %A11084100 IF BOOLEAN(PR) THEN BEGIN %A11084200 T3 ~ GNATR(PR.[26:6]); %A11084300 IF T ~ PR.[32:7] + T1.[8:7] > T1.[15:7] THEN %A11084400 BEGIN ERR(635); GO EXIT END; %A11084500 END ELSE %A11084600 BEGIN %A11084700 IF T1 < 0 THEN BEGIN BANA; EMITO(DUP); EMITO(DUP); %A11084800 EMITL(T1.[8:7]); EMITO(LSS); EMITO(XCH); %A11084900 EMITL(T1.[15:7]); EMITO(GTR); EMITO(LOR); %A11085000 B ~ TRUE; %A11085100 EMITERR(SGNO,L,"15") END ELSE %A11085200 BEGIN STEPIT; T ~ T1.[8:7] END; %A11085300 IF ELCLASS ! LEFTPAREN THEN BEGIN %A11085400 ERR(105); GO EXIT END ELSE %A11085500 STEPIT; IF NOT RECLAIMTOG THEN BEGIN% %A11085600 IF SYMTF ~ ELCLASS = SYMID OR ELCLASS = SYMARRAYID OR %A11085610 ELCLASS = CHAINOP OR %A11085612 ELCLASS = SYMTRNS OR %A11085615 (ELCLASS = FIELDID AND ELBAT[I].ADDRESS = SYMV) THEN %A11085620 BEGIN SEXPN; QUOTETOG ~ FCLASS=SYMV; %A11085630 IF B THEN EMITO(INX) ELSE %A11085635 IF T ! 0 THEN BEGIN EMITL(T); EMITO(INX) END; B~FALSE END %A11085640 ELSE GO LRX END ELSE BEGIN LRX: REXP; %A11085650 IF RECTYPE = 0 THEN BEGIN ERR(612); GO EXIT END; %A11085700 T3 ~ GNATR(WTYPE ~ RECTYPE); %A11085800 IF CHECKTYPE(EL.[35:13],RECTYPE) THEN BEGIN %A11085900 FLAG(636); ERRORTOG ~ TRUE END; %A11086000 END; %A11086050 IF ELCLASS ! RTPAREN THEN BEGIN %A11086100 ERR(104); GO EXIT END; %A11086200 STEPIT; END; %A11086300 IF NOT SYMTF THEN BEGIN %A11086350 T3 ~ TAKE(T3).ADDRESS; %A11086400 CR ~ REAL(ELCLASS=ASSIGNOP OR BOOLEAN(PR)).[47:1]; %A11086500 END; %A11086550 T2 ~ T1.[35:13]; PART ~ (T1~T1.[22:13])!0; %A11086600 IF FCLASS = STRINGV THEN BEGIN %A11086700 SLT ~ SPT ~ FALSE; SL ~ T2; %A11086800 IF SYMTF THEN BEGIN SYMSTK.[46:1] ~ TRUE; %A11086810 GETCONTENTS(0,TRUE); %A11086815 IF SL + (SP~T1) > 8 THEN FLAG(669) END ELSE %A11086820 BEGIN SP ~ T | 8 + T1; %A11086830 FIXRECORD(T3,CR); %A11086900 IF BOOLEAN(PR) THEN BEGIN QUOTETOG ~ TRUE; %A11087000 WTYPE ~ 4; %A11087100 ELCLASS~ ASSIGNOP; SYMSEC~ TRUE; STRINGSEC(2); %A11087200 QUOTETOG ~ FALSE END; %A11087300 END; %A11087400 GO EXIT END; %A11087500 % %A11087600 IF ELCLASS = ASSIGNOP OR BOOLEAN (PR) THEN BEGIN %A11087700 IF SYMTF THEN GETCONTENTS(0,TRUE); %A11087750 QUOTETOG ~ FCLASS = SYMV; STEPIT; %A11087800 IF FCLASS > INTV THEN RECOM(FCLASS) ELSE %A11087900 IF FCLASS = SYMV THEN SEXPN ELSE %A11088000 IF FCLASS = BOOV THEN BEXP ELSE AEXP; %A11088100 IF FROM THEN QUOTETOG ~ FALSE; %A11088200 IF PART OR B THEN EMITPAIR(TEMP1,STD) ELSE EMITO(XCH); %A11088300 IF NOT SYMTF THEN BEGIN %A11088350 FIXRECORD(T3,CR); %A11088400 IF B THEN EMITO(XCH) ELSE EMITL(T); EMITO(CDC); %A11088500 END; %A11088550 IF PART THEN BEGIN EMITO(DUP); EMITO(LOD); EMITV(TEMP1); %A11088600 EMITD(48-T2,T1,T2); EMITO(XCH); EMITO(STD); %A11088700 IF NOT FROM THEN EMITV(TEMP1) END ELSE %A11088800 BEGIN IF B THEN BEGIN EMITV(TEMP1); EMITO(XCH) END; %A11088900 EMITO(IF FROM THEN STD ELSE SND) END END ELSE %A11089000 IF FROM THEN ERR(685) ELSE% %A11089100 BEGIN IF SYMTF THEN GETCONTENTS(0,FALSE) ELSE %A11089150 BEGIN FIXRECORD(T3,CR); %A11089200 IF B THEN EMITO(XCH) ELSE EMITL(T); %A11089300 EMITO(COC); END; IF PART THEN EMITI(0,T1,T2); %A11089400 IF FCLASS > 29 THEN RECTYPE ~ FCLASS END; %A11089500 EXIT: IF FROM OR BOOLEAN(PR) THEN RECTYPE ~ 0; %A11089600 END OF FIELDC; %A11089700 % %A11089800 PROCEDURE FIXRECORD(R,A); VALUE R,A; REAL R,A; %A11089900 BEGIN REAL T,P; %A11090000 IF A = 2 THEN EMIT(0); EMITO(MKS); %A11090100 P ~ TAKE(GIT((T~RECARRAY[R]).[22:13])); %A11090200 IF A < 5 THEN BEGIN %A11090300 IF A = 2 THEN EMITN(P.[26:11]+1) ELSE EMIT(0); %A11090400 EMITN(P.[26:11]); END; %A11090500 EMITN(R~T.[11:11]); EMITN(R+1); EMITN(R+2); EMITL(P.[16:10]); %A11090600 EMITL(5); EMITN(TAKE(T.[22:13]).ADDRESS); %A11090700 EMITPAIR(P.[37:11],LOD); EMITL(A); EMITV(RECLINK); %A11090800 IF A = 4 THEN EMITO(DEL); END FIXRECORD; %A11090900 % %A11091000 PROCEDURE GENRECORD(R,B); VALUE R,B; REAL R; BOOLEAN B; %M11091100 BEGIN REAL A,S,T,P; %A11091200 IF B THEN WHILE R ~ R + 1 { RECORDLINK DO BEGIN %M11091300 EMITL(((A~ GNATR(R)).[6:5] - 1) | 2); EMITPAIR(A.[11:11],STD); %A11091400 S ~ A.[22:13]; %A11091500 IF T ~ TAKE(S~GIT(S)) > 0 THEN BEGIN %M11091600 EMITARRAY(T.[37:11],T.[2:5]|2,T.[16:10],FALSE);PUT(-T,S); %A11091700 BEGIN EMITL(T.[7:9]); EMITPAIR(T.[26:11]+1,STD) END END %A11092300 END ELSE WHILE R ~ R + 1 { RECORDLINK DO %A11092400 IF TAKE((S~(A~RECARRAY[R]).[22:13])+1).[2:2]!1 THEN BEGIN %A11092500 FIXRECORD(R,5); %A11092600 END;% %A11092700 END OF GENRECORD; %A11093400 % %A11093500 PROCEDURE RECVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11093600 BEGIN REAL TALL,STR,ADR,TYPEV; %A11093700 BOOLEAN ARTOG; %A11093800 LABEL EXIT; %A11093900 ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); TYPEV ~ GETYPE(TALL);%A11094000 IF ARTOG ~ ELCLASS = RECARRAYID THEN BEGIN %A11094100 IF ARAY(TALL,0,FALSE) THEN GO EXIT END ELSE STEPIT; %A11094200 IF ELCLASS=ASSIGNOP THEN BEGIN %A11094300 STEPIT; RECOM(TYPEV); STR ~ IF FROM THEN STD ELSE SND; %A11094400 IF FROM THEN RECTYPE ~ 0; %A11094500 IF ARTOG THEN BEGIN EMITO(XCH); EMITO(STR) END ELSE %A11094600 IF TALL.[9:2]=2 THEN BEGIN EMITN(ADR); EMITO(STR) END ELSE %A11094700 EMITPAIR(ADR,STR) END ELSE %A11094800 IF FROM THEN ERR(202) ELSE BEGIN %A11094900 IF NOT ARTOG THEN EMITV(ADR); RECTYPE ~ TYPEV END; %A11095000 EXIT: END RECVAR; %A11095100 % %A11095200 PROCEDURE RECOM(R); VALUE R; REAL R; %A11095300 BEGIN REXP; IF R ! RECTYPE AND RECTYPE ! 0 THEN FLAG(613); %A11095400 ERRORTOG ~ TRUE END; %A11095500 % %A11095600 PROCEDURE REXP; %A11095700 BEGIN REAL T; %A11095800 LABEL EXIT; %A11095900 REAL R, JR; LABEL LR;% %A11096000 IF ELCLASS}RECTRNS AND ELCLASS{RECARRAYID AND ELCLASS!22 THEN %A11096100 IF (GT1 ~ ELCLASS-STRTRNS).[45:3]=3 THEN %A11096200 IF GT1 } 24 THEN RECVAR(FALSE) ELSE% %A11096300 IF GT1 = 19 THEN PROCSTMT(FALSE) ELSE% %A11096400 ERR(612) ELSE ERR(612) ELSE% %A11096500 IF ELCLASS=NILV THEN BEGIN RECTYPE ~ 0; STEPIT; %A11097000 EMITL(0); END ELSE %A11097100 IF ELCLASS = DECLARATORS AND % %A11097200 T ~ (JR ~ ELBAT[I]).ADDRESS > FIELDV THEN% %A11097300 IF STEPI = LFTBRKET THEN BEGIN I ~ I - 1 ; BANA;% %A11097350 LR: RECTYPE ~ T ; GO EXIT END ELSE% %A11097400 BEGIN FIXRECORD (T,2); %A11097450 IF ELCLASS ! LEFTPAREN THEN GO LR;% %A11097460 BEGIN REAL J,A,B,K,PR,S; %A11097500 LABEL EXIT;% %A11097600 PR ~ 1 & T [26:42:6];% %A11097700 B ~ TAKE (J ~ GIT (JR)).[40:8];% %A11097800 FOR A ~ 1 STEP 1 UNTIL B DO BEGIN %A11097900 QUOTETOG ~ K ~(R~TAKE((S~TAKE(J+A)).[35:13])&S[35:35:13]).ADDRESS %A11098000 = SYMV OR K = STRINGV; %A11098100 IF K ~ TABLE(I+1) = FACTOP THEN %A11098200 % %A11098300 % %A11098400 BEGIN STEPIT; STEPIT END ELSE %A11098500 IF K = LFTBRKET THEN BEGIN K ~ -1; %A11098600 STEPIT; %A11098700 DO IF TABLE(I+1)=FACTOP THEN BEGIN STEPIT; STEPIT; K~K+1 END %A11098800 ELSE FIELDC(R,PR&(K~K+1)[32:41:7],TRUE) UNTIL ELCLASS!COMMA; %A11098900 IF ELCLASS=RTBRKET THEN STEPIT ELSE %A11099000 BEGIN ERR(614); GO EXIT END END ELSE %A11099100 FIELDC(R,PR,TRUE); %A11099200 IF A=B THEN %A11099300 IF ELCLASS= RTPAREN THEN STEPIT ELSE %A11099400 BEGIN ERR(104); GO EXIT END ELSE %A11099500 IF ELCLASS ! COMMA THEN BEGIN %A11099600 ERR(606); GO EXIT END; %A11099700 QUOTETOG ~ FALSE; END; %A11099800 RECTYPE ~ T; %A11099900 EXIT: %A11100000 END END ELSE% %A11100100 IF ELCLASS = FIELDID AND T > FIELDV THEN% %A11100200 FIELDC(JR,0,FALSE) ELSE ERR(612);% %A11100300 EXIT: END REXP; %A11101300 % THE FOLLOWING FOR SYMBOL EXPRESSIONS %A11101400 % %A11101500 PROCEDURE CONSIT; %A11101600 BEGIN LABEL EXIT; BOOLEAN BV; %A11101700 REAL P,R,S,T; LABEL L; %A11101800 IF STEPI = LFTBRKET THEN BEGIN BV ~ TRUE; %A11101810 DO BEGIN %A11101820 IF STEPI ! FIELDID THEN BEGIN L: %A11101830 ERR(682);% %A11101900 GO EXIT END; %A11101910 IF T ~ TAKE(GIT(S~ELBAT[I])) < 0 THEN GO L; %A11101920 R ~ T.[22:13]; %A11101930 IF BV THEN BEGIN BV ~ FALSE; P ~ T.[8:7]; %A11102000 IF R ! 0 THEN EMIT(0); END ELSE %A11102010 IF R = 0 OR T.[8:7] ! P THEN GO L; %A11102020 IF STEPI ! COLON THEN BEGIN ERR(681); GO EXIT END;% %A11102030 QUOTETOG ~ S ~ S.ADDRESS = SYMV; STEPIT; %A11102100 IF S > INTV THEN RECOM(S) ELSE %A11102110 IF S = SYMV THEN SEXPN ELSE %A11102120 IF S = BOOV THEN BEXP ELSE AEXP; RECTYPE ~ 0; %A11102130 IF R ! 0 THEN EMITD(48 - (T~T.[35:13]),R,T); %A11102200 END UNTIL ELCLASS ! COMMA; %A11102210 IF ELCLASS=RTBRKET THEN STEPIT ELSE ERR(607); %A11102220 QUOTETOG ~ TRUE; GENSYMLINK; GO EXIT END ELSE %A11102230 IF ELCLASS ! LEFTPAREN THEN BEGIN EMIT(0); %A11102300 GENSYMLINK; GO EXIT END; %A11102310 STEPIT; %A11102320 BEGIN SEXPN; %A11102400 IF RECLAIMTOG THEN BEGIN EMITO(SSP); MARKSYMNCR(1) END END; %A11102500 IF NOTCOMMA THEN GO EXIT; %A11102600 EMIT(0); %A11102700 SEXPN; EMITO(CTC); %A11102800 MARKSYMNCR(1); %A11102900 EMITO(XCH); %A11103000 IF ELCLASS = RTPAREN THEN STEPIT ELSE BEGIN ERR(104); GO %A11103100 EXIT END; %A11103200 EMITO(CTF); %A11103500 GENSYMLINK; MARKSYMDCR(-2+REAL(BV)); %A11103600 EXIT: %A11103700 END OF CONSIT; %A11103800 % %A11103900 PROCEDURE GENLIST; %A11104000 BEGIN REAL DC,T; %A11104100 LABEL EXIT; %A11104200 REAL ARRAY DCT[0:15]; LABEL LR; %A11104300 IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11104400 LR: QUOTETOG~ TRUE; STEPIT; T ~ SEXP; %A11104500 % %A11104600 IF RECLAIMTOG THEN BEGIN %A11104700 IF T>2 THEN SDNORM(T) ELSE EMITI(0,33-15|T,15); %A11104800 MARKSYMNCR(1) END ELSE DCT[DC]~ SNORM(T); %A11104900 DC ~ DC + 1; %A11105000 IF ELCLASS = COMMA THEN GO LR; %A11105100 IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END ELSE STEPIT; %A11105200 EMIT(0); %A11105300 EMITO(XCH); %A11105400 EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11105500 GENSYMLINK; T ~ DC; %A11105600 WHILE DC ~ DC -1 ! 0 DO BEGIN %A11105700 MARKSYMNCR(0); EMITO(XCH); %A11105800 EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11105900 GENSYMLINK END; %A11106000 MARKSYMDCR(-T); %A11106100 EXIT: %A11106200 END OF GENLIST; %A11106300 % %A11106400 REAL PROCEDURE GENQUOTE(BV); VALUE BV; BOOLEAN BV; %A11106500 BEGIN %A11106600 BOOLEAN STREAM PROCEDURE COMP(LNK,SKP,AC,I); VALUE LNK,SKP,I; %A11106700 BEGIN SI ~ LOC LNK; SI ~ SI + 1; DI ~ AC; DI ~ DI + 3; %A11106800 DI ~ DI + SKP; %A11106900 IF I SC ! DC THEN TALLY ~ 1; COMP ~ TALLY; %A11107000 END OF COMP; %A11107100 STREAM PROCEDURE TRC(BV,ACN,SKP,ACCUM,PTR,LNK); %A11107200 VALUE BV,ACN,SKP,PTR; %A11107300 BEGIN DI ~ LNK; SI ~ LOC ACN; SI ~ SI + 7; DS ~ CHR; %A11107400 SI ~ ACCUM; SI ~ SI + 3; SI ~ SI + SKP; %A11107500 DS ~ 4 CHR; %A11107600 BV(SI ~ LOC PTR; SI ~ SI + 5); %A11107700 DS ~ 3 CHR END; %A11107800 PROCEDURE RPLACD(A,B); VALUE A,B; REAL A,B; %A11107900 LNK[A.[33:6],A.[39:9]].[33:15] ~ B; %A11108000 REAL PROCEDURE CONSF(A); VALUE A; REAL A; %A11108100 BEGIN NEWLINK ~ 0 & A [18:33:15]; CONSF ~ LNKNDX END; %A11108200 REAL PROCEDURE MKATOM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A11108300 REAL PROCEDURE GENSYMLIST; %A11108400 IF ELCLASS = QUOTEOP THEN FLAG(615) ELSE %A11108500 BEGIN REAL X; LABEL EXIT; %A11108600 IF ELCLASS = RTPAREN THEN BEGIN STEPIT; GO EXIT END; %A11108700 GENSYMLIST ~ X ~ CONSF(MKATOM(TRUE)); %A11108800 WHILE ELCLASS ! RTPAREN DO BEGIN %A11108900 IF ELCLASS = QUOTEOP THEN BEGIN FLAG(615); GO EXIT END; %A11109000 IF ELCLASS = DOTOP THEN BEGIN STEPIT; %A11109100 RPLACD(X,MKATOM(TRUE)); %A11109200 IF ELCLASS ! RTPAREN THEN FLAG(104) ELSE STEPIT; %A11109300 GO EXIT END; %A11109400 IF ELCLASS = COMMA THEN STEPIT; %A11109500 RPLACD(X,X~CONSF(MKATOM(TRUE))); END; %A11109600 STEPIT; %A11109700 EXIT: END; %A11109800 REAL PROCEDURE MKATOM(BV); VALUE BV; BOOLEAN BV; %A11109900 BEGIN INTEGER N,J; REAL R; %A11110000 LABEL LS,EXIT; %A11110100 REAL P,K,S,B; LABEL L1,L2,L3; %A11110200 IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %A11110300 BEGIN MKATOM ~ MKNUM(C); GO LS END; %A11110400 IF ELCLASS = ADOP THEN BEGIN %A11110500 IF EXAMIN(NCR) ! " " THEN BEGIN J ~ ACCUM[1].[18:6]; %A11110600 IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %A11110700 MKATOM ~ MKNUM(IF J = "-" THEN -C ELSE C); GO LS %A11110800 END; %A11110900 MKATOM ~ J; GO EXIT END END; %A11111000 IF ELCLASS = ALFATRNS THEN BEGIN MKATOM ~ TAKE(GIT(ELBAT[I])); %A11111100 GO TO LS END; %A11111200 IF N ~ (R ~ ACCUM[1]).[12:6] = 1 THEN BEGIN %A11111300 R ~ R.[18:6]; %A11111400 IF BV THEN %A11111500 IF R = "(" THEN BEGIN STEPIT; MKATOM ~ GENSYMLIST; %A11111600 GO EXIT END ELSE %A11111700 IF R = ")" OR R = "." OR R = "," THEN BEGIN FLAG(615); %A11111800 GO EXIT END; %A11111900 MKATOM ~ R END ELSE %A11112000 BEGIN %A11112100 K ~ SYMSTACK[R MOD 125]; %A11112200 L1: IF P ~ K { 1 THEN GO TO L3; %A11112300 S ~ LNK[(K~LNK[K.[33:6],K.[39:9]]).[18:6],K.[24:9]]; %A11112400 K ~ K.[3:15]; %A11112500 IF S.[1:5] ! N THEN GO L1; %A11112600 J ~ 0; %A11112700 L2: IF B ~ N-J > 7 THEN B ~ 4; %A11112800 IF COMP(S,J,ACCUM[1],B) THEN GO L1; %A11112900 IF J ~ J+B = N THEN BEGIN MKATOM ~ P; GO LS END; %A11113000 S ~ LNK[S.[33:6],S.[39:9]]; GO L2; %A11113100 L3: IF N {7 THEN J ~ N ELSE J ~ (N MOD 4) + 4; %A11113200 TRC(0,J,N-J,ACCUM[1],0,NEWLINK); %A11113300 WHILE J ! N DO TRC(1,J~J+4,N-J,ACCUM[1],LNKNDX,NEWLINK); %A11113400 NEWLINK ~ 0 & (LNKNDX-1)[18:33:15] %A11113500 & (IF R ~ SYMSTACK[J ~ R MOD 125] = 0 THEN 1 ELSE R) %A11113600 [3:33:15] & 2 [1:46:2]; %A11113700 SYMSTACK[J] ~ MKATOM ~ LNKNDX; END; %A11113800 LS: STEPIT; %A11113900 EXIT: END OF MKATOM; %A11114000 REAL PROCEDURE SCANB; %A11114100 BEGIN LABEL L1; %A11114200 IF STEPI=LITNO OR ELCLASS=NONLITNO THEN BEGIN %A11114300 NEWLINK ~ 0&C[4:19:29]&1[1:46:2]; SCANB ~ LNKNDX; %A11114400 IF STEPI=RTBRKET THEN STEPIT ELSE BEGIN %A11114500 L1: QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(640); END END ELSE GO L1 %A11114600 END OF SCANB; %A11114700 PROCEDURE PROPLIST(X); VALUE X; REAL X; %A11114800 BEGIN REAL R,S; LABEL EXIT; %A11114900 STOPDEFINE ~ SYMQUOTE ~ FALSE; STEPIT; SYMQUOTE ~ TRUE; %A11114950 IF X > 63 OR X < 10 THEN %A11115000 IF LNK[X.[33:6],X.[39:9]].[1:2] ! 2 THEN BEGIN FLAG(641); %A11115100 ERRORTOG ~ TRUE END; %A11115200 IF ELCLASS=LFTBRKET THEN RPLACD(X,SCANB) ELSE %A11115300 IF ELCLASS=QUOTEOP THEN RPLACD(X,GENQUOTE(TRUE)) ELSE %A11115400 IF ELCLASS = LITNO THEN BEGIN RPLACD(X,ELBAT[I].ADDRESS); %A11115500 STEPIT END ELSE %A11115600 IF ELCLASS=LEFTPAREN THEN BEGIN DO %A11115700 IF STEPI= LFTBRKET THEN RPLACD(X,X~SCANB) ELSE %A11115800 BEGIN R~MKATOM(FALSE); %A11115900 IF ELCLASS!COLON THEN BEGIN QUOTETOG~SYMQUOTE~FALSE; %A11116000 ERR(642); GO EXIT END; STEPIT; S~ MKATOM(TRUE); %A11116100 NEWLINK ~ 0 & R[3:33:15]&S[18:33:15]; %A11116200 RPLACD(X,X~ LNKNDX) END UNTIL ELCLASS! COMMA; %A11116300 IF ELCLASS=RTPAREN THEN STEPIT ELSE BEGIN %A11116400 QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(104) END END ELSE %A11116500 BEGIN QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(639) END; %A11116600 EXIT: END OF PROPLIST; %A11116700 REAL S; %A11116800 SYMQUOTE ~ TRUE; %A11116900 IF STEPI = LEFTPAREN THEN %A11117000 IF STEPI = QUOTEOP THEN GENQUOTE ~ S ~ "(" ELSE %A11117100 BEGIN GENQUOTE ~ S ~ GENSYMLIST; %A11117200 IF ELCLASS = RTPAREN THEN BEGIN %A11117300 DO UNTIL STEPI ! RTPAREN; %A11117400 FLAG(616); END END ELSE %A11117500 GENQUOTE ~ S ~ MKATOM(FALSE); %A11117600 IF ELCLASS = QUOTEOP THEN BEGIN %A11117700 SYMQUOTE ~ FALSE; %A11117750 IF STEPI=COLON AND BV THEN PROPLIST(S); SYMQUOTE ~ FALSE %A11117800 END ELSE BEGIN SYMQUOTE ~ FALSE; ERR(637) END; %A11117900 END OF GENQUOTE; %A11118000 % %A11118100 REAL PROCEDURE MKCHAIN(FROM); VALUE FROM; BOOLEAN FROM; %A11118200 BEGIN INTEGER J,K,R,S; %A11118300 BOOLEAN V; %A11118400 LABEL L; %A11118500 J ~ ELBAT[I].[9:26]; %A11118600 DO BEGIN K ~ J.[46:2]; J ~ J DIV 4 END UNTIL K!0; %A11118700 K ~ J.[46:2]; J ~ J DIV 4; QUOTETOG ~ TRUE; S ~ J.[46:2]; %A11118800 IF SYMSEC THEN BEGIN SYMSEC ~ FALSE; R ~ 0 END ELSE R ~ PORV; %A11118900 V ~ ELCLASS = ASSIGNOP; %A11119000 IF FROM THEN QUOTETOG ~ TRUE; %A11119100 L: GETCONTENTS(R, S=3 AND V); R ~ K; %A11119200 IF K ~ S ! 3 THEN BEGIN %A11119300 J ~ J DIV 4; S ~ J.[46:2]; GO TO L END; %A11119400 IF V THEN BEGIN STEPIT; %A11119500 K ~ SNORM(SEXP); %A11119600 EMITPAIR(TEMP1,STD); EMITO(DUP); EMITO(LOD); EMITV(TEMP1); %A11119700 EMITD(33-K|15,33-R|15,15); EMITO(XCH); %A11119800 EMITO(IF FROM THEN STD ELSE SND); END ELSE %A11119900 IF FROM THEN ERR(617); %A11120000 MKCHAIN ~ R; QUOTETOG ~ NOT FROM; %A11120100 END OF MKCHAIN; %A11120200 % %A11120300 REAL PROCEDURE MKNUM(R); VALUE R; REAL R; %A11120400 BEGIN INTEGER I; LABEL L; %A11120500 IF ABS(R) < 10 THEN %A11120600 IF I ~ R } 0 AND I = R THEN BEGIN MKNUM ~ I; GO L END; %A11120700 NEWLINK ~ R; %A11120800 NEWLINK ~ ((MKNUM ~ LNKNDX)-1)& 3 [1:46:2]; %A11120900 L: END MKNUM; %A11121000 % %A11121100 PROCEDURE PANSYM(MARK,TWOARG); VALUE MARK,TWOARG; BOOLEAN %A11121200 MARK,TWOARG; %A11121300 BEGIN LABEL EXIT; %A11121400 IF STEPI = LEFTPAREN THEN BEGIN QUOTETOG~TRUE; STEPIT END ELSE %A11121500 BEGIN ERR(105); GO EXIT END; %A11121600 SEXPN; IF MARK THEN MARKSYMNCR(1); %A11121700 IF TWOARG THEN BEGIN QUOTETOG ~ TRUE; %A11121800 IF ELCLASS = COMMA THEN STEPIT ELSE %A11121900 BEGIN ERR(606); GO EXIT END; %A11122000 SEXPN; IF MARK THEN MARKSYMNCR(1) END; %A11122100 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11122200 EXIT: END OF PANSYM; %A11122300 % %A11122400 REAL PROCEDURE PORV; %A11122500 IF STEPI!LEFTPAREN THEN SYMVAR(BOOLEAN(2)) ELSE %A11122600 BEGIN QUOTETOG~TRUE; STEPIT; PORV~SNORM(SEXP); %A11122700 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END; %A11122800 % %A11122900 REAL PROCEDURE RSEXP; RSEXP ~ %A11123000 IF ELCLASS = IFV OR ELCLASS = CASEV THEN SEXP ELSE %A11123100 SYMPRIM(TRUE); %A11123200 % %A11123300 PROCEDURE SDNORM(R); VALUE R; REAL R; %A11123400 IF R ~ SNORM(R) ! 0 %A11123500 THEN EMITI(0,33 - 15|R,15); %A11123600 % %A11123700 REAL PROCEDURE SEXP; %A11123800 BEGIN REAL T,DC,TL; ARRAY DCT[0:15]; %A11123900 LABEL EXIT,LR; %A11124000 LABEL LD; %A11124050 T~0; QUOTETOG ~ TRUE; %A11124100 IF SYMSEC THEN SYMSEC ~ FALSE ELSE %A11124200 IF ELCLASS = IFV THEN IFXP(5) ELSE %A11124300 IF ELCLASS = CASEV THEN CASESTMT(11) ELSE %A11124400 LR: T ~ SYMPRIM(FALSE); %A11124500 IF ELCLASS > DOTOP OR ELCLASS = AMPERSAND THEN BEGIN %A11124600 IF T = 5 THEN BEGIN ERR(618); GO EXIT END; %A11124700 IF T = 4 THEN BEGIN T ~ 3; EMITNUM(SAVEQ); END ELSE %A11124800 IF T < 3 THEN BEGIN SDNORM(T); T ~ 3; %A11124900 EMITO(MKS); EMITV(ATN); END; %A11125000 QUOTETOG~FALSE; SIMPARITH; QUOTETOG ~ TRUE; END; %A11125100 IF ELCLASS = DOTOP THEN BEGIN %A11125200 LD: %A11125250 IF RECLAIMTOG THEN BEGIN %A11125300 IF T > 2 THEN SDNORM(T) ELSE %A11125400 EMITI(0,33-15|T,15);MARKSYMNCR(1) END ELSE %A11125500 DCT[DC] ~ SNORM(T); %A11125600 DC ~ DC + 1; QUOTETOG ~ TRUE; STEPIT; GO LR END; %A11125700 IF ELCLASS = PERIOD THEN BEGIN QUOTETOG ~ TRUE; %A11125710 IF TABLE(I+1) ! LFTBRKET THEN GO LD END; %A11125720 IF DC ! 0 THEN BEGIN %A11125800 IF T > 2 THEN SDNORM(T) ELSE EMITI(0,33-15|T,15); %A11125900 MARKSYMNCR(1); EMITO(XCH); %A11126000 EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11126100 GENSYMLINK; T ~ DC; %A11126200 WHILE DC ~ DC - 1 ! 0 DO BEGIN %A11126300 MARKSYMNCR(0); EMITO(XCH); %A11126400 EMITD(33- (IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11126500 GENSYMLINK END; %A11126600 MARKSYMDCR(-(T+1)); T ~ 0; END; %A11126700 IF T = 5 THEN BEGIN T ~ 0; EMITNUM(SAVEQ) END; %A11126800 SEXP ~ T; %A11126900 EXIT: END OF SEXP; %A11127000 % %A11127100 REAL PROCEDURE SNORM(R); VALUE R; REAL R; %A11127200 IF R <3 THEN SNORM ~ R ELSE %A11127300 IF R = 3 THEN BEGIN %A11127400 EMITO(MKS); EMITV(NTA); %A11127500 END ELSE %A11127600 IF R=4 THEN EMITNUM(MKNUM(SAVEQ)) ELSE %A11127700 EMITNUM(SAVEQ); %A11127800 % %A11127900 PROCEDURE SYMINT; %A11128000 BEGIN %B11128100 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11128200 CASE ELBAT[I].INCR OF BEGIN %A11128300 CONSIT; %A11128400 GENLIST; %A11128500 BEGIN EMITO(MKS); PANSYM(TRUE,TRUE); EMITV(APPEND ); %A11128600 MARKSYMDCR(-2) END; %A11128700 BEGIN EMITO(MKS); PANSYM(FALSE,TRUE); EMITV(NCONC ); END; %A11128800 BEGIN EMITO(MKS); EMITV(GENSYM); STEPIT END; %A11128900 BEGIN EMITO(MKS); PANSYM(FALSE,FALSE); EMITV(RANDOM) END; %A11129000 BEGIN IF STEPI = LEFTPAREN THEN BEGIN QUOTETOG ~ TRUE; %A11129100 STEPIT; STRINGSEC(4); QUOTETOG ~ FALSE; %A11129200 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104) END; %A11129300 EMITO(MKS); EMITV(ATCON); EMITPAIR(3,BFC); %A11129400 EMITV(INSYM); EMITPAIR(3,BFW); %A11129500 EMITO(MKS); %A11129600 IF ELCLASS = FACTOP THEN BEGIN EMIT(0); STEPIT END ELSE %A11129700 EMITL(1); EMITV(MKATM) END; %A11129800 PROPER(0); %A11129900 BEGIN EMITO(MKS); EMITV(READ1); STEPIT END; %A11130000 BEGIN FIXCLASS(SYMID,INSYM,FALSE); %A11130100 SYMVAR(FALSE) END; %A11130200 BEGIN QUOTETOG ~ FALSE; %A11130300 IF STEPI =LEFTPAREN THEN BEGIN STEPIT;AEXP; QUOTETOG ~ TRUE; %A11130310 IF ELCLASS = COMMA THEN BEGIN STEPIT; SEXPN; EMITO(INX); END; %A11130400 RTPARN END ELSE ERR(105) END; %A11130410 BEGIN QUOTETOG~FALSE; PANA ; QUOTETOG~TRUE; EMITV(SYMSTACKA) END; %A11130500 END; %B11130600 END; % END OF SYMINT %A11130700 % %A11130800 REAL PROCEDURE SYMPRIM(BV); VALUE BV; BOOLEAN BV; %A11130900 BEGIN LABEL EXIT, L57,L58,L59,L60,L61,L62,L63,L64,L65; %A11131000 LABEL LAE; %A11131050 SWITCH SW ~ L57,L58,L59,L60,L61,L62,L63,L64,L65; %A11131100 INTEGER T,R; %A11131200 IF ELCLASS > STRTRNS AND ELCLASS < RECARRAYID THEN BEGIN %A11131300 IF ELCLASS = ALFATRNS THEN BEGIN SAVEQ ~ TAKE(GIT(ELBAT[I])); %A11131400 STEPIT; SYMPRIM ~ 5; GO EXIT END; %A11131500 IF R ~(T~ELCLASS-STRTRNS).[45:3] = 2 THEN BEGIN %A11131600 CASE T DIV 8 OF BEGIN %A11131700 SYMINT; %A11131800 STRMPROCSTMT; %A11131900 PROCSTMT(FALSE); %A11132000 SYMVAR(FALSE); %A11132100 SYMVAR(FALSE); END; %A11132200 GO EXIT END ELSE %A11132300 IF R = 0 THEN BEGIN STRINGSEC(4); EMITO(MKS); EMITV(ATCON); %A11132400 EMITPAIR(3,BFC); EMITV(INSYM); EMITPAIR(3,BFW); %A11132500 EMITO(MKS); EMITL(1); EMITV(MKATM); %A11132600 GO EXIT END END ELSE %A11132700 IF ELCLASS = FIELDID THEN BEGIN %A11132800 IF ELBAT[I].ADDRESS = SYMV THEN BEGIN %A11132900 FIELDC(ELBAT[I],0,FALSE); GO EXIT END END ELSE %A11133000 IF ELCLASS > TRUTHV AND ELCLASS < WRITEV THEN %A11133100 GO TO SW[ELCLASS-TRUTHV]; %A11133200 IF ELCLASS=SPACEV THEN BEGIN SAVEQ ~" "; SYMPRIM ~5; %A11133300 STEPIT; GO EXIT END ELSE %A11133400 IF ELCLASS = STRTRNS THEN IF ELBAT[I].INCR=0 THEN %A11133500 BEGIN SAVEQ~12; SYMPRIM~5; STEPIT; GO EXIT END; %A11133600 IF BV THEN BEGIN ERR(618); GO TO EXIT END; %A11133700 LAE: %A11133750 QUOTETOG ~ FALSE; AEXP; QUOTETOG ~ TRUE; %A11133800 SYMPRIM ~ 3; GO EXIT; %A11133900 L57: L58: L59: SAVEQ ~ C; SYMPRIM ~ 4; STEPIT; GO EXIT; %A11134000 L60: STEPIT; %A11134100 SYMPRIM ~ IF BV THEN RSEXP ELSE SEXP; %A11134200 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); GO EXIT; %A11134300 L61: SAVEQ ~ 0; SYMPRIM ~ 4; STEPIT; GO EXIT; %A11134400 L62: SAVEQ ~ GENQUOTE(FALSE); SYMPRIM ~ 5; GO EXIT; %A11134500 L63: SYMPRIM ~ MKCHAIN(FALSE); GO EXIT; %A11134600 L64: IF T ~ ELBAT[I].ADDRESS = LISTV THEN GENLIST %A11134700 ELSE IF T = SYMV THEN BEGIN %A11134800 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11134900 STEPIT; BEXP; IF ELCLASS = RTPAREN THEN STEPIT ELSE %A11135000 BEGIN ERR(104); GO EXIT END; EMITI(0,47,1) END ELSE %A11135100 GO LAE; GO EXIT; %A11135200 L65: EMITO(MKS); EMITV(READER); STEPIT; %A11135300 EXIT: END OF SYMPRIM; %A11135400 % %A11135500 PROCEDURE SYMVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11135600 BEGIN REAL TALL,STR,ADR; %A11135700 BOOLEAN ARTOG; LABEL EXIT; %A11135800 ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); %A11135900 IF ARTOG ~ ELCLASS= SYMARRAYID THEN BEGIN %A11136000 IF FROM THEN SMT ~ TALL < 0 ELSE TALL ~ ABS(TALL); %A11136100 IF ARAY(TALL,0,FALSE) THEN BEGIN ERR(205); GO EXIT END %A11136200 END ELSE STEPIT; %A11136300 IF ELCLASS=ASSIGNOP THEN %A11136400 IF FROM.[46:1] THEN %A11136500 IF ARTOG THEN BEGIN L~L-1; EMITO(COC) END %A11136600 ELSE EMITV(ADR) ELSE %A11136700 BEGIN %A11136800 QUOTETOG ~ TRUE; STEPIT; SEXPN; QUOTETOG ~ FALSE; %A11136900 STR ~ IF FROM THEN STD ELSE SND; %A11137000 IF TALL < 0 THEN EMITPAIR(JUNK,SND); %A11137100 IF ARTOG THEN BEGIN EMITO(XCH); EMITO(STR) END ELSE %A11137200 IF TALL.[9:2]=2 THEN BEGIN EMITN(ADR); EMITO(STR) %A11137300 END ELSE EMITPAIR(ADR,STR); %A11137400 IF TALL < 0 THEN SYMONITOR(NOT ARTOG,TALL, %A11137500 IF ARTOG THEN TAKE(GIT(TALL)) ELSE 0,0); END ELSE %A11137600 IF FROM THEN ERR(145) ELSE IF NOT ARTOG THEN %A11137700 EMITV(ADR);EXIT: QUOTETOG ~ NOT FROM; %A11137800 END OF SYMVAR; %A11137900 % THE FOLLOWING SECTION IS FOR STRING EXPRESSIONS %A11138000 PROCEDURE STRINGC(DSV,NLP); VALUE DSV,NLP; %A11138100 REAL DSV; BOOLEAN NLP; %A11138200 BEGIN REAL S; INTEGER R,T; BOOLEAN V; LABEL L1; %A11138300 LABEL EXIT; %A11138400 STRINGSEC(1); %A11138500 S ~ IF V ~ DSV > TRS THEN SFD ELSE SFS; %A11138600 ECR(STKC,IF V THEN RDA ELSE RSA); %A11138700 IF SPT THEN BEGIN %A11138800 ECR(STKC,CRF); EC(0,S); %A11138900 IF WTYPE = 1 THEN BEGIN %A11139000 IF SLT THEN EMITPAIR(ST1,STD); %A11139100 EMITO(DUP); %A11139200 EMITI(0,36,6); %A11139300 ECR(STKC,CRF); %A11139400 EC(3,BNS); %A11139500 EC(32,S); EC(32,S); EC(0,ENS); %A11139600 IF SLT THEN EMITV(ST1) END %A11139700 END ELSE %A11139800 RCH(FALSE,0,FALSE,0,SP,S); %A11139900 S ~ IF V THEN DSV.[42:6] ELSE TRS; %A11140000 IF V OR SPT OR DPT OR SLT OR DRT THEN BEGIN L1: %A11140100 IF SLT THEN BEGIN %A11140200 IF WTYPE ! 2 THEN BEGIN %A11140300 EMITO(DUP); EMITI(0,36,6); EMITO(XCH); %A11140400 STKC END; %A11140500 ECR(STKC,CRF); %A11140600 EC(0,S); %A11140700 IF V THEN EJ(JFC); %A11140800 IF WTYPE ! 2 THEN BEGIN ECR(STK-1,CRF); %A11140900 EC(3+4|REAL(V),BNS); %A11141000 EC(32,S); %A11141100 IF V THEN EC(4,JNC); %A11141200 EC(32,S); %A11141300 IF V THEN EC(2,JNC); %A11141400 EC(0,ENS); %A11141500 IF V THEN BEGIN EC(1,JFW); EJ(JFW) END; END; %A11141600 EMITO(DUP); END ELSE %A11141700 BEGIN % SLT FALSE %A11141800 IF R ~ SL.[42:6] ! 0 THEN BEGIN %A11141900 EC(R,S); IF V THEN EJ(JFC) END; %A11142000 IF R ~ SL.[36:6] ! 0 THEN BEGIN %A11142100 EC(R,BNS); EC(32,S); %A11142200 IF V THEN EC(4,JNC); %A11142300 EC(32,S); IF V THEN EC(2,JNC); %A11142400 EC(0,ENS); %A11142500 IF V THEN BEGIN EC(1,JFW); EJ(JFW) END %A11142600 END END; %A11142700 GO EXIT END; %A11142800 IF WTYPE } 3 AND NLP AND SL > 15 THEN %A11142900 IF DPT.[46:1] THEN %A11143000 IF R ~ (DP+DR).[45:3] = SP.[45:3] THEN BEGIN %A11143100 IF R ~ (8-R).[45:3] ! 0 THEN EC(R,TRS); %A11143200 IF R ~ (T~SL-R) DIV 8 ! 0 THEN %A11143300 RCH(FALSE,0,FALSE,0,R,TRW); %A11143400 IF T ~ T - R|8 ! 0 THEN EC(T,TRS); %A11143500 GO EXIT END; %A11143600 GO L1; %A11143700 EXIT: %A11143800 END OF STRINGC; %A11143900 % %A11144000 PROCEDURE STRINGPRIM(DSV,NLP); VALUE DSV,NLP; %A11144100 BOOLEAN NLP; REAL DSV; %A11144200 BEGIN LABEL L2,EXIT,L1; %A11144300 % %A11144400 PROCEDURE STRINGINT(V,DSV,NLP); VALUE V,DSV,NLP; %A11144500 BOOLEAN V,NLP; REAL DSV; %A11144600 BEGIN %A11144700 REAL STREAM PROCEDURE GITA(C,K); VALUE C,K; %A11144800 BEGIN DI ~ LOC GITA; DI ~ DI + 7; %A11144900 SI ~ LOC C; SI ~ SI + K; DS ~ CHR END; %A11145000 % %A11145100 PROCEDURE AMONG(BV); VALUE BV; BOOLEAN BV; %A11145200 BEGIN LABEL EXIT; %A11145300 REAL R,N,T,K; %A11145400 QUOTETOG~ FALSE; %A11145500 IF STEPI!STRNGCON THEN BEGIN %A11145600 ERR(700); GO EXIT END; %A11145700 R ~ C; N ~ COUNT; %A11145800 IF BV THEN STEPIT ELSE LITF(64); %A11145900 BV ~ QUOTETOG ~ TRUE; %A11146000 IF SLT THEN BEGIN %A11146100 ECR(STKC,CRF); %A11146200 T ~ LC ~ LC + 1 END ELSE %A11146300 IF SL ! 1 THEN EC(SL,BNS) ELSE BV ~ FALSE; %A11146400 K ~ 8 - N; %A11146500 WHILE K < 7 DO BEGIN %A11146600 EC(GITA(R,K),TNE); %A11146700 EC(2|(K-7),JFC); K ~ K+1 END; %A11146800 EC(R.[42:6],TEQ); %A11146900 IF BV THEN EC(3,JNC) ELSE EJ(JFC); %A11147000 EC(1,SFS); %A11147100 IF BV THEN BEGIN EC(0,ENS); %A11147200 EC(1,JFW); EJ(JFW); %A11147300 IF SLT THEN BEGIN R ~ LC; %A11147400 LC ~ T - 1; EC(R-T,BNS); LC ~ R END %A11147500 END; %A11147600 IF SLT THEN EMITO(DUP); %A11147700 EXIT: %A11147800 END OF AMONG; %A11147900 % %A11148000 PROCEDURE BITPRIM(BV,V,DSV); VALUE BV,V,DSV; %A11148100 BOOLEAN BV,V; REAL DSV; %A11148200 BEGIN LABEL EXIT; %A11148300 SP ~ 0; SPT ~ FALSE; %A11148400 IF BV THEN STEPIT ELSE %A11148500 IF STEPI ! LEFTPAREN THEN BEGIN %A11148600 SLT ~ FALSE; SL ~ 1 END ELSE %A11148700 BEGIN QUOTETOG ~ FALSE; STEPIT; %A11148800 IF LITP(SL) THEN BEGIN %A11148900 IF SL > 64 OR SL = 0 THEN BEGIN %A11149000 FLAG(701); ERRORTOG~TRUE; SL ~ 1 END ; %A11149100 SLT ~ FALSE END ELSE %A11149200 BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); %A11149300 SLT ~ TRUE; END; %A11149400 IF ELCLASS = COMMA THEN BEGIN %A11149500 SPT ~ SLT; SP ~ SL; STEPIT; %A11149600 IF LITP(SL) THEN BEGIN SLT ~ FALSE; %A11149700 IF SL > 64 OR SL = 0 THEN BEGIN %A11149800 FLAG(701); ERRORTOG~ TRUE; SL~ 1 END; %A11149900 END ELSE %A11150000 BEGIN AEXP; EMITO(SSP); %A11150100 EMITPAIR(JUNK,IF SPT THEN ISD ELSE ISN); %A11150200 SLT ~ TRUE END END; %A11150300 QUOTETOG ~ TRUE; %A11150400 IF ELCLASS = RTPAREN THEN STEPIT ELSE BEGIN %A11150500 ERR(104); GO EXIT END; %A11150600 END; %A11150700 IF SPT THEN BEGIN EMITO(DUP); %A11150800 IF SLT THEN BEGIN EMITV(JUNK); EMITO(ADD); %A11150900 EMITV(JUNK); EMITO(XCH); %A11151000 END ELSE %A11151100 IF SL ! 0 THEN BEGIN %A11151200 EMITL(SL); EMITO(ADD); END %A11151300 END ELSE %A11151400 IF SLT THEN BEGIN EMITO(DUP); %A11151500 IF SP ! 0 THEN BEGIN EMITL(SP); EMITO(ADD) END ; %A11151600 END; %A11151700 IF SPT THEN BEGIN %A11151800 ECR(STKC,CRF); %A11151900 EC(0,IF DSV = TRS THEN BSD ELSE BSS); %A11152000 END ELSE %A11152100 IF SP ! 0 THEN %A11152200 EC(SP,IF DSV = TRS THEN BSD ELSE BSS); %A11152300 IF SLT THEN BEGIN %A11152400 ECR(STKC,CRF); %A11152500 IF DSV = TRS THEN EC(0,IF V THEN BIS ELSE BIR) ELSE %A11152600 BEGIN EC(6,BNS); %A11152700 EC(REAL(V),TIB); EC(3,JNC); %A11152800 EC(1,BSS); EC(0,ENS); %A11152900 EC(1,JFW); EJ(JFW); %A11153000 END END ELSE %A11153100 IF DSV = TRS THEN %A11153200 EC(SL,IF V THEN BIS ELSE BIR) ELSE %A11153300 BEGIN %A11153400 IF SL ! 1 THEN %A11153500 EC(SL,BNS); EC(REAL(V),TIB); %A11153600 IF SL = 1 THEN EJ(JFC) ELSE EC(3,JNC); %A11153700 EC(1,BSS); %A11153800 IF SL ! 1 THEN BEGIN EC(0,ENS); %A11153900 EC(1,JFW); EJ(JFW); END; %A11154000 END; %A11154100 IF DRT OR (SLT~ SLT OR SPT) THEN BEGIN %A11154200 IF NOT SLT THEN EMITL(SP+SL); %A11154300 IF DRT THEN BEGIN EMITV(DR); EMITO(ADD) END ELSE %A11154400 IF DR ! 0 THEN BEGIN EMITNUM(DR); EMITO(ADD) END; %A11154500 IF NOT DRT THEN DR ~ FORAD; DRT ~ TRUE; %A11154600 EMITPAIR(DR,ISD) END ELSE %A11154700 DR ~ DR + SP + SL; %A11154800 EXIT: %A11154900 END OF BITPRIM; %A11155000 % %A11155100 PROCEDURE BITXP(BV,V,DSV); VALUE BV,V,DSV; REAL DSV; %A11155200 BOOLEAN BV,V; %A11155300 BEGIN %A11155400 REAL DRO,R; BOOLEAN DRTO; LABEL EXIT; %A11155500 DRO~DR; DRTO~DRT; %A11155600 DRT ~ FALSE; DR ~ 0; %A11155700 BITPRIM(BV,V,DSV); %A11155800 WHILE ELCLASS = ADOP DO BEGIN %A11155900 SLT ~ FALSE; %A11156000 IF BV ~ STEPI = LITNO THEN BEGIN %A11156100 IF SL ~ ELBAT[I].ADDRESS > 64 OR SL = 0 THEN BEGIN %A11156200 FLAG(701); ERRORTOG ~ TRUE; SL ~ 1 END; %A11156300 STEPIT END; %A11156400 IF ELCLASS ! STRTRNS OR %A11156500 (R ~ ELBAT[I].INCR ! 5 AND R ! 6) THEN %A11156600 BEGIN ERR(702); GO EXIT END; %A11156700 BITPRIM(BV,R=5,DSV); %A11156800 END; %A11156900 IF SLT ~ DRT THEN %A11157000 BEGIN EMITV(DR); EMITL(5); EMITO(ADD); %A11157100 EMITL(6); EMITO(IDV); %A11157200 DCRFR END ELSE %A11157300 SL ~ (DR+5) DIV 6; %A11157400 DR ~ DRO; DRT ~ DRTO; %A11157500 EXIT: END IF BITXP; %A11157600 % %A11157700 REAL R,T; %A11157800 R ~ ELBAT[I].INCR; %A11157900 IF DSV = 1328 THEN BEGIN %A11158000 IF R < 5 THEN BEGIN %A11158100 NLP ~ TRUE; %A11158200 IF V THEN STEPIT ELSE LITF(64); %A11158300 IF SLT THEN BEGIN %A11158400 ECR(STKC,CRF); T ~ LC ~ LC + 1 END ELSE %A11158500 IF SL ! 1 THEN EC(SL,BNS) ELSE NLP ~ FALSE; %A11158600 CASE R OF BEGIN %A11158700 BEGIN %A11158800 EC(12,TEQ); IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11158900 END; %A11159000 BEGIN %A11159100 EC("A",TAN); %A11159200 IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11159300 END; %A11159400 BEGIN %A11159500 EC(0,TEG); %A11159600 IF NLP THEN EC(5,JNC) ELSE EJ(JFC); %A11159700 EC(9,TEL); %A11159800 IF NLP THEN EC(3,JNC) ELSE EJ(JFC); %A11159900 END; %A11160000 BEGIN %A11160100 EC("A",TNE); EC(8,JFC); %A11160200 EC("E",TNE); EC(6,JFC); %A11160300 EC("I",TNE); EC(4,JFC); %A11160400 EC("O",TNE); EC(2,JFC); %A11160500 EC("U",TEQ); %A11160600 IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11160700 END; %A11160800 BEGIN %A11160900 EC("A",TAN); %A11161000 IF NLP THEN EC(5,JNC) ELSE EJ(JFC); %A11161100 EC(0,TLS); %A11161200 IF NLP THEN EC(3,JNC) ELSE EJ(JFC); %A11161300 END; %A11161400 END; %A11161500 EC(1,SFS); %A11161600 IF NLP THEN BEGIN %A11161700 EC(0,ENS); EC(1,JFW); EJ(JFW); %A11161800 IF SLT THEN BEGIN R ~ LC; %A11161900 LC ~ T - 1; %A11162000 EC(T ~ R - T,BNS); LC ~ R END; %A11162100 END; %A11162200 IF SLT THEN EMITO(DUP); END ELSE % END OF R<5 PART %A11162300 IF R > 7 THEN BEGIN %A11162400 IF V THEN FLAG(703); %A11162500 STRINGC(DSV,NLP) END ELSE %A11162600 IF R = 7 THEN AMONG(V) ELSE %A11162700 BITXP(V,R=5,1328) %A11162800 END ELSE % END OF = PART %A11162900 IF DSV ! TRS THEN BEGIN %A11163000 IF V OR R < 8 THEN ERR(703) ELSE %A11163100 STRINGC(DSV,NLP) END ELSE %A11163200 BEGIN % TRS PART %A11163300 IF R = 0 THEN BEGIN %A11163400 IF V THEN STEPIT ELSE LITF(64); %A11163500 IF SLT THEN BEGIN %A11163600 EC(STKC,CRF); EMITO(DUP); %A11163700 EC(3,BNS) END ELSE %A11163800 IF SL ! 1 THEN EC(SL,BNS); %A11163900 EC(1,TRP); EMT(12); %A11164000 IF SLT OR SL ! 1 THEN EC(0,ENS); %A11164100 END ELSE %A11164200 IF R = 5 OR R = 6 THEN BITXP(V,R=5,TRS) ELSE %A11164300 IF R < 8 OR V THEN ERR(703) ELSE %A11164400 STRINGC(TRS,NLP); %A11164500 END; %A11164600 END OF STRINGINT; %A11164700 % %A11164800 BOOLEAN PROCEDURE FACTER(BV,DSV,NLP,FACT,P); %A11164900 VALUE BV,DSV,NLP,FACT,P ; %A11165000 BOOLEAN BV,NLP,FACT; REAL DSV,P; %A11165100 BEGIN INTEGER K; %A11165200 LABEL L3,L1,L2,EXIT; %A11165300 QUOTETOG ~ FALSE; %A11165400 IF BV THEN STEPIT ELSE %A11165500 IF TABLE(I+1) = LEFTPAREN THEN LITF(4096) ELSE %A11165600 IF FACTER ~ STEPI ! AMPERSAND AND NLP THEN GO L3 ELSE %A11165700 BEGIN SLT ~ FALSE; SL ~ 1 END; %A11165800 NLP ~ FALSE; %A11165900 QUOTETOG ~ TRUE; %A11166000 IF FACT THEN BEGIN %A11166100 IF SLT THEN BEGIN EMITO(DUP); %A11166200 EMITI(0,36,6); EMITO(XCH); EMITO(DUP); %A11166300 STK ~ STK + 2 END; %A11166400 RCH(SLT,STK,TRUE,STK-1,SL, IF DSV = TRS THEN SFD ELSE SFS) %A11166500 END ELSE %A11166600 BEGIN L1: %A11166700 IF SLT THEN BEGIN %A11166800 IF NOT NLP THEN EMITPAIR(JUNK,SND); %A11166900 EMITO(DUP); %A11167000 EMITI(0,45,3); EMITO(XCH); %A11167100 EMITI(0,39,6); %A11167200 IF NOT NLP THEN EMITV(JUNK); %A11167300 STK ~ STK + 2 END; %A11167400 K ~ 0; %A11167500 IF SLT OR SL} 16 THEN BEGIN %A11167600 IF SLT THEN BEGIN %A11167700 ECR(STK,CRF); %A11167800 EC(IF DSV = TRS THEN 6 ELSE 10,BNS) END ELSE %A11167900 IF K ~ SL DIV 8 = 0 THEN GO L2 ELSE EC(K,BNS); %A11168000 IF DSV = TRS THEN BEGIN %A11168100 EC(8,TRP); EMT(P); EMT(P); EMT(P); EMT(P); %A11168200 END ELSE %A11168300 BEGIN EC(8,BNS); %A11168400 EC(P, DSV.[36:6]); EC(3,JNC); %A11168500 EC(1,SFS); EC(0,ENS); EC(1,JFW); EC(2,JNS); %A11168600 END; %A11168700 EC(0,ENS); %A11168800 IF DSV ! TRS THEN BEGIN %A11168900 EC(1,JFW); EJ( JFW) END; %A11169000 END; %A11169100 L2: %A11169200 IF SLT THEN BEGIN ECR(STK-1,CRF); %A11169300 EC(IF DSV = TRS THEN 3 ELSE 6, BNS); %A11169400 END ELSE %A11169500 IF K ~ SL - K|8 = 0 THEN GO EXIT ELSE %A11169600 EC(K,BNS); %A11169700 IF DSV = TRS THEN BEGIN EC(1,TRP); EMT(P) END ELSE %A11169800 BEGIN EC(P,DSV.[36:6]); EC(3,JNC); EC(1,SFS) END; %A11169900 EC(0,ENS); %A11170000 IF DSV ! TRS THEN BEGIN EC(1,JFW); EJ(JFW) END; %A11170100 END; %A11170200 GO EXIT; %A11170300 L3: %A11170400 IF SLT ~ DLT OR DRT THEN BEGIN %A11170500 IF DLT THEN EMITV(DL) ELSE EMITNUM(DL); %A11170600 IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11170700 EMITO(SUB); %A11170800 IF NOT FACT THEN EMITO(DUP); %A11170900 EMIT(0); EMITO(LSS); %A11171000 IF DSV = TRS THEN EMITERR(SGNO,L," 2"); %A11171100 SLT ~ TRUE; %A11171200 IF DRT EQV NOT DLT THEN BEGIN %A11171300 DRT ~ DLT; DLT ~ NOT DLT END ; %A11171400 END ELSE %A11171500 IF DL 420; %A11174500 IF V THEN BEGIN COUNT ~ 0; %A11174600 RESULT ~ 5; SCANNER; STEPIT END ELSE BEGIN %A11174700 QUOTETOG ~ FALSE; ERR(705) END; %A11174800 IF DSV > TRS THEN %A11174900 BEGIN %A11175000 IF R = 1 THEN BEGIN %A11175100 ECR(STKC,SED); EC(1,SFD); %A11175200 EC(7,DSV.[42:6]); EJ(JFC) END ELSE %A11175300 IF R > 1 THEN BEGIN %A11175400 ECR(STK+1,SED); EC(R,BNS); %A11175500 EC(1,SFD); EC(7,DSV.[42:6]); %A11175600 EC(2,JNC); EC(0,ENS); EC(1,JFW); %A11175700 EJ(JFW); STK ~ STK + R; %A11175800 END; %A11175900 IF K ~ SL - R | 7 > 1 THEN BEGIN %A11176000 IF R = 0 THEN ECR(STKC,SED) ELSE STKC; %A11176100 EC(1,SFD); EC(K,DSV.[42:6]); %A11176200 EJ(JFC) END ELSE %A11176300 IF K = 1 THEN BEGIN %A11176400 EC(T,DSV.[36:6]); EJ(JFC) ; EC(1,SFS) END; %A11176500 END; %A11176600 SLT ~ FALSE; %A11176700 END OF SCANQ; %A11176800 % %A11176900 PROCEDURE BRKT(DSV); VALUE DSV; REAL DSV; %A11177000 BEGIN %A11177100 REAL DRO,JO,PC,T,R; %A11177200 BOOLEAN DRTO,PCT; %A11177300 LABEL L, EXIT; %A11177400 QUOTETOG~ FALSE; %A11177500 IF STEPI = LITNO THEN %A11177600 IF R ~ ELBAT[I].ADDRESS < 64 AND R > 0 THEN %A11177700 IF TABLE(I+1) = COLON THEN BEGIN %A11177800 STEPIT; PCT ~ FALSE; EC(PC~R,BNS); GO L END; %A11177900 AEXP; EMITO(SSP); %A11178000 PCT ~ TRUE; %A11178100 IF ELCLASS ! COLON THEN BEGIN ERR(706); GO EXIT END; %A11178200 EMITPAIR(PC~FORAD,ISN); %A11178300 ECR(STKC,CRF); R ~ LC ~ LC + 1; %A11178400 L: %A11178500 DRO ~ DR; DRTO ~ DRT; JO ~ JMPCH; %A11178600 DR ~ JMPCH ~ 0; DRT ~ FALSE; QUOTETOG ~ TRUE; %A11178700 STEPIT; STRINGXP(DSV,FALSE); %A11178800 EC(0,ENS); %A11178900 IF PCT THEN BEGIN T ~ LC; %A11179000 LC ~ R - 1; %A11179100 IF R ~ T - R > 63 THEN BEGIN %A11179200 FLAG(707); ERRORTOG~ TRUE;R ~ 1 END; %A11179300 EC(R,BNS); LC ~ T END; %A11179400 IF DSV > TRS THEN BEGIN %A11179500 EC(1,JFW); EMITJUMP(TRUE); %A11179600 JMPCH ~ JO; EJ(JFW) END ; %A11179700 IF SLT ~ DRT OR PCT THEN BEGIN %A11179800 IF DRT THEN BEGIN EMITV(DR); DCRFR END ELSE EMITNUM(DR); %A11179900 IF PCT THEN BEGIN EMITV(PC); DCRFR END ELSE EMITNUM(PC); %A11180000 EMITO(MUL); END ELSE %A11180100 SL ~ DR | PC; %A11180200 DR ~ DRO; %A11180300 DRT ~ DRTO; %A11180400 IF ELCLASS=RTBRKET THEN STEPIT ELSE ERR(715); %A11180500 EXIT: %A11180600 END OF BRKT; %A11180700 % %A11180800 PROCEDURE OTHERS(TR,DSV); VALUE TR,DSV; REAL DSV; %A11180900 BOOLEAN TR; %A11181000 BEGIN LABEL L1; REAL T; %A11181100 BOOLEAN CRFT; LABEL EXIT; %A11181150 QUOTETOG ~ FALSE; %A11181200 SLT ~ TRUE; %A11181300 IF TR THEN IF STEPI = LEFTPAREN THEN STEPIT ELSE ERR(105); %A11181400 IF T ~ EXPRSS = 5 THEN BEGIN %A11181500 FOR T ~ 0 STEP 1 UNTIL 4 DO EMIT(0); %A11181600 EMITO(MKS); EMITV(ATSTRV); %A11181700 ECR(STKC,IF DSV=TRS THEN SES ELSE SED); %A11181800 ECR(STK~STK+4,CRF); %A11181900 IF DSV = TRS THEN BEGIN %A11182000 EC(3,BNS); %A11182100 EC(1,SFS); EC(7,TRS); %A11182200 EC(0,ENS); EC(1,SFS); ECR(STKC,CRF); %A11182300 EC(0,TRS); END ELSE %A11182400 BEGIN EC(6,BNS); %A11182500 EC(1,SFD); EC(7,DSV.[42:6]); %A11182600 EC(2,JNC); EC(0,ENS); %A11182700 EC(1,JFW); EJ(JFW); %A11182800 EC(1,SFD); %A11182900 ECR(STKC,CRF); EC(0,DSV.[42:6]); %A11183000 EJ(JFC) END; %A11183100 END ELSE %A11183200 IF T = BTYPE AND NOT TR THEN BEGIN %A11183300 EMITPAIR(4,BFC); %A11183400 EMITNUM("TRUE000"); EMITL(4); %A11183500 EMITPAIR(2,BFW); %A11183600 EMITNUM("FALSE00"); EMITL(5); %A11183700 L1: %A11183800 EMITO(DUP); %A11183900 IF DSV = TRS THEN BEGIN %A11184000 ECR(STKC,SES); %A11184100 IF CRFT THEN BEGIN ECR(STKC,CRF); EC(0,SFS); END %A11184110 ELSE EC(1,SFS); %A11184120 ECR(STKC,CRF); EC(0,TRS); %A11184200 END ELSE %A11184300 BEGIN ECR(STKC,SED); %A11184400 IF CRFT THEN BEGIN ECR(STKC,CRF); EC(0,SFD); END %A11184410 ELSE EC(1,SFD); %A11184420 ECR(STKC,CRF); EC(0,DSV.[42:6]); %A11184500 EJ(JFC); END END ELSE %A11184600 IF T = ATYPE OR T = BTYPE THEN BEGIN %A11184700 IF ELCLASS = COMMA AND TR THEN BEGIN %A11184710 IF STEPI = LITNO THEN %A11184720 IF TABLE(I+1) = RTPAREN THEN BEGIN SLT ~ FALSE; %A11184730 SL ~ ELBAT[I].ADDRESS; STEPIT; STEPIT; %A11184740 IF SL > 8 THEN FLAG(697); T ~ 8 - SL; %A11184750 IF DSV = TRS THEN BEGIN ECR(STKC,SES); %A11184755 IF T ! 0 THEN EC(T,SFS); EC(SL,TRS) END ELSE %A11184760 BEGIN ECR(STKC,SED); IF T ! 0 THEN EC(T,SFD); %A11184765 EC(SL,DSV.[42:6]); EJ(JFC) END; GO EXIT END; AEXP; %A11184770 EMITL(7); EMITO(LND); EMITPAIR(JUNK,SND); EMITL(8); %A11184775 EMITO(XCH); EMITO(SUB); EMITV(JUNK); %A11184780 CRFT ~ TRUE; GO L1 END; %A11184785 EMIT(0); %A11184800 EMITO(MKS); %A11184900 EMITL(IF TR THEN 3 ELSE 0); %A11185000 EMITV(ARSTV); %A11185100 GO L1 END ELSE %A11185200 ERR(708); %A11185300 IF TR THEN RTPARN; %A11185400 EXIT: %A11185450 QUOTETOG ~ TRUE; %A11185500 END OF OTHERS; %A11185600 PROCEDURE TRANSFORM; %A11185700 BEGIN REAL J,N,LCO; LABEL LE,EXIT; QUOTETOG ~ FALSE; %A11185800 IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11185900 IF STEPI!STRINGID AND ELCLASS!STRINGARRAYID THEN %A11186000 BEGIN ERR(689); GO EXIT END; STRINGVAR(FALSE);% %A11186100 IF SPT OR SLT THEN FLAG(690);% %A11186200 ECR(STKC,RSA); RCH(FALSE,0,FALSE,0,SP,SFS); %A11186300 IF SL > 63 THEN IF SL > 126 OR BOOLEAN(SL) THEN BEGIN %A11186400 ERR(691); GO EXIT END ELSE BEGIN EC(2,BNS);% %A11186500 EC(SL.[41:6],BNS); END ELSE EC(SL,BNS); %A11186600 IF ELCLASS = COMMA AND TABLE(I+1)=STRINGID THEN BEGIN STEPIT; %A11186610 J ~ SL; STRINGVAR(FALSE); EMIT(0); EMIT(0); %A11186620 IF SPT OR SLT OR SP!0 OR SL{63 THEN FLAG(721); %A11186630 ECR(STK~STK+2,SDA); ECR(STKC,SED); EC(7,SFD); %A11186640 EC(1,TRS); ECR(STK-1,RDA); ECR(STK-1,SSA); ECR(STK-2,RSA); %A11186650 ECR(STK,CRF); EC(0,SFS); EC(1,TRS); ECR(STK-1,RSA); EC(0,ENS); %A11186660 SL ~ J; IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104) END %A11186670 ELSE BEGIN % %A11186680 EC("A",TAN); EC(1,JFC); LCO ~ LC; LC ~ LC + 1; %A11186700 EC(" ",TEQ); EC(1,JFC); LC ~ LC + 1; %A11186800 WHILE ELCLASS = COMMA AND N ~ N + 1 { 12 DO BEGIN %A11186900 IF STEPI ! STRNGCON THEN BEGIN LE: ERR(692); GO EXIT END;% %A11187000 EC(C.[42:6],TEQ); EC(3,JFC); EC(1,TRP); %A11187100 IF STEPI ! COLON THEN GO LE; IF STEPI!STRNGCON THEN GO LE; %A11187200 EMT(C.[42:6]); LC ~ LC + 1; STEPIT END; %A11187300 IF ELCLASS=RTPAREN THEN STEPIT ELSE BEGIN ERR(104);GO EXIT END; %A11187400 N ~ N - 1; %A11187500 LC ~ LCO; EC(5 | N + 3,JFW); LC ~ LC + 2; EC(5 | N,JFW); %A11187600 WHILE J ~ J + 1 { N DO BEGIN LC ~ LC + 4; %A11187700 EC((N - J) | 5 + 2,JFW) END; %A11187800 EC(1,TRS); EC(1,JFW); EC(1,SFS); EC(0,ENS); %A11187900 END; % %A11187950 IF SL > 63 THEN EC(0,ENS); %A11188000 EXIT: QUOTETOG ~ TRUE; %A11188100 END OF TRANSFORM; %A11188200 % %A11188300 % %A11188400 REAL R; %A11188500 IF ELCLASS = STRINGID OR ELCLASS = STRINGARRAYID THEN %A11188600 STRINGC(DSV,NLP) ELSE %A11188700 IF ELCLASS = QUOTEOP THEN SCANQ(DSV) ELSE %A11188800 IF ELCLASS = STRINGPROCID THEN BEGIN PROCSTMT(FALSE); %A11188900 IF DSV = TRS THEN BEGIN ECR(STKC,SES); EC(1,SFS); %A11189000 ECR(STKC,CRF); EC(0,TRS) END ELSE %A11189100 BEGIN ECR(STKC,SED); EC(1,SFD); ECR(STKC,CRF); %A11189200 EC(0,DSV.[42:6]) END; EMITO(DUP); SLT ~ TRUE %A11189300 END ELSE %A11189400 IF ELCLASS=FIELDID AND R ~ ELBAT[I].ADDRESS= STRINGV %A11189500 THEN STRINGC(DSV,NLP) ELSE %A11189600 IF ELCLASS = LFTBRKET THEN BRKT(DSV) ELSE %A11189700 IF ELCLASS = LEFTPAREN THEN BEGIN %A11189800 STEPIT; STRINGXP(DSV,FALSE); %A11189900 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11190000 GO L1 END ELSE %A11190100 IF ELCLASS = STRTRNS THEN %A11190200 STRINGINT(FALSE,DSV,NLP) ELSE %A11190300 IF ELCLASS = SPACEV OR ELCLASS = NILV OR ELCLASS = FACTOP %A11190400 THEN BEGIN %A11190500 IF FACTER(FALSE,DSV,NLP,ELCLASS=FACTOP, %A11190600 IF ELCLASS = SPACEV THEN " " ELSE 0) THEN %A11190700 BEGIN IF REAL(NLP) = 3 THEN FLAG(698); GO EXIT END END ELSE %A11190800 IF ELCLASS}BOOARRAYID AND ELCLASS { INTARRAYID THEN %A11190900 STRINGC(DSV,NLP) ELSE %A11191000 IF ELCLASS = LITNO THEN BEGIN %A11191100 IF R ~ TABLE(I+1) = STRTRNS OR R = FACTOP %A11191200 OR R = SPACEV OR R = NILV THEN BEGIN %A11191300 SLT ~ FALSE; SL ~ ELBAT[I].ADDRESS; %A11191400 STEPIT; %A11191500 IF ELCLASS = STRTRNS THEN BEGIN %A11191600 IF SL > 64 OR SL = 0 THEN FLAG(709); %A11191700 STRINGINT(TRUE,DSV,NLP) END ELSE %A11191800 IF FACTER(TRUE,DSV,NLP,R = FACTOP, %A11191900 IF R = SPACEV THEN " " ELSE 0) THEN BEGIN %A11192000 IF REAL(NLP) = 3 THEN FLAG(698); GO EXIT END %A11192010 END ELSE GO L2 END ELSE %A11192100 IF ELCLASS = FILLV THEN BEGIN SLT ~ FALSE; %A11192110 IF DSV ! TRS THEN FLAG(720); %A11192115 IF STEPI = LITNO THEN BEGIN %A11192120 IF SL ~ C > 63 THEN FLAG(709); END ELSE %A11192125 IF ELCLASS=LEFTPAREN THEN BEGIN QUOTETOG ~ FALSE;STEPIT; %A11192130 AEXP; IF NOTCOMMA THEN GO EXIT; QUOTETOG ~ TRUE; %A11192135 EMITPAIR(JUNK,ISN); %T9311192138 IF ELCLASS ! LITNO OR SL ~ C > 8 THEN BEGIN ERR(709); GO %A11192140 EXIT END; ECR(STKC,SES); EC(SL,OCV); EC(SL,SRD); %A11192145 IF STEPI ! RTPAREN THEN FLAG(104) END ELSE %A11192150 FLAG(105); STEPIT; EMIT(0); ECR(STKC,SDA);EC(SL-1,10); %A11192155 ECR(STK,RDA); EC(SL,SFD) END ELSE %A11192160 IF ELCLASS = 0 THEN %A11192200 IF ACCUM[1] = "5OCTAL" THEN BEGIN SLT ~ FALSE; SL ~ 16; %A11192300 IF DSV!TRS THEN BEGIN ERR(687); GO EXIT END;% %A11192400 QUOTETOG ~ SPT ~ FALSE; %A11192500 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11192510 IF (R ~ TABLE(I+1) { INTARRAYID AND R } BOOARRAYID %T9111192515 AND TABLE(I+2) ! LFTBRKET) OR %T9111192520 (R = STRINGID OR R = STRINGARRAYID) THEN BEGIN STEPIT; %T9111192525 STRINGVAR(FALSE); %A11192530 IF SPT OR SLT OR SL ! 8 OR SP!0 THEN FLAG(719); SL~16 END ELSE %A11192535 BEGIN I ~ I - 1; PANA; SPT ~ TRUE END; QUOTETOG ~ TRUE; %A11192540 ECR(STKC,IF SPT THEN SES ELSE RSA); %A11192545 IF NOT SPT THEN IF ELCLASS=RTPAREN THEN STEPIT ELSE %A11192550 BEGIN ERR(104); GO EXIT END; %A11192555 EC(16,BNS); EC(3,BIR); EC(3,BNS); EC(1,TIB); EC(2,JFC); %A11192600 EC(1,BIS); EC(1,JFW); EC(1,BIR); EC(1,BSS); EC(0,ENS); %A11192700 EC(0,ENS) END ELSE %A11192800 IF ACCUM[1] = "5SUBST" AND DSV = TRS THEN TRANSFORM ELSE %A11192900 BEGIN ERR(100); GO EXIT END ELSE %A11193000 IF ELCLASS = DECLARATORS AND R = STRINGV THEN %A11193100 OTHERS(TRUE,DSV) ELSE %A11193200 L2: OTHERS(FALSE,DSV); %A11193300 IF DRT OR SLT THEN BEGIN %A11193400 IF DRT THEN EMITV(DR) ELSE IF DR!0 THEN EMITNUM(DR); %A11193500 IF SLT OR SL!0 THEN BEGIN %A11193600 IF NOT SLT THEN EMITNUM(SL); %A11193700 IF DRT OR DR!0 THEN EMITO(ADD); END; %A11193800 IF NOT DRT THEN BEGIN DRT ~ TRUE; DR ~ FORAD END; %A11193900 END ELSE DR ~ DR + SL; %A11194000 L1: %A11194100 IF NLP AND ELCLASS ! AMPERSAND THEN BEGIN %A11194200 IF DRT OR DLT THEN BEGIN %A11194300 IF DRT THEN EMITPAIR(DR,SND) ELSE EMITNUM(DR); %A11194400 IF DLT THEN EMITV(DL) ELSE EMITNUM(DL); %A11194500 IF REAL(NLP) = 3 THEN BEGIN EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11194510 EMIT(0); EMITO(LSS); EMITERR(SGNO,L," 2") END ELSE %A11194520 IF DSV = TRS THEN BEGIN EMITO(GTR); %A11194600 EMITERR(SGNO,L," 2") END ELSE %A11194700 EMITO(IF DSV=1328 THEN EQL ELSE LEQ) END ELSE %A11194800 IF DSV = TRS THEN BEGIN %A11194900 IF DR > DL THEN ERR(704) END ELSE %A11195000 IF REAL(NLP) ! 3 THEN %A11195050 IF DR ! DL THEN ERR(716); %A11195100 END ELSE IF DRT THEN EMITPAIR(DR,STD); %M11195200 EXIT: %A11195300 END OF STRINGPRIM; %A11195400 % %A11195500 PROCEDURE STRINGXP(DSV,NLP); VALUE DSV,NLP; %A11195600 BOOLEAN NLP; REAL DSV; %A11195700 BEGIN %A11195800 REAL R; %A11195900 IF NLP AND DSV = TRS THEN BEGIN %T9311196000 IF ELCLASS = INTRNSICPROCID THEN %T9311196050 IF R := ELBAT[I].[27:6] } 21 AND R { 23 THEN %T9311196100 FIXCLASS(INTID, %T9311196120 IF R = 21 THEN TABR ELSE %T9311196130 IF R = 22 THEN COLR ELSE INREAL , %T9311196140 FALSE); %T9311196150 IF ELCLASS } REALID AND ELCLASS { INTID THEN %T9311196160 IF TABLE(I+1) = COLON THEN BEGIN %A11196200 CHECKER(R~ELBAT[I]); %A11196300 STEPIT; STEPIT END; END; %T9311196400 I ~ I - 1; %A11196500 DO BEGIN QUOTETOG ~ TRUE; STEPIT; %A11196600 STRINGPRIM(DSV,NLP); %A11196700 END UNTIL ELCLASS ! AMPERSAND; %A11196800 IF NLP THEN %A11196900 IF R ! 0 THEN BEGIN %A11197000 IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11197100 IF R.[9:2] = 2 THEN BEGIN %A11197200 EMITN(R.ADDRESS); EMITO(STD); END ELSE %A11197300 EMITPAIR(R.ADDRESS,STD); END; %A11197400 END OF STRINGXP; %A11197500 % %A11197600 PROCEDURE STRINGVAR(BV); VALUE BV; BOOLEAN BV; %A11197700 BEGIN %A11197800 LABEL L1,L2,L3,L4,EXIT; %A11197900 REAL SPTEMP,SLTEMP,WTYPEO,SLTO,SPTO; %A11197950 BOOLEAN RB; REAL RTYPE; %A11198000 REAL R,T,S,ADR; %A11198100 BOOLEAN NPT,NLT,QO; %A11198200 ADR ~ (R ~ ELBAT[I]).ADDRESS; %A11198300 QO ~ QUOTETOG; QUOTETOG ~ FALSE; %A11198400 IF SYMSEC THEN SYMSEC ~ FALSE ELSE BEGIN %A11198500 IF ELCLASS = STRINGID THEN %A11198600 BEGIN % STRINGID %A11198700 IF BOOLEAN(R.FORMAL) THEN %A11198800 BEGIN % FORMAL %A11198900 IF BOOLEAN(R.VO) THEN %A11199000 BEGIN % FORMAL-VALUE %A11199100 WTYPE ~ 2; SP ~ 1; %A11199200 SPT ~ FALSE; SLT ~ TRUE; %A11199300 EMITN(ADR); EMITV(ADR-1) %A11199400 END ELSE %A11199500 BEGIN % FORMAL-NAME %A11199600 WTYPE ~ 1; EMITPAIR(ADR,LOD); %A11199700 EMITV(ADR-1); EMITV(ADR-2); %A11199800 SPT ~ SLT ~ TRUE %A11199900 END; %A11200000 STEPIT END ELSE %A11200100 IF T ~ TAKE(GIT(R)) < 0 THEN %A11200200 BEGIN % SUBSTRING %A11200300 STEPIT; %A11200400 IF ACCUM[1] = "2IN000" THEN %A11200500 BEGIN STEPIT; %A11200600 IF S ~ T.LINK ! 0 THEN %A11200700 IF S ! ELBAT[I].LINK THEN %A11200800 BEGIN %A11200900 L1: ERR(710); GO EXIT; %A11201000 END; %A11201100 L2: IF ELCLASS ! STRINGID AND ELCLASS ! STRINGARRAYID THEN GO L1; %A11201200 IF BOOLEAN((S ~ ELBAT[I]).FORMAL) THEN GO L1; %A11201300 SPT ~ FALSE; SP ~ 0; SLT ~ FALSE; %A11201400 IF ELCLASS = STRINGID THEN BEGIN %A11201500 IF SL ~ TAKE(GIT(S)) < 0 THEN GO L1; %A11201600 IF SL { 7 THEN BEGIN %A11201700 EMITN(S.ADDRESS); SP ~ 1; WTYPE ~ 2; %A11201800 END ELSE BEGIN %A11201900 EMITPAIR(S.ADDRESS,LOD); WTYPE ~ 4 END; %A11202000 STEPIT; %A11202100 END ELSE %A11202200 BEGIN % STRINGARRAY %A11202300 SL ~ TAKE(TAKE(SL ~ GIT(S)) + SL + 1); %A11202400 SLTEMP ~ SL; % WATCH OUT FOR RECURSION %A11202450 IF ARAY(S,0,TRUE) THEN BEGIN %A11202500 L3:ERR(711); GO EXIT END; %A11202600 SL~SLTEMP;SLT~FALSE; % WATCH OUT FOR RECURSION %A11202650 IF SL { 8 THEN WTYPE ~ 2 ELSE BEGIN %A11202700 EMITO(LOD); WTYPE ~ 4 END; %A11202800 END; %A11202900 IF T.[22:13] + T.[9:13] > SL THEN GO L1; %A11203000 SL ~ T.[9:13]; SP ~ T.[22:13] + SP; %A11203100 END ELSE %A11203200 IF S ~ T.LINK = 0 THEN BEGIN %A11203300 ERR(710); GO EXIT %A11203400 END ELSE BEGIN %A11203500 ELBAT[I ~ I-1] ~ S ~ TAKE(S)& S[35:35:13]; %A11203600 ELCLASS ~ S.CLASS; %A11203700 GO L2 END; %A11203800 END OF SUBSTRING PART ELSE %A11203900 BEGIN % NONFORMAL STRING %A11204000 SLT ~ SPT ~ FALSE; SP ~ 0; %A11204100 IF SL ~ T { 7 THEN BEGIN %A11204200 EMITN(ADR); SP ~ 1; %A11204300 WTYPE ~ 2 END ELSE BEGIN %A11204400 EMITPAIR(ADR,LOD); %A11204500 WTYPE ~ 4 END; %A11204600 STEPIT; %A11204700 END %A11204800 END OF STRING PART ELSE %A11204900 IF ELCLASS = STRINGARRAYID THEN %A11205000 BEGIN %A11205100 IF ARAY(R,0,TRUE) THEN %A11205200 BEGIN IF SL ~ TAKE(TAKE(SL ~ GIT(R)) + SL + 1) { 8 %A11205300 AND BV AND STLB=1 THEN BEGIN SLT~FALSE; GO EXIT END; %A11205400 GO L3 END; %A11205500 IF BOOLEAN(R.FORMAL) THEN %A11205600 BEGIN % FORMAL ARRAY %A11205700 WTYPE ~ 1; EMITV(ADR-1); %A11205800 SLT ~ TRUE; EMITL(8); %A11205900 EMITO(GTR); EMITPAIR(1,BFC); %A11206000 EMITO(LOD); EMITV(ADR-1); %A11206100 SPT ~ FALSE; SP ~ 0; %A11206200 END OF FORMAL PART ELSE %A11206300 BEGIN % NONFORMAL STRING ARRAY %A11206400 IF SL ~ TAKE(TAKE(SL ~ GIT(R)) + SL + 1) { 8 %A11206500 THEN WTYPE ~ 2 ELSE %A11206600 BEGIN %A11206700 EMITO(LOD); WTYPE ~ 4 %A11206800 END; %A11206900 SP ~ 0; %A11207000 SPT ~ SLT ~ FALSE; %A11207100 END %A11207200 END OF STRINGARRAY PART ELSE %A11207300 IF ELCLASS } BOOARRAYID AND ELCLASS { INTARRAYID %A11207400 AND TABLE(I+1) ! LFTBRKET THEN BEGIN %A11207450 IF TAKE (GIT(R))!1 THEN FLAG(684); SP~REAL(SPT~FALSE);% %A11207500 SLT ~ TRUE; EMITPAIR(ADR,LOD); EMITO(DUP); EMITO(MOP); %A11207600 EMITI(0,8,10); EMITL(8); EMITO(MUL); STEPIT; WTYPE~4 END ELSE %A11207700 IF ELCLASS = FIELDID AND ADR = STRINGV THEN %A11207800 BEGIN FIELDC(R,0,FALSE); %A11207900 IF SYMSTK.[46:1] THEN BEGIN WTYPE~2; SYMSTK.[46:1]~FALSE; %A11207950 END ELSE BEGIN RTYPE ~ WTYPE; WTYPE ~ 4; %A11208000 RB ~ ELCLASS ! ASSIGNOP END END %A11208050 ELSE %A11208100 IF ELCLASS = STRTRNS AND R ~ R.INCR > 7 THEN %A11208200 BEGIN %A11208300 IF BOOLEAN(R) THEN %A11208400 BEGIN %A11208500 EMITPAIR(INSTR,LOD); %A11208600 SP ~ 3; SL ~ 61; %A11208700 END ELSE %A11208800 BEGIN %A11208900 EMITPAIR(OUTSTR,LOD); SP ~ 0; %A11209000 SL ~ STRINGMAX ~ MAX(64,STRINGMAX); %A11209100 END; %A11209200 STEPIT; %A11209300 SLT ~ SPT ~ FALSE; WTYPE ~ 4 %A11209400 END ELSE %A11209500 BEGIN %A11209600 ERR(708); GO EXIT %A11209700 END; END; %A11209800 IF BV THEN BEGIN %A11209900 IF WTYPE ! 4 OR SL { 8 OR SP ! 0 %A11210000 OR SPT OR SLT THEN ERR(712); %A11210100 GO EXIT END; %A11210200 IF ELCLASS = LEFTPAREN THEN %A11210300 BEGIN STEPIT; %A11210400 IF NPT ~ LITP(S) THEN %A11210500 BEGIN %A11210600 IF SPT THEN %A11210700 BEGIN %A11210800 IF SLT THEN EMITO(XCH); %A11210900 IF WTYPE ! 4 THEN BEGIN %A11211000 IF S ! 0 THEN BEGIN %A11211100 EMITNUM(S); EMITO(ADD); %A11211200 END; END ELSE %A11211300 BEGIN %A11211400 SP ~ SP + S; %A11211500 IF SP.[35:10]! 0 THEN BEGIN %A11211600 EMITL(SP.[35:10]); EMITO(ADD); END; %A11211700 EMITO(CDC); WTYPE ~ 3; %A11211800 SP ~ SP.[45:3]; SPT ~ FALSE %A11211900 END; %A11212000 IF SLT THEN EMITO(XCH); %A11212100 END ELSE %A11212200 IF SP ~ SP + S } 8 AND WTYPE = 4 THEN %A11212300 BEGIN %A11212400 WTYPE ~ 3; IF SLT THEN EMITPAIR(ST1,STD); %A11212500 EMITL(SP.[35:10]); EMITO(CDC); %A11212600 SP ~ SP.[45:3]; IF SLT THEN EMITV(ST1) %A11212700 END; %A11212800 END ELSE %A11212900 BEGIN IF SLT THEN EMITPAIR(ST1,STD); %A11213000 MOVE(5,SP,SPTEMP); % %A11213050 AEXP; EMITO(SSP); %A11213100 MOVE(5,SPTEMP,SP); % %A11213150 EMITPAIR(JUNK,ISN); %A11213200 IF SPT THEN %A11213300 BEGIN %A11213400 IF WTYPE = 4 THEN %A11213500 BEGIN IF SP ! 0 THEN %A11213600 BEGIN EMITL(SP); EMITO(ADD); END; %A11213700 EMITPAIR(ST2,SND); %A11213800 EMITL(8); EMITO(IDV); %A11213900 EMITO(ADD); EMITO(CDC); %A11214000 WTYPE ~ 3; EMITV(ST2); %A11214100 EMITI(0,45,3); EMITV(JUNK); %A11214200 END ELSE BEGIN EMITO(ADD); %A11214300 IF SLT THEN EMITV(ST1); %A11214400 EMITV(JUNK) END %A11214500 END ELSE %A11214600 BEGIN %A11214700 IF WTYPE = 4 THEN EMITPAIR(ST2,SND) %A11214800 ELSE EMITO(DUP); %A11214900 IF SP ! 0 THEN %A11215000 BEGIN EMITNUM(SP); EMITO(ADD); END; %A11215100 IF WTYPE = 4 THEN %A11215200 BEGIN %A11215300 WTYPE ~ 3; EMITPAIR(ST3,SND); %A11215400 EMITL(8); EMITO(IDV); %A11215500 EMITO(CDC); EMITV(ST3); %A11215600 EMITI(0,45,3); %A11215700 IF SLT THEN EMITV(ST1); %A11215800 EMITV(ST2) %A11215900 END ELSE %A11216000 BEGIN %A11216100 EMITO(XCH); %A11216200 IF SLT THEN %A11216300 BEGIN EMITV(ST1); EMITO(XCH) END %A11216400 END %A11216500 END; %A11216600 SPT ~ TRUE %A11216700 END; %A11216800 IF ELCLASS = RTPAREN THEN %A11216900 BEGIN %A11217000 STEPIT; %A11217100 IF NPT AND S = 0 THEN GO EXIT; %A11217200 IF SLT THEN %A11217300 BEGIN %A11217400 IF NPT THEN EMITNUM(S); %A11217500 L4: EMITO(SUB); EMITO(DUP); %A11217600 EMIT(0); EMITO(LSS); %A11217700 EMITERR(SGNO,L," 1"); %A11217800 END ELSE %A11217900 IF NPT THEN BEGIN %A11218000 IF SL ~ SL-S < 0 THEN %A11218100 BEGIN ERR(713); GO EXIT END %A11218200 END ELSE %A11218300 BEGIN %A11218400 EMITNUM(SL); EMITO(XCH); %A11218500 SLT ~ TRUE; GO L4 %A11218600 END; %A11218700 GO EXIT %A11218800 END OF SP ONLY PART; %A11218900 IF NOTCOMMA THEN GO EXIT; %A11219000 IF NLT ~ LITP(T) THEN %A11219100 BEGIN %A11219200 IF NPT THEN %A11219300 BEGIN %A11219400 IF SLT THEN %A11219500 BEGIN %A11219600 EMITNUM(S + T); EMITO(LSS); %A11219700 EMITERR(SGNO,L," 1"); %A11219800 END ELSE %A11219900 IF T + S > SL THEN %A11220000 BEGIN FLAG(713); ERRORTOG ~ TRUE END %A11220100 END ELSE %A11220200 BEGIN %A11220300 EMITNUM(T); EMITO(ADD); %A11220400 IF SLT THEN EMITO(LSS) ELSE %A11220500 BEGIN EMITNUM(SL); EMITO(GTR) END; %A11220600 EMITERR(SGNO,L," 1"); %A11220700 END; %A11220800 SL ~ T; SLT ~ FALSE %A11220900 END ELSE %A11221000 BEGIN %A11221100 MOVE(5,SP,SPTEMP); % %A11221150 AEXP; EMITO(SSP); %A11221200 MOVE(5,SPTEMP,SP); % %A11221250 EMITPAIR(ST1,ISN); %A11221300 IF NPT THEN EMITNUM(S); EMITO(ADD); %A11221400 IF SLT THEN EMITO(LSS) ELSE %A11221500 BEGIN EMITNUM(SL); EMITO(GTR); END; %A11221600 EMITERR(SGNO,L," 1"); %A11221700 EMITV(ST1); SLT ~ TRUE %A11221800 END; %A11221900 RTPARN; %A11222000 GO EXIT %A11222100 END; %A11222200 IF WTYPE = 4 THEN %A11222300 IF SPT THEN %A11222400 BEGIN SPT ~ FALSE; EMITO(CDC) END ELSE %A11222500 IF SP > 7 THEN BEGIN %A11222600 EMITL(SP.[35:10]); EMITO(CDC); %A11222700 SP ~ SP.[45:3]; %A11222800 WTYPE ~ 3 END; %A11222900 EXIT: IF WTYPE = 3 AND SL < 8 AND NOT SLT %A11223000 THEN WTYPE ~ 2; %A11223100 QUOTETOG ~ QO; %A11223200 IF RB AND ELCLASS = ASSIGNOP THEN BEGIN %A11223300 EMITV(RTYPE ~ RECARRAY[RTYPE].[11:11]); %A11223400 EMITPAIR(6,BFC); EMITV(RTYPE+2); EMITO(SSN); EMITPAIR(RTYPE+2, %A11223500 STD); EMITPAIR(4,BFW); EMITV(RTYPE+1); EMITO(SSN); %A11223600 EMITPAIR(RTYPE+1,STD) END; %A11223700 END OF STRINGVAR; %A11223800 % %A11223900 PROCEDURE STRINGSEC(FROM); VALUE FROM; REAL FROM; %A11224000 BEGIN %A11224100 IF FROM = 1 THEN STRINGVAR(FALSE); %A11224200 IF FROM ! 1 OR ELCLASS = ASSIGNOP THEN %A11224300 BEGIN %A11224400 ARRAY TEDC[0:3,0:127]; %A11224500 BOOLEAN RV; %A11224600 BOOLEAN BV,DLTO,DRTO,DPTO; %A11224700 REAL T,DLO,DRO,DPO,STKO,LCO,WT,JMPCHO; %A11224800 REAL R; %A11224850 LABEL EXIT,L9, L1,L2,L3,L4,L5,L6,L7,L8; %A11224900 SWITCH SW ~ L1,L2,L3,L4,L5,L6,L7,L8; %A11225000 DLTO ~ DLT; DPTO ~ DPT; DRTO ~ DRT; JMPCHO~ JMPCH; %A11225100 STKO~STK; LCO~LC; DLO~DL;DRO~DR; %A11225200 DLT~DPT~DRT~FALSE; %A11225300 DPO~DP; %A11225400 JMPCH~STK~LC~DR~0; %A11225500 MOVECODE(TEDC,EDC); %A11225600 QUOTETOG ~ TRUE; %A11225700 IF FROM > 4 THEN EMITL(REAL(FROM=7)) ELSE %A11225800 IF FROM = 1 AND SLT THEN %A11225900 EMITPAIR(DL~FORAD,STD); %A11226000 IF FROM ! 3 AND NOT SYMSEC THEN EMITO(MKS); %A11226100 GO TO SW[FROM]; %A11226200 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11226210 STEPIT; LC ~ 2; GO L7; %A11226220 L2: STRINGVAR(FALSE); %A11226300 IF SLT THEN EMITPAIR(DL~FORAD,STD); %A11226400 IF ELCLASS ! ASSIGNOP THEN BEGIN ERR(717); GO EXIT END; %A11226500 L1: IF NOT DLT~SLT THEN DL~SL; DP~SP; %A11226600 IF BV ~ (WT~WTYPE=1 AND DPT ~ SPT) THEN %A11226700 EMD(REAL(FROM=1) + 2,1); %A11226800 IF WTYPE > 2 AND NOT SPT THEN DPT ~ BOOLEAN(2); %A11226900 STK ~ REAL(FROM=1) + REAL(BV) + REAL(SPT); %A11227000 IF STEPI = ADOP THEN BEGIN %A11227100 T ~ REAL(DPT) & %A11227200 (STKC) [22:42:6] & %A11227300 (IF ELBAT[I].ADDRESS = ADD THEN FAD ELSE FSV) %A11227400 [41:42:6] & DP[28:35:13]; %A11227500 STEPIT; %A11227600 EMITPAIR(OUTSTR,LOD); %A11227700 ECR(STK,RDA); DP ~ 0; DPT ~ FALSE; %A11227800 STRINGXP(TRS,TRUE) END ELSE %A11227900 BEGIN T ~ 0; %A11228000 ECR(0,RDA); %A11228100 RCH(DPT,1,BV,STK,DP,SFD); %A11228200 IF NOT(DLT OR DPT OR WTYPE < 3 OR DL<32 ) THEN BEGIN %A11228300 IF ELCLASS=SPACEV OR ELCLASS = NILV THEN %A11228400 IF TABLE(I+1)!AMPERSAND AND TABLE(I+1)! LEFTPAREN THEN BEGIN %A11228500 INTEGER J,K,P; %A11228600 P ~ IF ELCLASS = SPACEV THEN " " ELSE 0; %A11228700 EC((T~(8-DP.[45:3]).[45:3])+8,BNS); %A11228800 EC(1,TRP); EMT(P); EC(0,ENS); %A11228900 ECR(0,RSA); %A11229000 IF T!0 THEN EC(0,SFS); %A11229100 J ~ (T~DL-T-8) DIV 8; %A11229200 T ~ T - J|8; %A11229300 IF K ~ J MOD 64 ! 0 THEN EC(K,TRW); %A11229400 IF J ~ J DIV 64 ! 0 THEN BEGIN %A11229500 EC(J,BNS); EC(32,TRW); EC(32,TRW); %A11229600 EC(0,ENS); END ; %A11229700 IF T ! 0 THEN BEGIN %A11229800 EC(T,BNS); EC(1,TRP); %A11229900 EMT(P); EC(0,ENS); END; %A11230000 T ~ 0; STEPIT; %A11230100 END ELSE STRINGXP(TRS,TRUE) ELSE %A11230200 STRINGXP(TRS,TRUE) END ELSE STRINGXP(TRS,TRUE) %A11230300 END; %A11230400 IF T ! 0 THEN BEGIN ECR(0,RDA); %A11230500 RCH(BOOLEAN(T),1,BV,REAL(FROM=1) + 2,T.[29:12],SFD); %A11230600 ECR(T.[22:6],RSA); %A11230700 IF DRT THEN BEGIN EMITV(DR); ECR(STKC,CRF); %A11230800 EC(0,T.[41:6]) END ELSE %A11230900 EC(DR.[42:6],T.[41:6]); END; %A11231000 EMTC; %A11231100 IF FROM = 1 AND DRT THEN EMITV(DR); %A11231200 SL ~ DR; SLT ~ DRT; %A11231300 WTYPE ~ WT; %A11231400 SPT ~ IF T ! 0 THEN BOOLEAN(T.[47:1]) ELSE DPT; %A11231500 SP ~ IF T ! 0 THEN T.[28:13] ELSE DP; %A11231600 GO EXIT; %A11231700 L3: EMIT(0); EMITO(MKS); %A11231800 STRINGSEC(1); %A11231900 IF BV ~ ELCLASS = RELOP THEN GO L9; %A11232000 IF SLT THEN BEGIN EMITPAIR(NSTR,SND); %A11232100 EMITO(DUP); EMITI(0,36,6); %A11232200 STK~ 3 END ELSE %A11232300 BEGIN EMITNUM(SL); EMITPAIR(NSTR,STD); STK ~ 1 END; %A11232400 IF BV ~ (WTYPE = 1 AND SPT) THEN BEGIN %A11232500 EMD(STK+1,1); STK ~ STK + 2; END ELSE %A11232600 STK ~ STK + REAL(SPT AND TRUE); %T9011232700 EMITPAIR(OUTSTR,LOD); %A11232800 ECR(0,RSA); %A11232900 RCH(SPT,1,BV,STK-1,SP,SFS); %A11233000 ECR(STK,RDA); %A11233100 IF SPT OR SP.[45:3] ! 0 OR SLT THEN %A11233200 RCH(SLT,STK-2-REAL(BV),TRUE,STK-1-REAL(BV),SL,TRS) ELSE %A11233300 BEGIN %A11233400 RCH(FALSE,0,FALSE,0,SL.[33:12],TRW); %A11233500 IF SL ~ SL.[45:3]!0 THEN EC(SL,TRS) END; %A11233600 EMTC; EMITV(STRINGPRINT); GO EXIT; %A11233700 L4: %A11233800 EMITPAIR(INSTR,LOD); %A11233900 ECR(0,RDA); %A11234000 EC(DP~3,SFD); %A11234100 DL ~ 31; STK ~ 0; %A11234200 STRINGXP(TRS,TRUE); %A11234300 ECR(0,RDA); EC(2,SFD); %A11234400 IF DRT THEN BEGIN %A11234500 EMITV(DR); %A11234600 EMITPAIR(COUNTI,SND); %A11234700 ECR(STKC,SES); %A11234800 EC(7,SFS); EC(1,TRS); END ELSE %A11234900 BEGIN %A11235000 EMITL(DR.[42:6]); EMITPAIR(COUNTI,STD); %A11235100 EC(1,TRP); EMT(DR.[42:6]) END; %A11235200 EMTC; GO TO EXIT; %A11235300 L5: %A11235400 EMITPAIR(OUTSTR,LOD); %A11235500 ECR(STK~2,RDA); %A11235600 DP ~ 0; DL ~ 8; %A11235700 STRINGXP(TRS,TRUE); %A11235800 ECR(0,SED); %A11235900 ECR(2,RSA); %A11236000 IF DRT THEN BEGIN %A11236100 EMITV(DR); %A11236200 ECR(STKC,CRF); %A11236300 EC(0,ICV); %A11236400 END ELSE %A11236500 EC(DR.[42:6],ICV); %A11236600 EMTC; GO TO EXIT; %A11236700 L6: %A11236800 EMIT(0); %A11236900 ECR(STK~ 2,SED); %A11237000 EC(1,SFD); DP ~ 1; DL ~ 7; %A11237100 STRINGXP(TRS,TRUE); %A11237200 ECR(0,SED); ECR(2,SES); %A11237300 EC(1,SFS); %A11237400 IF DRT THEN BEGIN %A11237500 EMITV(DR); %A11237600 EMITO(DUP); EMITL(8); EMITO(XCH); EMITO(SUB); %A11237700 ECR(STK~STK+2,CRF); %A11237800 EC(0,SFD); ECR(STK-1,CRF); %A11237900 EC(0,TRS); END ELSE %A11238000 BEGIN DR ~ DR.[45:3]; %A11238100 EC(8-DR,SFD); EC(DR,TRS) END; %A11238200 EMTC; GO EXIT; %A11238300 L7: BV ~ FALSE; %A11238400 STRINGSEC(1); %A11238500 IF ELCLASS ! RELOP THEN BEGIN %A11238600 ERR(714); GO EXIT END; %A11238700 L9: %A11238800 T ~ ELBAT[I].[36:12]; STEPIT; %A11238900 JMPCH ~ 0; %A11239000 IF DLT ~ SLT THEN EMITPAIR(DL~FORAD,STD) %A11239100 ELSE DL ~ SL; %A11239200 DP ~ SP; %A11239300 IF RV ~ (WTYPE=1 AND DPT ~ SPT) THEN EMD(4,3); %A11239400 ECR(2,RSA); %A11239500 RCH(DPT,3,RV,4,DP,SFS); %A11239600 IF NOT DPT AND WTYPE > 2 THEN DPT ~ BOOLEAN(2); %A11239700 STK ~ REAL(DPT.[47:1]) + REAL(RV) +2; %A11239800 IF FROM = 9 THEN BEGIN ECR(STKC,STC); EMIT(0); ECR(STK,CRF); %A11239810 EC(0,SFS); END; %A11239820 STRINGXP(IF T = 1393 THEN 1328 ELSE T,IF FROM = 9 THEN %A11239900 BOOLEAN(3) ELSE TRUE); %A11239910 IF FROM ! 9 THEN %A11239950 IF DLT OR DRT THEN DR ~ BUMPL; %A11240000 EMIT(0); L ~ L - 1; %A11240100 IF BV EQV T ! 1393 THEN BEGIN % ! %A11240200 IF FROM = 9 THEN BEGIN EC(1,INC); EC(1,JFW); END %A11240210 ELSE BEGIN EC(REAL(BV),SEC); ECR(0,STC) END; %A11240220 EMITJUMP(FALSE); %A11240230 IF FROM = 9 THEN EC(1,JNS) END ELSE %A11240240 BEGIN %A11240300 EC(2,IF FROM = 9 THEN JNS ELSE JFW); EMITJUMP(FALSE); %A11240400 IF FROM = 9 THEN EC(1,INC) ELSE %A11240500 BEGIN EC(REAL(BV),SEC); ECR(0,STC) END END; %A11240600 IF FROM = 9 THEN BEGIN EC(0,ENS); ECR(0,STC); R ~ LC; LC ~ 0; %A11240700 IF DRT OR DLT THEN BEGIN ECR(STKC,CRF); %A11240710 EMITL(1); EMITO(ADD); %A11240715 IF R > 61 THEN FLAG(604); EC(R-2,BNS) END ELSE %A11240720 BEGIN IF DL - DR > 62 THEN FLAG(699); EC(0,JFW); %A11240730 EC(DL - DR + 1,BNS);END; LC ~ R; %A11240740 IF ELCLASS = COMMA THEN BEGIN IF STEPI!REALID AND ELCLASS!ALFAID%A11240745 THEN BEGIN ERR(718); GO EXIT END; CHECKER(ELBAT[I]); %A11240750 % %A11240755 EMITN(ELBAT[I].ADDRESS); ECR(STKC,RDA); EC(7,SFD); %A11240760 EC(1,TRS); STEPIT END; %A11240765 IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104) END; %A11240770 EMTC; %A11240800 IF FROM ! 9 THEN BEGIN %A11240850 IF DRT OR DLT THEN BEGIN %A11240900 DL ~ BUMPL; ADJUST; %A11241000 EMITB(BFC,DR,L); EMITV(XITR); %A11241100 IF BV EQV T = 1393 THEN BEGIN EMITO(DEL); %A11241200 EMITL(REAL(BV)); END; %A11241300 EMITB(BFW,DL,L) END; %A11241400 IF BV THEN EMITV(BOOPRINT); %A11241500 END; %A11241550 GO EXIT; %A11241600 L8: %A11241700 ECR(0,SED); %A11241800 EC(STK~DP~1,SFD); DL ~ 7; %A11241900 STRINGXP(TRS,TRUE); %A11242000 EMTC; %A11242100 IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11242200 EXIT: %A11242300 IF DLT THEN DCRFR; %A11242400 IF DRT THEN DCRFR; %A11242500 DLT ~ DLTO; DPT ~ DPTO; DRT ~ DRTO; %A11242600 JMPCH ~ JMPCHO; STK ~ STKO; LC ~ LCO; %A11242700 DL ~ DLO; DR ~ DRO; %A11242800 MOVECODE(TEDC,EDC); %A11242900 IF FROM ! 1 THEN QUOTETOG ~ FALSE; %A11243000 END %A11243100 END OF STRINGSEC; %A11243200 PROCEDURE NVALINT; %A11243300 BEGIN %A11243400 % %A11243500 PROCEDURE EMITRET; %A11243600 BEGIN REAL A,B,T; %A11243700 IF T ~ PROINFO.CLASS = PROCID THEN STEPIT ELSE %A11243800 IF T < 31 THEN ERR(619) ELSE %A11243900 CASE T - STRINGPROCID OF BEGIN %A11244000 BEGIN QUOTETOG ~ TRUE; STEPIT; STRINGSEC(8); %A11244100 QUOTETOG ~ FALSE; EMITO(XCH); %A11244200 EMITPAIR(TAKE(GIT(PROINFO)).[30:10],STD); END; %A11244300 BEGIN T ~ TAKE(PROINFO.LINK + 1).[2:2]; %A11244400 DBLPLXP(T); EMITPAIR(514,STD); %A11244500 A ~ TAKE(GIT(PROINFO)).[30:10]; %A11244600 T ~ IF T = 2 THEN 2 ELSE 0; %A11244700 FOR B ~ 0 STEP 1 UNTIL T DO EMITPAIR(A+B,STD); %A11244800 EMITV(514) END; %A11244900 BEGIN QUOTETOG ~ TRUE; STEPIT; SEXPN; %A11245000 QUOTETOG ~ FALSE END; %A11245100 BEGIN STEPIT; RECOM( GETYPE (PROINFO)) END; %A11245200 BEGIN STEPIT; BEXP END; %A11245300 BEGIN STEPIT; AEXP END; %A11245400 BEGIN STEPIT; AEXP END; %A11245500 BEGIN STEPIT; AEXP; EMITPAIR(514,ISN); END; END; %A11245600 IF MODE > 0 AND (LEVEL=SUBLEVEL OR SOPG) THEN BEGIN %A11245700 EMIT(RETLIST); EMITO(NOP); RETLIST ~ L; EMITO(NOP); %A11245800 EMITO(NOP); END ELSE %A11245900 BEGIN FLAG(619); ERRORTOG ~ TRUE END %A11246000 END OF EMITRET; %A11246100 % %A11246200 PROCEDURE EMITXIT; %A11246300 BEGIN IF SOPG THEN BEGIN FLAG(620); ERRORTOG ~ TRUE END ELSE %A11246400 BEGIN EMIT(XITLIST); EMITO(NOP); XITLIST ~ L END; %A11246500 STEPIT; END; %A11246600 % %A11246700 PROCEDURE RECLAIMIT; %A11246800 IF STEPI ! LEFTPAREN AND RECLAIMTOG THEN BEGIN %A11246900 EMITO(MKS); EMITV(MARKER); EMITO(MKS); EMITV(COLLECT); END ELSE %A11247000 IF ELCLASS ! LEFTPAREN THEN ERR(105) ELSE %A11247100 BEGIN REAL T,R,S; %A11247200 IF STEPI = RECID OR ELCLASS = RECARRAYID THEN %A11247300 BEGIN %A11247400 REXP; %A11247500 IF RECTYPE ! 0 THEN BEGIN %A11247600 FIXRECORD(RECTYPE,4); %A11247700 RECTYPE ~ 0 END ELSE %A11247800 ERR(612); %A11247900 END ELSE %A11248000 IF NOT RECLAIMTOG THEN BEGIN %A11248100 EMIT(0); SEXPN; %A11248200 EMITO(CTC); %A11248300 IF SYMSTK THEN EMITPAIR(LNKROW,STD) ELSE BEGIN EMITO(DUP); %A11248350 GETCONTENTS(0,TRUE); EMITV(FREELIST); %A11248400 EMITO(XCH); EMITO(STD); %A11248500 EMITPAIR(FREELIST,STD); END; QUOTETOG~FALSE END ELSE %A11248600 ERR(621); %A11248700 IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT; %A11248800 END OF RECLAIMIT; %A11248900 PROCEDURE RECALLIT(ADR); VALUE ADR; REAL ADR; %A11249000 IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11249100 IF STEPI ! FILEID OR BOOLEAN(ELBAT[I].FORMAL) THEN %A11249200 ERR(622) ELSE% %A11250000 BEGIN EMITO(MKS); %A11250100 EMITPAIR(ELBAT[I].ADDRESS,LOD); %A11250200 EMITV(IF BOOLEAN(ADR) THEN REMEMBER ELSE RECALL); %A11250300 IF STEPI = RTPAREN THEN STEPIT ELSE %T9311250400 IF ELCLASS = COMMA THEN BEGIN I:=I-3; %T9311250402 IF BOOLEAN(ADR) THEN WRITESTMT ELSE READSTMT END ELSE %T9311250404 ERR(104); %T9311250406 END OF RECALLIT; %A11250500 PROCEDURE ADDPROP; %A11250600 BEGIN LABEL EXIT; REAL T; %A11250700 LABEL L; %A11250800 IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11250900 EMITO(MKS); QUOTETOG ~ TRUE; %A11251000 STEPIT ; SEXPN; %A11251100 MARKSYMNCR(1); %A11251200 IF ELCLASS ! COMMA THEN BEGIN %A11251300 L: ERR(606); GO EXIT END; %A11251400 QUOTETOG ~ TRUE; %A11251500 IF STEPI = FACTOP THEN BEGIN %A11251600 EMITL(4); EMIT(0); QUOTETOG ~ FALSE; %A11251700 IF STEPI ! COMMA THEN GO L; %A11251800 STEPIT; AEXP; T~ 1 END ELSE %A11251900 IF ELCLASS = DECLARATORS AND %A11252000 T ~ ELBAT[I].ADDRESS > 29 THEN BEGIN %A11252100 IF STEPI ! COMMA THEN GO L; %A11252200 QUOTETOG ~ FALSE;EMITL(2); EMITL(T); %A11252300 STEPIT; RECOM(T); T ~ 1 END ELSE %A11252400 BEGIN EMIT(0); SEXPN; MARKSYMNCR(1); %A11252500 QUOTETOG ~ TRUE; %A11252600 IF ELCLASS ! COMMA THEN GO L; STEPIT; %A11252700 SEXPN; MARKSYMNCR(1); QUOTETOG~ FALSE; %A11252800 T ~ 3 END; %A11252900 EMITV(ADDPROPA); MARKSYMDCR(-T); %A11253000 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11253100 EXIT: QUOTETOG ~ FALSE; %A11253200 END OF ADDPROP; %A11253300 PROCEDURE REMPROP; %A11253400 BEGIN LABEL EXIT; %A11253500 REAL T; %A11253600 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11253700 QUOTETOG ~ TRUE; %A11253800 EMITO(MKS); STEPIT; SEXPN; %A11253900 IF ELCLASS ! COMMA THEN BEGIN %A11254000 ERR(606); GO EXIT END; %A11254100 QUOTETOG ~ TRUE; %A11254200 IF STEPI = FACTOP THEN BEGIN %A11254300 EMITL(1); EMITL(3); QUOTETOG ~ FALSE; %A11254400 STEPIT; END ELSE %A11254500 IF ELCLASS = DECLARATORS AND %A11254600 T ~ ELBAT[I].ADDRESS > 29 THEN BEGIN %A11254700 EMIT(0); EMITNUM(T&1[32:47:1]); %A11254800 QUOTETOG ~ FALSE; STEPIT END ELSE %A11254900 BEGIN EMIT(0); SEXPN; QUOTETOG ~ FALSE END; %A11255000 EMITV(REMPROPER); %A11255100 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11255200 EXIT: QUOTETOG ~ FALSE %A11255300 END OF REMPROP; %A11255400 PROCEDURE PRINTER(TERPRI); VALUE TERPRI; BOOLEAN TERPRI; %A11255500 BEGIN LABEL NEXT,EXIT; %A11255600 LABEL L1; %A11255700 INTEGER TCOUNT,V,R,T; %A11255800 DEFINE FORMTOG = PRINFORM#; %A11255900 BOOLEAN BL,B,DP; %A11256000 PRINTOG ~ TRUE; %A11256100 PRINFORM ~ PRINFORM AND BOOLEAN(8188); %A11256200 IF STEPI = DECLARATORS THEN BEGIN %A11256300 IF T ~ ELBAT[I].ADDRESS=DOUBLEV THEN DP ~ DPTOG ~ TRUE ELSE %A11256400 IF T = FORMATV THEN FORMTOG ~ FORMTOG OR TRUE ELSE %A11256500 BEGIN ERR(638); GO EXIT END; STEPIT END; %A11256600 IF FORMTOG THEN %A11256700 BEGIN IF T ~REAL(PRINFORM.[35:11]) = 0 THEN %A11256800 PRINFORM.[36:11] := BOOLEAN(T:=GETSPACE(TRUE,-1)); %T9311256900 IF ELCLASS = LFTBRKET THEN BEGIN I ~ I - 1; BANA; %A11257000 EMITPAIR(T,STD); END; END; %A11257100 NEXT: IF ELCLASS = IFV THEN BEGIN IFCLAUSE; T ~ BUMPL; %A11257200 I~I-1;PRINTER(FALSE); IF ELCLASS=ELSEV THEN BEGIN %A11257300 EMITB(BFC,T,T~BUMPL); PRINTER(FALSE); EMITB(BFW,T,L) END ELSE %T9011257400 EMITB(BFC,T,L); END; EMITO(MKS); %A11257500 IF FORMTOG THEN IF FORMTOG.[46:1] THEN BEGIN %A11257600 IF TERPRI THEN %A11257605 IF (ELCLASS } UNTILV AND ELCLASS { ENDV) OR %A11257610 ELCLASS = RTBRKET OR ELCLASS = SEMICOLON THEN GO EXIT; %A11257620 EMITV(T~REAL(FORMTOG.[35:11])); EMITV(CP); EMITV(T); %A11257700 EMITO(RDV); EMITO(SUB); EMITV(SPACEPRINT); EMITO(MKS); END %A11257800 ELSE FORMTOG ~ FORMTOG OR BOOLEAN(2); %A11257900 IF ELCLASS=COMMA THEN BEGIN IF TABLE(I+1)=MULOP THEN BEGIN %A11258000 EMITV(TERPRIN); STEPIT END ELSE BEGIN EMITL(" "); %A11258100 EMITV(CHARPRINT); END; STEPIT; GO TO NEXT END; %A11258200 IF ELCLASS = CROSSHATCH THEN BEGIN %A11258300 TCOUNT ~ COUNT ~ 0; CHKND; RESULT ~ 5; %A11258400 SCANNER; %A11258500 IF V ~ EXAMIN(NCR) = "#" THEN BEGIN EMITL(ACCUM[1].[18:6]); %A11258600 RESULT ~ 5; SCANNER; STEPIT; %A11258700 EMITV(CHARPRINT); GO TO NEXT END; BL ~ FALSE; %A11258800 CHKND; EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %A11258900 GO TO L1; %A11259000 DO BEGIN COUNT ~ 0; %A11259100 L1: DO BEGIN B~BL; RESULT ~ 5; SCANNER; CHKND; %A11259200 IF (BL ~ V ~ EXAMIN(NCR)=" ") AND B THEN BEGIN %A11259300 DO BEGIN RESULT ~ 5; SCANNER; CHKND; %A11259400 COUNT ~ COUNT -1 END UNTIL V ~ EXAMIN(NCR)!" "; %A11259500 BL ~ FALSE END %A11259600 END UNTIL V = "#" OR COUNT = 63; %A11259700 TCOUNT ~ TCOUNT + COUNT; %A11259800 EMITC(COUNT,TRP); %A11259900 COUNT~(R~IF BOOLEAN(COUNT) THEN 2 ELSE 3) + COUNT; %A11260000 DO BEGIN T ~ 0; %A11260100 MOVECHARACTERS(2,ACCUM[1],R,T,6); %A11260200 EMIT(T); END UNTIL R~R+2 } COUNT; %A11260300 END UNTIL V = "#" OR TCOUNT = 896; %A11260400 EMITC(1,0); STREAMTOG ~ FALSE; %A11260500 IF V = "#" THEN BEGIN COUNT~0; RESULT~5; SCANNER; STEPIT END %A11260600 ELSE BEGIN ERR(623); GO EXIT END; %A11260700 STRINGMAX ~ MAX(TCOUNT,STRINGMAX); %A11260800 EMITL(TCOUNT); EMITPAIR(NSTR,STD); EMITO(MKS); %A11260900 EMIT(0); EMITV(STRINGPRINT) END ELSE %A11261000 IF (ELCLASS = FIELDID AND ELBAT[I].ADDRESS = STRINGV) OR %A11261100 (ELCLASS= STRTRNS AND ELBAT[I].INCR>7) OR %A11261200 ELCLASS = STRINGV OR ELCLASS = FILLV OR %T9011261250 ELCLASS = STRINGID OR ELCLASS = STRINGARRAYID THEN %A11261300 STRINGSEC(3) ELSE %A11261400 IF ELCLASS = SPACEV THEN BEGIN %A11261500 IF STEPI = LEFTPAREN THEN BEGIN I ~ I-1; PANA; EMITV(SPACEPRINT) %A11261600 END ELSE BEGIN EMITL(" "); EMITV(CHARPRINT) END END ELSE %A11261700 IF Q ~ ACCUM[1] = "5QMARK" THEN BEGIN STEPIT; EMITL(12); %A11261800 EMITV(CHARPRINT); END ELSE %A11261900 IF Q = "4SKIP0" THEN BEGIN PANA; %A11262000 EMITV(CP); EMITO(SUB); EMITV(SPACEPRINT); END ELSE %A11262100 IF (ELCLASS } UNTILV AND ELCLASS { ENDV) OR %A11262200 ELCLASS = RTBRKET OR %A11262300 ELCLASS = SEMICOLON THEN GO EXIT ELSE %A11262400 IF ELCLASS = ALFAID OR ELCLASS = ALFAARRAYID OR ELCLASS = ALFAPROCID %A11262500 OR ELCLASS=STRNGCON THEN BEGIN AEXP; EMITV(ALFPRINT) END ELSE %A11262600 IF Q = "2RL000" THEN BEGIN EMITO(MKS); EMITNUM("{!"); %A11262610 EMITV(ALFPRINT); STEPIT END ELSE %A11262620 BEGIN %A11262700 IF T ~ EXPRSS > 29 THEN BEGIN EMITO(MKS); %A11262800 MKALF(RECARRAY[T]); EMITV(ALFPRINT); %A11262900 EMITO(MKS); EMITL("-"); EMITV(CHARPRINT); %A11263000 EMIT(0); EMITV(ARITHPRINT); %A11263050 RECTYPE ~ 0 END ELSE %A11263100 IF T = DTYPE THEN BEGIN ERR(638); GO EXIT END ELSE %A11263200 CASE T OF BEGIN ERR(638); %A11263300 EMITV(BOOPRINT); %A11263400 ERR(638); %A11263500 BEGIN EMITL(REAL(FORMTOG)); EMITV(ARITHPRINT) END; %A11263600 ERR(638); %A11263700 EMITV(SYMPRINT); %A11263800 BEGIN EMITL(REAL(FORMTOG)); EMITV(DBLPRINT) END; %A11263900 EMITV(PLXPRINT); %A11264000 EMITV(DBLPLXPRINT); END; END; %A11264100 QUOTETOG ~ FALSE; %A11264200 DPTOG ~ DP ; GO NEXT ; %A11264300 EXIT: DPTOG ~ PRINTOG~ FALSE; %A11264400 IF TERPRI THEN EMITV(TERPRIN) ELSE L ~ L - 1; %A11264500 END OF PRINTER; %A11264600 PROCEDURE DONTS; %A11264700 BEGIN LABEL L,EXIT; BOOLEAN BV; REAL ADR; %A11264800 DPTOG~ TRUE; %A11264900 IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11265000 IF STEPI = FACTOP THEN BEGIN %A11265100 IF STEPI = FACTOP THEN BEGIN STEPIT; ADR ~ DBLSIG END ELSE %A11265200 ADR ~ SNGLSIG; %A11265300 L: IF ELCLASS ! COMMA THEN BEGIN ERR(606); GO EXIT END; %A11265400 DPTOG ~ FALSE; STEPIT; %A11265500 AEXP; EMITO(SSP); EMITO(DUP); EMITL(1); %A11265600 EMITO(LSS); EMITPAIR(2,BFC); EMITO(DEL); %A11265700 EMITL(1); EMITPAIR(ADR,IF BV THEN ISN ELSE ISD); %A11265800 IF BV THEN BEGIN EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11265900 EMITV(NTSER) END END ELSE %A11266000 BEGIN EMITO(MKS); DBLXP; BV ~ TRUE; %A11266100 ADR ~ JUNK; GO L END; %A11266200 IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11266300 EXIT: DPTOG ~ FALSE; %A11266400 END OF DONTS; %A11266500 PROCEDURE INPUTER; %A11266600 BEGIN LABEL EXIT,MARG,L1,LW,L2,L3; %A11266700 LABEL BF,SF; %BARRY FOLSOM LOVES SUSIE FOLSOM %T9311266750 BOOLEAN DACOM; %A11266800 REAL R; %A11266900 INOUTUSED.[44:1] ~1; % INPUT %A11267000 IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11267100 IF STEPI = LABELID THEN BEGIN DAC[0] ~ GNAT(ELBAT[I]); %A11267200 IF ELBAT[I].LVL ! 1 THEN FLAG(650); STEPIT END ELSE BEGIN %A11267300 IF ELCLASS = BOOID THEN %T9011267310 BEGIN DAC[22] ~ ELBAT[I].ADDRESS; %T9011267320 IF ELBAT[I].LVL ! 1 THEN FLAG(650); %T9011267330 STEPIT; %T9011267340 GO BF; %T9011267345 END ELSE %T9011267350 IF ELCLASS = FACTOP THEN GO MARG ELSE %T9311267400 %T9311267500 %T9311267600 IF ELCLASS = MULOP THEN GO LW; %A11267700 EMITL(1); EMITPAIR(INITI,STD); %A11267800 IF ELCLASS =FILEID THEN %A11267900 IF DAC[1] ! 0 THEN %T9011268000 BEGIN IF DACOM ~ ELBAT[I].LINK = DACP.LINK THEN %T9011268010 BEGIN IF DACOMI = 0 THEN DACOMI := GETSPACE(TRUE,-6); %T9311268020 IF DAC[3] = 0 THEN %T9011268030 BEGIN DAC[3] := GETSPACE(TRUE,-1); %T9311268040 DAC[4] := GETSPACE(TRUE,-1); %T9311268050 END; %T9011268060 EMITL(1); %T9011268070 END ELSE EMITL(0); %T9011268100 EMITPAIR(DAC[8],SND); %T9011268200 END ELSE EMIT(0) ELSE %T9011268300 IF ELCLASS = BOOPROCID THEN BEGIN EMITL(1); %A11268400 IF TAKE(GIT(ELBAT[I])).[40:8] ! 0 THEN GO L1 %A11268500 END ELSE %A11268600 BEGIN L1: ERR(624); GO EXIT END; %A11268700 EMITPAIR(PROI,STD); %A11268800 IF ELBAT[I].LVL ! 1 THEN FLAG(624); %A11268900 ERRORTOG ~ TRUE; %A11269000 R ~ ELBAT[I].ADDRESS; %A11269100 IF DACOM THEN BEGIN DAC[7]~ R; EMITL(DACOMI) END ELSE EMITL(R); %A11269200 EMITPAIR(FILPROI,STD); %A11269300 STEPIT; %A11269400 IF NOTCOMMA THEN GO EXIT; %A11269500 IF ELCLASS ! STRINGID OR %A11269600 (R~ELBAT[I]).LVL ! 1 OR %A11269700 BOOLEAN(R.FORMAL) OR %A11269800 R ~ TAKE(GIT(R)) < 0 THEN %A11269900 BEGIN ERR(625); GO EXIT END; %A11270000 IF DACOM THEN BEGIN IF DAC[5]=0 THEN DAC[5]~ELBAT[I].ADDRESS %A11270100 ELSE IF DAC[5] ! ELBAT[I].ADDRESS THEN FLAG(694);% %A11270200 EMITL(DAC[5]); EMITPAIR(STRI,STD); %A11270300 END; IF FALSE THEN BEGIN %T9011270350 DAC[6] ~ IF R > 136 THEN 136 ELSE R; %T9011270400 IF STEPI=COMMA AND TABLE(I+1)= LITNO THEN BEGIN STEPIT; %A11270500 IF R{R ~ ELBAT[I].ADDRESS THEN FLAG(649); EMITL(R); %T9011270600 STEPIT END ELSE EMIT(0); EMITPAIR(LMARGI,SND); %A11270700 EMITPAIR(RMARGI,SND); EMITPAIR(CPI,STD) END ELSE BEGIN %A11270800 EMITL(ELBAT[I].ADDRESS); %A11270900 EMITPAIR(STRI,STD); STEPIT; %A11271000 IF NOTCOMMA THEN GO EXIT; AEXP; EMITO(SSP); %A11271100 EMITO(DUP); EMITNUM(R); %A11271200 EMITO(GTR); EMITERR(SGNO,L," 5"); %A11271300 IF ELCLASS=RTPAREN THEN BEGIN EMITPAIR(RMARGI,SND); %A11271400 EMITPAIR(CPI,SND); EMIT(0); EMITPAIR(LMARGI,STD) END; %A11271500 EMITL(7); EMITO(ADD); EMITL(8); %A11271600 EMITO(IDV); EMITPAIR(LGI,STD); %A11271700 IF ELCLASS = RTPAREN THEN GO L2; %A11271800 MARG: %A11271900 IF NOTCOMMA THEN GO EXIT; %A11272000 IF ELCLASS = MULOP THEN GO LW; %A11272100 AEXP; EMITO(SSP); EMITPAIR(LMARGI,ISN); %A11272200 IF DACOM THEN BEGIN EMITV(DAC[6]); EMITO(GTR); GO SF END; %T9311272250 IF NOTCOMMA THEN GO EXIT; %A11272300 AEXP; EMITO(SSP); EMITPAIR(RMARGI,ISN); %A11272400 EMITPAIR(CPI,SND); %A11272500 EMITO(GTR); EMITV(RMARGI); %A11272600 % %A11272700 EMITV(LGI); EMITL(8); EMITO(MUL); %A11272800 EMITO(GTR); EMITO(LOR); %A11272900 SF: EMITERR(SGNO,L," 7"); %T9311273000 IF DACP.LINK!0 THEN BEGIN EMIT(0); EMITPAIR(DAC[1],STD) %A11273100 END END END; %A11273200 IF ELCLASS = RTPAREN THEN GO L2; %A11273300 IF NOTCOMMA THEN GO EXIT; %A11273400 IF ELCLASS ! MULOP THEN GO L3; %A11273500 LW: STEPIT; BEXP; %A11273600 EMITPAIR(WSIGN,STD); %A11273700 BF: IF ELCLASS = RTPAREN THEN L2: STEPIT ELSE %T9011273800 L3: ERR(104); %A11273900 EXIT: %A11274000 END OF INPUTER; %A11274100 PROCEDURE OUTPUTER; %A11274200 BEGIN LABEL EXIT, MARG,L1,L2; %A11274300 LABEL BF; %T9011274350 BOOLEAN DACOM; %A11274400 REAL R; %A11274500 INOUTUSED.[46:1] ~1; %OUTPUT %A11274600 IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11274700 IF STEPI = BOOID THEN BEGIN %A11274800 GPBV ~ ELBAT[I].ADDRESS; IF ELBAT[I].LVL!1 THEN FLAG(650); %A11274900 STEPIT; GO BF END ELSE BEGIN IF ELCLASS = FACTOP THEN %T9011275000 GO MARG; %T9311275100 %T9311275200 EMIT(0); EMITPAIR(OUTOG,STD); %A11275300 IF ELCLASS = FILEID THEN %A11275400 IF DAC[8] ! 0 THEN %T9011275500 BEGIN IF DACOM ~ ELBAT[I].LINK = DACP.[22:13] THEN %T9011275600 BEGIN GTLSTAT; EMITL(1); END ELSE EMITL(0); %T9011275700 EMITPAIR(DAC[8],SND); %T9011275800 END ELSE EMIT(0) ELSE %T9011276500 IF ELCLASS = PROCID THEN BEGIN EMITL(1); %A11276600 IF TAKE(GIT(ELBAT[I])).[40:8] ! 0 THEN %A11276700 GO L1 END ELSE %A11276800 BEGIN L1: ERR(624); GO EXIT END; %A11276900 EMITPAIR(PROTOG,STD); %A11277000 IF ELBAT[I].LVL ! 1 THEN FLAG(624); %A11277100 ERRORTOG ~ TRUE; %A11277200 R ~ ELBAT[I].ADDRESS; %A11277300 IF DACOM THEN BEGIN DAC[13]~R; EMITL(DACOMO) END ELSE EMITL(R); %A11277400 EMITPAIR(FILPRO,STD); %A11277500 STEPIT; %A11277600 IF NOTCOMMA THEN GO EXIT; %A11277700 IF ELCLASS ! STRINGID OR (R ~ ELBAT[I]).LVL ! 1 OR %A11277800 BOOLEAN(R.FORMAL) OR R ~ TAKE(GIT(R))<0 THEN %A11277900 BEGIN ERR(625); GO EXIT END; %A11278000 IF FALSE THEN BEGIN % IF DACOM THEN BEGIN %T9011278100 IF DAC[14]=0 THEN DAC[14] ~ ELBAT[I].ADDRESS ELSE %A11278200 IF DAC[14]! ELBAT[I].ADDRESS THEN FLAG(651); %A11278300 EMITL(DAC[14]); EMITPAIR(STRP,STD); %A11278400 DAC[15] ~ IF R > 136 THEN 136 ELSE R; % %T9011278500 IF DAC[2] = 0 THEN DAC[2] := GETSPACE(TRUE,-1); %T9311278530 EMIT(0); EMITPAIR(DAC[2],STD); % %T9011278560 EMITL(R); EMITPAIR(RMARG,STD); %A11278600 IF STEPI = COMMA AND TABLE(I+1)=LITNO THEN BEGIN STEPIT; %A11278700 IF R{R ~ ELBAT[I].ADDRESS THEN FLAG(693); STEPIT END ELSE% %A11278800 R ~ 0; EMITL(R); EMITPAIR(LMARG,SND); EMITPAIR(CP,STD); %A11278900 IF ELCLASS=COMMA THEN BEGIN %A11279000 IF STEPI ! LABELID OR ELBAT[I].LVL ! 1 THEN FLAG(654) ELSE %A11279100 BEGIN DAC[11] ~ GNAT(ELBAT[I]); STEPIT; GT1 ~ SCANR END; %A11279200 IF ELCLASS = COMMA THEN %A11279300 IF STEPI ! LABELID OR ELBAT[I].LVL ! 1 THEN FLAG(654) ELSE %A11279400 BEGIN DAC[12] ~ GNAT(ELBAT[I]); STEPIT END ELSE DAC[12] ~0 %A11279500 END ELSE DAC[11] ~ DAC[12] ~ 0; %A11279600 END ELSE BEGIN %A11279700 EMITL(ELBAT[I].ADDRESS); EMITPAIR(STRP,STD); %A11279800 STEPIT; %A11279900 IF NOTCOMMA THEN GO EXIT; AEXP; EMITO(SSP); %A11280000 EMITO(DUP); EMITNUM(R); %A11280100 EMITO(GTR); EMITERR(SGNO,L," 6"); %A11280200 IF ELCLASS=RTPAREN THEN BEGIN EMITPAIR(RMARG,SND); %A11280300 EMIT(0); EMITPAIR(CP,SND); EMITPAIR(LMARG,STD) END; %A11280400 EMITL(7); EMITO(ADD); EMITL(8); EMITO(IDV); %A11280500 EMITPAIR(LGO,ISD); %A11280600 IF ELCLASS = RTPAREN THEN GO L2; %A11280700 MARG: %A11280800 IF NOTCOMMA THEN GO EXIT; %A11280900 IF ELCLASS = BOOID THEN BEGIN GPBV ~ ELBAT[I].ADDRESS; %A11281000 IF ELBAT[I].LVL ! 1 THEN ERR(683);% %A11281100 IF STEPI=RTPAREN THEN GO L2; GO TO MARG END; %A11281200 AEXP; EMITO(SSP); %A11281300 EMITPAIR(LMARG,ISN); %A11281400 EMITPAIR(CP,SND); %A11281500 IF NOTCOMMA THEN GO EXIT; %A11281600 AEXP; EMITO(SSP); %A11281700 EMITPAIR(RMARG,ISN); %A11281800 EMITO(GTR); EMITV(RMARG); %A11281900 EMITV(LGO); EMITL(8); EMITO(MUL); %A11282000 EMITO(GTR); EMITO(LOR); %A11282100 EMITERR(SGNO,L," 8"); %A11282200 IF DACP.[22:13]!0 THEN BEGIN EMIT(0); EMITPAIR(DAC[8],STD); %A11282300 END END END; %A11282400 BF: IF ELCLASS = RTPAREN THEN L2: STEPIT ELSE %T9011282500 ERR(104); %A11282600 EXIT: %A11282700 END OF OUTPUTER; %A11282800 PROCEDURE REMOBIT; %A11282900 IF STEPI ! LEFTPAREN THEN BEGIN %A11283000 EMITO(MKS); EMIT(0); EMITN(SYMSTACKA); %A11283100 EMITO(ECM); STREAMTOG ~ TRUE; %A11283200 EMITC(8,TRP); EMIT(0); EMIT(0); EMIT(0); EMIT(0); %A11283300 EMITC(1,RSA); EMITC(2,BNS); %A11283400 EMITC(62,TRW); EMITC(0,ENS); %A11283500 EMITC(1,0); STREAMTOG ~ FALSE; %A11283600 END ELSE %A11283700 BEGIN EMITO(MKS); QUOTETOG ~ TRUE; %A11283800 STEPIT; %A11283900 SEXPN; QUOTETOG ~ FALSE; EMITV(REMOB); %A11284000 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END OF REMOBIT; %A11284100 CASE ELBAT[I].INCR OF BEGIN %A11284200 IF SYMFORMAT THEN ERR(660) ELSE EMITRET; %A11284300 EMITXIT; %A11284400 RECLAIMIT; %A11284500 RECALLIT(0); % %A11284600 RECALLIT(1); % %A11284700 ADDPROP; %A11284800 REMPROP; %A11284900 PRINTER(TRUE); %A11285000 PRINTER(FALSE); %A11285100 BEGIN TRPRI; STEPIT END; %A11285200 DONTS; %A11285300 INPUTER; %A11285400 OUTPUTER; %A11285500 REMOBIT; %A11285600 END END OF NVALINT; %A11285700 % %A11285800 % %A11285900 % %A11286000 PROCEDURE EMITNEWX; %A11286100 BEGIN REAL T,R,S; %A11286200 BOOLEAN STREAM PROCEDURE ALFTEST(V); VALUE V; %A11286300 BEGIN SI ~ LOC V; SI ~ SI + 7; IF SC = ALPHA THEN TALLY ~ 1; %A11286400 ALFTEST ~ TALLY END; %A11286500 PROCEDURE EMITFILL(A,N); VALUE N; INTEGER N; ARRAY A[0]; %A11286600 BEGIN %A11286700 INTEGER T,S; ARRAY TEDOC[0:7,0:127]; %A11286800 EMITNUM(SGAVL); EMITL(7); %A11286900 EMITO(COM); EMITO(DEL); EMITO(DEL); %A11287000 SEGMENTSTART; MOVECODE(TEDOC,EDOC); %A11287100 T ~ (N DIV 128) - 1; %A11287200 FOR S ~ 0 STEP 1 UNTIL T DO %A11287300 MOVE(128,A[S|128],EDOC[S,0]); % %A11287400 T ~ T + 1; %A11287500 MOVE(S ~ N MOD 128,A[T|128],EDOC[T,0]); %A11287600 SEGMENT(N,SGAVL,SGNO); %A11287700 MOVECODE(TEDOC,EDOC); %A11287800 SGAVL ~ SGAVL + 1; %A11287900 END OF EMITFILL; %A11288000 IF DACP ! 0 THEN BEGIN % REMOTE TERMINAL %T9011288100 IF DAC[1] = 0 THEN ERR(653) ELSE %T9011288200 IF DAC[9]!0THEN EMITARRAY(DAC[9],18,0,FALSE)ELSE FLAG(653);%T9011288300 END; % %T9011288400 IF DPI[44] ! 0 THEN BEGIN % LNK %A11288500 R ~ 32768 & 3 [1:46:2]; %A11288600 FOR T ~ 0 STEP 1 UNTIL 9 DO LNK[0,T] ~ R; %A11288700 R ~-32768; %A11288800 FOR T ~ 10 STEP 1 UNTIL 63 DO LNK[0,T] ~(IF ALFTEST(T) %A11288900 THEN R ELSE -65536) & LNK[0,T][33:33:15]; %A11289000 LNK[0,12] ~ -65536; % MAKE QMARK NON-ALF %A11289100 EMITARRAY(44,64,512,FALSE); %A11289200 IF RECLAIMTOG AND SFPL > LNKNDX THEN FLAG(667); %A11289250 R ~ LNKNDX.[33:6] - 1; %A11289300 FOR T ~ 0 STEP 1 UNTIL R DO BEGIN %A11289400 EMITL(T); EMITN(44); EMITO(LOD); %A11289500 EMITFILL(LNK[T,*],512) END; %A11289600 EMITL(R~R+1); EMITN(44); EMITO(LOD); %A11289700 EMITFILL(LNK[R,*], S ~ LNKNDX.[39:9] + 1); %A11289800 IF SYMSTK THEN BEGIN IF LNKNDX { 1023 THEN EMITL(LNKNDX) %A11289810 ELSE EMITREL(LNKNDX); EMITPAIR(LNKROW,STD) END ELSE BEGIN %A11289820 EMITL(R); EMITPAIR(LNKCOL,STD); %A11289900 IF DPI[59] !0 THEN BEGIN LNKNDX ~ LNKNDX + 1; %A11290000 IF S.[42:6] ! 0 THEN BEGIN S.[42:6] ~ 0; %A11290100 LNKNDX.[42:6] ~ 0; LNKNDX ~ LNKNDX + 64; S ~ S + 64 END; %A11290200 IF LNKNDX { 1023 THEN EMITL(LNKNDX) ELSE EMITREL(LNKNDX); %A11290210 EMITPAIR(FREENL,STD) END; %A11290220 EMITL(S); EMITPAIR(LNKROW,STD); END; %A11290300 END; %A11290350 IF DPI[45] ! 0 THEN BEGIN % SYMSTACK %A11290400 T ~ IF RECLAIMTOG THEN 256 ELSE %A11290500 IF DPI[89] ! 0 OR DPI[92] ! 0 THEN 128 ELSE 125; %A11290600 EMITARRAY(45,T,0,FALSE); %A11290700 EMITPAIR(45,LOD); EMITFILL(SYMSTACK[*],125); %A11290800 END; %A11290900 IF DPI[46] ! 0 THEN % INSTR %A11291000 EMITARRAY(46,8,0,FALSE); %A11291100 IF DPI[47] + DPI[107] ! 0 THEN BEGIN % OUTSTR %A11291200 %T9011291210 STRINGMAX ~ MAX (STRINGMAX,168) ; % %A11291220 %T9011291300 STRINGMAX ~ (STRINGMAX+7) DIV 8; %A11291400 EMITARRAY(23,STRINGMAX,0,TRUE); END; %A11291500 IF DPI[49] ! 0 OR DPI[82] ! 0 THEN BEGIN % RND %A11291600 EMITREL(.77712357123575); %A11291700 EMITPAIR(49,STD); END; %A11291800 IF REAL(PRINFORM.[35:11]) ! 0 THEN BEGIN EMITL(15); %A11291900 EMITPAIR(REAL(PRINFORM.[35:11]),STD); END; %A11292000 EMITL(1); EMITPAIR(OUTOG,SND); %A11292100 IF RECLAIMTOG THEN BEGIN EMITL(TABLEMARKV); %A11292200 EMITPAIR(TABLEMARK,STD) END; %A11292250 EMITPAIR(WSIGN,STD); %A11292300 EMITL(2); EMITPAIR(COLSET,STD); %A11292400 EMITL(5); EMITPAIR(SNGLSIG,STD); %A11292500 EMITL(22); EMITPAIR(DBLSIG,STD); %A11292600 END OF EMITNEWX; %A11292700 % %A11292800 PROCEDURE HANDLXIT; %A11292900 BEGIN REAL T; %A11293000 ADJUST; WHILE XITLIST ! 4095 DO BEGIN %A11293100 T ~ GET(XITLIST-2); %A11293200 EMITB(BFW,XITLIST,L); %A11293300 XITLIST ~ T END END; %A11293400 % %A11293500 PROCEDURE HANDLRET(BRANCH); VALUE BRANCH; BOOLEAN BRANCH; %A11293600 BEGIN REAL CL,T; CL ~ PROINFO.CLASS; %A11293700 IF BRANCH THEN BEGIN ADJUST; T ~ L; %A11293800 WHILE RETLIST ! 4095 DO BEGIN %A11293900 L ~ RETLIST; RETLIST ~ GET(RETLIST-2); %A11294000 IF CL = PROCID THEN EMITB(BFW,L,T) ELSE %A11294100 IF CL = DBLPLXPROCID THEN EMITB(BFW,L-1,T) ELSE %A11294200 BEGIN L ~ L-2; EMITPAIR(514,STD); %A11294300 EMITB(BFW,L+2,T) END END; %A11294400 L ~ T END ELSE %A11294500 BEGIN T ~ L; %A11294600 WHILE RETLIST ! 4095 DO BEGIN %A11294700 L ~ RETLIST - 2; RETLIST ~ GET(L); %A11294800 IF CL = PROCID THEN EMITO(XIT) ELSE EMITO(RTN) END; %A11294900 L ~ T END %A11295000 END OF HANDLRET; %A11295100 % %A11295200 % %A11295300 % %A11295400 REAL PROCEDURE TEMP(R); VALUE R; REAL R; %A11295500 DPI[R~R+29] ~ IF TEMP ~ ABS(DPI[R])!0 THEN -ABS(DPI[R]) ELSE %A11295600 -(TEMP:=GETSPACE(TRUE,-1)); %T9311295700 % %A11295800 REAL PROCEDURE GNATA(R); VALUE R; REAL R; %A11295900 DPI[R ~ R + 44] ~ GNATA ~ IF R = 47 THEN 23 ELSE R; %A11296000 % %A11296100 REAL PROCEDURE GNATP(K); VALUE K; REAL K; %A11296200 BEGIN %A11296300 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11296400 FORTERR; %A11296500 IF GNATP ~ DPI[K].ADDRESS = 0 THEN BEGIN %A11296600 IF GT1 := DPI[K].[33:6] = 0 THEN GT1 := GETSPACE(TRUE,-6); %T9311296700 DPI[K].ADDRESS ~ GNATP ~ GT1; %A11296800 CASE K OF BEGIN %A11296900 ; % ARCTAN 113 %A11297000 GT1 ~ GNATP(4); % 107 %A11297100 ; % 77 %A11297200 ; % 101 %A11297300 GT1 ~ GNATP(14); % 105 %A11297400 PUTADR(452,25); % 123 DSQRT %A11297500 GT1 ~ GNATP(3); % 104 %A11297600 GT1 ~ GNATP(0); % 115 %A11297700 PUTADR(452,25); % 53 %A11297800 BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 110 %A11297900 BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 100 %A11298000 BEGIN PUTADR(452,25); PUTADR(443,29); PUTADR(551,36); %A11298100 GT1 ~ GNATP(8); END; % 102 %A11298200 BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 106 %A11298300 BEGIN PUTADR(452,25); GT1 ~ GNATP(8) END; % 124 %A11298400 ; % 65 %A11298500 END; END; %A11298600 END OF GNATP; %A11298700 % %A11298800 REAL PROCEDURE GNATI(R); VALUE R; REAL R; %A11298900 BEGIN %A11298925 IF (R = 5 OR R = 27) AND LISTOG THEN %A11298950 WRITE(LINE,<"WARNING: IMPLICIT TRANSFER ENACTED">); %A11298960 IF DPI[GNATI ~ R ~ R + 50] = 0 THEN BEGIN %A11299000 DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11299100 DPI[R] ~ R; %A11299200 CASE R - 50 OF BEGIN %A11299300 R ~ GENLINK; %0 %A11299400 R ~ STRINGPRINT; % 1 %A11299500 R ~ GENLINK; % 2 %A11299600 R ~ STRINGPRINT; % 3 %A11299700 BEGIN R~LNKA; R ~PTABLE; R~INSTR; R~GENLINK END; %4 %A11299800 R ~ ERRPRO; % 5 %A11299900 BEGIN R ~ OUTSTR; R ~ SYMFIX END; % 6 %A11300000 R ~ TERPRIN; % 7 %A11300100 R ~ RITELINE; % 8 %A11300200 ; % 9 %A11300300 BEGIN R ~ DXP; R ~ DLOG END; % 10 %A11300400 BEGIN R ~ DBLFACT; R ~ DCOS; R ~ DSIN; R ~ DSQRT; %A11300500 R ~ DATN2 END ; % 11 %A11300600 BEGIN R ~ DBLPRINT; R ~ CHARPRINT END; % 12 %A11300700 BEGIN R ~ NTSER; R ~ STRINGPRINT END; % 13 %A11300800 ; % 14 %A11300900 BEGIN R ~ LNKA; R ~ ERRPRO; %A11301000 IF RECLAIMTOG THEN BEGIN R~MARKER;R~COLLECT END END; %15 %A11301100 R ~ GENLINK; % 16 %A11301200 R ~ LNKA; % 17 %A11301300 BEGIN R ~ LNKA; R ~ PTABLE END; % 18 %A11301400 R ~ MRK; % 19 %A11301500 BEGIN R ~ MARKD; R ~ MARKOB END; % 20 %A11301600 R ~ MRK; % 21 %A11301700 BEGIN R ~ LNKA; R ~ SYMEQ END; %A11301800 BEGIN R~LNKA; R~PTABLE; R~INSTR; R~GENLINK; END; %23 %A11301900 BEGIN R ~ SYMPRINT; R ~ BOOPRINT END; % 24 %A11302000 BEGIN R ~ SYMPRINT; R ~ ALFPRINT END; %25 %A11302100 R ~ LNKA; % 26 %A11302200 R ~ GENLINK; % 27 %A11302300 R ~ OUTSTR; % 28 %A11302400 BEGIN R ~ GNAT(429); R~ GNAT(551); R ~ CABS; R ~ GNAT(EXPI); %A11302500 R ~ GNAT(COSI); %A11302600 R ~ GNAT(SINI); R ~ GNAT(LOGI); %A11302700 R ~ GNAT(XTOTHEI) END; % 29 %A11302800 BEGIN R ~ CHARPRINT; R ~ ARITHPRINT END; % 30 %A11302900 R ~ LNKA; % 31 %A11303000 R ~ RND; % 32 %A11303100 BEGIN R ~ RANDNO; R ~ LENGTHV END; % 33 %A11303200 R ~ READSYM; % 34 %A11303300 BEGIN R ~ READCON; R ~ NTA END; % 35 %A11303400 BEGIN R ~ SCANR; R ~ ATCON; R ~ MKATM END; % 36 %A11303500 BEGIN R ~ READCON; R ~ TERPRIN; R ~ CHARPRINT END; % 37 %A11303600 R ~ READ1; % 38 %A11303700 BEGIN R ~ ERRPRO; R ~ SYMSTACKA END; %A11303800 BEGIN R ~ TERPRIN; R ~ READCON END; % 40 %A11303900 ; % 41 %A11304000 IF RECLAIMTOG THEN %A11304050 BEGIN R ~ MARKOB; R ~ COLLECT END; % 42 %A11304100 BEGIN R ~ LNKA; R ~ PTABLE END; % 43 %A11304200 R ~ LNKA; % 44 %A11304300 ; % 45 %A11304400 R ~ INSTR; % 46 %A11304500 R ~ RITELINE; % 47 %A11304600 BEGIN R ~ OUTSTR; R ~ TERPRIN END; % 48 %A11304700 R ~ SYMEQA; % 49 %A11304800 R ~ LNKA; % 50 %A11304900 R ~ LNKA; % 51 %A11305000 BEGIN R ~ ARITHPRINT; R ~ CHARPRINT; %A11305100 R~ SYMFIX; R ~ STRINGPRINT END; % 52 %A11305200 R ~ SPACEPRINT; % 53 %A11305300 ; % 54 %A11305400 END; %A11305500 END; %A11305550 END OF GNATI; %A11305600 % %A11305700 REAL PROCEDURE GNATR(T); VALUE T; REAL T; %A11305800 IF (GNATR ~ RECARRAY[T])<0 THEN %A11305900 BEGIN %A11306000 REAL S,R,J,K,B; %A11306100 REAL V; INTEGER P; %A11306200 RECARRAY[T]~ ABS(T ~ RECARRAY[T]); %A11306300 R ~ TAKE(J ~ GIT(T)); %A11306400 S ~ 0; %A11306450 FOR K ~ 1 STEP 1 UNTIL R DO BEGIN %A11306500 IF P ~ TAKE(B ~ TAKE(K+J)).ADDRESS = 0 THEN %A11306600 BEGIN Q ~ ACCUM[1]; ACCUM[1] ~ TAKE(B+1); %A11306700 FLAG(627); ERRORTOG ~ TRUE; ACCUM[1]~ Q END ELSE %A11306800 BEGIN V ~ TAKE(GIT(B)); %A11306900 IF P=3 THEN P ~((V.[22:13]+V.[35:13]+7) DIV 8)+ V.[8:7] ELSE %A11307000 P ~ V.[15:7] + 1; %A11307100 S ~ MAX(S,P) END END; %A11307200 IF TAKE(GIT(T.[22:13])).[16:10] < S THEN FLAG(659);% %A11307300 END OF GNATR; %A11307400 % %A11307500 % %A11307600 % %A11307700 PROCEDURE FIELDGEN; %A11307800 BEGIN REAL EL,G,K; LABEL EXIT,NEXT; INTEGER T1,T2; %A11307900 REAL T; %A11308000 IF SPECTOG THEN BEGIN ERR(628); GO EXIT END; %A11308100 IF G ~ GTA1[J ~J-1]=0 THEN G ~ REALV ELSE BEGIN %A11308200 IF G < STRINGV OR G = DOUBLEV OR (G{FIELDV AND G>INTV) THEN %A11308300 BEGIN ERR(629); GO EXIT END;% %A11308400 IF G = SYMV AND RECLAIMTOG THEN %A11308500 FLAG (629); %A11308600 CHKSOB; END; %A11308700 I ~ I - 1; %A11308800 NEXT: IF STEPI=FIELDID THEN BEGIN %A11308900 IF(EL ~ELBAT[I]).ADDRESS!0 AND EL.LVL= LEVEL THEN BEGIN %A11309000 ERR(630); GO EXIT END; %A11309100 T ~ GIT(EL); STEPIT; END ELSE BEGIN %A11309200 STOPENTRY ~ STOPGSP ~ TRUE; ENTRY(FIELDID); EL~ LASTINFO; %A11309300 STOPENTRY ~ STOPGSP ~ FALSE; T ~ NEXTINFO; PUTNBUMP(0); %A11309400 END; PUT(TAKE(EL)& G[16:37:11],EL); EL~0; %A11309500 IF ELCLASS = LEFTPAREN THEN BEGIN EL ~ GETLIT(127); %A11309600 IF ELCLASS=COMMA THEN K ~ GETLIT(127) ELSE K ~ EL; %A11309700 EL ~ 0&EL[8:41:7]&K[15:41:7]&REAL(EL!K)[1:47:1]; %A11309800 IF ELCLASS!RTPAREN THEN BEGIN ERR(104); GO EXIT END; STEPIT END; %A11309900 T1 ~ T2 ~ 0; %A11310000 IF G } STRINGV THEN BEGIN% %A11310100 IF ELCLASS= LFTBRKET THEN BEGIN %A11310200 T1 ~ GETLIT(IF G=STRINGV THEN 7 ELSE 47); %A11310300 IF ELCLASS!COLON THEN BEGIN ERR(631); GO EXIT END; %A11310400 T2 ~ GETLIT(IF G=STRINGV THEN 8183 ELSE 47); %A11310500 IF G=RECORDV OR G=SYMV THEN IF T2<15 THEN BEGIN ERR(632); GO EXIT END;%A11310600 IF ELCLASS!RTBRKET THEN BEGIN ERR(607); GO EXIT END; %A11310700 IF (IF G=STRINGV THEN 8184 ELSE 48)0 THEN BEGIN %A11314400 IF P.LVL! LEVEL THEN FLAG(655); STEPIT END ELSE %A11314500 BEGIN P~SAVEN; FLAG(656) END ELSE %A11314600 BEGIN P~SAVEN; FLAG(657) END; %A11314700 IF ELCLASS!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11314800 FIELDLIST(SAVEN,1); %A11314900 MOREWORDS ~2; %A11315000 RECARRAY[RECT]:=(-SAVEN)&P[22:35:13]&GETSPACE(FALSE,SAVEN +1) %T9311315100 [11:37:11]&(R:=TAKE(P:=GIT(P)).[2:5]+1)[6:43:5];MOREWORDS:=0; %T9311315200 PUT(TAKE(P)&R[2:43:5],P); IF R > 31 THEN FLAG(658); %A11315300 PUT(TAKE(SAVEN)&RECT[16:37:11] ,SAVEN); %A11315400 IF STEPI = COMMA THEN GO NEXT; %A11315500 EXIT: END OF RECORDGEN; %A11315600 % %A11315700 REAL PROCEDURE GETSTRINGLENGTH(MAIN,LS); VALUE MAIN,LS; REAL MAIN,LS; %A11315800 BEGIN REAL LG,N; INTEGER T; %A11315900 INTEGER S; %A11316000 LABEL EXIT,NEXT; %A11316100 IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11316200 NEXT: IF STEPI =LITNO OR ELCLASS=NONLITNO THEN T ~ C ELSE %A11316300 BEGIN STOPENTRY ~ STOPGSP~ TRUE; ENTRY(STRINGID); %A11316400 STOPENTRY ~ STOPGSP ~ FALSE; N ~ NEXTINFO ~ NEXTINFO + 1; %A11316500 I~I-1; T~ GETSTRINGLENGTH(MAIN,LS); PUT((-MAIN)&LS[22:35:13] %A11316600 & T[9:35:13],N-1); END; %A11316700 LS ~ LS + T; %A11316800 S ~ S + T; %A11316900 IF STEPI=COMMA THEN GO NEXT; %A11317000 IF ELCLASS!RTPAREN THEN ERR(104) ELSE %A11317100 IF GETSTRINGLENGTH ~ T ~ S < 1 OR S > 8184 THEN ERR(634); %A11317200 EXIT: STRINGMAX ~ MAX(STRINGMAX,T) END; %A11317300 % %A11317400 BOOLEAN PROCEDURE STRINGEN; %A11317500 BEGIN INTEGER T,K; BOOLEAN RTOG; REAL R; LABEL EXIT; %A11317600 REAL N; %A11317700 REAL SAVEINFO, SAVE2; %A11317800 BOOLEAN STOG; %A11317900 LABEL NEXT; IF NOT SPECTOG THEN BEGIN %A11318000 IF P2 ~ GTA1[J-1]=OWNV THEN J~J-1; %A11318100 IF P3 ~ GTA1[J-1]=SAVEV THEN J~J-1; END; CHKSOB; NEXT: %A11318200 SAVEINFO ~ NEXTINFO; ENTRY(STRINGID); IF SPECTOG THEN GO EXIT; %A11318300 N ~ GTA1[0]; %A11318400 SAVE2 ~ NEXTINFO ~ NEXTINFO + 1; I ~ I-1; %A11318500 T ~ GETSTRINGLENGTH(IF J=1 THEN SAVEINFO ELSE 0,0); %A11318600 PUT(T,SAVE2-1); %A11318700 IF RTOG ~ T>7 THEN BEGIN JUMPCHKX; EMITO(MKS) END; %A11318800 DO BEGIN R ~ TAKE(SAVEINFO); K ~ R.INCR; %A11318900 R.INCR ~ SAVE2 - SAVEINFO - 1; PUT(R,SAVEINFO); IF RTOG THEN %A11319000 IF R.CLASS=STRINGID THEN IF P2 THEN BEGIN EMITL(R.ADDRESS); %A11319100 EMITN(10) END ELSE EMITN(R.ADDRESS); %A11319200 SAVEINFO ~ SAVEINFO + K END UNTIL SAVE2-1=SAVEINFO; %A11319300 IF RTOG THEN BEGIN IF P2 THEN EMIT(0); EMITL(T~(T+7)DIV 8); %A11319400 EMITL(1); EMITL(N); EMITL(REAL(P3)+2|REAL(P2)); %A11319500 EMITV(5) END; %A11319600 IF RTOG THEN NOOFARRAYS ~ NOOFARRAYS + GTA1[0]; %A11319700 STOG ~ STOG OR RTOG; %A11319800 IF STEPI=COMMA THEN BEGIN STEPIT; GO TO NEXT END; %A11319900 STRINGEN ~ STOG; EXIT: %A11320000 END OF STRINGEN; %A11320100 % %A11320200 %A11320300 PROCEDURE EMITNONX; %A11320400 BEGIN REAL T,R,LO,A; BOOLEAN LSTO; %A11320500 ARRAY TEDOC[0:7,0:127], PA[0:56]; %A11320600 STREAM PROCEDURE WRTINTRSC(SGNO,ALFA,PRT,FIL); %A11320700 VALUE SGNO,PRT; %A11320800 BEGIN LOCAL T; %A11320900 DI ~ LOC T; SI ~ ALFA; %A11321000 DI ~ DI + 7; DS ~ CHR; %A11321100 DI ~ FIL; DS ~ 8 LIT " "; %A11321200 SI ~ FIL; DS ~ 14 WDS; %A11321300 DI ~ FIL; DI ~ DI + 6; %A11321400 SI ~ ALFA; SI ~ SI + 1; %A11321500 DS ~ T CHR; %A11321600 DS ~ LIT ":"; DI ~ FIL; DI ~ DI + 24; % %T0711321650 DS ~ 12 LIT " SEGMENT = "; % %T0711321700 SI ~ LOC SGNO; DS ~ 4 DEC; %A11321800 DS ~ 8 LIT "; PRT = "; % %T0711321900 SI ~ LOC PRT; SI ~ SI + 6; %A11322000 4(DS ~ 3 RESET; 3(IF SB THEN DS ~ SET ELSE DS ~ RESET; %A11322100 SKIP SB)); %A11322200 END; %A11322300 DEFINE %A11322400 % %A11322500 P2 = 125#, % FREELIST %A11322600 P3 = 126#, % LNKROW %A11322700 P4 = 127#; % LNKCOL %A11322800 DEFINE %A11322900 MARK = MRK#, %A11323000 FM1 = 897#, %A11323100 FM2 = 898#, %A11323200 FM3 = 899#, %A11323300 FM4 = 900#, %A11323400 FM5 = 901#, %A11323500 FM6 = 902#, %A11323600 FM7 = 903#, %A11323700 FM8 = 904#, %A11323800 FM9 = 905#, %A11323900 FP1 = 513#, %A11324000 FP2 = 514#, %A11324100 FP3 = 515#, %A11324200 FP4 = 516#, %A11324300 FP5 = 517#, %A11324400 FP6 = 518#, %A11324500 FP7 = 519#, %A11324600 FP8 = 520#, %A11324700 FP9 = 521#; %A11324800 PROCEDURE CALLRITE; FORWARD; %A11324900 PROCEDURE PRINCH(X); VALUE X; REAL X; %A11325000 BEGIN EMITO(MKS); EMITL(X); EMITV(CHARPRINT); END; %A11325100 PROCEDURE CHKFIN; %A11325200 BEGIN REAL T; %A11325300 EMITV(CP); EMITO(ADD); %A11325400 EMITPAIR(CP,ISN); EMITV(RMARG); EMITO(GEQ); %A11325500 T ~ BUMPL; %A11325600 CALLRITE; %A11325700 EMITB(BFC,T,L); %A11325800 END OF CHKFIN; %A11325900 PROCEDURE LODSTR; %A11326000 BEGIN %A11326100 EMITV(CP); EMITL(7); %A11326200 EMITO(LND); %A11326300 EMITV(STRP); EMITO(PRTE); EMITO(LOD); %A11326400 EMITV(CP); EMITL(8); EMITO(IDV); %A11326500 EMITO(CDC); EMITO(ECM); STREAMTOG ~ TRUE; %A11326600 EMITC(2,CRF); EMITC(0,SFD); %A11326700 END; %A11326800 PROCEDURE CALLRITE; %A11326900 BEGIN EMITO(MKS); EMITV(FILPRO); %A11327000 EMITO(PRTE); EMITO(LOD); EMITV(RITELINE); END; %A11327100 PROCEDURE EMITRD(RD,LG,STA,LAB); VALUE RD,LG,STA,LAB; %A11327200 BOOLEAN RD; REAL LG,STA,LAB; %A11327300 BEGIN REAL T; %A11327400 DEFINE BV = RD#; %A11327500 EMITO(MKS); %A11327600 EMITL(GNAT(POWERSOFTEN)); %A11327700 EMITO(LOD); EMITL(5); EMITN(FM1); % FILE %A11327800 EMIT(0); EMITL(1 + REAL(BV)); EMIT(0); %A11327900 EMITV(LG); EMITV(STA); %A11328000 EMITO(PRTE); EMITO(LOD); %A11328100 IF BV THEN BEGIN EMITL(LAB); EMITO(MKS); %A11328200 EMITN(512); EMITV(513); %A11328300 EMITV(GNAT(GOTOSOLVER)); %A11328400 END; %A11328500 FOR T~1 + REAL(BV) STEP 1 UNTIL 5 DO EMIT(0); %A11328600 EMITV(12 + REAL(BV)); %A11328700 END OF EMITRD; %A11328800 PROCEDURE SETBIT; %A11328900 BEGIN EMITO(MKS); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %A11329000 EMITC(3,RDA); EMITC(1,BIS); EMITC(1,0); STREAMTOG ~ FALSE END; %A11329100 PROCEDURE EMITADDPROP; %A11329200 BEGIN REAL T; %A11329300 EMIT(0); EMITV(FM4); %A11329400 GETCONTENTS(0,TRUE); EMITO(DUP); %A11329500 EMITO(LOD); %A11329600 EMITL(2); EMITDIAL(DIA,46); %A11329700 EMITDIAL(DIB,1); %A11329800 EMITFC(FCE,2); EMITO(LNG); %A11329900 EMITPAIR(1,BFC); EMITO(XIT); %A11330000 EMITO(DUP); EMIT(0); %A11330100 EMITO(XCH); EMITO(CTC); %A11330200 EMITV(FM3); %A11330300 EMITO(BFW); %A11330400 T ~ L ~ L + 4; %A11330500 EMITL(3); EMITD(46,2,2); %A11330600 EMITV(FM1); EMITD(19,4,29); %A11330700 EMITPAIR(10,BFW); %A11330800 EMITB(BFW,T,L); EMITL(1); %A11330900 EMITD(46,2,2); %A11331000 EMITB(BFW,T-2,L); %A11331100 EMITV(FM1); EMITO(CTF); %A11331200 EMITV(FM2); EMITD(33,3,15); %A11331300 GENSYMLINK; EMITO(CTC); %A11331400 EMITO(XCH); EMITO(STD); %A11331500 EMITO(XIT); %A11331600 END OF EMITADDPROP; %A11331700 PROCEDURE EMITALFPRINT; %A11331800 BEGIN %A11331900 EMIT(0); %A11332000 EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11332100 EMIT(0); EMITL(8); EMIT(0); EMITO(MKS); %A11332200 EMITV(FM1); EMITO(ECM); %A11332300 STREAMTOG ~ TRUE; %A11332400 EMITC(1,SES); EMITC(0,SEC); %A11332500 EMITC(7,BNS); EMITC(0,TEQ); %A11332600 EMITC(3,JNC); EMITC(1,SFS); %A11332700 EMITC(1,INC); EMITC(0,ENS); EMITC(5,STC); %A11332800 EMITC(3,STC); EMITC(1,0); %A11332900 STREAMTOG ~ FALSE; %A11333000 EMITO(SUB); %A11333100 EMITO(DUP); EMITV(CP); EMITO(ADD); %A11333200 EMITV(RMARG); EMITO(GTR); %A11333300 EMITPAIR(2,BFC); EMITO(MKS); EMITV(TERPRIN); %A11333400 EMITO(MKS); EMITV(FM1); LODSTR; %A11333500 EMITC(3,SES); EMITC(6,CRF); %A11333600 EMITC(0,SFS); EMITC(5,CRF); %A11333700 EMITC(0,TRS); EMITC(1,0); %A11333800 STREAMTOG ~ FALSE; %A11333900 EMITV(CP); EMITO(ADD); EMITPAIR(CP,SND); %A11334000 EMITV(RMARG); EMITO(LSS); EMITPAIR(1,BFC); %A11334100 EMITO(XIT); CALLRITE; EMITO(XIT); %A11334200 END OF EMITALFPRINT; %A11334300 PROCEDURE EMITAPPEND; %A11334400 BEGIN REAL T; %A11334500 EMIT(0); %A11334600 EMIT(0); % FP2 %A11334700 EMIT(0); MARKDESC(1); %A11334800 EMITV(FM2); GETCONTENTS(0,FALSE); %A11334900 EMITO(DUP); EMIT(0); %A11335000 EMITO(LSS); %A11335100 T ~ BUMPL; %A11335200 MARKSYMDCR(-3); %A11335300 EMITV(FM1); EMITO(RTN); %A11335400 EMITB(BFC,T,L); %A11335500 T ~ L; %A11335600 EMITL(1); EMITV(FP2); %A11335700 EMITO(ADD); EMITPAIR(FP2,STD); %A11335800 EMITO(DUP); %A11335900 GETCONTENTS(0,FALSE); %A11336000 EMITO(DUP); EMIT(0); %A11336100 EMITO(LSS); %A11336200 EMITB(BBC,BUMPL,T); EMITO(DEL); %A11336300 EMITV(FM1); %A11336400 T ~ L; %A11336500 EMITO(CTC); %A11336600 GENSYMLINK; %A11336700 EMITPAIR(FP3,SND); %A11336800 EMITV(FP2); EMITL(1); EMITO(SUB); %A11336900 EMITPAIR(FP2,SND); EMIT(0); %A11337000 EMITO(EQL); %A11337100 EMITB(BBC,BUMPL,T); %A11337200 MARKSYMDCR(-3); EMITO(RTN); %A11337300 END OF EMITAPPEND; %A11337400 PROCEDURE EMITARITHPRINT(BV); VALUE BV; BOOLEAN BV; %A11337500 BEGIN COMMENT BV IS TRUE IS DOUBLE; %A11337600 EMIT(0); %A11337700 EMITO(MKS); %A11337800 IF BV THEN EMITV(FM3) ELSE EMIT(0); %A11337900 EMITV(FM2); %A11338000 EMITV(IF BV THEN DBLSIG ELSE SNGLSIG); %A11338100 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11338200 EMITV(NTSER); %A11338300 EMITV(FM1); EMITPAIR(5,BFC); EMITO(MKS); %A11338400 EMITL(1); %A11338500 EMITV(JUNK); %A11338600 EMITO(SUB); %A11338700 EMITV(SPACEPRINT); %A11338800 EMITO(MKS); EMITL(1); EMITV(STRINGPRINT); %A11338900 EMITO(XIT); %A11339000 END OF EMITARITHPRINT; %A11339100 PROCEDURE EMITATCON; %A11339200 BEGIN REAL T,R,S,V; %A11339300 EMIT(0); %A11339400 EMIT(0); EMITV(INSTR); %A11339500 EMITV(COUNTI); EMITL(1); %A11339600 EMITO(LEQ); %A11339700 T ~ BUMPL; %A11339800 EMITI(0,18,6); EMITPAIR(INSYM,STD); %A11339900 EMITL(1); EMITO(RTN); %A11340000 EMITB(BFC,T,L); %A11340100 EMITL(125); %A11340200 EMITO(RDV); EMITV(SYMSTACKA); %A11340300 EMITO(DUP); EMITL(0); EMITO(EQL); %A11340400 EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11340500 S ~ L; %A11340600 EMITO(DUP); GETCONTENTS(0,FALSE); %A11340700 EMITO(DUP); GETCONTENTS(1,FALSE); EMITO(DUP); %A11340800 EMITI(0,1,5); EMITO(DUP); EMITV(COUNTI); %A11340900 EMITO(EQL); %A11341000 T ~ BUMPL; %A11341100 EMITO(DUP); EMITL(7); EMITO(GTR); %A11341200 EMITPAIR(3,BFC); %A11341300 EMITL(4); EMITPAIR(1,BFW); %A11341400 EMITO(DUP); EMIT(0); %A11341500 V ~ L; %A11341600 EMIT(0); EMITO(MKS); EMIT(0); EMITN(INSTR); %A11341700 EMITO(ECM); STREAMTOG ~ TRUE; %A11341800 EMITC(4,CRF); EMITC(0,SFD); %A11341900 EMITC(3,SFD); EMITC(7,SES); %A11342000 EMITC(1,SFS); EMITC(5,CRF); %A11342100 EMITC(0,CNE); EMITC(2,JFC); %A11342200 EMITC(1,SEC); EMITC(3,STC); %A11342300 EMITC(1,0); STREAMTOG ~ FALSE; %A11342400 R ~ BUMPL; %A11342500 EMITO(DEL); EMITO(DEL); %A11342600 EMITB(BFC,T,L); %A11342700 EMITO(DEL); EMITO(DEL); %A11342800 EMITI(0,3,15); EMITO(DUP); %A11342900 EMITL(1); EMITO(LEQ); %A11343000 EMITPAIR(2,BFC); %A11343100 EMIT(0); EMITO(RTN); %A11343200 EMITO(XCH); EMITO(DEL); %A11343300 EMITB(BBW,BUMPL,S); %A11343400 EMITB(BFC,R,L); %A11343500 EMITO(ADD); %A11343600 EMITO(DUP); EMITV(FP5); %A11343700 EMITO(XCH); EMITO(SUB); %A11343800 EMITO(DUP); EMIT(0); %A11343900 EMITO(EQL); %A11344000 EMITPAIR(5,BFC); %A11344100 EMITV(FP2); EMITPAIR(INSYM,STD); %A11344200 EMITL(1); EMITO(RTN); %A11344300 EMITO(DUP); EMITL(7); %A11344400 EMITO(GTR); %A11344500 EMITPAIR(2,BFC); EMITO(DEL); %A11344600 EMITL(4); EMITO(XCH); %A11344700 EMITV(FP4); GETCONTENTS(0,FALSE); %A11344800 EMITPAIR(FP4,STD); %A11344900 EMITB(BBW,BUMPL,V); %A11345000 END OF EMITATCON; %A11345100 PROCEDURE EMITATN; %A11345200 BEGIN %A11345300 EMIT(0); %A11345400 EMIT(0); EMITV(FM2); EMITO(CTC); %A11345500 EMITPAIR(FM2,SND); %A11345600 EMITL(10); EMITO(LSS); %A11345700 EMITPAIR(1,BFC); EMITO(XIT); %A11345800 EMITV(FM2); GETCONTENTS(0,FALSE); %A11345900 EMITO(DUP); EMITI(0,1,2); %A11346000 EMITL(3); EMITO(NEQ); %A11346100 EMITERR(SGNO,L,"11"); %A11346200 GETCONTENTS(0,FALSE); %A11346300 EMITPAIR(FM2,STD); EMITO(XIT); %A11346400 END OF EMITATN; %A11346500 PROCEDURE EMITATSTRV; %A11346600 BEGIN REAL T,R; %A11346700 EMIT(0); %A11346800 EMITV(FM7); EMITL(64); %A11346900 EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11347000 EMITFC(FCL,15); %A11347100 T ~ BUMPL; %A11347200 EMIT(0); EMITO(XCH); %A11347300 EMITD(42,6,6); EMITPAIR(FM7,STD); %A11347400 EMITL(1); EMITPAIR(FM2,SND); %A11347500 EMITO(RTN); %A11347600 EMITB(BFC,T,L); %A11347700 GETCONTENTS(0,FALSE); %A11347800 EMITL(2); EMITDIAL(DIA,46); %A11347900 EMITDIAL(DIB,1); %A11348000 EMITFC(FCE,2); %A11348100 R ~ BUMPL; %A11348200 EMITO(MKS); EMITV(SYMFIX); %A11348300 EMITO(DEL); EMITV(NSTR); %A11348400 EMITO(DUP); EMITL(7); %A11348500 EMITO(RDV); EMITPAIR(FM2, ISD); %A11348600 EMITO(DUP); EMITL(7); %A11348700 EMITO(IDV); EMITPAIR(FM3,ISD); %A11348800 EMITO(MKS); EMIT(0); %A11348900 EMITN(OUTSTR); EMITO(ECM); %A11349000 STREAMTOG ~ TRUE; %A11349100 EMITC(1,RSA); EMITC(12,SED); %A11349200 EMITC(8,CRF); EMITC(3,BNS); %A11349300 EMITC(1,SFD); EMITC(7,TRS); %A11349400 EMITC(0,ENS); %A11349500 EMITC(1,SFD); %A11349600 EMITC(7,CRF); EMITC(0,TRS); %A11349700 EMITC(1,0); STREAMTOG ~ FALSE; %A11349800 EMITO(RTN); %A11349900 EMITB(BFC,R,L); %A11350000 EMITL(12); %A11350100 EMITB(BBW,BUMPL,T); %A11350200 END OF EMITATSTRV; %A11350300 PROCEDURE EMITBOOPRINT; %A11350400 BEGIN %A11350500 EMIT(0); %A11350600 EMITV(FM1); EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11350700 EMITPAIR(3,BFC); EMITL(0); %A11350800 EMITPAIR(1,BFW); EMITL(1); %A11350900 EMITO(DUP); EMITL(4); %A11351000 EMITO(ADD); EMITO(DUP); %A11351100 EMITV(CP); EMITO(ADD); %A11351200 EMITV(RMARG); EMITO(GTR); %A11351300 EMITPAIR(2,BFC); %A11351400 EMITO(MKS); EMITV(TERPRIN); %A11351500 EMITO(MKS); LODSTR; %A11351600 EMITC(5,CRF); EMITC(0,JFW); EMITC(5,JFW); %A11351700 EMITC(5,TRP); EMIT(" F"); %A11351800 EMIT("AL"); EMIT("SE"); EMITC(3,JFW); %A11351900 EMITC(4,TRP); EMIT("TR"); EMIT("UE"); %A11352000 EMITC(1,0); STREAMTOG ~ FALSE; %A11352100 EMITV(CP); EMITO(ADD); %A11352200 EMITPAIR(CP,SND); EMITV(RMARG); %A11352300 EMITO(LSS); EMITPAIR(1,BFC); EMITO(XIT); %A11352400 CALLRITE; EMITO(XIT); %A11352500 END OF EMITBOOPRINT; %A11352600 PROCEDURE EMITCHARPRINT; %A11352700 BEGIN REAL T; %A11352800 EMIT(0); EMITV(OUTOG); %A11352900 EMITPAIR(1,BFC); EMITO(XIT); %A11353000 EMITV(CP); EMITL(1); EMITO(ADD); %A11353100 EMITV(RMARG); EMITO(GTR); %A11353200 T ~ BUMPL; %A11353300 CALLRITE; %A11353400 EMITB(BFC,T,L); %A11353500 EMITO(MKS); EMITV(FM1); LODSTR; %A11353600 EMITC(3,SES); EMITC(7,SFS); %A11353700 EMITC(1,TRS); EMITC(1,0); %A11353800 STREAMTOG ~ FALSE; %A11353900 EMITL(1); CHKFIN; %A11354000 EMITO(XIT); %A11354100 END OF EMITCHARPRINT; %A11354200 PROCEDURE EMITCOLLECT; %A11354300 BEGIN %A11354400 REAL L1; %A11354500 REAL L2; %A11354600 DEFINE DOIT = %A11354700 EMITC(1,BIT); EMITC(5,JFC); %A11354800 EMITC(1,BIR); EMITC(7,SFD); %A11354900 EMITC(1,INC); EMITC(8,SFS); %A11355000 EMITC(21,JFW); EMITC(3,STC); %A11355100 EMITC(2,RSA); EMITC(1,TRW); %A11355200 EMITC(2,RDA); EMITC(4,SES); %A11355300 EMITC(1,SFS); EMITC(7,TRS); %A11355400 EMITC(7,SFS); EMITC(1,TRS); %A11355500 EMITC(1,INC); EMITC(3,STC); %A11355600 EMITC(1,RSA); EMITC(1,RDA); %A11356000 EMITC(3,CRF); EMITC(2,BNS); %A11356100 EMITC(8,SFD); EMITC(0,ENS); %A11356200 EMITC(3,CRF); EMITC(2,BNS); %A11356300 EMITC(8,SFS); EMITC(0,ENS)#; %A11356400 DEFINE R = FP2#, C = FP3#, T = FP4#; %A11356500 EMIT(0); %A11356600 EMITV(FREENL); EMITI(0,39,3); % R %A11356700 EMITV(FREENL); EMITI(0,33,6); % C %A11356800 L1 ~L; %A11356900 EMITO(DUP); EMITV(LNKCOL); EMITO(GTR); %A11357000 L2 ~ BUMPL; %A11357100 EMITL(512); EMITPAIR(LNKROW,STD); %A11357200 EMITV(FREEN); EMITL(1); EMITO(ADD); %A11357300 EMITPAIR(FREEN,STD); EMITO(XIT); %A11357400 EMITB(BFC,L2,L); %A11357500 EMITO(DUP); EMITL(8); EMITO(MUL); %A11357600 EMITPAIR(JUNK,ISN); %A11357700 L2 ~ L; %A11357800 EMITO(MKS); %A11357900 EMITV(T); EMITV(R); EMITO(ADD); %A11358000 EMIT(0); EMITN(FREELIST); %A11358100 EMITV(C); EMITN(LNKA); EMITO(LOD); %A11358200 EMITV(R); EMITL(64); EMITO(MUL); %A11358300 EMITO(CDC); EMITO(ECM); %A11358400 STREAMTOG ~ TRUE; %A11358500 EMITC(1,RSA); EMITC(2,BNS); %A11358600 EMITC(32,BNS); DOIT; EMITC(0,ENS); %A11358700 EMITC(0,ENS); %A11358800 EMITC(1,0); STREAMTOG ~ FALSE; %A11358900 EMITV(R); EMITL(1); EMITO(ADD); %A11359700 EMITO(DUP); EMITL(8); EMITO(EQL); %A11359800 EMITPAIR(9,BFC); %A11359900 EMITO(DEL); EMITO(DEL); %A11360000 EMITL(1); EMITO(ADD); %A11360100 EMIT(0); EMITPAIR(R,STD); %A11360150 EMITB(BBW,BUMPL,L1); %A11360200 EMITPAIR(R,STD); %A11360300 EMITB(BBW,BUMPL,L2); %A11360400 END OF EMITCOLLECT; %A11360500 PROCEDURE EMITDBLFACT; %A11360600 BEGIN REAL T,R,S; %A11360700 DEFINE YLO = FM5#, YHI = FM4#, %A11360800 XLO = FM2#, XHI = FM1#, DLN = DLOG#; %A11360900 EMIT(0); %A11361000 EMITV(XLO); EMIT(0); EMITO(EQL); %A11361100 T ~ BUMPL; %A11361200 EMITV(XHI); EMIT(0); EMITO(EQL); %A11361300 R ~ BUMPL; %A11361400 EMIT(0); EMITPAIR(YLO,STD); %A11361500 EMITL(1); EMITPAIR(YHI,STD); EMITO(XIT); %A11361600 EMITB(BFC,R,L); %A11361700 EMITV(XHI); EMITI(0,2,36); %A11361800 EMIT(0); EMITO(EQL); %A11361900 R ~ BUMPL; %A11362000 EMIT(0); EMITV(XHI); EMITO(DUP); EMITO(SSP); %A11362100 EMITPAIR(XHI,STD); EMIT(0); %A11362200 EMITO(LSS); EMITO(DUP); %A11362300 EMITPAIR(2,BFC); EMIT(0); EMITL(1); %A11362400 EMITV(YLO); EMITV(YHI); %A11362500 EMITV(XHI); EMITL(1); EMITO(NEQ); %A11362600 S ~ BUMPL; %A11362700 EMITV(XHI); EMITPAIR(12,BFC); EMITV(FP2); EMITL(1); %A11362800 EMITO(ADD); EMITPAIR(FP2,STD); EMITPAIR(XLO,STD); %A11362900 EMITO(DUP); EMITV(XLO); EMITO(XCH); %A11363000 EMITPAIR(2,BFW); %A11363100 EMITPAIR(XLO,STD); %A11363200 EMITO(DUP); EMITV(XLO); EMITO(XCH); %A11363300 EMITV(XLO); EMITO(ML2); %A11363400 EMITV(XHI); EMITL(2); EMITO(IDV); %A11363500 EMITPAIR(XHI,ISN); EMITL(1); %A11363600 EMITO(EQL); %A11363700 EMITB(BBC,BUMPL,S); %A11363800 EMITB(BFC,S,L); %A11363900 EMITV(FP2); EMIT(0); EMITO(NEQ); %A11364000 S ~ BUMPL; %A11364100 EMITV(FP2); EMITL(1); EMITO(SUB); %A11364200 EMITPAIR(FP2,STD); %A11364300 EMITO(ML2); %A11364400 EMITB(BBW,BUMPL,S-5); %A11364500 EMITB(BFC,S,L); %A11364600 EMITV(FP3); EMITPAIR(1,BFC); EMITO(DV2); %A11364700 S ~ BUMPL; %A11364800 EMITB(BFC,T,L); %A11364900 EMITB(BFC,R,L); %A11365000 EMITO(MKS); %A11365100 EMITO(MKS); %A11365200 EMITV(YLO); EMITV(YHI); %A11365300 EMITV(DLN); EMITV(JUNK); EMITV(XLO); EMITV(XHI); %A11365400 EMITO(ML2); EMITV( DXP); %A11365500 EMITV(JUNK); %A11365600 EMITB(BFW,S,L); %A11365700 EMITPAIR(YHI,STD); EMITPAIR(YLO,STD); %A11365800 EMITO(XIT); %A11365900 END OF EMITDBLFACT; %A11366000 PROCEDURE EMITDBLPLXFACT; %A11366100 BEGIN REAL T; %A11366200 DEFINE XLO = FM2#, XHI = FM1#, REHI = FM4#, %A11366300 RELO = FM5#, IMHI = FM6#, IMLO = FM7#; %A11366400 EMIT(0); %A11366500 EMITV(IMLO); EMIT(0); EMITO(EQL); %A11366600 EMITV(IMHI); EMIT(0); EMITO(EQL); EMITO(LND); %A11366700 EMITV(REHI); EMIT(0); EMITO(GEQ); EMITO(LND); %A11366750 T ~ BUMPL; %A11366800 EMITV(RELO); EMITV(REHI); %A11366900 EMITO(MKS); EMITV(XLO); EMITV(XHI); %A11367000 EMITV(DBLFACT); %A11367100 EMITPAIR(REHI,STD); EMITPAIR(RELO,STD); %A11367200 EMITO(XIT); %A11367300 EMITB(BFC,T,L); %A11367400 EMITO(MKS); %A11367500 EMITV(IMLO); EMITV(IMHI); %A11367600 EMITV(RELO); EMITV(REHI); %A11367700 EMITV(DATN2); %A11367800 EMITV(JUNK); %A11367900 EMITV(XLO); EMITV(XHI); EMITO(ML2); % FP2, FP3 %A11368000 % %A11368100 EMITO(MKS); EMITV(IMLO); EMITV(IMHI); %A11368200 EMITV(IMLO); EMITV(IMHI); EMITO(ML2); %A11368300 EMITV(RELO); EMITV(REHI); %A11368400 EMITV(RELO); EMITV(REHI); %A11368500 EMITO(ML2); EMITO(AD2); %A11368600 EMITV(DSQRT); EMITV(JUNK); EMITO(MKS); %A11368700 EMITV(XLO); EMITV(XHI); EMITV(DBLFACT); %A11368800 EMITPAIR(RELO,STD); EMITO(DUP); %A11368900 EMITV(RELO); EMITO(XCH); %A11369000 EMITV(RELO); %A11369100 EMITO(MKS); EMITV(FP2); %A11369200 EMITV(FP3); EMITV(DCOS); EMITV(JUNK); EMITO(ML2); %A11369300 EMITPAIR(REHI,STD); EMITPAIR(RELO,STD); %A11369400 EMITO(MKS); %A11369500 EMITV(FP2); EMITV(FP3); %A11369600 EMITV(DSIN); EMITV(JUNK); EMITO(ML2); %A11369700 EMITPAIR(IMHI,STD); EMITPAIR(IMLO,STD); %A11369800 EMITO(XIT); %A11369900 END OF EMITDBLPLXFACT; %A11370000 PROCEDURE EMITPLXPRINT(BV); VALUE BV; BOOLEAN BV; %A11370100 BEGIN %A11370200 EMIT(0); %A11370300 EMITO(DUP); EMITV(FM2+REAL(BV)); EMITO(EQL); %A11370400 IF BV THEN BEGIN EMIT(0); %A11370500 EMITV(FM4); EMITO(EQL); %A11370600 EMITO(LND) END; %A11370700 EMITPAIR(5+REAL(BV),BFC); %A11370800 EMITO(MKS); %A11370900 IF BV THEN EMITV(FM2); EMITV(FM1); %A11371000 EMIT(0); %A11371100 EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11371200 EMITO(XIT); %A11371300 EMITV(FM1); EMIT(0); EMITO(NEQ); %A11371400 IF BV THEN BEGIN EMITV(FM2); EMIT(0); EMITO(NEQ); EMITO(LOR) %A11371500 END; %A11371600 EMITO(DUP); %A11371700 EMITPAIR(4+REAL(BV),BFC); %A11371800 EMITO(MKS); %A11371900 IF BV THEN EMITV(FM2); EMITV(FM1); %A11372000 EMIT(0); %A11372100 EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11372200 EMITV(FM2 + REAL(BV)); %A11372300 % %A11372400 EMIT(0); EMITO(LSS); %A11372500 EMITPAIR(5,BFC); %A11372600 EMITO(MKS); EMITL("-"); EMITV(CHARPRINT); %A11372700 EMITPAIR(6,BFW); EMITV(FP2); %A11372800 EMITPAIR(3,BFC); %A11372900 EMITO(MKS); EMITL("+"); EMITV(CHARPRINT); %A11373000 EMITO(MKS); EMITL(":"); EMITV(CHARPRINT); %A11373100 EMITO(MKS); %A11373200 IF BV THEN EMITV(FM4); %A11373300 EMITV(FM2+REAL(BV)); %A11373400 EMITO(SSP); EMIT(0); %A11373500 EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11373600 EMITO(XIT); %A11373700 END OF EMITPLXPRINT; %A11373800 PROCEDURE EMITERRPRO; %A11373900 BEGIN %A11374000 EMITV(BLOCKCTR); %A11374100 EMITL(1); EMITO(ADD); %A11374200 EMITPAIR(BLOCKCTR,SND); %A11374300 EMITO(MKS); EMITV(FM1); EMITV(FM3); EMITV(FM2); %A11374400 EMIT(0); EMITN(OUTSTR); EMITO(ECM); %A11374500 STREAMTOG ~ TRUE; %A11374600 EMITC(10,TRP); EMIT("GT"); EMIT("L "); %A11374700 EMIT("ER"); EMIT("RO"); %A11374800 EMIT("R "); EMITC(4,SES); %A11374900 EMITC(6,SFS); EMITC(2,TRS); %A11375000 EMITC(6,TRP); EMIT(", "); EMIT("S "); %A11375100 EMIT("= "); %A11375200 EMITC(4,OCV); EMITC(6,TRP); EMIT(", "); %A11375300 EMIT("A "); EMIT("= "); EMITC(4,OCV); %A11375400 EMITC(5,TRP); EMIT(" "); EMIT("--"); %A11375500 EMIT(" ~"); EMITC(1,0); STREAMTOG ~ FALSE; %A11375600 EMIT(0); EMITPAIR(OUTSTR,LOD); EMITO(CTC); %A11375700 EMITPAIR(34,COM); %A11375800 END OF EMITERRPRO; %A11375900 PROCEDURE EMITGENLINK; %A11376000 BEGIN REAL A,B,C,D; %A11376100 EMIT(0); %A11376200 EMITL(1); EMITPAIR(GENU,STD); %A11376300 EMITV(GENOK); EMITERR(SGNO,L,"12"); %A11376400 IF SYMSTK THEN BEGIN EMITV(LNKROW); EMITL(1); %A11376410 EMITO(INX); EMITPAIR(LNKROW,SND); %A11376420 GETCONTENTS(0,TRUE); EMITV(FM2); EMITO(XCH); %A11376430 EMITO(STD); EMITV(LNKROW) END ELSE BEGIN %A11376440 EMITV(LNKROW); EMITL(512); EMITO(EQL); %A11376500 A ~ BUMPL; %A11376600 EMITV(LNKCOL); EMITV(COLSET); %A11376700 EMITO(GTR); %A11376800 B ~ BUMPL; %A11376900 EMITV(FREELIST); EMIT(0); EMITO(EQL); %A11377000 C ~ BUMPL; %A11377100 IF RECLAIMTOG THEN BEGIN %A11377200 EMITO(MKS); EMITV(MARKER); EMITO(MKS); EMITV(COLLECT); %A11377300 EMITV(FREELIST); EMIT(0); EMITO(EQL); %A11377400 D ~ BUMPL; END; %A11377500 EMITB(BFC,B,L); %A11377600 EMIT(0); EMITPAIR(LNKROW,STD); %A11377700 EMITV(LNKCOL); EMITL(1); EMITO(ADD); %A11377800 EMITPAIR(LNKCOL,SND); EMITL(64); %A11377900 EMITO(EQL); EMITERR(SGNO,L,"10") ; % %A11378000 EMITB(BFC,A,L); %A11378100 EMITV(LNKCOL); EMITN(LNKA); EMITO(LOD); %A11378200 EMITV(LNKROW); EMITO(CDC); EMITV(FM2); %A11378300 EMITO(XCH); EMITO(STD); EMITV(LNKROW); %A11378400 EMITV(LNKCOL); EMITD(42,33,6); %A11378500 EMITPAIR(FM2,STD); %A11378600 EMITV(LNKROW); EMITL(1); EMITO(ADD); %A11378700 EMITPAIR(LNKROW,STD); EMITO(XIT); %A11378800 EMITB(BFC,C,L); IF RECLAIMTOG THEN EMITB(BFC,D,L); %A11378900 EMITV(FREELIST); %A11379000 EMITO(DUP); %A11379100 GETCONTENTS(0,TRUE); EMITO(DUP); %A11379200 EMITO(LOD); EMITPAIR(FREELIST,STD); %A11379300 EMITV(FM2); EMITO(XCH); EMITO(STD); %A11379400 END; %A11379450 EMITPAIR(FM2,STD); EMITO(XIT); %A11379500 END OF EMITGENLINK; %A11379600 PROCEDURE EMITGENSYM; %A11379700 BEGIN %A11379800 EMIT(0); %A11379900 EMIT(0); EMITO(MKS); EMITV(GENNO); %A11380000 EMITL(1); EMITO(ADD); EMITPAIR(GENNO,SND); %A11380100 EMITO(ECM); STREAMTOG ~ TRUE; %A11380200 EMITC(3,SED); EMITC(1,SES); %A11380300 EMITC(2,TPR); EMIT("4G"); %A11380400 EMITC(3,OCV); EMITC(1,0); %A11380500 STREAMTOG ~ FALSE; %A11380600 GENSYMLINK; %A11380700 IF RECLAIMTOG THEN BEGIN EMITO(SSN); %A11380800 MARKSYMNCR(1); END; %A11380900 EMIT(0); EMITO(XCH); %A11381000 EMITO(CTF); EMITO(SSN); %A11381100 GENSYMLINK; %A11381200 MARKSYMDCR(-1); %A11381300 EMITO(RTN); %A11381400 END OF EMITGENSYM; %A11381500 PROCEDURE EMITLENGTH; %A11381600 BEGIN REAL T; %A11381700 EMIT(0); %A11381800 EMITV(FM1); %A11381900 EMITI(0,33,15); EMITO(DUP); %A11382000 EMITL(9);EMITO(LEQ); %A11382100 EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11382200 EMITO(DUP); EMITL(64); EMITO(LSS); %A11382300 EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11382400 GETCONTENTS(0,FALSE); EMITL(2); %A11382500 EMITDIAL(DIA,46); EMITDIAL(DIB,1); EMITFC(FCE,2); %A11382600 T ~ BUMPL; %A11382700 GETCONTENTS(1,FALSE); EMITI(0,1,5); %A11382800 EMITO(RTN); %A11382900 EMITB(BFC,T,L); %A11383000 EMITO(DUP); EMIT(0); EMITO(LSS); %A11383100 EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11383200 EMITL(1); %A11383300 T ~ L; %A11383400 EMITO(XCH); %A11383500 GETCONTENTS(0,FALSE); %A11383600 EMITO(DUP); EMIT(0); EMITO(LSS); %A11383700 EMITPAIR(2,BFC); EMITO(XCH); EMITO(RTN); %A11383800 EMITO(XCH); EMITL(1); EMITO(ADD); %A11383900 EMITB(BBW,BUMPL,T); %A11384000 END OF EMITLENGTH; %A11384100 PROCEDURE EMITMARK; %A11384200 BEGIN REAL T,R; %A11384300 EMIT(0); %A11384400 T ~ L; %A11384500 EMITV(FM1); EMITO(DUP); %A11384600 EMITV(FREENL); %A11384700 EMITO(LSS); %A11384800 EMITPAIR(1,BFC); EMITO(XIT); %A11384900 GETCONTENTS(0,TRUE); EMIT(0); %A11385000 EMITO(MKS); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %A11385100 EMITC(4,RSA); EMITC(1,TIB); EMITC(2,JFC); %A11385200 EMITC(1,SEC); EMITC(3,STC); %A11385300 EMITC(1,0); %A11385400 STREAMTOG ~ FALSE; %A11385500 EMITPAIR(1,BFC); EMITO(XIT); %A11385600 EMITO(DUP); EMITO(LOD); EMITO(XCH); %A11385700 SETBIT; %A11385800 % %A11385900 EMITO(DEL); EMITO(DUP); %A11386000 EMITI(0,1,2); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11386100 R ~ BUMPL; L ~ L + 4; %A11386200 GETCONTENTS(0,TRUE); SETBIT; EMITO(XIT); %A11386300 EMITB(BFW,R,L); R ~ R + 2; %A11386400 EMITO(MKS); EMITV(FP2); EMITI(0,3,15); %A11386500 EMITV(MARK); EMITO(MKS); EMITV(FP2); %A11386600 EMITI(0,18,15); EMITV(MARK); EMITI(0,33,15); %A11386700 EMITB(BBW,BUMPL,T + 1); %A11386800 EMITB(BFW,R,L); R ~ R + 2; %A11386900 EMITI(0,33,15); %A11387000 EMITB(BBW,BUMPL,T+1); %A11387100 EMITB(BFW,R,L); %A11387200 EMITO(DUP); EMITI(0,3,15); %A11387300 EMITPAIR(FM1,STD); EMITO(MKS); %A11387400 EMITV(FP2); EMITI(0,33,15); %A11387500 EMITV(MARK); GETCONTENTS(1,TRUE); %A11387600 EMITO(DUP); EMITO(LOD); %A11387700 EMITO(XCH); SETBIT; EMITO(DEL); %A11387800 EMITO(DUP); EMITI(0,1,5); %A11387900 R ~ L; %A11388000 EMITO(DUP); EMITL(8); %A11388100 EMITO(LSS); EMITPAIR(4,BFC); %A11388200 EMITO(DEL); EMITO(DEL); %A11388300 EMITB(BBW,BUMPL,T); %A11388400 EMITL(4); EMITO(SUB); EMITO(XCH); %A11388500 GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11388600 EMITO(XCH); SETBIT; EMITO(DEL); %A11388700 EMITO(XCH); %A11388800 EMITB(BBW,BUMPL,R); %A11388900 END OF EMITMARK; %A11389000 PROCEDURE EMITMARKD; %A11389100 BEGIN REAL R,S; EMIT(0); %A11389200 EMITPAIR(FM1,LOD); EMITO(MOP); EMITO(DUP); %A11389300 EMITI(0,33,15); EMITL(3); %A11389400 EMITO(LEQ); EMITPAIR(1,BFC); EMITO(XIT); %A11389500 EMITI(0,8,10); % WORD COUNT FP2 %A11389600 EMIT(0); EMIT(0); % FP3 %A11389700 EMITN(FM1); EMITO(LOD); %A11389800 EMITO(TOP); EMITO(XCH); EMITO(DEL); %A11389900 R ~ BUMPL; %A11390000 EMITO(MKS); EMIT(0); %A11390100 EMITV(FP3); EMITV(FM1); %A11390200 EMITO(CTC); EMITV(MARK); %A11390300 EMITL(1); EMITO(ADD); %A11390400 EMITO(DUP); EMITV(FP2); %A11390500 EMITO(GEQ); %A11390600 EMITB(BBC,BUMPL,R); EMITO(XIT); %A11390700 EMITB(BFC,R, R ~ L); %A11390800 EMITO(MKS); EMITV(FP3); %A11390900 EMITN(FM1); EMITO(LOD); %A11391000 EMITV(MARKD);EMITL(1); %A11391100 EMITO(ADD); EMITO(DUP); %A11391200 EMITV(FP2); EMITO(GEQ); %A11391300 EMITB(BBC,BUMPL,R); %A11391400 EMITO(XIT); %A11391500 END OF EMITMARKD; %A11391600 PROCEDURE EMITMARKER; %A11391700 BEGIN REAL T,R,S; %A11391800 EMIT(0); %A11391900 % %A11392000 EMITO(MKS); EMITV(INSYM); EMITI(0,33,15); EMITV(MARK); %A11392100 EMITO(MKS); EMITV(MARKOB); %A11392200 EMITL(127); % FP2 %A11392400 T ~ L; %A11392500 EMITL(1); EMITO(ADD); EMITO(DUP); %A11392600 EMITV(TABLEMARK ); EMITO(GTR); %A11392700 EMITPAIR(1,BFC); EMITO(XIT); %A11392800 EMITO(DUP); EMITN(SYMSTACKA); %A11392900 EMITO(LOD); %A11393000 EMITO(TOP); %A11393100 R ~ BUMPL; %A11393200 EMITO(DUP); EMITPAIR(0,LSS); %A11393300 S ~ BUMPL; %A11393400 GETCONTENTS(0,TRUE); SETBIT; %A11393500 EMITB(BFC,R,R ~ BUMPL); %A11393600 EMITO(LOD); EMITO(TOP); %A11393700 EMITB(BFC,S,S ~ BUMPL); %A11393800 EMITO(MKS); EMIT(0); EMITV(FP3); EMITO(CTC); EMITV(MARK); %A11393900 EMITPAIR(4,BFW); %A11394000 EMITB(BFC,S,L); %A11394100 EMITO(MKS); EMITPAIR(FP3,LOD); EMITV(MARKD); %A11394200 EMITB(BFC,R,L); %A11394300 EMITO(DEL); %A11394400 EMITB(BBW,BUMPL,T); %A11394500 END OF EMITMARKER; %A11394600 PROCEDURE EMITMARKOB; %A11394700 BEGIN REAL T; %A11394800 EMIT(0); %A11395000 EMIT(0); %A11395300 T ~ L; %A11395400 EMITO(MKS); EMITV(FP2); %A11395500 GETCONTENTS(0,FALSE); EMITI(0,33,15); %A11395600 EMITV(MARK); EMITL(1); EMITO(ADD); %A11395700 EMITO(DUP); EMITL(64); EMITO(GEQ); %A11395800 EMITB(BBC,BUMPL,T); EMITO(DEL); EMIT(0); %A11395900 T ~ L; %A11396000 EMITO(MKS); EMITV(FP2); %A11396100 EMITV(SYMSTACKA); EMITI(0,33,15); %A11396200 EMITV(MARK); %A11396300 EMITL(1); EMITO(ADD); EMITO(DUP); %A11396400 EMITL(125); EMITO(GEQ); %A11396500 EMITB(BBC,BUMPL,T); %A11396600 EMITO(MKS); EMITV(FREELIST); EMITV(MARK); %A11396800 EMITO(XIT); %A11396900 END OF EMITMARKOB; %A11397000 PROCEDURE EMITMEMBER; %A11397100 BEGIN REAL T; %A11397200 EMIT(0); %A11397300 T ~ L; %A11397400 EMITV(FM1); %A11397500 GETCONTENTS(0,FALSE); EMITPAIR(FM1,SND); %A11397600 EMIT(0); EMITO(LSS); %A11397700 EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11397800 EMITV(FM2); EMITV(FM1); %A11397900 EMITI(0,18,15); %A11398000 EMITO(MKS); %A11398100 EMITV(SYMEQ); EMITO(DEL); %A11398200 EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11398300 EMITB(BBW,BUMPL,T); %A11398400 END OF EMITMEMBER; %A11398500 PROCEDURE EMITMKATOM; %A11398600 BEGIN REAL T,R; %A11398700 EMIT(0); %A11398800 EMITV(COUNTI); EMITO(DUP); %A11398900 EMITL(1); EMITO(EQL); %A11399000 T ~ BUMPL; %A11399100 EMIT(0); EMITV(INSTR); %A11399200 EMITI(0,18,6); EMITO(RTN); %A11399300 EMITB(BFC,T,L); EMITO(DUP); %A11399400 EMITL(7); EMITO(GTR); %A11399500 EMITPAIR(4,BFC); %A11399600 EMITL(3); EMITO(LND); EMITL(4); %A11399700 EMITO(ADD); EMITO(DUP); %A11399800 IF RECLAIMTOG THEN EMITL(1); %A11399900 EMIT(0); T ~ L; %A11400000 EMITO(MKS); EMITV(COUNTI); EMITO(DUP); EMITV(FP3); %A11400100 EMITO(SUB); EMITV(FP2); EMIT(0); %A11400200 EMITN(INSTR); EMITO(ECM); STREAMTOG ~ TRUE; %A11400300 EMITC(6,SED); EMITC(4,SES); %A11400400 EMITC(7,SFS); EMITC(1,TRS); %A11400500 EMITC(1,RSA); EMITC(3,CRF); %A11400600 EMITC(0,SFS); EMITC(3,SFS); EMITC(2,CRF); %A11400700 EMITC(0,TRS); EMITC(1,0); %A11400800 STREAMTOG ~ FALSE; %A11400900 GENSYMLINK; %A11401000 IF RECLAIMTOG THEN BEGIN EMITO(DUP); EMITO(SSN); %A11401100 MARKSYMNCR(1); L ~ L-1; EMITO(STD) END; %A11401200 EMITV(FP3); EMITV(COUNTI); %A11401300 EMITO(NEQ); %A11401400 R ~ BUMPL; %A11401500 EMITV(FP3); EMITL(4); EMITPAIR(FP2,SND); %A11401600 EMITO(ADD); EMITPAIR(FP3,STD); %A11401700 IF RECLAIMTOG THEN BEGIN EMITV(FP4); EMITL(1); %A11401800 EMITO(ADD); EMITPAIR(FP4,STD); END; %A11401900 EMITB(BBW,BUMPL,T); %A11402000 EMITB(BFC,R,L); %A11402100 EMIT(0); EMITO(XCH); EMITO(CTF); %A11402200 EMITO(SSN); %A11402300 EMITV(FM1); R ~ BUMPL; %A11402400 EMIT(0); EMITV(INSTR); EMITL(125); EMITO(RDV); %A11402500 EMITN(SYMSTACKA); EMITO(DUP); EMITO(LOD); %A11402600 EMITO(DUP); EMIT(0); EMITO(EQL); %A11402700 EMITPAIR(2,BFC); EMITO(DEL); EMITL(1); %A11402800 EMITV(IF RECLAIMTOG THEN FP5 ELSE FP4); %A11402900 EMITO(XCH); EMITD(33,3,15); %A11403000 EMITB(BFC,R,L); %A11403100 GENSYMLINK; %A11403200 IF RECLAIMTOG THEN BEGIN EMITV(TABLEMARK); %A11403300 EMITV(FP4); EMITO(SUB); %A11403400 EMITPAIR(TABLEMARK,STD); END; %A11403500 EMITV(FM1); EMITPAIR(2,BFC); %A11403600 EMITO(XCH); EMITO(SND); EMITO(RTN) %A11403700 END OF EMITMKATOM; %A11403800 PROCEDURE EMITMONPRO; %A11403900 BEGIN REAL T,R; %A11404000 REAL A1,A2,A3; %A11404100 EMIT(0); %A11404200 EMITL(12); %A11404300 EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11404400 TRPRI; %A11404500 EMITO(MKS); EMITV(CPM); EMITL(4); EMITO(ADD); %T9311404600 EMITPAIR(CPM,SND); %A11404700 EMITV(RMARG); EMITV(LMARG); EMITO(SUB); %A11404800 EMITO(RDV); EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11404900 ALFP("CALL "); %A11405000 EMITO(MKS); EMITV(FM2); EMITV(ALFPRINT); %A11405100 TRPRI; %A11405200 EMITV(FM1); EMITO(DUP); %A11405300 EMIT(0); EMITO(EQL); %A11405400 EMITPAIR(1,BFC); EMITO(XIT); %A11405500 EMITO(DUP); EMITO(ADD); %A11405600 EMITL(FM2); EMITO(ADD); % FP3 %A11405700 R ~ L; %A11405800 EMITPAIR(JUNK,ISN); %A11405900 EMITO(MKS); EMITV(CPM); EMITV(RMARG); %A11406000 EMITV(LMARG); EMITO(SUB); EMITO(RDV); %A11406100 EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11406200 EMITV(FP3); EMITO(LOD); %A11406300 EMITO(NOP); EMITO(LOD); %A11406400 EMITV(FP3); EMITL(1); %A11406500 EMITO(SUB); EMITPAIR(FP3,ISD); %A11406600 EMITV(FP3); EMITO(LOD); %A11406700 EMITO(BFW); %A11406800 T ~ L ~ L + 6; %A11406900 EMITO(MKS); EMITL(12); EMITV(CHARPRINT); A1 ~ BUMPL; %A11407000 EMITB(BFW,T - 4,L); %A11407100 EMITO(MKS); EMITV(FP4); EMIT(0); %A11407200 EMITV(ARITHPRINT); A2 ~ BUMPL; %A11407300 EMITB(BFW,T-2,L); %A11407400 EMITO(MKS); EMITV(FP4); EMITV(BOOPRINT); A3 ~ BUMPL; %A11407500 EMITB(BFW,T,L); %A11407600 EMITO(MKS); EMITV(FP4); EMITV(SYMPRINT); %A11407700 EMITB(BFW,A1,L); EMITB(BFW,A2,L); EMITB(BFW,A3,L); EMITO(DEL); %A11407800 TRPRI; %A11407900 EMITL(1); EMITO(SUB); EMITO(DUP); %A11408000 EMITL(FM2); EMITO(EQL); %A11408100 EMITB(BBC,BUMPL,R); %A11408200 EMITO(XIT); %A11408300 END OF EMITMONPRO; %A11408400 PROCEDURE EMITMONSYM; %A11408500 BEGIN REAL T,R; %A11408600 DEFINE ALF = FM3#, N = FM2#, VAL = FM4#; %A11408700 EMIT(0); %A11408800 EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11408900 TRPRI; %A11409000 EMITO(MKS); EMITV(CPM); %A11409100 EMITV(RMARG); EMITV(LMARG); %A11409200 EMITO(SUB); EMITO(RDV); %A11409300 EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11409400 EMITO(MKS); EMITV(ALF); EMITV(ALFPRINT); %A11409500 % %A11409600 EMITV(N); EMIT(0); EMITO(NEQ); %A11409700 T ~ BUMPL; %A11409800 EMITV(N); EMITL(FM4); EMITO(ADD); % FP2 %A11409900 EMITPAIR(JUNK,ISN); %A11410000 PRINCH("["); EMITPAIR(3,BFW); %A11410100 R ~ L; %A11410200 PRINCH(","); EMITO(MKS); EMITV(FP2); EMITO(LOD); %A11410300 EMIT(0); %A11410400 EMITV(ARITHPRINT); EMITL(1); EMITO(SUB); %A11410500 EMITO(DUP); EMITL(FM4); %A11410600 EMITO(EQL); %A11410700 EMITB(BBC,BUMPL,R); %A11410800 PRINCH("]"); %A11410900 EMITB(BFC,T,L); %A11411000 PRINCH(" "); PRINCH("="); PRINCH(" "); %A11411100 EMITO(MKS); EMITV(VAL); %A11411200 EMITV(SYMPRINT); %A11411300 TRPRI; %A11411400 EMITV(CPM); EMITV(FM1); EMITO(SUB); %A11411500 EMITPAIR(CPM,STD); EMITO(XIT); %A11411600 END OF EMITMONSYM; %A11411700 PROCEDURE EMITNCONC; %A11411800 BEGIN REAL T; %A11411900 EMIT(0); EMITV(FM2); %A11412000 GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11412100 EMITO(DUP); EMIT(0); %A11412200 EMITO(LSS); %A11412300 EMITPAIR(2,BFC); EMITV(FM1); %A11412400 EMITO(RTN); %A11412500 T ~ L; %A11412600 EMITO(DUP); %A11412700 GETCONTENTS(0,TRUE); %A11412800 EMITO(DUP); EMITO(LOD); %A11412900 EMITO(DUP); EMIT(0); %A11413000 EMITO(LSS); %A11413100 EMITPAIR(8,BFC); %A11413200 EMITO(DEL); EMITO(DEL); %A11413300 EMITV(FM1); EMITO(CTC); EMITO(XCH); %A11413400 EMITO(STD); EMITV(FM2); EMITO(RTN); %A11413500 EMITPAIR(FP2,STD); EMITO(XCH); EMITO(DEL); %A11413600 EMITO(XCH); %A11413700 EMITB(BBW,BUMPL,T); %A11413800 END OF EMITNCONC; %A11413900 PROCEDURE EMITNTA; %A11414000 BEGIN %A11414100 EMIT(0); %A11414200 EMITV(FM2); EMITO(DUP); %A11414300 EMIT(0); EMITO(GEQ); EMITO(XCH); %A11414400 EMITL( 9); EMITO(LEQ); EMITO(LND); %A11414500 EMITPAIR(11,BFC); %A11414600 EMITV(FM2); EMITO(DUP); %A11414700 EMITPAIR(JUNK,ISN); EMITO(EQL); %A11414800 EMITPAIR(4,BFC); %A11414900 EMITV(JUNK); EMITPAIR(FM2,STD); EMITO(XIT); %A11415000 EMITV(FM2); %A11415100 GENSYMLINK; EMITL(3); %A11415200 EMITD(46,1,2); %A11415300 MARKSYMNCR(1); %A11415400 GENSYMLINK; EMITPAIR(FM2,STD); %A11415500 MARKSYMDCR(-1); EMITO(XIT); %A11415600 END OF EMITNTA; %A11415700 PROCEDURE EMITNTS; %A11415800 BEGIN REAL A,L1,L2; %A11415900 REAL B,C; %A11416000 DEFINE %A11416100 XLO = FM4#, %A11416200 XHI = FM3#, %A11416300 N = FM2#, %A11416400 TIN = FM1#, %A11416500 R = FP2#, % DIGITS IN %A11416600 EA = FP3#, %A11416700 SE = FP4#, %A11416800 E = FP5#, %A11416900 J = FP6#, %A11417000 SN = FP7#, %A11417100 T = FP8#, % DIGITS TO BE CONVERTED %A11417200 TN = FP9#; %A11417300 FOR A ~ 1 STEP 1 UNTIL 6 DO EMIT(0); %A11417400 EMITV(XHI); EMIT(0); EMITO(LSS); %A11417500 EMITV(XLO); EMITV(XHI); EMITO(SSP); %A11417600 EMIT(0); %A11417700 EMITL(1); %A11417800 EMITO(ML2); EMITO(XCH); %A11417900 EMITPAIR(XLO,STD); EMITPAIR(XHI,SND); %A11418000 EMITO(DUP); EMITL(6); EMITV(TIN); EMITO(LSS); %A11418100 L1 ~ BUMPL; %A11418200 EMITO(DUP); EMITO(DUP); %A11418300 EMITPAIR(J,ISN); EMITO(EQL); %A11418400 EMIT(0); EMITV(XLO); EMITO(EQL); %A11418500 EMITV(N); EMITL(6); EMITO(LSS); EMITO(LOR); EMITO(LND); %A11418600 L2 ~ BUMPL; %A11418700 EMIT(0); EMITO(MKS); EMIT(0); %A11418800 EMITN(OUTSTR); EMITO(ECM); STREAMTOG ~ TRUE; %A11418900 EMITC(1,SFD); EMITC(6,SES); %A11419000 EMITC(6,OCV); %A11419100 EMITC(1,RDA); EMITC(5,CRF); %A11419200 EMITC(0,JFW); EMITC(2,JFW); %A11419300 EMITC(1,TRP); EMIT("-"); %A11419400 EMITC(1,RSA); EMITC(1,SFS); %A11419500 EMITC(6,SEC); %A11419600 EMITC(5,BNS); %A11419700 EMITC(0,TEQ); EMITC(3,JNC); %A11419800 EMITC(63,INC); EMITC(1,SFS); %A11419900 EMITC(0,ENS); EMITC(3,STC); %A11420000 EMITC(3,CRF); EMITC(0,TRS); %A11420100 EMITC(5,CRF); EMITC(0,INC); %A11420200 EMITC(3,STC); EMITC(1,0); %A11420300 STREAMTOG ~ FALSE; %A11420400 EMITPAIR(NSTR,STD); %A11420500 EMITV(SN); EMITPAIR(JUNK,STD); %A11420600 EMITO(XIT); %A11420700 % %A11420800 EMITB(BFC,L1,L); %A11420900 EMITB(BFC,L2,L); %A11421000 EMITO(DUP); EMITI(0,3,6); %A11421100 EMITO(XCH); EMITD(2,1,1); EMITL(12); EMITO(ADD); %A11421200 EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 ELSE CPLUS1); %A11421300 A ~ BUMPL; %A11421400 EMITWORD(0.90309); %A11421500 EMITB(BFW,A,L); %A11421600 EMITO(MUL); EMITREL(0.5); EMITO(ADD); %A11421700 EMITPAIR(E,ISN); %A11421800 L1 ~L; %A11421900 EMITO(DUP); EMIT(0); EMITO(GEQ); %A11422000 EMITPAIR(4,BFC); %A11422100 EMITV(E); EMITV(TIN); EMITPAIR(5,BFW); %A11422200 EMITL(1); EMITV(E); EMITO(SSP); %A11422300 EMITV(TIN); EMITO(DTV); %A11422400 EMITV(XHI); EMITO(GTR); %A11422500 EMITPAIR(6,BFC); %A11422600 EMITL(1); EMITO(SUB); %A11422700 EMITPAIR(E,ISN); %A11422800 EMITB(BBW,BUMPL,L1); EMITO(DEL); %A11422900 EMITV(N); EMITL(1); EMITO(ADD); %A11422910 EMITO(DUP); EMITL(7); EMITO(GTR); %A11423000 EMITPAIR(2,BFC); EMITO(DEL); EMITL(7); %A11423100 EMITO(DUP); EMITV(E); EMITO(XCH); EMITO(SUB); EMITL(1); %A11423200 EMITO(ADD); EMITO(DUP); %A11423300 EMIT(0); EMITO(GTR); %A11423400 L1 ~ BUMPL; %A11423500 EMITV(XLO); EMITV(XHI); %A11423600 EMITV(TN); EMITL(69); EMITO(ADD); EMITV(TIN); %A11423700 EMITV(TN); EMITV(TIN); EMITO(DV2); %A11423800 EMITB(BFC,L1,L1 ~ BUMPL); %A11423900 EMITV(XLO); EMITV(XHI); %A11424000 EMITV(TN); EMITO(SSP); EMITO(DUP); %A11424100 EMITL(69); EMITO(ADD); EMITV(TIN); %A11424200 EMITO(XCH); EMITV(TIN); EMITO(ML2); %A11424300 EMITB(BFW,L1,L); %A11424400 EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11424500 EMITO(DEL); %A11424600 EMITL(1); EMITO(ADD); %A11424700 EMITV(N); EMITL(2); EMITO(ADD); %A11424800 EMIT(0); %A11424900 L1 ~ L; EMITV(XHI); EMITREL(.5); EMITO(SUB); EMITPAIR(J,ISD); %A11425000 EMITV(R); EMITV(T); EMITO(ADD); EMITV(TN); %A11425100 EMITO(EQL); EMITO(MKS); %A11425200 EMITPAIR(OUTSTR,LOD); EMITL(10); EMITN(OUTSTR); %A11425300 EMITO(ECM); STREAMTOG ~ TRUE; %A11425400 EMITC(13,CRF); EMITC(0,SFD); %A11425500 EMITC(9,SES); EMITC(7,CRF); %A11425600 EMITC(0,OCV); EMITC(4,CRF); %A11425700 EMITC(0,JFW); EMITC(18,JFW); %A11425800 EMITC(2,RDA); EMITC(6,CRF); %A11425900 EMITC(3,BNS); EMITC(1,TRP); %A11426000 EMIT(0); EMITC(0,ENS); %A11426100 EMITC(1,SRD); EMITC(1,TRP); %A11426200 EMIT(5); EMITC(2,RSA); %A11426300 EMITC(1,RDA); EMITC(6,CRF); %A11426400 EMITC(0,FAD); EMITC(1,RSA); %A11426500 EMITC(1,TEQ); EMITC(2,JFC); %A11426600 EMITC(1,SEC); EMITC(5,STC); %A11426700 EMITC(1,0); STREAMTOG ~ FALSE; %A11426800 L2 ~ BUMPL; %A11426900 EMITV(E); EMITO(ADD); %A11427000 EMITPAIR(E,STD); %A11427100 EMITB(BFC,L2,L2 ~ BUMPL); %A11427200 EMITV(R); EMITV(T); EMITO(ADD); %A11427300 EMITPAIR(R,SND); EMITV(TN); %A11427400 EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11427500 EMITL(8); EMITO(GTR); EMITPAIR(2,BFC); %A11427600 % %A11427700 EMITO(DEL); EMITL(8); %A11427800 EMITPAIR(T,SND); EMITV(TIN); EMIT(0); %A11427900 EMITO(XCH); EMITV(XLO); EMITV(XHI); %A11428000 EMIT(0); EMITV(J); EMITO(SB2); EMITO(ML2); %A11428100 EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11428200 EMITB(BBW,BUMPL,L1); %A11428300 EMITB(BFW,L2,L); %A11428400 EMITV(E); EMITL(1); EMITO(ADD); EMITO(DUP); %A11428500 EMITO(DUP); EMIT(0); EMITO(EQL); %A11428600 EMITO(XCH); EMITO(DUP); EMITL(1); EMITO(EQL); %A11428700 EMITO(XCH); EMITO(DUP); EMIT(0); EMITO(GTR); %A11428800 EMITO(XCH); EMITV(N); EMITO(LEQ); EMITO(LND); %A11428900 EMITV(N); EMITL(6); EMITO(LSS); EMITO(LND); %A11429000 EMITO(LOR); EMITO(LOR); %A11429100 L1 ~ BUMPL; %A11429200 EMITPAIR(J,ISN); EMITV(N); EMITO(SUB); %A11429300 EMITPAIR(EA,STD); EMIT(0); EMITPAIR(E,SND); %A11429400 EMITB(BFC,L1,L1 ~ BUMPL); EMITO(DEL); %A11429500 EMITL(1); EMITPAIR(J,STD); %A11429600 EMITV(N); EMITL(1); EMITO(SUB); %A11429700 EMITPAIR(EA,STD); EMITV(E); %A11429800 EMITB(BFW,L1,L); %A11429900 EMITO(DUP); EMITO(SSP); EMITPAIR(E,STD); %A11430000 EMIT(0); EMITO(LSS); EMITPAIR(SE,STD); %A11430100 EMIT(0); EMITO(MKS); %A11430200 EMITV(SN); EMITV(J); EMITV(E); %A11430300 EMITV(SE); EMITV(EA); %A11430400 EMITV(EA); EMIT(0); EMITO(NEQ); %A11430500 EMITV(E); EMIT(0); EMITO(NEQ); %A11430600 EMITV(E); EMITL(10); EMITO(GEQ); %A11430700 EMITL(1); EMITO(ADD); %A11430800 EMITL(10); EMITN(OUTSTR); %A11430900 EMIT(0); EMITN(OUTSTR); %A11431000 EMITO(ECM); STREAMTOG ~ TRUE; %A11431100 EMITC(2,RSA); EMITC(10,CRF); %A11431200 EMITC(0,JFW); EMITC(3,JFW); %A11431300 EMITC(1,TRP); EMIT("-"); %A11431400 EMITC(1,INC); EMITC(0,TEQ); %A11431500 EMITC(1,JFC); EMITC(1,SFS); %A11431600 EMITC(9,CRF); %A11431700 EMITC(0,TRS); EMITC(9,CRF); %A11431800 EMITC(0,INC); EMITC(5,CRF); %A11431900 EMITC(0,JFW); EMITC(23,JFW); %A11432000 EMITC(1,TRP); EMIT("."); %A11432100 EMITC(1,INC); EMITC(6,CRF); %A11432200 EMITC(0,TRS); EMITC(6,CRF); %A11432300 EMITC(0,INC); EMITC(1,RDA); %A11432400 EMITC(1,RSA); EMITC(5,STC); %A11432500 EMITC(5,CRF); EMITC(0,SFS); %A11432600 EMITC(6,CRF); %A11432700 EMITC(5,BNS); EMITC(1,SRS); %A11432800 EMITC(0,TEQ); EMITC(3,JNC); %A11432900 EMITC(63,INC); EMITC(0,ENS); %A11433000 EMITC(63,INC); EMITC(5,STC); %A11433100 EMITC(5,CRF); EMITC(0,SFD); %A11433200 % %A11433300 EMITC(4,CRF); EMITC(0,JFW); %A11433400 EMITC(14,JFW); EMITC(1,TRP); %A11433500 EMIT("@"); EMITC(1,INC); %A11433600 EMITC(7,CRF); %A11433700 EMITC(0,JFW); EMITC(3,JFW); %A11433800 EMITC(1,TRP); EMIT("-"); %A11433900 EMITC(1,INC); %A11434000 EMITC(8,SES); EMITC(3,CRF); %A11434100 EMITC(0,OCV); EMITC(3,CRF); %A11434200 EMITC(0,INC); EMITC(12,STC); %A11434300 EMITC(1,0); STREAMTOG ~ FALSE; %A11434400 EMITPAIR(NSTR,STD); %A11434500 EMITV(SN); EMITPAIR(JUNK,STD); %A11434600 EMITO(XIT); %A11434700 END OF EMITNTS; %A11434800 PROCEDURE EMITPLXFACT; %A11434900 BEGIN REAL T; %A11435000 DEFINE X = FM1#, RE = FM3#, IM = FM4#; %A11435100 EMIT(0); %A11435200 EMITV(IM); EMIT(0); EMITO(EQL); %A11435300 EMITV(RE); EMIT(0); EMITO(GEQ); EMITO(LND); %A11435350 T ~ BUMPL; %A11435400 EMITV(RE); EMITV(X); %A11435500 EMITO(MKS); %A11435600 EMITPAIR(GNAT(LOGI),LOD); EMITPAIR(GNAT(EXPI),LOD); %A11435700 EMITV(GNAT(XTOTHEI)); EMITO(DEL); %A11435800 EMITPAIR(RE,STD); EMITO(XIT); %A11435900 EMITB(BFC,T,L); %A11436000 EMITO(MKS); EMITV(IM); EMITV(RE); EMITV(36); %A11436100 EMITV(X); EMITO(MUL); %A11436200 EMITO(MKS); EMITV(IM); EMITV(RE); EMITV(CABS); %A11436300 EMITV(X); EMITO(MKS); %A11436400 EMITPAIR(GNAT(LOGI),LOD); EMITPAIR(GNAT(EXPI),LOD); %A11436500 EMITV(GNAT(XTOTHEI)); EMITO(DEL); %A11436600 EMITO(DUP); %A11436700 EMITO(MKS); EMITV(FP2); EMITV(GNAT(COSI)); %A11436800 EMITO(MUL); EMITPAIR(RE,STD); %A11436900 EMITO(MKS); EMITV(FP2); EMITV(GNAT(SINI)); %A11437000 EMITO(MUL); EMITPAIR(IM,STD); %A11437100 EMITO(XIT); %A11437200 END OF EMITPLXFACT; %A11437300 PROCEDURE EMITPROP; %A11437400 BEGIN REAL T; %A11437500 REAL R; %A11437600 EMIT(0); %A11437700 EMITV(FM3); %A11437800 GETCONTENTS(0,FALSE); %A11437900 EMITL(2); EMITDIAL(DIA,46); %A11438000 EMITDIAL(DIB,1); EMITFC(FCE,2); %A11438100 EMITO(LNG); EMITPAIR(2,BFC); %A11438200 EMIT(0); EMITO(RTN); %A11438300 T ~ L; %A11438400 EMITPAIR(FM3,SND); %A11438500 GETCONTENTS(0,FALSE); EMITO(DUP); %A11438600 EMIT(0); EMITO(LSS); %A11438700 EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11438800 EMITV(FM1); %A11438900 EMITDIAL(DIB,2); EMITV(FM2); %A11439000 R ~ BUMPL; %A11439100 EMITDIAL(DIA,46); EMITFC(FCE,2); %A11439200 EMITB(BBC,BUMPL,T); %A11439300 EMIT(0); EMITO(XCH); EMITD(4,19,29); %A11439400 EMITO(RTN); %A11439500 EMITB(BFC,R,L); EMITDIAL(DIA,32); EMITFC(FCE,16); %A11439600 EMITB(BBC,BUMPL,T); %A11439700 EMITV(FM2); EMIT(0); EMITO(EQL); %A11439800 R ~ BUMPL; %A11439900 EMITI(0,18,15); %A11440000 EMITO(RTN); %A11440100 EMITB(BFC,R,L); EMITV(FM3); EMITO(RTN); %A11440200 END OF EMITPROP; %A11440300 PROCEDURE EMITRANDNO; %A11440400 BEGIN INTEGER A,B,D,E; %A11440500 DEFINE %A11440600 C = 549755813885#, %A11440700 Z = 8*13#; %A11440800 EMIT(0); EMIT(0); %A11440900 EMITV(RND); %A11441000 EMIT(0); %A11441100 EMITREL(C); %A11441200 EMITO(ML2); EMITO(DUP); %A11441300 EMITREL(.5); %A11441400 EMITO(SUB); %A11441500 EMITPAIR(JUNK,ISN); %A11441600 EMIT(0); EMITO(XCH); %A11441700 EMITO(SB2); EMITPAIR(RND,SND); %A11441800 EMITO(RTN); %A11441900 END OF EMITRANDNO; %A11442000 PROCEDURE EMITRANDOM; %A11442100 BEGIN REAL T,R; %A11442200 REAL P; %A11442300 EMIT(0); %A11442400 EMITV(FM1); GETCONTENTS(0,FALSE); %A11442500 EMIT(0); %A11442600 EMITDIAL(DIA,46); EMITDIAL(DIB,1); %A11442700 EMITFC(FCE,2); %A11442800 T ~ BUMPL; %A11442900 EMITO(MKS); EMITV(RANDNO); EMITO(MKS); %A11443000 EMITV(FM1); EMITV(LENGTHV); %A11443100 EMITO(MUL); EMITREL (.5); EMITO(SUB); %A11443200 EMITPAIR(JUNK,ISN); %A11443300 R ~ L; %A11443400 EMITO(DUP); EMIT(0); EMITO(EQL); %A11443500 P ~ BUMPL; %A11443600 EMITO(XCH); EMITI(0,18,15); EMITO(RTN); %A11443700 EMITB(BFC,P,L); %A11443800 EMITL(1); EMITO(SUB); EMITO(XCH); %A11443900 GETCONTENTS(0,FALSE); EMITO(XCH); %A11444000 EMITB(BBW,BUMPL,R); %A11444100 EMITB(BFC,T,L); %A11444200 EMIT(0); EMITO(RTN); %A11444300 END OF EMITRANDOM; %A11444400 PROCEDURE EMITREAD; %A11444500 BEGIN %A11444600 STREAM PROCEDURE TRA(A,B); VALUE B; %A11444700 BEGIN DI ~ A; DI ~ DI + B; %A11444800 DI ~ DI + B; %A11444900 DS ~ 26 LIT "READ: ILLEGAL LIST SYNTAX " END; %A11445000 REAL T; %A11445100 EMIT(0); %A11445200 EMITO(MKS); EMITV(READ1); EMITO(DUP); %A11445300 EMITL("("); EMITO(NEQ); EMITPAIR(1,BFC); %A11445400 EMITO(RTN); %A11445500 EMITO(MKS); EMITN(FP2); EMITV(READSYM); %A11445600 T ~ BUMPL; %A11445700 EMITO(MKS); EMITPAIR(OUTSTR,LOD); %A11445800 EMITO(ECM); STREAMTOG ~ TRUE; %A11445900 EMITC(26,TRP); %A11446000 TRA(EDOC[L.[36:3],L.[39:7]],L.[46:2]); %A11446100 L ~ L + 13; %A11446200 EMITC(1,0); STREAMTOG ~ FALSE; %A11446300 EMITL(26); EMITPAIR(NSTR,STD); %A11446400 TRPRI; EMITO(MKS); %A11446500 EMIT(0); EMITV(STRINGPRINT); %A11446600 TRPRI; EMITL(12); %A11446700 EMITPAIR(INSYM,STD); %A11446800 EMITV(FP2); EMITO(RTN); %A11446900 EMITB(BFC,T,L); %A11447000 EMITO(MKS); EMITV(READ1); EMITO(DUP); %A11447100 EMITL("$"); EMITO(EQL); %A11447200 EMITPAIR(5,BFC); EMIT(0); %A11447300 EMITPAIR(INSYM,STD); EMITV(FP2); %A11447400 EMITO(RTN); %A11447500 EMITO(DUP); %A11447600 EMITL(")"); EMITO(EQL); %A11447700 EMITB(BBC,BUMPL,T); %A11447800 EMITO(DEL); EMITO(MKS); EMITV(READ1); %A11447900 EMITPAIR(10,BBW); %A11448000 END OF EMITREAD; %A11448100 PROCEDURE EMITREAD1; %A11448200 BEGIN %A11448300 EMIT(0); %A11448400 EMITO(MKS); %A11448500 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11448600 EMITL(1); EMITV(READCON); %A11448700 EMITO(DUP); EMITO(ADD); %A11448800 EMITO(BFW); %A11448900 EMITPAIR(6,BFW); %A11449000 EMITPAIR(4,BFW); %A11449100 EMITPAIR(4,BFW); %A11449200 EMITV(INSYM); EMITO(RTN); %A11449300 EMITL(12); EMITO(RTN); %A11449400 EMITV(INREAL); EMITO(MKS); EMITV(NTA); EMITO(RTN); %A11449500 END OF EMITREAD1; %A11449600 PROCEDURE EMITREADCON; %A11449700 BEGIN %A11449800 COMMENT RESULTS OF READCON: %A11449900 0 - EOF, %A11450000 1 - NUMBER ERROR, %A11450100 2 - NUMBER, %A11450200 3 - ATOMIC SYMBOL, %A11450300 4 - ALPHA STRING; %A11450400 INTEGER L1,L2,L3,L4,L5,L6,L7; %A11450500 DEFINE TYPE = FP4#, BV = FM1#, TEN = FM2#, %A11450600 FP = FP3#, SN = FP2#, %A11450700 XLO = INDBL#, XHI = INREAL#, %A11450800 CALLSCAN = % %A11450900 EMITO(MKS); EMITN(TYPE); EMITV(STRI); %A11451000 EMITO(PRTE); EMITO(LOD); EMITV(FILPROI); EMITO(PRTE); %A11451100 EMITO(LOD); EMITV(SCANR)#; %A11451200 % SCAN RESULTS: %A11451300 % 0 SPACES, %A11451400 % 1 ALPHA, %A11451500 % 2 NUMBER, %A11451600 % 3 SPECIAL CHARACTER, %A11451700 % 4 EOF %A11451800 EMIT(0); % %A11451900 EMIT(0); % SN %A11452000 EMITL(1); % FP %A11452100 EMIT(0); % TYPE FP4 %A11452200 L1 ~ L; %A11452300 CALLSCAN; EMITO(DUP); EMITO(ADD); %A11452400 EMITO(BFW); %A11452500 EMITB(BBW,BUMPL,L1); %A11452600 L1 ~ L ~ L + 6; %A11452700 EMIT(0); EMITO(RTN); % 4 EOF %A11452800 EMITB(BFW,L1 - 4,L); % 1 ALPHA %A11452900 EMITO(MKS); EMITV(ATCON); %A11453000 EMITPAIR(2,BFC); EMITL(3); EMITO(RTN); % ATOMIC SYM ON OBLIS%A11453100 EMITV(BV); EMITPAIR(7,BFC); %A11453200 EMITO(MKS); EMITL(1); EMITV(MKATM); %A11453300 EMITPAIR(INSYM,STD); EMITL(3); EMITO(RTN); % BV=FALSE NEXT %A11453400 EMITL(4); EMITO(RTN); %A11453500 EMITB(BFW,L1 - 2,L); % 2 NUMBER %A11453600 EMIT(0); EMITPAIR(XLO,SND);EMITPAIR(XHI,SND); % XLO ~ XHI ~ 0 %A11453700 L2 ~ L; %A11453800 EMITO(DUP); EMITV(COUNTI); EMITO(XCH); %A11453900 EMITO(SUB); EMITO(DUP); EMITL(8); %A11454000 EMITO(GTR); EMITPAIR(2,BFC); %A11454100 EMITO(DEL); EMITL(8); EMIT(0); %A11454200 EMITO(MKS); %A11454300 EMIT(0); EMITN(INSTR); %A11454400 EMITO(ECM); STREAMTOG ~ TRUE; %A11454500 EMITC(1,RSA); %A11454600 EMITC(5,CRF); % T %A11454700 EMITC(0,SFS); EMITC(3,SFS); %A11454800 EMITC(3,SED); %A11454900 EMITC(4,CRF); % R %A11455000 EMITC(0,ICV); EMITC(1,0); %A11455100 STREAMTOG ~ FALSE; %A11455200 EMIT(0); EMITO(XCH); EMITV(XLO); %A11455300 EMITV(XHI); EMIT(0); EMITV(FP6); %A11455400 EMITV(TEN); EMITO(ML2); EMITO(AD2); %A11455500 EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11455600 EMITO(ADD); EMITO(DUP); %A11455700 EMITV(COUNTI); EMITO(EQL); %A11455800 EMITB(BBC,BUMPL,L2); %A11455900 EMITO(DEL); %A11456000 EMITI(0,43,3); EMITO(DUP); %A11456100 EMIT(0); EMITO(NEQ); %A11456200 L3 ~ BUMPL; % GO TO FIN %A11456300 EMITO(DUP); EMITL(3); EMITO(GTR); %A11456400 EMITV(CPI); EMITO(ADD); EMITL(1); %A11456500 EMITO(ADD); EMITO(DUP); %A11456600 EMITV(RMARGI); EMITO(GEQ); %A11456700 EMITPAIR(3,BFC); EMITO(DEL); %A11456800 L4 ~ BUMPL; % GO TO FIN %A11456900 EMITPAIR(CPI,STD); EMITO(DUP); %A11457000 EMITL(2); EMITO(EQL); %A11457100 L5 ~ BUMPL; %A11457200 EMITV(FP); %A11457300 L6 ~ BUMPL; %A11457400 EMITO(XCH); EMITO(DEL); %A11457500 EMIT(0); %A11457600 EMITO(XCH); CALLSCAN; %A11457700 EMITO(DEL); EMIT(0); %A11457800 EMITB(BBW,BUMPL,L2); %A11457900 EMITB(BFC,L6,L); %A11458000 EMITV(CPI); EMITL(1); EMITO(SUB); %A11458100 EMITPAIR(CPI,STD); %A11458200 EMITB(BFC,L5,L5 ~ BUMPL); %A11458300 EMITO(DUP); %A11458400 EMITV(FP); EMITPAIR(3,BFC); %A11458500 EMIT(0); EMITPAIR(2,BFW); %A11458600 EMITV(COUNTI); EMITO(SSN); %A11458700 EMITO(XCH); EMITPAIR(FP,STD); %A11458800 L7 ~ BUMPL; % GO TO OLD L8 %A11458900 % FIN: %A11459000 EMITB(BFC,L3,L); %A11459100 EMITB(BFW,L4,L); %A11459200 EMITV(FP); EMITPAIR(2,BFC); %A11459300 L3 ~ BUMPL; % TO OLD L12 %A11459400 % OLD L14: %A11459500 EMITB(BFW,L5,L); %A11459600 EMITO(DEL); %A11459700 EMITL(1); %A11459800 EMITV(COUNTI); %A11459900 L4 ~ BUMPL; % TO OLD L25 %A11460000 % THE FOLLOWING SECTION OF CODE IS FOR THE SPECIAL %A11460100 % CHARACTER CASE %A11460200 EMITB(BFW,L1,L); % SPECIAL CHARACTER %A11460300 EMITO(DUP); EMITL(2); EMITO(LEQ); %A11460400 EMITV(CPI); EMITV(RMARGI); %A11460500 EMITO(EQL); EMITO(LOR); %A11460600 L1 ~ BUMPL; %A11460700 EMIT(0); EMITV(INSTR ); EMITI(0,18,6); %A11460800 EMITPAIR(INSYM,STD); EMITL(3); EMITO(RTN); %A11460900 EMITB(BFC,L1,L); %A11461000 EMITO(DUP); EMITL(3); EMITO(LND); %A11461100 EMITPAIR(SN,SND); EMIT(0); %A11461200 EMITO(NEQ); EMITO(DUP); %A11461300 EMITO(LNG); %A11461400 EMITV(WSIGN); EMITO(LOR); %A11461500 EMITB(BBC,BUMPL,L1); %A11461600 EMITO(XCH); EMITI(0,43,3); EMITO(DUP); %A11461700 EMITL(1); EMITO(EQL); %A11461800 L5 ~ BUMPL; %A11461900 EMITO(DEL); CALLSCAN; EMITO(DEL); %A11462000 EMITB(BBW,BUMPL,L2 - 5); %A11462100 EMITB(BFC,L5,L); %A11462200 EMITO(DUP); EMITL(3); EMITO(GTR); %A11462300 EMITV(CPI); EMITO(ADD); EMITV(FP4); %A11462400 EMITO(ADD); EMITO(DUP); %A11462500 EMITV(RMARGI); EMITO(LSS); %A11462600 EMITB(BBC,BUMPL,L1); %A11462700 EMITPAIR(CPI,STD); EMITO(XCH); EMITO(DEL); %A11462800 EMITO(DUP); EMITL(2);EMITO(EQL); %A11462900 EMITPAIR(7,BFC); EMIT(0); EMITPAIR(XLO,SND); EMITPAIR(XHI,STD); %A11463000 EMITB(BBW,BUMPL,L6); %A11463100 EMITPAIR(FP,SND); %A11463200 EMITL(1); EMITPAIR(XHI,STD); EMIT(0); EMITPAIR(XLO,SND); %A11463300 % OLD L8: %A11463400 EMITB(BFW,L7,L); %A11463500 CALLSCAN; EMITO(DEL); %A11463600 EMITV(COUNTI); EMITL(8); %A11463700 EMITO(GTR); EMITPAIR(2,BFC); %A11463800 EMITL(1); EMITO(RTN); % RETURN IMPROPER NUMBER %A11463900 EMITO(XCH); EMITO(DEL); EMIT(0); %A11464000 EMITV(FP); EMITO(MKS); %A11464100 EMITV(COUNTI); EMIT(0); %A11464200 EMITN(INSTR); EMITO(ECM); %A11464300 STREAMTOG ~ TRUE; %A11464400 EMITC(1,RSA); EMITC(5,SED); %A11464500 EMITC(3,SFS); %A11464600 EMITC(2,CRF); EMITC(0,ICV); %A11464700 EMITC(1,0); STREAMTOG ~ FALSE; %A11464800 EMITD(47,1,1); %A11464900 EMITO(SUB); EMITO(DUP); EMITO(DUP); %A11465000 EMITO(SSP); EMITO(DUP); EMITL(69); %A11465100 EMITO(GEQ); %A11465200 EMITPAIR(2,BFC); EMITL(1); %A11465300 EMITO(RTN); % RETURN IMPROPER NUMBER %A11465400 EMITV(TEN); EMITI(0,3,6); EMITO(XCH); %A11465500 EMITD(1,1,1); %A11465600 EMITV(XHI); EMITI(0,3,6); %A11465700 EMITV(XHI); EMITD(2,1,1); EMITO(ADD); %A11465800 EMITL(12); EMITO(ADD); %A11465900 EMITO(SSP); EMITL(63); %A11466000 EMITO(GTR); EMITPAIR(2,BFC); %A11466100 EMITL(1); EMITO(RTN); % IMPROPER NUMBER - EXP TOO LARGE %A11466200 EMITO(DUP);EMIT(0); %A11466300 EMITO(LSS); EMITO(XCH); EMITO(SSP); %A11466400 % OLD L25: %A11466500 EMITB(BFW,L4,L); %A11466600 EMITV(XLO); EMITV(XHI); %A11466700 EMITV(FP4); EMITPAIR(10,BFC); %A11466800 EMITV(FP5); EMITO(DUP); EMITL(69); EMITO(ADD); %A11466900 EMITV(TEN); EMITO(XCH); EMITV(TEN); EMITO(DV2); %A11467000 EMITPAIR(8,BFW); %A11467100 EMITV(FP5); EMITO(DUP); EMITL(69); EMITO(ADD); %A11467200 EMITV(TEN); EMITO(XCH); EMITV(TEN); EMITO(ML2); %A11467300 EMITPAIR(XHI,STD); %A11467400 EMITPAIR(XLO,STD); %A11467500 EMITB(BFW,L3,L); % OLD L12 %A11467600 EMITV(XHI); EMITV(SN); EMITD(47,1,1); %A11467700 EMITPAIR(XHI,STD); %A11467800 EMITL(2); EMITO(RTN); % RETURN NUMBER RESULT %A11467900 END OF EMITREADCON; %A11468000 PROCEDURE EMITREADN; %A11468100 BEGIN REAL LS,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11; %A11468200 EMIT(0); LS ~ L; %A11468300 EMITO(MKS); %A11468400 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11468500 EMIT(0); EMITV(READCON); EMITV(FM2); EMITO(ADD); %A11468600 EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11468700 L1 ~ BUMPL; L2 ~ BUMPL; L3 ~ BUMPL; L4 ~ BUMPL; %A11468800 L5 ~ BUMPL; L6 ~ BUMPL; EMITB(BBW,BUMPL,LS); %A11468900 L7 ~ BUMPL; EMITB(BBW,BUMPL,LS); EMITB(BBW,BUMPL,LS); %A11469000 L8 ~ BUMPL; EMITB(BBW,BUMPL,LS); EMITB(BBW,BUMPL,LS); %A11469100 L9 ~ BUMPL; L10 ~ BUMPL; L11~BUMPL;EMITB(BBW,BUMPL,LS); %A11469200 EMITL(1); EMITO(RTN); EMITO(NOP); EMITO(NOP); %A11469300 EMITB(BFW,L9,L); EMITB(BFW,L10,L); EMITPAIR(0,MKS); %A11469400 EMITV(COUNTI); EMITO(DUP); EMITL(7); EMITO(GTR); %A11469500 EMITPAIR(2,BFC); EMITO(DEL); EMITL(7); EMITO(DUP); %A11469600 EMITL(8); EMITO(XCH); EMITO(SUB); EMITPAIR(INSTR,LOD); %A11469700 EMITO(ECM); EMITC(5,SED); EMITC(1,RSA); %A11469800 EMITC(3,SFS); EMITC(2,CRF); EMITC(0,SFD); %A11469900 EMITC(3,CRF); EMITC(0,TRS); EMITC(1,0); %A11470000 EMITV(FM2); EMITL(15); EMITO(EQL); EMITPAIR(3,BFC); %A11470100 EMITPAIR(INREAL,STD); EMIT(0); EMITO(RTN); %A11470200 EMITB(BFW,L3,L); EMITB(BFW,L7,L); %A11470280 EMITV(FM1); EMITPAIR(3,BFC); EMITV(INDBL); %A11470290 EMITPAIR(FM4,STD); EMIT(0); EMITPAIR(INSYM,STD); %A11470300 EMITV(INREAL); EMITO(RTN); %A11470310 EMITB(BFW,L1,L); EMITB(BFW,L2,L); EMITB(BFW,L4,L); %A11470320 EMITB(BFW,L5,L); EMITL(12); EMITPAIR(INSYM,STD); %A11470330 EMITPAIR(0,RTN); %A11470340 EMITB(BFW,L6,L); EMITB(BFW,L8,L); EMITB(BFW,L11,L); %A11470350 EMITO(MKS); EMITL(12); EMITV(CHARPRINT); %A11470360 EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11470370 %T9011470380 EMITO(MKS); EMITV(TERPRIN); EMITB(BBW,BUMPL,LS); %A11470390 END OF EMITREADN; %A11470400 PROCEDURE EMITREADSYM; %A11470500 BEGIN %A11470600 REAL TL,R,S; %A11470700 EMIT(0); %A11470800 EMITL(1); % LT FP2 %A11470900 EMIT(0); %A11471000 EMITO(MKS); EMITV(READ1); %A11471100 EMITO(DUP); EMITL(")"); EMITO(EQL); %A11471200 EMITPAIR(4,BFC); %A11471300 EMIT(0); EMITN(FM1); EMITO(SND); %A11471400 EMITO(RTN); %A11471500 EMITO(DUP); %A11471600 EMITO(DUP); EMITO(DUP); %A11471700 EMITL("$"); EMITO(EQL); EMITO(XCH); %A11471800 EMITL("."); EMITO(EQL); EMITO(LOR); EMITO(XCH); %A11471900 EMITL(","); EMITO(EQL); EMITO(LOR); %A11472000 EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11472100 EMITO(DUP); EMITL("("); EMITO(EQL); %A11472200 EMITPAIR(7,BFC); EMITO(MKS); EMITN(FP4); %A11472300 EMITV(READSYM); EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11472400 MARKSYMNCR(1); EMITD(33,18,15); %A11472500 GENSYMLINK; %A11472600 EMITN(FM1); EMITO(SND); %A11472700 MARKSYMNCR(0); %A11472800 EMITO(MKS); EMITV(READ1); %A11472900 MARKSYMNCR(1); %A11473000 TL ~ L; %A11473100 EMITO(DUP); EMITL(")"); %A11473200 EMITO(EQL); %A11473300 R ~ BUMPL; %A11473400 MARKSYMDCR(-2); %A11473500 EMIT(0); EMITO(RTN); %A11473600 EMITB(BFC,R,L); %A11473700 EMITO(DUP); EMITL("$"); EMITO(EQL); %A11473800 EMITV(FP2); EMITO(LNG); EMITO(LOR); %A11473900 R ~ BUMPL; %A11474000 MARKSYMDCR(-2); EMITL(1); EMITO(RTN); %A11474100 EMITB(BFC,R,L); %A11474200 EMITO(DUP); EMITL(","); EMITO(EQL); %A11474300 EMITPAIR(5,BFC); EMITO(DEL); %A11474400 EMITO(MKS); EMITV(READ1); EMITPAIR(10,BFW); %A11474500 EMITO(DUP); EMITL("."); EMITO(EQL); %A11474600 EMITPAIR(5,BFC); EMIT(0); %A11474700 EMITPAIR(FP2,STD); EMITPAIR(15,BBW); %A11474800 EMITO(DUP); EMITO(DUP); %A11474900 EMITO(DUP); EMITO(DUP); %A11475000 EMITL("$"); EMITO(NEQ); EMITO(XCH); %A11475100 EMITL("."); EMITO(NEQ); EMITO(LND); EMITO(XCH); %A11475200 EMITL(","); EMITO(NEQ); EMITO(LND); EMITO(XCH); %A11475300 EMITL(12); EMITO(NEQ); EMITO(LND); %A11475400 EMITB(BBC,BUMPL,R); %A11475500 EMITO(DUP); EMITL("("); EMITO(EQL); %A11475600 EMITPAIR(6,BFC); % %A11475700 EMITO(MKS); EMITN(FP4);EMITV(READSYM); %A11475800 EMITO(LNG); %A11475900 EMITB(BBC,BUMPL,R); %A11476000 MARKSYMNCR(0); %A11476100 EMITV(FP2); %A11476200 R ~ BUMPL; %A11476300 EMIT(0); EMITO(XCH); %A11476400 EMITD(33,18,15); GENSYMLINK; %A11476500 MARKSYMNCR(0); EMITB(BFC,R,L); %A11476600 EMITV(FP3); GETCONTENTS(0,TRUE); %A11476700 EMITO(DUP); EMITO(LOD); EMITV(FP4); %A11476800 EMITO(CTC); %A11476900 EMITO(XCH); EMITO(STD); %A11477000 EMITO(XCH); EMITO(DEL); EMITO(MKS); %A11477100 EMITV(READ1); MARKSYMNCR(0); %A11477200 EMITB(BBW,BUMPL,TL); %A11477300 END OF EMITREADSYM; %A11477400 PROCEDURE EMITRECALL; %A11477500 BEGIN REAL T,R; %A11477600 EMIT(0); %A11477700 IF RECLAIMTOG THEN BEGIN% %A11477750 EMITV(GENU); %A11477800 EMITERR(SGNO,L,"13");% %A11477900 END; %A11477950 EMITO(MKS); %A11478000 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11478100 EMITL(5); EMITN(FM1); %A11478200 EMIT(0); EMITL(2); EMIT(0); %A11478300 EMITL(128); %A11478400 EMITPAIR(SYMSTACKA,LOD); %A11478500 FOR T ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11478600 EMITV(13); %A11478700 EMITL(P2); EMITV(SYMSTACKA); EMITPAIR(FREELIST,STD); %A11478800 EMITL(P3); EMITV(SYMSTACKA); EMITPAIR(LNKROW,STD); %A11478900 EMITL(P4); EMITV(SYMSTACKA); EMITPAIR(LNKCOL,STD); %A11479000 EMIT(0); %A11479100 T ~ L; %A11479200 EMITO(MKS); %A11479300 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11479400 EMITL(5); EMITN(FM1); %A11479500 EMIT(0); EMITL(2); EMIT(0); %A11479600 EMITL(512); %A11479700 EMITV(FP2); EMITN(LNKA); EMITO(LOD); %A11479800 FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11479900 EMITV(13); EMITL(1); EMITO(ADD); %A11480000 EMITO(DUP); EMITV(LNKCOL); EMITO(GTR); %A11480100 EMITB(BBC,BUMPL,T); EMITO(XIT); %A11480200 END OF EMITRECALL; %A11480300 PROCEDURE EMITRECLAIMER; %A11480400 BEGIN REAL T,R,S; %A11480500 EMIT(0); EMIT(0); %A11480550 T ~ L; %A11480600 EMITO(MKS); %A11481400 IF DAC[14] = 0 THEN FLAG(668); %A11481410 EMITPAIR(DAC[14],LOD); EMITO(ECM); %A11481420 EMITC(3,CRF); EMITC(0,JFW); %A11481430 EMITC(12,TRP); EMIT(" G"); %A11481440 EMIT("O "); EMIT("AH"); %A11481450 EMIT("EA"); EMIT("D."); %A11481460 EMIT("{!"); EMITC(12,SEC); %A11481470 EMITC(11,JFW); EMITC(17,TRP); EMIT(" "); %A11481480 EMIT("PL"); EMIT("EA"); EMIT("SE"); EMIT(" R"); %A11481490 EMIT("ET"); EMIT("YP"); EMIT("E."); EMIT("{!"); %A11481500 EMITC(17,SEC); EMITC(3,STC); EMITC(1,0); %A11481510 EMITPAIR(CP,STD); EMITO(MKS); EMITV(TERPRIN); %A11481520 IF DAC[4]=0 OR DAC[5]=0 OR DACOMI = 0 THEN FLAG(679); %A11481530 IF R~SFTRC.[37:11]=0 OR S~SFTRC.[26:11]=0 THEN FLAG(671); %A11481535 EMIT(0); EMITPAIR(CPI,STD); EMITL(1); EMITPAIR(DAC[4],STD); %A11481540 EMITO(MKS); EMITV(DACOMI); EMITO(DEL); EMITO(MKS); %A11481545 EMITV(R); EMITV(FM2); EMITV(S); EMITO(EQL); %A11481550 EMITPAIR(1,BFC); EMITO(XIT); EMITO(MKS); EMITV(FM1); %A11481555 EMITPAIR(3,BFC); EMIT(0); EMITPAIR(1,BFW); EMITL(9); %A11481560 EMITB(BBW,BUMPL,T); %A11481565 END OF EMITRECLAIMER; %A11481600 PROCEDURE EMITRECLINK; %A11481700 BEGIN REAL L1,L2,L3,L4,L5,L6; %A11481800 REAL L7;% %A11481850 DEFINE P = FP2#, A = FM1#, AR=FM2#, DF = FM3#, LF = FM4#, %A11481900 P2=FM5#,P1=FM6#, R = FM7#, FL =FM8#,NXT=FM9#,RA=907#, %A11482000 CA = EMITV(A);EMITO(DUP);EMIT(0);EMITO(GTR);EMITO(XCH); %A11482100 EMITL(5);EMITO(LSS);EMITO(LND);EMITPAIR(4,BFC)#, %A11482200 RO = EMITV(R);EMITL(126);EMITO(LND);EMITN(R);EMITO(STD)#, %A11482300 R1 =EMITV(R);EMITL(1);EMITO(LOR);EMITN(R);EMITO(STD)#; %A11482400 % %A11482500 EMIT(0); EMIT(0); EMITV(A); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11482600 L1 ~ BUMPL; % 0 %A11482700 L2 ~ BUMPL; % 1 %A11482800 L3 ~ BUMPL; % 2 %A11482900 BUMPL; % 3 %A11483000 L4 ~ BUMPL; % 4 %A11483100 EMITV(P1); EMIT(0); EMITO(LSS);% %A11483200 L5 ~ BUMPL; %A11483300 RO; EMITN(P1); EMITPAIR(P,STD); L7 ~ BUMPL;% %A11483400 ADJUST; EMITB(BFC,L5,L5~L); EMITV(P2);% %A11483500 EMIT(0); EMITO(GEQ); EMITPAIR(1,BFC); EMITO(XIT);% %A11483600 R1; EMITN(P2); EMITPAIR(P,STD); EMITL(6); %A11483700 EMITPAIR(A,STD); %A11483800 L6 ~ BUMPL; %A11483900 EMITB(BFW,L3,L); %A11484000 EMITV(FL); EMIT(0); EMITO(EQL); %A11484100 EMITPAIR(12,BFC); %A11484200 EMITV(NXT); EMITL(1); EMITO(ADD); EMITPAIR(RA,SND); %A11484300 EMITN(NXT); EMITO(STD); EMITL(3); EMITPAIR(A,STD); %A11484400 L3~BUMPL; %A11484500 EMITV(FL); EMITPAIR(RA,STD); %A11484600 EMITB(BFW,L1,L); EMITB(BFW,L2,L); EMITB(BFW,L4,L); %A11484700 EMITV(RA); EMITV(P1); EMITO(SSP); EMITO(EQL); %A11484800 EMITPAIR(21,BFC); %A11484900 RO; CA; EMITV(P1); EMITO(SSN); EMITN(P1); EMITO(STD); %A11485000 L1 ~ BUMPL; %A11485100 EMITV(RA); EMITV(P2); EMITO(SSP); EMITO(EQL); %A11485200 EMITPAIR(21,BFC); %A11485300 R1; CA; EMITV(P2); EMITO(SSN); EMITN(P2); EMITO(STD); %A11485400 L2~BUMPL; %A11485500 EMITB(BFW,L3,L); %A11485600 EMITV(R); EMITPAIR(10,BFC); %A11485700 RO; EMITN(P1); EMITPAIR(P,STD); EMITPAIR(8,BFW); %A11485800 R1; EMITN(P2); EMITPAIR(P,STD); %A11485900 EMITV(P); EMIT(0); EMITO(LSS); %A11486000 L3 ~ BUMPL; %A11486100 EMITB(BFW,L7,L); EMITB(BFW,L6,L);% %A11486200 EMITO(MKS); EMITPAIR(105,LOD); EMITN(DF); EMITV(P); %A11486300 EMITO(SSP); EMIT(0); EMIT(0); %A11486400 EMITV(LF); EMITV(R); EMITN(AR); EMITO(LOD); %A11486500 FOR L4 ~ 1 STEP 1 UNTIL 5 DO EMIT(0); EMITV(12); %A11486600 EMITB(BFC,L3,L); %A11486700 EMITV(A); EMITL(3); EMITO(LSS); L3 ~ BUMPL;% %A11486800 EMITV(RA); EMIT(0); EMITO(EQL); EMITERR(% %A11486900 SGNO,L,"14"); %A11487000 EMITO(MKS); EMITPAIR(105,LOD); EMITN(DF); EMITV(RA); %A11487100 EMITO(SSP); EMITL(1); EMITO(ADD); %A11487200 EMITL(2); EMIT(0); EMITV(LF); EMITV(R); EMITN(AR); EMITO(LOD); %A11487300 FOR L4 ~ 1 STEP 1 UNTIL 5 DO EMIT(0); EMITV(13); %A11487400 EMITB(BFC,L3,L); %A11487500 EMITV(A); EMIT(0); EMITO(EQL); %A11487600 EMITPAIR(6,BFC); %A11487700 EMITV(RA); EMITO(SSP); EMITN(P); EMITO(STD); %A11487800 L3 ~ BUMPL; %A11487900 EMITV(A); EMITL(5); EMITO(LSS); %A11488000 EMITPAIR(4,BFC); %A11488100 EMITV(RA); EMITO(SSN); EMITN(P); EMITO(STD); ADJUST; %A11488200 EMITB(BFW,L3,L); EMITB(BFW,L1,L); EMITB(BFW,L2,L); %A11488300 EMITV(A); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11488400 L1 ~ BUMPL; % 0 %A11488500 L2~BUMPL; % 1 %A11488600 L3 ~ BUMPL; % 2 %A11488700 L4 ~ BUMPL; % 3 %A11488800 L6 ~ BUMPL; % 4 %A11488900 EMITB(BBW,BUMPL,L5); % 5 %A11489000 EMITO(XIT); %A11489100 EMITB(BFW,L3,L); %A11489200 EMITV(R); EMITN(AR); EMITO(LOD); EMIT(0); EMITO(CDC); %A11489300 EMITO(DUP); EMITO(LOD); EMITN(FL); EMITO(STD); %A11489400 EMIT(0); EMITO(XCH); EMITO(STD); EMITO(XIT); %A11489500 EMITB(BFW,L4,L); EMITB(BFW,L6,L); %A11489600 EMITO(MKS); EMITV(A); EMITPAIR(3,BFC); EMIT(0); %A11489700 EMITPAIR(1,BFW); EMITV(FL); EMIT(0); EMITV(LF); %A11489800 EMITL(2); EMITO(SUB); EMITO(DUP); EMITL(64); EMITO(IDV); %A11489900 EMITPAIR(JUNK,ISN); EMITV(R); EMITN(AR); EMITO(LOD); %A11490000 EMIT(0); EMITO(CDC); EMITO(ECM); %A11490100 EMITC(5,SES); EMITC(2,TRW); %A11490200 EMITC(1,RSA); EMITC(8,SFS); %A11490300 EMITC(3,CRF); EMITC(0,TRW); %A11490400 EMITC(2,CRF); EMITC(3,BNS); %A11490500 EMITC(32,TRW); %A11490600 EMITC(32,TRW); %A11490700 EMITC(0,ENS); EMITC(1,0); %A11490800 EMITV(A); %A11490900 EMITPAIR(1,BFC); EMITO(XIT); %A11491000 EMITV(RA); EMITN(FL); EMITO(STD); EMITO(XIT); %A11491100 EMITB(BFW,L1,L); EMITB(BFW,L2,L); %A11491200 EMITV(R); EMITN(AR); EMITO(LOD); EMITPAIR(RA,STD); EMITO(XIT); %A11491300 END OF EMITRECLINK; %A11491400 PROCEDURE EMITREMEMBER; %A11491500 BEGIN REAL T,R; %A11491600 EMIT(0); %A11491700 IF RECLAIMTOG THEN BEGIN %A11491750 EMITL(1); EMITPAIR(GENOK,STD); %A11491800 EMITO(MKS); EMITV(MARKOB); %A11491900 EMITO(MKS); EMITV(COLLECT); %A11492000 END ELSE %A11492010 IF SYMSTK THEN BEGIN EMITV(LNKROW); EMITI(0,33,6); %A11492020 EMITPAIR(LNKCOL,STD); END; %A11492050 EMITV(FREELIST); EMITL(P2); EMITN(SYMSTACKA); %A11492100 EMITO(STD); %A11492200 EMITV(LNKROW); EMITL(P3); EMITN(SYMSTACKA); %A11492300 EMITO(STD); %A11492400 EMITV(LNKCOL); EMITL(P4); EMITN(SYMSTACKA); EMITO(STD); %A11492500 EMITO(MKS); %A11492600 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11492700 EMITL(5); EMITN(FM1); %A11492800 EMIT(0); EMITL(1); EMIT(0); %A11492900 EMITL(128); EMITPAIR(SYMSTACKA,LOD); %A11493000 FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11493100 EMITV(12); %A11493200 % %A11493300 EMIT(0); % FP2 %A11493400 T ~ L; %A11493500 EMITO(MKS); %A11493600 EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11493700 EMITL(5); EMITN(FM1); %A11493800 EMIT(0); EMITL(1); EMIT(0); %A11493900 EMITL(512); EMITV(FP2); %A11494000 EMITN(LNKA); EMITO(LOD); %A11494100 FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11494200 EMITV(12); %A11494300 EMITL(1); EMITO(ADD); EMITO(DUP); %A11494400 EMITV(LNKCOL); EMITO(GTR); %A11494500 EMITB(BBC,BUMPL,T); %A11494600 EMITO(XIT); %A11494700 END OF EMITREMEMBER; %A11494800 PROCEDURE EMITREMOB; %A11494900 BEGIN REAL T; %A11495000 EMIT(0); %A11495100 EMIT(0); %A11495200 EMITV(FM1); EMITO(CTC); EMITO(DUP); %A11495300 EMITL(64); EMITO(LSS); %A11495400 EMITPAIR(1,BFC); EMITO(XIT); %A11495500 EMITO(DUP); GETCONTENTS(0,FALSE); %A11495600 EMITO(DUP); EMITI(0,1,2); %A11495700 EMITL(2); EMITO(NEQ); %A11495800 EMITPAIR(1,BFC); EMITO(XIT); %A11495900 EMITO(DUP); %A11496000 GETCONTENTS(1,FALSE); %A11496100 EMITO(DUP); EMITI(0,1,35); EMITO(DUP); %A11496200 EMITI(0,12,6); EMITL(7); EMITO(GTR); %A11496210 T ~ BUMPL; %A11496220 EMITO(XCH); GETCONTENTS(0,FALSE); EMITD(6,42,6); %A11496230 EMITPAIR(2,BFW); EMITB(BFC,T,L); %A11496240 EMITO(XCH); EMITO(DEL); EMITL(125); %A11496250 EMITO(RDV); EMITN(SYMSTACKA); %A11496300 EMITO(DUP); EMITO(LOD); %A11496400 EMITO(DUP); EMITV(FP2); EMITO(EQL); %A11496500 T ~ BUMPL; %A11496600 EMITO(DEL); EMITO(XCH); %A11496700 EMITI(0,3,15); EMITO(DUP); EMITL(1); EMITO(LEQ); %A11496800 EMITPAIR(2,BFC); EMITO(DEL); EMIT(0); %A11496900 EMITO(XCH); EMITO(STD); EMITO(XIT); %A11497000 EMITB(BFC,T,L); %A11497100 T ~ L; %A11497200 EMITO(XCH); EMITO(DEL); EMITO(DUP); EMITL(1); EMITO(LEQ); %A11497300 EMITPAIR(1,BFC); EMITO(XIT); %A11497400 GETCONTENTS(0,TRUE); EMITO(DUP); %A11497500 EMITO(LOD); EMITO(DUP); %A11497600 EMITI(0,3,15); EMITO(DUP); %A11497700 EMITV(FP2); EMITO(NEQ); %A11497800 EMITPAIR(4,BFC); EMITO(XCH); EMITO(DEL); %A11497900 EMITB(BBW,BUMPL,T); %A11498000 EMITO(DEL); EMITV(FP3); EMITD(3,3,15); %A11498100 EMITO(XCH); EMITO(STD); %A11498200 EMITO(XIT); %A11498300 END OF EMITREMOB; %A11498400 PROCEDURE EMITREMPROP; %A11498500 BEGIN REAL T; %A11498600 EMIT(0); %A11498700 EMITV(FM3); %A11498800 GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11498900 EMITL(2); EMITDIAL(DIA,46); %A11499000 EMITDIAL(DIB,1); EMITFC(FCE,2); %A11499100 EMITO(LNG); EMITPAIR(1,BFC); EMITO(XIT); %A11499200 T ~ L; %A11499300 EMITO(DUP); %A11499400 GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11499500 EMITO(DUP); EMIT(0); EMITO(LSS); %A11499600 EMITPAIR(1,BFC); EMITO(XIT); %A11499700 EMITDIAL(DIB,2); EMITV(FM1); %A11499800 EMITV(FM2); EMITPAIR(4,BFC); %A11499900 EMITDIAL(DIA,46); EMITFC(FCE,2); %A11500000 EMITPAIR(2,BFW); %A11500100 EMITDIAL(DIA,32);EMITFC(FCE,16); %A11500200 EMITPAIR(6,BFC); %A11500300 EMITO(XCH); EMITO(DEL); EMITO(CTC); %A11500400 EMITO(XCH); EMITO(STD); EMITO(XIT); %A11500500 EMITPAIR(FP2,STD); EMITO(XCH); %A11500600 EMITO(DEL); EMITO(XCH); %A11500700 EMITB(BBW,BUMPL,T); %A11500800 END OF EMITREMPROP; %A11500900 PROCEDURE EMITRITE; %A11501000 BEGIN EMIT(0); %A11501100 EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11501200 IF GPBV!0 OR DACP!0 THEN BEGIN %A11501300 IF GPBV!0 THEN EMITV(GPBV); %A11501400 IF DACP!0 THEN BEGIN EMITV(DAC[8]); %A11501500 IF GPBV!0 THEN EMITO(LOR) END; %A11501600 EMITO(LNG); EMITPAIR(3,BFC); END; %A11501700 EMITV(LMARG); EMITPAIR(CP,STD); %A11501800 EMITV(PROTOG); %A11501900 EMITPAIR(3,BFC); %A11502000 EMITO(MKS); EMITV(FM1); EMITO(XIT); %A11502100 EMITRD(FALSE,LGO,STRP,0); %A11502200 EMITO(XIT); %A11502300 INOUTUSED.[47:1] ~1; % PRINT %A11502400 END; %A11502500 PROCEDURE EMITSCAN; %A11502600 BEGIN REAL T; %A11502700 REAL STREAM PROCEDURE GITSYL(A,B); VALUE B; %A11502800 BEGIN DI ~ LOC GITSYL; DI ~ DI + 6; %A11502900 SI ~ A; SI ~ SI + B; SI ~ SI + B; %A11503000 DS ~ 2 CHR END; %A11503100 DEFINE R = FP2#; %A11503200 REAL P,S; %A11503300 REAL J; %A11503400 REAL K; %A11503500 ARRAY A[0:27]; %A11503600 INOUTUSED.[45:1] ~1; % READ %A11503700 ADJUST; %A11503800 EMITV(BLOCKCTR); EMITL(1); EMITO(ADD); %A11503900 EMITPAIR(BLOCKCTR,SND); EMIT(0); %A11504000 EMITV(INITI); J ~ BUMPL; %A11504100 EMITV(CPI); % 9 %A11504200 EMITV(RMARGI); % 10 %A11504300 EMITO(GEQ); % 11 %A11504400 P ~ BUMPL; %A11504500 EMITV(PROI); % 17 %A11504600 K ~ BUMPL; %A11504700 % %A11504800 EMITO(MKS); % 20 %A11504900 EMITV(FM1); % 21 %A11505000 EMITV(LMARGI); EMITV(RMARGI); EMITO(GEQ); EMITO(LOR); %A11505100 S ~ BUMPL; %A11505200 ADJUST; %A11505300 EMITB(BFC,J,L); %A11505400 T ~ PROGDESCBLDR(LDES,L,PRTFL); %A11505500 EMITV(BLOCKCTR); % 24 %A11505600 EMITL(1); % 25 %A11505700 EMITO(SUB); % 26 %A11505800 EMITPAIR(BLOCKCTR,STD); % 27 %A11505900 EMITL(4); % 29 %A11506000 EMITO(RTN); % 30 %A11506100 EMITB(BFC,K,L); %A11506200 EMITRD(TRUE,LGI,STRI,T); % 31 %A11506300 EMITB(BFC,S,L); EMITV(LMARGI); EMITPAIR(CPI,STD); %A11506400 EMITB(BFC,P,L); %A11506500 EMIT(0); % 54 %A11506600 EMITO(MKS); EMITV(CPI); EMITL(8); %A11506700 EMITO(IDV); EMITN(FM2); EMITV(CPI); %A11506800 EMITI(0,45,3); EMITV(RMARGI); EMITV(CPI); %A11506900 EMITO(SUB); EMITL(1); EMITO(SUB); EMITO(DUP); %A11507000 EMITL(30); EMITO(GTR); %A11507100 EMITPAIR(2,BFC); EMITO(DEL); EMITL(30); %A11507200 EMIT(0); EMITN(INSTR); %A11507300 EMITO(DUP); EMIT(0); EMITO(XCH); EMITO(STD); %A11507400 EMITN(FM3); EMITN(FP2 ); EMITO(ECM); %A11507500 STREAMTOG ~ TRUE; %A11507600 FILL A[*] WITH %A11507700 OCT0653054300310304, OCT0316014200261545, %A11507800 OCT0177044305520026, OCT0344017701400051, %A11507900 OCT1041024204410042, OCT6047213614450177, %A11508000 OCT0443055221360344, OCT0177014000511041, %A11508100 OCT0142044140476024, OCT1445013104430552, %A11508200 OCT6024034401310140, OCT0051104100420441, %A11508300 OCT2347017710410342, OCT0441004201302024, %A11508400 OCT0245024203475424, OCT1045014201310026, %A11508500 OCT0445044035474047, OCT4447322405450131, %A11508600 OCT0026264510402447, OCT1324224501312025, %A11508700 OCT0345542501450147, OCT0131002611450130, %A11508800 OCT1440542402450440, OCT0347202401451040, %A11508900 OCT0541052202040105, OCT1022073103040216, %A11509000 OCT0177042201040105, OCT0100000000000000; %A11509100 FOR T ~ 0 STEP 1 UNTIL 108 DO %A11509200 EMIT(GITSYL(A[T DIV 4],T.[46:2])); %A11509300 STREAMTOG ~ FALSE; %A11509400 EMITPAIR(COUNTI,SND); %A11509500 EMITV(CPI); EMITO(ADD); %A11509600 EMITPAIR(CPI,STD); %A11509700 EMITV(BLOCKCTR); EMITL(1); %A11509800 EMITO(SUB); EMITPAIR(BLOCKCTR,STD); %A11509900 EMITV(FP2); EMITO(RTN); %A11510000 END OF EMITSCAN; %A11510100 PROCEDURE EMITSPACEPRINT; %A11510200 BEGIN REAL T; %A11510300 EMIT(0); %A11510400 EMITV(FM1); EMIT(0); EMITO(LSS); EMITV(OUTOG); %A11510500 EMITO(LOR); EMITPAIR(1,BFC); EMITO(XIT); %A11510600 EMITV(CP); EMITV( RMARG); EMITO(GEQ); %A11510700 T ~ BUMPL ; %A11510800 CALLRITE; EMITO(XIT); %A11510900 EMITB(BFC,T,L); %A11511000 EMITV(CP); EMITV(FM1); EMITO(ADD); %A11511100 EMITV(RMARG); EMITO(GEQ); %A11511200 EMITPAIR(5,BFC); %A11511300 EMITV(RMARG); EMITV(CP); EMITO(SUB); %A11511400 EMITPAIR(3,BFW); EMITV(FM1); %A11511500 EMITPAIR(FM1,ISN); %A11511600 EMITO(DUP); EMITL(46); EMITO(GEQ); %A11511700 T~BUMPL; %A11511800 EMITV(CP); EMITL(7); %A11511900 EMITO(LND); EMITL(16); %A11512000 EMITO(XCH); EMITO(SUB); %A11512100 EMITO(DUP); EMITV(FP2); %A11512200 EMITO(XCH); EMITO(SUB); %A11512300 EMITO(DUP); EMITL(7); %A11512400 EMITO(LND); EMITO(XCH); %A11512500 EMITL(8); EMITO(IDV); %A11512600 EMITPAIR(JUNK,ISN); EMITO(DUP); %A11512700 EMITL(64); EMITO(IDV); EMITPAIR(JUNK,ISN); %A11512800 EMITB(BFC,T,T~BUMPL); %A11512900 EMITO(DUP); EMIT(0); %A11513000 EMIT(0); EMIT(0); %A11513100 EMITB(BFW,T,L); %A11513200 EMITO(MKS); LODSTR; %A11513300 % %A11513400 EMITC(7,CRF); EMITC(3,BNS); %A11513500 EMITC(1,TRP); EMIT(" "); %A11513600 EMITC(0,ENS); EMITC(1,RSA); %A11513700 EMITC(2,CRF); EMITC(0,SFS); EMITC(5,CRF); %A11513800 EMITC(0,TRW); EMITC(4,CRF); %A11513900 EMITC(3,BNS); EMITC(32,TRW); %A11514000 EMITC(32,TRW); EMITC(0,ENS); %A11514100 EMITC(6,CRF); EMITC(3,BNS); %A11514200 EMITC(1,TRP); EMIT(" "); %A11514300 EMITC(0,ENS); EMITC(1,0); %A11514400 STREAMTOG~FALSE; %A11514500 EMITV(CP); EMITV(FP2); %A11514600 EMITO(ADD); %A11514700 EMITPAIR(CP,SND); EMITV(RMARG); %A11514800 EMITO(LSS); %A11514900 EMITPAIR(1,BFC); EMITO(XIT); %A11515000 CALLRITE; EMITO(XIT); %A11515100 END OF EMITSPACEPRINT; %A11515200 PROCEDURE EMITSTRINGPRINT; %A11515300 BEGIN REAL T,R,S; %A11515400 EMIT(0); %A11515500 EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11515600 EMIT(0); %A11515700 EMITV(NSTR); %A11515800 T ~ L; %A11515900 EMITO(DUP); EMITV(CP); EMITO(ADD); EMITV(RMARG); %A11516000 EMITO(LEQ); %A11516100 R ~ BUMPL; %A11516200 EMITO(MKS); EMITV(FP2); %A11516300 EMITO(DUP); EMITL(7); EMITO(LND); %A11516400 EMITO(XCH); EMITL(8); EMITO(IDV); %A11516500 EMITN(OUTSTR); %A11516600 EMITV(FP3); EMITO(DUP); %A11516700 EMITL(63); EMITO(LND); %A11516800 EMITO(XCH); EMITL(64); EMITO(IDV); %A11516900 EMITPAIR(JUNK,ISN); LODSTR; %A11517000 EMITC(5,RSA); EMITC(6,CRF); %A11517100 EMITC(0,SFS); EMITC(4,CRF); %A11517200 EMITC(0,TRS); EMITC(3,CRF); %A11517300 EMITC(3,BNS); EMITC(32,TRS); %A11517400 EMITC(32,TRS); EMITC(0,ENS); %A11517500 EMITC(1,0); STREAMTOG ~ FALSE; %A11517600 EMITO(DUP); EMITV(CP); EMITO(ADD); %A11517700 EMITPAIR(CP,SND); EMITV(RMARG); %A11517800 EMITO(GEQ); %A11517900 S ~ BUMPL; %A11518000 CALLRITE; %A11518100 EMITB(BFC,S,L); %A11518200 EMITO(ADD); %A11518300 EMITO(DUP); EMITV(NSTR); %A11518400 EMITO(EQL); EMITPAIR(1,BFC); EMITO(XIT); %A11518500 EMITO(DUP); EMITV(NSTR); %A11518600 EMITO(XCH); EMITO(SUB); %A11518700 EMITB(BBW,BUMPL,T); %A11518800 EMITB(BFC,R,L); %A11518900 EMITV(FM1); %A11519000 R ~ BUMPL; %A11519100 EMITO(DUP); EMITV(RMARG); %A11519200 EMITV(LMARG); EMITO(SUB); %A11519300 EMITO(LEQ); %A11519400 S ~ BUMPL; %A11519500 EMITV(CP); EMITV(LMARG); EMITO(NEQ); %A11519600 EMITPAIR(2,BFC); %A11519700 EMITO(MKS); EMITV(TERPRIN); %A11519800 EMITB(BBW,BUMPL,T); %A11519900 EMITB(BFC,S,L); %A11520000 EMITO(DEL); EMITV(RMARG); %A11520100 EMITV(CP); EMITO(SUB); %A11520200 EMITB(BBW,BUMPL,T); %A11520300 EMITB(BFC,R,L); %A11520400 EMITO(DEL); EMITV(RMARG); EMITV(CP); %A11520500 EMITO(SUB); %A11520600 EMIT(0); EMITO(MKS); EMIT(0); %A11520700 EMITV(FP3); EMITV(FP2); EMITO(ADD); %A11520800 EMITO(DUP); EMITL(7); EMITO(LND); %A11520900 EMITO(XCH); EMITL(8); EMITO(IDV); %A11521000 EMITN(OUTSTR); EMITV(FP3); EMITO(DUP); %A11521100 EMITL(63); EMITO(LND); EMITO(XCH); %A11521200 EMITL(64); EMITO(IDV); %A11521300 EMITPAIR(JUNK,ISN); EMITO(ECM); %A11521400 STREAMTOG ~ TRUE; %A11521500 EMITC(3,RSA); EMITC(4,CRF); %A11521600 EMITC(0,SFS); EMITC(" ",TNE); %A11521700 EMITC(33,JFC); %A11521800 EMITC(1,CRF); %A11521900 EMITC(18,BNS); EMITC(2,BNS); %A11522000 EMITC(32,BNS); EMITC(1,SRS); %A11522100 EMITC(" ",TNE); EMITC(3,JNC); %A11522200 EMITC(1,INC); EMITC(0,ENS); EMITC(1,JFW); %A11522300 EMITC(2,JNS); EMITC(0,ENS); %A11522400 EMITC(1,JFW); EMITC(13,JNS); %A11522500 EMITC(5,CRF); %A11522600 EMITC(0,SEC); EMITC(1,INC); %A11522700 EMITC(5,STC); EMITC(0,SEC); %A11522800 EMITC(0,ENS); %A11522900 EMITC(2,CRF); EMITC(5,BNS); %A11523000 EMITC(1,SRS); EMITC(" ",TNE); %A11523100 EMITC(2,JNC); EMITC(1,INC); %A11523200 EMITC(0,ENS); %A11523300 EMITC(7,STC); EMITC(5,SES); %A11523400 EMITC(7,SFS); EMITC(7,SED); %A11523500 EMITC(6,SFD); EMITC(1,TRS); %A11523600 EMITC(1,0); STREAMTOG ~ FALSE; %A11523700 EMITO(SUB); EMITO(DUP); %A11523800 EMIT(0); EMITO(EQL); %A11523900 EMITB(BBC,BUMPL,T); %A11524000 EMITO(DEL); EMITO(DUP); %A11524100 EMITV(NSTR); EMITO(XCH); %A11524200 EMITO(SUB); %A11524300 EMITB(BBW,BUMPL,R); %A11524400 END OF EMITSTRINGPRINT; %A11524500 PROCEDURE EMITSYMEQ; %A11524600 BEGIN REAL T,R,S; %A11524700 EMIT(0); %A11524800 S ~ L; %A11524900 EMITV(FM3); EMITV(FM2); %A11525000 EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11525100 EMITFC(FCE,15); %A11525200 EMITPAIR(4,BFC); EMITL(1); %A11525300 EMITPAIR(FM3,STD); EMITO(XIT); %A11525400 EMIT(0); EMITO(XCH); EMITO(CTC); %A11525500 EMITO(DUP); %A11525600 EMITL(10); EMITO(LSS); %A11525700 EMITPAIR(4,BFC);R ~ L; %A11525800 EMIT(0); EMITPAIR(FM3,STD); EMITO(XIT); %A11525900 GETCONTENTS(0,FALSE); EMITO(DUP); %A11526000 EMITI(0,1,2); EMITO(DUP); EMITO(ADD); %A11526100 EMITO(BFW); %A11526200 T ~ L ~ L + 6; %A11526300 GETCONTENTS(0,FALSE); EMITV(FM2); EMITO(XCH); %A11526400 EMITO(MKS); EMITV(SYMEQA); EMITO(DEL); %A11526500 EMITPAIR(FM3,STD); EMITO(XIT); %A11526600 EMITB(BFW,T-4,L); %A11526700 EMITPAIR(FM3,SND); %A11526800 EMITV(FM2); GETCONTENTS(0,FALSE); %T9311526900 EMIT(0); EMITDIAL(DIA,46); EMITDIAL(DIB,1); %A11527000 EMITFC(FCE,2); %A11527100 EMITB(BBC,BUMPL,R); %A11527200 EMITPAIR(FM2,SND); %A11527300 EMITI(0,18,15); EMITO(XCH); %A11527400 EMITI(0,18,15); %A11527500 EMITO(MKS); EMITV(SYMEQ); EMITO(DEL); %A11527600 EMITB(BBC,BUMPL,R); %A11527700 EMITB(BBW,BUMPL,S); %A11527800 EMITB(BFW,T-2,L); %A11527900 EMITPAIR(FM3,SND); EMITV(FM2); %A11528000 GETCONTENTS(0,FALSE); EMITPAIR(FM2,SND); %A11528100 EMITL(1); EMITDIAL(DIA,46); %A11528200 EMITDIAL(DIB,1); EMITFC(FCE,2); %A11528300 EMITB(BBC,BUMPL,R); %A11528400 EMITI(0,3,30); EMITO(XCH); %A11528500 EMITI(0,3,30); EMITO(EQL); %A11528600 EMITB(BBC,BUMPL,R); %A11528700 EMITB(BBW,BUMPL,S); %A11528800 EMITB(BBW,T,R); %A11528900 END OF EMITSYMEQ; %A11529000 PROCEDURE EMITSYMEQA; %A11529100 BEGIN REAL T; %A11529200 EMIT(0); %A11529300 EMITV(FM3); EMITL(10); %A11529400 EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11529500 EMITFC(FCL,15); %A11529600 EMITPAIR(8,BFC); %A11529700 EMIT(0); EMITO(XCH); EMITO(CTC); %A11529800 EMITV(FM2); %A11529900 EMITO(EQL); EMITPAIR(FM3,STD); EMITO(XIT); %A11530000 GETCONTENTS(0,FALSE); %A11530100 EMITL(3); EMITDIAL(DIA,46); %A11530200 EMITDIAL(DIB,1); EMITFC(FCE,2); %A11530300 T ~ BUMPL; %A11530400 GETCONTENTS(0,FALSE); %A11530500 EMITV(FM2); EMITO(EQL); %A11530600 EMITPAIR(FM3,STD); EMITO(XIT); %A11530700 EMITB(BFC,T,L); %A11530800 EMIT(0); EMITPAIR(FM3,STD); %A11530900 EMITO(XIT); %A11531000 END OF EMITSYMEQA; %A11531100 PROCEDURE EMITSYMFIX; %A11531200 BEGIN REAL T; %A11531300 EMIT(0); %A11531400 EMITV(FM2); GETCONTENTS(1,FALSE); EMITO(DUP); %A11531500 EMITI(0,1,5); EMITO(DUP); %A11531600 EMITPAIR(NSTR,SND); EMIT(0); EMITO(XCH); %A11531700 EMITO(DUP); EMITL(7); %A11531800 EMITO(GTR); EMITPAIR(2,BFC); %A11531900 EMITO(DEL); %A11532000 EMITL(4); %A11532100 T ~ L; %A11532200 EMITO(MKS); EMIT(0); EMITN(OUTSTR); %A11532300 EMITO(ECM); STREAMTOG ~ TRUE; %A11532400 EMITC(4,CRF); EMITC(0,SFD); %A11532500 EMITC(6,SES); EMITC(1,SFS); %A11532600 EMITC(3,CRF); EMITC(0,TRS); %A11532700 EMITC(1,0); STREAMTOG ~ FALSE; %A11532800 EMITO(ADD); EMITO(DUP); EMITV(FP3); %A11532900 EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11533000 EMIT(0); EMITO(EQL); %A11533100 EMITPAIR(1,BFC); EMITO(XIT); %A11533200 EMITO(DUP); EMITL(7); %A11533300 EMITO(GTR); %A11533400 EMITPAIR(2,BFC); EMITO(DEL); EMITL(4); %A11533500 EMITV(FP2); GETCONTENTS(0,FALSE); EMITPAIR(FP2,STD); %A11533600 EMITB(BBW,BUMPL,T); %A11533700 % IN STACK: %A11533800 % FP1 0 %A11533900 % 6 FP2 ALPHA %A11534000 % 5 FP3 NUMBER OF CHARACTERS IN ATOMIC SYMBOL %A11534100 % 4 FP4 TOTAL NUMBER OF CHARACTERS TRANSFERRED %A11534200 % 3 FP5 NUMBER OF CHARACTERS TO TRANSFER %A11534300 END OF EMITSYMFIX; %A11534400 PROCEDURE EMITSYMPRINT; %A11534500 BEGIN REAL T,R,S; %A11534600 STACKCT ~ 1; %A11534700 EMIT(0); EMIT(0); %A11534800 EMITV(FM1); EMITO(CTC); %A11534900 EMITO(DUP); EMITL(64); %A11535000 EMITO(LSS); %A11535100 EMITPAIR(4,BFC); %A11535200 EMITO(MKS); EMITV(FP2); EMITV(CHARPRINT); EMITO(XIT); %A11535300 GETCONTENTS(0,FALSE); EMITO(DUP); %A11535400 EMITI(0,1,2); EMITO(DUP); EMITO(ADD); %A11535500 EMITO(BFW); %A11535600 T ~ L ~ L + 6; %A11535700 EMITO(MKS); EMITV(FP2); GETCONTENTS(0,FALSE); %A11535800 EMIT(0); %A11535900 EMITV(ARITHPRINT); EMITO(XIT); %A11536000 EMITB(BFW,T-2,L); EMITB(BFW,T-4,L); %A11536100 EMITO(MKS); EMITL("("); EMITV(CHARPRINT); %A11536200 EMITPAIR(3,BFW); %A11536300 S ~ L; %A11536400 EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11536500 EMITO(DUP); EMITI(0,1,2); EMITL(1); EMITO(EQL); %A11536600 EMITPAIR(7,BFC); %A11536700 EMITO(MKS); EMITV(FP2); EMITI(0,4,29); %A11536800 EMITV(ARITHPRINT); %A11536900 EMITPAIR(5,BFW); %A11537000 EMITO(MKS); EMITV(FP2); EMITI(0,18,15); %A11537100 EMITV(SYMPRINT); %A11537200 EMIT(0); EMITO(XCH); EMITO(CTC); %A11537300 EMITO(DUP); EMIT(0); EMITO(EQL); %A11537400 R ~ BUMPL; %A11537500 EMITO(MKS); EMITL(")"); EMITV(CHARPRINT); EMITO(XIT); %A11537600 EMITB(BFC,R,L); %A11537700 EMITO(DUP); %A11537800 GETCONTENTS(0,FALSE); EMITO(DUP); EMIT(0); %A11537900 EMITO(LSS); %A11538000 R ~ BUMPL; %A11538100 EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11538200 EMITO(MKS); EMITL("."); EMITV(CHARPRINT); %A11538300 EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11538400 EMITO(MKS); EMITV(FP2); EMITV(SYMPRINT); %A11538500 EMITO(MKS); EMITL(")"); EMITV(CHARPRINT); EMITO(XIT); %A11538600 EMITB(BFC,R,L); %A11538700 EMITO(XCH); EMITO(DEL); %A11538800 EMITB(BBW,BUMPL,S); %A11538900 EMITB(BFW,T,L); %A11539000 EMITO(MKS); EMITV(SYMFIX); %A11539100 EMITO(MKS); EMITL(1); EMITV(STRINGPRINT); %A11539200 EMITO(XIT); %A11539300 END OF EMITSYMPRINT; %A11539400 PROCEDURE EMITTERPRIN; %A11539500 BEGIN %A11539600 REAL T; %A11539700 EMIT(0); %A11539800 IF GPBV ! 0 THEN BEGIN EMITV(GPBV); %T9011540400 T ~ BUMPL; %A11540500 CALLRITE; EMITO(XIT); %A11540600 EMITB(BFC,T,L) END; %A11540700 EMITO(MKS); EMITV(RMARG); EMITV(CP); %A11540800 EMITO(SUB); EMITO(SSP); %A11540900 EMITV(SPACEPRINT); %A11541000 EMITO(XIT); %A11541100 END OF EMITTERPRIN; %A11541200 PROCEDURE EMITARSTV; %A11541300 BEGIN % THIS IS A CHAR MODE INTRINSIC %A11541400 STREAMTOG ~ TRUE; %A11541500 EMITC(1,CRF); EMITC(0,JFW); %A11541600 EMITC(4,SED); EMITC(4,SES); %A11541700 EMITC(8,OCV); EMITC(7,SEC); EMITC(4,SES); %A11541800 EMITC(1,SFS); EMITC(6,BNS); %A11541900 EMITC(0,TEQ); EMITC(3,JNC); %A11542000 EMITC(1,SFS); EMITC(63,INC); %A11542100 EMITC(0,ENS); EMITC(3,STC); %A11542200 EMITC(4,SED); EMITC(1,SFD); EMITC(3,CRF); %A11542300 EMITC(0,TRS); EMITC(0,0); %A11542400 STREAMTOG ~ FALSE %A11542500 END OF EMITARSTV; %A11542600 PROCEDURE EMITINT(N); VALUE N; REAL N; %A11542700 BEGIN %A11542800 CASE N OF BEGIN %A11542900 EMITADDPROP; %A11543000 EMITALFPRINT; %A11543100 EMITAPPEND; %A11543200 EMITARITHPRINT(FALSE); %A11543300 EMITATCON; %A11543400 EMITATN; %A11543500 EMITATSTRV; %A11543600 EMITBOOPRINT; %A11543700 EMITCHARPRINT; %A11543800 EMITCOLLECT; %A11543900 EMITDBLFACT; %A11544000 EMITDBLPLXFACT; %A11544100 EMITPLXPRINT(TRUE); %A11544200 EMITARITHPRINT(TRUE); %A11544300 EMITERRPRO; %A11544400 EMITGENLINK; %A11544500 EMITGENSYM; %A11544600 EMITLENGTH; %A11544700 EMITMARK; %A11544800 EMITMARKD; %A11544900 EMITMARKER; %A11545000 EMITMARKOB; %A11545100 EMITMEMBER; %A11545200 EMITMKATOM; %A11545300 EMITMONPRO; %A11545400 EMITMONSYM; %A11545500 EMITNCONC; %A11545600 EMITNTA; %A11545700 EMITNTS; %A11545800 EMITPLXFACT; %A11545900 EMITPLXPRINT(FALSE); %A11546000 EMITPROP; %A11546100 EMITRANDNO; %A11546200 EMITRANDOM; %A11546300 EMITREAD; %A11546400 EMITREAD1; %A11546500 EMITREADCON; %A11546600 EMITREADN; %A11546700 EMITREADSYM; %A11546800 EMITRECALL; %A11546900 EMITRECLAIMER; %A11547000 EMITRECLINK; %A11547100 EMITREMEMBER; %A11547200 EMITREMOB; %A11547300 EMITREMPROP; %A11547400 EMITRITE; %A11547500 EMITSCAN; %A11547600 EMITSPACEPRINT; %A11547700 EMITSTRINGPRINT; %A11547800 EMITSYMEQ; %A11547900 EMITSYMEQA; %A11548000 EMITSYMFIX; %A11548100 EMITSYMPRINT; %A11548200 EMITTERPRIN; %A11548300 EMITDACOM(TRUE); %A11548400 EMITDACOM(FALSE); %A11548500 END %A11548600 END OF EMITINT; %A11548700 ENDTOG ~ DEBUGTOG; DEBUGTOG ~ INTDEBUGTOG; %T9011548800 LO ~ L; %A11548900 MOVECODE(TEDOC,EDOC); %A11549000 FILL PA[*] WITH %A11549300 %A11549400 "7ADDPROP","5ALFPR00","6APPEND0", "7ARITHPR","5ATCON00", %A11549500 "3ATN0000","5ATSTR00","5BOOPR00","6CHARPR0","7COLLECT", %A11549600 "7DBLFACT","7DPXFACT","5DPXPR00","5DBLPR00","6ERRPRO0", %A11549700 "7GENLINK","6GENSYM0","6LENGTH0","4MARK000","5MARKD00", %A11549800 "6MARKER0","6MARKOB0","6MEMBER0","6MKATOM0","6MONPRO0", %A11549900 "6MONSYM0","5NCONC00","3NTA0000","3NTS0000","7PLXFACT", %A11550000 "5PLXPR00","4PROP000","6RANDNO0","6RANDOM0","5LREAD00", %A11550100 "5READ100","7READCON","5READN00","7READSYM","6RECALL0", %A11550200 "7TWXLOOP","7RECLINK","7REMEMBR","5REMOB00","7REMPROP", %P11550300 "6LWRITE0","4SCAN000","7SPACEPR","7STRINGP","6SYMEQL0", %A11550400 "7SYMEQLA","6SYMFIX0","5SYMPR00","6TERPRI0","7DACOM-I", %A11550500 "7DACOM-O","5ARSTV00"; %A11550600 FOR R~54 STEP 1 UNTIL 55,0 STEP 1 UNTIL 53 DO % %T9011550700 IF A ~ DPI[R+50] ! 0 THEN %A11550800 BEGIN %A11550900 L ~ 0; SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %A11551000 A ~ PROGDESCBLDR(1,0,A); %A11551100 EMITINT(R); LSTO ~ LISTOG; LISTOG ~ FALSE; %A11551200 SEGMENT((L+3) DIV 4,SGNO,2); LISTOG ~ LSTO; %A11551300 IF LISTOG THEN BEGIN %A11551400 WRTINTRSC(SGNO,PA[R],A,LIN); %A11551500 WRITELINE END; %A11551600 END; %A11551700 L~LO; SGNO ~ 2; MOVECODE(TEDOC,EDOC); %A11551800 IF DPI[106]!0 THEN BEGIN %A11551900 ADJUST; %A11552000 A ~ PROGDESCBLDR(3,L,104); %A11552100 EMITARSTV; %A11552200 IF LISTOG THEN BEGIN %A11552300 WRTINTRSC(2,PA[56],104,LIN); %A11552400 WRITELINE END; %A11552500 END; %A11552600 DEBUGTOG ~ ENDTOG; ENDTOG ~ FALSE; %TEMP %A11552700 END OF EMITNONX; %A11552800 PROCEDURE EMITDACOM (BV); VALUE BV; BOOLEAN BV; % %T9011552900 BEGIN % %T9011553000 REAL L0,L1,L2,L3,L4,L8,L9,M1,M2,M3,M4,GTS; % %T9011553100 REAL G1,G2 ; INTEGER TP;%T9011553150 DEFINE FP2=514#, FP3=515#, FP4=516#, FP5=517#; % %T9011553200 DEFINE WATE = IF DAC[16] { 0 THEN 300 ELSE MIN(DAC[16],1023)#;%T9011553250 PROCEDURE DACR(RD,B,A,GTS); VALUE RD,B,A,GTS; BOOLEAN RD; %T9011553300 REAL B,A,GTS; % %T9011553400 BEGIN % %T9011553500 BOOLEAN TP; TP := REAL(RD)>1; RD := RD AND TRUE; %T9011553550 EMITO(MKS); EMITPAIR(105,LOD); EMITL(5); % %T9011553600 EMITN(DAC[13-6|REAL(RD)]); IF RD THEN EMIT(4); %T9011553650 EMITN(2); EMITO(MOP); %T9011553700 EMITL(WATE); EMITPAIR(JUNK,ISN); %T9011553750 EMITO(CTF); IF RD THEN EMITO(LOR); %T9011553775 EMITL(IF RD THEN 2 ELSE 16-(15|REAL(TP))); EMIT(0); %T9011553800 EMITL(DAC[6] DIV 8); %T9011553850 EMITPAIR(IF RD THEN DAC[5] ELSE DAC[9],LOD); %T9011553900 %T9011553950 IF NOT RD THEN EMITO(MKS); EMITPAIR(A,MKS); % %T9011554000 EMITN(512); EMITV(513); EMITV(GTS); % %T9011554100 EMITPAIR(B,MKS); EMITN(512); EMITV(513); % %T9011554200 EMITV(GTS); % %T9011554300 IF NOT RD THEN BEGIN EMITL(15); EMITV(5); EMIT (0); EMIT (0); %T9011554400 END; % %T9011554500 EMIT (0); EMIT (0); EMIT (0); EMITV (12+REAL(RD)); % %T9011554600 END DACR; % %T9011554700 % %T9011554800 DEFINE LL1 = DAC[11] #, LL2 = DAC[17] #, LL3 = DAC[00] #; % %T9011554900 DEFINE LL4 = DAC[12] #, LL5 = DAC[18] #; % %T9011555000 DEFINE LL6 = DAC[19] #, LL7 = DAC[20] #, LL8 = DAC[21] #; %T9011555050 DEFINE BK(BK1) =EMITV(BLOCKCTR);EMITPAIR(1,BK1); % %T9011555100 EMITPAIR(BLOCKCTR,IF BK1 = ADD THEN SND ELSE STD) #; % %T9011555200 DEFINE J = DAC[3] #, GRP = DAC[4] #; % %T9011555300 DEFINE GOGO = EMITO(MKS);EMIT(0);EMITL(1);EMITV(GTS); % %T9011555400 EMITO(MKS);EMITL(9);EMITV(5);EMITO(BFW) #; % %T9011555500 GTS ~ GNAT(GOTOSOLVER); BK(ADD); % %T9011555600 IF BV THEN BEGIN % ***************** READ ******************* %T9011555700 LABEL SEGMENTR; % %T9011555750 EMIT (0); EMITPAIR(RMARGI,STD); EMITV(GRP); % %T9011555800 IF DAC[22] ! 0 THEN BEGIN EMITV(DAC[22]); EMITO(LOR); END; %T9011555850 M1 ~ BUMPL; % %T9011555900 %T9011555910 %T9011555920 %T9011555930 %T9011555940 EMIT (0); EMITPAIR(J,STD); % %T9011556000 L0 ~ M2 ~ L; % %T9011556100 DACR(TRUE,L1:=GETSPACE(TRUE,-7),L2:=GETSPACE(TRUE,-7),GTS); %T9311556200 M3 := L; %T9311556205 EMITL(DAC[6]); EMITO(MKS); %T9011556210 EMITL(DAC[6] DIV 64); % %T9011556220 EMITL((DAC[6] - 1) DIV 8); EMITN(DAC[5]); % %T9011556230 EMITO(ECM); STREAMTOG ~ TRUE; % %T9011556240 EMITC(1,RSA); EMITC(7,SFS); EMITC(4,RDA); % %T9011556250 EMITC(2,CRF); EMITC(9,BNS); % %T9011556260 EMITC(2,BNS); EMITC(32,BNS); % %T9011556270 EMITC(" ",TEQ); EMITC(12,JFC); % %T9011556280 EMITC(8,SRD); EMITC(1,SRS); EMITC(0,ENS); EMITC(0,ENS); % %T9011556290 EMITC(0,ENS); EMITC(4,CRF); EMITC(5,BNS); % %T9011556300 EMITC(" ", TEQ); EMITC(3,JNC); % %T9011556310 EMITC(8,SRD); EMITC(1,SRS); EMITC(0,ENS); % %T9011556320 EMITC(4,SDA); EMIT(64); STREAMTOG~FALSE; EMITO(DUP); EMITL(0);%T9011556330 EMITO(EQL); EMITO(ADD); EMITPAIR(RMARGI,STD); % %T9011556340 EMIT(0); EMITPAIR(DAC[2],STD); %T9011556350 BK(SUB); % %T9011556400 EMIT (0); EMITPAIR(GRP,SND); EMITO(RTN); % %T9011556500 EMITB(BFC,M1,L); BK(SUB); % %T9011556530 EMIT(4); EMITPAIR(GRP,SND); EMITO(RTN); % %T9011556560 ADJUST; L2 ~ PROGDESCBLDR(LDES,L,L2); % %T9011556600 IF TP ~ LL6 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE % %T9011556700 BEGIN EMITL(1); EMITERR(SGNO,L,"18"); END; % %T9011556800 ADJUST; L1 ~ PROGDESCBLDR(LDES,L,L1); % %T9011556900 EMITO(MKS); EMITPAIR(105,LOD); EMITL(5); % %T9011557000 EMITN(DAC[7]); EMIT(0); EMITL(2); EMIT(0); EMITL(1); % %T9011557100 EMITPAIR(DAC[9],LOD); EMIT(0); EMIT(0); EMIT(0); EMIT(0); %T9011557200 EMIT (0); EMITV(13); % %T9011557300 EMIT(0); EMITPAIR(TABR,STD); % %T9011557400 EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("BUFOV1 "); % %T9011557500 EMITO(ECM); STREAMTOG ~ TRUE; % %T9011557600 EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011557700 EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011557800 EMITC(4,STC); EMIT(64); STREAMTOG ~FALSE; G1 ~ BUMPL; % %T9011557900 IF TP ~ LL8 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN %T9011557950 EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %T9011558000 EMITC(26,TRP); EMIT("BU"); EMIT("FF"); EMIT("ER"); EMIT(" O");%T9011558100 EMIT("VE"); EMIT("RF"); EMIT("LO"); EMIT("W."); EMIT(" R"); % %T9011558200 EMIT("ET"); EMIT("YP"); EMIT("E."); EMIT("{!"); EMIT(64); % %T9011558300 STREAMTOG ~ FALSE; EMITL(26); EMITPAIR(NSTR,STD); % %T9011558400 EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011558500 EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN; % %T9011558600 END; % %T9011558650 EMITB(BFC,G1,L); % %T9011558700 EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("TOOLN2 "); % %T9011558800 EMITO(ECM); STREAMTOG ~ TRUE; % %T9011558900 EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011559000 EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011559100 EMITC(4,STC); EMIT(64); G1 ~ BUMPL; STREAMTOG ~ FALSE; % %T9011559200 IF TP ~ LL3 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011559300 %T9011559400 EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %T9011559500 EMITC(26,TRP); EMIT("IN"); EMIT("PU"); EMIT("T "); EMIT("TO");%T9011559510 EMIT("O "); EMIT("LO"); EMIT("NG"); EMIT(". "); EMIT("RE"); %T9011559520 EMIT("TY"); EMIT("PE"); EMIT(".{"); EMIT("!~"); EMIT(64); % %T9011559530 STREAMTOG ~ FALSE; EMITL(26); EMITPAIR(NSTR,STD); % %T9011559540 EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011559550 EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN ; % %T9011559560 END; % %T9011559600 %T9011559610 %T9011559620 %T9011559630 %T9011559640 %T9011559650 %T9011559660 CONSTANTCLEAN; EMITB(BFC,G1,L); % %T9011559700 EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("TIME3 "); % %T9011559800 EMITO(ECM); STREAMTOG ~ TRUE; % %T9011559900 EMITC(2,RSA); EMITC(3,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011560000 EMITC(5,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011560100 %T9011560110 %T9011560120 %T9011560130 %T9011560140 %T9011560145 EMITC(4,STC); EMIT(64); STREAMTOG ~ FALSE; G1 ~ BUMPL; % %T9011560150 %T9011560160 %T9011560170 %T9011560180 %T9011560190 IF TP ~ LL2 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011560200 %T9011560210 %T9011560220 %T9011560230 %T9011560240 EMITL(1); EMITERR(SGNO,L,"16") END; CONSTANTCLEAN; % %T9011560250 %T9011560260 %T9011560270 EMITB(BFC,G1,L); % %T9011560300 EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("WRTAB4 "); % %T9011560350 EMITO(ECM); STREAMTOG ~ TRUE; % %T9011560400 EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011560450 EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011560500 EMITC(4,STC); EMIT(64); STREAMTOG ~ FALSE; G1 ~ BUMPL; % %T9011560550 IF TP ~ LL5 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011560600 EMITL(1); EMITERR(SGNO,L,"17") END; CONSTANTCLEAN; % %T9011560650 EMITB(BFC,G1,L); % %T9011560700 IF TP ~ LL7 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN %T9011560725 EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); % %T9011560750 STREAMTOG ~ TRUE; EMITC(22,TRP); EMIT("PA"); EMIT("RI"); % %T9011560800 EMIT("TY"); EMIT(" E"); EMIT("RR"); EMIT("OR"); EMIT(". "); % %T9011560850 EMIT("RE"); EMIT("TY"); EMIT("PE"); EMIT("{!"); EMIT(64); % %T9011560900 STREAMTOG ~ FALSE; EMITL(22); EMITPAIR(NSTR,STD); % %T9011560950 EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011561000 EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN; % %T9011561050 END; % %T9011561100 %T9011561200 %T9011561300 %T9011561400 %T9011561500 %T9011561600 %T9011561700 %T9011561800 %T9011561900 END ELSE BEGIN % ******************* WRITE ****************** %T9011562000 LABEL SEGMENTR; % %T9011562006 EMITV(TABR); EMITL(DAC[15]); EMITO(GTR); EMITPAIR(3,BFC); %T9011562008 EMITL(DAC[15]); EMITPAIR(TABR,STD); %T9011562009 %T9011562010 EMITO(MKS); EMITPAIR(DAC[9],LOD); EMITO(ECM); STREAMTOG ~TRUE;%T9011562011 EMITC(8,TRP); EMIT(" "); EMIT(" "); EMIT(" "); EMIT(" "); %T9011562012 EMITC(1,RSA); EMITC(16,TRW); EMIT(64); STREAMTOG ~ FALSE; %T9011562013 %T9311562014 %T9011562015 EMITV(DAC[2]); G1~BUMPL; %T9011562016 DACR(BOOLEAN(2),L3:=GETSPACE(TRUE,-7),L4:=GETSPACE(TRUE,-7),GTS); 11562018 EMITB(BFC,G1,L); EMIT(4); EMITPAIR(DAC[2],STD); %T9011562020 EMITO(MKS); EMITV(TABR); EMITPAIR(DAC[14],LOD); %T9011562021 EMITPAIR(DAC[9],LOD); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %Y9011562023 EMITC(4,SES); EMITC(1,SED); EMITC(6,SFS); EMITC(7,SFD); %T9011562024 EMITC(1,TRS); EMITC(3,RSA); EMITC(2,RDA); EMITC(1,CRF); %T9011562025 EMITC(4,BNS); EMITC(32,TRS); EMITC(32,TRS); EMITC(0,ENS); %T9011562026 EMITC(4,TRS); EMIT(64); STREAMTOG ~ FALSE; %T9011562027 DACR(FALSE,L3,L4,GTS); %T9011562029 EMITV(LMARG); EMITPAIR(CP,STD); BK(SUB); EMITO(XIT); % %T9011562030 IF TP ~ LL1 ! 0 THEN BEGIN % %T9011562035 ADJUST; L3 ~ PROGDESCBLDR(LDES,L,L3); % %T9011562040 EMIT(0); EMITPAIR(RMARGI,STD); EMIT(4); EMITPAIR(GRP,STD); % %T9011562060 EMITL(TP); GOGO END; %T9011562070 IF TP ~ LL4 ! 0 THEN BEGIN % %T9011562073 ADJUST; L4 ~ PROGDESCBLDR(LDES,L,L4); % %T9011562075 EMITL(TP); GOGO END; % %T9011562078 IF LL1 = 0 THEN BEGIN ADJUST; L3 ~ PROGDESCBLDR(LDES,L,L3); % %T9011562080 EMIT(4); EMITERR(SGNO,L,"19"); END; %T9011562085 IF LL4 = 0 THEN BEGIN ADJUST; L4 ~ PROGDESCBLDR(LDES,L,L4); % %T9011562090 EMIT(4); EMITERR(SGNO,L," 9"); END; %T9011562095 %T9011562100 END; % WRITE %T9011562200 END EMITDACOM; % %T9011562300 %T9011562400 %T9011562500 %T9011562600 %T9011562700 %T9011562800 %T9011562900 %T9011563000 %T9011563100 %T9011563200 %T9011563300 %T9011563400 %T9011563500 %T9011563600 %T9011563700 %T9011563800 %T9011563900 %T9011563950 %T9011564000 %T9011564100 PROCEDURE SFHEAD; %A11564200 BEGIN REAL R,S,T; %A11564300 DO BEGIN QUOTETOG ~ TRUE; %A11564350 IF STEPI = QUOTEOP OR ELCLASS = LITNO OR ELCLASS = 0 THEN %A11564400 R ~ SFTERM(BOOLEAN(2)) ELSE %A11564500 BEGIN QUOTETOG ~ FALSE; %A11564600 IF ELBAT[I].LVL ! 1 THEN FLAG(663); %A11564700 R ~ ELBAT[I].ADDRESS; %A11564800 IF ELCLASS = BOOID THEN SFTRC.[15:11] ~ R ELSE %A11564900 IF ELCLASS = REALID OR ELCLASS = INTID THEN BEGIN %A11565000 IF SFTRC.[26:11] ! 0 THEN FLAG(664); %A11565100 SFTRC.[26:11] ~ R END ELSE %A11565200 IF ELCLASS = PROCID THEN BEGIN %A11565300 IF T ~ TAKE(S~GIT(ELBAT[I])).[40:8] = 0 THEN BEGIN %A11565400 IF SFTRC.[37:11] ! 0 THEN FLAG(665); %A11565500 SFTRC.[37:11] ~ R END ELSE %A11565600 IF T ! 1 OR TAKE(S+1).CLASS ! REALID THEN FLAG(666) %A11565700 ELSE SFTRC.[4:11] ~ R END ELSE %A11565800 FLAG(667); %A11565900 STEPIT %A11566000 END %A11566100 END UNTIL ELCLASS ! COMMA; %A11566200 END OF SFHEAD; %A11566300 % %A11566400 REAL PROCEDURE SFTERM(BV); VALUE BV; BOOLEAN BV; %A11566500 BEGIN LABEL START,EXIT; %A11566600 REAL R,S,FIRST,LAST; %A11566700 BOOLEAN EQTOG,FST,CONSEQ; %A11566800 STREAM PROCEDURE PUT(A,B); VALUE B; %A11566900 BEGIN DI ~ A; SI ~ LOC B; DS ~ 5 DEC; DS ~ LIT "#" END; %A11567000 FORMAT OUT DCA("DCA ",I4), %A11567100 RANGE("RANGE ",I4," TO ",I4); %A11567200 FST ~ CONSEQ ~ TRUE; %A11567300 START: %A11567400 IF ELCLASS = LITNO THEN BEGIN SFPL ~ C; STEPIT END ELSE %A11567500 IF ELCLASS = QUOTEOP THEN BEGIN %A11567600 IF (R~ LNK[(S~GENQUOTE(FALSE)).[33:6],S.[39:9]]).[1:2] !2 %A11567700 AND S > 63 THEN FLAG(668); %A11567800 IF R ~ R.[33:15] ! 0 THEN SFPL ~ R ELSE %A11567900 BEGIN %A11568000 IF NOT EQTOG THEN SFPL ~ SFPL + 1; %A11568100 LNK[S.[33:6],S.[39:9]].[33:15] ~ SFPL; %A11568200 IF NOT BV.[46:1] THEN %A11568300 IF LISTOG THEN WRITE(LINE,DCA,SFPL) %A11568400 END END ELSE %A11568500 IF ELCLASS = 0 AND LEVEL = 1 AND BV.[46:1] THEN BEGIN %A11568600 IF NOT EQTOG THEN SFPL ~ SFPL + 1; %A11568700 ACCUM[0] ~ ELBAT[I] & DEFINEDID[2:41:7] & NEXTTEXT[11:32:16]; %T9211568750 E; %T9211568800 PUT(TEXT[NEXTTEXT.LINKR,NEXTTEXT.LINKC],SFPL); %T9211568900 NEXTTEXT ~ NEXTTEXT + 1; STEPIT END ELSE %T9211569000 BEGIN ERR(669); GO EXIT END; %A11569100 IF FST THEN BEGIN FIRST ~ LAST ~ SFPL; FST ~ FALSE END ELSE %A11569200 BEGIN %A11569300 IF SFPL < LAST THEN FLAG(670); %A11569400 IF NOT EQTOG THEN CONSEQ ~ CONSEQ AND LAST + 1 = SFPL; %A11569500 LAST ~ SFPL %A11569600 END; %A11569700 IF ELCLASS = FACTOP OR EQTOG ~ ELCLASS = RELOP THEN %A11569800 BEGIN STEPIT; GO START END; %A11569900 IF BV THEN SFTERM ~ FIRST & LAST [18:33:15] %A11570000 & REAL(CONSEQ) [1:47:1] ELSE %A11570100 SFTERM ~ FIRST; %A11570200 IF BV.[46:1] THEN %A11570300 IF LISTOG THEN WRITE(LINE,RANGE,FIRST,LAST); %A11570400 EXIT: QUOTETOG ~ FALSE; %A11570500 END OF SFTERM; %A11570600 % %A11570700 PROCEDURE SFEXP(TOP,FT,BL); VALUE TOP,FT,BL; %A11570800 BOOLEAN TOP,FT; REAL BL; %A11570900 BEGIN LABEL EXIT,START,LS,L2,L3,L1; %A11571000 LABEL L4; %A11571050 BOOLEAN GNF,FST,SW,SFO,B; %A11571100 REAL TB,BLL,LF,R,S,T,P,CT,A,TC; %A11571200 ARRAY SWA[0:127]; %A11571300 DEFINE GETNEXT = EMITO(MKS); EMITV(SFTRC.[37:11])#, %A11571400 GNFT = IF GNF THEN BEGIN GNF ~ FALSE; GETNEXT END#; %A11571500 SFO ~ SYMFORMAT; SYMFORMAT ~ FST ~ TRUE; LF ~ LFINAL; LFINAL~0; %A11571600 IF SFTRC.[37:11] = 0 OR SFTRC.[26:11] = 0 THEN FLAG(671); %A11571700 TB ~ 4095; ADJUST; BLL ~ L; %A11571800 IF TOP THEN BEGIN %A11571900 HOLDFR ~ 4095; BL ~ BLL; %A11572000 IF ELCLASS ! LFTBRKET THEN BEGIN ERR(672); GO EXIT END END; %A11572100 QUOTETOG ~ TRUE; %A11572200 IF SW~STEPI=DECLARATORS AND ELBAT[I].ADDRESS = SWITCHV THEN %A11572300 BEGIN STEPIT; T ~ BUMPL; CONSTANTCLEAN END; %A11572400 START: %A11572500 IF ELCLASS = LITNO OR ELCLASS = QUOTEOP THEN BEGIN %A11572600 QUOTETOG ~ TRUE; GNFT; R ~ SFTERM(TRUE); %A11572700 IF B ~ FST AND SW THEN BEGIN %A11572800 IF R > 0 THEN FLAG(673); %A11572900 FST ~ FALSE; %A11572950 IF CT = 0 THEN A ~ R.[33:15] ELSE %A11573000 IF P + 1 ! R.[33:15] THEN FLAG(673); %A11573100 R ~ (P ~ R.[18:15]) - R.[33:15]; ADJUST; %A11573200 IF CT+R>127 OR R < 0 THEN BEGIN FLAG(674);R~CT~0 END; %A11573300 DO SWA[CT~CT+1] ~ L UNTIL R ~ R - 1 < 0 END; %A11573400 IF GNF ~ ELCLASS = COLON THEN STEPIT ; %A11573500 IF NOT B THEN BEGIN %A11573600 EMITV(SFTRC.[26:11]); EMITL(S~R.[33:15]); %A11573700 IF S = R ~ R.[18:15] THEN EMITO(EQL) ELSE %A11573800 BEGIN EMITO(GEQ); EMITV(SFTRC.[26:11]); EMITL(R); %A11573900 EMITO(LEQ); EMITO(LND) END; %A11574000 L4: %A11574050 IF B ~ GNF AND(ELCLASS= LITNO OR ELCLASS = FACTOP) THEN %A11574100 BEGIN EMITO(LNG); R ~ BUMPL; %A11574200 IF ELCLASS = LITNO THEN BEGIN %A11574300 IF SFTRC.[4:11] = 0 THEN FLAG(675); %A11574400 EMITO(MKS); EMITL(C); EMITV(SFTRC.[4:11]); %A11574500 STEPIT END ELSE %A11574600 BEGIN STEPIT; STMT END; %A11574700 EMIT(0); %A11574800 END; %A11574900 IF FST THEN BEGIN LFINAL ~ BUMPL; FST ~ FALSE END ELSE %A11575000 BEGIN EMIT(HOLDFR); HOLDFR ~ L ~ L + 1 END; %A11575100 IF B THEN BEGIN EMITB(BFC,R,L); %A11575200 IF ELCLASS = SEMICOLON THEN BEGIN %A11575300 LS: QUOTETOG ~ TRUE; STEPIT; GO START END END END; %A11575400 IF NOT GNF THEN BEGIN %A11575500 IF ELCLASS = COMMA THEN BEGIN GETNEXT ; GO LS END; %A11575600 GNF ~ TRUE END; %A11575700 GO TO L2 END; %A11575800 IF FST AND SW THEN BEGIN ERR(676); GO EXIT END; %A11575900 IF ELCLASS=LABELID THEN BEGIN GNFT; LABELR; GO START END; %A11575950 QUOTETOG ~ FALSE; %A11576000 IF ELCLASS = FACTOP THEN BEGIN GNFT; %A11576100 IF STEPI = TRUTHV THEN BEGIN %A11576200 B ~ BOOLEAN(ELBAT[I].[26:1]); STEPIT; %A11576300 IF FST THEN BEGIN FST ~ FALSE; %A11576400 IF NOT B THEN BEGIN EMIT(0);LFINAL ~ BUMPL END %A11576500 END ELSE %A11576600 IF NOT B THEN BEGIN EMIT(0); EMIT(HOLDFR); %A11576700 HOLDFR ~ L ~ L + 1 END END ELSE %A11576710 BEGIN BEXP; %A11576720 IF FST THEN BEGIN EMITO(DUP); EMIT(0); EMITO(NEQ); %A11576800 LFINAL ~ BUMPL; FST ~ FALSE END; %A11576900 EMIT(HOLDFR); HOLDFR ~ L ~ L + 1; %A11577000 END; %A11577010 L1: IF ELCLASS = COMMA THEN GO LS ELSE GO L2 %A11577100 END; %A11577200 IF ELCLASS = LFTBRKET THEN BEGIN GNFT; %A11577300 SFEXP(FALSE,FST,BL); FST ~ FALSE; GO L1 END; %A11577400 IF ELCLASS=PERIOD OR ELCLASS=DOTOP THEN BEGIN GNFT; %A11577500 IF STEPI!REALID AND ELCLASS!INTID THEN BEGIN ERR(730); %A11577510 GO EXIT END; CHECKER(ELBAT[I]); EMITV(ELBAT[I].ADDRESS); %A11577520 EMITV(SFTRC.[26:11]); EMITO(EQL); STEPIT; GO L4 END; %A11577530 L2: IF ELCLASS = MULOP OR ELCLASS = ELSEV THEN BEGIN %A11577600 GNFT; EMIT(TB); TB ~ L ~ L + 1; %A11577700 IF FST THEN FLAG(677); CONSTANTCLEAN; %A11577800 QUOTETOG ~ FST ~ TRUE; ADJUST; STEPIT; %A11577900 IF LFINAL ! 0 THEN BEGIN EMITB(BFC,LFINAL,L); %A11578000 LFINAL ~ 0 END; %A11578100 GO START END; %A11578200 IF ELCLASS = RTBRKET THEN BEGIN STEPIT; %A11578300 GNFT; %A11578350 IF SW THEN BEGIN EMIT(TB); TB ~ L ~ L + 1; CONSTANTCLEAN; %A11578400 ADJUST; EMITB(BFW,T,L);EMITV(SFTRC.[26:11]); %A11578500 EMITO(DUP); EMITL(A); EMITO(GEQ); EMITO(XCH); %A11578600 EMITL(P); EMITO(LEQ); EMITO(LND); LFINAL ~ BUMPL; %A11578700 EMITV(SFTRC.[26:11]); EMITL(A); EMITO(SUB); %A11578800 EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11578900 IF P-A+1!CT THEN FLAG(673); % TEMP %A11579000 FOR T ~ 1 STEP 1 UNTIL CT DO EMITB(BBW,BUMPL,SWA[T]); %A11579100 END; %A11579200 IF NOT FT THEN BEGIN %A11579300 IF LFINAL ! 0 THEN BEGIN T ~ L; L ~ LFINAL - 2; %A11579400 EMIT(HOLDFR); HOLDFR ~ LFINAL; L ~ T END; %A11579500 LFINAL ~ LF END; %A11579600 IF NOT SFO THEN BEGIN %A11579700 IF ELCLASS = COLON THEN STEPIT; %A11579800 IF ELCLASS ! LABELID OR NOT LOCAL(S~ELBAT[I]) THEN %A11579900 BEGIN ERR(678); GO EXIT END; %A11580000 STEPIT END; %A11580100 ADJUST; %A11580200 IF ERRORCOUNT = 0 THEN %A11580300 BEGIN %A11580325 IF TB = L THEN %A11580330 BEGIN %A11580335 TB ~ GET (L ~ L - 2); %A11580340 EMITO(NOP); EMITO(NOP); %A11580345 END; %A11580350 WHILE TB ! 4095 DO %A11580375 BEGIN %A11580400 T ~ GET (TB - 2); %A11580425 EMITB(BFW,TB,L); %A11580450 TB ~ T; %A11580475 END; %A11580500 END; %A11580550 IF B ~ TOP AND SFO THEN BEGIN EMITL(1); %A11580600 T ~ BUMPL; ADJUST END; %A11580700 IF TOP THEN BEGIN CT ~ L; %A11580800 IF ERRORCOUNT =0 THEN WHILE HOLDFR ! 4095 DO BEGIN %A11580900 R ~ GET(P ~ HOLDFR - 2); %A11581000 IF SFO THEN EMITB(BFC,HOLDFR,CT) ELSE %A11581100 BEGIN L ~ P; GOGEN(S,BFC) END; %A11581200 HOLDFR ~ R END; %A11581300 IF SFO THEN BEGIN EMITL(2); %A11581400 IF LFINAL ! 0 THEN BEGIN P ~ BUMPL; %A11581500 ADJUST; EMITB(BFC,LFINAL,L); EMIT(0); %A11581600 EMITB(BFW,P,L) END; %A11581700 EMITB(BFW,T,L); EMITPAIR(514,STD); END ELSE %A11581800 BEGIN %A11581900 IF LFINAL ! 0 THEN BEGIN L ~ LFINAL - 2; %A11582000 GOGEN(S,BFC) END; L ~ CT; %A11582100 END END; %A11582200 GO EXIT END; %A11582300 IF ELCLASS = NILV THEN BEGIN FST ~ FALSE; GNFT; %A11582310 STEPIT; GO L1 END; %A11582320 IF ACCUM[1] = "6RETUR" THEN BEGIN GNFT; STEPIT; %A11582400 % %A11582500 IF B ~ ACCUM[1] = "5START" THEN STEPIT; %A11582600 IF GNF ~ ELCLASS =UNTILV THEN BEGIN STEPIT; BEXP END; %A11582700 EMITB(IF GNF THEN BBC ELSE BBW,BUMPL,IF B THEN BL ELSE BLL); %A11582800 GNF ~ FALSE; %A11582900 L3: IF ELCLASS = SEMICOLON THEN GO LS ELSE GO L2 END; %A11583000 SYMFORMAT ~ FALSE; TC ~ ERRORCOUNT; STMT; %A11583100 IF TC ! ERRORCOUNT THEN GO EXIT; %A11583200 SYMFORMAT ~ TRUE; %A11583300 IF ELCLASS = SEMICOLON THEN GO LS; %A11583310 IF ELCLASS = ELSEV THEN GO L2; FLAG(119); %A11583320 EXIT: SYMFORMAT ~ SFO; %A11583400 END OF SFEXP; %A11583500 % REMOVE %M12000000 % REMOVE %M12001000 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){0 THEN 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 ELCLASSIDMAX AND ELCLASS{FACTOP 13337000 THEN FLAG(003); 13338000 IF ELCLASS!DEFINEDID THEN % CHECK FOR DUP. DECLS. 13339000 IF LEVELF=LEVEL THEN FLAG(1); % DECL. TWICE IN BLOCK. 13340000 VONF~P2; 13341000 IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000 THEN ADDRSF ~ PJ ~PJ+1 13343000 ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000 ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000 IF TYPE{INTARRAYID AND TYPE } STRINGARRAYID %M13346000 THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000 EMITL(ADDRSF); EMITN(10); 13347500 END 13347510 ELSE CHECKDISJOINT(ADDRSF); 13347520 END; 13348000 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 XREFINFO[NEXTINFO.LINKR,NEXTINFO.LINKC] ~ XREFINFO[LINKT.LINKR, 13366100 LINKT.LINKC]; 13366102 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 (COMPUTE 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 INTEGER T5; %M13450500 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 13457000 P2~TRUE;IF SPECTOG THEN 13458000 FLAG(013)13459000 END 13460000 ELSE 13461000 IF T1= SAVEV THEN 13462000 BEGIN 13463000 P3~TRUE; 13464000 IF SPECTOG THEN 13465000 FLAG(014) 13466000 END 13467000 ELSE 13468000 IF T1 >FIELDV THEN BEGIN TYPEV ~ RECARRAYID; RECTYPE ~ T1 END ELSE%M13469000 IF T1=COMPLEXV THEN BEGIN TYPEV ~ DBLPLXARRAYID; %M13469100 IF GTA1[J-1]=DOUBLEV THEN BEGIN J~J-1; NEWPART ~ 2 END ELSE %M13469200 NEWPART ~ 1 END ELSE %M13469300 IF TYPEV ~ REALID+T1 >INTARRAYID OR TYPEV < STRINGARRAYID %M13469400 THEN BEGIN FLAG(000); TYPEV ~ REALARRAYID END; %M13469500 T5~ IF TYPEV = DBLPLXARRAYID THEN REAL(NEWPART=2)|2+2 ELSE 0; %M13469600 IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000 MARKSYM ~ TYPEV=SYMARRAYID AND RECLAIMTOG; %M13470500 ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000 BETA1: 13472000 MARKSYM ~ FALSE; %M13472500 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 ARPROGS~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 EMITO(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=0) 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 T5!0 THEN BEGIN %M13549050 IF SPECTOG THEN BEGIN %M13549060 IF T2>0 THEN BEGIN %M13549070 IF T ~ T2.[36:10]|T5 >1023 THEN FLAG(600); %M13549080 PUT(T2&T[36:38:10],NEXTINFO-1) %M13549090 END END ELSE %M13549100 BEGIN %M13549110 IF T2.[46:2]=0 THEN BEGIN %M13549120 IF T ~ T2.[36:10]|T5 {1023 THEN T2.[36:10] ~ T ELSE %M13549130 BEGIN EMITNUM(IF T2.[23:10]= ADD THEN -T ELSE T); %M13549140 EMITPAIR(T2:=GETSPACE(P2,-1),ISD); T2:=T2|4+SUBC+2; %T9313549150 END; PUT(T2,NEXTINFO-1) END ELSE %M13549160 BEGIN EMITV(T2.[35:11]); EMITL(T5); EMITO(MUL); %M13549170 EMITPAIR(T2.[35:11],ISD) END; %M13549180 IF P2 THEN BEGIN EMITO(XCH); EMITL(T5); EMITO(MUL); %M13549190 EMITO(XCH) END; %M13549200 EMITL(T5);EMITO(MUL) %M13549210 END END; %M13549220 IF NOT SPECTOG THEN 13550000 BEGIN 13551000 COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400 NOOFARRAYS~NOOFARRAYS + GTA1[0]; 13551500 IF TYPEV= STRINGARRAYID THEN BEGIN %M13552000 T ~ NEXTINFO ~ NEXTINFO+1; %M13552100 IF K ~ GETSTRINGLENGTH(IF GTA1[0]=1 THEN SAVEINFO ELSE 0,0) %M13552200 > 8 THEN %M13552250 BEGIN IF P2 THEN EMITL(0); EMITL(T5 ~(K+7)DIV 8); %M13552300 EMITL(LBJ+1) END ELSE EMITL(LBJ); %M13552400 PUT(K,T-1) END ELSE EMITL(LBJ); EMITL(GTA1[0]); %M13552500 EMITL(REAL(P3) +2|REAL(P2)); 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 MARKSYM ~ TYPEV=SYMARRAYID AND RECLAIMTOG; %M13566500 I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO~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; NEWPART~RECTYPE ~ 0 END; %M13588000 PROCEDURE PUTNBUMP(X); 13589000 VALUE X; 13590000 REAL X; 13591000 BEGIN 13592000 INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000 NEXTINFO~NEXTINFO+1 13594000 END ; 13595000 PROCEDURE JUMPCHKX; 13596000 COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000 WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000 ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000 IS THE FIRST EXECUTABLE CODE; 13600000 IF NOT SPECTOG THEN 13601000 BEGIN 13602000 IF AJUMP 13603000 THEN 13604000 BEGIN ADJUST; 13605000 EMITB(BFW,SAVEL,L) 13606000 END ELSE 13607000 IF FIRSTX=4095 13608000 THEN 13609000 BEGIN 13610000 ADJUST; 13611000 FIRSTX~L; 13612000 END; 13613000 AJUMP~FALSE 13614000 END; 13615000 PROCEDURE JUMPCHKNX; 13616000 COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000 EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000 NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED 13619000 AND SAVED FOR A LATER BRANCH; 13620000 IF NOT SPECTOG THEN 13621000 BEGIN 13622000 IF FIRSTX!4095 13623000 THEN 13624000 BEGIN 13625000 IF NOT AJUMP 13626000 THEN 13627000 SAVEL~BUMPL; 13628000 AJUMP~TRUE 13629000 END;ADJUST 13630000 END; 13631000 PROCEDURE SEGMENTSTART; 13632000 IF LISTOG AND PRTOG THEN % %T0313633000 IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 PROCEDURE SEGMENT(SIZE,NO,NOO); 13657000 VALUE SIZE,NO,NOO; 13658000 REAL SIZE,NO,NOO; 13659000 BEGIN 13660000 STREAM PROCEDURE MOVE2(S,D); BEGIN SI~S; DI~D; DS~2 WDS; END; 13674000 13675000 13676000 INTEGER T,NSEGS,J,CNTR; 13677000 DEFINE POINTER = NO.[38:3], NO.[41:7]#; 13677100 NSEGS~(ABS(SIZE)+29) DIV 30; 13678000 IF DA DIV CHUNKSEGSIZEMAX THEN SEGSIZEMAX~SIZE; 13682000 AKKUM~AKKUM+SIZE; 13683000 IF SAVEPRTOG THEN AUXMEMREQ := AUXMEMREQ+16|(SIZE. [38:6]+1); 13683010 IF LISTOG AND PRTOG THEN % %T0313684000 IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) 13684100 ELSE WRITE(LINE[DBL],PRINTSIZE,NO,SIZE,NOO); 13684200 13685000 13686000 13687000 13688000 CNTR~0; 13689000 DO BEGIN 13690000 FOR J~0 STEP 2 WHILE J<30 AND CNTRMAXSTACK THEN MAXSTACK~STACKCTR; 13748000 CONSTANTCLEAN; 13749000 IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 13750000 OR FAULTOG.[46:1] % %D0113750010 THEN 13751000 BEGIN ADJUST;LS~L; 13752000 IF BT OR GOTSTORAGE OR FAULTOG.[46:1] % %D0113753000 THEN 13754000 BEGIN % %D0113755000 % 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;SEGMENTSTART; 13780000 SGNO~SGAVL; 13781000 GT4 := LL; LL := 0; % %W4013782000 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(36); 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);ELCLASS~"(";13791000 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 LL := GT4; % %W4013813500 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 %B0213819400 THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; %B0213819410 COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 ARRAY 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 GT17 THEN FLAG(601); %M14116000 G ~ G & GT1[32:45:3] & INC[27:43:5]; %M14116100 IF FWDTOG THEN %M14116150 BEGIN 14116200 IF(GT1~TAKE(MARK+PJ)).CLASS ! G.CLASS 14116300 COMMENT CLASS ERROR; THEN FLAG(49); 14116400 IF TC=3 OR TC=1 THEN BEGIN IF GT1.[27:5]!INC THEN FLAG(49) END; %M14116450 COMMENT VALUE ERROR; IF GT1.VO ! G.VO THEN FLAG(50) 14116500 END ELSE 14116600 PUT(G,MARK+PJ) 14117000 ;BUP~BUP-TAKE(BUP+1).PURPT 14118000 END 14119000 UNTIL PJ ~ PJ - 1 = 0; %M14120000 IF PROINFO.CLASS=STRINGPROCID OR %M14120250 PROINFO.CLASS=DBLPLXPROCID THEN %M14120500 PUT(TAKE(MARK)&(F+2)[30:38:10],MARK); %M14120600 END; 14121000 SPECTOG~FALSE; 14122000 GO TO HF 14123000 END 14124000 END; 14125000 STACKCT ~ 0; %A 14125500 WHILE STEPI = DECLARATORS AND DECLCHECK %M14126000 DO 14127000 BEGIN 14128000 STOPDEFINE~(GTA1[J~J+1]~ELBAT[I].ADDRESS)!MONITORV AND 14129000 GTA1[J]!DUMPV;ERRORTOG~TRUE; 14130000 END; 14131000 IF J =0 THEN GO TO CALLSTATEMENT; 14132000 P2~P3~FALSE; 14133000 IF GTA1[J] < 30 THEN GO TO DECLSW[GTA1[J]]; %M14134000 P3 ~ TRUE; RECTYPE ~ GTA1[J]; ENTER(RECID); RECTYPE ~0; GO TO START; %M14134500 OWNERR:FLAG(20);J~J+1;GO TO REALDEC; 14135000 SAVERR:FLAG(21);J~J+1;GO TO REALDEC; 14136000 STREAMERR:FLAG(22);J~J+1;GO TO PROCEDUREDEC; 14137000 REALDEC:P3~TRUE;ENTER(REALID);GO TO START; 14138000 ALPHADEC:P3~TRUE;ENTER(ALFAID);GO TO START; 14139000 DOUBLEDEC: MOREWORDS ~ 1; P3 ~ TRUE; ENTER(DBLPLXID); %M14139100 MOREWORDS ~ 0; GO TO START; %M14139150 COMPLEXDEC: MOREWORDS ~ 1;P3 ~ TRUE; NEWPART ~1; %M14139200 IF GTA1[J-1]=DOUBLEV THEN BEGIN J ~ J - 1; MOREWORDS ~ 3; %M14139250 NEWPART ~ 2 END; ENTER(DBLPLXID); %M14139300 MOREWORDS ~ NEWPART ~ 0; GO TO START; %M14139350 SYMDEC: P3 ~ TRUE; MARKSYM ~ RECLAIMTOG; ENTER(SYMID); %M14139400 MARKSYM ~ FALSE; GO TO START; %M14139450 FIELDEC: FIELDGEN; GO TO START; %M14139500 RECORDEC: RECORDGEN; GO TO GOTSCHK; %M14139550 STRINGDEC: IF STRINGEN THEN GO TO GOTSCHK ELSE GO TO START; %M14139600 BOOLEANDEC:P3~TRUE;ENTER(BOOID);GO TO START; 14140000 INTEGERDEC:P3~TRUE;ENTER(INTID);GO TO START; 14141000 MONITORDEC:IF SPECTOG 14142000 THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR 14143000 DECLARATION APPEARS IN THE SPECIFICATION 14144000 PART OF A PROCEDURE; 14145000 FLAG(463); 14146000 END; 14147000 IF GTA1[J-1] =SYMV THEN SYMAC ELSE %M14147500 IF MERRIMAC THEN BEGIN FAULTDEC; GO GOTSCHK END; GO START;14148000 DUMPDEC:IF SPECTOG 14149000 THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION 14150000 APPEARS IN THE SPECIFICATION PART OF A 14151000 PROCEDURE; 14152000 FLAG(464); 14153000 END; 14154000 DMUP; GO TO START; 14155000 ARRAYDEC:JUMPCHKX;ARRAE;GO TO GOTSCHK; 14156000 FILEDEC:J~J+1;IODEC(11);GO TO GOTSCHK; 14157000 INDEC: IODEC(9); IF G!FORMATV THEN GO GOTSCHK; GO START; %D14158000 OUTDEC: IODEC(10); IF G=FORMATV THEN GO TO START; 14159000 GOTSCHK:GOTSTORAGE~ NOT SPECTOG OR GOTSTORAGE;GO TO START; 14160000 FORMATDEC: IF SPECTOG THEN ENTRY(IF G ~ GTA1[J-1] = SYMV %A14161000 THEN SYMSTRPROCID ELSE FRMTID + REAL(G = SWITCHV)) ELSE %A14161100 IF GTA1[J-1] = SYMV THEN IF ELCLASS = FACTOP THEN SFHEAD ELSE %A14161500 GO TO PROCEDUREDEC ELSE %A14161600 FORMATGEN; GO TO START; 14162000 LISTDEC: 14163000 BEGIN 14164000 LABEL START; 14165000 IF G~GTA1[J] = LISTV AND G~ GTA1[J-1]= SWITCHV 14165500 THEN BEGIN HANDLESWLIST; GO TO GOTSCHK END; 14165510 IF SPECTOG 14166000 THEN 14167000 BEGIN 14168000 ENTRY(LISTID); 14169000 GO TO START 14170000 END; 14171000 STOPENTRY~STOPGSP~TRUE; I~I-1; 14172000 DO 14173000 BEGIN I~I+1; 14174000 JUMPCHKX; 14175000 ENTRY(LISTID); IF ELCLASS!LEFTPAREN THEN FLAG(31) ELSE STEPIT; 14176000 F~LISTGEN; 14177000 IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; %W3314177500 PUT(TAKE(LASTINFO)&(IF MODE=0 THEN F 14178000 ELSE F:=GETSPACE(FALSE,LASTINFO+1)) % LIST DESCR. 14178001 [16:37:11],LASTINFO); 14179000 EMITSTORE(F,STD); 14180000 END 14181000 UNTIL ELCLASS! COMMA; 14182000 STOPENTRY~STOPGSP~FALSE; 14183000 START: 14184000 END LISTDEC; 14185000 GO TO START; 14186000 LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24); 14187000 STOPENTRY~STOPGSP~TRUE; 14188000 I~I-1; 14189000 DO 14190000 BEGIN 14191000 STOPDEFINE~TRUE; 14192000 STEPIT; 14193000 ENTRY(LABELID); 14194000 PUTNBUMP(0) 14195000 END 14196000 UNTIL ELCLASS!COMMA; 14197000 STOPENTRY~STOPGSP~FALSE; 14198000 IF SPECTOG THEN NOGO; %M14198500 GO TO START; 14199000 SWITCHDEC: 14200000 BEGIN 14201000 LABEL START; 14202000 INTEGER GT1,GT2,GT4,GT5; 14203000 BOOLEAN TB1; 14204000 STOPENTRY~NOT SPECTOG;STOPGSP~TRUE; 14205000 SCATTERELBAT; GT1~0; TB1~FALSE; 14206000 IF LEVELF=LEVEL 14207000 THEN 14208000 BEGIN 14209000 IF TAKE(LINKF+1)}0 14210000 THEN FLAG(1); PUT(-TAKE(LINKF+1),LINKF+1); 14211000 TB1~TRUE;GT2~ADDRSF; 14212000 GT1~ TAKEFRST; GT4~LASTINFO; LASTINFO~LINKF; 14213000 STEPIT;GT5~NEXTINFO;NEXTINFO~LINKF+INCRF 14214000 END 14215000 ELSE 14216000 ENTRY(SWITCHID); STOPGSP~STOPENTRY~FALSE;IF SPECTOG THEN GO TO 14217000 START; 14218000 IF ELCLASS=ASSIGNOP 14219000 THEN 14220000 BEGIN 14221000 JUMPCHKNX;PUTNBUMP(L);G~L; 14222000 IF FORMALF~SWITCHGEN(TB1) 14223000 THEN 14224000 BEGIN 14225000 GT1~PROGDESCBLDR(ADES,G,GT1); 14226000 JUMPCHKX; 14227000 STUFFF(GT1); 14228000 IF MODE>0 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: IF SPECTOG THEN NOGO %M14251000 END SWITCHDEC; 14252000 GO TO START; 14253000 DEFINEDEC: 14254000 GT1 ~ GTA1[J-1]; %A14254030 BEGIN LABEL START; 14254050 REAL J,K,DINFO,LINKA,LINKB,T; 14254100 BOOLEAN BV; BV := GT1 = SYMV; %T9314254900 STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000 DO 14256000 BEGIN 14257000 IF STEPI = FACTOP AND BV THEN BEGIN QUOTETOG ~ TRUE; %A14257100 IF STEPI ! QUOTEOP THEN FLAG(688);% %A14257150 GT1 ~ GENQUOTE(TRUE); QUOTETOG ~ FALSE; I ~ I-1 END ELSE BEGIN %A14257200 STOPDEFINE:=TRUE; 14258000 IF BV THEN ENTRY(ALFATRNS) ELSE BEGIN %A14258500 MOVE(9,ACCUM[1],GTA1); %A14259000 IF T:=ELBAT[NXTELBT-1].LINK!0 THEN % DEFINED B4 IN PROGRAM. 14259002 IF T}NINFOO THEN FLAG(1); % DEFINED B4 IN THIS BLOCK. 14259004 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; 14259090 ACCUM[0].CLASS ~ DEFINEDID; 14259092 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 END; %A14259160 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 %T9214265930 %T9214265950 IF BV THEN BEGIN QUOTETOG ~ TRUE; %T9214266000 IF STEPI ! QUOTEOP THEN FLAG(688); PUTNBUMP(GENQUOTE(TRUE));%%A14266050 I ~ I -1; %M14266200 QUOTETOG ~ FALSE END ELSE BEGIN %A14266500 MACROID~TRUE; 14266600 LASTINFO ~ DINFO; %T9214266630 PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); %T9214266660 DEFINEGEN(FALSE, J & DINFO[18:33:15]); %T9214266700 MACROID~FALSE; 14266800 END; %A14266900 END END %M14267000 UNTIL STEPI!COMMA; 14268000 % %A14268500 START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000 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 GOTCHA := GOTCHA OR NOT STREAMER; % NOT FOR XALG %T0314280500 IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000 ELSE 14282000 BEGIN 14283000 %M14284000 IF G=COMPLEXV THEN BEGIN TYPEV ~ DBLPLXSTRPROCID; %M14284300 IF GTA1[J-1]= DOUBLEV THEN BEGIN J~J-1; NEWPART~2 END ELSE %M14284500 NEWPART ~ 1 END ELSE %M14285000 IF TYPEV ~INTRNSICPROCID+G>INTSTRPROCID OR %M14285500 TYPEV < STRINGSTRPROCID THEN FLAG(4); %M14286000 IF NOT SPECTOG THEN 14287000 FUNCTOG~TRUE; 14288000 CHKSOB 14289000 END END 14290000 ELSE 14291000 BEGIN %M14291500 IF G=0 THEN TYPEV~PROCID 14292000 ELSE 14293000 IF G > FIELDV THEN BEGIN TYPEV ~RECPROCID; RECTYPE ~ G END ELSE %T9214294000 IF G = COMPLEXV THEN BEGIN TYPEV ~ DBLPLXPROCID; %T9214294100 IF GTA1[J-1]=DOUBLEV THEN BEGIN J~J-1; NEWPART~ 2 END ELSE %M14294200 NEWPART ~ 1 END ELSE %M14294300 IF (TYPEV~REALSTRPROCID+G)=INTSTRPROCID THEN %T9214294400 BEGIN NEXTSAVE~TRUE; TYPEV ~ PROCID END ELSE %T9214294600 IF TYPEV > INTPROCID OR TYPEV < STRINGPROCID THEN FLAG(005); %T9214295000 IF GTA1[J+1]=FORMATV THEN TYPEV ~ SYMSTRPROCID; %T9214295100 IF TYPEV!PROCID THEN BEGIN %T9214296000 IF (NEXTSAVE ~ GTA1[J-1] = SAVEV) THEN J ~ J - 1; %T9214296500 IF NOT SPECTOG THEN FUNCTOG ~ TRUE; CHKSOB; END; %T9214297000 END; %M14297500 IF SPECTOG 14298000 THEN 14299000 BEGIN 14300000 ENTRY(TYPEV); NEWPART ~ RECTYPE ~ 0; GO TO START2; %M14301000 END; 14302000 MODE~MODE+1; 14303000 LO~PROINFO; 14304000 SYMFORMO ~ SYMFORM; SYMFORM ~ 0; %M14304500 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 14310000 XMARK; 14310500 PUT(-G,LINKF+1); 14311000 IF REAL (NEXTSAVE)!G.[3:1] THEN FLAG(051); %T9214311050 IF TYPEV = DBLPLXPROCID THEN BEGIN IF G.[2:2]!NEWPART THEN %T9214311100 BEGIN FLAG(6); GO DOITANYWAY END END ELSE %M14311200 IF TYPEV = RECPROCID THEN BEGIN %M14311300 IF TAKE(((G.[12:6]+18)DIV 8)+LINKF)! RECTYPE %M14311400 THEN BEGIN FLAG(6); GO DOITANYWAY END END; %M14311500 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 NEWPART ~ RECTYPE ~ 0; %M14322500 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; %A14325000 IF SLABTOG ~ ELCLASS!LFTBRKET THEN %W1414325500 IF ELCLASS!LEFTPAREN THEN FLAG(007); 14326000 COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000 FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000 RR1~NEXTINFO; 14329000 LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000 PUTNBUMP(0); 14331000 PTOG~TRUE; I~I+1; 14332000 ENTRY(SECRET); 14333000 IF FWDTOG THEN 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 IF ELCLASS!RTBRKET OR SLABTOG THEN FLAG(008); %W1414337000 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;G~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~NLOC+1; 14433000 END 14434000 ELSE 14435000 BEGIN 14436000 IF GT1.ADDRESS!0 THEN NLAB~NLAB+1; 14437000 IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000 BEGIN 14439000 MOVE(9,INFO[0,J],ACCUM[0]); 14440000 Q~ACCUM[1]; 14441000 FLAG(267); 14442000 ERRORTOG~TRUE; 14443000 END; 14444000 END; 14445000 G~(GT2~TAKE(J+1)).PURPT; 14446000 IF GT1.[2:8] ! STLABID|2+1 THEN 14447000 STACKHEAD[(0>2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000 END UNTIL J~J-G{1; 14449000 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 END; 14462000 LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000 END 14464000 ELSE 14465000 BEGIN 14466000 IF STEPI=FORWARDV 14467000 THEN 14468000 BEGIN 14469000 PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000 PURGE(PINFOO); 14471000 STEPIT 14472000 END 14473000 ELSE 14474000 BEGIN 14475000 PROADO~PROAD; 14476000 RETLISTO ~ RETLIST; RETLIST ~ 4095; %M14476500 SYMFORMATO ~ SYMFORMAT; SYMFORMAT ~ PROINFO.CLASS=SYMSTRPROCID; %A14476600 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 BEGIN %M14479500 IF STEPI=DECLARATORS THEN IF DECLCHECK THEN %M14480000 BEGIN I~I-1; %M14481000 BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000 ; PURGE(PINFOO); 14483000 GO TO STOP END; I ~I-1; ELCLASS~BEGINV END; %M14484000 BEGIN 14485000 JUMPCHKNX; 14486000 RELAD~L ; 14487000 IF NEXTSAVE THEN FLAG(052); 14487010 IF SYMFORMAT THEN SFEXP(TRUE,TRUE,0) ELSE %A14487500 STMT; %M14488000 IF RETLIST ! 4095 THEN HANDLRET(SYMFORM ! 0 AND FAULTOG.[46:1]); %T9214488200 MARKSYMDCR(-SYMFORM); %T9214488300 IF FAULTOG.[46:1] THEN BEGIN EMIT(40); EMITO(COM); END; % %D0114488500 HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000 END; 14490000 STOP: 14491000 RETLIST ~ RETLISTO; %M14491500 SYMFORMAT ~ SYMFORMATO; %A14491600 SUBLEVEL~TSUBLEVEL; 14492000 STACKCTR~STACKCTRO; 14493000 END; 14494000 END; 14495000 PROINFO~LO; 14496000 SYMFORM ~ SYMFORMO; %M14496500 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 FLAG(12);GO TO HF 14508000 END; 14509000 BEGINCTR ~ BEGINCTR-1; 14510000 IF RECORDLINK ! RECORDLINKO THEN BEGIN %A14510500 GOTSTORAGE ~ TRUE; GENRECORD(RECORDLINKO,TRUE); END; %M14510600 IF SYMFORMAT THEN SFEXP(TRUE,TRUE,0); %A14510700 IF ERRORTOG 14511000 THEN COMPOUNDTAIL 14512000 ELSE 14513000 BEGIN 14514000 STMT; 14515000 IF STEPI= DECLARATORS AND DECLCHECK %M14516000 THEN 14517000 BEGIN I~I-1; %M14518000 ELBAT[I].CLASS~SEMICOLON; 14519000 BEGINCTR~BEGINCTR+1; 14520000 GO TO START 14521000 END 14522000 ELSE 14523000 BEGIN I~I-1;COMPOUNDTAIL END %M14524000 END; 14525000 BEGIN 14526000 RELAD~FIRSTX; 14534000 IF STACKCTR>MAXSTACK 14535000 THEN MAXSTACK~STACKCTR; 14536000 SYMLOC ~ SYMLOC + SYMFORM; %M14536400 IF XITLIST! 4095 THEN HANDLXIT; %M14536500 IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000 THEN 14538000 BEGIN IF SOP AND RETLIST!4095 THEN HANDLRET(TRUE); %M14538500 MARKSYMDCR(-SYMLOC); %M14538600 IF RECORDLINKO! RECORDLINK THEN GENRECORD(RECORDLINKO,FALSE); %M14538700 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 END ELSE BEGIN IF SOP AND RETLIST!4095 THEN HANDLRET(SYMLOC!0); %M14552500 MARKSYMDCR(-SYMLOC) END; %M14552600 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 % %D0114561000 BEGIN 14562000 ADJUST; RELAD~L; 14563000 IF GOTSTORAGE OR FAULTOG.[46:1] THEN BEGIN EMITV(BLOCKCTR);EMIT(4); %D0114564000 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 ERRORCOUNT=0 THEN %M14569010 IF LEVEL = 1 THEN %A14569020 EMITNEWX; % DO THE RUN TIME INITIALIZATION %A14569050 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; IF LEVEL+ERRORCOUNT=1 THEN EMITNONX %M14572000 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 PRTI~PRTIO; 14607000 FIRSTX~FIRSTXO; 14608000 SOPG ~ SOPGO; XITLIST ~ XITLISTO; SYMLOC~ SYMLOCO; %M14608100 RECORDLINKO ~ RECORDLINK;% %A14608200 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 % %M15073500 T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000 J ; COMMENT SUBSCRIPT COUNTER ; 15075000 REAL X, Z; 15075500 LABEL EXIT; 15076000 BOOLEAN DPO; %M15076250 DPO ~ DPTOG; DPTOG ~ FALSE; %M15076500 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+8) [2:41:7] & 514 [16:37:11]; %M15083000 END 15084000 ELSE CHECKER(TALL); 15085000 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 L1: %W5215092000 XMARK; 15092010 STEPIT; %W5215092015 IF TALL.FORMALNAME THEN %W5215092020 BEGIN 15093000 EMITN(TALL.ADDRESS); 15094000 IF T1!0 OR ELCLASS=FACTOP THEN BEGIN EMITO(DUP); %W5215095000 EMITO(COC); IF T1!0 AND ELCLASS=FACTOP THEN %W5215095500 EMITO(DUP) END; %W5215095600 END 15096000 ELSE IF T1!0 OR ELCLASS=FACTOP THEN BEGIN %W5215097000 EMITV(TALL.ADDRESS);IF T1!0 AND ELCLASS=FACTOP %W5215097500 THEN EMITO(DUP) END; %W5215097600 STACKCT ~ REAL(T1!0); %W5215098000 IF ELCLASS=FACTOP THEN ELBAT[I].CLASS ~ %W5215098200 ELCLASS ~ CROSSHATCH; %W5215098400 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 IF P1! FS THEN 15114000 BEGIN ERR(201);GO TO EXIT END 15115000 ELSE GO TO L1 15116000 %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 DESIGNATER DOES NOT MATCH THE ARRAY * 15258000 DECLARATION. *;15259000 IF STEPI ! RTBRKET THEN 15260000 BEGIN ERR(204);GO EXIT END; 15261000 COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000 IF P1 ! FA THEN 15262500 IF STLB > 1 THEN FLAG(212) ELSE 15262600 IF P1!FI AND P1!FL THEN 15263000 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 EMITL(5); EMITN(GNAT(PRINTI)); 15271000 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 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 ELCLASS=FACTOP THEN BEGIN %W5215306200 ELBAT[I].CLASS~ELCLASS~CROSSHATCH; %W5215306400 EMITO(DUP); IF T1=0 THEN EMITO(LOD) END; %W5215306600 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 EMITL(IF SPCLMON 15326000 THEN 3 15327000 ELSE 2); EMITV(GNAT(PRINTI)); 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 IF P1=FS THEN GO TO LAST 15342000 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 EMITL(5); 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 EMITL(5); EMITV(GNAT(PRINTI)); 15374000 END ; 15375000 EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000 EXIT: DPTOG ~ DPO END OF VARIABLE; %M15377000 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 SED = 06#, COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 16017000 RSA = 43#, COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 16018000 TRP = 60#, COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 16019000 BSS = 3#, COMMENT 7.5.6.6 SKIP SOURCE BIT ; 16020000 BSD = 2#, COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 16021000 SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000 JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ; 16023000 PROCEDURE DECLARELABEL; %W2516023100 COMMENT DO LABEL DECLARATION UPON FIRST APPEARANCE OF LABEL; %W2516023200 BEGIN %W2516023300 KLASSF ~ STLABID; %W2516023400 VONF ~ FORMALF ~ FALSE; %W2516023500 ADDRSF ~ 0; %W2516023600 MAKEUPACCUM; E; PUTNBUMP(0); %W2516023700 ELBAT[I] ~ ACCUM[0]&LASTINFO[35:35:13]; %W2516023800 END DECLARELABEL; %W2516023900 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 IF SLABTOG THEN %W1416036000 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 IF SLABTOG THEN BEGIN %W1416048000 ADJUST END %69 %W1416048001 ELSE BEGIN FLAG(275); ERRORTOG~TRUE END; %W1416048500 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 IF SLABTOG THEN %W1416077500 ELSE BEGIN FLAG(275); ERRORTOG~TRUE END; %W1416077700 END 16078000 ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW); 16079000 END EMIT JUMP; 16080000 COMMENT WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE16081000 ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 16082000 TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000 LINK IS = 4096. ; 16084000 PROCEDURE JUMPCHAIN( E); VALUE E;REAL E; 16085000 BEGIN 16086000 REAL SAVL ,LINK; 16087000 SAVL ~ L; 16088000 L ~ TAKE(GIT(E)).LASTGT ; 16089000 WHILE L! 4095 DO 16090000 BEGIN 16091000 LINK ~ GET(L); 16092000 EMITJUMP( E); 16093000 L ~ LINK 16094000 END; 16095000 L~SAVL; 16096000 END JUMPCHAIN ; 16097000 COMMENT NESTS COMPILES THE NEST STATEMENT. 16098000 A VARIABLE NEST INDEX CAUSES THE CODE, 16099000 CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000 AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 16101000 THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH {63,OTHERWISE16102000 IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000 RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000 MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000 JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 NEST LEVEL INCREASED BY ONE. 16107000 WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000 THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000 OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000 ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000 JUMPS. 16112000 FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000 AND JOINFO RESTORED TO THEIR ORIGINAL VALUES. ; 16114000 PROCEDURE NESTS; 16115000 BEGIN 16116000 LABEL EXIT; 16117000 REAL JOINT,BNSFIX; 16118000 IF ELCLASS!LITNO THEN 16119000 BEGIN 16120000 EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000 EMIT(BNS); %W1416122000 IF SLABTOG THEN BEGIN EMIT(NOP); EMIT(NOP) END; %W1416122500 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 IF SLABTOG THEN ADJUST; %W1416137000 PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000 JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000 END; 16140000 IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000 NESTLEVEL ~ NESTLEVEL-1; 16142000 JOINFO ~ JOINT ; 16143000 EXIT: END NESTS ; 16144000 COMMENT LABELS HANDLES STREAM LABELS. 16145000 ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000 WORD (IN THE PROGRAMSTREAM). 16147000 IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000 THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000 [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000 HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000 MATCHES THE LEVEL OF THE LABEL. 16152000 MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000 FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000 AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 16155000 PROCEDURE LABELS; 16156000 BEGIN 16157000 REAL GT1; %W1416157500 IF SLABTOG THEN ADJUST; %W1416158000 GT1 ~ ELBAT[I]; 16159000 IF STEPI ! COLON THEN ERR(258) 16160000 ELSE 16161000 BEGIN 16162000 IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259); 16163000 IF GT1>0 THEN 16164000 BEGIN 16165000 PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000 PUT(-L,GT2) 16167000 END 16168000 ELSE 16169000 BEGIN 16170000 IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000 PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000 JUMPCHAIN(GT1); 16173000 END; 16174000 END 16175000 ; STEPIT; 16176000 END LABELS ; 16177000 COMMENT IFS COMPILES IF STATEMENTS. 16178000 FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000 CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000 THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000 IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR. OTHERWISE 16182000 THE CODE IS EMITTED STRAIGHTAWAY. 16183000 A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000 "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000 SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000 TO BE GENERATED. 16187000 THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000 IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000 IF THEN GO TO L1 ELSE GO TO L2 ; 16190000 PROCEDURE IFS; BEGIN 16191000 DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,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: IF STEPI ! RELOP THEN BEGIN ERR(264);GO TO EXIT END; 16207000 IF STEPI = DCV THEN EMITC( ADDR,ELBAT[I-1].COMPARECODE) 16208000 ELSE 16209000 IF ELCLASS = STRNGCON THEN 16210000 BEGIN 16211000 IF ACCUM[1].[12:6] ! 1 OR ELBAT[I-3].CLASS ! IFV 16211100 THEN BEGIN ERR(271); GO TO EXIT END 16211200 ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 END 16211400 ELSE 16212000 IF ACCUM[1] ! "5ALPHA" THEN 16213000 BEGIN ERR(265);GO TO EXIT END 16213100 ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 ELSE BEGIN FLAG(270); ERRORTOG ~ TRUE END; 16214100 GO TO IFTOG ; 16215000 IFSB: EMITC(1,BIT); 16216000 IFTOG: IF STEPI ! THENV THEN BEGIN ERR(266); GO TO EXIT END; 16217000 FIX1 ~ L; 16218000 EMIT(JFC); 16219000 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 IF SLABTOG THEN %W1416225500 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 FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000 AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000 BE JUMPED OUT. OTHERWISE,NEST LEVEL IS DEFINED. ; 16248000 PROCEDURE GOTOS; 16249000 BEGIN 16250000 LABEL EXIT; 16251000 IF STEPI !TOV THEN I~I-1 ; 16252000 IF STEPI ! STLABID THEN %77 %W2516253000 IF (IF ELCLASS{IDMAX THEN ELCLASS!LOCLID ELSE %77 %W2516253025 (ELCLASS=SUPERLISTID OR ELCLASS=FAULTID) ) THEN %77 %W2516253050 DECLARELABEL ELSE BEGIN ERR(260); GO TO EXIT END; %W2516253100 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 SYLLABLES ORDERED FROM 16300000 RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000 MAY REQUIRE AT MOST ONE REPEAT PART. 16302000 IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000 PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE" IS 16304000 ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000 ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000 USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000 THE PROPER ADDRESS AND OPERATOR . 16308000 NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000 ERROR. ; 16310000 PROCEDURE INDEXS; 16311000 BEGIN 16312000 LABEL EXIT,GENERATE,L,L1; 16313000 INTEGER TCLASS,INDEX,ADDR,J; 16314000 TCLASS ~ ELCLASS ; 16315000 IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000 IF TCLASS = LOCLID THEN 16317000 BEGIN 16318000 IF SIV>STEPI OR ELCLASS>TALLYV THEN GO TO L; 16319000 INDEX ~ 32 + ELCLASS-SIV; 16320000 ADDR ~ ELBAT[I-2].ADDRESS; 16321000 GO TO GENERATE; 16322000 END; 16323000 IF TCLASS = STEPI THEN 16324000 BEGIN 16325000 IF STEPI!ADDOP 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 DESTINATION STREAM STATEMENTS. 16356000 DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000 STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000 NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000 ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000 THE OPCODE FIELD ; 16361000 PROCEDURE DSS; 16362000 BEGIN 16363000 INTEGER ADDR,J,K,L,T; 16364000 LABEL EXIT,L1; 16365000 DEFINE OPCODE=[27:6]#; 16366000 IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000 IF STEPI = LOCLID THEN 16368000 BEGIN 16369000 EMITC(ELBAT[I].ADDRESS,CRF); 16370000 ADDR~ 0; 16371000 IF STEPI = LITV THEN GO TO L1 16372000 END 16373000 ELSE IF ELCLASS= LITNO THEN 16374000 BEGIN 16375000 ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000 END 16377000 ELSE ADDR ~ 1 ; 16378000 IF 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 ! STRNGCON THEN BEGIN ERR(255);GO TO EXIT END; 16384000 IF ADDR MOD 2 ! 0 THEN 16385000 BEGIN 16386000 EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000 END ; 16388000 FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000 BEGIN 16390000 FOR L ~6,7 DO 16391000 MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000 ELSE J),T,L ); 16393000 EMIT(T); 16394000 END END 16395000 ELSE 16396000 L1: ERR(250); 16397000 EXIT:END DSS ; 16398000 COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000 IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000 A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000 OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000 PROCEDURE SKIPS ; 16403000 BEGIN 16404000 REAL ADDR; 16405000 IF STEPI = LOCLID THEN 16406000 BEGIN 16407000 EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000 END 16409000 ELSE IF ELCLASS = LITNO THEN 16410000 BEGIN 16411000 ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000 END 16413000 ELSE ADDR ~ 1 ; 16414000 IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000 ELSE 16416000 IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000 ELSE ERR(250); 16418000 END SKIPS ; 16419000 COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000 JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO 16421000 THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 16422000 JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 16423000 JUMP INSTRUCTION. 16424000 SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000 A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 16426000 THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 16427000 UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000 THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING16429000 GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 16430000 PROCEDURE JUMPS; 16431000 BEGIN 16432000 JUMPLEVEL~1; 16433000 IF STEPI!DECLARATORS THEN FLAG(261); 16434000 IF STEPI = LITNO THEN JUMPLEVEL~ ELBAT[I].ADDRESS 16435000 ELSE BEGIN 16436000 IF ELCLASS! TOV AND ELCLASS! STLABID THEN 16437000 BEGIN 16438000 COMMENT SIMPLE JUMP OUT STATEMENT; 16439000 IF JOINFO = 0 THEN 16440000 BEGIN 16441000 JOINFO ~ NEXTINFO ; 16442000 PUTNBUMP(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=COLON THEN BEGIN ADJUST;STEPIT;GO START END; %W1416478200 IF ELCLASS=STLABID THEN GO TO L2; %W2516478400 IF (IF ELCLASS{IDMAX THEN ELCLASS!LOCLID ELSE %77 %W2516478600 (ELCLASS=SUPERLISTID OR ELCLASS=FAULTID) ) THEN %77 %W2516478700 BEGIN DECLARELABEL; GO TO L2 END; %W2516478800 IF ELCLASS = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 = LFTPAREN THEN GO TO L1; 16480000 %W2516481000 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 XREFPT~XLUN~0; %DFB16496000 TIME1 ~ TIME(1); PROGRAM; 17000000 % %A17000050 IF FALSE THEN ENDOFITALL: IF ERRORMAX < @10 THEN %T9317000100 BEGIN ERRORMAX:=@10; ERRORTOG:=TRUE; FLAG(999); END; %T9317000150 END; % END OF SEGMENT 17000200 IF XREF THEN %DFB17001000 BEGIN DEFINE LSS= <#,GTR=>#,NEQ= !#,LEQ={#; %DFB17002000 DEFINE XREFINFO=INFO#; 17002005 WRITE(LINE[PAGE]); 17002520 LASTADDRESS~0; 17002530 FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000 WRITE(DSK2,30,XREFAY2[*]); %DFB17004000 TOTALNO~REAL(XLUN >500)|1000+3000; 17004500 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 REWIND(DSK1) %DFB17022000 ELSE %DFB17023000 BEGIN %DFB17024000 A[9]:=XREFINFO[A[9].LINKR,A[9].LINKC]:=XLUN:=XLUN+1;%DFB17025000 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 LSS DC THEN TALLY:=1; %DFB17033000 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 END; %DFB17042000 BOOLEAN PROCEDURE COMP1(A,B); %DFB17042100 ARRAY A,B[0]; %DFB17042200 COMP1:=COMPS1(A,B); %DFB17042300 PROCEDURE HV1(A); %DFB17042400 ARRAY A[0]; %DFB17042500 HVS1(A); %DFB17042600 XLUN:=0; %DFB17043000 REWIND(DSK1); %DFB17044000 SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,TOTALNO ); %DFB17045000 END; %DFB17046000 BEGIN %DFB17047000 STREAM PROCEDURE PUP(S,D); %DFB17048000 BEGIN %DFB17049000 SI:=S; %DFB17050000 DI:=D; %DFB17051000 DS:=8 WDS; %DFB17052000 DS:= LIT " "; %DFB17053000 DS~8 CHR; %DFB17054000 DS~ 7 LIT" "; 17054500 5(DS~8LIT" "); 17054550 END; %DFB17055000 STREAM PROCEDURE PUP2(STAR,S,C,D); 17056000 VALUE STAR,S,C; 17056500 BEGIN %DFB17057000 DI:=D; %DFB17058000 C(DI:=DI+9); %DFB17059000 STAR(DI~DI-1; DS~LIT"*"); 17059100 SI:=LOC S; %DFB17060000 DS:= 8 DEC; %DFB17061000 END; %DFB17062000 STREAM PROCEDURE BLANKET(A); %DFB17063000 BEGIN %DFB17064000 DI:=A; %DFB17065000 DS:= 8 LIT " "; %DFB17066000 SI:=A; %DFB17067000 DS:= 14 WDS; %DFB17068000 END; %DFB17069000 ARRAY PAY[0:17]; %DFB17069500 BOOLEAN PROCEDURE INPUT2(A); %DFB17070000 ARRAY A[0]; %DFB17071000 BEGIN %DFB17072000 LABEL L,EOF; %DFB17073000 DEFINE I=XLUN#; %DFB17073100 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&XREFINFO[I.[10:3],I.[13:8]][10:37:11]; %DFB17080000 GO TO L; %DFB17081000 EOF: INPUT2:=TRUE; %DFB17082000 BLANKET(PAY); %DFB17083000 XREFAY1[9]:=-1; XREFPT~0; %DFB17084000 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 LOOP; %DFB17091100 IF B THEN %DFB17092000 WRITE(PRINTER,15,PAY[*]) %DFB17093000 ELSE %DFB17094000 IF LASTADDRESS ! LASTADDRESS~A[0] AND LASTADDRESS.[10:11]! 0 THEN 17094100 BEGIN %DFB17095000 LOOP: %DFB17095050 IF A[0].[10:11] GTR XREFAY1[9] THEN %DFB17095100 BEGIN %DFB17095200 READ(DSK1,10,XREFAY1[*]); %DFB17096000 WRITE(PRINTER[DBL],15,PAY[*]); %DFB17097000 PUP(XREFAY1,PAY); %DFB17098000 XREFPT:=0; %DFB17099000 WRITE(PRINTER,10,PAY[*]); %DFB17100000 BLANKET(PAY); %DFB17101000 GO LOOP; %DFB17101100 END; %DFB17102000 PUP2(LASTADDRESS < 0,LASTADDRESS.[21:27],17103000 XREFPT,PAY[1]); 17103010 IF XREFPT:=XREFPT+1=12 THEN %DFB17103100 BEGIN %DFB17103200 XREFPT:=0; %DFB17103300 WRITE(PRINTER,15,PAY[*]); %DFB17103400 BLANKET(PAY); %DFB17103500 END; %DFB17103600 END; %DFB17110000 END; %DFB17111000 PROCEDURE HV2(A); %DFB17112000 ARRAY A[0]; %DFB17113000 A[0]:=549755813887; %DFB17114000 BOOLEAN PROCEDURE COMP2(A,B); %DFB17115000 ARRAY A,B[0]; %DFB17116000 COMP2~ ABS(A[0]) LEQ ABS(B[0]); 17117000 XREFPT:=29; REWIND(DSK2); %DFB17118000 SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,TOTALNO ); %DFB17119000 END; %DFB17120000 END; %DFB17121000 END MAIN BLOCK; 17121500 END. 17122000 END;END. LAST CARD ON 0CRDING TAPE 99999999