github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-13 15:17:03 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/SYMBOL/ESPOL.alg_m

6917 lines
621 KiB
Plaintext
Raw Blame History

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