diff --git a/SYMBOL/ALGOL.alg_m b/SYMBOL/ALGOL.alg_m
index be3060d..18703a5 100644
--- a/SYMBOL/ALGOL.alg_m
+++ b/SYMBOL/ALGOL.alg_m
@@ -1,4 +1,4 @@
-$SET OMIT LISTA = LIST %121-00000999
+ $SET OMIT LISTA = LIST %121-00000999
%#######################################################################00001000
% 00001010
% B-5700 ALGOL/TSPOL SYMBOLIC 00001020
@@ -84,17 +84,17 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
00059000
031 LISTDEC: MISSING ( IN LISTDEC. 00060000
032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000
- 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE _ OR 00062000
+ 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00062000
FORWARD AFTER IDENTIFIER. 00063000
- 034 SWITCHFILEDEC:MISSING _ AFTER FILED. 00064000
+ 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
+ 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
+ 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
@@ -109,7 +109,7 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
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
+ 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
@@ -231,7 +231,7 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
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
+ 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
@@ -242,16 +242,16 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
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
+ 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
+ 251 ANY STREAM STMT PROCEDURE: MISSING ~. 00182000
252 INDEX: MISSING + OR - . 00183000
253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000
254 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 00185000
- 255 DSS: MISSING STRING IN DS_ LIT STATEMENT. 00186000
+ 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
@@ -268,7 +268,7 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
266 IFS: MISSING THEN INIF STATEMENT. 00200000
267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000
UNDEFINED. 00202000
- 268 EMITO: A REPEAT INDEX>= 64 WAS SPECIFIED OR TOO MANY 00203000
+ 268 EMITO: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00203000
FORMAL PARAMETERS,LOCALS AND LABELS. 00204000
269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000
OR TOO SMALL. 00206000
@@ -282,7 +282,7 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
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
+ 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
@@ -394,7 +394,7 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
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 IN A LIST IN A WRI00283000TE
+ 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
@@ -445,165 +445,165 @@ ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00417000
618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00418000
; 00490000
- $POP OMIT LISTA %121-00499999
+ $POP OMIT LISTA %121-00499999
BEGIN COMMENT OUTERMOST BLOCK; 00500000
INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000
SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000
INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000
IF COMPILER & GO =0.FOR SYNTAX, =-1. MUST BE AT R+26;00504000
- INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00504100
- INTEGER CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00504150
+INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00504100
+INTEGER CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00504150
INTEGER LASTADDRESS; 00504200
ARRAY ENIL[0:7,0:127]; 00504300
INTEGER ENILPTR; 00504400
DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500
ARRAY LDICT[0:7,0:127]; 00504600
BOOLEAN BUILDLINE; 00504700
- BOOLEAN REL; 00504801
- COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00505000
- TO SAVE SOME STACK SPACE; 00506000
- REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000
- COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000
- THE MAIN BLOCK; 00509000
- COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000
- REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000
- BEGIN SI_NCR; DI_LOC EXAMIN; DI_DI+7; DS_CHR END; 00512000
- REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100
- BEGIN 00512200
- SI _ AC; SI _ SI + CT; 00512300
- DI _ LOC EXAMINELAST; DI _ DI+7; 00512400
- DS _ 1 CHR; 00512500
- END EXAMINELAST; 00512600
- COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER00513000
- 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 END00518000
- 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
+BOOLEAN REL; 00504801
+ COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00505000
+ TO SAVE SOME STACK SPACE; 00506000
+ REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000
+ COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000
+ THE MAIN BLOCK; 00509000
+ COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000
+ REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000
+ BEGIN SI~NCR; DI~LOC EXAMIN; DI~DI+7; DS~CHR END; 00512000
+ REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100
+ BEGIN 00512200
+ SI ~ AC; SI ~ SI + CT; 00512300
+ DI ~ LOC EXAMINELAST; DI ~ DI+7; 00512400
+ DS ~ 1 CHR; 00512500
+ END EXAMINELAST; 00512600
+ COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000
+ IN SORCE TO THE DK-TH CHARACTER IN DEST, 0{N{63,0{SK{127; 00514000
+ DEFINE DK=DSK#; 00514500
+ STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000
+ VALUE N, SK, DSK ; 00516000
+ BEGIN SI~LOC SK; SI~SI+6; 00517000
+ IF SC!"0" THEN BEGIN SI~SORCE; 2(SI~SI+32);SORCE~SI END; 00518000
+ SI~LOC DK; SI~SI+6; DI~DEST; 00519000
+ IF SC!"0" THEN 2(DI~DI+32); 00520000
+ SI~SORCE; SI~SI+SK; DI~DI+DK; DS~N CHR; 00521000
+ END MOVECHARACTERS; 00522000
+ INTEGER STREAM PROCEDURE GETF(Q); VALUE Q; 00523000
+ BEGIN SI~LOC GETF; SI~SI+7; DI~LOC Q; DI~DI+5; 00524000
+ SKIP 3 DB; 9(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB); 00525000
+ DI~LOC Q; SI~Q; DS~WDS; SI~Q; GETF~SI 00526000
+ END GETF; 00527000
+ COMMENT START SETTING UP FILE PARAMETERS; 00528000
+ IF EXAMIN(RR11~GETF(3)+"Y08" )!12 THEN RR1~5 ELSE 00529000
+ BEGIN RR1~2; RR2~150END; 00530000
+ IF EXAMIN(RR11+5)!12 THEN RR3~4 ELSE 00531000
+ BEGIN RR3~2; RR4~150END; 00532000
+ IF EXAMIN(RR11+10)!12 THEN 00533000
+ BEGIN RR5~2; RR6~10; RR7~150END ELSE 00534000
+ BEGIN RR5~1; RR6~56; RR7~10 END; 00535000
+ IF EXAMIN(RR11+15)=12 THEN 00536000
+ BEGIN RR8~10; RR9~150END ELSE 00537000
+ BEGIN RR8~56; RR9~10 END; 00538000
+ IF EXAMIN(RR11+20)=12 THEN RR10~150; 00539000
+ BEGIN 01000000
01000100
01000200
01000300
01000400
01000500
01000600
- INTEGER NUMSEQUENCEERRORS; 01000700
- INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01000800
- BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTIONS SETTING 01000802
- BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810
- PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830
- BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE A01000840RE
- % EVALUATING AN ARRAY BOUND 01000850
- INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860
- COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870
- BASENUM IS STARTING VALUE 01000880
- TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890
- CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900
- DEFINE OPARSIZE = 200 #; 01000902
- ARRAY OPTIONS[0:OPARSIZE]; 01000904
- BOOLEAN OPTIONWORD; 01000910
- DEFINE CHECKBIT = 1#, 01000920
- DEBUGBIT = 2#, 01000930
- DECKBIT = 3#, 01000940
- FORMATBIT = 4#, 01000950
- INTBIT = 5#, 01000960
- LISTABIT = 6#, 01000970
- LISTBIT = 7#, 01000980
- LISTPBIT = 8#, 01000990
- MCPBIT = 9#, 01001000
- MERGEBIT = 10#, 01001010
- NESTBIT = 11#, 01001020
- NEWBIT = 12#, 01001030
- NEWINCLBIT = 13#, 01001040
- OMITBIT = 14#, 01001050
- PRINTDOLLARBIT = 15#, 01001060
- PRTBIT = 16#, 01001070
- PUNCHBIT = 17#, 01001080
- PURGEBIT = 18#, 01001090
- SEGSBIT = 19#, 01001100
- SEQBIT = 20#, 01001110
- SEQERRBIT = 21#, 01001120
- SINGLBIT = 22#, 01001130
- STUFFBIT = 23#, 01001140
- VOIDBIT = 24#, 01001150
- VOIDTBIT = 25#, 01001160
- XREFBIT = 26#, 01001170
- BENDBIT = 27#, 01001171
- CODEFILEBIT = 29#, %01001172106-
- USEROPINX = 30#, %01001173106-
- COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX01001180
- AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190
- FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200
- DEFINE CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01001210
- DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01001220
- DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01001230
- FORMATTOG = OPTIONWORD.[FORMATBIT:1] #, 01001240
- INTOG = OPTIONWORD.[INTBIT:1] #, 01001250
- LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01001260
- LISTOG = OPTIONWORD.[LISTBIT:1] #, 01001270
- LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01001280
- MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01001290
- MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01001300
- NESTTOG = OPTIONWORD.[NESTBIT:1] #, 01001310
- NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01001320
- NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01001330
- OMITTING = OPTIONWORD.[OMITBIT:1] #, 01001340
- PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #, 01001350
- PRTOG = OPTIONWORD.[PRTBIT:1] #, 01001360
- PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01001370
- PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01001380
- SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01001390
- SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01001400
- COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01001410
- SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01001420
- SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01001430
- STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01001440
- VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01001450
- VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01001460
- XREF = OPTIONWORD.[XREFBIT:1] #, 01001461
- BEND = OPTIONWORD.[BENDBIT:1] #, 01001462
- CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, %01001463106-
- DUMMY = #; 01001470
- BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01001480
- BOOLEAN NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01001490
- BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01001500
- % LAST CARD FROM SYMBOLIC LIBRARY READ 01001510
- % IS PATCHED FROM THE CARD READER. 01001520
- INTEGER XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01001530
- BOOLEAN DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01001540
- INTEGER ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01001550
- BOOLEAN SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01001560
- BOOLEAN LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01001570
- ALPHA MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01001580
- INTEGER MYCLASS; % USED IN DOLLARCARD EVALUATION. 01001590
- REAL BATMAN; % USED IN DOLLARCARD EVALUATION. 01001600
- ARRAY SPECIAL[0:31]; 01003000
- COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000
- CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000
- SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000
- ARRAY INFO[0:31,0:255]; 01007000
+INTEGER NUMSEQUENCEERRORS; 01000700
+INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01000800
+BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTIONS SETTING 01000802
+ BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810
+PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830
+ BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840
+ % EVALUATING AN ARRAY BOUND 01000850
+ INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860
+ COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870
+ BASENUM IS STARTING VALUE 01000880
+ TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890
+ CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900
+DEFINE OPARSIZE = 200 #; 01000902
+ARRAY OPTIONS[0:OPARSIZE]; 01000904
+BOOLEAN OPTIONWORD; 01000910
+DEFINE CHECKBIT = 1#, 01000920
+ DEBUGBIT = 2#, 01000930
+ DECKBIT = 3#, 01000940
+ FORMATBIT = 4#, 01000950
+ INTBIT = 5#, 01000960
+ LISTABIT = 6#, 01000970
+ LISTBIT = 7#, 01000980
+ LISTPBIT = 8#, 01000990
+ MCPBIT = 9#, 01001000
+ MERGEBIT = 10#, 01001010
+ NESTBIT = 11#, 01001020
+ NEWBIT = 12#, 01001030
+ NEWINCLBIT = 13#, 01001040
+ OMITBIT = 14#, 01001050
+ PRINTDOLLARBIT = 15#, 01001060
+ PRTBIT = 16#, 01001070
+ PUNCHBIT = 17#, 01001080
+ PURGEBIT = 18#, 01001090
+ SEGSBIT = 19#, 01001100
+ SEQBIT = 20#, 01001110
+ SEQERRBIT = 21#, 01001120
+ SINGLBIT = 22#, 01001130
+ STUFFBIT = 23#, 01001140
+ VOIDBIT = 24#, 01001150
+ VOIDTBIT = 25#, 01001160
+ XREFBIT = 26#, 01001170
+ BENDBIT = 27#, 01001171
+ CODEFILEBIT = 29#, %106-01001172
+ USEROPINX = 30#, %106-01001173
+COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01001180
+ AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190
+ FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200
+DEFINE CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01001210
+ DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01001220
+ DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01001230
+ FORMATTOG = OPTIONWORD.[FORMATBIT:1] #, 01001240
+ INTOG = OPTIONWORD.[INTBIT:1] #, 01001250
+ LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01001260
+ LISTOG = OPTIONWORD.[LISTBIT:1] #, 01001270
+ LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01001280
+ MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01001290
+ MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01001300
+ NESTTOG = OPTIONWORD.[NESTBIT:1] #, 01001310
+ NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01001320
+ NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01001330
+ OMITTING = OPTIONWORD.[OMITBIT:1] #, 01001340
+ PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #, 01001350
+ PRTOG = OPTIONWORD.[PRTBIT:1] #, 01001360
+ PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01001370
+ PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01001380
+ SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01001390
+ SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01001400
+COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01001410
+ SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01001420
+ SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01001430
+ STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01001440
+ VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01001450
+ VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01001460
+ XREF = OPTIONWORD.[XREFBIT:1] #, 01001461
+ BEND = OPTIONWORD.[BENDBIT:1] #, 01001462
+ CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, %106-01001463
+ DUMMY = #; 01001470
+BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01001480
+BOOLEAN NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01001490
+BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01001500
+ % LAST CARD FROM SYMBOLIC LIBRARY READ 01001510
+ % IS PATCHED FROM THE CARD READER. 01001520
+INTEGER XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01001530
+BOOLEAN DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01001540
+INTEGER ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01001550
+BOOLEAN SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01001560
+BOOLEAN LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01001570
+ALPHA MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01001580
+INTEGER MYCLASS; % USED IN DOLLARCARD EVALUATION. 01001590
+REAL BATMAN; % USED IN DOLLARCARD EVALUATION. 01001600
+ ARRAY SPECIAL[0:31]; 01003000
+ COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000
+ CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000
+ SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000
+ ARRAY INFO[0:31,0:255]; 01007000
%***********************************************************************01007005
% X R E F S T U F F %116-01007010
%***********************************************************************01007015
@@ -674,13 +674,13 @@ ARRAY %116-01007025
% FUTURE REFERENCES WILL 01007335
% BE DISCARDED. %116-01007340
% %116-01007345
- INTEGER % %116-01007350
- XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN %116-01007355
+INTEGER % %116-01007350
+ XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN %116-01007355
% XREFAY2, WHEN THIS BECOMES GREATER %116-01007360
% THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365
% AND XREFPT IS RESET TO ZERO. %116-01007370
% %116-01007375
- XLUN, % THIS VARIABLE CONTROLS THE ASSIGNING OF %116-01007380
+ XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF %116-01007380
% ID. NO. TO IDENTIFIERS. IT IS INCREMENTED %116-01007385
% EACH TIME A NEW IDENTIFIER IS ENCOUNTERED.%116-01007390
% %116-01007395
@@ -758,116 +758,116 @@ COMMENT INFO FORMAT 01028000
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
+ T.LINK~ S[L], (WHICH IS ZERO AT FIRST), 01055000
+ INFO[NEXTINFO]~T, S[L]~NEXTINFO, 01056000
+ NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000
ENTRY. 01058000
NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000
ITSELF CONTAINS THE STOP FLAG ZERO 01060000
B IS ENTERED SIMILARLY TO A. 01061000
NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000
ENTRY FOR A. 01063000
- SIMILARLY,AFTER C IS ENTERED 01064000
- A[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000
- POINTS TO A. 01066000
- THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000
- FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000
- FORWARD,IT IS RESET AT THE TIME OF ITS ACTUAL 01069000
- FULL DECLARATION. 01070000
- PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000
- INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBSTRACTED 01072000
- FROM THE CURRENT ENTRY INDEX. 01073000
- [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY,(<64) 01074000
- [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000
- AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000
- THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000
- THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000
- FOR X WOULD APPEAR AS FOLLOWS: 01079000
- INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000
- I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000
- I+2 = L 01082000
- I+3 = ELBATWRD (MADE FOR X) 01083000
- I+4 = O31X 01084000
- THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000
- THE ENTRY BEFORE SYMBOL, AND 01086000
- INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000
- ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000
- THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000
- FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000
- NECESSARY. 01091000
- THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000
- REAL 01093000
- BOOLEAN 01094000
- INTEGER 01095000
- ALPHA 01096000
- FILE 01097000
- FORMAT 01098000
- LIST 01099000
- OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000
- ARRAYS: 01101000
- THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000
- DIMENSIONS(IN THE LOW ORDER PART),[40:8] 01103000
- EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000
- BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000
- THESE WORDS ARE MADE UP AS FOLLOWS: 01106000
- [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000
- SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000
- RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000
- TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000
- SUBTRACTED. 01111000
- [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000
- REQUIRES A PRT OR STACK CELL.OTHERWISE THE BIT 01113000
- 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000
- REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000
- [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000
- IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000
- PROCEDURES: 01118000
- THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000
- PARAMETERS [40:8] 01120000
- IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000
- [13:11] ENDING PRT ADDRESS FOR LABELS. 01122000
- [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000
- OF LOCALS. 01124000
- SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000
- OF APPEARANCE IN FORMAL PARAPART) ARE 01126000
- ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000
- VALUE OR NOT([10:1]). 01128000
- THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000
- IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000
- CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 01131000
- LINK([35:13]) IS MEANINGLESS. 01132000
- IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 01133000
- THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEAS01134000E
- 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 I01140000S
- 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000
- SWITCHES: 01142000
- THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000
- ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000
- IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000
- NO POSSIBILITY OF JUMPING OUT OF A BLOCK. 01146000;
- DEFINE MON =[ 1: 1]#, 01147000
- CLASS =[ 2: 7]#, 01148000
- FORMAL=[ 9: 1]#, 01149000
- VO =[10: 1]#, 01150000
- LVL =[11: 5]#, 01151000
- ADDRESS=[16:11]#, 01152000
- INCR =[27: 8]#, 01153000
- LINK =[35:13]#, 01154000
- DYNAM =[11:16]#, 01154100
- SBITF =[21: 6]#, % STARTING BIT FOR FIELD ID. %11011542007-
- NBITF =[27: 6]#, % NUMBER OF BITS FOR FIELD ID.%11011543007-
- 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
+ SIMILARLY,AFTER C IS ENTERED 01064000
+ A[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000
+ POINTS TO A. 01066000
+ THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000
+ FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000
+ FORWARD,IT IS RESET AT THE TIME OF ITS ACTUAL 01069000
+ FULL DECLARATION. 01070000
+ PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000
+ INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBSTRACTED 01072000
+ FROM THE CURRENT ENTRY INDEX. 01073000
+ [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY,(<64) 01074000
+ [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000
+ AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000
+ THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000
+ THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000
+ FOR X WOULD APPEAR AS FOLLOWS: 01079000
+ INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000
+ I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000
+ I+2 = L 01082000
+ I+3 = ELBATWRD (MADE FOR X) 01083000
+ I+4 = O31X 01084000
+ THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000
+ THE ENTRY BEFORE SYMBOL, AND 01086000
+ INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000
+ ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000
+ THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000
+ FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000
+ NECESSARY. 01091000
+ THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000
+ REAL 01093000
+ BOOLEAN 01094000
+ INTEGER 01095000
+ ALPHA 01096000
+ FILE 01097000
+ FORMAT 01098000
+ LIST 01099000
+ OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000
+ ARRAYS: 01101000
+ THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000
+ DIMENSIONS(IN THE LOW ORDER PART),[40:8] 01103000
+ EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000
+ BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000
+ THESE WORDS ARE MADE UP AS FOLLOWS: 01106000
+ [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000
+ SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000
+ RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000
+ TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000
+ SUBTRACTED. 01111000
+ [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000
+ REQUIRES A PRT OR STACK CELL.OTHERWISE THE BIT 01113000
+ 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000
+ REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000
+ [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000
+ IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000
+ PROCEDURES: 01118000
+ THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000
+ PARAMETERS [40:8] 01120000
+ IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000
+ [13:11] ENDING PRT ADDRESS FOR LABELS. 01122000
+ [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000
+ OF LOCALS. 01124000
+ SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000
+ OF APPEARANCE IN FORMAL PARAPART) ARE 01126000
+ ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000
+ VALUE OR NOT([10:1]). 01128000
+ THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000
+ IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000
+ CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 01131000
+ LINK([35:13]) IS MEANINGLESS. 01132000
+ IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 01133000
+ THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE01134000
+ IS DONE IN THE STREAM PROCEDURE. 01135000
+ LABELS: 01136000
+ AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 01137000
+ BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 01138000
+ IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 01139000
+ LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS01140000
+ 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000
+ SWITCHES: 01142000
+ THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000
+ ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000
+ IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000
+ NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;01146000
+ DEFINE MON =[ 1: 1]#, 01147000
+ CLASS =[ 2: 7]#, 01148000
+ FORMAL=[ 9: 1]#, 01149000
+ VO =[10: 1]#, 01150000
+ LVL =[11: 5]#, 01151000
+ ADDRESS=[16:11]#, 01152000
+ INCR =[27: 8]#, 01153000
+ LINK =[35:13]#, 01154000
+ DYNAM =[11:16]#, 01154100
+ SBITF =[21:6]#, % STARTING BIT FOR FIELD ID. %117-01154200
+ NBITF =[27:6]#, % NUMBER OF BITS FOR FIELD ID.%117-01154300
+ LINKR =[35: 5]#, 01155000
+ LINKC =[40: 8]#; 01156000
+ COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD, 01157000
+ MON IS THE BIT WHICH IS TURNED ON IF: 01158000
+ 1. THE QUANTITY IS TO BE MONITORED, OR 01158100
+ 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200
+ A DEFINE WITHOUT PARAMETERS. 01158300
CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000
QUANTITY. 01160000
FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000
@@ -930,7 +930,7 @@ COMMENT INFO FORMAT 01028000
LEFTPAREN =34#, COMMENT 042; 01212000
COMMENT CLASSES FOR ALL DECLARATORS; 01213000
DECLARATORS =35#, COMMENT 043; 01214000
- COMMENT CLASSES FOR STATEMENT BEGINNERS; 01215000
+ COMMENT CLASSES FOR STATEMENT BEGINNERS 01215000
READV =36#, COMMENT 044; 01216000
WRITEV =37#, COMMENT 045; 01217000
SPACEV =38#, COMMENT 046; 01218000
@@ -995,7 +995,7 @@ COMMENT INFO FORMAT 01028000
MULOP =94#, COMMENT 136; 01277000
FACTOP =95#, COMMENT 137; 01278000
STRING =99#, COMMENT 143; 01278050
- FIELDID =125#, COMMENT 175; %11012780907-
+ FIELDID =125#, COMMENT 175; %117-01278090
FAULTID =126#, COMMENT 176; 01278100
SUPERLISTID =127#, COMMENT 177; 01278500
COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000
@@ -1018,172 +1018,172 @@ COMMENT INFO FORMAT 01028000
FILEV =17#, COMMENT 21; 01296000
STREAMV =18#, COMMENT 22; 01297000
DEFINEV =19#, COMMENT 23; 01298000
- AUXMEMV =20#, COMMENT 24; %11012985007-
- FIELDV =21#, COMMENT 25; %11012986007-
+ AUXMEMV =20#, COMMENT 24; %117-01298500
+ FIELDV =21#, COMMENT 25; %117-01298600
DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
- REAL TIME1; 01300000
- INTEGER SCRAM; 01301000
- COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIE01302000R
- OR RESERVED WORD SCANNED; 01303000
- ARRAY FILEATTRIBUTES[0:30] ; 01303500
- ALPHA ARRAY ACCUM[0:10]; 01304000
- COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000
- SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000
- IN INFO. THAT IS ACCUN[1] = 00NAAAAA, ACCUM[I] , I> 1.01307000
- HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000
- THE ELBAT WORD BY THE ENTER ROUTINES; 01309000
- ARRAY STACKHEAD,SUPERSTACK[0:124]; 01310000 %WF
- COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX 01311000 %WF
- POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A 01311100 %WF
- LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, 01311200 %WF
- BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS 01311300 %WF
- AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE 01311400 %WF
- WORDS POINTED TO (IN THREE GROUPS) ARE: 01311500 %WF
- 1) ALPHA, LABEL, OWN, REAL, SAVE 01311600 %WF
- 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE 01311700 %WF
- 3) BEGIN, DO, ELSE, END, FOR, GO, IF, 01311800 %WF
- STEP, THEN, TO, UNTIL, WHILE, WRITE. 01311900 %WF
- FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE 01312000 %WF
- COMMENTS IN THE TABLE PROCEDURE. ; 01312100 %WF
- INTEGER COUNT; 01313000
- COMMENT COUNT CONTAINS THE NUMBER OF CHARACTERS OF THE LAST ITEM01314000
- SCANNED; 01315000
- ALPHA Q; 01316000
- COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000
- WORD SCANNED; 01318000
- ARRAY ELBAT[0:76]; INTEGER I,NEXTELBT; 01319000
- COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANN01320000ED
- QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000
- (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE01322000
- GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000
- FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN IND01324000EX
- POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN01325000
- INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS01326000
- FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE01327000;
- INTEGER ELCLASS; 01328000
- COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000
- INTEGER LASTELCLASS; 01329100
- COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200
- INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000
- INTEGER MAXTCLR; 01331000
- COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTER OF 01332000
- THE CARD IMAGE CURRENTLY BEING SCANNED. NCR THE ADDRES01333000S
- OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000
- CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS O01335000F
- THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXT01336000LCR
- IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000
- DEFINE BUFFSIZE = 56#; 01338000
- INTEGER GTIX; 01339050
- ARRAY TEN[0:69]; 01340000
- INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050
- DECLARED IN THE OBJECT PROGRAM; 01340060
- INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070
- GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080
- REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500
- INTEGER IDLOC,IDLOCTEMP; 01341000
- ARRAY PDPRT[0:31,0:63]; 01342000
- COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILAT01343000ION
- IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000
- BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES01345000
- 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 NUMBE01361200R
- 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 ENT01363000RY
- IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THI01364000S
- ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT01365000
- DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEG01366000MENT
- IS READY FOR OUTPUT; 01367000
- COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE E01367010ND OF
- COMPILATION IS AS FOLLOWS: 01367020
- SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NU01367030M. I)
- BIT POSITIONS CONTENTS OF FIELD 01367040
- [0:1] EMPTY 01367050
- [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060
- [2:1] ON IFF INTRINSIC PROCEDURE 01367070
- [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075
- [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080
- [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085
- [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEG01367090MENT
- [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100
- [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110
- PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMB01367120ER I)
- BIT POSITIONS CONTENTS OF FIELD 01367130
- [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. ID 01367140BITS
- [4:2] MODE AND ARGUMENT BITS 01367150
- [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. 01367160DICT.)
- [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO A01367170NOTHER
- PRT ENTRY FOR SEGMENT01367180 I
- [18:15] I 01367190
- [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THI01367200S DESC;
- COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FI01367210LE ARE:
- 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 (IE01367290..1)
- 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 01372000ARRAY
- 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 US01375000ED;
- REAL LASTENTRY ; 01376000
- COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT PO01377000INTS
- INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONST01378000ANTS;
- BOOLEAN MRCLEAN ; 01379000
- COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN I01380000S
- FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE01381000
- POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXT,N01382000FO]
- DURING AN ARRAY DECLARATION ; 01383000
- REAL GT1,GT2,GT3,GT4,GT5; 01384000
- INTEGER GTI1; 01384500
- COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000
- INTEGER RESULT; 01386000
- COMMENT THIS VARIALE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000
- ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES TH01388000IS
- VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCAN01389000NER
- USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION T01390000AKEN;
- INTEGER LASTUSED; 01391000
- COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000
- READACARD. THE ROUTINE WHICH READS CARDS AND INITIA01393000LIZES
- OR PREPARES THE CARD FOR THE SCANNER. 01394000
- LASTUSED LAST CARD READ FROM 01394500
- -------- ------------------- 01394600
- 1 CARD READ ONLY, NO TAPE. 01395000
- 2 CARD READER, TAPE AND CARD MERGE. 01396000
- 3 TAPE, TAPE AND CARD MERGE. 01397000
- 4 INITIALIZATION ONLY, CARD ONLY. 01398000
- 5 CARD READER - MAKCAST, MERGING. 01398100
- 6 TAPE - MAKCAST, MERGING. 01398200
- ; 01398300
+ REAL TIME1; 01300000
+ INTEGER SCRAM; 01301000
+ COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000
+ OR RESERVED WORD SCANNED; 01303000
+ARRAY FILEATTRIBUTES[0:30] ; 01303500
+ ALPHA ARRAY ACCUM[0:10]; 01304000
+ COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000
+ SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000
+ IN INFO. THAT IS ACCUN[1] = 00NAAAAA, ACCUM[I] , I> 1. 01307000
+ HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000
+ THE ELBAT WORD BY THE ENTER ROUTINES; 01309000
+ ARRAY STACKHEAD,SUPERSTACK[0:124]; %WF 01310000
+ COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX %WF 01311000
+ POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100
+ LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200
+ BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300
+ AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400
+ WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500
+ 1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600
+ 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700
+ 3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800
+ STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900
+ FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE %WF 01312000
+ COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100
+ INTEGER COUNT; 01313000
+ COMMENT COUNT CONTAINS THE NUMBER OF CHARACTERS OF THE LAST ITEM 01314000
+ SCANNED; 01315000
+ ALPHA Q; 01316000
+ COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000
+ WORD SCANNED; 01318000
+ ARRAY ELBAT[0:76]; INTEGER I,NEXTELBT; 01319000
+ COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000
+ QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000
+ (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000
+ GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000
+ FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000
+ POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000
+ INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000
+ FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000
+ INTEGER ELCLASS; 01328000
+ COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000
+ INTEGER LASTELCLASS; 01329100
+ COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200
+ INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000
+ INTEGER MAXTCLR; 01331000
+ COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTER OF 01332000
+ THE CARD IMAGE CURRENTLY BEING SCANNED. NCR THE ADDRESS 01333000
+ OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000
+ CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000
+ THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000
+ IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000
+ DEFINE BUFFSIZE = 56#; 01338000
+ INTEGER GTIX; 01339050
+ ARRAY TEN[0:69]; 01340000
+ INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050
+ DECLARED IN THE OBJECT PROGRAM; 01340060
+ INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070
+ GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080
+ REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500
+ INTEGER IDLOC,IDLOCTEMP; 01341000
+ ARRAY PDPRT[0:31,0:63]; 01342000
+ COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000
+ IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000
+ BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000
+ OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000
+ TYPE 1 ENTRY 01347000
+ BIT POSITION KIND OF ENTRY 01348000
+ 0-3 ZERO 01349000
+ 4 MODE BIT(1=CHAR 0=WORD) 01350000
+ 5 ARGUMENT BIT 01351000
+ 6-7 ZERO 01352000
+ 8-17 RELATIVE ADDRESS IN PRT 01353000
+ 18-27 RELATIVE ADDRESS IN SEGMENT 01354000
+ 28-37 SEGMENT NUMBER 01355000
+ 38-47 ZERO 01356000
+ TYPE 2 ENTRY 01357000
+ BIT POSITION KIND OF ENTRY 01358000
+ 0 EMPTY 01359000
+ 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000
+ 2 ON IFF INTRINSIC PROCEDURE 01361000
+ 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050
+ 4-12 EMPTY 01361100
+ 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200
+ 28-37 SEGMENT NUMBER 01361300
+ 38-47 NUMBER OF WORDS IN SEGMENT 01362000
+ THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000
+ IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000
+ ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000
+ DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000
+ IS READY FOR OUTPUT; 01367000
+COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010
+ COMPILATION IS AS FOLLOWS: 01367020
+ SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030
+ BIT POSITIONS CONTENTS OF FIELD 01367040
+ [0:1] EMPTY 01367050
+ [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060
+ [2:1] ON IFF INTRINSIC PROCEDURE 01367070
+ [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075
+ [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080
+ [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085
+ [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 01367090
+ [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100
+ [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110
+ PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120
+ BIT POSITIONS CONTENTS OF FIELD 01367130
+ [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. IDBITS 01367140
+ [4:2] MODE AND ARGUMENT BITS 01367150
+ [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160
+ [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170
+ PRT ENTRY FOR SEGMENT I 01367180
+ [18:15] I 01367190
+ [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200
+COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210
+ WORD CONTENTS 01367220
+ 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230
+ 1 SIZE OF SEGMENT DICTIONARY 01367240
+ 2 RELATIVE LOCATION OF PRT 01367250
+ 3 SIZE OF PRT 01367260
+ 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270
+ 5 SIZE OF FILE PARAMETER BLOCK 01367280
+ 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290
+ 7 N 01367300
+ . O U 01367310
+ . T S 01367320
+ . E 01367330
+ 29 D; 01367340
+INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000
+INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000
+INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000
+ ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000
+ COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000
+ AS SPECIFIED BY "L". 01373000
+ IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 01374000
+ THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 01375000
+ REAL LASTENTRY ; 01376000
+ COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 01377000
+ INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 01378000
+ BOOLEAN MRCLEAN ; 01379000
+ COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000
+ FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000
+ POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000
+ DURING AN ARRAY DECLARATION ; 01383000
+ REAL GT1,GT2,GT3,GT4,GT5; 01384000
+ INTEGER GTI1; 01384500
+ COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000
+ INTEGER RESULT; 01386000
+ COMMENT THIS VARIALE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000
+ ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000
+ VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000
+ USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000
+ INTEGER LASTUSED; 01391000
+ COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000
+ READACARD. THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000
+ OR PREPARES THE CARD FOR THE SCANNER. 01394000
+ LASTUSED LAST CARD READ FROM 01394500
+ -------- ------------------- 01394600
+ 1 CARD READ ONLY, NO TAPE. 01395000
+ 2 CARD READER, TAPE AND CARD MERGE. 01396000
+ 3 TAPE, TAPE AND CARD MERGE. 01397000
+ 4 INITIALIZATION ONLY, CARD ONLY. 01398000
+ 5 CARD READER - MAKCAST, MERGING. 01398100
+ 6 TAPE - MAKCAST, MERGING. 01398200
+ ; 01398300
BOOLEAN LINKTOG; 01399000
COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK. 01400000
OTHERWISE IT IS TRUE; 01401000
@@ -1195,7 +1195,7 @@ DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
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 GLOBAL DEPTH OF THE PROCEDURE IN WHICH WE A01410000RE
+ IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000
NESTED (AT COMPILE TIME); 01411000
INTEGER AUXMEMREQ; 01411010
BOOLEAN SAVEPRTOG; 01411020
@@ -1211,109 +1211,109 @@ DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
BOOLEAN ERRORTOG; 01412000
COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000
ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000
- BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000
- COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000
- BOOLEAN STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500
- % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000
- % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500
- % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000
- % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500
- % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000
- DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000
- FI = 6#, FIO = 7#; 01420500
- COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 01421000
- THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000
- THEIR MEANING IS: 01423000
- FS MEANS FROM STATEMENT. 01424000
- FP MEANS FROM PRIMARY. 01425000
- FL MEANS FROM LIST. 01426000
- FR MEANS FROM FOR. 01427000
- FIO MEANS FROM IODEC. 01427250
- FA MEANS FROM ACTUALPARAPART. 01427500
- FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600
+BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000
+ COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000
+BOOLEAN STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500
+ % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000
+ % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500
+ % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000
+ % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500
+ % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000
+DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000
+ FI = 6#, FIO = 7#; 01420500
+ COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 01421000
+ THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000
+ THEIR MEANING IS: 01423000
+ FS MEANS FROM STATEMENT. 01424000
+ FP MEANS FROM PRIMARY. 01425000
+ FL MEANS FROM LIST. 01426000
+ FR MEANS FROM FOR. 01427000
+ FIO MEANS FROM IODEC. 01427250
+ FA MEANS FROM ACTUALPARAPART. 01427500
+ FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600
INTEGER L; 01428000
- COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000
+ 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 OBJECT01431000
- 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 T01436000O
- 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 TH01444000E
- 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 EXECUTED01447000
- BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW, THIS CARRIES YOU 01448000
- TO THE PROPOER 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
+ 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 PROPOER 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
+ 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 BLOC01460000K
- 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 TALLIE01465000D
- IF LEVEL = JUMPCTR; 01466000
- BOOLEAN GOTOG; 01467000
- COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF AN01468000Y
- 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 THE01473000
- ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000
- INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED01475000
- 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
+ COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK 01460000
+ AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000
+ BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000
+ SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000
+ MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000
+ OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED 01465000
+ IF LEVEL = JUMPCTR; 01466000
+BOOLEAN GOTOG; 01467000
+ COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 01468000
+ LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000
+ MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000
+REAL STLB; 01471000
+ COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000
+ THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000
+ ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000
+ INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000
+ FOR TEMPORARY STORAGE; 01476000
+DEFINE BUMPL = L~L+2#; 01477000
+ COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000
+DEFINE IDMAX = LABELID#; 01479000
+ COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000
+INTEGER DEFINECTR,DEFINEINDEX; 01481000
+ALPHA ARRAY DEFINFO[0:89]; 01481100
+ALPHA ARRAY TEXT[0:31,0:255]; 01481200
+INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300
+INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400
+ REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000
+ LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000
+ NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS; 01484000
+ JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000
+ COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000
+ ARRAY MACRO[0:35]; 01487000
+ COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000
REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000
- Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000
- SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000
- COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000
- DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE=# PAIRS. 01493000
- THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000
- TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000
- THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000
- ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000
- THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000
- INTEGER BEGINCTR; 01499000
- COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED01500000
- FOR ERROR CONTROL ONLY; 01501000
- INTEGER DIALA,DIALB; 01502000
- COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000
- DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000
- WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY01505000
- BY SETTING DIALA AND DIALB TO ZERO; 01506000
+ Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000
+SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000
+ COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000
+ DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE=# PAIRS. 01493000
+ THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000
+ TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000
+ THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000
+ ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000
+ THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000
+INTEGER BEGINCTR; 01499000
+ COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED 01500000
+ FOR ERROR CONTROL ONLY; 01501000
+INTEGER DIALA,DIALB; 01502000
+ COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000
+ DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000
+ WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY 01505000
+ BY SETTING DIALA AND DIALB TO ZERO; 01506000
01507000
01508000
01509000
@@ -1329,47 +1329,47 @@ REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000
01519000
01520000
01521000
- BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE TH01522000E
- 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 FOR01526000
- 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 DIMENSION01533000S
- IN NODIMPART; 01534000
- DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000
- POSITION IN THE FIRST WORD OF ADDITIONAL01536000
- 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 ADDITIONAL01540000
- 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 ADDITIONAL01544000
- 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 INCREMENTED01549000
- EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000
- APPEARS IN A DUMP DECLARATION; 01551000
- DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000
- ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000
- THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000
- FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000
- THE PRINTI ROUTINE; 01556000
- DEFINE CHUNK = 180#; 01556100
- FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200
- FILE IN CARD (RR1,10,RR2); 01557000
- SAVE 01558000
- FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000
- ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010
+BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000
+ SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000
+ COMMENT AT RR1; 01524000
+ BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000
+DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000
+ THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000
+ THE FIRST WORD OF ADDITIONAL INFO; 01528000
+DEFINE SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000
+ THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000
+ INFO FOR MONITORED SIMPLE VARIABLES; 01531000
+DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000
+ FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000
+ IN NODIMPART; 01534000
+DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000
+ POSITION IN THE FIRST WORD OF ADDITIONAL 01536000
+ INFO THAT CONTAINS THE MONITOR FILE 01537000
+ ADDRESS FOR LABELS; 01538000
+DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000
+ POSITION IN THE FIRST WORD OF ADDITIONAL 01540000
+ INFO THAT CONTAINS THE MONITOR FILE 01541000
+ ADDRESS FOR LABELS; 01542000
+DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000
+ POSITION IN THE FIRST WORD OF ADDITIONAL 01544000
+ INFO THAT CONTAINS THE MONITOR FILE 01545000
+ ADDRESS FOR LABELS; 01546000
+DEFINE DUMPEE = [2,11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000
+ ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000
+ THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000
+ EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000
+ APPEARS IN A DUMP DECLARATION; 01551000
+DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000
+ ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000
+ THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000
+ FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000
+ THE PRINTI ROUTINE; 01556000
+ DEFINE CHUNK = 180#; 01556100
+ FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200
+ FILE IN CARD (RR1,10,RR2); 01557000
+ SAVE 01558000
+ FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000
+ ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010
INTEGER DA; 01559020
SAVE FILE OUT NEWTAPE DISK SERIAL [20:2400] (RR5,RR6,RR7,SAVE 1); 01560000
FILE IN TAPE "OCRDIMG" (2,RR8,RR9); 01561000
@@ -1378,7 +1378,7 @@ INTEGER DA; 01559020
FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020
FILE IN CASTB(1,BUFFSIZE); 01561030
FILE IN CASTC(1,BUFFSIZE); 01561040
- SWITCH FILE LIBRARY_CASTA,CASTB,CASTC; 01561050
+ SWITCH FILE LIBRARY~CASTA,CASTB,CASTC; 01561050
FILE OUT REMOTE 19 (2,10); 01561055
SAVE ARRAY CBUF,TBUFF[0:9]; % INPUT BUFFERS. 01561056
BOOLEAN REMOTEG; 01561060
@@ -1398,38 +1398,38 @@ ARRAY LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 01561065
LIBRARY SWITCH FILE INDEX, SEQSUM IS THE 01561170
SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180
FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190
-REAL RECOUNT,FINISHPT; 01561200
- BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202
- PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204
- BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206
- CARD READER ELSE FALSE; 01561208
- COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210
- BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215
- OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217
-DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220
- BLOCKS PER LIBRARY TAPE; 01561230
-ARRAY DIRECTORY[0:3xNOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240
- DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250
- A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260
- B: 2 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270
- IDENTIFIER NAME. 01561280
- C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 01561290
- D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300
- ENTRIES. 01561310
- ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320
- LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330
- DIRECTORY BLOCKS. 01561340
- ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350
- AND THE ITEM D WILL FOLLOW INDICATING THE 01561360
- LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370
- ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380
- BLOCK. 01561390
- IN ORDER TO CHANGE: 01561400
- NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410
- 01561020 - 01561050. 01561420
- - CHANGE "3" AT 01561430
- NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440
- AT ; 01561450
+ REAL RECOUNT,FINISHPT; 01561200
+ BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202
+ PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204
+ BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206
+ CARD READER ELSE FALSE; 01561208
+ COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210
+ BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215
+ OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217
+ DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220
+ BLOCKS PER LIBRARY TAPE; 01561230
+ ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240
+ DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250
+ A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260
+ B: 2 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270
+ IDENTIFIER NAME. 01561280
+ C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 01561290
+ D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300
+ ENTRIES. 01561310
+ ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320
+ LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330
+ DIRECTORY BLOCKS. 01561340
+ ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350
+ AND THE ITEM D WILL FOLLOW INDICATING THE 01561360
+ LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370
+ ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380
+ BLOCK. 01561390
+ IN ORDER TO CHANGE: 01561400
+ NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410
+ 01561020 - 01561050. 01561420
+ - CHANGE "3" AT 01561430
+ NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440
+ AT ; 01561450
DEFINE %107-01561500
INSERTMAX = 20#, % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 01561510
INSERTCOP = INSERTINFO[INSERTDEPTH,4]#, % = 1 IF COPY TO NEWTAPE 01561520
@@ -1445,64 +1445,64 @@ SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER %107-01561610
REAL STREAM PROCEDURE CMPD(A,B); %107-01561620
BEGIN %107-01561630
SI:=A; DI:=B; %107-01561640
- IF 8 SC>=DC THEN %107-01561650
+ IF 8 SC } DC THEN %107-01561650
BEGIN %107-01561660
SI:=SI-8; DI=DI-8; TALLY:=2; %107-01561670
IF 8 SC = DC THEN TALLY:=1; %107-01561680
END; %107-01561690
- CMPD:=TALLY; %107-01561700
- END CMPD; %107-01561710
-REAL C; 01562000
- COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000
-REAL T; 01564000
- COMMENT T IS A TEMPORARY CELL; 01565000
-INTEGER TCOUNT; 01566000
- COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000
- FOR THE USE OF CONVERT; 01568000
- REAL STACKCT; %A 01568500
-DEFINE LOGI =443#, 01569000
- EXPI =440#, 01570000
- XTOTHEI =480#, 01571000
- GOTOSOLVER =484#, 01572000
- PRINTI =477#, 01573000
- MERGEI =500#, 01573100
- POWERSOFTEN =670#, 01574000
- LASTSEQUENCE =166#, %11701575000-
- LASTSEQROW = 2#, 01576000
- INTERPTO =461#, 01577000
- SUPERMOVER =555#, 01577500
- CHARI =465#, 01578000
- INTERPTI =469#, 01579000
- SORTI =473#, 01579100
- DIALER =559#, 01579200
- FILEATTINT =563#, 01579300
- POWERALL =567#, 01579350
- SPECIALMATH =570#, 01579355
- SORTA =673#, %11701580000-
- COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDE01581000X
- IN INFO OF THE CORRESPONDING ROUTINE; 01582000
+ CMPD:=TALLY; %107-01561700
+ END CMPD; %107-01561710
+ REAL C; 01562000
+ COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000
+ REAL T; 01564000
+ COMMENT T IS A TEMPORARY CELL; 01565000
+ INTEGER TCOUNT; 01566000
+ COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000
+ FOR THE USE OF CONVERT; 01568000
+ REAL STACKCT; %A01568500
+ DEFINE LOGI =443#, 01569000
+ EXPI =440#, 01570000
+ XTOTHEI =480#, 01571000
+ GOTOSOLVER =484#, 01572000
+ PRINTI =477#, 01573000
+ MERGEI =500#, 01573100
+ POWERSOFTEN =670#, 01574000
+ LASTSEQUENCE =166#, %117-01575000
+ LASTSEQROW = 2#, 01576000
+ INTERPTO =461#, 01577000
+ SUPERMOVER =555#, 01577500
+ CHARI =465#, 01578000
+ INTERPTI =469#, 01579000
+ SORTI =473#, 01579100
+ DIALER =559#, 01579200
+ FILEATTINT =563#, 01579300
+ POWERALL =567#, 01579350
+ SPECIALMATH =570#, 01579355
+ SORTA =673#, %117-01580000
+ COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000
+ IN INFO OF THE CORRESPONDING ROUTINE; 01582000
INTEGER KOUNT,BUFFACCUM; 01583000
INTEGER FILENO; 01584000
-BOOLEAN 01585000
- FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000
- FUNCTION; 01587000
- P2, COMMENT GNERALLY TELLS WHETHER OWN WAS SEEN; 01588000
- P3, COMMENT TELSS WHETHER SAVE WAS SEEN; 01589000
- P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500
- VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000
- FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000
- PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSED;01592000
+ BOOLEAN 01585000
+ FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000
+ FUNCTION; 01587000
+ P2, COMMENT GNERALLY TELLS WHETHER OWN WAS SEEN; 01588000
+ P3, COMMENT TELSS WHETHER SAVE WAS SEEN; 01589000
+ P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500
+ VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000
+ FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000
+ PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000
SPECTOG, 01593000
- STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000
- ONE ID AND THEN EIXT; 01595000
- AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000
+ 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
+ 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
@@ -1538,75 +1538,75 @@ DEFINE PURPT=[4:8]#,SECRET=2#; 01628000
NUMBERS REFERS TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE01630000
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 CONDITIONAL01634000;
- 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; %A01642000
- DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000
- EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000
- LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000
- LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000
- GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000
- LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000
- LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000
- GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000
- IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000
- INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000
- ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000
- ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT;01654000
- LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000
- LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000
- LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000
- LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000
- LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000
- LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 01660000
- LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000
- MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100
- MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000
- MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000
- NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000
- NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000
- PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000
- PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000
- RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000
- RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000
- RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000
- SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000
- SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100
- SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000
- STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000
- SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000
- XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000
- XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000
- ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000
+ ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000
+ BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;01634000
+ BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000
+ BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000
+ BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000
+ CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000
+ CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000
+ COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000
+ COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000
+ DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; %A 01642000
+ DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000
+ EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000
+ LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000
+ LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000
+ GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000
+ LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000
+ LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000
+ GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000
+ IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000
+ INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000
+ ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000
+ ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000
+ LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000
+ LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000
+ LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000
+ LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000
+ LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000
+ LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 01660000
+ LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000
+ MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100
+ MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000
+ MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000
+ NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000
+ NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000
+ PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000
+ PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000
+ RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000
+ RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000
+ RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000
+ SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000
+ SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100
+ SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000
+ STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000
+ SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000
+ XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000
+ XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000
+ ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000
COMMENT THESE DEFINES ARE USED BY EMITD; 01678000
DEFINE 01679000
- DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000
- DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000
- TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000
+ 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_LOCL 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
+ 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~LOCL 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
@@ -1622,7 +1622,7 @@ ARRAY GTA1[0:10]; 01697000
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 THE NEXT PRT CELL AVAILABLE FOR PERMANENT ASS01704000IGN-
+ COMMENT PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-01704000
MENT. ORTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000
TEMPORARY ASSIGNMENT; 01706000
DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000
@@ -1652,11 +1652,11 @@ DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000
PROCEDURE SCANNER; FORWARD; 01730000
COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 01732000
REAL STREAM PROCEDURE MKABS(A); 01733000
- BEGIN DI _ A; MKABS _ DI END MKABS; 01734000
+ 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
+ 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
@@ -1664,11 +1664,11 @@ DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000
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
+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
@@ -1676,21 +1676,21 @@ DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000
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
+ DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400
END; 01741500
- STREAM PROCEDURE SEQUENCEWARNING(L); 01742100
- BEGIN DI:=L; DI:=DI-8; DS:=24 LIST "SEQUENCE WARNING<<<<<<<<"; END;01742110
+STREAM PROCEDURE SEQUENCEWARNING(L); 01742100
+ BEGIN DI:=L; DI:=DI-8; DS:=24 LIT "SEQUENCE WARNING<<<<<<<<"; END; 01742110
BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200
COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300
TRUE IF ANY VISIBLE CHARACTER ; 01742400
BEGIN 01742500
LABEL NED; 01742600
- SI_FCR; 01742700
- TALLY_0; 01742800
- 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI_ SI+1)); 01742900
- TALLEY_63; 01743000
- NED: TALLY_TALLY+1; 01743100
- NONBLANK_TALLY 01743200
+ SI~FCR; 01742700
+ TALLY~0; 01742800
+ 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900
+ TALLEY~63; 01743000
+ NED: TALLY~TALLY+1; 01743100
+ NONBLANK~TALLY 01743200
END NONBLANK; 01743300
INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE** 01750000
GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000
@@ -1727,7 +1727,7 @@ TRANS: 01778000
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 VOIDE RANGE. 01783000
+ DI:=VR; SI:=LOC VP; DS:=WDS; % ADDRESS OF VOID RANGE. 01783000
END OF GETVOID; 01784000
REAL VOIDCR,VOIDPLACE; 01785000
BOOLEAN SORTMERGETOG; 01786000
@@ -1747,139 +1747,139 @@ PROCEDURE DATIME; 01820000
WRITE(LINE, 01829000
$ SET OMIT = NOT ALGOL 01829900
"XVI.0.122" %123-01831000
- ," ",A6,"DAY", ",0,", ",I2.":",A2,X1,A3, 01832000
+ ," ",A6,"DAY, ",0,", ",I2.":",A2,X1,A3, 01832000
////X45,A1,A6,"/",A1,A6,/X45,15("=")//>, 01832500
- TIME(6),DATER(TIME(5)),12xREAL(Q:=H MOD 12=0)+Q, 01833000
- Q:=MIN MOD 10+(MIN DIV 10)x64, 01834000
- IF H>=12THEN "PM." ELSE "AM.", 01835000
+ TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000
+ Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000
+ IF H}12THEN "PM." ELSE "AM.", 01835000
N1,[6:6],N1,N2,[6:6],N2); 01835500
IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. %120-01835600
WRITE(LINE,, %120-01835700
(N1:=TAPE.MFID),[6:6],N1,(N2:=TAPE.FID),[6:6],N2); %120-01835800
NOHEADING:=FALSE; 01836000
END OF DATIME; 01837000
-DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000
-COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000
- AND SCANNING THEM; 02001000
- BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020
- VALUE ROW ; 02001030
- BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040
- REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY 02001050
- ; 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 THE 02001200
- WRONG ROW; 02001210
- SI_SI+1;DI_LOC LOOK; 02001220
- IF 3 SC = DC 02001230
- THEN BEGIN COMMENT WE ARE 02001240
- IN THE WRONG 02001250
- ROW; 02001260
- SI_DPPOS; 02001270
- SI_SI+8; 02001280
- DPPOS_SI; 02001290
- DI_LOC TEMP; 02001300
- DS_WDS; 02001310
- SI_TEMP; 02001320
- END 02001330
- ELSE SI_SI-4; 02001340
- END; 02001350
- DI_LOC LGTH; DI_DI+7; DS_CHR; 02001360
- SI_SI+ LGTH; 02001370
- DI_STOPOS; DS_5 LIT"0"; 02001375
- DS_3 CHR; GO TO EXIT; 02001380
- END; 02001390
- SI_SI+3; 02001400
- END 02001410
- ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420
- SI_SI-1; 02001430
- IF SC = "0" 02001440
- THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450
- SI_SI+1; DI_LOC LOOK; 02001460
- IF 3 SC = DC 02001470
- THEN BEGIN COMMENT CHANGE ROWS; 02001480
- SI_DPPOS;SI_SI+8;DPPOS_SI; 02001490
- DI_LOC TEMP; DS_WDS; 02001500
- SI_TEMP; 02001510
- END 02001520
- ELSE BEGIN COMMENT IT IS NOT HERE; 02001530
- TALLY_1; LOOK_TALLY; 02001540
- GO TO EXIT; 02001550
- END; 02001560
- GO TO LOOP; 02001563
- END; 02001565
- SI_SI_LGTH; SI_SI+4; COMMENT POSITION TO NEXT ID.; 02001568
- END; 02001570
- GO TO LOOP; 02001580
- EXIT:; 02001590
- END LOOK; 02001600
-%***********************************************************************02001605*
-% %11602001610-
-% MISCELLANEOUS CROSS REFERENCE PROCEDURES %11602001615-
-% %11602001620-
-%***********************************************************************02001630*
-% %11602001635-
-PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); %11602001640-
- VALUE INDEX,SEQNO,REFTYPE; %11602001645-
- REAL INDEX,SEQNO,REFTYPE; %11602001650-
-BEGIN %11602001655-
- IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE %11602001660-
- BEGIN %11602001665-
- IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. %11602001670-
- BEGIN %11602001675-
- WRITE(DSK2,30,XREFAY2[*]); %11602001680-
- XREFPT := 0; %11602001685-
- END; %11602001690-
- XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] %11602001695-
- REFIDNOF; %11602001700-
- XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE %11602001705-
- % CANT WRITE IT OUT BECAUSE SOME ROUTINES %11602001710-
- % WILL LOOK BACK AT THE ENTRY WE JUST PUT %11602001715-
- % IN AND FIX IT UP. %11602001720-
- END; %11602001725-
-END OF CROSSREFIT; %11602001730-
-% %11602001735-
-PROCEDURE CROSSREFDUMP(INDEX); %11602001740-
- VALUE INDEX; %11602001745-
- REAL INDEX; %11602001750-
-BEGIN %11602001755-
- STREAM PROCEDURE MOVEREFINFO(S,D,N); %11602001760-
- VALUE N; %11602001765-
- BEGIN %11602001770-
- SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD %11602001775-
- SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER %11602001780-
- END OF MOVEXREFINFO; %11602001785-
- % %11602001790-
- IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT %11602001795-
- BEGIN %11602001800-
- MOVEXREFINFO(INFO[INDEX,LINKR,INDEX,LINKC+1],XREFAY1[*], %11602001805-
- TAKE(INDEX+1),[12:6]); %11602001810-
- XREFAY1[8] := XREFINFO[INDEX]; %11602001815-
- XREFAY1[9] := TAKE(INDEX); % ELBAT WORD %11602001820-
- WRITE(DSK1,10,XREFAY1[*]); %11602001821-
- XREFINFO[INDEX] := 0; %11602001822-
- END; %11602001825-
-END OF CROSSREFDUMP; %11602001830-
+ DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000
+ COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000
+ AND SCANNING THEM; 02001000
+ BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020
+ VALUE ROW ; 02001030
+ BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040
+ REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050
+ ; 02001060
+ LOCAL DPPOS,TEMP,LGTH; 02001070
+ LABEL LOOP,EXIT; 02001080
+ SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090
+ DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100
+ SI~SI+8; 02001110
+ LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120
+ DI~ACC1; DI~DI+2; SI~SI-1; 02001130
+ IF SC = DC 02001140
+ THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150
+ IF LGTH SC = DC 02001160
+ THEN BEGIN COMMENT FOUND IT; 02001170
+ DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180
+ IF SC = "0" 02001190
+ THEN BEGIN COMMENT WE MAY BE IN THE02001200
+ WRONG ROW; 02001210
+ SI~SI+1;DI~LOC LOOK; 02001220
+ IF 3 SC = DC 02001230
+ THEN BEGIN COMMENT WE ARE02001240
+ IN THE WRONG 02001250
+ ROW; 02001260
+ SI~DPPOS; 02001270
+ SI~SI+8; 02001280
+ DPPOS~SI; 02001290
+ DI~LOC TEMP; 02001300
+ DS~WDS; 02001310
+ SI~TEMP; 02001320
+ END 02001330
+ ELSE SI~SI-4; 02001340
+ END; 02001350
+ DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360
+ SI~SI+ LGTH; 02001370
+ DI~STOPOS; DS~5 LIT"0"; 02001375
+ DS~3 CHR; GO TO EXIT; 02001380
+ END; 02001390
+ SI~SI+3; 02001400
+ END 02001410
+ ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420
+ SI~SI-1; 02001430
+ IF SC = "0" 02001440
+ THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450
+ SI~SI+1; DI~LOC LOOK; 02001460
+ IF 3 SC = DC 02001470
+ THEN BEGIN COMMENT CHANGE ROWS; 02001480
+ SI~DPPOS;SI~SI+8;DPPOS~SI;02001490
+ DI~LOC TEMP; DS~WDS; 02001500
+ SI~TEMP; 02001510
+ END 02001520
+ ELSE BEGIN COMMENT IT IS NOT HERE; 02001530
+ TALLY~1; LOOK~TALLY; 02001540
+ GO TO EXIT; 02001550
+ END; 02001560
+ GO TO LOOP; 02001563
+ END; 02001565
+ SI~SI~LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568
+ END; 02001570
+ GO TO LOOP; 02001580
+ EXIT:; 02001590
+ END LOOK; 02001600
+%***********************************************************************02001605
+% %116-02001610
+% MISCELLANEOUS CROSS REFERENCE PROCEDURES %116-02001615
+% %116-02001620
+%***********************************************************************02001630
+% %116-02001635
+PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); %116-02001640
+ VALUE INDEX,SEQNO,REFTYPE; %116-02001645
+ REAL INDEX,SEQNO,REFTYPE; %116-02001650
+BEGIN %116-02001655
+ IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE %116-02001660
+ BEGIN %116-02001665
+ IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. %116-02001670
+ BEGIN %116-02001675
+ WRITE(DSK2,30,XREFAY2[*]); %116-02001680
+ XREFPT := 0; %116-02001685
+ END; %116-02001690
+ XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] %116-02001695
+ REFIDNOF; %116-02001700
+ XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE %116-02001705
+ % CANT WRITE IT OUT BECAUSE SOME ROUTINES %116-02001710
+ % WILL LOOK BACK AT THE ENTRY WE JUST PUT %116-02001715
+ % IN AND FIX IT UP. %116-02001720
+ END; %116-02001725
+END OF CROSSREFIT; %116-02001730
+% %116-02001735
+PROCEDURE CROSSREFDUMP(INDEX); %116-02001740
+ VALUE INDEX; %116-02001745
+ REAL INDEX; %116-02001750
+BEGIN %116-02001755
+ STREAM PROCEDURE MOVEREFINFO(S,D,N); %116-02001760
+ VALUE N; %116-02001765
+ BEGIN %116-02001770
+ SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD %116-02001775
+ SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER %116-02001780
+ END OF MOVEXREFINFO; %116-02001785
+ % %116-02001790
+ IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT %116-02001795
+ BEGIN %116-02001800
+ MOVEXREFINFO(INFO[INDEX,LINKR,INDEX,LINKC+1],XREFAY1[*], %116-02001805
+ TAKE(INDEX+1),[12:6]); %116-02001810
+ XREFAY1[8] := XREFINFO[INDEX]; %116-02001815
+ XREFAY1[9] := TAKE(INDEX); % ELBAT WORD %116-02001820
+ WRITE(DSK1,10,XREFAY1[*]); %116-02001821
+ XREFINFO[INDEX] := 0; %116-02001822
+ END; %116-02001825
+END OF CROSSREFDUMP; %116-02001830
REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831
BEGIN 02001832
- SI_ ACCUM; SI_SI+SKP;SI_SI+3;DI_LOC CONV; DS _ N OCT 02001833
+ SI~ ACCUM; SI~SI+SKP;SI~SI+3;DI~LOC CONV; DS ~ N OCT 02001833
END CONV; 02001834
COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 02001836
BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001838
BEGIN 02001840
SI:=S; SI:=SI+3; DI:=D; SK(DS:=3 RESET); % RIGHT JUSTIFY. 02001842
- CNT(IF SC>="8"THEN TALLY:=1 ELSE IF SC<="0"THEN TALLY:=1; SKIP 3 SB;02001844
+ CNT(IF SC}"8"THEN TALLY:=1 ELSE IF SC{"0"THEN TALLY:=1; SKIP 3 SB; 02001844
3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02001846
% 02001848
% 02001850
@@ -1892,7 +1892,7 @@ COMMENT LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE 02001862
WAY THEY ARE DECLARED IN STREAM PROCEDURES; 02001864
DI:=LOC TEMP1; CNT(DS:=LIT"1"); % IN CASE A CHAR=A,B,C,D,OR F. 02001866
SI:=S; SI:=SI+3; DI:=LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2. 02001868
- CNT(IF SC<"0" THEN IF SC>="A"THEN IF SC<="F"THEN % WORK HARD. 02001870
+ CNT(IF SC<"0" THEN IF SC}"A"THEN IF SC{"F"THEN % WORK HARD. 02001870
BEGIN 02001872
T1:=SIL T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN. 02001874
DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK. 02001876
@@ -1911,38 +1911,38 @@ COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 02002000
CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 02003000
IT IS NEEDED FOR FUTURE REFERENCE; 02004000
STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR; 02005000
- BEGIN D:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000
+ BEGIN DI:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000
COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 02007000
I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 02008000
CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02009000
THE SCANNER; 02010000
-STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000
- BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000
- COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010
- IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020
- THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030
- NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040
- VARIABLE AD; 02013050
- STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060
- VALUE AD,DESCRP; 02013065
- BEGIN 02013070
- LOCAL HOLD,ZONEP; 02013073
- DI_LOC ZONEP; SI_SUM; DS_8 ZON; 02013074
- COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075
- DI_SUM; DI_DI+7; DS_2 RESET; 02013076
- COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077
- SI_LOC DESCRP; SI_SI+7; 02013078
- IF SC="1" THEN BEGIN DI_LOC HOLD; SI_SEQLOC; 02013080
- DS_WDS; DI_HOLD; END 02013085
- ELSE DI_SEQLOC; 02013090
+ STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000
+ BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000
+ COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010
+ IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020
+ THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030
+ NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040
+ VARIABLE AD; 02013050
+ STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060
+ VALUE AD,DESCRP; 02013065
+ BEGIN 02013070
+ LOCAL HOLD,ZONEP; 02013073
+ DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074
+ COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075
+ DI~SUM; DI~DI+7; DS~2 RESET; 02013076
+ COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077
+ SI~LOC DESCRP; SI~SI+7; 02013078
+ IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080
+ DS~WDS; DI~HOLD; END 02013085
+ ELSE DI~SEQLOC; 02013090
COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091
- HOLD_DI; DI_DI+7; DS_2 RESET; DI_HOLD; 02013095
- SI _ LOC AD; 02013100
- SI _ SI + 7; 02013110
- IF SC = "1" THEN BEGIN SI_ SUM; DS_8 ADD; END 02013120
- ELSE BEGIN SI_ SUM; DS_8 SUB; END; 02013130
- SI_LOC ZONEP; DI_HOLD; DS_8 ZON; 02013135
- SI_LOC ZONEP; DI_SUM; DS_8 ZON; 02013136
+ 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
@@ -1958,149 +1958,149 @@ PROCEDURE SEARCHLIB(DOLLAR); VALUE DOLLAR; BOOLEAN DOLLAR; 02013165
Q:=ACCUM[1]; FLAG(N); 02013180
LISTOG:=TL; SINGLTOG:=TS; 02013181
END FLAGIT; 02013183
- IF DOLLAR THEN 02013184
- BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190
- RESULT_COUNT_ACCUM[1] _0; SCANNER; 02013195
- RESULT_COUNT_ACCUM[1] _0; SCANNER; 02013200
- IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205
- FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210
- COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219
- FLAGIT(500); GO EXIT; 02013222
- END; 02013225
- FILEINX _ FILEINX -1; 02013230
- IF DIRECTORY[GT1_3xFILEINX,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[FILEINXx3,0] _ -2; 02013255
- WHILE GT2 _ GT2-1 > 0 DO 02013260
- BEGIN 02013265
- READ(LIBRARY[FILEINX]); 02013270
- MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1_GT1+1,0]); 02013275
- END; 02013280
- END; 02013285
- RESULT_ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET THE PROD.ID.; 02013290
- IF LOOK(ACCUM[1],DIRECTORY,3xFILEINX, GT1,GT2) THEN 02013295
- BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300
- FLAGIT(501); GO EXIT; 02013305
- END; 02013310
- WHILE LCR.[33:15] - NCR.[33:15] !=1 OR NCR.[30:3]!= 7 02013313
- DO BEGIN 02013315
- IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317
- RESULT_5; SCANNER; 02013318
- END; 02013319
- GO TO NOPARTIAL; 02013320
- EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT SPACE PAST "[" ; 02013330
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET START POINT; 02013335
- IF RESULT!= 3 THEN 02013340
- BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345
- FLAGIT(502); GO EXIT; 02013350
- END; 02013355
- GT1 _ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; 02013365
- IF RESULT!= 2 THEN 02013370
- BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375
- FLAGIT(503); GO EXIT; 02013380
- END; 02013385
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET LENGTH; 02013390
- IF RESULT!= 3 THEN 02013395
- BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400
- FLAGIT(504); GO EXIT; 02013405
- END; 02013410
- GT2 _ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; 02013420
- IF ACCUM[1]!= "1D0000" THEN 02013425
- BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430
- FLAGIT(505); GO EXIT; 02013435
- END; 02013440
- WHILE LCR.[33:15] - NCR.[33:15]!= 1 OR NCR.[30:3]!= 7 02013445
- DO BEGIN RESULT _ 5; SCANNER END; 02013446
- END; 02013450
- NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475
- LIBARRAY[LIBINDEX].LSTUSD _ LASTUSED; 02013480
- LIBARRAY[LIBINDEX].FILEINDEX _ FILEINX; 02013490
- LIBARRAY[LIBINDEX].STOPPOINT _ FINISHPT; 02013495
- LIBARRAY[LIBINDEX].NEXTENTRY _ RECOUNT-1; 02013497
- FINISHPT _ GT2; 02013500
- IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3],FILEINDEX) 02013505
- x3,0] _ RECOUNT -1; 02013510
- RECOUNT_GT1; 02013515
- IF EXAMIN(LCR)!= "%" THEN 02013516
- PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525
- IF LASTUSED<=2 OR LASTUSED=5 THEN GTI1_0 02013526
- ELSE IF MAXLTLCR.[33:15]=NCR.[33:15]<11 THEN 02013527
- GTI1_MKABS(LIBRARY[FILEINX](0)) ELSE GTI1_(NCR+2).[33:15]; 02013528
- LIBARRAY[LIBINDEX+2],NCRLINK_GTI1.[33:15]; COMMENT GTI1=NCR; 02013530
- IF LASTUSED<=2 OR LASTUSED=5 THEN 02013533
- LIBARRAY[LIBINDEX+2].LCRLINK_0 ELSE 02013534
- LIBARRAY[LIBINDEX+2].LCRLINK_GTI1.[33:15]+10; 02013535
- IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536
- LASTUSED_5; LIBARRAY[LIBINDEX].NEXTENTRY_ 02013537
- LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538
- END ELSE BEGIN 02013539
- LASTUSED_6; FIRSTIMEX_ TRUE; END 02013540
- ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541
- LIBINDEX _ LIBINDEX + 3; 02013542
- END 02013545
- ELSE 02013550
- BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555
- LIBINDEX _ LIBINDEX -3; 02013560
- RECOUNT_RECOUNT-1; 02013563
- LASTUSED _ LIBARRAY[LIBINDEX].LSTUSD; 02013565
- IF LASTUSED =1 THEN MEDIUM := "C "; %112- 02013566
- IF LIBINDEX > 0 THEN BEGIN GTI1_LIBARRAY[LIBINDEX].NEXTENTRY; 02013567
- DIRECTORY[FILEINXx3,0]_RECOUNT; RECOUNT_GTI1+2; END ELSE 02013568
- DIRECTORY[FILEINXx3,0] _ RECOUNT; 02013570
- IF LIBINDEX > 0 THEN 02013575
- FILEINX _ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580
- FINISHPT _ LIBARRAY[LIBINDEX].STOPPOINT; 02013600
- IF LIBINDEX!= 0 THEN 02013610
- MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615
- IF LASTUSED<=2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617
- NCR _ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620
- IF LASTUSED<=2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621
- LCR _ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625
- NORELEASE_TRUE; 02013627
- IF LASTUSED=6 THEN FIRSTIMEX_TRUE; 02013628
- END OF UNLINK; 02013630
- IF LIBINDEX = 0 THEN 02013635
- BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640
- SEQSUM_0; 02013645
- END 02013650
- ELSE 02013655
- BEGIN 02013660
- GT1_(GTI1_(DIRECTORY[FILEINXx3,0]+3)/5)x5+1; 02013665
- GT2_(GTI1_(RECOUNT-3)/5)x5+1; 02013670
- GT3 _(GT2 - GT1)DIV 5; 02013675
- SPACE(LIBRARY[FILEINX],GT3); 02013680
+ IF DOLLAR THEN 02013184
+ BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190
+ RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195
+ RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200
+ IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205
+ FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210
+ COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219
+ FLAGIT(500); GO EXIT; 02013222
+ END; 02013225
+ FILEINX ~ FILEINX -1; 02013230
+ IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235
+ BEGIN COMMENT MUST READ DIRECTORY; 02013240
+ GT3~MKABS(LIBRARY[FILEINX](0)); 02013245
+ MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250
+ GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255
+ WHILE GT2 ~ GT2-1 > 0 DO 02013260
+ BEGIN 02013265
+ READ(LIBRARY[FILEINX]); 02013270
+ MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275
+ END; 02013280
+ END; 02013285
+ RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROD.ID.; 02013290
+ IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295
+ BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300
+ FLAGIT(501); GO EXIT; 02013305
+ END; 02013310
+ WHILE LCR.[33:15] - NCR.[33:15] !1 OR NCR.[30:3] ! 7 02013313
+ DO BEGIN 02013315
+ IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317
+ RESULT~5; SCANNER; 02013318
+ END; 02013319
+ GO TO NOPARTIAL; 02013320
+ EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325
+ RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT SPACE PAST "[" ;02013330
+ RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET START POINT;02013335
+ IF RESULT ! 3 THEN 02013340
+ BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345
+ FLAGIT(502); GO EXIT; 02013350
+ END; 02013355
+ GT1 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360
+ RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013365
+ IF RESULT ! 2 THEN 02013370
+ BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375
+ FLAGIT(503); GO EXIT; 02013380
+ END; 02013385
+ RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET LENGTH; 02013390
+ IF RESULT ! 3 THEN 02013395
+ BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400
+ FLAGIT(504); GO EXIT; 02013405
+ END; 02013410
+ GT2 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415
+ RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013420
+ IF ACCUM[1] ! "1D0000" THEN 02013425
+ BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430
+ FLAGIT(505); GO EXIT; 02013435
+ END; 02013440
+ WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013445
+ DO BEGIN RESULT ~ 5; SCANNER END; 02013446
+ END; 02013450
+ NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475
+ LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480
+ LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490
+ LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495
+ LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497
+ FINISHPT ~ GT2; 02013500
+ IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3],FILEINDEX) 02013505
+ |3,0] ~ RECOUNT -1; 02013510
+ RECOUNT~GT1; 02013515
+ IF EXAMIN(LCR) ! "%" THEN 02013516
+ PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517
+ MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520
+ MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525
+ IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526
+ ELSE IF MAXLTLCR.[33:15]=NCR.[33:15]<11 THEN 02013527
+ GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528
+ LIBARRAY[LIBINDEX+2],NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530
+ IF LASTUSED{2 OR LASTUSED=5 THEN 02013533
+ LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534
+ LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535
+ IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536
+ LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537
+ LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538
+ END ELSE BEGIN 02013539
+ LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540
+ ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541
+ LIBINDEX ~ LIBINDEX + 3; 02013542
+ END 02013545
+ ELSE 02013550
+ BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555
+ LIBINDEX ~ LIBINDEX -3; 02013560
+ RECOUNT~RECOUNT-1; 02013563
+ LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565
+ IF LASTUSED =1 THEN MEDIUM := "C "; %112-02013566
+ IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567
+ DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568
+ DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570
+ IF LIBINDEX > 0 THEN 02013575
+ FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580
+ FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600
+ IF LIBINDEX ! 0 THEN 02013610
+ MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615
+ IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617
+ NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620
+ IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621
+ LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625
+ NORELEASE~TRUE; 02013627
+ IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628
+ END OF UNLINK; 02013630
+ IF LIBINDEX = 0 THEN 02013635
+ BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640
+ SEQSUM~0; 02013645
+ END 02013650
+ ELSE 02013655
+ BEGIN 02013660
+ GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665
+ GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670
+ GT3 ~(GT2 - GT1)DIV 5; 02013675
+ SPACE(LIBRARY[FILEINX],GT3); 02013680
02013681
02013682
- READ(LIBRARY[FILEINX],GT3); 02013685
+ READ(LIBRARY[FILEINX],GT3); 02013685
02013690
02013693
- 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) x11)); 02013705
- MAXLTLCR_MKABS(LIBRARY[FILEINX](0))+54; 02013710
- ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713
- IF LASTUSED= 6 THEN BEGIN 02013714
- NCR_LCR_MKABS(LIBRARY[FILEINX](0)); 02013715
- PUTSEQNO(GT1,LCR); 02013716
- TURNONSTOPLIGHT("%",LCR); 02013717
- END; END; 02013718
- EXIT: END SEARCHLIB; 02013720
- COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000
- AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000
-BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000
- BEGIN SI_FCR; IF SC!="$" THEN TALLY_1; 02017000
- DI_NEW; DS_10 WDS; WRITNEW_TALLY 02018000
- END WRITNEW; 02019000
+ MOVE(1,LIBRARY[FILEINX](0),GTI1); 02013697
+ IF GTI1!GT2 AND GTI1 !0 THEN 02013699
+ BEGIN COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 02013701
+ FLAG(507); GO TO EXIT; 02013702
+ END; 02013703
+ LTLCR~MKABS(LIBRARY[FILEINX](10))+(GTI1~(((RECOUNT-1) MOD 5) |11)); 02013705
+ MAXLTLCR~MKABS(LIBRARY[FILEINX](0))+54; 02013710
+ ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713
+ IF LASTUSED= 6 THEN BEGIN 02013714
+ NCR~LCR~MKABS(LIBRARY[FILEINX](0)); 02013715
+ PUTSEQNO(GT1,LCR); 02013716
+ TURNONSTOPLIGHT("%",LCR); 02013717
+ END; END; 02013718
+ EXIT: END SEARCHLIB; 02013720
+ COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000
+ AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000
+ BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000
+ BEGIN SI~FCR; IF SC!"$" THEN TALLY~1; 02017000
+ DI~NEW; DS~10 WDS; WRITNEW~TALLY 02018000
+ END WRITNEW; 02019000
02020000
02021000
02022000
@@ -2218,13 +2218,13 @@ DEBLANK: 02100000
L: BEGIN SI:=SI+1; IF SC=" " THEN GO L END; 02101000
COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 02101500
NCRV:=SI; 02102000
- IF SC>= "0" THEN GO NUMBERS; 02102500
+ IF SC } "0" THEN GO NUMBERS; 02102500
IF SC=ALPHA THEN GO IDBLDR; 02103000
COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 02103500
GNC: 02104000
DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT; 02104500
COMMANTS: 02105000
- IF SC!=";" THEN 02105500
+ IF SC!";" THEN 02105500
BEGIN 02106000
COMMENTS: 02106500
SI:=SI+1; 02107000
@@ -2275,7 +2275,7 @@ L: 02128000
IF NCR=LCR THEN 02129500
BEGIN 02130000
READACARD; 02130500
- IF LIBINDEX!=0 THEN 02131500
+ IF LIBINDEX!0 THEN 02131500
IF RECOUNT=FINISHPT THEN 02132000
BEGIN 02132500
SEARCHLIB(FALSE); 02133000
@@ -2322,7 +2322,7 @@ COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02187250
REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02188000
BEGIN 02188250
SI := TAPE; DI := CARD; 02188500
- IF 8 SC >=DC THEN 02188750
+ IF 8 SC } DC THEN 02188750
BEGIN 02189000
SI := SI-8; DI := DI-8; TALLY := 1; 02189250
IF 8 SC = DC THEN TALLY := 2 02189500
@@ -2409,7 +2409,7 @@ END; %105-02202090
MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T.02204250
END 02204500
ELSE BEGIN 02204750
- IF GT1!= 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000
+ IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000
BEGIN 02205250
MEDIUM:="P "; % CARD PATCHES TAPE. 02205500
IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750
@@ -2428,7 +2428,7 @@ END; %105-02202090
SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750
LIBCLAST, LIBTLAST, COPYLIB; %107-02211000
BOOLEAN DOLLAR2TOG; 02211250
- IF ERRORCOUNT>=ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500
+ IF ERRORCOUNT}ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500
USETHESWITCH: 02211750
GO TO USESWITCH[LASTUSED]; 02212000
MOVE(1,TEXT[LASTUSED,LINKR,LASTUSED,LINKC], 02212250
@@ -2440,7 +2440,7 @@ FIRSTTIME: 02213500
READ(CARD,10,CBUFF[*]); 02213750
FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9; 02214000
MEDIUM:="C "; 02214100
- IF EXAMIN(FCR)!="$" AND LISTER THEN PRINTCARD; 02214200
+ IF EXAMIN(FCR)!"$" AND LISTER THEN PRINTCARD; 02214200
PUTSEQNO(INFO[LASTSEQROW,LASTSEQENCE],LCR); 02214250
CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02214260
TURNONSTOPLIGHT("%",LCR); 02214500
@@ -2504,7 +2504,7 @@ COMPAR: 02224250
EXIT: 02225000
NCR := FCR:= LCR - 9; 02225250
COMMENT SETS UP NCR AND FCR; 02225500
- IF CHECKTOG AND EXAMIN(FCR)!="$" THEN %$=CARDS DON"T COUNT. 02225750
+ IF CHECKTOG AND EXAMIN(FCR)!"$" THEN %$=CARDS DON"T COUNT. 02225750
IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000
IF SEQERRTOG THEN BEGIN FLAG(610); 02226250
NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300
@@ -2553,10 +2553,10 @@ COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250
% 02235500
TURNONSTOPLIGHT("%",LCR); 02235750
IF BUILDLINE THEN 02236000
- IF LASTADDRESS!= (LASTADDRESS := L.[36:10]) THEN 02236250
+ IF LASTADDRESS ! (LASTADDRESS := L.[36:10]) THEN 02236250
BEGIN 02236500
ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750
- IF (ENILPTR := ENILPTR+1)>=1023 THEN 02237000
+ IF (ENILPTR := ENILPTR+1)}1023 THEN 02237000
BEGIN FLAG(80); ENILPTR := 512; END; 02237250
END; 02237500
XIT: 02237750
@@ -2597,7 +2597,7 @@ DONTSCAN: %107-02238342
IF V="- " THEN %107-02238400
BEGIN %107-02238410
SKAN; %107-02238420
- IF RESULT != 3 THEN ERR(614); %107-02238430
+ IF RESULT ! 3 THEN ERR(614); %107-02238430
MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); %107-02238440
END ELSE GO TO DONTSCAN; %107-02238450
GO AGAIN; %107-02238460
@@ -2636,7 +2636,7 @@ GETEM: %107-02238560
IF INSERTINX > 0 THEN %107-02238660
BEGIN %107-02238670
DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] %107-02238680
- UNTIL CMPD(INSERTINX,LBUFF[9]) <= 1; %107-02238690
+ UNTIL CMPD(INSERTINX,LBUFF[9]) { 1; %107-02238690
V:=V-1; %107-02238700
END; %107-02238702
INSERTINX:=V; %107-02238704
@@ -2655,17 +2655,17 @@ EXIT: %107-02238830
END; %107-02238840
REAL PROCEDURE CONVERT; 02248000
BEGIN REAL T; INTEGER N; 02249000
- TL0_0; THI_ 02250000
- T_ CONV(ACCUM[1],TCOUNT,N_(COUNT-TCOUNT)MOD 8); 02251000
- FOR N_ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000
+ TL0~0; THI~ 02250000
+ T~ CONV(ACCUM[1],TCOUNT,N~(COUNT-TCOUNT)MOD 8); 02251000
+ FOR N~ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000
IF DPTOG THEN 02253000
BEGIN 02254000
- DOUBLE(THI,TLO,100000000.0,0,x,CONV(ACCUM[1],N,8),0,+,?, 02255000
+ DOUBLE(THI,TLO,100000000.0,0,|,CONV(ACCUM[1],N,8),0,+,?, 02255000
THI,TLO); 02256000
- T_THI; 02257000
+ T~THI; 02257000
END ELSE 02258000
- T_ Tx100000000+ CONV(ACCUM[1],N,8); 02259000
- CONVERT_T; 02260000
+ T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000
+ CONVERT~T; 02260000
END; 02261000
REAL STREAM PROCEDURE FETCH(F); VALUE F; 02262000
BEGIN SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS END FETCH; 02263000
@@ -2695,18 +2695,18 @@ PROCEDURE DUMPINFO; 02264000
BEGIN 02265400
WRITE(LINE[DBL],,JEDEN); 02265450
FOR DWA:=0 STEP 6 UNTIL 251 DO 02265500
- BEGIN 02265550
- BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600
- WRITE(LINE,15,A[*]); 02265650
- BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700
- WRITE(LINE[DBL],15,A[*]); 02265750
- END; 02265800
- BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850
- WRITE(LINE,15,A[*]); 02265900
- BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950
- WRITE(LINE[DBL],15,A[*]); 02266000
- END; 02266050
- END OF DUMPINFO; 02266100
+ BEGIN 02265550
+ BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600
+ WRITE(LINE,15,A[*]); 02265650
+ BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700
+ WRITE(LINE[DBL],15,A[*]); 02265750
+ END; 02265800
+ BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850
+ WRITE(LINE,15,A[*]); 02265900
+ BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950
+ WRITE(LINE[DBL],15,A[*]); 02266000
+ END; 02266050
+ END OF DUMPINFO; 02266100
DEFINE SKAN = BEGIN 02277000
COUNT:=RESULT:=ACCUM[1]:=0; 02278000
SCANNER; 02279000
@@ -2741,8 +2741,8 @@ BOOLEAN PROCEDURE FINDOPTION(BIT); VALUE BIT; INTEGER BIT; 02307000
BEGIN 02308000
LABEL FOUND; 02309000
REAL ID; 02310000
- OPINX:=2xBIT-4; 02311000
- WHILE ID:=OPTIONS[OPINX:=OPINX+2]!= D0 02312000
+ OPINX:=2|BIT-4; 02311000
+ WHILE ID:=OPTIONS[OPINX:=OPINX+2] ! D0 02312000
IF Q=ID THEN GO FOUND; 02313000
OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION. 02314000
FOUND: %103-02315000
@@ -2764,7 +2764,7 @@ XMODE0: % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP. 02329000
FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO OPTIONS[SAVEINX]:=0; 02331000
IF BUILDLINE.[45:1] THEN %108-02331050
BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; %108-02331060
- XMODE:=1; IF LASTUSED < 5 AND LASTUSED!= 3 THEN LASTUSED:=1; 02332000
+ XMODE:=1; IF LASTUSED < 5 AND LASTUSED ! 3 THEN LASTUSED:=1; 02332000
XMODE1: % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED. 02333000
OPTIONS[OPINX+1]:=REAL(TRUE); 02334000
IF XBIT= NXTELBT 02644000
+ WHILE P } NXTELBT 02644000
DO BEGIN 02645000
SCANAGAIN: 02646000
COUNT:=RESULT:=ACCUM[1]:=0; SCANNER; 02647000
@@ -3113,7 +3113,7 @@ COMMENT INCR FIELD OF SPECIAL CHARACTER IS NON-ZERO FOR SPECIAL 02660000
CHARACTERS REQUIRING SPECIAL HANDLING. INCR IS SWITCHED 02661000
ON TO OBTAIN DISCRIMINATION; 02662000
COLON: RESULT:=7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02663000
- FOR := IN PLACE OF _ ; 02664000
+ FOR := IN PLACE OF ~ ; 02664000
IF EXAMIN (NCR) = "=" THEN 02665000
BEGIN RESULT:=0; SCANNER; T:=SPECIAL[13] END; 02666000
RESULT:=2; GO COMPLETE; 02667000
@@ -3135,7 +3135,7 @@ QUOTE: 02690000
DO BEGIN 02693000
RESULT:=5; SCANNER; 02694000
IF COUNT=T THEN 02695000
- IF EXAMIN(NCR)!= """ THEN GO ARGH; 02696000
+ IF EXAMIN(NCR) ! """ THEN GO ARGH; 02696000
END UNTIL EXAMIN(NCR) = """; 02697000
IF NOT STREAMTOG AND COUNT=8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 02697500
BEGIN Q := ACCUM[1]; FLAG(254); GO TO SCANAGAIN; END; %111-02697600
@@ -3159,14 +3159,14 @@ COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02707000
CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID. 02712000
FOR A FULL DISCUSSION SEE DEFINEGEN; 02713000
CROSSHATCH: 02714000
- IF DEFINECTR!=0 THEN GO COMPLETE; 02715000
+ IF DEFINECTR!0 THEN GO COMPLETE; 02715000
PUTSEQNO(GT1,LCR); 02716000
TURNONSTOPLIGHT(0,LCR); 02717000
IF DEFINEINDEX = 0 THEN GO ARGH; 02718000
LCR:=(GT1:=DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02719000
NCR:=GT1 MOD 262144; 02720000
LASTUSED:=(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3]).[33:15];02721000
- IF (GT2 := T.[18:15])!= 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500
+ IF (GT2 := T.[18:15]) ! 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500
BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD %122-02722000
GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500
DO %122-02723000
@@ -3180,12 +3180,12 @@ CROSSHATCH: 02714000
GO SCANAGAIN; 02728000
DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02729000
IF GT1:=EXAMIN(NCR)="$" THEN GO DBLDOLLAR ELSE DOLLARCARD; 02730000
-PERCENT: IF NCR!= FCR THEN READACARD; 02731000
- IF LIBINDEX!=0 THEN 02732000
- IF RECOUNT=FINISHPT THEN 02733000
- BEGIN 02734000
- SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000
- END; 02736000
+PERCENT: IF NCR ! FCR THEN READACARD; 02731000
+ IF LIBINDEX!0 THEN 02732000
+ IF RECOUNT=FINISHPT THEN 02733000
+ BEGIN 02734000
+ SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000
+ END; 02736000
GO SCANAGAIN; 02737000
COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02738000
PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02739000
@@ -3202,7 +3202,7 @@ RTPAREN: RESULT:=7; SCANNER; 02744000
END UNTIL EXAMIN(NCR) = """; 02750000
RESULT:=0; SCANNER; 02751000
RESULT:=7; SCANNER; 02752000
- IF EXAMIN(NCR)!= "(" THEN GO ARGH; 02753000
+ IF EXAMIN(NCR) ! "(" THEN GO ARGH; 02753000
RESULT:=0; SCANNER; Q:=ACCUM[1]; 02754000
T:=SPECIAL[24] 02755000
END; 02756000
@@ -3227,7 +3227,7 @@ IPART: TCOUNT:=FSAVE:=0; C:=CONVERT; 02758000
FLAG(521) % NON-OCTAL CHARACTER IN STRING. 02773000
ELSE ELSE IF HEXIZE(ACCUM[1],ACCUM[4],12-COUNT,COUNT) THEN 02774000
FLAG(521); % NON-HEX CHARACTER IN HEX STRING. 02775000
- T.INCR := COUNT := (CxCOUNT-1)DIV 6 + 1; % # OF CHARS. 02776100
+ T.INCR := COUNT := (C|COUNT-1)DIV 6 + 1; % # OF CHARS. 02776100
T.CLASS:= STRNGCON; %111-02776200
MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); %111-02776300
IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. %111-02776400
@@ -3235,75 +3235,75 @@ IPART: TCOUNT:=FSAVE:=0; C:=CONVERT; 02758000
T.CLASS := STRING %111-02776600
ELSE %111-02776700
FLAG(254) %111-02776800
- ELSE %111-02776900
- C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000
- MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); %111-02777050
- GO TO COMPLETE; %111-02777100
- MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000
- GO COMPLETE; 02782000
- END OF OCTAL OR HEX STRING; 02783000
- IF DPTOG THEN 02784000
- BEGIN NHI:=THI; NLO:=TLO; END; 02785000
- IF EXAMIN(NCR)="." THEN 02786000
- BEGIN 02787000
- RESULT:=0; SCANNER; 02788000
- C:=1.0x C; 02789000
-FPART: TCOUNT:=COUNT; 02790000
- IF EXAMIN(NCR)<=9 THEN 02791000
- BEGIN 02792000
- RESULT:=0; SCANNER; 02793000
- IF DPTOG THEN 02794000
- BEGIN 02795000
- DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000
- 0,.,:=,THI,TLO); 02797000
- FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000
- DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000
- DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000
- C:=NHI 02801000
- END 02802000
- ELSE C:=CONVERT+CxTEN[FSAVE:=COUNT-TCOUNT]; 02803000
- END 02804000
- END; 02805000
- RESULT:=7; SCANNER; 02806000
- IF EXAMIN(NCR)="@" THEN 02807000
- BEGIN 02808000
- RESULT:=0; SCANNER; 02809000
-FPART: TCOUNT:=COUNT; 02810000
- C:=Cx1.0; 02811000
- RESULT:=7; SCANNER; 02812000
- IF T:=EXAMIN(NCR)>9 THEN 02813000
- IF T="-" OR T = "+" THEN 02814000
- BEGIN 02815000
- RESULT:=0; SCANNER; 02816000
- TCOUNT:=COUNT; 02817000
- END 02818000
- ELSE FLAG(47); 02819000
- RESULT:=0; SCANNER; 02820000
- IF RESULT!= 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000
- Q:=ACCUM[1]; 02822000
- IF GT1:=T:=(IF T="-" THEN -CONVERT ELSE CONVERT)<-46 OR 02823000
- T>69 THEN FLAG(269) 02824000
- ELSE BEGIN 02825000
- T:=TEN[ABS(GT3:=T-FSAVE)]; 02826000
- IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] 02827000
- + 12) >63 THEN FLAG(269) 02828000
- ELSE IF DPTOG THEN 02829000
- IF GT1<0 THEN 02830000
- BEGIN 02831000
- GT1:=-GT1; 02832000
- DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000
- FOR GT2:=12 STEP 12 UNTIL GT1 DO 02834000
- DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO); 02835000
- END 02836000
- ELSE BEGIN 02837000
- DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,x,:=,NHI,NLO); 02838000
- FOR GT2:=12 STEP 12 UNTIL GT1 DO 02839000
- DOUBLE( NHI,NLO,TEN[12],0,x,:=,NHI,NLO); 02840000
- END 02841000
- ELSE C:=IF GT3<0 THEN C/T ELSE CxT; 02842000
- END; 02843000
- END 02844000
- ELSE IF FSAVE!= 0 THEN C:=C/TEN[FSAVE]; 02845000
+ ELSE %111-02776900
+ C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000
+ MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); %111-02777050
+ GO TO COMPLETE; %111-02777100
+ MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000
+ GO COMPLETE; 02782000
+ END OCTAL OR HEX STRING; 02783000
+ IF DPTOG THEN 02784000
+ BEGIN NHI:=THI; NLO:=TLO; END; 02785000
+ IF EXAMIN(NCR)="." THEN 02786000
+ BEGIN 02787000
+ RESULT:=0; SCANNER; 02788000
+ C:=1.0| C; 02789000
+ FPART: TCOUNT:=COUNT; 02790000
+ IF EXAMIN(NCR){9 THEN 02791000
+ BEGIN 02792000
+ RESULT:=0; SCANNER; 02793000
+ IF DPTOG THEN 02794000
+ BEGIN 02795000
+ DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000
+ 0,.,:=,THI,TLO); 02797000
+ FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000
+ DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000
+ DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000
+ C:=NHI 02801000
+ END 02802000
+ ELSE C:=CONVERT+C|TEN[FSAVE:=COUNT-TCOUNT]; 02803000
+ END 02804000
+ END; 02805000
+ RESULT:=7; SCANNER; 02806000
+ IF EXAMIN(NCR)="@" THEN 02807000
+ BEGIN 02808000
+ RESULT:=0; SCANNER; 02809000
+ FPART: TCOUNT:=COUNT; 02810000
+ C:=C|1.0; 02811000
+ RESULT:=7; SCANNER; 02812000
+ IF T:=EXAMIN(NCR)>9 THEN 02813000
+ IF T="-" OR T = "+" THEN 02814000
+ BEGIN 02815000
+ RESULT:=0; SCANNER; 02816000
+ TCOUNT:=COUNT; 02817000
+ END 02818000
+ ELSE FLAG(47); 02819000
+ RESULT:=0; SCANNER; 02820000
+ IF RESULT ! 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000
+ Q:=ACCUM[1]; 02822000
+ IF GT1:=T:=(IF T="-" THEN -CONVERT ELSE CONVERT)<-46 OR 02823000
+ T>69 THEN FLAG(269) 02824000
+ ELSE BEGIN 02825000
+ T:=TEN[ABS(GT3:=T-FSAVE)]; 02826000
+ IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] 02827000
+ + 12) >63 THEN FLAG(269) 02828000
+ ELSE IF DPTOG THEN 02829000
+ IF GT1<0 THEN 02830000
+ BEGIN 02831000
+ GT1:=-GT1; 02832000
+ DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000
+ FOR GT2:=12 STEP 12 UNTIL GT1 DO 02834000
+ DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO); 02835000
+ END 02836000
+ ELSE BEGIN 02837000
+ DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,|,:=,NHI,NLO); 02838000
+ FOR GT2:=12 STEP 12 UNTIL GT1 DO 02839000
+ DOUBLE( NHI,NLO,TEN[12],0,|,:=,NHI,NLO); 02840000
+ END 02841000
+ ELSE C:=IF GT3<0 THEN C/T ELSE C|T; 02842000
+ END; 02843000
+ END 02844000
+ ELSE IF FSAVE ! 0 THEN C:=C/TEN[FSAVE]; 02845000
Q:=ACCUM[1]; RESULT:=3; 02846000
FINISHNUMBER: 02847000
T:=0; 02848000
@@ -3323,7 +3323,7 @@ COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02853000
OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS 02862000
ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, 02863000
SHOULD THIS BE REQUIRED. ; 02864000
-IDENT: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!=0 THEN 02865000
+IDENT: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!0 THEN 02865000
BEGIN 02866000
IF INFO[GT1:=T.LINKR,(GT2:=T.LINKC)+1]=Q THEN 02867000
BEGIN 02868000
@@ -3339,24 +3339,24 @@ ROSE: GT1:=T.LINKR; 02875000
IF T = INFO[GT1, GT2] THEN BEGIN %101-02877010
T:= 0; GO TO COMPLETE END; %101-02877020
T:=INFO[GT1,GT2]; 02878000
- IF INFO[GT1,GT2+1]&0[1:1:11]!= Q THEN GO ROSE; 02879000
- IF COUNT<= 5 THEN GO COMPOST ; 02880000
+ IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO ROSE; 02879000
+ IF COUNT { 5 THEN GO COMPOST ; 02880000
IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE; 02881000
COMPOST: T:=T>1[35:43:5]>2[40:40:8]; 02882000
- IF GT1!=1 AND NOT MACROID THEN % NOT RESERVED WORD %116-02882100
+ IF GT1 !1 AND NOT MACROID THEN % NOT RESERVED WORD %116-02882100
XREFIT(T,LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY %116-02882200
COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02883000
IF NOT ENDTOG THEN 02884000
BEGIN 02885000
IF GT1:=T.CLASS = COMMENTV THEN 02886000
BEGIN 02887000
- WHILE EXAMIN(NCR)!= ";" DO 02888000
+ WHILE EXAMIN(NCR) ! ";" DO 02888000
BEGIN RESULT:=6; COUNT:=0; SCANNER END; 02889000
RESULT:=0;SCANNER;GO SCANAGAIN 02890000
END 02891000
END; 02892000
IF STOPDEFINE THEN GO COMPLETE; 02893000
- IF GT1!= DEFINEDID THEN GO COMPLETE; 02894000
+ IF GT1 ! DEFINEDID THEN GO COMPLETE; 02894000
COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000
IF BOOLEAN(T,MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000
GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000
@@ -3364,7 +3364,7 @@ COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000
BEGIN FLAG(139);GO ARGH END; 02899000
DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000
LASTUSED:=T.DYNAM; 02901000
- DEFINEARRAY[DEFINEINDEX+2]262144xLCR+NCR; 02902000
+ DEFINEARRAY[DEFINEINDEX+2]262144|LCR+NCR; 02902000
LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02903000
PUTSEQNO(GT4,LCR); 02904000
TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3; 02905000
@@ -3382,7 +3382,7 @@ COMPLETE: 02909000
BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700
END; 02910800
STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000
- IF NXTELBT:=NXTELBT+! > 74 THEN 02912000
+ IF NXTELBT:=NXTELBT+ ! > 74 THEN 02912000
IF NOT MACROID THEN 02913000
BEGIN 02914000
COMMENT ELBAT IS FULL: ADJUST IT; 02915000
@@ -3425,51 +3425,51 @@ INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE,NAME) %106-02927100
); %106-02927330
DS:=LIT" "); %106-02927340
DS:=2 LIT" "); %106-02927350
- END OF OCTALWORDS; %106-02927360
- %********** S T A R T ********** %106-02927370
- NSEGS:=(SIZE+29) DIV 30; %106-02927380
- IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN %106-02927390
- DA:=CHUNKxT; %106-02927400
- MOVEANDBLOCK:=DA; %106-02927410
- IF CODEFILE THEN %106-02927420
- IF NAME>=0 THEN %106-02927430
- WRITE(LINE,FMT[NAME],DA) %106-02927440
- ELSE %106-02927450
- WRITE(LINE,FMT[7],ABS(NAME),DA); %106-02927460
- IF SIZE!=0 THEN %106-02927470
- BEGIN %106-02927480
- FOR J:=0 STEP 30 WHILE J < SIZE DO %106-02927490
- BEGIN %106-02927500
- IF (K:=(128-(J MOD 128))) < 30 THEN %106-02927510
- BEGIN %106-02927520
- MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927530
- MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); %106-02927540
- END %106-02927550
- ELSE %106-02927560
- MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927570
- IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION %106-02927580
- BEGIN %106-02927590
- K:=0; %106-02927600
- MOVE(1,K,CODE(SIZE-J)); %106-02927610
- IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD %106-02927612
- MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); %106-02927620
- END; %106-02927630
- IF CODEFILE THEN %106-02927640
- BEGIN %106-02927650
- FOR K:=0 STEP 5 WHILE K<=25 AND (J+K)<=SIZE DO %106-02927660
- BEGIN %106-02927670
- BLANKET(14,A); %106-02927680
- OCTALWORDS(J+K,IF (J_K+5)<=SIZE THEN 5 ELSE %106-02927690
- SIZE-J-K,CODE(K),A); %106-02927700
- WRITE(LINE,15,A[*]); %106-02927710
- END; %106-02927720
- WRITE(LINE); %106-02927722
- END; %106-02927730
- WRITE(CODE[DA]); DA:=DA+1; %106-02927740
- END; %106-02927750
- END; %106-02927760
- END OF MOVEANDBLOCK; %106-02927770
-COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE NEXT FORMAT GENERA02928000TOR.
+ END OF OCTALWORDS; %106-02927360
+ %********** S T A R T ********** %106-02927370
+ NSEGS:=(SIZE+29) DIV 30; %106-02927380
+ IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN %106-02927390
+ DA:=CHUNK|T; %106-02927400
+ MOVEANDBLOCK:=DA; %106-02927410
+ IF CODEFILE THEN %106-02927420
+ IF NAME}0 THEN %106-02927430
+ WRITE(LINE,FMT[NAME],DA) %106-02927440
+ ELSE %106-02927450
+ WRITE(LINE,FMT[7],ABS(NAME),DA); %106-02927460
+ IF SIZE!0 THEN %106-02927470
+ BEGIN %106-02927480
+ FOR J:=0 STEP 30 WHILE J < SIZE DO %106-02927490
+ BEGIN %106-02927500
+ IF (K:=(128-(J MOD 128))) < 30 THEN %106-02927510
+ BEGIN %106-02927520
+ MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927530
+ MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); %106-02927540
+ END %106-02927550
+ ELSE %106-02927560
+ MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); %106-02927570
+ IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION %106-02927580
+ BEGIN %106-02927590
+ K:=0; %106-02927600
+ MOVE(1,K,CODE(SIZE-J)); %106-02927610
+ IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD %106-02927612
+ MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); %106-02927620
+ END; %106-02927630
+ IF CODEFILE THEN %106-02927640
+ BEGIN %106-02927650
+ FOR K:=0 STEP 5 WHILE K{25 AND (J+K){SIZE DO %106-02927660
+ BEGIN %106-02927670
+ BLANKET(14,A); %106-02927680
+ OCTALWORDS(J+K,IF (J~K+5){SIZE THEN 5 ELSE %106-02927690
+ SIZE-J-K,CODE(K),A); %106-02927700
+ WRITE(LINE,15,A[*]); %106-02927710
+ END; %106-02927720
+ WRITE(LINE); %106-02927722
+ END; %106-02927730
+ WRITE(CODE[DA]); DA:=DA+1; %106-02927740
+ END; %106-02927750
+ END; %106-02927760
+ END OF MOVEANDBLOCK; %106-02927770
+COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02928000
IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000
PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000
NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000
@@ -3481,11 +3481,11 @@ DEBLANK: 02935000
BEGIN 02937000
RESULT:=7; SCANNER; 02938000
END; 02939000
- IF EXAMIN(NCR)<= 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000
+ IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000
BEGIN 02941000
RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000
IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000
- ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023.02944000
+ ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000
END 02945000
ELSE IF EXAMIN(NCR)="%" THEN 02946000
BEGIN 02947000
@@ -3519,7 +3519,7 @@ COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 02963500
ELSE IF Q="3OR000" THEN OROP 02965000
ELSE IF Q="3EQV00" THEN EQVOP 02965500
ELSE 0; 02966000
- IF T!=0 THEN BATMAN.CLASS:=T 02966500
+ IF T!0 THEN BATMAN.CLASS:=T 02966500
ELSE BATMAN:=1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION. 02967000
EXIT: 02967500
NEXT:=MYCLASS:=BATMAN.CLASS; 02968000
@@ -3528,7 +3528,7 @@ EXIT: 02967500
BEGIN 02969500
BOOLEAN B; 02970000
B:=BOOLPRIM; 02970500
- WHILE MYCLASS>=EQVOP AND MYCLASS<=ANDOP DO BOOLCOMP(B); 02971000
+ WHILE MYCLASS}EQVOP AND MYCLASS{ANDOP DO BOOLCOMP(B); 02971000
BOOLEXP:=B 02971500
END BOOLEXP; 02972000
BOOLEAN PROCEDURE BOOLPRIM; 02972500
@@ -3539,9 +3539,9 @@ EXIT: 02967500
IF MYCLASS=LEFTPAREN THEN 02975000
BEGIN 02975500
B:=BOOLEXP; 02976000
- IF MYCLASS!=RTPAREN THEN FLAG(604); 02976500
+ IF MYCLASS!RTPAREN THEN FLAG(604); 02976500
END 02977000
- ELSE IF MYCLASS!=BOOID THEN FLAG(601) 02977500
+ ELSE IF MYCLASS!BOOID THEN FLAG(601) 02977500
ELSE B:=BATMAN<0; 02978000
IF KNOT THEN B:=NOT B; SKIPIT; 02978500
BOOLPRIM:=B 02979000
@@ -3580,8 +3580,8 @@ COMMENT#################################################################02986000
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
+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
@@ -3607,47 +3607,47 @@ COMMENT#################################################################02986000
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
+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
+INTEGER PROCEDURE GETSPACE(S,L); VALUE S,L; 03051000
+ INTEGER L; BOOLEAN S; FORWARD; 03051001
PROCEDURE FORSTMT; FORWARD; 03052000
03053000
- PROCEDURE F; FORWARD; 03054000
- PROCEDURE ENTRY(TYPE); VALUE TYPE; REAL TYPE; FORWARD; 03055000
- PROCEDURE FORMATGEN;FORWARD; 03056000
- PROCEDURE EXPLICITFORMAT; FORWARD; 03056100
- BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; 03056200
- PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000
- PROCEDURE JUMPCHKNX; FORWARD; 03058000
- PROCEDURE JUMPCHKX; FORWARD; 03059000
+PROCEDURE F; FORWARD; 03054000
+PROCEDURE ENTRY(TYPE); VALUE TYPE; REAL TYPE; FORWARD; 03055000
+PROCEDURE FORMATGEN;FORWARD; 03056000
+PROCEDURE EXPLICITFORMAT; FORWARD; 03056100
+BOOLEAN PROCEDURE FORMATPHRASE; FORWARD; 03056200
+PROCEDURE PUTNBUMP(P1); VALUE P1; REAL P1; FORWARD; 03057000
+PROCEDURE JUMPCHKNX; FORWARD; 03058000
+PROCEDURE JUMPCHKX; FORWARD; 03059000
PROCEDURE DBLSTMT; FORWARD; 03060000
PROCEDURE READSTMT; FORWARD; 03061000
- INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N; FORWARD ; 03061010
+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 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
+REAL PROCEDURE LISTGEN; FORWARD; 03077000
PROCEDURE UNKNOWNSTMT; FORWARD; 03078000
PROCEDURE FAULTSTMT; FORWARD; 03079000
PROCEDURE FAULTDEC; FORWARD; 03080000
PROCEDURE SORTSTMT; FORWARD; 03081000
PROCEDURE MERGESTMT; FORWARD; 03082000
PROCEDURE CASESTMT; FORWARD; 03083000
- PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000
+PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; FORWARD; 03084000
ALPHA PROCEDURE BUGGER(S); VALUE S; INTEGER S; FORWARD; 03100000
COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 04000000
ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 04001000
@@ -3662,9 +3662,9 @@ COMMENT#################################################################02986000
PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000
INTEGER REPEAT,OPERATOR; 04011000
BEGIN 04012000
- IF REPEAT>=64 THEN FLAG(268); 04013000
+ IF REPEAT}64 THEN FLAG(268); 04013000
EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000
- COMMENT EMITV EMITS AND OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND04015000
+ 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
@@ -3701,289 +3701,289 @@ PROCEDURE EMITC(REPEAT,OPERATOR); VALUE REPEAT,OPERATOR; 04010000
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
+ 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
+ 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
+ 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
+ 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; %04078500A
- 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 LNG04091000
- 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, BOOCOMP04095000,
- AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000
- EMITLNG; 04097000
- PROCEDURE EMITLNG; 04098000
- BEGIN LABEL E; 04099000
- IF NOT LINKTOG THEN GO TO E; 04100000
- COMMENT GO TO E IF LAST THING IS A LINK; 04101000
- IF GET(L) ! 0 THEN GO TO E; 04102000
- COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000
- LNG OR RELATIONAL OPERATOR; 04104000
- IF GT1 _ GET(L-1) = 77 THEN L _ L-1 04105000
- COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000
- ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000
- COMMENT LAST THING WAS A RELATIONAL; 04108000
- BEGIN L_L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000
- BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000
- COMMENT NEGATE THE RELATIONAL; END ELSE 04111000
- E: EMITO(LNG) END EMITLNG; 04112000
- COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000
- PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000
- VALUE BRANCH,FROM,TOWARDS; 04115000
- INTEGER BRANCH,FROM,TOWARDS; 04116000
- BEGIN 04117000
- INTEGER TL; 04118000
- TL _ L; 04119000
- L _ FROM-2; 04120000
- GT1 _ TOWARDS-FROM; 04120100
- IF TOWARDS.[46:2] = 0 04120200
- THEN BEGIN 04120300
- BRANCH _ BRANCH&1[39:47:1]; 04120400
- GT1 _ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500
- EMITNUM(ABS(GT1)); 04121000
- EMITO(BRANCH&(REAL(GT1>=0)+1)[42:46:2]); 04122000
- IF BOOLEAN(BRANCH.[38:1]) THEN DIALA _ DIALB _ 0; 04123000
- L _ TL; 04124000
- END EMITB; 04125000
- COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000
- OCTAL, NAMELY : 04127000
- 1. 4 CHARACTERS FOR THE L REGISTER. 04128000
- 2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000
- STREAM PROCEDURE DEBUGWORD( SFQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000
- BEGIN 04131000
- DI_FEIL; SI_ LOC SEQ; SI_ SI+4; DS _ 4 CHR; 04132000
- DS _ 2 LIT" "; 04133000
- SI _ LOC CODE ; 04134000
- 16( DS _ 3 RESET; 3( IF SB THEN DS_SET ELSE 04135000
- DS _ RESET ; SKIP 1 SB)); 04136000
- 49(DS _ 2 LIT " "); 04137000
- END ; 04138000
- COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000
- DEBUGGING IS REQUIRED. "L" AND "WORD" ARE OUTPUT ON 04140000
- THE PRINTER FILE IN OCTAL FORMAT. ; 04141000
- PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000
- BEGIN 04143000
- ADJUST; 04144000
- IF L>=4092 THEN ERR(200); 04145000
- ELSE BEGIN 04146000
- MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000
- IF DEBUGTOG THEN 04148000
- BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000
- WRITELINE END; 04150000
- L_L+4 END 04151000
- END EMITWORD; 04152000
- COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000
- BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000
- EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000
- OF C-RELATIVE OPDC S LEFT BY EMITNUM, IF C-RELATIVE 04156000
- ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000
- IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000
- THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000
- AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000
- F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000
- CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000
- PROCEDURE CONSTANTCLEAN ; 04163000
- IF MRCLEAN THEN 04164000
- BEGIN 04165000
- INTEGER J,TEMPL,D,LINK; 04166000
- BOOLEAN CREL; 04167000
- LABEL ALLTHU ; 04168000
- DIALA _ DIALB _ 0; 04169000
- FOR J _ 1 STEP 2 UNTIL LASTENTRY DO 04170000
- BEGIN 04171000
- ADJUST; TEMPL_L; L_INFO[0.255-J+1]; 04172000
- CREL _ FALSE; 04173000
- DO BEGIN 04174000
- IF D_(TEMPL-L+3)DIV 4>=128 THEN 04175000
- BEGIN 04176000
- NCII_NCII+1; 04177000
- PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000
- PUTNBUMP(TAKE(255-J)); LASTINFO_NEXTINFO-2; 04179000
- GO TO ALLTHU; 04180000
- END; 04181000
- LINK_GET(L); 04182000
- CREL _ TRUE; 04183000
- EMITV(D + 768); 04184000
- END UNTIL L_ LINK = 4095 ; 04185000
- ALLTHU: L _ TEMPL; 04186000
- IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000
- END; 04188000
- LASTENTRY _ 0; 04189000
- END ; 04190000
- COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000
- EXPLICIT AND IMPLICIT, IN EVERY CASE,EMITNUM WILL 04192000
- PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000
- THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000
- SYLLABLE IS PRODUCED, HOWEVER,NON-LITERALS ARE KEPT 04195000
- IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000
- POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000
- CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000
- TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000
- IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000
- ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000
- OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000
-PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000
- BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000
- IF C.[1:37]=0 THEN EMITL(C) 04205000
- ELSE 04206000
- BEGIN 04207000
- FOR N _ 1 STEP 2 UNTIL LASTENTRY DO 04208000
- IF INFO[0,255-N] = C THEN GO TO FOUND ; 04209000
- INFO[0,255 -LASTENTRY] _ L; 04210000
- INFO[0,255 -LASTENTRY-1]_ C ; 04211000
- EMITN(1023); 04212000
- LINKTOG_FALSE; 04213000
- IF LASTENTRY _ LASTENTRY+2>= 128 THEN 04214000
- BEGIN 04215000
- C _ BUMPL; 04216000
- CONSTANTCLEAN; 04217000
- EMITB(BFW,C,L); 04218000
- END; 04219000
- GO TO FINISHED; 04220000
- FOUND: EMIT(INFO[0,255 -N+1]); 04221000
- LINKTOG_FALSE; 04222000
- INFO[0,255-N+1]_ L-1; 04223000
- END; 04224000
- FINSIHED:END EMITNUM ; 04225000
- COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000
- ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000
- MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000
- BE FOUND SEARCH YIELDS BLANKS. 04229000
- NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000
-ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000
- BEGIN LABEL L; 04232000
- COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000
- BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000
- AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000
- THE LENGTH OF Q IS 128. ; 04236000
- INTEGER N,I ; 04237000
- N _ 64 ; 04238000
- FOR I _ 66 STEP IF Q[I]=1 DO 04240000
- IF Q[ I ]=KEY THEN GO TO L ; 04241000
- I _0; COMMENT ARGUMENT NOT FOUND,SEARCH=Q[1] ; 04242000
- L: SEARCH_Q[ I +1] ; 04243000
- END SEARCH ; 04244000
- COMMENT B2D CONVERTS THE FOUR LOW ORDER OCTAL DIGITS TO BCD 04245000
- CODE ; 04246000
-ALPHA PROCEDURE B2D(B); VALUE B; REAL B; 04247000
- B2D_0&B[45:45:3]&B[39:42:3]&B[33:39:3]&B[27:36:3] ; 04248000
- COMMENT PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE 04265000
- INTO THE EDOC ARRAY. THE SPECIFIC ELEMENT OF EDOC 04266000
- IS PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128] 04267000
- SYLLABLE POSITION=(L MOD 4 ). WHERE L IS THE SYLLABLE 04268000
- NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT; 04269000
-STREAM PROCEDURE PACK(WORD,POSITION,SYLLABLE); 04270000
- VALUE POSITION,SYLLABLE; 04271000
- BEGIN 04272000
- DI_WORD ; DI _ DI+POSITION ; DI _ DI_POSITION; 04273000
- SI_LOC SYLLABLE ; SI_SI+6; 04274000
- DS_2 CHR ; 04275000
- END PACK ; 04276000
-PROCEDURE DEBUG(S); 04277000
- VALUE S; REAL S ; 04278000
- IF STREAMTOG THEN 04279000
- IF SINGLTOG THEN 04279100
- WRITE(LINE,BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]),B2D(S)); 04279200
- ELSE 04279300
- WRITE(LINE[DBL],BUG,B2D(L),COP[S.[42:6],B2D(S.[36:6]), 04280000
- B2D(S)) 04281000
+ 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( SFQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000
+ BEGIN 04131000
+ DI~FEIL; SI~ LOC SEQ; SI~ SI+4; DS ~ 4 CHR; 04132000
+ DS ~ 2 LIT" "; 04133000
+ SI ~ LOC CODE ; 04134000
+ 16( DS ~ 3 RESET; 3( IF SB THEN DS~SET ELSE 04135000
+ DS ~ RESET ; SKIP 1 SB)); 04136000
+ 49(DS ~ 2 LIT " "); 04137000
+ END ; 04138000
+ COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000
+ DEBUGGING IS REQUIRED. "L" AND "WORD" ARE OUTPUT ON 04140000
+ THE PRINTER FILE IN OCTAL FORMAT. ; 04141000
+ PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000
+ BEGIN 04143000
+ ADJUST; 04144000
+ IF L}4092 THEN ERR(200); 04145000
+ ELSE BEGIN 04146000
+ MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000
+ IF DEBUGTOG THEN 04148000
+ BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000
+ WRITELINE END; 04150000
+ L~L+4 END 04151000
+ END EMITWORD; 04152000
+ COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000
+ BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000
+ EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000
+ OF C-RELATIVE OPDC S LEFT BY EMITNUM, IF C-RELATIVE 04156000
+ ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000
+ IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000
+ THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000
+ AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000
+ F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000
+ CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000
+ PROCEDURE CONSTANTCLEAN ; 04163000
+ IF MRCLEAN THEN 04164000
+ BEGIN 04165000
+ INTEGER J,TEMPL,D,LINK; 04166000
+ BOOLEAN CREL; 04167000
+ LABEL ALLTHU ; 04168000
+ DIALA ~ DIALB ~ 0; 04169000
+ FOR J ~ 1 STEP 2 UNTIL LASTENTRY DO 04170000
+ BEGIN 04171000
+ ADJUST; TEMPL~L; L~INFO[0.255-J+1]; 04172000
+ CREL ~ FALSE; 04173000
+ DO BEGIN 04174000
+ IF D~(TEMPL-L+3)DIV 4}128 THEN 04175000
+ BEGIN 04176000
+ NCII~NCII+1; 04177000
+ PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000
+ PUTNBUMP(TAKE(255-J)); LASTINFO~NEXTINFO-2; 04179000
+ GO TO ALLTHU; 04180000
+ END; 04181000
+ LINK~GET(L); 04182000
+ CREL ~ TRUE; 04183000
+ EMITV(D + 768); 04184000
+ END UNTIL L~ LINK = 4095 ; 04185000
+ ALLTHU: L ~ TEMPL; 04186000
+ IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000
+ END; 04188000
+ LASTENTRY ~ 0; 04189000
+ END ; 04190000
+ COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000
+ EXPLICIT AND IMPLICIT, IN EVERY CASE,EMITNUM WILL 04192000
+ PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000
+ THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000
+ SYLLABLE IS PRODUCED, HOWEVER,NON-LITERALS ARE KEPT 04195000
+ IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000
+ POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000
+ CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000
+ TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000
+ IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000
+ ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000
+ OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000
+ PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000
+ BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000
+ IF C.[1:37]=0 THEN EMITL(C) 04205000
+ ELSE 04206000
+ BEGIN 04207000
+ FOR N ~ 1 STEP 2 UNTIL LASTENTRY DO 04208000
+ IF INFO[0,255-N] = C THEN GO TO FOUND ; 04209000
+ INFO[0,255 -LASTENTRY] ~ L; 04210000
+ INFO[0,255 -LASTENTRY-1]~ C ; 04211000
+ EMITN(1023); 04212000
+ LINKTOG~FALSE; 04213000
+ IF LASTENTRY ~ LASTENTRY+2 } 128 THEN 04214000
+ BEGIN 04215000
+ C ~ BUMPL; 04216000
+ CONSTANTCLEAN; 04217000
+ EMITB(BFW,C,L); 04218000
+ END; 04219000
+ GO TO FINISHED; 04220000
+ FOUND: EMIT(INFO[0,255 -N+1]); 04221000
+ LINKTOG~FALSE; 04222000
+ INFO[0,255-N+1]~ L-1; 04223000
+ END; 04224000
+ FINSIHED:END EMITNUM ; 04225000
+ COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000
+ ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000
+ MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000
+ BE FOUND SEARCH YIELDS BLANKS. 04229000
+ NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000
+ ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000
+ BEGIN LABEL L; 04232000
+ COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000
+ BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000
+ AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000
+ THE LENGTH OF Q IS 128. ; 04236000
+ INTEGER N,I ; 04237000
+ N ~ 64 ; 04238000
+ FOR I ~ 66 STEP IF Q[I]=9 THEN 04604000
- BEGIN BUGGER_POP[IF Q!10 THEN Q-5 ELSE OP.[42:2]]; 04605000
- WOP[1]_(IF 1- 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
+ END; 04526000
+ IF B = 0 THEN 04526100
+ BEGIN EMIT21(E,FALSE); GO TO EXIT END; 04526200
+ IF STACK ! 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 MODE 6)|64+DIA); 04550000
+ EMIT((A+B-1) DIV 6 -T1+1)|512+64|S+37); 04551000
+ GO TO EXIT; 04552000
+ END; 04553000
+ EMIT(0); 04554000
+ EMIT21(E,TRUE); 04555000
+ EMITD(A,48-B,B); 04556000
+ EXIT: END; 04558000
+ ALPHA PROCEDURE BUGGER(OP); VALUE OP; INTEGER OP; 04600000
+ BEGIN INTEGER Q; 04601000
+ WOP[1]~" "; 04602000
+ IF BUGGER~SEARCH(WOP,OP)=" " THEN 04603000
+ IF Q~OP.[44:4]}9 THEN 04604000
+ BEGIN BUGGER~POP[IF Q!10 THEN Q-5 ELSE OP.[42:2]]; 04605000
+ WOP[1]~(IF 1- THEN OP.[39:3]&OP[41:38:1] ELSE 04606000
+ OP.[41:3]&OP[39:38:3])&" "[24:36:12]; 04607000
+ END; END BUGGER; 04608000
PROCEDURE CHECKDISJOINT(A); VALUE A; INTEGER A; 04609000
BEGIN 04610000
IF LEVEL > SUBLEVEL+1 THEN 04611000
@@ -4052,14 +4052,14 @@ BEGIN 04610000
END CHECKDISJOINT; 04617000
COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000
COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000
- PROCEDURE STEPIT; ELCASS _ TABLE(I_I+1); 05002000
- INTEGER PROCEDURE STEPI; STEPI+ELCLASS_TABLE(I_I+1); 05003000
+ PROCEDURE STEPIT; ELCASS ~ TABLE(I~I+1); 05002000
+ INTEGER PROCEDURE STEPI; STEPI+ELCLASS~TABLE(I~I+1); 05003000
COMMENT TAKE FETCHS A WORD FROM INFO; 05004000
REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000
- TAKE _ INFO[INDEX,LINKR,INDEX,LINKC]; 05006000
+ 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
+ INFO[INDEX,LINKR,INDEX,LINKC] ~ WORD; 05009000
COMMENT FLAG FLAGS ERROR MESSAGES. COUNTS THEM AND SUPRESS FUTURE 05010000
ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;05011000
PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000
@@ -4070,22 +4070,22 @@ END CHECKDISJOINT; 04617000
VALUE ERRNUM,COUNT; 05017000
BEGIN 05018000
DI:=LINE; 11(DS:=8 LIT " "); % BLANK LINE 05019000
- SI _LSTSEQ; SI _ SI-8; DS _WDS; 05020000
+ SI ~LSTSEQ; SI ~ SI-8; DS ~WDS; 05020000
DS:=24 LIT " <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 05021000
- SI _ LSTSEQ; DI _ LSTSEQ; DI _ DI-8; DS _ WDS; 05023000
- DI_LINE; SI_RMT; SI_SI+7; 05024000
+ SI ~ LSTSEQ; DI ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000
+ DI~LINE; SI~RMT; SI~SI+7; 05024000
IF SC="1" THEN 05024100
- BEGIN SI_LSTSEQ; DS_10 LIT "NEAR LINE "; 05024200
+ BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200
7(IF SC>"0" THEN JUMP OUT; 05024300
- SI_SI+1; TALLY_TALLY+1); 05024400
- RMT_TALLY; DS_8 CHR; DI_DI-RMT; 05024500
- END ELSE DI_DI+7; 05024600
- DS_14 LIT " ERROR NUMBER "; 05025000
- SI _ LOC ERRNUM; DS _ 3 DEC; COMMENT CONVERT ERRNUM; 05026000
- DS _ 4 LIT " -- "; 05027000
- SI _ ACCUM; SI _ SI+3; DS _ COUNT CHR; 05028000
+ SI~SI+1; TALLY~TALLY+1); 05024400
+ RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500
+ END ELSE DI~DI+7; 05024600
+ DS~14 LIT " ERROR NUMBER "; 05025000
+ SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000
+ DS ~ 4 LIT " -- "; 05027000
+ SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000
COMMENT PLACE ALPHA IN BUFFER; 05029000
- DS _ LIT "." 05030000
+ DS ~ LIT "." 05030000
END WRITERROR; 05031000
IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000
BEGIN 05033000
@@ -4093,25 +4093,25 @@ END CHECKDISJOINT; 04617000
ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000
IF NOT(LISTER OR REMOTOG) THEN 05036000
BEGIN 05037000
- EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); %114- 05038000
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LINE[12]); 05039000
+ EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); %114-05038000
+ MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039000
IF NOHEADING THEN DATIME; WRITELINE; 05039500
END; 05041000
- COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000
- ACCUM[1] _ Q; COMMENT RESTORE ACCUMULATOR; 05043000
+ COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000
+ ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000
WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000
INFO[LASTSEQROW,LASTSEQUENCE]); 05045000
- IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900
- IF NOT HEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000
- ERRORTOG _ FALSE; COMMENT INHIBIT MESSAGES; 05047000
+ IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900
+ IF NOT NOHEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000
+ ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000
IF PUNCHTOG THEN 05048000
BEGIN 05049000
STREAM PROCEDURE PUNCH(FL,ST); 05050000
VALUE ST; 05051000
BEGIN 05052000
- DI _ FL; 05053000
- SI _ ST; 05054000
- DS _ 9 WDS 05055000
+ 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
@@ -4124,49 +4124,49 @@ COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000
SEMICOLON, END, OR BEGIN; 05104000
PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000
BEGIN FLAG(ERRNUM); 05106000
- I _ I-1; 05107000
+ I ~ I-1; 05107000
IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100
IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200
DO IF STEPI = BEGINV THEN STMT UNTIL 05108000
ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000
-DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000
-COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000
- UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000
- PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000
- BEGIN 05114000
- IF MODE>= 2 THEN 05115000
- IF GTI1 _ ELBATWORD.LVL >=FRSTLEVEL THEN 05116000
- IF GTI1 < SUBLEVEL THEN 05117000
- IF ELBATWORD.[9:2] ! 1 05118000
- THEN BEGIN FLAG(101); ERRORTOG _ TRUE END 05119000
- END CHECKER; 05120000
- COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000
- GIVEN THE LINK TO THE ELBAT WORD; 05122000
-INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000
- GIT _ TAKE(L).INCR+L.LINK; 05124000
-COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000
- IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000
- GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000
-INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000
- BEGIN 05129000
- REAL A; 05130000
- IF FNAT _(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 THE CODE THAT BRINGS TO TOP OF STACK A DESCRIP05134000TOR
- 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
- ADRES _ ELBAT[I].ADDRESS; 05140000
- IF ELCLASS = SUPERFILEID 05141000
- THEN BEGIN 05142000
- BANA; EMITN(ADDRESS); EMITO(LOD) END 05143000
- ELSE BEGIN 05144000
- IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000
- STEPIT; 05146000
- EMITN(DDRES) END END PASSFILE; 05147000
+ DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000
+ COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000
+ UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000
+ PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000
+ BEGIN 05114000
+ IF MODE } 2 THEN 05115000
+ IF GTI1 ~ ELBATWORD.LVL }FRSTLEVEL THEN 05116000
+ IF GTI1 < SUBLEVEL THEN 05117000
+ IF ELBATWORD.[9:2] ! 1 05118000
+ THEN BEGIN FLAG(101); ERRORTOG ~ TRUE END 05119000
+ END CHECKER; 05120000
+ COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000
+ GIVEN THE LINK TO THE ELBAT WORD; 05122000
+ INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000
+ GIT ~ TAKE(L).INCR+L.LINK; 05124000
+ COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000
+ IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000
+ GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000
+ INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000
+ BEGIN 05129000
+ REAL A; 05130000
+ IF FNAT ~(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
+ ADRES ~ ELBAT[I].ADDRESS; 05140000
+ IF ELCLASS = SUPERFILEID 05141000
+ THEN BEGIN 05142000
+ BANA; EMITN(ADDRESS); EMITO(LOD) END 05143000
+ ELSE BEGIN 05144000
+ IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000
+ STEPIT; 05146000
+ EMITN(DDRES) END END PASSFILE; 05147000
PROCEDURE PASSMONFILE(ADDRESS); 05148000
VALUE ADDRESS ; 05149000
REAL ADDRESS ; 05150000
@@ -4186,9 +4186,9 @@ PROCEDURE PASFILE; 05157000
REGISTER SETTING FOR THE SAVE OR 05164000
RELEASE LITERAL THAT GETS PASSED TO 05165000
KEN MYERS; 05166000
- EMITO(MKS); L_(LTEMP_L)+1; EMITL(0); 05167000
- EMITL(2); CHECKER(ELBATWORD_ELBAT[I]); 05168000
- IF RRB1_(RRB2_ ELCLASS = SUPERFILEID)OR 05169000
+ 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
@@ -4208,7 +4208,7 @@ PROCEDURE PASFILE; 05157000
EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000
END CHECKPRESENCE; 05187000
COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 05187500
- TO THE TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510
+ TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510
PROCEDURE PASSLIST; 05187520
BEGIN 05187530
INTEGER LISTADDRESS; 05187540
@@ -4221,49 +4221,49 @@ COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 05187550
END 05187610
ELSE BEGIN EMITL(LISTADDRESS); STEPIT END; 05187620
END OF PASSLIST; 05187630
-REAL PROCEDURE TAKEFRST; 05188000
- TAKEFRST _ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000
-COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000
- DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000
- STACK; 05198000
-PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000
- BEGIN 05200000
- EMITPAIR(ADDRESS,LOD); 05201000
- EMITN(512); 05202000
- EMITD(33,18,15) END STUFFF; 05203000
-COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000
- PRESENT CODE; 05205000
-BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000
- VALUE ELBATWORD; REAL ELBATWORD; 05207000
- BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000
- NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000
- LOCAL _ TRUE END LOCAL; 05210000
-COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000
- PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000
- STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000
-PROCEDURE PASSFORMAT; 05214000
- BEGIN INTEGER ADRES; 05215000
- CHECKER(ELBAT[I]); 05216000
- ADRES _ ELBAT[I].ADDRESS; 05217000
- IF BOOLEAN(ELBAT[I].FORMAL) 05218000
- THEN BEGIN EMITV(ADRES); ADRES _ ADRES-1 END 05219000
- ELSE BEGIN 05220000
- IF TABLE(I) = SUPERFRMTID 05221000
- THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR) 05222000
- END; 05223000
- IF TABLE(I) = SUPERFRMTID 05224000
- THEN BEGIN BANA; I _ I-1; 05225000
- EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000
- EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000
-COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000
- WORDS - IT COMPLEMENTS THEIR STATE; 05229000
-PROCEDURE STREAMWORDS; 05230000
- BEGIN GT1 _ 0; 05231000
- DO BEGIN 05232000
- INFO[1,GT1].LINK_STACKHEAD[GT2_(T_INFO[1,GT1]).ADDRESS]; 05233000
- STACKHEAD[GT2] _ T.LINK; 05234000
- GT1 _ GT1+2; 05235000
- END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000
+ REAL PROCEDURE TAKEFRST; 05188000
+ TAKEFRST ~ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000
+ COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000
+ DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000
+ STACK; 05198000
+ PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000
+ BEGIN 05200000
+ EMITPAIR(ADDRESS,LOD); 05201000
+ EMITN(512); 05202000
+ EMITD(33,18,15) END STUFFF; 05203000
+ COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000
+ PRESENT CODE; 05205000
+ BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000
+ VALUE ELBATWORD; REAL ELBATWORD; 05207000
+ BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000
+ NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000
+ LOCAL ~ TRUE END LOCAL; 05210000
+ COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000
+ PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000
+ STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000
+ PROCEDURE PASSFORMAT; 05214000
+ BEGIN INTEGER ADRES; 05215000
+ CHECKER(ELBAT[I]); 05216000
+ ADRES ~ ELBAT[I].ADDRESS; 05217000
+ IF BOOLEAN(ELBAT[I].FORMAL) 05218000
+ THEN BEGIN EMITV(ADRES); ADRES ~ ADRES-1 END 05219000
+ ELSE BEGIN 05220000
+ IF TABLE(I) = SUPERFRMTID 05221000
+ THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR)05222000
+ END; 05223000
+ IF TABLE(I) = SUPERFRMTID 05224000
+ THEN BEGIN BANA; I ~ I-1; 05225000
+ EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000
+ EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000
+ COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000
+ WORDS - IT COMPLEMENTS THEIR STATE; 05229000
+ PROCEDURE STREAMWORDS; 05230000
+ BEGIN GT1 ~ 0; 05231000
+ DO BEGIN 05232000
+ INFO[1,GT1].LINK~STACKHEAD[GT2~(T~INFO[1,GT1]).ADDRESS];05233000
+ STACKHEAD[GT2] ~ T.LINK; 05234000
+ GT1 ~ GT1+2; 05235000
+ END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000
STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000
VALUE PRT,TYP,RELAD,SGNO; 05237500
BEGIN LOCAL COUNT; 05238000
@@ -4278,66 +4278,66 @@ STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000
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 MODE 05251000
- 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 GOTTON 05256000
- ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000
- PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000
- VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000
- BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000
- PDPRT[PDINX,[37:5],PDINX.[42:6]]_0&RELAD[18:36:10] 05261000
- &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000
- IF DEBUGTOG THEN 05263000
- BEGIN 05263500
- BLANKET(14,LIN); 05264000
- DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO)); 05264500
- IF NOHEADING THEN DATIME; WRITELINE; 05265000
- END; 05265100
- PDINX_PDINX+1;PROGDESCBLDR_SPAC END PROGDESCBLDR; 05266000
-COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000
- IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000
- LITERALS INVOLVED; 05269000
-BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000
- INTEGER FIRST,SECOND; 05271000
- BEGIN 05272000
- LABEL EXIT; 05273000
- IF STEPI = FIELDID THEN % GET INFO FROM INFO %117-05273100
- BEGIN %117-05273200
- FIRST := ELBAT[I].SBITF; %117-05273300
- SECOND := ELBAT[I].NBITF; %117-05273400
- GO TO EXIT; %117-05273500
- END %117-05273600
- ELSE %117-05273700
- IF ELCLASS = LFTBRKET THEN %117-05273800
- IF STEPI = FIELDID THEN %117-05273900
- BEGIN %117-05274000
- FIRST := ELBAT[I].SBITF; %117-05274100
- SECOND := ELBAT[I].NBITF; %117-05274200
- IF STEPI = RTBRKET THEN %117-05274300
- GO TO EXIT; %117-05274400
- END %117-05274500
- ELSE %117-05274600
- IF ELCLASS = LITNO THEN %117-05275000
- IF STEPI = COLON THEN 05276000
- IF STEPI = LITNO THEN 05277000
- IF STEPI = RTBRKET THEN 05278000
- COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000
- IF (FIRST _ ELBAT[I-3].ADDRESS) x 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
+ 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 GOTTON 05256000
+ ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000
+ PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000
+ VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000
+ BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000
+ PDPRT[PDINX,[37:5],PDINX.[42:6]]~0&RELAD[18:36:10] 05261000
+ &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000
+ IF DEBUGTOG THEN 05263000
+ BEGIN 05263500
+ BLANKET(14,LIN); 05264000
+ DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO));05264500
+ IF NOHEADING THEN DATIME; WRITELINE; 05265000
+ END; 05265100
+ PDINX~PDINX+1;PROGDESCBLDR~SPAC END PROGDESCBLDR; 05266000
+ COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000
+ IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000
+ LITERALS INVOLVED; 05269000
+ BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000
+ INTEGER FIRST,SECOND; 05271000
+ BEGIN 05272000
+ LABEL EXIT; 05273000
+ IF STEPI = FIELDID THEN % GET INFO FROM INFO %117-05273100
+ BEGIN %117-05273200
+ FIRST := ELBAT[I].SBITF; %117-05273300
+ SECOND := ELBAT[I].NBITF; %117-05273400
+ GO TO EXIT; %117-05273500
+ END %117-05273600
+ ELSE %117-05273700
+ IF ELCLASS = LFTBRKET THEN %117-05273800
+ IF STEPI = FIELDID THEN %117-05273900
+ BEGIN %117-05274000
+ FIRST := ELBAT[I].SBITF; %117-05274100
+ SECOND := ELBAT[I].NBITF; %117-05274200
+ IF STEPI = RTBRKET THEN %117-05274300
+ GO TO EXIT; %117-05274400
+ END %117-05274500
+ ELSE %117-05274600
+ IF ELCLASS = LITNO THEN %117-05275000
+ IF STEPI = COLON THEN 05276000
+ IF STEPI = LITNO THEN 05277000
+ IF STEPI = RTBRKET THEN 05278000
+ COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000
+ IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000
+ (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000
+ IF FIRST ~ SECOND {48 THEN 05282000
+ COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000
+ GO TO EXIT; 05284000
+ ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000
+ DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000
BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000
VALUE ELBATCLASS,ERRORNUMBER; 05288000
REAL ELBATCLASS,ERRORNUMBER; 05289000
@@ -4345,7 +4345,7 @@ BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000
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
+ IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000
THEN ERR(ERRORNUMBER); 05295000
END; 05296000
BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000
@@ -4355,27 +4355,27 @@ BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000
IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000
UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000
CLASS MUST BE IN ELCLASS; 05303000
- RANGE_ELCLASS >= LOWER AND ELCLASS <= UPPER; 05304000
-COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 05305000
- EMITTED; 05306000
-INTEGER PROCEDURE GET(L); VALUE L; REAL; 05307000
- BEGIN 05308000
- INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000
- BEGIN DI _ LOC GETSYL; DI _ DI+6; 05310000
- SI _ W; SI _ SI+S; SI + SI+S; DS _ 2 CHR END; 05311000
- GET _ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000
-COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000
- SCRIPTOR TO THE TOP OF THE STACK; 05314000
-PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000
- BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000
+ RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000
+ COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 05305000
+ EMITTED; 05306000
+ INTEGER PROCEDURE GET(L); VALUE L; REAL; 05307000
+ BEGIN 05308000
+ INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000
+ BEGIN DI ~ LOC GETSYL; DI ~ DI+6; 05310000
+ SI ~ W; SI ~ SI+S; SI + SI+S; DS ~ 2 CHR END; 05311000
+ GET ~ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000
+ COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000
+ SCRIPTOR TO THE TOP OF THE STACK; 05314000
+ PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000
+ BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000
REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000
VALUE SIZE ; 05318000
BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000
FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000
CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000
ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000
- DI_LOC GETALPHA; DS_8 LIT"0 "; D_DI-7; 05323000
- SI_INFOINDEX; SI_SI+3; DS_SIZE CHR; 05324000
+ DI~LOC GETALPHA; DS~8 LIT"0 "; D~DI-7; 05323000
+ SI~INFOINDEX; SI~SI+3; DS~SIZE CHR; 05324000
END GETALPHA; 05325000
PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010
BEGIN 05325020
@@ -4390,7 +4390,7 @@ PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010
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
+ 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
@@ -4436,145 +4436,145 @@ INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000
BOOLEAN PERMANENT; INTEGER L; 05333000
BEGIN LABEL L1,L2,EXIT; 05334000
BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000
- DI_LOC MASK; DI_DI+2; SKIP K DB; DS_SET END MASK; 05342000
+ DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000
BOOLEAN M,Q; 05343000
INTEGER ROW,COL,GS; 05344000
IF PERMANENT 05345000
THEN BEGIN 05346000
IF PRTIMAX>1022 THEN FLAG(148);% 05347000
- SPRT[GS_PRTIMAX.[38:5]] _ MASK(PRTIMAX.[43:5]-35) 05348000
+ SPRT[GS~PRTIMAX.[38:5]] ~ MASK(PRTIMAX.[43:5]-35) 05348000
OR SPRT[GS]; 05349000
- PRTIMAX _ (GS _ PRTIMAX)+1 END 05350000
+ PRTIMAX ~ (GS ~ PRTIMAX)+1 END 05350000
ELSE IF MODE = 0 THEN BEGIN 05351000
- Q _ SPRT[ROW _ PRTI.[38:5]]; 05352000
- M _ MASK(COL _ PRTI.[43:4]-35); 05353000
- COL _ COL+35; 05354000
- L1: IF REAL(M AND Q) ! 0 05355000
- THEN BEGIN 05356000
- IF REAL(BOOLEAN(GS_4294967296-REAL(M)) AND Q) = G05357000S
- 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 _ 32xROW+COL)+1; 05367000
- IF PRTI > PRTIMAX THEN PRTIMAX _ PRTI END 05368000
- ELSE BEGIN 05369000
- IF STACKCTR > 767 THEN FLAG(149); 05370000
- STACKCTR _ (GS _ STACKCTR)+1; Q _ FALSE; 05371000
- GO TO EXIT END; 05372000
- L2: IF GS>= 512 THEN GS _ GS+1024; 05373000
- Q _ TRUE; 05374000
- EXIT: GETSPACE _ GS; 05375000
- IF GS > 1023 THEN GS _ GS-1024; 05376000
- IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100
- END GETSPACE; 05378000
- COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 05379000
-BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000
- ARRAYCHECK_AAW.CLASSINTARRAYID 05381000
- OR AAW.INCR !1; 05382000
- COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000
-BOOLEAN PROCEDURE COMMACHECK; 05384000
- BEGIN IF NOT(COMMACHECK_(STEPI=COMMA)) THEN ERR(350); 05385000
- STEPIT 05386000
- END COMMACHECK; 05387000
- COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000
-BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000
- IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000
- IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK_TRUE ELSE 05390100
- IF TAKE(GT1_GIT(ELBW)!1 THEN ERR(537) ELSE 05391000
- IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000
- HVCHECK_TRUE; 05393000
- COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000
-BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000
- IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000
- IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK_TRUE ELSE 05396100
- IF TAKE(GT1_GIT(ELBW))!2 THEN ERR(352) ELSE 05397000
- IF TAKE(GT1_1).CLASS!BOOID THEN ERR(353) ELSE 05398000
- IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000
- OUTPROCHECK_TRUE; 05400000
- COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000
-BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000
- IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000
- IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK _ TRUE ELSE 05403100
- IF TAKE(GT1_GIT(ELBW))!2 THEN ERR(360) ELSE 05404000
- IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000
- IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000
- EQLESCHECK_TRUE; 05407000
-COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS; 06000000
-COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 06001000
-PROCEDURE AEXP; 06002000
- BEGIN 06003000
- IF ELCLASS = IFV 06004000
- THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000
- ELSE BEGIN ARITHSEC; SIMPARITH END 06006000
- END AEXP; 06007000
-COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000
- IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000
- AND Q ARE PRIMARIES; 06010000
-PROCEDURE ARITHSEC; 06011000
- BEGIN 06012000
- IF ELCLASS = ADOP 06013000
- THEN BEGIN 06014000
- STEPIT; 06015000
- IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000
- ELSE BEGIN 06017000
- PRIMARY; 06018000
- WHILE ELCLASS = FACTOP DO %WF 06019000
- BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000
- ENDTOG _ LINKTOG; EMITO(CHS); 06021000
- LINKTOG _ ENDTOG; ENDTOG _ FALSE END END 06022000
- ELSE PRIMARY END ARITHSEC; 06023000
-COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000
- ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000
- COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000
- WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000
- COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000
- SIMPARITH IS DONE BY ARITHCOMP. AN ARTIFIAL ROUTINE 06029000
- WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000
- ARITHOCMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000
-PROCEDURE SIMPARITH; 06032000
- BEGIN 06033000
- WHILE ELCLASS = AMPERSAND 06034000
- DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000
- WHILE ELCLASS>=ADOP AND ELCLASS<=FACTOP DO ARITHCOMP END;06036000
-COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000
- ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000
- EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000
- IS OBTAINED BY RECURSION; 06040000
-PROCEDURE ARITHCOMP; 06041000
- BEGIN INTEGER OPERATOR, OPCLASS; 06042000
- DO BEGIN 06043000
- OPERATOR _ 1 & ELBAT[I] [36:17:10]; 06044000
- COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000
- ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000
- OF THE ELBAT WORD; 06047000
- OPCLASS _ ELCLASS; 06048000
- STEPIT; PRIMARY; 06049000
- IF OPCLASS = FACTOP THEN EMITUP 06050000
- ELSE BEGIN 06051000
- WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000
- COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000
- STACKCT _ 1; %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
+ Q ~ SPRT[ROW ~ PRTI.[38:5]]; 05352000
+ M ~ MASK(COL ~ PRTI.[43:4]-35); 05353000
+ COL ~ COL+35; 05354000
+ L1: IF REAL(M AND Q) ! 0 05355000
+ THEN BEGIN 05356000
+ IF REAL(BOOLEAN(GS~4294967296-REAL(M)) AND Q) =GS 05357000
+ THEN BEGIN 05358000
+ COL ~ 0; M ~ TRUE; 05359000
+ IF ROW ~ ROW+1 > 31 05360000
+ THEN BEGIN FLAG(148); GS ~ PRTIMAX; 05361000
+ GO TO L2 END; 05362000
+ Q ~ SPRT[ROW]; 05363000
+ GO TO L1 END; 05364000
+ COL ~ COL+1; M ~ BOOLEAN(REAL(M)+REAL(M)); 05365000
+ GO TO L1 END; 05366000
+ PRTI ~ (GS ~ 32|ROW+COL)+1; 05367000
+ IF PRTI > PRTIMAX THEN PRTIMAX ~ PRTI END 05368000
+ ELSE BEGIN 05369000
+ IF STACKCTR > 767 THEN FLAG(149); 05370000
+ STACKCTR ~ (GS ~ STACKCTR)+1; Q ~ FALSE; 05371000
+ GO TO EXIT END; 05372000
+ L2: IF GS } 512 THEN GS ~ GS+1024; 05373000
+ Q ~ TRUE; 05374000
+ EXIT: GETSPACE ~ GS; 05375000
+ IF GS > 1023 THEN GS ~ GS-1024; 05376000
+ IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100
+ END GETSPACE; 05378000
+ COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 05379000
+ BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000
+ ARRAYCHECK~AAW.CLASSINTARRAYID 05381000
+ OR AAW.INCR !1; 05382000
+ COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000
+ BOOLEAN PROCEDURE COMMACHECK; 05384000
+ BEGIN IF NOT(COMMACHECK~(STEPI=COMMA)) THEN ERR(350); 05385000
+ STEPIT 05386000
+ END COMMACHECK; 05387000
+ COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000
+ BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000
+ IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000
+ IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK~TRUE ELSE 05390100
+ IF TAKE(GT1~GIT(ELBW)!1 THEN ERR(537) ELSE 05391000
+ IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000
+ HVCHECK~TRUE; 05393000
+ COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000
+ BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000
+ IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000
+ IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100
+ IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000
+ IF TAKE(GT1~1).CLASS!BOOID THEN ERR(353) ELSE 05398000
+ IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000
+ OUTPROCHECK~TRUE; 05400000
+ COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000
+ BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000
+ IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000
+ IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100
+ IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000
+ IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000
+ IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000
+ EQLESCHECK~TRUE; 05407000
+ COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000
+ COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 06001000
+ PROCEDURE AEXP; 06002000
+ BEGIN 06003000
+ IF ELCLASS = IFV 06004000
+ THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000
+ ELSE BEGIN ARITHSEC; SIMPARITH END 06006000
+ END AEXP; 06007000
+ COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000
+ IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000
+ AND Q ARE PRIMARIES; 06010000
+ PROCEDURE ARITHSEC; 06011000
+ BEGIN 06012000
+ IF ELCLASS = ADOP 06013000
+ THEN BEGIN 06014000
+ STEPIT; 06015000
+ IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000
+ ELSE BEGIN 06017000
+ PRIMARY; 06018000
+ WHILE ELCLASS = FACTOP DO %WF 06019000
+ BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000
+ ENDTOG ~ LINKTOG; EMITO(CHS); 06021000
+ LINKTOG ~ ENDTOG; ENDTOG ~ FALSE END END 06022000
+ ELSE PRIMARY END ARITHSEC; 06023000
+ COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000
+ ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000
+ COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000
+ WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000
+ COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000
+ SIMPARITH IS DONE BY ARITHCOMP. AN ARTIFIAL ROUTINE 06029000
+ WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000
+ ARITHOCMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000
+ PROCEDURE SIMPARITH; 06032000
+ BEGIN 06033000
+ WHILE ELCLASS = AMPERSAND 06034000
+ DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000
+ WHILE ELCLASS}ADOP AND ELCLASS{FACTOP DO ARITHCOMP END; 06036000
+ COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000
+ ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000
+ EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000
+ IS OBTAINED BY RECURSION; 06040000
+ PROCEDURE ARITHCOMP; 06041000
+ BEGIN INTEGER OPERATOR, OPCLASS; 06042000
+ DO BEGIN 06043000
+ OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06044000
+ COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000
+ ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000
+ OF THE ELBAT WORD; 06047000
+ OPCLASS ~ ELCLASS; 06048000
+ STEPIT; PRIMARY; 06049000
+ IF OPCLASS = FACTOP THEN EMITUP 06050000
+ ELSE BEGIN 06051000
+ WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000
+ COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000
+ STACKCT ~ 1; %A06053500
+ EMIT(OPERATOR) END 06054000
+ END UNTIL OPCLASS ! ELCLASS END ARITHCOMP; 06055000
+ COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 06056000
+ PROCEDURE IMPFUN; 06057000
BEGIN 06058000
REAL T1,T2,T3 ; 06059000
BOOLEAN B ; 06059050
- DEFINE ERRX(ERRX1)=BEGIN T1_ERRX1; GO ERROR END #; 06059100
+ DEFINE ERRX(ERRX1)=BEGIN T1~ERRX1; GO ERROR END #; 06059100
LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000
MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100
LABEL ERROR,L1,L2,L3 ; 06060110
- SWITCH S _ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000
+ SWITCH S ~ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000
MAXANDMIN, MAXANDMIN, DELAY;% 06061100
DEFINE MAXV = 6#;% 06061200
- IF T2_(T1_ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000
+ IF T2~(T1~ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000
IF T2!25 THEN EMITO(MKS) ; 06062110
IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120
IF T2<24 THEN 06062125
@@ -4582,7 +4582,7 @@ PROCEDURE IMPFUN; 06057000
L3: IF TABLE(I+1)=COMMA THEN 06062135
IF ELCLASS>BOOID AND ELCLASS=REALID AND ELCLASS<=INTID THEN 06062340
+ IF ELCLASS}REALID AND ELCLASS{INTID THEN 06062340
BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 06062350
ELSE IF ELCLASSBOOPROCID THEN 06062370
IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211)06062380
@@ -4613,7 +4613,7 @@ L1: IF T2<23 THEN BEGIN IF ELCLASS!COMMA THEN ERRX(80) END 06062210
END ; 06062440
IF T2<23 THEN 06062470
BEGIN % DMOD, DARCTAN2 06062480
- B_TRUE; GO L3 ; 06062500
+ B~TRUE; GO L3 ; 06062500
END ; 06062535
IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540
EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560
@@ -4654,270 +4654,270 @@ L1: IF T2<23 THEN BEGIN IF ELCLASS!COMMA THEN ERRX(80) END 06062210
STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200
IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250
BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300
- EMITPAIR(32, COM); T1_3; 06073350
- END ELSE BEGIN EMIT(4); EMIT(0); T1_0; 06073400
- IF ELCLASS>=BOOARRAYID AND ELCLASS<=INTARRAYID THEN 06073450
- BEGIN T1_FI; VARIABLE(T1); END ELSE AEXP; 06073500
+ 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
+ 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
+ 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
+ STEPIT; AEXP; EMITPAIR(28,COM); T1~1; 06073830
END; END; END; 06073840
- GTI1_0; 06073845
- DO EMITO(DEL) UNTIL GTI1_GTI1-1=T1;% 06073850
+ GTI1~0; 06073845
+ DO EMITO(DEL) UNTIL GTI1~GTI1-1=T1;% 06073850
IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860
GO TO EXIT; 06073870
EXIT: END IMPFUN; 06074000
-COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000
- OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000
- DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000
- CASES; 06078000
-PROCEDURE PRIMARY; 06079000
- BEGIN 06080000
- LABEL 06081000
- L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000
- L30, L31, L32, L33, L34, L35; 06084000
- SWITCH S _ 06085000
- L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000
- L30, L31, L32, L33, L34, L35; 06088000
- COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000
- LABEL EXIT,RP,LDOT,LAMPER; 06090000
- GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000
- IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000
- IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005
- BEGIN 06092010
- IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015
- GO TO LAMPER ; 06092020
- END ; 06092025
- L12: L13: L17: L21: L25: L29: L30: 06093000
- COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000
- IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950
- ERR(103); GO TO EXIT; 06095000
- L11: 06096000
- COMMENT INTRINSIC FUNCTIONS; 06097000
- IMPFUN; STACKCT _ STACKCT-1; GO TO LDOT; %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 BOOLEAN 06115000
- EXPRESSION - OTHERWISE AN ERROR; 06116000
- IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000
- IF STEPI ! LEFTPAREN 06118000
- THEN BEGIN ERR(105); GO TO EXIT END; 06119000
- STEPIT; BEXP; GO TO RP END; 06120000
- IF ELBAT[I].ADDRESS = INTV THEN 06120100
- BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200
- ERR(106); GO TO EXIT; 06121000
- L34: 06122000
- COMMENT (; 06123000
- STEPIT; AEXP; 06124000
- STACKCT _ STACKCT-1; %A 06124500
- RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000
- STEPIT; 06126000
- LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000
- LAMPER: STACKCT _ STACKCT+1; %A 06128000
- WHILE ELCLASS = AMPERSAND %A 06128500
- DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000
- COMMENT THIS CODE HANDLES CANCATENATES; 06130000
- EXIT: END PRIMARY; 06131000
-COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000
-PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000
-COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000
- ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000
- BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000
- DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000
- OR DESIGNATIONAL EXPRESSION; 06138000
-INTEGER PROCEDURE EXPRSS; 06139000
- BEGIN 06140000
- IF ELCLASS = IFV 06141000
- THEN BEGIN 06142000
- IF EXPRSS _ IFEXP = ATYPE 06143000
- THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000
- ELSE IF EXPRSS _ BOOSEC = BTYPE THEN SIMPBOO 06145000
- END EXPRSS; 06146000
-COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000
- EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000
- AS EXPRSS REPORTS; 06149000
-INTEGER PROCEDURE BOOSEC; 06150000
- BEGIN BOOLEAN N; 06151000
- IF N _ ELCLASS = NOTOP THEN STEPIT; 06152000
- GT4 _ BOOSEC _ BOOPRIM; 06153000
- IF N THEN BEGIN EMITLNG; EMIT(0); L _ L-1; 06154000
- COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000
- RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000
- IF GT4 ! BTYPE THEN ERR(109) 06157000
- COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000
- LOGICALLY NEGATED; 06159000
- END END BOOSEC; 06160000
-COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000
- THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000
- ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000
- PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000
- A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000
- COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000
- LYSIS USING RECURSION; 06167000
-PROCEDURE SIMPBOO; 06168000
- BEGIN 06169000
- WHILE ELCLASS = AMPERSAND 06170000
- DO BEGIN 06171000
- STEPIT; 06172000
- IF BOOPRIM! BTYPE THEN ERR(109); 06173000
- PARSE END; 06174000
- WHILE ELCLASS >=EQVOP AND ELCLASS <=ANDOP DO BOOCOMP 06175000
- END BOOCOMP; 06176000
-COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS. 06177000
- IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN 06178000
- OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000
- SION; 06180000
-PROCEDURE BOOCOMP; 06181000
- BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000
- DO BEGIN 06183000
- OPERATOR _ 1 & ELBAT[I] [36:17:10]; 06184000
- COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000
- ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000
- OF THE ELBAT WORD; 06187000
- OPCLASS _ ELCLASS; 06188000
- STEPIT; 06189000
- IF BOOSEC ! BTYPE 06190000
- THEN BEGIN ERR(109); GO TO EXIT END; 06191000
- WHILE OPCLASS < ELCLASS 06192000
- DO IF ELCLASS <=ANDOP THEN BOOCOMP 06193000
- ELSE BEGIN ERR(110); GO TO EXIT END; 06194000
- COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000
- STACKCT _ 1; %A 06195500
- IF OPCLASS = IMPOP 06196000
- THEN BEGIN 06197000
- COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000
- ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000
- THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000
- EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000
- FUTURE. (SEE CODE FOR EMITLNG); 06202000
- EMITLNG; 06203000
- EMITO(LND); 06204000
- EMITO(LNG); 06205000
- EMITO(0); 06206000
- L _ L-1 END 06207000
- ELSE EMIT(OPERATOR) 06208000
- END UNTIL OPCLASS ! ELCLASS; 06209000
- EXIT: END BOOCOMP; 06210000
-COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000
- DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRESS REPORTS; 06212000
-INTEGER PROCEDURE BOOPRIM; 06213000
- BEGIN INTEGER TYPE; 06214000
- LABEL L9, 06215000
- L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000
- L30, L31, L32, L33, L34, L35; 06218000
- SWITCH S _ L9, 06219000
- L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000
- L30, L31, L32, L33, L34, L35; 06222000
- COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000
- LABEL EXIT,LE,D,TD,T; 06224000
- LABEL FAH ; 06224500
- GO TO S[ELCLASS-SUPERFILEID]; 06225000
- IF ELCLASS = ADOP THEN GO TO L11; 06226000
- IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000
- IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500
- BEGIN 06227510
- BOOPRIM_TYPE_FILEATTRIBUTEHANDLER(FP) ; 06227520
- GO FAH ; 06227530
- END ; 06227540
- LE: L10: L12: 06228000
- COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000
- EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000
- ERR(111); GO TO EXIT; 06231000
- L35: IF GT1 _ ELBAT[I].ADDRESS = BOOV 06232000
- THEN BEGIN PANA; GO TO TD END; 06233000
- IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000
- L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000
- L31: L32: L33: 06236000
- COMMENT ARITHMETIC TYPE STUFF; 06237000
- AEXP; 06238000
- D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM _ ATYPE; GO EXIT END;06239000
- RELATION; 06240000
- BOOPRIM _ BTYPE; GO TO EXIT; 06241000
- L13: 06242000
- COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100
- STRMPROCSTMT; GO TO TD; 06244000
- L17: 06245000
- COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100
- PROCSTMT(FALSE); GO TO TD; 06247000
- L21: L25: 06248000
- COMMENT BOOLEAN VARIABLES; 06249000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100
- VARIABLE(FP); GO TO T; 06250000
- L9: L29: 06251000
- COMMENT LABELS AND SWITCHES; 06252000
- DEXP; BOOPRIM _ DTYPE; GO TO EXIT; 06253000
- L30: 06254000
- COMMENT TRUE OR FALSE; 06255000
- EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000
- L34: 06257000
- COMMENT (; 06258000
- STEPIT; TYPE _ BOOPRIM _ EXPRSS; 06259000
- COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000
- STACKCT _ STACKCT-1; %A 06260500
- IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000
- STEPIT; 06262000
- FAH: 06262500
- IF TYPE = DTYPE THEN GO TO EXIT; 06263000
- COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000
- IF TYPE = BTYPE THEN BEGIN 06265000
- TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000
- T: STACKCT _ STACKCT+1; %A 06267000
- WHILE ELCLASS = AMPERSAND DO %A 06267500
- COMMENT HANDLES CONCATENATE; 06268000
- BEGIN 06269000
- STEPIT; 06270000
- IF BOOPRIM ! BTYPE 06271000
- THEN BEGIN ERR(109); GO TO EXIT END; 06272000
- PARSE END; 06273000
- BOOPRIM _ BTYPE; GO TO EXIT END; 06274000
- COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000
- EXPRESSION; 06276000
- DOT; SIMPARITH; GO TO D; 06277000
- EXIT: END BOOPRIM; 06278000
-COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000
- EXPRESSION HAS ALREADY BEEN COMPILED; 06280000
-PROCEDURE RELATION; 06281000
- BEGIN 06282000
- INTEGER OPERATOR; 06282200
- REAL A; 06282400
- BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600
- DEFINE FORMALNAME = [9:2]=2#; 06282800
- PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S: REAL A; 06283000
- BEGIN 06283200
- IF C THEN EMITNUM(A) 06283400
- ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600
- IF S THEN EMITO(CHS); 06283800
- END PLUG; 06284000
- DO BEGIN 06284200
+ COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000
+ OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000
+ DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000
+ CASES; 06078000
+ PROCEDURE PRIMARY; 06079000
+ BEGIN 06080000
+ LABEL 06081000
+ L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000
+ L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000
+ L30, L31, L32, L33, L34, L35; 06084000
+ SWITCH S ~ 06085000
+ L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000
+ L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000
+ L30, L31, L32, L33, L34, L35; 06088000
+ COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000
+ LABEL EXIT,RP,LDOT,LAMPER; 06090000
+ GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000
+ IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000
+ IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005
+ BEGIN 06092010
+ IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015
+ GO TO LAMPER ; 06092020
+ END ; 06092025
+ L12: L13: L17: L21: L25: L29: L30: 06093000
+ COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000
+ IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950
+ ERR(103); GO TO EXIT; 06095000
+ L11: 06096000
+ COMMENT INTRINSIC FUNCTIONS; 06097000
+ IMPFUN; STACKCT ~ STACKCT-1; GO TO LDOT; %A06098000
+ L14: L15: L16: 06099000
+ COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100
+ STRMPROCSTMT; GO TO LDOT 06101000
+ L18: L19: L20: 06102000
+ COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100
+ PROCSTMT(FALSE); GO TO LDOT; 06104000
+ L22: L23: L24: L26: L27: L28: 06105000
+ COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100
+ VARIABLE(FP); GO TO LAMPER; 06107000
+ L32: 06108000
+ COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000
+ EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000
+ L31: L33: 06111000
+ COMMENT STRINGS AND NONLITERALS; 06112000
+ EMITNUM(C); STEPIT; GO TO LAMPER; 06113000
+ L35: 06114000
+ COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000
+ EXPRESSION - OTHERWISE AN ERROR; 06116000
+ IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000
+ IF STEPI ! LEFTPAREN 06118000
+ THEN BEGIN ERR(105); GO TO EXIT END; 06119000
+ STEPIT; BEXP; GO TO RP END; 06120000
+ IF ELBAT[I].ADDRESS = INTV THEN 06120100
+ BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200
+ ERR(106); GO TO EXIT; 06121000
+ L34: 06122000
+ COMMENT (; 06123000
+ STEPIT; AEXP; 06124000
+ STACKCT ~ STACKCT-1; %A 06124500
+ RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000
+ STEPIT; 06126000
+ LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000
+ LAMPER: STACKCT ~ STACKCT+1; %A 06128000
+ WHILE ELCLASS = AMPERSAND %A 06128500
+ DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000
+ COMMENT THIS CODE HANDLES CANCATENATES; 06130000
+ EXIT: END PRIMARY; 06131000
+ COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000
+ PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000
+ COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000
+ ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000
+ BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000
+ DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000
+ OR DESIGNATIONAL EXPRESSION; 06138000
+ INTEGER PROCEDURE EXPRSS; 06139000
+ BEGIN 06140000
+ IF ELCLASS = IFV 06141000
+ THEN BEGIN 06142000
+ IF EXPRSS ~ IFEXP = ATYPE 06143000
+ THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000
+ ELSE IF EXPRSS ~ BOOSEC = BTYPE THEN SIMPBOO 06145000
+ END EXPRSS; 06146000
+ COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000
+ EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000
+ AS EXPRSS REPORTS; 06149000
+ INTEGER PROCEDURE BOOSEC; 06150000
+ BEGIN BOOLEAN N; 06151000
+ IF N ~ ELCLASS = NOTOP THEN STEPIT; 06152000
+ GT4 ~ BOOSEC ~ BOOPRIM; 06153000
+ IF N THEN BEGIN EMITLNG; EMIT(0); L ~ L-1; 06154000
+ COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000
+ RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000
+ IF GT4 ! BTYPE THEN ERR(109) 06157000
+ COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000
+ LOGICALLY NEGATED; 06159000
+ END END BOOSEC; 06160000
+ COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000
+ THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000
+ ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000
+ PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000
+ A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000
+ COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000
+ LYSIS USING RECURSION; 06167000
+ PROCEDURE SIMPBOO; 06168000
+ BEGIN 06169000
+ WHILE ELCLASS = AMPERSAND 06170000
+ DO BEGIN 06171000
+ STEPIT; 06172000
+ IF BOOPRIM ! BTYPE THEN ERR(109); 06173000
+ PARSE END; 06174000
+ WHILE ELCLASS }EQVOP AND ELCLASS {ANDOP DO BOOCOMP 06175000
+ END BOOCOMP; 06176000
+ COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.06177000
+ IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN06178000
+ OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000
+ SION; 06180000
+ PROCEDURE BOOCOMP; 06181000
+ BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000
+ DO BEGIN 06183000
+ OPERATOR ~ 1 & ELBAT[I] [36:17:10]; 06184000
+ COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000
+ ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000
+ OF THE ELBAT WORD; 06187000
+ OPCLASS ~ ELCLASS; 06188000
+ STEPIT; 06189000
+ IF BOOSEC ! BTYPE 06190000
+ THEN BEGIN ERR(109); GO TO EXIT END; 06191000
+ WHILE OPCLASS < ELCLASS 06192000
+ DO IF ELCLASS {ANDOP THEN BOOCOMP 06193000
+ ELSE BEGIN ERR(110); GO TO EXIT END; 06194000
+ COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000
+ STACKCT ~ 1; %A 06195500
+ IF OPCLASS = IMPOP 06196000
+ THEN BEGIN 06197000
+ COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000
+ ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000
+ THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000
+ EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000
+ FUTURE. (SEE CODE FOR EMITLNG); 06202000
+ EMITLNG; 06203000
+ EMITO(LND); 06204000
+ EMITO(LNG); 06205000
+ EMITO(0); 06206000
+ L ~ L-1 END 06207000
+ ELSE EMIT(OPERATOR) 06208000
+ END UNTIL OPCLASS ! ELCLASS; 06209000
+ EXIT: END BOOCOMP; 06210000
+ COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000
+ DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 06212000
+ INTEGER PROCEDURE BOOPRIM; 06213000
+ BEGIN INTEGER TYPE; 06214000
+ LABEL L9, 06215000
+ L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000
+ L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000
+ L30, L31, L32, L33, L34, L35; 06218000
+ SWITCH S ~ L9, 06219000
+ L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000
+ L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000
+ L30, L31, L32, L33, L34, L35; 06222000
+ COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000
+ LABEL EXIT,LE,D,TD,T; 06224000
+ LABEL FAH ; 06224500
+ GO TO S[ELCLASS-SUPERFILEID]; 06225000
+ IF ELCLASS = ADOP THEN GO TO L11; 06226000
+ IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000
+ IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500
+ BEGIN 06227510
+ BOOPRIM~TYPE~FILEATTRIBUTEHANDLER(FP) ; 06227520
+ GO FAH ; 06227530
+ END ; 06227540
+ LE: L10: L12: 06228000
+ COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000
+ EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000
+ ERR(111); GO TO EXIT; 06231000
+ L35: IF GT1 ~ ELBAT[I].ADDRESS = BOOV 06232000
+ THEN BEGIN PANA; GO TO TD END; 06233000
+ IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000
+ L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000
+ L31: L32: L33: 06236000
+ COMMENT ARITHMETIC TYPE STUFF; 06237000
+ AEXP; 06238000
+ D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM ~ ATYPE;GO EXIT END;06239000
+ RELATION; 06240000
+ BOOPRIM ~ BTYPE; GO TO EXIT; 06241000
+ L13: 06242000
+ COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100
+ STRMPROCSTMT; GO TO TD; 06244000
+ L17: 06245000
+ COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100
+ PROCSTMT(FALSE); GO TO TD; 06247000
+ L21: L25: 06248000
+ COMMENT BOOLEAN VARIABLES; 06249000
+ IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100
+ VARIABLE(FP); GO TO T; 06250000
+ L9: L29: 06251000
+ COMMENT LABELS AND SWITCHES; 06252000
+ DEXP; BOOPRIM ~ DTYPE; GO TO EXIT; 06253000
+ L30: 06254000
+ COMMENT TRUE OR FALSE; 06255000
+ EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000
+ L34: 06257000
+ COMMENT (; 06258000
+ STEPIT; TYPE ~ BOOPRIM ~ EXPRSS; 06259000
+ COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000
+ STACKCT ~ STACKCT-1; %A 06260500
+ IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000
+ STEPIT; 06262000
+ FAH: 06262500
+ IF TYPE = DTYPE THEN GO TO EXIT; 06263000
+ COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000
+ IF TYPE = BTYPE THEN BEGIN 06265000
+ TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000
+ T: STACKCT ~ STACKCT+1; %A 06267000
+ WHILE ELCLASS = AMPERSAND DO %A 06267500
+ COMMENT HANDLES CONCATENATE; 06268000
+ BEGIN 06269000
+ STEPIT; 06270000
+ IF BOOPRIM ! BTYPE 06271000
+ THEN BEGIN ERR(109); GO TO EXIT END; 06272000
+ PARSE END; 06273000
+ BOOPRIM ~ BTYPE; GO TO EXIT END; 06274000
+ COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000
+ EXPRESSION; 06276000
+ DOT; SIMPARITH; GO TO D; 06277000
+ EXIT: END BOOPRIM; 06278000
+ COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000
+ EXPRESSION HAS ALREADY BEEN COMPILED; 06280000
+ PROCEDURE RELATION; 06281000
+ BEGIN 06282000
+ INTEGER OPERATOR; 06282200
+ REAL A; 06282400
+ BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600
+ DEFINE FORMALNAME = [9:2]=2#; 06282800
+ PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S: REAL A; 06283000
+ BEGIN 06283200
+ IF C THEN EMITNUM(A) 06283400
+ ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600
+ IF S THEN EMITO(CHS); 06283800
+ END PLUG; 06284000
+ DO BEGIN 06284200
OPERATOR:=1&ELBAT[I][36:17:10]; 06284400
COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600
EMITTED LATER (AFTER PROCESSING SECOND HALF). 06284800
@@ -4929,8 +4929,8 @@ COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600
SIGNA:=FALSE; 06286000
IF STEPI=ADOP THEN SIGNA:=ELBAT[I].ADDRESS=SUB; 06286200
IF SIGN:=ELCLASS=ADOP THEN STEPIT; 06286400
- CONSTANA:=ELCLASS>=NONLITNO AND ELCLASS<=STRNGCON; 06286600
- A:=REAL(ELCLASS>=REALID AND ELCLASS<=INTID 06286800
+ CONSTANA:=ELCLASS}NONLITNO AND ELCLASS{STRNGCON; 06286600
+ A:=REAL(ELCLASS}REALID AND ELCLASS{INTID 06286800
AND NOT ELBAT[I].FORMALNAME); 06287000
SIMPLE:=(CONSTANA OR BOOLEAN(A)) AND STEPI=RELOP; 06287200
IF SIMPLE THEN 06287400
@@ -4948,238 +4948,238 @@ COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600
MANY:=TRUE; 06289800
END UNTIL ELCASS!RELOP 06290000
END RELATION; 06290200
-COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000
- OF EXPRESSIONS AS EXPRSS REPORTS; 06293000
-INTEGER PROCEDURE IFEXP; 06294000
- BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000
- IFCLAUSE; 06296000
- STACKCT _ 0; %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,THEBRANCH,L); 06301000
- IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000
- STEPIT; 06303000
- IF TYPE = ATYPE THEN AEXP ELSE 06304000
- IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000
- STACKCT _ 1; %A 06305500
- COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000
- EMITB(BFW,ELSEBRANCH,L); 06307000
- EMIT(1); L _ L-1; 06308000
- COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000
- BOOSEC, BOOCOMP, AND RELATION; 06310000
- END END IFEXP; 06311000
-PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000
-BEGIN INTEGER FIRST,SECOND,THIRD; 06312500
- BOOLEAN P1,P2,P3; 06313000
- LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500
- IF ELCLASS = FIELDID THEN %11706313550-
- BEGIN %11706313600-
- FIRST := ELBAT[I].SBITF; %11706313650-
- SECOND := 48 - (THIRD := ELBAT[I].NBITF); %11706313700-
- GO TO SKIP1; %11706313750-
- END %11706313800-
- ELSE %11706313850-
- IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90); GO TO EXIT END; 06314000
- IF STEPI = FIELDID THEN %11706314050-
- BEGIN %11706314100-
- FIRST := ELBAT[I].SBITF; %11706314150-
- SECOND := 48 - (THIRD := ELBAT[I].NBITF); %11706314200-
- IF STEPI ! RTBRKET THEN %11706314250-
- BEGIN %11706314300-
- ERR(94); %11706314350-
- GO TO EXIT; %11706314400-
- END; %11706314450-
- GO TO SKIP1; %11706314500-
- END %11706314550-
- ELSE %11706314600-
- IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL %11706314650-
- GO TO L1; %11706314700-
- 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
+ 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,THEBRANCH,L); 06301000
+ IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000
+ STEPIT; 06303000
+ IF TYPE = ATYPE THEN AEXP ELSE 06304000
+ IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000
+ STACKCT ~ 1; %A 06305500
+ COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000
+ EMITB(BFW,ELSEBRANCH,L); 06307000
+ EMIT(1); L ~ L-1; 06308000
+ COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000
+ BOOSEC, BOOCOMP, AND RELATION; 06310000
+ END END IFEXP; 06311000
+ PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000
+ BEGIN INTEGER FIRST,SECOND,THIRD; 06312500
+ BOOLEAN P1,P2,P3; 06313000
+ LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500
+ IF ELCLASS = FIELDID THEN %117 06313550
+ BEGIN %117 06313600
+ FIRST := ELBAT[I].SBITF; %117 06313650
+ SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06313700
+ GO TO SKIP1; %117 06313750
+ END %117 06313800
+ ELSE %117 06313850
+ IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000
+ IF STEPI = FIELDID THEN %117 06314050
+ BEGIN %117 06314100
+ FIRST := ELBAT[I].SBITF; %117 06314150
+ SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117 06314200
+ IF STEPI ! RTBRKET THEN %117 06314250
+ BEGIN %117 06314300
+ ERR(94); %117 06314350
+ GO TO EXIT; %117 06314400
+ END; %117 06314450
+ GO TO SKIP1; %117 06314500
+ END %117 06314550
+ ELSE %117 06314600
+ IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL %117 06314650
+ GO TO L1; %117 06314700
+ FIRST ~ C; 06315000
+ IF TABLE(I+1) = COLON THEN 06315500
+ BEGIN 06316000
+ STEPIT; 06316500
+ IF FIRST{0 THEN FLAG(92); 06317000
+ END ELSE 06317500
+ BEGIN 06318000
+ L1: EMITO(MKS); 06318500
+ AEXP; 06319000
+ P1 ~ TRUE; 06319500
+ IF ELCLASS ! COLON THEN BEGIN ERR(91); GO TO EXIT END; 06320000
+ END; 06320500
+ IF STEPI ! LITNO THEN GO TO L2; 06321000
06321100
- SECOND _ C ; 06321500
- IF GT1 _ TABLE(I+1) = COLON THEN 06322000
- BEGIN 06322500
- STEPIT; 06323000
- IF SECOND<=0 THEN FLAG(092); 06323500
- END ELSE 06324000
- BEGIN 06324500
- IF GT1 = RTBRKET THEN 06325000
- BEGIN 06325500
- STEPIT; 06326000
- SECOND _ 48 - (THIRD _ SECOND); 06326500
- GO TO SKIP2; 06327000
- END; 06327500
- L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000
- AEXP; 06328500
- P1 _ P2 _ TRUE; 06329000
- IF ELCLASS = COLON THEN 06329100
+ SECOND ~ C ; 06321500
+ IF GT1 ~ TABLE(I+1) = COLON THEN 06322000
+ BEGIN 06322500
+ STEPIT; 06323000
+ IF SECOND{0 THEN FLAG(092); 06323500
+ END ELSE 06324000
+ BEGIN 06324500
+ IF GT1 = RTBRKET THEN 06325000
+ BEGIN 06325500
+ STEPIT; 06326000
+ SECOND ~ 48 - (THIRD ~ SECOND); 06326500
+ GO TO SKIP2; 06327000
+ END; 06327500
+ L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000
+ AEXP; 06328500
+ P1 ~ P2 ~ TRUE; 06329000
+ IF ELCLASS = COLON THEN 06329100
06329200
06329300
- ELSE 06329350
- IF ELCLASS = RTBRKET THEN 06329400
- BEGIN 06329450
- EMITO(DUP); 06329500
- EMITL(48) ;EMITO(SUB); 06329550
- EMITO(CHS);EMITO(XCH); 06329600
- P3 _ TRUE; 06329700
- GO TO SKIP1; 06329800
- END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900
- END; 06330000
- IF STEPI ! LITNO THEN GO L3 ; 06330500
- THIRD _ C; 06330600
- IF TABLE(I+1) = RTBRKET THEN 06330700
- BEGIN 06330800
- STEPIT; 06331000
- SKIP2: IF THIRD<=0 OR THIRD > 47 THEN FLAG(95); 06331100
- END ELSE 06331200
- BEGIN 06331300
- L3: IF NOT P2 THEN 06331500
- BEGIN 06331600
- IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700
- EMITL(SECOND); 06331800
- END; 06332000
- AEXP; 06332100
- P1_ P2_P3 _TRUE; 06332200
- IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300
- END; 06332400
- SKIP1: IF P1 THEN 06332500
- BEGIN 06333000
- IF NOT P2 THEN EMITL(SECOND); 06333500
- IF NOT P3 THEN 06334000
- BEGIN 06334100
- EMITL(THIRD);EMITL(1); 06334200
- EMITV(GNAT(DIALER)); 06334500
- EMIT(TRB & THIRD[36:42:6]); 06334600
- END ELSE 06334700
- BEGIN 06335000
- EMITL(0); 06335100
- EMITV(GNAT(DIALER)); 06335200
- EMITO(DEL); 06335500
- END; 06335700
- END ELSE 06336000
- BEGIN 06336100
- IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200
- EMITD(SECOND,FIRST,THIRD); 06336300
- END; 06336400
- STEPIT; 06336500
- EXIT: STACKCT _ 1; 06336600
-END PARSE; 06336700
-COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000
- THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100
-PROCEDURE DOTIT; 06338000
- BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000
- IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000
+ ELSE 06329350
+ IF ELCLASS = RTBRKET THEN 06329400
+ BEGIN 06329450
+ EMITO(DUP); 06329500
+ EMITL(48) ;EMITO(SUB); 06329550
+ EMITO(CHS);EMITO(XCH); 06329600
+ P3 ~ TRUE; 06329700
+ GO TO SKIP1; 06329800
+ END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900
+ END; 06330000
+ IF STEPI ! LITNO THEN GO L3 ; 06330500
+ THIRD ~ C; 06330600
+ IF TABLE(I+1) = RTBRKET THEN 06330700
+ BEGIN 06330800
+ STEPIT; 06331000
+ SKIP2: IF THIRD{0 OR THIRD > 47 THEN FLAG(95); 06331100
+ END ELSE 06331200
+ BEGIN 06331300
+ L3: IF NOT P2 THEN 06331500
+ BEGIN 06331600
+ IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700
+ EMITL(SECOND); 06331800
+ END; 06332000
+ AEXP; 06332100
+ P1~ P2~P3 ~TRUE; 06332200
+ IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300
+ END; 06332400
+ SKIP1: IF P1 THEN 06332500
+ BEGIN 06333000
+ IF NOT P2 THEN EMITL(SECOND); 06333500
+ IF NOT P3 THEN 06334000
+ BEGIN 06334100
+ EMITL(THIRD);EMITL(1); 06334200
+ EMITV(GNAT(DIALER)); 06334500
+ EMIT(TRB & THIRD[36:42:6]); 06334600
+ END ELSE 06334700
+ BEGIN 06335000
+ EMITL(0); 06335100
+ EMITV(GNAT(DIALER)); 06335200
+ EMITO(DEL); 06335500
+ END; 06335700
+ END ELSE 06336000
+ BEGIN 06336100
+ IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200
+ EMITD(SECOND,FIRST,THIRD); 06336300
+ END; 06336400
+ STEPIT; 06336500
+ EXIT: STACKCT ~ 1; 06336600
+ END PARSE; 06336700
+ COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000
+ THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100
+ PROCEDURE DOTIT; 06338000
+ BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000
+ IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000
%A 06342000
- EMITI(0,FIRST,SECOND); %A 06343000
+ EMITI(0,FIRST,SECOND); %A 06343000
%A 06344000
- STEPIT; 06345000
-EXIT: END DOTIT; 06346000
-COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000
- PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000
- THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000
- SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000
- IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000
- IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000
- BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000
- THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000
- IS ALSO STORED IN F+1; 06355000
-PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000
- BEGIN INTEGER TLEVEL; 06357000
- EMITO(MKS); 06358000
- IF TLEVEL _ ELBATWORD.LVL > JUMPCTR THEN 06359000
- JUMPCTR _ TLEVEL; 06360000
- COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000
- INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000
- BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000
- JUMPING; 06364000
- IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000
- THEN BEGIN 06366000
- COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000
- EMIT(0); 06368000
- EMIT(TLEVEL); END 06369000
- ELSE BEGIN 06370000
- EMITN(512); 06371000
- EMITV(513); COMENT PICK UP BLOCKCTR AT ENTRY 06372000
- FROM F+1; 06373000
- IF TLEVEL _ TLEVEL - SUBLEVEL -1 ! 0 06374000
- THEN BEGIN 06375000
- EMITL(TLEVEL); 06376000
- EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000
- AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000
- END END; 06379000
- EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000
- END GENGO; 06381000
-COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000
- IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000
- THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000
- STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000
- SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000
- COMMUNICATE WILL BE DONE; 06387000
-PROCEDURE DEXP; 06388000
- BEGIN 06389000
- LABEL EXIT; 06390000
- BOOLEAN S,F; 06391000
- REAL ELBW; 06392000
- IF (S _ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000
- THEN BEGIN 06394000
- CHECKER(ELBW _ ELBAT[I]); 06395000
- SCATTERELBAT; 06396000
- IF LEVEL ! LEVELF OR F _ FORMALF THEN GOTOG _ TRUE; 06397000
- IF FAULTOG THEN 06397100
- IF S OR F THEN FAULTLEVEL_1 ELSE 06397200
- IF FAULTLEVEL>LEVELF THEN FAULTLEVEL_LEVELF; 06397300
- IF S THEN BEGIN 06398000
- BANA; EMITPAIR(JUNK,ISD); 06399000
- EMITV(GNAT(ELBW)); 06400000
- IF F THEN GO TO EXIT; END 06401000
- ELSE BEGIN 06402000
- STEPIT; 06403000
- IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000
- EMITL(GNAT(ELBW)) END; 06405000
- GENGO(ELBW); 06406000
- END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000
- EXIT: END DEXP; 06408000
-PROCEDURE IFCLAUSE; 06409000
- BEGIN STEPIT; STACKCT _ 0; BEXP; %A 06410000
- IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS; 06411000
-COMMENT PANA COMPILES THE CONSTRUCT: (); 06412000
-PROCEDURE PANA; 06413000
- BEGIN 06414000
- IF STEPI ! LEFTPAREN THEN ERR(105) 06415000
- ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000
- ERR(104) ELSE STEPIT END END PANA; 06417000
-COMMENT BANA COMPILES THE CONSTRUCT: []; 06418000
-PROCEDURE BANA; 06419000
- BEGIN 06420000
- IF STEPI ! LFTBRKET THEN ERR(117) 06421000
- ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000
- ERR(118) ELSE STEPIT END END BANA ; 06423000
-PROCEDURE MAKEALABEL; 06500000
- BEGIN LABEL EXIT; REAL I; 06501000
- STREAMTOG_FALSE; 06502000
- EMITO(MKS); PASSFILE; 06503000
- IF ELCLASS!WITHV THEN 06504000
- BEGIN ERR(301); GO TO EXIT END; 06505000
- FOR I_1 STEP 1 UNTIL 6 DO 06506000
- BEGIN IF STEPI=FACTOP THEN 06507000
- BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000
- ELSE AEXP; 06509000
- IF ELCLASS!COMMA THEN GO TO EXIT; 06510000
+ STEPIT; 06345000
+ EXIT: END DOTIT; 06346000
+ COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000
+ PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000
+ THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000
+ SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000
+ IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000
+ IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000
+ BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000
+ THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000
+ IS ALSO STORED IN F+1; 06355000
+ PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000
+ BEGIN INTEGER TLEVEL; 06357000
+ EMITO(MKS); 06358000
+ IF TLEVEL ~ ELBATWORD.LVL > JUMPCTR THEN 06359000
+ JUMPCTR ~ TLEVEL; 06360000
+ COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000
+ INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000
+ BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000
+ JUMPING; 06364000
+ IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000
+ THEN BEGIN 06366000
+ COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000
+ EMIT(0); 06368000
+ EMIT(TLEVEL); END 06369000
+ ELSE BEGIN 06370000
+ EMITN(512); 06371000
+ EMITV(513); COMENT PICK UP BLOCKCTR AT ENTRY 06372000
+ FROM F+1; 06373000
+ IF TLEVEL ~ TLEVEL - SUBLEVEL -1 ! 0 06374000
+ THEN BEGIN 06375000
+ EMITL(TLEVEL); 06376000
+ EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000
+ AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000
+ END END; 06379000
+ EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000
+ END GENGO; 06381000
+ COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000
+ IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000
+ THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000
+ STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000
+ SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000
+ COMMUNICATE WILL BE DONE; 06387000
+ PROCEDURE DEXP; 06388000
+ BEGIN 06389000
+ LABEL EXIT; 06390000
+ BOOLEAN S,F; 06391000
+ REAL ELBW; 06392000
+ IF (S ~ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000
+ THEN BEGIN 06394000
+ CHECKER(ELBW ~ ELBAT[I]); 06395000
+ SCATTERELBAT; 06396000
+ IF LEVEL ! LEVELF OR F ~ FORMALF THEN GOTOG ~ TRUE; 06397000
+ IF FAULTOG THEN 06397100
+ IF S OR F THEN FAULTLEVEL~1 ELSE 06397200
+ IF FAULTLEVEL>LEVELF THEN FAULTLEVEL~LEVELF; 06397300
+ IF S THEN BEGIN 06398000
+ BANA; EMITPAIR(JUNK,ISD); 06399000
+ EMITV(GNAT(ELBW)); 06400000
+ IF F THEN GO TO EXIT; END 06401000
+ ELSE BEGIN 06402000
+ STEPIT; 06403000
+ IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000
+ EMITL(GNAT(ELBW)) END; 06405000
+ GENGO(ELBW); 06406000
+ END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000
+ EXIT: END DEXP; 06408000
+ PROCEDURE IFCLAUSE; 06409000
+ BEGIN STEPIT; STACKCT ~ 0; BEXP; %A 06410000
+ IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS;06411000
+ COMMENT PANA COMPILES THE CONSTRUCT: (); 06412000
+ PROCEDURE PANA; 06413000
+ BEGIN 06414000
+ IF STEPI ! LEFTPAREN THEN ERR(105) 06415000
+ ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000
+ ERR(104) ELSE STEPIT END END PANA; 06417000
+ COMMENT BANA COMPILES THE CONSTRUCT: []; 06418000
+ PROCEDURE BANA; 06419000
+ BEGIN 06420000
+ IF STEPI ! LFTBRKET THEN ERR(117) 06421000
+ ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000
+ ERR(118) ELSE STEPIT END END BANA ; 06423000
+ PROCEDURE MAKEALABEL; 06500000
+ BEGIN LABEL EXIT; REAL I; 06501000
+ STREAMTOG~FALSE; 06502000
+ EMITO(MKS); PASSFILE; 06503000
+ IF ELCLASS!WITHV THEN 06504000
+ BEGIN ERR(301); GO TO EXIT END; 06505000
+ FOR I~1 STEP 1 UNTIL 6 DO 06506000
+ BEGIN IF STEPI=FACTOP THEN 06507000
+ BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000
+ ELSE AEXP; 06509000
+ IF ELCLASS!COMMA THEN GO TO EXIT; 06510000
END; 06511000
EXIT: FOR I:=I STEP 1 UNTIL 5 DO 06512000
BEGIN EMIT(4);EMITO(CHS) END; 06512100
@@ -5194,502 +5194,502 @@ EMITL(11); 06512200
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
+ I ~ I-1; BEGINCTR ~ BEGINCTR+1; 07008000
+ ANOTHER: ERRORTOG ~ TRUE; COMMENT ALLOW ERROR MESSAGES; 07009000
STEPTIT; 07010000
IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000
IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000
IF ELCLASS ! ENDV 07013000
THEN BEGIN 07014000
ERR(119); GO TO ANOTHER END; 07015000
- ENDTOG_TRUE; 07016000
- DO STOPDEFINE_TRUE UNTIL 07017000
- STEPI<=END AND ELCLASS>=UNTILV 07018000
+ ENDTOG~TRUE; 07016000
+ DO STOPDEFINE~TRUE UNTIL 07017000
+ STEPI{END AND ELCLASS}UNTILV 07018000
OR NOT ENDTOG; 07019000
- ENDTOG_FALSE; 07020000
- IF BEGINCTR _ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000
+ ENDTOG~FALSE; 07020000
+ IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000
THEN BEGIN 07022000
IF BEGINCTR = 0 THEN 07023000
- BEGIN FLAG(143); BEGINCTR _ 1; GO ANOTHER END; 07024000
- FLAG (120); %104-07025000
- FCR:= (LCR:=MKABS(CBUFF[9]))-9; %104-07025010
- IF LISTER THEN PRINTCARD; %104-07025020
- FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; %104-07025030
- IF ELCLASS = PERIOD THEN 07026000
- BEGIN 07027000
- GT5 _ "ND;END."&"E"[1:43:5]; 07028000
- MOVE(1,GT5,CBUFF[0]); 07029000
- LASTUSED_4; 07030000
- ELBAT[I_I-2] _SPECIAL[20]; 07031000
- ELCLASS _ SEMICOLON END 07032000
- END COMPOUNDTAIL; 07033000
- COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000
- PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000
- ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000
- NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000
- CONCERNING THE PARAMETERS: 07038000
- FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000
- OR NOT. 07040000
- SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM07041000
- PROCEDURE OR NOT. 07042000
- INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000
- INFORMATION; 07044000
- PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000
- VALUE FBIT,SBIT,INDEX; 07046000
- BOOLEAN FBIT,SBIT; 07047000
- INTEGER INDEX; 07048000
- BEGIN 07049000
- INTEGER PCTR,ACLASS,SCLASS; 07050000
- COMMENT 07051000
- PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000
- COMPILED. 07053000
- ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000
- SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 07055000
- THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000
- TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000
- SIMILAR MEANINGS; 07058000
- REAL WHOLE; 07059000
- COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000
- PARAMETERS; 07061000
- BOOLEAN VBIT; 07062000
- COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS T07063000O
- BE CALLED BY VALUE OR BY NAME; 07064000
- LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000
- LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000
- CERR,FGEN; 07067000
- LABEL 07068000
- L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000
- L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,07070000
- L31,L32,L33; 07071000
- SWITCH S _ 07072000
- L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000
- L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,07074000
- L31,L32,L33; 07075000
- REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000
- TO REDUCING TOTAL NUMBER; 07077000
- PCTR _ 1; 07078000
- ANOTHER: ACLASS _ STEPI; WHOLE _ ELBAT[I]; SCATTERELBAT; 07079000
- STACKCT _ 0; 07079500%A
- 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 CHECK07082000
- IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000
- METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK; 07084000
- ELSE BEGIN 07085000
- VBIT _ BOOLEAN(GT1_ TAKE(INDEX+PCTR)).V0; 07086000
- IF SCLASS _GT1.CLASS<= INTARRAYID AND 07087000
- SCLASS>= BOOSTRPROCID 07088000
- THEN IF GT1 _ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000
- THEN SCLASS _ SCLASS-GT1+1 07090000
- COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION07091000-
- AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000
- SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000
- END; 07094000
- IF T1 _ TABLE(I+1) ! COMMA THEN 07095000
- IF T1 ! RTPAREN THEN 07096000
- COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY -07097000
- HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000
- BEGIN IF ACLASS<= IDMAX OR ACLESS = SUPERLISTID THEN 07099000
- CHECKER(WHOLE); 07099500
- IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000
- THEN BEGIN 07101000
- COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000
- HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000
- SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000
- IF ACLASS = SUPERFRMTID THEN 07105000
- BEGIN ACLASS _ FRMTID; GO TO FGEN END; 07106000
- IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000
- THEN BEGIN 07108000
- T4_L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES.07108500
- IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505
- ACLASS _ FILEID; 07109000
- COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000
- PASSFILE; 07111000
- IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200
- BEGIN 07111210
- IF VBIT THEN 07111220
- BEGIN 07111225
- T5_L; L_T4; EMITO(MKS); L_T5; T5_0 ; 07111230
- END ; 07111235
- ACLASS_IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240
- THEN REALID ELSE BOOID ; 07111250
- IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255
- IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260
- BEGIN 07111265
- SIMPARITH ; 07111270
- IF ELCLASS=RELOP THEN 07111275
- BEGIN 07111280
- ACLASS_BOOID; RELATION ; 07111285
- SIMPBOO ; 07111290
- END ; 07111295
- END ; 07111300
- IF NOT VBIT THEN 07111303
- BEGIN 07111307
- EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310
- EMITO(RTS); ADJUST; CONSTANTCLEAN ;07111315
- EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320
- EMITB(BFW,T4+2,L) ; 07111325
- STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330
- END ; 07111335
- GO BS ; 07111340
- END OF FILE ATTRIBUTE PARAMETER EXPRESSION07111345;
- IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000
- I _ I-1; 07113000
- COMMENT IF WE ARE HERE IT IS INDEXED; 07114000
- CHECKPRESENCE; 07115000
- EMITO(LOD); PANA; EMITO(CDC); 07116000
- IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000
- THEN BEGIN ERR(121); GO TO CERR END 07118000
- COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000
- STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000
- RELEASE ON THIS DESCRIPTOR; 07121000
- ELSE GO TO COMMON END ; 07122000
- IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500
- EMITV(WHOLE.ADDRESS); 07122510
- IF WHOLE.ADDRESS>1023 THEN EMITO(PRTE); 07122520
- EMITO(LOD); 07122530
- ACLASS_LISTID; GO TO BS END; 07122540
+ BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000
+FLAG (120); %104-07025000
+FCR:= (LCR:=MKABS(CBUFF[9]))-9; %104-07025010
+IF LISTER THEN PRINTCARD; %104-07025020
+FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; %104-07025030
+ IF ELCLASS = PERIOD THEN 07026000
+ BEGIN 07027000
+ GT5 ~ "ND;END."&"E"[1:43:5]; 07028000
+ MOVE(1,GT5,CBUFF[0]); 07029000
+ LASTUSED~4; 07030000
+ ELBAT[I~I-2] ~SPECIAL[20]; 07031000
+ ELCLASS ~ SEMICOLON END 07032000
+ END COMPOUNDTAIL; 07033000
+ COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000
+ PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000
+ ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000
+ NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000
+ CONCERNING THE PARAMETERS: 07038000
+ FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000
+ OR NOT. 07040000
+ SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000
+ PROCEDURE OR NOT. 07042000
+ INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000
+ INFORMATION; 07044000
+ PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000
+ VALUE FBIT,SBIT,INDEX; 07046000
+ BOOLEAN FBIT,SBIT; 07047000
+ INTEGER INDEX; 07048000
+ BEGIN 07049000
+ INTEGER PCTR,ACLASS,SCLASS; 07050000
+ COMMENT 07051000
+ PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000
+ COMPILED. 07053000
+ ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000
+ SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 07055000
+ THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000
+ TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000
+ SIMILAR MEANINGS; 07058000
+ REAL WHOLE; 07059000
+ COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000
+ PARAMETERS; 07061000
+ BOOLEAN VBIT; 07062000
+ COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO07063000
+ BE CALLED BY VALUE OR BY NAME; 07064000
+ LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000
+ LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000
+ CERR,FGEN; 07067000
+ LABEL 07068000
+ L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000
+ L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000
+ L31,L32,L33; 07071000
+ SWITCH S ~ 07072000
+ L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000
+ L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000
+ L31,L32,L33; 07075000
+ REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000
+ TO REDUCING TOTAL NUMBER; 07077000
+ PCTR ~ 1; 07078000
+ ANOTHER: ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 07079000
+ STACKCT ~ 0; %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)).V0; 07086000
+ IF SCLASS ~GT1.CLASS { INTARRAYID AND 07087000
+ SCLASS } BOOSTRPROCID 07088000
+ THEN IF GT1 ~ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000
+ THEN SCLASS ~ SCLASS-GT1+1 07090000
+ COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-07091000
+ AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000
+ SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000
+ END; 07094000
+ IF T1 ~ TABLE(I+1) ! COMMA THEN 07095000
+ IF T1 ! RTPAREN THEN 07096000
+ COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000
+ HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000
+ BEGIN IF ACLASS { IDMAX OR ACLESS = SUPERLISTID THEN 07099000
+ CHECKER(WHOLE); 07099500
+ IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000
+ THEN BEGIN 07101000
+ COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000
+ HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000
+ SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000
+ IF ACLASS = SUPERFRMTID THEN 07105000
+ BEGIN ACLASS ~ FRMTID; GO TO FGEN END; 07106000
+ IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000
+ THEN BEGIN 07108000
+ T4~L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500
+ IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505
+ ACLASS ~ FILEID; 07109000
+ COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000
+ PASSFILE; 07111000
+ IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200
+ BEGIN 07111210
+ IF VBIT THEN 07111220
+ BEGIN 07111225
+ T5~L; L~T4; EMITO(MKS); L~T5; T5~0 ; 07111230
+ END ; 07111235
+ ACLASS~IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240
+ THEN REALID ELSE BOOID ; 07111250
+ IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255
+ IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260
+ BEGIN 07111265
+ SIMPARITH ; 07111270
+ IF ELCLASS=RELOP THEN 07111275
+ BEGIN 07111280
+ ACLASS~BOOID; RELATION ; 07111285
+ SIMPBOO ; 07111290
+ END ; 07111295
+ END ; 07111300
+ IF NOT VBIT THEN 07111303
+ BEGIN 07111307
+ EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310
+ EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315
+ EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320
+ EMITB(BFW,T4+2,L) ; 07111325
+ STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330
+ END ; 07111335
+ GO BS ; 07111340
+ END OF FILE ATTRIBUTE PARAMETER EXPRESSION;07111345
+ IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000
+ I ~ I-1; 07113000
+ COMMENT IF WE ARE HERE IT IS INDEXED; 07114000
+ CHECKPRESENCE; 07115000
+ EMITO(LOD); PANA; EMITO(CDC); 07116000
+ IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000
+ THEN BEGIN ERR(121); GO TO CERR END 07118000
+ COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000
+ STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000
+ RELEASE ON THIS DESCRIPTOR; 07121000
+ ELSE GO TO COMMON END ; 07122000
+ IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500
+ EMITV(WHOLE.ADDRESS); 07122510
+ IF WHOLE.ADDRESS>1023 THEN EMITO(PRTE); 07122520
+ EMITO(LOD); 07122530
+ ACLASS~LISTID; GO TO BS END; 07122540
COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000
-NORMAL: IF VBIT THEN 07124000
-VE: T1 _ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000
+ NORMAL: IF VBIT THEN 07124000
+ VE: T1 ~ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000
ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000
IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000
- COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME; 07128000
- T2 _ BAE; 07129000
- T3 _ PROGDESCBLDR(0,L,0); 07130000
- COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000
+ COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;07128000
+ T2 ~ BAE; 07129000
+ T3 ~ PROGDESCBLDR(0,L,0); 07130000
+ COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000
AROUND CODE FOR EXPRESSION; 07132000
- T1 _ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000
-STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000
+ T1 ~ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000
+ STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000
COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000
PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000
INTO JUNK; 07137000
-LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000
- COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000
+ LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000
+ COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000
THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000
EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000
THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000
OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000
END OF NAME CALL EXPRESSIONS; 07144000
- ACLASS _ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000
+ ACLASS ~ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000
THEN BOOID ELSE LABELID; GO TO BS; 07146000
END OF EXPRESSION CALL CODE; 07147000
- COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000
+ COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000
ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000
- IF SCLASS>= BOOARRAYID THEN 07150000
- IF SCLASS <=INTARRAYID THEN 07151000
- BEGIN T2 _ TAKE(INDEX+PCTR).INCR; 07152000
- COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER. 07153000
- THUS WE MUST HAVE A ROW DESIGNATOR; 07154000
- IF ACLASS ! BOOARRAYID THEN ACLASS _ REALARRAYID; 07155000
- COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000
- VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000
- THEN BEGIN ERR(123); GO TO EXIT END; 07158000
- COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000
- COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000
- STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000
-LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000
- THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000
- ELSE GO TO BS END; 07167000
- IF VBIT THEN GO TO VE; 07168000
- COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000
- VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000
- IF SBIT 07171000
- THEN BEGIN 07172000
- T6 _ FL; VARIABLE(T6); 07173000
- IF T6 ! 0 THEN GO TO BS; 07174000
- FLAG(122);GO TO CERR END; 07175000
- COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000
- CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000
- VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000
- THAN THIS IT SETS T6 TO ZERO; 07179000
- COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000
- WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000
- 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 07182000
- 2) A SUBSCRIPTED VARIABLE, OR 07183000
- 3) A GENUINE NAME CALL EXPRESSION; 07184000
- IF TABLE(I+2) = LITNO AND 07185000
- ( GT1 _ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000
- THEN BEGIN 07187000
- COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000
- CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000
- ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000
- VARIABLE(FL); 07191000
- ACLASS _ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000
- REALID; GO TO BS END; 07193000
- T2 _ BAE; T3 _ L; 07194000
- COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000
- IF WE HAVE ROW DESIGNATOR; 07196000
- T6 _ FA; VARIABLE(T6); 07197000
- IF TABLE(I-2) = FACTOP 07198000
- THEN BEGIN 07199000
- COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000
- EMITB(BFW,T2,T3); T2 _ STLB; GO TO LOWBD END; 07201000
- COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000
- T3 _ PROGDESCBLDR(0,T3,0); 07203000
- T1 _ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000
- IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000
- COMMENT WE ARE AT END OF PARAMETER; 07206000
- IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000
- GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000
- GO TO LRTS; 07209000
- IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000
- IF ELCLASS = RELOP THEN BEGIN T1 _ BTYPE; RELATION; 07211000
-FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000
- COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000
- ACTUAL PARAMETER; 07214000
- IF ACLASS<= IDMAX OR ACLASS = SUPERLISTID THEN 07215000
- CHECKER(WHOLE); STEPIT; 07215500
- GO TO S[ACLASS-3]; 07216000
- IF ACLASS = 0 THEN FLAG(100) ELSE 07217000
- IF ACLASS= SUPERLISTID THEN 07217500
- BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510
- FLAG(126); 07217520
-CERR: 07218000
-L12:L13:L14:L15:L16: 07219000
- COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000
- FLAG(125); ERRORTOG _ TRUE; GO TO COMMON; 07221000
-LODPOINT: 07222000
-L4:L8: 07223000
- COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000
- EMITPAIR(ADDRSF,LOD); 07225000
-NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000
- COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000
- STREAM PROCEDURES; 07228000
-BS: IF SCLASS ! ACLASS THEN 07229000
- IF SCLASS ! LOCLID THEN 07230000
- COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000
- AGREE; 07232000
- BEGIN FLAG(123); GO TO CERR END; 07233000
-COMMON: 07234000
- COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000
- PCTR _ PCTR+1; 07236000
- IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000
- IF ELCLASS ! RTPAREN 07238000
- THEN BEGIN ERROR(129); GO TO EXIT END; 07239000
- IF NOT FBIT THEN 07240000
- IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000
- THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000
- ERR(128); GO TO EXIT END; 07243000
- STEPIT; GO TO EXIT; 07244000
-L5: 07245000
- COMMENT FORMATS; 07246000
- I_I-1; 07247000
-FGEN: PASSFORMAT; 07248000
- IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000
- I_I+1; 07250000
- GO TO BS; 07251000
-L6: 07252000
- COMMENT SUPERFORMAT; 07253000
- IF FBIT 07254000
- THEN BEGIN EMITV(ADDRSF); ADDRSF _ ADDRSF-1 END 07255000
- ELSE BEGIN I _ I -1; EMITL(TAKEFRST); I _ I+1 END; 07256000
- GO TO LODPOINT; 07257000
-L7: 07258000
- COMMENT FILE; 07259000
- I _ I-1; ELCLASS _ FILEID; 07260000
- PASSFILE; GO TO BS; 07261000
-L9: 07262000
- COMMENT SWITCH; 07263000
- IF FORMALF THEN GO TO LODPOINT; 07264000
- COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000
- MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000
- DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000
- ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000
- THEY ARE OR NOT; 07269000
- T2 _ BAE; T3_PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000
- GENGO(WHOLE); 07271000
- EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000
-L10: 07273000
- COMMENT PROCEDURE; 07274000
- TB1 _ TRUE; IF FORMALF THEN GO LODPOINT; 07275000
-LP: IF T1 _ TAKE(WHOLE _ GIT(WHOLE)).[40:8] = 0 07276000
- THEN BEGIN 07277000
- COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000
- IF TB1 THEN GO TO LODPOINT; 07279000
- COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000
- DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE); 07281000
- IF NOT FBIT THEN 07281900
- IF SCLASS<= INTPROCID THEN SCLASS _ SCLASS+4; 07282000
- I _ I-2; STEPIT; 07283000
- GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000
- EXPRESSIONS HANDLE THIS CASE; 07285000
- END THE CASE OF ZERO PARAMETERS; 07286000
- TB1 _ TRUE; 07287000
- FOR T2 _ 1 STEP 1 UNTIL T1 07288000
- DO BEGIN 07289000
- IF BOOLEAN(T3_TAKE(WHOLE+T2)).V0 07290000
- THEN 07291000
- IF T4 _ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000
- THEN BEGIN 07293000
- COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000
- IF TB1 THEN 07295000
- BEGIN 07296000
- COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000
- VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000
- PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000
- VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000
- PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK 07301000
- CONSTRUCTIONS; 07302000
-GOBBLE: 07303000
- TB1 _ FALSE; T5 _ BAE; 07304000
- T6 _ PROGDESCBLDR(1,L,0) END; 07305000
- EMITV(T4 _ T3.ADDRESS); EMITPAIR(T4,STD)END END; 07306000
- COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000
- IF NOT TB1 07308000
- THEN BEGIN 07309000
- COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000
- EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000
- CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF _ T6 END; 07312000
- GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000
-L11: 07314000
- COMMENT INTRINSIC PROCEDURE; 07315000
- ADDRSF _ GNAT(WHOLE); 07316000
- COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000
- ACLASS _ REALPROCID; 07318000
- T3.ADDRESS _ 897; T2_T1_1; GO TO GOBBLE; 07319000
- COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000
- PROCEDURES; 07321000
-L19:L20: 07322000
- COMMENT ALFAPROC AND INTPROC; 07323000
- ACLASS _ REALPROCID; 07324000
-L17:L18: 07325000
- COMMENT BOOPROC AND REAL PROC; 07326000
- IF FORMALF 07327000
- THEN BEGIN 07328000
- COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000
- IF SCLASS > INTPROCID THEN ACLASS _ ACLASS+4; 07330000
- COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000
- EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000
- PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000
- IF VBIT 07334000
- THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000
- ELSE GO TO LODPOINT; 07336000
- COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000
- DESCRIPTOR ALONG; 07338000
- END; 07339000
- TB1 _ FALSE; GO TO LP; 07340000
-L23:L24: 07341000
- COMMENT INTEGER AND ALPHA IDS; 07342000
- ACLASS _ REALID; 07343000
-L21:L22: 07344000
- COMMENT BOOLEAN AND REAL IDS; 07345000
- IF VBIT THEN EMITV(ADDRSF) 07346000
- ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000
- THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000
- COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000
- AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000
- THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000
- GO TO BS; 07352000
-L27:L28: 07353000
- COMMENT INTEGER AND ALPHA ARRAYS; 07354000
- ACLASS _ REALARRAYID; 07355000
-L25:L26: 07356000
- COMMENT BOOLEAN AND REAL ARRAYS; 07357000
- EMITPAIR(ADDRSF,LOD); 07358000
- IF SBIT THEN GO TO BS; 07359000
- COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000
- T1 _ TAKE(WHOLE _ GIT(WHOLE)).NODIMPART; 07361000
- FOR T2 _ 1 STEP 1 UNTIL T1 07362000
- DO BEGIN 07363000
- IF T3 _ (STLB _ TAKE(WHOLE+T2)).[35:11] >1023 07364000
- THEN EMITV(T3) ELSE EMIT(STLB); 07365000
- IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000
- COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000
- IF FBIT THEN GO TO BS; 07368000
- IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000
- COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000
- OF DIMENSIONS; 07371000
-L29: 07372000
- COMMENT LABEL; 07373000
- ELCLASS _ TABLE(I_I-1); DEXP; GO TO NSBS; 07374000
-L30: 07375000
- COMMENT TRUTH VALUE; 07376000
- EMITL(ADDRSF); ACLASS _ BOOID; GO TO BSX; 07377000
-L32: 07378000
- COMMENT LITERAL; 07379000
- EMITL(ADDRSF); 07380000
-BSXXX: ACLASS _ REALID; 07381000
-BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000
-L31:L33: 07383000
- EMITNUM(C); GO TO BSXXX; 07384000
-EXIT: STACKCT _ 0 END OF ACTUALPARAPART; %A 07385000
-COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000
- FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000
- PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000
- IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000
- OPERATIONS; 07390000
-PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000
- BEGIN 07392000
- REAL HOLE,ADDRESS; 07393000
- LABEL EXIT; 07394000
- SCATTERELBAT; 07395000
- HOLE_ ELBAT[I]; 07396000
- ADDRESS _ ADDRSF; 07397000
- CHECKER(HOLE); 07398000
- IF ELCLASS ! PROCID THEN 07399000
- IF NOT FORMALF THEN 07400000
- IF TABLE(I+1) = ASSIGNOP THEN 07401000
- BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000
- COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000
- IF ELCLASS ! PROCID EQV FROM 07404000
- THEN BEGIN ERR(159); GO TO EXIT END; 07405000
- COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000
- STEPIT; 07407000
- EMITO(MKS); 07408000
- IF ELCLASS = LEFTPAREN 07409000
- THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000
- ELSE IF FORMALF THEN 07411000
- IF FROM THEN ELSE L_L-1 07411100
- ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000
- EMITV(ADDRESS); 07413000
- COMMENT MONITOR CODE GOES HERE; 07414000
- IF HOLE < 0 07415000
- THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR 07416000
- ; 07417000
- EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000
- EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000
- EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE); 07420000
- EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE 07421000
- (GIT(HOLE)),FUNCMONFILE); %109- 07422000
- EMITNUM(1&CARDNUMBER[1:4:44]); %109- 07422100
- EMITV(GNAT(PRINTI)); 07423000
- END; 07424000
-EXIT: END PROCSTMT; 07425000
-COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES; 07426000
-PROCEDURE STRMPROCSTMT; 07427000
- BEGIN 07428000
- INTEGER ADDRS; 07429000
- IF ADDRS _ ELBAT[I].ADDRESS = 0 07430000
- THEN BEGIN 07431000
- UNKNOWNSTMT; 07432000
- END 07433000
+ IF SCLASS } BOOARRAYID THEN 07150000
+ IF SCLASS {INTARRAYID THEN 07151000
+ BEGIN T2 ~ TAKE(INDEX+PCTR).INCR; 07152000
+ COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.07153000
+ THUS WE MUST HAVE A ROW DESIGNATOR; 07154000
+ IF ACLASS ! BOOARRAYID THEN ACLASS ~ REALARRAYID; 07155000
+ COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000
+ VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000
+ THEN BEGIN ERR(123); GO TO EXIT END; 07158000
+ COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000
+ COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000
+ STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000
+ LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000
+ THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000
+ ELSE GO TO BS END; 07167000
+ IF VBIT THEN GO TO VE; 07168000
+ COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000
+ VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000
+ IF SBIT 07171000
+ THEN BEGIN 07172000
+ T6 ~ FL; VARIABLE(T6); 07173000
+ IF T6 ! 0 THEN GO TO BS; 07174000
+ FLAG(122);GO TO CERR END; 07175000
+ COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000
+ CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000
+ VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000
+ THAN THIS IT SETS T6 TO ZERO; 07179000
+ COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000
+ WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000
+ 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 07182000
+ 2) A SUBSCRIPTED VARIABLE, OR 07183000
+ 3) A GENUINE NAME CALL EXPRESSION; 07184000
+ IF TABLE(I+2) = LITNO AND 07185000
+ ( GT1 ~ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000
+ THEN BEGIN 07187000
+ COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000
+ CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000
+ ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000
+ VARIABLE(FL); 07191000
+ ACLASS ~ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000
+ REALID; GO TO BS END; 07193000
+ T2 ~ BAE; T3 ~ L; 07194000
+ COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000
+ IF WE HAVE ROW DESIGNATOR; 07196000
+ T6 ~ FA; VARIABLE(T6); 07197000
+ IF TABLE(I-2) = FACTOP 07198000
+ THEN BEGIN 07199000
+ COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000
+ EMITB(BFW,T2,T3); T2 ~ STLB; GO TO LOWBD END; 07201000
+ COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000
+ T3 ~ PROGDESCBLDR(0,T3,0); 07203000
+ T1 ~ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000
+ IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000
+ COMMENT WE ARE AT END OF PARAMETER; 07206000
+ IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000
+ GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000
+ GO TO LRTS; 07209000
+ IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000
+ IF ELCLASS = RELOP THEN BEGIN T1 ~ BTYPE; RELATION; 07211000
+ FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000
+ COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000
+ ACTUAL PARAMETER; 07214000
+ IF ACLASS { IDMAX OR ACLASS = SUPERLISTID THEN 07215000
+ CHECKER(WHOLE); STEPIT; 07215500
+ GO TO S[ACLASS-3]; 07216000
+ IF ACLASS = 0 THEN FLAG(100) ELSE 07217000
+ IF ACLASS= SUPERLISTID THEN 07217500
+ BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510
+ FLAG(126); 07217520
+ CERR: 07218000
+ L12:L13:L14:L15:L16: 07219000
+ COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000
+ FLAG(125); ERRORTOG ~ TRUE; GO TO COMMON; 07221000
+ LODPOINT: 07222000
+ L4:L8: 07223000
+ COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000
+ EMITPAIR(ADDRSF,LOD); 07225000
+ NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000
+ COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000
+ STREAM PROCEDURES; 07228000
+ BS: IF SCLASS ! ACLASS THEN 07229000
+ IF SCLASS ! LOCLID THEN 07230000
+ COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000
+ AGREE; 07232000
+ BEGIN FLAG(123); GO TO CERR END; 07233000
+ COMMON: 07234000
+ COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000
+ PCTR ~ PCTR+1; 07236000
+ IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000
+ IF ELCLASS ! RTPAREN 07238000
+ THEN BEGIN ERROR(129); GO TO EXIT END; 07239000
+ IF NOT FBIT THEN 07240000
+ IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000
+ THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000
+ ERR(128); GO TO EXIT END; 07243000
+ STEPIT; GO TO EXIT; 07244000
+ L5: 07245000
+ COMMENT FORMATS; 07246000
+ I~I-1; 07247000
+ FGEN: PASSFORMAT; 07248000
+ IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000
+ I~I+1; 07250000
+ GO TO BS; 07251000
+ L6: 07252000
+ COMMENT SUPERFORMAT; 07253000
+ IF FBIT 07254000
+ THEN BEGIN EMITV(ADDRSF); ADDRSF ~ ADDRSF-1 END 07255000
+ ELSE BEGIN I ~ I -1; EMITL(TAKEFRST); I ~ I+1 END; 07256000
+ GO TO LODPOINT; 07257000
+ L7: 07258000
+ COMMENT FILE; 07259000
+ I ~ I-1; ELCLASS ~ FILEID; 07260000
+ PASSFILE; GO TO BS; 07261000
+ L9: 07262000
+ COMMENT SWITCH; 07263000
+ IF FORMALF THEN GO TO LODPOINT; 07264000
+ COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000
+ MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000
+ DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000
+ ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000
+ THEY ARE OR NOT; 07269000
+ T2 ~ BAE; T3~PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000
+ GENGO(WHOLE); 07271000
+ EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000
+ L10: 07273000
+ COMMENT PROCEDURE; 07274000
+ TB1 ~ TRUE; IF FORMALF THEN GO LODPOINT; 07275000
+ LP: IF T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).[40:8] = 0 07276000
+ THEN BEGIN 07277000
+ COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000
+ IF TB1 THEN GO TO LODPOINT; 07279000
+ COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000
+ DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);07281000
+ IF NOT FBIT THEN 07281900
+ IF SCLASS { INTPROCID THEN SCLASS ~ SCLASS+4; 07282000
+ I ~ I-2; STEPIT; 07283000
+ GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000
+ EXPRESSIONS HANDLE THIS CASE; 07285000
+ END THE CASE OF ZERO PARAMETERS; 07286000
+ TB1 ~ TRUE; 07287000
+ FOR T2 ~ 1 STEP 1 UNTIL T1 07288000
+ DO BEGIN 07289000
+ IF BOOLEAN(T3~TAKE(WHOLE+T2)).V0 07290000
+ THEN 07291000
+ IF T4 ~ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000
+ THEN BEGIN 07293000
+ COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000
+ IF TB1 THEN 07295000
+ BEGIN 07296000
+ COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000
+ VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000
+ PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000
+ VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000
+ PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK07301000
+ CONSTRUCTIONS; 07302000
+ GOBBLE: 07303000
+ TB1 ~ FALSE; T5 ~ BAE; 07304000
+ T6 ~ PROGDESCBLDR(1,L,0) END; 07305000
+ EMITV(T4 ~ T3.ADDRESS); EMITPAIR(T4,STD)END END;07306000
+ COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000
+ IF NOT TB1 07308000
+ THEN BEGIN 07309000
+ COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000
+ EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000
+ CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000
+ GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000
+ L11: 07314000
+ COMMENT INTRINSIC PROCEDURE; 07315000
+ ADDRSF ~ GNAT(WHOLE); 07316000
+ COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000
+ ACLASS ~ REALPROCID; 07318000
+ T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000
+ COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000
+ PROCEDURES; 07321000
+ L19:L20: 07322000
+ COMMENT ALFAPROC AND INTPROC; 07323000
+ ACLASS ~ REALPROCID; 07324000
+ L17:L18: 07325000
+ COMMENT BOOPROC AND REAL PROC; 07326000
+ IF FORMALF 07327000
+ THEN BEGIN 07328000
+ COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000
+ IF SCLASS > INTPROCID THEN ACLASS ~ ACLASS+4; 07330000
+ COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000
+ EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000
+ PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000
+ IF VBIT 07334000
+ THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000
+ ELSE GO TO LODPOINT; 07336000
+ COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000
+ DESCRIPTOR ALONG; 07338000
+ END; 07339000
+ TB1 ~ FALSE; GO TO LP; 07340000
+ L23:L24: 07341000
+ COMMENT INTEGER AND ALPHA IDS; 07342000
+ ACLASS ~ REALID; 07343000
+ L21:L22: 07344000
+ COMMENT BOOLEAN AND REAL IDS; 07345000
+ IF VBIT THEN EMITV(ADDRSF) 07346000
+ ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000
+ THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000
+ COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000
+ AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000
+ THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000
+ GO TO BS; 07352000
+ L27:L28: 07353000
+ COMMENT INTEGER AND ALPHA ARRAYS; 07354000
+ ACLASS ~ REALARRAYID; 07355000
+ L25:L26: 07356000
+ COMMENT BOOLEAN AND REAL ARRAYS; 07357000
+ EMITPAIR(ADDRSF,LOD); 07358000
+ IF SBIT THEN GO TO BS; 07359000
+ COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000
+ T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000
+ FOR T2 ~ 1 STEP 1 UNTIL T1 07362000
+ DO BEGIN 07363000
+ IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000
+ THEN EMITV(T3) ELSE EMIT(STLB); 07365000
+ IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000
+ COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000
+ IF FBIT THEN GO TO BS; 07368000
+ IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000
+ COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000
+ OF DIMENSIONS; 07371000
+ L29: 07372000
+ COMMENT LABEL; 07373000
+ ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000
+ L30: 07375000
+ COMMENT TRUTH VALUE; 07376000
+ EMITL(ADDRSF); ACLASS ~ BOOID; GO TO BSX; 07377000
+ L32: 07378000
+ COMMENT LITERAL; 07379000
+ EMITL(ADDRSF); 07380000
+ BSXXX: ACLASS ~ REALID; 07381000
+ BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000
+ L31:L33: 07383000
+ EMITNUM(C); GO TO BSXXX; 07384000
+ EXIT: STACKCT ~ 0 END OF ACTUALPARAPART; %A 07385000
+ COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000
+ FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000
+ PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000
+ IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000
+ OPERATIONS; 07390000
+ PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000
+ BEGIN 07392000
+ REAL HOLE,ADDRESS; 07393000
+ LABEL EXIT; 07394000
+ SCATTERELBAT; 07395000
+ HOLE~ ELBAT[I]; 07396000
+ ADDRESS ~ ADDRSF; 07397000
+ CHECKER(HOLE); 07398000
+ IF ELCLASS ! PROCID THEN 07399000
+ IF NOT FORMALF THEN 07400000
+ IF TABLE(I+1) = ASSIGNOP THEN 07401000
+ BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000
+ COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000
+ IF ELCLASS ! PROCID EQV FROM 07404000
+ THEN BEGIN ERR(159); GO TO EXIT END; 07405000
+ COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000
+ STEPIT; 07407000
+ EMITO(MKS); 07408000
+ IF ELCLASS = LEFTPAREN 07409000
+ THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000
+ ELSE IF FORMALF THEN 07411000
+ IF FROM THEN ELSE L~L-1 07411100
+ ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000
+ EMITV(ADDRESS); 07413000
+ COMMENT MONITOR CODE GOES HERE; 07414000
+ IF HOLE < 0 07415000
+ THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR07416000
+ ; 07417000
+ EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000
+ EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000
+ EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE);07420000
+ EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE07421000
+ (GIT(HOLE)),FUNCMONFILE); %109-07422000
+ EMITNUM(1&CARDNUMBER[1:4:44]); %109-07422100
+ EMITV(GNAT(PRINTI)); 07423000
+ END; 07424000
+ EXIT: END PROCSTMT; 07425000
+ COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000
+ PROCEDURE STRMPROCSTMT; 07427000
+ BEGIN 07428000
+ INTEGER ADDRS; 07429000
+ IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000
+ THEN BEGIN 07431000
+ UNKNOWNSTMT; 07432000
+ END 07433000
07434000
07435000
07436000
07437000
07438000
07439000
- ELSE BEGIN 07440000
- IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000
- GT1 _ (GT2 _ TAKE(GT3 _ GIT(ELBAT[I-1]))).[14:10]; 07442000
- GT4 _ GT1-GT2.[7:6]; 07443000
- FOR GT1 _ GT1-1 STEP -1 UNTIL GT4 07444000
- DO EMITV(IF GT1>= 512 THEN GT1+1024 ELSE GT1); 07445000
- COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000
- JUMPS INSIDE OF STREAM PROCEDURES; 07447000
- GT4 _ GT2.[1:6]; 07448000
- FOR GT1 _ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000
- COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE 07450000
- OF STREAM PROCEDURES; 07451000
- IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000
- ELSE BEGIN 07453000
- ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000
- END END STRMPROCSTMT; 07455000
-COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000
- ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000
-INTEGER PROCEDURE BAE; 07458000
- BEGIN BAE _ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000
+ ELSE BEGIN 07440000
+ IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000
+ GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000
+ GT4 ~ GT1-GT2.[7:6]; 07443000
+ FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000
+ DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000
+ COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000
+ JUMPS INSIDE OF STREAM PROCEDURES; 07447000
+ GT4 ~ GT2.[1:6]; 07448000
+ FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000
+ COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE07450000
+ OF STREAM PROCEDURES; 07451000
+ IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000
+ ELSE BEGIN 07453000
+ ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000
+ END END STRMPROCSTMT; 07455000
+ COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000
+ ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000
+ INTEGER PROCEDURE BAE; 07458000
+ BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000
COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000
RELEASE() % AUXMEM RELEASE STATEMENT. 07460250
RELEASE() % DATACOM RELEASE STATEMENT. 07460500
@@ -5740,119 +5740,119 @@ PARENCHECK: 07471500
IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750
EXIT: 07472000
END RELSESTMT; 07472250
-COMMENT DOTSTMT HANDLES THE DO STATEMENT; 07481000
-PROCEDURE DOSTMT; 07482000
- BEGIN INTEGER TL; 07483000
- DIALA _ DIALB _ 0; 07484000
+ COMMENT DOTSTMT HANDLES THE DO STATEMENT; 07481000
+ PROCEDURE DOSTMT; 07482000
+ BEGIN INTEGER TL; 07483000
+ DIALA ~ DIALB ~ 0; 07484000
ADJUST; 07484100
- STEPIT; TL_L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000
+ STEPIT; TL~L; STMT; IF ELCLASS ! UNTILV THEN ERR(131)07485000
ELSE BEGIN 07486000
STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000
END DOSTMT; 07488000
-COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000
-PROCEDURE WHILESTMT; 07490000
- BEGIN INTEGER BACK,FRONT; 07491000
- DIALA _ DIALB _ 0; 07492000
- ADJUST; 07492100
- STEPIT; BACK _ L; BEXP; FRONT _ BUMPL; 07493000
- IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000
- BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000
- CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000
-COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000
- EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000
- OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000
- STORAGE RETURNED. SEE DEXP AND GENGO; 07500000
-PROCEDURE GOSTMT; 07501000
- BEGIN 07502000
- REAL ELBW; 07503000
- LABEL GOMCP,EXIT; 07504000
- IF STEPI = TOV THEN STEPIT; 07505000
- IF ELCLASS = LABELID THEN TB1 _ TRUE 07506000
- ELSE IF ELCLASS = SWITCHID THEN TB1 _ FALSE ELSE GO GOCMP; 07507000
- IF NOT LOCAL(ELBAT[I]) THEN GO GOCMP; 07508000
- IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000
- CONSTANTCLEAN; GO EXIT END; 07510000
- ELBW _ ELBAT[I]; 07511000
- IF ELBW < 0 07512000
- THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000
- EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000
- CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)), 07515000
- SWITMONFILE); %109- 07516000
- EMITNUM(0&CARDNUMBER[1:4:44]); %109- 07516100
- EMITV(GNAT( %109- 07516200
- PRINTI)); 07517000
- END; 07518000
- BANA; EMITPAIR(JUNK,ISD); 07519000
- IF (GT1 _ TAKE(GT2 _ GIT(ELBW))).[24:12] = 0 07520000
- AND ELBW.ADDRESS = 0 THEN BEGIN 07521000
- PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000
- EMITB(BBW,L,GT4_GT1.[36:12]); 07523000
- EMITB(BFW,GT4+13,L+3); 07524000
- EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000
- ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000
- GO EXIT; 07527000
- GOMCP: GOTOG _ FALSE; DEXP; 07528000
- IF GOTOG THEN 07529000
- BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100
- ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200
- EXIT:END GOSTMT; 07530000
-COMMENT GOGEN GENERATES CODE TO GO TO A LABEL. GIVEN THAT LABEL AS A 07531000
- PARAMETER. GOGEN ASSUMES THA THE LABEL IS LOCAL. THE 07532000
- PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL 07533000
- OR NOT; 07534000
-PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000
- VALUE LABELBAT,BRANCHTYPE; 07536000
- REAL LABELBAT,BRANCHTYPE; 07537000
- BEGIN 07538000
- IF BOOLEAN(GT1_TAKE(GT2_GIT(LABELBAT))).[1:1] 07539000
- THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000
- COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000
- NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000
- THAT WE NOW KNOW WHERE TO GO; 07543000
- ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000
- PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000
-COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000
- A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000
-BOOLEAN PROCEDURE SIMPGO; 07548000
- BEGIN LABEL EXIT; 07549000
- IF ELCLASS = GOV 07550000
- THEN BEGIN 07551000
- IF STEPI = TOV THEN STEPIT; 07552000
- IF ELCLASS = LABELID THEN 07553000
- IF LOCAL(ELBAT[I]) THEN 07554000
- BEGIN SIMPGO _ TRUE; GO EXIT END; 07555000
- I _ I-1; ELCLASS _ GOV END; 07556000
- EXIT: END SIMPGO; 07557000
-COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000
- OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000
- EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000
-PROCEDURE IFSTMT; 07561000
- BEGIN REAL T1,T2; LABEL EXIT; 07562000
- IFCLAUSE; 07563000
- IF SIMPGO 07564000
- THEN BEGIN 07565000
- T1 _ ELBAT[I]; 07566000
- IF STEPI = ELSEV 07567000
- THEN BEGIN 07568000
- STEPIT; 07569000
- IF SIMPGO 07570000
- THEN BEGIN 07571000
- GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000
- STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000
- STMT ; GO TO EXIT END END ; 07574000
- EMITLNG; GOGEN(T1,BFC); 07575000
- GO EXIT END; 07576000
- T1 _ BUMPL; STMT; 07577000
- IF ELCLASS ! ELSEV THEN 07578000
- BEGIN DIALA _ DIALB _ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000
- STEPTIT; 07580000
- IF SIMPGO 07581000
- THEN BEGIN 07582000
- T2 _ L; L _T1-2;GOGEN(ELBAT[I],BFC); L _ T2; 07583000
- STEPIT; GO EXIT END; 07584000
- T2 _ BUMPL; CONSTANTCLEAN; 07585000
- EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000
- EXIT: END IFSTMT; 07587000
+ COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000
+ PROCEDURE WHILESTMT; 07490000
+ BEGIN INTEGER BACK,FRONT; 07491000
+ DIALA ~ DIALB ~ 0; 07492000
+ ADJUST; 07492100
+ STEPIT; BACK ~ L; BEXP; FRONT ~ BUMPL; 07493000
+ IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000
+ BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000
+ CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000
+ COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000
+ EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000
+ OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000
+ STORAGE RETURNED. SEE DEXP AND GENGO; 07500000
+ PROCEDURE GOSTMT; 07501000
+ BEGIN 07502000
+ REAL ELBW; 07503000
+ LABEL GOMCP,EXIT; 07504000
+ IF STEPI = TOV THEN STEPIT; 07505000
+ IF ELCLASS = LABELID THEN TB1 ~ TRUE 07506000
+ ELSE IF ELCLASS = SWITCHID THEN TB1 ~ FALSE ELSE GO GOCMP;07507000
+ IF NOT LOCAL(ELBAT[I]) THEN GO GOCMP; 07508000
+ IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000
+ CONSTANTCLEAN; GO EXIT END; 07510000
+ ELBW ~ ELBAT[I]; 07511000
+ IF ELBW < 0 07512000
+ THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000
+ EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000
+ CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)), 07515000
+ SWITMONFILE); %109-07516000
+ EMITNUM(0&CARDNUMBER[1:4:44]); %109-07516100
+ EMITV(GNAT( %109-07516200
+ PRINTI)); 07517000
+ END; 07518000
+ BANA; EMITPAIR(JUNK,ISD); 07519000
+ IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000
+ AND ELBW.ADDRESS = 0 THEN BEGIN 07521000
+ PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000
+ EMITB(BBW,L,GT4~GT1.[36:12]); 07523000
+ EMITB(BFW,GT4+13,L+3); 07524000
+ EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000
+ ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000
+ GO EXIT; 07527000
+ GOMCP: GOTOG ~ FALSE; DEXP; 07528000
+ IF GOTOG THEN 07529000
+ BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100
+ ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200
+ EXIT:END GOSTMT; 07530000
+ COMMENT GOGEN GENERATES CODE TO GO TO A LABEL. GIVEN THAT LABEL AS A 07531000
+ PARAMETER. GOGEN ASSUMES THA THE LABEL IS LOCAL. THE 07532000
+ PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000
+ OR NOT; 07534000
+ PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000
+ VALUE LABELBAT,BRANCHTYPE; 07536000
+ REAL LABELBAT,BRANCHTYPE; 07537000
+ BEGIN 07538000
+ IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1] 07539000
+ THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000
+ COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000
+ NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000
+ THAT WE NOW KNOW WHERE TO GO; 07543000
+ ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000
+ PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000
+ COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000
+ A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000
+ BOOLEAN PROCEDURE SIMPGO; 07548000
+ BEGIN LABEL EXIT; 07549000
+ IF ELCLASS = GOV 07550000
+ THEN BEGIN 07551000
+ IF STEPI = TOV THEN STEPIT; 07552000
+ IF ELCLASS = LABELID THEN 07553000
+ IF LOCAL(ELBAT[I]) THEN 07554000
+ BEGIN SIMPGO ~ TRUE; GO EXIT END; 07555000
+ I ~ I-1; ELCLASS ~ GOV END; 07556000
+ EXIT: END SIMPGO; 07557000
+ COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000
+ OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000
+ EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000
+ PROCEDURE IFSTMT; 07561000
+ BEGIN REAL T1,T2; LABEL EXIT; 07562000
+ IFCLAUSE; 07563000
+ IF SIMPGO 07564000
+ THEN BEGIN 07565000
+ T1 ~ ELBAT[I]; 07566000
+ IF STEPI = ELSEV 07567000
+ THEN BEGIN 07568000
+ STEPIT; 07569000
+ IF SIMPGO 07570000
+ THEN BEGIN 07571000
+ GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000
+ STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000
+ STMT ; GO TO EXIT END END ; 07574000
+ EMITLNG; GOGEN(T1,BFC); 07575000
+ GO EXIT END; 07576000
+ T1 ~ BUMPL; STMT; 07577000
+ IF ELCLASS ! ELSEV THEN 07578000
+ BEGIN DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000
+ STEPTIT; 07580000
+ IF SIMPGO 07581000
+ THEN BEGIN 07582000
+ T2 ~ L; L ~T1-2;GOGEN(ELBAT[I],BFC); L ~ T2; 07583000
+ STEPIT; GO EXIT END; 07584000
+ T2 ~ BUMPL; CONSTANTCLEAN; 07585000
+ EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000
+ EXIT: END IFSTMT; 07587000
COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000
ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000
AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000
@@ -5866,62 +5866,62 @@ DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000
BEGIN ERR(133); GO TO EXIT END; 07598000
XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION %116-07598100
% WHEN WE GET AROUND TO THE XREF. %116-07598200
- IF NOT LOCAL(ELBATWORD _ ELBAT[I-1]) 07599000
+ IF NOT LOCAL(ELBATWORD ~ ELBAT[I-1]) 07599000
THEN BEGIN FLAG(134); GO TO ROUND END; 07600000
- LINK _ (ADDITIONAL _ TAKE(INDEX _ GIT(ELBATWORD))) 07601000
+ 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
+ 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
+ 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
+ C ~ BUMPL; 07609500
CONSTANTCLEAN; 07609600
EMITB(BFW,C,L) END;END; 07609700
PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000
- IF ELBATWORD < 0 07611000
- THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000
- OR MONITOR DECLARATION; 07613000
- IF RR1_ADDITIONAL.LABLMONFILE ! 0 07614000
- THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000
- LABELS; 07616000
- EMITO(MKS); PASSALPHA(ELBATWORD); 07617000
- EMITPAIR(GNAT(CHARI),LOD); 07618000
- PASSMONFILE(RR1); %109- 07619000
- EMITNUM(0&CARDNUMBER[1:4:44]); %109- 07619100
- EMITV(GNAT(PRINTI)); 07620000
- END; 07621000
- IF RR1_ADDITIONAL.DUMPEE ! 0 07622000
- THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000
- LABEL COUNTER; 07624000
- EMITV(RR1); EMITL(1); EMITO(ADD); 07625000
- EMITPAIR (RR1,STD); 07626000
- IF RR1_ADDITIONAL.DUMPOR ! 0 07627000
- THEN BEGIN COMMENT EMIT CODE TO CALL 07628000
- THE DUMP ROUTINE; 07629000
+ IF ELBATWORD < 0 07611000
+ THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000
+ OR MONITOR DECLARATION; 07613000
+ IF RR1~ADDITIONAL.LABLMONFILE ! 0 07614000
+ THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000
+ LABELS; 07616000
+ EMITO(MKS); PASSALPHA(ELBATWORD); 07617000
+ EMITPAIR(GNAT(CHARI),LOD); 07618000
+ PASSMONFILE(RR1); %109-07619000
+ EMITNUM(0&CARDNUMBER[1:4:44]); %109-07619100
+ EMITV(GNAT(PRINTI)); 07620000
+ END; 07621000
+ IF RR1~ADDITIONAL.DUMPEE ! 0 07622000
+ THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000
+ LABEL COUNTER; 07624000
+ EMITV(RR1); EMITL(1); EMITO(ADD); 07625000
+ EMITPAIR (RR1,STD); 07626000
+ IF RR1~ADDITIONAL.DUMPOR ! 0 07627000
+ THEN BEGIN COMMENT EMIT CODE TO CALL 07628000
+ THE DUMP ROUTINE; 07629000
07630000
07631000
07632000
- STUFFF(RR1); EMITO 07633000
- (XCH);EMITO(COC); 07634000
+ 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
+ EMITO(DEL); 07641000
+ END; 07642000
+ END; 07643000
+ END; 07644000
+ ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000
+ EXIT: END LABELR; 07646000
PROCEDURE CASESTMT; 07646100
BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110
CASE OF BEGIN 07646120
@@ -5957,63 +5957,63 @@ BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110
BOOLEAN GOTOG; 07646395
REAL ARRAY TEDOC[0:7, 0:127]; 07646400
LABEL LOOP, XIT; 07646410
- LINK _ N _ NULL _ 0; 07646420
+ LINK ~ N ~ NULL ~ 0; 07646420
STEPIT; AEXP; 07646430
IF STEPI ! BEGINV THEN BEGIN ERR( 70); GO TO XIT END; 07646440
EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450
- EMITO(BFW); ADR _ L; 07646460
+ EMITO(BFW); ADR ~ L; 07646460
LOOP: 07646470
- ERRORTOG _ TRUE; 07646475
+ ERRORTOG ~ TRUE; 07646475
IF STEPI = SEMICOLON THEN 07646480
BEGIN COMMENT NULL STATEMENT; 07646485
- TEDOC[N,[38:3], N.[41:7]] _ NULL; 07646490
- NULL _ N _ N+1; GO TO LOOP; 07646495
+ TEDOC[N,[38:3], N.[41:7]] ~ NULL; 07646490
+ NULL ~ N ~ N+1; GO TO LOOP; 07646495
END; 07646500
- TEDOC[N.[38:3], N.[41:7]] _ L-ADR; N _ N + 1; 07646510
- IF GOTOG := SIMPGO THEN ELBAT[I_I-1] _ ELCLASS _ GOV; 07646515
+ TEDOC[N.[38:3], N.[41:7]] ~ L-ADR; N ~ N + 1; 07646510
+ IF GOTOG := SIMPGO THEN ELBAT[I~I-1] ~ ELCLASS ~ GOV; 07646515
STMT; 07646520
IF ELCLASS = SEMICOLON THEN 07646525
BEGIN IF NOT GOTOG THEN 07646530
- BEGIN EMIT(LINK);LINK _ L _ L+1; END; 07646533
+ BEGIN EMIT(LINK);LINK ~ L ~ L+1; END; 07646533
GO TO LOOP; 07646535
END ELSE IF ELCLASS = ENDV THEN 07646538
BEGIN IF NOT GOTOG THEN 07646540
- BEGIN EMIT(LINK); LINK _ L _ L+1; END; 07646543
- TEDOC[N,[38:3], N.[41:7]]_ L-ADR; 07646545
- N _ N+1; 07646548
+ BEGIN EMIT(LINK); LINK ~ L ~ L+1; END; 07646543
+ TEDOC[N,[38:3], N.[41:7]]~ L-ADR; 07646545
+ N ~ N+1; 07646548
END; 07646550
IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555
N := N-1 ; 07646556
WHILE NULL ! 0 DO 07646560
- BEGIN TEMP _ TEDOC[(NULL_NULL-1).[38:3], NULL.[41:7]]; 07646565
- TEDOC[NULL.[38:3], NULL.[41:7]] _ L-ADR; 07646570
- NULL _ TEMP; 07646575
+ 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
+ ENDTOG ~ TRUE; 07646585
COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590
- DO STOPDEFINE _ TRUE UNTIL STEPI<= ENDV AND ELCLASS >=UNTILV 07646595
+ DO STOPDEFINE ~ TRUE UNTIL STEPI { ENDV AND ELCLASS }UNTILV 07646595
OR NOT ENDTOG; 07646600
- ENDTOG _ FALSE; 07646610
+ ENDTOG ~ FALSE; 07646610
COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620
MOVECODE(TEDOC, EDOC); 07646630
- BUILDLINE _ BOOLEAN(2xREAL(BUILDLINE)) ; 07646635
+ BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 07646635
TEMP := SGNO; IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07646640
- SGNO _ SGAVL; 07646650
- Z _ PROGDESCBLDR(LDES, 0, PRT); 07646660
+ 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
+ SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680
+ BUILDLINE ~ BUILDLINE.[46:1] ; 07646685
MOVECODE(TEDOC, EDOC); 07646690
COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700
IF (L-ADR)>1019 THEN ADJUST;% 07646705
WHILE LINK ! 0 DO 07646710
- BEGIN TEMP _ GET(LINK-2); 07646720
+ BEGIN TEMP ~ GET(LINK-2); 07646720
EMITB(BFW, LINK, L); 07646730
- LINK _ TEMP; 07646740
- IF LASTENTRY >=126 THEN 07646750
+ LINK ~ TEMP; 07646740
+ IF LASTENTRY }126 THEN 07646750
BEGIN REAL C; 07646760
COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770
- C _ BUMPL; 07646780
+ C ~ BUMPL; 07646780
CONSTANTCLEAN; 07646790
EMITB(BFW, C, L); 07646800
END; 07646810
@@ -6057,7 +6057,7 @@ PROCEDURE FILLSTMT; 07653500
STEPIT; IF FILLIT(A) THEN GO GOOFUP; 07664000
IF T1=0 THEN T:=T2 07664500
ELSE BEGIN 07665000
- IF (T3:=(T1-1)x(T-T2))+T>1022 THEN 07665500
+ IF (T3:=(T1-1)|(T-T2))+T>1022 THEN 07665500
BEGIN ERROR(305); GO GOOFUP END;%>102307666000
MOVE(T3,A[T2],A[T]); T:=T+T3; 07666500
END; 07667000
@@ -6078,7 +6078,7 @@ PROCEDURE FILLSTMT; 07653500
END 07674500
ELSE MOVE(1,C,A[T]); 07675000
END 07675500
- ELSE IF COUNT<=19 AND ACCUM[1].[18:18]="OCT" THEN 07676000
+ ELSE IF COUNT{19 AND ACCUM[1].[18:18]="OCT" THEN 07676000
BEGIN % GET RID OF "OCT" FOR OCTIZE. 07676500
MOVECHARACTERS(COUNT-3,ACCUM[1],6,ACCUM[1],3); 07677000
IF OCTIZE(ACCUM[1],A[T],19-COUNT,COUNT-3) THEN 07677500
@@ -6106,7 +6106,7 @@ EXIT: 07683000
IF ELCLASS!WITHV THEN 07688000
BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500
STREAMTOG:=TRUE; 07689000
- IF TABLE(I+1)<=IDMAX THEN 07689500
+ IF TABLE(I+1){IDMAX THEN 07689500
IF Q="7INQUI" THEN 07690000
BEGIN 07690500
STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000
@@ -6116,7 +6116,7 @@ EXIT: 07683000
EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000
IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500
MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000
- BUILDLINE:=BOOLEAN(2xREAL(BUILDLINE)) ; 07694500
+ BUILDLINE:=BOOLEAN(2|REAL(BUILDLINE)) ; 07694500
IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000
ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500
ELSE BEGIN 07696000
@@ -6137,7 +6137,7 @@ EXIT: 07699500
LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000
LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000
LGO, LRELSE, LBEG, LBRK, EXIT; 07718000
- SWITCH S _ 07719000
+ SWITCH S ~ 07719000
LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000
LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000
LVAR, 07722000
@@ -6151,28 +6151,28 @@ LVAR, 07722000
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
+ 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
+ BEGIN GT1 ~ BUMPL; 07727070
CONSTANTCLEAN; 07727075
EMITB(BFW, GT1,L); 07727080
END; 07727085
END; 07727090
- STACKCT _ 0; %07727100A
+ STACKCT ~ 0; %A 07727100
AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000
IF ELCLASS = 0 THEN 07728500
BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000
IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100
IF ELCLASS=FILEDID OR ECLASS=SUPERFILEID THEN 07729190
- BEGIN GT1_FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200
+ BEGIN GT1~FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200
FLAG(145); 07729500
LERR: ERR(144); GO TO EXIT; 07730000
LDEC: FLAG(146); 07731000
IF TABLE(I-2) = ENV AND MODE > 0 07732000
- THEN BEGIN I _ I-2; ELCLASS _ ENDV; GO TO EXIT END; 07733000
- I _ I-1; ERRORTOG _ TRUE; BLOCK(FALSE); 07734000
- ELCLASS _ TABLE(I_I-1); GO TO EXIT; 07735000
+ THEN BEGIN I ~ I-2; ELCLASS ~ ENDV; GO TO EXIT END; 07733000
+ I ~ I-1; ERRORTOG ~ TRUE; BLOCK(FALSE); 07734000
+ ELCLASS ~ TABLE(I~I-1); GO TO EXIT; 07735000
07735500
07735510
07735520
@@ -6195,7 +6195,7 @@ LIF: IFSTMT; GO TO EXIT; 07751000
LGO: GOSTMT; GO TO EXIT; 07752000
LRELSE: RELSESTMT; GO TO EXIT; 07753000
LBEG: IF STEPI = DECLARATORS 07754000
- THEN BEGIN I _ I-1; BLOCK(FALSE) END 07755000
+ THEN BEGIN I ~ I-1; BLOCK(FALSE) END 07755000
ELSE COMPOUNDTIAL; 07756000
EXIT: END STMT; 07757000
PROCEDURE CMPLXSTMT; FORWARD ; 07777777
@@ -6227,14 +6227,14 @@ PROCEDURE CMPLXSTMT; FORWARD ; 07777777
EMIT(16); EMITO(COM); EMITO(DEL); 07817000
GO TO XXX; 07818000
END; 07819000
- N _ 1; C _ 8 07820000
+ N ~ 1; C ~ 8 07820000
END ELSE 07821000
IF Q = "5CHAIN" THEN 07821100
- BEGIN N _ 1; C _ 37 END ELSE 07821200
+ BEGIN N ~ 1; C ~ 37 END ELSE 07821200
IF Q = "4WHEN0" THEN 07822000
- BEGIN N _ 0; C _ 6 END ELSE 07823000
+ BEGIN N ~ 0; C ~ 6 END ELSE 07823000
IF Q = "4WAIT0" THEN 07824000
- BEGIN N _ 1; C _ 2 END ELSE 07825000
+ BEGIN N ~ 1; C ~ 2 END ELSE 07825000
IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500
IF Q = "4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000
IF Q = "5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000
@@ -6246,7 +6246,7 @@ PROCEDURE CMPLXSTMT; FORWARD ; 07777777
IF ELCLASS!COMMA THEN GO TO E; 07833000
IF STEPIINTARRAYID THEN 07834000
GO TO E; 07835000
- XMARK(ASSIGNREF); % SEARCH STATEMENT %11607835500-
+ XMARK(ASSIGNREF); % SEARCH STATEMENT %116-07835500
VARIABLE(FL); 07836000
IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000
IF ELCLASS!RTPAREN THEN 07838000
@@ -6270,23 +6270,23 @@ PROCEDURE CMPLXSTMT; FORWARD ; 07777777
EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000
EMITO(DEL); EMITO(DEL); STEPIT; 07857000
END; GO TO XXX; 07858000
- END ELSE 07859000
- IF Q="6UNLOC" THEN 07859010
- BEGIN IF STEPI!LEFTPAREN THEN 07859020
- BEGIN ERR(105); GO TO XXX END; 07859030
- STEPIT; VARIABLE(FL); L _ L-1; 07859040
- IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050
- EMITO(DUP); EMITO(LOD); EMITL(0); 07859060
- EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070
- IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080
- GO TO XXX 07859090
- END ELSE 07859100
-$ SET OMIT = NOT TSPOL 07859900
+ END ELSE 07859000
+ IF Q="6UNLOC" THEN 07859010
+ BEGIN IF STEPI!LEFTPAREN THEN 07859020
+ BEGIN ERR(105); GO TO XXX END; 07859030
+ STEPIT; VARIABLE(FL); L ~ L-1; 07859040
+ IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050
+ EMITO(DUP); EMITO(LOD); EMITL(0); 07859060
+ EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070
+ IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080
+ GO TO XXX 07859090
+ END ELSE 07859100
+ $ SET OMIT = NOT TSPOL 07859900
BEGIN ERROR(100); GO TO XXX END; 07900000
IF STEPI ! LEFTPAREN THEN 07901000
BEGIN ERR(105); GO TO XXX END; 07902000
STEPIT; AEXP; 07903000
- FOR J _ 1 STEP 1 UNTIL N DO 07904000
+ 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
@@ -6294,20 +6294,20 @@ $ SET OMIT = NOT TSPOL 07859900
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
+ FOR J ~ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000
STEPIT; 07913000
XXX: END; 07914000
- PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"_" 07920000
+ PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"~" 07920000
KIND OF STATEMENT. FOR THE RUN-TIME ERROR MESS; 07921000
BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000
- CHECKER(ELBW_ELBAT[I]); STR_IF FAULTOG THEN SND ELSE STD; 07923000
- FAULTOG _ BOOLEAN(1) OR FAULTOG; COMMENT TELLS DEXP TO MESS 07923100
+ CHECKER(ELBW~ELBAT[I]); STR~IF FAULTOG THEN SND ELSE STD; 07923000
+ FAULTOG ~ BOOLEAN(1) OR FAULTOG; COMMENT TELLS DEXP TO MESS 07923100
WITH FAULTLEVEL; 07923150
IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000
IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000
IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100
EMITPAIR(ADRES,STR); 07926000
- FAULTOG_FALSE&(ELBW.LVLINTARRAYID THEN 07939000
@@ -6327,9 +6327,9 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ BEGIN GOGOGO ~ FALSE;% JUST TO MAKE SURE... 07948000
HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000
- L _ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000
+ 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
@@ -6357,10 +6357,10 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ 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
@@ -6375,16 +6375,16 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ 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
+ 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
+ B ~ FALSE; A ~ ELBAT[I]; 08037000
+ SIMPLE ~ REALID { ELCLASS AND ELCLASS{INTID END; 08038000
COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000
PROCEDURE TEST; 08041000
BEGIN 08042000
@@ -6395,27 +6395,27 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000
END TEST; 08051000
BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000
BEGIN 08053000
- CHECKER(VRET_ALL); 08054000
- ADDRES _ ALL.ADDRESS; 08055000
- FORMALV _ ALL.[9:2] = 2; 08056000
- IF T _ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000
- GT1 _ (T-BOOID) MOD 4 < 1 THEN 08058000
- ERR(REAL(T ! 0) x 51 + 100); 08059000
- INT _ GT1 = 3; 08060000
- SIMPI _ T<= INTID END SIMPI; 08061000
+ CHECKER(VRET~ALL); 08054000
+ ADDRES ~ ALL.ADDRESS; 08055000
+ FORMALV ~ ALL.[9:2] = 2; 08056000
+ IF T ~ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000
+ GT1 ~ (T-BOOID) MOD 4 < 1 THEN 08058000
+ ERR(REAL(T ! 0) | 51 + 100); 08059000
+ INT ~ GT1 = 3; 08060000
+ SIMPI ~ T { INTID END SIMPI; 08061000
COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000
PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000
BEGIN 08064000
- IF FORMALV THEN BEGIN EMITO(XCH); S _ FALSE END 08065000
+ 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)x16; 08069000
- EMITO((IF INT THEN T+512 ELSE 4xT)+4) END STORE; 08070000
+ 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
@@ -6434,30 +6434,30 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
EMITB(GET(FORWART-1),FORWART,START); 08086000
IF RETURNSTORE ! 0 08087000
THEN BEGIN 08088000
- L _ STORE; EMITNUM(B-BACK); 08089000
+ 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
+ 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
+ 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
+ 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
+ BACKFIX ~ BUMPL; 08106000
COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000
IF FORMALV THEN CALL(DESC); CALL(OPOC); 08108000
COMMENT FETCH INDEX; 08109000
- IF I > 70 THEN BEGIN NXTELBT _ 1; I _ 0 END 08110000
- ELSE REGO _ I; 08111000
- IF SIMPLEB _ SIMPLE(CONSTANB,B,SIGNB) AND 08112000
+ 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
@@ -6465,13 +6465,13 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ 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
+ BRET ~ L; 08124000
EMITO(BFW) END; 08125000
- EMITO(REAL(SIGNB)x32+ADD); 08126000
+ EMITO(REAL(SIGNB)|32+ADD); 08126000
EMITB(BFW,BACKFIX,L); 08127000
IF ELCLASS = UNTILV 08128000
THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000
@@ -6491,13 +6491,13 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ 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
+ IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000
EMIT(BFC); 08151000
- BRNCH: FORWARDBRANCH _ L; DIALA _ DIALB _ 0; 08152000
+ BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000
IF ELCLASS = COMMA 08153000
THEN BEGIN 08154000
STEPIT; 08155000
@@ -6505,7 +6505,7 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000
ELSE BEGIN 08158000
IF ELCLASS ! DOV 08159000
- THEN BEGIN ERR(154); REGO_L; GO EXIT END; 08160000
+ 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
@@ -6513,20 +6513,20 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
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
+ EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000
+ STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000
+ CONSTANTCLEAN; REGO ~ L; 08170000
FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000
EXIT: END FORLIST; 08172000
REAL T1,T2,T3,T4; 08173000
- NXTELBT _ 1; I _ 0; 08174000
+ NXTELBT ~ 1; I ~ 0; 08174000
STEPIT; 08175000
- IF SIMPI(VRET_ELBAT[I]) 08176000
+ IF SIMPI(VRET~ELBAT[I]) 08176000
THEN BEGIN 08177000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000
XMARK(ASSIGNREF); % FOR STATEMENT %116-08178100
- T1 _ L; IF FORMALV THEN EMITN(ADDRES); 08179000
- K _ 0; 08180000
+ 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
@@ -6536,28 +6536,28 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
BEGIN 08187000
PLUG(CONSTANA,A); 08188000
IF SIGNA THEN EMITO(CHS); 08189000
- RETURNSTORE _ BUMPL; ADJUST; CONSTANTCLEAN; 08190000
- STMTSTART _ L; 08191000
+ RETURNSTORE ~ BUMPL; ADJUST; CONSTANTCLEAN; 08190000
+ STMTSTART ~ L; 08191000
STEPIT; 08192000
- T1 _ (((4096 x RETURNSTORE+STMTSTART)x2+ 08193000
- REAL(CONSTANB))x2+ 08194000
- REAL(CONSTANC))x2+ 08195000
- REAL(SIGNB))x2+ 08196000
+ 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
+ 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
+ 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
@@ -6566,19 +6566,19 @@ PROCEDURE KLUDGE(T); VALUE T; INTEGER T; 07930000
IF FORMALV THEN CALL(OPDC); 08217000
PLUG(CONSTANC,Q); 08218000
IF SIGNC THEN EMITO(CHS); 08219000
- SIMPLEB _ TRUE; TEST; EMITLNG; 08220000
+ 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
+ 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
+ EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000
+ VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000
IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000
END; 08230000
- STEPIT; FORLIST(FALSE); L _ REGO; 08231000
- EXIT: K _ 0 END FORSTMT; 08232000
+ STEPIT; FORLIST(FALSE); L ~ REGO; 08231000
+ EXIT: K ~ 0 END FORSTMT; 08232000
PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000
BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000
SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000
@@ -6636,247 +6636,247 @@ PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000
IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000
EMITV(13) 08287100
END ELSE EMITV(GNAT(INTERPTI)); 08287200
- GOGOGO _ FALSE;% 08287300
+ GOGOGO ~ FALSE;% 08287300
EXIT:; 08288000
END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000
- DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#08289010,
- EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020
- EMITPAIR(JUNK,ISN); EMITO(965) END#08289030;
- PROCEDURE READSTMT; 08290000
- BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH I08291000S
- SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000
- DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT O08293000F
- THE READ OR SPACE STATEMENT. 08294000
- THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF REA08295000D
- STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000
- REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC08297000
- EXPRESSION IN THE SPACE STATEMENT. 08298000
- I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE08299000
- READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08300000
- ARE PASSED TO INTERPTI. 08301000
- *********************************************************08302000*
- ::=REVERSE/ 08303000
- ::=/ 08304000
- ::=[NO]/ 08305000
- ::=[:<[PARITY LABEL>]/ 08306000
- []/[:]08307000/
- 08308000
- CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000
- POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000
- CONVERSION. 08311000
- FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000
- ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-,08313000
- 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR08314000
- 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 LABE08318000L
- DESCRIPTOR FOR THE END OF FILE JUMPS. 08319000
- PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000
- DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000
- + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXAC08322000T
- DISTANCE AND DIRECTION TO SPACE RATHER THAN ON08323000E
- GREATER THAN THE NUMBER OF RECORDS TO BE SPACED A08324000S
- IN ACTION TYPE. 08325000
- LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000
- DESCRIPTRO WHICH WILL EITHER RETUR08327000N
- AN ADDRESS OR VALUE DEPENDING ON 08328000
- THE CALL. 08329000
- N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT.08330000
- READ()08331000
- 08332000
- - - - - - - - - - - - - - - 08333000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABE08334000L
- ,PARITY LABEL) 08335000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000
- READ(,08337000
- ) 08338000
- - - - - - - - - - - - - - - 08339000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000
- ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000
- SPACE(,)08343000
- - - - - - - - - - - - - - - 08344000
- (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000
- PARITY LABEL) 08346000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000
- READ(,08348000
- ,) 08349000
- - - - - - - - - - - - - - - 08350000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000
- ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000
- LABEL,PARITY LABEL) 08353000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000
- READ(,08355000
- *,) 08356000
- - - - - - - - - - - - - - - 08357000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000
- DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000
- READ(,08361000
- ,) 08363000
- - - - - - - - - - - - - - - 08364000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000
- END OF FILE LABEL,PARITY LABEL) 08366000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000
- READ(,08368000
- ,) 08369000
- - - - - - - - - - - - - - - 08370000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000
- DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000
- *********************************************************08373000;
- DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRU08374000E
- IF THE STATEMENT BEING COMPILE08375000D
- IS A READ REVERSE, OTHERWISE I08376000T
- 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 RIGHT08381000
- PARENTHESIS; 08382000
- LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I T08383000O
- BE POINTING AT THE LAST QUANTITY IN THE 08384000
- SECOND PARAMETER; 08385000
- LABEL READXFORM; 08385100
- INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500
- BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600
- BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700
- INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800
- IF STEPI = LEFTPAREN 08386000
- THEN REVERSETOG_SEEKTOG_FALSE; 08387000
- ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000
- REVERSETOG_ACCUM[1]="7REVER"; 08389000
- LOCKTOG_ELCLASS=LOCKV; 08390000
- SEEKTOG_ACCUM[1]="4SEEK0"; 08390500
- IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000
- ELSE BEGIN ERR(420); 08392000
- GO TO EXIT; 08393000
- END; 08394000
- IF CHECK(LEFTPAREN,421); 08395000
- THEN GO TO EXIT; 08396000
- COMMENT ERROR 421 MEANS MISSING LEFT 08397000
- PARENTHESIS IN READ REVERSE STATEMENT; 08398000
- END; 08399000
- EMITO(MKS); 08400000
- IF STEPI>= BOOARRAYID AND ELCLASS<= INTARRAYID THEN 08401000
- BEGIN VARIABLE(FL); 08401020
- IF TABLE(I-2) ! FACTOP THEN 08401030
- BEGIN ERR(422); GO TO EXIT END; 08401040
- WAYI _ TRUE; HOLD _ L; 08401045
- EMIT(11); EMIT(4); EMITO(280); 08401050
- EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060
- EMITO(XCH); EMITL(0); EMITL(1); 08401070
- END ELSE 08401080
- BEGIN 08401090
- EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000
- IF NOT RANGE(FILEID,SUPERFILEID) 08403000
- THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000
- STATEMENT; 08405000
- ERR(422); GO TO EXIT; 08406000
- END; 08407000
- PASSFILE; 08408000
- IF ELCLASS = LFTBRKET 08409000
- THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000
- %%% [*],[*,*],[*,],[],[,*], 08410010
- %%% AND [,]. THE FIRST (LEFTMOST) 08410020
- %%% IS THE READSEEKDISTADDRESS, RESIDING 08410030
- %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000
- %%% IS THE WAIT-TIME, RESIDING IN THE 08411010
- %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 08411020
- %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 08411030
- %%% IN THE ABOVE, NS = NO OR STOP. 08411040
- STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000
- IF RR1_IF ACCUM[1]="2N0000" THEN 1 ELSE 08412010
- IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020
- 0 ! 0 THEN %%% HAVE [NS 08412030
- IF STEPI=COMMA THEN %%% HAVE [NS, 08412040
- IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050
- BEGIN 08412060
- IF RR1=1 THEN EMITNO(1) 08412070
- ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080
- STEPIT ; 08412090
- END 08413000
- ELSE 08413010
- IF ACCUM[1]="4LOCK0" THEN 08413012
- BEGIN %%% [NS,LOCK 08413014
- EMITL(1); EMITD(47,4,1); 08413016
- STEPIT; 08413018
- END ELSE 08413020
- BEGIN %%% HAVE [NS,AEXP 08413022
- IF RR1=2 THEN EMITL(1) ; 08413030
- EMITTIME ; 08413040
- IF RR1=2 THEN 08413050
- BEGIN EMITO(LOR); EMITL(2) END 08413060
- ELSE EMITL(1) ; 08413080
- END 08413090
- ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100
- ELSE BEGIN EMITL(1); EMITL(2) END 08413110
- ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120
- IF STEPI=COMMA THEN %%% HAVE [*, 08413130
- IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000
- BEGIN EMITNO(2); STEPIT END 08414010
- ELSE IF ACCUM[1]="4LOCK0" THEN 08414012
- BEGIN %%% [*,LOCK 08414014
- EMITL(1); EMITD(47,4,1); 08414016
- STEPIT; 08414018
- END ELSE 08414020
- BEGIN EMITTIME; EMITL(2); END % [*,A 08414022
- ELSE EMITNO(2) %%% HAVE ONLY [* 08414030
- ELSE BEGIN %%% HAVE [AEXP 08415000
- AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010
- IF SEEKTOG THEN EMITO(CHS) ; 08415020
- EMITPAIR(JUNK,ISN) ; 08415030
- IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000
- IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010
- ELSE IF ACCUM[1]="4LOCK0" THEN 08416012
- BEGIN %%% [AEXP,LOCK 08416014
- EMITL(1); EMITD(47,4,1); 08416016
- STEPIT; 08416018
- END ELSE 08416020
- BEGIN EMITTIME; EMITO(LOR) END ; 08416022
- EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030
- END ; 08417000
- IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010
- END 08418000
- ELSE IF ELCLASS=LEFTPAREN THEN 08418100
- BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200
- IF STEPI!FACTOP THEN% 08418250
- BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300
- BEGIN EMITL(1); GRABTOG_TRUE; STEPIT END ELSE 08418350
- EMITPAIR(0,LNG); 08418400
- EMITD(33,33,15); 08418500
- EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600
- EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650
- IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700
- EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800
- END 08418900
- ELSE BEGIN EMITL(0); EMITL(2); END; 08419000
- IF REVERSETOG 08420000
- THEN EMITO(CHS); 08421000
- END; 08421500
- IF ELCLASS = RTPAREN 08422000
- THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000
- EMITL(0); EMITL(0); EMITL(0); 08424000
- GOGOGO _ NOT MAYI;% 08424100
- GO CHKACTIONLABELS; 08425000
- END; 08426000
- IF CHECK(COMMA,424) 08427000
- THEN GO TO EXIT; 08428000
- COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000
- STATEMENT; 08430000
- IF STEPI = FACTOP 08431000
- THEN BEGIN COMMENT *,LIST CASE; 08432000
- EMITL(0); EMITL(0); GO PASSLIST; 08433000
- END; 08434000
- IF ELCLASS = MULOP 08435000
- THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000
- IF STEPI=MULOP THEN EMITL(2) ELSE 08437000
- BEGIN EMITL(1); I_I-1; END ; 08437050
- EMITL(0); GO TO PASSLIST ; 08437075
- END; 08438000
- IF RANGE(FRMTID,SUPERFRMTID) 08439000
- THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000
+ DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010
+ EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020
+ EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030
+PROCEDURE READSTMT; 08290000
+ BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS08291000
+ SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000
+ DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000
+ THE READ OR SPACE STATEMENT. 08294000
+ THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000
+ STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000
+ REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000
+ EXPRESSION IN THE SPACE STATEMENT. 08298000
+ I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000
+ READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000
+ ARE PASSED TO INTERPTI. 08301000
+ **********************************************************08302000
+ ::=REVERSE/ 08303000
+ ::=/ 08304000
+ ::=[NO]/ 08305000
+ ::=[:<[PARITY LABEL>]/ 08306000
+ []/[:]/08307000
+ 08308000
+ CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000
+ POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000
+ CONVERSION. 08311000
+ FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000
+ ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000
+ 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000
+ REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000
+ VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000
+ PROCESSED. 08317000
+ END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL08318000
+ DESCRIPTOR FOR THE END OF FILE JUMPS. 08319000
+ PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000
+ DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000
+ + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT08322000
+ DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE08323000
+ GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS08324000
+ IN ACTION TYPE. 08325000
+ LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000
+ DESCRIPTRO WHICH WILL EITHER RETURN08327000
+ AN ADDRESS OR VALUE DEPENDING ON 08328000
+ THE CALL. 08329000
+ N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000
+ READ() 08331000
+ 08332000
+ - - - - - - - - - - - - - - 08333000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL08334000
+ ,PARITY LABEL) 08335000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000
+ READ(, 08337000
+ ) 08338000
+ - - - - - - - - - - - - - - 08339000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000
+ ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000
+ SPACE(,) 08343000
+ - - - - - - - - - - - - - - 08344000
+ (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000
+ PARITY LABEL) 08346000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000
+ READ(, 08348000
+ ,) 08349000
+ - - - - - - - - - - - - - - 08350000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000
+ ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000
+ LABEL,PARITY LABEL) 08353000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000
+ READ(, 08355000
+ *,) 08356000
+ - - - - - - - - - - - - - - 08357000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000
+ DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000
+ READ(, 08361000
+ ,) 08363000
+ - - - - - - - - - - - - - - 08364000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000
+ END OF FILE LABEL,PARITY LABEL) 08366000
+ ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000
+ READ(, 08368000
+ ,) 08369000
+ - - - - - - - - - - - - - - 08370000
+ (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000
+ DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000
+ *********************************************************;08373000
+ DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE08374000
+ IF THE STATEMENT BEING COMPILED08375000
+ IS A READ REVERSE, OTHERWISE IT08376000
+ IS SET FALSE; 08377000
+ LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08378000
+ EXECUTABLE STATEMENT IN READSTMT; 08379000
+ LABEL CHKACTIONLABELS; COMMENT THE CODE AT THIS LABEL 08380000
+ ASSUMES I IS POINTING AT THE RIGHT 08381000
+ PARENTHESIS; 08382000
+ LABEL PASSLIST; COMMENT THE CODE AT PASSLIST EXPECTS I TO08383000
+ BE POINTING AT THE LAST QUANTITY IN THE 08384000
+ SECOND PARAMETER; 08385000
+ LABEL READXFORM; 08385100
+ INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500
+ BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600
+ BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700
+ INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800
+ IF STEPI = LEFTPAREN 08386000
+ THEN REVERSETOG~SEEKTOG~FALSE; 08387000
+ ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000
+ REVERSETOG~ACCUM[1]="7REVER"; 08389000
+ LOCKTOG~ELCLASS=LOCKV; 08390000
+ SEEKTOG~ACCUM[1]="4SEEK0"; 08390500
+ IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000
+ ELSE BEGIN ERR(420); 08392000
+ GO TO EXIT; 08393000
+ END; 08394000
+ IF CHECK(LEFTPAREN,421); 08395000
+ THEN GO TO EXIT; 08396000
+ COMMENT ERROR 421 MEANS MISSING LEFT 08397000
+ PARENTHESIS IN READ REVERSE STATEMENT; 08398000
+ END; 08399000
+ EMITO(MKS); 08400000
+ IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08401000
+ BEGIN VARIABLE(FL); 08401020
+ IF TABLE(I-2) ! FACTOP THEN 08401030
+ BEGIN ERR(422); GO TO EXIT END; 08401040
+ WAYI ~ TRUE; HOLD ~ L; 08401045
+ EMIT(11); EMIT(4); EMITO(280); 08401050
+ EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060
+ EMITO(XCH); EMITL(0); EMITL(1); 08401070
+ END ELSE 08401080
+ BEGIN 08401090
+ EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000
+ IF NOT RANGE(FILEID,SUPERFILEID) 08403000
+ THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000
+ STATEMENT; 08405000
+ ERR(422); GO TO EXIT; 08406000
+ END; 08407000
+ PASSFILE; 08408000
+ IF ELCLASS = LFTBRKET 08409000
+ THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000
+ %%% [*],[*,*],[*,],[],[,*], 08410010
+ %%% AND [,]. THE FIRST (LEFTMOST) 08410020
+ %%% IS THE READSEEKDISTADDRESS, RESIDING 08410030
+ %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000
+ %%% IS THE WAIT-TIME, RESIDING IN THE 08411010
+ %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 08411020
+ %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 08411030
+ %%% IN THE ABOVE, NS = NO OR STOP. 08411040
+ STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000
+ IF RR1~IF ACCUM[1]="2N0000" THEN 1 ELSE 08412010
+ IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020
+ 0 ! 0 THEN %%% HAVE [NS 08412030
+ IF STEPI=COMMA THEN %%% HAVE [NS, 08412040
+ IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050
+ BEGIN 08412060
+ IF RR1=1 THEN EMITNO(1) 08412070
+ ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080
+ STEPIT ; 08412090
+ END 08413000
+ ELSE 08413010
+ IF ACCUM[1]="4LOCK0" THEN 08413012
+ BEGIN %%% [NS,LOCK 08413014
+ EMITL(1); EMITD(47,4,1); 08413016
+ STEPIT; 08413018
+ END ELSE 08413020
+ BEGIN %%% HAVE [NS,AEXP 08413022
+ IF RR1=2 THEN EMITL(1) ; 08413030
+ EMITTIME ; 08413040
+ IF RR1=2 THEN 08413050
+ BEGIN EMITO(LOR); EMITL(2) END 08413060
+ ELSE EMITL(1) ; 08413080
+ END 08413090
+ ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100
+ ELSE BEGIN EMITL(1); EMITL(2) END 08413110
+ ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120
+ IF STEPI=COMMA THEN %%% HAVE [*, 08413130
+ IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000
+ BEGIN EMITNO(2); STEPIT END 08414010
+ ELSE IF ACCUM[1]="4LOCK0" THEN 08414012
+ BEGIN %%% [*,LOCK 08414014
+ EMITL(1); EMITD(47,4,1); 08414016
+ STEPIT; 08414018
+ END ELSE 08414020
+ BEGIN EMITTIME; EMITL(2); END % [*,A 08414022
+ ELSE EMITNO(2) %%% HAVE ONLY [* 08414030
+ ELSE BEGIN %%% HAVE [AEXP 08415000
+ AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010
+ IF SEEKTOG THEN EMITO(CHS) ; 08415020
+ EMITPAIR(JUNK,ISN) ; 08415030
+ IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000
+ IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010
+ ELSE IF ACCUM[1]="4LOCK0" THEN 08416012
+ BEGIN %%% [AEXP,LOCK 08416014
+ EMITL(1); EMITD(47,4,1); 08416016
+ STEPIT; 08416018
+ END ELSE 08416020
+ BEGIN EMITTIME; EMITO(LOR) END ; 08416022
+ EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030
+ END ; 08417000
+ IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010
+ END 08418000
+ ELSE IF ELCLASS=LEFTPAREN THEN 08418100
+ BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200
+ IF STEPI!FACTOP THEN% 08418250
+ BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300
+ BEGIN EMITL(1); GRABTOG~TRUE; STEPIT END ELSE 08418350
+ EMITPAIR(0,LNG); 08418400
+ EMITD(33,33,15); 08418500
+ EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600
+ EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650
+ IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700
+ EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800
+ END 08418900
+ ELSE BEGIN EMITL(0); EMITL(2); END; 08419000
+ IF REVERSETOG 08420000
+ THEN EMITO(CHS); 08421000
+ END; 08421500
+ IF ELCLASS = RTPAREN 08422000
+ THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000
+ EMITL(0); EMITL(0); EMITL(0); 08424000
+ GOGOGO ~ NOT MAYI;% 08424100
+ GO CHKACTIONLABELS; 08425000
+ END; 08426000
+ IF CHECK(COMMA,424) 08427000
+ THEN GO TO EXIT; 08428000
+ COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000
+ STATEMENT; 08430000
+ IF STEPI = FACTOP 08431000
+ THEN BEGIN COMMENT *,LIST CASE; 08432000
+ EMITL(0); EMITL(0); GO PASSLIST; 08433000
+ END; 08434000
+ IF ELCLASS = MULOP 08435000
+ THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000
+ IF STEPI=MULOP THEN EMITL(2) ELSE 08437000
+ BEGIN EMITL(1); I~I-1; END ; 08437050
+ EMITL(0); GO TO PASSLIST ; 08437075
+ END; 08438000
+ IF RANGE(FRMTID,SUPERFRMTID) 08439000
+ THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000
PASSFORMAT; 08441000
READXFORM: IF TABLE(I+1) = COMMA 08442000
THEN GO PASSLIST; 08443000
@@ -6911,7 +6911,7 @@ READXFORM: IF TABLE(I+1) = COMMA 08442000
THEN GO TO EXIT; 08466000
COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000
DELIMITER IN READ STATEMENT; 08468000
- GOGOGO _ TRUE;% 08468100
+ GOGOGO ~ TRUE;% 08468100
GO CHKACTIONLABELS; 08469000
END 08470000
ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000
@@ -6924,18 +6924,18 @@ READXFORM: IF TABLE(I+1) = COMMA 08442000
THE LIST IN A READ STATEMENT; 08478000
IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000
THEN BEGIN 08480000
- RR1_LISTGEN; 08481000
- I_I-1; 08482000
+ RR1~LISTGEN; 08481000
+ I~I-1; 08482000
GO TO CHKACTIONLABELS 08483000
END; 08484000
CHECKER(ELBAT[I]); 08484500
IF ELCLASS = SUPERLISTID THEN 08485000
BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000
- LISTADDRESS _ELBAT[I].ADDRESS; 08488000
+ LISTADDRESS ~ELBAT[I].ADDRESS; 08488000
BANA; 08489000
EMITV(LISTADDRESS); 08489500
IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08489510
- EMITO(LOD); I_I-1 END 08489520
+ EMITO(LOD); I~I-1 END 08489520
ELSE BEGIN COMMENT A COMMON LIST; 08489530
EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550
END; 08489560
@@ -6951,9 +6951,9 @@ 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
+ 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
+ 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
@@ -6979,10 +6979,10 @@ VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015
,"9SENSI" % "SENSITIVE" 08493111
% THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120
; % END OF FILL STATEMENT. 08493130
- I_FILEATTRIBUTES[0] ; 08493140
+ 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
+ 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
@@ -7018,7 +7018,7 @@ INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470
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
+ 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
@@ -7026,7 +7026,7 @@ INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470
IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580
BEGIN 08493590
DONESOME: 08493600
- IF ATTRIBUTEINDX_FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610
+ 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
@@ -7035,7 +7035,7 @@ STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625
END 08493660
ELSE EMITL(0) ; 08493670
EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675
- IF ASSOP_ELCLASS=ASSIGNOP THEN 08493680
+ 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
@@ -7057,7 +7057,7 @@ IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705
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
+ FILEATTRIBUTEHANDLER~ 08493870
IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880
THEN BTYPE ELSE ATYPE ; 08493890
END ; 08493900
@@ -7168,17 +7168,17 @@ PROCEDURE WRITESTMT; 08528000
INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500
BOOLEAN LOCKTOG,ARC; 08591600
INTEGER HOLD;% 08591700
- IF (LOCKTOG_STEPI=LOCKV) THEN STEPIT; 08592000
+ IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000
IF CHECK(LEFTPAREN,438) 08593000
THEN GO TO EXIT; 08594000
COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000
WRITE STATEMENT; 08596000
EMITO(MKS); 08597000
- IF STEPI>= BOOARRAYID AND ELCLASS<= INTARRAYID THEN 08597100
+ IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08597100
BEGIN VARIABLE(FL); 08597200
IF TABLE(I-2) ! FACTOP THEN 08597300
BEGIN ERR(439); GO TO EXIT END; 08597400
- ARC _ TRUE; HOLD _ L; 08597450
+ ARC ~ TRUE; HOLD ~ L; 08597450
EMIT(11); EMIT(4); EMITO(280); 08597500
EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600
EMITO(XCH); 08597700
@@ -7193,13 +7193,13 @@ PROCEDURE WRITESTMT; 08528000
EMITPAIR(GNAT( 08604000
POWERSOFTEN),LOD); PASSFILE; 08605000
END; 08605500
- IF(RRB1_ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000
+ IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000
THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000
EMITL(0); EMITL(1); 08608000
IF RRB1 08609000
THEN GO CHKSECOND; 08610000
ONEPARENSH:STEPIT; EMITL(0); EMITL(0); 08611000
- GOGOGO _ NOT ARC;% 08611100
+ GOGOGO ~ NOT ARC;% 08611100
EMITL(0); GO EMITCALL; 08612000
END; 08613000
IF ELCLASS=LEFTPAREN THEN 08613100
@@ -7222,7 +7222,7 @@ PROCEDURE WRITESTMT; 08528000
%%% 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~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
@@ -7272,11 +7272,11 @@ WRITXFORM: IF STEPI = RTPAREN 08647000
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
+ BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110
IF ELCLASS!MULOP THEN ERR(443) 08653120
ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125
IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130
- BEGIN I_I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140
+ BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140
ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150
GO TO PASSLIST ; 08653160
END 08653170
@@ -7284,7 +7284,7 @@ WRITXFORM: IF STEPI = RTPAREN 08647000
BEGIN EMITL(1) ; 08653190
IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195
IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200
- BEGIN I_I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210
+ 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
@@ -7318,7 +7318,7 @@ WRITXFORM: IF STEPI = RTPAREN 08647000
COMMENT ERROR 445 MEANS MISSING RIGHT 08675000
PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000
STATEMENT; 08677000
- GOGOGO _ TRUE;% 08677100
+ GOGOGO ~ TRUE;% 08677100
STEPIT; GO EMITCALL; 08678000
END 08679000
ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000
@@ -7329,16 +7329,16 @@ WRITXFORM: IF STEPI = RTPAREN 08647000
COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000
LIST IN A WRITE STATEMENT; 08686000
IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000
- THEN BEGIN RR1_LISTGEN; GO TO EMITCALL END; 08688000
+ THEN BEGIN RR1~LISTGEN; GO TO EMITCALL END; 08688000
CHECKER(ELBAT[I]); 08688500
IF ELCLASS = SUPERLISTID THEN 08689000
BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000
- LISTADDRESS_ELBAT[I].ADDRESS; 08692000
+ LISTADDRESS~ELBAT[I].ADDRESS; 08692000
BANA; 08693000
EMITV(LISTADDRESS); 08694000
IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08694500
EMITO(LOD); 08695000
- I_I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500
+ I~I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500
END ELSE 08696000
BEGIN COMMENT A COMMON LIST ID; 08696500
EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520
@@ -7359,7 +7359,7 @@ WRITXFORM: IF STEPI = RTPAREN 08647000
BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800
EMIT(0); EMIT(0); EMITV(12);% 08698850
END ELSE EMITV(GNAT(INTERPTO));% 08698900
- GOGOGO _ FALSE;% 08698950
+ GOGOGO ~ FALSE;% 08698950
EXIT:; 08699000
END WRITESTMT; 08700000
PROCEDURE LOCKSTMT; 08701000
@@ -7392,7 +7392,7 @@ PROCEDURE LOCKSTMT; 08701000
THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000
IF NOT RANGE(BOOARRAYID,INTARRAYID) THEN 08728100
BEGIN ERR(451); GO TO EXIT END; 08728200
- VARIABLE(FL); L _ L-1; 08728300
+ VARIABLE(FL); L ~ L-1; 08728300
IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400
EMITO(DUP); EMITO(LOD); EMITL(24); 08728500
EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600
@@ -7400,14 +7400,14 @@ PROCEDURE LOCKSTMT; 08701000
GO TO EXIT 08730000
END; 08731000
PASFILE; 08732000
- IF ELCLASS=RTPAREN THEN ELBAT[(I_I-2)+1].CLASS_ 08732100
+ 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
+ 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
@@ -7416,7 +7416,7 @@ PROCEDURE LOCKSTMT; 08701000
DISPOSITION PART; 08744000
ERROR(453); GO TO EXIT; 08745000
END; 08746000
- L_THISL; 08747000
+ L~THISL; 08747000
STEPIT; 08748000
IF CHECK(RTPAREN,454) 08749000
THEN GO TO EXIT; 08750000
@@ -7447,353 +7447,353 @@ PROCEDURE CLOSESTMT; 08756000
** ** ** ** ** ** *** ** ** ** ** ** ; 08771400
LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08772000
EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE; 08773000
- DEFINE THISL = RR1#; COMMENT THUSL 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 THR08781000EE
- 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 IN08791000 A
- CLOSE STATEMENT; 08792000
- ERROR(456); GO TO EXIT; 08793000
- END; 08794000
- PASFILE; 08795000
- IF ELCLASS=RTPAREN THEN ELBAT[(I_I-2)+1].CLASS_ 08795100
- RELEASEV ELSE 08795200
- IF CHECK(COMMA,457) 08796000
- THEN GO TO EXIT; 08797000
- COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000
- STATEMENT; 08799000
- THISL_L; L_LTEMP; 08800000
- IF STEPI = RELEASEV 08801000
- THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000
- EMITL(7); GO EMITREST; 08803000
- END; 08804000
- IF ELCLASS = FACTOP 08805000
- THEN BEGIN COMMENT ASTERISK UNTI DISPOSITION PART CASE; 08806000
- EMITL(1); GO EMITREST; 08807000
- END; 08808000
- IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000
- THEN BEGIN COMMENT SAVE UNIT DISPOSITION PART CASE; 08810000
- EMITL(3); GO EMITREST; 08811000
- END; 08812000
- IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100
- EMITL(4); GO EMITREST; 08812200
- END; 08812300
- ERROR(458); GO TO EXIT; 08813000
- COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000
- IN A CLOSE STATEMENT; 08815000
- EMITREST:STEPIT; 08816000
- L_THISL; 08817000
- IF CHECK(RTPAREN,459) 08818000
- THEN GO TO EXIT; 08819000
- COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000
- CLOSE STATEMENT; 08821000
- STEPIT; 08822000
- EXIT:; 08823000
- END CLOSESTMT; 08824000
- PROCEDURE RWNDSTMT; 08825000
- BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THA08826000T
- CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000
- FOLLOWING PARAMETERS. 08828000
- ********************************************************08829000**
- ::=REWIND() 08830000
- - - - - - - - - - - - - - -08831000
- (0,0,FILE,4); 08832000
- LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LA08833000ST
- EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000
- DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CEL08835000L
- FOR THE CURRENT L REGISTER; 08836000
- DEFINE LTEMP = RR2#; COMMENT LTEMP SETTING FOR T08837000HE
- L REGISTER SETTING FOR THE 08838000
- SAVE OR RELEASE LITERAL THAT08839000
- 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 IN08848000 A
- REWIND STATEMENT; 08849000
- ERROR(461); GO TO EXIT; 08850000
- END; 08851000
- PASFILE; 08852000
- IF CHECK(RTPAREN,462) 08853000
- THEN GO TO EXIT; 08854000
- COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000
- REWIND STATEMENT; 08856000
- STEPIT; THISL_L; L_LTEMP; 08857000
- EMITL(0); L_THISL; 08858000
- EXIT:; 08859000
- END RWNDSTMT; 08860000
- PROCEDURE EXPLICITFORMAT; 08860050
- BEGIN INTEGER PRT; ARRAY TEDOC[0:7,0:127]; 08860100
- MOVECODE(TEDOC,EDOC); 08860150
- GT5:=SGNO; GT1:=(2xSGAVL-1)&2[4:46:2]; SGNO:=SGAVL; 08860200
- F := 0; PRT := GETSPACE(TRUE,-4); % FORMAT DESCR. 08860250
- PRT := PROGDESCBLDR(LDES,0,PRT); 08860300
- ELCLASS := "<"; TB1 := FORMATPHRASE; 08860350
- SEGMENT(-F,SGNO,GT5); SGAVL := SGAVL+1; 08860400
- SGNO := GT5; MOVECODE(TEDOC,EDOC); 08860450
- IF LASTELCLASS ! ">" THEN ERR(136); 08860500
- IF ELCLASS = "," THEN ELBAT[I].CLASS := COMMA ELSE 08860600
- IF ELCLASS = ")" THEN ELBAT[I].CLASS := RTPAREN ELSE 08860650
- ELBAT[I].CLASS := 0; I:=I-1; 08860700
- EMITL(0); EMITPAIR(PRT,LOD); 08860750
- END EXPLICITFORMAT; 08860800
- COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXE08861000S
- AND CALL SORTI, PASSING THE FOLLOWING: 08862000
- SORT: MERGE: 08863000
- 0 DISK SIZE,IF SPECIFIED 08864000
- 0 CORE SIZE,IF SPECIFIED 08865000
- 0 0 ALFA FLAG 08866000
- RECORD SIZE 08867000
- PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE08868000
- PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE08869000
- ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000
- 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000
- TP5 FL7 SCRATCH TAPES FOR SORT, 08872000
- TP4 FL6 OR MERGE FILES, POINTERS TO 08873000
- TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000
- TP2 FL4 IF NOT USED. 08875000
- TP1 FL3 08876000
- 0 FL2 DISK FILES FOR SORT 08877000
- DK0 FL1 08878000
- 0/1 0 TRUE IF INPUT PROCEDURE 08879000
- 0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000
- INF 0 POINTER TO I/O DESC FOR INPUT 08881000
- OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000
- OF WORK ARRAY. 08883000
- PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000
- PD/0 PD/0 OUTPUT PROCEDURE 08885000
- 0 0 08886000
- 0 0 08887000
- 0 0 08888000
- LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000
- 0 0 08890000
- 0 1 SORT/MERGE FLAG 08891000
- ... MSCW 08892000
- 0 SORT-FILE MOTHER 08893000
- 0 DESCRIPTORS 08894000
- 0 " 08895000
- 0 " 08896000
- 0 " 08897000
- 0 " 08898000
- MSCW; 08900000
- PROCEDURE MERGESTMT; 08901000
- BEGIN INTEGER J,K,FILER,FILEND; 08902000
- BOOLEAN OPTOG; 08903000
- LABEL QUIT; 08904000
- STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000
- EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000
- EMIT(0); EMIT(0); EMIT(0); 08907000
- IF OPTOG_(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000
- ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000
- EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000
- EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I+I-1 END ELSE 08911000
- EMITN(GNAT(SORTA)); 08911100
- IF NOT COMMACHECK THEN GO QUIT; 08912000
- EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000
- FILE_BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000
- EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QU08915000IT;
- IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000
- EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QU08917000IT;
- 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])::=REWIND() 08830000
+ - - - - - - - - - - - - - - 08831000
+ (0,0,FILE,4); 08832000
+ LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08833000
+ EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 08834000
+ DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08835000
+ FOR THE CURRENT L REGISTER; 08836000
+ DEFINE LTEMP = RR2#; COMMENT LTEMP SETTING FOR THE08837000
+ L REGISTER SETTING FOR THE 08838000
+ SAVE OR RELEASE LITERAL THAT 08839000
+ GETS PASSED TO KEN MEYERS; 08840000
+ STEPIT; 08841000
+ IF CHECK(LEFTPAREN,460) 08842000
+ THEN GO TO EXIT; 08843000
+ COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000
+ REWIND STATEMENT; 08845000
+ STEPIT; 08846000
+ IF NOT RANGE(FILEID,SUPERFILEID) 08847000
+ THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A08848000
+ REWIND STATEMENT; 08849000
+ ERROR(461); GO TO EXIT; 08850000
+ END; 08851000
+ PASFILE; 08852000
+ IF CHECK(RTPAREN,462) 08853000
+ THEN GO TO EXIT; 08854000
+ COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 08855000
+ REWIND STATEMENT; 08856000
+ STEPIT; THISL~L; L~LTEMP; 08857000
+ EMITL(0); L~THISL; 08858000
+ EXIT:; 08859000
+ END RWNDSTMT; 08860000
+PROCEDURE EXPLICITFORMAT; 08860050
+ BEGIN INTEGER PRT; ARRAY TEDOC[0:7,0:127]; 08860100
+ MOVECODE(TEDOC,EDOC); 08860150
+ GT5:=SGNO; GT1:=(2|SGAVL-1)&2[4:46:2]; SGNO:=SGAVL; 08860200
+ F := 0; PRT := GETSPACE(TRUE,-4); % FORMAT DESCR. 08860250
+ PRT := PROGDESCBLDR(LDES,0,PRT); 08860300
+ ELCLASS := "<"; TB1 := FORMATPHRASE; 08860350
+ SEGMENT(-F,SGNO,GT5); SGAVL := SGAVL+1; 08860400
+ SGNO := GT5; MOVECODE(TEDOC,EDOC); 08860450
+ IF LASTELCLASS ! ">" THEN ERR(136); 08860500
+ IF ELCLASS = "," THEN ELBAT[I].CLASS := COMMA ELSE 08860600
+ IF ELCLASS = ")" THEN ELBAT[I].CLASS := RTPAREN ELSE 08860650
+ ELBAT[I].CLASS := 0; I:=I-1; 08860700
+ EMITL(0); EMITPAIR(PRT,LOD); 08860750
+ END EXPLICITFORMAT; 08860800
+ COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 08861000
+ AND CALL SORTI, PASSING THE FOLLOWING: 08862000
+ SORT: MERGE: 08863000
+ 0 DISK SIZE,IF SPECIFIED 08864000
+ 0 CORE SIZE,IF SPECIFIED 08865000
+ 0 0 ALFA FLAG 08866000
+ RECORD SIZE 08867000
+ PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 08868000
+ PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 08869000
+ ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 08870000
+ 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 08871000
+ TP5 FL7 SCRATCH TAPES FOR SORT, 08872000
+ TP4 FL6 OR MERGE FILES, POINTERS TO 08873000
+ TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 08874000
+ TP2 FL4 IF NOT USED. 08875000
+ TP1 FL3 08876000
+ 0 FL2 DISK FILES FOR SORT 08877000
+ DK0 FL1 08878000
+ 0/1 0 TRUE IF INPUT PROCEDURE 08879000
+ 0/1 0/1 TRUE IF OUTPUT PROCEDURE 08880000
+ INF 0 POINTER TO I/O DESC FOR INPUT 08881000
+ OUTF OUTF OR OUTPUT FILE, OR MOTHER 08882000
+ OF WORK ARRAY. 08883000
+ PD/0 0 INPUT PROCEDURE DESCRIPTOR 08884000
+ PD/0 PD/0 OUTPUT PROCEDURE 08885000
+ 0 0 08886000
+ 0 0 08887000
+ 0 0 08888000
+ LIT LIT PRT INDEX OF MERGE INTRINSIC 08889000
+ 0 0 08890000
+ 0 1 SORT/MERGE FLAG 08891000
+ ... MSCW 08892000
+ 0 SORT-FILE MOTHER 08893000
+ 0 DESCRIPTORS 08894000
+ 0 " 08895000
+ 0 " 08896000
+ 0 " 08897000
+ 0 " 08898000
+ MSCW; 08900000
+ PROCEDURE MERGESTMT; 08901000
+ BEGIN INTEGER J,K,FILER,FILEND; 08902000
+ BOOLEAN OPTOG; 08903000
+ LABEL QUIT; 08904000
+ STEPIT; IF CHECK(LEFTPAREN,367) THEN GO QUIT; 08905000
+ EMITO(MKS); EMITL(1); EMIT(0); EMITL(GNAT(MERGEI)); 08906000
+ EMIT(0); EMIT(0); EMIT(0); 08907000
+ IF OPTOG~(STEPI=FILEID OR ELCLASS=SUPERFILEID) THEN EMIT(0) 08908000
+ ELSE IF NOT OUTPROCHECK(ELBAT[I]) THEN GO QUIT ELSE 08909000
+ EMITPAIR(ELBAT[I].ADDRESS,LOD); 08910000
+ EMIT(0);IF OPTOG THEN BEGIN PASSFILE; I+I-1 END ELSE 08911000
+ EMITN(GNAT(SORTA)); 08911100
+ IF NOT COMMACHECK THEN GO QUIT; 08912000
+ EMIT(0); EMITL(REAL(TRUE AND NOT OPTOG)); EMIT(0); 08913000
+ FILE~BUMPL; IF NOT HVCHECK(ELBAT[I]) THEN GO QUIT; 08914000
+ EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08915000
+ IF NOT EQLESCHECK(ELBAT[I]) THEN GO QUIT; 08916000
+ EMITPAIR(ELBAT[I].ADDRESS,LOD); IF NOT COMMACHECK THEN GO QUIT;08917000
+ AEXP; EMITB(BFW,FILER,FILEND~BUMPL); 08918000
+ FOR J~1 STEP 1 WHILE ELCLASS=COMMA DO 08919000
+ BEGIN STEPIT; PASSFILE END; 08920000
+ FOR K~J STEP 1 UNTIL 7 DO EMIT(0); J~J-1; 08921000
+ IF J>7 OR J<2 THEN BEGIN ERR(368); GO QUIT END; 08922000
+ EMITL(J); EMITB(BBW,BUMPL,FILER); EMITB(BFW,FILEND,L); 08923000
+ IF CHECK(RTPAREN,369) THEN GO QUIT; STEPIT; EMITO(SSN); 08924000
+ EMIT(0); EMIT(0); EMIT(0); 08925000
+ QUIT: EMITV(GNAT(SORTI)); 08926000
+ END MERGESTMT; 08927000
+ PROCEDURE SORTSTMT; 08928000
+ BEGIN BOOLEAN INPRO,OUTPRO; 08929000
+ INTEGER A,J; 08930000
+ LABEL QUIT; DEFINE RDS=1,280#; 08931000
+ STREAM PROCEDURE STUFFILE(IDLOC,FN, SFN); 08932000
+ VALUE FN, SFN ; 08933000
+ BEGIN DI~IDLOC; DI~DI+5; DI~DC; 08934000
+ SI~LOC FN; SI~SI+5; DS~3 CHR; SI~SI+7; 08935000
+ DS~11 LIT"0000000DSRT"; DS~CHR; SI~SI-1; 08936000
+ DS~7 LIT" 5DSRT"; DS~CHR; SFN~DI; SI~LOC SFN; 08937000
+ DI~IDLOC; DI~DI+5; SI~SI+5; DS~3 CHR; 08938000
+ END STUFFILE; 08939000
+ BOOLEAN PROCEDURE INPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 08940000
+ IF ELBW.CLASS!BOOPROCID THEN ERR(363) ELSE 08941000
+ IF BOOLEAN(ELBW.FORMAL) THEN INPROCHECK~TRUE ELSE 08941100
+ IF TAKE(GT1~GIT(ELBW))!1 THEN ERR(364) ELSE 08942000
+ IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(365) ELSE 08943000
+ INPROCHECK~TRUE; 08944000
+ IF SFILENO=0 THEN 08945000
+ BEGIN SFILENO~FILENO; 08946000
+ FOR J~1 STEP 1 UNTIL 7 DO 08947000
+ IF MKABS(IDARRAY[127]); OCT1340000250002662, COMMENT 09201000 >;
- OCT1350000200000000, COMMENT +; OCT0000000000000000, 09202000
- OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT 09203000 [;
- OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT 09204000 (;
- OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT 09205000 _;
- OCT1360001000000000, COMMENT x; OCT0000000000000000, 09206000
- OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT 09207000 *;
- OCT1350000600000000, COMMENT "; OCT1240000000160000, COMMENT 09208000 );
- OCT0620000000000000, COMMENT ,; OCT1340010250003470, COMMENT<09209000=;
- OCT0000000000000000, OCT1360002000000000, COMMENT 09210000 /;
- OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT 09211000 %;
- OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT 09212000 =;
- OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT 09213000 ";
- 0,0; 09214000
- COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATA09214100COM;
- FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES 09214105ARE
- OCT0030000130000000, "2RB000", % DESIGNED TO LO09214110OK
- OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115
- OCT0030000150000000, "3GEQ00", % DECLARATIONS A09214120T
- OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0.09214125
- OCT0030000170000000, "3NEQ00", 09214130
- OCT0030000200000000, "3LEQ00", 09214135
- OCT0030000210000000, "3LSS00", 09214140
- OCT0030000220000000, "5TIMES", 09214145
- OCT0030000230000000, "5INPUT", 09214150
- OCT0030000240000000, "2IO000", 09214155
- OCT0030000250000000, "6SERIA","L0000000", 09214160
- OCT0030000260000000, "6RANDO","M0000000", 09214165
- OCT0030000270000000, "6UPDAT","E0000000", 09214170
- OCT0030000300000000, "6OUTPU","T0000000", 09214180
- OCT0030000310000000, "7CANTU","SE000000", 09214190
- OCT0130000000740000, "3MIN00", OCT0000000003200000,%09214200549
- OCT0130000001040000, "5DELAY", OCT0000000003300000,%09214210552
- OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%09214220555
- OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%09214230559
- OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%09214240563
- OCT0000000000040000, "5DCPWR", OCT0000000005600000,%09214250567
- OCT0000000000040000, "5DCMTH", OCT0000000005500000,%09214255570
- OCT0130000001140000, "5DSQRT", OCT0000000012300000,%09214260573
- OCT0130000001240000, "4CEXP0", OCT0000000010000000,%09214270576
- OCT0130000001340000, "3CLN00", OCT0000000010200000,%09214295579
- OCT0130000001440000, "4CSIN0", OCT0000000010600000,%09214300582
- OCT0130000001540000, "4CCOS0", OCT0000000011000000,%09214305585
- OCT0130000001640000, "5CSQRT", OCT0000000012400000,%09214310588
- OCT0130000001740000, "4DEXP0", OCT0000000007700000,%09214315591
- OCT0130000002040000, "3DLN00", OCT0000000010100000,%09214320594
- OCT0130000002140000, "4DSIN0", OCT0000000010500000,%09214325597
- OCT0130000002240000, "4DCOS0", OCT0000000010700000,%09214330600
- OCT0130000002360000, "7DARCT","AN0000000", OCT0000000011300000,%09214340603
- OCT0130000002460000, "6DLOG1","000000000", OCT0000000010400000,%09214345607
- OCT0130000002560000, "8DARCT","AN2000000", OCT0000000011500000,%09214350611
- OCT0130000002640000, "4DMOD0", OCT0000000006500000,%09214355615
- OCT0130000002740000, "4CABS0", OCT0000000005300000,%09214360618
- OCT0130000003060000, "7ARCTA","N20000000", OCT0000000011400000,%09214365621
- OCT0130000003160000, "6DROUN","D00000000", OCT0000000006100000,%09214370625
- OCT0130000000040000, "5LOG10", OCT0000000010300000,%09214375629
- OCT0130000000040000, "5COTAN", OCT0000000011200000,%09214380632
- OCT0130000000060000, "6ARCSI","N00000000", OCT0000000011600000,%09214385635
- OCT0130000000040000, "5ARCOS", OCT0000000011700000,%09214390639
- OCT0130000000040000, "4SINH0", OCT0000000012000000,%09214395642
- OCT0130000000040000, "4COSH0", OCT0000000012100000,%09214400645
- OCT0130000000040000, "4TANH0", OCT0000000012200000,%09214405648
- OCT0130000000040000, "3ERF00", OCT0000000012500000,%09214410651
- OCT0130000000040000, "5GAMMA", OCT0000000012600000,%09214415654
- OCT0130000000040000, "5LNGAM", OCT0000000012700000,%09214420657
- OCT0130000000040000, "3TAN00", OCT0000000011100000,%09214425660
- OCT0130000260000000, "4FAST0", %09214426663
- OCT0130000270000000, "4SLOW0", %09214427665
- OCT0130000240000000, "7PROTE", "CT000000", %09214428667
- OCT2000000000004050, COMMENT POWERS OF TEN ; %09214430670
- OCT0430000250000000, "5FIELD", %09214432671
- 0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %09214435673
- " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %09214440674
- COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500
- FOR NEXTINFO_512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510
- ,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,63092145155,
- 639 STEP 3 UNTIL 660,663 STEP 2 UNTIL 667, 671 %09214516117-
- DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2_TAKE(NEXTINFO+1)MOD 125][35:35:1092145203],
- LASTINFO_STACKHEAD[GT2]_NEXTINFO); 09214530
- NEXTINFO _ LASTINFO _ LASTSEQROW x 256 + LASTSEQUENCE + 1; 09214980
- BUILDLINE.[45:1]_TRUE ; 09214985
- PUTNBUMP(0); 09214990
- FILL MACRO[*] WITH 09215000
- OCT0131, COMMENT SFS A 00 ; 09216000
- OCT0116, COMMENT SFD A 01 ; 09217000
- OCT0000, COMMENT SYNTAX ERROR02 ; 09218000
- OCT0140, COMMENT INC A 03 ; 09219000
- OCT0130, COMMENT SRS A 04 ; 09220000
- OCT0117 COMMENT SRD A 05 ; 09221000
- OCT0000, COMMENT SYNTAX ERROR06 ; 09222000
- OCT0000, COMMENT SYNTAX ERROR07 ; 09223000
- OCT00310143, COMMENT CRF A, SFS 008 ; 09224000
- OCT00160143, COMMENT CRF A, SFD 009 ; 09225000
- OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000
- OCT00400143, COMMENT CRF A, INC 011 ; 09227000
- OCT00300143, COMMENT CRF A, SRS 012 ; 09228000
- OCT00170143, COMMENT CRF A, SRD 013 ; 09229000
- OCT0000, COMMENT SYNTAX ERROR14 ; 09230000
- OCT0000, COMMENT SYNTAX ERROR15 ; 09231000
- OCT0153, COMMENT RSA A 16 ; 09232000
- OCT0104, COMMENT RDA A 17 ; 09233000
- OCT0150, COMMENT RCA A 18 ; 09234000
- OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000
- OCT0122, COMMENT SES A 20 ; 09236000
- OCT0106, COMMENT SED A 21 ; 09237000
- OCT0000, COMMENT SYNTAX ERROR22 ; 09238000
- OCT0000, COMMENT SYNTAX ERROR23 ; 09239000
- OCT0056, COMMENT TSA 0 24 ; 09240000
- OCT0000, COMMENT SYNTAX ERROR25 ; 09241000
- OCT0000, COMMENT SYNTAX ERROR26 ; 09242000
- OCT0000, COMMENT SYNTAX ERROR27 ; 09243000
- OCT0000, COMMENT SYNTAX ERROR28 ; 09244000
- OCT0007, COMMENT TDA 0 29 ; 09245000
- OCT0000, COMMENT SYNTAX ERROR30 ; 09246000
- OCT0000, COMMENT SYNTAX ERROR31 ; 09247000
- OCT0115, COMMENT SSA A 32 ; 09248000
- OCT0114, COMMENT SDA A 33 ; 09249000
- OCT0154, COMMENT SCA A 34 ; 09250000
- OCT0141; COMMENT STC A 35 ; 09251000
- FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010
- "[# ", 09251020
- "]# ", 09251030
- "># ", 09251040
- ">=# ", 09251050
- "=# ", 09251060
- "!# ", 09251070
- "<=# ", 09251080
- "<# ", 09251090
- "x# ", 09251100
- "1# ", 09251101
- "3# ", 09251102
- "0# ", 09251103
- "1# ", 09251104
- "2# ", 09251105
- "2# ", 09251106
- "0# " 09251107
+ COMMENT THIS IS THE FILL FOR STACKHEAD; 09187000
+ FILL STACKHEAD[*] WITH 09188000
+320,359,313,458,385, 0,337,347,383,361,379,412, 0, 0, 0,372, 09189000
+355,309, 0, 0,368, 0,446, 0, 0,549,311,410, 0, 0,400, 0, 09190000
+ 0, 0, 0, 0,503,315, 0, 0,330, 0, 0, 0, 0, 0, 0,440, 09191000
+390,449,349, 0,414, 0, 0, 0,452, 0, 0, 0, 0, 0, 0, 0, 09192000
+381,328, 0, 0, 0, 0, 0, 0, 0, 0, 0,436, 0,402,407, 0, 09193000
+ 0, 0,377, 0, 0, 0,416,455,355, 0, 0,357, 0,552,374, 0, 09194000
+ 0, 0,433, 0,418,398,343, 0, 0,326,339, 0, 0, 0,366, 0, 09195000
+ 0, 0, 0, 0, 0,422, 0,392, 0, 0, 0,424, 0; 09196000
+ FILL SUPERSTACK[*] WITH %WF 09196100
+ 0, 0,313, 0,307, 0,337,347,383, 0,379,412, 0, 0, 0,372, %WF 09196200
+335,309, 0, 0, 0, 0, 0, 0, 0, 0,420,410, 0, 0, 0, 0, %WF 09196300
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %WF 09196400
+390, 0,364, 0,414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %WF 09196500
+ 0,328, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,402, 0, 0, %WF 09196600
+ 0, 0,377, 0,510, 0,416, 0,355, 0, 0,357, 0, 0, 0, 0, 09196700
+ 0, 0, 0, 0, 0,398, 0, 0, 0,326,339, 0, 0, 0,366, 0, %WF 09196800
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,424, 0; %WF 09196900
+ COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS; 09197000
+ FILL SPECIAL[*] WITH 09198000
+ OCT1200000000000000, COMMENT #; OCT0000000000100000, COMMENT @; 09199000
+ OCT0000000000000000, OCT1160000000120000, COMMENT :; 09200000
+ OCT1340000450002763, COMMENT >; OCT1340000250002662, COMMENT }; 09201000
+ OCT1350000200000000, COMMENT +; OCT0000000000000000, 09202000
+ OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 09203000
+ OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT (; 09204000
+ OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT ~; 09205000
+ OCT1360001000000000, COMMENT |; OCT0000000000000000, 09206000
+ OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT *; 09207000
+ OCT1350000600000000, COMMENT -; OCT1240000000160000, COMMENT ); 09208000
+ OCT0620000000000000, COMMENT .,; OCT1340010250003470, COMMENT {; 09209000
+ OCT0000000000000000, OCT1360002000000000, COMMENT /; 09210000
+ OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 09211000
+ OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT =; 09212000
+ OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 09213000
+ 0,0; 09214000
+ COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;09214100
+FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 09214105
+ OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 09214110
+ OCT0030000140000000, "3GTR00", % LIKE DEFINE 09214115
+ OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 09214120
+ OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 09214125
+ OCT0030000170000000, "3NEQ00", 09214130
+ OCT0030000200000000, "3LEQ00", 09214135
+ OCT0030000210000000, "3LSS00", 09214140
+ OCT0030000220000000, "5TIMES", 09214145
+ OCT0030000230000000, "5INPUT", 09214150
+ OCT0030000240000000, "2IO000", 09214155
+ OCT0030000250000000, "6SERIA","L0000000", 09214160
+ OCT0030000260000000, "6RANDO","M0000000", 09214165
+ OCT0030000270000000, "6UPDAT","E0000000", 09214170
+ OCT0030000300000000, "6OUTPU","T0000000", 09214180
+ OCT0030000310000000, "7CANTU","SE000000", 09214190
+ OCT0130000000740000, "3MIN00", OCT0000000003200000,%549 09214200
+ OCT0130000001040000, "5DELAY", OCT0000000003300000,%552 09214210
+ OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%555 09214220
+ OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%559 09214230
+ OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%563 09214240
+ OCT0000000000040000, "5DCPWR", OCT0000000005600000,%567 09214250
+ OCT0000000000040000, "5DCMTH", OCT0000000005500000,%570 09214255
+ OCT0130000001140000, "5DSQRT", OCT0000000012300000,%573 09214260
+ OCT0130000001240000, "4CEXP0", OCT0000000010000000,%576 09214270
+ OCT0130000001340000, "3CLN00", OCT0000000010200000,%579 09214295
+ OCT0130000001440000, "4CSIN0", OCT0000000010600000,%582 09214300
+ OCT0130000001540000, "4CCOS0", OCT0000000011000000,%585 09214305
+ OCT0130000001640000, "5CSQRT", OCT0000000012400000,%588 09214310
+ OCT0130000001740000, "4DEXP0", OCT0000000007700000,%591 09214315
+ OCT0130000002040000, "3DLN00", OCT0000000010100000,%594 09214320
+ OCT0130000002140000, "4DSIN0", OCT0000000010500000,%597 09214325
+ OCT0130000002240000, "4DCOS0", OCT0000000010700000,%600 09214330
+ OCT0130000002360000, "7DARCT","AN0000000", OCT0000000011300000,%603 09214340
+ OCT0130000002460000, "6DLOG1","000000000", OCT0000000010400000,%607 09214345
+ OCT0130000002560000, "8DARCT","AN2000000", OCT0000000011500000,%611 09214350
+ OCT0130000002640000, "4DMOD0", OCT0000000006500000,%615 09214355
+ OCT0130000002740000, "4CABS0", OCT0000000005300000,%618 09214360
+ OCT0130000003060000, "7ARCTA","N20000000", OCT0000000011400000,%621 09214365
+ OCT0130000003160000, "6DROUN","D00000000", OCT0000000006100000,%625 09214370
+ OCT0130000000040000, "5LOG10", OCT0000000010300000,%629 09214375
+ OCT0130000000040000, "5COTAN", OCT0000000011200000,%632 09214380
+ OCT0130000000060000, "6ARCSI","N00000000", OCT0000000011600000,%635 09214385
+ OCT0130000000040000, "5ARCOS", OCT0000000011700000,%639 09214390
+ OCT0130000000040000, "4SINH0", OCT0000000012000000,%642 09214395
+ OCT0130000000040000, "4COSH0", OCT0000000012100000,%645 09214400
+ OCT0130000000040000, "4TANH0", OCT0000000012200000,%648 09214405
+ OCT0130000000040000, "3ERF00", OCT0000000012500000,%651 09214410
+ OCT0130000000040000, "5GAMMA", OCT0000000012600000,%654 09214415
+ OCT0130000000040000, "5LNGAM", OCT0000000012700000,%657 09214420
+ OCT0130000000040000, "3TAN00", OCT0000000011100000,%660 09214425
+ OCT0130000260000000, "4FAST0", %663 09214426
+ OCT0130000270000000, "4SLOW0", %665 09214427
+ OCT0130000240000000, "7PROTE", "CT000000", %667 09214428
+ OCT2000000000004050, COMMENT POWERS OF TEN ; %670 09214430
+ OCT0430000250000000, "5FIELD", %671 09214432
+ 0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %673 09214435
+ " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %674 09214440
+ COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 09214500
+FOR NEXTINFO~512 STEP 2 UNTIL 534,537 STEP 3 UNTIL 546 09214510
+,567STEP 3UNTIL 603,607STEP 4UNTIL 615,618,621STEP 4UNTIL 629,632,635, 09214515
+639 STEP 3 UNTIL 660,663 STEP 2 UNTIL 667, 671 %117-09214516
+DO PUT(TAKE(NEXTINFO)&STACKHEAD[GT2~TAKE(NEXTINFO+1)MOD 125][35:35:13], 09214520
+ LASTINFO~STACKHEAD[GT2]~NEXTINFO); 09214530
+ NEXTINFO ~ LASTINFO ~ LASTSEQROW | 256 + LASTSEQUENCE + 1; 09214980
+ BUILDLINE.[45:1]~TRUE ; 09214985
+ PUTNBUMP(0); 09214990
+ FILL MACRO[*] WITH 09215000
+ OCT0131, COMMENT SFS A 00 ; 09216000
+ OCT0116, COMMENT SFD A 01 ; 09217000
+ OCT0000, COMMENT SYNTAX ERROR02 ; 09218000
+ OCT0140, COMMENT INC A 03 ; 09219000
+ OCT0130, COMMENT SRS A 04 ; 09220000
+ OCT0117 COMMENT SRD A 05 ; 09221000
+ OCT0000, COMMENT SYNTAX ERROR06 ; 09222000
+ OCT0000, COMMENT SYNTAX ERROR07 ; 09223000
+ OCT00310143, COMMENT CRF A, SFS 008 ; 09224000
+ OCT00160143, COMMENT CRF A, SFD 009 ; 09225000
+ OCT00470143, COMMENT CRF A, JFW 0 10 ; 09226000
+ OCT00400143, COMMENT CRF A, INC 011 ; 09227000
+ OCT00300143, COMMENT CRF A, SRS 012 ; 09228000
+ OCT00170143, COMMENT CRF A, SRD 013 ; 09229000
+ OCT0000, COMMENT SYNTAX ERROR14 ; 09230000
+ OCT0000, COMMENT SYNTAX ERROR15 ; 09231000
+ OCT0153, COMMENT RSA A 16 ; 09232000
+ OCT0104, COMMENT RDA A 17 ; 09233000
+ OCT0150, COMMENT RCA A 18 ; 09234000
+ OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 09235000
+ OCT0122, COMMENT SES A 20 ; 09236000
+ OCT0106, COMMENT SED A 21 ; 09237000
+ OCT0000, COMMENT SYNTAX ERROR22 ; 09238000
+ OCT0000, COMMENT SYNTAX ERROR23 ; 09239000
+ OCT0056, COMMENT TSA 0 24 ; 09240000
+ OCT0000, COMMENT SYNTAX ERROR25 ; 09241000
+ OCT0000, COMMENT SYNTAX ERROR26 ; 09242000
+ OCT0000, COMMENT SYNTAX ERROR27 ; 09243000
+ OCT0000, COMMENT SYNTAX ERROR28 ; 09244000
+ OCT0007, COMMENT TDA 0 29 ; 09245000
+ OCT0000, COMMENT SYNTAX ERROR30 ; 09246000
+ OCT0000, COMMENT SYNTAX ERROR31 ; 09247000
+ OCT0115, COMMENT SSA A 32 ; 09248000
+ OCT0114, COMMENT SDA A 33 ; 09249000
+ OCT0154, COMMENT SCA A 34 ; 09250000
+ OCT0141; COMMENT STC A 35 ; 09251000
+ FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 09251010
+ "[# ", 09251020
+ "]# ", 09251030
+ "># ", 09251040
+ "}# ", 09251050
+ "=# ", 09251060
+ "!# ", 09251070
+ "{# ", 09251080
+ "<# ", 09251090
+ "|# ", 09251100
+ "1# ", 09251101
+ "3# ", 09251102
+ "0# ", 09251103
+ "1# ", 09251104
+ "2# ", 09251105
+ "2# ", 09251106
+ "0# " 09251107
; 09251200
- NEXTTEXT_26 ; 09251300
- DO UNTIL STEPI = BEGINV; 09252000
- BUILDLINE.[45:1]_FALSE; 09252050
+NEXTTEXT~26 ; 09251300
+ DO UNTIL STEPI = BEGINV; 09252000
+ BUILDLINE.[45:1]~FALSE; 09252050
09252100
- COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM.09253000
- THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE09254000:
- 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 09257000EXIT.
- ITS PRIMARY FUNCTION IS TO CUT BACK09258000
- THE STACK AFTER A COMMUNICATE OPERA09259000TOR.
- MKS --- THIS SETS THE PROGRAM UP FOR RUNNIN09260000G
- IN SUBPROGRAM LEVEL.THIS IS TO ALLO09261000W
- C-RELATIVE ADDRESSING FOR CONSTANTS09262000
- IN THE PROGRAM STREAM 09263000
- OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000
- THAT GETS THE PROGRAM INTO SUBPROGR09265000AM
- LEVEL. XXXX IS THE FIRST AVAILABLE 09266000PRT
- CELL.AT THE START OF COMPILATION XX09267000XX IS
- ASSUMED TO CONTAIN A LABEL DESCRIPT09268000OR
- IT IS CHANGED BEFORE COMPILATION IS09269000
- COMPLETE TO LOOK LIKE A WORD MODE 09270000
- PROGRAM DESCRIPTOR; 09271000
- EMITL(0);EMIT0(MKS); 09272000
- GT1_PROGDESCBLDR(3,0,0); 09273000
- GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000
- INSERTCO:=1; 09274100 %107-
- ERRORTOG_TRUE; BLOCK(FALSE); 09275000
- COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100
- THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200
- THE END. CARD OFF AN INPUT TAPE; 09275250
- IF NEWTOG THEN 09275300
- BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST C09275350AR",
- "D ON OCR","DING TAPE","E ", " "," 09275400 ",
- " ","999999999"; 09275450
- WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500
- END; 09275550
+ COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000
+ THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000
+ LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000
+ AND IS ALSO USED AS A ONE SYLLABLE 09256000
+ CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000
+ ITS PRIMARY FUNCTION IS TO CUT BACK 09258000
+ THE STACK AFTER A COMMUNICATE OPERATOR. 09259000
+ MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000
+ IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000
+ C-RELATIVE ADDRESSING FOR CONSTANTS 09262000
+ IN THE PROGRAM STREAM 09263000
+ OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000
+ THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000
+ LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000
+ CELL.AT THE START OF COMPILATION XXXX IS 09267000
+ ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000
+ IT IS CHANGED BEFORE COMPILATION IS 09269000
+ COMPLETE TO LOOK LIKE A WORD MODE 09270000
+ PROGRAM DESCRIPTOR; 09271000
+ EMITL(0);EMIT0(MKS); 09272000
+ GT1~PROGDESCBLDR(3,0,0); 09273000
+ GT1 := GETSPACE(TRUE,-5); % SEG.#2 DESCR. 09274000
+ INSERTCO:=1; %107-09274100
+ ERRORTOG~TRUE; BLOCK(FALSE); 09275000
+ COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100
+ THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200
+ THE END. CARD OFF AN INPUT TAPE; 09275250
+ IF NEWTOG THEN 09275300
+ BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350
+ "D ON OCR","DING TAPE","E ", " "," ", 09275400
+ " ","999999999"; 09275450
+ WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500
+ END; 09275550
09275600
09275700
09275750
@@ -8147,55 +8147,55 @@ PROCEDURE CLOSESTMT; 08756000
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 PLACING09280000
- 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 THE09285000
- INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF09286000
- 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
+ COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000
+ WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000
+ USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000
+ THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000
+ IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000
+ PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000
+ INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000
+ ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000
+ FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 09285000
+ INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000
+ THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000
+ PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000
+ DRUM ADDRESSES TO THE INTRINSICS; 09289000
09290000
- GT1 _ GT3 _ STARTINTRSC; 09291000
- L1: GT1 _ GT1 + (GT2 _ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000
- IF GT2>= 0 THEN % NOT POWERS OF TEN TABLE 09293000
- BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000
- BEGIN SGNO _ SGAVL; SGAVL _ SGAVL + 1; 09295000
- GT2 _ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:109296000]
- x 2 + 1, 0, GT2.ADDRESS); 09296100
- PDPRT[PDINX.[37:5],PDINX.[42:6]] _ 09297000
- 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000
- & SGNO[28:38:10] & 1[2:47:1]; 09298100
- PDINX _ PDINX + 1; 09299000
- IF PRTOG THEN % WRITE OUT INTRINSICS USED. 09300000
- BEGIN GT3 _ GT3 + 1; 09300100
- BLANKET(14,LIN); % BLANK BUFFER. 09300150
- WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200
- B2D(GT2.[38:10]), LIN); 09301000
- IF NOHEADING THEN DATIME; WRITELINE; 09302000
- END 09303000
- END; 09304000
- GT3 _ GT1 _ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 109305000;
- GO TO L1; 09305100
- END; 09306000
- L_L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK09306100;
- EMITL(5);EMITO(COM); 09307000
- ENIL[0,1] _ 1023 & 99999999[10:20:28]; ENILPTR _ 1; 09307100
- SEGMENT((L+3) DIV 4,1,0); 09308000
+ GT1 ~ GT3 ~ STARTINTRSC; 09291000
+ L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000
+ IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000
+ BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000
+ BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000
+ GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000
+ | 2 + 1, 0, GT2.ADDRESS); 09296100
+ PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000
+ 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000
+ & SGNO[28:38:10] & 1[2:47:1]; 09298100
+ PDINX ~ PDINX + 1; 09299000
+ IF PRTOG THEN % WRITE OUT INTRINSICS USED. 09300000
+ BEGIN GT3 ~ GT3 + 1; 09300100
+ BLANKET(14,LIN); % BLANK BUFFER. 09300150
+ WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200
+ B2D(GT2.[38:10]), LIN); 09301000
+ IF NOHEADING THEN DATIME; WRITELINE; 09302000
+ END 09303000
+ END; 09304000
+ GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000
+ GO TO L1; 09305100
+ END; 09306000
+ L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100
+ EMITL(5);EMITO(COM); 09307000
+ ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100
+ SEGMENT((L+3) DIV 4,1,0); 09308000
COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000
AT THIS TIME AS A TYPE 2 SEGMENT; 09310000
- IF GT1_GT2.ADDRESS!0 THEN 09311000
- BEGIN SGAVL_(SGNO_SGAVL)+1; 09312000
- GT2_PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000
+ IF GT1~GT2.ADDRESS!0 THEN 09311000
+ BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000
+ GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000
MOVE(69,TEN,EDOC[0,0]); 09314000
- BUILDLINE _ BOOLEAN(2xREAL(BUILDLINE)); 09314100
+ BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100
SEGMENT(-69, SGNO,0); 09315000
- BUILDLINE _ BUILDLINE.[46:1] ; 09315100
+ 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
@@ -8214,73 +8214,73 @@ COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000
09345000
09346000
09347000
- FOR I_0 STEP 1 UNTIL PDINX DO 09348000
- IF (GT1_PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000
- BEGIN PR[ADR_GT1.[8:10]; SEGMNT_GT1.[28:10]; 09350000
- LINK_SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000
+ FOR I~0 STEP 1 UNTIL PDINX DO 09348000
+ IF (GT1~PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000
+ BEGIN PR[ADR~GT1.[8:10]; SEGMNT~GT1.[28:10]; 09350000
+ LINK~SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000
MDESC(GT1.[18:10]&SEGMNT[18:33:15] 09352000
&(IF LINK=0 THEN SEGMNT+2048 ELSE LINK) 09353000
[6:36:12]>1[4:4:2]&5[1:45:3], 09354000
PRT[PRTADR DIV 128,PRTADR MOD 128]); 09354100
- SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]_PRTADR; 09355000
+ 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
+ BEGIN SEGMNT~GT1.[28:10]; 09357000
+ SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]~ 09358000
SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]>1[23:38:10] 09359000
& GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 09360000
END; 09361000
- COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX_AKKUM; 09361005
+ COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX~AKKUM; 09361005
COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 09361010
- GTI1_0; 09361020
+ 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
+ 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
+ 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
+ GTI1~GTI1+ 512 + PRTIMAX; 09361120
COMMENT ADD IN JRT; 09361130
- GTI1_GTI1 + ( (FILENO +1)x 5); 09361140
+ 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
+ GTI1~GTI1+IOBUFFSIZE; COMMENT I/O SIZE CAL. IN P.IODEC; 09361160
COMMENT ADD SEGMENT DICT.SIZE; 09361170
- GTI1_GTI1+ SGAVL-1; 09361180
+ 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
+ IF GTI1 } 32000 THEN GTI1~ 32000; 09361200
COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 09361210
COMMENT WRITE OUT FILE PARAMETER BLOCK; 09393000
- GTI1_MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000
+ GTI1~MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000
MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000
ZEROUT(IDARRAY[0],0,30); 09395500
IDARRAY[4]:=MOVEANDBLOCK(EDOC,GT1,0); %106-09396000
- IDARRAY[5]_GT1; 09397000
+ IDARRAY[5]~GT1; 09397000
COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000
IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); %106-09399000
- IF BUILDLINE THEN IDARRAY[0]_IDARRAY[0]&MOVEANDBLOCK 09399100
+ IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100
(LDICT,SGAVL,2)[18:33:15]; %106-09399150
- IDARRAY[1]_SGAVL; 09400000
+ IDARRAY[1]~SGAVL; 09400000
COMMENT WRITE OUT PRT; 09401000
IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); %106-09402000
- IDARRAY[3]_PRTIMAX; 09403000
+ IDARRAY[3]~PRTIMAX; 09403000
COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000
- IDARRAY[6]_1; 09405000
+ IDARRAY[6]~1; 09405000
COMMENT PASS NUMBER OF FILES; 09405100
- IDARRAY[7] _ (FILENO-1)>I1[18:27:15]; 09405200
+ IDARRAY[7] ~ (FILENO-1)>I1[18:27:15]; 09405200
COMMENT WRITE DISK SEGMENT ZERO; 09406000
GT1:=DA; DA:=0; MOVE(30,IDARRAY[0],PRT[0,0]); %106-09407000
GT2:=MOVEANDBLOCK(PRT,30,6); DA:=GT1; %106-09407010
IF CODEFILE THEN WRITE(LINE); %106-09407020
- IF SAVETIME>= 0 AND ERRORCOUNT = 0THEN 09407050
+ IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050
LOCK(CODE,SAVE); 09407100
CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. %119-09407200
CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. %119-09407300
LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. %119-09407400
IF LISTER OR NOT NOHEADING THEN 09408000
- BEGIN FORMAT PAN("NUMBER OF ERRORS DETECTED = ",I4,". COMPILAT09409000"
+ BEGIN FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT"09409000
,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000
"PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000
" WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000
@@ -8295,391 +8295,392 @@ IF CHECKTOG THEN 09416001
THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004
THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006
WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2,09417000
- PRTIMAX,AKKUM,IF DA<=CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000
- DIV CHUNK)xCHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000
+ PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000
+ DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000
END END END PROGRAM; 09420000
-COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000
-COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000
- FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000
- WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000
- ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000
- RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000
- STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000
- EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000
- THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000
- TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000
- S = [1:1], 10010000
- REPEAT = [38:10], 10011000
- SKIP = [32:6], 10012000
- CODE = [2:4], 10013000
- W = [6:6], 10014000
- W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000
- S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000
- TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000
- BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000
- WORDS. GIVEN S = 1 WE HAVE: 10019000
- IF CODE = 0 THEN RIGHTPAREN, 10020000
- IF CODE = 2 THEN STRING, 10021000
- IF CODE = 4 THEN LEFTPAREN, 10022000
- IF CODE = 6 THEN STROKE, 10023000
- IF CODE = 8 THEN SCALE. 10023100
- GIVEN S = 0 WE HAVE 10024000
- IF CODE = 0 THEN D, 10025000
- IF CODE=1 THEN T, 10025010
- IF CODE = 2 THEN X, 10026000
- IF CODE = 4 THEN A, 10027000
- IF CODE = 6 THEN I, 10028000
- IF CODE = 8 THEN F, 10029000
- IF CODE =10 THEN E, 10030000
- IF CODE = 11 THEN U, 10030100
- IF CODE =12 THEN O, 10031000
- IF CODE = 13 THEN V, 10031100
- IF CODE =14 THEN L, 10032000
- IF CODE = 15 THEN R, 10032100
- W IS THE FIELD WIDTH. 10033000
- FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000
- ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000
- REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000
- REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000
- HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000
- IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000
- A NON-ZERO REPEAT FIELDS. 10040000
- THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000
- FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000
- D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000
- THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000
- FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000
- W2 = D1 = D2 =0. 10046000
- FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010
- W2=D1=D2=0. 10046020
- FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000
- W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000
- FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000
- IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000
- IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000
- FOR F IF D < 8 THEN D1 = D, D2=0, 10052000
- IF D > 8 THEN D1 = 8, D2=D-8, 10053000
- IF D >16 THEN ERROR. 10054000
- IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000
- SKIP=0. 10056000
- IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000
- IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000
- FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000
- D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000
- FOR O, W1=W2=D1=D2=SKIP=0, 10061000
- FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000
- SKIP = W-W1, 10063000
- FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100
- FOR B: SEE U-PHRASE DESCRIPTION. 10063110
- FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200
- FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300
- F-PHRASE DESCRIPTION. 10063400
- FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE 10064000
- WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000
- BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS 10066000
- IF IT NOTICES AN ERROR; 10067000
-PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000
- BEGIN 10069000
+ COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000
+ COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000
+ FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000
+ WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000
+ ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000
+ RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000
+ STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000
+ EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000
+ THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000
+ TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000
+ S = [1:1], 10010000
+ REPEAT = [38:10], 10011000
+ SKIP = [32:6], 10012000
+ CODE = [2:4], 10013000
+ W = [6:6], 10014000
+ W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000
+ S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000
+ TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000
+ BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000
+ WORDS. GIVEN S = 1 WE HAVE: 10019000
+ IF CODE = 0 THEN RIGHTPAREN, 10020000
+ IF CODE = 2 THEN STRING, 10021000
+ IF CODE = 4 THEN LEFTPAREN, 10022000
+ IF CODE = 6 THEN STROKE, 10023000
+ IF CODE = 8 THEN SCALE. 10023100
+ GIVEN S = 0 WE HAVE 10024000
+ IF CODE = 0 THEN D, 10025000
+ IF CODE=1 THEN T, 10025010
+ IF CODE = 2 THEN X, 10026000
+ IF CODE = 4 THEN A, 10027000
+ IF CODE = 6 THEN I, 10028000
+ IF CODE = 8 THEN F, 10029000
+ IF CODE =10 THEN E, 10030000
+ IF CODE = 11 THEN U, 10030100
+ IF CODE =12 THEN O, 10031000
+ IF CODE = 13 THEN V, 10031100
+ IF CODE =14 THEN L, 10032000
+ IF CODE = 15 THEN R, 10032100
+ W IS THE FIELD WIDTH. 10033000
+ FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000
+ ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000
+ REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000
+ REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000
+ HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000
+ IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000
+ A NON-ZERO REPEAT FIELDS. 10040000
+ THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000
+ FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000
+ D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000
+ THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000
+ FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000
+ W2 = D1 = D2 =0. 10046000
+ FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010
+ W2=D1=D2=0. 10046020
+ FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000
+ W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000
+ FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000
+ IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000
+ IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000
+ FOR F IF D < 8 THEN D1 = D, D2=0, 10052000
+ IF D > 8 THEN D1 = 8, D2=D-8, 10053000
+ IF D >16 THEN ERROR. 10054000
+ IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000
+ SKIP=0. 10056000
+ IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000
+ IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000
+ FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000
+ D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000
+ FOR O, W1=W2=D1=D2=SKIP=0, 10061000
+ FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000
+ SKIP = W-W1, 10063000
+ FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100
+ FOR B: SEE U-PHRASE DESCRIPTION. 10063110
+ FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200
+ FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300
+ F-PHRASE DESCRIPTION. 10063400
+ FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000
+ WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000
+ BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000
+ IF IT NOTICES AN ERROR; 10067000
+ PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000
+ BEGIN 10069000
10070000
- MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000
- IF DEBUGTOG 10072000
- THEN BEGIN 10073000
- DEBUGWORD(B2D(F),W,LIN); 10074000
- WRITELINE END; 10075000
- IF (F_F+1) > 1024 THEN FLAG(307); 10076000
+ MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000
+ IF DEBUGTOG 10072000
+ THEN BEGIN 10073000
+ DEBUGWORD(B2D(F),W,LIN); 10074000
+ WRITELINE END; 10075000
+ IF (F~F+1) > 1024 THEN FLAG(307); 10076000
10077000
10078000
10079000
10080000
10081000
- END WHIPOUT; 10082000
-BOOLEAN PROCEDURE FORMATPHRASE; 10083000
- BEGIN 10084000
- LABEL EL,EX,EXIT,L1,L2,L3; 10085000
-PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000
- VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000
- REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000
- BOOLEAN S; 10089000
- BEGIN IF W > 63 THEN FLAG(163); 10090000
- W _ REPEAT & W [ 6:42:6] 10091000
- & SKIP [32:42:6] 10092000
- & W1 [28:44:4] 10093000
- & W2 [28:44:4] 10094000
- & D1 [20:44:4] 10095000
- & D2 [16:44:4] 10096000
- & CODE [ 2:44:4] 10097000
- & REAL(S) [ 1:47:1]; 10098000
- WHIPOUT(W) END EMITFORMAT; 10099000
-STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000
- VALUE LETTER, CTR; 10101000
- BEGIN DI _ PLACE; DS _ LIT "B"; 10102000
- SI _ LOC CTR; SI _ SI+7; DS _ CHR; 10103000
- SI _ PLACE; SI _ SI+3; DS _ 5 CHR; 10104000
- SI _ LOC LETTER; SI _ SI+7; DS _ CHR END PACKALPHA; 10105000
- INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000
- DEFINE RRIGHT = 0#, 10107000
- RLEFT = 4#, 10108000
- RSTROKE = 6#; 10109000
- DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500
- DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000
- RT=1 #, 10110010
- RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000
- IF ELCLASS < 0 THEN BEGIN REPEAT _ -ELCLASS;NEXTENT; 10112000
- IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100
- ELSE BEGIN REPEAT:=REAL(ELCLASS!"<"); 10113000
- IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]_1; 10113100
- NEXTENT; 10113200
- END END; 10113300
- IF ELCLASS="(" OR ELCLASS="<" 10114000
- THEN BEGIN 10115000
- SKIP _ F; 10116000
- EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000
- DO BEGIN NEXTENT; 10118000
-EL: IF FORMATPHRASE THEN GO TO EX END 10119000
- UNTIL ELCLASS ! ","; 10120000
- WHILE ELCLASS = "/" 10121000
- DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000
- NEXTENT END; 10123000
- IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000
- THEN GO TO EL; 10124100
- IF LASTELCLASS = "," THEN GO TO EX; 10124200
- IF REPEAT = 0 THEN 10125000
- EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000
- REPEAT_F-SKIP; F_SKIP; 10127000
- WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100
- F_SKIP+REPEAT; S_TRUE; CODE_RRIGHT END 10127200
- ELSE IF ELCLASS = "0" 10128000
- THEN BEGIN CODE_RO; W_8 END 10129000
- ELSE IF ELCLASS = "D" 10130000
- THEN BEGIN CODE_RD; W_8 END 10131000
- ELSE IF ELCLASS = "," THEN GO TO L2 10132000
- ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000
- ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 10134000
- IF LASTELCLASS="," THEN GO EX ELSE GO EXIT 10134100
- ELSE IF ELCLASS = "S" THEN 10134500
- BEGIN 10134510
- NEXTENT; 10134520
- W _ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530
- IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540
- IF ELCLASS="*" THEN REPEAT.[12:1]_1 ELSE 10134545
- IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550
- GO TO EXIT 10134560
- END 10134570
- ELSE REPEAT _ - ELCLASS; 10134580
- EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590
- GO TO L2 10134600
- END 10134610
- ELSE IF ELCLASS = """ 10135000
- THEN BEGIN 10136000
- IF REPEAT ! 1 THEN FLAG(136); 10136500
- CODE _ 100; 10137000
- DO BEGIN 10138000
- SKIP _ 1; 10139000
- DO BEGIN RESULT _ 5; COUNT _ 0; SCANNER; 10140000
- IF ELCLASS _ ACCUM[1].[18:6] = CODE 10141000
- THEN BEGIN 10142000
- IF SKIP ! 1 THEN WHIPOUT(W); 10143000
- GO TO L2 END; 10144000
- CODE _ """; 10145000
- PACKALPHA(W,ELCLASS,SKIP); 10146000
- END UNTIL SKIP _ SKIP+1 = 7; 10147000
- WHIPOUT(W) 10148000
- END UNTIL FALSE END 10149000
- IF CODE = "U" OR CODE = "B" THEN 10150000
- BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE10150110.
- NEXTENT ; 10150120
- SKIP _ 0 ; 10150125
- IF ELCLASS = "*" OR ELCLASS<= 0 THEN 10150130
- BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135
- IF ELCLASS = "*" THEN REPEAT.[13:1] _ 1 10150140
- ELSE W _ -ELCLASS ; 10150145
- NEXTENT ; 10150150
- IF ELCLASS = "." THEN 10150155
- BEGIN %%% PHRASE IS AT LEAST UW. OR U*.10150160.
- NEXTENT ; 10150165
- IF ELCLASS = "*" OR ELCLASS<=0 THEN 10150170
- BEGIN %%% PHRASE IS UW*.D*10150175.
- IF ELCLASS = "*" THEN REPEAT.[14:110150185]_1
- ELSE SKIP _ -ELCLASS ; 10150190
- NEXTENT ; 10150195
- END 10150200
- ELSE GO TO EX 10150205
- END 10150210
- END 10150215
- ELSE W _-63 ; %%% PHRASE IS D. 10150220
- EMITFORMAT(FALSE,RD,REPEAT,SKIP,W,REAL(CODE="B"),10150225
- REAL(W<0),0,0) ; 10150230
- GO TO EXIT ; 10150260
- END OF U PHRASE HANDLER ; 10150270
- IF GETINT THEN BEGIN W_11; REPEAT.[13:1]_1 END 10150280
- ELSE ELCLASS := -(W := ELCLASS); 10150290
- IF CODE = "I" 10151000
- THEN BEGIN 10152000
- SKIP _ DIVIDE(W,W1,W2); CODE _ RI END 10153000
- ELSE IF CODE = "F" 10154000
- THEN BEGIN CODE _ RF; GO TO L1 END 10155000
- ELSE IF CODE = "R" THEN BEGIN CODE _ RR; GO TO L1 END 10155500
- ELSE IF CODE = "E" 10156000
- THEN BEGIN CODE _ RE; D1_1; 10157000
- L1: NEXTENT; 10158000
- IF ELCLASS!"." THEN GO EX; 10159000
- IF GETINT THEN BEGIN ELCLASS_3; REPEAT.[14:1]_1 E10159100ND;
- 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 EN10162000D
- 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(11016550036)
- ELSE BEGIN CODE_RT; W1_W.[38:4]; W_W.[42:6] END 10165505
- ELSE IF CODE = "A" 10166000
- THEN BEGIN CODE _ RA; W1 _6; GO TO L3 END 10167000
- ELSE IF CODE="V" THEN 10167100
- BEGIN CODE _ RV ; 10167200
- COUNT_ACCUM[1]_0; 10167300
- IF EXAMIN(NCR)=" " THEN 10167400
- BEGIN RESULT_7; SCANNER END; 10167500
- IF EXAMIN(NCR)="." THEN 10167600
- BEGIN NEXTENT; 10167700
- IF GETINT THEN REPEAT.[14:1]_1 ELSE 10167800
- GT1_DIVIDE(ELCLASS,D1,D2); 10167900
- ELCLASS :=-ELCLASS; 10167910
- END; END ELSE IF CODE="L" 10168000
- THEN BEGIN CODE _ RL; W1 _ 5; 10169000
- L3: IF W 2047 10242000
- THEN BEGIN FLAG(142); TB1_ TRUE END 10243000
- ELSE BEGIN 10244000
- IF COUNT > REMCOUNT 10245000
- THEN BEGIN 10246000
- SKIPCOUNT _ COUNT-(COUNT_REMCOUNT); 10247000
- REMCOUNT _ 2048 END 10248000
- ELSE REMCOUNT _ REMCOUNT-COUNT; 10249000
- GT1 _ CHARCOUNT DIV 8 _ NEXTTEXT; 10250000
- PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3]10251000,
- COUNT,0,CHAR); 10252000
- IF SKIPCOUNT ! 0 THEN 10253000
- PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000
- COUNT,CHAR); 10255000
- CHARCOUNT _ CHARCOUNT+SKIPCOUNT+COUNT END 10256000
- END PUTOGETHER; 10257000
- INTEGER LASTRESULT; 10258000
- REAL K,N,ELCLASS; 10258100
- DEFINE I=NXTELBT#; 10258200
- LABEL FINAL,PACKIN; 10258300
- LABEL BACK,SKSC,EXIT; 10259000
- REAL DINFO; 10259200
- BOOLEAN TSSTREAMTOG; % 1289 10259400
- DINFO _ J.[18:15]; 10259600
- J _ J.[33:15]; 10259700
- TB1_ FALSE; 10260000
- TSSTREAMTOG_ STREAMTOG; % 1289 10260050
- STREAMTOG_TRUE; 10260100
- CHARCOUNT _ 0; 10261000
- DEFINECTR _ 1; LASTRESULT _ 2; 10262000
- REMCOUNT _ (256-NEXTTEXT.LINKC)x8; 10263000
- K_0; 10263200
- BACK: STOPDEFINE_TRUE; 10263300
- ELCLASS_TABLE(NXTELBT); 10263400
- SKSC: NXTELBT_NXTELBT-1; 10263500
- IF MACRO THEN 10263600
- BEGIN IF ELCLASS=COMMA THEN 10263700
- IF K=0 THEN 10263800
- FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900
- ELSE GO PACKIN; 10264000
- IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100
- BEGIN K_K+1; GO TO PACKIN END; 10264200
- IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300
- IF K_K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400
- IF ELCLASS=SEMICOLON THEN 10264410
- BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN10264420
- 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)x10]) 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
+ 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 [28:44:4] 10094000
+ & D1 [20:44:4] 10095000
+ & D2 [16:44:4] 10096000
+ & CODE [ 2:44:4] 10097000
+ & REAL(S) [ 1:47:1]; 10098000
+ WHIPOUT(W) END EMITFORMAT; 10099000
+ STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000
+ VALUE LETTER, CTR; 10101000
+ BEGIN DI ~ PLACE; DS ~ LIT "B"; 10102000
+ SI ~ LOC CTR; SI ~ SI+7; DS ~ CHR; 10103000
+ SI ~ PLACE; SI ~ SI+3; DS ~ 5 CHR; 10104000
+ SI ~ LOC LETTER; SI ~ SI+7; DS ~ CHR END PACKALPHA; 10105000
+ INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000
+ DEFINE RRIGHT = 0#, 10107000
+ RLEFT = 4#, 10108000
+ RSTROKE = 6#; 10109000
+ DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500
+ DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000
+ RT=1 #, 10110010
+ RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000
+ IF ELCLASS < 0 THEN BEGIN REPEAT ~ -ELCLASS;NEXTENT; 10112000
+ IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100
+ ELSE BEGIN REPEAT:=REAL(ELCLASS!"<"); 10113000
+ IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100
+ NEXTENT; 10113200
+ END END; 10113300
+ IF ELCLASS="(" OR ELCLASS="<" 10114000
+ THEN BEGIN 10115000
+ SKIP ~ F; 10116000
+ EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000
+ DO BEGIN NEXTENT; 10118000
+ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
+ UNTIL ELCLASS ! ","; 10120000
+ WHILE ELCLASS = "/" 10121000
+ DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000
+ NEXTENT END; 10123000
+ IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000
+ THEN GO TO EL; 10124100
+ IF LASTELCLASS = "," THEN GO TO EX; 10124200
+ IF REPEAT = 0 THEN 10125000
+ EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000
+ REPEAT~F-SKIP; F~SKIP; 10127000
+ WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100
+ F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200
+ ELSE IF ELCLASS = "0" 10128000
+ THEN BEGIN CODE~RO; W~8 END 10129000
+ ELSE IF ELCLASS = "D" 10130000
+ THEN BEGIN CODE~RD; W~8 END 10131000
+ ELSE IF ELCLASS = "," THEN GO TO L2 10132000
+ ELSE IF ELCLASS = "/" THEN GO TO EXIT 10133000
+ ELSE IF ELCLASS=")" OR ELCLASS=">" THEN 10134000
+ IF LASTELCLASS="," THEN GO EX ELSE GO EXIT 10134100
+ ELSE IF ELCLASS = "S" THEN 10134500
+ BEGIN 10134510
+ NEXTENT; 10134520
+ W ~ IF ELCLASS = "-" THEN 1 ELSE 0; 10134530
+ IF ELCLASS="+" OR ELCLASS="-" THEN NEXTENT; 10134540
+ IF ELCLASS="*" THEN REPEAT.[12:1]~1 ELSE 10134545
+ IF ELCLASS > 0 THEN BEGIN ERR(136); 10134550
+ GO TO EXIT 10134560
+ END 10134570
+ ELSE REPEAT ~ - ELCLASS; 10134580
+ EMITFORMAT(TRUE,RSCALE,REPEAT,0,W,0,0,0,0); 10134590
+ GO TO L2 10134600
+ END 10134610
+ ELSE IF ELCLASS = """ 10135000
+ THEN BEGIN 10136000
+ IF REPEAT ! 1 THEN FLAG(136); 10136500
+ CODE ~ 100; 10137000
+ DO BEGIN 10138000
+ SKIP ~ 1; 10139000
+ DO BEGIN RESULT ~ 5; COUNT ~ 0; SCANNER; 10140000
+ IF ELCLASS ~ ACCUM[1].[18:6] = CODE 10141000
+ THEN BEGIN 10142000
+ IF SKIP ! 1 THEN WHIPOUT(W); 10143000
+ GO TO L2 END; 10144000
+ CODE ~ """; 10145000
+ PACKALPHA(W,ELCLASS,SKIP); 10146000
+ END UNTIL SKIP ~ SKIP+1 = 7; 10147000
+ WHIPOUT(W) 10148000
+ END UNTIL FALSE END 10149000
+ ELSE BEGIN CODE~ELCLASS; 10150000
+ IF CODE = "U" OR CODE = "B" THEN 10150100
+ BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 10150110
+ NEXTENT ; 10150120
+ SKIP ~ 0 ; 10150125
+ IF ELCLASS = "*" OR ELCLASS { 0 THEN 10150130
+ BEGIN %%% PHRASE IS AT LEAST UW OR U*. 10150135
+ IF ELCLASS = "*" THEN REPEAT.[13:1] ~ 1 10150140
+ ELSE W ~ -ELCLASS ; 10150145
+ NEXTENT ; 10150150
+ IF ELCLASS = "." THEN 10150155
+ BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 10150160
+ NEXTENT ; 10150165
+ IF ELCLASS = "*" OR ELCLASS{0 THEN 10150170
+ BEGIN %%% PHRASE IS UW*.D*. 10150175
+ IF ELCLASS = "*" THEN REPEAT.[14:1]~1 10150185
+ ELSE SKIP ~ -ELCLASS ; 10150190
+ NEXTENT ; 10150195
+ END 10150200
+ ELSE GO TO EX 10150205
+ END 10150210
+ END 10150215
+ ELSE W ~-63 ; %%% PHRASE IS D. 10150220
+ EMITFORMAT(FALSE,RD,REPEAT,SKIP,W,REAL(CODE="B"), 10150225
+ REAL(W<0),0,0) ; 10150230
+ GO TO EXIT ; 10150260
+ END OF U PHRASE HANDLER ; 10150270
+ IF GETINT THEN BEGIN W~11; REPEAT.[13:1]~1 END 10150280
+ ELSE ELCLASS := -(W := ELCLASS); 10150290
+ IF CODE = "I" 10151000
+ THEN BEGIN 10152000
+ SKIP ~ DIVIDE(W,W1,W2); CODE ~ RI END 10153000
+ ELSE IF CODE = "F" 10154000
+ THEN BEGIN CODE ~ RF; GO TO L1 END 10155000
+ ELSE IF CODE = "R" THEN BEGIN CODE ~ RR; GO TO L1 END 10155500
+ ELSE IF CODE = "E" 10156000
+ THEN BEGIN CODE ~ RE; D1~1; 10157000
+ L1: NEXTENT; 10158000
+ IF ELCLASS!"." THEN GO EX; 10159000
+ IF GETINT THEN BEGIN ELCLASS~3; REPEAT.[14:1]~1 END; 10159100
+ IF DIVIDE(ELCLASS+D1,D1,D2) > 0 THEN GO TO EX; 10160000
+ IF CODE = RF OR CODE = RR THEN 10161000
+ SKIP ~ DIVIDE(W-ELCLASS-1,W1,W2) 10161500
+ ELSE IF SKIP ~ W-ELCLASS-6 < 0 THEN GO TO EX END 10162000
+ ELSE IF CODE = "X" 10163000
+ THEN BEGIN CODE ~ RX; W1 ~ W.[38:4]; 10164000
+ SKIP ~ W ~ W.[42:6] END 10165000
+ ELSE IF CODE="T" THEN IF W~ABS(W)-1<0 THEN FLAG(136) 10165500
+ ELSE BEGIN CODE~RT; W1~W.[38:4]; W~W.[42:6] END 10165505
+ ELSE IF CODE = "A" 10166000
+ THEN BEGIN CODE ~ RA; W1 ~6; GO TO L3 END 10167000
+ ELSE IF CODE="V" THEN 10167100
+ BEGIN CODE ~ RV ; 10167200
+ COUNT~ACCUM[1]~0; 10167300
+ IF EXAMIN(NCR)=" " THEN 10167400
+ BEGIN RESULT~7; SCANNER END; 10167500
+ IF EXAMIN(NCR)="." THEN 10167600
+ BEGIN NEXTENT; 10167700
+ IF GETINT THEN REPEAT.[14:1]~1 ELSE 10167800
+ GT1~DIVIDE(ELCLASS,D1,D2); 10167900
+ ELCLASS :=-ELCLASS; 10167910
+ END; END ELSE IF CODE="L" 10168000
+ THEN BEGIN CODE ~ RL; W1 ~ 5; 10169000
+ L3: IF W 2047 10242000
+ THEN BEGIN FLAG(142); TB1~ TRUE END 10243000
+ ELSE BEGIN 10244000
+ IF COUNT > REMCOUNT 10245000
+ THEN BEGIN 10246000
+ SKIPCOUNT ~ COUNT-(COUNT~REMCOUNT); 10247000
+ REMCOUNT ~ 2048 END 10248000
+ ELSE REMCOUNT ~ REMCOUNT-COUNT; 10249000
+ GT1 ~ CHARCOUNT DIV 8 ~ NEXTTEXT; 10250000
+ PACKINFO(TEXT[GT1.LINKR,GT1.LINKC], CHARCOUNT.[45:3],10251000
+ COUNT,0,CHAR); 10252000
+ IF SKIPCOUNT ! 0 THEN 10253000
+ PACKINFO(TEXT[NEXTTEXT.LINKR+1,0],0,SKIPCOUNT, 10254000
+ COUNT,CHAR); 10255000
+ CHARCOUNT ~ CHARCOUNT+SKIPCOUNT+COUNT END 10256000
+ END PUTOGETHER; 10257000
+ INTEGER LASTRESULT; 10258000
+ REAL K,N,ELCLASS; 10258100
+ DEFINE I=NXTELBT#; 10258200
+ LABEL FINAL,PACKIN; 10258300
+ LABEL BACK,SKSC,EXIT; 10259000
+ REAL DINFO; 10259200
+ BOOLEAN TSSTREAMTOG; % 1289 10259400
+ DINFO ~ J.[18:15]; 10259600
+ J ~ J.[33:15]; 10259700
+ TB1~ FALSE; 10260000
+ TSSTREAMTOG~ STREAMTOG; % 1289 10260050
+STREAMTOG~TRUE; 10260100
+ CHARCOUNT ~ 0; 10261000
+ DEFINECTR ~ 1; LASTRESULT ~ 2; 10262000
+ REMCOUNT ~ (256-NEXTTEXT.LINKC)|8; 10263000
+ K~0; 10263200
+ BACK: STOPDEFINE~TRUE; 10263300
+ ELCLASS~TABLE(NXTELBT); 10263400
+ SKSC: NXTELBT~NXTELBT-1; 10263500
+ IF MACRO THEN 10263600
+ BEGIN IF ELCLASS=COMMA THEN 10263700
+ IF K=0 THEN 10263800
+ FINAL: BEGIN PUTOGETHER("1#0000"); GO TO EXIT END 10263900
+ ELSE GO PACKIN; 10264000
+ IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 10264100
+ BEGIN K~K+1; GO TO PACKIN END; 10264200
+ IF ELCLASS=RTPAREN OR ELCLASS=RTBRKET THEN 10264300
+ IF K~K-1<0 THEN GO FINAL ELSE GO PACKIN; 10264400
+ IF ELCLASS=SEMICOLON THEN 10264410
+ BEGIN FLAG(142); GO TO FINAL END ELSE GO PACKIN 10264420
+ END; 10264500
+ IF RESULT = 1 THEN IF J ! 0 THEN 10264600
+ FOR N ~ 1 STEP 1 UNTIL J DO 10264650
+ BEGIN 10264700
+ IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1]. 10264750
+ DEFINFO[(N-1)|10]) THEN 10264760
+ BEGIN 10264800
+ DEFINEPARAM(DINFO+1, N); 10264810
+ GO PACKIN; 10264820
+ END; 10264830
+ END; 10264900
+ PACKIN: 10264910
+ IF RESULT = 4 10265000
+ THEN BEGIN 10266000
COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 10267000
PUTOGETHER(2130706432); 10268000
PUTOGETHER(ACCUM[1]); 10269000
@@ -8689,17 +8690,17 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000
PUTOGETHER(ACCUM[1]) END; 10274000
IF TB1 THEN GO TO EXIT; 10275000
- LASTRESULT _ RESULT; 10276000
+ 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
+ THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END; 10278000
IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000
IF DEFINECTR ! 1 10280000
- THEN BEGIN STOPDEFINE _ TRUE; 10281000
- IF ELCLASS_TABLE(I)!COMMA THEN 10282000
- DEFINECTR_DEFINECTR-1; GO SKSC END; 10283000
- EXIT: DEFINECTR := 0; STREAMTOG_TSSTREAMTOG; % 1289 10284000
- NEXTTEXT _ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000
+ THEN BEGIN STOPDEFINE ~ TRUE; 10281000
+ IF ELCLASS~TABLE(I)!COMMA THEN 10282000
+ DEFINECTR~DEFINECTR-1; GO SKSC END; 10283000
+EXIT: DEFINECTR := 0; STREAMTOG~TSSTREAMTOG; % 1289 10284000
+ NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000
END DEFINEGEN; 10286000
COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000
ELEMENTS; 10288000
@@ -8707,7 +8708,7 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
BEGIN 10290000
REAL T1,T2,T3; 10291000
LABEL BOOFINISH,STORE,LRTS; 10292000
- DIALA _ DIALB _ 0; 10293000
+ DIALA ~ DIALB ~ 0; 10293000
IF ELCLASS= FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000
ELSE IF ELCLASS = LFTBRKET 10295000
THEN BEGIN COMMENT GORUP OF LIST ELEMENTS; 10296000
@@ -8715,24 +8716,24 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000
ELSE BEGIN COMMENT THE MEAT OF THE MATTER; 10299000
VARIABLES AND EXPRESSIONS; 10300000
- L _ (T1_L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000
+ L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000
EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000
NEXT TIME AROUND; 10303000
- IF(GT1 _ TABLE(I+1) = COMMA 10304000
+ IF(GT1 ~ TABLE(I+1) = COMMA 10304000
OR GT1 = RTPAREN 10305000
OR GT1 = RTBRKET) 10306000
- AND ELCLASS>= BOOID AND ELCLASS<= INTID 10307000
+ AND ELCLASS } BOOID AND ELCLASS { INTID 10307000
THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000
CHECKER(ELBAT[I]); 10308100
EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000
- ELSE BEGIN IF ELCLASS>= BOOARRAYID 10310000
- AND ELCLASS<= INTARRAYID 10311000
+ ELSE BEGIN IF ELCLASS } BOOARRAYID 10310000
+ AND ELCLASS { INTARRAYID 10311000
THEN BEGIN COMMENT IS EITHER A SUBSCRIPTED VARIABLE10312000
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
+ 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
@@ -8745,7 +8746,7 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
ELSE IF EXPRSS = DTYPE THEN ERR(156); 10327000
STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000
LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000
- T2 _ L; L _ T1; EMITNUM(T2-LSTR); L_T2 END END LSTELMT; 10330000
+ 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
@@ -8762,14 +8763,14 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
REAL PROCEDURE LISTGEN; 10344000
BEGIN 10345000
INTEGER JUMPLACE,LISTPLACE; 10346000
- JUMPLACE _ BAE; 10347000
- LISTGEN _ LISTPLACE _ PROGDESCBLDR(0,L,0); 10348000
+ JUMPLACE ~ BAE; 10347000
+ LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000
COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000
- EMITV(LSTRTN); EMITO(BFW); LSTR _ L; 10350000
+ EMITV(LSTRTN); EMITO(BFW); LSTR ~ L; 10350000
COMMENT INITIAL JUMP OF A LIST; 10351000
- LISTMODE _ TRUE; 10352000
+ LISTMODE ~ TRUE; 10352000
COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000
- I_I-1; 10354000
+ I~I-1; 10354000
DO BEGIN 10355000
STEPIT; 10356000
LISTELEMENT 10357000
@@ -8779,8 +8780,8 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
EMITO(RTS); 10361000
COMMENT SET END FLAG OF -1; 10362000
CONSTANTCLEAN; 10363000
- DIALA _ DIALB _ 0; 10364000
- LISTMODE _ FALSE; 10365000
+ DIALA ~ DIALB ~ 0; 10364000
+ LISTMODE ~ FALSE; 10365000
ADJUST; 10365100
EMITB(BFW,JUMPLACE,L); 10366000
STUFFF(LISTPLACE); 10367000
@@ -8983,16 +8984,16 @@ EL: IF FORMATPHRASE THEN GO TO EX END 10119000
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
+ "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
+ 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
+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
@@ -9001,29 +9002,29 @@ MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000
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
+ 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
+ TESTVARB~NODIM+NXTINFOTEMP; 10590000
STEPIT; 10591000
- STORESUBS:IF(RR3_TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000
+ 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
+ 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
+ OPLIT~1; 10603000
COMMENT ERROR 402 IS BAD 10604000
SUBSCRIPT IN MONITOR DECLARATION;10605000
STEPIT; 10606000
@@ -9035,10 +9036,10 @@ MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000
PROGRAM DESCRIPTOR CREATED AND THE 10612000
ADDRESS SAVED IN SUBSCRIPT, SUBSCRIPT10613000
MUST BE MARKED FOR AN OPDC; 10614000
- JUMPCHKNX; SUBSCRIPT_PROGDESCBLDR( 10615000
+ JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000
ADES,L,0); AEXP; EMITO(RTS); 10616000
JUMPCHKX; 10616500
- OPLIT_0; 10617000
+ OPLIT~0; 10617000
IF MODE > 0 10618000
THEN BEGIN COMMENT STUFF F AT THIS 10619000
POINT IF MODE > 0; 10620000
@@ -9046,7 +9047,7 @@ MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000
SUBSCRIPT,STD); 10622000
END; 10623000
END; 10624000
- PUT(TAKE(NXTINFOTEMP_NXTINFOTEMP+1) & 10625000
+ PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000
SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000
NXTINFOTEMP); 10627000
IF ELCLASS = COMMA 10628000
@@ -9059,13 +9060,13 @@ MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000
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
+ 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
+ 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
@@ -9078,38 +9079,38 @@ MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000
IF RANGE(BOOPROCID,INTPROCID) 10654000
THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000
E ;% 10656000
-IF LEVEL=(RR2_ELBAT[I]).LVL THEN 10656010
+IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010
BEGIN 10656011
%%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012
%%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013
PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014
PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015
END ; 10656016
- PUTNBUMP(NOPAR _ TAKEFRST & 10656030
- FILEIDENT[INSERTFILE]); TESTVARB_(NOPAR10657000
- _NOPAR. NOPARPART )+(INC_(ELBATWORD_ELBAT[I]). 10658000
+ PUTNBUMP(NOPAR ~ TAKEFRST & 10656030
+ FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR10657000
+ ~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000
LINK+ELBATWORD.INCR); 10659000
- DO PUTNBUMP(TAKE(INC_INC+1)) 10660000
- UNTIL INC>= TESTVARB; 10661000
+ 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 MONITOR 10670000
- 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
+ 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
@@ -9225,25 +9226,25 @@ PROCEDURE DMUP; 10681000
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
+ 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
+ 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
+ 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
+ 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
@@ -9262,13 +9263,13 @@ PROCEDURE DMUP; 10681000
COMMENT ERROR 411 MEANS 10830000
DUMP LIST ELEMENT HAS WRONG 10831000
NUMBER OF SUBSCRIPTS; 10832000
- FORMATTYPE_2; GO CALLPRINTI10833000
+ 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
+ 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
@@ -9298,9 +9299,9 @@ PROCEDURE DMUP; 10681000
ERR(413); GO TO EXIT; 10866000
END; 10867000
EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000
- FORMATTYPE_4; I_I-1; GO CALLPRINTI; 10869000
+ FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000
END; 10870000
- FORMATTYPE_1; 10871000
+ FORMATTYPE~1; 10871000
IF RANGE(BOOID,INTID) 10872000
THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000
EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000
@@ -9309,8 +9310,8 @@ PROCEDURE DMUP; 10681000
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
+ 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
@@ -9337,30 +9338,30 @@ PROCEDURE DMUP; 10681000
THEN GO TO EXIT; 10903000
COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000
DELIMETER; 10905000
- LEXIT_L; EMITL(0); EMITO(RTS); 10906000
+ 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
+ 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
+ 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
+ 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
+ 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
@@ -9368,7 +9369,7 @@ PROCEDURE DMUP; 10681000
END; 10926560
PRIMARY; EMITV(DUMPETEMP); 10927000
EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000
- L_FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000
+ 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
@@ -9398,70 +9399,70 @@ BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113-10954000
BEGIN 10955000
LABEL LX,EXIT,BEF; 10956000
REAL K,N,T1,TL; 10957000
- TL _ L; 10958000
+ TL ~ L; 10958000
EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000
- L _ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000
+ 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
+ GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000
IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000
LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000
THEN BEGIN 10966000
- INFO[0,N] _ ELBAT[I]; 10967000
- IF N _ N+1 = 256 10968000
+ 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
+ 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~INFO[0,K]).[35:1]); 10974000
EMIT(GT1) END; 10975000
- SWITCHGEN _ FALSE END 10976000
+ SWITCHGEN ~ FALSE END 10976000
ELSE BEGIN 10977000
- BEF: L _ BUMPL; N _ N-1; 10978000
+ BEF: L ~ BUMPL; N ~ N-1; 10978000
PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500
[16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600
- FOR K _ 0 STEP 1 UNTIL N 10979000
+ 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
+ ADJUST; T1 ~ L; 10981000
+ EMITL(GNAT(GT1~INFO[0,K])); 10982000
GENGO(GT1); 10983000
- INFO[0,K] _ T1; 10984000
+ INFO[0,K] ~ T1; 10984000
EMITO(RTS); 10985000
CONSTANTCLEAN END; 10986000
- I _ I-1; N _ N+1; 10987000
+ I ~ I-1; N ~ N+1; 10987000
DO BEGIN ADJUST; 10988000
- STEPIT; INFO[0,N] _ L; 10989000
- IF N _ N+1 = 256 10990000
+ 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
+ EMIT(0); EMITO(RTS); N ~ N-1; 10995000
+ FOR K ~ 0 STEP 1 UNTIL N 10996000
DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000
- SWITCHGEN _ TRUE END; 10998000
- T1 _ L; 10999000
- L _ TL+4; 11000000
+ SWITCHGEN ~ TRUE END; 10998000
+ T1 ~ L; 10999000
+ L ~ TL+4; 11000000
EMITL(N+1); 11001000
- L _ T1; 12000000
+ L ~ T1; 12000000
EXIT: END SWITCHGEN; 12001000
PROCEDURE DBLSTMT; 12002000
BEGIN 12003000
REAL S,T; 12004000
BOOLEAN B ; 12004100
LABEL L1,L2,L3,L4,EXIT ; 12005000
- S_0; 12006000
+ 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
+ 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
+ DPTOG~FALSE; 12016000
STEPIT; 12017000
GO TO L2; 12018000
END; 12019000
@@ -9470,27 +9471,27 @@ BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113-10954000
IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000
BEGIN 12023000
EMITO(ELBAT[I].ADDRESS+1); 12024000
- L4: IF (S_S-1)<=0THEN FLAG(282); STEPIT ; 12025000
+ L4: IF (S~S-1){0THEN 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
+ 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
+ B~ELCLASS=INTID OR ELCLASS=INTARRAYID 12034100
OR ELCLASS=INTPROCID ; 12034110
- IF ELCLASS<=INTID AND ELCLASS>=REALID THEN 12035000
+ IF ELCLASS{INTID AND ELCLASS}REALID THEN 12035000
BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000
- ELSE IF ELCLASS<=INTPROCID AND ELCLASS>=REALPROCID TH12036100EN
+ 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=BOOID THEN 12042000
+ IF ELCLASS{INTID AND ELCLASS}BOOID THEN 12042000
BEGIN 12043000
- CHECKER(T_ELBAT[I]); 12044000
+ CHECKER(T~ELBAT[I]); 12044000
STEPIT;STEPIT; 12045000
AEXP; 12046000
EMITV(T.ADDRESS); 12047000
@@ -9513,7 +9514,7 @@ BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113-10954000
IF ELCLASS!COMMA THEN BEGIN ERR(284);GO EXIT 12052000
END; 12053000
STEPIT; AEXP; EMITO(XCH); 12054000
- L2: S_S+1; 12055000
+ 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
@@ -9523,17 +9524,17 @@ PROCEDURE CMPLXSTMT ; 12060000
REAL S,T ; 12060200
BOOLEAN B ; 12060250
LABEL L1,L2,L3,L4,L5,EXIT,ERROR ; 12060300
- DEFINE ERRX(ERRX1) = BEGIN T_ERRX1; GO ERROR END #; 12060400
+ DEFINE ERRX(ERRX1) = BEGIN T~ERRX1; GO ERROR END #; 12060400
IF STEPI!LEFTPAREN THEN ERRX(381) ; 12060500
L1: STEPIT ; 12060550
IF TABLE(I+1)=COMMA THEN 12060600
BEGIN 12060700
IF ELCLASS=ADOP THEN 12060800
BEGIN 12060900
- T_ELBAT[I].ADDRESS ; 12061000
+ T~ELBAT[I].ADDRESS ; 12061000
EMITPAIR(9,STD); EMITO(XCH); EMITV(9); EMITO(T) ; 12061100
EMITPAIR(9,STD); EMITO(T); EMITV(9) ; 12061200
-L4: IF S_S-1<1 THEN FLAG(382); STEPIT; GO L1 ; 12061300
+L4: IF S~S-1<1 THEN FLAG(382); STEPIT; GO L1 ; 12061300
END ; 12061400
IF ELCLASS=MULOP THEN 12061500
BEGIN 12061600
@@ -9544,8 +9545,8 @@ L5: EMITO(DEL); EMITO(DEL); GO L4 ; 12061800
END ; 12061900
IF ELCLASS=ASSIGNOP THEN 12062000
BEGIN 12062100
- IF S_S-1<0 THEN FLAG(385); T_0; STEPIT ; 12062200
- B_ELCLASS=INTID OR ELCLASS=INTPROCID 12062250
+ IF S~S-1<0 THEN FLAG(385); T~0; STEPIT ; 12062200
+ B~ELCLASS=INTID OR ELCLASS=INTPROCID 12062250
OR ELCLASS=INTARRAYID ; 12062255
DO BEGIN 12062300
IF ELCLASS!COMMA THEN ERRX(384); STEPIT ; 12062400
@@ -9559,7 +9560,7 @@ L5: EMITO(DEL); EMITO(DEL); GO L4 ; 12061800
ELSE ERRX(386) ; 12063200
EMITO(IF B THEN ISD ELSE STD) ; 12063300
END 12063400
- UNTIL T_T+1=2 ; 12063500
+ UNTIL T~T+1=2 ; 12063500
IF ELCLASS!RTPAREN THEN GO L3 ; 12063600
IF S!0 THEN FLAG(383) ELSE BEGIN STEPIT; GO EXIT END ; 12063610
END ; 12063700
@@ -9569,38 +9570,38 @@ L5: EMITO(DEL); EMITO(DEL); GO L4 ; 12061800
END ; 12064100
IF ELCLASS>BOOID AND ELCLASS="0" 13011000
+ 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
+ SI~T1; DS~ T CHR;GO TO EXIT 13015000
END; 13016000
- SI_T1;DS _ 7 CHR; 13017000
+ 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
+ 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
+ DI~IDLOC; DI~DI+5;DI~DC; 13023000
+ SI~LOC FILENO; SI~SI+6; 13024000
+ DS~ 2 CHR; SI~LOC TYPE; 13025000
+ SI~ SI+7; DS~ CHR; 13026000
+ SI~ LOC MULFID;SI+SI+1; 13027000
+ DS~ 7 CHR; 13028000
+ SI~ LOC FILID;SI~SI+1; 13029000
+ DS~ 7 CHR; 13030000
+ SI~ LOC N; SI~SI+7; 13031000
+ DS~ CHR; 13032000
+ SI~ FILID1; SI~SI+3; 13033000
+ DS~ N CHR; N~DI; 13034000
+ DI~ IDLOC; DI~DI+5; 13035000
+ SI~ LOC N; SI~SI+5; 13036000
+ DS~ 3 CHR 13037000
END; 13038000
REAL MULFID,FILID,TYPE,M,K; 13039000
DEFINE CALL5=EMITL(0); EMITL(IOT); EMITL(8); EMITV(5) # ; 13039400
REAL SAVADDRSF ; 13039450
REAL ACCUM1; 13039500
INTEGER CURRENT, IOTEMP, IOTEMPO; 13039550
- LABEL START; 13040000
- JUMPCHKX; 13041000
- IF G_GTA1[J_J-1]=FILEV 13042000
- THEN 13043000
- BEGIN 13044000
- IF G_GTA1[J_J-1]=SWITCHV 13045000
- THEN 13046000
- BEGIN 13047000
- STOPENTRY_NOT SPECTOG; 13048000
- ENTRY(SUPERFILEID); 13049000
- IF SPECTOG THEN GO TO START; 13050000
- IF ELCLASS!ASSIGNOP 13051000
- THEN FLAG(34); 13052000
- EMITO(MKS); 13053000
- CHECKDISJOINT(ADDRSF); 13054000
- G_L;L_L+1; 13055000
- EMITL(1); 13056000
- EMITL(1); 13057000
- EMITL(1); 13058000
- EMITV(5) ; 13059000
+ LABEL START; 13040000
+ JUMPCHKX; 13041000
+ IF G~GTA1[J~J-1]=FILEV 13042000
+ THEN 13043000
+ BEGIN 13044000
+ IF G~GTA1[J~J-1]=SWITCHV 13045000
+ THEN 13046000
+ BEGIN 13047000
+ STOPENTRY~NOT SPECTOG; 13048000
+ ENTRY(SUPERFILEID); 13049000
+ IF SPECTOG THEN GO TO START; 13050000
+ IF ELCLASS!ASSIGNOP 13051000
+ THEN FLAG(34); 13052000
+ EMITO(MKS); 13053000
+ CHECKDISJOINT(ADDRSF); 13054000
+ G~L;L~L+1; 13055000
+ EMITL(1); 13056000
+ EMITL(1); 13057000
+ EMITL(1); 13058000
+ EMITV(5) ; 13059000
13060000
- J_-1; STOPENTRY_FALSE; 13061000
- DO 13062000
- BEGIN 13063000
- IF STEPI ! FILEID% 13064000
- THEN FLAG(35); 13065000
- PASSFILE; 13066000
- EMITL(J_J+1); 13067000
- EMITN(ADDRSF); 13068000
- EMITO(STD); 13069000
- END 13070000
- UNTIL ELCLASS!COMMA; 13071000
- GT2_L;L_G; EMITL(J+1); L_GT2; GO TO START 13072000
- END; 13073000
- I_I-1;M_1; 13074000
- IF G=ALFAV 13075000
- THEN M_0 13076000
- ELSE J_J+1;K_J; STOPENTRY_NOT SPECTOG; 13077000
- DO 13078000
- BEGIN 13079000
- STOPDEFINE := TRUE ; 13079500
- STEPIT; J:=K;P2:=P3:=P4:=FALSE;GTA1[0]:=0; GET7(ACCUM[1],FILID)13080000;
- MULFID_0;TYPE_2; ENTER(FILEID); 13081000
- SAVADDRSF_ADDRSF ; 13081500
- IF SPECTOG THEN GO TO START; 13082000
- EMITO(MKS);EMITL(0);EMITL(0); 13082500
- IF ELCLASS=LITNO 13083000
- THEN 13084000
- BEGIN 13085000
- TYPE_ELBAT[I].ADDRESS; 13086000
- STEPIT 13087000
- END; 13088000
- IF ELCLASS<=IDMAX THEN 13088010
- BEGIN 13088020
- % TO VOID A CARD 13088025
- IF ACCUM1_ACCUM[1]="5PRINT" THEN TYPE_1 ELSE 13088030
- IF ACCUM1="6REMOT" THEN TYPE _ 19 ELSE 13088035
- IF ACCUM1="5PUNCH" THEN TYPE_0 ELSE 13088040
- IF ACCUM1="4DISK0" THEN BEGIN STOPDEFINE_TRUE ;13088050
- TYPE:=12; IF STEPI <=IDMAX THEN BEGIN IF ACCUM1 := ACCUM[1] !13088060
- "6SERIA" THEN BEGIN IF ACCUM1 = "6RAND0" THEN 13088070
- TYPE:=TYPE-2 ELSE IF ACCUM1 = "6UPDAT" THEN 13088075
- TYPE:=TYPE+1 ELSE 13088080
- IF ACCUM1="7PROTE" THEN TYPE_26 ELSE 13088082
- FLAG(43);STEPIT; END; IF ELCLASS=LFTBRKET THEN 13088085
- BEGIN STEPIT;L_L-2;AEXP;IF ELCLASS=COLON THEN BEGIN 13088090
- STEPIT; AEXP END ELSE FLAG(30); 13088100
- IF ELCLASS!RTBRKET THEN FLAG(44);END ELSE I_I-1; 13088105
- END; 13088110
- STEPIT 13088120
- END; 13088130
- IF ELCLASS=STRNGCON THEN 13089000
- BEGIN 13090000
- GET7(ACCUM[1],G); 13091000
- IF STEPI=STRNGCON 13092000
- THEN 13093000
- BEGIN 13094000
- GET7(ACCUM[1],FILID); 13095000
- STEPIT; 13096000
- MULFID_G 13097000
- END 13098000
- ELSE 13099000
- FILID_G; 13100000
- END; 13101000
- IF MKABS(IDARRAY[127]) - IDLOC.[33:15] < (26 + KOUNT).[41:4] 13101100
- THEN FLAG(040) ELSE 13101200
- ENTERID(IDLOC,FILENO ,TYPE,MULFID,FILID,INFO[(LASTINFO+1).13102000
- LINKR,(LASTINFO+1).LINKC],KOUNT); 13103000
- IF ELCLASS!LEFTPAREN 13104000
- THEN FLAG(26); 13105000
- ARRAYFLAG_BOOLEAN(3) ; 13106000
+ J~-1; STOPENTRY~FALSE; 13061000
+ DO 13062000
+ BEGIN 13063000
+ IF STEPI ! FILEID% 13064000
+ THEN FLAG(35); 13065000
+ PASSFILE; 13066000
+ EMITL(J~J+1); 13067000
+ EMITN(ADDRSF); 13068000
+ EMITO(STD); 13069000
+ END 13070000
+ UNTIL ELCLASS!COMMA; 13071000
+ GT2~L;L~G; EMITL(J+1); L~GT2; GO TO START 13072000
+ END; 13073000
+ I~I-1;M~1; 13074000
+ IF G=ALFAV 13075000
+ THEN M~0 13076000
+ ELSE J~J+1;K~J; STOPENTRY~NOT SPECTOG; 13077000
+ DO 13078000
+ BEGIN 13079000
+ STOPDEFINE := TRUE ; 13079500
+ STEPIT; J:=K;P2:=P3:=P4:=FALSE;GTA1[0]:=0; GET7(ACCUM[1],FILID);13080000
+ MULFID~0;TYPE~2; ENTER(FILEID); 13081000
+ SAVADDRSF~ADDRSF ; 13081500
+ IF SPECTOG THEN GO TO START; 13082000
+ EMITO(MKS);EMITL(0);EMITL(0); 13082500
+ IF ELCLASS=LITNO 13083000
+ THEN 13084000
+ BEGIN 13085000
+ TYPE~ELBAT[I].ADDRESS; 13086000
+ STEPIT 13087000
+ END; 13088000
+ IF ELCLASS{IDMAX THEN 13088010
+ BEGIN 13088020
+% TO VOID A CARD 13088025
+ IF ACCUM1~ACCUM[1]="5PRINT" THEN TYPE~1 ELSE 13088030
+ IF ACCUM1="6REMOT" THEN TYPE ~ 19 ELSE 13088035
+ IF ACCUM1="5PUNCH" THEN TYPE~0 ELSE 13088040
+ IF ACCUM1="4DISK0" THEN BEGIN STOPDEFINE~TRUE ; 13088050
+ TYPE:=12; IF STEPI {IDMAX THEN BEGIN IF ACCUM1 := ACCUM[1] ! 13088060
+ "6SERIA" THEN BEGIN IF ACCUM1 = "6RAND0" THEN 13088070
+ TYPE:=TYPE-2 ELSE IF ACCUM1 = "6UPDAT" THEN 13088075
+ TYPE:=TYPE+1 ELSE 13088080
+ IF ACCUM1="7PROTE" THEN TYPE~26 ELSE 13088082
+ FLAG(43);STEPIT; END; IF ELCLASS=LFTBRKET THEN 13088085
+ BEGIN STEPIT;L~L-2;AEXP;IF ELCLASS=COLON THEN BEGIN 13088090
+ STEPIT; AEXP END ELSE FLAG(30); 13088100
+ IF ELCLASS!RTBRKET THEN FLAG(44);END ELSE I~I-1; 13088105
+ END; 13088110
+ STEPIT 13088120
+ END; 13088130
+ IF ELCLASS=STRNGCON THEN 13089000
+ BEGIN 13090000
+ GET7(ACCUM[1],G); 13091000
+ IF STEPI=STRNGCON 13092000
+ THEN 13093000
+ BEGIN 13094000
+ GET7(ACCUM[1],FILID); 13095000
+ STEPIT; 13096000
+ MULFID~G 13097000
+ END 13098000
+ ELSE 13099000
+ FILID~G; 13100000
+ END; 13101000
+ IF MKABS(IDARRAY[127]) - IDLOC.[33:15] < (26 + KOUNT).[41:4] 13101100
+ THEN FLAG(040) ELSE 13101200
+ ENTERID(IDLOC,FILENO ,TYPE,MULFID,FILID,INFO[(LASTINFO+1). 13102000
+ LINKR,(LASTINFO+1).LINKC],KOUNT); 13103000
+ IF ELCLASS!LEFTPAREN 13104000
+ THEN FLAG(26); 13105000
+ ARRAYFLAG~BOOLEAN(3) ; 13106000
13107000
- EMITL(REAL(NOT(P2 OR P3)).[46:2]); 13108000
- EMITL(FILENO);FILENO_FILENO+1; 13109000
- CHECKDISJOINT(TAKE(LASTINFO).ADDRESS); 13110000
- STEPIT;AEXP;EMITL(M); 13111000
- COMMENT GUESS AT THE NO. OF BUFFERS DECLARED; 13112000
- IF (IOTEMP_GET(L-2)).[46:2] = 0 THEN CURRENT _ IOTEMP 13113000
- DIV 4 ELSE CURRENT_2; 13114000
+ EMITL(REAL(NOT(P2 OR P3)).[46:2]); 13108000
+ EMITL(FILENO);FILENO~FILENO+1; 13109000
+ CHECKDISJOINT(TAKE(LASTINFO).ADDRESS); 13110000
+ STEPIT;AEXP;EMITL(M); 13111000
+ COMMENT GUESS AT THE NO. OF BUFFERS DECLARED; 13112000
+ IF (IOTEMP~GET(L-2)).[46:2] = 0 THEN CURRENT ~ IOTEMP 13113000
+ DIV 4 ELSE CURRENT~2; 13114000
13115000
13116000
13117000
@@ -9802,8 +9803,8 @@ END DEFINEPARAM; 12166000
BEGIN 13147000
STEPIT; AEXP; 13148000
13148100
- IF (IOTEMP_GET(L-1)).[46:2] = 0 THEN IOTEMP_IOTEMP DIV 4 13148200
- ELSE IOTEMP_ 256; 13148300
+ IF (IOTEMP~GET(L-1)).[46:2] = 0 THEN IOTEMP~IOTEMP DIV 4 13148200
+ ELSE IOTEMP~ 256; 13148300
IF ELCLASS!COMMA 13149000
THEN 13150000
BEGIN 13151000
@@ -9812,33 +9813,33 @@ END DEFINEPARAM; 12166000
END 13154000
ELSE 13155000
BEGIN 13156000
- IF GT1_FILEATTRIBUTEINDX(FALSE)=0 THEN 13157000
+ IF GT1~FILEATTRIBUTEINDX(FALSE)=0 THEN 13157000
BEGIN AEXP; 13157010
IF (IOTEMPO:=GET(L-1)).[46:2] = 0 THEN 13157020
IF IOTEMPO DIV 4 > IOTEMP THEN 13157030
IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040
ELSE BEGIN 13158000
EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000
- EMITN(SAVADDRSF); GT1_FILEATTRIBUTEHANDLER(FIO);13160000
+ EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000
END ; 13161000
WHILE ELCLASS=COMMA DO 13162000
- IF GT1_FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000
+ 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
+ GT1~FILEATTRIBUTEHANDLER(FIO); 13167000
END ; 13168000
END ; 13169000
END ; 13170000
- ARRAYFLAG_FALSE ; 13181000
+ ARRAYFLAG~FALSE ; 13181000
IF ELCLASS!RTPAREN THEN FLAG(29); 13182000
COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000
- IOBUFFSIZE_IOBUFFSIZE + 50 + ( CURRENT x IOTEMP); 13184000
+ IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000
% VOID 13185000
% VOID 13186000
END 13187000
UNTIL STEPI!COMMA; 13188000
- STOPENTRY_FALSE; 13189000
+ STOPENTRY~FALSE; 13189000
END ELSE 13190000
BEGIN 13191000
IF G!FORMATV THEN FLAG(33) ELSE 13192000
@@ -9851,248 +9852,248 @@ END DEFINEPARAM; 12166000
LABEL OVER; 13196320
13196330
JUMPCHKX; 13196340
- STOPENTRY_ NOT SPECTOG; 13196350
+ STOPENTRY~ NOT SPECTOG; 13196350
ENTRY(SUPERLISTID); 13196360
IF SPECTOG THEN GO TO OVER; 13196370
IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380
- COMMENT MISSING _; 13196390
+ COMMENT MISSING ~; 13196390
EMITO(MKS); 13196400
CHECKDISJOINT(ADDRSF); 13196410
- G_L; L_L+1; 13196420
+ G~L; L~L+1; 13196420
EMITL(1); 13196430
EMITL(1); 13196440
EMITL(1); 13196450
EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460
LIST DESCRIPTORS FOR SWITCH LIST; 13196470
COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480
- J_-1; STOPENTRY _ FALSE; 13196490
+ J~-1; STOPENTRY ~ FALSE; 13196490
DO 13196500
BEGIN 13196510
IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520
THEN BEGIN ERR(42); GO TO OVER END; 13196530
PASSLIST; 13196540
- EMITL(J_J+1); 13196550
+ 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
+ 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
+ T ~ ELBAT[I]; 13200000
+ KLASSF ~ T.CLASS; 13201000
+ FORMALF ~ BOOLEAN(T.FORMAL); 13202000
+ VONF ~ BOOLEAN(T.VO); 13203000
+ LEVELF ~ T.LVL; 13204000
+ ADDRSF ~ T.ADDRESS; 13205000
+ INCRF ~ T.INCR; 13206000
+ LINKF ~ T.LINK; 13207000
END SCATTERELBAT; 13208000
- PROCEDURE CHKSOB; 13209000
- IF GTA1[J_J-1]!0 THEN FLAG(23); 13210000
- DEFINE SUBOP=48#, 13211000
- ADDC=532480#, 13212000
- SUBC=1581056#, 13213000
- EMITSTORE=EMITPAIR#; 13214000
- PROCEDURE PURGE(STOPPER); 13215000
- VALUE STOPPER; 13216000
- REAL STOPPER; 13217000
- BEGIN 13218000
- INTEGER POINTER; 13219000
- LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000
- REAL J,N,OCR,TL,ADD; 13221000
- POINTER_LASTINFO; 13222000
- WHILE POINTER>= STOPPER 13223000
- DO 13224000
- BEGIN 13225000
- IF ELCLASS_(GT1_TAKE(POINTER)).CLASS=NONLITNO 13226000
- THEN BEGIN 13227000
- NCII_NCII-1; 13228000
- EMITNUM(TAKE(POINTER+1)); 13229000
- EMITSTORE(MAXSTACK,STD); 13230000
- MAXSTACK_(G_MAXSTACK)+1; 13231000
- J_L; L_GT1.LINK; 13232000
- DO 13233000
- BEGIN 13234000
- GT4_GET(L); 13235000
- EMITV(G) 13236000
- END 13237000
- UNTIL (L_GT4)=4095; 13238000
- L_J; 13239000
- POINTER_POINTER-GT1.INCR 13240000
- END 13241000
- ELSE 13242000
- BEGIN 13243000
- IF NOT BOOLEAN(GT1.FORMAL) 13244000
- THEN BEGIN 13245000
- IF ELCLASS = LABELID 13246000
- THEN BEGIN 13247000
- ADD _ GT1.ADDRESS; 13248000
- IF NOT BOOLEAN(OCR_TAKE(GIT(POINTER))).[1:1] 13249000
- THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000
- THEN BEGIN GT1 _ 160; GO TO RECOV END; 13251000
- IF ADD ! 0 THEN GT1_PROGDESCBLDR(2,OCR,ADD) END13252000
- 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)x4096+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)x4096+GET(L+1); 13273000
- GOGEN(GT1,BFW) END;END; 13274000
+PROCEDURE CHKSOB; 13209000
+ IF GTA1[J~J-1]!0 THEN FLAG(23); 13210000
+DEFINE SUBOP=48#, 13211000
+ ADDC=532480#, 13212000
+ SUBC=1581056#, 13213000
+ EMITSTORE=EMITPAIR#; 13214000
+ PROCEDURE PURGE(STOPPER); 13215000
+ VALUE STOPPER; 13216000
+ REAL STOPPER; 13217000
+ BEGIN 13218000
+ INTEGER POINTER; 13219000
+ LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000
+ REAL J,N,OCR,TL,ADD; 13221000
+ POINTER~LASTINFO; 13222000
+ WHILE POINTER } STOPPER 13223000
+ DO 13224000
+ BEGIN 13225000
+ IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO 13226000
+ THEN BEGIN 13227000
+ NCII~NCII-1; 13228000
+ EMITNUM(TAKE(POINTER+1)); 13229000
+ EMITSTORE(MAXSTACK,STD); 13230000
+ MAXSTACK~(G~MAXSTACK)+1; 13231000
+ J~L; L~GT1.LINK; 13232000
+ DO 13233000
+ BEGIN 13234000
+ GT4~GET(L); 13235000
+ EMITV(G) 13236000
+ END 13237000
+ UNTIL (L~GT4)=4095; 13238000
+ L~J; 13239000
+ POINTER~POINTER-GT1.INCR 13240000
+ END 13241000
+ ELSE 13242000
+ BEGIN 13243000
+ IF NOT BOOLEAN(GT1.FORMAL) 13244000
+ THEN BEGIN 13245000
+ IF ELCLASS = LABELID 13246000
+ THEN BEGIN 13247000
+ ADD ~ GT1.ADDRESS; 13248000
+ IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1] 13249000
+ THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000
+ THEN BEGIN GT1 ~ 160; GO TO RECOV END; 13251000
+ IF ADD ! 0 THEN GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000
+ ELSE IF ELCLASS = SWITCHID 13253000
+ THEN BEGIN 13254000
+ IF TAKE(POINTER+1) < 0 13255000
+ THEN BEGIN GT1 ~ 162; GO TO RECOV END; 13256000
+ OCR ~(J ~ TAKE(GIT(POINTER))).[24:12]; 13257000
+ N ~ GET( (J~J.[36:12])+4); TL ~ L; 13258000
+ IF ADD ~ GT1.ADDRESS ! 0 13259000
+ THEN BEGIN 13260000
+ GT5 ~ PROGDESCBLDR(0,J,ADD); 13261000
+ IF OCR ! 0 13262000
+ THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000
+ L~J+11; EMITL(15); EMITO(RTS); 13264000
+ FOR J ~ 4 STEP 4 UNTIL N 13265000
+ DO BEGIN 13266000
+ EMITL(GNAT(GET(L)|4096+GET(L+1))); 13267000
+ EMITO(RTS) END END 13268000
+ ELSE BEGIN 13269000
+ L ~ J+13; 13270000
+ FOR J ~ 4 STEP 4 UNTIL N 13271000
+ DO BEGIN 13272000
+ GT1 ~ GET(L)|4096+GET(L+1); 13273000
+ GOGEN(GT1,BFW) END;END; 13274000
13275000
13276000
- L _ TL END 13277000
- ELSE IF ELCLASS >=PROCID AND ELCLASS<= INTPROCID 13278000
- THEN IF TAKE(POINTER+1) < 0 13279000
- THEN BEGIN GT1 _ 161; 13280000
- RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM13281000);
- Q _ ACCUM[1]; FLAG(GT1); ERRORTOG _ TRUE END 13282000
- END; 13283000
- XREFDUMP(POINTER); % DUMP XREF INFO %11132835006-
- GT2_TAKE(POINTER+1); 13284000
- GT3_GT2.PURPT; 13285000
- STACKHEAD(0>2[12:12:36])MOD 125]_TAKE(POINTER).LINK; 13286000
- POINTER_POINTER-GT3 13287000
- END 13288000
- END ; 13289000
- LASTINFO_POINTER; 13290000
- NEXTINFO_STOPPER 13291000
- END; 13292000
- PROCEDURE E; 13293000
- COMMENT 13294000
- E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND 13295000
- HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK 13296000
- IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY 13297000
- E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE 13298000
- BEGINNING OF THE NEXT ROW IF NECESSARY 13299000 ;
- BEGIN 13300000
- REAL WORDCOUNT,RINX; 13301000
- IF RINX_(NEXTINFO+WORDCOUNT_(COUNT+18)DIV 8 ).LINKR ! 13302000
- NEXTINFO.LINKR 13303000
- THEN BEGIN PUT(0&(RINXx256-NEXTINFO)[27:40:8],NEXTINFO); 13304000
- NEXTINFO_256xRINX END; 13305000
- IF SPECTOG THEN 13305100
- IF NOT MACROID THEN 13305200
- UNHOOK; 13305300
- KOUNT_COUNT; 13306000
- ACCUM[0].INCR_WORDCOUNT; 13307000
- ACCUM[0].LINK _STACKHEAD[SCRAM];STACKHEAD[SCRAM]_NEXTINFO; 13308000
- ACCUM[1].PURPT_NEXTINFO_LASTINFO; 13309000
- MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000
- IF XREF THEN % MAKE DECLARATION REFERENCE %11133100506-
- IF (ACCUM[0].CLASS ! DEFINEID OR NOT %11133100756-
- BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER%11133100806-
- BEGIN %11133101006-
- XREFINFO[NEXTINFO] := %11133102006-
- IF SPECTOG THEN %11133103006-
- XREFINFO[ELBAT[I]] %11133103506-
- ELSE %11133104006-
- ((XLUN := XLUN + 1) & SGNO SEGNOF); %11133104506-
- IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY %11133105006-
- XMARK(DECLREF) %11133105256-
- ELSE %11133105506-
- XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG%11133105756-
- THEN NORMALREF ELSE DECLREF); %11133105806-
- END %11133106006-
- ELSE % DEFINE PARAMETERS - DONT CROSS REF. %11133107006-
- XREFINFO[NEXTINFO] := 0 %11133107506-
- ELSE %11133108006-
- IF DEFINING.[1:1] THEN % WE ARE DOING XREFING %11133109006-
- XREFINFO[NEXTINFO] := 0; %11133109506-
- LASTINFO_NEXTINFO; 13311000
- IF NEXTINFO _ NEXTINFO+WORDCOUNT >=8192 THEN 13312000
- BEGIN FLAG(199); GO TO ENDOFITALL END; 13312500
+ L ~ TL END 13277000
+ ELSE IF ELCLASS }PROCID AND ELCLASS { INTPROCID 13278000
+ THEN IF TAKE(POINTER+1) < 0 13279000
+ THEN BEGIN GT1 ~ 161; 13280000
+ RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM);13281000
+ Q ~ ACCUM[1]; FLAG(GT1); ERRORTOG ~ TRUE END 13282000
+ END; 13283000
+ XREFDUMP(POINTER); % DUMP XREF INFO %116-13283500
+ GT2~TAKE(POINTER+1); 13284000
+ GT3~GT2.PURPT; 13285000
+ STACKHEAD(0>2[12:12:36])MOD 125]~TAKE(POINTER).LINK; 13286000
+ POINTER~POINTER-GT3 13287000
+ END 13288000
+ END ; 13289000
+ LASTINFO~POINTER; 13290000
+ NEXTINFO~STOPPER 13291000
+ END; 13292000
+PROCEDURE E; 13293000
+COMMENT 13294000
+ E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND 13295000
+ HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK 13296000
+ IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY 13297000
+ E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE 13298000
+ BEGINNING OF THE NEXT ROW IF NECESSARY ;13299000
+ BEGIN 13300000
+ REAL WORDCOUNT,RINX; 13301000
+ IF RINX~(NEXTINFO+WORDCOUNT~(COUNT+18)DIV 8 ).LINKR ! 13302000
+ NEXTINFO.LINKR 13303000
+ THEN BEGIN PUT(0&(RINX|256-NEXTINFO)[27:40:8],NEXTINFO); 13304000
+ NEXTINFO~256|RINX END; 13305000
+ IF SPECTOG THEN 13305100
+ IF NOT MACROID THEN 13305200
+ UNHOOK; 13305300
+ KOUNT~COUNT; 13306000
+ ACCUM[0].INCR~WORDCOUNT; 13307000
+ ACCUM[0].LINK ~STACKHEAD[SCRAM];STACKHEAD[SCRAM]~NEXTINFO; 13308000
+ ACCUM[1].PURPT~NEXTINFO~LASTINFO; 13309000
+MOVE(WORDCOUNT,ACCUM,INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]); 13310000
+ IF XREF THEN % MAKE DECLARATION REFERENCE %116-13310050
+ IF (ACCUM[0].CLASS ! DEFINEID OR NOT %116-13310075
+ BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER%116-13310080
+ BEGIN %116-13310100
+ XREFINFO[NEXTINFO] := %116-13310200
+ IF SPECTOG THEN %116-13310300
+ XREFINFO[ELBAT[I]] %116-13310350
+ ELSE %116-13310400
+ ((XLUN := XLUN + 1) & SGNO SEGNOF); %116-13310450
+ IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY %116-13310500
+ XMARK(DECLREF) %116-13310525
+ ELSE %116-13310550
+ XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG%116-13310575
+ THEN NORMALREF ELSE DECLREF); %116-13310580
+ END %116-13310600
+ ELSE % DEFINE PARAMETERS - DONT CROSS REF. %116-13310700
+ XREFINFO[NEXTINFO] := 0 %116-13310750
+ ELSE %116-13310800
+ IF DEFINING.[1:1] THEN % WE ARE DOING XREFING %116-13310900
+ XREFINFO[NEXTINFO] := 0; %116-13310950
+ LASTINFO~NEXTINFO; 13311000
+ IF NEXTINFO ~ NEXTINFO+WORDCOUNT }8192 THEN 13312000
+ BEGIN FLAG(199); GO TO ENDOFITALL END; 13312500
END; 13313000
- PROCEDURE ENTRY(TYPE); 13314000
- VALUE TYPE; 13315000
- REAL TYPE; 13316000
- COMMENT 13317000
- ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH 13318000
- IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT 13319000
- ACCORD TO TYPE .IF THE ENTRY IS AN ARRAY AND NOT 13320000
- A SPECIFICATION THEN A DESCRIPTOR IS PALCED IN THE STACK 13321000
- FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) 13322000 ;
+PROCEDURE ENTRY(TYPE); 13314000
+ VALUE TYPE; 13315000
+ REAL TYPE; 13316000
+COMMENT 13317000
+ ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH 13318000
+ IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT 13319000
+ ACCORD TO TYPE .IF THE ENTRY IS AN ARRAY AND NOT 13320000
+ A SPECIFICATION THEN A DESCRIPTOR IS PALCED IN THE STACK 13321000
+ FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) ;13322000
BEGIN 13323000
- BOOLEAN SVTOG;% 13323010
- J_0;I_I-1; 13324000
- DO 13325000
- BEGIN 13326000
- STOPDEFINE _TRUE; STEPIT; SCATTERELBAT; 13327000
- IF FORMALF_SPECTOG 13328000
- THEN 13329000
- BEGIN 13330000
- IF TYPE<=INTARRAYID AND TYPE>=BOOARRAYID THEN% 13330550
- IF VONF THEN BEGIN SVTOG _ ERRORTOG; FLAG(15);% 13330600
- SPECTOG _ ERRORTOG _ SVTOG; END;% 13330650
- IF ELCLASS!SECRET 13331000
- THEN FLAG(002); 13332000
- BUP_BUP+1 13333000
- END 13334000
- ELSE 13335000
- BEGIN 13336000
- IF ELCLASS>IDMAX AND ELCLASS<=FACTOP 13337000
- THEN FLAG(003); 13338000
- IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION13339000
- IF NOT (PTOG OR STREAMTOG) AND LINKF>= GLOBALNINFOO 13339100
- THEN FLAG(1) %11813339200-
- ELSE %11813339300-
- ELSE %11813339400-
- IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION %11813339500-
- FLAG(1); %11813340000-
- VONF_P2; 13341000
- IF ((FORMALF_PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000
- THEN ADDRSF _ PG _PG+1 13343000
- ELSE IF STOPGSP THEN ADDRSF _ 0 13344000
- ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1].13345000
- IF TYPE<=INTARRAYID AND TYPE>BOOARRAYID 13346000
- THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000
- EMITL(ADDRSF); EMITN(10); 13347500
- END 13347510
- ELSE CHECKDISJOINT(ADDRSF); 13347520
- END; 13348000
- IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100
- XREFPT_XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200
- KLASSF_TYPE; MAKEUPACCUM;E; J_J+1; 13349000
- END 13350000
- UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]_J 13351000
- END; 13352000
- PROCEDURE UNHOOK; 13353000
- COMMENT 13354000
- UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000
- FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000
- E WILL WORK AS NORMAL. 13357000 ;
- BEGIN 13358000
- REAL LINKT,A,LINKP; 13359000
- LABEL L; 13360000
- LINKT_STACKHEAD[SCRAM] ; LINKP_ELBAT[I].LINK; 13361000
- IF LINKT=LINKP THEN STACKHEAD[SCRAM]_TAKE(LINKT).LINK13362000
- ELSE 13363000
- L: IF A_TAKE(LINKT).LINK=LINKP 13364000
- THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000
- ELSE BEGIN LINKT_A; GO TO L END; 13366000
- END; 13367000
+ BOOLEAN SVTOG;% 13323010
+ J~0;I~I-1; 13324000
+ DO 13325000
+ BEGIN 13326000
+ STOPDEFINE ~TRUE; STEPIT; SCATTERELBAT; 13327000
+ IF FORMALF~SPECTOG 13328000
+ THEN 13329000
+ BEGIN 13330000
+ IF TYPE{INTARRAYID AND TYPE}BOOARRAYID THEN% 13330550
+ IF VONF THEN BEGIN SVTOG ~ ERRORTOG; FLAG(15);% 13330600
+ SPECTOG ~ ERRORTOG ~ SVTOG; END;% 13330650
+ IF ELCLASS!SECRET 13331000
+ THEN FLAG(002); 13332000
+ BUP~BUP+1 13333000
+ END 13334000
+ ELSE 13335000
+ BEGIN 13336000
+ IF ELCLASS>IDMAX AND ELCLASS{FACTOP 13337000
+ THEN FLAG(003); 13338000
+ IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 13339000
+ IF NOT (PTOG OR STREAMTOG) AND LINKF } GLOBALNINFOO 13339100
+ THEN FLAG(1) %118-13339200
+ ELSE %118-13339300
+ ELSE %118-13339400
+ IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION %118-13339500
+ FLAG(1); %118-13340000
+ VONF~P2; 13341000
+ IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000
+ THEN ADDRSF ~ PG ~PG+1 13343000
+ ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000
+ ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000
+ IF TYPE{INTARRAYID AND TYPE>BOOARRAYID 13346000
+ THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000
+ EMITL(ADDRSF); EMITN(10); 13347500
+ END 13347510
+ ELSE CHECKDISJOINT(ADDRSF); 13347520
+ END; 13348000
+ IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100
+ XREFPT~XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200
+ KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000
+ END 13350000
+ UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J 13351000
+ END; 13352000
+ PROCEDURE UNHOOK; 13353000
+COMMENT 13354000
+ UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000
+ FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000
+ E WILL WORK AS NORMAL. ;13357000
+ BEGIN 13358000
+ REAL LINKT,A,LINKP; 13359000
+ LABEL L; 13360000
+ LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000
+ IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK 13362000
+ ELSE 13363000
+ L: IF A~TAKE(LINKT).LINK=LINKP 13364000
+ THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000
+ ELSE BEGIN LINKT~A; GO TO L END; 13366000
+ END; 13367000
PROCEDURE MAKEUPACCUM; 13368000
BEGIN 13369000
IF PTOG 13370000
- THEN GT1_LEVELF ELSE GT1_LEVEL; 13371000
- ACCUM[0]_ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000
+ 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
@@ -10133,7 +10134,7 @@ COMMENT 13377000
LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000
COM 13411000
DESC XITR 13412000
- SAVE OWN ARRAY D,E,F[X:Y,M+N:TxV], 13413000
+ SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000
MKS 13414000
DESC D 13415000
DESC E 13416000
@@ -10173,9 +10174,9 @@ COMMENT 13377000
BOOLEAN LLITOG,ULITOG; 13450000
REAL ADDCON; 13451000
LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000
- ARRAYFLAG _ TRUE; 13452100
- TYPEV_REALARRAYID; 13453000
- IF T1_GTA1[J_J-1]=0 THEN J_J+1 13454000
+ ARRAYFLAG ~ TRUE; 13452100
+ TYPEV~REALARRAYID; 13453000
+ IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000
ELSE 13455000
IF T1=OWNV THEN 13456000
BEGIN P2:=TRUE;IF SPECTOG THE FLAG(13) END 13457000
@@ -10191,156 +10192,156 @@ ELSE 13465000
BEGIN P4:=TRUE; IF SPECTOG THEN FLAG(13) END 13467000
ELSE 13468000
TYPEV :=REALID+T1; 13469000
- IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO_NEXTINFO; 13470000
- ENTER(TYPEV); SAVEINFO2_NEXTINFO_NEXTINFO+1; 13471000
+ IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO~NEXTINFO; 13470000
+ ENTER(TYPEV); SAVEINFO2~NEXTINFO~NEXTINFO+1; 13471000
BETA1: 13472000
- IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ_0;SAVEDIM_1; 13473000
+ 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
+ T1~ELBAT[I].ADDRESS; I~I+1 13476000
END 13477000
- ELSE T1_0;IF SPECTOG THEN GO TO BETA2; 13478000
- APROGS_L; 13479000
+ ELSE T1~0;IF SPECTOG THEN GO TO BETA2; 13478000
+ APROGS~L; 13479000
IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000
BEGIN 13481000
- LLITOG_TRUE; 13482000
- IF T3_ELBAT[I].ADDRESS!0 13483000
+ 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
+ ADDCON~ADDC 13490000
END ELSE 13491000
- ADDCON_SUBC 13492000
+ ADDCON~SUBC 13492000
END; 13493000
- T2_T3x4+ADDCON 13494000
+ T2~T3|4+ADDCON 13494000
END 13495000
ELSE 13496000
BEGIN 13497000
- LLITOG_FALSE; 13498000
- IF T1!0 THEN I_I-1; 13499000
+ LLITOG~FALSE; 13498000
+ IF T1!0 THEN I~I-1; 13499000
T2:=GETSPACE(P2,-1);%TEMP. 13500000
AEXP;EMITSTORE(T2,ISN); 13501000
- T2_T2x4+SUBC+2; 13502000
+ T2~T2|4+SUBC+2; 13502000
IF ELCLASS!COLON THEN 13503000
- FLAG(017);I_I-1 13504000
+ FLAG(017);I~I-1 13504000
END; 13505000
- IF P2 THEN 13506000
- BEGIN 13507000
- IF LLITOG AND T3=0 THEN EMITL(0)13508000;
- ARPROGS_L;EMITO(DUP); 13509000
- END; 13510000
- IF ELCLASS_TABLE(I_I+2)=LITNO THEN 13511000
- BEGIN 13512000
- IF T_TABLE(I_I+1)=COMMA OR 13513000
- T_RTBRKET 13514000
- THEN 13515000
- BEGIN 13516000
- EMITL(T4_ELBAT[I-1].ADDRESS);13517000
- ULITOG_TRUE;GO TO CSZ 13518000
- END 13519000
- ELSE 13520000
- I_I-1 13521000
- END; 13522000
- ULITOG_FALSE; 13523000
- AEXP; 13524000
- EMITL(JUNK); 13525000
- EMITL(ISN); 13526000
- CSZ: IF LLITOG AND ULITOG THEN 13527000
- BEGIN 13528000
- L_ARPROGS; 13529000
- IF(T_IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000
- T4-T3+1)<=0 OR T>1023 THEN FLAG(5913531000);
- EMITL(T); 13531100
- IF P3 THEN BEGIN SAVEDIM_SAVEDIMxT; 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=) 13540000
- OR P2 13541000
- THEN 13542000
- BEGIN 13543000
- EMITO(XCH);EMITO(SUB) 13544000
- END;EMITL(1);EMITO(ADD) 13545000
- END; 13546000
- SLB:PUTNBUMP(T2);LBJ_LBJ+1;IF T_TABLE(I)=COMMA THEN GO TO TWO 13547000
- ELSE 13548000
- IF T!RTBRKET THEN FLAG(018); 13549000
- IF NOT SPECTOG THEN 13550000
- BEGIN 13551000
- COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400
- NOOFARRAYS:=NOOFARRAYS + GTA1[0]; 13551500
- EMITL(LBJ);EMITL(GTA1[0]); 13552000
- IF P3 AND P4 THEN FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 13552500
- EMITL(REAL(P3)+2xREAL(P2)+REAL(P4)x64); 13553000
- EMITV(5) 13554000
- END; 13555000
- PUT(LBJ,SAVEINFO2-1); 13556000
- DO BEGIN 13557000
- T_TAKE(SAVEINFO); 13558000
- K_T.INCR; 13559000
- T.INCR_SAVEINFO2-SAVEINFO-1; 13560000
- PUT(T,SAVEINFO); 13561000
- END 13562000
- UNTIL SAVEINFO_SAVEINFO+K=SAVEINFO2-1; 13563000
- IF STEPI!COMMA THEN GO TO START; 13564000
- IF NOT SPECTOG THEN EMITO(MKS); 13565000
- SAVEINFO_NEXTINFO; 13566000
- I_I+1;ENTRY(TYPEV);SAVEINFO2_NEXTINFO+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_T3x4+ADDCON; GO TO SLB; 13580000
- END; 13581000
- IF ELCLASS=FACTOP THEN 13582000
- BEGIN 13583000
- T2_-SUBC; GO TO SLB 13584000
- END 13585000
- END; 13586000
- FLAG(019); 13587000
- START: ARRAYFLAG _ FALSE END; 13588000
- PROCEDURE PUTNBUMP(X); 13589000
- VALUE X; 13590000
- REAL X; 13591000
- BEGIN 13592000
- INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]_X; 13593000
- NEXTINFO_NEXTINFO+1 13594000
- END ; 13595000
- PROCEDURE JUMPCHX; 13596000
- COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000
- WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000
- ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000
- IS THE FIRST EXECUTABLE CODE; 13600000
- IF NOT SPECTOG THEN 13601000
- BEGIN 13602000
- IF AJUMP 13603000
- THEN 13604000
- BEGIN ADJUST; 13605000
- EMITB(BFW,SAVEL,L) 13606000
- END ELSE 13607000
- IF FIRSTX=4095 13608000
- THEN 13609000
- BEGIN 13610000
- ADJUST; 13611000
- FIRSTX_L; 13612000
- END; 13613000
- AJUMP_FALSE 13614000
- END; 13615000
+ IF P2 THEN 13506000
+ BEGIN 13507000
+ IF LLITOG AND T3=0 THEN EMITL(0);13508000
+ ARPROGS~L;EMITO(DUP); 13509000
+ END; 13510000
+ IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000
+ BEGIN 13512000
+ IF T~TABLE(I~I+1)=COMMA OR 13513000
+ T~RTBRKET 13514000
+ THEN 13515000
+ BEGIN 13516000
+ EMITL(T4~ELBAT[I-1].ADDRESS);13517000
+ ULITOG~TRUE;GO TO CSZ 13518000
+ END 13519000
+ ELSE 13520000
+ I~I-1 13521000
+ END; 13522000
+ ULITOG~FALSE; 13523000
+ AEXP; 13524000
+ EMITL(JUNK); 13525000
+ EMITL(ISN); 13526000
+CSZ: IF LLITOG AND ULITOG THEN 13527000
+ BEGIN 13528000
+ L~ARPROGS; 13529000
+ IF(T~IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000
+ T4-T3+1){0 OR T>1023 THEN FLAG(59); 13531000
+ EMITL(T); 13531100
+ IF P3 THEN BEGIN SAVEDIM~SAVEDIM|T; 13532000
+ IF SAVEDIM>MAXSAVE 13533000
+ THEN MAXSAVE~SAVEDIM 13534000
+ END 13535000
+ ELSE 13536000
+ IF T>MAXROW THEN MAXROW~T; 13537000
+ END 13538000
+ ELSE 13539000
+ BEGIN IF NOT(LLITOG AND T3=) 13540000
+ OR P2 13541000
+ THEN 13542000
+ BEGIN 13543000
+ EMITO(XCH);EMITO(SUB) 13544000
+ END;EMITL(1);EMITO(ADD) 13545000
+ END; 13546000
+SLB:PUTNBUMP(T2);LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547000
+ ELSE 13548000
+ IF T!RTBRKET THEN FLAG(018); 13549000
+ IF NOT SPECTOG THEN 13550000
+ BEGIN 13551000
+COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400
+ NOOFARRAYS:=NOOFARRAYS + GTA1[0]; 13551500
+ EMITL(LBJ);EMITL(GTA1[0]); 13552000
+ IF P3 AND P4 THEN FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 13552500
+ EMITL(REAL(P3)+2|REAL(P2)+REAL(P4)|64); 13553000
+ EMITV(5) 13554000
+ END; 13555000
+ PUT(LBJ,SAVEINFO2-1); 13556000
+ DO BEGIN 13557000
+ T~TAKE(SAVEINFO); 13558000
+ K~T.INCR; 13559000
+ T.INCR~SAVEINFO2-SAVEINFO-1; 13560000
+ PUT(T,SAVEINFO); 13561000
+ END 13562000
+ UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000
+ IF STEPI!COMMA THEN GO TO START; 13564000
+ IF NOT SPECTOG THEN EMITO(MKS); 13565000
+ SAVEINFO~NEXTINFO; 13566000
+ I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO+1;GO TO BETA1; 13567000
+BETA2: 13568000
+ IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000
+ THEN 13570000
+ BEGIN 13571000
+ IF ELCLASS~TABLE(I-1)=LITNO 13572000
+ THEN 13573000
+ BEGIN 13574000
+ T3~ELBAT[I-1].ADDRESS; 13575000
+ IF T1= SUBOP THEN 13576000
+ ADDCON ~ADDC 13577000
+ ELSE 13578000
+ ADDCON ~SUBC; 13579000
+ T2~T3|4+ADDCON; GO TO SLB; 13580000
+ END; 13581000
+ IF ELCLASS=FACTOP THEN 13582000
+ BEGIN 13583000
+ T2~-SUBC; GO TO SLB 13584000
+ END 13585000
+ END; 13586000
+ FLAG(019); 13587000
+START: ARRAYFLAG ~ FALSE END; 13588000
+ PROCEDURE PUTNBUMP(X); 13589000
+ VALUE X; 13590000
+ REAL X; 13591000
+ BEGIN 13592000
+ INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000
+ NEXTINFO~NEXTINFO+1 13594000
+ END ; 13595000
+ PROCEDURE JUMPCHX; 13596000
+COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 13597000
+ WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 13598000
+ ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 13599000
+ IS THE FIRST EXECUTABLE CODE; 13600000
+IF NOT SPECTOG THEN 13601000
+BEGIN 13602000
+ IF AJUMP 13603000
+ THEN 13604000
+ BEGIN ADJUST; 13605000
+ EMITB(BFW,SAVEL,L) 13606000
+ END ELSE 13607000
+ IF FIRSTX=4095 13608000
+ THEN 13609000
+ BEGIN 13610000
+ ADJUST; 13611000
+ FIRSTX~L; 13612000
+ END; 13613000
+ AJUMP~FALSE 13614000
+END; 13615000
PROCEDURE JUMPCHKNX; 13616000
COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000
EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000
@@ -10353,8 +10354,8 @@ BEGIN 13622000
BEGIN 13625000
IF NOT AJUMP 13626000
THEN 13627000
- SAVEL_BUMPL; 13628000
- AJUMP_TRUE 13629000
+ SAVEL~BUMPL; 13628000
+ AJUMP~TRUE 13629000
END;ADJUST 13630000
END; 13631000
PROCEDURE SEGMENTSTART; 13632000
@@ -10363,31 +10364,31 @@ PROCEDURE SEGMENTSTART; 13632000
IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100
ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200
END SEGMENTSTART; 13633300
-PROCEDURE SEGMENT(SIZE,NO,NOO); %11363400006-
- VALUE SIZE,NO,NOO; %11363500006-
- REAL SIZE,NO,NOO; %11363600006-
- BEGIN %11363700006-
- INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT %11363710006-
- % IS NOT TOO BIG %11363720006-
- PDPRT[PDINX.[37:5],PDINX.[42:6]] := %11363800006-
- SIZE & NO[28:38:10] & %11363900006-
- MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & %11364000006-
- REAL(SAVEPRTOG)[3:47:1]; %11364100006-
- PDINX:=PDINX+1; SIZE:=ABS(SIZE); %11364200006-
- IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; %11364300006-
- AKKUM:=AKKUM+SIZE; %11364400006-
- IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16x(SIZE.[38:6]+1); %11364500006-
- IF LISTER OR SEGSTOG THEN %11364600006-
- BEGIN %11364700006-
- IF NOHEADING THEN DATIME; %11364800006-
- IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) %11364900006-
- ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); %11365000006-
- END; %11365100006-
- LDICT[NO.[38:3],NO.[41:7]] := %11365200006-
- IF BUILDLINE THEN %11365300006-
- MOVENADBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] %11365400006-
- ELSE -1; %11365500006-
- END OF SEGMENT; %11365600006-
+PROCEDURE SEGMENT(SIZE,NO,NOO); %106-13634000
+ VALUE SIZE,NO,NOO; %106-13635000
+ REAL SIZE,NO,NOO; %106-13636000
+ BEGIN %106-13637000
+ INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT %106-13637100
+ % IS NOT TOO BIG %106-13637200
+ PDPRT[PDINX.[37:5],PDINX.[42:6]] := %106-13638000
+ SIZE & NO[28:38:10] & %106-13639000
+ MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & %106-13640000
+ REAL(SAVEPRTOG)[3:47:1]; %106-13641000
+ PDINX:=PDINX+1; SIZE:=ABS(SIZE); %106-13642000
+ IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; %106-13643000
+ AKKUM:=AKKUM+SIZE; %106-13644000
+ IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16|(SIZE.[38:6]+1); %106-13645000
+ IF LISTER OR SEGSTOG THEN %106-13646000
+ BEGIN %106-13647000
+ IF NOHEADING THEN DATIME; %106-13648000
+ IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) %106-13649000
+ ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); %106-13650000
+ END; %106-13651000
+ LDICT[NO.[38:3],NO.[41:7]] := %106-13652000
+ IF BUILDLINE THEN %106-13653000
+ MOVENADBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] %106-13654000
+ ELSE -1; %106-13655000
+ END OF SEGMENT; %106-13656000
13697000
13698000
13699000
@@ -10429,138 +10430,138 @@ PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000
BEGIN 13735000
BOOLEAN BT; 13736000
REAL K,LS; 13737000
- LS_RELAD; 13738000
- BT_JUMPCTR=LEVEL; 13739000
- IF FUNCTOG 13740000
- THEN 13741000
- BEGIN 13742000
- EMITV(514); 13743000
- EMITO(RTN) 13744000
- END 13745000
- ELSE 13746000
- EMITO(XIT); 13747000
- IF STACKCTR>MAXSTACK THEN MAXSTACK_STACKCTR; 13748000
- CONSTANTCLEAN; 13749000
- IF K_MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1]13750000
- THEN 13751000
- BEGIN ADJUST;LS_L; 13752000
- IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000
- THEN 13754000
- BEGIN 13755000
+ LS~RELAD; 13738000
+ BT~JUMPCTR=LEVEL; 13739000
+ IF FUNCTOG 13740000
+ THEN 13741000
+ BEGIN 13742000
+ EMITV(514); 13743000
+ EMITO(RTN) 13744000
+ END 13745000
+ ELSE 13746000
+ EMITO(XIT); 13747000
+ IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000
+ CONSTANTCLEAN; 13749000
+ IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000
+ THEN 13751000
+ BEGIN ADJUST;LS~L; 13752000
+ IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000
+ THEN 13754000
+ BEGIN 13755000
% 13755500
- EMITV(BLOCKCTR); 13756000
- EMITL(1); 13757000
- EMITO(ADD); 13758000
- IF GOTSTORAGE OR FAULTOG.[46:1] 13759000
- THEN 13760000
- EMITSTORE(BLOCKCTR,SND) 13761000
- END 13762000
+ 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
+ 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(2xREAL(BUILDLINE)) ; 13777700
- TB2_GTA1[J-1]=SWITCHV; 13778000
- GT5_SGNO; 13779000
- L: GT1:=(2xSGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000
- IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002
- SGNO_SGAVL; 13781000
+ EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000
+ CONSTANTCLEAN 13770000
+ END ELSE PURGE(STOPPER); 13771000
+ Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000
+ END HTTEOAP; 13773000
+PROCEDURE FORMATGEN; 13774000
+ BEGIN 13775000
+ INTEGER PRT;LABEL L; 13776000
+ BOOLEAN TB2; 13777000
+ ARRAY TEDOC[0:7,0:127]; 13777500
+ MOVECODE(TEDOC,EDOC); 13777600
+ BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700
+ TB2~GTA1[J-1]=SWITCHV; 13778000
+ GT5~SGNO; 13779000
+L: GT1:=(2|SGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000
+ IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002
+ SGNO~SGAVL; 13781000
13782000
- F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000
- Z_PROGDESCBLDR(LDES,0,PRT); 13784000
- IF TB2 THEN 13785000
- BEGIN 13786000
- ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(37); 13787000
- PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000
- RR4_NEXTINFO;PUTNBUMP(0); 13789000
- DO 13790000
- BEGIN PUTNBUMP(F); IF STEPI=LEFTPAREN THEN FLAG(37); 13791000
- ELCLASS:="<"; 13791050
- TB1_FORMATPHRASE; 13792000
- END 13793000
- UNTIL ELCLASS!","; 13794000
- RR3_NEXTINFO-1;NEXTINFO_RR4;PUTNBUMP(F); 13795000
- DO 13796000
- WHIPOUT(TAKE(RR4_RR4+1)) 13797000
- UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000
+ 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(37); 13787000
+ PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000
+ RR4~NEXTINFO;PUTNBUMP(0); 13789000
+ DO 13790000
+ BEGIN PUTNBUMP(F); IF STEPI=LEFTPAREN THEN FLAG(37); 13791000
+ ELCLASS:="<"; 13791050
+ TB1~FORMATPHRASE; 13792000
+ END 13793000
+ UNTIL ELCLASS!","; 13794000
+ RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000
+ DO 13796000
+ WHIPOUT(TAKE(RR4~RR4+1)) 13797000
+ UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000
13799000
- END ELSE 13800000
- BEGIN 13801000
- I_I-1; 13802000
- DO 13803000
- BEGIN 13804000
- STOPDEFINE_TRUE;STEPIT ; 13805000
- ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="13806000<";
- PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000
- TB1_FORMATPHRASE; 13808000
- END 13809000
- UNTIL ELCLASS!"," OR TB1_F>=256 ; 13810000
+ END ELSE 13800000
+ BEGIN 13801000
+ I~I-1; 13802000
+ DO 13803000
+ BEGIN 13804000
+ STOPDEFINE~TRUE;STEPIT ; 13805000
+ ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="<";13806000
+ PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000
+ TB1~FORMATPHRASE; 13808000
+ END 13809000
+ UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000
13811000
13812000
- END; 13813000
- SEGMENT(-F,SGNO,GT5);SGAVL_SGAVL+1; 13814000
- IF TB1 AND ELCLASS="," THEN BEGIN I_I+1;GO TO L END; 13815000
- IF ELCLASS!";" THEN ELBAT[I]_0 ELSE ELBAT[I].CLASS_SEMICOLON; 13816000
- STOPGSP_STOPENTRY_FALSE; 13817000
- SGNO_GT5; 13818000
- MOVECODE(TEDOC,EDOC); 13818500
- BUILDLINE _ BUILDLINE.[46:1] ; 13818600
- END FORMATGEN; 13819000
- PROCEDURE CHECKBOUNDLVL ; 13819100
- COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200
- DECLARED AT SAME LEVEL; 13819300
- IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400
- THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410
- COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500
- ARARY DECLARATION; 13819600
- PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR
- THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK O13901000R
- 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="5IND13909000EX"
- )[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1]13910000)=0
- 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 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=BOOARRAYID 14095000
- THEN 14096000
- BEGIN 14097000
- T1_G.INCR; 14098000
- GT1 _N_TAKE(BUP+T1); 14099000
- G.ADDRESS_F_F+N+1; 14100000
- WHILE N!0 14101000
- DO 14102000
- BEGIN 14103000
- IF T2_TAKE(BUP+T1+N)<0 14104000
- THEN 14105000
- BEGIN 14106000
- T2_-T2; 14107000
- T2.LBP_4x(F-N)+2; 14108000
- PUT(T2,BUP+T1+N) 14109000
- END; 14110000
- N_N-1 14111000
- END 14112000
- END 14113000
- ELSE 14114000
- G.ADDRESS_F_F+1; 14115000
- PUT(G,BUP); G.INCR_GT1; 14116000
- IF FWDTOG THEN COMMENT CHECK CORRESPONDENCE W/ FWD; 14116100
- BEGIN 14116200
- IF(GT1_TAKE(MARK+PJ)).CLASS ! G.CLASS 14116300
- COMMENT CLASS ERROR; THEN FLAG(49); 14116400
- COMMENT VALUE ERROR; IF GT1.VO ! G.VO THEN FLAG(50) 14116500
- END ELSE 14116600
- PUT(G,MARK+PJ) 14117000
- ;BUP_BUP-TAKE(BUP+1).PURPT 14118000
- END 14119000
- UNTIL PJ_PJ-1=0 14120000
- END; 14121000
- SPECTOG_FALSE; 14122000
- GO TO HF 14123000
- END 14124000
- END; 14125000
- STACKCT _ 0; %14125500A
- WHILE STEPI=DECLARATORS 14126000
- DO 14127000
- BEGIN 14128000
- STOPDEFINE_(GTA1[J_J+1]_ELBAT[I].ADDRESS)!MONITORV AND 14129000
- GTA1[J]!DUMPV;ERRORTOG_TRUE; 14130000
- END; 14131000
- IF J =0 THEN GO TO CALLSTATEMENT; 14132000
- P2:=P3:=P4:=FALSE; 14133000
- GO TO DECLSW[GTA1[J]]; 14134000
- OWNERR:FLAG(20);J_J+1;GO TO REALDEC; 14135000
- SAVERR:FLAG(21);J_J+1;GO TO REALDEC; 14136000
- AUXMEMERR:FLAG(618);J:=J+1;GO TO REALDEC; %11141361007-
- STREAMERR:FLAG(22);J_J+1;GO TO PROCEDUREDEC; 14137000
- REALDEC:P3_TRUE;ENTER(REALID);GO TO START; 14138000
- ALPHADEC:P3_TRUE;ENTER(ALFAID);GO TO START; 14139000
- BOOLEANDEC:P3_TRUE;ENTER(BOOID);GO TO START; 14140000
- INTEGERDEC:P3_TRUE;ENTER(INTID);GO TO START; 14141000
- MONITORDEC:IF SPECTOG 14142000
- THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR 14143000
- DECLARATION APPEARS IN THE SPECIFICATION 14144000
- PART OF A PROCEDURE; 14145000
- FLAG(463); 14146000
- END; 14147000
- IF MERRIMAC THEN BEGIN FAULTDEC; GO GOTSCHK END; GO STAR14148000T;
- DUMPDEC:IF SPECTOG 14149000
- THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION 14150000
- APPEARS IN THE SPECIFICATION PART OF A 14151000
- PROCEDURE; 14152000
- FLAG(464); 14153000
- END; 14154000
- DMUP; GO TO START; 14155000
- ARRAYDEC:JUMPCHKX;ARRAE;GO TO GOTSCHK; 14156000
- FILEDEC:J_J+1;IODEC(11);GO TO GOTSCHK; 14157000
- INDEC: IODEC(9); IF G!FORMATV THEN GO GOTSCHK; GO START;% 14158000
- OUTDEC: IODEC(10); IF G=FORMATV THEN GO TO START; 14159000
- GOTSCHK:GOTSTORAGE_ NOT SPECTOG OR GOTSTORAGE;GO TO START; 14160000
- FORMATDEC:IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV)) ELSE 14161000
- FORMATGEN; GO TO START; 14162000
- LISTDEC: 14163000
- BEGIN 14164000
- REAL SAVEINFO; 14165000
- LABEL START; 14166000
- IF G:=GTA1[J]=LISTV AND G:=GTA1[J-1]=SWITCHV THEN 14167000
- BEGIN HANDLESWLIST; GO TO GOTSCHK END; 14168000
- IF SPECTOG THEN 14169000
- BEGIN ENTRY(LISTID); GO TO START END; 14170000
- STOPENTRY:=STOPGSP:=TRUE; I:=I-1; 14171000
- DO BEGIN 14172000
- I:=I+1; JUMPCHKX; 14173000
- ENTRY(LISTID); IF ELCLASS!LEFTPAREN THEN FLAG(31) ELSE STEPIT14174000;
- SAVEINFO:=LASTINFO; % IN CASE C-RELATIVE CONSTANTS ARE 14175000
- % EMITTED B4 DOING THE PUT-TAKE BELOW. 14176000
- F:=LISTGEN; 14177000
- PUT(TAKE(SAVEINFO)&(IF MODE=0 THEN F 14178000
- ELSE F:=GETSPACE(FALSE,SAVEINFO+1)) % LIST DESCR. 14179000
- [16:11],SAVEINFO); 14180000
- EMITSTORE(F,STD); 14181000
- END UNTIL ELCLASS! COMMA; 14182000
- STOPENTRY:=STOPGSP:=FALSE; 14183000
- START: 14184000
- END LISTDEC; 14185000
- GO TO START; 14186000
- LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24); 14187000
- STOPENTRY_STOPGSP_TRUE; 14188000
- I_I-1; 14189000
- DO 14190000
- BEGIN 14191000
- STOPDEFINE_TRUE; 14192000
- STEPIT; 14193000
- ENTRY(LABELID); 14194000
- PUTNBUMP(0) 14195000
- END 14196000
- UNTIL ELCLASS!COMMA; 14197000
- STOPENTRY_STOPGSP_FALSE; 14198000
- GO TO START; 14199000
- SWITCHDEC: 14200000
- BEGIN 14201000
- LABEL START; 14202000
- INTEGER GT1,GT2,GT4,GT5; 14203000
- BOOLEAN TB1; 14204000
- STOPENTRY_NOT SPECTOG;STOPGSP_TRUE; 14205000
- SCATTERELBAT; GT1_0; TB1_FALSE; 14206000
- IF LEVELF=LEVEL 14207000
- THEN 14208000
- BEGIN 14209000
- IF TAKE(LINKF+1)>=0 14210000
- THEN FLAG(1); PUT(-TAKE(LINKF+1),LINKF+1); 14211000
- TB1_TRUE;GT2_ADDRSF; 14212000
- GT1_ TAKEFRST; GT4_LASTINFO; LASTINFO_LINKF; 14213000
- STEPIT;GT5_NEXTINFO;NEXTINFO_LINKF+INCRF 14214000
- END 14215000
- ELSE 14216000
- ENTRY(SWITCHID); STOPGSP_STOPENTRY_FALSE;IF SPECTOG THEN GO TO 14217000
- START: 14218000
- IF ELCLASS=ASSIGNOP 14219000
- THEN 14220000
- BEGIN 14221000
- JUMPCHKNX;PUTNBUMP(L);G_L; 14222000
- IF FORMALF := SWITCHGEN(TB1,GT1) %11314223000-
- THEN 14224000
- BEGIN 14225000
- JUMPCHKX; 14227000
- STUFFF(GT1); 14228000
- IF MODE>0 14229000
- THEN 14230000
- IF TB1 THEN GT1_GT2 ELSE 14231000
- GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000
- EMITSTORE(GT1,STD) 14233000
- END; 14234000
- END 14235000
- ELSE 14236000
- BEGIN 14237000
- IF ELCLASS!FORWARDV THEN FLAG(33); 14238000
- PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000
- PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000
- IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR.14241000
- STEPIT; 14242000
- FORMALF_TRUE 14243000
- END; 14244000
- PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]>1[16:37:11],LASTINFO); 14245000
- IF TB1 THEN 14246000
- BEGIN 14247000
- NEXTINFO_GT5; 14248000
- LASTINFO_GT4; 14249000
- END; 14250000
- START: 14251000
- END SWITCHDEC; 14252000
- GO TO START; 14253000
- DEFINEDEC: 14254000
- BEGIN LABEL START; 14254050
- REAL J,K,DINFO,LINKA,LINKB; %11814254100-
- STOPENTRY_STOPGSP_TRUE;I_I-1; 14255000
- DEFINING := BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 14255500
- DO 14256000
- BEGIN 14257000
- STOPDEFINE:=TRUE; 14258000
- STEPIT; MOVE(9,ACCUM[1],GTA1); 14259000
- K_COUNT+1; J_GTA1[0]; ENTRY(DEFINEDID); 14259010
- GTA1[0]_J+"100000"; J_0; 14259015
- DINFO _ LASTINFO; 14259017
- IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020
- BEGIN 14259030
- IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040
- DO BEGIN STOPDEFINE_TRUE; 14259060
- STEPIT; 14259070
- IF (J_J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075
- MOVE(9, ACCUM[1], DEFINFO[(J-1)x10]); 14259080
- DEFINEPARAM(DINFO+1, J); 14259085
- ACCUM[0] := 0 & DEFINEDID CLASS & 1 FORMAL; %11614259090-
- LINKA _ LASTINFO; LINKB _ NEXTINFO; 14259094
- E; 14259096
- IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098
- PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100
- STACKHEAD[SCRAM] _ TAKE(LASTINFO).LINK; 14259102
- STOPDEFINE _ TRUE; 14259104
- END UNTIL STEPI!COMMA; 14259110
- IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120
- STOPDEFINE_TRUE; 14259130
- STEPIT; 14259140
- PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150
- PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155
- END; 14259160
- IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000
- THEN 14261000
- BEGIN 14262000
- FLAG(45); 14263000
- COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100
- I_I-1; 14264000
- END; 14265000
- MACROID_TRUE; 14265900
- LASTINFO _ DINFO; 14265930
- PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950
- DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000
- MACROID_FALSE; 14266100
- END 14267000
- UNTIL STEPI!COMMA; 14268000
- DEFINING := BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 14268500
- START: STOPENTRY_STOPGSP_FALSE; END; GO TO START; 14269000
- FIELDDEC: %11142690207-
- BEGIN %11142690407-
- REAL SAVEINFO, SB, NB; %11142690607-
- BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC.%11142690807-
- LABEL EXIT, SAVEIT; %11142691007-
- STOPENTRY := STOPGSP := TRUE; %11142691207-
- I := I - 1; %11142691407-
- DO %11142691607-
- BEGIN %11142691807-
- STOPDEFINE := TRUE; %11142692007-
- STEPIT; %11142692207-
- ENTRY(FIELDID); %11142692407-
- SAVEINFO := LASTINFO; %11142692607-
- IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN %11142692807-
- BEGIN %11142693007-
- IF STEPI = LFTBRKET THEN % REMEMBER THIS %11142693207-
- BEGIN %11142693407-
- FOUNDLB := TRUE; %11142693607-
- STEPIT; %11142693807-
- END %11142694007-
- ELSE %11142694207-
- FOUNDLB := FALSE; %11142694407-
- IF ELCLASS = FIELDID THEN %11142694427-
- BEGIN %11142694447-
- SB := ELBAT[I].SBITF; %11142694467-
- NB := ELBAT[I].NBITF; %11142694487-
- GO TO SAVEIT; %11142694507-
- END; %11142694527-
- IF ELCLASS = LITNO THEN %11142694607-
- IF STEPI = COLON THEN %11142694807-
- IF STEPI = LITNO THEN %11142695007-
- IF (SB := ELBAT[I-2].ADDRESS) x %11142695207-
- (NB := ELBAT[I].ADDRESS) ! 0 AND %11142695407-
- SB + NB<= 48 THEN %11142695607-
- BEGIN %11142695807-
- SAVEIT: %11142695907-
- PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, %11142696007-
- SAVEINFO); %11142696207-
- STEPIT; %11142696407-
- IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. %11142696607-
- IF ELCLASS = RTBRKET THEN %11142696807-
- BEGIN %11142697007-
- STEPIT; %11142697057-
- GO TO EXIT; %11142697107-
- END %11142697157-
- ELSE %11142697207-
- ELSE %11142697407-
- GO TO EXIT; %11142697607-
- END; %11142697807-
- END; %11142698007-
- FLAG(114); %11142698207-
- DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; %11142698407-
- EXIT: %11142698607-
- END %11142698807-
- UNTIL %11142699007-
- ELCLASS ! COMMA; %11142699207-
- STOPENTRY := STOPGSP := FALSE; %11142699407-
- END; %11142699607-
- GO TO START; %11142699807-
+ ELSE BEGIN BLKAD:=GETSPACE(TRUE,-6); % SEG. DESCR. 14044000
+ EMITV(BLKAD); 14045000
+ EMITO(BFW); 14046000
+ CONSTANTCLEAN 14047000
+ END; 14048000
+ MOVECODE(TEDOC,EDOC); MOVECODE(TENIL,ENIL); 14049000
+ OLDLASTADDRESS ~ LASTADDRESS; LASTADDRESS ~ -1; 14049100
+ OLDENILPTR ~ ENILPTR; ENILPTR ~ 0; 14049200
+ENILSPOT~0&CARDNUMBER[10:20:28] ; ENILPTR~1 ; 14049300
+ MOVE(NLOCS,LOCBEGIN,LOCALS); 14050000
+ FIRSTXO~FIRSTX; 14051000
+ FIRSTX~4095; 14052000
+ IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14053000
+ ELSE FLAG(039); 14053100
+ LOLD~L;FUNCTOGO~FUNCTOG;AJUMPO~AJUMP;PRTIO~PRTI;SGNOO~SGNO; 14054000
+ SAVELO := SAVEL; %118-14055000
+ AJUMP := FALSE; % NO PENDING JUMPS IN THIS BLOCK YET. %118-14055100
+ L := 0; % START GENERATING CODE AT WORD 0, SYLLABLE 0. 14055200
+ OLDNINFOO := GLOBALNINFOO; % REMEMBER WHERE PREVIOUS BLOCKS %118-14055250
+ % SYMBOLS BEGAN IN SYMBOL TABLE. %118-14055260
+ GLOBALNINFOO := NINFOO := NEXTINFO; % REMEMBER WHERE THE SYMBOLS 14055300
+ % FROM THIS BLOCK WILL GO%118-14055400
+ % IN THE SYMBOL TABLE. %118-14055450
+ NTEXTO ~ NEXTTEXT; 14055500
+ NCIIO~NCII; 14056000
+ NCII~0; 14057000
+ STACKCTRO~STACKCTR; 14058000
+ FAULTOGO~FAULTOG; FAULTOG~ 14058100
+GOTSTORAGE~FALSE; 14059000
+ SAVEPRTOG := (SAVEPRTOGO := SAVEPRTOG) OR SOP.[46:1]; 14059100
+ IF LISTER OR SEGSTOG THEN SEGMENTSTART; 14060000
+ SGNO~SGAVL; SGAVL~SGAVL+1; 14061000
+ ELBAT[I].CLASS~SEMICOLON; 14062000
+START: IF TABLE(I)!SEMICOLON 14063000
+ THEN 14064000
+ BEGIN 14065000
+ FLAG(0); 14066000
+ I~I-1 14067000
+ END; 14068000
+ GTA1[0]~J~0; 14069000
+ IF SPECTOG 14070000
+ THEN 14071000
+ BEGIN 14072000
+ IF BUP=PJ 14073000
+ THEN 14074000
+ BEGIN 14075000
+ BEGIN LABEL GETLP; 14076000
+ IF STREAMTOG THEN F~0 ELSE 14077000
+ F~FZERO; 14078000
+ BUP~LASTINFO; 14079000
+ DO 14080000
+ BEGIN 14081000
+ IF NOT STREAMTOG THEN 14082000
+ BUP~LASTINFO; 14083000
+ GETLP: G~TAKE(BUP); 14084000
+ IF K~G.ADDRESS!PJ 14085000
+ THEN 14086000
+ BEGIN 14087000
+ IF BUP ! BUP:=BUP- TAKE(BUP + 1).PURPT THEN %102-14088000
+ GO TO GETLP 14089000
+ END; 14090000
+ IF TYPEV~G.CLASS=FRMTID OR TYPEV=SERUPFRMTID THEN 14091000
+ G.ADDRESS~F~F+2 14092000
+ ELSE 14093000
+ IF TYPEV~G.CLASS{INTARRAYID AND 14094000
+ TYPEV}BOOARRAYID 14095000
+ THEN 14096000
+ BEGIN 14097000
+ T1~G.INCR; 14098000
+ GT1 ~N~TAKE(BUP+T1); 14099000
+ G.ADDRESS~F~F+N+1; 14100000
+ WHILE N!0 14101000
+ DO 14102000
+ BEGIN 14103000
+ IF T2~TAKE(BUP+T1+N)<0 14104000
+ THEN 14105000
+ BEGIN 14106000
+ T2~-T2; 14107000
+ T2.LBP~4|(F-N)+2; 14108000
+ PUT(T2,BUP+T1+N) 14109000
+ END; 14110000
+ N~N-1 14111000
+ END 14112000
+ END 14113000
+ ELSE 14114000
+ G.ADDRESS~F~F+1; 14115000
+ PUT(G,BUP); G.INCR~GT1; 14116000
+ IF FWDTOG THEN COMMENT CHECK CORRESPONDENCE W/ FWD; 14116100
+ BEGIN 14116200
+ IF(GT1~TAKE(MARK+PJ)).CLASS ! G.CLASS 14116300
+ COMMENT CLASS ERROR; THEN FLAG(49); 14116400
+ COMMENT VALUE ERROR; IF GT1.VO ! G.VO THEN FLAG(50) 14116500
+ END ELSE 14116600
+ PUT(G,MARK+PJ) 14117000
+ ;BUP~BUP-TAKE(BUP+1).PURPT 14118000
+ END 14119000
+ UNTIL PJ~PJ-1=0 14120000
+ END; 14121000
+ SPECTOG~FALSE; 14122000
+ GO TO HF 14123000
+ END 14124000
+ END; 14125000
+ STACKCT ~ 0; %A 14125500
+ WHILE STEPI=DECLARATORS 14126000
+ DO 14127000
+ BEGIN 14128000
+ STOPDEFINE~(GTA1[J~J+1]~ELBAT[I].ADDRESS)!MONITORV AND 14129000
+ GTA1[J]!DUMPV;ERRORTOG~TRUE; 14130000
+ END; 14131000
+IF J =0 THEN GO TO CALLSTATEMENT; 14132000
+ P2:=P3:=P4:=FALSE; 14133000
+ GO TO DECLSW[GTA1[J]]; 14134000
+OWNERR:FLAG(20);J~J+1;GO TO REALDEC; 14135000
+SAVERR:FLAG(21);J~J+1;GO TO REALDEC; 14136000
+AUXMEMERR:FLAG(618);J:=J+1;GO TO REALDEC; %117-14136100
+STREAMERR:FLAG(22);J~J+1;GO TO PROCEDUREDEC; 14137000
+REALDEC:P3~TRUE;ENTER(REALID);GO TO START; 14138000
+ALPHADEC:P3~TRUE;ENTER(ALFAID);GO TO START; 14139000
+BOOLEANDEC:P3~TRUE;ENTER(BOOID);GO TO START; 14140000
+INTEGERDEC:P3~TRUE;ENTER(INTID);GO TO START; 14141000
+ MONITORDEC:IF SPECTOG 14142000
+ THEN BEGIN COMMENT ERROR 463 MEANS THAT A MONITOR 14143000
+ DECLARATION APPEARS IN THE SPECIFICATION 14144000
+ PART OF A PROCEDURE; 14145000
+ FLAG(463); 14146000
+ END; 14147000
+ IF MERRIMAC THEN BEGIN FAULTDEC; GO GOTSCHK END; GO START;14148000
+ DUMPDEC:IF SPECTOG 14149000
+ THEN BEGIN COMMENT ERROR 464 MEANS A DUMP DECLARATION 14150000
+ APPEARS IN THE SPECIFICATION PART OF A 14151000
+ PROCEDURE; 14152000
+ FLAG(464); 14153000
+ END; 14154000
+ DMUP; GO TO START; 14155000
+ARRAYDEC:JUMPCHKX;ARRAE;GO TO GOTSCHK; 14156000
+FILEDEC:J~J+1;IODEC(11);GO TO GOTSCHK; 14157000
+ INDEC: IODEC(9); IF G!FORMATV THEN GO GOTSCHK; GO START;% 14158000
+OUTDEC: IODEC(10); IF G=FORMATV THEN GO TO START; 14159000
+GOTSCHK:GOTSTORAGE~ NOT SPECTOG OR GOTSTORAGE;GO TO START; 14160000
+FORMATDEC:IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV)) ELSE 14161000
+ FORMATGEN; GO TO START; 14162000
+LISTDEC: 14163000
+ BEGIN 14164000
+ REAL SAVEINFO; 14165000
+ LABEL START; 14166000
+ IF G:=GTA1[J]=LISTV AND G:=GTA1[J-1]=SWITCHV THEN 14167000
+ BEGIN HANDLESWLIST; GO TO GOTSCHK END; 14168000
+ IF SPECTOG THEN 14169000
+ BEGIN ENTRY(LISTID); GO TO START END; 14170000
+ STOPENTRY:=STOPGSP:=TRUE; I:=I-1; 14171000
+ DO BEGIN 14172000
+ I:=I+1; JUMPCHKX; 14173000
+ ENTRY(LISTID); IF ELCLASS!LEFTPAREN THEN FLAG(31) ELSE STEPIT; 14174000
+ SAVEINFO:=LASTINFO; % IN CASE C-RELATIVE CONSTANTS ARE 14175000
+ % EMITTED B4 DOING THE PUT-TAKE BELOW. 14176000
+ F:=LISTGEN; 14177000
+ PUT(TAKE(SAVEINFO)&(IF MODE=0 THEN F 14178000
+ ELSE F:=GETSPACE(FALSE,SAVEINFO+1)) % LIST DESCR. 14179000
+ [16:11],SAVEINFO); 14180000
+ EMITSTORE(F,STD); 14181000
+ END UNTIL ELCLASS! COMMA; 14182000
+ STOPENTRY:=STOPGSP:=FALSE; 14183000
+START: 14184000
+ END LISTDEC; 14185000
+GO TO START; 14186000
+LABELDEC:IF SPECTOG AND FUNCTOG THEN FLAG(24); 14187000
+ STOPENTRY~STOPGSP~TRUE; 14188000
+ I~I-1; 14189000
+ DO 14190000
+ BEGIN 14191000
+ STOPDEFINE~TRUE; 14192000
+ STEPIT; 14193000
+ ENTRY(LABELID); 14194000
+ PUTNBUMP(0) 14195000
+ END 14196000
+ UNTIL ELCLASS!COMMA; 14197000
+ STOPENTRY~STOPGSP~FALSE; 14198000
+ GO TO START; 14199000
+SWITCHDEC: 14200000
+ BEGIN 14201000
+ LABEL START; 14202000
+ INTEGER GT1,GT2,GT4,GT5; 14203000
+ BOOLEAN TB1; 14204000
+ STOPENTRY~NOT SPECTOG;STOPGSP~TRUE; 14205000
+ SCATTERELBAT; GT1~0; TB1~FALSE; 14206000
+ IF LEVELF=LEVEL 14207000
+ THEN 14208000
+ BEGIN 14209000
+ IF TAKE(LINKF+1)}0 14210000
+ THEN FLAG(1); PUT(-TAKE(LINKF+1),LINKF+1); 14211000
+ TB1~TRUE;GT2~ADDRSF; 14212000
+ GT1~ TAKEFRST; GT4~LASTINFO; LASTINFO~LINKF; 14213000
+ STEPIT;GT5~NEXTINFO;NEXTINFO~LINKF+INCRF 14214000
+ END 14215000
+ ELSE 14216000
+ ENTRY(SWITCHID); STOPGSP~STOPENTRY~FALSE;IF SPECTOG THEN GO TO 14217000
+ START: 14218000
+ IF ELCLASS=ASSIGNOP 14219000
+ THEN 14220000
+ BEGIN 14221000
+ JUMPCHKNX;PUTNBUMP(L);G~L; 14222000
+ IF FORMALF := SWITCHGEN(TB1,GT1) %113-14223000
+ THEN 14224000
+ BEGIN 14225000
+ JUMPCHKX; 14227000
+ STUFFF(GT1); 14228000
+ IF MODE>0 14229000
+ THEN 14230000
+ IF TB1 THEN GT1~GT2 ELSE 14231000
+ GT1:=GETSPACE(FALSE,LASTINFO+1); % SWITCH. 14232000
+ EMITSTORE(GT1,STD) 14233000
+ END; 14234000
+ END 14235000
+ ELSE 14236000
+ BEGIN 14237000
+ IF ELCLASS!FORWARDV THEN FLAG(33); 14238000
+ PUT(-TAKE(LASTINFO+1),LASTINFO+1); 14239000
+ PUTNBUMP(GT1:=GETSPACE(TRUE,LASTINFO+1));%SWITCH. 14240000
+ IF MODE >0 THEN GT1:=GETSPACE(FALSE,-1);%TEMP. STOR. 14241000
+ STEPIT; 14242000
+ FORMALF~TRUE 14243000
+ END; 14244000
+ PUT(TAKE(LASTINFO)&REAL(FORMALF)[9:47:1]>1[16:37:11],LASTINFO); 14245000
+ IF TB1 THEN 14246000
+ BEGIN 14247000
+ NEXTINFO~GT5; 14248000
+ LASTINFO~GT4; 14249000
+ END; 14250000
+ START: 14251000
+ END SWITCHDEC; 14252000
+GO TO START; 14253000
+ DEFINEDEC: 14254000
+ BEGIN LABEL START; 14254050
+ REAL J,K,DINFO,LINKA,LINKB; %118 14254100-
+ STOPENTRY~STOPGSP~TRUE;I~I-1; 14255000
+ DEFINING := BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 14255500
+ DO 14256000
+ BEGIN 14257000
+ STOPDEFINE:=TRUE; 14258000
+ STEPIT; MOVE(9,ACCUM[1],GTA1); 14259000
+ K~COUNT+1; J~GTA1[0]; ENTRY(DEFINEDID); 14259010
+ GTA1[0]~J+"100000"; J~0; 14259015
+ DINFO ~ LASTINFO; 14259017
+ IF ELCLASS=LEFTPAREN OR ELCLASS=LFTBRKET THEN 14259020
+ BEGIN 14259030
+ IF K > 62 THEN BEGIN ERR(141); GO START END; 14259040
+ DO BEGIN STOPDEFINE~TRUE; 14259060
+ STEPIT; 14259070
+ IF (J~J+1) > 9 THEN BEGIN ERR(172); GO START END; 14259075
+ MOVE(9, ACCUM[1], DEFINFO[(J-1)|10]); 14259080
+ DEFINEPARAM(DINFO+1, J); 14259085
+ ACCUM[0] := 0 & DEFINEDID CLASS & 1 FORMAL; %116-14259090
+ LINKA ~ LASTINFO; LINKB ~ NEXTINFO; 14259094
+ E; 14259096
+ IF LASTINFO ! LINKB THEN % NEW INFO ROW ENTERED. 14259098
+ PUT(TAKE(LINKA)&(LASTINFO-LINKA)[27:40:8], LINKA); 14259100
+ STACKHEAD[SCRAM] ~ TAKE(LASTINFO).LINK; 14259102
+ STOPDEFINE ~ TRUE; 14259104
+ END UNTIL STEPI!COMMA; 14259110
+ IF ELCLASS!RTPAREN AND ELCLASS!RTBRKET THEN ERR(173); 14259120
+ STOPDEFINE~TRUE; 14259130
+ STEPIT; 14259140
+ PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 14259150
+ PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 14259155
+ END; 14259160
+ IF ELCLASS!RELOP OR ACCUM[1]!"1=0000" 14260000
+ THEN 14261000
+ BEGIN 14262000
+ FLAG(45); 14263000
+ COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 14263100
+ I~I-1; 14264000
+ END; 14265000
+ MACROID~TRUE; 14265900
+ LASTINFO ~ DINFO; 14265930
+ PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 14265950
+ DEFINEGEN(FALSE, J & DINFO[18:33:15]); 14266000
+ MACROID~FALSE; 14266100
+ END 14267000
+ UNTIL STEPI!COMMA; 14268000
+ DEFINING := BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 14268500
+ START: STOPENTRY~STOPGSP~FALSE; END; GO TO START; 14269000
+FIELDDEC: %117-14269020
+ BEGIN %117-14269040
+ REAL SAVEINFO, SB, NB; %117-14269060
+ BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC.%117-14269080
+ LABEL EXIT, SAVEIT; %117-14269100
+ STOPENTRY := STOPGSP := TRUE; %117-14269120
+ I := I - 1; %117-14269140
+ DO %117-14269160
+ BEGIN %117-14269180
+ STOPDEFINE := TRUE; %117-14269200
+ STEPIT; %117-14269220
+ ENTRY(FIELDID); %117-14269240
+ SAVEINFO := LASTINFO; %117-14269260
+ IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN %117-14269280
+ BEGIN %117-14269300
+ IF STEPI = LFTBRKET THEN % REMEMBER THIS %117-14269320
+ BEGIN %117-14269340
+ FOUNDLB := TRUE; %117-14269360
+ STEPIT; %117-14269380
+ END %117-14269400
+ ELSE %117-14269420
+ FOUNDLB := FALSE; %117-14269440
+ IF ELCLASS = FIELDID THEN %117-14269442
+ BEGIN %117-14269444
+ SB := ELBAT[I].SBITF; %117-14269446
+ NB := ELBAT[I].NBITF; %117-14269448
+ GO TO SAVEIT; %117-14269450
+ END; %117-14269452
+ IF ELCLASS = LITNO THEN %117-14269460
+ IF STEPI = COLON THEN %117-14269480
+ IF STEPI = LITNO THEN %117-14269500
+ IF (SB := ELBAT[I-2].ADDRESS) | %117-14269520
+ (NB := ELBAT[I].ADDRESS) ! 0 AND %117-14269540
+ SB + NB { 48 THEN %117-14269560
+ BEGIN %117-14269580
+ SAVEIT: %117-14269590
+ PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, %117-14269600
+ SAVEINFO); %117-14269620
+ STEPIT; %117-14269640
+ IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. %117-14269660
+ IF ELCLASS = RTBRKET THEN %117-14269680
+ BEGIN %117-14269700
+ STEPIT; %117-14269705
+ GO TO EXIT; %117-14269710
+ END %117-14269715
+ ELSE %117-14269720
+ ELSE %117-14269740
+ GO TO EXIT; %117-14269760
+ END; %117-14269780
+ END; %117-14269800
+ FLAG(114); %117-14269820
+ DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; %117-14269840
+ EXIT: %117-14269860
+ END %117-14269880
+ UNTIL %117-14269900
+ ELCLASS ! COMMA; %117-14269920
+ STOPENTRY := STOPGSP := FALSE; %117-14269940
+ END; %117-14269960
+ GO TO START; %117-14269980
PROCEDUREDEC: 14270000
BEGIN 14271000
LABEL START,START1; 14272000
LABEL START2, DOITANYWAY; 14273000
COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000
- IF NOT SPECTOG THEN FUNCTOG_FALSE; 14275000
+ 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
+ MAXSTACKO~ MAXSTACK; 14277000
+ IF G~GTA1[J~J-1]=STREAMV 14278000
THEN 14279000
- BEGIN STREAMTOG_TRUE; 14280000
- IF G_GTA1[J_J-1]=0 THEN TYPEV_STRPROCID 14281000
+ BEGIN STREAMTOG~TRUE; 14280000
+ IF G~GTA1[J~J-1]=0 THEN TYPEV~STRPROCID 14281000
ELSE 14282000
BEGIN 14283000
- IF TYPEV_PROCID +G>INSTRPROCID OR 14284000
+ IF TYPEV~PROCID +G>INSTRPROCID OR 14284000
TYPEV INTRPROCID THEN FLAG(005) 14295000
- ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100
- IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000
- END; 14297000
+ END END 14290000
+ ELSE 14291000
+ IF G=0 THEN TYPEV~PROCID 14292000
+ ELSE 14293000
+ IF (TYPEV:=REALSTRPROCID+G)=INTSTRPROCID THEN 14294000
+ BEGIN NEXTSAVE:=TRUE; TYPEV:=PROCID END ELSE 14294100
+ IF TYPEVINTRPROCID THEN FLAG(005) 14295000
+ ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100
+ IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000
+ END; 14297000
IF SPECTOG 14298000
THEN 14299000
BEGIN 14300000
ENTRY(TYPEV); GO TO START2 14301000
END; 14302000
- MODE_MODE+1; 14303000
- LO_PROINFO; 14304000
+ MODE~MODE+1; 14303000
+ LO~PROINFO; 14304000
SCATTERELBAT; 14305000
COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;14306000
IF LEVELF=LEVEL 14307000
THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE14308000
BEGIN 14309000
-IF G _ TAKE(LINKF+1)>= 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000
+IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000
XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST %116-14310500
% XREF ENTRY AS A DECLARATION. %116-14310501
IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100
- FWDTOG_TRUE; 14312000
- PROAD_ADDRSF; 14313000
- PROINFO_ELBAT[I];MARK_LINKF+INCRF;STEPIT 14314000
+ 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
+ DOITANYWAY: BEGIN STOPENTRY~P2~TRUE; 14318000
+ ENTRY(TYPEV); MARK~NEXTINFO;PUTNBUMP(0); 14319000
+ PROINFO~TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD~ADDRSF; 14320000
+ P2~STOPENTRY~FALSE 14321000
END; 14322000
- IF LEVEL < 31 THEN LEVEL _ LEVEL + 1 14323000
+ IF LEVEL < 31 THEN LEVEL ~ LEVEL + 1 14323000
ELSE FLAG(039); 14323100
- PJ _ 0; 14323200
+ PJ ~ 0; 14323200
IF STREAMTOG THEN STREAMWORDS; 14324000
IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000
IF ECLASS!LEFTPAREN THEN FLAG(007); 14326000
COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000
FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000
- RR1_NEXTINFO; 14329000
- LASTINFOT_LASTINFO; LASTINFO_NEXTINFO_1; 14330000
+ RR1~NEXTINFO; 14329000
+ LASTINFOT~LASTINFO; LASTINFO~NEXTINFO~1; 14330000
PUTNBUMP(0); 14331000
- PTOG_TRUE; I_I+1; 14332000
+ PTOG~TRUE; I~I+1; 14332000
ENTRY(SECRET); 14333000
-IF FWDTOG THEN BEGIN IF GT1 _ TAKE(MARK).[40:8] ! PJ THEN% 14333100
+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
+ P~PJ; 14335000
IF ELCLASS!RTPAREN 14336000
THEN FLAG(008); 14337000
IF STEPI!SEMICOLON 14338000
@@ -11040,10 +11041,10 @@ COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000
THEN FLAG(010) 14346000
ELSE 14347000
BEGIN 14348000
- IF G_ELBAT[I].ADDRESS=0 OR G>PJ 14349000
+ IF G~ELBAT[I].ADDRESS=0 OR G>PJ 14349000
THEN 14350000
FLAG(010); 14351000
- G_TAKE(ELBAT[I]); 14352000
+ G~TAKE(ELBAT[I]); 14352000
PUT(G&1[10:47:1],ELBAT[I]) 14353000
END 14354000
UNTIL 14355000
@@ -11051,22 +11052,22 @@ COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000
IF ELCLASS!SEMICOLON 14357000
THEN FLAG(011) 14358000
ELSE STEPIT 14359000
- END;I_I-1; 14360000
+ END;I~I-1; 14360000
IF STREAMTOG 14361000
THEN 14362000
BEGIN 14363000
- BUP_PJ; SPECTOG_TRUE;GO TO START1 14364000
+ BUP~PJ; SPECTOG~TRUE;GO TO START1 14364000
END 14365000
ELSE 14366000
BEGIN 14367000
- SPECTOG_TRUE; 14368000
- BUP_0; 14369000
+ 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
+START:PTOG~FALSE;LASTINFO~LASTINFOT;NEXTINFO~IF FWDTOG THEN RR1 ELSE 14373000
MARK+PJ+1; 14374000
-START1:PINFOO_NEXTINFO; 14375000
+START1:PINFOO~NEXTINFO; 14375000
START2: END; 14376000
IF SPECTOG OR STREAMTOG 14377000
THEN 14378000
@@ -11076,143 +11077,143 @@ COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 14380000
HF: 14382000
BEGIN 14383000
LABEL START,STOP; 14384000
- IF STREAMTOG 14385000
- THEN BEGIN 14386000
- JUMPCHKNX_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 UNTI14403000L
- 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+1; 14433000
- END 14434000
- ELSE 14435000
- BEGIN 14436000
- IF GT1.ADDRESS!0 THEN NLAB_NLAB+1; 14437000
- IF(GT3_TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000
- BEGIN 14439000
- MOVE(9,INFO[0,J],ACCUM[0]); 14440000
- Q_ACCUM[1]; 14441000
- FLAG(267); 14442000
- ERRORTOG_TRUE; 14443000
- END; 14444000
- END; 14445000
- XREFDUMP(J); % DUMP XREF INFO %11444510016-
- G_(GT2_TAKE(J+1)).PURPT; 14446000
- IF GT1.[2:8] ! STLABIDx2+1 THEN 14447000
- STACKHEAD[(0>2[12:12:36])MOD 125]_TAKE(J).LINK; 14448000
- END UNTIL J_J-G<=1; 14449000
- PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000
- [13:37:11],MARK); 14451000
- GT1_ L; L _ FILETHING ; 14451100
- WHILE L ! 4095 DO 14451200
- BEGIN FILETHING _ GET(L); 14451300
- EMITC(PJ+1,RSA); 14451400
- L _ FILETHING; 14451500
- END; 14451600
- L _ GT1; FILETHING _ 4095 ; 14451700
- IF FUNCTOG THEN 14452000
- BEGIN 14453000
- EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000
- EMITC(PJ+2,SED); 14455000
- EMITC(1,TRW); 14456000
- PUT(Z, PROINFO); 14457000
- END; 14458000
- EMIT(0); 14459000
- STREAMWORDS; 14460000
- STREAMTOG_FALSE; 14461000
- IF LISTER AND FORMATOG THEN SPACEITDOWN; 14461500
- END; 14462000
- LASTINFO_LASTINFOT;NEXTINFO_MARK+P+1; 14463000
- END 14464000
- ELSE 14465000
- BEGIN 14466000
- IF STEPI=FORWARDV 14467000
- THEN 14468000
- BEGIN 14469000
- XREFIT(PROINFO,0,FORWARDREF); % WE NEED THIS SO WE CAN FIND 14469100
- % THE FORWARD DECL. DURING XREF 14469101
- PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000
- PURGE(PINFOO); 14471000
- STEPIT 14472000
- END 14473000
- ELSE 14474000
- BEGIN 14475000
- PROADO_PROAD; 14476000
- TSUBLEVEL_SUBLEVEL;SUBLEVEL_LEVEL ;STACKCTRO_STACKCTR; 14477000
+ IF STREAMTOG 14385000
+ THEN BEGIN 14386000
+ JUMPCHKNX~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+1; 14433000
+ END 14434000
+ ELSE 14435000
+ BEGIN 14436000
+ IF GT1.ADDRESS!0 THEN NLAB~NLAB+1; 14437000
+ IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000
+ BEGIN 14439000
+ MOVE(9,INFO[0,J],ACCUM[0]); 14440000
+ Q~ACCUM[1]; 14441000
+ FLAG(267); 14442000
+ ERRORTOG~TRUE; 14443000
+ END; 14444000
+ END; 14445000
+ XREFDUMP(J); % DUMP XREF INFO %116-14445100
+ G~(GT2~TAKE(J+1)).PURPT; 14446000
+ IF GT1.[2:8] ! STLABID|2+1 THEN 14447000
+ STACKHEAD[(0>2[12:12:36])MOD 125]~TAKE(J).LINK; 14448000
+ END UNTIL J~J-G{1; 14449000
+ PUT( P&NLAB[7:42:6]&(NLOC+REAL(FUNCTOG))[1:42:6]&(LPRT+1) 14450000
+ [13:37:11],MARK); 14451000
+ GT1~ L; L ~ FILETHING ; 14451100
+ WHILE L ! 4095 DO 14451200
+ BEGIN FILETHING ~ GET(L); 14451300
+ EMITC(PJ+1,RSA); 14451400
+ L ~ FILETHING; 14451500
+ END; 14451600
+ L ~ GT1; FILETHING ~ 4095 ; 14451700
+ IF FUNCTOG THEN 14452000
+ BEGIN 14453000
+ EMITC(TAKE( PROINFO).ADDRESS,SES); 14454000
+ EMITC(PJ+2,SED); 14455000
+ EMITC(1,TRW); 14456000
+ PUT(Z, PROINFO); 14457000
+ END; 14458000
+ EMIT(0); 14459000
+ STREAMWORDS; 14460000
+ STREAMTOG~FALSE; 14461000
+ IF LISTER AND FORMATOG THEN SPACEITDOWN; 14461500
+ END; 14462000
+ LASTINFO~LASTINFOT;NEXTINFO~MARK+P+1; 14463000
+ END 14464000
+ ELSE 14465000
+ BEGIN 14466000
+ IF STEPI=FORWARDV 14467000
+ THEN 14468000
+ BEGIN 14469000
+ XREFIT(PROINFO,0,FORWARDREF); % WE NEED THIS SO WE CAN FIND 14469100
+ % THE FORWARD DECL. DURING XREF 14469101
+ PUT(-TAKE(G:=PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1],G); 14470000
+ PURGE(PINFOO); 14471000
+ STEPIT 14472000
+ END 14473000
+ ELSE 14474000
+ BEGIN 14475000
+ PROADO~PROAD; 14476000
+ TSUBLEVEL~SUBLEVEL;SUBLEVEL~LEVEL ;STACKCTRO~STACKCTR; 14477000
% 14478000
- COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010
- COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020
- IF MODE = 1 THEN FRSTLEVEL _LEVEL; 14478030
- MAXSTACK_STACKCTR_514 + REAL(FUNCTOG); 14478040
- IF ELCLASS = BEGINV THEN 14479000
- IF TABLE(I+1) = DECLARATORS THEN 14480000
- BEGIN 14481000
+ COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010
+ COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020
+ IF MODE = 1 THEN FRSTLEVEL ~LEVEL; 14478030
+ MAXSTACK~STACKCTR~514 + REAL(FUNCTOG); 14478040
+ IF ELCLASS = BEGINV THEN 14479000
+ IF TABLE(I+1) = DECLARATORS THEN 14480000
+ BEGIN 14481000
BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000
; PURGE(PINFOO); 14483000
GO TO STOP END; 14484000
BEGIN 14485000
JUMPCHKNX; 14486000
- RELAD_L ; 14487000
+ RELAD~L ; 14487000
IF NEXTSAVE THEN FLAG(052); 14487010
STMT; 14488000
IF FAULTOG.[46:1] THEN BEGIN EMITL(10); EMITO(COM); END;14488500
HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000
END; 14490000
STOP: 14491000
- SUBLEVEL_TSUBLEVEL; 14492000
- STACKCTR_STACKCTRO; 14493000
+ SUBLEVEL~TSUBLEVEL; 14492000
+ STACKCTR~STACKCTRO; 14493000
IF LISTER AND FORMATOG THEN SPACEITDOWN; 14493500
END; 14494000
END; 14495000
- PROINFO_LO; 14496000
+ PROINFO~LO; 14496000
IF JUMPCTR=LEVEL 14497000
THEN 14498000
- JUMPCTR_LEVEL-1; 14499000
- LEVEL_LEVEL-1; 14500000
- MODE_MODE-1; 14501000
- MAXSTACK_MAXSTACKO; 14502000
+ JUMPCTR~LEVEL-1; 14499000
+ LEVEL~LEVEL-1; 14500000
+ MODE~MODE-1; 14501000
+ MAXSTACK~MAXSTACKO; 14502000
START:END; 14503000
GO TO START; 14504000
CALLSTATEMENT: 14505000
@@ -11224,7 +11225,7 @@ CALLSTATEMENT: 14505000
MOVE(10,ACCUM,INFO[31,240]); 14507040
II :=I;SSCRAM:=SCRAM;SCOUNT:=COUNT; 14507050
FOR SCRAM := 0 STEP 1 UNTIL 124 14507060
- DO IF((I_STACKHEAD[SCRAM]) < 256) 14507070
+ DO IF((I~STACKHEAD[SCRAM]) < 256) 14507070
THEN IF I ! 0 THEN 14507080
BEGIN ELBAT[76]:=INFO[0,I]&I[35:35:14507090
13]; 14507095
@@ -11235,83 +11236,83 @@ CALLSTATEMENT: 14505000
KLASSF := REALID; 14507130
MAKEUPACCUM; E; 14507140
END; 14507150
- I_II;SCRAM_SSCRAM;COUNT_SCOUNT; 14507160
+ I~II;SCRAM~SSCRAM;COUNT~SCOUNT; 14507160
MOVE(10,INFO[31,240],ACCUM); 14507170
- BUP_PJ; FLAG(12);SPECTOG_TRUE; 14507180
+ BUP~PJ; FLAG(12);SPECTOG~TRUE; 14507180
GO TO START; 14507190
END ; 14507200
FLAG(12);GO TO HF 14508000
END; 14509000
- BEGINCTR _ BEGINCTR-1; 14510000
+ BEGINCTR ~ BEGINCTR-1; 14510000
IF ERRORTOG 14511000
THEN COMPOUNDTAIL 14512000
ELSE 14513000
BEGIN 14514000
STMT; 14515000
- IF ELCLASS_TABLE(I+1)=DECLARATORS 14516000
+ IF ELCLASS~TABLE(I+1)=DECLARATORS 14516000
THEN 14517000
BEGIN 14518000
- ELBAT[I].CLASS_SEMICOLON; 14519000
- BEGINCTR_BEGINCTR+1; 14520000
+ ELBAT[I].CLASS~SEMICOLON; 14519000
+ BEGINCTR~BEGINCTR+1; 14520000
GO TO START 14521000
END 14522000
ELSE 14523000
COMPOUNDTAIL 14524000
END; 14525000
BEGIN 14526000
- RELAD_FIRSTX; 14534000
+ RELAD~FIRSTX; 14534000
IF STACKCTR>MAXSTACK 14535000
- THEN MAXSTACK_STACKCTR; 14536000
+ THEN MAXSTACK~STACKCTR; 14536000
IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000
THEN 14538000
IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000
- THEN 14540000
- BEGIN 14541000
- EMITV(BLOCKCTR); 14542000
- EMITL(1); 14543000
- EMITO(SUB); 14544000
- EMITSTORE(BLOCKCTR,STD); 14545000
- GOTSTORAGE_TRUE 14546000
- END 14547000
- ELSE 14548000
- BEGIN 14549000
- EMITL(10); 14550000
- EMITO(COM) 14551000
- END; 14552000
- FUNCTOG_FUNCTOGO; 14553000
- IF SOP 14554000
- THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000
- ELSE 14556000
- BEGIN 14557000
- IF LEVEL = 1 THEN EMITO(XIT) 14557500
- ELSE BEGIN 14557600
- EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR.14558000
- EMITO(BFW); 14558500
- END; 14558600
- CONSTANTCLEAN; 14559000
- IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000
- OR FAULTOG.[46:1] THEN 14561000
- BEGIN 14562000
- ADJUST; RELAD_L; 14563000
- IF GOTSTORAGE OR FAULTOG.[46:1] 14564000
- THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100
- EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000
- END; 14566000
- IF LEVEL=1 THEN IF G_NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G_G-1 14567000
- =0; 14568000
- PURGE(NINFOO); 14569000
- IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100
- BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200
- BUMPL; 14570000
- EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000
- CONSTANTCLEAN 14572000
- END ELSE PURGE(NINFOO); 14573000
- IF RELAD =4095 THEN RELAD_0; 14574000
- NEXTTEXT _ NTEXTO; 14574500
- G_PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000
- END; 14576000
- ENILSPOT _ 1023 & CARDNUMBER[10:20:28]; 14576100
- SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000
+ THEN 14540000
+ BEGIN 14541000
+ EMITV(BLOCKCTR); 14542000
+ EMITL(1); 14543000
+ EMITO(SUB); 14544000
+ EMITSTORE(BLOCKCTR,STD); 14545000
+ GOTSTORAGE~TRUE 14546000
+ END 14547000
+ ELSE 14548000
+ BEGIN 14549000
+ EMITL(10); 14550000
+ EMITO(COM) 14551000
+ END; 14552000
+ FUNCTOG~FUNCTOGO; 14553000
+ IF SOP 14554000
+ THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000
+ ELSE 14556000
+ BEGIN 14557000
+ IF LEVEL = 1 THEN EMITO(XIT) 14557500
+ ELSE BEGIN 14557600
+ EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000
+ EMITO(BFW); 14558500
+ END; 14558600
+ CONSTANTCLEAN; 14559000
+ IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000
+ OR FAULTOG.[46:1] THEN 14561000
+ BEGIN 14562000
+ ADJUST; RELAD~L; 14563000
+ IF GOTSTORAGE OR FAULTOG.[46:1] 14564000
+ THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100
+ EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000
+ END; 14566000
+IF LEVEL=1 THEN IF G~NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G~G-1 14567000
+=0; 14568000
+ PURGE(NINFOO); 14569000
+ IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100
+ BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200
+ BUMPL; 14570000
+ EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000
+ CONSTANTCLEAN 14572000
+ END ELSE PURGE(NINFOO); 14573000
+ IF RELAD =4095 THEN RELAD~0; 14574000
+ NEXTTEXT ~ NTEXTO; 14574500
+ G~PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000
+ END; 14576000
+ ENILSPOT ~ 1023 & CARDNUMBER[10:20:28]; 14576100
+ SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000
14578000
14579000
14580000
@@ -11327,38 +11328,38 @@ BEGIN 14526000
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
+ ENILPTR ~ OLDENILPTR; LASTADDRESS ~ OLDLASTADDRESS; 14593000
+ MOVECODE(TENIL,ENIL); 14594000
+ MOVECODE(TEDOC,EDOC);L~LOLD; 14595000
+ DOUBLE(SGNO,SGNOO,~,SGNOO,SGNO); 14596000
+ IF NOT SOP AND LEVEL ! 1 14597000
+ THEN 14598000
+ BEGIN 14599000
+ ADJUST; 14600000
+ G~PROGDESCBLDR(LDES,L,ADDRSF); 14601000
+ IF ELCLASS = FACTOP THEN 14601100
+ BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200
14601300
14601400
14601500
14601600
14601610
- STEPIT; 14601700
- END; 14601800
- END; 14602000
- IF JUMPCTR=LEVEL THEN JUMPCTR_LEVEL-1; 14603000
- LEVEL_LEVEL-1; 14604000
- FUNCTOG_FUNCTOGO; 14605000
- AJUMP_AJUMPO; 14606000
- GLOBALNINFOO := OLDNINFOO; %118- 14606100
- PRTI_PRTIO; 14607000
- FIRSTX_FIRSTXO; 14608000
- SAVEL_SAVELO; 14609000
- STACKCTR_STACKCTRO; 14610000
- SAVEPRTOG := SAVEPRTOGO; 14610100
- NCII_NCIIO; FAULTOG_FAULTOGO AND(FALSE&FAULTLEVEL 7 15035000
- THEN 7 15036000
- ELSE SIZEALPHA)); EMITB(BFW.LTEMP,L); 15037000
- END PASSALPHA; 15038000
+ 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
+ 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
+ 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
@@ -11421,7 +11422,7 @@ PROCEDURE PASSALPHA(ELBATWORD); 15020000
M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000
VL = LITC V 15057000
VV = OPDC V 15058000
- _ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000
+ ~ = 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
@@ -11443,23 +11444,23 @@ PROCEDURE PASSALPHA(ELBATWORD); 15020000
% ON LEFT HAND SIDE OF ASSIGNMENT SO WE %116-15075551
% CAN XREF IT CORRECTLY. %116-15075552
LABEL EXIT; 15076000
- TALL_ELBAT[I] ; 15077000
- IF ELCLASS<= INTPROCID THEN 15078000
+ TALL~ELBAT[I] ; 15077000
+ IF ELCLASS { INTPROCID THEN 15078000
BEGIN 15079000
IF TALL.LINK !PROINFO.LINK THEN 15080000
BEGIN ERR(211); GO TO EXIT END; 15081000
COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000
- TALL _ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000
+ TALL ~ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000
END 15084000
ELSE CHECKER(TALL); 15085000
REMEMBERSEQNO := CARDNUMBER %116-15085100
- IF TALL.CLASS<= INTID THEN 15086000
+ IF TALL.CLASS { INTID THEN 15086000
BEGIN 15087000
LABEL L1, EXIT ; 15088000
DEFINE FORMALNAME=[9:2]=2 #; 15089000
- J _ ELCLASS ; 15089010
+ J ~ ELCLASS ; 15089010
IF STEPI= ASSIGNOP THEN 15090000
- BEGIN STACKCT _ 1; %A 15091000
+ BEGIN STACKCT ~ 1; %A 15091000
XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. %116-15091100
L1: 15092000
IF TALL.FORMALNAME THEN 15092020
@@ -11468,12 +11469,12 @@ L1: 15092000
IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END; 15095000
END 15096000
ELSE IF T1!0 THEN EMITV(TALL.ADDRESS) 15097000
- ; STACKCT _ REAL(T1!0); STEPIT; %A 15098000
+ ; STACKCT ~ REAL(T1!0); STEPIT; %A 15098000
IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000
EMITD(48-T2 ,T1 ,T2); 15100000
- IF TALL<0 THEN CLSMPMN(TALL,J>=BOOPROCID AND J<=INTPROCID) ; 15101000
- STACKCT _ 0; %A 15101500
- GT1 _ IF TALL.CLASS =INTID THEN IF P1= FS 15102000
+ 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
@@ -11486,7 +11487,7 @@ L1: 15092000
BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000
IF STEPI=ASSIGNOP THEN 15113000
BEGIN %116-15113100
- IF P1! FS THEN 15114000
+ IF P1 ! FS THEN 15114000
BEGIN %116-15115000
ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100
GO TO EXIT; %116-15115200
@@ -11496,7 +11497,7 @@ L1: 15092000
END; %116-15116200
%A 15117000
END ; 15118000
- IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000
+ 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
@@ -11512,8 +11513,8 @@ COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000
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
+ 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
@@ -11554,11 +11555,11 @@ COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000
XCH,T. 15174000
5. ADD THE SEQUENCE: 15175000
IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000
- XCH,_. 15177000
+ 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
+ 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
@@ -11596,7 +11597,7 @@ COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000
PROCEDURE M4(TALL,J); 15215000
VALUE TALL,J ; 15216000
REAL TALL,J ; 15217000
- BEGIN STACKCT _ 1; %A15217500
+ BEGIN STACKCT ~ 1; %A 15217500
IF J = 1 15218000
THEN BEGIN COMMENT FIRST TIME AROUND; 15219000
IF TALL < 0 15220000
@@ -11613,61 +11614,61 @@ PROCEDURE M4(TALL,J); 15215000
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
+ 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 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
+ IF SPCLMON~TAKE(GIT(TALL)+1).SPMON ! 0 15242000
THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000
- TESTVARB_(NODIM_TAKE(INC_GIT(TALL)) 15244000
+ TESTVARB~(NODIM~TAKE(INC~GIT(TALL)) 15244000
.NODIMPART)+INC; 15245000
- DO IF BOOLEAN(LWRBND_TAKE(INC_INC+1)).15246000
+ 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
+ UNTIL INC } TESTVARB 15250000
END; 15251000
END; 15252000
NEXT: IF STEPI = FACTOP THEN 15253000
BEGIN 15254000
- STLB _ 1; 15254400
+ STLB ~ 1; 15254400
WHILE TABLE(I+1) = COMMA DO 15254500
BEGIN STEPIT; 15254600
- IF STEPI = FACTOP THEN STLB _ STLB+1 ELSE 15254700
+ IF STEPI = FACTOP THEN STLB ~ STLB+1 ELSE 15254700
BEGIN ERR(204); GO TO EXIT END; 15254800
END; 15254900
IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000
BEGIN ERR(203);GO EXIT END; 15256000
-COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW *15257000
- ROW DESIGNATOR DOES NOT MATCH THE ARRAY *15258000
- DECLARATION. *15259000;
+COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000
+ ROW DESIGNATOR DOES NOT MATCH THE ARRAY * 15258000
+ DECLARATION. *;15259000
IF STEPI = RTBRKET THEN 15260000
BEGIN ERR(204);GO EXIT END; 15261000
-COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *15262000;
+COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;15262000
IF P1 ! FA THEN 15262500
IF STLB > 1 THEN FLAG(212) ELSE 15262600
IF P1!FI AND P1!FL THEN 15263000
IF P1 = FP AND REL THEN ELSE 15263050
BEGIN ERR(205); GO TO EXIT; END; 15263100
-COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL *15264000
- STATEMENT OR ACTUAL PARAMETER LIST. *15265000;
+COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000
+ STATEMENT OR ACTUAL PARAMETER LIST. *;15265000
IF J=0 THEN 15266000
EMITPAIR(TALL.ADDRESS,LOD); 15267000
COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000
IF TALL < 0 THEN 15269000
BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000
- EMITNUM(5&CARDNUMBER[1:4:44]); %10915271000-
- EMITN(GNAT(PRINTI)); %10915271100-
+ EMITNUM(5&CARDNUMBER[1:4:44]); %109-15271000
+ EMITN(GNAT(PRINTI)); %109-15271100
END; 15272000
IF P1 = FA THEN 15272900
- FOR X _ 1 STEP 1 UNTIL STLB DO 15273000
- BEGIN IF (Z_TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100
+ 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
@@ -11677,8 +11678,8 @@ COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000
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
+ 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
@@ -11701,7 +11702,7 @@ COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000
BEGIN ERR(208); GO TO EXIT END; 15297000
15298000
15299000
- STACKCT _ 0; %A 15299500
+ STACKCT ~ 0; %A 15299500
IF STEPI = ASSIGNOP THEN 15300000
BEGIN 15301000
XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO15301100
@@ -11735,12 +11736,12 @@ COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000
EMITV(GNAT(PRINTI)); %109-15328000
IF P1 ! FS 15329000
THEN EMITV(JUNK); 15330000
- P1_0; GO TO EXIT; 15331000
+ 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
+ P1~0 ; 15336000
GO TO EXIT ; 15337000
END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000
IF ELCLASS=PERIOD THEN 15339000
@@ -11759,7 +11760,7 @@ COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000
ELSE 15346000
COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000
BEGIN COMMENT MONITOR FUNCTION M10; 15348000
- SPCLMON_P1 = FP OR ELCLASS >=AMPERSAND; 15349000
+ SPCLMON~P1 = FP OR ELCLASS }AMPERSAND; 15349000
IF J = 1 15350000
THEN IF SPCLMON 15351000
THEN EMITV(TALL.ADDRESS) 15352000
@@ -11775,26 +11776,26 @@ COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000
ELSE EMITN(GNAT(PRINTI)) 15362000
END; 15363000
IF P1 =FS THEN ERR(210); 15364000
- IF P1 = FI THEN P1_0; 15364500
+ 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
+ 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
- %A15370000
+ IF P1=FI THEN P1~0;% 15369600
+ %A 15370000
COMMENT ***** MONITOR FUNCTION M9 ; 15371000
IF TALL < 0 15372000
THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000
- EMITNUM(5&CARDNUMBER[1:4:44]); %10915374000-
- EMITV(GNAT(PRINTI)); %10915374100-
+ EMITNUM(5&CARDNUMBER[1:4:44]); %109-15374000
+ EMITV(GNAT(PRINTI)); %109-15374100
END ; 15375000
- EXIT: STACKCT _ 0 END OF SUBSCRIPTED BLOCK; %A15376000
+ EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; %A 15376000
EXIT : END OF THE VARIABLE ROUTINE; 15377000
COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000
PROCEDURE STREAMSTMT ; 16001000
@@ -11805,77 +11806,77 @@ COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000
DEFINE 16006000
JFW = 39#, COMMENT 7,5,5,1 JUMP FORWARD UNCONDITIONAL ; 16007000
RCA = 40#, COMMENT 7,5,7,6 RECALL CONTROL ADDRESS ; 16008000
- JRV = 47#, COMMENT 7,5,5,2 JUMP REVERSE UNCONDITIONAL ; 16009000
- CRF = 35#, COMMENT 7,5,10,6 CALL REPEAT FIELD ; 16010000
- BNS = 42#, COMMENT 7,5,5,5 BEGIN LOOP ; 16011000
- NOP = 1#, COMMENT ; 16012000
- ENS = 41#, COMMENT 7,5,5,6 END LOOP ; 16013000
- TAN = 30#, COMMENT 7,5,3,7 TEST FOR ALPHAMERIC ; 16014000
- BIT = 31#, COMMENT 7,5,3,8 TEST BIT ; 16015000
- JFC = 37#, COMMENT 7,5,5,3 JUMP FORWARD CONDITIONAL ; 16016000
- SFD = 06#, COMMENT 7,5,7,8 SET DESTINATION ADDRESS ; 16017000
- RSA = 43#, COMMENT 7,5,7,4 RECALL SOURCE ADDRESS ; 16018000
- TRP = 60#, COMMENT 7,5,2,2 TRANSFER PROGRAM CHARACTERS ; 16019000
- BSS = 3#, COMMENT 7,5,6,6 SKIP SOURCE BIT ; 16020000
- BSD = 2#, COMMENT 7,5,6,5 SKIP DESTINATION BITS ; 16021000
+ JRV = 47#, COMMENT 7,5,5,2 JUMP REVERSE UNCONDITIONAL ; 16009000
+ CRF = 35#, COMMENT 7,5,10,6 CALL REPEAT FIELD ; 16010000
+ BNS = 42#, COMMENT 7,5,5,5 BEGIN LOOP ; 16011000
+ NOP = 1#, COMMENT ; 16012000
+ ENS = 41#, COMMENT 7,5,5,6 END LOOP ; 16013000
+ TAN = 30#, COMMENT 7,5,3,7 TEST FOR ALPHAMERIC ; 16014000
+ BIT = 31#, COMMENT 7,5,3,8 TEST BIT ; 16015000
+ JFC = 37#, COMMENT 7,5,5,3 JUMP FORWARD CONDITIONAL ; 16016000
+ SFD = 06#, COMMENT 7,5,7,8 SET DESTINATION ADDRESS ; 16017000
+ RSA = 43#, COMMENT 7,5,7,4 RECALL SOURCE ADDRESS ; 16018000
+ TRP = 60#, COMMENT 7,5,2,2 TRANSFER PROGRAM CHARACTERS ; 16019000
+ BSS = 3#, COMMENT 7,5,6,6 SKIP SOURCE BIT ; 16020000
+ BSD = 2#, COMMENT 7,5,6,5 SKIP DESTINATION BITS ; 16021000
SEC = 34#, COMMENT 7,5,10,1 SET COUNT ; 16022000
JNS = 38#; COMMENT 7,5,5,7 JUMP OUT LOOP ; 16023000
COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 16024000
OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 16025000
- A VALUE = 0 AND THE JUMP>= 64 SYLLABLES A JFW 1 AND 16026000
+ A 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
+ SAVL~L; 16032000
+F~GET( S); 16033000
+ IF D ~ L -( L~S) -1{63 THEN 16034000
BEGIN 16035000
IF F=BNS THEN 16036000
BEGIN 16037000
- S_GET(L_L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D_D-2; 16038000
+ S~GET(L~L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D~D-2; 16038000
END; 16039000
- EMITC(D,F); L _ SAVL 16040000
+ 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
+ EMITC(PJ~PJ+1,RCA); 16046000
+ L ~ SAVL; 16047000
ADJUST; 16048000
- LPRT _ PROGDESCBLDR(2,L,0); 16049000
+ LPRT ~ PROGDESCBLDR(2,L,0); 16049000
COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000
- PUTNBUMP(0&(STLABIDx2+1) 16051000
+ 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
+ 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
+ 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
- ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW); 16079000
- END EMIT JUMP; 16080000
+ 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
+ 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
@@ -11883,21 +11884,21 @@ F_GET( S); 16033000
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
+ SAVL ~ L; 16088000
+ L ~ TAKE(GIT(E)).LASTGT ; 16089000
+ WHILE L ! 4095 DO 16090000
BEGIN 16091000
- LINK _ GET(L); 16092000
+ LINK ~ GET(L); 16092000
EMITJUMP( E); 16093000
- L _ LINK 16094000
+ L ~ LINK 16094000
END; 16095000
- L_SAVL; 16096000
+ 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
+ THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH{63,OTHERWISE 16102000
IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000
RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000
MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000
@@ -11916,16 +11917,16 @@ F_GET( S); 16033000
REAL JOINT,BNSFIX; 16118000
IF ELCLASS!LITNO THEN 16119000
BEGIN 16120000
- EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX_ L; 16121000
+ EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX~ L; 16121000
EMIT ( BNS); EMIT(NOP);EMIT(NOP); 16122000
END 16123000
ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000
IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000
- NESTLEVEL_NESTLEVEL + 1; 16126000
- JOINT _ JOINFO; 16127000
- JOINFO _ 0; 16128000
+ NESTLEVEL~NESTLEVEL + 1; 16126000
+ JOINT ~ JOINFO; 16127000
+ JOINFO ~ 0; 16128000
DO BEGIN 16129000
- STEPIT; ERRORTOG _ TRUE; STREAMSTMT 16130000
+ 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
@@ -11937,8 +11938,8 @@ F_GET( S); 16033000
JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000
END; 16140000
IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000
- NESTLEVEL _ NESTLEVEL-1; 16142000
- JOINFO _ JOINT ; 16143000
+ 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
@@ -11950,16 +11951,16 @@ F_GET( S); 16033000
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
+ AND GET A PRT LOCATION FOR ANY JUMPS}64 SYLLABLES. ; 16155000
PROCEDURE LABELS; 16156000
BEGIN 16157000
ADJUST; 16158000
- GT1 _ ELBAT[I]; 16159000
+ GT1 ~ ELBAT[I]; 16159000
XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF %116-16159100
IF STEPI ! COLON THEN ERR(258) 16160000
ELSE 16161000
BEGIN 16162000
- IF TAKE(GT2_GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000
+ IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000
IF GT1>0 THEN 16164000
BEGIN 16165000
PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000
@@ -11990,17 +11991,17 @@ PROCEDURE LABELS; 16156000
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
+ SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000
REAL ADDR,FIX1,FIX2 ; 16195000
- ADDR_1 ; 16196000
+ 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
+ ADDR~0; 16201000
END 16202000
ELSE 16203000
- IF ELCLASS=LITNO THEN ADDR _ ELBAT[I].ADDRESS 16204000
+ IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000
ELSE BEGIN ERR(250); GO TO EXIT END; 16205000
IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000
IFSC: 16207000
@@ -12029,7 +12030,7 @@ IFSC: 16207000
GO IFTOG; 16215000
IFSB: EMITC(1,BIT); 16216000
IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
- FIX1 _ L; 16218000
+ FIX1 ~ L; 16218000
EMIT(JFC); 16219000
STEPIT; 16220000
IF ELCLASS = BEGINV OR 16221000
@@ -12044,7 +12045,7 @@ IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
STREAMSTMT; 16229000
IF ELCLASS= ELSEV THEN 16230000
BEGIN 16231000
- FIX2 _ L; EMIT(JFW); 16232000
+ FIX2 ~ L; EMIT(JFW); 16232000
FIXC(FIX1); 16233000
STEPIT; 16234000
STREAMSTMT; 16235000
@@ -12055,7 +12056,7 @@ IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
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
+ 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
FIRNALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000
@@ -12064,9 +12065,9 @@ IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
PROCEDURE GOTOS; 16249000
BEGIN 16250000
LABEL EXIT; 16251000
- IF STEPI !TOV THEN I_I-1 ; 16252000
+ IF STEPI !TOV THEN I~I-1 ; 16252000
IF STEPI ! STLABID THEN BEGIN ERR(260); GO TO EXIT END; 16253000
- IF(GT2_TAKE(GIT(GT1_ELBAT[I]))).MON=1 16254000
+ 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
@@ -12081,7 +12082,7 @@ IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
EMIT(GT2,LASTGT); 16266000
END; 16267000
END; 16268000
- JUMPLEVEL_0 ; 16269000
+ JUMPLEVEL~0 ; 16269000
EXIT: END GOTOS ; 16270000
COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000
THE CODE GENERATED IS : 16272000
@@ -12095,20 +12096,20 @@ IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000
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
+ (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
+ 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
+ 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
@@ -12127,14 +12128,14 @@ PROCEDURE INDEXS; 16311000
BEGIN 16312000
LABEL EXIT,GENERATE,L,L1; 16313000
INTEGER TCLASS,INDEX,ADDR,J; 16314000
- TCLASS _ ELCLASS ; 16315000
+ TCLASS ~ ELCLASS ; 16315000
IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000
IF TCLASS = LOCLID THEN 16317000
BEGIN 16318000
XMARK(ASSIGNREF); %116-16318500
IF SIV>STEPI OR ELCASS>TALLYV THEN GO TO L; 16319000
- INDEX _ 32 + ELCLASS-SIV; 16320000
- ADDR _ ELBAT[I-2].ADDRESS; 16321000
+ INDEX ~ 32 + ELCLASS-SIV; 16320000
+ ADDR ~ ELBAT[I-2].ADDRESS; 16321000
GO TO GENERATE; 16322000
END; 16323000
IF TCLASS = STEPI THEN 16324000
@@ -12142,13 +12143,13 @@ PROCEDURE INDEXS; 16311000
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) x 4 16329000
- + REAL(ELCLASS =LOCLID) x 8; 16330000
+ 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
+ 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
@@ -12158,20 +12159,20 @@ PROCEDURE INDEXS; 16311000
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
+ 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
+ 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
+ EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000
GO TO L1 16353000
END; 16354000
EXIT:END INDEXS ; 16355000
COMMENT DSS COMPILES DESINTATION STREAM STATEMENTS. 16356000
- DS_ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000
+ 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
@@ -12181,60 +12182,60 @@ PROCEDURE DSS; 16362000
INTEGER ADDR,J,K,L,T; 16364000
LABEL EXIT,L1; 16365000
DEFINE OPCODE=[27:16]#; 16366000
- IF STEPI!= ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000
+ 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
+ ADDR~ 0; 16371000
IF STEPI = LITV THEN GO TO L1 16372000
END 16373000
- ELSE IF ELCLASS= LITNO THEN 16374000
+ ELSE IF ELCLASS= LITNO THEN 16374000
BEGIN 16375000
- ADDR _ ELBAT[I].ADDRESS; STEPIT ; 16376000
+ ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000
END 16377000
- ELSE ADDR _ 1 ; 16378000
- IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000
- EMITC(ADDR,ELBAT[I],OPCODE) %A 16379500
- ELSE 16380000
- IF ELCLASS = LITV THEN 16381000
- BEGIN 16382000
- EMITC(ADDR,TRP); 16383000
- IF STEPI!=STRING AND ELCLASS!=STRNGCON AND %111-16384000
- ELCLASS!= LITNO AND ELCLASS!= NONLITNO THEN %111-16384100
- BEGIN ERR(255); GO TO EXIT END; 16384500
- IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %111-16384700
- MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800
- C,8-COUNT,ACCUM[1],3); %111-16384900
- IF ADDR MOD 2!= 0 THEN 16385000
- BEGIN 16386000
- EMIT(ACCUM[1],[18:6]); j _ 1; 16387000
- END ; 16388000
- FOR K _J+2 STEP 2 UNTIL ADDR DO 16389000
- BEGIN 16390000
- FOR L _6,7 DO 16391000
- MOVECHARACTERS(1,ACCUM[1],2+(IF J_J+1>COUNT THEN J-116392000
- 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
+ ELSE ADDR ~ 1 ; 16378000
+ IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000
+ EMITC(ADDR,ELBAT[I],OPCODE) %A 16379500
+ ELSE 16380000
+ IF ELCLASS = LITV THEN 16381000
+ BEGIN 16382000
+ EMITC(ADDR,TRP); 16383000
+ IF STEPI!STRING AND ELCLASS!STRNGCON AND %111-16384000
+ ELCLASS ! LITNO AND ELCLASS ! NONLITNO THEN %111-16384100
+ BEGIN ERR(255); GO TO EXIT END; 16384500
+ IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %111-16384700
+ MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800
+ C,8-COUNT,ACCUM[1],3); %111-16384900
+ IF ADDR MOD 2 ! 0 THEN 16385000
+ BEGIN 16386000
+ EMIT(ACCUM[1],[18:6]); j ~ 1; 16387000
+ END ; 16388000
+ FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000
+ BEGIN 16390000
+ FOR L ~6,7 DO 16391000
+ MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000
+ ELSE J),T,L ); 16393000
+ EMIT(T); 16394000
+ END END 16395000
+ ELSE 16396000
+ L1: ERR(250); 16397000
+ EXIT:END DSS ; 16398000
+ COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000
+ IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000
+ A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000
+ OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000
PROCEDURE SKIPS ; 16403000
BEGIN 16404000
REAL ADDR; 16405000
IF STEPI = LOCLID THEN 16406000
BEGIN 16407000
- EMITC(ELBAT[I],ADDRESS,CRF); ADDR_0; STEPIT; 16408000
+ 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
+ ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000
END 16413000
- ELSE ADDR _ 1 ; 16414000
+ ELSE ADDR ~ 1 ; 16414000
IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000
ELSE 16416000
IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000
@@ -12253,26 +12254,26 @@ PROCEDURE SKIPS ; 16403000
GO TOSD 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 JUMPLEBEL_ ELBAT[I].ADDRESS 16435000
+ JUMPLEVEL~1; 16433000
+ IF STEPI!DECLARATORS THEN FLAG(261); 16434000
+ IF STEPI!LITNO THEN JUMPLEBEL~ ELBAT[I].ADDRESS 16435000
ELSE BEGIN 16436000
- IF ELCLASS!=TOV AND ELCLASS!=STLABID THEN 16437000
+ 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&(STLABIDx2+1) 16443000
+ 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
+ LASTINFO ~ JOINFO; 16447000
END; 16448000
- ELBAT[I_ I-1]_ TAKE(JOINFO)&JOINFO[35:35:13]; 16449000
- END; I_I-1 ; 16450000
+ 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
+ FOR GT1~1 STEP 1 UNTIL JUMPLEVEL DO 16452000
EMIT( JNS); 16453000
GOTOS; 16454000
END JUMPS; 16455000
@@ -12309,7 +12310,7 @@ PROCEDURE JUMPS; 16431000
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
+ 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
@@ -12317,10 +12318,10 @@ PROCEDURE JUMPS; 16431000
EXIT: STEPIT; 16494000
FINI: END STREAMSTMT; 16495000
16496000
- TIME1 _ TIME(1); PROGRAM; 17000000
+ TIME1 ~ TIME(1); PROGRAM; 17000000
ENDOFITALL: 17000100
IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000
- BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ=<=#; %DFB17002000
+ BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ={#; %DFB 17002000
DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], %116-17002005
((INDEX).CF DIV 2).LINKC]#, %116-17002006
CF = [33:15]#, %116-17002007
@@ -12344,11 +12345,11 @@ IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000
END; %116-17002080
WRITE(LINE[PAGE]); 17002520
SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. %116-17002525
- LASTADDRESS_0; 17002530
+ LASTADDRESS~0; 17002530
FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000
WRITE(DSK2,30,XREFAY2[*]); %DFB17004000
TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. %116-17004500
- XREFPT_XLUN_0; %DFB17004600-
+ XREFPT~XLUN~0; %DFB17004600
FOR I:= 0 STEP 1 UNTIL 8191 DO %116-17004700
XREFINFO[I] := 0; %116-17004710
BEGIN %DFB17005000
@@ -12417,64 +12418,64 @@ IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000
REWIND(DSK1); %DFB17044000
SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN %116-17045000
7000 ELSE 10000); %116-17045100
- END; %DFB17046000
- BEGIN %DFB17047000
- ARRAY IDTYPE[0:(IDMAX+4)x4-1]; %117-17047100
- STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, %116-17047200
- FWDSEQNO,TYPE,OWNTOG,PARAMTOG, %116-17047300
- VALTOG); %116-17047350
- VALUE SEQG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, %116-17047400
- VALTOG; %116-17047450
- BEGIN %116-17047500
- SI := S; %116-17047700
- DI := D; %116-17047800
- 63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); %116-17047900
- DS := 6 LIT " -- "; %116-17048000
- OWNTOG (DS := 4 LIT "OWN "); %116-17048100
- SI := TYPE; %116-17049300
- 32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); %116-17049400
- PARAMTOG (DS := 6 LIT " -- "; %116-17049410
- DS := 4 LIT "NAME"; %116-17049420
- VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); %116-17049430
- DS := 10 LIT " PARAMETER"); %116-17049440
- DS := 26 LIT " -- DECLARED IN SEGMENT "; %116-17049500
- SI := LOC SEG; %116-17049600
- S := SI; %116-17049700
- DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800
- DI := DI + 8; % TO FORCE STORE OF LAST WORD %116-17049900
- SI := S; %116-17050000
- DI := S; %116-17050100
- 4(IF SC!= " " THEN DS:= CHR ELSE SI := SI + 1); %116-17050200
- DS := 4 LIT " AT "; %116-17050300
- SI := LOC SEQNO; %116-17050400
- DS := 8 DEC; %116-17050500
- FWDTOG (DS := 17 LIT " -- FORWARD AT "; %116-17050600
- SI := LOC FWDSEQNO; %116-17050700
- DS := 8 DEC); %116-17050800
- LBLTOG (DS := 16 LIT " -- OCCURS AT "; %116-17050900
- SI := LOC FWDSEQNO; %116-17051000
- DS := 8 DEC); %116-17051100
- END OF SETUPHEADING; %116-17051200
+ END; %DFB17046000
+ BEGIN %DFB17047000
+ ARRAY IDTYPE[0:(IDMAX+4)|4-1]; %117-17047100
+ STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, %116-17047200
+ FWDSEQNO,TYPE,OWNTOG,PARAMTOG, %116-17047300
+ VALTOG); %116-17047350
+ VALUE SEQG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, %116-17047400
+ VALTOG; %116-17047450
+ BEGIN %116-17047500
+ SI := S; %116-17047700
+ DI := D; %116-17047800
+ 63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); %116-17047900
+ DS := 6 LIT " -- "; %116-17048000
+ OWNTOG (DS := 4 LIT "OWN "); %116-17048100
+ SI := TYPE; %116-17049300
+ 32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); %116-17049400
+ PARAMTOG (DS := 6 LIT " -- "; %116-17049410
+ DS := 4 LIT "NAME"; %116-17049420
+ VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); %116-17049430
+ DS := 10 LIT " PARAMETER"); %116-17049440
+ DS := 26 LIT " -- DECLARED IN SEGMENT "; %116-17049500
+ SI := LOC SEG; %116-17049600
+ S := SI; %116-17049700
+ DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800
+ DI := DI + 8; % TO FORCE STORE OF LAST WORD %116-17049900
+ SI := S; %116-17050000
+ DI := S; %116-17050100
+ 4(IF SC ! " " THEN DS:= CHR ELSE SI := SI + 1); %116-17050200
+ DS := 4 LIT " AT "; %116-17050300
+ SI := LOC SEQNO; %116-17050400
+ DS := 8 DEC; %116-17050500
+ FWDTOG (DS := 17 LIT " -- FORWARD AT "; %116-17050600
+ SI := LOC FWDSEQNO; %116-17050700
+ DS := 8 DEC); %116-17050800
+ LBLTOG (DS := 16 LIT " -- OCCURS AT "; %116-17050900
+ SI := LOC FWDSEQNO; %116-17051000
+ DS := 8 DEC); %116-17051100
+ END OF SETUPHEADING; %116-17051200
%116-17051300
- STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); %116-17051400
- VALUE SEQNO,N,STARS; %116-17051500
- BEGIN %116-17051600
- DI := D; %116-17051700
- DI := DI + 8; %116-17051800
- N (DI := DI + 10); %116-17051900
- STARS(DO := DI - 1; DS := LIT "*"); %116-17052000
- SI := LOC SEQNO; %116-17052100
- DS := 8 DEC; %116-17052200
- DS := LIT " "; %116-17052300
- STARS (DI := DS - 1; DS := LIT "*"); %116-17052400
- END; %116-17052500
- STREAM PROCEDURE BLANKET(D); %116-17052600
- BEGIN %116-17052700
- DI := D; %116-17052800
- DS := 8 LIT " "; %116-17052900
- SI := D; %116-17053000
- DS := 16 WDS; %116-17053100
- END OF BLANKET; %116-17053200
+ STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); %116-17051400
+ VALUE SEQNO,N,STARS; %116-17051500
+ BEGIN %116-17051600
+ DI := D; %116-17051700
+ DI := DI + 8; %116-17051800
+ N (DI := DI + 10); %116-17051900
+ STARS(DO := DI - 1; DS := LIT "*"); %116-17052000
+ SI := LOC SEQNO; %116-17052100
+ DS := 8 DEC; %116-17052200
+ DS := LIT " "; %116-17052300
+ STARS (DI := DS - 1; DS := LIT "*"); %116-17052400
+ END; %116-17052500
+ STREAM PROCEDURE BLANKET(D); %116-17052600
+ BEGIN %116-17052700
+ DI := D; %116-17052800
+ DS := 8 LIT " "; %116-17052900
+ SI := D; %116-17053000
+ DS := 16 WDS; %116-17053100
+ END OF BLANKET; %116-17053200
PROCEDURE PRINTXREFSTATISTICS; %116-17053300
BEGIN %116-17053400
SWITCH FORMAT STATS := %116-17053500
@@ -12573,20 +12574,20 @@ IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000
FIRSTTIME := FALSE; %116-17091162
TIME1 := TIME(1); %116-17091165
DATIME; %116-17091170
- UPATETIMES(1); %116-17091175
+ UPDATETIMES(1); %116-17091175
SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. %116-17091180
END; %116-17091200
IF NOT B2 THEN %116-17091210
IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. %116-17091300
- IF XREFPT!= 0 THEN % WE GOT SOME TO LIST OUT %116-17091400
+ IF XREFPT ! 0 THEN % WE GOT SOME TO LIST OUT %116-17091400
BEGIN %116-17091500
WRITE(LINE[DBL],15,PAY[*]); %116-17091510
LINECOUNT := LINECOUNT + 1; %116-17091520
END %116-17091530
ELSE % NOTHING TO LIST OUT %116-17091600
ELSE % NOT END OF SORT %116-17091700
- IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF!= 0 AND 17091800
- A[0].REFIDNOF>= XREFAY1[8].IDNOF THEN %116-17091900
+ IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF ! 0 AND 17091800
+ A[0].REFIDNOF } XREFAY1[8].IDNOF THEN %116-17091900
IF A[0].TYPEREF = FORWARDREF THEN % %116-17092000
WAITINGFORFWDREF := TRUE %116-17092100
ELSE %116-17092200
@@ -12609,50 +12610,50 @@ IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116-17001000
DO %116-17093900
READ(DSK1,10,XREFAY1[*]) [EOF2] %116-17093950
UNTIL %116-17094000
- A[0].REFIDNOF<= XREFAY1[8].IDNOF; %116-17094050
+ A[0].REFIDNOF { XREFAY1[8].IDNOF; %116-17094050
IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN%116-17094100
GO TO SKIP; %116-17094150
IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200
- BEGIN %116-17094240
- IF SINGLTOG THEN %116-17094250
- WRITE(LINE,15,PAY[*]) %116-17094300
- ELSE %116-17094350
- WRITE(LINE[DBL],15,PAY[*]); %116-17094400
- LINECOUNT := LINECOUNT + 1; %116-17094410
- END %116-17094420
- ELSE %116-17094450
- IF NOT SINGLTOG THEN %116-17094500
- WRITE(LINE); %116-17094550
- XREFPT := 0; %116-17094600
- BLANKET(PAY[*]); %116-17094650
- SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8], 17094700
- SEGNOF,A[0],SEQNOF,FWDTOG,LBLTOG, %116-17094800
- FWDSEQNO.IDTYPE[(IF (I := %116-17094900
- XREFAY1[9].CLASS)>= FIELDID THEN %117-17095000
- (IDMAX + I - FIELDID + 1) ELSE %117-17095100
- IF I > IDMAX THEN 0 ELSE I) x 4], %116-17095200
- REAL(I>= BOOID AND XREFAY1[9].[9:2] = 1), 17095300
- REAL((I>= BOOID OR I = LOCLID) AND BOOLEAN 17095310
- (XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 17095320
- FWDTOG := LBLTOG := FALSE; %116-17095400
- WRITE(LINE,15,PAY[*]); %116-17095500
- LINECOUNT := LINECOUNT + 1; %116-17095510
- BLANKET(PAY[*]); %116-17095550
- END %116-17095600
- ELSE % IT MUST BE A NORMAL REFERENCE %116-17095700
- IF A[0].SEQNOF!= LASTADDRESS.SEQNOF THEN %116-17095750
- BEGIN %116-17095800
- ADDASEQNO(A[0],SEQNOF,XREFPT,A[0].[5:1], 17095900
- PAY[*]); %116-17096000
- IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100
- BEGIN %116-17096200
- WRITE(LINE,15,PAY[*]); %116-17096300
- LINECOUNT := LINECOUNT + 1; %116-17096350
- XREFPT := 0; %116-17096400
- BLANKET(PAY[*]); %116-17096450
- END %116-17096500
- END %116-17096550
- ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT %116-17096575
+ BEGIN %116-17094240
+ IF SINGLTOG THEN %116-17094250
+ WRITE(LINE,15,PAY[*]) %116-17094300
+ ELSE %116-17094350
+ WRITE(LINE[DBL],15,PAY[*]); %116-17094400
+ LINECOUNT := LINECOUNT + 1; %116-17094410
+ END %116-17094420
+ ELSE %116-17094450
+ IF NOT SINGLTOG THEN %116-17094500
+ WRITE(LINE); %116-17094550
+ XREFPT := 0; %116-17094600
+ BLANKET(PAY[*]); %116-17094650
+ SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8], 17094700
+ SEGNOF,A[0],SEQNOF,FWDTOG,LBLTOG, %116-17094800
+ FWDSEQNO.IDTYPE[(IF (I := %116-17094900
+ XREFAY1[9].CLASS) } FIELDID THEN %117-17095000
+ (IDMAX + I - FIELDID + 1) ELSE %117-17095100
+ IF I > IDMAX THEN 0 ELSE I) | 4], %116-17095200
+ REAL(I } BOOID AND XREFAY1[9].[9:2] = 1), 17095300
+ REAL((I } BOOID OR I = LOCLID) AND BOOLEAN 17095310
+ (XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 17095320
+ FWDTOG := LBLTOG := FALSE; %116-17095400
+ WRITE(LINE,15,PAY[*]); %116-17095500
+ LINECOUNT := LINECOUNT + 1; %116-17095510
+ BLANKET(PAY[*]); %116-17095550
+ END %116-17095600
+ ELSE % IT MUST BE A NORMAL REFERENCE %116-17095700
+ IF A[0].SEQNOF ! LASTADDRESS.SEQNOF THEN %116-17095750
+ BEGIN %116-17095800
+ ADDASEQNO(A[0],SEQNOF,XREFPT,A[0].[5:1], 17095900
+ PAY[*]); %116-17096000
+ IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100
+ BEGIN %116-17096200
+ WRITE(LINE,15,PAY[*]); %116-17096300
+ LINECOUNT := LINECOUNT + 1; %116-17096350
+ XREFPT := 0; %116-17096400
+ BLANKET(PAY[*]); %116-17096450
+ END %116-17096500
+ END %116-17096550
+ ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT %116-17096575
ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 17096600
ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 17096700
EOF2: B2 := TRUE; % SO SORT CAN GO TO NORMAL EOJ %116-17096800
diff --git a/SYMBOL/ALGOL.txt b/SYMBOL/ALGOL.txt
deleted file mode 100644
index ddf281d..0000000
--- a/SYMBOL/ALGOL.txt
+++ /dev/null
@@ -1,12696 +0,0 @@
-$SET OMIT LISTA = LIST %121- 00000999
-%####################################################################### 00001000
-% 00001010
-% B-5700 ALGOL/TSPOL SYMBOLIC 00001020
-% MARK XVI.0.122 %123- 00001030
-% MAY 9, 1977 %123- 00001040
-% 00001050
-%####################################################################### 00001060
-% 00001070
- COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00001072
- * FILE ID: SYMBOL/ALGOL TAPE ID: SYMBOL1/FILE000 * 00001073
- * THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00001074
- * AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00001075
- * EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00001076
- * WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00001077
- * BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00001078
- * * 00001079
- * COPYRIGHT (C) 1965, 1971, 1972, 1974 * 00001080
- * BURROUGHS CORPORATION * 00001081
- * AA759915 AA320206 AA393180 AA332366 *; 00001082
-COMMENT################################################################# 00001110
- ERROR MESSAGES 00001120
-######################################################################## 00001130
-% 00001140
-ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000
- 000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000
- 001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000
- 002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000
- IDENTIFIER NOT APPEARING IN 00006000
- FORMAL PARAMETER PART. 00007000
- 003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000
- LIST OF DECLARATION. 00009000
- 004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000
- PRECEDED BY ILLEGAL DECLARATOR. 00011000
- 005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000
- BY ILLEGAL DECLARATOR. 00013000
- 006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000
- IN SAME BLOCK(NOT FORWARD). 00015000
- 007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000
- BY ( OR SEMICOLON IN PROCEDURE 00017000
- DECLARATION. 00018000
- 008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000
- BY ). 00020000
- 009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000
- BY SEMICOLON. 00022000
- 010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000
- WHICH DID NOT APPEAR IN FORMAL 00024000
- PARAPART. 00025000
- 011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000
- 012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000
- PART. 00028000
- 013 PROCEDUREDEC: OWN, SAVE, OR AUXMEM USED IN 00029000
- ARRAY SPECIFICATION. 00029500
- 014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00030000
- 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00030500
- 00031000
- 016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00032000
- BY [ . 00033000
- 017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00034000
- FOLLOWED BY : . 00035000
- 018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00036000
- 019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00037000
- ARRAY SPECIFICATION. 00038000
- 020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00039000
- IDENTIFIER(NO TYPE). 00040000
- 021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00041000
- IDENTIFIER(NO TYPE). 00042000
- 022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00043000
- IDENTIFIER(THE WORD PROCEDURE LEFT 00044000
- OUT). 00045000
- 023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00046000
- ANOTHER DECLARATOR. 00047000
- 024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00048000
- 025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00049000
- PRECEDED BY OWN OR SAVE OR SOME 00050000
- OTHER DECLARATOR. 00051000
- 026 FILEDEC: MISSING ( IN FILE DEC. 00052000
- 027 FILEDEC: MISSING RECORD SIZE. 00053000
- 00054000
- 028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000
- IN FILE DEC. 00056000
- 029 FILEDEC: MISSING ) IN FILE DEC. 00057000
- 030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00058000
- 00059000
- 031 LISTDEC: MISSING ( IN LISTDEC. 00060000
- 032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000
- 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE _ OR 00062000
- FORWARD AFTER IDENTIFIER. 00063000
- 034 SWITCHFILEDEC:MISSING _ AFTER FILED. 00064000
- 035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00065000
- OF SWITCHFILE. 00066000
- 036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY _ . 00067000
- 037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00068000
- 038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00069000
- 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100
- 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200
- 041 HANDLESWLIST: MISSING _ AFTER SWITCH LIST ID. 00069300
- 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400
- 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500
- 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600
-045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00069700
-046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800
-047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900
- 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910
- 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920
- 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930
- 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931
- ACTUAL DECLARATION 00069932
- 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933
- IDENTIFIER. 00069934
- 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938
- 060 FAULTSTMT: MISSING _ IN FAULT STATEMENT. 00069940
- 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950
- INTOVR, OR INDEX. 00069960
- 070 CASESTMT: MISSING BEGIN. 00069970
- 071 CASESTMT: MISSING END. 00069980
- 080 PRIMARY: MISSING COMMA . 00069990
- 090 PARSE: MISSING LEFT BRACKET 00069991
- 091 PARSE: MISSING COLON 00069992
- 092 PARSE: ILLEGAL BIT NUMBER 00069993
- 093 PARSE: FIELD SIZE MUST BE LITERAL 00069994
- 094 PARSE: MISSING RIGHT BRACKET 00069995
- 095 PARSE: ILLEGAL FIELD SIZE 00069996
- 100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000
- 101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000
- IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL 00072000
- TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000
- AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000
- 102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000
- 103 PRIMARY: PRIMARY MAY NOT BEING WITH A QUANTITY OF THIS 00076000
- TYPE. 00077000
- 104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00078000
- 105 ANYWHERE: MISSING LEFT PARENTHESIS. 00079000
- 106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00080000
- 107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00081000
- 108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00082000
- AS THE ARITHMETIC EXPRESSIONS. 00083000
- 109 BOOSEC,SIMBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00084000
- 110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00085000
- EXPRESSION. 00086000
- 111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00087000
- TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00088000
- 112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00089000
- TIONAL) MAY BEGIN WITH A DECLARATOR. 00090000
- 113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00091000
- A CONCATENATE OPERATOR IS INCORRECT. 00092000
- 114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS 00093000
- FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00094000
- 115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE 00095000
- 116 IFCLAUSE: MISSING THEN. 00096000
- 117 BANA: MISSING LEFT BRAKET. 00097000
- 118 BANA: MISSING RIGHT BRAKET. 00098000
- 119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00099000
- 120 COMPOUNDTAIL: MISSING END. 00100000
- 121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00101000
- ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00102000
- PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00103000
- METER. 00104000
- 122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00105000
- EXPRESSION PASSED TO IT BY NAME. 00106000
- 123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00107000
- AGREE AS TO TYPE. 00108000
- 124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME 00109000
- 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 A 00115000
- 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 THIS 00147000
- PROCEDURE. 00148000
- 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000
- STREAM PROCEDURES. 00150000
- 151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000
- 152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000
- 153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000
- 154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000
- 155 IFEXP: MISSING ELSE 00155000
- 156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST 00156000
- ELEMENT. 00157000
- 157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00158000
- 158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00159000
- 159 PROCSTMT: ILLEGAL USE OF PROCEDURE OF FUNCTION IDENTIFIER 00160000
- 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000
- 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000
- 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500
- 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000
- 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000
- 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100
- 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720
- DECLARATION. 00164725
- 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730
- AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735
- 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740
- PARAMETRIC DEFINE INVOCATION. 00164745
- 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750
- 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00164850
- VARIABLE, OR A TYPE PROCEDURE IDENTIFIER. 00164851
- 199 E: INFO ARRAY HAS OVERFLOWED. 00164900
- 200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00165000
- 201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00166000
- IN A LEFT PART LIST. 00167000
- 202 SIMPLE VARIABLE: MISSING . OR _ . 00168000
- 203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000
- DESIGNATOR. 00170000
- 204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00171000
- 205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000
- AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00173000
- 206 SUBSCRIPTED VARIABLE: MISSING ]. 00174000
- 207 SUBSCRIPTED VARIABLE: MISSING [. 00175000
- 208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00176000
- 209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00177000
- MOST IN A LEFT PART LIST. 00178000
- 210 SUBSCRIPTED VARIABLE: MISSING , OR _ . 00179000
- 211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART. 00180000
- 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100
- PARAMETER ONLY. 00180200
- 250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00181000
- 251 ANY STREAM STMT PROCEDURE: MISSING _. 00182000
- 252 INDEX: MISSING + OR - . 00183000
- 253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000
- 254 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 00185000
- 255 DSS: MISSING STRING IN DS_ LIT STATEMENT. 00186000
- 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000
- A FORMAL PARAMETER. 00188000
- 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000
- NEXT LEVEL AS A PRECEDING APPEARANCE OF THE 00190000
- LABEL. 00191000
- 258 LABELS: MISSING :. 00192000
- 259 LABELS: LABEL APPEARS MORE THAN ONCE. 00193000
- 260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00194000
- 261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00195000
- 262 NESTS: MISSING PARENTHESIS. 00196000
- 263 IFS:MISSING SC IN IF STATEMENT. 00197000
- 264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00198000
- 265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00199000
- 266 IFS: MISSING THEN INIF STATEMENT. 00200000
- 267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00201000
- UNDEFINED. 00202000
- 268 EMITO: A REPEAT INDEX>= 64 WAS SPECIFIED OR TOO MANY 00203000
- FORMAL PARAMETERS,LOCALS AND LABELS. 00204000
- 269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00205000
- OR TOO SMALL. 00206000
- 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00206100
- 271 IFS: IMPROPER CONSTRUCT FOR . 00206200
- 281 DBLSTMT: MISSING (. 00207000
- 282 DBLSTMT: TOO MANY OPERATORS. 00208000
- 283 DBLSTMT: TOO MANY OPERANDS. 00209000
- 284 DBLSTMT: MISSING , . 00210000
- 285 DBLSTMT: TOO FEW OPERANDS. 00211000
- 286 DBLSTMT: ILLEGAL PARAMETER . 00211100
- 290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00211510
- 291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE 00211520
- 292 FILEATTRIBUTEHANDLER: MISSING _ IN FILE ATTR ASSIGN STMT 00211530
- 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540
- 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550
- 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551
- IN A LEFT PART LIST. 00211552
- 300 FILLSTMT: THE IDENTIFIER FOLLOWING "FILL" IS NOT 00212000
- AN ARRAY IDENTIFER. 00213000
- 301 FILLSTMT: MISSING "WITH" IN FILL STATEMENT. 00214000
- 302 FILLSTMT: IMPROPER FILL ELEMENT. 00215000
- 303 FILLSTMT: NON-OCTAL CHARACTER IN OCTAL FILL. 00216000
- 304 FILLSTMT: IMPROPER ARRAY ROW DESIGNATOR IN FILL. 00217000
- 305 FILLSTMT: DATA IN FILL EXCEEDS 1023 WORDS. 00218000
-304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00218100
- 306 FILLSTMT: ODD NUMBER OF PARENTHESES IN FILL. 00218110
- 307 WHIPOUT: FORMAT > 1023 WORDS. 00218112
- 350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00218200
- SORT OR MERGE STATEMENT. 00218210
- 351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00218220
- 352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00218230
- NOT HAVE EXACTLY TWO PARAMETERS. 00218240
- 353 OUTPROCHECK: FIRST PAREMETER OF OUTPUT PROCEDURE MUST 00218250
- BE BOOLEAN. 00218260
- 354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00218270
- ONE-DIM ARRAY. 00218280
- 355 SORTSTMT: MISSING (. 00218290
- 356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO 00218300
- 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 ARRAY 00218380
- 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390
- 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400
- PARAMETER. 00218410
- 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420
- 366 SORTSTMT: MISSING ). 00218430
- 367 MERGESTMT: MISSING (. 00218440
- 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450
- 369 MERGESTMT: MISSING ). 00218460
- 381 CMPLXSTMT: MISSING (. 00218500
- 382 CMPLXSTMT: TOO MANY OPERATORS. 00218505
- 383 CMPLXSTMT: TOO MANY OPERANDS. 00218510
- 384 CMPLXSTMT: MISSING , . 00218515
- 385 CMPLXSTMT: TOO FEW OPERANDS. 00218520
- 386 CMPLXSTMT: ILLEGAL PARAMETER. 00218525
- 400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00219000
- 401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00220000
- 402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00221000
- 403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00222000
- MONITOR LIST ELEMENT. 00223000
- 404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00224000
- ELEMENT. 00225000
- 405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00226000
- 406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00227000
- 407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION. 00228000
- 408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00229000
- 409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00230000
- 410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00231000
- 411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF 00232000
- SUBSCRIPTS. 00233000
- 412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF 00234000
- 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 DESIGNATOR 00280000
- IN A WRITE STATEMENT. 00281000
- 446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00282000
- 447 WRITESTMT:IMPROPER DELIMITER PRECEEDING IN 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 STATEMETN. 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 PART 00304000
- OF A PROCEDURE. 00305000
- 465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003
- SIMPLE VARIABLE 00305004
- 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010
- 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020
- 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030
- 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040
- 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050
- 505 SEARCHLIB: MISSING BRACKET. 00305060
- 00305070
- 507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080
- 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00305100
- 520 TABLE: STRING LONGER THAN ONE WORD (48 BITS). 00306200
- 521 TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER. 00306300
- 600 DOLLARCARD: NUMBER EXPECTED. 00400000
- 601 DOLLARCARD: OPTION IDENTIFIER EXPECTED. 00401000
- 602 DOLLARCARD: TOO MANY USER-DEFINED OPTIONS. 00403000
- 603 DOLLARCARD: UNRECOGNIZED WORD OR CHARACTER. 00404000
- 604 DOLLARCARD: MISMATCHED PARENTHESES. 00405000
- 610 READACARD: SEQUENCE ERROR. 00410000
- 611 READACARD: ERROR LIMIT HAS BEEN EXCEEDED. 00411000
- 612 INCLUDECARD: TOOMANY NESTED INCLUDES. %107- 00412000
- 613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. %107- 00413000
- 614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. %107- 00414000
- 615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. %107- 00415000
- 616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD %107- 00416000
- 617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00417000
- 618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00418000
- ; 00490000
- $POP OMIT LISTA %121- 00499999
-BEGIN COMMENT OUTERMOST BLOCK; 00500000
- INTEGER ERRORCOUNT; COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00501000
- SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00502000
- INTEGER SAVETIME; COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00503000
- IF COMPILER & GO =0.FOR SYNTAX, =-1. MUST BE AT R+26; 00504000
- INTEGER CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00504100
- INTEGER CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00504150
- INTEGER LASTADDRESS; 00504200
- ARRAY ENIL[0:7,0:127]; 00504300
- INTEGER ENILPTR; 00504400
- DEFINE ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]]#; 00504500
- ARRAY LDICT[0:7,0:127]; 00504600
- BOOLEAN BUILDLINE; 00504700
- BOOLEAN REL; 00504801
- COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00505000
- TO SAVE SOME STACK SPACE; 00506000
- REAL RR1,RR2,RR3,RR4,RR5,RR6,RR7,RR8,RR9,RR10,RR11; 00507000
- COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00508000
- THE MAIN BLOCK; 00509000
- COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00510000
- REAL STREAM PROCEDURE EXAMIN(NCR); VALUE NCR; 00511000
- BEGIN SI_NCR; DI_LOC EXAMIN; DI_DI+7; DS_CHR END; 00512000
- REAL STREAM PROCEDURE EXAMINELAST(AC, CT); VALUE CT; 00512100
- BEGIN 00512200
- SI _ AC; SI _ SI + CT; 00512300
- DI _ LOC EXAMINELAST; DI _ DI+7; 00512400
- DS _ 1 CHR; 00512500
- END EXAMINELAST; 00512600
- COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00513000
- IN SORCE TO THE DK-TH CHARACTER IN DEST, 0<=N<=63,0<=SK<=127; 00514000
- DEFINE DK=DSK#; 00514500
- STREAM PROCEDURE MOVECHARACTERS(N,SORCE,SK,DEST,DSK); 00515000
- VALUE N, SK, DSK ; 00516000
- BEGIN SI_LOC SK; SI_SI+6; 00517000
- IF SC!"0" THEN BEGIN SI_SORCE; 2(SI_Si+32); SORCE_SI END; 00518000
- SI_LOC DK; SI_SI+6; DI_DEST; 00519000
- IF SC!"0" THEN 2(DI_DI+32); 00520000
- SI_SORCE; SI_SI+SK; DI_DI+DK; DS_N CHR; 00521000
- END MOVECHARACTERS; 00522000
- INTEGER STREAM PROCEDURE GETF(Q); VALUE Q; 00523000
- BEGIN SI_LOC GETF; SI_SI+7; DI_LOC Q; DI_DI+5; 00524000
- SKIP 3 DB; 9(IF SB THEN DS_SET ELSE DS_RESET; SKIP SB); 00525000
- DI_LOC Q; SI_Q; DS_WDS; SI_Q; GETF_SI 00526000
- END GETF; 00527000
- COMMENT START SETTING UP FILE PARAMETERS; 00528000
- IF EXAMIN(RR11_GETF(3)+"Y08" )!12 THEN RR1_5 ELSE 00529000
- BEGIN RR1_2; RR2_150END; 00530000
- IF EXAMIN(RR11+5)!12 THEN RR3_4 ELSE 00531000
- BEGIN RR3_2; RR4_150END; 00532000
- IF EXAMIN(RR11+10)!12 THEN 00533000
- BEGIN RR5_2; RR6_10; RR7_150END ELSE 00534000
- BEGIN RR5_1; RR6_56; RR7_10 END; 00535000
- IF EXAMIN(RR11+15)=12 THEN 00536000
- BEGIN RR8_10; RR9_150END ELSE 00537000
- BEGIN RR8_56; RR9_10 END; 00538000
- IF EXAMIN(RR11+20)=12 THEN RR10_150; 00539000
- BEGIN 01000000
- 01000100
- 01000200
- 01000300
- 01000400
- 01000500
- 01000600
- INTEGER NUMSEQUENCEERRORS; 01000700
- INTEGER OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01000800
- BOOLEAN SETTING; % USED BY DOLLARCARD FOR AN OPTIONS SETTING 01000802
- BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810
- PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830
- BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840
- % EVALUATING AN ARRAY BOUND 01000850
- INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860
- COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870
- BASENUM IS STARTING VALUE 01000880
- TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890
- CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900
- DEFINE OPARSIZE = 200 #; 01000902
- ARRAY OPTIONS[0:OPARSIZE]; 01000904
- BOOLEAN OPTIONWORD; 01000910
- DEFINE CHECKBIT = 1#, 01000920
- DEBUGBIT = 2#, 01000930
- DECKBIT = 3#, 01000940
- FORMATBIT = 4#, 01000950
- INTBIT = 5#, 01000960
- LISTABIT = 6#, 01000970
- LISTBIT = 7#, 01000980
- LISTPBIT = 8#, 01000990
- MCPBIT = 9#, 01001000
- MERGEBIT = 10#, 01001010
- NESTBIT = 11#, 01001020
- NEWBIT = 12#, 01001030
- NEWINCLBIT = 13#, 01001040
- OMITBIT = 14#, 01001050
- PRINTDOLLARBIT = 15#, 01001060
- PRTBIT = 16#, 01001070
- PUNCHBIT = 17#, 01001080
- PURGEBIT = 18#, 01001090
- SEGSBIT = 19#, 01001100
- SEQBIT = 20#, 01001110
- SEQERRBIT = 21#, 01001120
- SINGLBIT = 22#, 01001130
- STUFFBIT = 23#, 01001140
- VOIDBIT = 24#, 01001150
- VOIDTBIT = 25#, 01001160
- XREFBIT = 26#, 01001170
- BENDBIT = 27#, 01001171
- CODEFILEBIT = 29#, %106- 01001172
- USEROPINX = 30#, %106- 01001173
- COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01001180
- AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01001190
- FILL STATEMENT IN INITIALIZATION OF COMPILER; 01001200
- DEFINE CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01001210
- DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01001220
- DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01001230
- FORMATTOG = OPTIONWORD.[FORMATBIT:1] #, 01001240
- INTOG = OPTIONWORD.[INTBIT:1] #, 01001250
- LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01001260
- LISTOG = OPTIONWORD.[LISTBIT:1] #, 01001270
- LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01001280
- MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01001290
- MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01001300
- NESTTOG = OPTIONWORD.[NESTBIT:1] #, 01001310
- NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01001320
- NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01001330
- OMITTING = OPTIONWORD.[OMITBIT:1] #, 01001340
- PRINTDOLLARTOG = OPTIONWORD.[PRINTDOLLARBIT:1] #, 01001350
- PRTOG = OPTIONWORD.[PRTBIT:1] #, 01001360
- PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01001370
- PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01001380
- SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01001390
- SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01001400
- COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01001410
- SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01001420
- SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01001430
- STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01001440
- VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01001450
- VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01001460
- XREF = OPTIONWORD.[XREFBIT:1] #, 01001461
- BEND = OPTIONWORD.[BENDBIT:1] #, 01001462
- CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, %106- 01001463
- DUMMY = #; 01001470
- BOOLEAN NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01001480
- BOOLEAN NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01001490
- BOOLEAN LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01001500
- % LAST CARD FROM SYMBOLIC LIBRARY READ 01001510
- % IS PATCHED FROM THE CARD READER. 01001520
- INTEGER XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01001530
- BOOLEAN DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01001540
- INTEGER ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01001550
- BOOLEAN SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01001560
- BOOLEAN LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01001570
- ALPHA MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01001580
- INTEGER MYCLASS; % USED IN DOLLARCARD EVALUATION. 01001590
- REAL BATMAN; % USED IN DOLLARCARD EVALUATION. 01001600
- ARRAY SPECIAL[0:31]; 01003000
- COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01004000
- CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01005000
- SAVE ALPHA ARRAY IDARRAY[0:127]; 01006000
- ARRAY INFO[0:31,0:255]; 01007000
-%*********************************************************************** 01007005
-% X R E F S T U F F %116- 01007010
-%*********************************************************************** 01007015
-% %116- 01007020
-ARRAY %116- 01007025
- XREFAY2[0:29], % ARRAY OF ONE WORD REFERENCE RECORDS. %116- 01007030
- % THE LAYOUT OF EACH WORD IS %116- 01007035
- % %116- 01007040
- % .[1:5] TYPE OF REFERENCE %116- 01007045
- % = 0 FOR FORWARD DECL %116- 01007050
- % = 1 FOR LABEL OCCURENCE %116- 01007051
- % = 2 FOR NORMAL DECL %116- 01007055
- % = 4 FOR NORMAL REFERENCE %116- 01007060
- % = 5 FOR ASSIGNMENT %116- 01007065
- % %116- 01007070
- % NOTE: THE LOWER ORDER BIT 01007075
- % OF THIS FIELD IS ON 01007080
- % IF YOU WANT STARS %116- 01007085
- % AROUND THIS REFERENCE 01007090
- % IN THE XREF %116- 01007095
- % %116- 01007100
- % .[6:16] IDENTIFIER ID. NO. %116- 01007105
- % THIS IS A UNIQUE NUMBER THAT 01007110
- % IS ASSIGNED WHEN THE %116- 01007115
- % IDENTIFIER IS ENCOUNTERE %116- 01007120
- % FOR THE FIRST TIME. %116- 01007125
- % %116- 01007130
- % .[21:27] SEQUENCE NUMBER %116- 01007135
- % %116- 01007140
- XREFAY1[0:9], % RECORD BUFFER AREA FOR WRITING OUT THE %116- 01007145
- % NAME INFORMATION RECORDS, ONE RECORD %116- 01007150
- % IS WRITTEN FOR EACH IDENTIFIER IN THE SYMBOL 01007155
- % TABLE WHEN THE IDENTIFIER IS PURGED FROM THE 01007160
- % SYMBOL TABLE, I.E., WHEN LEAVING THE BLOCK%116- 01007165
- % IN WHICH THE IDENTIFIER IS DECLARED. %116- 01007170
- % %116- 01007175
- % THE LAYOUT OF EACH IS: %116- 01007180
- % %116- 01007185
- % WORDS 0-7 THE IDENTIFIER WITH BLANK%116- 01007190
- % FILE ON THE RIGHT %116- 01007195
- % %116- 01007200
- % WORD 8 %116- 01007205
- % .[21:12] SEGMENT NUMBER IN WHICH %116- 01007210
- % THIS IDENTIFIER WAS DECLARED 01007215
- % %116- 01007220
- % .[33:15] IDENTIFIER ID. NO. %116- 01007225
- % %116- 01007230
- % WORD 9 ELBAT WORD %116- 01007235
- % %116- 01007240
- XINFO[0:31,0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 01007245
- % IN THE INFO TABLE. IF YOU HAVE THE INDEX %116- 01007250
- % OF THE ELBAT WORD FOR AN IDENTIFIER IN %116- 01007255
- % THE INFO TABLE YOU CAN FIND THE XINFO WORD%116- 01007260
- % FOR THE IDENTIFIER BY REFERRING TO: %116- 01007265
- % %116- 01007270
- % XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] %116- 01007275
- % %116- 01007280
- % EACH ENTRY CONTAINS: %116- 01007285
- % %116- 01007290
- % .[21:12] SEGMENT NUMBER IN WHICH 01007295
- % THIS IDENTIFIER WAS DECL 01007300
- % %116- 01007305
- % .[33:15] IDENTIFIER ID. NO. %116- 01007310
- % IF THIS ID. NO. IS ZERO 01007315
- % THEN XREF WAS NOT ON 01007320
- % AT THE TIME THE IDENT 01007325
- % WAS DECLARED AND ALL 01007330
- % FUTURE REFERENCES WILL 01007335
- % BE DISCARDED. %116- 01007340
- % %116- 01007345
- INTEGER % %116- 01007350
- XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN %116- 01007355
- % XREFAY2, WHEN THIS BECOMES GREATER %116- 01007360
- % THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365
- % AND XREFPT IS RESET TO ZERO. %116- 01007370
- % %116- 01007375
- XLUN, % THIS VARIABLE CONTROLS THE ASSIGNING OF %116- 01007380
- % ID. NO. TO IDENTIFIERS. IT IS INCREMENTED %116- 01007385
- % EACH TIME A NEW IDENTIFIER IS ENCOUNTERED.%116- 01007390
- % %116- 01007395
-DEFINE % %116- 01007400
- SEGNOF = [21:12]#, % FIELDS IN XINFO ENTRIES AND WORD 8 OF %116- 01007405
- IDNOF = [33:15]#, % IDENTIFIER RECORDS. %116- 01007410
- % %116- 01007415
- TYPEREF = [1:5]#, % FIELDS OF REFERENCE WORDS %116- 01007420
- REFIDNOF =[6:15]#, % %116- 01007425
- SEQNOF = [21:27]#, % %116- 01007430
- % %116- 01007435
- XREFIT(INDEX,SEQNO,REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE %116- 01007440
- BEGIN IF XREF THEN CROSSREFIT(INDEX,SEQNO,REFTYPE); END#, %116- 01007445
- % %116- 01007450
- XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 01007455
- BEGIN IF XREF THEN XREFAY2[XREFPT-1].TYPEREF := REFTYPE END#, %116- 01007460
- % %116- 01007465
- XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER 01007470
- BEGIN IF DEFINING.[1:1] THEN CROSSREFDUMP(INDEX); END#, %116- 01007475
- % %116- 01007480
- XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO%116- 01007481
- XINFO[(INDEX),LINKR,(INDEX).LINKC DIV 2]#, % XINFO ROW AND COL %116- 01007482
- % %116- 01007483
- FORWARDREF = 0#, % DEFINES FOR DIFFERENCE REFERENCE TYPES %116- 01007485
- LBLREF = 1#, % %116- 01007486
- DECLREF = 2#, % %116- 01007490
- NORMALREF = 4#, % %116- 01007495
- ASSIGNREF = 5#, % %116- 01007500
- ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600
- BOOLEAN DEFINING; 01007650
- COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000
- OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000
- THE INTERNAL CODE (OR ELBAT WORD AS IT IS USUALLY 01010000
- CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000
- [1:1]) FOR PROCEDURES. THE LINK TO PREVIOUS ENTRY (IN 01012000
- [4:8]). THE NUMBER OF CHARACTERS IN THE ALPHA REPRESENTA- 01013000
- TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 01014000
- SUCCEDING WORDS CONTAIN THE REMAINING CHARACTERS OF ALPHA, 01015000
- FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000
- AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLUT ACROSS A ROW 01017000
- OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 01018000
- RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 01019000
- DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY 01020000
- IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000
- OF CHARACTORS AND AAAAAIS HTE FIRST 5 CHARACTORS OF 01022000
- ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000
- THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000
- THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000
- RESERVED WORDS OCCUPY THE SECOND ROW, IT IS FILLED DURING 01026000
- INITIALIZATION; 01027000
-COMMENT INFO FORMAT 01028000
- FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000
- ENTERED IN INFO: 01030000
- THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000
- THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000
- ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000
- ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000
- E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR),LINKR,(IX+INCR). 01035000
- LINKC) WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000
- THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000
- THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000
- POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000
- THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.. THE 01040000
- LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000
- FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000
- ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000
- WILL NOT DETRACT FROM THE DISCUSSION. 01044000
- ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000
- THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000
- FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000
- THIS STACKHEAD INDEX, LET THIS STACKHEAD LOCATION BE 01048000
- S[L] 01049000
- NOW THE DECLARATION 01050000
- BEGIN REAL A,B,C IS ENCOUNTERED 01051000
- IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000
- THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000
- CONSTRUCTED FOR A) 01054000
- T.LINK_ S[L], (WHICH IS ZERO AT FIRST), 01055000
- INFO[NEXTINFO]_T, S[L]_NEXTINFO, 01056000
- NEXTINFO_NEXTINFO+NUMBER OF WORDS IN THIS 01057000
- ENTRY. 01058000
- NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000
- ITSELF CONTAINS THE STOP FLAG ZERO 01060000
- B IS ENTERED SIMILARLY TO A. 01061000
- NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000
- ENTRY FOR A. 01063000
- SIMILARLY,AFTER C IS ENTERED 01064000
- A[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 01065000
- POINTS TO A. 01066000
- THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 01067000
- FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 01068000
- FORWARD,IT IS RESET AT THE TIME OF ITS ACTUAL 01069000
- FULL DECLARATION. 01070000
- PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 01071000
- INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBSTRACTED 01072000
- FROM THE CURRENT ENTRY INDEX. 01073000
- [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY,(<64) 01074000
- [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 01075000
- AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 01076000
- THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 01077000
- THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 01078000
- FOR X WOULD APPEAR AS FOLLOWS: 01079000
- INFO[I] = ELBATWRD (MADE FOR SYMBOL) 01080000
- I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 01081000
- I+2 = L 01082000
- I+3 = ELBATWRD (MADE FOR X) 01083000
- I+4 = O31X 01084000
- THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 01085000
- THE ENTRY BEFORE SYMBOL, AND 01086000
- INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 01087000
- ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 01088000
- THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 01089000
- FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 01090000
- NECESSARY. 01091000
- THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 01092000
- REAL 01093000
- BOOLEAN 01094000
- INTEGER 01095000
- ALPHA 01096000
- FILE 01097000
- FORMAT 01098000
- LIST 01099000
- OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 01100000
- ARRAYS: 01101000
- THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01102000
- DIMENSIONS(IN THE LOW ORDER PART),[40:8] 01103000
- EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 01104000
- BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 01105000
- THESE WORDS ARE MADE UP AS FOLLOWS: 01106000
- [23:12] =ADD OPERATOR SYLLABLE (0101) OR 01107000
- SUB OPERATOR SYLLABLE (0301) CORRESPONDING 01108000
- RESPECTIVELY TO WHETHER THE LOWER BOUND IS 01109000
- TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 01110000
- SUBTRACTED. 01111000
- [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 01112000
- REQUIRES A PRT OR STACK CELL.OTHERWISE THE BIT 01113000
- 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 01114000
- REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 01115000
- [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 01116000
- IS A LITERAL OR OPERAND,RESPECTIVELY. 01117000
- PROCEDURES: 01118000
- THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 01119000
- PARAMETERS [40:8] 01120000
- IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 01121000
- [13:11] ENDING PRT ADDRESS FOR LABELS. 01122000
- [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 01123000
- OF LOCALS. 01124000
- SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 01125000
- OF APPEARANCE IN FORMAL PARAPART) ARE 01126000
- ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 01127000
- VALUE OR NOT([10:1]). 01128000
- THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 01129000
- IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 01130000
- CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 01131000
- LINK([35:13]) IS MEANINGLESS. 01132000
- IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 01133000
- THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE 01134000
- 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 IS 01140000
- 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 01141000
- SWITCHES: 01142000
- THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 01143000
- ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 01144000
- IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 01145000
- NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ; 01146000
- DEFINE MON =[ 1: 1]#, 01147000
- CLASS =[ 2: 7]#, 01148000
- FORMAL=[ 9: 1]#, 01149000
- VO =[10: 1]#, 01150000
- LVL =[11: 5]#, 01151000
- ADDRESS=[16:11]#, 01152000
- INCR =[27: 8]#, 01153000
- LINK =[35:13]#, 01154000
- DYNAM =[11:16]#, 01154100
- SBITF =[21: 6]#, % STARTING BIT FOR FIELD ID. %117- 01154200
- NBITF =[27: 6]#, % NUMBER OF BITS FOR FIELD ID.%117- 01154300
- LINKR =[35: 5]#, 01155000
- LINKC =[40: 8]#; 01156000
- COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD, 01157000
- MON IS THE BIT WHICH IS TURNED ON IF: 01158000
- 1. THE QUANTITY IS TO BE MONITORED, OR 01158100
- 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 01158200
- A DEFINE WITHOUT PARAMETERS. 01158300
- CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 01159000
- QUANTITY. 01160000
- FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 01161000
- PARAMETER. 01162000
- V0 IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 01163000
- DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 01164000
- FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 01165000
- FROM OTHERS. 01166000
- LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 01167000
- ADDRESS GIVES THE STACK OR PRT ADDRESS. 01168000
- DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 01168100
- DEFINE PARAMETER ENTRIES, ONLY, IT IS AN INDEX 01168200
- INTO THE ARRAY CONTAINING THE DEFINE TEXT. 01168300
- THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 01168400
- DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 01168500
- NOT USE THE LVL FIELD, BUT MAKES USE OF NINF00 01168600
- INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION 01169000
- NEEDED, RELATIVE TO THE LOCATION IN INFO. 01170000
- LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE 01171000
- QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE 01172000
- NEXT ITEM IN THE STACK, ZERO IS AN END FLAG. 01173000
- LINKR AND LINKC ARE SUBDIVISIONS OF LINK.; 01174000
- COMMENT CLASSES FOR ALL QUANTITIES - OCTAL CLASS IS IN COMMENT; 01175000
- COMMENT CLASSES FOR IDENTIFIERS; 01176000
- DEFINE UNKNOWNID =00#, COMMENT 000; 01177000
- STLABID =01#, COMMENT 001; 01178000
- LOCLID =02#, COMMENT 002; 01179000
- DEFINEID =03#, COMMENT 003; 01180000
- LISTID =04#, COMMENT 004; 01181000
- FRMTID =05#, COMMENT 005; 01182000
- SUPERFRMTID =06#, COMMENT 006; 01183000
- FILEID =07#, COMMENT 006; 01184000
- SUPERFILEID =08#, COMMENT 007; 01185000
- SWITCHID =09#, COMMENT 011; 01186000
- PROCID =10#, COMMENT 012; 01187000
- INTRNSICPROCID =11#, COMMENT 013; 01188000
- STRPROCID =12#, COMMENT 014; 01189000
- BOOSTPROCID =13#, COMMENT 015; 01190000
- REALSTRPROCID =14#, COMMENT 016; 01191000
- ALFASTRPROCID =15#, COMMENT 017; 01192000
- INTSTRPROCID =16#, COMMENT 020; 01193000
- BOOPROCID =17#, COMMENT 021; 01194000
- REALPROCID =18#, COMMENT 022; 01195000
- ALFAPROCID =19#, COMMENT 023; 01196000
- INTPROCID =20#, COMMENT 024; 01197000
- BOOID =21#, COMMENT 025; 01198000
- REALID =22#, COMMENT 026; 01199000
- ALFAID =23#, COMMENT 027; 01200000
- INTID =24#, COMMENT 030; 01201000
- BOOARRAYID =25#, COMMENT 031; 01202000
- REALARAYID =26#, COMMENT 032; 01203000
- ALFARRAYID =27#, COMMENT 033; 01204000
- INTARRAYID =28#, COMMENT 034; 01205000
- LABELID =29#, COMMENT 035; 01206000
- COMMENT CLASSES FOR PRIMARY BEGINNERS; 01207000
- TRUTHV =30#, COMMENT 036; 01208000
- NONLITNO =31#, COMMENT 037; 01209000
- LITNO =32#, COMMENT 040; 01210000
- STRNGCON =33#, COMMENT 041; 01211000
- LEFTPAREN =34#, COMMENT 042; 01212000
- COMMENT CLASSES FOR ALL DECLARATORS; 01213000
- DECLARATORS =35#, COMMENT 043; 01214000
- COMMENT CLASSES FOR STATEMENT BEGINNERS; 01215000
- READV =36#, COMMENT 044; 01216000
- WRITEV =37#, COMMENT 045; 01217000
- SPACEV =38#, COMMENT 046; 01218000
- CLOSEV =39#, COMMENT 047; 01219000
- LOCKV =40#, COMMENT 050; 01220000
- REWINDV =41#, COMMENT 051; 01221000
- DOUBLEV =42#, COMMENT 052; 01222000
- FORV =43#, COMMENT 053; 01223000
- WHILEV =44#, COMMENT 054; 01224000
- DOV =45#, COMMENT 055; 01225000
- UNTILV =46#, COMMENT 056; 01226000
- ELSEV =47#, COMMENT 057; 01227000
- ENDV =48#, COMMENT 060; 01228000
- FILLV =49#, COMMENT 061; 01229000
- SEMICOLON =50#, COMMENT 062; 01230000
- IFV =51#, COMMENT 063; 01231000
- GOV =52#, COMMENT 064; 01232000
- RELEASEV =53#, COMMENT 065; 01233000
- BEGINV =54#, COMMENT 066; 01234000
- COMMENT CLASSES FOR STREAM RESERVED WORDS; 01235000
- SIV =55#, COMMENT 067; 01236000
- DIQ =56#, COMMENT 070; 01237000
- CIV =57#, COMMENT 071; 01238000
- TALLYV =58#, COMMENT 072; 01239000
- DSV =59#, COMMENT 073; 01240000
- SKIPV =60#, COMMENT 074; 01241000
- JUMPV =61#, COMMENT 075; 01242000
- DBV =62#, COMMENT 076; 01243000
- SBV =63#, COMMENT 077; 01244000
- TOGGLEV =64#, COMMENT 100; 01245000
- SCV =65#, COMMENT 101; 01246000
- LOCV =66#, COMMENT 102; 01247000
- DCV =67#, COMMENT 103; 01248000
- LOCALV =68#, COMMENT 104; 01249000
- LITV =69#, COMMENT 105; 01250000
- TRNSFER =70#, COMMENT 106; 01251000
- COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 01252000
- COMMENTV =71#, COMMENT 107; 01253000
- FORWARDV =72#, COMMENT 110; 01254000
- STEPV =73#, COMMENT 111; 01255000
- THENV =74#, COMMENT 112; 01256000
- TOV =75#, COMMENT 113; 01257000
- VALUEV =76#, COMMENT 114; 01258000
- WITHV =77#, COMMENT 115; 01259000
- COLON =78#, COMMENT 116; 01260000
- COMMA =79#, COMMENT 117; 01261000
- CROSSHATCH =80#, COMMENT 120; 01262000
- LFTBRKET =81#, COMMENT 121; 01263000
- PERIOD =82#, COMMENT 122; 01264000
- RTBRKET =83#, COMMENT 123; 01265000
- RTPAREN =84#, COMMENT 124; 01266000
- COMMENT CLASSES FOR OPERATORS; 01267000
- NOTOP =85#, COMMENT 125; 01268000
- ASSIGNOP =86#, COMMENT 126; 01269000
- AMPERSAND =87#, COMMENT 127; 01270000
- EQVOP =88#, COMMENT 130; 01271000
- IMPOP =89#, COMMENT 131; 01272000
- OROP =90#, COMMENT 132; 01273000
- ANDOP =91#, COMMENT 133; 01274000
- RELOP =92#, COMMENT 134; 01275000
- ADOP =93#, COMMENT 135; 01276000
- MULOP =94#, COMMENT 136; 01277000
- FACTOP =95#, COMMENT 137; 01278000
- STRING =99#, COMMENT 143; 01278050
- FIELDID =125#, COMMENT 175; %117- 01278090
- FAULTID =126#, COMMENT 176; 01278100
- SUPERLISTID =127#, COMMENT 177; 01278500
- COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 01279000
- OWNV =01#, COMMENT 01; 01280000
- SAVEV =02#, COMMENT 02; 01281000
- BOOV =03#, COMMENT 03; 01282000
- REALV =04#, COMMENT 04; 01283000
- ALFAV =05#, COMMENT 05; 01284000
- INTV =06#, COMMENT 06; 01285000
- LABELV =07#, COMMENT 07; 01286000
- DUMPV =08#, COMMENT 10; 01287000
- LISTV =09#, COMMENT 11; 01288000
- OUTV =10#, COMMENT 12; 01289000
- INV =11#, COMMENT 13; 01290000
- MONITORV =12#, COMMENT 14; 01291000
- SWITCHV =13#, COMMENT 15; 01292000
- PROCV =14#, COMMENT 16; 01293000
- ARRAYV =15#, COMMENT 17; 01294000
- FORMATV =16#, COMMENT 20; 01295000
- FILEV =17#, COMMENT 21; 01296000
- STREAMV =18#, COMMENT 22; 01297000
- DEFINEV =19#, COMMENT 23; 01298000
- AUXMEMV =20#, COMMENT 24; %117- 01298500
- FIELDV =21#, COMMENT 25; %117- 01298600
-DEFINE ADES=0#,LDES=2#,PDES=1#,CHAR=3#; 01299000
- REAL TIME1; 01300000
- INTEGER SCRAM; 01301000
- COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 01302000
- OR RESERVED WORD SCANNED; 01303000
- ARRAY FILEATTRIBUTES[0:30] ; 01303500
- ALPHA ARRAY ACCUM[0:10]; 01304000
- COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 01305000
- SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 01306000
- IN INFO. THAT IS ACCUN[1] = 00NAAAAA, ACCUM[I] , I> 1. 01307000
- HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000
- THE ELBAT WORD BY THE ENTER ROUTINES; 01309000
- ARRAY STACKHEAD,SUPERSTACK[0:124]; %WF 01310000
- COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX %WF 01311000
- POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A %WF 01311100
- LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, %WF 01311200
- BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS %WF 01311300
- AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE %WF 01311400
- WORDS POINTED TO (IN THREE GROUPS) ARE: %WF 01311500
- 1) ALPHA, LABEL, OWN, REAL, SAVE %WF 01311600
- 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE %WF 01311700
- 3) BEGIN, DO, ELSE, END, FOR, GO, IF, %WF 01311800
- STEP, THEN, TO, UNTIL, WHILE, WRITE. %WF 01311900
- FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE %WF 01312000
- COMMENTS IN THE TABLE PROCEDURE. ; %WF 01312100
- INTEGER COUNT; 01313000
- COMMENT COUNT CONTAINS THE NUMBER OF CHARACTERS OF THE LAST ITEM 01314000
- SCANNED; 01315000
- ALPHA Q; 01316000
- COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000
- WORD SCANNED; 01318000
- ARRAY ELBAT[0:76]; INTEGER I,NEXTELBT; 01319000
- COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 01320000
- QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 01321000
- (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 01322000
- GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 01323000
- FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 01324000
- POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 01325000
- INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 01326000
- FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 01327000
- INTEGER ELCLASS; 01328000
- COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 01329000
- INTEGER LASTELCLASS; 01329100
- COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 01329200
- INTEGER FCR, NCR, LCR,TLCR,CLCR; 01330000
- INTEGER MAXTCLR; 01331000
- COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTER 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 BUFFIZE = 56#; 01338000
- INTEGER GTIX; 01339050
- ARRAY TEN[0:69]; 01340000
- INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050
- DECLARED IN THE OBJECT PROGRAM; 01340060
- INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070
- GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080
- REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500
- INTEGER IDLOC,IDLOCTEMP; 01341000
- ARRAY PDPRT[0:31,0:63]; 01342000
- COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000
- IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000
- BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000
- OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000
- TYPE 1 ENTRY 01347000
- BIT POSITION KIND OF ENTRY 01348000
- 0-3 ZERO 01349000
- 4 MODE BIT(1=CHAR 0=WORD) 01350000
- 5 ARGUMENT BIT 01351000
- 6-7 ZERO 01352000
- 8-17 RELATIVE ADDRESS IN PRT 01353000
- 18-27 RELATIVE ADDRESS IN SEGMENT 01354000
- 28-37 SEGMENT NUMBER 01355000
- 38-47 ZERO 01356000
- TYPE 2 ENTRY 01357000
- BIT POSITION KIND OF ENTRY 01358000
- 0 EMPTY 01359000
- 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000
- 2 ON IFF INTRINSIC PROCEDURE 01361000
- 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050
- 4-12 EMPTY 01361100
- 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200
- 28-37 SEGMENT NUMBER 01361300
- 38-47 NUMBER OF WORDS IN SEGMENT 01362000
- THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000
- IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000
- ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000
- DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT 01366000
- IS READY FOR OUTPUT; 01367000
- COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010
- COMPILATION IS AS FOLLOWS: 01367020
- SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030
- BIT POSITIONS CONTENTS OF FIELD 01367040
- [0:1] EMPTY 01367050
- [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060
- [2:1] ON IFF INTRINSIC PROCEDURE 01367070
- [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075
- [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080
- [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085
- [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 01367090
- [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100
- [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110
- PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120
- BIT POSITIONS CONTENTS OF FIELD 01367130
- [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. 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[NEXT,NFO] 01382000
- DURING AN ARRAY DECLARATION ; 01383000
- REAL GT1,GT2,GT3,GT4,GT5; 01384000
- INTEGER GTI1; 01384500
- COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000
- INTEGER RESULT; 01386000
- COMMENT THIS VARIALE IS USED FOR A DUAL PURPOSE BY THE TABLE 01387000
- ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 01388000
- VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 01389000
- USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 01390000
- INTEGER LASTUSED; 01391000
- COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 01392000
- READACARD. THE ROUTINE WHICH READS CARDS AND INITIALIZES 01393000
- OR PREPARES THE CARD FOR THE SCANNER. 01394000
- LASTUSED LAST CARD READ FROM 01394500
- -------- ------------------- 01394600
- 1 CARD READ ONLY, NO TAPE. 01395000
- 2 CARD READER, TAPE AND CARD MERGE. 01396000
- 3 TAPE, TAPE AND CARD MERGE. 01397000
- 4 INITIALIZATION ONLY, CARD ONLY. 01398000
- 5 CARD READER - MAKCAST, MERGING. 01398100
- 6 TAPE - MAKCAST, MERGING. 01398200
- ; 01398300
- BOOLEAN LINKTOG; 01399000
- COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK. 01400000
- OTHERWISE IT IS TRUE; 01401000
- INTEGER LEVEL,FRSTLEVEL,SUBLEVEL,MODE; 01402000
- COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 01403000
- TRACK OF LEVELS OF DEFINITION. LEVEL GIVES THE DEPTH OF 01404000
- NESTING IN DEFINITION. WHERE EACH BLOCK AND EACH PROCEDURE 01405000
- 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 GLOBAL DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000
- NESTED (AT COMPILE TIME); 01411000
- INTEGER AUXMEMREQ; 01411010
- BOOLEAN SAVEPRTOG; 01411020
- COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030
- ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040
- AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050
- WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060
- "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070
- TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080
- TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090
- ROUTINE IS "PSEUDO-SAVE". 01411100
- ; 01411110
- BOOLEAN ERRORTOG; 01412000
- COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE 01413000
- ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000
- BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000
- COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000
- BOOLEAN STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500
- % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000
- % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500
- % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000
- % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500
- % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000
- DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000
- FI = 6#, FIO = 7#; 01420500
- COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 01421000
- THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000
- THEIR MEANING IS: 01423000
- FS MEANS FROM STATEMENT. 01424000
- FP MEANS FROM PRIMARY. 01425000
- FL MEANS FROM LIST. 01426000
- FR MEANS FROM FOR. 01427000
- FIO MEANS FROM IODEC. 01427250
- FA MEANS FROM ACTUALPARAPART. 01427500
- FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600
- INTEGER L; 01428000
- COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000
- DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#; 01430000
- COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000
- PROGRAMS. 01432000
- BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000
- BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000
- IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000
- BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS TO 01436000
- 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 THE 01444000
- 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 PROPOER ITEM IN THE LIST. THE FORMATING ROUTINES 01449000
- SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 01450000
- LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 01451000
- DEFINE BTYPE =1#, DTYPE =2#, ATYPE =3#; 01452000
- COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 01453000
- ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 01454000
- BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 01455000
- FOR ARITHMETIC EXPRESSIONS; 01456000
- BOOLEAN TB1; 01457000
- COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE; 01458000
- INTEGER JUMPCTR; 01459000
- COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK 01460000
- AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000
- BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000
- SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000
- MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000
- OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED 01465000
- IF LEVEL = JUMPCTR; 01466000
- BOOLEAN GOTOG; 01467000
- COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 01468000
- LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000
- MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000
- REAL STLB; 01471000
- COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000
- THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000
- ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000
- INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000
- FOR TEMPORARY STORAGE; 01476000
- DEFINE BUMPL = L_L+2#; 01477000
- COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000
- DEFINE IDMAX = LABELID#; 01479000
- COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000
- INTEGER DEFINECTR,DEFINEINDEX; 01481000
- ALPHA ARRAY DEFINFO[0:89]; 01481100
- ALPHA ARRAY TEXT[0:31,0:255]; 01481200
- INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300
- INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400
- REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000
- LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000
- NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS; 01484000
- JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000
- COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000
- ARRAY MACRO[0:35]; 01487000
- COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000
-REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000
- Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000
- SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000
- COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000
- DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE=# PAIRS. 01493000
- THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000
- TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000
- THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000
- ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000
- THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000
- INTEGER BEGINCTR; 01499000
- COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED 01500000
- FOR ERROR CONTROL ONLY; 01501000
- INTEGER DIALA,DIALB; 01502000
- COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 01503000
- DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 01504000
- WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY 01505000
- BY SETTING DIALA AND DIALB TO ZERO; 01506000
- 01507000
- 01508000
- 01509000
- 01510000
- 01511000
- 01512000
- 01513000
- 01514000
- 01515000
- 01516000
- 01517000
- 01518000
- 01519000
- 01520000
- 01521000
- BOOLEAN RRB1; COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 01522000
- SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 01523000
- COMMENT AT RR1; 01524000
- BOOLEAN RRB2; COMMENT SEE COMMENT AT RRB1 DECLARATION; 01525000
- DEFINE ARRAYMONFILE = [27:11]#; COMMENT ARRAYMONFILE IS THE DEFINE FOR 01526000
- THE ADDRESS OF THE FILE DESCRIPTOR IN 01527000
- THE FIRST WORD OF ADDITIONAL INFO; 01528000
- DEFINE SVARMONDILE = [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 DIMENSIONS 01533000
- IN NODIMPART; 01534000
- DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000
- POSITION IN THE FIRST WORD OF ADDITIONAL 01536000
- INFO THAT CONTAINS THE MONITOR FILE 01537000
- ADDRESS FOR LABELS; 01538000
- DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000
- POSITION IN THE FIRST WORD OF ADDITIONAL 01540000
- INFO THAT CONTAINS THE MONITOR FILE 01541000
- ADDRESS FOR LABELS; 01542000
- DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000
- POSITION IN THE FIRST WORD OF ADDITIONAL 01544000
- INFO THAT CONTAINS THE MONITOR FILE 01545000
- ADDRESS FOR LABELS; 01546000
- DEFINE DUMPEE = [2,11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000
- ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000
- THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000
- EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000
- APPEARS IN A DUMP DECLARATION; 01551000
- DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000
- ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000
- THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000
- FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000
- THE PRINTI ROUTINE; 01556000
- DEFINE CHUNK = 180#; 01556100
- FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200
- FILE IN CARD (RR1,10,RR2); 01557000
- SAVE 01558000
- FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000
- ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010
-INTEGER DA; 01559020
- SAVE FILE OUT NEWTAPE DISK SERIAL [20:2400] (RR5,RR6,RR7,SAVE 1); 01560000
- FILE IN TAPE "OCRDIMG" (2,RR8,RR9); 01561000
- SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005
- COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010
- FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020
- FILE IN CASTB(1,BUFFSIZE); 01561030
- FILE IN CASTC(1,BUFFSIZE); 01561040
- SWITCH FILE LIBRARY_CASTA,CASTB,CASTC; 01561050
- FILE OUT REMOTE 19 (2,10); 01561055
-SAVE ARRAY CBUF,TBUFF[0:9]; % INPUT BUFFERS. 01561056
-BOOLEAN REMOTEG; 01561060
-ARRAY LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 01561065
- % TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 01561070
- % EACH ENTRY CONSISTS OF THREE WORDS CONTAINING: 01561080
- FILE DSK1 DISK SERIAL [20:816](2,10,30); %116- 01561085
- FILE DSK2 DISK SERIAL [20:450](2,30,30); %116- 01561087
- DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090
- NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100
- DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110
- INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120
- COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 01561130
- INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140
- LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150
- MAXTLCR USED IN READACARD, FILEINX IS THE 01561160
- LIBRARY SWITCH FILE INDEX, SEQSUM IS THE 01561170
- SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180
- FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190
-REAL RECOUNT,FINISHPT; 01561200
- BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202
- PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204
- BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206
- CARD READER ELSE FALSE; 01561208
- COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210
- BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215
- OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217
-DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220
- BLOCKS PER LIBRARY TAPE; 01561230
-ARRAY DIRECTORY[0:3xNOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240
- DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250
- A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260
- B: 2 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270
- IDENTIFIER NAME. 01561280
- C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 01561290
- D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300
- ENTRIES. 01561310
- ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320
- LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330
- DIRECTORY BLOCKS. 01561340
- ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350
- AND THE ITEM D WILL FOLLOW INDICATING THE 01561360
- LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370
- ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380
- BLOCK. 01561390
- IN ORDER TO CHANGE: 01561400
- NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410
- 01561020 - 01561050. 01561420
- - CHANGE "3" AT 01561430
- NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440
- AT ; 01561450
-DEFINE %107- 01561500
- INSERTMAX = 20#, % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 01561510
- INSERTCOP = INSERTINFO[INSERTDEPTH,4]#, % = 1 IF COPY TO NEWTAPE 01561520
- INSERTMID = INSERTINFO[INSERTDEPTH,0]#, % MFID OF THE LIBRARY FILE 01561530
- INSERTFID = INSERTINFO[INSERTDEPTH,1]#, % FID OF THE LIBRARY FILE 01561540
- INSERTINX = INSERTINFO[INSERTDEPTH,2]#, % POINTER TO THE RECORD%107- 01561550
- INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#, % LAST SEQUENCE TO BE INCLUD 01561560
-INTEGER SAVECARD, INSERTDEPTH; %107- 01561570
-ARRAY INSERTINFO[0:INSERTMAX,0:4]; %107- 01561580
-FILE LIBRARYFIL DISK RANDOM(2,10,30); %107- 01561590
-DEFINE LF = LIBRARYFIL#; %107- 01561600
-SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER %107- 01561610
-REAL STREAM PROCEDURE CMPD(A,B); %107- 01561620
- BEGIN %107- 01561630
- SI:=A; DI:=B; %107- 01561640
- IF 8 SC>=DC THEN %107- 01561650
- BEGIN %107- 01561660
- SI:=SI-8; DI=DI-8; TALLY:=2; %107- 01561670
- IF 8 SC = DC THEN TALLY:=1; %107- 01561680
- END; %107- 01561690
- CMPD:=TALLY; %107- 01561700
- END CMPD; %107- 01561710
-REAL C; 01562000
- COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 01563000
-REAL T; 01564000
- COMMENT T IS A TEMPORARY CELL; 01565000
-INTEGER TCOUNT; 01566000
- COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 01567000
- FOR THE USE OF CONVERT; 01568000
- REAL STACKCT; %A 01568500
-DEFINE LOGI =443#, 01569000
- EXPI =440#, 01570000
- XTOTHEI =480#, 01571000
- GOTOSOLVER =484#, 01572000
- PRINTI =477#, 01573000
- MERGEI =500#, 01573100
- POWERSOFTEN =670#, 01574000
- LASTSEQUENCE =166#, %117- 01575000
- LASTSEQROW = 2#, 01576000
- INTERPTO =461#, 01577000
- SUPERMOVER =555#, 01577500
- CHARI =465#, 01578000
- INTERPTI =469#, 01579000
- SORTI =473#, 01579100
- DIALER =559#, 01579200
- FILEATTINT =563#, 01579300
- POWERALL =567#, 01579350
- SPECIALMATH =570#, 01579355
- SORTA =673#, %117- 01580000
- COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX 01581000
- 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 GNERALLY TELLS WHETHER OWN WAS SEEN; 01588000
- P3, COMMENT TELSS WHETHER SAVE WAS SEEN; 01589000
- P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500
- VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000
- FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000
- PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSED; 01592000
-SPECTOG, 01593000
- STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000
- ONE ID AND THEN EIXT; 01595000
- AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000
-BOOLEAN STOPDEFINE; 01597000
-REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100
-INTEGER MAXSAVE; 01598000
- COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000
- DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000
- FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000
-REAL 01602000
- KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000
- ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000
- LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000
- LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000
- INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000
- PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000
- DECLARED; 01609000
- G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000
- TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000
- BEING DECLARED; 01612000
- PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000
- DECLARED; 01614000
- MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000
- OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000
- PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000
- J, COMMENT ARRAY COUNTER; 01618000
- LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000
- NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000
- GLOBALNINFOO,COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 01620100
- GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 01620200
- CAN CHECK FOR DUPLICATE DECLARATIONS; %118- 01620300
- OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; %118- 01620400
- FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 01621000
- IN BLOCK,INITIALIZED TO 4095 EACH TIME; 01622000
- SAVEL, COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 01623000
-INTEGER NCII; COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 01624000
- ENTERED IN INFO AT ANY GIVEN TIME; 01625000
- REAL FILETHING; COMMENT HOLDS LINKS FOR STREAM RELEASES ; 01625100
-PROCEDURE UNHOOK;FORWARD; 01626000
-PROCEDURE MAKEUPACCUM;FORWARD; 01627000
-DEFINE PURPT=[4:8]#,SECRET=2#; 01628000
- COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 01629000
- NUMBERS REFERS TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE 01630000
- FULL NAME IS ALSO GIVEN; 01631000
- DEFINE 01632000
- ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 01633000
- BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL; 01634000
- BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 01635000
- BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 01636000
- BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 01637000
- CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 01638000
- CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 01639000
- COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 01640000
- COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 01641000
- DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; %A 01642000
- DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 01643000
- EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 01644000
- LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 01645000
- LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 01646000
- GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 01647000
- LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 01648000
- LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 01649000
- GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 01650000
- IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 01651000
- INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 01652000
- ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 01653000
- ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 01654000
- LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 01655000
- LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 01656000
- LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 01657000
- LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 01658000
- LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 01659000
- LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 01660000
- LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 01661000
- MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 01661100
- MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 01662000
- MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 01663000
- NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 01664000
- NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 01665000
- PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 01666000
- PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 01667000
- RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 01668000
- RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 01669000
- RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 01670000
- SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 01671000
- SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 01671100
- SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 01672000
- STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 01673000
- SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 01674000
- XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 01675000
- XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 01676000
- ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 01677000
- COMMENT THESE DEFINES ARE USED BY EMITD; 01678000
- DEFINE 01679000
- DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 01680000
- DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 01681000
- TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 01682000
-REAL MAXSTACK,STACKCTR; 01683000
-INTEGER MAXROW; 01684000
- COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000
- ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000
-INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000
-INTEGER F; 01688000
-STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010
- BEGIN LOCAL T1,T2,T3; 01688020
- SI_EDOC;T1_SI;SI+TEDOC;T2_SI;SI_LOC EDOC;SI_SI+3;DI_LOC T3; 01688030
- DI_DI+5;SKIP 3 DB;15(IF SB THEN DS_1 SET ELSE DS_1 RESET; 01688040
- SKIP 1 SB);SI_LOC EDOC;DI_LOC T2; DS_5 CHR;3(IF SB THEN DS_ 01688050
- 1 SET ELSE DS _ 1 RESET; SKIP 1 SB);DI_T3;SI_LOC T2;DS_WDS; 01688060
- DI_LOC T3;DI_DI+5;SKIP 3 DB;SI_LOCL 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 THE NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN- 01704000
- MENT. ORTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000
- TEMPORARY ASSIGNMENT; 01706000
-DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT 01707000
- POSITION IN THE SECOND WORD OF INFO WHICH 01708000
- CONTAINS THE LENGTH OF ALPHA; 01709000
-DEFINE EDOCINDEX = L.[36:3],L.[39:7]#; COMMENT EDOCINDEX IS THE WORD 01710000
- PORTION OF L SPLIT INTO A ROW AND 01711000
- COLUMN INDEX FOR EDOC; 01712000
-DEFINE CPLUS1 = 769#; COMMENT SEE COMMENT AT CPLUS2 DEFINE; 01713000
-DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000
- USED IN THE GENERATION OF C-RELATIVE CODE; 01715000
- PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01716000
- ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD; 01717000
- BOOLEAN MACROID; 01717800
- REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900
- PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950
- PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000
- REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100
- PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200
- INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000
- BOOLEAN LISTMODE; 01720000
- COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000
- IS BEING GENERATED OR A STATEMENT; 01722000
- INTEGER LSTR; 01723000
- COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000
- USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000
- PROCEDURE SCANNER; FORWARD; 01730000
- COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 01732000
- REAL STREAM PROCEDURE MKABS(A); 01733000
- BEGIN DI _ A; MKABS _ DI END MKABS; 01734000
- STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000
- BEGIN LOCAL T; 01736000
- SI_LOC W; DI_LOC T; SI_SI+6; DI_DI+7; DS_CHR; 01736100
- SI_A; DI_B; T(DS_32 WDS; DS_32 WDS); DS_W WDS; 01736200
- END MOVE; 01736300
- STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000
- VALUE NDIV32,NMOD32 ; 01737050
- BEGIN DI := DEST; 01737100
- NDIV32(32(DS :=8 LIT"0")); 01737150
- NMOD32(DS := 8 LIT"0"); 01737200
- END; 01737250
- COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 01737300
- STREAM PROCEDURE BLANKET(N,THERE); VALUE N; 01737350
- BEGIN 01737400
- DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS; 01737450
- END BLANKET; 01737500
- 01738000
- 01739000
- 01740000
- PROCEDURE STEPIT; FORWARD; 01741000
- COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100
- STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200
- BEGIN 01741300
- DI _ OLDSEQ; SI_VAL ; DS _ 8 DEC 01741400
- END; 01741500
- STREAM PROCEDURE SEQUENCEWARNING(L); 01742100
- BEGIN DI:=L; DI:=DI-8; DS:=24 LIST "SEQUENCE WARNING<<<<<<<<"; END; 01742110
- BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200
- COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300
- TRUE IF ANY VISIBLE CHARACTER ; 01742400
- BEGIN 01742500
- LABEL NED; 01742600
- SI_FCR; 01742700
- TALLY_0; 01742800
- 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI_ SI+1)); 01742900
- TALLEY_63; 01743000
- NED: TALLY_TALLY+1; 01743100
- NONBLANK_TALLY 01743200
- END NONBLANK; 01743300
- INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE** 01750000
- GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000
- FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000
- BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000
- ABOUT FAULTLEVEL; 01754000
- INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000
-STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR,SEQ); VALUE NCR; 01756000
- BEGIN 01757000
- LABEL L,TRANS; 01758000
- LOCAL N; 01759000
- SI:=SEQ; DI:=LCR; DI:=DI-1; DS:=LIT"%"; % PUT "%" IN CC 72. 01759100
- DS:=WDS; % RESTORE SEQ. NO. FOR $VOID(T) CARDS. 01759200
- SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000
- SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000
- 2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000
- SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-80. 01763000
-L: 01764000
- IF SC=""" THEN 01765000
- BEGIN 01766000
- SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN 01767000
- NCR:=SI; % TEMP, STORAGE. SINCE NCR IS "LOCAL" TO GETVOID. 01768000
- 8(IF SC=""" THEN JUMP OUT ELSE 01769000
- BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01770000
- END 01771000
- ELSE BEGIN 01772000
- NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01773000
- DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN 01774000
- 8(IF SC=" " THEN JUMP OUT ELSE 01775000
- BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01776000
- END; 01777000
-TRANS: 01778000
- SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000
- SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000
- N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000
- DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000
- DI:=VR; SI:=LOC VP; DS:=WDS; % ADDRESS OF VOIDE RANGE. 01783000
- END OF GETVOID; 01784000
-REAL VOIDCR,VOIDPLACE; 01785000
-BOOLEAN SORTMERGETOG; 01786000
- FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000
- PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000
- BUG(X24,4(A4,X2)); 01802000
-PROCEDURE DATIME; 01820000
- BEGIN 01821000
- INTEGER H,MIN,Q; ALPHA N1,N2; 01822000
- ALPHA STREAM PROCEDURE DATER(DATE); VALUE DATE; 01823000
- BEGIN 01824000
- DI:=LOC DATER; SI:=LOC DATE; SI:=SI+2; 01825000
- 2(DS:=2 CHR; DS:=LIT"/"); DS:=2 CHR; 01826000
- END OF DATER; 01827000
- H:=TIME1 DIV 216000; MIN:=(TIME1 DIV 3600) MOD 60; 01828000
- N1:=CODE.MFID; N2:=CODE.FID; 01828500
- WRITE(LINE, 01829000
- $ SET OMIT = NOT ALGOL 01829900
-"XVI.0.122" %123- 01831000
- ," ",A6,"DAY", ",0,", ",I2.":",A2,X1,A3, 01832000
- ////X45,A1,A6,"/",A1,A6,/X45,15("=")//>, 01832500
- TIME(6),DATER(TIME(5)),12xREAL(Q:=H MOD 12=0)+Q, 01833000
- Q:=MIN MOD 10+(MIN DIV 10)x64, 01834000
- IF H>=12THEN "PM." ELSE "AM.", 01835000
- N1,[6:6],N1,N2,[6:6],N2); 01835500
- IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. %120- 01835600
- WRITE(LINE,, %120- 01835700
- (N1:=TAPE.MFID),[6:6],N1,(N2:=TAPE.FID),[6:6],N2); %120- 01835800
- NOHEADING:=FALSE; 01836000
- END OF DATIME; 01837000
-DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000
-COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000
- AND SCANNING THEM; 02001000
- BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020
- VALUE ROW ; 02001030
- BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040
- REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY 02001050
- ; 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 THE 02001200
- WRONG ROW; 02001210
- SI_SI+1;DI_LOC LOOK; 02001220
- IF 3 SC = DC 02001230
- THEN BEGIN COMMENT WE ARE 02001240
- IN THE WRONG 02001250
- ROW; 02001260
- SI_DPPOS; 02001270
- SI_SI+8; 02001280
- DPPOS_SI; 02001290
- DI_LOC TEMP; 02001300
- DS_WDS; 02001310
- SI_TEMP; 02001320
- END 02001330
- ELSE SI_SI-4; 02001340
- END; 02001350
- DI_LOC LGTH; DI_DI+7; DS_CHR; 02001360
- SI_SI+ LGTH; 02001370
- DI_STOPOS; DS_5 LIT"0"; 02001375
- DS_3 CHR; GO TO EXIT; 02001380
- END; 02001390
- SI_SI+3; 02001400
- END 02001410
- ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420
- SI_SI-1; 02001430
- IF SC = "0" 02001440
- THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450
- SI_SI+1; DI_LOC LOOK; 02001460
- IF 3 SC = DC 02001470
- THEN BEGIN COMMENT CHANGE ROWS; 02001480
- SI_DPPOS;SI_SI+8;DPPOS_SI; 02001490
- DI_LOC TEMP; DS_WDS; 02001500
- SI_TEMP; 02001510
- END 02001520
- ELSE BEGIN COMMENT IT IS NOT HERE; 02001530
- TALLY_1; LOOK_TALLY; 02001540
- GO TO EXIT; 02001550
- END; 02001560
- GO TO LOOP; 02001563
- END; 02001565
- SI_SI_LGTH; SI_SI+4; COMMENT POSITION TO NEXT ID.; 02001568
- END; 02001570
- GO TO LOOP; 02001580
- EXIT:; 02001590
- END LOOK; 02001600
-%************************************************************************ 02001605
-% %116- 02001610
-% MISCELLANEOUS CROSS REFERENCE PROCEDURES %116- 02001615
-% %116- 02001620
-%************************************************************************ 02001630
-% %116- 02001635
-PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); %116- 02001640
- VALUE INDEX,SEQNO,REFTYPE; %116- 02001645
- REAL INDEX,SEQNO,REFTYPE; %116- 02001650
-BEGIN %116- 02001655
- IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE %116- 02001660
- BEGIN %116- 02001665
- IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. %116- 02001670
- BEGIN %116- 02001675
- WRITE(DSK2,30,XREFAY2[*]); %116- 02001680
- XREFPT := 0; %116- 02001685
- END; %116- 02001690
- XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] %116- 02001695
- REFIDNOF; %116- 02001700
- XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE %116- 02001705
- % CANT WRITE IT OUT BECAUSE SOME ROUTINES %116- 02001710
- % WILL LOOK BACK AT THE ENTRY WE JUST PUT %116- 02001715
- % IN AND FIX IT UP. %116- 02001720
- END; %116- 02001725
-END OF CROSSREFIT; %116- 02001730
-% %116- 02001735
-PROCEDURE CROSSREFDUMP(INDEX); %116- 02001740
- VALUE INDEX; %116- 02001745
- REAL INDEX; %116- 02001750
-BEGIN %116- 02001755
- STREAM PROCEDURE MOVEREFINFO(S,D,N); %116- 02001760
- VALUE N; %116- 02001765
- BEGIN %116- 02001770
- SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD %116- 02001775
- SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER %116- 02001780
- END OF MOVEXREFINFO; %116- 02001785
- % %116- 02001790
- IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT %116- 02001795
- BEGIN %116- 02001800
- MOVEXREFINFO(INFO[INDEX,LINKR,INDEX,LINKC+1],XREFAY1[*], %116- 02001805
- TAKE(INDEX+1),[12:6]); %116- 02001810
- XREFAY1[8] := XREFINFO[INDEX]; %116- 02001815
- XREFAY1[9] := TAKE(INDEX); % ELBAT WORD %116- 02001820
- WRITE(DSK1,10,XREFAY1[*]); %116- 02001821
- XREFINFO[INDEX] := 0; %116- 02001822
- END; %116- 02001825
-END OF CROSSREFDUMP; %116- 02001830
- REAL STREAM PROCEDURE CONV(ACCUM,SKP,N); VALUE SKP,N; 02001831
- BEGIN 02001832
- SI_ ACCUM; SI_SI+SKP;SI_SI+3;DI_LOC CONV; DS _ N OCT 02001833
- END CONV; 02001834
-COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 02001836
-BOOLEAN STREAM PROCEDURE OCTIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001838
- BEGIN 02001840
- SI:=S; SI:=SI+3; DI:=D; SK(DS:=3 RESET); % RIGHT JUSTIFY. 02001842
- CNT(IF SC>="8"THEN TALLY:=1 ELSE IF SC<="0"THEN TALLY:=1; SKIP 3 SB; 02001844
- 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02001846
-% 02001848
-% 02001850
- OCTIZE:=TALLY; % "1" = NON OCTAL CHARACTER. 02001852
- END OCTIZE; 02001854
-COMMENT HEXIZE REFORMATS ACCUM FOR HEXADECIMAL CONSTANTS; 02001856
-BOOLEAN STREAM PROCEDURE HEXIZE(S,D,SKP,CNT); VALUE SKP,CNT; 02001858
- BEGIN LOCAL T1,T2,TEMP2,TEMP1; LABEL AGIN; 02001860
-COMMENT LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE 02001862
- WAY THEY ARE DECLARED IN STREAM PROCEDURES; 02001864
- DI:=LOC TEMP1; CNT(DS:=LIT"1"); % IN CASE A CHAR=A,B,C,D,OR F. 02001866
- SI:=S; SI:=SI+3; DI:=LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2. 02001868
- CNT(IF SC<"0" THEN IF SC>="A"THEN IF SC<="F"THEN % WORK HARD. 02001870
- BEGIN 02001872
- T1:=SIL T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN. 02001874
- DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK. 02001876
- DS:=1 ADD; DI:=DI-1; SKIP 2 DB; DS:=1 SET; SKIP 3 DB; 02001878
- GO AGIN; 02001880
- END; 02001882
- IF SC<"0" THEN TALLY:=1; DS:=CHR; % < 0 = NON-HEX CHARACTER. 02001884
-AGIN: 02001886
- ); 02001888
- SI:=LOC TEMP1; DI:=D; SKP(DS:=4 RESET); % RIGHT ADJUST CONSTANT. 02001890
- CNT(SKIP 2 SB; 02001892
- 4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));% FINAL CONVERT. 02001894
- HEXIZE:=TALLY; % "1" IF PROGRAMMER GOOFED. 02001896
- END HEXIZE; 02001898
-COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 02002000
- CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 02003000
- IT IS NEEDED FOR FUTURE REFERENCE; 02004000
-STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR; 02005000
- BEGIN D:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000
-COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 02007000
- I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 02008000
- CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02009000
- THE SCANNER; 02010000
-STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000
- BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000
- COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010
- IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020
- THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030
- NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040
- VARIABLE AD; 02013050
- STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060
- VALUE AD,DESCRP; 02013065
- BEGIN 02013070
- LOCAL HOLD,ZONEP; 02013073
- DI_LOC ZONEP; SI_SUM; DS_8 ZON; 02013074
- COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075
- DI_SUM; DI_DI+7; DS_2 RESET; 02013076
- COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077
- SI_LOC DESCRP; SI_SI+7; 02013078
- IF SC="1" THEN BEGIN DI_LOC HOLD; SI_SEQLOC; 02013080
- DS_WDS; DI_HOLD; END 02013085
- ELSE DI_SEQLOC; 02013090
- COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091
- HOLD_DI; DI_DI+7; DS_2 RESET; DI_HOLD; 02013095
- SI _ LOC AD; 02013100
- SI _ SI + 7; 02013110
- IF SC = "1" THEN BEGIN SI_ SUM; DS_8 ADD; END 02013120
- ELSE BEGIN SI_ SUM; DS_8 SUB; END; 02013130
- SI_LOC ZONEP; DI_HOLD; DS_8 ZON; 02013135
- SI_LOC ZONEP; DI_SUM; DS_8 ZON; 02013136
- COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137
- END ADDER; 02013140
-COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150
-COMPILABLE QUANTITIES. THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155
-A LIBRARY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160
-PROCEDURE SEARCHLIB(DOLLAR); VALUE DOLLAR; BOOLEAN DOLLAR; 02013165
- BEGIN 02013170
- LABEL EXIT,EXITOUT, NOPARTIAL; 02013175
- PROCEDURE FLAGIT(N); VALUE N; INTEGER N; 02013176
- BEGIN 02013177
- BOOLEAN TL,TS; 02013178
- TL:=LISTOG; TS:=SINGLTOG; LISTOG:=FALSE; SINGLTOG:=FALSE; 02013179
- Q:=ACCUM[1]; FLAG(N); 02013180
- LISTOG:=TL; SINGLTOG:=TS; 02013181
- END FLAGIT; 02013183
- IF DOLLAR THEN 02013184
- BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190
- RESULT_COUNT_ACCUM[1] _0; SCANNER; 02013195
- RESULT_COUNT_ACCUM[1] _0; SCANNER; 02013200
- IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205
- FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210
- COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219
- FLAGIT(500); GO EXIT; 02013222
- END; 02013225
- FILEINX _ FILEINX -1; 02013230
- IF DIRECTORY[GT1_3xFILEINX,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[FILEINXx3,0] _ -2; 02013255
- WHILE GT2 _ GT2-1 > 0 DO 02013260
- BEGIN 02013265
- READ(LIBRARY[FILEINX]); 02013270
- MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1_GT1+1,0]); 02013275
- END; 02013280
- END; 02013285
- RESULT_ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET THE PROD.ID.; 02013290
- IF LOOK(ACCUM[1],DIRECTORY,3xFILEINX, GT1,GT2) THEN 02013295
- BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300
- FLAGIT(501); GO EXIT; 02013305
- END; 02013310
- WHILE LCR.[33:15] - NCR.[33:15] !=1 OR NCR.[30:3]!= 7 02013313
- DO BEGIN 02013315
- IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317
- RESULT_5; SCANNER; 02013318
- END; 02013319
- GO TO NOPARTIAL; 02013320
- EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT SPACE PAST "[" ; 02013330
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET START POINT; 02013335
- IF RESULT!= 3 THEN 02013340
- BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345
- FLAGIT(502); GO EXIT; 02013350
- END; 02013355
- GT1 _ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; 02013365
- IF RESULT!= 2 THEN 02013370
- BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375
- FLAGIT(503); GO EXIT; 02013380
- END; 02013385
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; COMMENT GET LENGTH; 02013390
- IF RESULT!= 3 THEN 02013395
- BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400
- FLAGIT(504); GO EXIT; 02013405
- END; 02013410
- GT2 _ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415
- RESULT_ ACCUM[1]_ COUNT_0; SCANNER; 02013420
- IF ACCUM[1]!= "1D0000" THEN 02013425
- BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430
- FLAGIT(505); GO EXIT; 02013435
- END; 02013440
- WHILE LCR.[33:15] - NCR.[33:15]!= 1 OR NCR.[30:3]!= 7 02013445
- DO BEGIN RESULT _ 5; SCANNER END; 02013446
- END; 02013450
- NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475
- LIBARRAY[LIBINDEX].LSTUSD _ LASTUSED; 02013480
- LIBARRAY[LIBINDEX].FILEINDEX _ FILEINX; 02013490
- LIBARRAY[LIBINDEX].STOPPOINT _ FINISHPT; 02013495
- LIBARRAY[LIBINDEX].NEXTENTRY _ RECOUNT-1; 02013497
- FINISHPT _ GT2; 02013500
- IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3],FILEINDEX) 02013505
- x3,0] _ RECOUNT -1; 02013510
- RECOUNT_GT1; 02013515
- IF EXAMIN(LCR)!= "%" THEN 02013516
- PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525
- IF LASTUSED<=2 OR LASTUSED=5 THEN GTI1_0 02013526
- ELSE IF MAXLTLCR.[33:15]=NCR.[33:15]<11 THEN 02013527
- GTI1_MKABS(LIBRARY[FILEINX](0)) ELSE GTI1_(NCR+2).[33:15]; 02013528
- LIBARRAY[LIBINDEX+2],NCRLINK_GTI1.[33:15]; COMMENT GTI1=NCR; 02013530
- IF LASTUSED<=2 OR LASTUSED=5 THEN 02013533
- LIBARRAY[LIBINDEX+2].LCRLINK_0 ELSE 02013534
- LIBARRAY[LIBINDEX+2].LCRLINK_GTI1.[33:15]+10; 02013535
- IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536
- LASTUSED_5; LIBARRAY[LIBINDEX].NEXTENTRY_ 02013537
- LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538
- END ELSE BEGIN 02013539
- LASTUSED_6; FIRSTIMEX_ TRUE; END 02013540
- ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541
- LIBINDEX _ LIBINDEX + 3; 02013542
- END 02013545
- ELSE 02013550
- BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555
- LIBINDEX _ LIBINDEX -3; 02013560
- RECOUNT_RECOUNT-1; 02013563
- LASTUSED _ LIBARRAY[LIBINDEX].LSTUSD; 02013565
- IF LASTUSED =1 THEN MEDIUM := "C "; %112- 02013566
- IF LIBINDEX > 0 THEN BEGIN GTI1_LIBARRAY[LIBINDEX].NEXTENTRY; 02013567
- DIRECTORY[FILEINXx3,0]_RECOUNT; RECOUNT_GTI1+2; END ELSE 02013568
- DIRECTORY[FILEINXx3,0] _ RECOUNT; 02013570
- IF LIBINDEX > 0 THEN 02013575
- FILEINX _ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580
- FINISHPT _ LIBARRAY[LIBINDEX].STOPPOINT; 02013600
- IF LIBINDEX!= 0 THEN 02013610
- MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615
- IF LASTUSED<=2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617
- NCR _ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620
- IF LASTUSED<=2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621
- LCR _ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625
- NORELEASE_TRUE; 02013627
- IF LASTUSED=6 THEN FIRSTIMEX_TRUE; 02013628
- END OF UNLINK; 02013630
- IF LIBINDEX = 0 THEN 02013635
- BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640
- SEQSUM_0; 02013645
- END 02013650
- ELSE 02013655
- BEGIN 02013660
- GT1_(GTI1_(DIRECTORY[FILEINXx3,0]+3)/5)x5+1; 02013665
- GT2_(GTI1_(RECOUNT-3)/5)x5+1; 02013670
- GT3 _(GT2 - GT1)DIV 5; 02013675
- SPACE(LIBRARY[FILEINX],GT3); 02013680
- 02013681
- 02013682
- READ(LIBRARY[FILEINX],GT3); 02013685
- 02013690
- 02013693
- 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) x11)); 02013705
- MAXLTLCR_MKABS(LIBRARY[FILEINX](0))+54; 02013710
- ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713
- IF LASTUSED= 6 THEN BEGIN 02013714
- NCR_LCR_MKABS(LIBRARY[FILEINX](0)); 02013715
- PUTSEQNO(GT1,LCR); 02013716
- TURNONSTOPLIGHT("%",LCR); 02013717
- END; END; 02013718
- EXIT: END SEARCHLIB; 02013720
- COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000
- AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000
-BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000
- BEGIN SI_FCR; IF SC!="$" THEN TALLY_1; 02017000
- DI_NEW; DS_10 WDS; WRITNEW_TALLY 02018000
- END WRITNEW; 02019000
- 02020000
- 02021000
- 02022000
- 02023000
- 02041000
- 02042000
- 02043000
- 02044000
- 02045000
- 02046000
- 02047000
- 02047050
- 02047055
- 02047060
- 02047065
- 02047070
- 02047075
- 02048000
- 02049000
- 02050000
- 02051000
- 02052000
- 02053000
- 02054000
- 02055000
- 02055100
- 02055200
- 02055300
- 02056000
- 02057000
- 02058000
- 02059000
- 02060000
-COMMENT EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR 02061000
- EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02061500
- QUANTITIES IN THE DIRECTORY; 02062000
-BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02062500
- BEGIN 02063000
- TALLY:=1; SI:=A; DI:=B; 02063500
- IF COUNT SC=DC THEN EQUAL:=TALLY 02064000
- END EQUAL; 02064500
-PROCEDURE READACARD; FORWARD; 02065000
-PROCEDURE DOLLARCARD; FORWARD; 02065500
-BOOLEAN PROCEDURE BOOLEXP; FORWARD; 02065600
-PROCEDURE SCANNER; 02066000
- BEGIN 02066500
-COMMENT "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 02067000
- IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER". 02067500
- WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 02068000
- IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO 02068500
- INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE. 02069000
- HENCE THE VARIABLE "RESULTS" IS PASSED BY BOTH NAME AND VALUE. 02069500
- THE MEANING OF "RESULT" AS INPUT IS: 02070000
- VALUE MEANING 02070500
- ===== ========================================= 02071000
- 0 INITIAL CODE - DEBLANK AND START TO FETCH THE 02071500
- NEXT QUANTITY. 02072000
- 1 CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02072500
- END-OF-CARD BREAK). 02073000
- 2 LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE, 02073500
- EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT 02074000
- IMPORTANT). 02074500
- 3 CONTINUE BUILDING A NUMBER (INTERRUPTED YB END-OF- 02075000
- CARD BREAK). 02075500
- 4 LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE, 02076000
- EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT 02076500
- IMPORTANT). 02077000
- 5 GET NEXT CHARACTER AND EXIT. 02077500
- 6 SCAN A COMMENT. 02078000
- 7 DEBLANK ONLY. 02078500
- THE MEANING OF "RESULT" AS OUTPUT IS: 02079000
- VALUE MEANING 02079500
- ===== ======================================= 02080000
- 1 AN IDENTIFIER WAS BUILT. 02080500
- 2 A SPECIAL CHARACTER WAS OBTAINED. 02081000
- 3 A NUMBER (INTEGER) WAS BUILT. 02081500
- "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02082000
- DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR" 02082500
- FOR THE REST OF THIS DISCUSSION). 02083000
- "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS 02083500
- "SCAN" HAS PUT INTO THE "ACCUMULATOR". SINCE "SCAN" NEEDS 02084000
- THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM- 02084500
- ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD. 02085000
- "COUNT" IS PASSED BY BOTH NAME AND VALUE/ IT IS ALSO 02085500
- CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT". 02086000
- "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY 02086500
- NAME AND VALUE SO THAT IT MAY BE UPDATED. 02087000
- "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02087500
- PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK 02088000
- ARRANGEMENT. 02088500
- ; 02089000
- STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02089500
- COUNT,ST2,NCRV,ST1); 02090000
- VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02090500
- BEGIN 02091000
- LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS.L,ERROR, 02091500
- COMMENTS,COMMANTS; 02092000
- DI:=RESULT; DI:=DI+7; SI:=NCRV; 02092500
-COMMENT SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT 02093000
- THE BUFFER; 02093500
- CI:=CI+RESULTV; % SWITCH ON VALUE OF RESULT; 02094000
- GO DEBLANK; % 0 IS INITIAL CODE. 02094500
- GO IDBLDR; % 1 IS ID CODE. 02095000
- GO FINIS; % 2 IS SPECIAL CHARACTER CODE. 02095500
- GO NUMBERS; % 3 IS NUMBER CODE. 02096000
- GO FINIS; % 4 IS ERROR CODE. 02096500
- GO GNC; % 5 IS GET NEXT CHARACTER CODE. 02097000
- GO COMMANTS; % 6 IS COMMENT CODE. 02097500
- % 7 IS DEBLANK ONLY CODE. 02098000
- IF SC=" " THEN 02098500
-K: BEGIN SI:=SI+1; IF SC=" " THEN GO K END; 02099000
- GO FINIS; 02099500
-DEBLANK: 02100000
- IF SC=" " THEN 02100500
-L: BEGIN SI:=SI+1; IF SC=" " THEN GO L END; 02101000
-COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 02101500
- NCRV:=SI; 02102000
- IF SC>= "0" THEN GO NUMBERS; 02102500
- IF SC=ALPHA THEN GO IDBLDR; 02103000
-COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 02103500
-GNC: 02104000
- DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT; 02104500
-COMMANTS: 02105000
- IF SC!=";" THEN 02105500
- BEGIN 02106000
-COMMENTS: 02106500
- SI:=SI+1; 02107000
- IF SC > "%" THEN GO COMMENTS; 02107500
- IF SC < ";" THEN GO COMMENTS; 02108000
-COMMENT CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD- 02108500
- MODE PART OF COMMENT ROUTINE; 02109000
- END; 02109500
- GO FINIS; 02110000
-IDBLDR: 02110500
- TALLY:=63; DS:=LIT "1"; 02111000
- COMCOUNT(TALLY:=TALLY+1; 02111500
- IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO EXIT); 02112000
- TALLY:=TALLY+1; 02112500
- IF SC=ALPHA THEN 02113000
- BEGIN 02113500
-ERROR: 02114000
- DI:=DI-1; DS:=LIT "4"; GO EXIT; 02114500
- END 02115000
- ELSE GO EXIT; 02115500
-COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS 02116000
- IN AN IDENTIFIER OR NUMBER; 02116500
-NUMBERS: 02117000
- TALLY:=63; DS:=LIT "3"; 02117500
- COMCOUNT(TALLY:=TALLY+1; 02118000
- IF SC <"0"THEN JUMP OUT TO EXIT; SI:=SI+1); 02118500
- GO ERROR; 02119000
-EXIT: 02119500
- ST1:=TALLY; % "ST1" CONTAINS THE NUMBER OF CHARACTERS WE ARE 02120000
- % GOING TO MOVE INTO THE "ACCUMULATOR". 02120500
- TALLY:=TALLY+COUNTV; ST2:=TALLY; 02121000
- DI:=COUNT; SI:=LOC ST2; DS:=WDS; 02121500
-COMMENT THIS CODE UPDATED "COUNT'; 02122000
- DI:=ACCUM; SI:=SI-3; DS:=3 CHR; 02122500
-COMMENT THIS CODE PLACES "COUNT" IN "ACCUM" AS WELL; 02123000
- DI:=DI+COUNTV; % POSITION "DI" PAST CHARACTERS ALREADY 02123500
- % IN THE "ACCUMULATOR", IF ANY. 02124000
- SI:=NCRV; DS:=ST1 CHR; 02124500
-COMMENT MOVE CHARACTERS INTO "ACCUM"; 02125000
-FINIS: 02125500
- DI:=NCR; ST1:=SI; SI:=LOC ST1; DS:=WDS; 02126000
-COMMENT RESET "NCR" TO LOCATION OF NEXT CHARACTER TO BE SCANNED; 02126500
- END OF SCAN; 02127000
- LABEL L;% 02127500
-L: 02128000
- SCAN(NCR,COUNT,ACCUM[1],63-COUNT,RESULT, 02128500
- RESULT,COUNT,0,NCR,0); 02129000
- IF NCR=LCR THEN 02129500
- BEGIN 02130000
- READACARD; 02130500
- IF LIBINDEX!=0 THEN 02131500
- IF RECOUNT=FINISHPT THEN 02132000
- BEGIN 02132500
- SEARCHLIB(FALSE); 02133000
- READACARD; 02133500
- NORELEASE:=FALSE; 02134000
- END; 02134500
- GO TO L; % GO DIRECTLY TO L, DO NOT PASS GO. 02135500
- % DO NOT COLLECT $200. 02136000
- END; 02136500
- END SCANNER; 02137000
-DEFINE WRITELINE = IF SINGLTOG THEN WRITE(LINE,15,LIN[*]) 02181000
- ELSE WRITE(LINE[DBL],15,LIN[*])#, 02181250
- MAKCAST = BEGIN 02181500
- CARDCALL:=IF LASTUSED=5 THEN TRUE ELSE FALSE; 02181750
- SEARCHLIB(TRUE); 02182000
- END #, 02182250
- PRINTCARD = BEGIN 02182500
- EDITLINE(LIN,FCR,L.[36:10], %114- 02182750
- SGNO,L.[45:2],MEDIUM,OMITTING); %114- 02182760
- IF NOHEADING THEN DATIME; WRITELINE; 02183000
- END #; 02183250
-STREAM PROCEDURE EDITLINE(LINE,NGR,R,S,L,SYMBOL,OMIT); %114- 02183500
- VALUE NCR,R,S,L,SYMBOL,OMIT; %114- 02183750
- BEGIN 02184000
- DI := LINE; DS := 16 LIT " "; 02184250
- SI := NCR; DS := 9 WDS; 02184500
- DS := 8 LIT " "; 02184750
- DS := WDS; % SEQUENCE NUMBER. 02185000
- DS:=LIT" "; SI:=LOC SYMBOL; SI:=SI+6; 02185250
- DS:=2 CHR; DS:=LIT" "; 02185500
- SI:=LOC R; SI:=SI+4; 02185750
- IF SC=" " THEN DS:=12 LIT" " ELSE %114- 02186000
- BEGIN %114- 02186250
- SI:=LOC S; DS:=4 DEC; DS:=LIT ":"; %114- 02186300
- SI:=LOC R; DS:=4 DEC; DS:=LIT ":"; %114- 02186400
- SI:=LOC L; DS:=1 DEC; DS:=LIT " "; %114- 02186500
- END; %114- 02186600
- OMIT(DI := DI - 12; DS := 12 LIT " :OMIT: "; DI:= LINE; %114- 02186750
- DS := 8 LIT " :OMIT:"); %114- 02186760
- END EDITLINE; 02187000
-COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 02187250
- TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 02187500
- RESULT = 1 ELSE RESULT = 2; 02187750
-REAL STREAM PROCEDURE COMPARE(TAPE,CARD); VALUE TAPE,CARD; 02188000
- BEGIN 02188250
- SI := TAPE; DI := CARD; 02188500
- IF 8 SC >=DC THEN 02188750
- BEGIN 02189000
- SI := SI-8; DI := DI-8; TALLY := 1; 02189250
- IF 8 SC = DC THEN TALLY := 2 02189500
- END; 02189750
- COMPARE := TALLY; 02190000
- END COMPARE; 02190250
-PROCEDURE OUTPUTSOURCE; 02190500
- BEGIN 02190750
- LABEL LCARD,LTAPE,AWAY; 02191000
- SWITCH SW:=LCARD,LCARD,LTAPE,AWAY,LCARD,LTAPE; 02191250
- IF SEQTOG THEN % RESEQUENCING. 02191500
- BEGIN 02191750
- IF TOTALNO = -10 OR NEWBASE THEN 02192000
- BEGIN 02192250
- NEWBASE := FALSE; GTI1:= TOTALNO:=BASENUM 02192500
- END 02192750
- ELSE GTI1:= TOTALNO:= TOTALNO + ADDVALUE; 02193000
- CHANGESEQ(GTI1,LCR); 02193250
- END; 02193500
- IF NEWTOG THEN 02193750
- IF INSERTDEPTH > 0 AND INSERTCOP=1 OR INSERTDEPTH=0 THEN %107- 02193800
- IF WRITNEW(LIN,FCR) THEN WRITF(NEWTAPE,10,LIN[*]); 02194000
- IF OMITTING THEN IF NOT LISTATOG THEN GO AWAY; 02194250
- GO SW[LASTUSED]; 02194500
-LCARD: 02194750
- IF LISTER OR LISTPTOG THEN PRINTCARD; 02195000
- GO AWAY; 02195250
-LTAPE: 02195500
- IF LISTER THEN PRINTCARD; 02195750
-% GO AWAY; 02196000
-AWAY: 02196250
- END OUTPUTSOURCE; 02196500
- PROCEDURE BEGINPRINT; 02196510
- BEGIN 02196520
- STREAM PROCEDURE STUFF(N,L); VALUE N; 02196530
- BEGIN 02196540
- DI:=L; DS:=8 LIT " "; SI:=L; DS:=13 WDS; 02196550
- SI:=LOC N; DS:=8 DEC; 02196560
- END; 02196570
- STUFF(BEGINSTACK[BSPOINT],LIN); 02196580
- IF NOHEADING THEN DATIME; WRITELINE; 02196590
- END BEGINPRINT; 02196610
-PROCEDURE READACARD; 02196750
-COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 02197000
- TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 02197250
- LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 02197500
- SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 02197750
- FCR,NCR,LCR,TLCR, AND CLCR; 02198000
- BEGIN 02198250
- PROCEDURE READTAPE(LCR,MAXLCR,LIB); VALUE LIB; BOOLEAN LIB; 02198500
- REAL LCR, MAXLCR; 02198750
-BEGIN %105- 02198755
-LABEL ENDREADTAPE, EOFT; %105- 02198760
- IF LIB THEN 02199000
- BEGIN 02199250
- RECOUNT:=RECOUNT+1; 02199500
- IF LCR:=LCR+11>MAXLCR THEN 02199750
- BEGIN 02200000
- READ(LIBRARY,FILEINX); 02200250
- MAXLCR:=46+LCR:=MKABS(LIBRARY[FILEINX](0))+10; 02200500
- END; 02200750
- ADDER(SEQSUM,LCR,TRUE,TRUE); 02201000
- END 02201250
- ELSE BEGIN 02201500
-READ (TAPE, 10, TBUFF[*])[EOFT]; %105- 02201750
-MAXLCR:=LCR:=MKABS(TBUFF[9]); %105- 02202000
-GO TO ENDREADTAPE; %105- 02202010
-EOFT: %105- 02202020
-DEFINEARRAY[25]:="ND;END."& "E"[1:43:5]; %105- 02202030
-DEFINEARRAY[34]:="9999" & "9999"[1:25:23]; %105- 02202040
-TLCR:= MKABS(DEFINEARRAY[34]); %105- 02202050
-PUTSEQNO (DEFINEARRAY[33],TLCR-8); %105- 02202060
-TURNONSTOPLIGHT("%", TLCR-8); %105- 02202070
-ENDREADTAPE: %105- 02202080
-END; %105- 02202090
- END READTAPE; 02202250
- PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB; 02202500
- REAL TLCR, CLCR ; 02202750
- BEGIN 02203000
- MEDIUM:="C "; % CARD READER. 02203250
- IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMB 02203500
- BEGIN 02203750
- LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02204000
- MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T. 02204250
- END 02204500
- ELSE BEGIN 02204750
- IF GT1!= 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000
- BEGIN 02205250
- MEDIUM:="P "; % CARD PATCHES TAPE. 02205500
- IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750
- LASTCRDPATCH:=TRUE ELSE 02208000
- READTAPE(LTLCR,MAXLTLCR,TRUE) ELSE 02208250
- READTAPE(TLCR,MAXTLCR,FALSE); 02208500
- END; 02208750
- LCR:=CLCR; 02209000
- LASTUSED:=IF LIB THEN 5 ELSE 2; 02209250
- END; 02209500
- END OF SEQCOMPARE; 02209750
- LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02210000
- EOF, USETHESWITCH, 02210250
- COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02210500
- LABEL COPYLIB, COPYEOF; %107- 02210600
- SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750
- LIBCLAST, LIBTLAST, COPYLIB; %107- 02211000
- BOOLEAN DOLLAR2TOG; 02211250
- IF ERRORCOUNT>=ERRMAX THEN ERR(611);% ERR LIMIT EXCEEDED - STOP. 02211500
-USETHESWITCH: 02211750
- GO TO USESWITCH[LASTUSED]; 02212000
- MOVE(1,TEXT[LASTUSED,LINKR,LASTUSED,LINKC], 02212250
- DEFINEARRAY[DEFINEINDEX-2]); 02212500
- LASTUSED := LASTUSED + 1; 02212750
- NCR := LCR-1; 02213000
- GO TO XIT; 02213250
-FIRSTTIME: 02213500
- READ(CARD,10,CBUFF[*]); 02213750
- FCR:=NCR:=(LCR:=MKABS(CBUFF[9]))-9; 02214000
- MEDIUM:="C "; 02214100
- IF EXAMIN(FCR)!="$" AND LISTER THEN PRINTCARD; 02214200
- PUTSEQNO(INFO[LASTSEQROW,LASTSEQENCE],LCR); 02214250
- CARDNUMBER:=CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02214260
- TURNONSOPTLIGHT("%",LCR); 02214500
- GO XIT; 02214750
-COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000
-CARDONLY: 02215250
- IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*]); 02215500
- LCR := MKABS(CBUFF[9]); GO EXIT; 02215750
-CARDLAST: 02216000
- IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*])[EOF]; 02216250
- CLCR := MKABS(CBUFF[9]); 02216500
- GO COMPAR; 02216750
-EOF: 02217000
- DEFINEARRAY[25]:="ND;END."&"E"[1:43:5]; 02217250
- DEFINEARRAY[34]:="9999"&"9999"[1:25:23]; 02217500
- CLCR:=MKABS(DEFINEARRAY[34]); 02217750
- PUTSEQNO(DEFINEARRAY[33],CLCR-8); 02218000
- TURNONSTOPLIGHT("%",CLCR-8); 02218250
-% 02218400
- GO COMPAR; 02218500
-COMMENT THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND 02218750
- SETS UP CLCR; 02219000
-TAPELAST: 02219250
- READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02219500
-COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02219750
-LIBCLAST: 02220000
- IF FIRSTIMEX THEN 02220250
- BEGIN FIRSTIMEX:=FALSE; GO COMPAR END; 02220500
- READ(CARD,10,CBUFF[*])[EOF]; 02220750
- CLCR := MKABS(CBUFF[9]); 02221000
- IF LASTCRDPATCH THEN 02221250
- BEGIN 02221500
- LASTCRDPATCH:=FALSE; 02221750
- RECOUNT:=RECOUNT+1; 02222000
- GO TO XIT 02222250
- END; 02222500
- GO TO COMPAR; 02222750
-LIBTLAST: 02223000
- IF FIRSTIMEX THEN 02223250
- BEGIN FIRSTIMEX:=FALSE; GO TO COMPAR END; 02223500
- READTAPE(LTLCR,MAXLTLCR,TRUE); 02223750
- IF RECOUNT=FINISHPT THEN GO TO XIT; 02224000
- GO COMPAR; %107- 02224010
-COPYLIB: %107- 02224020
- READ(LF[INSERTINX:=INSERTINX+1],10,LBUFF[*])[COPYEOF]; %107- 02224030
- READ SEEK(LF[INSERTINX+1]); %107- 02224032
- IF(CMPD(INSERTSEQ,LBUFF[9]) = 0) THEN GO COPYEOF; %107- 02224040
- LCR:=MKABS(LBUFF[9]); %107- 02224050
- GO TO EXIT; %107- 02224060
-COPYEOF: %107- 02224070
- CLOSE(LF,RELEASE); %107- 02224080
- IF((INSERTDEPTH:=INSERTDEPTH-1) = 0) THEN %107- 02224090
- BEGIN LASTUSED:=SAVECARD; MEDIUM:=MEDIUM.[24:12]; %107- 02224100
- GO USETHESWITCH; %107- 02224102
- END; %107- 02224104
- FILL LF WITH INSERTMID, INSERTFID; %107- 02224110
- GO COPYLIB; %107- 02224120
-COMPAR: 02224250
- IF LASTUSED = 2 OR LASTUSED = 3 THEN SEQCOMPARE(TLCR,CLCR,FALSE) 02224500
- ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02224750
-EXIT: 02225000
- NCR := FCR:= LCR - 9; 02225250
-COMMENT SETS UP NCR AND FCR; 02225500
- IF CHECKTOG AND EXAMIN(FCR)!="$" THEN %$=CARDS DON"T COUNT. 02225750
- IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000
- IF SEQERRTOG THEN BEGIN FLAG(610); 02226250
- NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300
- ELSE BEGIN % SEQUENCE WARNING 02226500
- BLANKET(14,LIN); 02226750
- SEQUENCEWARNING(LIN[13]); 02227000
- IF NOHEADING THEN DATIME; WRITELINE; 02227250
- IF NOT LISTER THEN PRINTCARD; 02227500
- NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1; 02227600
- END; 02227750
- IF EXAMIN(FCR)="$" THEN 02228250
- BEGIN 02228500
- IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD; 02228750
- IF EXAMIN(NCR:=NCR+32768)="$" THEN MAKCAST ELSE DOLLARCARD; 02229000
- NORELEASE := FALSE; 02229100
-COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250
- GO USETHESWITCH; 02229500
- END; 02229750
- IF EXAMIN(FCR)=" " THEN 02230000
- IF DOLLAR2TOG:=EXAMIN(FCR+32768)="$" THEN 02230100
- BEGIN 02230250
- OUTPUTSOURCE; 02230500
- IF EXAMIN(NCR:=NCR+65536)="$" THEN MAKCAST ELSE 02230750
- DOLLARCARD; 02231000
- END; 02231250
- IF VOIDING OR VOIDTAPE THEN 02231500
- BEGIN 02231750
- IF COMPARE(LCR,VOIDCR)=0 THEN 02232000
- BEGIN 02232250
- IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN 02232500
- GO USETHESWITCH; 02232750
- END 02233000
- ELSE BEGIN 02233250
- VOIDCR:=VOIDPLACE:=0; 02233500
- VOIDING:=FALSE; VOIDTAPE:=FALSE 02233750
- END; 02234000
- END; 02234250
- CARDCOUNT:=CARDOCUNT+1; 02234500
- IF DOLLAR2TOG THEN 02234600
- BEGIN DOLLAR2TOG:=NORELEASE:=FALSE; GO USETHESWITCH;END; 02234650
- PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02234750
- CARDNUMBER:=IF SEQTOG THEN TOTALNO+ADDVALUE ELSE 02234800
- CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02234900
- OUTPUTSOURCE; 02235000
- IF OMITTING THEN GO USETHESWITCH; 02235250
-% 02235500
- TURNONSTOPLIGHT("%",LCR); 02235750
- IF BUILDLINE THEN 02236000
- IF LASTADDRESS!= (LASTADDRESS := L.[36:10]) THEN 02236250
- BEGIN 02236500
- ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750
- IF (ENILPTR := ENILPTR+1)>=1023 THEN 02237000
- BEGIN FLAG(80); ENILPTR := 512; END; 02237250
- END; 02237500
-XIT: 02237750
- END READACARD; 02238000
-PROCEDURE INCLUDECARD; %107- 02238100
- BEGIN %107- 02238110
- REAL V; %107- 02238112
- LABEL EEXIT,AGAIN,GETEM,EOF,EXIT,DONTSCAN; %107- 02238120
- REAL STREAM PROCEDURE SCNN(A,B); VALUE B; %107- 02238130
- BEGIN %107- 02238140
- SI:=A; DI:=LOC SCNN; DS:=8 LIT"0 "; %107- 02238150
- DI:=DI-7; SI:=SI+3; DS:=8 CHR; %107- 02238160
- END; %107- 02238170
- STREAM PROCEDURE MVE(A,B,C,D); VALUE B,C; %107- 02238180
- BEGIN %107- 02238190
- SI:=A; SI:=SI+3; DI:=D; C(DS:=LIT"0"); DS:=B CHR; %107- 02238200
- END; %107- 02238210
-STREAM PROCEDURE MVEWD(A,B); VALUE A; %107- 02238212
- BEGIN SI:=A; DI:=B; DS:=10 WDS; END; %107- 02238214
- DEFINE SKAN = BEGIN %107- 02238220
- COUNT:=RESULT:=ACCUM[0]:=0; %107- 02238230
- SCANNER; %107- 02238240
- V:=SCNN(ACCUM[1],MIN(COUNT,7)); %107- 02238250
- END#; %107- 02238260
- DEFINE ERR(ERR1) = BEGIN FLAG(ERR1); GO TO EEXIT; END#; %107- 02238270
- IF((INSERTDEPTH:=INSERTDEPTH+1) > INSERTMAX) THEN ERR(612); %107- 02238280
- INSERTMID:=INSERTFID:=INSERTINX:=INSERTCOP:=0; %107- 02238290
- INSERTSEQ:="9999"&"9999"[1:23]; %107- 02238300
-AGAIN: %107- 02238330
- SKAN; %107- 02238340
-DONTSCAN: %107- 02238342
- IF V="% " THEN GO GETEM; %107- 02238350
- IF V="/ " THEN GO AGAIN; %107- 02238360
- IF RESULT=3 THEN % SEQ RANGE %107- 02238370
- BEGIN %107- 02238380
- MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTINX); %107- 02238385
- SKAN; %107- 02238390
- IF V="- " THEN %107- 02238400
- BEGIN %107- 02238410
- SKAN; %107- 02238420
- IF RESULT != 3 THEN ERR(614); %107- 02238430
- MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); %107- 02238440
- END ELSE GO TO DONTSCAN; %107- 02238450
- GO AGAIN; %107- 02238460
- END; % SEQ RANGE %107- 02238470
- IF V="+ " THEN % WE HAVE COPY FORM %107- 02238480
- BEGIN %107- 02238490
- SKAN; %107- 02238500
- IF V="COPY " THEN %107- 02238510
- IF EXAMIN(LCR-9)="$" THEN %107- 02238512
- INSERTCOP:=INSERTINFO[INSERTDEPTH-1,4] %107- 02238514
- ELSE ERR(617) %107- 02238520
- ELSE ERR(616); %107- 02238522
- GO AGAIN; %107- 02238530
- END; %107- 02238540
- IF INSERTMID=0 THEN INSERTMID:=V %107- 02238550
- ELSE IF INSERTFID=0 THEN INSERTFID:=V ELSE ERR(616); %107- 02238552
- GO AGAIN; %107- 02238555
-GETEM: %107- 02238560
- IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN %107- 02238570
- IF EXAMIN(FCR) = "$" THEN % ONLY IF "$" IS IN COLUMN ONE %107- 02238572
- IF BOOLEAN(INSERTINFO[INSERTDEPTH-1,4]) THEN % ONLY IF LAST HAD COPY 02238574
- BEGIN MVEWD(FCR,LBUFF[0]); %107- 02238580
- PUTSEQNO(LBUFF[9],MKABS(INFO[LASTSEQROW,LASTSEQUENCE])); %107- 02238582
- WRITE(NEWTAPE,10,LBUFF[*]); %107- 02238590
- END; %107- 02238600
- IF INSERTMID=0 THEN ERR(613); %107- 02238602
- IF INSERTMID=0 THEN INSERTFID:=TIME(-1); %107- 02238610
- IF INSERTMID=0 THEN %107- 02238620
- BEGIN INSERTFID:=INSERTMID; INSERTMID:=0; END; %107- 02238630
- IF INSERTDEPTH > 1 THEN CLOSE(LF,RELEASE); %107- 02238640
- FILL LF WITH ISNERTMID,INSERTFID; %107- 02238650
- READ(LF[0],10,LBUFF[*])[EEXIT]; % DO THE FOLLOWING SO THAT %107- 02238652
- INSERTMID:=LF.MFID; % IF THE OPERATOR IL-ED US %107- 02238654
- INSERTFID:=LF.FID; % WE WILL HAVE THE PROPER NAMES. 02238656
- V:=-1; %107- 02238658
- IF INSERTINX > 0 THEN %107- 02238660
- BEGIN %107- 02238670
- DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] %107- 02238680
- UNTIL CMPD(INSERTINX,LBUFF[9]) <= 1; %107- 02238690
- V:=V-1; %107- 02238700
- END; %107- 02238702
- INSERTINX:=V; %107- 02238704
- IF INSERTDEPTH = 1 THEN %107- 02238710
- BEGIN SAVECARD:=LASTUSED; LASTUSED:=7; MEDIUM:="L "& MEDIUM[24:12]; 02238720
- END; %107- 02238730
- GO TO EXIT; %107- 02238760
-EEXIT: %107- 02238770
- IF((INSERTDEPTH:=INSERTDEPTH-1) > 0) THEN %107- 02238780
- BEGIN %107- 02238790
- CLOSE(LF,RELEASE); %107- 02238800
- FILL LF WITH INSERTMID,INSERTFID; %107- 02238810
- END; %107- 02238820
-EXIT: %107- 02238830
- Q:="1%0000"; %107- 02238832
- END; %107- 02238840
-REAL PROCEDURE CONVERT; 02248000
- BEGIN REAL T; INTEGER N; 02249000
- TL0_0; THI_ 02250000
- T_ CONV(ACCUM[1],TCOUNT,N_(COUNT-TCOUNT)MOD 8); 02251000
- FOR N_ TCOUNT+N STEP 8 UNTIL COUNT- 1 DO 02252000
- IF DPTOG THEN 02253000
- BEGIN 02254000
- DOUBLE(THI,TLO,100000000.0,0,x,CONV(ACCUM[1],N,8),0,+,?, 02255000
- THI,TLO); 02256000
- T_THI; 02257000
- END ELSE 02258000
- T_ Tx100000000+ CONV(ACCUM[1],N,8); 02259000
- CONVERT_T; 02260000
- END; 02261000
-REAL STREAM PROCEDURE FETCH(F); VALUE F; 02262000
- BEGIN SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS END FETCH; 02263000
-PROCEDURE DUMPINFO; 02264000
- BEGIN 02264050
- ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100
- STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400
- BEGIN 02264450
- SI:=S; DI:=D; 02264500
- N(2(8(DS:=3 RESET; SKIP 1 SB)); DS:=1 LIT " "); DS:=2 LIT " "); 02264550
- DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600
- END OF OCTALWORDS; 02264650
- STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700
- BEGIN 02264750
- SI:=S; DI:=D; 02264800
- N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850
- END OF ALPHAWORDS; 02264900
- IF NOHEADING THEN DATIME;WRITE(LINE[DBL],); 02264950
- FOR JEDEN:=0 STEP 6 UNTIL 71 DO 02265000
- BEGIN 02265050
- BLANKET(14,A); OCTALWORDS(ELBAT[JEDEN],A,6); 02265100
- WRITE(LINE[DBL],15,A[*]); 02265150
- END; 02265200
- BLANKET(14,A); OCTALWORDS(ELBAT[72],A,4); 02265250
- WRITE(LINE[DBL],15,A[*]); 02265300
- FOR JEDEN:=0 STEP 1 UNTIL NEXTINFO DIV 256 DO 02265350
- BEGIN 02265400
- WRITE(LINE[DBL],,JEDEN); 02265450
- FOR DWA:=0 STEP 6 UNTIL 251 DO 02265500
- BEGIN 02265550
- BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,DWA],A,6); 02265600
- WRITE(LINE,15,A[*]); 02265650
- BLANKET(14,A); OCTALWORDS(INFO[JEDEN,DWA],A,6); 02265700
- WRITE(LINE[DBL],15,A[*]); 02265750
- END; 02265800
- BLANKET(14,A); ALPHAWORDS(INFO[JEDEN,252],A,4); 02265850
- WRITE(LINE,15,A[*]); 02265900
- BLANKET(14,A); OCTALWORDS(INFO[JEDEN,252],A,4); 02265950
- WRITE(LINE[DBL],15,A[*]); 02266000
- END; 02266050
- END OF DUMPINFO; 02266100
-DEFINE SKAN = BEGIN 02277000
- COUNT:=RESULT:=ACCUM[1]:=0; 02278000
- SCANNER; 02279000
- Q:=ACCUM[1]; 02280000
- END #; 02281000
-COMMENT DOLLARCARD HANDLES THE COMPILER CONTROL CARDS. 02282000
- ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT 02283000
- IN THE ARRAY "OPTIONS". 02284000
- EACH OPTION HAS A TWO-WORD ENTRY; 02285000
- 02286000
- WORD CONTAINS 02287000
- ---- -------- 02288000
- 1 ENTRY FROM ACCUM[1]: 00XZZZZ, WHERE 02289000
- X IS THE SIZE OF THE ID AND 02290000
- ZZZZZ IS THE FIRST FIVE CHARS OF THE ID. 02291000
- 2 PUSH-DOWN, 47-BIT STACK CONTAINING THE 02292000
- HISTORY OF THE SETTINGS OF THIS OPTION. 02293000
- 02294000
- IN "FINDOPTION", ALL COMPILER-DEFINED OPTIONS ARE USUALLY 02295000
- LOCATION BASED UPON A UNIQUE NUMBER ASSIGNED TO EACH. 02296000
- FOR ALL USER-DEFINED OPTIONS, A SEQUENTIAL TABLE SEARCH IS 02297000
- INITIATED USING "USEROPINX" AS THE INITIAL INDEX INTO THE 02298000
- "OPTIONS" ARRAY. IF THE NUMBER OF COMPILER-DEFINED OPTIONS 02299000
- IS CHANGED, THEN "USEROPINX" MUST BE ACCORDINGLY CHANGED. 02300000
- THE NUMBER OF USER DEFINED OPTIONS ALLOWED CAN BE 02301000
- CHANGED BY CHANGING THE DEFINE "OPARSIZE". 02302000
- THE VARIABLE "OPTIONWORD" CONTAINS THE CURRENT TRUE OR FALSE 02303000
- SETTING OF ALL THE COMPILER-DEFINED OPTIONS, ONE BIT PER 02304000
- OPTION. 02305000
- ; 02306000
-BOOLEAN PROCEDURE FINDOPTION(BIT); VALUE BIT; INTEGER BIT; 02307000
- BEGIN 02308000
- LABEL FOUND; 02309000
- REAL ID; 02310000
- OPINX:=2xBIT-4; 02311000
- WHILE ID:=OPTIONS[OPINX:=OPINX+2]!= D0 02312000
- IF Q=ID THEN GO FOUND; 02313000
- OPTIONS[OPINX]:=Q; % NEW USER-DEFINED OPTION. 02314000
-FOUND: %103- 02315000
- IF OPINX +1>OPARSIZE THEN FLAG(602) ELSE % TOO MANY USER OPTIONS 02316000
- FINDOPTION:=BOOLEAN(OPTIONS[OPINX+1]); 02317000
- END FINDOPTION; 02318000
-PROCEDURE DOLLARCARD; 02319000
- BEGIN 02320000
- PROCEDURE SWITCHIT(XBIT); VALUE XBIT; INTEGER XBIT; 02321000
- BEGIN 02322000
- BOOLEAN B,T; 02323000
- INTEGER SAVEINX; 02324000
- LABEL XMODE0,XMODE1,XMODE2,XMODE3,XMODE4,ALONG; 02325000
- SWITCH SW:=XMODE0,XMODE1,XMODE2,XMODE3,XMODE4; 02326000
- SETTING:=FINDOPTION(XBIT); SKAN; 02327000
- GO SW[XMODE+1]; 02328000
-XMODE0: % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP. 02329000
- OPTIONWORD:=BOOLEAN(0); 02330000
- FOR SAVEINX:=1 STEP 2 UNTIL OPARSIZE DO OPTIONS[SAVEINX]:=0; 02331000
- IF BUILDLINE.[45:1] THEN %108- 02331050
- BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; %108- 02331060
- XMODE:=1; IF LASTUSED < 5 AND LASTUSED!= 3 THEN LASTUSED:=1; 02332000
-XMODE1: % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED. 02333000
- OPTIONS[OPINX+1]:=REAL(TRUE); 02334000
- IF XBIT= NXTELBT 02644000
- DO BEGIN 02645000
-SCANAGAIN: 02646000
- COUNT:=RESULT:=ACCUM[1]:=0; SCANNER; 02647000
- GO RESULTSWITCH[RESULT]; 02648000
-ARGH: 02649000
- Q:=ACCUM[1]; FLAG(141); GO SCANAGAIN; 02650000
-SPECIALCHAR: 02651000
- GT1:=ACCUM[1].[18:6] - 2; 02652000
- ENDTOG:=GT1 = 57 AND ENDTOG; 02653000
-COMMENT OBTAIN ACTUAL CHARACTER FROM ACCUM; 02654000
- T:=SPECIAL[GT1>1[42:41:3]; 02655000
-COMMENT NOTICE COMPRESSION TECHNIQUE USED TO SHORTEN TABLE OF 02656000
- ELBAT WORDS FOR SPECIAL CHARACTERS; 02657000
- IF GT1:=T.INCR = 0 THEN GO COMPLETE; 02658000
- GO SPECIALSWITCH[GT1]; 02659000
-COMMENT INCR FIELD OF SPECIAL CHARACTER IS NON-ZERO FOR SPECIAL 02660000
- CHARACTERS REQUIRING SPECIAL HANDLING. INCR IS SWITCHED 02661000
- ON TO OBTAIN DISCRIMINATION; 02662000
-COLON: RESULT:=7; SCANNER; COMMENT ELIMINATE BLANKS - CHECKING 02663000
- FOR := IN PLACE OF _ ; 02664000
- IF EXAMIN (NCR) = "=" THEN 02665000
- BEGIN RESULT:=0; SCANNER; T:=SPECIAL[13] END; 02666000
- RESULT:=2; GO COMPLETE; 02667000
-DOT: 02668000
- IF EXAMIN(NCR)>9 OR ENDTOG THEN GO COMPLETE; 02680000
- NHI:=NLO:=0; 02681000
- C:=0; FSAVE:=0; GO FPART; 02682000
-ATSIGN: 02683000
-% RESULT:0; SCANNER; 02684000
-% IF COUNT>17 THEN GO ARGH; 02685000
-% IF OCTIZE(ACCUM[1],COUNT-1,17-COUNT,C) THEN GO ARGH 02686000
-% ELSE GO NUMBEREND; 02687000
- NHI:=C:=1; NLO:=FSAVE:=0; GO EPART; 02688000
-COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 02689000
-QUOTE: 02690000
- COUNT := 0; T := IF STREAMTOG THEN 63 ELSE 8; %111- 02691000
-% 02692000
-% 02692500
- DO BEGIN 02693000
- RESULT:=5; SCANNER; 02694000
- IF COUNT=T THEN 02695000
- IF EXAMIN(NCR)!= """ THEN GO ARGH; 02696000
- END UNTIL EXAMIN(NCR) = """; 02697000
- IF NOT STREAMTOG AND COUNT=8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 02697500
- BEGIN Q := ACCUM[1]; FLAG(254); GO TO SCANAGAIN; END; %111- 02697600
- Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02698000
- IF COUNT<0 THEN COUNT:=COUNT+64; 02699000
- ACCUM[1]:=Q; RESULT:=4; 02700000
-STRNGXT: T:=C:=0; 02701000
- T.CLASS:=STRNGCON; 02702000
- IF COUNT < 8 OR (COUNT = 8 AND NOT BOOLEAN %111- 02703000
- (ACCUM[1].[18:1])) THEN % FLAG BIT NOT SET, FULL WORD CONST. 02703050
-MOVEIT: 02704000
- MOVECHARACTERS(COUNT,ACCUM[1],3,C,8-COUNT) 02705000
- ELSE T.CLASS:=STRING; 02705100
- T.INCR:=COUNT; GO COMPLETE; 02705200
-% 02706000
-COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 02707000
- THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 02708000
- THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 02709000
- THE TWO CASES ARE PROCESSED DIFFERENTLY. THE FIRST CASE 02710000
- MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 02711000
- CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID. 02712000
- FOR A FULL DISCUSSION SEE DEFINEGEN; 02713000
-CROSSHATCH: 02714000
- IF DEFINECTR!=0 THEN GO COMPLETE; 02715000
- PUTSEQNO(GT1,LCR); 02716000
- TURNONSTOPLIGHT(0,LCR); 02717000
- IF DEFINEINDEX = 0 THEN GO ARGH; 02718000
- LCR:=(GT1:=DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 02719000
- NCR:=GT1 MOD 262144; 02720000
- LASTUSED:=(T:=DEFINEARRAY[DEFINEINDEX:=DEFINEINDEX-3]).[33:15]; 02721000
- IF (GT2 := T.[18:15])!= 0 THEN % THIS WAS A PARAMETRIC DEFINE 02721500
- BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD %122- 02722000
- GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500
- DO %122- 02723000
- PUT(TEXT[(NEXTTEXT:=(GT1:=TAKE(DEFSTACKHEAD)),DYNAM-1) 02723500
- ,LINKR,NEXTTEXT,LINKC],DEFSTACKHEAD) %122- 02724000
- % THIS RESTORES THE PREVIOUS ELBAT WORD FOR %122- 02724500
- % THIS PARAMETER IN CASE OF NESTED DEFINE. %122- 02725000
- UNTIL %122- 02725500
- GT2 = (DEFSTACKHEAD := GT1.LINK); %122- 02726000
- END; %122- 02727000
- GO SCANAGAIN; 02728000
-DOLLAR: COMMENT THIS CODE HANDLES CONTROL CARDS; 02729000
- IF GT1:=EXAMIN(NCR)="$" THEN GO DBLDOLLAR ELSE DOLLARCARD; 02730000
-PERCENT: IF NCR!= FCR THEN READACARD; 02731000
- IF LIBINDEX!=0 THEN 02732000
- IF RECOUNT=FINISHPT THEN 02733000
- BEGIN 02734000
- SEARCHLIB(FALSE); READACARD; NORELEASE:=FALSE 02735000
- END; 02736000
- GO SCANAGAIN; 02737000
-COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 02738000
- PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 02739000
- SIDE EFFECT IS THAT ALL CHARACTERS ON A CARD ARE IGNORED 02740000
- AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR 02741000
- COMMENT); 02742000
-COMMENT MIGHT BE FUNNY COMMA - HANDLE HERE; 02743000
-RTPAREN: RESULT:=7; SCANNER; 02744000
- IF EXAMIN(NCR) = """ THEN 02745000
- BEGIN 02746000
- RESULT:=0; SCANNER; 02747000
- DO BEGIN 02748000
- RESULT:=5; SCANNER 02749000
- END UNTIL EXAMIN(NCR) = """; 02750000
- RESULT:=0; SCANNER; 02751000
- RESULT:=7; SCANNER; 02752000
- IF EXAMIN(NCR)!= "(" THEN GO ARGH; 02753000
- RESULT:=0; SCANNER; Q:=ACCUM[1]; 02754000
- T:=SPECIAL[24] 02755000
- END; 02756000
- RESULT:=2; GO COMPLETE; 02757000
-IPART: TCOUNT:=FSAVE:=0; C:=CONVERT; 02758000
- RESULT:=7; SCANNER; % DEBLANK. 02759000
- IF DEFINECTR=0 THEN 02760000
- IF (C=3 OR C=4) AND EXAMIN(NCR)=""" THEN %OCTAL OR HEX STRING. 02761000
- IF NOT (ACCUM[0].CLASS=FILEID AND INFO[LASTINFO. % 1641 02761500
- LINKR, LASTINFO.LINKC] = ACCUM[0])THEN % 1641 02761501
- BEGIN INTEGER SIZ; 02762000
- RESULT:=5; SCANNER; % SKIP QUOTE. 02763000
- COUNT:=0; 02764000
- DO BEGIN 02765000
- RESULT:=5; SCANNER; 02766000
- IF COUNT > SIZ:=48 DIV C THEN % > 1 WORD LONG. 02767000
- BEGIN ERR(520); GO SCANAGAIN END; 02768000
- END UNTIL EXMAIN(NCR)="""; 02769000
- Q:=ACCUM[1]; RESULT:=5; SCANNER; COUNT:=COUNT-1; 02770000
- IF C=3 THEN % OCTAL STRING. 02771000
- IF OCTIZE(ACCUM[1],ACCUM[4],16-COUNT,COUNT) THEN 02772000
- FLAG(521) % NON-OCTAL CHARACTER IN STRING. 02773000
- ELSE ELSE IF HEXIZE(ACCUM[1],ACCUM[4],12-COUNT,COUNT) THEN 02774000
- FLAG(521); % NON-HEX CHARACTER IN HEX STRING. 02775000
- T.INCR := COUNT := (CxCOUNT-1)DIV 6 + 1; % # OF CHARS. 02776100
- T.CLASS:= STRNGCON; %111- 02776200
- MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); %111- 02776300
- IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. %111- 02776400
- IF STREAMTOG THEN %111- 02776500
- T.CLASS := STRING %111- 02776600
- ELSE %111- 02776700
- FLAG(254) %111- 02776800
- ELSE %111- 02776900
- C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000
- MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); %111- 02777050
- GO TO COMPLETE; %111- 02777100
- MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000
- GO COMPLETE; 02782000
- END OF OCTAL OR HEX STRING; 02783000
- IF DPTOG THEN 02784000
- BEGIN NHI:=THI; NLO:=TLO; END; 02785000
- IF EXAMIN(NCR)="." THEN 02786000
- BEGIN 02787000
- RESULT:=0; SCANNER; 02788000
- C:=1.0x C; 02789000
-FPART: TCOUNT:=COUNT; 02790000
- IF EXAMIN(NCR)<=9 THEN 02791000
- BEGIN 02792000
- RESULT:=0; SCANNER; 02793000
- IF DPTOG THEN 02794000
- BEGIN 02795000
- DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000
- 0,.,:=,THI,TLO); 02797000
- FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000
- DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000
- DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000
- C:=NHI 02801000
- END 02802000
- ELSE C:=CONVERT+CxTEN[FSAVE:=COUNT-TCOUNT]; 02803000
- END 02804000
- END; 02805000
- RESULT:=7; SCANNER; 02806000
- IF EXAMIN(NCR)="@" THEN 02807000
- BEGIN 02808000
- RESULT:=0; SCANNER; 02809000
-FPART: TCOUNT:=COUNT; 02810000
- C:=Cx1.0; 02811000
- RESULT:=7; SCANNER; 02812000
- IF T:=EXAMIN(NCR)>9 THEN 02813000
- IF T="-" OR T = "+" THEN 02814000
- BEGIN 02815000
- RESULT:=0; SCANNER; 02816000
- TCOUNT:=COUNT; 02817000
- END 02818000
- ELSE FLAG(47); 02819000
- RESULT:=0; SCANNER; 02820000
- IF RESULT!= 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000
- Q:=ACCUM[1]; 02822000
- IF GT1:=T:=(IF T="-" THEN -CONVERT ELSE CONVERT)<-46 OR 02823000
- T>69 THEN FLAG(269) 02824000
- ELSE BEGIN 02825000
- T:=TEN[ABS(GT3:=T-FSAVE)]; 02826000
- IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>3[1:1:1] 02827000
- + 12) >63 THEN FLAG(269) 02828000
- ELSE IF DPTOG THEN 02829000
- IF GT1<0 THEN 02830000
- BEGIN 02831000
- GT1:=-GT1; 02832000
- DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,/,:=,NHI,NLO); 02833000
- FOR GT2:=12 STEP 12 UNTIL GT1 DO 02834000
- DOUBLE(NHI,NLO,TEN[12],0,/,:=,NHI,NLO); 02835000
- END 02836000
- ELSE BEGIN 02837000
- DOUBLE(NHI,NLO,TEN[GT1 MOD 12],0,x,:=,NHI,NLO); 02838000
- FOR GT2:=12 STEP 12 UNTIL GT1 DO 02839000
- DOUBLE( NHI,NLO,TEN[12],0,x,:=,NHI,NLO); 02840000
- END 02841000
- ELSE C:=IF GT3<0 THEN C/T ELSE CxT; 02842000
- END; 02843000
- END 02844000
- ELSE IF FSAVE!= 0 THEN C:=C/TEN[FSAVE]; 02845000
- Q:=ACCUM[1]; RESULT:=3; 02846000
-FINISHNUMBER: 02847000
- T:=0; 02848000
- IF C.[1:37]=0 THEN 02849000
- BEGIN T.CLASS:=LITNO ; T.ADDRESS:=C END 02850000
- ELSE T.CLASS:=NONLITNO ; 02851000
- GO COMPLETE; 02852000
-COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 02853000
- IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 02854000
- ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 02855000
- TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK. 02856000
- TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR 02857000
- COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO 02858000
- COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND 02859000
- ROSE IS ENTERED. THE LAST THING DONE FOR ANY 02860000
- IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION 02861000
- OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS 02862000
- ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, 02863000
- SHOULD THIS BE REQUIRED. ; 02864000
-IDENT: IF T:=SUPERSTACK[SCRAM:=(Q:=ACCUM[1])MOD 125]!=0 THEN 02865000
- BEGIN 02866000
- IF INFO[GT1:=T.LINKR,(GT2:=T.LINKC)+1]=Q THEN 02867000
- BEGIN 02868000
- T:=INFO[GT1,GT2]&T[35:35:13]; 02869000
- GO COMPLETE 02870000
- END 02871000
- END; 02872000
- IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN T:=DEFSTACKHEAD 02873000
- ELSE T:=STACKHEAD[SCRAM]; 02874000
-ROSE: GT1:=T.LINKR; 02875000
- IF(GT2:=T.LINKC)+GT1= 0 THEN 02876000
- BEGIN T:=0; GO COMPLETE END; 02877000
- IF T = INFO[GT1, GT2] THEN BEGIN %101- 02877010
- T:= 0; GO TO COMPLETE END; %101- 02877020
- T:=INFO[GT1,GT2]; 02878000
- IF INFO[GT1,GT2+1]&0[1:1:11]!= Q THEN GO ROSE; 02879000
- IF COUNT<= 5 THEN GO COMPOST ; 02880000
- IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE; 02881000
-COMPOST: T:=T>1[35:43:5]>2[40:40:8]; 02882000
- IF GT1!=1 AND NOT MACROID THEN % NOT RESERVED WORD %116- 02882100
- XREFIT(T,LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY %116- 02882200
-COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02883000
- IF NOT ENDTOG THEN 02884000
- BEGIN 02885000
- IF GT1:=T.CLASS = COMMENTV THEN 02886000
- BEGIN 02887000
- WHILE EXAMIN(NCR)!= ";" DO 02888000
- BEGIN RESULT:=6; COUNT:=0; SCANNER END; 02889000
- RESULT:=0;SCANNER;GO SCANAGAIN 02890000
- END 02891000
- END; 02892000
- IF STOPDEFINE THEN GO COMPLETE; 02893000
- IF GT1!= DEFINEDID THEN GO COMPLETE; 02894000
-COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000
- IF BOOLEAN(T,MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000
- GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000
- IF DEFINEINDEX = 24 THEN 02898000
- BEGIN FLAG(139);GO ARGH END; 02899000
- DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000
- LASTUSED:=T.DYNAM; 02901000
- DEFINEARRAY[DEFINEINDEX+2]262144xLCR+NCR; 02902000
- LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02903000
- PUTSEQNO(GT4,LCR); 02904000
- TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3; 02905000
- GO PERCENT; 02906000
-DBLDOLLAR: 02907000
- MAKCAST; GO SCANAGAIN; 02908000
-COMPLETE: 02909000
- ELBAT[NXTELBT]:=T; 02910000
- IF NOT DEFINING THEN 02910100
- IF T.CLASS = BEGINV THEN 02910200
- BEGINSTACK[BSPOINT:=BSPOINT+1]:=CARDNUMBER ELSE 02910300
- IF T.CLASS = ENDV THEN 02910400
- BEGIN 02910500
- IF LISTER THEN IF BEND THEN BEGINPRINT; 02910600
- BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700
- END; 02910800
- STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000
- IF NXTELBT:=NXTELBT+! > 74 THEN 02912000
- IF NOT MACROID THEN 02913000
- BEGIN 02914000
-COMMENT ELBAT IS FULL: ADJUST IT; 02915000
- MOVE(10,ELBAT[65],ELBAT); 02916000
- I:=I-65; P:=P-65; NXTELBT:=10; 02917000
- END 02918000
- END; 02919000
- IF TABLE:=ELBAT[P].CLASS = COMMENTV THEN 02920000
- BEGIN 02921000
-COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02922000
- C:=INFO[0,ELBAT[P].ADDRESS]; 02923000
- ELBAT[P].CLASS:=TABLE:=NONLITNO 02924000
- END; 02925000
- STOPDEFINE:=FALSE; COMMENT ALLOW DEFINE; 02926000
- END TABLE ; 02927000
-INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE,NAME) %106- 02927100
- VALUE SIZE,NAME; REAL SIZE,NAME; ARRAY FROM [0,0]; %106- 02927110
- BEGIN %106- 02927120
- INTEGER NSEGS,I,J,K; %106- 02927130
- ARRAY A[0:14]; %106- 02927140
- SWITCH FORMAT FMT := %106- 02927150
- (/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), %106- 02927160
- (/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), %106- 02927170
- (/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106- 02927180
- (/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), %106- 02927190
- (/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), %106- 02927200
- (/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), %106- 02927210
- (/,"SEGMENT ZERO",I*,/), %106- 02927220
- (/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); %106- 02927230
- STREAM PROCEDURE OCTALWORDS(N,W,S,D); VALUE N,W; %106- 02927240
- BEGIN %106- 02927250
- DI:=D; DS:=LIT" "; %106- 02927260
- SI:=LOC N; SI:=SI+6; %106- 02927270
- 4(DS:=3 RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02927272
- DI:=DI-4; DS:=3 FILL; %106- 02927280
- DI:=D; DI:=DI+5; DS:=4 LIT" "; %106- 02927290
- SI:=S; %106- 02927300
- W(2(8(DS:=3 RESET; %106- 02927310
- 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); %106- 02927320
- ); %106- 02927330
- DS:=LIT" "); %106- 02927340
- DS:=2 LIT" "); %106- 02927350
- END OF OCTALWORDS; %106- 02927360
- %********** S T A R T ********** %106- 02927370
- NSEGS:=(SIZE+29) DIV 30; %106- 02927380
- IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN %106- 02927390
- DA:=CHUNKxT; %106- 02927400
- MOVEANDBLOCK:=DA; %106- 02927410
- IF CODEFILE THEN %106- 02927420
- IF NAME>=0 THEN %106- 02927430
- WRITE(LINE,FMT[NAME],DA) %106- 02927440
- ELSE %106- 02927450
- WRITE(LINE,FMT[7],ABS(NAME),DA); %106- 02927460
- IF SIZE!=0 THEN %106- 02927470
- BEGIN %106- 02927480
- FOR J:=0 STEP 30 WHILE J < SIZE DO %106- 02927490
- BEGIN %106- 02927500
- IF (K:=(128-(J MOD 128))) < 30 THEN %106- 02927510
- BEGIN %106- 02927520
- MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); %106- 02927530
- MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); %106- 02927540
- END %106- 02927550
- ELSE %106- 02927560
- MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); %106- 02927570
- IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION %106- 02927580
- BEGIN %106- 02927590
- K:=0; %106- 02927600
- MOVE(1,K,CODE(SIZE-J)); %106- 02927610
- IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD %106- 02927612
- MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); %106- 02927620
- END; %106- 02927630
- IF CODEFILE THEN %106- 02927640
- BEGIN %106- 02927650
- FOR K:=0 STEP 5 WHILE K<=25 AND (J+K)<=SIZE DO %106- 02927660
- BEGIN %106- 02927670
- BLANKET(14,A); %106- 02927680
- OCTALWORDS(J+K,IF (J_K+5)<=SIZE THEN 5 ELSE %106- 02927690
- SIZE-J-K,CODE(K),A); %106- 02927700
- WRITE(LINE,15,A[*]); %106- 02927710
- END; %106- 02927720
- WRITE(LINE); %106- 02927722
- END; %106- 02927730
- WRITE(CODE[DA]); DA:=DA+1; %106- 02927740
- END; %106- 02927750
- END; %106- 02927760
- END OF MOVEANDBLOCK; %106- 02927770
-COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE NEXT FORMAT GENERATOR. 02928000
- IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000
- PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000
- NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000
-PROCEDURE NEXTENT; 02932000
- BEGIN LABEL DEBLANK; 02933000
- COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02934000
-DEBLANK: 02935000
- IF EXAMIN(NCR)=" "THEN 02936000
- BEGIN 02937000
- RESULT:=7; SCANNER; 02938000
- END; 02939000
- IF EXAMIN(NCR)<= 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000
- BEGIN 02941000
- RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000
- IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000
- ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000
- END 02945000
-ELSE IF EXAMIN(NCR)="%" THEN 02946000
- BEGIN 02947000
- READACARD; COUNT:=ACCUM[1]:=0; GO DEBLANK; 02948000
- END 02949000
-ELSE BEGIN 02950000
- RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02951000
- Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02952000
- END 02953000
- END OF NEXTENT; 02954000
- BOOLEAN PROCEDURE BOOLPRIM; FORWARD; 02955000
- PROCEDURE BOOLCOMP(B); BOOLEAN B; FORWARD; 02955500
- INTEGER PROCEDURE NEXT; 02956000
- BEGIN 02956500
- LABEL EXIT; 02957000
- INTEGER T; 02957500
- DEFINE ERROR = BEGIN FLAG(603); GO EXIT END#; 02958000
- SKAN; 02958500
- IF RESULT=3 THEN ERROR; % NUMBERS NOT ALLOWED. 02959000
- IF RESULT=2 THEN % SPECIAL CHARACTER. 02959500
- BEGIN 02960000
- T:=IF Q="1,0000" OR Q="1%0000" THEN 20 % FAKE OUT BOOLEXP. 02960500
- ELSE ((T:=Q.[18:6]-2) & T[42:41:3]); 02961000
- IF T=11 OR T=19 OR T=20 THEN BATMAN:=SPECIAL[T] % (,),OR ; 02961500
- ELSE FLAG(603); 02962000
- GO EXIT 02962500
- END SPECIAL CHARACTERS; 02963000
-COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 02963500
- T:= IF Q="3NOT00" THEN NOTOP 02964000
- ELSE IF Q="3AND00" THEN ANDOP 02964500
- ELSE IF Q="3OR000" THEN OROP 02965000
- ELSE IF Q="3EQV00" THEN EQVOP 02965500
- ELSE 0; 02966000
- IF T!=0 THEN BATMAN.CLASS:=T 02966500
- ELSE BATMAN:=1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION. 02967000
-EXIT: 02967500
- NEXT:=MYCLASS:=BATMAN.CLASS; 02968000
- END NEXT; 02968500
- BOOLEAN PROCEDURE BOOLEXP; 02969000
- BEGIN 02969500
- BOOLEAN B; 02970000
- B:=BOOLPRIM; 02970500
- WHILE MYCLASS>=EQVOP AND MYCLASS<=ANDOP DO BOOLCOMP(B); 02971000
- BOOLEXP:=B 02971500
- END BOOLEXP; 02972000
- BOOLEAN PROCEDURE BOOLPRIM; 02972500
- BEGIN 02973000
- BOOLEAN B,KNOT; 02973500
- DEFINE SKIPIT = MYCLASS:=NEXT #; 02974000
- IF KNOT:=(NEXT=NOTOP) THEN SKIPIT; 02974500
- IF MYCLASS=LEFTPAREN THEN 02975000
- BEGIN 02975500
- B:=BOOLEXP; 02976000
- IF MYCLASS!=RTPAREN THEN FLAG(604); 02976500
- END 02977000
- ELSE IF MYCLASS!=BOOID THEN FLAG(601) 02977500
- ELSE B:=BATMAN<0; 02978000
- IF KNOT THEN B:=NOT B; SKIPIT; 02978500
- BOOLPRIM:=B 02979000
- END BOOLPRIM; 02979500
- PROCEDURE BOOLCOMP(B); BOOLEAN B; 02980000
- BEGIN 02980500
- REAL OPCLASS; 02981000
- BOOLEAN T; 02981500
- OPCLASS:=MYCLASS; 02982000
- T:=BOOLPRIM; 02982500
- WHILE OPCLASS=64 THEN FLAG(268); 04013000
- EMIT(OPERATOR&REPEAT[36:42:6]) END EMITC; 04014000
- COMMENT EMITV EMITS AND 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
- EMIL(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. THIS 04037000
- 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, XTOTHE, 04041000
- IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000
- (APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000
- OTHERWISE IT CALLS LN AND EXP; 04044000
- PROCEDURE EMITUP; 04045000
- BEGIN INTEGER BACKUP, CTR; 04046000
- LABEL E; 04047000
- IF NOT LINKTOG THEN GO TO E; 04048000
- COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000
- IF GET(L-1) = 537 THEN 04050000
- COMMENT LAST OPERATOR IS CHS; 04051000
- BEGIN BACKUP _ 1; L _ L-1 END; 04052000
- IF(GT4 _ GET(L-1)).[46:2] = 0 04053000
- THEN BEGIN 04054000
- COMMENT IT IS A LITERAL; 04055000
- BACKUP _ BACKUP+1; L _ L-1; 04056000
- IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000
- COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000
- CTR _ 1; GT4 _ GT4 DIV 4; 04059000
- WHILE GT4 DIV 2 ! 0 04060000
- DO BEGIN 04061000
- EMITO(DUP); 04062000
- IF BOOLEAN(GT4) THEN BEGIN CTR_CTR+1;EMITO(DUP)END; 04063000
- EMITO(MUL); 04064000
- GT4 _ GT4 DIV 2 END; 04065000
- IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000
- ELSE WHILE CTR _ CTR-1 ! 0 DO EMITO(MUL); 04067000
- IF BACKUP = 2 04068000
- THEN BEGIN 04069000
- EMITL(1); 04070000
- EMITO(XCH); 04071000
- EMITO(128) END END 04072000
- ELSE BEGIN 04073000
- E: L _ L+BACKUP; 04074000
- EMITO(MKS); 04075000
- EMITPAIR(GNAT(LOGI),LOD); 04076000
- EMITPAIR(GNAT(EXPI),LOD); 04077000
- EMITV(GNAT(XTOTHEI)); 04078000
- STACKCT _ 0; %A 04078500
- EMITO(DEL) END END EMITUP; 04079000
- COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 04080000
- INERVENING SPACE WITH NOPS, IT CHECKS STREAMTOG TO DECIDE 04081000
- WHICH SORT OF NOP TO USE; 04082000
- PROCEDURE ADJUST; 04083000
- BEGIN 04084000
- DIALA _ DIALB _ 0; 04085000
- WHILE L.[46:2] ! 0 DO EMIT(IF STREAMTOG THEN 1 ELSE 45) 04086000
- END ADJUST; 04087000
- COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 04088000
- NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 04089000
- BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 04090000
- (FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 04091000
- OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 04092000
- ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 04093000
- COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 04094000
- EMITS FOLLOWED BY L _ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP, 04095000
- AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 04096000
- EMITLNG; 04097000
- PROCEDURE EMITLNG; 04098000
- BEGIN LABEL E; 04099000
- IF NOT LINKTOG THEN GO TO E; 04100000
- COMMENT GO TO E IF LAST THING IS A LINK; 04101000
- IF GET(L) ! 0 THEN GO TO E; 04102000
- COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 04103000
- LNG OR RELATIONAL OPERATOR; 04104000
- IF GT1 _ GET(L-1) = 77 THEN L _ L-1 04105000
- COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 04106000
- ELSE IF GT1.[42:6]=21 AND GT1.[37:2]=0 THEN % AHA 04107000
- COMMENT LAST THING WAS A RELATIONAL; 04108000
- BEGIN L_L-1; EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 04109000
- BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 04110000
- COMMENT NEGATE THE RELATIONAL; END ELSE 04111000
- E: EMITO(LNG) END EMITLNG; 04112000
- COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 04113000
- PROCEDURE EMITB(BRANCH,FROM,TOWARDS); 04114000
- VALUE BRANCH,FROM,TOWARDS; 04115000
- INTEGER BRANCH,FROM,TOWARDS; 04116000
- BEGIN 04117000
- INTEGER TL; 04118000
- TL _ L; 04119000
- L _ FROM-2; 04120000
- GT1 _ TOWARDS-FROM; 04120100
- IF TOWARDS.[46:2] = 0 04120200
- THEN BEGIN 04120300
- BRANCH _ BRANCH&1[39:47:1]; 04120400
- GT1 _ TOWARDS DIV 4 - (FROM-1) DIV 4 END; 04120500
- EMITNUM(ABS(GT1)); 04121000
- EMITO(BRANCH&(REAL(GT1>=0)+1)[42:46:2]); 04122000
- IF BOOLEAN(BRANCH.[38:1]) THEN DIALA _ DIALB _ 0; 04123000
- L _ TL; 04124000
- END EMITB; 04125000
- COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 04126000
- OCTAL, NAMELY : 04127000
- 1. 4 CHARACTERS FOR THE L REGISTER. 04128000
- 2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 04129000
- STREAM PROCEDURE DEBUGWORD( SFQ,CODE,FEIL); VALUE SEQ,CODE ; 04130000
- BEGIN 04131000
- DI_FEIL; SI_ LOC SEQ; SI_ SI+4; DS _ 4 CHR; 04132000
- DS _ 2 LIT" "; 04133000
- SI _ LOC CODE ; 04134000
- 16( DS _ 3 RESET; 3( IF SB THEN DS_SET ELSE 04135000
- DS _ RESET ; SKIP 1 SB)); 04136000
- 49(DS _ 2 LIT " "); 04137000
- END ; 04138000
- COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 04139000
- DEBUGGING IS REQUIRED. "L" AND "WORD" ARE OUTPUT ON 04140000
- THE PRINTER FILE IN OCTAL FORMAT. ; 04141000
- PROCEDURE EMITWORD (WORD); VALUE WORD; REAL WORD; 04142000
- BEGIN 04143000
- ADJUST; 04144000
- IF L>=4092 THEN ERR(200); 04145000
- ELSE BEGIN 04146000
- MOVE(1,WORD,EDOC[L.[36:3],L.[39:7]]); 04147000
- IF DEBUGTOG THEN 04148000
- BEGIN DEBUGWORD(B2D(L),WORD,LIN); 04149000
- WRITELINE END; 04150000
- L_L+4 END 04151000
- END EMITWORD; 04152000
- COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 04153000
- BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 04154000
- EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 04155000
- OF C-RELATIVE OPDC S LEFT BY EMITNUM, IF C-RELATIVE 04156000
- ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 04157000
- IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 04158000
- THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 04159000
- AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 04160000
- F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 04161000
- CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 04162000
- PROCEDURE CONSTANTCLEAN ; 04163000
- IF MRCLEAN THEN 04164000
- BEGIN 04165000
- INTEGER J,TEMPL,D,LINK; 04166000
- BOOLEAN CREL; 04167000
- LABEL ALLTHU ; 04168000
- DIALA _ DIALB _ 0; 04169000
- FOR J _ 1 STEP 2 UNTIL LASTENTRY DO 04170000
- BEGIN 04171000
- ADJUST; TEMPL_L; L_INFO[0.255-J+1]; 04172000
- CREL _ FALSE; 04173000
- DO BEGIN 04174000
- IF D_(TEMPL-L+3)DIV 4>=128 THEN 04175000
- BEGIN 04176000
- NCII_NCII+1; 04177000
- PUTNBUMP(L&NONLITNO[2:41:7]&(NEXTINFO-LASTINFO)[27:40:8]); 04178000
- PUTNBUMP(TAKE(255-J)); LASTINFO_NEXTINFO-2; 04179000
- GO TO ALLTHU; 04180000
- END; 04181000
- LINK_GET(L); 04182000
- CREL _ TRUE; 04183000
- EMITV(D + 768); 04184000
- END UNTIL L_ LINK = 4095 ; 04185000
- ALLTHU: L _ TEMPL; 04186000
- IF CREL THEN EMITWORD( INFO[0,255-J ]); 04187000
- END; 04188000
- LASTENTRY _ 0; 04189000
- END ; 04190000
- COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 04191000
- EXPLICIT AND IMPLICIT, IN EVERY CASE,EMITNUM WILL 04192000
- PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 04193000
- THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 04194000
- SYLLABLE IS PRODUCED, HOWEVER,NON-LITERALS ARE KEPT 04195000
- IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 04196000
- POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 04197000
- CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 04198000
- TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 04199000
- IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 04200000
- ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 04201000
- OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 04202000
-PROCEDURE EMITNUM( C ); VALUE C; REAL C; 04203000
- BEGIN LABEL FINISHED,FOUND ; REAL N; 04204000
- IF C.[1:37]=0 THEN EMITL(C) 04205000
- ELSE 04206000
- BEGIN 04207000
- FOR N _ 1 STEP 2 UNTIL LASTENTRY DO 04208000
- IF INFO[0,255-N] = C THEN GO TO FOUND ; 04209000
- INFO[0,255 -LASTENTRY] _ L; 04210000
- INFO[0,255 -LASTENTRY-1]_ C ; 04211000
- EMITN(1023); 04212000
- LINKTOG_FALSE; 04213000
- IF LASTENTRY _ LASTENTRY+2>= 128 THEN 04214000
- BEGIN 04215000
- C _ BUMPL; 04216000
- CONSTANTCLEAN; 04217000
- EMITB(BFW,C,L); 04218000
- END; 04219000
- GO TO FINISHED; 04220000
- FOUND: EMIT(INFO[0,255 -N+1]); 04221000
- LINKTOG_FALSE; 04222000
- INFO[0,255-N+1]_ L-1; 04223000
- END; 04224000
- FINSIHED:END EMITNUM ; 04225000
- COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 04226000
- ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 04227000
- MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 04228000
- BE FOUND SEARCH YIELDS BLANKS. 04229000
- NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 04230000
-ALPHA PROCEDURE SEARCH (Q,KEY); VALUE KEY; ARRAY Q[0]; REAL KEY ; 04231000
- BEGIN LABEL L; 04232000
- COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 04233000
- BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 04234000
- AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 04235000
- THE LENGTH OF Q IS 128. ; 04236000
- INTEGER N,I ; 04237000
- N _ 64 ; 04238000
- FOR I _ 66 STEP IF Q[I]=1 DO 04240000
- IF Q[ I ]=KEY THEN GO TO L ; 04241000
- I _0; COMMENT ARGUMENT NOT FOUND,SEARCH=Q[1] ; 04242000
- L: SEARCH_Q[ I +1] ; 04243000
- END SEARCH ; 04244000
- COMMENT B2D CONVERTS THE FOUR LOW ORDER OCTAL DIGITS TO BCD 04245000
- CODE ; 04246000
-ALPHA PROCEDURE B2D(B); VALUE B; REAL B; 04247000
- B2D_0&B[45:45:3]&B[39:42:3]&B[33:39:3]&B[27:36:3] ; 04248000
- COMMENT PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE 04265000
- INTO THE EDOC ARRAY. THE SPECIFIC ELEMENT OF EDOC 04266000
- IS PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128] 04267000
- SYLLABLE POSITION=(L MOD 4 ). WHERE L IS THE SYLLABLE 04268000
- NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT; 04269000
-STREAM PROCEDURE PACK(WORD,POSITION,SYLLABLE); 04270000
- VALUE POSITION,SYLLABLE; 04271000
- BEGIN 04272000
- DI_WORD ; DI _ DI+POSITION ; DI _ DI_POSITION; 04273000
- SI_LOC SYLLABLE ; SI_SI+6; 04274000
- DS_2 CHR ; 04275000
- END PACK ; 04276000
-PROCEDURE DEBUG(S); 04277000
- VALUE S; REAL S ; 04278000
- IF STREAMTOG THEN 04279000
- IF SINGLTOG THEN 04279100
- WRITE(LINE,BUG,B2D(L),COP[S.[42:6]],B2D(S.[36:6]),B2D(S)); 04279200
- ELSE 04279300
- WRITE(LINE[DBL],BUG,B2D(L),COP[S.[42:6],B2D(S.[36:6]), 04280000
- B2D(S)) 04281000
- 04282000
- ELSE 04283000
- 04284000
- IF SINGLTOG THEN 04284100
- WRITE(LINE,BUG,B2D(L),IF T1_S.[46:2]=1 THEN 04284200
- BUGGER(S.[36:10]) ELSE WOP[T1],IF T1=1 THEN WOP[1] 04284300
- ELSE B2D(S.[36:10]),B2D(S)) 04284400
- ELSE 04284500
- WRITE(LINE[DBL],BUG,B2D(L),IF T1_S.[46:2]=1 THEN 04285000
- BUGGER(S.[36:10]) ELSE WOP[T1],IF T1=1 THEN WOP[1] 04286000
- ELSE B2D(S.[36:10]),B2D(S)); 04287000
- COMMENT EMIT PLACES SYLLABLES INTO EDOC, CALLS DEBUG FOR 04288000
- DEBUGGING OUTPUT ON THE PRINTER, AND CHECKS FOR SEGMENTS 04289000
- GREATER THAN 4093 SYLLABLES. ; 04290000
-PROCEDURE EMIT ( S ) ; VALUE S; REAL S ; 04291000
- BEGIN 04292000
- IF L <4092 THEN 04293000
- BEGIN 04294000
- LINKTOG _ TRUE; 04295000
- PACK( EDOC[L.[36:3 ],L.[39:7]],L.[46:2],S); 04296000
- IF DEBUGTOG THEN DEBUG(S); 04297000
- L_L+1; 04298000
- END ELSE 04299000
- ERR(200) 04300000
- COMMENT 200 EMIT - SEGMENT GREATER THAN 4093 SYLLABLES *; 04301000
- END EMIT ; 04302000
- COMMENT THE PRINCIPLE FUNCTION OF DEBUG IS TO COMPUTER THE PROPER 04303000
- PARAMETERS FOR STREAM PROCEDURE BUG; 04304000
- COMMENT EMITD EMITS TEH 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 SYLLABLES(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)x512 + ( A_ A MOD 6)x 64 + DIA); 04315000
- IF DIALB!B THEN 04316000
- EMIT((DIALB_B) DIV 6)x512 + ( B_ B MOD 6)x 64 + DIB); 04317000
- EMIT(TRB+64xT); 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 EMIT(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 STACK ! 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)x512+(A MODE 6)x64+DIA); 04550000
- EMIT((A+B-1) DIV 6 -T1+1)x512+64xS+37); 04551000
- GO TO EXIT; 04552000
- END; 04553000
- EMIT(0); 04554000
- EMIT21(E,TRUE); 04555000
- EMITD(A,48-B,B); 04556000
- EXIT: END; 04558000
-ALPHA PROCEDURE BUGGER(OP); VALUE OP; INTEGER OP; 04600000
- BEGIN INTEGER Q; 04601000
- WOP[1]_" "; 04602000
- IF BUGGER_SEARCH(WOP,OP)=" " THEN 04603000
- IF Q_OP.[44:4]>=9 THEN 04604000
- BEGIN BUGGER_POP[IF Q!10 THEN Q-5 ELSE OP.[42:2]]; 04605000
- WOP[1]_(IF 1- THEN OP.[39:3]&OP[41:38:1] ELSE 04606000
- OP.[41:3]&OP[39:38:3])&" "[24:36:12]; 04607000
- END; END BUGGER; 04608000
-PROCEDURE CHECKDISJOINT(A); VALUE A; INTEGER A; 04609000
-BEGIN 04610000
- IF LEVEL > SUBLEVEL+1 THEN 04611000
- BEGIN 04612000
- EMIT(0); 04613000
- EMITPAIR(A,STD); 04614000
- END; 04615000
- EMITN(A); 04616000
-END CHECKDISJOINT; 04617000
- COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 05000000
- COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 05001000
- PROCEDURE STEPIT; ELCASS _ TABLE(I_I+1); 05002000
- INTEGER PROCEDURE STEPI; STEPI+ELCLASS_TABLE(I_I+1); 05003000
- COMMENT TAKE FETCHS A WORD FROM INFO; 05004000
- REAL PROCEDURE TAKE(INDEX); VALUE INDEX; INTEGER INDEX; 05005000
- TAKE _ INFO[INDEX,LINKR,INDEX,LINKC]; 05006000
- COMMENT PUT PLACES A WORD INTO INFO; 05007000
- PROCEDURE PUT(WORD,INDEX); VALUE WORD,INDEX; REAL WORD,INDEX; 05008000
- INFO[INDEX,LINKR,INDEX,LINKC] _ WORD; 05009000
- COMMENT FLAG FLAGS ERROR MESSAGES. COUNTS THEM AND SUPRESS FUTURE 05010000
- ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED; 05011000
- PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05012000
- BEGIN 05013000
- COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 05014000
- THE ERROR MESSAGE ON THE PRINTER; 05015000
- STREAM PROCEDURE WRITERROR(RMT,ERRNUM,ACCUM,LINE,COUNT,LSTSEQ); 05016000
- VALUE ERRNUM,COUNT; 05017000
- BEGIN 05018000
- DI:=LINE; 11(DS:=8 LIT " "); % BLANK LINE 05019000
- SI _LSTSEQ; SI _ SI-8; DS _WDS; 05020000
- DS:=24 LIT " <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 05021000
- SI _ LSTSEQ; DI _ LSQSEQ; DI _ DI-8; DS _ WDS; 05023000
- DI_LINE; SI_RMT; SI_SI+7; 05024000
- IF SC="1" THEN 05024100
- BEGIN SI_LSTSEQ; DS_10 LIT "NEAR LINE "; 05024200
- 7(IF SC>"0" THEN JUMP OUT; 05024300
- SI_SI+1; TALLY_TALLY+1); 05024400
- RMT_TALLY; DS_8 CHR; DI_DI-RMT; 05024500
- END ELSE DI_DI+7; 05024600
- DS_14 LIT " ERROR NUMBER "; 05025000
- SI _ LOC ERRNUM; DS _ 3 DEC; COMMENT CONVERT ERRNUM; 05026000
- DS _ 4 LIT " -- "; 05027000
- SI _ ACCUM; SI _ SI+3; DS _ COUNT CHR; 05028000
- COMMENT PLACE ALPHA IN BUFFER; 05029000
- DS _ LIT "." 05030000
- END WRITERROR; 05031000
- IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000
- BEGIN 05033000
- SPECTOG := FALSE; 05034000
- ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000
- IF NOT(LISTER OR REMOTOG) THEN 05036000
- BEGIN 05037000
- EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); %114- 05038000
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LINE[12]); 05039000
- IF NOHEADING THEN DATIME; WRITELINE; 05039500
- END; 05041000
- COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000
- ACCUM[1] _ Q; COMMENT RESTORE ACCUMULATOR; 05043000
- WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000
- INFO[LASTSEQROW,LASTSEQUENCE]); 05045000
- IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900
- IF NOT HEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000
- ERRORTOG _ FALSE; COMMENT INHIBIT MESSAGES; 05047000
-IF PUNCHTOG THEN 05048000
- BEGIN 05049000
- STREAM PROCEDURE PUNCH(FL,ST); 05050000
- VALUE ST; 05051000
- BEGIN 05052000
- DI _ FL; 05053000
- SI _ ST; 05054000
- DS _ 9 WDS 05055000
- END PUNCH; 05056000
- PUNCH(PNCH(0),FCR); 05057000
- MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000
- WRITE(PNCH) 05059000
- END 05060000
- END END FLAG; 05101000
- LABEL ENDOFITALL; 05101100
-COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000
- RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000
- SEMICOLON, END, OR BEGIN; 05104000
-PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000
- BEGIN FLAG(ERRNUM); 05106000
- I _ I-1; 05107000
- IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100
- IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200
- DO IF STEPI = BEGINV THEN STMT UNTIL 05108000
- ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000
-DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000
-COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000
- UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000
- PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWOD; REAL ELBATWORD; 05113000
- BEGIN 05114000
- IF MODE>= 2 THEN 05115000
- IF GTI1 _ ELBATWORD.LVL >=FRSTLEVEL THEN 05116000
- IF GTI1 < SUBLEVEL THEN 05117000
- IF ELBATWORD.[9:2] ! 1 05118000
- THEN BEGIN FLAG(101); ERRORTOG _ TRUE END 05119000
- END CHECKER; 05120000
- COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 05121000
- GIVEN THE LINK TO THE ELBAT WORD; 05122000
-INTEGER PROCEDURE GIT(L); VALUE L; REAL L; 05123000
- GIT _ TAKE(L).INCR+L.LINK; 05124000
-COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 05125000
- IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 05126000
- GETSPACE TO OBTAIN THE PRT ADDRESS; 05127000
-INTEGER PROCEDURE GNAT(L); VALUE L; REAL L; 05128000
- BEGIN 05129000
- REAL A; 05130000
- IF FNAT _(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 THE CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR 05134000
- 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
- ADRES _ ELBAT[I].ADDRESS; 05140000
- IF ELCLASS = SUPERFILEID 05141000
- THEN BEGIN 05142000
- BANA; EMITN(ADDRESS); EMITO(LOD) END 05143000
- ELSE BEGIN 05144000
- IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000
- STEPIT; 05146000
- EMITN(DDRES) END END PASSFILE; 05147000
-PROCEDURE PASSMONFILE(ADDRESS); 05148000
- VALUE ADDRESS ; 05149000
- REAL ADDRESS ; 05150000
- BEGIN COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 05151000
- FILE TO PRINTI; 05152000
- IF ADDRESS < 768 OR ADDRESS > 1023 05153000
- THEN EMITL(5); 05154000
- EMITN(ADDRESS); 05155000
- END PASSMONFILE; 05156000
-PROCEDURE PASFILE; 05157000
- BEGIN COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 05158000
- MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 05159000
- DEFINE ELBATWORD = RR1#; COMMENT ELBATWORD CONTAINS THE 05160000
- ELBATWORD FOR THE FILE BEING 05161000
- OPERATED ON; 05162000
- DEFINE LTEMP = RR2#; COMMENT LTEMP IS USED TO HOLD THE L 05163000
- REGISTER SETTING FOR THE SAVE OR 05164000
- RELEASE LITERAL THAT GETS PASSED TO 05165000
- KEN MYERS; 05166000
- EMITO(MKS); L_(LTEMP_L)+1; EMITL(0); 05167000
- EMITL(2); CHECKER(ELBATWORD_ELBAT[I]); 05168000
- IF RRB1_(RRB2_ ELCLASS = SUPERFILEID)OR 05169000
- BOOLEAN(ELBATWORD.FORMAL) 05170000
- THEN EMITO(LNG); 05171000
- IF RRB2 05172000
- THEN BANA 05173000
- ELSE STEPIT; 05174000
- EMITN(ELBATWORD.ADDRESS); 05175000
- IF RRB2 05176000
- THEN EMITO(LOD); 05177000
- IF RRB1 05178000
- THEN EMITO(INX); 05179000
- EMITL(4); EMITV(14); 05180000
- END PASFILE; 05181000
- COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE 05182000
- PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000
- PROCEDURE CHECKPRESENCE; 05184000
- BEGIN 05185000
- EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000
- END CHECKPRESENCE; 05187000
-COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 05187500
- TO THE TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510
-PROCEDURE PASSLIST; 05187520
- BEGIN 05187530
- INTEGER LISTADDRESS; 05187540
-COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 05187550
- CHECKER(ELBAT[I]); 05187560
- LISTADDRESS:=ELBAT[I].ADDRESS; 05187570
- IF FLCLASS = SUPERLISTID THEN % SUBSCRIPTED LIST ID. 05187580
- BEGIN 05187590
- BANA; EMITN(LISTADDRESS); EMITO(LOD); 05187600
- END 05187610
- ELSE BEGIN EMITL(LISTADDRESS); STEPIT END; 05187620
- END OF PASSLIST; 05187630
-REAL PROCEDURE TAKEFRST; 05188000
- TAKEFRST _ TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 05189000
-COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 05196000
- DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 05197000
- STACK; 05198000
-PROCEDURE STUFFF(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 05199000
- BEGIN 05200000
- EMITPAIR(ADDRESS,LOD); 05201000
- EMITN(512); 05202000
- EMITD(33,18,15) END STUFFF; 05203000
-COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 05204000
- PRESENT CODE; 05205000
-BOOLEAN PROCEDURE LOCAL(ELBATWORD); 05206000
- VALUE ELBATWORD; REAL ELBATWORD; 05207000
- BEGIN IF ELBATWORD.LVL = LEVEL AND 05208000
- NOT BOOLEAN(ELBATWORD.FORMAL) THEN 05209000
- LOCAL _ TRUE END LOCAL; 05210000
-COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 05211000
- PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 05212000
- STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 05213000
-PROCEDURE PASSFORMAT; 05214000
- BEGIN INTEGER ADRES; 05215000
- CHECKER(ELBAT[I]); 05216000
- ADRES _ ELBAT[I].ADDRESS; 05217000
- IF BOOLEAN(ELBAT[I].FORMAL) 05218000
- THEN BEGIN EMITV(ADRES); ADRES _ ADRES-1 END 05219000
- ELSE BEGIN 05220000
- IF TABLE(I) = SUPERFRMTID 05221000
- THEN EMITL(TAKEFRST) ELSE EMITL(ELBAT[I].INCR) 05222000
- END; 05223000
- IF TABLE(I) = SUPERFRMTID 05224000
- THEN BEGIN BANA; I _ I-1; 05225000
- EMITO(SSP); EMITO(ADD); EMITV(ADRES) END; 05226000
- EMITPAIR(ADRES,LOD) END PASSFORMAT; 05227000
-COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 05228000
- WORDS - IT COMPLEMENTS THEIR STATE; 05229000
-PROCEDURE STREAMWORDS; 05230000
- BEGIN GT1 _ 0; 05231000
- DO BEGIN 05232000
- INFO[1,GT1].LINK_STACKHEAD[GT2_(T_INFO[1,GT1]).ADDRESS]; 05233000
- STACKHEAD[GT2] _ T.LINK; 05234000
- GT1 _ GT1+2; 05235000
- END UNTIL BOOLEAN(T.FORMAL) END STREAMWORDS; 05236000
-STREAM PROCEDURE DEBUGDESC(LIN,PRT,TYP,RELAD,SGNO); 05237000
- VALUE PRT,TYP,RELAD,SGNO; 05237500
- BEGIN LOCAL COUNT; 05238000
- DI:=LIN; DS:=6 LIT" PRT("; SI:=LOC PRT; SI:=SI+4; TALLY:=4; 05238500
- 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05239000
- BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05239500
- COUNT:=TALLY; DS:=COUNT CHR; 05240000
- DS:= 31 LIT") = SEGMENT DESCRIPTOR, TYPE = "; 05240500
- SI:=LOC TYP; SI:=SI+7; DS:=CHR; % TYPE. 05241000
- DS:=21 LIT", RELATIVE ADDRESS = "; 05241500
- SI:=LOC RELAD; SI:=SI+4; DS:=4 CHR; % REL. ADDR. 05242000
- DS:=19 LIT", SEGMENT NUMBER = "; 05242500
- SI:=LOC SGNO; SI:=SI+4; DS:=4 CHR; DS:=LIT"."; 05243000
- END DEBUGDESC; 05243500
-REAL PROCEDURE PROGDESCBLDR(TYPE,RELAD,SPAC); 05245000
- COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE, IT IS 05246000
- CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 05247000
- BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 05248000
- SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 05249000
- THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 05250000
- TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE 05251000
- 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 GOTTON 05256000
- ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000
- PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000
- VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000
- BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000
- PDPRT[PDINX,[37:5],PDINX.[42:6]]_0&RELAD[18:36:10] 05261000
- &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000
- IF DEBUGTOG THEN 05263000
- BEGIN 05263500
- BLANKET(14,LIN); 05264000
- DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO)); 05264500
- IF NOHEADING THEN DATIME; WRITELINE; 05265000
- END; 05265100
- PDINX_PDINX+1;PROGDESCBLDR_SPAC END PROGDESCBLDR; 05266000
-COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000
- IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000
- LITERALS INVOLVED; 05269000
-BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000
- INTEGER FIRST,SECOND; 05271000
- BEGIN 05272000
- LABEL EXIT; 05273000
- IF STEPI = FIELDID THEN % GET INFO FROM INFO %117- 05273100
- BEGIN %117- 05273200
- FIRST := ELBAT[I].SBITF; %117- 05273300
- SECOND := ELBAT[I].NBITF; %117- 05273400
- GO TO EXIT; %117- 05273500
- END %117- 05273600
- ELSE %117- 05273700
- IF ELCLASS = LFTBRKET THEN %117- 05273800
- IF STEPI = FIELDID THEN %117- 05273900
- BEGIN %117- 05274000
- FIRST := ELBAT[I].SBITF; %117- 05274100
- SECOND := ELBAT[I].NBITF; %117- 05274200
- IF STEPI = RTBRKET THEN %117- 05274300
- GO TO EXIT; %117- 05274400
- END %117- 05274500
- ELSE %117- 05274600
- IF ELCLASS = LITNO THEN %117- 05275000
- IF STEPI = COLON THEN 05276000
- IF STEPI = LITNO THEN 05277000
- IF STEPI = RTBRKET THEN 05278000
- COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000
- IF (FIRST _ ELBAT[I-3].ADDRESS) x 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 SET 05292000
- FALSE; 05293000
- IF CHECK_(ELBATCLASS ! TABLE(I)) 05294000
- THEN ERR(ERRORNUMBER); 05295000
- END; 05296000
-BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000
- VALUE LOWER,UPPER; 05298000
- REAL LOWER,UPPER; 05299000
- COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000
- IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000
- UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000
- CLASS MUST BE IN ELCLASS; 05303000
- RANGE_ELCLASS >= LOWER AND ELCLASS <= UPPER; 05304000
-COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 05305000
- EMITTED; 05306000
-INTEGER PROCEDURE GET(L); VALUE L; REAL; 05307000
- BEGIN 05308000
- INTEGER STREAM PROCEDURE GETSYL(W,S); VALUE S; 05309000
- BEGIN DI _ LOC GETSYL; DI _ DI+6; 05310000
- SI _ W; SI _ SI+S; SI + SI+S; DS _ 2 CHR END; 05311000
- GET _ GETSYL(EDOC[L.[36:3],L.[39:7]],L.[46:2]) END GET; 05312000
-COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 05313000
- SCRIPTOR TO THE TOP OF THE STACK; 05314000
-PROCEDURE CALLSWITCH(H); VALUE H; REAL H; 05315000
- BEGIN EMITV(GNAT(H)); EMITO(PRTE); EMITO(LOD) END CALLSWITCH; 05316000
-REAL STREAM PROCEDURE GETALPHA(INFOINDEX,SIZE); 05317000
- VALUE SIZE ; 05318000
- BEGIN COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 05319000
- FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 05320000
- CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 05321000
- ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 05322000
- DI_LOC GETALPHA; DS_8 LIT"0 "; D_DI-7; 05323000
- SI_INFOINDEX; SI_SI+3; DS_SIZE CHR; 05324000
- END GETALPHA; 05325000
-PROCEDURE WRITEPRT(PORS,N,GS); VALUE PORS,N,GS; INTEGER PORS,N,GS; 05325010
- BEGIN 05325020
- LABEL EXIT; 05325030
- STREAM PROCEDURE FILLIT(LIN,PORS,CELL,N,ID); 05325040
- VALUE PORS,CELL,N; 05325050
- BEGIN 05325060
- LOCAL COUNT; 05325070
- LABEL M0,M1,M2,M3,M4,M5,M6,M7,XIT; 05325080
- SI:=LOC PORS; SI:=SI+3; DI:=LIN; % "PRT" OR "STACK". 05325090
- IF SC="P" THEN 05325100
- BEGIN DS:=3 CHR; DS:=LIT"("; END 05325110
- ELSE BEGIN 05325120
- DS:=5 CHR; DS:=LIT"("; SI:=LOC CELL; SI:=SI+5; 05325130
- IF SC>="6"THEN DS:=2 LIT"F-" ELSE DS:=2 LIT"F+"; 05325140
- COUNT:=DI; DI:=LOC CELL; DI:=DI+4; 05325150
- DS:=11 RESET; DI:=COUNT; 05325160
- END; 05325170
- SI:=LOC CELL; SI:=SI+4; TALLY:=4; % LOCATION. 05325180
- 3(IF SC="0" THEN % DONT PRINT LEADING ZEROES. 05325190
- BEGIN SI:=SI+1; TALLY:=TALLY+63 END ELSE JUMP OUT); 05325200
- COUNT:=TALLY; DS:=COUNT CHR; TALLY:=0; COUNT:=TALLY; 05325210
- DS:=4 LIT") = "; CELL:=DI; % SAVE OUR PLACE. 05325220
- CI:=CI+N; 05325230
- GO M0; 05325240
- GO M1; 05325250
- GO M2; 05325260
- GO M3; 05325270
- GO M4; 05325280
- GO M5; 05325290
- GO M6; 05325300
- GO M7; 05325310
-M0: SI:=ID; SI:=SI+2; DI:=LOC COUNT; 05325320
- DI:=DI+7; DS:=CHR; DI:=CELL; DS:=COUNT CHR; 05325330
- GO XIT; 05325340
-M1: DI:=CELL; DS:=19 LIT"*TEMPORARY STORAGE*"; GO XIT; 05325350
-M2: DI:=CELL; 05325360
- DS:=36 LIT"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; GO XIT; 05325370
-M3: DI:=CELL; DS:=27 LIT"*CASE STATEMENT DESCRIPTOR*"; GO XIT; 05325380
-M4: DI:=CELL; DS:=19 LIT"*FORMAT DESCRIPTOR*"; GO XIT; 05325390
-M5: DI:=CELL; DS:=24 LIT"*OUTER BLOCK DESCRIPTOR*"; GO XIT; 05325400
-M6: DI:=CELL; DS:=20 LIT"*SEGMENT DESCRIPTOR*"; GO XIT; 05325410
-M7: DI:=CELL; DS:=18 LIT"*LABEL DESCRIPTOR*"; 05325420
-XIT: 05325430
- END FILLIT; 05325440
- BLANKET(14,LIN); 05325450
- IF N=1 THEN FILLIT(LIN,PORS,GS,0,ACCUM[1]) 05325460
-ELSE IF N>1 THEN FILLIT(LIN,PORS,GS,0,INFO[N.LINKR,N.LINKC]) 05325470
-ELSE FILLIT(LIN,PORS,GS,ABS(N),N); 05325480
- IF NOHEADING THEN DATIME; WRITELINE; 05325490
- END WRITEPRT; 05325500
- COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 05326000
- THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 05327000
- PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 05328000
- PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 05329000
- MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 05330000
-INTEGER PROCEDURE GETSPACE(PERMANENT,L); VALUE PERMANENT,L; 05331000
- BOOLEAN PERMANENT; INTEGER L; 05333000
- BEGIN LABEL L1,L2,EXIT; 05334000
- BOOLEAN STREAM PROCEDURE MASK(K); VALUE K; 05341000
- DI_LOC MASK; DI_DI+2; SKIP K DB; DS_SET END MASK; 05342000
- BOOLEAN M,Q; 05343000
- INTEGER ROW,COL,GS; 05344000
- IF PERMANENT 05345000
- THEN BEGIN 05346000
- IF PRTIMAX>1022 THEN FLAG(148);% 05347000
- SPRT[GS_PRTIMAX.[38:5]] _ MASK(PRTIMAX.[43:5]-35) 05348000
- OR SPRT[GS]; 05349000
- PRTIMAX _ (GS _ PRTIMAX)+1 END 05350000
- ELSE IF MODE = 0 THEN BEGIN 05351000
- Q _ SPRT[ROW _ PRTI.[38:5]]; 05352000
- M _ MASK(COL _ PRTI.[43:4]-35); 05353000
- COL _ COL+35; 05354000
- L1: IF REAL(M AND Q) ! 0 05355000
- THEN BEGIN 05356000
- IF REAL(BOOLEAN(GS_4294967296-REAL(M)) AND Q) = GS 05357000
- THEN BEGIN 05358000
- COL _ 0; M _ TRUE; 05359000
- IF ROW _ ROW+1 > 31 05360000
- THEN BEGIN FLAG(148); GS _ PRTIMAX; 05361000
- GO TO L2 END; 05362000
- Q _ SPRT[ROW]; 05363000
- GO TO L1 END; 05364000
- COL _ COL+1; M _ BOOLEAN(REAL(M)+REAL(M)); 05365000
- GO TO L1 END; 05366000
- PRTI _ (GS _ 32xROW+COL)+1; 05367000
- IF PRTI > PRTIMAX THEN PRTIMAX _ PRTI END 05368000
- ELSE BEGIN 05369000
- IF STACKCTR > 767 THEN FLAG(149); 05370000
- STACKCTR _ (GS _ STACKCTR)+1; Q _ FALSE; 05371000
- GO TO EXIT END; 05372000
- L2: IF GS>= 512 THEN GS _ GS+1024; 05373000
- Q _ TRUE; 05374000
- EXIT: GETSPACE _ GS; 05375000
- IF GS > 1023 THEN GS _ GS-1024; 05376000
- IF PRTOG THEN WRITEPRT(IF Q THEN "PRT " ELSE "STACK",L,B2D(GS)); 05376100
- END GETSPACE; 05378000
- COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 05379000
-BOOLEAN PROCEDURE ARRAYCHECK(AAW); VALUE AAW; REAL AAW; 05380000
- ARRAYCHECK_AAW.CLASSINTARRAYID 05381000
- OR AAW.INCR !1; 05382000
- COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 05383000
-BOOLEAN PROCEDURE COMMACHECK; 05384000
- BEGIN IF NOT(COMMACHECK_(STEPI=COMMA)) THEN ERR(350); 05385000
- STEPIT 05386000
- END COMMACHECK; 05387000
- COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 05388000
-BOOLEAN PROCEDURE HVCHECK(ELBW); VALUE ELBW; REAL ELBW; 05389000
- IF ELBW.CLASS!PROCID THEN ERR(356) ELSE 05390000
- IF BOOLEAN(ELBW.FORMAL) THEN HVCHECK_TRUE ELSE 05390100
- IF TAKE(GT1_GIT(ELBW)!1 THEN ERR(537) ELSE 05391000
- IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000
- HVCHECK_TRUE; 05393000
- COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000
-BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000
- IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000
- IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK_TRUE ELSE 05396100
- IF TAKE(GT1_GIT(ELBW))!2 THEN ERR(352) ELSE 05397000
- IF TAKE(GT1_1).CLASS!BOOID THEN ERR(353) ELSE 05398000
- IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000
- OUTPROCHECK_TRUE; 05400000
- COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000
-BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000
- IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000
- IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK _ TRUE ELSE 05403100
- IF TAKE(GT1_GIT(ELBW))!2 THEN ERR(360) ELSE 05404000
- IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000
- IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000
- EQLESCHECK_TRUE; 05407000
-COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS; 06000000
-COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 06001000
-PROCEDURE AEXP; 06002000
- BEGIN 06003000
- IF ELCLASS = IFV 06004000
- THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000
- ELSE BEGIN ARITHSEC; SIMPARITH END 06006000
- END AEXP; 06007000
-COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000
- IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000
- AND Q ARE PRIMARIES; 06010000
-PROCEDURE ARITHSEC; 06011000
- BEGIN 06012000
- IF ELCLASS = ADOP 06013000
- THEN BEGIN 06014000
- STEPIT; 06015000
- IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000
- ELSE BEGIN 06017000
- PRIMARY; 06018000
- WHILE ELCLASS = FACTOP DO %WF 06019000
- BEGIN STEPIT; PRIMARY; EMITUP END; %WF 06020000
- ENDTOG _ LINKTOG; EMITO(CHS); 06021000
- LINKTOG _ ENDTOG; ENDTOG _ FALSE END END 06022000
- ELSE PRIMARY END ARITHSEC; 06023000
-COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 06024000
- ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 06025000
- COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 06026000
- WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 06027000
- COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 06028000
- SIMPARITH IS DONE BY ARITHCOMP. AN ARTIFIAL ROUTINE 06029000
- WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 06030000
- ARITHOCMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 06031000
-PROCEDURE SIMPARITH; 06032000
- BEGIN 06033000
- WHILE ELCLASS = AMPERSAND 06034000
- DO BEGIN STEPIT; PRIMARY; PARSE END; 06035000
- WHILE ELCLASS>=ADOP AND ELCLASS<=FACTOP DO ARITHCOMP END; 06036000
-COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 06037000
- ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 06038000
- EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 06039000
- IS OBTAINED BY RECURSION; 06040000
-PROCEDURE ARITHCOMP; 06041000
- BEGIN INTEGER OPERATOR, OPCLASS; 06042000
- DO BEGIN 06043000
- OPERATOR _ 1 & ELBAT[I] [36:17:10]; 06044000
- COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06045000
- ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06046000
- OF THE ELBAT WORD; 06047000
- OPCLASS _ ELCLASS; 06048000
- STEPIT; PRIMARY; 06049000
- IF OPCLASS = FACTOP THEN EMITUP 06050000
- ELSE BEGIN 06051000
- WHILE OPCLASS < ELCLASS DO ARITHCOMP; 06052000
- COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06053000
- STACKCT _ 1; %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,T2,T3 ; 06059000
- BOOLEAN B ; 06059050
- DEFINE ERRX(ERRX1)=BEGIN T1_ERRX1; GO ERROR END #; 06059100
- LABEL ABS, SIGN, ENTIER, TIME, STATUS,% 06060000
- MAXANDMIN, DELAY, OTHERS, EXIT;% 06060100
- LABEL ERROR,L1,L2,L3 ; 06060110
- SWITCH S _ OTHERS, ABS, SIGN, ENTIER, TIME, STATUS,% 06061000
- MAXANDMIN, MAXANDMIN, DELAY;% 06061100
- DEFINE MAXV = 6#;% 06061200
- IF T2_(T1_ELBAT[I]).[27:6]<9 THEN GO S[T2+1] ; 06062000
- IF T2!25 THEN EMITO(MKS) ; 06062110
- IF STEPI!LEFTPAREN THEN ERRX(105); STEPIT ; 06062120
- IF T2<24 THEN 06062125
- BEGIN 06062130
-L3: IF TABLE(I+1)=COMMA THEN 06062135
- IF ELCLASS>BOOID AND ELCLASS=REALID AND ELCLASS<=INTID THEN 06062340
- BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 06062350
- ELSE IF ELCLASSBOOPROCID THEN 06062370
- IF ELBAT[I].LINK!PROINFO.LINK THEN FLAG(211) 06062380
- ELSE BEGIN EMITL(514); STEPIT END 06062385
- ELSE IF ELCLASSBOOARRAYID 06062390
- THEN VARIABLE(FL) 06062400
- ELSE ERRX(185) ; 06062420
- IF ELCLASS!RTPAREN THEN ERRX(104); STEPIT ; 06062430
- EMITO(IF B THEN ISD ELSE STD); EMITV(17); GO EXIT ; 06062435
- END ; 06062440
- IF T2<23 THEN 06062470
- BEGIN % DMOD, DARCTAN2 06062480
- B_TRUE; GO L3 ; 06062500
- END ; 06062535
- IF T2<25 THEN BEGIN EMITV(GNAT(T1)); GO EXIT END ; 06062540
- EMITD(9,47,1); EMITV(9); EMITO(ADD); GO EXIT ; 06062560
- ERROR: ERR(T1); GO EXIT ; 06062565
- OTHERS: EMITO(MKS) ; 06064000
- PANA; 06065000
- EMITV(GNAT(T1)); GO TO EXIT; 06066000
- ABS: PANA; EMITO(SSP); GO TO EXIT; 06067000
- SIGN: PANA; 06068000
- EMITO(DUP); EMITL(0); EMITO(NEQ); EMITO(XCH); 06069000
- EMITD(1,1,1); GO TO EXIT; 06070000
- ENTIER: PANA; EMITNUM(.5); EMITO(SUB); 06071000
- EMITPAIR(JUNK,ISN); GO TO EXIT; 06072000
- MAXANDMIN:% 06072010
- IF STEPI!LEFTPAREN THEN ERR(105) ELSE% 06072030
- BEGIN STEPIT; AEXP;% 06072040
- WHILE ELCLASS=COMMA DO% 06072050
- BEGIN STEPIT; EMITO(DUP); AEXP;% 06072060
- EMITPAIR(JUNK, SND);% 06072070
- IF T2=MAXV THEN EMITO(LSS) ELSE EMITO(GTR) ; 06072080
- EMITPAIR(2, BFC); EMITO(DEL); EMITV(JUNK); 06072090
- END;% 06072100
- IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT;% 06072110
- END;% 06072120
- GO TO EXIT;% 06072130
- DELAY: IF STEPI!LEFTPAREN THEN% 06072200
- BEGIN ERR(105); GO TO EXIT END;% 06072210
- STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072220
- BEGIN ERR(165); GO TO EXIT END;% 06072230
- STEPIT; AEXP; IF ELCLASS!COMMA THEN% 06072240
- BEGIN ERR(165); GO TO EXIT END;% 06072250
- STEPIT; AEXP; IF ELCLASS!RTPAREN THEN% 06072260
- BEGIN ERR(104); GO TO EXIT END ELSE STEPIT;% 06072270
- EMITPAIR(31, COM); EMITO(DEL); EMITO(DEL);% 06072280
- GO TO EXIT;% 06072290
- TIME: PANA; EMITL(1); EMITO(COM); 06073000
- GO TO EXIT; 06073100
- STATUS: IF STEPI!LEFTPAREN THEN BEGIN ERR(105); GO TO EXIT END; 06073200
- IF STEPI=SUPERFILEID OR ELCLASS=FILEID THEN 06073250
- BEGIN EMIT(16); EMIT(0); EMIT(0); PASSFILE; 06073300
- EMITPAIR(32, COM); T1_3; 06073350
- END ELSE BEGIN EMIT(4); EMIT(0); T1_0; 06073400
- IF ELCLASS>=BOOARRAYID AND ELCLASS<=INTARRAYID THEN 06073450
- BEGIN T1_FI; VARIABLE(T1); END ELSE AEXP; 06073500
- IF T1=FI THEN 06073550
- BEGIN EMITPAIR(0, XCH); EMITPAIR(32, COM); T1_3 06073600
- END ELSE BEGIN IF ELCLASS=RTPAREN THEN 06073650
- BEGIN EMIT(0); EMITPAIR(32, COM); T1_3 END 06073700
- ELSE BEGIN EMITO(XCH); EMITO(DEL); 06073750
- EMITO(XCH); EMITO(DEL); 06073800
- IF ELCLASS!COMMA THEN 06073810
- BEGIN ERR(129); GO TO EXIT END; 06073820
- STEPIT; AEXP; EMITPAIR(28,COM); T1_1; 06073830
- END; END; END; 06073840
- GTI1_0; 06073845
- DO EMITO(DEL) UNTIL GTI1_GTI1-1=T1;% 06073850
- IF ELCLASS!RTPAREN THEN ERR(104) ELSE STEPIT; 06073860
- GO TO EXIT; 06073870
- EXIT: END IMPFUN; 06074000
-COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 06075000
- OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 06076000
- DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 06077000
- CASES; 06078000
-PROCEDURE PRIMARY; 06079000
- BEGIN 06080000
- LABEL 06081000
- L11, L12, L13, L14, L15, L16, L17, L18, L19, 06082000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06083000
- L30, L31, L32, L33, L34, L35; 06084000
- SWITCH S _ 06085000
- L11, L12, L13, L14, L15, L16, L17, L18, L19, 06086000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06087000
- L30, L31, L32, L33, L34, L35; 06088000
- COMMENT LN IS THE LABEL FOR THE CLASS N; 06089000
- LABEL EXIT,RP,LDOT,LAMPER; 06090000
- GO TO S[ELCLASS-PROCID]; COMMENT GO TO PROPER SYNTAXER; 06091000
- IF ELCLASS = UNKNOWNID THEN ERR(100); 06092000
- IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06092005
- BEGIN 06092010
- IF FILEATTRIBUTEHANDLER(FP)!ATYPE THEN FLAG(294) ; 06092015
- GO TO LAMPER ; 06092020
- END ; 06092025
- L12: L13: L17: L21: L25: L29: L30: 06093000
- COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06094000
- IF REL AND ELCLASS = BOOARRAYID THEN GO L22; 06094950
- ERR(103); GO TO EXIT; 06095000
- L11: 06096000
- COMMENT INTRINSIC FUNCTIONS; 06097000
- IMPFUN; STACKCT _ STACKCT-1; GO TO LDOT; %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 BOOLEAN 06115000
- EXPRESSION - OTHERWISE AN ERROR; 06116000
- IF ELBAT[I].ADDRESS = REALV THEN BEGIN 06117000
- IF STEPI ! LEFTPAREN 06118000
- THEN BEGIN ERR(105); GO TO EXIT END; 06119000
- STEPIT; BEXP; GO TO RP END; 06120000
- IF ELBAT[I].ADDRESS = INTV THEN 06120100
- BEGIN PANA; EMITPAIR(JUNK,ISN); GO TO LDOT END; 06120200
- ERR(106); GO TO EXIT; 06121000
- L34: 06122000
- COMMENT (; 06123000
- STEPIT; AEXP; 06124000
- STACKCT _ STACKCT-1; %A 06124500
- RP: IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO EXIT END; 06125000
- STEPIT; 06126000
- LDOT: DOT; COMMENT THIS CHECKS FOR PARTIAL WORDS; 06127000
- LAMPER: STACKCT _ STACKCT+1; %A 06128000
- WHILE ELCLASS = AMPERSAND %A 06128500
- DO BEGIN STEPIT; PRIMARY; PARSE END; 06129000
- COMMENT THIS CODE HANDLES CANCATENATES; 06130000
- EXIT: END PRIMARY; 06131000
-COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 06132000
-PROCEDURE BEXP; IF EXPRSS ! BTYPE THEN ERR(107); 06133000
-COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 06134000
- ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 06135000
- BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 06136000
- DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 06137000
- OR DESIGNATIONAL EXPRESSION; 06138000
-INTEGER PROCEDURE EXPRSS; 06139000
- BEGIN 06140000
- IF ELCLASS = IFV 06141000
- THEN BEGIN 06142000
- IF EXPRSS _ IFEXP = ATYPE 06143000
- THEN IF ELCLASS = RELOP THEN ERR(108) END 06144000
- ELSE IF EXPRSS _ BOOSEC = BTYPE THEN SIMPBOO 06145000
- END EXPRSS; 06146000
-COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 06147000
- EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 06148000
- AS EXPRSS REPORTS; 06149000
-INTEGER PROCEDURE BOOSEC; 06150000
- BEGIN BOOLEAN N; 06151000
- IF N _ ELCLASS = NOTOP THEN STEPIT; 06152000
- GT4 _ BOOSEC _ BOOPRIM; 06153000
- IF N THEN BEGIN EMITLNG; EMIT(0); L _ L-1; 06154000
- COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 06155000
- RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 06156000
- IF GT4 ! BTYPE THEN ERR(109) 06157000
- COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 06158000
- LOGICALLY NEGATED; 06159000
- END END BOOSEC; 06160000
-COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 06161000
- THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 06162000
- ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 06163000
- PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 06164000
- A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 06165000
- COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 06166000
- LYSIS USING RECURSION; 06167000
-PROCEDURE SIMPBOO; 06168000
- BEGIN 06169000
- WHILE ELCLASS = AMPERSAND 06170000
- DO BEGIN 06171000
- STEPIT; 06172000
- IF BOOPRIM! BTYPE THEN ERR(109); 06173000
- PARSE END; 06174000
- WHILE ELCLASS >=EQVOP AND ELCLASS <=ANDOP DO BOOCOMP 06175000
- END BOOCOMP; 06176000
-COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS. 06177000
- IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN 06178000
- OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 06179000
- SION; 06180000
-PROCEDURE BOOCOMP; 06181000
- BEGIN INTEGER OPCLASS, OPERATOR; LABEL EXIT; 06182000
- DO BEGIN 06183000
- OPERATOR _ 1 & ELBAT[I] [36:17:10]; 06184000
- COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 06185000
- ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 06186000
- OF THE ELBAT WORD; 06187000
- OPCLASS _ ELCLASS; 06188000
- STEPIT; 06189000
- IF BOOSEC ! BTYPE 06190000
- THEN BEGIN ERR(109); GO TO EXIT END; 06191000
- WHILE OPCLASS < ELCLASS 06192000
- DO IF ELCLASS <=ANDOP THEN BOOCOMP 06193000
- ELSE BEGIN ERR(110); GO TO EXIT END; 06194000
- COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 06195000
- STACKCT _ 1; %A 06195500
- IF OPCLASS = IMPOP 06196000
- THEN BEGIN 06197000
- COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 06198000
- ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 06199000
- THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 06200000
- EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 06201000
- FUTURE. (SEE CODE FOR EMITLNG); 06202000
- EMITLNG; 06203000
- EMITO(LND); 06204000
- EMITO(LNG); 06205000
- EMITO(0); 06206000
- L _ L-1 END 06207000
- ELSE EMIT(OPERATOR) 06208000
- END UNTIL OPCLASS ! ELCLASS; 06209000
- EXIT: END BOOCOMP; 06210000
-COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 06211000
- DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRESS REPORTS; 06212000
-INTEGER PROCEDURE BOOPRIM; 06213000
- BEGIN INTEGER TYPE; 06214000
- LABEL L9, 06215000
- L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06216000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06217000
- L30, L31, L32, L33, L34, L35; 06218000
- SWITCH S _ L9, 06219000
- L10, L11, L12, L13, L14, L15, L16, L17, L18, L19, 06220000
- L20, L21, L22, L23, L24, L25, L26, L27, L28, L29, 06221000
- L30, L31, L32, L33, L34, L35; 06222000
- COMMENT LN IS THE LABEL FOR THE CLASS N; 06223000
- LABEL EXIT,LE,D,TD,T; 06224000
- LABEL FAH ; 06224500
- GO TO S[ELCLASS-SUPERFILEID]; 06225000
- IF ELCLASS = ADOP THEN GO TO L11; 06226000
- IF ELCLASS = UNKNOWNID THEN ERR(100); 06227000
- IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 06227500
- BEGIN 06227510
- BOOPRIM_TYPE_FILEATTRIBUTEHANDLER(FP) ; 06227520
- GO FAH ; 06227530
- END ; 06227540
- LE: L10: L12: 06228000
- COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 06229000
- EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 06230000
- ERR(111); GO TO EXIT; 06231000
- L35: IF GT1 _ ELBAT[I].ADDRESS = BOOV 06232000
- THEN BEGIN PANA; GO TO TD END; 06233000
- IF GT1 ! REALV THEN BEGIN ERR(112); GO TO EXIT END; 06234000
- L11: L14: L15: L16: L18: L19: L20: L22: L23: L24: L26: L27: L28: 06235000
- L31: L32: L33: 06236000
- COMMENT ARITHMETIC TYPE STUFF; 06237000
- AEXP; 06238000
- D: IF ELCLASS ! RELOP THEN BEGIN BOOPRIM _ ATYPE; GO EXIT END; 06239000
- RELATION; 06240000
- BOOPRIM _ BTYPE; GO TO EXIT; 06241000
- L13: 06242000
- COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 06243000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06243100
- STRMPROCSTMT; GO TO TD; 06244000
- L17: 06245000
- COMMENT BOOLEAN PROCEDURE DESIGNATOR; 06246000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06246100
- PROCSTMT(FALSE); GO TO TD; 06247000
- L21: L25: 06248000
- COMMENT BOOLEAN VARIABLES; 06249000
- IF ARRAYFLAG THEN CHECKBOUNDLVL; 06249100
- VARIABLE(FP); GO TO T; 06250000
- L9: L29: 06251000
- COMMENT LABELS AND SWITCHES; 06252000
- DEXP; BOOPRIM _ DTYPE; GO TO EXIT; 06253000
- L30: 06254000
- COMMENT TRUE OR FALSE; 06255000
- EMIT(0&ELBAT[I][45:26:1]); STEPIT; GO TO T; 06256000
- L34: 06257000
- COMMENT (; 06258000
- STEPIT; TYPE _ BOOPRIM _ EXPRSS; 06259000
- COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 06260000
- STACKCT _ STACKCT-1; %A 06260500
- IF ELCLASS ! RTPAREN THEN BEGIN ERR(104); GO TO EXIT END; 06261000
- STEPIT; 06262000
- FAH: 06262500
- IF TYPE = DTYPE THEN GO TO EXIT; 06263000
- COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 06264000
- IF TYPE = BTYPE THEN BEGIN 06265000
- TD: DOT; COMMENT HANDLES PARTIAL WORDS; 06266000
- T: STACKCT _ STACKCT+1; %A 06267000
- WHILE ELCLASS = AMPERSAND DO %A 06267500
- COMMENT HANDLES CONCATENATE; 06268000
- BEGIN 06269000
- STEPIT; 06270000
- IF BOOPRIM ! BTYPE 06271000
- THEN BEGIN ERR(109); GO TO EXIT END; 06272000
- PARSE END; 06273000
- BOOPRIM _ BTYPE; GO TO EXIT END; 06274000
- COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 06275000
- EXPRESSION; 06276000
- DOT; SIMPARITH; GO TO D; 06277000
- EXIT: END BOOPRIM; 06278000
-COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 06279000
- EXPRESSION HAS ALREADY BEEN COMPILED; 06280000
-PROCEDURE RELATION; 06281000
- BEGIN 06282000
- INTEGER OPERATOR; 06282200
- REAL A; 06282400
- BOOLEAN SIGNA,CONSTANA,SIMPLE,MANY,SIGN; 06282600
- DEFINE FORMALNAME = [9:2]=2#; 06282800
- PROCEDURE PLUG(C,A,S); VALUE C,A,S; BOOLEAN C,S: REAL A; 06283000
- BEGIN 06283200
- IF C THEN EMITNUM(A) 06283400
- ELSE BEGIN CHECKER(A); EMITV(A.ADDRESS) END; 06283600
- IF S THEN EMITO(CHS); 06283800
- END PLUG; 06284000
- DO BEGIN 06284200
- OPERATOR:=1&ELBAT[I][36:17:10]; 06284400
-COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 06284600
- EMITTED LATER (AFTER PROCESSING SECOND HALF). 06284800
- THE HIGH-ORDER BITS OF THE BINARY OPERATOR 06285000
- ARE TAKEN FROM THE [17:10] FIELD OF THE 06285200
- ELBAT WORD FRO THE RELATIONAL SYMBOL; 06285400
- IF MANY THEN 06285600
- IF SIMPLE THEN PLUG(CONSTANA,A,SIGNA) ELSE EMITV(JUNK); 06285800
- SIGNA:=FALSE; 06286000
- IF STEPI=ADOP THEN SIGNA:=ELBAT[I].ADDRESS=SUB; 06286200
- IF SIGN:=ELCLASS=ADOP THEN STEPIT; 06286400
- CONSTANA:=ELCLASS>=NONLITNO AND ELCLASS<=STRNGCON; 06286600
- A:=REAL(ELCLASS>=REALID AND ELCLASS<=INTID 06286800
- AND NOT ELBAT[I].FORMALNAME); 06287000
- SIMPLE:=(CONSTANA OR BOOLEAN(A)) AND STEPI=RELOP; 06287200
- IF SIMPLE THEN 06287400
- BEGIN 06287600
- IF CONSTANA THEN A:=C ELSE A:=ELBAT[I-1]; 06287800
- PLUG(CONSTANA,A,SIGNA) 06288000
- END 06288200
- ELSE BEGIN 06288400
- I:=I-REAL(SIGN)-2; STEPIT; AEXP; 06288600
- IF ELCLASS=RELOP THEN EMITPAIR(JUNK,SND); 06288800
- END; 06289000
- STACKCT:=1; EMIT(OPERATOR); 06289200
- IF MANY THEN EMITO(LND); 06289400
- ELSE BEGIN EMIT(0); L:=L-1 END; 06289600
- MANY:=TRUE; 06289800
- END UNTIL ELCASS!RELOP 06290000
- END RELATION; 06290200
-COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 06292000
- OF EXPRESSIONS AS EXPRSS REPORTS; 06293000
-INTEGER PROCEDURE IFEXP; 06294000
- BEGIN INTEGER TYPE,THENBRANCH,ELSEBRANCH; 06295000
- IFCLAUSE; 06296000
- STACKCT _ 0; %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,THEBRANCH,L); 06301000
- IF ELCLASS ! ELSEV THEN ERR(155) ELSE BEGIN 06302000
- STEPIT; 06303000
- IF TYPE = ATYPE THEN AEXP ELSE 06304000
- IF TYPE = DTYPE THEN DEXP ELSE BEXP; 06305000
- STACKCT _ 1; %A 06305500
- COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 06306000
- EMITB(BFW,ELSEBRANCH,L); 06307000
- EMIT(1); L _ L-1; 06308000
- COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 06309000
- BOOSEC, BOOCOMP, AND RELATION; 06310000
- END END IFEXP; 06311000
-PROCEDURE PARSE ;%COMPILES CODE FOR THE CONCATENATE ; 06312000
-BEGIN INTEGER FIRST,SECOND,THIRD; 06312500
- BOOLEAN P1,P2,P3; 06313000
- LABEL L1,L2,L3,SKIP1,SKIP2,EXIT; 06313500
- IF ELCLASS = FIELDID THEN %117- 06313550
- BEGIN %117- 06313600
- FIRST := ELBAT[I].SBITF; %117- 06313650
- SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117- 06313700
- GO TO SKIP1; %117- 06313750
- END %117- 06313800
- ELSE %117- 06313850
- IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90); GO TO EXIT END; 06314000
- IF STEPI = FIELDID THEN %117- 06314050
- BEGIN %117- 06314100
- FIRST := ELBAT[I].SBITF; %117- 06314150
- SECOND := 48 - (THIRD := ELBAT[I].NBITF); %117- 06314200
- IF STEPI ! RTBRKET THEN %117- 06314250
- BEGIN %117- 06314300
- ERR(94); %117- 06314350
- GO TO EXIT; %117- 06314400
- END; %117- 06314450
- GO TO SKIP1; %117- 06314500
- END %117- 06314550
- ELSE %117- 06314600
- IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL %117- 06314650
- GO TO L1; %117- 06314700
- FIRST _ C; 06315000
- IF TABLE(I+1) = COLON THEN 06315500
- BEGIN 06316000
- STEPIT; 06316500
- IF FIRST<=0 THEN FLAG(92); 06317000
- END ELSE 06317500
- BEGIN 06318000
- L1: EMITO(MKS); 06318500
- AEXP; 06319000
- P1 _ TRUE; 06319500
- IF ELCLASS ! COLON THEN BEGIN ERR(91); GO TO EXIT END; 06320000
- END; 06320500
- IF STEPI ! LITNO THEN GO TO L2; 06321000
- 06321100
- SECOND _ C ; 06321500
- IF GT1 _ TABLE(I+1) = COLON THEN 06322000
- BEGIN 06322500
- STEPIT; 06323000
- IF SECOND<=0 THEN FLAG(092); 06323500
- END ELSE 06324000
- BEGIN 06324500
- IF GT1 = RTBRKET THEN 06325000
- BEGIN 06325500
- STEPIT; 06326000
- SECOND _ 48 - (THIRD _ SECOND); 06326500
- GO TO SKIP2; 06327000
- END; 06327500
- L2: IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06328000
- AEXP; 06328500
- P1 _ P2 _ TRUE; 06329000
- IF ELCLASS = COLON THEN 06329100
- 06329200
- 06329300
- ELSE 06329350
- IF ELCLASS = RTBRKET THEN 06329400
- BEGIN 06329450
- EMITO(DUP); 06329500
- EMITL(48) ;EMITO(SUB); 06329550
- EMITO(CHS);EMITO(XCH); 06329600
- P3 _ TRUE; 06329700
- GO TO SKIP1; 06329800
- END ELSE BEGIN ERR(91);GO TO EXIT END; 06329900
- END; 06330000
- IF STEPI ! LITNO THEN GO L3 ; 06330500
- THIRD _ C; 06330600
- IF TABLE(I+1) = RTBRKET THEN 06330700
- BEGIN 06330800
- STEPIT; 06331000
- SKIP2: IF THIRD<=0 OR THIRD > 47 THEN FLAG(95); 06331100
- END ELSE 06331200
- BEGIN 06331300
- L3: IF NOT P2 THEN 06331500
- BEGIN 06331600
- IF NOT P1 THEN BEGIN EMITO(MKS);EMITL(FIRST) END; 06331700
- EMITL(SECOND); 06331800
- END; 06332000
- AEXP; 06332100
- P1_ P2_P3 _TRUE; 06332200
- IF ELCLASS ! RTBRKET THEN BEGIN ERR(94);GO TO EXIT END; 06332300
- END; 06332400
- SKIP1: IF P1 THEN 06332500
- BEGIN 06333000
- IF NOT P2 THEN EMITL(SECOND); 06333500
- IF NOT P3 THEN 06334000
- BEGIN 06334100
- EMITL(THIRD);EMITL(1); 06334200
- EMITV(GNAT(DIALER)); 06334500
- EMIT(TRB & THIRD[36:42:6]); 06334600
- END ELSE 06334700
- BEGIN 06335000
- EMITL(0); 06335100
- EMITV(GNAT(DIALER)); 06335200
- EMITO(DEL); 06335500
- END; 06335700
- END ELSE 06336000
- BEGIN 06336100
- IF FIRST + THIRD > 48 OR SECOND + THIRD > 48 THEN FLAG(095); 06336200
- EMITD(SECOND,FIRST,THIRD); 06336300
- END; 06336400
- STEPIT; 06336500
- EXIT: STACKCT _ 1; 06336600
-END PARSE; 06336700
-COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 06337000
- THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 06337100
-PROCEDURE DOTIT; 06338000
- BEGIN INTEGER FIRST,SECOND; LABEL EXIT; 06339000
- IF DOTSYNTAX(FIRST,SECOND) THEN GO TO EXIT; 06340000
- %A 06342000
- EMITI(0,FIRST,SECOND); %A 06343000
- %A 06344000
- STEPIT; 06345000
-EXIT: END DOTIT; 06346000
-COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 06347000
- PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 06348000
- THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 06349000
- SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 06350000
- IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 06351000
- IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 06352000
- BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 06353000
- THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 06354000
- IS ALSO STORED IN F+1; 06355000
-PROCEDURE GENGO(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 06356000
- BEGIN INTEGER TLEVEL; 06357000
- EMITO(MKS); 06358000
- IF TLEVEL _ ELBATWORD.LVL > JUMPCTR THEN 06359000
- JUMPCTR _ TLEVEL; 06360000
- COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 06361000
- INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 06362000
- BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 06363000
- JUMPING; 06364000
- IF TLEVEL < FRSTLEVEL OR MODE = 0 06365000
- THEN BEGIN 06366000
- COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 06367000
- EMIT(0); 06368000
- EMIT(TLEVEL); END 06369000
- ELSE BEGIN 06370000
- EMITN(512); 06371000
- EMITV(513); COMENT PICK UP BLOCKCTR AT ENTRY 06372000
- FROM F+1; 06373000
- IF TLEVEL _ TLEVEL - SUBLEVEL -1 ! 0 06374000
- THEN BEGIN 06375000
- EMITL(TLEVEL); 06376000
- EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 06377000
- AS AT ENTRY TIME, FUDGE THE COUNTER; 06378000
- END END; 06379000
- EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 06380000
- END GENGO; 06381000
-COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 06382000
- IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 06383000
- THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 06384000
- STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 06385000
- SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 06386000
- COMMUNICATE WILL BE DONE; 06387000
-PROCEDURE DEXP; 06388000
- BEGIN 06389000
- LABEL EXIT; 06390000
- BOOLEAN S,F; 06391000
- REAL ELBW; 06392000
- IF (S _ ELCLASS = SWITCHID) OR ELCLASS = LABELID 06393000
- THEN BEGIN 06394000
- CHECKER(ELBW _ ELBAT[I]); 06395000
- SCATTERELBAT; 06396000
- IF LEVEL ! LEVELF OR F _ FORMALF THEN GOTOG _ TRUE; 06397000
- IF FAULTOG THEN 06397100
- IF S OR F THEN FAULTLEVEL_1 ELSE 06397200
- IF FAULTLEVEL>LEVELF THEN FAULTLEVEL_LEVELF; 06397300
- IF S THEN BEGIN 06398000
- BANA; EMITPAIR(JUNK,ISD); 06399000
- EMITV(GNAT(ELBW)); 06400000
- IF F THEN GO TO EXIT; END 06401000
- ELSE BEGIN 06402000
- STEPIT; 06403000
- IF F THEN BEGIN EMITV(ADDRSF); GO TO EXIT END; 06404000
- EMITL(GNAT(ELBW)) END; 06405000
- GENGO(ELBW); 06406000
- END ELSE IF EXPRSS ! DTYPE THEN ERR(115); 06407000
- EXIT: END DEXP; 06408000
-PROCEDURE IFCLAUSE; 06409000
- BEGIN STEPIT; STACKCT _ 0; BEXP; %A 06410000
- IF ELCLASS ! THENV THEN ERR(116)ELSE STEPIT END IFCLAUS; 06411000
-COMMENT PANA COMPILES THE CONSTRUCT: (); 06412000
-PROCEDURE PANA; 06413000
- BEGIN 06414000
- IF STEPI ! LEFTPAREN THEN ERR(105) 06415000
- ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTPAREN THEN 06416000
- ERR(104) ELSE STEPIT END END PANA; 06417000
-COMMENT BANA COMPILES THE CONSTRUCT: []; 06418000
-PROCEDURE BANA; 06419000
- BEGIN 06420000
- IF STEPI ! LFTBRKET THEN ERR(117) 06421000
- ELSE BEGIN STEPIT; AEXP; IF ELCLASS ! RTBRKET THEN 06422000
- ERR(118) ELSE STEPIT END END BANA ; 06423000
-PROCEDURE MAKEALABEL; 06500000
- BEGIN LABEL EXIT; REAL I; 06501000
- STREAMTOG_FALSE; 06502000
- EMITO(MKS); PASSFILE; 06503000
- IF ELCLASS!WITHV THEN 06504000
- BEGIN ERR(301); GO TO EXIT END; 06505000
- FOR I_1 STEP 1 UNTIL 6 DO 06506000
- BEGIN IF STEPI=FACTOP THEN 06507000
- BEGIN EMIT(4); EMITO(CHS); STEPIT END 06508000
- ELSE AEXP; 06509000
- IF ELCLASS!COMMA THEN GO TO EXIT; 06510000
- END; 06511000
-EXIT: FOR I:=I STEP 1 UNTIL 5 DO 06512000
-BEGIN EMIT(4);EMITO(CHS) END; 06512100
-EMITL(11); 06512200
- EMITV(5); 06513000
- END; 06514000
- COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES; 07000000
- COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 07001000
- COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES 07002000
- ARE SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE 07003000
- FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME 07004000
- CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 07005000
-PROCEDURE COMPOUNDTAIL; 07006000
- BEGIN LABEL ANOTHER; 07007000
- I _ I-1; BEGINCTR _ BEGINCTR+1; 07008000
- ANOTHER: ERRORTOG _ TRUE; COMMENT ALLOW ERROR MESSAGES; 07009000
- STEPTIT; 07010000
- IF STREAMTOG THEN STREAMSTMT ELSE STMT; 07011000
- IF ELCLASS = SEMICOLON THEN GO TO ANOTHER; 07012000
- IF ELCLASS ! ENDV 07013000
- THEN BEGIN 07014000
- ERR(119); GO TO ANOTHER END; 07015000
- ENDTOG_TRUE; 07016000
- DO STOPDEFINE_TRUE UNTIL 07017000
- STEPI<=END AND ELCLASS>=UNTILV 07018000
- OR NOT ENDTOG; 07019000
- ENDTOG_FALSE; 07020000
- IF BEGINCTR _ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000
- THEN BEGIN 07022000
- IF BEGINCTR = 0 THEN 07023000
- BEGIN FLAG(143); BEGINCTR _ 1; GO ANOTHER END; 07024000
- FLAG (120); %104- 07025000
- FCR:= (LCR:=MKABS(CBUFF[9]))-9; %104- 07025010
- IF LISTER THEN PRINTCARD; %104- 07025020
- FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; %104- 07025030
- IF ELCLASS = PERIOD THEN 07026000
- BEGIN 07027000
- GT5 _ "ND;END."&"E"[1:43:5]; 07028000
- MOVE(1,GT5,CBUFF[0]); 07029000
- LASTUSED_4; 07030000
- ELBAT[I_I-2] _SPECIAL[20]; 07031000
- ELCLASS _ SEMICOLON END 07032000
- END COMPOUNDTAIL; 07033000
- COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 07034000
- PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 07035000
- ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 07036000
- NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 07037000
- CONCERNING THE PARAMETERS: 07038000
- FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 07039000
- OR NOT. 07040000
- SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 07041000
- PROCEDURE OR NOT. 07042000
- INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 07043000
- INFORMATION; 07044000
- PROCEDURE ACTUALPARAPART(FBIT,SBIT,INDEX); 07045000
- VALUE FBIT,SBIT,INDEX; 07046000
- BOOLEAN FBIT,SBIT; 07047000
- INTEGER INDEX; 07048000
- BEGIN 07049000
- INTEGER PCTR,ACLASS,SCLASS; 07050000
- COMMENT 07051000
- PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 07052000
- COMPILED. 07053000
- ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 07054000
- SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 07055000
- THEY ARE PUT IN A NORMALIZED FORM IN ORDER 07056000
- TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 07057000
- SIMILAR MEANINGS; 07058000
- REAL WHOLE; 07059000
- COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 07060000
- PARAMETERS; 07061000
- BOOLEAN VBIT; 07062000
- COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO 07063000
- BE CALLED BY VALUE OR BY NAME; 07064000
- LABEL ANOTHER,NORMAL,VE,STORE,LRTS,LOWBD,FINISHBOO, 07065000
- LODPOINT,NSBS,BS,COMMON,LP,GOBBLE,BSXX,BSX,EXIT, 07066000
- CERR,FGEN; 07067000
- LABEL 07068000
- L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07069000
- L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07070000
- L31,L32,L33; 07071000
- SWITCH S _ 07072000
- L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17, 07073000
- L18,L19,L20,L21,L22,L23,L24,L25,L26,L27,L28,L29,L30, 07074000
- L31,L32,L33; 07075000
- REAL T1,T2,T3,T4,T5,T6; COMMENT EXAMINE LATER WITH EYE 07076000
- TO REDUCING TOTAL NUMBER; 07077000
- PCTR _ 1; 07078000
- ANOTHER: ACLASS _ STEPI; WHOLE _ ELBAT[I]; SCATTERELBAT; 07079000
- STACKCT _ 0; %A 07079500
- COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 07080000
- IF FBIT THEN BEGIN VBIT _ FALSE; SCLASS _ LOCLID END 07081000
- COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 07082000
- IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 07083000
- METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK; 07084000
- ELSE BEGIN 07085000
- VBIT _ BOOLEAN(GT1_ TAKE(INDEX+PCTR)).V0; 07086000
- IF SCLASS _GT1.CLASS<= INTARRAYID AND 07087000
- SCLASS>= BOOSTRPROCID 07088000
- THEN IF GT1 _ (SCLASS - BOOSTRPROCID) MOD 4 ! 0 07089000
- THEN SCLASS _ SCLASS-GT1+1 07090000
- COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION- 07091000
- AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 07092000
- SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 07093000
- END; 07094000
- IF T1 _ TABLE(I+1) ! COMMA THEN 07095000
- IF T1 ! RTPAREN THEN 07096000
- COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 07097000
- HENCE A DIFFERENT ANALYSIS IS REQUIRED; 07098000
- BEGIN IF ACLASS<= IDMAX OR ACLESS = SUPERLISTID THEN 07099000
- CHECKER(WHOLE); 07099500
- IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID 07100000
- THEN BEGIN 07101000
- COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 07102000
- HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 07103000
- SUPERFILE, AN INDEXED FILE OR SUPERLIST; 07104000
- IF ACLASS = SUPERFRMTID THEN 07105000
- BEGIN ACLASS _ FRMTID; GO TO FGEN END; 07106000
- IF ACLASS = SUPERFILEID OR ACLASS = FILEID 07107000
- THEN BEGIN 07108000
- T4_L; EMITO(NOP) ;%MAY NEED FOR FILEATTRIBUTES. 07108500
- IF NOT VBIT THEN EMITO(NOP) ; % DITTO. 07108505
- ACLASS _ FILEID; 07109000
- COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 07110000
- PASSFILE; 07111000
- IF ELCLASS=PERIOD THEN % THEN FILE ATTRIBUTE 07111200
- BEGIN 07111210
- IF VBIT THEN 07111220
- BEGIN 07111225
- T5_L; L_T4; EMITO(MKS); L_T5; T5_0 ; 07111230
- END ; 07111235
- ACLASS_IF FILEATTRIBUTEHANDLER(FA)=ATYPE 07111240
- THEN REALID ELSE BOOID ; 07111250
- IF ELCLASS!COMMA AND ELCLASS!RTPAREN THEN 07111255
- IF ACLASS=BOOID THEN SIMPBOO ELSE 07111260
- BEGIN 07111265
- SIMPARITH ; 07111270
- IF ELCLASS=RELOP THEN 07111275
- BEGIN 07111280
- ACLASS_BOOID; RELATION ; 07111285
- SIMPBOO ; 07111290
- END ; 07111295
- END ; 07111300
- IF NOT VBIT THEN 07111303
- BEGIN 07111307
- EMITPAIR(JUNK,STD); EMITN(JUNK) ; 07111310
- EMITO(RTS); ADJUST; CONSTANTCLEAN ; 07111315
- EMITO(MKS); EMITB(BBW,BUMPL,T4+2) ; 07111320
- EMITB(BFW,T4+2,L) ; 07111325
- STUFFF(PROGDESCBLDR(0,L-3,0)) ; 07111330
- END ; 07111335
- GO BS ; 07111340
- END OF FILE ATTRIBUTE PARAMETER EXPRESSION; 07111345
- IF ELCLASS ! LEFTPAREN THEN GO TO BS; 07112000
- I _ I-1; 07113000
- COMMENT IF WE ARE HERE IT IS INDEXED; 07114000
- CHECKPRESENCE; 07115000
- EMITO(LOD); PANA; EMITO(CDC); 07116000
- IF SCLASS = FILEID OR NOT SBIT OR VBIT 07117000
- THEN BEGIN ERR(121); GO TO CERR END 07118000
- COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 07119000
- STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 07120000
- RELEASE ON THIS DESCRIPTOR; 07121000
- ELSE GO TO COMMON END ; 07122000
- IF ACLASS = SUPERLISTID THEN BEGIN BANA; 07122500
- EMITV(WHOLE.ADDRESS); 07122510
- IF WHOLE.ADDRESS>1023 THEN EMITO(PRTE); 07122520
- EMITO(LOD); 07122530
- ACLASS_LISTID; GO TO BS END; 07122540
- COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 07123000
-NORMAL: IF VBIT THEN 07124000
-VE: T1 _ EXPRSS COMMENT VALUE CALL EXPRESSION; 07125000
- ELSE BEGIN COMMENT NAME CALL EXPRESSION; 07126000
- IF SBIT THEN BEGIN FLAG(122); GO TO CERR END; 07127000
- COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME; 07128000
- T2 _ BAE; 07129000
- T3 _ PROGDESCBLDR(0,L,0); 07130000
- COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 07131000
- AROUND CODE FOR EXPRESSION; 07132000
- T1 _ EXPRSS; COMMENT COMPILE EXPRESSION; 07133000
-STORE: EMITPAIR(JUNK,STD); EMITN(JUNK); 07134000
- COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 07135000
- PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 07136000
- INTO JUNK; 07137000
-LRTS: EMITO(RTS); CONSTANTCLEAN; EMITB(BFW,T2,L); STUFFF(T3) 07138000
- COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 07139000
- THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 07140000
- EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 07141000
- THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 07142000
- OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 07143000
- END OF NAME CALL EXPRESSIONS; 07144000
- ACLASS _ IF T1 = ATYPE THEN REALID ELSE IF T1 = BTYPE 07145000
- THEN BOOID ELSE LABELID; GO TO BS; 07146000
- END OF EXPRESSION CALL CODE; 07147000
- COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 07148000
- ARRAY NAME FOLLOWED BY SOMETHING ELSE; 07149000
- IF SCLASS>= BOOARRAYID THEN 07150000
- IF SCLASS <=INTARRAYID THEN 07151000
- BEGIN T2 _ TAKE(INDEX+PCTR).INCR; 07152000
- COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER. 07153000
- THUS WE MUST HAVE A ROW DESIGNATOR; 07154000
- IF ACLASS ! BOOARRAYID THEN ACLASS _ REALARRAYID; 07155000
- COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 07156000
- VARIABLE(FA); IF TABLE(I-2) ! FACTOP 07157000
- THEN BEGIN ERR(123); GO TO EXIT END; 07158000
- COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 07159000
- COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 07163000
- STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 07164000
-LOWBD: IF T2 ! STLB THEN BEGIN FLAG(124); GO TO CERR END 07165000
- THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION 07166000
- ELSE GO TO BS END; 07167000
- IF VBIT THEN GO TO VE; 07168000
- COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 07169000
- VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 07170000
- IF SBIT 07171000
- THEN BEGIN 07172000
- T6 _ FL; VARIABLE(T6); 07173000
- IF T6 ! 0 THEN GO TO BS; 07174000
- FLAG(122);GO TO CERR END; 07175000
- COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 07176000
- CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 07177000
- VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 07178000
- THAN THIS IT SETS T6 TO ZERO; 07179000
- COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 07180000
- WE HAVE NOT YET DECEIDED WHETHER WE HAVE 07181000
- 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 07182000
- 2) A SUBSCRIPTED VARIABLE, OR 07183000
- 3) A GENUINE NAME CALL EXPRESSION; 07184000
- IF TABLE(I+2) = LITNO AND 07185000
- ( GT1 _ TABLE(I+4) = COMMA OR GT1 = RTPAREN) 07186000
- THEN BEGIN 07187000
- COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 07188000
- CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 07189000
- ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 07190000
- VARIABLE(FL); 07191000
- ACLASS _ IF ACLASS = BOOARRAYID THEN BOOID ELSE 07192000
- REALID; GO TO BS END; 07193000
- T2 _ BAE; T3 _ L; 07194000
- COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 07195000
- IF WE HAVE ROW DESIGNATOR; 07196000
- T6 _ FA; VARIABLE(T6); 07197000
- IF TABLE(I-2) = FACTOP 07198000
- THEN BEGIN 07199000
- COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 07200000
- EMITB(BFW,T2,T3); T2 _ STLB; GO TO LOWBD END; 07201000
- COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 07202000
- T3 _ PROGDESCBLDR(0,T3,0); 07203000
- T1 _ IF BOOARRAYID = ACLASS THEN BTYPE ELSE ATYPE; 07204000
- IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 07205000
- COMMENT WE ARE AT END OF PARAMETER; 07206000
- IF T6 = 0 THEN COMMENT MORE THAN SUBSCRIPTED VARIABLE; 07207000
- GO TO STORE ELSE COMMENT SUBSCRIPTED VARIABLE; 07208000
- GO TO LRTS; 07209000
- IF T1 = BTYPE THEN GO TO FINISHBOO; SIMPARITH; 07210000
- IF ELCLASS = RELOP THEN BEGIN T1 _ BTYPE; RELATION; 07211000
-FINISHBOO: SIMPBOO END; GO TO STORE END; 07212000
- COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 07213000
- ACTUAL PARAMETER; 07214000
- IF ACLASS<= IDMAX OR ACLASS = SUPERLISTID THEN 07215000
- CHECKER(WHOLE); STEPIT; 07215500
- GO TO S[ACLASS-3]; 07216000
- IF ACLASS = 0 THEN FLAG(100) ELSE 07217000
- IF ACLASS= SUPERLISTID THEN 07217500
- BEGIN EMITPAIR(ADDRSF,LOD); GO TO BS END; 07217510
- FLAG(126); 07217520
-CERR: 07218000
-L12:L13:L14:L15:L16: 07219000
- COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 07220000
- FLAG(125); ERRORTOG _ TRUE; GO TO COMMON; 07221000
-LODPOINT: 07222000
-L4:L8: 07223000
- COMMENT LIST, SUPERLIST OR SUPERFILE; 07224000
- EMITPAIR(ADDRSF,LOD); 07225000
-NSBS: IF SBIT THEN BEGIN FLAG(127); GO TO CERR END; 07226000
- COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 07227000
- STREAM PROCEDURES; 07228000
-BS: IF SCLASS ! ACLASS THEN 07229000
- IF SCLASS ! LOCLID THEN 07230000
- COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 07231000
- AGREE; 07232000
- BEGIN FLAG(123); GO TO CERR END; 07233000
-COMMON: 07234000
- COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 07235000
- PCTR _ PCTR+1; 07236000
- IF ELCLASS = COMMA THEN GO TO ANOTHER; 07237000
- IF ELCLASS ! RTPAREN 07238000
- THEN BEGIN ERROR(129); GO TO EXIT END; 07239000
- IF NOT FBIT THEN 07240000
- IF TAKE(INDEX).NODIMPART+1 ! PCTR 07241000
- THEN BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 07242000
- ERR(128); GO TO EXIT END; 07243000
- STEPIT; GO TO EXIT; 07244000
-L5: 07245000
- COMMENT FORMATS; 07246000
- I_I-1; 07247000
-FGEN: PASSFORMAT; 07248000
- IF SBIT THEN BEGIN EMITO(XCH); EMITO(CDC) END; 07249000
- I_I+1; 07250000
- GO TO BS; 07251000
-L6: 07252000
- COMMENT SUPERFORMAT; 07253000
- IF FBIT 07254000
- THEN BEGIN EMITV(ADDRSF); ADDRSF _ ADDRSF-1 END 07255000
- ELSE BEGIN I _ I -1; EMITL(TAKEFRST); I _ I+1 END; 07256000
- GO TO LODPOINT; 07257000
-L7: 07258000
- COMMENT FILE; 07259000
- I _ I-1; ELCLASS _ FILEID; 07260000
- PASSFILE; GO TO BS; 07261000
-L9: 07262000
- COMMENT SWITCH; 07263000
- IF FORMALF THEN GO TO LODPOINT; 07264000
- COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 07265000
- MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 07266000
- DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 07267000
- ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 07268000
- THEY ARE OR NOT; 07269000
- T2 _ BAE; T3_PROGDESCBLDR(0,L,0); EMITV(GNAT(WHOLE)); 07270000
- GENGO(WHOLE); 07271000
- EMITO(RTS); EMITB(BFW,T2,L); STUFFF(T3); GO TO NSBS; 07272000
-L10: 07273000
- COMMENT PROCEDURE; 07274000
- TB1 _ TRUE; IF FORMALF THEN GO LODPOINT; 07275000
-LP: IF T1 _ TAKE(WHOLE _ GIT(WHOLE)).[40:8] = 0 07276000
- THEN BEGIN 07277000
- COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 07278000
- IF TB1 THEN GO TO LODPOINT; 07279000
- COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 07280000
- DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE); 07281000
- IF NOT FBIT THEN 07281900
- IF SCLASS<= INTPROCID THEN SCLASS _ SCLASS+4; 07282000
- I _ I-2; STEPIT; 07283000
- GO TO NORMAL; COMMENT WE LET OUT NORMAL MECHANISM FOR 07284000
- EXPRESSIONS HANDLE THIS CASE; 07285000
- END THE CASE OF ZERO PARAMETERS; 07286000
- TB1 _ TRUE; 07287000
- FOR T2 _ 1 STEP 1 UNTIL T1 07288000
- DO BEGIN 07289000
- IF BOOLEAN(T3_TAKE(WHOLE+T2)).V0 07290000
- THEN 07291000
- IF T4 _ T3.CLASS < BOOARRAYID OR T4 > INTARRAYID 07292000
- THEN BEGIN 07293000
- COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 07294000
- IF TB1 THEN 07295000
- BEGIN 07296000
- COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 07297000
- VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 07298000
- PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 07299000
- VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 07300000
- PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK 07301000
- CONSTRUCTIONS; 07302000
-GOBBLE: 07303000
- TB1 _ FALSE; T5 _ BAE; 07304000
- T6 _ PROGDESCBLDR(1,L,0) END; 07305000
- EMITV(T4 _ T3.ADDRESS); EMITPAIR(T4,STD)END END; 07306000
- COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000
- IF NOT TB1 07308000
- THEN BEGIN 07309000
- COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000
- EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000
- CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF _ T6 END; 07312000
- GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000
-L11: 07314000
- COMMENT INTRINSIC PROCEDURE; 07315000
- ADDRSF _ GNAT(WHOLE); 07316000
- COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000
- ACLASS _ REALPROCID; 07318000
- T3.ADDRESS _ 897; T2_T1_1; GO TO GOBBLE; 07319000
- COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000
- PROCEDURES; 07321000
-L19:L20: 07322000
- COMMENT ALFAPROC AND INTPROC; 07323000
- ACLASS _ REALPROCID; 07324000
-L17:L18: 07325000
- COMMENT BOOPROC AND REAL PROC; 07326000
- IF FORMALF 07327000
- THEN BEGIN 07328000
- COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000
- IF SCLASS > INTPROCID THEN ACLASS _ ACLASS+4; 07330000
- COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000
- EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000
- PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000
- IF VBIT 07334000
- THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000
- ELSE GO TO LODPOINT; 07336000
- COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000
- DESCRIPTOR ALONG; 07338000
- END; 07339000
- TB1 _ FALSE; GO TO LP; 07340000
-L23:L24: 07341000
- COMMENT INTEGER AND ALPHA IDS; 07342000
- ACLASS _ REALID; 07343000
-L21:L22: 07344000
- COMMENT BOOLEAN AND REAL IDS; 07345000
- IF VBIT THEN EMITV(ADDRSF) 07346000
- ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000
- THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000
- COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000
- AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000
- THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000
- GO TO BS; 07352000
-L27:L28: 07353000
- COMMENT INTEGER AND ALPHA ARRAYS; 07354000
- ACLASS _ REALARRAYID; 07355000
-L25:L26: 07356000
- COMMENT BOOLEAN AND REAL ARRAYS; 07357000
- EMITPAIR(ADDRSF,LOD); 07358000
- IF SBIT THEN GO TO BS; 07359000
- COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000
- T1 _ TAKE(WHOLE _ GIT(WHOLE)).NODIMPART; 07361000
- FOR T2 _ 1 STEP 1 UNTIL T1 07362000
- DO BEGIN 07363000
- IF T3 _ (STLB _ TAKE(WHOLE+T2)).[35:11] >1023 07364000
- THEN EMITV(T3) ELSE EMIT(STLB); 07365000
- IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000
- COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000
- IF FBIT THEN GO TO BS; 07368000
- IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000
- COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000
- OF DIMENSIONS; 07371000
-L29: 07372000
- COMMENT LABEL; 07373000
- ELCLASS _ TABLE(I_I-1); DEXP; GO TO NSBS; 07374000
-L30: 07375000
- COMMENT TRUTH VALUE; 07376000
- EMITL(ADDRSF); ACLASS _ BOOID; GO TO BSX; 07377000
-L32: 07378000
- COMMENT LITERAL; 07379000
- EMITL(ADDRSF); 07380000
-BSXXX: ACLASS _ REALID; 07381000
-BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000
-L31:L33: 07383000
- EMITNUM(C); GO TO BSXXX; 07384000
-EXIT: STACKCT _ 0 END OF ACTUALPARAPART; %A 07385000
-COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 07386000
- FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 07387000
- PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 07388000
- IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 07389000
- OPERATIONS; 07390000
-PROCEDURE PROCSTMT(FROM); VALUE FROM; BOOLEAN FROM; 07391000
- BEGIN 07392000
- REAL HOLE,ADDRESS; 07393000
- LABEL EXIT; 07394000
- SCATTERELBAT; 07395000
- HOLE_ ELBAT[I]; 07396000
- ADDRESS _ ADDRSF; 07397000
- CHECKER(HOLE); 07398000
- IF ELCLASS ! PROCID THEN 07399000
- IF NOT FORMALF THEN 07400000
- IF TABLE(I+1) = ASSIGNOP THEN 07401000
- BEGIN VARIABLE(2-REAL(FROM)); GO TO EXIT END; 07402000
- COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 07403000
- IF ELCLASS ! PROCID EQV FROM 07404000
- THEN BEGIN ERR(159); GO TO EXIT END; 07405000
- COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 07406000
- STEPIT; 07407000
- EMITO(MKS); 07408000
- IF ELCLASS = LEFTPAREN 07409000
- THEN ACTUALPARAPART(FORMALF,FALSE,GIT(HOLE)) 07410000
- ELSE IF FORMALF THEN 07411000
- IF FROM THEN ELSE L_L-1 07411100
- ELSE IF TAKE(GIT(HOLE)).NODIMPART!0 THEN ERR(128); 07412000
- EMITV(ADDRESS); 07413000
- COMMENT MONITOR CODE GOES HERE; 07414000
- IF HOLE < 0 07415000
- THEN BEGIN COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR 07416000
- ; 07417000
- EMITL(JUNK); EMITO(SND); EMITO(MKS); 07418000
- EMITL(JUNK); EMITL(PASSTYPE(HOLE)); 07419000
- EMITPAIR(GNAT(POWERSOFTEN),LOD);PASSALPHA(HOLE); 07420000
- EMITPAIR(GNAT(CHARI ),LOD); PASSMONFILE(TAKE 07421000
- (GIT(HOLE)),FUNCMONFILE); %109- 07422000
- EMITNUM(1&CARDNUMBER[1:4:44]); %109- 07422100
- EMITV(GNAT(PRINTI)); 07423000
- END; 07424000
-EXIT: END PROCSTMT; 07425000
-COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES; 07426000
-PROCEDURE STRMPROCSTMT; 07427000
- BEGIN 07428000
- INTEGER ADDRS; 07429000
- IF ADDRS _ ELBAT[I].ADDRESS = 0 07430000
- THEN BEGIN 07431000
- UNKNOWNSTMT; 07432000
- END 07433000
- 07434000
- 07435000
- 07436000
- 07437000
- 07438000
- 07439000
- ELSE BEGIN 07440000
- IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000
- GT1 _ (GT2 _ TAKE(GT3 _ GIT(ELBAT[I-1]))).[14:10]; 07442000
- GT4 _ GT1-GT2.[7:6]; 07443000
- FOR GT1 _ GT1-1 STEP -1 UNTIL GT4 07444000
- DO EMITV(IF GT1>= 512 THEN GT1+1024 ELSE GT1); 07445000
- COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000
- JUMPS INSIDE OF STREAM PROCEDURES; 07447000
- GT4 _ GT2.[1:6]; 07448000
- FOR GT1 _ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000
- COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE 07450000
- OF STREAM PROCEDURES; 07451000
- IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000
- ELSE BEGIN 07453000
- ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000
- END END STRMPROCSTMT; 07455000
-COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000
- ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000
-INTEGER PROCEDURE BAE; 07458000
- BEGIN BAE _ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000
-COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000
- RELEASE() % AUXMEM RELEASE STATEMENT. 07460250
- RELEASE() % DATACOM RELEASE STATEMENT. 07460500
- RELEASE() % FILE RELEASE STATEMENT. 07460750
- ; 07461000
-PROCEDURE RELSESTMT; 07461250
- BEGIN 07461500
- LABEL DCR,PARENCHECK,EXIT; 07461750
- IF STEPI!LEFTPAREN THEN 07462000
- BEGIN ERR(105); GO EXIT END; 07462250
- IF STEPI=UNKNOWNID THEN 07462500
- BEGIN ERR(100); GO EXIT END; 07462750
- IF ELCLASS=PROCID OR RANGE(BOOPROCID,INTPROCID) THEN 07463000
- BEGIN 07463250
- EMITPAIR(ELBAT[I].ADDRESS,LOD); EMITPAIR(38,COM); 07463500
- EMITO(DEL); STEPIT; GO PARENCHECK; 07463750
- END; 07464000
- IF RANGE(BOOARRAYID,INTARRAYID) THEN 07464250
- BEGIN 07464500
- REL:=TRUE;AEXP; REL:=FALSE; 07464750
- IF TABLE(I-2) = FACTOP THEN 07465000
- BEGIN STACKCT:=STACKCT-1; 07465250
- EMITPAIR(38,COM); EMIT0(DEL); GO PARENCHECK; 07465500
- END 07465750
- ELSE BEGIN % DATACOM RELEASE. 07466000
-DCR: 07466250
- EMITL(2); EMITO(XCH); EMITL(0); EMITO(XCH); 07466500
- EMITL(0); EMITPAIR(32,COM); EMITO(DEL); 07466750
- EMITO(DEL); EMITO(DEL); EMITO(DEL); GO PARENCHECK; 07467000
- END; 07467250
- END; 07467500
- IF FLCASS!FILEID AND ELCLASS!SUPERFILEID THEN % DATACOM RELEASE. 07467750
- BEGIN AEXP; GO DCR; END; 07468000
- CHECKER(ELBAT[I]); PASSFILE; 07468250
- IF ELCLASS = COMMA THEN EMITO(DUP); 07468500
-COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 07468750
- CHECKPRESENCE; 07469000
-COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 07469250
- NOT COMPLETED; 07469500
- EMITO(DUP); EMITO(LOD); EMITO(XCH); 07469750
- IF ELCLASS = COMMA THEN 07470000
- BEGIN 07470250
- EMITO(DUP); EMITO(LOD); STEPIT; AEXP; 07470500
- EMITD(38,8,10); EMITO(XCH); EMITO(STD); EMITO(XCH); 07470750
- END; 07471000
- EMITO(PRL); EMITO(DEL); 07471250
-PARENCHECK: 07471500
- IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07471750
-EXIT: 07472000
- END RELSESTMT; 07472250
-COMMENT DOTSTMT HANDLES THE DO STATEMENT; 07481000
-PROCEDURE DOSTMT; 07482000
- BEGIN INTEGER TL; 07483000
- DIALA _ DIALB _ 0; 07484000
- ADJUST; 07484100
- STEPIT; TL_L; STMT; IF ELCLASS ! UNTILV THEN ERR(131) 07485000
- ELSE BEGIN 07486000
- STEPIT; BEXP; EMITB(BBC,BUMPL,TL) END 07487000
- END DOSTMT; 07488000
-COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 07489000
-PROCEDURE WHILESTMT; 07490000
- BEGIN INTEGER BACK,FRONT; 07491000
- DIALA _ DIALB _ 0; 07492000
- ADJUST; 07492100
- STEPIT; BACK _ L; BEXP; FRONT _ BUMPL; 07493000
- IF ELCLASS ! DOV THEN ERR(132) ELSE 07494000
- BEGIN STEPIT; STMT; EMITB(BBW,BUMPL,BACK); 07495000
- CONSTANTCLEAN; EMITB(BFC,FRONT,L) END END WHILESTMT; 07496000
-COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 07497000
- EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 07498000
- OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 07499000
- STORAGE RETURNED. SEE DEXP AND GENGO; 07500000
-PROCEDURE GOSTMT; 07501000
- BEGIN 07502000
- REAL ELBW; 07503000
- LABEL GOMCP,EXIT; 07504000
- IF STEPI = TOV THEN STEPIT; 07505000
- IF ELCLASS = LABELID THEN TB1 _ TRUE 07506000
- ELSE IF ELCLASS = SWITCHID THEN TB1 _ FALSE ELSE GO GOCMP; 07507000
- IF NOT LOCAL(ELBAT[I]) THEN GO GOCMP; 07508000
- IF TB1 THEN BEGIN GOGEN(ELBAT[I],BFW); STEPIT; 07509000
- CONSTANTCLEAN; GO EXIT END; 07510000
- ELBW _ ELBAT[I]; 07511000
- IF ELBW < 0 07512000
- THEN BEGIN COMMENT THIS IS A MONITORED SWITCH; 07513000
- EMITO(MKS); PASSALPHA(ELBW);EMITPAIR(GNAT( 07514000
- CHARI),LOD); PASSMONFILE(TAKE(GIT(ELBW)), 07515000
- SWITMONFILE); %109- 07516000
- EMITNUM(0&CARDNUMBER[1:4:44]); %109- 07516100
- EMITV(GNAT( %109- 07516200
- PRINTI)); 07517000
- END; 07518000
- BANA; EMITPAIR(JUNK,ISD); 07519000
- IF (GT1 _ TAKE(GT2 _ GIT(ELBW))).[24:12] = 0 07520000
- AND ELBW.ADDRESS = 0 THEN BEGIN 07521000
- PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000
- EMITB(BBW,L,GT4_GT1.[36:12]); 07523000
- EMITB(BFW,GT4+13,L+3); 07524000
- EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000
- ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000
- GO EXIT; 07527000
- GOMCP: GOTOG _ FALSE; DEXP; 07528000
- IF GOTOG THEN 07529000
- BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100
- ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200
- EXIT:END GOSTMT; 07530000
-COMMENT GOGEN GENERATES CODE TO GO TO A LABEL. GIVEN THAT LABEL AS A 07531000
- PARAMETER. GOGEN ASSUMES THA THE LABEL IS LOCAL. THE 07532000
- PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL 07533000
- OR NOT; 07534000
-PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000
- VALUE LABELBAT,BRANCHTYPE; 07536000
- REAL LABELBAT,BRANCHTYPE; 07537000
- BEGIN 07538000
- IF BOOLEAN(GT1_TAKE(GT2_GIT(LABELBAT))).[1:1] 07539000
- THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000
- COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000
- NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000
- THAT WE NOW KNOW WHERE TO GO; 07543000
- ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000
- PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000
-COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000
- A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000
-BOOLEAN PROCEDURE SIMPGO; 07548000
- BEGIN LABEL EXIT; 07549000
- IF ELCLASS = GOV 07550000
- THEN BEGIN 07551000
- IF STEPI = TOV THEN STEPIT; 07552000
- IF ELCLASS = LABELID THEN 07553000
- IF LOCAL(ELBAT[I]) THEN 07554000
- BEGIN SIMPGO _ TRUE; GO EXIT END; 07555000
- I _ I-1; ELCLASS _ GOV END; 07556000
- EXIT: END SIMPGO; 07557000
-COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000
- OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000
- EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000
-PROCEDURE IFSTMT; 07561000
- BEGIN REAL T1,T2; LABEL EXIT; 07562000
- IFCLAUSE; 07563000
- IF SIMPGO 07564000
- THEN BEGIN 07565000
- T1 _ ELBAT[I]; 07566000
- IF STEPI = ELSEV 07567000
- THEN BEGIN 07568000
- STEPIT; 07569000
- IF SIMPGO 07570000
- THEN BEGIN 07571000
- GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000
- STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000
- STMT ; GO TO EXIT END END ; 07574000
- EMITLNG; GOGEN(T1,BFC); 07575000
- GO EXIT END; 07576000
- T1 _ BUMPL; STMT; 07577000
- IF ELCLASS ! ELSEV THEN 07578000
- BEGIN DIALA _ DIALB _ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000
- STEPTIT; 07580000
- IF SIMPGO 07581000
- THEN BEGIN 07582000
- T2 _ L; L _T1-2;GOGEN(ELBAT[I],BFC); L _ T2; 07583000
- STEPIT; GO EXIT END; 07584000
- T2 _ BUMPL; CONSTANTCLEAN; 07585000
- EMITB(BFC,T1,L); STMT; EMITB(BFW,T2,L); 07586000
- EXIT: END IFSTMT; 07587000
- COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 07588000
- ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 07589000
- AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 07590000
- UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 07591000
- IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 07592000
- PROCEDURE LABELR; 07593000
- BEGIN LABEL EXIT, ROUND; 07594000
-DEFINE ELBATWORD=RR9#,LINK=GT2#,INDEX=GT3#,ADDITIONAL 07595000
- =GT4#,NEXTLINK=GT5#; 07596000
- DO BEGIN ADJUST; IF STEPI ! COLON THEN 07597000
- BEGIN ERR(133); GO TO EXIT END; 07598000
- XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION %116- 07598100
- % WHEN WE GET AROUND TO THE XREF. %116- 07598200
- IF NOT LOCAL(ELBATWORD _ ELBAT[I-1]) 07599000
- THEN BEGIN FLAG(134); GO TO ROUND END; 07600000
- LINK _ (ADDITIONAL _ TAKE(INDEX _ GIT(ELBATWORD))) 07601000
- .[36:12]; 07602000
- IF ADDITIONAL < 0 THEN 07603000
- BEGIN FLAG(135); GO TO ROUND END; 07604000
- WHILE LINK ! 0 07605000
- DO BEGIN 07606000
- NEXTLINK _ GET(LINK-2); 07607000
- EMITB(GET(LINK-1),LINK,L); 07608000
- LINK _ NEXTLINK; 07609000
- IF LASTENTRY>= 126 THEN % DONT LET EMITNUM DO IT 07609100
- BEGIN REAL C; % HOLD L FOR A WHILE 07609200
- COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 07609300
- (>1023 WORD) FORWARD REFERENCES TO A LABEL; 07609400
- C _ BUMPL; 07609500
- CONSTANTCLEAN; 07609600
- EMITB(BFW,C,L) END;END; 07609700
- PUT(-ADDITIONAL&L[36:36:12],INDEX); 07610000
- IF ELBATWORD < 0 07611000
- THEN BEGIN COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 07612000
- OR MONITOR DECLARATION; 07613000
- IF RR1_ADDITIONAL.LABLMONFILE ! 0 07614000
- THEN BEGIN COMMENT THIS CODE IS FOR MONITORED 07615000
- LABELS; 07616000
- EMITO(MKS); PASSALPHA(ELBATWORD); 07617000
- EMITPAIR(GNAT(CHARI),LOD); 07618000
- PASSMONFILE(RR1); %109- 07619000
- EMITNUM(0&CARDNUMBER[1:4:44]); %109- 07619100
- EMITV(GNAT(PRINTI)); 07620000
- END; 07621000
- IF RR1_ADDITIONAL.DUMPEE ! 0 07622000
- THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000
- LABEL COUNTER; 07624000
- EMITV(RR1); EMITL(1); EMITO(ADD); 07625000
- EMITPAIR (RR1,STD); 07626000
- IF RR1_ADDITIONAL.DUMPOR ! 0 07627000
- THEN BEGIN COMMENT EMIT CODE TO CALL 07628000
- THE DUMP ROUTINE; 07629000
- 07630000
- 07631000
- 07632000
- STUFFF(RR1); EMITO 07633000
- (XCH);EMITO(COC); 07634000
- 07635000
- 07636000
- 07637000
- 07638000
- 07639000
- 07640000
- EMITO(DEL); 07641000
- END; 07642000
- END; 07643000
- END; 07644000
-ROUND: ERRORTOG _ TRUE END UNTIL STEPI ! LABELID; 07645000
- EXIT: END LABELR; 07646000
-PROCEDURE CASESTMT; 07646100
-BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110
- CASE OF BEGIN 07646120
- AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 07646130
- IN THE , DEPENDING ON THE VALUE OF THE , 07646140
- ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 07646150
- THE . IF THERE ARE N STATEMENTS IN THE 07646160
- , THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1. 07646170
- AND THE MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 07646180
- WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 07646190
- THE STATEMENTS IN THE MAY BE ANY EXECUTABLE 07646200
- STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 07646210
- AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 07646220
- 07646230
- OPDC ARRAY 07646240
- BFW 07646250
- STMT 0 07646260
- BRANCH TO RESUME 07646270
- STMT 1 07646280
- BRANCH TO RESUME 07646290
- . 07646300
- . 07646310
- . 07646320
- STMT N-1 07646330
- RESUME: 07646340
- "ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 07646350
- CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 07646360
- BY THE VALUE OF AND CONTAINS SYLLABLE COUNTS 07646370
- FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 07646375
- IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 07646380
- TRANSFERS TO RESUME DIRECTLY; 07646385
- REAL LINK, TEMP, N, ADR, PRT, NULL; 07646390
- BOOLEAN GOTOG; 07646395
- REAL ARRAY TEDOC[0:7, 0:127]; 07646400
- LABEL LOOP, XIT; 07646410
- LINK _ N _ NULL _ 0; 07646420
- STEPIT; AEXP; 07646430
- IF STEPI ! BEGINV THEN BEGIN ERR( 70); GO TO XIT END; 07646440
- EMITV(PRT:=GETSPACE(TRUE,-3)); % CASE STMNT. DESCR. 07646450
- EMITO(BFW); ADR _ L; 07646460
-LOOP: 07646470
- ERRORTOG _ TRUE; 07646475
- IF STEPI = SEMICOLON THEN 07646480
- BEGIN COMMENT NULL STATEMENT; 07646485
- TEDOC[N,[38:3], N.[41:7]] _ NULL; 07646490
- NULL _ N _ N+1; GO TO LOOP; 07646495
- END; 07646500
- TEDOC[N.[38:3], N.[41:7]] _ L-ADR; N _ N + 1; 07646510
- IF GOTOG := SIMPGO THEN ELBAT[I_I-1] _ ELCLASS _ GOV; 07646515
- STMT; 07646520
- IF ELCLASS = SEMICOLON THEN 07646525
- BEGIN IF NOT GOTOG THEN 07646530
- BEGIN EMIT(LINK);LINK _ L _ L+1; END; 07646533
- GO TO LOOP; 07646535
- END ELSE IF ELCLASS = ENDV THEN 07646538
- BEGIN IF NOT GOTOG THEN 07646540
- BEGIN EMIT(LINK); LINK _ L _ L+1; END; 07646543
- TEDOC[N,[38:3], N.[41:7]]_ L-ADR; 07646545
- N _ N+1; 07646548
- END; 07646550
- IF ELCLASS ! ENDV THEN BEGIN ERR( 71); GO TO LOOP END; 07646555
- N := N-1 ; 07646556
- WHILE NULL ! 0 DO 07646560
- BEGIN TEMP _ TEDOC[(NULL_NULL-1).[38:3], NULL.[41:7]]; 07646565
- TEDOC[NULL.[38:3], NULL.[41:7]] _ L-ADR; 07646570
- NULL _ TEMP; 07646575
- END; 07646580
- ENDTOG _ TRUE; 07646585
- COMMENT SKIP ANY COMMENTS AFTER "END"; 07646590
- DO STOPDEFINE _ TRUE UNTIL STEPI<= ENDV AND ELCLASS >=UNTILV 07646595
- OR NOT ENDTOG; 07646600
- ENDTOG _ FALSE; 07646610
- COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 07646620
- MOVECODE(TEDOC, EDOC); 07646630
- BUILDLINE _ BOOLEAN(2xREAL(BUILDLINE)) ; 07646635
- TEMP := SGNO; IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07646640
- SGNO _ SGAVL; 07646650
- Z _ PROGDESCBLDR(LDES, 0, PRT); 07646660
- SEGMENT(-N, SGNO, TEMP); 07646670
- SGAVL _ SGAVL + 1; SGNO _ TEMP; 07646680
- BUILDLINE _ BUILDLINE.[46:1] ; 07646685
- MOVECODE(TEDOC, EDOC); 07646690
- COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700
- IF (L-ADR)>1019 THEN ADJUST;% 07646705
- WHILE LINK ! 0 DO 07646710
- BEGIN TEMP _ GET(LINK-2); 07646720
- EMITB(BFW, LINK, L); 07646730
- LINK _ TEMP; 07646740
- IF LASTENTRY >=126 THEN 07646750
- BEGIN REAL C; 07646760
- COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770
- C _ BUMPL; 07646780
- CONSTANTCLEAN; 07646790
- EMITB(BFW, C, L); 07646800
- END; 07646810
- END; 07646820
-XIT: 07646830
-END CASESTMT; 07646840
-COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07647000
- IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07647500
- THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07648000
- THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07648500
- NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07649000
- RESIDES ON THE DISK AND IS READ INTO THE ROW DESIGNATED 07649500
- BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07650000
- EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07650500
- ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07651000
- NUMBERS LOOK LIKE IDENITIFERS TO FILLSTMT AND ARE CONVERTED 07651500
- BY OCTIZE.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN 07652000
- PDPRT TO SUPPLY INFO TO BUILD A DISK DESCRIPTOR IN THE 07652500
- SEGMENT DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07653000
-PROCEDURE FILLSTMT; 07653500
- BEGIN 07654000
- LABEL EXIT; 07654500
- DEFINE PARENCOUNTER = RR1#, 07655000
- T = RR2#, 07655500
- J = RR3#; 07656000
- ARRAY TEDOC[0:7,0:127], FILLTEMP[0:1022]; 07656500
- BOOLEAN PROCEDURE FILLIT(A); ARRAY A[0]; 07657000
- BEGIN 07657500
- REAL T1, T2, T3; 07658000
- BOOLEAN BOO; 07658500
- LABEL CHECK, GOOFUP, EXIT; 07659000
- PARENCOUNTER:=PARENCOUNTER+1; 07659500
- WHILE T<1023 DO 07660000
- BEGIN 07660500
- IF STEPI>IDMAX THEN 07661000
- BEGIN 07661500
- IF ELCLASS=LITNO THEN 07662000
- IF TABLE(I+1)=LEFTPAREN THEN 07662500
- BEGIN 07663000
- T1:=ELBAT[I].ADDRESS; T2:=T; 07663500
- STEPIT; IF FILLIT(A) THEN GO GOOFUP; 07664000
- IF T1=0 THEN T:=T2 07664500
- ELSE BEGIN 07665000
- IF (T3:=(T1-1)x(T-T2))+T>1022 THEN 07665500
- BEGIN ERROR(305); GO GOOFUP END;%>1023 07666000
- MOVE(T3,A[T2],A[T]); T:=T+T3; 07666500
- END; 07667000
- GO CHECK; 07667500
- END REPEAT PART; 07668000
- IF (BOO:=ELCLASS=ADOP) THEN STEPIT; 07668500
- IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN 07669000
- IF ELCASS!STRING AND(ELCASS!STRNGCON OR BOO) THEN 07669500
- BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07670000
- IF BOO THEN C:=C&ELBAT[I-1][1:21:1]; 07670500
- IF ELCLASS=STRING THEN 07671000
- BEGIN 07671500
- IF (T2:=T+(COUNT+7)DIV 8-1)>1022 THEN 07672000
- BEGIN ERROR(305); GO GOOFUP END; % > 1023. 07672500
- T3:=" "; MOVE(1,T3,A[T2]); 07673000
- MOVECHARACTERS(COUNT,ACCUM[1],3,A[T],0); 07673500
- T:=T2; 07674000
- END 07674500
- ELSE MOVE(1,C,A[T]); 07675000
- END 07675500
- ELSE IF COUNT<=19 AND ACCUM[1].[18:18]="OCT" THEN 07676000
- BEGIN % GET RID OF "OCT" FOR OCTIZE. 07676500
- MOVECHARACTERS(COUNT-3,ACCUM[1],6,ACCUM[1],3); 07677000
- IF OCTIZE(ACCUM[1],A[T],19-COUNT,COUNT-3) THEN 07677500
- FLAG(303); % NON-OCTAL CHARACTER. 07678000
- END 07678500
- ELSE BEGIN ERROR(302); GO GOOFUP END; % WHATISIT. 07679000
- T:=T+1; 07679500
-CHECK: 07680000
- IF STEPI!COMMA THEN GO EXIT; 07680500
- END T LOOP; 07681000
- ERROR(305); % > 1023 ITEMS IN LIST. 07681500
-GOOFUP: 07682000
- FILLIT:=TRUE; 07682500
-EXIT: 07683000
- PARENCOUNTER:=PARENCOUNTER-REAL(ELCLASS=RTPAREN); 07683500
- END RECURSIVE FILLIT; 07684000
- IF STEPIINTARRAYID THEN 07684500
- BEGIN 07685000
- IF ELCLASS=FILEID OR ELCLASS=SUPERFILEID THEN 07685500
- MAKEALABEL ELSE ERROR(300); % NO ARRAY ID. 07686000
- GO EXIT; 07686500
- END; 07687000
- VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN FLAG(304); % NOT ARR. ROW. 07687500
- XMARK(ASSIGNREF); % FILL STATEMENT %116- 07687600
- IF ELCLASS!WITHV THEN 07688000
- BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500
- STREAMTOG:=TRUE; 07689000
- IF TABLE(I+1)<=IDMAX THEN 07689500
- IF Q="7INQUI" THEN 07690000
- BEGIN 07690500
- STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000
- EMITPAIR(9,COM); EMITO(DEL); 07691500
- GO EXIT; 07692000
- END; 07692500
- EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000
- IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500
- MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000
- BUILDLINE:=BOOLEAN(2xREAL(BUILDLINE)) ; 07694500
- IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000
- ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500
- ELSE BEGIN 07696000
- FOR J:=0 STEP 32 UNTIL T DO 07696500
- MOVE(32,FILLTEMP[J],EDOC[J.[38:3],J.[41:7]]); 07697000
- SEGMENT(T,SGAVL,SGNO); 07697500
- END; 07698000
- MOVECODE(TEDOC,EDOC); STREAMTOG:=FALSE; 07698500
- BUILDLINE:=BUILDLINE.[46:1] ; SGAVL:=SGAVL+1; 07699000
-EXIT: 07699500
- END FILLSTMT; 07700000
- COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000
- CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000
- WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000
- AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000
- PROCEDURE STMT ; 07714000
- BEGIN 07715000
- LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000
- LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000
- LGO, LRELSE, LBEG, LBRK, EXIT; 07718000
- SWITCH S _ 07719000
- LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000
- LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000
-LVAR, 07722000
- LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000
- LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000
- LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000
- EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000
- LRELSE,LBEG; 07727000
- COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010
- CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020
- GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030
- ADDRESSING IS NOT POSSIBLE; 07727040
- IF LASTENTRY !0 THEN 07727050
- BEGIN GT2 _ INFO [0,255]; 07727055
- DO GT1 _ GT2 UNTIL GT2_GET(GT1) = 4095; 07727060
- IF L- GT1 > 400 THEN 07727065
- BEGIN GT1 _ BUMPL; 07727070
- CONSTANTCLEAN; 07727075
- EMITB(BFW, GT1,L); 07727080
- END; 07727085
- END; 07727090
- STACKCT _ 0; %A 07727100
- AGAIN: GO TO S[ELCLASS-SWITCHID]; 07728000
- IF ELCLASS = 0 THEN 07728500
- BEGIN UNKNOWNSTMT; GO TO EXIT END; 07729000
- IF ELCLASS=FAULTID THEN BEGIN FAULTSTMT; GO EXIT END; 07729100
- IF ELCLASS=FILEDID OR ECLASS=SUPERFILEID THEN 07729190
- BEGIN GT1_FILEATTRIBUTEHANDLER(FS); GO EXIT END ; 07729200
- FLAG(145); 07729500
-LERR: ERR(144); GO TO EXIT; 07730000
-LDEC: FLAG(146); 07731000
- IF TABLE(I-2) = ENV AND MODE > 0 07732000
- THEN BEGIN I _ I-2; ELCLASS _ ENDV; GO TO EXIT END; 07733000
- I _ I-1; ERRORTOG _ TRUE; BLOCK(FALSE); 07734000
- ELCLASS _ TABLE(I_I-1); GO TO EXIT; 07735000
- 07735500
- 07735510
- 07735520
-LPROC: PROCSTMT(TRUE); GO TO EXIT; 07736000
-LSPROC: STRMPROCSTMT; GO TO EXIT; 07737000
-LVAR: VARIABLE(FS); GO TO EXIT; 07738000
-LAB: LABELR; GO TO AGAIN; 07739000
-LREAD: READSTMT; GO TO EXIT; 07740000
-LWRITE: WRITESTMT; GO TO EXIT; 07741000
-LSPACE: SPACESTMT; GO TO EXIT; 07742000
-LCLOSE: CLOSESTMT; GO TO EXIT; 07743000
-LLOCK: LOCKSTMT; GO TO EXIT; 07744000
-LRWND: RWNDSTMT; GO TO EXIT; 07745000
-LDBL: DBLSTMT; GO TO EXIT; 07746000
-LFOR: FORSTMT; GO TO EXIT; 07747000
-LWHILE: WHILESTMT; GO TO EXIT; 07748000
-LDO: DOSTMT; GO TO EXIT; 07749000
-LFILL: FILLSTMT; GO TO EXIT; 07750000
-LIF: IFSTMT; GO TO EXIT; 07751000
-LGO: GOSTMT; GO TO EXIT; 07752000
-LRELSE: RELSESTMT; GO TO EXIT; 07753000
-LBEG: IF STEPI = DECLARATORS 07754000
- THEN BEGIN I _ I-1; BLOCK(FALSE) END 07755000
- ELSE COMPOUNDTIAL; 07756000
-EXIT: END STMT; 07757000
-PROCEDURE CMPLXSTMT; FORWARD ; 07777777
- PROCEDURE UNKNOWNSTMT; 07800000
- BEGIN LABEL XXX,E; 07801000
- REAL J,N,C; 07802000
- IF Q = "5BREAK" THEN 07803000
- BEGIN EMIT(0); 07804000
- EMIT(48); 07805000
- EMITO(COM); 07806000
- EMITO(DEL); 07807000
- STEPIT; 07808000
- GO TO XXX; 07809000
- END; 07810000
- IF Q="7COMPL" THEN BEGIN CMPLXSTMT; GO XXX END ; 07810100
- IF Q = "3ZIPOO" THEN 07811000
- BEGIN IF TABLE(I+1) = WITHV THEN 07812000
- BEGIN STEPIT; 07813000
- IF STEPI < BOOARRAYID OR ELCLASS > 07814000
- INTARRAYID THEN 07814100
- IF ELCLASS=FILEID OR 07814200
- ELCLASS=SUPERFILEID THEN 07814300
- PASSFILE ELSE 07814400
- GO E ELSE 07814500
- BEGIN 07814600
- VARIABLE(FL); 07815000
- IF TABLE(I-2) ! FACTOP THEN GO TO E; 07816000
- END; 07816100
- EMIT(16); EMITO(COM); EMITO(DEL); 07817000
- GO TO XXX; 07818000
- END; 07819000
- N _ 1; C _ 8 07820000
- END ELSE 07821000
- IF Q = "5CHAIN" THEN 07821100
- BEGIN N _ 1; C _ 37 END ELSE 07821200
- IF Q = "4WHEN0" THEN 07822000
- BEGIN N _ 0; C _ 6 END ELSE 07823000
- IF Q = "4WAIT0" THEN 07824000
- BEGIN N _ 1; C _ 2 END ELSE 07825000
- IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500
- IF Q = "4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000
- IF Q = "5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000
- IF Q = "6SEARC" THEN 07828000
- BEGIN IF STEPI!LEFTPAREN THEN 07829000
- BEGIN ERR(105); GO TO XXX END; 07830000
- IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000
- PASSFILE ELSE GO TO E; 07832000
- IF ELCLASS!COMMA THEN GO TO E; 07833000
- IF STEPIINTARRAYID THEN 07834000
- GO TO E; 07835000
- XMARK(ASSIGNREF); % SEARCH STATEMENT %116- 07835500
- VARIABLE(FL); 07836000
- IF TABLE(I-2)!FACTOP THEN GO TO E; 07837000
- IF ELCLASS!RTPAREN THEN 07838000
- BEGIN ERR(104); GO TO XXX END; 07839000
- EMITPAIR(30,COM); EMITO(DEL); EMITO(DEL); 07840000
- STEPIT; GO TO XXX; 07841000
- END ELSE 07842000
- IF Q="4SEEK0" THEN 07843000
- BEGIN IF STEPI!LEFTPAREN THEN 07844000
- BEGIN ERR(105); GO TO XXX; END; 07845000
- IF STEPI!FILEID AND ELCLASS!SUPERFILED THEN 07846000
- GO TO E ELSE 07847000
- BEGIN EMITL(0); EMITL(0); PASSFILE; 07848000
- IF ELCLASS!LEFTPAREN THEN 07849000
- BEGIN ERR(105); GO TO XXX; END; 07850000
- STEPIT; AEXP; EMITO(XCH); 07851000
- IF ELCLASS!RTPAREN THEN 07852000
- BEGIN ERR(104); GO TO XXX; END; 07853000
- IF STEPI!RTPAREN THEN 07854000
- BEGIN ERR(104); GO TO XXX; END; 07855000
- EMITPAIR(32,COM); EMITO(DEL); EMITO(DEL); 07856000
- EMITO(DEL); EMITO(DEL); STEPIT; 07857000
- END; GO TO XXX; 07858000
- END ELSE 07859000
- IF Q="6UNLOC" THEN 07859010
- BEGIN IF STEPI!LEFTPAREN THEN 07859020
- BEGIN ERR(105); GO TO XXX END; 07859030
- STEPIT; VARIABLE(FL); L _ L-1; 07859040
- IF TABLE(I-2)!FACTOP THEN FLAG(208); 07859050
- EMITO(DUP); EMITO(LOD); EMITL(0); 07859060
- EMITD(43,3,5); EMITO(XCH); EMITO(STD); 07859070
- IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 07859080
- GO TO XXX 07859090
- END ELSE 07859100
-$ SET OMIT = NOT TSPOL 07859900
- BEGIN ERROR(100); GO TO XXX END; 07900000
- IF STEPI ! LEFTPAREN THEN 07901000
- BEGIN ERR(105); GO TO XXX END; 07902000
- STEPIT; AEXP; 07903000
- FOR J _ 1 STEP 1 UNTIL N DO 07904000
- BEGIN IF ELCLASS ! COMMA THEN 07905000
- E: BEGIN ERR(164); GO TO XXX END; 07906000
- STEPIT; AEXP; 07907000
- END; 07908000
- IF ELCLASS ! RTPAREN THEN 07909000
- BEGIN ERR(104); GO TO XXX END; 07910000
- EMITL(C); EMITO(COM); 07911000
- FOR J _ 0 STEP 1 UNTIL N DO EMITO(DEL); 07912000
- STEPIT; 07913000
- XXX: END; 07914000
- PROCEDURE FAULTSTMT; COMMENT THIS IS WHAT HAPPENS FOR THE"_" 07920000
- KIND OF STATEMENT. FOR THE RUN-TIME ERROR MESS; 07921000
- BEGIN REAL ELBW,STR; DEFINE ADRES=ELBW.ADDRESS#; 07922000
- CHECKER(ELBW_ELBAT[I]); STR_IF FAULTOG THEN SND ELSE STD; 07923000
- FAULTOG _ BOOLEAN(1) OR FAULTOG; COMMENT TELLS DEXP TO MESS 07923100
- WITH FAULTLEVEL; 07923150
- IF STEPI!ASSIGNOP THEN ERR (60) ELSE 07924000
- IF STEPI=LITNO THEN BEGIN EMIT(0); STEPIT END ELSE 07925000
- IF ELCLASS=FAULTID THEN FAULTSTMT ELSE DEXP; 07925100
- EMITPAIR(ADRES,STR); 07926000
- FAULTOG_FALSE&(ELBW.LVLINTARRAYID THEN 07939000
- BEGIN ERR(429); GO TO EXIT; END; 07940000
- VARIABLE(FL); IF TABLE(I-2)!FACTOP THEN 07941000
- BEGIN ERR(427); GO TO EXIT; END; 07942000
- IF ELCLASS!RTPAREN THEN BEGIN ERR(428); GO TO EXIT; END; 07943000
- EMITO(XCH); 07944000
- IF T<0 THEN COMMENT FROM WRITE...(<0 IS FROM READ); 07945000
- BEGIN EMITPAIR(JUNK,STD); EMITO(XCH); EMITV(JUNK); END; 07946000
- IF T>0 THEN IF TABLE(I+1)=LFTBRKET THEN 07947000
- BEGIN GOGOGO _ FALSE;% JUST TO MAKE SURE... 07948000
- HANDLETHETAILENDOFAREADORSPACESTATEMENT;% 07949000
- L _ L-1;% REMOVE THE OPDC ON INPUTINT... 07950000
- EMITO(DEL); EMITO(DEL);% REMOVE LABEL WORDS... 07951000
- END ELSE STEPIT ELSE STEPIT;% WALTZ ON BY... 07952000
- EMITV(GNAT(SUPERMOVER));% BET YOU THOUGHT I"D NEVER DO IT 07953000
- EXIT: END THIS HAIRY KLUDGE;% 07954000
- COMMENT FORSTMT IS RESPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 08000000
- IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 08001000
- THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 08002000
- ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 08003000
- CONSTANT, THEN THE CODE TAKES ON MORE EFFICIENT FORM. 08004000
- IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 08005000
- THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 08006000
- STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 08007000
- PROCEDURE FORSTMT; 08008000
- BEGIN 08009000
- OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET, 08010000
- BRET; 08011000
- OWN BOOLEAN SIGNA,SIGNB,SIGNC, INT, 08012000
- CONSTANA,CONSTANB,CONSTANC; 08013000
- DEFINE SIMPLEB = SIGNC#, FORMALV = SIGNA#, 08014000
- SIMPLEV = CONSTANA#, A = V#, Q = REGO#, 08015000
- OPDC = TRUE#, DESC = FALSE#, K = BRET#; 08016000
- LABEL EXIT; 08017000
- COMMENT FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 08017100
- IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 08017200
- INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 08017300
- RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 08017400
- BOOLEAN PROCEDURE FORCLASS(CLSS); VALUE CLSS; INTEGER CLSS; 08017500
- IF STEPI = CLSS THEN FORCLASS _ TRUE ELSE 08017600
- IF ELCLASS>= NONLITNO AND ELCLASS<= STRNGCON THEN 08017700
- BEGIN INFO[0,K_K+1] _ C; 08017800
- ELBAT[I] _ 0&COMMENTV[2:41:7]&K[16:37:11] 08017900
- END FORCLASS; 08017950
- COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 08018000
- CONSTANT DEPENDING ON THE REQUIREMENTS; 08019000
- PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 08020000
- IF C THEN EMITNUM (A) ELSE BEGIN 08021000
- CHECKER (A); 08021100
- EMITV(A.ADDRESS) END; 08021200
- COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A 08022000
- CONSTANT OR A SIMPLE VARIABLE. IT MAKES A THROUGH REPORT 08023000
- ON ITS ACTIVITY. IT ALSO MAKES PROVISION FOR THE RESCAN 08024000
- OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE 08025000
- TABLE ROUTINE FOR FURTHER DETAILS); 08026000
- BOOLEAN PROCEDURE SIMPLE(B,A,S); BOOLEAN B,S; REAL A; 08027000
- BEGIN 08028000
- S _ IF STEPI ! ADOP THEN FALSE ELSE ELBAT[I].ADDRESS 08029000
- = SUB; 08030000
- IF ELCLASS = ADOP THEN STEPIT; 08031000
- IF ELCLASS>= NONLITNO AND ELCLASS<= STRNGCON 08032000
- THEN BEGIN K _ K+1; SIMPLE _ TRUE; 08033000
- ELBAT[I] _ 0&COMMENTV[2:41:7]&K[16:37:11]; 08034000
- INFO[0,K] _ A _ C; B _ TRUE END 08035000
- ELSE BEGIN 08036000
- B _ FALSE; A _ ELBAT[I]; 08037000
- SIMPLE _ REALID<= ELCLASS AND ELCLASS<=INTID END; 08038000
- COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000
- PROCEDURE TEST; 08041000
- BEGIN 08042000
- IF NOT CONSTANB THEN 08043000
- BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000
- ELSE BEGIN 08045000
- EMITL(2+L-BRET); 08046000
- EMITB(BBW,BUMPL,B); 08047000
- END; 08048000
- EMITO(MUL); EMIT(0) END; 08049000
- EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L_L-1 08050000
- END TEST; 08051000
- BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000
- BEGIN 08053000
- CHECKER(VRET_ALL); 08054000
- ADDRES _ ALL.ADDRESS; 08055000
- FORMALV _ ALL.[9:2] = 2; 08056000
- IF T _ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000
- GT1 _ (T-BOOID) MOD 4 < 1 THEN 08058000
- ERR(REAL(T ! 0) x 51 + 100); 08059000
- INT _ GT1 = 3; 08060000
- SIMPI _ T<= INTID END SIMPI; 08061000
- COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000
- PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000
- BEGIN 08064000
- IF FORMALV THEN BEGIN EMITO(XCH); S _ FALSE END 08065000
- ELSE BEGIN 08066000
- EMITL(ADDRES); 08067000
- IF ADDRES > 1023 THEN EMITO(PRTE) END; 08068000
- T _ (REAL(S)+1)x16; 08069000
- EMITO((IF INT THEN T+512 ELSE 4xT)+4) END STORE; 08070000
- COMMENT CALL EFFECTS A CALL ON THE INDEX; 08071000
- PROCEDURE CALL(S); VALUE S; BOOLEAN S; 08072000
- BEGIN 08073000
- IF SIMPLEV 08074000
- THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES) 08075000
- ELSE BEGIN 08076000
- EMITL(2+L-VRET); 08077000
- EMITB(BBW,BUMPL,V); 08078000
- IF S THEN EMITO(LOD) END END CALL; 08079000
- PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 08080000
- BEGIN 08081000
- PROCEDURE FIX(STORE,BACK,FORWART,START); 08082000
- VALUE STORE,BACK,FORWART,START; 08083000
- REAL STORE,BACK,FORWART,START; 08084000
- BEGIN 08085000
- EMITB(GET(FORWART-1),FORWART,START); 08086000
- IF RETURNSTORE ! 0 08087000
- THEN BEGIN 08088000
- L _ STORE; EMITNUM(B-BACK); 08089000
- EMITPAIR(RETURNSTORE,STD) END END FIX; 08090000
- INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX; 08091000
- LABEL BRNCH,EXIT; 08092000
- STOREFIX _ L; Q _ REAL(MODE=0)+3; 08093000
- FOR K _ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000
- IF NUMLE 08095000
- THEN BEGIN 08096000
- BACKFIX _ L; 08097000
- IF FORMALV THEN CALL(DESC) END 08098000
- ELSE BACKFIX _ V + REAL(SIMPLEV)-1; 08099000
- DIALA + DIALB _ 0; 08100000
- AEXP; DIALA _ DIALB _ 0; 08101000
- COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 08102000
- IF ELCLASS = STEPV 08103000
- THEN BEGIN 08104000
- COMMENT HERE WE HAVE A STEP ELEMENT; 08105000
- BACKFIX _ BUMPL; 08106000
- COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000
- IF FORMALV THEN CALL(DESC); CALL(OPOC); 08108000
- COMMENT FETCH INDEX; 08109000
- IF I > 70 THEN BEGIN NXTELBT _ 1; I _ 0 END 08110000
- ELSE REGO _ I; 08111000
- IF SIMPLEB _ SIMPLE(CONSTANB,B,SIGNB) AND 08112000
- (STEPI = UNTILV OR ELCLASS = WHILEV) 08113000
- THEN BEGIN 08114000
- COMMENT WE HAVE A SIMPLE STEP FUNCTION; 08115000
- PLUG(CONSTANB ,B); 08116000
- END ELSE BEGIN 08117000
- COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 08118000
- SUBROUTINE; 08119000
- I _ IF I < 4 THEN 0 ELSE REGO; STEPIT; 08120000
- SIGNB _ CONSTANB _ FALSE; 08121000
- EMIT(0); B _ L; 08122000
- AEXP; EMITO(XCH); 08123000
- BRET _ L; 08124000
- EMITO(BFW) END; 08125000
- EMITO(REAL(SIGNB)x32+ADD); 08126000
- EMITB(BFW,BACKFIX,L); 08127000
- IF ELCLASS = UNTILV 08128000
- THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000
- STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000
- STEPIT; AEXP; TEST END 08131000
- ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000
- IF ELCLASS ! WHILEV THEN 08133000
- BEGIN ERR(153); GO TO EXIT END; 08134000
- STEPIT; STORE(FALSE); BEXP END END 08135000
- ELSE BEGIN 08136000
- COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000
- STORE(FALSE); 08138000
- IF ELCLASS = WHILEV 08139000
- THEN BEGIN 08140000
- COMMENT WE HAVE A WHILE ELEMENT; 08141000
- STEPIT; BEXP END 08142000
- ELSE BEGIN 08143000
- COMMENT ONE EXPRESSION ELEMENT; 08144000
- IF ELCLASS ! COMMA THEN BEGIN 08145000
- EMITB(BFW,BUMPL,L+2); BACKFIX _ L END 08146000
- ELSE BACKFIX _ L + 2; 08147000
- L _ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000
- COMMENT THIS IS THE COMMON POINT; 08149000
- IF ELCLASS = COMMA THEN EMITLNG; L _ L+1; 08150000
- EMIT(BFC); 08151000
- BRNCH: FORWARDBRANCH _ L; DIALA _ DIALB _ 0; 08152000
- IF ELCLASS = COMMA 08153000
- THEN BEGIN 08154000
- STEPIT; 08155000
- FORLIST(TRUE); 08156000
- FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000
- ELSE BEGIN 08158000
- IF ELCLASS ! DOV 08159000
- THEN BEGIN ERR(154); REGO_L; GO EXIT END; 08160000
- STEPIT; 08161000
- IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000
- IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000
- 08164000
- IF NUMLE THEN BEGIN 08165000
- EMITV(RETURNSTORE + FOOT); EMITO(BBW) END 08166000
- ELSE BEGIN 08167000
- EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE _ 0 END; 08168000
- STMTSTART _ FORWARDBRANCH; B _ L; 08169000
- CONSTANTCLEAN; REGO _ L; 08170000
- FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000
- EXIT: END FORLIST; 08172000
- REAL T1,T2,T3,T4; 08173000
- NXTELBT _ 1; I _ 0; 08174000
- STEPIT; 08175000
- IF SIMPI(VRET_ELBAT[I]) 08176000
- THEN BEGIN 08177000
- IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END; 08178000
- XMARK(ASSIGNREF); % FOR STATEMENT %116- 08178100
- T1 _ L; IF FORMALV THEN EMITN(ADDRES); 08179000
- K _ 0; 08180000
- IF SIMPLE(CONSTANA,A,SIGNA) THEN 08181000
- IF FORCLASS(STEPV) THEN 08182000
- IF SIMPLE(CONSTANB,B,SIGNB) THEN 08183000
- IF FORCLASS(UNTILV) THEN 08184000
- IF SIMPLE(CONSTANC,C,SIGNC) THEN 08185000
- IF FORCLASS(DOV) THEN 08186000
- BEGIN 08187000
- PLUG(CONSTANA,A); 08188000
- IF SIGNA THEN EMITO(CHS); 08189000
- RETURNSTORE _ BUMPL; ADJUST; CONSTANTCLEAN; 08190000
- STMTSTART _ L; 08191000
- STEPIT; 08192000
- T1 _ (((4096 x RETURNSTORE+STMTSTART)x2+ 08193000
- REAL(CONSTANB))x2+ 08194000
- REAL(CONSTANC))x2+ 08195000
- REAL(SIGNB))x2+ 08196000
- REAL(SIGNC); 08197000
- T2 _ VRET; 08198000
- T3 _ B; 08199000
- T4 _ Q; 08200000
- IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000
- SIGNC _ BOOLEAN(T1.[47:1]); 08202000
- SIGNB _ BOOLEAN(T1.[46:1]); 08203000
- CONSTANC _ BOOLEAN(T1.[45:1]); 08204000
- CONSTANB _ BOOLEAN(T1.[44:1]); 08205000
- STMTSTART _ T1.[32:12]; 08206000
- RETURNSTORE _ T1.[20:12]; 08207000
- VRET _ T2; 08208000
- B _ T3; 08209000
- Q _ T4; 08210000
- SIMPLEV_ SIMPI(VRET); 08211000
- IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000
- PLUG(CONSTANB,B); 08213000
- EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000
- EMITB(BFW,RETURNSTORE,L); 08215000
- STORE(TRUE); 08216000
- IF FORMALV THEN CALL(OPDC); 08217000
- PLUG(CONSTANC,Q); 08218000
- IF SIGNC THEN EMITO(CHS); 08219000
- SIMPLEB _ TRUE; TEST; EMITLNG; 08220000
- EMITB(BBC,BUMPL,STMTSTART); 08221000
- GO TO EXIT END; 08222000
- I _ 2; K _ 0; 08223000
- SIMPLEV _ SIMPI(VRET); 08224000
- V _ T1 END 08225000
- ELSE BEGIN 08226000
- EMIT(0); V _ L; SIMPLEV _ FALSE; FORMALV _ TRUE; 08227000
- VARIABLE(FR); EMITO(XCH); VRET _ L; EMITO(BFW); 08228000
- IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END; 08229000
- END; 08230000
- STEPIT; FORLIST(FALSE); L _ REGO; 08231000
- EXIT: K _ 0 END FORSTMT; 08232000
-PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000
- BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000
- SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000
- LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000
- COLON HAS JUST BEEN DETECTED; 08237000
- LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08238000
- 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 THIS 08283000
- CASE; 08284000
- EMITL(0); EMITL(0); 08285000
- END; 08286000
- IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000
- EMITV(13) 08287100
- END ELSE EMITV(GNAT(INTERPTI)); 08287200
- GOGOGO _ FALSE;% 08287300
- EXIT:; 08288000
- END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000
- DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#, 08289010
- EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020
- EMITPAIR(JUNK,ISN); EMITO(965) END#; 08289030
- PROCEDURE READSTMT; 08290000
- BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS 08291000
- SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000
- DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF 08293000
- THE READ OR SPACE STATEMENT. 08294000
- THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ 08295000
- STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000
- REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000
- EXPRESSION IN THE SPACE STATEMENT. 08298000
- I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000
- READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000
- ARE PASSED TO INTERPTI. 08301000
- ********************************************************** 08302000
- ::=REVERSE/ 08303000
- ::=/ 08304000
- ::=[NO]/ 08305000
- ::=[:<[PARITY LABEL>]/ 08306000
- []/[:]/ 08307000
- 08308000
- CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 08309000
- POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 08310000
- CONVERSION. 08311000
- FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 08312000
- ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 08313000
- 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 08314000
- REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 08315000
- VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 08316000
- PROCESSED. 08317000
- END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08318000
- DESCRIPTOR FOR THE END OF FILE JUMPS. 08319000
- PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 08320000
- DESCRIPTOR FOR PARITY CONDITION JUMPS. 08321000
- + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT 08322000
- DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE 08323000
- GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS 08324000
- IN ACTION TYPE. 08325000
- LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 08326000
- DESCRIPTRO WHICH WILL EITHER RETURN 08327000
- AN ADDRESS OR VALUE DEPENDING ON 08328000
- THE CALL. 08329000
- N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 08330000
- READ() 08331000
- 08332000
- - - - - - - - - - - - - - - 08333000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL 08334000
- ,PARITY LABEL) 08335000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08336000
- READ(, 08337000
- ) 08338000
- - - - - - - - - - - - - - - 08339000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08340000
- ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 08341000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08342000
- SPACE(,) 08343000
- - - - - - - - - - - - - - - 08344000
- (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 08345000
- PARITY LABEL) 08346000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08347000
- READ(, 08348000
- ,) 08349000
- - - - - - - - - - - - - - - 08350000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 08351000
- ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 08352000
- LABEL,PARITY LABEL) 08353000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08354000
- READ(, 08355000
- *,) 08356000
- - - - - - - - - - - - - - - 08357000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 08358000
- DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08359000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08360000
- READ(, 08361000
- ,) 08363000
- - - - - - - - - - - - - - - 08364000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 08365000
- END OF FILE LABEL,PARITY LABEL) 08366000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08367000
- READ(, 08368000
- ,) 08369000
- - - - - - - - - - - - - - - 08370000
- (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 08371000
- DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 08372000
- *********************************************************; 08373000
- DEFINE REVERSETOG = RRB1#; COMMENT REVERSETOG IS SET TRUE 08374000
- IF THE STATEMENT BEING COMPILED 08375000
- IS A READ REVERSE, OTHERWISE IT 08376000
- 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 TO 08383000
- BE POINTING AT THE LAST QUANTITY IN THE 08384000
- SECOND PARAMETER; 08385000
- LABEL READXFORM; 08385100
- INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08385500
- BOOLEAN SEEKTOG,LOCKTOG,GRABTOG;% 08385600
- BOOLEAN MAYI; COMMENT TRUE IF "FILE" IS ARRAY ROW; 08385700
- INTEGER HOLD; COMMENT L MAY GET CUT BACK TO HERE; 08385800
- IF STEPI = LEFTPAREN 08386000
- THEN REVERSETOG_SEEKTOG_FALSE; 08387000
- ELSE BEGIN COMMENT THIS HAD BETTER SAY REVERSE; 08388000
- REVERSETOG_ACCUM[1]="7REVER"; 08389000
- LOCKTOG_ELCLASS=LOCKV; 08390000
- SEEKTOG_ACCUM[1]="4SEEK0"; 08390500
- IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN STEPIT 08391000
- ELSE BEGIN ERR(420); 08392000
- GO TO EXIT; 08393000
- END; 08394000
- IF CHECK(LEFTPAREN,421); 08395000
- THEN GO TO EXIT; 08396000
- COMMENT ERROR 421 MEANS MISSING LEFT 08397000
- PARENTHESIS IN READ REVERSE STATEMENT; 08398000
- END; 08399000
- EMITO(MKS); 08400000
- IF STEPI>= BOOARRAYID AND ELCLASS<= INTARRAYID THEN 08401000
- BEGIN VARIABLE(FL); 08401020
- IF TABLE(I-2) ! FACTOP THEN 08401030
- BEGIN ERR(422); GO TO EXIT END; 08401040
- WAYI _ TRUE; HOLD _ L; 08401045
- EMIT(11); EMIT(4); EMITO(280); 08401050
- EMITPAIR(GNAT(POWERSOFTEN),LOD); 08401060
- EMITO(XCH); EMITL(0); EMITL(1); 08401070
- END ELSE 08401080
- BEGIN 08401090
- EMITPAIR(GNAT(POWERSOFTEN),LOD); 08402000
- IF NOT RANGE(FILEID,SUPERFILEID) 08403000
- THEN BEGIN COMMENT ERROR 422 MEANS MISSING FILE IN READ 08404000
- STATEMENT; 08405000
- ERR(422); GO TO EXIT; 08406000
- END; 08407000
- PASSFILE; 08408000
- IF ELCLASS = LFTBRKET 08409000
- THEN BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 08410000
- %%% [*],[*,*],[*,],[],[,*], 08410010
- %%% AND [,]. THE FIRST (LEFTMOST) 08410020
- %%% IS THE READSEEKDISTADDRESS, RESIDING 08410030
- %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 08411000
- %%% IS THE WAIT-TIME, RESIDING IN THE 08411010
- %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 08411020
- %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 08411030
- %%% IN THE ABOVE, NS = NO OR STOP. 08411040
- STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 08412000
- IF RR1_IF ACCUM[1]="2N0000" THEN 1 ELSE 08412010
- IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020
- 0 ! 0 THEN %%% HAVE [NS 08412030
- IF STEPI=COMMA THEN %%% HAVE [NS, 08412040
- IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050
- BEGIN 08412060
- IF RR1=1 THEN EMITNO(1) 08412070
- ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080
- STEPIT ; 08412090
- END 08413000
- ELSE 08413010
- IF ACCUM[1]="4LOCK0" THEN 08413012
- BEGIN %%% [NS,LOCK 08413014
- EMITL(1); EMITD(47,4,1); 08413016
- STEPIT; 08413018
- END ELSE 08413020
- BEGIN %%% HAVE [NS,AEXP 08413022
- IF RR1=2 THEN EMITL(1) ; 08413030
- EMITTIME ; 08413040
- IF RR1=2 THEN 08413050
- BEGIN EMITO(LOR); EMITL(2) END 08413060
- ELSE EMITL(1) ; 08413080
- END 08413090
- ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100
- ELSE BEGIN EMITL(1); EMITL(2) END 08413110
- ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120
- IF STEPI=COMMA THEN %%% HAVE [*, 08413130
- IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000
- BEGIN EMITNO(2); STEPIT END 08414010
- ELSE IF ACCUM[1]="4LOCK0" THEN 08414012
- BEGIN %%% [*,LOCK 08414014
- EMITL(1); EMITD(47,4,1); 08414016
- STEPIT; 08414018
- END ELSE 08414020
- BEGIN EMITTIME; EMITL(2); END % [*,A 08414022
- ELSE EMITNO(2) %%% HAVE ONLY [* 08414030
- ELSE BEGIN %%% HAVE [AEXP 08415000
- AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010
- IF SEEKTOG THEN EMITO(CHS) ; 08415020
- EMITPAIR(JUNK,ISN) ; 08415030
- IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000
- IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010
- ELSE IF ACCUM[1]="4LOCK0" THEN 08416012
- BEGIN %%% [AEXP,LOCK 08416014
- EMITL(1); EMITD(47,4,1); 08416016
- STEPIT; 08416018
- END ELSE 08416020
- BEGIN EMITTIME; EMITO(LOR) END ; 08416022
- EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030
- END ; 08417000
- IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010
- END 08418000
- ELSE IF ELCLASS=LEFTPAREN THEN 08418100
- BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200
- IF STEPI!FACTOP THEN% 08418250
- BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300
- BEGIN EMITL(1); GRABTOG_TRUE; STEPIT END ELSE 08418350
- EMITPAIR(0,LNG); 08418400
- EMITD(33,33,15); 08418500
- EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600
- EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650
- IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700
- EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800
- END 08418900
- ELSE BEGIN EMITL(0); EMITL(2); END; 08419000
- IF REVERSETOG 08420000
- THEN EMITO(CHS); 08421000
- END; 08421500
- IF ELCLASS = RTPAREN 08422000
- THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000
- EMITL(0); EMITL(0); EMITL(0); 08424000
- GOGOGO _ NOT MAYI;% 08424100
- GO CHKACTIONLABELS; 08425000
- END; 08426000
- IF CHECK(COMMA,424) 08427000
- THEN GO TO EXIT; 08428000
- COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000
- STATEMENT; 08430000
- IF STEPI = FACTOP 08431000
- THEN BEGIN COMMENT *,LIST CASE; 08432000
- EMITL(0); EMITL(0); GO PASSLIST; 08433000
- END; 08434000
- IF ELCLASS = MULOP 08435000
- THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000
- IF STEPI=MULOP THEN EMITL(2) ELSE 08437000
- BEGIN EMITL(1); I_I-1; END ; 08437050
- EMITL(0); GO TO PASSLIST ; 08437075
- END; 08438000
- IF RANGE(FRMTID,SUPERFRMTID) 08439000
- THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000
- PASSFORMAT; 08441000
-READXFORM: IF TABLE(I+1) = COMMA 08442000
- THEN GO PASSLIST; 08443000
- STEPIT; 08444000
- IF CHECK(RTPAREN,425) 08445000
- THEN GO TO EXIT; 08446000
- COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000
- DELIMITER IN READ STATEMENT; 08448000
- EMITL(0); GO CHKACTIONLABELS; 08449000
- END; 08450000
- IF Q:=ACCUM[1]="1<0000" THEN 08450010
- BEGIN EXPLICITFORMAT; GO TO READXFORM; END; 08450020
- IF MAYI THEN 08450100
- BEGIN KLUDGE(HOLD); 08450200
- GO TO EXIT; 08450300
- END ARRAY TO ARRAY CASE; 08450400
- EMITL(0); AEXP; 08451000
- IF CHECK(COMMA,426) 08452000
- THEN GO TO EXIT; 08453000
- COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000
- PARAMETER; 08455000
- STEPIT; 08456000
- IF RANGE(BOOARRAYID,INTARRAYID) 08457000
- THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000
- VARIABLE(FL); 08459000
- IF TABLE(I-2) ! FACTOP 08460000
- THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000
- ROW DESIGNATOR IN READ; 08462000
- ERROR(427); GO TO EXIT; 08463000
- END; 08464000
- IF CHECK(RTPAREN,428) 08465000
- THEN GO TO EXIT; 08466000
- COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR 08467000
- DELIMITER IN READ STATEMENT; 08468000
- GOGOGO _ TRUE;% 08468100
- GO CHKACTIONLABELS; 08469000
- END 08470000
- ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR; 08471000
- ERROR(429); GO TO EXIT; 08472000
- END; 08473000
- PASSLIST:STEPIT; 08474000
- IF CHECK(COMMA,430) 08475000
- THEN GO TO EXIT; 08476000
- COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000
- THE LIST IN A READ STATEMENT; 08478000
- IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000
- THEN BEGIN 08480000
- RR1_LISTGEN; 08481000
- I_I-1; 08482000
- GO TO CHKACTIONLABELS 08483000
- END; 08484000
- CHECKER(ELBAT[I]); 08484500
- IF ELCLASS = SUPERLISTID THEN 08485000
- BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000
- LISTADDRESS _ELBAT[I].ADDRESS; 08488000
- BANA; 08489000
- EMITV(LISTADDRESS); 08489500
- IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08489510
- EMITO(LOD); I_I-1 END 08489520
- ELSE BEGIN COMMENT A COMMON LIST; 08489530
- EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550
- END; 08489560
- STEPIT; 08489570
- IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580
- COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590
- 08490000
-CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000
- EXIT:; 08492000
- END READSTMT; 08493000
-REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND 08493010
-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]=1 08493090
- % BOOLEAN ATTRIBUTES HAVE .[2:1]=1, 08493091
- % ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092
- % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093
- 17 08493094
- ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED*** 08493095
- ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE****** 08493096
- ,"4SAVE0" 08493097
- ,"8OTHER" % "OTHERUSE". 08493098
- ,"404MFID0" 08493099
- ,"403FID00" 08493100
- ,"4REEL0" 08493101
- ,"4DATE0" 08493102
- ,"5CYCLE" 08493103
- ,"4TYPE0" 08493104
- ,"5AREAS" 08493105
- ,"8AREAS" % "AREASIZE". 08493106
- ,"2EU000" 08493107
- ,"5SPEED" 08493108
- ,"9TIMEL" % "TIMELIMIT" 08493109
- ,"+08IOSTA" % "IOSTATUS" 08493110
- ,"9SENSI" % "SENSITIVE" 08493111
- % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120
- ; % END OF FILL STATEMENT. 08493130
- I_FILEATTRIBUTES[0] ; 08493140
- END ; 08493150
- FOR I_I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160
- BEGIN FILEATTRIBUTEINDX_I; GO EXIT END ; 08493170
- EXIT: 08493180
- END OF FILEATTRIBUTEINDX ; 08493190
-COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS 08493200
- 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 ATTRIBUTE 08493230
- 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. IF 08493320
- 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 LABEL 08493625
- 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 ASSGNMT 08493705
- DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710
- THEN FLAG(293) ; 08493720
- STEPIT ; 08493730
- IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740
- THEN BEXP ELSE AEXP ; 08493750
- END 08493760
- ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770
- ELSE EMITL(0) ; 08493780
- EMITNUM(IF ATTRIBUTEINDX= 1 THEN "6ACCESS" ELSE 08493790
- IF ATTRIBUTEINDX= 4 THEN "6OTHRUS" ELSE 08493795
- IF ATTRIBUTEINDX=12 THEN "6ARASIZ" ELSE 08493800
- IF ATTRIBUTEINDX=15 THEN "6TIMLMT" ELSE 08493805
- IF ATTRIBUTEINDX=16 THEN "6IOSTAT" ELSE 08493810
- IF ATTRIBUTEINDX=17 THEN "6SNSTIV" ELSE 08493812
- 0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820
- & FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830
- EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840
- & REAL(ASSOP)[38:47:1]) ; 08493850
- EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ; 08493860
- FILEATTRIBUTEHANDLER_ 08493870
- IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880
- THEN BTYPE ELSE ATYPE ; 08493890
- END ; 08493900
- END ; 08493910
- EXIT: 08493920
- END OF FILEATTRIBUTEHANDLER ; 08493930
-PROCEDURE SPACESTMT; 08494000
- BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000
- SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000
- FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000
- PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS 08498000
- 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 WHICH 08533000
- ARE PASSED TO INTERPTO. 08534000
- ********************************************************** 08535000
- FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000
- UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000
- READSTMT ROUTINE. 08538000
- ::= [DBL]/[PAGE]/[NO]// 08540000
- CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR 08541000
- TO CIMI FOR INPUT. 08542000
- [DBL] [PAGE] [NO] 08543000
- CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 08544000
- LINESKIP 1 2 4 8 0 08545000
- WRITE()/ 08546000
- - - - - - - - - - - - - - - 08547000
- (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 08548000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08549000
- WRITE(,)/ 08550000
- - - - - - - - - - - - - - - 08551000
- (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08552000
- INDEX,FORMAT ARRAY DESCRIPTOR,0) 08553000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08554000
- WRITE(,,)/ 08555000
- - - - - - - - - - - - - - - 08556000
- (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 08557000
- INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 08558000
- ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08559000
- WRITE(