github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-17 08:32:07 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/SYMBOL/ALGOL.alg_m

12709 lines
1.1 MiB
Raw Blame History

$SET OMIT LISTA = LIST %121-00000999
%#######################################################################00001000
% 00001010
% B-5700 ALGOL/TSPOL SYMBOLIC 00001020
% MARK XVI.0.122 %123-00001030
% MAY 9, 1977 %123-00001040
% 00001050
%#######################################################################00001060
% 00001070
COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00001072
* FILE ID: SYMBOL/ALGOL TAPE ID: SYMBOL1/FILE000 * 00001073
* THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00001074
* AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00001075
* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00001076
* WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00001077
* BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00001078
* * 00001079
* COPYRIGHT (C) 1965, 1971, 1972, 1974 * 00001080
* BURROUGHS CORPORATION * 00001081
* AA759915 AA320206 AA393180 AA332366 *; 00001082
COMMENT#################################################################00001110
ERROR MESSAGES 00001120
########################################################################00001130
% 00001140
ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000
001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000
002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000
IDENTIFIER NOT APPEARING IN 00006000
FORMAL PARAMETER PART. 00007000
003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000
LIST OF DECLARATION. 00009000
004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000
PRECEDED BY ILLEGAL DECLARATOR. 00011000
005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000
BY ILLEGAL DECLARATOR. 00013000
006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000
IN SAME BLOCK(NOT FORWARD). 00015000
007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000
BY ( OR SEMICOLON IN PROCEDURE 00017000
DECLARATION. 00018000
008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000
BY ). 00020000
009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000
BY SEMICOLON. 00022000
010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000
WHICH DID NOT APPEAR IN FORMAL 00024000
PARAPART. 00025000
011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000
012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000
PART. 00028000
013 PROCEDUREDEC: OWN, SAVE, OR AUXMEM USED IN 00029000
ARRAY SPECIFICATION. 00029500
014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00030000
015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00030500
00031000
016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00032000
BY [ . 00033000
017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00034000
FOLLOWED BY : . 00035000
018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00036000
019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00037000
ARRAY SPECIFICATION. 00038000
020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00039000
IDENTIFIER(NO TYPE). 00040000
021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00041000
IDENTIFIER(NO TYPE). 00042000
022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00043000
IDENTIFIER(THE WORD PROCEDURE LEFT 00044000
OUT). 00045000
023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00046000
ANOTHER DECLARATOR. 00047000
024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00048000
025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00049000
PRECEDED BY OWN OR SAVE OR SOME 00050000
OTHER DECLARATOR. 00051000
026 FILEDEC: MISSING ( IN FILE DEC. 00052000
027 FILEDEC: MISSING RECORD SIZE. 00053000
00054000
028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000
IN FILE DEC. 00056000
029 FILEDEC: MISSING ) IN FILE DEC. 00057000
030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00058000
00059000
031 LISTDEC: MISSING ( IN LISTDEC. 00060000
032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000
033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00062000
FORWARD AFTER IDENTIFIER. 00063000
034 SWITCHFILEDEC:MISSING ~ AFTER FILED. 00064000
035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00065000
OF SWITCHFILE. 00066000
036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~ . 00067000
037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00068000
038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00069000
039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100
040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200
041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300
042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400
043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500
044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600
045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00069700
046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800
047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900
048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910
049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920
050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930
051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931
ACTUAL DECLARATION 00069932
052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933
IDENTIFIER. 00069934
059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938
060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940
061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950
INTOVR, OR INDEX. 00069960
070 CASESTMT: MISSING BEGIN. 00069970
071 CASESTMT: MISSING END. 00069980
080 PRIMARY: MISSING COMMA . 00069990
090 PARSE: MISSING LEFT BRACKET 00069991
091 PARSE: MISSING COLON 00069992
092 PARSE: ILLEGAL BIT NUMBER 00069993
093 PARSE: FIELD SIZE MUST BE LITERAL 00069994
094 PARSE: MISSING RIGHT BRACKET 00069995
095 PARSE: ILLEGAL FIELD SIZE 00069996
100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000
101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000
IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000
TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000
AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000
102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000
103 PRIMARY: PRIMARY MAY NOT BEGIN WITH A QUANTITY OF THIS 00076000
TYPE. 00077000
104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000
105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000
106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000
107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000
108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000
AS THE ARITHMETIC EXPRESSIONS. 00083000
109 BOOSEC,SIMBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000
110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000
EXPRESSION. 00086000
111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000
TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000
112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000
TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000
113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000
A CONCATENATE OPERATOR IS INCORRECT. 00092000
114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS00093000
FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000
115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE. 00095000
116 IFCLAUSE: MISSING THEN. 00096000
117 BANA: MISSING LEFT BRAKET. 00097000
118 BANA: MISSING RIGHT BRAKET. 00098000
119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000
120 COMPOUNDTAIL: MISSING END. 00100000
121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000
ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000
PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000
METER. 00104000
122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000
EXPRESSION PASSED TO IT BY NAME. 00106000
123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000
AGREE AS TO TYPE. 00108000
124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000
NUMBER OF DIMENSIONS. 00110000
125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000
PARAMETER TO A PROCEDURE. 00112000
126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000
QUANTITY OF THIS TYPE. 00114000
127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000
STREAM PROCEDURE. 00116000
128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000
NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000
129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000
130 RELSESTMT: NO FILE NAME. 00120000
131 DOSTMT: MISSING UNTIL. 00121000
132 WHILESTMT: MISSING DO. 00122000
133 LABELR: MISSING C OLON. 00123000
134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000
135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000
136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000
137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000
INTEGER WHERE AN INTEGER IS REQUIRED. 00128000
138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000
PHRASE. 00130000
139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000
140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000
141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000
CHARACTORS. 00134000
142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000
(BLANK SUPPRESSED). 00136000
143 COMPOUNDTAIL: EXTRA END. 00137000
144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000
145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000
146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000
A MISSING END OF A PROCEDURE OR A MISPLACED 00141000
DECLARATION. 00142000
147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000
DECLARATION. 00144000
148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000
ARE REQUIRED FOR THIS PROGRAM. 00146000
149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000
PROCEDURE. 00148000
150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000
STREAM PROCEDURES. 00150000
151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000
152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000
153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000
154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000
155 IFEXP: MISSING ELSE 00155000
156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST00156000
ELEMENT. 00157000
157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LIST ELEMENT. 00158000
158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000
159 PROCSTMT: ILLEGAL USE OF PROCEDURE OR FUNCTION IDENTIFIER00160000
160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000
161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000
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
NEST LEVEL AS A PRECEDING APPEARANCE OF THE 00190000
LABEL. 00191000
258 LABELS: MISSING :. 00192000
259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000
260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000
261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000
262 NESTS: MISSING PARENTHESIS. 00196000
263 IFS:MISSING SC IN IF STATEMENT. 00197000
264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000
265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000
266 IFS: MISSING THEN INIF STATEMENT. 00200000
267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000
UNDEFINED. 00202000
268 EMITC: A REPEAT INDEX }64 WAS SPECIFIED OR TOO MANY 00203000
FORMAL PARAMETERS,LOCALS AND LABELS. 00204000
269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000
OR TOO SMALL. 00206000
270 IFS: RELATIONAL IN SC<RELATIONAL>ALPHA MUST BE "EQUAL". 00206100
271 IFS: IMPROPER CONSTRUCT FOR <SOURCE WITH LITERAL>. 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 IDENTIFIER. 00213000
301 FILLSTMT: MISSING "WITH" IN FILL STATEMENT. 00214000
302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000
303 FILLSTMT: NON-OCTAL CHARACTER IN OCTAL FILL. 00216000
304 FILLSTMT: IMPROPER ARRAY ROW DESIGNATOR IN FILL. 00217000
305 FILLSTMT: DATA IN FILL EXCEEDS 1023 WORDS. 00218000
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. %107-00412000
613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. %107-00413000
614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. %107-00414000
615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. %107-00415000
616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD %107-00416000
617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00417000
618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00418000
; 00490000
$POP OMIT LISTA %121-00499999
BEGIN COMMENT OUTERMOST BLOCK; 00500000
INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000
SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000
INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000
IF COMPILE & GO =0, FOR SYNTAX, =-1. MUST BE AT R+26;00504000
INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00504100
INTEGER CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00504150
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#, %106-01001172
USEROPINX = 30#; %106-01001173
COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01001180
AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190
FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200
DEFINE CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01001210
DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01001220
DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01001230
FORMATOG = OPTIONWORD.[FORMATBIT:1] #, 01001240
INTOG = OPTIONWORD.[INTBIT:1] #, 01001250
LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01001260
LISTOG = OPTIONWORD.[LISTBIT:1] #, 01001270
LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01001280
MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01001290
MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01001300
NESTOG = OPTIONWORD.[NESTBIT:1] #, 01001310
NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01001320
NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01001330
OMITTING = OPTIONWORD.[OMITBIT:1] #, 01001340
PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #, 01001350
PRTOG = OPTIONWORD.[PRTBIT:1] #, 01001360
PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01001370
PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01001380
SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01001390
SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01001400
COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01001410
SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01001420
SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01001430
STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01001440
VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01001450
VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01001460
XREF = OPTIONWORD.[XREFBIT:1] #, 01001461
BEND = OPTIONWORD.[BENDBIT:1] #, 01001462
CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, %106-01001463
DUMMY = #; 01001470
BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01001480
BOOLEAN NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01001490
BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01001500
% LAST CARD FROM SYMBOLIC LIBRARY READ 01001510
% IS PATCHED FROM THE CARD READER. 01001520
INTEGER XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01001530
BOOLEAN DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01001540
INTEGER ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01001550
BOOLEAN SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01001560
BOOLEAN LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01001570
ALPHA MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01001580
INTEGER MYCLASS; % USED IN DOLLARCARD EVALUATION. 01001590
REAL BATMAN; % USED IN DOLLARCARD EVALUATION. 01001600
ARRAY SPECIAL[0:31]; 01003000
COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000
CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000
SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000
ARRAY INFO[0:31,0:255]; 01007000
%***********************************************************************01007005
% X R E F S T U F F %116-01007010
%***********************************************************************01007015
% %116-01007020
ARRAY %116-01007025
XREFAY2[0:29], % ARRAY OF ONE WORD REFERENCE RECORDS. %116-01007030
% THE LAYOUT OF EACH WORD IS %116-01007035
% %116-01007040
% .[1:5] TYPE OF REFERENCE %116-01007045
% = 0 FOR FORWARD DECL %116-01007050
% = 1 FOR LABEL OCCURENCE %116-01007051
% = 2 FOR NORMAL DECL %116-01007055
% = 4 FOR NORMAL REFERENCE %116-01007060
% = 5 FOR ASSIGNMENT %116-01007065
% %116-01007070
% NOTE: THE LOWER ORDER BIT 01007075
% OF THIS FIELD IS ON 01007080
% IF YOU WANT STARS %116-01007085
% AROUND THIS REFERENCE 01007090
% IN THE XREF %116-01007095
% %116-01007100
% .[6:15] IDENTIFIER ID. NO. %116-01007105
% THIS IS A UNIQUE NUMBER THAT 01007110
% IS ASSIGNED WHEN THE %116-01007115
% IDENTIFIER IS ENCOUNTERE %116-01007120
% FOR THE FIRST TIME. %116-01007125
% %116-01007130
% .[21:27] SEQUENCE NUMBER %116-01007135
% %116-01007140
XREFAY1[0:9], % RECORD BUFFER AREA FOR WRITING OUT THE %116-01007145
% NAME INFORMATION RECORDS, ONE RECORD %116-01007150
% IS WRITTEN FOR EACH IDENTIFIER IN THE SYMBOL 01007155
% TABLE WHEN THE IDENTIFIER IS PURGED FROM THE 01007160
% SYMBOL TABLE, I.E., WHEN LEAVING THE BLOCK%116-01007165
% IN WHICH THE IDENTIFIER IS DECLARED. %116-01007170
% %116-01007175
% THE LAYOUT OF EACH IS: %116-01007180
% %116-01007185
% WORDS 0-7 THE IDENTIFIER WITH BLANK%116-01007190
% FILE ON THE RIGHT %116-01007195
% %116-01007200
% WORD 8 %116-01007205
% .[21:12] SEGMENT NUMBER IN WHICH %116-01007210
% THIS IDENTIFIER WAS DECLARED01007215
% %116-01007220
% .[33:15] IDENTIFIER ID. NO. %116-01007225
% %116-01007230
% WORD 9 ELBAT WORD %116-01007235
% %116-01007240
XINFO[0:31,0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 01007245
% IN THE INFO TABLE. IF YOU HAVE THE INDEX %116-01007250
% OF THE ELBAT WORD FOR AN IDENTIFIER IN %116-01007255
% THE INFO TABLE YOU CAN FIND THE XINFO WORD%116-01007260
% FOR THE IDENTIFIER BY REFERRING TO: %116-01007265
% %116-01007270
% XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] %116-01007275
% %116-01007280
% EACH ENTRY CONTAINS: %116-01007285
% %116-01007290
% .[21:12] SEGMENT NUMBER IN WHICH 01007295
% THIS IDENTIFIER WAS DECL01007300
% %116-01007305
% .[33:15] IDENTIFIER ID. NO. %116-01007310
% IF THIS ID. NO. IS ZERO 01007315
% THEN XREF WAS NOT ON 01007320
% AT THE TIME THE IDENT 01007325
% WAS DECLARED AND ALL 01007330
% FUTURE REFERENCES WILL 01007335
% BE DISCARDED. %116-01007340
% %116-01007345
INTEGER % %116-01007350
XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN %116-01007355
% XREFAY2, WHEN THIS BECOMES GREATER %116-01007360
% THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365
% AND XREFPT IS RESET TO ZERO. %116-01007370
% %116-01007375
XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF %116-01007380
% ID. NO. TO IDENTIFIERS. IT IS INCREMENTED %116-01007385
% EACH TIME A NEW IDENTIFIER IS ENCOUNTERED.%116-01007390
% %116-01007395
DEFINE % %116-01007400
SEGNOF = [21:12]#, % FIELDS IN XINFO ENTRIES AND WORD 8 OF %116-01007405
IDNOF = [33:15]#, % IDENTIFIER RECORDS. %116-01007410
% %116-01007415
TYPEREF = [1:5]#, % FIELDS OF REFERENCE WORDS %116-01007420
REFIDNOF =[6:15]#, % %116-01007425
SEQNOF = [21:27]#, % %116-01007430
% %116-01007435
XREFIT(INDEX,SEQNO,REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE %116-01007440
BEGIN IF XREF THEN CROSSREFIT(INDEX,SEQNO,REFTYPE); END#, %116-01007445
% %116-01007450
XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 01007455
BEGIN IF XREF THEN XREFAY2[XREFPT-1].TYPEREF := REFTYPE END#, %116-01007460
% %116-01007465
XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER01007470
BEGIN IF DEFINING.[1:1] THEN CROSSREFDUMP(INDEX); END#, %116-01007475
% %116-01007480
XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO%116-01007481
XINFO[(INDEX).LINKR,(INDEX).LINKC DIV 2]#, % XINFO ROW AND COL %116-01007482
% %116-01007483
FORWARDREF = 0#, % DEFINES FOR DIFFERENT REFERENCE TYPES %116-01007485
LBLREF = 1#, % %116-01007486
DECLREF = 2#, % %116-01007490
NORMALREF = 4#, % %116-01007495
ASSIGNREF = 5#; % %116-01007500
ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600
BOOLEAN DEFINING; 01007650
COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000
OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000
THE INTERNAL CODE ( OR ELBAT WORD AS IT IS USUALLY 01010000
CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000
[1:1]) FOR PROCEDURES, THE LINK TO PREVIOUS ENTRY (IN 01012000
[4:8]). THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000
TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 01014000
SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000
FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000
AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLIT ACROSS A ROW 01017000
OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000
RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000
DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000
IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000
OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 01022000
ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000
THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000
THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000
RESERVED WORDS OCCUPY THE SECOND ROW. IT IS FILLED DURING 01026000
INITIALIZATION; 01027000
COMMENT INFO FORMAT 01028000
FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000
ENTERED IN INFO: 01030000
THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000
THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000
ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000
ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000
E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 01035000
LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000
THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000
THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000
POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000
THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.,THE 01040000
LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000
FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000
ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000
WILL NOT DETRACT FROM THE DISCUSSION. 01044000
ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000
THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000
FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000
THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 01048000
S[L] 01049000
NOW THE DECLARATION 01050000
BEGIN REAL A,B,C IS ENCOUNTERED 01051000
IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000
THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000
CONSTRUCTED FOR A) 01054000
T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 01055000
INFO[NEXTINFO]~T. S[L]~NEXTINFO. 01056000
NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000
ENTRY. 01058000
NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000
ITSELF CONTAINS THE STOP FLAG ZERO. 01060000
B IS ENTERED SIMILARLY TO A. 01061000
NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000
ENTRY FOR A. 01063000
SIMILARLY,AFTER C IS ENTERED 01064000
S[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000
POINTS TO A. 01066000
THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000
FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000
FORWARD. IT IS RESET AT THE TIME OF ITS ACTUAL 01069000
FULL DECLARATION. 01070000
PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000
INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBTRACTED 01072000
FROM THE CURRENT ENTRY INDEX. 01073000
[12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY.(<64) 01074000
[18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000
AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000
THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000
THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000
FOR X WOULD APPEAR AS FOLLOWS: 01079000
INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000
I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000
I+2 = L 01082000
I+3 = ELBATWRD (MADE FOR X) 01083000
I+4 = 031X 01084000
THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000
THE ENTRY BEFORE SYMBOL, AND 01086000
INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000
ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000
THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000
FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000
NECESSARY. 01091000
THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000
REAL 01093000
BOOLEAN 01094000
INTEGER 01095000
ALPHA 01096000
FILE 01097000
FORMAT 01098000
LIST 01099000
OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000
ARRAYS: 01101000
THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000
DIMENSIONS(IN THE LOW ORDER PART).[40:8] 01103000
EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000
BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000
THESE WORDS ARE MADE UP AS FOLLOWS: 01106000
[23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000
SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000
RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000
TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000
SUBTRACTED. 01111000
[35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000
REQUIRES A PRT OR STACK CELL,OTHERWISE THE BIT 01113000
35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000
REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000
[46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000
IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000
PROCEDURES: 01118000
THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000
PARAMETERS [40:8] 01120000
IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000
[13:11] ENDING PRT ADDRESS FOR LABELS, 01122000
[ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000
OF LOCALS. 01124000
SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000
OF APPEARANCE IN FORMAL PARAPART) ARE 01126000
ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000
VALUE OR NOT([10:1]). 01128000
THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000
IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000
CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 01131000
LINK([35:13]) IS MEANINGLESS. 01132000
IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 01133000
THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000
IS DONE IN THE STREAM PROCEDURE. 01135000
LABELS: 01136000
AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000
BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000
IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000
LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000
0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000
SWITCHES: 01142000
THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000
ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000
IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000
NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000
DEFINE MON =[ 1: 1]#, 01147000
CLASS =[ 2: 7]#, 01148000
FORMAL=[ 9: 1]#, 01149000
VO =[10: 1]#, 01150000
LVL =[11: 5]#, 01151000
ADDRESS=[16:11]#, 01152000
INCR =[27: 8]#, 01153000
LINK =[35:13]#, 01154000
DYNAM =[11:16]#, 01154100
SBITF =[21:6]#, % STARTING BIT FOR FIELD ID. %117-01154200
NBITF =[27:6]#, % NUMBER OF BITS FOR FIELD ID.%117-01154300
LINKR =[35: 5]#, 01155000
LINKC =[40: 8]#; 01156000
COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD. 01157000
MON IS THE BIT WHICH IS TURNED ON IF: 01158000
1. THE QUANTITY IS TO BE MONITORED, OR 01158100
2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200
A DEFINE WITHOUT PARAMETERS. 01158300
CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000
QUANTITY. 01160000
FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000
PARAMETER. 01162000
VO IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000
DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000
FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000
FROM OTHERS. 01166000
LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000
ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000
DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100
DEFINE PARAMETER ENTRIES, ONLY, IT IS AN INDEX 01168200
INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300
THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400
DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500
NOT USE THE LVL FIELD, BUT MAKES USE OF 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
DEFINEDID =03#, COMMENT 003; 01180000
LISTID =04#, COMMENT 004; 01181000
FRMTID =05#, COMMENT 005; 01182000
SUPERFRMTID =06#, COMMENT 006; 01183000
FILEID =07#, COMMENT 007; 01184000
SUPERFILEID =08#, COMMENT 010; 01185000
SWITCHID =09#, COMMENT 011; 01186000
PROCID =10#, COMMENT 012; 01187000
INTRNSICPROCID =11#, COMMENT 013; 01188000
STRPROCID =12#, COMMENT 014; 01189000
BOOSTRPROCID =13#, COMMENT 015; 01190000
REALSTRPROCID =14#, COMMENT 016; 01191000
ALFASTRPROCID =15#, COMMENT 017; 01192000
INTSTRPROCID =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
REALARRAYID =26#, COMMENT 032; 01203000
ALFARRAYID =27#, COMMENT 033; 01204000
INTARRAYID =28#, COMMENT 034; 01205000
LABELID =29#, COMMENT 035; 01206000
COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000
TRUTHV =30#, COMMENT 036; 01208000
NONLITNO =31#, COMMENT 037; 01209000
LITNO =32#, COMMENT 040; 01210000
STRNGCON =33#, COMMENT 041; 01211000
LEFTPAREN =34#, COMMENT 042; 01212000
COMMENT CLASSES FOR ALL DECLARATORS; 01213000
DECLARATORS =35#, COMMENT 043; 01214000
COMMENT CLASSES FOR STATEMENT BEGINNERS 01215000
READV =36#, COMMENT 044; 01216000
WRITEV =37#, COMMENT 045; 01217000
SPACEV =38#, COMMENT 046; 01218000
CLOSEV =39#, COMMENT 047; 01219000
LOCKV =40#, COMMENT 050; 01220000
REWINDV =41#, COMMENT 051; 01221000
DOUBLEV =42#, COMMENT 052; 01222000
FORV =43#, COMMENT 053; 01223000
WHILEV =44#, COMMENT 054; 01224000
DOV =45#, COMMENT 055; 01225000
UNTILV =46#, COMMENT 056; 01226000
ELSEV =47#, COMMENT 057; 01227000
ENDV =48#, COMMENT 060; 01228000
FILLV =49#, COMMENT 061; 01229000
SEMICOLON =50#, COMMENT 062; 01230000
IFV =51#, COMMENT 063; 01231000
GOV =52#, COMMENT 064; 01232000
RELEASEV =53#, COMMENT 065; 01233000
BEGINV =54#, COMMENT 066; 01234000
COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000
SIV =55#, COMMENT 067; 01236000
DIQ =56#, COMMENT 070; 01237000
CIV =57#, COMMENT 071; 01238000
TALLYV =58#, COMMENT 072; 01239000
DSV =59#, COMMENT 073; 01240000
SKIPV =60#, COMMENT 074; 01241000
JUMPV =61#, COMMENT 075; 01242000
DBV =62#, COMMENT 076; 01243000
SBV =63#, COMMENT 077; 01244000
TOGGLEV =64#, COMMENT 100; 01245000
SCV =65#, COMMENT 101; 01246000
LOCV =66#, COMMENT 102; 01247000
DCV =67#, COMMENT 103; 01248000
LOCALV =68#, COMMENT 104; 01249000
LITV =69#, COMMENT 105; 01250000
TRNSFER =70#, COMMENT 106; 01251000
COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000
COMMENTV =71#, COMMENT 107; 01253000
FORWARDV =72#, COMMENT 110; 01254000
STEPV =73#, COMMENT 111; 01255000
THENV =74#, COMMENT 112; 01256000
TOV =75#, COMMENT 113; 01257000
VALUEV =76#, COMMENT 114; 01258000
WITHV =77#, COMMENT 115; 01259000
COLON =78#, COMMENT 116; 01260000
COMMA =79#, COMMENT 117; 01261000
CROSSHATCH =80#, COMMENT 120; 01262000
LFTBRKET =81#, COMMENT 121; 01263000
PERIOD =82#, COMMENT 122; 01264000
RTBRKET =83#, COMMENT 123; 01265000
RTPAREN =84#, COMMENT 124; 01266000
COMMENT CLASSES FOR OPERATORS; 01267000
NOTOP =85#, COMMENT 125; 01268000
ASSIGNOP =86#, COMMENT 126; 01269000
AMPERSAND =87#, COMMENT 127; 01270000
EQVOP =88#, COMMENT 130; 01271000
IMPOP =89#, COMMENT 131; 01272000
OROP =90#, COMMENT 132; 01273000
ANDOP =91#, COMMENT 133; 01274000
RELOP =92#, COMMENT 134; 01275000
ADOP =93#, COMMENT 135; 01276000
MULOP =94#, COMMENT 136; 01277000
FACTOP =95#, COMMENT 137; 01278000
STRING =99#, COMMENT 143; 01278050
FIELDID =125#, COMMENT 175; %117-01278090
FAULTID =126#, COMMENT 176; 01278100
SUPERLISTID =127#, COMMENT 177; 01278500
COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000
OWNV =01#, COMMENT 01; 01280000
SAVEV =02#, COMMENT 02; 01281000
BOOV =03#, COMMENT 03; 01282000
REALV =04#, COMMENT 04; 01283000
ALFAV =05#, COMMENT 05; 01284000
INTV =06#, COMMENT 06; 01285000
LABELV =07#, COMMENT 07; 01286000
DUMPV =08#, COMMENT 10; 01287000
LISTV =09#, COMMENT 11; 01288000
OUTV =10#, COMMENT 12; 01289000
INV =11#, COMMENT 13; 01290000
MONITORV =12#, COMMENT 14; 01291000
SWITCHV =13#, COMMENT 15; 01292000
PROCV =14#, COMMENT 16; 01293000
ARRAYV =15#, COMMENT 17; 01294000
FORMATV =16#, COMMENT 20; 01295000
FILEV =17#, COMMENT 21; 01296000
STREAMV =18#, COMMENT 22; 01297000
DEFINEV =19#, COMMENT 23; 01298000
AUXMEMV =20#, COMMENT 24; %117-01298500
FIELDV =21#; COMMENT 25; %117-01298600
DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
REAL TIME1; 01300000
INTEGER SCRAM; 01301000
COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000
OR RESERVED WORD SCANNED; 01303000
ARRAY FILEATTRIBUTES[0:30] ; 01303500
ALPHA ARRAY ACCUM[0:10]; 01304000
COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000
SCANNED ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000
IN INFO. THAT IS ACCUM[1] = 00NAAAAA, ACCUM[I] , I> 1, 01307000
HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000
THE ELBAT WORD BY THE ENTER ROUTINES; 01309000
ARRAY STACKHEAD,SUPERSTACK[0:124]; %WF 01310000
COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX %WF 01311000
POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100
LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200
BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300
AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400
WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500
1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600
2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700
3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800
STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900
FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE %WF 01312000
COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100
INTEGER COUNT; 01313000
COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 01314000
SCANNED; 01315000
ALPHA Q; 01316000
COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000
WORD SCANNED; 01318000
ARRAY ELBAT[0:76]; INTEGER I,NXTELBT; 01319000
COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000
QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000
(ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000
GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000
FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000
POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000
INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000
FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000
INTEGER ELCLASS; 01328000
COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000
INTEGER LASTELCLASS; 01329100
COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200
INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000
INTEGER MAXTLCR; 01331000
COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF 01332000
THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS 01333000
OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000
CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000
THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000
IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000
DEFINE BUFFSIZE = 56#; 01338000
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 VARIABLE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000
ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000
VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000
USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000
INTEGER LASTUSED; 01391000
COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000
READACARD, THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000
OR PREPARES THE CARD FOR THE SCANNER. 01394000
LASTUSED LAST CARD READ FROM 01394500
-------- ------------------- 01394600
1 CARD READER ONLY, NO TAPE. 01395000
2 CARD READER, TAPE AND CARD MERGE. 01396000
3 TAPE, TAPE AND CARD MERGE. 01397000
4 INITIALIZATION ONLY, CARD ONLY. 01398000
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 USED01500000
FOR ERROR CONTROL ONLY; 01501000
INTEGER DIALA,DIALB; 01502000
COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000
DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000
WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000
BY SETTING DIALA AND DIALB TO ZERO; 01506000
01507000
01508000
01509000
01510000
01511000
01512000
01513000
01514000
01515000
01516000
01517000
01518000
01519000
01520000
01521000
BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000
SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000
COMMENT AT RR1; 01524000
BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000
DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000
THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000
THE FIRST WORD OF ADDITIONAL INFO; 01528000
DEFINE SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000
THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000
INFO FOR MONITORED SIMPLE VARIABLES; 01531000
DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000
FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000
IN NODIMPART; 01534000
DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000
POSITION IN THE FIRST WORD OF ADDITIONAL 01536000
INFO THAT CONTAINS THE MONITOR FILE 01537000
ADDRESS FOR LABELS; 01538000
DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000
POSITION IN THE FIRST WORD OF ADDITIONAL 01540000
INFO THAT CONTAINS THE MONITOR FILE 01541000
ADDRESS FOR LABELS; 01542000
DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000
POSITION IN THE FIRST WORD OF ADDITIONAL 01544000
INFO THAT CONTAINS THE MONITOR FILE 01545000
ADDRESS FOR LABELS; 01546000
DEFINE DUMPEE = [2:11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000
ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000
THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000
EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000
APPEARS IN A DUMP DECLARATION; 01551000
DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000
ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000
THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000
FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000
THE PRINTI ROUTINE; 01556000
DEFINE CHUNK = 180#; 01556100
FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200
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 CBUFF,TBUFF[0:9]; % INPUT BUFFERS. 01561056
BOOLEAN REMOTOG; 01561060
ARRAY LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 01561065
% TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070
% EACH ENTRY CONSISTS OF THREE WORDS CONTAINING: 01561080
FILE DSK1 DISK SERIAL [20:816](2,10,30); %116-01561085
FILE DSK2 DISK SERIAL [20:450](2,30,30); %116-01561087
DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090
NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100
DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110
INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120
COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 01561130
INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140
LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150
MAXTLCR USED IN READACARD, FILEINX IS THE 01561160
LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 01561170
SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180
FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190
REAL RECOUNT,FINISHPT; 01561200
BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202
PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204
BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206
CARD READER ELSE FALSE; 01561208
COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210
BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215
OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217
DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220
BLOCKS PER LIBRARY TAPE; 01561230
ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240
DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250
A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260
B: 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 %107-01561500
INSERTMAX = 20#, % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 01561510
INSERTCOP = INSERTINFO[INSERTDEPTH,4]#, % = 1 IF COPY TO NEWTAPE 01561520
INSERTMID = INSERTINFO[INSERTDEPTH,0]#, % MFID OF THE LIBRARY FILE 01561530
INSERTFID = INSERTINFO[INSERTDEPTH,1]#, % FID OF THE LIBRARY FILE 01561540
INSERTINX = INSERTINFO[INSERTDEPTH,2]#, % POINTER TO THE RECORD%107-01561550
INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#; % LAST SEQUENCE TO BE INCLUD01561560
INTEGER SAVECARD, INSERTDEPTH; %107-01561570
ARRAY INSERTINFO[0:INSERTMAX,0:4]; %107-01561580
FILE LIBRARYFIL DISK RANDOM(2,10,30); %107-01561590
DEFINE LF = LIBRARYFIL#; %107-01561600
SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER %107-01561610
REAL STREAM PROCEDURE CMPD(A,B); %107-01561620
BEGIN %107-01561630
SI:=A; DI:=B; %107-01561640
IF 8 SC } DC THEN %107-01561650
BEGIN %107-01561660
SI:=SI-8; DI=DI-8; TALLY:=2; %107-01561670
IF 8 SC = DC THEN TALLY:=1; %107-01561680
END; %107-01561690
CMPD:=TALLY; %107-01561700
END CMPD; %107-01561710
REAL C; 01562000
COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000
REAL T; 01564000
COMMENT T IS A TEMPORARY CELL; 01565000
INTEGER TCOUNT; 01566000
COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000
FOR THE USE OF CONVERT; 01568000
REAL STACKCT; %A01568500
DEFINE LOGI =443#, 01569000
EXPI =440#, 01570000
XTOTHEI =480#, 01571000
GOTOSOLVER =484#, 01572000
PRINTI =477#, 01573000
MERGEI =500#, 01573100
POWERSOFTEN =670#, 01574000
LASTSEQUENCE =166#, %117-01575000
LASTSEQROW = 2#, 01576000
INTERPTO =461#, 01577000
SUPERMOVER =555#, 01577500
CHARI =465#, 01578000
INTERPTI =469#, 01579000
SORTI =473#, 01579100
DIALER =559#, 01579200
FILATTINT =563#, 01579300
POWERALL =567#, 01579350
SPECIALMATH =570#, 01579355
SORTA =673#; %117-01580000
COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000
IN INFO OF THE CORRESPONDING ROUTINE; 01582000
INTEGER KOUNT,BUFFACCUM; 01583000
INTEGER FILENO; 01584000
BOOLEAN 01585000
FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000
FUNCTION; 01587000
P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 01588000
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
PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000
SPECTOG, 01593000
STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000
ONE ID AND THEN EIXT; 01595000
AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000
BOOLEAN STOPDEFINE; 01597000
REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100
INTEGER MAXSAVE; 01598000
COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000
DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000
FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000
REAL 01602000
KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000
ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000
LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000
LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000
INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000
PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000
DECLARED; 01609000
G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000
TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000
BEING DECLARED; 01612000
PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000
DECLARED; 01614000
MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000
OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000
PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000
J, COMMENT ARRAY COUNTER; 01618000
LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000
NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000
GLOBALNINFOO,COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 01620100
GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 01620200
CAN CHECK FOR DUPLICATE DECLARATIONS; %118-01620300
OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; %118-01620400
FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000
IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000
SAVEL; COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000
INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000
ENTERED IN INFO AT ANY GIVEN TIME; 01625000
REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100
PROCEDURE UNHOOK;FORWARD; 01626000
PROCEDURE MAKEUPACCUM;FORWARD; 01627000
DEFINE PURPT=[4:8]#,SECRET=2#; 01628000
COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000
NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000
FULL NAME IS ALSO GIVEN; 01631000
DEFINE 01632000
ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000
BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000
BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000
BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000
BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000
CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000
CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000
COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000
COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000
DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; %A 01642000
DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000
EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000
LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000
LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000
GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000
LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000
LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000
GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000
IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000
INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000
ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000
ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000
LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000
LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000
LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000
LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000
LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000
LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 01660000
LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000
MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100
MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000
MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000
NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000
NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000
PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000
PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000
RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000
RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000
RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000
SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000
SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100
SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000
STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000
SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000
XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000
XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000
ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000
COMMENT THESE DEFINES ARE USED BY EMITD; 01678000
DEFINE 01679000
DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000
DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000
TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000
REAL MAXSTACK,STACKCTR; 01683000
INTEGER MAXROW; 01684000
COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000
ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000
INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000
INTEGER F; 01688000
STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010
BEGIN LOCAL T1,T2,T3; 01688020
SI~EDOC;T1~SI;SI~TEDOC;T2~SI;SI~LOC EDOC;SI~SI+3;DI~LOC T3; 01688030
DI~DI+5;SKIP 3 DB;15(IF SB THEN DS~1 SET ELSE DS~1 RESET; 01688040
SKIP 1 SB);SI~LOC EDOC;DI~LOC T2; DS~5 CHR;3(IF SB THEN DS~ 01688050
1 SET ELSE DS ~ 1 RESET; SKIP 1 SB);DI~T3;SI~LOC T2;DS~WDS; 01688060
DI~LOC T3;DI~DI+5;SKIP 3 DB;SI~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
FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000
PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000
BUG(X24,4(A4,X2)); 01802000
PROCEDURE DATIME; 01820000
BEGIN 01821000
INTEGER H,MIN,Q; ALPHA N1,N2; 01822000
ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE; 01823000
BEGIN 01824000
DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2; 01825000
2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR; 01826000
END OF DATER; 01827000
H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60; 01828000
N1:=CODE.MFID; N2:=CODE.FID; 01828500
WRITE(LINE, 01829000
$ SET OMIT = NOT ALGOL 01829900
<X22,"BURROUGHS B-5700 ALGOL COMPILER MARK ", 01830000
$ POP OMIT 01830010
$ SET OMIT = ALGOL 01830020
<X22,"BURROUGHS B-5700 TSPOL COMPILER MARK ", 01830030
$ POP OMIT 01830040
"XVI.0.122" %123-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}12 THEN "PM." ELSE "AM.", 01835000
N1.[6:6],N1,N2.[6:6],N2); 01835500
IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. %120-01835600
WRITE(LINE,<X40,"SOURCE FILE: ",A1,A6,"/",A1,A6,//>, %120-01835700
(N1:=TAPE.MFID).[6:6],N1,(N2:=TAPE.FID).[6:6],N2); %120-01835800
NOHEADING:=FALSE; 01836000
END OF DATIME; 01837000
DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000
COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000
AND SCANNING THEM; 02001000
BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020
VALUE ROW ; 02001030
BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040
REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050
; 02001060
LOCAL DPPOS,TEMP,LGTH; 02001070
LABEL LOOP,EXIT; 02001080
SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090
DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100
SI~SI+8; 02001110
LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120
DI~ACC1; DI~DI+2; SI~SI-1; 02001130
IF SC = DC 02001140
THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150
IF LGTH SC = DC 02001160
THEN BEGIN COMMENT FOUND IT; 02001170
DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180
IF SC = "0" 02001190
THEN BEGIN COMMENT WE MAY BE IN THE02001200
WRONG ROW; 02001210
SI~SI+1;DI~LOC LOOK; 02001220
IF 3 SC = DC 02001230
THEN BEGIN COMMENT WE ARE02001240
IN THE WRONG 02001250
ROW; 02001260
SI~DPPOS; 02001270
SI~SI+8; 02001280
DPPOS~SI; 02001290
DI~LOC TEMP; 02001300
DS~WDS; 02001310
SI~TEMP; 02001320
END 02001330
ELSE SI~SI-4; 02001340
END; 02001350
DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360
SI~SI+ LGTH; 02001370
DI~STOPOS; DS~5 LIT"0"; 02001375
DS~3 CHR; GO TO EXIT; 02001380
END; 02001390
SI~SI+3; 02001400
END 02001410
ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420
SI~SI-1; 02001430
IF SC = "0" 02001440
THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450
SI~SI+1; DI~LOC LOOK; 02001460
IF 3 SC = DC 02001470
THEN BEGIN COMMENT CHANGE ROWS; 02001480
SI~DPPOS;SI~SI+8;DPPOS~SI;02001490
DI~LOC TEMP; DS~WDS; 02001500
SI~TEMP; 02001510
END 02001520
ELSE BEGIN COMMENT IT IS NOT HERE; 02001530
TALLY~1; LOOK~TALLY; 02001540
GO TO EXIT; 02001550
END; 02001560
GO TO LOOP; 02001563
END; 02001565
SI~SI~LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568
END; 02001570
GO TO LOOP; 02001580
EXIT:; 02001590
END LOOK; 02001600
%***********************************************************************02001605
% %116-02001610
% MISCELLANEOUS CROSS REFERENCE PROCEDURES %116-02001615
% %116-02001620
%***********************************************************************02001630
% %116-02001635
PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); %116-02001640
VALUE INDEX,SEQNO,REFTYPE; %116-02001645
REAL INDEX,SEQNO,REFTYPE; %116-02001650
BEGIN %116-02001655
IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE %116-02001660
BEGIN %116-02001665
IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. %116-02001670
BEGIN %116-02001675
WRITE(DSK2,30,XREFAY2[*]); %116-02001680
XREFPT := 0; %116-02001685
END; %116-02001690
XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] %116-02001695
REFIDNOF; %116-02001700
XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE %116-02001705
% CANT WRITE IT OUT BECAUSE SOME ROUTINES %116-02001710
% WILL LOOK BACK AT THE ENTRY WE JUST PUT %116-02001715
% IN AND FIX IT UP. %116-02001720
END; %116-02001725
END OF CROSSREFIT; %116-02001730
% %116-02001735
PROCEDURE CROSSREFDUMP(INDEX); %116-02001740
VALUE INDEX; %116-02001745
REAL INDEX; %116-02001750
BEGIN %116-02001755
STREAM PROCEDURE MOVEXREFINFO(S,D,N); %116-02001760
VALUE N; %116-02001765
BEGIN %116-02001770
SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD %116-02001775
SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER %116-02001780
END OF MOVEXREFINFO; %116-02001785
% %116-02001790
IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT %116-02001795
BEGIN %116-02001800
MOVEXREFINFO(INFO[INDEX.LINKR,INDEX.LINKC+1],XREFAY1[*], %116-02001805
TAKE(INDEX+1).[12:6]); %116-02001810
XREFAY1[8] := XREFINFO[INDEX]; %116-02001815
XREFAY1[9] := TAKE(INDEX); % ELBAT WORD %116-02001820
WRITE(DSK1,10,XREFAY1[*]); %116-02001821
XREFINFO[INDEX] := 0; %116-02001822
END; %116-02001825
END OF CROSSREFDUMP; %116-02001830
REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831
BEGIN 02001832
SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833
END CONV; 02001834
COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 02001836
BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001838
BEGIN 02001840
SI:=S; SI:=SI+3; DI:=D; SKP(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 "; %112-02013566
IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567
DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568
DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570
IF LIBINDEX > 0 THEN 02013575
FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580
FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600
IF LIBINDEX ! 0 THEN 02013610
MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615
IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617
NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620
IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621
LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625
NORELEASE~TRUE; 02013627
IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628
END OF UNLINK; 02013630
IF LIBINDEX = 0 THEN 02013635
BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640
SEQSUM~0; 02013645
END 02013650
ELSE 02013655
BEGIN 02013660
GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665
GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670
GT3 ~(GT2 - GT1)DIV 5; 02013675
SPACE(LIBRARY[FILEINX],GT3); 02013680
02013681
02013682
READ(LIBRARY[FILEINX]); 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 NUMBER OF CHARACTERS WE ARE 02120000
% GOING TO MOVE INTO THE "ACCUMULATOR". 02120500
TALLY:=TALLY+COUNTV; ST2:=TALLY; 02121000
DI:=COUNT; SI:=LOC ST2; DS:=WDS; 02121500
COMMENT THIS CODE UPDATED "COUNT"; 02122000
DI:=ACCUM; SI:=SI-3; DS:=3 CHR; 02122500
COMMENT THIS CODE PLACES "COUNT" IN "ACCUM" AS WELL; 02123000
DI:=DI+COUNTV; % POSITION "DI" PAST CHARACTERS ALREADY 02123500
% IN THE "ACCUMULATOR", IF ANY. 02124000
SI:=NCRV; DS:=ST1 CHR; 02124500
COMMENT MOVE CHARACTERS INTO "ACCUM"; 02125000
FINIS: 02125500
DI:=NCR; ST1:=SI; SI:=LOC ST1; DS:=WDS; 02126000
COMMENT RESET "NCR" TO LOCATION OF NEXT CHARACTER TO BE SCANNED; 02126500
END OF SCAN; 02127000
LABEL L;% 02127500
L: 02128000
SCAN(NCR,COUNT,ACCUM[1],63-COUNT,RESULT, 02128500
RESULT,COUNT,0,NCR,0); 02129000
IF NCR=LCR THEN 02129500
BEGIN 02130000
READACARD; 02130500
IF LIBINDEX!0 THEN 02131500
IF RECOUNT=FINISHPT THEN 02132000
BEGIN 02132500
SEARCHLIB(FALSE); 02133000
READACARD; 02133500
NORELEASE:=FALSE; 02134000
END; 02134500
GO TO L; % GO DIRECTLY TO L, DO NOT PASS GO, 02135500
% DO NOT COLLECT $200. 02136000
END; 02136500
END SCANNER; 02137000
DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) 02181000
ELSE WRITE(LINE[DBL],15,LIN[*])#, 02181250
MAKCAST = BEGIN 02181500
CARDCALL:=IF LASTUSED=5 THEN TRUE ELSE FALSE; 02181750
SEARCHLIB(TRUE); 02182000
END #, 02182250
PRINTCARD = BEGIN 02182500
EDITLINE(LIN,FCR,L.[36:10], %114-02182750
SGNO,L.[45:2],MEDIUM,OMITTING); %114-02182760
IF NOHEADING THEN DATIME; WRITELINE; 02183000
END #; 02183250
STREAM PROCEDURE EDITLINE(LINE,NCR,R,S,L,SYMBOL,OMIT); %114-02183500
VALUE NCR,R,S,L,SYMBOL,OMIT; %114-02183750
BEGIN 02184000
DI := LINE; DS := 16 LIT " "; 02184250
SI := NCR; DS := 9 WDS; 02184500
DS := 8 LIT " "; 02184750
DS := WDS; % SEQUENCE NUMBER. 02185000
DS:=LIT" "; SI:=LOC SYMBOL; SI:=SI+6; 02185250
DS:=2 CHR; DS:=LIT" "; 02185500
SI:=LOC R; SI:=SI+4; 02185750
IF SC=" " THEN DS:=12 LIT" " ELSE %114-02186000
BEGIN %114-02186250
SI:=LOC S; DS:=4 DEC; DS:=LIT ":"; %114-02186300
SI:=LOC R; DS:=4 DEC; DS:=LIT ":"; %114-02186400
SI:=LOC L; DS:=1 DEC; DS:=LIT " "; %114-02186500
END; %114-02186600
OMIT(DI := DI - 12; DS := 12 LIT " :OMIT: "; DI:= LINE; %114-02186750
DS := 8 LIT " :OMIT:"); %114-02186760
END EDITLINE; 02187000
COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02187250
TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02187500
RESULT = 1 ELSE RESULT = 2; 02187750
REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02188000
BEGIN 02188250
SI := TAPE; DI := CARD; 02188500
IF 8 SC } DC THEN 02188750
BEGIN 02189000
SI := SI-8; DI := DI-8; TALLY := 1; 02189250
IF 8 SC = DC THEN TALLY := 2 02189500
END; 02189750
COMPARE := TALLY 02190000
END COMPARE; 02190250
PROCEDURE OUTPUTSOURCE; 02190500
BEGIN 02190750
LABEL LCARD,LTAPE,AWAY; 02191000
SWITCH SW:=LCARD,LCARD,LTAPE,AWAY,LCARD,LTAPE; 02191250
IF SEQTOG THEN % RESEQUENCING. 02191500
BEGIN 02191750
IF TOTALNO = -10 OR NEWBASE THEN 02192000
BEGIN 02192250
NEWBASE := FALSE; GTI1:= TOTALNO:=BASENUM 02192500
END 02192750
ELSE GTI1:= TOTALNO:= TOTALNO + ADDVALUE; 02193000
CHANGESEQ(GTI1,LCR); 02193250
END; 02193500
IF NEWTOG THEN 02193750
IF INSERTDEPTH > 0 AND INSERTCOP=1 OR INSERTDEPTH=0 THEN %107- 02193800
IF WRITNEW(LIN,FCR) THEN WRITE(NEWTAPE,10,LIN[*]); 02194000
IF OMITTING THEN IF NOT LISTATOG THEN GO AWAY; 02194250
GO SW[LASTUSED]; 02194500
LCARD: 02194750
IF LISTER OR LISTPTOG THEN PRINTCARD; 02195000
GO AWAY; 02195250
LTAPE: 02195500
IF LISTER THEN PRINTCARD; 02195750
% GO AWAY; 02196000
AWAY: 02196250
END OUTPUTSOURCE; 02196500
PROCEDURE BEGINPRINT; 02196510
BEGIN 02196520
STREAM PROCEDURE STUFF(N,L); VALUE N; 02196530
BEGIN 02196540
DI:=L; DS:=8 LIT " "; SI:=L; DS:=13 WDS; 02196550
SI:=LOC N; DS:=8 DEC; 02196560
END; 02196570
STUFF(BEGINSTACK[BSPOINT],LIN); 02196580
IF NOHEADING THEN DATIME; WRITELINE; 02196590
END BEGINPRINT; 02196610
PROCEDURE READACARD; 02196750
COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02197000
TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02197250
LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02197500
SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02197750
FCR,NCR,LCR,TLCR, AND CLCR; 02198000
BEGIN 02198250
PROCEDURE READTAPE(LCR,MAXLCR,LIB); VALUE LIB; BOOLEAN LIB; 02198500
REAL LCR, MAXLCR; 02198750
BEGIN %105-02198755
LABEL ENDREADTAPE, EOFT; %105-02198760
IF LIB THEN 02199000
BEGIN 02199250
RECOUNT:=RECOUNT+1; 02199500
IF LCR:=LCR+11>MAXLCR THEN 02199750
BEGIN 02200000
READ(LIBRARY,FILEINX); 02200250
MAXLCR:=46+LCR:=MKABS(LIBRARY[FILEINX](0))+10; 02200500
END; 02200750
ADDER(SEQSUM,LCR,TRUE,TRUE); 02201000
END 02201250
ELSE BEGIN 02201500
READ (TAPE, 10, TBUFF[*])[EOFT]; %105-02201750
MAXLCR:=LCR:=MKABS(TBUFF[9]); %105-02202000
GO TO ENDREADTAPE; %105-02202010
EOFT: %105-02202020
DEFINEARRAY[25]:="ND;END."& "E"[1:43:5]; %105-02202030
DEFINEARRAY[34]:="9999" & "9999"[1:25:23]; %105-02202040
TLCR:= MKABS(DEFINEARRAY[34]); %105-02202050
PUTSEQNO (DEFINEARRAY[33],TLCR-8); %105-02202060
TURNONSTOPLIGHT("%", TLCR-8); %105-02202070
ENDREADTAPE: %105-02202080
END; %105-02202090
END READTAPE; 02202250
PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB; 02202500
REAL TLCR, CLCR ; 02202750
BEGIN 02203000
MEDIUM:="C "; % CARD READER. 02203250
IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMB02203500
BEGIN 02203750
LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02204000
MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T.02204250
END 02204500
ELSE BEGIN 02204750
IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000
BEGIN 02205250
MEDIUM:="P "; % CARD PATCHES TAPE. 02205500
IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750
LASTCRDPATCH:=TRUE ELSE 02208000
READTAPE(LTLCR,MAXLTLCR,TRUE) ELSE 02208250
READTAPE(TLCR,MAXTLCR,FALSE); 02208500
END; 02208750
LCR:=CLCR; 02209000
LASTUSED:=IF LIB THEN 5 ELSE 2; 02209250
END; 02209500
END OF SEQCOMPARE; 02209750
LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02210000
EOF, USETHESWITCH, 02210250
COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02210500
LABEL COPYLIB, COPYEOF; %107-02210600
SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750
LIBCLAST, LIBTLAST, COPYLIB; %107-02211000
BOOLEAN DOLLAR2TOG; 02211250
IF ERRORCOUNT}ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500
USETHESWITCH: 02211750
GO TO USESWITCH[LASTUSED]; 02212000
MOVE(1,TEXT[LASTUSED.LINKR,LASTUSED.LINKC], 02212250
DEFINEARRAY[DEFINEINDEX-2]); 02212500
LASTUSED := LASTUSED + 1; 02212750
NCR := LCR-1; 02213000
GO TO XIT; 02213250
FIRSTTIME: 02213500
READ(CARD,10,CBUFF[*]); 02213750
FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9; 02214000
MEDIUM:="C "; 02214100
IF EXAMIN(FCR)!"$" AND LISTER THEN PRINTCARD; 02214200
PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02214250
CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02214260
TURNONSTOPLIGHT("%",LCR); 02214500
GO XIT; 02214750
COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000
CARDONLY: 02215250
IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*]); 02215500
LCR := MKABS(CBUFF[9]); GO EXIT; 02215750
CARDLAST: 02216000
IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*])[EOF]; 02216250
CLCR := MKABS(CBUFF[9]); 02216500
GO COMPAR; 02216750
EOF: 02217000
DEFINEARRAY[25]:="ND;END."&"E"[1:43:5]; 02217250
DEFINEARRAY[34]:="9999"&"9999"[1:25:23]; 02217500
CLCR:=MKABS(DEFINEARRAY[34]); 02217750
PUTSEQNO(DEFINEARRAY[33],CLCR-8); 02218000
TURNONSTOPLIGHT("%",CLCR-8); 02218250
% 02218400
GO COMPAR; 02218500
COMMENT THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND 02218750
SETS UP CLCR; 02219000
TAPELAST: 02219250
READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02219500
COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02219750
LIBCLAST: 02220000
IF FIRSTIMEX THEN 02220250
BEGIN FIRSTIMEX:=FALSE; GO COMPAR END; 02220500
READ(CARD,10,CBUFF[*])[EOF]; 02220750
CLCR := MKABS(CBUFF[9]); 02221000
IF LASTCRDPATCH THEN 02221250
BEGIN 02221500
LASTCRDPATCH:=FALSE; 02221750
RECOUNT:=RECOUNT+1; 02222000
GO TO XIT 02222250
END; 02222500
GO TO COMPAR; 02222750
LIBTLAST: 02223000
IF FIRSTIMEX THEN 02223250
BEGIN FIRSTIMEX:=FALSE; GO TO COMPAR END; 02223500
READTAPE(LTLCR,MAXLTLCR,TRUE); 02223750
IF RECOUNT=FINISHPT THEN GO TO XIT; 02224000
GO COMPAR; %107-02224010
COPYLIB: %107-02224020
READ(LF[INSERTINX:=INSERTINX+1],10,LBUFF[*])[COPYEOF]; %107-02224030
READ SEEK(LF[INSERTINX+1]); %107-02224032
IF(CMPD(INSERTSEQ,LBUFF[9]) = 0) THEN GO COPYEOF; %107-02224040
LCR:=MKABS(LBUFF[9]); %107-02224050
GO TO EXIT; %107-02224060
COPYEOF: %107-02224070
CLOSE(LF,RELEASE); %107-02224080
IF((INSERTDEPTH:=INSERTDEPTH-1) = 0) THEN %107-02224090
BEGIN LASTUSED:=SAVECARD; MEDIUM:=MEDIUM.[24:12]; %107-02224100
GO USETHESWITCH; %107-02224102
END; %107-02224104
FILL LF WITH INSERTMID, INSERTFID; %107-02224110
GO COPYLIB; %107-02224120
COMPAR: 02224250
IF LASTUSED = 2 OR LASTUSED = 3 THEN SEQCOMPARE(TLCR,CLCR,FALSE) 02224500
ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02224750
EXIT: 02225000
NCR := FCR:= LCR - 9; 02225250
COMMENT SETS UP NCR AND FCR; 02225500
IF CHECKTOG AND EXAMIN(FCR)!"$" THEN %$-CARDS DON"T COUNT. 02225750
IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000
IF SEQERRTOG THEN BEGIN FLAG(610); 02226250
NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300
ELSE BEGIN % SEQUENCE WARNING 02226500
BLANKET(14,LIN); 02226750
SEQUENCEWARNING(LIN[13]); 02227000
IF NOHEADING THEN DATIME; WRITELINE; 02227250
IF NOT LISTER THEN PRINTCARD; 02227500
NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1; 02227600
END; 02227750
IF EXAMIN(FCR)="$" THEN 02228250
BEGIN 02228500
IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD; 02228750
IF EXAMIN(NCR:=NCR+32768)="$" THEN MAKCAST ELSE DOLLARCARD; 02229000
NORELEASE := FALSE; 02229100
COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250
GO USETHESWITCH; 02229500
END; 02229750
IF EXAMIN(FCR)=" " THEN 02230000
IF DOLLAR2TOG:=EXAMIN(FCR+32768)="$" THEN 02230100
BEGIN 02230250
OUTPUTSOURCE; 02230500
IF EXAMIN(NCR:=NCR+65536)="$" THEN MAKCAST ELSE 02230750
DOLLARCARD; 02231000
END; 02231250
IF VOIDING OR VOIDTAPE THEN 02231500
BEGIN 02231750
IF COMPARE(LCR,VOIDCR)=0 THEN 02232000
BEGIN 02232250
IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN 02232500
GO USETHESWITCH; 02232750
END 02233000
ELSE BEGIN 02233250
VOIDCR:=VOIDPLACE:=0; 02233500
VOIDING:=FALSE; VOIDTAPE:=FALSE 02233750
END; 02234000
END; 02234250
CARDCOUNT:=CARDCOUNT+1; 02234500
IF DOLLAR2TOG THEN 02234600
BEGIN DOLLAR2TOG:=NORELEASE:=FALSE; GO USETHESWITCH;END; 02234650
PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02234750
CARDNUMBER:=IF SEQTOG THEN TOTALNO+ADDVALUE ELSE 02234800
CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02234900
OUTPUTSOURCE; 02235000
IF OMITTING THEN GO USETHESWITCH; 02235250
% 02235500
TURNONSTOPLIGHT("%",LCR); 02235750
IF BUILDLINE THEN 02236000
IF LASTADDRESS ! (LASTADDRESS := L.[36:10]) THEN 02236250
BEGIN 02236500
ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750
IF (ENILPTR := ENILPTR+1)}1023 THEN 02237000
BEGIN FLAG(80); ENILPTR := 512; END; 02237250
END; 02237500
XIT: 02237750
END READACARD; 02238000
PROCEDURE INCLUDECARD; %107-02238100
BEGIN %107-02238110
REAL V; %107-02238112
LABEL EEXIT,AGAIN,GETEM,EOF,EXIT,DONTSCAN; %107-02238120
REAL STREAM PROCEDURE SCNN(A,B); VALUE B; %107-02238130
BEGIN %107-02238140
SI:=A; DI:=LOC SCNN; DS:=8 LIT"0 "; %107-02238150
DI:=DI-7; SI:=SI+3; DS:=B CHR; %107-02238160
END; %107-02238170
STREAM PROCEDURE MVE(A,B,C,D); VALUE B,C; %107-02238180
BEGIN %107-02238190
SI:=A; SI:=SI+3; DI:=D; C(DS:=LIT"0"); DS:=B CHR; %107-02238200
END; %107-02238210
STREAM PROCEDURE MVEWD(A,B); VALUE A; %107-02238212
BEGIN SI:=A; DI:=B; DS:=10 WDS; END; %107-02238214
DEFINE SKAN = BEGIN %107-02238220
COUNT:=RESULT:=ACCUM[0]:=0; %107-02238230
SCANNER; %107-02238240
V:=SCNN(ACCUM[1],MIN(COUNT,7)); %107-02238250
END#; %107-02238260
DEFINE ERR(ERR1) = BEGIN FLAG(ERR1); GO TO EEXIT; END#; %107-02238270
IF((INSERTDEPTH:=INSERTDEPTH+1) > INSERTMAX) THEN ERR(612); %107-02238280
INSERTMID:=INSERTFID:=INSERTINX:=INSERTCOP:=0; %107-02238290
INSERTSEQ:="9999"&"9999"[1:23]; %107-02238300
AGAIN: %107-02238330
SKAN; %107-02238340
DONTSCAN: %107-02238342
IF V="% " THEN GO GETEM; %107-02238350
IF V="/ " THEN GO AGAIN; %107-02238360
IF RESULT=3 THEN % SEQ RANGE %107-02238370
BEGIN %107-02238380
MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTINX); %107-02238385
SKAN; %107-02238390
IF V="- " THEN %107-02238400
BEGIN %107-02238410
SKAN; %107-02238420
IF RESULT ! 3 THEN ERR(614); %107-02238430
MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); %107-02238440
END ELSE GO TO DONTSCAN; %107-02238450
GO AGAIN; %107-02238460
END; % SEQ RANGE %107-02238470
IF V="+ " THEN % WE HAVE COPY FORM %107-02238480
BEGIN %107-02238490
SKAN; %107-02238500
IF V="COPY " THEN %107-02238510
IF EXAMIN(LCR-9)="$" THEN %107-02238512
INSERTCOP:=INSERTINFO[INSERTDEPTH-1,4] %107-02238514
ELSE ERR(617) %107-02238520
ELSE ERR(616); %107-02238522
GO AGAIN; %107-02238530
END; %107-02238540
IF INSERTMID=0 THEN INSERTMID:=V %107-02238550
ELSE IF INSERTFID=0 THEN INSERTFID:=V ELSE ERR(616); %107-02238552
GO AGAIN; %107-02238555
GETEM: %107-02238560
IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN %107-02238570
IF EXAMIN(FCR) = "$" THEN % ONLY IF "$" IS IN COLUMN ONE %107-02238572
IF BOOLEAN(INSERTINFO[INSERTDEPTH-1,4]) THEN % ONLY IF LAST HAD COPY02238574
BEGIN MVEWD(FCR,LBUFF[0]); %107-02238580
PUTSEQNO(LBUFF[9],MKABS(INFO[LASTSEQROW,LASTSEQUENCE])); %107-02238582
WRITE(NEWTAPE,10,LBUFF[*]); %107-02238590
END; %107-02238600
IF INSERTMID=0 THEN ERR(613); %107-02238602
IF INSERTFID=0 THEN INSERTFID:=TIME(-1); %107-02238610
IF INSERTFID=0 THEN %107-02238620
BEGIN INSERTFID:=INSERTMID; INSERTMID:=0; END; %107-02238630
IF INSERTDEPTH > 1 THEN CLOSE(LF,RELEASE); %107-02238640
FILL LF WITH INSERTMID,INSERTFID; %107-02238650
READ(LF[0],10,LBUFF[*])[EEXIT]; % DO THE FOLLOWING SO THAT %107-02238652
INSERTMID:=LF.MFID; % IF THE OPERATOR IL-ED US %107-02238654
INSERTFID:=LF.FID; % WE WILL HAVE THE PROPER NAMES. 02238656
V:=-1; %107-02238658
IF INSERTINX > 0 THEN %107-02238660
BEGIN %107-02238670
DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] %107-02238680
UNTIL CMPD(INSERTINX,LBUFF[9]) { 1; %107-02238690
V:=V-1; %107-02238700
END; %107-02238702
INSERTINX:=V; %107-02238704
IF INSERTDEPTH = 1 THEN %107-02238710
BEGIN SAVECARD:=LASTUSED; LASTUSED:=7; MEDIUM:="L "& MEDIUM[24:12]; 02238720
END; %107-02238730
GO TO EXIT; %107-02238760
EEXIT: %107-02238770
IF((INSERTDEPTH:=INSERTDEPTH-1) > 0) THEN %107-02238780
BEGIN %107-02238790
CLOSE(LF,RELEASE); %107-02238800
FILL LF WITH INSERTMID,INSERTFID; %107-02238810
END; %107-02238820
EXIT: %107-02238830
Q:="1%0000"; %107-02238832
END; %107-02238840
REAL PROCEDURE CONVERT; 02248000
BEGIN REAL T; INTEGER N; 02249000
TLO~0; THI~ 02250000
T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000
FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000
IF DPTOG THEN 02253000
BEGIN 02254000
DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~, 02255000
THI,TLO); 02256000
T~THI; 02257000
END ELSE 02258000
T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000
CONVERT~T; 02260000
END; 02261000
REAL STREAM PROCEDURE FETCH(F); VALUE F; 02262000
BEGIN SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS END FETCH; 02263000
PROCEDURE DUMPINFO; 02264000
BEGIN 02264050
ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100
STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400
BEGIN 02264450
SI:=S; DI:=D; 02264500
N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550
DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600
END OF OCTALWORDS; 02264650
STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700
BEGIN 02264750
SI:=S; DI:=D; 02264800
N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850
END OF ALPHAWORDS; 02264900
IF NOHEADING THEN DATIME;WRITE(LINE[DBL],<//"ELBAT">); 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],<//"INFO[",I2,",*]">,JEDEN); 02265450
FOR DWA:=0 STEP 6 UNTIL 251 DO 02265500
BEGIN 02265550
BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600
WRITE(LINE,15,A[*]); 02265650
BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700
WRITE(LINE[DBL],15,A[*]); 02265750
END; 02265800
BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850
WRITE(LINE,15,A[*]); 02265900
BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950
WRITE(LINE[DBL],15,A[*]); 02266000
END; 02266050
END OF DUMPINFO; 02266100
DEFINE SKAN = BEGIN 02277000
COUNT:=RESULT:=ACCUM[1]:=0; 02278000
SCANNER; 02279000
Q:=ACCUM[1]; 02280000
END #; 02281000
COMMENT DOLLARCARD HANDLES THE COMPILER CONTROL CARDS. 02282000
ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT 02283000
IN THE ARRAY "OPTIONS". 02284000
EACH OPTION HAS A TWO-WORD ENTRY: 02285000
02286000
WORD CONTAINS 02287000
---- -------- 02288000
1 ENTRY FROM ACCUM[1]: 00XZZZZ, WHERE 02289000
X IS THE SIZE OF THE ID AND 02290000
ZZZZZ IS THE FIRST FIVE CHARS OF THE ID. 02291000
2 PUSH-DOWN, 47-BIT STACK CONTAINING THE 02292000
HISTORY OF THE SETTINGS OF THIS OPTION. 02293000
02294000
IN "FINDOPTION", ALL COMPILER-DEFINED OPTIONS ARE USUALLY 02295000
LOCATED BASED UPON A UNIQUE NUMBER ASSIGNED TO EACH. 02296000
FOR ALL USER-DEFINED OPTIONS, A SEQUENTIAL TABLE SEARCH IS 02297000
INITIATED USING "USEROPINX" AS THE INITIAL INDEX INTO THE 02298000
"OPTIONS" ARRAY. IF THE NUMBER OF COMPILER-DEFINED OPTIONS 02299000
IS CHANGED, THEN "USEROPINX" MUST BE ACCORDINGLY CHANGED. 02300000
THE NUMBER OF USER DEFINED OPTIONS ALLOWED CAN BE 02301000
CHANGED BY CHANGING THE DEFINE "OPARSIZE". 02302000
THE VARIABLE "OPTIONWORD" CONTAINS THE CURRENT TRUE OR FALSE 02303000
SETTING OF ALL OF THE COMPILER-DEFINED OPTIONS, ONE BIT PER 02304000
OPTION. 02305000
; 02306000
BOOLEAN PROCEDURE FINDOPTION(BIT); VALUE BIT; INTEGER BIT; 02307000
BEGIN 02308000
LABEL FOUND; 02309000
REAL ID; 02310000
OPINX:=2|BIT-4; 02311000
WHILE ID:=OPTIONS[OPINX:=OPINX+2]!0 DO 02312000
IF Q=ID THEN GO FOUND; 02313000
OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION. 02314000
FOUND: %103-02315000
IF OPINX +1>OPARSIZE THEN FLAG(602) ELSE % TOO MANY USER OPTIONS 02316000
FINDOPTION:=BOOLEAN(OPTIONS[OPINX+1]); 02317000
END FINDOPTION; 02318000
PROCEDURE DOLLARCARD; 02319000
BEGIN 02320000
PROCEDURE SWITCHIT(XBIT); VALUE XBIT; INTEGER XBIT; 02321000
BEGIN 02322000
BOOLEAN B,T; 02323000
INTEGER SAVEINX; 02324000
LABEL XMODE0,XMODE1,XMODE2,XMODE3,XMODE4,ALONG; 02325000
SWITCH SW:=XMODE0,XMODE1,XMODE2,XMODE3,XMODE4; 02326000
SETTING:=FINDOPTION(XBIT); SKAN; 02327000
GO SW[XMODE+1]; 02328000
XMODE0: % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP. 02329000
OPTIONWORD:=BOOLEAN(0); 02330000
FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO OPTIONS[SAVEINX]:=0; 02331000
IF BUILDLINE.[45:1] THEN %108-02331050
BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; %108-02331060
XMODE:=1; IF LASTUSED < 5 AND LASTUSED ! 3 THEN LASTUSED:=1; 02332000
XMODE1: % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED. 02333000
OPTIONS[OPINX+1]:=REAL(TRUE); 02334000
IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & TRUE[XBIT:1]; 02335000
GO ALONG; 02336000
XMODE2: % RESET; 02337000
OPTIONS[OPINX+1]:=REAL(FALSE & SETTING[1:2:46]); 02338000
IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & FALSE[XBIT:1]; 02339000
GO ALONG; 02340000
XMODE3: % SET. 02341000
SAVEINX:=OPINX; % REMEMBER OPTION WE ARE SETTING. 02342000
B:=IF Q="1=0000" THEN BOOLEXP ELSE TRUE; 02343000
OPTIONS[SAVEINX+1]:=REAL(B & SETTING[1:46]); 02352000
IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & B [XBIT:1]; 02353000
GO ALONG; 02354000
XMODE4: % POP. 02355000
OPTIONS[OPINX+1]:=REAL(B:=SETTING.[1:46]); 02356000
IF XBIT<USEROPINX THEN OPTIONWORD:=OPTIONWORD & B [XBIT:1]; 02357000
ALONG: 02358000
END SWITCHIT; 02359000
LABEL EXIT,AGAIN,SKANAGAIN,LENGTH1,LENGTH2,LENGTH3,LENGTH4, 02360000
LENGTH5,LENGTH6,LENGTH7,LENGTH8,LENGTH9, 02361000
WHATISIT, 02362000
CARDOPTION,MERGEOPTION; 02363000
SWITCH OPTIONLENGTH:=LENGTH1,WHATISIT,LENGTH3,LENGTH4,LENGTH5, 02364000
LENGTH6,LENGTH7,LENGTH8,LENGTH9,WHATISIT; %106-02365000
INTEGER SRESULT,SCOUNT; 02365100
INTEGER SAVEINX; %108-02365200
DOLLARTOG:=TRUE; 02366000
MOVE(10,ACCUM[0],DEFINEARRAY[0]); % SAVE INFORMATION FOR 02366100
SCOUNT:=COUNT; SRESULT:=RESULT; % "TABLE" TO RESUME SCAN. 02366200
XMODE:=0; 02367000
PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02368000
TURNONSTOPLIGHT("%",LCR); 02369000
SKANAGAIN: 02370000
SKAN; 02371000
AGAIN: 02372000
GO OPTIONLENGTH[MIN(COUNT,10)]; 02373000
LENGTH1: 02374000
IF Q = "1%0000" THEN GO EXIT; 02375000
IF Q = "1$0000" THEN 02376000
BEGIN SWITCHIT(PRINTDOLLARBIT); GO AGAIN END; 02377000
IF Q = "1,0000" THEN GO SKANAGAIN; 02378000
GO WHATISIT; 02379000
LENGTH2: % NO OPTIONS OF THIS LENGTH ARE CURRENTLY IMPLEMENTED. 02380000
LENGTH3: 02381000
IF Q = "3SET00" THEN 02382000
BEGIN XMODE:=3; GO SKANAGAIN END; 02383000
IF Q = "3POP00" THEN 02384000
BEGIN XMODE:=4; GO SKANAGAIN END; 02385000
IF Q = "3NEW00" THEN 02386000
BEGIN 02387000
SWITCHIT(NEWBIT); 02388000
IF Q = "4TAPE0" THEN GO SKANAGAIN; 02389000
GO AGAIN; 02390000
END; 02391000
IF Q = "3SEQ00" THEN 02392000
BEGIN SWITCHIT(SEQBIT); GO AGAIN END; 02393000
IF Q = "3PRT00" THEN 02394000
BEGIN SWITCHIT(PRTBIT); GO AGAIN END; 02395000
IF Q = "3MCP00" THEN 02396000
BEGIN SWITCHIT(MCPBIT); GO AGAIN END; 02397000
GO WHATISIT; 02398000
LENGTH4: 02399000
IF Q = "4LIST0" THEN 02400000
BEGIN 02401000
SWITCHIT(LISTBIT); 02402000
GO AGAIN; 02404000
END; 02405000
IF Q = "4VOID0" THEN 02406000
BEGIN 02407000
IF XMODE=0 THEN 02408000
BEGIN 02409000
GETVOID(VOIDPLACE,NCR,VOIDCR,LCR, 02410000
INFO[LASTSEQROW,LASTSEQUENCE]); 02411000
XMODE:=1; SWITCHIT(VOIDBIT); 02412000
GO EXIT; 02413000
END; 02414000
SWITCHIT(VOIDBIT); 02415000
VOIDPLACE:="9999"&"9999"[1:23];%2 B COMPATIBLE W/B-5700 VOIDS 02416000
VOIDCR:=MKABS(VOIDPLACE); % AND FAKE OUT READACARD. 02417000
GO AGAIN; 02418000
END; 02419000
IF Q = "4XREF0" THEN BEGIN SWITCHIT(XREFBIT); IF BOOLEAN(XMODE) THEN02419100
DEFINING := BOOLEAN(REAL(DEFINING)&1[1:47:1]); 02419110
GO AGAIN END; 02419120
IF Q = "4BEND0" THEN BEGIN SWITCHIT(BENDBIT); GO AGAIN END; 02419200
IF Q = "4OMIT0" THEN 02420000
BEGIN SWITCHIT(OMITBIT); GO AGAIN END; 02421000
IF Q = "4CARD0" THEN 02422000
BEGIN 02423000
Q:="4TAPE0"; % FAKE OUT SWITCHIT. 02424000
SWITCHIT(MERGEBIT); 02425000
IF XMODE!2 THEN MERGETOG:=NOT MERGETOG; 02425500
OPTIONS[2|MERGEBIT-1]:= % CARD IS 02426000
REAL(SETTING & (MERGETOG)[47:1]); % INVERSE OF MERGE. 02427000
IF MERGETOG THEN GO MERGEOPTION; 02428000
CARDOPTION: 02429000
IF LASTUSED<5 THEN LASTUSED:=1; 02430000
GO AGAIN; 02431000
END; 02432000
IF Q = "4TAPE0" THEN 02433000
BEGIN 02434000
SWITCHIT(MERGEBIT); 02435000
IF NOT MERGETOG THEN GO CARDOPTION; 02436000
MERGEOPTION: 02437000
IF LASTUSED ! 1 THEN GO TO AGAIN; %110-02437500
LASTUSED:=2; % NEXT CARD IS READ FROM READER. 02438000
IF MAXTLCR=0 THEN 02439000
BEGIN 02440000
INTEGER STREAM PROCEDURE FEJ(F,T); VALUE T; 02441000
BEGIN 02442000
SI:=F; DI:=LOC T; DS:=WDS; 02443000
SI:=T; SI:=SI-16; DI:=LOC FEJ; DS:=WDS; 02444000
END FEJ; 02445000
STREAM PROCEDURE FIX(F,T); VALUE T; 02446000
BEGIN 02447000
SI:=F; SI:=SI-24; DI:=LOC T; DS:=WDS; 02448000
DI:=T; DI:=DI+47; SKIP 4 DB; DS:=2 RESET; 02449000
2(DI:=DI+48); DS:=8 LIT"00#01+0#"; 02450000
END FIX; 02451000
IF GT1:=FEJ(TAPE,0)=10 THEN 02452000
BEGIN 02453000
REWIND(TAPE); FIX(TAPE,0); 02454000
END; 02455000
MAXTLCR:=GT1+TLCR:=9+MKABS(TBUFF[0]); 02456000
READ(TAPE,10,TBUFF[*]); % INITIALIZE TAPE INPUT. 02457000
LASTUSED:=2; 02458000
END; 02459000
GO AGAIN; 02460000
END; 02461000
IF Q = "4PAGE0" THEN 02462000
BEGIN 02463000
IF LISTER THEN WRITE(LINE[PAGE]); 02464000
GO SKANAGAIN; 02465000
END; 02466000
IF Q = "4INFO0" THEN 02467000
BEGIN DUMPINFO; GO SKANAGAIN END; 02468000
IF Q = "4SEGS0" THEN 02469000
BEGIN SWITCHIT(SEGSBIT); GO AGAIN END; 02470000
IF Q = "4NEST0" THEN 02471000
BEGIN SWITCHIT(NESTBIT); GO AGAIN END; 02472000
IF Q = "4DECK0" THEN 02473000
BEGIN SWITCHIT(DECKBIT); GO AGAIN END; 02474000
GO WHATISIT; 02475000
LENGTH5: 02476000
IF Q = "5RESET" THEN 02477000
BEGIN XMODE:=2; GO SKANAGAIN END; 02478000
IF Q = "5LISTP" THEN 02479000
BEGIN SWITCHIT(LISTPBIT); GO AGAIN; END; 02480000
IF Q = "5VOIDT" THEN 02481000
BEGIN 02482000
IF XMODE=0 THEN 02483000
BEGIN 02484000
GETVOID(VOIDPLACE,NCR,VOIDCR,LCR, 02485000
INFO[LASTSEQROW,LASTSEQUENCE]); 02486000
XMODE:=1; SWITCHIT(VOIDBIT); 02487000
GO EXIT; 02488000
END; 02489000
SWITCHIT(VOIDTBIT); 02490000
VOIDPLACE:="9999"&"9999"[1:23];%2 B COMPATIBLE W/B-5700 VOIDS 02491000
VOIDCR:=MKABS(VOIDPLACE); % AND FAKE OUT READACARD. 02492000
GO AGAIN; 02493000
END; 02494000
IF Q = "5CHECK" THEN 02495000
BEGIN SWITCHIT(CHECKBIT); GO AGAIN END; 02496000
IF Q = "5LIMIT" THEN 02497000
BEGIN 02498000
SKAN; 02499000
IF RESULT!3 THEN % SHOULD BE NUMBER. 02500000
BEGIN FLAG(600); GO AGAIN END; 02501000
ERRMAX:=CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02502000
GO SKANAGAIN; 02503000
END; 02504000
IF Q = "5PUNCH" THEN 02505000
BEGIN SWITCHIT(PUNCHBIT); GO AGAIN; END; 02506000
IF Q = "5PURGE" THEN 02507000
BEGIN SWITCHIT(PURGEBIT); GO AGAIN; END; 02508000
IF Q = "5LISTA" THEN 02509000
BEGIN 02510000
SWITCHIT(LISTABIT); 02511000
GO AGAIN; 02513000
END; 02514000
IF Q = "5STUFF" THEN 02515000
BEGIN SWITCHIT(STUFFBIT); GO AGAIN; END; 02516000
GO WHATISIT; 02517000
LENGTH6: 02518000
IF Q = "6SEQER" THEN 02519000
BEGIN SWITCHIT(SEQERRBIT); GO AGAIN END; 02520000
IF Q = "6SINGL" THEN 02521000
BEGIN SWITCHIT(SINGLBIT); GO AGAIN END; 02522000
IF Q = "6SEQXE" THEN 02523000
BEGIN 02524000
IF BUILDLINE.[45:1] THEN %108-02525000
BEGIN %108-02525001
IF XMODE = 0 THEN %108-02525003
BEGIN %108-02525004
OPTIONWORD:=BOOLEAN(0); %108-02525005
FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO %108-02525006
OPTIONS[SAVEINX]:=0; %108-02525007
BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; %108-02525008
IF LASTUSED < 5 THEN LASTUSED:=1; %108-02525009
XMODE:=1; %108-02525010
END; %108-02525011
SEQXEQTOG:=XMODE ! 2 AND XMODE ! 4; %108-02525012
BUILDLINE.[47:1]:=SEQXEQTOG; %108-02525013
END; %108-02526000
GO SKANAGAIN; 02527000
END; 02528000
IF Q = "6DEBUG" THEN 02529000
BEGIN 02530000
SWITCHIT(DEBUGBIT); 02531000
IF DEBUGTOG THEN 02533000
IF WOP[0]=0 THEN 02534000
BEGIN 02535000
FILL WOP[*] WITH 02536000
"LITC"," ", 02537000
"OPDC","DESC", 02538000
10,"DFL ", 11,"NOP ", 12,"XRT ", 16,"ADD ", 17,"AD2 ", 18,"PRL ", 02539000
19,"LNG ", 21,"GEQ ", 22,"BBC ", 24,"INX ", 35,"LOR ", 37,"GTR ", 02540000
38,"BFC ", 39,"RTN ", 40,"COC ", 48,"SUB ", 49,"SB2 ", 64,"MUL ", 02541000
65,"ML2 ", 67,"LND ", 68,"STD ", 69,"NEQ ", 71,"XIT ", 72,"MKS ", 02542000
128,"DIV ",129,"DV2 ",130,"COM ",131,"LQV ",132,"SND ",133,"XCH ", 02543000
134,"CHS ",167,"RTS ",168,"CDC ",197,"FTC ",260,"LOD ",261,"DUP ", 02544000
278,"LBC ",280,"SSF ",294,"LFC ",322,"ZP1 ",384,"IDV ",453,"FTF ", 02545000
515,"MDS ",532,"ISD ",533,"LEQ ",534,"BBW ",548,"ISN ",549,"LSS ", 02546000
550,"BFW ",581,"EQL ",582,"SSP ",584,"ECM ",709,"CTC ",790,"LBU ", 02547000
806,"LFU ",896,"RDV ",965,"CTF ", 02548000
1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023; 02549000
FILL COP[*] WITH % CHARACTER MODE MNEMONICS 02550000
"EXC ","NOP ","BSD ","BSS ","RDA ","TRW ","SED ","TDA ", 02551000
" "," ","TBN "," ","SDA ","SSA ","SFD ","SRD ", 02552000
" "," ","SES "," ","TEQ ","TNE ","TEG ","TGR ", 02553000
"SRS ","SFS "," "," ","TEL ","TLS ","TAN ","BIT ", 02554000
"INC ","STC ","SEC ","CRF ","JNC ","JFC ","JNS ","JFW ", 02555000
"RCA ","ENS ","BNS ","RSA ","SCA ","JRC ","TSA ","JRV ", 02556000
"CEQ ","CNE ","CEG ","CGR ","BIS ","BIR ","OCV ","ICV ", 02557000
"CEL ","CLS ","FSU ","FAD ","TRP ","TRN ","TRZ ","TRS "; 02558000
02559000
FILL POP[*] WITH 02560000
"ZFN ","ZBN ","ZFD ","ZBD ","ISO ",0,"DIA ","DIB ","TRB ","CFL ","CFE "02561000
; 02562000
END; 02563000
GO AGAIN; 02564000
END; 02565000
IF Q = "6FORMA" THEN 02566000
BEGIN SWITCHIT(FORMATBIT); GO AGAIN; END; 02567000
GO WHATISIT; 02568000
LENGTH7: 02569000
IF Q = "7INCLU" THEN %107-02570000
BEGIN INCLUDECARD; GO EXIT; END; %107-02571000
% IF Q = "7INCLN" THEN 02572000
% BEGIN SWITCHIT(NEWINCLBIT); GO AGAIN; END; 02573000
LENGTH8: %106-02574000
IF Q ="8CODEF" THEN %106-02574100
BEGIN SWITCHIT(CODEFILEBIT); GO AGAIN; END; %106-02574200
GO WHATISIT; %106-02574300
LENGTH9: 02575000
IF Q = "9INTRI" THEN 02576000
BEGIN SWITCHIT(INTBIT); GO AGAIN; END; 02577000
WHATISIT: 02578000
IF RESULT=3 THEN 02579000
BEGIN 02580000
BASENUM:=CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02581000
TOTALNO:=-10; 02582000
NEWBASE:=TRUE; 02583000
GO SKANAGAIN; 02584000
END; 02585000
IF RESULT=2 THEN 02586000
BEGIN 02587000
IF Q = "1+0000" THEN 02588000
BEGIN 02589000
SKAN; 02590000
IF RESULT=3 THEN 02591000
ADDVALUE:=CONV(ACCUM[1],0,ACCUM[1].[12:6]) 02592000
ELSE FLAG(600); % NUMBER EXPECTED. 02593000
END; 02594000
GO SKANAGAIN; 02595000
END; 02596000
COMMENT DID NOT RECOGNIZE OPTION; 02597000
IF RESULT!1 THEN % NOT AN IDENTIFIER. 02598000
BEGIN FLAG(601); GO SKANAGAIN END; 02599000
SWITCHIT(USEROPINX); % USEROPINX MEANS A USER-DEFINED OPTION. 02600000
GO AGAIN; 02601000
EXIT: 02602000
LISTER:=DEBUGTOG OR LISTOG OR LISTATOG; 02602500
MOVE(10,DEFINEARRAY[0],ACCUM[0]); % RESTORE INFORMATION FOR 02602600
COUNT:=SCOUNT; RESULT:=SRESULT; % "TABLE" TO RESUME SCAN. 02602700
DOLLARTOG:=FALSE; 02603000
END DOLLARCARD; 02604000
COMMENT TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER 02605000
USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY. 02606000
THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED. 02607000
TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY 02608000
ELBAT. ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR 02609000
COMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD. NXTELBT 02610000
IS ALMOST EXCLUSIVELY USED BY TABLE, ALTHOUGH AN OCCASION- 02611000
AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS 02612000
SCANNED. (SEE, FOR EXAMPLE, COMPOUNDTAIL). FOR FURTHER 02613000
GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES. 02614000
THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY 02615000
DESIRED (USUALLY I-1,I, OR I+1). 02616000
THE GENERAL PLAN OF TABLE IS THIS: 02617000
I) IF P < NXTELBAT GO ON TO III). 02618000
II) PROCESS ONE QUANTITY. 02619000
A) SCAN. 02620000
B) TEST FOR IDENTIFIER, NUMBER, OR SPECIAL CHARACTER. 02621000
1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS 02622000
IN SPECIAL MANNER IF COMMENT OR DEFINED ID. 02623000
2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART, 02624000
AND EXPONENT PART. 02625000
3) TEST IF SPECIAL CHARACTER REQUIRES SPECIAL 02626000
PROCESSING - OTHERWISE GET ELBAT WORD FROM 02627000
SPECIAL. 02628000
C) LOAD ELBAT AND INCREMENT NXTELBT. 02629000
D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P. 02630000
E) GO BACK TO I). 02631000
III) RETURN WITH CLASS OF ELBAT[P]. 02632000
FURTHER DETAILS ARE GIVEN IN BODY OF TABLE. 02633000
; 02634000
INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 02635000
BEGIN 02636000
LABEL PERCENT,SPECIALCHAR,COMPLETE,COLON,DOT,ATSIGN,QUOTE, 02637000
STRNGXT,MOVEIT,ARGH,FINISHNUMBER, 02638000
SCANAGAIN,FPART,EPART,IPART,IDENT,ROSE,COMPOST,DOLLAR,RTPAREN,02639000
CROSSHATCH, DBLDOLLAR; 02640000
SWITCH SPECIALSWITCH:=PERCENT,DOLLAR,DOT,ATSIGN,COLON,QUOTE, 02641000
RTPAREN,CROSSHATCH,DBLDOLLAR; 02642000
SWITCH RESULTSWITCH:=IDENT,SPECIALCHAR,IPART; 02643000
WHILE P } NXTELBT 02644000
DO BEGIN 02645000
SCANAGAIN: 02646000
COUNT:=RESULT:=ACCUM[1]:=0; SCANNER; 02647000
GO RESULTSWITCH[RESULT]; 02648000
ARGH: 02649000
Q:=ACCUM[1]; FLAG(141); GO SCANAGAIN; 02650000
SPECIALCHAR: 02651000
GT1:=ACCUM[1].[18:6] - 2; 02652000
ENDTOG:=GT1 = 57 AND ENDTOG; 02653000
COMMENT OBTAIN ACTUAL CHARACTER FROM ACCUM; 02654000
T:=SPECIAL[GT1&GT1[42:41:3]]; 02655000
COMMENT NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF 02656000
ELBAT WORDS FOR SPECIAL CHARACTERS; 02657000
IF GT1:=T.INCR = 0 THEN GO COMPLETE; 02658000
GO SPECIALSWITCH[GT1]; 02659000
COMMENT INCR FIELD OF SPECIAL CHARACTER IS NON-ZERO FOR SPECIAL 02660000
CHARACTERS REQUIRING SPECIAL HANDLING. INCR IS SWITCHED 02661000
ON TO OBTAIN DISCRIMINATION; 02662000
COLON: RESULT:=7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02663000
FOR := IN PLACE OF ~ ; 02664000
IF EXAMIN (NCR) = "=" THEN 02665000
BEGIN RESULT:=0; SCANNER; T:=SPECIAL[13] END; 02666000
RESULT:=2; GO COMPLETE; 02667000
DOT: 02668000
IF EXAMIN(NCR)>9 OR ENDTOG THEN GO COMPLETE; 02680000
NHI:=NLO:=0; 02681000
C:=0; FSAVE:=0; GO FPART; 02682000
ATSIGN: 02683000
% RESULT:=0; SCANNER; 02684000
% IF COUNT>17 THEN GO ARGH; 02685000
% IF OCTIZE(ACCUM[1],COUNT-1,17-COUNT,C) THEN GO ARGH 02686000
% ELSE GO NUMBEREND; 02687000
NHI:=C:=1; NLO:=FSAVE:=0; GO EPART; 02688000
COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02689000
QUOTE: 02690000
COUNT := 0; T := IF STREAMTOG THEN 63 ELSE 8; %111-02691000
% 02692000
% 02692500
DO BEGIN 02693000
RESULT:=5; SCANNER; 02694000
IF COUNT=T THEN 02695000
IF EXAMIN(NCR) ! """ THEN GO ARGH; 02696000
END UNTIL EXAMIN(NCR) = """; 02697000
IF NOT STREAMTOG AND COUNT=8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 02697500
BEGIN Q := ACCUM[1]; FLAG(254); GO TO SCANAGAIN; END; %111-02697600
Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02698000
IF COUNT<0 THEN COUNT:=COUNT+64; 02699000
ACCUM[1]:=Q; RESULT:=4; 02700000
STRNGXT: T:=C:=0; 02701000
T.CLASS:=STRNGCON; 02702000
IF COUNT < 8 OR (COUNT = 8 AND NOT BOOLEAN %111-02703000
(ACCUM[1].[18:1])) THEN % FLAG BIT NOT SET, FULL WORD CONST. 02703050
MOVEIT: 02704000
MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT) 02705000
ELSE T.CLASS:=STRING; 02705100
T.INCR:=COUNT; GO COMPLETE; 02705200
% 02706000
COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02707000
THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02708000
THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02709000
THE TWO CASES ARE PROCESSED DIFFERENTLY. THE FIRST CASE 02710000
MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02711000
CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID. 02712000
FOR A FULL DISCUSSION SEE DEFINEGEN; 02713000
CROSSHATCH: 02714000
IF DEFINECTR!0 THEN GO COMPLETE; 02715000
PUTSEQNO(GT1,LCR); 02716000
TURNONSTOPLIGHT(0,LCR); 02717000
IF DEFINEINDEX = 0 THEN GO ARGH; 02718000
LCR:=(GT1:=DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02719000
NCR:=GT1 MOD 262144; 02720000
LASTUSED:=(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3]).[33:15];02721000
IF (GT2 := T.[18:15]) ! 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500
BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD %122-02722000
GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500
DO %122-02723000
PUT(TEXT[(NEXTTEXT:=(GT1:=TAKE(DEFSTACKHEAD)).DYNAM-1) 02723500
.LINKR,NEXTTEXT.LINKC],DEFSTACKHEAD) %122-02724000
% THIS RESTORES THE PREVIOUS ELBAT WORD FOR %122-02724500
% THIS PARAMETER IN CASE OF NESTED DEFINE. %122-02725000
UNTIL %122-02725500
GT2 = (DEFSTACKHEAD := GT1.LINK); %122-02726000
END; %122-02727000
GO SCANAGAIN; 02728000
DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02729000
IF GT1:=EXAMIN(NCR)="$" THEN GO DBLDOLLAR ELSE DOLLARCARD; 02730000
PERCENT: IF NCR ! FCR THEN READACARD; 02731000
IF LIBINDEX!0 THEN 02732000
IF RECOUNT=FINISHPT THEN 02733000
BEGIN 02734000
SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000
END; 02736000
GO SCANAGAIN; 02737000
COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02738000
PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02739000
SIDE EFFECT IS THAT ALL CHARACTERS ON A CARD ARE IGNORED 02740000
AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR 02741000
COMMENT); 02742000
COMMENT MIGHT BE FUNNY COMMA - HANDLE HERE; 02743000
RTPAREN: RESULT:=7; SCANNER; 02744000
IF EXAMIN(NCR) = """ THEN 02745000
BEGIN 02746000
RESULT:=0; SCANNER; 02747000
DO BEGIN 02748000
RESULT:=5; SCANNER 02749000
END UNTIL EXAMIN(NCR) = """; 02750000
RESULT:=0; SCANNER; 02751000
RESULT:=7; SCANNER; 02752000
IF EXAMIN(NCR) ! "(" THEN GO ARGH; 02753000
RESULT:=0; SCANNER; Q:=ACCUM[1]; 02754000
T:=SPECIAL[24] 02755000
END; 02756000
RESULT:=2; GO COMPLETE; 02757000
IPART: TCOUNT:=FSAVE:=0; C:=CONVERT; 02758000
RESULT:=7; SCANNER; % DEBLANK. 02759000
IF DEFINECTR=0 THEN 02760000
IF (C=3 OR C=4) AND EXAMIN(NCR)=""" THEN %OCTAL OR HEX STRING.02761000
IF NOT (ACCUM[0].CLASS=FILEID AND INFO[LASTINFO. % 1641 02761500
LINKR, LASTINFO.LINKC] = ACCUM[0])THEN % 1641 02761501
BEGIN INTEGER SIZ; 02762000
RESULT:=5; SCANNER; % SKIP QUOTE. 02763000
COUNT:=0; 02764000
DO BEGIN 02765000
RESULT:=5; SCANNER; 02766000
IF COUNT > SIZ:=48 DIV C THEN % > 1 WORD LONG. 02767000
BEGIN ERR(520); GO SCANAGAIN END; 02768000
END UNTIL EXAMIN(NCR)="""; 02769000
Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02770000
IF C=3 THEN % OCTAL STRING. 02771000
IF OCTIZE(ACCUM[1],ACCUM[4],16-COUNT,COUNT) THEN 02772000
FLAG(521) % NON-OCTAL CHARACTER IN STRING. 02773000
ELSE ELSE IF HEXIZE(ACCUM[1],ACCUM[4],12-COUNT,COUNT) THEN 02774000
FLAG(521); % NON-HEX CHARACTER IN HEX STRING. 02775000
T.INCR := COUNT := (C|COUNT-1)DIV 6 + 1; % # OF CHARS. 02776100
T.CLASS:= STRNGCON; %111-02776200
MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); %111-02776300
IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. %111-02776400
IF STREAMTOG THEN %111-02776500
T.CLASS := STRING %111-02776600
ELSE %111-02776700
FLAG(254) %111-02776800
ELSE %111-02776900
C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000
MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); %111-02777050
GO TO COMPLETE; %111-02777100
MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000
GO COMPLETE; 02782000
END OCTAL OR HEX STRING; 02783000
IF DPTOG THEN 02784000
BEGIN NHI:=THI; NLO:=TLO; END; 02785000
IF EXAMIN(NCR)="." THEN 02786000
BEGIN 02787000
RESULT:=0; SCANNER; 02788000
C:=1.0| C; 02789000
FPART: TCOUNT:=COUNT; 02790000
IF EXAMIN(NCR){9 THEN 02791000
BEGIN 02792000
RESULT:=0; SCANNER; 02793000
IF DPTOG THEN 02794000
BEGIN 02795000
DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000
0,/,:=,THI,TLO); 02797000
FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000
DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000
DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000
C:=NHI 02801000
END 02802000
ELSE C:=CONVERT+C|TEN[FSAVE:=COUNT-TCOUNT]; 02803000
END 02804000
END; 02805000
RESULT:=7; SCANNER; 02806000
IF EXAMIN(NCR)="@" THEN 02807000
BEGIN 02808000
RESULT:=0; SCANNER; 02809000
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]&GT3[1:1:1] 02827000
+ 12) >63 THEN FLAG(269) 02828000
ELSE IF DPTOG THEN 02829000
IF GT1<0 THEN 02830000
BEGIN 02831000
GT1:=-GT1; 02832000
DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000
FOR GT2:=12 STEP 12 UNTIL GT1 DO 02834000
DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO); 02835000
END 02836000
ELSE BEGIN 02837000
DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,:=,NHI,NLO); 02838000
FOR GT2:=12 STEP 12 UNTIL GT1 DO 02839000
DOUBLE( NHI,NLO,TEN[12],0,|,:=,NHI,NLO); 02840000
END 02841000
ELSE C:=IF GT3<0 THEN C/T ELSE C|T; 02842000
END; 02843000
END 02844000
ELSE IF FSAVE ! 0 THEN C:=C/TEN[FSAVE]; 02845000
Q:=ACCUM[1]; RESULT:=3; 02846000
FINISHNUMBER: 02847000
T:=0; 02848000
IF C.[1:37]=0 THEN 02849000
BEGIN T.CLASS:=LITNO ; T.ADDRESS:=C END 02850000
ELSE T.CLASS:=NONLITNO ; 02851000
GO COMPLETE; 02852000
COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02853000
IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02854000
ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02855000
TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK. 02856000
TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR 02857000
COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO 02858000
COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND 02859000
ROSE IS ENTERED. THE LAST THING DONE FOR ANY 02860000
IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION 02861000
OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS 02862000
ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, 02863000
SHOULD THIS BE REQUIRED. ; 02864000
IDENT: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!0 THEN 02865000
BEGIN 02866000
IF INFO[GT1:=T.LINKR,(GT2:=T.LINKC)+1]=Q THEN 02867000
BEGIN 02868000
T:=INFO[GT1,GT2]&T[35:35:13]; 02869000
GO COMPLETE 02870000
END 02871000
END; 02872000
IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN T:=DEFSTACKHEAD 02873000
ELSE T:=STACKHEAD[SCRAM]; 02874000
ROSE: GT1:=T.LINKR; 02875000
IF(GT2:=T.LINKC)+GT1= 0 THEN 02876000
BEGIN T:=0; GO COMPLETE END; 02877000
IF T = INFO[GT1, GT2] THEN BEGIN %101-02877010
T:= 0; GO TO COMPLETE END; %101-02877020
T:=INFO[GT1,GT2]; 02878000
IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO ROSE; 02879000
IF COUNT { 5 THEN GO COMPOST ; 02880000
IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE; 02881000
COMPOST: T:=T&GT1[35:43:5]&GT2[40:40:8]; 02882000
IF GT1 !1 AND NOT MACROID THEN % NOT RESERVED WORD %116-02882100
XREFIT(T.LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY %116-02882200
COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02883000
IF NOT ENDTOG THEN 02884000
BEGIN 02885000
IF GT1:=T.CLASS = COMMENTV THEN 02886000
BEGIN 02887000
WHILE EXAMIN(NCR) ! ";" DO 02888000
BEGIN RESULT:=6; COUNT:=0; SCANNER END; 02889000
RESULT:=0;SCANNER;GO SCANAGAIN 02890000
END 02891000
END; 02892000
IF STOPDEFINE THEN GO COMPLETE; 02893000
IF GT1 ! DEFINEDID THEN GO COMPLETE; 02894000
COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000
IF BOOLEAN(T.MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000
GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000
IF DEFINEINDEX = 24 THEN 02898000
BEGIN FLAG(139);GO ARGH END; 02899000
DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000
LASTUSED:=T.DYNAM; 02901000
DEFINEARRAY[DEFINEINDEX+2]:=262144|LCR+NCR; 02902000
LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02903000
PUTSEQNO(GT4,LCR); 02904000
TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3; 02905000
GO PERCENT; 02906000
DBLDOLLAR: 02907000
MAKCAST; GO SCANAGAIN; 02908000
COMPLETE: 02909000
ELBAT[NXTELBT]:=T; 02910000
IF NOT DEFINING THEN 02910100
IF T.CLASS = BEGINV THEN 02910200
BEGINSTACK[BSPOINT:=BSPOINT+1]:=CARDNUMBER ELSE 02910300
IF T.CLASS = ENDV THEN 02910400
BEGIN 02910500
IF LISTER THEN IF BEND THEN BEGINPRINT; 02910600
BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700
END; 02910800
STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000
IF NXTELBT:=NXTELBT+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); %106-02927100
VALUE SIZE,NAME; REAL SIZE,NAME; ARRAY FROM [0,0]; %106-02927110
BEGIN %106-02927120
INTEGER NSEGS,I,J,K; %106-02927130
ARRAY A[0:14]; %106-02927140
SWITCH FORMAT FMT := %106-02927150
(/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), %106-02927160
(/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927170
(/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927180
(/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), %106-02927190
(/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106-02927200
(/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), %106-02927210
(/,"SEGMENT ZERO",I*,/), %106-02927220
(/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); %106-02927230
STREAM PROCEDURE OCTALWORDS(N,W,S,D); VALUE N,W; %106-02927240
BEGIN %106-02927250
DI:=D; DS:=LIT" "; %106-02927260
SI:=LOC N; SI:=SI+6; %106-02927270
4(DS:=3 RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02927272
DI:=DI-4; DS:=3 FILL; %106-02927280
DI:=D; DI:=DI+5; DS:=4 LIT" "; %106-02927290
SI:=S; %106-02927300
W(2(8(DS:=3 RESET; %106-02927310
3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); %106-02927320
); %106-02927330
DS:=LIT" "); %106-02927340
DS:=2 LIT" "); %106-02927350
END OF OCTALWORDS; %106-02927360
%********** S T A R T ********** %106-02927370
NSEGS:=(SIZE+29) DIV 30; %106-02927380
IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN %106-02927390
DA:=CHUNK|T; %106-02927400
MOVEANDBLOCK:=DA; %106-02927410
IF CODEFILE THEN %106-02927420
IF NAME}0 THEN %106-02927430
WRITE(LINE,FMT[NAME],DA) %106-02927440
ELSE %106-02927450
WRITE(LINE,FMT[7],ABS(NAME),DA); %106-02927460
IF SIZE!0 THEN %106-02927470
BEGIN %106-02927480
FOR J:=0 STEP 30 WHILE J < SIZE DO %106-02927490
BEGIN %106-02927500
IF (K:=(128-(J MOD 128))) < 30 THEN %106-02927510
BEGIN %106-02927520
MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927530
MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); %106-02927540
END %106-02927550
ELSE %106-02927560
MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927570
IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION %106-02927580
BEGIN %106-02927590
K:=0; %106-02927600
MOVE(1,K,CODE(SIZE-J)); %106-02927610
IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD %106-02927612
MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); %106-02927620
END; %106-02927630
IF CODEFILE THEN %106-02927640
BEGIN %106-02927650
FOR K:=0 STEP 5 WHILE K{25 AND (J+K){SIZE DO %106-02927660
BEGIN %106-02927670
BLANKET(14,A); %106-02927680
OCTALWORDS(J+K,IF (J~K+5){SIZE THEN 5 ELSE %106-02927690
SIZE-J-K,CODE(K),A); %106-02927700
WRITE(LINE,15,A[*]); %106-02927710
END; %106-02927720
WRITE(LINE); %106-02927722
END; %106-02927730
WRITE(CODE[DA]); DA:=DA+1; %106-02927740
END; %106-02927750
END; %106-02927760
END OF MOVEANDBLOCK; %106-02927770
COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02928000
IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000
PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000
NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000
PROCEDURE NEXTENT; 02932000
BEGIN LABEL DEBLANK; 02933000
COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02934000
DEBLANK: 02935000
IF EXAMIN(NCR)=" "THEN 02936000
BEGIN 02937000
RESULT:=7; SCANNER; 02938000
END; 02939000
IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000
BEGIN 02941000
RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000
IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000
ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000
END 02945000
ELSE IF EXAMIN(NCR)="%" THEN 02946000
BEGIN 02947000
READACARD; COUNT:=ACCUM[1]:=0; GO DEBLANK; 02948000
END 02949000
ELSE BEGIN 02950000
RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02951000
Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02952000
END 02953000
END OF NEXTENT; 02954000
BOOLEAN PROCEDURE BOOLPRIM; FORWARD; 02955000
PROCEDURE BOOLCOMP(B); BOOLEAN B; FORWARD; 02955500
INTEGER PROCEDURE NEXT; 02956000
BEGIN 02956500
LABEL EXIT; 02957000
INTEGER T; 02957500
DEFINE ERROR = BEGIN FLAG(603); GO EXIT END#; 02958000
SKAN; 02958500
IF RESULT=3 THEN ERROR; % NUMBERS NOT ALLOWED. 02959000
IF RESULT=2 THEN % SPECIAL CHARACTER. 02959500
BEGIN 02960000
T:=IF Q="1,0000" OR Q="1%0000" THEN 20 % FAKE OUT BOOLEXP.02960500
ELSE ((T:=Q.[18:6]-2) & T[42:41:3]); 02961000
IF T=11 OR T=19 OR T=20 THEN BATMAN:=SPECIAL[T] % (,),OR ;02961500
ELSE FLAG(603); 02962000
GO EXIT 02962500
END SPECIAL CHARACTERS; 02963000
COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 02963500
T:= IF Q="3NOT00" THEN NOTOP 02964000
ELSE IF Q="3AND00" THEN ANDOP 02964500
ELSE IF Q="2OR000" THEN OROP 02965000
ELSE IF Q="3EQV00" THEN EQVOP 02965500
ELSE 0; 02966000
IF T!0 THEN BATMAN.CLASS:=T 02966500
ELSE BATMAN:=1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION. 02967000
EXIT: 02967500
NEXT:=MYCLASS:=BATMAN.CLASS; 02968000
END NEXT; 02968500
BOOLEAN PROCEDURE BOOLEXP; 02969000
BEGIN 02969500
BOOLEAN B; 02970000
B:=BOOLPRIM; 02970500
WHILE MYCLASS}EQVOP AND MYCLASS{ANDOP DO BOOLCOMP(B); 02971000
BOOLEXP:=B 02971500
END BOOLEXP; 02972000
BOOLEAN PROCEDURE BOOLPRIM; 02972500
BEGIN 02973000
BOOLEAN B,KNOT; 02973500
DEFINE SKIPIT = MYCLASS:=NEXT #; 02974000
IF KNOT:=(NEXT=NOTOP) THEN SKIPIT; 02974500
IF MYCLASS=LEFTPAREN THEN 02975000
BEGIN 02975500
B:=BOOLEXP; 02976000
IF MYCLASS!RTPAREN THEN FLAG(604); 02976500
END 02977000
ELSE IF MYCLASS!BOOID THEN FLAG(601) 02977500
ELSE B:=BATMAN<0; 02978000
IF KNOT THEN B:=NOT B; SKIPIT; 02978500
BOOLPRIM:=B 02979000
END BOOLPRIM; 02979500
PROCEDURE BOOLCOMP(B); BOOLEAN B; 02980000
BEGIN 02980500
REAL OPCLASS; 02981000
BOOLEAN T; 02981500
OPCLASS:=MYCLASS; 02982000
T:=BOOLPRIM; 02982500
WHILE OPCLASS<MYCLASS DO BOOLCOMP(T); 02983000
B:= IF OPCLASS=ANDOP THEN (B AND T) 02983500
ELSE IF OPCLASS=OROP THEN (B OR T) 02984000
ELSE (B EQV T); 02984500
END BOOLCOMP; 02985000
% 02985500
COMMENT#################################################################02986000
FORWARD DECLARATIONS 02986500
#######################################################################;02987000
% 02987500
PROCEDURE AEXP; FORWARD; 03001000
PROCEDURE ARITHSEC; FORWARD; 03002000
PROCEDURE SIMPARITH; FORWARD; 03003000
PROCEDURE ARITHCOMP; FORWARD; 03004000
PROCEDURE PRIMARY; FORWARD; 03005000
PROCEDURE BEXP; FORWARD; 03006000
INTEGER PROCEDURE EXPRSS; FORWARD; 03007000
INTEGER PROCEDURE BOOSEC; FORWARD; 03008000
PROCEDURE SIMPBOO; FORWARD; 03009000
PROCEDURE BOOCOMP; FORWARD; 03010000
INTEGER PROCEDURE BOOPRIM; FORWARD; 03011000
PROCEDURE RELATION; FORWARD; 03012000
INTEGER PROCEDURE IFEXP; FORWARD; 03013000
PROCEDURE PARSE; FORWARD; 03014000
PROCEDURE DOTIT; FORWARD; 03015000
PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; FORWARD; 03016000
PROCEDURE DEXP; FORWARD; 03017000
PROCEDURE IFCLAUSE; FORWARD; 03018000
INTEGER PROCEDURE GET(SYLLABLE);VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03019000
INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; FORWARD; 03020000
PROCEDURE PANA; FORWARD; 03021000
PROCEDURE IFSTMT; FORWARD; 03022000
PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 03023000
VALUE LABELBAT,BRANCHTYPE; 03024000
REAL LABELBAT,BRANCHTYPE; FORWARD; 03025000
BOOLEAN PROCEDURE SIMPGO; FORWARD; 03026000
PROCEDURE STMT; FORWARD; 03027000
PROCEDURE EMIT(SYLLABLE); VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03028000
PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; 03029000
PROCEDURE STRMPROCSTMT; FORWARD; 03030000
BOOLEAN PROCEDURE GETINT; FORWARD; 03031000
INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); VALUE NUMBER; 03032000
INTEGER P1,P2,NUMBER; FORWARD; 03033000
PROCEDURE CONSTANTCLEAN; FORWARD; 03034000
PROCEDURE SCATTERELBAT; FORWARD; 03035000
PROCEDURE EMITB(BRANCH,FROM,TOWARDS); VALUE BRANCH,FROM,TOWARDS; 03036000
INTEGER BRANCH,FROM,TOWARDS; FORWARD; 03037000
PROCEDURE VARIABLE(FROM); REAL FROM; FORWARD; 03038000
PROCEDURE IMPFUN; FORWARD; 03039000
PROCEDURE STREAMSTMT; FORWARD; 03040000
PROCEDURE SEGMENTSTART;FORWARD; 03041000
PROCEDURE SEGMENT(SIZE,NO,NOO); 03042000
VALUE SIZE,NO,NOO; 03043000
REAL SIZE,NO,NOO; 03044000
FORWARD; 03045000
INTEGER PROCEDURE BAE; FORWARD; 03046000
REAL PROCEDURE PROGDESCBLDR(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 03047000
PROCEDURE BANA; FORWARD; 03048000
PROCEDURE EMITNUM(A); VALUE A; REAL A; FORWARD; 03049000
PROCEDURE EMITD(A,B,T); VALUE A,B,T; INTEGER A,B,T; FORWARD; 03050000
INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L; 03051000
INTEGER L; BOOLEAN S; FORWARD; 03051001
PROCEDURE FORSTMT; FORWARD; 03052000
03053000
PROCEDURE E; FORWARD; 03054000
PROCEDURE ENTRY(TYPE); VALUE TYPE;REAL TYPE; FORWARD; 03055000
PROCEDURE FORMATGEN;FORWARD; 03056000
PROCEDURE EXPLICITFORMAT; FORWARD; 03056100
BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; 03056200
PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000
PROCEDURE JUMPCHKNX; FORWARD; 03058000
PROCEDURE JUMPCHKX; FORWARD; 03059000
PROCEDURE DBLSTMT; FORWARD; 03060000
PROCEDURE READSTMT; FORWARD; 03061000
INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N; FORWARD ; 03061010
PROCEDURE WRITESTMT; FORWARD; 03062000
PROCEDURE SPACESTMT; FORWARD; 03063000
PROCEDURE CLOSESTMT; FORWARD; 03064000
PROCEDURE LOCKSTMT; FORWARD; 03065000
PROCEDURE RWNDSTMT; FORWARD; 03066000
PROCEDURE BLOCK(S); VALUE S; BOOLEAN S; FORWARD; 03067000
PROCEDURE PURGE(STOPPER);VALUE STOPPER;REAL STOPPER;FORWARD; 03068000
PROCEDURE ENTER(TYPEV); 03069000
VALUE TYPEV; 03070000
INTEGER TYPEV; FORWARD; 03071000
INTEGER PROCEDURE PASSTYPE(P); VALUE P; REAL P; FORWARD; 03074000
PROCEDURE PASSALPHA(P); VALUE P; REAL P; FORWARD; 03075000
PROCEDURE LISTELEMENT; FORWARD; 03076000
REAL PROCEDURE LISTGEN; FORWARD; 03077000
PROCEDURE UNKNOWNSTMT; FORWARD; 03078000
PROCEDURE FAULTSTMT; FORWARD; 03079000
PROCEDURE FAULTDEC; FORWARD; 03080000
PROCEDURE SORTSTMT; FORWARD; 03081000
PROCEDURE MERGESTMT; FORWARD; 03082000
PROCEDURE CASESTMT; FORWARD; 03083000
PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000
ALPHA PROCEDURE BUGGER(S); VALUE S; INTEGER S; FORWARD; 03100000
COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 04000000
ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 04001000
COMMENT EMITL EMITS A LIT CALL; 04002000
PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; 04003000
EMIT(0&LITERAL[36:38:10]); 04004000
COMMENT EMITO EMIT AN OPERATOR; 04005000
PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; 04006000
EMIT(1&OPERATOR[36:38:10]); 04007000
COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTOR MODE 04008000
OPERATORS. HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB; 04009000
PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000
INTEGER REPEAT,OPERATOR; 04011000
BEGIN 04012000
IF REPEAT}64 THEN FLAG(268); 04013000
EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000
COMMENT EMITV EMITS AN OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND 04015000
HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04016000
PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04017000
BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04018000
EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000
COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000
SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000
PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000
BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000
EMIT(3 & ADDRESS [36:38:10]) END EMITN; 04024000
COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000
ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000
EMITS PRTE; 04027000
PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000
VALUE ADDRESS,OPERATOR; 04029000
INTEGER ADDRESS,OPERATOR; 04030000
BEGIN 04031000
EMITL(ADDRESS); 04032000
IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000
EMITO(OPERATOR) END EMITPAIR; 04034000
COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000
EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000
OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000
CODE CONSISTS OF A SERIES OF DUPS AND MULS, AS WITH 04038000
EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000
AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000
NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 04041000
IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000
(APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000
OTHERWISE IT CALLS LN AND EXP; 04044000
PROCEDURE EMITUP; 04045000
BEGIN INTEGER BACKUP, CTR; 04046000
LABEL E; 04047000
IF NOT LINKTOG THEN GO TO E; 04048000
COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000
IF GET(L-1) = 537 THEN 04050000
COMMENT LAST OPERATOR IS CHS; 04051000
BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000
IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000
THEN BEGIN 04054000
COMMENT IT IS A LITERAL; 04055000
BACKUP ~ BACKUP+1; L ~ L-1; 04056000
IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000
COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000
CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000
WHILE GT4 DIV 2 ! 0 04060000
DO BEGIN 04061000
EMITO(DUP); 04062000
IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000
EMITO(MUL); 04064000
GT4 ~ GT4 DIV 2 END; 04065000
IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000
ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000
IF BACKUP = 2 04068000
THEN BEGIN 04069000
EMITL(1); 04070000
EMITO(XCH); 04071000
EMITO(128) END END 04072000
ELSE BEGIN 04073000
E: L ~ L+BACKUP; 04074000
EMITO(MKS); 04075000
EMITPAIR(GNAT(LOGI),LOD); 04076000
EMITPAIR(GNAT(EXPI),LOD); 04077000
EMITV(GNAT(XTOTHEI)); 04078000
STACKCT ~ 0; %A 04078500
EMITO(DEL) END END EMITUP; 04079000
COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 04080000
INERVENING SPACE WITH NOPS. IT CHECKS STREAMTOG TO DECIDE 04081000
WHICH SORT OF NOP TO USE; 04082000
PROCEDURE ADJUST; 04083000
BEGIN 04084000
DIALA ~ DIALB ~ 0; 04085000
WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000
END ADJUST; 04087000
COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000
NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000
BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000
(FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000
OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000
ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000
COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000
EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,04095000
AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000
EMITLNG; 04097000
PROCEDURE EMITLNG; 04098000
BEGIN LABEL E; 04099000
IF NOT LINKTOG THEN GO TO E; 04100000
COMMENT GO TO E IF LAST THING IS A LINK; 04101000
IF GET(L) ! 0 THEN GO TO E; 04102000
COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000
LNG OR RELATIONAL OPERATOR; 04104000
IF GT1 ~ GET(L-1) = 77 THEN L ~ L-1 04105000
COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000
ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000
COMMENT LAST THING WAS A RELATIONAL; 04108000
BEGIN L~L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000
BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000
COMMENT NEGATE THE RELATIONAL; END ELSE 04111000
E: EMITO(LNG) END EMITLNG; 04112000
COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000
PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000
VALUE BRANCH,FROM,TOWARDS; 04115000
INTEGER BRANCH,FROM,TOWARDS; 04116000
BEGIN 04117000
INTEGER TL; 04118000
TL ~ L; 04119000
L ~ FROM-2; 04120000
GT1 ~ TOWARDS-FROM; 04120100
IF TOWARDS.[46:2] = 0 04120200
THEN BEGIN 04120300
BRANCH ~ BRANCH&1[39:47:1]; 04120400
GT1 ~ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500
EMITNUM(ABS(GT1)); 04121000
EMITO(BRANCH&(REAL(GT1} 0)+1)[42:46:2]); 04122000
IF BOOLEAN(BRANCH.[38:1]) THEN DIALA ~ DIALB ~ 0; 04123000
L ~ TL; 04124000
END EMITB; 04125000
COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000
OCTAL, NAMELY : 04127000
1. 4 CHARACTERS FOR THE L REGISTER. 04128000
2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000
STREAM PROCEDURE DEBUGWORD( SEQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000
BEGIN 04131000
DI~FEIL; SI~ LOC SEQ; SI~ SI+4; DS ~ 4 CHR; 04132000
DS ~ 2 LIT" "; 04133000
SI ~ LOC CODE ; 04134000
16( DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE 04135000
DS ~ RESET ; SKIP 1 SB)); 04136000
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
FINISHED:END EMITNUM ; 04225000
COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000
ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000
MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000
BE FOUND SEARCH YIELDS BLANKS. 04229000
NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000
ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000
BEGIN LABEL L; 04232000
COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000
BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000
AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000
THE LENGTH OF Q IS 128. ; 04236000
INTEGER N,I ; 04237000
N ~ 64 ; 04238000
FOR I ~ 66 STEP IF Q[I]<KEY THEN N ELSE - N 04239000
WHILE N~N DIV 2 } 1 DO 04240000
IF Q[ I ]=KEY THEN GO TO L ; 04241000
I ~0; COMMENT ARGUMENT NOT FOUND,SEARCH=Q[1] ; 04242000
L: SEARCH~Q[ I +1] ; 04243000
END SEARCH ; 04244000
COMMENT B2D CONVERTS THE FOUR LOW ORDER OCTAL DIGITS TO BCD 04245000
CODE ; 04246000
ALPHA PROCEDURE B2D(B); VALUE B; REAL B; 04247000
B2D~0&B[45:45:3]&B[39:42:3]&B[33:39:3]&B[27:36:3] ; 04248000
COMMENT PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE 04265000
INTO THE EDOC ARRAY. THE SPECIFIC ELEMENT OF EDOC 04266000
IS PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128] 04267000
SYLLABLE POSITION=(L MOD 4 ), WHERE L IS THE SYLLABLE 04268000
NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT; 04269000
STREAM PROCEDURE PACK(WORD,POSITION,SYLLABLE); 04270000
VALUE POSITION,SYLLABLE; 04271000
BEGIN 04272000
DI~WORD ; DI ~ DI+POSITION ; DI ~ DI+POSITION; 04273000
SI~LOC SYLLABLE ; SI~SI+6; 04274000
DS~2 CHR ; 04275000
END PACK ; 04276000
PROCEDURE DEBUG(S); 04277000
VALUE S; REAL S ; 04278000
IF STREAMTOG THEN 04279000
IF SINGLTOG THEN 04279100
WRITE(LINE,BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]),B2D(S)) 04279200
ELSE 04279300
WRITE(LINE[DBL],BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]), 04280000
B2D(S)) 04281000
04282000
ELSE 04283000
04284000
IF SINGLTOG THEN 04284100
WRITE(LINE,BUG,B2D(L),IF T1~S.[46:2]=1 THEN 04284200
BUGGER(S.[36:10]) ELSE WOP[T1],IF T1=1 THEN WOP[1] 04284300
ELSE B2D(S.[36:10]),B2D(S)) 04284400
ELSE 04284500
WRITE(LINE[DBL],BUG,B2D(L),IF T1~S.[46:2]=1 THEN 04285000
BUGGER(S.[36:10]) ELSE WOP[T1],IF T1=1 THEN WOP[1] 04286000
ELSE B2D(S.[36:10]),B2D(S)); 04287000
COMMENT EMIT PLACES SYLLABLES INTO EDOC, CALLS DEBUG FOR 04288000
DEBUGGING OUTPUT ON THE PRINTER, AND CHECKS FOR SEGMENTS 04289000
GREATER THAN 4093 SYLLABLES. ; 04290000
PROCEDURE EMIT ( S ) ; VALUE S; REAL S ; 04291000
BEGIN 04292000
IF L <4092 THEN 04293000
BEGIN 04294000
LINKTOG ~ TRUE; 04295000
PACK( EDOC[L.[36:3 ],L.[39:7]],L.[46:2],S); 04296000
IF DEBUGTOG THEN DEBUG(S); 04297000
L~L+1; 04298000
END ELSE 04299000
ERR(200) 04300000
COMMENT 200 EMIT - SEGMENT GREATER THAN 4093 SYLLABLES *; 04301000
END EMIT ; 04302000
COMMENT THE PRINCIPLE FUNCTION OF DEBUG IS TO COMPUTER THE PROPER 04303000
PARAMETERS FOR STREAM PROCEDURE BUG; 04304000
COMMENT EMITD EMITS THE DIA,DIB,TRB SEQUENCE OF CODE. THE 04305000
PREVIOUS SETTING OF THE G-H AND K-V REGISTERS IS COMPARED 04306000
THE CURRENT . IF THE G-H,K-V OR BOTH ARE ALREADY SET THEN 04307000
THE APPROIATE SYLLABLE(S) ARE OMITTED 04308000
IF 0 BITS ARE TO BE TRANSFERED THEN NO SYLLABLES ARE 04309000
EMITTED ; 04310000
PROCEDURE EMITD(A,B,T); VALUE A,B,T ; INTEGER A,B,T; 04311000
BEGIN LABEL EXIT,NORMAL; 04311010
REAL Q; 04311020
IF T = 15 THEN 04311030
BEGIN 04311040
IF A = 33 THEN Q ~ 512 04311050
ELSE IF A ! 18 THEN GO TO NORMAL; 04311060
IF B = 18 THEN Q ~ Q+256 04311070
ELSE IF B ! 33 THEN GO TO NORMAL; 04311080
EMITO(Q+197); COMMENT -- THIS GETS OUT FIXED FIELD; 04311090
GO TO EXIT; 04311100
END; 04311110
NORMAL: 04311120
IF T! 0 THEN 04312000
BEGIN 04313000
IF DIALA! A THEN 04314000
EMIT(((DIALA~A) DIV 6)|512 + ( A~ A MOD 6)| 64 + DIA); 04315000
IF DIALB!B THEN 04316000
EMIT(((DIALB~B) DIV 6)|512 + ( B~ B MOD 6)| 64 + DIB); 04317000
EMIT(TRB+64|T); 04318000
DIALA~DIALB~0; 04319000
COMMENT THE PRECEEDING STATEMENT CAN BE REMOVED FOR OPTIMIZING 04320000
G-H AND K-V REGISTERS, OTHERWISE NO OPTIMIZING OCCURS; 04321000
END EMITD ; 04322000
EXIT: END; 04322100
PROCEDURE EMITI(E,A,B); VALUE E,A,B; REAL E,A,B; 04500000
BEGIN LABEL EXIT,IS; 04501000
INTEGER S,T1,T2; 04502000
PROCEDURE EMIT21(E,B); VALUE E,B; 04503000
REAL E; 04504000
BOOLEAN B; 04505000
BEGIN IF E = 0 THEN 04506000
BEGIN IF B THEN EMITO(XCH); END 04507000
ELSE BEGIN GT1 ~ E.ADDRESS; 04508000
IF E ~ E.CLASS { INTID THEN 04509000
EMITV(GT1) 04521000
ELSE IF E { INTARRAYID THEN 04522000
EMITPAIR(GT1,LOD) ELSE 04523000
EMITN(GT1) 04524000
END 04525000
END; 04526000
IF B = 0 THEN 04526100
BEGIN EMIT21(E,FALSE); GO TO EXIT END; 04526200
IF STACKCT ! 0 THEN GO TO IS; 04527000
IF B = 15 THEN 04528000
BEGIN IF A = 33 THEN 04529000
BEGIN EMIT21(E,FALSE); 04530000
EMIT(0); EMITO(INX); 04531000
GO TO EXIT; 04532000
END; 04533000
IF A = 18 THEN 04534000
BEGIN EMIT(0); 04535000
EMIT21(E,TRUE); 04536000
EMITO(197); 04537000
GO TO EXIT; 04538000
END; 04539000
GO TO IS; 04540000
END; 04541000
IF B { 10 AND A+B = 48 THEN 04542000
BEGIN EMIT21(E,FALSE); 04543000
EMITL(2*B-1); 04544000
EMITO(LND); 04545000
GO TO EXIT; 04546000
END; 04547000
IS: IF (S ~ (48-A-B) MOD 6)+B { 39 THEN 04548000
BEGIN EMIT21(E,FALSE); 04549000
EMIT(T2~(T1~A DIV 6)|512+(A MOD 6)|64+DIA); 04550000
EMIT(((A+B-1) DIV 6 -T1+1)|512+64|S+37); 04551000
GO TO EXIT; 04552000
END; 04553000
EMIT(0); 04554000
EMIT21(E,TRUE); 04555000
EMITD(A,48-B,B); 04556000
EXIT: END; 04558000
ALPHA PROCEDURE BUGGER(OP); VALUE OP; INTEGER OP; 04600000
BEGIN INTEGER Q; 04601000
WOP[1]~" "; 04602000
IF BUGGER~SEARCH(WOP,OP)=" " THEN 04603000
IF Q~OP.[44:4]}9 THEN 04604000
BEGIN BUGGER~POP[IF Q!10 THEN Q-5 ELSE OP.[42:2]]; 04605000
WOP[1]~(IF Q=10 THEN OP.[39:3]&OP[41:38:1] ELSE 04606000
OP.[41:3]&OP[39:38:3])&" "[24:36:12]; 04607000
END; END BUGGER; 04608000
PROCEDURE CHECKDISJOINT(A); VALUE A; INTEGER A; 04609000
BEGIN 04610000
IF LEVEL > 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; ELCLASS ~ TABLE(I~I+1); 05002000
INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1); 05003000
COMMENT TAKE FETCHS A WORD FROM INFO; 05004000
REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000
TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC]; 05006000
COMMENT PUT PLACES A WORD INTO INFO; 05007000
PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000
INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD; 05009000
COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPRESS FUTURE 05010000
ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000
PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000
BEGIN 05013000
COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000
THE ERROR MESSAGE ON THE PRINTER; 05015000
STREAM PROCEDURE WRITERROR(RMT,ERRNUM,ACCUM,LINE,COUNT,LSTSEQ); 05016000
VALUE ERRNUM,COUNT; 05017000
BEGIN 05018000
DI:=LINE; 11(DS:=8 LIT " "); % BLANK LINE 05019000
SI ~LSTSEQ; SI ~ SI-8; DS ~WDS; 05020000
DS:=24 LIT " <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 05021000
SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000
DI~LINE; SI~RMT; SI~SI+7; 05024000
IF SC="1" THEN 05024100
BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200
7(IF SC>"0" THEN JUMP OUT; 05024300
SI~SI+1; TALLY~TALLY+1); 05024400
RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500
END ELSE DI~DI+7; 05024600
DS~14 LIT " ERROR NUMBER "; 05025000
SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000
DS ~ 4 LIT " -- "; 05027000
SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000
COMMENT PLACE ALPHA IN BUFFER; 05029000
DS ~ LIT "." 05030000
END WRITERROR; 05031000
IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000
BEGIN 05033000
SPECTOG := FALSE; 05034000
ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000
IF NOT(LISTER OR REMOTOG) THEN 05036000
BEGIN 05037000
EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); %114-05038000
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039000
IF NOHEADING THEN DATIME; WRITELINE; 05039500
END; 05041000
COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000
ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000
WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000
INFO[LASTSEQROW,LASTSEQUENCE]); 05045000
IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900
IF NOT NOHEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000
ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000
IF PUNCHTOG THEN 05048000
BEGIN 05049000
STREAM PROCEDURE PUNCH(FL,ST); 05050000
VALUE ST; 05051000
BEGIN 05052000
DI ~ FL; 05053000
SI ~ ST; 05054000
DS ~ 9 WDS 05055000
END PUNCH; 05056000
PUNCH(PNCH(0),FCR); 05057000
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000
WRITE(PNCH) 05059000
END 05060000
END END FLAG; 05101000
LABEL ENDOFITALL; 05101100
COMMENT ERR,IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000
RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000
SEMICOLON, END, OR BEGIN; 05104000
PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000
BEGIN FLAG(ERRNUM); 05106000
I ~ I-1; 05107000
IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100
IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200
DO IF STEPI = BEGINV THEN STMT UNTIL 05108000
ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000
DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000
COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000
UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000
PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000
BEGIN 05114000
IF MODE } 2 THEN 05115000
IF GT1 ~ ELBATWORD.LVL } FRSTLEVEL THEN 05116000
IF GT1 < SUBLEVEL THEN 05117000
IF ELBATWORD.[9:2] ! 1 05118000
THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000
END CHECKER; 05120000
COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000
GIVEN THE LINK TO THE ELBAT WORD; 05122000
INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000
GIT ~ TAKE(L).INCR+L.LINK; 05124000
COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000
IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000
GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000
INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000
BEGIN 05129000
REAL A; 05130000
IF 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 ELCLASS = 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 %117-05273100
BEGIN %117-05273200
FIRST := ELBAT[I].SBITF; %117-05273300
SECOND := ELBAT[I].NBITF; %117-05273400
GO TO EXIT; %117-05273500
END %117-05273600
ELSE %117-05273700
IF ELCLASS = LFTBRKET THEN %117-05273800
IF STEPI = FIELDID THEN %117-05273900
BEGIN %117-05274000
FIRST := ELBAT[I].SBITF; %117-05274100
SECOND := ELBAT[I].NBITF; %117-05274200
IF STEPI = RTBRKET THEN %117-05274300
GO TO EXIT; %117-05274400
END %117-05274500
ELSE %117-05274600
IF ELCLASS = LITNO THEN %117-05275000
IF STEPI = COLON THEN 05276000
IF STEPI = LITNO THEN 05277000
IF STEPI = RTBRKET THEN 05278000
COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000
IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000
(SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000
IF FIRST + SECOND { 48 THEN 05282000
COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000
GO TO EXIT; 05284000
ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000
DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000
BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000
VALUE ELBATCLASS,ERRORNUMBER; 05288000
REAL ELBATCLASS,ERRORNUMBER; 05289000
BEGIN COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 05290000
ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 05291000
CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET05292000
FALSE; 05293000
IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000
THEN ERR(ERRORNUMBER); 05295000
END; 05296000
BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000
VALUE LOWER,UPPER; 05298000
REAL LOWER,UPPER; 05299000
COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000
IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000
UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000
CLASS MUST BE IN ELCLASS; 05303000
RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000
COMMENT GET OBTAINS A SYLLABLE FROM EDOC, THE ARRAY INTO WHICH CODE IS 05305000
EMITTED; 05306000
INTEGER PROCEDURE GET(L); VALUE L; REAL L; 05307000
BEGIN 05308000
INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000
BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000
SI ~ W; SI ~ SI+S; SI ~ SI+S; DS ~ 2 CHR END; 05311000
GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000
COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000
SCRIPTOR TO THE TOP OF THE STACK; 05314000
PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000
BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000
REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000
VALUE SIZE ; 05318000
BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000
FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000
CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000
ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000
DI~LOC GETALPHA; DS~8 LIT"0 "; DI~DI-7; 05323000
SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000
END GETALPHA; 05325000
PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010
BEGIN 05325020
LABEL EXIT; 05325030
STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040
VALUE PORS,CELL,N; 05325050
BEGIN 05325060
LOCAL COUNT; 05325070
LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080
SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090
IF SC="P" THEN 05325100
BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110
ELSE BEGIN 05325120
DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130
IF SC}"6" THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140
COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150
DS:=11 RESET; DI:=COUNT; 05325160
END; 05325170
SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180
3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190
BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200
COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210
DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220
CI:=CI+N; 05325230
GO M0; 05325240
GO M1; 05325250
GO M2; 05325260
GO M3; 05325270
GO M4; 05325280
GO M5; 05325290
GO M6; 05325300
GO M7; 05325310
M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320
DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330
GO XIT; 05325340
M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350
M2: DI:=CELL; 05325360
DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370
M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380
M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390
M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400
M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410
M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420
XIT: 05325430
END FILLIT; 05325440
BLANKET(14,LIN); 05325450
IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460
ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470
ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480
IF 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; 05342000
BOOLEAN M,Q; 05343000
INTEGER ROW,COL,GS; 05344000
IF PERMANENT 05345000
THEN BEGIN 05346000
IF PRTIMAX>1022 THEN FLAG(148);% 05347000
SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000
OR SPRT[GS]; 05349000
PRTIMAX ~ (GS ~ PRTIMAX)+1 END 05350000
ELSE IF MODE = 0 THEN BEGIN 05351000
Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000
M ~ MASK(COL ~ PRTI.[43:5]-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.CLASS<BOOARRAYID OR AAW.CLASS>INTARRAYID 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 %WF 06019000
BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000
ENDTOG ~ LINKTOG; EMITO(CHS); 06021000
LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END 06022000
ELSE PRIMARY END ARITHSEC; 06023000
COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000
ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000
COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000
WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000
COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000
SIMPARITH IS DONE BY ARITHCOMP, AN ARTIFIAL ROUTINE 06029000
WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000
ARITHCOMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000
PROCEDURE SIMPARITH; 06032000
BEGIN 06033000
WHILE ELCLASS = AMPERSAND 06034000
DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000
WHILE ELCLASS}ADOP AND ELCLASS{FACTOP DO ARITHCOMP END; 06036000
COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000
ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000
EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000
IS OBTAINED BY RECURSION; 06040000
PROCEDURE ARITHCOMP; 06041000
BEGIN INTEGER OPERATOR, OPCLASS; 06042000
DO BEGIN 06043000
OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06044000
COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000
ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000
OF THE ELBAT WORD; 06047000
OPCLASS ~ ELCLASS; 06048000
STEPIT; PRIMARY; 06049000
IF OPCLASS = FACTOP THEN EMITUP 06050000
ELSE BEGIN 06051000
WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000
COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000
STACKCT ~ 1; %A06053500
EMIT(OPERATOR) END 06054000
END UNTIL OPCLASS ! ELCLASS END ARITHCOMP; 06055000
COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 06056000
PROCEDURE IMPFUN; 06057000
BEGIN 06058000
REAL T1,T2,T3 ; 06059000
BOOLEAN B ; 06059050
DEFINE ERRX(ERRX1)=BEGIN T1~ERRX1; GO ERROR END #; 06059100
LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000
MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100
LABEL ERROR,L1,L2,L3 ; 06060110
SWITCH S ~ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000
MAXANDMIN, MAXANDMIN, DELAY;% 06061100
DEFINE MAXV = 6#;% 06061200
IF T2~(T1~ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000
IF T2!25 THEN EMITO(MKS) ; 06062110
IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120
IF T2<24 THEN 06062125
BEGIN 06062130
L3: IF TABLE(I+1)=COMMA THEN 06062135
IF ELCLASS>BOOID AND ELCLASS<BOOARRAYID THEN 06062140
BEGIN 06062145
CHECKER(T3~ELBAT[I]); STEPIT; STEPIT ; 06062150
AEXP; EMITV(T3.ADDRESS); GO L1 ; 06062155
END ; 06062160
L2: AEXP; IF ELCLASS!COMMA THEN ERRX(80); STEPIT ; 06062165
AEXP; IF T2<24 THEN EMITO(XCH) ; 06062170
END 06062175
ELSE BEGIN 06062180
IF T2=24 THEN GO L2; EMITL(0); AEXP ; 06062185
IF ELCLASS!COMMA THEN ERRX(80); EMITPAIR(9,SND) ; 06062190
EMITD(1,1,8); STEPIT; AEXP ; 06062195
END ; 06062200
L1: IF T2<23 THEN BEGIN IF ELCLASS!COMMA THEN ERRX(80) END 06062210
ELSE IF ELCLASS!RTPAREN THEN ERRX(104) ; 06062220
STEPIT ; 06062230
IF T2<21 OR B THEN 06062280
BEGIN EMITV(GNAT(T1)) ; 06062285
B~ELCLASS=INTID OR ELCLASS=INTARRAYID 06062290
OR ELCLASS=INTPROCID ; 06062295
IF ELCLASS}REALID AND ELCLASS{INTID THEN 06062340
BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 06062350
ELSE IF ELCLASS<BOOID AND ELCLASS>BOOPROCID THEN 06062370
IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)06062380
ELSE BEGIN EMITL(514); STEPIT END 06062385
ELSE IF ELCLASS<LABELID AND ELCLASS>BOOARRAYID 06062390
THEN VARIABLE(FL) 06062400
ELSE ERRX(185) ; 06062420
IF ELCLASS!RTPAREN THEN ERRX(104); STEPIT ; 06062430
EMITO(IF B THEN ISD ELSE STD); EMITV(17); GO EXIT ;06062435
END ; 06062440
IF T2<23 THEN 06062470
BEGIN % DMOD, DARCTAN2 06062480
B~TRUE; GO L3 ; 06062500
END ; 06062535
IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540
EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560
ERROR: ERR(T1); GO EXIT ; 06062565
OTHERS: EMITO(MKS) ; 06064000
PANA; 06065000
EMITV(GNAT(T1)); GO TO EXIT; 06066000
ABS: PANA; EMITO(SSP); GO TO EXIT; 06067000
SIGN: PANA; 06068000
EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000
EMITD(1,1,1); GO TO EXIT; 06070000
ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000
EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000
MAXANDMIN:% 06072010
IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030
BEGIN STEPIT; AEXP;% 06072040
WHILE ELCLASS=COMMA DO% 06072050
BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060
EMITPAIR(JUNK, SND);% 06072070
IF T2=MAXV THEN EMITO(LSS) ELSE EMITO(GTR) ; 06072080
EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090
END;% 06072100
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110
END;% 06072120
GO TO EXIT;% 06072130
DELAY: IF STEPI!LEFTPAREN THEN% 06072200
BEGIN ERR(105); GO TO EXIT END;% 06072210
STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220
BEGIN ERR(165); GO TO EXIT END;% 06072230
STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240
BEGIN ERR(165); GO TO EXIT END;% 06072250
STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260
BEGIN ERR(104); GO TO EXIT END ELSE STEPIT;% 06072270
EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280
GO TO EXIT;% 06072290
TIME: PANA; EMITL(1); EMITO(COM); 06073000
GO TO EXIT; 06073100
STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200
IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250
BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300
EMITPAIR(32, COM); T1~3; 06073350
END ELSE BEGIN EMIT(4); EMIT(0); T1~0; 06073400
IF ELCLASS}BOOARRAYID AND ELCLASS{INTARRAYID THEN 06073450
BEGIN T1~FI; VARIABLE(T1); END ELSE AEXP; 06073500
IF T1=FI THEN 06073550
BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1~3 06073600
END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650
BEGIN EMIT(0); EMITPAIR(32, COM); T1~3 END 06073700
ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750
EMITO(XCH); EMITO(DEL); 06073800
IF ELCLASS!COMMA THEN 06073810
BEGIN ERR(129); GO TO EXIT END; 06073820
STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830
END; END; END; 06073840
GTI1~0; 06073845
DO EMITO(DEL) UNTIL GTI1~GTI1-1=T1;% 06073850
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860
GO TO EXIT; 06073870
EXIT: END IMPFUN; 06074000
COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000
OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000
DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000
CASES; 06078000
PROCEDURE PRIMARY; 06079000
BEGIN 06080000
LABEL 06081000
L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000
L30, L31, L32, L33, L34, L35; 06084000
SWITCH S ~ 06085000
L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000
L30, L31, L32, L33, L34, L35; 06088000
COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000
LABEL EXIT,RP,LDOT,LAMPER; 06090000
GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000
IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005
BEGIN 06092010
IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015
GO TO LAMPER ; 06092020
END ; 06092025
L12: L13: L17: L21: L25: L29: L30: 06093000
COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000
IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950
ERR(103); GO TO EXIT; 06095000
L11: 06096000
COMMENT INTRINSIC FUNCTIONS; 06097000
IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A06098000
L14: L15: L16: 06099000
COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100
STRMPROCSTMT; GO TO LDOT; 06101000
L18: L19: L20: 06102000
COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100
PROCSTMT(FALSE); GO TO LDOT; 06104000
L22: L23: L24: L26: L27: L28: 06105000
COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100
VARIABLE(FP); GO TO LAMPER; 06107000
L32: 06108000
COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000
EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000
L31: L33: 06111000
COMMENT STRINGS AND NONLITERALS; 06112000
EMITNUM(C); STEPIT; GO TO LAMPER; 06113000
L35: 06114000
COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000
EXPRESSION - OTHERWISE AN ERROR; 06116000
IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000
IF STEPI ! LEFTPAREN 06118000
THEN BEGIN ERR(105); GO TO EXIT END; 06119000
STEPIT; BEXP; GO TO RP END; 06120000
IF ELBAT[I].ADDRESS = INTV THEN 06120100
BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200
ERR(106); GO TO EXIT; 06121000
L34: 06122000
COMMENT (; 06123000
STEPIT; AEXP; 06124000
STACKCT ~ STACKCT-1; %A 06124500
RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000
STEPIT; 06126000
LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000
LAMPER: STACKCT ~ STACKCT+1; %A 06128000
WHILE ELCLASS = AMPERSAND %A 06128500
DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000
COMMENT THIS CODE HANDLES CANCATENATES; 06130000
EXIT: END PRIMARY; 06131000
COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000
PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000
COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000
ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000
BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000
DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000
OR DESIGNATIONAL EXPRESSION; 06138000
INTEGER PROCEDURE EXPRSS; 06139000
BEGIN 06140000
IF ELCLASS = IFV 06141000
THEN BEGIN 06142000
IF EXPRSS ~ IFEXP = ATYPE 06143000
THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000
ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000
END EXPRSS; 06146000
COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000
EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000
AS EXPRSS REPORTS; 06149000
INTEGER PROCEDURE BOOSEC; 06150000
BEGIN BOOLEAN N; 06151000
IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000
GT4 ~ BOOSEC ~ BOOPRIM; 06153000
IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000
COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000
RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000
IF GT4 ! BTYPE THEN ERR(109) 06157000
COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000
LOGICALLY NEGATED; 06159000
END END BOOSEC; 06160000
COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000
THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000
ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000
PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000
A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000
COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000
LYSIS USING RECURSION; 06167000
PROCEDURE SIMPBOO; 06168000
BEGIN 06169000
WHILE ELCLASS = AMPERSAND 06170000
DO BEGIN 06171000
STEPIT; 06172000
IF BOOPRIM! BTYPE THEN ERR(109); 06173000
PARSE END; 06174000
WHILE ELCLASS } EQVOP AND ELCLASS { ANDOP DO BOOCOMP 06175000
END BOOCOMP; 06176000
COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000
IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000
OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000
SION; 06180000
PROCEDURE BOOCOMP; 06181000
BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000
DO BEGIN 06183000
OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000
COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000
ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000
OF THE ELBAT WORD; 06187000
OPCLASS ~ ELCLASS; 06188000
STEPIT; 06189000
IF BOOSEC ! BTYPE 06190000
THEN BEGIN ERR(109); GO TO EXIT END; 06191000
WHILE OPCLASS < ELCLASS 06192000
DO IF ELCLASS { ANDOP THEN BOOCOMP 06193000
ELSE BEGIN ERR(110); GO TO EXIT END; 06194000
COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000
STACKCT ~ 1; %A 06195500
IF OPCLASS = IMPOP 06196000
THEN BEGIN 06197000
COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000
ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000
THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000
EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000
FUTURE. (SEE CODE FOR EMITLNG); 06202000
EMITLNG; 06203000
EMITO(LND); 06204000
EMITO(LNG); 06205000
EMITO(0); 06206000
L ~ L-1 END 06207000
ELSE EMIT(OPERATOR) 06208000
END UNTIL OPCLASS ! ELCLASS; 06209000
EXIT: END BOOCOMP; 06210000
COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000
DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000
INTEGER PROCEDURE BOOPRIM; 06213000
BEGIN INTEGER TYPE; 06214000
LABEL L9, 06215000
L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000
L30, L31, L32, L33, L34, L35; 06218000
SWITCH S ~ L9, 06219000
L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000
L30, L31, L32, L33, L34, L35; 06222000
COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000
LABEL EXIT,LE,D,TD,T; 06224000
LABEL FAH ; 06224500
GO TO S[ELCLASS-SUPERFILEID]; 06225000
IF ELCLASS = ADOP THEN GO TO L11; 06226000
IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500
BEGIN 06227510
BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520
GO FAH ; 06227530
END ; 06227540
LE: L10: L12: 06228000
COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000
EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000
ERR(111); GO TO EXIT; 06231000
L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000
THEN BEGIN PANA; GO TO TD END; 06233000
IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000
L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000
L31: L32: L33: 06236000
COMMENT ARITHMETIC TYPE STUFF; 06237000
AEXP; 06238000
D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000
RELATION; 06240000
BOOPRIM ~ BTYPE; GO TO EXIT; 06241000
L13: 06242000
COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100
STRMPROCSTMT; GO TO TD; 06244000
L17: 06245000
COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100
PROCSTMT(FALSE); GO TO TD; 06247000
L21: L25: 06248000
COMMENT BOOLEAN VARIABLES; 06249000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100
VARIABLE(FP); GO TO T; 06250000
L9: L29: 06251000
COMMENT LABELS AND SWITCHES; 06252000
DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000
L30: 06254000
COMMENT TRUE OR FALSE; 06255000
EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000
L34: 06257000
COMMENT (; 06258000
STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000
COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000
STACKCT ~ STACKCT-1; %A 06260500
IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000
STEPIT; 06262000
FAH: 06262500
IF TYPE = DTYPE THEN GO TO EXIT; 06263000
COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000
IF TYPE = BTYPE THEN BEGIN 06265000
TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000
T: STACKCT ~ STACKCT+1; %A 06267000
WHILE ELCLASS = AMPERSAND DO %A 06267500
COMMENT HANDLES CONCATENATE; 06268000
BEGIN 06269000
STEPIT; 06270000
IF BOOPRIM ! BTYPE 06271000
THEN BEGIN ERR(109); GO TO EXIT END; 06272000
PARSE END; 06273000
BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000
COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000
EXPRESSION; 06276000
DOT; SIMPARITH; GO TO D; 06277000
EXIT: END BOOPRIM; 06278000
COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000
EXPRESSION HAS ALREADY BEEN COMPILED; 06280000
PROCEDURE RELATION; 06281000
BEGIN 06282000
INTEGER OPERATOR; 06282200
REAL A; 06282400
BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600
DEFINE FORMALNAME = [9:2]=2#; 06282800
PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S; REAL A; 06283000
BEGIN 06283200
IF C THEN EMITNUM(A) 06283400
ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600
IF S THEN EMITO(CHS); 06283800
END PLUG; 06284000
DO BEGIN 06284200
OPERATOR:=1&ELBAT[I][36:17:10]; 06284400
COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600
EMITTED LATER (AFTER PROCESSING SECOND HALF). 06284800
THE HIGH-ORDER BITS OF THE BINARY OPERATOR 06285000
ARE TAKEN FROM THE [17:10] FIELD OF THE 06285200
ELBAT WORD FRO THE RELATIONAL SYMBOL; 06285400
IF MANY THEN 06285600
IF SIMPLE THEN PLUG(CONSTANA,A,SIGNA) ELSE EMITV(JUNK); 06285800
SIGNA:=FALSE; 06286000
IF STEPI=ADOP THEN SIGNA:=ELBAT[I].ADDRESS=SUB; 06286200
IF SIGN:=ELCLASS=ADOP THEN STEPIT; 06286400
CONSTANA:=ELCLASS}NONLITNO AND ELCLASS{STRNGCON; 06286600
A:=REAL(ELCLASS}REALID AND ELCLASS{INTID 06286800
AND NOT ELBAT[I].FORMALNAME); 06287000
SIMPLE:=(CONSTANA OR BOOLEAN(A)) AND STEPI=RELOP; 06287200
IF SIMPLE THEN 06287400
BEGIN 06287600
IF CONSTANA THEN A:=C ELSE A:=ELBAT[I-1]; 06287800
PLUG(CONSTANA,A,SIGNA) 06288000
END 06288200
ELSE BEGIN 06288400
I:=I-REAL(SIGN)-2; STEPIT; AEXP; 06288600
IF ELCLASS=RELOP THEN EMITPAIR(JUNK,SND); 06288800
END; 06289000
STACKCT:=1; EMIT(OPERATOR); 06289200
IF MANY THEN EMITO(LND) 06289400
ELSE BEGIN EMIT(0); L:=L-1 END; 06289600
MANY:=TRUE; 06289800
END UNTIL ELCLASS!RELOP 06290000
END RELATION; 06290200
COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000
OF EXPRESSIONS AS EXPRSS REPORTS; 06293000
INTEGER PROCEDURE IFEXP; 06294000
BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000
IFCLAUSE; 06296000
STACKCT ~ 0; %A 06296500
THENBRANCH ~ BUMPL; 06297000
COMMENT SAVE L FOR LATER FIXUP; 06298000
IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000
STACKCT ~ 0; %A 06299500
ELSEBRANCH ~ BUMPL; 06300000
EMITB(BFC,THENBRANCH,L); 06301000
IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000
STEPIT; 06303000
IF TYPE = ATYPE THEN AEXP ELSE 06304000
IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000
STACKCT ~ 1; %A 06305500
COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000
EMITB(BFW,ELSEBRANCH,L); 06307000
EMIT(1); L ~ L-1; 06308000
COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000
BOOSEC, BOOCOMP, AND RELATION; 06310000
END END IFEXP; 06311000
PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000
BEGIN INTEGER FIRST,SECOND,THIRD; 06312500
BOOLEAN P1,P2,P3; 06313000
LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500
IF ELCLASS = FIELDID THEN %117 06313550
BEGIN %117 06313600
FIRST := ELBAT[I].SBITF; %117 06313650
SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06313700
GO TO SKIP1; %117 06313750
END %117 06313800
ELSE %117 06313850
IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000
IF STEPI = FIELDID THEN %117 06314050
BEGIN %117 06314100
FIRST := ELBAT[I].SBITF; %117 06314150
SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06314200
IF STEPI ! RTBRKET THEN %117 06314250
BEGIN %117 06314300
ERR(94); %117 06314350
GO TO EXIT; %117 06314400
END; %117 06314450
GO TO SKIP1; %117 06314500
END %117 06314550
ELSE %117 06314600
IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL %117 06314650
GO TO L1; %117 06314700
FIRST ~ C; 06315000
IF TABLE(I+1) = COLON THEN 06315500
BEGIN 06316000
STEPIT; 06316500
IF FIRST {0 THEN FLAG(92); 06317000
END ELSE 06317500
BEGIN 06318000
L1: EMITO(MKS); 06318500
AEXP; 06319000
P1 ~ TRUE; 06319500
IF ELCLASS ! COLON THEN BEGIN ERR(91); GO TO EXIT END; 06320000
END; 06320500
IF STEPI ! LITNO THEN GO TO L2; 06321000
06321100
SECOND ~ C ; 06321500
IF GT1 ~ TABLE(I+1) = COLON THEN 06322000
BEGIN 06322500
STEPIT; 06323000
IF SECOND {0 THEN FLAG(092); 06323500
END ELSE 06324000
BEGIN 06324500
IF GT1 = RTBRKET THEN 06325000
BEGIN 06325500
STEPIT; 06326000
SECOND ~ 48 - (THIRD ~ SECOND); 06326500
GO TO SKIP2; 06327000
END; 06327500
L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000
AEXP; 06328500
P1 ~ P2 ~ TRUE; 06329000
IF ELCLASS = COLON THEN 06329100
06329200
06329300
ELSE 06329350
IF ELCLASS = RTBRKET THEN 06329400
BEGIN 06329450
EMITO(DUP); 06329500
EMITL(48) ;EMITO(SUB); 06329550
EMITO(CHS);EMITO(XCH); 06329600
P3 ~ TRUE; 06329700
GO TO SKIP1; 06329800
END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900
END; 06330000
IF STEPI ! LITNO THEN GO L3 ; 06330500
THIRD ~ C; 06330600
IF TABLE(I+1) = RTBRKET THEN 06330700
BEGIN 06330800
STEPIT; 06331000
SKIP2: IF THIRD { 0 OR THIRD > 47 THEN FLAG(95); 06331100
END ELSE 06331200
BEGIN 06331300
L3: IF NOT P2 THEN 06331500
BEGIN 06331600
IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700
EMITL(SECOND); 06331800
END; 06332000
AEXP; 06332100
P1~ P2~P3 ~TRUE; 06332200
IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300
END; 06332400
SKIP1: IF P1 THEN 06332500
BEGIN 06333000
IF NOT P2 THEN EMITL(SECOND); 06333500
IF NOT P3 THEN 06334000
BEGIN 06334100
EMITL(THIRD);EMITL(1); 06334200
EMITV(GNAT(DIALER)); 06334500
EMIT(TRB & THIRD[36:42:6]); 06334600
END ELSE 06334700
BEGIN 06335000
EMITL(0); 06335100
EMITV(GNAT(DIALER)); 06335200
EMITO(DEL); 06335500
END; 06335700
END ELSE 06336000
BEGIN 06336100
IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200
EMITD(SECOND,FIRST,THIRD); 06336300
END; 06336400
STEPIT; 06336500
EXIT: STACKCT ~ 1; 06336600
END PARSE; 06336700
COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000
THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100
PROCEDURE DOTIT; 06338000
BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000
IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000
%A 06342000
EMITI(0,FIRST,SECOND); %A 06343000
%A 06344000
STEPIT; 06345000
EXIT: END DOTIT; 06346000
COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000
PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000
THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000
SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000
IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000
IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000
BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000
THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000
IS ALSO STORED IN F+1; 06355000
PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000
BEGIN INTEGER TLEVEL; 06357000
EMITO(MKS); 06358000
IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000
JUMPCTR ~ TLEVEL; 06360000
COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000
INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000
BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000
JUMPING; 06364000
IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000
THEN BEGIN 06366000
COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000
EMIT(0); 06368000
EMIT(TLEVEL); END 06369000
ELSE BEGIN 06370000
EMITN(512); 06371000
EMITV(513); COMMENT PICK UP BLOCKCTR AT ENTRY 06372000
FROM F+1; 06373000
IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000
THEN BEGIN 06375000
EMITL(TLEVEL); 06376000
EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000
AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000
END END; 06379000
EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000
END GENGO; 06381000
COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000
IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000
THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000
STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000
SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000
COMMUNICATE WILL BE DONE; 06387000
PROCEDURE DEXP; 06388000
BEGIN 06389000
LABEL EXIT; 06390000
BOOLEAN S,F; 06391000
REAL ELBW; 06392000
IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000
THEN BEGIN 06394000
CHECKER(ELBW ~ ELBAT[I]); 06395000
SCATTERELBAT; 06396000
IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000
IF FAULTOG THEN 06397100
IF S OR F THEN FAULTLEVEL~1 ELSE 06397200
IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300
IF S THEN BEGIN 06398000
BANA; EMITPAIR(JUNK,ISD); 06399000
EMITV(GNAT(ELBW)); 06400000
IF F THEN GO TO EXIT; END 06401000
ELSE BEGIN 06402000
STEPIT; 06403000
IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000
EMITL(GNAT(ELBW)) END; 06405000
GENGO(ELBW); 06406000
END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000
EXIT: END DEXP; 06408000
PROCEDURE IFCLAUSE; 06409000
BEGIN STEPIT; STACKCT ~ 0; BEXP; %A 06410000
IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000
COMMENT PANA COMPILES THE CONSTRUCT: (<ARIT. EXP.>); 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: [<ARITH. EXP.>]; 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
STEPIT; 07010000
IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000
IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000
IF ELCLASS ! ENDV 07013000
THEN BEGIN 07014000
ERR(119); GO TO ANOTHER END; 07015000
ENDTOG~TRUE; 07016000
DO STOPDEFINE~TRUE UNTIL 07017000
STEPI{ENDV AND ELCLASS}UNTILV 07018000
OR NOT ENDTOG; 07019000
ENDTOG~FALSE; 07020000
IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000
THEN BEGIN 07022000
IF BEGINCTR = 0 THEN 07023000
BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000
FLAG (120); %104-07025000
FCR:= (LCR:=MKABS(CBUFF[9]))-9; %104-07025010
IF LISTER THEN PRINTCARD; %104-07025020
FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; %104-07025030
IF ELCLASS = PERIOD THEN 07026000
BEGIN 07027000
GT5 ~ "ND;END."&"E"[1:43:5]; 07028000
MOVE(1,GT5,CBUFF[0]); 07029000
LASTUSED~4; 07030000
ELBAT[I~I-2] ~SPECIAL[20]; 07031000
ELCLASS ~ SEMICOLON END 07032000
END COMPOUNDTAIL; 07033000
COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000
PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000
ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000
NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000
CONCERNING THE PARAMETERS: 07038000
FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000
OR NOT. 07040000
SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000
PROCEDURE OR NOT. 07042000
INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000
INFORMATION; 07044000
PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000
VALUE FBIT,SBIT,INDEX; 07046000
BOOLEAN FBIT,SBIT; 07047000
INTEGER INDEX; 07048000
BEGIN 07049000
INTEGER PCTR,ACLASS,SCLASS; 07050000
COMMENT 07051000
PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000
COMPILED. 07053000
ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000
SCLASS IS THE CLASS OF THE FORMAL PARAMETER. 07055000
THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000
TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000
SIMILAR MEANINGS; 07058000
REAL WHOLE; 07059000
COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000
PARAMETERS; 07061000
BOOLEAN VBIT; 07062000
COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000
BE CALLED BY VALUE OR BY NAME; 07064000
LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000
LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000
CERR,FGEN; 07067000
LABEL 07068000
L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000
L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000
L31,L32,L33; 07071000
SWITCH S ~ 07072000
L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000
L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000
L31,L32,L33; 07075000
REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000
TO REDUCING TOTAL NUMBER; 07077000
PCTR ~ 1; 07078000
ANOTHER: ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 07079000
STACKCT ~ 0; %A 07079500
COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000
IF FBIT THEN BEGIN VBIT ~ FALSE; SCLASS ~ LOCLID END 07081000
COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000
IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000
METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK 07084000
ELSE BEGIN 07085000
VBIT ~ BOOLEAN(GT1~ TAKE(INDEX+PCTR)).VO; 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 ACLASS = 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)).VO 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; %A 07385000
COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000
FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000
PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000
IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000
OPERATIONS; 07390000
PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000
BEGIN 07392000
REAL HOLE,ADDRESS; 07393000
LABEL EXIT; 07394000
SCATTERELBAT; 07395000
HOLE~ ELBAT[I]; 07396000
ADDRESS ~ ADDRSF; 07397000
CHECKER(HOLE); 07398000
IF ELCLASS ! PROCID THEN 07399000
IF NOT FORMALF THEN 07400000
IF TABLE(I+1) = ASSIGNOP THEN 07401000
BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000
COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000
IF ELCLASS ! PROCID EQV FROM 07404000
THEN BEGIN ERR(159); GO TO EXIT END; 07405000
COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000
STEPIT; 07407000
EMITO(MKS); 07408000
IF ELCLASS = LEFTPAREN 07409000
THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000
ELSE IF FORMALF THEN 07411000
IF FROM THEN ELSE L~L-1 07411100
ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000
EMITV(ADDRESS); 07413000
COMMENT MONITOR CODE GOES HERE; 07414000
IF HOLE < 0 07415000
THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR07416000
; 07417000
EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000
EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000
EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000
EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000
(GIT(HOLE)).FUNCMONFILE); %109-07422000
EMITNUM(1&CARDNUMBER[1:4:44]); %109-07422100
EMITV(GNAT(PRINTI)); 07423000
END; 07424000
EXIT: END PROCSTMT; 07425000
COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000
PROCEDURE STRMPROCSTMT; 07427000
BEGIN 07428000
INTEGER ADDRS; 07429000
IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000
THEN BEGIN 07431000
UNKNOWNSTMT; 07432000
END 07433000
07434000
07435000
07436000
07437000
07438000
07439000
ELSE BEGIN 07440000
IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000
GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000
GT4 ~ GT1-GT2.[7:6]; 07443000
FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000
DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000
COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000
JUMPS INSIDE OF STREAM PROCEDURES; 07447000
GT4 ~ GT2.[1:6]; 07448000
FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000
COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE07450000
OF STREAM PROCEDURES; 07451000
IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000
ELSE BEGIN 07453000
ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000
END END STRMPROCSTMT; 07455000
COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000
ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000
INTEGER PROCEDURE BAE; 07458000
BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000
COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000
RELEASE(<MEMORY DESIGNATOR>) % AUXMEM RELEASE STATEMENT. 07460250
RELEASE(<TERMINAL BUFFER SPECIFIER>) % DATACOM RELEASE STATEMENT. 07460500
RELEASE(<FILE PART>) % 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); EMITO(DEL); GO PARENCHECK; 07465500
END 07465750
ELSE BEGIN % DATACOM RELEASE. 07466000
DCR: 07466250
EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500
EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750
EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000
END; 07467250
END; 07467500
IF ELCLASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750
BEGIN AEXP; GO DCR; END; 07468000
CHECKER(ELBAT[I]); PASSFILE; 07468250
IF ELCLASS = COMMA THEN EMITO(DUP); 07468500
COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750
CHECKPRESENCE; 07469000
COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250
NOT COMPLETED; 07469500
EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750
IF ELCLASS = COMMA THEN 07470000
BEGIN 07470250
EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500
EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750
END; 07471000
EMITO(PRL); EMITO(DEL); 07471250
PARENCHECK: 07471500
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750
EXIT: 07472000
END RELSESTMT; 07472250
COMMENT DOSTMT HANDLES THE DO STATEMENT; 07481000
PROCEDURE DOSTMT; 07482000
BEGIN INTEGER TL; 07483000
DIALA ~ DIALB ~ 0; 07484000
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 GOMCP;07507000
IF NOT LOCAL(ELBAT[I]) THEN GO GOMCP; 07508000
IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000
CONSTANTCLEAN; GO EXIT END; 07510000
ELBW ~ ELBAT[I]; 07511000
IF ELBW < 0 07512000
THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000
EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000
CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)). 07515000
SWITMONFILE); %109-07516000
EMITNUM(0&CARDNUMBER[1:4:44]); %109-07516100
EMITV(GNAT( %109-07516200
PRINTI)); 07517000
END; 07518000
BANA; EMITPAIR(JUNK,ISD); 07519000
IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000
AND ELBW.ADDRESS = 0 THEN BEGIN 07521000
PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000
EMITB(BBW,L,GT4~GT1.[36:12]); 07523000
EMITB(BFW,GT4+13,L+3); 07524000
EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000
ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000
GO EXIT; 07527000
GOMCP: GOTOG ~ FALSE; DEXP; 07528000
IF GOTOG THEN 07529000
BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100
ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200
EXIT:END GOSTMT; 07530000
COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 07531000
PARAMETER. GOGEN ASSUMES THAT THE LABEL IS LOCAL. THE 07532000
PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000
OR NOT; 07534000
PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000
VALUE LABELBAT,BRANCHTYPE; 07536000
REAL LABELBAT,BRANCHTYPE; 07537000
BEGIN 07538000
IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1] 07539000
THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000
COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000
NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000
THAT WE NOW KNOW WHERE TO GO; 07543000
ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000
PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000
COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000
A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000
BOOLEAN PROCEDURE SIMPGO; 07548000
BEGIN LABEL EXIT; 07549000
IF ELCLASS = GOV 07550000
THEN BEGIN 07551000
IF STEPI = TOV THEN STEPIT; 07552000
IF ELCLASS = LABELID THEN 07553000
IF LOCAL(ELBAT[I]) THEN 07554000
BEGIN SIMPGO ~ TRUE; GO EXIT END; 07555000
I ~ I-1; ELCLASS ~ GOV END; 07556000
EXIT: END SIMPGO; 07557000
COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000
OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000
EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000
PROCEDURE IFSTMT; 07561000
BEGIN REAL T1,T2; LABEL EXIT; 07562000
IFCLAUSE; 07563000
IF SIMPGO 07564000
THEN BEGIN 07565000
T1 ~ ELBAT[I]; 07566000
IF STEPI = ELSEV 07567000
THEN BEGIN 07568000
STEPIT; 07569000
IF SIMPGO 07570000
THEN BEGIN 07571000
GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000
STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000
STMT ; GO TO EXIT END END ; 07574000
EMITLNG; GOGEN(T1,BFC); 07575000
GO EXIT END; 07576000
T1 ~ BUMPL; STMT; 07577000
IF ELCLASS ! ELSEV THEN 07578000
BEGIN DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000
STEPIT; 07580000
IF SIMPGO 07581000
THEN BEGIN 07582000
T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000
STEPIT; GO EXIT END; 07584000
T2 ~ BUMPL; CONSTANTCLEAN; 07585000
EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000
EXIT: END IFSTMT; 07587000
COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000
ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000
AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000
UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 07591000
IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 07592000
PROCEDURE LABELR; 07593000
BEGIN LABEL EXIT, ROUND; 07594000
DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000
=GT4#,NEXTLINK=GT5#; 07596000
DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000
BEGIN ERR(133); GO TO EXIT END; 07598000
XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION %116-07598100
% WHEN WE GET AROUND TO THE XREF. %116-07598200
IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000
THEN BEGIN FLAG(134); GO TO ROUND END; 07600000
LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD))) 07601000
.[36:12]; 07602000
IF ADDITIONAL < 0 THEN 07603000
BEGIN FLAG(135); GO TO ROUND END; 07604000
WHILE LINK ! 0 07605000
DO BEGIN 07606000
NEXTLINK ~ GET(LINK-2); 07607000
EMITB(GET(LINK-1),LINK,L); 07608000
LINK ~ NEXTLINK; 07609000
IF LASTENTRY } 126 THEN % DONT LET EMITNUM DO IT 07609100
BEGIN REAL C; % HOLD L FOR A WHILE 07609200
COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300
(>1023 WORD) FORWARD REFERENCES TO A LABEL;07609400
C ~ BUMPL; 07609500
CONSTANTCLEAN; 07609600
EMITB(BFW,C,L) END;END; 07609700
PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000
IF ELBATWORD < 0 07611000
THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000
OR MONITOR DECLARATION; 07613000
IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000
THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000
LABELS; 07616000
EMITO(MKS); PASSALPHA(ELBATWORD); 07617000
EMITPAIR(GNAT(CHARI),LOD); 07618000
PASSMONFILE(RR1); %109-07619000
EMITNUM(0&CARDNUMBER[1:4:44]); %109-07619100
EMITV(GNAT(PRINTI)); 07620000
END; 07621000
IF RR1~ADDITIONAL.DUMPEE ! 0 07622000
THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000
LABEL COUNTER; 07624000
EMITV(RR1); EMITL(1); EMITO(ADD); 07625000
EMITPAIR (RR1,STD); 07626000
IF RR1~ADDITIONAL.DUMPOR ! 0 07627000
THEN BEGIN COMMENT EMIT CODE TO CALL 07628000
THE DUMP ROUTINE; 07629000
07630000
07631000
07632000
STUFFF(RR1); EMITO07633000
(XCH);EMITO(COC); 07634000
07635000
07636000
07637000
07638000
07639000
07640000
EMITO(DEL); 07641000
END; 07642000
END; 07643000
END; 07644000
ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000
EXIT: END LABELR; 07646000
PROCEDURE CASESTMT; 07646100
BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110
CASE <ARITH EXP> OF BEGIN <COMPOUND TAIL> 07646120
AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130
IN THE <COMPOUND TALE>, DEPENDING ON THE VALUE OF THE <ARITH EXP>, 07646140
ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150
THE <COMPOUND TAIL>. IF THERE ARE N STATEMENTS IN THE 07646160
<COMPOUND TAIL>, THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1. 07646170
AND THE <ARITH EXP> 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 <COMPOUND TAIL> MAY BE ANY EXECUTABLE 07646200
STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210
AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220
<ARITH EXP> 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 <ARITH EXP> 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 ELCLASS!STRING AND(ELCLASS!STRNGCON OR BOO) THEN07669500
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 STEPI<BOOARRAYID OR ELCLASS>INTARRAYID THEN 07684500
BEGIN 07685000
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07685500
MAKEALABEL ELSE ERROR(300); % NO ARRAY ID. 07686000
GO EXIT; 07686500
END; 07687000
VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN FLAG(304); % NOT ARR. ROW. 07687500
XMARK(ASSIGNREF); % FILL STATEMENT %116-07687600
IF ELCLASS!WITHV THEN 07688000
BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500
STREAMTOG:=TRUE; 07689000
IF TABLE(I+1){IDMAX THEN 07689500
IF Q="7INQUI" THEN 07690000
BEGIN 07690500
STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000
EMITPAIR(9,COM); EMITO(DEL); 07691500
GO EXIT; 07692000
END; 07692500
EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000
IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500
MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000
BUILDLINE:=BOOLEAN(2|REAL(BUILDLINE)) ; 07694500
IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000
ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500
ELSE BEGIN 07696000
FOR J:=0 STEP 32 UNTIL T DO 07696500
MOVE(32,FILLTEMP[J],EDOC[J.[38:3],J.[41:7]]); 07697000
SEGMENT(T,SGAVL,SGNO); 07697500
END; 07698000
MOVECODE(TEDOC,EDOC); STREAMTOG:=FALSE; 07698500
BUILDLINE:=BUILDLINE.[46:1] ; SGAVL:=SGAVL+1; 07699000
EXIT: 07699500
END FILLSTMT; 07700000
COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000
CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000
WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000
AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000
PROCEDURE STMT ; 07714000
BEGIN 07715000
LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000
LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000
LGO, LRELSE, LBEG, LBRK, EXIT; 07718000
SWITCH S ~ 07719000
LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000
LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000
LVAR, 07722000
LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000
LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000
LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000
EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000
LRELSE,LBEG; 07727000
COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010
CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020
GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030
ADDRESSING IS NOT POSSIBLE; 07727040
IF LASTENTRY !0 THEN 07727050
BEGIN GT2 ~ INFO [0,255]; 07727055
DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060
IF L- GT1 > 400 THEN 07727065
BEGIN GT1 ~ BUMPL; 07727070
CONSTANTCLEAN; 07727075
EMITB(BFW, GT1,L); 07727080
END; 07727085
END; 07727090
STACKCT ~ 0; %A 07727100
AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000
IF ELCLASS = 0 THEN 07728500
BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000
IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100
IF ELCLASS=FILEID OR ELCLASS=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) = ENDV AND MODE > 0 07732000
THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000
I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000
ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000
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 COMPOUNDTAIL; 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 STEPI<BOOARRAYID OR ELCLASS>INTARRAYID THEN 07834000
GO TO E; 07835000
XMARK(ASSIGNREF); % SEARCH STATEMENT %116-07835500
VARIABLE(FL); 07836000
IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000
IF ELCLASS!RTPAREN THEN 07838000
BEGIN ERR(104); GO TO XXX END; 07839000
EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000
STEPIT; GO TO XXX; 07841000
END ELSE 07842000
IF Q="4SEEK0" THEN 07843000
BEGIN IF STEPI!LEFTPAREN THEN 07844000
BEGIN ERR(105); GO TO XXX; END; 07845000
IF STEPI!FILEID AND ELCLASS!SUPERFILEID THEN 07846000
GO TO E ELSE 07847000
BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000
IF ELCLASS!LEFTPAREN THEN 07849000
BEGIN ERR(105); GO TO XXX; END; 07850000
STEPIT; AEXP; EMITO(XCH); 07851000
IF ELCLASS!RTPAREN THEN 07852000
BEGIN ERR(104); GO TO XXX; END; 07853000
IF STEPI!RTPAREN THEN 07854000
BEGIN ERR(104); GO TO XXX; END; 07855000
EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000
EMITO(DEL); EMITO(DEL); STEPIT; 07857000
END; GO TO XXX; 07858000
END ELSE 07859000
IF Q="6UNLOC" THEN 07859010
BEGIN IF STEPI!LEFTPAREN THEN 07859020
BEGIN ERR(105); GO TO XXX END; 07859030
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
$ POP OMIT % [NOT IN ORIGINAL LISTING] 07899000
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"<FAULTYPE>~" 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.LVL<LEVEL OR FAULTOG.[46:1])[46:47:1]; 07926100
END FAULTSTMT NOW WASNT THAT SIMPLE; 07927000
PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
BEGIN COMMENT KLUDGE HANDLES ARRAY-ROW READS AND WRITES FOR 07931000
THOSE CASES WHICH DO NOT NEED TO GO THROUGH THE 07932000
FORMATTING INTRINSICS. A NEW MCP INTRINSIC IS 07933000
USED, TO FURTHER IMPROVE SPEED/DECREASE CORE USE; 07934000
LABEL EXIT; 07935000
L ~ ABS(T); 07936000
AEXP; 07937000
IF ELCLASS!COMMA THEN BEGIN ERR(426); GO TO EXIT; END; 07938000
IF STEPI<BOOARRAYID OR ELCLASS>INTARRAYID 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; 08038100
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(OPDC); 08108000
COMMENT FETCH INDEX; 08109000
IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END 08110000
ELSE REGO ~ I; 08111000
IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND 08112000
(STEPI = UNTILV OR ELCLASS = WHILEV) 08113000
THEN BEGIN 08114000
COMMENT WE HAVE A SIMPLE STEP FUNCTION; 08115000
PLUG(CONSTANB ,B); 08116000
END ELSE BEGIN 08117000
COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 08118000
SUBROUTINE; 08119000
I ~ IF I < 4 THEN 0 ELSE REGO; STEPIT; 08120000
SIGNB ~ CONSTANB ~ FALSE; 08121000
EMIT(0); B ~ L; 08122000
AEXP; EMITO(XCH); 08123000
BRET ~ L; 08124000
EMITO(BFW) END; 08125000
EMITO(REAL(SIGNB)|32+ADD); 08126000
EMITB(BFW,BACKFIX,L); 08127000
IF ELCLASS = UNTILV 08128000
THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000
STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000
STEPIT; AEXP; TEST END 08131000
ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000
IF ELCLASS ! WHILEV THEN 08133000
BEGIN ERR(153); GO TO EXIT END; 08134000
STEPIT; STORE(FALSE); BEXP END END 08135000
ELSE BEGIN 08136000
COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000
STORE(FALSE); 08138000
IF ELCLASS = WHILEV 08139000
THEN BEGIN 08140000
COMMENT WE HAVE A WHILE ELEMENT; 08141000
STEPIT; BEXP END 08142000
ELSE BEGIN 08143000
COMMENT ONE EXPRESSION ELEMENT; 08144000
IF ELCLASS ! COMMA THEN BEGIN 08145000
EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END 08146000
ELSE BACKFIX ~ L + 2; 08147000
L ~ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000
COMMENT THIS IS THE COMMON POINT; 08149000
IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000
EMIT(BFC); 08151000
BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000
IF ELCLASS = COMMA 08153000
THEN BEGIN 08154000
STEPIT; 08155000
FORLIST(TRUE); 08156000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000
ELSE BEGIN 08158000
IF ELCLASS ! DOV 08159000
THEN BEGIN ERR(154); REGO~L; GO EXIT END; 08160000
STEPIT; 08161000
IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000
IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000
08164000
IF NUMLE THEN BEGIN 08165000
EMITV(RETURNSTORE ~ FOOT); EMITO(BBW) END 08166000
ELSE BEGIN 08167000
EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000
STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000
CONSTANTCLEAN; REGO ~ L; 08170000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000
EXIT: END FORLIST; 08172000
REAL T1,T2,T3,T4; 08173000
NXTELBT ~ 1; I ~ 0; 08174000
STEPIT; 08175000
IF SIMPI(VRET~ELBAT[I]) 08176000
THEN BEGIN 08177000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000
XMARK(ASSIGNREF); % FOR STATEMENT %116-08178100
T1 ~ L; IF FORMALV THEN EMITN(ADDRES); 08179000
K ~ 0; 08180000
IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000
IF FORCLASS(STEPV) THEN 08182000
IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000
IF FORCLASS(UNTILV) THEN 08184000
IF SIMPLE(CONSTANC,Q,SIGNC) THEN 08185000
IF FORCLASS(DOV) THEN 08186000
BEGIN 08187000
PLUG(CONSTANA,A); 08188000
IF SIGNA THEN EMITO(CHS); 08189000
RETURNSTORE ~ BUMPL; ADJUST; CONSTANTCLEAN; 08190000
STMTSTART ~ L; 08191000
STEPIT; 08192000
T1 ~ ((((4096 | RETURNSTORE+STMTSTART)|2+ 08193000
REAL(CONSTANB))|2+ 08194000
REAL(CONSTANC))|2+ 08195000
REAL(SIGNB))|2+ 08196000
REAL(SIGNC); 08197000
T2 ~ VRET; 08198000
T3 ~ B; 08199000
T4 ~ Q; 08200000
IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000
SIGNC ~ BOOLEAN(T1.[47:1]); 08202000
SIGNB ~ BOOLEAN(T1.[46:1]); 08203000
CONSTANC ~ BOOLEAN(T1.[45:1]); 08204000
CONSTANB ~ BOOLEAN(T1.[44:1]); 08205000
STMTSTART ~ T1.[32:12]; 08206000
RETURNSTORE ~ T1.[20:12]; 08207000
VRET ~ T2; 08208000
B ~ T3; 08209000
Q ~ T4; 08210000
SIMPLEV~ SIMPI(VRET); 08211000
IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000
PLUG(CONSTANB,B); 08213000
EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000
EMITB(BFW,RETURNSTORE,L); 08215000
STORE(TRUE); 08216000
IF FORMALV THEN CALL(OPDC); 08217000
PLUG(CONSTANC,Q); 08218000
IF SIGNC THEN EMITO(CHS); 08219000
SIMPLEB ~ TRUE; TEST; EMITLNG; 08220000
EMITB(BBC,BUMPL,STMTSTART); 08221000
GO TO EXIT END; 08222000
I ~ 2; K ~ 0; 08223000
SIMPLEV ~ SIMPI(VRET); 08224000
V ~ T1 END 08225000
ELSE BEGIN 08226000
EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000
VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000
IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000
END; 08230000
STEPIT; FORLIST(FALSE); L ~ REGO; 08231000
EXIT: K ~ 0 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
<DIRECTION INDICATOR>::=REVERSE/<EMPTY> 08303000
<FILE PART>::=<FILE IDENTIFIER>/<SUPERFILE DESIGNATOR> 08304000
<RELEASE INDICATOR>::=[NO]/<EMPTY> 08305000
<ACTION LABELS>::=[<END OF FILE LABEL>:<PARITY LABEL>]/ 08306000
[<END OF FILE LABEL>]/[:<PARITY LABEL>]/08307000
<EMPTY> 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<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>) 08331000
<ACTION LABELS> 08332000
- - - - - - - - - - - - - - 08333000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000
,PARITY LABEL) 08335000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08337000
<FORMAT PART>)<ACTION LABELS> 08338000
- - - - - - - - - - - - - - 08339000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000
ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000
SPACE(<FILE PART>,<ARITHMETIC EXPRESSION>)<ACTION LABELS> 08343000
- - - - - - - - - - - - - - 08344000
(CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000
PARITY LABEL) 08346000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08348000
<FORMAT PART>,<LIST>)<ACTION LABELS> 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<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08355000
*,<LIST>)<ACTION LABELS> 08356000
- - - - - - - - - - - - - - 08357000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000
DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08361000
<ARITHMETIC EXPRESSION>,<ROW DESIGNATOR>)<ACTION 08362000
LABELS> 08363000
- - - - - - - - - - - - - - 08364000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000
END OF FILE LABEL,PARITY LABEL) 08366000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08368000
<MULTIPLYING OPERATOR>,<LIST>)<ACTION LABELS> 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
MAYI ~ TRUE; HOLD ~ L; 08401045
EMIT(11); EMIT(4); EMITO(280); 08401050
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060
EMITO(XCH); EMITL(0); EMITL(1); 08401070
END ELSE 08401080
BEGIN 08401090
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000
IF NOT RANGE(FILEID,SUPERFILEID) 08403000
THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000
STATEMENT; 08405000
ERR(422); GO TO EXIT; 08406000
END; 08407000
PASSFILE; 08408000
IF ELCLASS = LFTBRKET 08409000
THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,<AEXP>], 08410000
%%% [*],[*,*],[*,<AEXP>],[<AEXP>],[<AEXP>,*], 08410010
%%% AND [<AEXP>,<AEXP>]. THE FIRST (LEFTMOST) 08410020
%%% <AEXP> IS THE READSEEKDISTADDRESS, RESIDING 08410030
%%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000
%%% <AEXP> 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
FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090
% BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091
% ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092
% THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093
17 08493094
,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095
,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096
,"4SAVE0" 08493097
,"8OTHER" % "OTHERUSE". 08493098
,"404MFID0" 08493099
,"403FID00" 08493100
,"4REEL0" 08493101
,"4DATE0" 08493102
,"5CYCLE" 08493103
,"4TYPE0" 08493104
,"5AREAS" 08493105
,"8AREAS" % "AREASIZE". 08493106
,"2EU000" 08493107
,"5SPEED" 08493108
,"9TIMEL" % "TIMELIMIT" 08493109
,"+08IOSTA" % "IOSTATUS" 08493110
,"9SENSI" % "SENSITIVE" 08493111
% THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120
; % END OF FILL STATEMENT. 08493130
I~FILEATTRIBUTES[0] ; 08493140
END ; 08493150
FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160
BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170
EXIT: 08493180
END OF FILEATTRIBUTEINDX ; 08493190
COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200
A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210
1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220
FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230
AND XIT. 08493240
2. ACTUALPARAPART: 08493250
PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260
ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270
THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280
3. PRIMARY: 08493290
PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300
IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310
ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320
THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330
TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340
IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350
ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360
ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370
FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380
(ATYPE OR BTYPE). 08493390
4. BOOPRIM: 08493400
PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410
5. IODEC: 08493420
PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430
HAVE ALREADY BEEN EMITTED, THE ATTRIBUTEINDX IS 08493440
DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450
END OF COMMENT ; 08493460
INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470
BEGIN 08493480
REAL ATTRIBUTEINDX ; 08493490
BOOLEAN ASSOP ; 08493500
LABEL DONESOME,DONEMORE,EXIT ; 08493510
IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520
BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530
EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540
GO TO DONEMORE ; 08493550
END ; 08493560
EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570
IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580
BEGIN 08493590
DONESOME: 08493600
IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610
BEGIN 08493620
STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625
IF STEPI=LFTBRKET THEN 08493630
BEGIN 08493640
STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650
END 08493660
ELSE EMITL(0) ; 08493670
EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675
IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680
BEGIN 08493700
IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705
DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710
THEN FLAG(293) ; 08493720
STEPIT ; 08493730
IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740
THEN BEXP ELSE AEXP ; 08493750
END 08493760
ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770
ELSE EMITL(0) ; 08493780
EMITNUM(IF ATTRIBUTEINDX= 1 THEN "6ACCESS" ELSE 08493790
IF ATTRIBUTEINDX= 4 THEN "6OTHRUS" ELSE 08493795
IF ATTRIBUTEINDX=12 THEN "6ARASIZ" ELSE 08493800
IF ATTRIBUTEINDX=15 THEN "6TIMLMT" ELSE 08493805
IF ATTRIBUTEINDX=16 THEN "6IOSTAT" ELSE 08493810
IF ATTRIBUTEINDX=17 THEN "6SNSTIV" ELSE 08493812
0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820
& FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830
EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840
& REAL(ASSOP)[38:47:1]) ; 08493850
EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860
FILEATTRIBUTEHANDLER~ 08493870
IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880
THEN BTYPE ELSE ATYPE ; 08493890
END ; 08493900
END ; 08493910
EXIT: 08493920
END OF FILEATTRIBUTEHANDLER ; 08493930
PROCEDURE SPACESTMT; 08494000
BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000
SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000
FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000
PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000
FOR THE READ STATEMENT; 08499000
LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000
EXECUTABLE STATEMENT IN SPACESTMT; 08501000
STEPIT; 08502000
IF CHECK(LEFTPAREN,434) 08503000
THEN GO TO EXIT; 08504000
COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000
SPACE STATEMENT; 08506000
STEPIT; 08507000
IF NOT RANGE(FILEID,SUPERFILEID) 08508000
THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000
IDENTIFIER IN SPACE STATEMENT; 08510000
ERROR(435); GO TO EXIT; 08511000
END; 08512000
EMITO(MKS); 08513000
EMITPAIR(GNAT( 08514000
POWERSOFTEN),LOD); PASSFILE; 08515000
EMITL(0); 08515100
IF CHECK(COMMA,436) 08516000
THEN GO TO EXIT; 08517000
COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000
STEPIT; AEXP; 08519000
IF CHECK(RTPAREN,437) 08520000
THEN GO TO EXIT; 08521000
COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000
SPACE STATEMENT; 08523000
EMITL(0); EMITL(0); EMITL(1); 08524000
HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000
EXIT:; 08526000
END SPACESTMT; 08527000
PROCEDURE WRITESTMT; 08528000
BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000
INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000
DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000
I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000
WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000
ARE PASSED TO INTERPTO. 08534000
**********************************************************08535000
FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000
UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000
READSTMT ROUTINE. 08538000
<CARRIAGE CONTROL>::= [DBL]/[PAGE]/[NO]/<ARITHMETIC 08539000
EXPRESSION>/<EMPTY> 08540000
CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000
TO CIMI FOR INPUT. 08542000
<CARRIAGE> <EMPTY> [DBL] [PAGE] [NO] <ARITHMETIC EXP> 08543000
CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000
LINESKIP 1 2 4 8 0 08545000
WRITE(<FILE PART><CARRIAGE CONTROLS>)/ 08546000
- - - - - - - - - - - - - - 08547000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000
WRITE(<FILE PART><CARRIAGE CONTROL>,<FORMAT PART>)/ 08550000
- - - - - - - - - - - - - - 08551000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000
INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000
WRITE(<FILE PART><CARRIAGE CONTROL>,<FORMAT PART>,<LIST>)/08555000
- - - - - - - - - - - - - - 08556000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000
INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000
WRITE(<FILE PART><CARRIAGE CONTROL>,*,<LIST>)/ 08560000
- - - - - - - - - - - - - - 08561000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000
ROUTINE DESCRIPTOR) 08563000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000
WRITE(<FILE PART>(CARRIAGE CONTROL>,<ARITHMETIC EXPRESSION08565000
>,<ROW DESIGNATOR>) 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,<AEXP>],[*],[*,*],[*,<AEXP>],[<AEXP>],[<AEXP>,*] 08619010
%%% AND [<AEXP>,<AEXP>], WHERE DPN IN STOP, DBL, PAGE, OR 08619020
%%% NO. THE FIRST (LEFTMOST) <AEXP> IS THE CHANNELSKIP, 08619030
%%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND <AEXP> 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 STATEMENT>::=LOCK(<FILE PART>,SAVE)/ 08706000
- - - - - - - - - - - - - - 08707000
(2,0,FILE,4) 08708000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000
LOCK(<FILE PART>,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 STATEMENT>::=CLOSE(<FILE PART>,SAVE)/ 08761000
- - - - - - - - - - - - - - 08762000
(3,0,FILE,4) 08763000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000
CLOSE(<FILE PART>,RELEASE)/ 08765000
- - - - - - - - - - - - - - 08766000
(7,0,FILE,4) 08767000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000
CLOSE(<FILE PART>,*) 08769000
- - - - - - - - - - - - - - 08770000
(1,0,FILE,4) 08771000
<CLOSE STATEMENT> ::= CLOSE(<FILE PART>, 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 STATEMENT>::=REWIND(<FILE PART>) 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
<AEXP> 0 DISK SIZE,IF SPECIFIED 08864000
<AEXP> 0 CORE SIZE,IF SPECIFIED 08865000
0 0 ALFA FLAG 08866000
<AEXP> <AEXP> 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
FILER~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000
EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000
IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000
EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000
AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000
FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000
BEGIN STEPIT; PASSFILE END; 08920000
FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000
IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000
EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000
IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000
EMIT(0); EMIT(0); EMIT(0); 08925000
QUIT: EMITV(GNAT(SORTI)); 08926000
END MERGESTMT; 08927000
PROCEDURE SORTSTMT; 08928000
BEGIN BOOLEAN INPRO,OUTPRO; 08929000
INTEGER A,J; 08930000
LABEL QUIT; DEFINE RDS=1,280#; 08931000
STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000
VALUE FN, SFN ; 08933000
BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000
SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000
DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000
DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000
DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000
END STUFFILE; 08939000
BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000
IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000
IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100
IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000
IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000
INPROCHECK~TRUE; 08944000
IF SFILENO=0 THEN 08945000
BEGIN SFILENO~FILENO; 08946000
FOR J~1 STEP 1 UNTIL 7 DO 08947000
IF MKABS(IDARRAY[127])<IDLOC.[33:15]+3 THEN FLAG(40) ELSE 08948000
BEGIN STUFFILE(IDLOC,(IF J{2 THEN 12 ELSE 2)&FILENO 08949000
[30:36:12],J); 08950000
FILENO~FILENO+1; 08951000
END; END; 08952000
EMITO(MKS); EMITV(BLOCKCTR); EMITPAIR(1,ADD); 08953000
EMITPAIR(BLOCKCTR,STD); EMIT(0); EMIT(0); 08954000
EMITN(2); EMITPAIR(RDS); EMITPAIR(A~GNAT(SORTA),STD); 08955000
EMITO(MKS); EMITL(20); EMITL(1000); EMITL(3); EMITL(SFILENO); 08956000
EMIT(0); EMITO(LNG); EMITN(A); EMITO(INX); EMITL(2); 08957000
EMITL(1); EMITL(10); EMIT(0); EMIT(0); EMITL(10); 08958000
EMITL(8); EMITV(5); 08959000
EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); 08964000
EMITL(GNAT(MERGEI)); EMIT(0); EMIT(0); EMIT(0); STEPIT; 08965000
IF CHECK(LEFTPAREN,355) THEN GO QUIT; 08966000
% OUTPUT OPTION. 08966500
IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 08967000
BEGIN EMIT(0); PASSFILE; I~I-1 END ELSE 08968000
BEGIN IF NOT(OUTPRO~OUTPROCHECK(ELBAT[I]))THEN GO QUIT; 08969000
EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITL(A);EMITN(10) 08970000
END; 08971000
IF NOT COMMACHECK THEN GO QUIT; 08972000
% INPUT OPTION. 08972500
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 08973000
BEGIN EMITPAIR(0,XCH); PASSFILE; I~I-1 END ELSE 08974000
IF NOT(INPRO~INPROCHECK(ELBAT[I])) THEN GO QUIT ELSE 08975000
BEGIN EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITO(XCH); 08976000
IF OUTPRO THEN EMITO(DUP) ELSE BEGIN EMITL(A); 08977000
EMITN(10) END; END INPUT PRO; 08978000
EMITL(REAL(OUTPRO)); EMITL(REAL(INPRO)); EMIT(0); 08979000
EMITO(LNG); EMITN(A); EMITO(INX); EMITO(LOD); 08980000
EMITPAIR(5,CDC); EMIT(0); 08981000
IF NOT COMMACHECK THEN GO QUIT; 08983000
% NUMBER OF TAPES. 08983500
EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); 08984000
EMITO(MKS); EMITN(A); EMITL(SFILENO+2); AEXP; I~I-1; 08985000
EMITL(14); EMITV(5); 08986000
IF NOT COMMACHECK THEN GO QUIT; 08987000
% HIVALUE PROCEDURE. 08987500
IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08988000
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08989000
IF NOT COMMACHECK THEN GO QUIT; 08990000
% COMPARE PROCEDURE. 08990500
IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08991000
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08992000
% RECORD LENGTH. 08992500
IF NOT COMMACHECK THEN GO QUIT; AEXP; EMITO(SSN); 08993000
EMIT(0); EMITPAIR(A,SND); 08993500
% CORE SIZE. 08993900
IF ELCLASS=COMMA THEN 08994000
BEGIN 08994010
STEPIT; 08994020
CORESZ:= 08994030
MAX(IF ELCLASS=NONLITNO THEN C ELSE 12000,CORESZ); 08994040
AEXP; 08994060
END 08994070
ELSE IF ELCLASS=RTPAREN THEN 08994080
BEGIN 08994090
IF CORESZ<1023 THEN CORESZ:=12000; 08994500
EMIT(0); 08994510
END 08994520
ELSE ERR(366); 08994530
% DISK SIZE. 08994900
IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08995000
IF ELCLASS=RTPAREN THEN EMIT(0) ELSE ERR(366); 08995500
IF ELCLASS!RTPAREN THEN ERR(366) ELSE STEPIT; 08996000
QUIT: EMITV(GNAT(SORTI)); 08997000
END SORTSTMT; 08998000
COMMENT THE PROGRAM ROUTINE DOES THE INITIALIZATION AND THE WRAPUP 09000000
FOR THE REST OF THE COMPILER. THE MAIN PROGRAM OF THE COMPILER09001000
IS SIMPLY A CALL ON THE PROGRAM ROUTINE; 09002000
PROCEDURE PROGRAM; 09003000
BEGIN 09004000
STREAM PROCEDURE MDESC(WD,TOLOC);VALUE WD; 09005000
BEGIN DI~LOC WD; DS~ SET;SI~ LOC WD; DI~TOLOC;DS~WDS END; 09006000
COMMENT THE FOLLOWING PROCEDURE PRINTS OUT THE PRT, NAME, AND 09007000
SEGMENT NUMBER OF THE INTRINSIC PROCEDURES USED IN THE 09008000
OBJECT PROGRAM; 09009000
STREAM PROCEDURE WRTINTRSC(SGNO,ALFA,PRT,FIL); 09010000
VALUE SGNO,PRT; 09011000
BEGIN LOCAL COUNT,DEST; 09012000
DI:=FIL; DS:=4 LIT"PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 09013000
3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 09014000
BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 09015000
COUNT:=TALLY; DS:=COUNT CHR; DS:=4 LIT") = "; 09016000
SI:=ALFA; SI:=SI+2; DEST:=DI; % SAVE DI. 09017000
DI:=LOC COUNT; DS:=7 LIT"0"; DS:=CHR; % NO OF CHARS IN NAME. 09018000
DI:=DEST; DS:=COUNT CHR; % INT. NAME. 09019000
DS:=29 LIT" INTRINSIC, SEGMENT NUMBER = "; 09020000
SI:= LOC SGNO; DS:=4 DEC; DS:=LIT"."; 09021000
DI:=DI-5; DS:=4 FILL; % JUNK LEADING BLANKS. 09022000
END WRTINTRSC; 09023000
DEFINE STARTINTRSC=426#; 09024000
LABEL L1; 09025000
IDLOC~MKABS(IDARRAY[0]); 09026000
IDLOCTEMP ~ IDLOC; 09027000
FILL OPTIONS[*] WITH "5CHECK",0, % 0, 1 09027002
"6DEBUG",0, % 2, 3 09027004
"4DECK0",0, % 4, 5 09027006
"6FORMA",0, % 6, 7 09027008
"9INTRI",0, % 8, 9 09027010
"5LISTA",0, % 10, 11 09027012
"4LIST0",0, % 12, 13 09027014
"5LISTP",0, % 14, 15 09027016
"3MCP00",0, % 16, 17 09027018
"4TAPE0",0, % 18, 19 09027020
"4NEST0",0, % 20, 21 09027022
"3NEW00",0, % 22, 23 09027024
"7NEWIN",0, % 24, 25 09027026
"4OMIT0",0, % 26, 27 09027028
"1$0000",0, % 28, 29 09027030
"3PRT00",0, % 30, 31 09027032
"5PUNCH",0, % 32, 33 09027034
"5PURGE",0, % 34, 35 09027036
"4SEGS0",0, % 36, 37 09027038
"3SEQ00",0, % 38, 39 09027040
"6SEQER",0, % 40, 41 09027042
"6SINGL",0, % 42, 43 09027044
"5STUFF",0, % 44, 45 09027046
"4VOID0",0, % 46, 47 09027048
"5VOIDT",0, % 48, 49 09027050
"4BEND0",0, % 50, 51 09027052
"4XREF0",0, % 52, 53 09027054
"7INCLU",0, % 54,55 %107-09027056
"8CODEF",0, % 56,57 %106-09027058
0; 09027100
LISTOG:=LISTER:=BOOLEAN(1-ERRORCOUNT.[46:1]); 09028000
OPTIONS[13] := REAL(LISTER); 09028005
COMMENT LISTOG IS NOT SET BY DEFAULT ON TIMESHARING; 09028010
NOHEADING := TRUE; 09028050
BUILDLINE.[47:1]~SEQXEQTOG~REMOTOG~ 09028100
BOOLEAN(ERRORCOUNT.[47:1]); 09028150
ERRORCOUNT := 0; 09028900
ERRMAX:=999; % MAY BE CHANGED IN DOLLARCARD. 09028910
BASENUM:=10000; ADDVALUE:=1000; NEWBASE:=TRUE; 09028920
COMMENT DEFAULT VALUES FOR "$SEQ" OPTION; 09028930
LASTUSED := 4; % FOR INITIALIZATION. 09029000
SGNO~1;SGAVL~2;PDINX~0; 09030000
FILENO:=DA:=1; 09031000
FILETHING ~ 4095; 09031100
MAXSTACK ~ 513; 09032000
NEXTINFO ~ LASTINFO ~ LASTSEQROW|256+LASTSEQUENCE+1; 09033000
PUTNBUMP(0); 09034000
BLANKET(0,INFO[LASTSEQROW,LASTSEQUENCE]); % FOR "$ CHECK".09034500
READACARD; % INITIALIZATION OF NCR,FCR, AND LCR, AND 09035000
% READS FIRST CARD INTO CARD BUFFER. 09036000
LASTUSED := 1; % ASSUMES CARD ONLY UNTIL TOLD DIFFERENTLY.09037000
NXTELBT~1; FAULTLEVEL~32; 09038000
PRTI ~ PRTIMAX ~ 18; 09039000
MRCLEAN ~ TRUE; 09040000
COMMENT START FILLING TABLES NEEDED TO COMPILE A PROGRAM; 09040100
FILL TEN[*] WITH 09041000
09042000
09043000
09044000
09045000
09046000
09047000
09048000
09049000
09050000
09051000
09052000
09053000
09054000
09055000
09056000
OCT1141000000000000, OCT1131200000000000, 09057000
OCT1121440000000000, OCT1111750000000000, OCT1102342000000000, 09058000
OCT1073032400000000, OCT1063641100000000, OCT1054611320000000, 09059000
OCT1045753604000000, OCT1037346545000000, OCT1011124027620000, 09060000
OCT0001351035564000, OCT0011643245121000, OCT0022214116345200,09061000
OCT0032657142036440, OCT0043432772446150, OCT0054341571157602,09062000
OCT0065432127413543, OCT0076740555316473, OCT0111053071060221,09063000
OCT0121265707274266, OCT0131543271153343, OCT0142074147406234, 09064000
OCT0152513201307703, OCT0163236041571663, OCT0174105452130240, 09065000
OCT0205126764556310, OCT0216354561711772, OCT0231004771627437, 09066000
OCT0241206170175347, OCT0251447626234641, OCT0261761573704011, 09067000
OCT0272356132665013, OCT0303051561442216, OCT0313664115752661, 09068000
OCT0324641141345435, OCT0336011371636745, OCT0347413670206536, 09069000
OCT0361131664625027, OCT0371360241772234, OCT0401654312370703, 09070000
OCT0412227375067064, OCT0422675274304701, OCT0433454553366062, 09071000
OCT0444367706263476, OCT0455465667740415, OCT0467003245730521, 09072000
OCT0501060411731665, OCT0511274514320242, OCT0521553637404312, 09073000
OCT0532106607305375, OCT0542530351166674, OCT0553256443424453, 09074000
OCT0564132154331566, OCT0575160607420123, OCT0606414751324150, 09075000
OCT0621012014361120, OCT0631214417455344, OCT0641457523370635, 09076000
OCT0651773450267005, OCT0662372362344606, OCT0673071057035747, 09077000
OCT0703707272645341, OCT0714671151416632, OCT0726047403722400, 09078000
OCT0737461304707100, OCT0751137556607072, OCT0761367512350710, 09079000
OCT0771665435043073; 09080000
COMMENT THIS IS THE FILL FOR THE SECOND ROW OF INFO: 09081000
THE FIRST ITEMS ARE STREAM RESERVED WORDS, 09082000
THEN ORDINARY RESERVED WORDS, 09083000
THEN INTRINSIC FUNCTIONS; 09084000
FILL INFO[1,*] WITH 09085000
OCT0670000600000400, "2SI000", COMMENT 256;09086000
OCT0700001040000402, "2DI000", COMMENT 258;09087000
OCT0710001460000404, "2CI000", COMMENT 260;09088000
OCT0720001630000406, "5TALLY", COMMENT 262;09089000
OCT0730000530000410, "2DS000", COMMENT 264;09090000
OCT0740000150000412, "4SKIP0", COMMENT 266;09091000
OCT0750001620000414, "4JUMP0", COMMENT 268;09092000
OCT0760000740000416, "2DB000", COMMENT 270;09093000
OCT0770000500000420, "2SB000", COMMENT 272;09094000
OCT1010000730000422, "2SC000", COMMENT 274;09095000
OCT1020001160000424, "3LOC00", COMMENT 276;09096000
OCT1030001170000426, "2DC000", COMMENT 278;09097000
OCT1040001430000430, "5LOCAL", COMMENT 280;09098000
OCT1050000340000432, "3LIT00", COMMENT 282;09099000
OCT1060001036400434, "3SET00", COMMENT 284;09100000
OCT1060001066500436, "5RESET", COMMENT 286;09101000
OCT1060001020500440, "3WDS00", COMMENT 288;09102000
OCT1060001357700442, "3CHR00", COMMENT 290;09103000
OCT1060001057300444, "3ADD00", COMMENT 292;09104000
OCT1060001617200446, "3SUB00", COMMENT 294;09105000
OCT1060000727600450, "3ZON00", COMMENT 296;09106000
OCT1060000417500452, "3NUM00", COMMENT 298;09107000
OCT1060000766700454, "3OCT00", COMMENT 300;09108000
OCT1060000176600456, "3DEC00", COMMENT 302;09109000
OCT1004000260000460, "6TOGGL", "E0000000", COMMENT 304;09110000
OCT0430000050000000, "5ALPHA", COMMENT 307;09111000
OCT1330001030000000, "3AND00", COMMENT 309;09112000
OCT0430000170000525, "5ARRAY", COMMENT 311;09113000
OCT0660000000000000, "5BEGIN", COMMENT 313;09114000
OCT0430000030000503, "7BOOLE", "AN000000", COMMENT 315;09115000
OCT0470000000000000, "5CLOSE", COMMENT 318;09116000
OCT1070000000000655, "7COMME", "NT000000", COMMENT 320;09117000
OCT0430000230000000, "6DEFIN", "E0000000", COMMENT 323;09118000
OCT1360006000000000, "3DIV00", COMMENT 326;09119000
OCT0550000000000000, "2DO000", COMMENT 328;09120000
OCT0520000000000000, "6DOUBL", "E0000000", COMMENT 330;09121000
OCT0430000100000000, "4DUMP0", COMMENT 333;09122000
OCT0570000000000000, "4ELSE0", COMMENT 335;09123000
OCT0600000000000000, "3END00", COMMENT 337;09124000
OCT1300002030000000, "3EQV00", COMMENT 339;09125000
OCT0360000000000644, "5FALSE", COMMENT 341;09126000
OCT0430000210000000, "4FILE0", COMMENT 343;09127000
OCT0610000001200000, "4FILL0", %A 09128000
OCT0530000000000000, "3FOR00", COMMENT 347;09129000
OCT0430000200000554, "6FORMA", "T0000000", COMMENT 349;09130000
OCT1100000000000000, "7FORWA", "RD000000", COMMENT 352;09131000
OCT0640000000000604, "2GO000", COMMENT 355;09132000
OCT0630000000000000, "2IF000", COMMENT 357;09133000
OCT0430000130000000, "2IN000", COMMENT 359;09134000
OCT0430000060000000, "7INTEG", "ER000000", COMMENT 361;09135000
OCT1310000000000000, "3IMP00", COMMENT 364;09136000
OCT0430000070000000, "5LABEL", COMMENT 366;09137000
OCT0430000110000613, "4LIST0", COMMENT 368;09138000
OCT0500000000000000, "4LOCK0", COMMENT 370;09139000
OCT1360016000000000, "3MOD00", COMMENT 372;09140000
OCT0430000140000000, "7MONIT", "OR000000", COMMENT 374;09141000
OCT1250000000000000, "3NOT00", COMMENT 377;09142000
OCT1320000430000624, "2OR000", COMMENT 379;09143000
OCT0430000120000000, "3OUT00", COMMENT 381;09144000
OCT0430000010000476, "3OWN00", COMMENT 383;09145000
OCT0430000160000463, "9PROCE", "DURE0000", COMMENT 385;09146000
OCT0440000000000000, "4READ0", COMMENT 388;09147000
OCT0430000040000000, "4REAL0", COMMENT 390;09148000
OCT0650000000000000, "7RELEA", "SE000000", COMMENT 392;09149000
OCT0510000000000000, "6REWIN", "D0000000", COMMENT 395;09150000
OCT0430000020000773, "4SAVE0", COMMENT 398;09151000
OCT0460000000000000, "5SPACE", COMMENT 400;09152000
OCT1110000000000000, "4STEP0", COMMENT 402;09153000
OCT0430000220000000, "6STREA", "M0000000", COMMENT 404;09154000
OCT0430000150000562, "6SWITC", "H0000000", COMMENT 407;09155000
OCT1120000000000000, "4THEN0", COMMENT 410;09156000
OCT1130000000000000, "2TO000", COMMENT 412;09157000
OCT0360000010000000, "4TRUE0", COMMENT 414;09158000
OCT0560000000000000, "5UNTIL", COMMENT 416;09159000
OCT1140000000000000, "5VALUE", COMMENT 418;09160000
OCT0540000000000540, "5WHILE", COMMENT 420;09161000
OCT1150000000000000, "4WITH0", COMMENT 422;09162000
OCT0450000000000531, "5WRITE", COMMENT 424;09163000
OCT0130000000140673, "3ABS00", OCT0000000000700000,%426 09164000
OCT0130000000060000, "6ARCTA", "N0000000", OCT0000000001600000,%429;09165000
OCT0130000000040000, "3COS00", OCT0000000001500000,%433;09166000
OCT0130000000360000, "6ENTIE", "R0000000", OCT0000000001100000,%436 09167000
OCT0130000000040000, "3EXP00", OCT0000000002000000,%440;09168000
OCT0130000000040000, "2LN000", OCT0000000001700000,%443;09169000
OCT0130000000240000, "4SIGN0", OCT0000000001000000,%446 09170000
OCT0130000000040000, "3SIN00", OCT0000000001400000,%449;09171000
OCT0130000000040515, "4SQRT0", OCT0000000001300000,%452;09172000
OCT0130000000440000, "4TIME0", OCT0000000001200000,%455 09173000
OCT0140000000040000, "3ZIP00", 0, COMMENT 455;09174000
OCT0130000000060000, "9OUTPU", "T(W)0000", OCT0000000000100000,%461;09175000
OCT0130000050060000, ":BLOCK", " CONTROL", OCT0000000000200000,%465;09176000
OCT0130000000060000, "8INPUT", "(W)00000", OCT0000000000300000,%469;09177000
OCT0000000000060000, "4SORT0", 0, OCT0000000000400000,% 473 09178000
OCT0130000000040000, "4DUMP0", OCT0000000000500000,%477;09179000
OCT0130000000060000, "#X TO ", "THE I000", OCT0000000000600000,%480;09180000
OCT0130000000060000, ":GO TO", " SOLVER ", OCT0000000002100000,%484;09181000
OCT0130000140060000, ":ALGOL", " WRITE ", OCT0000000002200000,%488;09182000
OCT0130000150060000, ":ALGOL", " READ ", OCT0000000002300000,%492;09183000
OCT0130000160060000, ":ALGOL", " SELECT ", OCT0000000002400000,%496;09184000
OCT0000000000040000, "5MERGE", OCT0000000002700000,% 500 09184100
OCT0130000000560652, "6STATU", "S0000000", OCT0000000003000000,%503 09184200
OCT0130000000640000, "3MAX00", OCT0000000003100047,%507 09184300
OCT0430000240000000, "6AUXME", "M0000000"; %510 09185000
09185100
09186000
COMMENT THIS IS THE FILL FOR STACKHEAD; 09187000
FILL STACKHEAD[*] WITH 09188000
320,359,313,458,385, 0,337,347,383,361,379,412, 0, 0, 0,372, 09189000
355,309, 0, 0,368, 0,446, 0, 0,549,311,410, 0, 0,400, 0, 09190000
0, 0, 0, 0,503,315, 0, 0,330, 0, 0, 0, 0, 0, 0,440, 09191000
390,449,349, 0,414, 0, 0, 0,452, 0, 0, 0, 0, 0, 0, 0, 09192000
381,328, 0, 0, 0, 0, 0, 0, 0, 0, 0,436, 0,402,407, 0, 09193000
0, 0,377, 0, 0, 0,416,455,355, 0, 0,357, 0,552,374, 0, 09194000
0, 0,433, 0,418,398,343, 0, 0,326,339, 0, 0, 0,366, 0, 09195000
0, 0, 0, 0, 0,422, 0,392, 0, 0, 0,424, 0; 09196000
FILL SUPERSTACK[*] WITH %WF 09196100
0, 0,313, 0,307, 0,337,347,383, 0,379,412, 0, 0, 0,372, %WF 09196200
335,309, 0, 0, 0, 0, 0, 0, 0, 0,420,410, 0, 0, 0, 0, %WF 09196300
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %WF 09196400
390, 0,364, 0,414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %WF 09196500
0,328, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,402, 0, 0, %WF 09196600
0, 0,377, 0,510, 0,416, 0,355, 0, 0,357, 0, 0, 0, 0, 09196700
0, 0, 0, 0, 0,398, 0, 0, 0,326,339, 0, 0, 0,366, 0, %WF 09196800
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,424, 0; %WF 09196900
COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS; 09197000
FILL SPECIAL[*] WITH 09198000
OCT1200000000200000, COMMENT #; OCT0000000000100000, COMMENT @; 09199000
OCT0000000000000000, OCT1160000000120000, COMMENT :; 09200000
OCT1340000450002763, COMMENT >; 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", OCT0000000011100007,%660 09214425
OCT0130000260000000, "4FAST0", %663 09214426
OCT0130000270000000, "4SLOW0", %665 09214427
OCT0130000240000000, "7PROTE", "CT000000", %667 09214428
OCT2000000000004050, COMMENT POWERS OF TEN ; %670 09214430
OCT0430000250000000, "5FIELD", %671 09214432
0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %673 09214435
" " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %674 09214440
COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500
FOR NEXTINFO~512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510
,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,635, 09214515
639 STEP 3 UNTIL 660,663 STEP 2 UNTIL 667, 671 %117-09214516
DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], 09214520
LASTINFO~STACKHEAD[GT2]~NEXTINFO); 09214530
NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980
BUILDLINE.[45:1]~TRUE ; 09214985
PUTNBUMP(0); 09214990
FILL MACRO[*] WITH 09215000
OCT0131, COMMENT SFS A 00 ; 09216000
OCT0116, COMMENT SFD A 01 ; 09217000
OCT0000, COMMENT SYNTAX ERROR02 ; 09218000
OCT0140, COMMENT INC A 03 ; 09219000
OCT0130, COMMENT SRS A 04 ; 09220000
OCT0117, COMMENT SRD A 05 ; 09221000
OCT0000, COMMENT SYNTAX ERROR06 ; 09222000
OCT0000, COMMENT SYNTAX ERROR07 ; 09223000
OCT00310143, COMMENT CRF A, SFS 008 ; 09224000
OCT00160143, COMMENT CRF A, SFD 009 ; 09225000
OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000
OCT00400143, COMMENT CRF A, INC 011 ; 09227000
OCT00300143, COMMENT CRF A, SRS 012 ; 09228000
OCT00170143, COMMENT CRF A, SRD 013 ; 09229000
OCT0000, COMMENT SYNTAX ERROR14 ; 09230000
OCT0000, COMMENT SYNTAX ERROR15 ; 09231000
OCT0153, COMMENT RSA A 16 ; 09232000
OCT0104, COMMENT RDA A 17 ; 09233000
OCT0150, COMMENT RCA A 18 ; 09234000
OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000
OCT0122, COMMENT SES A 20 ; 09236000
OCT0106, COMMENT SED A 21 ; 09237000
OCT0000, COMMENT SYNTAX ERROR22 ; 09238000
OCT0000, COMMENT SYNTAX ERROR23 ; 09239000
OCT0056, COMMENT TSA 0 24 ; 09240000
OCT0000, COMMENT SYNTAX ERROR25 ; 09241000
OCT0000, COMMENT SYNTAX ERROR26 ; 09242000
OCT0000, COMMENT SYNTAX ERROR27 ; 09243000
OCT0000, COMMENT SYNTAX ERROR28 ; 09244000
OCT0007, COMMENT TDA 0 29 ; 09245000
OCT0000, COMMENT SYNTAX ERROR30 ; 09246000
OCT0000, COMMENT SYNTAX ERROR31 ; 09247000
OCT0115, COMMENT SSA A 32 ; 09248000
OCT0114, COMMENT SDA A 33 ; 09249000
OCT0154, COMMENT SCA A 34 ; 09250000
OCT0141; COMMENT STC A 35 ; 09251000
FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010
"[# ", 09251020
"]# ", 09251030
"># ", 09251040
"}# ", 09251050
"=# ", 09251060
"!# ", 09251070
"{# ", 09251080
"<# ", 09251090
"|# ", 09251100
"1# ", 09251101
"3# ", 09251102
"0# ", 09251103
"1# ", 09251104
"2# ", 09251105
"2# ", 09251106
"0# " 09251107
; 09251200
NEXTTEXT~26 ; 09251300
DO UNTIL STEPI = BEGINV; 09252000
BUILDLINE.[45:1]~FALSE; 09252050
09252100
COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000
THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000
LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000
AND IS ALSO USED AS A ONE SYLLABLE 09256000
CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000
ITS PRIMARY FUNCTION IS TO CUT BACK 09258000
THE STACK AFTER A COMMUNICATE OPERATOR. 09259000
MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000
IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000
C-RELATIVE ADDRESSING FOR CONSTANTS 09262000
IN THE PROGRAM STREAM 09263000
OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000
THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000
LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000
CELL.AT THE START OF COMPILATION XXXX IS 09267000
ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000
IT IS CHANGED BEFORE COMPILATION IS 09269000
COMPLETE TO LOOK LIKE A WORD MODE 09270000
PROGRAM DESCRIPTOR; 09271000
EMITL(0);EMITO(MKS); 09272000
GT1~PROGDESCBLDR(3,0,0); 09273000
GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000
INSERTCOP:=1; %107-09274100
ERRORTOG~TRUE; BLOCK(FALSE); 09275000
COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100
THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200
THE END. CARD OFF AN INPUT TAPE; 09275250
IF NEWTOG THEN 09275300
BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350
"D ON OCR","DING TAPE","E ", " "," ", 09275400
" ","999999999"; 09275450
WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500
END; 09275550
09275600
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]&GT1[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]]&GT1[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
GT1~MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000
MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000
ZEROUT(IDARRAY[0],0,30); 09395500
IDARRAY[4]:=MOVEANDBLOCK(EDOC,GT1,0); %106-09396000
IDARRAY[5]~GT1; 09397000
COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000
IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); %106-09399000
IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100
(LDICT,SGAVL,2)[18:33:15]; %106-09399150
IDARRAY[1]~SGAVL; 09400000
COMMENT WRITE OUT PRT; 09401000
IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); %106-09402000
IDARRAY[3]~PRTIMAX; 09403000
COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000
IDARRAY[6]~1; 09405000
COMMENT PASS NUMBER OF FILES; 09405100
IDARRAY[7] ~ (FILENO-1)&GTI1[18:27:15]; 09405200
COMMENT WRITE DISK SEGMENT ZERO; 09406000
GT1:=DA; DA:=0; MOVE(30,IDARRAY[0],PRT[0,0]); %106-09407000
GT2:=MOVEANDBLOCK(PRT,30,6); DA:=GT1; %106-09407010
IF CODEFILE THEN WRITE(LINE); %106-09407020
IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050
LOCK(CODE,SAVE); 09407100
CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. %119-09407200
CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. %119-09407300
LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. %119-09407400
IF LISTER OR NOT NOHEADING THEN 09408000
BEGIN FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT"09409000
,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000
"PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000
" WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000
I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 09413000
/"ESTIMATED AUXILIARY MEMORY REQUIRED =",I6," WORDS.", 09414000
/"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 09414100
FORMAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 09414101
MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4);09415000
MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4);09416000
IF CHECKTOG THEN 09416001
WRITE(LINE[DBL] ,SERR,IF NUMSEQUENCEERRORS = 0 09416002
THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004
THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006
WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2,09417000
PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000
DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000
END END END PROGRAM; 09420000
COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000
COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000
FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000
WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000
ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000
RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000
STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000
EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000
THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000
TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000
S = [1:1], 10010000
REPEAT = [38:10], 10011000
SKIP = [32:6], 10012000
CODE = [2:4], 10013000
W = [6:6], 10014000
W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000
S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000
TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000
BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000
WORDS. GIVEN S = 1 WE HAVE: 10019000
IF CODE = 0 THEN RIGHTPAREN, 10020000
IF CODE = 2 THEN STRING, 10021000
IF CODE = 4 THEN LEFTPAREN, 10022000
IF CODE = 6 THEN STROKE, 10023000
IF CODE = 8 THEN SCALE. 10023100
GIVEN S = 0 WE HAVE 10024000
IF CODE = 0 THEN D, 10025000
IF CODE=1 THEN T, 10025010
IF CODE = 2 THEN X, 10026000
IF CODE = 4 THEN A, 10027000
IF CODE = 6 THEN I, 10028000
IF CODE = 8 THEN F, 10029000
IF CODE =10 THEN E, 10030000
IF CODE = 11 THEN U, 10030100
IF CODE =12 THEN O, 10031000
IF CODE = 13 THEN V, 10031100
IF CODE =14 THEN L, 10032000
IF CODE = 15 THEN R, 10032100
W IS THE FIELD WIDTH. 10033000
FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000
ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000
REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000
REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000
HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000
IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000
A NON-ZERO REPEAT FIELDS. 10040000
THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000
FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000
D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000
THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000
FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000
W2 = D1 = D2 =0. 10046000
FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010
W2=D1=D2=0. 10046020
FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000
W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000
FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000
IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000
IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000
FOR F IF D < 8 THEN D1 = D, D2=0, 10052000
IF D > 8 THEN D1 = 8, D2=D-8, 10053000
IF D >16 THEN ERROR. 10054000
IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000
SKIP=0. 10056000
IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000
IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000
FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000
D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000
FOR O, W1=W2=D1=D2=SKIP=0, 10061000
FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000
SKIP = W-W1, 10063000
FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100
FOR B: SEE U-PHRASE DESCRIPTION. 10063110
FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200
FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300
F-PHRASE DESCRIPTION. 10063400
FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000
WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000
BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000
IF IT NOTICES AN ERROR; 10067000
PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000
BEGIN 10069000
10070000
MOVE(1,W,EDOC[F.[38:3],F.[41:7]]); 10071000
IF DEBUGTOG 10072000
THEN BEGIN 10073000
DEBUGWORD(B2D(F),W,LIN); 10074000
WRITELINE END; 10075000
IF (F~F+1) > 1024 THEN FLAG(307); 10076000
10077000
10078000
10079000
10080000
10081000
END WHIPOUT; 10082000
BOOLEAN PROCEDURE FORMATPHRASE; 10083000
BEGIN 10084000
LABEL EL,EX,EXIT,L1,L2,L3; 10085000
PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000
VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000
REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000
BOOLEAN S; 10089000
BEGIN IF W > 63 THEN FLAG(163); 10090000
W ~ REPEAT & W [ 6:42:6] 10091000
& SKIP [32:42:6] 10092000
& W1 [28:44:4] 10093000
& W2 [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 = "O" 10128000
THEN BEGIN CODE~RO; W~8 END 10129000
ELSE IF ELCLASS = "D" 10130000
THEN BEGIN CODE~RD; W~8 END 10131000
ELSE IF ELCLASS = "," THEN GO TO L2 10132000
ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000
ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 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<OR>*.D<OR>*. 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<W1 THEN W1~W; SKIP ~ W-W1 END ELSE GO EX END; 10170000
EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10171000
L2: NEXTENT; GO TO EXIT; 10172000
EX: FORMATPHRASE ~ TRUE; ERR(136); 10173000
EXIT: END FORMATPHRASE; 10174000
COMMENT GETINT DOES A CALL ON NEXTENT AND CHECKS TO SEE IF AN INTEGER 10175000
WAS THE RESULT: IF NOT ERROR - OTHERWISE MAKE SIGN PLUS; 10176000
BOOLEAN PROCEDURE GETINT; 10177000
BEGIN NEXTENT; IF ELCLASS ~ - ELCLASS < 0 THEN 10178000
IF ELCLASS=-("*") THEN GETINT~TRUE ELSE 10178100
BEGIN FLAG(137); ELCLASS ~ 0 END 10179000
END GETINT; 10180000
COMMENT DIVIDE PARTIONS THE PARAMETER NUMBER INTO THREE PARTS. THE 10181000
RESULT IS PASSED BACK THROUGH P1,P2, AND THE FUNCTION 10182000
IDENTIFIER. SEE CODE FOR DETAILS; 10183000
INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); 10184000
VALUE NUMBER; INTEGER P1,P2,NUMBER; 10185000
BEGIN 10186000
IF NUMBER < 0 THEN BEGIN FLAG(138); ERRORTOG~TRUE; 10187000
NUMBER ~ 0 END; 10188000
P1 ~ IF NUMBER < 8 THEN NUMBER ELSE 8; 10189000
NUMBER ~ NUMBER-P1; 10190000
P2 ~ IF NUMBER < 8 THEN NUMBER ELSE 8; 10191000
DIVIDE ~ NUMBER-P2 END DIVIDE; 10192000
COMMENT DEFINEGEN PACKS THE ALPHA FOR A DEFINE INTO INFO. DEFINEGEN 10193000
PRINCIPALLY ELIMINATES BLANKS AND COMMENTS. PUTOGETHER 10194000
ACTUALLY DOES THE MECHANICAL WORK OF PROCESSING THE 10195000
CHARACTORS FROM ACCUM TO INFO. THE FINAL TRANSFER IS DONE10196000
IN PACKINFO. THE OTHER FUNCTION SERVED BY DEFINEGEN IS 10197000
THAT OF COUNTING DEFINES AND CROSSHATCHES IN ORDER TO 10198000
ALLOW NESTED DEFINES. 10199000
A WORD ON THE OVERALL PLAN OF ATTACK ON HANDLEING 10200000
DEFINES: 10201000
THERE ARE FOUR PLACES THAT THERE IS CODE WRITTEN 10202000
EXPLICITLY FOR THE DEFINE. 10203000
FIRST IS DEFINEGEN WHICH LOADS THE ALPHA INTO INFO. 10204000
SECOND IS IN THE TABLE ROUTINE AFTER A DEFINED ID IS 10205000
NOTICED. HERE A SETUP IS PERFORMED SO THAT THE SCANNER 10206000
WILL SCAN INFO. SINCE INFO (UNLIKE I/O BUFFERS) IS NOT 10207000
A SAVE ARRAY, WE CAN NOT DIRECTLY SCAN INFO. INSTEAD WE 10208000
FOOL READACARD SO THAT THE ALPHA IS FETCHED FROM INFO AND 10209000
PLACED INTO A SMALL SAVE ARRAY (DEFINEARRAY) INSTEAD OF 10210000
BEING FETCHED FROM AN I/O DEVICE. NATURALLY WE MUST HAVE 10211000
NESTING WHICH IS OBTAINED BY USING DEFINEARRAY AS A SMALL 10212000
STACK. THE QUANTITIES SAVED ARE LCR,NCR, AND LASTUSED. 10213000
LASTUSED DOUBLES AS A DEVICE FOR DIRECTING THE FLOW OF 10214000
INFORMATION FROM I/O GEAR AND FROM INFO DURING ANALYSIS OF10215000
DEFINES. THIS STACKING IS DONE HERE BY THE TABLE ROUTINE.10216000
THIRD IS READACARD WHICH HAS NOW BEEN FAIRLY WELL 10217000
DESCRIBED. THE ONLY ADDITIONAL COMMENT NECESSARY IS THAT 10218000
LASTUSED SERVES AS AN INDEX TO FETCH NEXT WORD OF ALPHA 10219000
FROM INFO. READACARD FETCHES ONLY ONE WORD AT A TIME. 10220000
FOURTH IS ALSO IN THE TABLE ROUTINE. IT IS AT THE 10221000
PLACE THAT A CROSSHATCH IS NOTICED. IT CAUSES AN UNSETUP 10222000
SO THAT THE SCANNER WILL STOP SCANNING THAT PART OF INFO 10223000
AND RESUME ITS PREVIOUS TASKS. A DISTINCTION IS MADE 10224000
BETWEEN CROSSHATCHES SCANNED AFTER A DEFINE DECLARATION 10225000
AND THOSE SCANNED DURING THE RECALL PROCESS. THE LATER 10226000
ONLY CAUSES AN UNSETUP; 10227000
PROCEDURE DEFINEGEN(MACRO,J); VALUE MACRO,J; BOOLEAN MACRO; REAL J; 10228000
BEGIN 10229000
OWN INTEGER CHARCOUNT, REMCOUNT; 10230000
COMMENT CHARCOUNT CONTAINS NUMBER OFCHARACTORS OF THE DEFINE THAT WE10231000
HAVE PUT INTO INFO. REMCOUNT CONTAINS NUMBER OF CHARACT- 10232000
ORS REMAINING IN THIS ROW OF INFO; 10233000
PROCEDURE PUTOGETHER(CHAR); REAL CHAR; 10234000
BEGIN 10235000
STREAM PROCEDURE PACKINFO(INFO,ISKIP,COUNT,ASKIP,ACCUM); 10236000
VALUE ISKIP,COUNT,ASKIP; 10237000
BEGIN DI ~ INFO; DI ~ DI+ISKIP; 10238000
SI ~ ACCUM;SI ~ SI+ASKIP; SI ~ SI+3; 10239000
DS ~ COUNT CHR END PACKINFO; 10240000
INTEGER COUNT,SKIPCOUNT; 10241000
IF (COUNT ~ CHAR.[12:6]) + CHARCOUNT > 2047 10242000
THEN BEGIN FLAG(142); TB1~ TRUE END 10243000
ELSE BEGIN 10244000
IF COUNT > REMCOUNT 10245000
THEN BEGIN 10246000
SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT); 10247000
REMCOUNT ~ 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 <ID,CHARI,FILE,0> 10443000
--------- ------------------------- 10444000
1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000
--------- ------------------------- 10446000
2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000
FILE,2) 10448000
--------- ------------------------- 10449000
3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000
,ID,CHARI,FILE,3) 10451000
--------- ------------------------- 10452000
4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000
POWERSOFTEN,ID,CHARI,FILE,4) 10454000
*********** *************************** 10455000
SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000
MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000
THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000
THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000
ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000
ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000
MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000
MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000
WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000
MONITORING INFORMATION. 10465000
*********FORMAT OF INFO FOR MONITORED ITEMS**********10466000
ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000
WORD WILL BE SET. 10468000
SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000
ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000
THE MONITOR FILE IN [37:11], I WILL HAVE A 10471000
DEFINE SVARMONFILE = [37:11]#. 10472000
ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000
NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000
MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000
FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000
DEFINE ARRAYMONFILE = [27:11]#. 10477000
SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000
SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000
TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000
OF INFO CONTAINING LOWER BOUND INFORMATION10481000
ALSO CONTAINS MONITOR INFORMATION. EITHER10482000
A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000
IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000
DESIGNATES WHETHER AN OPDC OR A LITC 10485000
SHOULD BE GENERATED USING [12:11]. IF THE10486000
BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000
ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000
MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000
ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000
PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000
SI* TO THE PRINTI ROUTINE. 10492000
LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000
THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000
ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000
DEFINE LABLMONFILE = [13:11]#. 10496000
SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000
I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000
FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000
WITH THE SAME NUMBER OF WORDS AS THE 10500000
ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000
REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000
ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000
FUNCMONFILE = [27:11]#; 10504000
DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000
ADDRESS OF THE MONITOR FILE; 10506000
DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000
SAVE THE ADDRESS OR VALUE OF A 10508000
SUBSCRIPT. ONE ADDITIONAL BIT IS10509000
USED TO TELL WHETHER TO EMIT AN 10510000
OPDC OR A LITC ON THIS ADDRESS OR10511000
VALUE; 10512000
DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000
DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000
VARIABLE APPEARING IN A MONITOR LIST;10515000
DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000
ADDITIONAL INFO AND IS USED WHEN MAKING10517000
A NEW ENTRY IN INFO FOR ARRAYS; 10518000
DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000
ELBAT WORD FOR A MONITOR LIST 10520000
ELEMENT; 10521000
DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000
SUBSCRIPTED VARIABLES TO TELL ME 10523000
WHETHER TO EMIT AN OPDC OR A LITC.10524000
0 IS USED FOR OPDC, 1 FOR LITC; 10525000
DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000
POINTING AT THE END OF ADDITIONAL 10527000
INFO AND IS USED TO TELL WHEN TO 10528000
STOP MOVING INFO FOR THE NEW ENTRY10529000
FOR MONITORED ARRAYS; 10530000
DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000
LINK POINTING AT THE FIRST 10532000
ADDITIONAL WORD OF INFO FOR 10533000
MONITORED ARRAYS; 10534000
DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000
CONCATENATE DEFINE FOR 10536000
STUFFING THE MONITOR FILE 10537000
ADDRESS INTO THE FIRST 10538000
ADDITIONAL INFO WORD FOR 10539000
ARRAYS AND FUNCTIONS; 10540000
DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000
PARTIAL WORD DESIGNATOR [4010542000
:8] USED TO EXTRACT THE 10543000
NUMBER OF PARAMETERS FOR A 10544000
GIVEN PROCEDURE FROM INFO; 10545000
DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000
OF PARAMETERS FOR A FUNCTION 10547000
DESIGNATOR APPEARING IN A MONITOR 10548000
LIST; 10549000
LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000
POINTING AT THE FILE IDENTIFIER IN THE 10551000
MONITOR DECLARATION; 10552000
LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000
TURNS ON THE MONITOR BIT OF THE ELBAT10554000
WORD IN THE MONITOR LIST AND STORES 10555000
IT IN ACCUM[0] FOR THE E ROUTINE; 10556000
LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000
REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000
EACH SUBSCRIPT EXPRESSION; 10559000
LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000
POINTING THE LAST LOGICAL QUANTITY OF THE 10561000
MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000
PROCESSED; 10563000
LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000
START:IF ELCLASS!FILEID THEN 10565000
BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100
"6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200
ERR(400); GO EXIT; 10565300
END 10566000
COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000
CHECKER(ELBAT[I]); 10568000
FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000
IF CHECK(LEFTPAREN,401) 10570000
THEN GO TO EXIT; 10571000
COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000
MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000
IF RANGE(BOOID,INTID) 10574000
THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000
E; PUTNBUMP(FILEIDENT); 10576000
GO CHKCOMMA; 10577000
END; 10578000
IF RANGE(BOOARRAYID,INTARRAYID) 10579000
THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000
SUBSCRIPTED VARIABLES; 10581000
E; NXTINFOTEMP~NEXTINFO; 10582000
PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000
TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000
ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000
DO PUTNBUMP(TAKE(INC~INC+1)) 10586000
UNTIL INC } TESTVARB; 10587000
IF TABLE(I+1) ! LFTBRKET 10588000
THEN GO CHKCOMMA; 10589000
TESTVARB~NODIM+NXTINFOTEMP; 10590000
STEPIT; 10591000
STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000
STEPI ! NONLITNO 10593000
THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000
SUBSCRIPTED VARIABLES. EITHER A LITC 10595000
OR AN OPDC ON A VARIABLE IS ALL THAT 10596000
IS NEEDED TO CALL THE SUBSCRIPT; 10597000
SUBSCRIPT~ELBAT[I].ADDRESS; 10598000
OPLIT~0; 10598500
IF NOT RANGE( INTRNSICPROCID,INTID) 10599000
THEN IF CHECK(LITNO,402) 10600000
THEN GO TO EXIT 10601000
ELSE COMMENT MARK FOR LITC; 10602000
OPLIT~1; 10603000
COMMENT ERROR 402 IS BAD 10604000
SUBSCRIPT IN MONITOR DECLARATION;10605000
STEPIT; 10606000
END 10607000
ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000
SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000
SUBSCRIPT EXPRESSION MUST BE GENERATED10610000
AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000
PROGRAM DESCRIPTOR CREATED AND THE 10612000
ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT10613000
MUST BE MARKED FOR AN OPDC; 10614000
JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000
ADES,L,0); AEXP; EMITO(RTS); 10616000
JUMPCHKX; 10616500
OPLIT~0; 10617000
IF MODE > 0 10618000
THEN BEGIN COMMENT STUFF F AT THIS 10619000
POINT IF MODE > 0; 10620000
STUFFF(SUBSCRIPT);EMITPAIR( 10621000
SUBSCRIPT,STD); 10622000
END; 10623000
END; 10624000
PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000
SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000
NXTINFOTEMP); 10627000
IF ELCLASS = COMMA 10628000
THEN GO TO STORESUBS; 10629000
IF CHECK(RTBRKET,403) 10630000
THEN GO TO EXIT; 10631000
COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000
EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000
IF NXTINFOTEMP ! TESTVARB 10634000
THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000
ELEMENT HAS IMPROPER NUMBER OF 10636000
SUBSCRIPTS; 10637000
I~I-1; ERROR(404); GO TO EXIT; 10638000
END; 10639000
GO CHKCOMMA; 10640000
END; 10641000
IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000
THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000
IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000
THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000
SWITCH MONITORED AT IMPROPER LEVEL; 10646000
ERROR(405); GO TO EXIT; 10647000
END; 10648000
PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000
); 10650000
PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000
ELBATWORD); GO CHKCOMMA; 10652000
END; 10653000
IF RANGE(BOOPROCID,INTPROCID) 10654000
THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000
E ;% 10656000
IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010
BEGIN 10656011
%%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012
%%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013
PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014
PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015
END ; 10656016
PUTNBUMP(NOPAR ~ TAKEFRST & 10656030
FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR10657000
~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000
LINK+ELBATWORD.INCR); 10659000
DO PUTNBUMP(TAKE(INC~INC+1)) 10660000
UNTIL INC } TESTVARB; 10661000
GO CHKCOMMA; 10662000
END; 10663000
ERROR(406); GO TO EXIT; 10664000
COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000
CHKCOMMA:IF STEPI = COMMA 10666000
THEN GO MARKMONITORED; 10667000
IF CHECK(RTPAREN,407) 10668000
THEN GO TO EXIT; 10669000
COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000
DECLARATION; 10671000
IF STEPI = SEMICOLON 10672000
THEN GO TO EXIT; 10673000
IF CHECK(COMMA,408) 10674000
THEN GO TO EXIT; 10675000
COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000
DELIMITER; 10677000
STEPIT; GO TO START; 10678000
EXIT:; 10679000
END MERRIMAC; 10680000
PROCEDURE DMUP; 10681000
BEGIN COMMENT 15 JULY 1963 10682000
THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000
ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000
ARRAYS. 10685000
THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000
THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000
OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000
THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000
A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000
HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000
BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000
COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000
WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000
THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000
FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000
THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000
INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000
ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000
OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000
. THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000
DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000
IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000
FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000
SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000
LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000
POINTING AT THE FILE IDENTIFIER IN THE DUMP 10707000
DECLARATION; 10708000
LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000
ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000
IS REACHED; 10711000
DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000
ADDRESS OF THE MONITOR FILE; 10713000
LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000
CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000
STARTCALL IS REACHED, I MUST BE POINTING 10716000
AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000
DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000
DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000
DIMENSIONS OF AN ARRAY OR A 10720000
SUBSCRIPTED VARIABLE APPEARING IN A 10721000
DUMP LIST; 10722000
DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000
COUNTER SETTING AT WHICH CODE IS 10724000
GENERATED TO EXIT THE ROUTINE EMITTED10725000
BY DMUP; 10726000
DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000
LOCATION OF THE COUNTER 10728000
ASSOCIATED WITH THIS LABEL IF 10729000
SPACE HAS BEEN ASSIGNED FOR IT; 10730000
DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000
NODIM. IT IS THEN COUNTED DOWN TO 10732000
ZERO AS SUBSCRIPT CODE IS GENERATED;10733000
LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000
NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000
LABEL SUBSLOOP; COMMENT THE CODE AT SUBLOOP PASSES 10736000
SUBSCRIPTS TO PRINTI; 10737000
ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000
HOLDS THE ADDRESSES OF ALL LABEL 10739000
COUNTERS FOR LABELS APPEARING IN 10740000
THIS DUMP DECLARATION. IT IS 10741000
NECESSARY TO RETAIN THIS 10742000
INFORMATION SO THAT CODE MAY BE 10743000
GENERATED AT THE END OF THE 10744000
DECLARATION TO INITIALIZE THE 10745000
COUNTERS; 10746000
DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000
VARIABLE USED TO INDEX INTO THE10748000
LABELCTR ARRAY; 10749000
DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000
CONCATENATE DEFINE FOR INSERTING10751000
THE COUNTER ASSOCIATED WITH THIS10752000
LABEL INTO THE FIRST ADDITIONAL 10753000
WORD OF INFO; 10754000
DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000
BOUND FOR MONITORED SUBSCRIPTED 10756000
VARIABLES; 10757000
DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000
FORMAT TYPE REFERRED TO IN THE 10759000
COMMENTS FOR THE MERRIMAC 10760000
ROUTINE DESCRIBING PRINTI; 10761000
DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000
USED TO HOLD L WHILE THE DUMP 10763000
INDICATOR TEST CODE IS BEING 10764000
GENERATED; 10765000
DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000
LOCATION OF THE CODE THAT MUST BE 10767000
GENERATED TO MAKE THE TEST TO 10768000
DETERMINE WHETHER OR NOT DUMPING 10769000
SHOULD OCCUR; 10770000
DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000
CONCATENATE DEFINE USED TO 10772000
INSERT THE ADDRESS OF THE 10773000
PROGRAM DESCRIPTOR FOR THE CODE 10774000
GENERATED FROM THE DUMP 10775000
DECLARATION; 10776000
DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000
ADDRESS OF THE PROGRAM DESCRIPTOR 10778000
THAT DESCRIBES THE CODE GENERATED 10779000
BY DMUP; 10780000
DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000
ELBAT WORD FOR THE DUMP LIST 10782000
ELEMENT CURRENTLY BEING OPERATED 10783000
ON; 10784000
LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000
ON PRINTI. IT GENERATES THE CODE TO 10786000
PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000
FILE, AND FORMAT TYPE; 10788000
DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000
DIMENSION NUMBER THAT IS CURRENTLY 10790000
BEING WORKED ON; 10791000
START:IF CHECK(FILEID,409) 10792000
THEN GO TO EXIT; 10793000
COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000
CHECKER(ELBAT[I]); 10795000
FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000
IF CHECK(LEFTPAREN,410) 10797000
THEN GO TO EXIT; 10798000
COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000
JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000
(ADES,L,0); TESTLOC~L; L~L+3; 10801000
LABELCTRINX~-1; EMITO(NOP); BUMPL; 10802000
STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000
[I]); 10804000
IF RANGE(BOOARRAYID,INTARRAYID) 10805000
THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000
SUBSCRIPTED VARIABLES; 10807000
NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000
IF STEPI = LFTBRKET 10809000
THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000
VARIABLES; 10811000
STEPIT; AEXP; EMITO(DUP); 10812000
SUBSCTR~1; 10813000
IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000
).[35:13] ! 0 10815000
THEN BEGIN COMMENT SUBTRACT OFF THE 10816000
LOWER BOUND BEFORE INDEXING;10817000
IF LWRBND.[46:2] = 0 10818000
THEN EMIT(LWRBND) 10819000
ELSE EMITV(LWRBND.[35:11]); 10820000
EMIT(LWRBND.[23:12]); 10821000
END; 10822000
IF DIMCTR-SUBSCTR = 0 10823000
THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000
VALUE,N; 10825000
EMITV(ELBATWORD.ADDRESS); 10826000
PASSN:EMITL(NODIM); 10827000
IF CHECK(RTBRKET,411) 10828000
THEN GO TO EXIT; 10829000
COMMENT ERROR 411 MEANS 10830000
DUMP LIST ELEMENT HAS WRONG 10831000
NUMBER OF SUBSCRIPTS; 10832000
FORMATTYPE~2; GO CALLPRINTI10833000
END; 10834000
EMITN(ELBATWORD.ADDRESS); 10835000
SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000
EMITL(JUNK); EMITO(SND); 10837000
SUBSCTR~SUBSCTR+1; 10838000
IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000
).[35:13] ! 0 10840000
THEN BEGIN COMMENT SUBTRACT OFF THE 10841000
LOWER BOUND BEFORE INDEXING;10842000
IF LWRBND.[46:2] = 0 10843000
THEN EMIT(LWRBND) 10844000
ELSE EMITV(LWRBND.[35:11]); 10845000
EMIT(LWRBND.[23:12]); 10846000
END; 10847000
IF DIMCTR-SUBSCTR = 0 10848000
THEN BEGIN COMMENT EMIT COC; 10849000
EMITO(COC); EMITV(JUNK10850000
); EMITO(XCH); 10851000
GO PASSN; 10852000
END; 10853000
EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000
IF CHECK(COMMA,412) 10855000
THEN GO TO EXIT 10856000
ELSE GO TO SUBSLOOP; 10857000
COMMENT ERROR 412 MEANS DUMP LIST 10858000
ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000
; 10860000
END; 10861000
COMMENT THIS CODE HANDLES ARRAYS; 10862000
IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000
THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000
ARRAY DUMP LIST ELEMENT; 10865000
ERR(413); GO TO EXIT; 10866000
END; 10867000
EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000
FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000
END; 10870000
FORMATTYPE~1; 10871000
IF RANGE(BOOID,INTID) 10872000
THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000
EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000
END; 10875000
IF CHECK(LABELID,414) 10876000
THEN GO TO EXIT; 10877000
COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000
CODE HANDLES LABELS; 10879000
PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10880000
IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000
THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000
ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000
EMITV(LABELCTR[ 10884000
LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000
,ELBATWORD); 10886000
EMITL(3); IF FALSE THEN 10887000
CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000
POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000
EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000
FILEIDENT); %109-10891000
EMITNUM(FORMATTYPE&CARDNUMBER[1:4:44]); %109-10891100
EMITV(GNAT(PRINTI)); %109-10891200
IF STEPI = COMMA 10892000
THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000
IF LABELCTRINX = 100 10894000
THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000
ABOUT TO OVERFLOW WITH LABEL 10896000
INFORMATION; 10897000
ERR(415); GO TO EXIT; 10898000
END; 10899000
GO STARTCALL; 10900000
END; 10901000
IF CHECK(RTPAREN,416) 10902000
THEN GO TO EXIT; 10903000
COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000
DELIMETER; 10905000
LEXIT~L; EMITL(0); EMITO(RTS); 10906000
JUMPCHKX; STEPIT; 10907000
IF CHECK(LABELID,417) 10908000
THEN GO TO EXIT; 10909000
COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000
PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000
ELBATWORD); 10912000
IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100
PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000
IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000
THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000
ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000
EMITL(0); 10917000
DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000
EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000
END 10920000
UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000
L~L-1; EMITO(STD); STEPIT; 10922000
IF CHECK(COLON,418) 10923000
THEN GO TO EXIT; 10924000
COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000
FINALL~L; L~TESTLOC; STEPIT; 10926000
IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500
AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510
! COMMA AND GT1 ! SEMICOLON) 10926520
THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530
UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540
FLAG(465); GO TO EXIT; 10926550
END; 10926560
PRIMARY; EMITV(DUMPETEMP); 10927000
EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000
L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000
DUMPR],GIT(ELBAT[I-3])); 10930000
IF ELCLASS = COMMA 10931000
THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000
STEPIT; GO TO START; 10933000
END; 10934000
IF CHECK(SEMICOLON,419) 10935000
THEN; 10936000
COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000
EXIT:; 10938000
END DMUP; 10939000
COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000
AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000
OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000
SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000
OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000
IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000
A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000
SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 10947000
SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000
SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000
THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000
JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000
TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000
SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000
BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113-10954000
VALUE BEFORE; BOOLEAN BEFORE; REAL PD; %113-10954100
BEGIN 10955000
LABEL LX,EXIT,BEF; 10956000
REAL K,N,T1,TL; 10957000
TL ~ L; 10958000
EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000
L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000
EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000
AND PREPARATION FOR SWITCH-JUMP; 10962000
GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000
IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000
LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000
THEN BEGIN 10966000
INFO[0,N] ~ ELBAT[I]; 10967000
IF N ~ N+1 = 256 10968000
THEN BEGIN ERR(147); GO TO EXIT END; 10969000
IF STEPI = COMMA THEN GO TO LX; 10970000
EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000
FOR K ~ 0 STEP 1 UNTIL N 10972000
DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000
EMIT((GT1~INFO[0,K]).[35:1]); 10974000
EMIT(GT1) END; 10975000
SWITCHGEN ~ FALSE END 10976000
ELSE BEGIN 10977000
BEF: L ~ BUMPL; N ~ N-1; 10978000
PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500
[16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600
FOR K ~ 0 STEP 1 UNTIL N 10979000
DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000
ADJUST; T1 ~ L; 10981000
EMITL(GNAT(GT1~INFO[0,K])); 10982000
GENGO(GT1); 10983000
INFO[0,K] ~ T1; 10984000
EMITO(RTS); 10985000
CONSTANTCLEAN END; 10986000
I ~ I-1; N ~ N+1; 10987000
DO BEGIN ADJUST; 10988000
STEPIT; INFO[0,N] ~ L; 10989000
IF N ~ N+1 = 256 10990000
THEN BEGIN ERR(147); GO TO EXIT END; 10991000
DEXP; EMITO(RTS) END 10992000
UNTIL ELCLASS ! COMMA; ADJUST; 10993000
EMITB(BFW,TL+12,L); EMITO(BFC); 10994000
EMIT(0); EMITO(RTS); N ~ N-1; 10995000
FOR K ~ 0 STEP 1 UNTIL N 10996000
DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000
SWITCHGEN ~ TRUE END; 10998000
T1 ~ L; 10999000
L ~ TL+4; 11000000
EMITL(N+1); 11001000
L ~ T1; 12000000
EXIT: END SWITCHGEN; 12001000
PROCEDURE DBLSTMT; 12002000
BEGIN 12003000
REAL S,T; 12004000
BOOLEAN B ; 12004100
LABEL L1,L2,L3,L4,EXIT ; 12005000
S~0; 12006000
IF STEPI!LEFTPAREN THEN ERR(281) 12007000
ELSE 12008000
L1: BEGIN 12009000
IF STEPI=COMMA THEN 12010000
BEGIN 12011000
DPTOG~TRUE; 12012000
IF STEPI=ADOP THEN STEPIT; 12013000
EMITNUM(NLO); 12014000
EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000
DPTOG~FALSE; 12016000
STEPIT; 12017000
GO TO L2; 12018000
END; 12019000
IF TABLE(I+1)=COMMA THEN 12020000
BEGIN 12021000
IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000
BEGIN 12023000
EMITO(ELBAT[I].ADDRESS+1); 12024000
L4: IF (S~S-1){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 ELCLASS<REALARRAYID 12036400
THEN ERR(286) 12036500
ELSE VARIABLE(FL); 12037000
EMITO(IF B THEN ISD ELSE STD) END UNTIL T~T+1=2;12038000
IF ELCLASS!RTPAREN THEN GO L3 ; 12039000
IF S!0 THEN FLAG(283) 12039100
ELSE BEGIN STEPIT; GO EXIT END ; 12040000
END; 12041000
IF ELCLASS=FACTOP THEN 12041100
BEGIN 12041110
EMITO(MKS); EMITL(4); EMITV(GNAT(POWERALL)) ; 12041130
EMITO(DEL); EMITO(DEL); GO L4 ; 12041140
END ; 12041160
IF ELCLASS{INTID AND ELCLASS}BOOID THEN 12042000
BEGIN 12043000
CHECKER(T~ELBAT[I]); 12044000
STEPIT;STEPIT; 12045000
AEXP; 12046000
EMITV(T.ADDRESS); 12047000
GO TO L2; 12048000
END; 12049000
END ; 12050000
AEXP; 12051000
IF ELCLASS!COMMA THEN BEGIN ERR(284);GO EXIT 12052000
END; 12053000
STEPIT; AEXP; EMITO(XCH); 12054000
L2: S~S+1; 12055000
L3: IF ELCLASS!COMMA THEN BEGIN ERR(284);GO TO EXIT END; 12056000
GO TO L1; 12057000
EXIT:END 12058000
END DBLSTMT; 12059000
PROCEDURE CMPLXSTMT ; 12060000
BEGIN 12060100
REAL S,T ; 12060200
BOOLEAN B ; 12060250
LABEL L1,L2,L3,L4,L5,EXIT,ERROR ; 12060300
DEFINE ERRX(ERRX1) = BEGIN T~ERRX1; GO ERROR END #; 12060400
IF STEPI!LEFTPAREN THEN ERRX(381) ; 12060500
L1: STEPIT ; 12060550
IF TABLE(I+1)=COMMA THEN 12060600
BEGIN 12060700
IF ELCLASS=ADOP THEN 12060800
BEGIN 12060900
T~ELBAT[I].ADDRESS ; 12061000
EMITPAIR(9,STD); EMITO(XCH); EMITV(9); EMITO(T) ; 12061100
EMITPAIR(9,STD); EMITO(T); EMITV(9) ; 12061200
L4: IF S~S-1<1 THEN FLAG(382); STEPIT; GO L1 ; 12061300
END ; 12061400
IF ELCLASS=MULOP THEN 12061500
BEGIN 12061600
EMITO(MKS) ; 12061700
EMITL(IF ELBAT[I].ADDRESS=MUL THEN 26 ELSE 35) ; 12061725
EMITV(GNAT(SPECIALMATH)) ; 12061750
L5: EMITO(DEL); EMITO(DEL); GO L4 ; 12061800
END ; 12061900
IF ELCLASS=ASSIGNOP THEN 12062000
BEGIN 12062100
IF S~S-1<0 THEN FLAG(385); T~0; STEPIT ; 12062200
B~ELCLASS=INTID OR ELCLASS=INTPROCID 12062250
OR ELCLASS=INTARRAYID ; 12062255
DO BEGIN 12062300
IF ELCLASS!COMMA THEN ERRX(384); STEPIT ; 12062400
IF ELCLASS>BOOID AND ELCLASS<BOOARRAYID THEN 12062500
BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12062600
ELSE IF ELCLASS>BOOPROCID AND ELCLASS<BOOID THEN 12062700
IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)12062800
ELSE BEGIN EMITL(514); STEPIT END 12062900
ELSE IF ELCLASS<LABELID AND ELCLASS>BOOARRAYID 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<BOOARRAYID THEN 12064200
BEGIN 12064300
CHECKER(T~ELBAT[I]); STEPIT; STEPIT; AEXP ; 12064400
EMITV(T.ADDRESS); GO L2 ; 12064500
END ; 12064600
END ; 12064700
AEXP; IF ELCLASS!COMMA THEN ERRX(384); STEPIT; AEXP; EMITO(XCH);12064800
L2: S~S+1 ; 12064900
L3: IF ELCLASS=COMMA THEN GO L1; T~384 ; 12065000
ERROR: 12065100
ERR(T) ; 12065200
EXIT: 12065300
END OF CMPLXSTMT ; 12065400
REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; 12101000
BEGIN REAL K,S,P,J,EL; 12102000
MACROID~TRUE; 12107000
P ~ GIT(FIXDEFINEINFO ~ T); 12108000
STOPDEFINE~TRUE; 12111000
EL~TABLE(NXTELBT); 12112000
NXTELBT~NXTELBT-1; 12113000
IF EL!LEFTPAREN AND EL!LFTBRKET THEN 12114000
FLAG(175) % [ OR ( EXPECTED. 12115000
ELSE DO BEGIN J~J+1; 12116000
TEXT[NEXTTEXT.LINKR,NEXTTEXT.LINKC] := TAKE(P); %122- 12117000
NEXTTEXT := NEXTTEXT + 1; %122- 12118000
PUT(TAKE(P) & NEXTTEXT[11:32:16] & 12121000
DEFSTACKHEAD[35:35:13], P); 12122000
DEFSTACKHEAD ~ P.LINK; 12123000
P ~ GIT(K~P); 12123500
DEFINEGEN(TRUE,0); 12124000
END UNTIL EL ~ ELBAT[NXTELBT].CLASS ! COMMA OR K = P; 12125000
IF EL!RTPAREN AND EL!RTBRKET OR K!P THEN 12126000
FLAG(174);%INCORRECT # OF PARAMS IN DEFINE INVOCATION. 12126100
MACROID~FALSE; 12127000
END; 12128000
PROCEDURE DEFINEPARAM(DINFO, N); 12150000
COMMENT DEFINEPARAM GENERATES EVERYTHING (EXCEPT THE ELBAT 12150100
WORD) FOR AN INFO TABLE ENTRY FOR A PARAMETER OF A 12150200
PARAMETRIC DEFINE. 12150300
; 12150400
VALUE DINFO, N; INTEGER DINFO, N; 12151000
BEGIN 12152000
INTEGER J; 12153000
STREAM PROCEDURE MAKEPARAM(INF, ACC, C, Q, N); VALUE C, Q, N; 12154000
BEGIN 12155000
DI ~ ACC; DI ~ DI+3; 12156000
SI ~ INF; SI ~ SI+3; DS ~ C CHR; 12157000
SI ~ LOC N; SI ~ SI+7; DS ~ 1 CHR; 12158000
SI ~ LOC Q; SI ~ SI+6; DS ~ 1 CHR; 12159000
DI ~ ACC; DI ~ DI+2; DS ~ 1 CHR; 12160000
END MAKEPARAM; 12161000
ACCUM[1] ~ 0; 12161500
MAKEPARAM(INFO[DINFO.LINKR,DINFO.LINKC], ACCUM[1], 12162000
J ~ INFO[DINFO.LINKR,DINFO.LINKC].[12:6], 770+J, N); 12163000
SCRAM ~ ACCUM[1] MOD 125; 12164000
COUNT ~ J+2; 12165000
END DEFINEPARAM; 12166000
COMMENT THIS SECTION CONTAINS THE PROCEDURES USED BY THE BLOCK ROUTINE;13000000
PROCEDURE IODEC(IOT); 13001000
VALUE IOT; 13002000
INTEGER IOT; 13003000
BEGIN 13004000
STREAM PROCEDURE GET7(ACCUM,RESULT); 13005000
BEGIN 13006000
LOCAL T,T1; LABEL EXIT; 13007000
SI~ACCUM; SI~SI+2; DI~ LOC T; DI~DI+7; 13008000
DS~ CHR; T1~SI; SI~LOC T; SI~SI+7; 13009000
DI~ RESULT; DS~ 8 LIT "0 "; DI~DI-7; 13010000
IF SC}"0" 13011000
THEN IF SC<"8" 13012000
THEN 13013000
BEGIN 13014000
SI~T1; DS~ T CHR;GO TO EXIT 13015000
END; 13016000
SI~T1;DS ~ 7 CHR; 13017000
EXIT: 13018000
END; 13019000
STREAM PROCEDURE ENTERID(IDLOC,FILENO,TYPE,MULFID,FILID,FILID1,N); 13020000
VALUE FILENO,TYPE,MULFID,FILID,N; 13021000
BEGIN 13022000
DI~IDLOC; DI~DI+5;DI~DC; 13023000
SI~LOC FILENO; SI~SI+6; 13024000
DS~ 2 CHR; SI~LOC TYPE; 13025000
SI~ SI+7; DS~ CHR; 13026000
SI~ LOC MULFID;SI~SI+1; 13027000
DS~ 7 CHR; 13028000
SI~ LOC FILID;SI~SI+1; 13029000
DS~ 7 CHR; 13030000
SI~ LOC N; SI~SI+7; 13031000
DS~ CHR; 13032000
SI~ FILID1; SI~SI+3; 13033000
DS~ N CHR; N~DI; 13034000
DI~ IDLOC; DI~DI+5; 13035000
SI~ LOC N; SI~SI+5; 13036000
DS~ 3 CHR 13037000
END; 13038000
REAL MULFID,FILID,TYPE,M,K; 13039000
DEFINE CALL5=EMITL(0); EMITL(IOT); EMITL(8); EMITV(5) # ; 13039400
REAL SAVADDRSF ; 13039450
REAL ACCUM1; 13039500
INTEGER CURRENT, IOTEMP, IOTEMPO; 13039550
LABEL START; 13040000
JUMPCHKX; 13041000
IF G~GTA1[J~J-1]=FILEV 13042000
THEN 13043000
BEGIN 13044000
IF G~GTA1[J~J-1]=SWITCHV 13045000
THEN 13046000
BEGIN 13047000
STOPENTRY~NOT SPECTOG; 13048000
ENTRY(SUPERFILEID); 13049000
IF SPECTOG THEN GO TO START; 13050000
IF ELCLASS!ASSIGNOP 13051000
THEN FLAG(34); 13052000
EMITO(MKS); 13053000
CHECKDISJOINT(ADDRSF); 13054000
G~L;L~L+1; 13055000
EMITL(1); 13056000
EMITL(1); 13057000
EMITL(1); 13058000
EMITV(5) ; 13059000
13060000
J~-1; STOPENTRY~FALSE; 13061000
DO 13062000
BEGIN 13063000
IF STEPI ! FILEID% 13064000
THEN FLAG(35); 13065000
PASSFILE; 13066000
EMITL(J~J+1); 13067000
EMITN(ADDRSF); 13068000
EMITO(STD); 13069000
END 13070000
UNTIL ELCLASS!COMMA; 13071000
GT2~L;L~G; EMITL(J+1); L~GT2; GO TO START 13072000
END; 13073000
I~I-1;M~1; 13074000
IF G=ALFAV 13075000
THEN M~0 13076000
ELSE J~J+1;K~J; STOPENTRY~NOT SPECTOG; 13077000
DO 13078000
BEGIN 13079000
STOPDEFINE := TRUE ; 13079500
STEPIT; J:=K;P2:=P3:=P4:=FALSE;GTA1[0]:=0; GET7(ACCUM[1],FILID);13080000
MULFID~0;TYPE~2; ENTER(FILEID); 13081000
SAVADDRSF~ADDRSF ; 13081500
IF SPECTOG THEN GO TO START; 13082000
EMITO(MKS);EMITL(0);EMITL(0); 13082500
IF ELCLASS=LITNO 13083000
THEN 13084000
BEGIN 13085000
TYPE~ELBAT[I].ADDRESS; 13086000
STEPIT 13087000
END; 13088000
IF ELCLASS{IDMAX THEN 13088010
BEGIN 13088020
% TO VOID A CARD 13088025
IF ACCUM1~ACCUM[1]="5PRINT" THEN TYPE~1 ELSE 13088030
IF ACCUM1="6REMOT" THEN TYPE ~ 19 ELSE 13088035
IF ACCUM1="5PUNCH" THEN TYPE~0 ELSE 13088040
IF ACCUM1="4DISK0" THEN BEGIN STOPDEFINE~TRUE ; 13088050
TYPE:=12; IF STEPI { IDMAX THEN BEGIN IF ACCUM1 := ACCUM[1] ! 13088060
"6SERIA" THEN BEGIN IF ACCUM1 = "6RANDO" THEN 13088070
TYPE:=TYPE-2 ELSE IF ACCUM1 = "6UPDAT" THEN 13088075
TYPE:=TYPE+1 ELSE 13088080
IF ACCUM1="7PROTE" THEN TYPE~26 ELSE 13088082
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
END; 13088110
STEPIT 13088120
END; 13088130
IF ELCLASS=STRNGCON THEN 13089000
BEGIN 13090000
GET7(ACCUM[1],G); 13091000
IF STEPI=STRNGCON 13092000
THEN 13093000
BEGIN 13094000
GET7(ACCUM[1],FILID); 13095000
STEPIT; 13096000
MULFID~G 13097000
END 13098000
ELSE 13099000
FILID~G; 13100000
END; 13101000
IF MKABS(IDARRAY[127]) - IDLOC.[33:15] < (26 + KOUNT).[41:4] 13101100
THEN FLAG(040) ELSE 13101200
ENTERID(IDLOC,FILENO ,TYPE,MULFID,FILID,INFO[(LASTINFO+1). 13102000
LINKR,(LASTINFO+1).LINKC],KOUNT); 13103000
IF ELCLASS!LEFTPAREN 13104000
THEN FLAG(26); 13105000
ARRAYFLAG~BOOLEAN(3) ; 13106000
13107000
EMITL(REAL(NOT(P2 OR P3)).[46:2]); 13108000
EMITL(FILENO);FILENO~FILENO+1; 13109000
CHECKDISJOINT(TAKE(LASTINFO).ADDRESS); 13110000
STEPIT;AEXP;EMITL(M); 13111000
COMMENT GUESS AT THE NO. OF BUFFERS DECLARED; 13112000
IF (IOTEMP~GET(L-2)).[46:2] = 0 THEN CURRENT ~ IOTEMP 13113000
DIV 4 ELSE CURRENT~2; 13114000
13115000
13116000
13117000
13118000
13119000
13120000
13121000
13122000
13123000
13124000
13125000
13126000
13127000
13128000
13129000
13130000
13131000
13132000
13133000
13134000
13135000
13136000
13137000
13138000
13139000
13140000
13141000
13142000
13143000
13144000
IF ELCLASS ! COMMA THEN BEGIN FLAG(27); GO TO START END 13145000
ELSE 13146000
BEGIN 13147000
STEPIT; AEXP; 13148000
; 13148100
IF (IOTEMP~GET(L-1)).[46:2] = 0 THEN IOTEMP~IOTEMP DIV 4 13148200
ELSE IOTEMP~ 256; 13148300
IF ELCLASS!COMMA 13149000
THEN 13150000
BEGIN 13151000
EMITL(0); 13152000
CALL5 ; 13153000
END 13154000
ELSE 13155000
BEGIN 13156000
IF GT1~FILEATTRIBUTEINDX(FALSE)=0 THEN 13157000
BEGIN AEXP; 13157010
IF (IOTEMPO:=GET(L-1)).[46:2] = 0 THEN 13157020
IF IOTEMPO DIV 4 > IOTEMP THEN 13157030
IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040
ELSE BEGIN 13158000
EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000
EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000
END ; 13161000
WHILE ELCLASS=COMMA DO 13162000
IF GT1~FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000
BEGIN ERR(291); GO START END 13164000
ELSE BEGIN 13165000
EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000
GT1~FILEATTRIBUTEHANDLER(FIO); 13167000
END ; 13168000
END ; 13169000
END ; 13170000
ARRAYFLAG~FALSE ; 13181000
IF ELCLASS!RTPAREN THEN FLAG(29); 13182000
COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000
IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000
% VOID 13185000
% VOID 13186000
END 13187000
UNTIL STEPI!COMMA; 13188000
STOPENTRY~FALSE; 13189000
END ELSE 13190000
BEGIN 13191000
IF G!FORMATV THEN FLAG(33) ELSE 13192000
IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN13193000
END; 13194000
START: 13195000
END; 13196000
PROCEDURE HANDLESWLIST; 13196300
BEGIN 13196310
LABEL OVER; 13196320
13196330
JUMPCHKX; 13196340
STOPENTRY~ NOT SPECTOG; 13196350
ENTRY(SUPERLISTID); 13196360
IF SPECTOG THEN GO TO OVER; 13196370
IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380
COMMENT MISSING ~; 13196390
EMITO(MKS); 13196400
CHECKDISJOINT(ADDRSF); 13196410
G~L; L~L+1; 13196420
EMITL(1); 13196430
EMITL(1); 13196440
EMITL(1); 13196450
EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460
LIST DESCRIPTORS FOR SWITCH LIST; 13196470
COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480
J~-1; STOPENTRY ~ FALSE; 13196490
DO 13196500
BEGIN 13196510
IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520
THEN BEGIN ERR(42); GO TO OVER END; 13196530
PASSLIST; 13196540
EMITL(J~J+1); 13196550
EMITN(ADDRSF); 13196560
EMITO(STD); COMMENT STORE LIST DESC IN ARRAY;13196570
END 13196580
UNTIL ELCLASS ! COMMA; 13196590
GT2~L; L~G; EMITL(J+1); L~GT2; 13196600
OVER: END OF HANDLESWLIST; 13196610
PROCEDURE SCATTERELBAT; 13197000
BEGIN 13198000
REAL T; 13199000
T ~ ELBAT[I]; 13200000
KLASSF ~ T.CLASS; 13201000
FORMALF ~ BOOLEAN(T.FORMAL); 13202000
VONF ~ BOOLEAN(T.VO); 13203000
LEVELF ~ T.LVL; 13204000
ADDRSF ~ T.ADDRESS; 13205000
INCRF ~ T.INCR; 13206000
LINKF ~ T.LINK; 13207000
END SCATTERELBAT; 13208000
PROCEDURE CHKSOB; 13209000
IF GTA1[J~J-1]!0 THEN FLAG(23); 13210000
DEFINE SUBOP=48#, 13211000
ADDC=532480#, 13212000
SUBC=1581056#, 13213000
EMITSTORE=EMITPAIR#; 13214000
PROCEDURE PURGE(STOPPER); 13215000
VALUE STOPPER; 13216000
REAL STOPPER; 13217000
BEGIN 13218000
INTEGER POINTER; 13219000
LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000
REAL J,N,OCR,TL,ADD; 13221000
POINTER~LASTINFO; 13222000
WHILE POINTER } STOPPER 13223000
DO 13224000
BEGIN 13225000
IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO 13226000
THEN BEGIN 13227000
NCII~NCII-1; 13228000
EMITNUM(TAKE(POINTER+1)); 13229000
EMITSTORE(MAXSTACK,STD); 13230000
MAXSTACK~(G~MAXSTACK)+1; 13231000
J~L; L~GT1.LINK; 13232000
DO 13233000
BEGIN 13234000
GT4~GET(L); 13235000
EMITV(G) 13236000
END 13237000
UNTIL (L~GT4)=4095; 13238000
L~J; 13239000
POINTER~POINTER-GT1.INCR 13240000
END 13241000
ELSE 13242000
BEGIN 13243000
IF NOT BOOLEAN(GT1.FORMAL) 13244000
THEN BEGIN 13245000
IF ELCLASS = LABELID 13246000
THEN BEGIN 13247000
ADD ~ GT1.ADDRESS; 13248000
IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1] 13249000
THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000
THEN BEGIN GT1 ~ 160; GO TO RECOV END; 13251000
IF ADD ! 0 THEN GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000
ELSE IF ELCLASS = SWITCHID 13253000
THEN BEGIN 13254000
IF TAKE(POINTER+1) < 0 13255000
THEN BEGIN GT1 ~ 162; GO TO RECOV END; 13256000
OCR ~(J ~ TAKE(GIT(POINTER))).[24:12]; 13257000
N ~ GET( (J~J.[36:12])+4); TL ~ L; 13258000
IF ADD ~ GT1.ADDRESS ! 0 13259000
THEN BEGIN 13260000
GT5 ~ PROGDESCBLDR(0,J,ADD); 13261000
IF OCR ! 0 13262000
THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000
L~J+11; EMITL(15); EMITO(RTS); 13264000
FOR J ~ 4 STEP 4 UNTIL N 13265000
DO BEGIN 13266000
EMITL(GNAT(GET(L)|4096+GET(L+1))); 13267000
EMITO(RTS) END END 13268000
ELSE BEGIN 13269000
L ~ J+13; 13270000
FOR J ~ 4 STEP 4 UNTIL N 13271000
DO BEGIN 13272000
GT1 ~ GET(L)|4096+GET(L+1); 13273000
GOGEN(GT1,BFW) END;END; 13274000
13275000
13276000
L ~ TL END 13277000
ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID 13278000
THEN IF TAKE(POINTER+1) < 0 13279000
THEN BEGIN GT1 ~ 161; 13280000
RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM);13281000
Q ~ ACCUM[1]; FLAG(GT1); ERRORTOG ~ TRUE END 13282000
END; 13283000
XREFDUMP(POINTER); % DUMP XREF INFO %116-13283500
GT2~TAKE(POINTER+1); 13284000
GT3~GT2.PURPT; 13285000
STACKHEAD[(0&GT2[12:12:36])MOD 125]~TAKE(POINTER).LINK; 13286000
POINTER~POINTER-GT3 13287000
END 13288000
END ; 13289000
LASTINFO~POINTER; 13290000
NEXTINFO~STOPPER 13291000
END; 13292000
PROCEDURE E; 13293000
COMMENT 13294000
E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND 13295000
HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK 13296000
IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY 13297000
E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE 13298000
BEGINNING OF THE NEXT ROW IF NECESSARY ;13299000
BEGIN 13300000
REAL WORDCOUNT,RINX; 13301000
IF RINX~(NEXTINFO+WORDCOUNT~(COUNT+18)DIV 8 ).LINKR ! 13302000
NEXTINFO.LINKR 13303000
THEN BEGIN PUT(0&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO); 13304000
NEXTINFO~256|RINX END; 13305000
IF SPECTOG THEN 13305100
IF NOT MACROID THEN 13305200
UNHOOK; 13305300
KOUNT~COUNT; 13306000
ACCUM[0].INCR~WORDCOUNT; 13307000
ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO; 13308000
ACCUM[1].PURPT~NEXTINFO-LASTINFO; 13309000
MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000
IF XREF THEN % MAKE DECLARATION REFERENCE %116-13310050
IF (ACCUM[0].CLASS ! DEFINEDID OR NOT %116-13310075
BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER%116-13310080
BEGIN %116-13310100
XREFINFO[NEXTINFO] := %116-13310200
IF SPECTOG THEN %116-13310300
XREFINFO[ELBAT[I]] %116-13310350
ELSE %116-13310400
((XLUN := XLUN + 1) & SGNO SEGNOF); %116-13310450
IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY %116-13310500
XMARK(DECLREF) %116-13310525
ELSE %116-13310550
XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG%116-13310575
THEN NORMALREF ELSE DECLREF); %116-13310580
END %116-13310600
ELSE % DEFINE PARAMETERS - DONT CROSS REF. %116-13310700
XREFINFO[NEXTINFO] := 0 %116-13310750
ELSE %116-13310800
IF DEFINING.[1:1] THEN % WE ARE DOING XREFING %116-13310900
XREFINFO[NEXTINFO] := 0; %116-13310950
LASTINFO~NEXTINFO; 13311000
IF NEXTINFO ~ NEXTINFO+WORDCOUNT } 8192 THEN 13312000
BEGIN FLAG(199); GO TO ENDOFITALL END; 13312500
END; 13313000
PROCEDURE ENTRY(TYPE); 13314000
VALUE TYPE; 13315000
REAL TYPE; 13316000
COMMENT 13317000
ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH 13318000
IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT 13319000
ACCORD TO TYPE .IF THE ENTRY IS AN ARRAY AND NOT 13320000
A SPECIFICATION THEN A DESCRIPTOR IS PLACED IN THE STACK 13321000
FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) ;13322000
BEGIN 13323000
BOOLEAN SVTOG;% 13323010
J~0;I~I-1; 13324000
DO 13325000
BEGIN 13326000
STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT; 13327000
IF FORMALF~SPECTOG 13328000
THEN 13329000
BEGIN 13330000
IF TYPE{INTARRAYID AND TYPE}BOOARRAYID THEN% 13330550
IF VONF THEN BEGIN SVTOG ~ ERRORTOG; FLAG(15);% 13330600
SPECTOG ~ ERRORTOG ~ SVTOG; END;% 13330650
IF ELCLASS!SECRET 13331000
THEN FLAG(002); 13332000
BUP~BUP+1 13333000
END 13334000
ELSE 13335000
BEGIN 13336000
IF ELCLASS>IDMAX AND ELCLASS{FACTOP 13337000
THEN FLAG(003); 13338000
IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 13339000
IF NOT (PTOG OR STREAMTOG) AND LINKF } GLOBALNINFOO 13339100
THEN FLAG(1) %118-13339200
ELSE %118-13339300
ELSE %118-13339400
IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION %118-13339500
FLAG(1); %118-13340000
VONF~P2; 13341000
IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000
THEN ADDRSF ~ 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 13457000
ELSE 13458000
IF T1= SAVEV THEN 13459000
BEGIN 13460000
P3:=TRUE; 13461000
IF SPECTOG THEN FLAG(13); 13462000
% IF REMOTOG THEN FLAG(508); % NOT ALLOWED IN XALGOL ON TSS. 13463000
END 13464000
ELSE 13465000
IF T1= AUXMEMV THEN 13466000
BEGIN P4:=TRUE; IF SPECTOG THEN FLAG(13) END 13467000
ELSE 13468000
TYPEV :=REALID+T1; 13469000
IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000
ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000
BETA1: 13472000
IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ~0;SAVEDIM~1; 13473000
TWO:IF STEPI=ADOP THEN 13474000
BEGIN 13475000
T1~ELBAT[I].ADDRESS; I~I+1 13476000
END 13477000
ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000
ARPROGS~L; 13479000
IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000
BEGIN 13481000
LLITOG~TRUE; 13482000
IF T3~ELBAT[I].ADDRESS!0 13483000
THEN 13484000
BEGIN 13485000
EMITL(T3); 13486000
IF T1=SUBOP THEN 13487000
BEGIN 13488000
EMITO(CHS); 13489000
ADDCON~ADDC 13490000
END ELSE 13491000
ADDCON~SUBC 13492000
END; 13493000
T2~T3|4+ADDCON 13494000
END 13495000
ELSE 13496000
BEGIN 13497000
LLITOG~FALSE; 13498000
IF T1!0 THEN I~I-1; 13499000
T2:=GETSPACE(P2,-1);%TEMP. 13500000
AEXP;EMITSTORE(T2,ISN); 13501000
T2~T2|4+SUBC+2; 13502000
IF ELCLASS!COLON THEN 13503000
FLAG(017);I~I-1 13504000
END; 13505000
IF P2 THEN 13506000
BEGIN 13507000
IF LLITOG AND T3=0 THEN EMITL(0);13508000
ARPROGS~L;EMITO(DUP); 13509000
END; 13510000
IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000
BEGIN 13512000
IF T~TABLE(I~I+1)=COMMA OR 13513000
T=RTBRKET 13514000
THEN 13515000
BEGIN 13516000
EMITL(T4~ELBAT[I-1].ADDRESS);13517000
ULITOG~TRUE;GO TO CSZ 13518000
END 13519000
ELSE 13520000
I~I-1 13521000
END; 13522000
ULITOG~FALSE; 13523000
AEXP; 13524000
EMITL(JUNK); 13525000
EMITO(ISN); 13526000
CSZ: IF LLITOG AND ULITOG THEN 13527000
BEGIN 13528000
L~ARPROGS; 13529000
IF(T~IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000
T4-T3+1){0 OR T>1023 THEN FLAG(59); 13531000
EMITL(T); 13531100
IF P3 THEN BEGIN SAVEDIM~SAVEDIM|T; 13532000
IF SAVEDIM>MAXSAVE 13533000
THEN MAXSAVE~SAVEDIM 13534000
END 13535000
ELSE 13536000
IF T>MAXROW THEN MAXROW~T; 13537000
END 13538000
ELSE 13539000
BEGIN IF NOT(LLITOG AND T3=0) 13540000
OR P2 13541000
THEN 13542000
BEGIN 13543000
EMITO(XCH);EMITO(SUB) 13544000
END;EMITL(1);EMITO(ADD) 13545000
END; 13546000
SLB:PUTNBUMP(T2);LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547000
ELSE 13548000
IF T!RTBRKET THEN FLAG(018); 13549000
IF 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 JUMPCHKX; 13596000
COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000
WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000
ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000
IS THE FIRST EXECUTABLE CODE; 13600000
IF NOT SPECTOG THEN 13601000
BEGIN 13602000
IF AJUMP 13603000
THEN 13604000
BEGIN ADJUST; 13605000
EMITB(BFW,SAVEL,L) 13606000
END ELSE 13607000
IF FIRSTX=4095 13608000
THEN 13609000
BEGIN 13610000
ADJUST; 13611000
FIRSTX~L; 13612000
END; 13613000
AJUMP~FALSE 13614000
END; 13615000
PROCEDURE JUMPCHKNX; 13616000
COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000
EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000
NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED 13619000
AND SAVED FOR A LATER BRANCH; 13620000
IF NOT SPECTOG THEN 13621000
BEGIN 13622000
IF FIRSTX!4095 13623000
THEN 13624000
BEGIN 13625000
IF NOT AJUMP 13626000
THEN 13627000
SAVEL~BUMPL; 13628000
AJUMP~TRUE 13629000
END;ADJUST 13630000
END; 13631000
PROCEDURE SEGMENTSTART; 13632000
BEGIN 13632100
IF NOHEADING THEN DATIME; 13633000
IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100
ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200
END SEGMENTSTART; 13633300
PROCEDURE SEGMENT(SIZE,NO,NOO); %106-13634000
VALUE SIZE,NO,NOO; %106-13635000
REAL SIZE,NO,NOO; %106-13636000
BEGIN %106-13637000
INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT %106-13637100
% IS NOT TOO BIG %106-13637200
PDPRT[PDINX.[37:5],PDINX.[42:6]] := %106-13638000
SIZE & NO[28:38:10] & %106-13639000
MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & %106-13640000
REAL(SAVEPRTOG)[3:47:1]; %106-13641000
PDINX:=PDINX+1; SIZE:=ABS(SIZE); %106-13642000
IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; %106-13643000
AKKUM:=AKKUM+SIZE; %106-13644000
IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16|(SIZE.[38:6]+1); %106-13645000
IF LISTER OR SEGSTOG THEN %106-13646000
BEGIN %106-13647000
IF NOHEADING THEN DATIME; %106-13648000
IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) %106-13649000
ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); %106-13650000
END; %106-13651000
LDICT[NO.[38:3],NO.[41:7]] := %106-13652000
IF BUILDLINE THEN %106-13653000
MOVEANDBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] %106-13654000
ELSE -1; %106-13655000
END OF SEGMENT; %106-13656000
13697000
13698000
13699000
13700000
13701000
13702000
13703000
13704000
13705000
13706000
13707000
13708000
13709000
13710000
13711000
13712000
13713000
PROCEDURE ENTER(TYPE); VALUE TYPE; INTEGER TYPE; 13714000
BEGIN 13715000
G:=GTA1[J:=J-1]; 13716000
IF NOT SPECTOG THEN 13717000
BEGIN 13718000
IF NOT P2 THEN 13719000
IF P2:=(G=OWNV) THEN G:=GTA1[J:=J-1]; 13720000
IF NOT P3 THEN 13721000
IF P3:=(G=SAVEV) THEN G:=GTA1[J:=J-1]; 13722000
IF NOT P4 THEN 13723000
IF P4:=(G=AUXMEMV) THEN G:=GTA1[J:=J-1]; 13724000
END; 13725000
IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE) 13726000
END ENTER; 13727000
13728000
13729000
13730000
PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000
VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD; 13732000
BOOLEAN GOTSTORAGE; 13733000
REAL RELAD,STOPPER,PRTAD; 13734000
BEGIN 13735000
BOOLEAN BT; 13736000
REAL K,LS; 13737000
LS~RELAD; 13738000
BT~JUMPCTR=LEVEL; 13739000
IF FUNCTOG 13740000
THEN 13741000
BEGIN 13742000
EMITV(514); 13743000
EMITO(RTN) 13744000
END 13745000
ELSE 13746000
EMITO(XIT); 13747000
IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000
CONSTANTCLEAN; 13749000
IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000
THEN 13751000
BEGIN ADJUST;LS~L; 13752000
IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000
THEN 13754000
BEGIN 13755000
% 13755500
EMITV(BLOCKCTR); 13756000
EMITL(1); 13757000
EMITO(ADD); 13758000
IF GOTSTORAGE OR FAULTOG.[46:1] 13759000
THEN 13760000
EMITSTORE(BLOCKCTR,SND) 13761000
END 13762000
% 13762500
ELSE EMITL(0); 13763000
K~K+NCII; 13764000
WHILE K~K-1}0 13765000
DO EMITL(0); 13766000
PURGE(STOPPER); 13767000
IF FAULTLEVEL{LEVEL THEN 13767100
BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200
EMITPAIR(0,MDS); EMITO(CHS); 13767300
END OF THIS PART OF ERROR KLUDGE; 13767400
EMIT(0); % DC & DISK 13767500
BUMPL; 13768000
13768100
EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000
CONSTANTCLEAN 13770000
END ELSE PURGE(STOPPER); 13771000
Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000
END HTTEOAP; 13773000
PROCEDURE FORMATGEN; 13774000
BEGIN 13775000
INTEGER PRT;LABEL L; 13776000
BOOLEAN TB2; 13777000
ARRAY TEDOC[0:7,0:127]; 13777500
MOVECODE(TEDOC,EDOC); 13777600
BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700
TB2~GTA1[J-1]=SWITCHV; 13778000
GT5~SGNO; 13779000
L: GT1:=(2|SGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000
IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002
SGNO~SGAVL; 13781000
13782000
F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000
Z~PROGDESCBLDR(LDES,0,PRT); 13784000
IF TB2 THEN 13785000
BEGIN 13786000
ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(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 <FAULT LIST> 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 GT1<FAULTID THEN ERR(3);13911300
LEVELF~ELBAT[I].LVL; 13911400
END ELSE COUNT~(ACCUM[1]~A).[12:6]; 13911500
IF LEVELF=LEVEL THEN ERR (1) ELSE 13912000
BEGIN KLASSF:=FAULTID; ADDRSF:=GETSPACE(FALSE,1); 13913000
FORMALF~VONF~FALSE; 13913100
EMITL(TP); IF MODE=0 THEN BEGIN EMITL(0); 13914000
EMITPAIR(ADDRSF,STD);END; EMITN(ADDRSF); 13915000
EMIT ("!E"); COMMENT C-TO-F; 13916000
MAKEUPACCUM; E; STEPIT 13917000
END; END; END UNTIL ELCLASS!COMMA; 13918000
EMITL(J); EMITL(13); EMITV(5); 13919000
END FAULTDEC; 13920000
COMMENT THIS SECTION CONTAINS THE BLOCK ROUTINE ; 14000000
PROCEDURE BLOCK(SOP); 14001000
VALUE SOP; 14002000
BOOLEAN SOP; 14003000
COMMENT SOP IS TRUE IF THE BLOCK WAS CALLED BY ITSELF THROUGH THE 14004000
PROCEDURE DECLARATION-OTHERWISE IT WAS CALLED BY STATEMENT. 14005000
THE BLOCK ROUTINE IS RESPONSIBLE FOR HANDLING THE BLOCK 14006000
STRUCTURE OF AN ALGOL PROGRAM-SEGMENTING EACH BLOCK,HANDLING 14007000
ALL DECLARATIONS,DOING NECESSARY BOOKKEEPING REGARDING EACH 14008000
BLOCK, AND SUPPLYING THE SCANNER WITH ALL NECESSARY INFORMATION 14009000
ABOUT DECLARED IDENTIFIERS. 14010000
IT ALSO WRITES EACH SEGMENT ONTO THE PCT; 14011000
BEGIN 14012000
LABEL OWNERR,SAVERR,BOOLEANDEC,REALDEC,ALPHADEC,INTEGERDEC, 14013000
LABELDEC,DUMPDEC,LISTDEC,OUTDEC,INDEC,MONITORDEC, 14014000
SWITCHDEC,PROCEDUREDEC,ARRAYDEC,FORMATDEC,FILEDEC, 14015000
GOTSCHK,FIELDDEC,AUXMEMERR, %117-14016000
STREAMERR,DEFINEDEC,CALLSTATEMENT,HF,START; 14017000
SWITCH DECLSW~ OWNERR,SAVERR,BOOLEANDEC,REALDEC,ALPHADEC,INTEGERDEC, 14018000
LABELDEC,DUMPDEC,LISTDEC,OUTDEC,INDEC,MONITORDEC, 14019000
SWITCHDEC,PROCEDUREDEC,ARRAYDEC,FORMATDEC,FILEDEC, 14020000
STREAMERR,DEFINEDEC,AUXMEMERR,FIELDDEC; %117-14021000
DEFINE NLOCS=10#,LOCBEGIN=PRTI#, 14022000
LBP=[36:12]#, 14023000
SPACEITDOWN = BEGIN WRITE(LINE[DBL]); WRITE(LINE[DBL]) END#; 14023100
ARRAY TEDOC[0:7,0:127],LOCALS[0:NLOCS]; 14024000
ARRAY TENIL[0:7,0:127]; 14024100
INTEGER OLDLASTADDRESS; 14024200
INTEGER OLDENILPTR; 14024300
BOOLEAN GOTSTORAGE; 14025000
BOOLEAN FWDTOG; COMMENT PREVIOUS FORWARD DECLARATION INDICATOR; 14025100
INTEGER PINFOO,BLKAD; 14026000
COMMENT LOCAL TO BLOCK TO SAVE WHERE A PROCEDURE IS EMTERED 14027000
IN INFO; 14028000
REAL MAXSTACKO,LASTINFOT,RELAD,LO,TSUBLEVEL,STACKCTRO; 14029000
INTEGER SGNOO,LOLD,SAVELO,PRTIO,NINFOO; 14030000
INTEGER NCIIO; 14031000
INTEGER PROAD ; 14032000
INTEGER NTEXTO; 14032500
INTEGER FIRSTXO; 14033000
BOOLEAN FUNCTOGO,AJUMPO,FAULTOGO; 14034000
BOOLEAN SAVEPRTOGO, NEXTSAVE; 14034100
BEGINCTR~BEGINCTR+1; 14035000
IF SOP THEN BLKAD~PROADO 14036000
14037000
14038000
14039000
14040000
14041000
14042000
14043000
ELSE BEGIN BLKAD:=GETSPACE(TRUE,-6); % SEG. DESCR. 14044000
EMITV(BLKAD); 14045000
EMITO(BFW); 14046000
CONSTANTCLEAN 14047000
END; 14048000
MOVECODE(TEDOC,EDOC); MOVECODE(TENIL,ENIL); 14049000
OLDLASTADDRESS ~ LASTADDRESS; LASTADDRESS ~ -1; 14049100
OLDENILPTR ~ ENILPTR; ENILPTR ~ 0; 14049200
ENILSPOT~0&CARDNUMBER[10:20:28] ; ENILPTR~1 ; 14049300
MOVE(NLOCS,LOCBEGIN,LOCALS); 14050000
FIRSTXO~FIRSTX; 14051000
FIRSTX~4095; 14052000
IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14053000
ELSE FLAG(039); 14053100
LOLD~L;FUNCTOGO~FUNCTOG;AJUMPO~AJUMP;PRTIO~PRTI;SGNOO~SGNO; 14054000
SAVELO := SAVEL; %118-14055000
AJUMP := FALSE; % NO PENDING JUMPS IN THIS BLOCK YET. %118-14055100
L := 0; % START GENERATING CODE AT WORD 0, SYLLABLE 0. 14055200
OLDNINFOO := GLOBALNINFOO; % REMEMBER WHERE PREVIOUS BLOCKS %118-14055250
% SYMBOLS BEGAN IN SYMBOL TABLE. %118-14055260
GLOBALNINFOO := NINFOO := NEXTINFO; % REMEMBER WHERE THE SYMBOLS 14055300
% FROM THIS BLOCK WILL GO%118-14055400
% IN THE SYMBOL TABLE. %118-14055450
NTEXTO ~ NEXTTEXT; 14055500
NCIIO~NCII; 14056000
NCII~0; 14057000
STACKCTRO~STACKCTR; 14058000
FAULTOGO~FAULTOG; FAULTOG~ 14058100
GOTSTORAGE~FALSE; 14059000
SAVEPRTOG := (SAVEPRTOGO := SAVEPRTOG) OR SOP.[46:1]; 14059100
IF LISTER OR SEGSTOG THEN SEGMENTSTART; 14060000
SGNO~SGAVL; SGAVL~SGAVL+1; 14061000
ELBAT[I].CLASS~SEMICOLON; 14062000
START: IF TABLE(I)!SEMICOLON 14063000
THEN 14064000
BEGIN 14065000
FLAG(0); 14066000
I~I-1 14067000
END; 14068000
GTA1[0]~J~0; 14069000
IF SPECTOG 14070000
THEN 14071000
BEGIN 14072000
IF BUP=PJ 14073000
THEN 14074000
BEGIN 14075000
BEGIN LABEL GETLP; 14076000
IF STREAMTOG THEN F~0 ELSE 14077000
F~FZERO; 14078000
BUP~LASTINFO; 14079000
DO 14080000
BEGIN 14081000
IF NOT STREAMTOG THEN 14082000
BUP~LASTINFO; 14083000
GETLP: G~TAKE(BUP); 14084000
IF K~G.ADDRESS!PJ 14085000
THEN 14086000
BEGIN 14087000
IF BUP ! BUP:=BUP- TAKE(BUP + 1).PURPT THEN %102-14088000
GO TO GETLP 14089000
END; 14090000
IF TYPEV~G.CLASS=FRMTID OR TYPEV=SUPERFRMTID THEN 14091000
G.ADDRESS~F~F+2 14092000
ELSE 14093000
IF TYPEV~G.CLASS{INTARRAYID AND 14094000
TYPEV}BOOARRAYID 14095000
THEN 14096000
BEGIN 14097000
T1~G.INCR; 14098000
GT1 ~N~TAKE(BUP+T1); 14099000
G.ADDRESS~F~F+N+1; 14100000
WHILE N!0 14101000
DO 14102000
BEGIN 14103000
IF T2~TAKE(BUP+T1+N)<0 14104000
THEN 14105000
BEGIN 14106000
T2~-T2; 14107000
T2.LBP~4|(F-N)+2; 14108000
PUT(T2,BUP+T1+N) 14109000
END; 14110000
N~N-1 14111000
END 14112000
END 14113000
ELSE 14114000
G.ADDRESS~F~F+1; 14115000
PUT(G,BUP); G.INCR~GT1; 14116000
IF FWDTOG THEN COMMENT CHECK CORRESPONDENCE W/ FWD; 14116100
BEGIN 14116200
IF(GT1~TAKE(MARK+PJ)).CLASS ! G.CLASS 14116300
COMMENT CLASS ERROR; THEN FLAG(49); 14116400
COMMENT VALUE ERROR; IF GT1.VO ! G.VO THEN FLAG(50) 14116500
END ELSE 14116600
PUT(G,MARK+PJ) 14117000
;BUP~BUP-TAKE(BUP+1).PURPT 14118000
END 14119000
UNTIL PJ~PJ-1=0 14120000
END; 14121000
SPECTOG~FALSE; 14122000
GO TO HF 14123000
END 14124000
END; 14125000
STACKCT ~ 0; %A 14125500
WHILE STEPI=DECLARATORS 14126000
DO 14127000
BEGIN 14128000
STOPDEFINE~(GTA1[J~J+1]~ELBAT[I].ADDRESS)!MONITORV AND 14129000
GTA1[J]!DUMPV;ERRORTOG~TRUE; 14130000
END; 14131000
IF J =0 THEN GO TO CALLSTATEMENT; 14132000
P2:=P3:=P4:=FALSE; 14133000
GO TO DECLSW[GTA1[J]]; 14134000
OWNERR:FLAG(20);J~J+1;GO TO REALDEC; 14135000
SAVERR:FLAG(21);J~J+1;GO TO REALDEC; 14136000
AUXMEMERR:FLAG(618);J:=J+1;GO TO REALDEC; %117-14136100
STREAMERR:FLAG(22);J~J+1;GO TO PROCEDUREDEC; 14137000
REALDEC:P3~TRUE;ENTER(REALID);GO TO START; 14138000
ALPHADEC:P3~TRUE;ENTER(ALFAID);GO TO START; 14139000
BOOLEANDEC:P3~TRUE;ENTER(BOOID);GO TO START; 14140000
INTEGERDEC:P3~TRUE;ENTER(INTID);GO TO START; 14141000
MONITORDEC:IF SPECTOG 14142000
THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR 14143000
DECLARATION APPEARS IN THE SPECIFICATION 14144000
PART OF A PROCEDURE; 14145000
FLAG(463); 14146000
END; 14147000
IF MERRIMAC THEN BEGIN FAULTDEC; GO GOTSCHK END; GO START;14148000
DUMPDEC:IF SPECTOG 14149000
THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION 14150000
APPEARS IN THE SPECIFICATION PART OF A 14151000
PROCEDURE; 14152000
FLAG(464); 14153000
END; 14154000
DMUP; GO TO START; 14155000
ARRAYDEC:JUMPCHKX;ARRAE;GO TO GOTSCHK; 14156000
FILEDEC:J~J+1;IODEC(11);GO TO GOTSCHK; 14157000
INDEC: IODEC(9); IF G!FORMATV THEN GO GOTSCHK; GO START;% 14158000
OUTDEC: IODEC(10); IF G=FORMATV THEN GO TO START; 14159000
GOTSCHK:GOTSTORAGE~ NOT SPECTOG OR GOTSTORAGE;GO TO START; 14160000
FORMATDEC:IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV)) ELSE 14161000
FORMATGEN; GO TO START; 14162000
LISTDEC: 14163000
BEGIN 14164000
REAL SAVEINFO; 14165000
LABEL START; 14166000
IF G:=GTA1[J]=LISTV AND G:=GTA1[J-1]=SWITCHV THEN 14167000
BEGIN HANDLESWLIST; GO TO GOTSCHK END; 14168000
IF SPECTOG THEN 14169000
BEGIN ENTRY(LISTID); GO TO START END; 14170000
STOPENTRY:=STOPGSP:=TRUE; I:=I-1; 14171000
DO BEGIN 14172000
I:=I+1; JUMPCHKX; 14173000
ENTRY(LISTID); IF ELCLASS!LEFTPAREN THEN FLAG(31) ELSE STEPIT; 14174000
SAVEINFO:=LASTINFO; % IN CASE C-RELATIVE CONSTANTS ARE 14175000
% EMITTED B4 DOING THE PUT-TAKE BELOW. 14176000
F:=LISTGEN; 14177000
PUT(TAKE(SAVEINFO)&(IF MODE=0 THEN F 14178000
ELSE F:=GETSPACE(FALSE,SAVEINFO+1)) % LIST DESCR. 14179000
[16:11],SAVEINFO); 14180000
EMITSTORE(F,STD); 14181000
END UNTIL ELCLASS! COMMA; 14182000
STOPENTRY:=STOPGSP:=FALSE; 14183000
START: 14184000
END LISTDEC; 14185000
GO TO START; 14186000
LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24); 14187000
STOPENTRY~STOPGSP~TRUE; 14188000
I~I-1; 14189000
DO 14190000
BEGIN 14191000
STOPDEFINE~TRUE; 14192000
STEPIT; 14193000
ENTRY(LABELID); 14194000
PUTNBUMP(0) 14195000
END 14196000
UNTIL ELCLASS!COMMA; 14197000
STOPENTRY~STOPGSP~FALSE; 14198000
GO TO START; 14199000
SWITCHDEC: 14200000
BEGIN 14201000
LABEL START; 14202000
INTEGER GT1,GT2,GT4,GT5; 14203000
BOOLEAN TB1; 14204000
STOPENTRY~NOT SPECTOG;STOPGSP~TRUE; 14205000
SCATTERELBAT; GT1~0; TB1~FALSE; 14206000
IF LEVELF=LEVEL 14207000
THEN 14208000
BEGIN 14209000
IF TAKE(LINKF+1)}0 14210000
THEN FLAG(1); PUT(-TAKE(LINKF+1),LINKF+1); 14211000
TB1~TRUE;GT2~ADDRSF; 14212000
GT1~ TAKEFRST; GT4~LASTINFO; LASTINFO~LINKF; 14213000
STEPIT;GT5~NEXTINFO;NEXTINFO~LINKF+INCRF 14214000
END 14215000
ELSE 14216000
ENTRY(SWITCHID); STOPGSP~STOPENTRY~FALSE;IF SPECTOG THEN GO TO 14217000
START; 14218000
IF ELCLASS=ASSIGNOP 14219000
THEN 14220000
BEGIN 14221000
JUMPCHKNX;PUTNBUMP(L);G~L; 14222000
IF FORMALF := SWITCHGEN(TB1,GT1) %113-14223000
THEN 14224000
BEGIN 14225000
JUMPCHKX; 14227000
STUFFF(GT1); 14228000
IF MODE>0 14229000
THEN 14230000
IF TB1 THEN GT1~GT2 ELSE 14231000
GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000
EMITSTORE(GT1,STD) 14233000
END; 14234000
END 14235000
ELSE 14236000
BEGIN 14237000
IF ELCLASS!FORWARDV THEN FLAG(33); 14238000
PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000
PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000
IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000
STEPIT; 14242000
FORMALF~TRUE 14243000
END; 14244000
PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]&GT1[16:37:11],LASTINFO); 14245000
IF TB1 THEN 14246000
BEGIN 14247000
NEXTINFO~GT5; 14248000
LASTINFO~GT4; 14249000
END; 14250000
START: 14251000
END SWITCHDEC; 14252000
GO TO START; 14253000
DEFINEDEC: 14254000
BEGIN LABEL START; 14254050
REAL J,K,DINFO,LINKA,LINKB; %118 14254100-
STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000
DEFINING := BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 14255500
DO 14256000
BEGIN 14257000
STOPDEFINE:=TRUE; 14258000
STEPIT; MOVE(9,ACCUM[1],GTA1); 14259000
K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID); 14259010
GTA1[0]~J+"100000"; J~0; 14259015
DINFO ~ LASTINFO; 14259017
IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020
BEGIN 14259030
IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040
DO BEGIN STOPDEFINE~TRUE; 14259060
STEPIT; 14259070
IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075
MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080
DEFINEPARAM(DINFO+1, J); 14259085
ACCUM[0] := 0 & DEFINEDID CLASS & 1 FORMAL; %116-14259090
LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094
E; 14259096
IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098
PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100
STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102
STOPDEFINE ~ TRUE; 14259104
END UNTIL STEPI!COMMA; 14259110
IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120
STOPDEFINE~TRUE; 14259130
STEPIT; 14259140
PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150
PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155
END; 14259160
IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000
THEN 14261000
BEGIN 14262000
FLAG(45); 14263000
COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100
I~I-1; 14264000
END; 14265000
MACROID~TRUE; 14265900
LASTINFO ~ DINFO; 14265930
PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950
DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000
MACROID~FALSE; 14266100
END 14267000
UNTIL STEPI!COMMA; 14268000
DEFINING := BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 14268500
START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000
FIELDDEC: %117-14269020
BEGIN %117-14269040
REAL SAVEINFO, SB, NB; %117-14269060
BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC.%117-14269080
LABEL EXIT, SAVEIT; %117-14269100
STOPENTRY := STOPGSP := TRUE; %117-14269120
I := I - 1; %117-14269140
DO %117-14269160
BEGIN %117-14269180
STOPDEFINE := TRUE; %117-14269200
STEPIT; %117-14269220
ENTRY(FIELDID); %117-14269240
SAVEINFO := LASTINFO; %117-14269260
IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN %117-14269280
BEGIN %117-14269300
IF STEPI = LFTBRKET THEN % REMEMBER THIS %117-14269320
BEGIN %117-14269340
FOUNDLB := TRUE; %117-14269360
STEPIT; %117-14269380
END %117-14269400
ELSE %117-14269420
FOUNDLB := FALSE; %117-14269440
IF ELCLASS = FIELDID THEN %117-14269442
BEGIN %117-14269444
SB := ELBAT[I].SBITF; %117-14269446
NB := ELBAT[I].NBITF; %117-14269448
GO TO SAVEIT; %117-14269450
END; %117-14269452
IF ELCLASS = LITNO THEN %117-14269460
IF STEPI = COLON THEN %117-14269480
IF STEPI = LITNO THEN %117-14269500
IF (SB := ELBAT[I-2].ADDRESS) | %117-14269520
(NB := ELBAT[I].ADDRESS) ! 0 AND %117-14269540
SB + NB { 48 THEN %117-14269560
BEGIN %117-14269580
SAVEIT: %117-14269590
PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, %117-14269600
SAVEINFO); %117-14269620
STEPIT; %117-14269640
IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. %117-14269660
IF ELCLASS = RTBRKET THEN %117-14269680
BEGIN %117-14269700
STEPIT; %117-14269705
GO TO EXIT; %117-14269710
END %117-14269715
ELSE %117-14269720
ELSE %117-14269740
GO TO EXIT; %117-14269760
END; %117-14269780
END; %117-14269800
FLAG(114); %117-14269820
DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; %117-14269840
EXIT: %117-14269860
END %117-14269880
UNTIL %117-14269900
ELCLASS ! COMMA; %117-14269920
STOPENTRY := STOPGSP := FALSE; %117-14269940
END; %117-14269960
GO TO START; %117-14269980
PROCEDUREDEC: 14270000
BEGIN 14271000
LABEL START,START1; 14272000
LABEL START2, DOITANYWAY; 14273000
COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000
IF NOT SPECTOG THEN FUNCTOG~FALSE; 14275000
FWDTOG := NEXTSAVE := FALSE; 14276000
IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500
MAXSTACKO~ MAXSTACK; 14277000
IF G~GTA1[J~J-1]=STREAMV 14278000
THEN 14279000
BEGIN STREAMTOG~TRUE; 14280000
IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000
ELSE 14282000
BEGIN 14283000
IF TYPEV~PROCID +G>INTSTRPROCID OR 14284000
TYPEV <BOOSTRPROCID 14285000
THEN FLAG(004); 14286000
IF NOT SPECTOG THEN 14287000
FUNCTOG~TRUE; 14288000
CHKSOB 14289000
END END 14290000
ELSE 14291000
IF G=0 THEN TYPEV~PROCID 14292000
ELSE 14293000
IF (TYPEV:=REALSTRPROCID+G)=INTSTRPROCID THEN 14294000
BEGIN NEXTSAVE:=TRUE; TYPEV:=PROCID END ELSE 14294100
IF TYPEV<BOOPROCID OR TYPEV>INTPROCID THEN FLAG(005) 14295000
ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100
IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000
END; 14297000
IF SPECTOG 14298000
THEN 14299000
BEGIN 14300000
ENTRY(TYPEV); GO TO START2 14301000
END; 14302000
MODE~MODE+1; 14303000
LO~PROINFO; 14304000
SCATTERELBAT; 14305000
COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000
IF LEVELF=LEVEL 14307000
THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000
BEGIN 14309000
IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000
XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST %116-14310500
% XREF ENTRY AS A DECLARATION. %116-14310501
IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100
FWDTOG~TRUE; 14312000
PROAD~ADDRSF; 14313000
PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT 14314000
END 14316000
ELSE 14317000
DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000
ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000
PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000
P2~STOPENTRY~FALSE 14321000
END; 14322000
IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000
ELSE FLAG(039); 14323100
PJ ~ 0; 14323200
IF STREAMTOG THEN STREAMWORDS; 14324000
IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000
IF ELCLASS!LEFTPAREN THEN FLAG(007); 14326000
COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000
FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000
RR1~NEXTINFO; 14329000
LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000
PUTNBUMP(0); 14331000
PTOG~TRUE; I~I+1; 14332000
ENTRY(SECRET); 14333000
IF FWDTOG THEN BEGIN IF GT1 ~ TAKE(MARK).[40:8] ! PJ THEN% 14333100
FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200
COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300
PUT(PJ,MARK); 14334000
P~PJ; 14335000
IF ELCLASS!RTPAREN 14336000
THEN 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 %116-14445100
G~(GT2~TAKE(J+1)).PURPT; 14446000
IF GT1.[2:8] ! STLABID|2+1 THEN 14447000
STACKHEAD[(0&GT2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000
END UNTIL J~J-G{1; 14449000
PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000
[13:37:11],MARK); 14451000
GT1~ L; L ~ FILETHING ; 14451100
WHILE L ! 4095 DO 14451200
BEGIN FILETHING ~ GET(L); 14451300
EMITC(PJ+1,RSA); 14451400
L ~ FILETHING; 14451500
END; 14451600
L ~ GT1; FILETHING ~ 4095 ; 14451700
IF FUNCTOG THEN 14452000
BEGIN 14453000
EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000
EMITC(PJ+2,SED); 14455000
EMITC(1,TRW); 14456000
PUT(Z, PROINFO); 14457000
END; 14458000
EMIT(0); 14459000
STREAMWORDS; 14460000
STREAMTOG~FALSE; 14461000
IF LISTER AND FORMATOG THEN SPACEITDOWN; 14461500
END; 14462000
LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000
END 14464000
ELSE 14465000
BEGIN 14466000
IF STEPI=FORWARDV 14467000
THEN 14468000
BEGIN 14469000
XREFIT(PROINFO,0,FORWARDREF); % WE NEED THIS SO WE CAN FIND 14469100
% THE FORWARD DECL. DURING XREF 14469101
PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000
PURGE(PINFOO); 14471000
STEPIT 14472000
END 14473000
ELSE 14474000
BEGIN 14475000
PROADO~PROAD; 14476000
TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000
% 14478000
COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010
COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020
IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030
MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040
IF ELCLASS = BEGINV THEN 14479000
IF TABLE(I+1) = DECLARATORS THEN 14480000
BEGIN 14481000
BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000
; PURGE(PINFOO); 14483000
GO TO STOP END; 14484000
BEGIN 14485000
JUMPCHKNX; 14486000
RELAD~L ; 14487000
IF NEXTSAVE THEN FLAG(052); 14487010
STMT; 14488000
IF FAULTOG.[46:1] THEN BEGIN EMITL(10); EMITO(COM); END;14488500
HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000
END; 14490000
STOP: 14491000
SUBLEVEL~TSUBLEVEL; 14492000
STACKCTR~STACKCTRO; 14493000
IF LISTER AND FORMATOG THEN SPACEITDOWN; 14493500
END; 14494000
END; 14495000
PROINFO~LO; 14496000
IF JUMPCTR=LEVEL 14497000
THEN 14498000
JUMPCTR~LEVEL-1; 14499000
LEVEL~LEVEL-1; 14500000
MODE~MODE-1; 14501000
MAXSTACK~MAXSTACKO; 14502000
START:END; 14503000
GO TO START; 14504000
CALLSTATEMENT: 14505000
JUMPCHKX; 14506000
IF SPECTOG THEN BEGIN 14507000
IF (PJ ! BUP) THEN 14507010
BEGIN 14507020
INTEGER II,SSCRAM,SCOUNT; 14507030
MOVE(10,ACCUM,INFO[31,240]); 14507040
II :=I;SSCRAM:=SCRAM;SCOUNT:=COUNT; 14507050
FOR SCRAM := 0 STEP 1 UNTIL 124 14507060
DO IF((I~STACKHEAD[SCRAM]) < 256) 14507070
THEN IF I ! 0 THEN 14507080
BEGIN ELBAT[76]:=INFO[0,I]&I[35:35:14507090
13]; 14507095
COUNT:=INFO[0,I+1].[12:6]; 14507100
MOVE(COUNT,INFO[0,I],ACCUM); 14507105
I:=76; SCATTERELBAT; 14507110
FORMALF := TRUE; 14507120
KLASSF := REALID; 14507130
MAKEUPACCUM; E; 14507140
END; 14507150
I~II;SCRAM~SSCRAM;COUNT~SCOUNT; 14507160
MOVE(10,INFO[31,240],ACCUM); 14507170
BUP~PJ; FLAG(12);SPECTOG~TRUE; 14507180
GO TO START; 14507190
END ; 14507200
FLAG(12);GO TO HF 14508000
END; 14509000
BEGINCTR ~ BEGINCTR-1; 14510000
IF ERRORTOG 14511000
THEN COMPOUNDTAIL 14512000
ELSE 14513000
BEGIN 14514000
STMT; 14515000
IF ELCLASS~TABLE(I+1)=DECLARATORS 14516000
THEN 14517000
BEGIN 14518000
ELBAT[I].CLASS~SEMICOLON; 14519000
BEGINCTR~BEGINCTR+1; 14520000
GO TO START 14521000
END 14522000
ELSE 14523000
COMPOUNDTAIL 14524000
END; 14525000
BEGIN 14526000
RELAD~FIRSTX; 14534000
IF STACKCTR>MAXSTACK 14535000
THEN MAXSTACK~STACKCTR; 14536000
IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000
THEN 14538000
IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000
THEN 14540000
BEGIN 14541000
EMITV(BLOCKCTR); 14542000
EMITL(1); 14543000
EMITO(SUB); 14544000
EMITSTORE(BLOCKCTR,STD); 14545000
GOTSTORAGE~TRUE 14546000
END 14547000
ELSE 14548000
BEGIN 14549000
EMITL(10); 14550000
EMITO(COM) 14551000
END; 14552000
FUNCTOG~FUNCTOGO; 14553000
IF SOP 14554000
THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000
ELSE 14556000
BEGIN 14557000
IF LEVEL = 1 THEN EMITO(XIT) 14557500
ELSE BEGIN 14557600
EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000
EMITO(BFW); 14558500
END; 14558600
CONSTANTCLEAN; 14559000
IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000
OR FAULTOG.[46:1] THEN 14561000
BEGIN 14562000
ADJUST; RELAD~L; 14563000
IF GOTSTORAGE OR FAULTOG.[46:1] 14564000
THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100
EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000
END; 14566000
IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000
=0; 14568000
PURGE(NINFOO); 14569000
IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100
BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200
BUMPL; 14570000
EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000
CONSTANTCLEAN 14572000
END ELSE PURGE(NINFOO); 14573000
IF RELAD =4095 THEN RELAD~0; 14574000
NEXTTEXT ~ NTEXTO; 14574500
G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000
END; 14576000
ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100
SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000
14578000
14579000
14580000
14581000
14582000
14583000
14584000
14585000
14586000
14587000
14588000
14589000
14590000
14591000
14592000
ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000
MOVECODE(TENIL,ENIL); 14594000
MOVECODE(TEDOC,EDOC);L~LOLD; 14595000
DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000
IF NOT SOP AND LEVEL ! 1 14597000
THEN 14598000
BEGIN 14599000
ADJUST; 14600000
G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000
IF ELCLASS = FACTOP THEN 14601100
BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200
14601300
14601400
14601500
14601600
14601610
STEPIT; 14601700
END; 14601800
END; 14602000
IF JUMPCTR=LEVEL THEN JUMPCTR~LEVEL-1; 14603000
LEVEL~LEVEL-1; 14604000
FUNCTOG~FUNCTOGO; 14605000
AJUMP~AJUMPO; 14606000
GLOBALNINFOO := OLDNINFOO; %118-14606100
PRTI~PRTIO; 14607000
FIRSTX~FIRSTXO; 14608000
SAVEL~SAVELO; 14609000
STACKCTR~STACKCTRO; 14610000
SAVEPRTOG := SAVEPRTOGO; 14610100
NCII~NCIIO; FAULTOG~FAULTOGO AND(FALSE&FAULTLEVEL<LEVEL[46:47:1]); 14611000
END; 14612000
END BLOCK; 14613000
COMMENT THIS SECTION CONTAINS THE VARIABLE ROUTINE AND ITS SIDEKICKS; 15000000
PROCEDURE CLSMPMN(ELBATWORD,TYPEDPROC) ; 15001000
VALUE ELBATWORD,TYPEDPROC ; 15002000
REAL ELBATWORD ; 15003000
BOOLEAN TYPEDPROC ; 15003010
BEGIN COMMENT CALL SIMPLE MONITOR IS USED TO CALL PRINTI FOR 15004000
SIMPLE VARIABLES. SEE THE MERRIMAC ROUTINE FOR A 15005000
DESCRIPTION OF PRINTI; 15006000
EMITPAIR(JUNK,SND);EMITO(MKS); EMITV(JUNK); 15007000
EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 15008000
POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 15009000
EMITPAIR(GNAT(CHARI),LOD) ; 15010000
IF TYPEDPROC THEN PASSMONFILE(TAKE(GIT(ELBATWORD)).[27:11]) ELSE 15010010
PASSMONFILE(TAKE(GIT(ELBATWORD)).SVARMONFILE) ; 15010020
EMITNUM(1&CARDNUMBER[1:4:44]); %109-15011000
EMITV(GNAT(PRINTI)); 15012000
END CLSMPMN; 15013000
INTEGER PROCEDURE PASSTYPE(ELBATWORD); 15014000
VALUE ELBATWORD ; 15015000
REAL ELBATWORD ; 15016000
COMMENT PASSTYPE IS USED TO PASS THE TYPE OF VARIABLE BEING 15017000
MONITORED TO PRINTI; 15018000
PASSTYPE~(ELBATWORD.CLASS-BOOPROCID) MOD 4; 15019000
PROCEDURE PASSALPHA(ELBATWORD); 15020000
VALUE ELBATWORD ; 15021000
REAL ELBATWORD ; 15022000
BEGIN COMMENT PASSALPHA GENERATES CODE THAT PASSES THE ID 15023000
PARAMETER TO PRINTI; 15024000
DEFINE SIZEALPHA = RR9#; COMMENT SIZEALPHA CONTAINS THE 15025000
LENGTH OF THE ALPHA FOR THE 15026000
VARIABLE DESCRIBED BY ELBATWORD; 15027000
DEFINE INDEX = RR10#; COMMENT INDEX CONTAINS THE INDEX 15028000
INTO INFO FOR ID. INFO[INDEX] = ID; 15029000
DEFINE LTEMP = RR11#; COMMENT LTEMP IS A TEMP FOR L; 15030000
EMITV(IF BOOLEAN(L.[46:1]) 15031000
THEN CPLUS2 15032000
ELSE CPLUS1);LTEMP~BUMPL; EMITWORD(GETALPHA( 15033000
INFO[(INDEX~ELBATWORD.LINK+1).LINKR,INDEX.LINKC], 15034000
IF SIZEALPHA~TAKE(INDEX).ALPHASIZE > 7 15035000
THEN 7 15036000
ELSE SIZEALPHA)); EMITB(BFW,LTEMP,L); 15037000
END PASSALPHA; 15038000
COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 15039000
OF SIMPLE VARIABLES: 15040000
1. V ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15041000
2. V ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15042000
3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15043000
4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15044000
5. V.[S:L] ,ALL V. 15045000
6. V ,ALL V. 15046000
CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 15047000
1. VN,EXP,M*,XCH,~. 15048000
2. EXP,M*,VL,~. 15049000
3. VN,DUP,COC,EXP,T,M*,XCH,~. 15050000
4. VV,EXP,T,M*,VL,~. 15051000
5. ZEROL,VV,T . 15052000
6. VV . 15053000
WHERE VN = DESC V 15054000
EXP= ARITH, OR BOOLEAN EXPRESSION,AS REQUIRED. 15055000
M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000
VL = LITC V 15057000
VV = OPDC V 15058000
~ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000
T = BIT TRANSFER CODE(DIA,DIB,TRB). 15060000
ZEROL = LITC 0 15061000
DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000
OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 15063000
THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 15064000
GLOBAL FASHION. 15065000
THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 15066000
WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 15067000
SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 15068000
; 15069000
PROCEDURE VARIABLE(P1); REAL P1; 15070000
BEGIN 15071000
REAL TALL, COMMENT ELBAT WORD FOR VARIABLE; 15072000
T1 , COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 15073000
T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000
J ; COMMENT SUBSCRIPT COUNTER ; 15075000
REAL X, Z; 15075500
REAL REMEMBERSEQNO; % REMEMBERS SEQUENCE NUMBER OF VARIABLE %116-15075550
% ON LEFT HAND SIDE OF ASSIGNMENT SO WE %116-15075551
% CAN XREF IT CORRECTLY. %116-15075552
LABEL EXIT; 15076000
TALL~ELBAT[I] ; 15077000
IF ELCLASS { INTPROCID THEN 15078000
BEGIN 15079000
IF TALL.LINK !PROINFO.LINK THEN 15080000
BEGIN ERR(211); GO TO EXIT END; 15081000
COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000
TALL ~ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000
END 15084000
ELSE CHECKER(TALL); 15085000
REMEMBERSEQNO := CARDNUMBER; %116-15085100
IF TALL.CLASS { INTID THEN 15086000
BEGIN 15087000
LABEL L1, EXIT ; 15088000
DEFINE FORMALNAME=[9:2]=2 #; 15089000
J ~ ELCLASS ; 15089010
IF STEPI= ASSIGNOP THEN 15090000
BEGIN STACKCT ~ 1; %A 15091000
XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. %116-15091100
L1: 15092000
IF TALL.FORMALNAME THEN 15092020
BEGIN 15093000
EMITN(TALL.ADDRESS); 15094000
IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END; 15095000
END 15096000
ELSE IF T1!0 THEN EMITV(TALL.ADDRESS) 15097000
; STACKCT ~ REAL(T1!0); STEPIT; %A 15098000
IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000
EMITD(48-T2 ,T1 ,T2); 15100000
IF TALL<0 THEN CLSMPMN(TALL,J}BOOPROCID AND J{INTPROCID) ; 15101000
STACKCT ~ 0; %A 15101500
GT1 ~ IF TALL.CLASS =INTID THEN IF P1= FS 15102000
THEN ISD ELSE ISN ELSE 15103000
IF P1 = FS THEN STD ELSE SND ; 15104000
IF TALL.FORMALNAME THEN 15105000
BEGIN EMITO(XCH); EMITO(GT1) END 15106000
ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000
END 15108000
ELSE 15109000
BEGIN 15110000
IF ELCLASS= PERIOD THEN 15111000
BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000
IF STEPI=ASSIGNOP THEN 15113000
BEGIN %116-15113100
IF P1! FS THEN 15114000
BEGIN %116-15115000
ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100
GO TO EXIT; %116-15115200
END; %116-15115300
XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); %116-15116000
GO TO L1; %116-15116100
END; %116-15116200
%A 15117000
END ; 15118000
IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000
COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000
BY A LEFT ARROW OR PERIOD *;15121000
COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000
LEFT-MOST OF A LEFT PART LIST *;15123000
EMITI(TALL,T1,T2); %A 15124000
%A 15125000
END ; 15126000
EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000
ELSE 15128000
COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 15129000
VARIABLES: 15130000
1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 15131000
2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 15132000
3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 15133000
4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 15134000
5. V[R] ~ ,ASSIGNMENT TO ARRAY ELEMENT. 15135000
6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000
R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 15137000
IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 15138000
IS EMITTED FOR THE ABOVE CASES: 15139000
1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 15140000
DIMENSION. THE CODE EMITTED IS: 15141000
VL,LOD . 15142000
EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 15143000
2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.15144000
EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE15145000
OF CODE: 15146000
AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000
,LOD. 15148000
FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 15149000
PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 15150000
THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000
PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000
[* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000
NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 15154000
EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000
EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A15156000
. THE SPECIFIC ROW DEPENDS UPON THE 15157000
VALUES OF THE K-1 SUBSCRIPTS. 15158000
FOR THE REMAINING CASES, 15159000
SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 15160000
HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000
ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.15162000
K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 15163000
ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 15164000
SUBSCRIPTS,IF K>1. 15165000
AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 15166000
AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 15167000
EMITTED. 15168000
3. ADD THE SEQUENCE: 15169000
IF FIRST SUBSCRIPT THEN VV ELSE COC. 15170000
EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000
4. ADD THE SEQUENCE: 15172000
IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL. 15173000
XCH,T. 15174000
5. ADD THE SEQUENCE: 15175000
IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000
XCH,~. 15177000
6. ADD THE SEQUENCE: 15178000
IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD, 15179000
EXP,T, XCH,~. 15180000
EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 15181000
SIMPLE VARIABLE BLOCK. ; 15182000
BEGIN 15183000
LABEL EXIT,LAST,NEXT ; 15184000
INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100
DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF15185000
DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000
VARIABLE; 15187000
DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000
INDEX OF THE LAST ENTRY IN INFO 15189000
FOR A MONITORED SUBSCRIPTED 15190000
VARIABLE; 15191000
DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX15192000
INTO INFO TO PICK OUT SPECIAL MONITOR 15193000
INFORMATION; 15194000
DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT15195000
POSITION OF THE SPECIAL MONITOR 15196000
INFORMATION FOR SUBSCRIPTED 15197000
VARIABLES; 15198000
DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000
EMIT AN OPDC OR LITC FOR PASSING 15200000
THE SUBSCRIPTS FOR MONITORED 15201000
SUBSCRIPTED VARIABLES.1 MEANS 15202000
LITC, 0 MEANS OPDC; 15203000
DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000
BOUND WORD FROM INFO FOR MONITORED 15205000
SUBSCRIPTED VARIABLES; 15206000
DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000
THE ADDRESS THAT WILL BE 15208000
EMITTED IN AN OPDC OR LITC 15209000
DEPENDING ON OPBIT; 15210000
BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT15211000
IS SET TRUE IF THE VARIABLE IN 15212000
TALL IS SPECIAL MONITORED. 15213000
; 15214000
PROCEDURE M4(TALL,J); 15215000
VALUE TALL,J ; 15216000
REAL TALL,J ; 15217000
BEGIN STACKCT ~ 1; %A 15217500
IF J = 1 15218000
THEN BEGIN COMMENT FIRST TIME AROUND; 15219000
IF TALL < 0 15220000
THEN BEGIN COMMENT TALL IS MONITORED; 15221000
EMITV(JUNK); EMITO(XCH); 15222000
END; 15223000
EMITN(TALL.ADDRESS ) 15224000
END 15225000
ELSE BEGIN COMMENT NOT THE FIRST TIME AROUND; 15226000
EMITO(CDC); 15227000
IF TALL < 0 15228000
THEN BEGIN COMMENT CALL SUBSCRIPT; 15229000
EMITV(JUNK); EMITO(XCH); 15230000
END; 15231000
END; END; %A 15232000
IF STEPI ! LFTBRKET THEN BEGIN ERR(207);GO TO EXIT END; 15233000
THENUMBEROFDECLAREDDIMENSIONS ~ TAKE(GIT(TALL)).[40:8]; 15233100
J ~ 0; 15234000
STACKCT ~ 0; %A 15234500
COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000
IF P1 > FP THEN TALL ~ ABS(TALL) ELSE 15236000
IF TALL < 0 THEN 15237000
COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000
BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000
VARIABLE; 15240000
EMITO(MKS); 15241000
IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000
THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000
TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000
.NODIMPART)+INC; 15245000
DO IF BOOLEAN(LWRBND~TAKE(INC~INC+1)).15246000
OPBIT 15247000
THEN EMITL(LWRBND.SPMONADR) 15248000
ELSE EMITV(LWRBND.SPMONADR) 15249000
UNTIL INC } TESTVARB 15250000
END; 15251000
END; 15252000
NEXT: IF STEPI = FACTOP THEN 15253000
BEGIN 15254000
STLB ~ 1; 15254400
WHILE TABLE(I+1) = COMMA DO 15254500
BEGIN STEPIT; 15254600
IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700
BEGIN ERR(204); GO TO EXIT END; 15254800
END; 15254900
IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000
BEGIN ERR(203);GO EXIT END; 15256000
COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000
ROW DESIGNATER DOES NOT MATCH THE ARRAY * 15258000
DECLARATION. *;15259000
IF STEPI ! RTBRKET THEN 15260000
BEGIN ERR(204);GO EXIT END; 15261000
COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000
IF P1 ! FA THEN 15262500
IF STLB > 1 THEN FLAG(212) ELSE 15262600
IF P1!FI AND P1!FL THEN 15263000
IF P1 = FP AND REL THEN ELSE 15263050
BEGIN ERR(205); GO TO EXIT; END; 15263100
COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000
STATEMENT OR ACTUAL PARAMETER LIST. *;15265000
IF J=0 THEN 15266000
EMITPAIR(TALL.ADDRESS,LOD); 15267000
COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000
IF TALL < 0 THEN 15269000
BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000
EMITNUM(5&CARDNUMBER[1:4:44]); %109-15271000
EMITN(GNAT(PRINTI)); %109-15271100
END; 15272000
IF P1 = FA THEN 15272900
FOR X ~ 1 STEP 1 UNTIL STLB DO 15273000
BEGIN IF (Z~TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100
THEN EMITV(Z) ELSE EMIT(Z); 15273200
IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300
END; 15273400
STEPIT; 15274000
GO TO EXIT; 15275000
END OF ROW DESIGNATOR PORTION ; 15276000
AEXP; 15277000
COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000
IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000
J ~ J + 1; 15280000
IF(GT1 ~ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000
BEGIN 15282000
IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000
ELSE EMITV(GT1.[35:11]) ; 15284000
EMIT(GT1.[23:12]); 15285000
END OF LOWER BOUND ADJUSTMENT ; 15286000
IF ELCLASS = COMMA THEN 15287000
BEGIN 15288000
COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000
M4 (TALL,J); 15290000
EMITO(LOD) ; 15291000
IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100
BEGIN ERR(208); GO TO EXIT END; 15291200
COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300
DECLARATION *;15291400
GO TO NEXT; 15292000
END OF SUBSCRIPT COMMA HANDLER ; 15293000
IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END; 15294000
COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000
IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000
BEGIN ERR(208); GO TO EXIT END; 15297000
15298000
15299000
STACKCT ~ 0; %A 15299500
IF STEPI = ASSIGNOP THEN 15300000
BEGIN 15301000
XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO15301100
% SUBSCRIPTED VARIABLE. %116-15301200
COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000
LAST: M4(TALL,J); 15303000
IF T1= 0 THEN 15304000
BEGIN IF P1= FR THEN GO TO EXIT END 15305000
ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; %WF 15306000
IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000
EMITD(48-T2,T1,T2) ; 15308000
EMITO(XCH); 15309000
COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000
IF TALL < 0 15311000
THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000
IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000
VALUE FROM JUNK; 15314000
EMITO( 15315000
IF TALL.CLASS = INTARRAYID 15316000
THEN ISN 15317000
ELSE SND); 15318000
IF P1 ! FS 15319000
THEN EMITPAIR(JUNK,SND); 15320000
EMITL(J); EMITL(PASSTYPE(TALL)); 15321000
EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000
PASSALPHA(TALL); EMITPAIR(GNAT( 15323000
CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000
ARRAYMONFILE); 15325000
EMITNUM((IF SPCLMON THEN 3 ELSE 2) %109-15326000
&CARDNUMBER[1:4:44]); %109-15327000
EMITV(GNAT(PRINTI)); %109-15328000
IF P1 ! FS 15329000
THEN EMITV(JUNK); 15330000
P1~0; GO TO EXIT; 15331000
END; 15332000
EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000
IF P1 = FS THEN ISD ELSE ISN ELSE 15334000
IF P1=FS THEN STD ELSE SND); 15335000
P1~0 ; 15336000
GO TO EXIT ; 15337000
END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000
IF ELCLASS=PERIOD THEN 15339000
BEGIN 15340000
IF DOTSYNTAX(T1,T2) THEN GO TO EXIT; 15341000
IF STEPI = ASSIGNOP THEN %116-15342000
IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST %116-15342100
BEGIN %116-15342200
XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % PARTIAL15342300
% WORD ASSIGNMENT TO SUBSCR. VAR. 15342400
GO TO LAST; %116-15342500
END %116-15342600
ELSE BEGIN ERR(209); GO EXIT END; 15343000
IF J=1 THEN EMITV(TALL.ADDRESS)ELSE EMITO(COC); 15344000
END 15345000
ELSE 15346000
COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000
BEGIN COMMENT MONITOR FUNCTION M10; 15348000
SPCLMON~P1 = FP OR ELCLASS } AMPERSAND; 15349000
IF J = 1 15350000
THEN IF SPCLMON 15351000
THEN EMITV(TALL.ADDRESS) 15352000
ELSE EMITN(TALL.ADDRESS) 15353000
ELSE EMITO(IF SPCLMON 15354000
THEN COC 15355000
ELSE CDC); 15356000
IF TALL < 0 15357000
THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000
EMITNUM(5&CARDNUMBER[1:4:44]); %109-15359000
IF SPCLMON 15360000
THEN EMITV(GNAT(PRINTI)) 15361000
ELSE EMITN(GNAT(PRINTI)) 15362000
END; 15363000
IF P1 =FS THEN ERR(210); 15364000
IF P1 = FI THEN P1~0; 15364500
GO TO EXIT; 15365000
END; 15366000
IF P1=FS THEN BEGIN ERR(210); GO TO EXIT END ; 15367000
COMMENT 210 VARIABLE-MISSING LEFT ARROW OR PERIOD. *;15368000
IF T1!0 THEN BEGIN EMITI(0,T1,T2); 15369000
IF P1!FI THEN P1~0; 15369100
END; 15369200
IF P1=FI THEN 15369300
IF ELCLASS!COMMA AND ELCLASS!RTPAREN 15369400
THEN SIMPARITH; 15369500
IF P1=FI THEN P1~0;% 15369600
%A 15370000
COMMENT ***** MONITOR FUNCTION M9 ; 15371000
IF TALL < 0 15372000
THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000
EMITNUM(5&CARDNUMBER[1:4:44]); %109-15374000
EMITV(GNAT(PRINTI)); %109-15374100
END ; 15375000
EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000
EXIT : END OF THE VARIABLE ROUTINE; 15377000
COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000
PROCEDURE STREAMSTMT ; 16001000
BEGIN 16002000
DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#, 16003000
LOCFLD=36:36:12#,LGTFLD=24:24:12#; 16004000
DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000
DEFINE 16006000
JFW = 39#, COMMENT 7.5.5.1 JUMP FORWARD UNCONDITIONAL ; 16007000
RCA = 40#, COMMENT 7.5.7.6 RECALL CONTROL ADDRESS ; 16008000
JRV = 47#, COMMENT 7.5.5.2 JUMP REVERSE UNCONDITIONAL ; 16009000
CRF = 35#, COMMENT 7.5.10.6 CALL REPEAT FIELD ; 16010000
BNS = 42#, COMMENT 7.5.5.5 BEGIN LOOP ; 16011000
NOP = 1#, COMMENT ; 16012000
ENS = 41#, COMMENT 7.5.5.6 END LOOP ; 16013000
TAN = 30#, COMMENT 7.5.3.7 TEST FOR ALPHAMERIC ; 16014000
BIT = 31#, COMMENT 7.5.3.8 TEST BIT ; 16015000
JFC = 37#, COMMENT 7.5.5.3 JUMP FORWARD CONDITIONAL ; 16016000
SED = 06#, COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 16017000
RSA = 43#, COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 16018000
TRP = 60#, COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 16019000
BSS = 3#, COMMENT 7.5.6.6 SKIP SOURCE BIT ; 16020000
BSD = 2#, COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 16021000
SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000
JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ; 16023000
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 RESTORED TO THEIR ORIGINAL VALUES. ; 16114000
PROCEDURE NESTS; 16115000
BEGIN 16116000
LABEL EXIT; 16117000
REAL JOINT,BNSFIX; 16118000
IF ELCLASS!LITNO THEN 16119000
BEGIN 16120000
EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000
EMIT ( BNS); EMIT(NOP);EMIT(NOP); 16122000
END 16123000
ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000
IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000
NESTLEVEL~NESTLEVEL + 1; 16126000
JOINT ~ JOINFO; 16127000
JOINFO ~ 0; 16128000
DO BEGIN 16129000
STEPIT; ERRORTOG ~ TRUE; STREAMSTMT 16130000
END UNTIL ELCLASS ! SEMICOLON ; 16131000
IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END; 16132000
EMIT ( ENS); 16133000
IF JOINFO ! 0 THEN 16134000
BEGIN 16135000
COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 16136000
ADJUST; 16137000
PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000
JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000
END; 16140000
IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000
NESTLEVEL ~ NESTLEVEL-1; 16142000
JOINFO ~ JOINT ; 16143000
EXIT: END NESTS ; 16144000
COMMENT LABELS HANDLES STREAM LABELS. 16145000
ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000
WORD (IN THE PROGRAMSTREAM). 16147000
IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000
THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000
[1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000
HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000
MATCHES THE LEVEL OF THE LABEL. 16152000
MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000
FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000
AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 16155000
PROCEDURE LABELS; 16156000
BEGIN 16157000
ADJUST; 16158000
GT1 ~ ELBAT[I]; 16159000
XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF %116-16159100
IF STEPI ! COLON THEN ERR(258) 16160000
ELSE 16161000
BEGIN 16162000
IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000
IF GT1>0 THEN 16164000
BEGIN 16165000
PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000
PUT(-L,GT2) 16167000
END 16168000
ELSE 16169000
BEGIN 16170000
IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000
PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000
JUMPCHAIN(GT1); 16173000
END; 16174000
END 16175000
; STEPIT; 16176000
END LABELS ; 16177000
COMMENT IFS COMPILES IF STATEMENTS. 16178000
FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000
CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000
THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000
IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR. OTHERWISE 16182000
THE CODE IS EMITTED STRAIGHTAWAY. 16183000
A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000
"THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000
SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000
TO BE GENERATED. 16187000
THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000
IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000
IF THEN GO TO L1 ELSE GO TO L2 ; 16190000
PROCEDURE IFS; BEGIN 16191000
DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000
LABEL IFSB,IFTOG,IFSC,EXIT; 16193000
SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000
REAL ADDR,FIX1,FIX2 ; 16195000
ADDR~1 ; 16196000
GO TO IFSW[STEPI -SBV+1] ; 16197000
IF ELCLASS=LOCLID THEN 16198000
BEGIN 16199000
EMITC(ELBAT[I].ADDRESS,CRF); 16200000
ADDR~0; 16201000
END 16202000
ELSE 16203000
IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000
ELSE BEGIN ERR(250); GO TO EXIT END; 16205000
IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000
IFSC: 16207000
IF STEPI!RELOP THEN BEGIN ERR(264);GO EXIT END; 16208000
IF STEPI=DCV THEN EMITC(ADDR,ELBAT[I-1].COMPARECODE) 16209000
ELSE IF ELCLASS=STRNGCON THEN 16210000
BEGIN 16211000
IF ACCUM[1].[12:6]!1 OR ELBAT[I-3].CLASS!IFV THEN 16211100
BEGIN ERR(271); GO EXIT END 16211200
ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300
END 16211400
ELSE IF ELCLASS=LOCLID THEN 16212000
BEGIN 16212100
IF ELBAT[I-3].CLASS!IFV THEN 16212200
BEGIN ERR(271); GO EXIT END 16212300
ELSE BEGIN 16212400
EMITC(0,ELBAT[I-1].TESTCODE); % RESET TFFF. 16212500
EMITC(ELBAT[I].ADDRESS,CRF); 16212600
EMITC(0,ELBAT[I-1].TESTCODE); % COMPARE. 16212700
END 16212800
END 16212900
ELSE IF ACCUM[1]!"5ALPHA" THEN 16213000
BEGIN ERR(265);GO EXIT END 16213100
ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000
ELSE BEGIN FLAG(270); ERRORTOG:=TRUE END; 16214100
GO IFTOG; 16215000
IFSB: EMITC(1,BIT); 16216000
IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
FIX1 ~ L; 16218000
EMIT(JFC); 16219000
STEPIT; 16220000
IF ELCLASS = BEGINV OR 16221000
ELCLASS = IFV OR 16222000
ELCLASS = LITNO OR 16223000
ELCLASS = STLABID OR 16224000
ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000
BEGIN 16226000
EMIT (NOP); EMIT (NOP) 16227000
END; 16228000
IF ELCLASS= ELSEV THEN ELSE 16228500
STREAMSTMT; 16229000
IF ELCLASS= ELSEV THEN 16230000
BEGIN 16231000
FIX2 ~ L; EMIT(JFW); 16232000
FIXC(FIX1); 16233000
STEPIT; 16234000
STREAMSTMT; 16235000
FIXC(FIX2); 16236000
END 16237000
ELSE FIXC(FIX1); 16238000
EXIT:END IFS ; 16239000
COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000
STATEMENTS. 16241000
IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000
AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 16243000
ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000
GO TOS IN THE CASE OF FORWARD JUMPS. 16245000
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 SYLLABLES ORDERED FROM 16300000
RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000
MAY REQUIRE AT MOST ONE REPEAT PART. 16302000
IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000
PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE" IS 16304000
ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000
ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000
USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000
THE PROPER ADDRESS AND OPERATOR . 16308000
NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000
ERROR. ; 16310000
PROCEDURE INDEXS; 16311000
BEGIN 16312000
LABEL EXIT,GENERATE,L,L1; 16313000
INTEGER TCLASS,INDEX,ADDR,J; 16314000
TCLASS ~ ELCLASS ; 16315000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000
IF TCLASS = LOCLID THEN 16317000
BEGIN 16318000
XMARK(ASSIGNREF); %116-16318500
IF SIV>STEPI OR ELCLASS>TALLYV THEN GO TO L; 16319000
INDEX ~ 32 + ELCLASS-SIV; 16320000
ADDR ~ ELBAT[I-2].ADDRESS; 16321000
GO TO GENERATE; 16322000
END; 16323000
IF TCLASS = STEPI THEN 16324000
BEGIN 16325000
IF STEPI!ADDOP THEN BEGIN ERR(252); GO EXIT END ELSE 16326000
IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100
BEGIN ERR(253); GO EXIT END; 16327000
INDEX ~ TCLASS-SIV 16328000
+REAL(ELBAT[I-1].ADDRESS=SUB) | 4 16329000
+ REAL(ELCLASS =LOCLID) | 8; 16330000
END 16331000
ELSE 16332000
BEGIN 16333000
INDEX ~ TCLASS -SIV 16334000
+ ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000
IF ELCLASS = LOCV THEN 20 ELSE 16336000
IF ELCLASS = SCV THEN 24 ELSE 16337000
IF ELCLASS= DCV THEN 28 ELSE 25); 16338000
IF ELCLASS = LOCV THEN 16339000
IF STEPI ! LOCLID THEN GO TO L; 16340000
IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000
BEGIN EMITC(ELBAT[I].ADDRESS,SEC); GO TO EXIT END; 16342000
END ; 16343000
ADDR ~ ELBAT[I].ADDRESS; 16344000
GENERATE: 16345000
IF MACRO[INDEX]= 0 THEN 16346000
L: BEGIN ERR(250);GO TO EXIT END; 16347000
J ~ 8; TCLASS ~0 ; 16348000
L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 ); 16349000
IF TCLASS!0 THEN 16350000
BEGIN 16351000
EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000
GO TO L1 16353000
END; 16354000
EXIT:END INDEXS ; 16355000
COMMENT DSS COMPILES DESTINATION STREAM STATEMENTS. 16356000
DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000
STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000
NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000
ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000
THE OPCODE FIELD ; 16361000
PROCEDURE DSS; 16362000
BEGIN 16363000
INTEGER ADDR,J,K,L,T; 16364000
LABEL EXIT,L1; 16365000
DEFINE OPCODE=[27:6]#; 16366000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000
IF STEPI = LOCLID THEN 16368000
BEGIN 16369000
EMITC(ELBAT[I].ADDRESS,CRF); 16370000
ADDR~ 0; 16371000
IF STEPI = LITV THEN GO TO L1 16372000
END 16373000
ELSE IF ELCLASS= LITNO THEN 16374000
BEGIN 16375000
ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000
END 16377000
ELSE ADDR ~ 1 ; 16378000
IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000
EMITC(ADDR,ELBAT[I].OPCODE) %A 16379500
ELSE 16380000
IF ELCLASS = LITV THEN 16381000
BEGIN 16382000
EMITC(ADDR,TRP); 16383000
IF STEPI!STRING AND ELCLASS!STRNGCON AND %111-16384000
ELCLASS ! LITNO AND ELCLASS ! NONLITNO THEN %111-16384100
BEGIN ERR(255);GO TO EXIT END; 16384500
IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %111-16384700
MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800
C,8-COUNT,ACCUM[1],3); %111-16384900
IF ADDR MOD 2 ! 0 THEN 16385000
BEGIN 16386000
EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000
END ; 16388000
FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000
BEGIN 16390000
FOR L ~6,7 DO 16391000
MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000
ELSE J),T,L ); 16393000
EMIT(T); 16394000
END END 16395000
ELSE 16396000
L1: ERR(250); 16397000
EXIT:END DSS ; 16398000
COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000
IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000
A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000
OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000
PROCEDURE SKIPS ; 16403000
BEGIN 16404000
REAL ADDR; 16405000
IF STEPI = LOCLID THEN 16406000
BEGIN 16407000
EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000
END 16409000
ELSE IF ELCLASS = LITNO THEN 16410000
BEGIN 16411000
ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000
END 16413000
ELSE ADDR ~ 1 ; 16414000
IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000
ELSE 16416000
IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000
ELSE ERR(250); 16418000
END SKIPS ; 16419000
COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000
JUMP OUT TO STATEMENTS CAUSE JUMP 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 %116-17001000
BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ={#; %DFB 17002000
DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], %116-17002005
((INDEX).CF DIV 2).LINKC]#, %116-17002006
CF = [33:15]#, %116-17002007
FF = [18:15]#, %116-17002008
NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF 17002009
ELSE XREFINFO[INDEX].CF)#; %116-17002010
ARRAY TIMINGS[0:2,0:3]; %116-17002012
PROCEDURE SAVETIMES(I); %116-17002015
VALUE I; INTEGER I; %116-17002020
BEGIN %116-17002025
INTEGER J; %116-17002030
FOR J := 1 STEP 1 UNTIL 3 DO %116-17002035
TIMINGS[I,J] := TIME(J); %116-17002040
END; %116-17002045
PROCEDURE UPDATETIMES(I); %116-17002050
VALUE I; INTEGER I; %116-17002055
BEGIN %116-17002060
INTEGER J; %116-17002065
FOR J := 1 STEP 1 UNTIL 3 DO %116-17002070
TIMINGS[I,J] := TIME(J) - TIMINGS[I,J]; %116-17002075
END; %116-17002080
WRITE(LINE[PAGE]); 17002520
SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. %116-17002525
LASTADDRESS~0; 17002530
FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000
WRITE(DSK2,30,XREFAY2[*]); %DFB17004000
TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. %116-17004500
XREFPT~XLUN~0; %DFB17004600
FOR I:= 0 STEP 1 UNTIL 8191 DO %116-17004700
XREFINFO[I] := 0; %116-17004710
BEGIN %DFB17005000
BOOLEAN PROCEDURE INPUT1(A); %DFB17006000
ARRAY A[0]; %DFB17007000
BEGIN %DFB17008000
LABEL L,EOF; %DFB17009000
READ(DSK1,10,A[*])[EOF]; %DFB17010000
GO TO L; %DFB17011000
EOF: INPUT1:=TRUE; %DFB17012000
REWIND(DSK1); %DFB17013000
L: %DFB17014000
END; %DFB17015000
PROCEDURE OUTPUT1(B,A); %DFB17016000
VALUE B; %DFB17017000
BOOLEAN B; %DFB17018000
ARRAY A[0]; %DFB17019000
BEGIN %DFB17020000
IF B THEN %DFB17021000
BEGIN %116-17022000
REWIND(DSK1); %116-17022100
UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 17022200
TIMINGS[0,0] := XLUN; % NUMBER OF IDENTIFIERS SORTED. 17022300
END %116-17022400
ELSE %DFB17023000
BEGIN %DFB17024000
IF BOOLEAN(A[8]) THEN %116-17025000
XREFINFO[A[8]].FF := XLUN := XLUN + 1 %116-17025100
ELSE %116-17025200
XREFINFO[A[8]].CF := XLUN := XLUN + 1; %116-17025300
A[8].IDNOF := XLUN; %116-17025400
WRITE(DSK1,10,A[*]); %DFB17026000
END; %DFB17027000
END; %DFB17028000
BOOLEAN STREAM PROCEDURE COMPS1(A,B); %DFB17029000
BEGIN %DFB17030000
SI:=A; %DFB17031000
DI:=B; %DFB17032000
IF 63 SC < DC THEN %116-17033000
TALLY := 1 %116-17033100
ELSE %116-17033200
BEGIN %116-17033300
SI := A; %116-17033400
DI := B; %116-17033500
IF 63 SC = DC THEN %116-17033600
TALLY := 2; %116-17033700
END; %116-17033800
COMPS1:=TALLY; %DFB17034000
END; %DFB17035000
STREAM PROCEDURE HVS1(A); %DFB17036000
BEGIN %DFB17037000
DI:=A; %DFB17038000
DS:=8 LIT "9"; %DFB17039000
SI:=A; %DFB17040000
DS:= 7 WDS; %DFB17041000
DS := 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS %116-17041100
END; %DFB17042000
BOOLEAN PROCEDURE COMP1(A,B); %DFB17042100
ARRAY A,B[0]; %DFB17042200
IF REAL(COMP1:=COMPS1(A,B)) = 2 THEN % IDS EQUAL %116-17042300
COMP1 := A[8].IDNOF < B[8].IDNOF; %116-17042350
PROCEDURE HV1(A); %DFB17042400
ARRAY A[0]; %DFB17042500
HVS1(A); %DFB17042600
XLUN:=0; %DFB17043000
REWIND(DSK1); %DFB17044000
SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN %116-17045000
7000 ELSE 10000); %116-17045100
END; %DFB17046000
BEGIN %DFB17047000
ARRAY IDTYPE[0:(IDMAX+4)|4-1]; %117-17047100
STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, %116-17047200
FWDSEQNO,TYPE,OWNTOG,PARAMTOG, %116-17047300
VALTOG); %116-17047350
VALUE SEG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, %116-17047400
VALTOG; %116-17047450
BEGIN %116-17047500
SI := S; %116-17047700
DI := D; %116-17047800
63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); %116-17047900
DS := 6 LIT " -- "; %116-17048000
OWNTOG (DS := 4 LIT "OWN "); %116-17048100
SI := TYPE; %116-17049300
32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); %116-17049400
PARAMTOG (DS := 6 LIT " -- "; %116-17049410
DS := 4 LIT "NAME"; %116-17049420
VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); %116-17049430
DS := 10 LIT " PARAMETER"); %116-17049440
DS := 26 LIT " -- DECLARED IN SEGMENT "; %116-17049500
SI := LOC SEG; %116-17049600
S := DI; %116-17049700
DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800
DI := DI + 8; % TO FORCE STORE OF LAST WORD %116-17049900
SI := S; %116-17050000
DI := S; %116-17050100
4(IF SC ! " " THEN DS:= CHR ELSE SI := SI + 1); %116-17050200
DS := 4 LIT " AT "; %116-17050300
SI := LOC SEQNO; %116-17050400
DS := 8 DEC; %116-17050500
FWDTOG (DS := 17 LIT " -- FORWARD AT "; %116-17050600
SI := LOC FWDSEQNO; %116-17050700
DS := 8 DEC); %116-17050800
LBLTOG (DS := 16 LIT " -- OCCURS AT "; %116-17050900
SI := LOC FWDSEQNO; %116-17051000
DS := 8 DEC); %116-17051100
END OF SETUPHEADING; %116-17051200
%116-17051300
STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); %116-17051400
VALUE SEQNO,N,STARS; %116-17051500
BEGIN %116-17051600
DI := D; %116-17051700
DI := DI + 8; %116-17051800
N (DI := DI + 10); %116-17051900
STARS(DI := DI - 1; DS := LIT "*"); %116-17052000
SI := LOC SEQNO; %116-17052100
DS := 8 DEC; %116-17052200
DS := LIT " "; %116-17052300
STARS (DI := DI - 1; DS := LIT "*"); %116-17052400
END; %116-17052500
STREAM PROCEDURE BLANKET(D); %116-17052600
BEGIN %116-17052700
DI := D; %116-17052800
DS := 8 LIT " "; %116-17052900
SI := D; %116-17053000
DS := 16 WDS; %116-17053100
END OF BLANKET; %116-17053200
PROCEDURE PRINTXREFSTATISTICS; %116-17053300
BEGIN %116-17053400
SWITCH FORMAT STATS := %116-17053500
(///, "CROSS REFERENCE STATISTICS", /, %116-17053600
"----- --------- ----------", /), %116-17053700
("PHASE ONE - SORT",I6," IDENTIFIERS"), %116-17053800
("PHASE TWO - SORT",I7," REFERENCES"), %116-17053900
("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), %116-17054000
(X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), %116-17054100
(X5,I4,":",2I1," PROCESSOR TIME"), %116-17054200
(X5,I4,":",2I1," I/O TIME",/); %116-17054300
INTEGER I,J,K; %116-17054400
WRITE(LINE,STATS[0]); %116-17054500
FOR I := 0 STEP 1 UNTIL 2 DO %116-17054600
BEGIN %116-17054700
WRITE(LINE,STATS[I+1],TIMINGS[I,0]); %116-17054800
FOR J := 1 STEP 1 UNTIL 3 DO %116-17054900
BEGIN %116-17055000
K := (TIMINGS[I,J] + 30) DIV 60; % ROUND TO NEAREST SECON17055010
WRITE(LINE,STATS[J+3],K DIV 60,(K:=K MOD 60) DIV 10,%116-17055020
K MOD 10); %116-17055025
END; %116-17055030
END; %116-17055100
END PRINTXREFSTATISTICS; %116-17055200
DEFINE REFCOUNT = TIMINGS[1,0]#; % NUMBER OF REFERENCES SORTED.17069300
BOOLEAN FIRSTTIME; % TRUE ON FIRST CALL OF OUTPUT PROCEDURE. 17069400
ARRAY PAY[0:17]; %DFB17069500
REAL LASTADDRESS; %116-17069600
BOOLEAN PROCEDURE INPUT2(A); %DFB17070000
ARRAY A[0]; %DFB17071000
BEGIN %DFB17072000
LABEL L,EOF; %DFB17073000
DEFINE I = LASTADDRESS#; %116-17073100
IF XREFPT:=XREFPT+1=30 THEN %DFB17074000
BEGIN %DFB17075000
READ(DSK2,30,XREFAY2[*])[EOF]; %DFB17076000
XREFPT:=0; %DFB17077000
END; %DFB17078000
IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF;17079000
A[0] := I & NEWID[I.REFIDNOF] REFIDNOF; %116-17080000
REFCOUNT := REFCOUNT + 1; %116-17080100
GO TO L; %DFB17081000
EOF: INPUT2:=TRUE; %DFB17082000
BLANKET(PAY); %DFB17083000
XREFAY1[8] := XREFPT := LASTADDRESS := 0; %116-17084000
FILL IDTYPE[*] WITH %116-17084010
"UNKNOWN. ", % 0 %116-17084020
"STREAM LABEL. ", % 1 %116-17084030
"STREAM VARIABLE. ", % 2 %116-17084040
"DEFINE. ", % 3 %116-17084050
"LIST. ", % 4 %116-17084060
"FORMAT. ", % 5 %116-17084070
"SWITCH FORMAT. ", % 6 %116-17084080
"FILE. ", % 7 %116-17084090
"SWITCH FILE. ", % 8 %116-17084100
"SWITCH LABEL. ", % 9 %116-17084110
"PROCEDURE. ", % 10 %116-17084120
"INTRINSIC. ", % 11 %116-17084130
"STREAM PROCEDURE. ", % 12 %116-17084140
"BOOLEAN STREAM PROCEDURE. ", % 13 %116-17084150
"REAL STREAM PROCEDURE. ", % 14 %116-17084160
"ALPHA STREAM PROCEDURE. ", % 15 %116-17084170
"INTEGER STREAM PROCEDURE. ", % 16 %116-17084180
"BOOLEAN PROCEDURE. ", % 17 %116-17084182
"REAL PROCEDURE. ", % 18 %116-17084184
"ALPHA PROCEDURE. ", % 19 %116-17084186
"INTEGER PROCEDURE. ", % 20 %116-17084188
"BOOLEAN. ", % 21 %116-17084190
"REAL. ", % 22 %116-17084200
"ALPHA. ", % 23 %116-17084210
"INTEGER. ", % 24 %116-17084220
"BOOLEAN ARRAY. ", % 25 %116-17084230
"REAL ARRAY. ", % 26 %116-17084240
"ALPHA ARRAY. ", % 27 %116-17084250
"INTEGER ARRAY. ", % 28 %116-17084260
"LABEL. ", % 29 %116-17084270
"FIELD. ", % 30 (CLASS = 125) %117-17084275
"FAULT. ", % 32 (CLASS = 126) %117-17084280
"SWITCH LIST. "; % 31 (CLASS = 127) %117-17084290
L: %DFB17085000
END; %DFB17086000
PROCEDURE OUTPUT2(B,A); %DFB17087000
VALUE B; %DFB17088000
BOOLEAN B; %DFB17089000
ARRAY A[0]; %DFB17090000
BEGIN DEFINE PRINTER=LINE#; %DFB17091000
LABEL EOF2, SKIP; %116-17091100
OWN BOOLEAN B2, FWDTOG, LBLTOG, WAITINGFORFWDREF; %116-17091110
DEFINE MATCH(A,B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = %116-17091115
REAL(NOT FALSE)#; %116-17091116
REAL I; %116-17091120
DEFINE LINECOUNT = TIMINGS[2,0]#; % NUMBER OF LINES PRINTED. 17091140
OWN REAL FWDSEQNO; %116-17091150
IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. %116-17091155
BEGIN %116-17091160
FIRSTTIME := FALSE; %116-17091162
TIME1 := TIME(1); %116-17091165
DATIME; %116-17091170
UPDATETIMES(1); %116-17091175
SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. %116-17091180
END; %116-17091200
IF NOT B2 THEN %116-17091210
IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. %116-17091300
IF XREFPT ! 0 THEN % WE GOT SOME TO LIST OUT %116-17091400
BEGIN %116-17091500
WRITE(LINE[DBL],15,PAY[*]); %116-17091510
LINECOUNT := LINECOUNT + 1; %116-17091520
END %116-17091530
ELSE % NOTHING TO LIST OUT %116-17091600
ELSE % NOT END OF SORT %116-17091700
IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF ! 0 AND 17091800
A[0].REFIDNOF } XREFAY1[8].IDNOF THEN %116-17091900
IF A[0].TYPEREF = FORWARDREF THEN % %116-17092000
WAITINGFORFWDREF := TRUE %116-17092100
ELSE %116-17092200
IF A[0].TYPEREF = LBLREF THEN % %116-17092300
BEGIN %116-17092400
LBLTOG := TRUE; %116-17092500
FWDSEQNO := A[0].SEQNOF; %116-17092600
END %116-17092700
ELSE %116-17092800
IF A[0].TYPEREF = DECLREF THEN %116-17092900
IF WAITINGFORFWDREF THEN % THIS MUST BE IT %116-17093000
BEGIN %116-17093100
WAITINGFORFWDREF := FALSE; %116-17093200
FWDTOG := TRUE; %116-17093300
FWDSEQNO := A[0].SEQNOF; %116-17093400
END %116-17093500
ELSE % ITS A NORMAL DECLARATION - NOT FORWARD%116-17093600
BEGIN %116-17093700
IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN %116-17093850
DO %116-17093900
READ(DSK1,10,XREFAY1[*]) [EOF2] %116-17093950
UNTIL %116-17094000
A[0].REFIDNOF { XREFAY1[8].IDNOF; %116-17094050
IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN%116-17094100
GO TO SKIP; %116-17094150
IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200
BEGIN %116-17094240
IF SINGLTOG THEN %116-17094250
WRITE(LINE,15,PAY[*]) %116-17094300
ELSE %116-17094350
WRITE(LINE[DBL],15,PAY[*]); %116-17094400
LINECOUNT := LINECOUNT + 1; %116-17094410
END %116-17094420
ELSE %116-17094450
IF NOT SINGLTOG THEN %116-17094500
WRITE(LINE); %116-17094550
XREFPT := 0; %116-17094600
BLANKET(PAY[*]); %116-17094650
SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8]. 17094700
SEGNOF,A[0].SEQNOF,FWDTOG,LBLTOG, %116-17094800
FWDSEQNO,IDTYPE[(IF (I := %116-17094900
XREFAY1[9].CLASS) } FIELDID THEN %117-17095000
(IDMAX + I - FIELDID + 1) ELSE %117-17095100
IF I > IDMAX THEN 0 ELSE I) | 4], %116-17095200
REAL(I } BOOID AND XREFAY1[9].[9:2] = 1), 17095300
REAL((I } BOOID OR I = LOCLID) AND BOOLEAN 17095310
(XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 17095320
FWDTOG := LBLTOG := FALSE; %116-17095400
WRITE(LINE,15,PAY[*]); %116-17095500
LINECOUNT := LINECOUNT + 1; %116-17095510
BLANKET(PAY[*]); %116-17095550
END %116-17095600
ELSE % IT MUST BE A NORMAL REFERENCE %116-17095700
IF A[0].SEQNOF ! LASTADDRESS.SEQNOF THEN %116-17095750
BEGIN %116-17095800
ADDASEQNO(A[0].SEQNOF,XREFPT,A[0].[5:1], 17095900
PAY[*]); %116-17096000
IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100
BEGIN %116-17096200
WRITE(LINE,15,PAY[*]); %116-17096300
LINECOUNT := LINECOUNT + 1; %116-17096350
XREFPT := 0; %116-17096400
BLANKET(PAY[*]); %116-17096450
END %116-17096500
END %116-17096550
ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT %116-17096575
ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 17096600
ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 17096700
EOF2: B2 := TRUE; % SO SORT CAN GO TO NORMAL EOJ %116-17096800
IF NOT B THEN SKIP: LASTADDRESS := A[0]; %116-17096850
END OF OUTPUT2; %116-17096900
PROCEDURE HV2(A); %DFB17112000
ARRAY A[0]; %DFB17113000
A[0] := 3"777777777777777"; % BIGGEST FLOATING PT. NO. %116-17114000
BOOLEAN PROCEDURE COMP2(A,B); %DFB17115000
ARRAY A,B[0]; %DFB17116000
COMP2 := IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 17117000
TRUE %116-17117100
ELSE %116-17117200
IF A[0].REFIDNOF = B[0].REFIDNOF THEN %116-17117300
IF A[0].[1:4] LSS B[0].[1:4] THEN %116-17117400
TRUE %116-17117500
ELSE %116-17117600
IF A[0].[1:4] = B[0].[1:4] THEN %116-17117700
IF A[0].SEQNOF < B[0].SEQNOF THEN %116-17117702
TRUE %116-17117704
ELSE %116-17117706
IF A[0].SEQNOF = B[0].SEQNOF THEN%116-17117708
BOOLEAN(A[0].[5:1]) %116-17117710
ELSE %116-17117712
FALSE %116-17117714
ELSE %116-17117720
FALSE %116-17117730
ELSE %116-17117800
FALSE; %116-17117900
SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT %116-17117910
FIRSTTIME := TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 17117920
XREFPT:=29; REWIND(DSK2); %DFB17118000
SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,6000); %116-17119000
UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE%116-17119100
PRINTXREFSTATISTICS; %116-17119200
END; %DFB17120000
END; %DFB17121000
END OF MAIN BLOCK; 17121500
END. %DFB17122000
%NUMBER OF ERRORS DETECTED = 1. COMPILATION TIME = 532 SECONDS. 99990000
%NUMBER OF CARD-IMAGES PROCESSED = 12712. 99991000
Reference in New Issue View Git Blame Copy Permalink