diff --git a/SYMBOL/ALGOL.alg_m b/SYMBOL/ALGOL.alg_m index 2ae3391..d13ebf0 100644 --- a/SYMBOL/ALGOL.alg_m +++ b/SYMBOL/ALGOL.alg_m @@ -552,7 +552,7 @@ DEFINE CHECKBIT = 1#, 01000920 XREFBIT = 26#, 01001170 BENDBIT = 27#, 01001171 CODEFILEBIT = 29#, %106-01001172 - USEROPINX = 30#, %106-01001173 + USEROPINX = 30#; %106-01001173 COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01001180 AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190 FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200 @@ -708,7 +708,7 @@ DEFINE % %116-01007400 LBLREF = 1#, % %116-01007486 DECLREF = 2#, % %116-01007490 NORMALREF = 4#, % %116-01007495 - ASSIGNREF = 5#, % %116-01007500 + ASSIGNREF = 5#; % %116-01007500 ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600 BOOLEAN DEFINING; 01007650 COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 @@ -930,7 +930,7 @@ COMMENT INFO FORMAT 01028000 LEFTPAREN =34#, COMMENT 042; 01212000 COMMENT CLASSES FOR ALL DECLARATORS; 01213000 DECLARATORS =35#, COMMENT 043; 01214000 - COMMENT CLASSES FOR STATEMENT BEGINNERS 01215000 + COMMENT CLASSES FOR STATEMENT BEGINNERS; 01215000 READV =36#, COMMENT 044; 01216000 WRITEV =37#, COMMENT 045; 01217000 SPACEV =38#, COMMENT 046; 01218000 @@ -1436,7 +1436,7 @@ DEFINE %107-01561500 INSERTMID = INSERTINFO[INSERTDEPTH,0]#, % MFID OF THE LIBRARY FILE 01561530 INSERTFID = INSERTINFO[INSERTDEPTH,1]#, % FID OF THE LIBRARY FILE 01561540 INSERTINX = INSERTINFO[INSERTDEPTH,2]#, % POINTER TO THE RECORD%107-01561550 - INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#, % LAST SEQUENCE TO BE INCLUD01561560 + INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#; % LAST SEQUENCE TO BE INCLUD01561560 INTEGER SAVECARD, INSERTDEPTH; %107-01561570 ARRAY INSERTINFO[0:INSERTMAX,0:4]; %107-01561580 FILE LIBRARYFIL DISK RANDOM(2,10,30); %107-01561590 @@ -1478,7 +1478,7 @@ REAL STREAM PROCEDURE CMPD(A,B); %107-01561620 FILEATTINT =563#, 01579300 POWERALL =567#, 01579350 SPECIALMATH =570#, 01579355 - SORTA =673#, %117-01580000 + SORTA =673#; %117-01580000 COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000 IN INFO OF THE CORRESPONDING ROUTINE; 01582000 INTEGER KOUNT,BUFFACCUM; 01583000 @@ -1487,7 +1487,7 @@ INTEGER FILENO; 01584000 FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000 FUNCTION; 01587000 P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 01588000 - P3, COMMENT TELSS WHETHER SAVE WAS SEEN; 01589000 + P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 01589000 P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500 VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000 FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000 @@ -2716,7 +2716,7 @@ DEFINE SKAN = BEGIN 02277000 COMMENT DOLLARCARD HANDLES THE COMPILER CONTROL CARDS. 02282000 ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT 02283000 IN THE ARRAY "OPTIONS". 02284000 - EACH OPTION HAS A TWO-WORD ENTRY; 02285000 + EACH OPTION HAS A TWO-WORD ENTRY: 02285000 02286000 WORD CONTAINS 02287000 ---- -------- 02288000 @@ -4437,7 +4437,7 @@ INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000 BOOLEAN PERMANENT; INTEGER L; 05333000 BEGIN LABEL L1,L2,EXIT; 05334000 BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000 - DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000 + BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000 BOOLEAN M,Q; 05343000 INTEGER ROW,COL,GS; 05344000 IF PERMANENT 05345000 @@ -6386,6 +6386,7 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000 ELSE BEGIN 08036000 B ~ FALSE; A ~ ELBAT[I]; 08037000 SIMPLE ~ REALID { ELCLASS AND ELCLASS { INTID END; 08038000 + END SIMPLE; 08038100 COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000 PROCEDURE TEST; 08041000 BEGIN 08042000 @@ -9736,7 +9737,7 @@ END DEFINEPARAM; 12166000 TYPE:=TYPE-2 ELSE IF ACCUM1 = "6UPDAT" THEN 13088075 TYPE:=TYPE+1 ELSE 13088080 IF ACCUM1="7PROTE" THEN TYPE~26 ELSE 13088082 - FLAG(43);STEPIT; END; IF ELCLASS=LFTBRKET THEN 13088085 + FLAG(43);END;STEPIT; END; IF ELCLASS=LFTBRKET THEN 13088085 BEGIN STEPIT;L~L-2;AEXP;IF ELCLASS=COLON THEN BEGIN 13088090 STEPIT; AEXP END ELSE FLAG(30); 13088100 IF ELCLASS!RTBRKET THEN FLAG(44);END ELSE I~I-1; 13088105 @@ -10182,7 +10183,7 @@ REAL ADDCON; 13451000 IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000 ELSE 13455000 IF T1=OWNV THEN 13456000 - BEGIN P2:=TRUE;IF SPECTOG THE FLAG(13) END 13457000 + BEGIN P2:=TRUE;IF SPECTOG THEN FLAG(13) END 13457000 ELSE 13458000 IF T1= SAVEV THEN 13459000 BEGIN 13460000 diff --git a/tools/xem/ALGOLXEM.alg_m b/tools/xem/ALGOLXEM.alg_m new file mode 100644 index 0000000..4af1cf0 --- /dev/null +++ b/tools/xem/ALGOLXEM.alg_m @@ -0,0 +1,12722 @@ +$ MARGIN 0 INDENT 2 BEGINOFFSET 2 00000100 +$ DECINDENT 2 DEFINEINDENT 18 PROCINDENT 2 00000200120324PK + $SET OMIT LISTA = LIST 00000999 +%#######################################################################00001000 +% 00001010 +% B-5700 ALGOL/TSPOL SYMBOLIC 00001020 +% MARK XVI.0.122 00001030 +% MAY 9, 1977 00001040 +% 00001050 +%#######################################################################00001060 +% 00001070 + COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00001072 + * FILE ID: SYMBOL/ALGOL TAPE ID: SYMBOL1/FILE000 * 00001073 + * THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00001074 + * AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00001075 + * EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00001076 + * WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00001077 + * BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00001078 + * * 00001079 + * COPYRIGHT (C) 1965, 1971, 1972, 1974 * 00001080 + * BURROUGHS CORPORATION * 00001081 + * AA759915 AA320206 AA393180 AA332366 *; 00001082 +COMMENT#################################################################00001110 + ERROR MESSAGES 00001120 +########################################################################00001130 +% 00001140 +ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000 + 000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000 + 001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000 + 002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000 + IDENTIFIER NOT APPEARING IN 00006000 + FORMAL PARAMETER PART. 00007000 + 003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000 + LIST OF DECLARATION. 00009000 + 004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000 + PRECEDED BY ILLEGAL DECLARATOR. 00011000 + 005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000 + BY ILLEGAL DECLARATOR. 00013000 + 006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000 + IN SAME BLOCK(NOT FORWARD). 00015000 + 007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000 + BY ( OR SEMICOLON IN PROCEDURE 00017000 + DECLARATION. 00018000 + 008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000 + BY ). 00020000 + 009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000 + BY SEMICOLON. 00022000 + 010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000 + WHICH DID NOT APPEAR IN FORMAL 00024000 + PARAPART. 00025000 + 011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000 + 012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000 + PART. 00028000 + 013 PROCEDUREDEC: OWN, SAVE, OR AUXMEM USED IN 00029000 + ARRAY SPECIFICATION. 00029500 + 014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00030000 + 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00030500 + 00031000 + 016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00032000 + BY [ . 00033000 + 017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00034000 + FOLLOWED BY : . 00035000 + 018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00036000 + 019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00037000 + ARRAY SPECIFICATION. 00038000 + 020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00039000 + IDENTIFIER(NO TYPE). 00040000 + 021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00041000 + IDENTIFIER(NO TYPE). 00042000 + 022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00043000 + IDENTIFIER(THE WORD PROCEDURE LEFT 00044000 + OUT). 00045000 + 023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00046000 + ANOTHER DECLARATOR. 00047000 + 024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00048000 + 025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00049000 + PRECEDED BY OWN OR SAVE OR SOME 00050000 + OTHER DECLARATOR. 00051000 + 026 FILEDEC: MISSING ( IN FILE DEC. 00052000 + 027 FILEDEC: MISSING RECORD SIZE. 00053000 + 00054000 + 028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000 + IN FILE DEC. 00056000 + 029 FILEDEC: MISSING ) IN FILE DEC. 00057000 + 030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00058000 + 00059000 + 031 LISTDEC: MISSING ( IN LISTDEC. 00060000 + 032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000 + 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00062000 + FORWARD AFTER IDENTIFIER. 00063000 + 034 SWITCHFILEDEC:MISSING ~ AFTER FILED. 00064000 + 035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00065000 + OF SWITCHFILE. 00066000 + 036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~ . 00067000 + 037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00068000 + 038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00069000 + 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100 + 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200 + 041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300 + 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400 + 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500 + 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600 +045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00069700 +046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800 +047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900 + 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910 + 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920 + 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930 + 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931 + ACTUAL DECLARATION 00069932 + 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933 + IDENTIFIER. 00069934 + 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938 + 060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940 + 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950 + INTOVR, OR INDEX. 00069960 + 070 CASESTMT: MISSING BEGIN. 00069970 + 071 CASESTMT: MISSING END. 00069980 + 080 PRIMARY: MISSING COMMA . 00069990 + 090 PARSE: MISSING LEFT BRACKET 00069991 + 091 PARSE: MISSING COLON 00069992 + 092 PARSE: ILLEGAL BIT NUMBER 00069993 + 093 PARSE: FIELD SIZE MUST BE LITERAL 00069994 + 094 PARSE: MISSING RIGHT BRACKET 00069995 + 095 PARSE: ILLEGAL FIELD SIZE 00069996 + 100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000 + 101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000 + IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000 + TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000 + AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000 + 102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000 + 103 PRIMARY: PRIMARY MAY NOT BEING WITH A QUANTITY OF THIS 00076000 + TYPE. 00077000 + 104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000 + 105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000 + 106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000 + 107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000 + 108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000 + AS THE ARITHMETIC EXPRESSIONS. 00083000 + 109 BOOSEC,SIMBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000 + 110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000 + EXPRESSION. 00086000 + 111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000 + TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000 + 112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000 + TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000 + 113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000 + A CONCATENATE OPERATOR IS INCORRECT. 00092000 + 114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS 00093000 + FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000 + 115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE 00095000 + 116 IFCLAUSE: MISSING THEN. 00096000 + 117 BANA: MISSING LEFT BRAKET. 00097000 + 118 BANA: MISSING RIGHT BRAKET. 00098000 + 119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000 + 120 COMPOUNDTAIL: MISSING END. 00100000 + 121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000 + ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000 + PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000 + METER. 00104000 + 122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000 + EXPRESSION PASSED TO IT BY NAME. 00106000 + 123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000 + AGREE AS TO TYPE. 00108000 + 124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000 + NUMBER OF DIMENSIONS. 00110000 + 125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000 + PARAMETER TO A PROCEDURE. 00112000 + 126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000 + QUANTITY OF THIS TYPE. 00114000 + 127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000 + STREAM PROCEDURE. 00116000 + 128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000 + NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000 + 129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000 + 130 RELSESTMT: NO FILE NAME. 00120000 + 131 DOSTMT: MISSING UNTIL. 00121000 + 132 WHILESTMT: MISSING DO. 00122000 + 133 LABELR: MISSING C OLON. 00123000 + 134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000 + 135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000 + 136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000 + 137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000 + INTEGER WHERE AN INTEGER IS REQUIRED. 00128000 + 138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000 + PHRASE. 00130000 + 139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000 + 140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000 + 141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000 + CHARACTORS. 00134000 + 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000 + (BLANK SUPPRESSED). 00136000 + 143 COMPOUNDTAIL: EXTRA END. 00137000 + 144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000 + 145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000 + 146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000 + A MISSING END OF A PROCEDURE OR A MISPLACED 00141000 + DECLARATION. 00142000 + 147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000 + DECLARATION. 00144000 + 148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000 + ARE REQUIRED FOR THIS PROGRAM. 00146000 + 149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000 + PROCEDURE. 00148000 + 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000 + STREAM PROCEDURES. 00150000 + 151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000 + 152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000 + 153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000 + 154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000 + 155 IFEXP: MISSING ELSE 00155000 + 156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST 00156000 + ELEMENT. 00157000 + 157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00158000 + 158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000 + 159 PROCSTMT: ILLEGAL USE OF PROCEDURE OF FUNCTION IDENTIFIER00160000 + 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000 + 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000 + 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500 + 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000 + 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000 + 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100 + 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720 + DECLARATION. 00164725 + 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730 + AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735 + 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740 + PARAMETRIC DEFINE INVOCATION. 00164745 + 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750 + 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00164850 + VARIABLE, OR A TYPE PROCEDURE IDENTIFIER. 00164851 + 199 E: INFO ARRAY HAS OVERFLOWED. 00164900 + 200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00165000 + 201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00166000 + IN A LEFT PART LIST. 00167000 + 202 SIMPLE VARIABLE: MISSING . OR ~ . 00168000 + 203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000 + DESIGNATOR. 00170000 + 204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00171000 + 205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000 + AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00173000 + 206 SUBSCRIPTED VARIABLE: MISSING ]. 00174000 + 207 SUBSCRIPTED VARIABLE: MISSING [. 00175000 + 208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00176000 + 209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00177000 + MOST IN A LEFT PART LIST. 00178000 + 210 SUBSCRIPTED VARIABLE: MISSING , OR ~ . 00179000 + 211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00180000 + 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100 + PARAMETER ONLY. 00180200 + 250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00181000 + 251 ANY STREAM STMT PROCEDURE: MISSING ~. 00182000 + 252 INDEX: MISSING + OR - . 00183000 + 253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000 + 254 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 00185000 + 255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00186000 + 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000 + A FORMAL PARAMETER. 00188000 + 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000 + NEXT LEVEL AS A PRECEDING APPEARANCE OF THE 00190000 + LABEL. 00191000 + 258 LABELS: MISSING :. 00192000 + 259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000 + 260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000 + 261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000 + 262 NESTS: MISSING PARENTHESIS. 00196000 + 263 IFS:MISSING SC IN IF STATEMENT. 00197000 + 264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000 + 265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000 + 266 IFS: MISSING THEN INIF STATEMENT. 00200000 + 267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000 + UNDEFINED. 00202000 + 268 EMITO: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00203000 + FORMAL PARAMETERS,LOCALS AND LABELS. 00204000 + 269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000 + OR TOO SMALL. 00206000 + 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00206100 + 271 IFS: IMPROPER CONSTRUCT FOR . 00206200 + 281 DBLSTMT: MISSING (. 00207000 + 282 DBLSTMT: TOO MANY OPERATORS. 00208000 + 283 DBLSTMT: TOO MANY OPERANDS. 00209000 + 284 DBLSTMT: MISSING , . 00210000 + 285 DBLSTMT: TOO FEW OPERANDS. 00211000 + 286 DBLSTMT: ILLEGAL PARAMETER . 00211100 + 290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00211510 + 291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE00211520 + 292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00211530 + 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540 + 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550 + 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551 + IN A LEFT PART LIST. 00211552 + 300 FILLSTMT: THE IDENTIFIER FOLLOWING "FILL" IS NOT 00212000 + AN ARRAY IDENTIFER. 00213000 + 301 FILLSTMT: MISSING "WITH" IN FILL STATEMENT. 00214000 + 302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000 + 303 FILLSTMT: NON-OCTAL CHARACTER IN OCTAL FILL. 00216000 + 304 FILLSTMT: IMPROPER ARRAY ROW DESIGNATOR IN FILL. 00217000 + 305 FILLSTMT: DATA IN FILL EXCEEDS 1023 WORDS. 00218000 +304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100 + 306 FILLSTMT: ODD NUMBER OF PARENTHESES IN FILL. 00218110 + 307 WHIPOUT: FORMAT > 1023 WORDS. 00218112 + 350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00218200 + SORT OR MERGE STATEMENT. 00218210 + 351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00218220 + 352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00218230 + NOT HAVE EXACTLY TWO PARAMETERS. 00218240 + 353 OUTPROCHECK: FIRST PAREMETER OF OUTPUT PROCEDURE MUST 00218250 + BE BOOLEAN. 00218260 + 354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00218270 + ONE-DIM ARRAY. 00218280 + 355 SORTSTMT: MISSING (. 00218290 + 356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO00218300 + 357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00218310 + PARAMETER. 00218320 + 358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00218330 + 359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00218340 + 360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00218350 + TWO PARAMETERS. 00218360 + 361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00218370 + 362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00218380 + 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390 + 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400 + PARAMETER. 00218410 + 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420 + 366 SORTSTMT: MISSING ). 00218430 + 367 MERGESTMT: MISSING (. 00218440 + 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450 + 369 MERGESTMT: MISSING ). 00218460 + 381 CMPLXSTMT: MISSING (. 00218500 + 382 CMPLXSTMT: TOO MANY OPERATORS. 00218505 + 383 CMPLXSTMT: TOO MANY OPERANDS. 00218510 + 384 CMPLXSTMT: MISSING , . 00218515 + 385 CMPLXSTMT: TOO FEW OPERANDS. 00218520 + 386 CMPLXSTMT: ILLEGAL PARAMETER. 00218525 + 400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00219000 + 401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00220000 + 402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00221000 + 403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00222000 + MONITOR LIST ELEMENT. 00223000 + 404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00224000 + ELEMENT. 00225000 + 405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00226000 + 406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00227000 + 407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00228000 + 408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00229000 + 409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00230000 + 410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00231000 + 411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00232000 + SUBSCRIPTS. 00233000 + 412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00234000 + SUBSCRIPTS. 00235000 + 413 DMUP:IMPROPER ARRAY DUMP LIST ELEMENT. 00236000 + 414 DMUP:ILLEGAL DUMP LIST ELEMENT. 00237000 + 415 DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS 00238000 + IN ONE DUMP DECLARATION. 00239000 + 416 DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER. 00240000 + 417 DMUP:MISSING OR NON-LOCAL LABEL IN DUMP DECLARATION. 00241000 + 418 DMUP:MISSING COLON IN DUMP DECLARATION. 00242000 + 419 DMUP:IMPROPER DUMP DECLARATION DELIMITER. 00243000 + 420 READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT. 00244000 + 421 READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE 00245000 + STATEMENT. 00246000 + 422 READSTMT:MISSING FILE IN READ STATEMENT. 00247000 + 00248000 + 424 READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT 00249000 + 425 READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT. 00250000 + 426 READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ 00251000 + STATEMENT. 00252000 + 427 READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT. 00253000 + 428 READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ 00254000 + STATEMENT. 00255000 + 429 READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT. 00256000 + 430 READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00257000 + STATEMENT. 00258000 + 00259000 + 00260000 + 00261000 + 00262000 + 433 HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT 00263000 + BRACKET IN READ OR SPACE STATEMENT. 00264000 + 434 SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT. 00265000 + 435 SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT. 00266000 + 436 SPACESTMT:MISSING COMMA IN SPACE STATEMENT. 00267000 + 437 SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT. 00268000 + 438 WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT. 00269000 + 439 WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT. 00270000 + 440 WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A 00271000 + WRITE STATEMENT. 00272000 + 441 WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART 00273000 + OF A WRITE STATEMENT. 00274000 + 442 WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE 00275000 + STATEMENT. 00276000 + 443 WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE 00277000 + STATEMENT. 00278000 + 444 WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT. 00279000 + 445 WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00280000 + IN A WRITE STATEMENT. 00281000 + 446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00282000 + 447 WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00283000 + STATEMENT. 00284000 + 448 WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT. 00285000 + 449 READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT. 00286000 + 450 LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT. 00287000 + 451 LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT. 00288000 + 452 LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT. 00289000 + 453 LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK 00290000 + STATEMENT. 00291000 + 454 LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT. 00292000 + 455 CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT. 00293000 + 456 CLOSESTMT:IMPROPER FILE PART IN A CLOSE 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 + 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010 + 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020 + 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030 + 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040 + 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050 + 505 SEARCHLIB: MISSING BRACKET. 00305060 + 00305070 + 507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080 + 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00305100 + 520 TABLE: STRING LONGER THAN ONE WORD (48 BITS). 00306200 + 521 TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER. 00306300 + 600 DOLLARCARD: NUMBER EXPECTED. 00400000 + 601 DOLLARCARD: OPTION IDENTIFIER EXPECTED. 00401000 + 602 DOLLARCARD: TOO MANY USER-DEFINED OPTIONS. 00403000 + 603 DOLLARCARD: UNRECOGNIZED WORD OR CHARACTER. 00404000 + 604 DOLLARCARD: MISMATCHED PARENTHESES. 00405000 + 610 READACARD: SEQUENCE ERROR. 00410000 + 611 READACARD: ERROR LIMIT HAS BEEN EXCEEDED. 00411000 + 612 INCLUDECARD: TOOMANY NESTED INCLUDES. 00412000 + 613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. 00413000 + 614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. 00414000 + 615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. 00415000 + 616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD 00416000 + 617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00417000 + 618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00418000 + ; 00490000 + $POP OMIT LISTA 00499999 +BEGIN COMMENT OUTERMOST BLOCK; 00500000 +$SET NEATUP NEATUPSEQ 505000+5000 00500100120324PK + INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000 + SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000 + INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000 + IF COMPILER & GO =0.FOR SYNTAX, =-1. MUST BE AT R+26;00504000 +INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00504100 +INTEGER CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00504150 + INTEGER LASTADDRESS; 00504200 + ARRAY ENIL[0:7,0:127]; 00504300 + INTEGER ENILPTR; 00504400 + DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500 + ARRAY LDICT[0:7,0:127]; 00504600 + BOOLEAN BUILDLINE; 00504700 +BOOLEAN REL; 00504801 + COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00505000 + TO SAVE SOME STACK SPACE; 00506000 + REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000 + COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000 + THE MAIN BLOCK; 00509000 + COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000 + REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000 + BEGIN SI~NCR; DI~LOC EXAMIN; DI~DI+7; DS~CHR END; 00512000 + REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100 + BEGIN 00512200 + SI ~ AC; SI ~ SI + CT; 00512300 + DI ~ LOC EXAMINELAST; DI ~ DI+7; 00512400 + DS ~ 1 CHR; 00512500 + END EXAMINELAST; 00512600 + COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000 + IN SORCE TO THE DK-TH CHARACTER IN DEST, 0{N{63,0{SK{127; 00514000 + DEFINE DK=DSK#; 00514500 + STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000 + VALUE N, SK, DSK ; 00516000 + BEGIN SI~LOC SK; SI~SI+6; 00517000 + IF SC!"0" THEN BEGIN SI~SORCE; 2(SI~SI+32);SORCE~SI END; 00518000 + SI~LOC DK; SI~SI+6; DI~DEST; 00519000 + IF SC!"0" THEN 2(DI~DI+32); 00520000 + SI~SORCE; SI~SI+SK; DI~DI+DK; DS~N CHR; 00521000 + END MOVECHARACTERS; 00522000 + INTEGER STREAM PROCEDURE GETF(Q); VALUE Q; 00523000 + BEGIN SI~LOC GETF; SI~SI-7; DI~LOC Q; DI~DI+5; 00524000 + SKIP 3 DB; 9(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB); 00525000 + DI~LOC Q; SI~Q; DS~WDS; SI~Q; GETF~SI 00526000 + END GETF; 00527000 + COMMENT START SETTING UP FILE PARAMETERS; 00528000 + IF EXAMIN(RR11~GETF(3)+"Y08" )!12 THEN RR1~5 ELSE 00529000 + BEGIN RR1~2; RR2~150END; 00530000 + IF EXAMIN(RR11+5)!12 THEN RR3~4 ELSE 00531000 + BEGIN RR3~2; RR4~150END; 00532000 + IF EXAMIN(RR11+10)=12 THEN 00533000 + BEGIN RR5~2; RR6~10; RR7~150END ELSE 00534000 + BEGIN RR5~1; RR6~56; RR7~10 END; 00535000 + IF EXAMIN(RR11+15)=12 THEN 00536000 + BEGIN RR8~10; RR9~150END ELSE 00537000 + BEGIN RR8~56; RR9~10 END; 00538000 + IF EXAMIN(RR11+20)=12 THEN RR10~150; 00539000 + BEGIN 01000000 + 01000100 + 01000200 + 01000300 + 01000400 + 01000500 + 01000600 +INTEGER NUMSEQUENCEERRORS; 01000700 +INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01000800 +BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTION"S SETTING 01000802 + BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810 +PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830 + BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840 + % EVALUATING AN ARRAY BOUND 01000850 + INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860 + COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870 + BASENUM IS STARTING VALUE 01000880 + TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890 + CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900 +DEFINE OPARSIZE = 200 #; 01000902 +ARRAY OPTIONS[0:OPARSIZE]; 01000904 +BOOLEAN OPTIONWORD; 01000910 +DEFINE CHECKBIT = 1#, 01000920 + DEBUGBIT = 2#, 01000930 + DECKBIT = 3#, 01000940 + FORMATBIT = 4#, 01000950 + INTBIT = 5#, 01000960 + LISTABIT = 6#, 01000970 + LISTBIT = 7#, 01000980 + LISTPBIT = 8#, 01000990 + MCPBIT = 9#, 01001000 + MERGEBIT = 10#, 01001010 + NESTBIT = 11#, 01001020 + NEWBIT = 12#, 01001030 + NEWINCLBIT = 13#, 01001040 + OMITBIT = 14#, 01001050 + PRINTDOLLARBIT = 15#, 01001060 + PRTBIT = 16#, 01001070 + PUNCHBIT = 17#, 01001080 + PURGEBIT = 18#, 01001090 + SEGSBIT = 19#, 01001100 + SEQBIT = 20#, 01001110 + SEQERRBIT = 21#, 01001120 + SINGLBIT = 22#, 01001130 + STUFFBIT = 23#, 01001140 + VOIDBIT = 24#, 01001150 + VOIDTBIT = 25#, 01001160 + XREFBIT = 26#, 01001170 + BENDBIT = 27#, 01001171 + CODEFILEBIT = 29#, 01001172 + USEROPINX = 30#; 01001173120324PK +COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01001180 + AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190 + FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200 +DEFINE CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01001210 + DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01001220 + DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01001230 + FORMATTOG = OPTIONWORD.[FORMATBIT:1] #, 01001240 + INTOG = OPTIONWORD.[INTBIT:1] #, 01001250 + LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01001260 + LISTOG = OPTIONWORD.[LISTBIT:1] #, 01001270 + LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01001280 + MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01001290 + MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01001300 + NESTTOG = OPTIONWORD.[NESTBIT:1] #, 01001310 + NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01001320 + NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01001330 + OMITTING = OPTIONWORD.[OMITBIT:1] #, 01001340 + PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #, 01001350 + PRTOG = OPTIONWORD.[PRTBIT:1] #, 01001360 + PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01001370 + PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01001380 + SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01001390 + SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01001400 +COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01001410 + SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01001420 + SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01001430 + STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01001440 + VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01001450 + VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01001460 + XREF = OPTIONWORD.[XREFBIT:1] #, 01001461 + BEND = OPTIONWORD.[BENDBIT:1] #, 01001462 + CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, 01001463 + DUMMY = #; 01001470 +BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01001480 +BOOLEAN NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01001490 +BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01001500 + % LAST CARD FROM SYMBOLIC LIBRARY READ 01001510 + % IS PATCHED FROM THE CARD READER. 01001520 +INTEGER XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01001530 +BOOLEAN DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01001540 +INTEGER ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01001550 +BOOLEAN SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01001560 +BOOLEAN LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01001570 +ALPHA MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01001580 +INTEGER MYCLASS; % USED IN DOLLARCARD EVALUATION. 01001590 +REAL BATMAN; % USED IN DOLLARCARD EVALUATION. 01001600 + ARRAY SPECIAL[0:31]; 01003000 + COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000 + CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000 + SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000 + ARRAY INFO[0:31,0:255]; 01007000 +%***********************************************************************01007005 +% X R E F S T U F F 01007010 +%***********************************************************************01007015 +% 01007020 +ARRAY 01007025 + XREFAY2[0:29], % ARRAY OF ONE WORD REFERENCE RECORDS. 01007030 + % THE LAYOUT OF EACH WORD IS 01007035 + % 01007040 + % .[1:5] TYPE OF REFERENCE 01007045 + % = 0 FOR FORWARD DECL 01007050 + % = 1 FOR LABEL OCCURENCE 01007051 + % = 2 FOR NORMAL DECL 01007055 + % = 4 FOR NORMAL REFERENCE 01007060 + % = 5 FOR ASSIGNMENT 01007065 + % 01007070 + % NOTE: THE LOWER ORDER BIT 01007075 + % OF THIS FIELD IS ON 01007080 + % IF YOU WANT STARS 01007085 + % AROUND THIS REFERENCE 01007090 + % IN THE XREF 01007095 + % 01007100 + % .[6:15] IDENTIFIER ID. NO. 01007105 + % THIS IS A UNIQUE NUMBER THAT 01007110 + % IS ASSIGNED WHEN THE 01007115 + % IDENTIFIER IS ENCOUNTERE 01007120 + % FOR THE FIRST TIME. 01007125 + % 01007130 + % .[21:27] SEQUENCE NUMBER 01007135 + % 01007140 + XREFAY1[0:9], % RECORD BUFFER AREA FOR WRITING OUT THE 01007145 + % NAME INFORMATION RECORDS, ONE RECORD 01007150 + % IS WRITTEN FOR EACH IDENTIFIER IN THE SYMBOL 01007155 + % TABLE WHEN THE IDENTIFIER IS PURGED FROM THE 01007160 + % SYMBOL TABLE, I.E., WHEN LEAVING THE BLOCK 01007165 + % IN WHICH THE IDENTIFIER IS DECLARED. 01007170 + % 01007175 + % THE LAYOUT OF EACH IS: 01007180 + % 01007185 + % WORDS 0-7 THE IDENTIFIER WITH BLANK 01007190 + % FILE ON THE RIGHT 01007195 + % 01007200 + % WORD 8 01007205 + % .[21:12] SEGMENT NUMBER IN WHICH 01007210 + % THIS IDENTIFIER WAS DECLARED01007215 + % 01007220 + % .[33:15] IDENTIFIER ID. NO. 01007225 + % 01007230 + % WORD 9 ELBAT WORD 01007235 + % 01007240 + XINFO[0:31,0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 01007245 + % IN THE INFO TABLE. IF YOU HAVE THE INDEX 01007250 + % OF THE ELBAT WORD FOR AN IDENTIFIER IN 01007255 + % THE INFO TABLE YOU CAN FIND THE XINFO WORD 01007260 + % FOR THE IDENTIFIER BY REFERRING TO: 01007265 + % 01007270 + % XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] 01007275 + % 01007280 + % EACH ENTRY CONTAINS: 01007285 + % 01007290 + % .[21:12] SEGMENT NUMBER IN WHICH 01007295 + % THIS IDENTIFIER WAS DECL01007300 + % 01007305 + % .[33:15] IDENTIFIER ID. NO. 01007310 + % IF THIS ID. NO. IS ZERO 01007315 + % THEN XREF WAS NOT ON 01007320 + % AT THE TIME THE IDENT 01007325 + % WAS DECLARED AND ALL 01007330 + % FUTURE REFERENCES WILL 01007335 + % BE DISCARDED. 01007340 + % 01007345 +INTEGER % 01007350 + XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN 01007355 + % XREFAY2, WHEN THIS BECOMES GREATER 01007360 + % THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365 + % AND XREFPT IS RESET TO ZERO. 01007370 + % 01007375 + XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF 01007380 + % ID. NO. TO IDENTIFIERS. IT IS INCREMENTED 01007385 + % EACH TIME A NEW IDENTIFIER IS ENCOUNTERED. 01007390 + % 01007395 +DEFINE % 01007400 + SEGNOF = [21:12]#, % FIELDS IN XINFO ENTRIES AND WORD 8 OF 01007405 + IDNOF = [33:15]#, % IDENTIFIER RECORDS. 01007410 + % 01007415 + TYPEREF = [1:5]#, % FIELDS OF REFERENCE WORDS 01007420 + REFIDNOF =[6:15]#, % 01007425 + SEQNOF = [21:27]#, % 01007430 + % 01007435 + XREFIT(INDEX,SEQNO,REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE 01007440 + BEGIN IF XREF THEN CROSSREFIT(INDEX,SEQNO,REFTYPE); END#, 01007445 + % 01007450 + XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 01007455 + BEGIN IF XREF THEN XREFAY2[XREFPT-1].TYPEREF := REFTYPE END#, 01007460 + % 01007465 + XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER01007470 + BEGIN IF DEFINING.[1:1] THEN CROSSREFDUMP(INDEX); END#, 01007475 + % 01007480 + XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO 01007481 + XINFO[(INDEX).LINKR,(INDEX).LINKC DIV 2]#, % XINFO ROW AND COL 01007482 + % 01007483 + FORWARDREF = 0#, % DEFINES FOR DIFFERENT REFERENCE TYPES 01007485 + LBLREF = 1#, % 01007486 + DECLREF = 2#, % 01007490 + NORMALREF = 4#, % 01007495 + ASSIGNREF = 5#; % 01007500120324PK + ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600 + BOOLEAN DEFINING; 01007650 + COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 + OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000 + THE INTERNAL CODE (OR ELBAT WORD AS IT IS USUALLY 01010000 + CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000 + [1:1]) FOR PROCEDURES. THE LINK TO PREVIOUS ENTRY (IN 01012000 + [4:8]). THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000 + TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 01014000 + SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000 + FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000 + AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLUT ACROSS A ROW 01017000 + OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000 + RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000 + DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000 + IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000 + OF CHARACTORS AND 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 + A[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000 + POINTS TO A. 01066000 + THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000 + FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000 + FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL 01069000 + FULL DECLARATION. 01070000 + PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000 + INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBSTRACTED 01072000 + FROM THE CURRENT ENTRY INDEX. 01073000 + [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY,(<64) 01074000 + [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000 + AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000 + THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000 + THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000 + FOR X WOULD APPEAR AS FOLLOWS: 01079000 + INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000 + I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000 + I+2 = L 01082000 + I+3 = ELBATWRD (MADE FOR X) 01083000 + I+4 = O31X 01084000 + THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000 + THE ENTRY BEFORE SYMBOL, AND 01086000 + INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000 + ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000 + THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000 + FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000 + NECESSARY. 01091000 + THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000 + REAL 01093000 + BOOLEAN 01094000 + INTEGER 01095000 + ALPHA 01096000 + FILE 01097000 + FORMAT 01098000 + LIST 01099000 + OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000 + ARRAYS: 01101000 + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000 + DIMENSIONS(IN THE LOW ORDER PART).[40:8] 01103000 + EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000 + BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000 + THESE WORDS ARE MADE UP AS FOLLOWS: 01106000 + [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000 + SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000 + RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000 + TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000 + SUBTRACTED. 01111000 + [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000 + REQUIRES A PRT OR STACK CELL.OTHERWISE THE BIT 01113000 + 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000 + REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000 + [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000 + IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000 + PROCEDURES: 01118000 + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000 + PARAMETERS [40:8] 01120000 + IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000 + [13:11] ENDING PRT ADDRESS FOR LABELS. 01122000 + [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000 + OF LOCALS. 01124000 + SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000 + OF APPEARANCE IN FORMAL PARAPART) ARE 01126000 + ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000 + VALUE OR NOT([10:1]). 01128000 + THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000 + IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000 + CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 01131000 + LINK([35:13]) IS MEANINGLESS. 01132000 + IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 01133000 + THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000 + IS DONE IN THE STREAM PROCEDURE. 01135000 + LABELS: 01136000 + AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000 + BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000 + IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000 + LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000 + 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000 + SWITCHES: 01142000 + THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000 + ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000 + IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000 + NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000 + DEFINE MON =[ 1: 1]#, 01147000 + CLASS =[ 2: 7]#, 01148000 + FORMAL=[ 9: 1]#, 01149000 + VO =[10: 1]#, 01150000 + LVL =[11: 5]#, 01151000 + ADDRESS=[16:11]#, 01152000 + INCR =[27: 8]#, 01153000 + LINK =[35:13]#, 01154000 + DYNAM =[11:16]#, 01154100 + SBITF =[21:6]#, % STARTING BIT FOR FIELD ID. 01154200 + NBITF =[27:6]#, % NUMBER OF BITS FOR FIELD ID. 01154300 + LINKR =[35: 5]#, 01155000 + LINKC =[40: 8]#; 01156000 + COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD, 01157000 + MON IS THE BIT WHICH IS TURNED ON IF: 01158000 + 1. THE QUANTITY IS TO BE MONITORED, OR 01158100 + 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200 + A DEFINE WITHOUT PARAMETERS. 01158300 + CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000 + QUANTITY. 01160000 + FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000 + PARAMETER. 01162000 + V0 IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000 + DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000 + FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000 + FROM OTHERS. 01166000 + LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000 + ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000 + DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100 + DEFINE PARAMETER ENTRIES, ONLY, IT IS AN INDEX 01168200 + INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300 + THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400 + DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500 + NOT USE THE LVL FIELD, BUT MAKES USE OF NINF00 01168600 + INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION 01169000 + NEEDED, RELATIVE TO THE LOCATION IN INFO. 01170000 + LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE 01171000 + QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE 01172000 + NEXT ITEM IN THE STACK, ZERO IS AN END FLAG. 01173000 + LINKR AND LINKC ARE SUBDIVISIONS OF LINK.; 01174000 + COMMENT CLASSES FOR ALL QUANTITIES - OCTAL CLASS IS IN COMMENT; 01175000 + COMMENT CLASSES FOR IDENTIFIERS; 01176000 + DEFINE UNKNOWNID =00#, COMMENT 000; 01177000 + STLABID =01#, COMMENT 001; 01178000 + LOCLID =02#, COMMENT 002; 01179000 + DEFINEID =03#, COMMENT 003; 01180000 + LISTID =04#, COMMENT 004; 01181000 + FRMTID =05#, COMMENT 005; 01182000 + SUPERFRMTID =06#, COMMENT 006; 01183000 + FILEID =07#, COMMENT 006; 01184000 + SUPERFILEID =08#, COMMENT 007; 01185000 + SWITCHID =09#, COMMENT 011; 01186000 + PROCID =10#, COMMENT 012; 01187000 + INTRNSICPROCID =11#, COMMENT 013; 01188000 + STRPROCID =12#, COMMENT 014; 01189000 + BOOSTRPROCID =13#, COMMENT 015; 01190000 + REALSTRPROCID =14#, COMMENT 016; 01191000 + ALFASTRPROCID =15#, COMMENT 017; 01192000 + INTSTRPROCID =16#, COMMENT 020; 01193000 + BOOPROCID =17#, COMMENT 021; 01194000 + REALPROCID =18#, COMMENT 022; 01195000 + ALFAPROCID =19#, COMMENT 023; 01196000 + INTPROCID =20#, COMMENT 024; 01197000 + BOOID =21#, COMMENT 025; 01198000 + REALID =22#, COMMENT 026; 01199000 + ALFAID =23#, COMMENT 027; 01200000 + INTID =24#, COMMENT 030; 01201000 + BOOARRAYID =25#, COMMENT 031; 01202000 + REALARAYID =26#, COMMENT 032; 01203000 + ALFARRAYID =27#, COMMENT 033; 01204000 + INTARRAYID =28#, COMMENT 034; 01205000 + LABELID =29#, COMMENT 035; 01206000 + COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000 + TRUTHV =30#, COMMENT 036; 01208000 + NONLITNO =31#, COMMENT 037; 01209000 + LITNO =32#, COMMENT 040; 01210000 + STRNGCON =33#, COMMENT 041; 01211000 + LEFTPAREN =34#, COMMENT 042; 01212000 + COMMENT CLASSES FOR ALL DECLARATORS; 01213000 + DECLARATORS =35#, COMMENT 043; 01214000 + COMMENT CLASSES FOR STATEMENT BEGINNERS; 01215000120324PK + READV =36#, COMMENT 044; 01216000 + WRITEV =37#, COMMENT 045; 01217000 + SPACEV =38#, COMMENT 046; 01218000 + CLOSEV =39#, COMMENT 047; 01219000 + LOCKV =40#, COMMENT 050; 01220000 + REWINDV =41#, COMMENT 051; 01221000 + DOUBLEV =42#, COMMENT 052; 01222000 + FORV =43#, COMMENT 053; 01223000 + WHILEV =44#, COMMENT 054; 01224000 + DOV =45#, COMMENT 055; 01225000 + UNTILV =46#, COMMENT 056; 01226000 + ELSEV =47#, COMMENT 057; 01227000 + ENDV =48#, COMMENT 060; 01228000 + FILLV =49#, COMMENT 061; 01229000 + SEMICOLON =50#, COMMENT 062; 01230000 + IFV =51#, COMMENT 063; 01231000 + GOV =52#, COMMENT 064; 01232000 + RELEASEV =53#, COMMENT 065; 01233000 + BEGINV =54#, COMMENT 066; 01234000 + COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000 + SIV =55#, COMMENT 067; 01236000 + DIQ =56#, COMMENT 070; 01237000 + CIV =57#, COMMENT 071; 01238000 + TALLYV =58#, COMMENT 072; 01239000 + DSV =59#, COMMENT 073; 01240000 + SKIPV =60#, COMMENT 074; 01241000 + JUMPV =61#, COMMENT 075; 01242000 + DBV =62#, COMMENT 076; 01243000 + SBV =63#, COMMENT 077; 01244000 + TOGGLEV =64#, COMMENT 100; 01245000 + SCV =65#, COMMENT 101; 01246000 + LOCV =66#, COMMENT 102; 01247000 + DCV =67#, COMMENT 103; 01248000 + LOCALV =68#, COMMENT 104; 01249000 + LITV =69#, COMMENT 105; 01250000 + TRNSFER =70#, COMMENT 106; 01251000 + COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000 + COMMENTV =71#, COMMENT 107; 01253000 + FORWARDV =72#, COMMENT 110; 01254000 + STEPV =73#, COMMENT 111; 01255000 + THENV =74#, COMMENT 112; 01256000 + TOV =75#, COMMENT 113; 01257000 + VALUEV =76#, COMMENT 114; 01258000 + WITHV =77#, COMMENT 115; 01259000 + COLON =78#, COMMENT 116; 01260000 + COMMA =79#, COMMENT 117; 01261000 + CROSSHATCH =80#, COMMENT 120; 01262000 + LFTBRKET =81#, COMMENT 121; 01263000 + PERIOD =82#, COMMENT 122; 01264000 + RTBRKET =83#, COMMENT 123; 01265000 + RTPAREN =84#, COMMENT 124; 01266000 + COMMENT CLASSES FOR OPERATORS; 01267000 + NOTOP =85#, COMMENT 125; 01268000 + ASSIGNOP =86#, COMMENT 126; 01269000 + AMPERSAND =87#, COMMENT 127; 01270000 + EQVOP =88#, COMMENT 130; 01271000 + IMPOP =89#, COMMENT 131; 01272000 + OROP =90#, COMMENT 132; 01273000 + ANDOP =91#, COMMENT 133; 01274000 + RELOP =92#, COMMENT 134; 01275000 + ADOP =93#, COMMENT 135; 01276000 + MULOP =94#, COMMENT 136; 01277000 + FACTOP =95#, COMMENT 137; 01278000 + STRING =99#, COMMENT 143; 01278050 + FIELDID =125#, COMMENT 175; 01278090 + FAULTID =126#, COMMENT 176; 01278100 + SUPERLISTID =127#, COMMENT 177; 01278500 + COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000 + OWNV =01#, COMMENT 01; 01280000 + SAVEV =02#, COMMENT 02; 01281000 + BOOV =03#, COMMENT 03; 01282000 + REALV =04#, COMMENT 04; 01283000 + ALFAV =05#, COMMENT 05; 01284000 + INTV =06#, COMMENT 06; 01285000 + LABELV =07#, COMMENT 07; 01286000 + DUMPV =08#, COMMENT 10; 01287000 + LISTV =09#, COMMENT 11; 01288000 + OUTV =10#, COMMENT 12; 01289000 + INV =11#, COMMENT 13; 01290000 + MONITORV =12#, COMMENT 14; 01291000 + SWITCHV =13#, COMMENT 15; 01292000 + PROCV =14#, COMMENT 16; 01293000 + ARRAYV =15#, COMMENT 17; 01294000 + FORMATV =16#, COMMENT 20; 01295000 + FILEV =17#, COMMENT 21; 01296000 + STREAMV =18#, COMMENT 22; 01297000 + DEFINEV =19#, COMMENT 23; 01298000 + AUXMEMV =20#, COMMENT 24; 01298500 + FIELDV =21#; COMMENT 25; 01298600 +DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000 + REAL TIME1; 01300000 + INTEGER SCRAM; 01301000 + COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000 + OR RESERVED WORD SCANNED; 01303000 +ARRAY FILEATTRIBUTES[0:30] ; 01303500 + ALPHA ARRAY ACCUM[0:10]; 01304000 + COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000 + SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000 + IN INFO. THAT IS 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]; 01310000 + COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX 01311000 + POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A 01311100 + LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, 01311200 + BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS 01311300 + AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE 01311400 + WORDS POINTED TO (IN THREE GROUPS) ARE: 01311500 + 1) ALPHA, LABEL, OWN, REAL, SAVE 01311600 + 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE 01311700 + 3) BEGIN, DO, ELSE, END, FOR, GO, IF, 01311800 + STEP, THEN, TO, UNTIL, WHILE, WRITE. 01311900 + FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE 01312000 + COMMENTS IN THE TABLE PROCEDURE. ; 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:76]; INTEGER I,NEXTELBT; 01319000 + COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000 + QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000 + (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000 + GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000 + FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000 + POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000 + INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000 + FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000 + INTEGER ELCLASS; 01328000 + COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000 + INTEGER LASTELCLASS; 01329100 + COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200 + INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000 + INTEGER MAXTCLR; 01331000 + COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST 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 + INTEGER GTIX; 01339050 + ARRAY TEN[0:69]; 01340000 + INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050 + DECLARED IN THE OBJECT PROGRAM; 01340060 + INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070 + GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080 + REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500 + INTEGER IDLOC,IDLOCTEMP; 01341000 + ARRAY PDPRT[0:31,0:63]; 01342000 + COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000 + IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000 + BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000 + OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000 + TYPE 1 ENTRY 01347000 + BIT POSITION KIND OF ENTRY 01348000 + 0-3 ZERO 01349000 + 4 MODE BIT(1=CHAR 0=WORD) 01350000 + 5 ARGUMENT BIT 01351000 + 6-7 ZERO 01352000 + 8-17 RELATIVE ADDRESS IN PRT 01353000 + 18-27 RELATIVE ADDRESS IN SEGMENT 01354000 + 28-37 SEGMENT NUMBER 01355000 + 38-47 ZERO 01356000 + TYPE 2 ENTRY 01357000 + BIT POSITION KIND OF ENTRY 01358000 + 0 EMPTY 01359000 + 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000 + 2 ON IFF INTRINSIC PROCEDURE 01361000 + 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050 + 4-12 EMPTY 01361100 + 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200 + 28-37 SEGMENT NUMBER 01361300 + 38-47 NUMBER OF WORDS IN SEGMENT 01362000 + THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000 + IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000 + ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000 + DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000 + IS READY FOR OUTPUT; 01367000 +COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010 + COMPILATION IS AS FOLLOWS: 01367020 + SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030 + BIT POSITIONS CONTENTS OF FIELD 01367040 + [0:1] EMPTY 01367050 + [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060 + [2:1] ON IFF INTRINSIC PROCEDURE 01367070 + [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075 + [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080 + [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085 + [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 01367090 + [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100 + [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110 + PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120 + BIT POSITIONS CONTENTS OF FIELD 01367130 + [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. IDBITS 01367140 + [4:2] MODE AND ARGUMENT BITS 01367150 + [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160 + [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170 + PRT ENTRY FOR SEGMENT I 01367180 + [18:15] I 01367190 + [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200 +COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210 + WORD CONTENTS 01367220 + 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230 + 1 SIZE OF SEGMENT DICTIONARY 01367240 + 2 RELATIVE LOCATION OF PRT 01367250 + 3 SIZE OF PRT 01367260 + 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270 + 5 SIZE OF FILE PARAMETER BLOCK 01367280 + 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290 + 7 N 01367300 + . O U 01367310 + . T S 01367320 + . E 01367330 + 29 D; 01367340 +INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000 +INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000 +INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000 + ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000 + COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000 + AS SPECIFIED BY "L". 01373000 + IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 01374000 + THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 01375000 + REAL LASTENTRY ; 01376000 + COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 01377000 + INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 01378000 + BOOLEAN MRCLEAN ; 01379000 + COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000 + FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000 + POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000 + DURING AN ARRAY DECLARATION ; 01383000 + REAL GT1,GT2,GT3,GT4,GT5; 01384000 + INTEGER GTI1; 01384500 + COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000 + INTEGER RESULT; 01386000 + COMMENT THIS VARIALE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000 + ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000 + VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000 + USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000 + INTEGER LASTUSED; 01391000 + COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000 + READACARD. THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000 + OR PREPARES THE CARD FOR THE SCANNER. 01394000 + LASTUSED LAST CARD READ FROM 01394500 + -------- ------------------- 01394600 + 1 CARD READ ONLY, NO TAPE. 01395000 + 2 CARD READER, TAPE AND CARD MERGE. 01396000 + 3 TAPE, TAPE AND CARD MERGE. 01397000 + 4 INITIALIZATION ONLY, CARD ONLY. 01398000 + 5 CARD READER - MAKCAST, MERGING. 01398100 + 6 TAPE - MAKCAST, MERGING. 01398200 + ; 01398300 + BOOLEAN LINKTOG; 01399000 + COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK. 01400000 + OTHERWISE IT IS TRUE; 01401000 + INTEGER LEVEL,FRSTLEVEL,SUBLEVEL,MODE; 01402000 + COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 01403000 + TRACK OF LEVELS OF DEFINITION. LEVEL GIVES THE DEPTH OF 01404000 + NESTING IN DEFINITION. WHERE EACH BLOCK AND EACH PROCEDURE01405000 + GIVES RISE TO A NEW LEVEL. SUBLEVEL GIVES THE LEVEL OF 01406000 + THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 01407000 + FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST 01408000 + GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED. MODE 01409000 + IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000 + NESTED (AT COMPILE TIME); 01411000 + INTEGER AUXMEMREQ; 01411010 + BOOLEAN SAVEPRTOG; 01411020 + COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030 + ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040 + AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050 + WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060 + "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070 + TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080 + TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090 + ROUTINE IS "PSEUDO-SAVE". 01411100 + ; 01411110 + BOOLEAN ERRORTOG; 01412000 + COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000 + ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000 +BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000 + COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000 +BOOLEAN STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500 + % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000 + % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500 + % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000 + % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500 + % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000 +DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000 + FI = 6#, FIO = 7#; 01420500 + COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 01421000 + THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000 + THEIR MEANING IS: 01423000 + FS MEANS FROM STATEMENT. 01424000 + FP MEANS FROM PRIMARY. 01425000 + FL MEANS FROM LIST. 01426000 + FR MEANS FROM FOR. 01427000 + FIO MEANS FROM IODEC. 01427250 + FA MEANS FROM ACTUALPARAPART. 01427500 + FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600 + INTEGER L; 01428000 + COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000 + DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#; 01430000 + COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000 + PROGRAMS. 01432000 + BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000 + BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000 + IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000 + BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T301436000 + INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 01437000 + JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 01438000 + IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 01439000 + THINGS ON THE TOP OF THE STACK. 01440000 + XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 01441000 + WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 01442000 + USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 01443000 + THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE01444000 + STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 01445000 + LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 01446000 + THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 01447000 + BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW, THIS CARRIES YOU 01448000 + TO THE 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 BLOCK 01460000 + AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000 + BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000 + SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000 + MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000 + OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED 01465000 + IF LEVEL = JUMPCTR; 01466000 +BOOLEAN GOTOG; 01467000 + COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 01468000 + LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000 + MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000 +REAL STLB; 01471000 + COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000 + THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000 + ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000 + INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000 + FOR TEMPORARY STORAGE; 01476000 +DEFINE BUMPL = L~L+2#; 01477000 + COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000 +DEFINE IDMAX = LABELID#; 01479000 + COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000 +INTEGER DEFINECTR,DEFINEINDEX; 01481000 +ALPHA ARRAY DEFINFO[0:89]; 01481100 +ALPHA ARRAY TEXT[0:31,0:255]; 01481200 +INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300 +INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400 + REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000 + LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000 + NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS; 01484000 + JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000 + COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000 + ARRAY MACRO[0:35]; 01487000 + COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000 +REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000 + Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000 +SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000 + COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000 + DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS. 01493000 + THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000 + TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000 + THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000 + ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000 + THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000 +INTEGER BEGINCTR; 01499000 + COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED 01500000 + FOR ERROR CONTROL ONLY; 01501000 +INTEGER DIALA,DIALB; 01502000 + COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000 + DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000 + WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY 01505000 + BY SETTING DIALA AND DIALB TO ZERO; 01506000 + 01507000 + 01508000 + 01509000 + 01510000 + 01511000 + 01512000 + 01513000 + 01514000 + 01515000 + 01516000 + 01517000 + 01518000 + 01519000 + 01520000 + 01521000 +BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000 + SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000 + COMMENT AT RR1; 01524000 + BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000 +DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000 + THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000 + THE FIRST WORD OF ADDITIONAL INFO; 01528000 +DEFINE SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000 + THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000 + INFO FOR MONITORED SIMPLE VARIABLES; 01531000 +DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000 + FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000 + IN NODIMPART; 01534000 +DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01536000 + INFO THAT CONTAINS THE MONITOR FILE 01537000 + ADDRESS FOR LABELS; 01538000 +DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01540000 + INFO THAT CONTAINS THE MONITOR FILE 01541000 + ADDRESS FOR LABELS; 01542000 +DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000 + POSITION IN THE FIRST WORD OF ADDITIONAL 01544000 + INFO THAT CONTAINS THE MONITOR FILE 01545000 + ADDRESS FOR LABELS; 01546000 +DEFINE DUMPEE = [2:11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000 + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000 + THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000 + EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000 + APPEARS IN A DUMP DECLARATION; 01551000 +DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000 + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000 + THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000 + FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000 + THE PRINTI ROUTINE; 01556000 + DEFINE CHUNK = 180#; 01556100 + FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200 + FILE IN CARD (RR1,10,RR2); 01557000 + SAVE 01558000 + FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000 + ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010 +INTEGER DA; 01559020 + SAVE FILE OUT NEWTAPE DISK SERIAL [20:2400] (RR5,RR6,RR7,SAVE 1); 01560000 + FILE IN TAPE "OCRDIMG" (2,RR8,RR9); 01561000 + SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005 + COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010 + FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020 + FILE IN CASTB(1,BUFFSIZE); 01561030 + FILE IN CASTC(1,BUFFSIZE); 01561040 + SWITCH FILE LIBRARY~CASTA,CASTB,CASTC; 01561050 + FILE OUT REMOTE 19 (2,10); 01561055 +SAVE ARRAY CBUF,TBUFF[0:9]; % INPUT BUFFERS. 01561056 +BOOLEAN REMOTEG; 01561060 +ARRAY LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 01561065 + % TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070 + % EACH ENTRY CONSISTS OF THREE WORDS CONTAINING: 01561080 + FILE DSK1 DISK SERIAL [20:816](2,10,30); 01561085 + FILE DSK2 DISK SERIAL [20:450](2,30,30); 01561087 + DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090 + NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100 + DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110 + INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120 + COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 01561130 + INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140 + LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150 + MAXTLCR USED IN READACARD, FILEINX IS THE 01561160 + LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 01561170 + SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180 + FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190 + REAL RECOUNT,FINISHPT; 01561200 + BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202 + PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204 + BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206 + CARD READER ELSE FALSE; 01561208 + COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210 + BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215 + OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217 + DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220 + BLOCKS PER LIBRARY TAPE; 01561230 + ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240 + DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250 + A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260 + B: 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 THE ITEM D WILL FOLLOW INDICATING THE 01561360 + LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370 + ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380 + BLOCK. 01561390 + IN ORDER TO CHANGE: 01561400 + NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410 + 01561020 - 01561050. 01561420 + - CHANGE "3" AT 01561430 + NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440 + AT ; 01561450 +DEFINE 01561500 + INSERTMAX = 20#, % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 01561510 + INSERTCOP = INSERTINFO[INSERTDEPTH,4]#, % = 1 IF COPY TO NEWTAPE 01561520 + INSERTMID = INSERTINFO[INSERTDEPTH,0]#, % MFID OF THE LIBRARY FILE 01561530 + INSERTFID = INSERTINFO[INSERTDEPTH,1]#, % FID OF THE LIBRARY FILE 01561540 + INSERTINX = INSERTINFO[INSERTDEPTH,2]#, % POINTER TO THE RECORD 01561550 + INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#; % LAST SEQUENCE TO BE INCLUD01561560120324PK +INTEGER SAVECARD, INSERTDEPTH; 01561570 +ARRAY INSERTINFO[0:INSERTMAX,0:4]; 01561580 +FILE LIBRARYFIL DISK RANDOM(2,10,30); 01561590 +DEFINE LF = LIBRARYFIL#; 01561600 +SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER 01561610 +REAL STREAM PROCEDURE CMPD(A,B); 01561620 + BEGIN 01561630 + SI:=A; DI:=B; 01561640 + IF 8 SC } DC THEN 01561650 + BEGIN 01561660 + SI:=SI-8; DI=DI-8; TALLY:=2; 01561670 + IF 8 SC = DC THEN TALLY:=1; 01561680 + END; 01561690 + CMPD:=TALLY; 01561700 + END CMPD; 01561710 + REAL C; 01562000 + COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000 + REAL T; 01564000 + COMMENT T IS A TEMPORARY CELL; 01565000 + INTEGER TCOUNT; 01566000 + COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000 + FOR THE USE OF CONVERT; 01568000 + REAL STACKCT; 01568500 + DEFINE LOGI =443#, 01569000 + EXPI =440#, 01570000 + XTOTHEI =480#, 01571000 + GOTOSOLVER =484#, 01572000 + PRINTI =477#, 01573000 + MERGEI =500#, 01573100 + POWERSOFTEN =670#, 01574000 + LASTSEQUENCE =166#, 01575000 + LASTSEQROW = 2#, 01576000 + INTERPTO =461#, 01577000 + SUPERMOVER =555#, 01577500 + CHARI =465#, 01578000 + INTERPTI =469#, 01579000 + SORTI =473#, 01579100 + DIALER =559#, 01579200 + FILEATTINT =563#, 01579300 + POWERALL =567#, 01579350 + SPECIALMATH =570#, 01579355 + SORTA =673#; 01580000120324PK + 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; 01589000120324PK + P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500 + VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000 + FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000 + PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000 +SPECTOG, 01593000 + STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000 + ONE ID AND THEN EIXT; 01595000 + AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000 +BOOLEAN STOPDEFINE; 01597000 +REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100 +INTEGER MAXSAVE; 01598000 + COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000 + DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000 + FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000 + REAL 01602000 + KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000 + ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000 + LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000 + LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000 + INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000 + PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000 + DECLARED; 01609000 + G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000 + TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000 + BEING DECLARED; 01612000 + PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000 + DECLARED; 01614000 + MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000 + OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000 + PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000 + J, COMMENT ARRAY COUNTER; 01618000 + LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000 + NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000 + GLOBALNINFOO,COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 01620100 + GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 01620200 + CAN CHECK FOR DUPLICATE DECLARATIONS; 01620300 + OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; 01620400 + FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000 + IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000 + SAVEL, COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000 +INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000 + ENTERED IN INFO AT ANY GIVEN TIME; 01625000 + REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100 +PROCEDURE UNHOOK;FORWARD; 01626000 +PROCEDURE MAKEUPACCUM;FORWARD; 01627000 +DEFINE PURPT=[4:8]#,SECRET=2#; 01628000 + COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000 + NUMBERS REFERS TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE01630000 + FULL NAME IS ALSO GIVEN; 01631000 +$RESET NEATUP 01631100120324PK + 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; 01642000 + DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000 + EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000 + LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000 + LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000 + GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000 + LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000 + LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000 + GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000 + IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000 + INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000 + ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000 + ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000 + LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000 + LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000 + LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000 + LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000 + LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000 + LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 01660000 + LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000 + MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100 + MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000 + MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000 + NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000 + NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000 + PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000 + PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000 + RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000 + RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000 + RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000 + SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000 + SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100 + SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000 + STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000 + SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000 + XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000 + XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000 + ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000 + COMMENT THESE DEFINES ARE USED BY EMITD; 01678000 + DEFINE 01679000 + DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000 + DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000 + TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000 +$SET NEATUP 01682100120324PK +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 EDOCINDEX = L.[36:3],L.[39:7]#; COMMENT EDOCINDEX IS THE WORD 01710000 + PORTION OF L SPLIT INTO A ROW AND01711000 + COLUMN INDEX FOR EDOC; 01712000 +DEFINE CPLUS1 = 769#; COMMENT SEE COMMENT AT CPLUS2 DEFINE; 01713000 +DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000 + USED IN THE GENERATION OF C-RELATIVE CODE; 01715000 + PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01716000 + ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD; 01717000 + BOOLEAN MACROID; 01717800 + REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900 + PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950 + PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000 + REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100 + PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200 + INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000 + BOOLEAN LISTMODE; 01720000 + COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000 + IS BEING GENERATED OR A STATEMENT; 01722000 + INTEGER LSTR; 01723000 + COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000 + USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000 + PROCEDURE SCANNER; FORWARD; 01730000 + COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 01732000 + REAL STREAM PROCEDURE MKABS(A); 01733000 + BEGIN DI ~ A; MKABS ~ DI END MKABS; 01734000 + STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000 + BEGIN LOCAL T; 01736000 + SI~LOC W; DI~LOC T; SI~SI+6; DI~DI+7; DS~CHR; 01736100 + SI~A; DI~B; T(DS~32 WDS; DS~32 WDS); DS~W WDS; 01736200 + END MOVE; 01736300 + STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000 + VALUE NDIV32,NMOD32 ; 01737050 + BEGIN DI := DEST; 01737100 + NDIV32(32(DS :=8 LIT"0")); 01737150 + NMOD32(DS := 8 LIT"0"); 01737200 + END; 01737250 +COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 01737300 +STREAM PROCEDURE BLANKET(N,THERE); VALUE N; 01737350 + BEGIN 01737400 + DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS; 01737450 + END BLANKET; 01737500 + 01738000 + 01739000 + 01740000 + PROCEDURE STEPIT; FORWARD; 01741000 + COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100 + STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200 + BEGIN 01741300 + DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400 + END; 01741500 +STREAM PROCEDURE SEQUENCEWARNING(L); 01742100 + BEGIN DI:=L; DI:=DI-8; DS:=24 LIT "SEQUENCE WARNING<<<<<<<<"; END; 01742110 + BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200 + COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300 + TRUE IF ANY VISIBLE CHARACTER ; 01742400 + BEGIN 01742500 + LABEL NED; 01742600 + SI~FCR; 01742700 + TALLY~0; 01742800 + 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900 + TALLY~63; 01743000 + NED: TALLY~TALLY+1; 01743100 + NONBLANK~TALLY 01743200 + END NONBLANK; 01743300 + INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE-- 01750000 + GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000 + FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000 + BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000 + ABOUT FAULTLEVEL; 01754000 + INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000 +STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR,SEQ); VALUE NCR; 01756000 + BEGIN 01757000 + LABEL L,TRANS; 01758000 + LOCAL N; 01759000 + SI:=SEQ; DI:=LCR; DI:=DI-1; DS:=LIT"%"; % PUT "%" IN CC 72. 01759100 + DS:=WDS; % RESTORE SEQ. NO. FOR $VOID(T) CARDS. 01759200 + SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000 + SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000 + 2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000 + SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-80. 01763000 +L: 01764000 + IF SC=""" THEN 01765000 + BEGIN 01766000 + SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN 01767000 + NCR:=SI; % TEMP, STORAGE. SINCE NCR IS "LOCAL" TO GETVOID. 01768000 + 8(IF SC=""" THEN JUMP OUT ELSE 01769000 + BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01770000 + END 01771000 + ELSE BEGIN 01772000 + NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01773000 + DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN 01774000 + 8(IF SC=" " THEN JUMP OUT ELSE 01775000 + BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01776000 + END; 01777000 +TRANS: 01778000 + SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000 + SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000 + N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000 + DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000 + DI:=VR; SI:=LOC VP; DS:=WDS; % ADDRESS OF VOID RANGE. 01783000 + END OF GETVOID; 01784000 +REAL VOIDCR,VOIDPLACE; 01785000 +BOOLEAN SORTMERGETOG; 01786000 +$RESET NEATUP 01786100120324PK + FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000 + PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000 + BUG(X24,4(A4,X2)); 01802000 +$SET NEATUP 01802100120324PK +PROCEDURE DATIME; 01820000 + BEGIN 01821000 + INTEGER H,MIN,Q; ALPHA N1,N2; 01822000 + ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE; 01823000 + BEGIN 01824000 + DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2; 01825000 + 2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR; 01826000 + END OF DATER; 01827000 + H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60; 01828000 + N1:=CODE.MFID; N2:=CODE.FID; 01828500 + WRITE(LINE, 01829000 +$RESET NEATUP 01829100120324PK + $ SET OMIT = NOT ALGOL 01829900 +"XVI.0.122" 01831000 + ," ",A6,"DAY, ",O,", ",I2,":",A2,X1,A3, 01832000 + ////X45,A1,A6,"/",A1,A6,/X45,15("=")//>, 01832500 + TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000 + Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000 + IF H}12THEN "PM." ELSE "AM.", 01835000 + N1.[6:6],N1,N2.[6:6],N2); 01835500 +$SET NEATUP 01835550120324PK + IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. 01835600 + WRITE(LINE,, 01835700 + (N1:=TAPE.MFID).[6:6],N1,(N2:=TAPE.FID).[6:6],N2); 01835800 + NOHEADING:=FALSE; 01836000 + END OF DATIME; 01837000 + DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000 + COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000 + AND SCANNING THEM; 02001000 + BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020 + VALUE ROW ; 02001030 + BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040 + REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050 + ; 02001060 + LOCAL DPPOS,TEMP,LGTH; 02001070 + LABEL LOOP,EXIT; 02001080 + SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090 + DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100 + SI~SI+8; 02001110 + LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120 + DI~ACC1; DI~DI+2; SI~SI-1; 02001130 + IF SC = DC 02001140 + THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150 + IF LGTH SC = DC 02001160 + THEN BEGIN COMMENT FOUND IT; 02001170 + DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180 + IF SC = "0" 02001190 + THEN BEGIN COMMENT WE MAY BE IN THE02001200 + WRONG ROW; 02001210 + SI~SI+1;DI~LOC LOOK; 02001220 + IF 3 SC = DC 02001230 + THEN BEGIN COMMENT WE ARE02001240 + IN THE WRONG 02001250 + ROW; 02001260 + SI~DPPOS; 02001270 + SI~SI+8; 02001280 + DPPOS~SI; 02001290 + DI~LOC TEMP; 02001300 + DS~WDS; 02001310 + SI~TEMP; 02001320 + END 02001330 + ELSE SI~SI-4; 02001340 + END; 02001350 + DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360 + SI~SI+ LGTH; 02001370 + DI~STOPOS; DS~5 LIT"0"; 02001375 + DS~3 CHR; GO TO EXIT; 02001380 + END; 02001390 + SI~SI+3; 02001400 + END 02001410 + ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420 + SI~SI-1; 02001430 + IF SC = "0" 02001440 + THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450 + SI~SI+1; DI~LOC LOOK; 02001460 + IF 3 SC = DC 02001470 + THEN BEGIN COMMENT CHANGE ROWS; 02001480 + SI~DPPOS;SI~SI+8;DPPOS~SI;02001490 + DI~LOC TEMP; DS~WDS; 02001500 + SI~TEMP; 02001510 + END 02001520 + ELSE BEGIN COMMENT IT IS NOT HERE; 02001530 + TALLY~1; LOOK~TALLY; 02001540 + GO TO EXIT; 02001550 + END; 02001560 + GO TO LOOP; 02001563 + END; 02001565 + SI~SI~LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568 + END; 02001570 + GO TO LOOP; 02001580 + EXIT:; 02001590 + END LOOK; 02001600 +%***********************************************************************02001605 +% 02001610 +% MISCELLANEOUS CROSS REFERENCE PROCEDURES 02001615 +% 02001620 +%***********************************************************************02001630 +% 02001635 +PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); 02001640 + VALUE INDEX,SEQNO,REFTYPE; 02001645 + REAL INDEX,SEQNO,REFTYPE; 02001650 +BEGIN 02001655 + IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE 02001660 + BEGIN 02001665 + IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. 02001670 + BEGIN 02001675 + WRITE(DSK2,30,XREFAY2[*]); 02001680 + XREFPT := 0; 02001685 + END; 02001690 + XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] 02001695 + REFIDNOF; 02001700 + XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE 02001705 + % CANT WRITE IT OUT BECAUSE SOME ROUTINES 02001710 + % WILL LOOK BACK AT THE ENTRY WE JUST PUT 02001715 + % IN AND FIX IT UP. 02001720 + END; 02001725 +END OF CROSSREFIT; 02001730 +% 02001735 +PROCEDURE CROSSREFDUMP(INDEX); 02001740 + VALUE INDEX; 02001745 + REAL INDEX; 02001750 +BEGIN 02001755 + STREAM PROCEDURE MOVEREFINFO(S,D,N); 02001760 + VALUE N; 02001765 + BEGIN 02001770 + SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD 02001775 + SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER 02001780 + END OF MOVEXREFINFO; 02001785 + % 02001790 + IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT 02001795 + BEGIN 02001800 + MOVEXREFINFO(INFO[INDEX.LINKR,INDEX.LINKC+1],XREFAY1[*], 02001805 + TAKE(INDEX+1).[12:6]); 02001810 + XREFAY1[8] := XREFINFO[INDEX]; 02001815 + XREFAY1[9] := TAKE(INDEX); % ELBAT WORD 02001820 + WRITE(DSK1,10,XREFAY1[*]); 02001821 + XREFINFO[INDEX] := 0; 02001822 + END; 02001825 +END OF CROSSREFDUMP; 02001830 + REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831 + BEGIN 02001832 + SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833 + END CONV; 02001834 +COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 02001836 +BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001838 + BEGIN 02001840 + SI:=S; SI:=SI+3; DI:=D; SK(DS:=3 RESET); % RIGHT JUSTIFY. 02001842 + CNT(IF SC}"8"THEN TALLY:=1 ELSE IF SC<"0"THEN TALLY:=1; SKIP 3 SB; 02001844 + 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02001846 +% 02001848 +% 02001850 + OCTIZE:=TALLY; % "1" = NON OCTAL CHARACTER. 02001852 + END OCTIZE; 02001854 +COMMENT HEXIZE REFORMATS ACCUM FOR HEXADECIMAL CONSTANTS; 02001856 +BOOLEAN STREAM PROCEDURE HEXIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001858 + BEGIN LOCAL T1,T2,TEMP2,TEMP1; LABEL AGIN; 02001860 +COMMENT LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE 02001862 + WAY THEY ARE DECLARED IN STREAM PROCEDURES; 02001864 + DI:=LOC TEMP1; CNT(DS:=LIT"1"); % IN CASE A CHAR=A,B,C,D,OR F. 02001866 + SI:=S; SI:=SI+3; DI:=LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2. 02001868 + CNT(IF SC<"0" THEN IF SC}"A" THEN IF SC{"F" THEN % WORK HARD. 02001870 + BEGIN 02001872 + T1:=SI; T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN. 02001874 + DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK. 02001876 + DS:=1 ADD; DI:=DI-1; SKIP 2 DB; DS:=1 SET; SKIP 3 DB; 02001878 + GO AGIN; 02001880 + END; 02001882 + IF SC<"0" THEN TALLY:=1; DS:=CHR; % < 0 = NON-HEX CHARACTER. 02001884 +AGIN: 02001886 + ); 02001888 + SI:=LOC TEMP1; DI:=D; SKP(DS:=4 RESET); % RIGHT ADJUST CONSTANT. 02001890 + CNT(SKIP 2 SB; 02001892 + 4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));% FINAL CONVERT. 02001894 + HEXIZE:=TALLY; % "1" IF PROGRAMMER GOOFED. 02001896 + END HEXIZE; 02001898 +COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 02002000 + CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 02003000 + IT IS NEEDED FOR FUTURE REFERENCE; 02004000 +STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR; 02005000 + BEGIN DI:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000 +COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 02007000 + I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 02008000 + CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02009000 + THE SCANNER; 02010000 + STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000 + BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000 + COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010 + IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020 + THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030 + NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040 + VARIABLE AD; 02013050 + STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060 + VALUE AD,DESCRP; 02013065 + BEGIN 02013070 + LOCAL HOLD,ZONEP; 02013073 + DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074 + COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075 + DI~SUM; DI~DI+7; DS~2 RESET; 02013076 + COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077 + SI~LOC DESCRP; SI~SI+7; 02013078 + IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080 + DS~WDS; DI~HOLD; END 02013085 + ELSE DI~SEQLOC; 02013090 + COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091 + HOLD~DI; DI~DI+7; DS~2 RESET; DI~HOLD; 02013095 + SI ~ LOC AD; 02013100 + SI ~ SI + 7; 02013110 + IF SC = "1" THEN BEGIN SI~ SUM; DS~8 ADD; END 02013120 + ELSE BEGIN SI~ SUM; DS~8 SUB; END; 02013130 + SI~LOC ZONEP; DI~HOLD; DS~8 ZON; 02013135 + SI~LOC ZONEP; DI~SUM; DS~8 ZON; 02013136 + COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137 + END ADDER; 02013140 +COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150 +COMPILABLE QUANTITIES. THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155 +A LIBRARY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160 +PROCEDURE SEARCHLIB(DOLLAR); VALUE DOLLAR; BOOLEAN DOLLAR; 02013165 + BEGIN 02013170 + LABEL EXIT,EXITOUT, NOPARTIAL; 02013175 + PROCEDURE FLAGIT(N); VALUE N; INTEGER N; 02013176 + BEGIN 02013177 + BOOLEAN TL,TS; 02013178 + TL:=LISTOG; TS:=SINGLTOG; LISTOG:=FALSE; SINGLTOG:=FALSE; 02013179 + Q:=ACCUM[1]; FLAG(N); 02013180 + LISTOG:=TL; SINGLTOG:=TS; 02013181 + END FLAGIT; 02013183 + IF DOLLAR THEN 02013184 + BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190 + RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195 + RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200 + IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205 + FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210 + COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219 + FLAGIT(500); GO EXIT; 02013222 + END; 02013225 + FILEINX ~ FILEINX -1; 02013230 + IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235 + BEGIN COMMENT MUST READ DIRECTORY; 02013240 + GT3~MKABS(LIBRARY[FILEINX](0)); 02013245 + MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250 + GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255 + WHILE GT2 ~ GT2-1 > 0 DO 02013260 + BEGIN 02013265 + READ(LIBRARY[FILEINX]); 02013270 + MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275 + END; 02013280 + END; 02013285 + RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROD.ID.; 02013290 + IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295 + BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300 + FLAGIT(501); GO EXIT; 02013305 + END; 02013310 + WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013313 + DO BEGIN 02013315 + IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317 + RESULT~5; SCANNER; 02013318 + END; 02013319 + GO TO NOPARTIAL; 02013320 + EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT SPACE PAST "[" ;02013330 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET START POINT;02013335 + IF RESULT ! 3 THEN 02013340 + BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345 + FLAGIT(502); GO EXIT; 02013350 + END; 02013355 + GT1 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013365 + IF RESULT ! 2 THEN 02013370 + BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375 + FLAGIT(503); GO EXIT; 02013380 + END; 02013385 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET LENGTH; 02013390 + IF RESULT ! 3 THEN 02013395 + BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400 + FLAGIT(504); GO EXIT; 02013405 + END; 02013410 + GT2 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415 + RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013420 + IF ACCUM[1] ! "1]0000" THEN 02013425 + BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430 + FLAGIT(505); GO EXIT; 02013435 + END; 02013440 + WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013445 + DO BEGIN RESULT ~ 5; SCANNER END; 02013446 + END; 02013450 + NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475 + LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480 + LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490 + LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495 + LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497 + FINISHPT ~ GT2; 02013500 + IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3].FILEINDEX) 02013505 + |3,0] ~ RECOUNT -1; 02013510 + RECOUNT~GT1; 02013515 + IF EXAMIN(LCR) ! "%" THEN 02013516 + PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525 + IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526 + ELSE IF MAXLTLCR.[33:15]-NCR.[33:15]<11 THEN 02013527 + GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528 + LIBARRAY[LIBINDEX+2],NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530 + IF LASTUSED{2 OR LASTUSED=5 THEN 02013533 + LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534 + LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535 + IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536 + LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537 + LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538 + END ELSE BEGIN 02013539 + LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540 + ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541 + LIBINDEX ~ LIBINDEX + 3; 02013542 + END 02013545 + ELSE 02013550 + BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555 + LIBINDEX ~ LIBINDEX -3; 02013560 + RECOUNT~RECOUNT-1; 02013563 + LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565 + IF LASTUSED =1 THEN MEDIUM := "C "; 02013566 + IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567 + DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568 + DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570 + IF LIBINDEX > 0 THEN 02013575 + FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580 + FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600 + IF LIBINDEX ! 0 THEN 02013610 + MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615 + IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617 + NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620 + IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621 + LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625 + NORELEASE~TRUE; 02013627 + IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628 + END OF UNLINK; 02013630 + IF LIBINDEX = 0 THEN 02013635 + BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640 + SEQSUM~0; 02013645 + END 02013650 + ELSE 02013655 + BEGIN 02013660 + GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665 + GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670 + GT3 ~(GT2 - GT1)DIV 5; 02013675 + SPACE(LIBRARY[FILEINX],GT3); 02013680 + 02013681 + 02013682 + READ(LIBRARY[FILEINX]); 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 + PUTSEQNO(GT1,LCR); 02013716 + TURNONSTOPLIGHT("%",LCR); 02013717 + END; END; 02013718 + EXIT: END SEARCHLIB; 02013720 + COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000 + AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000 + BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000 + BEGIN SI~FCR; IF SC!"$" THEN TALLY~1; 02017000 + DI~NEW; DS~10 WDS; WRITNEW~TALLY 02018000 + END WRITNEW; 02019000 + 02020000 + 02021000 + 02022000 + 02023000 + 02041000 + 02042000 + 02043000 + 02044000 + 02045000 + 02046000 + 02047000 + 02047050 + 02047055 + 02047060 + 02047065 + 02047070 + 02047075 + 02048000 + 02049000 + 02050000 + 02051000 + 02052000 + 02053000 + 02054000 + 02055000 + 02055100 + 02055200 + 02055300 + 02056000 + 02057000 + 02058000 + 02059000 + 02060000 +COMMENT EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR 02061000 + EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02061500 + QUANTITIES IN THE DIRECTORY; 02062000 +BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02062500 + BEGIN 02063000 + TALLY:=1; SI:=A; DI:=B; 02063500 + IF COUNT SC=DC THEN EQUAL:=TALLY 02064000 + END EQUAL; 02064500 +PROCEDURE READACARD; FORWARD; 02065000 +PROCEDURE DOLLARCARD; FORWARD; 02065500 +BOOLEAN PROCEDURE BOOLEXP; FORWARD; 02065600 +PROCEDURE SCANNER; 02066000 + BEGIN 02066500 +COMMENT "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 02067000 + IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER". 02067500 + WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 02068000 + IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO 02068500 + INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE. 02069000 + HENCE THE VARIABLE "RESULT" IS PASSED BY BOTH NAME AND VALUE. 02069500 + THE MEANING OF "RESULT" AS INPUT IS: 02070000 + VALUE MEANING 02070500 + ===== ========================================= 02071000 + 0 INITIAL CODE - DEBLANK AND START TO FETCH THE 02071500 + NEXT QUANTITY. 02072000 + 1 CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02072500 + END-OF-CARD BREAK). 02073000 + 2 LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE, 02073500 + EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT 02074000 + IMPORTANT). 02074500 + 3 CONTINUE BUILDING A NUMBER (INTERRUPTED BY END-OF- 02075000 + CARD BREAK). 02075500 + 4 LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE,02076000 + EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT 02076500 + IMPORTANT). 02077000 + 5 GET NEXT CHARACTER AND EXIT. 02077500 + 6 SCAN A COMMENT. 02078000 + 7 DEBLANK ONLY. 02078500 + THE MEANING OF "RESULT" AS OUTPUT IS: 02079000 + VALUE MEANING 02079500 + ===== ======================================= 02080000 + 1 AN IDENTIFIER WAS BUILT. 02080500 + 2 A SPECIAL CHARACTER WAS OBTAINED. 02081000 + 3 A NUMBER (INTEGER) WAS BUILT. 02081500 + "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02082000 + DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR" 02082500 + FOR THE REST OF THIS DISCUSSION). 02083000 + "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS 02083500 + "SCAN" HAS PUT INTO THE "ACCUMULATOR". SINCE "SCAN" NEEDS 02084000 + THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM- 02084500 + ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD. 02085000 + "COUNT" IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 02085500 + CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT". 02086000 + "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY 02086500 + NAME AND VALUE SO THAT IT MAY BE UPDATED. 02087000 + "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02087500 + PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK 02088000 + ARRANGEMENT. 02088500 + ; 02089000 + STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02089500 + COUNT,ST2,NCRV,ST1); 02090000 + VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02090500 + BEGIN 02091000 + LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR, 02091500 + COMMENTS,COMMANTS; 02092000 + DI:=RESULT; DI:=DI+7; SI:=NCRV; 02092500 +COMMENT SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT 02093000 + THE BUFFER; 02093500 + CI:=CI+RESULTV; % SWITCH ON VALUE OF RESULT; 02094000 + GO DEBLANK; % 0 IS INITIAL CODE. 02094500 + GO IDBLDR; % 1 IS ID CODE. 02095000 + GO FINIS; % 2 IS SPECIAL CHARACTER CODE. 02095500 + GO NUMBERS; % 3 IS NUMBER CODE. 02096000 + GO FINIS; % 4 IS ERROR CODE. 02096500 + GO GNC; % 5 IS GET NEXT CHARACTER CODE. 02097000 + GO COMMANTS; % 6 IS COMMENT CODE. 02097500 + % 7 IS DEBLANK ONLY CODE. 02098000 + IF SC=" " THEN 02098500 +K: BEGIN SI:=SI+1; IF SC=" " THEN GO K END; 02099000 + GO FINIS; 02099500 +DEBLANK: 02100000 + IF SC=" " THEN 02100500 +L: BEGIN SI:=SI+1; IF SC=" " THEN GO L END; 02101000 +COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 02101500 + NCRV:=SI; 02102000 + IF SC } "0" THEN GO NUMBERS; 02102500 + IF SC=ALPHA THEN GO IDBLDR; 02103000 +COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 02103500 +GNC: 02104000 + DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT; 02104500 +COMMANTS: 02105000 + IF SC!";" THEN 02105500 + BEGIN 02106000 +COMMENTS: 02106500 + SI:=SI+1; 02107000 + IF SC > "%" THEN GO COMMENTS; 02107500 + IF SC < ";" THEN GO COMMENTS; 02108000 +COMMENT CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD- 02108500 + MODE PART OF COMMENT ROUTINE; 02109000 + END; 02109500 + GO FINIS; 02110000 +IDBLDR: 02110500 + TALLY:=63; DS:=LIT "1"; 02111000 + COMCOUNT(TALLY:=TALLY+1; 02111500 + IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO EXIT); 02112000 + TALLY:=TALLY+1; 02112500 + IF SC=ALPHA THEN 02113000 + BEGIN 02113500 +ERROR: 02114000 + DI:=DI-1; DS:=LIT "4"; GO EXIT; 02114500 + END 02115000 + ELSE GO EXIT; 02115500 +COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS 02116000 + IN AN IDENTIFIER OR NUMBER; 02116500 +NUMBERS: 02117000 + TALLY:=63; DS:=LIT "3"; 02117500 + COMCOUNT(TALLY:=TALLY+1; 02118000 + IF SC <"0"THEN JUMP OUT TO EXIT; SI:=SI+1); 02118500 + GO ERROR; 02119000 +EXIT: 02119500 + ST1:=TALLY; % "ST1" CONTAINS THE NUMBER OF CHARACTERS WE ARE 02120000 + % GOING TO MOVE INTO THE "ACCUMULATOR". 02120500 + TALLY:=TALLY+COUNTV; ST2:=TALLY; 02121000 + DI:=COUNT; SI:=LOC ST2; DS:=WDS; 02121500 +COMMENT THIS CODE UPDATED "COUNT'; 02122000 + DI:=ACCUM; SI:=SI-3; DS:=3 CHR; 02122500 +COMMENT THIS CODE PLACES "COUNT" IN "ACCUM" AS WELL; 02123000 + DI:=DI+COUNTV; % POSITION "DI" PAST CHARACTERS ALREADY 02123500 + % IN THE "ACCUMULATOR", IF ANY. 02124000 + SI:=NCRV; DS:=ST1 CHR; 02124500 +COMMENT MOVE CHARACTERS INTO "ACCUM"; 02125000 +FINIS: 02125500 + DI:=NCR; ST1:=SI; SI:=LOC ST1; DS:=WDS; 02126000 +COMMENT RESET "NCR" TO LOCATION OF NEXT CHARACTER TO BE SCANNED; 02126500 + END OF SCAN; 02127000 + LABEL L;% 02127500 +L: 02128000 + SCAN(NCR,COUNT,ACCUM[1],63-COUNT,RESULT, 02128500 + RESULT,COUNT,0,NCR,0); 02129000 + IF NCR=LCR THEN 02129500 + BEGIN 02130000 + READACARD; 02130500 + IF LIBINDEX!0 THEN 02131500 + IF RECOUNT=FINISHPT THEN 02132000 + BEGIN 02132500 + SEARCHLIB(FALSE); 02133000 + READACARD; 02133500 + NORELEASE:=FALSE; 02134000 + END; 02134500 + GO TO L; % GO DIRECTLY TO L, DO NOT PASS GO. 02135500 + % DO NOT COLLECT $200. 02136000 + END; 02136500 + END SCANNER; 02137000 +DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) 02181000 + ELSE WRITE(LINE[DBL],15,LIN[*])#, 02181250 + MAKCAST = BEGIN 02181500 + CARDCALL:=IF LASTUSED=5 THEN TRUE ELSE FALSE; 02181750 + SEARCHLIB(TRUE); 02182000 + END #, 02182250 + PRINTCARD = BEGIN 02182500 + EDITLINE(LIN,FCR,L.[36:10], 02182750 + SGNO,L.[45:2],MEDIUM,OMITTING); 02182760 + IF NOHEADING THEN DATIME; WRITELINE; 02183000 + END #; 02183250 +STREAM PROCEDURE EDITLINE(LINE,NGR,R,S,L,SYMBOL,OMIT); 02183500 + VALUE NCR,R,S,L,SYMBOL,OMIT; 02183750 + BEGIN 02184000 + DI := LINE; DS := 16 LIT " "; 02184250 + SI := NCR; DS := 9 WDS; 02184500 + DS := 8 LIT " "; 02184750 + DS := WDS; % SEQUENCE NUMBER. 02185000 + DS:=LIT" "; SI:=LOC SYMBOL; SI:=SI+6; 02185250 + DS:=2 CHR; DS:=LIT" "; 02185500 + SI:=LOC R; SI:=SI+4; 02185750 + IF SC=" " THEN DS:=12 LIT" " ELSE 02186000 + BEGIN 02186250 + SI:=LOC S; DS:=4 DEC; DS:=LIT ":"; 02186300 + SI:=LOC R; DS:=4 DEC; DS:=LIT ":"; 02186400 + SI:=LOC L; DS:=1 DEC; DS:=LIT " "; 02186500 + END; 02186600 + OMIT(DI := DI - 12; DS := 12 LIT " :OMIT: "; DI:= LINE; 02186750 + DS := 8 LIT " :OMIT:"); 02186760 + END EDITLINE; 02187000 +COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02187250 + TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02187500 + RESULT = 1 ELSE RESULT = 2; 02187750 +REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02188000 + BEGIN 02188250 + SI := TAPE; DI := CARD; 02188500 + IF 8 SC } DC THEN 02188750 + BEGIN 02189000 + SI := SI-8; DI := DI-8; TALLY := 1; 02189250 + IF 8 SC = DC THEN TALLY := 2 02189500 + END; 02189750 + COMPARE := TALLY; 02190000 + END COMPARE; 02190250 +PROCEDURE OUTPUTSOURCE; 02190500 + BEGIN 02190750 + LABEL LCARD,LTAPE,AWAY; 02191000 + SWITCH SW:=LCARD,LCARD,LTAPE,AWAY,LCARD,LTAPE; 02191250 + IF SEQTOG THEN % RESEQUENCING. 02191500 + BEGIN 02191750 + IF TOTALNO = -10 OR NEWBASE THEN 02192000 + BEGIN 02192250 + NEWBASE := FALSE; GTI1:= TOTALNO:=BASENUM 02192500 + END 02192750 + ELSE GTI1:= TOTALNO:= TOTALNO + ADDVALUE; 02193000 + CHANGESEQ(GTI1,LCR); 02193250 + END; 02193500 + IF NEWTOG THEN 02193750 + IF INSERTDEPTH > 0 AND INSERTCOP=1 OR INSERTDEPTH=0 THEN 02193800 + IF WRITNEW(LIN,FCR) THEN WRITF(NEWTAPE,10,LIN[*]); 02194000 + IF OMITTING THEN IF NOT LISTATOG THEN GO AWAY; 02194250 + GO SW[LASTUSED]; 02194500 +LCARD: 02194750 + IF LISTER OR LISTPTOG THEN PRINTCARD; 02195000 + GO AWAY; 02195250 +LTAPE: 02195500 + IF LISTER THEN PRINTCARD; 02195750 +% GO AWAY; 02196000 +AWAY: 02196250 + END OUTPUTSOURCE; 02196500 + PROCEDURE BEGINPRINT; 02196510 + BEGIN 02196520 + STREAM PROCEDURE STUFF(N,L); VALUE N; 02196530 + BEGIN 02196540 + DI:=L; DS:=8 LIT " "; SI:=L; DS:=13 WDS; 02196550 + SI:=LOC N; DS:=8 DEC; 02196560 + END; 02196570 + STUFF(BEGINSTACK[BSPOINT],LIN); 02196580 + IF NOHEADING THEN DATIME; WRITELINE; 02196590 + END BEGINPRINT; 02196610 +PROCEDURE READACARD; 02196750 +COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02197000 + TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02197250 + LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02197500 + SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02197750 + FCR,NCR,LCR,TLCR, AND CLCR; 02198000 + BEGIN 02198250 + PROCEDURE READTAPE(LCR,MAXLCR,LIB); VALUE LIB; BOOLEAN LIB; 02198500 + REAL LCR, MAXLCR; 02198750 +BEGIN 02198755 +LABEL ENDREADTAPE, EOFT; 02198760 + IF LIB THEN 02199000 + BEGIN 02199250 + RECOUNT:=RECOUNT+1; 02199500 + IF LCR:=LCR+11>MAXLCR THEN 02199750 + BEGIN 02200000 + READ(LIBRARY,FILEINX); 02200250 + MAXLCR:=46+LCR:=MKABS(LIBRARY[FILEINX](0))+10; 02200500 + END; 02200750 + ADDER(SEQSUM,LCR,TRUE,TRUE); 02201000 + END 02201250 + ELSE BEGIN 02201500 +READ (TAPE, 10, TBUFF[*])[EOFT]; 02201750 +MAXLCR:=LCR:=MKABS(TBUFF[9]); 02202000 +GO TO ENDREADTAPE; 02202010 +EOFT: 02202020 +DEFINEARRAY[25]:="ND;END."& "E"[1:43:5]; 02202030 +DEFINEARRAY[34]:="9999" & "9999"[1:25:23]; 02202040 +TLCR:= MKABS(DEFINEARRAY[34]); 02202050 +PUTSEQNO (DEFINEARRAY[33],TLCR-8); 02202060 +TURNONSTOPLIGHT("%", TLCR-8); 02202070 +ENDREADTAPE: 02202080 +END; 02202090 + END READTAPE; 02202250 + PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB; 02202500 + REAL TLCR, CLCR ; 02202750 + BEGIN 02203000 + MEDIUM:="C "; % CARD READER. 02203250 + IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMB02203500 + BEGIN 02203750 + LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02204000 + MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T.02204250 + END 02204500 + ELSE BEGIN 02204750 + IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000 + BEGIN 02205250 + MEDIUM:="P "; % CARD PATCHES TAPE. 02205500 + IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750 + LASTCRDPATCH:=TRUE ELSE 02208000 + READTAPE(LTLCR,MAXLTLCR,TRUE) ELSE 02208250 + READTAPE(TLCR,MAXTLCR,FALSE); 02208500 + END; 02208750 + LCR:=CLCR; 02209000 + LASTUSED:=IF LIB THEN 5 ELSE 2; 02209250 + END; 02209500 + END OF SEQCOMPARE; 02209750 + LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02210000 + EOF, USETHESWITCH, 02210250 + COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02210500 + LABEL COPYLIB, COPYEOF; 02210600 + SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750 + LIBCLAST, LIBTLAST, COPYLIB; 02211000 + BOOLEAN DOLLAR2TOG; 02211250 + IF ERRORCOUNT}ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500 +USETHESWITCH: 02211750 + GO TO USESWITCH[LASTUSED]; 02212000 + MOVE(1,TEXT[LASTUSED.LINKR,LASTUSED.LINKC], 02212250 + DEFINEARRAY[DEFINEINDEX-2]); 02212500 + LASTUSED := LASTUSED + 1; 02212750 + NCR := LCR-1; 02213000 + GO TO XIT; 02213250 +FIRSTTIME: 02213500 + READ(CARD,10,CBUFF[*]); 02213750 + FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9; 02214000 + MEDIUM:="C "; 02214100 + IF EXAMIN(FCR)!"$" AND LISTER THEN PRINTCARD; 02214200 + PUTSEQNO(INFO[LASTSEQROW,LASTSEQENCE],LCR); 02214250 + CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02214260 + TURNONSTOPLIGHT("%",LCR); 02214500 + GO XIT; 02214750 +COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000 +CARDONLY: 02215250 + IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*]); 02215500 + LCR := MKABS(CBUFF[9]); GO EXIT; 02215750 +CARDLAST: 02216000 + IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*])[EOF]; 02216250 + CLCR := MKABS(CBUFF[9]); 02216500 + GO COMPAR; 02216750 +EOF: 02217000 + DEFINEARRAY[25]:="ND;END."&"E"[1:43:5]; 02217250 + DEFINEARRAY[34]:="9999"&"9999"[1:25:23]; 02217500 + CLCR:=MKABS(DEFINEARRAY[34]); 02217750 + PUTSEQNO(DEFINEARRAY[33],CLCR-8); 02218000 + TURNONSTOPLIGHT("%",CLCR-8); 02218250 +% 02218400 + GO COMPAR; 02218500 +COMMENT THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND 02218750 + SETS UP CLCR; 02219000 +TAPELAST: 02219250 + READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02219500 +COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02219750 +LIBCLAST: 02220000 + IF FIRSTIMEX THEN 02220250 + BEGIN FIRSTIMEX:=FALSE; GO COMPAR END; 02220500 + READ(CARD,10,CBUFF[*])[EOF]; 02220750 + CLCR := MKABS(CBUFF[9]); 02221000 + IF LASTCRDPATCH THEN 02221250 + BEGIN 02221500 + LASTCRDPATCH:=FALSE; 02221750 + RECOUNT:=RECOUNT+1; 02222000 + GO TO XIT 02222250 + END; 02222500 + GO TO COMPAR; 02222750 +LIBTLAST: 02223000 + IF FIRSTIMEX THEN 02223250 + BEGIN FIRSTIMEX:=FALSE; GO TO COMPAR END; 02223500 + READTAPE(LTLCR,MAXLTLCR,TRUE); 02223750 + IF RECOUNT=FINISHPT THEN GO TO XIT; 02224000 + GO COMPAR; 02224010 +COPYLIB: 02224020 + READ(LF[INSERTINX:=INSERTINX+1],10,LBUFF[*])[COPYEOF]; 02224030 + READ SEEK(LF[INSERTINX+1]); 02224032 + IF(CMPD(INSERTSEQ,LBUFF[9]) = 0) THEN GO COPYEOF; 02224040 + LCR:=MKABS(LBUFF[9]); 02224050 + GO TO EXIT; 02224060 +COPYEOF: 02224070 + CLOSE(LF,RELEASE); 02224080 + IF((INSERTDEPTH:=INSERTDEPTH-1) = 0) THEN 02224090 + BEGIN LASTUSED:=SAVECARD; MEDIUM:=MEDIUM.[24:12]; 02224100 + GO USETHESWITCH; 02224102 + END; 02224104 + FILL LF WITH INSERTMID, INSERTFID; 02224110 + GO COPYLIB; 02224120 +COMPAR: 02224250 + IF LASTUSED = 2 OR LASTUSED = 3 THEN SEQCOMPARE(TLCR,CLCR,FALSE) 02224500 + ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02224750 +EXIT: 02225000 + NCR := FCR:= LCR - 9; 02225250 +COMMENT SETS UP NCR AND FCR; 02225500 + IF CHECKTOG AND EXAMIN(FCR)!"$" THEN %$=CARDS DON"T COUNT. 02225750 + IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000 + IF SEQERRTOG THEN BEGIN FLAG(610); 02226250 + NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300 + ELSE BEGIN % SEQUENCE WARNING 02226500 + BLANKET(14,LIN); 02226750 + SEQUENCEWARNING(LIN[13]); 02227000 + IF NOHEADING THEN DATIME; WRITELINE; 02227250 + IF NOT LISTER THEN PRINTCARD; 02227500 + NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1; 02227600 + END; 02227750 + IF EXAMIN(FCR)="$" THEN 02228250 + BEGIN 02228500 + IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD; 02228750 + IF EXAMIN(NCR:=NCR+32768)="$" THEN MAKCAST ELSE DOLLARCARD; 02229000 + NORELEASE := FALSE; 02229100 +COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250 + GO USETHESWITCH; 02229500 + END; 02229750 + IF EXAMIN(FCR)=" " THEN 02230000 + IF DOLLAR2TOG:=EXAMIN(FCR+32768)="$" THEN 02230100 + BEGIN 02230250 + OUTPUTSOURCE; 02230500 + IF EXAMIN(NCR:=NCR+65536)="$" THEN MAKCAST ELSE 02230750 + DOLLARCARD; 02231000 + END; 02231250 + IF VOIDING OR VOIDTAPE THEN 02231500 + BEGIN 02231750 + IF COMPARE(LCR,VOIDCR)=0 THEN 02232000 + BEGIN 02232250 + IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN 02232500 + GO USETHESWITCH; 02232750 + END 02233000 + ELSE BEGIN 02233250 + VOIDCR:=VOIDPLACE:=0; 02233500 + VOIDING:=FALSE; VOIDTAPE:=FALSE 02233750 + END; 02234000 + END; 02234250 + CARDCOUNT:=CARDCOUNT+1; 02234500 + IF DOLLAR2TOG THEN 02234600 + BEGIN DOLLAR2TOG:=NORELEASE:=FALSE; GO USETHESWITCH;END; 02234650 + PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02234750 + CARDNUMBER:=IF SEQTOG THEN TOTALNO+ADDVALUE ELSE 02234800 + CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02234900 + OUTPUTSOURCE; 02235000 + IF OMITTING THEN GO USETHESWITCH; 02235250 +% 02235500 + TURNONSTOPLIGHT("%",LCR); 02235750 + IF BUILDLINE THEN 02236000 + IF LASTADDRESS ! (LASTADDRESS := L.[36:10]) THEN 02236250 + BEGIN 02236500 + ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750 + IF (ENILPTR := ENILPTR+1)}1023 THEN 02237000 + BEGIN FLAG(80); ENILPTR := 512; END; 02237250 + END; 02237500 +XIT: 02237750 + END READACARD; 02238000 +PROCEDURE INCLUDECARD; 02238100 + BEGIN 02238110 + REAL V; 02238112 + LABEL EEXIT,AGAIN,GETEM,EOF,EXIT,DONTSCAN; 02238120 + REAL STREAM PROCEDURE SCNN(A,B); VALUE B; 02238130 + BEGIN 02238140 + SI:=A; DI:=LOC SCNN; DS:=8 LIT"0 "; 02238150 + DI:=DI-7; SI:=SI+3; DS:=B CHR; 02238160 + END; 02238170 + STREAM PROCEDURE MVE(A,B,C,D); VALUE B,C; 02238180 + BEGIN 02238190 + SI:=A; SI:=SI+3; DI:=D; C(DS:=LIT"0"); DS:=B CHR; 02238200 + END; 02238210 +STREAM PROCEDURE MVEWD(A,B); VALUE A; 02238212 + BEGIN SI:=A; DI:=B; DS:=10 WDS; END; 02238214 + DEFINE SKAN = BEGIN 02238220 + COUNT:=RESULT:=ACCUM[0]:=0; 02238230 + SCANNER; 02238240 + V:=SCNN(ACCUM[1],MIN(COUNT,7)); 02238250 + END#; 02238260 + DEFINE ERR(ERR1) = BEGIN FLAG(ERR1); GO TO EEXIT; END#; 02238270 + IF((INSERTDEPTH:=INSERTDEPTH+1) > INSERTMAX) THEN ERR(612); 02238280 + INSERTMID:=INSERTFID:=INSERTINX:=INSERTCOP:=0; 02238290 + INSERTSEQ:="9999"&"9999"[1:23]; 02238300 +AGAIN: 02238330 + SKAN; 02238340 +DONTSCAN: 02238342 + IF V="% " THEN GO GETEM; 02238350 + IF V="/ " THEN GO AGAIN; 02238360 + IF RESULT=3 THEN % SEQ RANGE 02238370 + BEGIN 02238380 + MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTINX); 02238385 + SKAN; 02238390 + IF V="- " THEN 02238400 + BEGIN 02238410 + SKAN; 02238420 + IF RESULT ! 3 THEN ERR(614); 02238430 + MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); 02238440 + END ELSE GO TO DONTSCAN; 02238450 + GO AGAIN; 02238460 + END; % SEQ RANGE 02238470 + IF V="+ " THEN % WE HAVE COPY FORM 02238480 + BEGIN 02238490 + SKAN; 02238500 + IF V="COPY " THEN 02238510 + IF EXAMIN(LCR-9)="$" THEN 02238512 + INSERTCOP:=INSERTINFO[INSERTDEPTH-1,4] 02238514 + ELSE ERR(617) 02238520 + ELSE ERR(616); 02238522 + GO AGAIN; 02238530 + END; 02238540 + IF INSERTMID=0 THEN INSERTMID:=V 02238550 + ELSE IF INSERTFID=0 THEN INSERTFID:=V ELSE ERR(616); 02238552 + GO AGAIN; 02238555 +GETEM: 02238560 + IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN 02238570 + IF EXAMIN(FCR) = "$" THEN % ONLY IF "$" IS IN COLUMN ONE 02238572 + IF BOOLEAN(INSERTINFO[INSERTDEPTH-1,4]) THEN % ONLY IF LAST HAD COPY02238574 + BEGIN MVEWD(FCR,LBUFF[0]); 02238580 + PUTSEQNO(LBUFF[9],MKABS(INFO[LASTSEQROW,LASTSEQUENCE])); 02238582 + WRITE(NEWTAPE,10,LBUFF[*]); 02238590 + END; 02238600 + IF INSERTMID=0 THEN ERR(613); 02238602 + IF INSERTFID=0 THEN INSERTFID:=TIME(-1); 02238610 + IF INSERTFID=0 THEN 02238620 + BEGIN INSERTFID:=INSERTMID; INSERTMID:=0; END; 02238630 + IF INSERTDEPTH > 1 THEN CLOSE(LF,RELEASE); 02238640 + FILL LF WITH INSERTMID,INSERTFID; 02238650 + READ(LF[0],10,LBUFF[*])[EEXIT]; % DO THE FOLLOWING SO THAT 02238652 + INSERTMID:=LF.MFID; % IF THE OPERATOR IL-ED US 02238654 + INSERTFID:=LF.FID; % WE WILL HAVE THE PROPER NAMES. 02238656 + V:=-1; 02238658 + IF INSERTINX > 0 THEN 02238660 + BEGIN 02238670 + DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] 02238680 + UNTIL CMPD(INSERTINX,LBUFF[9]) { 1; 02238690 + V:=V-1; 02238700 + END; 02238702 + INSERTINX:=V; 02238704 + IF INSERTDEPTH = 1 THEN 02238710 + BEGIN SAVECARD:=LASTUSED; LASTUSED:=7; MEDIUM:="L "& MEDIUM[24:12]; 02238720 + END; 02238730 + GO TO EXIT; 02238760 +EEXIT: 02238770 + IF((INSERTDEPTH:=INSERTDEPTH-1) > 0) THEN 02238780 + BEGIN 02238790 + CLOSE(LF,RELEASE); 02238800 + FILL LF WITH INSERTMID,INSERTFID; 02238810 + END; 02238820 +EXIT: 02238830 + Q:="1%0000"; 02238832 + END; 02238840 +REAL PROCEDURE CONVERT; 02248000 + BEGIN REAL T; INTEGER N; 02249000 + TL0~0; THI~ 02250000 + T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000 + FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000 + IF DPTOG THEN 02253000 + BEGIN 02254000 + DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~, 02255000 + THI,TLO); 02256000 + T~THI; 02257000 + END ELSE 02258000 + T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000 + CONVERT~T; 02260000 + END; 02261000 +REAL STREAM PROCEDURE FETCH(F); VALUE F; 02262000 + BEGIN SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS END FETCH; 02263000 +PROCEDURE DUMPINFO; 02264000 + BEGIN 02264050 + ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100 + STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400 + BEGIN 02264450 + SI:=S; DI:=D; 02264500 + N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550 + DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600 + END OF OCTALWORDS; 02264650 + STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700 + BEGIN 02264750 + SI:=S; DI:=D; 02264800 + N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850 + END OF ALPHAWORDS; 02264900 + IF NOHEADING THEN DATIME;WRITE(LINE[DBL],); 02264950 + FOR JEDEN:=0 STEP 6 UNTIL 71 DO 02265000 + BEGIN 02265050 + BLANKET(14,A); OCTALWORDS(ELBAT[JEDEN],A,6); 02265100 + WRITE(LINE[DBL],15,A[*]); 02265150 + END; 02265200 + BLANKET(14,A); OCTALWORDS(ELBAT[72],A,4); 02265250 + WRITE(LINE[DBL],15,A[*]); 02265300 + FOR JEDEN:=0 STEP 1 UNTIL NEXTINFO DIV 256 DO 02265350 + BEGIN 02265400 + WRITE(LINE[DBL],,JEDEN); 02265450 + FOR DWA:=0 STEP 6 UNTIL 251 DO 02265500 + BEGIN 02265550 + BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600 + WRITE(LINE,15,A[*]); 02265650 + BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700 + WRITE(LINE[DBL],15,A[*]); 02265750 + END; 02265800 + BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850 + WRITE(LINE,15,A[*]); 02265900 + BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950 + WRITE(LINE[DBL],15,A[*]); 02266000 + END; 02266050 + END OF DUMPINFO; 02266100 +DEFINE SKAN = BEGIN 02277000 + COUNT:=RESULT:=ACCUM[1]:=0; 02278000 + SCANNER; 02279000 + Q:=ACCUM[1]; 02280000 + END #; 02281000 +COMMENT DOLLARCARD HANDLES THE COMPILER CONTROL CARDS. 02282000 + ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT 02283000 + IN THE ARRAY "OPTIONS". 02284000 + EACH OPTION HAS A TWO-WORD ENTRY: 02285000120324PK + 02286000 + WORD CONTAINS 02287000 + ---- -------- 02288000 + 1 ENTRY FROM ACCUM[1]: 00XZZZZ, WHERE 02289000 + X IS THE SIZE OF THE ID AND 02290000 + ZZZZZ IS THE FIRST FIVE CHARS OF THE ID. 02291000 + 2 PUSH-DOWN, 47-BIT STACK CONTAINING THE 02292000 + HISTORY OF THE SETTINGS OF THIS OPTION. 02293000 + 02294000 + IN "FINDOPTION", ALL COMPILER-DEFINED OPTIONS ARE USUALLY 02295000 + LOCATES BASED UPON A UNIQUE NUMBER ASSIGNED TO EACH. 02296000 + FOR ALL USER-DEFINED OPTIONS, A SEQUENTIAL TABLE SEARCH IS 02297000 + INITIATED USING "USEROPINX" AS THE INITIAL INDEX INTO THE 02298000 + "OPTIONS" ARRAY. IF THE NUMBER OF COMPILER-DEFINED OPTIONS 02299000 + IS CHANGED, THEN "USEROPINX" MUST BE ACCORDINGLY CHANGED. 02300000 + THE NUMBER OF USER DEFINED OPTIONS ALLOWED CAN BE 02301000 + CHANGED BY CHANGING THE DEFINE "OPARSIZE". 02302000 + THE VARIABLE "OPTIONWORD" CONTAINS THE CURRENT TRUE OR FALSE 02303000 + SETTING OF ALL THE COMPILER-DEFINED OPTIONS, ONE BIT PER 02304000 + OPTION. 02305000 + ; 02306000 +BOOLEAN PROCEDURE FINDOPTION(BIT); VALUE BIT; INTEGER BIT; 02307000 + BEGIN 02308000 + LABEL FOUND; 02309000 + REAL ID; 02310000 + OPINX:=2|BIT-4; 02311000 + WHILE ID:=OPTIONS[OPINX:=OPINX+2] ! D0 02312000 + IF Q=ID THEN GO FOUND; 02313000 + OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION. 02314000 +FOUND: 02315000 + IF OPINX +1>OPARSIZE THEN FLAG(602) ELSE % TOO MANY USER OPTIONS 02316000 + FINDOPTION:=BOOLEAN(OPTIONS[OPINX+1]); 02317000 + END FINDOPTION; 02318000 +PROCEDURE DOLLARCARD; 02319000 + BEGIN 02320000 + PROCEDURE SWITCHIT(XBIT); VALUE XBIT; INTEGER XBIT; 02321000 + BEGIN 02322000 + BOOLEAN B,T; 02323000 + INTEGER SAVEINX; 02324000 + LABEL XMODE0,XMODE1,XMODE2,XMODE3,XMODE4,ALONG; 02325000 + SWITCH SW:=XMODE0,XMODE1,XMODE2,XMODE3,XMODE4; 02326000 + SETTING:=FINDOPTION(XBIT); SKAN; 02327000 + GO SW[XMODE+1]; 02328000 +XMODE0: % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP. 02329000 + OPTIONWORD:=BOOLEAN(0); 02330000 + FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO OPTIONS[SAVEINX]:=0; 02331000 + IF BUILDLINE.[45:1] THEN 02331050 + BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; 02331060 + XMODE:=1; IF LASTUSED < 5 AND LASTUSED ! 3 THEN LASTUSED:=1; 02332000 +XMODE1: % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED. 02333000 + OPTIONS[OPINX+1]:=REAL(TRUE); 02334000 + IF XBIT9 OR ENDTOG THEN GO COMPLETE; 02680000 + NHI:=NLO:=0; 02681000 + C:=0; FSAVE:=0; GO FPART; 02682000 +ATSIGN: 02683000 +% RESULT:=0; SCANNER; 02684000 +% IF COUNT>17 THEN GO ARGH; 02685000 +% IF OCTIZE(ACCUM[1],COUNT-1,17-COUNT,C) THEN GO ARGH 02686000 +% ELSE GO NUMBEREND; 02687000 + NHI:=C:=1; NLO:=FSAVE:=0; GO EPART; 02688000 +COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02689000 +QUOTE: 02690000 + COUNT := 0; T := IF STREAMTOG THEN 63 ELSE 8; 02691000 +% 02692000 +% 02692500 + DO BEGIN 02693000 + RESULT:=5; SCANNER; 02694000 + IF COUNT=T THEN 02695000 + IF EXAMIN(NCR) ! """ THEN GO ARGH; 02696000 + END UNTIL EXAMIN(NCR) = """; 02697000 + IF NOT STREAMTOG AND COUNT=8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 02697500 + BEGIN Q := ACCUM[1]; FLAG(254); GO TO SCANAGAIN; END; 02697600 + Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02698000 + IF COUNT<0 THEN COUNT:=COUNT+64; 02699000 + ACCUM[1]:=Q; RESULT:=4; 02700000 +STRNGXT: T:=C:=0; 02701000 + T.CLASS:=STRNGCON; 02702000 + IF COUNT < 8 OR (COUNT = 8 AND NOT BOOLEAN 02703000 + (ACCUM[1].[18:1])) THEN % FLAG BIT NOT SET, FULL WORD CONST. 02703050 +MOVEIT: 02704000 + MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT) 02705000 + ELSE T.CLASS:=STRING; 02705100 + T.INCR:=COUNT; GO COMPLETE; 02705200 +% 02706000 +COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02707000 + THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02708000 + THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02709000 + THE TWO CASES ARE PROCESSED DIFFERENTLY. THE FIRST CASE 02710000 + MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02711000 + CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID. 02712000 + FOR A FULL DISCUSSION SEE DEFINEGEN; 02713000 +CROSSHATCH: 02714000 + IF DEFINECTR!0 THEN GO COMPLETE; 02715000 + PUTSEQNO(GT1,LCR); 02716000 + TURNONSTOPLIGHT(0,LCR); 02717000 + IF DEFINEINDEX = 0 THEN GO ARGH; 02718000 + LCR:=(GT1:=DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02719000 + NCR:=GT1 MOD 262144; 02720000 + LASTUSED:=(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3]).[33:15];02721000 + IF (GT2 := T.[18:15]) ! 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500 + BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD 02722000 + GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500 + DO 02723000 + PUT(TEXT[(NEXTTEXT:=(GT1:=TAKE(DEFSTACKHEAD)).DYNAM-1) 02723500 + .LINKR,NEXTTEXT.LINKC],DEFSTACKHEAD) 02724000 + % THIS RESTORES THE PREVIOUS ELBAT WORD FOR 02724500 + % THIS PARAMETER IN CASE OF NESTED DEFINE. 02725000 + UNTIL 02725500 + GT2 = (DEFSTACKHEAD := GT1.LINK); 02726000 + END; 02727000 + GO SCANAGAIN; 02728000 +DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02729000 + IF GT1:=EXAMIN(NCR)="$" THEN GO DBLDOLLAR ELSE DOLLARCARD; 02730000 +PERCENT: IF NCR ! FCR THEN READACARD; 02731000 + IF LIBINDEX!0 THEN 02732000 + IF RECOUNT=FINISHPT THEN 02733000 + BEGIN 02734000 + SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000 + END; 02736000 + GO SCANAGAIN; 02737000 +COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02738000 + PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02739000 + SIDE EFFECT IS THAT ALL CHARACTERS ON A CARD ARE IGNORED 02740000 + AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR 02741000 + COMMENT); 02742000 +COMMENT MIGHT BE FUNNY COMMA - HANDLE HERE; 02743000 +RTPAREN: RESULT:=7; SCANNER; 02744000 + IF EXAMIN(NCR) = """ THEN 02745000 + BEGIN 02746000 + RESULT:=0; SCANNER; 02747000 + DO BEGIN 02748000 + RESULT:=5; SCANNER 02749000 + END UNTIL EXAMIN(NCR) = """; 02750000 + RESULT:=0; SCANNER; 02751000 + RESULT:=7; SCANNER; 02752000 + IF EXAMIN(NCR) ! "(" THEN GO ARGH; 02753000 + RESULT:=0; SCANNER; Q:=ACCUM[1]; 02754000 + T:=SPECIAL[24] 02755000 + END; 02756000 + RESULT:=2; GO COMPLETE; 02757000 +IPART: TCOUNT:=FSAVE:=0; C:=CONVERT; 02758000 + RESULT:=7; SCANNER; % DEBLANK. 02759000 + IF DEFINECTR=0 THEN 02760000 + IF (C=3 OR C=4) AND EXAMIN(NCR)=""" THEN %OCTAL OR HEX STRING.02761000 + IF NOT (ACCUM[0].CLASS=FILEID AND INFO[LASTINFO. 02761500 + LINKR, LASTINFO.LINKC] = ACCUM[0])THEN 02761501 + BEGIN INTEGER SIZ; 02762000 + RESULT:=5; SCANNER; % SKIP QUOTE. 02763000 + COUNT:=0; 02764000 + DO BEGIN 02765000 + RESULT:=5; SCANNER; 02766000 + IF COUNT > SIZ:=48 DIV C THEN % > 1 WORD LONG. 02767000 + BEGIN ERR(520); GO SCANAGAIN END; 02768000 + END UNTIL EXMAIN(NCR)="""; 02769000 + Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02770000 + IF C=3 THEN % OCTAL STRING. 02771000 + IF OCTIZE(ACCUM[1],ACCUM[4],16-COUNT,COUNT) THEN 02772000 + FLAG(521) % NON-OCTAL CHARACTER IN STRING. 02773000 + ELSE ELSE IF HEXIZE(ACCUM[1],ACCUM[4],12-COUNT,COUNT) THEN 02774000 + FLAG(521); % NON-HEX CHARACTER IN HEX STRING. 02775000 + T.INCR := COUNT := (C|COUNT-1)DIV 6 + 1; % # OF CHARS. 02776100 + T.CLASS:= STRNGCON; 02776200 + MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); 02776300 + IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. 02776400 + IF STREAMTOG THEN 02776500 + T.CLASS := STRING 02776600 + ELSE 02776700 + FLAG(254) 02776800 + ELSE 02776900 + C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000 + MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); 02777050 + GO TO COMPLETE; 02777100 + MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000 + GO COMPLETE; 02782000 + END OCTAL OR HEX STRING; 02783000 + IF DPTOG THEN 02784000 + BEGIN NHI:=THI; NLO:=TLO; END; 02785000 + IF EXAMIN(NCR)="." THEN 02786000 + BEGIN 02787000 + RESULT:=0; SCANNER; 02788000 + C:=1.0| C; 02789000 + FPART: TCOUNT:=COUNT; 02790000 + IF EXAMIN(NCR){9 THEN 02791000 + BEGIN 02792000 + RESULT:=0; SCANNER; 02793000 + IF DPTOG THEN 02794000 + BEGIN 02795000 + DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000 + 0,/,:=,THI,TLO); 02797000 + FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000 + DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000 + DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000 + C:=NHI 02801000 + END 02802000 + ELSE C:=CONVERT+C|TEN[FSAVE:=COUNT-TCOUNT]; 02803000 + END 02804000 + END; 02805000 + RESULT:=7; SCANNER; 02806000 + IF EXAMIN(NCR)="@" THEN 02807000 + BEGIN 02808000 + RESULT:=0; SCANNER; 02809000 + EPART: TCOUNT:=COUNT; 02810000 + C:=C|1.0; 02811000 + RESULT:=7; SCANNER; 02812000 + IF T:=EXAMIN(NCR)>9 THEN 02813000 + IF T="-" OR T = "+" THEN 02814000 + BEGIN 02815000 + RESULT:=0; SCANNER; 02816000 + TCOUNT:=COUNT; 02817000 + END 02818000 + ELSE FLAG(47); 02819000 + RESULT:=0; SCANNER; 02820000 + IF RESULT ! 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000 + Q:=ACCUM[1]; 02822000 + IF GT1:=T:=(IF T="-" THEN -CONVERT ELSE CONVERT)<-46 OR 02823000 + T>69 THEN FLAG(269) 02824000 + ELSE BEGIN 02825000 + T:=TEN[ABS(GT3:=T-FSAVE)]; 02826000 + IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] 02827000 + + 12) >63 THEN FLAG(269) 02828000 + ELSE IF DPTOG THEN 02829000 + IF GT1<0 THEN 02830000 + BEGIN 02831000 + GT1:=-GT1; 02832000 + DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000 + FOR GT2:=12 STEP 12 UNTIL GT1 DO 02834000 + DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO); 02835000 + END 02836000 + ELSE BEGIN 02837000 + DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,:=,NHI,NLO); 02838000 + FOR GT2:=12 STEP 12 UNTIL GT1 DO 02839000 + DOUBLE( NHI,NLO,TEN[12],0,|,:=,NHI,NLO); 02840000 + END 02841000 + ELSE C:=IF GT3<0 THEN C/T ELSE C|T; 02842000 + END; 02843000 + END 02844000 + ELSE IF FSAVE ! 0 THEN C:=C/TEN[FSAVE]; 02845000 + Q:=ACCUM[1]; RESULT:=3; 02846000 +FINISHNUMBER: 02847000 + T:=0; 02848000 + IF C.[1:37]=0 THEN 02849000 + BEGIN T.CLASS:=LITNO ; T.ADDRESS:=C END 02850000 + ELSE T.CLASS:=NONLITNO ; 02851000 + GO COMPLETE; 02852000 +COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02853000 + IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02854000 + ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02855000 + TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK. 02856000 + TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR 02857000 + COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO 02858000 + COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND 02859000 + ROSE IS ENTERED. THE LAST THING DONE FOR ANY 02860000 + IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION 02861000 + OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS 02862000 + ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, 02863000 + SHOULD THIS BE REQUIRED. ; 02864000 +IDENT: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!0 THEN 02865000 + BEGIN 02866000 + IF INFO[GT1:=T.LINKR,(GT2:=T.LINKC)+1]=Q THEN 02867000 + BEGIN 02868000 + T:=INFO[GT1,GT2]&T[35:35:13]; 02869000 + GO COMPLETE 02870000 + END 02871000 + END; 02872000 + IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN T:=DEFSTACKHEAD 02873000 + ELSE T:=STACKHEAD[SCRAM]; 02874000 +ROSE: GT1:=T.LINKR; 02875000 + IF(GT2:=T.LINKC)+GT1= 0 THEN 02876000 + BEGIN T:=0; GO COMPLETE END; 02877000 + IF T = INFO[GT1, GT2] THEN BEGIN 02877010 + T:= 0; GO TO COMPLETE END; 02877020 + T:=INFO[GT1,GT2]; 02878000 + IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO ROSE; 02879000 + IF COUNT { 5 THEN GO COMPOST ; 02880000 + IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE; 02881000 +COMPOST: T:=T>1[35:43:5]>2[40:40:8]; 02882000 + IF GT1 !1 AND NOT MACROID THEN % NOT RESERVED WORD 02882100 + XREFIT(T,LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY 02882200 +COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02883000 + IF NOT ENDTOG THEN 02884000 + BEGIN 02885000 + IF GT1:=T.CLASS = COMMENTV THEN 02886000 + BEGIN 02887000 + WHILE EXAMIN(NCR) ! ";" DO 02888000 + BEGIN RESULT:=6; COUNT:=0; SCANNER END; 02889000 + RESULT:=0;SCANNER;GO SCANAGAIN 02890000 + END 02891000 + END; 02892000 + IF STOPDEFINE THEN GO COMPLETE; 02893000 + IF GT1 ! DEFINEDID THEN GO COMPLETE; 02894000 +COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000 + IF BOOLEAN(T,MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000 + GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000 + IF DEFINEINDEX = 24 THEN 02898000 + BEGIN FLAG(139);GO ARGH END; 02899000 + DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000 + LASTUSED:=T.DYNAM; 02901000 + DEFINEARRAY[DEFINEINDEX+2]:=262144|LCR+NCR; 02902000 + LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02903000 + PUTSEQNO(GT4,LCR); 02904000 + TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3; 02905000 + GO PERCENT; 02906000 +DBLDOLLAR: 02907000 + MAKCAST; GO SCANAGAIN; 02908000 +COMPLETE: 02909000 + ELBAT[NXTELBT]:=T; 02910000 + IF NOT DEFINING THEN 02910100 + IF T.CLASS = BEGINV THEN 02910200 + BEGINSTACK[BSPOINT:=BSPOINT+1]:=CARDNUMBER ELSE 02910300 + IF T.CLASS = ENDV THEN 02910400 + BEGIN 02910500 + IF LISTER THEN IF BEND THEN BEGINPRINT; 02910600 + BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700 + END; 02910800 + STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000 + IF NXTELBT:=NXTELBT+1 > 74 THEN 02912000 + IF NOT MACROID THEN 02913000 + BEGIN 02914000 +COMMENT ELBAT IS FULL: ADJUST IT; 02915000 + MOVE(10,ELBAT[65],ELBAT); 02916000 + I:=I-65; P:=P-65; NXTELBT:=10; 02917000 + END 02918000 + END; 02919000 + IF TABLE:=ELBAT[P].CLASS = COMMENTV THEN 02920000 + BEGIN 02921000 +COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02922000 + C:=INFO[0,ELBAT[P].ADDRESS]; 02923000 + ELBAT[P].CLASS:=TABLE:=NONLITNO 02924000 + END; 02925000 + STOPDEFINE:=FALSE; COMMENT ALLOW DEFINE; 02926000 + END TABLE ; 02927000 +INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE,NAME) 02927100 + VALUE SIZE,NAME; REAL SIZE,NAME; ARRAY FROM [0,0]; 02927110 + BEGIN 02927120 + INTEGER NSEGS,I,J,K; 02927130 + ARRAY A[0:14]; 02927140 + SWITCH FORMAT FMT := 02927150 +$RESET NEATUP 02927155120324PK + (/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), 02927160 + (/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927170 + (/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927180 + (/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), 02927190 + (/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927200 + (/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), 02927210 + (/,"SEGMENT ZERO",I*,/), 02927220 + (/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); 02927230 +$SET NEATUP 02927235120324PK + STREAM PROCEDURE OCTALWORDS(N,W,S,D); VALUE N,W; 02927240 + BEGIN 02927250 + DI:=D; DS:=LIT" "; 02927260 + SI:=LOC N; SI:=SI+6; 02927270 + 4(DS:=3 RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02927272 + DI:=DI-4; DS:=3 FILL; 02927280 + DI:=D; DI:=DI+5; DS:=4 LIT" "; 02927290 + SI:=S; 02927300 + W(2(8(DS:=3 RESET; 02927310 + 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); 02927320 + ); 02927330 + DS:=LIT" "); 02927340 + DS:=2 LIT" "); 02927350 + END OF OCTALWORDS; 02927360 + %********** S T A R T ********** 02927370 + NSEGS:=(SIZE+29) DIV 30; 02927380 + IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN 02927390 + DA:=CHUNK|T; 02927400 + MOVEANDBLOCK:=DA; 02927410 + IF CODEFILE THEN 02927420 + IF NAME}0 THEN 02927430 + WRITE(LINE,FMT[NAME],DA) 02927440 + ELSE 02927450 + WRITE(LINE,FMT[7],ABS(NAME),DA); 02927460 + IF SIZE!0 THEN 02927470 + BEGIN 02927480 + FOR J:=0 STEP 30 WHILE J < SIZE DO 02927490 + BEGIN 02927500 + IF (K:=(128-(J MOD 128))) < 30 THEN 02927510 + BEGIN 02927520 + MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); 02927530 + MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); 02927540 + END 02927550 + ELSE 02927560 + MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); 02927570 + IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION 02927580 + BEGIN 02927590 + K:=0; 02927600 + MOVE(1,K,CODE(SIZE-J)); 02927610 + IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD 02927612 + MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); 02927620 + END; 02927630 + IF CODEFILE THEN 02927640 + BEGIN 02927650 + FOR K:=0 STEP 5 WHILE K{25 AND (J+K){SIZE DO 02927660 + BEGIN 02927670 + BLANKET(14,A); 02927680 + OCTALWORDS(J+K,IF (J~K+5){SIZE THEN 5 ELSE 02927690 + SIZE-J-K,CODE(K),A); 02927700 + WRITE(LINE,15,A[*]); 02927710 + END; 02927720 + WRITE(LINE); 02927722 + END; 02927730 + WRITE(CODE[DA]); DA:=DA+1; 02927740 + END; 02927750 + END; 02927760 + END OF MOVEANDBLOCK; 02927770 +COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02928000 + IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000 + PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000 + NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000 +PROCEDURE NEXTENT; 02932000 + BEGIN LABEL DEBLANK; 02933000 + COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02934000 +DEBLANK: 02935000 + IF EXAMIN(NCR)=" "THEN 02936000 + BEGIN 02937000 + RESULT:=7; SCANNER; 02938000 + END; 02939000 + IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000 + BEGIN 02941000 + RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000 + IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000 + ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000 + END 02945000 +ELSE IF EXAMIN(NCR)="%" THEN 02946000 + BEGIN 02947000 + READACARD; COUNT:=ACCUM[1]:=0; GO DEBLANK; 02948000 + END 02949000 +ELSE BEGIN 02950000 + RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02951000 + Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02952000 + END 02953000 + END OF NEXTENT; 02954000 + BOOLEAN PROCEDURE BOOLPRIM; FORWARD; 02955000 + PROCEDURE BOOLCOMP(B); BOOLEAN B; FORWARD; 02955500 + INTEGER PROCEDURE NEXT; 02956000 + BEGIN 02956500 + LABEL EXIT; 02957000 + INTEGER T; 02957500 + DEFINE ERROR = BEGIN FLAG(603); GO EXIT END#; 02958000 + SKAN; 02958500 + IF RESULT=3 THEN ERROR; % NUMBERS NOT ALLOWED. 02959000 + IF RESULT=2 THEN % SPECIAL CHARACTER. 02959500 + BEGIN 02960000 + T:=IF Q="1,0000" OR Q="1%0000" THEN 20 % FAKE OUT BOOLEXP.02960500 + ELSE ((T:=Q.[18:6]-2) & T[42:41:3]); 02961000 + IF T=11 OR T=19 OR T=20 THEN BATMAN:=SPECIAL[T] % (,),OR ;02961500 + ELSE FLAG(603); 02962000 + GO EXIT 02962500 + END SPECIAL CHARACTERS; 02963000 +COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 02963500 + T:= IF Q="3NOT00" THEN NOTOP 02964000 + ELSE IF Q="3AND00" THEN ANDOP 02964500 + ELSE IF Q="3OR000" THEN OROP 02965000 + ELSE IF Q="3EQV00" THEN EQVOP 02965500 + ELSE 0; 02966000 + IF T!0 THEN BATMAN.CLASS:=T 02966500 + ELSE BATMAN:=1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION. 02967000 +EXIT: 02967500 + NEXT:=MYCLASS:=BATMAN.CLASS; 02968000 + END NEXT; 02968500 + BOOLEAN PROCEDURE BOOLEXP; 02969000 + BEGIN 02969500 + BOOLEAN B; 02970000 + B:=BOOLPRIM; 02970500 + WHILE MYCLASS}EQVOP AND MYCLASS{ANDOP DO BOOLCOMP(B); 02971000 + BOOLEXP:=B 02971500 + END BOOLEXP; 02972000 + BOOLEAN PROCEDURE BOOLPRIM; 02972500 + BEGIN 02973000 + BOOLEAN B,KNOT; 02973500 + DEFINE SKIPIT = MYCLASS:=NEXT #; 02974000 + IF KNOT:=(NEXT=NOTOP) THEN SKIPIT; 02974500 + IF MYCLASS=LEFTPAREN THEN 02975000 + BEGIN 02975500 + B:=BOOLEXP; 02976000 + IF MYCLASS!RTPAREN THEN FLAG(604); 02976500 + END 02977000 + ELSE IF MYCLASS!BOOID THEN FLAG(601) 02977500 + ELSE B:=BATMAN<0; 02978000 + IF KNOT THEN B:=NOT B; SKIPIT; 02978500 + BOOLPRIM:=B 02979000 + END BOOLPRIM; 02979500 + PROCEDURE BOOLCOMP(B); BOOLEAN B; 02980000 + BEGIN 02980500 + REAL OPCLASS; 02981000 + BOOLEAN T; 02981500 + OPCLASS:=MYCLASS; 02982000 + T:=BOOLPRIM; 02982500 + WHILE OPCLASS 1023 THEN EMITO(PRTE); 04018000 + EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000 + COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000 + SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000 + PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000 + BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000 + EMIT(3 & ADDRESS [36:38:10] END EMITN; 04024000 + COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000 + ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000 + EMITS PRTE; 04027000 + PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000 + VALUE ADDRESS,OPERATOR; 04029000 + INTEGER ADDRESS,OPERATOR; 04030000 + BEGIN 04031000 + EMITL(ADDRESS); 04032000 + IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000 + EMITO(OPERATOR) END EMITPAIR; 04034000 + COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000 + EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000 + OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000 + CODE CONSISTS OF A SERIES OF DUPS AND MULS, AS WITH 04038000 + EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000 + AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000 + NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 04041000 + IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000 + (APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000 + OTHERWISE IT CALLS LN AND EXP; 04044000 + PROCEDURE EMITUP; 04045000 + BEGIN INTEGER BACKUP, CTR; 04046000 + LABEL E; 04047000 + IF NOT LINKTOG THEN GO TO E; 04048000 + COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000 + IF GET(L-1) = 537 THEN 04050000 + COMMENT LAST OPERATOR IS CHS; 04051000 + BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000 + IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000 + THEN BEGIN 04054000 + COMMENT IT IS A LITERAL; 04055000 + BACKUP ~ BACKUP+1; L ~ L-1; 04056000 + IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000 + COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000 + CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000 + WHILE GT4 DIV 2 ! 0 04060000 + DO BEGIN 04061000 + EMITO(DUP); 04062000 + IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000 + EMITO(MUL); 04064000 + GT4 ~ GT4 DIV 2 END; 04065000 + IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000 + ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000 + IF BACKUP = 2 04068000 + THEN BEGIN 04069000 + EMITL(1); 04070000 + EMITO(XCH); 04071000 + EMITO(128) END END 04072000 + ELSE BEGIN 04073000 + E: L ~ L+BACKUP; 04074000 + EMITO(MKS); 04075000 + EMITPAIR(GNAT(LOGI),LOD); 04076000 + EMITPAIR(GNAT(EXPI),LOD); 04077000 + EMITV(GNAT(XTOTHEI)); 04078000 + STACKCT ~ 0; 04078500 + EMITO(DEL) END END EMITUP; 04079000 + COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 04080000 + INERVENING SPACE WITH NOPS, IT CHECKS STREAMTOG TO DECIDE 04081000 + WHICH SORT OF NOP TO USE; 04082000 + PROCEDURE ADJUST; 04083000 + BEGIN 04084000 + DIALA ~ DIALB ~ 0; 04085000 + WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000 + END ADJUST; 04087000 + COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000 + NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000 + BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000 + (FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000 + OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000 + ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000 + COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000 + EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,04095000 + AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000 + EMITLNG; 04097000 + PROCEDURE EMITLNG; 04098000 + BEGIN LABEL E; 04099000 + IF NOT LINKTOG THEN GO TO E; 04100000 + COMMENT GO TO E IF LAST THING IS A LINK; 04101000 + IF GET(L) ! 0 THEN GO TO E; 04102000 + COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000 + LNG OR RELATIONAL OPERATOR; 04104000 + IF GT1 ~ GET(L-1) = 77 THEN L ~ L-1 04105000 + COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000 + ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000 + COMMENT LAST THING WAS A RELATIONAL; 04108000 + BEGIN L~L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000 + BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000 + COMMENT NEGATE THE RELATIONAL; END ELSE 04111000 + E: EMITO(LNG) END EMITLNG; 04112000 + COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000 + PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000 + VALUE BRANCH,FROM,TOWARDS; 04115000 + INTEGER BRANCH,FROM,TOWARDS; 04116000 + BEGIN 04117000 + INTEGER TL; 04118000 + TL ~ L; 04119000 + L ~ FROM-2; 04120000 + GT1 ~ TOWARDS-FROM; 04120100 + IF TOWARDS.[46:2] = 0 04120200 + THEN BEGIN 04120300 + BRANCH ~ BRANCH&1[39:47:1]; 04120400 + GT1 ~ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500 + EMITNUM(ABS(GT1)); 04121000 + EMITO(BRANCH&(REAL(GT1} 0)+1)[42:46:2]); 04122000 + IF BOOLEAN(BRANCH.[38:1]) THEN DIALA ~ DIALB ~ 0; 04123000 + L ~ TL; 04124000 + END EMITB; 04125000 + COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000 + OCTAL, NAMELY : 04127000 + 1. 4 CHARACTERS FOR THE L REGISTER. 04128000 + 2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000 + STREAM PROCEDURE DEBUGWORD( SFQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000 + BEGIN 04131000 + DI~FEIL; SI~ LOC SEQ; SI~ SI+4; DS ~ 4 CHR; 04132000 + DS ~ 2 LIT" "; 04133000 + SI ~ LOC CODE ; 04134000 + 16( DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE 04135000 + DS ~ RESET ; SKIP 1 SB)); 04136000 + 49(DS ~ 2 LIT " "); 04137000 + END ; 04138000 + COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000 + DEBUGGING IS REQUIRED. "L" AND "WORD" ARE OUTPUT ON 04140000 + THE PRINTER FILE IN OCTAL FORMAT. ; 04141000 + PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000 + BEGIN 04143000 + ADJUST; 04144000 + IF L}4092 THEN ERR(200); 04145000 + ELSE BEGIN 04146000 + MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000 + IF DEBUGTOG THEN 04148000 + BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000 + WRITELINE END; 04150000 + L~L+4 END 04151000 + END EMITWORD; 04152000 + COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000 + BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000 + EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000 + OF C-RELATIVE OPDC S LEFT BY EMITNUM, IF C-RELATIVE 04156000 + ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000 + IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000 + THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000 + AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000 + F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000 + CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000 + PROCEDURE CONSTANTCLEAN ; 04163000 + IF MRCLEAN THEN 04164000 + BEGIN 04165000 + INTEGER J,TEMPL,D,LINK; 04166000 + BOOLEAN CREL; 04167000 + LABEL ALLTHU ; 04168000 + DIALA ~ DIALB ~ 0; 04169000 + FOR J ~ 1 STEP 2 UNTIL LASTENTRY DO 04170000 + BEGIN 04171000 + ADJUST; TEMPL~L; L~INFO[0,255-J+1]; 04172000 + CREL ~ FALSE; 04173000 + DO BEGIN 04174000 + IF D~(TEMPL-L+3)DIV 4}128 THEN 04175000 + BEGIN 04176000 + NCII~NCII+1; 04177000 + PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000 + PUTNBUMP(TAKE(255-J)); LASTINFO~NEXTINFO-2; 04179000 + GO TO ALLTHU; 04180000 + END; 04181000 + LINK~GET(L); 04182000 + CREL ~ TRUE; 04183000 + EMITV(D + 768); 04184000 + END UNTIL L~ LINK = 4095 ; 04185000 + ALLTHU: L ~ TEMPL; 04186000 + IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000 + END; 04188000 + LASTENTRY ~ 0; 04189000 + END ; 04190000 + COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000 + EXPLICIT AND IMPLICIT, IN EVERY CASE,EMITNUM WILL 04192000 + PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000 + THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000 + SYLLABLE IS PRODUCED, HOWEVER,NON-LITERALS ARE KEPT 04195000 + IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000 + POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000 + CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000 + TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000 + IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000 + ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000 + OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000 + PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000 + BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000 + IF C.[1:37]=0 THEN EMITL(C) 04205000 + ELSE 04206000 + BEGIN 04207000 + FOR N ~ 1 STEP 2 UNTIL LASTENTRY DO 04208000 + IF INFO[0,255-N] = C THEN GO TO FOUND ; 04209000 + INFO[0,255 -LASTENTRY] ~ L; 04210000 + INFO[0,255 -LASTENTRY-1]~ C ; 04211000 + EMITN(1023); 04212000 + LINKTOG~FALSE; 04213000 + IF LASTENTRY ~ LASTENTRY+2 } 128 THEN 04214000 + BEGIN 04215000 + C ~ BUMPL; 04216000 + CONSTANTCLEAN; 04217000 + EMITB(BFW,C,L); 04218000 + END; 04219000 + GO TO FINISHED; 04220000 + FOUND: EMIT(INFO[0,255 -N+1]); 04221000 + LINKTOG~FALSE; 04222000 + INFO[0,255-N+1]~ L-1; 04223000 + END; 04224000 + FINSIHED:END EMITNUM ; 04225000 + COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000 + ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000 + MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000 + BE FOUND SEARCH YIELDS BLANKS. 04229000 + NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000 + ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000 + BEGIN LABEL L; 04232000 + COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000 + BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000 + AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000 + THE LENGTH OF Q IS 128. ; 04236000 + INTEGER N,I ; 04237000 + N ~ 64 ; 04238000 + FOR I ~ 66 STEP IF Q[I] SUBLEVEL+1 THEN 04611000 + BEGIN 04612000 + EMIT(0); 04613000 + EMITPAIR(A,STD); 04614000 + END; 04615000 + EMITN(A); 04616000 +END CHECKDISJOINT; 04617000 + COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000 + COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000 + PROCEDURE STEPIT; ELCASS ~ TABLE(I~I+1); 05002000 + INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1); 05003000 + COMMENT TAKE FETCHS A WORD FROM INFO; 05004000 + REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000 + TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC]; 05006000 + COMMENT PUT PLACES A WORD INTO INFO; 05007000 + PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000 + INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD; 05009000 + COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPRESS FUTURE 05010000 + ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000 + PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000 + BEGIN 05013000 + COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000 + THE ERROR MESSAGE ON THE PRINTER; 05015000 + STREAM PROCEDURE WRITERROR(RMT,ERRNUM,ACCUM,LINE,COUNT,LSTSEQ); 05016000 + VALUE ERRNUM,COUNT; 05017000 + BEGIN 05018000 + DI:=LINE; 11(DS:=8 LIT " "); % BLANK LINE 05019000 + SI ~LSTSEQ; SI ~ SI-8; DS ~WDS; 05020000 + DS:=24 LIT " <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 05021000 + SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000 + DI~LINE; SI~RMT; SI~SI+7; 05024000 + IF SC="1" THEN 05024100 + BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200 + 7(IF SC>"0" THEN JUMP OUT; 05024300 + SI~SI+1; TALLY~TALLY+1); 05024400 + RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500 + END ELSE DI~DI+7; 05024600 + DS~14 LIT " ERROR NUMBER "; 05025000 + SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000 + DS ~ 4 LIT " -- "; 05027000 + SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000 + COMMENT PLACE ALPHA IN BUFFER; 05029000 + DS ~ LIT "." 05030000 + END WRITERROR; 05031000 + IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000 + BEGIN 05033000 + SPECTOG := FALSE; 05034000 + ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000 + IF NOT(LISTER OR REMOTOG) THEN 05036000 + BEGIN 05037000 + EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); 05038000 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039000 + IF NOHEADING THEN DATIME; WRITELINE; 05039500 + END; 05041000 + COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000 + ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000 + WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000 + INFO[LASTSEQROW,LASTSEQUENCE]); 05045000 + IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900 + IF NOT NOHEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000 + ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000 +IF PUNCHTOG THEN 05048000 + BEGIN 05049000 + STREAM PROCEDURE PUNCH(FL,ST); 05050000 + VALUE ST; 05051000 + BEGIN 05052000 + DI ~ FL; 05053000 + SI ~ ST; 05054000 + DS ~ 9 WDS 05055000 + END PUNCH; 05056000 + PUNCH(PNCH(0),FCR); 05057000 + MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000 + WRITE(PNCH) 05059000 + END 05060000 + END END FLAG; 05101000 + LABEL ENDOFITALL; 05101100 +COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000 + RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000 + SEMICOLON, END, OR BEGIN; 05104000 +PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000 + BEGIN FLAG(ERRNUM); 05106000 + I ~ I-1; 05107000 + IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100 + IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200 + DO IF STEPI = BEGINV THEN STMT UNTIL 05108000 + ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000 + DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000 + COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000 + UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000 + PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000 + BEGIN 05114000 + IF MODE } 2 THEN 05115000 + IF GTI1 ~ ELBATWORD.LVL } FRSTLEVEL THEN 05116000 + IF GTI1 < SUBLEVEL THEN 05117000 + IF ELBATWORD.[9:2] ! 1 05118000 + THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000 + END CHECKER; 05120000 + COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000 + GIVEN THE LINK TO THE ELBAT WORD; 05122000 + INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000 + GIT ~ TAKE(L).INCR+L.LINK; 05124000 + COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000 + IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000 + GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000 + INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000 + BEGIN 05129000 + REAL A; 05130000 + IF 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 MYERS; 05166000 + EMITO(MKS); L~(LTEMP~L)+1; EMITL(0); 05167000 + EMITL(2); CHECKER(ELBATWORD~ELBAT[I]); 05168000 + IF RRB1~(RRB2~ ELCLASS = SUPERFILEID)OR 05169000 + BOOLEAN(ELBATWORD.FORMAL) 05170000 + THEN EMITO(LNG); 05171000 + IF RRB2 05172000 + THEN BANA 05173000 + ELSE STEPIT; 05174000 + EMITN(ELBATWORD.ADDRESS); 05175000 + IF RRB2 05176000 + THEN EMITO(LOD); 05177000 + IF RRB1 05178000 + THEN EMITO(INX); 05179000 + EMITL(4); EMITV(14); 05180000 + END PASFILE; 05181000 + COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE05182000 + PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000 + PROCEDURE CHECKPRESENCE; 05184000 + BEGIN 05185000 + EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000 + END CHECKPRESENCE; 05187000 +COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 05187500 + TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510 +PROCEDURE PASSLIST; 05187520 + BEGIN 05187530 + INTEGER LISTADDRESS; 05187540 +COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 05187550 + CHECKER(ELBAT[I]); 05187560 + LISTADDRESS:=ELBAT[I].ADDRESS; 05187570 + IF FLCLASS = SUPERLISTID THEN % SUBSCRIPTED LIST ID. 05187580 + BEGIN 05187590 + BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600 + END 05187610 + ELSE BEGIN EMITL(LISTADDRESS); STEPIT END; 05187620 + END OF PASSLIST; 05187630 + REAL PROCEDURE TAKEFRST; 05188000 + TAKEFRST ~ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000 + COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000 + DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000 + STACK; 05198000 + PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000 + BEGIN 05200000 + EMITPAIR(ADDRESS,LOD); 05201000 + EMITN(512); 05202000 + EMITD(33,18,15) END STUFFF; 05203000 + COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000 + PRESENT CODE; 05205000 + BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000 + VALUE ELBATWORD; REAL ELBATWORD; 05207000 + BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000 + NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000 + LOCAL ~ TRUE END LOCAL; 05210000 + COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000 + PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000 + STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000 + PROCEDURE PASSFORMAT; 05214000 + BEGIN INTEGER ADRES; 05215000 + CHECKER(ELBAT[I]); 05216000 + ADRES ~ ELBAT[I].ADDRESS; 05217000 + IF BOOLEAN(ELBAT[I].FORMAL) 05218000 + THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END 05219000 + ELSE BEGIN 05220000 + IF TABLE(I) = SUPERFRMTID 05221000 + THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000 + END; 05223000 + IF TABLE(I) = SUPERFRMTID 05224000 + THEN BEGIN BANA; I ~ I-1; 05225000 + EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000 + EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000 + COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000 + WORDS - IT COMPLEMENTS THEIR STATE; 05229000 + PROCEDURE STREAMWORDS; 05230000 + BEGIN GT1 ~ 0; 05231000 + DO BEGIN 05232000 + INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000 + STACKHEAD[GT2] ~ T.LINK; 05234000 + GT1 ~ GT1+2; 05235000 + END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000 +STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000 + VALUE PRT,TYP,RELAD,SGNO; 05237500 + BEGIN LOCAL COUNT; 05238000 + DI:=LIN; DS:=6 LIT" PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 05238500 + 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05239000 + BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05239500 + COUNT:=TALLY; DS:=COUNT CHR; 05240000 + DS:= 31 LIT") = SEGMENT DESCRIPTOR, TYPE = "; 05240500 + SI:=LOC TYP; SI:=SI+7; DS:=CHR; % TYPE. 05241000 + DS:=21 LIT", RELATIVE ADDRESS = "; 05241500 + SI:=LOC RELAD; SI:=SI+4; DS:=4 CHR; % REL. ADDR. 05242000 + DS:=19 LIT", SEGMENT NUMBER = "; 05242500 + SI:=LOC SGNO; SI:=SI+4; DS:=4 CHR; DS:=LIT"."; 05243000 + END DEBUGDESC; 05243500 + REAL PROCEDURE PROGDESCBLDR(TYPE,RELAD,SPAC); 05245000 + COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE, IT IS 05246000 + CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 05247000 + BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 05248000 + SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 05249000 + THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 05250000 + TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE05251000 + AND ARGUMENT BIT FOR THE PROGRAM 05252000 + DESCRIPTOR TO BE BUILT. 05253000 + RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 05254000 + SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 05255000 + IF!0 THEN SPACE IS ALREADY 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 = FIELDID THEN % GET INFO FROM INFO 05273100 + BEGIN 05273200 + FIRST := ELBAT[I].SBITF; 05273300 + SECOND := ELBAT[I].NBITF; 05273400 + GO TO EXIT; 05273500 + END 05273600 + ELSE 05273700 + IF ELCLASS = LFTBRKET THEN 05273800 + IF STEPI = FIELDID THEN 05273900 + BEGIN 05274000 + FIRST := ELBAT[I].SBITF; 05274100 + SECOND := ELBAT[I].NBITF; 05274200 + IF STEPI = RTBRKET THEN 05274300 + GO TO EXIT; 05274400 + END 05274500 + ELSE 05274600 + IF ELCLASS = 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; 05307000 + BEGIN 05308000 + INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000 + BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000 + SI ~ W; SI ~ SI+S; SI + SI+S; DS ~ 2 CHR END; 05311000 + GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000 + COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000 + SCRIPTOR TO THE TOP OF THE STACK; 05314000 + PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000 + BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000 +REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000 + VALUE SIZE ; 05318000 + BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000 + FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000 + CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000 + ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000 + DI~LOC GETALPHA; DS~8 LIT"0 "; D~DI-7; 05323000 + SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000 + END GETALPHA; 05325000 +PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010 + BEGIN 05325020 + LABEL EXIT; 05325030 + STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040 + VALUE PORS,CELL,N; 05325050 + BEGIN 05325060 + LOCAL COUNT; 05325070 + LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080 + SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090 + IF SC="P" THEN 05325100 + BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110 + ELSE BEGIN 05325120 + DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130 + IF SC}"6" THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140 + COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150 + DS:=11 RESET; DI:=COUNT; 05325160 + END; 05325170 + SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180 + 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190 + BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200 + COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210 + DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220 + CI:=CI+N; 05325230 + GO M0; 05325240 + GO M1; 05325250 + GO M2; 05325260 + GO M3; 05325270 + GO M4; 05325280 + GO M5; 05325290 + GO M6; 05325300 + GO M7; 05325310 +M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320 + DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330 + GO XIT; 05325340 +M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350 +M2: DI:=CELL; 05325360 + DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370 +M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380 +M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390 +M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400 +M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410 +M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420 +XIT: 05325430 + END FILLIT; 05325440 + BLANKET(14,LIN); 05325450 + IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460 +ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470 +ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480 + IF NOHEADING THEN DATIME; WRITELINE; 05325490 + END WRITEPRT; 05325500 + COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 05326000 + THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 05327000 + PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 05328000 + PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 05329000 + MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 05330000 +INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000 + BOOLEAN PERMANENT; INTEGER L; 05333000 + BEGIN LABEL L1,L2,EXIT; 05334000 + BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000 + BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000120324PK + BOOLEAN M,Q; 05343000 + INTEGER ROW,COL,GS; 05344000 + IF PERMANENT 05345000 + THEN BEGIN 05346000 + IF PRTIMAX>1022 THEN FLAG(148);% 05347000 + SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000 + OR SPRT[GS]; 05349000 + PRTIMAX ~ (GS ~ PRTIMAX)+1 END 05350000 + ELSE IF MODE = 0 THEN BEGIN 05351000 + Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000 + M ~ MASK(COL ~ PRTI.[43:4]-35); 05353000 + COL ~ COL+35; 05354000 + L1: IF REAL(M AND Q) ! 0 05355000 + THEN BEGIN 05356000 + IF REAL(BOOLEAN(GS~4294967296-REAL(M)) AND Q) =GS 05357000 + THEN BEGIN 05358000 + COL ~ 0; M ~ TRUE; 05359000 + IF ROW ~ ROW+1 > 31 05360000 + THEN BEGIN FLAG(148); GS ~ PRTIMAX; 05361000 + GO TO L2 END; 05362000 + Q ~ SPRT[ROW]; 05363000 + GO TO L1 END; 05364000 + COL ~ COL+1; M ~ BOOLEAN(REAL(M)+REAL(M)); 05365000 + GO TO L1 END; 05366000 + PRTI ~ (GS ~ 32|ROW+COL)+1; 05367000 + IF PRTI > PRTIMAX THEN PRTIMAX ~ PRTI END 05368000 + ELSE BEGIN 05369000 + IF STACKCTR > 767 THEN FLAG(149); 05370000 + STACKCTR ~ (GS ~ STACKCTR)+1; Q ~ FALSE; 05371000 + GO TO EXIT END; 05372000 + L2: IF GS } 512 THEN GS ~ GS+1024; 05373000 + Q ~ TRUE; 05374000 + EXIT: GETSPACE ~ GS; 05375000 + IF GS > 1023 THEN GS ~ GS-1024; 05376000 + IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100 + END GETSPACE; 05378000 + COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 05379000 + BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000 + ARRAYCHECK~AAW.CLASSINTARRAYID 05381000 + OR AAW.INCR !1; 05382000 + COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000 + BOOLEAN PROCEDURE COMMACHECK; 05384000 + BEGIN IF NOT(COMMACHECK~(STEPI=COMMA)) THEN ERR(350); 05385000 + STEPIT 05386000 + END COMMACHECK; 05387000 + COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000 + BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000 + IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000 + IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK~TRUE ELSE 05390100 + IF TAKE(GT1~GIT(ELBW)!1 THEN ERR(357) ELSE 05391000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000 + HVCHECK~TRUE; 05393000 + COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000 + BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000 + IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000 + IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100 + IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000 + IF TAKE(GT1~1).CLASS!BOOID THEN ERR(353) ELSE 05398000 + IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000 + OUTPROCHECK~TRUE; 05400000 + COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000 + BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000 + IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000 + IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100 + IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000 + IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000 + EQLESCHECK~TRUE; 05407000 + COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000 + COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 06001000 + PROCEDURE AEXP; 06002000 + BEGIN 06003000 + IF ELCLASS = IFV 06004000 + THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000 + ELSE BEGIN ARITHSEC; SIMPARITH END 06006000 + END AEXP; 06007000 + COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000 + IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000 + AND Q ARE PRIMARIES; 06010000 + PROCEDURE ARITHSEC; 06011000 + BEGIN 06012000 + IF ELCLASS = ADOP 06013000 + THEN BEGIN 06014000 + STEPIT; 06015000 + IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000 + ELSE BEGIN 06017000 + PRIMARY; 06018000 + WHILE ELCLASS = FACTOP DO 06019000 + BEGIN STEPIT; PRIMARY; EMITUP END; 06020000 + ENDTOG ~ LINKTOG; EMITO(CHS); 06021000 + LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END 06022000 + ELSE PRIMARY END ARITHSEC; 06023000 + COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000 + ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000 + COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000 + WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000 + COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000 + SIMPARITH IS DONE BY ARITHCOMP. AN ARTIFIAL ROUTINE 06029000 + WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000 + ARITHOCMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000 + PROCEDURE SIMPARITH; 06032000 + BEGIN 06033000 + WHILE ELCLASS = AMPERSAND 06034000 + DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000 + WHILE ELCLASS}ADOP AND ELCLASS{FACTOP DO ARITHCOMP END; 06036000 + COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000 + ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000 + EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000 + IS OBTAINED BY RECURSION; 06040000 + PROCEDURE ARITHCOMP; 06041000 + BEGIN INTEGER OPERATOR, OPCLASS; 06042000 + DO BEGIN 06043000 + OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06044000 + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000 + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000 + OF THE ELBAT WORD; 06047000 + OPCLASS ~ ELCLASS; 06048000 + STEPIT; PRIMARY; 06049000 + IF OPCLASS = FACTOP THEN EMITUP 06050000 + ELSE BEGIN 06051000 + WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000 + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000 + STACKCT ~ 1; 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,T2,T3 ; 06059000 + BOOLEAN B ; 06059050 + DEFINE ERRX(ERRX1)=BEGIN T1~ERRX1; GO ERROR END #; 06059100 + LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000 + MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100 + LABEL ERROR,L1,L2,L3 ; 06060110 + SWITCH S ~ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000 + MAXANDMIN, MAXANDMIN, DELAY;% 06061100 + DEFINE MAXV = 6#;% 06061200 + IF T2~(T1~ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000 + IF T2!25 THEN EMITO(MKS) ; 06062110 + IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120 + IF T2<24 THEN 06062125 + BEGIN 06062130 +L3: IF TABLE(I+1)=COMMA THEN 06062135 + IF ELCLASS>BOOID AND ELCLASSBOOPROCID THEN 06062370 + IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)06062380 + ELSE BEGIN EMITL(514); STEPIT END 06062385 + ELSE IF ELCLASSBOOARRAYID 06062390 + THEN VARIABLE(FL) 06062400 + ELSE ERRX(185) ; 06062420 + IF ELCLASS!RTPAREN THEN ERRX(104); STEPIT ; 06062430 + EMITO(IF B THEN ISD ELSE STD); EMITV(17); GO EXIT ;06062435 + END ; 06062440 + IF T2<23 THEN 06062470 + BEGIN % DMOD, DARCTAN2 06062480 + B~TRUE; GO L3 ; 06062500 + END ; 06062535 + IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540 + EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560 + ERROR: ERR(T1); GO EXIT ; 06062565 + OTHERS: EMITO(MKS) ; 06064000 + PANA; 06065000 + EMITV(GNAT(T1)); GO TO EXIT; 06066000 + ABS: PANA; EMITO(SSP); GO TO EXIT; 06067000 + SIGN: PANA; 06068000 + EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000 + EMITD(1,1,1); GO TO EXIT; 06070000 + ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000 + EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000 + MAXANDMIN:% 06072010 + IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030 + BEGIN STEPIT; AEXP;% 06072040 + WHILE ELCLASS=COMMA DO% 06072050 + BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060 + EMITPAIR(JUNK, SND);% 06072070 + IF T2=MAXV THEN EMITO(LSS) ELSE EMITO(GTR) ; 06072080 + EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090 + END;% 06072100 + IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110 + END;% 06072120 + GO TO EXIT;% 06072130 + DELAY: IF STEPI!LEFTPAREN THEN% 06072200 + BEGIN ERR(105); GO TO EXIT END;% 06072210 + STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220 + BEGIN ERR(165); GO TO EXIT END;% 06072230 + STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240 + BEGIN ERR(165); GO TO EXIT END;% 06072250 + STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260 + BEGIN ERR(104); GO TO EXIT END ELSE STEPIT;% 06072270 + EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280 + GO TO EXIT;% 06072290 + TIME: PANA; EMITL(1); EMITO(COM); 06073000 + GO TO EXIT; 06073100 + STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200 + IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250 + BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300 + EMITPAIR(32, COM); T1~3; 06073350 + END ELSE BEGIN EMIT(4); EMIT(0); T1~0; 06073400 + IF ELCLASS}BOOARRAYID AND ELCLASS{INTARRAYID THEN 06073450 + BEGIN T1~FI; VARIABLE(T1); END ELSE AEXP; 06073500 + IF T1=FI THEN 06073550 + BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1~3 06073600 + END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650 + BEGIN EMIT(0); EMITPAIR(32, COM); T1~3 END 06073700 + ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750 + EMITO(XCH); EMITO(DEL); 06073800 + IF ELCLASS!COMMA THEN 06073810 + BEGIN ERR(129); GO TO EXIT END; 06073820 + STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830 + END; END; END; 06073840 + GTI1~0; 06073845 + DO EMITO(DEL) UNTIL GTI1~GTI1-1=T1;% 06073850 + IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860 + GO TO EXIT; 06073870 + EXIT: END IMPFUN; 06074000 + COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000 + OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000 + DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000 + CASES; 06078000 + PROCEDURE PRIMARY; 06079000 + BEGIN 06080000 + LABEL 06081000 + L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000 + L30, L31, L32, L33, L34, L35; 06084000 + SWITCH S ~ 06085000 + L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000 + L30, L31, L32, L33, L34, L35; 06088000 + COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000 + LABEL EXIT,RP,LDOT,LAMPER; 06090000 + GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000 + IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005 + BEGIN 06092010 + IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015 + GO TO LAMPER ; 06092020 + END ; 06092025 + L12: L13: L17: L21: L25: L29: L30: 06093000 + COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000 + IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950 + ERR(103); GO TO EXIT; 06095000 + L11: 06096000 + COMMENT INTRINSIC FUNCTIONS; 06097000 + IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; 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 = REALV THEN BEGIN 06117000 + IF STEPI ! LEFTPAREN 06118000 + THEN BEGIN ERR(105); GO TO EXIT END; 06119000 + STEPIT; BEXP; GO TO RP END; 06120000 + IF ELBAT[I].ADDRESS = INTV THEN 06120100 + BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200 + ERR(106); GO TO EXIT; 06121000 + L34: 06122000 + COMMENT (; 06123000 + STEPIT; AEXP; 06124000 + STACKCT ~ STACKCT-1; 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; 06128000 + WHILE ELCLASS = AMPERSAND 06128500 + DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000 + COMMENT THIS CODE HANDLES CANCATENATES; 06130000 + EXIT: END PRIMARY; 06131000 + COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000 + PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000 + COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000 + ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000 + BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000 + DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000 + OR DESIGNATIONAL EXPRESSION; 06138000 + INTEGER PROCEDURE EXPRSS; 06139000 + BEGIN 06140000 + IF ELCLASS = IFV 06141000 + THEN BEGIN 06142000 + IF EXPRSS ~ IFEXP = ATYPE 06143000 + THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000 + ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000 + END EXPRSS; 06146000 + COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000 + EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000 + AS EXPRSS REPORTS; 06149000 + INTEGER PROCEDURE BOOSEC; 06150000 + BEGIN BOOLEAN N; 06151000 + IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000 + GT4 ~ BOOSEC ~ BOOPRIM; 06153000 + IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000 + COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000 + RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000 + IF GT4 ! BTYPE THEN ERR(109) 06157000 + COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000 + LOGICALLY NEGATED; 06159000 + END END BOOSEC; 06160000 + COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000 + THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000 + ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000 + PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000 + A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000 + COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000 + LYSIS USING RECURSION; 06167000 + PROCEDURE SIMPBOO; 06168000 + BEGIN 06169000 + WHILE ELCLASS = AMPERSAND 06170000 + DO BEGIN 06171000 + STEPIT; 06172000 + IF BOOPRIM! BTYPE THEN ERR(109); 06173000 + PARSE END; 06174000 + WHILE ELCLASS } EQVOP AND ELCLASS { ANDOP DO BOOCOMP 06175000 + END BOOCOMP; 06176000 + COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000 + IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000 + OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000 + SION; 06180000 + PROCEDURE BOOCOMP; 06181000 + BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000 + DO BEGIN 06183000 + OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000 + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000 + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000 + OF THE ELBAT WORD; 06187000 + OPCLASS ~ ELCLASS; 06188000 + STEPIT; 06189000 + IF BOOSEC ! BTYPE 06190000 + THEN BEGIN ERR(109); GO TO EXIT END; 06191000 + WHILE OPCLASS < ELCLASS 06192000 + DO IF ELCLASS { ANDOP THEN BOOCOMP 06193000 + ELSE BEGIN ERR(110); GO TO EXIT END; 06194000 + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000 + STACKCT ~ 1; 06195500 + IF OPCLASS = IMPOP 06196000 + THEN BEGIN 06197000 + COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000 + ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000 + THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000 + EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000 + FUTURE. (SEE CODE FOR EMITLNG); 06202000 + EMITLNG; 06203000 + EMITO(LND); 06204000 + EMITO(LNG); 06205000 + EMITO(0); 06206000 + L ~ L-1 END 06207000 + ELSE EMIT(OPERATOR) 06208000 + END UNTIL OPCLASS ! ELCLASS; 06209000 + EXIT: END BOOCOMP; 06210000 + COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000 + DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000 + INTEGER PROCEDURE BOOPRIM; 06213000 + BEGIN INTEGER TYPE; 06214000 + LABEL L9, 06215000 + L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000 + L30, L31, L32, L33, L34, L35; 06218000 + SWITCH S ~ L9, 06219000 + L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000 + L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000 + L30, L31, L32, L33, L34, L35; 06222000 + COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000 + LABEL EXIT,LE,D,TD,T; 06224000 + LABEL FAH ; 06224500 + GO TO S[ELCLASS-SUPERFILEID]; 06225000 + IF ELCLASS = ADOP THEN GO TO L11; 06226000 + IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500 + BEGIN 06227510 + BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520 + GO FAH ; 06227530 + END ; 06227540 + LE: L10: L12: 06228000 + COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000 + EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000 + ERR(111); GO TO EXIT; 06231000 + L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000 + THEN BEGIN PANA; GO TO TD END; 06233000 + IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000 + L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000 + L31: L32: L33: 06236000 + COMMENT ARITHMETIC TYPE STUFF; 06237000 + AEXP; 06238000 + D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000 + RELATION; 06240000 + BOOPRIM ~ BTYPE; GO TO EXIT; 06241000 + L13: 06242000 + COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100 + STRMPROCSTMT; GO TO TD; 06244000 + L17: 06245000 + COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100 + PROCSTMT(FALSE); GO TO TD; 06247000 + L21: L25: 06248000 + COMMENT BOOLEAN VARIABLES; 06249000 + IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100 + VARIABLE(FP); GO TO T; 06250000 + L9: L29: 06251000 + COMMENT LABELS AND SWITCHES; 06252000 + DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000 + L30: 06254000 + COMMENT TRUE OR FALSE; 06255000 + EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000 + L34: 06257000 + COMMENT (; 06258000 + STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000 + COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000 + STACKCT ~ STACKCT-1; 06260500 + IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000 + STEPIT; 06262000 + FAH: 06262500 + IF TYPE = DTYPE THEN GO TO EXIT; 06263000 + COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000 + IF TYPE = BTYPE THEN BEGIN 06265000 + TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000 + T: STACKCT ~ STACKCT+1; 06267000 + WHILE ELCLASS = AMPERSAND DO 06267500 + COMMENT HANDLES CONCATENATE; 06268000 + BEGIN 06269000 + STEPIT; 06270000 + IF BOOPRIM ! BTYPE 06271000 + THEN BEGIN ERR(109); GO TO EXIT END; 06272000 + PARSE END; 06273000 + BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000 + COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000 + EXPRESSION; 06276000 + DOT; SIMPARITH; GO TO D; 06277000 + EXIT: END BOOPRIM; 06278000 + COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000 + EXPRESSION HAS ALREADY BEEN COMPILED; 06280000 + PROCEDURE RELATION; 06281000 + BEGIN 06282000 + INTEGER OPERATOR; 06282200 + REAL A; 06282400 + BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600 + DEFINE FORMALNAME = [9:2]=2#; 06282800 + PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S: REAL A; 06283000 + BEGIN 06283200 + IF C THEN EMITNUM(A) 06283400 + ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600 + IF S THEN EMITO(CHS); 06283800 + END PLUG; 06284000 + DO BEGIN 06284200 + OPERATOR:=1&ELBAT[I][36:17:10]; 06284400 +COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600 + EMITTED LATER (AFTER PROCESSING SECOND HALF). 06284800 + THE HIGH-ORDER BITS OF THE BINARY OPERATOR 06285000 + ARE TAKEN FROM THE [17:10] FIELD OF THE 06285200 + ELBAT WORD FRO THE RELATIONAL SYMBOL; 06285400 + IF MANY THEN 06285600 + IF SIMPLE THEN PLUG(CONSTANA,A,SIGNA) ELSE EMITV(JUNK); 06285800 + SIGNA:=FALSE; 06286000 + IF STEPI=ADOP THEN SIGNA:=ELBAT[I].ADDRESS=SUB; 06286200 + IF SIGN:=ELCLASS=ADOP THEN STEPIT; 06286400 + CONSTANA:=ELCLASS}NONLITNO AND ELCLASS{STRNGCON; 06286600 + A:=REAL(ELCLASS}REALID AND ELCLASS{INTID 06286800 + AND NOT ELBAT[I].FORMALNAME); 06287000 + SIMPLE:=(CONSTANA OR BOOLEAN(A)) AND STEPI=RELOP; 06287200 + IF SIMPLE THEN 06287400 + BEGIN 06287600 + IF CONSTANA THEN A:=C ELSE A:=ELBAT[I-1]; 06287800 + PLUG(CONSTANA,A,SIGNA) 06288000 + END 06288200 + ELSE BEGIN 06288400 + I:=I-REAL(SIGN)-2; STEPIT; AEXP; 06288600 + IF ELCLASS=RELOP THEN EMITPAIR(JUNK,SND); 06288800 + END; 06289000 + STACKCT:=1; EMIT(OPERATOR); 06289200 + IF MANY THEN EMITO(LND); 06289400 + ELSE BEGIN EMIT(0); L:=L-1 END; 06289600 + MANY:=TRUE; 06289800 + END UNTIL ELCASS!RELOP 06290000 + END RELATION; 06290200 + COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000 + OF EXPRESSIONS AS EXPRSS REPORTS; 06293000 + INTEGER PROCEDURE IFEXP; 06294000 + BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000 + IFCLAUSE; 06296000 + STACKCT ~ 0; 06296500 + THENBRANCH ~ BUMPL; 06297000 + COMMENT SAVE L FOR LATER FIXUP; 06298000 + IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000 + STACKCT ~ 0; 06299500 + ELSEBRANCH ~ BUMPL; 06300000 + EMITB(BFC,THEBRANCH,L); 06301000 + IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000 + STEPIT; 06303000 + IF TYPE = ATYPE THEN AEXP ELSE 06304000 + IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000 + STACKCT ~ 1; 06305500 + COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000 + EMITB(BFW,ELSEBRANCH,L); 06307000 + EMIT(1); L ~ L-1; 06308000 + COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000 + BOOSEC, BOOCOMP, AND RELATION; 06310000 + END END IFEXP; 06311000 + PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000 + BEGIN INTEGER FIRST,SECOND,THIRD; 06312500 + BOOLEAN P1,P2,P3; 06313000 + LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500 + IF ELCLASS = FIELDID THEN 06313550 + BEGIN 06313600 + FIRST := ELBAT[I].SBITF; 06313650 + SECOND := 48 - (THIRD := ELBAT[I].NBITF); 06313700 + GO TO SKIP1; 06313750 + END 06313800 + ELSE 06313850 + IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000 + IF STEPI = FIELDID THEN 06314050 + BEGIN 06314100 + FIRST := ELBAT[I].SBITF; 06314150 + SECOND := 48 - (THIRD := ELBAT[I].NBITF); 06314200 + IF STEPI ! RTBRKET THEN 06314250 + BEGIN 06314300 + ERR(94); 06314350 + GO TO EXIT; 06314400 + END; 06314450 + GO TO SKIP1; 06314500 + END 06314550 + ELSE 06314600 + IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL 06314650 + GO TO L1; 06314700 + FIRST ~ C; 06315000 + IF TABLE(I+1) = COLON THEN 06315500 + BEGIN 06316000 + STEPIT; 06316500 + IF FIRST {0 THEN FLAG(92); 06317000 + END ELSE 06317500 + BEGIN 06318000 + L1: EMITO(MKS); 06318500 + AEXP; 06319000 + P1 ~ TRUE; 06319500 + IF ELCLASS ! COLON THEN BEGIN ERR(91); GO TO EXIT END; 06320000 + END; 06320500 + IF STEPI ! LITNO THEN GO TO L2; 06321000 + 06321100 + SECOND ~ C ; 06321500 + IF GT1 ~ TABLE(I+1) = COLON THEN 06322000 + BEGIN 06322500 + STEPIT; 06323000 + IF SECOND {0 THEN FLAG(092); 06323500 + END ELSE 06324000 + BEGIN 06324500 + IF GT1 = RTBRKET THEN 06325000 + BEGIN 06325500 + STEPIT; 06326000 + SECOND ~ 48 - (THIRD ~ SECOND); 06326500 + GO TO SKIP2; 06327000 + END; 06327500 + L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000 + AEXP; 06328500 + P1 ~ P2 ~ TRUE; 06329000 + IF ELCLASS = COLON THEN 06329100 + 06329200 + 06329300 + ELSE 06329350 + IF ELCLASS = RTBRKET THEN 06329400 + BEGIN 06329450 + EMITO(DUP); 06329500 + EMITL(48) ;EMITO(SUB); 06329550 + EMITO(CHS);EMITO(XCH); 06329600 + P3 ~ TRUE; 06329700 + GO TO SKIP1; 06329800 + END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900 + END; 06330000 + IF STEPI ! LITNO THEN GO L3 ; 06330500 + THIRD ~ C; 06330600 + IF TABLE(I+1) = RTBRKET THEN 06330700 + BEGIN 06330800 + STEPIT; 06331000 + SKIP2: IF THIRD { 0 OR THIRD > 47 THEN FLAG(95); 06331100 + END ELSE 06331200 + BEGIN 06331300 + L3: IF NOT P2 THEN 06331500 + BEGIN 06331600 + IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700 + EMITL(SECOND); 06331800 + END; 06332000 + AEXP; 06332100 + P1~ P2~P3 ~TRUE; 06332200 + IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300 + END; 06332400 + SKIP1: IF P1 THEN 06332500 + BEGIN 06333000 + IF NOT P2 THEN EMITL(SECOND); 06333500 + IF NOT P3 THEN 06334000 + BEGIN 06334100 + EMITL(THIRD);EMITL(1); 06334200 + EMITV(GNAT(DIALER)); 06334500 + EMIT(TRB & THIRD[36:42:6]); 06334600 + END ELSE 06334700 + BEGIN 06335000 + EMITL(0); 06335100 + EMITV(GNAT(DIALER)); 06335200 + EMITO(DEL); 06335500 + END; 06335700 + END ELSE 06336000 + BEGIN 06336100 + IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200 + EMITD(SECOND,FIRST,THIRD); 06336300 + END; 06336400 + STEPIT; 06336500 + EXIT: STACKCT ~ 1; 06336600 + END PARSE; 06336700 + COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000 + THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100 + PROCEDURE DOTIT; 06338000 + BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000 + IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000 + 06342000 + EMITI(0,FIRST,SECOND); 06343000 + 06344000 + STEPIT; 06345000 + EXIT: END DOTIT; 06346000 + COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000 + PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000 + THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000 + SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000 + IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000 + IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000 + BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000 + THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000 + IS ALSO STORED IN F+1; 06355000 + PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000 + BEGIN INTEGER TLEVEL; 06357000 + EMITO(MKS); 06358000 + IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000 + JUMPCTR ~ TLEVEL; 06360000 + COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000 + INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000 + BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000 + JUMPING; 06364000 + IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000 + THEN BEGIN 06366000 + COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000 + EMIT(0); 06368000 + EMIT(TLEVEL); END 06369000 + ELSE BEGIN 06370000 + EMITN(512); 06371000 + EMITV(513); COMENT PICK UP BLOCKCTR AT ENTRY 06372000 + FROM F+1; 06373000 + IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000 + THEN BEGIN 06375000 + EMITL(TLEVEL); 06376000 + EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000 + AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000 + END END; 06379000 + EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000 + END GENGO; 06381000 + COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000 + IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000 + THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000 + STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000 + SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000 + COMMUNICATE WILL BE DONE; 06387000 + PROCEDURE DEXP; 06388000 + BEGIN 06389000 + LABEL EXIT; 06390000 + BOOLEAN S,F; 06391000 + REAL ELBW; 06392000 + IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000 + THEN BEGIN 06394000 + CHECKER(ELBW ~ ELBAT[I]); 06395000 + SCATTERELBAT; 06396000 + IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000 + IF FAULTOG THEN 06397100 + IF S OR F THEN FAULTLEVEL~1 ELSE 06397200 + IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300 + IF S THEN BEGIN 06398000 + BANA; EMITPAIR(JUNK,ISD); 06399000 + EMITV(GNAT(ELBW)); 06400000 + IF F THEN GO TO EXIT; END 06401000 + ELSE BEGIN 06402000 + STEPIT; 06403000 + IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000 + EMITL(GNAT(ELBW)) END; 06405000 + GENGO(ELBW); 06406000 + END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000 + EXIT: END DEXP; 06408000 + PROCEDURE IFCLAUSE; 06409000 + BEGIN STEPIT; STACKCT ~ 0; BEXP; 06410000 + IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000 + COMMENT PANA COMPILES THE CONSTRUCT: (); 06412000 + PROCEDURE PANA; 06413000 + BEGIN 06414000 + IF STEPI ! LEFTPAREN THEN ERR(105) 06415000 + ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000 + ERR(104) ELSE STEPIT END END PANA; 06417000 + COMMENT BANA COMPILES THE CONSTRUCT: []; 06418000 + PROCEDURE BANA; 06419000 + BEGIN 06420000 + IF STEPI ! LFTBRKET THEN ERR(117) 06421000 + ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000 + ERR(118) ELSE STEPIT END END BANA ; 06423000 + PROCEDURE MAKEALABEL; 06500000 + BEGIN LABEL EXIT; REAL I; 06501000 + STREAMTOG~FALSE; 06502000 + EMITO(MKS); PASSFILE; 06503000 + IF ELCLASS!WITHV THEN 06504000 + BEGIN ERR(301); GO TO EXIT END; 06505000 + FOR I~1 STEP 1 UNTIL 6 DO 06506000 + BEGIN IF STEPI=FACTOP THEN 06507000 + BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000 + ELSE AEXP; 06509000 + IF ELCLASS!COMMA THEN GO TO EXIT; 06510000 + END; 06511000 +EXIT: FOR I:=I STEP 1 UNTIL 5 DO 06512000 +BEGIN EMIT(4);EMITO(CHS) END; 06512100 +EMITL(11); 06512200 + EMITV(5); 06513000 + END; 06514000 + COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES; 07000000 + COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 07001000 + COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES 07002000 + ARE SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE 07003000 + FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME 07004000 + CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 07005000 +PROCEDURE COMPOUNDTAIL; 07006000 + BEGIN LABEL ANOTHER; 07007000 + I ~ I-1; BEGINCTR ~ BEGINCTR+1; 07008000 + ANOTHER: ERRORTOG ~ TRUE; COMMENT ALLOW ERROR MESSAGES; 07009000 + STEPTIT; 07010000 + IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000 + IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000 + IF ELCLASS ! ENDV 07013000 + THEN BEGIN 07014000 + ERR(119); GO TO ANOTHER END; 07015000 + ENDTOG~TRUE; 07016000 + DO STOPDEFINE~TRUE UNTIL 07017000 + STEPI{ENDV AND ELCLASS}UNTILV 07018000 + OR NOT ENDTOG; 07019000 + ENDTOG~FALSE; 07020000 + IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000 + THEN BEGIN 07022000 + IF BEGINCTR = 0 THEN 07023000 + BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000 +FLAG (120); 07025000 +FCR:= (LCR:=MKABS(CBUFF[9]))-9; 07025010 +IF LISTER THEN PRINTCARD; 07025020 +FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; 07025030 + IF ELCLASS = PERIOD THEN 07026000 + BEGIN 07027000 + GT5 ~ "ND;END."&"E"[1:43:5]; 07028000 + MOVE(1,GT5,CBUFF[0]); 07029000 + LASTUSED~4; 07030000 + ELBAT[I~I-2] ~SPECIAL[20]; 07031000 + ELCLASS ~ SEMICOLON END 07032000 + END COMPOUNDTAIL; 07033000 + COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000 + PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000 + ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000 + NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000 + CONCERNING THE PARAMETERS: 07038000 + FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000 + OR NOT. 07040000 + SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000 + PROCEDURE OR NOT. 07042000 + INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000 + INFORMATION; 07044000 + PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000 + VALUE FBIT,SBIT,INDEX; 07046000 + BOOLEAN FBIT,SBIT; 07047000 + INTEGER INDEX; 07048000 + BEGIN 07049000 + INTEGER PCTR,ACLASS,SCLASS; 07050000 + COMMENT 07051000 + PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000 + COMPILED. 07053000 + ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000 + SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 07055000 + THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000 + TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000 + SIMILAR MEANINGS; 07058000 + REAL WHOLE; 07059000 + COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000 + PARAMETERS; 07061000 + BOOLEAN VBIT; 07062000 + COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000 + BE CALLED BY VALUE OR BY NAME; 07064000 + LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000 + LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000 + CERR,FGEN; 07067000 + LABEL 07068000 + L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000 + L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000 + L31,L32,L33; 07071000 + SWITCH S ~ 07072000 + L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000 + L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000 + L31,L32,L33; 07075000 + REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000 + TO REDUCING TOTAL NUMBER; 07077000 + PCTR ~ 1; 07078000 + ANOTHER: ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 07079000 + STACKCT ~ 0; 07079500 + COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000 + IF FBIT THEN BEGIN VBIT ~ FALSE; SCLASS ~ LOCLID END 07081000 + COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000 + IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000 + METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK; 07084000 + ELSE BEGIN 07085000 + VBIT ~ BOOLEAN(GT1~ TAKE(INDEX+PCTR)).V0; 07086000 + IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000 + SCLASS } BOOSTRPROCID 07088000 + THEN IF GT1 ~ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000 + THEN SCLASS ~ SCLASS-GT1+1 07090000 + COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-07091000 + AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000 + SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000 + END; 07094000 + IF T1 ~ TABLE(I+1) ! COMMA THEN 07095000 + IF T1 ! RTPAREN THEN 07096000 + COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000 + HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000 + BEGIN IF ACLASS { IDMAX OR ACLESS = SUPERLISTID THEN 07099000 + CHECKER(WHOLE); 07099500 + IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000 + THEN BEGIN 07101000 + COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000 + HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000 + SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000 + IF ACLASS = SUPERFRMTID THEN 07105000 + BEGIN ACLASS ~ FRMTID; GO TO FGEN END; 07106000 + IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000 + THEN BEGIN 07108000 + T4~L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500 + IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505 + ACLASS ~ FILEID; 07109000 + COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000 + PASSFILE; 07111000 + IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200 + BEGIN 07111210 + IF VBIT THEN 07111220 + BEGIN 07111225 + T5~L; L~T4; EMITO(MKS); L~T5; T5~0 ; 07111230 + END ; 07111235 + ACLASS~IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240 + THEN REALID ELSE BOOID ; 07111250 + IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255 + IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260 + BEGIN 07111265 + SIMPARITH ; 07111270 + IF ELCLASS=RELOP THEN 07111275 + BEGIN 07111280 + ACLASS~BOOID; RELATION ; 07111285 + SIMPBOO ; 07111290 + END ; 07111295 + END ; 07111300 + IF NOT VBIT THEN 07111303 + BEGIN 07111307 + EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310 + EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315 + EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320 + EMITB(BFW,T4+2,L) ; 07111325 + STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330 + END ; 07111335 + GO BS ; 07111340 + END OF FILE ATTRIBUTE PARAMETER EXPRESSION;07111345 + IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000 + I ~ I-1; 07113000 + COMMENT IF WE ARE HERE IT IS INDEXED; 07114000 + CHECKPRESENCE; 07115000 + EMITO(LOD); PANA; EMITO(CDC); 07116000 + IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000 + THEN BEGIN ERR(121); GO TO CERR END 07118000 + COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000 + STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000 + RELEASE ON THIS DESCRIPTOR; 07121000 + ELSE GO TO COMMON END ; 07122000 + IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500 + EMITV(WHOLE.ADDRESS); 07122510 + IF WHOLE.ADDRESS>1023 THEN EMITO(PRTE); 07122520 + EMITO(LOD); 07122530 + ACLASS~LISTID; GO TO BS END; 07122540 + COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000 + NORMAL: IF VBIT THEN 07124000 + VE: T1 ~ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000 + ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000 + IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000 + COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;07128000 + T2 ~ BAE; 07129000 + T3 ~ PROGDESCBLDR(0,L,0); 07130000 + COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000 + AROUND CODE FOR EXPRESSION; 07132000 + T1 ~ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000 + STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000 + COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000 + PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000 + INTO JUNK; 07137000 + LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000 + COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000 + THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000 + EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000 + THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000 + OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000 + END OF NAME CALL EXPRESSIONS; 07144000 + ACLASS ~ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000 + THEN BOOID ELSE LABELID; GO TO BS; 07146000 + END OF EXPRESSION CALL CODE; 07147000 + COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000 + ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000 + IF SCLASS } BOOARRAYID THEN 07150000 + IF SCLASS {INTARRAYID THEN 07151000 + BEGIN T2 ~ TAKE(INDEX+PCTR).INCR; 07152000 + COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.07153000 + THUS WE MUST HAVE A ROW DESIGNATOR; 07154000 + IF ACLASS ! BOOARRAYID THEN ACLASS ~ REALARRAYID; 07155000 + COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000 + VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000 + THEN BEGIN ERR(123); GO TO EXIT END; 07158000 + COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000 + COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000 + STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000 + LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000 + THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000 + ELSE GO TO BS END; 07167000 + IF VBIT THEN GO TO VE; 07168000 + COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000 + VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000 + IF SBIT 07171000 + THEN BEGIN 07172000 + T6 ~ FL; VARIABLE(T6); 07173000 + IF T6 ! 0 THEN GO TO BS; 07174000 + FLAG(122);GO TO CERR END; 07175000 + COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000 + CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000 + VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000 + THAN THIS IT SETS T6 TO ZERO; 07179000 + COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000 + WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000 + 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 07182000 + 2) A SUBSCRIPTED VARIABLE, OR 07183000 + 3) A GENUINE NAME CALL EXPRESSION; 07184000 + IF TABLE(I+2) = LITNO AND 07185000 + ( GT1 ~ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000 + THEN BEGIN 07187000 + COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000 + CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000 + ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000 + VARIABLE(FL); 07191000 + ACLASS ~ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000 + REALID; GO TO BS END; 07193000 + T2 ~ BAE; T3 ~ L; 07194000 + COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000 + IF WE HAVE ROW DESIGNATOR; 07196000 + T6 ~ FA; VARIABLE(T6); 07197000 + IF TABLE(I-2) = FACTOP 07198000 + THEN BEGIN 07199000 + COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000 + EMITB(BFW,T2,T3); T2 ~ STLB; GO TO LOWBD END; 07201000 + COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000 + T3 ~ PROGDESCBLDR(0,T3,0); 07203000 + T1 ~ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000 + IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000 + COMMENT WE ARE AT END OF PARAMETER; 07206000 + IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000 + GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000 + GO TO LRTS; 07209000 + IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000 + IF ELCLASS = RELOP THEN BEGIN T1 ~ BTYPE; RELATION; 07211000 + FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000 + COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000 + ACTUAL PARAMETER; 07214000 + IF ACLASS { IDMAX OR ACLASS = SUPERLISTID THEN 07215000 + CHECKER(WHOLE); STEPIT; 07215500 + GO TO S[ACLASS-3]; 07216000 + IF ACLASS = 0 THEN FLAG(100) ELSE 07217000 + IF ACLASS= SUPERLISTID THEN 07217500 + BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510 + FLAG(126); 07217520 + CERR: 07218000 + L12:L13:L14:L15:L16: 07219000 + COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000 + FLAG(125); ERRORTOG ~ TRUE; GO TO COMMON; 07221000 + LODPOINT: 07222000 + L4:L8: 07223000 + COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000 + EMITPAIR(ADDRSF,LOD); 07225000 + NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000 + COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000 + STREAM PROCEDURES; 07228000 + BS: IF SCLASS ! ACLASS THEN 07229000 + IF SCLASS ! LOCLID THEN 07230000 + COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000 + AGREE; 07232000 + BEGIN FLAG(123); GO TO CERR END; 07233000 + COMMON: 07234000 + COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000 + PCTR ~ PCTR+1; 07236000 + IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000 + IF ELCLASS ! RTPAREN 07238000 + THEN BEGIN ERROR(129); GO TO EXIT END; 07239000 + IF NOT FBIT THEN 07240000 + IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000 + THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000 + ERR(128); GO TO EXIT END; 07243000 + STEPIT; GO TO EXIT; 07244000 + L5: 07245000 + COMMENT FORMATS; 07246000 + I~I-1; 07247000 + FGEN: PASSFORMAT; 07248000 + IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000 + I~I+1; 07250000 + GO TO BS; 07251000 + L6: 07252000 + COMMENT SUPERFORMAT; 07253000 + IF FBIT 07254000 + THEN BEGIN EMITV(ADDRSF); ADDRSF ~ ADDRSF-1 END 07255000 + ELSE BEGIN I ~ I -1; EMITL(TAKEFRST); I ~ I+1 END; 07256000 + GO TO LODPOINT; 07257000 + L7: 07258000 + COMMENT FILE; 07259000 + I ~ I-1; ELCLASS ~ FILEID; 07260000 + PASSFILE; GO TO BS; 07261000 + L9: 07262000 + COMMENT SWITCH; 07263000 + IF FORMALF THEN GO TO LODPOINT; 07264000 + COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000 + MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000 + DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000 + ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000 + THEY ARE OR NOT; 07269000 + T2 ~ BAE; T3~PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000 + GENGO(WHOLE); 07271000 + EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000 + L10: 07273000 + COMMENT PROCEDURE; 07274000 + TB1 ~ TRUE; IF FORMALF THEN GO LODPOINT; 07275000 + LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000 + THEN BEGIN 07277000 + COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000 + IF TB1 THEN GO TO LODPOINT; 07279000 + COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000 + DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);07281000 + IF NOT FBIT THEN 07281900 + IF SCLASS { INTPROCID THEN SCLASS ~ SCLASS+4; 07282000 + I ~ I-2; STEPIT; 07283000 + GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000 + EXPRESSIONS HANDLE THIS CASE; 07285000 + END THE CASE OF ZERO PARAMETERS; 07286000 + TB1 ~ TRUE; 07287000 + FOR T2 ~ 1 STEP 1 UNTIL T1 07288000 + DO BEGIN 07289000 + IF BOOLEAN(T3~TAKE(WHOLE+T2)).V0 07290000 + THEN 07291000 + IF T4 ~ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000 + THEN BEGIN 07293000 + COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000 + IF TB1 THEN 07295000 + BEGIN 07296000 + COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000 + VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000 + PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000 + VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000 + PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK07301000 + CONSTRUCTIONS; 07302000 + GOBBLE: 07303000 + TB1 ~ FALSE; T5 ~ BAE; 07304000 + T6 ~ PROGDESCBLDR(1,L,0) END; 07305000 + EMITV(T4 ~ T3.ADDRESS); EMITPAIR(T4,STD)END END;07306000 + COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000 + IF NOT TB1 07308000 + THEN BEGIN 07309000 + COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000 + EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000 + CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000 + GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000 + L11: 07314000 + COMMENT INTRINSIC PROCEDURE; 07315000 + ADDRSF ~ GNAT(WHOLE); 07316000 + COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000 + ACLASS ~ REALPROCID; 07318000 + T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000 + COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000 + PROCEDURES; 07321000 + L19:L20: 07322000 + COMMENT ALFAPROC AND INTPROC; 07323000 + ACLASS ~ REALPROCID; 07324000 + L17:L18: 07325000 + COMMENT BOOPROC AND REAL PROC; 07326000 + IF FORMALF 07327000 + THEN BEGIN 07328000 + COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000 + IF SCLASS > INTPROCID THEN ACLASS ~ ACLASS+4; 07330000 + COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000 + EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000 + PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000 + IF VBIT 07334000 + THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000 + ELSE GO TO LODPOINT; 07336000 + COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000 + DESCRIPTOR ALONG; 07338000 + END; 07339000 + TB1 ~ FALSE; GO TO LP; 07340000 + L23:L24: 07341000 + COMMENT INTEGER AND ALPHA IDS; 07342000 + ACLASS ~ REALID; 07343000 + L21:L22: 07344000 + COMMENT BOOLEAN AND REAL IDS; 07345000 + IF VBIT THEN EMITV(ADDRSF) 07346000 + ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000 + THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000 + COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000 + AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000 + THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000 + GO TO BS; 07352000 + L27:L28: 07353000 + COMMENT INTEGER AND ALPHA ARRAYS; 07354000 + ACLASS ~ REALARRAYID; 07355000 + L25:L26: 07356000 + COMMENT BOOLEAN AND REAL ARRAYS; 07357000 + EMITPAIR(ADDRSF,LOD); 07358000 + IF SBIT THEN GO TO BS; 07359000 + COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000 + T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000 + FOR T2 ~ 1 STEP 1 UNTIL T1 07362000 + DO BEGIN 07363000 + IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000 + THEN EMITV(T3) ELSE EMIT(STLB); 07365000 + IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000 + COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000 + IF FBIT THEN GO TO BS; 07368000 + IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000 + COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000 + OF DIMENSIONS; 07371000 + L29: 07372000 + COMMENT LABEL; 07373000 + ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000 + L30: 07375000 + COMMENT TRUTH VALUE; 07376000 + EMITL(ADDRSF); ACLASS ~ BOOID; GO TO BSX; 07377000 + L32: 07378000 + COMMENT LITERAL; 07379000 + EMITL(ADDRSF); 07380000 + 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 END OF ACTUALPARAPART; 07385000 + COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000 + FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000 + PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000 + IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000 + OPERATIONS; 07390000 + PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000 + BEGIN 07392000 + REAL HOLE,ADDRESS; 07393000 + LABEL EXIT; 07394000 + SCATTERELBAT; 07395000 + HOLE~ ELBAT[I]; 07396000 + ADDRESS ~ ADDRSF; 07397000 + CHECKER(HOLE); 07398000 + IF ELCLASS ! PROCID THEN 07399000 + IF NOT FORMALF THEN 07400000 + IF TABLE(I+1) = ASSIGNOP THEN 07401000 + BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000 + COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000 + IF ELCLASS ! PROCID EQV FROM 07404000 + THEN BEGIN ERR(159); GO TO EXIT END; 07405000 + COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000 + STEPIT; 07407000 + EMITO(MKS); 07408000 + IF ELCLASS = LEFTPAREN 07409000 + THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000 + ELSE IF FORMALF THEN 07411000 + IF FROM THEN ELSE L~L-1 07411100 + ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000 + EMITV(ADDRESS); 07413000 + COMMENT MONITOR CODE GOES HERE; 07414000 + IF HOLE < 0 07415000 + THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR07416000 + ; 07417000 + EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000 + EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000 + EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000 + EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000 + (GIT(HOLE)).FUNCMONFILE); 07422000 + EMITNUM(1&CARDNUMBER[1:4:44]); 07422100 + EMITV(GNAT(PRINTI)); 07423000 + END; 07424000 + EXIT: END PROCSTMT; 07425000 + COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000 + PROCEDURE STRMPROCSTMT; 07427000 + BEGIN 07428000 + INTEGER ADDRS; 07429000 + IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000 + THEN BEGIN 07431000 + UNKNOWNSTMT; 07432000 + END 07433000 + 07434000 + 07435000 + 07436000 + 07437000 + 07438000 + 07439000 + ELSE BEGIN 07440000 + IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000 + GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000 + GT4 ~ GT1-GT2.[7:6]; 07443000 + FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000 + DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000 + COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000 + JUMPS INSIDE OF STREAM PROCEDURES; 07447000 + GT4 ~ GT2.[1:6]; 07448000 + FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000 + COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE07450000 + OF STREAM PROCEDURES; 07451000 + IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000 + ELSE BEGIN 07453000 + ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000 + END END STRMPROCSTMT; 07455000 + COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000 + ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000 + INTEGER PROCEDURE BAE; 07458000 + BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000 +COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000 + RELEASE() % AUXMEM RELEASE STATEMENT. 07460250 + RELEASE() % DATACOM RELEASE STATEMENT. 07460500 + RELEASE() % FILE RELEASE STATEMENT. 07460750 + ; 07461000 +PROCEDURE RELSESTMT; 07461250 + BEGIN 07461500 + LABEL DCR,PARENCHECK,EXIT; 07461750 + IF STEPI!LEFTPAREN THEN 07462000 + BEGIN ERR(105); GO EXIT END; 07462250 + IF STEPI=UNKNOWNID THEN 07462500 + BEGIN ERR(100); GO EXIT END; 07462750 + IF ELCLASS=PROCID OR RANGE(BOOPROCID,INTPROCID) THEN 07463000 + BEGIN 07463250 + EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITPAIR(38,COM); 07463500 + EMITO(DEL); STEPIT; GO PARENCHECK; 07463750 + END; 07464000 + IF RANGE(BOOARRAYID,INTARRAYID) THEN 07464250 + BEGIN 07464500 + REL:=TRUE;AEXP; REL:=FALSE; 07464750 + IF TABLE(I-2) = FACTOP THEN 07465000 + BEGIN STACKCT:=STACKCT-1; 07465250 + EMITPAIR(38,COM); EMIT0(DEL); GO PARENCHECK; 07465500 + END 07465750 + ELSE BEGIN % DATACOM RELEASE. 07466000 +DCR: 07466250 + EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500 + EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750 + EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000 + END; 07467250 + END; 07467500 + IF FLCLASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750 + BEGIN AEXP; GO DCR; END; 07468000 + CHECKER(ELBAT[I]); PASSFILE; 07468250 + IF ELCLASS = COMMA THEN EMITO(DUP); 07468500 +COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750 + CHECKPRESENCE; 07469000 +COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250 + NOT COMPLETED; 07469500 + EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750 + IF ELCLASS = COMMA THEN 07470000 + BEGIN 07470250 + EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500 + EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750 + END; 07471000 + EMITO(PRL); EMITO(DEL); 07471250 +PARENCHECK: 07471500 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750 +EXIT: 07472000 + END RELSESTMT; 07472250 + COMMENT DOTSTMT HANDLES THE DO STATEMENT; 07481000 + PROCEDURE DOSTMT; 07482000 + BEGIN INTEGER TL; 07483000 + DIALA ~ DIALB ~ 0; 07484000 + ADJUST; 07484100 + STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000 + ELSE BEGIN 07486000 + STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000 + END DOSTMT; 07488000 + COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000 + PROCEDURE WHILESTMT; 07490000 + BEGIN INTEGER BACK,FRONT; 07491000 + DIALA ~ DIALB ~ 0; 07492000 + ADJUST; 07492100 + STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL; 07493000 + IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000 + BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000 + CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000 + COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000 + EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000 + OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000 + STORAGE RETURNED. SEE DEXP AND GENGO; 07500000 + PROCEDURE GOSTMT; 07501000 + BEGIN 07502000 + REAL ELBW; 07503000 + LABEL GOMCP,EXIT; 07504000 + IF STEPI = TOV THEN STEPIT; 07505000 + IF ELCLASS = LABELID THEN TB1 ~ TRUE 07506000 + ELSE IF ELCLASS = SWITCHID THEN TB1 ~ FALSE ELSE GO GOCMP;07507000 + IF NOT LOCAL(ELBAT[I]) THEN GO GOCMP; 07508000 + IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000 + CONSTANTCLEAN; GO EXIT END; 07510000 + ELBW ~ ELBAT[I]; 07511000 + IF ELBW < 0 07512000 + THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000 + EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000 + CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)), 07515000 + SWITMONFILE); 07516000 + EMITNUM(0&CARDNUMBER[1:4:44]); 07516100 + EMITV(GNAT( 07516200 + PRINTI)); 07517000 + END; 07518000 + BANA; EMITPAIR(JUNK,ISD); 07519000 + IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000 + AND ELBW.ADDRESS = 0 THEN BEGIN 07521000 + PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000 + EMITB(BBW,L,GT4~GT1.[36:12]); 07523000 + EMITB(BFW,GT4+13,L+3); 07524000 + EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000 + ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000 + GO EXIT; 07527000 + GOMCP: GOTOG ~ FALSE; DEXP; 07528000 + IF GOTOG THEN 07529000 + BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100 + ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200 + EXIT:END GOSTMT; 07530000 + COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 07531000 + PARAMETER. GOGEN ASSUMES 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 + STEPTIT; 07580000 + IF SIMPGO 07581000 + THEN BEGIN 07582000 + T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000 + STEPIT; GO EXIT END; 07584000 + T2 ~ BUMPL; CONSTANTCLEAN; 07585000 + EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000 + EXIT: END IFSTMT; 07587000 + COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000 + ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000 + AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000 + UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 07591000 + IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 07592000 + PROCEDURE LABELR; 07593000 + BEGIN LABEL EXIT, ROUND; 07594000 +DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000 + =GT4#,NEXTLINK=GT5#; 07596000 + DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000 + BEGIN ERR(133); GO TO EXIT END; 07598000 + XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION 07598100 + % WHEN WE GET AROUND TO THE XREF. 07598200 + IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000 + THEN BEGIN FLAG(134); GO TO ROUND END; 07600000 + LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD))) 07601000 + .[36:12]; 07602000 + IF ADDITIONAL < 0 THEN 07603000 + BEGIN FLAG(135); GO TO ROUND END; 07604000 + WHILE LINK ! 0 07605000 + DO BEGIN 07606000 + NEXTLINK ~ GET(LINK-2); 07607000 + EMITB(GET(LINK-1),LINK,L); 07608000 + LINK ~ NEXTLINK; 07609000 + IF LASTENTRY } 126 THEN % DONT LET EMITNUM DO IT 07609100 + BEGIN REAL C; % HOLD L FOR A WHILE 07609200 + COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300 + (>1023 WORD) FORWARD REFERENCES TO A LABEL;07609400 + C ~ BUMPL; 07609500 + CONSTANTCLEAN; 07609600 + EMITB(BFW,C,L) END;END; 07609700 + PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000 + IF ELBATWORD < 0 07611000 + THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000 + OR MONITOR DECLARATION; 07613000 + IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000 + THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000 + LABELS; 07616000 + EMITO(MKS); PASSALPHA(ELBATWORD); 07617000 + EMITPAIR(GNAT(CHARI),LOD); 07618000 + PASSMONFILE(RR1); 07619000 + EMITNUM(0&CARDNUMBER[1:4:44]); 07619100 + EMITV(GNAT(PRINTI)); 07620000 + END; 07621000 + IF RR1~ADDITIONAL.DUMPEE ! 0 07622000 + THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000 + LABEL COUNTER; 07624000 + EMITV(RR1); EMITL(1); EMITO(ADD); 07625000 + EMITPAIR (RR1,STD); 07626000 + IF RR1~ADDITIONAL.DUMPOR ! 0 07627000 + THEN BEGIN COMMENT EMIT CODE TO CALL 07628000 + THE DUMP ROUTINE; 07629000 + 07630000 + 07631000 + 07632000 + STUFFF(RR1); EMITO07633000 + (XCH);EMITO(COC); 07634000 + 07635000 + 07636000 + 07637000 + 07638000 + 07639000 + 07640000 + EMITO(DEL); 07641000 + END; 07642000 + END; 07643000 + END; 07644000 + ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000 + EXIT: END LABELR; 07646000 +PROCEDURE CASESTMT; 07646100 +BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110 + CASE OF BEGIN 07646120 + AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130 + IN THE , DEPENDING ON THE VALUE OF THE , 07646140 + ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150 + THE . IF THERE ARE N STATEMENTS IN THE 07646160 + , THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1. 07646170 + AND THE MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 07646180 + WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 07646190 + THE STATEMENTS IN THE MAY BE ANY EXECUTABLE 07646200 + STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210 + AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220 + 07646230 + OPDC ARRAY 07646240 + BFW 07646250 + STMT 0 07646260 + BRANCH TO RESUME 07646270 + STMT 1 07646280 + BRANCH TO RESUME 07646290 + . 07646300 + . 07646310 + . 07646320 + STMT N-1 07646330 + RESUME: 07646340 + "ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 07646350 + CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 07646360 + BY THE VALUE OF AND CONTAINS SYLLABLE COUNTS 07646370 + FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 07646375 + IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 07646380 + TRANSFERS TO RESUME DIRECTLY; 07646385 + REAL LINK, TEMP, N, ADR, PRT, NULL; 07646390 + BOOLEAN GOTOG; 07646395 + REAL ARRAY TEDOC[0:7, 0:127]; 07646400 + LABEL LOOP, XIT; 07646410 + LINK ~ N ~ NULL ~ 0; 07646420 + STEPIT; AEXP; 07646430 + IF STEPI ! BEGINV THEN BEGIN ERR( 70); GO TO XIT END; 07646440 + EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450 + EMITO(BFW); ADR ~ L; 07646460 +LOOP: 07646470 + ERRORTOG ~ TRUE; 07646475 + IF STEPI = SEMICOLON THEN 07646480 + BEGIN COMMENT NULL STATEMENT; 07646485 + TEDOC[N.[38:3], N.[41:7]] ~ NULL; 07646490 + NULL ~ N ~ N+1; GO TO LOOP; 07646495 + END; 07646500 + TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510 + IF GOTOG := SIMPGO THEN ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646515 + STMT; 07646520 + IF ELCLASS = SEMICOLON THEN 07646525 + BEGIN IF NOT GOTOG THEN 07646530 + BEGIN EMIT(LINK);LINK ~ L ~ L+1; END; 07646533 + GO TO LOOP; 07646535 + END ELSE IF ELCLASS = ENDV THEN 07646538 + BEGIN IF NOT GOTOG THEN 07646540 + BEGIN EMIT(LINK); LINK ~ L ~ L+1; END; 07646543 + TEDOC[N.[38:3], N.[41:7]]~ L-ADR; 07646545 + N ~ N+1; 07646548 + END; 07646550 + IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555 + N := N-1 ; 07646556 + WHILE NULL ! 0 DO 07646560 + BEGIN TEMP ~ TEDOC[(NULL~NULL-1).[38:3], NULL.[41:7]]; 07646565 + TEDOC[NULL.[38:3], NULL.[41:7]] ~ L-ADR; 07646570 + NULL ~ TEMP; 07646575 + END; 07646580 + ENDTOG ~ TRUE; 07646585 + COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590 + DO STOPDEFINE ~ TRUE UNTIL STEPI { ENDV AND ELCLASS }UNTILV 07646595 + OR NOT ENDTOG; 07646600 + ENDTOG ~ FALSE; 07646610 + COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620 + MOVECODE(TEDOC, EDOC); 07646630 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07646635 + TEMP := SGNO; IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07646640 + SGNO ~ SGAVL; 07646650 + Z ~ PROGDESCBLDR(LDES, 0, PRT); 07646660 + SEGMENT(-N, SGNO, TEMP); 07646670 + SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680 + BUILDLINE ~ BUILDLINE.[46:1] ; 07646685 + MOVECODE(TEDOC, EDOC); 07646690 + COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700 + IF (L-ADR)>1019 THEN ADJUST;% 07646705 + WHILE LINK ! 0 DO 07646710 + BEGIN TEMP ~ GET(LINK-2); 07646720 + EMITB(BFW, LINK, L); 07646730 + LINK ~ TEMP; 07646740 + IF LASTENTRY } 126 THEN 07646750 + BEGIN REAL C; 07646760 + COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770 + C ~ BUMPL; 07646780 + CONSTANTCLEAN; 07646790 + EMITB(BFW, C, L); 07646800 + END; 07646810 + END; 07646820 +XIT: 07646830 +END CASESTMT; 07646840 +COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07647000 + IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07647500 + THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07648000 + THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07648500 + NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07649000 + RESIDES ON THE DISK AND IS READ INTO THE ROW DESIGNATED 07649500 + BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07650000 + EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07650500 + ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07651000 + NUMBERS LOOK LIKE IDENITIFERS TO FILLSTMT AND ARE CONVERTED 07651500 + BY OCTIZE.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN 07652000 + PDPRT TO SUPPLY INFO TO BUILD A DISK DESCRIPTOR IN THE 07652500 + SEGMENT DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07653000 +PROCEDURE FILLSTMT; 07653500 + BEGIN 07654000 + LABEL EXIT; 07654500 + DEFINE PARENCOUNTER = RR1#, 07655000 + T = RR2#, 07655500 + J = RR3#; 07656000 + ARRAY TEDOC[0:7,0:127], FILLTEMP[0:1022]; 07656500 + BOOLEAN PROCEDURE FILLIT(A); ARRAY A[0]; 07657000 + BEGIN 07657500 + REAL T1, T2, T3; 07658000 + BOOLEAN BOO; 07658500 + LABEL CHECK, GOOFUP, EXIT; 07659000 + PARENCOUNTER:=PARENCOUNTER+1; 07659500 + WHILE T<1023 DO 07660000 + BEGIN 07660500 + IF STEPI>IDMAX THEN 07661000 + BEGIN 07661500 + IF ELCLASS=LITNO THEN 07662000 + IF TABLE(I+1)=LEFTPAREN THEN 07662500 + BEGIN 07663000 + T1:=ELBAT[I].ADDRESS; T2:=T; 07663500 + STEPIT; IF FILLIT(A) THEN GO GOOFUP; 07664000 + IF T1=0 THEN T:=T2 07664500 + ELSE BEGIN 07665000 + IF (T3:=(T1-1)|(T-T2))+T>1022 THEN 07665500 + BEGIN ERROR(305); GO GOOFUP END;%>102307666000 + MOVE(T3,A[T2],A[T]); T:=T+T3; 07666500 + END; 07667000 + GO CHECK; 07667500 + END REPEAT PART; 07668000 + IF (BOO:=ELCLASS=ADOP) THEN STEPIT; 07668500 + IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN 07669000 + IF ELCASS!STRING AND(ELCASS!STRNGCON OR BOO) THEN 07669500 + BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07670000 + IF BOO THEN C:=C&ELBAT[I-1][1:21:1]; 07670500 + IF ELCLASS=STRING THEN 07671000 + BEGIN 07671500 + IF (T2:=T+(COUNT+7)DIV 8-1)>1022 THEN 07672000 + BEGIN ERROR(305); GO GOOFUP END; % > 1023. 07672500 + T3:=" "; MOVE(1,T3,A[T2]); 07673000 + MOVECHARACTERS(COUNT,ACCUM[1],3,A[T],0); 07673500 + T:=T2; 07674000 + END 07674500 + ELSE MOVE(1,C,A[T]); 07675000 + END 07675500 + ELSE IF COUNT{19 AND ACCUM[1].[18:18]="OCT" THEN 07676000 + BEGIN % GET RID OF "OCT" FOR OCTIZE. 07676500 + MOVECHARACTERS(COUNT-3,ACCUM[1],6,ACCUM[1],3); 07677000 + IF OCTIZE(ACCUM[1],A[T],19-COUNT,COUNT-3) THEN 07677500 + FLAG(303); % NON-OCTAL CHARACTER. 07678000 + END 07678500 + ELSE BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07679000 + T:=T+1; 07679500 +CHECK: 07680000 + IF STEPI!COMMA THEN GO EXIT; 07680500 + END T LOOP; 07681000 + ERROR(305); % > 1023 ITEMS IN LIST. 07681500 +GOOFUP: 07682000 + FILLIT:=TRUE; 07682500 +EXIT: 07683000 + PARENCOUNTER:=PARENCOUNTER-REAL(ELCLASS=RTPAREN); 07683500 + END RECURSIVE FILLIT; 07684000 + IF STEPIINTARRAYID THEN 07684500 + BEGIN 07685000 + IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07685500 + MAKEALABEL ELSE ERROR(300); % NO ARRAY ID. 07686000 + GO EXIT; 07686500 + END; 07687000 + VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN FLAG(304); % NOT ARR. ROW. 07687500 + XMARK(ASSIGNREF); % FILL STATEMENT 07687600 + IF ELCLASS!WITHV THEN 07688000 + BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500 + STREAMTOG:=TRUE; 07689000 + IF TABLE(I+1){IDMAX THEN 07689500 + IF Q="7INQUI" THEN 07690000 + BEGIN 07690500 + STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000 + EMITPAIR(9,COM); EMITO(DEL); 07691500 + GO EXIT; 07692000 + END; 07692500 + EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000 + IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500 + MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000 + BUILDLINE:=BOOLEAN(2|REAL(BUILDLINE)) ; 07694500 + IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000 + ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500 + ELSE BEGIN 07696000 + FOR J:=0 STEP 32 UNTIL T DO 07696500 + MOVE(32,FILLTEMP[J],EDOC[J.[38:3],J.[41:7]]); 07697000 + SEGMENT(T,SGAVL,SGNO); 07697500 + END; 07698000 + MOVECODE(TEDOC,EDOC); STREAMTOG:=FALSE; 07698500 + BUILDLINE:=BUILDLINE.[46:1] ; SGAVL:=SGAVL+1; 07699000 +EXIT: 07699500 + END FILLSTMT; 07700000 + COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000 + CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000 + WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000 + AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000 + PROCEDURE STMT ; 07714000 + BEGIN 07715000 + LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000 + LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000 + LGO, LRELSE, LBEG, LBRK, EXIT; 07718000 + SWITCH S ~ 07719000 + LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000 + LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000 +LVAR, 07722000 + LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000 + LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000 + LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000 + EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000 + LRELSE,LBEG; 07727000 + COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010 + CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020 + GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030 + ADDRESSING IS NOT POSSIBLE; 07727040 + IF LASTENTRY !0 THEN 07727050 + BEGIN GT2 ~ INFO [0,255]; 07727055 + DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060 + IF L- GT1 > 400 THEN 07727065 + BEGIN GT1 ~ BUMPL; 07727070 + CONSTANTCLEAN; 07727075 + EMITB(BFW, GT1,L); 07727080 + END; 07727085 + END; 07727090 + STACKCT ~ 0; 07727100 + AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000 + IF ELCLASS = 0 THEN 07728500 + BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000 + IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100 + IF ELCLASS=FILEDID OR ECLASS=SUPERFILEID THEN 07729190 + BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200 + FLAG(145); 07729500 +LERR: ERR(144); GO TO EXIT; 07730000 +LDEC: FLAG(146); 07731000 + IF TABLE(I-2) = ENV AND MODE > 0 07732000 + THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000 + I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000 + ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000 + 07735500 + 07735510 + 07735520 +LPROC: PROCSTMT(TRUE); GO TO EXIT; 07736000 +LSPROC: STRMPROCSTMT; GO TO EXIT; 07737000 +LVAR: VARIABLE(FS); GO TO EXIT; 07738000 +LAB: LABELR; GO TO AGAIN; 07739000 +LREAD: READSTMT; GO TO EXIT; 07740000 +LWRITE: WRITESTMT; GO TO EXIT; 07741000 +LSPACE: SPACESTMT; GO TO EXIT; 07742000 +LCLOSE: CLOSESTMT; GO TO EXIT; 07743000 +LLOCK: LOCKSTMT; GO TO EXIT; 07744000 +LRWND: RWNDSTMT; GO TO EXIT; 07745000 +LDBL: DBLSTMT; GO TO EXIT; 07746000 +LFOR: FORSTMT; GO TO EXIT; 07747000 +LWHILE: WHILESTMT; GO TO EXIT; 07748000 +LDO: DOSTMT; GO TO EXIT; 07749000 +LFILL: FILLSTMT; GO TO EXIT; 07750000 +LIF: IFSTMT; GO TO EXIT; 07751000 +LGO: GOSTMT; GO TO EXIT; 07752000 +LRELSE: RELSESTMT; GO TO EXIT; 07753000 +LBEG: IF STEPI = DECLARATORS 07754000 + THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000 + ELSE COMPOUNDTIAL; 07756000 +EXIT: END STMT; 07757000 +PROCEDURE CMPLXSTMT; FORWARD ; 07777777 + PROCEDURE UNKNOWNSTMT; 07800000 + BEGIN LABEL XXX,E; 07801000 + REAL J,N,C; 07802000 + IF Q = "5BREAK" THEN 07803000 + BEGIN EMIT(0); 07804000 + EMIT(48); 07805000 + EMITO(COM); 07806000 + EMITO(DEL); 07807000 + STEPIT; 07808000 + GO TO XXX; 07809000 + END; 07810000 + IF Q="7COMPL" THEN BEGIN CMPLXSTMT; GO XXX END ; 07810100 + IF Q = "3ZIP00" THEN 07811000 + BEGIN IF TABLE(I+1) = WITHV THEN 07812000 + BEGIN STEPIT; 07813000 + IF STEPI < BOOARRAYID OR ELCLASS > 07814000 + INTARRAYID THEN 07814100 + IF ELCLASS=FILEID OR 07814200 + ELCLASS=SUPERFILEID THEN 07814300 + PASSFILE ELSE 07814400 + GO E ELSE 07814500 + BEGIN 07814600 + VARIABLE(FL); 07815000 + IF TABLE(I-2) ! FACTOP THEN GO TO E; 07816000 + END; 07816100 + EMIT(16); EMITO(COM); EMITO(DEL); 07817000 + GO TO XXX; 07818000 + END; 07819000 + N ~ 1; C ~ 8 07820000 + END ELSE 07821000 + IF Q = "5CHAIN" THEN 07821100 + BEGIN N ~ 1; C ~ 37 END ELSE 07821200 + IF Q = "4WHEN0" THEN 07822000 + BEGIN N ~ 0; C ~ 6 END ELSE 07823000 + IF Q = "4WAIT0" THEN 07824000 + BEGIN N ~ 1; C ~ 2 END ELSE 07825000 + IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500 + IF Q = "4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000 + IF Q = "5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000 + IF Q = "6SEARC" THEN 07828000 + BEGIN IF STEPI!LEFTPAREN THEN 07829000 + BEGIN ERR(105); GO TO XXX END; 07830000 + IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000 + PASSFILE ELSE GO TO E; 07832000 + IF ELCLASS!COMMA THEN GO TO E; 07833000 + IF STEPIINTARRAYID THEN 07834000 + GO TO E; 07835000 + XMARK(ASSIGNREF); % SEARCH STATEMENT 07835500 + VARIABLE(FL); 07836000 + IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000 + IF ELCLASS!RTPAREN THEN 07838000 + BEGIN ERR(104); GO TO XXX END; 07839000 + EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000 + STEPIT; GO TO XXX; 07841000 + END ELSE 07842000 + IF Q="4SEEK0" THEN 07843000 + BEGIN IF STEPI!LEFTPAREN THEN 07844000 + BEGIN ERR(105); GO TO XXX; END; 07845000 + IF STEPI!FILEID AND ELCLASS!SUPERFILED THEN 07846000 + GO TO E ELSE 07847000 + BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000 + IF ELCLASS!LEFTPAREN THEN 07849000 + BEGIN ERR(105); GO TO XXX; END; 07850000 + STEPIT; AEXP; EMITO(XCH); 07851000 + IF ELCLASS!RTPAREN THEN 07852000 + BEGIN ERR(104); GO TO XXX; END; 07853000 + IF STEPI!RTPAREN THEN 07854000 + BEGIN ERR(104); GO TO XXX; END; 07855000 + EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000 + EMITO(DEL); EMITO(DEL); STEPIT; 07857000 + END; GO TO XXX; 07858000 + END ELSE 07859000 + IF Q="6UNLOC" THEN 07859010 + BEGIN IF STEPI!LEFTPAREN THEN 07859020 + BEGIN ERR(105); GO TO XXX END; 07859030 + STEPIT; VARIABLE(FL); L ~ L-1; 07859040 + IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050 + EMITO(DUP); EMITO(LOD); EMITL(0); 07859060 + EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080 + GO TO XXX 07859090 + END ELSE 07859100 + $ SET OMIT = NOT TSPOL 07859900 + BEGIN ERROR(100); GO TO XXX END; 07900000 + IF STEPI ! LEFTPAREN THEN 07901000 + BEGIN ERR(105); GO TO XXX END; 07902000 + STEPIT; AEXP; 07903000 + FOR J ~ 1 STEP 1 UNTIL N DO 07904000 + BEGIN IF ELCLASS ! COMMA THEN 07905000 + E: BEGIN ERR(164); GO TO XXX END; 07906000 + STEPIT; AEXP; 07907000 + END; 07908000 + IF ELCLASS ! RTPAREN THEN 07909000 + BEGIN ERR(104); GO TO XXX END; 07910000 + EMITL(C); EMITO(COM); 07911000 + FOR J ~ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000 + STEPIT; 07913000 + XXX: END; 07914000 + PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"~" 07920000 + KIND OF STATEMENT. FOR THE RUN-TIME ERROR MESS; 07921000 + BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000 + CHECKER(ELBW~ELBAT[I]); STR~IF FAULTOG THEN SND ELSE STD; 07923000 + FAULTOG ~ BOOLEAN(1) OR FAULTOG; COMMENT TELLS DEXP TO MESS 07923100 + WITH FAULTLEVEL; 07923150 + IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000 + IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000 + IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100 + EMITPAIR(ADRES,STR); 07926000 + FAULTOG~FALSE&(ELBW.LVLINTARRAYID THEN 07939000 + BEGIN ERR(429); GO TO EXIT; END; 07940000 + VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN 07941000 + BEGIN ERR(427); GO TO EXIT; END; 07942000 + IF ELCLASS!RTPAREN THEN BEGIN ERR(428); GO TO EXIT; END; 07943000 + EMITO(XCH); 07944000 + IF T<0 THEN COMMENT FROM WRITE...(<0 IS FROM READ); 07945000 + BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITV(JUNK); END; 07946000 + IF T>0 THEN IF TABLE(I+1)=LFTBRKET THEN 07947000 + BEGIN GOGOGO ~ FALSE;% JUST TO MAKE SURE... 07948000 + HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000 + L ~ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000 + EMITO(DEL); EMITO(DEL);% REMOVE LABEL WORDS... 07951000 + END ELSE STEPIT ELSE STEPIT;% WALTZ ON BY... 07952000 + EMITV(GNAT(SUPERMOVER));% BET YOU THOUGHT I"D NEVER DO IT 07953000 + EXIT: END THIS HAIRY KLUDGE;% 07954000 + COMMENT FORSTMT IS RESPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 08000000 + IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 08001000 + THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 08002000 + ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 08003000 + CONSTANT, THEN THE CODE TAKES ON MORE EFFICIENT FORM. 08004000 + IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 08005000 + THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 08006000 + STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 08007000 + PROCEDURE FORSTMT; 08008000 + BEGIN 08009000 + OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET, 08010000 + BRET; 08011000 + OWN BOOLEAN SIGNA,SIGNB,SIGNC, INT, 08012000 + CONSTANA,CONSTANB,CONSTANC; 08013000 + DEFINE SIMPLEB = SIGNC#, FORMALV = SIGNA#, 08014000 + SIMPLEV = CONSTANA#, A = V#, Q = REGO#, 08015000 + OPDC = TRUE#, DESC = FALSE#, K = BRET#; 08016000 + LABEL EXIT; 08017000 + COMMENT FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 08017100 + IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 08017200 + INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 08017300 + RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 08017400 + BOOLEAN PROCEDURE FORCLASS(CLSS); VALUE CLSS; INTEGER CLSS; 08017500 + IF STEPI = CLSS THEN FORCLASS ~ TRUE ELSE 08017600 + IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON THEN 08017700 + BEGIN INFO[0,K~K+1] ~ C; 08017800 + ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11] 08017900 + END FORCLASS; 08017950 + COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 08018000 + CONSTANT DEPENDING ON THE REQUIREMENTS; 08019000 + PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 08020000 + IF C THEN EMITNUM (A) ELSE BEGIN 08021000 + CHECKER (A); 08021100 + EMITV(A.ADDRESS) END; 08021200 + COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A 08022000 + CONSTANT OR A SIMPLE VARIABLE. IT MAKES A THROUGH REPORT 08023000 + ON ITS ACTIVITY. IT ALSO MAKES PROVISION FOR THE RESCAN 08024000 + OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE 08025000 + TABLE ROUTINE FOR FURTHER DETAILS); 08026000 + BOOLEAN PROCEDURE SIMPLE(B,A,S); BOOLEAN B,S; REAL A; 08027000 + BEGIN 08028000 + S ~ IF STEPI ! ADOP THEN FALSE ELSE ELBAT[I].ADDRESS 08029000 + = SUB; 08030000 + IF ELCLASS = ADOP THEN STEPIT; 08031000 + IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON 08032000 + THEN BEGIN K ~ K+1; SIMPLE ~ TRUE; 08033000 + ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11]; 08034000 + INFO[0,K] ~ A ~ C; B ~ TRUE END 08035000 + ELSE BEGIN 08036000 + B ~ FALSE; A ~ ELBAT[I]; 08037000 + SIMPLE ~ REALID { ELCLASS AND ELCLASS { INTID END; 08038000 + END SIMPLE; 08038100120324PK + COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000 + PROCEDURE TEST; 08041000 + BEGIN 08042000 + IF NOT CONSTANB THEN 08043000 + BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000 + ELSE BEGIN 08045000 + EMITL(2+L-BRET); 08046000 + EMITB(BBW,BUMPL,B); 08047000 + END; 08048000 + EMITO(MUL); EMIT(0) END; 08049000 + EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000 + END TEST; 08051000 + BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000 + BEGIN 08053000 + CHECKER(VRET~ALL); 08054000 + ADDRES ~ ALL.ADDRESS; 08055000 + FORMALV ~ ALL.[9:2] = 2; 08056000 + IF T ~ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000 + GT1 ~ (T-BOOID) MOD 4 < 1 THEN 08058000 + ERR(REAL(T ! 0) | 51 + 100); 08059000 + INT ~ GT1 = 3; 08060000 + SIMPI ~ T { INTID END SIMPI; 08061000 + COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000 + PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000 + BEGIN 08064000 + IF FORMALV THEN BEGIN EMITO(XCH); S ~ FALSE END 08065000 + ELSE BEGIN 08066000 + EMITL(ADDRES); 08067000 + IF ADDRES > 1023 THEN EMITO(PRTE) END; 08068000 + T ~ (REAL(S)+1)|16; 08069000 + EMITO((IF INT THEN T+512 ELSE 4|T)+4) END STORE; 08070000 + COMMENT CALL EFFECTS A CALL ON THE INDEX; 08071000 + PROCEDURE CALL(S); VALUE S; BOOLEAN S; 08072000 + BEGIN 08073000 + IF SIMPLEV 08074000 + THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES) 08075000 + ELSE BEGIN 08076000 + EMITL(2+L-VRET); 08077000 + EMITB(BBW,BUMPL,V); 08078000 + IF S THEN EMITO(LOD) END END CALL; 08079000 + PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 08080000 + BEGIN 08081000 + PROCEDURE FIX(STORE,BACK,FORWART,START); 08082000 + VALUE STORE,BACK,FORWART,START; 08083000 + REAL STORE,BACK,FORWART,START; 08084000 + BEGIN 08085000 + EMITB(GET(FORWART-1),FORWART,START); 08086000 + IF RETURNSTORE ! 0 08087000 + THEN BEGIN 08088000 + L ~ STORE; EMITNUM(B-BACK); 08089000 + EMITPAIR(RETURNSTORE,STD) END END FIX; 08090000 + INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX; 08091000 + LABEL BRNCH,EXIT; 08092000 + STOREFIX ~ L; Q ~ REAL(MODE=0)+3; 08093000 + FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000 + IF NUMLE 08095000 + THEN BEGIN 08096000 + BACKFIX ~ L; 08097000 + IF FORMALV THEN CALL(DESC) END 08098000 + ELSE BACKFIX ~ V + REAL(SIMPLEV)-1; 08099000 + DIALA + DIALB ~ 0; 08100000 + AEXP; DIALA ~ DIALB ~ 0; 08101000 + COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 08102000 + IF ELCLASS = STEPV 08103000 + THEN BEGIN 08104000 + COMMENT HERE WE HAVE A STEP ELEMENT; 08105000 + BACKFIX ~ BUMPL; 08106000 + COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000 + IF FORMALV THEN CALL(DESC); CALL(OPOC); 08108000 + COMMENT FETCH INDEX; 08109000 + IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END 08110000 + ELSE REGO ~ I; 08111000 + IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND 08112000 + (STEPI = UNTILV OR ELCLASS = WHILEV) 08113000 + THEN BEGIN 08114000 + COMMENT WE HAVE A SIMPLE STEP FUNCTION; 08115000 + PLUG(CONSTANB ,B); 08116000 + END ELSE BEGIN 08117000 + COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 08118000 + SUBROUTINE; 08119000 + I ~ IF I < 4 THEN 0 ELSE REGO; STEPIT; 08120000 + SIGNB ~ CONSTANB ~ FALSE; 08121000 + EMIT(0); B ~ L; 08122000 + AEXP; EMITO(XCH); 08123000 + BRET ~ L; 08124000 + EMITO(BFW) END; 08125000 + EMITO(REAL(SIGNB)|32+ADD); 08126000 + EMITB(BFW,BACKFIX,L); 08127000 + IF ELCLASS = UNTILV 08128000 + THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000 + STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000 + STEPIT; AEXP; TEST END 08131000 + ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000 + IF ELCLASS ! WHILEV THEN 08133000 + BEGIN ERR(153); GO TO EXIT END; 08134000 + STEPIT; STORE(FALSE); BEXP END END 08135000 + ELSE BEGIN 08136000 + COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000 + STORE(FALSE); 08138000 + IF ELCLASS = WHILEV 08139000 + THEN BEGIN 08140000 + COMMENT WE HAVE A WHILE ELEMENT; 08141000 + STEPIT; BEXP END 08142000 + ELSE BEGIN 08143000 + COMMENT ONE EXPRESSION ELEMENT; 08144000 + IF ELCLASS ! COMMA THEN BEGIN 08145000 + EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END 08146000 + ELSE BACKFIX ~ L + 2; 08147000 + L ~ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000 + COMMENT THIS IS THE COMMON POINT; 08149000 + IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000 + EMIT(BFC); 08151000 + BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000 + IF ELCLASS = COMMA 08153000 + THEN BEGIN 08154000 + STEPIT; 08155000 + FORLIST(TRUE); 08156000 + FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000 + ELSE BEGIN 08158000 + IF ELCLASS ! DOV 08159000 + THEN BEGIN ERR(154); REGO~L; GO EXIT END; 08160000 + STEPIT; 08161000 + IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000 + IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000 + 08164000 + IF NUMLE THEN BEGIN 08165000 + EMITV(RETURNSTORE + FOOT); EMITO(BBW) END 08166000 + ELSE BEGIN 08167000 + EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000 + STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000 + CONSTANTCLEAN; REGO ~ L; 08170000 + FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000 + EXIT: END FORLIST; 08172000 + REAL T1,T2,T3,T4; 08173000 + NXTELBT ~ 1; I ~ 0; 08174000 + STEPIT; 08175000 + IF SIMPI(VRET~ELBAT[I]) 08176000 + THEN BEGIN 08177000 + IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000 + XMARK(ASSIGNREF); % FOR STATEMENT 08178100 + T1 ~ L; IF FORMALV THEN EMITN(ADDRES); 08179000 + K ~ 0; 08180000 + IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000 + IF FORCLASS(STEPV) THEN 08182000 + IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000 + IF FORCLASS(UNTILV) THEN 08184000 + IF SIMPLE(CONSTANC,C,SIGNC) THEN 08185000 + IF FORCLASS(DOV) THEN 08186000 + BEGIN 08187000 + PLUG(CONSTANA,A); 08188000 + IF SIGNA THEN EMITO(CHS); 08189000 + RETURNSTORE ~ BUMPL; ADJUST; CONSTANTCLEAN; 08190000 + STMTSTART ~ L; 08191000 + STEPIT; 08192000 + T1 ~ (((4096 | RETURNSTORE+STMTSTART)|2+ 08193000 + REAL(CONSTANB))|2+ 08194000 + REAL(CONSTANC))|2+ 08195000 + REAL(SIGNB))|2+ 08196000 + REAL(SIGNC); 08197000 + T2 ~ VRET; 08198000 + T3 ~ B; 08199000 + T4 ~ Q; 08200000 + IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000 + SIGNC ~ BOOLEAN(T1.[47:1]); 08202000 + SIGNB ~ BOOLEAN(T1.[46:1]); 08203000 + CONSTANC ~ BOOLEAN(T1.[45:1]); 08204000 + CONSTANB ~ BOOLEAN(T1.[44:1]); 08205000 + STMTSTART ~ T1.[32:12]; 08206000 + RETURNSTORE ~ T1.[20:12]; 08207000 + VRET ~ T2; 08208000 + B ~ T3; 08209000 + Q ~ T4; 08210000 + SIMPLEV~ SIMPI(VRET); 08211000 + IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000 + PLUG(CONSTANB,B); 08213000 + EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000 + EMITB(BFW,RETURNSTORE,L); 08215000 + STORE(TRUE); 08216000 + IF FORMALV THEN CALL(OPDC); 08217000 + PLUG(CONSTANC,Q); 08218000 + IF SIGNC THEN EMITO(CHS); 08219000 + SIMPLEB ~ TRUE; TEST; EMITLNG; 08220000 + EMITB(BBC,BUMPL,STMTSTART); 08221000 + GO TO EXIT END; 08222000 + I ~ 2; K ~ 0; 08223000 + SIMPLEV ~ SIMPI(VRET); 08224000 + V ~ T1 END 08225000 + ELSE BEGIN 08226000 + EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000 + VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000 + IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000 + END; 08230000 + STEPIT; FORLIST(FALSE); L ~ REGO; 08231000 + EXIT: K ~ 0 END FORSTMT; 08232000 +PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000 + BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000 + SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000 + LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000 + COLON HAS JUST BEEN DETECTED; 08237000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08238000 + EXECUTABLE STATEMENT IN THIS ROUTINE; 08239000 + IF STEPI = LFTBRKET 08240000 + THEN BEGIN COMMENT THIS CODE HANDLES PARITY AND END OF 08241000 + FILE LABELS; 08242000 + IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08243000 + IF ELCLASS ! COLON THEN EMIT(0) ELSE 08244000 + BEGIN STEPIT; DEXP END; 08245000 + 08246000 + 08247000 + 08248000 + 08249000 + 08250000 + 08251000 + 08252000 + 08253000 + 08254000 + 08255000 + 08256000 + 08257000 + 08258000 + 08259000 + 08260000 + 08261000 + 08262000 + 08263000 + 08264000 + 08265000 + 08266000 + 08267000 + 08268000 + 08269000 + 08270000 + 08271000 + 08272000 + 08273000 + 08274000 + 08275000 + 08276000 + IF CHECK(RTBRKET,433) 08277000 + THEN GO TO EXIT; 08278000 + COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 08279000 + IN READ OR SPACE STATEMENT; 08280000 + STEPIT; 08281000 + END 08282000 + ELSE BEGIN COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS08283000 + CASE; 08284000 + EMITL(0); EMITL(0); 08285000 + END; 08286000 + IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000 + EMITV(13) 08287100 + END ELSE EMITV(GNAT(INTERPTI)); 08287200 + GOGOGO ~ FALSE;% 08287300 + EXIT:; 08288000 + END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000 + DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010 + EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020 + EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030 +PROCEDURE READSTMT; 08290000 + BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS08291000 + SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000 + DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000 + THE READ OR SPACE STATEMENT. 08294000 + THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000 + STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000 + REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000 + EXPRESSION IN THE SPACE STATEMENT. 08298000 + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000 + READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000 + ARE PASSED TO INTERPTI. 08301000 + **********************************************************08302000 + ::=REVERSE/ 08303000 + ::=/ 08304000 + ::=[NO]/ 08305000 + ::=[:]/ 08306000 + []/[:]/08307000 + 08308000 + CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000 + POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000 + CONVERSION. 08311000 + FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000 + ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000 + 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000 + REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000 + VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000 + PROCESSED. 08317000 + END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL08318000 + DESCRIPTOR FOR THE END OF FILE JUMPS. 08319000 + PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000 + DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000 + + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT08322000 + DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE08323000 + GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS08324000 + IN ACTION TYPE. 08325000 + LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000 + DESCRIPTRO WHICH WILL EITHER RETURN08327000 + AN ADDRESS OR VALUE DEPENDING ON 08328000 + THE CALL. 08329000 + N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000 + READ() 08331000 + 08332000 + - - - - - - - - - - - - - - 08333000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000 + ,PARITY LABEL) 08335000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000 + READ(, 08337000 + ) 08338000 + - - - - - - - - - - - - - - 08339000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000 + ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000 + SPACE(,) 08343000 + - - - - - - - - - - - - - - 08344000 + (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000 + PARITY LABEL) 08346000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000 + READ(, 08348000 + ,) 08349000 + - - - - - - - - - - - - - - 08350000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000 + ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000 + LABEL,PARITY LABEL) 08353000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000 + READ(, 08355000 + *,) 08356000 + - - - - - - - - - - - - - - 08357000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000 + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000 + READ(, 08361000 + ,) 08363000 + - - - - - - - - - - - - - - 08364000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000 + END OF FILE LABEL,PARITY LABEL) 08366000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000 + READ(, 08368000 + ,) 08369000 + - - - - - - - - - - - - - - 08370000 + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000 + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000 + *********************************************************;08373000 + DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE08374000 + IF THE STATEMENT BEING COMPILED08375000 + IS A READ REVERSE, OTHERWISE IT08376000 + IS SET FALSE; 08377000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08378000 + EXECUTABLE STATEMENT IN READSTMT; 08379000 + LABEL CHKACTIONLABELS; COMMENT THE CODE AT THIS LABEL 08380000 + ASSUMES I IS POINTING AT THE RIGHT 08381000 + PARENTHESIS; 08382000 + LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I TO08383000 + BE POINTING AT THE LAST QUANTITY IN THE 08384000 + SECOND PARAMETER; 08385000 + LABEL READXFORM; 08385100 + INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500 + BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600 + BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700 + INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800 + IF STEPI = LEFTPAREN 08386000 + THEN REVERSETOG~SEEKTOG~FALSE; 08387000 + ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000 + REVERSETOG~ACCUM[1]="7REVER"; 08389000 + LOCKTOG~ELCLASS=LOCKV; 08390000 + SEEKTOG~ACCUM[1]="4SEEK0"; 08390500 + IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000 + ELSE BEGIN ERR(420); 08392000 + GO TO EXIT; 08393000 + END; 08394000 + IF CHECK(LEFTPAREN,421); 08395000 + THEN GO TO EXIT; 08396000 + COMMENT ERROR 421 MEANS MISSING LEFT 08397000 + PARENTHESIS IN READ REVERSE STATEMENT; 08398000 + END; 08399000 + EMITO(MKS); 08400000 + IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08401000 + BEGIN VARIABLE(FL); 08401020 + IF TABLE(I-2) ! FACTOP THEN 08401030 + BEGIN ERR(422); GO TO EXIT END; 08401040 + WAYI ~ TRUE; HOLD ~ L; 08401045 + EMIT(11); EMIT(4); EMITO(280); 08401050 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060 + EMITO(XCH); EMITL(0); EMITL(1); 08401070 + END ELSE 08401080 + BEGIN 08401090 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000 + IF NOT RANGE(FILEID,SUPERFILEID) 08403000 + THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000 + STATEMENT; 08405000 + ERR(422); GO TO EXIT; 08406000 + END; 08407000 + PASSFILE; 08408000 + IF ELCLASS = LFTBRKET 08409000 + THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000 + %%% [*],[*,*],[*,],[],[,*], 08410010 + %%% AND [,]. THE FIRST (LEFTMOST) 08410020 + %%% IS THE READSEEKDISTADDRESS, RESIDING 08410030 + %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000 + %%% IS THE WAIT-TIME, RESIDING IN THE 08411010 + %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 08411020 + %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 08411030 + %%% IN THE ABOVE, NS = NO OR STOP. 08411040 + STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000 + IF RR1~IF ACCUM[1]="2NO000" THEN 1 ELSE 08412010 + IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020 + 0 ! 0 THEN %%% HAVE [NS 08412030 + IF STEPI=COMMA THEN %%% HAVE [NS, 08412040 + IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050 + BEGIN 08412060 + IF RR1=1 THEN EMITNO(1) 08412070 + ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080 + STEPIT ; 08412090 + END 08413000 + ELSE 08413010 + IF ACCUM[1]="4LOCK0" THEN 08413012 + BEGIN %%% [NS,LOCK 08413014 + EMITL(1); EMITD(47,4,1); 08413016 + STEPIT; 08413018 + END ELSE 08413020 + BEGIN %%% HAVE [NS,AEXP 08413022 + IF RR1=2 THEN EMITL(1) ; 08413030 + EMITTIME ; 08413040 + IF RR1=2 THEN 08413050 + BEGIN EMITO(LOR); EMITL(2) END 08413060 + ELSE EMITL(1) ; 08413080 + END 08413090 + ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100 + ELSE BEGIN EMITL(1); EMITL(2) END 08413110 + ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120 + IF STEPI=COMMA THEN %%% HAVE [*, 08413130 + IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000 + BEGIN EMITNO(2); STEPIT END 08414010 + ELSE IF ACCUM[1]="4LOCK0" THEN 08414012 + BEGIN %%% [*,LOCK 08414014 + EMITL(1); EMITD(47,4,1); 08414016 + STEPIT; 08414018 + END ELSE 08414020 + BEGIN EMITTIME; EMITL(2); END % [*,A 08414022 + ELSE EMITNO(2) %%% HAVE ONLY [* 08414030 + ELSE BEGIN %%% HAVE [AEXP 08415000 + AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010 + IF SEEKTOG THEN EMITO(CHS) ; 08415020 + EMITPAIR(JUNK,ISN) ; 08415030 + IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000 + IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010 + ELSE IF ACCUM[1]="4LOCK0" THEN 08416012 + BEGIN %%% [AEXP,LOCK 08416014 + EMITL(1); EMITD(47,4,1); 08416016 + STEPIT; 08416018 + END ELSE 08416020 + BEGIN EMITTIME; EMITO(LOR) END ; 08416022 + EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030 + END ; 08417000 + IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010 + END 08418000 + ELSE IF ELCLASS=LEFTPAREN THEN 08418100 + BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200 + IF STEPI!FACTOP THEN% 08418250 + BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300 + BEGIN EMITL(1); GRABTOG~TRUE; STEPIT END ELSE 08418350 + EMITPAIR(0,LNG); 08418400 + EMITD(33,33,15); 08418500 + EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600 + EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650 + IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700 + EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800 + END 08418900 + ELSE BEGIN EMITL(0); EMITL(2); END; 08419000 + IF REVERSETOG 08420000 + THEN EMITO(CHS); 08421000 + END; 08421500 + IF ELCLASS = RTPAREN 08422000 + THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000 + EMITL(0); EMITL(0); EMITL(0); 08424000 + GOGOGO ~ NOT MAYI;% 08424100 + GO CHKACTIONLABELS; 08425000 + END; 08426000 + IF CHECK(COMMA,424) 08427000 + THEN GO TO EXIT; 08428000 + COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000 + STATEMENT; 08430000 + IF STEPI = FACTOP 08431000 + THEN BEGIN COMMENT *,LIST CASE; 08432000 + EMITL(0); EMITL(0); GO PASSLIST; 08433000 + END; 08434000 + IF ELCLASS = MULOP 08435000 + THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000 + IF STEPI=MULOP THEN EMITL(2) ELSE 08437000 + BEGIN EMITL(1); I~I-1; END ; 08437050 + EMITL(0); GO TO PASSLIST ; 08437075 + END; 08438000 + IF RANGE(FRMTID,SUPERFRMTID) 08439000 + THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000 + PASSFORMAT; 08441000 +READXFORM: IF TABLE(I+1) = COMMA 08442000 + THEN GO PASSLIST; 08443000 + STEPIT; 08444000 + IF CHECK(RTPAREN,425) 08445000 + THEN GO TO EXIT; 08446000 + COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000 + DELIMITER IN READ STATEMENT; 08448000 + EMITL(0); GO CHKACTIONLABELS; 08449000 + END; 08450000 + IF Q:=ACCUM[1]="1<0000" THEN 08450010 + BEGIN EXPLICITFORMAT; GO TO READXFORM; END; 08450020 + IF MAYI THEN 08450100 + BEGIN KLUDGE(HOLD); 08450200 + GO TO EXIT; 08450300 + END ARRAY TO ARRAY CASE; 08450400 + EMITL(0); AEXP; 08451000 + IF CHECK(COMMA,426) 08452000 + THEN GO TO EXIT; 08453000 + COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000 + PARAMETER; 08455000 + STEPIT; 08456000 + IF RANGE(BOOARRAYID,INTARRAYID) 08457000 + THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000 + VARIABLE(FL); 08459000 + IF TABLE(I-2) ! FACTOP 08460000 + THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000 + ROW DESIGNATOR IN READ; 08462000 + ERROR(427); GO TO EXIT; 08463000 + END; 08464000 + IF CHECK(RTPAREN,428) 08465000 + THEN GO TO EXIT; 08466000 + COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000 + DELIMITER IN READ STATEMENT; 08468000 + GOGOGO ~ TRUE;% 08468100 + GO CHKACTIONLABELS; 08469000 + END 08470000 + ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000 + ERROR(429); GO TO EXIT; 08472000 + END; 08473000 + PASSLIST:STEPIT; 08474000 + IF CHECK(COMMA,430) 08475000 + THEN GO TO EXIT; 08476000 + COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000 + THE LIST IN A READ STATEMENT; 08478000 + IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000 + THEN BEGIN 08480000 + RR1~LISTGEN; 08481000 + I~I-1; 08482000 + GO TO CHKACTIONLABELS 08483000 + END; 08484000 + CHECKER(ELBAT[I]); 08484500 + IF ELCLASS = SUPERLISTID THEN 08485000 + BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000 + LISTADDRESS ~ELBAT[I].ADDRESS; 08488000 + BANA; 08489000 + EMITV(LISTADDRESS); 08489500 + IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08489510 + EMITO(LOD); I~I-1 END 08489520 + ELSE BEGIN COMMENT A COMMON LIST; 08489530 + EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550 + END; 08489560 + STEPIT; 08489570 + IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580 + COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590 + 08490000 +CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000 + EXIT:; 08492000 + END READSTMT; 08493000 +REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND08493010 +VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015 + BEGIN % RETURNS THE ASSOCIATED INDEX IF 08493020 + REAL I ; % IT IS A FILE ATTRIBUTE. 08493030 + LABEL EXIT ; 08493040 + STOPDEFINE~T ; % MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 08493050 + STEPIT ; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 08493060 + IF I~FILEATTRIBUTES[0]=0 THEN 08493070 + BEGIN 08493080 +$RESET NEATUP 08493085120324PK + FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090 + % BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091 + % ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092 + % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093 + 17 08493094 + ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095 + ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096 + ,"4SAVE0" 08493097 + ,"8OTHER" % "OTHERUSE". 08493098 + ,"404MFID0" 08493099 + ,"403FID00" 08493100 + ,"4REEL0" 08493101 + ,"4DATE0" 08493102 + ,"5CYCLE" 08493103 + ,"4TYPE0" 08493104 + ,"5AREAS" 08493105 + ,"8AREAS" % "AREASIZE". 08493106 + ,"2EU000" 08493107 + ,"5SPEED" 08493108 + ,"9TIMEL" % "TIMELIMIT" 08493109 + ,"+08IOSTA" % "IOSTATUS" 08493110 + ,"9SENSI" % "SENSITIVE" 08493111 + % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120 + ; % END OF FILL STATEMENT. 08493130 +$SET NEATUP 08493135120324PK + I~FILEATTRIBUTES[0] ; 08493140 + END ; 08493150 + FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160 + BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170 + EXIT: 08493180 + END OF FILEATTRIBUTEINDX ; 08493190 +COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200 + A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210 + 1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220 + FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230 + AND XIT. 08493240 + 2. ACTUALPARAPART: 08493250 + PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260 + ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270 + THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280 + 3. PRIMARY: 08493290 + PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300 + IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310 + ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320 + THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330 + TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340 + IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350 + ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360 + ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370 + FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380 + (ATYPE OR BTYPE). 08493390 + 4. BOOPRIM: 08493400 + PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410 + 5. IODEC: 08493420 + PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430 + HAVE ALREADY BEEN EMITTED, THE ATTRIBUTEINDX IS 08493440 + DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450 +END OF COMMENT ; 08493460 +INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470 + BEGIN 08493480 + REAL ATTRIBUTEINDX ; 08493490 + BOOLEAN ASSOP ; 08493500 + LABEL DONESOME,DONEMORE,EXIT ; 08493510 + IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520 + BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530 + EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540 + GO TO DONEMORE ; 08493550 + END ; 08493560 + EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570 + IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580 + BEGIN 08493590 + DONESOME: 08493600 + IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610 + BEGIN 08493620 +STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625 + IF STEPI=LFTBRKET THEN 08493630 + BEGIN 08493640 + STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650 + END 08493660 + ELSE EMITL(0) ; 08493670 + EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675 + IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680 + BEGIN 08493700 +IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705 + DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710 + THEN FLAG(293) ; 08493720 + STEPIT ; 08493730 + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740 + THEN BEXP ELSE AEXP ; 08493750 + END 08493760 + ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770 + ELSE EMITL(0) ; 08493780 + EMITNUM(IF ATTRIBUTEINDX= 1 THEN "6ACCESS" ELSE 08493790 + IF ATTRIBUTEINDX= 4 THEN "6OTHRUS" ELSE 08493795 + IF ATTRIBUTEINDX=12 THEN "6ARASIZ" ELSE 08493800 + IF ATTRIBUTEINDX=15 THEN "6TIMLMT" ELSE 08493805 + IF ATTRIBUTEINDX=16 THEN "6IOSTAT" ELSE 08493810 + IF ATTRIBUTEINDX=17 THEN "6SNSTIV" ELSE 08493812 + 0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820 + & FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830 + EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840 + & REAL(ASSOP)[38:47:1]) ; 08493850 + EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860 + FILEATTRIBUTEHANDLER~ 08493870 + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880 + THEN BTYPE ELSE ATYPE ; 08493890 + END ; 08493900 + END ; 08493910 + EXIT: 08493920 + END OF FILEATTRIBUTEHANDLER ; 08493930 +PROCEDURE SPACESTMT; 08494000 + BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000 + SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000 + FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000 + PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000 + FOR THE READ STATEMENT; 08499000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000 + EXECUTABLE STATEMENT IN SPACESTMT; 08501000 + STEPIT; 08502000 + IF CHECK(LEFTPAREN,434) 08503000 + THEN GO TO EXIT; 08504000 + COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000 + SPACE STATEMENT; 08506000 + STEPIT; 08507000 + IF NOT RANGE(FILEID,SUPERFILEID) 08508000 + THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000 + IDENTIFIER IN SPACE STATEMENT; 08510000 + ERROR(435); GO TO EXIT; 08511000 + END; 08512000 + EMITO(MKS); 08513000 + EMITPAIR(GNAT( 08514000 + POWERSOFTEN),LOD); PASSFILE; 08515000 + EMITL(0); 08515100 + IF CHECK(COMMA,436) 08516000 + THEN GO TO EXIT; 08517000 + COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000 + STEPIT; AEXP; 08519000 + IF CHECK(RTPAREN,437) 08520000 + THEN GO TO EXIT; 08521000 + COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000 + SPACE STATEMENT; 08523000 + EMITL(0); EMITL(0); EMITL(1); 08524000 + HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000 + EXIT:; 08526000 + END SPACESTMT; 08527000 +PROCEDURE WRITESTMT; 08528000 + BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000 + INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000 + DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000 + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000 + WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000 + ARE PASSED TO INTERPTO. 08534000 + **********************************************************08535000 + FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000 + UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000 + READSTMT ROUTINE. 08538000 + ::= [DBL]/[PAGE]/[NO]// 08540000 + CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000 + TO CIMI FOR INPUT. 08542000 + [DBL] [PAGE] [NO] 08543000 + CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000 + LINESKIP 1 2 4 8 0 08545000 + WRITE()/ 08546000 + - - - - - - - - - - - - - - 08547000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000 + WRITE(,)/ 08550000 + - - - - - - - - - - - - - - 08551000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000 + INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000 + WRITE(,,)/08555000 + - - - - - - - - - - - - - - 08556000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000 + INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000 + WRITE(,*,)/ 08560000 + - - - - - - - - - - - - - - 08561000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000 + ROUTINE DESCRIPTOR) 08563000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000 + WRITE((CARRIAGE CONTROL>,,) 08566000 + - - - - - - - - - - - - - - 08567000 + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 08568000 + ROW DESCRIPTOR) 08569000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08570000 + LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08571000 + EXECUTABLE STATEMENT IN WRITESTMT; 08572000 + LABEL CHKSECOND; COMMENT I IS NOW POINTING AT THE COMMA 08573000 + SEPARATING THE FIRST AND SECOND 08574000 + PARAMETERS; 08575000 + LABEL ONEPARENSH; COMMENT I IS POINT AT THE RIGHT 08576000 + PARENTHESIS AT THIS POINT AND I HAVE 08577000 + JUST DISCOVERED THAT THIS IS THE ONE 08578000 + PARAMETER CASE; 08579000 + DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000 + TEMPORARY CELL FOR ACCUM[1]; 08581000 +%VOID 08582000 +%VOID 08583000 +%VOID 08584000 +%VOID 08585000 + LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000 + PRECEEDING THE LIST WHEN THIS LABEL IS 08587000 + REACHED; 08588000 + LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000 + DELIMITER. THE CODE AT EMITCALL EMITS THE08590000 + CODE TO CALL INTERPTO; 08591000 + LABEL CHKRTPAREN; 08591100 + LABEL WRITXFORM; 08591200 + INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 + BOOLEAN LOCKTOG,ARC; 08591600 + INTEGER HOLD;% 08591700 + IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000 + IF CHECK(LEFTPAREN,438) 08593000 + THEN GO TO EXIT; 08594000 + COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000 + WRITE STATEMENT; 08596000 + EMITO(MKS); 08597000 + IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08597100 + BEGIN VARIABLE(FL); 08597200 + IF TABLE(I-2) ! FACTOP THEN 08597300 + BEGIN ERR(439); GO TO EXIT END; 08597400 + ARC ~ TRUE; HOLD ~ L; 08597450 + EMIT(11); EMIT(4); EMITO(280); 08597500 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600 + EMITO(XCH); 08597700 + END ELSE 08597800 + BEGIN 08597900 + IF NOT RANGE(FILEID,SUPERFILEID) 08598000 + THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000 + IDENTIFIER IN A WRITE STATEMENT; 08600000 + ERR(439); GO TO EXIT; 08601000 + END; 08602000 + 08603000 + EMITPAIR(GNAT( 08604000 + POWERSOFTEN),LOD); PASSFILE; 08605000 + END; 08605500 + IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000 + THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000 + EMITL(0); EMITL(1); 08608000 + IF RRB1 08609000 + THEN GO CHKSECOND; 08610000 + ONEPARENSH:STEPIT; EMITL(0); EMITL(0); 08611000 + GOGOGO ~ NOT ARC;% 08611100 + EMITL(0); GO EMITCALL; 08612000 + END; 08613000 + IF ELCLASS=LEFTPAREN THEN 08613100 + BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200 + IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300 + EMITPAIR(0,LNG); 08613400 + EMITD(33,33,15); EMIT(0); 08613500 + IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN08613600 + END; 08613700 + IF CHECK(LFTBRKET,440) 08614000 + THEN GO TO EXIT; 08615000 + COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000 + PARAMETER IN A WRITE STATEMENT; 08617000 + STEPIT; 08618000 + %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 + %%% [DPN,],[*],[*,*],[*,],[],[,*] 08619010 + %%% AND [,], WHERE DPN IN STOP, DBL, PAGE, OR 08619020 + %%% NO. THE FIRST (LEFTMOST) IS THE CHANNELSKIP, 08619030 + %%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND IS 08619040 + %%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP,08619050 + %%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP, 08619060 + %%% *"S ARE CONSIDERED TO BE EMPTIES. 08619070 + IF ACCUM1~IF ACCUM1~ACCUM[1]="3DBL00" THEN 2 ELSE 08619080 + IF ACCUM1="4PAGE0" THEN 4 ELSE 08619090 + IF ACCUM1="4STOP0" THEN 16 ELSE 08619095 + IF ACCUM1="2NO000" THEN 8 ELSE 0!0 THEN %%% [DPN08620000 + IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010 + IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020 + BEGIN EMITNO(ACCUM1); STEPIT END 08621000 + ELSE IF ACCUM[1]="6UNLOC" THEN %%% [NS,UNLOCK 08621002 + BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08621004 + ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP08621010 + ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020 + ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000 + IF STEPI=COMMA THEN %%% HAVE [*, 08622010 + IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000 + BEGIN EMITNO(1); STEPIT END 08624000 + ELSE IF ACCUM[1]="6UNLOC" THEN %%% [*,UNLOCK 08624002 + BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08624004 + ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000 + ELSE EMITNO(1) %%% HAVE ONLY [* 08626000 + ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000 + %% HAVE [AEXP 08627100 + IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000 + IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,*08629000 + ELSE IF ACCUM[1]="6UNLOC" THEN %%% [AEXP,UNLOCK 08629002 + BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08629004 + ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A08630000 + EMITL(0) ; %%% 0 IS NO DPN. 08631000 + END ; 08632000 + IF CHECK(RTBRKET,441) 08633000 + THEN GO TO EXIT; 08634000 + COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE08635000 + CONTROL PART; 08636000 + CHKRTPAREN:IF STEPI = RTPAREN 08637000 + THEN GO TO ONEPARENSH; 08638000 + IF CHECK(COMMA,442) 08639000 + THEN GO TO EXIT; 08640000 + COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000 + DELIMITER IN A WRITE STATEMENT; 08642000 + CHKSECOND:STEPIT; 08643000 + IF RANGE(FRMTID,SUPERFRMTID) 08644000 + THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 + PASSFORMAT; 08646000 +WRITXFORM: IF STEPI = RTPAREN 08647000 + THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000 + CASE OF THE WRITE; 08649000 + STEPIT; EMITL(0); GO EMITCALL; 08650000 + END; 08651000 + GO PASSLIST; 08652000 + END; 08653000 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110 + IF ELCLASS!MULOP THEN ERR(443) 08653120 + ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140 + ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150 + GO TO PASSLIST ; 08653160 + END 08653170 + ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180 + BEGIN EMITL(1) ; 08653190 + IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195 + IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200 + BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210 + ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220 + GO TO PASSLIST ; 08653230 + END OF SCANNING FOR FREE FIELD FORMAT ; 08653240 + IF ELCLASS = FACTOP 08654000 + THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;08655000 + EMITL(0); EMITL(0); STEPIT; 08656000 + GO PASSLIST; 08657000 + END; 08658000 + IF ACCUM[1]="1<0000" THEN 08658010 + BEGIN EXPLICITFORMAT; GO TO WRITXFORM; END; 08658020 + IF ARC THEN 08658100 + BEGIN KLUDGE(-HOLD); 08658200 + GO TO EXIT; 08658300 + END ARRAY TO ARRAY CASE; 08658400 + EMITL(0); AEXP; 08659000 + IF CHECK(COMMA,443) 08660000 + THEN GO TO EXIT; 08661000 + COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000 + PARAMETER IN WRITE STATEMENT; 08663000 + STEPIT; 08664000 + IF RANGE(BOOARRAYID,INTARRAYID) 08665000 + THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 + VARIABLE(FL); 08667000 + IF TABLE(I-2) ! FACTOP 08668000 + THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000 + DESIGNATOR IN A WRITE STATEMENT; 08670000 + ERROR(444); GO TO EXIT; 08671000 + END; 08672000 + IF CHECK(RTPAREN,445) 08673000 + THEN GO TO EXIT; 08674000 + COMMENT ERROR 445 MEANS MISSING RIGHT 08675000 + PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000 + STATEMENT; 08677000 + GOGOGO ~ TRUE;% 08677100 + STEPIT; GO EMITCALL; 08678000 + END 08679000 + ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000 + ERROR(446); GO TO EXIT; 08681000 + END; 08682000 + PASSLIST:IF CHECK(COMMA,447) 08683000 + THEN GO TO EXIT; 08684000 + COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000 + LIST IN A WRITE STATEMENT; 08686000 + IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000 + THEN BEGIN RR1~LISTGEN; GO TO EMITCALL END; 08688000 + CHECKER(ELBAT[I]); 08688500 + IF ELCLASS = SUPERLISTID THEN 08689000 + BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000 + LISTADDRESS~ELBAT[I].ADDRESS; 08692000 + BANA; 08693000 + EMITV(LISTADDRESS); 08694000 + IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08694500 + EMITO(LOD); 08695000 + I~I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500 + END ELSE 08696000 + BEGIN COMMENT A COMMON LIST ID; 08696500 + EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520 + END; 08696530 + STEPIT; 08696540 + IF CHECK(RTPAREN,448) THEN GO TO EXIT; 08696550 + COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560 + STEPIT; 08697000 + EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000 + BEGIN EMITO(MKS); 08698100 + IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200 + IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300 + BEGIN STEPIT; DEXP END; 08698400 + IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500 + EMITL(15); EMITV(5); STEPIT; 08698600 + END;% 08698700 + IF GOGOGO THEN% 08698750 + BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800 + EMIT(0); EMIT(0); EMITV(12);% 08698850 + END ELSE EMITV(GNAT(INTERPTO));% 08698900 + GOGOGO ~ FALSE;% 08698950 + EXIT:; 08699000 + END WRITESTMT; 08700000 +PROCEDURE LOCKSTMT; 08701000 + BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000 + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000 + **********************************************************08705000 + ::=LOCK(,SAVE)/ 08706000 + - - - - - - - - - - - - - - 08707000 + (2,0,FILE,4) 08708000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000 + LOCK(,RELEASE) 08710000 + - - - - - - - - - - - - - - 08711000 + (6,0,FILE,4); 08712000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08713000 + EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000 + DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000 + FOR THE CURRENT L REGISTER; 08716000 + DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000 + L REGISTER SETTING FOR THE 08718000 + SAVE OR RELEASE LITERAL THAT 08719000 + GETS PASSED TO KEN MEYERS; 08720000 + STEPIT; 08721000 + IF CHECK(LEFTPAREN,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 RANGE(BOOARRAYID,INTARRAYID) THEN 08728100 + BEGIN ERR(451); GO TO EXIT END; 08728200 + VARIABLE(FL); L ~ L-1; 08728300 + IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400 + EMITO(DUP); EMITO(LOD); EMITL(24); 08728500 + EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600 + IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000 + GO TO EXIT 08730000 + END; 08731000 + PASFILE; 08732000 + IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08732100 + RELEASEV ELSE 08732200 + IF CHECK(COMMA,452) 08733000 + THEN GO TO EXIT; 08734000 + COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT08735000 + ; 08736000 + THISL~L; L~LTEMP; 08737000 + IF(RRB1~STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000 + ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000 + THEN EMITL(IF RRB1 08740000 + THEN 6 08741000 + ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000 + ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000 + DISPOSITION PART; 08744000 + ERROR(453); GO TO EXIT; 08745000 + END; 08746000 + L~THISL; 08747000 + STEPIT; 08748000 + IF CHECK(RTPAREN,454) 08749000 + THEN GO TO EXIT; 08750000 + COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000 + LOCK STATEMENT; 08752000 + STEPIT; 08753000 + EXIT:; 08754000 + END LOCKSTMT; 08755000 +PROCEDURE CLOSESTMT; 08756000 + BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000 + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000 + **********************************************************08760000 + ::=CLOSE(,SAVE)/ 08761000 + - - - - - - - - - - - - - - 08762000 + (3,0,FILE,4) 08763000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000 + CLOSE(,RELEASE)/ 08765000 + - - - - - - - - - - - - - - 08766000 + (7,0,FILE,4) 08767000 + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000 + CLOSE(,*) 08769000 + - - - - - - - - - - - - - - 08770000 + (1,0,FILE,4) 08771000 + ::= CLOSE(, PURGE) 08771100 + -- -- -- -- -- --- -- -- -- -- -- -- 08771200 + (4,0,FILE,4) 08771300 + ** ** ** ** ** ** *** ** ** ** ** ** ; 08771400 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08772000 + EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE; 08773000 + DEFINE THISL = RR1#; COMMENT 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 UNTI DISPOSITION PART CASE; 08806000 + EMITL(1); GO EMITREST; 08807000 + END; 08808000 + IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000 + THEN BEGIN COMMENT SAVE UNIT DISPOSITION PART CASE; 08810000 + EMITL(3); GO EMITREST; 08811000 + END; 08812000 + IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100 + EMITL(4); GO EMITREST; 08812200 + END; 08812300 + ERROR(458); GO TO EXIT; 08813000 + COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000 + IN A CLOSE STATEMENT; 08815000 + EMITREST:STEPIT; 08816000 + L~THISL; 08817000 + IF CHECK(RTPAREN,459) 08818000 + THEN GO TO EXIT; 08819000 + COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000 + CLOSE STATEMENT; 08821000 + STEPIT; 08822000 + EXIT:; 08823000 + END CLOSESTMT; 08824000 +PROCEDURE RWNDSTMT; 08825000 + BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000 + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000 + FOLLOWING PARAMETERS. 08828000 + **********************************************************08829000 + ::=REWIND() 08830000 + - - - - - - - - - - - - - - 08831000 + (0,0,FILE,4); 08832000 + LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08833000 + EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000 + DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08835000 + FOR THE CURRENT L REGISTER; 08836000 + DEFINE LTEMP = RR2#; COMMENT LTEMP SETTING FOR THE08837000 + L REGISTER SETTING FOR THE 08838000 + SAVE OR RELEASE LITERAL THAT 08839000 + GETS PASSED TO KEN MEYERS; 08840000 + STEPIT; 08841000 + IF CHECK(LEFTPAREN,460) 08842000 + THEN GO TO EXIT; 08843000 + COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000 + REWIND STATEMENT; 08845000 + STEPIT; 08846000 + IF NOT RANGE(FILEID,SUPERFILEID) 08847000 + THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A08848000 + REWIND STATEMENT; 08849000 + ERROR(461); GO TO EXIT; 08850000 + END; 08851000 + PASFILE; 08852000 + IF CHECK(RTPAREN,462) 08853000 + THEN GO TO EXIT; 08854000 + COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000 + REWIND STATEMENT; 08856000 + STEPIT; THISL~L; L~LTEMP; 08857000 + EMITL(0); L~THISL; 08858000 + EXIT:; 08859000 + END RWNDSTMT; 08860000 +PROCEDURE EXPLICITFORMAT; 08860050 + BEGIN INTEGER PRT; ARRAY TEDOC[0:7,0:127]; 08860100 + MOVECODE(TEDOC,EDOC); 08860150 + GT5:=SGNO; GT1:=(2|SGAVL-1)&2[4:46:2]; SGNO:=SGAVL; 08860200 + F := 0; PRT := GETSPACE(TRUE,-4); % FORMAT DESCR. 08860250 + PRT := PROGDESCBLDR(LDES,0,PRT); 08860300 + ELCLASS := "<"; TB1 := FORMATPHRASE; 08860350 + SEGMENT(-F,SGNO,GT5); SGAVL := SGAVL+1; 08860400 + SGNO := GT5; MOVECODE(TEDOC,EDOC); 08860450 + IF LASTELCLASS ! ">" THEN ERR(136); 08860500 + IF ELCLASS = "," THEN ELBAT[I].CLASS := COMMA ELSE 08860600 + IF ELCLASS = ")" THEN ELBAT[I].CLASS := RTPAREN ELSE 08860650 + ELBAT[I].CLASS := 0; I:=I-1; 08860700 + EMITL(0); EMITPAIR(PRT,LOD); 08860750 + END EXPLICITFORMAT; 08860800 + COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 08861000 + AND CALL SORTI, PASSING THE FOLLOWING: 08862000 + SORT: MERGE: 08863000 + 0 DISK SIZE,IF SPECIFIED 08864000 + 0 CORE SIZE,IF SPECIFIED 08865000 + 0 0 ALFA FLAG 08866000 + RECORD SIZE 08867000 + PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 08868000 + PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 08869000 + ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000 + 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000 + TP5 FL7 SCRATCH TAPES FOR SORT, 08872000 + TP4 FL6 OR MERGE FILES, POINTERS TO 08873000 + TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000 + TP2 FL4 IF NOT USED. 08875000 + TP1 FL3 08876000 + 0 FL2 DISK FILES FOR SORT 08877000 + DK0 FL1 08878000 + 0/1 0 TRUE IF INPUT PROCEDURE 08879000 + 0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000 + INF 0 POINTER TO I/O DESC FOR INPUT 08881000 + OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000 + OF WORK ARRAY. 08883000 + PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000 + PD/0 PD/0 OUTPUT PROCEDURE 08885000 + 0 0 08886000 + 0 0 08887000 + 0 0 08888000 + LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000 + 0 0 08890000 + 0 1 SORT/MERGE FLAG 08891000 + ... MSCW 08892000 + 0 SORT-FILE MOTHER 08893000 + 0 DESCRIPTORS 08894000 + 0 . 08895000 + 0 . 08896000 + 0 . 08897000 + 0 . 08898000 + MSCW; 08900000 + PROCEDURE MERGESTMT; 08901000 + BEGIN INTEGER J,K,FILER,FILEND; 08902000 + BOOLEAN OPTOG; 08903000 + LABEL QUIT; 08904000 + STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000 + EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000 + EMIT(0); EMIT(0); EMIT(0); 08907000 + IF OPTOG~(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000 + ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000 + EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I~I-1 END ELSE 08911000 + EMITN(GNAT(SORTA)); 08911100 + IF NOT COMMACHECK THEN GO QUIT; 08912000 + EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000 + FILE~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000 + IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000 + EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000 + AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000 + FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000 + BEGIN STEPIT; PASSFILE END; 08920000 + FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000 + IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000 + EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000 + IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000 + EMIT(0); EMIT(0); EMIT(0); 08925000 + QUIT: EMITV(GNAT(SORTI)); 08926000 + END MERGESTMT; 08927000 + PROCEDURE SORTSTMT; 08928000 + BEGIN BOOLEAN INPRO,OUTPRO; 08929000 + INTEGER A,J; 08930000 + LABEL QUIT; DEFINE RDS=1,280#; 08931000 + STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000 + VALUE FN, SFN ; 08933000 + BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000 + SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000 + DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000 + DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000 + DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000 + END STUFFILE; 08939000 + BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000 + IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000 + IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100 + IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000 + IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000 + INPROCHECK~TRUE; 08944000 + IF SFILENO=0 THEN 08945000 + BEGIN SFILENO~FILENO; 08946000 + FOR J~1 STEP 1 UNTIL 7 DO 08947000 + IF MKABS(IDARRAY[127]); OCT1340000250002662, COMMENT }; 09201000 + OCT1350000200000000, COMMENT +; OCT0000000000000000, 09202000 + OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 09203000 + OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT (; 09204000 + OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT ~; 09205000 + OCT1360001000000000, COMMENT |; OCT0000000000000000, 09206000 + OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT *; 09207000 + OCT1350000600000000, COMMENT -; OCT1240000000160000, COMMENT ); 09208000 + OCT0620000000000000, COMMENT .,; OCT1340010250003470, COMMENT {; 09209000 + OCT0000000000000000, OCT1360002000000000, COMMENT /; 09210000 + OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 09211000 + OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT =; 09212000 + OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 09213000 + 0,0; 09214000 + COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;09214100 +FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 09214105 + OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 09214110 + OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115 + OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 09214120 + OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 09214125 + OCT0030000170000000, "3NEQ00", 09214130 + OCT0030000200000000, "3LEQ00", 09214135 + OCT0030000210000000, "3LSS00", 09214140 + OCT0030000220000000, "5TIMES", 09214145 + OCT0030000230000000, "5INPUT", 09214150 + OCT0030000240000000, "2IO000", 09214155 + OCT0030000250000000, "6SERIA","L0000000", 09214160 + OCT0030000260000000, "6RANDO","M0000000", 09214165 + OCT0030000270000000, "6UPDAT","E0000000", 09214170 + OCT0030000300000000, "6OUTPU","T0000000", 09214180 + OCT0030000310000000, "7CANTU","SE000000", 09214190 + OCT0130000000740000, "3MIN00", OCT0000000003200000,%549 09214200 + OCT0130000001040000, "5DELAY", OCT0000000003300000,%552 09214210 + OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%555 09214220 + OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%559 09214230 + OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%563 09214240 + OCT0000000000040000, "5DCPWR", OCT0000000005600000,%567 09214250 + OCT0000000000040000, "5DCMTH", OCT0000000005500000,%570 09214255 + OCT0130000001140000, "5DSQRT", OCT0000000012300000,%573 09214260 + OCT0130000001240000, "4CEXP0", OCT0000000010000000,%576 09214270 + OCT0130000001340000, "3CLN00", OCT0000000010200000,%579 09214295 + OCT0130000001440000, "4CSIN0", OCT0000000010600000,%582 09214300 + OCT0130000001540000, "4CCOS0", OCT0000000011000000,%585 09214305 + OCT0130000001640000, "5CSQRT", OCT0000000012400000,%588 09214310 + OCT0130000001740000, "4DEXP0", OCT0000000007700000,%591 09214315 + OCT0130000002040000, "3DLN00", OCT0000000010100000,%594 09214320 + OCT0130000002140000, "4DSIN0", OCT0000000010500000,%597 09214325 + OCT0130000002240000, "4DCOS0", OCT0000000010700000,%600 09214330 + OCT0130000002360000, "7DARCT","AN0000000", OCT0000000011300000,%603 09214340 + OCT0130000002460000, "6DLOG1","000000000", OCT0000000010400000,%607 09214345 + OCT0130000002560000, "8DARCT","AN2000000", OCT0000000011500000,%611 09214350 + OCT0130000002640000, "4DMOD0", OCT0000000006500000,%615 09214355 + OCT0130000002740000, "4CABS0", OCT0000000005300000,%618 09214360 + OCT0130000003060000, "7ARCTA","N20000000", OCT0000000011400000,%621 09214365 + OCT0130000003160000, "6DROUN","D00000000", OCT0000000006100000,%625 09214370 + OCT0130000000040000, "5LOG10", OCT0000000010300000,%629 09214375 + OCT0130000000040000, "5COTAN", OCT0000000011200000,%632 09214380 + OCT0130000000060000, "6ARCSI","N00000000", OCT0000000011600000,%635 09214385 + OCT0130000000040000, "5ARCOS", OCT0000000011700000,%639 09214390 + OCT0130000000040000, "4SINH0", OCT0000000012000000,%642 09214395 + OCT0130000000040000, "4COSH0", OCT0000000012100000,%645 09214400 + OCT0130000000040000, "4TANH0", OCT0000000012200000,%648 09214405 + OCT0130000000040000, "3ERF00", OCT0000000012500000,%651 09214410 + OCT0130000000040000, "5GAMMA", OCT0000000012600000,%654 09214415 + OCT0130000000040000, "5LNGAM", OCT0000000012700000,%657 09214420 + OCT0130000000040000, "3TAN00", OCT0000000011100000,%660 09214425 + OCT0130000260000000, "4FAST0", %663 09214426 + OCT0130000270000000, "4SLOW0", %665 09214427 + OCT0130000240000000, "7PROTE", "CT000000", %667 09214428 + OCT2000000000004050, COMMENT POWERS OF TEN ; %670 09214430 + OCT0430000250000000, "5FIELD", %671 09214432 + 0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %673 09214435 + " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %674 09214440 +$SET NEATUP 09214450120324PK + COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500 +FOR NEXTINFO~512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510 +,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,635, 09214515 +639 STEP 3 UNTIL 660,663 STEP 2 UNTIL 667, 671 09214516 +DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], 09214520 + LASTINFO~STACKHEAD[GT2]~NEXTINFO); 09214530 + NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980 + BUILDLINE.[45:1]~TRUE ; 09214985 + PUTNBUMP(0); 09214990 + FILL MACRO[*] WITH 09215000 +$RESET NEATUP 09215100120324PK + OCT0131, COMMENT SFS A 00 ; 09216000 + OCT0116, COMMENT SFD A 01 ; 09217000 + OCT0000, COMMENT SYNTAX ERROR02 ; 09218000 + OCT0140, COMMENT INC A 03 ; 09219000 + OCT0130, COMMENT SRS A 04 ; 09220000 + OCT0117 COMMENT SRD A 05 ; 09221000 + OCT0000, COMMENT SYNTAX ERROR06 ; 09222000 + OCT0000, COMMENT SYNTAX ERROR07 ; 09223000 + OCT00310143, COMMENT CRF A, SFS 008 ; 09224000 + OCT00160143, COMMENT CRF A, SFD 009 ; 09225000 + OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000 + OCT00400143, COMMENT CRF A, INC 011 ; 09227000 + OCT00300143, COMMENT CRF A, SRS 012 ; 09228000 + OCT00170143, COMMENT CRF A, SRD 013 ; 09229000 + OCT0000, COMMENT SYNTAX ERROR14 ; 09230000 + OCT0000, COMMENT SYNTAX ERROR15 ; 09231000 + OCT0153, COMMENT RSA A 16 ; 09232000 + OCT0104, COMMENT RDA A 17 ; 09233000 + OCT0150, COMMENT RCA A 18 ; 09234000 + OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000 + OCT0122, COMMENT SES A 20 ; 09236000 + OCT0106, COMMENT SED A 21 ; 09237000 + OCT0000, COMMENT SYNTAX ERROR22 ; 09238000 + OCT0000, COMMENT SYNTAX ERROR23 ; 09239000 + OCT0056, COMMENT TSA 0 24 ; 09240000 + OCT0000, COMMENT SYNTAX ERROR25 ; 09241000 + OCT0000, COMMENT SYNTAX ERROR26 ; 09242000 + OCT0000, COMMENT SYNTAX ERROR27 ; 09243000 + OCT0000, COMMENT SYNTAX ERROR28 ; 09244000 + OCT0007, COMMENT TDA 0 29 ; 09245000 + OCT0000, COMMENT SYNTAX ERROR30 ; 09246000 + OCT0000, COMMENT SYNTAX ERROR31 ; 09247000 + OCT0115, COMMENT SSA A 32 ; 09248000 + OCT0114, COMMENT SDA A 33 ; 09249000 + OCT0154, COMMENT SCA A 34 ; 09250000 + OCT0141; COMMENT STC A 35 ; 09251000 + FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010 + "[# ", 09251020 + "]# ", 09251030 + "># ", 09251040 + "}# ", 09251050 + "=# ", 09251060 + "!# ", 09251070 + "{# ", 09251080 + "<# ", 09251090 + "|# ", 09251100 + "1# ", 09251101 + "3# ", 09251102 + "0# ", 09251103 + "1# ", 09251104 + "2# ", 09251105 + "2# ", 09251106 + "0# " 09251107 + ; 09251200 +$SET NEATUP 09251250120324PK +NEXTTEXT~26 ; 09251300 + DO UNTIL STEPI = BEGINV; 09252000 + BUILDLINE.[45:1]~FALSE; 09252050 + 09252100 + COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000 + THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000 + LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000 + AND IS ALSO USED AS A ONE SYLLABLE 09256000 + CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000 + ITS PRIMARY FUNCTION IS TO CUT BACK 09258000 + THE STACK AFTER A COMMUNICATE OPERATOR. 09259000 + MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000 + IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000 + C-RELATIVE ADDRESSING FOR CONSTANTS 09262000 + IN THE PROGRAM STREAM 09263000 + OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000 + THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000 + LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000 + CELL.AT THE START OF COMPILATION XXXX IS 09267000 + ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000 + IT IS CHANGED BEFORE COMPILATION IS 09269000 + COMPLETE TO LOOK LIKE A WORD MODE 09270000 + PROGRAM DESCRIPTOR; 09271000 + EMITL(0);EMIT0(MKS); 09272000 + GT1~PROGDESCBLDR(3,0,0); 09273000 + GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000 + INSERTCOP:=1; 09274100 + ERRORTOG~TRUE; BLOCK(FALSE); 09275000 + COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100 + THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200 + THE END. CARD OFF AN INPUT TAPE; 09275250 + IF NEWTOG THEN 09275300 + BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350 + "D ON OCR","DING TAPE","E ", " "," ", 09275400 + " ","999999999"; 09275450 + WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500 + END; 09275550 + 09275600 + 09275650 + 09275700 + 09275750 + 09275800 + 09275850 + 09275900 + 09275950 + 09276000 + COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000 + WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000 + USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000 + THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000 + IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000 + PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000 + INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000 + ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000 + FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 09285000 + INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000 + THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000 + PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000 + DRUM ADDRESSES TO THE INTRINSICS; 09289000 + 09290000 + GT1 ~ GT3 ~ STARTINTRSC; 09291000 + L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000 + IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000 + BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000 + BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000 + GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000 + | 2 + 1, 0, GT2.ADDRESS); 09296100 + PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000 + 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000 + & SGNO[28:38:10] & 1[2:47:1]; 09298100 + PDINX ~ PDINX + 1; 09299000 + IF PRTOG THEN % WRITE OUT INTRINSICS USED. 09300000 + BEGIN GT3 ~ GT3 + 1; 09300100 + BLANKET(14,LIN); % BLANK BUFFER. 09300150 + WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200 + B2D(GT2.[38:10]), LIN); 09301000 + IF NOHEADING THEN DATIME; WRITELINE; 09302000 + END 09303000 + END; 09304000 + GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000 + GO TO L1; 09305100 + END; 09306000 + L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100 + EMITL(5);EMITO(COM); 09307000 + ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100 + SEGMENT((L+3) DIV 4,1,0); 09308000 +COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000 + AT THIS TIME AS A TYPE 2 SEGMENT; 09310000 + IF GT1~GT2.ADDRESS!0 THEN 09311000 + BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000 + GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000 + MOVE(69,TEN,EDOC[0,0]); 09314000 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100 + SEGMENT(-69, SGNO,0); 09315000 + BUILDLINE ~ BUILDLINE.[46:1] ; 09315100 + END; 09316000 +BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000 + INTEGER PRTADR,SEGMNT,LINK; 09318000 +COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000 + 09334000 + 09335000 + 09336000 + 09337000 + 09338000 + 09339000 + 09340000 + 09341000 + 09342000 + 09343000 + 09344000 + 09345000 + 09346000 + 09347000 + FOR I~0 STEP 1 UNTIL PDINX-1 DO 09348000 + IF (GT1~PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000 + BEGIN PRTADR~GT1.[8:10]; SEGMNT~GT1.[28:10]; 09350000 + LINK~SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000 + MDESC(GT1.[18:10]&SEGMNT[18:33:15] 09352000 + &(IF LINK=0 THEN SEGMNT+2048 ELSE LINK) 09353000 + [6:36:12]>1[4:4:2]&5[1:45:3], 09354000 + PRT[PRTADR DIV 128,PRTADR MOD 128]); 09354100 + SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]~PRTADR; 09355000 + END ELSE 09356000 + BEGIN SEGMNT~GT1.[28:10]; 09357000 + SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]~ 09358000 + SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]>1[23:38:10] 09359000 + & GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 09360000 + END; 09361000 + COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX~AKKUM; 09361005 + COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 09361010 + GTI1~0; 09361020 + COMMENT ADD IN ARRAYS; 09361030 + GTI1~GTI1+( IF NOOFARRAYS =0 THEN 0 ELSE IF NOOFARRAYS {4 09361040 + THEN 2000 ELSE IF NOOFARRAYS { 8 THEN 3500 09361050 + ELSE 5000); 09361060 + COMMENT ADD IN SEGMENT SIZE REQUIREMENTS; 09361070 + GTI1~GTI1+ (IF NEWINX { 1000 THEN NEWINX ELSE IF NEWINX {2000 09361080 + THEN 1000 ELSE NEWINX/2); 09361100 + COMMENT ADD IN STACK AND PRT; 09361110 + GTI1~GTI1+ 512 + PRTIMAX; 09361120 + COMMENT ADD IN JRT; 09361130 + GTI1~GTI1 + ( (FILENO +1)| 5); 09361140 + COMMENT ADD IN I/O BUFFER REQUIREMENTS; 09361150 + GTI1~GTI1+IOBUFFSIZE; COMMENT I/O SIZE CAL. IN P.IODEC; 09361160 + COMMENT ADD SEGMENT DICT.SIZE; 09361170 + GTI1~GTI1+ SGAVL-1; 09361180 +COMMENT ADD IN CORE ESTIMATE FOR SORT; 09361181 + GTI1:=GTI1+CORESZ; 09361182 + COMMENT CHECK IF TOTAL IS MORE THAN 8 MODS; 09361190 + IF GTI1 } 32000 THEN GTI1~ 32000; 09361200 + COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 09361210 +COMMENT WRITE OUT FILE PARAMETER BLOCK; 09393000 + GTI1~MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000 + MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000 + ZEROUT(IDARRAY[0],0,30); 09395500 + IDARRAY[4]:=MOVEANDBLOCK(EDOC,GT1,0); 09396000 + IDARRAY[5]~GT1; 09397000 +COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000 + IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); 09399000 + IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100 + (LDICT,SGAVL,2)[18:33:15]; 09399150 + IDARRAY[1]~SGAVL; 09400000 +COMMENT WRITE OUT PRT; 09401000 + IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); 09402000 + IDARRAY[3]~PRTIMAX; 09403000 +COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000 + IDARRAY[6]~1; 09405000 +COMMENT PASS NUMBER OF FILES; 09405100 + IDARRAY[7] ~ (FILENO-1)>I1[18:27:15]; 09405200 +COMMENT WRITE DISK SEGMENT ZERO; 09406000 + GT1:=DA; DA:=0; MOVE(30,IDARRAY[0],PRT[0,0]); 09407000 + GT2:=MOVEANDBLOCK(PRT,30,6); DA:=GT1; 09407010 + IF CODEFILE THEN WRITE(LINE); 09407020 + IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050 + LOCK(CODE,SAVE); 09407100 + CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. 09407200 + CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. 09407300 + LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. 09407400 + IF LISTER OR NOT NOHEADING THEN 09408000 + BEGIN 09409000120324PK +$RESET NEATUP 09409100120324PK + FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT" 09409200120324PK + ,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000 + "PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000 + " WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000 + I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 09413000 + /"ESTIMATED AUXILIARY MEMORY REQUIRED =",I6," WORDS.", 09414000 + /"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 09414100 +FOMRAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 09414101 +$SET NEATUP 09414200120324PK + MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4);09415000 + MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4);09416000 +IF CHECKTOG THEN 09416001 + WRITE(LINE[DBL] ,SERR,IF NUMSEQUENCEERRORS = 0 09416002 + THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004 + THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006 + WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2,09417000 + PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000 + DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000 +END END END PROGRAM; 09420000 + COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000 + COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000 + FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000 + WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000 + ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000 + RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000 + STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000 + EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000 + THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000 + TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000 + S = [1:1], 10010000 + REPEAT = [38:10], 10011000 + SKIP = [32:6], 10012000 + CODE = [2:4], 10013000 + W = [6:6], 10014000 + W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000 + S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000 + TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000 + BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000 + WORDS. GIVEN S = 1 WE HAVE: 10019000 + IF CODE = 0 THEN RIGHTPAREN, 10020000 + IF CODE = 2 THEN STRING, 10021000 + IF CODE = 4 THEN LEFTPAREN, 10022000 + IF CODE = 6 THEN STROKE, 10023000 + IF CODE = 8 THEN SCALE. 10023100 + GIVEN S = 0 WE HAVE 10024000 + IF CODE = 0 THEN D, 10025000 + IF CODE=1 THEN T, 10025010 + IF CODE = 2 THEN X, 10026000 + IF CODE = 4 THEN A, 10027000 + IF CODE = 6 THEN I, 10028000 + IF CODE = 8 THEN F, 10029000 + IF CODE =10 THEN E, 10030000 + IF CODE = 11 THEN U, 10030100 + IF CODE =12 THEN O, 10031000 + IF CODE = 13 THEN V, 10031100 + IF CODE =14 THEN L, 10032000 + IF CODE = 15 THEN R, 10032100 + W IS THE FIELD WIDTH. 10033000 + FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000 + ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000 + REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000 + REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000 + HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000 + IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000 + A NON-ZERO REPEAT FIELDS. 10040000 + THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000 + FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000 + D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000 + THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000 + FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000 + W2 = D1 = D2 =0. 10046000 + FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010 + W2=D1=D2=0. 10046020 + FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000 + W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000 + FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000 + IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000 + IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000 + FOR F IF D < 8 THEN D1 = D, D2=0, 10052000 + IF D > 8 THEN D1 = 8, D2=D-8, 10053000 + IF D >16 THEN ERROR. 10054000 + IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000 + SKIP=0. 10056000 + IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000 + IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000 + FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000 + D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000 + FOR O, W1=W2=D1=D2=SKIP=0, 10061000 + FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000 + SKIP = W-W1, 10063000 + FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100 + FOR B: SEE U-PHRASE DESCRIPTION. 10063110 + FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200 + FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300 + F-PHRASE DESCRIPTION. 10063400 + FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000 + WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000 + BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000 + IF IT NOTICES AN ERROR; 10067000 + PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000 + BEGIN 10069000 + 10070000 + MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000 + IF DEBUGTOG 10072000 + THEN BEGIN 10073000 + DEBUGWORD(B2D(F),W,LIN); 10074000 + WRITELINE END; 10075000 + IF (F~F+1) > 1024 THEN FLAG(307); 10076000 + 10077000 + 10078000 + 10079000 + 10080000 + 10081000 + END WHIPOUT; 10082000 + BOOLEAN PROCEDURE FORMATPHRASE; 10083000 + BEGIN 10084000 + LABEL EL,EX,EXIT,L1,L2,L3; 10085000 + PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000 + VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000 + REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000 + BOOLEAN S; 10089000 + BEGIN IF W > 63 THEN FLAG(163); 10090000 + W ~ REPEAT & W [ 6:42:6] 10091000 + & SKIP [32:42:6] 10092000 + & W1 [28:44:4] 10093000 + & W2 [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!"<"); 10113000 + IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100 + NEXTENT; 10113200 + END END; 10113300 + IF ELCLASS="(" OR ELCLASS="<" 10114000 + THEN BEGIN 10115000 + SKIP ~ F; 10116000 + EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000 + DO BEGIN NEXTENT; 10118000 + EL: IF FORMATPHRASE THEN GO TO EX END 10119000 + UNTIL ELCLASS ! ","; 10120000 + WHILE ELCLASS = "/" 10121000 + DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000 + NEXTENT END; 10123000 + IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000 + THEN GO TO EL; 10124100 + IF LASTELCLASS = "," THEN GO TO EX; 10124200 + IF REPEAT = 0 THEN 10125000 + EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000 + REPEAT~F-SKIP; F~SKIP; 10127000 + WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100 + F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200 + ELSE IF ELCLASS = "0" 10128000 + THEN BEGIN CODE~RO; W~8 END 10129000 + ELSE IF ELCLASS = "D" 10130000 + THEN BEGIN CODE~RD; W~8 END 10131000 + ELSE IF ELCLASS = "," THEN GO TO L2 10132000 + ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000 + ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 10134000 + IF LASTELCLASS="," THEN GO EX ELSE GO EXIT 10134100 + ELSE IF ELCLASS = "S" THEN 10134500 + BEGIN 10134510 + NEXTENT; 10134520 + W ~ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530 + IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540 + IF ELCLASS="*" THEN REPEAT.[12:1]~1 ELSE 10134545 + IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550 + GO TO EXIT 10134560 + END 10134570 + ELSE REPEAT ~ - ELCLASS; 10134580 + EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590 + GO TO L2 10134600 + END 10134610 + ELSE IF ELCLASS = """ 10135000 + THEN BEGIN 10136000 + IF REPEAT ! 1 THEN FLAG(136); 10136500 + CODE ~ 100; 10137000 + DO BEGIN 10138000 + SKIP ~ 1; 10139000 + DO BEGIN RESULT ~ 5; COUNT ~ 0; SCANNER; 10140000 + IF ELCLASS ~ ACCUM[1].[18:6] = CODE 10141000 + THEN BEGIN 10142000 + IF SKIP ! 1 THEN WHIPOUT(W); 10143000 + GO TO L2 END; 10144000 + CODE ~ """; 10145000 + PACKALPHA(W,ELCLASS,SKIP); 10146000 + END UNTIL SKIP ~ SKIP+1 = 7; 10147000 + WHIPOUT(W) 10148000 + END UNTIL FALSE END 10149000 + ELSE BEGIN CODE~ELCLASS; 10150000 + IF CODE = "U" OR CODE = "B" THEN 10150100 + BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 10150110 + NEXTENT ; 10150120 + SKIP ~ 0 ; 10150125 + IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150130 + BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135 + IF ELCLASS = "*" THEN REPEAT.[13:1] ~ 1 10150140 + ELSE W ~ -ELCLASS ; 10150145 + NEXTENT ; 10150150 + IF ELCLASS = "." THEN 10150155 + BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 10150160 + NEXTENT ; 10150165 + IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150170 + BEGIN %%% PHRASE IS UW*.D*. 10150175 + IF ELCLASS = "*" THEN REPEAT.[14:1]~1 10150185 + ELSE SKIP ~ -ELCLASS ; 10150190 + NEXTENT ; 10150195 + END 10150200 + ELSE GO TO EX 10150205 + END 10150210 + END 10150215 + ELSE W ~-63 ; %%% PHRASE IS D. 10150220 + EMITFORMAT(FALSE,RD,REPEAT,SKIP,W,REAL(CODE="B"), 10150225 + REAL(W<0),0,0) ; 10150230 + GO TO EXIT ; 10150260 + END OF U PHRASE HANDLER ; 10150270 + IF GETINT THEN BEGIN W~11; REPEAT.[13:1]~1 END 10150280 + ELSE ELCLASS := -(W := ELCLASS); 10150290 + IF CODE = "I" 10151000 + THEN BEGIN 10152000 + SKIP ~ DIVIDE(W,W1,W2); CODE ~ RI END 10153000 + ELSE IF CODE = "F" 10154000 + THEN BEGIN CODE ~ RF; GO TO L1 END 10155000 + ELSE IF CODE = "R" THEN BEGIN CODE ~ RR; GO TO L1 END 10155500 + ELSE IF CODE = "E" 10156000 + THEN BEGIN CODE ~ RE; D1~1; 10157000 + L1: NEXTENT; 10158000 + IF ELCLASS!"." THEN GO EX; 10159000 + IF GETINT THEN BEGIN ELCLASS~3; REPEAT.[14:1]~1 END; 10159100 + IF DIVIDE(ELCLASS+D1,D1,D2) > 0 THEN GO TO EX; 10160000 + IF CODE = RF OR CODE = RR THEN 10161000 + SKIP ~ DIVIDE(W-ELCLASS-1,W1,W2) 10161500 + ELSE IF SKIP ~ W-ELCLASS-6 < 0 THEN GO TO EX END 10162000 + ELSE IF CODE = "X" 10163000 + THEN BEGIN CODE ~ RX; W1 ~ W.[38:4]; 10164000 + SKIP ~ W ~ W.[42:6] END 10165000 + ELSE IF CODE="T" THEN IF W~ABS(W)-1<0 THEN FLAG(136) 10165500 + ELSE BEGIN CODE~RT; W1~W.[38:4]; W~W.[42:6] END 10165505 + ELSE IF CODE = "A" 10166000 + THEN BEGIN CODE ~ RA; W1 ~6; GO TO L3 END 10167000 + ELSE IF CODE="V" THEN 10167100 + BEGIN CODE ~ RV ; 10167200 + COUNT~ACCUM[1]~0; 10167300 + IF EXAMIN(NCR)=" " THEN 10167400 + BEGIN RESULT~7; SCANNER END; 10167500 + IF EXAMIN(NCR)="." THEN 10167600 + BEGIN NEXTENT; 10167700 + IF GETINT THEN REPEAT.[14:1]~1 ELSE 10167800 + GT1~DIVIDE(ELCLASS,D1,D2); 10167900 + ELCLASS :=-ELCLASS; 10167910 + END; END ELSE IF CODE="L" 10168000 + THEN BEGIN CODE ~ RL; W1 ~ 5; 10169000 + L3: IF W 2047 10242000 + THEN BEGIN FLAG(142); TB1~ TRUE END 10243000 + ELSE BEGIN 10244000 + IF COUNT > REMCOUNT 10245000 + THEN BEGIN 10246000 + SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT); 10247000 + REMCOUNT ~ 2048 END 10248000 + ELSE REMCOUNT ~ REMCOUNT-COUNT; 10249000 + GT1 ~ CHARCOUNT DIV 8 ~ NEXTTEXT; 10250000 + PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3],10251000 + COUNT,0,CHAR); 10252000 + IF SKIPCOUNT ! 0 THEN 10253000 + PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000 + COUNT,CHAR); 10255000 + CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END 10256000 + END PUTOGETHER; 10257000 + INTEGER LASTRESULT; 10258000 + REAL K,N,ELCLASS; 10258100 + DEFINE I=NXTELBT#; 10258200 + LABEL FINAL,PACKIN; 10258300 + LABEL BACK,SKSC,EXIT; 10259000 + REAL DINFO; 10259200 + BOOLEAN TSSTREAMTOG; % 1289 10259400 + DINFO ~ J.[18:15]; 10259600 + J ~ J.[33:15]; 10259700 + TB1~ FALSE; 10260000 + TSSTREAMTOG~ STREAMTOG; % 1289 10260050 +STREAMTOG~TRUE; 10260100 + CHARCOUNT ~ 0; 10261000 + DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000 + REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000 + K~0; 10263200 + BACK: STOPDEFINE~TRUE; 10263300 + ELCLASS~TABLE(NXTELBT); 10263400 + SKSC: NXTELBT~NXTELBT-1; 10263500 + IF MACRO THEN 10263600 + BEGIN IF ELCLASS=COMMA THEN 10263700 + IF K=0 THEN 10263800 + FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900 + ELSE GO PACKIN; 10264000 + IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100 + BEGIN K~K+1; GO TO PACKIN END; 10264200 + IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300 + IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400 + IF ELCLASS=SEMICOLON THEN 10264410 + BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420 + END; 10264500 + IF RESULT = 1 THEN IF J ! 0 THEN 10264600 + FOR N ~ 1 STEP 1 UNTIL J DO 10264650 + BEGIN 10264700 + IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1]. 10264750 + DEFINFO[(N-1)|10]) THEN 10264760 + BEGIN 10264800 + DEFINEPARAM(DINFO+1, N); 10264810 + GO PACKIN; 10264820 + END; 10264830 + END; 10264900 + PACKIN: 10264910 + IF RESULT = 4 10265000 + THEN BEGIN 10266000 + COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 10267000 + PUTOGETHER(2130706432); 10268000 + PUTOGETHER(ACCUM[1]); 10269000 + PUTOGETHER(2130706432) END 10270000 + ELSE BEGIN 10271000 + IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) 10272000 + THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000 + PUTOGETHER(ACCUM[1]) END; 10274000 + IF TB1 THEN GO TO EXIT; 10275000 + LASTRESULT ~ RESULT; 10276000 + IF MACRO THEN GO BACK; 10276500 + IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV10277000 + THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END; 10278000 + IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000 + IF DEFINECTR ! 1 10280000 + THEN BEGIN STOPDEFINE ~ TRUE; 10281000 + IF ELCLASS~TABLE(I)!COMMA THEN 10282000 + DEFINECTR~DEFINECTR-1; GO SKSC END; 10283000 +EXIT: DEFINECTR := 0; STREAMTOG~TSSTREAMTOG; % 1289 10284000 + NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 + END DEFINEGEN; 10286000 + COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000 + ELEMENTS; 10288000 + PROCEDURE LISTELEMENT; 10289000 + BEGIN 10290000 + REAL T1,T2,T3; 10291000 + LABEL BOOFINISH,STORE,LRTS; 10292000 + DIALA ~ DIALB ~ 0; 10293000 + IF ELCLASS= FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000 + ELSE IF ELCLASS = LFTBRKET 10295000 + THEN BEGIN COMMENT GORUP OF LIST ELEMENTS; 10296000 + DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000 + IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 + ELSE BEGIN COMMENT THE MEAT OF THE MATTER: 10299000 + VARIABLES AND EXPRESSIONS; 10300000 + L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000 + EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000 + NEXT TIME AROUND; 10303000 + IF(GT1 ~ TABLE(I+1) = COMMA 10304000 + OR GT1 = RTPAREN 10305000 + OR GT1 = RTBRKET) 10306000 + AND ELCLASS } BOOID AND ELCLASS { INTID 10307000 + THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 + CHECKER(ELBAT[I]); 10308100 + EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 + ELSE BEGIN IF ELCLASS } BOOARRAYID 10310000 + AND ELCLASS { INTARRAYID 10311000 + THEN BEGIN COMMENT IS EITHER A 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 EXPRSS = DTYPE THEN ERR(156); 10327000 + STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000 + LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000 + T2 ~ L; L ~ T1; EMITNUM(T2-LSTR); L~T2 END END LSTELMT; 10330000 + COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000 + LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000 + LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000 + CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000 + LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000 + FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000 + THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000 + FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000 + DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR, 10339000 + LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000 + LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000 + VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000 + ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000 + REAL PROCEDURE LISTGEN; 10344000 + BEGIN 10345000 + INTEGER JUMPLACE,LISTPLACE; 10346000 + JUMPLACE ~ BAE; 10347000 + LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000 + COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 + EMITV(LSTRTN); EMITO(BFW); LSTR ~ L; 10350000 + COMMENT INITIAL JUMP OF A LIST; 10351000 + LISTMODE ~ TRUE; 10352000 + COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000 + I~I-1; 10354000 + DO BEGIN 10355000 + STEPIT; 10356000 + LISTELEMENT 10357000 + END UNTIL ELCLASS ! COMMA; 10358000 + EMITL(1); EMITO(CHS); 10359000 + EMITPAIR(LSTRTN,SND); 10360000 + EMITO(RTS); 10361000 + COMMENT SET END FLAG OF -1; 10362000 + CONSTANTCLEAN; 10363000 + DIALA ~ DIALB ~ 0; 10364000 + LISTMODE ~ FALSE; 10365000 + ADJUST; 10365100 + EMITB(BFW,JUMPLACE,L); 10366000 + STUFFF(LISTPLACE); 10367000 + IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT 10368000 + END LISTGEN; 10369000 + BOOLEAN PROCEDURE MERRIMAC; 10370000 + BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000 + 03 JULY 1963 10372000 + THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000 + LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,10374000 + ARRAYS, AND FUNCTION DESIGNATORS. 10375000 + WITH ONE EXCEPTION, THE MERRIMAX ROUTINES ONLY FUNCTION 10376000 + IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE10377000 + VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000 + THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000 + THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000 + A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN10381000 + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000 + ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000 + THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000 + INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000 + FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000 + EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000 + AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000 + POSSIBLE CALLS ON PRINTI. 10389000 + ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000 + THE IDENTIFIER TO BE PRINTED. 10391000 + N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000 + ARRAY OR SUBSCRIPTED VARIABLE. 10393000 + V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000 + S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000 + PRINTED. 10396000 + S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000 + MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000 + ONLY IF THEY ARE EQUAL. 10399000 + FORMAT TYPE MONITOR DUMP 10400000 + ----------- ------- ---- 10401000 + 0 LABELS 10402000 + SWITCHES 10403000 + --------- ----- -- 10404000 + 1 SIMPLE VARIABLES LABELS 10405000 + FUNCTION SIMPLE VARIABLES 10406000 + --------- ----- -- 10407000 + 2 ARRAYS SUBSCRIPTED VARS 10408000 + --------- ----- -- 10409000 + 3 SUBSCRIPTED VARS 10410000 + --------- ----- -- 10411000 + 4 ARRAYS 10412000 + ********* ***** ** 10413000 + FORMAT TYPE PRINTOUT 10414000 + ----------- -------- 10415000 + 0 ID 10416000 + --------- ----- 10417000 + 1 ID=V 10418000 + --------- ----- 10419000 + 2 ID[S1---SN]=V 10420000 + --------- ----- 10421000 + 3 ID[S1---SN]=V 10422000 + --------- ----- 10423000 + 4 ID=V1---VN 10424000 + *********** ******** 10425000 + THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY10426000 + THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000 + PASSING THE TYPEV TO PRINTI. 10428000 + TYPE TYPEV 10429000 + ---- ----- 10430000 + BOOLEAN 0 10431000 + -- --- 10432000 + REAL 1 10433000 + -- --- 10434000 + ALPHA 2 10435000 + -- --- 10436000 + INTEGER 3 10437000 + **** ***** 10438000 + POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000 + AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000 + FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000 + ----------- --------------------------- 10442000 + 0 10443000 + --------- ------------------------- 10444000 + 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000 + --------- ------------------------- 10446000 + 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000 + FILE,2) 10448000 + --------- ------------------------- 10449000 + 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000 + ,ID,CHARI,FILE,3) 10451000 + --------- ------------------------- 10452000 + 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000 + POWERSOFTEN,ID,CHARI,FILE,4) 10454000 + *********** *************************** 10455000 + SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000 + MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000 + THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000 + THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000 + ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000 + ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000 + MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000 + MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000 + WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000 + MONITORING INFORMATION. 10465000 + *********FORMAT OF INFO FOR MONITORED ITEMS**********10466000 + ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000 + WORD WILL BE SET. 10468000 + SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000 + ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000 + THE MONITOR FILE IN [37:11], I WILL HAVE A 10471000 + DEFINE SVARMONFILE = [37:11]#. 10472000 + ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000 + NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000 + MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000 + FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000 + DEFINE ARRAYMONFILE = [27:11]#. 10477000 + SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000 + SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000 + TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000 + OF INFO CONTAINING LOWER BOUND INFORMATION10481000 + ALSO CONTAINS MONITOR INFORMATION. EITHER10482000 + A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000 + IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000 + DESIGNATES WHETHER AN OPDC OR A LITC 10485000 + SHOULD BE GENERATED USING [12:11]. IF THE10486000 + BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000 + ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000 + MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000 + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000 + PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000 + SI* TO THE PRINTI ROUTINE. 10492000 + LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000 + THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000 + ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000 + DEFINE LABLMONFILE = [13:11]#. 10496000 + SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000 + I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000 + FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000 + WITH THE SAME NUMBER OF WORDS AS THE 10500000 + ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000 + REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000 + ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000 + FUNCMONFILE = [27:11]#; 10504000 + DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000 + ADDRESS OF THE MONITOR FILE; 10506000 + DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000 + SAVE THE ADDRESS OR VALUE OF A 10508000 + SUBSCRIPT. ONE ADDITIONAL BIT IS10509000 + USED TO TELL WHETHER TO EMIT AN 10510000 + OPDC OR A LITC ON THIS ADDRESS OR10511000 + VALUE; 10512000 + DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000 + DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000 + VARIABLE APPEARING IN A MONITOR LIST;10515000 + DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000 + ADDITIONAL INFO AND IS USED WHEN MAKING10517000 + A NEW ENTRY IN INFO FOR ARRAYS; 10518000 + DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000 + ELBAT WORD FOR A MONITOR LIST 10520000 + ELEMENT; 10521000 + DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000 + SUBSCRIPTED VARIABLES TO TELL ME 10523000 + WHETHER TO EMIT AN OPDC OR A LITC.10524000 + 0 IS USED FOR OPDC, 1 FOR LITC; 10525000 + DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000 + POINTING AT THE END OF ADDITIONAL 10527000 + INFO AND IS USED TO TELL WHEN TO 10528000 + STOP MOVING INFO FOR THE NEW ENTRY10529000 + FOR MONITORED ARRAYS; 10530000 + DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000 + LINK POINTING AT THE FIRST 10532000 + ADDITIONAL WORD OF INFO FOR 10533000 + MONITORED ARRAYS; 10534000 + DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000 + CONCATENATE DEFINE FOR 10536000 + STUFFING THE MONITOR FILE 10537000 + ADDRESS INTO THE FIRST 10538000 + ADDITIONAL INFO WORD FOR 10539000 + ARRAYS AND FUNCTIONS; 10540000 + DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000 + PARTIAL WORD DESIGNATOR [4010542000 + :8] USED TO EXTRACT THE 10543000 + NUMBER OF PARAMETERS FOR A 10544000 + GIVEN PROCEDURE FROM INFO; 10545000 + DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000 + OF PARAMETERS FOR A FUNCTION 10547000 + DESIGNATOR APPEARING IN A MONITOR 10548000 + LIST; 10549000 + LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000 + POINTING AT THE FILE IDENTIFIER IN THE 10551000 + MONITOR DECLARATION; 10552000 + LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000 + TURNS ON THE MONITOR BIT OF THE ELBAT10554000 + WORD IN THE MONITOR LIST AND STORES 10555000 + IT IN ACCUM[0] FOR THE E ROUTINE; 10556000 + LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000 + REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000 + EACH SUBSCRIPT EXPRESSION; 10559000 + LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000 + POINTING THE LAST LOGICAL QUANTITY OF THE 10561000 + MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000 + PROCESSED; 10563000 + LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000 + START:IF ELCLASS!FILEID THEN 10565000 + BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100 + "6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200 + ERR(400); GO EXIT; 10565300 + END 10566000 + COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000 + CHECKER(ELBAT[I]); 10568000 + FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000 + IF CHECK(LEFTPAREN,401) 10570000 + THEN GO TO EXIT; 10571000 + COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000 +MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000 + IF RANGE(BOOID,INTID) 10574000 + THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000 + E; PUTNBUMP(FILEIDENT); 10576000 + GO CHKCOMMA; 10577000 + END; 10578000 + IF RANGE(BOOARRAYID,INTARRAYID) 10579000 + THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000 + SUBSCRIPTED VARIABLES; 10581000 + E; NXTINFOTEMP~NEXTINFO; 10582000 + PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000 + TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000 + ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000 + DO PUTNBUMP(TAKE(INC~INC+1)) 10586000 + UNTIL INC } TESTVARB; 10587000 + IF TABLE(I+1) ! LFTBRKET 10588000 + THEN GO CHKCOMMA; 10589000 + TESTVARB~NODIM+NXTINFOTEMP; 10590000 + STEPIT; 10591000 + STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000 + STEPI ! NONLITNO 10593000 + THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000 + SUBSCRIPTED VARIABLES. EITHER A LITC 10595000 + OR AN OPDC ON A VARIABLE IS ALL THAT 10596000 + IS NEEDED TO CALL THE SUBSCRIPT; 10597000 + SUBSCRIPT~ELBAT[I].ADDRESS; 10598000 + OPLIT~0; 10598500 + IF NOT RANGE( INTRNSICPROCID,INTID) 10599000 + THEN IF CHECK(LITNO,402) 10600000 + THEN GO TO EXIT 10601000 + ELSE COMMENT MARK FOR LITC; 10602000 + OPLIT~1; 10603000 + COMMENT ERROR 402 IS BAD 10604000 + SUBSCRIPT IN MONITOR DECLARATION;10605000 + STEPIT; 10606000 + END 10607000 + ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000 + SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000 + SUBSCRIPT EXPRESSION MUST BE GENERATED10610000 + AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000 + PROGRAM DESCRIPTOR CREATED AND THE 10612000 + ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT10613000 + MUST BE MARKED FOR AN OPDC; 10614000 + JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000 + ADES,L,0); AEXP; EMITO(RTS); 10616000 + JUMPCHKX; 10616500 + OPLIT~0; 10617000 + IF MODE > 0 10618000 + THEN BEGIN COMMENT STUFF F AT THIS 10619000 + POINT IF MODE > 0; 10620000 + STUFFF(SUBSCRIPT);EMITPAIR( 10621000 + SUBSCRIPT,STD); 10622000 + END; 10623000 + END; 10624000 + PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000 + SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000 + NXTINFOTEMP); 10627000 + IF ELCLASS = COMMA 10628000 + THEN GO TO STORESUBS; 10629000 + IF CHECK(RTBRKET,403) 10630000 + THEN GO TO EXIT; 10631000 + COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000 + EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000 + IF NXTINFOTEMP ! TESTVARB 10634000 + THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000 + ELEMENT HAS IMPROPER NUMBER OF 10636000 + SUBSCRIPTS; 10637000 + I~I-1; ERROR(404); GO TO EXIT; 10638000 + END; 10639000 + GO CHKCOMMA; 10640000 + END; 10641000 + IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000 + THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000 + IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000 + THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000 + SWITCH MONITORED AT IMPROPER LEVEL; 10646000 + ERROR(405); GO TO EXIT; 10647000 + END; 10648000 + PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000 + ); 10650000 + PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000 + ELBATWORD); GO CHKCOMMA; 10652000 + END; 10653000 + IF RANGE(BOOPROCID,INTPROCID) 10654000 + THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000 + E ;% 10656000 +IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010 + BEGIN 10656011 + %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012 + %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013 + PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014 + PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015 + END ; 10656016 + PUTNBUMP(NOPAR ~ TAKEFRST & 10656030 + FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR10657000 + ~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000 + LINK+ELBATWORD.INCR); 10659000 + DO PUTNBUMP(TAKE(INC~INC+1)) 10660000 + UNTIL INC } TESTVARB; 10661000 + GO CHKCOMMA; 10662000 + END; 10663000 + ERROR(406); GO TO EXIT; 10664000 + COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000 + CHKCOMMA:IF STEPI = COMMA 10666000 + THEN GO MARKMONITORED; 10667000 + IF CHECK(RTPAREN,407) 10668000 + THEN GO TO EXIT; 10669000 + COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000 + DECLARATION; 10671000 + IF STEPI = SEMICOLON 10672000 + THEN GO TO EXIT; 10673000 + IF CHECK(COMMA,408) 10674000 + THEN GO TO EXIT; 10675000 + COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000 + DELIMITER; 10677000 + STEPIT; GO TO START; 10678000 + EXIT:; 10679000 + END MERRIMAC; 10680000 +PROCEDURE DMUP; 10681000 + BEGIN COMMENT 15 JULY 1963 10682000 + THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000 + ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000 + ARRAYS. 10685000 + THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000 + THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000 + OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000 + THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000 + A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000 + HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000 + BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000 + COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000 + WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000 + THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000 + FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000 + THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000 + INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000 + ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000 + OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000 + . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000 + DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000 + IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000 + FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000 + SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000 + LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000 + POINTING AT THE FILE IDENTIFIER IN THE DUMP 10707000 + DECLARATION; 10708000 + LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000 + ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000 + IS REACHED; 10711000 + DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000 + ADDRESS OF THE MONITOR FILE; 10713000 + LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000 + CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000 + STARTCALL IS REACHED, I MUST BE POINTING 10716000 + AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000 + DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000 + DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000 + DIMENSIONS OF AN ARRAY OR A 10720000 + SUBSCRIPTED VARIABLE APPEARING IN A 10721000 + DUMP LIST; 10722000 + DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000 + COUNTER SETTING AT WHICH CODE IS 10724000 + GENERATED TO EXIT THE ROUTINE EMITTED10725000 + BY DMUP; 10726000 + DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000 + LOCATION OF THE COUNTER 10728000 + ASSOCIATED WITH THIS LABEL IF 10729000 + SPACE HAS BEEN ASSIGNED FOR IT; 10730000 + DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000 + NODIM. IT IS THEN COUNTED DOWN TO 10732000 + ZERO AS SUBSCRIPT CODE IS GENERATED;10733000 + LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000 + NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000 + LABEL SUBSLOOP; COMMENT THE CODE AT SUBLOOP PASSES 10736000 + SUBSCRIPTS TO PRINTI; 10737000 + ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000 + HOLDS THE ADDRESSES OF ALL LABEL 10739000 + COUNTERS FOR LABELS APPEARING IN 10740000 + THIS DUMP DECLARATION. IT IS 10741000 + NECESSARY TO RETAIN THIS 10742000 + INFORMATION SO THAT CODE MAY BE 10743000 + GENERATED AT THE END OF THE 10744000 + DECLARATION TO INITIALIZE THE 10745000 + COUNTERS; 10746000 + DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000 + VARIABLE USED TO INDEX INTO THE10748000 + LABELCTR ARRAY; 10749000 + DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000 + CONCATENATE DEFINE FOR INSERTING10751000 + THE COUNTER ASSOCIATED WITH THIS10752000 + LABEL INTO THE FIRST ADDITIONAL 10753000 + WORD OF INFO; 10754000 + DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000 + BOUND FOR MONITORED SUBSCRIPTED 10756000 + VARIABLES; 10757000 + DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000 + FORMAT TYPE REFERRED TO IN THE 10759000 + COMMENTS FOR THE MERRIMAC 10760000 + ROUTINE DESCRIBING PRINTI; 10761000 + DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000 + USED TO HOLD L WHILE THE DUMP 10763000 + INDICATOR TEST CODE IS BEING 10764000 + GENERATED; 10765000 + DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000 + LOCATION OF THE CODE THAT MUST BE 10767000 + GENERATED TO MAKE THE TEST TO 10768000 + DETERMINE WHETHER OR NOT DUMPING 10769000 + SHOULD OCCUR; 10770000 + DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000 + CONCATENATE DEFINE USED TO 10772000 + INSERT THE ADDRESS OF THE 10773000 + PROGRAM DESCRIPTOR FOR THE CODE 10774000 + GENERATED FROM THE DUMP 10775000 + DECLARATION; 10776000 + DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000 + ADDRESS OF THE PROGRAM DESCRIPTOR 10778000 + THAT DESCRIBES THE CODE GENERATED 10779000 + BY DMUP; 10780000 + DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000 + ELBAT WORD FOR THE DUMP LIST 10782000 + ELEMENT CURRENTLY BEING OPERATED 10783000 + ON; 10784000 + LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000 + ON PRINTI. IT GENERATES THE CODE TO 10786000 + PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000 + FILE, AND FORMAT TYPE; 10788000 + DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000 + DIMENSION NUMBER THAT IS CURRENTLY 10790000 + BEING WORKED ON; 10791000 + START:IF CHECK(FILEID,409) 10792000 + THEN GO TO EXIT; 10793000 + COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000 + CHECKER(ELBAT[I]); 10795000 + FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000 + IF CHECK(LEFTPAREN,410) 10797000 + THEN GO TO EXIT; 10798000 + COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000 + JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000 + (ADES,L,0); TESTLOC~L; L~L+3; 10801000 + LABELCTRINX~-1; EMITO(NOP); BUMPL; 10802000 + STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000 + [I]); 10804000 + IF RANGE(BOOARRAYID,INTARRAYID) 10805000 + THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000 + SUBSCRIPTED VARIABLES; 10807000 + NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000 + IF STEPI = LFTBRKET 10809000 + THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000 + VARIABLES; 10811000 + STEPIT; AEXP; EMITO(DUP); 10812000 + SUBSCTR~1; 10813000 + IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000 + ).[35:13] ! 0 10815000 + THEN BEGIN COMMENT SUBTRACT OFF THE 10816000 + LOWER BOUND BEFORE INDEXING;10817000 + IF LWRBND.[46:2] = 0 10818000 + THEN EMIT(LWRBND) 10819000 + ELSE EMITV(LWRBND.[35:11]); 10820000 + EMIT(LWRBND.[23:12]); 10821000 + END; 10822000 + IF DIMCTR-SUBSCTR = 0 10823000 + THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000 + VALUE,N; 10825000 + EMITV(ELBATWORD.ADDRESS); 10826000 + PASSN:EMITL(NODIM); 10827000 + IF CHECK(RTBRKET,411) 10828000 + THEN GO TO EXIT; 10829000 + COMMENT ERROR 411 MEANS 10830000 + DUMP LIST ELEMENT HAS WRONG 10831000 + NUMBER OF SUBSCRIPTS; 10832000 + FORMATTYPE~2; GO CALLPRINTI10833000 + END; 10834000 + EMITN(ELBATWORD.ADDRESS); 10835000 + SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000 + EMITL(JUNK); EMITO(SND); 10837000 + SUBSCTR~SUBSCTR+1; 10838000 + IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000 + ).[35:13] ! 0 10840000 + THEN BEGIN COMMENT SUBTRACT OFF THE 10841000 + LOWER BOUND BEFORE INDEXING;10842000 + IF LWRBND.[46:2] = 0 10843000 + THEN EMIT(LWRBND) 10844000 + ELSE EMITV(LWRBND.[35:11]); 10845000 + EMIT(LWRBND.[23:12]); 10846000 + END; 10847000 + IF DIMCTR-SUBSCTR = 0 10848000 + THEN BEGIN COMMENT EMIT COC; 10849000 + EMITO(COC); EMITV(JUNK10850000 + ); EMITO(XCH); 10851000 + GO PASSN; 10852000 + END; 10853000 + EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000 + IF CHECK(COMMA,412) 10855000 + THEN GO TO EXIT 10856000 + ELSE GO TO SUBSLOOP; 10857000 + COMMENT ERROR 412 MEANS DUMP LIST 10858000 + ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000 + ; 10860000 + END; 10861000 + COMMENT THIS CODE HANDLES ARRAYS; 10862000 + IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000 + THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000 + ARRAY DUMP LIST ELEMENT; 10865000 + ERR(413); GO TO EXIT; 10866000 + END; 10867000 + EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000 + FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000 + END; 10870000 + FORMATTYPE~1; 10871000 + IF RANGE(BOOID,INTID) 10872000 + THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000 + EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000 + END; 10875000 + IF CHECK(LABELID,414) 10876000 + THEN GO TO EXIT; 10877000 + COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000 + CODE HANDLES LABELS; 10879000 + PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]- 10880000 + IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000 + THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000 + ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000 + EMITV(LABELCTR[ 10884000 + LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000 + ,ELBATWORD); 10886000 + EMITL(3); IF FALSE THEN 10887000 + CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000 + POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000 + EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000 + FILEIDENT); 10891000 + EMITNUM(FORMATTYPE&CARDNUMBER[1:4:44]); 10891100 + EMITV(GNAT(PRINTI)); 10891200 + IF STEPI = COMMA 10892000 + THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000 + IF LABELCTRINX = 100 10894000 + THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000 + ABOUT TO OVERFLOW WITH LABEL 10896000 + INFORMATION; 10897000 + ERR(415); GO TO EXIT; 10898000 + END; 10899000 + GO STARTCALL; 10900000 + END; 10901000 + IF CHECK(RTPAREN,416) 10902000 + THEN GO TO EXIT; 10903000 + COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000 + DELIMETER; 10905000 + LEXIT~L; EMITL(0); EMITO(RTS); 10906000 + JUMPCHKX; STEPIT; 10907000 + IF CHECK(LABELID,417) 10908000 + THEN GO TO EXIT; 10909000 + COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000 + PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000 + ELBATWORD); 10912000 + IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100 + PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000 + IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000 + THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000 + ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000 + EMITL(0); 10917000 + DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000 + EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000 + END 10920000 + UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000 + L~L-1; EMITO(STD); STEPIT; 10922000 + IF CHECK(COLON,418) 10923000 + THEN GO TO EXIT; 10924000 + COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000 + FINALL~L; L~TESTLOC; STEPIT; 10926000 + IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500 + AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510 + ! COMMA AND GT1 ! SEMICOLON) 10926520 + THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530 + UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540 + FLAG(465); GO TO EXIT; 10926550 + END; 10926560 + PRIMARY; EMITV(DUMPETEMP); 10927000 + EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000 + L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000 + DUMPR],GIT(ELBAT[I-3])); 10930000 + IF ELCLASS = COMMA 10931000 + THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000 + STEPIT; GO TO START; 10933000 + END; 10934000 + IF CHECK(SEMICOLON,419) 10935000 + THEN; 10936000 + COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000 + EXIT:; 10938000 + END DMUP; 10939000 + COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000 + AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000 + OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000 + SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000 + OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000 + IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000 + A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000 + SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 10947000 + SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000 + SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000 + THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000 + JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000 + TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 + SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 +BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); 10954000 + VALUE BEFORE; BOOLEAN BEFORE; REAL PD; 10954100 + BEGIN 10955000 + LABEL LX,EXIT,BEF; 10956000 + REAL K,N,T1,TL; 10957000 + TL ~ L; 10958000 + EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000 + L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000 + EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000 + AND PREPARATION FOR SWITCH-JUMP; 10962000 + GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000 + IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000 + LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000 + THEN BEGIN 10966000 + INFO[0,N] ~ ELBAT[I]; 10967000 + IF N ~ N+1 = 256 10968000 + THEN BEGIN ERR(147); GO TO EXIT END; 10969000 + IF STEPI = COMMA THEN GO TO LX; 10970000 + EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000 + FOR K ~ 0 STEP 1 UNTIL N 10972000 + DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000 + EMIT((GT1~INFO[0,K]).[35:1]); 10974000 + EMIT(GT1) END; 10975000 + SWITCHGEN ~ FALSE END 10976000 + ELSE BEGIN 10977000 + BEF: L ~ BUMPL; N ~ N-1; 10978000 + PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500 + [16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600 + FOR K ~ 0 STEP 1 UNTIL N 10979000 + DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000 + ADJUST; T1 ~ L; 10981000 + EMITL(GNAT(GT1~INFO[0,K])); 10982000 + GENGO(GT1); 10983000 + INFO[0,K] ~ T1; 10984000 + EMITO(RTS); 10985000 + CONSTANTCLEAN END; 10986000 + I ~ I-1; N ~ N+1; 10987000 + DO BEGIN ADJUST; 10988000 + STEPIT; INFO[0,N] ~ L; 10989000 + IF N ~ N+1 = 256 10990000 + THEN BEGIN ERR(147); GO TO EXIT END; 10991000 + DEXP; EMITO(RTS) END 10992000 + UNTIL ELCLASS ! COMMA; ADJUST; 10993000 + EMITB(BFW,TL+12,L); EMITO(BFC); 10994000 + EMIT(0); EMITO(RTS); N ~ N-1; 10995000 + FOR K ~ 0 STEP 1 UNTIL N 10996000 + DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000 + SWITCHGEN ~ TRUE END; 10998000 + T1 ~ L; 10999000 + L ~ TL+4; 11000000 + EMITL(N+1); 11001000 + L ~ T1; 12000000 + EXIT: END SWITCHGEN; 12001000 + PROCEDURE DBLSTMT; 12002000 + BEGIN 12003000 + REAL S,T; 12004000 + BOOLEAN B ; 12004100 + LABEL L1,L2,L3,L4,EXIT ; 12005000 + S~0; 12006000 + IF STEPI!LEFTPAREN THEN ERR(281) 12007000 + ELSE 12008000 + L1: BEGIN 12009000 + IF STEPI=COMMA THEN 12010000 + BEGIN 12011000 + DPTOG~TRUE; 12012000 + IF STEPI=ADOP THEN STEPIT; 12013000 + EMITNUM(NLO); 12014000 + EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000 + DPTOG~FALSE; 12016000 + STEPIT; 12017000 + GO TO L2; 12018000 + END; 12019000 + IF TABLE(I+1)=COMMA THEN 12020000 + BEGIN 12021000 + IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000 + BEGIN 12023000 + EMITO(ELBAT[I].ADDRESS+1); 12024000 + L4: IF (S~S-1){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 ELCLASSBOOID AND ELCLASSBOOPROCID AND ELCLASSBOOARRAYID 12063000 + THEN VARIABLE(FL) 12063100 + ELSE ERRX(386) ; 12063200 + EMITO(IF B THEN ISD ELSE STD) ; 12063300 + END 12063400 + UNTIL T~T+1=2 ; 12063500 + IF ELCLASS!RTPAREN THEN GO L3 ; 12063600 + IF S!0 THEN FLAG(383) ELSE BEGIN STEPIT; GO EXIT END ; 12063610 + END ; 12063700 + IF ELCLASS=FACTOP THEN 12063800 + BEGIN 12063900 + EMITO(MKS); EMITL(8); EMITV(GNAT(POWERALL)); GO L5 ; 12064000 + END ; 12064100 + IF ELCLASS>BOOID AND ELCLASS IOTEMP THEN 13157030 + IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040 + ELSE BEGIN 13158000 + EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000 + EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000 + END ; 13161000 + WHILE ELCLASS=COMMA DO 13162000 + IF GT1~FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000 + BEGIN ERR(291); GO START END 13164000 + ELSE BEGIN 13165000 + EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000 + GT1~FILEATTRIBUTEHANDLER(FIO); 13167000 + END ; 13168000 + END ; 13169000 + END ; 13170000 + ARRAYFLAG~FALSE ; 13181000 + IF ELCLASS!RTPAREN THEN FLAG(29); 13182000 + COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000 + IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000 +% VOID 13185000 +% VOID 13186000 + END 13187000 + UNTIL STEPI!COMMA; 13188000 + STOPENTRY~FALSE; 13189000 + END ELSE 13190000 + BEGIN 13191000 + IF G!FORMATV THEN FLAG(33) ELSE 13192000 + IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN13193000 + END; 13194000 + START: 13195000 + END; 13196000 + PROCEDURE HANDLESWLIST; 13196300 + BEGIN 13196310 + LABEL OVER; 13196320 + 13196330 + JUMPCHKX; 13196340 + STOPENTRY~ NOT SPECTOG; 13196350 + ENTRY(SUPERLISTID); 13196360 + IF SPECTOG THEN GO TO OVER; 13196370 + IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380 + COMMENT MISSING ~; 13196390 + EMITO(MKS); 13196400 + CHECKDISJOINT(ADDRSF); 13196410 + G~L; L~L+1; 13196420 + EMITL(1); 13196430 + EMITL(1); 13196440 + EMITL(1); 13196450 + EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460 + LIST DESCRIPTORS FOR SWITCH LIST; 13196470 + COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480 + J~-1; STOPENTRY ~ FALSE; 13196490 + DO 13196500 + BEGIN 13196510 + IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520 + THEN BEGIN ERR(42); GO TO OVER END; 13196530 + PASSLIST; 13196540 + EMITL(J~J+1); 13196550 + EMITN(ADDRSF); 13196560 + EMITO(STD); COMMENT STORE LIST DESC IN ARRAY;13196570 + END 13196580 + UNTIL ELCLASS ! COMMA; 13196590 + GT2~L; L~G; EMITL(J+1); L~GT2; 13196600 + OVER: END OF HANDLESWLIST; 13196610 + PROCEDURE SCATTERELBAT; 13197000 + BEGIN 13198000 + REAL T; 13199000 + T ~ ELBAT[I]; 13200000 + KLASSF ~ T.CLASS; 13201000 + FORMALF ~ BOOLEAN(T.FORMAL); 13202000 + VONF ~ BOOLEAN(T.VO); 13203000 + LEVELF ~ T.LVL; 13204000 + ADDRSF ~ T.ADDRESS; 13205000 + INCRF ~ T.INCR; 13206000 + LINKF ~ T.LINK; 13207000 + END SCATTERELBAT; 13208000 +PROCEDURE CHKSOB; 13209000 + IF GTA1[J~J-1]!0 THEN FLAG(23); 13210000 +DEFINE SUBOP=48#, 13211000 + ADDC=532480#, 13212000 + SUBC=1581056#, 13213000 + EMITSTORE=EMITPAIR#; 13214000 + PROCEDURE PURGE(STOPPER); 13215000 + VALUE STOPPER; 13216000 + REAL STOPPER; 13217000 + BEGIN 13218000 + INTEGER POINTER; 13219000 + LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000 + REAL J,N,OCR,TL,ADD; 13221000 + POINTER~LASTINFO; 13222000 + WHILE POINTER } STOPPER 13223000 + DO 13224000 + BEGIN 13225000 + IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO 13226000 + THEN BEGIN 13227000 + NCII~NCII-1; 13228000 + EMITNUM(TAKE(POINTER+1)); 13229000 + EMITSTORE(MAXSTACK,STD); 13230000 + MAXSTACK~(G~MAXSTACK)+1; 13231000 + J~L; L~GT1.LINK; 13232000 + DO 13233000 + BEGIN 13234000 + GT4~GET(L); 13235000 + EMITV(G) 13236000 + END 13237000 + UNTIL (L~GT4)=4095; 13238000 + L~J; 13239000 + POINTER~POINTER-GT1.INCR 13240000 + END 13241000 + ELSE 13242000 + BEGIN 13243000 + IF NOT BOOLEAN(GT1.FORMAL) 13244000 + THEN BEGIN 13245000 + IF ELCLASS = LABELID 13246000 + THEN BEGIN 13247000 + ADD ~ GT1.ADDRESS; 13248000 + IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1] 13249000 + THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000 + THEN BEGIN GT1 ~ 160; GO TO RECOV END; 13251000 + IF ADD ! 0 THEN GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000 + ELSE IF ELCLASS = SWITCHID 13253000 + THEN BEGIN 13254000 + IF TAKE(POINTER+1) < 0 13255000 + THEN BEGIN GT1 ~ 162; GO TO RECOV END; 13256000 + OCR ~(J ~ TAKE(GIT(POINTER))).[24:12]; 13257000 + N ~ GET( (J~J.[36:12])+4); TL ~ L; 13258000 + IF ADD ~ GT1.ADDRESS ! 0 13259000 + THEN BEGIN 13260000 + GT5 ~ PROGDESCBLDR(0,J,ADD); 13261000 + IF OCR ! 0 13262000 + THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000 + L~J+11; EMITL(15); EMITO(RTS); 13264000 + FOR J ~ 4 STEP 4 UNTIL N 13265000 + DO BEGIN 13266000 + EMITL(GNAT(GET(L)|4096+GET(L+1))); 13267000 + EMITO(RTS) END END 13268000 + ELSE BEGIN 13269000 + L ~ J+13; 13270000 + FOR J ~ 4 STEP 4 UNTIL N 13271000 + DO BEGIN 13272000 + GT1 ~ GET(L)|4096+GET(L+1); 13273000 + GOGEN(GT1,BFW) END;END; 13274000 + 13275000 + 13276000 + L ~ TL END 13277000 + ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID 13278000 + THEN IF TAKE(POINTER+1) < 0 13279000 + THEN BEGIN GT1 ~ 161; 13280000 + RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM);13281000 + Q ~ ACCUM[1]; FLAG(GT1); ERRORTOG ~ TRUE END 13282000 + END; 13283000 + XREFDUMP(POINTER); % DUMP XREF INFO 13283500 + GT2~TAKE(POINTER+1); 13284000 + GT3~GT2.PURPT; 13285000 + STACKHEAD(0>2[12:12:36])MOD 125]~TAKE(POINTER).LINK; 13286000 + POINTER~POINTER-GT3 13287000 + END 13288000 + END ; 13289000 + LASTINFO~POINTER; 13290000 + NEXTINFO~STOPPER 13291000 + END; 13292000 +PROCEDURE E; 13293000 +COMMENT 13294000 + E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND 13295000 + HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK 13296000 + IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY 13297000 + E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE 13298000 + BEGINNING OF THE NEXT ROW IF NECESSARY ;13299000 + BEGIN 13300000 + REAL WORDCOUNT,RINX; 13301000 + IF RINX~(NEXTINFO+WORDCOUNT~(COUNT+18)DIV 8 ).LINKR ! 13302000 + NEXTINFO.LINKR 13303000 + THEN BEGIN PUT(0&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO); 13304000 + NEXTINFO~256|RINX END; 13305000 + IF SPECTOG THEN 13305100 + IF NOT MACROID THEN 13305200 + UNHOOK; 13305300 + KOUNT~COUNT; 13306000 + ACCUM[0].INCR~WORDCOUNT; 13307000 + ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO; 13308000 + ACCUM[1].PURPT~NEXTINFO~LASTINFO; 13309000 +MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000 + IF XREF THEN % MAKE DECLARATION REFERENCE 13310050 + IF (ACCUM[0].CLASS ! DEFINEID OR NOT 13310075 + BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER 13310080 + BEGIN 13310100 + XREFINFO[NEXTINFO] := 13310200 + IF SPECTOG THEN 13310300 + XREFINFO[ELBAT[I]] 13310350 + ELSE 13310400 + ((XLUN := XLUN + 1) & SGNO SEGNOF); 13310450 + IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY 13310500 + XMARK(DECLREF) 13310525 + ELSE 13310550 + XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG 13310575 + THEN NORMALREF ELSE DECLREF); 13310580 + END 13310600 + ELSE % DEFINE PARAMETERS - DONT CROSS REF. 13310700 + XREFINFO[NEXTINFO] := 0 13310750 + ELSE 13310800 + IF DEFINING.[1:1] THEN % WE ARE DOING XREFING 13310900 + XREFINFO[NEXTINFO] := 0; 13310950 + LASTINFO~NEXTINFO; 13311000 + IF NEXTINFO ~ NEXTINFO+WORDCOUNT } 8192 THEN 13312000 + BEGIN FLAG(199); GO TO ENDOFITALL END; 13312500 + END; 13313000 +PROCEDURE ENTRY(TYPE); 13314000 + VALUE TYPE; 13315000 + REAL TYPE; 13316000 +COMMENT 13317000 + ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH 13318000 + IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT 13319000 + ACCORD TO TYPE .IF THE ENTRY IS AN ARRAY AND NOT 13320000 + A SPECIFICATION THEN A DESCRIPTOR IS PALCED IN THE STACK 13321000 + FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) ;13322000 + BEGIN 13323000 + BOOLEAN SVTOG;% 13323010 + J~0;I~I-1; 13324000 + DO 13325000 + BEGIN 13326000 + STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT; 13327000 + IF FORMALF~SPECTOG 13328000 + THEN 13329000 + BEGIN 13330000 + IF TYPE{INTARRAYID AND TYPE}BOOARRAYID THEN% 13330550 + IF VONF THEN BEGIN SVTOG ~ ERRORTOG; FLAG(15);% 13330600 + SPECTOG ~ ERRORTOG ~ SVTOG; END;% 13330650 + IF ELCLASS!SECRET 13331000 + THEN FLAG(002); 13332000 + BUP~BUP+1 13333000 + END 13334000 + ELSE 13335000 + BEGIN 13336000 + IF ELCLASS>IDMAX AND ELCLASS{FACTOP 13337000 + THEN FLAG(003); 13338000 + IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 13339000 + IF NOT (PTOG OR STREAMTOG) AND LINKF } GLOBALNINFOO 13339100 + THEN FLAG(1) 13339200 + ELSE 13339300 + ELSE 13339400 + IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION 13339500 + FLAG(1); 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}BOOARRAYID 13346000 + THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000 + EMITL(ADDRSF); EMITN(10); 13347500 + END 13347510 + ELSE CHECKDISJOINT(ADDRSF); 13347520 + END; 13348000 + IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100 + XREFPT~XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200 + KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000 + END 13350000 + UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J 13351000 + END; 13352000 + PROCEDURE UNHOOK; 13353000 +COMMENT 13354000 + UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000 + FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000 + E WILL WORK AS NORMAL. ;13357000 + BEGIN 13358000 + REAL LINKT,A,LINKP; 13359000 + LABEL L; 13360000 + LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000 + IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK 13362000 + ELSE 13363000 + L: IF A~TAKE(LINKT).LINK=LINKP 13364000 + THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000 + ELSE BEGIN LINKT~A; GO TO L END; 13366000 + END; 13367000 +PROCEDURE MAKEUPACCUM; 13368000 + BEGIN 13369000 + IF PTOG 13370000 + THEN GT1~LEVELF ELSE GT1~LEVEL; 13371000 + ACCUM[0]~ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000 + & REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11]13373000 + ) 13374000 + END; 13375000 +PROCEDURE ARRAE; 13376000 +COMMENT 13377000 + ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000 + IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000 + STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000 + MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000 + EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000 + ARRAY A[0:10], 13383000 + MKS (THIS MARKS STACK TO CUT BACK AFTER COM)13384000 + DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000 + THE ADDRESS OF A) 13386000 + LITC 11 (SIZE OF ARRAY) 13387000 + LITC 1 (NUMBER OF DIMENSIONS) 13388000 + LITC 1 (NUMBER OF ARRAYS) 13389000 + LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000 + NON OWN ARRAYS) 13391000 + COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000 + DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000 + STACK) 13394000 + OWN ARRAY B,C[0:X,-1:10], 13395000 + MKS 13396000 + DESC B 13397000 + DESC C 13398000 + LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000 + OPDC X 13400000 + LITC JUNK (JUNK CELL) 13401000 + ISN (INTEGERIZE UPPER BOUND) 13402000 + LITC 1 (COMPUTE SIZE 13403000 + ADD OF DIMENSION 13404000 + LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000 + CHS 13406000 + LITC 12 (SIZE SECOND DIMENSION) 13407000 + LITC 2 (NUMBER DIMENSIONS) 13408000 + LITC 2 (NUMBER ARRAYS) 13409000 + LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000 + COM 13411000 + DESC XITR 13412000 + SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000 + MKS 13414000 + DESC D 13415000 + DESC E 13416000 + DESC F 13417000 + OPDC X 13418000 + LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000 + ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000 + DUP (MUST PASS LOWER BOUND FOR OWN) 13421000 + OPDC Y (INTEGERIZE 13422000 + LITC JUNK UPPER 13423000 + ISN BOUND) 13424000 + XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000 + SUB UPPER 13426000 + LITC 1 -LOWER 13427000 + ADD +1) 13428000 + OPDC M (COMPUTER LOWER BOUND 13429000 + OPDC N SECOND DIM) 13430000 + ADD 13431000 + LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000 + ISN (INTEGERIZE) 13433000 + DUP (PASS LOWER BOUND FOR OWN) 13434000 + OPDC T 13435000 + MUL V 13436000 + LITC JUNK (INTEGERIZE 13437000 + ISN UPPER) 13438000 + XCH (COMPUTE 13439000 + SUB SIZE 13440000 + LITC 1 13441000 + ADD ) 13442000 + LITC 2 (NUMBER DIMENSIONS) 13443000 + LITC 3 (NUMBER ARRAYS) 13444000 + LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000 + COM 13446000 + DESC XITR ; 13447000 + BEGIN 13448000 + REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000 + BOOLEAN LLITOG,ULITOG; 13450000 +REAL ADDCON; 13451000 + LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000 + ARRAYFLAG ~ TRUE; 13452100 + TYPEV~REALARRAYID; 13453000 + IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000 +ELSE 13455000 + IF T1=OWNV THEN 13456000 + BEGIN P2:=TRUE;IF SPECTOG THEN FLAG(13) END 13457000120324PK +ELSE 13458000 + IF T1= SAVEV THEN 13459000 + BEGIN 13460000 + P3:=TRUE; 13461000 + IF SPECTOG THEN FLAG(13); 13462000 +% IF REMOTOG THEN FLAG(508); % NOT ALLOWED IN XALGOL ON TSS. 13463000 + END 13464000 +ELSE 13465000 + IF T1= AUXMEMV THEN 13466000 + BEGIN P4:=TRUE; IF SPECTOG THEN FLAG(13) END 13467000 +ELSE 13468000 + TYPEV :=REALID+T1; 13469000 + IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000 + ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000 +BETA1: 13472000 + IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ~0;SAVEDIM~1; 13473000 +TWO:IF STEPI=ADOP THEN 13474000 + BEGIN 13475000 + T1~ELBAT[I].ADDRESS; I~I+1 13476000 + END 13477000 + ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000 + APROGS~L; 13479000 + IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000 + BEGIN 13481000 + LLITOG~TRUE; 13482000 + IF T3~ELBAT[I].ADDRESS!0 13483000 + THEN 13484000 + BEGIN 13485000 + EMITL(T3); 13486000 + IF T1=SUBOP THEN 13487000 + BEGIN 13488000 + EMITO(CHS); 13489000 + ADDCON~ADDC 13490000 + END ELSE 13491000 + ADDCON~SUBC 13492000 + END; 13493000 + T2~T3|4+ADDCON 13494000 + END 13495000 + ELSE 13496000 + BEGIN 13497000 + LLITOG~FALSE; 13498000 + IF T1!0 THEN I~I-1; 13499000 + T2:=GETSPACE(P2,-1);%TEMP. 13500000 + AEXP;EMITSTORE(T2,ISN); 13501000 + T2~T2|4+SUBC+2; 13502000 + IF ELCLASS!COLON THEN 13503000 + FLAG(017);I~I-1 13504000 + END; 13505000 + IF P2 THEN 13506000 + BEGIN 13507000 + IF LLITOG AND T3=0 THEN EMITL(0);13508000 + ARPROGS~L;EMITO(DUP); 13509000 + END; 13510000 + IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000 + BEGIN 13512000 + IF T~TABLE(I~I+1)=COMMA OR 13513000 + T~RTBRKET 13514000 + THEN 13515000 + BEGIN 13516000 + EMITL(T4~ELBAT[I-1].ADDRESS);13517000 + ULITOG~TRUE;GO TO CSZ 13518000 + END 13519000 + ELSE 13520000 + I~I-1 13521000 + END; 13522000 + ULITOG~FALSE; 13523000 + AEXP; 13524000 + EMITL(JUNK); 13525000 + EMITL(ISN); 13526000 +CSZ: IF LLITOG AND ULITOG THEN 13527000 + BEGIN 13528000 + L~ARPROGS; 13529000 + IF(T~IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000 + T4-T3+1){0 OR T>1023 THEN FLAG(59); 13531000 + EMITL(T); 13531100 + IF P3 THEN BEGIN SAVEDIM~SAVEDIM|T; 13532000 + IF SAVEDIM>MAXSAVE 13533000 + THEN MAXSAVE~SAVEDIM 13534000 + END 13535000 + ELSE 13536000 + IF T>MAXROW THEN MAXROW~T; 13537000 + END 13538000 + ELSE 13539000 + BEGIN IF NOT(LLITOG AND T3=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 NOT SPECTOG THEN 13550000 + BEGIN 13551000 +COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400 + NOOFARRAYS:=NOOFARRAYS + GTA1[0]; 13551500 + EMITL(LBJ);EMITL(GTA1[0]); 13552000 + IF P3 AND P4 THEN FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 13552500 + EMITL(REAL(P3)+2|REAL(P2)+REAL(P4)|64); 13553000 + EMITV(5) 13554000 + END; 13555000 + PUT(LBJ,SAVEINFO2-1); 13556000 + DO BEGIN 13557000 + T~TAKE(SAVEINFO); 13558000 + K~T.INCR; 13559000 + T.INCR~SAVEINFO2-SAVEINFO-1; 13560000 + PUT(T,SAVEINFO); 13561000 + END 13562000 + UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000 + IF STEPI!COMMA THEN GO TO START; 13564000 + IF NOT SPECTOG THEN EMITO(MKS); 13565000 + SAVEINFO~NEXTINFO; 13566000 + I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO~NEXTINFO+1;GO TO BETA1; 13567000 +BETA2: 13568000 + IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000 + THEN 13570000 + BEGIN 13571000 + IF ELCLASS~TABLE(I-1)=LITNO 13572000 + THEN 13573000 + BEGIN 13574000 + T3~ELBAT[I-1].ADDRESS; 13575000 + IF T1= SUBOP THEN 13576000 + ADDCON ~ADDC 13577000 + ELSE 13578000 + ADDCON ~SUBC; 13579000 + T2~T3|4+ADDCON; GO TO SLB; 13580000 + END; 13581000 + IF ELCLASS=FACTOP THEN 13582000 + BEGIN 13583000 + T2~-SUBC; GO TO SLB 13584000 + END 13585000 + END; 13586000 + FLAG(019); 13587000 +START: ARRAYFLAG ~ FALSE END; 13588000 + PROCEDURE PUTNBUMP(X); 13589000 + VALUE X; 13590000 + REAL X; 13591000 + BEGIN 13592000 + INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000 + NEXTINFO~NEXTINFO+1 13594000 + END ; 13595000 + PROCEDURE JUMPCHX; 13596000 +COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000 + WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000 + ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000 + IS THE FIRST EXECUTABLE CODE; 13600000 +IF NOT SPECTOG THEN 13601000 +BEGIN 13602000 + IF AJUMP 13603000 + THEN 13604000 + BEGIN ADJUST; 13605000 + EMITB(BFW,SAVEL,L) 13606000 + END ELSE 13607000 + IF FIRSTX=4095 13608000 + THEN 13609000 + BEGIN 13610000 + ADJUST; 13611000 + FIRSTX~L; 13612000 + END; 13613000 + AJUMP~FALSE 13614000 +END; 13615000 + PROCEDURE JUMPCHKNX; 13616000 +COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000 + EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000 + NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH 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 + BEGIN 13632100 + IF NOHEADING THEN DATIME; 13633000 + IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 + ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 + END SEGMENTSTART; 13633300 +PROCEDURE SEGMENT(SIZE,NO,NOO); 13634000 + VALUE SIZE,NO,NOO; 13635000 + REAL SIZE,NO,NOO; 13636000 + BEGIN 13637000 + INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT 13637100 + % IS NOT TOO BIG 13637200 + PDPRT[PDINX.[37:5],PDINX.[42:6]] := 13638000 + SIZE & NO[28:38:10] & 13639000 + MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & 13640000 + REAL(SAVEPRTOG)[3:47:1]; 13641000 + PDINX:=PDINX+1; SIZE:=ABS(SIZE); 13642000 + IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; 13643000 + AKKUM:=AKKUM+SIZE; 13644000 + IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16|(SIZE.[38:6]+1); 13645000 + IF LISTER OR SEGSTOG THEN 13646000 + BEGIN 13647000 + IF NOHEADING THEN DATIME; 13648000 + IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) 13649000 + ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); 13650000 + END; 13651000 + LDICT[NO.[38:3],NO.[41:7]] := 13652000 + IF BUILDLINE THEN 13653000 + MOVENADBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] 13654000 + ELSE -1; 13655000 + END OF SEGMENT; 13656000 + 13697000 + 13698000 + 13699000 + 13700000 + 13701000 + 13702000 + 13703000 + 13704000 + 13705000 + 13706000 + 13707000 + 13708000 + 13709000 + 13710000 + 13711000 + 13712000 + 13713000 +PROCEDURE ENTER(TYPE); VALUE TYPE; INTEGER TYPE; 13714000 + BEGIN 13715000 + G:=GTA1[J:=J-1]; 13716000 + IF NOT SPECTOG THEN 13717000 + BEGIN 13718000 + IF NOT P2 THEN 13719000 + IF P2:=(G=OWNV) THEN G:=GTA1[J:=J-1]; 13720000 + IF NOT P3 THEN 13721000 + IF P3:=(G=SAVEV) THEN G:=GTA1[J:=J-1]; 13722000 + IF NOT P4 THEN 13723000 + IF P4:=(G=AUXMEMV) THEN G:=GTA1[J:=J-1]; 13724000 + END; 13725000 + IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE) 13726000 + END ENTER; 13727000 + 13728000 + 13729000 + 13730000 +PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000 + VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD; 13732000 + BOOLEAN GOTSTORAGE; 13733000 + REAL RELAD,STOPPER,PRTAD; 13734000 + BEGIN 13735000 + BOOLEAN BT; 13736000 + REAL K,LS; 13737000 + LS~RELAD; 13738000 + BT~JUMPCTR=LEVEL; 13739000 + IF FUNCTOG 13740000 + THEN 13741000 + BEGIN 13742000 + EMITV(514); 13743000 + EMITO(RTN) 13744000 + END 13745000 + ELSE 13746000 + EMITO(XIT); 13747000 + IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000 + CONSTANTCLEAN; 13749000 + IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000 + THEN 13751000 + BEGIN ADJUST;LS~L; 13752000 + IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000 + THEN 13754000 + BEGIN 13755000 +% 13755500 + EMITV(BLOCKCTR); 13756000 + EMITL(1); 13757000 + EMITO(ADD); 13758000 + IF GOTSTORAGE OR FAULTOG.[46:1] 13759000 + THEN 13760000 + EMITSTORE(BLOCKCTR,SND) 13761000 + END 13762000 +% 13762500 + ELSE EMITL(0); 13763000 + K~K+NCII; 13764000 + WHILE K~K-1}0 13765000 + DO EMITL(0); 13766000 + PURGE(STOPPER); 13767000 + IF FAULTLEVEL{LEVEL THEN 13767100 + BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200 + EMITPAIR(0,MDS); EMITO(CHS); 13767300 + END OF THIS PART OF ERROR KLUDGE; 13767400 + EMIT(0); % DC & DISK 13767500 + BUMPL; 13768000 + 13768100 + EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000 + CONSTANTCLEAN 13770000 + END ELSE PURGE(STOPPER); 13771000 + Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000 + END HTTEOAP; 13773000 +PROCEDURE FORMATGEN; 13774000 + BEGIN 13775000 + INTEGER PRT;LABEL L; 13776000 + BOOLEAN TB2; 13777000 + ARRAY TEDOC[0:7,0:127]; 13777500 + MOVECODE(TEDOC,EDOC); 13777600 + BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700 + TB2~GTA1[J-1]=SWITCHV; 13778000 + GT5~SGNO; 13779000 +L: GT1:=(2|SGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000 + IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002 + SGNO~SGAVL; 13781000 + 13782000 + F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000 + Z~PROGDESCBLDR(LDES,0,PRT); 13784000 + IF TB2 THEN 13785000 + BEGIN 13786000 + ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(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); 13791000 + ELCLASS:="<"; 13791050 + TB1~FORMATPHRASE; 13792000 + END 13793000 + UNTIL ELCLASS!","; 13794000 + RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000 + DO 13796000 + WHIPOUT(TAKE(RR4~RR4+1)) 13797000 + UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000 + 13799000 + END ELSE 13800000 + BEGIN 13801000 + I~I-1; 13802000 + DO 13803000 + BEGIN 13804000 + STOPDEFINE~TRUE;STEPIT ; 13805000 + ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="<";13806000 + PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000 + TB1~FORMATPHRASE; 13808000 + END 13809000 + UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000 + 13811000 + 13812000 + END; 13813000 + SEGMENT(-F,SGNO,GT5);SGAVL~SGAVL+1; 13814000 + IF TB1 AND ELCLASS="," THEN BEGIN I~I+1;GO TO L END; 13815000 + IF ELCLASS!";" THEN ELBAT[I]~0 ELSE ELBAT[I].CLASS~SEMICOLON; 13816000 + STOPGSP~STOPENTRY~FALSE; 13817000 + SGNO~GT5; 13818000 + MOVECODE(TEDOC,EDOC); 13818500 + BUILDLINE ~ BUILDLINE.[46:1] ; 13818600 + END FORMATGEN; 13819000 +PROCEDURE CHECKBOUNDLVL ; 13819100 + COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200 + DECLARED AT SAME LEVEL; 13819300 + IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400 + THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410 + COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 + ARARY DECLARATION; 13819600 + PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR 13900000 + THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 13901000 + PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 13902000 + INTRINSIC, WHO WILL BUILD AIT ENTRIES; 13903000 + BEGIN INTEGER TP; REAL A; 13903100 + J~0; JUMPCHKX; EMITO(MKS); 13904000 + IF FAULTLEVEL>LEVEL THEN FAULTLEVEL~LEVEL; 13905000 + IF MODE=0 THEN FAULTLEVEL~1; 13906000 + DO BEGIN IF J>0 THEN STEPIT; J~J+1; 13907000 + SCATTERELBAT; A~ACCUM[1]; 13908000 + IF TP~REAL((Q="6INTOV")&(Q="6EXPOV")[46:47:1]&(Q="5INDEX" 13909000 + )[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1])=0 13910000 + THEN ERR (61) ELSE 13911000 + BEGIN IF TABLE(I+1)=ASSIGNOP THEN 13911100 + BEGIN STEPIT; COMMENT OVER THE ~; 13911200 + IF GT1~STEPI>IDMAX AND GT10 14229000 + THEN 14230000 + IF TB1 THEN GT1~GT2 ELSE 14231000 + GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000 + EMITSTORE(GT1,STD) 14233000 + END; 14234000 + END 14235000 + ELSE 14236000 + BEGIN 14237000 + IF ELCLASS!FORWARDV THEN FLAG(33); 14238000 + PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000 + PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000 + IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000 + STEPIT; 14242000 + FORMALF~TRUE 14243000 + END; 14244000 + PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]>1[16:37:11],LASTINFO); 14245000 + IF TB1 THEN 14246000 + BEGIN 14247000 + NEXTINFO~GT5; 14248000 + LASTINFO~GT4; 14249000 + END; 14250000 + START: 14251000 + END SWITCHDEC; 14252000 +GO TO START; 14253000 + DEFINEDEC: 14254000 + BEGIN LABEL START; 14254050 + REAL J,K,DINFO,LINKA,LINKB; 14254100- + STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000 + DEFINING := BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 14255500 + DO 14256000 + BEGIN 14257000 + STOPDEFINE:=TRUE; 14258000 + STEPIT; MOVE(9,ACCUM[1],GTA1); 14259000 + K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID); 14259010 + GTA1[0]~J+"100000"; J~0; 14259015 + DINFO ~ LASTINFO; 14259017 + IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020 + BEGIN 14259030 + IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040 + DO BEGIN STOPDEFINE~TRUE; 14259060 + STEPIT; 14259070 + IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075 + MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080 + DEFINEPARAM(DINFO+1, J); 14259085 + ACCUM[0] := 0 & DEFINEDID CLASS & 1 FORMAL; 14259090 + LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094 + E; 14259096 + IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098 + PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100 + STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102 + STOPDEFINE ~ TRUE; 14259104 + END UNTIL STEPI!COMMA; 14259110 + IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120 + STOPDEFINE~TRUE; 14259130 + STEPIT; 14259140 + PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150 + PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155 + END; 14259160 + IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000 + THEN 14261000 + BEGIN 14262000 + FLAG(45); 14263000 + COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100 + I~I-1; 14264000 + END; 14265000 + MACROID~TRUE; 14265900 + LASTINFO ~ DINFO; 14265930 + PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950 + DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000 + MACROID~FALSE; 14266100 + END 14267000 + UNTIL STEPI!COMMA; 14268000 + DEFINING := BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 14268500 + START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000 +FIELDDEC: 14269020 + BEGIN 14269040 + REAL SAVEINFO, SB, NB; 14269060 + BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC. 14269080 + LABEL EXIT, SAVEIT; 14269100 + STOPENTRY := STOPGSP := TRUE; 14269120 + I := I - 1; 14269140 + DO 14269160 + BEGIN 14269180 + STOPDEFINE := TRUE; 14269200 + STEPIT; 14269220 + ENTRY(FIELDID); 14269240 + SAVEINFO := LASTINFO; 14269260 + IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN 14269280 + BEGIN 14269300 + IF STEPI = LFTBRKET THEN % REMEMBER THIS 14269320 + BEGIN 14269340 + FOUNDLB := TRUE; 14269360 + STEPIT; 14269380 + END 14269400 + ELSE 14269420 + FOUNDLB := FALSE; 14269440 + IF ELCLASS = FIELDID THEN 14269442 + BEGIN 14269444 + SB := ELBAT[I].SBITF; 14269446 + NB := ELBAT[I].NBITF; 14269448 + GO TO SAVEIT; 14269450 + END; 14269452 + IF ELCLASS = LITNO THEN 14269460 + IF STEPI = COLON THEN 14269480 + IF STEPI = LITNO THEN 14269500 + IF (SB := ELBAT[I-2].ADDRESS) | 14269520 + (NB := ELBAT[I].ADDRESS) ! 0 AND 14269540 + SB + NB { 48 THEN 14269560 + BEGIN 14269580 + SAVEIT: 14269590 + PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, 14269600 + SAVEINFO); 14269620 + STEPIT; 14269640 + IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. 14269660 + IF ELCLASS = RTBRKET THEN 14269680 + BEGIN 14269700 + STEPIT; 14269705 + GO TO EXIT; 14269710 + END 14269715 + ELSE 14269720 + ELSE 14269740 + GO TO EXIT; 14269760 + END; 14269780 + END; 14269800 + FLAG(114); 14269820 + DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; 14269840 + EXIT: 14269860 + END 14269880 + UNTIL 14269900 + ELCLASS ! COMMA; 14269920 + STOPENTRY := STOPGSP := FALSE; 14269940 + END; 14269960 + GO TO START; 14269980 +PROCEDUREDEC: 14270000 + BEGIN 14271000 + LABEL START,START1; 14272000 + LABEL START2, DOITANYWAY; 14273000 + COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000 + IF NOT SPECTOG THEN FUNCTOG~FALSE; 14275000 + FWDTOG := NEXTSAVE := FALSE; 14276000 + IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500 + MAXSTACKO~ MAXSTACK; 14277000 + IF G~GTA1[J~J-1]=STREAMV 14278000 + THEN 14279000 + BEGIN STREAMTOG~TRUE; 14280000 + IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000 + ELSE 14282000 + BEGIN 14283000 + IF TYPEV~PROCID +G>INSTRPROCID OR 14284000 + TYPEV INTRPROCID THEN FLAG(005) 14295000 + ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100 + IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000 + END; 14297000 + IF SPECTOG 14298000 + THEN 14299000 + BEGIN 14300000 + ENTRY(TYPEV); GO TO START2 14301000 + END; 14302000 + MODE~MODE+1; 14303000 + LO~PROINFO; 14304000 + SCATTERELBAT; 14305000 +COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000 + IF LEVELF=LEVEL 14307000 + THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000 + BEGIN 14309000 +IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000 + XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST 14310500 + % XREF ENTRY AS A DECLARATION. 14310501 + IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100 + FWDTOG~TRUE; 14312000 + PROAD~ADDRSF; 14313000 + PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT 14314000 + END 14316000 + ELSE 14317000 + DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000 + ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000 + PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000 + P2~STOPENTRY~FALSE 14321000 + END; 14322000 + IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000 + ELSE FLAG(039); 14323100 + PJ ~ 0; 14323200 + IF STREAMTOG THEN STREAMWORDS; 14324000 + IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000 + IF ECLASS!LEFTPAREN THEN FLAG(007); 14326000 +COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000 + FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000 + RR1~NEXTINFO; 14329000 + LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000 + PUTNBUMP(0); 14331000 + PTOG~TRUE; I~I+1; 14332000 + ENTRY(SECRET); 14333000 +IF FWDTOG THEN BEGIN IF GT1 ~ TAKE(MARK).[40:8] ! PJ THEN% 14333100 + FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200 + COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300 + PUT(PJ,MARK); 14334000 + P~PJ; 14335000 + IF ELCLASS!RTPAREN 14336000 + THEN FLAG(008); 14337000 + IF STEPI!SEMICOLON 14338000 + THEN FLAG(009); 14339000 +COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000 + IF STEPI=VALUEV 14341000 + THEN 14342000 + BEGIN 14343000 + DO 14344000 + IF STEPI!SECRET 14345000 + THEN FLAG(010) 14346000 + ELSE 14347000 + BEGIN 14348000 + IF G~ELBAT[I].ADDRESS=0 OR G>PJ 14349000 + THEN 14350000 + FLAG(010); 14351000 + G~TAKE(ELBAT[I]); 14352000 + PUT(G&1[10:47:1],ELBAT[I]) 14353000 + END 14354000 + UNTIL 14355000 + STEPI!COMMA; 14356000 + IF ELCLASS!SEMICOLON 14357000 + THEN FLAG(011) 14358000 + ELSE STEPIT 14359000 + END;I~I-1; 14360000 + IF STREAMTOG 14361000 + THEN 14362000 + BEGIN 14363000 + BUP~PJ; SPECTOG~TRUE;GO TO START1 14364000 + END 14365000 + ELSE 14366000 + BEGIN 14367000 + SPECTOG~TRUE; 14368000 + BUP~0; 14369000 + IF ELCLASS!DECLARATORS 14370000 + THEN FLAG(012) 14371000 + END; 14372000 +START:PTOG~FALSE;LASTINFO~LASTINFOT;NEXTINFO~IF FWDTOG THEN RR1 ELSE 14373000 + MARK+PJ+1; 14374000 +START1:PINFOO~NEXTINFO; 14375000 +START2: END; 14376000 + IF SPECTOG OR STREAMTOG 14377000 + THEN 14378000 + GO TO START; 14379000 +COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 14380000 + PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS; 14381000 +HF: 14382000 + BEGIN 14383000 + LABEL START,STOP; 14384000 + IF STREAMTOG 14385000 + THEN BEGIN 14386000 + JUMPCHKNX;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 + XREFDUMP(J); % DUMP XREF INFO 14445100 + G~(GT2~TAKE(J+1)).PURPT; 14446000 + IF GT1.[2:8] ! STLABID|2+1 THEN 14447000 + STACKHEAD[(0>2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000 + END UNTIL J~J-G{1; 14449000 + PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000 + [13:37:11],MARK); 14451000 + GT1~ L; L ~ FILETHING ; 14451100 + WHILE L ! 4095 DO 14451200 + BEGIN FILETHING ~ GET(L); 14451300 + EMITC(PJ+1,RSA); 14451400 + L ~ FILETHING; 14451500 + END; 14451600 + L ~ GT1; FILETHING ~ 4095 ; 14451700 + IF FUNCTOG THEN 14452000 + BEGIN 14453000 + EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000 + EMITC(PJ+2,SED); 14455000 + EMITC(1,TRW); 14456000 + PUT(Z, PROINFO); 14457000 + END; 14458000 + EMIT(0); 14459000 + STREAMWORDS; 14460000 + STREAMTOG~FALSE; 14461000 + IF LISTER AND FORMATOG THEN SPACEITDOWN; 14461500 + END; 14462000 + LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000 + END 14464000 + ELSE 14465000 + BEGIN 14466000 + IF STEPI=FORWARDV 14467000 + THEN 14468000 + BEGIN 14469000 + XREFIT(PROINFO,0,FORWARDREF); % WE NEED THIS SO WE CAN FIND 14469100 + % THE FORWARD DECL. DURING XREF 14469101 + PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000 + PURGE(PINFOO); 14471000 + STEPIT 14472000 + END 14473000 + ELSE 14474000 + BEGIN 14475000 + PROADO~PROAD; 14476000 + TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000 +% 14478000 + COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010 + COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020 + IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030 + MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040 + IF ELCLASS = BEGINV THEN 14479000 + IF TABLE(I+1) = DECLARATORS THEN 14480000 + BEGIN 14481000 + BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000 + ; PURGE(PINFOO); 14483000 + GO TO STOP END; 14484000 + BEGIN 14485000 + JUMPCHKNX; 14486000 + RELAD~L ; 14487000 + IF NEXTSAVE THEN FLAG(052); 14487010 + STMT; 14488000 + IF FAULTOG.[46:1] THEN BEGIN EMITL(10); EMITO(COM); END;14488500 + HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000 + END; 14490000 + STOP: 14491000 + SUBLEVEL~TSUBLEVEL; 14492000 + STACKCTR~STACKCTRO; 14493000 + IF LISTER AND FORMATOG THEN SPACEITDOWN; 14493500 + END; 14494000 + END; 14495000 + PROINFO~LO; 14496000 + IF JUMPCTR=LEVEL 14497000 + THEN 14498000 + JUMPCTR~LEVEL-1; 14499000 + LEVEL~LEVEL-1; 14500000 + MODE~MODE-1; 14501000 + MAXSTACK~MAXSTACKO; 14502000 +START:END; 14503000 + GO TO START; 14504000 +CALLSTATEMENT: 14505000 + JUMPCHKX; 14506000 + IF SPECTOG THEN BEGIN 14507000 + IF (PJ ! BUP) THEN 14507010 + BEGIN 14507020 + INTEGER II,SSCRAM,SCOUNT; 14507030 + MOVE(10,ACCUM,INFO[31,240]); 14507040 + II :=I;SSCRAM:=SCRAM;SCOUNT:=COUNT; 14507050 + FOR SCRAM := 0 STEP 1 UNTIL 124 14507060 + DO IF((I~STACKHEAD[SCRAM]) < 256) 14507070 + THEN IF I ! 0 THEN 14507080 + BEGIN ELBAT[76]:=INFO[0,I]&I[35:35:14507090 + 13]; 14507095 + COUNT:=INFO[0,I+1].[12:6]; 14507100 + MOVE(COUNT,INFO[0,I],ACCUM); 14507105 + I:=76; SCATTERELBAT; 14507110 + FORMALF := TRUE; 14507120 + KLASSF := REALID; 14507130 + MAKEUPACCUM; E; 14507140 + END; 14507150 + I~II;SCRAM~SSCRAM;COUNT~SCOUNT; 14507160 + MOVE(10,INFO[31,240],ACCUM); 14507170 + BUP~PJ; FLAG(12);SPECTOG~TRUE; 14507180 + GO TO START; 14507190 + END ; 14507200 + FLAG(12);GO TO HF 14508000 + END; 14509000 + BEGINCTR ~ BEGINCTR-1; 14510000 + IF ERRORTOG 14511000 + THEN COMPOUNDTAIL 14512000 + ELSE 14513000 + BEGIN 14514000 + STMT; 14515000 + IF ELCLASS~TABLE(I+1)=DECLARATORS 14516000 + THEN 14517000 + BEGIN 14518000 + ELBAT[I].CLASS~SEMICOLON; 14519000 + BEGINCTR~BEGINCTR+1; 14520000 + GO TO START 14521000 + END 14522000 + ELSE 14523000 + COMPOUNDTAIL 14524000 + END; 14525000 +BEGIN 14526000 + RELAD~FIRSTX; 14534000 + IF STACKCTR>MAXSTACK 14535000 + THEN MAXSTACK~STACKCTR; 14536000 + IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000 + THEN 14538000 + IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000 + THEN 14540000 + BEGIN 14541000 + EMITV(BLOCKCTR); 14542000 + EMITL(1); 14543000 + EMITO(SUB); 14544000 + EMITSTORE(BLOCKCTR,STD); 14545000 + GOTSTORAGE~TRUE 14546000 + END 14547000 + ELSE 14548000 + BEGIN 14549000 + EMITL(10); 14550000 + EMITO(COM) 14551000 + END; 14552000 + FUNCTOG~FUNCTOGO; 14553000 + IF SOP 14554000 + THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000 + ELSE 14556000 + BEGIN 14557000 + IF LEVEL = 1 THEN EMITO(XIT) 14557500 + ELSE BEGIN 14557600 + EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000 + EMITO(BFW); 14558500 + END; 14558600 + CONSTANTCLEAN; 14559000 + IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000 + OR FAULTOG.[46:1] THEN 14561000 + BEGIN 14562000 + ADJUST; RELAD~L; 14563000 + IF GOTSTORAGE OR FAULTOG.[46:1] 14564000 + THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100 + EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000 + END; 14566000 +IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000 +=0; 14568000 + PURGE(NINFOO); 14569000 + IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100 + BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200 + BUMPL; 14570000 + EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000 + CONSTANTCLEAN 14572000 + END ELSE PURGE(NINFOO); 14573000 + IF RELAD =4095 THEN RELAD~0; 14574000 + NEXTTEXT ~ NTEXTO; 14574500 + G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000 + END; 14576000 + ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100 + SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000 + 14578000 + 14579000 + 14580000 + 14581000 + 14582000 + 14583000 + 14584000 + 14585000 + 14586000 + 14587000 + 14588000 + 14589000 + 14590000 + 14591000 + 14592000 + ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000 + MOVECODE(TENIL,ENIL); 14594000 + MOVECODE(TEDOC,EDOC);L~LOLD; 14595000 + DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000 + IF NOT SOP AND LEVEL ! 1 14597000 + THEN 14598000 + BEGIN 14599000 + ADJUST; 14600000 + G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000 + IF ELCLASS = FACTOP THEN 14601100 + BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200 + 14601300 + 14601400 + 14601500 + 14601600 + 14601610 + STEPIT; 14601700 + END; 14601800 + END; 14602000 + IF JUMPCTR=LEVEL THEN JUMPCTR~LEVEL-1; 14603000 + LEVEL~LEVEL-1; 14604000 + FUNCTOG~FUNCTOGO; 14605000 + AJUMP~AJUMPO; 14606000 + GLOBALNINFOO := OLDNINFOO; 14606100 + PRTI~PRTIO; 14607000 + FIRSTX~FIRSTXO; 14608000 + SAVEL~SAVELO; 14609000 + STACKCTR~STACKCTRO; 14610000 + SAVEPRTOG := SAVEPRTOGO; 14610100 + NCII~NCIIO; FAULTOG~FAULTOGO AND(FALSE&FAULTLEVEL 7 15035000 + THEN 7 15036000 + ELSE SIZEALPHA)); EMITB(BFW,LTEMP,L); 15037000 + END PASSALPHA; 15038000 + COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 15039000 + OF SIMPLE VARIABLES: 15040000 + 1. V ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15041000 + 2. V ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15042000 + 3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15043000 + 4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15044000 + 5. V.[S:L] ,ALL V. 15045000 + 6. V ,ALL V. 15046000 + CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 15047000 + 1. VN,EXP,M*,XCH,~. 15048000 + 2. EXP,M*,VL,~. 15049000 + 3. VN,DUP,COC,EXP,T,M*,XCH,~. 15050000 + 4. VV,EXP,T,M*,VL,~. 15051000 + 5. ZEROL,VV,T . 15052000 + 6. VV . 15053000 + WHERE VN = DESC V 15054000 + EXP= ARITH, OR BOOLEAN EXPRESSION,AS REQUIRED. 15055000 + M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000 + VL = LITC V 15057000 + VV = OPDC V 15058000 + ~ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000 + T = BIT TRANSFER CODE(DIA,DIB,TRB). 15060000 + ZEROL = LITC 0 15061000 + DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000 + OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 15063000 + THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 15064000 + GLOBAL FASHION. 15065000 + THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 15066000 + WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 15067000 + SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 15068000 + ; 15069000 + PROCEDURE VARIABLE(P1); REAL P1; 15070000 + BEGIN 15071000 + REAL TALL, COMMENT ELBAT WORD FOR VARIABLE; 15072000 + T1 , COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 15073000 + T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000 + J ; COMMENT SUBSCRIPT COUNTER ; 15075000 + REAL X, Z; 15075500 + REAL REMEMBERSEQNO; % REMEMBERS SEQUENCE NUMBER OF VARIABLE 15075550 + % ON LEFT HAND SIDE OF ASSIGNMENT SO WE 15075551 + % CAN XREF IT CORRECTLY. 15075552 + LABEL EXIT; 15076000 + TALL~ELBAT[I] ; 15077000 + IF ELCLASS { INTPROCID THEN 15078000 + BEGIN 15079000 + IF TALL.LINK !PROINFO.LINK THEN 15080000 + BEGIN ERR(211); GO TO EXIT END; 15081000 +COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000 + TALL ~ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000 + END 15084000 + ELSE CHECKER(TALL); 15085000 + REMEMBERSEQNO := CARDNUMBER 15085100 + IF TALL.CLASS { INTID THEN 15086000 + BEGIN 15087000 + LABEL L1, EXIT ; 15088000 + DEFINE FORMALNAME=[9:2]=2 #; 15089000 + J ~ ELCLASS ; 15089010 + IF STEPI= ASSIGNOP THEN 15090000 + BEGIN STACKCT ~ 1; 15091000 + XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. 15091100 +L1: 15092000 + IF TALL.FORMALNAME THEN 15092020 + BEGIN 15093000 + EMITN(TALL.ADDRESS); 15094000 + IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END; 15095000 + END 15096000 + ELSE IF T1!0 THEN EMITV(TALL.ADDRESS) 15097000 + ; STACKCT ~ REAL(T1!0); STEPIT; 15098000 + IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000 + EMITD(48-T2 ,T1 ,T2); 15100000 + IF TALL<0 THEN CLSMPMN(TALL,J}BOOPROCID AND J{INTPROCID) ; 15101000 + STACKCT ~ 0; 15101500 + GT1 ~ IF TALL.CLASS =INTID THEN IF P1= FS 15102000 + THEN ISD ELSE ISN ELSE 15103000 + IF P1 = FS THEN STD ELSE SND ; 15104000 + IF TALL.FORMALNAME THEN 15105000 + BEGIN EMITO(XCH); EMITO(GT1) END 15106000 + ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000 + END 15108000 + ELSE 15109000 + BEGIN 15110000 + IF ELCLASS= PERIOD THEN 15111000 + BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000 + IF STEPI=ASSIGNOP THEN 15113000 + BEGIN 15113100 + IF P1! FS THEN 15114000 + BEGIN 15115000 + ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100 + GO TO EXIT; 15115200 + END; 15115300 + XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); 15116000 + GO TO L1; 15116100 + END; 15116200 + 15117000 + END ; 15118000 + IF P1 ! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000 +COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000 + BY A LEFT ARROW OR PERIOD *;15121000 +COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000 + LEFT-MOST OF A LEFT PART LIST *;15123000 + EMITI(TALL,T1,T2); 15124000 + 15125000 + END ; 15126000 + 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; 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; 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; 15234500 +COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000 + IF P1 > FP THEN TALL ~ ABS(TALL) ELSE 15236000 + IF TALL < 0 THEN 15237000 +COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000 + BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000 + VARIABLE; 15240000 + EMITO(MKS); 15241000 + IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000 + THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000 + TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000 + .NODIMPART)+INC; 15245000 + DO IF BOOLEAN(LWRBND~TAKE(INC~INC+1)).15246000 + OPBIT 15247000 + THEN EMITL(LWRBND,SPMONADR) 15248000 + ELSE EMITV(LWRBND,SPMONADR) 15249000 + UNTIL INC } TESTVARB 15250000 + END; 15251000 + END; 15252000 + NEXT: IF STEPI = FACTOP THEN 15253000 + BEGIN 15254000 + STLB ~ 1; 15254400 + WHILE TABLE(I+1) = COMMA DO 15254500 + BEGIN STEPIT; 15254600 + IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700 + BEGIN ERR(204); GO TO EXIT END; 15254800 + END; 15254900 + IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000 + BEGIN ERR(203);GO EXIT END; 15256000 +COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000 + ROW DESIGNATOR DOES NOT MATCH THE ARRAY * 15258000 + DECLARATION. *;15259000 + IF STEPI = RTBRKET THEN 15260000 + BEGIN ERR(204);GO EXIT END; 15261000 +COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000 + IF P1 ! FA THEN 15262500 + IF STLB > 1 THEN FLAG(212) ELSE 15262600 + IF P1!FI AND P1!FL THEN 15263000 + IF P1 = FP AND REL THEN ELSE 15263050 + BEGIN ERR(205); GO TO EXIT; END; 15263100 +COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000 + STATEMENT OR ACTUAL PARAMETER LIST. *;15265000 + IF J=0 THEN 15266000 + EMITPAIR(TALL.ADDRESS,LOD); 15267000 +COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000 + IF TALL < 0 THEN 15269000 + BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000 + EMITNUM(5&CARDNUMBER[1:4:44]); 15271000 + EMITN(GNAT(PRINTI)); 15271100 + END; 15272000 + IF P1 = FA THEN 15272900 + FOR X ~ 1 STEP 1 UNTIL STLB DO 15273000 + BEGIN IF (Z~TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100 + THEN EMITV(Z) ELSE EMIT(Z); 15273200 + IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300 + END; 15273400 + STEPIT; 15274000 + GO TO EXIT; 15275000 + END OF ROW DESIGNATOR PORTION ; 15276000 + AEXP: 15277000 +COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000 + IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000 + J ~ J + 1; 15280000 + IF(GT1 ~ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000 + BEGIN 15282000 + IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000 + ELSE EMITV(GT1.[35:11]) ; 15284000 + EMIT(GT1.[23:12]); 15285000 + END OF LOWER BOUND ADJUSTMENT ; 15286000 + IF ELCLASS = COMMA THEN 15287000 + BEGIN 15288000 +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000 + M4 (TALL,J); 15290000 + EMITO(LOD) ; 15291000 + IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100 + BEGIN ERR(208); GO TO EXIT END; 15291200 + COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300 + DECLARATION *;15291400 + GO TO NEXT; 15292000 + END OF SUBSCRIPT COMMA HANDLER ; 15293000 + IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END; 15294000 +COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000 + IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000 + BEGIN ERR(208); GO TO EXIT END; 15297000 + 15298000 + 15299000 + STACKCT ~ 0; 15299500 + IF STEPI = ASSIGNOP THEN 15300000 + BEGIN 15301000 + XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO15301100 + % SUBSCRIPTED VARIABLE. 15301200 +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000 + LAST: M4(TALL,J); 15303000 + IF T1= 0 THEN 15304000 + BEGIN IF P1= FR THEN GO TO EXIT END 15305000 + ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; 15306000 + IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000 + EMITD(48-T2,T1,T2) ; 15308000 + EMITO(XCH); 15309000 +COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000 + IF TALL < 0 15311000 + THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000 + IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000 + VALUE FROM JUNK; 15314000 + EMITO( 15315000 + IF TALL.CLASS = INTARRAYID 15316000 + THEN ISN 15317000 + ELSE SND); 15318000 + IF P1 ! FS 15319000 + THEN EMITPAIR(JUNK,SND); 15320000 + EMITL(J); EMITL(PASSTYPE(TALL)); 15321000 + EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000 + PASSALPHA(TALL); EMITPAIR(GNAT( 15323000 + CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000 + ARRAYMONFILE); 15325000 + EMITNUM((IF SPCLMON THEN 3 ELSE 2) 15326000 + &CARDNUMBER[1:4:44]); 15327000 + 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 15342000 + IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST 15342100 + BEGIN 15342200 + XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % PARTIAL15342300 + % WORD ASSIGNMENT TO SUBSCR. VAR. 15342400 + GO TO LAST; 15342500 + END 15342600 + ELSE BEGIN ERR(209); GO EXIT END; 15343000 + IF J=1 THEN EMITV(TALL.ADDRESS)ELSE EMITO(COC); 15344000 + END 15345000 + ELSE 15346000 +COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000 + BEGIN COMMENT MONITOR FUNCTION M10; 15348000 + SPCLMON~P1 = FP OR ELCLASS } AMPERSAND; 15349000 + IF J = 1 15350000 + THEN IF SPCLMON 15351000 + THEN EMITV(TALL.ADDRESS) 15352000 + ELSE EMITN(TALL.ADDRESS) 15353000 + ELSE EMITO(IF SPCLMON 15354000 + THEN COC 15355000 + ELSE CDC); 15356000 + IF TALL < 0 15357000 + THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000 + EMITNUM(5&CARDNUMBER[1:4:44]); 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 + 15370000 +COMMENT ***** MONITOR FUNCTION M9 ; 15371000 + IF TALL < 0 15372000 + THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000 + EMITNUM(5&CARDNUMBER[1:4:44]); 15374000 + EMITV(GNAT(PRINTI)); 15374100 + END ; 15375000 + EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; 15376000 + EXIT : END OF THE VARIABLE ROUTINE; 15377000 +COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000 + PROCEDURE STREAMSTMT ; 16001000 + BEGIN 16002000 + DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#, 16003000 + LOCFLD=36:36:12#,LGTFLD=24:24:12#; 16004000 + DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000 + DEFINE 16006000 + JFW = 39#, COMMENT 7.5.5.1 JUMP FORWARD UNCONDITIONAL ; 16007000 + RCA = 40#, COMMENT 7.5.7.6 RECALL CONTROL ADDRESS ; 16008000 + JRV = 47#, COMMENT 7.5.5.2 JUMP REVERSE UNCONDITIONAL ; 16009000 + CRF = 35#, COMMENT 7.5.10.6 CALL REPEAT FIELD ; 16010000 + BNS = 42#, COMMENT 7.5.5.5 BEGIN LOOP ; 16011000 + NOP = 1#, COMMENT ; 16012000 + ENS = 41#, COMMENT 7.5.5.6 END LOOP ; 16013000 + TAN = 30#, COMMENT 7.5.3.7 TEST FOR ALPHAMERIC ; 16014000 + BIT = 31#, COMMENT 7.5.3.8 TEST BIT ; 16015000 + JFC = 37#, COMMENT 7.5.5.3 JUMP FORWARD CONDITIONAL ; 16016000 + SFD = 06#, COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 16017000 + RSA = 43#, COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 16018000 + TRP = 60#, COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 16019000 + BSS = 3#, COMMENT 7.5.6.6 SKIP SOURCE BIT ; 16020000 + BSD = 2#, COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 16021000 + SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000 + JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ; 16023000 + COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 16024000 + OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 16025000 + A VALUE = 0 AND THE JUMP } 64 SYLLABLES A JFW 1 AND 16026000 + A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH 16027000 + MUST ALSO BE MANUFACTURED) IS EMITTED. ; 16028000 + PROCEDURE FIXC(S); VALUE S; REAL S; 16029000 + BEGIN 16030000 + REAL SAVL,D,F; 16031000 + SAVL~L; 16032000 +F~GET( S); 16033000 + IF D ~ L -( L~S) -1{63 THEN 16034000 + BEGIN 16035000 + IF F=BNS THEN 16036000 + BEGIN 16037000 + S~GET(L~L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D~D-2; 16038000 + END; 16039000 + EMITC(D,F); L ~ SAVL 16040000 + END 16041000 + ELSE BEGIN 16042000 + IF F!JFW THEN BEGIN 16043000 + EMITC(1,F); 16044000 + EMITC(1,JFW) END ; 16045000 + EMITC(PJ~PJ+1,RCA); 16046000 + L ~ SAVL; 16047000 + ADJUST; 16048000 + LPRT ~ PROGDESCBLDR(2,L,0); 16049000 + COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000 + PUTNBUMP(0&(STLABID|2+1) 16051000 + [2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000 + PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000 + PUTNBUMP(0); 16054000 + LASTINFO ~ NEXTINFO-3; 16055000 + END; 16056000 + END FIXC ; 16057000 + COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 16058000 + THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63 16059000 + SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 16060000 + STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 16061000 + RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000 + INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000 + POINTING TO OUR LABEL IN QUESTION. ; 16064000 + PROCEDURE EMITJUMP( E); VALUE E; REAL E; 16065000 + BEGIN 16066000 + REAL T,D; 16067000 + REAL ADDR; 16068000 + IF ABS( 16069000 + D~(T~TAKE(GIT(E)).LOC)-L-1)}64 THEN 16070000 + BEGIN 16071000 + IF ADDR~TAKE(E).ADDRESS=0 THEN 16072000 + BEGIN 16073000 + PUT(TAKE(E)&(ADDR~PJ~PJ+1)[16:37:11],E); 16074000 + LPRT ~ PROGDESCBLDR(2,T,0); 16075000 + END ; 16076000 + EMITC(ADDR,RCA); 16077000 + 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,OTHERWISE 16102000 + IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000 + RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000 + MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000 + JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 + NEST LEVEL INCREASED BY ONE. 16107000 + WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000 + THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000 + OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000 + ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000 + JUMPS. 16112000 + FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000 + AND JOINFO RESOTRED TO THEIR ORIGINAL VALUES. ; 16114000 + PROCEDURE NESTS; 16115000 + BEGIN 16116000 + LABEL EXIT; 16117000 + REAL JOINT,BNSFIX; 16118000 + IF ELCLASS!LITNO THEN 16119000 + BEGIN 16120000 + EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000 + EMIT ( BNS); EMIT(NOP);EMIT(NOP); 16122000 + END 16123000 + ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000 + IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000 + NESTLEVEL~NESTLEVEL + 1; 16126000 + JOINT ~ JOINFO; 16127000 + JOINFO ~ 0; 16128000 + DO BEGIN 16129000 + STEPIT; ERRORTOG ~ TRUE; STREAMSTMT 16130000 + END UNTIL ELCLASS ! SEMICOLON ; 16131000 + IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END; 16132000 + EMIT ( ENS); 16133000 + IF JOINFO ! 0 THEN 16134000 + BEGIN 16135000 + COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 16136000 + ADJUST; 16137000 + PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000 + JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000 + END; 16140000 + IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000 + NESTLEVEL ~ NESTLEVEL-1; 16142000 + JOINFO ~ JOINT ; 16143000 + EXIT: END NESTS ; 16144000 + COMMENT LABELS HANDLES STREAM LABELS. 16145000 + ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000 + WORD (IN THE PROGRAMSTREAM). 16147000 + IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000 + THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000 + [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000 + HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000 + MATCHES THE LEVEL OF THE LABEL. 16152000 + MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000 + FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000 + AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 16155000 +PROCEDURE LABELS; 16156000 + BEGIN 16157000 + ADJUST; 16158000 + GT1 ~ ELBAT[I]; 16159000 + XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF 16159100 + IF STEPI ! COLON THEN ERR(258) 16160000 + ELSE 16161000 + BEGIN 16162000 + IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000 + IF GT1>0 THEN 16164000 + BEGIN 16165000 + PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000 + PUT(-L,GT2) 16167000 + END 16168000 + ELSE 16169000 + BEGIN 16170000 + IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000 + PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000 + JUMPCHAIN(GT1); 16173000 + END; 16174000 + END 16175000 + ; STEPIT; 16176000 + END LABELS ; 16177000 + COMMENT IFS COMPILES IF STATEMENTS. 16178000 + FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000 + CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000 + THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000 + IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR, OTHERWISE 16182000 + THE CODE IS EMITTED STRAIGHTAWAY. 16183000 + A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000 + "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000 + SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000 + TO BE GENERATED. 16187000 + THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000 + IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000 + IF THEN GO TO L1 ELSE GO TO L2 ; 16190000 + PROCEDURE IFS; BEGIN 16191000 + DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000 + LABEL IFSB,IFTOG,IFSC,EXIT; 16193000 + SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000 + REAL ADDR,FIX1,FIX2 ; 16195000 + ADDR~1 ; 16196000 + GO TO IFSW[STEPI -SBV+1] ; 16197000 + IF ELCLASS=LOCLID THEN 16198000 + BEGIN 16199000 + EMITC(ELBAT[I].ADDRESS,CRF); 16200000 + ADDR~0; 16201000 + END 16202000 + ELSE 16203000 + IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000 + ELSE BEGIN ERR(250); GO TO EXIT END; 16205000 + IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000 +IFSC: 16207000 + IF STEPI!RELOP THEN BEGIN ERR(264);GO EXIT END; 16208000 + IF STEPI=DCV THEN EMITC(ADDR,ELBAT[I-1],COMPARECODE) 16209000 + ELSE IF ELCLASS=STRNGCON THEN 16210000 + BEGIN 16211000 + IF ACCUM[1].[12:6]!1 OR ELBAT[I-3].CLASS!IFV THEN 16211100 + BEGIN ERR(271); GO EXIT END 16211200 + ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 + END 16211400 + ELSE IF ELCLASS=LOCLID THEN 16212000 + BEGIN 16212100 + IF ELBAT[I-3].CLASS!IFV THEN 16212200 + BEGIN ERR(271); GO EXIT END 16212300 + ELSE BEGIN 16212400 + EMITC(0,ELBAT[I-1].TESTCODE); % RESET TFFF. 16212500 + EMITC(ELBAT[I].ADDRESS,CRF); 16212600 + EMITC(0,ELBAT[I-1].TESTCODE); % COMPARE. 16212700 + END 16212800 + END 16212900 + ELSE IF ACCUM[1]!"5ALPHA" THEN 16213000 + BEGIN ERR(265);GO EXIT END 16213100 + ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 + ELSE BEGIN FLAG(270); ERRORTOG:=TRUE END; 16214100 + GO IFTOG; 16215000 +IFSB: EMITC(1,BIT); 16216000 +IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000 + FIX1 ~ L; 16218000 + EMIT(JFC); 16219000 + STEPIT; 16220000 + IF ELCLASS = BEGINV OR 16221000 + ELCLASS = IFV OR 16222000 + ELCLASS = LITNO OR 16223000 + ELCLASS = STLABID OR 16224000 + ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000 + BEGIN 16226000 + EMIT (NOP); EMIT (NOP) 16227000 + END; 16228000 + IF ELCLASS= ELSEV THEN ELSE 16228500 + STREAMSTMT; 16229000 + IF ELCLASS= ELSEV THEN 16230000 + BEGIN 16231000 + FIX2 ~ L; EMIT(JFW); 16232000 + FIXC(FIX1); 16233000 + STEPIT; 16234000 + STREAMSTMT; 16235000 + FIXC(FIX2); 16236000 + END 16237000 + ELSE FIXC(FIX1); 16238000 + EXIT:END IFS ; 16239000 + COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000 + STATEMENTS. 16241000 + IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000 + AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 16243000 + ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000 + GO TOS IN THE CASE OF FORWARD JUMPS. 16245000 + 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 BEGIN ERR(260); GO TO EXIT END; 16253000 + IF(GT2~TAKE(GIT(GT1~ELBAT[I]))).MON=1 16254000 + OR GT2.LOC!0 THEN EMITJUMP(GT1) 16255000 + ELSE 16256000 + BEGIN PUT(0&L[24:36:12],GIT(GT1)); 16257000 + IF GT1>0 THEN 16258000 + BEGIN 16259000 + PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEVEL)[11:43:5]),GT1);16260000 + EMITN(1023); 16261000 + END 16262000 + ELSE 16263000 + BEGIN 16264000 + IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257); 16265000 + EMIT(GT2,LASTGT); 16266000 + END; 16267000 + END; 16268000 + JUMPLEVEL~0 ; 16269000 + EXIT: END GOTOS ; 16270000 + COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000 + THE CODE GENERATED IS : 16272000 + SED FILE 16273000 + RSA 0. 16274000 + AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000 + INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000 + BY THE DESTINATION ADDRESS. 16277000 + THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000 + THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 16279000 + MUST BE PASSED FOR THIS FORMAL PARAMETER; 16280000 +PROCEDURE RELEASES; 16281000 + IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000 + (GT1~ELBAT[I-1]).FORMAL=0 16283000 + THEN ERR(256) ELSE 16284000 + BEGIN 16285000 + EMITC( GT1.ADDRESS,SED); 16286000 + EMIT(FILETHING); FILETHING~L-1; 16287000 + INFO[GT1.LINKR,GT1.LINKC].MON ~ 1; 16288000 + END RELEASES; 16289000 + COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 16290000 + OR LOCALIDS . 16291000 + THREE CASES PRESENT THEMSELVES, 16292000 + LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 16293000 + CASE I LOCLID ~ X 16294000 + CASE II X ~ X ... 16295000 + CASE III X ~ EITHER LOC,LOCLID,SC OR DC. 16296000 + THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 16297000 + CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS16298000 + THE CODE TO BE EMITTED. 16299000 + EACH ELEMENT OF MACRO HAS 1-3 SYLLABES ORDERED FROM 16300000 + RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000 + MAY REQUIRE AT MOST ONE REPEAT PART. 16302000 + IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000 + PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE' IS 16304000 + ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000 + ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000 + USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000 + THE PROPER ADDRESS AND OPERATOR . 16308000 + NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000 + ERROR. ; 16310000 +PROCEDURE INDEXS; 16311000 + BEGIN 16312000 + LABEL EXIT,GENERATE,L,L1; 16313000 + INTEGER TCLASS,INDEX,ADDR,J; 16314000 + TCLASS ~ ELCLASS ; 16315000 + IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000 + IF TCLASS = LOCLID THEN 16317000 + BEGIN 16318000 + XMARK(ASSIGNREF); 16318500 + IF SIV>STEPI OR ELCASS>TALLYV THEN GO TO L; 16319000 + INDEX ~ 32 + ELCLASS-SIV; 16320000 + ADDR ~ ELBAT[I-2].ADDRESS; 16321000 + GO TO GENERATE; 16322000 + END; 16323000 + IF TCLASS = STEPI THEN 16324000 + BEGIN 16325000 + IF STEPI!ADDOP THEN BEGIN ERR(252); GO EXIT END ELSE 16326000 + IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100 + BEGIN ERR(253); GO EXIT END; 16327000 + INDEX ~ TCLASS-SIV 16328000 + +REAL(ELBAT[I-1].ADDRESS=SUB) | 4 16329000 + + REAL(ELCLASS =LOCLID) | 8; 16330000 + END 16331000 + ELSE 16332000 + BEGIN 16333000 + INDEX ~ TCLASS -SIV 16334000 + + ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000 + IF ELCLASS = LOCV THEN 20 ELSE 16336000 + IF ELCLASS = SCV THEN 24 ELSE 16337000 + IF ELCLASS= DCV THEN 28 ELSE 25); 16338000 + IF ELCLASS = LOCV THEN 16339000 + IF STEPI ! LOCLID THEN GO TO L; 16340000 + IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000 + BEGIN EMITC(ELBAT[I].ADDRESS,SEC); GO TO EXIT END; 16342000 + END ; 16343000 + ADDR ~ ELBAT[I].ADDRESS; 16344000 + GENERATE: 16345000 + IF MACRO[INDEX]= 0 THEN 16346000 + L: BEGIN ERR(250); GO TO EXIT END; 16347000 + J ~ 8; TCLASS ~0 ; 16348000 + L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 ); 16349000 + IF TCLASS!0 THEN 16350000 + BEGIN 16351000 + EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000 + GO TO L1 16353000 + END; 16354000 + EXIT:END INDEXS ; 16355000 + COMMENT DSS COMPILES DESINTATION STREAM STATEMENTS. 16356000 + DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000 + STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000 + NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000 + ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000 + THE OPCODE FIELD ; 16361000 +PROCEDURE DSS; 16362000 + BEGIN 16363000 + INTEGER ADDR,J,K,L,T; 16364000 + LABEL EXIT,L1; 16365000 + DEFINE OPCODE=[27: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 16379000 + EMITC(ADDR,ELBAT[I].OPCODE) 16379500 + ELSE 16380000 + IF ELCLASS = LITV THEN 16381000 + BEGIN 16382000 + EMITC(ADDR,TRP); 16383000 + IF STEPI!STRING AND ELCLASS!STRNGCON AND 16384000 + ELCLASS ! LITNO AND ELCLASS ! NONLITNO THEN 16384100 + BEGIN ERR(255); GO TO EXIT END; 16384500 + IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN 16384700 + MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800 + C,8-COUNT,ACCUM[1],3); 16384900 + IF ADDR MOD 2 ! 0 THEN 16385000 + BEGIN 16386000 + EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000 + END ; 16388000 + FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000 + BEGIN 16390000 + FOR L ~6,7 DO 16391000 + MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000 + ELSE J),T,L ); 16393000 + EMIT(T); 16394000 + END END 16395000 + ELSE 16396000 + L1: ERR(250); 16397000 + EXIT:END DSS ; 16398000 + COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000 + IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000 + A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000 + OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000 +PROCEDURE SKIPS ; 16403000 + BEGIN 16404000 + REAL ADDR; 16405000 + IF STEPI = LOCLID THEN 16406000 + BEGIN 16407000 + EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000 + END 16409000 + ELSE IF ELCLASS = LITNO THEN 16410000 + BEGIN 16411000 + ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000 + END 16413000 + ELSE ADDR ~ 1 ; 16414000 + IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000 + ELSE 16416000 + IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000 + ELSE ERR(250); 16418000 + END SKIPS ; 16419000 + COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000 + JUMP OUT TO STATEMENTS CAUSE JUMP 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 = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 + = LFTPAREN THEN GO TO L1; 16480000 + IF ELCLASS= STLABID THEN GO TO L2 ; 16481000 + IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000 + L: ERR( 250 ); GO TO FINI ; 16483000 + L1: NESTS; GO TO EXIT; 16484000 + L2: LABELS; GO TO START; 16485000 + L3: IFS; GO TO FINI; 16486000 + L4: GOTOS; GO TO EXIT; 16487000 + L5: RELEASES; GO TO EXIT; 16488000 + L6: I~I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000 + L7: INDEXS; GO TO EXIT; 16490000 + L8: DSS; GO TO EXIT; 16491000 + L9: SKIPS; GO TO EXIT; 16492000 + L10: JUMPS; GO TO EXIT; 16493000 + EXIT: STEPIT; 16494000 + FINI: END STREAMSTMT; 16495000 + 16496000 + TIME1 ~ TIME(1); PROGRAM; 17000000 + ENDOFITALL: 17000100 +IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN 17001000 + BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ={#; 17002000 + DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], 17002005 + ((INDEX).CF DIV 2).LINKC]#, 17002006 + CF = [33:15]#, 17002007 + FF = [18:15]#, 17002008 + NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF 17002009 + ELSE XREFINFO[INDEX].CF)#; 17002010 + ARRAY TIMINGS[0:2,0:3]; 17002012 + PROCEDURE SAVETIMES(I); 17002015 + VALUE I; INTEGER I; 17002020 + BEGIN 17002025 + INTEGER J; 17002030 + FOR J := 1 STEP 1 UNTIL 3 DO 17002035 + TIMINGS[I,J] := TIME(J); 17002040 + END; 17002045 + PROCEDURE UPDATETIMES(I); 17002050 + VALUE I; INTEGER I; 17002055 + BEGIN 17002060 + INTEGER J; 17002065 + FOR J := 1 STEP 1 UNTIL 3 DO 17002070 + TIMINGS[I,J] := TIME(J) - TIMINGS[I,J]; 17002075 + END; 17002080 + WRITE(LINE[PAGE]); 17002520 + SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. 17002525 + LASTADDRESS~0; 17002530 + FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000 + WRITE(DSK2,30,XREFAY2[*]); 17004000 + TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. 17004500 + XREFPT~XLUN~0; 17004600 + FOR I:= 0 STEP 1 UNTIL 8191 DO 17004700 + XREFINFO[I] := 0; 17004710 + BEGIN 17005000 + BOOLEAN PROCEDURE INPUT1(A); 17006000 + ARRAY A[0]; 17007000 + BEGIN 17008000 + LABEL L,EOF; 17009000 + READ(DSK1,10,A[*])[EOF]; 17010000 + GO TO L; 17011000 + EOF: INPUT1:=TRUE; 17012000 + REWIND(DSK1); 17013000 + L: 17014000 + END; 17015000 + PROCEDURE OUTPUT1(B,A); 17016000 + VALUE B; 17017000 + BOOLEAN B; 17018000 + ARRAY A[0]; 17019000 + BEGIN 17020000 + IF B THEN 17021000 + BEGIN 17022000 + REWIND(DSK1); 17022100 + UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 17022200 + TIMINGS[0,0] := XLUN; % NUMBER OF IDENTIFIERS SORTED. 17022300 + END 17022400 + ELSE 17023000 + BEGIN 17024000 + IF BOOLEAN(A[8]) THEN 17025000 + XREFINFO[A[8]].FF := XLUN := XLUN + 1 17025100 + ELSE 17025200 + XREFINFO[A[8]].CF := XLUN := XLUN + 1; 17025300 + A[8].IDNOF := XLUN; 17025400 + WRITE(DSK1,10,A[*]); 17026000 + END; 17027000 + END; 17028000 + BOOLEAN STREAM PROCEDURE COMPS1(A,B); 17029000 + BEGIN 17030000 + SI:=A; 17031000 + DI:=B; 17032000 + IF 63 SC < DC THEN 17033000 + TALLY := 1 17033100 + ELSE 17033200 + BEGIN 17033300 + SI := A; 17033400 + DI := B; 17033500 + IF 63 SC = DC THEN 17033600 + TALLY := 2; 17033700 + END; 17033800 + COMPS1:=TALLY; 17034000 + END; 17035000 + STREAM PROCEDURE HVS1(A); 17036000 + BEGIN 17037000 + DI:=A; 17038000 + DS:=8 LIT "9"; 17039000 + SI:=A; 17040000 + DS:= 7 WDS; 17041000 + DS := 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS 17041100 + END; 17042000 + BOOLEAN PROCEDURE COMP1(A,B); 17042100 + ARRAY A,B[0]; 17042200 + IF REAL(COMP1:=COMPS1(A,B)) = 2 THEN % IDS EQUAL 17042300 + COMP1 := A[8].IDNOF < B[8].IDNOF; 17042350 + PROCEDURE HV1(A); 17042400 + ARRAY A[0]; 17042500 + HVS1(A); 17042600 + XLUN:=0; 17043000 + REWIND(DSK1); 17044000 + SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN 17045000 + 7000 ELSE 10000); 17045100 + END; 17046000 + BEGIN 17047000 + ARRAY IDTYPE[0:(IDMAX+4)|4-1]; 17047100 + STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, 17047200 + FWDSEQNO,TYPE,OWNTOG,PARAMTOG, 17047300 + VALTOG); 17047350 + VALUE SEQG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, 17047400 + VALTOG; 17047450 + BEGIN 17047500 + SI := S; 17047700 + DI := D; 17047800 + 63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); 17047900 + DS := 6 LIT " -- "; 17048000 + OWNTOG (DS := 4 LIT "OWN "); 17048100 + SI := TYPE; 17049300 + 32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); 17049400 + PARAMTOG (DS := 6 LIT " -- "; 17049410 + DS := 4 LIT "NAME"; 17049420 + VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); 17049430 + DS := 10 LIT " PARAMETER"); 17049440 + DS := 26 LIT " -- DECLARED IN SEGMENT "; 17049500 + SI := LOC SEG; 17049600 + S := DI; 17049700 + DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800 + DI := DI + 8; % TO FORCE STORE OF LAST WORD 17049900 + SI := S; 17050000 + DI := S; 17050100 + 4(IF SC ! " " THEN DS:= CHR ELSE SI := SI + 1); 17050200 + DS := 4 LIT " AT "; 17050300 + SI := LOC SEQNO; 17050400 + DS := 8 DEC; 17050500 + FWDTOG (DS := 17 LIT " -- FORWARD AT "; 17050600 + SI := LOC FWDSEQNO; 17050700 + DS := 8 DEC); 17050800 + LBLTOG (DS := 16 LIT " -- OCCURS AT "; 17050900 + SI := LOC FWDSEQNO; 17051000 + DS := 8 DEC); 17051100 + END OF SETUPHEADING; 17051200 + 17051300 + STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); 17051400 + VALUE SEQNO,N,STARS; 17051500 + BEGIN 17051600 + DI := D; 17051700 + DI := DI + 8; 17051800 + N (DI := DI + 10); 17051900 + STARS(DO := DI - 1; DS := LIT "*"); 17052000 + SI := LOC SEQNO; 17052100 + DS := 8 DEC; 17052200 + DS := LIT " "; 17052300 + STARS (DI := DS - 1; DS := LIT "*"); 17052400 + END; 17052500 + STREAM PROCEDURE BLANKET(D); 17052600 + BEGIN 17052700 + DI := D; 17052800 + DS := 8 LIT " "; 17052900 + SI := D; 17053000 + DS := 16 WDS; 17053100 + END OF BLANKET; 17053200 + PROCEDURE PRINTXREFSTATISTICS; 17053300 + BEGIN 17053400 +$RESET NEATUP 17053450120324PK + SWITCH FORMAT STATS := 17053500 + (///, "CROSS REFERENCE STATISTICS", /, 17053600 + "----- --------- ----------", /), 17053700 + ("PHASE ONE - SORT",I6," IDENTIFIERS"), 17053800 + ("PHASE TWO - SORT",I7," REFERENCES"), 17053900 + ("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), 17054000 + (X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), 17054100 + (X5,I4,":",2I1," PROCESSOR TIME"), 17054200 + (X5,I4,":",2I1," I/O TIME",/); 17054300 +$SET NEATUP 17054350120324PK + INTEGER I,J,K; 17054400 + WRITE(LINE,STATS[0]); 17054500 + FOR I := 0 STEP 1 UNTIL 2 DO 17054600 + BEGIN 17054700 + WRITE(LINE,STATS[I+1],TIMINGS[I,0]); 17054800 + FOR J := 1 STEP 1 UNTIL 3 DO 17054900 + BEGIN 17055000 + K := (TIMINGS[I,J] + 30) DIV 60; % ROUND TO NEAREST SECON17055010 + WRITE(LINE,STATS[J+3],K DIV 60,(K:=K MOD 60) DIV 10, 17055020 + K MOD 10); 17055025 + END; 17055030 + END; 17055100 + END PRINTXREFSTATISTICS; 17055200 + DEFINE REFCOUNT = TIMINGS[1,0]#; % NUMBER OF REFERENCES SORTED.17069300 + BOOLEAN FIRSTTIME; % TRUE ON FIRST CALL OF OUTPUT PROCEDURE. 17069400 + ARRAY PAY[0:17]; 17069500 + REAL LASTADDRESS; 17069600 + BOOLEAN PROCEDURE INPUT2(A); 17070000 + ARRAY A[0]; 17071000 + BEGIN 17072000 + LABEL L,EOF; 17073000 + DEFINE I = LASTADDRESS#; 17073100 + IF XREFPT:=XREFPT+1=30 THEN 17074000 + BEGIN 17075000 + READ(DSK2,30,XREFAY2[*])[EOF]; 17076000 + XREFPT:=0; 17077000 + END; 17078000 + IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF;17079000 + A[0] := I & NEWID[I.REFIDNOF] REFIDNOF; 17080000 + REFCOUNT := REFCOUNT + 1; 17080100 + GO TO L; 17081000 + EOF: INPUT2:=TRUE; 17082000 + BLANKET(PAY); 17083000 + XREFAY1[8] := XREFPT := LASTADDRESS := 0; 17084000 + FILL IDTYPE[*] WITH 17084010 + "UNKNOWN. ", % 0 17084020 + "STREAM LABEL. ", % 1 17084030 + "STREAM VARIABLE. ", % 2 17084040 + "DEFINE. ", % 3 17084050 + "LIST. ", % 4 17084060 + "FORMAT. ", % 5 17084070 + "SWITCH FORMAT. ", % 6 17084080 + "FILE. ", % 7 17084090 + "SWITCH FILE. ", % 8 17084100 + "SWITCH LABEL. ", % 9 17084110 + "PROCEDURE. ", % 10 17084120 + "INTRINSIC. ", % 11 17084130 + "STREAM PROCEDURE. ", % 12 17084140 + "BOOLEAN STREAM PROCEDURE. ", % 13 17084150 + "REAL STREAM PROCEDURE. ", % 14 17084160 + "ALPHA STREAM PROCEDURE. ", % 15 17084170 + "INTEGER STREAM PROCEDURE. ", % 16 17084180 + "BOOLEAN PROCEDURE. ", % 17 17084182 + "REAL PROCEDURE. ", % 18 17084184 + "ALPHA PROCEDURE. ", % 19 17084186 + "INTEGER PROCEDURE. ", % 20 17084188 + "BOOLEAN. ", % 21 17084190 + "REAL. ", % 22 17084200 + "ALPHA. ", % 23 17084210 + "INTEGER. ", % 24 17084220 + "BOOLEAN ARRAY. ", % 25 17084230 + "REAL ARRAY. ", % 26 17084240 + "ALPHA ARRAY. ", % 27 17084250 + "INTEGER ARRAY. ", % 28 17084260 + "LABEL. ", % 29 17084270 + "FIELD. ", % 30 (CLASS = 125) 17084275 + "FAULT. ", % 32 (CLASS = 126) 17084280 + "SWITCH LIST. "; % 31 (CLASS = 127) 17084290 + L: 17085000 + END; 17086000 + PROCEDURE OUTPUT2(B,A); 17087000 + VALUE B; 17088000 + BOOLEAN B; 17089000 + ARRAY A[0]; 17090000 + BEGIN DEFINE PRINTER=LINE#; 17091000 + LABEL EOF2, SKIP; 17091100 + OWN BOOLEAN B2, FWDTOG, LBLTOG, WAITINGFORFWDREF; 17091110 + DEFINE MATCH(A,B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = 17091115 + REAL(NOT FALSE)#; 17091116 + REAL I; 17091120 + DEFINE LINECOUNT = TIMINGS[2,0]#; % NUMBER OF LINES PRINTED. 17091140 + OWN REAL FWDSEQNO; 17091150 + IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. 17091155 + BEGIN 17091160 + FIRSTTIME := FALSE; 17091162 + TIME1 := TIME(1); 17091165 + DATIME; 17091170 + UPDATETIMES(1); 17091175 + SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. 17091180 + END; 17091200 + IF NOT B2 THEN 17091210 + IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. 17091300 + IF XREFPT ! 0 THEN % WE GOT SOME TO LIST OUT 17091400 + BEGIN 17091500 + WRITE(LINE[DBL],15,PAY[*]); 17091510 + LINECOUNT := LINECOUNT + 1; 17091520 + END 17091530 + ELSE % NOTHING TO LIST OUT 17091600 + ELSE % NOT END OF SORT 17091700 + IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF ! 0 AND 17091800 + A[0].REFIDNOF } XREFAY1[8].IDNOF THEN 17091900 + IF A[0].TYPEREF = FORWARDREF THEN % 17092000 + WAITINGFORFWDREF := TRUE 17092100 + ELSE 17092200 + IF A[0].TYPEREF = LBLREF THEN % 17092300 + BEGIN 17092400 + LBLTOG := TRUE; 17092500 + FWDSEQNO := A[0].SEQNOF; 17092600 + END 17092700 + ELSE 17092800 + IF A[0].TYPEREF = DECLREF THEN 17092900 + IF WAITINGFORFWDREF THEN % THIS MUST BE IT 17093000 + BEGIN 17093100 + WAITINGFORFWDREF := FALSE; 17093200 + FWDTOG := TRUE; 17093300 + FWDSEQNO := A[0].SEQNOF; 17093400 + END 17093500 + ELSE % ITS A NORMAL DECLARATION - NOT FORWARD 17093600 + BEGIN 17093700 + IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN 17093850 + DO 17093900 + READ(DSK1,10,XREFAY1[*]) [EOF2] 17093950 + UNTIL 17094000 + A[0].REFIDNOF { XREFAY1[8].IDNOF; 17094050 + IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN 17094100 + GO TO SKIP; 17094150 + IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200 + BEGIN 17094240 + IF SINGLTOG THEN 17094250 + WRITE(LINE,15,PAY[*]) 17094300 + ELSE 17094350 + WRITE(LINE[DBL],15,PAY[*]); 17094400 + LINECOUNT := LINECOUNT + 1; 17094410 + END 17094420 + ELSE 17094450 + IF NOT SINGLTOG THEN 17094500 + WRITE(LINE); 17094550 + XREFPT := 0; 17094600 + BLANKET(PAY[*]); 17094650 + SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8]. 17094700 + SEGNOF,A[0].SEQNOF,FWDTOG,LBLTOG, 17094800 + FWDSEQNO.IDTYPE[(IF (I := 17094900 + XREFAY1[9].CLASS) } FIELDID THEN 17095000 + (IDMAX + I - FIELDID + 1) ELSE 17095100 + IF I > IDMAX THEN 0 ELSE I) | 4], 17095200 + REAL(I } BOOID AND XREFAY1[9].[9:2] = 1), 17095300 + REAL((I } BOOID OR I = LOCLID) AND BOOLEAN 17095310 + (XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 17095320 + FWDTOG := LBLTOG := FALSE; 17095400 + WRITE(LINE,15,PAY[*]); 17095500 + LINECOUNT := LINECOUNT + 1; 17095510 + BLANKET(PAY[*]); 17095550 + END 17095600 + ELSE % IT MUST BE A NORMAL REFERENCE 17095700 + IF A[0].SEQNOF ! LASTADDRESS.SEQNOF THEN 17095750 + BEGIN 17095800 + ADDASEQNO(A[0].SEQNOF,XREFPT,A[0].[5:1], 17095900 + PAY[*]); 17096000 + IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100 + BEGIN 17096200 + WRITE(LINE,15,PAY[*]); 17096300 + LINECOUNT := LINECOUNT + 1; 17096350 + XREFPT := 0; 17096400 + BLANKET(PAY[*]); 17096450 + END 17096500 + END 17096550 + ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT 17096575 + ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 17096600 + ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 17096700 + EOF2: B2 := TRUE; % SO SORT CAN GO TO NORMAL EOJ 17096800 + IF NOT B THEN SKIP: LASTADDRESS := A[0]; 17096850 + END OF OUTPUT2; 17096900 + PROCEDURE HV2(A); 17112000 + ARRAY A[0]; 17113000 + A[0] := 3"777777777777777"; % BIGGEST FLOATING PT. NO. 17114000 + BOOLEAN PROCEDURE COMP2(A,B); 17115000 + ARRAY A,B[0]; 17116000 + COMP2 := IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 17117000 + TRUE 17117100 + ELSE 17117200 + IF A[0].REFIDNOF = B[0].REFIDNOF THEN 17117300 + IF A[0].[1:4] LSS B[0].[1:4] THEN 17117400 + TRUE 17117500 + ELSE 17117600 + IF A[0].[1:4] = B[0].[1:4] THEN 17117700 + IF A[0].SEQNOF < B[0].SEQNOF THEN 17117702 + TRUE 17117704 + ELSE 17117706 + IF A[0].SEQNOF = B[0].SEQNOF THEN 17117708 + BOOLEAN(A[0].[5:1]) 17117710 + ELSE 17117712 + FALSE 17117714 + ELSE 17117720 + FALSE 17117730 + ELSE 17117800 + FALSE; 17117900 + SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT 17117910 + FIRSTTIME := TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 17117920 + XREFPT:=29; REWIND(DSK2); 17118000 + SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,6000); 17119000 + UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE 17119100 + PRINTXREFSTATISTICS; 17119200 + END; 17120000 + END; 17121000 + END OF MAIN BLOCK; 17121500 + END. 17122000