github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-03-03 01:47:56 +00:00
Code Issues Releases Wiki Activity
Files
master
retro-software.B5500-software/CUBE-Library-13/Files/GTL-L200015.alg
Paul Kimpel 2c72f7fd1d Commit CUBE Library version 13 of February 1972. 
1. Commit library tape images, directories, and extracted text files.
2. Commit additional utilities under Unisys-Emode-Tools.
2018-05-27 11:24:23 -07:00

19762 lines
1.5 MiB
Raw Permalink Blame History

% G T L C O M P I L E R M A R K X I I I . 3 6 10/11/71 %T9300000000
% 00000001
% WRITTEN BY MARTIN ALEXANDER GA TECH RECC 00000002
T03 $PUSH,POP,INCLUDE,OMIT, CHANGE PRINT LINE, CHECK CONSTRUCTS. %T0300000003
T07 CHANGE HEADER AND TRAILER PRINTOUTS. %T0700000007
T11 FIX SINGLE SPACING AND DISK FILE SIZE %T1100000011
T14 PRINT ERROR MESSAGE, NOT ERROR NUMBER %T1400000014
T29 COMMUNICATE STATEMENTS %T2900000029
T60 IMPLEMENT READ [V1,V2,...VN] FOR LIST-DIRECTED PRINT-READ. %T6000000060
T89 FIX USE OF PARAMETRIC DEFINES IN STREAMS. %T8900000089
T90 CHANGE FILE REMOTE TO TYPE 19 AND FIX OTHER GTL ERRORS %T9000000090
T91 ALLOW ARRAYS TO BE USED IN BOOLEAN STRING RELATION SYNTAX %T9100000091
T92 MAKE CHANGES TO GTL TO ACCEPT MARK XI & XII ALGOL PATCHES %T9200000092
T93 BRING GTL IN ACCORDS WITH MANUAL AND ADD MARK XIII PATCHES %T9300000093
T98 LIMIT MAX NUMBER OF ERRORS %T9800000098
RESTRICTED VERSION. DATE OF LATEST MODIFICATION: %M00000100
03/23/70 %T9000000101
W27 STEPI AND STEPIT DEFINES. %W2700000127
%09000000200
%#######################################################################00001000
% 00001010
% B-5700 G T L COMPILER %T9300001020
% MARK XIII.36 %T9300001030
% OCTOBER 11, 1971 %T9300001040
% 00001050
%#######################################################################00001060
% 00001070
COMMENT#################################################################00001110
G T L ERROR MESSAGES %T9300001120
########################################################################00001130
% 00001140
ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000
001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000
002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000
IDENTIFIER NOT APPEARING IN 00006000
FORMAL PARAMETER PART. 00007000
003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000
LIST OF DECLARATION. 00009000
004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000
PRECEDED BY ILLEGAL DECLARATOR. 00011000
005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000
BY ILLEGAL DECLARATOR. 00013000
006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000
IN SAME BLOCK(NOT FORWARD). 00015000
007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000
BY ( OR SEMICOLON IN PROCEDURE 00017000
DECLARATION. 00018000
008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000
BY ). 00020000
009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000
BY SEMICOLON. 00022000
010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000
WHICH DID NOT APPEAR IN FORMAL 00024000
PARAPART. 00025000
011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000
012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000
PART. 00028000
013 PROCEDUREDEC: OWN USED IN ARRAY SPECIFICATION. 00029000
014 PROCEDUREDEC: SAVE USED IN ARRAY SPECIFICATION. 00030000
015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. %D00030500
00031000
016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00032000
BY [ . 00033000
017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00034000
FOLLOWED BY : . 00035000
018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00036000
019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00037000
ARRAY SPECIFICATION. 00038000
020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00039000
IDENTIFIER(NO TYPE). 00040000
021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00041000
IDENTIFIER(NO TYPE). 00042000
022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00043000
IDENTIFIER(THE WORD PROCEDURE LEFT 00044000
OUT). 00045000
023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00046000
ANOTHER DECLARATOR. 00047000
024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00048000
025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00049000
PRECEDED BY OWN OR SAVE OR SOME 00050000
OTHER DECLARATOR. 00051000
026 FILEDEC: MISSING ( IN FILE DEC. 00052000
027 FILEDEC: MISSING RECORD SIZE. 00053000
00054000
028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000
IN FILE DEC. 00056000
029 FILEDEC: MISSING ) IN FILE DEC. 00057000
030 IODEC: MISSING COLON IN DISK DESCRIPTION. %P00058000
00059000
031 LISTDEC: MISSING ( IN LISTDEC. 00060000
032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000
033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00062000
FORWARD AFTER IDENTIFIER. 00063000
034 SWITCHFILEDEC:MISSING ~ AFTER FILED. 00064000
035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00065000
OF SWITCHFILE. 00066000
036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~ . 00067000
037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00068000
038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00069000
039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100
040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200
041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300
042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400
043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500
044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600
045 DEFINEDEC: MISSING "=" AFTER DEFINE ID. 00069700
046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800
047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900
048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910
049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920
050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930
051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931
ACTUAL DECLARATION 00069932
052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933
IDENTIFIER. 00069934
059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938
060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940
061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950
INTOVR, OR INDEX. 00069960
070 CASESTMT: MISSING BEGIN. 00069970
071 CASESTMT: MISSING END. 00069980
080 PRIMARY : MISSING COMMA . 00069990
090 PARSE: MISSING LEFT BRACKET 00069991
091 PARSE: MISSING COLON 00069992
092 PARSE: ILLEGAL BIT NUMBER 00069993
093 PARSE: FIELD SIZE MUST BE LITERAL 00069994
094 PARSE: MISSING RIGHT BRACKET 00069995
095 PARSE: ILLEGAL FIELD SIZE 00069996
100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000
101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000
IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000
TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000
AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000
102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000
103 PRIMARY: PRIMARY MAY NOT BEGIN WITH A QUANTITY OF THIS 00076000
TYPE. 00077000
104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000
105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000
106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000
107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000
108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000
AS THE ARITHMETIC EXPRESSIONS. 00083000
109 BOOSEC,SIMPBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000
110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000
EXPRESSION. 00086000
111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000
TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000
112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000
TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000
113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000
A CONCATENATE OPERATOR IS INCORRECT. 00092000
114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS00093000
FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000
115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE. 00095000
116 IFCLAUSE: MISSING THEN. 00096000
117 BANA: MISSING LEFT BRAKET. 00097000
118 BANA: MISSING RIGHT BRAKET. 00098000
119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000
120 COMPOUNDTAIL: MISSING END. 00100000
121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000
ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000
PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000
METER. 00104000
122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000
EXPRESSION PASSED TO IT BY NAME. 00106000
123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000
AGREE AS TO TYPE. 00108000
124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00109000
NUMBER OF DIMENSIONS. 00110000
125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000
PARAMETER TO A PROCEDURE. 00112000
126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000
QUANTITY OF THIS TYPE. 00114000
127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000
STREAM PROCEDURE. 00116000
128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000
NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000
129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000
130 RELSESTMT: NO FILE NAME. 00120000
131 DOSTMT: MISSING UNTIL. 00121000
132 WHILESTMT: MISSING DO. 00122000
133 LABELR: MISSING C OLON. 00123000
134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000
135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000
136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000
137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000
INTEGER WHERE AN INTEGER IS REQUIRED. 00128000
138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000
PHRASE. 00130000
139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000
140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000
141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000
CHARACTORS. 00134000
142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000
(BLANK SUPPRESSED). 00136000
143 COMPOUNDTAIL: EXTRA END. 00137000
144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000
145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000
146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000
A MISSING END OF A PROCEDURE OR A MISPLACED 00141000
DECLARATION. 00142000
147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000
DECLARATION. 00144000
148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000
ARE REQUIRED FOR THIS PROGRAM. 00146000
149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000
PROCEDURE. 00148000
150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000
STREAM PROCEDURES. 00150000
151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000
152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000
153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000
154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000
155 IFEXP: MISSING ELSE 00155000
156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST00156000
ELEMENT. 00157000
157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00158000
158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000
159 PROCSTMT: ILLEGAL USE OF PROCEDURE OR FUNCTION IDENTIFIER00160000
160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000
161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000
162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500
163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000
164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000
165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100
172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720
DECLARATION. 00164725
173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730
AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735
174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740
PARAMETRIC DEFINE INVOCATION. 00164745
175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750
200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00165000
201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00166000
IN A LEFT PART LIST. 00167000
202 SIMPLE VARIABLE: MISSING . OR ~ . 00168000
203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000
DESIGNATOR. 00170000
204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00171000
205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000
AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00173000
206 SUBSCRIPTED VARIABLE: MISSING ]. 00174000
207 SUBSCRIPTED VARIABLE: MISSING [. 00175000
208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00176000
209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00177000
MOST IN A LEFT PART LIST. 00178000
210 SUBSCRIPTED VARIABLE: MISSING . OR ~ . 00179000
211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00180000
212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100
PARAMETER ONLY. 00180200
250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00181000
251 ANY STREAM STMT PROCEDURE: MISSING ~. 00182000
252 INDEX: MISSING + OR - . 00183000
253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000
00185000
255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00186000
256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000
A FORMAL PARAMETER. 00188000
257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000
NEST LEVEL AS A PRECEDING APPEARANCE OF THE 00190000
LABEL. 00191000
258 LABELS: MISSING :. 00192000
259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000
260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000
261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000
262 NESTS: MISSING PARENTHESIS. 00196000
263 IFS:MISSING SC IN IF STATEMENT. 00197000
264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000
265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000
266 IFS: MISSING THEN INIF STATEMENT. 00200000
267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000
UNDEFINED. 00202000
268 EMITC: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00203000
FORMAL PARAMETERS,LOCALS AND LABELS. 00204000
269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000
OR TOO SMALL. 00206000
270 IFS: RELATIONAL IN SC<RELATIONAL>ALPHA MUST BE "EQUAL". 00206100
271 IFS: IMPROPER CONSTRUCT FOR <SOURCE WITH LITERAL>. 00206200
275 STRMSTMT: JUMP LONGER THAN 63 SYLLABLES %W1100206500
281 DBLSTMT: MISSING (. 00207000
282 DBLSTMT: TOO MANY OPERATORS. 00208000
283 DBLSTMT: TOO MANY OPERANDS. 00209000
284 DBLSTMT: MISSING , . 00210000
285 DBLSTMT: MISSING ) . 00211000
286 DBLSTMT: ILLEGAL PARAMETER . 00211100
290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00211510
291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE00211520
292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00211530
293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540
294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550
295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551
IN A LEFT PART LIST. 00211552
300 FILLSTMT: THE INDNTIFIER FOLLOWING THE WORD FILL IS NOT 00212000
AN ARRAY IDENTIFIER. 00213000
301 FILLSTMT: MISSING WITH IN FILL STATEMENT. 00214000
302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000
303 FILLSTMT: NON OCTAL CHARACTER IN OCTAL FILL. THE THREE 00216000
LOW ORDER BITS ARE CONVERTED AND COMPILATION 00217000
CONTINUES. 00218000
304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100
305 FILLSTMT: STRING FILL: STRING EXCEEDS 1023 CHARACTERS %M00218150
350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00218200
SORT OR MERGE STATEMENT. 00218210
351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00218220
352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00218230
NOT HAVE EXACTLY TWO PARAMETERS. 00218240
353 OUTPROCHECK: FIRST PARAMETER OF OUTPUT PROCEDURE MUST 00218250
BE BOOLEAN. 00218260
354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00218270
ONE-DIM ARRAY. 00218280
355 SORTSTMT: MISSING (. 00218290
356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO00218300
357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00218310
PARAMETER. 00218320
358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00218330
359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00218340
360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00218350
TWO PARAMETERS. 00218360
361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00218370
362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00218380
363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390
364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400
PARAMETER. 00218410
365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420
366 SORTSTMT: MISSING ). 00218430
367 MERGESTMT: MISSING (. 00218440
368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450
369 MERGESTMT: MISSING ). 00218460
400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00219000
401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00220000
402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00221000
403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00222000
MONITOR LIST ELEMENT. 00223000
404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00224000
ELEMENT. 00225000
405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00226000
406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00227000
407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00228000
408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00229000
409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00230000
410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00231000
411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00232000
SUBSCRIPTS. 00233000
412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00234000
SUBSCRIPTS. 00235000
413 DMUP:IMPROPER ARRAY DUMP LIST ELEMENT. 00236000
414 DMUP:ILLEGAL DUMP LIST ELEMENT. 00237000
415 DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS 00238000
IN ONE DUMP DECLARATION. 00239000
416 DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER. 00240000
417 DMUP:MISSING OR NON-LOCAL LABEL IN DUMP DECLARATION. 00241000
418 DMUP:MISSING COLON IN DUMP DECLARATION. 00242000
419 DMUP:IMPROPER DUMP DECLARATION DELIMITER. 00243000
420 READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT. 00244000
421 READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE 00245000
STATEMENT. 00246000
422 READSTMT:MISSING FILE IN READ STATEMENT. 00247000
00248000
424 READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT 00249000
425 READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT. 00250000
426 READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ 00251000
STATEMENT. 00252000
427 READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT. 00253000
428 READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ 00254000
STATEMENT. 00255000
429 READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT. 00256000
430 READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00257000
STATEMENT. 00258000
00259000
00260000
00261000
00262000
433 HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT 00263000
BRACKET IN READ OR SPACE STATEMENT. 00264000
434 SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT. 00265000
435 SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT. 00266000
436 SPACESTMT:MISSING COMMA IN SPACE STATEMENT. 00267000
437 SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT. 00268000
438 WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT. 00269000
439 WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT. 00270000
440 WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A 00271000
WRITE STATEMENT. 00272000
441 WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART 00273000
OF A WRITE STATEMENT. 00274000
442 WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE 00275000
STATEMENT. 00276000
443 WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE 00277000
STATEMENT. 00278000
444 WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT. 00279000
445 WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00280000
IN A WRITE STATEMENT. 00281000
446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00282000
447 WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00283000
STATEMENT. 00284000
448 WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT. 00285000
449 READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT. 00286000
450 LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT. 00287000
451 LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT. 00288000
452 LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT. 00289000
453 LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK 00290000
STATEMENT. 00291000
454 LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT. 00292000
455 CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT. 00293000
456 CLOSESTMT:IMPROPER FILE PART IN A CLOSE STATEMENT. 00294000
457 CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT. 00295000
458 CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE 00296000
STATEMENT. 00297000
459 CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00298000
460 RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT. 00299000
461 RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT. 00300000
462 RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00301000
463 BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION 00302000
PART OF A PROCEDURE. 00303000
464 BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00304000
OF A PROCEDURE. 00305000
465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003
SIMPLE VARIABLE 00305004
475 FOR LISTNAME NOT FOLLOWED BY DO %W3300305006
476 LISTGEN: LISTGEN MAY NOT BE CALLED RECURSIVELY. %W3300305007
500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010
501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020
502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030
503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040
504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050
505 SEARCHLIB: MISSING BRACKET. 00305060
00305070
507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080
509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. %B0200305095
510 FORSTLIST: FOR <LIST> DO <STATEMENT> IN PROC BODY ONLY %73 %W3300305100
600 ARRAYDEC: ARRAY SIZE TOO LARGE %T9300306000
601 FORMALARRAY: NUMBER OF DIMENSIONS EXCEEDS 7 %A00307000
602 NEWINTRINSIC: RECALL CANNOT BE USED WITHOUT %A00308000
REMEMBER AND VICE VERSA %A00309000
603 EMIT: LOCAL STRING SEGMENT TOO LARGE %A00310000
604 EMIT: INTERNAL STRING EXPRESSION JUMP TOO FAR %A00311000
605 LIT: MISSING NUMBER OR NUMBER TOO LARGE %A00312000
606 ANYWHERE: MISSING COMMA %A00313000
607 ANYWHERE: MISSING RIGHT BRACKET %A00314000
608 RPROP: MISSING RECORD TYPE %A00315000
609 CONVAL: MISSING OR ILLEGAL NUMBER %A00316000
610 ARAY: ARRAY ROW NOT ALLOWED HERE %A00317000
611 DBLPRIM: DOUBLE PRIMARY MAY NOT BEGIN WITH QUANTITY %A00318000
OF THIS TYPE %A00319000
612 REXP: ILLEGAL RECORD EXPRESSION %A00320000
613 REXP: RECORD CLASSES DO NOT AGREE %A00321000
614 FIELDINDEX: MISSING RIGHT BRACKET %A00322000
615 GENQUOTE: ILLEGAL LIST ITEM %A00323000
616 GENQUOTE: TOO MANY RIGHT PARENTHESES IN LIST %A00324000
617 CHAINOP: MISSING ~ IN ASSIGNMENT STATEMENT %A00325000
618 SYMBOLEXP: ILLEGAL SYMBOL EXPRESSION %A00326000
619 RETURN: USED OUTSIDE OF SCOPE %A00327000
620 EXIT: USED OUTSIDE OF SCOPE %A00328000
621 RECLAIM: SYMBOL REFERENCES CANNOT BE EXPLICITLY RECLAIMED %A00329000
WHEN USING AUTOMATIC STORAGE RECLAMATION %A00330000
622 RECALL-REMEMBER: ILLEGAL FILE IDENTIFIER %A00331000
623 PRINT: PRINT STRING TOO LARGE %A00332000
624 IOSTMT: ILLEGAL FILE OR PROCEDURE IDENTIFIER IN %A00333000
INPUT OR OUTPUT STATEMENT %A00334000
625 IOSTMT: ILLEGAL STRING IDENTIFIER IN %A00335000
INPUT OR OUTPUT STATEMENT %A00336000
626 NOGO: THIS DESIGNATIONAL EXPRESSION NOT PERMITTED %A00337000
WHEN USING AUTOMATIC STORAGE RECLAMATION %A00338000
627 RECORDGEN: UNDEFINED FIELD IDENTIFIER IN RECORD GENERATOR %A00339000
628 FIELDGEN: A FIELD CANNOT BE A FORMAL PARAMETER %A00340000
629 FIELDGEN: ILLEGAL FIELD DECLARATION %A00341000
630 FIELDGEN: FIELD PREVIOUSLY DECLARED IN SAME BLOCK %A00342000
631 FIELDGEN: MISSING COLON %A00343000
632 FIELDGEN: FIELD TOO SMALL FOR REFERENCE VALUE %A00344000
633 RECORDGEN: NUMBER OF RECORD CLASSES EXCEEDS 30 %A00345000
634 STRINGEN: DECLARED STRING LENGTH EXCEEDS 8184 CHARACTERS %A00346000
635 RECORDGEN: ACTUAL NUMBER OF SUBSCRIPTS OF INDEXED FIELD %A00347000
IS NOT EQUAL TO DECLARED NUMBER %A00348000
636 FIELDC: FIELD NOT CONTAINED IN GIVEN RECORD CLASS %A00349000
637 GENQUOTE: MISSING " IN QUOTED SYMBOL EXPRESSION %A00350000
638 PRINT: UNPRINTABLE EXPRESSION %A00351000
639 SYMBOLDEFINE: ILLEGAL PROPERTY LIST ELEMENT %A00351100
640 SYMBOLDEFINE: MISSING ] %A00351200
641 SYMBOLDEFINE: ATOMIC SYMBOL MUST PRECEDE PROPERTY LIST PART %A00351300
642 SYMBOLDEFINE: MISSING : %A00351400
643 LISTELEMENT: ILLEGAL LIST ELEMENT %A00351410
644 IOSTMT: MISSING INPUT STATEMENT %A00351420
645 IOSTMT: MISSING OUTPUT STATEMENT %A00351430
700 AMONG: MISSING STRING %A00352000
701 BITXP: REPEAT INDICATOR TOO LARGE IN BIT EXPRESSION %A00353000
702 BITXP: BIT1 OR BIT0 EXPECTED %A00354000
703 STRINGINT: REPEAT INDICATOR NOT PERMITTED HERE %A00355000
704 STRINGXP: STRING EXPRESSION (LENGTH) OVERFLOW %A00356000
705 STRINGXP: QUOTED STRING TOO LONG %A00357000
706 STRINGLOOP: MISSING COLON %A00358000
707 STRINGLOOP: STRING EXPRESSION TOO LARGE %A00359000
708 STRINGXP: STRING EXPRESSION CANNOT CANTAIN %A00360000
THIS TYPE QUANTITY %A00361000
709 STRINGXP: REPEAT INDICATOR TOO LARGE %A00362000
710 STRINGVAR: SUBSTRING NOT IN DESIGNATED STRING OR %A00363000
MISSING OR FORMAL STRING IDENTIFIER %A00364000
711 STRINGVAR: ARRAY ROW DESIGNATOR NOT PERMITTED HERE %A00365000
712 STRINGVAR: STRING DESIGNATOR NOT PERMITTED HERE %A00366000
713 STRINGVAR: STARTING POSITION PLUS SUBSTRING LENGTH %A00367000
EXCEEDS LENGTH OF MAIN STRING %A00368000
714 STRINGXP: MISSING RELATIONAL OPERATOR IN STRING %A00369000
COMPARISON EXPRESSION %A00370000
715 STRINGLOOP: MISSING ] %A00371000
716 STRINGXP: STRINGS ON LEFT AND RIGHT HAND SIDES OF %A00372000
RELATIONAL OPERATOR KNOWN TO BE OF UNEQUAL %A00373000
LENGTH %A00374000
717 STRINGSEC: MISSING ~ %A00375000
; %M00499000
BEGIN COMMENT OUTERMOST BLOCK; 00500000
INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000
SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000
INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000
IF COMPILE & GO =0. FOR SYNTAX, =-1. MUST BE AT R+26;00504000
INTEGER CARDNUMBER; 00504100
INTEGER LASTADDRESS; 00504200
INTEGER ERRORMAX; % %T9800504250
ARRAY ENIL[0:7,0:127]; 00504300
INTEGER ENILPTR; 00504400
DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500
ARRAY LDICT[0:7,0:127]; 00504600
BOOLEAN BUILDLINE; 00504700
COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS, 00505000
TO SAVE SOME STACK SPACE; 00506000
REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000
COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000
THE MAIN BLOCK; 00509000
COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000
REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000
BEGIN SI~NCR; DI~LOC EXAMIN; DI~DI+7; DS~CHR END; 00512000
REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100
BEGIN 00512200
SI ~ AC; SI ~ SI + CT; 00512300
DI ~ LOC EXAMINELAST; DI ~ DI+7; 00512400
DS ~ 1 CHR; 00512500
END EXAMINELAST; 00512600
COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000
IN SORCE TO THE DK-TH CHARACTER IN DEST. 0{N{63,0{SK{127; 00514000
DEFINE DK=DSK#; 00514500
STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000
VALUE N, SK, DSK ; 00516000
BEGIN SI~LOC SK; SI~SI+6; 00517000
IF SC!"0" THEN BEGIN SI~SORCE; 2(SI~SI+32); SORCE~SI END; 00518000
SI~LOC DK; SI~SI+6; DI~DEST; 00519000
IF SC!"0" THEN 2(DI~DI+32); 00520000
SI~SORCE; SI~SI+SK; DI~DI+DK; DS~N CHR; 00521000
END MOVECHARACTERS; 00522000
INTEGER STREAM PROCEDURE GETF(Q); VALUE Q; 00523000
BEGIN SI~LOC GETF; SI~SI-7; DI~LOC Q; DI~DI+5; 00524000
SKIP 3 DB; 9(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB); 00525000
DI~LOC Q; SI~Q; DS~WDS; SI~Q; GETF~SI 00526000
END GETF; 00527000
COMMENT START SETTING UP FILE PARAMETERS; 00528000
IF EXAMIN(RR11~GETF(3)+"Y08" )!12 THEN RR1~5 ELSE 00529000
BEGIN RR1~2; RR2~150END; 00530000
IF EXAMIN(RR11+5)!12 THEN RR3~4 ELSE 00531000
BEGIN RR3~2; RR4~150END; 00532000
IF EXAMIN(RR11+10)=12 THEN 00533000
BEGIN RR5~2; RR6~10; RR7~150END ELSE 00534000
BEGIN RR5~1; RR6~56; RR7~10 END; 00535000
IF EXAMIN(RR11+15)=12 THEN 00536000
BEGIN RR8~10; RR9~150END ELSE 00537000
BEGIN RR8~56; RR9~10 END; 00538000
IF EXAMIN(RR11+20)=12 THEN RR10~150; 00539000
BEGIN 01000000
01000100
01000200
01000300
01000400
01000500
01000600
01000700
INTEGER LASTELCLASS; %SAVES ELCLASS %W4001000713
BOOLEAN CHECKTOG; 01000800
BOOLEAN GOGOGO;% TRUE FOR SPECIAL WRITES AND READS 01000810
BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840
% EVALUATING AN ARRAY BOUND 01000850
INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860
COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870
BASENUM IS STARTING VALUE 01000880
TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890
CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900
BOOLEAN SEQTOG, NEWBASE; COMMENT SEQTOG INDICATES SEQUENCING IS 01000910
REQD. NEWBASE INDICATES A NEW BASENUM IS FOUND ON A NEW $ CRD;01000920
BOOLEAN LASTCRDPATCH; COMMENT NORMALLY FALSE, SET TO 01000960
TRUE WHEN THE LAST CARD FROM SYMBOLIC LIBRARY 01000970
READ IS PATCHED FROM THE CARD READER; 01000980
BOOLEAN LISTOG,PRTOG,DEBUGTOG,NEWTOG,PUNCHTOG,VOIDTAPE; 01001000
BOOLEAN SINGLTOG; 01001010
BOOLEAN NOTPNTED; 01001020
BOOLEAN REMOTERR; ARRAY BITS[0:22]; % %T1401001050
DEFINE NOHEADING=LISTOG.[46:1]# ; %%% TRUE IFF DATIME HAS NOT BEEN CALLD01001100
DEFINE XREFINFO[XREFINFO1,XREFINFO2]= 01001750
XINFO[XREFINFO1,(XREFINFO2)DIV 2]#, 01001760
XMARK= IF XREF THEN XREFAY2[XREFPT-1].[1:1]~1#; 01001770
COMMENT THESE TOGGLES SPECIFY THE ACTION REQUIRED BY A CONTROL CARD;01002000
REAL SEQERRORCOUNT ; BOOLEAN SEQERRORTOG ; % %T0301002010
BOOLEAN ARRAY OPTHOLD[0:31]; ARRAY BASHOLD,TOTHOLD,ADDHOLD[0:31]; % %T0301002020
INTEGER ZOPT; ARRAY L1N[0:9]; % %T0301002030
BOOLEAN GOTCHA,STREAMER; % %T0301002040
ARRAY SPECIAL[0:31]; 01003000
COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000
CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000
SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000
ARRAY INFO[0:31,0:255]; 01007000
ARRAY XREFAY2[0:29],XREFAY1[0:10],XINFO[0:31,0:127]; 01007100
INTEGER XREFPT,XLUN; %DFB01007200
BOOLEAN XREF; %DFB01007500
COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000
OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000
THE INTERNAL CODE ( OR ELBAT WORD AS IT IS USUALLY 01010000
CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000
[1:1]) FOR PROCEDURES, THE LINK TO PREVIOUS ENTRY (IN 01012000
[4:8]), THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000
TION (IN [12:6]), AND THE FIRST 5 CHARACTORS OF ALPHA. 01014000
SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000
FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000
AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLIT ACROSS A ROW 01017000
OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000
RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000
DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY01020000
IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000
OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 01022000
ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000
THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000
THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000
RESERVED WORDS OCCUPY THE SECOND ROW. IT IS FILLED DURING 01026000
INITIALIZATION; 01027000
COMMENT INFO FORMAT 01028000
FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000
ENTERED IN INFO: 01030000
THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000
THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000
ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000
ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000
E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 01035000
LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000
THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000
THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000
POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000
THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.,THE 01040000
LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000
FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000
ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000
WILL NOT DETRACT FROM THE DISCUSSION. 01044000
ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000
THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000
FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000
THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 01048000
S[L] 01049000
NOW THE DECLARATION 01050000
BEGIN REAL A,B,C IS ENCOUNTERED 01051000
IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000
THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000
CONSTRUCTED FOR A) 01054000
T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 01055000
INFO[NEXTINFO]~T. S[L]~NEXTINFO. 01056000
NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000
ENTRY. 01058000
NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000
ITSELF CONTAINS THE STOP FLAG ZERO. 01060000
B IS ENTERED SIMILARLY TO A. 01061000
NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000
ENTRY FOR A. 01063000
SIMILARLY,AFTER C IS ENTERED 01064000
S[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000
POINTS TO A. 01066000
THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000
FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000
FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL 01069000
FULL DECLARATION. 01070000
PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000
INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBTRACTED 01072000
FROM THE CURRENT ENTRY INDEX. 01073000
[12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY.(<64) 01074000
[18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000
AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000
THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000
THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000
FOR X WOULD APPEAR AS FOLLOWS: 01079000
INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000
I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000
I+2 = L 01082000
I+3 = ELBATWRD (MADE FOR X) 01083000
I+4 = 031X 01084000
THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000
THE ENTRY BEFORE SYMBOL, AND 01086000
INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000
ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000
THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000
FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000
NECESSARY. 01091000
THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000
REAL 01093000
BOOLEAN 01094000
INTEGER 01095000
ALPHA 01096000
FILE 01097000
FORMAT 01098000
LIST 01099000
OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000
ARRAYS: 01101000
THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000
DIMENSIONS(IN THE LOW ORDER PART).[40:8] 01103000
EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000
BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000
THESE WORDS ARE MADE UP AS FOLLOWS: 01106000
[23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000
SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000
RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000
TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000
SUBTRACTED. 01111000
[35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000
REQUIRES A PRT OR STACK CELL,OTHERWISE THE BIT 01113000
35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000
REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000
[46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000
IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000
PROCEDURES: 01118000
THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000
PARAMETERS [40:8] 01120000
IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000
[13:11] ENDING PRT ADDRESS FOR LABELS, 01122000
[ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000
OF LOCALS. 01124000
SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000
OF APPEARANCE IN FORMAL PARAPART) ARE 01126000
ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000
VALUE OR NOT([10:1]). 01128000
THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000
IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000
CONTAINS THE NUMBER OF DIMENSIONS.OTHERWISE INCR IS MEANINGLESS. 01131000
LINK([35:13]) IS MEANINGLESS. 01132000
IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMATER IS 01133000
THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000
IS DONE IN THE STREAM PROCEDURE. 01135000
LABELS: 01136000
AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000
BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000
IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000
LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000
0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000
SWITCHES: 01142000
THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000
ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000
IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000
NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000
DEFINE MON =[ 1: 1]#, 01147000
CLASS =[ 2: 7]#, 01148000
FORMAL=[ 9: 1]#, 01149000
VO =[10: 1]#, 01150000
LVL =[11: 5]#, 01151000
ADDRESS=[16:11]#, 01152000
INCR =[27: 8]#, 01153000
LINK =[35:13]#, 01154000
DYNAM =[11:16]#, 01154100
LINKR =[35: 5]#, 01155000
LINKC =[40: 8]#; 01156000
COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD. 01157000
MON IS THE BIT WHICH IS TURNED ON IF: 01158000
1. THE QUANTITY IS TO BE MONITORED, OR 01158100
2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200
A DEFINE WITHOUT PARAMETERS. 01158300
CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000
QUANTITY. 01160000
FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000
PARAMETER. 01162000
VO IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000
DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000
FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000
FROM OTHERS. 01166000
LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000
ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000
DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100
DEFINE PARAMETER ENTRIES, ONLY. IT IS AN INDEX 01168200
INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300
THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400
DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500
NOT USE THE LVL FIELD, BUT MAKES USE OF NINFOO. 01168600
INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION 01169000
NEEDED, RELATIVE TO THE LOCATION IN INFO. 01170000
LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE 01171000
QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE 01172000
NEXT ITEM IN THE STACK. ZERO IS AN END FLAG. 01173000
LINKR AND LINKC ARE SUBDIVISIONS OF LINK.; 01174000
COMMENT CLASSES FOR ALL QUANTITIES - OCTAL CLASS IS IN COMMENT; 01175000
COMMENT CLASSES FOR IDENTIFIERS; 01176000
DEFINE UNKNOWNID =000#, COMMENT 000; %M01177000
STLABID =001#, COMMENT 001; %M01178000
LOCLID =002#, COMMENT 002; %M01179000
DEFINEDID =003#, COMMENT 003; %M01180000
FAULTID =004#, COMMENT 004; %M01180100
LISTID =005#, COMMENT 005; %M01181000
SUPERLISTID =006#, COMMENT 006; %M01181010
FRMTID =007#, COMMENT 007; %M01182000
SUPERFRMTID =008#, COMMENT 010; %M01183000
FILEID =009#, COMMENT 011; %M01184000
SUPERFILEID =010#, COMMENT 012; %M01185000
SWITCHID =011#, COMMENT 013; %M01186000
PROCID =012#, COMMENT 014; %M01187000
STRPROCID =013#, COMMENT 015; %M01187100
FIELDID =014#, COMMENT 016; %M01187200
STRTRNS =015#, COMMENT 017; %M01187300
DBLPLXTRNS =016#, COMMENT 020; %M01187400
SYMTRNS =017#, COMMENT 021; %M01187500
RECTRNS =018#, COMMENT 022; %M01187600
BOOTRNS =019#, COMMENT 023; %M01187700
INTRNSICPROCID =020#, COMMENT 024; %M01188000
ALFATRNS =021#, COMMENT 025; %M01189000
INTRNS =022#, COMMENT 026; %M01189100
STRINGSTRPROCID =023#, COMMENT 027; %M01189200
DBLPLXSTRPROCID =024#, COMMENT 030; %M01189300
SYMSTRPROCID =025#, COMMENT 031; %M01189400
RECSTRPROCID =026#, COMMENT 032; %M01189500
BOOSTRPROCID =027#, COMMENT 033; %M01190000
REALSTRPROCID =028#, COMMENT 034; %M01191000
ALFASTRPROCID =029#, COMMENT 035; %M01192000
INTSTRPROCID =030#, COMMENT 036; %M01193000
STRINGPROCID =031#, COMMENT 037; %M01193100
DBLPLXPROCID =032#, COMMENT 040; %M01193200
SYMPROCID =033#, COMMENT 041; %M01193300
RECPROCID =034#, COMMENT 042; %M01193400
BOOPROCID =035#, COMMENT 043; %M01194000
REALPROCID =036#, COMMENT 044; %M01195000
ALFAPROCID =037#, COMMENT 045; %M01196000
INTPROCID =038#, COMMENT 046; %M01197000
STRINGID =039#, COMMENT 047; %M01197100
DBLPLXID =040#, COMMENT 050; %M01197200
SYMID =041#, COMMENT 051; %M01197300
RECID =042#, COMMENT 052; %M01197400
BOOID =043#, COMMENT 053; %M01198000
REALID =044#, COMMENT 054; %M01199000
ALFAID =045#, COMMENT 055; %M01200000
INTID =046#, COMMENT 056; %M01201000
STRINGARRAYID =047#, COMMENT 057; %M01201100
DBLPLXARRAYID =048#, COMMENT 060; %M01201200
SYMARRAYID =049#, COMMENT 061; %M01201300
RECARRAYID =050#, COMMENT 062; %M01201400
BOOARRAYID =051#, COMMENT 063; %M01202000
REALARRAYID =052#, COMMENT 064; %M01203000
ALFAARRAYID =053#, COMMENT 065; %M01204000
INTARRAYID =054#, COMMENT 066; %M01205000
LABELID =055#, COMMENT 067; %M01206000
COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000
TRUTHV =056#, COMMENT 070; %M01208000
NONLITNO =057#, COMMENT 071; %M01209000
LITNO =058#, COMMENT 072; %M01210000
STRNGCON =059#, COMMENT 073; %M01211000
LEFTPAREN =060#, COMMENT 074; %M01212000
NILV =061#, COMMENT 075; %M01212100
QUOTEOP =062#, COMMENT 076; %M01212200
CHAINOP =063#, COMMENT 077; %M01212300
COMMENT CLASS FOR ALL DECLARATORS; 01213000
DECLARATORS =064#, COMMENT 100; %M01214000
COMMENT CLASSES FOR STATEMENT BEGINNERS; %M01215000
READV =065#, COMMENT 101; %M01216000
WRITEV =066#, COMMENT 102; %M01217000
SPACEV =067#, COMMENT 103; %M01218000
CLOSEV =068#, COMMENT 104; %M01219000
LOCKV =069#, COMMENT 105; %M01220000
REWINDV =070#, COMMENT 106; %M01221000
CASEV =071#, COMMENT 107; %M01222000
FORV =072#, COMMENT 110; %M01223000
WHILEV =073#, COMMENT 111; %M01224000
DOV =074#, COMMENT 112; %M01225000
UNTILV =075#, COMMENT 113; %M01226000
ELSEV =076#, COMMENT 114; %M01227000
ENDV =077#, COMMENT 115; %M01228000
FILLV =078#, COMMENT 116; %M01229000
SEMICOLON =079#, COMMENT 117; %M01230000
IFV =080#, COMMENT 120; %M01231000
GOV =081#, COMMENT 121; %M01232000
RELEASEV =082#, COMMENT 122; %M01233000
BEGINV =083#, COMMENT 123; %M01234000
COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000
SIV =084#, COMMENT 124; %M01236000
DIQ =085#, COMMENT 125; %M01237000
CIV =086#, COMMENT 126; %M01238000
TALLYV =087#, COMMENT 127; %M01239000
DSV =088#, COMMENT 130; %M01240000
SKIPV =089#, COMMENT 131; %M01241000
JUMPV =090#, COMMENT 132; %M01242000
DBV =091#, COMMENT 133; %M01243000
SBV =092#, COMMENT 134; %M01244000
TOGGLEV =093#, COMMENT 135; %M01245000
SCV =094#, COMMENT 136; %M01246000
LOCV =095#, COMMENT 137; %M01247000
DCV =096#, COMMENT 140; %M01248000
LOCALV =097#, COMMENT 141; %M01249000
LITV =098#, COMMENT 142; %M01250000
TRNSFER =099#, COMMENT 143; %M01251000
COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000
COMMENTV =100#, COMMENT 144; %M01253000
FORWARDV =101#, COMMENT 145; %M01254000
STEPV =102#, COMMENT 146; %M01255000
THENV =103#, COMMENT 147; %M01256000
TOV =104#, COMMENT 150; %M01257000
VALUEV =105#, COMMENT 151; %M01258000
WITHV =106#, COMMENT 152; %M01259000
COLON =107#, COMMENT 153; %M01260000
COMMA =108#, COMMENT 154; %M01261000
CROSSHATCH =109#, COMMENT 155; %M01262000
LFTBRKET =110#, COMMENT 156; %M01263000
PERIOD =111#, COMMENT 157; %M01264000
RTBRKET =112#, COMMENT 160; %M01265000
RTPAREN =113#, COMMENT 161; %M01266000
COMMENT CLASSES FOR OPERATORS; 01267000
NOTOP =114#, COMMENT 162; %M01268000
ASSIGNOP =115#, COMMENT 163; %M01269000
AMPERSAND =116#, COMMENT 164; %M01270000
EQVOP =117#, COMMENT 165; %M01271000
IMPOP =118#, COMMENT 166; %M01272000
OROP =119#, COMMENT 167; %M01273000
ANDOP =120#, COMMENT 170; %M01274000
RELOP =121#, COMMENT 171; %M01275000
LRELOP =122#, COMMENT 172; %M01275100
DOTOP =123#, COMMENT 173; %M01275200
ADOP =124#, COMMENT 174; %M01276000
MULOP =125#, COMMENT 175; %M01277000
FACTOP =126#, COMMENT 176; %M01278000
%M01278100
%M01278500
COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000
OWNV =001#, COMMENT 001; %M01280000
SAVEV =002#, COMMENT 002; %M01281000
STRINGV =003#, COMMENT 003; %M01281100
DOUBLEV =004#, COMMENT 004; %M01281200
SYMV =005#, COMMENT 005; %M01281300
RECORDV =006#, COMMENT 006; %M01281400
BOOV =007#, COMMENT 007; %M01282000
REALV =008#, COMMENT 010; %M01283000
ALFAV =009#, COMMENT 011; %M01284000
INTV =010#, COMMENT 012; %M01285000
LABELV =011#, COMMENT 013; %M01286000
DUMPV =012#, COMMENT 014; %M01287000
LISTV =013#, COMMENT 015; %M01288000
OUTV =014#, COMMENT 016; %M01289000
INV =015#, COMMENT 017; %M01290000
MONITORV =016#, COMMENT 020; %M01291000
SWITCHV =017#, COMMENT 021; %M01292000
PROCV =018#, COMMENT 022; %M01293000
ARRAYV =019#, COMMENT 023; %M01294000
FORMATV =020#, COMMENT 024; %M01295000
FILEV =021#, COMMENT 025; %M01296000
STREAMV =022#, COMMENT 026; %M01297000
COMPLEXV =023#, COMMENT 027; %M01297100
DEFINEV =024#, COMMENT 030; %M01298000
FIELDV =025#; COMMENT 031; %M01298100
DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
REAL TIME1; 01300000
INTEGER SCRAM; 01301000
COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000
OR RESERVED WORD SCANNED; 01303000
ARRAY FILEATTRIBUTES[0:30] ; 01303500
SAVE ARRAY ACCUM[0:11]; % %M01304000
COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000
SCANNED ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000
IN INFO, THAT IS ACCUM[1] = 00NAAAAA. ACCUM[I] , I> 1, 01307000
HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000
THE ELBAT WORD BY THE ENTER ROUTINES; 01309000
ARRAY STACKHEAD,SUPERSTACK[0:124]; %WF 01310000
COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO. THIS INDEX %WF 01311000
POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100
LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200
BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300
AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400
WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500
1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600
2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700
3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800
STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900
FOR MORE INFORMATION ON THE USE OF SUPERSTACK, SEE %WF 01312000
COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100
INTEGER COUNT; 01313000
COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 01314000
SCANNED; 01315000
ALPHA Q; 01316000
COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000
WORD SCANNED; 01318000
ARRAY ELBAT[0:75]; INTEGER IZ, NXTELBT; DEFINE I=IZ#; %W2701319000
COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000
QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000
(ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000
GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000
FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000
POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000
INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000
FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000
INTEGER ELCLASS; 01328000
COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000
INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000
INTEGER MAXTLCR; 01331000
COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF 01332000
THE CARD IMAGE CURRENTLY BEING SCANNED, NCR THE ADDRESS 01333000
OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000
CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000
THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000
IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000
DEFINE BUFFSIZE = 56#; 01338000
01339000
INTEGER GTIX; 01339050
ARRAY TEN[0:139]; %A01340000
INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050
DECLARED IN THE OBJECT PROGRAM; 01340060
INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070
GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080
REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500
INTEGER IDLOC,IDLOCTEMP; 01341000
ARRAY PDPRT[0:31,0:63]; 01342000
COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000
IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000
BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000
OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000
TYPE 1 ENTRY 01347000
BIT POSITION KIND OF ENTRY 01348000
0-3 ZERO 01349000
4 MODE BIT(1=CHAR 0=WORD) 01350000
5 ARGUMENT BIT 01351000
6-7 ZERO 01352000
8-17 RELATIVE ADDRESS IN PRT 01353000
18-27 RELATIVE ADDRESS IN SEGMENT 01354000
28-37 SEGMENT NUMBER 01355000
38-47 ZERO 01356000
TYPE 2 ENTRY 01357000
BIT POSITION KIND OF ENTRY 01358000
0 EMPTY 01359000
1 ON IFF TYPE 2 (DATA) SEGMENT 01360000
2 ON IFF INTRINSIC PROCEDURE 01361000
3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050
4-12 EMPTY 01361100
13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200
28-37 SEGMENT NUMBER 01361300
38-47 NUMBER OF WORDS IN SEGMENT 01362000
THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000
IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000
ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000
DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000
IS READY FOR OUTPUT; 01367000
COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010
COMPILATION IS AS FOLLOWS: 01367020
SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030
BIT POSITIONS CONTENTS OF FIELD 01367040
[0:1] EMPTY 01367050
[1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060
[2:1] ON IFF INTRINSIC PROCEDURE 01367070
[3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075
[4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080
[5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085
[8:10] R-RELATIVE LINK TO A PRT ENTRY FOR THIS SEGMENT 01367090
[18:15] SIZE (NOT USED FOR INTRINSICS) 01367100
[33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110
PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120
BIT POSITIONS CONTENTS OF FIELD 01367130
[0:4] 1101(BINARY) NON-PRESENT PROG. DESC. ID BITS 01367140
[4:2] MODE AND ARGUMENT BITS 01367150
[6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160
[7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170
PRT ENTRY FOR SEGMENT I 01367180
[18:15] I 01367190
[33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200
COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210
WORD CONTENTS 01367220
0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230
1 SIZE OF SEGMENT DICTIONARY 01367240
2 RELATIVE LOCATION OF PRT 01367250
3 SIZE OF PRT 01367260
4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270
5 SIZE OF FILE PARAMETER BLOCK 01367280
6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290
7 N 01367300
. O U 01367310
. T S 01367320
. E 01367330
29 D; 01367340
INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000
INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000
INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000
ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000
COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000
AS SPECIFIED BY "L". 01373000
IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 01374000
THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 01375000
REAL LASTENTRY ; 01376000
COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 01377000
INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 01378000
BOOLEAN MRCLEAN ; 01379000
COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000
FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000
POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000
DURING AN ARRAY DECLARATION ; 01383000
REAL GT1,GT2,GT3,GT4,GT5; 01384000
INTEGER GTI1; 01384500
COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000
INTEGER RESULT; 01386000
COMMENT THIS VARIABLE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000
ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000
VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000
USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000
INTEGER LASTUSED; 01391000
COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000
READACARD, THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000
OR PREPARES THE CARD FOR THE SCANNER. 01394000
IF LASTUSED = 1 THEN READ CARDS ONLY 01395000
IF LASTUSED = 2 THEN LAST CARD IMAGE FROM READER (MERGING)01396000
IF LASTUSED = 3 THEN LAST CARD IMAGE FROM TAPE (MERGING) 01397000
IF LASTUSED = 4 THEN READ NO CARD (FOR INITIALIZATION); 01398000
BOOLEAN LINKTOG; 01399000
COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK, 01400000
OTHERWISE IT IS TRUE; 01401000
INTEGER LEVEL,FRSTLEVEL,SUBLEVEL,MODE; 01402000
COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 01403000
TRACK OF LEVELS OF DEFINITION. LEVEL GIVES THE DEPTH OF 01404000
NESTING IN DEFINITION, WHERE EACH BLOCK AND EACH PROCEDURE01405000
GIVES RISE TO A NEW LEVEL. SUBLEVEL GIVES THE LEVEL OF 01406000
THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 01407000
FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST 01408000
GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED. MODE 01409000
IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000
NESTED (AT COMPILE TIME); 01411000
INTEGER AUXMEMREQ; 01411010
BOOLEAN SAVEPRTOG; 01411020
COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030
ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040
AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050
WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060
"PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070
TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080
TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090
ROUTINE IS "PSEUDO-SAVE". 01411100
; 01411110
BOOLEAN SLABTOG; COMMENT USED TO SUPPRESS STREAM NOPS; %W1401411600
BOOLEAN ERRORTOG; 01412000
COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000
ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000
BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000
COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000
BOOLEAN STREAMTOG; 01417000
COMMENT STREAMTOG IS TRUE IF WE ARE COMPILING STREAM STATEMENT. IT 01418000
IS USED TO CONTROL COUMPOUNDTAIL; 01419000
DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000
FI = 6#, FIO = 7#; 01420500
COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE. 01421000
THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000
THEIR MEANING IS: 01423000
FS MEANS FROM STATEMENT, 01424000
FP MEANS FROM PRIMARY, 01425000
FL MEANS FROM LIST, 01426000
FR MEANS FROM FOR, 01427000
FIO MEANS FROM IODEC, 01427250
FA MEANS FROM ACTUALPARAPART, 01427500
FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600
INTEGER LL; DEFINE L = LL#; % %T4001428000
COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000
DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#; 01430000
COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000
PROGRAMS. 01432000
BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000
BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000
IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000
BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T301436000
INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 01437000
JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 01438000
IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 01439000
THINGS ON THE TOP OF THE STACK. 01440000
XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 01441000
WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 01442000
USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 01443000
THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE01444000
STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 01445000
LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 01446000
THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 01447000
BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW. THIS CARRIES YOU 01448000
TO THE PROPER ITEM IN THE LIST. THE FORMATING ROUTINES 01449000
SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 01450000
LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 01451000
DEFINE BTYPE =1#, DTYPE =2#, ATYPE =3#; 01452000
COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 01453000
ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 01454000
BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 01455000
FOR ARITHMETIC EXPRESSIONS; 01456000
BOOLEAN TB1; 01457000
COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE; 01458000
INTEGER JUMPCTR; 01459000
COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK01460000
AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000
BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000
SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000
MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000
OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED01465000
IF LEVEL = JUMPCTR; 01466000
BOOLEAN GOTOG; 01467000
COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY01468000
LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000
MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000
REAL STLB; 01471000
COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000
THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000
ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000
INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000
FOR TEMPORARY STORAGE; 01476000
DEFINE BUMPL = L~L+2#; 01477000
COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000
DEFINE IDMAX = LABELID#; 01479000
COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000
INTEGER DEFINECTR,DEFINEINDEX; 01481000
ALPHA ARRAY DEFINFO[0:89]; 01481100
ALPHA ARRAY TEXT[0:31,0:255]; 01481200
INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300
INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400
REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000
LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000
NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS;01484000
JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000
COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000
ARRAY MACRO[0:35]; 01487000
COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000
REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000
Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000
SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000
COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000
DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS. 01493000
THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000
TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000
THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000
ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000
THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000
INTEGER BEGINCTR; 01499000
COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED01500000
FOR ERROR CONTROL ONLY; 01501000
INTEGER DIALA,DIALB; 01502000
COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000
DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000
WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000
BY SETTING DIALA AND DIALB TO ZERO; 01506000
01507000
01508000
01509000
01510000
01511000
01512000
01513000
01514000
01515000
01516000
01517000
01518000
01519000
01520000
01521000
BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000
SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000
COMMENT AT RR1; 01524000
BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000
DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000
THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000
THE FIRST WORD OF ADDITIONAL INFO; 01528000
DEFINE SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000
THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000
INFO FOR MONITORED SIMPLE VARIABLES; 01531000
DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000
FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000
IN NODIMPART; 01534000
DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000
POSITION IN THE FIRST WORD OF ADDITIONAL 01536000
INFO THAT CONTAINS THE MONITOR FILE 01537000
ADDRESS FOR LABELS; 01538000
DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000
POSITION IN THE FIRST WORD OF ADDITIONAL 01540000
INFO THAT CONTAINS THE MONITOR FILE 01541000
ADDRESS FOR LABELS; 01542000
DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000
POSITION IN THE FIRST WORD OF ADDITIONAL 01544000
INFO THAT CONTAINS THE MONITOR FILE 01545000
ADDRESS FOR LABELS; 01546000
DEFINE DUMPEE = [2:11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000
ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000
THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000
EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000
APPEARS IN A DUMP DECLARATION; 01551000
DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000
ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000
THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000
FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000
THE PRINTI ROUTINE; 01556000
DEFINE CHUNK = 180#; 01556100
FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200
% %A01556300
FILE IN CARD (RR1,10,RR2); %M01557000
DEFINE LINESIZE = 900 # ; % SMALLER DISK AREA %T1101558000
SAVE FILE OUT LINE DISK SERIAL [20:LINESIZE] (RR3,15,RR4,SAVE 5) ; %T1101559000
SAVE ARRAY LIN[0:20];% PRINT OUTPUT BUILT IN LIN %T1101559010
INTEGER DA; 01559020
DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) ELSE 01559030
WRITE(LINE[DBL],15,LIN[*])#; 01559039
SAVE FILE OUT NEWTAPE DISK SERIAL [20:LINESIZE](RR5,RR6,RR7,SAVE 5);%T1101560000
FILE IN TAPE "0CRDIMG" (2,RR8,RR9); 01561000
SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005
FILE IN ERMDF DISK RANDOM "ALGOL ""ERRORS " (1,15,30) ; % %T1401561006
ARRAY ERARA [0:14] ; % %T1401561007
REAL PERR ; % %T1401561008
COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010
FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020
FILE IN CASTB(1,BUFFSIZE); 01561030
FILE IN CASTC(1,BUFFSIZE); 01561040
FILE IN CASTD DISK SERIAL "CASTD""LIBRARY" (1,BUFFSIZE); % %T0301561042
FILE IN CASTE DISK SERIAL "CASTE""LIBRARY" (1,BUFFSIZE); % %T0301561044
FILE IN CASTF DISK SERIAL "CASTF""LIBRARY" (1,BUFFSIZE); % %T0301561045
FILE IN CASTG DISK SERIAL "CASTG""LIBRARY" (1,BUFFSIZE); % %T0301561046
FILE IN CASTH DISK SERIAL "CASTH""LIBRARY" (1,BUFFSIZE); % %T0301561047
FILE IN RETNE DISK SERIAL (1,BUFFSIZE); % %T0301561048
SWITCH FILE LIBRARY ~ CASTA,CASTB,CASTC,CASTD,CASTE,CASTF,CASTG,%T0301561050
CASTH,RETNE; % %T0301561051
FILE OUT REMOTE 19 (2,9); % %T1401561055
BOOLEAN REMOTOG; 01561056
ARRAY LIBARRAY[0:24]; COMMENT LIBARRAY IS USED TO KEEP INFORMATION 01561060
AS TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070
EACH ENTRY CONSISTS OF THREE WORDS CONTAINING; 01561080
FILE DSK1 DISK SERIAL[20:150](2,10,30); %DFB01561085
FILE DSK2 DISK SERIAL [20:300](2,30,30); %DFB01561087
DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090
NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100
DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110
INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120
COMMENT LIBINDEX IS A INDEX INTO LIBARRAY 01561130
INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140
LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150
MAXTLCR USED IN READACARD. FILEINX IS THE 01561160
LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 01561170
SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180
FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190
REAL RECOUNT,FINISHPT; 01561200
BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202
PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204
BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206
CARD READER ELSE FALSE; 01561208
COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210
BOOLEAN NOPATCH ; % %T0301561212
BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215
OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217
DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220
BLOCKS PER LIBRARY TAPE; 01561230
DEFINE NOTAPES = 9 #;%NUMBER OF SOURCE LIBRARY TAPES %T0301561240
ARRAY DIRECTORY[0:NOTAPES|NOROWS-1,0:55]; COMMENT IS THE ACTUAL %T0301561245
DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250
A: 1 CAR- NUMBER OF DIRECTORY BLOCKS, 01561260
B: 1 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270
IDENTIFIER NAME, 01561280
C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER, 01561290
D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300
ENTRIES. 01561310
ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320
LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330
DIRECTORY BLOCKS. 01561340
ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350
AND THEN ITEM D WILL FOLLOW INDICATING THE 01561360
LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370
ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380
BLOCK, 01561390
IN ORDER TO CHANGE: 01561400
NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410
01561020 - 01561050. 01561420
- CHANGE "3" AT 01561430
NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440
AT ; 01561450
REAL C; 01562000
COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000
REAL T; 01564000
COMMENT T IS A TEMPORARY CELL; 01565000
INTEGER TCOUNT; 01566000
COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000
FOR THE USE OF CONVERT; 01568000
REAL STACKCT; %A 01568500
DEFINE LOGI =443#, 01569000
EXPI =440#, 01570000
XTOTHEI =480#, 01571000
GOTOSOLVER =484#, 01572000
PRINTI =477#, 01573000
MERGEI =500#, 01573100
POWERSOFTEN =792#, %T9201574000
LASTSEQUENCE = 30#, %T9301575000
LASTSEQROW =3#, %A01576000
INTERPTO =461#, 01577000
SUPERMOVER =545#, %T9201577500
CHARI =465#, 01578000
INTERPTI =469#, 01579000
SORTI =473#, 01579100
SWAPPER =768#, %T9201579200
DIALER =763#, %T9201579300
FORTRANERR = 772#, %A01579400
MATDID =776#, %A01579500
MATINV = 780#, %A01579600
MATTRN =784#, %A01579700
MATMUL =788#, %A01579800
FILATTINT =535#, %T9201579900
SORTA =793#; %T9201580000
COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000
IN INFO OF THE CORRESPONDING ROUTINE; 01582000
INTEGER KOUNT,BUFFACCUM; 01583000
INTEGER FILENO; 01584000
BOOLEAN 01585000
FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000
FUNCTION; 01587000
P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 01588000
P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 01589000
VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000
FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000
PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000
SPECTOG, 01593000
STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000
ONE ID AND THEN EIXT; 01595000
AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000
BOOLEAN STOPDEFINE; 01597000
REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100
INTEGER MAXSAVE; 01598000
COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000
DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000
FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000
REAL 01602000
KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000
ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000
LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000
LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000
INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000
PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000
DECLARED; 01609000
G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000
TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000
BEING DECLARED; 01612000
PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000
DECLARED; 01614000
MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000
OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000
PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000
J, COMMENT ARRAY COUNTER; 01618000
LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000
NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000
FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000
IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000
SAVEL; COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000
INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000
ENTERED IN INFO AT ANY GIVEN TIME; 01625000
REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100
DEFINE PURPT=[4:8]#,SECRET=2#; 01628000
COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000
NUMBERS REFER TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000
FULL NAME IS ALSO GIVEN; 01631000
DEFINE 01632000
ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000
BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000
BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000
BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000
BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000
CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000
CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000
COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000
COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000
DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; %A 01642000
DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000
EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000
LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000
LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000
GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000
LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000
LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000
GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000
IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000
INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000
ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000
ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000
LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000
LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000
LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000
LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000
LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000
LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQIVALENCE; 01660000
LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000
MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100
MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000
MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000
NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000
NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000
PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000
PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000
RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000
RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000
RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000
SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000
SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100
SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000
STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000
SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000
XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000
XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000
ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000
COMMENT THESE DEFINES ARE USED BY EMITD; 01678000
DEFINE 01679000
DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000
DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000
TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000
REAL MAXSTACK,STACKCTR; 01683000
INTEGER MAXROW; 01684000
COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000
ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000
INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000
INTEGER F; 01688000
STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010
BEGIN LOCAL T1,T2,T3; 01688020
SI~EDOC;T1~SI;SI~TEDOC;T2~SI;SI~LOC EDOC;SI~SI+3;DI~LOC T3; 01688030
DI~DI+5;SKIP 3 DB;15(IF SB THEN DS~1 SET ELSE DS~1 RESET; 01688040
SKIP 1 SB);SI~LOC EDOC;DI~LOC T2; DS~ 5 CHR;3(IF SB THEN DS~ 01688050
1 SET ELSE DS ~ 1 RESET; SKIP 1 SB);DI~T3;SI~LOC T2;DS~WDS; 01688060
DI~LOC T3;DI~DI+5;SKIP 3 DB;SI~LOC TEDOC;SI~SI+3;15(IF SB 01688070
THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);SI~ LOC TEDOC;DI~LOC 01688080
T1; DS~5 CHR;3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB); 01688090
DI~T3;SI~LOC T1;DS~WDS 01688100
END; 01688110
REAL NLO,NHI,TLO,THI; 01689000
BOOLEAN DPTOG; 01690000
COMMENT THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;01691000
DEFINE FZERO=896#; 01692000
REAL T1,T2,N,K,AKKUM; 01693000
BOOLEAN STOPGSP; 01694000
INTEGER BUP; 01695000
COMMENT UNIQUE GLOBAL TEMP FOR BLOCK; 01696000
ARRAY GTA1[0:10]; 01697000
BOOLEAN ARRAY SPRT[0:31]; 01698000
COMMENT SPRT IS TO BE CONSIDERED TO BE AN ARRAY OF 32 32 BIT 01699000
FIELDS. THE 32 BITS ARE IN THE LOW ORDER PART OF EACH 01700000
WORD. THE BIT IS ON IF AND ONLY IF THE CORRESPONDING 01701000
PRT CELL HAS A PERMANENT ASSIGNMENT; 01702000
INTEGER PRTI,PRTIMAX; 01703000
COMMENT PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-01704000
MENT. PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000
TEMPORARY ASSIGNMENT; 01706000
DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000
POSITION IN THE SECOND WORD OF INFO WHICH 01708000
CONTAINS THE LENGTH OF ALPHA; 01709000
DEFINE STEPI = (ELCLASS ~ TABLE(IZ~IZ+1))#; % %60 %W2701709400
DEFINE EDOCINDEX = L.[36:3],L.[39:7]#; COMMENT EDOCINDEX IS THE WORD 01710000
PORTION OF L SPLIT INTO A ROW AND01711000
COLUMN INDEX FOR EDOC; 01712000
DEFINE CPLUS1 = 769#; COMMENT SEE COMMENT AT CPLUS2 DEFINE; 01713000
DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000
USED IN THE GENERATION OF C-RELATIVE CODE; 01715000
BEGIN % START SEGMENT HERE..... 01715001
PROCEDURE CHECKBOUNDLVL; FORWARD; % 01715010
PROCEDURE UNHOOK; FORWARD; % 01715020
PROCEDURE MAKEUPACCUM; FORWARD; % 01715030
PROCEDURE LISTPARA; FORWARD; %W3301715500
PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01716000
ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD; 01717000
BOOLEAN MACROID; 01717800
REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900
PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950
PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000
REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100
PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200
INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000
BOOLEAN LISTMODE; 01720000
COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000
IS BEING GENERATED OR A STATEMENT; 01722000
INTEGER LSTR; 01723000
COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000
USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000
%T0301727000
%T0301728000
PROCEDURE SCANNER; FORWARD; 01730000
COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLUTE ADDRESS; 01732000
REAL STREAM PROCEDURE MKABS(A); 01733000
BEGIN DI ~ A; MKABS ~ DI END MKABS; 01734000
STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000
BEGIN LOCAL T; 01736000
SI~LOC W; DI~LOC T; SI~SI+6; DI~DI+7; DS~CHR; 01736100
SI~A; DI~B; T(DS~32 WDS; DS~32 WDS); DS~W WDS; 01736200
END MOVE; 01736300
STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000
VALUE NDIV32,NMOD32 ; 01737050
BEGIN DI := DEST; 01737100
NDIV32(32(DS :=8 LIT"0")); 01737150
NMOD32(DS := 8 LIT"0"); 01737200
END; 01737250
COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 01737300
STREAM PROCEDURE BLANKET(N,THERE); VALUE N; 01737350
BEGIN 01737400
DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS; 01737450
END BLANKET; 01737500
01738000
01739000
01740000
DEFINE STEPIT= ELCLASS ~ TABLE(IZ~IZ+1)#; % %W2701741000
COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100
STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200
BEGIN 01741300
DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400
END; 01741500
STREAM PROCEDURE SEQERR(L); BEGIN DI~L;DI~DI+3;DS~LIT"S";END; % %T0301742100
BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200
COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300
TRUE IF ANY VISIBLE CHARACTER ; 01742400
BEGIN 01742500
LABEL NED; 01742600
SI~FCR; 01742700
TALLY~0; 01742800
2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900
TALLY~63; 01743000
NED: TALLY~TALLY+1; 01743100
NONBLANK~TALLY 01743200
END NONBLANK; 01743300
INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN-TIME ERROR KLUDGE-- 01750000
GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000
FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000
BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000
ABOUT FAULTLEVEL; 01754000
INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000
STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR); VALUE NCR; 01756000
BEGIN 01757000
LABEL L,TRANS; 01758000
LOCAL N; 01759000
SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000
SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000
2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000
SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-8 . 01763000
L: 01764000
IF SC=""" THEN 01765000
BEGIN 01766000
SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN 01767000
NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETV6ID. 01768000
8(IF SC=""" THEN JUMP OUT ELSE 01769000
BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01770000
END 01771000
ELSE BEGIN 01772000
NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01773000
DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN 01774000
8(IF SC=" " THEN JUMP OUT ELSE 01775000
BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01776000
END; 01777000
TRANS: 01778000
SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000
SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000
N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000
DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000
DI:=VR; SI:=LOC VP; DS:=WDS;% ADDRESS OF VOID RANGE. 01783000
END OF GETVOID; 01784000
REAL VOIDCR,VOIDPLACE; 01785000
BOOLEAN SORTMERGETOG; 01786000
FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000
PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000
BUG(X24,4(A4,X2)); 01802000
PROCEDURE OCTCON(F,R); VALUE F; BOOLEAN F; REAL R; BEGIN %W0301810810
COMMENT OCTCON SETS FLAG BIT ONLY IF CALLED FROM FILLSTMT(I.E. IF %W0301810820
F IS FALSE); %W0301810830
BOOLEAN STREAM PROCEDURE OC(AC,C1,C2,B,F,R); VALUE C1,C2,B,F; %W0301810840
BEGIN %W0301810850
SI ~ AC; SI ~ SI+C1; DI ~ R; SKIP B DB; %W0301810860
C2(IF SC>"7"THEN TALLY~1; IF SC<"0"THEN TALLY~1;SKIP 3SB; %W0301810870
3(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); %W0301810880
DI ~ R; DS ~ F RESET; OC ~ TALLY %W0301810890
END OC; %W0301810900
INTEGER C1,C2; %W0301810910
IF COUNT>16 THEN BEGIN C1 ~ COUNT-13; C2 ~ 16 END %W0301810920
ELSE BEGIN C1 ~ 3; C2 ~ COUNT END; %W0301810930
R ~ 0; %W0301810940
IF OC(ACCUM[1],C1,C2,48-3|C2,F,R) THEN FLAG( 303) %W0301810950
END OCTCON; %W0301810960
PROCEDURE DATIME; 01820000
BEGIN 01821000
INTEGER H,MIN,Q; 01822000
ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE; 01823000
BEGIN 01824000
DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2; 01825000
2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR; 01826000
END OF DATER; 01827000
H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60; 01828000
WRITE(LINE[DBL], 01829000
<X16,"RECC B-5700 GEORGIA TECH LANGUAGE COMPILER MARK ", %T9301830000
"XIII.36" %T9301831000
," ",A6,"DAY, ",O,", ",I2,":",A2,X1,A1,"M."//>, 01832000
TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000
Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000
IF H}12 THEN "P" ELSE "A"); 01835000
NOHEADING:=FALSE; 01836000
WRITE (LINE,<" *** ** **"X80" **** ******** * ****:* * ***"/ % %T0701837000
" E B L "X80" L N S N S A S S S "/ % %T0701838320
" R E E "X80" I U E U O D Y E E "/ % %T0701838330
" R G V "X80" N M Q M U D L Q G "/ % %T0701838340
" O I E "X80" E B U B R R L M "/ % %T0701838350
" R N L "X80" * E E E C E A E E "/ % %T0701838360
" S S * "X80" * R N R E S B R N "/ % %T0701838370
" * * * "X80" * * C * * S L R T "/ % %T0701838380
" * * * "X80" * * E * * * E * * "/ % %T0701838390
" *** ** **"X80" **** ******** * ****:* * ***">); END;%T0701838400
DEFINE DOT = BEGIN IF ELCLASS=PERIOD THEN DOTIT END#; %D01841000
% %A01842000
% %A01842100
COMMENT THE FOLLOWING DECLARATIONS ARE FOR GTL; %A01842200
REAL ARRAY %A01842300
DAC[0:22], % USED FOR REMOTE TERMINAL FILE INFO %T9001842350
DPI[0:107], % USED FOR OBJECT PROGRAM PRT ASSIGNMENTS %A01842400
% - SEE GNATA GNATP, AND GNATI %A01842500
FRD[0:31], % CONTAINS PRT AND STACK ADDRESS FOR %A01842600
%TEMPORARY FOR AND STRING PARAMETERS - SEE FORAD %A01842700
EDC[0:3,0:127], % TEMPORARY CODE ARRAY FOR STRING STUFF %A01842800
LNK[0:7,0:512], % CONTAINS COMPILE TIME SYMBOL CONSTANTS %A01842900
RECARRAY[30:60], % CONTAINS ADDITIONAL INFORMATION ABOUT %A01843000
% RECORD TYPES %A01843100
SYMSTACK[0:124]; % STACKHEAD FOR COMPILE TIME %A01843200
% SYMBOL CONSTANTS %A01843300
REAL %A01843500
INOUTUSED, %A01843550
DACP, % DATA-COMM POINTERS %A01843560
FORLEVEL, %A01843600
GPBV, %A01843650
JMPCH, %A01843700
LC, %A01843800
RECORDLINK, %A01843900
RECTYPE, %A01844000
RETLIST; %T9201844050
PROCEDURE PERMLINE(B); VALUE B; BOOLEAN B; 01844100
BEGIN 01844110
INTEGER LT; % %T1101844115
NOTPNTED ~ FALSE; 01844120
IF LT:=LINE.TYPE=10 OR LT=12 OR LT=13 % %T1101844130
THEN BEGIN 01844140
IF LT ! 12 THEN LINE.TYPE := 12; % %T1101844145
WRITE(LINE); LOCK(LINE); 01844150
LINE.AREAS ~ 0; LINE.AREASIZE ~ 0; 01844160
END; 01844170
IF B THEN DATIME; 01844180
END PERMLINE ; 01844190
REAL %T9201844195
SAVEQ, %A01844200
SFPL, % %A01844210
SFTRC, % SYMBOL FORMAT TRACE TOG %A01844220
HOLDFR, %A01844250
XITLIST; %A01844300
INTEGER %A01844400
DP, %A01844700
DL, %A01844800
DR, %A01844900
LFINAL, %A01845000
LNKNDX, %A01845100
MOREWORDS, %A01845200
NEWPART, %A01845300
STK, %A01845400
STRINGMAX, %A01845500
SYMFORM, %A01845600
SYMLOC, %A01845700
TABLEMARKV, %A01845800
SP, %A01845810
SL, %A01845820
WTYPE; %A01845900
BOOLEAN %A01846000
SPT, %A01846100
SLT, %A01846200
DPT, %A01846300
DLT, %A01846350
DRT, %A01846400
INTDEBUGTOG, %IF TRUE THEN DEBUGN ON GTL INTRINSICS %T9001846450
MARKSYM, %A01846500
PRINTOG, %A01846600
PRINFORM, %A01846650
QUOTETOG, %A01846700
RECLAIMTOG, %A01846800
SMT, %A01846900
SOPG, %A01847000
SYMFORMAT, %A01847050
SYMQUOTE, %A01847100
SYMSTK, % SYMBOL PLEX OPTION FLAG %A01847150
SYMSEC; %A01847200
% %A01847300
COMMENT ADDITIONAL INFORMATION FOR RECORD DECLARATORS: %A01847400
1ST WORD: [40:8] = NUMBER OF FIELDS %A01847500
OTHERS: [35:13] = LINK TO FIELDID, %A01847600
IN RECARRAY[R], WHERE R IS THE RECORD TYPE NUMBER,: %A01847700
[35:13] = LINK TO RECORD, %A01847800
[24:11] = ADDRESS OF ARRAY, %A01847900
[13:11] = ADDRESS OF FREELIST (COL, ROW), %A01848000
[10:3] = LENGTH OF RECORD (AS POWER OF 2), %A01848100
[3:7] = LENGTH OF RECORD; %A01848200
COMMENT ADDITIONAL WORDS IN INFO FOR FIELD IDENTIFIER: %A01848300
[1:1] = ON IF INDEXED, %A01848400
[8:7] = STARTING WORD, %A01848500
[15:7] = ENDING WORD, %A01848600
[22:13] = STARTING POSITION, %A01848700
[35:13] = NO OF POSITIONS; %A01848800
COMMENT SUBCLASS FOR RECID IN (18+COUNT)DIV 8,WHERE %A01848900
COUNT IS NO OF CHARACTERS IN IDENTIFIER %A01849000
[2:7] = ID NUMBER IF ID FIELD %A01849100
[1:1] = IF USED AS ID FIELD; %A01849200
COMMENT ADDITIONAL STRING INFO - IF NOT FORMAL: %A01849300
STRINGID: IF [1:1] =1 THEN SUBSTRING - %A01849400
[35:13]= LINK TO MAIN STRING, %A01849500
[22:13]= STARTING POSITION, %A01849600
[9:13] = STRING LENGTH IN CHAR, %A01849700
ELSE [35:13] = LENGTH %A01849800
STRING ARRAY: [35:13] = LENGTH AT %A01849900
INDEX + INCR + DIMENSION +1; %A01850000
% %A01850100
% %A01850200
DEFINE %A01850300
TRS = 63#, %A01850400
TRP = 60#, %A01850500
TRW = 05#, %A01850600
TGR = 23#, %A01850700
TEG = 22#, %A01850800
TEQ = 20#, %A01850900
TEL = 28#, %A01851000
TLS = 29#, %A01851100
TNE = 21#, %A01851200
TAN = 30#, %A01851300
BIT = 31#, %A01851400
TIB = BIT#, %A01851450
CGR = 51#, %A01851500
CEG = 50#, %A01851600
CEQ = 48#, %A01851700
CEL = 56#, %A01851800
CLS = 57#, %A01851900
CNE = 49#, %A01852000
JFW = 39#, %A01852100
JFC = 37#, %A01852200
BNS = 42#, %A01852300
ENS = 41#, %A01852400
JNS = 38#, %A01852500
JNC = 36#, %A01852600
SFS = 25#, %A01852700
SRS = 24#, %A01852800
SFD = 14#, %A01852900
SRD = 15#, %A01853000
BSD = 02#, %A01853100
BSS = 03#, %A01853200
SSA = 13#, %A01853300
SDA = 12#, %A01853400
SCA = 44#, %A01853500
RSA = 43#, %A01853600
RDA = 04#, %A01853700
RCA = 40#, %A01853800
SES = 18#, %A01853900
SED = 06#, %A01854000
TSA = 46#, %A01854100
TDA = 07#, %A01854200
FAD = 59#, %A01854300
FSV = 58#, %A01854400
ICV = 55#, %A01854500
OCV = 54#, %A01854600
SEC = 34#, %A01854700
INC = 32#, %A01854800
STC = 33#, %A01854900
BIR = 53#, %A01855000
BIS = 52#, %A01855100
CRF = 35#; %A01855200
DEFINE %A01855300
DATAN = GNATP( 0)#, %A01855400
DCOS = GNATP( 1)#, %A01855500
DXP = GNATP( 2)#, %A01855600
DLOG = GNATP( 3)#, %A01855700
DSIN = GNATP( 4)#, %A01855800
DSQRT = GNATP( 5)#, %A01855900
DLG10 = GNATP( 6)#, %A01856000
DATN2 = GNATP( 7)#, %A01856100
CABS = GNATP( 8)#, %A01856200
CCOS = GNATP( 9)#, %A01856300
CEXP = GNATP(10)#, %A01856400
CLOG = GNATP(11)#, %A01856500
CSIN = GNATP(12)#, %A01856600
CSQRT = GNATP(13)#, %A01856700
DMOD = GNATP(14)#; %A01856800
DEFINE NEWLINK = LNK[(LNKNDX~LNKNDX+1).[33:6],LNKNDX.[39:9]]#; %A01856900
DEFINE FRLEVEL = FORLEVEL+REAL(MARKSYM)#; %A01857000
DEFINE NEWFLD = [2:2]#; %A01857100
DEFINE DTV = 128#, %A01857200
TS = [41:2]#, %A01857300
NS = [43:2]#; %A01857400
% %A01857500
% %A01857600
DEFINE FCE = 61#, FCL = 57#, CBD = 3#, %A01857700
CBN = 1#, CFD = 2#, CFN = 0#; %A01857800
DEFINE %A01857900
SEXPN = SDNORM(SEXP)#, %A01857950
TEMP1 = TEMP(1)#, %A01858000
TEMP2 = TEMP(2)#, %A01858100
ECM = 584#, %A01858200
CTF = 965#, %A01858300
CTC = 709#, %A01858400
FTF = 453#, %A01858500
ML2 = 065#, %A01858600
AD2 = 017#, %A01858700
SB2 = 049#, %A01858800
DV2 = 129#, %A01858900
MOP = 259#, %A01859000
TOP = 262#, %A01859100
TIMEI = 455#, %A01859200
STKC = STK ~ STK + 1#, %A01859300
DCRFR = FORLEVEL ~ FORLEVEL -1 - REAL(RECLAIMTOG)#, %A01859400
TABR = CP#, %A01859500
COLR = CPI#, %A01859600
SINI = 449#, %A01859700
COSI = 433#; %A01859800
DEFINE %A01859900
PRTFL = 147#, %A01860000
ST1 = 148#, %A01860100
ST2 = 149#, %A01860200
ST3 = 150#, %A01860300
TMP = 141#, %A01860400
LNKA = GNATA(0)#, %A01860500
PTABLE = GNATA(1)#, %A01860600
SYMSTACKA = GNATA(1)#, %A01860700
INSTR = GNATA(2)#, %A01860800
OUTSTR = GNATA(3)#, %A01860900
TABLEMARK = GNATA(4)#, %A01861000
RND = GNATA(5)#, %A01861100
ADDPROPA = GNATI( 0)#, %A01861200
ALFPRINT = GNATI( 1)#, %A01861300
APPEND = GNATI( 2)#, %A01861400
ARITHPRINT = GNATI( 3)#, %A01861500
ATCON = GNATI( 4)#, %A01861600
ATN = GNATI( 5)#, %A01861700
ATSTRV = GNATI( 6)#, %A01861800
BOOPRINT = GNATI( 7)#, %A01861900
CHARPRINT = GNATI( 8)#, %A01862000
COLLECT = GNATI( 9)#, %A01862100
DBLFACT = GNATI(10)#, %A01862200
DBLPLXFACT = GNATI(11)#, %A01862300
DBLPLXPRINT = GNATI(12)#, %A01862400
DBLPRINT = GNATI(13)#, %A01862500
ERRPRO = GNATI(14)#, %A01862600
GENLINK = GNATI(15)#, %A01862700
GENSYM = GNATI(16)#, %A01862800
LENGTHV = GNATI(17)#, %A01862900
MRK = GNATI(18)#, %A01863000
MARKD = GNATI(19)#, %A01863100
MARKER = GNATI(20)#, %A01863200
MARKOB = GNATI(21)#, %A01863300
MEMBER = GNATI(22)#, %A01863400
MKATM = GNATI(23)#, %A01863500
MONPRO = GNATI(24)#, %A01863600
MONSYM = GNATI(25)#, %A01863700
NCONC = GNATI(26)#, %A01863800
NTA = GNATI(27)#, %A01863900
NTSER = GNATI(28)#, %A01864000
PLXFACT = GNATI(29)#, %A01864100
PLXPRINT = GNATI(30)#, %A01864200
PROPA = GNATI(31)#, %A01864300
RANDNO = GNATI(32)#, %A01864400
RANDOM = GNATI(33)#, %A01864500
READER = GNATI(34)#, %A01864600
READ1 = GNATI(35)#, %A01864700
READCON = GNATI(36)#, %A01864800
READN = GNATI(37)#, %A01864900
READSYM = GNATI(38)#, %A01865000
RECALL = GNATI(39)#, %A01865100
TWXLOOP = GNATI(40)#, %A01865200
RECLINK = GNATI(41)#, %A01865300
REMEMBER = GNATI(42)#, %A01865400
REMOB = GNATI(43)#, %A01865500
REMPROPER = GNATI(44)#, %A01865600
RITELINE = GNATI(45)#, %A01865700
SCANR = GNATI(46)#, %A01865800
SPACEPRINT = GNATI(47)#, %A01865900
STRINGPRINT = GNATI(48)#, %A01866000
SYMEQ = GNATI(49)#, %A01866100
SYMEQA = GNATI(50)#, %A01866200
SYMFIX = GNATI(51)#, %A01866300
SYMPRINT = GNATI(52)#, %A01866400
TERPRIN = GNATI(53)#, %A01866500
DACOMI = DPI[104]#, %A01866600
DACOMO = DPI[105]#, %A01866610
ARSTV = DPI[106]~104#, %A01866620
FORTERR = DPI[107] ~ 24#, %A01866630
POWERSOFTENI = 105#, %A01866700
SNGLSIG = 106#, %A01866800
DBLSIG = 107#, %A01866900
WSIGN = 108#, %A01867000
FREEN = 109#, %A01867100
FREENL = 110#, %A01867200
FREETIME = 111#, %A01867300
FREELIST = 112#, %A01867400
LNKCOL = 113#, %A01867500
LNKROW = 114#, %A01867600
CP = 115#, %A01867700
CPI = 116#, %A01867800
LMARG = 117#, %A01867900
LMARGI = 118#, %A01868000
RMARG = 119#, %A01868100
RMARGI = 120#, %A01868200
OUTOG = 121#, %A01868300
INITI = 122#, %A01868400
LGO = 123#, %A01868500
LGI = 124#, %A01868600
PROTOG = 125#, %A01868700
PROI = 126#, %A01868800
NSTR = 127#, %A01868900
COUNTI = 128#, %A01869000
FILPRO = 129#, %A01869100
FILPROI = 130#, %A01869200
STRP = 131#, %A01869300
STRI = 132#, %A01869400
GENOK = 133#, %A01869500
GENU = 134#, %A01869600
CPM = 135#, %A01869700
GENNO = 136#, %A01869800
COLSET = 142#, %A01869850
INSYM = 137#, %A01869900
INDBL = 138#, %A01870000
INREAL = 139#; %A01870100
DEFINE RTPARN = IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104)#; %A01870200
% %A01870300
DEFINE TPR = TRP#; %A01870400
% %A01870500
STREAM PROCEDURE CHAINFORM(A,B); %A01870600
BEGIN %A01870700
LOCAL T,R; LABEL OTHERS; %A01870800
SI ~ A; SI ~ SI + 2; DI ~ LOC T; DI ~ DI + 7; DS ~ CHR; %A01870900
IF SC ! "C" THEN GO TO OTHERS; SI ~ SI + T; SI ~ SI - 1; %A01871000
IF SC ! "R" THEN GO TO OTHERS; TALLY ~ T; %A01871100
2(TALLY ~ TALLY + 63); T ~ TALLY; DI ~ LOC R; DI ~ DI + 6; %A01871200
SI ~ SI - T; %A01871300
T(IF SC = "D" THEN SKIP 2 DB ELSE %A01871400
IF SC = "A" THEN BEGIN SKIP DB; DS ~ SET END ELSE %A01871500
IF SC = "T" THEN BEGIN DS ~ SET; SKIP DB END ELSE %A01871600
JUMP OUT TO OTHERS; SI ~ SI + 1); %A01871700
DI ~ B; SKIP 3 DB; DS ~ 6 SET; %A01871800
SI ~ LOC R; SI ~ SI + 6; DS ~ 2 SET; %A01871900
2(T(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); %A01872000
DS ~ 2 SET; %A01872100
OTHERS: END OF CHAINFORM; %A01872200
% %A01872300
% %A01872400
% %A01872500
% FIX RECORD CODE %A01872600
% 0 READ & SET POINTER PLUS %A01872700
% 1 READ & SET POINTER MINUS %A01872800
% 2 GENERATE RECORD %A01872900
% 4 RECLAIM RECORD %A01873000
% 5 WRITE IF NEGATIVE %A01873100
COMMENT RECARRAY[R] %A01873200
[35:13] = LINK TO RECORD %A01873300
[22:13] = LINK TO FILE %A01873400
[11:11] = ADDRESS OF ROW POINTER,(BUFF1 ADR,BUFF2 ADR) %A01873500
[6 : 5] = NO OF STARTING ROW %A01873600
[1 : 1] = 1 IF FIELDS NO CHECKED ; %A01873700
% ADDL INFO FOR RECORD DISK FILES %A01873800
% [37:11] = ADR OF ARRAY %A01873900
% [26:11] = ADR OF FREELIST,NXT AVL REC %A01874000
% [16:10] = BUFFER SIZE %A01874100
% [7 : 9] = NO OF INFO WORDS IN FILE %A01874200
% [2 : 5] = NO OF RECORD CLASSES %A01874300
% [1 : 1] = 1 IF ARRAY DECLARED %A01874400
% EL+1: [2:2]= 1 IF LOCAL %A01874500
% 2 IF NEW %A01874600
% 3 IF OLD %A01874700
% INFO IN DAC %A01874800
% 0 READ TO CLEAR TOG %A01874900
% 1 REMOTE IN TOG %A01875000
% 2 TOGGLE SET BY READ-CLEARED BY WRITE-SUPPRESS EXTRA LF %T9001875100
% 3 OWN J %A01875200
% 4 OWN K %A01875300
% 5 MAIN IN-STRING ADR %A01875400
% 6 MAIN STRING LENGTH - EQUAL TO FILE LENGTH %T9001875500
% 7 IN-FILE ADR %A01875600
% 8 REMOTE OUT-TOG %A01875700
% 9 AUX OUT-ARRAY ADR %A01875800
% 10 STATEWORD ADR %A01875900
% 11 BRKTOG ADR %A01876000
% 12 IMPTOG ADR %A01876100
% 13 OUT FILE ADR - SAME AS IN-FILE ADR %T9001876200
% 14 MAIN OUT-STRING ADR %A01876300
% 15 RMARG - LENGTH OF OUT STRING EQUALS FILE LENGTH %T9001876400
% 16 READ WAIT TIME IF ! 0 %A01876500
% 17 REMOTE NO INPUT LABEL IF ! 0 %A01876600
% 18 REMOTE ABNORMAL CONDITIONN LABLE IF ! 0 %A01876700
% 19 REMOTE INPUT EOF IF ! 0 %T9001876730
% 20 REMOTE INPUT PARITY IF ! 0 %T9001876760
% 21 REMOTE INPUT BUFFER OVERFLOW IF ! 0 %T9001876790
% %A01876800
% 22 RETURN END OF FILE TOG - IF FALSE THEN RETURN END OF FILE%T9001876900
COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000
AND SCANNING THEM; 02001000
BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020
VALUE ROW ; 02001030
BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040
REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050
; 02001060
LOCAL DPPOS,TEMP,LGTH; 02001070
LABEL LOOP,EXIT; 02001080
SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090
DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100
SI~SI+8; 02001110
LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120
DI~ACC1; DI~DI+2; SI~SI-1; 02001130
IF SC = DC 02001140
THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150
IF LGTH SC = DC 02001160
THEN BEGIN COMMENT FOUND IT; 02001170
DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180
IF SC = "0" 02001190
THEN BEGIN COMMENT WE MAY BE IN THE02001200
WRONG ROW; 02001210
SI~SI+1;DI~LOC LOOK; 02001220
IF 3 SC = DC 02001230
THEN BEGIN COMMENT WE ARE02001240
IN THE WRONG 02001250
ROW; 02001260
SI~DPPOS; 02001270
SI~SI+8; 02001280
DPPOS~SI; 02001290
DI~LOC TEMP; 02001300
DS~WDS; 02001310
SI~TEMP; 02001320
END 02001330
ELSE SI~SI-4; 02001340
END; 02001350
DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360
SI~SI+ LGTH; 02001360
DI~STOPOS; DS~5 LIT"0"; 02001375
DS~3 CHR; GO TO EXIT; 02001380
END; 02001390
SI~SI+3; 02001400
END 02001410
ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420
SI~SI-1; 02001430
IF SC = "0" 02001440
THEN BEGIN COMMENT MAY BE NEW ROW; 02001450
SI~SI+1; DI~LOC LOOK; 02001460
IF 3 SC = DC 02001470
THEN BEGIN COMMENT CHANGE ROWS; 02001480
SI~DPPOS;SI~SI+8;DPPOS~SI;02001490
DI~LOC TEMP; DS~WDS; 02001500
SI~TEMP; 02001510
END 02001520
ELSE BEGIN COMMENT IT IS NOT HERE; 02001530
TALLY~1; LOOK~TALLY; 02001540
GO TO EXIT; 02001550
END; 02001560
GO TO LOOP; 02001563
END; 02001565
SI~SI+LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568
END; 02001570
GO TO LOOP; 02001580
EXIT:; 02001590
END LOOK; 02001600
02001750
02001760
02001763
02001765
02001770
02001780
02001790
02001800
02001810
02001820
02001825
02001826
02001827
02001828
02001830
REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831
BEGIN 02001832
SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833
END CONV; 02001834
COMMENT ZOT INSERTS THE CHARACTOR CHAR INTO THE POSITION GIVEN BY 02002000
LCR. IT RETURNS THE CHARACTOR PREVIOUSLY IN LCR THROUGH 02003000
RET. THE PRIMARY PURPOSE OF THE ROUTINE IS TO INSERT A 02004000
PERCENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02005000
THE SCANNER AND TO REMEMBER THE PREVIOUS CHARACTOR IN CASE02006000
IT IS NEEDED BY THE ERROR ROUTINES; 02007000
STREAM PROCEDURE ZOT(RET,CHAR,LCR); VALUE CHAR,LCR; 02008000
BEGIN DI ~ RET; SI ~ LCR; DS ~ WDS; 02009000
COMMENT BRING OUT THE CHARACTOR IN COLUMN 73; 02010000
DI~LCR; SI~LOC LCR; SI~SI-1; DS~CHR; 02011000
COMMENT CHANGE CHARACTOR IN COLUMN 73 TO CHAR; 02012000
END ZOT; 02013000
COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010
IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020
THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030
NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040
VARIABLE AD; 02013050
STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060
VALUE AD,DESCRP; 02013065
BEGIN 02013070
LOCAL HOLD,ZONEP; 02013073
DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074
COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075
DI~SUM; DI~DI+7; DS~2 RESET; 02013076
COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077
SI~LOC DESCRP; SI~SI+7; 02013078
IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080
DS~WDS; DI~HOLD; END 02013085
ELSE DI~SEQLOC; 02013090
COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091
HOLD~DI; DI~DI+7; DS~2 RESET; DI~HOLD; 02013095
SI ~ LOC AD; 02013100
SI ~ SI + 7; 02013110
IF SC = "1" THEN BEGIN SI~ SUM; DS~8 ADD; END 02013120
ELSE BEGIN SI~ SUM; DS~8 SUB; END; 02013130
SI~LOC ZONEP; DI~HOLD; DS~8 ZON; 02013135
SI~LOC ZONEP; DI~SUM; DS~8 ZON; 02013136
COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137
END ADDER; 02013140
COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150
COMPILABLE QUANTITIES, THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155
A LIBRAY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160
PROCEDURE SEARCHLIB(DOLLAR); 02013165
VALUE DOLLAR; BOOLEAN DOLLAR; 02013170
BEGIN 02013175
REAL R1 ; % %3002013176
LABEL EXIT,EXITOUT, NOPARTIAL; 02013180
BOOLEAN TEMPLISTOG; 02013183
NOPATCH ~ REAL (DOLLAR) = 5; % %T0302013184
IF DOLLAR THEN 02013185
BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190
IF NOT NOPATCH THEN BEGIN % %T0302013193
IF REAL(DOLLAR) = 3 THEN BEGIN % %T0302013194
RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195
END; % %T0302013196
RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200
END; % %T0302013201
FILEINX~IF NOPATCH THEN NOTAPES-1 ELSE ACCUM[1].[18:6]; % %T0302013203
IF IF NOPATCH THEN FALSE ELSE % %T0302013205
FILEINX ~ FILEINX - 17 < 0 OR FILEINX>NOTAPES-2 THEN BEGIN %T0302013210
COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219
TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013220
FLAG(500); LISTOG~TEMPLISTOG; GO TO EXIT; 02013222
END; 02013225
% %T0302013230
IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235
BEGIN COMMENT MUST READ DIRECTORY; 02013240
GT3~MKABS(LIBRARY[FILEINX](0)); 02013245
MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250
GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255
WHILE GT2 ~ GT2-1 > 0 DO 02013260
BEGIN 02013265
READ(LIBRARY[FILEINX]); 02013270
MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275
END; 02013280
END; 02013285
RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROG.ID.; 02013290
IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295
BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300
TEMPLISTOG~LISTOG; LISTOG~FALSE; Q~ACCUM[1]; 02013303
FLAG(501); LISTOG~TEMPLISTOG; GO TO EXIT; 02013305
END; 02013310
WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013313
DO BEGIN 02013315
RESULT ~ 5; SCANNER; % %T0302013316
% %T0302013317
IF NOT NOPATCH THEN NOPATCH ~ EXAMIN(NCR) = "N"; % %T0302013318
END; 02013319
NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475
LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480
LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490
LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495
LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497
FINISHPT ~ GT2; 02013500
IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3].FILEINDEX) 02013505
|3,0] ~ RECOUNT -1; 02013510
RECOUNT~GT1; 02013515
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520
IF NOPATCH THEN SEQSUM ~ 0 ELSE % %T0302013522
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525
IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526
ELSE IF MAXLTLCR.[33:15]-NCR.[33:15]<11 THEN 02013527
GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528
LIBARRAY[LIBINDEX+2].NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530
IF LASTUSED{2 OR LASTUSED=5 THEN 02013533
LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534
LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535
IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536
LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537
LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538
END ELSE BEGIN 02013539
LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540
ELSE LASTUSED~5; 02013541
LIBINDEX ~ LIBINDEX + 3; 02013542
END 02013545
ELSE 02013550
BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555
LIBINDEX ~ LIBINDEX -3; 02013560
RECOUNT~RECOUNT-1; 02013563
LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565
IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567
DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568
DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570
IF LIBINDEX > 0 THEN 02013575
FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580
FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600
IF LIBINDEX ! 0 THEN 02013610
MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615
IF LASTUSED{2 OR LASTUSED=5 THEN NCR~MKABS(CARD(0)) ELSE 02013617
NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620
IF LASTUSED{2 OR LASTUSED=5 THEN LCR~MKABS(CARD(9)) ELSE 02013621
LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625
NORELEASE~TRUE; 02013627
IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628
END OF UNLINK; 02013630
IF LIBINDEX = 0 THEN 02013635
BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640
SEQSUM~0; 02013645
END 02013650
ELSE 02013655
BEGIN 02013660
GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665
GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670
GT3 ~(GT2 - GT1)DIV 5; 02013675
SPACE(LIBRARY[FILEINX],GT3); 02013680
02013681
02013682
READ(LIBRARY[FILEINX]); 02013685
02013690
02013693
02013695
MOVE(1,LIBRARY[FILEINX](0),GTI1); 02013697
IF GTI1!GT2 AND GTI1 ! 0 THEN 02013699
BEGIN COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 02013701
FLAG(507); GO TO EXIT; 02013702
END; 02013703
LTLCR~MKABS(LIBRARY[FILEINX](10))+(GTI1~(((RECOUNT-1) MOD 5) |11)); 02013705
MAXLTLCR~MKABS(LIBRARY[FILEINX](0))+54; 02013710
ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713
IF LASTUSED= 6 THEN BEGIN 02013714
NCR~LCR~MKABS(LIBRARY[FILEINX](0)); 02013715
ZOT(GT1, "%", LCR); 02013716
END; 02013717
END; 02013718
EXIT: END SEARCHLIB; 02013720
COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000
AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000
DEFINE WRITNEW(WRITNEW1,WRITNEW2)=WRITENEW(WRITNEW1,WRITNEW2,NEWTOG)%T1102015500
#; % %T1102015600
BOOLEAN STREAM PROCEDURE WRITENEW(NEW,FCR,N);VALUE FCR,N; % %T1102016000
BEGIN SI ~ FCR; IF SC ! "$" THEN TALLY ~ 1 ELSE BEGIN % %T0302017000
L: SI ~ SI + 1; IF SC = " " THEN GO TO L; % %T0302017100
IF SC = "I" THEN TALLY ~ 1 ELSE % %T0302017200
IF SC = "O" THEN TALLY ~ 1 ELSE % %T0302017300
IF SC = "S" THEN TALLY ~ 1 ELSE % %T0302017400
IF SC = "G" THEN TALLY ~ 1 ELSE % %T0302017500
IF SC = "P" THEN TALLY ~ 1 ELSE % %T0302017600
IF SC = "E" THEN TALLY ~ 1 ELSE % %T0302017700
% OTHER OPTIONS GO HERE %T0302017880
; SI ~ FCR; % %T0302017890
END; % %T0302017900
N(DI~NEW; DS~10WDS; SI~SI-8; %T1102018000
7(IF SC!"9" THEN JUMP OUT ELSE SI~SI+1); %T1102019000
IF SC="9"THEN TALLY~0);WRITENEW~TALLY; END; % WRITENEW%T1102020000
DEFINE PRINT(PRINT1,PRINT2,PRINT3,PRINT4) = % %T0302021000
PRINTLINE (ERRORCOUNT,BEGINCTR,LEVEL,LINENUMBER,L.[46:2],SGNO, % %T0302021500
PRINT1,PRINT2,PRINT4,L.[36:10])#; % %T0302022000
INTEGER LINENUMBER; BOOLEAN USELINO; % %T0302022500
STREAM PROCEDURE PRINTLINE (E,B,L,C,S,G, % %T0302023000
LINE,NCR,SYMBOL,R); % %T0302023500
VALUE E,B,L,C,S,G, % %T0302024000
NCR,SYMBOL,R ; % %T0302024500
BEGIN LOCAL Z; % %T0302025000
SI ~ LINE; DI ~ LINE; DS ~ 8 LIT " "; DS ~ 14 WDS; % %T0302025500
DI ~ LINE; SI ~ LOC E; % %T0302026000
DS ~ 4 DEC; Z ~ DI; DI ~ DI - 4; DS ~ 4 FILL; DI ~ Z; %%T0302026500
DS ~ 3 DEC; Z ~ DI; DI ~ DI - 3; DS ~ 3 FILL; DI ~ Z; %%T0302027000
DS ~ 3 DEC; Z ~ DI; DI ~ DI - 3; DS ~ 3 FILL; DI ~ Z; %%T0302027500
DI ~ DI + 5; % %T0302028000
DS ~ LIT "*";SI ~ NCR; DS ~ 9 WDS; DS ~ LIT "*"; DI ~ DI + 1; % %T0302028500
NCR ~ SI; SI ~ LOC C; % %T0302028700
DS ~ 5 DEC; Z ~ DI; DI ~ DI - 5; DS ~ 5 FILL; DI ~ Z; %%T0302028800
SI ~ NCR; DI ~ DI + 1; DS ~ WDS; % %T0302028900
DI ~ DI + 1; SI ~ LOC SYMBOL; SI ~ SI + 7; DS ~ CHR; % %T0302029000
DI ~ DI + 2; DS ~ 4 DEC; SI ~ LOC S; SI ~ SI + 7; % %T0302029500
DS ~ LIT ":"; DS ~ CHR; Z ~ DI; DI ~ DI - 6; DS ~ 6 FILL; DI ~ Z; %%T0302030000
DI ~ DI + 2; DS ~ 4 DEC; Z ~ DI; DI ~ DI - 4; DS ~ 4 FILL; DI ~ Z; %%T0302030100
END; % PRINTLINE %T0302030200
% %T0302030300
% %T0302030400
% %T0302031000
COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02032000
TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02033000
RESULT = 1 ELSE RESULT = 2; 02034000
REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02035000
BEGIN SI ~ TAPE; DI ~ CARD; 02036000
IF 8 SC } DC THEN 02037000
BEGIN SI ~ SI-8; DI ~ DI-8; TALLY ~ 1; 02038000
IF 8 SC = DC THEN TALLY ~ 2 END; 02039000
COMPARE ~ TALLY END COMPARE; 02040000
02041000
02042000
02043000
02044000
02045000
02046000
02047000
02047050
02047055
02047060
02047065
02047070
02047075
02048000
02049000
02050000
02051000
02052000
02053000
02054000
02055000
02055100
02055200
02055300
02056000
02057000
02058000
02059000
02060000
COMMENT EQUAL COMPARES COUNT CHARACTORS LOCATED AT A AND B FOR 02061000
EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02062000
QUANTITIES IN THE DIRECTORY; 02063000
BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02064000
BEGIN TALLY ~ 1; SI~A; DI~B; 02065000
IF COUNT SC = DC THEN EQUAL ~ TALLY END; 02066000
PROCEDURE READACARD; FORWARD; %WF 02067000
PROCEDURE SCANNER; %WF 02068000
BEGIN %WF 02069000
02070000
COMMENT SCAN IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING.02071000
IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED SCAN- 02072000
NER, WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A 02073000
CARD. SCAN IS CONTROLED BY A VARIABLE CALLED RESULT. 02074000
SCAN ALSO INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE 02075000
SAME VARIABLE. HENCE THE VARIABLE, RESULT, IS PASSED BY 02076000
BOTH NAME AND VALUE. 02077000
THE MEANING OF RESULT AS INPUT IS: 02078000
0: INITIAL CODE - DEBLANK AND START TO FETCH THE 02079000
NEXT QUANTITY. 02080000
1: CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02081000
END OF CARD BREAK). 02082000
2: LAST QUANTITY BUILT WAS SPECIAL CHARACTOR. HENCE 02083000
EXIT (INTERRUPTION BY END OF CARD BREAK IS NOT 02084000
IMPORTANT). 02085000
3: CONTINUE BUILDING A NUMBER (INTERRUPTED BY END OF 02086000
CARD BREAK). 02087000
4: LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE02088000
EXIT (INTERRUPTION BY END OF CARD BREAK NOT 02089000
IMPORTANT). 02090000
5: GET NEXT CHARACTOR AND EXIT. 02091000
6: SCAN A COMMENT. 02092000
7: DEBLANK ONLY. 02093000
THE MEANING OF RESULT AS OUTPUT IS: 02094000
1: AN IDENTIFIER WAS BUILT. 02095000
2: A SPECIAL CHARACTOR WAS OBTAINED. 02096000
3: A NUMBER (INTEGER) WAS BUILT. 02097000
SCAN PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02098000
BLANK ELIMINATED) INTO ACCUM (CALLED ACCUMULATOR FOR REST 02099000
OF THIS DISCUSSION). 02100000
COUNT IS THE VARIABLE THAT GIVES THE NUMBER OF CHARAC- 02101000
TORS SCAN HAS PUT IN THE ACCUMULATOR. SINCE SCAN NEEDS 02102000
THE VALUE SO THAT IT CAN PUT MORE CHARACTORS IN THE ACCUM-02103000
ULATOR AND NEEDS TO UPDATE COUNT FOR THE OUTSIDE WORLD, 02104000
COUNT IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 02105000
CONVENIENT TO HAVE 63-COUNT. THIS IS CALLED COMCOUNT. 02106000
NCR (NEXT CHARACTOR TO BE SCANNED) IS ALSO PASSED BY 02107000
NAME AND VALUE SO THAT IT MAY BE UPDATED. 02108000
ST1 AND ST2 ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02109000
PASSED TO SCAN IN ORDER TO OBTAIN THE MOST USEFULL STACK 02110000
ARRANGEMENT; 02111000
STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02112000
COUNT,ST2,NCRV,ST1); 02113000
VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02114000
BEGIN 02115000
LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR, 02116000
COMMENTS,COMMANTS; 02117000
DI ~ RESULT; DI ~ DI+7; 02118000
SI ~ NCRV; 02119000
COMMENT SETUP DI FOR A CHANGE IN RESULT AND SI FOR A LOOK AT BUFFER;02120000
CI ~ CI+RESULTV; COMMENT SWITCH ON VALUE OF RESULT; 02121000
GO TO DEBLANK; COMMENT 0 IS INITIAL CODE; 02122000
GO TO IDBLDR; COMMENT 1 IS ID CODE; 02123000
GO TO FINIS; COMMENT 2 IS SPECIAL CHARACTER CODE; 02124000
GO TO NUMBERS; COMMENT 3 IS NUMBER CODE; 02125000
GO TO FINIS; COMMENT 4 IS ERROR CODE; 02126000
GO TO GNC; COMMENT 5 IS GET NEXT CHARACTOR CODE; 02127000
GO TO COMMANTS; COMMENT 6 IS COMMENT CODE; 02128000
COMMENT 7 IS DEBLANK ONLY CODE; 02129000
IF SC=" " THEN 02130000
BEGIN K: SI~SI+1; 02131000
IF SC =" " THEN GO TO K 02132000
END; 02133000
GO TO FINIS; 02134000
DEBLANK: IF SC = " " THEN 02135000
BEGIN L: SI~SI+1; IF SC = " " THEN GO TO L END; 02136000
COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTOR; 02137000
NCRV ~ SI; 02138000
IF SC } "0" THEN GO TO NUMBERS; 02139000
IF SC = ALPHA THEN GO TO IDBLDR; 02140000
COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTOR (OR GNC); 02141000
GNC: DS ~ LIT "2"; 02142000
TALLY ~ 1; SI ~ SI +1; GO TO EXIT; 02143000
COMMANTS: IF SC ! ";" THEN BEGIN 02144000
COMMENTS: SI ~ SI+1; 02145000
IF SC > "%" THEN GO TO COMMENTS; 02146000
IF SC < ";" THEN GO TO COMMENTS; 02147000
COMMENT CHARACTORS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD 02148000
MODE PART OF COMMENT ROUTINE; 02149000
END; 02150000
GO TO FINIS; 02151000
IDBLDR: TALLY ~ 63; DS ~ LIT "1"; 02152000
COMCOUNT( TALLY~ TALLY+1; 02153000
IF SC = ALPHA THEN SI~SI+1 ELSE JUMP OUT TO EXIT); 02154000
TALLY ~ TALLY+1; IF SC = ALPHA THEN BEGIN 02155000
ERROR: DI~DI-1; DS ~ LIT "4"; GO TO EXIT; 02156000
END ELSE GO TO EXIT; 02157000
COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTORS 02158000
IN AN IDENTIFIER OR NUMBER; 02159000
NUMBERS: TALLY ~ 63; DS ~ LIT "3"; 02160000
COMCOUNT( TALLY~ TALLY+1; 02161000
IF SC <"0"THEN JUMP OUT TO EXIT; SI~SI+1); 02162000
GO TO ERROR; 02163000
EXIT: ST1 ~ TALLY; COMMENT ST1 CONTAINS NUMBER OF CHAR- 02164000
ACTORS WE ARE GOING TO MOVE INTO THE 02165000
ACCUMULATOR; 02166000
TALLY ~ TALLY+COUNTV; ST2 ~ TALLY; 02167000
DI ~ COUNT; SI ~ LOC ST2; DS ~ WDS; 02168000
COMMENT THIS CODE UPDATED COUNT; 02169000
DI ~ ACCUM; SI ~ SI-3; DS ~ 3 CHR; 02170000
COMMENT THIS CODE PLACES COUNT IN ACCUM AS WELL; 02171000
DI ~ DI+COUNTV; COMMENT POSITION DI PAST CHARACTORS 02172000
ALREADY IN THE ACCUMULATOR, IF ANY; 02173000
SI ~ NCRV; DS ~ ST1 CHR; 02174000
COMMENT MOVE CHARACTORS INTO ACCUM; 02175000
FINIS: DI ~ NCR; ST1 ~ SI; SI ~ LOC ST1; DS ~ WDS; 02176000
COMMENT RESET NCR TO LOCATION OF NEXT CHARACTOR TO BE SCANNED; 02177000
END OF SCAN; 02178000
LABEL L;% %WF 02178100
L: SCAN(NCR, COUNT, ACCUM[1], 63-COUNT, RESULT, %WF 02178200
RESULT, COUNT, 0, NCR, 0); %WF 02178300
IF NCR=LCR THEN %WF 02178400
BEGIN READACARD; %WF 02179000
IF LIBINDEX!0 THEN %WF 02179100
IF RECOUNT=FINISHPT THEN %WF 02179200
BEGIN SEARCHLIB(FALSE); %WF 02179300
READACARD; %WF 02179400
NORELEASE ~ FALSE; %WF 02180000
END; %WF 02180100
GO TO L; %WF 02180200
END; %WF 02180300
END SCANNER; %WF 02180400
PROCEDURE READACARD; 02181000
COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02182000
TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02183000
LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02184000
SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02185000
FCR,NCR,LCR,TLCR, AND CLCR; 02186000
BEGIN 02187000
PROCEDURE READTAPE(LCR,MAXLCR,LIB); 02188000
VALUE LIB; 02189000
BOOLEAN LIB; 02190000
REAL LCR, MAXLCR; 02191000
IF LIB THEN 02192000
BEGIN RECOUNT~RECOUNT+1; 02193000
IF LCR~LCR+11>MAXLCR THEN 02194000
BEGIN READ(LIBRARY[FILEINX]); 02195000
MAXLCR~46+LCR~MKABS(LIBRARY[FILEINX](0))+10; 02196000
END; 02196010
ADDER(SEQSUM,LCR,TRUE,TRUE); 02196015
END ELSE 02196030
BEGIN READ(TAPE); 02196040
MAXLCR~LCR~MKABS(TAPE(9)) 02196050
END READTAPE; 02196060
02196070
02196080
02196090
02196100
02196110
02196120
02196130
02196140
02196141
02196142
PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); 02196150
VALUE LIB; 02196160
BOOLEAN LIB; 02196170
REAL TLCR, CLCR ; 02196180
BEGIN 02196190
IF IF NOPATCH THEN TRUE ELSE GT1 ~ COMPARE (TLCR,CLCR) = 0 THEN % %T0302196200
BEGIN 02196210
LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02196220
END 02196230
ELSE BEGIN 02196240
IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02196250
BEGIN 02196260
IF EXAMIN(GT1:=CLCR-9) = "$" % %T0302196270
IMP (EXAMIN(GT1+65536)="E" OR GT1~EXAMIN(GT1+32768)="$" OR GT1="E")%T0302196272
THEN % %T0302196273
BEGIN 02196275
IF LIB THEN 02196280
BEGIN 02196290
IF FINISHPT-RECOUNT=1 THEN 02196300
LASTCRDPATCH:=TRUE 02196305
ELSE READTAPE(LTLCR,MAXLTLCR,TRUE) 02196310
END 02196320
ELSE READTAPE(TLCR,MAXTLCR,FALSE); 02196330
END 02196340
ELSE IF LIB THEN READTAPE(LTLCR,MAXTLCR,TRUE) 02196345
ELSE READTAPE(TLCR,MAXTLCR,FALSE) 02196350
END; 02196360
LCR:=CLCR; 02196370
LASTUSED:=IF LIB THEN 5 ELSE 2; 02196380
END; 02196390
END OF SEQCOMPARE; 02196400
LABEL CARDONLY, CARDLAST, TAPELAST, FIRSTIME, EXIT, 02197000
EOF, USETHESWITCH, %D02197100
COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02198000
SWITCH USESWITCH ~ CARDONLY,CARDLAST,TAPELAST,FIRSTIME, 02199000
LIBCLAST, LIBTLAST; 02199010
USETHESWITCH: %D02199900
GO TO USESWITCH[LASTUSED]; 02200000
MOVE(1,TEXT[LASTUSED.LINKR,LASTUSED.LINKC], 02201000
DEFINEARRAY[DEFINEINDEX-2]); 02202000
LASTUSED ~ LASTUSED + 1; 02203000
NCR ~ LCR-1; 02204000
GO TO XIT; 02205000
CARDONLY: IF NORELEASE THEN GO TO EXIT; READ(CARD); 02206000
FIRSTIME: LCR ~ MKABS(CARD(9)); 02207000
GO TO EXIT; 02208000
COMMENT THIS RELEASES CARD FROM READER AND SETS LCR; 02209000
CARDLAST: IF NORELEASE THEN GO TO EXIT; READ(CARD)[EOF]; 02210000
CLCR ~ MKABS(CARD(9)); 02211000
GO COMPAR; 02212000
EOF: DEFINEARRAY[25]~"ND;END."&"E"[1:43:5]; 02212100
DEFINEARRAY[34]~"9999"&"9999"[1:25:23]; 02212200
CLCR~MKABS(DEFINEARRAY[34]); 02212300
ZOT(DEFINEARRAY[33],"%",CLCR-8); 02212400
GO COMPAR; 02212700
COMMENT THIS RELEASES THE PREVIOUS CARD FROM CARD READER AND SETS 02213000
UP CLCR; 02214000
TAPELAST: READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02215000
COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02216000
LIBCLAST: IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; 02217000
GO TO COMPAR END; 02217100
READ(CARD)[EOF]; 02217200
CLCR ~ MKABS(CARD(9)); 02218000
IF LASTCRDPATCH THEN BEGIN 02218100
LASTCRDPATCH~FALSE; 02218200
RECOUNT~RECOUNT+1; 02218300
GO TO XIT END; 02218400
GO TO COMPAR; 02219000
LIBTLAST: 02220000
IF FIRSTIMEX THEN BEGIN FIRSTIMEX~FALSE; GO TO COMPAR END; 02220500
READTAPE(LTLCR,MAXLTLCR,TRUE); 02221000
IF RECOUNT=FINISHPT THEN GO TO XIT; 02221100
02222000
02223000
02224000
02225000
02226000
COMPAR: IF LASTUSED = 2 OR LASTUSED = 3 THEN 02227000
SEQCOMPARE(TLCR,CLCR,FALSE) 02228000
ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02229000
EXIT: NCR ~ FCR~ LCR - 9; 02229010
COMMENT SETS UP NCR AND FCR; 02230000
IF VOIDCR ! 0 THEN 02230010
BEGIN IF COMPARE(LCR,VOIDCR) = 0 THEN 02230020
BEGIN % %T0302230021
IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN BEGIN % %T0302230022
GO USETHESWITCH; % %T0302230030
END; % %T0302230032
END ELSE BEGIN 02230035
VOIDCR ~ VOIDPLACE ~ 0; 02230040
VOIDTAPE ~ FALSE; % %T0302230045
END; END; % %T0302230050
IF(IF SEQTOG THEN NONBLANK(FCR) ELSE TRUE) THEN 02230100
IF WRITNEW (L1N,FCR) THEN BEGIN % %T0302231000
IF NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); 02231050
IF SEQTOG THEN BEGIN IF TOTALNO = -10 OR NEWBASE THEN 02231100
BEGIN NEWBASE ~ FALSE; GTI1~ TOTALNO~BASENUM END ELSE 02231200
GTI1~ TOTALNO~ TOTALNO + ADDVALUE; 02231300
IF NEWTOG THEN CHANGESEQ(GTI1,MKABS(L1N[9])); % %T0302231350
CHANGESEQ(GTI1,LCR); END; 02231400
LINENUMBER ~ LINENUMBER + 1; % %T0302231450
IF LISTOG OR (IF CHECKTOG THEN GT1~ 02231500
COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR) = 1 02231600
ELSE FALSE) THEN 02232000
BEGIN PRINT(LIN,FCR,L.[36:10],IF LASTUSED=6 THEN FILEINX 02233000
+17 ELSE IF LASTUSED=3 THEN "T" ELSE IF LASTUSED02233100
=2 OR LASTUSED=5 THEN "R" ELSE 48); 02234000
IF CHECKTOG AND GT1 = 1 THEN BEGIN % %T0302235000
% %T0302235005
SEQERRORCOUNT ~ SEQERRORCOUNT + 1; % %T0302235010
SEQERR(LIN[14]); % %T0302235020
ERRORCOUNT ~ ERRORCOUNT + REAL(SEQERRORTOG); % %T0302235030
END; % %T0302235040
IF NOTPNTED THEN PERMLINE(NOHEADING); 02235100
WRITELINE; 02236000
END; 02237000
IF NEWTOG THEN 02238000
% %T0302239000
WRITE (NEWTAPE,10,L1N[*]); % %T0302240000
02241000
02242000
COMMENT WRITES NEW TAPE IF NECESSARY; 02243000
END; 02244000
ZOT(INFO[LASTSEQROW,LASTSEQUENCE],"%",LCR); 02245000
COMMENT PUTS % IN COLUMN 73 AND SEQUENCE NUMBER IN INFO; 02246000
IF USELINO THEN CARDNUMBER ~ LINENUMBER ELSE %T0302246050
CARDNUMBER ~ CONV(INFO[LASTSEQROW,LASTSEQUENCE-1], 5, 8); 02246100
IF BUILDLINE THEN 02246200
IF LASTADDRESS ! (LASTADDRESS ~ L) THEN 02246300
BEGIN ENILSPOT ~ L.[36:10] & CARDNUMBER[10:20:28]; 02246400
IF (ENILPTR ~ ENILPTR+1)}1023 THEN 02246500
BEGIN FLAG(80); ENILPTR ~ 512; END; 02246600
END; 02246700
XIT: END READACARD; 02247000
REAL PROCEDURE CONVERT; 02248000
BEGIN REAL T; INTEGER N; 02249000
TLO~0; THI~ 02250000
T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000
FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000
IF DPTOG THEN 02253000
BEGIN 02254000
DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,~, 02255000
THI,TLO); 02256000
T~THI; 02257000
END ELSE 02258000
T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000
CONVERT~T; 02260000
END; 02261000
%T0302261500
LABEL ENDOFITALL; % %T1402261600
REAL STREAM PROCEDURE FETCH(F); VALUE F; %WF 02262000
BEGIN SI~F; SI~SI-8; DI~LOC FETCH; DS~WDS; END FETCH; %WF 02263000
PROCEDURE DUMPINFO; 02264000
BEGIN 02264050
ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100
STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400
BEGIN 02264450
SI:=S; DI:=D; 02264500
N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550
DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600
END OF OCTALWORDS; 02264650
STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700
BEGIN 02264750
SI:=S; DI:=D; 02264800
N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850
END OF ALPHAWORDS; 02264900
IF NOTPNTED THEN PERMLINE(NOHEADING);WRITE(LINE[DBL],<//"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
COMMENT TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER 02277000
USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY. 02278000
THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED. 02279000
TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY 02280000
ELBAT. ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR 02281000
COMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD. NXTELBT02282000
IS ALMOST EXCLUSIVELY USED BY TABLE, ALTHOUGH AN OCCASION-02283000
AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS02284000
SCANNED. (SEE FOR EXAMPLE COMPOUNDTAIL). FOR FURTHER 02285000
GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES.02286000
THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY 02287000
DESIRED (USUALLY I-1,I, OR I+1). 02288000
THE GENERAL PLAN OF TABLE IS THIS: 02289000
I) IF P < NXTELBAT GO ON TO III). 02290000
II) PROCESS ONE QUANTITY. 02291000
A) SCAN. 02292000
B) TEST FOR IDENTIFIER, NUMBER, 3R SPECIAL CHARACTOR.02293000
1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS 02294000
IN SPECIAL MANNER IF COMMENT OR DEFINED ID. 02295000
2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART, 02296000
AND EXPONENT PART. 02297000
3) TEST IF SPECIAL CHARACTOR REQUIRES SPECIAL 02298000
PROCESSING - OTHERWISE GET ELBAT WORD FROM 02299000
SPECIAL. 02300000
C) LOAD ELBAT AND INCREMENT NXTELBT. 02301000
D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P. 02302000
E) GO BACK TO I). 02303000
III) RETURN WITH CLASS OF ELBAT[P]. 02304000
FURTHER DETAILS ARE GIVEN IN BODY OF TABLE; 02305000
INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 02306000
BEGIN 02307000
LABEL PERCENT,SPECIALCHAR,COMPLETE,COLON,DOT,ATSIGN,QUOTE, 02308000
STRNGXT, MOVEIT, 02308100
SCANAGAIN,FPART,EPART,IPART,IDENT,ROSE,COMPOST,DOLLAR,RTPAREN,ARGH, 02309000
CROSSHATCH,DBLDOLLAR,LESSTHAN; %W0302310000
SWITCH SPECIALSWITCH ~ PERCENT,DOLLAR,DOT,ATSIGN,COLON,QUOTE,RTPAREN, 02311000
CROSSHATCH,DBLDOLLAR,LESSTHAN; %W0302312000
SWITCH RESULTSWITCH~ IDENT, SPECIALCHAR,IPART; 02313000
WHILE P } NXTELBT 02314000
DO BEGIN 02315000
SCANAGAIN: COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02316000
GO TO RESULTSWITCH[RESULT]; 02317000
ARGH: Q ~ ACCUM[1]; FLAG(141); GO TO SCANAGAIN; 02318000
SPECIALCHAR: GT1 ~ (Q ~ ACCUM[1]).[18:6] - 2; %T9002319000
ENDTOG ~ (GT1 = 57 OR GT1 = 24) AND ENDTOG; %M02320000
COMMENT OBTAIN ACTUAL CHARACTOR FROM ACCUM; 02321000
T ~ SPECIAL[GT1&GT1[42:41:3]]; 02322000
COMMENT NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF 02323000
ELBAT WORDS FOR SPECIAL CHARACTORS; 02324000
IF GT1 ~ T.INCR = 0 THEN GO TO COMPLETE; 02325000
GO TO SPECIALSWITCH[GT1]; 02326000
COMMENT INCR FIELD OF SPECIAL CHARACTOR IS NON-ZERO FOR SPECIAL 02327000
CHARACTORS REQUIRING SPECIAL HANDELING. INCR IS SWITCHED 02328000
ON TO OBTAIN DISCRIMINATION; 02329000
COLON: RESULT ~ 7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02330000
FOR := IN PLACE OR ~ ; 02331000
IF NOT SYMQUOTE THEN %M02331500
IF EXAMIN (NCR) = "=" THEN BEGIN RESULT ~0; SCANNER; 02332000
T ~ SPECIAL[13] END; 02333000
RESULT ~ 2; GO TO COMPLETE; 02334000
LESSTHAN: IF REAL(STOPDEFINE) ! 0 THEN GO TO COMPLETE; % %W0302334100
RESULT~7; SCANNER; %W0302334105
COUNT ~ 0; RESULT ~ 3; SCANNER; %W0302334110
RESULT~7; SCANNER; %W0302334115
IF EXAMIN(NCR)!">" THEN BEGIN %W0302334120
IF COUNT=0 THEN BEGIN ACCUM[1]~"1<0000"; %W0302334130
GO TO COMPLETE END; %W0302334140
ELBAT[NXTELBT] ~ T; NXTELBT ~ NXTELBT+1; %W0302334150
GO TO IPART END; %W0302334160
IF REAL(STREAMTOG)=2 THEN OCTCON(FALSE,ACCUM[0]) ELSE %W0302334170
OCTCON(TRUE,C); T ~ 0&TRUTHV[2:41:7]&2[25:46:2]; %W0302334180
RESULT ~ 0; SCANNER; GO TO COMPLETE; %W0302334190
DOT: IF ENDTOG THEN BEGIN ENDTOG ~ FALSE; GO TO COMPLETE END; %M02335000
IF EXAMIN(NCR)>9 THEN BEGIN RESULT ~ 7; SCANNER; %M02335100
IF QUOTETOG THEN %A02335150
IF EXAMIN(NCR)!"[" THEN T ~ 0&DOTOP[2:41:7]; %M02335200
GO TO COMPLETE END; %M02335300
NHI~NLO~0; 02336000
C~0; FSAVE~0; GO TO FPART; 02337000
ATSIGN: IF QUOTETOG THEN BEGIN T ~ PERIOD; GO TO COMPLETE END; %A02338000
NHI ~ C ~ 1; NLO ~ FSAVE ~ 0; GO TO EPART; %A02338500
COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02339000
02340000
QUOTE: IF QUOTETOG THEN BEGIN T~0&QUOTEOP[2:41:7]; %M02341000
GO TO COMPLETE END; %M02341100
COUNT ~ 0; T ~ IF STREAMTOG THEN 63 ELSE IF STREAMTOG.[2:1] %M02341200
THEN 16 ELSE 7+REAL(STREAMTOG.[46:1]); 02342000
DO BEGIN 02343000
RESULT ~ 5; SCANNER; 02344000
IF COUNT=T THEN IF EXAMIN(NCR) ! """ 02345000
THEN GO TO ARGH; 02345100
END UNTIL EXAMIN(NCR) = """; 02346000
Q ~ ACCUM[1]; RESULT ~ 5; SCANNER; COUNT~COUNT-1; 02347000
IF COUNT<0 THEN COUNT~COUNT+64; 02347100
ACCUM[1] ~ Q; RESULT ~ 4; 02348000
STRNGXT: T~C~0; 02349000
IF COUNT < 8 THEN 02350000
MOVEIT: 02350100
MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT); 02351000
T.CLASS ~ STRNGCON; GO TO COMPLETE; 02352000
COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02353000
THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02354000
THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02355000
THE TWO CASES ARE PROCESSED DIFERENTLY. THE FIRST CASE 02356000
MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02357000
CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID.02358000
FOR A FULL DISCUSSION SEE DEFINEGEN; 02359000
CROSSHATCH: IF DEFINECTR!0 THEN GO TO COMPLETE; 02360000
IF SYMQUOTE THEN GO TO COMPLETE; %M02360500
% %M02361000
IF DEFINEINDEX=0 THEN IF PRINTOG OR SYMFORMAT THEN GO TO COMPLETE ELSE%M02362000
GO TO ARGH; %M02362500
ZOT(GT1,0,LCR); %M02362600
LCR ~ (GT1 ~ DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02363000
NCR ~ GT1 - LCR | 262144; % %T0302364000
GT2~0&(T~DEFINEARRAY[DEFINEINDEX~DEFINEINDEX-3]) 02365000
[33:18:15]; 02365100
LASTUSED~T.[33:15]; 02365200
IF GT2 ! 0 THEN 02365300
BEGIN 02365400
NEXTTEXT ~ (GT2 ~ TAKE(GT2)).DYNAM; 02365500
DEFSTACKHEAD ~ GT2.LINK; 02365600
END; 02365700
GO TO SCANAGAIN; 02366000
DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02367000
IF SYMQUOTE THEN GO TO COMPLETE; %M02367005
BEGIN LABEL SEGMENT; SEGMENT: % %T0302367010
COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; 02368000
IF Q ~ ACCUM[1] = "1X0000" THEN GO SEGMENT; % %T0302369000
IF Q = "4VOID0" THEN 02369100
BEGIN GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369200
%T0302369300
GO TO PERCENT %T0302369400
END; 02369500
IF Q="5VOIDT" THEN BEGIN 02369600
VOIDTAPE~TRUE; 02369700
GETVOID(VOIDPLACE,NCR,VOIDCR,LCR); 02369800
READACARD;GO SCANAGAIN END; 02369900
%T0302369950
%T0302369960
IF Q = "4TAPE0" THEN 02370000
BEGIN 02371000
LASTUSED ~ 2; COMMENT NEXT CARD READ IS FROM RDR; 02372000
IF MAXTLCR = 0 THEN 02373000
BEGIN INTEGER STREAM PROCEDURE FEJ(F,T); VALUE T; 02374000
BEGIN SI~F; DI~LOC T; DS~WDS; SI~T; SI~SI-16; 02375000
DI~LOC FEJ; DS~WDS END FEJ; 02376000
STREAM PROCEDURE FIX(F,T); VALUE T; 02377000
BEGIN SI~F; SI~SI-24; DI~LOC T; DS~WDS; DI~T; 02378000
DI~DI+47; SKIP 4 DB; DS~2 RESET; DI~DI+48; 02379000
DI~DI+48; DS~8 LIT "00#01+0#"; END FIX; 02379100
IF GT1~FEJ(TAPE,0)=10 THEN 02379200
BEGIN REWIND(TAPE); FIX(TAPE,0) END; 02379300
MAXTLCR~GT1+TLCR~9+MKABS(TAPE(0)); 02379400
LASTUSED~2; 02379500
END; END 02380000
ELSE IF Q="3POP00" THEN BEGIN % %T0302380205
LISTOG.[47:1] ~ OPTHOLD[ZOPT ~ ZOPT - 1]; %%T0302380210
PRTOG ~ OPTHOLD[ZOPT].[46:1]; % %T0302380215
CHECKTOG ~ OPTHOLD[ZOPT].[45:1]; % %T0302380220
NEWTOG ~ OPTHOLD[ZOPT].[44:1]; % %T0302380225
SEQTOG ~ OPTHOLD[ZOPT].[43:1]; % %T0302380230
BASENUM ~ BASHOLD[ZOPT]; % %T0302380235
TOTALNO ~ TOTHOLD[ZOPT]; % %T0302380240
NEWBASE ~ OPTHOLD[ZOPT].[42:1]; % %T0302380245
ADDVALUE ~ ADDHOLD[ZOPT]; % %T0302380250
DEBUGTOG ~ OPTHOLD[ZOPT].[41:1]; % %T0302380255
PUNCHTOG ~ OPTHOLD[ZOPT].[40:1]; % %T0302380260
SEQERRORTOG ~ OPTHOLD[ZOPT].[39:1]; % %T0302380265
LASTUSED ~ REAL( % %T0302380270
OPTHOLD[ZOPT].[18:15]); % %T0302380275
STREAMER ~ OPTHOLD[ZOPT].[38:1]; % %T0302380280
SINGLTOG ~ OPTHOLD[ZOPT].[37:1]; % %T0302380390
GO TO PERCENT; % %T0302380400
END ELSE % %T0302380405
IF Q="4PUSH0" THEN BEGIN % %T0302380410
OPTHOLD[ZOPT] ~ LISTOG; % %T0302380415
OPTHOLD[ZOPT].[46:1] ~ PRTOG; % %T0302380420
OPTHOLD[ZOPT].[45:1] ~ CHECKTOG; % %T0302380425
OPTHOLD[ZOPT].[44:1] ~ NEWTOG; % %T0302380430
OPTHOLD[ZOPT].[43:1] ~ SEQTOG; % %T0302380435
BASHOLD[ZOPT] ~ BASENUM; % %T0302380440
TOTHOLD[ZOPT] ~ TOTALNO; % %T0302380445
OPTHOLD[ZOPT].[42:1] ~ NEWBASE; % %T0302380450
ADDHOLD[ZOPT] ~ ADDVALUE; % %T0302380455
OPTHOLD[ZOPT].[41:1] ~ DEBUGTOG; % %T0302380460
OPTHOLD[ZOPT].[40:1] ~ PUNCHTOG; % %T0302380465
OPTHOLD[ZOPT].[39:1] ~ SEQERRORTOG; % %T0302380470
OPTHOLD[ZOPT].[18:15] ~ BOOLEAN(LASTUSED); % %T0302380475
OPTHOLD[ZOPT].[38:1] ~ STREAMER; % %T0302380480
OPTHOLD[ZOPT].[37:1] ~ SINGLTOG; % %T0302380590
ZOPT ~ ZOPT + 1; % %T0302380600
GO TO PERCENT; % %T0302380605
END ELSE % %T0302380610
IF Q="5ENTER" THEN BEGIN % %T0302380620
GT1 ~ 5; % %T0302380630
GO TO DBLDOLLAR; % %T0302380640
END ELSE % %T0302380650
IF Q="1$0000" THEN BEGIN % %T0302380660
GT1 ~ 1; % %T0302380670
GO TO DBLDOLLAR; % %T0302380680
END % %T0302380690
ELSE BEGIN IF Q! "4CARD0" THEN GO TO PERCENT; 02381000
IF LASTUSED } 5 THEN ELSE LASTUSED ~1 END; 02382000
CHECKTOG~FALSE; 02382100
LISTOG.[47:1]~FALSE; 02382200
PRTOG~NEWTOG~DEBUGTOG~PUNCHTOG~FALSE; 02383000
SEQERRORTOG ~ FALSE ; % %T0302383010
% %T1102383100
DO BEGIN 02384000
COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; Q ~ ACCUM[1];02385000
IF Q = "1%0000" THEN GO TO PERCENT ELSE 02385100
IF Q = "4XREF0" THEN XREF := %HCG190 02385200
XREF OR BUILDLINE.[45:1] ELSE %HCG190 02385201
IF Q = "6SEQXE" THEN % 02385400
BUILDLINE.[47:1] ~ TRUE ELSE %HCG190 02385600
IF Q = "4LIST0" THEN LISTOG.[47:1]~TRUE ELSE 02386000
IF Q = "6SINGL" OR Q = "3SGL00" THEN 02386100
%T9302386105
LISTOG.[47:1]:=SINGLTOG:=TRUE ELSE 02386110
IF Q = "6DOUBL" OR Q = "3DBL00" THEN SINGLTOG := FALSE ELSE %T9302386115
02386120
02386130
02386140
02386150
02386160
02386170
02386180
02386190
02386200
02386210
IF Q = "3PRT00" THEN PRTOG:=TRUE ELSE 02387000
IF Q= "5CHECK" THEN CHECKTOG~TRUE ELSE 02387100
IF Q = "4INFO0" THEN DUMPINFO ELSE 02387200
IF Q.[18:18]="NEW" THEN NEWTOG~TRUE ELSE %T1102388000
IF Q = "5NOSEQ" THEN SEQTOG~FALSE ELSE 02388100
IF Q = "3SEQ00" THEN SEQTOG~ TRUE ELSE 02388200
IF RESULT = 3 THEN BEGIN 02388300
BASENUM~ CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388400
TOTALNO~-10; 02388450
NEWBASE ~ TRUE 02388500
END ELSE 02388600
IF RESULT = 2 THEN BEGIN 02388700
IF ACCUM[1]= "1+0000" THEN 02388800
BEGIN RESULT~ COUNT~ ACCUM[1]~0; 02388900
SCANNER; IF RESULT = 3 THEN 02388910
ADDVALUE~CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02388920
END END ELSE 02388930
IF Q = "6DEBUG" OR Q = "7IDEBU" THEN %T9002389000
BEGIN LISTOG.[47:1] := PRTOG := TRUE; %T9302390000
IF Q="6DEBUG" THEN DEBUGTOG~TRUE ELSE %T9002390050
INTDEBUGTOG ~ TRUE; %T9002390080
FILL WOP[*] WITH 02391000
"LITC"," ", 02392000
"OPDC","DESC", 02393000
10,"DEL ", 11,"NOP ", 12,"XRT ", 16,"ADD ", 17,"AD2 ", 18,"PRL ", 02394000
19,"LNG ", 21,"GEQ ", 22,"BBC ", 24,"INX ", 35,"LOR ", 37,"GTR ", 02395000
38,"BFC ", 39,"RTN ", 40,"COC ", 48,"SUB ", 49,"SB2 ", 64,"MUL ", 02396000
65,"ML2 ", 67,"LND ", 68,"STD ", 69,"NEQ ", 71,"XIT ", 72,"MKS ", 02397000
128,"DIV ",129,"DV2 ",130,"COM ",131,"LQV ",132,"SND ",133,"XCH ", 02398000
134,"CHS ",167,"RTS ",168,"CDC ",197,"FTC ",260,"LOD ",261,"DUP ", 02399000
278,"LBC ",280,"SSF ",294,"LFC ",322,"ZP1 ",384,"IDV ",453,"FTF ", 02400000
515,"MDS ",532,"ISD ",533,"LEQ ",534,"BBW ",548,"ISN ",549,"LSS ", 02401000
550,"BFW ",581,"EQL ",582,"SSP ",584,"ECM ",709,"CTC ",790,"LBU ", 02401100
806,"LFU ",896,"RDV ",965,"CTF ", 02401200
1023,1023,1023,1023,1023,1023,1023,1023,1023,1023,1023, 1023; 02402000
FILL COP[*] WITH % CHARACTER MODE MNEMONICS 02403000
"EXC ","NOP ","BSD ","BSS ","RDA ","TRW ","SED ","TDA ", 02404000
" "," ","TBN "," ","SDA ","SSA ","SFD ","SRD ", 02405000
" "," ","SES "," ","TEQ ","TNE ","TEG ","TGR ", 02406000
"SRS ","SFS "," "," ","TEL ","TLS ","TAN ","BIT ", 02407000
"INC ","STC ","SEC ","CRF ","JNC ","JFC ","JNS ","JFW ", 02408000
"RCA ","ENS ","BNS ","RSA ","SCA ","JRC ","TSA ","JRV ", 02409000
"CEQ ","CNE ","CEG ","CGR ","BIS ","BIR ","OCV ","ICV ", 02410000
"CEL ","CLS ","FSU ","FAD ","TRP ","TRN ","TRZ ","TRS "; 02411000
02412000
FILL POP[*] WITH 02412100
"ZFN ","ZBN ","ZFD ","ZBD ","ISO ",0,"DIA ","DIB ","TRB ","CFL ","CFE "02412200
; 02412300
END ELSE 02413000
IF Q = "5PUNCH" THEN PUNCHTOG ~ TRUE ELSE 02414000
IF Q = "5ERROR" THEN SEQERRORTOG ~ TRUE ELSE % STXERR FOR SEQERR %T0302414100
IF Q = "7LIBLI" THEN LISTOG.[47:1] ~ LISTOG.[18:15] ELSE % %T0302414200
% %T0302414600
IF Q="6UNSAF" THEN STREAMER ~% %T0302414700
(LASTUSED}5 AND FILEINX=NOTAPES-1) ELSE % %T0302414800
IF Q="7LISTL" THEN LISTOG.[18:15] ~ TRUE ELSE % %T0302414850
IF Q="4SAFE0" THEN STREAMER ~ FALSE ELSE % %T0302414900
IF Q="6ERROR" THEN BEGIN % %T9802414910
COUNT ~ RESULT ~ ACCUM[1] ~ 0; SCANNER; % %T9802414920
IF RESULT ! 3 THEN GO PERCENT; % %T9802414930
ERRORMAX ~ CONV(ACCUM[1],0,ACCUM[1].[12:6]); % %T9802414940
IF ERRORMAX < ERRORCOUNT THEN GO ENDOFITALL; % %T9802414945
END ELSE % %T9802414950
END UNTIL FALSE; 02415000
END; % %T0302415900
PERCENT: IF SYMQUOTE THEN IF NCR.[33:15] ! LCR.[33:15] THEN %T9202416000
GO TO COMPLETE; %T9202416100
IF NCR ! FCR THEN READACARD; %T9202416150
IF LIBINDEX!0 THEN 02416200
IF RECOUNT=FINISHPT THEN 02416400
BEGIN SEARCHLIB(FALSE); READACARD; NORELEASE~FALSE END; 02416600
GO TO SCANAGAIN; 02417000
COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02418000
PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02419000
SIDE AFFECT IS THAT ALL CHARACTORS ON A CARD ARE IGNORED 02420000
AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR02421000
COMMENT; 02422000
COMMENT MIGHT BE FUNNY COMMA - HANDEL HERE; 02423000
RTPAREN: RESULT ~ 7; SCANNER; 02424000
IF SYMQUOTE THEN GO TO COMPLETE; %M02424500
IF EXAMIN(NCR) = """ 02425000
THEN BEGIN 02426000
RESULT ~ 0; SCANNER; 02427000
DO BEGIN RESULT ~ 5; SCANNER END UNTIL EXAMIN(NCR) 02428000
= """; 02429000
RESULT ~ 0; SCANNER; 02430000
RESULT ~ 7; SCANNER; 02431000
IF EXAMIN(NCR) ! "(" THEN 02432000
GO TO ARGH; 02433000
RESULT ~ 0; SCANNER; Q ~ ACCUM[1]; 02434000
T ~ SPECIAL[24] 02435000
END; 02436000
RESULT ~ 2; GO TO COMPLETE; 02437000
IPART: TCOUNT~0; 02438000
FSAVE~0; 02438500
C~CONVERT; 02439000
IF DPTOG THEN BEGIN NHI~THI; NLO~TLO; END; 02440000
IF EXAMIN(NCR)="." THEN 02441000
BEGIN RESULT~0; 02442000
SCANNER; 02443000
C ~ 1.0| C; 02444000
FPART: TCOUNT~COUNT; 02445000
IF EXAMIN(NCR){9 THEN 02446000
BEGIN RESULT~0; 02447000
SCANNER; 02448000
IF DPTOG THEN 02449000
BEGIN 02450000
DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02451000
0,/,~,THI,TLO); 02452000
FOR T~12 STEP 12 UNTIL COUNT - TCOUNT DO 02453000
DOUBLE(THI,TLO,TEN[12],0,/,~,THI,TLO); 02454000
DOUBLE(THI,TLO,NHI,NLO,+,~,NHI,NLO); 02455000
C~NHI END ELSE 02456000
C~CONVERT+C|TEN[FSAVE~COUNT-TCOUNT]; 02457000
END 02458000
END; 02459000
RESULT ~7; SCANNER; 02460000
IF EXAMIN(NCR)="@" THEN 02461000
BEGIN RESULT~0; 02462000
SCANNER; 02463000
EPART: TCOUNT~COUNT; 02464000
C~C|1.0; 02465000
RESULT ~7; SCANNER; 02466000
IF T~EXAMIN(NCR)>9 THEN 02467000
IF T="-" OR T = "+" THEN 02467100
BEGIN RESULT~0; 02468000
SCANNER; 02469000
TCOUNT~COUNT; 02470000
END ELSE FLAG(47); RESULT ~ 0; 02471000
SCANNER; 02472000
IF RESULT ! 3 THEN FLAG (47);COMMENT NOT A NUMBER; 02472100
Q~ACCUM[1]; 02473000
IF GT1~T~(IF T="-"THEN -CONVERT ELSE CONVERT)<-46 OR T>69 02474000
THEN 02475000
FLAG(269) 02476000
ELSE BEGIN T~TEN[ABS(GT3~T-FSAVE)]; 02477000
IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]&GT3[1:1:1] + 12) 02478000
>63 THEN 02479000
FLAG(269) ELSE 02480000
IF DPTOG THEN 02481000
IF GT1<0 THEN 02482000
BEGIN 02483000
GT1~-GT1; 02484000
DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,~,NHI,NLO); 02485000
FOR GT2~12 STEP 12 UNTIL GT1 DO 02486000
DOUBLE(NHI,NLO,TEN[12],0,/,~,NHI,NLO); 02487000
END ELSE 02488000
BEGIN 02489000
DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,~,NHI,NLO); 02490000
FOR GT2~12 STEP 12 UNTIL GT1 DO 02491000
DOUBLE( NHI,NLO,TEN[12],0,|,~,NHI,NLO); 02492000
END ELSE C~IF GT3<0 THEN C/T ELSE C|T; 02493000
END; 02494000
END ELSE IF FSAVE ! 0 THEN C~C/TEN[FSAVE]; 02495000
Q ~ ACCUM[1]; RESULT ~ 3; 02496000
T~0; 02497000
IF REAL(BOOLEAN(C)AND NOT BOOLEAN(1023))=0 THEN 02498000
BEGIN T.CLASS~LITNO ; T.ADDRESS~C.[38:10] END 02499000
ELSE T.CLASS~NONLITNO ; 02500000
GO TO COMPLETE; 02501000
COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02502000
IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02503000
ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02504000
TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK, %WF 02505000
TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR %WF 02505100
COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO %WF 02505200
COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND %WF 02506000
ROSE IS ENTERED. THE LAST THING DONE FOR ANY %WF 02506100
IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION %WF 02506200
OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS %WF 02507000
ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, %WF 02507100
SHOULD THIS BE REQUIRED. ; %WF 02507200
IDENT: IF T ~ SUPERSTACK[SCRAM ~ (Q ~ ACCUM[1]) MOD 125]!0 02508000
THEN BEGIN %WF 02508100
IF INFO[GT1 ~ T.LINKR,(GT2 ~ T.LINKC)+1]=Q %WF 02508200
THEN BEGIN %WF 02508300
T ~ INFO[GT1,GT2]&T[35:35:13]; %WF 02508400
GO TO COMPLETE %WF 02508500
END %WF 02508600
END; %WF 02508700
IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN 02508730
T ~ DEFSTACKHEAD ELSE 02508770
T ~ STACKHEAD[SCRAM]; %WF 02508800
ROSE : GT1 ~ T.LINKR; 02509000
IF(GT2 ~ T.LINKC)+GT1= 0 THEN 02510000
BEGIN T ~ 0; IF COUNT { 13 AND COUNT } 3 AND NOT %M02511000
SYMQUOTE THEN CHAINFORM(ACCUM[1],T); GO TO COMPLETE END; %M02511500
T ~ INFO[GT1,GT2]; 02512000
IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO TO ROSE; 02513000
IF COUNT { 5 THEN GO TO COMPOST ; 02514000
IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2]) 02515000
THEN GO TO ROSE; 02516000
COMPOST: T ~ T&GT1[35:43:5]&GT2[40:40:8]; 02517000
IF XREF THEN %DFB02517100
IF GT1 !1 THEN 02517150
IF GT1!1 OR GT2}LASTSEQUENCE THEN 02517170
BEGIN %DFB02517200
IF XREFPT=30 THEN %DFB02517300
BEGIN %DFB02517400
WRITE(DSK2,30,XREFAY2[*]); %DFB02517500
XREFPT:=0; %DFB02517600
END; %DFB02517700
XREFAY2[XREFPT]:=CARDNUMBER&XREFINFO[GT1,GT2] %DFB02517800
[10:37:11]; %DFB02517820
XREFPT:=XREFPT+1; %DFB02517840
END; %DFB02517860
COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02518000
IF SYMQUOTE THEN GO TO COMPLETE; %M02518500
IF NOT ENDTOG THEN BEGIN 02519000
IF GT1 ~ T.CLASS = COMMENTV THEN BEGIN 02520000
WHILE EXAMIN(NCR) ! ";" DO 02521000
BEGIN RESULT ~ 6; COUNT ~ 0; SCANNER END; 02522000
RESULT~0;SCANNER;GO TO SCANAGAIN END END; 02523000
IF STOPDEFINE THEN GO TO COMPLETE; 02524000
IF GT1 ! DEFINEDID THEN GO TO COMPLETE; 02525000
COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02526000
IF BOOLEAN(T.MON) THEN % THIS IS A PARAMETRIC DEFINE 02526500
GT1 ~ GIT(T ~ FIXDEFINEINFO(T)) ELSE GT1 ~ 0; 02526600
IF DEFINEINDEX = 24 THEN BEGIN FLAG(139);GO TO ARGH END; 02527000
DEFINEARRAY[DEFINEINDEX] ~ LASTUSED & GT1[18:33:15]; 02528000
LASTUSED ~ T.DYNAM; 02529000
DEFINEARRAY[DEFINEINDEX+2] ~ 262144|LCR+NCR; 02530000
LCR ~ (NCR ~ MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02531000
ZOT(GT4,"%",LCR); DEFINEINDEX ~ DEFINEINDEX+3; 02532000
GO TO PERCENT; 02533000
DBLDOLLAR: CARDCALL ~ LASTUSED = 5; % %T0302533010
SEARCHLIB(BOOLEAN(GT1)); GO SCANAGAIN; % %T0302533500
COMPLETE: ELBAT[NXTELBT] ~ T; 02534000
STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINES AGAIN; 02535000
IF NXTELBT ~ NXTELBT+1 > 74 02536000
THEN IF NOT MACROID 02536500
THEN BEGIN 02537000
COMMENT ELBAT IS FULL: ADJUST IT; 02538000
MOVE(11,ELBAT[65],ELBAT); %W0302539000
I~ I-65; 02540000
P~ P-65; 02541000
NXTELBT ~ NXTELBT-65 END END; %W0302542000
IF TABLE ~ ELBAT[P].CLASS = COMMENTV 02543000
THEN IF NOT SYMQUOTE %A02543500
THEN BEGIN 02544000
COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02545000
C ~ INFO[0,ELBAT[P].ADDRESS]; 02546000
ELBAT[P].CLASS ~ TABLE ~ NONLITNO END; 02547000
STOPDEFINE ~ FALSE; COMMENT ALLOW DEFINE; 02547500
END TABLE ; 02548000
COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02549000
IT USED THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02550000
PLACES EITHER A CHARACTOR OR A CONVERTED NUMBER WITH A 02551000
NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESS BLANKS; 02552000
PROCEDURE NEXTENT; 02553000
BEGIN LABEL DEBLANK; 02554000
COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02555000
DEBLANK: 02556000
IF EXAMIN(NCR)=" " THEN 02557000
BEGIN 02558000
RESULT:=7; SCANNER; 02559000
END; 02560000
IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02561000
BEGIN 02562000
RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02563000
IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02564000
ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02565000
END 02566000
ELSE IF EXAMIN(NCR)="%" THEN 02567000
BEGIN 02568000
READACARD; GO DEBLANK; 02569000
END 02570000
ELSE BEGIN 02571000
RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02572000
Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02573000
END 02574000
END OF NEXTENT; 02575000
%T0302579000
COMMENT THIS SECTION CONTAINS FORWARD DECLARATIONS; 03000000
PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; FORWARD; %T9203000002
PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; FORWARD; 03000005
PROCEDURE EMITC(REPEAT,OPERATOR); VALUE OPERATOR,REPEAT; %T9203000010
INTEGER REPEAT,OPERATOR; FORWARD; %T9203000015
PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; FORWARD; %T9203000020
PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; FORWARD; %T9203000025
PROCEDURE EMITPAIR(ADDRESS,OPERATOR); VALUE ADDRESS,OPERATOR; %T9203000030
INTEGER ADDRESS,OPERATOR; FORWARD; %T9203000035
PROCEDURE EMITUP; FORWARD; %T9203000040
PROCEDURE EMITLNG; FORWARD; %T9203000045
PROCEDURE EMITWORD(WORD); VALUE WORD; REAL WORD; FORWARD; %T9203000050
PROCEDURE %T9203000058
EMITDIAL(A,B); VALUE A,B; INTEGER A,B; %T9203000060
FORWARD; %T9203000062
PROCEDURE %T9203000064
EMITFC(A,B); VALUE A,B; INTEGER A,B; %T9203000066
FORWARD; %T9203000068
PROCEDURE %T9203000070
EMITFB(TYPE,LENGTH,FROM,TOWARDS); %T9203000072
VALUE TYPE,LENGTH,FROM,TOWARDS; %T9203000074
INTEGER TYPE,LENGTH,FROM,TOWARDS; %T9203000076
FORWARD; %T9203000078
PROCEDURE AEXP; FORWARD; 03001000
PROCEDURE ARITHSEC; FORWARD; 03002000
PROCEDURE SIMPARITH; FORWARD; 03003000
PROCEDURE ARITHCOMP; FORWARD; 03004000
PROCEDURE PRIMARY; FORWARD; 03005000
PROCEDURE BEXP; FORWARD; 03006000
INTEGER PROCEDURE EXPRSS; FORWARD; 03007000
INTEGER PROCEDURE BOOSEC; FORWARD; 03008000
PROCEDURE SIMPBOO; FORWARD; 03009000
PROCEDURE BOOCOMP; FORWARD; 03010000
INTEGER PROCEDURE BOOPRIM; FORWARD; 03011000
PROCEDURE RELATION; FORWARD; 03012000
INTEGER PROCEDURE IFEXP; FORWARD; 03013000
PROCEDURE PARSE; FORWARD; 03014000
PROCEDURE DOTIT; FORWARD; %D03015000
PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; FORWARD; 03016000
PROCEDURE DEXP; FORWARD; 03017000
PROCEDURE IFCLAUSE; FORWARD; 03018000
INTEGER PROCEDURE GET(SYLLABLE);VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03019000
INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; FORWARD; 03020000
PROCEDURE PANA; FORWARD; 03021000
PROCEDURE IFSTMT; FORWARD; 03022000
PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 03023000
VALUE LABELBAT,BRANCHTYPE; 03024000
REAL LABELBAT,BRANCHTYPE; FORWARD; 03025000
BOOLEAN PROCEDURE SIMPGO; FORWARD; 03026000
PROCEDURE STMT; FORWARD; 03027000
PROCEDURE EMIT(SYLLABLE); VALUE SYLLABLE; REAL SYLLABLE; FORWARD; 03028000
PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; 03029000
PROCEDURE STRMPROCSTMT; FORWARD; 03030000
BOOLEAN PROCEDURE GETINT; FORWARD; 03031000
INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); VALUE NUMBER; 03032000
INTEGER P1,P2,NUMBER; FORWARD; 03033000
PROCEDURE CONSTANTCLEAN; FORWARD; 03034000
PROCEDURE SCATTERELBAT; FORWARD; 03035000
PROCEDURE EMITB(BRANCH,FROM,TOWARDS); VALUE BRANCH,FROM,TOWARDS; 03036000
INTEGER BRANCH,FROM,TOWARDS; FORWARD; 03037000
PROCEDURE VARIABLE(FROM); REAL FROM; FORWARD; 03038000
PROCEDURE IMPFUN; FORWARD; 03039000
PROCEDURE STREAMSTMT; FORWARD; 03040000
PROCEDURE SEGMENTSTART;FORWARD; 03041000
PROCEDURE SEGMENT(SIZE,NO,NOO); 03042000
VALUE SIZE,NO,NOO; 03043000
REAL SIZE,NO,NOO; 03044000
FORWARD; 03045000
INTEGER PROCEDURE BAE; FORWARD; 03046000
REAL PROCEDURE PROGDESCBLDR(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 03047000
PROCEDURE BANA; FORWARD; 03048000
PROCEDURE EMITNUM(A); VALUE A; REAL A; FORWARD; 03049000
PROCEDURE EMITD(A,B,T); VALUE A,B,T; INTEGER A,B,T; FORWARD; 03050000
INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L; 03051000
INTEGER L; BOOLEAN S; FORWARD; 03051001
PROCEDURE FORSTMT; FORWARD; 03052000
03053000
PROCEDURE E; FORWARD; 03054000
PROCEDURE ENTRY(TYPE); VALUE TYPE;REAL TYPE; FORWARD; 03055000
PROCEDURE FORMATGEN;FORWARD; 03056000
BOOLEAN PROCEDURE EXPLICITFORMAT; FORWARD; %W4003056500
BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; %W4003056600
PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000
PROCEDURE JUMPCHKNX; FORWARD; 03058000
PROCEDURE JUMPCHKX; FORWARD; 03059000
PROCEDURE DBLSTMT; FORWARD; 03060000
PROCEDURE READSTMT; FORWARD; 03061000
INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N; FORWARD ; 03061010
PROCEDURE WRITESTMT; FORWARD; 03062000
PROCEDURE SPACESTMT; FORWARD; 03063000
PROCEDURE CLOSESTMT; FORWARD; 03064000
PROCEDURE LOCKSTMT; FORWARD; 03065000
PROCEDURE RWNDSTMT; FORWARD; 03066000
PROCEDURE BLOCK(S); VALUE S; BOOLEAN S; FORWARD; 03067000
PROCEDURE PURGE(STOPPER);VALUE STOPPER;REAL STOPPER;FORWARD; 03068000
PROCEDURE ENTER(TYPEV); 03069000
VALUE TYPEV; 03070000
INTEGER TYPEV; FORWARD; 03071000
INTEGER PROCEDURE PASSTYPE(P); VALUE P; REAL P; FORWARD; 03074000
PROCEDURE PASSALPHA(P); VALUE P; REAL P; FORWARD; 03075000
PROCEDURE LISTELEMENT; FORWARD; 03076000
REAL PROCEDURE LISTGEN; FORWARD; 03077000
PROCEDURE UNKNOWNSTMT; FORWARD; 03078000
PROCEDURE FAULTSTMT; FORWARD; 03079000
PROCEDURE FAULTDEC; FORWARD; 03080000
PROCEDURE SORTSTMT; FORWARD; 03081000
PROCEDURE MERGESTMT; FORWARD; 03082000
PROCEDURE CASESTMT(R); VALUE R; REAL R; FORWARD; %M03083000
PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000
ALPHA PROCEDURE BUGGER(S); VALUE S; INTEGER S; FORWARD; 03100000
% %A03200000
% %A03201000
% %A03202000
PROCEDURE GENLIST; FORWARD; %A03203000
PROCEDURE SYMINT; FORWARD; %A03204000
PROCEDURE CONSIT; FORWARD; %A03205000
PROCEDURE PANSYM(MARK,TWOARG); VALUE MARK,TWOARG; BOOLEAN %A03206000
MARK,TWOARG; FORWARD; %A03207000
REAL PROCEDURE SYMPRIM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03208000
REAL PROCEDURE SEXP; FORWARD; %A03209000
PROCEDURE SYMVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03210000
REAL PROCEDURE MKCHAIN(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03211000
REAL PROCEDURE GENQUOTE(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03212000
REAL PROCEDURE MKNUM(R); VALUE R; REAL R; FORWARD; %A03213000
REAL PROCEDURE RSEXP; FORWARD; %A03214000
REAL PROCEDURE PORV; FORWARD; %A03215000
REAL PROCEDURE SNORM(R); VALUE R; REAL R; FORWARD; %A03216000
PROCEDURE SDNORM(R); VALUE R; REAL R; FORWARD; %A03217000
PROCEDURE FIELDC(EL,PR,FROM); VALUE EL,PR,FROM; REAL EL,PR; %A03218000
BOOLEAN FROM; FORWARD; %A03219000
PROCEDURE RECOM(R); VALUE R; REAL R; FORWARD; %A03220000
PROCEDURE GENRECORD(R,B); VALUE R,B; REAL R; BOOLEAN B; FORWARD; %A03222000
PROCEDURE RECVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03223000
PROCEDURE REXP; FORWARD; %A03224000
REAL PROCEDURE PLXPRIM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03225000
PROCEDURE PLXNORM(R,BV); %A03226000
VALUE R,BV; %A03227000
REAL R; %A03228000
BOOLEAN BV; FORWARD; %A03229000
REAL PROCEDURE PLXINT(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03230000
REAL PROCEDURE PANPLX(V,A); VALUE V,A; BOOLEAN V,A; FORWARD; %A03231000
INTEGER PROCEDURE PLXSEC(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03232000
INTEGER PROCEDURE PLXP(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03233000
PROCEDURE DBLPLXP(TYPE); VALUE TYPE; REAL TYPE; FORWARD; %A03234000
PROCEDURE PLXPN(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03235000
PROCEDURE PANDBL(V); VALUE V; BOOLEAN V; FORWARD; %A03236000
PROCEDURE EMITCONVAL; FORWARD; %A03237000
PROCEDURE IFXP(R); VALUE R; REAL R; FORWARD; %A03238000
PROCEDURE GENEXP(R); VALUE R; REAL R; FORWARD; %A03239000
BOOLEAN PROCEDURE ARAY(TALL,WDS,ROWTOG); %A03240000
VALUE TALL,WDS,ROWTOG; %A03241000
REAL TALL,WDS; BOOLEAN ROWTOG; FORWARD; %A03242000
REAL PROCEDURE GNATI(R); VALUE R; REAL R; FORWARD; %A03243000
REAL PROCEDURE GNATA(R); VALUE R; REAL R; FORWARD; %A03244000
REAL PROCEDURE TEMP(R); VALUE R; REAL R; FORWARD; %A03245000
REAL PROCEDURE GNATP(K); VALUE K; REAL K; FORWARD; %A03246000
REAL PROCEDURE GNATR(T); VALUE T; REAL T; FORWARD; %A03247000
PROCEDURE DBLPLXVAR(FROM); VALUE FROM; BOOLEAN FROM; FORWARD; %A03248000
PROCEDURE DBLPRIM; FORWARD; %A03249000
PROCEDURE DBLSEC; FORWARD; %A03250000
PROCEDURE DBLINT; FORWARD; %A03251000
PROCEDURE DBLXP; FORWARD; %A03252000
BOOLEAN PROCEDURE RECRELATION(TYPE); VALUE TYPE; REAL TYPE; %A03253000
FORWARD; %A03254000
BOOLEAN PROCEDURE DBLRELATION; FORWARD; %A03255000
BOOLEAN PROCEDURE PLXRELATION; FORWARD; %A03256000
BOOLEAN PROCEDURE DBLPLXRELATION; FORWARD; %A03257000
BOOLEAN PROCEDURE SYMRELATION(TYPE); VALUE TYPE; REAL TYPE;FORWARD; %A03258000
PROCEDURE BOOINT; FORWARD; %A03259000
PROCEDURE NVALINT; FORWARD; %A03260000
PROCEDURE STRINGSEC(FROM); VALUE FROM; REAL FROM; FORWARD; %A03261000
PROCEDURE STRINGVAR(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03262000
PROCEDURE STRINGXP(DSV,NLP); VALUE DSV,NLP; %A03263000
BOOLEAN NLP; REAL DSV; FORWARD; %A03264000
PROCEDURE PUTADR(P,R); VALUE P,R; REAL R,P; FORWARD; %A03265000
PROCEDURE DBLSTO(BV,J,OPER); VALUE BV,J,OPER; BOOLEAN BV; %A03266000
INTEGER J,OPER; FORWARD ; %A03267000
PROCEDURE SIMPDBL; FORWARD; %A03268000
INTEGER PROCEDURE SIMPLX(R,BV); VALUE R,BV; INTEGER R; BOOLEAN BV; %A03269000
FORWARD; %A03270000
PROCEDURE CHKSOB; FORWARD; %A03271000
PROCEDURE EMITDACOM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03272000
PROCEDURE FIXRECORD(R,A); VALUE R,A; REAL R,A; FORWARD; %A03273000
REAL PROCEDURE SFTERM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A03274000
PROCEDURE SFEXP(TOP,FT,BL) ; VALUE TOP,FT,BL;% %A03275000
BOOLEAN TOP,FT; REAL BL; FORWARD;% %A03276000
PROCEDURE EMITNONX; FORWARD; %A03277000
PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); %A03278000
VALUE FBIT,SBIT,INDEX; BOOLEAN FBIT,SBIT; INTEGER INDEX; %A03279000
FORWARD; %A03280000
COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 04000000
ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 04001000
COMMENT EMITL EMITS A LIT CALL; 04002000
PROCEDURE EMITL(LITERAL); VALUE LITERAL; INTEGER LITERAL; 04003000
EMIT(0&LITERAL[36:38:10]); 04004000
COMMENT EMITO EMIT AN OPERATOR; 04005000
PROCEDURE EMITO(OPERATOR); VALUE OPERATOR; INTEGER OPERATOR; 04006000
EMIT(1&OPERATOR[36:38:10]); 04007000
COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTOR MODE 04008000
OPERATORS. HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB; 04009000
PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000
INTEGER REPEAT,OPERATOR; 04011000
BEGIN 04012000
IF REPEAT}64 THEN FLAG(268); 04013000
EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000
COMMENT EMITV EMITS AN OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND 04015000
HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04016000
PROCEDURE EMITV(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04017000
BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04018000
EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000
COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000
SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000
PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000
BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000
EMIT(3 & ADDRESS [36:38:10]) END EMITN; 04024000
COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000
ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000
EMITS PRTE; 04027000
PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000
VALUE ADDRESS,OPERATOR; 04029000
INTEGER ADDRESS,OPERATOR; 04030000
BEGIN 04031000
EMITL(ADDRESS); 04032000
IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000
EMITO(OPERATOR) END EMITPAIR; 04034000
COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000
EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000
OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000
CODE CONSISTS OF A SERIES OF DUPS AND MULS. AS WITH 04038000
EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000
AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000
NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 04041000
IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000
(APROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000
OTHERWISE IT CALLS LN AND EXP; 04044000
PROCEDURE EMITUP; 04045000
BEGIN INTEGER BACKUP, CTR; 04046000
LABEL E; 04047000
IF NOT LINKTOG THEN GO TO E; 04048000
COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000
IF GET(L-1) = 537 THEN 04050000
COMMENT LAST OPERATOR IS CHS; 04051000
BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000
IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000
THEN BEGIN 04054000
COMMENT IT IS A LITERAL; 04055000
BACKUP ~ BACKUP+1; L ~ L-1; 04056000
IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000
COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000
CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000
WHILE GT4 DIV 2 ! 0 04060000
DO BEGIN 04061000
EMITO(DUP); 04062000
IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000
EMITO(MUL); 04064000
GT4 ~ GT4 DIV 2 END; 04065000
IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000
ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000
IF BACKUP = 2 04068000
THEN BEGIN 04069000
EMITL(1); 04070000
EMITO(XCH); 04071000
EMITO(128) END END 04072000
ELSE BEGIN 04073000
E: L ~ L+BACKUP; 04074000
EMITO(MKS); 04075000
EMITPAIR(GNAT(LOGI),LOD); 04076000
EMITPAIR(GNAT(EXPI),LOD); 04077000
EMITV(GNAT(XTOTHEI)); 04078000
STACKCT ~ 0; %A 04078500
EMITO(DEL) END END EMITUP; 04079000
COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 04080000
INERVENING SPACE WITH NOPS. IT CHECKS STREAMTOG TO DECIDE 04081000
WHICH SORT OF NOP TO USE; 04082000
PROCEDURE ADJUST; 04083000
BEGIN 04084000
DIALA ~ DIALB ~ 0; 04085000
WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000
END ADJUST; 04087000
COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000
NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000
BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000
(FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000
OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000
ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000
COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000
EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,04095000
AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000
EMITLNG; 04097000
PROCEDURE EMITLNG; 04098000
BEGIN LABEL E; 04099000
IF NOT LINKTOG THEN GO TO E; 04100000
COMMENT GO TO E IF LAST THING IS A LINK; 04101000
IF GET(L) ! 0 THEN GO TO E; 04102000
COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000
LNG OR RELATIONAL OPERATOR; 04104000
IF GT1 ~ GET(L-1) = 77 THEN L ~ L-1 04105000
COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000
ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000
COMMENT LAST THING WAS A RELATIONAL; 04108000
BEGIN L~L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000
BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000
COMMENT NEGATE THE RELATIONAL; END ELSE 04111000
E: EMITO(LNG) END EMITLNG; 04112000
COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000
PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000
VALUE BRANCH,FROM,TOWARDS; 04115000
INTEGER BRANCH,FROM,TOWARDS; 04116000
BEGIN 04117000
INTEGER TL; 04118000
TL ~ L; 04119000
L ~ FROM-2; 04120000
GT1 ~ TOWARDS-FROM; 04120100
IF TOWARDS.[46:2] = 0 04120200
THEN BEGIN 04120300
BRANCH ~ BRANCH&1[39:47:1]; 04120400
GT1 ~ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500
EMITNUM(ABS(GT1)); 04121000
EMITO(BRANCH&(REAL(GT1} 0)+1)[42:46:2]); 04122000
IF BOOLEAN(BRANCH.[38:1]) THEN DIALA ~ DIALB ~ 0; 04123000
L ~ TL 04124000
END EMITB; 04125000
COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000
OCTAL, NAMELY : 04127000
1. 4 CHARACTERS FOR THE L REGISTER. 04128000
2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000
STREAM PROCEDURE DEBUGWORD( SEQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000
BEGIN 04131000
DI:=FEIL; 3(DS:=8LIT" "); SI:=LOC SEQ; SI:=SI+4; DS:=4 CHR; %T9304132000
DS ~ 2 LIT" "; 04133000
SI ~ LOC CODE ; 04134000
16( DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE 04135000
DS ~ RESET ; SKIP 1 SB)); 04136000
37(DS:= 2 LIT " "); %T9304137000
END ; 04138000
COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000
DEBUGGING IS REQUIRED, "L" AND "WORD" ARE OUTPUT ON 04140000
THE PRINTER FILE IN OCTAL FORMAT. ; 04141000
PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000
BEGIN 04143000
ADJUST; 04144000
IF L}4092 THEN ERR(200) 04145000
ELSE BEGIN 04146000
MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000
IF DEBUGTOG THEN 04148000
BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000
WRITELINE END; 04150000
L~L+4 END 04151000
END EMITWORD; 04152000
COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000
BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000
EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000
OF C-RELATIVE OPDC S LEFT BY EMITNUM. IF C-RELATIVE 04156000
ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000
IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000
THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000
AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000
F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000
CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000
PROCEDURE CONSTANTCLEAN ; 04163000
IF MRCLEAN THEN 04164000
BEGIN 04165000
INTEGER J,TEMPL,D,LINK; 04166000
BOOLEAN CREL; 04167000
LABEL ALLTHU ; 04168000
DIALA ~ DIALB ~ 0; 04169000
FOR J ~ 1 STEP 2 UNTIL LASTENTRY DO 04170000
BEGIN 04171000
ADJUST; TEMPL~L; L~INFO[0,255-J+1]; 04172000
CREL ~ FALSE; 04173000
DO BEGIN 04174000
IF D~(TEMPL-L+3)DIV 4}128 THEN 04175000
BEGIN 04176000
NCII~NCII+1; 04177000
PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000
PUTNBUMP(TAKE(255-J)); LASTINFO~NEXTINFO-2; 04179000
GO TO ALLTHU; 04180000
END; 04181000
LINK~GET(L); 04182000
CREL ~ TRUE; 04183000
EMITV(D + 768); 04184000
END UNTIL L~ LINK = 4095 ; 04185000
ALLTHU: L ~ TEMPL; 04186000
IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000
END; 04188000
LASTENTRY ~ 0; 04189000
END ; 04190000
COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000
EXPLICIT AND IMPLICIT. IN EVERY CASE,EMITNUM WILL 04192000
PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000
THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000
SYLLABLE IS PRODUCED. HOWEVER,NON-LITERALS ARE KEPT 04195000
IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000
POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000
CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000
TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000
IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000
ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000
OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000
PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000
BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000
IF C.[1:37]=0 THEN EMITL(C) 04205000
ELSE 04206000
BEGIN 04207000
FOR N ~ 1 STEP 2 UNTIL LASTENTRY DO 04208000
IF REAL(BOOLEAN(INFO[0,255-N])EQV BOOLEAN(C)) %W0304209000
= REAL(NOT FALSE) THEN GO TO FOUND; %W0304209500
INFO[0,255 -LASTENTRY] ~ L; 04210000
INFO[0,255 -LASTENTRY-1]~ C ; 04211000
EMITN(1023); 04212000
LINKTOG~FALSE; 04213000
IF LASTENTRY ~ LASTENTRY+2 } 128 THEN 04214000
BEGIN 04215000
C ~ BUMPL; 04216000
CONSTANTCLEAN; 04217000
EMITB(BFW,C,L); 04218000
END; 04219000
GO TO FINISHED; 04220000
FOUND: EMIT(INFO[0,255 -N+1]); 04221000
LINKTOG~FALSE; 04222000
INFO[0,255-N+1]~ L-1; 04223000
END; 04224000
FINISHED:END EMITNUM ; 04225000
COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000
ARRAYS. GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000
MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000
BE FOUND SEARCH YIELDS BLANKS. 04229000
NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000
ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000
BEGIN LABEL L; 04232000
COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000
BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000
AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000
THE LENGTH OF Q IS 128. ; 04236000
INTEGER N,I ; 04237000
N ~ 64 ; 04238000
FOR I ~ 66 STEP IF Q[I]<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
04249000
COMMENT PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE 04265000
INTO THE EDOC ARRAY. THE SPECIFIC ELEMENT OF EDOC 04266000
IS PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128] 04267000
SYLLABLE POSITION=(L MOD 4 ), WHERE L IS THE SYLLABLE 04268000
NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT; 04269000
STREAM PROCEDURE PACK(WORD,POSITION,SYLLABLE); 04270000
VALUE POSITION,SYLLABLE; 04271000
BEGIN 04272000
DI~WORD ; DI ~ DI+POSITION ; DI ~ DI+POSITION; 04273000
SI~LOC SYLLABLE ; SI~SI+6; 04274000
DS~2 CHR ; 04275000
END PACK ; 04276000
PROCEDURE DEBUG(S); 04277000
VALUE S; REAL S ; 04278000
BEGIN %B04278100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B04278200
IF STREAMTOG THEN 04279000
IF SINGLTOG THEN 04279100
WRITE(LINE,BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]),B2D(S)) 04279200
ELSE 04279300
WRITE(LINE,BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]),B2D(S)) 04280000
%0104281000
04282000
ELSE 04283000
04284000
IF SINGLTOG THEN 04284100
WRITE(LINE,BUG,B2D(L),IF T1~S.[46:2]=1 THEN 04284200
BUGGER(S.[36:10]) ELSE WOP[T1],IF T1=1 THEN WOP[1] 04284300
ELSE B2D(S.[36:10]),B2D(S)) 04284400
ELSE 04284500
WRITE(LINE,BUG,B2D(L),IF T1~S.[46:2]!1THEN WOP[T1] ELSE 04285000
BUGGER(S.[36:10]),IF T1=1THEN WOP[T1] ELSE 04286000
B2D(S.[36:10]),B2D(S));% %0104287000
END; %B04287500
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 <4093 THEN 04293000
BEGIN 04294000
LINKTOG ~ TRUE; 04295000
PACK( EDOC[L.[36:3 ],L.[39:7]],L.[46:2],S); 04296000
IF DEBUGTOG THEN DEBUG(S); 04297000
L~L+1; 04298000
END ELSE 04299000
ERR(200) 04300000
COMMENT 200 EMIT - SEGMENT GREATER THAN 4093 SYLLABLES *;04301000
END EMIT ; 04302000
COMMENT THE PRINCIPLE FUNCTION OF DEBUG IS TO COMPUTE THE PROPER 04303000
PARAMETERS FOR STREAM PROCEDURE BUG; 04304000
COMMENT EMITD EMITS THE DIA,DIB,TRB SEQUENCE OF CODE. THE 04305000
PREVIOUS SETTING OF THE G-H AND K-V REGISTERS IS COMPARED 04306000
THE CURRENT . IF THE G-H,K-V OR BOTH ARE ALREADY SET THEN 04307000
THE APPROIATE SYLLABLE(S) ARE OMITTED 04308000
IF 0 BITS ARE TO BE TRANSFERED THEN NO SYLLABLES ARE 04309000
EMITTED ; 04310000
PROCEDURE EMITD(A,B,T); VALUE A,B,T ; INTEGER A,B,T; 04311000
BEGIN LABEL EXIT,NORMAL; 04311010
REAL Q; 04311020
IF T = 15 THEN 04311030
BEGIN 04311040
IF A = 33 THEN Q ~ 512 04311050
ELSE IF A ! 18 THEN GO TO NORMAL; 04311060
IF B = 18 THEN Q ~ Q+256 04311070
ELSE IF B ! 33 THEN GO TO NORMAL; 04311080
EMITO(Q+197); COMMENT -- THIS GETS OUT FIXED FIELD; 04311090
GO TO EXIT; 04311100
END; 04311110
NORMAL: 04311120
IF T! 0 THEN 04312000
BEGIN 04313000
IF DIALA! A THEN 04314000
EMIT(((DIALA~A) DIV 6)|512 + ( A~ A MOD 6)| 64 + DIA); 04315000
IF DIALB!B THEN 04316000
EMIT(((DIALB~B) DIV 6)|512 + ( B~ B MOD 6)| 64 + DIB); 04317000
EMIT(TRB+64|T); 04318000
DIALA~DIALB~0; 04319000
COMMENT THE PRECEEDING STATEMENT CAN BE REMOVED FOR OPTIMIZING 04320000
G-H AND K-V REGISTERS,OTHERWISE NO OPTIMIZING OCCURS; 04321000
END EMITD ; 04322000
EXIT: END; 04322100
PROCEDURE EMITI(E,A,B); VALUE E,A,B; REAL E,A,B; 04500000
BEGIN LABEL EXIT,IS; 04501000
INTEGER S,T1,T2; 04502000
PROCEDURE EMIT21(E,B); VALUE E,B; 04503000
REAL E; 04504000
BOOLEAN B; 04505000
BEGIN IF E = 0 THEN 04506000
BEGIN IF B THEN EMITO(XCH); END 04507000
ELSE BEGIN GT1 ~ E.ADDRESS; 04508000
IF E ~ E.CLASS { INTID THEN 04509000
EMITV(GT1) 04521000
ELSE IF E { INTARRAYID THEN 04522000
EMITPAIR(GT1,LOD) ELSE 04523000
EMITN(GT1) 04524000
END 04525000
END; 04526000
IF B = 0 THEN 04526100
BEGIN EMIT21(E,FALSE); GO TO EXIT END; 04526200
IF STACKCT ! 0 THEN GO TO IS; 04527000
IF B = 15 THEN 04528000
BEGIN IF A = 33 THEN 04529000
BEGIN EMIT21(E,FALSE); 04530000
EMIT(0); EMITO(INX); 04531000
GO TO EXIT; 04532000
END; 04533000
IF A = 18 THEN 04534000
BEGIN EMIT(0); 04535000
EMIT21(E,TRUE); 04536000
EMITO(197); 04537000
GO TO EXIT; 04538000
END; 04539000
GO TO IS; 04540000
END; 04541000
IF B { 10 AND A+B = 48 THEN 04542000
BEGIN EMIT21(E,FALSE); 04543000
EMITL(2*B-1); 04544000
EMITO(LND); 04545000
GO TO EXIT; 04546000
END; 04547000
IS: IF (S ~ (48-A-B) MOD 6)+B { 39 THEN 04548000
BEGIN EMIT21(E,FALSE); 04549000
EMIT(T2~(T1~A DIV 6)|512+(A MOD 6)|64+DIA); 04550000
EMIT(((A+B-1) DIV 6 -T1+1)|512+64|S+37); 04551000
GO TO EXIT; 04552000
END; 04553000
EMIT(0); 04554000
EMIT21(E,TRUE); 04555000
EMITD(A,48-B,B); 04556000
04557000
EXIT: END; 04558000
ALPHA PROCEDURE BUGGER(OP); VALUE OP; INTEGER OP; 04600000
BEGIN INTEGER Q; 04601000
WOP[1]~" "; 04602000
IF BUGGER~SEARCH(WOP,OP)=" " THEN 04603000
IF Q~OP.[44:4]}9 THEN 04604000
BEGIN BUGGER~POP[IF Q!10 THEN Q-5 ELSE OP.[42:2]]; 04605000
WOP[1]~(IF Q=10 THEN OP.[39:3]&OP[41:38:1] ELSE 04606000
OP.[41:3]&OP[39:38:3])&" "[24:36:12]; 04607000
END; END BUGGER; 04608000
PROCEDURE CHECKDISJOINT(A); VALUE A; INTEGER A; 04609000
BEGIN 04609010
IF LEVEL > SUBLEVEL+1 THEN 04609020
BEGIN 04609030
EMIT(0); 04609040
EMITPAIR(A, STD); 04609050
END; 04609060
EMITN(A); 04609070
END CHECKDISJOINT; 04609080
PROCEDURE EMITDIAL(A,B); VALUE A,B; INTEGER A,B; %A04610000
EMIT(B~A + (B DIV 6)|512 + (B MOD 6)|64); %A04611000
% %A04612000
PROCEDURE EMITFC(A,B); VALUE A,B; INTEGER A,B; %A04613000
EMIT(B ~ A + 64|B); %A04614000
% %A04615000
PROCEDURE EMITFB(TYPE,LENGTH,FROM,TOWARDS); %A04616000
VALUE TYPE,LENGTH,FROM,TOWARDS; %A04617000
INTEGER TYPE,LENGTH,FROM,TOWARDS; %A04618000
BEGIN INTEGER TL; TL ~ L; %A04619000
L ~ FROM - 2; %A04620000
EMITNUM(ABS(TOWARDS-FROM)); %A04621000
EMIT(TYPE~ LENGTH|256 + TYPE|64 + 41); L ~ TL END; %A04622000
% %A04623000
PROCEDURE DBLTSNGL(R); VALUE R; REAL R; %A04624000
BEGIN %A04625000
DEFINE STARTBLOCK = #; 04625500
EMIT(0); EMITNUM(1.0); EMITO( ML2); EMITO(XCH); EMITO(DEL); %A04626000
IF R > 4 THEN BEGIN EMITPAIR(JUNK,STD); EMIT(0); EMITNUM(1.0); %A04627000
EMITO(ML2); EMITO(XCH); EMITO(DEL); EMITV(JUNK) END; %A04628000
END; %A04629000
% %A04630000
PROCEDURE DBLNORM; %A04631000
BEGIN EMIT(0); EMITNUM(1.0); EMITO( ML2) END; %A04632000
% %A04633000
PROCEDURE MARKDESC(N); VALUE N; REAL N; %A04634000
BEGIN DEFINE STARTBLOCK = #; 04634500
IF RECLAIMTOG THEN BEGIN %A04635000
EMIT(11); EMIT(4); EMITO(280);% %A04636000
EMITV(TABLEMARK); %A04637000
IF N ! 0 THEN BEGIN %A04638000
EMITL(ABS(N)); %A04639000
EMITO(IF N < 0 THEN SUB ELSE ADD); %A04640000
EMITPAIR(TABLEMARK,SND); %A04641000
END; %A04642000
EMITN(PTABLE); EMITO(STD); END; %A04643000
END; % 04643500
% %A04644000
PROCEDURE MARKSYMNCR(N); VALUE N; REAL N; %A04645000
BEGIN DEFINE STARTBLOCK = #; 04645500
IF RECLAIMTOG THEN BEGIN IF N ! 0 THEN BEGIN %A04646000
EMITV(TABLEMARK); EMITL(ABS(N)); %A04647000
EMITO(IF N < 0 THEN SUB ELSE ADD); %A04648000
EMITPAIR(TABLEMARK,SND) END ELSE EMITV(TABLEMARK); %A04649000
EMITN(PTABLE); EMITO(SND); END; %A04650000
END; % 04650500
% %A04651000
PROCEDURE MARKSYMDCR(N); VALUE N; REAL N; %A04652000
BEGIN DEFINE STARTBLOCK = #; 04652500
IF N ! 0 AND RECLAIMTOG THEN BEGIN %A04653000
EMITV(TABLEMARK); EMITL(ABS(N)); %A04654000
EMITO(IF N < 0 THEN SUB ELSE ADD); %A04655000
EMITPAIR(TABLEMARK,STD); END; %A04656000
END; % 04656500
% %A04657000
PROCEDURE GETCONTENTS(R,V); VALUE R,V; REAL R; BOOLEAN V; %A04658000
BEGIN INTEGER K; %A04659000
STACKCT ~ 1; %A04660000
EMITO(DUP); EMITI(0,K~39-R|15,9); EMITO(XCH); %A04661000
EMITI(0,K~33-R|15,6); EMITN(LNKA); EMITO(LOD); EMITO(XCH); %A04662000
EMITO(IF V THEN CDC ELSE COC) END; %A04663000
% %A04664000
PROCEDURE EMITERR(SG,RELAD,NO); VALUE SG,RELAD,NO ; %A04665000
INTEGER SG,RELAD,NO; %A04666000
BEGIN RELAD ~ (RELAD + 3) DIV 4; %A04667000
EMITPAIR(5,BFC); EMITO(MKS); %A04668000
EMITL(SG); EMITL(RELAD); EMITL(NO); %A04669000
EMITV(ERRPRO); END; %A04670000
% %A04671000
PROCEDURE EMITREL(X); VALUE X; REAL X; %A04672000
BEGIN REAL T; %A04673000
EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 ELSE CPLUS1); %A04674000
T ~ BUMPL; %A04675000
EMITWORD(X); %A04676000
EMITB(BFW,T,L); %A04677000
END OF EMITREL; %A04678000
% %A04679000
PROCEDURE EMITCREL(N,T); VALUE N,T; REAL T,N; %A04680000
BEGIN %A04681000
INTEGER J,TL; %A04682000
EMITWORD(N); %A04683000
TL ~ L - 4; %A04684000
L ~ T - 1; %A04685000
EMITV(J~((L-TL+3) DIV 4) + 768); %A04686000
L ~ TL + 4; %A04687000
END OF EMITCREL; %A04688000
% %A04689000
PROCEDURE EMITARRAY(ADR,S,R,SAVETOG); VALUE ADR,S,R,SAVETOG; %A04690000
REAL ADR,S,R; BOOLEAN SAVETOG; %A04691000
BEGIN %A04692000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B04692500
NOOFARRAYS ~ NOOFARRAYS + 1; %A04693000
EMITO(MKS); %A04694000
EMITN(ADR); %A04695000
EMITL(S); %A04696000
IF R ! 0 THEN EMITL(R); %A04697000
EMITL(REAL(R!0) + 1); %A04698000
EMITL(1); %A04699000
EMITL(REAL(SAVETOG)); %A04700000
EMITV(5); %A04701000
END OF EMITARRAY; %A04702000
% %A04703000
PROCEDURE EMITATN; %A04704000
BEGIN EMITO(MKS); EMITV(ATN) END; %A04705000
% %A04706000
PROCEDURE TRPRI; %A04707000
BEGIN EMITO(MKS); EMITV(TERPRIN); END; %A04708000
% %A04709000
PROCEDURE GENSYMLINK; %A04710000
BEGIN EMITO(MKS); EMITV(GENLINK); END ; %A04711000
% %A04712000
REAL PROCEDURE GETPC(R); VALUE R; REAL R; %A04713000
GETPC ~ IF BOOLEAN (R) THEN %A04714000
EDC[R.[36:4],R.[40:7]].[30:18] ELSE %A04715000
EDC[R.[36:4],R.[40:7]].[12:18]; %A04716000
% %A04717000
PROCEDURE EMT(X); VALUE X; REAL X; %A04718000
BEGIN %A04719000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B04719500
IF BOOLEAN(LC) THEN %A04720000
EDC[LC.[36:4],LC.[40:7]].[30:18] ~ X ELSE %A04721000
EDC[LC.[36:4],LC.[40:7]].[12:18] ~ X; %A04722000
IF LC ! 2046 THEN IF LC ~ LC + 1 = 2046 THEN BEGIN %A04723000
FLAG(603); %A04724000
ERRORTOG~ TRUE END; END OF EMT; %A04725000
% %A04726000
PROCEDURE EC(X,Y); VALUE X,Y; REAL X,Y; EMT(Y&X[36:42:6]); %A04727000
% %A04728000
PROCEDURE ECR(X,Y); VALUE X,Y; REAL X,Y; %A04729000
BEGIN %A04730000
EMT(Y&X[36:42:6] & 1 [30:42:6]); %A04731000
IF X > 63 THEN BEGIN %A04732000
FLAG(604); %A04733000
ERRORTOG~ TRUE END END OF ECR; %A04734000
% %A04735000
PROCEDURE EMD(A,B); VALUE A,B; REAL A,B; %A04736000
BEGIN EMIT(0); ECR(B,SES); %A04737000
EC(6,SFS); ECR(A,SED); EC(7,SFD); EC(1,TRS); %A04738000
END OF EMD; %A04739000
% %A04740000
PROCEDURE EJ(T); VALUE T; REAL T; %A04741000
BEGIN EMT(JMPCH & T [30:42:6]); JMPCH ~ LC END; %A04742000
% %A04743000
PROCEDURE EMITJUMP(BV); VALUE BV; BOOLEAN BV; %A04744000
BEGIN LABEL EXIT; %A04745000
REAL JF; %A04745500
REAL R,P,T; %A04746000
T ~ P ~ LC; %A04747000
WHILE JMPCH ! 0 DO BEGIN %A04748000
R ~ GETPC(LC ~ JMPCH - 1); %A04749000
JF ~ R .[30:6]; %A04750000
IF BV THEN JF ~ IF JF=JFW THEN JNS ELSE JNC; %A04751000
IF T - JMPCH > 63 THEN %A04752000
IF T - P > 63 THEN BEGIN %A04753000
FLAG(604); %A04754000
ERRORTOG ~ TRUE; GO EXIT END ELSE %A04755000
EC(T-P,JF) ELSE EC(T-JMPCH,JF); %A04756000
P ~ LC - 1; %A04757000
JMPCH ~ R.[36:12]; END; %A04758000
LC ~ T; %A04759000
EXIT: %A04760000
END OF EMITJUMP ; %A04761000
% %A04762000
PROCEDURE EMTC; %A04763000
BEGIN REAL T,R; %A04764000
LC ~ LC - 1; STK ~ STK + 1; %A04765000
IF GET(L-1) = 289 THEN BEGIN % MKS %A04765100
EMIT(0); STK ~ STK + 1 END; %A04765200
EMITO(ECM); STREAMTOG ~ TRUE; %A04766000
FOR R ~ 0 STEP 1 UNTIL LC DO BEGIN %A04767000
IF BOOLEAN((T~GETPC(R)).[35:1]) THEN %A04768000
EMIT(T & (STK - T.[36:6])[36:42:6]) ELSE EMIT(T) %A04769000
END; %A04770000
EMITC(1,0); STREAMTOG ~ FALSE; %A04771000
END OF EMTC; %A04772000
% %A04773000
PROCEDURE MKALF(EL); VALUE EL; REAL EL; %A04774000
BEGIN REAL T,R,S; %A04775000
MOVECHARACTERS(IF S~TAKE(R~EL.LINK+1).[12:6]>7 THEN S~7 ELSE S, %A04776000
INFO[R.LINKR,R.LINKC],3,T,8-S); EMITNUM(T) %A04777000
END; %A04778000
COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000
COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000
COMMENT TO HANDLE PARA DEFINES MOVE STEPI W27; %60 %W2705002000
%W2705003000
COMMENT TAKE FETCHS A WORD FROM INFO; 05004000
REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000
TAKE ~ INFO[INDEX.LINKR,INDEX.LINKC]; 05006000
COMMENT PUT PLACES A WORD INTO INFO; 05007000
PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000
INFO[INDEX.LINKR,INDEX.LINKC] ~ WORD; 05009000
COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPPRESS FUTURE 05010000
ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000
PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000
BEGIN 05013000
COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000
THE ERROR MESSAGE ON THE PRINTER; 05015000
STREAM PROCEDURE WRITERROR (P,C,A,E1,N,M,R,D,L); % %T1405016000
VALUE C, N,M,R,D ; % %T1405017000
BEGIN % %T1405018000
SI~P ; DI~P ; DS~8 LIT " " ; DS~14 WDS ; % %T1405019000
SI~LOC R;DI~DI-3;DS~3DEC;DI~DI+1;SI~L;DS~WDS;% %T1405019500
DI~P ; DS~13 LIT "ERROR IN COL "; SI~LOC C ; DS~2 DEC ; DS~LIT ":" ;%T1405020000
DI~DI+32 ; DI~DI+40 ; SI~L ; SI~SI-8 ; DS~WDS ; % %T1405021000
DI~L ; DI~DI-8 ; DS~WDS ; % %T1405022000
% %T1405023000
DI~E1 ; DI~DI+M ; % %T1405025000
SI ~ A; SI ~ SI + 3; D(N( IF SC=ALPHA THEN DS~CHR ELSE %T1405026000
IF SC="}" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026010
IF SC="!" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026020
IF SC="~" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026030
IF SC="{" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026040
IF SC="<" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026050
IF SC=">" THEN BEGIN DS~LIT "$";SI~SI+1;END ELSE %T1405026060
DS ~ CHR); JUMP OUT TO LL1); DS~N CHR; LL1: %T1405026500
D(DS :=2LIT" #"; SI:= LOC R; DS := 3 DEC; % %T1405026900
DS ~ LIT "~"; SI ~ L; DI ~ P; DS ~ WDS; DS ~ LIT ":"); % %T1405027000
END WRITERROR; % %T1405028000
DEFINE TESTIT = IF LISTOG OR NOT(REMOTOG OR REMOTERR) THEN BEGIN#; %T1405028990
REAL R1,R2,R3,R4,R5; % %T1405029000
BOOLEAN STREAM PROCEDURE TESTBIT(B,V); VALUE V; % %T1405030000
BEGIN SI:=B; SKIP V SB; IF SB THEN TALLY := 1 ELSE BEGIN % %T1405031000
DI:=B; SKIP V DB; DS:=SET; END; TESTBIT:=TALLY; END; % TESTBIT %T1405031100
IF ERRORTOG 05032000
THEN BEGIN COMMENT DO NOTHING IF WE SUPPRESS MSSGS;05033000
SPECTOG ~ FALSE; 05034000
ERRORCOUNT ~ ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000
IF NOT LISTOG AND NOT (REMOTOG OR REMOTERR) % %T1405036000
THEN BEGIN 05037000
PRINT(LIN,FCR," ",IF LASTUSED=6 THEN FILEINX+17 05038000
ELSE IF LASTUSED=3 THEN"T"ELSE IF LASTUSED=2 OR 05038500
LASTUSED=5 THEN"R"ELSE 48); 05039000
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039500
IF NOTPNTED THEN PERMLINE(NOHEADING) ; 05039600
WRITELINE; 05040000
END; 05041000
COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000
ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000
% %T1405043100
% %T1405043200
% %T1405043300
% %T1405043400
IF DEFINEINDEX = 0 THEN R2 ~ NCR ELSE % %T1405044000
MOVECHARACTERS(3,DEFINEARRAY[2],5,R2,5);% %T1405044050
R1 ~ R2.[33:15] - FCR ; % %T1405044100
R2 ~ R2.[30:3] ; % %T1405044200
IF R3 ~ R1 | 8 + R2 } 72 THEN R3 ~ 71 ; % %T1405044400
R5 ~ MIN (Q.[12:6],31) ; % %T1405044450
IF NOT (REMOTOG OR REMOTERR) THEN % %T1405044475
R4 ~ IF R3+R5 { 71 THEN R3 ELSE R3-R5; % %T1405044500
R3 ~ R3 + 1 ; % %T1405044550
WRITERROR (LIN,R3,ACCUM[1],LIN[R4 DIV 8 + 2],R5,R4.[45:3],ERRNUM, % %T1405044900
(REMOTOG OR REMOTERR) AND TRUE, % %T1405044950
INFO[LASTSEQROW,LASTSEQUENCE]); 05045000
% %T1405045100
% %T1405045200
% %T1405045300
% %T1405045400
IF REMOTOG OR REMOTERR THEN WRITE(REMOTE[*,9],9,LIN[*])[ENDOFITALL];%T1405045900
TESTIT WRITELINE; END; % %T1405046000
IF ERRNUM ! PERR THEN READ (ERMDF[PERR ~ ERRNUM],15,ERARA [*]); % %T1405046400
TESTIT WRITE(LINE,15,ERARA[*]); END; % %T1405046600
IF REMOTOG OR REMOTERR THEN IF NOT TESTBIT(BITS[ERRNUM DIV 48], % %T1405046650
ENTIER(ERRNUM MOD 48)) THEN WRITE(REMOTE[*,9],9,ERARA[*]) % %T1405046700
[ENDOFITALL]; % %T1405046705
ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000
IF PUNCHTOG THEN 05048000
BEGIN 05049000
STREAM PROCEDURE PUNCH(FL,ST); 05050000
VALUE ST; 05051000
BEGIN 05052000
DI ~ FL; 05053000
SI ~ ST; 05054000
DS ~ 9 WDS 05055000
END PUNCH; 05056000
PUNCH(PNCH(0),FCR); 05057000
MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000
WRITE(PNCH) 05059000
END 05060000
05061000
05062000
05063000
05064000
05065000
05066000
05067000
05068000
05069000
05070000
05071000
05072000
05073000
05074000
05075000
05076000
05077000
05078000
05079000
05080000
05081000
05082000
05083000
05084000
05085000
05086000
05087000
05088000
05089000
05090000
05091000
05092000
05093000
05094000
05095000
05096000
05097000
05098000
05099000
05100000
; IF ERRORCOUNT > ERRORMAX THEN GO ENDOFITALL; % %T9805100005
END END FLAG; 05101000
% %T1405101100
COMMENT ERR,IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000
RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000
SEMICOLON, END, OR BEGIN; 05104000
PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000
BEGIN FLAG(ERRNUM); 05106000
I ~ I-1; 05107000
IF ERRNUM=200THEN AKKUM~AKKUM+1024+L~0;% %0705107100
DO IF STEPI = BEGINV THEN STMT UNTIL 05108000
ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000
DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000
COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000
UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000
PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000
BEGIN 05114000
IF MODE } 2 THEN 05115000
IF GT1 ~ ELBATWORD.LVL } FRSTLEVEL THEN 05116000
IF GT1 < SUBLEVEL THEN 05117000
IF ELBATWORD.[9:2] ! 1 05118000
THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000
END CHECKER; 05120000
COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000
GIVEN THE LINK TO THE ELBAT WORD; 05122000
INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000
GIT ~ TAKE(L).INCR+L.LINK; 05124000
COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000
IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000
GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000
INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000
BEGIN 05129000
REAL A; 05130000
IF L = XTOTHEI THEN PUTADR(XTOTHEI,GNAT~140) ELSE %M05130050
IF L = POWERSOFTEN THEN PUTADR(POWERSOFTEN,GNAT~105) ELSE %A05130100
IF (A ~ TAKE(L)).CLASS = 20 AND A.[33:2] ! 0 THEN BEGIN %M05130200
IF GNAT ~ A.ADDRESS = 0 THEN BEGIN %M05130300
IF A ~ TAKE(L.LINK + A.[33:2]).[3:6] = 0 THEN %M05130400
A:=GETSPACE(TRUE,L.LINK+1); PUTADR(L,GNAT:=A) END END ELSE%M05130500
IF GNAT ~(A~TAKE(L)).ADDRESS=0 05131000
THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11],L) 05132000
END GNAT; 05133000
COMMENT PASSFILE COMPILES CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR05134000
POINTING AT THE I/O DESCRIPTOR (ON TOP). IT HANDLES 05135000
SUPERFILES AS WELL AS ORDINARY FILES; 05136000
PROCEDURE PASSFILE; 05137000
BEGIN INTEGER ADDRES; 05138000
CHECKER(ELBAT[I]); 05139000
ADDRES ~ ELBAT[I].ADDRESS; 05140000
IF ELCLASS = SUPERFILEID 05141000
THEN BEGIN 05142000
BANA; EMITN(ADDRES); EMITO(LOD) END 05143000
ELSE BEGIN 05144000
IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000
STEPIT; 05146000
EMITN(ADDRES) END END PASSFILE; 05147000
PROCEDURE PASSMONFILE(ADDRESS); 05148000
VALUE ADDRESS ; 05149000
REAL ADDRESS ; 05150000
BEGIN COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 05151000
FILE TO PRINTI; 05152000
IF ADDRESS < 768 OR ADDRESS > 1023 05153000
THEN EMITL(5); 05154000
EMITN(ADDRESS); 05155000
END PASSMONFILE; 05156000
PROCEDURE PASFILE; 05157000
BEGIN COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 05158000
MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 05159000
DEFINE ELBATWORD = RR1#; COMMENT ELBATWORD CONTAINS THE 05160000
ELBATWORD FOR THE FILE BEING 05161000
OPERATED ON; 05162000
DEFINE LTEMP = RR2#; COMMENT LTEMP IS USED TO HOLD THE L 05163000
REGISTER SETTING FOR THE SAVE OR 05164000
RELEASE LITERAL THAT GETS PASSED TO 05165000
KEN MEYERS; 05166000
EMITO(MKS); L~(LTEMP~L)+1; EMITL(0); 05167000
EMITL(2); CHECKER(ELBATWORD~ELBAT[I]); 05168000
IF RRB1~(RRB2~ ELCLASS = SUPERFILEID)OR 05169000
BOOLEAN(ELBATWORD.FORMAL) 05170000
THEN EMITO(LNG); 05171000
IF RRB2 05172000
THEN BANA 05173000
ELSE STEPIT; 05174000
EMITN(ELBATWORD.ADDRESS); 05175000
IF RRB2 05176000
THEN EMITO(LOD); 05177000
IF RRB1 05178000
THEN EMITO(INX); 05179000
EMITL(4); EMITV(14); 05180000
END PASFILE; 05181000
COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE05182000
PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000
PROCEDURE CHECKPRESENCE; 05184000
BEGIN 05185000
EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000
END CHECKPRESENCE; 05187000
COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESC 05187500
TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510
PROCEDURE PASTOLIST; 05187520
BEGIN 05187530
INTEGER LISTADDRESS; 05187540
COMMENT PASSLIST ASSUMES I POINTING AT LIST ID; 05187550
CHECKER(ELBAT[I]); 05187560
LISTADDRESS~ELBAT[I].ADDRESS; 05187570
IF ELCLASS = SUPERLISTID 05187580
THEN BEGIN COMMENT SUBSCRIPTED LIST ID; 05187590
BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600
END 05187610
ELSE BEGIN 05187620
IF LISTADDRESS<512 OR 05187630
LISTADDRESS>1023 THEN 05187640
BEGIN EMITL(LISTADDRESS); 05187650
EMITN(10); 05187660
END 05187670
ELSE BEGIN 05187680
IF LISTADDRESS<896 THEN 05187690
EMITL(LISTADDRESS-512) 05187700
ELSE BEGIN EMITL(LISTADDRESS- 05187710
897); EMITO(LNG) 05187720
END; 05187730
EMITN(512); EMITO(INX); 05187800
END; 05187810
STEPIT; 05187820
END; 05187830
END OF PASSTOLIST; 05187840
DEFINE % %4105188000
TAKEFRST = TAKE(ELBAT[I].LINK+ELBAT[I].INCR)#; %T9305189000
COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000
DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000
STACK; 05198000
PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000
BEGIN 05200000
EMITPAIR(ADDRESS,LOD); 05201000
EMITN(512); 05202000
EMITD(33,18,15) END STUFFF; 05203000
COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000
PRESENT CODE; 05205000
BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000
VALUE ELBATWORD; REAL ELBATWORD; 05207000
BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000
NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000
LOCAL ~ TRUE END LOCAL; 05210000
COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000
PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000
STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000
PROCEDURE PASSFORMAT; 05214000
BEGIN INTEGER ADRES; 05215000
CHECKER(ELBAT[I]); 05216000
ADRES ~ ELBAT[I].ADDRESS; 05217000
IF BOOLEAN(ELBAT[I].FORMAL) 05218000
THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END 05219000
ELSE BEGIN 05220000
IF TABLE(I) = SUPERFRMTID 05221000
THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000
END; 05223000
IF TABLE(I) = SUPERFRMTID 05224000
THEN BEGIN BANA; I ~ I-1; 05225000
EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000
EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000
COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000
WORDS - IT COMPLEMENTS THEIR STATE; 05229000
DEFINE STREAMWORDS = % %4105230000
BEGIN GT1 ~ 0; 05231000
DO BEGIN 05232000
INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000
STACKHEAD[GT2] ~ T.LINK; 05234000
GT1 ~ GT1+2; 05235000
END UNTIL BOOLEAN(T.FORMAL) END #;% STREAMWORDS. %4105236000
STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000
VALUE PRT,TYP,RELAD,SGNO; 05237500
BEGIN LOCAL COUNT; 05238000
DI:=LIN; DS:=6 LIT" PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 05238500
3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05239000
BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05239500
COUNT:=TALLY; DS:=COUNT CHR; 05240000
DS:= 31 LIT") = SEGMENT DESCRIPTOR, TYPE = "; 05240500
SI:=LOC TYP; SI:=SI+7; DS:=CHR; % TYPE. 05241000
DS:=21 LIT", RELATIVE ADDRESS = "; 05241500
SI:=LOC RELAD; SI:=SI+4; DS:=4 CHR; % REL. ADDR. 05242000
DS:=19 LIT", SEGMENT NUMBER = "; 05242500
SI:=LOC SGNO; SI:=SI+4; DS:=4 CHR; DS:=LIT"."; 05243000
END DEBUGDESC; 05243500
REAL PROCEDURE PROGDESCBLDR(TYPE,RELAD,SPAC); 05245000
COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE.IT IS 05246000
CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 05247000
BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 05248000
SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 05249000
THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 05250000
TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE05251000
AND ARGUMENT BIT FOR THE PROGRAM 05252000
DESCRIPTOR TO BE BUILT. 05253000
RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 05254000
SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 05255000
IF!0 THEN SPACE IS ALREADY GOTTEN 05256000
ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000
PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000
VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000
BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000
PDPRT[PDINX.[37:5],PDINX.[42:6]]~0&RELAD[18:36:10] 05261000
&SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000
IF DEBUGTOG THEN 05263000
BEGIN 05263500
BLANKET(14,LIN); 05264000
DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO));05264500
IF NOHEADING THEN DATIME; WRITELINE; 05265000
END; 05265100
PDINX~PDINX+1;PROGDESCBLDR~SPAC END PROGDESCBLDR; 05266000
COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000
IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000
LITERALS INVOLVED; 05269000
BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000
INTEGER FIRST,SECOND; 05271000
BEGIN 05272000
LABEL EXIT; 05273000
IF STEPI = LFTBRKET THEN 05274000
IF STEPI = LITNO THEN 05275000
IF STEPI = COLON THEN 05276000
IF STEPI = LITNO THEN 05277000
IF STEPI = RTBRKET THEN 05278000
COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000
IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000
(SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000
IF FIRST + SECOND { 48 THEN 05282000
COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000
GO TO EXIT; 05284000
ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000
DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000
BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000
VALUE ELBATCLASS,ERRORNUMBER; 05288000
REAL ELBATCLASS,ERRORNUMBER; 05289000
BEGIN COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 05290000
ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 05291000
CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET05292000
FALSE; 05293000
IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000
THEN ERR(ERRORNUMBER); 05295000
END; 05296000
BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000
VALUE LOWER,UPPER; 05298000
REAL LOWER,UPPER; 05299000
COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000
IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000
UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000
CLASS MUST BE IN ELCLASS; 05303000
RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000
COMMENT GET OBTAINS A SYLLABLE FROM EDOC, THE ARRAY INTO WHICH CODE IS 05305000
EMITTED; 05306000
INTEGER PROCEDURE GET(L); VALUE L; REAL L; 05307000
BEGIN 05308000
INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000
BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000
SI ~ W; SI ~ SI+S; SI ~ SI+S; DS ~ 2 CHR END; 05311000
GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000
COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000
SCRIPTOR TO THE TOP OF THE STACK; 05314000
PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000
BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000
REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000
VALUE SIZE ; 05318000
BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000
FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000
CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000
ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000
DI~LOC GETALPHA; DS~8 LIT"0 "; DI~DI-7; 05323000
SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000
END GETALPHA; 05325000
PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010
BEGIN 05325020
LABEL EXIT; 05325030
STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040
VALUE PORS,CELL,N; 05325050
BEGIN 05325060
LOCAL COUNT; 05325070
LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080
SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090
IF SC="P" THEN 05325100
BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110
ELSE BEGIN 05325120
DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130
IF SC}"6" THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140
COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150
DS:=11 RESET; DI:=COUNT; 05325160
END; 05325170
SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180
3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190
BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200
COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210
DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220
CI:=CI+N; 05325230
GO M0; 05325240
GO M1; 05325250
GO M2; 05325260
GO M3; 05325270
GO M4; 05325280
GO M5; 05325290
GO M6; 05325300
GO M7; 05325310
M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320
DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330
GO XIT; 05325340
M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350
M2: DI:=CELL; 05325360
DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370
M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380
M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390
M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400
M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410
M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420
XIT: 05325430
END FILLIT; 05325440
BLANKET(14,LIN); 05325450
IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460
ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470
ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480
IF NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); WRITELINE; %T9305325490
END WRITEPRT; 05325500
COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 05326000
THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 05327000
PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 05328000
PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 05329000
MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 05330000
INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000
BOOLEAN PERMANENT; INTEGER L; 05333000
BEGIN LABEL L1,L2,EXIT; 05334000
LABEL L3; %M05334100
REAL GSO,CONSEC; %M05334200
BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000
BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000
BOOLEAN M,Q; 05343000
INTEGER ROW,COL,GS; 05344000
COMMENT MOREWORDS =1 IF DOUBLE OR COMPLEX %M05344100
=3 IF DOUBLE COMPLEX; %M05344200
IF PERMANENT 05345000
THEN BEGIN 05346000
IF PRTIMAX+MOREWORDS>1023 THEN FLAG(148); %M05347000
SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000
OR SPRT[GS]; 05349000
PRTIMAX~(GS~PRTIMAX)+MOREWORDS+1 END %M05350000
ELSE IF MODE = 0 THEN BEGIN 05351000
Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000
M ~ MASK(COL ~ PRTI.[43:5]-35); 05353000
COL ~ COL+35; 05354000
L1: IF REAL(M AND Q) ! 0 05355000
THEN BEGIN L3: %M05356000
IF REAL(BOOLEAN(GS~4294967296-REAL(M)) AND Q) = GS 05357000
THEN BEGIN 05358000
COL ~ 0; M ~ TRUE; 05359000
IF ROW ~ ROW+1 > 31 05360000
THEN BEGIN FLAG(148); GS ~ PRTIMAX; 05361000
GO TO L2 END; 05362000
Q ~ SPRT[ROW]; 05363000
GO TO L1 END; 05364000
COL ~ COL+1; M ~ BOOLEAN(REAL(M)+REAL(M)); 05365000
GO TO L1 END; 05366000
PRTI ~ (GS ~ 32|ROW+COL)+1; 05367000
IF MOREWORDS!0 THEN BEGIN %M05367650
IF CONSEC=0 THEN BEGIN GSO~GS; CONSEC ~ 1; GO TO L3 END; %M05367700
IF GS-GSO! 1 THEN BEGIN CONSEC~0; GO TO L3 END; %M05367750
IF CONSEC<MOREWORDS THEN BEGIN CONSEC~CONSEC+1; %M05367800
GSO~GS; GO TO L3 END; %M05367850
GS ~ GS - MOREWORDS END; %M05367900
IF PRTI > PRTIMAX THEN PRTIMAX ~ PRTI END 05368000
ELSE BEGIN 05369000
IF STACKCTR+MOREWORDS>767 THEN FLAG(149); %M05370000
STACKCTR~(GS~STACKCTR)+MOREWORDS+1; Q ~FALSE; %M05371000
GO TO EXIT END; 05372000
L2: IF GS } 512 THEN GS ~ GS+1024; 05373000
Q ~ TRUE; 05374000
EXIT: GETSPACE ~ GS; 05375000
IF MARKSYM THEN BEGIN JUMPCHKX; EMITN(GS); %M05375100
IF NOT (PERMANENT OR SOPG) THEN BEGIN EMITO(DUP); %M05375125
EMIT(0); EMITO(XCH); EMITO(STD) END; %M05375150
IF PERMANENT THEN EMITNUM(TABLEMARKV~TABLEMARKV+1) ELSE %M05375200
BEGIN EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M05375300
EMITPAIR(TABLEMARK,SND); END; EMITN(PTABLE); %M05375400
EMITO(STD); %A05375500
IF NOT PERMANENT THEN SYMLOC ~ SYMLOC + 1 END; %A05375600
IF GS > 1023 THEN GS ~ GS-1024; 05376000
IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100
END GETSPACE; 05378000
COMMENT ARRAYCHECK CHECKS A PARAMETER-INFO WORD FOR SORT/MERGE; 05379000
BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000
ARRAYCHECK~AAW.CLASS<BOOARRAYID OR AAW.CLASS>INTARRAYID 05381000
OR AAW.INCR !1; 05382000
COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000
BOOLEAN PROCEDURE COMMACHECK; 05384000
BEGIN IF NOT(COMMACHECK~(STEPI=COMMA)) THEN ERR(350); 05385000
STEPIT 05386000
END COMMACHECK; 05387000
COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000
BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000
BEGIN %B05389100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05389200
IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000
IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK~TRUE ELSE 05390100
IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(357) ELSE 05391000
IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000
HVCHECK~TRUE; 05393000
END; %B05393500
COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000
BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000
BEGIN %B05395100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05395200
IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000
IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100
IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000
IF TAKE(GT1+1).CLASS!BOOID THEN ERR(353) ELSE 05398000
IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000
OUTPROCHECK~TRUE; 05400000
END; %B05400500
COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000
BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000
BEGIN %B05402100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05402200
IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000
IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100
IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000
IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000
IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000
EQLESCHECK~TRUE; 05407000
END; %B05407500
PROCEDURE ALFP(V); VALUE V ; REAL V; %A05408000
BEGIN REAL T; %A05409000
EMITO(MKS); %A05410000
EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 %A05411000
ELSE CPLUS1); %A05412000
T ~ BUMPL; %A05413000
EMITWORD(V); %A05414000
EMITB(BFW,T,L); %A05414500
EMITV(ALFPRINT); %A05415000
END OF ALFP; %A05416000
% %A05417000
PROCEDURE ARGLIST(TALL); VALUE TALL; REAL TALL; %A05418000
BEGIN REAL N,J,S,T; INTEGER R,K; %A05419000
DEFINE FP2 = 514#; %A05419500
EMITO(MKS); %A05420000
IF N ~ TAKE(J~ GIT(TALL)) ! 0 THEN BEGIN %A05421000
R ~ 2 | N + 3; %A05422000
FOR S ~ 1 STEP 1 UNTIL N DO %A05423000
IF BOOLEAN((T~TAKE(J+S)).VO) AND %A05424000
(K ~ T.CLASS = SYMID OR %A05425000
K = REALID OR K = BOOID) THEN BEGIN %A05426000
EMITL(T.ADDRESS + R); %A05427000
EMITL(IF K = REALID THEN 0 ELSE %A05428000
IF K = BOOID THEN 2 ELSE 4) END %A05429000
ELSE BEGIN EMITL(FP2); EMITL(6); END; %A05430000
END; %A05431000
MKALF(TALL); %A05432000
EMITL(N); %A05433000
EMITV(MONPRO); %A05434000
END OF ARGLIST; %A05435000
% %A05436000
PROCEDURE CHKND; %A05437000
IF NCR = LCR THEN BEGIN %A05438000
READACARD; %A05439000
IF LIBINDEX ! 0 THEN %A05440000
IF RECOUNT = FINISHPT THEN BEGIN %A05441000
SEARCHLIB(FALSE); READACARD; %A05442000
NORELEASE ~ FALSE END END; %A05443000
% %A05444000
BOOLEAN PROCEDURE DECLCHECK; %A05445000
DECLCHECK ~ IF ELBAT[I].ADDRESS=DOUBLEV AND %A05446000
ELCLASS = DECLARATORS THEN %A05446500
TABLE(I+1)! LEFTPAREN ELSE TRUE; %A05447000
% %A05448000
REAL PROCEDURE FORAD; %A05449000
BEGIN REAL VRET; %A05450000
FORLEVEL ~ FORLEVEL + 1 + REAL(RECLAIMTOG); %A05450500
IF MODE = 0 OR MARKSYM THEN BEGIN %A05451000
IF FORAD ~ FRD[ FRLEVEL].[11:11] = 0 THEN %A05452000
FRD[FRLEVEL].[11:11] := (FORAD:=GETSPACE(TRUE,-1)) END ELSE %T9305453000
BEGIN IF FORAD ~ (VRET ~ FRD[ FRLEVEL]).[22:11] = 0 OR %A05454000
VRET.[33:15] ! SGNO THEN %A05455000
FRD[ FRLEVEL] ~ VRET & SGNO[33:33:15] & %A05456000
(FORAD := GETSPACE(FALSE,-1))[22:37:11] END; %T9305457000
END OF FORAD; %A05458000
% %A05459000
INTEGER PROCEDURE GETLIT(B); VALUE B; REAL B; %A05460000
IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %A05461000
IF GETLIT ~ C > B THEN FLAG(605); STEPIT END ELSE ERR(605); %A05462000
% %A05463000
REAL PROCEDURE GETYPE(T); VALUE T; REAL T; %A05464000
GETYPE ~ TAKE(((TAKE((T ~ T.LINK)+1).[12:6]+18) DIV 8) + T); %A05465000
% %A05466000
PROCEDURE LITF(B); VALUE B; REAL B; %A05467000
BEGIN %A05468000
REAL R; %T9005468500
SLT ~ FALSE; %A05469000
IF STEPI = LEFTPAREN THEN BEGIN %A05470000
QUOTETOG~FALSE; STEPIT; R~ACCUM[1]; %T9005471000
IF ELCLASS=LITNO AND TABLE(I+1)=RTPAREN THEN BEGIN %T9005472000
IF SL ~ ELBAT[I].ADDRESS > B OR SL = 0 THEN BEGIN %A05473000
FLAG(605); %A05474000
ERRORTOG ~ TRUE; SL ~ 1 END; %A05475000
STEPIT; STEPIT END ELSE %A05476000
BEGIN %A05477000
ACCUM[1] ~ R; %T9005477500
AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); %A05478000
SLT ~ TRUE; %A05479000
RTPARN END; %A05480000
QUOTETOG ~ TRUE; END ELSE SL ~ 1; %A05481000
END OF LITF; %A05482000
% %A05483000
BOOLEAN PROCEDURE LITP(T); INTEGER T; %A05484000
BEGIN REAL R,S; %A05485000
IF (ELCLASS = LITNO OR ELCLASS = NONLITNO %A05486000
OR ELCLASS = STRNGCON) THEN %A05487000
IF (S ~ C).[1:37] = 0 THEN %A05488000
IF LITP ~ R ~ TABLE(I+1) = COMMA OR R = RTPAREN THEN %A05489000
BEGIN T ~ S; STEPIT END ELSE C ~ S; END; %A05490000
% %A05491000
BOOLEAN PROCEDURE MAKEROW; %A05492000
IF ELCLASS < BOOARRAYID THEN STRINGVAR( TRUE) ELSE %A05493000
BEGIN VARIABLE(FL); %A05494000
MAKEROW ~ TABLE(I-2)! FACTOP END; %A05495000
% %A05496000
REAL PROCEDURE NEWP(T); VALUE T; REAL T; %A05497000
NEWP ~ IF TAKE(T.LINK+1).[2:2]=2 THEN 3 ELSE 1; %A05498000
% %A05499000
PROCEDURE NOGO; %A05500000
IF RECLAIMTOG THEN BEGIN FLAG(626); ERRORTOG ~ TRUE END; %A05501000
%A05502000
BOOLEAN PROCEDURE NOTCOMMA; %A05503000
IF NOTCOMMA ~ ELCLASS ! COMMA THEN %A05504000
ERR(606) ELSE STEPIT; %A05505000
% %A05506000
PROCEDURE PROPER(V); VALUE V; REAL V; %A05507000
BEGIN LABEL EXIT; %A05508000
% MEANING OF V: 0 - SYMBOL, 1 - RECORD, 2 - NUMBER %A05509000
IF STEPI ! LEFTPAREN THEN BEGIN %A05510000
ERR(105); GO EXIT END; %A05511000
QUOTETOG~ TRUE; %A05512000
EMITO(MKS); STEPIT; SEXPN; %A05513000
IF ELCLASS ! COMMA AND V < 2 THEN BEGIN %A05514000
ERR(606); GO EXIT END; %A05515000
IF V=0 THEN BEGIN EMITL(2); QUOTETOG ~ TRUE; %A05516000
STEPIT; SEXPN; QUOTETOG ~ FALSE END ELSE %A05517000
IF V = 1 THEN BEGIN EMIT(0); QUOTETOG ~ FALSE; %A05518000
IF STEPI ! DECLARATORS OR %A05519000
RECTYPE ~ ELBAT[I].ADDRESS < 30 THEN %A05520000
BEGIN RECTYPE ~ 0; %A05521000
ERR(608); GO EXIT END; %A05522000
EMITNUM(RECTYPE&1[32:47:1]); END ELSE %A05523000
BEGIN EMITL(1); EMITL(3); QUOTETOG ~ FALSE END; %A05524000
IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT; %A05525000
EXIT: QUOTETOG ~ FALSE; RECTYPE ~ 0; %A05526000
EMITV(PROPA); %A05527000
END OF PROPER; %A05528000
% %A05529000
PROCEDURE PUTADR(P,R); VALUE P,R; REAL R,P; %A05530000
PUT(TAKE(P)&R[16:37:11],P); %A05531000
% %A05532000
PROCEDURE RCH(R,A,BV,B,T,OP); %A05533000
VALUE R,A,BV,B,T,OP; BOOLEAN R,BV; %A05534000
REAL A,B,T,OP; %A05535000
BEGIN %B05535100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B05535200
IF R THEN BEGIN %A05536000
ECR(A,CRF); EC(0,OP); %A05537000
IF BV THEN BEGIN ECR(B,CRF); %A05538000
EC(3,BNS); EC(32,OP); %A05539000
EC(32,OP); EC(0,ENS); END END ELSE %A05540000
BEGIN %A05541000
IF B ~ T.[42:6] ! 0 THEN EC(B,OP); %A05542000
IF B ~ T.[36:6] ! 0 THEN BEGIN EC(B,BNS); EC(32,OP); EC(32,OP);%A05543000
EC(0,ENS) END %A05544000
END; %B05544500
END OF RCH; %A05545000
% %A05546000
BOOLEAN PROCEDURE ROWD(BV); VALUE BV; BOOLEAN BV; %A05547000
BEGIN IF BV THEN STEPIT; %A05548000
IF ELCLASS = RECARRAYID OR ELCLASS=SYMARRAYID THEN BEGIN %A05548100
ROWD ~ TRUE; %A05548150
ELBAT[I].CLASS ~ ELCLASS ~ REALARRAYID END ELSE %A05548200
ROWD ~ (ELCLASS} BOOARRAYID AND ELCLASS { INTARRAYID) %A05549000
OR ELCLASS= STRINGID OR ELCLASS = STRINGARRAYID END; %A05550000
% %A05551000
PROCEDURE SYMAC; %A05552000
BEGIN REAL T; %A05553000
I ~ I - 1; %A05554000
DO BEGIN %A05555000
IF STEPI = SYMID OR ELCLASS = SYMARRAYID OR %A05556000
ELCLASS = SYMPROCID THEN BEGIN %A05557000
PUT(-TAKE(T~ ELBAT[I]),T); %A05558000
PUTNBUMP(T & FACTOP [2:41:7] & (NEXTINFO-LASTINFO)[27:40:8]); %A05558100
LASTINFO ~ NEXTINFO - 1; %A05558150
STEPIT END %A05558200
ELSE ERR(406); %A05559000
END UNTIL ELCLASS ! COMMA; %A05560000
END OF SYMAC; %A05561000
% %A05562000
PROCEDURE SYMONITOR(BV,TALL,N,V); VALUE BV,TALL,N,V; %A05563000
BOOLEAN BV; REAL TALL,N,V; %A05564000
BEGIN %A05565000
% CALLS ON SYMONITOR: %A05566000
% SIMPLE VARIABLE SYMONITOR(TRUE,TALL,0,0) %A05567000
% SYMBOL PROCEDURE SYMONITOR(TRUE,TALL,0,5) %A05568000
% ARRAY SYMONITOR(FALSE,TALL,N,0) %A05569000
IF BV THEN EMITO(MKS); %A05570000
EMITV(JUNK); MKALF(TALL); %A05571000
EMITL(N); EMITL(V); %A05572000
EMITV(MONSYM); %A05573000
END OF SYMONITOR; %A05574000
% %A05575000
PROCEDURE CALLSF(R); VALUE R; REAL R; %A05586000
BEGIN REAL T,P; LABEL EXIT; %A05587000
CHECKER(R); EMITO(MKS); STEPIT; %A05587500
IF P ~ SFTRC.[15:11] ! 0 THEN BEGIN EMITV(P); %A05588000
T ~ BUMPL; EMITO(MKS); %A05589000
MKALF(R); EMIT(0); EMITV(MONPRO); %A05590000
EMITB(BFC,T,L) END; %A05590100
IF NOT BOOLEAN(R).FORMAL THEN %A05590200
IF TAKE(T~GIT(R)).[40:8]!0 THEN BEGIN %A05590300
IF ELCLASS ! LEFTPAREN THEN BEGIN ERR(128); GO EXIT END; %A05590400
ACTUALPARAPART(FALSE,FALSE,T); END; %A05590500
EMITV(R.ADDRESS); %A05591000
IF P!0 THEN BEGIN EMITV(P);T~BUMPL;EMITO(DUP);EMITI(0,46,2); %A05591500
EMITPAIR(JUNK,STD); SYMONITOR(TRUE,R,0,4); %T9305592000
EMITB(BFC,T,L) END; %A05593000
EXIT: %A05594000
END OF CALLSF; %A05595000
% %A05596000
PROCEDURE FIXCLASS(CL,AD,B); VALUE CL,AD,B; REAL CL,AD; %A05597000
BOOLEAN B; %A05598000
BEGIN REAL T;% %A05599000
IF B THEN% %A05601000
IF B.[46:1] THEN% %A05601100
IF STEPI ! LEFTPAREN THEN ERR(105) ELSE BEGIN% %A05601150
IF STEPI = FILEID THEN BEGIN% %A05601200
IF TAKE((T~ELBAT[I]).LINK+1).[2:2] = 0 THEN FLAG(662)% %A05601250
ELSE ADDRSF ~ TAKE(GIT(T)).[26:11];% %A05601300
AD ~ ADDRSF ~ IF AD = "8FREEL" THEN ADDRSF ELSE ADDRSF+1;% %A05601350
END ELSE% %A05601400
IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SYMV% %A05601450
AND AD ! "8FREEL" AND SYMSTK THEN ADDRSF ~ AD ~ LNKROW% %A05601500
ELSE BEGIN ERR(662); I ~ I - 1 END;% %A05601550
IF STEPI ! RTPAREN THEN ERR(104) END ELSE% %A05601600
IF (T ~ ACCUM[1]).[12:6] = 5 THEN% %A05601650
IF T ~ T.[18:6] = "L" THEN AD ~ LMARG ELSE %A05602000
IF T = "R" THEN AD ~ RMARG ELSE ERR(100) ELSE %A05603000
IF T.[12:6] = 6 THEN %A05604000
IF T ~ T.[18:6] = "L" THEN AD ~ LMARGI ELSE %A05605000
IF T = "R" THEN AD ~ RMARGI ELSE ERR(100) %A05606000
ELSE ERR(100); %A05607000
ELCLASS ~ CL;% %A05607500
ELBAT[I] ~ ELBAT[I] & CL[2:41:7] & AD[16:37:11] %A05608000
END OF FIXCLASS; %A05609000
% %A05610000
PROCEDURE GTLSTAT; %A05611000
BEGIN REAL R; %A05612000
IF DACOMO = 0 THEN DACOMO := GETSPACE(TRUE,-6); %T9305613000
IF DAC[9] = 0 THEN BEGIN DAC[9] := GETSPACE(TRUE,-1); %T9305614000
IF DACP.LINK = 0 THEN FLAG(653); % %T9005619000
% %T9005620000
END; %A05620500
END OF GTLSTAT; %A05621000
% %A05622000
BOOLEAN PROCEDURE BASICMATRIX; %A05623000
BEGIN REAL A,B,T; LABEL LC,LR,EXIT; BASICMATRIX ~ TRUE; %A05624000
IF TAKE(GIT(A~ELBAT[I])).[40:8] = 2 THEN BEGIN %A05625000
EMITO(MKS); EMITPAIR(A.ADDRESS,LOD); BASICMATRIX ~ FALSE; %A05626000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(717); GO EXIT END; %A05627000
IF STEPI = REALARRAYID THEN BEGIN %A05628000
IF TAKE(GIT(A~ELBAT[I])).[40:8] ! 2 THEN GO LR; %A05629000
EMITPAIR(A.ADDRESS,LOD); END ELSE %A05630000
IF ELCLASS = LITNO THEN T ~ MATINV ELSE BEGIN % %A05631000
EMIT (0); % %A05631100
IF T ~ ACCUM[0] = "3ZER00" THEN B ~ 64 ELSE % %A05631200
IF T = "3CON00" THEN B ~ 68 ELSE % %A05631300
IF T = "3IDN00" THEN B ~ 72 ELSE GO LR; % %A05631400
EMIT (B); % %A05631500
EMITV (5); % %A05631600
STEPIT; % %A05631700
GO EXIT; % %A05631800
END; % %A05631900
IF STEPI < ADOP THEN BEGIN EMIT(4); EMITO(XCH); B ~ 2; %T9005632000
IF T ! 0 THEN GO LR; T ~ MATDID; GO LC END; %A05633000
IF ELCLASS = FACTOP THEN T ~ MATTRN ELSE BEGIN %A05634000
IF ELCLASS = ADOP THEN BEGIN B ~ ELBAT[I].[21:1]; %A05635000
T ~ MATDID END ELSE %A05636000
IF BOOLEAN(ELBAT[I].[20:1]) THEN T ~ MATMUL ELSE %A05637000
IF T ! MATINV THEN GO LR; %A05638000
IF STEPI = REALARRAYID AND TABLE(I+1) ! LFTBRKET THEN BEGIN %A05639000
IF TAKE(GIT(A~ELBAT[I])).[40:8] ! 2 THEN GO LR; %A05640000
EMITPAIR(A.ADDRESS,LOD) END ELSE %A05641000
IF T = MATMUL THEN BEGIN PRIMARY; T ~ MATDID; B ~ 2; %A05642000
EMITO(XCH); GO LC END ELSE GO LR END; %A05643000
STEPIT; %A05644000
LC: IF T = MATDID THEN EMITL(B); EMITV(GNAT(T)); %A05645000
GO EXIT; %A05646000
LR: ERR(725) END; %A05647000
EXIT: END OF BASICMATRIX; %A05648000
% %A05649000
COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000
COMMENT AEXP IS THE ARITHMETIC EXPRESSION ROUTINE; 06001000
PROCEDURE AEXP; 06002000
BEGIN 06003000
IF ELCLASS=CROSSHATCH THEN BEGIN %W5206003200
STEPIT; SIMPARITH END ELSE %W5206003400
IF ELCLASS=CASEV THEN CASESTMT(7) ELSE %M06003500
IF ELCLASS = IFV 06004000
THEN IFXP(ATYPE) %M06005000
ELSE BEGIN ARITHSEC; SIMPARITH END 06006000
END AEXP; 06007000
COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000
IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000
AND Q ARE PRIMARIES; 06010000
PROCEDURE ARITHSEC; 06011000
BEGIN 06012000
IF ELCLASS = ADOP 06013000
THEN BEGIN 06014000
STEPIT; 06015000
IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000
ELSE BEGIN 06017000
PRIMARY; 06018000
WHILE ELCLASS = FACTOP DO %WF 06019000
BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000
ENDTOG ~ LINKTOG; EMITO(CHS); 06021000
LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END 06022000
ELSE PRIMARY END ARITHSEC; 06023000
COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000
ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000
COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000
WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000
COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000
SIMPARITH IS DONE BY ARITHCOMP, AN ARTIFIAL ROUTINE 06029000
WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000
ARITHCOMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000
PROCEDURE SIMPARITH; 06032000
BEGIN 06033000
WHILE ELCLASS = AMPERSAND 06034000
DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000
WHILE ELCLASS}ADOP AND ELCLASS{FACTOP DO ARITHCOMP END; 06036000
COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000
ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000
EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000
IS OBTAINED BY RECURSION; 06040000
PROCEDURE ARITHCOMP; 06041000
BEGIN INTEGER OPERATOR, OPCLASS; 06042000
DO BEGIN 06043000
OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06044000
COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000
ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000
OF THE ELBAT WORD; 06047000
OPCLASS ~ ELCLASS; 06048000
STEPIT; PRIMARY; 06049000
IF OPCLASS = FACTOP THEN EMITUP 06050000
ELSE BEGIN 06051000
WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000
COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000
STACKCT ~ 1; %A 06053500
EMIT(OPERATOR) END 06054000
END UNTIL OPCLASS ! ELCLASS END ARITHCOMP; 06055000
COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 06056000
PROCEDURE IMPFUN; 06057000
BEGIN 06058000
REAL T1; 06059000
REAL R; DEFINE PUT = PUTADR#; %M06059500
LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000
L11,L12,L13,L14,L15,L16,L17,L20,L21,L22,L23,L24,L25,L26, %M06060025
L27,L30,L31,L32,L33,L34,L35,L36,RP,L37, %M06060050
MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100
SWITCH S ~ ABS, SIGN, ENTIER, TIME, STATUS,% 06061000
MAXANDMIN,MAXANDMIN,DELAY,L11,L12,L13,L14,L15,L16,L17,L20, %M06061100
L21,L22,L23,L24,L25,L26,L27,L30,L31,L32,L33,L34,L35,L36,L37; %M06061150
DEFINE MAXV = 6#;% 06061200
GO TO S[ELBAT[I].[27:6]];% 06062000
OTHERS: T1 ~ ELBAT[I]; 06063000
EMITO(MKS); 06064000
PANA; 06065000
IF R ~ T1.ADDRESS = 0 THEN BEGIN %M06065100
IF R:=TAKE(T1.LINK+T1.[33:2]).[3:6] = 0 THEN %T9306065200
R := GETSPACE(TRUE,T1.LINK+1); %T9306065250
PUTADR(T1,R) END; %M06065300
EMITV(R); GO TO EXIT; %M06066000
ABS: IF STEPI! LEFTPAREN THEN BEGIN ERR(105);GO EXIT END ELSE STEPIT; %M06067000
T1 ~L; EMITO(NOP); IF PLXP(FALSE) <4 THEN EMITO(SSP) ELSE %M06067100
BEGIN R ~ L; L ~ T1; EMITO(MKS); L ~ R; EMITV(GNATP(8)); %M06067200
END; GO RP; %M06067300
SIGN: PANA; 06068000
EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000
EMITD(1,1,1); GO TO EXIT; 06070000
L11: IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %M06070010
EMITO(MKS); PLXPN(FALSE); EMITV(36); PUTADR(551,36); %M06070020
PUTADR(429,31); %M06070030
RP: IF ELCLASS! RTPAREN THEN ERR(104) ELSE STEPIT; GO EXIT; %M06070040
L12: EMITO(MKS); PANA; EMITV(26); FORTERR; PUT(554,26); PUT(452,25); %A06070050
GO TO EXIT; % %A06070055
L13: EMITO(MKS); PANA; EMITV(32); PUT(561,32); PUT(449,28); %A06070060
FORTERR; GO TO EXIT; % %A06070065
L14: EMITO(MKS);PANA; EMITV(GNAT(564));PUT(558,30); %M06070070
GO EXIT; %M06070080
L15: EMITO(MKS);PANA;FORTERR;PUT(554,26);EMITV(GNAT(567));GO EXIT; %A06070090
L16: T1 ~ ELBAT[I]; EMITO(MKS); PANA; PUT(440,27); %M06070100
FORTERR; %A06070105
EMITV(GNAT(T1)); GO EXIT; %M06070110
L17: EMITO(MKS);PANA;FORTERR;PUT(443,29);EMITV(GNAT(583));GO EXIT; %A06070120
L20: PANDBL(TRUE); EMITV(GNATP(6)); EMITO(DEL); EMITV(JUNK); %M06070130
GO EXIT; %M06070140
L21: IF R ~ PANPLX(FALSE,FALSE) < 4 THEN %M06070150
IF BOOLEAN(R) THEN BEGIN %M06070160
IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END %M06070170
ELSE BEGIN EMITO(DEL); EMIT(0) END ELSE %M06070180
IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(XCH); %M06070190
EMITO(DEL); IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END %M06070200
ELSE BEGIN EMITO(DEL); %M06070210
IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END; GO EXIT; %M06070220
L22: IF R ~ PANPLX(FALSE,FALSE) < 4 THEN %M06070230
IF BOOLEAN(R) THEN BEGIN EMITO(DEL); EMIT(0) END ELSE %M06070240
BEGIN IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %M06070250
IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(DEL); %M06070260
IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END ELSE %M06070270
BEGIN EMITO(XCH); EMITO(DEL); %M06070280
IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END; GO EXIT; %M06070290
L23: PANDBL(FALSE); EMITO(XCH); EMITO(DEL); GO EXIT; %M06070300
L24: PANDBL(FALSE); EMITO(DEL); GO EXIT; %M06070310
L25: FIXCLASS(INTID,TABR,FALSE); %A06070320
VARIABLE(FP); GO EXIT; %A06070325
L26: FIXCLASS(INTID,COLR,FALSE); %A06070330
VARIABLE(FP); GO EXIT; %A06070335
L27: FIXCLASS(REALID,INREAL,FALSE); VARIABLE(FP); GO EXIT; %A06070340
L30: EMITO(MKS); EMITN(JUNK); EMITV(STRI); %M06070350
EMITO(PRTE); EMITO(LOD); EMITV(FILPROI); EMITO(PRTE); %M06070355
EMITO(LOD); EMITV(SCANR); STEPIT; GO EXIT; %M06070357
L31: IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %M06070360
EMITO(MKS); STEPIT; %M06070365
EMITPAIR(GNAT(POWERSOFTEN),LOD); BEXP; EMITV(READCON); %M06070370
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); GO EXIT; %M06070380
L32: IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A06070390
QUOTETOG ~ TRUE; IF STEPI = STRTRNS AND ELBAT[I].INCR } 8 THEN %M06070400
BEGIN %M06070405
EMITV(IF BOOLEAN(ELBAT[I].[34:1]) THEN COUNTI ELSE NSTR); %M06070410
STEPIT END ELSE %M06070420
IF (ELCLASS = STRINGID OR ELCLASS=STRINGARRAYID) %M06070425
AND BOOLEAN(ELBAT[I].FORMAL) THEN BEGIN %M06070430
EMITV(ELBAT[I].ADDRESS - REAL(ELCLASS=STRINGID AND %M06070435
NOT BOOLEAN(ELBAT[I].VO))-1); STEPIT END ELSE %A06070436
BEGIN EMITO(MKS); SEXPN; EMITV(LENGTHV) END; %M06070437
QUOTETOG ~ FALSE; IF ELCLASS! RTPAREN THEN ERR(104) ELSE STEPIT; %M06070438
GO EXIT; %M06070440
L33: PROPER(2); GO EXIT; %M06070450
L34: PANSYM(FALSE,FALSE); QUOTETOG~FALSE; GO EXIT; %M06070460
L35: IF STEPI!LEFTPAREN THEN %M06070470
BEGIN ERR(105); GO EXIT END; %M06070472
QUOTETOG~TRUE; STEPIT; GETCONTENTS(SNORM(SEXP),FALSE); %M06070474
QUOTETOG~FALSE; IF ELCLASS=RTPAREN THEN %M06070476
STEPIT ELSE ERR(104); GO EXIT; %M06070478
L36: EMITCONVAL; GO EXIT; %M06070480
L37: EMITO(MKS); IF STEPI = LEFTPAREN THEN BEGIN STEPIT; %A06070490
IF Q ~ ACCUM[1] = "3TWX00" THEN EMITL(5) ELSE %A06070510
IF Q = "4TWXA0" THEN EMITL(10) ELSE FLAG(665); %A06070520
IF STEPI! RTPAREN THEN ERR(104) ELSE STEPIT END ELSE EMIT(0); %A06070530
EMIT(0); EMITV(READN); GO EXIT; %A06070540
ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000
EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000
MAXANDMIN:% 06072010
T1 ~ ELBAT[I].[27:6];% 06072020
IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030
BEGIN STEPIT; AEXP;% 06072040
WHILE ELCLASS=COMMA DO% 06072050
BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060
EMITPAIR(JUNK, SND);% 06072070
IF T1=MAXV THEN EMITO(LSS) ELSE EMITO(GTR); 06072080
EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090
END;% 06072100
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110
END;% 06072120
GO TO EXIT;% 06072130
DELAY: IF STEPI!LEFTPAREN THEN% 06072200
BEGIN ERR(105); GO TO EXIT END;% 06072210
STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220
BEGIN ERR(165); GO TO EXIT END;% 06072230
STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240
BEGIN ERR(165); GO TO EXIT END;% 06072250
STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260
BEGIN ERR(104); GO TO EXIT END;% 06072270
EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280
GO TO EXIT;% 06072290
TIME: PANA; EMITL(1); EMITO(COM); 06073000
GO TO EXIT; 06073100
STATUS: IF STEPI ! LEFTPAREN THEN BEGIN IF DACP ! 0 THEN %A06073200
IF DAC[10]!0 THEN BEGIN EMITV(DAC[10]); GO EXIT END; %A06073210
ERR(105); GO EXIT END; %A06073220
IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250
BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300
EMITPAIR(32, COM); T1~3; 06073350
END ELSE BEGIN EMIT(4); EMIT(0); T1~0; 06073400
IF ELCLASS}BOOARRAYID AND ELCLASS{INTARRAYID THEN 06073450
BEGIN T1~FI; VARIABLE(T1); END ELSE AEXP; 06073500
IF T1=FI THEN 06073550
BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1~3 06073600
END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650
BEGIN EMIT(0); EMITPAIR(32, COM); T1~3 END 06073700
ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750
EMITO(XCH); EMITO(DEL); 06073800
IF ELCLASS!COMMA THEN 06073810
BEGIN ERR(129); GO TO EXIT END; 06073820
STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830
END; END; END; 06073840
GTI1~0; 06073845
DO EMITO(DEL) UNTIL GTI1~GTI1+1=T1;% 06073850
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860
GO TO EXIT; 06073870
EXIT: END IMPFUN; 06074000
COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000
OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000
DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000
CASES; 06078000
PROCEDURE PRIMARY; 06079000
BEGIN 06080000
REAL R; DEFINE V = IF ARRAYFLAG THEN CHECKBOUNDLVL#; %M06080500
LABEL 06081000
LSTR,LSYM,LDP,LE, LF, %M06081500
LTR, %M06081600
L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000
L30, L31, L32, L33, L34, L35; 06084000
SWITCH SF ~ LE,LE,LSTR,LDP,LSYM,LE,LE,LF,LF,LF; %M06084500
SWITCH S ~ 06085000
LSYM,LE,LE, %A06085500
L11,LSYM,LTR,LSTR,LDP,LSYM,LE,L13,L14,L15,L16,LSTR,LDP,LSYM, %M06086000
LE,L17,L18,L19,L20,LSTR,LDP,LSYM,LE,L21,L22,L23,L24,LSTR, %M06087000
LDP,LSYM,LE,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34,LE,LE, %M06088000
LSYM,L35,LSYM; %M06088500
COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000
INTEGER SL; %W5206089500
LABEL EXIT,RP,LDOT,LAMPER; 06090000
IF ELCLASS=FIELDID THEN BEGIN %M06090100
IF R ~ ELBAT[I].ADDRESS > 10 THEN GO LE; %M06090200
GO TO SF[R] END; %M06090300
GO TO S[ELCLASS-16]; %A06091000
IF ELCLASS=RELOP THEN BEGIN QUOTETOG ~ TRUE; STEPIT; %A06091100
EMITNUM(SFTERM(FALSE)); GO TO LAMPER END; %A06091150
IF ELCLASS=FACTOP THEN %W5206091200
IF LINKTOG THEN % LAST SYLLABLE IS NOT A LINK %W5206091300
IF (SL~GET(L-1)).[46:2]=3 OR SL=673 THEN BEGIN %LOOK FOR DESC OR CDC%W5206091400
ELBAT[I].CLASS~ELCLASS~CROSSHATCH; STEPIT; %W5206091500
EMITO(DUP); EMITO(LOD); GO EXIT END; %W5206091600
%T9206092000
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005
BEGIN 06092010
IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015
GO TO LAMPER ; 06092020
END ; 06092025
IF ELCLASS = UNKNOWNID THEN %T9206092099
IF (R ~ ACCUM[1]).[24:24] = "MARG" THEN BEGIN% %A06092100
FIXCLASS(INTID,0,TRUE); VARIABLE(FP); GO TO LDOT END %A06092200
ELSE IF R = "4JUNK0" THEN BEGIN STEPIT; EMITV(JUNK);GO LDOT END %T2906092201
ELSE IF R = "#LINEN" THEN BEGIN C~CARDNUMBER;GO L33 END %T9306092205
ELSE IF R = "3TEN00" THEN BEGIN BANA; EMITPAIR(JUNK,ISN); %T9306092210
EMITV(GNAT(POWERSOFTEN)) %T9306092213
; GO LDOT; % %A06092215
END ELSE %T9206092220
IF R = "6SERIA" OR R = "7CANTU" THEN %T9206092222
BEGIN C ~ 0; GO L33; END ELSE %T9206092224
IF R = "6UPDAT" THEN BEGIN C~2; GO L33; END ELSE %T9206092226
IF R = "6RANDO" THEN BEGIN C ~1;GO L33; END ELSE %T9206092228
IF R = "2IO000" THEN BEGIN C~3; GO L33; END %T9206092230
ELSE IF R = "6SEARC" THEN BEGIN STRINGSEC(9); GO LDOT END 06092250
ELSE IF R = "8FREEL" OR R = "7NEXTA" THEN BEGIN% %A06092300
FIXCLASS (INTID,R,BOOLEAN(3)); VARIABLE(FP);% %A06092400
GO LDOT END ELSE ERR (100);% %A06092450
LTR: IF R ~ ACCUM[1] = "5INPUT" OR R = "6OUTPU" THEN %T9206092500
BEGIN C ~ 1 + REAL(R = "6OUTPU"); GO L33; END; %T9206092550
LE: %T9206092600
L12: L13: L17: L21: L25: L29: L30: 06093000
COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000
ERR(103); GO TO EXIT; 06095000
LDP: IF TAKE(ELBAT[I].LINK+1).[2:2] =0 THEN BEGIN V; %M06095100
DBLPRIM; DBLTSNGL(0); GO TO LDOT END; GO LE; %M06095150
LSTR: STRINGSEC(5); GO TO LDOT; %M06095200
LSYM: IF GT1 ~ SYMPRIM(TRUE) = 5 THEN GO LE ELSE %M06095250
IF GT1 = 4 THEN EMITNUM(SAVEQ) ELSE %M06095300
IF GT1 < 3 THEN BEGIN SDNORM(GT1); EMITO(MKS); EMITV(ATN); %M06095350
END; QUOTETOG ~ FALSE; GO TO LDOT; %M06095550
LF: V; FIELDC(ELBAT[I],0,FALSE); GO TO LAMPER; %M06095600
L11: 06096000
COMMENT INTRINSIC FUNCTIONS; 06097000
IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A 06098000
L14: L15: L16: 06099000
COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100
STRMPROCSTMT; GO TO LDOT; 06101000
L18: L19: L20: 06102000
COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100
PROCSTMT(FALSE); GO TO LDOT; 06104000
L22: L23: L24: L26: L27: L28: 06105000
COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100
VARIABLE(FP); GO TO LAMPER; 06107000
L32: 06108000
COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000
EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000
L31: L33: 06111000
COMMENT STRINGS AND NONLITERALS; 06112000
EMITNUM(C); STEPIT; GO TO LAMPER; 06113000
L35: 06114000
COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000
EXPRESSION - OTHERWISE AN ERROR; 06116000
IF ELBAT[I].ADDRESS = INTV THEN BEGIN PANA; %M06116100
EMITPAIR(JUNK,ISN); GO TO LDOT END; %M06116200
IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000
IF STEPI ! LEFTPAREN 06118000
THEN BEGIN ERR(105); GO TO EXIT END; 06119000
IF STEPI = STRINGPROCID OR ELCLASS = STRINGID OR %M06120000
(ELCLASS = STRTRNS AND ELBAT[I].INCR } 8) OR %A06120050
(ELCLASS=FIELDID AND ELBAT[I].ADDRESS=STRINGV) OR %A06120070
(ELCLASS } BOOARRAYID AND ELCLASS { INTARRAYID %T9006120080
AND TABLE(I+1) ! LFTBRKET) OR %T9106120090
ELCLASS = STRINGARRAYID THEN STRINGSEC(6) ELSE %A06120100
IF ELCLASS = RECID THEN BEGIN RECVAR(FALSE);% %A06120110
RECTYPE ~ 0 END ELSE BEXP;% %A06120120
GO TO RP END; %M06120200
ERR(106); GO TO EXIT; 06121000
L34: 06122000
COMMENT (; 06123000
STEPIT; AEXP; 06124000
STACKCT ~ STACKCT-1; %A 06124500
RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000
STEPIT; 06126000
LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000
LAMPER: STACKCT ~ STACKCT+1; %A 06128000
WHILE ELCLASS = AMPERSAND %A 06128500
DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000
COMMENT THIS CODE HANDLES CANCATENATES; 06130000
EXIT: END PRIMARY; 06131000
COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000
PROCEDURE BEXP; IF ELCLASS= CASEV THEN CASESTMT(3) ELSE %M06133000
IF ELCLASS= IFV THEN IFXP(BTYPE) ELSE %M06133250
IF EXPRSS! BTYPE THEN ERR(107); %M06133500
COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000
ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000
BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000
DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000
OR DESIGNATIONAL EXPRESSION; 06138000
INTEGER PROCEDURE EXPRSS; 06139000
BEGIN 06140000
IF ELCLASS = IFV 06141000
THEN BEGIN 06142000
IF EXPRSS ~ IFEXP = ATYPE 06143000
THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000
ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000
END EXPRSS; 06146000
COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000
EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000
AS EXPRSS REPORTS; 06149000
INTEGER PROCEDURE BOOSEC; 06150000
BEGIN BOOLEAN N; 06151000
IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000
IF ELCLASS=CROSSHATCH THEN GT4~BOOSEC~BTYPE ELSE %W5206152500
GT4 ~ BOOSEC ~ BOOPRIM; 06153000
IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000
COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000
RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000
IF GT4 ! BTYPE THEN ERR(109) 06157000
COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000
LOGICALLY NEGATED; 06159000
END END BOOSEC; 06160000
COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000
THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000
ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000
PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000
A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000
COMP, AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000
LYSIS USING RECURSION; 06167000
PROCEDURE SIMPBOO; 06168000
BEGIN 06169000
WHILE ELCLASS = AMPERSAND 06170000
DO BEGIN 06171000
STEPIT; 06172000
IF BOOPRIM! BTYPE THEN ERR(109); 06173000
PARSE END; 06174000
WHILE ELCLASS } EQVOP AND ELCLASS { ANDOP DO BOOCOMP 06175000
END BOOCOMP; 06176000
COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000
IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000
OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000
SION; 06180000
PROCEDURE BOOCOMP; 06181000
BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000
DO BEGIN 06183000
OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000
COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000
ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000
OF THE ELBAT WORD; 06187000
OPCLASS ~ ELCLASS; 06188000
STEPIT; 06189000
IF BOOSEC ! BTYPE 06190000
THEN BEGIN ERR(109); GO TO EXIT END; 06191000
WHILE OPCLASS < ELCLASS 06192000
DO IF ELCLASS { ANDOP THEN BOOCOMP 06193000
ELSE BEGIN ERR(110); GO TO EXIT END; 06194000
COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000
STACKCT ~ 1; %A 06195500
IF OPCLASS = IMPOP 06196000
THEN BEGIN 06197000
COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000
ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000
THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000
EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000
FUTURE. (SEE CODE FOR EMITLNG); 06202000
EMITLNG; 06203000
EMITO(LND); 06204000
EMITO(LNG); 06205000
EMIT(0); 06206000
L ~ L-1 END 06207000
ELSE EMIT(OPERATOR) 06208000
END UNTIL OPCLASS ! ELCLASS; 06209000
EXIT: END BOOCOMP; 06210000
COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000
DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000
INTEGER PROCEDURE BOOPRIM; 06213000
BEGIN INTEGER TYPE; 06214000
LABEL L9, 06215000
LSFP,LE,LSFM, %A06215100
LR1,LR2,LR3,LR4,LR5, %M06215250
LFIELD,LSTR,LDP,LDBL,LPLX,LDPX,LSYM,LREC,LBTRN,LBF,LR, %M06215500
BAS,LAS, % %T9106215750
L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000
L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000
L30, L31, L32, L33, L34, L35; 06218000
SWITCH S ~ L9, 06219000
L10,L12,LFIELD,LSTR,LDBL,LSYM,LREC,LBTRN,L11,LSYM,LE,LSTR, %M06220000
LDP,LSFP,LSFM,L13,L14,L15,L16,LSTR,LDP,LSYM,LREC,L17,L18, %A06221000
% %M06222000
L19,L20,LSTR,LDP,LSYM,LREC,L21,L22,L23,L24,LSTR,LDP,LSYM, %M06222100
LREC,L25,LAS,LAS,LAS,L29,L30,L31,L32,L33,L34,LR,LSYM,LSYM, %T9106222200
L35,LSYM; %M06222300
SWITCH SF ~ LPLX,LDPX,LSTR,LDBL,LSYM,LREC,LBF,L33,L33,L33; %M06222400
DEFINE V = IF ARRAYFLAG THEN CHECKBOUNDLVL#; REAL R; %M06222500
COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000
LABEL EXIT,D,TD,T; %M06224000
LABEL FAH ; 06224500
GO TO S[ELCLASS-SUPERFILEID]; 06225000
IF ELCLASS = ADOP THEN GO TO L11; 06226000
IF ELCLASS = COLON THEN %M06226500
IF DPTOG THEN GO TO LDPX ELSE GO TO LPLX; %M06226600
IF ELCLASS = UNKNOWNID THEN %A06227000
IF ACCUM[1].[24:24] = "MARG" THEN BEGIN %A06227100
FIXCLASS(INTID,0,TRUE); GO L33 END ELSE %A06227200
IF ACCUM[1] = "6TWXNU" THEN BEGIN STEPIT; EMITO(MKS); %A06227210
EMITL(15); EMIT(0); EMITV(READN); GO TD END ELSE %A06227220
IF ACCUM[1] = "5SEARC" THEN GO L33 ELSE ERR(100); %A06227300
IF ELCLASS = RELOP THEN GO L33; %A06227400
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500
BEGIN 06227510
BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520
GO FAH ; 06227530
END ; 06227540
LE: L10: L12: 06228000
COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000
EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000
ERR(111); GO TO EXIT; 06231000
L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000
THEN BEGIN PANA; GO TO TD END; 06233000
IF GT1= SYMV OR GT1 = LISTV THEN GO TO LSYM; %M06233100
IF GT1= INTV THEN GO L33; %M06233200
IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000
L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000
L31: L32: L33: 06236000
COMMENT ARITHMETIC TYPE STUFF; 06237000
IF DPTOG THEN GO TO LDBL; %M06237500
AEXP; 06238000
D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000
RELATION; 06240000
BOOPRIM ~ BTYPE; GO TO EXIT; 06241000
LFIELD: IF TYPE ~ ELBAT[I].ADDRESS > 29 THEN GO LREC; %M06241010
GO TO SF[TYPE]; %M06241020
COMMENT CHECK TO SEE IF AN ARRAY IS BEING USED IN STRING SYNTAX;%T9106241024
LAS: IF TABLE(I+1) ! LFTBRKET THEN GO BAS ELSE GO L26; % %T9106241025
LSTR: IF ELCLASS=STRTRNS AND ELBAT[I].INCR = 1 THEN BEGIN %A06241030
EMITI(0,33-15|PORV,15); QUOTETOG ~ FALSE; %A06241035
EMITO(DUP); EMITL(64); EMITO(LSS); TYPE ~ BUMPL; %A06241037
GETCONTENTS(0,FALSE); EMITI(0,18,15); EMITPAIR(2,BFW); %A06241040
EMITB(BFC,TYPE,L); EMITO(DEL); EMITL(1); END ELSE %A06241042
BAS: STRINGSEC(7); BOOPRIM ~ BTYPE; GO TD; % %T9106241044
LBTRN: BOOINT; BOOPRIM ~ BTYPE; GO TO TD; %M06241050
LR: IF QUOTETOG THEN GO TO LSYM ELSE GO TO LREC; %M06241060
LDP: IF TYPE ~ TAKE(ELBAT[I].LINK+1).[2:2] = 0 THEN GO LDBL ELSE %M06241070
IF TYPE=1 THEN GO LPLX ELSE GO LDPX; %M06241080
LBF: V; FIELDC(ELBAT[I],0,FALSE); BOOPRIM ~ BTYPE; GO TO T; %M06241090
LREC: REXP; LR1: TYPE ~ BOOPRIM ~ RECTYPE; RECTYPE~0; %M06241100
IF RECRELATION(TYPE) THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241110
LDBL: DPTOG ~ TRUE; DBLXP; DPTOG ~ FALSE; %M06241140
LR3: BOOPRIM~ 6; %M06241145
IF DBLRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241150
LPLX: IF DPTOG THEN GO TO LDPX; PLXNORM(PLXP(FALSE),FALSE); %NEW %M06241250
LR4: BOOPRIM ~ 7; %M06241255
IF PLXRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241260
LDPX: DPTOG ~ TRUE; PLXNORM(PLXP(TRUE),TRUE); DPTOG ~ FALSE; %M06241330
LR5: BOOPRIM~ 8; %M06241340
IF DBLPLXRELATION THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241350
LSYM: QUOTETOG ~ TRUE; TYPE ~ SEXP; %M06241440
LR2: BOOPRIM~ 5; %M06241450
IF SYMRELATION(TYPE) THEN GO EXIT; BOOPRIM~BTYPE; GO EXIT; %M06241460
LSFM: LSFP: CALLSF(ELBAT[I]); GO TO TD; %A06241500
L13: 06242000
COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100
STRMPROCSTMT; GO TO TD; 06244000
L17: 06245000
COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100
PROCSTMT(FALSE); GO TO TD; 06247000
L21: L25: 06248000
COMMENT BOOLEAN VARIABLES; 06249000
IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100
VARIABLE(FP); GO TO T; 06250000
L9: L29: 06251000
COMMENT LABELS AND SWITCHES; 06252000
DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000
L30: 06254000
COMMENT BOOLEAN CONSTANT; %W0306255000
IF TYPE ~ 0&ELBAT[I][44:25:2]>7 THEN EMITNUM(C) %W0306255500
ELSE EMIT(TYPE); STEPIT; GO TO T; %W0306256000
L34: 06257000
COMMENT (; 06258000
STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000
COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000
STACKCT ~ STACKCT-1; %A 06260500
IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000
STEPIT; 06262000
IF TYPE > 29 THEN GO TO LR1; %M06262050
IF TYPE > 4 THEN %M06262100
CASE TYPE-5 OF BEGIN %M06262200
BEGIN SYMSEC ~ TRUE; TYPE ~ SEXP; %M06262300
GO TO LR2 END; %M06262400
BEGIN SIMPDBL; GO TO LR3 END; %T9206262500
BEGIN PLXNORM(SIMPLX(12,FALSE),FALSE); GO TO LR4 END; %M06262600
BEGIN PLXNORM(SIMPLX(12,TRUE),TRUE); GO TO LR5; END; END; %M06262700
FAH: %T9206262800
IF TYPE = DTYPE THEN GO TO EXIT; 06263000
COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000
IF TYPE = BTYPE THEN BEGIN 06265000
TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000
T: STACKCT ~ STACKCT+1; %A 06267000
WHILE ELCLASS = AMPERSAND DO %A 06267500
COMMENT HANDLES CONCATENATE; 06268000
BEGIN 06269000
STEPIT; 06270000
IF BOOPRIM ! BTYPE 06271000
THEN BEGIN ERR(109); GO TO EXIT END; 06272000
PARSE END; 06273000
BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000
COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000
EXPRESSION; 06276000
DOT; SIMPARITH; GO TO D; 06277000
EXIT: END BOOPRIM; 06278000
COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000
EXPRESSION HAS ALREADY BEEN COMPILED; 06280000
PROCEDURE RELATION; 06281000
BEGIN INTEGER OPERATOR; 06282000
BOOLEAN MULTIPLE; LABEL DOITAGAIN; %W5306282100
DOITAGAIN: %W5306282900
OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06283000
COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06284000
ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06285000
OF THE ELBAT WORD; 06286000
STEPIT; AEXP; %W5306287000
IF ELCLASS=RELOP THEN BEGIN %W5306287100
EMITPAIR(JUNK,SND); EMIT (OPERATOR); %W5306287200
IF MULTIPLE THEN EMITO(LND); EMITV(JUNK); %W5306287300
MULTIPLE ~ TRUE; GO DOITAGAIN; %W5306287400
END; %W5306287500
EMIT (OPERATOR); %W5306287600
IF MULTIPLE THEN EMITO(LND); %W5306287700
STACKCT ~ 1; %W5306287900
EMIT(REAL(MULTIPLE)); L~L-1; %W5306288000
COMMENT THE LAST LINE IS PREPARATORY. EMITLNG USES THIS TO IMPROVE06289000
CODE LATER; 06290000
END RELATION; 06291000
COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000
OF EXPRESSIONS AS EXPRSS REPORTS; 06293000
INTEGER PROCEDURE IFEXP; 06294000
BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000
IFCLAUSE; 06296000
STACKCT ~ 0; %A 06296500
THENBRANCH ~ BUMPL; 06297000
COMMENT SAVE L FOR LATER FIXUP; 06298000
IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000
STACKCT ~ 0; %A 06299500
ELSEBRANCH ~ BUMPL; 06300000
EMITB(BFC,THENBRANCH,L); 06301000
IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000
GENEXP(TYPE); %M06303000
% REMOVED %M06304000
% REMOVED %M06305000
STACKCT ~ 1; %A 06305500
COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000
EMITB(BFW,ELSEBRANCH,L); 06307000
EMIT(1); L ~ L-1; 06308000
COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000
BOOSEC, BOOCOMP, AND RELATION; 06310000
END END IFEXP; 06311000
PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000
BEGIN INTEGER FIRST,SECOND,THIRD; 06312500
BOOLEAN P1,P2,P3; 06313000
LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500
IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000
IF STEPI ! LITNO THEN GO TO L1; 06314500
FIRST ~ C; 06315000
IF TABLE(I+1) = COLON THEN 06315500
BEGIN 06316000
STEPIT; 06316500
IF FIRST {0 THEN FLAG(92); 06317000
END ELSE 06317500
BEGIN 06318000
L1: EMITO(MKS); 06318500
AEXP; 06319000
P1 ~ TRUE; 06319500
IF ELCLASS ! COLON THEN BEGIN ERR(91);GO TO EXIT END; 06320000
END; 06320500
IF STEPI ! LITNO THEN GO TO L2; 06321000
06321100
SECOND ~ C ; 06321500
IF GT1 ~ TABLE(I+1) = COLON THEN 06322000
BEGIN 06322500
STEPIT; 06323000
IF SECOND {0 THEN FLAG(092); 06323500
END ELSE 06324000
BEGIN 06324500
IF GT1 = RTBRKET THEN 06325000
BEGIN 06325500
STEPIT; 06326000
SECOND ~ 48 - (THIRD ~ SECOND); 06326500
GO TO SKIP2; 06327000
END; 06327500
L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000
AEXP; 06328500
P1 ~ P2 ~ TRUE; 06329000
IF ELCLASS = COLON THEN 06329100
06329200
06329300
ELSE 06329350
IF ELCLASS = RTBRKET THEN 06329400
BEGIN 06329450
EMITO(DUP); 06329500
EMITL(48) ;EMITO(SUB); 06329550
EMITO(CHS);EMITO(XCH); 06329600
P3 ~ TRUE; 06329700
GO TO SKIP1; 06329800
END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900
END; 06330000
IF STEPI ! LITNO THEN GO L3 ; 06330500
THIRD ~ C; 06330600
IF TABLE(I+1) = RTBRKET THEN 06330700
BEGIN 06330800
STEPIT; 06331000
SKIP2: IF THIRD {0 OR THIRD > 47 THEN FLAG(95); 06331100
END ELSE 06331200
BEGIN 06331300
L3: IF NOT P2 THEN 06331500
BEGIN 06331600
IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700
EMITL(SECOND); 06331800
END; 06332000
AEXP; 06332100
P1~ P2~P3 ~TRUE; 06332200
IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300
END; 06332400
SKIP1: IF P1 THEN 06332500
BEGIN 06333000
IF NOT P2 THEN EMITL(SECOND); 06333500
IF NOT P3 THEN 06334000
BEGIN 06334100
EMITL(THIRD);EMITL(1); 06334200
EMITV(GNAT(DIALER)); 06334500
EMIT(TRB & THIRD[36:42:6]); 06334600
END ELSE 06334700
BEGIN 06335000
EMITL(0); 06335100
EMITV(GNAT(DIALER)); 06335200
EMITO(DEL); 06335500
END; 06335700
END ELSE 06336000
BEGIN 06336100
IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200
EMITD(SECOND,FIRST,THIRD); 06336300
END; 06336400
STEPIT; 06336500
EXIT: STACKCT ~ 1; 06336600
END PARSE; 06336700
COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000
THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100
PROCEDURE DOTIT; %D06338000
BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000
% %D06340000
IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06341000
%A 06342000
EMITI(0,FIRST,SECOND); %A 06343000
%A 06344000
STEPIT; 06345000
EXIT: END DOTIT; %D06346000
COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000
PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000
THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000
SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000
IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000
IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000
BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000
THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000
IS ALSO STORED IN F+1; 06355000
PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000
BEGIN INTEGER TLEVEL; 06357000
EMITO(MKS); 06358000
IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000
JUMPCTR ~ TLEVEL; 06360000
COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000
INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000
BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000
JUMPING; 06364000
IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000
THEN BEGIN 06366000
COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000
EMIT(0); 06368000
EMITL(TLEVEL) END 06369000
ELSE BEGIN 06370000
EMITN(512); 06371000
EMITV(513); COMMENT PICK UP BLOCKCTR AT ENTRY 06372000
FROM F+1; 06373000
IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000
THEN BEGIN 06375000
EMITL(TLEVEL); 06376000
EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000
AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000
END END; 06379000
EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000
END GENGO; 06381000
COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000
IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000
THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000
STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000
SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000
COMMUNICATE WILL BE DONE; 06387000
PROCEDURE DEXP; 06388000
BEGIN 06389000
LABEL EXIT; 06390000
BOOLEAN S,F; 06391000
REAL ELBW; 06392000
IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000
THEN BEGIN 06394000
CHECKER(ELBW ~ ELBAT[I]); 06395000
SCATTERELBAT; 06396000
IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000
IF FAULTOG THEN 06397100
IF S OR F THEN FAULTLEVEL~1 ELSE 06397200
IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300
IF S THEN BEGIN 06398000
BANA; EMITPAIR(JUNK,ISD); 06399000
EMITV(GNAT(ELBW)); 06400000
IF F THEN GO TO EXIT; END 06401000
ELSE BEGIN 06402000
STEPIT; 06403000
IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000
EMITL(GNAT(ELBW)) END; 06405000
GENGO(ELBW); 06406000
END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000
EXIT: END DEXP; 06408000
PROCEDURE IFCLAUSE; 06409000
BEGIN STEPIT; STACKCT ~ 0; BEXP; %A 06410000
IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000
COMMENT PANA COMPILES THE CONSTRUCT: (<ARIT. EXP.>); 06412000
PROCEDURE PANA; 06413000
BEGIN 06414000
IF STEPI ! LEFTPAREN THEN ERR(105) 06415000
ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000
ERR(104) ELSE STEPIT END END PANA; 06417000
COMMENT BANA COMPILES THE CONSTRUCT: [<ARITH. EXP.>]; 06418000
PROCEDURE BANA; 06419000
BEGIN 06420000
IF STEPI ! LFTBRKET THEN ERR(117) 06421000
ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000
ERR(118) ELSE STEPIT END END BANA ; 06423000
PROCEDURE MAKEALABEL; 06500000
BEGIN LABEL EXIT; REAL X; %W2706501000
STREAMTOG~FALSE; 06502000
EMITO(MKS); PASSFILE; 06503000
IF ELCLASS!WITHV THEN 06504000
BEGIN ERR(301); GO TO EXIT END; 06505000
FOR X~1 STEP 1 UNTIL 6 DO %W2706506000
BEGIN IF STEPI=FACTOP THEN 06507000
BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000
ELSE AEXP; 06509000
IF ELCLASS!COMMA THEN GO TO EXIT; 06510000
END; 06511000
EXIT: FOR X:=X STEP 1 UNTIL 5 DO %W2706512000
BEGIN EMIT(4);EMITO(CHS) END; 06512100
EMITL(11); 06512200
EMITV(5); 06513000
END; 06514000
COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES; 07000000
COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 07001000
COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES 07002000
ARE SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE 07003000
FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME 07004000
CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 07005000
PROCEDURE COMPOUNDTAIL; 07006000
BEGIN LABEL ANOTHER; 07007000
I ~ I-1; BEGINCTR ~ BEGINCTR+1; 07008000
ANOTHER: ERRORTOG ~ TRUE; COMMENT ALLOW ERROR MESSAGES; 07009000
STEPIT; 07010000
IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000
IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000
IF ELCLASS ! ENDV 07013000
THEN BEGIN 07014000
ERR(119); GO TO ANOTHER END; 07015000
ENDTOG~TRUE; 07016000
DO STOPDEFINE~TRUE UNTIL 07017000
STEPI{ENDV AND ELCLASS}UNTILV 07018000
OR NOT ENDTOG; 07019000
ENDTOG~FALSE; 07020000
IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000
THEN BEGIN 07022000
IF BEGINCTR = 0 THEN 07023000
BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000
FLAG(120) END; 07025000
IF ELCLASS = PERIOD THEN 07026000
BEGIN 07027000
GT5 ~ "ND;END."&"E"[1:43:5]; 07028000
MOVE(1,GT5,CARD(0)); 07029000
LASTUSED~4; 07030000
ELBAT[I~I-2] ~SPECIAL[20]; 07031000
ELCLASS ~ SEMICOLON END 07032000
END COMPOUNDTAIL; 07033000
COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000
PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000
ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000
NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000
CONCERNING THE PARAMETERS: 07038000
FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000
OR NOT. 07040000
SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000
PROCEDURE OR NOT. 07042000
INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000
INFORMATION; 07044000
PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000
VALUE FBIT,SBIT,INDEX; 07046000
BOOLEAN FBIT,SBIT; 07047000
INTEGER INDEX; 07048000
BEGIN 07049000
INTEGER PCTR,ACLASS,SCLASS; 07050000
INTEGER STYPE; LABEL LCH; BOOLEAN PART; LABEL M; %M07050500
COMMENT 07051000
PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000
COMPILED. 07053000
ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000
SCLASS IS THE CLASS OF THE FORMAL PARAMETER. 07055000
THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000
TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000
SIMILAR MEANINGS; 07058000
REAL WHOLE; 07059000
BOOLEAN DPTOGO,QUOTETOGO; REAL T7; %M07059500
COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000
PARAMETERS; 07061000
BOOLEAN VBIT; 07062000
COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000
BE CALLED BY VALUE OR BY NAME; 07064000
BOOLEAN PROCEDURE COMPCLASS(ACLASS,SCLASS,T,WHOLE); %M07064100
VALUE ACLASS,SCLASS,T,WHOLE; %M07064150
REAL ACLASS,SCLASS,T,WHOLE; %M07064200
IF ACLASS=SCLASS THEN BEGIN %M07064250
IF SCLASS= RECID THEN BEGIN %M07064300
IF COMPCLASS ~ (T.[27:5]+30)! GETYPE(WHOLE) THEN %M07064400
FLAG(123) END ELSE %M07064500
IF SCLASS= DBLPLXID THEN BEGIN %M07064600
IF COMPCLASS ~ T.[27:5] ! TAKE( WHOLE .LINK+1).[2:2] %M07064700
THEN FLAG(123) END END ELSE %M07064800
IF COMPCLASS ~ SCLASS!LOCLID OR ACLASS < SYMID THEN FLAG(123); %M07064900
LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000
LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000
LFB, %M07066500
CERR,FGEN; 07067000
LABEL 07068000
A6,AER,A15,A21,A31,A32,A33,A34,A40,A41,A42,A47,A48,A49,A50, %M07068100
A61,A63, %M07068200
A25, %A07068300
L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000
L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000
L31,L32,L33; 07071000
SWITCH S ~ 07072000
L4,A6,L5,L6,L7,L8,L9,L10,L12,AER,A15,AER,AER,AER,AER,L11, %M07073000
A21,AER,L12,L12,A25,L12,L13,L14,L15,L16,A31,A32,A33,A34,L17, %A07074000
L18,L19,L20,AER,A40,A41,A42,L21,L22,L23,L24,A47,A48,A49,A50, %M07075000
L25,L26,L27,L28,L29,L30,L31,L32,L33,AER,A61,AER,A63; %M07075500
REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000
TO REDUCING TOTAL NUMBER; 07077000
PCTR ~ 1; 07078000
DPTOGO ~ DPTOG; QUOTETOGO ~ QUOTETOG; DPTOG ~ QUOTETOG ~ FALSE; %M07078500
ANOTHER: DPTOG ~ QUOTETOG ~ FALSE; %M07079000
STACKCT ~ 0; %A 07079500
COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000
IF FBIT THEN BEGIN VBIT ~ FALSE; SCLASS ~ LOCLID END 07081000
COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000
IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000
METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK 07084000
ELSE BEGIN 07085000
VBIT ~ BOOLEAN(GT1~ TAKE(INDEX+PCTR)).VO; 07086000
T7 ~ GT1; %M07086500
IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000
SCLASS } STRINGSTRPROCID %M07088000
THEN BEGIN IF GT1 ~ (SCLASS-STRINGSTRPROCID).[45:3]}5 %M07089000
THEN SCLASS ~ SCLASS - GT1 + 5; %M07090000
COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-07091000
AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000
SOURCE, HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000
% DELETE %M07094000
IF GT1 {2 THEN IF BOOLEAN(GT1) THEN DPTOG ~ T7.[27:5]!1 ELSE %M07094100
QUOTETOG ~ TRUE; %M07094150
END; %M07094155
IF SBIT THEN IF ACLASS~TABLE(I+1)=39 OR ACLASS=47 THEN BEGIN %M07094160
STEPIT; %M07094165
STRINGSEC(IF VBIT THEN 8 ELSE 1); %M07094170
IF VBIT THEN EMITO(DEL) ELSE BEGIN IF SPT THEN EMITO(DEL); %M07094180
IF SLT THEN EMITO(DEL) END; GO BS END ELSE %A07094190
IF VBIT THEN BEGIN STEPIT; GO VE END; %A07094195
IF VBIT THEN IF SCLASS}STRINGID AND SCLASS{REALID THEN BEGIN %M07094200
STEPIT; CASE SCLASS-STRINGID OF BEGIN %M07094250
STRINGSEC(8); %M07094300
IF T7.[27:5]=0 THEN DBLXP ELSE PLXNORM(PLXP(DPTOG),DPTOG); %M07094350
BEGIN SEXPN; IF RECLAIMTOG THEN BEGIN %M07094380
EMIT(11); EMIT(4); EMITO(280); % MAKE DESC %M07094400
EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M07094410
EMITPAIR(TABLEMARK,SND); EMITN(PTABLE); EMITO(SND) END; %M07094430
END; %M07094440
RECOM(T7.[27:5]+30); BEXP; AEXP; END; %M07094450
GO TO COMMON END; %M07094460
% %A07094465
IF SCLASS=STRINGID THEN BEGIN %M07094470
STEPIT; %M07094471
STRINGSEC(1); %M07094472
IF SPT THEN BEGIN IF NOT SLT THEN EMITNUM(SL) END ELSE %M07094474
BEGIN EMITNUM(SP); IF SLT THEN EMITO(XCH) ELSE %M07094476
EMITNUM(SL) END; GO TO COMMON END; %M07094480
END; %M07094525
IF SCLASS=FRMTID THEN IF EXPLICITFORMAT THEN %W4007094560
BEGIN STEPIT; GO TO COMMON END; %W4007094570
ACLASS~STEPI; WHOLE~ELBAT[I];SCATTERELBAT; %W4007094580
IF SCLASS=LISTID THEN BEGIN LISTPARA;GO TO COMMON END; %W3307094700
IF T1 ~ TABLE(I+1) ! COMMA THEN 07095000
IF T1 ! RTPAREN THEN 07096000
COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000
HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000
BEGIN IF ACLASS { IDMAX THEN %M07099000
CHECKER(WHOLE); 07099500
IF ACLASS < STRINGARRAYID OR ACLASS > INTARRAYID %M07100000
THEN BEGIN 07101000
COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000
HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000
SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000
IF ACLASS = SUPERFRMTID THEN 07105000
BEGIN ACLASS ~ FRMTID; GO TO FGEN END; 07106000
IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000
THEN BEGIN 07108000
T4~L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500
IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505
ACLASS ~ FILEID; 07109000
COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000
PASSFILE; 07111000
IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200
BEGIN 07111210
IF VBIT THEN 07111220
BEGIN 07111225
T5~L; L~T4; EMITO(MKS); L~T5; T5~0 ; 07111230
END ; 07111235
ACLASS~IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240
THEN REALID ELSE BOOID ; 07111250
IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255
IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260
BEGIN 07111265
SIMPARITH ; 07111270
IF ELCLASS=RELOP THEN 07111275
BEGIN 07111280
ACLASS~BOOID; RELATION ; 07111285
SIMPBOO ; 07111290
END ; 07111295
END ; 07111300
IF NOT VBIT THEN 07111303
BEGIN 07111307
EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310
EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315
EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320
EMITB(BFW,T4+2,L) ; 07111325
STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330
END ; 07111335
GO BS ; 07111340
END OF FILE ATTRIBUTE PARAMETER EXPRESSION;07111345
IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000
I ~ I-1; 07113000
COMMENT IF WE ARE HERE IT IS INDEXED; 07114000
CHECKPRESENCE; 07115000
EMITO(LOD); PANA; EMITO(CDC); 07116000
IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000
THEN BEGIN ERR(121); GO TO CERR END 07118000
COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000
STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000
RELEASE ON THIS DESCRIPTOR 07121000
ELSE GO TO COMMON END ; 07122000
IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500
EMITN(WHOLE.ADDRESS); 07122510
EMITO(LOD); 07122520
EMITO(LOD); 07122530
ACLASS~LISTID; GO TO BS END; 07122540
COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000
NORMAL: IF VBIT THEN 07124000
BEGIN VE: ACLASS~ IF T1 ~EXPRSS = ATYPE THEN REALID ELSE %M07125000
IF T1 = BTYPE THEN BOOID ELSE IF T1 = DTYPE THEN %M07125100
LABELID ELSE IF T1=5 THEN SYMID ELSE 0; %M07125200
IF ACLASS=0 THEN GO AER; %M07125300
GO TO BS END %M07125400
ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000
IF FBIT THEN BEGIN %M07126100
IF(ACLASS} STRINGSTRPROCID AND ACLASS{INTARRAYID %M07126200
AND (ACLASS-STRINGSTRPROCID).[45:3]<4) OR ACLASS=COLON %M07126300
THEN GO TO LFB END; %M07126400
IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000
COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;07128000
T2 ~ BAE; 07129000
T3 ~ PROGDESCBLDR(0,L,0); 07130000
COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000
AROUND CODE FOR EXPRESSION; 07132000
IF SCLASS = LABELID THEN BEGIN DEXP; ACLASS~ LABELID END ELSE %M07133000
IF FBIT THEN BEGIN IF EXPRSS>5 THEN GO AER END ELSE %M07133050
IF SCLASS} DBLPLXID AND SCLASS { REALID THEN BEGIN %M07133100
CASE SCLASS-DBLPLXID OF BEGIN %M07133200
BEGIN I~I-1; DBLPLXP( T7.[27:5]) END; %M07133300
SEXPN; %M07133400
RECOM(T7.[27:5]+30); %M07133500
BEXP; AEXP; END; END ELSE GO TO AER; %M07133600
STORE: IF SCLASS= DBLPLXID THEN BEGIN %M07134000
T7 ~ IF T7.[27:5]=2 THEN 4 ELSE 2; %M07134100
FOR STYPE ~T7 STEP -1 UNTIL 1 DO EMITPAIR(TEMP(STYPE),STD); %M07134200
EMITN(TEMP(1)) END ELSE %M07134300
BEGIN EMITPAIR(JUNK,STD); EMITN(JUNK) END; %M07134400
COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000
PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000
INTO JUNK; 07137000
LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000
COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000
THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000
EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000
THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000
OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000
END OF NAME CALL EXPRESSIONS; 07144000
% REMOVE %M07145000
GO TO COMMON %M07146000
END OF EXPRESSION CALL CODE; 07147000
COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000
ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000
IF SCLASS } STRINGARRAYID THEN %M07150000
IF SCLASS { INTARRAYID THEN 07151000
BEGIN T2 ~ TAKE(INDEX+PCTR).[32:3]; %M07152000
COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.07153000
THUS WE MUST HAVE A ROW DESIGNATOR; 07154000
IF ACLASS > BOOARRAYID THEN ACLASS ~ REALARRAYID; %M07155000
IF ACLASS = SCLASS THEN BEGIN %M07155100
IF SCLASS= RECARRAYID THEN BEGIN %M07155200
IF T7.[27:5]+30!GETYPE(ELBAT[I]) THEN BEGIN FLAG(123); %M07155300
ERRORTOG ~ TRUE END END ELSE %M07155400
IF SCLASS = DBLPLXARRAYID THEN BEGIN %M07155500
IF TAKE(ELBAT[I].LINK+1).[2:2]!T7.[27:5] THEN BEGIN %M07155600
FLAG(123); ERRORTOG ~ TRUE END END END ELSE %M07155700
BEGIN ERR(123); GO TO EXIT END; %M07155800
COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000
IF SCLASS < BOOARRAYID THEN BEGIN %M07157000
IF SCLASS = DBLPLXARRAYID THEN BEGIN %M07157100
IF NOT ARAY(ELBAT[I],IF T7.[27:5]=2 THEN 4 ELSE 2,BOOLEAN(5)) %M07157200
THEN BEGIN ERR(123); GO TO EXIT END END ELSE %M07157300
IF NOT ARAY(ELBAT[I],0,BOOLEAN(REAL(SCLASS=STRINGARRAYID)|2+5)) %M07157400
THEN BEGIN ERR(123); GO TO EXIT END END ELSE %M07157500
BEGIN VARIABLE(FA); IF TABLE(I-2) ! FACTOP THEN %M07157600
BEGIN ERR(123); GO EXIT END; END; %M07158000
COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000
COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000
STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000
LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000
THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000
; GO TO COMMON END; %M07167000
IF VBIT THEN GO TO VE; 07168000
COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000
VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000
IF SBIT THEN %M07171000
IF ACLASS<BOOARRAYID THEN BEGIN %M07171100
GT1~ REAL(ARAY(WHOLE ,IF ACLASS=DBLPLXARRAYID THEN %M07171200
NEWP(WHOLE) +1 ELSE 0,TRUE)); GO BS END %M07171300
ELSE BEGIN %M07172000
T6 ~ FL; VARIABLE(T6); 07173000
IF T6 ! 0 THEN GO TO BS; 07174000
FLAG(122);GO TO CERR END; 07175000
COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000
CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000
VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000
THAN THIS IT SETS T6 TO ZERO; 07179000
COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000
WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000
1) A ROW DESIGNATOR WITH FORMAL PROCEDURE, 07182000
2) A SUBSCRIPTED VARIABLE, OR 07183000
3) A GENUINE NAME CALL EXPRESSION; 07184000
IF TABLE(I+2) = LITNO AND 07185000
( GT1 ~ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000
THEN BEGIN 07187000
COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000
CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000
ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000
IF COMPCLASS(ACLASS-8,SCLASS,T7,WHOLE) THEN GO TO AER; %M07191000
IF ARAY( WHOLE, IF ACLASS= DBLPLXARRAYID THEN %M07192000
NEWP(WHOLE) + 1 ELSE 0,TRUE) %M07192500
THEN BEGIN ERR(123); %M07192700
GO EXIT END; GO TO COMMON END; %M07193000
T2 ~ BAE; T3 ~ L; 07194000
COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000
IF WE HAVE ROW DESIGNATOR; 07196000
IF ACLASS~ACLASS-8 < BOOID THEN BEGIN T3 ~PROGDESCBLDR(0,T3,0); %M07197000
IF ARAY(WHOLE , IF ACLASS=DBLPLXID THEN %M07197200
NEWP(WHOLE) + 1 ELSE 0,BOOLEAN(4)) THEN BEGIN %M07197300
ERR(123); GO TO EXIT END; %M07197400
IF ELCLASS = COMMA OR ELCLASS=RTPAREN THEN %M07197500
IF COMPCLASS(ACLASS,SCLASS,T7,WHOLE) THEN GO TO CERR %M07197600
ELSE GO TO LRTS ELSE %M07197700
IF ELCLASS= ASSIGNOP THEN BEGIN PART ~ FALSE; %M07197800
IF ACLASS= SYMID THEN BEGIN QUOTETOG ~ TRUE; STEPIT; %M07197900
SEXPN; QUOTETOG ~ FALSE; EMITO(XCH); %M07198000
EMITO(SND); END ELSE %M07198100
IF ACLASS= DBLPLXID THEN %M07198200
DBLPLXVAR(BOOLEAN(2&(T6~TAKE(WHOLE.LINK+1).[2:2]) %M07198300
[44:46:2])) ELSE %M07198400
BEGIN STEPIT; RECOM(T6 ~ GETYPE(WHOLE));EMITO(XCH); %M07198500
EMITO(SND) END; GO LCH END; PART ~ TRUE; %M07198600
IF ACLASS = DBLPLXID THEN T6 ~ TAKE(WHOLE.LINK+1).[2:2] %M07198700
ELSE IF ACLASS=RECID THEN T6 ~ GETYPE(WHOLE); %M07198800
IF FBIT THEN GO TO M END ELSE %M07198900
BEGIN T6 ~ FA; VARIABLE(T6); %M07199000
IF TABLE(I-1) = FACTOP THEN BEGIN %M07199100
EMITB(BFW,T2,T3); GO TO BS END; %M07199200
T3 ~ PROGDESCBLDR(0,T3,0); %M07199300
IF ACLASS! BOOID THEN ACLASS ~ REALID; %M07199400
IF NOT (PART ~ ELCLASS!COMMA AND ELCLASS!RTPAREN) THEN %M07199500
IF T6!0 THEN %M07199600
IF COMPCLASS(ACLASS,SCLASS,T7,WHOLE) THEN GO CERR %M07199700
ELSE GO TO LRTS; %M07199800
END; %M07199900
LCH: IF SCLASS = LOCLID THEN SCLASS ~ ACLASS ELSE %M07200000
IF SCLASS>REALID OR SCLASS< DBLPLXID THEN GO M; %M07200100
CASE(IF SCLASS=DBLPLXID THEN T7.[27:5] ELSE %M07200200
SCLASS-38) OF BEGIN %M07200300
IF ACLASS = DBLPLXID THEN BEGIN %M07200400
IF T6!0 THEN GO M; IF PART THEN SIMPDBL; END ELSE %M07200500
IF ACLASS = REALID OR ACLASS= SYMID THEN BEGIN %M07200600
IF ACLASS = SYMID THEN EMITATN; EMIT(0); EMITO(XCH); %M07200700
IF PART THEN SIMPDBL END ELSE GO M; %M07200800
BEGIN IF ACLASS = DBLPLXID THEN BEGIN %M07200900
IF T6 ! 1 THEN DBLTSNGL(T6|4); %M07201000
IF T6 ! 0 THEN T6 ~ 12; END ELSE %M07201100
IF ACLASS = REALID THEN T6 ~ 0 ELSE %M07201200
IF ACLASS = SYMID THEN BEGIN EMITATN; T6 ~0; END %M07201300
ELSE GO TO M; %M07201400
PLXNORM(IF PART THEN SIMPLX(T6,FALSE) ELSE T6, FALSE) %M07201500
END; %M07201600
BEGIN IF ACLASS = DBLPLXID THEN BEGIN %M07201700
IF T6 = 1 THEN BEGIN EMITPAIR(JUNK,STD); EMIT(0); %M07201800
EMITO(XCH); EMIT(0); EMITV(JUNK); END ELSE %M07201900
IF T6 ! 0 THEN T6 ~ 12 END ELSE %M07202000
IF ACLASS = REALID OR ACLASS = SYMID THEN BEGIN %M07202100
IF ACLASS= SYMID THEN EMITATN; EMIT(T6~0); %M07202200
EMITO(XCH) END ELSE GO TO M; %M07202300
PLXNORM(IF PART THEN SIMPLX(T6,TRUE) ELSE T6,TRUE) %M07202400
END; %M07202500
BEGIN IF(ACLASS= DBLPLXID AND T6=0) OR ACLASS=REALID THEN %M07202600
BEGIN IF ACLASS ! REALID THEN DBLTSNGL(0); SDNORM(3) END %M07202700
ELSE IF ACLASS! SYMID THEN GO TO M; %M07202800
IF PART THEN BEGIN QUOTETOG ~ SYMSEC ~ TRUE; SDNORM(SEXP) %M07202900
END END; %M07203000
IF ACLASS ! RECID OR T7.[27:5]+30 ! T6 THEN GO TO M; %M07203100
BEGIN CASE IF ACLASS= DBLPLXID THEN T6 ELSE %M07203200
ACLASS-38 OF BEGIN %M07203300
BEGIN SIMPDBL; IF DBLRELATION THEN GO TO M END; %M07203400
BEGIN PLXNORM(SIMPLX(0,FALSE),FALSE); %M07203500
IF PLXRELATION THEN GO TO M; END; %M07203600
BEGIN PLXNORM(SIMPLX(0,TRUE),TRUE); %M07203700
IF DBLPLXRELATION THEN GO TO M END; %M07203800
BEGIN QUOTETOG ~ SYMSEC ~ TRUE; %M07204000
IF SYMRELATION(SEXP) THEN GO TO M END; %M07205000
IF RECRELATION(T6) THEN GO TO M; ; %M07206000
IF ELCLASS ! RELOP THEN GO TO M ELSE RELATION; END; %M07207000
FINISHBOO: SIMPBOO END; %M07208000
BEGIN IF ACLASS= SYMID THEN EMITATN ELSE %M07209000
IF ACLASS= DBLPLXID AND T6=0 THEN DBLTSNGL(0) ELSE %M07210000
IF ACLASS! REALID THEN GO TO M; SIMPARITH END; %M07211000
END; %M07211500
GO TO STORE END; %M07212000
COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000
ACTUAL PARAMETER; 07214000
IF ACLASS { IDMAX THEN CHECKER(WHOLE); %M07215000
STEPIT; IF VBIT THEN GO AER; GO TO S[ACLASS-4]; %M07215500
IF ACLASS=0 THEN FLAG(100) ELSE %M07216000
IF ACLASS = READV THEN BEGIN I ~ I - 1; GO TO NORMAL END; %M07216100
IF ACLASS = SPACEV THEN BEGIN EMITL(" "); ACLASS ~ SYMID; %M07216200
GO TO BSX END; %M07216300
FLAG(126); GO TO CERR; %M07217000
A6: EMITPAIR(ADDRSF,LOD); GO TO BS; %M07217500
M: FLAG(123); ERRORTOG ~ TRUE; GO TO COMMON; %M07217510
AER: FLAG(126); %M07217520
CERR: 07218000
L12:L13:L14:L15:L16: 07219000
COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000
FLAG(125); ERRORTOG ~ TRUE; GO TO COMMON; 07221000
LODPOINT: 07222000
L4:L8: 07223000
COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000
EMITPAIR(ADDRSF,LOD); 07225000
NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000
COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000
STREAM PROCEDURES; 07228000
BS: IF ACLASS=SCLASS THEN BEGIN %M07229000
IF SCLASS>23 AND SCLASS <51 THEN %M07229100
IF SCLASS ~(SCLASS-23).[45:3]=1 THEN BEGIN %M07229200
IF TAKE(WHOLE.LINK+1).[2:2]! T7.[27:5] THEN GO M END %M07229300
ELSE IF SCLASS=3 THEN BEGIN %M07229400
IF GETYPE(WHOLE)! T7.[27:5]+30 THEN GO M END END ELSE %M07229500
IF SCLASS ! LOCLID THEN 07230000
COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000
AGREE; 07232000
BEGIN FLAG(123); GO TO CERR END; 07233000
COMMON: 07234000
COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000
PCTR ~ PCTR+1; 07236000
IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000
IF ELCLASS ! RTPAREN 07238000
THEN BEGIN ERROR(129); GO TO EXIT END; 07239000
IF NOT FBIT THEN 07240000
IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000
THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000
ERR(128); GO TO EXIT END; 07243000
STEPIT; GO TO EXIT; 07244000
LFB: IF ACLASS~ EXPRSS}29 THEN ACLASS ~4; %M07244100
IF LISTOG THEN BEGIN %M07244200
STREAM PROCEDURE MSG(PCTR,ACLASS,LIN); VALUE PCTR,ACLASS; %M07244250
BEGIN LABEL L1,L2,L3,L4,L5,L6,L7,L8,L9; %M07244300
DI ~ LIN; DS ~ 8 LIT " "; SI ~ LIN; DS ~ 14 WDS; %M07244350
DI ~ LIN; DS ~18 LIT "WARNING: ARGUMENT "; SI ~ LOC PCTR; %M07244400
DS ~ 3DEC; DS~37 LIT " OF FORMAL PROCEDURE MUST BE OF TYPE "; %M07244450
CI ~CI + ACLASS; GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; %M07244500
GO L7; GO L8; DS ~ 14 LIT "DOUBLE COMPLEX"; GO L9; %M07244550
L1: DS ~ 9 LIT "--ERROR--"; GO L9; L2: DS~7 LIT "BOOLEAN"; %M07244600
GO L9; L3: DS~13 LIT "DESIGNATIONAL"; GO L9; %M07244650
L4: DS ~ 4 LIT "REAL"; GO L9; L5: DS ~ 6 LIT "RECORD"; GO L9; %M07244700
L6: DS ~ 6 LIT "SYMBOL"; GO L9; L7: DS ~ 6 LIT "DOUBLE"; GO L9; %M07244750
L8: DS ~ 7 LIT "COMPLEX"; %M07244800
L9: DS ~ 16 LIT " CALLED BY VALUE"; END; %M07244850
IF ACLASS > 8 THEN ERR(123) ELSE BEGIN MSG(PCTR,ACLASS,LIN); %M07244900
WRITELINE END; END; GO TO COMMON; %M07244950
L5: 07245000
COMMENT FORMATS; 07246000
I~I-1; 07247000
FGEN: PASSFORMAT; 07248000
IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000
I~I+1; 07250000
GO TO BS; 07251000
L6: 07252000
COMMENT SUPERFORMAT; 07253000
IF FBIT 07254000
THEN BEGIN EMITV(ADDRSF); ADDRSF ~ ADDRSF-1 END 07255000
ELSE BEGIN I ~ I -1; EMITL(TAKEFRST); I ~ I+1 END; 07256000
GO TO LODPOINT; 07257000
A25: IF FORMALF THEN GO LODPOINT; %A07257100
IF TAKE(LINKF+INCRF).[40:8]=0 THEN GO LODPOINT; %A07257200
ERR(731); GO EXIT; %A07257300
L7: 07258000
COMMENT FILE; 07259000
I ~ I-1; ELCLASS ~ FILEID; 07260000
PASSFILE; GO TO BS; 07261000
L9: 07262000
COMMENT SWITCH; 07263000
IF FORMALF THEN GO TO LODPOINT; 07264000
COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000
MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000
DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000
ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000
THEY ARE OR NOT; 07269000
T2 ~ BAE; T3~PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000
GENGO(WHOLE); 07271000
EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000
L10: 07273000
COMMENT PROCEDURE; 07274000
TB1 ~ TRUE; IF FORMALF THEN GO TO LODPOINT; 07275000
LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000
THEN BEGIN 07277000
COMMENT THE PROCEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000
IF TB1 THEN GO TO LODPOINT; 07279000
COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000
DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);07281000
IF NOT FBIT THEN %R07281900
IF SCLASS { INTPROCID THEN SCLASS~ SCLASS + 8; %M07282000
I ~ I-2; STEPIT; 07283000
WHOLE ~ ELBAT[I]; %M07283500
GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000
EXPRESSIONS HANDLE THIS CASE; 07285000
END THE CASE OF ZERO PARAMETERS; 07286000
TB1 ~ TRUE; 07287000
FOR T2 ~ 1 STEP 1 UNTIL T1 07288000
DO BEGIN 07289000
IF BOOLEAN(T3~TAKE(WHOLE+T2)).VO 07290000
THEN 07291000
IF T4 ~ T3.CLASS ! DBLPLXID %M07292000
THEN BEGIN 07293000
COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000
IF TB1 THEN 07295000
BEGIN 07296000
COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000
VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000
PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000
VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000
PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK07301000
CONSTRUCTIONS; 07302000
GOBBLE: 07303000
TB1 ~ FALSE; T5 ~ BAE; 07304000
T6 ~ PROGDESCBLDR(1,L,0) END; 07305000
EMITV(T3 ~ T3.ADDRESS); EMITPAIR(T3,STD); %M07306000
IF T4 = SYMID AND RECLAIMTOG THEN BEGIN EMITN(T3); %M07306100
EMITV(TABLEMARK); EMITL(1); EMITO(ADD); %M07306200
EMITPAIR( TABLEMARK,SND); EMITN(PTABLE); %M07306300
EMITO(STD) END END END; %M07306400
COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000
IF NOT TB1 07308000
THEN BEGIN 07309000
COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000
EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000
CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000
WHOLE ~ ELBAT[I-1]; %M07312500
GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000
L11: 07314000
COMMENT INTRINSIC PROCEDURE; 07315000
IF WHOLE.[27:6]!0 THEN IF LINKF>542 THEN GO AER; T4 ~ 0; %M07316000
IF ADDRSF = 0 THEN BEGIN %M07316100
IF ADDRSF ~ TAKE(LINKF+INCRF.[46:2]).[3:6]=0 %M07316200
THEN ADDRSF := GETSPACE(TRUE,LINKF.LINK+1); %T9307316300
PUTADR(LINKF,ADDRSF); END; %T9307316350
COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000
ACLASS ~ REALPROCID; 07318000
T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000
COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000
PROCEDURES; 07321000
A31: A32: A34: IF FBIT THEN BEGIN I~I-2; STEPIT; GO TO LFB END; %M07321100
GO TO L17; %M07321200
L19:L20: 07322000
COMMENT ALFAPROC AND INTPROC; 07323000
ACLASS ~ REALPROCID; 07324000
A33: %M07324500
L17:L18: 07325000
COMMENT BOOPROC AND REAL PROC; 07326000
IF FORMALF 07327000
THEN BEGIN 07328000
COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000
IF SCLASS > INTPROCID THEN ACLASS~ ACLASS +8; %M07330000
COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000
EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000
PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000
IF VBIT 07334000
THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000
ELSE GO TO LODPOINT; 07336000
COMMENT IF VBIT WE DO VALUE CALL, OTHERWISE WE PASS PROCEDURE 07337000
DESCRIPTOR ALONG; 07338000
END; 07339000
TB1 ~ FALSE; GO TO LP; 07340000
A40: COMMENT DBLPLXID; %M07340100
A42: COMMENT RECID; IF FBIT THEN BEGIN I~I-2; STEPIT; GO LFB END; %M07340200
A41: COMMENT SYMID; GO TO L21; %M07340400
L23:L24: 07341000
COMMENT INTEGER AND ALPHA IDS; 07342000
ACLASS ~ REALID; 07343000
L21:L22: 07344000
COMMENT BOOLEAN AND REAL IDS; 07345000
IF VBIT THEN EMITV(ADDRSF) 07346000
ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000
THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000
COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000
AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000
THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000
GO TO BS; 07352000
A47: COMMENT STRINGARRAYID; %M07352100
A48: COMMENT DBLPLXARRAYID; %M07352200
A50: COMMENT RECARRAYID; IF FBIT THEN GO AER; %M07352300
A49: COMMENT SYMARRAYID; GO TO L25; %M07352600
L27:L28: 07353000
COMMENT INTEGER AND ALPHA ARRAYS; 07354000
ACLASS ~ REALARRAYID; 07355000
L25:L26: 07356000
COMMENT BOOLEAN AND REAL ARRAYS; 07357000
EMITPAIR(ADDRSF,LOD); 07358000
IF SBIT THEN GO TO BS; 07359000
COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000
T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000
IF ACLASS= STRINGARRAYID THEN %M07361100
IF FORMALF THEN EMITV(ADDRSF-1) ELSE %M07361200
EMITNUM(TAKE(WHOLE+T1+1).NODIMPART); %M07361300
FOR T2 ~ 1 STEP 1 UNTIL T1 07362000
DO BEGIN 07363000
IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000
THEN EMITV(T3) ELSE EMIT(STLB); 07365000
IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000
COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000
IF FBIT THEN GO TO BS; 07368000
IF T7.[32:3]!T1 THEN FLAG(124); WHOLE~ELBAT[I-1]; GO BS; %M07369000
COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000
OF DIMENSIONS; 07371000
L29: 07372000
COMMENT LABEL; 07373000
ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000
L30: 07375000
COMMENT BOOLEAN CONSTANT; %W0307376000
IF T2 ~ 0 & WHOLE[44:25:2] > 7 THEN EMITNUM(C) %W0307377000
ELSE EMIT(T2); ACLASS ~ BOOID; GO TO BSX; %W0307377050
A15: IF INCRF!0 THEN GO AER; EMITL(12); ACLASS~ SYMID; GO BSX; %M07377100
A21: EMITNUM(TAKE(GIT(WHOLE))); ACLASS ~ SYMID; GO TO BSX; %M07377200
A63: COMMENT CHAINOP; I ~ I-1; T5 ~ BAE; %M07377300
T6 ~ PROGDESCBLDR(1,L,0); EMITV(897); SYMSEC ~ TRUE; %M07377400
SDNORM(MKCHAIN(FALSE)); EMITO(RTN); CONSTANTCLEAN; %M07377500
EMITB(BFW,T5,L); STEPIT; ACLASS~ SYMPROCID; GO TO BS; %M07377600
A61: COMMENT NIL; EMIT(0); ACLASS~ SYMID; %M07377700
IF SCLASS = RECID THEN SCLASS ~ SYMID; GO TO BSX; %M07377800
L32: 07378000
COMMENT LITERAL; 07379000
EMITL(ADDRSF); 07380000
BSXX: ACLASS ~ REALID; 07381000
BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000
L31:L33: 07383000
EMITNUM(C); GO TO BSXX; 07384000
EXIT: STACKCT ~ 0; QUOTETOG~QUOTETOGO;DPTOG~DPTOGO END; %M07385000
COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000
FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000
PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000
IS TRUE. PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000
OPERATIONS; 07390000
PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000
BEGIN 07392000
REAL HOLE,ADDRESS; 07393000
REAL A,B; %M07393500
LABEL EXIT; 07394000
SCATTERELBAT; 07395000
HOLE~ ELBAT[I]; 07396000
ADDRESS ~ ADDRSF; 07397000
CHECKER(HOLE); 07398000
IF ELCLASS ! PROCID THEN 07399000
IF NOT FORMALF THEN 07400000
IF TABLE(I+1) = ASSIGNOP THEN 07401000
BEGIN IF ELCLASS}BOOPROCID THEN VARIABLE(2-REAL(FROM)) ELSE %M07402000
IF HOLE.LINK!PROINFO.LINK THEN BEGIN ERR(211); %M07402100
GO EXIT END ELSE %M07402110
IF ELCLASS= STRINGPROCID THEN BEGIN STEPIT; QUOTETOG~TRUE; %M07402120
STEPIT; STRINGSEC(8); QUOTETOG ~ NOT FROM; EMITPAIR(514,STD); %M07402130
EMITPAIR(TAKE(GIT(PROINFO)).[30:10],IF FROM THEN STD ELSE SND); %M07402140
IF NOT FROM THEN EMITV(514) END ELSE %M07402150
IF ELCLASS=DBLPLXPROCID THEN DBLPLXVAR(FROM) ELSE %M07402200
BEGIN ELBAT[I] ~ABS(HOLE)&(ELCLASS+8)[2:41:7]&514[16:37:11]; %M07402300
IF ELCLASS=SYMPROCID THEN SYMVAR(FROM) ELSE RECVAR(FROM) %M07402400
END; GO TO EXIT END; %M07402500
COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000
IF ELCLASS ! PROCID EQV FROM 07404000
THEN BEGIN ERR(159); GO TO EXIT END; 07405000
COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000
IF ELCLASS=STRINGPROCID THEN B~1 ELSE %M07406100
IF ELCLASS=DBLPLXPROCID THEN B ~ NEWP(HOLE) ELSE B ~0; %M07406200
FOR A ~ 1 STEP 1 UNTIL B DO EMIT(0); %M07406300
STEPIT; 07407000
EMITO(MKS); 07408000
IF ELCLASS = LEFTPAREN 07409000
THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000
ELSE IF FORMALF THEN 07411000
IF FROM THEN ELSE L~L-1 07411100
ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000
IF HOLE.CLASS = SYMPROCID AND HOLE < 0 AND NOT %M07412100
BOOLEAN(HOLE.FORMAL) THEN %M07412150
ARGLIST(HOLE); %M07412200
EMITV(ADDRESS); 07413000
IF HOLE.CLASS=RECPROCID THEN RECTYPE ~ GETYPE(HOLE); %M07413500
COMMENT MONITOR CODE GOES HERE; 07414000
IF HOLE < 0 07415000
THEN IF HOLE.CLASS=SYMPROCID AND NOT BOOLEAN(HOLE.FORMAL) %M07416000
THEN BEGIN EMITPAIR(JUNK,SND); SYMONITOR(TRUE,HOLE,0,4);%T9307416500
END ELSE BEGIN %M07417000
EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000
EMITV(JUNK); EMITL(PASSTYPE(HOLE)); 07419000
EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000
EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000
(GIT(HOLE)).FUNCMONFILE); EMITL(1); 07422000
EMITV(GNAT(PRINTI)); 07423000
END; 07424000
EXIT: END PROCSTMT; 07425000
COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000
PROCEDURE STRMPROCSTMT; 07427000
BEGIN 07428000
INTEGER ADDRS; 07429000
REAL HOLE; HOLE ~ ELBAT[I]; %M07429500
IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000
THEN BEGIN 07431000
UNKNOWNSTMT; 07432000
END 07433000
07434000
07435000
07436000
07437000
07438000
07439000
ELSE BEGIN 07440000
IF ELCLASS!STRPROCID THEN BEGIN %M07441000
GT2 ~ IF ELCLASS=DBLPLXSTRPROCID THEN NEWP(ELBAT[I])+1 ELSE 1; %M07441100
FOR GT1~1 STEP 1 UNTIL GT2 DO EMIT(0) END; EMITO(MKS); STEPIT; %M07441200
GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000
GT4 ~ GT1-GT2.[7:6]; 07443000
FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000
DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000
COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000
JUMPS INSIDE OF STREAM PROCEDURES; 07447000
GT4 ~ GT2.[1:6]; 07448000
FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000
COMMENT THIS CODE CALLS ZERO LITS TO MAKE SPACE FOR LOCALS INSIDE 07450000
OF STREAM PROCEDURES; 07451000
IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000
ELSE BEGIN 07453000
ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000
IF HOLE.CLASS=RECSTRPROCID THEN RECTYPE ~ GETYPE(HOLE) %M07454500
END END STRMPROCSTMT; 07455000
COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000
ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000
INTEGER PROCEDURE BAE; 07458000
BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000
COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000
RELEASE(<MEMORY DESIGNATOR>) % AUXMEM RELEASE STATEMENT. 07460250
RELEASE(<TERMINAL BUFFER SPECIFIER>) % DATACOM RELEASE STATEMENT. 07460500
RELEASE(<FILE PART>) % FILE RELEASE STATEMENT. 07460750
; 07461000
PROCEDURE RELSESTMT; 07461250
BEGIN 07461500
LABEL DCR,PARENCHECK,EXIT; 07461750
IF STEPI!LEFTPAREN THEN 07462000
BEGIN ERR(105); GO EXIT END; 07462250
IF STEPI=UNKNOWNID THEN 07462500
BEGIN ERR(100); GO EXIT END; 07462750
IF ELCLASS=PROCID OR RANGE(BOOPROCID,INTPROCID) THEN 07463000
BEGIN 07463250
EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITPAIR(38,COM); 07463500
EMITO(DEL); STEPIT; GO PARENCHECK; 07463750
END; 07464000
IF RANGE(BOOARRAYID,INTARRAYID) THEN 07464250
BEGIN 07464500
VARIABLE(FL); 07464750
IF TABLE(I-2)=FACTOP THEN % A[*] = AUXMEM RELEASE. 07465000
BEGIN 07465250
EMITPAIR(38,COM); EMITO(DEL); GO PARENCHECK; 07465500
END 07465750
ELSE BEGIN % DATACOM RELEASE. 07466000
DCR: 07466250
EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500
EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750
EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000
END; 07467250
END; 07467500
IF ELCLASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750
BEGIN AEXP; GO DCR END; 07468000
CHECKER(ELBAT[I]); PASSFILE; 07468250
IF ELCLASS = COMMA THEN EMITO(DUP); 07468500
COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750
CHECKPRESENCE; 07469000
COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250
NOT COMPLETED; 07469500
EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750
IF ELCLASS = COMMA THEN 07470000
BEGIN 07470250
EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500
EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750
END; 07471000
EMITO(PRL); EMITO(DEL); 07471250
PARENCHECK: 07471500
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750
EXIT: 07472000
END RELSESTMT; 07472250
COMMENT DOSTMT HANDLES THE DO STATEMENT; 07481000
PROCEDURE DOSTMT; 07482000
BEGIN INTEGER TL; 07483000
DIALA ~ DIALB ~ 0; 07484000
STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000
ELSE BEGIN 07486000
STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000
END DOSTMT; 07488000
COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000
PROCEDURE WHILESTMT; 07490000
BEGIN INTEGER BACK,FRONT; 07491000
DIALA ~ DIALB ~ 0; 07492000
STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL; 07493000
IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000
BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000
CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000
COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000
EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000
OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000
STORAGE RETURNED. SEE DEXP AND GENGO; 07500000
PROCEDURE GOSTMT; 07501000
BEGIN 07502000
REAL ELBW; 07503000
REAL T,N; %A07503500
LABEL GOMCP,EXIT; 07504000
IF STEPI = TOV THEN STEPIT; 07505000
IF ELCLASS = LABELID THEN TB1 ~ TRUE 07506000
ELSE IF ELCLASS = SWITCHID THEN TB1 ~ FALSE ELSE GO GOMCP;07507000
IF NOT LOCAL(ELBAT[I]) THEN GO GOMCP; 07508000
IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000
CONSTANTCLEAN; GO EXIT END; 07510000
ELBW ~ ELBAT[I]; 07511000
IF ELBW < 0 07512000
THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000
EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000
CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)). 07515000
SWITMONFILE); EMITL(0); EMITV(GNAT( 07516000
PRINTI)); 07517000
END; 07518000
BANA; EMITPAIR(JUNK,ISD); 07519000
IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000
AND ELBW.ADDRESS = 0 THEN BEGIN 07521000
PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000
EMITB(BBW,L,GT4~GT1.[36:12]); 07523000
EMITB(BFW,GT4+13,L+3); 07524000
EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000
ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000
GO EXIT; 07527000
GOMCP: GOTOG ~ FALSE; DEXP; 07528000
IF GOTOG THEN NOGO; %M07528500
IF GOTOG THEN 07529000
BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100
ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200
EXIT:END GOSTMT; 07530000
COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 07531000
PARAMETER. GOGEN ASSUMES THAT THE LABEL IS LOCAL. THE 07532000
PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000
OR NOT; 07534000
PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000
VALUE LABELBAT,BRANCHTYPE; 07536000
REAL LABELBAT,BRANCHTYPE; 07537000
BEGIN 07538000
IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1] 07539000
THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000
COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000
NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000
THAT WE NOW KNOW WHERE TO GO; 07543000
ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000
PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000
COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000
A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000
BOOLEAN PROCEDURE SIMPGO; 07548000
BEGIN LABEL EXIT; 07549000
IF ELCLASS = GOV 07550000
THEN BEGIN 07551000
IF STEPI = TOV THEN STEPIT; 07552000
IF ELCLASS = LABELID THEN 07553000
IF LOCAL(ELBAT[I]) THEN 07554000
BEGIN SIMPGO ~ TRUE; GO EXIT END; 07555000
I ~ I-1; ELCLASS ~ GOV END; 07556000
EXIT: END SIMPGO; 07557000
COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000
OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000
EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000
PROCEDURE IFSTMT; 07561000
BEGIN REAL T1,T2; LABEL EXIT; 07562000
IFCLAUSE; 07563000
IF SIMPGO 07564000
THEN BEGIN 07565000
T1 ~ ELBAT[I]; 07566000
IF STEPI = ELSEV 07567000
THEN BEGIN 07568000
STEPIT; 07569000
IF SIMPGO 07570000
THEN BEGIN 07571000
GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000
STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000
STMT ; GO TO EXIT END END ; 07574000
EMITLNG; GOGEN(T1,BFC); 07575000
GO EXIT END; 07576000
T1 ~ BUMPL; STMT; 07577000
IF ELCLASS ! ELSEV THEN 07578000
BEGIN DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000
STEPIT; 07580000
IF SIMPGO 07581000
THEN BEGIN 07582000
T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000
STEPIT; GO EXIT END; 07584000
T2 ~ BUMPL; CONSTANTCLEAN; 07585000
EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000
EXIT: END IFSTMT; 07587000
COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000
ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000
AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000
UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 07591000
IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 07592000
PROCEDURE LABELR; 07593000
BEGIN LABEL EXIT, ROUND; 07594000
DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000
=GT4#,NEXTLINK=GT5#; 07596000
XMARK; 07596500
DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000
BEGIN ERR(133); GO TO EXIT END; 07598000
IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000
THEN BEGIN FLAG(134); GO TO ROUND END; 07600000
LINK ~ (ADDITIONAL ~ TAKE(INDEX ~ GIT(ELBATWORD))) 07601000
.[36:12]; 07602000
IF ADDITIONAL < 0 THEN 07603000
BEGIN FLAG(135); GO TO ROUND END; 07604000
WHILE LINK ! 0 07605000
DO BEGIN 07606000
NEXTLINK ~ GET(LINK-2); 07607000
EMITB(GET(LINK-1),LINK,L); 07608000
LINK ~ NEXTLINK; 07609000
IF LASTENTRY } 126 THEN % DONT LET EMITNUM DO IT 07609100
BEGIN REAL C; % HOLD L FOR A WHILE 07609200
COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300
(>1023 WORD) FORWARD REFERENCES TO A LABEL;07609400
C ~ BUMPL; 07609500
CONSTANTCLEAN; 07609600
EMITB(BFW,C,L) END;END; 07609700
PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000
IF ELBATWORD < 0 07611000
THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000
OR MONITOR DECLARATION; 07613000
IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000
THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000
LABELS; 07616000
EMITO(MKS); PASSALPHA(ELBATWORD); 07617000
EMITPAIR(GNAT(CHARI),LOD); 07618000
PASSMONFILE(RR1); EMITL(0); 07619000
EMITV(GNAT(PRINTI)); 07620000
END; 07621000
IF RR1~ADDITIONAL.DUMPEE ! 0 07622000
THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000
LABEL COUNTER; 07624000
EMITV(RR1); EMITL(1); EMITO(ADD); 07625000
EMITPAIR (RR1,STD); 07626000
IF RR1~ADDITIONAL.DUMPOR ! 0 07627000
THEN BEGIN COMMENT EMIT CODE TO CALL 07628000
THE DUMP ROUTINE; 07629000
07630000
07631000
07632000
STUFFF(RR1); EMITO07633000
(XCH);EMITO(COC); 07634000
07635000
07636000
07637000
07638000
07639000
07640000
EMITO(DEL); 07641000
END; 07642000
END; 07643000
END; 07644000
ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000
EXIT: END LABELR; 07646000
PROCEDURE CASESTMT(R); VALUE R; REAL R; %M07646100
BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110
CASE <ARITH EXP> OF BEGIN <COMPOUND TAIL> 07646120
AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130
IN THE <COMPOUND TAIL>, DEPENDING ON THE VALUE OF THE <ARITH EXP>. 07646140
ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150
THE <COMPOUND TAIL>. IF THERE ARE N STATEMENTS IN THE 07646160
<COMPOUND TAIL>, THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1, 07646170
AND THE <ARITH EXP> MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 07646180
WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 07646190
THE STATEMENTS IN THE <COMPOUND TAIL> MAY BE ANY EXECUTABLE 07646200
STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210
AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220
<ARITH EXP> 07646230
OPDC ARRAY 07646240
BFW 07646250
STMT 0 07646260
BRANCH TO RESUME 07646270
STMT 1 07646280
BRANCH TO RESUME 07646290
. 07646300
. 07646310
. 07646320
STMT N-1 07646330
RESUME: 07646340
"ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 07646350
CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 07646360
BY THE VALUE OF <ARITH EXP> AND CONTAINS SYLLABLE COUNTS 07646370
FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 07646375
IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 07646380
TRANSFERS TO RESUME DIRECTLY; 07646385
REAL LINK, TEMP, N, ADR, PRT, NULL; 07646390
REAL T; %M07646393
LABEL LX; %M07646395
REAL ARRAY TEDOC[0:7, 0:127]; 07646400
LABEL LOOP, XIT; 07646410
LINK ~ N ~ NULL ~ 0; 07646420
STEPIT; AEXP; 07646430
IF STEPI!BEGINV THEN BEGIN FLAG(70);I~I-1; COMPOUNDTAIL; GO XIT END;%T9007646440
EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450
EMITO(BFW); ADR ~ L; 07646460
T ~ R.[41:6]; %M07646465
LOOP: 07646470
ERRORTOG ~ TRUE; 07646475
IF BOOLEAN(R) THEN BEGIN QUOTETOG ~ T = 5; %M07646476
DPTOG ~ T=6 OR T=8; IF STEPI = ENDV THEN BEGIN %M07646477
QUOTETOG ~ DPTOG ~ FALSE; GO LX END; I~ I -1 END ELSE BEGIN %M07646478
IF STEPI = SEMICOLON THEN 07646480
BEGIN COMMENT NULL STATEMENT; 07646485
TEDOC[N.[38:3], N.[41:7]] ~ NULL; 07646490
NULL ~ N ~ N+1; GO TO LOOP; 07646495
END; I ~ I-1 END; %M07646500
TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510
IF NOT BOOLEAN(R) THEN BEGIN STEPIT; %M07646512
IF SIMPGO THEN 07646515
BEGIN COMMENT SIMPLE GO TO. DO NOT EMIT BRANCH TO RESUME; 07646520
ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646525
STMT; IF ELCLASS = SEMICOLON THEN GO TO LOOP 07646530
ELSE GO TO LX %M07646532
END ELSE I ~ I-1 END; %M07646535
IF BOOLEAN(R) THEN GENEXP(R.[41:6]) ELSE BEGIN STEPIT; STMT END; %M07646540
IF ELCLASS = SEMICOLON THEN %M07646542
BEGIN EMIT (LINK); LINK ~ L ~ L+1; GO TO LOOP END 07646545
; LX: %M07646550
IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555
% %D9907646556
WHILE NULL ! 0 DO 07646560
BEGIN TEMP ~ TEDOC[(NULL~NULL-1).[38:3], NULL.[41:7]]; 07646565
TEDOC[NULL.[38:3], NULL.[41:7]] ~ L-ADR; 07646570
NULL ~ TEMP; 07646575
END; 07646580
ENDTOG ~ TRUE; 07646585
COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590
DO STOPDEFINE ~ TRUE UNTIL STEPI { ENDV AND ELCLASS } UNTILV 07646595
OR NOT ENDTOG; 07646600
ENDTOG ~ FALSE; 07646610
COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620
MOVECODE(TEDOC, EDOC); 07646630
BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07646635
TEMP ~ SGNO; SEGMENTSTART; 07646640
SGNO ~ SGAVL; 07646650
Z ~ PROGDESCBLDR(LDES, 0, PRT); 07646660
SEGMENT(-N, SGNO, TEMP); 07646670
SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680
BUILDLINE ~ BUILDLINE.[46:1] ; 07646685
MOVECODE(TEDOC, EDOC); 07646690
COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700
IF (L-ADR)>1019 THEN ADJUST;% %D07646705
WHILE LINK ! 0 DO 07646710
BEGIN TEMP ~ GET(LINK-2); 07646720
EMITB(BFW, LINK, L); 07646730
LINK ~ TEMP; 07646740
IF LASTENTRY } 126 THEN 07646750
BEGIN REAL C; 07646760
COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770
C ~ BUMPL; 07646780
CONSTANTCLEAN; 07646790
EMITB(BFW, C, L); 07646800
END; 07646810
END; 07646820
XIT: 07646830
END CASESTMT; 07646840
PROCEDURE FILLSTMT;BEGIN 07647000
COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07648000
IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07649000
THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07650000
THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07651000
NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07652000
RESIDES ON THE DRUM AND IS READ INTO THE ROW DESIGNATED 07653000
BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07654000
EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07655000
ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07656000
NUMBERS LOOK LIKE IDENTIFIERS TO FILLSTMT AND ARE CONVERTED 07657000
BY COCT.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN PDPRT 07658000
TO SUPPLY INFO TO BUILD A DRUM DESCRIPTOR IN THE SEGMENT 07659000
DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07660000
LABEL L2,L3,L4; %W0307675000
INTEGER LX,SG; % %W0307675500
REAL T1,T3; 07676000
BOOLEAN V; %M07676100
ARRAY TEDOC[0:7,0:127]; DEFINE T2=T3.[38:3],T3.[41:7]#; 07676500
LABEL L,L1,EXIT; 07677000
IF STEPI<BOOARRAYID OR ELCLASS>INTARRAYID THEN 07678000
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07678100
BEGIN MAKEALABEL; GO TO EXIT END ELSE 07678200
BEGIN IF ELCLASS!STRINGID AND ELCLASS! STRINGARRAYID THEN %M07679000
BEGIN ERR(300); GO EXIT END END; %M07679500
IF ELCLASS < BOOARRAYID THEN %M07679600
STRINGVAR( TRUE) ELSE BEGIN %M07679700
VARIABLE(FL );COMMENT FL TELLS THE VARIABLE ROUTINE 07680000
IT IS COMING FROM THE FILL STATEMENT SO 07681000
IT MAY EXPECT A ROW DESIGNATOR.VARIABLE 07682000
THEN EMITS THE CODE; 07683000
IF TABLE(I - 2) ! FACTOP THEN FLAG(304); 07683100
END; %M07683150
IF ELCLASS!WITHV THEN BEGIN ERR(301); GO EXIT END; 07684000
STREAMTOG ~ BOOLEAN(2); 07684005
IF TABLE(I+1) { IDMAX THEN 07684010
IF Q = "7INQUI" THEN 07684020
BEGIN EMITL(9); EMITO(COM); EMITO(DEL); 07684030
STREAMTOG ~ FALSE; 07684035
I ~ I+1; STEPIT;GO TO EXIT END; 07684040
EMITNUM(SGAVL); T1 ~ 2|SGAVL-1; EMITL(7);T1~T1&1[5:47:1]; 07685000
EMITO(COM); EMITO(DEL); EMITO(DEL); SEGMENTSTART; 07686000
MOVECODE(TEDOC,EDOC); 07686500
BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); % 07686600
LX :=LL; SG := SGNO; SGNO := SGAVL; % %W0307686700
IF STEPI=DECLARATORS AND ELBAT[I].ADDRESS=STRINGV THEN BEGIN %M07687000
QUOTETOG~TRUE; STEPIT; QUOTETOG ~ FALSE; %M07687050
IF ELCLASS!QUOTEOP THEN BEGIN ERR(305); GO TO L1 END; T3~0; %M07687100
DO BEGIN %M07687200
COUNT ~ 0; %M07687300
DO BEGIN CHKND; RESULT~5; SCANNER; CHKND; %M07687400
END UNTIL (V ~ EXAMIN(NCR)=""") OR COUNT=8; %M07687500
MOVECHARACTERS(COUNT,ACCUM[1],3,EDOC[T2],0); %M07687600
END UNTIL T3 ~ T3 + 1 = 1022 OR V; %M07687700
IF V THEN BEGIN RESULT~5; SCANNER; STEPIT END ELSE ERR(305); %M07687800
GO TO L1 END ELSE I ~ I - 1; %M07687900
L:FOR T3~0 STEP 1 UNTIL 1022 DO 07688000
BEGIN LL:= T3 | 4; % %W0307688500
BEGIN IF STEPI=LITNO OR ELCLASS=NONLITNO THEN GO L2; %W0307689000
IF ELCLASS = STRNGCON THEN %W0307690000
IF COUNT=8 THEN BEGIN MOVECHARACTERS(8,ACCUM[1],3,%W0307690500
EDOC[T2],0); GO TO L3 END ELSE GO TO L2; %W0307691000
IF ELCLASS = ADOP THEN BEGIN %W0307691500
IF STEPI=LITNO OR ELCLASS=NONLITNO THEN BEGIN %W0307692000
C ~ C&ELBAT[I-1][1:21:1]; GO TO L2 END %W0307692500
END ELSE %W0307693000
IF ELCLASS{IDMAX THEN BEGIN %W0307693500
IF ACCUM[1].[18:18] ="OCT" THEN BEGIN %W0307694000
ACCUM[1].[18:18]~0; %W0307694500
OCTCON(FALSE,ACCUM[0]); GO TO L4 END %W0307695000
END ELSE %W0307695500
IF ELCLASS=TRUTHV THEN BEGIN %W0307696000
IF ELBAT[I].ADDRESS>1 THEN BEGIN %W0307697000
L4: MOVE(1,ACCUM[0],EDOC[T2]); GO TO L3 END END;%W0307698000
I ~ I-1; C ~ 0; COMMENT BLANK FIELD IS ZERO; %W0307699000
L2: MOVE(1,C,EDOC[T2]); %W0307700000
L3: C ~ 0; %W0307701000
IF STEPI!COMMA THEN GO TO L1 07702000
END; 07703000
END; % %W0307703500
L1: 07704000
07705000
LL:= LX; SGNO := SG; % %W0307705500
STREAMTOG~FALSE; 07706000
SEGMENT(T3+1,SGAVL,SGNO); 07707000
MOVECODE(TEDOC,EDOC); 07707500
BUILDLINE ~ BUILDLINE.[46:1] ; 07707650
SGAVL~SGAVL+1; 07708000
EXIT: END; 07709000
COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000
CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000
WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000
AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000
PROCEDURE STMT ; 07714000
BEGIN 07715000
INTEGER T; %M07715500
LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000
LFIELD,LSTRING,LINDBL,LINSYM,LATRNS,LTRN,LCHAIN,LSDCV,LSYMV,LDCA, %M07716500
LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000
LRV,LATE, %A07717500
LGO, LRELSE, LBEG, LBRK, EXIT; 07718000
SWITCH S ~ 07719000
LPROC,LSPROC,LFIELD,LSTRING,LINDBL,LINSYM,LERR,LERR,LATRNS,LERR , %M07720000
LTRN,LERR,LERR,LERR,LERR,LERR,LERR,LERR,LERR,LPROC, %M07720100
LPROC,LPROC,LPROC,LPROC,LPROC,LPROC,LPROC,LSTRING,LSDCV,LSYMV, %M07721000
LRV,LVAR,LVAR,LVAR,LVAR,LSTRING,LDCA,LSYMV,LRV,LATE, %A07722000
LATE,LATE,LATE,LAB,LERR,LERR,LERR,LERR,LERR,LERR, %A07723000
LERR,LCHAIN,LDEC,LREAD,LWRITE,LSPACE, %M07724000
LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000
EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000
LRELSE,LBEG; 07727000
COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010
CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020
GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030
ADDRESSING IS NOT POSSIBLE; 07727040
IF LASTENTRY !0 THEN 07727050
BEGIN GT2 ~ INFO [0,255]; 07727055
DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060
IF L- GT1 > 400 THEN 07727065
BEGIN GT1 ~ BUMPL; 07727070
CONSTANTCLEAN; 07727075
EMITB(BFW, GT1,L); 07727080
END; 07727085
END; 07727090
STACKCT ~ 0; %A 07727100
AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000
IF ELCLASS = 0 THEN 07728500
BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000
IF ELCLASS=LFTBRKET THEN BEGIN SFEXP(TRUE,TRUE,0); GO EXIT END; %A07729050
IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07729190
BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200
FLAG(145); 07729500
LERR: ERR(144); GO TO EXIT; 07730000
LATRNS: IF T ~ ELBAT[I].[27:6] <21 OR T >23 THEN GO TO LERR; %M07730100
IF T < 23 THEN BEGIN %M07730150
IF STEPI ! ASSIGNOP THEN GO LERR; %M07730160
STEPIT; AEXP; EMITO(SSP); %M07730180
EMITPAIR(IF T=21 THEN TABR ELSE COLR,ISD); GO TO EXIT END; %M07730200
FIXCLASS(REALID,INREAL,FALSE); GO TO LVAR; %A07730250
LCHAIN: GT1 ~ MKCHAIN(TRUE); GO TO EXIT; %M07730300
LFIELD: IF ELBAT[I].ADDRESS=STRINGV THEN GO LSTRING; %M07730350
FIELDC(ELBAT[I],0,TRUE); GO TO EXIT; %M07730375
LINDBL: IF NOT BOOLEAN(ELBAT[I].INCR) THEN GO TO LERR; %M07730400
FIXCLASS(DBLPLXID,INDBL,FALSE); %A07730450
LSDCV: LDCA: DBLPLXVAR(TRUE); GO TO EXIT; %M07730500
LRV: RECVAR(TRUE); GO TO EXIT; %M07730550
LSYMV: SYMVAR(TRUE); GO TO EXIT; %M07730600
LSTRING: STRINGSEC(2); GO TO EXIT; %M07730650
LTRN: NVALINT; GO TO EXIT; %M07730700
LINSYM: IF ELBAT[I].INCR ! 9 THEN GO TO LERR; %M07730750
ELBAT[I].CLASS ~ SYMID; ELBAT[I].ADDRESS ~ INSYM; GO TO LSYMV; %M07730800
LDEC: IF DECLCHECK THEN FLAG(146) ELSE BEGIN DBLSTMT; GO TO EXIT END; %M07731000
IF TABLE(I-2) = ENDV AND MODE > 0 07732000
THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000
I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000
ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000
LATE: IF TABLE(I+1) ! LFTBRKET THEN BEGIN %A07735500
IF BASICMATRIX THEN STRINGSEC(2) END %A07735505
ELSE VARIABLE(FS); GO EXIT; %A07735510
07735520
LPROC: PROCSTMT(TRUE); GO TO EXIT; 07736000
LSPROC: STRMPROCSTMT; GO TO EXIT; 07737000
LVAR: VARIABLE(FS); GO TO EXIT; 07738000
LAB: LABELR; GO TO AGAIN; 07739000
LREAD: READSTMT; GO TO EXIT; 07740000
LWRITE: WRITESTMT; GO TO EXIT; 07741000
LSPACE: SPACESTMT; GO TO EXIT; 07742000
LCLOSE: CLOSESTMT; GO TO EXIT; 07743000
LLOCK: LOCKSTMT; GO TO EXIT; 07744000
LRWND: RWNDSTMT; GO TO EXIT; 07745000
LDBL: CASESTMT(0); GO TO EXIT; %M07746000
LFOR: FORSTMT; GO TO EXIT; 07747000
LWHILE: WHILESTMT; GO TO EXIT; 07748000
LDO: DOSTMT; GO TO EXIT; 07749000
LFILL: FILLSTMT; GO TO EXIT; 07750000
LIF: IFSTMT; GO TO EXIT; 07751000
LGO: GOSTMT; GO TO EXIT; 07752000
LRELSE: RELSESTMT; GO TO EXIT; 07753000
LBEG: IF STEPI = DECLARATORS 07754000
THEN IF DECLCHECK %M07754500
THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000
ELSE COMPOUNDTAIL %M07755500
ELSE COMPOUNDTAIL; 07756000
EXIT: END STMT; 07757000
PROCEDURE UNKNOWNSTMT; 07800000
BEGIN LABEL XXX,E; 07801000
REAL J,N,C; 07802000
IF Q="5ERROR" THEN BEGIN EMITO(MKS); EMITL(SGNO); %M07802100
EMITL((L+3)DIV 4); PANA; EMITV(ERRPRO); GO TO XXX END; %M07802200
IF Q = "5BREAK" THEN 07803000
BEGIN EMIT(0); 07804000
EMIT(48); 07805000
EMITO(COM); 07806000
EMITO(DEL); 07807000
STEPIT; 07808000
GO TO XXX; 07809000
END; 07810000
IF Q = "3ZIP00" THEN 07811000
BEGIN IF TABLE(I+1) = WITHV THEN 07812000
BEGIN STEPIT; IF ROWD(TRUE) THEN BEGIN %A07813000
IF MAKEROW THEN GO TO E END ELSE %A07814000
IF ELCLASS=FILEID OR ELCLASS = SUPERFILEID %A07814100
THEN PASSFILE ELSE GO E; %A07814200
EMIT(16); EMITO(COM); EMITO(DEL); 07817000
GO TO XXX; 07818000
END; 07819000
N ~ 1; C ~ 8 07820000
END ELSE 07821000
IF Q = "5CHAIN" THEN 07821100
BEGIN N ~ 1; C ~ 37 END ELSE 07821200
IF Q = "4WHEN0" THEN 07822000
BEGIN N ~ 0; C ~ 6 END ELSE 07823000
IF Q = "4WAIT0" THEN 07824000
BEGIN N ~ 1; C ~ 2 END ELSE 07825000
IF Q = "4SWAP0" THEN 07825600
BEGIN ALPHA C, D; 07825610
EMITO(MKS); %A07825615
IF STEPI ! LEFTPAREN THEN 07825620
BEGIN ERR(105); GO TO XXX END; 07825630
IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 07825640
BEGIN ERR(171); GO TO XXX END; 07825650
IF TAKE(GIT(C~ELBAT[I])).[40:8] ! 2 THEN FLAG(171); 07825660
EMITPAIR(C.ADDRESS,LOD); %A07825670
CHECKER(C); ERRORTOG~TRUE; %T9007825675
IF STEPI ! COMMA THEN 07825680
BEGIN ERR(170); GO TO XXX END; 07825690
IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 07825700
BEGIN ERR(171); GO TO XXX END; 07825710
IF TAKE(GIT(D~ELBAT[I])).[40:8] ! 2 THEN FLAG(171); 07825720
EMITPAIR(D.ADDRESS,LOD); %A07825730
CHECKER(D); ERRORTOG~TRUE; %T9007825735
IF STEPI ! RTPAREN THEN ERR(104) ELSE STEPIT; 07825740
EMITV(GNAT(SWAPPER)); 07825750
GO TO XXX; 07825760
END ELSE 07825770
IF Q .[24:24]="MARG" THEN BEGIN FIXCLASS(INTID,0,TRUE); %A07825790
VARIABLE(FS); GO TO XXX END ELSE %A07825800
IF Q="4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000
IF Q="5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000
IF Q="6SEARC" THEN 07828000
BEGIN IF STEPI!LEFTPAREN THEN 07829000
BEGIN ERR(105); GO TO XXX END; 07830000
IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000
PASSFILE ELSE GO TO E; 07832000
IF ELCLASS!COMMA THEN GO TO E; 07833000
IF STEPI<BOOARRAYID OR ELCLASS>INTARRAYID THEN 07834000
GO TO E; 07835000
VARIABLE(FL); 07836000
IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000
IF ELCLASS!RTPAREN THEN 07838000
BEGIN ERR(104); GO TO XXX END; 07839000
EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000
STEPIT; GO TO XXX; 07841000
END ELSE 07842000
IF Q="4SEEK0" THEN 07843000
BEGIN IF STEPI!LEFTPAREN THEN 07844000
BEGIN ERR(105); GO TO XXX; END; 07845000
IF STEPI!FILEID AND ELCLASS!SUPERFILEID THEN 07846000
GO TO E ELSE 07847000
BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000
IF ELCLASS!LEFTPAREN THEN 07849000
BEGIN ERR(105); GO TO XXX; END; 07850000
STEPIT; AEXP; EMITO(XCH); 07851000
IF ELCLASS!RTPAREN THEN 07852000
BEGIN ERR(104); GO TO XXX; END; 07853000
IF STEPI!RTPAREN THEN 07854000
BEGIN ERR(104); GO TO XXX; END; 07855000
EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000
EMITO(DEL); EMITO(DEL); STEPIT; 07857000
END; GO TO XXX; 07858000
END ELSE 07859000
IF Q="6UNLOC" THEN 07859010
BEGIN IF STEPI!LEFTPAREN THEN 07859020
BEGIN ERR(105); GO TO XXX END; 07859030
IF ROWD(TRUE) THEN BEGIN %T9207859040
IF MAKEROW THEN FLAG(208) ELSE L ~ L - 1; %T9207859050
EMITO(DUP); EMITO(LOD); EMITL(0); 07859060
EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080
END ELSE ERR(208); %T9207859085
GO TO XXX 07859090
END ELSE %T9207859095
IF Q = "7TWXLO" THEN BEGIN %T9207859100
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO XXX END; %A07859200
QUOTETOG ~ TRUE; STEPIT; QUOTETOG ~ FALSE; %A07859300
IF ELCLASS ! QUOTEOP THEN BEGIN ERR(637); GO XXX END; %A07859400
QUOTETOG ~ TRUE; EMITNUM(SFTERM(FALSE)); %A07859500
IF ELCLASS ! COMMA THEN BEGIN ERR(606); GO XXX END;% %A07859600
IF STEPI ! SYMSTRPROCID THEN BEGIN ERR(680); GO XXX END;% %A07859700
IF NOT BOOLEAN(J~ELBAT[I]).FORMAL THEN %A07859710
IF TAKE(GIT(J)).[40:8]!0 THEN BEGIN ERR(732); GO XXX END; %A07859720
EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITV(TWXLOOP); %A07859800
STEPIT; %A07859850
RTPARN; GO XXX END ELSE% %A07859900
IF Q = "8FREEL" OR Q = "7NEXTA" THEN BEGIN% %A07859910
FIXCLASS(INTID,Q,BOOLEAN(3)); VARIABLE(FS); GO XXX END ELSE %A07859920
IF Q="@COMMU" THEN BEGIN % %T2907860000
GOTCHA := GOTCHA AND NOT STREAMER; % %T0307860050
PANA; EMITO(COM); GO XXX END ELSE %T2907861000
%T9307862000
%T9307864000
%T9307865000
BEGIN ERROR(100); GO TO XXX END; 07900000
IF STEPI ! LEFTPAREN THEN 07901000
BEGIN ERR(105); GO TO XXX END; 07902000
STEPIT; AEXP; 07903000
FOR J ~ 1 STEP 1 UNTIL N DO 07904000
BEGIN IF ELCLASS ! COMMA THEN 07905000
E: BEGIN ERR(164); GO TO XXX END; 07906000
STEPIT; AEXP; 07907000
END; 07908000
IF ELCLASS ! RTPAREN THEN 07909000
BEGIN ERR(104);GO TO XXX END; 07910000
EMITL(C); EMITO(COM); 07911000
FOR J ~ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000
STEPIT; 07913000
XXX: END; 07914000
COMMENT FORSTLIST COMPILES THE CONSTRUCT FOR <LIST> DO <STATEMENT>; %W3307915000
PROCEDURE FORSTLIST(J); VALUE J; INTEGER J; %W3307915010
BEGIN %W3307915020
INTEGER LISTADDRESS,JUMPPLACE,LL,NAME; %W3307915030
REAL LINFO,TEMP,VOBIT; %W3307915040
CHECKER(ELBAT[I]); %W3307915050
COMMENT J=0 IF FORSTLIST CALLED BY FORSTMT %W3307915060
J!0 IF FORSTLIST CALLED BY FORSTLIST; %W3307915070
IF J=0 THEN %W3307915080
BEGIN %W3307915090
EMITL(0); ADJUST; JUMPPLACE ~ L; %W3307915100
END ELSE JUMPPLACE ~ J; %W3307915110
EMITPAIR(LSTRTN,SND); %W3307915120
LISTADDRESS ~ ELBAT[I].ADDRESS; %W3307915130
COMMENT SET UP THE LIST AS IF IT WERE A REAL VARIABLE; %W3307915140
TEMP ~ TAKE(LINFO ~ ELBAT[I].LINK); %W3307915150
IF MODE = 0 THEN FLAG(510) ELSE %73 %W3307915155
NAME ~ GETSPACE(FALSE,-1); %W3307915160
VOBIT ~ IF BOOLEAN(TEMP.FORMAL) THEN TEMP ELSE TEMP & 2[9:46:2];%W3307915170
PUT(VOBIT & LEVEL[11:43:5] & REALID[2:41:7] & NAME[16:37:11], %W3307915180
LINFO); %W3307915190
EMITN(LISTADDRESS); EMITPAIR(NAME,STD); %W3307915200
EMITV(LSTRTN); EMITPAIR(0,GEQ); LL ~ BUMPL; %W3307915210
IF STEPI = COMMA THEN %W3307915220
IF STEPI = LISTID THEN FORSTLIST(JUMPPLACE) ELSE ERR(475) %W3307915230
ELSE BEGIN %W3307915240
IF ELCLASS!DOV THEN ERR(475) ELSE STEPIT; EMITO(DEL); %W3307915250
COMMENT ERROR 475 INDICATES MISSING DO OR NON LIST ELEMENT; %W3307915260
DIALA ~ DIALB ~ 0; %W3307915270
STMT; %W3307915280
EMITL(5); EMITB(BBW,BUMPL,JUMPPLACE); %W3307915290
CONSTANTCLEAN; ADJUST; %W3307915300
EMITO(DEL); EMITL(5); %W3307915310
EMITPAIR(LSTRTN,STD); %W3307915320
END; %W3307915330
EMITB(BFC,LL,L-4); %W3307915340
COMMENT SET THE LIST BACK TO BE A LIST (NOW REAL); %W3307915350
PUT(TAKE(LINFO)& TEMP[1:1:34],LINFO); %W3307915360
DIALA ~ DIALB ~ 0; %W3307915370
END FORSTLIST; %W3307915380
PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"<FAULTYPE>~" 07920000
KIND OF STATEMENT, FOR THE RUN-TIME ERROR MESS; 07921000
BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000
CHECKER(ELBW~ELBAT[I]); STR~IF FAULTOG THEN SND ELSE STD; 07923000
FAULTOG := TRUE & (FAULTOG.[46:1]) [46:47:1]; % %D0107923100
IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000
IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000
IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100
EMITPAIR(ADRES,STR); 07926000
FAULTOG~FALSE&(ELBW.LVL<LEVEL OR FAULTOG.[46:1])[46:47:1]; 07926100
END FAULTSTMT NOW WASNT THAT SIMPLE; 07927000
PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
BEGIN COMMENT KLUDGE HANDLES ARRAY-ROW READS AND WRITES FOR 07931000
THOSE CASES WHICH DO NOT NEED TO GO THROUGH THE 07932000
FORMATTING INTRINSICS. A NEW MCP INTRINSIC IS 07933000
USED, TO FURTHER IMPROVE SPEED/DECREASE CORE USE; 07934000
LABEL EXIT; 07935000
L ~ ABS(T); 07936000
AEXP; 07937000
IF ELCLASS!COMMA THEN BEGIN ERR(426); GO TO EXIT; END; 07938000
IF NOT ROWD(TRUE) THEN %M07939000
BEGIN ERR(429); GO TO EXIT; END; 07940000
IF MAKEROW THEN %M07941000
BEGIN ERR(427); GO TO EXIT; END; 07942000
IF ELCLASS!RTPAREN THEN BEGIN ERR(428); GO TO EXIT; END; 07943000
EMITO(XCH); 07944000
IF T<0 THEN COMMENT FROM WRITE...(<0 IS FROM READ); 07945000
BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITV(JUNK); END; 07946000
IF T>0 THEN IF TABLE(I+1)=LFTBRKET THEN 07947000
BEGIN GOGOGO ~ FALSE;% JUST TO MAKE SURE... 07948000
HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000
L ~ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000
EMITO(DEL); EMITO(DEL);% REMOVE LABEL WORDS... 07951000
END ELSE STEPIT ELSE STEPIT;% WALTZ ON BY... 07952000
EMITV(GNAT(SUPERMOVER));% BET YOU THOUGHT I"D NEVER DO IT 07953000
EXIT: END THIS HAIRY KLUDGE;% 07954000
COMMENT FORSTMT IS REPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 08000000
IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 08001000
THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 08002000
ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 08003000
CONSTANT, THEN THE CODE TAKES ON A MORE EFFICIENT FORM. 08004000
IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 08005000
THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 08006000
STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 08007000
PROCEDURE FORSTMT; 08008000
BEGIN 08009000
OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET, 08010000
BRET; 08011000
OWN BOOLEAN SIGNA,SIGNB,SIGNC, INT, 08012000
CONSTANA,CONSTANB,CONSTANC; 08013000
DEFINE SIMPLEB = SIGNC#, FORMALV = SIGNA#, 08014000
SIMPLEV = CONSTANA#, A = V#, Q = REGO#, 08015000
OPDC = TRUE#, DESC = FALSE#, K = BRET#; 08016000
LABEL EXIT,XIT; %W3308017000
COMMENT FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 08017100
IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 08017200
INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 08017300
RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 08017400
BOOLEAN PROCEDURE FORCLASS(CLSS); VALUE CLSS; INTEGER CLSS; 08017500
IF STEPI = CLSS THEN FORCLASS ~ TRUE ELSE 08017600
IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON THEN 08017700
BEGIN INFO[0,K~K+1] ~ C; 08017800
ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11] 08017900
END FORCLASS; 08017950
COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 08018000
CONSTANT DEPENDING ON THE REQUIREMENTS; 08019000
PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 08020000
IF C THEN EMITNUM (A) ELSE BEGIN 08021000
CHECKER (A); 08021100
EMITV(A.ADDRESS) END; 08021200
COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A 08022000
CONSTANT OR A SIMPLE VARIABLE. IT MAKES A THROUGH REPORT 08023000
ON ITS ACTIVITY. IT ALSO MAKES PROVISION FOR THE RESCAN 08024000
OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE 08025000
TABLE ROUTINE FOR FURTHER DETAILS); 08026000
BOOLEAN PROCEDURE SIMPLE(B,A,S); BOOLEAN B,S; REAL A; 08027000
BEGIN 08028000
S ~ IF STEPI ! ADOP THEN FALSE ELSE ELBAT[I].ADDRESS 08029000
= SUB; 08030000
IF ELCLASS = ADOP THEN STEPIT; 08031000
IF ELCLASS } NONLITNO AND ELCLASS { STRNGCON 08032000
THEN BEGIN K ~ K+1; SIMPLE ~ TRUE; 08033000
ELBAT[I] ~ 0&COMMENTV[2:41:7]&K[16:37:11]; 08034000
INFO[0,K] ~ A ~ C; B ~ TRUE END 08035000
ELSE BEGIN 08036000
B ~ FALSE; A ~ ELBAT[I]; 08037000
SIMPLE ~ REALID { ELCLASS AND ELCLASS { INTID END; 08038000
END SIMPLE; 08039000
COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000
PROCEDURE TEST; 08041000
BEGIN 08042000
IF NOT CONSTANB THEN 08043000
BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000
ELSE BEGIN 08045000
EMITL(2+L-BRET); 08046000
EMITB(BBW,BUMPL,B); 08047000
END; 08048000
EMITO(MUL); EMIT(0) END; 08049000
EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000
END TEST; 08051000
BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000
BEGIN 08053000
CHECKER(VRET~ALL); 08054000
ADDRES ~ ALL.ADDRESS; 08055000
FORMALV ~ ALL.[9:2] = 2; 08056000
IF T ~ ALL.CLASS > INTARRAYID OR T< REALID OR %M08057000
(T > INTID AND T< REALARRAYID) THEN %M08058000
ERR(REAL(T ! 0) | 51 + 100); 08059000
INT ~ T= INTID OR T= INTARRAYID; %M08060000
SIMPI ~ T { INTID END SIMPI; 08061000
COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000
PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000
BEGIN 08064000
IF FORMALV THEN BEGIN EMITO(XCH); S ~ FALSE END 08065000
ELSE BEGIN 08066000
EMITL(ADDRES); 08067000
IF ADDRES > 1023 THEN EMITO(PRTE) END; 08068000
T ~ (REAL(S)+1)|16; 08069000
EMITO((IF INT THEN T+512 ELSE 4|T)+4) END STORE; 08070000
COMMENT CALL EFFECTS A CALL ON THE INDEX; 08071000
PROCEDURE CALL(S); VALUE S; BOOLEAN S; 08072000
BEGIN 08073000
IF SIMPLEV 08074000
THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES) 08075000
ELSE BEGIN 08076000
EMITL(2+L-VRET); 08077000
EMITB(BBW,BUMPL,V); 08078000
IF S THEN EMITO(LOD) END END CALL; 08079000
PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 08080000
BEGIN 08081000
PROCEDURE FIX(STORE,BACK,FORWART,START); 08082000
VALUE STORE,BACK,FORWART,START; 08083000
REAL STORE,BACK,FORWART,START; 08084000
BEGIN 08085000
EMITB(GET(FORWART-1),FORWART,START); 08086000
IF RETURNSTORE ! 0 08087000
THEN BEGIN 08088000
L ~ STORE; EMITNUM(B-BACK); 08089000
EMITPAIR(RETURNSTORE,STD) END END FIX; 08090000
INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX; 08091000
LABEL BRNCH,EXIT; 08092000
STOREFIX ~ L; Q ~ REAL(MODE=0)+3; 08093000
FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000
IF NUMLE 08095000
THEN BEGIN 08096000
BACKFIX ~ L; 08097000
IF FORMALV THEN CALL(DESC) END 08098000
ELSE BACKFIX ~ V + REAL(SIMPLEV)-1; 08099000
DIALA ~ DIALB ~ 0; 08100000
AEXP; DIALA ~ DIALB ~ 0; 08101000
COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 08102000
IF ELCLASS = STEPV 08103000
THEN BEGIN 08104000
COMMENT HERE WE HAVE A STEP ELEMENT; 08105000
BACKFIX ~ BUMPL; 08106000
COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000
IF FORMALV THEN CALL(DESC); CALL(OPDC); 08108000
COMMENT FETCH INDEX; 08109000
IF I > 70 THEN BEGIN NXTELBT ~ 1; I ~ 0 END 08110000
ELSE REGO ~ I; 08111000
IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) AND 08112000
(STEPI = UNTILV OR ELCLASS = WHILEV) 08113000
THEN BEGIN 08114000
COMMENT WE HAVE A SIMPLE STEP FUNCTION; 08115000
PLUG(CONSTANB ,B); 08116000
END ELSE BEGIN 08117000
COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 08118000
SUBROUTINE; 08119000
I ~ IF I < 4 THEN 0 ELSE REGO; STEPIT; 08120000
SIGNB ~ CONSTANB ~ FALSE; 08121000
EMIT(0); B ~ L; 08122000
AEXP; EMITO(XCH); 08123000
BRET ~ L; 08124000
EMITO(BFW) END; 08125000
EMITO(REAL(SIGNB)|32+ADD); 08126000
EMITB(BFW,BACKFIX,L); 08127000
IF ELCLASS = UNTILV 08128000
THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000
STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000
STEPIT; AEXP; TEST END 08131000
ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000
IF ELCLASS ! WHILEV THEN 08133000
BEGIN ERR(153); GO TO EXIT END; 08134000
STEPIT; STORE(FALSE); BEXP END END 08135000
ELSE BEGIN 08136000
COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000
STORE(FALSE); 08138000
IF ELCLASS = WHILEV 08139000
THEN BEGIN 08140000
COMMENT WE HAVE A WHILE ELEMENT; 08141000
STEPIT; BEXP END 08142000
ELSE BEGIN 08143000
COMMENT ONE EXPRESSION ELEMENT; 08144000
IF ELCLASS ! COMMA THEN BEGIN 08145000
EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END 08146000
ELSE BACKFIX ~ L + 2; 08147000
L ~ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000
COMMENT THIS IS THE COMMON POINT; 08149000
IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000
EMIT(BFC); 08151000
BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000
IF ELCLASS = COMMA 08153000
THEN BEGIN 08154000
STEPIT; 08155000
FORLIST(TRUE); 08156000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000
ELSE BEGIN 08158000
IF ELCLASS ! DOV 08159000
THEN BEGIN ERR(154); REGO~L; GO EXIT END; 08160000
STEPIT; 08161000
IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000
IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000
08164000
IF NUMLE THEN BEGIN 08165000
EMITV(RETURNSTORE ~ FOOT); EMITO(BBW) END 08166000
ELSE BEGIN 08167000
EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000
STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000
CONSTANTCLEAN; REGO ~ L; 08170000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000
EXIT: END FORLIST; 08172000
REAL T1,T2,T3,T4; 08173000
LABEL NF; %M08173500
NXTELBT ~ 1; I ~ 0; 08174000
IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %M08175000
EMITNUM(C); %M08175050
NF: T1 ~ L; EMITPAIR(T3 ~FORAD,SND); EMIT(0); %M08175075
EMITO(GTR); T2 ~ BUMPL; %M08175100
IF STEPI= DOV THEN STEPIT ELSE BEGIN ERR(154); GO EXIT END; %M08175150
STMT; DCRFR; %M08175225
EMITV(T3); EMITL(1); EMITO(SUB); EMITB(BBW,BUMPL,T1); %M08175250
EMITB(BFC,T2,L); GO TO EXIT END; %M08175300
IF ELCLASS = SYMID THEN BEGIN CHECKER(VRET ~ ELBAT[I]); %M08175350
T4 ~ VRET.ADDRESS; FORMALV ~ VRET.[9:2]=2; %M08175400
IF (INT~ STEPI = DECLARATORS AND ELBAT[I].ADDRESS= INV) OR %M08175450
ACCUM[1] = "2ON000" THEN BEGIN QUOTETOG ~ TRUE; %M08175500
STEPIT; SEXPN; QUOTETOG ~ FALSE; %M08175510
IF INT THEN BEGIN MARKSYM ~ RECLAIMTOG; %M08175540
T3 ~ FORAD; MARKSYM ~ FALSE; %M08175550
T1 ~ L; GETCONTENTS(0,FALSE); %M08175560
EMITPAIR(T3,SND); EMIT(0); EMITO(GEQ); %M08175570
IF ELCLASS=WHILEV THEN BEGIN STEPIT; BEXP; EMITO(LND) END %M08175572
ELSE IF ELCLASS=UNTILV THEN BEGIN STEPIT; BEXP; EMITLNG; %M08175575
EMITO(LND) END; %M08175577
IF ELCLASS = DOV THEN STEPIT ELSE %M08175578
BEGIN ERR(154); GO EXIT END; %M08175579
T2 ~ BUMPL; EMITV(T3); EMITI(0,18,15); %M08175580
IF FORMALV THEN BEGIN EMITN(T4); EMITO(STD) END ELSE %M08175590
EMITPAIR(T4,STD); %M08175600
STMT; FORLEVEL ~ FORLEVEL-REAL(RECLAIMTOG)-1; EMITV(T3); %M08175610
EMITB(BBW,BUMPL,T1); EMITB(BFC,T2,L); %M08175620
IF RECLAIMTOG THEN BEGIN EMIT(0); EMITPAIR(T3,STD) END %M08175630
END ELSE %M08175640
BEGIN T1 ~ L; EMITI(0,33,15); %M08175650
IF FORMALV THEN BEGIN EMITN(T4); EMITO(SND) END ELSE %M08175660
EMITPAIR(T4,SND); EMIT(0); EMITO(NEQ); %M08175670
IF ELCLASS=WHILEV THEN BEGIN STEPIT; BEXP; EMITO(LND) END %M08175680
ELSE IF ELCLASS=UNTILV THEN BEGIN STEPIT; BEXP; EMITLNG; %M08175690
EMITO(LND) END; %M08175700
IF ELCLASS = DOV THEN STEPIT ELSE %M08175703
BEGIN ERR(154); GO EXIT END; %M08175705
T2 ~ BUMPL; %M08175710
STMT; %M08175720
EMITV(T4); GETCONTENTS(0,FALSE); %M08175730
EMITB(BBW,BUMPL,T1); %M08175740
EMITB(BFC,T2,L); %M08175750
END END ELSE ERR(151); %M08175760
GO TO EXIT END; %M08175780
IF ELCLASS = LISTID AND NOT LISTMODE THEN %W3308175785
BEGIN FORSTLIST(0); GO TO XIT END; %W3308175790
IF SIMPI(VRET~ELBAT[I]) 08176000
THEN BEGIN 08177000
IF STEPI!ASSIGNOP THEN BEGIN %M08178000
IF ELCLASS!DOV THEN BEGIN ERR(152); GO EXIT END; %M08178100
EMITV(ADDRES); I ~ I - 1; GO NF END; %M08178200
T1 ~ L; IF FORMALV THEN EMITN(ADDRES); 08179000
K ~ 0; 08180000
IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000
IF FORCLASS(STEPV) THEN 08182000
IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000
IF FORCLASS(UNTILV) THEN 08184000
IF SIMPLE(CONSTANC,Q,SIGNC) THEN 08185000
IF FORCLASS(DOV) THEN 08186000
BEGIN 08187000
PLUG(CONSTANA,A); 08188000
IF SIGNA THEN EMITO(CHS); 08189000
RETURNSTORE ~ BUMPL; ADJUST; CONSTANTCLEAN; 08190000
STMTSTART ~ L; 08191000
STEPIT; 08192000
T1 ~ ((((4096 | RETURNSTORE+STMTSTART)|2+ 08193000
REAL(CONSTANB))|2+ 08194000
REAL(CONSTANC))|2+ 08195000
REAL(SIGNB))|2+ 08196000
REAL(SIGNC); 08197000
T2 ~ VRET; 08198000
T3 ~ B; 08199000
T4 ~ Q; 08200000
IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000
SIGNC ~ BOOLEAN(T1.[47:1]); 08202000
SIGNB ~ BOOLEAN(T1.[46:1]); 08203000
CONSTANC ~ BOOLEAN(T1.[45:1]); 08204000
CONSTANB ~ BOOLEAN(T1.[44:1]); 08205000
STMTSTART ~ T1.[32:12]; 08206000
RETURNSTORE ~ T1.[20:12]; 08207000
VRET ~ T2; 08208000
B ~ T3; 08209000
Q ~ T4; 08210000
SIMPLEV~ SIMPI(VRET); 08211000
IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000
PLUG(CONSTANB,B); 08213000
EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000
EMITB(BFW,RETURNSTORE,L); 08215000
STORE(TRUE); 08216000
IF FORMALV THEN CALL(OPDC); 08217000
PLUG(CONSTANC,Q); 08218000
IF SIGNC THEN EMITO(CHS); 08219000
SIMPLEB ~ TRUE; TEST; EMITLNG; 08220000
EMITB(BBC,BUMPL,STMTSTART); 08221000
GO TO EXIT END; 08222000
I ~ 2; K ~ 0; 08223000
SIMPLEV ~ SIMPI(VRET); 08224000
V ~ T1 END 08225000
ELSE BEGIN 08226000
EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000
VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000
IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000
END; 08230000
STEPIT; FORLIST(FALSE); L ~ REGO; 08231000
EXIT: K~ 0; XIT: END FORSTMT; %W3308232000
PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000
BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000
SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000
LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000
COLON HAS JUST BEEN DETECTED; 08237000
LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08238000
EXECUTABLE STATEMENT IN THIS ROUTINE; 08239000
IF STEPI = LFTBRKET 08240000
THEN BEGIN COMMENT THIS CODE HANDLES PARITY AND END OF 08241000
FILE LABELS; 08242000
IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08243000
IF ELCLASS ! COLON THEN EMIT(0) ELSE 08244000
BEGIN STEPIT; DEXP END; 08245000
08246000
08247000
08248000
08249000
08250000
08251000
08252000
08253000
08254000
08255000
08256000
08257000
08258000
08259000
08260000
08261000
08262000
08263000
08264000
08265000
08266000
08267000
08268000
08269000
08270000
08271000
08272000
08273000
08274000
08275000
08276000
IF CHECK(RTBRKET,433) 08277000
THEN GO TO EXIT; 08278000
COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 08279000
IN READ OR SPACE STATEMENT; 08280000
STEPIT; 08281000
END 08282000
ELSE BEGIN COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS08283000
CASE; 08284000
EMITL(0); EMITL(0); 08285000
END; 08286000
IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000
EMITV(13) 08287100
END ELSE EMITV(GNAT(INTERPTI)); 08287200
GOGOGO ~ FALSE;% 08287300
EXIT:; 08288000
END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000
DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010
EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020
EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030
PROCEDURE LISTPARA; %W3308289100
BEGIN %W3308289200
INTEGER LISTADDRESS; %W3308289300
IF ELCLASS=LFTBRKET THEN %W3308289400
BEGIN %W3308289500
STEPIT; RR1 ~ LISTGEN; %W3308289600
IF ELCLASS ! RTBRKET THEN ERR(158) ELSE STEPIT %W3308289700
END %W3308289800
ELSE IF ELCLASS ! LISTID AND ELCLASS ! SUPERLISTID %W3308289810
THEN RR1 ~ LISTGEN %W3308289820
ELSE BEGIN %W3308289830
CHECKER(ELBAT[I]); %W3308289840
LISTADDRESS ~ ELBAT[I].ADDRESS; %W3308289850
IF ELCLASS = SUPERLISTID THEN %W3308289860
BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; %W3308289870
BANA;EMITN(LISTADDRESS); %B8-6 %67 %W3308289880
EMITO(LOD); %B8-6 %67 %W3308289884
EMITO(LOD); %W3308289886
END ELSE %W3308289890
BEGIN COMMENT A COMMON LIST ID; %W3308289900
EMITL(LISTADDRESS); IF LISTADDRESS > 1023 THEN EMITO(PRTE); %W3308289910
EMITO (LOD); STEPIT; %W3308289915
END %W3308289920
END %W3308289930
END LISTPARA; %W3308289940
PROCEDURE READSTMT; 08290000
BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI(WHICH IS08291000
SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000
DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000
THE READ OR SPACE STATEMENT. 08294000
THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000
STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000
REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000
EXPRESSION IN THE SPACE STATEMENT. 08298000
I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000
READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000
ARE PASSED TO INTERPTI. 08301000
**********************************************************08302000
<DIRECTION INDICATOR>::=REVERSE/<EMPTY> 08303000
<FILE PART>::=<FILE IDENTIFIER>/<SUPERFILE DESIGNATOR> 08304000
<RELEASE INDICATOR>::=[NO]/<EMPTY> 08305000
<ACTION LABELS>::=[<END OF FILE LABEL>:<PARITY LABEL>]/ 08306000
[<END OF FILE LABEL>]/[:<PARITY LABEL>]/08307000
<EMPTY> 08308000
CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000
POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000
CONVERSION. 08311000
FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000
ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000
1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000
REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000
VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000
PROCESSED. 08317000
END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL08318000
DESCRIPTOR FOR END OF FILE JUMPS. 08319000
PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000
DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000
+ OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT08322000
DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE08323000
GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS08324000
IN ACTION TYPE. 08325000
LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000
DESCRIPTRO WHICH WILL EITHER RETURN08327000
AN ADDRESS OR VALUE DEPENDING ON 08328000
THE CALL. 08329000
N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>) 08331000
<ACTION LABELS> 08332000
- - - - - - - - - - - - - - 08333000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000
,PARITY LABEL) 08335000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08337000
<FORMAT PART>)<ACTION LABELS> 08338000
- - - - - - - - - - - - - - 08339000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000
ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000
SPACE(<FILE PART>,<ARITHMETIC EXPRESSION>)<ACTION LABELS> 08343000
- - - - - - - - - - - - - - 08344000
(CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000
PARITY LABEL) 08346000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08348000
<FORMAT PART>,<LIST>)<ACTION LABELS> 08349000
- - - - - - - - - - - - - - 08350000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000
ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000
LABEL,PARITY LABEL) 08353000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08355000
*,<LIST>)<ACTION LABELS> 08356000
- - - - - - - - - - - - - - 08357000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000
DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08361000
<ARITHMETIC EXPRESSION>,<ROW DESIGNATOR>)<ACTION 08362000
LABELS> 08363000
- - - - - - - - - - - - - - 08364000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000
END OF FILE LABEL,PARITY LABEL) 08366000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000
READ<DIRECTION INDICATOR>(<FILE PART><RELEASE INDICATOR>, 08368000
<MULTIPLYING OPERATOR>,<LIST>)<ACTION LABELS> 08369000
- - - - - - - - - - - - - - 08370000
(CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000
DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000
*********************************************************;08373000
DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE08374000
IF THE STATEMENT BEING COMPILED08375000
IS A READ REVERSE, OTHERWISE IT08376000
IS SET FALSE; 08377000
LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08378000
EXECUTABLE STATEMENT IN READSTMT; 08379000
LABEL CHKACTIONLABELS; COMMENT THE CODE AT THIS LABEL 08380000
ASSUMES I IS POINTING AT THE RIGHT 08381000
PARENTHESIS; 08382000
LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I TO08383000
BE POINTING AT THE LAST QUANTITY IN THE 08384000
SECOND PARAMETER; 08385000
INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500
LABEL EXPFORMR; %W4008385550
BOOLEAN SEEKTOG,LOCKTOG,GRABTOG; % %P08385600
BOOLEAN JR; LABEL REMT; %A08385650
BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700
INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800
IF STEPI = LEFTPAREN 08386000
THEN REVERSETOG~SEEKTOG~FALSE 08387000
ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000
IF JR ~ ACCUM[1] = "3TWX00" THEN BEGIN STEPIT; EMITO(MKS); %A08388100
GO REMT END; %A08388200
IF ELCLASS = LFTBRKET THEN BEGIN % %T6008388300
DO IF SYMID { STEPI AND ELCLASS { INTID THEN BEGIN % %T6008388350
CHECKER(RR9 ~ ELBAT[I]); % %T6008388400
EMITO(MKS); EMITV(TERPRIN); % %T6008388425
EMITO(MKS); MKALF(RR9); EMITV(ALFPRINT); % %T6008388450
EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); % %T6008388475
EMITO(MKS); EMITL("="); EMITV(CHARPRINT); % %T6008388500
EMITO(MKS); EMITV(TERPRIN); % %T6008388525
EMITO(MKS); % %T6008388550
IF ELCLASS = SYMID THEN EMITV(READ1) ELSE BEGIN % %T6008388554
EMIT(IF ELCLASS = ALFAID THEN 40 ELSE 20); % %T6008388558
EMIT(0); EMITV(READN); END; % %T6008388560
EMITN(RR9.ADDRESS); % %T6008388650
EMITO(IF ELCLASS = INTID THEN ISD ELSE STD); % %T6008388700
RR8 ~ BUMPL; CONSTANTCLEAN; EMITB(BFW,RR8,L); % %T6008388725
END ELSE BEGIN ERR(638); GO EXIT; END % %T6008388750
UNTIL STEPI ! COMMA; % %T6008388800
IF ELCLASS ! RTBRKET THEN ERR(118) ELSE STEPIT; % %T6008388850
GO EXIT; % %T6008388900
END; % %T6008388950
REVERSETOG~ACCUM[1]="7REVER"; 08389000
LOCKTOG ~ ELCLASS=LOCKV; %R08390000
SEEKTOG~ACCUM[1]="4SEEK0"; 08390500
IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000
ELSE BEGIN ERR(420); 08392000
GO TO EXIT; 08393000
END; 08394000
IF CHECK(LEFTPAREN,421) 08395000
THEN GO TO EXIT; 08396000
COMMENT ERROR 421 MEANS MISSING LEFT 08397000
PARENTHESIS IN READ REVERSE STATEMENT; 08398000
END; 08399000
EMITO(MKS); 08400000
IF ROWD(TRUE) THEN %M08401000
BEGIN %M08401020
IF ELCLASS = STRINGID THEN %A08401021
IF ACCUM[1] = "5TWXS1" AND DACP ! 0 THEN BEGIN %A08401022
REMT: DACP ~ -ABS(DACP); %A08401023
IF DAC[4]=0 OR DAC[5]=0 OR DACOMI = 0 THEN %A08401024
BEGIN FLAG(880); DACOMI := 1; END; %T9308401025
EMIT(0); EMITPAIR(CPI,STD); EMITL(1); EMITPAIR(DAC[4],STD); %A08401026
EMITV(DACOMI); EMITO(DEL); %A08401027
IF JR THEN GO EXIT; %T9308401028
IF TABLE(I+1) = RTPAREN THEN BEGIN STEPIT; GO EXIT END; %T9308401029
EMITO(MKS); END; %T9308401030
IF MAKEROW THEN %T9308401035
BEGIN ERR(422); GO TO EXIT END; 08401040
MAYI ~ TRUE; HOLD ~ L; 08401045
EMIT(11); EMIT(4); EMITO(280); 08401050
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060
EMITO(XCH); EMITL(0); EMITL(1); 08401070
END ELSE 08401080
BEGIN 08401090
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000
IF NOT RANGE(FILEID,SUPERFILEID) 08403000
THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000
STATEMENT; 08405000
ERR(422); GO TO EXIT; 08406000
END; 08407000
PASSFILE; 08408000
IF ELCLASS = LFTBRKET 08409000
THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,<AEXP>], %B0208410000
%%% [*],[*,*],[*,<AEXP>],[<AEXP>],[<AEXP>,*], 08410010
%%% AND [<AEXP>,<AEXP>]. THE FIRST (LEFTMOST) 08410020
%%% <AEXP> IS THE READSEEKDISTADDRESS, RESIDING08410030
%%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000
%%% <AEXP> IS THE WAIT-TIME, RESIDING IN THE 08411010
%%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON08411020
%%% THE EXP-SIGN BIT OF DSKADDR.X"S ARE EMPTIES08411030
%%% IN THE ABOVE, NS = NO OR STOP. %B0208411040
STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000
IF RR1~IF ACCUM[1]="2NO000" THEN 1 ELSE %B0208412010
IF ACCUM[1]="4STOP0" THEN 2 ELSE %B0208412020
0 ! 0 THEN %%% HAVE [NS %B0208412030
IF STEPI=COMMA THEN %%% HAVE [NS, %B0208412040
IF STEPI=FACTOP THEN %%% HAVE [NS,* %B0208412050
BEGIN %B0208412060
IF RR1=1 THEN EMITNO(1) %B0208412070
ELSE BEGIN EMITL(1); EMITL(2) END;%B0208412080
STEPIT ; %B0208412090
END %B0208413000
ELSE %B0208413010
BEGIN %%% HAVE [NS,AEXP %B0208413020
IF RR1=2 THEN EMITL(1) ; %B0208413030
EMITTIME ; %B0208413040
IF RR1=2 THEN %B0208413050
BEGIN EMITO(LOR); EMITL(2) END %B0208413060
ELSE EMITL(1) ; %B0208413080
END %B0208413090
ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS %B0208413100
ELSE BEGIN EMITL(1); EMITL(2) END %B0208413110
ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120
IF STEPI=COMMA THEN %%% HAVE [*, 08413130
IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000
BEGIN EMITNO(2); STEPIT END 08414010
ELSE BEGIN EMITTIME; EMITL(2) END%[*,A08414020
ELSE EMITNO(2) %%% HAVE ONLY [* 08414030
ELSE BEGIN %%% HAVE [AEXP 08415000
AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010
IF SEEKTOG THEN EMITO(CHS) ; 08415020
EMITPAIR(JUNK,ISN) ; 08415030
IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000
IF STEPI=FACTOP THEN STEPIT %%%[AEXP,*08416010
ELSE BEGIN EMITTIME; EMITO(LOR) END ; 08416020
EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030
END ; 08417000
IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ;08417010
END 08418000
ELSE IF ELCLASS=LEFTPAREN THEN 08418100
BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200
IF STEPI ! FACTOP THEN % %P08418250
BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE % %P08418300
BEGIN EMITL(1); GRABTOG ~ TRUE; STEPIT END ELSE %P08418350
EMITPAIR(0,LNG); 08418400
EMITD(33,33,15); 08418500
EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600
EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650
IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700
EMITL(REAL(GRABTOG)+2); STEPIT ; % %P08418800
END 08418900
ELSE BEGIN EMITL(0); EMITL(2); END; 08419000
IF REVERSETOG 08420000
THEN EMITO(CHS); 08421000
END; 08421500
IF ELCLASS = RTPAREN 08422000
THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000
EMITL(0); EMITL(0); EMITL(0); 08424000
GOGOGO ~ NOT MAYI;% 08424100
GO CHKACTIONLABELS; 08425000
END; 08426000
IF CHECK(COMMA,424) 08427000
THEN GO TO EXIT; 08428000
COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000
STATEMENT; 08430000
IF EXPLICITFORMAT THEN GO TO EXPFORMR; %W4008430500
IF STEPI = FACTOP 08431000
THEN BEGIN COMMENT *,LIST CASE; 08432000
EMITL(0); EMITL(0); GO PASSLIST; 08433000
END; 08434000
IF ELCLASS = MULOP 08435000
THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000
IF STEPI=MULOP THEN EMITL(2) ELSE %B0208437000
BEGIN EMITL(1); I~I-1; END ; %B0208437050
EMITL(0); GO TO PASSLIST ; %B0208437075
END; 08438000
IF RANGE(FRMTID,SUPERFRMTID) 08439000
THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000
PASSFORMAT; 08441000
EXPFORMR: %W4008441500
IF TABLE(I+1) = COMMA 08442000
THEN GO PASSLIST; 08443000
STEPIT; 08444000
IF CHECK(RTPAREN,425) 08445000
THEN GO TO EXIT; 08446000
COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000
DELIMITER IN READ STATEMENT; 08448000
EMITL(0); GO CHKACTIONLABELS; 08449000
END; 08450000
IF MAYI THEN 08450100
BEGIN KLUDGE(HOLD); 08450200
GO TO EXIT; 08450300
END ARRAY TO ARRAY CASE; 08450400
EMITL(0); AEXP; 08451000
IF CHECK(COMMA,426) 08452000
THEN GO TO EXIT; 08453000
COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000
PARAMETER; 08455000
STEPIT; 08456000
IF ROWD(FALSE) %M08457000
THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000
IF MAKEROW %M08459000
% %M08460000
THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000
ROW DESIGNATOR IN READ; 08462000
ERROR(427); GO TO EXIT; 08463000
END; 08464000
IF CHECK(RTPAREN,428) 08465000
THEN GO TO EXIT; 08466000
COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000
DELIMITER IN READ STATEMENT; 08468000
GOGOGO ~ TRUE;% 08468100
GO CHKACTIONLABELS; 08469000
END 08470000
ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000
ERROR(429); GO TO EXIT; 08472000
END; 08473000
PASSLIST:STEPIT; 08474000
IF CHECK(COMMA,430) 08475000
THEN GO TO EXIT; 08476000
COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000
THE LIST IN A READ STATEMENT; 08478000
STEPIT; LISTPARA; %W3308479000
IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580
COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590
08490000
CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000
EXIT:; 08492000
END READSTMT; 08493000
REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND08493010
VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015
BEGIN % RETURNS THE ASSOCIATED INDEX IF 08493020
REAL I ; % IT IS A FILE ATTRIBUTE. 08493030
LABEL EXIT ; 08493040
STOPDEFINE~T ; % MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 08493050
STEPIT ; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 08493060
IF I~FILEATTRIBUTES[0]=0 THEN 08493070
BEGIN 08493080
FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090
% BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091
% ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092
% THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093
12 08493094
,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095
,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096
,"4SAVE0" 08493097
,"8OTHER" % "OTHERUSE". 08493098
,"404MFID0" 08493099
,"403FID00" 08493100
,"4REEL0" 08493101
,"4DATE0" 08493102
,"5CYCLE" 08493103
,"4TYPE0" 08493104
,"5AREAS" 08493105
,"8AREAS" % "AREASIZE". 08493106
% THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493110
% THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120
; % END OF FILL STATEMENT. 08493130
I~FILEATTRIBUTES[0] ; 08493140
END ; 08493150
FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160
BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170
EXIT: 08493180
END OF FILEATTRIBUTEINDX ; 08493190
COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200
A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210
1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220
FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230
AND XIT. 08493240
2. ACTUALPARAPART: 08493250
PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260
ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270
THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280
3. PRIMARY: 08493290
PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300
IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310
ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320
THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330
TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340
IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350
ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360
ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370
FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380
(ATYPE OR BTYPE). 08493390
4. BOOPRIM: 08493400
PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410
5. IODEC: 08493420
PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430
HAVE ALREADY BEEN EMITTED. THE ATTRIBUTEINDX IS 08493440
DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450
END OF COMMENT ; 08493460
INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470
BEGIN 08493480
REAL ATTRIBUTEINDX ; 08493490
BOOLEAN ASSOP ; 08493500
LABEL DONESOME,DONEMORE,EXIT ; 08493510
IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520
BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530
EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540
GO TO DONEMORE ; 08493550
END ; 08493560
EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570
IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580
BEGIN 08493590
DONESOME: 08493600
IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610
BEGIN 08493620
STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625
IF STEPI=LFTBRKET THEN 08493630
BEGIN 08493640
STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650
END 08493660
ELSE EMITL(0) ; 08493670
EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675
IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680
BEGIN 08493700
IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705
DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710
THEN FLAG(293) ; 08493720
STEPIT ; 08493730
IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740
THEN BEXP ELSE AEXP ; 08493750
END 08493760
ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770
ELSE EMITL(0) ; 08493780
EMITNUM(IF ATTRIBUTEINDX=1 THEN "6ACCESS" ELSE IF 08493790
ATTRIBUTEINDX=4 THEN "6OTHRUS" ELSE IF ATTRIBUTEINDX=12 08493800
THEN "6ARASIZ" ELSE 08493810
0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820
& FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830
EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840
& REAL(ASSOP)[38:47:1]) ; 08493850
EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860
FILEATTRIBUTEHANDLER~ 08493870
IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880
THEN BTYPE ELSE ATYPE ; 08493890
END ; 08493900
END ; 08493910
EXIT: 08493920
END OF FILEATTRIBUTEHANDLER ; 08493930
PROCEDURE SPACESTMT; 08494000
BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000
SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000
FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000
PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000
FOR THE READ STATEMENT; 08499000
LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000
EXECUTABLE STATEMENT IN SPACESTMT; 08501000
STEPIT; 08502000
IF CHECK(LEFTPAREN,434) 08503000
THEN GO TO EXIT; 08504000
COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000
SPACE STATEMENT; 08506000
STEPIT; 08507000
IF NOT RANGE(FILEID,SUPERFILEID) 08508000
THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000
IDENTIFIER IN SPACE STATEMENT; 08510000
ERROR(435); GO TO EXIT; 08511000
END; 08512000
EMITO(MKS); 08513000
EMITPAIR(GNAT( 08514000
POWERSOFTEN),LOD); PASSFILE; 08515000
EMITL(0); 08515100
IF CHECK(COMMA,436) 08516000
THEN GO TO EXIT; 08517000
COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000
STEPIT; AEXP; 08519000
IF CHECK(RTPAREN,437) 08520000
THEN GO TO EXIT; 08521000
COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000
SPACE STATEMENT; 08523000
EMITL(0); EMITL(0); EMITL(1); 08524000
HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000
EXIT:; 08526000
END SPACESTMT; 08527000
PROCEDURE WRITESTMT; 08528000
BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000
INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000
DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000
I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000
WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000
ARE PASSED TO INTERPTO. 08534000
**********************************************************08535000
FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000
UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000
READSTMT ROUTINE. 08538000
<CARRIAGE CONTROL>::= [DBL]/[PAGE]/[NO]/<ARITHMETIC 08539000
EXPRESSION>/<EMPTY> 08540000
CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000
TO CIMI FOR INPUT. 08542000
<CARRIAGE> <EMPTY> [DBL] [PAGE] [NO] <ARITHMETIC EXP> 08543000
CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000
LINESKIP 1 2 4 8 0 08545000
WRITE(<FILE PART><CARRIAGE CONTROLS>)/ 08546000
- - - - - - - - - - - - - - 08547000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000
WRITE(<FILE PART><CARRIAGE CONTROL>,<FORMAT PART>)/ 08550000
- - - - - - - - - - - - - - 08551000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000
INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000
WRITE(<FILE PART><CARRIAGE CONTROL>,<FORMAT PART>,<LIST>)/08555000
- - - - - - - - - - - - - - 08556000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000
INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000
WRITE(<FILE PART><CARRIAGE CONTROL>,*,<LIST>)/ 08560000
- - - - - - - - - - - - - - 08561000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000
ROUTINE DESCRIPTOR) 08563000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000
WRITE(<FILE PART>(CARRIAGE CONTROL>,<ARITHMETIC EXPRESSION08565000
>,<ROW DESIGNATOR>) 08566000
- - - - - - - - - - - - - - 08567000
(CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 08568000
ROW DESCRIPTOR) 08569000
** ** ** ** ** ** ** ** ** ** ** ** ** **; 08570000
LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08571000
EXECUTABLE STATEMENT IN WRITESTMT; 08572000
LABEL CHKSECOND; COMMENT I IS NOW POINTING AT THE COMMA 08573000
SEPARATING THE FIRST AND SECOND 08574000
PARAMETERS; 08575000
LABEL ONEPARFNSH; COMMENT I IS POINTING AT THE RIGHT 08576000
PARENTHESIS AT THIS POINT AND I HAVE 08577000
JUST DISCOVERED THAT THIS IS THE ONE 08578000
PARAMETER CASE; 08579000
DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000
TEMPORARY CELL FOR ACCUM[1]; 08581000
%VOID 08582000
%VOID 08583000
%VOID 08584000
%VOID 08585000
LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000
PRECEEDING THE LIST WHEN THIS LABEL IS 08587000
REACHED; 08588000
LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000
DELIMITER. THE CODE AT EMITCALL EMITS THE08590000
CODE TO CALL INTERPTO; 08591000
LABEL CHKRTPAREN; 08591100
LABEL EXPFORMW; %W4008591150
INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500
BOOLEAN LOCKTOG,ARC; 08591600
BOOLEAN REMOTE; %A08591650
INTEGER HOLD;% 08591700
IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000
IF REMOTE ~ ACCUM[1] = "3TWX00" THEN BEGIN STEPIT; GO EXIT END; %A08592500
IF CHECK(LEFTPAREN,438) 08593000
THEN GO TO EXIT; 08594000
COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000
WRITE STATEMENT; 08596000
EMITO(MKS); 08597000
IF ROWD(TRUE) THEN %M08597100
BEGIN %M08597200
IF ELCLASS = STRINGID THEN REMOTE ~ ACCUM[1] = "5TWXS2" %A08597250
AND DACP ! 0; %A08597260
IF MAKEROW THEN %M08597300
BEGIN ERR(439); GO TO EXIT END; 08597400
ARC ~ TRUE; HOLD ~ L; 08597450
EMIT(11); EMIT(4); EMITO(280); 08597500
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600
EMITO(XCH); 08597700
END ELSE 08597800
BEGIN 08597900
IF NOT RANGE(FILEID,SUPERFILEID) 08598000
THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000
IDENTIFIER IN A WRITE STATEMENT; 08600000
ERR(439); GO TO EXIT; 08601000
END; 08602000
08603000
EMITPAIR(GNAT( 08604000
POWERSOFTEN),LOD); PASSFILE; 08605000
END; 08605500
IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000
THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000
EMITL(0); EMITL(1); 08608000
IF RRB1 08609000
THEN GO CHKSECOND; 08610000
ONEPARFNSH:STEPIT; EMITL(0); EMITL(0); 08611000
GOGOGO ~ NOT ARC;% 08611100
EMITL(0); GO EMITCALL; 08612000
END; 08613000
IF ELCLASS=LEFTPAREN THEN 08613100
BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200
IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300
EMITPAIR(0,LNG); 08613400
EMITD(33,33,15); EMIT(0); 08613500
IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN08613600
END; 08613700
IF CHECK(LFTBRKET,440) 08614000
THEN GO TO EXIT; 08615000
COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000
PARARAMETER IN A WRITE STATEMENT; 08617000
STEPIT; 08618000
%%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000
%%% [DPN,<AEXP>],[*],[*,*],[*,<AEXP>],[<AEXP>],[<AEXP>,*] 08619010
%%% AND [<AEXP>,<AEXP>], WHERE DPN IS STOP, DBL, PAGE, OR 08619020
%%% NO. THE FIRST (LEFTMOST) <AEXP> IS THE CHANNELSKIP, 08619030
%%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND <AEXP> IS 08619040
%%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP,08619050
%%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP. 08619060
%%% *"S ARE CONSIDERED TO BE EMPTIES. 08619070
IF ACCUM1~IF ACCUM1~ACCUM[1]="3DBL00" THEN 2 ELSE 08619080
IF ACCUM1="4PAGE0" THEN 4 ELSE 08619090
IF ACCUM1="4STOP0" THEN 16 ELSE 08619095
IF ACCUM1="2NO000" THEN 8 ELSE 0!0 THEN %%% [DPN08620000
IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010
IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020
BEGIN EMITNO(ACCUM1); STEPIT END 08621000
ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP08621010
ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020
ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000
IF STEPI=COMMA THEN %%% HAVE [*, 08622010
IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000
BEGIN EMITNO(1); STEPIT END 08624000
ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000
ELSE EMITNO(1) %%% HAVE ONLY [* 08626000
ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000
%% HAVE [AEXP 08627100
IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000
IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,*08629000
ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A08630000
EMITL(0) ; %%% 0 IS NO DPN. 08631000
END ; 08632000
IF CHECK(RTBRKET,441) 08633000
THEN GO TO EXIT; 08634000
COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE08635000
CONTROL PART; 08636000
CHKRTPAREN:IF STEPI = RTPAREN 08637000
THEN GO TO ONEPARFNSH; 08638000
IF CHECK(COMMA,442) 08639000
THEN GO TO EXIT; 08640000
COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000
DELIMITER IN A WRITE STATEMENT; 08642000
CHKSECOND: IF EXPLICITFORMAT THEN GO TO EXPFORMW ELSE STEPIT; %W4008643000
IF RANGE(FRMTID,SUPERFRMTID) 08644000
THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000
PASSFORMAT; 08646000
EXPFORMW: %W4008646500
IF STEPI = RTPAREN 08647000
THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000
CASE OF THE WRITE; 08649000
STEPIT; EMITL(0); GO EMITCALL; 08650000
END; 08651000
GO PASSLIST; 08652000
END; 08653000
IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100
BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110
IF ELCLASS!MULOP THEN ERR(443) %B0208653120
ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END;%B0208653125
IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130
BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140
ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150
GO TO PASSLIST ; 08653160
END 08653170
ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180
BEGIN EMITL(1) ; 08653190
IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; %B0208653195
IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. %B0208653200
BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210
ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220
GO TO PASSLIST ; 08653230
END OF SCANNING FOR FREE FIELD FORMAT ; 08653240
IF ELCLASS = FACTOP 08654000
THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;08655000
EMITL(0); EMITL(0); STEPIT; 08656000
GO PASSLIST; 08657000
END; 08658000
IF ARC THEN 08658100
BEGIN KLUDGE(-HOLD); 08658200
GO TO EXIT; 08658300
END ARRAY TO ARRAY CASE; 08658400
EMITL(0); AEXP; 08659000
IF CHECK(COMMA,443) 08660000
THEN GO TO EXIT; 08661000
COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000
PARAMETER IN WRITE STATEMENT; 08663000
STEPIT; 08664000
IF ROWD(FALSE) %M08665000
THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000
IF MAKEROW %M08667000
% %M08668000
THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000
DESIGNATOR IN A WRITE STATEMENT; 08670000
ERROR(444); GO TO EXIT; 08671000
END; 08672000
IF CHECK(RTPAREN,445) 08673000
THEN GO TO EXIT; 08674000
COMMENT ERROR 445 MEANS MISSING RIGHT 08675000
PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000
STATEMENT; 08677000
GOGOGO ~ TRUE;% 08677100
STEPIT; GO EMITCALL; 08678000
END 08679000
ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000
ERROR(446); GO TO EXIT; 08681000
END; 08682000
PASSLIST:IF CHECK(COMMA,447) 08683000
THEN GO TO EXIT; 08684000
COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000
LIST IN A WRITE STATEMENT; 08686000
%W3308687000
STEPIT; LISTPARA; %W3308688000
IF CHECK(RTPAREN,448) THEN GO TO EXIT; 08696550
COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560
STEPIT; 08697000
EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000
BEGIN EMITO(MKS); 08698100
IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200
IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300
BEGIN STEPIT; DEXP END; 08698400
IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500
EMITL(15); EMITV(5); STEPIT; 08698600
END;% 08698700
IF GOGOGO THEN% 08698750
BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800
EMIT(0); EMIT(0); EMITV(12);% 08698850
END ELSE EMITV(GNAT(INTERPTO));% 08698900
GOGOGO ~ FALSE;% 08698950
EXIT:; 08699000
IF REMOTE THEN BEGIN EMITL(RMARG ); EMITPAIR(TABR,STD); %T9008699100
EMITO(MKS); EMITV(TERPRIN) END; %A08699200
END WRITESTMT; 08700000
PROCEDURE LOCKSTMT; 08701000
BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000
CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000
FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000
**********************************************************08705000
<LOCK STATEMENT>::=LOCK(<FILE PART>,SAVE)/ 08706000
- - - - - - - - - - - - - - 08707000
(2,0,FILE,4) 08708000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000
LOCK(<FILE PART>,RELEASE) 08710000
- - - - - - - - - - - - - - 08711000
(6,0,FILE,4); 08712000
LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08713000
EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000
DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000
FOR THE CURRENT L REGISTER; 08716000
DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000
L REGISTER SETTING FOR THE 08718000
SAVE OR RELEASE LITERAL THAT 08719000
GETS PASSED TO KEN MEYERS; 08720000
STEPIT; 08721000
IF CHECK(LEFTPAREN,450) 08722000
THEN GO TO EXIT; 08723000
COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 08724000
IN A LOCK STATEMENT; 08725000
STEPIT; 08726000
IF NOT RANGE(FILEID,SUPERFILEID) 08727000
THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000
IF NOT ROWD(FALSE) THEN %T9208728100
BEGIN ERR(451); GO TO EXIT END; 08728200
IF MAKEROW THEN FLAG(208) ELSE L ~ L-1; %T9208728300
%T9208728400
EMITO(DUP); EMITO(LOD); EMITL(24); 08728500
EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000
GO TO EXIT 08730000
END; 08731000
PASFILE; 08732000
IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08732100
RELEASEV ELSE 08732200
IF CHECK(COMMA,452) 08733000
THEN GO TO EXIT; 08734000
COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT08735000
; 08736000
THISL~L; L~LTEMP; 08737000
IF(RRB1~STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000
ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000
THEN EMITL(IF RRB1 08740000
THEN 6 08741000
ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000
ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000
DISPOSITION PART; 08744000
ERROR(453); GO TO EXIT; 08745000
END; 08746000
L~THISL; 08747000
STEPIT; 08748000
IF CHECK(RTPAREN,454) 08749000
THEN GO TO EXIT; 08750000
COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000
LOCK STATEMENT; 08752000
STEPIT; 08753000
EXIT:; 08754000
END LOCKSTMT; 08755000
PROCEDURE CLOSESTMT; 08756000
BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000
CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000
FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000
**********************************************************08760000
<CLOSE STATEMENT>::=CLOSE(<FILE PART>,SAVE)/ 08761000
- - - - - - - - - - - - - - 08762000
(3,0,FILE,4) 08763000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000
CLOSE(<FILE PART>,RELEASE)/ 08765000
- - - - - - - - - - - - - - 08766000
(7,0,FILE,4) 08767000
** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000
CLOSE(<FILE PART>,*) 08769000
- - - - - - - - - - - - - - 08770000
(1,0,FILE,4) 08771000
<CLOSE STATEMENT> ::= CLOSE(<FILE PART>, PURGE) 08771100
-- -- -- -- -- --- -- -- -- -- -- -- 08771200
(4,0,FILE,4) 08771300
** ** ** ** ** ** *** ** ** ** ** ** ; 08771400
LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08772000
EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE;08773000
DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08774000
FOR THE CURRENT LREGISTER; 08775000
DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08776000
L REGISTER SETTING FOR THE 08777000
SAVE OR RELEASE LITERAL THAT 08778000
GETS PASSED TO KEN MEYERS; 08779000
LABEL EMITREST; COMMENT I IS POINTING AT THE UNIT 08780000
DISPOTION PART AND CODE FOR THE LAST THREE08781000
PARAMETERS TO THE FILE CONTROL ROUTINE 08782000
MUST NOW BE GENERATED; 08783000
STEPIT; 08784000
IF CHECK(LEFTPAREN,455) 08785000
THEN GO TO EXIT; 08786000
COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 08787000
CLOSE STATEMENT; 08788000
STEPIT; 08789000
IF NOT RANGE(FILEID,SUPERFILEID) 08790000
THEN BEGIN COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A08791000
CLOSE STATEMENT; 08792000
ERROR(456); GO TO EXIT; 08793000
END; 08794000
PASFILE; 08795000
IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08795100
RELEASEV ELSE 08795200
IF CHECK(COMMA,457) 08796000
THEN GO TO EXIT; 08797000
COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000
STATEMENT; 08799000
THISL~L; L~LTEMP; 08800000
IF STEPI = RELEASEV 08801000
THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000
EMITL(7); GO EMITREST; 08803000
END; 08804000
IF ELCLASS = FACTOP 08805000
THEN BEGIN COMMENT ASTERISK UNIT DISPOSITION PART CASE; 08806000
EMITL(1); GO EMITREST; 08807000
END; 08808000
IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000
THEN BEGIN COMMENT SAVE UNIT DISPOSTION PART CASE; 08810000
EMITL(3); GO EMITREST; 08811000
END; 08812000
IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100
EMITL(4); GO EMITREST; 08812200
END; 08812300
ERROR(458); GO TO EXIT; 08813000
COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000
IN A CLOSE STATEMENT; 08815000
EMITREST:STEPIT; 08816000
L~THISL; 08817000
IF CHECK(RTPAREN,459) 08818000
THEN GO TO EXIT; 08819000
COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000
CLOSE STATEMENT; 08821000
STEPIT; 08822000
EXIT:; 08823000
END CLOSESTMT; 08824000
PROCEDURE RWNDSTMT; 08825000
BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000
CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000
FOLLOWING PARAMETERS. 08828000
**********************************************************08829000
<REWIND STATEMENT>::=REWIND(<FILE PART>) 08830000
- - - - - - - - - - - - - - 08831000
(0,0,FILE,4); 08832000
LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08833000
EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000
DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08835000
FOR THE CURRENT L REGISTER; 08836000
DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08837000
L REGISTER SETTING FOR THE 08838000
SAVE OR RELEASE LITERAL THAT 08839000
GETS PASSED TO KEN MEYERS; 08840000
STEPIT; 08841000
IF CHECK(LEFTPAREN,460) 08842000
THEN GO TO EXIT; 08843000
COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000
REWIND STATEMENT; 08845000
STEPIT; 08846000
IF NOT RANGE(FILEID,SUPERFILEID) 08847000
THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A08848000
REWIND STATEMENT; 08849000
ERROR(461); GO TO EXIT; 08850000
END; 08851000
PASFILE; 08852000
IF CHECK(RTPAREN,462) 08853000
THEN GO TO EXIT; 08854000
COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000
REWIND STATEMENT; 08856000
STEPIT; THISL~L; L~LTEMP; 08857000
EMITL(0); L~THISL; 08858000
EXIT:; 08859000
END RWNDSTMT; 08860000
%T9308860250
COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 08861000
AND CALL SORTI, PASSING THE FOLLOWING: 08862000
SORT: MERGE: 08863000
<AEXP> 0 DISK SIZE,IF SPECIFIED 08864000
<AEXP> 0 CORE SIZE,IF SPECIFIED 08865000
0 0 ALFA FLAG 08866000
<AEXP> <AEXP> RECORD SIZE 08867000
PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 08868000
PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 08869000
... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000
0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000
TP5 FL7 SCRATCH TAPES FOR SORT, 08872000
TP4 FL6 OR MERGE FILES. POINTERS TO 08873000
TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000
TP2 FL4 IF NOT USED. 08875000
TP1 FL3 08876000
0 FL2 DISK FILES FOR SORT 08877000
DKO FL1 08878000
0/1 0 TRUE IF INPUT PROCEDURE 08879000
0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000
INF 0 POINTER TO I/O DESC FOR INPUT 08881000
OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000
OF WORK ARRAY. 08883000
PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000
PD/0 PD/0 OUTPUT PROCEDURE 08885000
0 0 08886000
0 0 08887000
0 0 08888000
LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000
0 0 08890000
0 1 SORT/MERGE FLAG 08891000
... MSCW 08892000
0 SORT-FILE MOTHER 08893000
0 DESCRIPTORS 08894000
0 . 08895000
0 . 08896000
0 . 08897000
0 . 08898000
MSCW; 08900000
PROCEDURE MERGESTMT; 08901000
BEGIN INTEGER J,K,FILER,FILEND; 08902000
BOOLEAN OPTOG; 08903000
LABEL QUIT; 08904000
STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000
EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000
EMIT(0); EMIT(0); EMIT(0); 08907000
IF OPTOG~(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000
ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000
EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I~I-1 END ELSE 08911000
EMITN(GNAT(SORTA)); 08911100
IF NOT COMMACHECK THEN GO QUIT; 08912000
EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000
FILER~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000
EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000
IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000
EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000
AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000
FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000
BEGIN STEPIT; PASSFILE END; 08920000
FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000
IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000
EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000
IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000
EMIT(0); EMIT(0); EMIT(0); 08925000
QUIT: EMITV(GNAT(SORTI)); 08926000
END MERGESTMT; 08927000
PROCEDURE SORTSTMT; 08928000
BEGIN BOOLEAN INPRO,OUTPRO; 08929000
INTEGER A,J; 08930000
LABEL QUIT; DEFINE RDS=1,280#; 08931000
STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000
VALUE FN, SFN ; 08933000
BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000
SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000
DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000
DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000
DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000
END STUFFILE; 08939000
BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000
IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000
IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100
IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000
IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000
INPROCHECK~TRUE; 08944000
IF SFILENO=0 THEN 08945000
BEGIN SFILENO~FILENO; 08946000
FOR J~1 STEP 1 UNTIL 7 DO 08947000
IF MKABS(IDARRAY[127])<IDLOC.[33:15]+3 THEN FLAG(40) ELSE 08948000
BEGIN STUFFILE(IDLOC,(IF J{2 THEN 12 ELSE 2)&FILENO 08949000
[30:36:12],J); 08950000
FILENO~FILENO+1; 08951000
END; END; 08952000
EMITO(MKS); EMITV(BLOCKCTR); EMITPAIR(1,ADD); 08953000
EMITPAIR(BLOCKCTR,STD); EMIT(0); EMIT(0); 08954000
EMITN(2); EMITPAIR(RDS); EMITPAIR(A~GNAT(SORTA),STD); 08955000
EMITO(MKS); EMITL(20); EMITL(1000); EMITL(3); EMITL(SFILENO); 08956000
EMIT(0); EMITO(LNG); EMITN(A); EMITO(INX); EMITL(2); 08957000
EMITL(1); EMITL(10); EMIT(0); EMIT(0); EMITL(10); 08958000
EMITL(8); EMITV(5); 08959000
EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); 08964000
EMITL(GNAT(MERGEI)); EMIT(0); EMIT(0); EMIT(0); STEPIT; 08965000
IF CHECK(LEFTPAREN,355) THEN GO QUIT; 08966000
% OUTPUT OPTION. 08966500
IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 08967000
BEGIN EMIT(0); PASSFILE; I~I-1 END ELSE 08968000
BEGIN IF NOT(OUTPRO~OUTPROCHECK(ELBAT[I]))THEN GO QUIT; 08969000
EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITL(A);EMITN(10) 08970000
END; 08971000
IF NOT COMMACHECK THEN GO QUIT; 08972000
% INPUT OPTION. 08972500
IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 08973000
BEGIN EMITPAIR(0,XCH); PASSFILE; I~I-1 END ELSE 08974000
IF NOT(INPRO~INPROCHECK(ELBAT[I])) THEN GO QUIT ELSE 08975000
BEGIN EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITO(XCH); 08976000
IF OUTPRO THEN EMITO(DUP) ELSE BEGIN EMITL(A); 08977000
EMITN(10) END; END INPUT PRO; 08978000
EMITL(REAL(OUTPRO)); EMITL(REAL(INPRO)); EMIT(0); 08979000
EMITO(LNG); EMITN(A); EMITO(INX); EMITO(LOD); 08980000
EMITPAIR(5,CDC); EMIT(0); 08981000
IF NOT COMMACHECK THEN GO QUIT; 08983000
% NUMBER OF TAPES. 08983500
EMIT(0); EMIT(0); EMIT(0); EMIT(0); EMIT(0); 08984000
EMITO(MKS); EMITN(A); EMITL(SFILENO+2); AEXP; I~I-1; 08985000
EMITL(14); EMITV(5); 08986000
IF NOT COMMACHECK THEN GO QUIT; 08987000
% HIVALUE PROCEDURE. 08987500
IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08988000
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08989000
IF NOT COMMACHECK THEN GO QUIT; 08990000
% COMPARE PROCEDURE. 08990500
IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08991000
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08992000
% RECORD LENGTH. 08992500
IF NOT COMMACHECK THEN GO QUIT; AEXP; EMITO(SSN); 08993000
EMIT(0); EMITPAIR(A,SND); 08993500
% CORE SIZE. 08993900
IF ELCLASS=COMMA THEN 08994000
BEGIN 08994010
STEPIT; 08994020
CORESZ:= 08994030
MAX(IF ELCLASS=NONLITNO THEN C ELSE 12000,CORESZ); 08994040
AEXP; 08994060
END 08994070
ELSE IF ELCLASS=RTPAREN THEN 08994080
BEGIN 08994090
IF CORESZ<1023 THEN CORESZ:=12000; 08994500
EMIT(0); 08994510
END 08994520
ELSE ERR(366); 08994530
% DISK SIZE. 08994900
IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08995000
IF ELCLASS=RTPAREN THEN EMIT(0) ELSE ERR(366); 08995500
IF ELCLASS!RTPAREN THEN ERR(366) ELSE STEPIT; 08996000
QUIT: EMITV(GNAT(SORTI)); 08997000
END SORTSTMT; 08998000
PROCEDURE CHECKSTREAMS; BEGIN DEFINE SEGMENT=#; % %T0308999000
WRITE(LIN[*],<"RESTRICTED CONSTRUCTS WERE FOUND IN THIS PROGRAM.">);%T0308999200
IF LISTOG OR NOT(REMOTOG OR REMOTERR) THEN BEGIN % %T0308999300
IF NOHEADING THEN DATIME; WRITELINE; END; % %T0308999400
IF REMOTOG OR REMOTERR THEN WRITE(REMOTE[*,9],10,LIN[*])[ENDOFITALL]%T0308999500
; % %T0308999555
ERRORCOUNT := ERRORCOUNT + 1; % %T0308999600
END; % %T0308999700
COMMENT THE PROGRAM ROUTINE DOES THE INITIALIZATION AND THE WRAPUP 09000000
FOR THE REST OF THE COMPILER. THE MAIN PROGRAM OF THE COMPILER09001000
IS SIMPLY A CALL ON THE PROGRAM ROUTINE; 09002000
PROCEDURE PROGRAM; 09003000
BEGIN 09004000
STREAM PROCEDURE MDESC(WD,TOLOC);VALUE WD; 09005000
BEGIN DI~LOC WD; DS~ SET;SI~ LOC WD; DI~TOLOC;DS~WDS END; 09006000
COMMENT THE FOLLOWING PROCEDURE PRINTS OUT THE PRT, NAME, AND 09007000
SEGMENT NUMBER OF THE INTRINSIC PROCEDURES USED IN THE 09008000
OBJECT PROGRAM; 09009000
STREAM PROCEDURE WRTINTRSC(SGNO,ALFA,PRT,FIL); 09010000
VALUE SGNO,PRT; 09011000
BEGIN LOCAL COUNT,DEST; 09012000
DI:=FIL; DS:=4 LIT"PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 09013000
3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 09014000
BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 09015000
COUNT:=TALLY; DS:=COUNT CHR; DS:=4 LIT") = "; 09016000
SI:=ALFA; SI:=SI+2; DEST:=DI; % SAVE DI. 09017000
DI:=LOC COUNT; DS:=7 LIT"0"; DS:=CHR; % NO OF CHARS IN NAME. 09018000
DI:=DEST; DS:=COUNT CHR; % INT. NAME. 09019000
DS:=29 LIT" INTRINSIC, SEGMENT NUMBER = "; 09020000
SI:= LOC SGNO; DS:=4 DEC; DS:=LIT"."; 09021000
DI:=DI-5; DS:=4 FILL; % JUNK LEADING BLANKS. 09022000
END WRTINTRSC; 09023000
DEFINE STARTINTRSC=426#; 09024000
LABEL L1; 09025000
IDLOC~MKABS(IDARRAY[0]); 09026000
IDLOCTEMP ~ IDLOC; 09027000
LISTOG ~ BOOLEAN(3-ERRORCOUNT.[46:1]); 09028000
BUILDLINE ~ REMOTOG ~ BOOLEAN(ERRORCOUNT.[47:1]); 09028100
REMOTERR ~ BOOLEAN(ERRORCOUNT.[45:1]); %T1409028110
BUILDLINE ~ BUILDLINE OR BOOLEAN(ERRORCOUNT.[44:1]); %T1409028120
ERRORMAX ~ 99 - 79 | REAL(REMOTOG OR REMOTERR); % %T9809028800
ERRORCOUNT ~ 0; 09028900
LASTUSED ~ 4; 09029000
SGNO~1;SGAVL~2;PDINX~0; 09030000
FILENO~DA~1; 09031000
FILETHING ~ 4095; 09031100
MAXSTACK ~ 513; 09032000
09032100
NEXTINFO ~ LASTINFO ~ LASTSEQROW|256+LASTSEQUENCE+1; 09033000
PUTNBUMP(0); 09034000
FILL RETNE WITH "ENTER ","LIBRARY",*,*,*,12; % %T0309034100
NOTPNTED ~ TRUE; %T0309034900
READACARD; COMMENT THIS IS INITIALIZATION OF NCR,FCR, AND 09035000
LCR. SINCE LASTUSED = 4 NO CARDS ARE ACTUALLY READ; 09036000
LASTUSED ~ 1; COMMENT ASSUMES CARD ONLY UNTIL TOLD; 09037000
NXTELBT~1; FAULTLEVEL~32; 09038000
PRTI ~ PRTIMAX ~ 18; 09039000
MRCLEAN ~ TRUE; 09040000
%T0309040100
LNKNDX ~ 63; %M09041000
RECORDLINK ~ 29; %M09041500
TABLEMARKV ~ 127; %A09042000
% %A09043000
% %A09044000
09045000
09046000
09047000
09048000
09049000
09050000
09051000
09052000
09053000
09054000
09055000
FILL TEN[*] WITH %M09056000
OCT1141000000000000, OCT1131200000000000, OCT1121440000000000, %A09057000
OCT1111750000000000, OCT1102342000000000, OCT1073032400000000, %A09058000
OCT1063641100000000, OCT1054611320000000, OCT1045753604000000, %A09059000
OCT1037346545000000, OCT1011124027620000, OCT0001351035564000, %A09060000
OCT0011643245121000, OCT0022214116345200, OCT0032657142036440, %A09061000
OCT0043432772446150, OCT0054341571157602, OCT0065432127413542, %A09062000
OCT0076740555316473, OCT0111053071060221, OCT0121265707274265, %A09063000
OCT0131543271153342, OCT0142074147406233, OCT0152513201307702, %A09064000
OCT0163236041571663, OCT0174105452130240, OCT0205126764556310, %A09065000
OCT0216354561711772, OCT0231004771627437, OCT0241206170175346, %A09066000
OCT0251447626234640, OCT0261761573704010, OCT0272356132665012, %A09067000
OCT0303051561442215, OCT0313664115752660, OCT0324641141345435, %A09068000
OCT0336011371636744, OCT0347413670206535, OCT0361131664625026, %A09069000
OCT0371360241772234, OCT0401654312370703, OCT0412227375067064, %A09070000
OCT0422675274304701, OCT0433454553366061, OCT0444367706263475, %A09071000
OCT0455465667740415, OCT0467003245730520, OCT0501060411731664, %A09072000
OCT0511274514320241, OCT0521553637404312, OCT0532106607305374, %A09073000
OCT0542530351166673, OCT0553256443424452, OCT0564132154331565, %A09074000
OCT0575160607420123, OCT0606414751324147, OCT0621012014361120, %A09075000
OCT0631214417455344, OCT0641457523370635, OCT0651773450267004, %A09076000
OCT0662372362344605, OCT0673071057035747, OCT0703707272645341, %A09077000
OCT0714671151416631, OCT0726047403722377, OCT0737461304707077, %A09078000
OCT0751137556607071, OCT0761367512350710, OCT0771665435043072, %A09078100
OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078200
OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078300
OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078400
OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078500
OCT0000000000000000, OCT0000000000000000, OCT0000000000000000, %A09078600
OCT0000000000000000, OCT0000000000000000, OCT0004000000000000, %A09078700
OCT0001000000000000, OCT0001720000000000, OCT0004304000000000, %A09078800
OCT0007365000000000, OCT0005262200000000, OCT0004536640000000, %A09078900
OCT0001666410000000, OCT0000244112000000, OCT0000315134400000, %A09079000
OCT0000400363500000, OCT0000450046042000, OCT0006562057452400, %A09079100
OCT0004316473365100, OCT0005402212262320, OCT0006702654737004, %A09079200
OCT0004463430126605, OCT0007600336154346, OCT0001540425607437, %A09079300
OCT0004070533151346, OCT0005106662003637, OCT0005033043640460, %A09079400
OCT0002241654610574, OCT0002712227752733, OCT0001474675745521, %A09079500
OCT0002014055337045, OCT0004417070626656, OCT0007522706774431, %A09079600
OCT0003447470573537, OCT0006361406732466, OCT0005005571052120, %A09079700
OCT0006207127264544, OCT0001650755141675, OCT0006223150372254, %A09079800
OCT0007670002470727, OCT0007646003207114, OCT0005617404050737, %A09079900
OCT0001163305063126, OCT0007420166277753, OCT0001732422375774, %A09080000
OCT0002321127075373, OCT0003005354714671, OCT0005606650100047, %A09080100
OCT0007150422120060, OCT0003002526544074, OCT0001603254275113, %A09080200
OCT0004144127354335, OCT0007175155247424, OCT0007034410521331, %A09080300
OCT0007664351264561, OCT0003641443541715, OCT0004611754472300; %A09080400
COMMENT THIS IS THE FILL FOR THE SECOND ROW OF INFO: 09081000
THE FIRST ITEMS ARE STREAM RESERVED WORDS, 09082000
THEN ORDINARY RESERVED WORDS, 09083000
THEN INTRINSIC FUNCTIONS; 09084000
FILL INFO[1,*] WITH 09085000
OCT1240000600000400, "2SI000", %256 %M09086000
OCT1250001040000402, "2DI000", %258 %M09087000
OCT1260001460000404, "2CI000", %260 %M09088000
OCT1270001630000406, "5TALLY", %262 %M09089000
OCT1300000530000410, "2DS000", %264 %M09090000
OCT1310000150000412, "4SKIP0", %266 %M09091000
OCT1320001620000414, "4JUMP0", %268 %M09092000
OCT1330000740000416, "2DB000", %270 %M09093000
OCT1340000500000420, "2SB000", %272 %M09094000
OCT1360000730000422, "2SC000", %274 %M09095000
OCT1370001160000424, "3LOC00", %276 %M09096000
OCT1400001170000426, "2DC000", %278 %M09097000
OCT1410001430000430, "5LOCAL", %280 %M09098000
OCT1420000340000432, "3LIT00", %282 %M09099000
OCT1430001036400434, "3SET00", %284 %M09100000
OCT1430001066500436, "5RESET", %286 %M09101000
OCT1430001020500440, "3WDS00", %288 %M09102000
OCT1430001357700442, "3CHR00", %290 %M09103000
OCT1430001057300444, "3ADD00", %292 %M09104000
OCT1430001617200446, "3SUB00", %294 %M09105000
OCT1430000727600450, "3ZON00", %296 %M09106000
OCT1430000417500452, "3NUM00", %298 %M09107000
OCT1430000766700454, "3OCT00", %300 %M09108000
OCT1430000176600456, "3DEC00", %302 %M09109000
OCT1354000260000460, "6TOGGL", "E0000000", %304 %M09110000
OCT1000000110001236, "5ALPHA", %307 %M09111000
OCT1700001030001360, "3AND00", %309 %M09112000
OCT1000000230000525, "5ARRAY", %311 %M09113000
OCT1230000000001067, "5BEGIN", %313 %M09114000
OCT1000000070000503, "7BOOLE", "AN000000", %315 %M09115000
OCT1040000000001122, "5CLOSE", %318 %M09116000
OCT1440000000000655, "7COMME", "NT000000", %320 %M09117000
OCT1000000300000000, "6DEFIN", "E0000000", %323 %M09118000
OCT1750006000000000, "3DIV00", %326 %M09119000
OCT1120000000000000, "2DO000", %328 %M09120000
OCT1000000040000000, "6DOUBL", "E0000000", %330 %M09121000
OCT1000000140001255, "4DUMP0", %333 %M09122000
OCT1140000000001300, "4ELSE0", %335 %M09123000
OCT1150000000001047, "3END00", %337 %M09124000
OCT1650002030001163, "3EQV00", %339 %M09125000
OCT0700000000000644, "5FALSE", %341 %M09126000
OCT1000000250000000, "4FILE0", %343 %M09127000
OCT1160000001200000, "4FILL0", %345 %M09128000
OCT1100000000000000, "3FOR00", %347 %M09129000
OCT1000000240000554, "6FORMA", "T0000000", %349 %M09130000
OCT1450000000000000, "7FORWA", "RD000000", %352 %M09131000
OCT1210000000000604, "2GO000", %355 %M09132000
OCT1200000000000000, "2IF000", %357 %M09133000
OCT1000000170000000, "2IN000", %359 %M09134000
OCT1000000120000000, "7INTEG", "ER000000", %361 %M09135000
OCT1660000000000000, "3IMP00", %364 %M09136000
OCT1000000130000000, "5LABEL", %366 %M09137000
OCT1000000150000613, "4LIST0", %368 %M09138000
OCT1050000000000000, "4LOCK0", %370 %M09139000
OCT1750016000001343, "3MOD00",%372 %M09140000
OCT1000000200000000, "7MONIT", "OR000000", %374 %M09141000
OCT1620000000000000, "3NOT00", %377 %M09142000
OCT1670000430000624, "2OR000", %379 %M09143000
OCT1000000160000000, "3OUT00", %381 %M09144000
OCT1000000010000476, "3OWN00", %383 %M09145000
OCT1000000220000463, "9PROCE", "DURE0000", %385 %M09146000
OCT1010000000000000, "4READ0", %388 %M09147000
OCT1000000100000000, "4REAL0", %390 %M09148000
OCT1220000000001215, "7RELEA", "SE000000", %392 %M09149000
OCT1060000000000000, "6REWIN", "D0000000", %395 %M09150000
OCT1000000020000773, "4SAVE0", %398 %M09151000
OCT1030000000000000, "5SPACE", %400 %M09152000
OCT1460000000000000, "4STEP0", %402 %M09153000
OCT1000000260000000, "6STREA", "M0000000", %404 %M09154000
OCT1000000210000562, "6SWITC", "H0000000", %407 %M09155000
OCT1470000000001275, "4THEN0", %410 %M09156000
OCT1500000000000000, "2TO000", %412 %M09157000
OCT0700000010000000, "4TRUE0", %414 %M09158000
OCT1130000000000000, "5UNTIL", %416 %M09159000
OCT1510000000000000, "5VALUE", %418 %M09160000
OCT1110000000000540, "5WHILE", %420 %M09161000
OCT1520000000000000, "4WITH0", %422 %M09162000
OCT1020000000000531, "5WRITE", %424 %M09163000
OCT0240000000140673, "3ABS00", OCT0000202000700000,%426 %M09164000
OCT0240000000061331, "6ARCTA", "N0000000", OCT0370100001600000,%429 %M09165000
OCT0240000000041100, "3COS00", OCT0531101001500000,%433 %M09166000
OCT0240000000360000, "6ENTIE", "R0000000", OCT0000000001100000,%436 %M09167000
OCT0240000000040000, "3EXP00", OCT0332111002000000,%440 %M09168000
OCT0240000000041352, "2LN000", OCT0353121001700000,%443 %M09169000
OCT0240000000240000, "4SIGN0", OCT0000000001000000,%446 %M09170000
OCT0240000000040000, "3SIN00", OCT0344131001400000,%449 %M09171000
OCT0240000000040515, "4SQRT0", OCT0315141001300000,%452 %M09172000
OCT0240000000441113,"4TIME0", OCT0000000001200000, %455 %M09173000
OCT0150000000040000, "3ZIP00", 0, % 455 %A09174000
OCT0130000000060000, "9OUTPU", "T(W)0000", OCT0000000000100000,%461;09175000
OCT0130000050060000, ":BLOCK", " CONTROL", OCT0000000000200000,%465;09176000
OCT0130000000060000, "8INPUT", "(W)00000", OCT0000000000300000,%469;09177000
OCT0000000000061226, "4SORT0", 0, OCT0000000000400000, % 473 %M09178000
OCT0130000000040000, "4DUMP0", OCT0000000000500000,%477;09179000
OCT0130000000060000, "#X TO ", "THE I000", OCT0000000000600000,%480;09180000
OCT0240000000060000, ":GO TO"," SOLVER ", OCT0570000002100000, %484 %A09181000
OCT0130000140060000, ":ALGOL", " WRITE ", OCT0000000002200000,%488;09182000
OCT0130000150060000, ":ALGOL", " READ ", OCT0000000002300000,%492;09183000
OCT0130000160060000, ":ALGOL", " SELECT ", OCT0000000002400000,%496;09184000
OCT0000000000040000, "5MERGE", OCT0000000002700000,% 500 09184100
OCT0240000000560652, "6STATU", "S0000000", OCT0000000003000000, %M09184200
OCT0240000000641126, "3MAX00", OCT0000000003100031; %T9209185000
FILL INFO[3,*] WITH % %A09185100
OCT0240000000060000,"#SWAP ","ARRAYS ",OCT0000000004500000,% 768 %A09185200
OCT0240000000060000,":FORTE","RR ",OCT0300000013400000,% 772 %A09185300
OCT0240000000060000,":MATRI","XDIDDLER",OCT0000000014100000,% 776 %A09185400
OCT0240000000060000,":MATRI","X INVERT",OCT0000000014200000,% 780 %A09185500
OCT0240000000060000,":MTX T","RANSPOSE",OCT0000000014300000,% 784 %A09185600
OCT0240000000060000,"#MATRI","X MULT ",OCT0000000014400000,% 788 %A09185700
OCT2000000000004050, COMMENT POWERS OF TEN; % 792 %A09185800
0, ":SORT ","TEMPORAR","Y ", COMMENT SORTA; %793 %T9309185900
" "; COMMENT LASTSEQROW, LASTSEQUENCE; % 794 %A09186000
COMMENT THIS IS THE FILL FOR STACKHEAD; 09187000
FILL STACKHEAD[*] WITH 09188000
320,673,678,458,385, 0,337,347,383,361,621,412, 0, 0,681,372, %M09189000
335,758,666, 0,368,695,446, 0, 0,539,311,410, 0, 0,400,721,%T9209190000
0,608,570, 0,630,741,664,606,330,690, 0,579, 0, 0,727,440, %M09191000
390,646,659, 0,414, 0,683,737,452, 0,698, 0, 0, 0,733,561, %M09192000
381,328, 0, 0, 0,750, 0, 0, 0, 0,760,436, 0,402,744,633, %M09193000
748,639,711,573,718,756,416,455,355,687, 0,357,564,542,610, 0,%T9209194000
716, 0,433,602,418,398,343,618,692,326,339,648,714,725,366, 0, %M09195000
0,558, 0, 0, 0,754,656,392, 0,636, 0,675,644; %M09196000
FILL SUPERSTACK[*] WITH %WF 09196100
0,359,313, 0,307, 0,337,347,383, 0,397,412, 0, 0, 0,372,%T9209196200
335,309, 0, 0, 0, 0, 0, 0, 0, 0,420,410, 0, 0, 0, 0, %M09196300
0, 0, 0, 0,630, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %M09196400
390, 0,364, 0,414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %M09196500
0,328, 0, 0, 0, 0, 0, 0, 0, 0,760, 0, 0,402, 0,633, %M09196600
0, 0,377, 0, 0,756,416, 0,355, 0, 0,357, 0, 0, 0, 0, %M09196700
0, 0, 0, 0, 0,398, 0, 0, 0,326,339, 0, 0, 0,366, 0, %M09196800
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,424, 0; %M09196900
COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS; 09197000
FILL SPECIAL[*] WITH 09198000
OCT1550000000200000, COMMENT #; OCT0000000000100000, COMMENT @;%M09199000
OCT0000000000000000, OCT1530000000120000, COMMENT :;%M09200000
OCT1710000450002763, COMMENT >; OCT1710000250002662, COMMENT };%M09201000
OCT1740000200000000, COMMENT +; 0, %M09202000
OCT1570000000060000, COMMENT .; OCT1560000000000000, COMMENT [;%M09203000
OCT1640000000000000, COMMENT &; OCT0740000000000000, COMMENT (;%M09204000
OCT1710010450243571, COMMENT <; OCT1630000000000000, COMMENT ~; %M09205000
OCT1750001000000000, COMMENT |; 0, %M09206000
OCT0000000000040000, COMMENT $; OCT1760000000000000, COMMENT *; %M09207000
OCT1740000600000000, COMMENT -; OCT1610000000160000, COMMENT); %M09208000
OCT1170000000000000, COMMENT .,; OCT1710010250003470, COMMENT {;%M09209000
0, OCT1750002000000000, COMMENT/; %M09210000
OCT1540000000000000, COMMENT ,; OCT0000000000020000, COMMENT %;%M09211000
OCT1710001050002561, COMMENT !; OCT1710011050002460, COMMENT =;%M09212000
OCT1600000000000000, COMMENT ]; OCT0000000000140000, COMMENT ";%M09213000
0,0; 09214000
COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;09214100
FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 09214105
OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 09214110
OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115
OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 09214120
OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 09214125
OCT0030000170000000, "3NEQ00", 09214130
OCT0030000200000000, "3LEQ00", 09214135
OCT0030000210000000, "3LSS00", 09214140
OCT0030000220000000, "5TIMES", 09214145
0, %T9209214150
0, %T9209214155
0, %T9209214160
0, %T9209214165
0, %T9209214170
%T9209214180
OCT0240000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000, %T9209214190
OCT0240000000740000, "3MIN00",OCT0000000003200000, % 539 %T9209214200
OCT0240000001040000, "5DELAY", OCT0000000003300000, % 542 %T9209214210
OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400002, %T9209214220
0, 0, % FILLER %M09214225
OCT0240000001140000, "3ARG00", OCT0447500011400000, %551 %T9209214230
OCT0240000001261116, "6ARCSI", "N0000000", OCT0320000011600000,%554 %M09214235
OCT0240000000041107, "3TAN00", OCT0360000011100000, %558 %T9209214240
OCT0240000001340000, "5GAMMA", OCT0400000012600000,%561 %M09214245
OCT0240000001440000, "5COTAN", OCT0000000011200000, %564 %T9209214250
OCT0240000001540000, "5ARCOS", OCT0000000011700000,%567 %M09214255
OCT0240000001640000, "4SINH0", OCT0000000012000000, %570 %T9209214260
OCT0240000001640000, "4COSH0", OCT0000000012100000,%573 %M09214265
OCT0240000001641161, "4TANH0", OCT0000000012200000, %576 %T9209214270
OCT0240000001660000, "6ERROR", "F0000000", OCT0000000012500000,%579 %M09214275
OCT0240000001760000,"7LNGAM","MA ",OCT0000000012700260,% 583 %A09214280
OCT0240000002040000, "3LOG00", OCT0006100000000000,%587 %M09214285
OCT0240000002160000, "8IMAGP", "ART00000", OCT0000300000000000,%590 %M09214290
OCT0240000002261213, "8REALP", "ART00000", OCT0000400000000000,%594 %M09214295
OCT0240000002360000, "6HIPAR", "T0000000", OCT0000000000000000,%598 %M09214300
OCT0240000002460000, "6LOPAR", "T0000000", OCT0000000000000000,%602 %M09214305
OCT0240000002500000, "3TAB00", %606 %M09214310
OCT0240000002600000, "3COL00", %608 %M09214315
OCT0240000002700566, "6INREA", "L0000000", %610 %M09214320
OCT0240000003000571, "4SCAN0", %613 %M09214325
OCT0240000003100000, "7READC" , "ON000000", % 615 %A09214330
OCT0240000003200000, "6LENGT", "H0000000", %618 %M09214335
OCT0240000003300573, "5NPROP", %621 %M09214340
OCT0240000003400000, "4SMTA0", %623 %M09214345
OCT0240000003500000, "4CTSM0", %625 %M09214350
OCT0240000003600000, "6CONVA", "L0000000", %627 %M09214355
OCT1000000030000767, "6STRIN", "G0000000", %630 %M09214360
OCT1000000050001147, "6SYMBO", "L0000000", % 633 %A09214365
OCT1000000060000000, "6RECOR", "D0000000", %636 %M09214370
OCT1000000270000000, "7COMPL", "EX000000", %639 %M09214375
OCT1000000310000650, "5FIELD", %642 %M09214380
OCT0210000000001323, "4CONS0", %644 %M09214385
OCT0750000000000701, "3NIL00", %646 %M09214390
OCT0210000000040000, "6APPEN", "D0000000", %648 %M09214395
OCT0210000000060000, "5NCONC", %651 %M09214400
OCT0210000000101337, "6GENSY", "M0000000", %653 %M09214405
OCT0210000000120000, "6RANDO", "M0000000", %656 %M09214410
OCT0210000000140535, "6MKATO", "M0000000", %659 %M09214415
OCT0210000000160000, "4PROP0", %662 %M09214420
OCT0210000000200000, "5READ1", %664 %M09214425
OCT0210000000220731, "5INSYM", %666 %M09214430
OCT0210000000240000, "4ATSM0", %668 %M09214435
OCT0210000000260000, "6OBLIS", "T0000000", %670 %M09214440
OCT0230000000000547, "4NULL0", %673 %M09214445
OCT0230000000021202, "6MEMBE", "R0000000", %675 %M09214450
OCT0230000000040471, "7NUMBE", "RP000000", %678 %M09214455
OCT0230000000061157, "4ATOM0", %681 %M09214460
OCT0230000000100000, "5ATCON", %683 %M09214465
OCT0230000000121333, "5ATSYM", %685 %M09214470
OCT0260000000000000, "6RETUR", "N0000000", %687 %M09214475
OCT0260000000021234, "4EXIT0", %690 %M09214480
OCT0260000000040000, "7RECLA", "IM000000", %692 %M09214485
OCT0260000000060000, "6RECAL", "L0000000", %695 %M09214490
OCT0260000000100000, "8REMEM", "BER00000", %698 %M09214495
OCT0260000000120000, "7ADDPR", "OP000000", %701 %M09214500
OCT0260000000140000, "7REMPR", "OP000000", %704 %M09214505
OCT0260000000160465, "5PRINT", %707 %T9209214510
OCT0260000000201303, "4PRIN0", %709 %M09214515
OCT0260000000221145, "6TERPR", "I0000000", %711 %T9209214520
OCT0260000000240000, "3NTS00", %714 %M09214525
OCT0260000000260000, "5INPUT", %716 %M09214530
OCT0260000000300000, "6OUTPU", "T0000000", %718 %M09214535
OCT0260000000320000, "5REMOB", %721 %M09214540
OCT0220000000000000, "5RPROP", %723 %M09214545
OCT0170000000000000, "5QMARK", %725 %M09214550
OCT0170000000020000, "3ALF00", %727 %M09214555
OCT0170000000040000, "3DGT00", %729 %M09214560
OCT0170000000060000, "3VWL00", %731 %M09214565
OCT0170000000100000, "3LTR00", %733 %M09214570
OCT0170000000120000, "4BIT10", %735 %M09214575
OCT0170000000140000, "4BIT00", %737 %M09214580
OCT0170000000160000, "5AMONG", %739 %M09214585
OCT0170000000200473, "6OUTST", "R0000000", %741 %M09214590
OCT0170000000220627, "5INSTR", %744 %M09214595
OCT0200000000000000, "4CONJ0", %746 %M09214600
OCT0200000000020000, "5INDBL", %748 %M09214605
OCT1720000000001052, "2EQ000", %750 %M09214610
OCT1720000000020000, "4NEQL0", %752 %M09214615
OCT1070000000000646, "4CASE0", %754 %M09214620
OCT0776700000000000, "3CAR00",%756 %M09214625
OCT0776300000001305, "3CDR00", %758 %M09214630
OCT0240000003740000, "5READN", OCT0000600000000000, % 760 %M09214633
OCT0240000000060000,":DYNAM","IC DIALS",OCT0000000004000001;% 763 %A09214635
COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; %M09214640
FOR NEXTINFO ~ 512 STEP 2 UNTIL 530 DO PUT((TAKE(NEXTINFO))& %T9209214645
STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], %M09214650
LASTINFO ~ STACKHEAD[GT2] ~ NEXTINFO); %M09214655
NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980
BUILDLINE.[45:1]~TRUE ; 09214985
PUTNBUMP(0); 09214990
FILL MACRO[*] WITH 09215000
OCT0131, COMMENT SFS A 00 ; 09216000
OCT0116, COMMENT SFD A 01 ; 09217000
OCT0047, % JFW A 02 09218000
OCT0140, COMMENT INC A 03 ; 09219000
OCT0130, COMMENT SRS A 04 ; 09220000
OCT0117, COMMENT SRD A 05 ; 09221000
OCT0057, % JRV A 06 09222000
OCT0000, COMMENT SYNTAX ERROR07 ; 09223000
OCT00310143, COMMENT CRF A, SFS 008 ; 09224000
OCT00160143, COMMENT CRF A, SFD 009 ; 09225000
OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000
OCT00400143, COMMENT CRF A, INC 011 ; 09227000
OCT00300143, COMMENT CRF A, SRS 012 ; 09228000
OCT00170143, COMMENT CRF A, SRD 013 ; 09229000
OCT00570143, % CRF A, JRV O 14 09230000
OCT0000, COMMENT SYNTAX ERROR15 ; 09231000
OCT0153, COMMENT RSA A 16 ; 09232000
OCT0104, COMMENT RDA A 17 ; 09233000
OCT0150, COMMENT RCA A 18 ; 09234000
OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000
OCT0122, COMMENT SES A 20 ; 09236000
OCT0106, COMMENT SED A 21 ; 09237000
OCT0000, COMMENT SYNTAX ERROR22 ; 09238000
OCT0000, COMMENT SYNTAX ERROR23 ; 09239000
OCT0056, COMMENT TSA 0 24 ; 09240000
OCT0000, COMMENT SYNTAX ERROR25 ; 09241000
OCT0000, COMMENT SYNTAX ERROR26 ; 09242000
OCT0000, COMMENT SYNTAX ERROR27 ; 09243000
OCT0000, COMMENT SYNTAX ERROR28 ; 09244000
OCT0007, COMMENT TDA 0 29 ; 09245000
OCT0000, COMMENT SYNTAX ERROR30 ; 09246000
OCT0000, COMMENT SYNTAX ERROR31 ; 09247000
OCT0115, COMMENT SSA A 32 ; 09248000
OCT0114, COMMENT SDA A 33 ; 09249000
OCT0154, COMMENT SCA A 34 ; 09250000
OCT0141; COMMENT STC A 35 ; 09251000
FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010
"[# ", 09251020
"]# ", 09251030
"># ", 09251040
"}# ", 09251050
"=# ", 09251060
"!# ", 09251070
"{# ", 09251080
"<# ", 09251090
"|# ", 09251100
"1# ", 09251101
"3# ", 09251102
"0# ", 09251103
"1# ", 09251104
"2# ", 09251105
"2# ", 09251106
"0# " 09251107
; 09251200
NEXTTEXT~26 ; 09251300
FILL DPI[*] WITH %T9209251310
OCT41113, OCT42107, OCT47077, OCT51101, OCT43105, %T9209251315
OCT50123, OCT00104, OCT52115, OCT45053, OCT00110, %T9209251320
OCT00100, OCT00102, OCT00106, OCT00124, OCT46065, %T9209251325
"5DATAN", "4DCOS0", "4DEXP0", "4DLOG0", "4DSIN0", %T9209251330
"5DSQRT", "5DLG10", "5DATN2", "4CABS0", "4CCOS0", %M09251350
"4CEXP0", "4CLOG0", "4CSIN0", "5CSQRT", "4DMOD0", %M09251400
COMMENT FOLLOWING ARE TEMPS 1 - 10; %M09251450
143,144,145,146; %A09251500
%T9309251550
PERR ~ -1 ; % INITIALIZE ERRORMESS NUMBER %T1409251600
SINGLTOG ~ TRUE; % %T1109251700
DO UNTIL STEPI = BEGINV; 09252000
BUILDLINE.[45:1]~FALSE; 09252050
IF NOT BUILDLINE THEN BUILDLINE ~ USELINO ~ TRUE; % %T0309252060
IF STEPI=DECLARATORS AND ELBAT[I].ADDRESS = SYMV %M09252100
THEN IF (RECLAIMTOG ~ STEPI=INTRNS AND ELBAT[I].INCR=2) %A09252200
OR (SYMSTK ~ ACCUM[1] = "4PLEX0") THEN BEGIN %A09252300
IF STEPI ! SEMICOLON THEN ERR(0); %M09252400
ELBAT[I].CLASS ~ BEGINV END ELSE I ~ I-2 ELSE I~I-1; %M09252500
COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000
THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000
LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000
AND IS ALSO USED AS A ONE SYLLABLE 09256000
CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000
ITS PRIMARY FUNTION IS TO CUT BACK 09258000
THE STACK AFTER A COMMUNICATE OPERATOR. 09259000
MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000
IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000
C-RELATIVE ADDRESSING FOR CONSTANTS 09262000
IN THE PROGRAM STREAM 09263000
OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000
THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000
LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000
CELL.AT THE START OF COMPILATION XXXX IS 09267000
ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000
IT IS CHANGED BEFORE COMPILATION IS 09269000
COMPLETE TO LOOK LIKE A WORD MODE 09270000
PROGRAM DESCRIPTOR; 09271000
EMITL(0);EMITO(MKS); 09272000
GT1~PROGDESCBLDR(3,0,0); 09273000
GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000
% %M09274050
PRTIMAX ~ 23; %A09274100
ENDTOG ~ PRTOG; PRTOG ~ FALSE; %M09274150
FOR GT1 := 23 STEP 1 UNTIL 151 DO GT2 := GETSPACE(TRUE,-1); %T9309274200
PRTOG ~ ENDTOG; ENDTOG ~ FALSE; %M09274250
ERRORTOG~TRUE; BLOCK(FALSE); 09275000
COMMENT THIS CODE WILL PUT AN EXTRA CARD ON 0CRDIMG TAPE 09275100
THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200
THE END. CARD OFF AN INPUT TAPE; 09275250
IF NEWTOG THEN 09275300
BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350
"D ON 0CR","DING TAP","E ", " "," ", 09275400
" ","99999999"; 09275450
WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500
END; 09275550
IF INOUTUSED.[46:2]=1 THEN FLAG(645); %M09275600
ERRORTOG ~ TRUE; %A09275625
IF INOUTUSED.[44:2]=1 THEN FLAG(644); %M09275650
09275700
09275750
09275800
09275850
09275900
09275950
09276000
COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000
WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000
USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000
THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000
IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000
PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000
INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000
ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000
FIELD IS BROKEN INTO 2 PARTS. [33:2] IS USED TO ADD TO THE 09285000
INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000
THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000
PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000
DRUM ADDRESSES TO THE INTRINSICS; 09289000
IF DPI[107] ! 0 THEN BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %A09289100
GT2 ~ PROGDESCBLDR(1,0,24); %A09289200
PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ % %A09289300
1 & 92 [19:39:9] & SGNO[28:38:10] & 1[2:47:1]; %A09289400
PDINX ~ PDINX + 1; END; %A09289500
FOR GT1 ~ 0 STEP 1 UNTIL 14 DO %M09290000
IF GT2 ~ (GT3 ~ DPI[GT1]).ADDRESS ! 0 THEN BEGIN %M09290100
SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %M09290200
GT2 ~ PROGDESCBLDR(1,0,GT2); %M09290300
PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ %M09290400
1 & GT3[19:39:9] &SGNO[28:38:10] & 1[2:47:1]; %M09290500
PDINX ~ PDINX + 1; %M09290600
IF LISTOG THEN BEGIN WRTINTRSC(SGNO,DPI[GT1+15], %M09290700
B2D(GT2.[38:10]),LIN); WRITELINE END END; %M09290800
GT1 ~ GT3 ~ STARTINTRSC; 09291000
L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000
IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000
BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000
BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000
GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000
| 2 + 1, 0, GT2.ADDRESS); 09296100
PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000
1 & INFO[GT1.LINKR,GT1.LINKC][16:21:12] %M09298000
& SGNO[28:38:10] & 1[2:47:1]; 09298100
PDINX ~ PDINX + 1; 09299000
IF LISTOG AND PRTOG THEN % %T0709300000
BEGIN GT3 ~ GT3 + 1; 09300100
BLANKET(14,LIN); % BLANK BUFFER. 09300150
WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200
B2D(GT2.[38:10]), LIN); 09301000
IF NOTPNTED THEN PERMLINE(REAL(LISTOG)=3); WRITELINE; %T9309302000
END 09303000
END; 09304000
GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000
GO TO L1; 09305100
END; 09306000
L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100
EMITL(5);EMITO(COM); 09307000
ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100
SEGMENT((L+3) DIV 4,1,0); 09308000
COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000
AT THIS TIME AS A TYPE 2 SEGMENT; 09310000
IF GT1~GT2.ADDRESS!0 THEN 09311000
BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000
GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000
MOVE(128,TEN,EDOC[0,0]); MOVE(10,TEN[128],EDOC[1,0]); %A09314000
BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100
SEGMENT(-138,SGNO,0); %A09315000
BUILDLINE ~ BUILDLINE.[46:1] ; 09315100
END; 09316000
BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000
INTEGER PRTADR,SEGMNT,LINK; 09318000
INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE); VALUE SIZE; 09319000
ARRAY FROM[0,0]; INTEGER SIZE; 09320000
BEGIN INTEGER NSEGS,I,J; 09321000
REAL T; 09322000
NSEGS~(SIZE+29) DIV 30; 09323000
IF DA DIV CHUNK<T~(DA+NSEGS) DIV CHUNK THEN 09324000
DA~CHUNK|T; 09325000
MOVEANDBLOCK~DA; 09326000
DO BEGIN FOR J~0 STEP 2 WHILE J<30 AND I<SIZE DO 09327000
BEGIN MOVE(2,FROM[I DIV 128,I MOD 128],CODE(J)); 09328000
I~I+2; END; 09329000
IF ERRORCOUNT = 0 AND SAVETIME } 0 THEN %A09329500
WRITE(CODE[DA]); DA~DA+1; 09330000
END UNTIL I}SIZE; 09331000
END MOVEAND BLOCK; 09332000
COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000
09334000
09335000
09336000
09337000
09338000
09339000
09340000
09341000
09342000
09343000
09344000
09345000
09346000
09347000
FOR I~0 STEP 1 UNTIL PDINX-1 DO 09348000
IF (GT1~PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000
BEGIN PRTADR~GT1.[8:10]; SEGMNT~GT1.[28:10]; 09350000
LINK~SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000
MDESC(GT1.[18:10]&SEGMNT[18:33:15] 09352000
&(IF LINK=0 THEN SEGMNT+2048 ELSE LINK) 09353000
[6:36:12]&GT1[4:4:2]&5[1:45:3], 09354000
PRT[PRTADR DIV 128,PRTADR MOD 128]); 09354100
SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]~PRTADR; 09355000
END ELSE 09356000
BEGIN SEGMNT~GT1.[28:10]; 09357000
SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]~ 09358000
SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]&GT1[23:38:10] 09359000
& GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 09360000
END; 09361000
IF GOTCHA AND "RCC63YH"!TIME(-1)!"ACCSITE" THEN CHECKSTREAMS; % %T0309361001
COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX~AKKUM; 09361005
COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 09361010
GTI1~0; 09361020
COMMENT ADD IN ARRAYS; 09361030
GTI1~GTI1+( IF NOOFARRAYS =0 THEN 0 ELSE IF NOOFARRAYS {4 09361040
THEN 2000 ELSE IF NOOFARRAYS { 8 THEN 3500 09361050
ELSE 5000); 09361060
COMMENT ADD IN SEGMENT SIZE REQUIREMENTS; 09361070
GTI1~GTI1+ (IF NEWINX { 1000 THEN NEWINX ELSE IF NEWINX {2000 09361080
THEN 1000 ELSE NEWINX/2); 09361100
COMMENT ADD IN STACK AND PRT; 09361110
GTI1~GTI1+ 512 + PRTIMAX; 09361120
COMMENT ADD IN JRT; 09361130
GTI1~GTI1 + ( (FILENO +1)| 5); 09361140
COMMENT ADD IN I/O BUFFER REQUIREMENTS; 09361150
GTI1~GTI1+IOBUFFSIZE; COMMENT I/O SIZE CAL. IN P.IODEC; 09361160
COMMENT ADD SEGMENT DICT.SIZE; 09361170
GTI1~GTI1+ SGAVL-1; 09361180
COMMENT ADD IN CORE ESTIMATE FOR SORT; 09361181
GTI1:=GTI1+CORESZ; 09361182
COMMENT CHECK IF TOTAL IS MORE THAN 8 MODS; 09361190
IF GTI1 } 32000 THEN GTI1~ 32000; 09361200
COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 09361210
COMMENT WRITE OUT FILE PARAMETER BLOCK; 09393000
GT1 ~ MIN((IDLOC-IDLOCTEMP).[33:15]+1,128);% AHA %D09394000
MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000
ZEROUT(IDARRAY[0],0,30); 09395500
IDARRAY[4]~MOVEANDBLOCK(EDOC,GT1); 09396000
IDARRAY[5]~GT1; 09397000
COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000
IDARRAY[0]~MOVEANDBLOCK(SEGDICT,SGAVL); 09399000
IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100
(LDICT,SGAVL)[18:33:15] ; 09399150
IDARRAY[1]~SGAVL; 09400000
COMMENT WRITE OUT PRT; 09401000
IDARRAY[2]~MOVEANDBLOCK(PRT,PRTIMAX); 09402000
IDARRAY[3]~PRTIMAX; 09403000
COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000
IDARRAY[6]~1; 09405000
COMMENT PASS NUMBER OF FILES; 09405100
IDARRAY[7] ~ (FILENO-1)&GTI1[18:27:15]; 09405200
COMMENT WRITE DISK SEGMENT ZERO; 09406000
MOVE(30,IDARRAY[0],CODE(0)); WRITE(CODE[0]); 09407000
IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050
LOCK(CODE,SAVE); 09407100
IF LISTOG OR NOT NOHEADING THEN 09408000
BEGIN FORMAT PAN(" NUMBER OF SYNTAX ERRORS DETECTED =",I4,X6,2A4/" "%T0709409000
"NUMBER OF SEQUENCE ERRORS DETECTED = "U /" COMPILATION TIMES: " %T0709410000
"PROCESSOR = "U "SECONDS; IO = "U "SECONDS; ELAPSED = "U "SECONDS"/%T0709410100
" PRT SIZE = "U /" TOTAL SEGMENT SIZE = "U "WORDS"/" DISK SIZE = " %T0709411000
U"SEGMENTS"/" NUMBER OF PROGRAM SEGMENTS = "U/ % %T0709412000
" ESTIMATED CORE STORAGE REQUIREMENT = "U "WORDS"/ % %T0709413000
" ESTIMATED AUXILIARY MEMORY REQUIRMENT = "U"WORDS"///% %T0709413010
" * * * * * * * * L E G E N D * * * * * * * *"// %T0709413050
"ERRORS - THE NUMBER OF SYNTAX ERRORS DETECTED THUS FAR"/ %T0709413100
"BEGINS - THE NUMBER OF UNMATCHED BEGINS DETECTED THUS FAR"/ %T0709413200
"LEVEL - THE DECLARATION OF A LABEL AND ITS USE (FOLLOWED BY :)"%T0709413300
" MUST BE ON THE SAME LEVEL"/ %T0709413320
"LINE - THE NUMBER OF CARD IMAGES READ THUS FAR"/ %T0709413400
" NORMALLY ERROR TERMINATION MESSAGES REFERENCE " %T0709413440
"LINE NUMBER"/ %T0709413450
"SEQUENCE - THE CONTENTS OF COLUMNS 73 THRU 80 IN THE CARD IMAGE"/ %T0709413500
"SOURCE - THE INDICATION OF THE ORIGIN OF A CARD IMAGE:"/ %T0709413600
" BLANK - IMAGE FROM READER, NOT MERGING WITH TAPE"/ %T0709413620
" R - IMAGE FROM READER, MERGING WITH TAPE"/ %T0709413630
" T - IMAGE FROM TAPE, MERGING WITH READER"/ %T0709413640
" A - I - IMAGE FROM SOURCE LIBRARY"/ %T0709413650
" V - IMAGE VOIDED"/ %T0709413660
" O - IMAGE OMITTED"/ %T0709413670
"ADDRESS - THE NUMBER OF WORDS OF CODE GENERATED IN THE CURRENT " %T0709413700
"SEGMENT"/ %T0709413750
"SYLLABLE - THE NUMBER OF SYLLABLES OF CODE GENERATED IN THE " %T0709413800
"CURRENT WORD"/ %T0709413850
"SEQ ERR - NONBLANK IF SEQUENCE CHECKING IS PERFORMED AND A SEQUE"%T0709413900
"NCE ERROR OCCURS ON THAT LINE"/ %T0709413950
"SEGMENT - THE NUMBER OF THE CURRENT SEGMENT INTO WHICH CODE IS " %T0709414000
"BEING EMITTED"// %T0709414100
" THE ASTERISKS ON THE LINE BEFORE AND AFTER THE CARD IMAGE"/ %T0709414600
" REPRESENT FICTITIOUS COLUMNS 0 AND 73"); % %T0709414900
MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4);09415000
MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4);09416000
WRITE(LINE,PAN,ERRORCOUNT,GT1,GT2,SEQERRORCOUNT,TIME(2) DIV 60, % %T0709417000
TIME(3) DIV 60,(TIME(1)-TIME1) DIV 60, % %T0709417010
PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000
DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ); 09419000
% %A09419500
END END END PROGRAM; 09420000
BOOLEAN PROCEDURE EXPLICITFORMAT; %W4009500000
BEGIN INTEGER PRT,ITEM; LABEL DEBLANK; %W4009500010
ARRAY TEDOC[0:7,0:127]; %W4009500015
DEBLANK: % %W4009500020
STOPDEFINE~BOOLEAN(2); STEPIT; %W4009500030
IF Q:=ACCUM[1]="1<0000" OR Q="3LSS00" THEN % %W4009500040
BEGIN %W4009500050
EXPLICITFORMAT := TRUE; % %W4009500100
MOVECODE(TEDOC,EDOC); BUILDLINE~BUILDLINE.[2:46]; % %W4009500300
GT5~SGNO;GT1~(2|SGAVL-1)&2[4:46:2];SGNO~SGAVL; %NEW SEGMENT %W4009500400
F:=0;PRT:=GETSPACE(TRUE,-4);Z:=PROGDESCBLDR(LDES,0,PRT); %T9309500500
GT4 := LL; LL := 0; % %W4009500550
ELCLASS := "<"; TB1 := FORMATPHRASE; LL:= GT4; % %W4009500600
SEGMENT(-F,SGNO,GT5); % %W4009500650
SGAVL ~ SGAVL+1; SGNO ~ GT5; MOVECODE(TEDOC,EDOC); %W4009500700
IF LASTELCLASS ! ">" AND LASTELCLASS ! ")" THEN ERR(136); %%W4009500800
ELBAT[I].CLASS ~ IF ELCLASS = "," THEN COMMA %W4009500900
ELSE IF ELCLASS = ")" THEN RTPAREN ELSE 0; %W4009501000
I ~ I-1; BUILDLINE~BUILDLINE.[1:46]; %W4009501100
EMITL(0); EMITPAIR(PRT,LOD); %W4009501200
END ELSE I := I - 1; % %W4009501250
END EXPLICITFORMAT; %W4009501300
COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000
COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000
FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000
WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000
ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000
RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTORS OF 10005000
STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000
EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000
THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000
TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000
S = [1:1], 10010000
REPEAT = [38:10], 10011000
SKIP = [32:6], 10012000
CODE = [2:4], 10013000
W = [6:6], 10014000
W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4]. 10015000
S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000
TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000
BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000
WORDS. GIVEN S = 1 WE HAVE: 10019000
IF CODE = 0 THEN RIGHTPAREN, 10020000
IF CODE = 2 THEN STRING, 10021000
IF CODE = 4 THEN LEFTPAREN, 10022000
IF CODE = 6 THEN STROKE. 10023000
IF CODE = 8 THEN SCALE. 10023100
GIVEN S = 0 WE HAVE 10024000
IF CODE = 0 THEN D, 10025000
IF CODE=1 THEN T, 10025010
IF CODE = 2 THEN X, 10026000
IF CODE = 4 THEN A, 10027000
IF CODE = 6 THEN I, 10028000
IF CODE = 8 THEN F, 10029000
IF CODE =10 THEN E, 10030000
IF CODE = 11 THEN U, 10030100
IF CODE =12 THEN O, 10031000
IF CODE = 13 THEN V, 10031100
IF CODE =14 THEN L. 10032000
IF CODE = 15 THEN R. 10032100
W IS THE FIELD WIDTH. 10033000
FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000
ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000
REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000
REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000
HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000
IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000
A NON-ZERO REPEAT FIELDS. 10040000
THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000
FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000
D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH. 10043000
THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000
FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000
W2 = D1 = D2 =0. 10046000
FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010
W2=D1=D2=0. 10046020
FOR A, W1 = W, SKIP = 0 IF W < 6. OTHERWISE 10047000
W1 = 6, SKIP = W-6. W2=D1=D2=0. 10048000
FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000
IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000
IF W < 8 THEN W1 = W, W2 = 0. ALWAYS D1=D2=0. 10051000
FOR F IF D < 8 THEN D1 = D, D2=0. 10052000
IF D > 8 THEN D1 = 8, D2=D-8. 10053000
IF D >16 THEN ERROR. 10054000
IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000
SKIP=0. 10056000
IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8. 10057000
IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000
FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000
D+1 FOR D. SKIP = W-D-6. W1=W2=0. 10060000
FOR O, W1=W2=D1=D2=SKIP=0. 10061000
FOR L, W2=D1=D2=0. IF W > 5 THEN W1=5 ELSE W1 = W. 10062000
SKIP = W-W1. 10063000
FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100
FOR B: SEE U-PHRASE DESCRIPTION. 10063110
FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200
FOR V: SKIP = W1 = W2 = UNSET. D1,D2 AS IN ABOVE 10063300
F-PHRASE DESCRIPTION. 10063400
FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000
WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000
BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000
IF IT NOTICES AN ERROR; 10067000
PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000
BEGIN 10069000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B10070000
MOVE(1,W,EDOC[F.[38:3],F.[41:7]]); 10071000
IF DEBUGTOG 10072000
THEN BEGIN 10073000
DEBUGWORD(B2D(F),W,LIN); 10074000
WRITELINE END; 10075000
F ~ F+1; 10076000
10077000
10078000
10079000
10080000
10081000
END WHIPOUT; 10082000
BOOLEAN PROCEDURE FORMATPHRASE; 10083000
BEGIN 10084000
LABEL EL,EX,EXIT,L1,L2,L3; 10085000
PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000
VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000
REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000
BOOLEAN S; 10089000
BEGIN IF W > 63 THEN FLAG(163); 10090000
W ~ REPEAT & W [ 6:42:6] 10091000
& SKIP [32:42:6] 10092000
& W1 [28:44:4] 10093000
& W2 [24:44:4] 10094000
& D1 [20:44:4] 10095000
& D2 [16:44:4] 10096000
& CODE [ 2:44:4] 10097000
& REAL(S) [ 1:47:1]; 10098000
WHIPOUT(W) END EMITFORMAT; 10099000
STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000
VALUE LETTER,CTR; 10101000
BEGIN DI ~ PLACE; DS ~ LIT "B"; 10102000
SI ~ LOC CTR; SI ~ SI+7; DS ~ CHR; 10103000
SI ~ PLACE; SI ~ SI+3; DS ~ 5 CHR; 10104000
SI ~ LOC LETTER; SI ~ SI+7; DS ~ CHR END PACKALPHA; 10105000
INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000
DEFINE RRIGHT = 0#, 10107000
RLEFT = 4#, 10108000
RSTROKE = 6#; 10109000
DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500
DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000
RT=1 #, 10110010
RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000
IF ELCLASS < 0 THEN BEGIN REPEAT ~ -ELCLASS;NEXTENT; 10112000
IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100
ELSE BEGIN REPEAT ~ REAL(ELCLASS ! "(" AND ELCLASS ! "<" ); %W4010113000
IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100
NEXTENT; 10113200
END END; 10113300
IF ELCLASS = "(" OR ELCLASS = "<" %W4010114000
THEN BEGIN 10115000
SKIP ~ F; 10116000
EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000
DO BEGIN NEXTENT; 10118000
EL: IF FORMATPHRASE THEN GO TO EX END 10119000
UNTIL ELCLASS ! ","; 10120000
WHILE ELCLASS = "/" 10121000
DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000
NEXTENT END; 10123000
IF ELCLASS ! ")" AND ELCLASS ! ">" THEN GO TO EL; %W4010124000
IF REPEAT = 0 THEN 10125000
EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000
REPEAT~F-SKIP; F~SKIP; 10127000
WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100
F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200
ELSE IF ELCLASS = "O" 10128000
THEN BEGIN CODE~RO; W~8 END 10129000
ELSE IF ELCLASS = "D" 10130000
THEN BEGIN CODE~RD; W~8 END 10131000
ELSE IF ELCLASS = "," THEN GO TO L2 10132000
ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000
ELSE IF ELCLASS = ")" OR ELCLASS = ">" THEN GO TO EXIT %W4010134000
ELSE IF ELCLASS = "S" THEN 10134500
BEGIN 10134510
NEXTENT; 10134520
W ~ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530
IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540
IF ELCLASS="*" THEN REPEAT.[12:1]~1 ELSE 10134545
IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550
GO TO EXIT 10134560
END 10134570
ELSE REPEAT ~ - ELCLASS; 10134580
EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590
GO TO L2 10134600
END 10134610
ELSE IF ELCLASS = """ 10135000
THEN BEGIN 10136000
IF REPEAT ! 1 THEN FLAG(136); 10136500
CODE ~ 100; 10137000
DO BEGIN 10138000
SKIP ~ 1; 10139000
DO BEGIN RESULT ~ 5; COUNT ~ 0; SCANNER; 10140000
IF ELCLASS ~ ACCUM[1].[18:6] = CODE 10141000
THEN BEGIN 10142000
IF SKIP ! 1 THEN WHIPOUT(W); 10143000
GO TO L2 END; 10144000
CODE ~ """; 10145000
PACKALPHA(W,ELCLASS,SKIP); 10146000
END UNTIL SKIP ~ SKIP+1 = 7; 10147000
WHIPOUT(W) 10148000
END UNTIL FALSE END 10149000
ELSE BEGIN CODE~ELCLASS; 10150000
IF CODE = "U" OR CODE = "B" THEN 10150100
BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 10150110
NEXTENT ; 10150120
SKIP ~ 0 ; 10150125
IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150130
BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135
IF ELCLASS = "*" THEN REPEAT.[13:1] ~ 1 10150140
ELSE W ~ -ELCLASS ; 10150145
NEXTENT ; 10150150
IF ELCLASS = "." THEN 10150155
BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 10150160
NEXTENT ; 10150165
IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150170
BEGIN %%% PHRASE IS UW<OR>*.D<OR>*. 10150175
IF ELCLASS = "*" THEN REPEAT.[14:1]~1 10150185
ELSE SKIP ~ -ELCLASS ; 10150190
NEXTENT ; 10150195
END 10150200
ELSE GO TO EX 10150205
END 10150210
END 10150215
ELSE W ~-63 ; %%% PHRASE IS U. 10150220
EMITFORMAT(FALSE,RU,REPEAT,SKIP,W,REAL(CODE="B"), 10150225
REAL(W<0),0,0) ; 10150230
GO TO EXIT ; 10150260
END OF U PHRASE HANDLER ; 10150270
IF GETINT THEN BEGIN W~11; REPEAT.[13:1]~1 END 10150280
ELSE ELCLASS := -(W := ELCLASS); 10150290
IF CODE = "I" 10151000
THEN BEGIN 10152000
SKIP ~ DIVIDE(W,W1,W2); CODE ~ RI END 10153000
ELSE IF CODE = "F" 10154000
THEN BEGIN CODE ~ RF; GO TO L1 END 10155000
ELSE IF CODE = "R" THEN BEGIN CODE ~ RR; GO TO L1 END 10155500
ELSE IF CODE = "E" 10156000
THEN BEGIN CODE ~ RE; D1~1; 10157000
L1: NEXTENT; 10158000
IF ELCLASS!"." THEN GO EX; 10159000
IF GETINT THEN BEGIN ELCLASS~3; REPEAT.[14:1]~1 END; 10159100
IF DIVIDE(ELCLASS+D1,D1,D2) > 0 THEN GO TO EX; 10160000
IF CODE = RF OR CODE = RR THEN 10161000
SKIP ~ DIVIDE(W-ELCLASS-1,W1,W2) 10161500
ELSE IF SKIP ~ W-ELCLASS-6 < 0 THEN GO TO EX END 10162000
ELSE IF CODE = "X" 10163000
THEN BEGIN CODE ~ RX; W1 ~ W.[38:4]; 10164000
SKIP ~ W ~ W.[42:6] END 10165000
ELSE IF CODE="T" THEN IF W~ABS(W)-1<0 THEN FLAG(136) 10165500
ELSE BEGIN CODE~RT; W1~W.[38:4]; W~W.[42:6] END 10165505
ELSE IF CODE = "A" 10166000
THEN BEGIN CODE ~ RA; W1 ~6; GO TO L3 END 10167000
ELSE IF CODE="V" THEN 10167100
BEGIN CODE ~ RV ; 10167200
COUNT~ACCUM[1]~0; 10167300
IF EXAMIN(NCR)=" " THEN 10167400
BEGIN RESULT~7; SCANNER END; 10167500
IF EXAMIN(NCR)="." THEN 10167600
BEGIN NEXTENT; 10167700
IF GETINT THEN REPEAT.[14:1]~1 ELSE 10167800
GT1~DIVIDE(ELCLASS,D1,D2); 10167900
ELCLASS :=-ELCLASS; 10167910
END; END ELSE IF CODE="L" 10168000
THEN BEGIN CODE ~ RL; W1 ~ 5; 10169000
L3: IF W<W1 THEN W1~W; SKIP ~ W-W1 END ELSE GO EX END; 10170000
EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10171000
L2: NEXTENT; GO TO EXIT; 10172000
EX: FORMATPHRASE ~ TRUE; ERR(136); 10173000
EXIT: END FORMATPHRASE; 10174000
COMMENT GETINT DOES A CALL ON NEXTENT AND CHECKS TO SEE IF AN INTEGER 10175000
WAS THE RESULT: IF NOT ERROR - OTHERWISE MAKE SIGN PLUS; 10176000
BOOLEAN PROCEDURE GETINT; 10177000
BEGIN NEXTENT; IF ELCLASS ~ - ELCLASS < 0 THEN 10178000
IF ELCLASS=-("*") THEN GETINT~TRUE ELSE 10178100
BEGIN FLAG(137); ELCLASS ~ 0 END 10179000
END GETINT; 10180000
COMMENT DIVIDE PARTIONS THE PARAMETER NUMBER INTO THREE PARTS. THE 10181000
RESULT IS PASSED BACK THROUGH P1,P2, AND THE FUNCTION 10182000
IDENTIFIER. SEE CODE FOR DETAILS; 10183000
INTEGER PROCEDURE DIVIDE(NUMBER,P1,P2); 10184000
VALUE NUMBER; INTEGER P1,P2,NUMBER; 10185000
BEGIN 10186000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B10186500
IF NUMBER < 0 THEN BEGIN FLAG(138); ERRORTOG~TRUE; 10187000
NUMBER ~ 0 END; 10188000
P1 ~ IF NUMBER < 8 THEN NUMBER ELSE 8; 10189000
NUMBER ~ NUMBER-P1; 10190000
P2 ~ IF NUMBER < 8 THEN NUMBER ELSE 8; 10191000
DIVIDE ~ NUMBER-P2 END DIVIDE; 10192000
COMMENT DEFINEGEN PACKS THE ALPHA FOR A DEFINE INTO INFO. DEFINEGEN 10193000
PRINCIPALLY ELIMINATES BLANKS AND COMMENTS. PUTOGETHER 10194000
ACTUALLY DOES THE MECHANICAL WORK OF PROCESSING THE 10195000
CHARACTORS FROM ACCUM TO INFO. THE FINAL TRANSFER IS DONE10196000
IN PACKINFO. THE OTHER FUNCTION SERVED BY DEFINEGEN IS 10197000
THAT OF COUNTING DEFINES AND CROSSHATCHES IN ORDER TO 10198000
ALLOW NESTED DEFINES. 10199000
A WORD ON THE OVERALL PLAN OF ATTACK ON HANDLEING 10200000
DEFINES: 10201000
THERE ARE FOUR PLACES THAT THERE IS CODE WRITTEN 10202000
EXPLICITLY FOR THE DEFINE. 10203000
FIRST IS DEFINEGEN WHICH LOADS THE ALPHA INTO INFO. 10204000
SECOND IS IN THE TABLE ROUTINE AFTER A DEFINED ID IS 10205000
NOTICED. HERE A SETUP IS PERFORMED SO THAT THE SCANNER 10206000
WILL SCAN INFO. SINCE INFO (UNLIKE I/O BUFFERS) IS NOT 10207000
A SAVE ARRAY, WE CAN NOT DIRECTLY SCAN INFO. INSTEAD WE 10208000
FOOL READACARD SO THAT THE ALPHA IS FETCHED FROM INFO AND 10209000
PLACED INTO A SMALL SAVE ARRAY (DEFINEARRAY) INSTEAD OF 10210000
BEING FETCHED FROM AN I/O DEVICE. NATURALLY WE MUST HAVE 10211000
NESTING WHICH IS OBTAINED BY USING DEFINEARRAY AS A SMALL 10212000
STACK. THE QUANTITIES SAVED ARE LCR,NCR, AND LASTUSED. 10213000
LASTUSED DOUBLES AS A DEVICE FOR DIRECTING THE FLOW OF 10214000
INFORMATION FROM I/O GEAR AND FROM INFO DURING ANALYSIS OF10215000
DEFINES. THIS STACKING IS DONE HERE BY THE TABLE ROUTINE.10216000
THIRD IS READACARD WHICH HAS NOW BEEN FAIRLY WELL 10217000
DESCRIBED. THE ONLY ADDITIONAL COMMENT NECESSARY IS THAT 10218000
LASTUSED SERVES AS AN INDEX TO FETCH NEXT WORD OF ALPHA 10219000
FROM INFO. READACARD FETCHES ONLY ONE WORD AT A TIME. 10220000
FOURTH IS ALSO IN THE TABLE ROUTINE. IT IS AT THE 10221000
PLACE THAT A CROSSHATCH IS NOTICED. IT CAUSES AN UNSETUP 10222000
SO THAT THE SCANNER WILL STOP SCANNING THAT PART OF INFO 10223000
AND RESUME ITS PREVIOUS TASKS. A DISTINCTION IS MADE 10224000
BETWEEN CROSSHATCHES SCANNED AFTER A DEFINE DECLARATION 10225000
AND THOSE SCANNED DURING THE RECALL PROCESS. THE LATER 10226000
ONLY CAUSES AN UNSETUP; 10227000
PROCEDURE DEFINEGEN(MACRO,J); VALUE MACRO,J; BOOLEAN MACRO; REAL J; 10228000
BEGIN 10229000
OWN INTEGER CHARCOUNT, REMCOUNT; 10230000
COMMENT CHARCOUNT CONTAINS NUMBER OFCHARACTORS OF THE DEFINE THAT WE10231000
HAVE PUT INTO INFO. REMCOUNT CONTAINS NUMBER OF CHARACT- 10232000
ORS REMAINING IN THIS ROW OF INFO; 10233000
PROCEDURE PUTOGETHER(CHAR); REAL CHAR; 10234000
BEGIN 10235000
STREAM PROCEDURE PACKINFO(INFO,ISKIP,COUNT,ASKIP,ACCUM); 10236000
VALUE ISKIP,COUNT,ASKIP; 10237000
BEGIN DI ~ INFO; DI ~ DI+ISKIP; 10238000
SI ~ ACCUM;SI ~ SI+ASKIP; SI ~ SI+3; 10239000
DS ~ COUNT CHR END PACKINFO; 10240000
INTEGER COUNT,SKIPCOUNT; 10241000
IF (COUNT ~ CHAR.[12:6]) + CHARCOUNT > 2047 10242000
THEN BEGIN FLAG(142); TB1~ TRUE END 10243000
ELSE BEGIN 10244000
IF COUNT > REMCOUNT 10245000
THEN BEGIN 10246000
SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT); 10247000
REMCOUNT ~ 2048 END 10248000
ELSE REMCOUNT ~ REMCOUNT-COUNT; 10249000
GT1 ~ CHARCOUNT DIV 8 + NEXTTEXT; 10250000
PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3],10251000
COUNT,0,CHAR); 10252000
IF SKIPCOUNT ! 0 THEN 10253000
PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000
COUNT,CHAR); 10255000
CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END 10256000
END PUTOGETHER; 10257000
10257100
10257200
10257300
10257400
10257500
10257600
10257700
10257800
10257900
INTEGER LASTRESULT; 10258000
REAL K,N,ELCLASS; 10258100
DEFINE I=NXTELBT#; 10258200
LABEL FINAL,PACKIN; 10258300
LABEL BACK,SKSC,EXIT; 10259000
REAL DINFO; 10259200
BOOLEAN TSTREAMTOG; % %T8910259400
DINFO ~ J.[18:15]; 10259600
J ~ J.[33:15]; 10259700
TB1~ FALSE; 10260000
TSTREAMTOG := STREAMTOG; % %T8910260050
STREAMTOG~TRUE; 10260100
CHARCOUNT ~ 0; 10261000
DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000
REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000
10263100
10263110
K~0; 10263200
BACK: STOPDEFINE~TRUE; 10263300
ELCLASS~TABLE(NXTELBT); 10263400
SKSC: NXTELBT~NXTELBT-1; 10263500
IF MACRO THEN 10263600
BEGIN IF ELCLASS=COMMA THEN 10263700
IF K=0 THEN 10263800
FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900
ELSE GO PACKIN; 10264000
IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100
BEGIN K~K+1; GO TO PACKIN END; 10264200
IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300
IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400
IF ELCLASS=SEMICOLON THEN 10264410
BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420
END; 10264500
IF RESULT = 1 THEN IF J ! 0 THEN 10264600
FOR N ~ 1 STEP 1 UNTIL J DO 10264650
BEGIN 10264700
IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1], 10264750
DEFINFO[(N-1)|10]) THEN 10264760
BEGIN 10264800
DEFINEPARAM(DINFO+1, N); 10264810
GO PACKIN; 10264820
END; 10264830
END; 10264900
PACKIN: 10264910
IF RESULT = 4 10265000
THEN BEGIN 10266000
COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 10267000
PUTOGETHER(2130706432); 10268000
PUTOGETHER(ACCUM[1]); 10269000
PUTOGETHER(2130706432) END 10270000
ELSE BEGIN 10271000
IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) 10272000
THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000
PUTOGETHER(ACCUM[1]) END; 10274000
IF TB1 THEN GO TO EXIT; 10275000
LASTRESULT ~ RESULT; 10276000
IF MACRO THEN GO BACK; 10276500
IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV10277000
THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END; 10278000
IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000
IF DEFINECTR ! 1 10280000
THEN BEGIN STOPDEFINE ~ TRUE; 10281000
IF ELCLASS~TABLE(I)!COMMA THEN 10282000
DEFINECTR~DEFINECTR-1; GO SKSC END; 10283000
EXIT: DEFINECTR := 0; STREAMTOG := TSTREAMTOG; % %T8910284000
NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000
END DEFINEGEN; 10286000
INTEGER TEMPCELL, LISTPTR; %W3310286500
BOOLEAN LISTLVFLAG; %W3310286600
COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000
ELEMENTS; 10288000
PROCEDURE LISTELEMENT; 10289000
BEGIN 10290000
INTEGER LISTADDRESS; %W3310290500
REAL T1,T2,T3; 10291000
REAL T4; %M10291500
LABEL BOOFINISH,STORE,LRTS; 10292000
DIALA ~ DIALB ~ 0; 10293000
T4 ~ ACCUM[1];% %A10293100
LISTLVFLAG ~ LISTLVFLAG AND (ELCLASS = LISTID %W3310293200
OR ELCLASS = SUPERLISTID); %W3310293400
IF ELCLASS = FORV THEN BEGIN COMMENT FORCLAUSE; %W3310294000
FORSTMT; LISTLVFLAG ~ FALSE END %W3310294200
ELSE IF ELCLASS = LFTBRKET 10295000
THEN BEGIN COMMENT GROUP OF LIST ELEMENTS; 10296000
DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000
IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000
ELSE IF ELCLASS=LISTID OR ELCLASS=SUPERLISTID THEN %W3310298100
BEGIN %W3310298120
IF LISTLVFLAG THEN L ~ L-3; %W3310298160
CHECKER(ELBAT[I]); LISTADDRESS~ELBAT[I].ADDRESS;%W3310298200
EMITL(0);EMITPAIR(LSTRTN,STD); %W3310298240
EMITNUM(L+3-LSTR+REAL(LISTPTR>1023)); %W3310298260
EMITPAIR(LISTPTR,STD); %W3310298280
IF ELCLASS=SUPERLISTID THEN %W3310298300
BEGIN BANA;EMITN(LISTADDRESS);IF LISTADDRESS>1023THEN EMITO(PRTE); %W3310298400
EMITO(LOD); %72 %W3310298430
EMITO(LOD); EMITO(XCH); EMITO(CDC) END %W3310298480
ELSE BEGIN EMITN(LISTADDRESS);STEPIT END; %W3310298500
EMITV(LSTRTN); EMITL(0); EMITO(GEQ); %W3310298600
EMITL(1); EMITO(BFC); EMITO(RTS); %W3310298700
EMITO(DEL); EMITL(5); EMITPAIR(LSTRTN,STD); %W3310298850
LISTLVFLAG ~ TRUE; %W3310298870
END %W3310298900
ELSE IF GT1 ~ TABLE(I+1) = RTPAREN AND L=LSTR %W3310298910
AND ELBAT[I].ADDRESS { 1023 %W3310298915
AND ELCLASS } SYMID AND ELCLASS { INTID THEN %T9310298920
COMMENT LIST CONSISTS OF A SINGLE SIMPLE VAR.; %W3310298930
BEGIN L ~ L-4-REAL(LISTPTR>1023); %W3310298940
CHECKER(ELBAT[I]); %W3310298945
EMITN(ELBAT[I].ADDRESS); EMITO(RTS); %W3310298950
STEPIT; %W3310298960
END %W3310298970
ELSE BEGIN COMMENT THE MEAT OF THE MATTER: 10299000
VARIABLES AND EXPRESSIONS; 10300000
L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000
EMITPAIR(LISTPTR,STD); COMMENT PREPARE LISTPTR FOR %W3310302000
NEXT TIME AROUND; 10303000
IF (GT1 = COMMA %W3310304000
OR GT1 = RTPAREN 10305000
OR GT1 = RTBRKET) 10306000
AND ELCLASS } SYMID AND ELCLASS { INTID %T9310307000
THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000
CHECKER(ELBAT[I]); 10308100
EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000
ELSE IF ELCLASS = 0 THEN% %A10309100
IF T4 = "8FREEL" OR T4 = "7NEXTA" THEN BEGIN% %A10309200
FIXCLASS(INTID,T4,BOOLEAN(3));EMITN(ADDRSF);STEPIT END % %A10309300
ELSE ERR(100)% %A10309400
ELSE BEGIN IF ELCLASS } SYMARRAYID %T9310310000
AND ELCLASS { INTARRAYID 10311000
THEN BEGIN COMMENT IS EITHER A SUBCRIPTED VARIABLE 10312000
OR THE BEGINNING OF AN EXPRESSION. THIS10313000
SITUATION IS VERY SIMILAR TO THAT IN 10314000
ACTUALPARAPART (SEE COMMENTS THERE FOR 10315000
FURTHER DETAILS); 10316000
T2 ~ FL; T3 ~ ELCLASS; VARIABLE(T2); 10317000
IF TABLE(I-2)=FACTOP AND TABLE(I-1)=RTBRKET THEN ERR(157);10318000
IF ELCLASS = COMMA OR 10319000
ELCLASS = RTPAREN OR 10320000
ELCLASS = RTBRKET THEN 10321000
IF T2 = 0 THEN GO TO STORE ELSE GO TO LRTS; 10322000
IF T3 = BOOARRAYID THEN GO TO BOOFINISH; 10323000
SIMPARITH; 10324000
IF ELCLASS = RELOP THEN BEGIN RELATION; 10325000
BOOFINISH: SIMPBOO END END 10326000
ELSE IF T4 ~ EXPRSS= DTYPE THEN ERR(156) ELSE %M10327000
IF T4 > 6 THEN ERR(643) ELSE %M10327100
IF T4 = 5 THEN BEGIN EMITO(MKS); EMITV(ATN) END ELSE %M10327200
IF T4 = 6 THEN DBLTSNGL(0); %M10327300
STORE: EMITPAIR(TEMPCELL,STD); EMITN(TEMPCELL) END; %W3310328000
LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000
T2 ~ L; L ~ T1; EMITNUM(T2-LSTR); L~T2 END END LSTELMT; 10330000
COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000
LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000
LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000
CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000
LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000
FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000
THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000
FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000
DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR. 10339000
LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000
LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000
VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000
ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000
REAL PROCEDURE LISTGEN; 10344000
BEGIN 10345000
INTEGER JUMPLACE,LISTPLACE; 10346000
COMMENT TEST TO INSURE LISTGEN NOT CALLED RECURSIVELY; %W3310346200
IF LISTMODE THEN ERR(476) ELSE %W3310346400
BEGIN %W3310346600
JUMPLACE ~ BAE; 10347000
LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000
TEMPCELL~GETSPACE(FALSE,-1);LISTPTR~GETSPACE(FALSE,-1);%W3310348500
COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000
EMITV(LSTRTN); EMITO(BFW); %W3310349400
EMITL(5); EMITPAIR(LSTRTN,STD); %W3310349600
EMITPAIR(REAL(LISTPTR>1023)+2,BFW); %W3310349800
EMITV(LISTPTR); EMITO(BFW); LSTR ~ L; %W3310350000
COMMENT INITIAL JUMP OF A LIST; 10351000
LISTMODE ~ TRUE; 10352000
COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000
I~I-1; 10354000
DO BEGIN 10355000
STEPIT; 10356000
LISTELEMENT 10357000
END UNTIL ELCLASS ! COMMA; 10358000
IF LISTLVFLAG THEN BEGIN L~L-3; LISTLVFLAG~FALSE END; %W3310358500
EMITL(1); EMITO(CHS); 10359000
EMITPAIR(LSTRTN,SND); 10360000
EMITO(RTS); 10361000
COMMENT SET END FLAG OF -1; 10362000
CONSTANTCLEAN; 10363000
DIALA ~ DIALB ~ 0; 10364000
LISTMODE ~ FALSE; 10365000
ADJUST; 10365100
EMITB(BFW,JUMPLACE,L); 10366000
STUFFF(LISTPLACE); 10367000
END %W3310368000
END LISTGEN; 10369000
BOOLEAN PROCEDURE MERRIMAC; 10370000
BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000
03 JULY 1963 10372000
THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000
LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,10374000
ARRAYS, AND FUNCTION DESIGNATORS. 10375000
WITH ONE EXCEPTION, THE MERRIMAC ROUTINES ONLY FUNCTION 10376000
IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE10377000
VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000
THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000
THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000
A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN10381000
ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000
ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000
THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000
INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000
FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000
EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000
AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000
POSSIBLE CALLS ON PRINTI. 10389000
ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000
THE IDENTIFIER TO BE PRINTED. 10391000
N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000
ARRAY OR SUBSCRIPTED VARIABLE. 10393000
V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000
S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000
PRINTED. 10396000
S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000
MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000
ONLY IF THEY ARE EQUAL. 10399000
FORMAT TYPE MONITOR DUMP 10400000
----------- ------- ---- 10401000
0 LABELS 10402000
SWITCHES 10403000
--------- ----- -- 10404000
1 SIMPLE VARIABLES LABELS 10405000
FUNCTION SIMPLE VARIABLES 10406000
--------- ----- -- 10407000
2 ARRAYS SUBSCRIPTED VARS 10408000
--------- ----- -- 10409000
3 SUBSCRIPTED VARS 10410000
--------- ----- -- 10411000
4 ARRAYS 10412000
********* ***** ** 10413000
FORMAT TYPE PRINTOUT 10414000
----------- -------- 10415000
0 ID 10416000
--------- ------ 10417000
1 ID=V 10418000
--------- ------ 10419000
2 ID[S1---SN]=V 10420000
--------- ------ 10421000
3 ID[S1---SN]=V 10422000
--------- ------ 10423000
4 ID=V1---VN 10424000
*********** ******** 10425000
THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY10426000
THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000
PASSING THE TYPEV TO PRINTI. 10428000
TYPE TYPEV 10429000
---- ----- 10430000
BOOLEAN 0 10431000
-- --- 10432000
REAL 1 10433000
-- --- 10434000
ALPHA 2 10435000
-- --- 10436000
INTEGER 3 10437000
**** ***** 10438000
POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000
AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000
FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000
----------- --------------------------- 10442000
0 <ID,CHARI,FILE,0> 10443000
--------- ------------------------- 10444000
1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000
--------- ------------------------- 10446000
2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000
FILE,2) 10448000
--------- ------------------------- 10449000
3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000
,ID,CHARI,FILE,3) 10451000
--------- ------------------------- 10452000
4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000
POWERSOFTEN,ID,CHARI,FILE,4) 10454000
*********** **************************** 10455000
SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000
MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000
THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000
THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000
ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000
ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000
MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000
MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000
WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000
MONITORING INFORMATION. 10465000
*********FORMAT OF INFO FOR MONITORED ITEMS**********10466000
ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000
WORD WILL BE SET. 10468000
SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000
ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000
THE MONITOR FILE IN [37:11]. I WILL HAVE A 10471000
DEFINE SVARMONFILE = [37:11]#. 10472000
ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000
NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000
MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000
FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000
DEFINE ARRAYMONFILE = [27:11]#. 10477000
SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000
SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000
TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000
OF INFO CONTAINING LOWER BOUND INFORMATION10481000
ALSO CONTAINS MONITOR INFORMATION. EITHER10482000
A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000
IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000
DESIGNATES WHETHER AN OPDC OR A LITC 10485000
SHOULD BE GENERATED USING [12:11]. IF THE10486000
BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000
ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000
MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000
ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000
PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000
SI* TO THE PRINTI ROUTINE. 10492000
LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000
THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000
ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000
DEFINE LABLMONFILE = [13:11]#. 10496000
SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000
I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000
FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000
WITH THE SAME NUMBER OF WORDS AS THE 10500000
ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000
REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000
ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000
FUNCMONFILE = [27:11]#; 10504000
DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000
ADDRESS OF THE MONITOR FILE; 10506000
DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000
SAVE THE ADDRESS OR VALUE OF A 10508000
SUBSCRIPT. ONE ADDITIONAL BIT IS10509000
USED TO TELL WHETHER TO EMIT AN 10510000
OPDC OR A LITC ON THIS ADDRESS OR10511000
VALUE; 10512000
DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000
DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000
VARIABLE APPEARING IN A MONITOR LIST;10515000
DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000
ADDITIONAL INFO AND IS USED WHEN MAKING10517000
A NEW ENTRY IN INFO FOR ARRAYS; 10518000
DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000
ELBAT WORD FOR A MONITOR LIST 10520000
ELEMENT; 10521000
DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000
SUBSCRIPTED VARIABLES TO TELL ME 10523000
WHETHER TO EMIT AN OPDC OR A LITC.10524000
0 IS USED FOR OPDC, 1 FOR LITC; 10525000
DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000
POINTING AT THE END OF ADDITIONAL 10527000
INFO AND IS USED TO TELL WHEN TO 10528000
STOP MOVING INFO FOR THE NEW ENTRY10529000
FOR MONITORED ARRAYS; 10530000
DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000
LINK POINTING AT THE FIRST 10532000
ADDITIONAL WORD OF INFO FOR 10533000
MONITORED ARRAYS; 10534000
DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000
CONCATENATE DEFINE FOR 10536000
STUFFING THE MONITOR FILE 10537000
ADDRESS INTO THE FIRST 10538000
ADDITIONAL INFO WORD FOR 10539000
ARRAYS AND FUNCTIONS; 10540000
DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000
PARTIAL WORD DESIGNATOR [4010542000
:8] USED TO EXTRACT THE 10543000
NUMBER OF PARAMETERS FOR A 10544000
GIVEN PROCEDURE FROM INFO; 10545000
DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000
OF PARAMETERS FOR A FUNCTION 10547000
DESIGNATOR APPEARING IN A MONITOR 10548000
LIST; 10549000
LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000
POINTING AT THE FILE IDENTIFIER IN THE 10551000
MONITOR DECLARATION; 10552000
LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000
TURNS ON THE MONITOR BIT OF THE ELBAT10554000
WORD IN THE MONITOR LIST AND STORES 10555000
IT IN ACCUM[0] FOR THE E ROUTINE; 10556000
LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000
REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000
EACH SUBSCRIPT EXPRESSION; 10559000
LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000
POINTING THE LAST LOGICAL QUANTITY OF THE 10561000
MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000
PROCESSED; 10563000
LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000
START:IF ELCLASS!FILEID THEN 10565000
BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100
"6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200
ERR(400); GO EXIT; 10565300
END 10566000
COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000
CHECKER(ELBAT[I]); 10568000
FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000
IF CHECK(LEFTPAREN,401) 10570000
THEN GO TO EXIT; 10571000
COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000
MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000
IF RANGE(BOOID,INTID) 10574000
THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000
E; PUTNBUMP(FILEIDENT); 10576000
GO CHKCOMMA; 10577000
END; 10578000
IF RANGE(BOOARRAYID,INTARRAYID) 10579000
THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000
SUBSCRIPTED VARIABLES; 10581000
E; NXTINFOTEMP~NEXTINFO; 10582000
PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000
TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000
ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000
DO PUTNBUMP(TAKE(INC~INC+1)) 10586000
UNTIL INC } TESTVARB; 10587000
IF TABLE(I+1) ! LFTBRKET 10588000
THEN GO CHKCOMMA; 10589000
TESTVARB~NODIM+NXTINFOTEMP; 10590000
STEPIT; 10591000
STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000
STEPI ! NONLITNO 10593000
THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000
SUBSCRIPTED VARIABLES. EITHER A LITC 10595000
OR AN OPDC ON A VARIABLE IS ALL THAT 10596000
IS NEEDED TO CALL THE SUBSCRIPT; 10597000
SUBSCRIPT~ELBAT[I].ADDRESS; 10598000
OPLIT~0; 10598500
IF NOT RANGE( INTRNSICPROCID,INTID) 10599000
THEN IF CHECK(LITNO,402) 10600000
THEN GO TO EXIT 10601000
ELSE COMMENT MARK FOR LITC; 10602000
OPLIT~1; 10603000
COMMENT ERROR 402 IS BAD 10604000
SUBSCRIPT IN MONITOR DECLARATION;10605000
STEPIT; 10606000
END 10607000
ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000
SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000
SUBSCRIPT EXPRESSION MUST BE GENERATED10610000
AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000
PROGRAM DESCRIPTOR CREATED AND THE 10612000
ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT10613000
MUST BE MARKED FOR AN OPDC; 10614000
JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000
ADES,L,0); AEXP; EMITO(RTS); 10616000
JUMPCHKX; 10616500
OPLIT~0; 10617000
IF MODE > 0 10618000
THEN BEGIN COMMENT STUFF F AT THIS 10619000
POINT IF MODE > 0; 10620000
STUFFF(SUBSCRIPT);EMITPAIR( 10621000
SUBSCRIPT,STD); 10622000
END; 10623000
END; 10624000
PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000
SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000
NXTINFOTEMP); 10627000
IF ELCLASS = COMMA 10628000
THEN GO TO STORESUBS; 10629000
IF CHECK(RTBRKET,403) 10630000
THEN GO TO EXIT; 10631000
COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000
EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000
IF NXTINFOTEMP ! TESTVARB 10634000
THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000
ELEMENT HAS IMPROPER NUMBER OF 10636000
SUBSCRIPTS; 10637000
I~I-1; ERROR(404); GO TO EXIT; 10638000
END; 10639000
GO CHKCOMMA; 10640000
END; 10641000
IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000
THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000
IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000
THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000
SWITCH MONITORED AT IMPROPER LEVEL; 10646000
ERROR(405); GO TO EXIT; 10647000
END; 10648000
PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000
); 10650000
PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000
ELBATWORD); GO CHKCOMMA; 10652000
END; 10653000
IF RANGE(BOOPROCID,INTPROCID) 10654000
THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000
E ;% 10656000
IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010
BEGIN 10656011
%%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012
%%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013
PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014
PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015
END ; 10656016
PUTNBUMP(NOPAR ~ TAKEFRST & 10656030
FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR 10657000
~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000
LINK+ELBATWORD.INCR); 10659000
DO PUTNBUMP(TAKE(INC~INC+1)) 10660000
UNTIL INC } TESTVARB; 10661000
GO CHKCOMMA; 10662000
END; 10663000
ERROR(406); GO TO EXIT; 10664000
COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000
CHKCOMMA:IF STEPI = COMMA 10666000
THEN GO MARKMONITORED; 10667000
IF CHECK(RTPAREN,407) 10668000
THEN GO TO EXIT; 10669000
COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000
DECLARATION; 10671000
IF STEPI = SEMICOLON 10672000
THEN GO TO EXIT; 10673000
IF CHECK(COMMA,408) 10674000
THEN GO TO EXIT; 10675000
COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000
DELIMITER; 10677000
STEPIT; GO TO START; 10678000
EXIT:; 10679000
END MERRIMAC; 10680000
PROCEDURE DMUP; 10681000
BEGIN COMMENT 15 JULY 1963 10682000
THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000
ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000
ARRAYS. 10685000
THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000
THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000
OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000
THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000
A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000
HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000
BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000
COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000
WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000
THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000
FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000
THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000
INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000
ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000
OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000
. THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000
DUMP INDICATOR. IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000
IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000
FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000
SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000
LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000
POINTING AT THE FILE INDENTIFIER IN THE DUMP 10707000
DECLARATION; 10708000
LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000
ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000
IS REACHED; 10711000
DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000
ADDRESS OF THE MONITOR FILE; 10713000
LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000
CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000
STARTCALL IS REACHED, I MUST BE POINTING 10716000
AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000
DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000
DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000
DIMENSIONS OF AN ARRAY OR A 10720000
SUBSCRIPTED VARIABLE APPEARING IN A 10721000
DUMP LIST; 10722000
DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000
COUNTER SETTING AT WHICH CODE IS 10724000
GENERATED TO EXIT THE ROUTINE EMITTED10725000
BY DMUP; 10726000
DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000
LOCATION OF THE COUNTER 10728000
ASSOCIATED WITH THIS LABEL IF 10729000
SPACE HAS BEEN ASSIGNED FOR IT; 10730000
DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000
NODIM. IT IS THEN COUNTED DOWN TO 10732000
ZERO AS SUBSCRIPT CODE IS GENERATED;10733000
LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000
NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000
LABEL SUBSLOOP; COMMENT THE CODE AT SUBSLOOP PASSES 10736000
SUBSCRIPTS TO PRINTI; 10737000
ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000
HOLDS THE ADDRESSES OF ALL LABEL 10739000
COUNTERS FOR LABELS APPEARING IN 10740000
THIS DUMP DECLARATION. IT IS 10741000
NECESSARY TO RETAIN THIS 10742000
INFORMATION SO THAT CODE MAY BE 10743000
GENERATED AT THE END OF THE 10744000
DECLARATION TO INITIALIZE THE 10745000
COUNTERS; 10746000
DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000
VARIABLE USED TO INDEX INTO THE10748000
LABELCTR ARRAY; 10749000
DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000
CONCATENATE DEFINE FOR INSERTING10751000
THE COUNTER ASSOCIATED WITH THIS10752000
LABEL INTO THE FIRST ADDITIONAL 10753000
WORD OF INFO; 10754000
DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000
BOUND FOR MONITORED SUBSCRIPTED 10756000
VARIABLES; 10757000
DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000
FORMAT TYPE REFERRED TO IN THE 10759000
COMMENTS FOR THE MERRIMAC 10760000
ROUTINE DESCRIBING PRINTI; 10761000
DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000
USED TO HOLD L WHILE THE DUMP 10763000
INDICATOR TEST CODE IS BEING 10764000
GENERATED; 10765000
DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000
LOCATION OF THE CODE THAT MUST BE 10767000
GENERATED TO MAKE THE TEST TO 10768000
DETERMINE WHETHER OR NOT DUMPING 10769000
SHOULD OCCUR; 10770000
DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000
CONCATENATE DEFINE USED TO 10772000
INSERT THE ADDRESS OF THE 10773000
PROGRAM DESCRIPTOR FOR THE CODE 10774000
GENERATED FROM THE DUMP 10775000
DECLARATION; 10776000
DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000
ADDRESS OF THE PROGRAM DESCRIPTOR 10778000
THAT DESCRIBES THE CODE GENERATED 10779000
BY DMUP; 10780000
DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000
ELBAT WORD FOR THE DUMP LIST 10782000
ELEMENT CURRENTLY BEING OPERATED 10783000
ON; 10784000
LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000
ON PRINTI. IT GENERATES THE CODE TO 10786000
PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000
FILE, AND FORMAT TYPE; 10788000
DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000
DIMENSION NUMBER THAT IS CURRENTLY 10790000
BEING WORKED ON; 10791000
START:IF CHECK(FILEID,409) 10792000
THEN GO TO EXIT; 10793000
COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000
CHECKER(ELBAT[I]); 10795000
FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000
IF CHECK(LEFTPAREN,410) 10797000
THEN GO TO EXIT; 10798000
COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000
JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000
(ADES,L,0); TESTLOC~L; L~L+3; 10801000
LABELCTRINX~-1; EMITO(NOP); BUMPL; 10802000
STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000
[I]); 10804000
IF RANGE(BOOARRAYID,INTARRAYID) 10805000
THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000
SUBSCRIPTED VARIABLES; 10807000
NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000
IF STEPI = LFTBRKET 10809000
THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000
VARIABLES; 10811000
STEPIT; AEXP; EMITO(DUP); 10812000
SUBSCTR~1; 10813000
IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000
).[35:13] ! 0 10815000
THEN BEGIN COMMENT SUBTRACT OFF THE 10816000
LOWER BOUND BEFORE INDEXING;10817000
IF LWRBND.[46:2] = 0 10818000
THEN EMIT(LWRBND) 10819000
ELSE EMITV(LWRBND.[35:11]); 10820000
EMIT(LWRBND.[23:12]); 10821000
END; 10822000
IF DIMCTR-SUBSCTR = 0 10823000
THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000
VALUE,N; 10825000
EMITV(ELBATWORD.ADDRESS); 10826000
PASSN:EMITL(NODIM); 10827000
IF CHECK(RTBRKET,411) 10828000
THEN GO TO EXIT; 10829000
COMMENT ERROR 411 MEANS 10830000
DUMP LIST ELEMENT HAS WRONG 10831000
NUMBER OF SUBSCRIPTS; 10832000
FORMATTYPE~2; GO CALLPRINTI10833000
END; 10834000
EMITN(ELBATWORD.ADDRESS); 10835000
SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000
EMITL(JUNK); EMITO(SND); 10837000
SUBSCTR~SUBSCTR+1; 10838000
IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000
).[35:13] ! 0 10840000
THEN BEGIN COMMENT SUBTRACT OFF THE 10841000
LOWER BOUND BEFORE INDEXING;10842000
IF LWRBND.[46:2] = 0 10843000
THEN EMIT(LWRBND) 10844000
ELSE EMITV(LWRBND.[35:11]); 10845000
EMIT(LWRBND.[23:12]); 10846000
END; 10847000
IF DIMCTR-SUBSCTR = 0 10848000
THEN BEGIN COMMENT EMIT COC; 10849000
EMITO(COC); EMITV(JUNK10850000
); EMITO(XCH); 10851000
GO PASSN; 10852000
END; 10853000
EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000
IF CHECK(COMMA,412) 10855000
THEN GO TO EXIT 10856000
ELSE GO TO SUBSLOOP; 10857000
COMMENT ERROR 412 MEANS DUMP LIST 10858000
ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000
; 10860000
END; 10861000
COMMENT THIS CODE HANDLES ARRAYS; 10862000
IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000
THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000
ARRAY DUMP LIST ELEMENT; 10865000
ERR(413); GO TO EXIT; 10866000
END; 10867000
EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000
FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000
END; 10870000
FORMATTYPE~1; 10871000
IF RANGE(BOOID,INTID) 10872000
THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000
EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000
END; 10875000
IF CHECK(LABELID,414) 10876000
THEN GO TO EXIT; 10877000
COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000
CODE HANDLES LABELS; 10879000
PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10880000
IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000
THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000
ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000
EMITV(LABELCTR[ 10884000
LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000
,ELBATWORD); 10886000
EMITL(3); IF FALSE THEN 10887000
CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000
POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000
EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000
FILEIDENT); EMITL(FORMATTYPE); EMITV(GNAT(PRINTI));10891000
IF STEPI = COMMA 10892000
THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000
IF LABELCTRINX = 100 10894000
THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000
ABOUT TO OVERFLOW WITH LABEL 10896000
INFORMATION; 10897000
ERR(415); GO TO EXIT; 10898000
END; 10899000
GO STARTCALL; 10900000
END; 10901000
IF CHECK(RTPAREN,416) 10902000
THEN GO TO EXIT; 10903000
COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000
DELIMITER; 10905000
LEXIT~L; EMITL(0); EMITO(RTS); 10906000
JUMPCHKX; STEPIT; 10907000
IF CHECK(LABELID,417) 10908000
THEN GO TO EXIT; 10909000
COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000
PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000
ELBATWORD); 10912000
IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100
PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000
IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000
THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000
ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000
EMITL(0); 10917000
DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000
EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000
END 10920000
UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000
L~L-1; EMITO(STD); STEPIT; 10922000
IF CHECK(COLON,418) 10923000
THEN GO TO EXIT; 10924000
COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000
FINALL~L; L~TESTLOC; STEPIT; 10926000
IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500
AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510
! COMMA AND GT1 ! SEMICOLON) 10926520
THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530
UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540
FLAG(465); GO TO EXIT; 10926550
END; 10926560
PRIMARY; EMITV(DUMPETEMP); 10927000
EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000
L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000
DUMPR],GIT(ELBAT[I-3])); 10930000
IF ELCLASS = COMMA 10931000
THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000
STEPIT; GO TO START; 10933000
END; 10934000
IF CHECK(SEMICOLON,419) 10935000
THEN; 10936000
COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000
EXIT:; 10938000
END DMUP; 10939000
COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000
AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000
OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000
SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000
OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000
IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000
A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000
SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION. FOR 10947000
SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000
SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000
THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000
JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000
TO STUFF F INTO A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000
SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000
BOOLEAN PROCEDURE SWITCHGEN(BEFORE); VALUE BEFORE; BOOLEAN BEFORE; 10954000
BEGIN 10955000
LABEL LX,EXIT,BEF; 10956000
REAL K,N,T1,TL; 10957000
TL ~ L; 10958000
EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000
L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000
EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000
AND PREPARATION FOR SWITCH-JUMP; 10962000
GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000
IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000
LX: IF STEPI = LABELID AND LOCAL(ELBAT[I]) %M10965000
THEN BEGIN 10966000
INFO[0,N] ~ ELBAT[I]; 10967000
IF N ~ N+1 = 256 10968000
THEN BEGIN ERR(147); GO TO EXIT END; 10969000
IF STEPI = COMMA THEN GO TO LX; 10970000
EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000
FOR K ~ 0 STEP 1 UNTIL N 10972000
DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000
EMIT((GT1~INFO[0,K]).[35:1]); 10974000
EMIT(GT1) END; 10975000
SWITCHGEN ~ FALSE END 10976000
ELSE BEGIN 10977000
BEF: NOGO; L ~ BUMPL; N ~ N-1; %M10978000
FOR K ~ 0 STEP 1 UNTIL N 10979000
DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000
ADJUST; T1 ~ L; 10981000
EMITL(GNAT(GT1~INFO[0,K])); 10982000
GENGO(GT1); 10983000
INFO[0,K] ~ T1; 10984000
EMITO(RTS); 10985000
CONSTANTCLEAN END; 10986000
I ~ I-1; N ~ N+1; 10987000
DO BEGIN ADJUST; 10988000
STEPIT; INFO[0,N] ~ L; 10989000
IF N ~ N+1 = 256 10990000
THEN BEGIN ERR(147); GO TO EXIT END; 10991000
DEXP; EMITO(RTS) END 10992000
UNTIL ELCLASS ! COMMA; ADJUST; 10993000
EMITB(BFW,TL+12,L); EMITO(BFC); 10994000
EMIT(0); EMITO(RTS); N ~ N-1; 10995000
FOR K ~ 0 STEP 1 UNTIL N 10996000
DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000
SWITCHGEN ~ TRUE END; 10998000
T1 ~ L; 10999000
L ~ TL+4; %M10999100
EMITL(N+1); %M10999200
L ~ T1; %M10999300
EXIT: END SWITCHGEN; %M10999400
PROCEDURE BOOINT; %A11000000
BEGIN REAL T; LABEL EXIT; %A11000100
CASE ELBAT[I].INCR OF BEGIN %A11000200
BEGIN IF T ~ TABLE(I+1)=RECID OR T=RECARRAYID %A11000300
OR T=RECPROCID THEN BEGIN STEPIT; REXP; RECTYPE~0 END ELSE %A11000400
EMITI(0,33-PORV|15,15); EMIT(0); EMITO(EQL); END; %A11000500
BEGIN EMITO(MKS);PANSYM(FALSE,TRUE); EMITV(MEMBER ) END; %A11000600
BEGIN GETCONTENTS(PORV,FALSE); EMITI(0,1,2); EMITL(3); %A11000700
EMITO(EQL); END; %A11000800
BEGIN GETCONTENTS(PORV,FALSE); EMIT(0); %A11000900
EMITO(LSS) END; %A11001000
BEGIN QUOTETOG ~ TRUE; %A11001100
IF STEPI = LEFTPAREN THEN BEGIN STEPIT; STRINGSEC(4); %A11001200
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104) END; %A11001300
EMITO(MKS); EMITV(ATCON) END; %A11001400
BEGIN GETCONTENTS(PORV,FALSE); EMITI(0,1,2); EMITL(2); EMITO(EQL); %A11001500
END; END; %A11001600
EXIT: QUOTETOG ~ FALSE END OF BOOINT; %A11001700
% %A11001800
% %A11001900
COMMENT RELATIONAL EXPRESSIONS; %A11002000
% %A11002100
BOOLEAN PROCEDURE SYMRELATION(TYPE); VALUE TYPE; REAL TYPE; %A11002200
BEGIN REAL R; LABEL EXIT; %A11002300
IF ELCLASS=LRELOP THEN BEGIN QUOTETOG ~ TRUE; %A11002400
TYPE ~ SNORM(TYPE); R ~ ELBAT[I].INCR; %A11002500
STEPIT; GT1 ~ SNORM(SEXP); %A11002600
EMITDIAL(DIA,33-15|GT1); EMITDIAL(DIB,33-15|TYPE); %A11002700
EMITFC(FCE,15); EMITO(XCH); EMITO(DEL); %A11002800
IF BOOLEAN(R) THEN EMITO(LNG); %A11002900
QUOTETOG ~ FALSE; GO TO EXIT END ELSE %A11003000
IF ELCLASS ! RELOP OR %A11003100
(R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69) THEN BEGIN SDNORM(TYPE);%A11003200
SYMRELATION ~ TRUE; %A11003300
QUOTETOG ~ FALSE; GO EXIT END; QUOTETOG ~ TRUE; %A11003400
% %A11003500
IF TYPE {2 THEN SDNORM(TYPE) ELSE %A11003600
IF TYPE =5 THEN BEGIN EMITNUM(SAVEQ); TYPE ~0 END ELSE %A11003700
IF TYPE= 4 THEN BEGIN EMITNUM(SAVEQ); TYPE ~3 END; %A11003800
STEPIT; GT1 ~ SEXP; QUOTETOG ~ FALSE; %A11003900
IF GT1 { 2 THEN SDNORM(GT1) ELSE %A11004000
IF GT1}4 THEN BEGIN EMITNUM(SAVEQ); %A11004100
GT1 ~ IF GT1 = 5 THEN 0 ELSE 3 END; %A11004200
IF TYPE+GT1 = 6 THEN EMITO(R) ELSE BEGIN %A11004300
IF TYPE = 3 OR GT1 = 3 THEN BEGIN %A11004400
IF TYPE = 3 THEN EMITO(XCH); EMITO(MKS); %A11004500
EMITV(SYMEQA) END ELSE %A11004600
BEGIN EMITO(MKS); EMITV(SYMEQ); END; EMITO(DEL) END ; %A11004700
IF R = 69 THEN EMITO(LNG); %A11004800
EXIT: END OF SYMRELATION; %A11004900
BOOLEAN PROCEDURE DBLPLXRELATION; %A11005000
BEGIN LABEL EXIT; REAL R , TYPE; DBLPLXRELATION~TRUE; %A11005100
IF ELCLASS ! RELOP THEN GO EXIT; %A11005200
IF R ~ ELBAT[I].ADDRESS ! 581 AND R! 69 THEN GO EXIT; %A11005300
DPTOG ~ TRUE; STEPIT; PLXNORM(PLXP(TRUE),TRUE);%A11005400
FOR TYPE ~ 0 STEP 1 UNTIL 2 DO BEGIN %A11005500
DBLNORM; DBLSTO(TRUE,1+2|TYPE,STD)END; DBLNORM; %A11005600
TYPE ~ IF R=581 THEN LND ELSE LOR; DPTOG ~ FALSE; %A11005700
EMITV(TEMP(3)); EMITO(R); EMITO(XCH); EMITV(TEMP(4)); %A11005800
EMITO(R); EMITO(TYPE); EMITV(TEMP(5)); EMITV(TEMP(1)); %A11005900
EMITO(R); EMITO(TYPE); EMITV(TEMP(6)); EMITV(TEMP(2)); %A11006000
EMITO(TYPE); DBLPLXRELATION ~ FALSE; %A11006100
EXIT: END OF DBLPLXRELATION; %A11006200
% %A11006300
BOOLEAN PROCEDURE PLXRELATION; %A11006400
BEGIN REAL R; LABEL EXIT; PLXRELATION ~ TRUE; %A11006500
IF ELCLASS! RELOP THEN GO EXIT; %A11006600
IF R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69 THEN GO EXIT; %A11006700
STEPIT; PLXNORM(PLXP(FALSE),FALSE); %A11006800
EMITPAIR(TEMP1,STD); EMITO(XCH); EMITPAIR(TEMP2,STD); %A11006900
EMITO(R); EMITV(TEMP1); EMITV(TEMP2); EMITO(R); %A11007000
EMITO(IF R=581 THEN LND ELSE LOR); PLXRELATION~FALSE; %A11007100
EXIT: END OF PLXRELATION; %A11007200
% %A11007300
BOOLEAN PROCEDURE DBLRELATION; %A11007400
BEGIN REAL R; LABEL EXIT; DBLRELATION ~ TRUE; %A11007500
IF ELCLASS ! RELOP THEN GO EXIT; %A11007600
R ~ ELBAT[I].ADDRESS; %A11007700
DBLNORM; %A11007800
DPTOG ~ TRUE; STEPIT; DBLXP; DPTOG ~ FALSE; DBLNORM; %A11007900
EMITPAIR(TEMP1,STD); EMITO(XCH); EMITPAIR(TEMP2,STD); EMITO(R); %A11008000
EMITV(TEMP2); EMITV(TEMP1); %A11008100
IF R = 581 THEN BEGIN EMITO(581); EMITO(LND); END ELSE %A11008200
IF R = 69 THEN BEGIN EMITO(69); EMITO(LOR); END ELSE %A11008300
BEGIN EMITO(581); EMITO(LND); EMITV(TEMP2); EMITV(TEMP1); %A11008400
EMITO(R); EMITO(LOR) END; DPTOG ~ FALSE; %A11008500
DBLRELATION ~ FALSE; %A11008600
EXIT: END OF DBLRELATION; %A11008700
% %A11008800
BOOLEAN PROCEDURE RECRELATION(TYPE); VALUE TYPE; REAL TYPE; %A11008900
BEGIN REAL R; LABEL EXIT; %A11009000
RECRELATION ~ TRUE; %A11009100
IF ELCLASS ! RELOP THEN GO TO EXIT; %A11009200
IF R ~ ELBAT[I].ADDRESS ! 581 AND R ! 69 THEN GO EXIT; %A11009300
STEPIT; RECOM(TYPE); EMITO(R); RECRELATION ~ FALSE; %A11009400
EXIT: END OF RECRELATION; %A11009500
% %A11009600
% %A11009700
% %A11009800
BOOLEAN PROCEDURE ARAY(TALL,WDS,ROWTOG); %A11009900
VALUE TALL,WDS,ROWTOG; %A11010000
REAL TALL,WDS; BOOLEAN ROWTOG; %A11010100
BEGIN LABEL LX,NEXT; %A11010200
REAL X,Z; %A11010300
INTEGER J,DM; %A11010400
BOOLEAN DPO,SM; %A11010500
BOOLEAN QO; QO ~ QUOTETOG; QUOTETOG ~ FALSE; %A11010600
DPO ~ DPTOG; IF SM~SMT THEN EMITO(MKS); %A11010700
DPTOG ~ SMT ~ FALSE; %A11010800
IF STEPI! LFTBRKET THEN BEGIN ERR(207); GO TO LX END; %A11010900
DM ~ TAKE(GIT(TALL)).[40:8]; J ~ 0; %A11011000
NEXT: IF ARAY ~ STEPI= FACTOP THEN BEGIN %A11011100
STLB ~ 1; %A11011200
WHILE TABLE(I+1) = COMMA DO %A11011300
BEGIN STEPIT; %A11011400
IF STEPI = FACTOP THEN STLB ~ STLB + 1 ELSE %A11011500
BEGIN ERR(204); GO TO LX END; END; %A11011600
IF J+STLB!DM THEN BEGIN ERR(203); GO TO LX END; %A11011700
IF STEPI!RTBRKET THEN BEGIN ERR(204); GO TO LX END; %A11011800
IF NOT ROWTOG.[45:1] THEN %A11011900
IF STLB > 1 THEN FLAG(212) ELSE %A11012000
IF NOT ROWTOG THEN BEGIN ERR(205); GO LX END; %A11012100
IF J=0 THEN EMITPAIR(TALL.ADDRESS,LOD); %A11012200
IF ROWTOG.[45:1] THEN BEGIN %A11012300
IF ROWTOG.[46:1] THEN BEGIN EMITNUM(TAKE(GIT(TALL)+DM+1).[35:13]) %A11012400
END; %A11012500
FOR X ~ 1 STEP 1 UNTIL STLB DO %A11012600
BEGIN IF (Z ~ TAKE(GIT(TALL)+J+X)).[35:11] > 1023 %A11012700
THEN EMITV(Z) ELSE EMIT(Z); %A11012800
IF Z.[23:10] = ADD THEN EMITO(CHS); END END; %A11012900
STEPIT; %A11013000
GO TO LX END; %A11013100
AEXP; IF SM THEN EMITPAIR(JUNK,SND); %A11013200
IF ELCLASS = RTBRKET THEN %A11013300
IF WDS!0 THEN BEGIN EMITL(WDS); EMITO(MUL) END; %A11013400
IF (GT1 ~ TAKE(GIT(TALL)+ J~J+1)).[35:13] ! 0 THEN BEGIN %A11013500
IF GT1.[46:2] =0 THEN EMIT(GT1) ELSE EMITV(GT1.[35:11]); %A11013600
EMIT(GT1.[23:12]) END; %A11013700
IF ELCLASS=COMMA THEN BEGIN %A11013800
IF J=1 THEN EMITN(TALL.ADDRESS) ELSE EMITO(CDC); %A11013900
EMITO(LOD); %A11014000
IF SM THEN BEGIN EMITV(JUNK); EMITO(XCH); END; %A11014100
IF J+1> DM THEN BEGIN ERR(206); GO TO LX END; %A11014200
GO TO NEXT END; %A11014300
IF ELCLASS!RTBRKET THEN BEGIN ERR(206); GO TO LX END; %A11014400
IF J!DM THEN ERR(208); %A11014500
ROWTOG ~ (STEPI=ASSIGNOP) OR ROWTOG OR %A11014600
((ELCLASS = COMMA OR ELCLASS = RTPAREN) AND ROWTOG.[45:1]); %A11014700
IF ROWTOG THEN BEGIN IF J =1 THEN %A11014800
EMITN(TALL.ADDRESS) ELSE EMITO(CDC); %A11014900
IF SM THEN BEGIN EMITV(JUNK); EMITO(XCH); END; END ELSE %A11015000
IF WDS ! 0 THEN BEGIN %A11015100
IF J = 1 THEN BEGIN EMITPAIR(TMP,SND); %A11015200
EMITV(J ~ TALL.ADDRESS); WDS ~ WDS - 1; %A11015300
FOR GT1 ~ 1 STEP 1 UNTIL WDS DO BEGIN %A11015400
EMITV(TMP); EMITL(GT1); EMITO(ADD); EMITV(J) END END ELSE %A11015500
BEGIN %A11015600
WDS ~ WDS -2; %A11015700
EMITPAIR(TMP,STD); EMITO(DUP); EMITV(TMP); %A11015800
EMITO(COC); EMITO(XCH); %A11015900
FOR GT1 ~ 1 STEP 1 UNTIL WDS DO BEGIN %A11016000
EMITO(DUP); EMITV(TMP); EMITL(GT1); EMITO(ADD); %A11016100
EMITO(COC); EMITO(XCH); END; %A11016200
EMITV(TMP); EMITL(WDS+1); EMITO(ADD); EMITO(COC) END %A11016300
END %A11016400
ELSE IF J = 1 THEN EMITV(TALL.ADDRESS) ELSE EMITO(COC); %A11016500
IF ROWTOG.[46:1] THEN BEGIN %A11016600
IF GT1 ~ TAKE(GIT(TALL) + DM + 1).[35:13] > 8 THEN EMITO(LOD); %A11016700
EMITNUM(GT1) END; %A11016800
LX: QUOTETOG ~ QO; DPTOG ~ DPO; %A11016900
END OF ARAY; %A11017000
% %A11017100
PROCEDURE GENEXP(R); VALUE R; REAL R; %A11017200
BEGIN %B11017300
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11017400
IF R > 29 THEN BEGIN STEPIT; RECOM(R) END ELSE %A11017500
CASE R-1 OF BEGIN %A11017600
BEGIN STEPIT; BEXP END; %A11017700
BEGIN STEPIT; DEXP END; %A11017800
BEGIN STEPIT; AEXP END; %A11017900
; BEGIN QUOTETOG ~ TRUE; STEPIT; SEXPN; QUOTETOG~FALSE END; %A11018000
DBLPLXP(0); %A11018100
DBLPLXP(1); %A11018200
DBLPLXP(2); END; %A11018300
END; %B11018400
% %A11018500
PROCEDURE IFXP(R); VALUE R; REAL R; %A11018600
BEGIN INTEGER B,S; %A11018700
QUOTETOG ~ DPTOG ~ FALSE; %A11018800
STEPIT; STACKCT ~ 0; BEXP; %A11018900
IF ELCLASS ! THENV THEN ERR(116); %A11019000
STACKCT ~ 0; B ~ BUMPL; GENEXP(R); STACKCT ~ 0; %A11019100
S ~ BUMPL; EMITB(BFC,B,L); %A11019200
IF ELCLASS ! ELSEV THEN ERR(155) ELSE %A11019300
BEGIN GENEXP(R); STACKCT ~1; EMITB(BFW,S,L); %A11019400
EMIT(1); L ~ L - 1 END %A11019500
END IFXP; %A11019600
% %A11019700
PROCEDURE EMITCONVAL; %A11019800
BEGIN LABEL EXIT,L; INTEGER T; %A11019900
IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11020000
BEGIN %A11020100
IF STEPI ! LITNO THEN BEGIN %A11020200
L: ERR(609); GO EXIT END; %A11020300
IF T ~ ELBAT[I].ADDRESS } 40 THEN GO L; %A11020400
STEPIT; %A11020500
IF T > 1 AND T < 36 THEN EMITV(T+104) ELSE %A11020600
IF T = 37 THEN BEGIN EMITV(COLSET); %A11020700
IF ELCLASS = COMMA THEN BEGIN STEPIT; AEXP; %A11020800
EMITPAIR(COLSET,STD) END END ELSE %A11020900
IF T = 0 THEN BEGIN %A11021000
IF ELCLASS = COMMA THEN BEGIN %A11021100
STEPIT; AEXP; EMITPAIR(RND,STD) END; %A11021200
EMITO(MKS); EMITV(RANDNO); END ELSE %A11021300
IF T = 1 THEN EMITV(RND) ELSE %A11021400
IF T = 36 THEN EMITV(TABLEMARK) ELSE %A11021500
ERR(686);% %A11021600
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11022200
END; %A11022300
EXIT: %A11022400
END OF EMITCONVAL; %A11022500
% %A11022600
% %A11022700
% %A11022800
COMMENT DOUBLE EXPRESSIONS; %A11022900
BOOLEAN PROCEDURE DIVOP(OP); VALUE OP; REAL OP; %A11023000
DIVOP ~ OP.[40:8]=128; %A11023100
% %A11023200
PROCEDURE DBLXCH(BV,J); %A11023300
VALUE BV,J; %A11023400
BOOLEAN BV; INTEGER J; %A11023500
IF BV THEN BEGIN %A11023600
EMITPAIR(TEMP(J),STD); EMITO(XCH); EMITPAIR(TEMP(J+1),STD); %A11023700
EMITO(XCH); EMITV(TEMP(J)); EMITO(XCH); %A11023800
EMITV(TEMP(J+1)); END %A11023900
ELSE EMITO(XCH); %A11024000
% %A11024100
PROCEDURE DBLSTO(BV,J,OPER); %A11024200
VALUE BV,J,OPER; %A11024300
BOOLEAN BV; INTEGER J,OPER; %A11024400
IF BV THEN BEGIN %A11024500
EMITPAIR(TEMP(J),OPER); IF OPER=SND THEN EMITO(XCH); %A11024600
EMITPAIR(TEMP(J+1),OPER); IF OPER=SND THEN EMITO(XCH) %A11024700
END %A11024800
ELSE EMITPAIR(TEMP(J),OPER); %A11024900
% %A11025000
PROCEDURE DBLEMITV(BV,J); %A11025100
VALUE BV,J; %A11025200
BOOLEAN BV; INTEGER J; %A11025300
BEGIN IF BV THEN %A11025400
EMITV(TEMP(J+1)); %A11025500
EMITV(TEMP(J)) END; %A11025600
% %A11025700
PROCEDURE DBLDUP; %A11025800
IF DPTOG THEN %A11025900
BEGIN %A11026000
EMITPAIR(JUNK,STD); EMITO(DUP); %A11026100
EMITV(JUNK); EMITO(XCH); EMITV(JUNK) %A11026200
END %A11026300
ELSE EMITO(DUP); %A11026400
% %A11026500
PROCEDURE EMITDV(OP,BV); VALUE OP,BV; REAL OP; BOOLEAN BV; %A11026600
BEGIN %B11026700
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11026800
IF OP ~ OP.[38:2]=0 THEN EMITO(128+REAL(BV)) ELSE %A11026900
IF OP = 1 THEN IF BV THEN BEGIN %A11027000
DBLTSNGL(5); EMITO(384); EMIT(0); EMITO(XCH) END ELSE %A11027100
EMITO(384) ELSE %A11027200
IF BV THEN BEGIN DBLSTO(TRUE,5,STD); %A11027300
DBLSTO(TRUE,7,STD); EMITO(MKS); %A11027400
DBLEMITV(TRUE,7); DBLEMITV(TRUE,5); EMITV(GNATP(14)) %A11027500
; EMITV(JUNK); %A11027600
END ELSE EMITO(896); %A11027700
END; %B11027800
% %A11027900
PROCEDURE DBLPLXVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11028000
BEGIN REAL TALL,STR,ADR,TYPE,ADS; %A11028100
REAL R; %A11028200
BOOLEAN ARTOG,V; LABEL EXIT,L; %A11028300
ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); %A11028400
TYPE ~ TAKE(TALL.LINK+1).[2:2]; %A11028500
IF ELCLASS=DBLPLXPROCID THEN BEGIN STEPIT; %A11028600
DBLPLXP(TYPE); EMITPAIR(514,STD); %A11028700
ADS ~ TAKE(TALL.LINK+ TALL.INCR).[30:10]; %A11028800
IF TYPE!2 THEN TYPE~0; %A11028900
FOR ADR ~ 1 STEP 1 UNTIL TYPE DO BEGIN %A11029000
EMITPAIR(ADS,STD); ADS~ADS+1 END; %A11029100
IF FROM THEN EMITPAIR(ADS,STD) ELSE %A11029200
BEGIN EMITPAIR(ADS,SND); %A11029300
FOR ADR~1 STEP 1 UNTIL TYPE DO EMITV(ADS~ADS-1); %A11029400
EMITV(514) END END ELSE %A11029500
BEGIN V ~ TALL.[9:2]=2; %A11029600
ADR ~ ADR & TALL[1:9:1]; %A11029700
IF ARTOG ~ ELCLASS = DBLPLXARRAYID THEN BEGIN %A11029800
IF ARAY(TALL,IF TYPE=2 THEN 4 ELSE 2,FALSE) THEN %A11029900
BEGIN ERR(610); GO EXIT END END ELSE %A11030000
BEGIN IF V THEN EMITN(ADR); STEPIT END; %A11030100
IF ELCLASS=ASSIGNOP THEN BEGIN L: DPTOG ~ TYPE ! 1; STEPIT; %A11030200
IF ARTOG OR V THEN BEGIN EMITO(DUP); EMITL(1); %A11030300
EMITO(XCH); EMITO(INX); %A11030400
IF TYPE = 2 THEN BEGIN EMITO(DUP); EMITL(1); EMITO(XCH); %A11030500
EMITO(INX); EMITO(DUP); EMITL(1); EMITO(XCH); EMITO(INX); %A11030600
END END; %A11030700
IF TYPE=0 THEN BEGIN R ~ 12; DBLXP; END ELSE R ~ PLXP(TYPE=2); %A11030800
DPTOG ~ FALSE; %A11030900
IF ARTOG OR V THEN BEGIN %A11031000
PLXNORM(R,TYPE=2); %A11031100
IF TYPE = 2 THEN BEGIN EMITPAIR(JUNK,STD); EMITPAIR(NSTR,STD); %A11031200
EMITPAIR(39,STD); EMITPAIR(40,STD); EMITV(JUNK); %A11031300
EMITO(XCH); EMITO(STD); EMITV(NSTR); EMITO(XCH); %A11031400
EMITO(STD); EMITV(39); EMITO(XCH); EMITO(STD); %A11031500
EMITV(40); EMITO(XCH); %A11031600
IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); %A11031700
EMITV(39); EMITV(NSTR); EMITV(JUNK); END END ELSE %A11031800
BEGIN EMITO(XCH); EMITPAIR(JUNK,STD); EMITO(XCH); %A11031900
IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); EMITO(XCH); %A11032000
END; EMITV(JUNK); EMITO(XCH); %A11032100
IF FROM THEN EMITO(STD) ELSE BEGIN EMITO(SND); %A11032200
EMITO(XCH); END END END ELSE %A11032300
BEGIN V~ TYPE=2; TYPE ~ IF FROM THEN STD ELSE SND; %A11032400
IF R<4 THEN BEGIN IF R}2 THEN EMITO(CHS); %A11032500
IF BOOLEAN(R) THEN BEGIN EMITPAIR(ADR+REAL(V),TYPE); %A11032600
IF V THEN BEGIN IF NOT FROM THEN EMITO(XCH); %A11032700
EMITPAIR(ADR,TYPE); IF NOT FROM THEN EMITO(XCH); END; %A11032800
EMIT(0); %A11032900
IF V THEN BEGIN EMITPAIR(ADR+3,SND); EMITPAIR(ADR+2,TYPE); %A11033000
IF NOT FROM THEN EMITO(DUP) END ELSE %A11033100
EMITPAIR(ADR+1,TYPE); END ELSE %A11033200
BEGIN IF V THEN EMITPAIR(ADR+3,STD); %A11033300
EMITPAIR(ADR+1+REAL(V),STD); EMIT(0); %A11033400
IF V THEN EMITPAIR(ADR+1,SND); EMITPAIR(ADR,TYPE); %A11033500
IF NOT FROM THEN BEGIN IF V THEN EMIT(0); %A11033600
EMITV(ADR+1+REAL(V)); %A11033700
IF V THEN EMITV(ADR+3) END END END ELSE %A11033800
BEGIN IF BOOLEAN(R.[41:1]) THEN EMITO(CHS); %A11033900
ADS~ IF BOOLEAN(R.[42:1]) THEN 0 ELSE 1; %A11034000
IF V THEN BEGIN EMITPAIR(ADR+1+2|ADS,STD); %A11034100
EMITPAIR(2|ADS+ADR,STD) END ELSE %A11034200
BEGIN EMITPAIR(ADR+ADS,TYPE); IF NOT FROM THEN EMITO(XCH) %A11034300
END; IF BOOLEAN(R.[43:1]) THEN EMITO(CHS); ADS ~ 1-ADS; %A11034400
IF V THEN BEGIN %A11034500
IF FROM OR BOOLEAN(ADS) THEN BEGIN %A11034600
EMITPAIR(ADR+1+2|ADS,STD); EMITPAIR(ADR+2|ADS,STD); %A11034700
IF NOT FROM THEN BEGIN EMITV(ADR); EMITV(ADR+1) END %A11034800
END ELSE BEGIN EMITPAIR(ADR+1,SND); EMITO(XCH); %A11034900
EMITPAIR(ADR,SND); EMITO(XCH) END; %A11035000
IF NOT FROM THEN BEGIN EMITV(ADR+2); EMITV(ADR+3) END %A11035100
END ELSE %A11035200
BEGIN EMITPAIR(ADR+ADS,TYPE); %A11035300
IF NOT FROM THEN %A11035400
IF NOT BOOLEAN(ADS) THEN EMITO(XCH) END %A11035500
END END END ELSE %A11035600
IF FROM THEN ERR(145) ELSE %A11035700
IF NOT ARTOG THEN BEGIN %A11035800
TYPE ~ IF TYPE =2 THEN 3 ELSE 1; %A11035900
IF V THEN BEGIN %A11036000
FOR TALL~ 1 STEP 1 UNTIL TYPE DO BEGIN EMITO(DUP); %A11036100
EMITL(1); EMITO(INX); EMITO(XCH); EMITO(LOD); %A11036200
EMITO(XCH); END; %A11036300
EMITO(LOD) END ELSE %A11036400
FOR TALL ~ 0 STEP 1 UNTIL TYPE DO EMITV(ADR+TALL); %A11036500
END END; %A11036600
EXIT: END DBLPLXVAR; %A11036700
% %A11036800
PROCEDURE DBLINT; %A11036900
BEGIN REAL T,R; LABEL EXIT; %A11037000
IF GT1 ~ (T ~ ELBAT[I]).[33:2] = 0 THEN BEGIN %A11037100
DPTOG ~ FALSE; %A11037200
EMIT(0); IMPFUN END ELSE %A11037300
CASE (T ~ TAKE(T.LINK+GT1)).[12:3] OF BEGIN %A11037400
BEGIN DPTOG ~ FALSE; EMIT(0); IMPFUN END; %A11037500
BEGIN PANDBL(TRUE); EMITV(GNATP(T.[9:3])); EMITV(JUNK) END; %A11037600
BEGIN T ~ L; EMITO(NOP); %A11037700
IF PANPLX(FALSE,TRUE) < 4 THEN EMITO(SSP) ELSE %A11037800
BEGIN R ~ L; L ~ T; EMITO(MKS); L ~ R; %A11037900
DBLSTO(TRUE,1,STD); DPTOG ~ TRUE; DBLDUP; EMITO(ML2); %A11038000
DBLEMITV(TRUE,1); DBLEMITV(TRUE,1); EMITO(ML2); %A11038100
EMITO(AD2); EMITV(DSQRT); EMITV(JUNK) END; %A11038200
END; %A11038300
IF R ~ PANPLX(FALSE,TRUE) < 4 THEN %A11038400
IF BOOLEAN(R) THEN BEGIN %A11038500
IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %A11038600
BEGIN EMITO(DEL); EMITO(DEL); EMIT(0); EMIT(0) END ELSE %A11038700
IF BOOLEAN(R.[42:1]) THEN BEGIN EMITPAIR(JUNK,STD); %A11038800
EMITO(XCH); EMITO(DEL); EMITO(XCH); EMITO(DEL); EMITV(JUNK); %A11038900
IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END %A11039000
ELSE BEGIN EMITO(DEL); EMITO(DEL); %A11039100
IF BOOLEAN(R.[43:1]) THEN EMITO(CHS) END; %A11039200
IF R ~ PANPLX(FALSE,TRUE) < 4 THEN %A11039300
IF BOOLEAN(R) THEN BEGIN EMITO(DEL); EMITO(DEL); %A11039400
EMIT(0); EMIT(0) END ELSE %A11039500
BEGIN IF BOOLEAN(R.[46:1]) THEN EMITO(CHS) END ELSE %A11039600
IF BOOLEAN(R.[42:1]) THEN BEGIN EMITO(DEL); EMITO(DEL); %A11039700
IF BOOLEAN(R.[43:1]) THEN EMITO(CHS); END ELSE %A11039800
BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITO(DEL); %A11039900
EMITO(XCH); EMITO(DEL); EMITV(JUNK); %A11040000
IF BOOLEAN(R.[41:1]) THEN EMITO(CHS) END; %A11040100
BEGIN PLXNORM(PANPLX(TRUE,TRUE),TRUE); EMITV(GNATP(7)); %A11040200
EMITV(17) END; %A11040300
BEGIN EMIT(0); EMITO(MKS); %A11040400
IF STEPI = LEFTPAREN THEN BEGIN STEPIT; %A11040410
IF Q ~ ACCUM[1] = "3TWX00" THEN EMITL(5) ELSE %A11040420
IF Q = "4TWXA0" THEN EMITL(10) ELSE FLAG(665); %A11040430
IF STEPI! RTPAREN THEN ERR(104) ELSE STEPIT END ELSE EMIT(0); %A11040440
EMITL(1); EMITV(READN); END; END; %A11040450
EXIT: END OF DBLINT; %A11040500
% %A11040600
PROCEDURE DBLPRIM; %A11040700
BEGIN LABEL EXIT; %A11040800
REAL T; %A11040900
IF ELCLASS= INTRNSICPROCID THEN DBLINT ELSE BEGIN %A11041000
IF ELCLASS}DBLPLXTRNS AND ELCLASS{DBLPLXARRAYID THEN %A11041100
IF (T ~ ELCLASS - STRTRNS).[45:3]= 1 THEN %A11041200
IF TAKE(ELBAT[I].LINK+1).[2:2]=0 THEN BEGIN %A11041300
CASE T DIV 8 OF BEGIN %A11041400
IF BOOLEAN(ELBAT[I].[34:1]) THEN BEGIN %A11041500
ELBAT[I].ADDRESS ~ INDBL; %A11041600
ELBAT[I].CLASS~ DBLPLXID; DBLPLXVAR(FALSE) END %A11041700
ELSE ERR(611); %A11041800
STRMPROCSTMT; %A11041900
PROCSTMT(FALSE); DBLPLXVAR(FALSE); DBLPLXVAR(FALSE); END; %A11042000
GO EXIT END; %A11042100
IF ELCLASS=LEFTPAREN THEN BEGIN I~I-1; PANDBL(FALSE) END ELSE %A11042200
IF ELCLASS=NONLITNO THEN BEGIN EMITNUM(NLO); EMITNUM(NHI); %A11042300
STEPIT END ELSE %A11042400
IF ACCUM[1] = "3TEN00" THEN BEGIN BANA; EMITPAIR(JUNK,ISN); %T9311042500
EMITO(DUP); %T9311042550
EMITL(69); EMITO(ADD); EMITV(GNAT(POWERSOFTEN)); EMITO(XCH);%A11042600
EMITV(105) END ELSE %A11042650
BEGIN EMIT(0); DPTOG ~ FALSE; PRIMARY END END; %A11042700
EXIT: END OF DBLPRIM; %A11042800
% %A11042900
PROCEDURE DBLEXP; %A11043000
BEGIN EMITO(MKS); DBLPRIM; EMITV(DBLFACT); END; %A11043100
% %A11043200
PROCEDURE DBLSEC; %A11043300
BEGIN %B11043400
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11043500
IF ELCLASS = ADOP THEN %A11043600
BEGIN %A11043700
STEPIT; %A11043800
IF ELBAT[I-1].ADDRESS ! ADD THEN %A11043900
BEGIN %A11044000
DBLPRIM; %A11044100
WHILE ELCLASS = FACTOP DO %A11044200
BEGIN DPTOG ~ TRUE; STEPIT; DBLEXP END; %A11044300
ENDTOG~LINKTOG; EMITO(CHS); %A11044400
LINKTOG~ENDTOG; ENDTOG~FALSE %A11044500
END %A11044600
ELSE DBLPRIM %A11044700
END %A11044800
ELSE DBLPRIM; %A11044900
END; %B11045000
% %A11045100
PROCEDURE DBLCOMP; %A11045200
BEGIN REAL OPCLASS, OPERATOR; %A11045300
DO BEGIN %A11045400
OPERATOR~ ELBAT[I].ADDRESS; %A11045500
OPCLASS ~ ELCLASS; %A11045600
DPTOG ~TRUE; %A11045700
STEPIT; %A11045800
IF OPCLASS = FACTOP %A11045900
THEN DBLEXP %A11046000
ELSE BEGIN %A11046100
DBLPRIM; %A11046200
DPTOG ~ TRUE; %A11046300
WHILE OPCLASS < ELCLASS DO DBLCOMP; %A11046400
IF DIVOP(OPERATOR) THEN %A11046500
EMITDV(OPERATOR,TRUE) ELSE EMITO(OPERATOR+1) %A11046600
END %A11046700
END UNTIL OPCLASS ! ELCLASS; %A11046800
END DBLCOMP; %A11046900
% %A11047000
PROCEDURE SIMPDBL; %A11047100
WHILE ELCLASS } ADOP DO DBLCOMP; %A11047200
% %A11047300
PROCEDURE DBLXP; %A11047400
BEGIN %A11047500
DPTOG~TRUE; %A11047600
IF ELCLASS = CASEV %A11047700
THEN CASESTMT(13) ELSE %A11047800
IF ELCLASS = IFV %A11047900
THEN IFXP(6) ELSE %A11048000
BEGIN DBLSEC; SIMPDBL END; %A11048100
% %A11048200
END DBLXP; %A11048300
% %A11048400
PROCEDURE PANDBL(V); VALUE V; BOOLEAN V; %A11048500
BEGIN %B11048600
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11048700
IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11048800
BEGIN IF V THEN EMITO(MKS); DPTOG ~ TRUE; %A11048900
STEPIT; DBLXP; %A11049000
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END; %A11049100
DPTOG ~ FALSE; %A11049200
END; %B11049300
COMMENT COMPLEX EXPRESSIONS; %A11049400
% %A11049500
INTEGER PROCEDURE PAIR(R1,R2); VALUE R1,R2; REAL R1,R2; %A11049600
PAIR~4 & R1[41:46:2] & R2[43:46:2]; %A11049700
% %A11049800
PROCEDURE PLXNORM(R,BV); %A11049900
VALUE R,BV; %A11050000
REAL R; %A11050100
BOOLEAN BV; %A11050200
BEGIN INTEGER T1,T2; %A11050300
IF R < 4 THEN %A11050400
BEGIN %A11050500
IF BOOLEAN(R.[46:1]) THEN EMITO(CHS); %A11050600
EMITL(0); %A11050700
IF BV THEN EMITL(0); %A11050800
IF BOOLEAN(R) THEN ELSE DBLXCH(BV,1); %A11050900
END ELSE %A11051000
BEGIN %A11051100
T1~R.TS; T2~R.NS; %A11051200
IF BOOLEAN(T1.[46:1]) THEN EMITO(CHS); %A11051300
IF BOOLEAN(T2.[46:1]) THEN %A11051400
BEGIN DBLXCH(BV,1); EMITO(CHS); %A11051500
IF BOOLEAN(T2) THEN DBLXCH(BV,1) END ELSE %A11051600
IF BOOLEAN(T1) THEN DBLXCH(BV,1) %A11051700
END %A11051800
END OF PLXNORM; %A11051900
% %A11052000
INTEGER PROCEDURE PLXOP(OP,R1,R2,BV); %A11052100
VALUE OP,R1,R2,BV; %A11052200
REAL OP,R1,R2; BOOLEAN BV; %A11052300
BEGIN %B11052400
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11052500
IF OP = MUL THEN BEGIN %A11052600
PLXOP~(R1+R2) MOD 4; %A11052700
EMITO(MUL + REAL(BV)) END ELSE %A11052800
IF DIVOP(OP) THEN BEGIN %A11052900
PLXOP~(4 + R1 - R2) MOD 4; %A11053000
EMITDV(OP,BV) END ELSE %A11053100
BEGIN PLXOP~R1; %A11053200
IF R1 = R2 THEN EMITO(OP + REAL(BV)) ELSE %A11053300
IF NOT BOOLEAN(R1 + R2) THEN %A11053400
EMITO(IF OP = ADD THEN (SUB + REAL(BV)) ELSE %A11053500
(ADD + REAL(BV))) ELSE %A11053600
PLXOP ~ PAIR(IF OP=ADD THEN R2 ELSE R2+2,R1) %A11053700
END; %A11053800
END; %B11053900
% %A11054000
INTEGER PROCEDURE PLXOP2(OPCLASS,R1,R2,BV); %A11054100
VALUE OPCLASS,R1,R2,BV; %A11054200
REAL OPCLASS,R1,R2; BOOLEAN BV; %A11054300
BEGIN %A11054400
REAL T1,T2,TS1,TS2,T; %A11054500
DEFINE OP= OPCLASS#, %A11054600
NS1 = T1#, %A11054700
NS2 = T2#; %A11054800
DPTOG ~ BV; %A11054900
IF R2 < 4 THEN %A11055000
IF R1 < 4 THEN %A11055100
PLXOP2~PLXOP(OP,R1,R2,BV) ELSE %A11055200
BEGIN %A11055300
T1~R1.TS; %A11055400
T2~R1.NS; %A11055500
IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11055600
IF BOOLEAN(T1+R2) THEN %A11055700
BEGIN %A11055800
DBLXCH(BV,1); %A11055900
DBLSTO(BV,1,STD); %A11056000
PLXOP2~PAIR(T1,PLXOP(OP,T2,R2,BV)); %A11056100
DBLEMITV(BV,1) %A11056200
END %A11056300
ELSE PLXOP2~PAIR(PLXOP(OP,T1,R2,BV),T2) %A11056400
ELSE BEGIN %A11056500
DBLSTO(BV,1,SND); %A11056600
R1 ~ PLXOP(OP,T1,R2,BV); %A11056700
DBLXCH(BV,3); %A11056800
DBLEMITV(BV,1); %A11056900
PLXOP2~PAIR(PLXOP(OP,T2,R2,BV),R1) %A11057000
END %A11057100
END %A11057200
ELSE %A11057300
IF R1 < 4 THEN %A11057400
BEGIN %A11057500
T1~R2.TS; %A11057600
T2~R2.NS; %A11057700
IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11057800
BEGIN %A11057900
IF BOOLEAN(T2+R1) THEN %A11058000
BEGIN %A11058100
DBLXCH(BV,1); %A11058200
T~T1; %A11058300
T1~T2; %A11058400
T2~T %A11058500
END; %A11058600
DBLSTO(BV,1,STD); %A11058700
IF OP = SUB THEN T1 ~ T1 + 2; %A11058800
PLXOP2~PAIR(T1,PLXOP(OP,R1,T2,BV)); %A11058900
DBLEMITV(BV,1) %A11059000
END %A11059100
ELSE BEGIN %A11059200
IF DIVOP(OP) THEN %A11059300
BEGIN %A11059400
T1~(4-T1) MOD 4; %A11059500
T2~(4-T2) MOD 4 %A11059600
END; %A11059700
DBLSTO(BV,1,STD); %A11059800
DBLSTO(BV,3,STD); %A11059900
DBLDUP; %A11060000
DBLEMITV(BV,3); %A11060100
R2~PLXOP(MUL,R1,T2,BV); %A11060200
DBLXCH(BV,5); %A11060300
DBLEMITV(BV,1); %A11060400
PLXOP2~PAIR(PLXOP(MUL,R1,T1,BV),R2); %A11060500
IF DIVOP(OP) THEN %A11060600
BEGIN %A11060700
DBLEMITV(BV,1); %A11060800
DBLDUP; %A11060900
EMITO(MUL + REAL(BV)); %A11061000
DBLEMITV(BV,3); %A11061100
IF BV THEN DBLEMITV(BV,3) ELSE EMITO(DUP); %A11061200
EMITO(MUL + REAL(BV)); %A11061300
EMITO(ADD + REAL(BV)); %A11061400
DBLSTO(BV,1,SND); %A11061500
EMITDV(OP,BV); %A11061600
DBLXCH(BV,5); %A11061700
DBLEMITV(BV,1); %A11061800
EMITDV(OP,BV); %A11061900
DBLXCH(BV,1) %A11062000
END %A11062100
END %A11062200
END %A11062300
ELSE BEGIN %A11062400
TS1~R1.TS; %A11062500
NS1~R1.NS; %A11062600
TS2~R2.TS; %A11062700
NS2~R2.NS; %A11062800
IF OPCLASS = ADD OR OPCLASS = SUB THEN %A11062900
BEGIN %A11063000
IF BOOLEAN(NS2 + TS1) THEN %A11063100
BEGIN %A11063200
DBLXCH(BV,1); %A11063300
T~TS2; %A11063400
TS2~NS2; %A11063500
NS2~T %A11063600
END; %A11063700
DBLSTO(BV,1,STD); %A11063800
R2~PLXOP(OP,TS1,NS2,BV); %A11063900
DBLXCH(BV,3); %A11064000
DBLEMITV(BV,1); %A11064100
PLXOP2~PAIR(PLXOP(OP,NS1,TS2,BV),R2) %A11064200
END %A11064300
ELSE BEGIN %A11064400
IF DIVOP(OP) THEN %A11064500
BEGIN %A11064600
TS2~(4-TS2) MOD 4; %A11064700
NS2~(4-NS2) MOD 4 %A11064800
END; %A11064900
DBLSTO(BV,1,STD); %A11065000
DBLSTO(BV,3,STD); %A11065100
DBLSTO(BV,5,STD); %A11065200
DBLDUP; %A11065300
DBLEMITV(BV,3); %A11065400
R2~PLXOP(MUL,NS1,NS2,BV); %A11065500
DBLEMITV(BV,5); %A11065600
DBLEMITV(BV,1); %A11065700
R1~PLXOP(MUL,TS1,TS2,BV); %A11065800
R1~PLXOP(ADD,R2,R1,BV); %A11065900
DBLXCH(BV,7); %A11066000
DBLEMITV(BV,1); %A11066100
R2~PLXOP(MUL,NS1,TS2,BV); %A11066200
DBLEMITV(BV,5); %A11066300
DBLEMITV(BV,3); %A11066400
R2~PLXOP(ADD,R2,PLXOP(MUL,TS1,NS2,BV),BV); %A11066500
IF OP = MUL THEN PLXOP2~PAIR(R2,R1) %A11066600
ELSE BEGIN %A11066700
DBLEMITV(BV,1); %A11066800
IF BV THEN DBLEMITV(BV,1) ELSE EMITO(DUP); %A11066900
EMITO(MUL + REAL(BV)); %A11067000
DBLEMITV(BV,3); %A11067100
IF BV THEN DBLEMITV(BV,3) ELSE EMITO(DUP); %A11067200
EMITO(MUL + REAL(BV)); %A11067300
EMITO(ADD + REAL(BV)); %A11067400
DBLSTO(BV,1,SND); %A11067500
EMITDV(OP,BV); %A11067600
DBLXCH(BV,3); %A11067700
DBLEMITV(BV,1); %A11067800
EMITDV(OP,BV); %A11067900
PLXOP2~PAIR(R1,R2) %A11068000
END %A11068100
END %A11068200
END; %A11068300
END OF PLXOP2; %A11068400
% %A11068500
REAL PROCEDURE PLXINT(BV); VALUE BV; BOOLEAN BV; %A11068600
BEGIN %A11068700
REAL K; LABEL EXIT; %A11068800
DPTOG ~ FALSE; %A11068900
IF K ~ ELBAT[I].[33:2]! 0 THEN BEGIN %A11069000
CASE (K ~ TAKE(ELBAT[I].LINK+K)).[18:3] OF BEGIN %A11069100
IF BV THEN DBLINT ELSE IMPFUN; %A11069200
BEGIN PLXNORM(PANPLX(TRUE,FALSE),FALSE); EMITV(GNATP(K.[15:3]+9)); %A11069300
IF BV THEN BEGIN EMIT(0); EMITO(XCH); EMIT(0) END; %A11069400
EMITV(JUNK); PLXINT ~ 12 END; %A11069500
IF BV THEN DBLINT ELSE IMPFUN; END; %A11069600
GO EXIT END; %A11069700
IF BV THEN DBLINT ELSE IMPFUN; %A11069800
EXIT: END OF PLXINT; %A11069900
% %A11070000
REAL PROCEDURE PLXPRIM(BV); VALUE BV; BOOLEAN BV; %A11070100
BEGIN REAL J,R,K; LABEL EXIT, L; %A11070200
REAL T; %A11070300
DPTOG ~ FALSE; %A11070400
WHILE ELCLASS= COLON DO BEGIN J~J+1; STEPIT END; %A11070500
IF ELCLASS= INTRNSICPROCID THEN R ~ PLXINT(BV) ELSE BEGIN %A11070600
IF ELCLASS= FIELDID AND K ~ ELBAT[I].ADDRESS{ 2 THEN %A11070700
BEGIN R ~ 12; FIELDC(ELBAT[I],0,FALSE); GO L END ELSE %A11070800
IF ELCLASS}DBLPLXTRNS AND ELCLASS{DBLPLXARRAYID THEN %A11070900
IF (T ~ ELCLASS-STRTRNS).[45:3] =1 THEN BEGIN %A11071000
IF K ~ TAKE(ELBAT[I].LINK+1).[2:2] =0 THEN R ~0 ELSE R ~ 12; %A11071100
CASE T DIV 8 OF BEGIN BEGIN IF BV THEN K~0 ELSE K~1; %A11071200
IF BOOLEAN(ELBAT[I].[34:1]) THEN %A11071300
IF BV THEN DBLPRIM ELSE PRIMARY ELSE %A11071400
BEGIN R ~ PANPLX(FALSE,BV); %A11071500
IF R < 4 THEN BEGIN IF BOOLEAN(R) THEN R ~ (R+2)MOD 4 %A11071600
END ELSE %A11071700
IF BOOLEAN(R.[42:1]) THEN R ~ R & (R.TS+2)[41:46:2] ELSE %A11071800
R ~ R & (R.NS+2) [43:46:2] END; %A11071900
END; %A11072000
STRMPROCSTMT; PROCSTMT(FALSE); %A11072100
DBLPLXVAR(FALSE); DBLPLXVAR(FALSE); END; %A11072200
L: IF BV AND K=1 THEN %A11072300
IF R<4 THEN BEGIN EMIT(0); EMITO(XCH) END ELSE %A11072400
BEGIN EMITPAIR(JUNK,STD); EMIT(0); EMITO(XCH); %A11072500
EMIT(0); EMITV(JUNK) END ELSE %A11072600
IF K!1 AND NOT BV THEN DBLTSNGL(R); %A11072700
GO TO EXIT END; %A11072800
IF ELCLASS=LEFTPAREN THEN BEGIN I~I-1; R ~ PANPLX(FALSE,BV); %A11072900
GO EXIT END ELSE %A11073000
IF BV THEN DBLPRIM ELSE PRIMARY; R ~ 0; END; %A11073100
EXIT: IF R < 4 THEN PLXPRIM ~ (R+J).[46:2]ELSE %A11073200
PLXPRIM ~ R & (R.TS+J)[41:46:2] %A11073300
& (R.NS+J)[43:46:2] %A11073400
END OF PLXPRIM; %A11073500
% %A11073600
REAL PROCEDURE PLEXP(R,BV); VALUE R,BV; REAL R; BOOLEAN BV; %A11073700
BEGIN %B11073800
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11073900
% %A11074000
IF R > 4 OR BOOLEAN(R) THEN BEGIN PLEXP ~ 12; %A11074100
PLXNORM(R,BV); EMITO(MKS); IF BV THEN DBLPRIM ELSE PRIMARY; %A11074200
EMITV(IF BV THEN DBLPLXFACT ELSE PLXFACT) END ELSE %A11074300
BEGIN IF R = 2 THEN EMITO(CHS); %A11074400
IF BV THEN DBLEXP ELSE %A11074500
BEGIN PRIMARY; EMITUP END END; %A11074600
% %A11074700
END OF PLEXP; %A11074800
% %A11074900
INTEGER PROCEDURE PLXCOMP(R1,BV); %A11075000
VALUE R1,BV; INTEGER R1; BOOLEAN BV; %A11075100
BEGIN REAL OPERATOR,R2,OPCLASS; %A11075200
DO BEGIN %A11075300
OPERATOR~ELBAT[I].ADDRESS; %A11075400
OPCLASS ~ ELCLASS; %A11075500
DPTOG ~ BV; %A11075600
STEPIT; %A11075700
IF OPCLASS = FACTOP THEN R1~ PLEXP(R1,BV) %A11075800
ELSE BEGIN R2~PLXPRIM(BV); %A11075900
WHILE OPCLASS < ELCLASS DO %A11076000
R2~PLXCOMP(R2,BV); %A11076100
R1~PLXOP2(OPERATOR,R1,R2,BV) %A11076200
END %A11076300
END UNTIL OPCLASS ! ELCLASS; %A11076400
PLXCOMP~R1; %A11076500
END OF PLXCOMP; %A11076600
% %A11076700
INTEGER PROCEDURE SIMPLX(R,BV); VALUE R,BV; INTEGER R; BOOLEAN BV; %A11076800
BEGIN WHILE ELCLASS } ADOP DO R~PLXCOMP(R,BV); %A11076900
SIMPLX~R END; %A11077000
% %A11077100
INTEGER PROCEDURE PLXSEC(BV); VALUE BV; BOOLEAN BV; %A11077200
BEGIN REAL R; %A11077300
IF ELCLASS = ADOP THEN BEGIN %A11077400
IF ELBAT[I].ADDRESS ! ADD THEN %A11077500
BEGIN %A11077600
STEPIT; %A11077700
R~PLXPRIM(BV); %A11077800
WHILE ELCLASS = FACTOP DO BEGIN DPTOG ~ BV; %A11077900
STEPIT; R ~ PLEXP(R,BV) END; %A11078000
PLXSEC~IF R < 4 THEN (R+2) MOD 4 %A11078100
ELSE 4 & (R.[43:2] + 2)[43:46:2] %A11078200
& (R.[41:2] + 2)[41:46:2] %A11078300
END %A11078400
ELSE BEGIN STEPIT; PLXSEC~PLXPRIM(BV) END %A11078500
END ELSE PLXSEC~PLXPRIM(BV) %A11078600
END OF PLXSEC; %A11078700
% %A11078800
REAL PROCEDURE PANPLX(V,A); VALUE V,A; BOOLEAN V,A; %A11078900
BEGIN %B11079000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11079100
IF STEPI! LEFTPAREN THEN ERR(105) ELSE BEGIN %A11079200
IF V THEN EMITO(MKS); %A11079300
DPTOG ~ A; %A11079400
STEPIT; PANPLX ~ PLXP(A); %A11079500
DPTOG ~ FALSE; %A11079600
IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT END; %A11079700
END; %B11079800
% %A11079900
PROCEDURE PLXPN(BV); VALUE BV; BOOLEAN BV; %A11080000
BEGIN DPTOG ~ BV; STEPIT; PLXNORM(PLXP(BV),BV); DPTOG ~ FALSE END; %A11080100
% %A11080200
PROCEDURE DBLPLXP(TYPE); VALUE TYPE; REAL TYPE; %A11080300
IF TYPE=0 THEN BEGIN DPTOG ~ TRUE; STEPIT; %A11080400
DBLXP; DPTOG ~ FALSE END ELSE PLXPN(TYPE=2); %A11080500
% %A11080600
INTEGER PROCEDURE PLXP(BV); VALUE BV; BOOLEAN BV; %A11080700
BEGIN %B11080800
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11080900
IF ELCLASS = CASEV %A11081000
THEN BEGIN PLXP~12; %A11081100
CASESTMT(1 & (7 + REAL(BV))[43:44:4]) %A11081200
END ELSE %A11081300
IF ELCLASS = IFV %A11081400
THEN BEGIN PLXP~12; %A11081500
IFXP(7 + REAL(BV)) END ELSE %A11081600
PLXP~SIMPLX(PLXSEC(BV),BV); %A11081700
END; %B11081800
% THE FOLLOWING FOR RECORD EXPRESSIONS %A11081900
% %A11082000
PROCEDURE FIELDC(EL,PR,FROM); VALUE EL,PR,FROM; REAL EL,PR; %A11082100
BOOLEAN FROM; %A11082200
BEGIN REAL T1,T2,T3,FCLASS; %A11082300
REAL T; BOOLEAN B; %A11082400
BOOLEAN PART; LABEL EXIT; REAL CR; %A11082500
LABEL LRX; BOOLEAN SYMTF; %A11082550
DEFINE TEMP1 = TMP#; %A11082600
BOOLEAN PROCEDURE CHECKTYPE(EL,RTYPE); VALUE EL,RTYPE; %A11082700
REAL EL,RTYPE; %A11082800
BEGIN REAL S; DEFINE T = RTYPE#; REAL R; %A11082900
LABEL EXIT; %A11083000
CHECKTYPE ~ TRUE; %A11083100
T ~ TAKE(R~GIT(RECARRAY[RTYPE])); %A11083200
FOR S ~ 1 STEP 1 UNTIL T DO %A11083300
IF TAKE(R+S) = EL THEN BEGIN CHECKTYPE~FALSE; GO EXIT END; %A11083400
EXIT: END OF CHECKTYPE; %A11083500
FCLASS ~ EL.ADDRESS; %A11083600
IF BOOLEAN(PR) THEN %A11083700
IF FCLASS=STRINGV THEN BEGIN EMITPAIR(TMP,SND); %A11083800
EMITO(MKS); EMITV(TMP); END %A11083900
ELSE EMITO(DUP); %A11084000
T1 ~ TAKE(GIT(EL)); %A11084100
IF BOOLEAN(PR) THEN BEGIN %A11084200
T3 ~ GNATR(PR.[26:6]); %A11084300
IF T ~ PR.[32:7] + T1.[8:7] > T1.[15:7] THEN %A11084400
BEGIN ERR(635); GO EXIT END; %A11084500
END ELSE %A11084600
BEGIN %A11084700
IF T1 < 0 THEN BEGIN BANA; EMITO(DUP); EMITO(DUP); %A11084800
EMITL(T1.[8:7]); EMITO(LSS); EMITO(XCH); %A11084900
EMITL(T1.[15:7]); EMITO(GTR); EMITO(LOR); %A11085000
B ~ TRUE; %A11085100
EMITERR(SGNO,L,"15") END ELSE %A11085200
BEGIN STEPIT; T ~ T1.[8:7] END; %A11085300
IF ELCLASS ! LEFTPAREN THEN BEGIN %A11085400
ERR(105); GO EXIT END ELSE %A11085500
STEPIT; IF NOT RECLAIMTOG THEN BEGIN% %A11085600
IF SYMTF ~ ELCLASS = SYMID OR ELCLASS = SYMARRAYID OR %A11085610
ELCLASS = CHAINOP OR %A11085612
ELCLASS = SYMTRNS OR %A11085615
(ELCLASS = FIELDID AND ELBAT[I].ADDRESS = SYMV) THEN %A11085620
BEGIN SEXPN; QUOTETOG ~ FCLASS=SYMV; %A11085630
IF B THEN EMITO(INX) ELSE %A11085635
IF T ! 0 THEN BEGIN EMITL(T); EMITO(INX) END; B~FALSE END %A11085640
ELSE GO LRX END ELSE BEGIN LRX: REXP; %A11085650
IF RECTYPE = 0 THEN BEGIN ERR(612); GO EXIT END; %A11085700
T3 ~ GNATR(WTYPE ~ RECTYPE); %A11085800
IF CHECKTYPE(EL.[35:13],RECTYPE) THEN BEGIN %A11085900
FLAG(636); ERRORTOG ~ TRUE END; %A11086000
END; %A11086050
IF ELCLASS ! RTPAREN THEN BEGIN %A11086100
ERR(104); GO EXIT END; %A11086200
STEPIT; END; %A11086300
IF NOT SYMTF THEN BEGIN %A11086350
T3 ~ TAKE(T3).ADDRESS; %A11086400
CR ~ REAL(ELCLASS=ASSIGNOP OR BOOLEAN(PR)).[47:1]; %A11086500
END; %A11086550
T2 ~ T1.[35:13]; PART ~ (T1~T1.[22:13])!0; %A11086600
IF FCLASS = STRINGV THEN BEGIN %A11086700
SLT ~ SPT ~ FALSE; SL ~ T2; %A11086800
IF SYMTF THEN BEGIN SYMSTK.[46:1] ~ TRUE; %A11086810
GETCONTENTS(0,TRUE); %A11086815
IF SL + (SP~T1) > 8 THEN FLAG(669) END ELSE %A11086820
BEGIN SP ~ T | 8 + T1; %A11086830
FIXRECORD(T3,CR); %A11086900
IF BOOLEAN(PR) THEN BEGIN QUOTETOG ~ TRUE; %A11087000
WTYPE ~ 4; %A11087100
ELCLASS~ ASSIGNOP; SYMSEC~ TRUE; STRINGSEC(2); %A11087200
QUOTETOG ~ FALSE END; %A11087300
END; %A11087400
GO EXIT END; %A11087500
% %A11087600
IF ELCLASS = ASSIGNOP OR BOOLEAN (PR) THEN BEGIN %A11087700
IF SYMTF THEN GETCONTENTS(0,TRUE); %A11087750
QUOTETOG ~ FCLASS = SYMV; STEPIT; %A11087800
IF FCLASS > INTV THEN RECOM(FCLASS) ELSE %A11087900
IF FCLASS = SYMV THEN SEXPN ELSE %A11088000
IF FCLASS = BOOV THEN BEXP ELSE AEXP; %A11088100
IF FROM THEN QUOTETOG ~ FALSE; %A11088200
IF PART OR B THEN EMITPAIR(TEMP1,STD) ELSE EMITO(XCH); %A11088300
IF NOT SYMTF THEN BEGIN %A11088350
FIXRECORD(T3,CR); %A11088400
IF B THEN EMITO(XCH) ELSE EMITL(T); EMITO(CDC); %A11088500
END; %A11088550
IF PART THEN BEGIN EMITO(DUP); EMITO(LOD); EMITV(TEMP1); %A11088600
EMITD(48-T2,T1,T2); EMITO(XCH); EMITO(STD); %A11088700
IF NOT FROM THEN EMITV(TEMP1) END ELSE %A11088800
BEGIN IF B THEN BEGIN EMITV(TEMP1); EMITO(XCH) END; %A11088900
EMITO(IF FROM THEN STD ELSE SND) END END ELSE %A11089000
IF FROM THEN ERR(685) ELSE% %A11089100
BEGIN IF SYMTF THEN GETCONTENTS(0,FALSE) ELSE %A11089150
BEGIN FIXRECORD(T3,CR); %A11089200
IF B THEN EMITO(XCH) ELSE EMITL(T); %A11089300
EMITO(COC); END; IF PART THEN EMITI(0,T1,T2); %A11089400
IF FCLASS > 29 THEN RECTYPE ~ FCLASS END; %A11089500
EXIT: IF FROM OR BOOLEAN(PR) THEN RECTYPE ~ 0; %A11089600
END OF FIELDC; %A11089700
% %A11089800
PROCEDURE FIXRECORD(R,A); VALUE R,A; REAL R,A; %A11089900
BEGIN REAL T,P; %A11090000
IF A = 2 THEN EMIT(0); EMITO(MKS); %A11090100
P ~ TAKE(GIT((T~RECARRAY[R]).[22:13])); %A11090200
IF A < 5 THEN BEGIN %A11090300
IF A = 2 THEN EMITN(P.[26:11]+1) ELSE EMIT(0); %A11090400
EMITN(P.[26:11]); END; %A11090500
EMITN(R~T.[11:11]); EMITN(R+1); EMITN(R+2); EMITL(P.[16:10]); %A11090600
EMITL(5); EMITN(TAKE(T.[22:13]).ADDRESS); %A11090700
EMITPAIR(P.[37:11],LOD); EMITL(A); EMITV(RECLINK); %A11090800
IF A = 4 THEN EMITO(DEL); END FIXRECORD; %A11090900
% %A11091000
PROCEDURE GENRECORD(R,B); VALUE R,B; REAL R; BOOLEAN B; %M11091100
BEGIN REAL A,S,T,P; %A11091200
IF B THEN WHILE R ~ R + 1 { RECORDLINK DO BEGIN %M11091300
EMITL(((A~ GNATR(R)).[6:5] - 1) | 2); EMITPAIR(A.[11:11],STD); %A11091400
S ~ A.[22:13]; %A11091500
IF T ~ TAKE(S~GIT(S)) > 0 THEN BEGIN %M11091600
EMITARRAY(T.[37:11],T.[2:5]|2,T.[16:10],FALSE);PUT(-T,S); %A11091700
BEGIN EMITL(T.[7:9]); EMITPAIR(T.[26:11]+1,STD) END END %A11092300
END ELSE WHILE R ~ R + 1 { RECORDLINK DO %A11092400
IF TAKE((S~(A~RECARRAY[R]).[22:13])+1).[2:2]!1 THEN BEGIN %A11092500
FIXRECORD(R,5); %A11092600
END;% %A11092700
END OF GENRECORD; %A11093400
% %A11093500
PROCEDURE RECVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11093600
BEGIN REAL TALL,STR,ADR,TYPEV; %A11093700
BOOLEAN ARTOG; %A11093800
LABEL EXIT; %A11093900
ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); TYPEV ~ GETYPE(TALL);%A11094000
IF ARTOG ~ ELCLASS = RECARRAYID THEN BEGIN %A11094100
IF ARAY(TALL,0,FALSE) THEN GO EXIT END ELSE STEPIT; %A11094200
IF ELCLASS=ASSIGNOP THEN BEGIN %A11094300
STEPIT; RECOM(TYPEV); STR ~ IF FROM THEN STD ELSE SND; %A11094400
IF FROM THEN RECTYPE ~ 0; %A11094500
IF ARTOG THEN BEGIN EMITO(XCH); EMITO(STR) END ELSE %A11094600
IF TALL.[9:2]=2 THEN BEGIN EMITN(ADR); EMITO(STR) END ELSE %A11094700
EMITPAIR(ADR,STR) END ELSE %A11094800
IF FROM THEN ERR(202) ELSE BEGIN %A11094900
IF NOT ARTOG THEN EMITV(ADR); RECTYPE ~ TYPEV END; %A11095000
EXIT: END RECVAR; %A11095100
% %A11095200
PROCEDURE RECOM(R); VALUE R; REAL R; %A11095300
BEGIN REXP; IF R ! RECTYPE AND RECTYPE ! 0 THEN FLAG(613); %A11095400
ERRORTOG ~ TRUE END; %A11095500
% %A11095600
PROCEDURE REXP; %A11095700
BEGIN REAL T; %A11095800
LABEL EXIT; %A11095900
REAL R, JR; LABEL LR;% %A11096000
IF ELCLASS}RECTRNS AND ELCLASS{RECARRAYID AND ELCLASS!22 THEN %A11096100
IF (GT1 ~ ELCLASS-STRTRNS).[45:3]=3 THEN %A11096200
IF GT1 } 24 THEN RECVAR(FALSE) ELSE% %A11096300
IF GT1 = 19 THEN PROCSTMT(FALSE) ELSE% %A11096400
ERR(612) ELSE ERR(612) ELSE% %A11096500
IF ELCLASS=NILV THEN BEGIN RECTYPE ~ 0; STEPIT; %A11097000
EMITL(0); END ELSE %A11097100
IF ELCLASS = DECLARATORS AND % %A11097200
T ~ (JR ~ ELBAT[I]).ADDRESS > FIELDV THEN% %A11097300
IF STEPI = LFTBRKET THEN BEGIN I ~ I - 1 ; BANA;% %A11097350
LR: RECTYPE ~ T ; GO EXIT END ELSE% %A11097400
BEGIN FIXRECORD (T,2); %A11097450
IF ELCLASS ! LEFTPAREN THEN GO LR;% %A11097460
BEGIN REAL J,A,B,K,PR,S; %A11097500
LABEL EXIT;% %A11097600
PR ~ 1 & T [26:42:6];% %A11097700
B ~ TAKE (J ~ GIT (JR)).[40:8];% %A11097800
FOR A ~ 1 STEP 1 UNTIL B DO BEGIN %A11097900
QUOTETOG ~ K ~(R~TAKE((S~TAKE(J+A)).[35:13])&S[35:35:13]).ADDRESS %A11098000
= SYMV OR K = STRINGV; %A11098100
IF K ~ TABLE(I+1) = FACTOP THEN %A11098200
% %A11098300
% %A11098400
BEGIN STEPIT; STEPIT END ELSE %A11098500
IF K = LFTBRKET THEN BEGIN K ~ -1; %A11098600
STEPIT; %A11098700
DO IF TABLE(I+1)=FACTOP THEN BEGIN STEPIT; STEPIT; K~K+1 END %A11098800
ELSE FIELDC(R,PR&(K~K+1)[32:41:7],TRUE) UNTIL ELCLASS!COMMA; %A11098900
IF ELCLASS=RTBRKET THEN STEPIT ELSE %A11099000
BEGIN ERR(614); GO EXIT END END ELSE %A11099100
FIELDC(R,PR,TRUE); %A11099200
IF A=B THEN %A11099300
IF ELCLASS= RTPAREN THEN STEPIT ELSE %A11099400
BEGIN ERR(104); GO EXIT END ELSE %A11099500
IF ELCLASS ! COMMA THEN BEGIN %A11099600
ERR(606); GO EXIT END; %A11099700
QUOTETOG ~ FALSE; END; %A11099800
RECTYPE ~ T; %A11099900
EXIT: %A11100000
END END ELSE% %A11100100
IF ELCLASS = FIELDID AND T > FIELDV THEN% %A11100200
FIELDC(JR,0,FALSE) ELSE ERR(612);% %A11100300
EXIT: END REXP; %A11101300
% THE FOLLOWING FOR SYMBOL EXPRESSIONS %A11101400
% %A11101500
PROCEDURE CONSIT; %A11101600
BEGIN LABEL EXIT; BOOLEAN BV; %A11101700
REAL P,R,S,T; LABEL L; %A11101800
IF STEPI = LFTBRKET THEN BEGIN BV ~ TRUE; %A11101810
DO BEGIN %A11101820
IF STEPI ! FIELDID THEN BEGIN L: %A11101830
ERR(682);% %A11101900
GO EXIT END; %A11101910
IF T ~ TAKE(GIT(S~ELBAT[I])) < 0 THEN GO L; %A11101920
R ~ T.[22:13]; %A11101930
IF BV THEN BEGIN BV ~ FALSE; P ~ T.[8:7]; %A11102000
IF R ! 0 THEN EMIT(0); END ELSE %A11102010
IF R = 0 OR T.[8:7] ! P THEN GO L; %A11102020
IF STEPI ! COLON THEN BEGIN ERR(681); GO EXIT END;% %A11102030
QUOTETOG ~ S ~ S.ADDRESS = SYMV; STEPIT; %A11102100
IF S > INTV THEN RECOM(S) ELSE %A11102110
IF S = SYMV THEN SEXPN ELSE %A11102120
IF S = BOOV THEN BEXP ELSE AEXP; RECTYPE ~ 0; %A11102130
IF R ! 0 THEN EMITD(48 - (T~T.[35:13]),R,T); %A11102200
END UNTIL ELCLASS ! COMMA; %A11102210
IF ELCLASS=RTBRKET THEN STEPIT ELSE ERR(607); %A11102220
QUOTETOG ~ TRUE; GENSYMLINK; GO EXIT END ELSE %A11102230
IF ELCLASS ! LEFTPAREN THEN BEGIN EMIT(0); %A11102300
GENSYMLINK; GO EXIT END; %A11102310
STEPIT; %A11102320
BEGIN SEXPN; %A11102400
IF RECLAIMTOG THEN BEGIN EMITO(SSP); MARKSYMNCR(1) END END; %A11102500
IF NOTCOMMA THEN GO EXIT; %A11102600
EMIT(0); %A11102700
SEXPN; EMITO(CTC); %A11102800
MARKSYMNCR(1); %A11102900
EMITO(XCH); %A11103000
IF ELCLASS = RTPAREN THEN STEPIT ELSE BEGIN ERR(104); GO %A11103100
EXIT END; %A11103200
EMITO(CTF); %A11103500
GENSYMLINK; MARKSYMDCR(-2+REAL(BV)); %A11103600
EXIT: %A11103700
END OF CONSIT; %A11103800
% %A11103900
PROCEDURE GENLIST; %A11104000
BEGIN REAL DC,T; %A11104100
LABEL EXIT; %A11104200
REAL ARRAY DCT[0:15]; LABEL LR; %A11104300
IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11104400
LR: QUOTETOG~ TRUE; STEPIT; T ~ SEXP; %A11104500
% %A11104600
IF RECLAIMTOG THEN BEGIN %A11104700
IF T>2 THEN SDNORM(T) ELSE EMITI(0,33-15|T,15); %A11104800
MARKSYMNCR(1) END ELSE DCT[DC]~ SNORM(T); %A11104900
DC ~ DC + 1; %A11105000
IF ELCLASS = COMMA THEN GO LR; %A11105100
IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END ELSE STEPIT; %A11105200
EMIT(0); %A11105300
EMITO(XCH); %A11105400
EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11105500
GENSYMLINK; T ~ DC; %A11105600
WHILE DC ~ DC -1 ! 0 DO BEGIN %A11105700
MARKSYMNCR(0); EMITO(XCH); %A11105800
EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11105900
GENSYMLINK END; %A11106000
MARKSYMDCR(-T); %A11106100
EXIT: %A11106200
END OF GENLIST; %A11106300
% %A11106400
REAL PROCEDURE GENQUOTE(BV); VALUE BV; BOOLEAN BV; %A11106500
BEGIN %A11106600
BOOLEAN STREAM PROCEDURE COMP(LNK,SKP,AC,I); VALUE LNK,SKP,I; %A11106700
BEGIN SI ~ LOC LNK; SI ~ SI + 1; DI ~ AC; DI ~ DI + 3; %A11106800
DI ~ DI + SKP; %A11106900
IF I SC ! DC THEN TALLY ~ 1; COMP ~ TALLY; %A11107000
END OF COMP; %A11107100
STREAM PROCEDURE TRC(BV,ACN,SKP,ACCUM,PTR,LNK); %A11107200
VALUE BV,ACN,SKP,PTR; %A11107300
BEGIN DI ~ LNK; SI ~ LOC ACN; SI ~ SI + 7; DS ~ CHR; %A11107400
SI ~ ACCUM; SI ~ SI + 3; SI ~ SI + SKP; %A11107500
DS ~ 4 CHR; %A11107600
BV(SI ~ LOC PTR; SI ~ SI + 5); %A11107700
DS ~ 3 CHR END; %A11107800
PROCEDURE RPLACD(A,B); VALUE A,B; REAL A,B; %A11107900
LNK[A.[33:6],A.[39:9]].[33:15] ~ B; %A11108000
REAL PROCEDURE CONSF(A); VALUE A; REAL A; %A11108100
BEGIN NEWLINK ~ 0 & A [18:33:15]; CONSF ~ LNKNDX END; %A11108200
REAL PROCEDURE MKATOM(BV); VALUE BV; BOOLEAN BV; FORWARD; %A11108300
REAL PROCEDURE GENSYMLIST; %A11108400
IF ELCLASS = QUOTEOP THEN FLAG(615) ELSE %A11108500
BEGIN REAL X; LABEL EXIT; %A11108600
IF ELCLASS = RTPAREN THEN BEGIN STEPIT; GO EXIT END; %A11108700
GENSYMLIST ~ X ~ CONSF(MKATOM(TRUE)); %A11108800
WHILE ELCLASS ! RTPAREN DO BEGIN %A11108900
IF ELCLASS = QUOTEOP THEN BEGIN FLAG(615); GO EXIT END; %A11109000
IF ELCLASS = DOTOP THEN BEGIN STEPIT; %A11109100
RPLACD(X,MKATOM(TRUE)); %A11109200
IF ELCLASS ! RTPAREN THEN FLAG(104) ELSE STEPIT; %A11109300
GO EXIT END; %A11109400
IF ELCLASS = COMMA THEN STEPIT; %A11109500
RPLACD(X,X~CONSF(MKATOM(TRUE))); END; %A11109600
STEPIT; %A11109700
EXIT: END; %A11109800
REAL PROCEDURE MKATOM(BV); VALUE BV; BOOLEAN BV; %A11109900
BEGIN INTEGER N,J; REAL R; %A11110000
LABEL LS,EXIT; %A11110100
REAL P,K,S,B; LABEL L1,L2,L3; %A11110200
IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %A11110300
BEGIN MKATOM ~ MKNUM(C); GO LS END; %A11110400
IF ELCLASS = ADOP THEN BEGIN %A11110500
IF EXAMIN(NCR) ! " " THEN BEGIN J ~ ACCUM[1].[18:6]; %A11110600
IF STEPI = LITNO OR ELCLASS = NONLITNO THEN BEGIN %A11110700
MKATOM ~ MKNUM(IF J = "-" THEN -C ELSE C); GO LS %A11110800
END; %A11110900
MKATOM ~ J; GO EXIT END END; %A11111000
IF ELCLASS = ALFATRNS THEN BEGIN MKATOM ~ TAKE(GIT(ELBAT[I])); %A11111100
GO TO LS END; %A11111200
IF N ~ (R ~ ACCUM[1]).[12:6] = 1 THEN BEGIN %A11111300
R ~ R.[18:6]; %A11111400
IF BV THEN %A11111500
IF R = "(" THEN BEGIN STEPIT; MKATOM ~ GENSYMLIST; %A11111600
GO EXIT END ELSE %A11111700
IF R = ")" OR R = "." OR R = "," THEN BEGIN FLAG(615); %A11111800
GO EXIT END; %A11111900
MKATOM ~ R END ELSE %A11112000
BEGIN %A11112100
K ~ SYMSTACK[R MOD 125]; %A11112200
L1: IF P ~ K { 1 THEN GO TO L3; %A11112300
S ~ LNK[(K~LNK[K.[33:6],K.[39:9]]).[18:6],K.[24:9]]; %A11112400
K ~ K.[3:15]; %A11112500
IF S.[1:5] ! N THEN GO L1; %A11112600
J ~ 0; %A11112700
L2: IF B ~ N-J > 7 THEN B ~ 4; %A11112800
IF COMP(S,J,ACCUM[1],B) THEN GO L1; %A11112900
IF J ~ J+B = N THEN BEGIN MKATOM ~ P; GO LS END; %A11113000
S ~ LNK[S.[33:6],S.[39:9]]; GO L2; %A11113100
L3: IF N {7 THEN J ~ N ELSE J ~ (N MOD 4) + 4; %A11113200
TRC(0,J,N-J,ACCUM[1],0,NEWLINK); %A11113300
WHILE J ! N DO TRC(1,J~J+4,N-J,ACCUM[1],LNKNDX,NEWLINK); %A11113400
NEWLINK ~ 0 & (LNKNDX-1)[18:33:15] %A11113500
& (IF R ~ SYMSTACK[J ~ R MOD 125] = 0 THEN 1 ELSE R) %A11113600
[3:33:15] & 2 [1:46:2]; %A11113700
SYMSTACK[J] ~ MKATOM ~ LNKNDX; END; %A11113800
LS: STEPIT; %A11113900
EXIT: END OF MKATOM; %A11114000
REAL PROCEDURE SCANB; %A11114100
BEGIN LABEL L1; %A11114200
IF STEPI=LITNO OR ELCLASS=NONLITNO THEN BEGIN %A11114300
NEWLINK ~ 0&C[4:19:29]&1[1:46:2]; SCANB ~ LNKNDX; %A11114400
IF STEPI=RTBRKET THEN STEPIT ELSE BEGIN %A11114500
L1: QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(640); END END ELSE GO L1 %A11114600
END OF SCANB; %A11114700
PROCEDURE PROPLIST(X); VALUE X; REAL X; %A11114800
BEGIN REAL R,S; LABEL EXIT; %A11114900
STOPDEFINE ~ SYMQUOTE ~ FALSE; STEPIT; SYMQUOTE ~ TRUE; %A11114950
IF X > 63 OR X < 10 THEN %A11115000
IF LNK[X.[33:6],X.[39:9]].[1:2] ! 2 THEN BEGIN FLAG(641); %A11115100
ERRORTOG ~ TRUE END; %A11115200
IF ELCLASS=LFTBRKET THEN RPLACD(X,SCANB) ELSE %A11115300
IF ELCLASS=QUOTEOP THEN RPLACD(X,GENQUOTE(TRUE)) ELSE %A11115400
IF ELCLASS = LITNO THEN BEGIN RPLACD(X,ELBAT[I].ADDRESS); %A11115500
STEPIT END ELSE %A11115600
IF ELCLASS=LEFTPAREN THEN BEGIN DO %A11115700
IF STEPI= LFTBRKET THEN RPLACD(X,X~SCANB) ELSE %A11115800
BEGIN R~MKATOM(FALSE); %A11115900
IF ELCLASS!COLON THEN BEGIN QUOTETOG~SYMQUOTE~FALSE; %A11116000
ERR(642); GO EXIT END; STEPIT; S~ MKATOM(TRUE); %A11116100
NEWLINK ~ 0 & R[3:33:15]&S[18:33:15]; %A11116200
RPLACD(X,X~ LNKNDX) END UNTIL ELCLASS! COMMA; %A11116300
IF ELCLASS=RTPAREN THEN STEPIT ELSE BEGIN %A11116400
QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(104) END END ELSE %A11116500
BEGIN QUOTETOG ~ SYMQUOTE ~ FALSE; ERR(639) END; %A11116600
EXIT: END OF PROPLIST; %A11116700
REAL S; %A11116800
SYMQUOTE ~ TRUE; %A11116900
IF STEPI = LEFTPAREN THEN %A11117000
IF STEPI = QUOTEOP THEN GENQUOTE ~ S ~ "(" ELSE %A11117100
BEGIN GENQUOTE ~ S ~ GENSYMLIST; %A11117200
IF ELCLASS = RTPAREN THEN BEGIN %A11117300
DO UNTIL STEPI ! RTPAREN; %A11117400
FLAG(616); END END ELSE %A11117500
GENQUOTE ~ S ~ MKATOM(FALSE); %A11117600
IF ELCLASS = QUOTEOP THEN BEGIN %A11117700
SYMQUOTE ~ FALSE; %A11117750
IF STEPI=COLON AND BV THEN PROPLIST(S); SYMQUOTE ~ FALSE %A11117800
END ELSE BEGIN SYMQUOTE ~ FALSE; ERR(637) END; %A11117900
END OF GENQUOTE; %A11118000
% %A11118100
REAL PROCEDURE MKCHAIN(FROM); VALUE FROM; BOOLEAN FROM; %A11118200
BEGIN INTEGER J,K,R,S; %A11118300
BOOLEAN V; %A11118400
LABEL L; %A11118500
J ~ ELBAT[I].[9:26]; %A11118600
DO BEGIN K ~ J.[46:2]; J ~ J DIV 4 END UNTIL K!0; %A11118700
K ~ J.[46:2]; J ~ J DIV 4; QUOTETOG ~ TRUE; S ~ J.[46:2]; %A11118800
IF SYMSEC THEN BEGIN SYMSEC ~ FALSE; R ~ 0 END ELSE R ~ PORV; %A11118900
V ~ ELCLASS = ASSIGNOP; %A11119000
IF FROM THEN QUOTETOG ~ TRUE; %A11119100
L: GETCONTENTS(R, S=3 AND V); R ~ K; %A11119200
IF K ~ S ! 3 THEN BEGIN %A11119300
J ~ J DIV 4; S ~ J.[46:2]; GO TO L END; %A11119400
IF V THEN BEGIN STEPIT; %A11119500
K ~ SNORM(SEXP); %A11119600
EMITPAIR(TEMP1,STD); EMITO(DUP); EMITO(LOD); EMITV(TEMP1); %A11119700
EMITD(33-K|15,33-R|15,15); EMITO(XCH); %A11119800
EMITO(IF FROM THEN STD ELSE SND); END ELSE %A11119900
IF FROM THEN ERR(617); %A11120000
MKCHAIN ~ R; QUOTETOG ~ NOT FROM; %A11120100
END OF MKCHAIN; %A11120200
% %A11120300
REAL PROCEDURE MKNUM(R); VALUE R; REAL R; %A11120400
BEGIN INTEGER I; LABEL L; %A11120500
IF ABS(R) < 10 THEN %A11120600
IF I ~ R } 0 AND I = R THEN BEGIN MKNUM ~ I; GO L END; %A11120700
NEWLINK ~ R; %A11120800
NEWLINK ~ ((MKNUM ~ LNKNDX)-1)& 3 [1:46:2]; %A11120900
L: END MKNUM; %A11121000
% %A11121100
PROCEDURE PANSYM(MARK,TWOARG); VALUE MARK,TWOARG; BOOLEAN %A11121200
MARK,TWOARG; %A11121300
BEGIN LABEL EXIT; %A11121400
IF STEPI = LEFTPAREN THEN BEGIN QUOTETOG~TRUE; STEPIT END ELSE %A11121500
BEGIN ERR(105); GO EXIT END; %A11121600
SEXPN; IF MARK THEN MARKSYMNCR(1); %A11121700
IF TWOARG THEN BEGIN QUOTETOG ~ TRUE; %A11121800
IF ELCLASS = COMMA THEN STEPIT ELSE %A11121900
BEGIN ERR(606); GO EXIT END; %A11122000
SEXPN; IF MARK THEN MARKSYMNCR(1) END; %A11122100
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11122200
EXIT: END OF PANSYM; %A11122300
% %A11122400
REAL PROCEDURE PORV; %A11122500
IF STEPI!LEFTPAREN THEN SYMVAR(BOOLEAN(2)) ELSE %A11122600
BEGIN QUOTETOG~TRUE; STEPIT; PORV~SNORM(SEXP); %A11122700
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END; %A11122800
% %A11122900
REAL PROCEDURE RSEXP; RSEXP ~ %A11123000
IF ELCLASS = IFV OR ELCLASS = CASEV THEN SEXP ELSE %A11123100
SYMPRIM(TRUE); %A11123200
% %A11123300
PROCEDURE SDNORM(R); VALUE R; REAL R; %A11123400
IF R ~ SNORM(R) ! 0 %A11123500
THEN EMITI(0,33 - 15|R,15); %A11123600
% %A11123700
REAL PROCEDURE SEXP; %A11123800
BEGIN REAL T,DC,TL; ARRAY DCT[0:15]; %A11123900
LABEL EXIT,LR; %A11124000
LABEL LD; %A11124050
T~0; QUOTETOG ~ TRUE; %A11124100
IF SYMSEC THEN SYMSEC ~ FALSE ELSE %A11124200
IF ELCLASS = IFV THEN IFXP(5) ELSE %A11124300
IF ELCLASS = CASEV THEN CASESTMT(11) ELSE %A11124400
LR: T ~ SYMPRIM(FALSE); %A11124500
IF ELCLASS > DOTOP OR ELCLASS = AMPERSAND THEN BEGIN %A11124600
IF T = 5 THEN BEGIN ERR(618); GO EXIT END; %A11124700
IF T = 4 THEN BEGIN T ~ 3; EMITNUM(SAVEQ); END ELSE %A11124800
IF T < 3 THEN BEGIN SDNORM(T); T ~ 3; %A11124900
EMITO(MKS); EMITV(ATN); END; %A11125000
QUOTETOG~FALSE; SIMPARITH; QUOTETOG ~ TRUE; END; %A11125100
IF ELCLASS = DOTOP THEN BEGIN %A11125200
LD: %A11125250
IF RECLAIMTOG THEN BEGIN %A11125300
IF T > 2 THEN SDNORM(T) ELSE %A11125400
EMITI(0,33-15|T,15);MARKSYMNCR(1) END ELSE %A11125500
DCT[DC] ~ SNORM(T); %A11125600
DC ~ DC + 1; QUOTETOG ~ TRUE; STEPIT; GO LR END; %A11125700
IF ELCLASS = PERIOD THEN BEGIN QUOTETOG ~ TRUE; %A11125710
IF TABLE(I+1) ! LFTBRKET THEN GO LD END; %A11125720
IF DC ! 0 THEN BEGIN %A11125800
IF T > 2 THEN SDNORM(T) ELSE EMITI(0,33-15|T,15); %A11125900
MARKSYMNCR(1); EMITO(XCH); %A11126000
EMITD(33-(IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11126100
GENSYMLINK; T ~ DC; %A11126200
WHILE DC ~ DC - 1 ! 0 DO BEGIN %A11126300
MARKSYMNCR(0); EMITO(XCH); %A11126400
EMITD(33- (IF RECLAIMTOG THEN 0 ELSE DCT[DC-1])|15,18,15); %A11126500
GENSYMLINK END; %A11126600
MARKSYMDCR(-(T+1)); T ~ 0; END; %A11126700
IF T = 5 THEN BEGIN T ~ 0; EMITNUM(SAVEQ) END; %A11126800
SEXP ~ T; %A11126900
EXIT: END OF SEXP; %A11127000
% %A11127100
REAL PROCEDURE SNORM(R); VALUE R; REAL R; %A11127200
IF R <3 THEN SNORM ~ R ELSE %A11127300
IF R = 3 THEN BEGIN %A11127400
EMITO(MKS); EMITV(NTA); %A11127500
END ELSE %A11127600
IF R=4 THEN EMITNUM(MKNUM(SAVEQ)) ELSE %A11127700
EMITNUM(SAVEQ); %A11127800
% %A11127900
PROCEDURE SYMINT; %A11128000
BEGIN %B11128100
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11128200
CASE ELBAT[I].INCR OF BEGIN %A11128300
CONSIT; %A11128400
GENLIST; %A11128500
BEGIN EMITO(MKS); PANSYM(TRUE,TRUE); EMITV(APPEND ); %A11128600
MARKSYMDCR(-2) END; %A11128700
BEGIN EMITO(MKS); PANSYM(FALSE,TRUE); EMITV(NCONC ); END; %A11128800
BEGIN EMITO(MKS); EMITV(GENSYM); STEPIT END; %A11128900
BEGIN EMITO(MKS); PANSYM(FALSE,FALSE); EMITV(RANDOM) END; %A11129000
BEGIN IF STEPI = LEFTPAREN THEN BEGIN QUOTETOG ~ TRUE; %A11129100
STEPIT; STRINGSEC(4); QUOTETOG ~ FALSE; %A11129200
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104) END; %A11129300
EMITO(MKS); EMITV(ATCON); EMITPAIR(3,BFC); %A11129400
EMITV(INSYM); EMITPAIR(3,BFW); %A11129500
EMITO(MKS); %A11129600
IF ELCLASS = FACTOP THEN BEGIN EMIT(0); STEPIT END ELSE %A11129700
EMITL(1); EMITV(MKATM) END; %A11129800
PROPER(0); %A11129900
BEGIN EMITO(MKS); EMITV(READ1); STEPIT END; %A11130000
BEGIN FIXCLASS(SYMID,INSYM,FALSE); %A11130100
SYMVAR(FALSE) END; %A11130200
BEGIN QUOTETOG ~ FALSE; %A11130300
IF STEPI =LEFTPAREN THEN BEGIN STEPIT;AEXP; QUOTETOG ~ TRUE; %A11130310
IF ELCLASS = COMMA THEN BEGIN STEPIT; SEXPN; EMITO(INX); END; %A11130400
RTPARN END ELSE ERR(105) END; %A11130410
BEGIN QUOTETOG~FALSE; PANA ; QUOTETOG~TRUE; EMITV(SYMSTACKA) END; %A11130500
END; %B11130600
END; % END OF SYMINT %A11130700
% %A11130800
REAL PROCEDURE SYMPRIM(BV); VALUE BV; BOOLEAN BV; %A11130900
BEGIN LABEL EXIT, L57,L58,L59,L60,L61,L62,L63,L64,L65; %A11131000
LABEL LAE; %A11131050
SWITCH SW ~ L57,L58,L59,L60,L61,L62,L63,L64,L65; %A11131100
INTEGER T,R; %A11131200
IF ELCLASS > STRTRNS AND ELCLASS < RECARRAYID THEN BEGIN %A11131300
IF ELCLASS = ALFATRNS THEN BEGIN SAVEQ ~ TAKE(GIT(ELBAT[I])); %A11131400
STEPIT; SYMPRIM ~ 5; GO EXIT END; %A11131500
IF R ~(T~ELCLASS-STRTRNS).[45:3] = 2 THEN BEGIN %A11131600
CASE T DIV 8 OF BEGIN %A11131700
SYMINT; %A11131800
STRMPROCSTMT; %A11131900
PROCSTMT(FALSE); %A11132000
SYMVAR(FALSE); %A11132100
SYMVAR(FALSE); END; %A11132200
GO EXIT END ELSE %A11132300
IF R = 0 THEN BEGIN STRINGSEC(4); EMITO(MKS); EMITV(ATCON); %A11132400
EMITPAIR(3,BFC); EMITV(INSYM); EMITPAIR(3,BFW); %A11132500
EMITO(MKS); EMITL(1); EMITV(MKATM); %A11132600
GO EXIT END END ELSE %A11132700
IF ELCLASS = FIELDID THEN BEGIN %A11132800
IF ELBAT[I].ADDRESS = SYMV THEN BEGIN %A11132900
FIELDC(ELBAT[I],0,FALSE); GO EXIT END END ELSE %A11133000
IF ELCLASS > TRUTHV AND ELCLASS < WRITEV THEN %A11133100
GO TO SW[ELCLASS-TRUTHV]; %A11133200
IF ELCLASS=SPACEV THEN BEGIN SAVEQ ~" "; SYMPRIM ~5; %A11133300
STEPIT; GO EXIT END ELSE %A11133400
IF ELCLASS = STRTRNS THEN IF ELBAT[I].INCR=0 THEN %A11133500
BEGIN SAVEQ~12; SYMPRIM~5; STEPIT; GO EXIT END; %A11133600
IF BV THEN BEGIN ERR(618); GO TO EXIT END; %A11133700
LAE: %A11133750
QUOTETOG ~ FALSE; AEXP; QUOTETOG ~ TRUE; %A11133800
SYMPRIM ~ 3; GO EXIT; %A11133900
L57: L58: L59: SAVEQ ~ C; SYMPRIM ~ 4; STEPIT; GO EXIT; %A11134000
L60: STEPIT; %A11134100
SYMPRIM ~ IF BV THEN RSEXP ELSE SEXP; %A11134200
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); GO EXIT; %A11134300
L61: SAVEQ ~ 0; SYMPRIM ~ 4; STEPIT; GO EXIT; %A11134400
L62: SAVEQ ~ GENQUOTE(FALSE); SYMPRIM ~ 5; GO EXIT; %A11134500
L63: SYMPRIM ~ MKCHAIN(FALSE); GO EXIT; %A11134600
L64: IF T ~ ELBAT[I].ADDRESS = LISTV THEN GENLIST %A11134700
ELSE IF T = SYMV THEN BEGIN %A11134800
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11134900
STEPIT; BEXP; IF ELCLASS = RTPAREN THEN STEPIT ELSE %A11135000
BEGIN ERR(104); GO EXIT END; EMITI(0,47,1) END ELSE %A11135100
GO LAE; GO EXIT; %A11135200
L65: EMITO(MKS); EMITV(READER); STEPIT; %A11135300
EXIT: END OF SYMPRIM; %A11135400
% %A11135500
PROCEDURE SYMVAR(FROM); VALUE FROM; BOOLEAN FROM; %A11135600
BEGIN REAL TALL,STR,ADR; %A11135700
BOOLEAN ARTOG; LABEL EXIT; %A11135800
ADR ~ (TALL ~ ELBAT[I]).ADDRESS; CHECKER(TALL); %A11135900
IF ARTOG ~ ELCLASS= SYMARRAYID THEN BEGIN %A11136000
IF FROM THEN SMT ~ TALL < 0 ELSE TALL ~ ABS(TALL); %A11136100
IF ARAY(TALL,0,FALSE) THEN BEGIN ERR(205); GO EXIT END %A11136200
END ELSE STEPIT; %A11136300
IF ELCLASS=ASSIGNOP THEN %A11136400
IF FROM.[46:1] THEN %A11136500
IF ARTOG THEN BEGIN L~L-1; EMITO(COC) END %A11136600
ELSE EMITV(ADR) ELSE %A11136700
BEGIN %A11136800
QUOTETOG ~ TRUE; STEPIT; SEXPN; QUOTETOG ~ FALSE; %A11136900
STR ~ IF FROM THEN STD ELSE SND; %A11137000
IF TALL < 0 THEN EMITPAIR(JUNK,SND); %A11137100
IF ARTOG THEN BEGIN EMITO(XCH); EMITO(STR) END ELSE %A11137200
IF TALL.[9:2]=2 THEN BEGIN EMITN(ADR); EMITO(STR) %A11137300
END ELSE EMITPAIR(ADR,STR); %A11137400
IF TALL < 0 THEN SYMONITOR(NOT ARTOG,TALL, %A11137500
IF ARTOG THEN TAKE(GIT(TALL)) ELSE 0,0); END ELSE %A11137600
IF FROM THEN ERR(145) ELSE IF NOT ARTOG THEN %A11137700
EMITV(ADR);EXIT: QUOTETOG ~ NOT FROM; %A11137800
END OF SYMVAR; %A11137900
% THE FOLLOWING SECTION IS FOR STRING EXPRESSIONS %A11138000
PROCEDURE STRINGC(DSV,NLP); VALUE DSV,NLP; %A11138100
REAL DSV; BOOLEAN NLP; %A11138200
BEGIN REAL S; INTEGER R,T; BOOLEAN V; LABEL L1; %A11138300
LABEL EXIT; %A11138400
STRINGSEC(1); %A11138500
S ~ IF V ~ DSV > TRS THEN SFD ELSE SFS; %A11138600
ECR(STKC,IF V THEN RDA ELSE RSA); %A11138700
IF SPT THEN BEGIN %A11138800
ECR(STKC,CRF); EC(0,S); %A11138900
IF WTYPE = 1 THEN BEGIN %A11139000
IF SLT THEN EMITPAIR(ST1,STD); %A11139100
EMITO(DUP); %A11139200
EMITI(0,36,6); %A11139300
ECR(STKC,CRF); %A11139400
EC(3,BNS); %A11139500
EC(32,S); EC(32,S); EC(0,ENS); %A11139600
IF SLT THEN EMITV(ST1) END %A11139700
END ELSE %A11139800
RCH(FALSE,0,FALSE,0,SP,S); %A11139900
S ~ IF V THEN DSV.[42:6] ELSE TRS; %A11140000
IF V OR SPT OR DPT OR SLT OR DRT THEN BEGIN L1: %A11140100
IF SLT THEN BEGIN %A11140200
IF WTYPE ! 2 THEN BEGIN %A11140300
EMITO(DUP); EMITI(0,36,6); EMITO(XCH); %A11140400
STKC END; %A11140500
ECR(STKC,CRF); %A11140600
EC(0,S); %A11140700
IF V THEN EJ(JFC); %A11140800
IF WTYPE ! 2 THEN BEGIN ECR(STK-1,CRF); %A11140900
EC(3+4|REAL(V),BNS); %A11141000
EC(32,S); %A11141100
IF V THEN EC(4,JNC); %A11141200
EC(32,S); %A11141300
IF V THEN EC(2,JNC); %A11141400
EC(0,ENS); %A11141500
IF V THEN BEGIN EC(1,JFW); EJ(JFW) END; END; %A11141600
EMITO(DUP); END ELSE %A11141700
BEGIN % SLT FALSE %A11141800
IF R ~ SL.[42:6] ! 0 THEN BEGIN %A11141900
EC(R,S); IF V THEN EJ(JFC) END; %A11142000
IF R ~ SL.[36:6] ! 0 THEN BEGIN %A11142100
EC(R,BNS); EC(32,S); %A11142200
IF V THEN EC(4,JNC); %A11142300
EC(32,S); IF V THEN EC(2,JNC); %A11142400
EC(0,ENS); %A11142500
IF V THEN BEGIN EC(1,JFW); EJ(JFW) END %A11142600
END END; %A11142700
GO EXIT END; %A11142800
IF WTYPE } 3 AND NLP AND SL > 15 THEN %A11142900
IF DPT.[46:1] THEN %A11143000
IF R ~ (DP+DR).[45:3] = SP.[45:3] THEN BEGIN %A11143100
IF R ~ (8-R).[45:3] ! 0 THEN EC(R,TRS); %A11143200
IF R ~ (T~SL-R) DIV 8 ! 0 THEN %A11143300
RCH(FALSE,0,FALSE,0,R,TRW); %A11143400
IF T ~ T - R|8 ! 0 THEN EC(T,TRS); %A11143500
GO EXIT END; %A11143600
GO L1; %A11143700
EXIT: %A11143800
END OF STRINGC; %A11143900
% %A11144000
PROCEDURE STRINGPRIM(DSV,NLP); VALUE DSV,NLP; %A11144100
BOOLEAN NLP; REAL DSV; %A11144200
BEGIN LABEL L2,EXIT,L1; %A11144300
% %A11144400
PROCEDURE STRINGINT(V,DSV,NLP); VALUE V,DSV,NLP; %A11144500
BOOLEAN V,NLP; REAL DSV; %A11144600
BEGIN %A11144700
REAL STREAM PROCEDURE GITA(C,K); VALUE C,K; %A11144800
BEGIN DI ~ LOC GITA; DI ~ DI + 7; %A11144900
SI ~ LOC C; SI ~ SI + K; DS ~ CHR END; %A11145000
% %A11145100
PROCEDURE AMONG(BV); VALUE BV; BOOLEAN BV; %A11145200
BEGIN LABEL EXIT; %A11145300
REAL R,N,T,K; %A11145400
QUOTETOG~ FALSE; %A11145500
IF STEPI!STRNGCON THEN BEGIN %A11145600
ERR(700); GO EXIT END; %A11145700
R ~ C; N ~ COUNT; %A11145800
IF BV THEN STEPIT ELSE LITF(64); %A11145900
BV ~ QUOTETOG ~ TRUE; %A11146000
IF SLT THEN BEGIN %A11146100
ECR(STKC,CRF); %A11146200
T ~ LC ~ LC + 1 END ELSE %A11146300
IF SL ! 1 THEN EC(SL,BNS) ELSE BV ~ FALSE; %A11146400
K ~ 8 - N; %A11146500
WHILE K < 7 DO BEGIN %A11146600
EC(GITA(R,K),TNE); %A11146700
EC(2|(K-7),JFC); K ~ K+1 END; %A11146800
EC(R.[42:6],TEQ); %A11146900
IF BV THEN EC(3,JNC) ELSE EJ(JFC); %A11147000
EC(1,SFS); %A11147100
IF BV THEN BEGIN EC(0,ENS); %A11147200
EC(1,JFW); EJ(JFW); %A11147300
IF SLT THEN BEGIN R ~ LC; %A11147400
LC ~ T - 1; EC(R-T,BNS); LC ~ R END %A11147500
END; %A11147600
IF SLT THEN EMITO(DUP); %A11147700
EXIT: %A11147800
END OF AMONG; %A11147900
% %A11148000
PROCEDURE BITPRIM(BV,V,DSV); VALUE BV,V,DSV; %A11148100
BOOLEAN BV,V; REAL DSV; %A11148200
BEGIN LABEL EXIT; %A11148300
SP ~ 0; SPT ~ FALSE; %A11148400
IF BV THEN STEPIT ELSE %A11148500
IF STEPI ! LEFTPAREN THEN BEGIN %A11148600
SLT ~ FALSE; SL ~ 1 END ELSE %A11148700
BEGIN QUOTETOG ~ FALSE; STEPIT; %A11148800
IF LITP(SL) THEN BEGIN %A11148900
IF SL > 64 OR SL = 0 THEN BEGIN %A11149000
FLAG(701); ERRORTOG~TRUE; SL ~ 1 END ; %A11149100
SLT ~ FALSE END ELSE %A11149200
BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); %A11149300
SLT ~ TRUE; END; %A11149400
IF ELCLASS = COMMA THEN BEGIN %A11149500
SPT ~ SLT; SP ~ SL; STEPIT; %A11149600
IF LITP(SL) THEN BEGIN SLT ~ FALSE; %A11149700
IF SL > 64 OR SL = 0 THEN BEGIN %A11149800
FLAG(701); ERRORTOG~ TRUE; SL~ 1 END; %A11149900
END ELSE %A11150000
BEGIN AEXP; EMITO(SSP); %A11150100
EMITPAIR(JUNK,IF SPT THEN ISD ELSE ISN); %A11150200
SLT ~ TRUE END END; %A11150300
QUOTETOG ~ TRUE; %A11150400
IF ELCLASS = RTPAREN THEN STEPIT ELSE BEGIN %A11150500
ERR(104); GO EXIT END; %A11150600
END; %A11150700
IF SPT THEN BEGIN EMITO(DUP); %A11150800
IF SLT THEN BEGIN EMITV(JUNK); EMITO(ADD); %A11150900
EMITV(JUNK); EMITO(XCH); %A11151000
END ELSE %A11151100
IF SL ! 0 THEN BEGIN %A11151200
EMITL(SL); EMITO(ADD); END %A11151300
END ELSE %A11151400
IF SLT THEN BEGIN EMITO(DUP); %A11151500
IF SP ! 0 THEN BEGIN EMITL(SP); EMITO(ADD) END ; %A11151600
END; %A11151700
IF SPT THEN BEGIN %A11151800
ECR(STKC,CRF); %A11151900
EC(0,IF DSV = TRS THEN BSD ELSE BSS); %A11152000
END ELSE %A11152100
IF SP ! 0 THEN %A11152200
EC(SP,IF DSV = TRS THEN BSD ELSE BSS); %A11152300
IF SLT THEN BEGIN %A11152400
ECR(STKC,CRF); %A11152500
IF DSV = TRS THEN EC(0,IF V THEN BIS ELSE BIR) ELSE %A11152600
BEGIN EC(6,BNS); %A11152700
EC(REAL(V),TIB); EC(3,JNC); %A11152800
EC(1,BSS); EC(0,ENS); %A11152900
EC(1,JFW); EJ(JFW); %A11153000
END END ELSE %A11153100
IF DSV = TRS THEN %A11153200
EC(SL,IF V THEN BIS ELSE BIR) ELSE %A11153300
BEGIN %A11153400
IF SL ! 1 THEN %A11153500
EC(SL,BNS); EC(REAL(V),TIB); %A11153600
IF SL = 1 THEN EJ(JFC) ELSE EC(3,JNC); %A11153700
EC(1,BSS); %A11153800
IF SL ! 1 THEN BEGIN EC(0,ENS); %A11153900
EC(1,JFW); EJ(JFW); END; %A11154000
END; %A11154100
IF DRT OR (SLT~ SLT OR SPT) THEN BEGIN %A11154200
IF NOT SLT THEN EMITL(SP+SL); %A11154300
IF DRT THEN BEGIN EMITV(DR); EMITO(ADD) END ELSE %A11154400
IF DR ! 0 THEN BEGIN EMITNUM(DR); EMITO(ADD) END; %A11154500
IF NOT DRT THEN DR ~ FORAD; DRT ~ TRUE; %A11154600
EMITPAIR(DR,ISD) END ELSE %A11154700
DR ~ DR + SP + SL; %A11154800
EXIT: %A11154900
END OF BITPRIM; %A11155000
% %A11155100
PROCEDURE BITXP(BV,V,DSV); VALUE BV,V,DSV; REAL DSV; %A11155200
BOOLEAN BV,V; %A11155300
BEGIN %A11155400
REAL DRO,R; BOOLEAN DRTO; LABEL EXIT; %A11155500
DRO~DR; DRTO~DRT; %A11155600
DRT ~ FALSE; DR ~ 0; %A11155700
BITPRIM(BV,V,DSV); %A11155800
WHILE ELCLASS = ADOP DO BEGIN %A11155900
SLT ~ FALSE; %A11156000
IF BV ~ STEPI = LITNO THEN BEGIN %A11156100
IF SL ~ ELBAT[I].ADDRESS > 64 OR SL = 0 THEN BEGIN %A11156200
FLAG(701); ERRORTOG ~ TRUE; SL ~ 1 END; %A11156300
STEPIT END; %A11156400
IF ELCLASS ! STRTRNS OR %A11156500
(R ~ ELBAT[I].INCR ! 5 AND R ! 6) THEN %A11156600
BEGIN ERR(702); GO EXIT END; %A11156700
BITPRIM(BV,R=5,DSV); %A11156800
END; %A11156900
IF SLT ~ DRT THEN %A11157000
BEGIN EMITV(DR); EMITL(5); EMITO(ADD); %A11157100
EMITL(6); EMITO(IDV); %A11157200
DCRFR END ELSE %A11157300
SL ~ (DR+5) DIV 6; %A11157400
DR ~ DRO; DRT ~ DRTO; %A11157500
EXIT: END IF BITXP; %A11157600
% %A11157700
REAL R,T; %A11157800
R ~ ELBAT[I].INCR; %A11157900
IF DSV = 1328 THEN BEGIN %A11158000
IF R < 5 THEN BEGIN %A11158100
NLP ~ TRUE; %A11158200
IF V THEN STEPIT ELSE LITF(64); %A11158300
IF SLT THEN BEGIN %A11158400
ECR(STKC,CRF); T ~ LC ~ LC + 1 END ELSE %A11158500
IF SL ! 1 THEN EC(SL,BNS) ELSE NLP ~ FALSE; %A11158600
CASE R OF BEGIN %A11158700
BEGIN %A11158800
EC(12,TEQ); IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11158900
END; %A11159000
BEGIN %A11159100
EC("A",TAN); %A11159200
IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11159300
END; %A11159400
BEGIN %A11159500
EC(0,TEG); %A11159600
IF NLP THEN EC(5,JNC) ELSE EJ(JFC); %A11159700
EC(9,TEL); %A11159800
IF NLP THEN EC(3,JNC) ELSE EJ(JFC); %A11159900
END; %A11160000
BEGIN %A11160100
EC("A",TNE); EC(8,JFC); %A11160200
EC("E",TNE); EC(6,JFC); %A11160300
EC("I",TNE); EC(4,JFC); %A11160400
EC("O",TNE); EC(2,JFC); %A11160500
EC("U",TEQ); %A11160600
IF NLP THEN EC(3,JNC) ELSE EJ(JFC) %A11160700
END; %A11160800
BEGIN %A11160900
EC("A",TAN); %A11161000
IF NLP THEN EC(5,JNC) ELSE EJ(JFC); %A11161100
EC(0,TLS); %A11161200
IF NLP THEN EC(3,JNC) ELSE EJ(JFC); %A11161300
END; %A11161400
END; %A11161500
EC(1,SFS); %A11161600
IF NLP THEN BEGIN %A11161700
EC(0,ENS); EC(1,JFW); EJ(JFW); %A11161800
IF SLT THEN BEGIN R ~ LC; %A11161900
LC ~ T - 1; %A11162000
EC(T ~ R - T,BNS); LC ~ R END; %A11162100
END; %A11162200
IF SLT THEN EMITO(DUP); END ELSE % END OF R<5 PART %A11162300
IF R > 7 THEN BEGIN %A11162400
IF V THEN FLAG(703); %A11162500
STRINGC(DSV,NLP) END ELSE %A11162600
IF R = 7 THEN AMONG(V) ELSE %A11162700
BITXP(V,R=5,1328) %A11162800
END ELSE % END OF = PART %A11162900
IF DSV ! TRS THEN BEGIN %A11163000
IF V OR R < 8 THEN ERR(703) ELSE %A11163100
STRINGC(DSV,NLP) END ELSE %A11163200
BEGIN % TRS PART %A11163300
IF R = 0 THEN BEGIN %A11163400
IF V THEN STEPIT ELSE LITF(64); %A11163500
IF SLT THEN BEGIN %A11163600
EC(STKC,CRF); EMITO(DUP); %A11163700
EC(3,BNS) END ELSE %A11163800
IF SL ! 1 THEN EC(SL,BNS); %A11163900
EC(1,TRP); EMT(12); %A11164000
IF SLT OR SL ! 1 THEN EC(0,ENS); %A11164100
END ELSE %A11164200
IF R = 5 OR R = 6 THEN BITXP(V,R=5,TRS) ELSE %A11164300
IF R < 8 OR V THEN ERR(703) ELSE %A11164400
STRINGC(TRS,NLP); %A11164500
END; %A11164600
END OF STRINGINT; %A11164700
% %A11164800
BOOLEAN PROCEDURE FACTER(BV,DSV,NLP,FACT,P); %A11164900
VALUE BV,DSV,NLP,FACT,P ; %A11165000
BOOLEAN BV,NLP,FACT; REAL DSV,P; %A11165100
BEGIN INTEGER K; %A11165200
LABEL L3,L1,L2,EXIT; %A11165300
QUOTETOG ~ FALSE; %A11165400
IF BV THEN STEPIT ELSE %A11165500
IF TABLE(I+1) = LEFTPAREN THEN LITF(4096) ELSE %A11165600
IF FACTER ~ STEPI ! AMPERSAND AND NLP THEN GO L3 ELSE %A11165700
BEGIN SLT ~ FALSE; SL ~ 1 END; %A11165800
NLP ~ FALSE; %A11165900
QUOTETOG ~ TRUE; %A11166000
IF FACT THEN BEGIN %A11166100
IF SLT THEN BEGIN EMITO(DUP); %A11166200
EMITI(0,36,6); EMITO(XCH); EMITO(DUP); %A11166300
STK ~ STK + 2 END; %A11166400
RCH(SLT,STK,TRUE,STK-1,SL, IF DSV = TRS THEN SFD ELSE SFS) %A11166500
END ELSE %A11166600
BEGIN L1: %A11166700
IF SLT THEN BEGIN %A11166800
IF NOT NLP THEN EMITPAIR(JUNK,SND); %A11166900
EMITO(DUP); %A11167000
EMITI(0,45,3); EMITO(XCH); %A11167100
EMITI(0,39,6); %A11167200
IF NOT NLP THEN EMITV(JUNK); %A11167300
STK ~ STK + 2 END; %A11167400
K ~ 0; %A11167500
IF SLT OR SL} 16 THEN BEGIN %A11167600
IF SLT THEN BEGIN %A11167700
ECR(STK,CRF); %A11167800
EC(IF DSV = TRS THEN 6 ELSE 10,BNS) END ELSE %A11167900
IF K ~ SL DIV 8 = 0 THEN GO L2 ELSE EC(K,BNS); %A11168000
IF DSV = TRS THEN BEGIN %A11168100
EC(8,TRP); EMT(P); EMT(P); EMT(P); EMT(P); %A11168200
END ELSE %A11168300
BEGIN EC(8,BNS); %A11168400
EC(P, DSV.[36:6]); EC(3,JNC); %A11168500
EC(1,SFS); EC(0,ENS); EC(1,JFW); EC(2,JNS); %A11168600
END; %A11168700
EC(0,ENS); %A11168800
IF DSV ! TRS THEN BEGIN %A11168900
EC(1,JFW); EJ( JFW) END; %A11169000
END; %A11169100
L2: %A11169200
IF SLT THEN BEGIN ECR(STK-1,CRF); %A11169300
EC(IF DSV = TRS THEN 3 ELSE 6, BNS); %A11169400
END ELSE %A11169500
IF K ~ SL - K|8 = 0 THEN GO EXIT ELSE %A11169600
EC(K,BNS); %A11169700
IF DSV = TRS THEN BEGIN EC(1,TRP); EMT(P) END ELSE %A11169800
BEGIN EC(P,DSV.[36:6]); EC(3,JNC); EC(1,SFS) END; %A11169900
EC(0,ENS); %A11170000
IF DSV ! TRS THEN BEGIN EC(1,JFW); EJ(JFW) END; %A11170100
END; %A11170200
GO EXIT; %A11170300
L3: %A11170400
IF SLT ~ DLT OR DRT THEN BEGIN %A11170500
IF DLT THEN EMITV(DL) ELSE EMITNUM(DL); %A11170600
IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11170700
EMITO(SUB); %A11170800
IF NOT FACT THEN EMITO(DUP); %A11170900
EMIT(0); EMITO(LSS); %A11171000
IF DSV = TRS THEN EMITERR(SGNO,L," 2"); %A11171100
SLT ~ TRUE; %A11171200
IF DRT EQV NOT DLT THEN BEGIN %A11171300
DRT ~ DLT; DLT ~ NOT DLT END ; %A11171400
END ELSE %A11171500
IF DL <DR THEN FLAG(704) ELSE SL ~ DL - DR; %A11171600
DR ~ DL; %A11171700
IF NOT FACT THEN GO L1; %A11171800
EXIT: QUOTETOG ~ TRUE; %A11171900
END OF FACTER; %A11172000
% %A11172100
PROCEDURE SCANQ(DSV); VALUE DSV; REAL DSV; %A11172200
BEGIN %A11172300
REAL T,R; INTEGER K; BOOLEAN V; %A11172400
R~SL~0; %A11172500
K ~ IF DSV = TRS THEN 63 ELSE 7; %A11172600
DO BEGIN %A11172700
COUNT ~ 0; %A11172800
DO BEGIN CHKND; %A11172900
RESULT ~ 5; SCANNER; CHKND; %A11173000
END UNTIL (V~EXAMIN(NCR)=""") OR COUNT = K; %A11173100
SL ~ SL + COUNT; %A11173200
IF DSV = TRS THEN BEGIN %A11173300
EC(COUNT,TRP); %A11173400
COUNT ~ (R~IF BOOLEAN(COUNT) THEN 2 ELSE 3) + COUNT; %A11173500
DO BEGIN T ~ 0; %A11173600
MOVECHARACTERS(2,ACCUM[1],R,T,6); EMT(T); %A11173700
END UNTIL R ~ R + 2 } COUNT; %A11173800
END ELSE %A11173900
IF COUNT = 1 THEN T ~ ACCUM[1].[18:6] ELSE %A11174000
BEGIN T ~ 0; %A11174100
IF COUNT = 7 THEN R ~ R + 1; %A11174200
MOVECHARACTERS(COUNT,ACCUM[1],3,T,1); %A11174300
EMITNUM(T) END %A11174400
END UNTIL V OR SL > 420; %A11174500
IF V THEN BEGIN COUNT ~ 0; %A11174600
RESULT ~ 5; SCANNER; STEPIT END ELSE BEGIN %A11174700
QUOTETOG ~ FALSE; ERR(705) END; %A11174800
IF DSV > TRS THEN %A11174900
BEGIN %A11175000
IF R = 1 THEN BEGIN %A11175100
ECR(STKC,SED); EC(1,SFD); %A11175200
EC(7,DSV.[42:6]); EJ(JFC) END ELSE %A11175300
IF R > 1 THEN BEGIN %A11175400
ECR(STK+1,SED); EC(R,BNS); %A11175500
EC(1,SFD); EC(7,DSV.[42:6]); %A11175600
EC(2,JNC); EC(0,ENS); EC(1,JFW); %A11175700
EJ(JFW); STK ~ STK + R; %A11175800
END; %A11175900
IF K ~ SL - R | 7 > 1 THEN BEGIN %A11176000
IF R = 0 THEN ECR(STKC,SED) ELSE STKC; %A11176100
EC(1,SFD); EC(K,DSV.[42:6]); %A11176200
EJ(JFC) END ELSE %A11176300
IF K = 1 THEN BEGIN %A11176400
EC(T,DSV.[36:6]); EJ(JFC) ; EC(1,SFS) END; %A11176500
END; %A11176600
SLT ~ FALSE; %A11176700
END OF SCANQ; %A11176800
% %A11176900
PROCEDURE BRKT(DSV); VALUE DSV; REAL DSV; %A11177000
BEGIN %A11177100
REAL DRO,JO,PC,T,R; %A11177200
BOOLEAN DRTO,PCT; %A11177300
LABEL L, EXIT; %A11177400
QUOTETOG~ FALSE; %A11177500
IF STEPI = LITNO THEN %A11177600
IF R ~ ELBAT[I].ADDRESS < 64 AND R > 0 THEN %A11177700
IF TABLE(I+1) = COLON THEN BEGIN %A11177800
STEPIT; PCT ~ FALSE; EC(PC~R,BNS); GO L END; %A11177900
AEXP; EMITO(SSP); %A11178000
PCT ~ TRUE; %A11178100
IF ELCLASS ! COLON THEN BEGIN ERR(706); GO EXIT END; %A11178200
EMITPAIR(PC~FORAD,ISN); %A11178300
ECR(STKC,CRF); R ~ LC ~ LC + 1; %A11178400
L: %A11178500
DRO ~ DR; DRTO ~ DRT; JO ~ JMPCH; %A11178600
DR ~ JMPCH ~ 0; DRT ~ FALSE; QUOTETOG ~ TRUE; %A11178700
STEPIT; STRINGXP(DSV,FALSE); %A11178800
EC(0,ENS); %A11178900
IF PCT THEN BEGIN T ~ LC; %A11179000
LC ~ R - 1; %A11179100
IF R ~ T - R > 63 THEN BEGIN %A11179200
FLAG(707); ERRORTOG~ TRUE;R ~ 1 END; %A11179300
EC(R,BNS); LC ~ T END; %A11179400
IF DSV > TRS THEN BEGIN %A11179500
EC(1,JFW); EMITJUMP(TRUE); %A11179600
JMPCH ~ JO; EJ(JFW) END ; %A11179700
IF SLT ~ DRT OR PCT THEN BEGIN %A11179800
IF DRT THEN BEGIN EMITV(DR); DCRFR END ELSE EMITNUM(DR); %A11179900
IF PCT THEN BEGIN EMITV(PC); DCRFR END ELSE EMITNUM(PC); %A11180000
EMITO(MUL); END ELSE %A11180100
SL ~ DR | PC; %A11180200
DR ~ DRO; %A11180300
DRT ~ DRTO; %A11180400
IF ELCLASS=RTBRKET THEN STEPIT ELSE ERR(715); %A11180500
EXIT: %A11180600
END OF BRKT; %A11180700
% %A11180800
PROCEDURE OTHERS(TR,DSV); VALUE TR,DSV; REAL DSV; %A11180900
BOOLEAN TR; %A11181000
BEGIN LABEL L1; REAL T; %A11181100
BOOLEAN CRFT; LABEL EXIT; %A11181150
QUOTETOG ~ FALSE; %A11181200
SLT ~ TRUE; %A11181300
IF TR THEN IF STEPI = LEFTPAREN THEN STEPIT ELSE ERR(105); %A11181400
IF T ~ EXPRSS = 5 THEN BEGIN %A11181500
FOR T ~ 0 STEP 1 UNTIL 4 DO EMIT(0); %A11181600
EMITO(MKS); EMITV(ATSTRV); %A11181700
ECR(STKC,IF DSV=TRS THEN SES ELSE SED); %A11181800
ECR(STK~STK+4,CRF); %A11181900
IF DSV = TRS THEN BEGIN %A11182000
EC(3,BNS); %A11182100
EC(1,SFS); EC(7,TRS); %A11182200
EC(0,ENS); EC(1,SFS); ECR(STKC,CRF); %A11182300
EC(0,TRS); END ELSE %A11182400
BEGIN EC(6,BNS); %A11182500
EC(1,SFD); EC(7,DSV.[42:6]); %A11182600
EC(2,JNC); EC(0,ENS); %A11182700
EC(1,JFW); EJ(JFW); %A11182800
EC(1,SFD); %A11182900
ECR(STKC,CRF); EC(0,DSV.[42:6]); %A11183000
EJ(JFC) END; %A11183100
END ELSE %A11183200
IF T = BTYPE AND NOT TR THEN BEGIN %A11183300
EMITPAIR(4,BFC); %A11183400
EMITNUM("TRUE000"); EMITL(4); %A11183500
EMITPAIR(2,BFW); %A11183600
EMITNUM("FALSE00"); EMITL(5); %A11183700
L1: %A11183800
EMITO(DUP); %A11183900
IF DSV = TRS THEN BEGIN %A11184000
ECR(STKC,SES); %A11184100
IF CRFT THEN BEGIN ECR(STKC,CRF); EC(0,SFS); END %A11184110
ELSE EC(1,SFS); %A11184120
ECR(STKC,CRF); EC(0,TRS); %A11184200
END ELSE %A11184300
BEGIN ECR(STKC,SED); %A11184400
IF CRFT THEN BEGIN ECR(STKC,CRF); EC(0,SFD); END %A11184410
ELSE EC(1,SFD); %A11184420
ECR(STKC,CRF); EC(0,DSV.[42:6]); %A11184500
EJ(JFC); END END ELSE %A11184600
IF T = ATYPE OR T = BTYPE THEN BEGIN %A11184700
IF ELCLASS = COMMA AND TR THEN BEGIN %A11184710
IF STEPI = LITNO THEN %A11184720
IF TABLE(I+1) = RTPAREN THEN BEGIN SLT ~ FALSE; %A11184730
SL ~ ELBAT[I].ADDRESS; STEPIT; STEPIT; %A11184740
IF SL > 8 THEN FLAG(697); T ~ 8 - SL; %A11184750
IF DSV = TRS THEN BEGIN ECR(STKC,SES); %A11184755
IF T ! 0 THEN EC(T,SFS); EC(SL,TRS) END ELSE %A11184760
BEGIN ECR(STKC,SED); IF T ! 0 THEN EC(T,SFD); %A11184765
EC(SL,DSV.[42:6]); EJ(JFC) END; GO EXIT END; AEXP; %A11184770
EMITL(7); EMITO(LND); EMITPAIR(JUNK,SND); EMITL(8); %A11184775
EMITO(XCH); EMITO(SUB); EMITV(JUNK); %A11184780
CRFT ~ TRUE; GO L1 END; %A11184785
EMIT(0); %A11184800
EMITO(MKS); %A11184900
EMITL(IF TR THEN 3 ELSE 0); %A11185000
EMITV(ARSTV); %A11185100
GO L1 END ELSE %A11185200
ERR(708); %A11185300
IF TR THEN RTPARN; %A11185400
EXIT: %A11185450
QUOTETOG ~ TRUE; %A11185500
END OF OTHERS; %A11185600
PROCEDURE TRANSFORM; %A11185700
BEGIN REAL J,N,LCO; LABEL LE,EXIT; QUOTETOG ~ FALSE; %A11185800
IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11185900
IF STEPI!STRINGID AND ELCLASS!STRINGARRAYID THEN %A11186000
BEGIN ERR(689); GO EXIT END; STRINGVAR(FALSE);% %A11186100
IF SPT OR SLT THEN FLAG(690);% %A11186200
ECR(STKC,RSA); RCH(FALSE,0,FALSE,0,SP,SFS); %A11186300
IF SL > 63 THEN IF SL > 126 OR BOOLEAN(SL) THEN BEGIN %A11186400
ERR(691); GO EXIT END ELSE BEGIN EC(2,BNS);% %A11186500
EC(SL.[41:6],BNS); END ELSE EC(SL,BNS); %A11186600
IF ELCLASS = COMMA AND TABLE(I+1)=STRINGID THEN BEGIN STEPIT; %A11186610
J ~ SL; STRINGVAR(FALSE); EMIT(0); EMIT(0); %A11186620
IF SPT OR SLT OR SP!0 OR SL{63 THEN FLAG(721); %A11186630
ECR(STK~STK+2,SDA); ECR(STKC,SED); EC(7,SFD); %A11186640
EC(1,TRS); ECR(STK-1,RDA); ECR(STK-1,SSA); ECR(STK-2,RSA); %A11186650
ECR(STK,CRF); EC(0,SFS); EC(1,TRS); ECR(STK-1,RSA); EC(0,ENS); %A11186660
SL ~ J; IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104) END %A11186670
ELSE BEGIN % %A11186680
EC("A",TAN); EC(1,JFC); LCO ~ LC; LC ~ LC + 1; %A11186700
EC(" ",TEQ); EC(1,JFC); LC ~ LC + 1; %A11186800
WHILE ELCLASS = COMMA AND N ~ N + 1 { 12 DO BEGIN %A11186900
IF STEPI ! STRNGCON THEN BEGIN LE: ERR(692); GO EXIT END;% %A11187000
EC(C.[42:6],TEQ); EC(3,JFC); EC(1,TRP); %A11187100
IF STEPI ! COLON THEN GO LE; IF STEPI!STRNGCON THEN GO LE; %A11187200
EMT(C.[42:6]); LC ~ LC + 1; STEPIT END; %A11187300
IF ELCLASS=RTPAREN THEN STEPIT ELSE BEGIN ERR(104);GO EXIT END; %A11187400
N ~ N - 1; %A11187500
LC ~ LCO; EC(5 | N + 3,JFW); LC ~ LC + 2; EC(5 | N,JFW); %A11187600
WHILE J ~ J + 1 { N DO BEGIN LC ~ LC + 4; %A11187700
EC((N - J) | 5 + 2,JFW) END; %A11187800
EC(1,TRS); EC(1,JFW); EC(1,SFS); EC(0,ENS); %A11187900
END; % %A11187950
IF SL > 63 THEN EC(0,ENS); %A11188000
EXIT: QUOTETOG ~ TRUE; %A11188100
END OF TRANSFORM; %A11188200
% %A11188300
% %A11188400
REAL R; %A11188500
IF ELCLASS = STRINGID OR ELCLASS = STRINGARRAYID THEN %A11188600
STRINGC(DSV,NLP) ELSE %A11188700
IF ELCLASS = QUOTEOP THEN SCANQ(DSV) ELSE %A11188800
IF ELCLASS = STRINGPROCID THEN BEGIN PROCSTMT(FALSE); %A11188900
IF DSV = TRS THEN BEGIN ECR(STKC,SES); EC(1,SFS); %A11189000
ECR(STKC,CRF); EC(0,TRS) END ELSE %A11189100
BEGIN ECR(STKC,SED); EC(1,SFD); ECR(STKC,CRF); %A11189200
EC(0,DSV.[42:6]) END; EMITO(DUP); SLT ~ TRUE %A11189300
END ELSE %A11189400
IF ELCLASS=FIELDID AND R ~ ELBAT[I].ADDRESS= STRINGV %A11189500
THEN STRINGC(DSV,NLP) ELSE %A11189600
IF ELCLASS = LFTBRKET THEN BRKT(DSV) ELSE %A11189700
IF ELCLASS = LEFTPAREN THEN BEGIN %A11189800
STEPIT; STRINGXP(DSV,FALSE); %A11189900
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11190000
GO L1 END ELSE %A11190100
IF ELCLASS = STRTRNS THEN %A11190200
STRINGINT(FALSE,DSV,NLP) ELSE %A11190300
IF ELCLASS = SPACEV OR ELCLASS = NILV OR ELCLASS = FACTOP %A11190400
THEN BEGIN %A11190500
IF FACTER(FALSE,DSV,NLP,ELCLASS=FACTOP, %A11190600
IF ELCLASS = SPACEV THEN " " ELSE 0) THEN %A11190700
BEGIN IF REAL(NLP) = 3 THEN FLAG(698); GO EXIT END END ELSE %A11190800
IF ELCLASS}BOOARRAYID AND ELCLASS { INTARRAYID THEN %A11190900
STRINGC(DSV,NLP) ELSE %A11191000
IF ELCLASS = LITNO THEN BEGIN %A11191100
IF R ~ TABLE(I+1) = STRTRNS OR R = FACTOP %A11191200
OR R = SPACEV OR R = NILV THEN BEGIN %A11191300
SLT ~ FALSE; SL ~ ELBAT[I].ADDRESS; %A11191400
STEPIT; %A11191500
IF ELCLASS = STRTRNS THEN BEGIN %A11191600
IF SL > 64 OR SL = 0 THEN FLAG(709); %A11191700
STRINGINT(TRUE,DSV,NLP) END ELSE %A11191800
IF FACTER(TRUE,DSV,NLP,R = FACTOP, %A11191900
IF R = SPACEV THEN " " ELSE 0) THEN BEGIN %A11192000
IF REAL(NLP) = 3 THEN FLAG(698); GO EXIT END %A11192010
END ELSE GO L2 END ELSE %A11192100
IF ELCLASS = FILLV THEN BEGIN SLT ~ FALSE; %A11192110
IF DSV ! TRS THEN FLAG(720); %A11192115
IF STEPI = LITNO THEN BEGIN %A11192120
IF SL ~ C > 63 THEN FLAG(709); END ELSE %A11192125
IF ELCLASS=LEFTPAREN THEN BEGIN QUOTETOG ~ FALSE;STEPIT; %A11192130
AEXP; IF NOTCOMMA THEN GO EXIT; QUOTETOG ~ TRUE; %A11192135
EMITPAIR(JUNK,ISN); %T9311192138
IF ELCLASS ! LITNO OR SL ~ C > 8 THEN BEGIN ERR(709); GO %A11192140
EXIT END; ECR(STKC,SES); EC(SL,OCV); EC(SL,SRD); %A11192145
IF STEPI ! RTPAREN THEN FLAG(104) END ELSE %A11192150
FLAG(105); STEPIT; EMIT(0); ECR(STKC,SDA);EC(SL-1,10); %A11192155
ECR(STK,RDA); EC(SL,SFD) END ELSE %A11192160
IF ELCLASS = 0 THEN %A11192200
IF ACCUM[1] = "5OCTAL" THEN BEGIN SLT ~ FALSE; SL ~ 16; %A11192300
IF DSV!TRS THEN BEGIN ERR(687); GO EXIT END;% %A11192400
QUOTETOG ~ SPT ~ FALSE; %A11192500
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11192510
IF (R ~ TABLE(I+1) { INTARRAYID AND R } BOOARRAYID %T9111192515
AND TABLE(I+2) ! LFTBRKET) OR %T9111192520
(R = STRINGID OR R = STRINGARRAYID) THEN BEGIN STEPIT; %T9111192525
STRINGVAR(FALSE); %A11192530
IF SPT OR SLT OR SL ! 8 OR SP!0 THEN FLAG(719); SL~16 END ELSE %A11192535
BEGIN I ~ I - 1; PANA; SPT ~ TRUE END; QUOTETOG ~ TRUE; %A11192540
ECR(STKC,IF SPT THEN SES ELSE RSA); %A11192545
IF NOT SPT THEN IF ELCLASS=RTPAREN THEN STEPIT ELSE %A11192550
BEGIN ERR(104); GO EXIT END; %A11192555
EC(16,BNS); EC(3,BIR); EC(3,BNS); EC(1,TIB); EC(2,JFC); %A11192600
EC(1,BIS); EC(1,JFW); EC(1,BIR); EC(1,BSS); EC(0,ENS); %A11192700
EC(0,ENS) END ELSE %A11192800
IF ACCUM[1] = "5SUBST" AND DSV = TRS THEN TRANSFORM ELSE %A11192900
BEGIN ERR(100); GO EXIT END ELSE %A11193000
IF ELCLASS = DECLARATORS AND R = STRINGV THEN %A11193100
OTHERS(TRUE,DSV) ELSE %A11193200
L2: OTHERS(FALSE,DSV); %A11193300
IF DRT OR SLT THEN BEGIN %A11193400
IF DRT THEN EMITV(DR) ELSE IF DR!0 THEN EMITNUM(DR); %A11193500
IF SLT OR SL!0 THEN BEGIN %A11193600
IF NOT SLT THEN EMITNUM(SL); %A11193700
IF DRT OR DR!0 THEN EMITO(ADD); END; %A11193800
IF NOT DRT THEN BEGIN DRT ~ TRUE; DR ~ FORAD END; %A11193900
END ELSE DR ~ DR + SL; %A11194000
L1: %A11194100
IF NLP AND ELCLASS ! AMPERSAND THEN BEGIN %A11194200
IF DRT OR DLT THEN BEGIN %A11194300
IF DRT THEN EMITPAIR(DR,SND) ELSE EMITNUM(DR); %A11194400
IF DLT THEN EMITV(DL) ELSE EMITNUM(DL); %A11194500
IF REAL(NLP) = 3 THEN BEGIN EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11194510
EMIT(0); EMITO(LSS); EMITERR(SGNO,L," 2") END ELSE %A11194520
IF DSV = TRS THEN BEGIN EMITO(GTR); %A11194600
EMITERR(SGNO,L," 2") END ELSE %A11194700
EMITO(IF DSV=1328 THEN EQL ELSE LEQ) END ELSE %A11194800
IF DSV = TRS THEN BEGIN %A11194900
IF DR > DL THEN ERR(704) END ELSE %A11195000
IF REAL(NLP) ! 3 THEN %A11195050
IF DR ! DL THEN ERR(716); %A11195100
END ELSE IF DRT THEN EMITPAIR(DR,STD); %M11195200
EXIT: %A11195300
END OF STRINGPRIM; %A11195400
% %A11195500
PROCEDURE STRINGXP(DSV,NLP); VALUE DSV,NLP; %A11195600
BOOLEAN NLP; REAL DSV; %A11195700
BEGIN %A11195800
REAL R; %A11195900
IF NLP AND DSV = TRS THEN BEGIN %T9311196000
IF ELCLASS = INTRNSICPROCID THEN %T9311196050
IF R := ELBAT[I].[27:6] } 21 AND R { 23 THEN %T9311196100
FIXCLASS(INTID, %T9311196120
IF R = 21 THEN TABR ELSE %T9311196130
IF R = 22 THEN COLR ELSE INREAL , %T9311196140
FALSE); %T9311196150
IF ELCLASS } REALID AND ELCLASS { INTID THEN %T9311196160
IF TABLE(I+1) = COLON THEN BEGIN %A11196200
CHECKER(R~ELBAT[I]); %A11196300
STEPIT; STEPIT END; END; %T9311196400
I ~ I - 1; %A11196500
DO BEGIN QUOTETOG ~ TRUE; STEPIT; %A11196600
STRINGPRIM(DSV,NLP); %A11196700
END UNTIL ELCLASS ! AMPERSAND; %A11196800
IF NLP THEN %A11196900
IF R ! 0 THEN BEGIN %A11197000
IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11197100
IF R.[9:2] = 2 THEN BEGIN %A11197200
EMITN(R.ADDRESS); EMITO(STD); END ELSE %A11197300
EMITPAIR(R.ADDRESS,STD); END; %A11197400
END OF STRINGXP; %A11197500
% %A11197600
PROCEDURE STRINGVAR(BV); VALUE BV; BOOLEAN BV; %A11197700
BEGIN %A11197800
LABEL L1,L2,L3,L4,EXIT; %A11197900
REAL SPTEMP,SLTEMP,WTYPEO,SLTO,SPTO; %A11197950
BOOLEAN RB; REAL RTYPE; %A11198000
REAL R,T,S,ADR; %A11198100
BOOLEAN NPT,NLT,QO; %A11198200
ADR ~ (R ~ ELBAT[I]).ADDRESS; %A11198300
QO ~ QUOTETOG; QUOTETOG ~ FALSE; %A11198400
IF SYMSEC THEN SYMSEC ~ FALSE ELSE BEGIN %A11198500
IF ELCLASS = STRINGID THEN %A11198600
BEGIN % STRINGID %A11198700
IF BOOLEAN(R.FORMAL) THEN %A11198800
BEGIN % FORMAL %A11198900
IF BOOLEAN(R.VO) THEN %A11199000
BEGIN % FORMAL-VALUE %A11199100
WTYPE ~ 2; SP ~ 1; %A11199200
SPT ~ FALSE; SLT ~ TRUE; %A11199300
EMITN(ADR); EMITV(ADR-1) %A11199400
END ELSE %A11199500
BEGIN % FORMAL-NAME %A11199600
WTYPE ~ 1; EMITPAIR(ADR,LOD); %A11199700
EMITV(ADR-1); EMITV(ADR-2); %A11199800
SPT ~ SLT ~ TRUE %A11199900
END; %A11200000
STEPIT END ELSE %A11200100
IF T ~ TAKE(GIT(R)) < 0 THEN %A11200200
BEGIN % SUBSTRING %A11200300
STEPIT; %A11200400
IF ACCUM[1] = "2IN000" THEN %A11200500
BEGIN STEPIT; %A11200600
IF S ~ T.LINK ! 0 THEN %A11200700
IF S ! ELBAT[I].LINK THEN %A11200800
BEGIN %A11200900
L1: ERR(710); GO EXIT; %A11201000
END; %A11201100
L2: IF ELCLASS ! STRINGID AND ELCLASS ! STRINGARRAYID THEN GO L1; %A11201200
IF BOOLEAN((S ~ ELBAT[I]).FORMAL) THEN GO L1; %A11201300
SPT ~ FALSE; SP ~ 0; SLT ~ FALSE; %A11201400
IF ELCLASS = STRINGID THEN BEGIN %A11201500
IF SL ~ TAKE(GIT(S)) < 0 THEN GO L1; %A11201600
IF SL { 7 THEN BEGIN %A11201700
EMITN(S.ADDRESS); SP ~ 1; WTYPE ~ 2; %A11201800
END ELSE BEGIN %A11201900
EMITPAIR(S.ADDRESS,LOD); WTYPE ~ 4 END; %A11202000
STEPIT; %A11202100
END ELSE %A11202200
BEGIN % STRINGARRAY %A11202300
SL ~ TAKE(TAKE(SL ~ GIT(S)) + SL + 1); %A11202400
SLTEMP ~ SL; % WATCH OUT FOR RECURSION %A11202450
IF ARAY(S,0,TRUE) THEN BEGIN %A11202500
L3:ERR(711); GO EXIT END; %A11202600
SL~SLTEMP;SLT~FALSE; % WATCH OUT FOR RECURSION %A11202650
IF SL { 8 THEN WTYPE ~ 2 ELSE BEGIN %A11202700
EMITO(LOD); WTYPE ~ 4 END; %A11202800
END; %A11202900
IF T.[22:13] + T.[9:13] > SL THEN GO L1; %A11203000
SL ~ T.[9:13]; SP ~ T.[22:13] + SP; %A11203100
END ELSE %A11203200
IF S ~ T.LINK = 0 THEN BEGIN %A11203300
ERR(710); GO EXIT %A11203400
END ELSE BEGIN %A11203500
ELBAT[I ~ I-1] ~ S ~ TAKE(S)& S[35:35:13]; %A11203600
ELCLASS ~ S.CLASS; %A11203700
GO L2 END; %A11203800
END OF SUBSTRING PART ELSE %A11203900
BEGIN % NONFORMAL STRING %A11204000
SLT ~ SPT ~ FALSE; SP ~ 0; %A11204100
IF SL ~ T { 7 THEN BEGIN %A11204200
EMITN(ADR); SP ~ 1; %A11204300
WTYPE ~ 2 END ELSE BEGIN %A11204400
EMITPAIR(ADR,LOD); %A11204500
WTYPE ~ 4 END; %A11204600
STEPIT; %A11204700
END %A11204800
END OF STRING PART ELSE %A11204900
IF ELCLASS = STRINGARRAYID THEN %A11205000
BEGIN %A11205100
IF ARAY(R,0,TRUE) THEN %A11205200
BEGIN IF SL ~ TAKE(TAKE(SL ~ GIT(R)) + SL + 1) { 8 %A11205300
AND BV AND STLB=1 THEN BEGIN SLT~FALSE; GO EXIT END; %A11205400
GO L3 END; %A11205500
IF BOOLEAN(R.FORMAL) THEN %A11205600
BEGIN % FORMAL ARRAY %A11205700
WTYPE ~ 1; EMITV(ADR-1); %A11205800
SLT ~ TRUE; EMITL(8); %A11205900
EMITO(GTR); EMITPAIR(1,BFC); %A11206000
EMITO(LOD); EMITV(ADR-1); %A11206100
SPT ~ FALSE; SP ~ 0; %A11206200
END OF FORMAL PART ELSE %A11206300
BEGIN % NONFORMAL STRING ARRAY %A11206400
IF SL ~ TAKE(TAKE(SL ~ GIT(R)) + SL + 1) { 8 %A11206500
THEN WTYPE ~ 2 ELSE %A11206600
BEGIN %A11206700
EMITO(LOD); WTYPE ~ 4 %A11206800
END; %A11206900
SP ~ 0; %A11207000
SPT ~ SLT ~ FALSE; %A11207100
END %A11207200
END OF STRINGARRAY PART ELSE %A11207300
IF ELCLASS } BOOARRAYID AND ELCLASS { INTARRAYID %A11207400
AND TABLE(I+1) ! LFTBRKET THEN BEGIN %A11207450
IF TAKE (GIT(R))!1 THEN FLAG(684); SP~REAL(SPT~FALSE);% %A11207500
SLT ~ TRUE; EMITPAIR(ADR,LOD); EMITO(DUP); EMITO(MOP); %A11207600
EMITI(0,8,10); EMITL(8); EMITO(MUL); STEPIT; WTYPE~4 END ELSE %A11207700
IF ELCLASS = FIELDID AND ADR = STRINGV THEN %A11207800
BEGIN FIELDC(R,0,FALSE); %A11207900
IF SYMSTK.[46:1] THEN BEGIN WTYPE~2; SYMSTK.[46:1]~FALSE; %A11207950
END ELSE BEGIN RTYPE ~ WTYPE; WTYPE ~ 4; %A11208000
RB ~ ELCLASS ! ASSIGNOP END END %A11208050
ELSE %A11208100
IF ELCLASS = STRTRNS AND R ~ R.INCR > 7 THEN %A11208200
BEGIN %A11208300
IF BOOLEAN(R) THEN %A11208400
BEGIN %A11208500
EMITPAIR(INSTR,LOD); %A11208600
SP ~ 3; SL ~ 61; %A11208700
END ELSE %A11208800
BEGIN %A11208900
EMITPAIR(OUTSTR,LOD); SP ~ 0; %A11209000
SL ~ STRINGMAX ~ MAX(64,STRINGMAX); %A11209100
END; %A11209200
STEPIT; %A11209300
SLT ~ SPT ~ FALSE; WTYPE ~ 4 %A11209400
END ELSE %A11209500
BEGIN %A11209600
ERR(708); GO EXIT %A11209700
END; END; %A11209800
IF BV THEN BEGIN %A11209900
IF WTYPE ! 4 OR SL { 8 OR SP ! 0 %A11210000
OR SPT OR SLT THEN ERR(712); %A11210100
GO EXIT END; %A11210200
IF ELCLASS = LEFTPAREN THEN %A11210300
BEGIN STEPIT; %A11210400
IF NPT ~ LITP(S) THEN %A11210500
BEGIN %A11210600
IF SPT THEN %A11210700
BEGIN %A11210800
IF SLT THEN EMITO(XCH); %A11210900
IF WTYPE ! 4 THEN BEGIN %A11211000
IF S ! 0 THEN BEGIN %A11211100
EMITNUM(S); EMITO(ADD); %A11211200
END; END ELSE %A11211300
BEGIN %A11211400
SP ~ SP + S; %A11211500
IF SP.[35:10]! 0 THEN BEGIN %A11211600
EMITL(SP.[35:10]); EMITO(ADD); END; %A11211700
EMITO(CDC); WTYPE ~ 3; %A11211800
SP ~ SP.[45:3]; SPT ~ FALSE %A11211900
END; %A11212000
IF SLT THEN EMITO(XCH); %A11212100
END ELSE %A11212200
IF SP ~ SP + S } 8 AND WTYPE = 4 THEN %A11212300
BEGIN %A11212400
WTYPE ~ 3; IF SLT THEN EMITPAIR(ST1,STD); %A11212500
EMITL(SP.[35:10]); EMITO(CDC); %A11212600
SP ~ SP.[45:3]; IF SLT THEN EMITV(ST1) %A11212700
END; %A11212800
END ELSE %A11212900
BEGIN IF SLT THEN EMITPAIR(ST1,STD); %A11213000
MOVE(5,SP,SPTEMP); % %A11213050
AEXP; EMITO(SSP); %A11213100
MOVE(5,SPTEMP,SP); % %A11213150
EMITPAIR(JUNK,ISN); %A11213200
IF SPT THEN %A11213300
BEGIN %A11213400
IF WTYPE = 4 THEN %A11213500
BEGIN IF SP ! 0 THEN %A11213600
BEGIN EMITL(SP); EMITO(ADD); END; %A11213700
EMITPAIR(ST2,SND); %A11213800
EMITL(8); EMITO(IDV); %A11213900
EMITO(ADD); EMITO(CDC); %A11214000
WTYPE ~ 3; EMITV(ST2); %A11214100
EMITI(0,45,3); EMITV(JUNK); %A11214200
END ELSE BEGIN EMITO(ADD); %A11214300
IF SLT THEN EMITV(ST1); %A11214400
EMITV(JUNK) END %A11214500
END ELSE %A11214600
BEGIN %A11214700
IF WTYPE = 4 THEN EMITPAIR(ST2,SND) %A11214800
ELSE EMITO(DUP); %A11214900
IF SP ! 0 THEN %A11215000
BEGIN EMITNUM(SP); EMITO(ADD); END; %A11215100
IF WTYPE = 4 THEN %A11215200
BEGIN %A11215300
WTYPE ~ 3; EMITPAIR(ST3,SND); %A11215400
EMITL(8); EMITO(IDV); %A11215500
EMITO(CDC); EMITV(ST3); %A11215600
EMITI(0,45,3); %A11215700
IF SLT THEN EMITV(ST1); %A11215800
EMITV(ST2) %A11215900
END ELSE %A11216000
BEGIN %A11216100
EMITO(XCH); %A11216200
IF SLT THEN %A11216300
BEGIN EMITV(ST1); EMITO(XCH) END %A11216400
END %A11216500
END; %A11216600
SPT ~ TRUE %A11216700
END; %A11216800
IF ELCLASS = RTPAREN THEN %A11216900
BEGIN %A11217000
STEPIT; %A11217100
IF NPT AND S = 0 THEN GO EXIT; %A11217200
IF SLT THEN %A11217300
BEGIN %A11217400
IF NPT THEN EMITNUM(S); %A11217500
L4: EMITO(SUB); EMITO(DUP); %A11217600
EMIT(0); EMITO(LSS); %A11217700
EMITERR(SGNO,L," 1"); %A11217800
END ELSE %A11217900
IF NPT THEN BEGIN %A11218000
IF SL ~ SL-S < 0 THEN %A11218100
BEGIN ERR(713); GO EXIT END %A11218200
END ELSE %A11218300
BEGIN %A11218400
EMITNUM(SL); EMITO(XCH); %A11218500
SLT ~ TRUE; GO L4 %A11218600
END; %A11218700
GO EXIT %A11218800
END OF SP ONLY PART; %A11218900
IF NOTCOMMA THEN GO EXIT; %A11219000
IF NLT ~ LITP(T) THEN %A11219100
BEGIN %A11219200
IF NPT THEN %A11219300
BEGIN %A11219400
IF SLT THEN %A11219500
BEGIN %A11219600
EMITNUM(S + T); EMITO(LSS); %A11219700
EMITERR(SGNO,L," 1"); %A11219800
END ELSE %A11219900
IF T + S > SL THEN %A11220000
BEGIN FLAG(713); ERRORTOG ~ TRUE END %A11220100
END ELSE %A11220200
BEGIN %A11220300
EMITNUM(T); EMITO(ADD); %A11220400
IF SLT THEN EMITO(LSS) ELSE %A11220500
BEGIN EMITNUM(SL); EMITO(GTR) END; %A11220600
EMITERR(SGNO,L," 1"); %A11220700
END; %A11220800
SL ~ T; SLT ~ FALSE %A11220900
END ELSE %A11221000
BEGIN %A11221100
MOVE(5,SP,SPTEMP); % %A11221150
AEXP; EMITO(SSP); %A11221200
MOVE(5,SPTEMP,SP); % %A11221250
EMITPAIR(ST1,ISN); %A11221300
IF NPT THEN EMITNUM(S); EMITO(ADD); %A11221400
IF SLT THEN EMITO(LSS) ELSE %A11221500
BEGIN EMITNUM(SL); EMITO(GTR); END; %A11221600
EMITERR(SGNO,L," 1"); %A11221700
EMITV(ST1); SLT ~ TRUE %A11221800
END; %A11221900
RTPARN; %A11222000
GO EXIT %A11222100
END; %A11222200
IF WTYPE = 4 THEN %A11222300
IF SPT THEN %A11222400
BEGIN SPT ~ FALSE; EMITO(CDC) END ELSE %A11222500
IF SP > 7 THEN BEGIN %A11222600
EMITL(SP.[35:10]); EMITO(CDC); %A11222700
SP ~ SP.[45:3]; %A11222800
WTYPE ~ 3 END; %A11222900
EXIT: IF WTYPE = 3 AND SL < 8 AND NOT SLT %A11223000
THEN WTYPE ~ 2; %A11223100
QUOTETOG ~ QO; %A11223200
IF RB AND ELCLASS = ASSIGNOP THEN BEGIN %A11223300
EMITV(RTYPE ~ RECARRAY[RTYPE].[11:11]); %A11223400
EMITPAIR(6,BFC); EMITV(RTYPE+2); EMITO(SSN); EMITPAIR(RTYPE+2, %A11223500
STD); EMITPAIR(4,BFW); EMITV(RTYPE+1); EMITO(SSN); %A11223600
EMITPAIR(RTYPE+1,STD) END; %A11223700
END OF STRINGVAR; %A11223800
% %A11223900
PROCEDURE STRINGSEC(FROM); VALUE FROM; REAL FROM; %A11224000
BEGIN %A11224100
IF FROM = 1 THEN STRINGVAR(FALSE); %A11224200
IF FROM ! 1 OR ELCLASS = ASSIGNOP THEN %A11224300
BEGIN %A11224400
ARRAY TEDC[0:3,0:127]; %A11224500
BOOLEAN RV; %A11224600
BOOLEAN BV,DLTO,DRTO,DPTO; %A11224700
REAL T,DLO,DRO,DPO,STKO,LCO,WT,JMPCHO; %A11224800
REAL R; %A11224850
LABEL EXIT,L9, L1,L2,L3,L4,L5,L6,L7,L8; %A11224900
SWITCH SW ~ L1,L2,L3,L4,L5,L6,L7,L8; %A11225000
DLTO ~ DLT; DPTO ~ DPT; DRTO ~ DRT; JMPCHO~ JMPCH; %A11225100
STKO~STK; LCO~LC; DLO~DL;DRO~DR; %A11225200
DLT~DPT~DRT~FALSE; %A11225300
DPO~DP; %A11225400
JMPCH~STK~LC~DR~0; %A11225500
MOVECODE(TEDC,EDC); %A11225600
QUOTETOG ~ TRUE; %A11225700
IF FROM > 4 THEN EMITL(REAL(FROM=7)) ELSE %A11225800
IF FROM = 1 AND SLT THEN %A11225900
EMITPAIR(DL~FORAD,STD); %A11226000
IF FROM ! 3 AND NOT SYMSEC THEN EMITO(MKS); %A11226100
GO TO SW[FROM]; %A11226200
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11226210
STEPIT; LC ~ 2; GO L7; %A11226220
L2: STRINGVAR(FALSE); %A11226300
IF SLT THEN EMITPAIR(DL~FORAD,STD); %A11226400
IF ELCLASS ! ASSIGNOP THEN BEGIN ERR(717); GO EXIT END; %A11226500
L1: IF NOT DLT~SLT THEN DL~SL; DP~SP; %A11226600
IF BV ~ (WT~WTYPE=1 AND DPT ~ SPT) THEN %A11226700
EMD(REAL(FROM=1) + 2,1); %A11226800
IF WTYPE > 2 AND NOT SPT THEN DPT ~ BOOLEAN(2); %A11226900
STK ~ REAL(FROM=1) + REAL(BV) + REAL(SPT); %A11227000
IF STEPI = ADOP THEN BEGIN %A11227100
T ~ REAL(DPT) & %A11227200
(STKC) [22:42:6] & %A11227300
(IF ELBAT[I].ADDRESS = ADD THEN FAD ELSE FSV) %A11227400
[41:42:6] & DP[28:35:13]; %A11227500
STEPIT; %A11227600
EMITPAIR(OUTSTR,LOD); %A11227700
ECR(STK,RDA); DP ~ 0; DPT ~ FALSE; %A11227800
STRINGXP(TRS,TRUE) END ELSE %A11227900
BEGIN T ~ 0; %A11228000
ECR(0,RDA); %A11228100
RCH(DPT,1,BV,STK,DP,SFD); %A11228200
IF NOT(DLT OR DPT OR WTYPE < 3 OR DL<32 ) THEN BEGIN %A11228300
IF ELCLASS=SPACEV OR ELCLASS = NILV THEN %A11228400
IF TABLE(I+1)!AMPERSAND AND TABLE(I+1)! LEFTPAREN THEN BEGIN %A11228500
INTEGER J,K,P; %A11228600
P ~ IF ELCLASS = SPACEV THEN " " ELSE 0; %A11228700
EC((T~(8-DP.[45:3]).[45:3])+8,BNS); %A11228800
EC(1,TRP); EMT(P); EC(0,ENS); %A11228900
ECR(0,RSA); %A11229000
IF T!0 THEN EC(0,SFS); %A11229100
J ~ (T~DL-T-8) DIV 8; %A11229200
T ~ T - J|8; %A11229300
IF K ~ J MOD 64 ! 0 THEN EC(K,TRW); %A11229400
IF J ~ J DIV 64 ! 0 THEN BEGIN %A11229500
EC(J,BNS); EC(32,TRW); EC(32,TRW); %A11229600
EC(0,ENS); END ; %A11229700
IF T ! 0 THEN BEGIN %A11229800
EC(T,BNS); EC(1,TRP); %A11229900
EMT(P); EC(0,ENS); END; %A11230000
T ~ 0; STEPIT; %A11230100
END ELSE STRINGXP(TRS,TRUE) ELSE %A11230200
STRINGXP(TRS,TRUE) END ELSE STRINGXP(TRS,TRUE) %A11230300
END; %A11230400
IF T ! 0 THEN BEGIN ECR(0,RDA); %A11230500
RCH(BOOLEAN(T),1,BV,REAL(FROM=1) + 2,T.[29:12],SFD); %A11230600
ECR(T.[22:6],RSA); %A11230700
IF DRT THEN BEGIN EMITV(DR); ECR(STKC,CRF); %A11230800
EC(0,T.[41:6]) END ELSE %A11230900
EC(DR.[42:6],T.[41:6]); END; %A11231000
EMTC; %A11231100
IF FROM = 1 AND DRT THEN EMITV(DR); %A11231200
SL ~ DR; SLT ~ DRT; %A11231300
WTYPE ~ WT; %A11231400
SPT ~ IF T ! 0 THEN BOOLEAN(T.[47:1]) ELSE DPT; %A11231500
SP ~ IF T ! 0 THEN T.[28:13] ELSE DP; %A11231600
GO EXIT; %A11231700
L3: EMIT(0); EMITO(MKS); %A11231800
STRINGSEC(1); %A11231900
IF BV ~ ELCLASS = RELOP THEN GO L9; %A11232000
IF SLT THEN BEGIN EMITPAIR(NSTR,SND); %A11232100
EMITO(DUP); EMITI(0,36,6); %A11232200
STK~ 3 END ELSE %A11232300
BEGIN EMITNUM(SL); EMITPAIR(NSTR,STD); STK ~ 1 END; %A11232400
IF BV ~ (WTYPE = 1 AND SPT) THEN BEGIN %A11232500
EMD(STK+1,1); STK ~ STK + 2; END ELSE %A11232600
STK ~ STK + REAL(SPT AND TRUE); %T9011232700
EMITPAIR(OUTSTR,LOD); %A11232800
ECR(0,RSA); %A11232900
RCH(SPT,1,BV,STK-1,SP,SFS); %A11233000
ECR(STK,RDA); %A11233100
IF SPT OR SP.[45:3] ! 0 OR SLT THEN %A11233200
RCH(SLT,STK-2-REAL(BV),TRUE,STK-1-REAL(BV),SL,TRS) ELSE %A11233300
BEGIN %A11233400
RCH(FALSE,0,FALSE,0,SL.[33:12],TRW); %A11233500
IF SL ~ SL.[45:3]!0 THEN EC(SL,TRS) END; %A11233600
EMTC; EMITV(STRINGPRINT); GO EXIT; %A11233700
L4: %A11233800
EMITPAIR(INSTR,LOD); %A11233900
ECR(0,RDA); %A11234000
EC(DP~3,SFD); %A11234100
DL ~ 31; STK ~ 0; %A11234200
STRINGXP(TRS,TRUE); %A11234300
ECR(0,RDA); EC(2,SFD); %A11234400
IF DRT THEN BEGIN %A11234500
EMITV(DR); %A11234600
EMITPAIR(COUNTI,SND); %A11234700
ECR(STKC,SES); %A11234800
EC(7,SFS); EC(1,TRS); END ELSE %A11234900
BEGIN %A11235000
EMITL(DR.[42:6]); EMITPAIR(COUNTI,STD); %A11235100
EC(1,TRP); EMT(DR.[42:6]) END; %A11235200
EMTC; GO TO EXIT; %A11235300
L5: %A11235400
EMITPAIR(OUTSTR,LOD); %A11235500
ECR(STK~2,RDA); %A11235600
DP ~ 0; DL ~ 8; %A11235700
STRINGXP(TRS,TRUE); %A11235800
ECR(0,SED); %A11235900
ECR(2,RSA); %A11236000
IF DRT THEN BEGIN %A11236100
EMITV(DR); %A11236200
ECR(STKC,CRF); %A11236300
EC(0,ICV); %A11236400
END ELSE %A11236500
EC(DR.[42:6],ICV); %A11236600
EMTC; GO TO EXIT; %A11236700
L6: %A11236800
EMIT(0); %A11236900
ECR(STK~ 2,SED); %A11237000
EC(1,SFD); DP ~ 1; DL ~ 7; %A11237100
STRINGXP(TRS,TRUE); %A11237200
ECR(0,SED); ECR(2,SES); %A11237300
EC(1,SFS); %A11237400
IF DRT THEN BEGIN %A11237500
EMITV(DR); %A11237600
EMITO(DUP); EMITL(8); EMITO(XCH); EMITO(SUB); %A11237700
ECR(STK~STK+2,CRF); %A11237800
EC(0,SFD); ECR(STK-1,CRF); %A11237900
EC(0,TRS); END ELSE %A11238000
BEGIN DR ~ DR.[45:3]; %A11238100
EC(8-DR,SFD); EC(DR,TRS) END; %A11238200
EMTC; GO EXIT; %A11238300
L7: BV ~ FALSE; %A11238400
STRINGSEC(1); %A11238500
IF ELCLASS ! RELOP THEN BEGIN %A11238600
ERR(714); GO EXIT END; %A11238700
L9: %A11238800
T ~ ELBAT[I].[36:12]; STEPIT; %A11238900
JMPCH ~ 0; %A11239000
IF DLT ~ SLT THEN EMITPAIR(DL~FORAD,STD) %A11239100
ELSE DL ~ SL; %A11239200
DP ~ SP; %A11239300
IF RV ~ (WTYPE=1 AND DPT ~ SPT) THEN EMD(4,3); %A11239400
ECR(2,RSA); %A11239500
RCH(DPT,3,RV,4,DP,SFS); %A11239600
IF NOT DPT AND WTYPE > 2 THEN DPT ~ BOOLEAN(2); %A11239700
STK ~ REAL(DPT.[47:1]) + REAL(RV) +2; %A11239800
IF FROM = 9 THEN BEGIN ECR(STKC,STC); EMIT(0); ECR(STK,CRF); %A11239810
EC(0,SFS); END; %A11239820
STRINGXP(IF T = 1393 THEN 1328 ELSE T,IF FROM = 9 THEN %A11239900
BOOLEAN(3) ELSE TRUE); %A11239910
IF FROM ! 9 THEN %A11239950
IF DLT OR DRT THEN DR ~ BUMPL; %A11240000
EMIT(0); L ~ L - 1; %A11240100
IF BV EQV T ! 1393 THEN BEGIN % ! %A11240200
IF FROM = 9 THEN BEGIN EC(1,INC); EC(1,JFW); END %A11240210
ELSE BEGIN EC(REAL(BV),SEC); ECR(0,STC) END; %A11240220
EMITJUMP(FALSE); %A11240230
IF FROM = 9 THEN EC(1,JNS) END ELSE %A11240240
BEGIN %A11240300
EC(2,IF FROM = 9 THEN JNS ELSE JFW); EMITJUMP(FALSE); %A11240400
IF FROM = 9 THEN EC(1,INC) ELSE %A11240500
BEGIN EC(REAL(BV),SEC); ECR(0,STC) END END; %A11240600
IF FROM = 9 THEN BEGIN EC(0,ENS); ECR(0,STC); R ~ LC; LC ~ 0; %A11240700
IF DRT OR DLT THEN BEGIN ECR(STKC,CRF); %A11240710
EMITL(1); EMITO(ADD); %A11240715
IF R > 61 THEN FLAG(604); EC(R-2,BNS) END ELSE %A11240720
BEGIN IF DL - DR > 62 THEN FLAG(699); EC(0,JFW); %A11240730
EC(DL - DR + 1,BNS);END; LC ~ R; %A11240740
IF ELCLASS = COMMA THEN BEGIN IF STEPI!REALID AND ELCLASS!ALFAID%A11240745
THEN BEGIN ERR(718); GO EXIT END; CHECKER(ELBAT[I]); %A11240750
% %A11240755
EMITN(ELBAT[I].ADDRESS); ECR(STKC,RDA); EC(7,SFD); %A11240760
EC(1,TRS); STEPIT END; %A11240765
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104) END; %A11240770
EMTC; %A11240800
IF FROM ! 9 THEN BEGIN %A11240850
IF DRT OR DLT THEN BEGIN %A11240900
DL ~ BUMPL; ADJUST; %A11241000
EMITB(BFC,DR,L); EMITV(XITR); %A11241100
IF BV EQV T = 1393 THEN BEGIN EMITO(DEL); %A11241200
EMITL(REAL(BV)); END; %A11241300
EMITB(BFW,DL,L) END; %A11241400
IF BV THEN EMITV(BOOPRINT); %A11241500
END; %A11241550
GO EXIT; %A11241600
L8: %A11241700
ECR(0,SED); %A11241800
EC(STK~DP~1,SFD); DL ~ 7; %A11241900
STRINGXP(TRS,TRUE); %A11242000
EMTC; %A11242100
IF DRT THEN EMITV(DR) ELSE EMITNUM(DR); %A11242200
EXIT: %A11242300
IF DLT THEN DCRFR; %A11242400
IF DRT THEN DCRFR; %A11242500
DLT ~ DLTO; DPT ~ DPTO; DRT ~ DRTO; %A11242600
JMPCH ~ JMPCHO; STK ~ STKO; LC ~ LCO; %A11242700
DL ~ DLO; DR ~ DRO; %A11242800
MOVECODE(TEDC,EDC); %A11242900
IF FROM ! 1 THEN QUOTETOG ~ FALSE; %A11243000
END %A11243100
END OF STRINGSEC; %A11243200
PROCEDURE NVALINT; %A11243300
BEGIN %A11243400
% %A11243500
PROCEDURE EMITRET; %A11243600
BEGIN REAL A,B,T; %A11243700
IF T ~ PROINFO.CLASS = PROCID THEN STEPIT ELSE %A11243800
IF T < 31 THEN ERR(619) ELSE %A11243900
CASE T - STRINGPROCID OF BEGIN %A11244000
BEGIN QUOTETOG ~ TRUE; STEPIT; STRINGSEC(8); %A11244100
QUOTETOG ~ FALSE; EMITO(XCH); %A11244200
EMITPAIR(TAKE(GIT(PROINFO)).[30:10],STD); END; %A11244300
BEGIN T ~ TAKE(PROINFO.LINK + 1).[2:2]; %A11244400
DBLPLXP(T); EMITPAIR(514,STD); %A11244500
A ~ TAKE(GIT(PROINFO)).[30:10]; %A11244600
T ~ IF T = 2 THEN 2 ELSE 0; %A11244700
FOR B ~ 0 STEP 1 UNTIL T DO EMITPAIR(A+B,STD); %A11244800
EMITV(514) END; %A11244900
BEGIN QUOTETOG ~ TRUE; STEPIT; SEXPN; %A11245000
QUOTETOG ~ FALSE END; %A11245100
BEGIN STEPIT; RECOM( GETYPE (PROINFO)) END; %A11245200
BEGIN STEPIT; BEXP END; %A11245300
BEGIN STEPIT; AEXP END; %A11245400
BEGIN STEPIT; AEXP END; %A11245500
BEGIN STEPIT; AEXP; EMITPAIR(514,ISN); END; END; %A11245600
IF MODE > 0 AND (LEVEL=SUBLEVEL OR SOPG) THEN BEGIN %A11245700
EMIT(RETLIST); EMITO(NOP); RETLIST ~ L; EMITO(NOP); %A11245800
EMITO(NOP); END ELSE %A11245900
BEGIN FLAG(619); ERRORTOG ~ TRUE END %A11246000
END OF EMITRET; %A11246100
% %A11246200
PROCEDURE EMITXIT; %A11246300
BEGIN IF SOPG THEN BEGIN FLAG(620); ERRORTOG ~ TRUE END ELSE %A11246400
BEGIN EMIT(XITLIST); EMITO(NOP); XITLIST ~ L END; %A11246500
STEPIT; END; %A11246600
% %A11246700
PROCEDURE RECLAIMIT; %A11246800
IF STEPI ! LEFTPAREN AND RECLAIMTOG THEN BEGIN %A11246900
EMITO(MKS); EMITV(MARKER); EMITO(MKS); EMITV(COLLECT); END ELSE %A11247000
IF ELCLASS ! LEFTPAREN THEN ERR(105) ELSE %A11247100
BEGIN REAL T,R,S; %A11247200
IF STEPI = RECID OR ELCLASS = RECARRAYID THEN %A11247300
BEGIN %A11247400
REXP; %A11247500
IF RECTYPE ! 0 THEN BEGIN %A11247600
FIXRECORD(RECTYPE,4); %A11247700
RECTYPE ~ 0 END ELSE %A11247800
ERR(612); %A11247900
END ELSE %A11248000
IF NOT RECLAIMTOG THEN BEGIN %A11248100
EMIT(0); SEXPN; %A11248200
EMITO(CTC); %A11248300
IF SYMSTK THEN EMITPAIR(LNKROW,STD) ELSE BEGIN EMITO(DUP); %A11248350
GETCONTENTS(0,TRUE); EMITV(FREELIST); %A11248400
EMITO(XCH); EMITO(STD); %A11248500
EMITPAIR(FREELIST,STD); END; QUOTETOG~FALSE END ELSE %A11248600
ERR(621); %A11248700
IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT; %A11248800
END OF RECLAIMIT; %A11248900
PROCEDURE RECALLIT(ADR); VALUE ADR; REAL ADR; %A11249000
IF STEPI ! LEFTPAREN THEN ERR(105) ELSE %A11249100
IF STEPI ! FILEID OR BOOLEAN(ELBAT[I].FORMAL) THEN %A11249200
ERR(622) ELSE% %A11250000
BEGIN EMITO(MKS); %A11250100
EMITPAIR(ELBAT[I].ADDRESS,LOD); %A11250200
EMITV(IF BOOLEAN(ADR) THEN REMEMBER ELSE RECALL); %A11250300
IF STEPI = RTPAREN THEN STEPIT ELSE %T9311250400
IF ELCLASS = COMMA THEN BEGIN I:=I-3; %T9311250402
IF BOOLEAN(ADR) THEN WRITESTMT ELSE READSTMT END ELSE %T9311250404
ERR(104); %T9311250406
END OF RECALLIT; %A11250500
PROCEDURE ADDPROP; %A11250600
BEGIN LABEL EXIT; REAL T; %A11250700
LABEL L; %A11250800
IF STEPI! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11250900
EMITO(MKS); QUOTETOG ~ TRUE; %A11251000
STEPIT ; SEXPN; %A11251100
MARKSYMNCR(1); %A11251200
IF ELCLASS ! COMMA THEN BEGIN %A11251300
L: ERR(606); GO EXIT END; %A11251400
QUOTETOG ~ TRUE; %A11251500
IF STEPI = FACTOP THEN BEGIN %A11251600
EMITL(4); EMIT(0); QUOTETOG ~ FALSE; %A11251700
IF STEPI ! COMMA THEN GO L; %A11251800
STEPIT; AEXP; T~ 1 END ELSE %A11251900
IF ELCLASS = DECLARATORS AND %A11252000
T ~ ELBAT[I].ADDRESS > 29 THEN BEGIN %A11252100
IF STEPI ! COMMA THEN GO L; %A11252200
QUOTETOG ~ FALSE;EMITL(2); EMITL(T); %A11252300
STEPIT; RECOM(T); T ~ 1 END ELSE %A11252400
BEGIN EMIT(0); SEXPN; MARKSYMNCR(1); %A11252500
QUOTETOG ~ TRUE; %A11252600
IF ELCLASS ! COMMA THEN GO L; STEPIT; %A11252700
SEXPN; MARKSYMNCR(1); QUOTETOG~ FALSE; %A11252800
T ~ 3 END; %A11252900
EMITV(ADDPROPA); MARKSYMDCR(-T); %A11253000
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11253100
EXIT: QUOTETOG ~ FALSE; %A11253200
END OF ADDPROP; %A11253300
PROCEDURE REMPROP; %A11253400
BEGIN LABEL EXIT; %A11253500
REAL T; %A11253600
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11253700
QUOTETOG ~ TRUE; %A11253800
EMITO(MKS); STEPIT; SEXPN; %A11253900
IF ELCLASS ! COMMA THEN BEGIN %A11254000
ERR(606); GO EXIT END; %A11254100
QUOTETOG ~ TRUE; %A11254200
IF STEPI = FACTOP THEN BEGIN %A11254300
EMITL(1); EMITL(3); QUOTETOG ~ FALSE; %A11254400
STEPIT; END ELSE %A11254500
IF ELCLASS = DECLARATORS AND %A11254600
T ~ ELBAT[I].ADDRESS > 29 THEN BEGIN %A11254700
EMIT(0); EMITNUM(T&1[32:47:1]); %A11254800
QUOTETOG ~ FALSE; STEPIT END ELSE %A11254900
BEGIN EMIT(0); SEXPN; QUOTETOG ~ FALSE END; %A11255000
EMITV(REMPROPER); %A11255100
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11255200
EXIT: QUOTETOG ~ FALSE %A11255300
END OF REMPROP; %A11255400
PROCEDURE PRINTER(TERPRI); VALUE TERPRI; BOOLEAN TERPRI; %A11255500
BEGIN LABEL NEXT,EXIT; %A11255600
LABEL L1; %A11255700
INTEGER TCOUNT,V,R,T; %A11255800
DEFINE FORMTOG = PRINFORM#; %A11255900
BOOLEAN BL,B,DP; %A11256000
PRINTOG ~ TRUE; %A11256100
PRINFORM ~ PRINFORM AND BOOLEAN(8188); %A11256200
IF STEPI = DECLARATORS THEN BEGIN %A11256300
IF T ~ ELBAT[I].ADDRESS=DOUBLEV THEN DP ~ DPTOG ~ TRUE ELSE %A11256400
IF T = FORMATV THEN FORMTOG ~ FORMTOG OR TRUE ELSE %A11256500
BEGIN ERR(638); GO EXIT END; STEPIT END; %A11256600
IF FORMTOG THEN %A11256700
BEGIN IF T ~REAL(PRINFORM.[35:11]) = 0 THEN %A11256800
PRINFORM.[36:11] := BOOLEAN(T:=GETSPACE(TRUE,-1)); %T9311256900
IF ELCLASS = LFTBRKET THEN BEGIN I ~ I - 1; BANA; %A11257000
EMITPAIR(T,STD); END; END; %A11257100
NEXT: IF ELCLASS = IFV THEN BEGIN IFCLAUSE; T ~ BUMPL; %A11257200
I~I-1;PRINTER(FALSE); IF ELCLASS=ELSEV THEN BEGIN %A11257300
EMITB(BFC,T,T~BUMPL); PRINTER(FALSE); EMITB(BFW,T,L) END ELSE %T9011257400
EMITB(BFC,T,L); END; EMITO(MKS); %A11257500
IF FORMTOG THEN IF FORMTOG.[46:1] THEN BEGIN %A11257600
IF TERPRI THEN %A11257605
IF (ELCLASS } UNTILV AND ELCLASS { ENDV) OR %A11257610
ELCLASS = RTBRKET OR ELCLASS = SEMICOLON THEN GO EXIT; %A11257620
EMITV(T~REAL(FORMTOG.[35:11])); EMITV(CP); EMITV(T); %A11257700
EMITO(RDV); EMITO(SUB); EMITV(SPACEPRINT); EMITO(MKS); END %A11257800
ELSE FORMTOG ~ FORMTOG OR BOOLEAN(2); %A11257900
IF ELCLASS=COMMA THEN BEGIN IF TABLE(I+1)=MULOP THEN BEGIN %A11258000
EMITV(TERPRIN); STEPIT END ELSE BEGIN EMITL(" "); %A11258100
EMITV(CHARPRINT); END; STEPIT; GO TO NEXT END; %A11258200
IF ELCLASS = CROSSHATCH THEN BEGIN %A11258300
TCOUNT ~ COUNT ~ 0; CHKND; RESULT ~ 5; %A11258400
SCANNER; %A11258500
IF V ~ EXAMIN(NCR) = "#" THEN BEGIN EMITL(ACCUM[1].[18:6]); %A11258600
RESULT ~ 5; SCANNER; STEPIT; %A11258700
EMITV(CHARPRINT); GO TO NEXT END; BL ~ FALSE; %A11258800
CHKND; EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %A11258900
GO TO L1; %A11259000
DO BEGIN COUNT ~ 0; %A11259100
L1: DO BEGIN B~BL; RESULT ~ 5; SCANNER; CHKND; %A11259200
IF (BL ~ V ~ EXAMIN(NCR)=" ") AND B THEN BEGIN %A11259300
DO BEGIN RESULT ~ 5; SCANNER; CHKND; %A11259400
COUNT ~ COUNT -1 END UNTIL V ~ EXAMIN(NCR)!" "; %A11259500
BL ~ FALSE END %A11259600
END UNTIL V = "#" OR COUNT = 63; %A11259700
TCOUNT ~ TCOUNT + COUNT; %A11259800
EMITC(COUNT,TRP); %A11259900
COUNT~(R~IF BOOLEAN(COUNT) THEN 2 ELSE 3) + COUNT; %A11260000
DO BEGIN T ~ 0; %A11260100
MOVECHARACTERS(2,ACCUM[1],R,T,6); %A11260200
EMIT(T); END UNTIL R~R+2 } COUNT; %A11260300
END UNTIL V = "#" OR TCOUNT = 896; %A11260400
EMITC(1,0); STREAMTOG ~ FALSE; %A11260500
IF V = "#" THEN BEGIN COUNT~0; RESULT~5; SCANNER; STEPIT END %A11260600
ELSE BEGIN ERR(623); GO EXIT END; %A11260700
STRINGMAX ~ MAX(TCOUNT,STRINGMAX); %A11260800
EMITL(TCOUNT); EMITPAIR(NSTR,STD); EMITO(MKS); %A11260900
EMIT(0); EMITV(STRINGPRINT) END ELSE %A11261000
IF (ELCLASS = FIELDID AND ELBAT[I].ADDRESS = STRINGV) OR %A11261100
(ELCLASS= STRTRNS AND ELBAT[I].INCR>7) OR %A11261200
ELCLASS = STRINGV OR ELCLASS = FILLV OR %T9011261250
ELCLASS = STRINGID OR ELCLASS = STRINGARRAYID THEN %A11261300
STRINGSEC(3) ELSE %A11261400
IF ELCLASS = SPACEV THEN BEGIN %A11261500
IF STEPI = LEFTPAREN THEN BEGIN I ~ I-1; PANA; EMITV(SPACEPRINT) %A11261600
END ELSE BEGIN EMITL(" "); EMITV(CHARPRINT) END END ELSE %A11261700
IF Q ~ ACCUM[1] = "5QMARK" THEN BEGIN STEPIT; EMITL(12); %A11261800
EMITV(CHARPRINT); END ELSE %A11261900
IF Q = "4SKIP0" THEN BEGIN PANA; %A11262000
EMITV(CP); EMITO(SUB); EMITV(SPACEPRINT); END ELSE %A11262100
IF (ELCLASS } UNTILV AND ELCLASS { ENDV) OR %A11262200
ELCLASS = RTBRKET OR %A11262300
ELCLASS = SEMICOLON THEN GO EXIT ELSE %A11262400
IF ELCLASS = ALFAID OR ELCLASS = ALFAARRAYID OR ELCLASS = ALFAPROCID %A11262500
OR ELCLASS=STRNGCON THEN BEGIN AEXP; EMITV(ALFPRINT) END ELSE %A11262600
IF Q = "2RL000" THEN BEGIN EMITO(MKS); EMITNUM("{!"); %A11262610
EMITV(ALFPRINT); STEPIT END ELSE %A11262620
BEGIN %A11262700
IF T ~ EXPRSS > 29 THEN BEGIN EMITO(MKS); %A11262800
MKALF(RECARRAY[T]); EMITV(ALFPRINT); %A11262900
EMITO(MKS); EMITL("-"); EMITV(CHARPRINT); %A11263000
EMIT(0); EMITV(ARITHPRINT); %A11263050
RECTYPE ~ 0 END ELSE %A11263100
IF T = DTYPE THEN BEGIN ERR(638); GO EXIT END ELSE %A11263200
CASE T OF BEGIN ERR(638); %A11263300
EMITV(BOOPRINT); %A11263400
ERR(638); %A11263500
BEGIN EMITL(REAL(FORMTOG)); EMITV(ARITHPRINT) END; %A11263600
ERR(638); %A11263700
EMITV(SYMPRINT); %A11263800
BEGIN EMITL(REAL(FORMTOG)); EMITV(DBLPRINT) END; %A11263900
EMITV(PLXPRINT); %A11264000
EMITV(DBLPLXPRINT); END; END; %A11264100
QUOTETOG ~ FALSE; %A11264200
DPTOG ~ DP ; GO NEXT ; %A11264300
EXIT: DPTOG ~ PRINTOG~ FALSE; %A11264400
IF TERPRI THEN EMITV(TERPRIN) ELSE L ~ L - 1; %A11264500
END OF PRINTER; %A11264600
PROCEDURE DONTS; %A11264700
BEGIN LABEL L,EXIT; BOOLEAN BV; REAL ADR; %A11264800
DPTOG~ TRUE; %A11264900
IF STEPI ! LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11265000
IF STEPI = FACTOP THEN BEGIN %A11265100
IF STEPI = FACTOP THEN BEGIN STEPIT; ADR ~ DBLSIG END ELSE %A11265200
ADR ~ SNGLSIG; %A11265300
L: IF ELCLASS ! COMMA THEN BEGIN ERR(606); GO EXIT END; %A11265400
DPTOG ~ FALSE; STEPIT; %A11265500
AEXP; EMITO(SSP); EMITO(DUP); EMITL(1); %A11265600
EMITO(LSS); EMITPAIR(2,BFC); EMITO(DEL); %A11265700
EMITL(1); EMITPAIR(ADR,IF BV THEN ISN ELSE ISD); %A11265800
IF BV THEN BEGIN EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11265900
EMITV(NTSER) END END ELSE %A11266000
BEGIN EMITO(MKS); DBLXP; BV ~ TRUE; %A11266100
ADR ~ JUNK; GO L END; %A11266200
IF ELCLASS = RTPAREN THEN STEPIT ELSE ERR(104); %A11266300
EXIT: DPTOG ~ FALSE; %A11266400
END OF DONTS; %A11266500
PROCEDURE INPUTER; %A11266600
BEGIN LABEL EXIT,MARG,L1,LW,L2,L3; %A11266700
LABEL BF,SF; %BARRY FOLSOM LOVES SUSIE FOLSOM %T9311266750
BOOLEAN DACOM; %A11266800
REAL R; %A11266900
INOUTUSED.[44:1] ~1; % INPUT %A11267000
IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11267100
IF STEPI = LABELID THEN BEGIN DAC[0] ~ GNAT(ELBAT[I]); %A11267200
IF ELBAT[I].LVL ! 1 THEN FLAG(650); STEPIT END ELSE BEGIN %A11267300
IF ELCLASS = BOOID THEN %T9011267310
BEGIN DAC[22] ~ ELBAT[I].ADDRESS; %T9011267320
IF ELBAT[I].LVL ! 1 THEN FLAG(650); %T9011267330
STEPIT; %T9011267340
GO BF; %T9011267345
END ELSE %T9011267350
IF ELCLASS = FACTOP THEN GO MARG ELSE %T9311267400
%T9311267500
%T9311267600
IF ELCLASS = MULOP THEN GO LW; %A11267700
EMITL(1); EMITPAIR(INITI,STD); %A11267800
IF ELCLASS =FILEID THEN %A11267900
IF DAC[1] ! 0 THEN %T9011268000
BEGIN IF DACOM ~ ELBAT[I].LINK = DACP.LINK THEN %T9011268010
BEGIN IF DACOMI = 0 THEN DACOMI := GETSPACE(TRUE,-6); %T9311268020
IF DAC[3] = 0 THEN %T9011268030
BEGIN DAC[3] := GETSPACE(TRUE,-1); %T9311268040
DAC[4] := GETSPACE(TRUE,-1); %T9311268050
END; %T9011268060
EMITL(1); %T9011268070
END ELSE EMITL(0); %T9011268100
EMITPAIR(DAC[8],SND); %T9011268200
END ELSE EMIT(0) ELSE %T9011268300
IF ELCLASS = BOOPROCID THEN BEGIN EMITL(1); %A11268400
IF TAKE(GIT(ELBAT[I])).[40:8] ! 0 THEN GO L1 %A11268500
END ELSE %A11268600
BEGIN L1: ERR(624); GO EXIT END; %A11268700
EMITPAIR(PROI,STD); %A11268800
IF ELBAT[I].LVL ! 1 THEN FLAG(624); %A11268900
ERRORTOG ~ TRUE; %A11269000
R ~ ELBAT[I].ADDRESS; %A11269100
IF DACOM THEN BEGIN DAC[7]~ R; EMITL(DACOMI) END ELSE EMITL(R); %A11269200
EMITPAIR(FILPROI,STD); %A11269300
STEPIT; %A11269400
IF NOTCOMMA THEN GO EXIT; %A11269500
IF ELCLASS ! STRINGID OR %A11269600
(R~ELBAT[I]).LVL ! 1 OR %A11269700
BOOLEAN(R.FORMAL) OR %A11269800
R ~ TAKE(GIT(R)) < 0 THEN %A11269900
BEGIN ERR(625); GO EXIT END; %A11270000
IF DACOM THEN BEGIN IF DAC[5]=0 THEN DAC[5]~ELBAT[I].ADDRESS %A11270100
ELSE IF DAC[5] ! ELBAT[I].ADDRESS THEN FLAG(694);% %A11270200
EMITL(DAC[5]); EMITPAIR(STRI,STD); %A11270300
END; IF FALSE THEN BEGIN %T9011270350
DAC[6] ~ IF R > 136 THEN 136 ELSE R; %T9011270400
IF STEPI=COMMA AND TABLE(I+1)= LITNO THEN BEGIN STEPIT; %A11270500
IF R{R ~ ELBAT[I].ADDRESS THEN FLAG(649); EMITL(R); %T9011270600
STEPIT END ELSE EMIT(0); EMITPAIR(LMARGI,SND); %A11270700
EMITPAIR(RMARGI,SND); EMITPAIR(CPI,STD) END ELSE BEGIN %A11270800
EMITL(ELBAT[I].ADDRESS); %A11270900
EMITPAIR(STRI,STD); STEPIT; %A11271000
IF NOTCOMMA THEN GO EXIT; AEXP; EMITO(SSP); %A11271100
EMITO(DUP); EMITNUM(R); %A11271200
EMITO(GTR); EMITERR(SGNO,L," 5"); %A11271300
IF ELCLASS=RTPAREN THEN BEGIN EMITPAIR(RMARGI,SND); %A11271400
EMITPAIR(CPI,SND); EMIT(0); EMITPAIR(LMARGI,STD) END; %A11271500
EMITL(7); EMITO(ADD); EMITL(8); %A11271600
EMITO(IDV); EMITPAIR(LGI,STD); %A11271700
IF ELCLASS = RTPAREN THEN GO L2; %A11271800
MARG: %A11271900
IF NOTCOMMA THEN GO EXIT; %A11272000
IF ELCLASS = MULOP THEN GO LW; %A11272100
AEXP; EMITO(SSP); EMITPAIR(LMARGI,ISN); %A11272200
IF DACOM THEN BEGIN EMITV(DAC[6]); EMITO(GTR); GO SF END; %T9311272250
IF NOTCOMMA THEN GO EXIT; %A11272300
AEXP; EMITO(SSP); EMITPAIR(RMARGI,ISN); %A11272400
EMITPAIR(CPI,SND); %A11272500
EMITO(GTR); EMITV(RMARGI); %A11272600
% %A11272700
EMITV(LGI); EMITL(8); EMITO(MUL); %A11272800
EMITO(GTR); EMITO(LOR); %A11272900
SF: EMITERR(SGNO,L," 7"); %T9311273000
IF DACP.LINK!0 THEN BEGIN EMIT(0); EMITPAIR(DAC[1],STD) %A11273100
END END END; %A11273200
IF ELCLASS = RTPAREN THEN GO L2; %A11273300
IF NOTCOMMA THEN GO EXIT; %A11273400
IF ELCLASS ! MULOP THEN GO L3; %A11273500
LW: STEPIT; BEXP; %A11273600
EMITPAIR(WSIGN,STD); %A11273700
BF: IF ELCLASS = RTPAREN THEN L2: STEPIT ELSE %T9011273800
L3: ERR(104); %A11273900
EXIT: %A11274000
END OF INPUTER; %A11274100
PROCEDURE OUTPUTER; %A11274200
BEGIN LABEL EXIT, MARG,L1,L2; %A11274300
LABEL BF; %T9011274350
BOOLEAN DACOM; %A11274400
REAL R; %A11274500
INOUTUSED.[46:1] ~1; %OUTPUT %A11274600
IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11274700
IF STEPI = BOOID THEN BEGIN %A11274800
GPBV ~ ELBAT[I].ADDRESS; IF ELBAT[I].LVL!1 THEN FLAG(650); %A11274900
STEPIT; GO BF END ELSE BEGIN IF ELCLASS = FACTOP THEN %T9011275000
GO MARG; %T9311275100
%T9311275200
EMIT(0); EMITPAIR(OUTOG,STD); %A11275300
IF ELCLASS = FILEID THEN %A11275400
IF DAC[8] ! 0 THEN %T9011275500
BEGIN IF DACOM ~ ELBAT[I].LINK = DACP.[22:13] THEN %T9011275600
BEGIN GTLSTAT; EMITL(1); END ELSE EMITL(0); %T9011275700
EMITPAIR(DAC[8],SND); %T9011275800
END ELSE EMIT(0) ELSE %T9011276500
IF ELCLASS = PROCID THEN BEGIN EMITL(1); %A11276600
IF TAKE(GIT(ELBAT[I])).[40:8] ! 0 THEN %A11276700
GO L1 END ELSE %A11276800
BEGIN L1: ERR(624); GO EXIT END; %A11276900
EMITPAIR(PROTOG,STD); %A11277000
IF ELBAT[I].LVL ! 1 THEN FLAG(624); %A11277100
ERRORTOG ~ TRUE; %A11277200
R ~ ELBAT[I].ADDRESS; %A11277300
IF DACOM THEN BEGIN DAC[13]~R; EMITL(DACOMO) END ELSE EMITL(R); %A11277400
EMITPAIR(FILPRO,STD); %A11277500
STEPIT; %A11277600
IF NOTCOMMA THEN GO EXIT; %A11277700
IF ELCLASS ! STRINGID OR (R ~ ELBAT[I]).LVL ! 1 OR %A11277800
BOOLEAN(R.FORMAL) OR R ~ TAKE(GIT(R))<0 THEN %A11277900
BEGIN ERR(625); GO EXIT END; %A11278000
IF FALSE THEN BEGIN % IF DACOM THEN BEGIN %T9011278100
IF DAC[14]=0 THEN DAC[14] ~ ELBAT[I].ADDRESS ELSE %A11278200
IF DAC[14]! ELBAT[I].ADDRESS THEN FLAG(651); %A11278300
EMITL(DAC[14]); EMITPAIR(STRP,STD); %A11278400
DAC[15] ~ IF R > 136 THEN 136 ELSE R; % %T9011278500
IF DAC[2] = 0 THEN DAC[2] := GETSPACE(TRUE,-1); %T9311278530
EMIT(0); EMITPAIR(DAC[2],STD); % %T9011278560
EMITL(R); EMITPAIR(RMARG,STD); %A11278600
IF STEPI = COMMA AND TABLE(I+1)=LITNO THEN BEGIN STEPIT; %A11278700
IF R{R ~ ELBAT[I].ADDRESS THEN FLAG(693); STEPIT END ELSE% %A11278800
R ~ 0; EMITL(R); EMITPAIR(LMARG,SND); EMITPAIR(CP,STD); %A11278900
IF ELCLASS=COMMA THEN BEGIN %A11279000
IF STEPI ! LABELID OR ELBAT[I].LVL ! 1 THEN FLAG(654) ELSE %A11279100
BEGIN DAC[11] ~ GNAT(ELBAT[I]); STEPIT; GT1 ~ SCANR END; %A11279200
IF ELCLASS = COMMA THEN %A11279300
IF STEPI ! LABELID OR ELBAT[I].LVL ! 1 THEN FLAG(654) ELSE %A11279400
BEGIN DAC[12] ~ GNAT(ELBAT[I]); STEPIT END ELSE DAC[12] ~0 %A11279500
END ELSE DAC[11] ~ DAC[12] ~ 0; %A11279600
END ELSE BEGIN %A11279700
EMITL(ELBAT[I].ADDRESS); EMITPAIR(STRP,STD); %A11279800
STEPIT; %A11279900
IF NOTCOMMA THEN GO EXIT; AEXP; EMITO(SSP); %A11280000
EMITO(DUP); EMITNUM(R); %A11280100
EMITO(GTR); EMITERR(SGNO,L," 6"); %A11280200
IF ELCLASS=RTPAREN THEN BEGIN EMITPAIR(RMARG,SND); %A11280300
EMIT(0); EMITPAIR(CP,SND); EMITPAIR(LMARG,STD) END; %A11280400
EMITL(7); EMITO(ADD); EMITL(8); EMITO(IDV); %A11280500
EMITPAIR(LGO,ISD); %A11280600
IF ELCLASS = RTPAREN THEN GO L2; %A11280700
MARG: %A11280800
IF NOTCOMMA THEN GO EXIT; %A11280900
IF ELCLASS = BOOID THEN BEGIN GPBV ~ ELBAT[I].ADDRESS; %A11281000
IF ELBAT[I].LVL ! 1 THEN ERR(683);% %A11281100
IF STEPI=RTPAREN THEN GO L2; GO TO MARG END; %A11281200
AEXP; EMITO(SSP); %A11281300
EMITPAIR(LMARG,ISN); %A11281400
EMITPAIR(CP,SND); %A11281500
IF NOTCOMMA THEN GO EXIT; %A11281600
AEXP; EMITO(SSP); %A11281700
EMITPAIR(RMARG,ISN); %A11281800
EMITO(GTR); EMITV(RMARG); %A11281900
EMITV(LGO); EMITL(8); EMITO(MUL); %A11282000
EMITO(GTR); EMITO(LOR); %A11282100
EMITERR(SGNO,L," 8"); %A11282200
IF DACP.[22:13]!0 THEN BEGIN EMIT(0); EMITPAIR(DAC[8],STD); %A11282300
END END END; %A11282400
BF: IF ELCLASS = RTPAREN THEN L2: STEPIT ELSE %T9011282500
ERR(104); %A11282600
EXIT: %A11282700
END OF OUTPUTER; %A11282800
PROCEDURE REMOBIT; %A11282900
IF STEPI ! LEFTPAREN THEN BEGIN %A11283000
EMITO(MKS); EMIT(0); EMITN(SYMSTACKA); %A11283100
EMITO(ECM); STREAMTOG ~ TRUE; %A11283200
EMITC(8,TRP); EMIT(0); EMIT(0); EMIT(0); EMIT(0); %A11283300
EMITC(1,RSA); EMITC(2,BNS); %A11283400
EMITC(62,TRW); EMITC(0,ENS); %A11283500
EMITC(1,0); STREAMTOG ~ FALSE; %A11283600
END ELSE %A11283700
BEGIN EMITO(MKS); QUOTETOG ~ TRUE; %A11283800
STEPIT; %A11283900
SEXPN; QUOTETOG ~ FALSE; EMITV(REMOB); %A11284000
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT END OF REMOBIT; %A11284100
CASE ELBAT[I].INCR OF BEGIN %A11284200
IF SYMFORMAT THEN ERR(660) ELSE EMITRET; %A11284300
EMITXIT; %A11284400
RECLAIMIT; %A11284500
RECALLIT(0); % %A11284600
RECALLIT(1); % %A11284700
ADDPROP; %A11284800
REMPROP; %A11284900
PRINTER(TRUE); %A11285000
PRINTER(FALSE); %A11285100
BEGIN TRPRI; STEPIT END; %A11285200
DONTS; %A11285300
INPUTER; %A11285400
OUTPUTER; %A11285500
REMOBIT; %A11285600
END END OF NVALINT; %A11285700
% %A11285800
% %A11285900
% %A11286000
PROCEDURE EMITNEWX; %A11286100
BEGIN REAL T,R,S; %A11286200
BOOLEAN STREAM PROCEDURE ALFTEST(V); VALUE V; %A11286300
BEGIN SI ~ LOC V; SI ~ SI + 7; IF SC = ALPHA THEN TALLY ~ 1; %A11286400
ALFTEST ~ TALLY END; %A11286500
PROCEDURE EMITFILL(A,N); VALUE N; INTEGER N; ARRAY A[0]; %A11286600
BEGIN %A11286700
INTEGER T,S; ARRAY TEDOC[0:7,0:127]; %A11286800
EMITNUM(SGAVL); EMITL(7); %A11286900
EMITO(COM); EMITO(DEL); EMITO(DEL); %A11287000
SEGMENTSTART; MOVECODE(TEDOC,EDOC); %A11287100
T ~ (N DIV 128) - 1; %A11287200
FOR S ~ 0 STEP 1 UNTIL T DO %A11287300
MOVE(128,A[S|128],EDOC[S,0]); % %A11287400
T ~ T + 1; %A11287500
MOVE(S ~ N MOD 128,A[T|128],EDOC[T,0]); %A11287600
SEGMENT(N,SGAVL,SGNO); %A11287700
MOVECODE(TEDOC,EDOC); %A11287800
SGAVL ~ SGAVL + 1; %A11287900
END OF EMITFILL; %A11288000
IF DACP ! 0 THEN BEGIN % REMOTE TERMINAL %T9011288100
IF DAC[1] = 0 THEN ERR(653) ELSE %T9011288200
IF DAC[9]!0THEN EMITARRAY(DAC[9],18,0,FALSE)ELSE FLAG(653);%T9011288300
END; % %T9011288400
IF DPI[44] ! 0 THEN BEGIN % LNK %A11288500
R ~ 32768 & 3 [1:46:2]; %A11288600
FOR T ~ 0 STEP 1 UNTIL 9 DO LNK[0,T] ~ R; %A11288700
R ~-32768; %A11288800
FOR T ~ 10 STEP 1 UNTIL 63 DO LNK[0,T] ~(IF ALFTEST(T) %A11288900
THEN R ELSE -65536) & LNK[0,T][33:33:15]; %A11289000
LNK[0,12] ~ -65536; % MAKE QMARK NON-ALF %A11289100
EMITARRAY(44,64,512,FALSE); %A11289200
IF RECLAIMTOG AND SFPL > LNKNDX THEN FLAG(667); %A11289250
R ~ LNKNDX.[33:6] - 1; %A11289300
FOR T ~ 0 STEP 1 UNTIL R DO BEGIN %A11289400
EMITL(T); EMITN(44); EMITO(LOD); %A11289500
EMITFILL(LNK[T,*],512) END; %A11289600
EMITL(R~R+1); EMITN(44); EMITO(LOD); %A11289700
EMITFILL(LNK[R,*], S ~ LNKNDX.[39:9] + 1); %A11289800
IF SYMSTK THEN BEGIN IF LNKNDX { 1023 THEN EMITL(LNKNDX) %A11289810
ELSE EMITREL(LNKNDX); EMITPAIR(LNKROW,STD) END ELSE BEGIN %A11289820
EMITL(R); EMITPAIR(LNKCOL,STD); %A11289900
IF DPI[59] !0 THEN BEGIN LNKNDX ~ LNKNDX + 1; %A11290000
IF S.[42:6] ! 0 THEN BEGIN S.[42:6] ~ 0; %A11290100
LNKNDX.[42:6] ~ 0; LNKNDX ~ LNKNDX + 64; S ~ S + 64 END; %A11290200
IF LNKNDX { 1023 THEN EMITL(LNKNDX) ELSE EMITREL(LNKNDX); %A11290210
EMITPAIR(FREENL,STD) END; %A11290220
EMITL(S); EMITPAIR(LNKROW,STD); END; %A11290300
END; %A11290350
IF DPI[45] ! 0 THEN BEGIN % SYMSTACK %A11290400
T ~ IF RECLAIMTOG THEN 256 ELSE %A11290500
IF DPI[89] ! 0 OR DPI[92] ! 0 THEN 128 ELSE 125; %A11290600
EMITARRAY(45,T,0,FALSE); %A11290700
EMITPAIR(45,LOD); EMITFILL(SYMSTACK[*],125); %A11290800
END; %A11290900
IF DPI[46] ! 0 THEN % INSTR %A11291000
EMITARRAY(46,8,0,FALSE); %A11291100
IF DPI[47] + DPI[107] ! 0 THEN BEGIN % OUTSTR %A11291200
%T9011291210
STRINGMAX ~ MAX (STRINGMAX,168) ; % %A11291220
%T9011291300
STRINGMAX ~ (STRINGMAX+7) DIV 8; %A11291400
EMITARRAY(23,STRINGMAX,0,TRUE); END; %A11291500
IF DPI[49] ! 0 OR DPI[82] ! 0 THEN BEGIN % RND %A11291600
EMITREL(.77712357123575); %A11291700
EMITPAIR(49,STD); END; %A11291800
IF REAL(PRINFORM.[35:11]) ! 0 THEN BEGIN EMITL(15); %A11291900
EMITPAIR(REAL(PRINFORM.[35:11]),STD); END; %A11292000
EMITL(1); EMITPAIR(OUTOG,SND); %A11292100
IF RECLAIMTOG THEN BEGIN EMITL(TABLEMARKV); %A11292200
EMITPAIR(TABLEMARK,STD) END; %A11292250
EMITPAIR(WSIGN,STD); %A11292300
EMITL(2); EMITPAIR(COLSET,STD); %A11292400
EMITL(5); EMITPAIR(SNGLSIG,STD); %A11292500
EMITL(22); EMITPAIR(DBLSIG,STD); %A11292600
END OF EMITNEWX; %A11292700
% %A11292800
PROCEDURE HANDLXIT; %A11292900
BEGIN REAL T; %A11293000
ADJUST; WHILE XITLIST ! 4095 DO BEGIN %A11293100
T ~ GET(XITLIST-2); %A11293200
EMITB(BFW,XITLIST,L); %A11293300
XITLIST ~ T END END; %A11293400
% %A11293500
PROCEDURE HANDLRET(BRANCH); VALUE BRANCH; BOOLEAN BRANCH; %A11293600
BEGIN REAL CL,T; CL ~ PROINFO.CLASS; %A11293700
IF BRANCH THEN BEGIN ADJUST; T ~ L; %A11293800
WHILE RETLIST ! 4095 DO BEGIN %A11293900
L ~ RETLIST; RETLIST ~ GET(RETLIST-2); %A11294000
IF CL = PROCID THEN EMITB(BFW,L,T) ELSE %A11294100
IF CL = DBLPLXPROCID THEN EMITB(BFW,L-1,T) ELSE %A11294200
BEGIN L ~ L-2; EMITPAIR(514,STD); %A11294300
EMITB(BFW,L+2,T) END END; %A11294400
L ~ T END ELSE %A11294500
BEGIN T ~ L; %A11294600
WHILE RETLIST ! 4095 DO BEGIN %A11294700
L ~ RETLIST - 2; RETLIST ~ GET(L); %A11294800
IF CL = PROCID THEN EMITO(XIT) ELSE EMITO(RTN) END; %A11294900
L ~ T END %A11295000
END OF HANDLRET; %A11295100
% %A11295200
% %A11295300
% %A11295400
REAL PROCEDURE TEMP(R); VALUE R; REAL R; %A11295500
DPI[R~R+29] ~ IF TEMP ~ ABS(DPI[R])!0 THEN -ABS(DPI[R]) ELSE %A11295600
-(TEMP:=GETSPACE(TRUE,-1)); %T9311295700
% %A11295800
REAL PROCEDURE GNATA(R); VALUE R; REAL R; %A11295900
DPI[R ~ R + 44] ~ GNATA ~ IF R = 47 THEN 23 ELSE R; %A11296000
% %A11296100
REAL PROCEDURE GNATP(K); VALUE K; REAL K; %A11296200
BEGIN %A11296300
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11296400
FORTERR; %A11296500
IF GNATP ~ DPI[K].ADDRESS = 0 THEN BEGIN %A11296600
IF GT1 := DPI[K].[33:6] = 0 THEN GT1 := GETSPACE(TRUE,-6); %T9311296700
DPI[K].ADDRESS ~ GNATP ~ GT1; %A11296800
CASE K OF BEGIN %A11296900
; % ARCTAN 113 %A11297000
GT1 ~ GNATP(4); % 107 %A11297100
; % 77 %A11297200
; % 101 %A11297300
GT1 ~ GNATP(14); % 105 %A11297400
PUTADR(452,25); % 123 DSQRT %A11297500
GT1 ~ GNATP(3); % 104 %A11297600
GT1 ~ GNATP(0); % 115 %A11297700
PUTADR(452,25); % 53 %A11297800
BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 110 %A11297900
BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 100 %A11298000
BEGIN PUTADR(452,25); PUTADR(443,29); PUTADR(551,36); %A11298100
GT1 ~ GNATP(8); END; % 102 %A11298200
BEGIN PUTADR(452,25); PUTADR(440,27); PUTADR(449,28) END; % 106 %A11298300
BEGIN PUTADR(452,25); GT1 ~ GNATP(8) END; % 124 %A11298400
; % 65 %A11298500
END; END; %A11298600
END OF GNATP; %A11298700
% %A11298800
REAL PROCEDURE GNATI(R); VALUE R; REAL R; %A11298900
BEGIN %A11298925
IF (R = 5 OR R = 27) AND LISTOG THEN %A11298950
WRITE(LINE,<"WARNING: IMPLICIT TRANSFER ENACTED">); %A11298960
IF DPI[GNATI ~ R ~ R + 50] = 0 THEN BEGIN %A11299000
DEFINE STBLK = #; % CONVERT PROCEDURE INTO BLOCK %B11299100
DPI[R] ~ R; %A11299200
CASE R - 50 OF BEGIN %A11299300
R ~ GENLINK; %0 %A11299400
R ~ STRINGPRINT; % 1 %A11299500
R ~ GENLINK; % 2 %A11299600
R ~ STRINGPRINT; % 3 %A11299700
BEGIN R~LNKA; R ~PTABLE; R~INSTR; R~GENLINK END; %4 %A11299800
R ~ ERRPRO; % 5 %A11299900
BEGIN R ~ OUTSTR; R ~ SYMFIX END; % 6 %A11300000
R ~ TERPRIN; % 7 %A11300100
R ~ RITELINE; % 8 %A11300200
; % 9 %A11300300
BEGIN R ~ DXP; R ~ DLOG END; % 10 %A11300400
BEGIN R ~ DBLFACT; R ~ DCOS; R ~ DSIN; R ~ DSQRT; %A11300500
R ~ DATN2 END ; % 11 %A11300600
BEGIN R ~ DBLPRINT; R ~ CHARPRINT END; % 12 %A11300700
BEGIN R ~ NTSER; R ~ STRINGPRINT END; % 13 %A11300800
; % 14 %A11300900
BEGIN R ~ LNKA; R ~ ERRPRO; %A11301000
IF RECLAIMTOG THEN BEGIN R~MARKER;R~COLLECT END END; %15 %A11301100
R ~ GENLINK; % 16 %A11301200
R ~ LNKA; % 17 %A11301300
BEGIN R ~ LNKA; R ~ PTABLE END; % 18 %A11301400
R ~ MRK; % 19 %A11301500
BEGIN R ~ MARKD; R ~ MARKOB END; % 20 %A11301600
R ~ MRK; % 21 %A11301700
BEGIN R ~ LNKA; R ~ SYMEQ END; %A11301800
BEGIN R~LNKA; R~PTABLE; R~INSTR; R~GENLINK; END; %23 %A11301900
BEGIN R ~ SYMPRINT; R ~ BOOPRINT END; % 24 %A11302000
BEGIN R ~ SYMPRINT; R ~ ALFPRINT END; %25 %A11302100
R ~ LNKA; % 26 %A11302200
R ~ GENLINK; % 27 %A11302300
R ~ OUTSTR; % 28 %A11302400
BEGIN R ~ GNAT(429); R~ GNAT(551); R ~ CABS; R ~ GNAT(EXPI); %A11302500
R ~ GNAT(COSI); %A11302600
R ~ GNAT(SINI); R ~ GNAT(LOGI); %A11302700
R ~ GNAT(XTOTHEI) END; % 29 %A11302800
BEGIN R ~ CHARPRINT; R ~ ARITHPRINT END; % 30 %A11302900
R ~ LNKA; % 31 %A11303000
R ~ RND; % 32 %A11303100
BEGIN R ~ RANDNO; R ~ LENGTHV END; % 33 %A11303200
R ~ READSYM; % 34 %A11303300
BEGIN R ~ READCON; R ~ NTA END; % 35 %A11303400
BEGIN R ~ SCANR; R ~ ATCON; R ~ MKATM END; % 36 %A11303500
BEGIN R ~ READCON; R ~ TERPRIN; R ~ CHARPRINT END; % 37 %A11303600
R ~ READ1; % 38 %A11303700
BEGIN R ~ ERRPRO; R ~ SYMSTACKA END; %A11303800
BEGIN R ~ TERPRIN; R ~ READCON END; % 40 %A11303900
; % 41 %A11304000
IF RECLAIMTOG THEN %A11304050
BEGIN R ~ MARKOB; R ~ COLLECT END; % 42 %A11304100
BEGIN R ~ LNKA; R ~ PTABLE END; % 43 %A11304200
R ~ LNKA; % 44 %A11304300
; % 45 %A11304400
R ~ INSTR; % 46 %A11304500
R ~ RITELINE; % 47 %A11304600
BEGIN R ~ OUTSTR; R ~ TERPRIN END; % 48 %A11304700
R ~ SYMEQA; % 49 %A11304800
R ~ LNKA; % 50 %A11304900
R ~ LNKA; % 51 %A11305000
BEGIN R ~ ARITHPRINT; R ~ CHARPRINT; %A11305100
R~ SYMFIX; R ~ STRINGPRINT END; % 52 %A11305200
R ~ SPACEPRINT; % 53 %A11305300
; % 54 %A11305400
END; %A11305500
END; %A11305550
END OF GNATI; %A11305600
% %A11305700
REAL PROCEDURE GNATR(T); VALUE T; REAL T; %A11305800
IF (GNATR ~ RECARRAY[T])<0 THEN %A11305900
BEGIN %A11306000
REAL S,R,J,K,B; %A11306100
REAL V; INTEGER P; %A11306200
RECARRAY[T]~ ABS(T ~ RECARRAY[T]); %A11306300
R ~ TAKE(J ~ GIT(T)); %A11306400
S ~ 0; %A11306450
FOR K ~ 1 STEP 1 UNTIL R DO BEGIN %A11306500
IF P ~ TAKE(B ~ TAKE(K+J)).ADDRESS = 0 THEN %A11306600
BEGIN Q ~ ACCUM[1]; ACCUM[1] ~ TAKE(B+1); %A11306700
FLAG(627); ERRORTOG ~ TRUE; ACCUM[1]~ Q END ELSE %A11306800
BEGIN V ~ TAKE(GIT(B)); %A11306900
IF P=3 THEN P ~((V.[22:13]+V.[35:13]+7) DIV 8)+ V.[8:7] ELSE %A11307000
P ~ V.[15:7] + 1; %A11307100
S ~ MAX(S,P) END END; %A11307200
IF TAKE(GIT(T.[22:13])).[16:10] < S THEN FLAG(659);% %A11307300
END OF GNATR; %A11307400
% %A11307500
% %A11307600
% %A11307700
PROCEDURE FIELDGEN; %A11307800
BEGIN REAL EL,G,K; LABEL EXIT,NEXT; INTEGER T1,T2; %A11307900
REAL T; %A11308000
IF SPECTOG THEN BEGIN ERR(628); GO EXIT END; %A11308100
IF G ~ GTA1[J ~J-1]=0 THEN G ~ REALV ELSE BEGIN %A11308200
IF G < STRINGV OR G = DOUBLEV OR (G{FIELDV AND G>INTV) THEN %A11308300
BEGIN ERR(629); GO EXIT END;% %A11308400
IF G = SYMV AND RECLAIMTOG THEN %A11308500
FLAG (629); %A11308600
CHKSOB; END; %A11308700
I ~ I - 1; %A11308800
NEXT: IF STEPI=FIELDID THEN BEGIN %A11308900
IF(EL ~ELBAT[I]).ADDRESS!0 AND EL.LVL= LEVEL THEN BEGIN %A11309000
ERR(630); GO EXIT END; %A11309100
T ~ GIT(EL); STEPIT; END ELSE BEGIN %A11309200
STOPENTRY ~ STOPGSP ~ TRUE; ENTRY(FIELDID); EL~ LASTINFO; %A11309300
STOPENTRY ~ STOPGSP ~ FALSE; T ~ NEXTINFO; PUTNBUMP(0); %A11309400
END; PUT(TAKE(EL)& G[16:37:11],EL); EL~0; %A11309500
IF ELCLASS = LEFTPAREN THEN BEGIN EL ~ GETLIT(127); %A11309600
IF ELCLASS=COMMA THEN K ~ GETLIT(127) ELSE K ~ EL; %A11309700
EL ~ 0&EL[8:41:7]&K[15:41:7]&REAL(EL!K)[1:47:1]; %A11309800
IF ELCLASS!RTPAREN THEN BEGIN ERR(104); GO EXIT END; STEPIT END; %A11309900
T1 ~ T2 ~ 0; %A11310000
IF G } STRINGV THEN BEGIN% %A11310100
IF ELCLASS= LFTBRKET THEN BEGIN %A11310200
T1 ~ GETLIT(IF G=STRINGV THEN 7 ELSE 47); %A11310300
IF ELCLASS!COLON THEN BEGIN ERR(631); GO EXIT END; %A11310400
T2 ~ GETLIT(IF G=STRINGV THEN 8183 ELSE 47); %A11310500
IF G=RECORDV OR G=SYMV THEN IF T2<15 THEN BEGIN ERR(632); GO EXIT END;%A11310600
IF ELCLASS!RTBRKET THEN BEGIN ERR(607); GO EXIT END; %A11310700
IF (IF G=STRINGV THEN 8184 ELSE 48)<T1+T2 THEN BEGIN %A11310800
ERR(629); GO EXIT END; %A11310900
IF G=STRINGV THEN STRINGMAX ~ MAX(STRINGMAX, T2); %A11311000
STEPIT END ELSE BEGIN %A11311100
IF G= STRINGV THEN BEGIN ERR(629); GO EXIT END; END; %A11311200
EL ~ EL&T1[22:35:13]&T2[35:35:13] END; %A11311300
PUT(EL,T); %A11311400
IF EL <0 THEN IF G{ DOUBLEV THEN BEGIN ERR(629); GO EXIT END; %A11311500
IF ELCLASS=COMMA THEN GO TO NEXT; %A11311600
EXIT: END FIELDGEN; %A11311700
% %A11311800
PROCEDURE RECORDGEN; %A11311900
BEGIN REAL SAVEN,IDCOUNT,FLD,T,SAVE2; %A11312000
LABEL NEXT,EXIT; %A11312100
DEFINE RECT = RECORDLINK#; %A11312200
% %A11312300
PROCEDURE FIELDLIST(SAVEN,FC); VALUE SAVEN,FC; REAL SAVEN,FC; %A11312400
BEGIN REAL T,R,S; %A11312500
IF STEPI=FIELDID THEN BEGIN T ~ ELBAT[I].LINK; STEPIT END ELSE %A11312600
BEGIN STOPENTRY~ STOPGSP ~ TRUE; ENTRY(FIELDID); %A11312700
STOPENTRY~ STOPGSP ~ FALSE; T ~ LASTINFO; %A11312800
PUTNBUMP(0); END; %A11312900
IF ELCLASS=COMMA THEN FIELDLIST(SAVEN,FC+1) ELSE %A11313000
IF ELCLASS=RTPAREN THEN BEGIN %A11313100
PUT(TAKE(SAVEN)&(NEXTINFO-SAVEN)[27:40:8],SAVEN); %A11313200
PUTNBUMP(FC); GT4~FC+1; NEXTINFO~NEXTINFO+FC END %A11313300
ELSE ERR(104); %A11313400
PUT(T,SAVEN~NEXTINFO+FC-GT4); %A11313500
END FIELDLIST; %A11313600
REAL P,R; %A11313700
I ~ I - 1; %A11313800
CHKSOB; NEXT: STEPIT; %A11313900
STOPENTRY ~ STOPGSP ~ TRUE; ENTRY(DECLARATORS); %A11314000
STOPENTRY ~ STOPGSP ~ FALSE; SAVEN ~ LASTINFO; %A11314100
IF RECORDLINK =60 THEN FLAG(633) ELSE RECT ~ RECT+1; %A11314200
IF ELCLASS=FILEID THEN %A11314300
IF TAKE((P~ELBAT[I]).LINK+1).[2:2]>0 THEN BEGIN %A11314400
IF P.LVL! LEVEL THEN FLAG(655); STEPIT END ELSE %A11314500
BEGIN P~SAVEN; FLAG(656) END ELSE %A11314600
BEGIN P~SAVEN; FLAG(657) END; %A11314700
IF ELCLASS!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11314800
FIELDLIST(SAVEN,1); %A11314900
MOREWORDS ~2; %A11315000
RECARRAY[RECT]:=(-SAVEN)&P[22:35:13]&GETSPACE(FALSE,SAVEN +1) %T9311315100
[11:37:11]&(R:=TAKE(P:=GIT(P)).[2:5]+1)[6:43:5];MOREWORDS:=0; %T9311315200
PUT(TAKE(P)&R[2:43:5],P); IF R > 31 THEN FLAG(658); %A11315300
PUT(TAKE(SAVEN)&RECT[16:37:11] ,SAVEN); %A11315400
IF STEPI = COMMA THEN GO NEXT; %A11315500
EXIT: END OF RECORDGEN; %A11315600
% %A11315700
REAL PROCEDURE GETSTRINGLENGTH(MAIN,LS); VALUE MAIN,LS; REAL MAIN,LS; %A11315800
BEGIN REAL LG,N; INTEGER T; %A11315900
INTEGER S; %A11316000
LABEL EXIT,NEXT; %A11316100
IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO EXIT END; %A11316200
NEXT: IF STEPI =LITNO OR ELCLASS=NONLITNO THEN T ~ C ELSE %A11316300
BEGIN STOPENTRY ~ STOPGSP~ TRUE; ENTRY(STRINGID); %A11316400
STOPENTRY ~ STOPGSP ~ FALSE; N ~ NEXTINFO ~ NEXTINFO + 1; %A11316500
I~I-1; T~ GETSTRINGLENGTH(MAIN,LS); PUT((-MAIN)&LS[22:35:13] %A11316600
& T[9:35:13],N-1); END; %A11316700
LS ~ LS + T; %A11316800
S ~ S + T; %A11316900
IF STEPI=COMMA THEN GO NEXT; %A11317000
IF ELCLASS!RTPAREN THEN ERR(104) ELSE %A11317100
IF GETSTRINGLENGTH ~ T ~ S < 1 OR S > 8184 THEN ERR(634); %A11317200
EXIT: STRINGMAX ~ MAX(STRINGMAX,T) END; %A11317300
% %A11317400
BOOLEAN PROCEDURE STRINGEN; %A11317500
BEGIN INTEGER T,K; BOOLEAN RTOG; REAL R; LABEL EXIT; %A11317600
REAL N; %A11317700
REAL SAVEINFO, SAVE2; %A11317800
BOOLEAN STOG; %A11317900
LABEL NEXT; IF NOT SPECTOG THEN BEGIN %A11318000
IF P2 ~ GTA1[J-1]=OWNV THEN J~J-1; %A11318100
IF P3 ~ GTA1[J-1]=SAVEV THEN J~J-1; END; CHKSOB; NEXT: %A11318200
SAVEINFO ~ NEXTINFO; ENTRY(STRINGID); IF SPECTOG THEN GO EXIT; %A11318300
N ~ GTA1[0]; %A11318400
SAVE2 ~ NEXTINFO ~ NEXTINFO + 1; I ~ I-1; %A11318500
T ~ GETSTRINGLENGTH(IF J=1 THEN SAVEINFO ELSE 0,0); %A11318600
PUT(T,SAVE2-1); %A11318700
IF RTOG ~ T>7 THEN BEGIN JUMPCHKX; EMITO(MKS) END; %A11318800
DO BEGIN R ~ TAKE(SAVEINFO); K ~ R.INCR; %A11318900
R.INCR ~ SAVE2 - SAVEINFO - 1; PUT(R,SAVEINFO); IF RTOG THEN %A11319000
IF R.CLASS=STRINGID THEN IF P2 THEN BEGIN EMITL(R.ADDRESS); %A11319100
EMITN(10) END ELSE EMITN(R.ADDRESS); %A11319200
SAVEINFO ~ SAVEINFO + K END UNTIL SAVE2-1=SAVEINFO; %A11319300
IF RTOG THEN BEGIN IF P2 THEN EMIT(0); EMITL(T~(T+7)DIV 8); %A11319400
EMITL(1); EMITL(N); EMITL(REAL(P3)+2|REAL(P2)); %A11319500
EMITV(5) END; %A11319600
IF RTOG THEN NOOFARRAYS ~ NOOFARRAYS + GTA1[0]; %A11319700
STOG ~ STOG OR RTOG; %A11319800
IF STEPI=COMMA THEN BEGIN STEPIT; GO TO NEXT END; %A11319900
STRINGEN ~ STOG; EXIT: %A11320000
END OF STRINGEN; %A11320100
% %A11320200
%A11320300
PROCEDURE EMITNONX; %A11320400
BEGIN REAL T,R,LO,A; BOOLEAN LSTO; %A11320500
ARRAY TEDOC[0:7,0:127], PA[0:56]; %A11320600
STREAM PROCEDURE WRTINTRSC(SGNO,ALFA,PRT,FIL); %A11320700
VALUE SGNO,PRT; %A11320800
BEGIN LOCAL T; %A11320900
DI ~ LOC T; SI ~ ALFA; %A11321000
DI ~ DI + 7; DS ~ CHR; %A11321100
DI ~ FIL; DS ~ 8 LIT " "; %A11321200
SI ~ FIL; DS ~ 14 WDS; %A11321300
DI ~ FIL; DI ~ DI + 6; %A11321400
SI ~ ALFA; SI ~ SI + 1; %A11321500
DS ~ T CHR; %A11321600
DS ~ LIT ":"; DI ~ FIL; DI ~ DI + 24; % %T0711321650
DS ~ 12 LIT " SEGMENT = "; % %T0711321700
SI ~ LOC SGNO; DS ~ 4 DEC; %A11321800
DS ~ 8 LIT "; PRT = "; % %T0711321900
SI ~ LOC PRT; SI ~ SI + 6; %A11322000
4(DS ~ 3 RESET; 3(IF SB THEN DS ~ SET ELSE DS ~ RESET; %A11322100
SKIP SB)); %A11322200
END; %A11322300
DEFINE %A11322400
% %A11322500
P2 = 125#, % FREELIST %A11322600
P3 = 126#, % LNKROW %A11322700
P4 = 127#; % LNKCOL %A11322800
DEFINE %A11322900
MARK = MRK#, %A11323000
FM1 = 897#, %A11323100
FM2 = 898#, %A11323200
FM3 = 899#, %A11323300
FM4 = 900#, %A11323400
FM5 = 901#, %A11323500
FM6 = 902#, %A11323600
FM7 = 903#, %A11323700
FM8 = 904#, %A11323800
FM9 = 905#, %A11323900
FP1 = 513#, %A11324000
FP2 = 514#, %A11324100
FP3 = 515#, %A11324200
FP4 = 516#, %A11324300
FP5 = 517#, %A11324400
FP6 = 518#, %A11324500
FP7 = 519#, %A11324600
FP8 = 520#, %A11324700
FP9 = 521#; %A11324800
PROCEDURE CALLRITE; FORWARD; %A11324900
PROCEDURE PRINCH(X); VALUE X; REAL X; %A11325000
BEGIN EMITO(MKS); EMITL(X); EMITV(CHARPRINT); END; %A11325100
PROCEDURE CHKFIN; %A11325200
BEGIN REAL T; %A11325300
EMITV(CP); EMITO(ADD); %A11325400
EMITPAIR(CP,ISN); EMITV(RMARG); EMITO(GEQ); %A11325500
T ~ BUMPL; %A11325600
CALLRITE; %A11325700
EMITB(BFC,T,L); %A11325800
END OF CHKFIN; %A11325900
PROCEDURE LODSTR; %A11326000
BEGIN %A11326100
EMITV(CP); EMITL(7); %A11326200
EMITO(LND); %A11326300
EMITV(STRP); EMITO(PRTE); EMITO(LOD); %A11326400
EMITV(CP); EMITL(8); EMITO(IDV); %A11326500
EMITO(CDC); EMITO(ECM); STREAMTOG ~ TRUE; %A11326600
EMITC(2,CRF); EMITC(0,SFD); %A11326700
END; %A11326800
PROCEDURE CALLRITE; %A11326900
BEGIN EMITO(MKS); EMITV(FILPRO); %A11327000
EMITO(PRTE); EMITO(LOD); EMITV(RITELINE); END; %A11327100
PROCEDURE EMITRD(RD,LG,STA,LAB); VALUE RD,LG,STA,LAB; %A11327200
BOOLEAN RD; REAL LG,STA,LAB; %A11327300
BEGIN REAL T; %A11327400
DEFINE BV = RD#; %A11327500
EMITO(MKS); %A11327600
EMITL(GNAT(POWERSOFTEN)); %A11327700
EMITO(LOD); EMITL(5); EMITN(FM1); % FILE %A11327800
EMIT(0); EMITL(1 + REAL(BV)); EMIT(0); %A11327900
EMITV(LG); EMITV(STA); %A11328000
EMITO(PRTE); EMITO(LOD); %A11328100
IF BV THEN BEGIN EMITL(LAB); EMITO(MKS); %A11328200
EMITN(512); EMITV(513); %A11328300
EMITV(GNAT(GOTOSOLVER)); %A11328400
END; %A11328500
FOR T~1 + REAL(BV) STEP 1 UNTIL 5 DO EMIT(0); %A11328600
EMITV(12 + REAL(BV)); %A11328700
END OF EMITRD; %A11328800
PROCEDURE SETBIT; %A11328900
BEGIN EMITO(MKS); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %A11329000
EMITC(3,RDA); EMITC(1,BIS); EMITC(1,0); STREAMTOG ~ FALSE END; %A11329100
PROCEDURE EMITADDPROP; %A11329200
BEGIN REAL T; %A11329300
EMIT(0); EMITV(FM4); %A11329400
GETCONTENTS(0,TRUE); EMITO(DUP); %A11329500
EMITO(LOD); %A11329600
EMITL(2); EMITDIAL(DIA,46); %A11329700
EMITDIAL(DIB,1); %A11329800
EMITFC(FCE,2); EMITO(LNG); %A11329900
EMITPAIR(1,BFC); EMITO(XIT); %A11330000
EMITO(DUP); EMIT(0); %A11330100
EMITO(XCH); EMITO(CTC); %A11330200
EMITV(FM3); %A11330300
EMITO(BFW); %A11330400
T ~ L ~ L + 4; %A11330500
EMITL(3); EMITD(46,2,2); %A11330600
EMITV(FM1); EMITD(19,4,29); %A11330700
EMITPAIR(10,BFW); %A11330800
EMITB(BFW,T,L); EMITL(1); %A11330900
EMITD(46,2,2); %A11331000
EMITB(BFW,T-2,L); %A11331100
EMITV(FM1); EMITO(CTF); %A11331200
EMITV(FM2); EMITD(33,3,15); %A11331300
GENSYMLINK; EMITO(CTC); %A11331400
EMITO(XCH); EMITO(STD); %A11331500
EMITO(XIT); %A11331600
END OF EMITADDPROP; %A11331700
PROCEDURE EMITALFPRINT; %A11331800
BEGIN %A11331900
EMIT(0); %A11332000
EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11332100
EMIT(0); EMITL(8); EMIT(0); EMITO(MKS); %A11332200
EMITV(FM1); EMITO(ECM); %A11332300
STREAMTOG ~ TRUE; %A11332400
EMITC(1,SES); EMITC(0,SEC); %A11332500
EMITC(7,BNS); EMITC(0,TEQ); %A11332600
EMITC(3,JNC); EMITC(1,SFS); %A11332700
EMITC(1,INC); EMITC(0,ENS); EMITC(5,STC); %A11332800
EMITC(3,STC); EMITC(1,0); %A11332900
STREAMTOG ~ FALSE; %A11333000
EMITO(SUB); %A11333100
EMITO(DUP); EMITV(CP); EMITO(ADD); %A11333200
EMITV(RMARG); EMITO(GTR); %A11333300
EMITPAIR(2,BFC); EMITO(MKS); EMITV(TERPRIN); %A11333400
EMITO(MKS); EMITV(FM1); LODSTR; %A11333500
EMITC(3,SES); EMITC(6,CRF); %A11333600
EMITC(0,SFS); EMITC(5,CRF); %A11333700
EMITC(0,TRS); EMITC(1,0); %A11333800
STREAMTOG ~ FALSE; %A11333900
EMITV(CP); EMITO(ADD); EMITPAIR(CP,SND); %A11334000
EMITV(RMARG); EMITO(LSS); EMITPAIR(1,BFC); %A11334100
EMITO(XIT); CALLRITE; EMITO(XIT); %A11334200
END OF EMITALFPRINT; %A11334300
PROCEDURE EMITAPPEND; %A11334400
BEGIN REAL T; %A11334500
EMIT(0); %A11334600
EMIT(0); % FP2 %A11334700
EMIT(0); MARKDESC(1); %A11334800
EMITV(FM2); GETCONTENTS(0,FALSE); %A11334900
EMITO(DUP); EMIT(0); %A11335000
EMITO(LSS); %A11335100
T ~ BUMPL; %A11335200
MARKSYMDCR(-3); %A11335300
EMITV(FM1); EMITO(RTN); %A11335400
EMITB(BFC,T,L); %A11335500
T ~ L; %A11335600
EMITL(1); EMITV(FP2); %A11335700
EMITO(ADD); EMITPAIR(FP2,STD); %A11335800
EMITO(DUP); %A11335900
GETCONTENTS(0,FALSE); %A11336000
EMITO(DUP); EMIT(0); %A11336100
EMITO(LSS); %A11336200
EMITB(BBC,BUMPL,T); EMITO(DEL); %A11336300
EMITV(FM1); %A11336400
T ~ L; %A11336500
EMITO(CTC); %A11336600
GENSYMLINK; %A11336700
EMITPAIR(FP3,SND); %A11336800
EMITV(FP2); EMITL(1); EMITO(SUB); %A11336900
EMITPAIR(FP2,SND); EMIT(0); %A11337000
EMITO(EQL); %A11337100
EMITB(BBC,BUMPL,T); %A11337200
MARKSYMDCR(-3); EMITO(RTN); %A11337300
END OF EMITAPPEND; %A11337400
PROCEDURE EMITARITHPRINT(BV); VALUE BV; BOOLEAN BV; %A11337500
BEGIN COMMENT BV IS TRUE IS DOUBLE; %A11337600
EMIT(0); %A11337700
EMITO(MKS); %A11337800
IF BV THEN EMITV(FM3) ELSE EMIT(0); %A11337900
EMITV(FM2); %A11338000
EMITV(IF BV THEN DBLSIG ELSE SNGLSIG); %A11338100
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11338200
EMITV(NTSER); %A11338300
EMITV(FM1); EMITPAIR(5,BFC); EMITO(MKS); %A11338400
EMITL(1); %A11338500
EMITV(JUNK); %A11338600
EMITO(SUB); %A11338700
EMITV(SPACEPRINT); %A11338800
EMITO(MKS); EMITL(1); EMITV(STRINGPRINT); %A11338900
EMITO(XIT); %A11339000
END OF EMITARITHPRINT; %A11339100
PROCEDURE EMITATCON; %A11339200
BEGIN REAL T,R,S,V; %A11339300
EMIT(0); %A11339400
EMIT(0); EMITV(INSTR); %A11339500
EMITV(COUNTI); EMITL(1); %A11339600
EMITO(LEQ); %A11339700
T ~ BUMPL; %A11339800
EMITI(0,18,6); EMITPAIR(INSYM,STD); %A11339900
EMITL(1); EMITO(RTN); %A11340000
EMITB(BFC,T,L); %A11340100
EMITL(125); %A11340200
EMITO(RDV); EMITV(SYMSTACKA); %A11340300
EMITO(DUP); EMITL(0); EMITO(EQL); %A11340400
EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11340500
S ~ L; %A11340600
EMITO(DUP); GETCONTENTS(0,FALSE); %A11340700
EMITO(DUP); GETCONTENTS(1,FALSE); EMITO(DUP); %A11340800
EMITI(0,1,5); EMITO(DUP); EMITV(COUNTI); %A11340900
EMITO(EQL); %A11341000
T ~ BUMPL; %A11341100
EMITO(DUP); EMITL(7); EMITO(GTR); %A11341200
EMITPAIR(3,BFC); %A11341300
EMITL(4); EMITPAIR(1,BFW); %A11341400
EMITO(DUP); EMIT(0); %A11341500
V ~ L; %A11341600
EMIT(0); EMITO(MKS); EMIT(0); EMITN(INSTR); %A11341700
EMITO(ECM); STREAMTOG ~ TRUE; %A11341800
EMITC(4,CRF); EMITC(0,SFD); %A11341900
EMITC(3,SFD); EMITC(7,SES); %A11342000
EMITC(1,SFS); EMITC(5,CRF); %A11342100
EMITC(0,CNE); EMITC(2,JFC); %A11342200
EMITC(1,SEC); EMITC(3,STC); %A11342300
EMITC(1,0); STREAMTOG ~ FALSE; %A11342400
R ~ BUMPL; %A11342500
EMITO(DEL); EMITO(DEL); %A11342600
EMITB(BFC,T,L); %A11342700
EMITO(DEL); EMITO(DEL); %A11342800
EMITI(0,3,15); EMITO(DUP); %A11342900
EMITL(1); EMITO(LEQ); %A11343000
EMITPAIR(2,BFC); %A11343100
EMIT(0); EMITO(RTN); %A11343200
EMITO(XCH); EMITO(DEL); %A11343300
EMITB(BBW,BUMPL,S); %A11343400
EMITB(BFC,R,L); %A11343500
EMITO(ADD); %A11343600
EMITO(DUP); EMITV(FP5); %A11343700
EMITO(XCH); EMITO(SUB); %A11343800
EMITO(DUP); EMIT(0); %A11343900
EMITO(EQL); %A11344000
EMITPAIR(5,BFC); %A11344100
EMITV(FP2); EMITPAIR(INSYM,STD); %A11344200
EMITL(1); EMITO(RTN); %A11344300
EMITO(DUP); EMITL(7); %A11344400
EMITO(GTR); %A11344500
EMITPAIR(2,BFC); EMITO(DEL); %A11344600
EMITL(4); EMITO(XCH); %A11344700
EMITV(FP4); GETCONTENTS(0,FALSE); %A11344800
EMITPAIR(FP4,STD); %A11344900
EMITB(BBW,BUMPL,V); %A11345000
END OF EMITATCON; %A11345100
PROCEDURE EMITATN; %A11345200
BEGIN %A11345300
EMIT(0); %A11345400
EMIT(0); EMITV(FM2); EMITO(CTC); %A11345500
EMITPAIR(FM2,SND); %A11345600
EMITL(10); EMITO(LSS); %A11345700
EMITPAIR(1,BFC); EMITO(XIT); %A11345800
EMITV(FM2); GETCONTENTS(0,FALSE); %A11345900
EMITO(DUP); EMITI(0,1,2); %A11346000
EMITL(3); EMITO(NEQ); %A11346100
EMITERR(SGNO,L,"11"); %A11346200
GETCONTENTS(0,FALSE); %A11346300
EMITPAIR(FM2,STD); EMITO(XIT); %A11346400
END OF EMITATN; %A11346500
PROCEDURE EMITATSTRV; %A11346600
BEGIN REAL T,R; %A11346700
EMIT(0); %A11346800
EMITV(FM7); EMITL(64); %A11346900
EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11347000
EMITFC(FCL,15); %A11347100
T ~ BUMPL; %A11347200
EMIT(0); EMITO(XCH); %A11347300
EMITD(42,6,6); EMITPAIR(FM7,STD); %A11347400
EMITL(1); EMITPAIR(FM2,SND); %A11347500
EMITO(RTN); %A11347600
EMITB(BFC,T,L); %A11347700
GETCONTENTS(0,FALSE); %A11347800
EMITL(2); EMITDIAL(DIA,46); %A11347900
EMITDIAL(DIB,1); %A11348000
EMITFC(FCE,2); %A11348100
R ~ BUMPL; %A11348200
EMITO(MKS); EMITV(SYMFIX); %A11348300
EMITO(DEL); EMITV(NSTR); %A11348400
EMITO(DUP); EMITL(7); %A11348500
EMITO(RDV); EMITPAIR(FM2, ISD); %A11348600
EMITO(DUP); EMITL(7); %A11348700
EMITO(IDV); EMITPAIR(FM3,ISD); %A11348800
EMITO(MKS); EMIT(0); %A11348900
EMITN(OUTSTR); EMITO(ECM); %A11349000
STREAMTOG ~ TRUE; %A11349100
EMITC(1,RSA); EMITC(12,SED); %A11349200
EMITC(8,CRF); EMITC(3,BNS); %A11349300
EMITC(1,SFD); EMITC(7,TRS); %A11349400
EMITC(0,ENS); %A11349500
EMITC(1,SFD); %A11349600
EMITC(7,CRF); EMITC(0,TRS); %A11349700
EMITC(1,0); STREAMTOG ~ FALSE; %A11349800
EMITO(RTN); %A11349900
EMITB(BFC,R,L); %A11350000
EMITL(12); %A11350100
EMITB(BBW,BUMPL,T); %A11350200
END OF EMITATSTRV; %A11350300
PROCEDURE EMITBOOPRINT; %A11350400
BEGIN %A11350500
EMIT(0); %A11350600
EMITV(FM1); EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11350700
EMITPAIR(3,BFC); EMITL(0); %A11350800
EMITPAIR(1,BFW); EMITL(1); %A11350900
EMITO(DUP); EMITL(4); %A11351000
EMITO(ADD); EMITO(DUP); %A11351100
EMITV(CP); EMITO(ADD); %A11351200
EMITV(RMARG); EMITO(GTR); %A11351300
EMITPAIR(2,BFC); %A11351400
EMITO(MKS); EMITV(TERPRIN); %A11351500
EMITO(MKS); LODSTR; %A11351600
EMITC(5,CRF); EMITC(0,JFW); EMITC(5,JFW); %A11351700
EMITC(5,TRP); EMIT(" F"); %A11351800
EMIT("AL"); EMIT("SE"); EMITC(3,JFW); %A11351900
EMITC(4,TRP); EMIT("TR"); EMIT("UE"); %A11352000
EMITC(1,0); STREAMTOG ~ FALSE; %A11352100
EMITV(CP); EMITO(ADD); %A11352200
EMITPAIR(CP,SND); EMITV(RMARG); %A11352300
EMITO(LSS); EMITPAIR(1,BFC); EMITO(XIT); %A11352400
CALLRITE; EMITO(XIT); %A11352500
END OF EMITBOOPRINT; %A11352600
PROCEDURE EMITCHARPRINT; %A11352700
BEGIN REAL T; %A11352800
EMIT(0); EMITV(OUTOG); %A11352900
EMITPAIR(1,BFC); EMITO(XIT); %A11353000
EMITV(CP); EMITL(1); EMITO(ADD); %A11353100
EMITV(RMARG); EMITO(GTR); %A11353200
T ~ BUMPL; %A11353300
CALLRITE; %A11353400
EMITB(BFC,T,L); %A11353500
EMITO(MKS); EMITV(FM1); LODSTR; %A11353600
EMITC(3,SES); EMITC(7,SFS); %A11353700
EMITC(1,TRS); EMITC(1,0); %A11353800
STREAMTOG ~ FALSE; %A11353900
EMITL(1); CHKFIN; %A11354000
EMITO(XIT); %A11354100
END OF EMITCHARPRINT; %A11354200
PROCEDURE EMITCOLLECT; %A11354300
BEGIN %A11354400
REAL L1; %A11354500
REAL L2; %A11354600
DEFINE DOIT = %A11354700
EMITC(1,BIT); EMITC(5,JFC); %A11354800
EMITC(1,BIR); EMITC(7,SFD); %A11354900
EMITC(1,INC); EMITC(8,SFS); %A11355000
EMITC(21,JFW); EMITC(3,STC); %A11355100
EMITC(2,RSA); EMITC(1,TRW); %A11355200
EMITC(2,RDA); EMITC(4,SES); %A11355300
EMITC(1,SFS); EMITC(7,TRS); %A11355400
EMITC(7,SFS); EMITC(1,TRS); %A11355500
EMITC(1,INC); EMITC(3,STC); %A11355600
EMITC(1,RSA); EMITC(1,RDA); %A11356000
EMITC(3,CRF); EMITC(2,BNS); %A11356100
EMITC(8,SFD); EMITC(0,ENS); %A11356200
EMITC(3,CRF); EMITC(2,BNS); %A11356300
EMITC(8,SFS); EMITC(0,ENS)#; %A11356400
DEFINE R = FP2#, C = FP3#, T = FP4#; %A11356500
EMIT(0); %A11356600
EMITV(FREENL); EMITI(0,39,3); % R %A11356700
EMITV(FREENL); EMITI(0,33,6); % C %A11356800
L1 ~L; %A11356900
EMITO(DUP); EMITV(LNKCOL); EMITO(GTR); %A11357000
L2 ~ BUMPL; %A11357100
EMITL(512); EMITPAIR(LNKROW,STD); %A11357200
EMITV(FREEN); EMITL(1); EMITO(ADD); %A11357300
EMITPAIR(FREEN,STD); EMITO(XIT); %A11357400
EMITB(BFC,L2,L); %A11357500
EMITO(DUP); EMITL(8); EMITO(MUL); %A11357600
EMITPAIR(JUNK,ISN); %A11357700
L2 ~ L; %A11357800
EMITO(MKS); %A11357900
EMITV(T); EMITV(R); EMITO(ADD); %A11358000
EMIT(0); EMITN(FREELIST); %A11358100
EMITV(C); EMITN(LNKA); EMITO(LOD); %A11358200
EMITV(R); EMITL(64); EMITO(MUL); %A11358300
EMITO(CDC); EMITO(ECM); %A11358400
STREAMTOG ~ TRUE; %A11358500
EMITC(1,RSA); EMITC(2,BNS); %A11358600
EMITC(32,BNS); DOIT; EMITC(0,ENS); %A11358700
EMITC(0,ENS); %A11358800
EMITC(1,0); STREAMTOG ~ FALSE; %A11358900
EMITV(R); EMITL(1); EMITO(ADD); %A11359700
EMITO(DUP); EMITL(8); EMITO(EQL); %A11359800
EMITPAIR(9,BFC); %A11359900
EMITO(DEL); EMITO(DEL); %A11360000
EMITL(1); EMITO(ADD); %A11360100
EMIT(0); EMITPAIR(R,STD); %A11360150
EMITB(BBW,BUMPL,L1); %A11360200
EMITPAIR(R,STD); %A11360300
EMITB(BBW,BUMPL,L2); %A11360400
END OF EMITCOLLECT; %A11360500
PROCEDURE EMITDBLFACT; %A11360600
BEGIN REAL T,R,S; %A11360700
DEFINE YLO = FM5#, YHI = FM4#, %A11360800
XLO = FM2#, XHI = FM1#, DLN = DLOG#; %A11360900
EMIT(0); %A11361000
EMITV(XLO); EMIT(0); EMITO(EQL); %A11361100
T ~ BUMPL; %A11361200
EMITV(XHI); EMIT(0); EMITO(EQL); %A11361300
R ~ BUMPL; %A11361400
EMIT(0); EMITPAIR(YLO,STD); %A11361500
EMITL(1); EMITPAIR(YHI,STD); EMITO(XIT); %A11361600
EMITB(BFC,R,L); %A11361700
EMITV(XHI); EMITI(0,2,36); %A11361800
EMIT(0); EMITO(EQL); %A11361900
R ~ BUMPL; %A11362000
EMIT(0); EMITV(XHI); EMITO(DUP); EMITO(SSP); %A11362100
EMITPAIR(XHI,STD); EMIT(0); %A11362200
EMITO(LSS); EMITO(DUP); %A11362300
EMITPAIR(2,BFC); EMIT(0); EMITL(1); %A11362400
EMITV(YLO); EMITV(YHI); %A11362500
EMITV(XHI); EMITL(1); EMITO(NEQ); %A11362600
S ~ BUMPL; %A11362700
EMITV(XHI); EMITPAIR(12,BFC); EMITV(FP2); EMITL(1); %A11362800
EMITO(ADD); EMITPAIR(FP2,STD); EMITPAIR(XLO,STD); %A11362900
EMITO(DUP); EMITV(XLO); EMITO(XCH); %A11363000
EMITPAIR(2,BFW); %A11363100
EMITPAIR(XLO,STD); %A11363200
EMITO(DUP); EMITV(XLO); EMITO(XCH); %A11363300
EMITV(XLO); EMITO(ML2); %A11363400
EMITV(XHI); EMITL(2); EMITO(IDV); %A11363500
EMITPAIR(XHI,ISN); EMITL(1); %A11363600
EMITO(EQL); %A11363700
EMITB(BBC,BUMPL,S); %A11363800
EMITB(BFC,S,L); %A11363900
EMITV(FP2); EMIT(0); EMITO(NEQ); %A11364000
S ~ BUMPL; %A11364100
EMITV(FP2); EMITL(1); EMITO(SUB); %A11364200
EMITPAIR(FP2,STD); %A11364300
EMITO(ML2); %A11364400
EMITB(BBW,BUMPL,S-5); %A11364500
EMITB(BFC,S,L); %A11364600
EMITV(FP3); EMITPAIR(1,BFC); EMITO(DV2); %A11364700
S ~ BUMPL; %A11364800
EMITB(BFC,T,L); %A11364900
EMITB(BFC,R,L); %A11365000
EMITO(MKS); %A11365100
EMITO(MKS); %A11365200
EMITV(YLO); EMITV(YHI); %A11365300
EMITV(DLN); EMITV(JUNK); EMITV(XLO); EMITV(XHI); %A11365400
EMITO(ML2); EMITV( DXP); %A11365500
EMITV(JUNK); %A11365600
EMITB(BFW,S,L); %A11365700
EMITPAIR(YHI,STD); EMITPAIR(YLO,STD); %A11365800
EMITO(XIT); %A11365900
END OF EMITDBLFACT; %A11366000
PROCEDURE EMITDBLPLXFACT; %A11366100
BEGIN REAL T; %A11366200
DEFINE XLO = FM2#, XHI = FM1#, REHI = FM4#, %A11366300
RELO = FM5#, IMHI = FM6#, IMLO = FM7#; %A11366400
EMIT(0); %A11366500
EMITV(IMLO); EMIT(0); EMITO(EQL); %A11366600
EMITV(IMHI); EMIT(0); EMITO(EQL); EMITO(LND); %A11366700
EMITV(REHI); EMIT(0); EMITO(GEQ); EMITO(LND); %A11366750
T ~ BUMPL; %A11366800
EMITV(RELO); EMITV(REHI); %A11366900
EMITO(MKS); EMITV(XLO); EMITV(XHI); %A11367000
EMITV(DBLFACT); %A11367100
EMITPAIR(REHI,STD); EMITPAIR(RELO,STD); %A11367200
EMITO(XIT); %A11367300
EMITB(BFC,T,L); %A11367400
EMITO(MKS); %A11367500
EMITV(IMLO); EMITV(IMHI); %A11367600
EMITV(RELO); EMITV(REHI); %A11367700
EMITV(DATN2); %A11367800
EMITV(JUNK); %A11367900
EMITV(XLO); EMITV(XHI); EMITO(ML2); % FP2, FP3 %A11368000
% %A11368100
EMITO(MKS); EMITV(IMLO); EMITV(IMHI); %A11368200
EMITV(IMLO); EMITV(IMHI); EMITO(ML2); %A11368300
EMITV(RELO); EMITV(REHI); %A11368400
EMITV(RELO); EMITV(REHI); %A11368500
EMITO(ML2); EMITO(AD2); %A11368600
EMITV(DSQRT); EMITV(JUNK); EMITO(MKS); %A11368700
EMITV(XLO); EMITV(XHI); EMITV(DBLFACT); %A11368800
EMITPAIR(RELO,STD); EMITO(DUP); %A11368900
EMITV(RELO); EMITO(XCH); %A11369000
EMITV(RELO); %A11369100
EMITO(MKS); EMITV(FP2); %A11369200
EMITV(FP3); EMITV(DCOS); EMITV(JUNK); EMITO(ML2); %A11369300
EMITPAIR(REHI,STD); EMITPAIR(RELO,STD); %A11369400
EMITO(MKS); %A11369500
EMITV(FP2); EMITV(FP3); %A11369600
EMITV(DSIN); EMITV(JUNK); EMITO(ML2); %A11369700
EMITPAIR(IMHI,STD); EMITPAIR(IMLO,STD); %A11369800
EMITO(XIT); %A11369900
END OF EMITDBLPLXFACT; %A11370000
PROCEDURE EMITPLXPRINT(BV); VALUE BV; BOOLEAN BV; %A11370100
BEGIN %A11370200
EMIT(0); %A11370300
EMITO(DUP); EMITV(FM2+REAL(BV)); EMITO(EQL); %A11370400
IF BV THEN BEGIN EMIT(0); %A11370500
EMITV(FM4); EMITO(EQL); %A11370600
EMITO(LND) END; %A11370700
EMITPAIR(5+REAL(BV),BFC); %A11370800
EMITO(MKS); %A11370900
IF BV THEN EMITV(FM2); EMITV(FM1); %A11371000
EMIT(0); %A11371100
EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11371200
EMITO(XIT); %A11371300
EMITV(FM1); EMIT(0); EMITO(NEQ); %A11371400
IF BV THEN BEGIN EMITV(FM2); EMIT(0); EMITO(NEQ); EMITO(LOR) %A11371500
END; %A11371600
EMITO(DUP); %A11371700
EMITPAIR(4+REAL(BV),BFC); %A11371800
EMITO(MKS); %A11371900
IF BV THEN EMITV(FM2); EMITV(FM1); %A11372000
EMIT(0); %A11372100
EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11372200
EMITV(FM2 + REAL(BV)); %A11372300
% %A11372400
EMIT(0); EMITO(LSS); %A11372500
EMITPAIR(5,BFC); %A11372600
EMITO(MKS); EMITL("-"); EMITV(CHARPRINT); %A11372700
EMITPAIR(6,BFW); EMITV(FP2); %A11372800
EMITPAIR(3,BFC); %A11372900
EMITO(MKS); EMITL("+"); EMITV(CHARPRINT); %A11373000
EMITO(MKS); EMITL(":"); EMITV(CHARPRINT); %A11373100
EMITO(MKS); %A11373200
IF BV THEN EMITV(FM4); %A11373300
EMITV(FM2+REAL(BV)); %A11373400
EMITO(SSP); EMIT(0); %A11373500
EMITV(IF BV THEN DBLPRINT ELSE ARITHPRINT); %A11373600
EMITO(XIT); %A11373700
END OF EMITPLXPRINT; %A11373800
PROCEDURE EMITERRPRO; %A11373900
BEGIN %A11374000
EMITV(BLOCKCTR); %A11374100
EMITL(1); EMITO(ADD); %A11374200
EMITPAIR(BLOCKCTR,SND); %A11374300
EMITO(MKS); EMITV(FM1); EMITV(FM3); EMITV(FM2); %A11374400
EMIT(0); EMITN(OUTSTR); EMITO(ECM); %A11374500
STREAMTOG ~ TRUE; %A11374600
EMITC(10,TRP); EMIT("GT"); EMIT("L "); %A11374700
EMIT("ER"); EMIT("RO"); %A11374800
EMIT("R "); EMITC(4,SES); %A11374900
EMITC(6,SFS); EMITC(2,TRS); %A11375000
EMITC(6,TRP); EMIT(", "); EMIT("S "); %A11375100
EMIT("= "); %A11375200
EMITC(4,OCV); EMITC(6,TRP); EMIT(", "); %A11375300
EMIT("A "); EMIT("= "); EMITC(4,OCV); %A11375400
EMITC(5,TRP); EMIT(" "); EMIT("--"); %A11375500
EMIT(" ~"); EMITC(1,0); STREAMTOG ~ FALSE; %A11375600
EMIT(0); EMITPAIR(OUTSTR,LOD); EMITO(CTC); %A11375700
EMITPAIR(34,COM); %A11375800
END OF EMITERRPRO; %A11375900
PROCEDURE EMITGENLINK; %A11376000
BEGIN REAL A,B,C,D; %A11376100
EMIT(0); %A11376200
EMITL(1); EMITPAIR(GENU,STD); %A11376300
EMITV(GENOK); EMITERR(SGNO,L,"12"); %A11376400
IF SYMSTK THEN BEGIN EMITV(LNKROW); EMITL(1); %A11376410
EMITO(INX); EMITPAIR(LNKROW,SND); %A11376420
GETCONTENTS(0,TRUE); EMITV(FM2); EMITO(XCH); %A11376430
EMITO(STD); EMITV(LNKROW) END ELSE BEGIN %A11376440
EMITV(LNKROW); EMITL(512); EMITO(EQL); %A11376500
A ~ BUMPL; %A11376600
EMITV(LNKCOL); EMITV(COLSET); %A11376700
EMITO(GTR); %A11376800
B ~ BUMPL; %A11376900
EMITV(FREELIST); EMIT(0); EMITO(EQL); %A11377000
C ~ BUMPL; %A11377100
IF RECLAIMTOG THEN BEGIN %A11377200
EMITO(MKS); EMITV(MARKER); EMITO(MKS); EMITV(COLLECT); %A11377300
EMITV(FREELIST); EMIT(0); EMITO(EQL); %A11377400
D ~ BUMPL; END; %A11377500
EMITB(BFC,B,L); %A11377600
EMIT(0); EMITPAIR(LNKROW,STD); %A11377700
EMITV(LNKCOL); EMITL(1); EMITO(ADD); %A11377800
EMITPAIR(LNKCOL,SND); EMITL(64); %A11377900
EMITO(EQL); EMITERR(SGNO,L,"10") ; % %A11378000
EMITB(BFC,A,L); %A11378100
EMITV(LNKCOL); EMITN(LNKA); EMITO(LOD); %A11378200
EMITV(LNKROW); EMITO(CDC); EMITV(FM2); %A11378300
EMITO(XCH); EMITO(STD); EMITV(LNKROW); %A11378400
EMITV(LNKCOL); EMITD(42,33,6); %A11378500
EMITPAIR(FM2,STD); %A11378600
EMITV(LNKROW); EMITL(1); EMITO(ADD); %A11378700
EMITPAIR(LNKROW,STD); EMITO(XIT); %A11378800
EMITB(BFC,C,L); IF RECLAIMTOG THEN EMITB(BFC,D,L); %A11378900
EMITV(FREELIST); %A11379000
EMITO(DUP); %A11379100
GETCONTENTS(0,TRUE); EMITO(DUP); %A11379200
EMITO(LOD); EMITPAIR(FREELIST,STD); %A11379300
EMITV(FM2); EMITO(XCH); EMITO(STD); %A11379400
END; %A11379450
EMITPAIR(FM2,STD); EMITO(XIT); %A11379500
END OF EMITGENLINK; %A11379600
PROCEDURE EMITGENSYM; %A11379700
BEGIN %A11379800
EMIT(0); %A11379900
EMIT(0); EMITO(MKS); EMITV(GENNO); %A11380000
EMITL(1); EMITO(ADD); EMITPAIR(GENNO,SND); %A11380100
EMITO(ECM); STREAMTOG ~ TRUE; %A11380200
EMITC(3,SED); EMITC(1,SES); %A11380300
EMITC(2,TPR); EMIT("4G"); %A11380400
EMITC(3,OCV); EMITC(1,0); %A11380500
STREAMTOG ~ FALSE; %A11380600
GENSYMLINK; %A11380700
IF RECLAIMTOG THEN BEGIN EMITO(SSN); %A11380800
MARKSYMNCR(1); END; %A11380900
EMIT(0); EMITO(XCH); %A11381000
EMITO(CTF); EMITO(SSN); %A11381100
GENSYMLINK; %A11381200
MARKSYMDCR(-1); %A11381300
EMITO(RTN); %A11381400
END OF EMITGENSYM; %A11381500
PROCEDURE EMITLENGTH; %A11381600
BEGIN REAL T; %A11381700
EMIT(0); %A11381800
EMITV(FM1); %A11381900
EMITI(0,33,15); EMITO(DUP); %A11382000
EMITL(9);EMITO(LEQ); %A11382100
EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11382200
EMITO(DUP); EMITL(64); EMITO(LSS); %A11382300
EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11382400
GETCONTENTS(0,FALSE); EMITL(2); %A11382500
EMITDIAL(DIA,46); EMITDIAL(DIB,1); EMITFC(FCE,2); %A11382600
T ~ BUMPL; %A11382700
GETCONTENTS(1,FALSE); EMITI(0,1,5); %A11382800
EMITO(RTN); %A11382900
EMITB(BFC,T,L); %A11383000
EMITO(DUP); EMIT(0); EMITO(LSS); %A11383100
EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11383200
EMITL(1); %A11383300
T ~ L; %A11383400
EMITO(XCH); %A11383500
GETCONTENTS(0,FALSE); %A11383600
EMITO(DUP); EMIT(0); EMITO(LSS); %A11383700
EMITPAIR(2,BFC); EMITO(XCH); EMITO(RTN); %A11383800
EMITO(XCH); EMITL(1); EMITO(ADD); %A11383900
EMITB(BBW,BUMPL,T); %A11384000
END OF EMITLENGTH; %A11384100
PROCEDURE EMITMARK; %A11384200
BEGIN REAL T,R; %A11384300
EMIT(0); %A11384400
T ~ L; %A11384500
EMITV(FM1); EMITO(DUP); %A11384600
EMITV(FREENL); %A11384700
EMITO(LSS); %A11384800
EMITPAIR(1,BFC); EMITO(XIT); %A11384900
GETCONTENTS(0,TRUE); EMIT(0); %A11385000
EMITO(MKS); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %A11385100
EMITC(4,RSA); EMITC(1,TIB); EMITC(2,JFC); %A11385200
EMITC(1,SEC); EMITC(3,STC); %A11385300
EMITC(1,0); %A11385400
STREAMTOG ~ FALSE; %A11385500
EMITPAIR(1,BFC); EMITO(XIT); %A11385600
EMITO(DUP); EMITO(LOD); EMITO(XCH); %A11385700
SETBIT; %A11385800
% %A11385900
EMITO(DEL); EMITO(DUP); %A11386000
EMITI(0,1,2); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11386100
R ~ BUMPL; L ~ L + 4; %A11386200
GETCONTENTS(0,TRUE); SETBIT; EMITO(XIT); %A11386300
EMITB(BFW,R,L); R ~ R + 2; %A11386400
EMITO(MKS); EMITV(FP2); EMITI(0,3,15); %A11386500
EMITV(MARK); EMITO(MKS); EMITV(FP2); %A11386600
EMITI(0,18,15); EMITV(MARK); EMITI(0,33,15); %A11386700
EMITB(BBW,BUMPL,T + 1); %A11386800
EMITB(BFW,R,L); R ~ R + 2; %A11386900
EMITI(0,33,15); %A11387000
EMITB(BBW,BUMPL,T+1); %A11387100
EMITB(BFW,R,L); %A11387200
EMITO(DUP); EMITI(0,3,15); %A11387300
EMITPAIR(FM1,STD); EMITO(MKS); %A11387400
EMITV(FP2); EMITI(0,33,15); %A11387500
EMITV(MARK); GETCONTENTS(1,TRUE); %A11387600
EMITO(DUP); EMITO(LOD); %A11387700
EMITO(XCH); SETBIT; EMITO(DEL); %A11387800
EMITO(DUP); EMITI(0,1,5); %A11387900
R ~ L; %A11388000
EMITO(DUP); EMITL(8); %A11388100
EMITO(LSS); EMITPAIR(4,BFC); %A11388200
EMITO(DEL); EMITO(DEL); %A11388300
EMITB(BBW,BUMPL,T); %A11388400
EMITL(4); EMITO(SUB); EMITO(XCH); %A11388500
GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11388600
EMITO(XCH); SETBIT; EMITO(DEL); %A11388700
EMITO(XCH); %A11388800
EMITB(BBW,BUMPL,R); %A11388900
END OF EMITMARK; %A11389000
PROCEDURE EMITMARKD; %A11389100
BEGIN REAL R,S; EMIT(0); %A11389200
EMITPAIR(FM1,LOD); EMITO(MOP); EMITO(DUP); %A11389300
EMITI(0,33,15); EMITL(3); %A11389400
EMITO(LEQ); EMITPAIR(1,BFC); EMITO(XIT); %A11389500
EMITI(0,8,10); % WORD COUNT FP2 %A11389600
EMIT(0); EMIT(0); % FP3 %A11389700
EMITN(FM1); EMITO(LOD); %A11389800
EMITO(TOP); EMITO(XCH); EMITO(DEL); %A11389900
R ~ BUMPL; %A11390000
EMITO(MKS); EMIT(0); %A11390100
EMITV(FP3); EMITV(FM1); %A11390200
EMITO(CTC); EMITV(MARK); %A11390300
EMITL(1); EMITO(ADD); %A11390400
EMITO(DUP); EMITV(FP2); %A11390500
EMITO(GEQ); %A11390600
EMITB(BBC,BUMPL,R); EMITO(XIT); %A11390700
EMITB(BFC,R, R ~ L); %A11390800
EMITO(MKS); EMITV(FP3); %A11390900
EMITN(FM1); EMITO(LOD); %A11391000
EMITV(MARKD);EMITL(1); %A11391100
EMITO(ADD); EMITO(DUP); %A11391200
EMITV(FP2); EMITO(GEQ); %A11391300
EMITB(BBC,BUMPL,R); %A11391400
EMITO(XIT); %A11391500
END OF EMITMARKD; %A11391600
PROCEDURE EMITMARKER; %A11391700
BEGIN REAL T,R,S; %A11391800
EMIT(0); %A11391900
% %A11392000
EMITO(MKS); EMITV(INSYM); EMITI(0,33,15); EMITV(MARK); %A11392100
EMITO(MKS); EMITV(MARKOB); %A11392200
EMITL(127); % FP2 %A11392400
T ~ L; %A11392500
EMITL(1); EMITO(ADD); EMITO(DUP); %A11392600
EMITV(TABLEMARK ); EMITO(GTR); %A11392700
EMITPAIR(1,BFC); EMITO(XIT); %A11392800
EMITO(DUP); EMITN(SYMSTACKA); %A11392900
EMITO(LOD); %A11393000
EMITO(TOP); %A11393100
R ~ BUMPL; %A11393200
EMITO(DUP); EMITPAIR(0,LSS); %A11393300
S ~ BUMPL; %A11393400
GETCONTENTS(0,TRUE); SETBIT; %A11393500
EMITB(BFC,R,R ~ BUMPL); %A11393600
EMITO(LOD); EMITO(TOP); %A11393700
EMITB(BFC,S,S ~ BUMPL); %A11393800
EMITO(MKS); EMIT(0); EMITV(FP3); EMITO(CTC); EMITV(MARK); %A11393900
EMITPAIR(4,BFW); %A11394000
EMITB(BFC,S,L); %A11394100
EMITO(MKS); EMITPAIR(FP3,LOD); EMITV(MARKD); %A11394200
EMITB(BFC,R,L); %A11394300
EMITO(DEL); %A11394400
EMITB(BBW,BUMPL,T); %A11394500
END OF EMITMARKER; %A11394600
PROCEDURE EMITMARKOB; %A11394700
BEGIN REAL T; %A11394800
EMIT(0); %A11395000
EMIT(0); %A11395300
T ~ L; %A11395400
EMITO(MKS); EMITV(FP2); %A11395500
GETCONTENTS(0,FALSE); EMITI(0,33,15); %A11395600
EMITV(MARK); EMITL(1); EMITO(ADD); %A11395700
EMITO(DUP); EMITL(64); EMITO(GEQ); %A11395800
EMITB(BBC,BUMPL,T); EMITO(DEL); EMIT(0); %A11395900
T ~ L; %A11396000
EMITO(MKS); EMITV(FP2); %A11396100
EMITV(SYMSTACKA); EMITI(0,33,15); %A11396200
EMITV(MARK); %A11396300
EMITL(1); EMITO(ADD); EMITO(DUP); %A11396400
EMITL(125); EMITO(GEQ); %A11396500
EMITB(BBC,BUMPL,T); %A11396600
EMITO(MKS); EMITV(FREELIST); EMITV(MARK); %A11396800
EMITO(XIT); %A11396900
END OF EMITMARKOB; %A11397000
PROCEDURE EMITMEMBER; %A11397100
BEGIN REAL T; %A11397200
EMIT(0); %A11397300
T ~ L; %A11397400
EMITV(FM1); %A11397500
GETCONTENTS(0,FALSE); EMITPAIR(FM1,SND); %A11397600
EMIT(0); EMITO(LSS); %A11397700
EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11397800
EMITV(FM2); EMITV(FM1); %A11397900
EMITI(0,18,15); %A11398000
EMITO(MKS); %A11398100
EMITV(SYMEQ); EMITO(DEL); %A11398200
EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11398300
EMITB(BBW,BUMPL,T); %A11398400
END OF EMITMEMBER; %A11398500
PROCEDURE EMITMKATOM; %A11398600
BEGIN REAL T,R; %A11398700
EMIT(0); %A11398800
EMITV(COUNTI); EMITO(DUP); %A11398900
EMITL(1); EMITO(EQL); %A11399000
T ~ BUMPL; %A11399100
EMIT(0); EMITV(INSTR); %A11399200
EMITI(0,18,6); EMITO(RTN); %A11399300
EMITB(BFC,T,L); EMITO(DUP); %A11399400
EMITL(7); EMITO(GTR); %A11399500
EMITPAIR(4,BFC); %A11399600
EMITL(3); EMITO(LND); EMITL(4); %A11399700
EMITO(ADD); EMITO(DUP); %A11399800
IF RECLAIMTOG THEN EMITL(1); %A11399900
EMIT(0); T ~ L; %A11400000
EMITO(MKS); EMITV(COUNTI); EMITO(DUP); EMITV(FP3); %A11400100
EMITO(SUB); EMITV(FP2); EMIT(0); %A11400200
EMITN(INSTR); EMITO(ECM); STREAMTOG ~ TRUE; %A11400300
EMITC(6,SED); EMITC(4,SES); %A11400400
EMITC(7,SFS); EMITC(1,TRS); %A11400500
EMITC(1,RSA); EMITC(3,CRF); %A11400600
EMITC(0,SFS); EMITC(3,SFS); EMITC(2,CRF); %A11400700
EMITC(0,TRS); EMITC(1,0); %A11400800
STREAMTOG ~ FALSE; %A11400900
GENSYMLINK; %A11401000
IF RECLAIMTOG THEN BEGIN EMITO(DUP); EMITO(SSN); %A11401100
MARKSYMNCR(1); L ~ L-1; EMITO(STD) END; %A11401200
EMITV(FP3); EMITV(COUNTI); %A11401300
EMITO(NEQ); %A11401400
R ~ BUMPL; %A11401500
EMITV(FP3); EMITL(4); EMITPAIR(FP2,SND); %A11401600
EMITO(ADD); EMITPAIR(FP3,STD); %A11401700
IF RECLAIMTOG THEN BEGIN EMITV(FP4); EMITL(1); %A11401800
EMITO(ADD); EMITPAIR(FP4,STD); END; %A11401900
EMITB(BBW,BUMPL,T); %A11402000
EMITB(BFC,R,L); %A11402100
EMIT(0); EMITO(XCH); EMITO(CTF); %A11402200
EMITO(SSN); %A11402300
EMITV(FM1); R ~ BUMPL; %A11402400
EMIT(0); EMITV(INSTR); EMITL(125); EMITO(RDV); %A11402500
EMITN(SYMSTACKA); EMITO(DUP); EMITO(LOD); %A11402600
EMITO(DUP); EMIT(0); EMITO(EQL); %A11402700
EMITPAIR(2,BFC); EMITO(DEL); EMITL(1); %A11402800
EMITV(IF RECLAIMTOG THEN FP5 ELSE FP4); %A11402900
EMITO(XCH); EMITD(33,3,15); %A11403000
EMITB(BFC,R,L); %A11403100
GENSYMLINK; %A11403200
IF RECLAIMTOG THEN BEGIN EMITV(TABLEMARK); %A11403300
EMITV(FP4); EMITO(SUB); %A11403400
EMITPAIR(TABLEMARK,STD); END; %A11403500
EMITV(FM1); EMITPAIR(2,BFC); %A11403600
EMITO(XCH); EMITO(SND); EMITO(RTN) %A11403700
END OF EMITMKATOM; %A11403800
PROCEDURE EMITMONPRO; %A11403900
BEGIN REAL T,R; %A11404000
REAL A1,A2,A3; %A11404100
EMIT(0); %A11404200
EMITL(12); %A11404300
EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11404400
TRPRI; %A11404500
EMITO(MKS); EMITV(CPM); EMITL(4); EMITO(ADD); %T9311404600
EMITPAIR(CPM,SND); %A11404700
EMITV(RMARG); EMITV(LMARG); EMITO(SUB); %A11404800
EMITO(RDV); EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11404900
ALFP("CALL "); %A11405000
EMITO(MKS); EMITV(FM2); EMITV(ALFPRINT); %A11405100
TRPRI; %A11405200
EMITV(FM1); EMITO(DUP); %A11405300
EMIT(0); EMITO(EQL); %A11405400
EMITPAIR(1,BFC); EMITO(XIT); %A11405500
EMITO(DUP); EMITO(ADD); %A11405600
EMITL(FM2); EMITO(ADD); % FP3 %A11405700
R ~ L; %A11405800
EMITPAIR(JUNK,ISN); %A11405900
EMITO(MKS); EMITV(CPM); EMITV(RMARG); %A11406000
EMITV(LMARG); EMITO(SUB); EMITO(RDV); %A11406100
EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11406200
EMITV(FP3); EMITO(LOD); %A11406300
EMITO(NOP); EMITO(LOD); %A11406400
EMITV(FP3); EMITL(1); %A11406500
EMITO(SUB); EMITPAIR(FP3,ISD); %A11406600
EMITV(FP3); EMITO(LOD); %A11406700
EMITO(BFW); %A11406800
T ~ L ~ L + 6; %A11406900
EMITO(MKS); EMITL(12); EMITV(CHARPRINT); A1 ~ BUMPL; %A11407000
EMITB(BFW,T - 4,L); %A11407100
EMITO(MKS); EMITV(FP4); EMIT(0); %A11407200
EMITV(ARITHPRINT); A2 ~ BUMPL; %A11407300
EMITB(BFW,T-2,L); %A11407400
EMITO(MKS); EMITV(FP4); EMITV(BOOPRINT); A3 ~ BUMPL; %A11407500
EMITB(BFW,T,L); %A11407600
EMITO(MKS); EMITV(FP4); EMITV(SYMPRINT); %A11407700
EMITB(BFW,A1,L); EMITB(BFW,A2,L); EMITB(BFW,A3,L); EMITO(DEL); %A11407800
TRPRI; %A11407900
EMITL(1); EMITO(SUB); EMITO(DUP); %A11408000
EMITL(FM2); EMITO(EQL); %A11408100
EMITB(BBC,BUMPL,R); %A11408200
EMITO(XIT); %A11408300
END OF EMITMONPRO; %A11408400
PROCEDURE EMITMONSYM; %A11408500
BEGIN REAL T,R; %A11408600
DEFINE ALF = FM3#, N = FM2#, VAL = FM4#; %A11408700
EMIT(0); %A11408800
EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11408900
TRPRI; %A11409000
EMITO(MKS); EMITV(CPM); %A11409100
EMITV(RMARG); EMITV(LMARG); %A11409200
EMITO(SUB); EMITO(RDV); %A11409300
EMITPAIR(JUNK,ISN); EMITV(SPACEPRINT); %A11409400
EMITO(MKS); EMITV(ALF); EMITV(ALFPRINT); %A11409500
% %A11409600
EMITV(N); EMIT(0); EMITO(NEQ); %A11409700
T ~ BUMPL; %A11409800
EMITV(N); EMITL(FM4); EMITO(ADD); % FP2 %A11409900
EMITPAIR(JUNK,ISN); %A11410000
PRINCH("["); EMITPAIR(3,BFW); %A11410100
R ~ L; %A11410200
PRINCH(","); EMITO(MKS); EMITV(FP2); EMITO(LOD); %A11410300
EMIT(0); %A11410400
EMITV(ARITHPRINT); EMITL(1); EMITO(SUB); %A11410500
EMITO(DUP); EMITL(FM4); %A11410600
EMITO(EQL); %A11410700
EMITB(BBC,BUMPL,R); %A11410800
PRINCH("]"); %A11410900
EMITB(BFC,T,L); %A11411000
PRINCH(" "); PRINCH("="); PRINCH(" "); %A11411100
EMITO(MKS); EMITV(VAL); %A11411200
EMITV(SYMPRINT); %A11411300
TRPRI; %A11411400
EMITV(CPM); EMITV(FM1); EMITO(SUB); %A11411500
EMITPAIR(CPM,STD); EMITO(XIT); %A11411600
END OF EMITMONSYM; %A11411700
PROCEDURE EMITNCONC; %A11411800
BEGIN REAL T; %A11411900
EMIT(0); EMITV(FM2); %A11412000
GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11412100
EMITO(DUP); EMIT(0); %A11412200
EMITO(LSS); %A11412300
EMITPAIR(2,BFC); EMITV(FM1); %A11412400
EMITO(RTN); %A11412500
T ~ L; %A11412600
EMITO(DUP); %A11412700
GETCONTENTS(0,TRUE); %A11412800
EMITO(DUP); EMITO(LOD); %A11412900
EMITO(DUP); EMIT(0); %A11413000
EMITO(LSS); %A11413100
EMITPAIR(8,BFC); %A11413200
EMITO(DEL); EMITO(DEL); %A11413300
EMITV(FM1); EMITO(CTC); EMITO(XCH); %A11413400
EMITO(STD); EMITV(FM2); EMITO(RTN); %A11413500
EMITPAIR(FP2,STD); EMITO(XCH); EMITO(DEL); %A11413600
EMITO(XCH); %A11413700
EMITB(BBW,BUMPL,T); %A11413800
END OF EMITNCONC; %A11413900
PROCEDURE EMITNTA; %A11414000
BEGIN %A11414100
EMIT(0); %A11414200
EMITV(FM2); EMITO(DUP); %A11414300
EMIT(0); EMITO(GEQ); EMITO(XCH); %A11414400
EMITL( 9); EMITO(LEQ); EMITO(LND); %A11414500
EMITPAIR(11,BFC); %A11414600
EMITV(FM2); EMITO(DUP); %A11414700
EMITPAIR(JUNK,ISN); EMITO(EQL); %A11414800
EMITPAIR(4,BFC); %A11414900
EMITV(JUNK); EMITPAIR(FM2,STD); EMITO(XIT); %A11415000
EMITV(FM2); %A11415100
GENSYMLINK; EMITL(3); %A11415200
EMITD(46,1,2); %A11415300
MARKSYMNCR(1); %A11415400
GENSYMLINK; EMITPAIR(FM2,STD); %A11415500
MARKSYMDCR(-1); EMITO(XIT); %A11415600
END OF EMITNTA; %A11415700
PROCEDURE EMITNTS; %A11415800
BEGIN REAL A,L1,L2; %A11415900
REAL B,C; %A11416000
DEFINE %A11416100
XLO = FM4#, %A11416200
XHI = FM3#, %A11416300
N = FM2#, %A11416400
TIN = FM1#, %A11416500
R = FP2#, % DIGITS IN %A11416600
EA = FP3#, %A11416700
SE = FP4#, %A11416800
E = FP5#, %A11416900
J = FP6#, %A11417000
SN = FP7#, %A11417100
T = FP8#, % DIGITS TO BE CONVERTED %A11417200
TN = FP9#; %A11417300
FOR A ~ 1 STEP 1 UNTIL 6 DO EMIT(0); %A11417400
EMITV(XHI); EMIT(0); EMITO(LSS); %A11417500
EMITV(XLO); EMITV(XHI); EMITO(SSP); %A11417600
EMIT(0); %A11417700
EMITL(1); %A11417800
EMITO(ML2); EMITO(XCH); %A11417900
EMITPAIR(XLO,STD); EMITPAIR(XHI,SND); %A11418000
EMITO(DUP); EMITL(6); EMITV(TIN); EMITO(LSS); %A11418100
L1 ~ BUMPL; %A11418200
EMITO(DUP); EMITO(DUP); %A11418300
EMITPAIR(J,ISN); EMITO(EQL); %A11418400
EMIT(0); EMITV(XLO); EMITO(EQL); %A11418500
EMITV(N); EMITL(6); EMITO(LSS); EMITO(LOR); EMITO(LND); %A11418600
L2 ~ BUMPL; %A11418700
EMIT(0); EMITO(MKS); EMIT(0); %A11418800
EMITN(OUTSTR); EMITO(ECM); STREAMTOG ~ TRUE; %A11418900
EMITC(1,SFD); EMITC(6,SES); %A11419000
EMITC(6,OCV); %A11419100
EMITC(1,RDA); EMITC(5,CRF); %A11419200
EMITC(0,JFW); EMITC(2,JFW); %A11419300
EMITC(1,TRP); EMIT("-"); %A11419400
EMITC(1,RSA); EMITC(1,SFS); %A11419500
EMITC(6,SEC); %A11419600
EMITC(5,BNS); %A11419700
EMITC(0,TEQ); EMITC(3,JNC); %A11419800
EMITC(63,INC); EMITC(1,SFS); %A11419900
EMITC(0,ENS); EMITC(3,STC); %A11420000
EMITC(3,CRF); EMITC(0,TRS); %A11420100
EMITC(5,CRF); EMITC(0,INC); %A11420200
EMITC(3,STC); EMITC(1,0); %A11420300
STREAMTOG ~ FALSE; %A11420400
EMITPAIR(NSTR,STD); %A11420500
EMITV(SN); EMITPAIR(JUNK,STD); %A11420600
EMITO(XIT); %A11420700
% %A11420800
EMITB(BFC,L1,L); %A11420900
EMITB(BFC,L2,L); %A11421000
EMITO(DUP); EMITI(0,3,6); %A11421100
EMITO(XCH); EMITD(2,1,1); EMITL(12); EMITO(ADD); %A11421200
EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 ELSE CPLUS1); %A11421300
A ~ BUMPL; %A11421400
EMITWORD(0.90309); %A11421500
EMITB(BFW,A,L); %A11421600
EMITO(MUL); EMITREL(0.5); EMITO(ADD); %A11421700
EMITPAIR(E,ISN); %A11421800
L1 ~L; %A11421900
EMITO(DUP); EMIT(0); EMITO(GEQ); %A11422000
EMITPAIR(4,BFC); %A11422100
EMITV(E); EMITV(TIN); EMITPAIR(5,BFW); %A11422200
EMITL(1); EMITV(E); EMITO(SSP); %A11422300
EMITV(TIN); EMITO(DTV); %A11422400
EMITV(XHI); EMITO(GTR); %A11422500
EMITPAIR(6,BFC); %A11422600
EMITL(1); EMITO(SUB); %A11422700
EMITPAIR(E,ISN); %A11422800
EMITB(BBW,BUMPL,L1); EMITO(DEL); %A11422900
EMITV(N); EMITL(1); EMITO(ADD); %A11422910
EMITO(DUP); EMITL(7); EMITO(GTR); %A11423000
EMITPAIR(2,BFC); EMITO(DEL); EMITL(7); %A11423100
EMITO(DUP); EMITV(E); EMITO(XCH); EMITO(SUB); EMITL(1); %A11423200
EMITO(ADD); EMITO(DUP); %A11423300
EMIT(0); EMITO(GTR); %A11423400
L1 ~ BUMPL; %A11423500
EMITV(XLO); EMITV(XHI); %A11423600
EMITV(TN); EMITL(69); EMITO(ADD); EMITV(TIN); %A11423700
EMITV(TN); EMITV(TIN); EMITO(DV2); %A11423800
EMITB(BFC,L1,L1 ~ BUMPL); %A11423900
EMITV(XLO); EMITV(XHI); %A11424000
EMITV(TN); EMITO(SSP); EMITO(DUP); %A11424100
EMITL(69); EMITO(ADD); EMITV(TIN); %A11424200
EMITO(XCH); EMITV(TIN); EMITO(ML2); %A11424300
EMITB(BFW,L1,L); %A11424400
EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11424500
EMITO(DEL); %A11424600
EMITL(1); EMITO(ADD); %A11424700
EMITV(N); EMITL(2); EMITO(ADD); %A11424800
EMIT(0); %A11424900
L1 ~ L; EMITV(XHI); EMITREL(.5); EMITO(SUB); EMITPAIR(J,ISD); %A11425000
EMITV(R); EMITV(T); EMITO(ADD); EMITV(TN); %A11425100
EMITO(EQL); EMITO(MKS); %A11425200
EMITPAIR(OUTSTR,LOD); EMITL(10); EMITN(OUTSTR); %A11425300
EMITO(ECM); STREAMTOG ~ TRUE; %A11425400
EMITC(13,CRF); EMITC(0,SFD); %A11425500
EMITC(9,SES); EMITC(7,CRF); %A11425600
EMITC(0,OCV); EMITC(4,CRF); %A11425700
EMITC(0,JFW); EMITC(18,JFW); %A11425800
EMITC(2,RDA); EMITC(6,CRF); %A11425900
EMITC(3,BNS); EMITC(1,TRP); %A11426000
EMIT(0); EMITC(0,ENS); %A11426100
EMITC(1,SRD); EMITC(1,TRP); %A11426200
EMIT(5); EMITC(2,RSA); %A11426300
EMITC(1,RDA); EMITC(6,CRF); %A11426400
EMITC(0,FAD); EMITC(1,RSA); %A11426500
EMITC(1,TEQ); EMITC(2,JFC); %A11426600
EMITC(1,SEC); EMITC(5,STC); %A11426700
EMITC(1,0); STREAMTOG ~ FALSE; %A11426800
L2 ~ BUMPL; %A11426900
EMITV(E); EMITO(ADD); %A11427000
EMITPAIR(E,STD); %A11427100
EMITB(BFC,L2,L2 ~ BUMPL); %A11427200
EMITV(R); EMITV(T); EMITO(ADD); %A11427300
EMITPAIR(R,SND); EMITV(TN); %A11427400
EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11427500
EMITL(8); EMITO(GTR); EMITPAIR(2,BFC); %A11427600
% %A11427700
EMITO(DEL); EMITL(8); %A11427800
EMITPAIR(T,SND); EMITV(TIN); EMIT(0); %A11427900
EMITO(XCH); EMITV(XLO); EMITV(XHI); %A11428000
EMIT(0); EMITV(J); EMITO(SB2); EMITO(ML2); %A11428100
EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11428200
EMITB(BBW,BUMPL,L1); %A11428300
EMITB(BFW,L2,L); %A11428400
EMITV(E); EMITL(1); EMITO(ADD); EMITO(DUP); %A11428500
EMITO(DUP); EMIT(0); EMITO(EQL); %A11428600
EMITO(XCH); EMITO(DUP); EMITL(1); EMITO(EQL); %A11428700
EMITO(XCH); EMITO(DUP); EMIT(0); EMITO(GTR); %A11428800
EMITO(XCH); EMITV(N); EMITO(LEQ); EMITO(LND); %A11428900
EMITV(N); EMITL(6); EMITO(LSS); EMITO(LND); %A11429000
EMITO(LOR); EMITO(LOR); %A11429100
L1 ~ BUMPL; %A11429200
EMITPAIR(J,ISN); EMITV(N); EMITO(SUB); %A11429300
EMITPAIR(EA,STD); EMIT(0); EMITPAIR(E,SND); %A11429400
EMITB(BFC,L1,L1 ~ BUMPL); EMITO(DEL); %A11429500
EMITL(1); EMITPAIR(J,STD); %A11429600
EMITV(N); EMITL(1); EMITO(SUB); %A11429700
EMITPAIR(EA,STD); EMITV(E); %A11429800
EMITB(BFW,L1,L); %A11429900
EMITO(DUP); EMITO(SSP); EMITPAIR(E,STD); %A11430000
EMIT(0); EMITO(LSS); EMITPAIR(SE,STD); %A11430100
EMIT(0); EMITO(MKS); %A11430200
EMITV(SN); EMITV(J); EMITV(E); %A11430300
EMITV(SE); EMITV(EA); %A11430400
EMITV(EA); EMIT(0); EMITO(NEQ); %A11430500
EMITV(E); EMIT(0); EMITO(NEQ); %A11430600
EMITV(E); EMITL(10); EMITO(GEQ); %A11430700
EMITL(1); EMITO(ADD); %A11430800
EMITL(10); EMITN(OUTSTR); %A11430900
EMIT(0); EMITN(OUTSTR); %A11431000
EMITO(ECM); STREAMTOG ~ TRUE; %A11431100
EMITC(2,RSA); EMITC(10,CRF); %A11431200
EMITC(0,JFW); EMITC(3,JFW); %A11431300
EMITC(1,TRP); EMIT("-"); %A11431400
EMITC(1,INC); EMITC(0,TEQ); %A11431500
EMITC(1,JFC); EMITC(1,SFS); %A11431600
EMITC(9,CRF); %A11431700
EMITC(0,TRS); EMITC(9,CRF); %A11431800
EMITC(0,INC); EMITC(5,CRF); %A11431900
EMITC(0,JFW); EMITC(23,JFW); %A11432000
EMITC(1,TRP); EMIT("."); %A11432100
EMITC(1,INC); EMITC(6,CRF); %A11432200
EMITC(0,TRS); EMITC(6,CRF); %A11432300
EMITC(0,INC); EMITC(1,RDA); %A11432400
EMITC(1,RSA); EMITC(5,STC); %A11432500
EMITC(5,CRF); EMITC(0,SFS); %A11432600
EMITC(6,CRF); %A11432700
EMITC(5,BNS); EMITC(1,SRS); %A11432800
EMITC(0,TEQ); EMITC(3,JNC); %A11432900
EMITC(63,INC); EMITC(0,ENS); %A11433000
EMITC(63,INC); EMITC(5,STC); %A11433100
EMITC(5,CRF); EMITC(0,SFD); %A11433200
% %A11433300
EMITC(4,CRF); EMITC(0,JFW); %A11433400
EMITC(14,JFW); EMITC(1,TRP); %A11433500
EMIT("@"); EMITC(1,INC); %A11433600
EMITC(7,CRF); %A11433700
EMITC(0,JFW); EMITC(3,JFW); %A11433800
EMITC(1,TRP); EMIT("-"); %A11433900
EMITC(1,INC); %A11434000
EMITC(8,SES); EMITC(3,CRF); %A11434100
EMITC(0,OCV); EMITC(3,CRF); %A11434200
EMITC(0,INC); EMITC(12,STC); %A11434300
EMITC(1,0); STREAMTOG ~ FALSE; %A11434400
EMITPAIR(NSTR,STD); %A11434500
EMITV(SN); EMITPAIR(JUNK,STD); %A11434600
EMITO(XIT); %A11434700
END OF EMITNTS; %A11434800
PROCEDURE EMITPLXFACT; %A11434900
BEGIN REAL T; %A11435000
DEFINE X = FM1#, RE = FM3#, IM = FM4#; %A11435100
EMIT(0); %A11435200
EMITV(IM); EMIT(0); EMITO(EQL); %A11435300
EMITV(RE); EMIT(0); EMITO(GEQ); EMITO(LND); %A11435350
T ~ BUMPL; %A11435400
EMITV(RE); EMITV(X); %A11435500
EMITO(MKS); %A11435600
EMITPAIR(GNAT(LOGI),LOD); EMITPAIR(GNAT(EXPI),LOD); %A11435700
EMITV(GNAT(XTOTHEI)); EMITO(DEL); %A11435800
EMITPAIR(RE,STD); EMITO(XIT); %A11435900
EMITB(BFC,T,L); %A11436000
EMITO(MKS); EMITV(IM); EMITV(RE); EMITV(36); %A11436100
EMITV(X); EMITO(MUL); %A11436200
EMITO(MKS); EMITV(IM); EMITV(RE); EMITV(CABS); %A11436300
EMITV(X); EMITO(MKS); %A11436400
EMITPAIR(GNAT(LOGI),LOD); EMITPAIR(GNAT(EXPI),LOD); %A11436500
EMITV(GNAT(XTOTHEI)); EMITO(DEL); %A11436600
EMITO(DUP); %A11436700
EMITO(MKS); EMITV(FP2); EMITV(GNAT(COSI)); %A11436800
EMITO(MUL); EMITPAIR(RE,STD); %A11436900
EMITO(MKS); EMITV(FP2); EMITV(GNAT(SINI)); %A11437000
EMITO(MUL); EMITPAIR(IM,STD); %A11437100
EMITO(XIT); %A11437200
END OF EMITPLXFACT; %A11437300
PROCEDURE EMITPROP; %A11437400
BEGIN REAL T; %A11437500
REAL R; %A11437600
EMIT(0); %A11437700
EMITV(FM3); %A11437800
GETCONTENTS(0,FALSE); %A11437900
EMITL(2); EMITDIAL(DIA,46); %A11438000
EMITDIAL(DIB,1); EMITFC(FCE,2); %A11438100
EMITO(LNG); EMITPAIR(2,BFC); %A11438200
EMIT(0); EMITO(RTN); %A11438300
T ~ L; %A11438400
EMITPAIR(FM3,SND); %A11438500
GETCONTENTS(0,FALSE); EMITO(DUP); %A11438600
EMIT(0); EMITO(LSS); %A11438700
EMITPAIR(2,BFC); EMIT(0); EMITO(RTN); %A11438800
EMITV(FM1); %A11438900
EMITDIAL(DIB,2); EMITV(FM2); %A11439000
R ~ BUMPL; %A11439100
EMITDIAL(DIA,46); EMITFC(FCE,2); %A11439200
EMITB(BBC,BUMPL,T); %A11439300
EMIT(0); EMITO(XCH); EMITD(4,19,29); %A11439400
EMITO(RTN); %A11439500
EMITB(BFC,R,L); EMITDIAL(DIA,32); EMITFC(FCE,16); %A11439600
EMITB(BBC,BUMPL,T); %A11439700
EMITV(FM2); EMIT(0); EMITO(EQL); %A11439800
R ~ BUMPL; %A11439900
EMITI(0,18,15); %A11440000
EMITO(RTN); %A11440100
EMITB(BFC,R,L); EMITV(FM3); EMITO(RTN); %A11440200
END OF EMITPROP; %A11440300
PROCEDURE EMITRANDNO; %A11440400
BEGIN INTEGER A,B,D,E; %A11440500
DEFINE %A11440600
C = 549755813885#, %A11440700
Z = 8*13#; %A11440800
EMIT(0); EMIT(0); %A11440900
EMITV(RND); %A11441000
EMIT(0); %A11441100
EMITREL(C); %A11441200
EMITO(ML2); EMITO(DUP); %A11441300
EMITREL(.5); %A11441400
EMITO(SUB); %A11441500
EMITPAIR(JUNK,ISN); %A11441600
EMIT(0); EMITO(XCH); %A11441700
EMITO(SB2); EMITPAIR(RND,SND); %A11441800
EMITO(RTN); %A11441900
END OF EMITRANDNO; %A11442000
PROCEDURE EMITRANDOM; %A11442100
BEGIN REAL T,R; %A11442200
REAL P; %A11442300
EMIT(0); %A11442400
EMITV(FM1); GETCONTENTS(0,FALSE); %A11442500
EMIT(0); %A11442600
EMITDIAL(DIA,46); EMITDIAL(DIB,1); %A11442700
EMITFC(FCE,2); %A11442800
T ~ BUMPL; %A11442900
EMITO(MKS); EMITV(RANDNO); EMITO(MKS); %A11443000
EMITV(FM1); EMITV(LENGTHV); %A11443100
EMITO(MUL); EMITREL (.5); EMITO(SUB); %A11443200
EMITPAIR(JUNK,ISN); %A11443300
R ~ L; %A11443400
EMITO(DUP); EMIT(0); EMITO(EQL); %A11443500
P ~ BUMPL; %A11443600
EMITO(XCH); EMITI(0,18,15); EMITO(RTN); %A11443700
EMITB(BFC,P,L); %A11443800
EMITL(1); EMITO(SUB); EMITO(XCH); %A11443900
GETCONTENTS(0,FALSE); EMITO(XCH); %A11444000
EMITB(BBW,BUMPL,R); %A11444100
EMITB(BFC,T,L); %A11444200
EMIT(0); EMITO(RTN); %A11444300
END OF EMITRANDOM; %A11444400
PROCEDURE EMITREAD; %A11444500
BEGIN %A11444600
STREAM PROCEDURE TRA(A,B); VALUE B; %A11444700
BEGIN DI ~ A; DI ~ DI + B; %A11444800
DI ~ DI + B; %A11444900
DS ~ 26 LIT "READ: ILLEGAL LIST SYNTAX " END; %A11445000
REAL T; %A11445100
EMIT(0); %A11445200
EMITO(MKS); EMITV(READ1); EMITO(DUP); %A11445300
EMITL("("); EMITO(NEQ); EMITPAIR(1,BFC); %A11445400
EMITO(RTN); %A11445500
EMITO(MKS); EMITN(FP2); EMITV(READSYM); %A11445600
T ~ BUMPL; %A11445700
EMITO(MKS); EMITPAIR(OUTSTR,LOD); %A11445800
EMITO(ECM); STREAMTOG ~ TRUE; %A11445900
EMITC(26,TRP); %A11446000
TRA(EDOC[L.[36:3],L.[39:7]],L.[46:2]); %A11446100
L ~ L + 13; %A11446200
EMITC(1,0); STREAMTOG ~ FALSE; %A11446300
EMITL(26); EMITPAIR(NSTR,STD); %A11446400
TRPRI; EMITO(MKS); %A11446500
EMIT(0); EMITV(STRINGPRINT); %A11446600
TRPRI; EMITL(12); %A11446700
EMITPAIR(INSYM,STD); %A11446800
EMITV(FP2); EMITO(RTN); %A11446900
EMITB(BFC,T,L); %A11447000
EMITO(MKS); EMITV(READ1); EMITO(DUP); %A11447100
EMITL("$"); EMITO(EQL); %A11447200
EMITPAIR(5,BFC); EMIT(0); %A11447300
EMITPAIR(INSYM,STD); EMITV(FP2); %A11447400
EMITO(RTN); %A11447500
EMITO(DUP); %A11447600
EMITL(")"); EMITO(EQL); %A11447700
EMITB(BBC,BUMPL,T); %A11447800
EMITO(DEL); EMITO(MKS); EMITV(READ1); %A11447900
EMITPAIR(10,BBW); %A11448000
END OF EMITREAD; %A11448100
PROCEDURE EMITREAD1; %A11448200
BEGIN %A11448300
EMIT(0); %A11448400
EMITO(MKS); %A11448500
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11448600
EMITL(1); EMITV(READCON); %A11448700
EMITO(DUP); EMITO(ADD); %A11448800
EMITO(BFW); %A11448900
EMITPAIR(6,BFW); %A11449000
EMITPAIR(4,BFW); %A11449100
EMITPAIR(4,BFW); %A11449200
EMITV(INSYM); EMITO(RTN); %A11449300
EMITL(12); EMITO(RTN); %A11449400
EMITV(INREAL); EMITO(MKS); EMITV(NTA); EMITO(RTN); %A11449500
END OF EMITREAD1; %A11449600
PROCEDURE EMITREADCON; %A11449700
BEGIN %A11449800
COMMENT RESULTS OF READCON: %A11449900
0 - EOF, %A11450000
1 - NUMBER ERROR, %A11450100
2 - NUMBER, %A11450200
3 - ATOMIC SYMBOL, %A11450300
4 - ALPHA STRING; %A11450400
INTEGER L1,L2,L3,L4,L5,L6,L7; %A11450500
DEFINE TYPE = FP4#, BV = FM1#, TEN = FM2#, %A11450600
FP = FP3#, SN = FP2#, %A11450700
XLO = INDBL#, XHI = INREAL#, %A11450800
CALLSCAN = % %A11450900
EMITO(MKS); EMITN(TYPE); EMITV(STRI); %A11451000
EMITO(PRTE); EMITO(LOD); EMITV(FILPROI); EMITO(PRTE); %A11451100
EMITO(LOD); EMITV(SCANR)#; %A11451200
% SCAN RESULTS: %A11451300
% 0 SPACES, %A11451400
% 1 ALPHA, %A11451500
% 2 NUMBER, %A11451600
% 3 SPECIAL CHARACTER, %A11451700
% 4 EOF %A11451800
EMIT(0); % %A11451900
EMIT(0); % SN %A11452000
EMITL(1); % FP %A11452100
EMIT(0); % TYPE FP4 %A11452200
L1 ~ L; %A11452300
CALLSCAN; EMITO(DUP); EMITO(ADD); %A11452400
EMITO(BFW); %A11452500
EMITB(BBW,BUMPL,L1); %A11452600
L1 ~ L ~ L + 6; %A11452700
EMIT(0); EMITO(RTN); % 4 EOF %A11452800
EMITB(BFW,L1 - 4,L); % 1 ALPHA %A11452900
EMITO(MKS); EMITV(ATCON); %A11453000
EMITPAIR(2,BFC); EMITL(3); EMITO(RTN); % ATOMIC SYM ON OBLIS%A11453100
EMITV(BV); EMITPAIR(7,BFC); %A11453200
EMITO(MKS); EMITL(1); EMITV(MKATM); %A11453300
EMITPAIR(INSYM,STD); EMITL(3); EMITO(RTN); % BV=FALSE NEXT %A11453400
EMITL(4); EMITO(RTN); %A11453500
EMITB(BFW,L1 - 2,L); % 2 NUMBER %A11453600
EMIT(0); EMITPAIR(XLO,SND);EMITPAIR(XHI,SND); % XLO ~ XHI ~ 0 %A11453700
L2 ~ L; %A11453800
EMITO(DUP); EMITV(COUNTI); EMITO(XCH); %A11453900
EMITO(SUB); EMITO(DUP); EMITL(8); %A11454000
EMITO(GTR); EMITPAIR(2,BFC); %A11454100
EMITO(DEL); EMITL(8); EMIT(0); %A11454200
EMITO(MKS); %A11454300
EMIT(0); EMITN(INSTR); %A11454400
EMITO(ECM); STREAMTOG ~ TRUE; %A11454500
EMITC(1,RSA); %A11454600
EMITC(5,CRF); % T %A11454700
EMITC(0,SFS); EMITC(3,SFS); %A11454800
EMITC(3,SED); %A11454900
EMITC(4,CRF); % R %A11455000
EMITC(0,ICV); EMITC(1,0); %A11455100
STREAMTOG ~ FALSE; %A11455200
EMIT(0); EMITO(XCH); EMITV(XLO); %A11455300
EMITV(XHI); EMIT(0); EMITV(FP6); %A11455400
EMITV(TEN); EMITO(ML2); EMITO(AD2); %A11455500
EMITPAIR(XHI,STD); EMITPAIR(XLO,STD); %A11455600
EMITO(ADD); EMITO(DUP); %A11455700
EMITV(COUNTI); EMITO(EQL); %A11455800
EMITB(BBC,BUMPL,L2); %A11455900
EMITO(DEL); %A11456000
EMITI(0,43,3); EMITO(DUP); %A11456100
EMIT(0); EMITO(NEQ); %A11456200
L3 ~ BUMPL; % GO TO FIN %A11456300
EMITO(DUP); EMITL(3); EMITO(GTR); %A11456400
EMITV(CPI); EMITO(ADD); EMITL(1); %A11456500
EMITO(ADD); EMITO(DUP); %A11456600
EMITV(RMARGI); EMITO(GEQ); %A11456700
EMITPAIR(3,BFC); EMITO(DEL); %A11456800
L4 ~ BUMPL; % GO TO FIN %A11456900
EMITPAIR(CPI,STD); EMITO(DUP); %A11457000
EMITL(2); EMITO(EQL); %A11457100
L5 ~ BUMPL; %A11457200
EMITV(FP); %A11457300
L6 ~ BUMPL; %A11457400
EMITO(XCH); EMITO(DEL); %A11457500
EMIT(0); %A11457600
EMITO(XCH); CALLSCAN; %A11457700
EMITO(DEL); EMIT(0); %A11457800
EMITB(BBW,BUMPL,L2); %A11457900
EMITB(BFC,L6,L); %A11458000
EMITV(CPI); EMITL(1); EMITO(SUB); %A11458100
EMITPAIR(CPI,STD); %A11458200
EMITB(BFC,L5,L5 ~ BUMPL); %A11458300
EMITO(DUP); %A11458400
EMITV(FP); EMITPAIR(3,BFC); %A11458500
EMIT(0); EMITPAIR(2,BFW); %A11458600
EMITV(COUNTI); EMITO(SSN); %A11458700
EMITO(XCH); EMITPAIR(FP,STD); %A11458800
L7 ~ BUMPL; % GO TO OLD L8 %A11458900
% FIN: %A11459000
EMITB(BFC,L3,L); %A11459100
EMITB(BFW,L4,L); %A11459200
EMITV(FP); EMITPAIR(2,BFC); %A11459300
L3 ~ BUMPL; % TO OLD L12 %A11459400
% OLD L14: %A11459500
EMITB(BFW,L5,L); %A11459600
EMITO(DEL); %A11459700
EMITL(1); %A11459800
EMITV(COUNTI); %A11459900
L4 ~ BUMPL; % TO OLD L25 %A11460000
% THE FOLLOWING SECTION OF CODE IS FOR THE SPECIAL %A11460100
% CHARACTER CASE %A11460200
EMITB(BFW,L1,L); % SPECIAL CHARACTER %A11460300
EMITO(DUP); EMITL(2); EMITO(LEQ); %A11460400
EMITV(CPI); EMITV(RMARGI); %A11460500
EMITO(EQL); EMITO(LOR); %A11460600
L1 ~ BUMPL; %A11460700
EMIT(0); EMITV(INSTR ); EMITI(0,18,6); %A11460800
EMITPAIR(INSYM,STD); EMITL(3); EMITO(RTN); %A11460900
EMITB(BFC,L1,L); %A11461000
EMITO(DUP); EMITL(3); EMITO(LND); %A11461100
EMITPAIR(SN,SND); EMIT(0); %A11461200
EMITO(NEQ); EMITO(DUP); %A11461300
EMITO(LNG); %A11461400
EMITV(WSIGN); EMITO(LOR); %A11461500
EMITB(BBC,BUMPL,L1); %A11461600
EMITO(XCH); EMITI(0,43,3); EMITO(DUP); %A11461700
EMITL(1); EMITO(EQL); %A11461800
L5 ~ BUMPL; %A11461900
EMITO(DEL); CALLSCAN; EMITO(DEL); %A11462000
EMITB(BBW,BUMPL,L2 - 5); %A11462100
EMITB(BFC,L5,L); %A11462200
EMITO(DUP); EMITL(3); EMITO(GTR); %A11462300
EMITV(CPI); EMITO(ADD); EMITV(FP4); %A11462400
EMITO(ADD); EMITO(DUP); %A11462500
EMITV(RMARGI); EMITO(LSS); %A11462600
EMITB(BBC,BUMPL,L1); %A11462700
EMITPAIR(CPI,STD); EMITO(XCH); EMITO(DEL); %A11462800
EMITO(DUP); EMITL(2);EMITO(EQL); %A11462900
EMITPAIR(7,BFC); EMIT(0); EMITPAIR(XLO,SND); EMITPAIR(XHI,STD); %A11463000
EMITB(BBW,BUMPL,L6); %A11463100
EMITPAIR(FP,SND); %A11463200
EMITL(1); EMITPAIR(XHI,STD); EMIT(0); EMITPAIR(XLO,SND); %A11463300
% OLD L8: %A11463400
EMITB(BFW,L7,L); %A11463500
CALLSCAN; EMITO(DEL); %A11463600
EMITV(COUNTI); EMITL(8); %A11463700
EMITO(GTR); EMITPAIR(2,BFC); %A11463800
EMITL(1); EMITO(RTN); % RETURN IMPROPER NUMBER %A11463900
EMITO(XCH); EMITO(DEL); EMIT(0); %A11464000
EMITV(FP); EMITO(MKS); %A11464100
EMITV(COUNTI); EMIT(0); %A11464200
EMITN(INSTR); EMITO(ECM); %A11464300
STREAMTOG ~ TRUE; %A11464400
EMITC(1,RSA); EMITC(5,SED); %A11464500
EMITC(3,SFS); %A11464600
EMITC(2,CRF); EMITC(0,ICV); %A11464700
EMITC(1,0); STREAMTOG ~ FALSE; %A11464800
EMITD(47,1,1); %A11464900
EMITO(SUB); EMITO(DUP); EMITO(DUP); %A11465000
EMITO(SSP); EMITO(DUP); EMITL(69); %A11465100
EMITO(GEQ); %A11465200
EMITPAIR(2,BFC); EMITL(1); %A11465300
EMITO(RTN); % RETURN IMPROPER NUMBER %A11465400
EMITV(TEN); EMITI(0,3,6); EMITO(XCH); %A11465500
EMITD(1,1,1); %A11465600
EMITV(XHI); EMITI(0,3,6); %A11465700
EMITV(XHI); EMITD(2,1,1); EMITO(ADD); %A11465800
EMITL(12); EMITO(ADD); %A11465900
EMITO(SSP); EMITL(63); %A11466000
EMITO(GTR); EMITPAIR(2,BFC); %A11466100
EMITL(1); EMITO(RTN); % IMPROPER NUMBER - EXP TOO LARGE %A11466200
EMITO(DUP);EMIT(0); %A11466300
EMITO(LSS); EMITO(XCH); EMITO(SSP); %A11466400
% OLD L25: %A11466500
EMITB(BFW,L4,L); %A11466600
EMITV(XLO); EMITV(XHI); %A11466700
EMITV(FP4); EMITPAIR(10,BFC); %A11466800
EMITV(FP5); EMITO(DUP); EMITL(69); EMITO(ADD); %A11466900
EMITV(TEN); EMITO(XCH); EMITV(TEN); EMITO(DV2); %A11467000
EMITPAIR(8,BFW); %A11467100
EMITV(FP5); EMITO(DUP); EMITL(69); EMITO(ADD); %A11467200
EMITV(TEN); EMITO(XCH); EMITV(TEN); EMITO(ML2); %A11467300
EMITPAIR(XHI,STD); %A11467400
EMITPAIR(XLO,STD); %A11467500
EMITB(BFW,L3,L); % OLD L12 %A11467600
EMITV(XHI); EMITV(SN); EMITD(47,1,1); %A11467700
EMITPAIR(XHI,STD); %A11467800
EMITL(2); EMITO(RTN); % RETURN NUMBER RESULT %A11467900
END OF EMITREADCON; %A11468000
PROCEDURE EMITREADN; %A11468100
BEGIN REAL LS,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11; %A11468200
EMIT(0); LS ~ L; %A11468300
EMITO(MKS); %A11468400
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11468500
EMIT(0); EMITV(READCON); EMITV(FM2); EMITO(ADD); %A11468600
EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11468700
L1 ~ BUMPL; L2 ~ BUMPL; L3 ~ BUMPL; L4 ~ BUMPL; %A11468800
L5 ~ BUMPL; L6 ~ BUMPL; EMITB(BBW,BUMPL,LS); %A11468900
L7 ~ BUMPL; EMITB(BBW,BUMPL,LS); EMITB(BBW,BUMPL,LS); %A11469000
L8 ~ BUMPL; EMITB(BBW,BUMPL,LS); EMITB(BBW,BUMPL,LS); %A11469100
L9 ~ BUMPL; L10 ~ BUMPL; L11~BUMPL;EMITB(BBW,BUMPL,LS); %A11469200
EMITL(1); EMITO(RTN); EMITO(NOP); EMITO(NOP); %A11469300
EMITB(BFW,L9,L); EMITB(BFW,L10,L); EMITPAIR(0,MKS); %A11469400
EMITV(COUNTI); EMITO(DUP); EMITL(7); EMITO(GTR); %A11469500
EMITPAIR(2,BFC); EMITO(DEL); EMITL(7); EMITO(DUP); %A11469600
EMITL(8); EMITO(XCH); EMITO(SUB); EMITPAIR(INSTR,LOD); %A11469700
EMITO(ECM); EMITC(5,SED); EMITC(1,RSA); %A11469800
EMITC(3,SFS); EMITC(2,CRF); EMITC(0,SFD); %A11469900
EMITC(3,CRF); EMITC(0,TRS); EMITC(1,0); %A11470000
EMITV(FM2); EMITL(15); EMITO(EQL); EMITPAIR(3,BFC); %A11470100
EMITPAIR(INREAL,STD); EMIT(0); EMITO(RTN); %A11470200
EMITB(BFW,L3,L); EMITB(BFW,L7,L); %A11470280
EMITV(FM1); EMITPAIR(3,BFC); EMITV(INDBL); %A11470290
EMITPAIR(FM4,STD); EMIT(0); EMITPAIR(INSYM,STD); %A11470300
EMITV(INREAL); EMITO(RTN); %A11470310
EMITB(BFW,L1,L); EMITB(BFW,L2,L); EMITB(BFW,L4,L); %A11470320
EMITB(BFW,L5,L); EMITL(12); EMITPAIR(INSYM,STD); %A11470330
EMITPAIR(0,RTN); %A11470340
EMITB(BFW,L6,L); EMITB(BFW,L8,L); EMITB(BFW,L11,L); %A11470350
EMITO(MKS); EMITL(12); EMITV(CHARPRINT); %A11470360
EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11470370
%T9011470380
EMITO(MKS); EMITV(TERPRIN); EMITB(BBW,BUMPL,LS); %A11470390
END OF EMITREADN; %A11470400
PROCEDURE EMITREADSYM; %A11470500
BEGIN %A11470600
REAL TL,R,S; %A11470700
EMIT(0); %A11470800
EMITL(1); % LT FP2 %A11470900
EMIT(0); %A11471000
EMITO(MKS); EMITV(READ1); %A11471100
EMITO(DUP); EMITL(")"); EMITO(EQL); %A11471200
EMITPAIR(4,BFC); %A11471300
EMIT(0); EMITN(FM1); EMITO(SND); %A11471400
EMITO(RTN); %A11471500
EMITO(DUP); %A11471600
EMITO(DUP); EMITO(DUP); %A11471700
EMITL("$"); EMITO(EQL); EMITO(XCH); %A11471800
EMITL("."); EMITO(EQL); EMITO(LOR); EMITO(XCH); %A11471900
EMITL(","); EMITO(EQL); EMITO(LOR); %A11472000
EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11472100
EMITO(DUP); EMITL("("); EMITO(EQL); %A11472200
EMITPAIR(7,BFC); EMITO(MKS); EMITN(FP4); %A11472300
EMITV(READSYM); EMITPAIR(2,BFC); EMITL(1); EMITO(RTN); %A11472400
MARKSYMNCR(1); EMITD(33,18,15); %A11472500
GENSYMLINK; %A11472600
EMITN(FM1); EMITO(SND); %A11472700
MARKSYMNCR(0); %A11472800
EMITO(MKS); EMITV(READ1); %A11472900
MARKSYMNCR(1); %A11473000
TL ~ L; %A11473100
EMITO(DUP); EMITL(")"); %A11473200
EMITO(EQL); %A11473300
R ~ BUMPL; %A11473400
MARKSYMDCR(-2); %A11473500
EMIT(0); EMITO(RTN); %A11473600
EMITB(BFC,R,L); %A11473700
EMITO(DUP); EMITL("$"); EMITO(EQL); %A11473800
EMITV(FP2); EMITO(LNG); EMITO(LOR); %A11473900
R ~ BUMPL; %A11474000
MARKSYMDCR(-2); EMITL(1); EMITO(RTN); %A11474100
EMITB(BFC,R,L); %A11474200
EMITO(DUP); EMITL(","); EMITO(EQL); %A11474300
EMITPAIR(5,BFC); EMITO(DEL); %A11474400
EMITO(MKS); EMITV(READ1); EMITPAIR(10,BFW); %A11474500
EMITO(DUP); EMITL("."); EMITO(EQL); %A11474600
EMITPAIR(5,BFC); EMIT(0); %A11474700
EMITPAIR(FP2,STD); EMITPAIR(15,BBW); %A11474800
EMITO(DUP); EMITO(DUP); %A11474900
EMITO(DUP); EMITO(DUP); %A11475000
EMITL("$"); EMITO(NEQ); EMITO(XCH); %A11475100
EMITL("."); EMITO(NEQ); EMITO(LND); EMITO(XCH); %A11475200
EMITL(","); EMITO(NEQ); EMITO(LND); EMITO(XCH); %A11475300
EMITL(12); EMITO(NEQ); EMITO(LND); %A11475400
EMITB(BBC,BUMPL,R); %A11475500
EMITO(DUP); EMITL("("); EMITO(EQL); %A11475600
EMITPAIR(6,BFC); % %A11475700
EMITO(MKS); EMITN(FP4);EMITV(READSYM); %A11475800
EMITO(LNG); %A11475900
EMITB(BBC,BUMPL,R); %A11476000
MARKSYMNCR(0); %A11476100
EMITV(FP2); %A11476200
R ~ BUMPL; %A11476300
EMIT(0); EMITO(XCH); %A11476400
EMITD(33,18,15); GENSYMLINK; %A11476500
MARKSYMNCR(0); EMITB(BFC,R,L); %A11476600
EMITV(FP3); GETCONTENTS(0,TRUE); %A11476700
EMITO(DUP); EMITO(LOD); EMITV(FP4); %A11476800
EMITO(CTC); %A11476900
EMITO(XCH); EMITO(STD); %A11477000
EMITO(XCH); EMITO(DEL); EMITO(MKS); %A11477100
EMITV(READ1); MARKSYMNCR(0); %A11477200
EMITB(BBW,BUMPL,TL); %A11477300
END OF EMITREADSYM; %A11477400
PROCEDURE EMITRECALL; %A11477500
BEGIN REAL T,R; %A11477600
EMIT(0); %A11477700
IF RECLAIMTOG THEN BEGIN% %A11477750
EMITV(GENU); %A11477800
EMITERR(SGNO,L,"13");% %A11477900
END; %A11477950
EMITO(MKS); %A11478000
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11478100
EMITL(5); EMITN(FM1); %A11478200
EMIT(0); EMITL(2); EMIT(0); %A11478300
EMITL(128); %A11478400
EMITPAIR(SYMSTACKA,LOD); %A11478500
FOR T ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11478600
EMITV(13); %A11478700
EMITL(P2); EMITV(SYMSTACKA); EMITPAIR(FREELIST,STD); %A11478800
EMITL(P3); EMITV(SYMSTACKA); EMITPAIR(LNKROW,STD); %A11478900
EMITL(P4); EMITV(SYMSTACKA); EMITPAIR(LNKCOL,STD); %A11479000
EMIT(0); %A11479100
T ~ L; %A11479200
EMITO(MKS); %A11479300
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11479400
EMITL(5); EMITN(FM1); %A11479500
EMIT(0); EMITL(2); EMIT(0); %A11479600
EMITL(512); %A11479700
EMITV(FP2); EMITN(LNKA); EMITO(LOD); %A11479800
FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11479900
EMITV(13); EMITL(1); EMITO(ADD); %A11480000
EMITO(DUP); EMITV(LNKCOL); EMITO(GTR); %A11480100
EMITB(BBC,BUMPL,T); EMITO(XIT); %A11480200
END OF EMITRECALL; %A11480300
PROCEDURE EMITRECLAIMER; %A11480400
BEGIN REAL T,R,S; %A11480500
EMIT(0); EMIT(0); %A11480550
T ~ L; %A11480600
EMITO(MKS); %A11481400
IF DAC[14] = 0 THEN FLAG(668); %A11481410
EMITPAIR(DAC[14],LOD); EMITO(ECM); %A11481420
EMITC(3,CRF); EMITC(0,JFW); %A11481430
EMITC(12,TRP); EMIT(" G"); %A11481440
EMIT("O "); EMIT("AH"); %A11481450
EMIT("EA"); EMIT("D."); %A11481460
EMIT("{!"); EMITC(12,SEC); %A11481470
EMITC(11,JFW); EMITC(17,TRP); EMIT(" "); %A11481480
EMIT("PL"); EMIT("EA"); EMIT("SE"); EMIT(" R"); %A11481490
EMIT("ET"); EMIT("YP"); EMIT("E."); EMIT("{!"); %A11481500
EMITC(17,SEC); EMITC(3,STC); EMITC(1,0); %A11481510
EMITPAIR(CP,STD); EMITO(MKS); EMITV(TERPRIN); %A11481520
IF DAC[4]=0 OR DAC[5]=0 OR DACOMI = 0 THEN FLAG(679); %A11481530
IF R~SFTRC.[37:11]=0 OR S~SFTRC.[26:11]=0 THEN FLAG(671); %A11481535
EMIT(0); EMITPAIR(CPI,STD); EMITL(1); EMITPAIR(DAC[4],STD); %A11481540
EMITO(MKS); EMITV(DACOMI); EMITO(DEL); EMITO(MKS); %A11481545
EMITV(R); EMITV(FM2); EMITV(S); EMITO(EQL); %A11481550
EMITPAIR(1,BFC); EMITO(XIT); EMITO(MKS); EMITV(FM1); %A11481555
EMITPAIR(3,BFC); EMIT(0); EMITPAIR(1,BFW); EMITL(9); %A11481560
EMITB(BBW,BUMPL,T); %A11481565
END OF EMITRECLAIMER; %A11481600
PROCEDURE EMITRECLINK; %A11481700
BEGIN REAL L1,L2,L3,L4,L5,L6; %A11481800
REAL L7;% %A11481850
DEFINE P = FP2#, A = FM1#, AR=FM2#, DF = FM3#, LF = FM4#, %A11481900
P2=FM5#,P1=FM6#, R = FM7#, FL =FM8#,NXT=FM9#,RA=907#, %A11482000
CA = EMITV(A);EMITO(DUP);EMIT(0);EMITO(GTR);EMITO(XCH); %A11482100
EMITL(5);EMITO(LSS);EMITO(LND);EMITPAIR(4,BFC)#, %A11482200
RO = EMITV(R);EMITL(126);EMITO(LND);EMITN(R);EMITO(STD)#, %A11482300
R1 =EMITV(R);EMITL(1);EMITO(LOR);EMITN(R);EMITO(STD)#; %A11482400
% %A11482500
EMIT(0); EMIT(0); EMITV(A); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11482600
L1 ~ BUMPL; % 0 %A11482700
L2 ~ BUMPL; % 1 %A11482800
L3 ~ BUMPL; % 2 %A11482900
BUMPL; % 3 %A11483000
L4 ~ BUMPL; % 4 %A11483100
EMITV(P1); EMIT(0); EMITO(LSS);% %A11483200
L5 ~ BUMPL; %A11483300
RO; EMITN(P1); EMITPAIR(P,STD); L7 ~ BUMPL;% %A11483400
ADJUST; EMITB(BFC,L5,L5~L); EMITV(P2);% %A11483500
EMIT(0); EMITO(GEQ); EMITPAIR(1,BFC); EMITO(XIT);% %A11483600
R1; EMITN(P2); EMITPAIR(P,STD); EMITL(6); %A11483700
EMITPAIR(A,STD); %A11483800
L6 ~ BUMPL; %A11483900
EMITB(BFW,L3,L); %A11484000
EMITV(FL); EMIT(0); EMITO(EQL); %A11484100
EMITPAIR(12,BFC); %A11484200
EMITV(NXT); EMITL(1); EMITO(ADD); EMITPAIR(RA,SND); %A11484300
EMITN(NXT); EMITO(STD); EMITL(3); EMITPAIR(A,STD); %A11484400
L3~BUMPL; %A11484500
EMITV(FL); EMITPAIR(RA,STD); %A11484600
EMITB(BFW,L1,L); EMITB(BFW,L2,L); EMITB(BFW,L4,L); %A11484700
EMITV(RA); EMITV(P1); EMITO(SSP); EMITO(EQL); %A11484800
EMITPAIR(21,BFC); %A11484900
RO; CA; EMITV(P1); EMITO(SSN); EMITN(P1); EMITO(STD); %A11485000
L1 ~ BUMPL; %A11485100
EMITV(RA); EMITV(P2); EMITO(SSP); EMITO(EQL); %A11485200
EMITPAIR(21,BFC); %A11485300
R1; CA; EMITV(P2); EMITO(SSN); EMITN(P2); EMITO(STD); %A11485400
L2~BUMPL; %A11485500
EMITB(BFW,L3,L); %A11485600
EMITV(R); EMITPAIR(10,BFC); %A11485700
RO; EMITN(P1); EMITPAIR(P,STD); EMITPAIR(8,BFW); %A11485800
R1; EMITN(P2); EMITPAIR(P,STD); %A11485900
EMITV(P); EMIT(0); EMITO(LSS); %A11486000
L3 ~ BUMPL; %A11486100
EMITB(BFW,L7,L); EMITB(BFW,L6,L);% %A11486200
EMITO(MKS); EMITPAIR(105,LOD); EMITN(DF); EMITV(P); %A11486300
EMITO(SSP); EMIT(0); EMIT(0); %A11486400
EMITV(LF); EMITV(R); EMITN(AR); EMITO(LOD); %A11486500
FOR L4 ~ 1 STEP 1 UNTIL 5 DO EMIT(0); EMITV(12); %A11486600
EMITB(BFC,L3,L); %A11486700
EMITV(A); EMITL(3); EMITO(LSS); L3 ~ BUMPL;% %A11486800
EMITV(RA); EMIT(0); EMITO(EQL); EMITERR(% %A11486900
SGNO,L,"14"); %A11487000
EMITO(MKS); EMITPAIR(105,LOD); EMITN(DF); EMITV(RA); %A11487100
EMITO(SSP); EMITL(1); EMITO(ADD); %A11487200
EMITL(2); EMIT(0); EMITV(LF); EMITV(R); EMITN(AR); EMITO(LOD); %A11487300
FOR L4 ~ 1 STEP 1 UNTIL 5 DO EMIT(0); EMITV(13); %A11487400
EMITB(BFC,L3,L); %A11487500
EMITV(A); EMIT(0); EMITO(EQL); %A11487600
EMITPAIR(6,BFC); %A11487700
EMITV(RA); EMITO(SSP); EMITN(P); EMITO(STD); %A11487800
L3 ~ BUMPL; %A11487900
EMITV(A); EMITL(5); EMITO(LSS); %A11488000
EMITPAIR(4,BFC); %A11488100
EMITV(RA); EMITO(SSN); EMITN(P); EMITO(STD); ADJUST; %A11488200
EMITB(BFW,L3,L); EMITB(BFW,L1,L); EMITB(BFW,L2,L); %A11488300
EMITV(A); EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11488400
L1 ~ BUMPL; % 0 %A11488500
L2~BUMPL; % 1 %A11488600
L3 ~ BUMPL; % 2 %A11488700
L4 ~ BUMPL; % 3 %A11488800
L6 ~ BUMPL; % 4 %A11488900
EMITB(BBW,BUMPL,L5); % 5 %A11489000
EMITO(XIT); %A11489100
EMITB(BFW,L3,L); %A11489200
EMITV(R); EMITN(AR); EMITO(LOD); EMIT(0); EMITO(CDC); %A11489300
EMITO(DUP); EMITO(LOD); EMITN(FL); EMITO(STD); %A11489400
EMIT(0); EMITO(XCH); EMITO(STD); EMITO(XIT); %A11489500
EMITB(BFW,L4,L); EMITB(BFW,L6,L); %A11489600
EMITO(MKS); EMITV(A); EMITPAIR(3,BFC); EMIT(0); %A11489700
EMITPAIR(1,BFW); EMITV(FL); EMIT(0); EMITV(LF); %A11489800
EMITL(2); EMITO(SUB); EMITO(DUP); EMITL(64); EMITO(IDV); %A11489900
EMITPAIR(JUNK,ISN); EMITV(R); EMITN(AR); EMITO(LOD); %A11490000
EMIT(0); EMITO(CDC); EMITO(ECM); %A11490100
EMITC(5,SES); EMITC(2,TRW); %A11490200
EMITC(1,RSA); EMITC(8,SFS); %A11490300
EMITC(3,CRF); EMITC(0,TRW); %A11490400
EMITC(2,CRF); EMITC(3,BNS); %A11490500
EMITC(32,TRW); %A11490600
EMITC(32,TRW); %A11490700
EMITC(0,ENS); EMITC(1,0); %A11490800
EMITV(A); %A11490900
EMITPAIR(1,BFC); EMITO(XIT); %A11491000
EMITV(RA); EMITN(FL); EMITO(STD); EMITO(XIT); %A11491100
EMITB(BFW,L1,L); EMITB(BFW,L2,L); %A11491200
EMITV(R); EMITN(AR); EMITO(LOD); EMITPAIR(RA,STD); EMITO(XIT); %A11491300
END OF EMITRECLINK; %A11491400
PROCEDURE EMITREMEMBER; %A11491500
BEGIN REAL T,R; %A11491600
EMIT(0); %A11491700
IF RECLAIMTOG THEN BEGIN %A11491750
EMITL(1); EMITPAIR(GENOK,STD); %A11491800
EMITO(MKS); EMITV(MARKOB); %A11491900
EMITO(MKS); EMITV(COLLECT); %A11492000
END ELSE %A11492010
IF SYMSTK THEN BEGIN EMITV(LNKROW); EMITI(0,33,6); %A11492020
EMITPAIR(LNKCOL,STD); END; %A11492050
EMITV(FREELIST); EMITL(P2); EMITN(SYMSTACKA); %A11492100
EMITO(STD); %A11492200
EMITV(LNKROW); EMITL(P3); EMITN(SYMSTACKA); %A11492300
EMITO(STD); %A11492400
EMITV(LNKCOL); EMITL(P4); EMITN(SYMSTACKA); EMITO(STD); %A11492500
EMITO(MKS); %A11492600
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11492700
EMITL(5); EMITN(FM1); %A11492800
EMIT(0); EMITL(1); EMIT(0); %A11492900
EMITL(128); EMITPAIR(SYMSTACKA,LOD); %A11493000
FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11493100
EMITV(12); %A11493200
% %A11493300
EMIT(0); % FP2 %A11493400
T ~ L; %A11493500
EMITO(MKS); %A11493600
EMITPAIR(GNAT(POWERSOFTEN),LOD); %A11493700
EMITL(5); EMITN(FM1); %A11493800
EMIT(0); EMITL(1); EMIT(0); %A11493900
EMITL(512); EMITV(FP2); %A11494000
EMITN(LNKA); EMITO(LOD); %A11494100
FOR R ~ 1 STEP 1 UNTIL 5 DO EMIT(0); %A11494200
EMITV(12); %A11494300
EMITL(1); EMITO(ADD); EMITO(DUP); %A11494400
EMITV(LNKCOL); EMITO(GTR); %A11494500
EMITB(BBC,BUMPL,T); %A11494600
EMITO(XIT); %A11494700
END OF EMITREMEMBER; %A11494800
PROCEDURE EMITREMOB; %A11494900
BEGIN REAL T; %A11495000
EMIT(0); %A11495100
EMIT(0); %A11495200
EMITV(FM1); EMITO(CTC); EMITO(DUP); %A11495300
EMITL(64); EMITO(LSS); %A11495400
EMITPAIR(1,BFC); EMITO(XIT); %A11495500
EMITO(DUP); GETCONTENTS(0,FALSE); %A11495600
EMITO(DUP); EMITI(0,1,2); %A11495700
EMITL(2); EMITO(NEQ); %A11495800
EMITPAIR(1,BFC); EMITO(XIT); %A11495900
EMITO(DUP); %A11496000
GETCONTENTS(1,FALSE); %A11496100
EMITO(DUP); EMITI(0,1,35); EMITO(DUP); %A11496200
EMITI(0,12,6); EMITL(7); EMITO(GTR); %A11496210
T ~ BUMPL; %A11496220
EMITO(XCH); GETCONTENTS(0,FALSE); EMITD(6,42,6); %A11496230
EMITPAIR(2,BFW); EMITB(BFC,T,L); %A11496240
EMITO(XCH); EMITO(DEL); EMITL(125); %A11496250
EMITO(RDV); EMITN(SYMSTACKA); %A11496300
EMITO(DUP); EMITO(LOD); %A11496400
EMITO(DUP); EMITV(FP2); EMITO(EQL); %A11496500
T ~ BUMPL; %A11496600
EMITO(DEL); EMITO(XCH); %A11496700
EMITI(0,3,15); EMITO(DUP); EMITL(1); EMITO(LEQ); %A11496800
EMITPAIR(2,BFC); EMITO(DEL); EMIT(0); %A11496900
EMITO(XCH); EMITO(STD); EMITO(XIT); %A11497000
EMITB(BFC,T,L); %A11497100
T ~ L; %A11497200
EMITO(XCH); EMITO(DEL); EMITO(DUP); EMITL(1); EMITO(LEQ); %A11497300
EMITPAIR(1,BFC); EMITO(XIT); %A11497400
GETCONTENTS(0,TRUE); EMITO(DUP); %A11497500
EMITO(LOD); EMITO(DUP); %A11497600
EMITI(0,3,15); EMITO(DUP); %A11497700
EMITV(FP2); EMITO(NEQ); %A11497800
EMITPAIR(4,BFC); EMITO(XCH); EMITO(DEL); %A11497900
EMITB(BBW,BUMPL,T); %A11498000
EMITO(DEL); EMITV(FP3); EMITD(3,3,15); %A11498100
EMITO(XCH); EMITO(STD); %A11498200
EMITO(XIT); %A11498300
END OF EMITREMOB; %A11498400
PROCEDURE EMITREMPROP; %A11498500
BEGIN REAL T; %A11498600
EMIT(0); %A11498700
EMITV(FM3); %A11498800
GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11498900
EMITL(2); EMITDIAL(DIA,46); %A11499000
EMITDIAL(DIB,1); EMITFC(FCE,2); %A11499100
EMITO(LNG); EMITPAIR(1,BFC); EMITO(XIT); %A11499200
T ~ L; %A11499300
EMITO(DUP); %A11499400
GETCONTENTS(0,TRUE); EMITO(DUP); EMITO(LOD); %A11499500
EMITO(DUP); EMIT(0); EMITO(LSS); %A11499600
EMITPAIR(1,BFC); EMITO(XIT); %A11499700
EMITDIAL(DIB,2); EMITV(FM1); %A11499800
EMITV(FM2); EMITPAIR(4,BFC); %A11499900
EMITDIAL(DIA,46); EMITFC(FCE,2); %A11500000
EMITPAIR(2,BFW); %A11500100
EMITDIAL(DIA,32);EMITFC(FCE,16); %A11500200
EMITPAIR(6,BFC); %A11500300
EMITO(XCH); EMITO(DEL); EMITO(CTC); %A11500400
EMITO(XCH); EMITO(STD); EMITO(XIT); %A11500500
EMITPAIR(FP2,STD); EMITO(XCH); %A11500600
EMITO(DEL); EMITO(XCH); %A11500700
EMITB(BBW,BUMPL,T); %A11500800
END OF EMITREMPROP; %A11500900
PROCEDURE EMITRITE; %A11501000
BEGIN EMIT(0); %A11501100
EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11501200
IF GPBV!0 OR DACP!0 THEN BEGIN %A11501300
IF GPBV!0 THEN EMITV(GPBV); %A11501400
IF DACP!0 THEN BEGIN EMITV(DAC[8]); %A11501500
IF GPBV!0 THEN EMITO(LOR) END; %A11501600
EMITO(LNG); EMITPAIR(3,BFC); END; %A11501700
EMITV(LMARG); EMITPAIR(CP,STD); %A11501800
EMITV(PROTOG); %A11501900
EMITPAIR(3,BFC); %A11502000
EMITO(MKS); EMITV(FM1); EMITO(XIT); %A11502100
EMITRD(FALSE,LGO,STRP,0); %A11502200
EMITO(XIT); %A11502300
INOUTUSED.[47:1] ~1; % PRINT %A11502400
END; %A11502500
PROCEDURE EMITSCAN; %A11502600
BEGIN REAL T; %A11502700
REAL STREAM PROCEDURE GITSYL(A,B); VALUE B; %A11502800
BEGIN DI ~ LOC GITSYL; DI ~ DI + 6; %A11502900
SI ~ A; SI ~ SI + B; SI ~ SI + B; %A11503000
DS ~ 2 CHR END; %A11503100
DEFINE R = FP2#; %A11503200
REAL P,S; %A11503300
REAL J; %A11503400
REAL K; %A11503500
ARRAY A[0:27]; %A11503600
INOUTUSED.[45:1] ~1; % READ %A11503700
ADJUST; %A11503800
EMITV(BLOCKCTR); EMITL(1); EMITO(ADD); %A11503900
EMITPAIR(BLOCKCTR,SND); EMIT(0); %A11504000
EMITV(INITI); J ~ BUMPL; %A11504100
EMITV(CPI); % 9 %A11504200
EMITV(RMARGI); % 10 %A11504300
EMITO(GEQ); % 11 %A11504400
P ~ BUMPL; %A11504500
EMITV(PROI); % 17 %A11504600
K ~ BUMPL; %A11504700
% %A11504800
EMITO(MKS); % 20 %A11504900
EMITV(FM1); % 21 %A11505000
EMITV(LMARGI); EMITV(RMARGI); EMITO(GEQ); EMITO(LOR); %A11505100
S ~ BUMPL; %A11505200
ADJUST; %A11505300
EMITB(BFC,J,L); %A11505400
T ~ PROGDESCBLDR(LDES,L,PRTFL); %A11505500
EMITV(BLOCKCTR); % 24 %A11505600
EMITL(1); % 25 %A11505700
EMITO(SUB); % 26 %A11505800
EMITPAIR(BLOCKCTR,STD); % 27 %A11505900
EMITL(4); % 29 %A11506000
EMITO(RTN); % 30 %A11506100
EMITB(BFC,K,L); %A11506200
EMITRD(TRUE,LGI,STRI,T); % 31 %A11506300
EMITB(BFC,S,L); EMITV(LMARGI); EMITPAIR(CPI,STD); %A11506400
EMITB(BFC,P,L); %A11506500
EMIT(0); % 54 %A11506600
EMITO(MKS); EMITV(CPI); EMITL(8); %A11506700
EMITO(IDV); EMITN(FM2); EMITV(CPI); %A11506800
EMITI(0,45,3); EMITV(RMARGI); EMITV(CPI); %A11506900
EMITO(SUB); EMITL(1); EMITO(SUB); EMITO(DUP); %A11507000
EMITL(30); EMITO(GTR); %A11507100
EMITPAIR(2,BFC); EMITO(DEL); EMITL(30); %A11507200
EMIT(0); EMITN(INSTR); %A11507300
EMITO(DUP); EMIT(0); EMITO(XCH); EMITO(STD); %A11507400
EMITN(FM3); EMITN(FP2 ); EMITO(ECM); %A11507500
STREAMTOG ~ TRUE; %A11507600
FILL A[*] WITH %A11507700
OCT0653054300310304, OCT0316014200261545, %A11507800
OCT0177044305520026, OCT0344017701400051, %A11507900
OCT1041024204410042, OCT6047213614450177, %A11508000
OCT0443055221360344, OCT0177014000511041, %A11508100
OCT0142044140476024, OCT1445013104430552, %A11508200
OCT6024034401310140, OCT0051104100420441, %A11508300
OCT2347017710410342, OCT0441004201302024, %A11508400
OCT0245024203475424, OCT1045014201310026, %A11508500
OCT0445044035474047, OCT4447322405450131, %A11508600
OCT0026264510402447, OCT1324224501312025, %A11508700
OCT0345542501450147, OCT0131002611450130, %A11508800
OCT1440542402450440, OCT0347202401451040, %A11508900
OCT0541052202040105, OCT1022073103040216, %A11509000
OCT0177042201040105, OCT0100000000000000; %A11509100
FOR T ~ 0 STEP 1 UNTIL 108 DO %A11509200
EMIT(GITSYL(A[T DIV 4],T.[46:2])); %A11509300
STREAMTOG ~ FALSE; %A11509400
EMITPAIR(COUNTI,SND); %A11509500
EMITV(CPI); EMITO(ADD); %A11509600
EMITPAIR(CPI,STD); %A11509700
EMITV(BLOCKCTR); EMITL(1); %A11509800
EMITO(SUB); EMITPAIR(BLOCKCTR,STD); %A11509900
EMITV(FP2); EMITO(RTN); %A11510000
END OF EMITSCAN; %A11510100
PROCEDURE EMITSPACEPRINT; %A11510200
BEGIN REAL T; %A11510300
EMIT(0); %A11510400
EMITV(FM1); EMIT(0); EMITO(LSS); EMITV(OUTOG); %A11510500
EMITO(LOR); EMITPAIR(1,BFC); EMITO(XIT); %A11510600
EMITV(CP); EMITV( RMARG); EMITO(GEQ); %A11510700
T ~ BUMPL ; %A11510800
CALLRITE; EMITO(XIT); %A11510900
EMITB(BFC,T,L); %A11511000
EMITV(CP); EMITV(FM1); EMITO(ADD); %A11511100
EMITV(RMARG); EMITO(GEQ); %A11511200
EMITPAIR(5,BFC); %A11511300
EMITV(RMARG); EMITV(CP); EMITO(SUB); %A11511400
EMITPAIR(3,BFW); EMITV(FM1); %A11511500
EMITPAIR(FM1,ISN); %A11511600
EMITO(DUP); EMITL(46); EMITO(GEQ); %A11511700
T~BUMPL; %A11511800
EMITV(CP); EMITL(7); %A11511900
EMITO(LND); EMITL(16); %A11512000
EMITO(XCH); EMITO(SUB); %A11512100
EMITO(DUP); EMITV(FP2); %A11512200
EMITO(XCH); EMITO(SUB); %A11512300
EMITO(DUP); EMITL(7); %A11512400
EMITO(LND); EMITO(XCH); %A11512500
EMITL(8); EMITO(IDV); %A11512600
EMITPAIR(JUNK,ISN); EMITO(DUP); %A11512700
EMITL(64); EMITO(IDV); EMITPAIR(JUNK,ISN); %A11512800
EMITB(BFC,T,T~BUMPL); %A11512900
EMITO(DUP); EMIT(0); %A11513000
EMIT(0); EMIT(0); %A11513100
EMITB(BFW,T,L); %A11513200
EMITO(MKS); LODSTR; %A11513300
% %A11513400
EMITC(7,CRF); EMITC(3,BNS); %A11513500
EMITC(1,TRP); EMIT(" "); %A11513600
EMITC(0,ENS); EMITC(1,RSA); %A11513700
EMITC(2,CRF); EMITC(0,SFS); EMITC(5,CRF); %A11513800
EMITC(0,TRW); EMITC(4,CRF); %A11513900
EMITC(3,BNS); EMITC(32,TRW); %A11514000
EMITC(32,TRW); EMITC(0,ENS); %A11514100
EMITC(6,CRF); EMITC(3,BNS); %A11514200
EMITC(1,TRP); EMIT(" "); %A11514300
EMITC(0,ENS); EMITC(1,0); %A11514400
STREAMTOG~FALSE; %A11514500
EMITV(CP); EMITV(FP2); %A11514600
EMITO(ADD); %A11514700
EMITPAIR(CP,SND); EMITV(RMARG); %A11514800
EMITO(LSS); %A11514900
EMITPAIR(1,BFC); EMITO(XIT); %A11515000
CALLRITE; EMITO(XIT); %A11515100
END OF EMITSPACEPRINT; %A11515200
PROCEDURE EMITSTRINGPRINT; %A11515300
BEGIN REAL T,R,S; %A11515400
EMIT(0); %A11515500
EMITV(OUTOG); EMITPAIR(1,BFC); EMITO(XIT); %A11515600
EMIT(0); %A11515700
EMITV(NSTR); %A11515800
T ~ L; %A11515900
EMITO(DUP); EMITV(CP); EMITO(ADD); EMITV(RMARG); %A11516000
EMITO(LEQ); %A11516100
R ~ BUMPL; %A11516200
EMITO(MKS); EMITV(FP2); %A11516300
EMITO(DUP); EMITL(7); EMITO(LND); %A11516400
EMITO(XCH); EMITL(8); EMITO(IDV); %A11516500
EMITN(OUTSTR); %A11516600
EMITV(FP3); EMITO(DUP); %A11516700
EMITL(63); EMITO(LND); %A11516800
EMITO(XCH); EMITL(64); EMITO(IDV); %A11516900
EMITPAIR(JUNK,ISN); LODSTR; %A11517000
EMITC(5,RSA); EMITC(6,CRF); %A11517100
EMITC(0,SFS); EMITC(4,CRF); %A11517200
EMITC(0,TRS); EMITC(3,CRF); %A11517300
EMITC(3,BNS); EMITC(32,TRS); %A11517400
EMITC(32,TRS); EMITC(0,ENS); %A11517500
EMITC(1,0); STREAMTOG ~ FALSE; %A11517600
EMITO(DUP); EMITV(CP); EMITO(ADD); %A11517700
EMITPAIR(CP,SND); EMITV(RMARG); %A11517800
EMITO(GEQ); %A11517900
S ~ BUMPL; %A11518000
CALLRITE; %A11518100
EMITB(BFC,S,L); %A11518200
EMITO(ADD); %A11518300
EMITO(DUP); EMITV(NSTR); %A11518400
EMITO(EQL); EMITPAIR(1,BFC); EMITO(XIT); %A11518500
EMITO(DUP); EMITV(NSTR); %A11518600
EMITO(XCH); EMITO(SUB); %A11518700
EMITB(BBW,BUMPL,T); %A11518800
EMITB(BFC,R,L); %A11518900
EMITV(FM1); %A11519000
R ~ BUMPL; %A11519100
EMITO(DUP); EMITV(RMARG); %A11519200
EMITV(LMARG); EMITO(SUB); %A11519300
EMITO(LEQ); %A11519400
S ~ BUMPL; %A11519500
EMITV(CP); EMITV(LMARG); EMITO(NEQ); %A11519600
EMITPAIR(2,BFC); %A11519700
EMITO(MKS); EMITV(TERPRIN); %A11519800
EMITB(BBW,BUMPL,T); %A11519900
EMITB(BFC,S,L); %A11520000
EMITO(DEL); EMITV(RMARG); %A11520100
EMITV(CP); EMITO(SUB); %A11520200
EMITB(BBW,BUMPL,T); %A11520300
EMITB(BFC,R,L); %A11520400
EMITO(DEL); EMITV(RMARG); EMITV(CP); %A11520500
EMITO(SUB); %A11520600
EMIT(0); EMITO(MKS); EMIT(0); %A11520700
EMITV(FP3); EMITV(FP2); EMITO(ADD); %A11520800
EMITO(DUP); EMITL(7); EMITO(LND); %A11520900
EMITO(XCH); EMITL(8); EMITO(IDV); %A11521000
EMITN(OUTSTR); EMITV(FP3); EMITO(DUP); %A11521100
EMITL(63); EMITO(LND); EMITO(XCH); %A11521200
EMITL(64); EMITO(IDV); %A11521300
EMITPAIR(JUNK,ISN); EMITO(ECM); %A11521400
STREAMTOG ~ TRUE; %A11521500
EMITC(3,RSA); EMITC(4,CRF); %A11521600
EMITC(0,SFS); EMITC(" ",TNE); %A11521700
EMITC(33,JFC); %A11521800
EMITC(1,CRF); %A11521900
EMITC(18,BNS); EMITC(2,BNS); %A11522000
EMITC(32,BNS); EMITC(1,SRS); %A11522100
EMITC(" ",TNE); EMITC(3,JNC); %A11522200
EMITC(1,INC); EMITC(0,ENS); EMITC(1,JFW); %A11522300
EMITC(2,JNS); EMITC(0,ENS); %A11522400
EMITC(1,JFW); EMITC(13,JNS); %A11522500
EMITC(5,CRF); %A11522600
EMITC(0,SEC); EMITC(1,INC); %A11522700
EMITC(5,STC); EMITC(0,SEC); %A11522800
EMITC(0,ENS); %A11522900
EMITC(2,CRF); EMITC(5,BNS); %A11523000
EMITC(1,SRS); EMITC(" ",TNE); %A11523100
EMITC(2,JNC); EMITC(1,INC); %A11523200
EMITC(0,ENS); %A11523300
EMITC(7,STC); EMITC(5,SES); %A11523400
EMITC(7,SFS); EMITC(7,SED); %A11523500
EMITC(6,SFD); EMITC(1,TRS); %A11523600
EMITC(1,0); STREAMTOG ~ FALSE; %A11523700
EMITO(SUB); EMITO(DUP); %A11523800
EMIT(0); EMITO(EQL); %A11523900
EMITB(BBC,BUMPL,T); %A11524000
EMITO(DEL); EMITO(DUP); %A11524100
EMITV(NSTR); EMITO(XCH); %A11524200
EMITO(SUB); %A11524300
EMITB(BBW,BUMPL,R); %A11524400
END OF EMITSTRINGPRINT; %A11524500
PROCEDURE EMITSYMEQ; %A11524600
BEGIN REAL T,R,S; %A11524700
EMIT(0); %A11524800
S ~ L; %A11524900
EMITV(FM3); EMITV(FM2); %A11525000
EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11525100
EMITFC(FCE,15); %A11525200
EMITPAIR(4,BFC); EMITL(1); %A11525300
EMITPAIR(FM3,STD); EMITO(XIT); %A11525400
EMIT(0); EMITO(XCH); EMITO(CTC); %A11525500
EMITO(DUP); %A11525600
EMITL(10); EMITO(LSS); %A11525700
EMITPAIR(4,BFC);R ~ L; %A11525800
EMIT(0); EMITPAIR(FM3,STD); EMITO(XIT); %A11525900
GETCONTENTS(0,FALSE); EMITO(DUP); %A11526000
EMITI(0,1,2); EMITO(DUP); EMITO(ADD); %A11526100
EMITO(BFW); %A11526200
T ~ L ~ L + 6; %A11526300
GETCONTENTS(0,FALSE); EMITV(FM2); EMITO(XCH); %A11526400
EMITO(MKS); EMITV(SYMEQA); EMITO(DEL); %A11526500
EMITPAIR(FM3,STD); EMITO(XIT); %A11526600
EMITB(BFW,T-4,L); %A11526700
EMITPAIR(FM3,SND); %A11526800
EMITV(FM2); GETCONTENTS(0,FALSE); %T9311526900
EMIT(0); EMITDIAL(DIA,46); EMITDIAL(DIB,1); %A11527000
EMITFC(FCE,2); %A11527100
EMITB(BBC,BUMPL,R); %A11527200
EMITPAIR(FM2,SND); %A11527300
EMITI(0,18,15); EMITO(XCH); %A11527400
EMITI(0,18,15); %A11527500
EMITO(MKS); EMITV(SYMEQ); EMITO(DEL); %A11527600
EMITB(BBC,BUMPL,R); %A11527700
EMITB(BBW,BUMPL,S); %A11527800
EMITB(BFW,T-2,L); %A11527900
EMITPAIR(FM3,SND); EMITV(FM2); %A11528000
GETCONTENTS(0,FALSE); EMITPAIR(FM2,SND); %A11528100
EMITL(1); EMITDIAL(DIA,46); %A11528200
EMITDIAL(DIB,1); EMITFC(FCE,2); %A11528300
EMITB(BBC,BUMPL,R); %A11528400
EMITI(0,3,30); EMITO(XCH); %A11528500
EMITI(0,3,30); EMITO(EQL); %A11528600
EMITB(BBC,BUMPL,R); %A11528700
EMITB(BBW,BUMPL,S); %A11528800
EMITB(BBW,T,R); %A11528900
END OF EMITSYMEQ; %A11529000
PROCEDURE EMITSYMEQA; %A11529100
BEGIN REAL T; %A11529200
EMIT(0); %A11529300
EMITV(FM3); EMITL(10); %A11529400
EMITDIAL(DIA,33); EMITDIAL(DIB,33); %A11529500
EMITFC(FCL,15); %A11529600
EMITPAIR(8,BFC); %A11529700
EMIT(0); EMITO(XCH); EMITO(CTC); %A11529800
EMITV(FM2); %A11529900
EMITO(EQL); EMITPAIR(FM3,STD); EMITO(XIT); %A11530000
GETCONTENTS(0,FALSE); %A11530100
EMITL(3); EMITDIAL(DIA,46); %A11530200
EMITDIAL(DIB,1); EMITFC(FCE,2); %A11530300
T ~ BUMPL; %A11530400
GETCONTENTS(0,FALSE); %A11530500
EMITV(FM2); EMITO(EQL); %A11530600
EMITPAIR(FM3,STD); EMITO(XIT); %A11530700
EMITB(BFC,T,L); %A11530800
EMIT(0); EMITPAIR(FM3,STD); %A11530900
EMITO(XIT); %A11531000
END OF EMITSYMEQA; %A11531100
PROCEDURE EMITSYMFIX; %A11531200
BEGIN REAL T; %A11531300
EMIT(0); %A11531400
EMITV(FM2); GETCONTENTS(1,FALSE); EMITO(DUP); %A11531500
EMITI(0,1,5); EMITO(DUP); %A11531600
EMITPAIR(NSTR,SND); EMIT(0); EMITO(XCH); %A11531700
EMITO(DUP); EMITL(7); %A11531800
EMITO(GTR); EMITPAIR(2,BFC); %A11531900
EMITO(DEL); %A11532000
EMITL(4); %A11532100
T ~ L; %A11532200
EMITO(MKS); EMIT(0); EMITN(OUTSTR); %A11532300
EMITO(ECM); STREAMTOG ~ TRUE; %A11532400
EMITC(4,CRF); EMITC(0,SFD); %A11532500
EMITC(6,SES); EMITC(1,SFS); %A11532600
EMITC(3,CRF); EMITC(0,TRS); %A11532700
EMITC(1,0); STREAMTOG ~ FALSE; %A11532800
EMITO(ADD); EMITO(DUP); EMITV(FP3); %A11532900
EMITO(XCH); EMITO(SUB); EMITO(DUP); %A11533000
EMIT(0); EMITO(EQL); %A11533100
EMITPAIR(1,BFC); EMITO(XIT); %A11533200
EMITO(DUP); EMITL(7); %A11533300
EMITO(GTR); %A11533400
EMITPAIR(2,BFC); EMITO(DEL); EMITL(4); %A11533500
EMITV(FP2); GETCONTENTS(0,FALSE); EMITPAIR(FP2,STD); %A11533600
EMITB(BBW,BUMPL,T); %A11533700
% IN STACK: %A11533800
% FP1 0 %A11533900
% 6 FP2 ALPHA %A11534000
% 5 FP3 NUMBER OF CHARACTERS IN ATOMIC SYMBOL %A11534100
% 4 FP4 TOTAL NUMBER OF CHARACTERS TRANSFERRED %A11534200
% 3 FP5 NUMBER OF CHARACTERS TO TRANSFER %A11534300
END OF EMITSYMFIX; %A11534400
PROCEDURE EMITSYMPRINT; %A11534500
BEGIN REAL T,R,S; %A11534600
STACKCT ~ 1; %A11534700
EMIT(0); EMIT(0); %A11534800
EMITV(FM1); EMITO(CTC); %A11534900
EMITO(DUP); EMITL(64); %A11535000
EMITO(LSS); %A11535100
EMITPAIR(4,BFC); %A11535200
EMITO(MKS); EMITV(FP2); EMITV(CHARPRINT); EMITO(XIT); %A11535300
GETCONTENTS(0,FALSE); EMITO(DUP); %A11535400
EMITI(0,1,2); EMITO(DUP); EMITO(ADD); %A11535500
EMITO(BFW); %A11535600
T ~ L ~ L + 6; %A11535700
EMITO(MKS); EMITV(FP2); GETCONTENTS(0,FALSE); %A11535800
EMIT(0); %A11535900
EMITV(ARITHPRINT); EMITO(XIT); %A11536000
EMITB(BFW,T-2,L); EMITB(BFW,T-4,L); %A11536100
EMITO(MKS); EMITL("("); EMITV(CHARPRINT); %A11536200
EMITPAIR(3,BFW); %A11536300
S ~ L; %A11536400
EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11536500
EMITO(DUP); EMITI(0,1,2); EMITL(1); EMITO(EQL); %A11536600
EMITPAIR(7,BFC); %A11536700
EMITO(MKS); EMITV(FP2); EMITI(0,4,29); %A11536800
EMITV(ARITHPRINT); %A11536900
EMITPAIR(5,BFW); %A11537000
EMITO(MKS); EMITV(FP2); EMITI(0,18,15); %A11537100
EMITV(SYMPRINT); %A11537200
EMIT(0); EMITO(XCH); EMITO(CTC); %A11537300
EMITO(DUP); EMIT(0); EMITO(EQL); %A11537400
R ~ BUMPL; %A11537500
EMITO(MKS); EMITL(")"); EMITV(CHARPRINT); EMITO(XIT); %A11537600
EMITB(BFC,R,L); %A11537700
EMITO(DUP); %A11537800
GETCONTENTS(0,FALSE); EMITO(DUP); EMIT(0); %A11537900
EMITO(LSS); %A11538000
R ~ BUMPL; %A11538100
EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11538200
EMITO(MKS); EMITL("."); EMITV(CHARPRINT); %A11538300
EMITO(MKS); EMITL(" "); EMITV(CHARPRINT); %A11538400
EMITO(MKS); EMITV(FP2); EMITV(SYMPRINT); %A11538500
EMITO(MKS); EMITL(")"); EMITV(CHARPRINT); EMITO(XIT); %A11538600
EMITB(BFC,R,L); %A11538700
EMITO(XCH); EMITO(DEL); %A11538800
EMITB(BBW,BUMPL,S); %A11538900
EMITB(BFW,T,L); %A11539000
EMITO(MKS); EMITV(SYMFIX); %A11539100
EMITO(MKS); EMITL(1); EMITV(STRINGPRINT); %A11539200
EMITO(XIT); %A11539300
END OF EMITSYMPRINT; %A11539400
PROCEDURE EMITTERPRIN; %A11539500
BEGIN %A11539600
REAL T; %A11539700
EMIT(0); %A11539800
IF GPBV ! 0 THEN BEGIN EMITV(GPBV); %T9011540400
T ~ BUMPL; %A11540500
CALLRITE; EMITO(XIT); %A11540600
EMITB(BFC,T,L) END; %A11540700
EMITO(MKS); EMITV(RMARG); EMITV(CP); %A11540800
EMITO(SUB); EMITO(SSP); %A11540900
EMITV(SPACEPRINT); %A11541000
EMITO(XIT); %A11541100
END OF EMITTERPRIN; %A11541200
PROCEDURE EMITARSTV; %A11541300
BEGIN % THIS IS A CHAR MODE INTRINSIC %A11541400
STREAMTOG ~ TRUE; %A11541500
EMITC(1,CRF); EMITC(0,JFW); %A11541600
EMITC(4,SED); EMITC(4,SES); %A11541700
EMITC(8,OCV); EMITC(7,SEC); EMITC(4,SES); %A11541800
EMITC(1,SFS); EMITC(6,BNS); %A11541900
EMITC(0,TEQ); EMITC(3,JNC); %A11542000
EMITC(1,SFS); EMITC(63,INC); %A11542100
EMITC(0,ENS); EMITC(3,STC); %A11542200
EMITC(4,SED); EMITC(1,SFD); EMITC(3,CRF); %A11542300
EMITC(0,TRS); EMITC(0,0); %A11542400
STREAMTOG ~ FALSE %A11542500
END OF EMITARSTV; %A11542600
PROCEDURE EMITINT(N); VALUE N; REAL N; %A11542700
BEGIN %A11542800
CASE N OF BEGIN %A11542900
EMITADDPROP; %A11543000
EMITALFPRINT; %A11543100
EMITAPPEND; %A11543200
EMITARITHPRINT(FALSE); %A11543300
EMITATCON; %A11543400
EMITATN; %A11543500
EMITATSTRV; %A11543600
EMITBOOPRINT; %A11543700
EMITCHARPRINT; %A11543800
EMITCOLLECT; %A11543900
EMITDBLFACT; %A11544000
EMITDBLPLXFACT; %A11544100
EMITPLXPRINT(TRUE); %A11544200
EMITARITHPRINT(TRUE); %A11544300
EMITERRPRO; %A11544400
EMITGENLINK; %A11544500
EMITGENSYM; %A11544600
EMITLENGTH; %A11544700
EMITMARK; %A11544800
EMITMARKD; %A11544900
EMITMARKER; %A11545000
EMITMARKOB; %A11545100
EMITMEMBER; %A11545200
EMITMKATOM; %A11545300
EMITMONPRO; %A11545400
EMITMONSYM; %A11545500
EMITNCONC; %A11545600
EMITNTA; %A11545700
EMITNTS; %A11545800
EMITPLXFACT; %A11545900
EMITPLXPRINT(FALSE); %A11546000
EMITPROP; %A11546100
EMITRANDNO; %A11546200
EMITRANDOM; %A11546300
EMITREAD; %A11546400
EMITREAD1; %A11546500
EMITREADCON; %A11546600
EMITREADN; %A11546700
EMITREADSYM; %A11546800
EMITRECALL; %A11546900
EMITRECLAIMER; %A11547000
EMITRECLINK; %A11547100
EMITREMEMBER; %A11547200
EMITREMOB; %A11547300
EMITREMPROP; %A11547400
EMITRITE; %A11547500
EMITSCAN; %A11547600
EMITSPACEPRINT; %A11547700
EMITSTRINGPRINT; %A11547800
EMITSYMEQ; %A11547900
EMITSYMEQA; %A11548000
EMITSYMFIX; %A11548100
EMITSYMPRINT; %A11548200
EMITTERPRIN; %A11548300
EMITDACOM(TRUE); %A11548400
EMITDACOM(FALSE); %A11548500
END %A11548600
END OF EMITINT; %A11548700
ENDTOG ~ DEBUGTOG; DEBUGTOG ~ INTDEBUGTOG; %T9011548800
LO ~ L; %A11548900
MOVECODE(TEDOC,EDOC); %A11549000
FILL PA[*] WITH %A11549300
%A11549400
"7ADDPROP","5ALFPR00","6APPEND0", "7ARITHPR","5ATCON00", %A11549500
"3ATN0000","5ATSTR00","5BOOPR00","6CHARPR0","7COLLECT", %A11549600
"7DBLFACT","7DPXFACT","5DPXPR00","5DBLPR00","6ERRPRO0", %A11549700
"7GENLINK","6GENSYM0","6LENGTH0","4MARK000","5MARKD00", %A11549800
"6MARKER0","6MARKOB0","6MEMBER0","6MKATOM0","6MONPRO0", %A11549900
"6MONSYM0","5NCONC00","3NTA0000","3NTS0000","7PLXFACT", %A11550000
"5PLXPR00","4PROP000","6RANDNO0","6RANDOM0","5LREAD00", %A11550100
"5READ100","7READCON","5READN00","7READSYM","6RECALL0", %A11550200
"7TWXLOOP","7RECLINK","7REMEMBR","5REMOB00","7REMPROP", %P11550300
"6LWRITE0","4SCAN000","7SPACEPR","7STRINGP","6SYMEQL0", %A11550400
"7SYMEQLA","6SYMFIX0","5SYMPR00","6TERPRI0","7DACOM-I", %A11550500
"7DACOM-O","5ARSTV00"; %A11550600
FOR R~54 STEP 1 UNTIL 55,0 STEP 1 UNTIL 53 DO % %T9011550700
IF A ~ DPI[R+50] ! 0 THEN %A11550800
BEGIN %A11550900
L ~ 0; SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; %A11551000
A ~ PROGDESCBLDR(1,0,A); %A11551100
EMITINT(R); LSTO ~ LISTOG; LISTOG ~ FALSE; %A11551200
SEGMENT((L+3) DIV 4,SGNO,2); LISTOG ~ LSTO; %A11551300
IF LISTOG THEN BEGIN %A11551400
WRTINTRSC(SGNO,PA[R],A,LIN); %A11551500
WRITELINE END; %A11551600
END; %A11551700
L~LO; SGNO ~ 2; MOVECODE(TEDOC,EDOC); %A11551800
IF DPI[106]!0 THEN BEGIN %A11551900
ADJUST; %A11552000
A ~ PROGDESCBLDR(3,L,104); %A11552100
EMITARSTV; %A11552200
IF LISTOG THEN BEGIN %A11552300
WRTINTRSC(2,PA[56],104,LIN); %A11552400
WRITELINE END; %A11552500
END; %A11552600
DEBUGTOG ~ ENDTOG; ENDTOG ~ FALSE; %TEMP %A11552700
END OF EMITNONX; %A11552800
PROCEDURE EMITDACOM (BV); VALUE BV; BOOLEAN BV; % %T9011552900
BEGIN % %T9011553000
REAL L0,L1,L2,L3,L4,L8,L9,M1,M2,M3,M4,GTS; % %T9011553100
REAL G1,G2 ; INTEGER TP;%T9011553150
DEFINE FP2=514#, FP3=515#, FP4=516#, FP5=517#; % %T9011553200
DEFINE WATE = IF DAC[16] { 0 THEN 300 ELSE MIN(DAC[16],1023)#;%T9011553250
PROCEDURE DACR(RD,B,A,GTS); VALUE RD,B,A,GTS; BOOLEAN RD; %T9011553300
REAL B,A,GTS; % %T9011553400
BEGIN % %T9011553500
BOOLEAN TP; TP := REAL(RD)>1; RD := RD AND TRUE; %T9011553550
EMITO(MKS); EMITPAIR(105,LOD); EMITL(5); % %T9011553600
EMITN(DAC[13-6|REAL(RD)]); IF RD THEN EMIT(4); %T9011553650
EMITN(2); EMITO(MOP); %T9011553700
EMITL(WATE); EMITPAIR(JUNK,ISN); %T9011553750
EMITO(CTF); IF RD THEN EMITO(LOR); %T9011553775
EMITL(IF RD THEN 2 ELSE 16-(15|REAL(TP))); EMIT(0); %T9011553800
EMITL(DAC[6] DIV 8); %T9011553850
EMITPAIR(IF RD THEN DAC[5] ELSE DAC[9],LOD); %T9011553900
%T9011553950
IF NOT RD THEN EMITO(MKS); EMITPAIR(A,MKS); % %T9011554000
EMITN(512); EMITV(513); EMITV(GTS); % %T9011554100
EMITPAIR(B,MKS); EMITN(512); EMITV(513); % %T9011554200
EMITV(GTS); % %T9011554300
IF NOT RD THEN BEGIN EMITL(15); EMITV(5); EMIT (0); EMIT (0); %T9011554400
END; % %T9011554500
EMIT (0); EMIT (0); EMIT (0); EMITV (12+REAL(RD)); % %T9011554600
END DACR; % %T9011554700
% %T9011554800
DEFINE LL1 = DAC[11] #, LL2 = DAC[17] #, LL3 = DAC[00] #; % %T9011554900
DEFINE LL4 = DAC[12] #, LL5 = DAC[18] #; % %T9011555000
DEFINE LL6 = DAC[19] #, LL7 = DAC[20] #, LL8 = DAC[21] #; %T9011555050
DEFINE BK(BK1) =EMITV(BLOCKCTR);EMITPAIR(1,BK1); % %T9011555100
EMITPAIR(BLOCKCTR,IF BK1 = ADD THEN SND ELSE STD) #; % %T9011555200
DEFINE J = DAC[3] #, GRP = DAC[4] #; % %T9011555300
DEFINE GOGO = EMITO(MKS);EMIT(0);EMITL(1);EMITV(GTS); % %T9011555400
EMITO(MKS);EMITL(9);EMITV(5);EMITO(BFW) #; % %T9011555500
GTS ~ GNAT(GOTOSOLVER); BK(ADD); % %T9011555600
IF BV THEN BEGIN % ***************** READ ******************* %T9011555700
LABEL SEGMENTR; % %T9011555750
EMIT (0); EMITPAIR(RMARGI,STD); EMITV(GRP); % %T9011555800
IF DAC[22] ! 0 THEN BEGIN EMITV(DAC[22]); EMITO(LOR); END; %T9011555850
M1 ~ BUMPL; % %T9011555900
%T9011555910
%T9011555920
%T9011555930
%T9011555940
EMIT (0); EMITPAIR(J,STD); % %T9011556000
L0 ~ M2 ~ L; % %T9011556100
DACR(TRUE,L1:=GETSPACE(TRUE,-7),L2:=GETSPACE(TRUE,-7),GTS); %T9311556200
M3 := L; %T9311556205
EMITL(DAC[6]); EMITO(MKS); %T9011556210
EMITL(DAC[6] DIV 64); % %T9011556220
EMITL((DAC[6] - 1) DIV 8); EMITN(DAC[5]); % %T9011556230
EMITO(ECM); STREAMTOG ~ TRUE; % %T9011556240
EMITC(1,RSA); EMITC(7,SFS); EMITC(4,RDA); % %T9011556250
EMITC(2,CRF); EMITC(9,BNS); % %T9011556260
EMITC(2,BNS); EMITC(32,BNS); % %T9011556270
EMITC(" ",TEQ); EMITC(12,JFC); % %T9011556280
EMITC(8,SRD); EMITC(1,SRS); EMITC(0,ENS); EMITC(0,ENS); % %T9011556290
EMITC(0,ENS); EMITC(4,CRF); EMITC(5,BNS); % %T9011556300
EMITC(" ", TEQ); EMITC(3,JNC); % %T9011556310
EMITC(8,SRD); EMITC(1,SRS); EMITC(0,ENS); % %T9011556320
EMITC(4,SDA); EMIT(64); STREAMTOG~FALSE; EMITO(DUP); EMITL(0);%T9011556330
EMITO(EQL); EMITO(ADD); EMITPAIR(RMARGI,STD); % %T9011556340
EMIT(0); EMITPAIR(DAC[2],STD); %T9011556350
BK(SUB); % %T9011556400
EMIT (0); EMITPAIR(GRP,SND); EMITO(RTN); % %T9011556500
EMITB(BFC,M1,L); BK(SUB); % %T9011556530
EMIT(4); EMITPAIR(GRP,SND); EMITO(RTN); % %T9011556560
ADJUST; L2 ~ PROGDESCBLDR(LDES,L,L2); % %T9011556600
IF TP ~ LL6 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE % %T9011556700
BEGIN EMITL(1); EMITERR(SGNO,L,"18"); END; % %T9011556800
ADJUST; L1 ~ PROGDESCBLDR(LDES,L,L1); % %T9011556900
EMITO(MKS); EMITPAIR(105,LOD); EMITL(5); % %T9011557000
EMITN(DAC[7]); EMIT(0); EMITL(2); EMIT(0); EMITL(1); % %T9011557100
EMITPAIR(DAC[9],LOD); EMIT(0); EMIT(0); EMIT(0); EMIT(0); %T9011557200
EMIT (0); EMITV(13); % %T9011557300
EMIT(0); EMITPAIR(TABR,STD); % %T9011557400
EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("BUFOV1 "); % %T9011557500
EMITO(ECM); STREAMTOG ~ TRUE; % %T9011557600
EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011557700
EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011557800
EMITC(4,STC); EMIT(64); STREAMTOG ~FALSE; G1 ~ BUMPL; % %T9011557900
IF TP ~ LL8 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN %T9011557950
EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %T9011558000
EMITC(26,TRP); EMIT("BU"); EMIT("FF"); EMIT("ER"); EMIT(" O");%T9011558100
EMIT("VE"); EMIT("RF"); EMIT("LO"); EMIT("W."); EMIT(" R"); % %T9011558200
EMIT("ET"); EMIT("YP"); EMIT("E."); EMIT("{!"); EMIT(64); % %T9011558300
STREAMTOG ~ FALSE; EMITL(26); EMITPAIR(NSTR,STD); % %T9011558400
EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011558500
EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN; % %T9011558600
END; % %T9011558650
EMITB(BFC,G1,L); % %T9011558700
EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("TOOLN2 "); % %T9011558800
EMITO(ECM); STREAMTOG ~ TRUE; % %T9011558900
EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011559000
EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011559100
EMITC(4,STC); EMIT(64); G1 ~ BUMPL; STREAMTOG ~ FALSE; % %T9011559200
IF TP ~ LL3 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011559300
%T9011559400
EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); STREAMTOG~TRUE; %T9011559500
EMITC(26,TRP); EMIT("IN"); EMIT("PU"); EMIT("T "); EMIT("TO");%T9011559510
EMIT("O "); EMIT("LO"); EMIT("NG"); EMIT(". "); EMIT("RE"); %T9011559520
EMIT("TY"); EMIT("PE"); EMIT(".{"); EMIT("!~"); EMIT(64); % %T9011559530
STREAMTOG ~ FALSE; EMITL(26); EMITPAIR(NSTR,STD); % %T9011559540
EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011559550
EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN ; % %T9011559560
END; % %T9011559600
%T9011559610
%T9011559620
%T9011559630
%T9011559640
%T9011559650
%T9011559660
CONSTANTCLEAN; EMITB(BFC,G1,L); % %T9011559700
EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("TIME3 "); % %T9011559800
EMITO(ECM); STREAMTOG ~ TRUE; % %T9011559900
EMITC(2,RSA); EMITC(3,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011560000
EMITC(5,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011560100
%T9011560110
%T9011560120
%T9011560130
%T9011560140
%T9011560145
EMITC(4,STC); EMIT(64); STREAMTOG ~ FALSE; G1 ~ BUMPL; % %T9011560150
%T9011560160
%T9011560170
%T9011560180
%T9011560190
IF TP ~ LL2 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011560200
%T9011560210
%T9011560220
%T9011560230
%T9011560240
EMITL(1); EMITERR(SGNO,L,"16") END; CONSTANTCLEAN; % %T9011560250
%T9011560260
%T9011560270
EMITB(BFC,G1,L); % %T9011560300
EMITPAIR(1,MKS); EMITPAIR(DAC[9],LOD); EMITNUM("WRTAB4 "); % %T9011560350
EMITO(ECM); STREAMTOG ~ TRUE; % %T9011560400
EMITC(2,RSA); EMITC(2,SFS); EMITC(1,SED); EMITC(1,SFD); % %T9011560450
EMITC(6,CEQ); EMITC(1,JFC); EMITC(2,JFW); EMITC(0,SEC); % %T9011560500
EMITC(4,STC); EMIT(64); STREAMTOG ~ FALSE; G1 ~ BUMPL; % %T9011560550
IF TP ~ LL5 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN % %T9011560600
EMITL(1); EMITERR(SGNO,L,"17") END; CONSTANTCLEAN; % %T9011560650
EMITB(BFC,G1,L); % %T9011560700
IF TP ~ LL7 ! 0 THEN BEGIN EMITL(TP); GOGO END ELSE BEGIN %T9011560725
EMITO(MKS); EMITPAIR(OUTSTR,LOD); EMITO(ECM); % %T9011560750
STREAMTOG ~ TRUE; EMITC(22,TRP); EMIT("PA"); EMIT("RI"); % %T9011560800
EMIT("TY"); EMIT(" E"); EMIT("RR"); EMIT("OR"); EMIT(". "); % %T9011560850
EMIT("RE"); EMIT("TY"); EMIT("PE"); EMIT("{!"); EMIT(64); % %T9011560900
STREAMTOG ~ FALSE; EMITL(22); EMITPAIR(NSTR,STD); % %T9011560950
EMITO(MKS); EMIT(0); EMITV(STRINGPRINT); EMITO(MKS); % %T9011561000
EMITV(TERPRIN); EMITB(BBW,BUMPL,L0); CONSTANTCLEAN; % %T9011561050
END; % %T9011561100
%T9011561200
%T9011561300
%T9011561400
%T9011561500
%T9011561600
%T9011561700
%T9011561800
%T9011561900
END ELSE BEGIN % ******************* WRITE ****************** %T9011562000
LABEL SEGMENTR; % %T9011562006
EMITV(TABR); EMITL(DAC[15]); EMITO(GTR); EMITPAIR(3,BFC); %T9011562008
EMITL(DAC[15]); EMITPAIR(TABR,STD); %T9011562009
%T9011562010
EMITO(MKS); EMITPAIR(DAC[9],LOD); EMITO(ECM); STREAMTOG ~TRUE;%T9011562011
EMITC(8,TRP); EMIT(" "); EMIT(" "); EMIT(" "); EMIT(" "); %T9011562012
EMITC(1,RSA); EMITC(16,TRW); EMIT(64); STREAMTOG ~ FALSE; %T9011562013
%T9311562014
%T9011562015
EMITV(DAC[2]); G1~BUMPL; %T9011562016
DACR(BOOLEAN(2),L3:=GETSPACE(TRUE,-7),L4:=GETSPACE(TRUE,-7),GTS); 11562018
EMITB(BFC,G1,L); EMIT(4); EMITPAIR(DAC[2],STD); %T9011562020
EMITO(MKS); EMITV(TABR); EMITPAIR(DAC[14],LOD); %T9011562021
EMITPAIR(DAC[9],LOD); EMIT(0); EMITO(ECM); STREAMTOG ~ TRUE; %Y9011562023
EMITC(4,SES); EMITC(1,SED); EMITC(6,SFS); EMITC(7,SFD); %T9011562024
EMITC(1,TRS); EMITC(3,RSA); EMITC(2,RDA); EMITC(1,CRF); %T9011562025
EMITC(4,BNS); EMITC(32,TRS); EMITC(32,TRS); EMITC(0,ENS); %T9011562026
EMITC(4,TRS); EMIT(64); STREAMTOG ~ FALSE; %T9011562027
DACR(FALSE,L3,L4,GTS); %T9011562029
EMITV(LMARG); EMITPAIR(CP,STD); BK(SUB); EMITO(XIT); % %T9011562030
IF TP ~ LL1 ! 0 THEN BEGIN % %T9011562035
ADJUST; L3 ~ PROGDESCBLDR(LDES,L,L3); % %T9011562040
EMIT(0); EMITPAIR(RMARGI,STD); EMIT(4); EMITPAIR(GRP,STD); % %T9011562060
EMITL(TP); GOGO END; %T9011562070
IF TP ~ LL4 ! 0 THEN BEGIN % %T9011562073
ADJUST; L4 ~ PROGDESCBLDR(LDES,L,L4); % %T9011562075
EMITL(TP); GOGO END; % %T9011562078
IF LL1 = 0 THEN BEGIN ADJUST; L3 ~ PROGDESCBLDR(LDES,L,L3); % %T9011562080
EMIT(4); EMITERR(SGNO,L,"19"); END; %T9011562085
IF LL4 = 0 THEN BEGIN ADJUST; L4 ~ PROGDESCBLDR(LDES,L,L4); % %T9011562090
EMIT(4); EMITERR(SGNO,L," 9"); END; %T9011562095
%T9011562100
END; % WRITE %T9011562200
END EMITDACOM; % %T9011562300
%T9011562400
%T9011562500
%T9011562600
%T9011562700
%T9011562800
%T9011562900
%T9011563000
%T9011563100
%T9011563200
%T9011563300
%T9011563400
%T9011563500
%T9011563600
%T9011563700
%T9011563800
%T9011563900
%T9011563950
%T9011564000
%T9011564100
PROCEDURE SFHEAD; %A11564200
BEGIN REAL R,S,T; %A11564300
DO BEGIN QUOTETOG ~ TRUE; %A11564350
IF STEPI = QUOTEOP OR ELCLASS = LITNO OR ELCLASS = 0 THEN %A11564400
R ~ SFTERM(BOOLEAN(2)) ELSE %A11564500
BEGIN QUOTETOG ~ FALSE; %A11564600
IF ELBAT[I].LVL ! 1 THEN FLAG(663); %A11564700
R ~ ELBAT[I].ADDRESS; %A11564800
IF ELCLASS = BOOID THEN SFTRC.[15:11] ~ R ELSE %A11564900
IF ELCLASS = REALID OR ELCLASS = INTID THEN BEGIN %A11565000
IF SFTRC.[26:11] ! 0 THEN FLAG(664); %A11565100
SFTRC.[26:11] ~ R END ELSE %A11565200
IF ELCLASS = PROCID THEN BEGIN %A11565300
IF T ~ TAKE(S~GIT(ELBAT[I])).[40:8] = 0 THEN BEGIN %A11565400
IF SFTRC.[37:11] ! 0 THEN FLAG(665); %A11565500
SFTRC.[37:11] ~ R END ELSE %A11565600
IF T ! 1 OR TAKE(S+1).CLASS ! REALID THEN FLAG(666) %A11565700
ELSE SFTRC.[4:11] ~ R END ELSE %A11565800
FLAG(667); %A11565900
STEPIT %A11566000
END %A11566100
END UNTIL ELCLASS ! COMMA; %A11566200
END OF SFHEAD; %A11566300
% %A11566400
REAL PROCEDURE SFTERM(BV); VALUE BV; BOOLEAN BV; %A11566500
BEGIN LABEL START,EXIT; %A11566600
REAL R,S,FIRST,LAST; %A11566700
BOOLEAN EQTOG,FST,CONSEQ; %A11566800
STREAM PROCEDURE PUT(A,B); VALUE B; %A11566900
BEGIN DI ~ A; SI ~ LOC B; DS ~ 5 DEC; DS ~ LIT "#" END; %A11567000
FORMAT OUT DCA("DCA ",I4), %A11567100
RANGE("RANGE ",I4," TO ",I4); %A11567200
FST ~ CONSEQ ~ TRUE; %A11567300
START: %A11567400
IF ELCLASS = LITNO THEN BEGIN SFPL ~ C; STEPIT END ELSE %A11567500
IF ELCLASS = QUOTEOP THEN BEGIN %A11567600
IF (R~ LNK[(S~GENQUOTE(FALSE)).[33:6],S.[39:9]]).[1:2] !2 %A11567700
AND S > 63 THEN FLAG(668); %A11567800
IF R ~ R.[33:15] ! 0 THEN SFPL ~ R ELSE %A11567900
BEGIN %A11568000
IF NOT EQTOG THEN SFPL ~ SFPL + 1; %A11568100
LNK[S.[33:6],S.[39:9]].[33:15] ~ SFPL; %A11568200
IF NOT BV.[46:1] THEN %A11568300
IF LISTOG THEN WRITE(LINE,DCA,SFPL) %A11568400
END END ELSE %A11568500
IF ELCLASS = 0 AND LEVEL = 1 AND BV.[46:1] THEN BEGIN %A11568600
IF NOT EQTOG THEN SFPL ~ SFPL + 1; %A11568700
ACCUM[0] ~ ELBAT[I] & DEFINEDID[2:41:7] & NEXTTEXT[11:32:16]; %T9211568750
E; %T9211568800
PUT(TEXT[NEXTTEXT.LINKR,NEXTTEXT.LINKC],SFPL); %T9211568900
NEXTTEXT ~ NEXTTEXT + 1; STEPIT END ELSE %T9211569000
BEGIN ERR(669); GO EXIT END; %A11569100
IF FST THEN BEGIN FIRST ~ LAST ~ SFPL; FST ~ FALSE END ELSE %A11569200
BEGIN %A11569300
IF SFPL < LAST THEN FLAG(670); %A11569400
IF NOT EQTOG THEN CONSEQ ~ CONSEQ AND LAST + 1 = SFPL; %A11569500
LAST ~ SFPL %A11569600
END; %A11569700
IF ELCLASS = FACTOP OR EQTOG ~ ELCLASS = RELOP THEN %A11569800
BEGIN STEPIT; GO START END; %A11569900
IF BV THEN SFTERM ~ FIRST & LAST [18:33:15] %A11570000
& REAL(CONSEQ) [1:47:1] ELSE %A11570100
SFTERM ~ FIRST; %A11570200
IF BV.[46:1] THEN %A11570300
IF LISTOG THEN WRITE(LINE,RANGE,FIRST,LAST); %A11570400
EXIT: QUOTETOG ~ FALSE; %A11570500
END OF SFTERM; %A11570600
% %A11570700
PROCEDURE SFEXP(TOP,FT,BL); VALUE TOP,FT,BL; %A11570800
BOOLEAN TOP,FT; REAL BL; %A11570900
BEGIN LABEL EXIT,START,LS,L2,L3,L1; %A11571000
LABEL L4; %A11571050
BOOLEAN GNF,FST,SW,SFO,B; %A11571100
REAL TB,BLL,LF,R,S,T,P,CT,A,TC; %A11571200
ARRAY SWA[0:127]; %A11571300
DEFINE GETNEXT = EMITO(MKS); EMITV(SFTRC.[37:11])#, %A11571400
GNFT = IF GNF THEN BEGIN GNF ~ FALSE; GETNEXT END#; %A11571500
SFO ~ SYMFORMAT; SYMFORMAT ~ FST ~ TRUE; LF ~ LFINAL; LFINAL~0; %A11571600
IF SFTRC.[37:11] = 0 OR SFTRC.[26:11] = 0 THEN FLAG(671); %A11571700
TB ~ 4095; ADJUST; BLL ~ L; %A11571800
IF TOP THEN BEGIN %A11571900
HOLDFR ~ 4095; BL ~ BLL; %A11572000
IF ELCLASS ! LFTBRKET THEN BEGIN ERR(672); GO EXIT END END; %A11572100
QUOTETOG ~ TRUE; %A11572200
IF SW~STEPI=DECLARATORS AND ELBAT[I].ADDRESS = SWITCHV THEN %A11572300
BEGIN STEPIT; T ~ BUMPL; CONSTANTCLEAN END; %A11572400
START: %A11572500
IF ELCLASS = LITNO OR ELCLASS = QUOTEOP THEN BEGIN %A11572600
QUOTETOG ~ TRUE; GNFT; R ~ SFTERM(TRUE); %A11572700
IF B ~ FST AND SW THEN BEGIN %A11572800
IF R > 0 THEN FLAG(673); %A11572900
FST ~ FALSE; %A11572950
IF CT = 0 THEN A ~ R.[33:15] ELSE %A11573000
IF P + 1 ! R.[33:15] THEN FLAG(673); %A11573100
R ~ (P ~ R.[18:15]) - R.[33:15]; ADJUST; %A11573200
IF CT+R>127 OR R < 0 THEN BEGIN FLAG(674);R~CT~0 END; %A11573300
DO SWA[CT~CT+1] ~ L UNTIL R ~ R - 1 < 0 END; %A11573400
IF GNF ~ ELCLASS = COLON THEN STEPIT ; %A11573500
IF NOT B THEN BEGIN %A11573600
EMITV(SFTRC.[26:11]); EMITL(S~R.[33:15]); %A11573700
IF S = R ~ R.[18:15] THEN EMITO(EQL) ELSE %A11573800
BEGIN EMITO(GEQ); EMITV(SFTRC.[26:11]); EMITL(R); %A11573900
EMITO(LEQ); EMITO(LND) END; %A11574000
L4: %A11574050
IF B ~ GNF AND(ELCLASS= LITNO OR ELCLASS = FACTOP) THEN %A11574100
BEGIN EMITO(LNG); R ~ BUMPL; %A11574200
IF ELCLASS = LITNO THEN BEGIN %A11574300
IF SFTRC.[4:11] = 0 THEN FLAG(675); %A11574400
EMITO(MKS); EMITL(C); EMITV(SFTRC.[4:11]); %A11574500
STEPIT END ELSE %A11574600
BEGIN STEPIT; STMT END; %A11574700
EMIT(0); %A11574800
END; %A11574900
IF FST THEN BEGIN LFINAL ~ BUMPL; FST ~ FALSE END ELSE %A11575000
BEGIN EMIT(HOLDFR); HOLDFR ~ L ~ L + 1 END; %A11575100
IF B THEN BEGIN EMITB(BFC,R,L); %A11575200
IF ELCLASS = SEMICOLON THEN BEGIN %A11575300
LS: QUOTETOG ~ TRUE; STEPIT; GO START END END END; %A11575400
IF NOT GNF THEN BEGIN %A11575500
IF ELCLASS = COMMA THEN BEGIN GETNEXT ; GO LS END; %A11575600
GNF ~ TRUE END; %A11575700
GO TO L2 END; %A11575800
IF FST AND SW THEN BEGIN ERR(676); GO EXIT END; %A11575900
IF ELCLASS=LABELID THEN BEGIN GNFT; LABELR; GO START END; %A11575950
QUOTETOG ~ FALSE; %A11576000
IF ELCLASS = FACTOP THEN BEGIN GNFT; %A11576100
IF STEPI = TRUTHV THEN BEGIN %A11576200
B ~ BOOLEAN(ELBAT[I].[26:1]); STEPIT; %A11576300
IF FST THEN BEGIN FST ~ FALSE; %A11576400
IF NOT B THEN BEGIN EMIT(0);LFINAL ~ BUMPL END %A11576500
END ELSE %A11576600
IF NOT B THEN BEGIN EMIT(0); EMIT(HOLDFR); %A11576700
HOLDFR ~ L ~ L + 1 END END ELSE %A11576710
BEGIN BEXP; %A11576720
IF FST THEN BEGIN EMITO(DUP); EMIT(0); EMITO(NEQ); %A11576800
LFINAL ~ BUMPL; FST ~ FALSE END; %A11576900
EMIT(HOLDFR); HOLDFR ~ L ~ L + 1; %A11577000
END; %A11577010
L1: IF ELCLASS = COMMA THEN GO LS ELSE GO L2 %A11577100
END; %A11577200
IF ELCLASS = LFTBRKET THEN BEGIN GNFT; %A11577300
SFEXP(FALSE,FST,BL); FST ~ FALSE; GO L1 END; %A11577400
IF ELCLASS=PERIOD OR ELCLASS=DOTOP THEN BEGIN GNFT; %A11577500
IF STEPI!REALID AND ELCLASS!INTID THEN BEGIN ERR(730); %A11577510
GO EXIT END; CHECKER(ELBAT[I]); EMITV(ELBAT[I].ADDRESS); %A11577520
EMITV(SFTRC.[26:11]); EMITO(EQL); STEPIT; GO L4 END; %A11577530
L2: IF ELCLASS = MULOP OR ELCLASS = ELSEV THEN BEGIN %A11577600
GNFT; EMIT(TB); TB ~ L ~ L + 1; %A11577700
IF FST THEN FLAG(677); CONSTANTCLEAN; %A11577800
QUOTETOG ~ FST ~ TRUE; ADJUST; STEPIT; %A11577900
IF LFINAL ! 0 THEN BEGIN EMITB(BFC,LFINAL,L); %A11578000
LFINAL ~ 0 END; %A11578100
GO START END; %A11578200
IF ELCLASS = RTBRKET THEN BEGIN STEPIT; %A11578300
GNFT; %A11578350
IF SW THEN BEGIN EMIT(TB); TB ~ L ~ L + 1; CONSTANTCLEAN; %A11578400
ADJUST; EMITB(BFW,T,L);EMITV(SFTRC.[26:11]); %A11578500
EMITO(DUP); EMITL(A); EMITO(GEQ); EMITO(XCH); %A11578600
EMITL(P); EMITO(LEQ); EMITO(LND); LFINAL ~ BUMPL; %A11578700
EMITV(SFTRC.[26:11]); EMITL(A); EMITO(SUB); %A11578800
EMITO(DUP); EMITO(ADD); EMITO(BFW); %A11578900
IF P-A+1!CT THEN FLAG(673); % TEMP %A11579000
FOR T ~ 1 STEP 1 UNTIL CT DO EMITB(BBW,BUMPL,SWA[T]); %A11579100
END; %A11579200
IF NOT FT THEN BEGIN %A11579300
IF LFINAL ! 0 THEN BEGIN T ~ L; L ~ LFINAL - 2; %A11579400
EMIT(HOLDFR); HOLDFR ~ LFINAL; L ~ T END; %A11579500
LFINAL ~ LF END; %A11579600
IF NOT SFO THEN BEGIN %A11579700
IF ELCLASS = COLON THEN STEPIT; %A11579800
IF ELCLASS ! LABELID OR NOT LOCAL(S~ELBAT[I]) THEN %A11579900
BEGIN ERR(678); GO EXIT END; %A11580000
STEPIT END; %A11580100
ADJUST; %A11580200
IF ERRORCOUNT = 0 THEN %A11580300
BEGIN %A11580325
IF TB = L THEN %A11580330
BEGIN %A11580335
TB ~ GET (L ~ L - 2); %A11580340
EMITO(NOP); EMITO(NOP); %A11580345
END; %A11580350
WHILE TB ! 4095 DO %A11580375
BEGIN %A11580400
T ~ GET (TB - 2); %A11580425
EMITB(BFW,TB,L); %A11580450
TB ~ T; %A11580475
END; %A11580500
END; %A11580550
IF B ~ TOP AND SFO THEN BEGIN EMITL(1); %A11580600
T ~ BUMPL; ADJUST END; %A11580700
IF TOP THEN BEGIN CT ~ L; %A11580800
IF ERRORCOUNT =0 THEN WHILE HOLDFR ! 4095 DO BEGIN %A11580900
R ~ GET(P ~ HOLDFR - 2); %A11581000
IF SFO THEN EMITB(BFC,HOLDFR,CT) ELSE %A11581100
BEGIN L ~ P; GOGEN(S,BFC) END; %A11581200
HOLDFR ~ R END; %A11581300
IF SFO THEN BEGIN EMITL(2); %A11581400
IF LFINAL ! 0 THEN BEGIN P ~ BUMPL; %A11581500
ADJUST; EMITB(BFC,LFINAL,L); EMIT(0); %A11581600
EMITB(BFW,P,L) END; %A11581700
EMITB(BFW,T,L); EMITPAIR(514,STD); END ELSE %A11581800
BEGIN %A11581900
IF LFINAL ! 0 THEN BEGIN L ~ LFINAL - 2; %A11582000
GOGEN(S,BFC) END; L ~ CT; %A11582100
END END; %A11582200
GO EXIT END; %A11582300
IF ELCLASS = NILV THEN BEGIN FST ~ FALSE; GNFT; %A11582310
STEPIT; GO L1 END; %A11582320
IF ACCUM[1] = "6RETUR" THEN BEGIN GNFT; STEPIT; %A11582400
% %A11582500
IF B ~ ACCUM[1] = "5START" THEN STEPIT; %A11582600
IF GNF ~ ELCLASS =UNTILV THEN BEGIN STEPIT; BEXP END; %A11582700
EMITB(IF GNF THEN BBC ELSE BBW,BUMPL,IF B THEN BL ELSE BLL); %A11582800
GNF ~ FALSE; %A11582900
L3: IF ELCLASS = SEMICOLON THEN GO LS ELSE GO L2 END; %A11583000
SYMFORMAT ~ FALSE; TC ~ ERRORCOUNT; STMT; %A11583100
IF TC ! ERRORCOUNT THEN GO EXIT; %A11583200
SYMFORMAT ~ TRUE; %A11583300
IF ELCLASS = SEMICOLON THEN GO LS; %A11583310
IF ELCLASS = ELSEV THEN GO L2; FLAG(119); %A11583320
EXIT: SYMFORMAT ~ SFO; %A11583400
END OF SFEXP; %A11583500
% REMOVE %M12000000
% REMOVE %M12001000
PROCEDURE DBLSTMT; 12002000
BEGIN 12003000
REAL S,T; 12004000
BOOLEAN B ; 12004100
LABEL L1,L2,L3,L4,EXIT ; 12005000
S~0; 12006000
IF STEPI!LEFTPAREN THEN ERR(281) 12007000
ELSE 12008000
L1: BEGIN 12009000
IF STEPI=COMMA THEN 12010000
BEGIN 12011000
DPTOG~TRUE; 12012000
IF STEPI=ADOP THEN STEPIT; 12013000
EMITNUM(NLO); 12014000
EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000
DPTOG~FALSE; 12016000
STEPIT; 12017000
GO TO L2; 12018000
END; 12019000
IF TABLE(I+1)=COMMA THEN 12020000
BEGIN 12021000
IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000
BEGIN 12023000
EMITO(ELBAT[I].ADDRESS+1); 12024000
L4: IF (S~S-1){0 THEN FLAG(282); STEPIT ; 12025000
GO TO L3; 12026000
END; 12027000
IF ELCLASS=ASSIGNOP THEN 12028000
BEGIN 12029000
IF S~S-1<0 THEN FLAG(285); T~0; STEPIT ; 12030000
DO 12031000
BEGIN 12032000
IF ELCLASS !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000
STEPIT; 12034000
B~ELCLASS=INTID OR ELCLASS=INTARRAYID 12034100
OR ELCLASS=INTPROCID ; 12034110
IF ELCLASS{INTID AND ELCLASS}REALID THEN 12035000
BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000
ELSE IF ELCLASS{INTPROCID AND ELCLASS}REALPROCID THEN12036100
IF ELBAT[I].LINK ! PROINFO.LINK THEN FLAG(211) 12036200
ELSE BEGIN EMITL(514); STEPIT END 12036300
ELSE IF ELCLASS>INTARRAYID OR ELCLASS<REALARRAYID 12036400
THEN ERR(286) 12036500
ELSE VARIABLE(FL); 12037000
EMITO(IF B THEN ISD ELSE STD) END UNTIL T~T+1=2;12038000
IF ELCLASS!RTPAREN THEN GO L3 ; 12039000
IF S!0 THEN FLAG(283) 12039100
ELSE BEGIN STEPIT; GO EXIT END ; 12040000
END; 12041000
IF ELCLASS=FACTOP THEN 12041100
BEGIN 12041110
DBLSTO(TRUE,7,STD); EMITO(MKS); %T9312041120
DBLEMITV(TRUE,7); EMITV(DBLFACT); %T9312041130
GO L4 ; 12041140
END ; 12041160
IF ELCLASS{INTID AND ELCLASS}BOOID THEN 12042000
BEGIN 12043000
CHECKER(T~ELBAT[I]); 12044000
STEPIT;STEPIT; 12045000
AEXP; 12046000
EMITV(T.ADDRESS); 12047000
GO TO L2; 12048000
END; 12049000
END ; 12050000
AEXP; 12051000
IF ELCLASS!COMMA THEN BEGIN ERR(284);GO EXIT 12052000
END; 12053000
STEPIT; AEXP; EMITO(XCH); 12054000
L2: S~S+1; 12055000
L3: IF ELCLASS!COMMA THEN BEGIN ERR(284);GO TO EXIT END; 12056000
GO TO L1; 12057000
EXIT:END 12058000
END DBLSTMT; 12059000
REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; 12101000
BEGIN REAL K,S,P,J,EL; 12102000
12103000
12104000
12105000
12106000
MACROID~TRUE; 12107000
P ~ GIT(FIXDEFINEINFO ~ T); 12108000
12109000
12110000
STOPDEFINE~TRUE; 12111000
EL~TABLE(NXTELBT); 12112000
NXTELBT~NXTELBT-1; 12113000
IF EL!LEFTPAREN AND EL!LFTBRKET THEN 12114000
FLAG(175) % [ OR ( EXPECTED. 12115000
ELSE DO BEGIN J~J+1; 12116000
12117000
12118000
12119000
12120000
PUT(TAKE(P) & NEXTTEXT[11:32:16] & 12121000
DEFSTACKHEAD[35:35:13], P); 12122000
DEFSTACKHEAD ~ P.LINK; 12123000
P ~ GIT(K~P); 12123500
DEFINEGEN(TRUE,0); 12124000
END UNTIL EL ~ ELBAT[NXTELBT].CLASS ! COMMA OR K = P; 12125000
IF EL!RTPAREN AND EL!RTBRKET OR K!P THEN 12126000
FLAG(174);%INCORRECT # OF PARAMS IN DEFINE INVOCATION. 12126100
MACROID~FALSE; 12127000
END; 12128000
PROCEDURE DEFINEPARAM(DINFO, N); 12150000
COMMENT DEFINEPARAM GENERATES EVERYTHING (EXCEPT THE ELBAT 12150100
WORD) FOR AN INFO TABLE ENTRY FOR A PARAMETER OF A 12150200
PARAMETRIC DEFINE. 12150300
; 12150400
VALUE DINFO, N; INTEGER DINFO, N; 12151000
BEGIN 12152000
INTEGER J; 12153000
STREAM PROCEDURE MAKEPARAM(INF, ACC, C, Q, N); VALUE C, Q, N; 12154000
BEGIN 12155000
DI ~ ACC; DI ~ DI+3; 12156000
SI ~ INF; SI ~ SI+3; DS ~ C CHR; 12157000
SI ~ LOC N; SI ~ SI+7; DS ~ 1 CHR; 12158000
SI ~ LOC Q; SI ~ SI+6; DS ~ 1 CHR; 12159000
DI ~ ACC; DI ~ DI+2; DS ~ 1 CHR; 12160000
END MAKEPARAM; 12161000
ACCUM[1] ~ 0; 12161500
MAKEPARAM(INFO[DINFO.LINKR,DINFO.LINKC], ACCUM[1], 12162000
J ~ INFO[DINFO.LINKR,DINFO.LINKC].[12:6], 770+J, N); 12163000
SCRAM ~ ACCUM[1] MOD 125; 12164000
COUNT ~ J+2; 12165000
END DEFINEPARAM; 12166000
COMMENT THIS SECTION CONTAINS THE PROCEDURES USED BY THE BLOCK ROUTINE;13000000
PROCEDURE IODEC(IOT); 13001000
VALUE IOT; 13002000
INTEGER IOT; 13003000
BEGIN 13004000
STREAM PROCEDURE GET7(ACCUM,RESULT); 13005000
BEGIN 13006000
LOCAL T,T1; LABEL EXIT; 13007000
SI~ACCUM; SI~SI+2; DI~ LOC T; DI~DI+7; 13008000
DS~ CHR; T1~SI; SI~LOC T; SI~SI+7; 13009000
DI~ RESULT; DS~ 8 LIT "0 "; DI~DI-7; 13010000
IF SC}"0" 13011000
THEN IF SC<"8" 13012000
THEN 13013000
BEGIN 13014000
SI~T1; DS~ T CHR;GO TO EXIT 13015000
END; 13016000
SI~T1;DS ~ 7 CHR; 13017000
EXIT: 13018000
END; 13019000
STREAM PROCEDURE ENTERID(IDLOC,FILENO,TYPE,MULFID,FILID,FILID1,N); 13020000
VALUE FILENO,TYPE,MULFID,FILID,N; 13021000
BEGIN 13022000
DI~IDLOC; DI~DI+5;DI~DC; 13023000
SI~LOC FILENO; SI~SI+6; 13024000
DS~ 2 CHR; SI~LOC TYPE; 13025000
SI~ SI+7; DS~ CHR; 13026000
SI~ LOC MULFID;SI~SI+1; 13027000
DS~ 7 CHR; 13028000
SI~ LOC FILID;SI~SI+1; 13029000
DS~ 7 CHR; 13030000
SI~ LOC N; SI~SI+7; 13031000
DS~ CHR; 13032000
SI~ FILID1; SI~SI+3; 13033000
DS~ N CHR; N~DI; 13034000
DI~ IDLOC; DI~DI+5; 13035000
SI~ LOC N; SI~SI+5; 13036000
DS~ 3 CHR 13037000
END; 13038000
REAL MULFID,FILID,TYPE,M,K; 13039000
BOOLEAN RECTOG; REAL RFN,RFT; %M13039100
BOOLEAN REMOTE; %A13039200
DEFINE CALL5=EMITL(0); EMITL(IOT); EMITL(8); EMITV(5) # ; 13039400
REAL SAVADDRSF ; 13039450
REAL ACCUM1; 13039500
INTEGER CURRENT, IOTEMP; COMMENT TEMP. FOR CORE SIZE CALCUL; 13039550
LABEL START; 13040000
INTEGER REMT1,INLTH,OUTLTH; % %T9013040100
JUMPCHKX; 13041000
IF G~GTA1[J~J-1]=FILEV 13042000
THEN 13043000
BEGIN 13044000
IF G~GTA1[J~J-1]=SWITCHV 13045000
THEN 13046000
BEGIN 13047000
STOPENTRY~NOT SPECTOG; 13048000
ENTRY(SUPERFILEID); 13049000
IF SPECTOG THEN GO TO START; 13050000
IF ELCLASS!ASSIGNOP 13051000
THEN FLAG(34); 13052000
EMITO(MKS); 13053000
CHECKDISJOINT(ADDRSF); 13054000
G~L;L~L+1; 13055000
EMITL(1); 13056000
EMITL(1); 13057000
EMITL(1); 13058000
EMITV(5) ; 13059000
13060000
J~-1; STOPENTRY~FALSE; 13061000
DO 13062000
BEGIN 13063000
IF STEPI ! FILEID% 13064000
THEN FLAG(35); 13065000
PASSFILE; 13066000
EMITL(J~J+1); 13067000
EMITN(ADDRSF); 13068000
EMITO(STD); 13069000
END 13070000
UNTIL ELCLASS!COMMA; 13071000
GT2~L;L~G; EMITL(J+1); L~GT2; GO TO START 13072000
END ELSE %M13073000
IF G = RECORDV AND NOT SPECTOG THEN BEGIN %M13073500
G ~ GTA1[J~J-1]; RECTOG ~ TRUE END; %M13073600
I~I-1;M~1; 13074000
IF G=ALFAV 13075000
THEN M~0 13076000
ELSE J~J+1;K~J; STOPENTRY~NOT SPECTOG; 13077000
RESULT:=7; SCANNER; %T9313077050
IF IOT = 11 AND LEVEL = 1 THEN %A13077100
IF REMOTE := ACCUM[1] = "6REMOT" AND NOT SPECTOG AND %T9313077200
(RR9:=EXAMIN(NCR) = ";" OR RR9 = "(") THEN %T9313077250
BEGIN M~ 0; IOT ~ 9; COUNT ~ 5; %A13077300
SCRAM ~ (ACCUM[1] ~ "5TWXF1") MOD 125 END; %A13077400
DO 13078000
BEGIN 13079000
STOPDEFINE := TRUE ; 13079500
STEPIT; J~K;P2~P3~FALSE;GTA1[0]~0; GET7(ACCUM[1],FILID); 13080000
MULFID~0;TYPE~2; ENTER(FILEID); 13081000
SAVADDRSF~ADDRSF ; 13081500
IF SPECTOG THEN GO TO START; 13082000
EMITO(MKS);EMITL(0);EMITL(0); 13082500
IF REMOTE THEN BEGIN TYPE ~ 19; % %T9013082600
DAC[13] ~ DAC[7] ~ ADDRSF END ELSE BEGIN %T9013082700
IF ELCLASS=LITNO 13083000
THEN 13084000
BEGIN 13085000
TYPE~ELBAT[I].ADDRESS; 13086000
STEPIT 13087000
END ELSE % 13088000
IF ELCLASS{IDMAX THEN 13088010
BEGIN 13088020
% TO VOID A CARD 13088025
IF ACCUM1~ACCUM[1]="5PRINT" THEN TYPE~1 ELSE 13088030
IF ACCUM1="6REMOT" THEN TYPE ~ 19 ELSE 13088035
IF ACCUM1="5PUNCH" THEN TYPE~0 ELSE 13088040
IF ACCUM1="4DISK0" THEN BEGIN STOPDEFINE~TRUE ; 13088050
TYPE ~ 10; IF STEPI{IDMAX THEN BEGIN IF RECTOG THEN BEGIN %T9213088060
IF ACCUM1~ACCUM[1]="5LOCAL" THEN RFT ~1 ELSE IF ACCUM1="3NEW00" %M13088061
THEN RFT~2 ELSE IF ACCUM1="3OLD00"THEN RFT ~3 ELSE BEGIN RFT~1; %M13088062
I ~ I - 1 ; END ; IF STEPI = LITNO THEN% %A13088063
RFN ~ C ELSE I ~ I - (RFN ~ 1) END ELSE % %A13088064
IF ACCUM1~ACCUM[1]! %M13088065
"6RANDO" THEN BEGIN IF ACCUM1="6SERIA" THEN TYPE~TYPE+2 ELSE 13088070
IF ACCUM1="6UPDAT" THEN TYPE~TYPE+3 ELSE 13088080
FLAG(43); END; STEPIT END ELSE IF RECTOG THEN FLAG(43); %M13088085
IF ELCLASS=LFTBRKET THEN %M13088087
BEGIN STEPIT;L~L-2;AEXP;IF ELCLASS=COLON THEN BEGIN 13088090
STEPIT; AEXP END ELSE FLAG(30); 13088100
IF ELCLASS!RTBRKET THEN FLAG(44);END ELSE I~I-1; 13088105
END; 13088110
STEPIT 13088120
END ELSE IF RECTOG THEN BEGIN FLAG(695); RFN ~ RFT ~ 1 END;% %A13088130
IF ELCLASS=STRNGCON THEN 13089000
BEGIN 13090000
GET7(ACCUM[1],G); 13091000
IF STEPI=STRNGCON 13092000
THEN 13093000
BEGIN 13094000
GET7(ACCUM[1],FILID); 13095000
STEPIT; 13096000
MULFID~G 13097000
END 13098000
ELSE 13099000
FILID~G; 13100000
END END; %A13101000
IF MKABS(IDARRAY[127]) - IDLOC.[33:15] < (26 + KOUNT).[41:4] 13101100
THEN FLAG(040) ELSE 13101200
ENTERID(IDLOC,FILENO ,TYPE,MULFID,FILID,INFO[(LASTINFO+1). 13102000
LINKR,(LASTINFO+1).LINKC],KOUNT); 13103000
IF ELCLASS!LEFTPAREN 13104000
AND NOT REMOTE %A13104500
THEN FLAG(26); 13105000
IF NOT REMOTE THEN % %T1113105500
ARRAYFLAG~BOOLEAN(3) ; %B0213106000
13107000
EMITL(REAL(NOT(P2 OR P3)).[46:2]); 13108000
EMITL(FILENO);FILENO~FILENO+1; 13109000
CHECKDISJOINT(TAKE(LASTINFO).ADDRESS); 13110000
IF REMOTE THEN BEGIN EMITL(CURRENT ~ 11 - IOT); EMIT(4); % %T9013110100
%T9013110150
%T9013110175
REMT1 ~ L; EMITL(IOTEMP ~ 17); % %T9013110200
EMIT(0); EMITO(DUP) END ELSE BEGIN % %T9013110300
STEPIT;AEXP;EMITL(M); 13111000
COMMENT GUESS AT THE NO. OF BUFFERS DECLARED; 13112000
IF IOTEMP~GET(L-2).[46:2] = 0 THEN CURRENT~IOTEMP 13113000
DIV 4 ELSE CURRENT~2; 13114000
13115000
13116000
13117000
13118000
13119000
13120000
13121000
13122000
13123000
13124000
13125000
13126000
13127000
13128000
13129000
13130000
13131000
13132000
13133000
13134000
13135000
13136000
13137000
13138000
13139000
13140000
13141000
13142000
13143000
13144000
IF ELCLASS ! COMMA THEN BEGIN FLAG(27); GO TO START END 13145000
ELSE 13146000
BEGIN 13147000
IF STEPI=LITNO AND(IOTEMP~TABLE(I+1)=COMMA OR IOTEMP=RTPAREN) %M13148000
THEN BEGIN EMITL(IOTEMP ~ ELBAT[I].ADDRESS); %M13148100
STEPIT END ELSE %M13148150
BEGIN AEXP; IOTEMP ~ 256; IF RECTOG OR TYPE=14 THEN %M13148200
FLAG(648) END; %M13148300
IF ELCLASS!COMMA 13149000
THEN 13150000
BEGIN 13151000
EMITL(0); 13152000
CALL5 ; 13153000
END 13154000
ELSE 13155000
BEGIN 13156000
IF GT1~FILEATTRIBUTEINDX(FALSE)=0 THEN 13157000
BEGIN AEXP; CALL5 END 13157010
ELSE BEGIN 13158000
EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000
EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000
END ; 13161000
WHILE ELCLASS=COMMA DO 13162000
IF GT1~FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000
BEGIN ERR(291); GO START END 13164000
ELSE BEGIN 13165000
EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000
GT1~FILEATTRIBUTEHANDLER(FIO) ; 13167000
END ; 13168000
END ; 13169000
END ; 13170000
13171000
13172000
13173000
13174000
13175000
13176000
13177000
13178000
13179000
13180000
ARRAYFLAG~FALSE ; %B0213180900
IF RECTOG THEN BEGIN %M13181500
PUT(TAKE(LASTINFO+1)&RFT[2:46:2],LASTINFO+1); %M13181600
RFN:=GETSPACE(FALSE,LASTINFO+1)&IOTEMP[16:38:10]&(RFN-1)[7:39:9]; 13181700
MOREWORDS ~1; %M13181800
PUTNBUMP(RFN&GETSPACE(FALSE,LASTINFO+1)[26:37:11]); %T9313181900
MOREWORDS := 0; END; %T9313181950
IF ELCLASS!RTPAREN THEN FLAG(29); 13182000
END; %A13182500
COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000
IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000
% VOID 13185000
% VOID 13186000
IF REMOTE THEN BEGIN %A13186100
EMITL(IOT); EMITL(8); EMITV(5); %T9213186150
DACP.[22:13] ~ LASTINFO; DACP.[35:13] ~ LASTINFO; %T9013186200
SCRAM ~ (ACCUM[1] ~ "5TWXF2") MOD 125; COUNT ~ 5; %A13186300
KLASSF ~ FILEID; FORMALF ~ VONF ~ FALSE; ADDRSF ~ SAVADDRSF; %T9013186400
MAKEUPACCUM; E; I ~ I - 1; END %T9013186500
END 13187000
UNTIL STEPI!COMMA; 13188000
IF REMOTE THEN BEGIN INTEGER R; %A13188100
LABEL BACKTRACK; %T9013188101
LABEL ITSABOUTTIMEIPUTINAFUNNYLABEL; %A13188102
OUTLTH ~ INLTH ~ DAC[6] ~ 136; DAC[15] ~ 72; %T9013188103
IF LEVEL ! 1 THEN FLAG(696);% %A13188105
IF ELCLASS = LEFTPAREN THEN BEGIN %A13188110
%T9013188115
STEPIT; %T9013188116
IF ELCLASS = LITNO THEN BEGIN % %T9013188120
C ~ REAL(BOOLEAN(C+7) AND NOT BOOLEAN(7)); % %T9013188122
OUTLTH~INLTH~((DAC[6]~IF C}136 THEN 136 ELSE C)+7) DIV 8; %T9313188123
IF C ! 136 THEN BEGIN R ~ L; L~ REMT1; EMITL(INLTH); % %T9013188124
L ~ R; IOBUFFSIZE ~ IOBUFFSIZE + 17 - INLTH END; % %T9013188125
IF STEPI = COMMA THEN STEPIT END; %T9013188127
%T9013188128
IF ELCLASS = LITNO THEN BEGIN % %T9013188129
BACKTRACK: %T9013188130
DAC[5] := IF C } INLTH|8 THEN INLTH|8 ELSE C; %T9313188131
%T9013188132
%T9013188133
IF STEPI = COMMA THEN STEPIT END; % %T9013188134
IF ACCUM[1] = "4WAIT0" THEN BEGIN % %T9013188135
IF STEPI ! LITNO THEN FLAG(661) ELSE BEGIN % %T9013188136
DAC[16] ~ IF C } 300 THEN 300 ELSE C; % %T9013188137
IF STEPI = COMMA THEN STEPIT END END;% %A13188138
FOR R ~ 11,17,0,12,18,19,20,21 DO BEGIN %T9013188140
IF ELCLASS = 0 THEN BEGIN KLASSF ~ LABELID; %A13188142
FORMALF:=VONF:=FALSE; DAC[R] := ADDRSF:=GETSPACE(TRUE,1); %T9313188144
MAKEUPACCUM; E; PUTNBUMP(0); END ELSE %A13188146
IF ELCLASS = FACTOP THEN ELSE %A13188150
IF ELCLASS = LITNO AND R = 17 THEN GO BACKTRACK ELSE %T9013188155
IF ELCLASS = LABELID THEN DAC[R] ~ GNAT(ELBAT[I]) ELSE %A13188160
GO TO ITSABOUTTIMEIPUTINAFUNNYLABEL; %A13188165
IF STEPI = COMMA THEN STEPIT END; %A13188170
ITSABOUTTIMEIPUTINAFUNNYLABEL: %A13188180
IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO START END ELSE %A13188230
STEPIT END; %A13188240
ELBAT[I~I-1].CLASS ~ 0; %A13188250
SCRAM ~ (ACCUM[1] ~ "5TWXS2") MOD 125; COUNT ~ 5; %A13188260
P2 ~ STOPENTRY ~ FALSE; ENTRY(STRINGID); I ~ I - 1; %A13188270
PUTNBUMP(DAC[15]); EMITL(DAC[14] ~ ADDRSF); % %T9013188280
EMITPAIR(STRP,STD); EMITARRAY(DAC[14],OUTLTH,0,FALSE); % %T9013188290
EMITL(DAC[15]); EMITPAIR(RMARG,STD); % %T9013188300
SCRAM ~ (ACCUM[1] ~ "5TWXS1") MOD 125; %A13188310
ENTRY(STRINGID); PUTNBUMP(DAC[6]); %A13188320
EMITL(DAC[5] ~ ADDRSF); EMITPAIR(STRI,STD); %A13188330
EMITARRAY(ADDRSF,R ~ INLTH,0,FALSE); % %T9013188340
INOUTUSED.[44:1] ~ 1; INOUTUSED.[46:1] ~ 1; %A13188350
EMITL(DACOMI:=GETSPACE(TRUE,-6));EMITPAIR(FILPROI,STD); %T9313188360
EMITL(1); EMITPAIR(PROI,SND); EMITPAIR(PROTOG,SND); %A13188370
EMITPAIR(DAC[1]:=GETSPACE(TRUE,-1),SND); %T9313188380
EMITPAIR(DAC[8]:=GETSPACE(TRUE,-1),STD); %T9313188390
GTLSTAT; EMITL(DACOMO); EMITPAIR(FILPRO,STD); %A13188400
FOR R:=2 STEP 1 UNTIL 4 DO DAC[R] := GETSPACE(TRUE,-1); %T9313188410
EMIT(0); EMITPAIR(OUTOG,STD); EMITL(1); EMITPAIR(INITI,STD); %A13188415
STRINGMAX ~ MAX(STRINGMAX,DAC[15],DAC[6]); % %T9013188416
P2 ~ FALSE; LEVEL ~ 1 END; %A13188420
STOPENTRY~FALSE; 13189000
END ELSE 13190000
BEGIN 13191000
IF G!FORMATV THEN FLAG(33) ELSE %B0113192000
IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN13193000
END; 13194000
ARRAYFLAG := FALSE ; % 13194500
START: 13195000
END; 13196000
PROCEDURE HANDLESWLIST; 13196300
BEGIN 13196310
LABEL OVER; 13196320
13196330
JUMPCHKX; 13196340
STOPENTRY~ NOT SPECTOG; 13196350
ENTRY(SUPERLISTID); 13196360
IF SPECTOG THEN GO TO OVER; 13196370
IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380
COMMENT MISSING ~; 13196390
EMITO(MKS); 13196400
CHECKDISJOINT(ADDRSF); 13196410
G~L; L~L+1; 13196420
EMITL(1); 13196430
EMITL(1); 13196440
EMITL(1); 13196450
EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460
LIST DESCRIPTORS FOR SWITCH LIST; 13196470
COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; %D13196480
J~-1; STOPENTRY ~ FALSE; 13196490
DO 13196500
BEGIN 13196510
IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520
THEN BEGIN ERR(42); GO TO OVER END; 13196530
PASTOLIST; 13196540
EMITL(J~J+1); 13196550
EMITN(ADDRSF); 13196560
EMITO(STD); COMMENT STORE LIST DESC IN ARRAY;13196570
END 13196580
UNTIL ELCLASS ! COMMA; 13196590
GT2~L; L~G; EMITL(J+1); L~GT2; 13196600
OVER: END OF HANDLESWLIST; 13196610
PROCEDURE SCATTERELBAT; 13197000
BEGIN 13198000
REAL T; 13199000
T ~ ELBAT[I]; 13200000
KLASSF ~ T.CLASS; 13201000
FORMALF ~ BOOLEAN(T.FORMAL); 13202000
VONF ~ BOOLEAN(T.VO); 13203000
LEVELF ~ T.LVL; 13204000
ADDRSF ~ T.ADDRESS; 13205000
INCRF ~ T.INCR; 13206000
LINKF ~ T.LINK; 13207000
END SCATTERELBAT; 13208000
PROCEDURE CHKSOB; 13209000
IF GTA1[J~J-1]!0 THEN FLAG(23); 13210000
DEFINE SUBOP=48#, 13211000
ADDC=532480#, 13212000
SUBC=1581056#, 13213000
EMITSTORE=EMITPAIR#; 13214000
PROCEDURE PURGE(STOPPER); 13215000
VALUE STOPPER; 13216000
REAL STOPPER; 13217000
BEGIN 13218000
INTEGER POINTER; 13219000
LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000
REAL J,N,OCR,TL,ADD; 13221000
POINTER~LASTINFO; 13222000
WHILE POINTER } STOPPER 13223000
DO 13224000
BEGIN 13225000
IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO 13226000
THEN BEGIN 13227000
NCII~NCII-1; 13228000
EMITNUM(TAKE(POINTER+1)); 13229000
EMITSTORE(MAXSTACK,STD); 13230000
MAXSTACK~(G~MAXSTACK)+1; 13231000
J~L; L~GT1.LINK; 13232000
DO 13233000
BEGIN 13234000
GT4~GET(L); 13235000
EMITV(G) 13236000
END 13237000
UNTIL (L~GT4)=4095; 13238000
L~J; 13239000
POINTER~POINTER-GT1.INCR 13240000
END 13241000
ELSE 13242000
IF ELCLASS=FACTOP THEN BEGIN PUT(ABS(TAKE(GT1)),GT1); %M13242100
POINTER ~ POINTER - GT1.INCR; END ELSE %M13242200
BEGIN 13243000
IF NOT BOOLEAN(GT1.FORMAL) 13244000
THEN BEGIN 13245000
IF ELCLASS = LABELID 13246000
THEN BEGIN 13247000
ADD ~ GT1.ADDRESS; 13248000
IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1] 13249000
THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000
THEN BEGIN GT1 ~ 160; GO TO RECOV END; 13251000
IF ADD ! 0 THEN GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000
ELSE IF ELCLASS = SWITCHID 13253000
THEN BEGIN 13254000
IF TAKE(POINTER+1) < 0 13255000
THEN BEGIN GT1 ~ 162; GO TO RECOV END; 13256000
OCR ~(J ~ TAKE(GIT(POINTER))).[24:12]; 13257000
N ~ GET( (J~J.[36:12])+4); TL ~ L; 13258000
IF ADD ~ GT1.ADDRESS ! 0 13259000
THEN BEGIN 13260000
GT5 ~ PROGDESCBLDR(0,J,ADD); 13261000
IF OCR ! 0 13262000
THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000
L~J+11; EMITL(15); EMITO(RTS); 13264000
FOR J ~ 4 STEP 4 UNTIL N 13265000
DO BEGIN 13266000
EMITL(GNAT(GET(L)|4096+GET(L+1))); 13267000
EMITO(RTS) END END 13268000
ELSE BEGIN 13269000
L ~ J+13; 13270000
FOR J ~ 4 STEP 4 UNTIL N 13271000
DO BEGIN 13272000
GT1 ~ GET(L)|4096+GET(L+1); 13273000
GOGEN(GT1,BFW) END;END; 13274000
13275000
13276000
L ~ TL END 13277000
ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID 13278000
OR ELCLASS = RECSTRPROCID %M13278500
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
STREAM PROCEDURE XREFMOVE(S,C,SN,SQ,L,D); %DFB13301100
VALUE C,L; %DFB13301130
BEGIN %DFB13301160
DI:=D; %DFB13301190
DS:= 8 LIT" "; %DFB13301220
SI:=D; %DFB13301250
DS:=8 WDS; %DFB13301280
DI:=D; %DFB13301310
SI:=S; %DFB13301340
SI:=SI+3; %DFB13301370
DS:=C CHR; %DFB13301400
DI:=D; %DFB13301430
DI~DI+60; %DFB13301460
SI:=SN; %DFB13301490
DS:=4 DEC; %DFB13301520
SI:=SQ; %DFB13301610
DS:=8 DEC; %DFB13301640
SI:=LOC L; %DFB13301670
DS:=WDS; %DFB13301700
END; %DFB13301730
IF RINX~(NEXTINFO+WORDCOUNT~(COUNT+8|REAL(RECTYPE!0)+18)DIV 8).LINKR! %M13302000
NEXTINFO.LINKR 13303000
THEN BEGIN PUT(0&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO); 13304000
NEXTINFO~256|RINX END; 13305000
IF SPECTOG THEN 13305100
IF NOT MACROID THEN 13305200
UNHOOK; 13305300
KOUNT~COUNT; 13306000
ACCUM[0].INCR~WORDCOUNT; 13307000
ACCUM[1].[2:2] ~ NEWPART; %M13307500
IF RECTYPE!0 THEN ACCUM[WORDCOUNT-1] ~ RECTYPE; %M13307700
ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO; 13308000
ACCUM[1].PURPT~NEXTINFO-LASTINFO; 13309000
MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000
IF XREF THEN IF NOT SPECTOG OR MACROID THEN %DFB13310100
BEGIN %DFB13310200
XREFMOVE(ACCUM[1],COUNT,SGNO ,CARDNUMBER, %DFB13310300
XREFINFO[NEXTINFO.LINKR,NEXTINFO.LINKC]:=XLUN:=XLUN+1, %DFB13310400
XREFAY1); 13310450
WRITE(DSK1,10,XREFAY1[*]); %DFB13310500
END; %DFB13310600
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
BOOLEAN SVTOG;% %D13323010
J~0;I~I-1; 13324000
DO 13325000
BEGIN 13326000
STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT; 13327000
IF FORMALF~SPECTOG 13328000
THEN 13329000
BEGIN 13330000
IF TYPE { INTARRAYID AND TYPE } STRINGARRAYID THEN %D13330550
IF VONF THEN BEGIN SVTOG ~ ERRORTOG; FLAG(15);% %D13330600
SPECTOG ~ ERRORTOG ~ SVTOG; END; % %D13330650
IF ELCLASS!SECRET 13331000
THEN FLAG(002); 13332000
BUP~BUP+1 13333000
END 13334000
ELSE 13335000
BEGIN 13336000
IF ELCLASS>IDMAX AND ELCLASS{FACTOP 13337000
THEN FLAG(003); 13338000
IF ELCLASS!DEFINEDID THEN % CHECK FOR DUP. DECLS. 13339000
IF LEVELF=LEVEL THEN FLAG(1); % DECL. TWICE IN BLOCK. 13340000
VONF~P2; 13341000
IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000
THEN ADDRSF ~ PJ ~PJ+1 13343000
ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000
ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000
IF TYPE{INTARRAYID AND TYPE } STRINGARRAYID %M13346000
THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000
EMITL(ADDRSF); EMITN(10); 13347500
END 13347510
ELSE CHECKDISJOINT(ADDRSF); 13347520
END; 13348000
KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000
END 13350000
UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J 13351000
END; 13352000
PROCEDURE UNHOOK; 13353000
COMMENT 13354000
UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000
FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000
E WILL WORK AS NORMAL. ;13357000
BEGIN 13358000
REAL LINKT,A,LINKP; 13359000
LABEL L; 13360000
LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000
IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK 13362000
ELSE 13363000
L: IF A~TAKE(LINKT).LINK=LINKP 13364000
THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000
ELSE BEGIN LINKT~A; GO TO L END; 13366000
XREFINFO[NEXTINFO.LINKR,NEXTINFO.LINKC] ~ XREFINFO[LINKT.LINKR, 13366100
LINKT.LINKC]; 13366102
END; 13367000
PROCEDURE MAKEUPACCUM; 13368000
BEGIN 13369000
IF PTOG 13370000
THEN GT1~LEVELF ELSE GT1~LEVEL; 13371000
ACCUM[0]~ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000
& REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11]13373000
) 13374000
END; 13375000
PROCEDURE ARRAE; 13376000
COMMENT 13377000
ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000
IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000
STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000
MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000
EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000
ARRAY A[0:10], 13383000
MKS (THIS MARKS STACK TO CUT BACK AFTER COM)13384000
DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000
THE ADDRESS OF A) 13386000
LITC 11 (SIZE OF ARRAY) 13387000
LITC 1 (NUMBER OF DIMENSIONS) 13388000
LITC 1 (NUMBER OF ARRAYS) 13389000
LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000
NON OWN ARRAYS) 13391000
COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000
DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000
STACK) 13394000
OWN ARRAY B,C[0:X,-1:10], 13395000
MKS 13396000
DESC B 13397000
DESC C 13398000
LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000
OPDC X 13400000
LITC JUNK (JUNK CELL) 13401000
ISN (INTEGERIZE UPPER BOUND) 13402000
LITC 1 (COMPUTE SIZE 13403000
ADD OF DIMENSION 13404000
LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000
CHS 13406000
LITC 12 (SIZE SECOND DIMENSION) 13407000
LITC 2 (NUMBER DIMENSIONS) 13408000
LITC 2 (NUMBER ARRAYS) 13409000
LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000
COM 13411000
DESC XITR 13412000
SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000
MKS 13414000
DESC D 13415000
DESC E 13416000
DESC F 13417000
OPDC X 13418000
LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000
ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000
DUP (MUST PASS LOWER BOUND FOR OWN) 13421000
OPDC Y (INTEGERIZE 13422000
LITC JUNK UPPER 13423000
ISN BOUND) 13424000
XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000
SUB UPPER 13426000
LITC 1 -LOWER 13427000
ADD +1) 13428000
OPDC M (COMPUTE LOWER BOUND 13429000
OPDC N SECOND DIM) 13430000
ADD 13431000
LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000
ISN (INTEGERIZE) 13433000
DUP (PASS LOWER BOUND FOR OWN) 13434000
OPDC T 13435000
MUL V 13436000
LITC JUNK (INTEGERIZE 13437000
ISN UPPER) 13438000
XCH (COMPUTE 13439000
SUB SIZE 13440000
LITC 1 13441000
ADD ) 13442000
LITC 2 (NUMBER DIMENSIONS) 13443000
LITC 3 (NUMBER ARRAYS) 13444000
LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000
COM 13446000
DESC XITR ; 13447000
BEGIN 13448000
REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000
BOOLEAN LLITOG,ULITOG; 13450000
INTEGER T5; %M13450500
REAL ADDCON; 13451000
LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000
ARRAYFLAG ~ TRUE; 13452100
TYPEV~REALARRAYID; 13453000
IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000
ELSE 13455000
IF T1=OWNV THEN 13456000
BEGIN 13457000
P2~TRUE;IF SPECTOG THEN 13458000
FLAG(013)13459000
END 13460000
ELSE 13461000
IF T1= SAVEV THEN 13462000
BEGIN 13463000
P3~TRUE; 13464000
IF SPECTOG THEN 13465000
FLAG(014) 13466000
END 13467000
ELSE 13468000
IF T1 >FIELDV THEN BEGIN TYPEV ~ RECARRAYID; RECTYPE ~ T1 END ELSE%M13469000
IF T1=COMPLEXV THEN BEGIN TYPEV ~ DBLPLXARRAYID; %M13469100
IF GTA1[J-1]=DOUBLEV THEN BEGIN J~J-1; NEWPART ~ 2 END ELSE %M13469200
NEWPART ~ 1 END ELSE %M13469300
IF TYPEV ~ REALID+T1 >INTARRAYID OR TYPEV < STRINGARRAYID %M13469400
THEN BEGIN FLAG(000); TYPEV ~ REALARRAYID END; %M13469500
T5~ IF TYPEV = DBLPLXARRAYID THEN REAL(NEWPART=2)|2+2 ELSE 0; %M13469600
IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000
MARKSYM ~ TYPEV=SYMARRAYID AND RECLAIMTOG; %M13470500
ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000
BETA1: 13472000
MARKSYM ~ FALSE; %M13472500
IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ~0;SAVEDIM~1; 13473000
TWO:IF STEPI=ADOP THEN 13474000
BEGIN 13475000
T1~ELBAT[I].ADDRESS; I~I+1 13476000
END 13477000
ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000
ARPROGS~L; 13479000
IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000
BEGIN 13481000
LLITOG~TRUE; 13482000
IF T3~ELBAT[I].ADDRESS!0 13483000
THEN 13484000
BEGIN 13485000
EMITL(T3); 13486000
IF T1=SUBOP THEN 13487000
BEGIN 13488000
EMITO(CHS); 13489000
ADDCON~ADDC 13490000
END ELSE 13491000
ADDCON~SUBC 13492000
END; 13493000
T2~T3|4+ADDCON 13494000
END 13495000
ELSE 13496000
BEGIN 13497000
LLITOG~FALSE; 13498000
IF T1!0 THEN I~I-1; 13499000
T2:=GETSPACE(P2,-1);%TEMP. 13500000
AEXP;EMITSTORE(T2,ISN); 13501000
T2~T2|4+SUBC+2; 13502000
IF ELCLASS!COLON THEN 13503000
FLAG(017);I~I-1 13504000
END; 13505000
IF P2 THEN 13506000
BEGIN 13507000
IF LLITOG AND T3=0 THEN EMITL(0);13508000
ARPROGS~L;EMITO(DUP); 13509000
END; 13510000
IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000
BEGIN 13512000
IF T~TABLE(I~I+1)=COMMA OR 13513000
T=RTBRKET 13514000
THEN 13515000
BEGIN 13516000
EMITL(T4~ELBAT[I-1].ADDRESS); 13517000
ULITOG~TRUE;GO TO CSZ 13518000
END 13519000
ELSE 13520000
I~I-1 13521000
END; 13522000
ULITOG~FALSE; 13523000
AEXP; 13524000
EMITL(JUNK); 13525000
EMITO(ISN); 13526000
CSZ: IF LLITOG AND ULITOG THEN 13527000
BEGIN 13528000
L~ARPROGS; 13529000
IF(T~IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000
T4-T3+1){0 OR T>1023 THEN FLAG(59); 13531000
EMITL(T); 13531100
IF P3 THEN BEGIN SAVEDIM~SAVEDIM|T; 13532000
IF SAVEDIM>MAXSAVE 13533000
THEN MAXSAVE~SAVEDIM 13534000
END 13535000
ELSE 13536000
IF T>MAXROW THEN MAXROW~T; 13537000
END 13538000
ELSE 13539000
BEGIN IF NOT(LLITOG AND T3=0) 13540000
OR P2 13541000
THEN 13542000
BEGIN 13543000
EMITO(XCH);EMITO(SUB) 13544000
END;EMITL(1);EMITO(ADD) 13545000
END; 13546000
SLB:PUTNBUMP(T2);LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547000
ELSE 13548000
IF T!RTBRKET THEN FLAG(018); 13549000
IF T5!0 THEN BEGIN %M13549050
IF SPECTOG THEN BEGIN %M13549060
IF T2>0 THEN BEGIN %M13549070
IF T ~ T2.[36:10]|T5 >1023 THEN FLAG(600); %M13549080
PUT(T2&T[36:38:10],NEXTINFO-1) %M13549090
END END ELSE %M13549100
BEGIN %M13549110
IF T2.[46:2]=0 THEN BEGIN %M13549120
IF T ~ T2.[36:10]|T5 {1023 THEN T2.[36:10] ~ T ELSE %M13549130
BEGIN EMITNUM(IF T2.[23:10]= ADD THEN -T ELSE T); %M13549140
EMITPAIR(T2:=GETSPACE(P2,-1),ISD); T2:=T2|4+SUBC+2; %T9313549150
END; PUT(T2,NEXTINFO-1) END ELSE %M13549160
BEGIN EMITV(T2.[35:11]); EMITL(T5); EMITO(MUL); %M13549170
EMITPAIR(T2.[35:11],ISD) END; %M13549180
IF P2 THEN BEGIN EMITO(XCH); EMITL(T5); EMITO(MUL); %M13549190
EMITO(XCH) END; %M13549200
EMITL(T5);EMITO(MUL) %M13549210
END END; %M13549220
IF NOT SPECTOG THEN 13550000
BEGIN 13551000
COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400
NOOFARRAYS~NOOFARRAYS + GTA1[0]; 13551500
IF TYPEV= STRINGARRAYID THEN BEGIN %M13552000
T ~ NEXTINFO ~ NEXTINFO+1; %M13552100
IF K ~ GETSTRINGLENGTH(IF GTA1[0]=1 THEN SAVEINFO ELSE 0,0) %M13552200
> 8 THEN %M13552250
BEGIN IF P2 THEN EMITL(0); EMITL(T5 ~(K+7)DIV 8); %M13552300
EMITL(LBJ+1) END ELSE EMITL(LBJ); %M13552400
PUT(K,T-1) END ELSE EMITL(LBJ); EMITL(GTA1[0]); %M13552500
EMITL(REAL(P3) +2|REAL(P2)); 13553000
EMITV(5) 13554000
END; 13555000
PUT(LBJ,SAVEINFO2-1); 13556000
DO BEGIN 13557000
T~TAKE(SAVEINFO); 13558000
K~T.INCR; 13559000
T.INCR~SAVEINFO2-SAVEINFO-1; 13560000
PUT(T,SAVEINFO); 13561000
END 13562000
UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000
IF STEPI!COMMA THEN GO TO START; 13564000
IF NOT SPECTOG THEN EMITO(MKS); 13565000
SAVEINFO~NEXTINFO; 13566000
MARKSYM ~ TYPEV=SYMARRAYID AND RECLAIMTOG; %M13566500
I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO~NEXTINFO+1;GO TO BETA1; 13567000
BETA2: 13568000
IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000
THEN 13570000
BEGIN 13571000
IF ELCLASS~TABLE(I-1)=LITNO 13572000
THEN 13573000
BEGIN 13574000
T3~ELBAT[I-1].ADDRESS; 13575000
IF T1= SUBOP THEN 13576000
ADDCON ~ADDC 13577000
ELSE 13578000
ADDCON ~SUBC; 13579000
T2~T3|4+ADDCON; GO TO SLB; 13580000
END; 13581000
IF ELCLASS=FACTOP THEN 13582000
BEGIN 13583000
T2~-SUBC; GO TO SLB 13584000
END 13585000
END; 13586000
FLAG(019); 13587000
START: ARRAYFLAG ~ FALSE; NEWPART~RECTYPE ~ 0 END; %M13588000
PROCEDURE PUTNBUMP(X); 13589000
VALUE X; 13590000
REAL X; 13591000
BEGIN 13592000
INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000
NEXTINFO~NEXTINFO+1 13594000
END ; 13595000
PROCEDURE JUMPCHKX; 13596000
COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000
WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000
ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000
IS THE FIRST EXECUTABLE CODE; 13600000
IF NOT SPECTOG THEN 13601000
BEGIN 13602000
IF AJUMP 13603000
THEN 13604000
BEGIN ADJUST; 13605000
EMITB(BFW,SAVEL,L) 13606000
END ELSE 13607000
IF FIRSTX=4095 13608000
THEN 13609000
BEGIN 13610000
ADJUST; 13611000
FIRSTX~L; 13612000
END; 13613000
AJUMP~FALSE 13614000
END; 13615000
PROCEDURE JUMPCHKNX; 13616000
COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000
EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000
NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED 13619000
AND SAVED FOR A LATER BRANCH; 13620000
IF NOT SPECTOG THEN 13621000
BEGIN 13622000
IF FIRSTX!4095 13623000
THEN 13624000
BEGIN 13625000
IF NOT AJUMP 13626000
THEN 13627000
SAVEL~BUMPL; 13628000
AJUMP~TRUE 13629000
END;ADJUST 13630000
END; 13631000
PROCEDURE SEGMENTSTART; 13632000
IF LISTOG AND PRTOG THEN % %T0313633000
IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100
ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200
PROCEDURE SEGMENT(SIZE,NO,NOO); 13657000
VALUE SIZE,NO,NOO; 13658000
REAL SIZE,NO,NOO; 13659000
BEGIN 13660000
STREAM PROCEDURE MOVE2(S,D); BEGIN SI~S; DI~D; DS~2 WDS; END; 13674000
13675000
13676000
INTEGER T,NSEGS,J,CNTR; 13677000
DEFINE POINTER = NO.[38:3], NO.[41:7]#; 13677100
NSEGS~(ABS(SIZE)+29) DIV 30; 13678000
IF DA DIV CHUNK<T~(DA+ NSEGS) DIV CHUNK THEN DA~CHUNK|T; 13679000
PDPRT[PDINX.[37:5],PDINX. [42:6]] := 13680000
SIZE & NO[28:38:10] & DA[13:33:15] 13680100
& REAL(SAVEPRTOG)[3:47:1]; 13680200
PDINX~PDINX+1; SIZE~ABS(SIZE); 13681000
IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX~SIZE; 13682000
AKKUM~AKKUM+SIZE; 13683000
IF SAVEPRTOG THEN AUXMEMREQ := AUXMEMREQ+16|(SIZE. [38:6]+1); 13683010
IF LISTOG AND PRTOG THEN % %T0313684000
IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) 13684100
ELSE WRITE(LINE[DBL],PRINTSIZE,NO,SIZE,NOO); 13684200
13685000
13686000
13687000
13688000
CNTR~0; 13689000
DO BEGIN 13690000
FOR J~0 STEP 2 WHILE J<30 AND CNTR<SIZE DO 13691000
BEGIN MOVE2(EDOC[CNTR.[38:3], CNTR.[41:7]], CODE(J)); 13692000
CNTR ~ CNTR+2; 13692100
END; 13692200
IF ERRORCOUNT = 0 AND SAVETIME } 0 THEN %A13692300
WRITE(CODE[DA]);DA~DA+1; 13693000
END 13694000
UNTIL CNTR}SIZE; 13695000
IF BUILDLINE THEN 13695050
BEGIN CNTR ~ 0; NSEGS ~ ENILPTR DIV 30 +1; SIZE ~ ENILPTR+1; 13695150
IF DA DIV CHUNK < T ~ (DA+NSEGS) DIV CHUNK THEN DA ~ CHUNK|T; 13695200
LDICT[POINTER] ~ DA&SIZE[18:33:15]; 13695250
DO BEGIN 13695300
FOR J~0 STEP 2 WHILE J<30 AND CNTR<SIZE DO 13695350
BEGIN MOVE2(ENIL[CNTR.[38:3], CNTR.[41:7]], CODE(J)); 13695400
CNTR ~ CNTR+2; 13695450
END; 13695500
WRITE(CODE[DA]); DA ~ DA+1; 13695550
END UNTIL CNTR}SIZE; 13695600
END ELSE LDICT[POINTER] ~ -1; 13695650
END SEGMENT; 13696000
13697000
13698000
13699000
13700000
13701000
13702000
13703000
13704000
13705000
13706000
13707000
13708000
13709000
13710000
13711000
13712000
13713000
PROCEDURE ENTER(TYPE); 13714000
VALUE TYPE; 13715000
INTEGER 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
BOOLEAN BT; 13736000
REAL R,S,J; %M13736500
REAL K,LS; 13737000
LS~RELAD; 13738000
BT~JUMPCTR=LEVEL; 13739000
IF FUNCTOG 13740000
THEN 13741000
BEGIN 13742000
EMITV(514); 13743000
EMITO(RTN) 13744000
END 13745000
ELSE 13746000
EMITO(XIT); 13747000
IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000
CONSTANTCLEAN; 13749000
IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 13750000
OR FAULTOG.[46:1] % %D0113750010
THEN 13751000
BEGIN ADJUST;LS~L; 13752000
IF BT OR GOTSTORAGE OR FAULTOG.[46:1] % %D0113753000
THEN 13754000
BEGIN % %D0113755000
% 13755500
EMITV(BLOCKCTR); 13756000
EMITL(1); 13757000
EMITO(ADD); 13758000
IF GOTSTORAGE OR FAULTOG.[46:1] 13759000
THEN 13760000
EMITSTORE(BLOCKCTR,SND) 13761000
END 13762000
% 13762500
ELSE EMITL(0); 13763000
K~K+NCII; 13764000
WHILE K~K-1}0 13765000
DO EMITL(0); 13766000
PURGE(STOPPER); 13767000
IF FAULTLEVEL{LEVEL THEN 13767100
BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200
EMITPAIR(0,MDS); EMITO(CHS); 13767300
END OF THIS PART OF ERROR KLUDGE; 13767400
EMIT(0); % DC & DISK 13767500
BUMPL; 13768000
13768100
EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000
CONSTANTCLEAN 13770000
END ELSE PURGE(STOPPER); 13771000
Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000
END HTTEOAP; 13773000
PROCEDURE FORMATGEN; 13774000
BEGIN 13775000
INTEGER PRT;LABEL L; 13776000
BOOLEAN TB2; 13777000
ARRAY TEDOC[0:7,0:127]; 13777500
MOVECODE(TEDOC,EDOC); 13777600
BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700
TB2~GTA1[J-1]=SWITCHV; 13778000
GT5~SGNO; 13779000
L: GT1~(2|SGAVL-1)&2[4:46:2]; STOPENTRY~TRUE;SEGMENTSTART; 13780000
SGNO~SGAVL; 13781000
GT4 := LL; LL := 0; % %W4013782000
F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000
Z~PROGDESCBLDR(LDES,0,PRT); 13784000
IF TB2 THEN 13785000
BEGIN 13786000
ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(36); 13787000
PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000
RR4~NEXTINFO;PUTNBUMP(0); 13789000
DO 13790000
BEGIN PUTNBUMP(F);IF STEPI!LEFTPAREN THEN FLAG(37);ELCLASS~"(";13791000
TB1~FORMATPHRASE; 13792000
END 13793000
UNTIL ELCLASS!","; 13794000
RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000
DO 13796000
WHIPOUT(TAKE(RR4~RR4+1)) 13797000
UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000
13799000
END ELSE 13800000
BEGIN 13801000
I~I-1; 13802000
DO 13803000
BEGIN 13804000
STOPDEFINE~TRUE;STEPIT ; 13805000
ENTRY(FRMTID);IF ELCLASS!LEFTPAREN THEN FLAG(32);ELCLASS~"("; 13806000
PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000
TB1~FORMATPHRASE; 13808000
END 13809000
UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000
13811000
13812000
END; 13813000
LL := GT4; % %W4013813500
SEGMENT(-F,SGNO,GT5);SGAVL~SGAVL+1; 13814000
IF TB1 AND ELCLASS="," THEN BEGIN I~I+1;GO TO L END; 13815000
IF ELCLASS!";" THEN ELBAT[I]~0 ELSE ELBAT[I].CLASS~SEMICOLON; 13816000
STOPGSP~STOPENTRY~FALSE; 13817000
SGNO~GT5; 13818000
MOVECODE(TEDOC,EDOC); 13818500
BUILDLINE ~ BUILDLINE.[46:1] ; 13818600
END FORMATGEN; 13819000
PROCEDURE CHECKBOUNDLVL ; 13819100
COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200
DECLARED AT SAME LEVEL; 13819300
IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL %B0213819400
THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; %B0213819410
COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500
ARRAY DECLARATION; 13819600
PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR <FAULT LIST> 13900000
THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 13901000
PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 13902000
INTRINSIC, WHO WILL BUILD AIT ENTRIES; 13903000
BEGIN INTEGER TP; REAL A; 13903100
J~0; JUMPCHKX; EMITO(MKS); 13904000
IF FAULTLEVEL>LEVEL THEN FAULTLEVEL~LEVEL; 13905000
IF MODE=0 THEN FAULTLEVEL~1; 13906000
DO BEGIN IF J>0 THEN STEPIT; J~J+1; 13907000
SCATTERELBAT; A~ACCUM[1]; 13908000
IF TP~REAL((Q="6INTOV")&(Q="6EXPOV")[46:47:1]&(Q="5INDEX" 13909000
)[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1])=0 13910000
THEN ERR (61) ELSE 13911000
BEGIN IF TABLE(I+1)=ASSIGNOP THEN 13911100
BEGIN STEPIT; COMMENT OVER THE ~; 13911200
IF GT1~STEPI>IDMAX AND GT1<FAULTID THEN ERR(3);13911300
LEVELF~ELBAT[I].LVL; 13911400
END ELSE COUNT~(ACCUM[1]~A).[12:6]; 13911500
IF LEVELF=LEVEL THEN ERR (1) ELSE 13912000
BEGIN KLASSF:=FAULTID; ADDRSF:=GETSPACE(FALSE,1); 13913000
FORMALF~VONF~FALSE; 13913100
EMITL(TP); IF MODE=0 THEN BEGIN EMITL(0); 13914000
EMITPAIR(ADDRSF,STD);END; EMITN(ADDRSF); 13915000
EMIT ("!E"); COMMENT C-TO-F; 13916000
MAKEUPACCUM; E; STEPIT 13917000
END; END; END UNTIL ELCLASS!COMMA; 13918000
EMITL(J); EMITL(13); EMITV(5); 13919000
END FAULTDEC; 13920000
COMMENT THIS SECTION CONTAINS THE BLOCK ROUTINE ; 14000000
PROCEDURE BLOCK(SOP); 14001000
VALUE SOP; 14002000
BOOLEAN SOP; 14003000
COMMENT SOP IS TRUE IF THE BLOCK WAS CALLED BY ITSELF THROUGH THE 14004000
PROCEDURE DECLARATION-OTHERWISE IT WAS CALLED BY STATEMENT. 14005000
THE BLOCK ROUTINE IS RESPONSIBLE FOR HANDLING THE BLOCK 14006000
STRUCTURE OF AN ALGOL PROGRAM-SEGMENTING EACH BLOCK,HANDLING 14007000
ALL DECLARATIONS,DOING NECESSARY BOOKKEEPING REGARDING EACH 14008000
BLOCK, AND SUPPLYING THE SCANNER WITH ALL NECESSARY INFORMATION 14009000
ABOUT DECLARED IDENTIFIERS. 14010000
IT ALSO WRITES EACH SEGMENT ONTO THE PCT; 14011000
BEGIN 14012000
LABEL OWNERR,SAVERR,BOOLEANDEC,REALDEC,ALPHADEC,INTEGERDEC, 14013000
LABELDEC,DUMPDEC,LISTDEC,OUTDEC,INDEC,MONITORDEC, 14014000
SWITCHDEC,PROCEDUREDEC,ARRAYDEC,FORMATDEC,FILEDEC, 14015000
GOTSCHK, 14016000
STRINGDEC,DOUBLEDEC,COMPLEXDEC,SYMDEC,RECORDEC,FIELDEC, %M14016500
STREAMERR,DEFINEDEC,CALLSTATEMENT,HF,START; 14017000
SWITCH DECLSW~ OWNERR, SAVERR,STRINGDEC,DOUBLEDEC,SYMDEC,RECORDEC, %M14018000
BOOLEANDEC,REALDEC,ALPHADEC,INTEGERDEC, %M14018500
LABELDEC,DUMPDEC,LISTDEC,OUTDEC,INDEC,MONITORDEC, 14019000
SWITCHDEC,PROCEDUREDEC,ARRAYDEC,FORMATDEC,FILEDEC, 14020000
STREAMERR,COMPLEXDEC,DEFINEDEC,FIELDEC; %M14021000
DEFINE NLOCS=10#,LOCBEGIN=PRTI#; 14022000
DEFINE LBP=[36:12]#; 14023000
ARRAY TEDOC[0:7,0:127],LOCALS[0:NLOCS]; 14024000
ARRAY TENIL[0:7,0:127]; 14024100
INTEGER OLDLASTADDRESS; 14024200
INTEGER OLDENILPTR; 14024300
BOOLEAN GOTSTORAGE; 14025000
BOOLEAN FWDTOG; COMMENT PREVIOUS FORWARD DECLARATION INDICATOR; 14025100
INTEGER PINFOO,BLKAD; 14026000
COMMENT LOCAL TO BLOCK TO SAVE WHERE A PROCEDURE IS EMTERED 14027000
IN INFO; 14028000
REAL MAXSTACKO,LASTINFOT,RELAD,LO,TSUBLEVEL,STACKCTRO; 14029000
INTEGER SGNOO,LOLD,SAVELO,PRTIO,NINFOO; 14030000
REAL XITLISTO,RETLISTO,SYMLOCO,SYMFORMO; BOOLEAN SOPGO; %M14030500
INTEGER NCIIO; 14031000
INTEGER PROAD ; 14032000
INTEGER NTEXTO; 14032500
INTEGER FIRSTXO; 14033000
REAL RECORDLINKO; %M14033100
BOOLEAN SYMFORMATO; %A14033200
BOOLEAN FUNCTOGO,AJUMPO,FAULTOGO; 14034000
BOOLEAN SAVEPRTOGO, NEXTSAVE; 14034100
BEGINCTR~BEGINCTR+1; 14035000
IF SOP THEN BLKAD~PROADO 14036000
14037000
14038000
14039000
14040000
14041000
14042000
14043000
ELSE BEGIN BLKAD := GETSPACE(LEVEL!0,-6); %T9314044000
EMITV(BLKAD); 14045000
EMITO(BFW); 14046000
CONSTANTCLEAN 14047000
END; 14048000
MOVECODE(TEDOC,EDOC); MOVECODE(TENIL,ENIL); 14049000
OLDLASTADDRESS ~ LASTADDRESS; LASTADDRESS ~ -1; 14049100
OLDENILPTR ~ ENILPTR; ENILPTR ~ 0; 14049200
ENILSPOT~0&CARDNUMBER[10:20:28] ; ENILPTR~1 ; 14049300
MOVE(NLOCS,LOCBEGIN,LOCALS); 14050000
FIRSTXO~FIRSTX; 14051000
FIRSTX~4095; 14052000
SYMLOCO ~ SYMLOC; SYMLOC ~ 0; %M14052200
SOPGO ~ SOPG; SOPG ~ SOP; XITLISTO ~ XITLIST; XITLIST~4095; %M14052500
IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14053000
ELSE FLAG(039); 14053100
LOLD~L;FUNCTOGO~FUNCTOG;AJUMPO~AJUMP;PRTIO~PRTI;SGNOO~SGNO; 14054000
SAVELO~SAVEL;AJUMP~FALSE; L~0;NINFOO~NEXTINFO; 14055000
RECORDLINKO ~ RECORDLINK; %M14055100
NTEXTO ~ NEXTTEXT; 14055500
NCIIO~NCII; 14056000
NCII~0; 14057000
STACKCTRO~STACKCTR; 14058000
FAULTOGO~FAULTOG; FAULTOG~ 14058100
GOTSTORAGE~FALSE; 14059000
SAVEPRTOG := (SAVEPRTOGO := SAVEPRTOG) OR SOP.[46:1]; 14059100
SEGMENTSTART; 14060000
SGNO~SGAVL; SGAVL~SGAVL+1; 14061000
ELBAT[I].CLASS~SEMICOLON; 14062000
START: IF TABLE(I)!SEMICOLON 14063000
THEN 14064000
BEGIN 14065000
FLAG(0); 14066000
I~I-1 14067000
END; 14068000
GTA1[0]~J~0; 14069000
IF SPECTOG 14070000
THEN 14071000
BEGIN 14072000
IF BUP=PJ 14073000
THEN 14074000
BEGIN 14075000
BEGIN LABEL GETLP; 14076000
INTEGER INC,TC; TC ~ 0; %M14076500
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
BUP~BUP-TAKE(BUP+1).PURPT; 14088000
GO TO GETLP 14089000
END; 14090000
INC ~ GT1 ~ 0; %M14091000
IF TYPEV ~ G.CLASS=SYMID THEN %M14091010
IF BOOLEAN(G.VO) AND RECLAIMTOG THEN SYMFORM ~ SYMFORM+1; %M14091020
IF TYPEV } DBLPLXSTRPROCID AND TYPEV { %M14091030
RECARRAYID THEN IF TC ~(TYPEV-STRINGSTRPROCID)MOD 8 = 1 THEN %M14091100
INC ~ TAKE(BUP+1).[2:2] ELSE %M14091200
IF TC = 3 THEN INC ~ TAKE(INC~((TAKE(BUP+1).[12:6]+18)DIV 8) %M14091300
+ BUP) - 30 ELSE INC ~ 0; %M14092000
IF TYPEV=FRMTID OR TYPEV= SUPERFRMTID THEN G.ADDRESS~F~F+2 ELSE %M14093000
IF TYPEV=DBLPLXID THEN G.ADDRESS~F~(IF BOOLEAN(G.VO) THEN (IF INC=2 %M14094000
THEN 4 ELSE 2)ELSE 1) + F ELSE %M14094500
IF TYPEV=STRINGID THEN G.ADDRESS~F~F+3 -G.VO ELSE %M14095000
IF TYPEV{INTARRAYID AND TYPEV}STRINGARRAYID THEN %M14096000
BEGIN 14097000
T1~G.INCR; 14098000
GT1 ~N~TAKE(BUP+T1); 14099000
G.ADDRESS ~F~ REAL(TYPEV=STRINGARRAYID) +F+N+1; %M14100000
F ~ F - REAL(TYPEV=STRINGARRAYID); %M14100500
WHILE N!0 14101000
DO 14102000
BEGIN 14103000
IF T2~TAKE(BUP+T1+N)<0 14104000
THEN 14105000
BEGIN 14106000
T2~-T2; 14107000
T2.LBP~4|(F-N)+2; 14108000
PUT(T2,BUP+T1+N) 14109000
END; 14110000
N~N-1 14111000
END; F ~ F + REAL(TYPEV=STRINGARRAYID) %M14112000
END 14113000
ELSE 14114000
G.ADDRESS~F~F+1; 14115000
PUT(G,BUP); IF GT1>7 THEN FLAG(601); %M14116000
G ~ G & GT1[32:45:3] & INC[27:43:5]; %M14116100
IF FWDTOG THEN %M14116150
BEGIN 14116200
IF(GT1~TAKE(MARK+PJ)).CLASS ! G.CLASS 14116300
COMMENT CLASS ERROR; THEN FLAG(49); 14116400
IF TC=3 OR TC=1 THEN BEGIN IF GT1.[27:5]!INC THEN FLAG(49) END; %M14116450
COMMENT VALUE ERROR; IF GT1.VO ! G.VO THEN FLAG(50) 14116500
END ELSE 14116600
PUT(G,MARK+PJ) 14117000
;BUP~BUP-TAKE(BUP+1).PURPT 14118000
END 14119000
UNTIL PJ ~ PJ - 1 = 0; %M14120000
IF PROINFO.CLASS=STRINGPROCID OR %M14120250
PROINFO.CLASS=DBLPLXPROCID THEN %M14120500
PUT(TAKE(MARK)&(F+2)[30:38:10],MARK); %M14120600
END; 14121000
SPECTOG~FALSE; 14122000
GO TO HF 14123000
END 14124000
END; 14125000
STACKCT ~ 0; %A 14125500
WHILE STEPI = DECLARATORS AND DECLCHECK %M14126000
DO 14127000
BEGIN 14128000
STOPDEFINE~(GTA1[J~J+1]~ELBAT[I].ADDRESS)!MONITORV AND 14129000
GTA1[J]!DUMPV;ERRORTOG~TRUE; 14130000
END; 14131000
IF J =0 THEN GO TO CALLSTATEMENT; 14132000
P2~P3~FALSE; 14133000
IF GTA1[J] < 30 THEN GO TO DECLSW[GTA1[J]]; %M14134000
P3 ~ TRUE; RECTYPE ~ GTA1[J]; ENTER(RECID); RECTYPE ~0; GO TO START; %M14134500
OWNERR:FLAG(20);J~J+1;GO TO REALDEC; 14135000
SAVERR:FLAG(21);J~J+1;GO TO REALDEC; 14136000
STREAMERR:FLAG(22);J~J+1;GO TO PROCEDUREDEC; 14137000
REALDEC:P3~TRUE;ENTER(REALID);GO TO START; 14138000
ALPHADEC:P3~TRUE;ENTER(ALFAID);GO TO START; 14139000
DOUBLEDEC: MOREWORDS ~ 1; P3 ~ TRUE; ENTER(DBLPLXID); %M14139100
MOREWORDS ~ 0; GO TO START; %M14139150
COMPLEXDEC: MOREWORDS ~ 1;P3 ~ TRUE; NEWPART ~1; %M14139200
IF GTA1[J-1]=DOUBLEV THEN BEGIN J ~ J - 1; MOREWORDS ~ 3; %M14139250
NEWPART ~ 2 END; ENTER(DBLPLXID); %M14139300
MOREWORDS ~ NEWPART ~ 0; GO TO START; %M14139350
SYMDEC: P3 ~ TRUE; MARKSYM ~ RECLAIMTOG; ENTER(SYMID); %M14139400
MARKSYM ~ FALSE; GO TO START; %M14139450
FIELDEC: FIELDGEN; GO TO START; %M14139500
RECORDEC: RECORDGEN; GO TO GOTSCHK; %M14139550
STRINGDEC: IF STRINGEN THEN GO TO GOTSCHK ELSE GO TO START; %M14139600
BOOLEANDEC:P3~TRUE;ENTER(BOOID);GO TO START; 14140000
INTEGERDEC:P3~TRUE;ENTER(INTID);GO TO START; 14141000
MONITORDEC:IF SPECTOG 14142000
THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR 14143000
DECLARATION APPEARS IN THE SPECIFICATION 14144000
PART OF A PROCEDURE; 14145000
FLAG(463); 14146000
END; 14147000
IF GTA1[J-1] =SYMV THEN SYMAC ELSE %M14147500
IF MERRIMAC THEN BEGIN FAULTDEC; GO GOTSCHK END; GO START;14148000
DUMPDEC:IF SPECTOG 14149000
THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION 14150000
APPEARS IN THE SPECIFICATION PART OF A 14151000
PROCEDURE; 14152000
FLAG(464); 14153000
END; 14154000
DMUP; GO TO START; 14155000
ARRAYDEC:JUMPCHKX;ARRAE;GO TO GOTSCHK; 14156000
FILEDEC:J~J+1;IODEC(11);GO TO GOTSCHK; 14157000
INDEC: IODEC(9); IF G!FORMATV THEN GO GOTSCHK; GO START; %D14158000
OUTDEC: IODEC(10); IF G=FORMATV THEN GO TO START; 14159000
GOTSCHK:GOTSTORAGE~ NOT SPECTOG OR GOTSTORAGE;GO TO START; 14160000
FORMATDEC: IF SPECTOG THEN ENTRY(IF G ~ GTA1[J-1] = SYMV %A14161000
THEN SYMSTRPROCID ELSE FRMTID + REAL(G = SWITCHV)) ELSE %A14161100
IF GTA1[J-1] = SYMV THEN IF ELCLASS = FACTOP THEN SFHEAD ELSE %A14161500
GO TO PROCEDUREDEC ELSE %A14161600
FORMATGEN; GO TO START; 14162000
LISTDEC: 14163000
BEGIN 14164000
LABEL START; 14165000
IF G~GTA1[J] = LISTV AND G~ GTA1[J-1]= SWITCHV 14165500
THEN BEGIN HANDLESWLIST; GO TO GOTSCHK END; 14165510
IF SPECTOG 14166000
THEN 14167000
BEGIN 14168000
ENTRY(LISTID); 14169000
GO TO START 14170000
END; 14171000
STOPENTRY~STOPGSP~TRUE; I~I-1; 14172000
DO 14173000
BEGIN I~I+1; 14174000
JUMPCHKX; 14175000
ENTRY(LISTID); IF ELCLASS!LEFTPAREN THEN FLAG(31) ELSE STEPIT; 14176000
F~LISTGEN; 14177000
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; %W3314177500
PUT(TAKE(LASTINFO)&(IF MODE=0 THEN F 14178000
ELSE F:=GETSPACE(FALSE,LASTINFO+1)) % LIST DESCR. 14178001
[16:37:11],LASTINFO); 14179000
EMITSTORE(F,STD); 14180000
END 14181000
UNTIL ELCLASS! COMMA; 14182000
STOPENTRY~STOPGSP~FALSE; 14183000
START: 14184000
END LISTDEC; 14185000
GO TO START; 14186000
LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24); 14187000
STOPENTRY~STOPGSP~TRUE; 14188000
I~I-1; 14189000
DO 14190000
BEGIN 14191000
STOPDEFINE~TRUE; 14192000
STEPIT; 14193000
ENTRY(LABELID); 14194000
PUTNBUMP(0) 14195000
END 14196000
UNTIL ELCLASS!COMMA; 14197000
STOPENTRY~STOPGSP~FALSE; 14198000
IF SPECTOG THEN NOGO; %M14198500
GO TO START; 14199000
SWITCHDEC: 14200000
BEGIN 14201000
LABEL START; 14202000
INTEGER GT1,GT2,GT4,GT5; 14203000
BOOLEAN TB1; 14204000
STOPENTRY~NOT SPECTOG;STOPGSP~TRUE; 14205000
SCATTERELBAT; GT1~0; TB1~FALSE; 14206000
IF LEVELF=LEVEL 14207000
THEN 14208000
BEGIN 14209000
IF TAKE(LINKF+1)}0 14210000
THEN FLAG(1); PUT(-TAKE(LINKF+1),LINKF+1); 14211000
TB1~TRUE;GT2~ADDRSF; 14212000
GT1~ TAKEFRST; GT4~LASTINFO; LASTINFO~LINKF; 14213000
STEPIT;GT5~NEXTINFO;NEXTINFO~LINKF+INCRF 14214000
END 14215000
ELSE 14216000
ENTRY(SWITCHID); STOPGSP~STOPENTRY~FALSE;IF SPECTOG THEN GO TO 14217000
START; 14218000
IF ELCLASS=ASSIGNOP 14219000
THEN 14220000
BEGIN 14221000
JUMPCHKNX;PUTNBUMP(L);G~L; 14222000
IF FORMALF~SWITCHGEN(TB1) 14223000
THEN 14224000
BEGIN 14225000
GT1~PROGDESCBLDR(ADES,G,GT1); 14226000
JUMPCHKX; 14227000
STUFFF(GT1); 14228000
IF MODE>0 14229000
THEN 14230000
IF TB1 THEN GT1~GT2 ELSE 14231000
GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000
EMITSTORE(GT1,STD) 14233000
END; 14234000
END 14235000
ELSE 14236000
BEGIN 14237000
IF ELCLASS!FORWARDV THEN FLAG(33); 14238000
PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000
PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000
IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000
STEPIT; 14242000
FORMALF~TRUE 14243000
END; 14244000
PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]&GT1[16:37:11],LASTINFO); 14245000
IF TB1 THEN 14246000
BEGIN 14247000
NEXTINFO~GT5; 14248000
LASTINFO~GT4; 14249000
END; 14250000
START: IF SPECTOG THEN NOGO %M14251000
END SWITCHDEC; 14252000
GO TO START; 14253000
DEFINEDEC: 14254000
GT1 ~ GTA1[J-1]; %A14254030
BEGIN LABEL START; 14254050
REAL J,K,DINFO,LINKA,LINKB,T; 14254100
BOOLEAN BV; BV := GT1 = SYMV; %T9314254900
STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000
DO 14256000
BEGIN 14257000
IF STEPI = FACTOP AND BV THEN BEGIN QUOTETOG ~ TRUE; %A14257100
IF STEPI ! QUOTEOP THEN FLAG(688);% %A14257150
GT1 ~ GENQUOTE(TRUE); QUOTETOG ~ FALSE; I ~ I-1 END ELSE BEGIN %A14257200
STOPDEFINE:=TRUE; 14258000
IF BV THEN ENTRY(ALFATRNS) ELSE BEGIN %A14258500
MOVE(9,ACCUM[1],GTA1); %A14259000
IF T:=ELBAT[NXTELBT-1].LINK!0 THEN % DEFINED B4 IN PROGRAM. 14259002
IF T}NINFOO THEN FLAG(1); % DEFINED B4 IN THIS BLOCK. 14259004
K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID); 14259010
GTA1[0]~J+"100000"; J~0; 14259015
DINFO ~ LASTINFO; 14259017
IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020
BEGIN 14259030
IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040
DO BEGIN STOPDEFINE~TRUE; 14259060
STEPIT; 14259070
IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075
MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080
DEFINEPARAM(DINFO+1, J); 14259085
ACCUM[0] ~ 0; 14259090
ACCUM[0].CLASS ~ DEFINEDID; 14259092
LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094
E; 14259096
IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098
PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100
STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102
STOPDEFINE ~ TRUE; 14259104
END UNTIL STEPI!COMMA; 14259110
IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120
STOPDEFINE~TRUE; 14259130
STEPIT; 14259140
PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150
PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155
END END; %A14259160
IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000
THEN 14261000
BEGIN 14262000
FLAG(45); 14263000
COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100
I~I-1; 14264000
END; 14265000
%T9214265930
%T9214265950
IF BV THEN BEGIN QUOTETOG ~ TRUE; %T9214266000
IF STEPI ! QUOTEOP THEN FLAG(688); PUTNBUMP(GENQUOTE(TRUE));%%A14266050
I ~ I -1; %M14266200
QUOTETOG ~ FALSE END ELSE BEGIN %A14266500
MACROID~TRUE; 14266600
LASTINFO ~ DINFO; %T9214266630
PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); %T9214266660
DEFINEGEN(FALSE, J & DINFO[18:33:15]); %T9214266700
MACROID~FALSE; 14266800
END; %A14266900
END END %M14267000
UNTIL STEPI!COMMA; 14268000
% %A14268500
START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000
PROCEDUREDEC: 14270000
BEGIN 14271000
LABEL START,START1; 14272000
LABEL START2, DOITANYWAY; 14273000
COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000
IF NOT SPECTOG THEN FUNCTOG~FALSE; 14275000
FWDTOG := NEXTSAVE := FALSE; 14276000
IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500
MAXSTACKO~ MAXSTACK; 14277000
IF G~GTA1[J~J-1]=STREAMV 14278000
THEN 14279000
BEGIN STREAMTOG~TRUE; 14280000
GOTCHA := GOTCHA OR NOT STREAMER; % NOT FOR XALG %T0314280500
IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000
ELSE 14282000
BEGIN 14283000
%M14284000
IF G=COMPLEXV THEN BEGIN TYPEV ~ DBLPLXSTRPROCID; %M14284300
IF GTA1[J-1]= DOUBLEV THEN BEGIN J~J-1; NEWPART~2 END ELSE %M14284500
NEWPART ~ 1 END ELSE %M14285000
IF TYPEV ~INTRNSICPROCID+G>INTSTRPROCID OR %M14285500
TYPEV < STRINGSTRPROCID THEN FLAG(4); %M14286000
IF NOT SPECTOG THEN 14287000
FUNCTOG~TRUE; 14288000
CHKSOB 14289000
END END 14290000
ELSE 14291000
BEGIN %M14291500
IF G=0 THEN TYPEV~PROCID 14292000
ELSE 14293000
IF G > FIELDV THEN BEGIN TYPEV ~RECPROCID; RECTYPE ~ G END ELSE %T9214294000
IF G = COMPLEXV THEN BEGIN TYPEV ~ DBLPLXPROCID; %T9214294100
IF GTA1[J-1]=DOUBLEV THEN BEGIN J~J-1; NEWPART~ 2 END ELSE %M14294200
NEWPART ~ 1 END ELSE %M14294300
IF (TYPEV~REALSTRPROCID+G)=INTSTRPROCID THEN %T9214294400
BEGIN NEXTSAVE~TRUE; TYPEV ~ PROCID END ELSE %T9214294600
IF TYPEV > INTPROCID OR TYPEV < STRINGPROCID THEN FLAG(005); %T9214295000
IF GTA1[J+1]=FORMATV THEN TYPEV ~ SYMSTRPROCID; %T9214295100
IF TYPEV!PROCID THEN BEGIN %T9214296000
IF (NEXTSAVE ~ GTA1[J-1] = SAVEV) THEN J ~ J - 1; %T9214296500
IF NOT SPECTOG THEN FUNCTOG ~ TRUE; CHKSOB; END; %T9214297000
END; %M14297500
IF SPECTOG 14298000
THEN 14299000
BEGIN 14300000
ENTRY(TYPEV); NEWPART ~ RECTYPE ~ 0; GO TO START2; %M14301000
END; 14302000
MODE~MODE+1; 14303000
LO~PROINFO; 14304000
SYMFORMO ~ SYMFORM; SYMFORM ~ 0; %M14304500
SCATTERELBAT; 14305000
COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000
IF LEVELF=LEVEL 14307000
THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000
BEGIN 14309000
IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE 14310000
XMARK; 14310500
PUT(-G,LINKF+1); 14311000
IF REAL (NEXTSAVE)!G.[3:1] THEN FLAG(051); %T9214311050
IF TYPEV = DBLPLXPROCID THEN BEGIN IF G.[2:2]!NEWPART THEN %T9214311100
BEGIN FLAG(6); GO DOITANYWAY END END ELSE %M14311200
IF TYPEV = RECPROCID THEN BEGIN %M14311300
IF TAKE(((G.[12:6]+18)DIV 8)+LINKF)! RECTYPE %M14311400
THEN BEGIN FLAG(6); GO DOITANYWAY END END; %M14311500
FWDTOG~TRUE; 14312000
PROAD~ADDRSF; 14313000
PROINFO~ELBAT[I];MARK~LINKF+INCRF;STEPIT 14314000
END 14316000
ELSE 14317000
DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000
ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000
PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000
P2~STOPENTRY~FALSE 14321000
END; 14322000
NEWPART ~ RECTYPE ~ 0; %M14322500
IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000
ELSE FLAG(039); 14323100
PJ ~ 0; 14323200
IF STREAMTOG THEN STREAMWORDS; 14324000
IF ELCLASS = SEMICOLON THEN GO TO START1; %A14325000
IF SLABTOG ~ ELCLASS!LFTBRKET THEN %W1414325500
IF ELCLASS!LEFTPAREN THEN FLAG(007); 14326000
COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000
FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000
RR1~NEXTINFO; 14329000
LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000
PUTNBUMP(0); 14331000
PTOG~TRUE; I~I+1; 14332000
ENTRY(SECRET); 14333000
IF FWDTOG THEN BEGIN IF GT1 ~ TAKE(MARK).[40:8] ! PJ THEN% 14333100
FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200
COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300
PUT(PJ,MARK); 14334000
P~PJ; 14335000
IF ELCLASS!RTPAREN 14336000
THEN IF ELCLASS!RTBRKET OR SLABTOG THEN FLAG(008); %W1414337000
IF STEPI!SEMICOLON 14338000
THEN FLAG(009); 14339000
COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000
IF STEPI=VALUEV 14341000
THEN 14342000
BEGIN 14343000
DO 14344000
IF STEPI!SECRET 14345000
THEN FLAG(010) 14346000
ELSE 14347000
BEGIN 14348000
IF G~ELBAT[I].ADDRESS=0 OR G>PJ 14349000
THEN 14350000
FLAG(010); 14351000
G~TAKE(ELBAT[I]); 14352000
PUT(G&1[10:47:1],ELBAT[I]) 14353000
END 14354000
UNTIL 14355000
STEPI!COMMA; 14356000
IF ELCLASS!SEMICOLON 14357000
THEN FLAG(011) 14358000
ELSE STEPIT 14359000
END;I~I-1; 14360000
IF STREAMTOG 14361000
THEN 14362000
BEGIN 14363000
BUP~PJ; SPECTOG~TRUE;GO TO START1 14364000
END 14365000
ELSE 14366000
BEGIN 14367000
SPECTOG~TRUE; 14368000
BUP~0; 14369000
IF ELCLASS!DECLARATORS 14370000
THEN FLAG(012) 14371000
END; 14372000
START:PTOG~FALSE;LASTINFO~LASTINFOT;NEXTINFO~IF FWDTOG THEN RR1 ELSE 14373000
MARK+PJ+1; 14374000
START1:PINFOO~NEXTINFO; 14375000
START2: END; 14376000
IF SPECTOG OR STREAMTOG 14377000
THEN 14378000
GO TO START; 14379000
COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 14380000
PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS; 14381000
HF: 14382000
BEGIN 14383000
LABEL START,STOP; 14384000
IF STREAMTOG 14385000
THEN BEGIN 14386000
JUMPCHKNX;G~PROGDESCBLDR(CHAR,L,PROAD);PJ~P; 14387000
PTOG~FALSE; 14388000
IF FUNCTOG 14389000
THEN 14390000
PUT((Z~TAKE(PROINFO))&LOCLID[2:41:7]&(PJ~PJ+1)[16:37:11] 14391000
, PROINFO); 14392000
IF STEPI=BEGINV 14393000
THEN 14394000
BEGIN 14395000
WHILE STEPI=DECLARATORS OR ELCLASS=LOCALV 14396000
DO 14397000
BEGIN 14398000
IF ELBAT[I].ADDRESS=LABELV 14399000
THEN 14400000
BEGIN 14401000
STOPDEFINE~STOPGSP~STOPENTRY~TRUE; 14402000
DO BEGIN STOPDEFINE~TRUE;STEPIT;ENTRY(STLABID);PUTNBUMP(0) END UNTIL14403000
ELCLASS!COMMA;STOPGSP~STOPENTRY~FALSE 14404000
END 14405000
ELSE 14406000
BEGIN 14407000
I~I+1; 14408000
ENTRY(LOCLID) 14409000
END 14410000
END; 14411000
COMPOUNDTAIL 14412000
END 14413000
ELSE 14414000
STREAMSTMT ; 14415000
COMMENT THE FOLLOWING BLOCK CONSTITUTES THE STREAM PROCEDURE PURGE; 14416000
BEGIN 14417000
REAL NLOC,NLAB; 14418000
DEFINE SES=18#,SED=6#,TRW=5#; 14419000
DEFINE RSA = 43 #; 14419100
DEFINE LOC=[36:12]#,LASTGT=[24:12]#; 14420000
J~ LASTINFO; 14421000
NLOC~NLAB~0; 14422000
DO 14423000
BEGIN 14424000
IF(GT1~TAKE(J)).CLASS=LOCLID THEN 14425000
BEGIN 14426000
IF BOOLEAN(GT1.FORMAL) THEN 14427000
BEGIN 14428000
IF GT1<0 THEN 14429000
PUT(TAKE(GT2~MARK+P-GT1.ADDRESS+1)&FILEID[2:41:7] 14430000
,GT2); 14431000
END 14432000
ELSE NLOC~NLOC+1; 14433000
END 14434000
ELSE 14435000
BEGIN 14436000
IF GT1.ADDRESS!0 THEN NLAB~NLAB+1; 14437000
IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000
BEGIN 14439000
MOVE(9,INFO[0,J],ACCUM[0]); 14440000
Q~ACCUM[1]; 14441000
FLAG(267); 14442000
ERRORTOG~TRUE; 14443000
END; 14444000
END; 14445000
G~(GT2~TAKE(J+1)).PURPT; 14446000
IF GT1.[2:8] ! STLABID|2+1 THEN 14447000
STACKHEAD[(0&GT2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000
END UNTIL J~J-G{1; 14449000
PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000
[13:37:11],MARK); 14451000
GT1~ L; L ~ FILETHING ; 14451100
WHILE L ! 4095 DO 14451200
BEGIN FILETHING ~ GET(L); 14451300
EMITC(PJ+1,RSA); 14451400
L ~ FILETHING; 14451500
END; 14451600
L ~ GT1; FILETHING ~ 4095 ; 14451700
IF FUNCTOG THEN 14452000
BEGIN 14453000
EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000
EMITC(PJ+2,SED); 14455000
EMITC(1,TRW); 14456000
PUT(Z, PROINFO); 14457000
END; 14458000
EMIT(0); 14459000
STREAMWORDS; 14460000
STREAMTOG~FALSE; 14461000
END; 14462000
LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000
END 14464000
ELSE 14465000
BEGIN 14466000
IF STEPI=FORWARDV 14467000
THEN 14468000
BEGIN 14469000
PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000
PURGE(PINFOO); 14471000
STEPIT 14472000
END 14473000
ELSE 14474000
BEGIN 14475000
PROADO~PROAD; 14476000
RETLISTO ~ RETLIST; RETLIST ~ 4095; %M14476500
SYMFORMATO ~ SYMFORMAT; SYMFORMAT ~ PROINFO.CLASS=SYMSTRPROCID; %A14476600
TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000
% 14478000
COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010
COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020
IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030
MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040
IF ELCLASS = BEGINV THEN 14479000
BEGIN %M14479500
IF STEPI=DECLARATORS THEN IF DECLCHECK THEN %M14480000
BEGIN I~I-1; %M14481000
BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000
; PURGE(PINFOO); 14483000
GO TO STOP END; I ~I-1; ELCLASS~BEGINV END; %M14484000
BEGIN 14485000
JUMPCHKNX; 14486000
RELAD~L ; 14487000
IF NEXTSAVE THEN FLAG(052); 14487010
IF SYMFORMAT THEN SFEXP(TRUE,TRUE,0) ELSE %A14487500
STMT; %M14488000
IF RETLIST ! 4095 THEN HANDLRET(SYMFORM ! 0 AND FAULTOG.[46:1]); %T9214488200
MARKSYMDCR(-SYMFORM); %T9214488300
IF FAULTOG.[46:1] THEN BEGIN EMIT(40); EMITO(COM); END; % %D0114488500
HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000
END; 14490000
STOP: 14491000
RETLIST ~ RETLISTO; %M14491500
SYMFORMAT ~ SYMFORMATO; %A14491600
SUBLEVEL~TSUBLEVEL; 14492000
STACKCTR~STACKCTRO; 14493000
END; 14494000
END; 14495000
PROINFO~LO; 14496000
SYMFORM ~ SYMFORMO; %M14496500
IF JUMPCTR=LEVEL 14497000
THEN 14498000
JUMPCTR~LEVEL-1; 14499000
LEVEL~LEVEL-1; 14500000
MODE~MODE-1; 14501000
MAXSTACK~MAXSTACKO; 14502000
START:END; 14503000
GO TO START; 14504000
CALLSTATEMENT: 14505000
JUMPCHKX; 14506000
IF SPECTOG THEN BEGIN 14507000
FLAG(12);GO TO HF 14508000
END; 14509000
BEGINCTR ~ BEGINCTR-1; 14510000
IF RECORDLINK ! RECORDLINKO THEN BEGIN %A14510500
GOTSTORAGE ~ TRUE; GENRECORD(RECORDLINKO,TRUE); END; %M14510600
IF SYMFORMAT THEN SFEXP(TRUE,TRUE,0); %A14510700
IF ERRORTOG 14511000
THEN COMPOUNDTAIL 14512000
ELSE 14513000
BEGIN 14514000
STMT; 14515000
IF STEPI= DECLARATORS AND DECLCHECK %M14516000
THEN 14517000
BEGIN I~I-1; %M14518000
ELBAT[I].CLASS~SEMICOLON; 14519000
BEGINCTR~BEGINCTR+1; 14520000
GO TO START 14521000
END 14522000
ELSE 14523000
BEGIN I~I-1;COMPOUNDTAIL END %M14524000
END; 14525000
BEGIN 14526000
RELAD~FIRSTX; 14534000
IF STACKCTR>MAXSTACK 14535000
THEN MAXSTACK~STACKCTR; 14536000
SYMLOC ~ SYMLOC + SYMFORM; %M14536400
IF XITLIST! 4095 THEN HANDLXIT; %M14536500
IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000
THEN 14538000
BEGIN IF SOP AND RETLIST!4095 THEN HANDLRET(TRUE); %M14538500
MARKSYMDCR(-SYMLOC); %M14538600
IF RECORDLINKO! RECORDLINK THEN GENRECORD(RECORDLINKO,FALSE); %M14538700
IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000
THEN 14540000
BEGIN 14541000
EMITV(BLOCKCTR); 14542000
EMITL(1); 14543000
EMITO(SUB); 14544000
EMITSTORE(BLOCKCTR,STD); 14545000
GOTSTORAGE~TRUE 14546000
END 14547000
ELSE 14548000
BEGIN 14549000
EMITL(10); 14550000
EMITO(COM) 14551000
END; 14552000
END ELSE BEGIN IF SOP AND RETLIST!4095 THEN HANDLRET(SYMLOC!0); %M14552500
MARKSYMDCR(-SYMLOC) END; %M14552600
FUNCTOG~FUNCTOGO; 14553000
IF SOP 14554000
THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000
ELSE 14556000
BEGIN 14557000
IF LEVEL = 1 THEN EMITO(XIT) 14557500
ELSE BEGIN 14557600
EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000
EMITO(BFW); 14558500
END; 14558600
CONSTANTCLEAN; 14559000
IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000
OR FAULTOG.[46:1] THEN % %D0114561000
BEGIN 14562000
ADJUST; RELAD~L; 14563000
IF GOTSTORAGE OR FAULTOG.[46:1] THEN BEGIN EMITV(BLOCKCTR);EMIT(4); %D0114564000
EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000
END; 14566000
IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000
=0; 14568000
PURGE(NINFOO); 14569000
IF ERRORCOUNT=0 THEN %M14569010
IF LEVEL = 1 THEN %A14569020
EMITNEWX; % DO THE RUN TIME INITIALIZATION %A14569050
IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100
BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200
BUMPL; 14570000
EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000
CONSTANTCLEAN; IF LEVEL+ERRORCOUNT=1 THEN EMITNONX %M14572000
END ELSE PURGE(NINFOO); 14573000
IF RELAD =4095 THEN RELAD~0; 14574000
NEXTTEXT ~ NTEXTO; 14574500
G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000
END; 14576000
ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100
SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000
14578000
14579000
14580000
14581000
14582000
14583000
14584000
14585000
14586000
14587000
14588000
14589000
14590000
14591000
14592000
ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000
MOVECODE(TENIL,ENIL); 14594000
MOVECODE(TEDOC,EDOC);L~LOLD; 14595000
DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000
IF NOT SOP AND LEVEL ! 1 14597000
THEN 14598000
BEGIN 14599000
ADJUST; 14600000
G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000
IF ELCLASS = FACTOP THEN 14601100
BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200
14601300
14601400
14601500
14601600
14601610
STEPIT; 14601700
END; 14601800
END; 14602000
IF JUMPCTR=LEVEL THEN JUMPCTR~LEVEL-1; 14603000
LEVEL~LEVEL-1; 14604000
FUNCTOG~FUNCTOGO; 14605000
AJUMP~AJUMPO; 14606000
PRTI~PRTIO; 14607000
FIRSTX~FIRSTXO; 14608000
SOPG ~ SOPGO; XITLIST ~ XITLISTO; SYMLOC~ SYMLOCO; %M14608100
RECORDLINKO ~ RECORDLINK;% %A14608200
SAVEL~SAVELO; 14609000
STACKCTR~STACKCTRO; 14610000
SAVEPRTOG := SAVEPRTOGO; 14610100
NCII~NCIIO; FAULTOG~FAULTOGO AND(FALSE&FAULTLEVEL<LEVEL[46:47:1]); 14611000
END; 14612000
END BLOCK; 14613000
COMMENT THIS SECTION CONTAINS THE VARIABLE ROUTINE AND ITS SIDEKICKS; 15000000
PROCEDURE CLSMPMN(ELBATWORD,TYPEDPROC) ; 15001000
VALUE ELBATWORD,TYPEDPROC ; 15002000
REAL ELBATWORD ; 15003000
BOOLEAN TYPEDPROC ; 15003010
BEGIN COMMENT CALL SIMPLE MONITOR IS USED TO CALL PRINTI FOR 15004000
SIMPLE VARIABLES. SEE THE MERRIMAC ROUTINE FOR A 15005000
DESCRIPTION OF PRINTI; 15006000
EMITPAIR(JUNK,SND);EMITO(MKS); EMITV(JUNK); 15007000
EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 15008000
POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 15009000
EMITPAIR(GNAT(CHARI),LOD) ; 15010000
IF TYPEDPROC THEN PASSMONFILE(TAKE(GIT(ELBATWORD)).[27:11]) ELSE 15010010
PASSMONFILE(TAKE(GIT(ELBATWORD)).SVARMONFILE) ; 15010020
EMITL(1) ; 15011000
EMITV(GNAT(PRINTI)); 15012000
END CLSMPMN; 15013000
INTEGER PROCEDURE PASSTYPE(ELBATWORD); 15014000
VALUE ELBATWORD ; 15015000
REAL ELBATWORD ; 15016000
COMMENT PASSTYPE IS USED TO PASS THE TYPE OF VARIABLE BEING 15017000
MONITORED TO PRINTI; 15018000
PASSTYPE ~ (ELBATWORD.CLASS-STRINGPROCID).[45:3]-4; %M15019000
PROCEDURE PASSALPHA(ELBATWORD); 15020000
VALUE ELBATWORD ; 15021000
REAL ELBATWORD ; 15022000
BEGIN COMMENT PASSALPHA GENERATES CODE THAT PASSES THE ID 15023000
PARAMETER TO PRINTI; 15024000
DEFINE SIZEALPHA = RR9#; COMMENT SIZEALPHA CONTAINS THE 15025000
LENGTH OF THE ALPHA FOR THE 15026000
VARIABLE DESCRIBED BY ELBATWORD; 15027000
DEFINE INDEX = RR10#; COMMENT INDEX CONTAINS THE INDEX 15028000
INTO INFO FOR ID. INFO[INDEX] = ID; 15029000
DEFINE LTEMP = RR11#; COMMENT LTEMP IS A TEMP FOR L; 15030000
EMITV(IF BOOLEAN(L.[46:1]) 15031000
THEN CPLUS2 15032000
ELSE CPLUS1);LTEMP~BUMPL; EMITWORD(GETALPHA( 15033000
INFO[(INDEX~ELBATWORD.LINK+1).LINKR,INDEX.LINKC], 15034000
IF SIZEALPHA~TAKE(INDEX).ALPHASIZE > 7 15035000
THEN 7 15036000
ELSE SIZEALPHA)); EMITB(BFW,LTEMP,L); 15037000
END PASSALPHA; 15038000
COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 15039000
OF SIMPLE VARIABLES: 15040000
1. V ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15041000
2. V ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15042000
3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15043000
4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME. 15044000
5. V.[S:L] ,ALL V. 15045000
6. V ,ALL V. 15046000
CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 15047000
1. VN,EXP,M*,XCH,~. 15048000
2. EXP,M*,VL,~. 15049000
3. VN,DUP,COC,EXP,T,M*,XCH,~. 15050000
4. VV,EXP,T,M*,VL,~. 15051000
5. ZEROL,VV,T . 15052000
6. VV . 15053000
WHERE VN = DESC V 15054000
EXP= ARITH. OR BOOLEAN EXPRESSION,AS REQUIRED. 15055000
M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000
VL = LITC V 15057000
VV = OPDC V 15058000
~ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000
T = BIT TRANSFER CODE(DIA,DIB,TRB). 15060000
ZEROL = LITC 0 15061000
DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000
OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 15063000
THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 15064000
GLOBAL FASHION. 15065000
THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 15066000
WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 15067000
SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 15068000
; 15069000
PROCEDURE VARIABLE(P1); REAL P1; 15070000
BEGIN 15071000
REAL TALL, COMMENT ELBAT WORD FOR VARIABLE; 15072000
T1 , COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 15073000
% %M15073500
T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000
J ; COMMENT SUBSCRIPT COUNTER ; 15075000
REAL X, Z; 15075500
LABEL EXIT; 15076000
BOOLEAN DPO; %M15076250
DPO ~ DPTOG; DPTOG ~ FALSE; %M15076500
TALL~ELBAT[I] ; 15077000
IF ELCLASS { INTPROCID THEN 15078000
BEGIN 15079000
IF TALL.LINK !PROINFO.LINK THEN 15080000
BEGIN ERR(211); GO TO EXIT END; 15081000
COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000
TALL ~ TALL & (ELCLASS+8) [2:41:7] & 514 [16:37:11]; %M15083000
END 15084000
ELSE CHECKER(TALL); 15085000
IF TALL.CLASS { INTID THEN 15086000
BEGIN 15087000
LABEL L1, EXIT ; 15088000
DEFINE FORMALNAME=[9:2]=2 #; 15089000
J ~ ELCLASS ; 15089010
IF STEPI= ASSIGNOP THEN 15090000
BEGIN STACKCT ~ 1; %A 15091000
L1: %W5215092000
XMARK; 15092010
STEPIT; %W5215092015
IF TALL.FORMALNAME THEN %W5215092020
BEGIN 15093000
EMITN(TALL.ADDRESS); 15094000
IF T1!0 OR ELCLASS=FACTOP THEN BEGIN EMITO(DUP); %W5215095000
EMITO(COC); IF T1!0 AND ELCLASS=FACTOP THEN %W5215095500
EMITO(DUP) END; %W5215095600
END 15096000
ELSE IF T1!0 OR ELCLASS=FACTOP THEN BEGIN %W5215097000
EMITV(TALL.ADDRESS);IF T1!0 AND ELCLASS=FACTOP %W5215097500
THEN EMITO(DUP) END; %W5215097600
STACKCT ~ REAL(T1!0); %W5215098000
IF ELCLASS=FACTOP THEN ELBAT[I].CLASS ~ %W5215098200
ELCLASS ~ CROSSHATCH; %W5215098400
IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000
EMITD(48-T2 ,T1 ,T2); 15100000
IF TALL<0 THEN CLSMPMN(TALL,J}BOOPROCID AND J{INTPROCID) ; 15101000
STACKCT ~ 0; %A 15101500
GT1 ~ IF TALL.CLASS =INTID THEN IF P1= FS 15102000
THEN ISD ELSE ISN ELSE 15103000
IF P1 = FS THEN STD ELSE SND ; 15104000
IF TALL.FORMALNAME THEN 15105000
BEGIN EMITO(XCH); EMITO(GT1) END 15106000
ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000
END 15108000
ELSE 15109000
BEGIN 15110000
IF ELCLASS= PERIOD THEN 15111000
BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000
IF STEPI=ASSIGNOP THEN 15113000
IF P1! FS THEN 15114000
BEGIN ERR(201);GO TO EXIT END 15115000
ELSE GO TO L1 15116000
%A 15117000
END ; 15118000
IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000
COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000
BY A LEFT ARROW OR PERIOD *;15121000
COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000
LEFT-MOST OF A LEFT PART LIST *;15123000
EMITI(TALL,T1,T2); %A 15124000
%A 15125000
END ; 15126000
EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000
ELSE 15128000
COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 15129000
VARIABLES: 15130000
1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 15131000
2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 15132000
3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 15133000
4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 15134000
5. V[R] ~ ,ASSIGNMENT TO ARRAY ELEMENT. 15135000
6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000
R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 15137000
IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 15138000
IS EMITTED FOR THE ABOVE CASES: 15139000
1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 15140000
DIMENSION. THE CODE EMITTED IS: 15141000
VL,LOD . 15142000
EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 15143000
2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.15144000
EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE15145000
OF CODE: 15146000
AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000
,LOD. 15148000
FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 15149000
PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 15150000
THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000
PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000
[* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000
NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 15154000
EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000
EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A15156000
. THE SPECIFIC ROW DEPENDS UPON THE 15157000
VALUES OF THE K-1 SUBSCRIPTS. 15158000
FOR THE REMAINING CASES, 15159000
SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 15160000
HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000
ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.15162000
K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 15163000
ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 15164000
SUBSCRIPTS,IF K>1. 15165000
AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 15166000
AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 15167000
EMITTED. 15168000
3. ADD THE SEQUENCE: 15169000
IF FIRST SUBSCRIPT THEN VV ELSE COC. 15170000
EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000
4. ADD THE SEQUENCE: 15172000
IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL, 15173000
XCH,T. 15174000
5. ADD THE SEQUENCE: 15175000
IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000
XCH,~. 15177000
6. ADD THE SEQUENCE: 15178000
IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD, 15179000
EXP,T, XCH,~. 15180000
EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 15181000
SIMPLE VARIABLE BLOCK. ; 15182000
BEGIN 15183000
LABEL EXIT,LAST,NEXT ; 15184000
INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100
DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF15185000
DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000
VARIABLE; 15187000
DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000
INDEX OF THE LAST ENTRY IN INFO 15189000
FOR A MONITORED SUBSCRIPTED 15190000
VARIABLE; 15191000
DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX15192000
INTO INFO TO PICK OUT SPECIAL MONITOR 15193000
INFORMATION; 15194000
DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT15195000
POSITION OF THE SPECIAL MONITOR 15196000
INFORMATION FOR SUBSCRIPTED 15197000
VARIABLES; 15198000
DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000
EMIT AN OPDC OR LITC FOR PASSING 15200000
THE SUBSCRIPTS FOR MONITORED 15201000
SUBSCRIPTED VARIABLES.1 MEANS 15202000
LITC, 0 MEANS OPDC; 15203000
DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000
BOUND WORD FROM INFO FOR MONITORED 15205000
SUBSCRIPTED VARIABLES; 15206000
DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000
THE ADDRESS THAT WILL BE 15208000
EMITTED IN AN OPDC OR LITC 15209000
DEPENDING ON OPBIT; 15210000
BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT15211000
IS SET TRUE IF THE VARIABLE IN 15212000
TALL IS SPECIAL MONITORED. 15213000
; 15214000
PROCEDURE M4(TALL,J); 15215000
VALUE TALL,J ; 15216000
REAL TALL,J ; 15217000
BEGIN STACKCT ~ 1; %A 15217500
IF J = 1 15218000
THEN BEGIN COMMENT FIRST TIME AROUND; 15219000
IF TALL < 0 15220000
THEN BEGIN COMMENT TALL IS MONITORED; 15221000
EMITV(JUNK); EMITO(XCH); 15222000
END; 15223000
EMITN(TALL.ADDRESS ) 15224000
END 15225000
ELSE BEGIN COMMENT NOT THE FIRST TIME AROUND; 15226000
EMITO(CDC); 15227000
IF TALL < 0 15228000
THEN BEGIN COMMENT CALL SUBSCRIPT; 15229000
EMITV(JUNK); EMITO(XCH); 15230000
END; 15231000
END; END; %A 15232000
IF STEPI ! LFTBRKET THEN BEGIN ERR(207);GO TO EXIT END; 15233000
THENUMBEROFDECLAREDDIMENSIONS ~ TAKE(GIT(TALL)).[40:8]; 15233100
J ~ 0; 15234000
STACKCT ~ 0; %A 15234500
COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000
IF P1 > FP THEN TALL ~ ABS(TALL) ELSE 15236000
IF TALL < 0 THEN 15237000
COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000
BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000
VARIABLE; 15240000
EMITO(MKS); 15241000
IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000
THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000
TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000
.NODIMPART)+INC; 15245000
DO IF BOOLEAN(LWRBND~TAKE(INC~INC+1)).15246000
OPBIT 15247000
THEN EMITL(LWRBND.SPMONADR) 15248000
ELSE EMITV(LWRBND.SPMONADR) 15249000
UNTIL INC } TESTVARB 15250000
END; 15251000
END; 15252000
NEXT: IF STEPI = FACTOP THEN 15253000
BEGIN 15254000
STLB ~ 1; 15254400
WHILE TABLE(I+1) = COMMA DO 15254500
BEGIN STEPIT; 15254600
IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700
BEGIN ERR(204); GO TO EXIT END; 15254800
END; 15254900
IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000
BEGIN ERR(203);GO EXIT END; 15256000
COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000
ROW DESIGNATER DOES NOT MATCH THE ARRAY * 15258000
DECLARATION. *;15259000
IF STEPI ! RTBRKET THEN 15260000
BEGIN ERR(204);GO EXIT END; 15261000
COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000
IF P1 ! FA THEN 15262500
IF STLB > 1 THEN FLAG(212) ELSE 15262600
IF P1!FI AND P1!FL THEN 15263000
BEGIN ERR(205); GO TO EXIT; END; 15263100
COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000
STATEMENT OR ACTUAL PARAMETER LIST. *;15265000
IF J=0 THEN 15266000
EMITPAIR(TALL.ADDRESS,LOD); 15267000
COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000
IF TALL < 0 THEN 15269000
BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000
EMITL(5); EMITN(GNAT(PRINTI)); 15271000
END; 15272000
IF P1 = FA THEN 15272900
FOR X ~ 1 STEP 1 UNTIL STLB DO 15273000
BEGIN IF (Z~TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100
THEN EMITV(Z) ELSE EMIT(Z); 15273200
IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300
END; 15273400
STEPIT; 15274000
GO TO EXIT; 15275000
END OF ROW DESIGNATOR PORTION ; 15276000
AEXP; 15277000
COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000
IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000
J ~ J + 1; 15280000
IF(GT1 ~ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000
BEGIN 15282000
IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000
ELSE EMITV(GT1.[35:11]) ; 15284000
EMIT(GT1.[23:12]); 15285000
END OF LOWER BOUND ADJUSTMENT ; 15286000
IF ELCLASS = COMMA THEN 15287000
BEGIN 15288000
COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000
M4 (TALL,J); 15290000
EMITO(LOD) ; 15291000
IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100
BEGIN ERR(208); GO TO EXIT END; 15291200
COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300
DECLARATION *;15291400
GO TO NEXT; 15292000
END OF SUBSCRIPT COMMA HANDLER ; 15293000
IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END; 15294000
COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000
IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000
BEGIN ERR(208); GO TO EXIT END; 15297000
15298000
15299000
STACKCT ~ 0; %A 15299500
IF STEPI = ASSIGNOP THEN 15300000
BEGIN 15301000
COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000
LAST: M4(TALL,J); 15303000
IF T1= 0 THEN 15304000
BEGIN IF P1= FR THEN GO TO EXIT END 15305000
ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; %WF 15306000
IF ELCLASS=FACTOP THEN BEGIN %W5215306200
ELBAT[I].CLASS~ELCLASS~CROSSHATCH; %W5215306400
EMITO(DUP); IF T1=0 THEN EMITO(LOD) END; %W5215306600
IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000
EMITD(48-T2,T1,T2) ; 15308000
EMITO(XCH); 15309000
COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000
IF TALL < 0 15311000
THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000
IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000
VALUE FROM JUNK; 15314000
EMITO( 15315000
IF TALL.CLASS = INTARRAYID 15316000
THEN ISN 15317000
ELSE SND); 15318000
IF P1 ! FS 15319000
THEN EMITPAIR(JUNK,SND); 15320000
EMITL(J); EMITL(PASSTYPE(TALL)); 15321000
EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000
PASSALPHA(TALL); EMITPAIR(GNAT( 15323000
CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000
ARRAYMONFILE); 15325000
EMITL(IF SPCLMON 15326000
THEN 3 15327000
ELSE 2); EMITV(GNAT(PRINTI)); 15328000
IF P1 ! FS 15329000
THEN EMITV(JUNK); 15330000
P1~0; GO TO EXIT; 15331000
END; 15332000
EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000
IF P1 = FS THEN ISD ELSE ISN ELSE 15334000
IF P1=FS THEN STD ELSE SND); 15335000
P1~0 ; 15336000
GO TO EXIT ; 15337000
END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000
IF ELCLASS=PERIOD THEN 15339000
BEGIN 15340000
IF DOTSYNTAX(T1,T2) THEN GO TO EXIT; 15341000
IF STEPI = ASSIGNOP THEN IF P1=FS THEN GO TO LAST 15342000
ELSE BEGIN ERR(209); GO EXIT END; 15343000
IF J=1 THEN EMITV(TALL.ADDRESS)ELSE EMITO(COC); 15344000
END 15345000
ELSE 15346000
COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000
BEGIN COMMENT MONITOR FUNCTION M10; 15348000
SPCLMON~P1 = FP OR ELCLASS } AMPERSAND; 15349000
IF J = 1 15350000
THEN IF SPCLMON 15351000
THEN EMITV(TALL.ADDRESS) 15352000
ELSE EMITN(TALL.ADDRESS) 15353000
ELSE EMITO(IF SPCLMON 15354000
THEN COC 15355000
ELSE CDC); 15356000
IF TALL < 0 15357000
THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000
EMITL(5); 15359000
IF SPCLMON 15360000
THEN EMITV(GNAT(PRINTI)) 15361000
ELSE EMITN(GNAT(PRINTI)) 15362000
END; 15363000
IF P1 =FS THEN ERR(210); 15364000
IF P1 = FI THEN P1~0; 15364500
GO TO EXIT; 15365000
END; 15366000
IF P1=FS THEN BEGIN ERR(210); GO TO EXIT END ; 15367000
COMMENT 210 VARIABLE-MISSING LEFT ARROW OR PERIOD. *;15368000
IF T1!0 THEN BEGIN EMITI(0,T1,T2); 15369000
IF P1!FI THEN P1~0; 15369100
END; 15369200
IF P1=FI THEN 15369300
IF ELCLASS!COMMA AND ELCLASS!RTPAREN 15369400
THEN SIMPARITH; 15369500
IF P1=FI THEN P1~0;% 15369600
%A 15370000
COMMENT ***** MONITOR FUNCTION M9 ; 15371000
IF TALL < 0 15372000
THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000
EMITL(5); EMITV(GNAT(PRINTI)); 15374000
END ; 15375000
EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000
EXIT: DPTOG ~ DPO END OF VARIABLE; %M15377000
COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000
PROCEDURE STREAMSTMT ; 16001000
BEGIN 16002000
DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#, 16003000
LOCFLD=36:36:12#,LGTFLD=24:24:12#; 16004000
DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000
DEFINE 16006000
JFW = 39#, COMMENT 7.5.5.1 JUMP FORWARD UNCONDITIONAL ; 16007000
RCA = 40#, COMMENT 7.5.7.6 RECALL CONTROL ADDRESS ; 16008000
JRV = 47#, COMMENT 7.5.5.2 JUMP REVERSE UNCONDITIONAL ; 16009000
CRF = 35#, COMMENT 7.5.10.6 CALL REPEAT FIELD ; 16010000
BNS = 42#, COMMENT 7.5.5.5 BEGIN LOOP ; 16011000
NOP = 1#, COMMENT ; 16012000
ENS = 41#, COMMENT 7.5.5.6 END LOOP ; 16013000
TAN = 30#, COMMENT 7.5.3.7 TEST FOR ALPHAMERIC ; 16014000
BIT = 31#, COMMENT 7.5.3.8 TEST BIT ; 16015000
JFC = 37#, COMMENT 7.5.5.3 JUMP FORWARD CONDITIONAL ; 16016000
SED = 06#, COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 16017000
RSA = 43#, COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 16018000
TRP = 60#, COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 16019000
BSS = 3#, COMMENT 7.5.6.6 SKIP SOURCE BIT ; 16020000
BSD = 2#, COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 16021000
SEC = 34#, COMMENT 7.5.10.1 SET COUNT ; 16022000
JNS = 38#; COMMENT 7.5.5.7 JUMP OUT LOOP ; 16023000
PROCEDURE DECLARELABEL; %W2516023100
COMMENT DO LABEL DECLARATION UPON FIRST APPEARANCE OF LABEL; %W2516023200
BEGIN %W2516023300
KLASSF ~ STLABID; %W2516023400
VONF ~ FORMALF ~ FALSE; %W2516023500
ADDRSF ~ 0; %W2516023600
MAKEUPACCUM; E; PUTNBUMP(0); %W2516023700
ELBAT[I] ~ ACCUM[0]&LASTINFO[35:35:13]; %W2516023800
END DECLARELABEL; %W2516023900
COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 16024000
OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 16025000
A VALUE = 0 AND THE JUMP } 64 SYLLABLES A JFW 1 AND 16026000
A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH 16027000
MUST ALSO BE MANUFACTURED) IS EMITTED. ; 16028000
PROCEDURE FIXC(S); VALUE S; REAL S; 16029000
BEGIN 16030000
REAL SAVL,D,F; 16031000
SAVL~L; 16032000
F~GET( S); 16033000
IF D ~ L -( L~S) -1{63 THEN 16034000
BEGIN 16035000
IF F=BNS THEN IF SLABTOG THEN %W1416036000
BEGIN 16037000
S~GET(L~L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D~D-2; 16038000
END; 16039000
EMITC(D,F); L ~ SAVL 16040000
END 16041000
ELSE BEGIN 16042000
IF F!JFW THEN BEGIN 16043000
EMITC(1,F); 16044000
EMITC(1,JFW) END ; 16045000
EMITC(PJ~PJ+1,RCA); 16046000
L ~ SAVL; 16047000
IF SLABTOG THEN BEGIN %W1416048000
ADJUST END %69 %W1416048001
ELSE BEGIN FLAG(275); ERRORTOG~TRUE END; %W1416048500
LPRT ~ PROGDESCBLDR(2,L,0); 16049000
COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000
PUTNBUMP(0&(STLABID|2+1) 16051000
[2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000
PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000
PUTNBUMP(0); 16054000
LASTINFO ~ NEXTINFO-3; 16055000
END; 16056000
END FIXC ; 16057000
COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 16058000
THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63 16059000
SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 16060000
STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 16061000
RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000
INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000
POINTING TO OUR LABEL IN QUESTION. ; 16064000
PROCEDURE EMITJUMP( E); VALUE E; REAL E; 16065000
BEGIN 16066000
REAL T,D; 16067000
REAL ADDR; 16068000
IF ABS( 16069000
D~(T~TAKE(GIT(E)).LOC)-L-1)}64 THEN 16070000
BEGIN 16071000
IF ADDR~TAKE(E).ADDRESS=0 THEN 16072000
BEGIN 16073000
PUT(TAKE(E)&(ADDR~PJ~PJ+1)[16:37:11],E); 16074000
LPRT ~ PROGDESCBLDR(2,T,0); 16075000
END ; 16076000
EMITC(ADDR,RCA); 16077000
IF SLABTOG THEN %W1416077500
ELSE BEGIN FLAG(275); ERRORTOG~TRUE END; %W1416077700
END 16078000
ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW); 16079000
END EMIT JUMP; 16080000
COMMENT WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE16081000
ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 16082000
TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000
LINK IS = 4096. ; 16084000
PROCEDURE JUMPCHAIN( E); VALUE E;REAL E; 16085000
BEGIN 16086000
REAL SAVL ,LINK; 16087000
SAVL ~ L; 16088000
L ~ TAKE(GIT(E)).LASTGT ; 16089000
WHILE L! 4095 DO 16090000
BEGIN 16091000
LINK ~ GET(L); 16092000
EMITJUMP( E); 16093000
L ~ LINK 16094000
END; 16095000
L~SAVL; 16096000
END JUMPCHAIN ; 16097000
COMMENT NESTS COMPILES THE NEST STATEMENT. 16098000
A VARIABLE NEST INDEX CAUSES THE CODE, 16099000
CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000
AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 16101000
THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH {63,OTHERWISE16102000
IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000
RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000
MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000
JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000
NEST LEVEL INCREASED BY ONE. 16107000
WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000
THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000
OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000
ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000
JUMPS. 16112000
FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000
AND JOINFO RESTORED TO THEIR ORIGINAL VALUES. ; 16114000
PROCEDURE NESTS; 16115000
BEGIN 16116000
LABEL EXIT; 16117000
REAL JOINT,BNSFIX; 16118000
IF ELCLASS!LITNO THEN 16119000
BEGIN 16120000
EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000
EMIT(BNS); %W1416122000
IF SLABTOG THEN BEGIN EMIT(NOP); EMIT(NOP) END; %W1416122500
END 16123000
ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000
IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000
NESTLEVEL~NESTLEVEL + 1; 16126000
JOINT ~ JOINFO; 16127000
JOINFO ~ 0; 16128000
DO BEGIN 16129000
STEPIT; ERRORTOG ~ TRUE; STREAMSTMT 16130000
END UNTIL ELCLASS ! SEMICOLON ; 16131000
IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END; 16132000
EMIT ( ENS); 16133000
IF JOINFO ! 0 THEN 16134000
BEGIN 16135000
COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 16136000
IF SLABTOG THEN ADJUST; %W1416137000
PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000
JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000
END; 16140000
IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000
NESTLEVEL ~ NESTLEVEL-1; 16142000
JOINFO ~ JOINT ; 16143000
EXIT: END NESTS ; 16144000
COMMENT LABELS HANDLES STREAM LABELS. 16145000
ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000
WORD (IN THE PROGRAMSTREAM). 16147000
IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000
THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000
[1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000
HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000
MATCHES THE LEVEL OF THE LABEL. 16152000
MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000
FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000
AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 16155000
PROCEDURE LABELS; 16156000
BEGIN 16157000
REAL GT1; %W1416157500
IF SLABTOG THEN ADJUST; %W1416158000
GT1 ~ ELBAT[I]; 16159000
IF STEPI ! COLON THEN ERR(258) 16160000
ELSE 16161000
BEGIN 16162000
IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259); 16163000
IF GT1>0 THEN 16164000
BEGIN 16165000
PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000
PUT(-L,GT2) 16167000
END 16168000
ELSE 16169000
BEGIN 16170000
IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000
PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000
JUMPCHAIN(GT1); 16173000
END; 16174000
END 16175000
; STEPIT; 16176000
END LABELS ; 16177000
COMMENT IFS COMPILES IF STATEMENTS. 16178000
FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000
CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000
THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000
IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR. OTHERWISE 16182000
THE CODE IS EMITTED STRAIGHTAWAY. 16183000
A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000
"THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000
SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000
TO BE GENERATED. 16187000
THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000
IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000
IF THEN GO TO L1 ELSE GO TO L2 ; 16190000
PROCEDURE IFS; BEGIN 16191000
DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000
LABEL IFSB,IFTOG,IFSC,EXIT; 16193000
SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000
REAL ADDR,FIX1,FIX2 ; 16195000
ADDR~1 ; 16196000
GO TO IFSW[STEPI -SBV+1] ; 16197000
IF ELCLASS=LOCLID THEN 16198000
BEGIN 16199000
EMITC(ELBAT[I].ADDRESS,CRF); 16200000
ADDR~0; 16201000
END 16202000
ELSE 16203000
IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000
ELSE BEGIN ERR(250); GO TO EXIT END; 16205000
IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000
IFSC: IF STEPI ! RELOP THEN BEGIN ERR(264);GO TO EXIT END; 16207000
IF STEPI = DCV THEN EMITC( ADDR,ELBAT[I-1].COMPARECODE) 16208000
ELSE 16209000
IF ELCLASS = STRNGCON THEN 16210000
BEGIN 16211000
IF ACCUM[1].[12:6] ! 1 OR ELBAT[I-3].CLASS ! IFV 16211100
THEN BEGIN ERR(271); GO TO EXIT END 16211200
ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300
END 16211400
ELSE 16212000
IF ACCUM[1] ! "5ALPHA" THEN 16213000
BEGIN ERR(265);GO TO EXIT END 16213100
ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000
ELSE BEGIN FLAG(270); ERRORTOG ~ TRUE END; 16214100
GO TO IFTOG ; 16215000
IFSB: EMITC(1,BIT); 16216000
IFTOG: IF STEPI ! THENV THEN BEGIN ERR(266); GO TO EXIT END; 16217000
FIX1 ~ L; 16218000
EMIT(JFC); 16219000
STEPIT; 16220000
IF ELCLASS = BEGINV OR 16221000
ELCLASS = IFV OR 16222000
ELCLASS = LITNO OR 16223000
ELCLASS = STLABID OR 16224000
ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000
IF SLABTOG THEN %W1416225500
BEGIN 16226000
EMIT (NOP);EMIT (NOP) 16227000
END; 16228000
IF ELCLASS= ELSEV THEN ELSE 16228500
STREAMSTMT; 16229000
IF ELCLASS= ELSEV THEN 16230000
BEGIN 16231000
FIX2 ~ L; EMIT(JFW); 16232000
FIXC(FIX1); 16233000
STEPIT; 16234000
STREAMSTMT; 16235000
FIXC(FIX2); 16236000
END 16237000
ELSE FIXC(FIX1); 16238000
EXIT:END IFS ; 16239000
COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000
STATEMENTS. 16241000
IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000
AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 16243000
ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000
GO TOS IN THE CASE OF FORWARD JUMPS. 16245000
FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000
AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000
BE JUMPED OUT. OTHERWISE,NEST LEVEL IS DEFINED. ; 16248000
PROCEDURE GOTOS; 16249000
BEGIN 16250000
LABEL EXIT; 16251000
IF STEPI !TOV THEN I~I-1 ; 16252000
IF STEPI ! STLABID THEN %77 %W2516253000
IF (IF ELCLASS{IDMAX THEN ELCLASS!LOCLID ELSE %77 %W2516253025
(ELCLASS=SUPERLISTID OR ELCLASS=FAULTID) ) THEN %77 %W2516253050
DECLARELABEL ELSE BEGIN ERR(260); GO TO EXIT END; %W2516253100
IF(GT2~TAKE(GIT(GT1~ELBAT[I]))).MON=1 16254000
OR GT2.LOC!0 THEN EMITJUMP(GT1) 16255000
ELSE 16256000
BEGIN PUT(0&L[24:36:12],GIT(GT1)); 16257000
IF GT1>0 THEN 16258000
BEGIN 16259000
PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEVEL)[11:43:5]),GT1);16260000
EMITN(1023); 16261000
END 16262000
ELSE 16263000
BEGIN 16264000
IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257); 16265000
EMIT(GT2.LASTGT); 16266000
END; 16267000
END; 16268000
JUMPLEVEL~0 ; 16269000
EXIT: END GOTOS ; 16270000
COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000
THE CODE GENERATED IS : 16272000
SED FILE 16273000
RSA 0. 16274000
AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000
INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000
BY THE DESTINATION ADDRESS. 16277000
THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000
THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 16279000
MUST BE PASSED FOR THIS FORMAL PARAMETER; 16280000
PROCEDURE RELEASES; 16281000
IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000
(GT1~ELBAT[I-1]).FORMAL=0 16283000
THEN ERR(256) ELSE 16284000
BEGIN 16285000
EMITC( GT1.ADDRESS,SED); 16286000
EMIT(FILETHING); FILETHING~L-1; 16287000
INFO[GT1.LINKR,GT1.LINKC].MON ~ 1; 16288000
END RELEASES; 16289000
COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 16290000
OR LOCALIDS . 16291000
THREE CASES PRESENT THEMSELVES, 16292000
LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 16293000
CASE I LOCLID ~ X 16294000
CASE II X ~ X ... 16295000
CASE III X ~ EITHER LOC,LOCLID,SC OR DC. 16296000
THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 16297000
CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS16298000
THE CODE TO BE EMITTED. 16299000
EACH ELEMENT OF MACRO HAS 1-3 SYLLABLES ORDERED FROM 16300000
RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000
MAY REQUIRE AT MOST ONE REPEAT PART. 16302000
IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000
PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE" IS 16304000
ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000
ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000
USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000
THE PROPER ADDRESS AND OPERATOR . 16308000
NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000
ERROR. ; 16310000
PROCEDURE INDEXS; 16311000
BEGIN 16312000
LABEL EXIT,GENERATE,L,L1; 16313000
INTEGER TCLASS,INDEX,ADDR,J; 16314000
TCLASS ~ ELCLASS ; 16315000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000
IF TCLASS = LOCLID THEN 16317000
BEGIN 16318000
IF SIV>STEPI OR ELCLASS>TALLYV THEN GO TO L; 16319000
INDEX ~ 32 + ELCLASS-SIV; 16320000
ADDR ~ ELBAT[I-2].ADDRESS; 16321000
GO TO GENERATE; 16322000
END; 16323000
IF TCLASS = STEPI THEN 16324000
BEGIN 16325000
IF STEPI!ADDOP THEN BEGIN ERR(252); GO EXIT END ELSE 16326000
IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100
BEGIN ERR(253); GO EXIT END; 16327000
INDEX ~ TCLASS-SIV 16328000
+REAL(ELBAT[I-1].ADDRESS=SUB) | 4 16329000
+ REAL(ELCLASS =LOCLID) | 8; 16330000
END 16331000
ELSE 16332000
BEGIN 16333000
INDEX ~ TCLASS -SIV 16334000
+ ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000
IF ELCLASS = LOCV THEN 20 ELSE 16336000
IF ELCLASS = SCV THEN 24 ELSE 16337000
IF ELCLASS= DCV THEN 28 ELSE 25); 16338000
IF ELCLASS = LOCV THEN 16339000
IF STEPI ! LOCLID THEN GO TO L; 16340000
IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000
BEGIN EMITC(ELBAT[I].ADDRESS,SEC);GO TO EXIT END; 16342000
END ; 16343000
ADDR ~ ELBAT[I].ADDRESS; 16344000
GENERATE: 16345000
IF MACRO[INDEX]= 0 THEN 16346000
L: BEGIN ERR(250);GO TO EXIT END; 16347000
J ~ 8; TCLASS ~0 ; 16348000
L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 ); 16349000
IF TCLASS!0 THEN 16350000
BEGIN 16351000
EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000
GO TO L1 16353000
END; 16354000
EXIT:END INDEXS ; 16355000
COMMENT DSS COMPILES DESTINATION STREAM STATEMENTS. 16356000
DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000
STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000
NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000
ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000
THE OPCODE FIELD ; 16361000
PROCEDURE DSS; 16362000
BEGIN 16363000
INTEGER ADDR,J,K,L,T; 16364000
LABEL EXIT,L1; 16365000
DEFINE OPCODE=[27:6]#; 16366000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000
IF STEPI = LOCLID THEN 16368000
BEGIN 16369000
EMITC(ELBAT[I].ADDRESS,CRF); 16370000
ADDR~ 0; 16371000
IF STEPI = LITV THEN GO TO L1 16372000
END 16373000
ELSE IF ELCLASS= LITNO THEN 16374000
BEGIN 16375000
ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000
END 16377000
ELSE ADDR ~ 1 ; 16378000
IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000
EMITC(ADDR,ELBAT[I].OPCODE) %A 16379500
ELSE 16380000
IF ELCLASS = LITV THEN 16381000
BEGIN 16382000
EMITC(ADDR,TRP); 16383000
IF STEPI ! STRNGCON THEN BEGIN ERR(255);GO TO EXIT END; 16384000
IF ADDR MOD 2 ! 0 THEN 16385000
BEGIN 16386000
EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000
END ; 16388000
FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000
BEGIN 16390000
FOR L ~6,7 DO 16391000
MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000
ELSE J),T,L ); 16393000
EMIT(T); 16394000
END END 16395000
ELSE 16396000
L1: ERR(250); 16397000
EXIT:END DSS ; 16398000
COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000
IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000
A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000
OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000
PROCEDURE SKIPS ; 16403000
BEGIN 16404000
REAL ADDR; 16405000
IF STEPI = LOCLID THEN 16406000
BEGIN 16407000
EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000
END 16409000
ELSE IF ELCLASS = LITNO THEN 16410000
BEGIN 16411000
ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000
END 16413000
ELSE ADDR ~ 1 ; 16414000
IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000
ELSE 16416000
IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000
ELSE ERR(250); 16418000
END SKIPS ; 16419000
COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000
JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO 16421000
THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 16422000
JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 16423000
JUMP INSTRUCTION. 16424000
SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000
A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 16426000
THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 16427000
UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000
THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING16429000
GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 16430000
PROCEDURE JUMPS; 16431000
BEGIN 16432000
JUMPLEVEL~1; 16433000
IF STEPI!DECLARATORS THEN FLAG(261); 16434000
IF STEPI = LITNO THEN JUMPLEVEL~ ELBAT[I].ADDRESS 16435000
ELSE BEGIN 16436000
IF ELCLASS! TOV AND ELCLASS! STLABID THEN 16437000
BEGIN 16438000
COMMENT SIMPLE JUMP OUT STATEMENT; 16439000
IF JOINFO = 0 THEN 16440000
BEGIN 16441000
JOINFO ~ NEXTINFO ; 16442000
PUTNBUMP(0&(STLABID|2+1) 16443000
[2:40:8]&2[27:40:8 ]); 16444000
PUTNBUMP(0&(JOINFO-LASTINFO )[ 4:40:8]); 16445000
PUTNBUMP (0); 16446000
LASTINFO ~ JOINFO; 16447000
END; 16448000
ELBAT[I~ I-1]~ TAKE(JOINFO)&JOINFO[35:35:13]; 16449000
END; I~I-1 ; 16450000
END; 16451000
FOR GT1~ 1 STEP 1 UNTIL JUMPLEVEL DO 16452000
EMIT( JNS); 16453000
GOTOS; 16454000
END JUMPS; 16455000
COMMENT STREAMSTMT ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE 16456000
THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 16457000
THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 16458000
IDENTIFIED BY PROCEDURE ENVOKED 16459000
END GO TO FINI 16460000
SEMICOLON GO TO FINI 16461000
) GO TO FINI 16462000
IF IFS 16463000
GO GOTOS 16464000
RELEASE RELEASES 16465000
BEGIN COMPOUNDTAIL 16466000
SI,DI,CI,TALLY,LOCALID INDEXS 16467000
DS DSS 16468000
SKIP SKIPS 16469000
JUMP JUMPS 16470000
LABELID LABELS 16471000
LITERAL NO.,LOCALID( NESTS 16472000
UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO 16473000
THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 16474000
LABEL L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,EXIT,FINI,START; 16475000
SWITCH TYPE ~ FINI,L,FINI,L3,L4,L5,L6,L7,L7,L7,L7,L8,L9,L10; 16476000
START: GO TO TYPE[ ELCLASS-ENDV+1]; 16477000
IF ELCLASS= RTPAREN THEN GO TO FINI ; 16478000
IF ELCLASS=COLON THEN BEGIN ADJUST;STEPIT;GO START END; %W1416478200
IF ELCLASS=STLABID THEN GO TO L2; %W2516478400
IF (IF ELCLASS{IDMAX THEN ELCLASS!LOCLID ELSE %77 %W2516478600
(ELCLASS=SUPERLISTID OR ELCLASS=FAULTID) ) THEN %77 %W2516478700
BEGIN DECLARELABEL; GO TO L2 END; %W2516478800
IF ELCLASS = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000
= LFTPAREN THEN GO TO L1; 16480000
%W2516481000
IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000
L: ERR( 250 ); GO TO FINI ; 16483000
L1: NESTS; GO TO EXIT; 16484000
L2: LABELS; GO TO START; 16485000
L3: IFS; GO TO FINI; 16486000
L4: GOTOS; GO TO EXIT; 16487000
L5: RELEASES; GO TO EXIT; 16488000
L6: I~I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000
L7: INDEXS; GO TO EXIT; 16490000
L8: DSS; GO TO EXIT; 16491000
L9: SKIPS; GO TO EXIT; 16492000
L10: JUMPS; GO TO EXIT; 16493000
EXIT: STEPIT; 16494000
FINI: END STREAMSTMT; 16495000
XREFPT~XLUN~0; %DFB16496000
TIME1 ~ TIME(1); PROGRAM; 17000000
% %A17000050
IF FALSE THEN ENDOFITALL: IF ERRORMAX < @10 THEN %T9317000100
BEGIN ERRORMAX:=@10; ERRORTOG:=TRUE; FLAG(999); END; %T9317000150
END; % END OF SEGMENT 17000200
IF XREF THEN %DFB17001000
BEGIN DEFINE LSS= <#,GTR=>#,NEQ= !#,LEQ={#; %DFB17002000
DEFINE XREFINFO=INFO#; 17002005
WRITE(LINE[PAGE]); 17002520
LASTADDRESS~0; 17002530
FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000
WRITE(DSK2,30,XREFAY2[*]); %DFB17004000
TOTALNO~REAL(XLUN >500)|1000+3000; 17004500
BEGIN %DFB17005000
BOOLEAN PROCEDURE INPUT1(A); %DFB17006000
ARRAY A[0]; %DFB17007000
BEGIN %DFB17008000
LABEL L,EOF; %DFB17009000
READ(DSK1,10,A[*])[EOF]; %DFB17010000
GO TO L; %DFB17011000
EOF: INPUT1:=TRUE; %DFB17012000
REWIND(DSK1); %DFB17013000
L: %DFB17014000
END; %DFB17015000
PROCEDURE OUTPUT1(B,A); %DFB17016000
VALUE B; %DFB17017000
BOOLEAN B; %DFB17018000
ARRAY A[0]; %DFB17019000
BEGIN %DFB17020000
IF B THEN %DFB17021000
REWIND(DSK1) %DFB17022000
ELSE %DFB17023000
BEGIN %DFB17024000
A[9]:=XREFINFO[A[9].LINKR,A[9].LINKC]:=XLUN:=XLUN+1;%DFB17025000
WRITE(DSK1,10,A[*]); %DFB17026000
END; %DFB17027000
END; %DFB17028000
BOOLEAN STREAM PROCEDURE COMPS1(A,B); %DFB17029000
BEGIN %DFB17030000
SI:=A; %DFB17031000
DI:=B; %DFB17032000
IF 63 SC LSS DC THEN TALLY:=1; %DFB17033000
COMPS1:=TALLY; %DFB17034000
END; %DFB17035000
STREAM PROCEDURE HVS1(A); %DFB17036000
BEGIN %DFB17037000
DI:=A; %DFB17038000
DS:=8 LIT "9"; %DFB17039000
SI:=A; %DFB17040000
DS:= 7 WDS; %DFB17041000
END; %DFB17042000
BOOLEAN PROCEDURE COMP1(A,B); %DFB17042100
ARRAY A,B[0]; %DFB17042200
COMP1:=COMPS1(A,B); %DFB17042300
PROCEDURE HV1(A); %DFB17042400
ARRAY A[0]; %DFB17042500
HVS1(A); %DFB17042600
XLUN:=0; %DFB17043000
REWIND(DSK1); %DFB17044000
SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,TOTALNO ); %DFB17045000
END; %DFB17046000
BEGIN %DFB17047000
STREAM PROCEDURE PUP(S,D); %DFB17048000
BEGIN %DFB17049000
SI:=S; %DFB17050000
DI:=D; %DFB17051000
DS:=8 WDS; %DFB17052000
DS:= LIT " "; %DFB17053000
DS~8 CHR; %DFB17054000
DS~ 7 LIT" "; 17054500
5(DS~8LIT" "); 17054550
END; %DFB17055000
STREAM PROCEDURE PUP2(STAR,S,C,D); 17056000
VALUE STAR,S,C; 17056500
BEGIN %DFB17057000
DI:=D; %DFB17058000
C(DI:=DI+9); %DFB17059000
STAR(DI~DI-1; DS~LIT"*"); 17059100
SI:=LOC S; %DFB17060000
DS:= 8 DEC; %DFB17061000
END; %DFB17062000
STREAM PROCEDURE BLANKET(A); %DFB17063000
BEGIN %DFB17064000
DI:=A; %DFB17065000
DS:= 8 LIT " "; %DFB17066000
SI:=A; %DFB17067000
DS:= 14 WDS; %DFB17068000
END; %DFB17069000
ARRAY PAY[0:17]; %DFB17069500
BOOLEAN PROCEDURE INPUT2(A); %DFB17070000
ARRAY A[0]; %DFB17071000
BEGIN %DFB17072000
LABEL L,EOF; %DFB17073000
DEFINE I=XLUN#; %DFB17073100
IF XREFPT:=XREFPT+1=30 THEN %DFB17074000
BEGIN %DFB17075000
READ(DSK2,30,XREFAY2[*])[EOF]; %DFB17076000
XREFPT:=0; %DFB17077000
END; %DFB17078000
IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF;17079000
A[0]:= I&XREFINFO[I.[10:3],I.[13:8]][10:37:11]; %DFB17080000
GO TO L; %DFB17081000
EOF: INPUT2:=TRUE; %DFB17082000
BLANKET(PAY); %DFB17083000
XREFAY1[9]:=-1; XREFPT~0; %DFB17084000
L: %DFB17085000
END; %DFB17086000
PROCEDURE OUTPUT2(B,A); %DFB17087000
VALUE B; %DFB17088000
BOOLEAN B; %DFB17089000
ARRAY A[0]; %DFB17090000
BEGIN DEFINE PRINTER=LINE#; %DFB17091000
LABEL LOOP; %DFB17091100
IF B THEN %DFB17092000
WRITE(PRINTER,15,PAY[*]) %DFB17093000
ELSE %DFB17094000
IF LASTADDRESS ! LASTADDRESS~A[0] AND LASTADDRESS.[10:11]! 0 THEN 17094100
BEGIN %DFB17095000
LOOP: %DFB17095050
IF A[0].[10:11] GTR XREFAY1[9] THEN %DFB17095100
BEGIN %DFB17095200
READ(DSK1,10,XREFAY1[*]); %DFB17096000
WRITE(PRINTER[DBL],15,PAY[*]); %DFB17097000
PUP(XREFAY1,PAY); %DFB17098000
XREFPT:=0; %DFB17099000
WRITE(PRINTER,10,PAY[*]); %DFB17100000
BLANKET(PAY); %DFB17101000
GO LOOP; %DFB17101100
END; %DFB17102000
PUP2(LASTADDRESS < 0,LASTADDRESS.[21:27],17103000
XREFPT,PAY[1]); 17103010
IF XREFPT:=XREFPT+1=12 THEN %DFB17103100
BEGIN %DFB17103200
XREFPT:=0; %DFB17103300
WRITE(PRINTER,15,PAY[*]); %DFB17103400
BLANKET(PAY); %DFB17103500
END; %DFB17103600
END; %DFB17110000
END; %DFB17111000
PROCEDURE HV2(A); %DFB17112000
ARRAY A[0]; %DFB17113000
A[0]:=549755813887; %DFB17114000
BOOLEAN PROCEDURE COMP2(A,B); %DFB17115000
ARRAY A,B[0]; %DFB17116000
COMP2~ ABS(A[0]) LEQ ABS(B[0]); 17117000
XREFPT:=29; REWIND(DSK2); %DFB17118000
SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,TOTALNO ); %DFB17119000
END; %DFB17120000
END; %DFB17121000
END MAIN BLOCK; 17121500
END. 17122000
END;END. LAST CARD ON 0CRDING TAPE 99999999
Reference in New Issue View Git Blame Copy Permalink