From 8e1ff6351fc55fa6de75eea53b2dee4094bbfa09 Mon Sep 17 00:00:00 2001 From: Paul Kimpel Date: Sun, 18 Mar 2012 04:59:28 +0000 Subject: [PATCH] Commit pre-proofing fixes for Algol compiler source: correct text indentation and overflows beyond column 72, replace digraph relational symbols and standardize ASCII replacements for BCL characters (left-arrow=~, times=|, not-equal=!, greater-than-or-equal=}, less-than-or-equal=}); correct miscellaneous typos as encountered. Delete original ALGOL.txt version (should have happened as part of rename in r4, but didn't). --- SYMBOL/ALGOL.alg_m | 12449 +++++++++++++++++++++--------------------- SYMBOL/ALGOL.txt | 12696 ------------------------------------------- 2 files changed, 6225 insertions(+), 18920 deletions(-) delete mode 100644 SYMBOL/ALGOL.txt 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(,*,)/ 08560000 - - - - - - - - - - - - - - - 08561000 - (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 08562000 - ROUTINE DESCRIPTOR) 08563000 - ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08564000 - WRITE((CARRIAGE CONTROL>,,) 08566000 - - - - - - - - - - - - - - - 08567000 - (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 08568000 - ROW DESCRIPTOR) 08569000 - ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08570000 - LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08571000 - EXECUTABLE STATEMENT IN WRITESTMT; 08572000 - LABEL CHKSECOND; COMMENT I IS NOW POINTING AT THE COMMA 08573000 - SEPARATING THE FIRST AND SECOND 08574000 - PARAMETERS; 08575000 - LABEL ONEPARFNSH; COMMENT I IS POINT AT THE RIGHT 08576000 - PARENTHESIS AT THIS POINT AND I HAVE 08577000 - JUST DISCOVERED THAT THIS IS THE ONE 08578000 - PARAMETER CASE; 08579000 - DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000 - TEMPORARY CELL FOR ACCUM[1]; 08581000 -%VOID 08582000 -%VOID 08583000 -%VOID 08584000 -%VOID 08585000 - LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000 - PRECEEDING THE LIST WHEN THIS LABEL IS 08587000 - REACHED; 08588000 - LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000 - DELIMITER. THE CODE AT EMITCALL EMITS THE 08590000 - CODE TO CALL INTERPTO; 08591000 - LABEL CHKRTPAREN; 08591100 - LABEL WRITXFORM; 08591200 - INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 - BOOLEAN LOCKTOG,ARC; 08591600 - INTEGER HOLD;% 08591700 - IF (LOCKTOG_STEPI=LOCKV) THEN STEPIT; 08592000 - IF CHECK(LEFTPAREN,438) 08593000 - THEN GO TO EXIT; 08594000 - COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000 - WRITE STATEMENT; 08596000 - EMITO(MKS); 08597000 - IF STEPI>= BOOARRAYID AND ELCLASS<= INTARRAYID THEN 08597100 - BEGIN VARIABLE(FL); 08597200 - IF TABLE(I-2) ! FACTOP THEN 08597300 - BEGIN ERR(439); GO TO EXIT END; 08597400 - ARC _ TRUE; HOLD _ L; 08597450 - EMIT(11); EMIT(4); EMITO(280); 08597500 - EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600 - EMITO(XCH); 08597700 - END ELSE 08597800 - BEGIN 08597900 - IF NOT RANGE(FILEID,SUPERFILEID) 08598000 - THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000 - IDENTIFIER IN A WRITE STATEMENT; 08600000 - ERR(439); GO TO EXIT; 08601000 - END; 08602000 - 08603000 - EMITPAIR(GNAT( 08604000 - POWERSOFTEN),LOD); PASSFILE; 08605000 - END; 08605500 - IF(RRB1_ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000 - THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000 - EMITL(0); EMITL(1); 08608000 - IF RRB1 08609000 - THEN GO CHKSECOND; 08610000 - ONEPARENSH:STEPIT; EMITL(0); EMITL(0); 08611000 - GOGOGO _ NOT ARC;% 08611100 - EMITL(0); GO EMITCALL; 08612000 - END; 08613000 - IF ELCLASS=LEFTPAREN THEN 08613100 - BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200 - IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300 - EMITPAIR(0,LNG); 08613400 - EMITD(33,33,15); EMIT(0); 08613500 - IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN 08613600 - END; 08613700 - IF CHECK(LFTBRKET,440) 08614000 - THEN GO TO EXIT; 08615000 - COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000 - PARAMETER IN A WRITE STATEMENT; 08617000 - STEPIT; 08618000 - %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 - %%% [DPN,],[*],[*,*],[*,],[],[,*] 08619010 - %%% AND [,], WHERE DPN IN STOP, DBL, PAGE, OR 08619020 - %%% NO. THE FIRST (LEFTMOST) IS THE CHANNELSKIP, 08619030 - %%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND IS 08619040 - %%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP, 08619050 - %%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP, 08619060 - %%% *"S ARE CONSIDERED TO BE EMPTIES. 08619070 - IF ACCUM1_IF ACCUM1_ACCUM[1]="3DBL00" THEN 2 ELSE 08619080 - IF ACCUM1="4PAGE0" THEN 4 ELSE 08619090 - IF ACCUM1="4STOP0" THEN 16 ELSE 08619095 - IF ACCUM1="2NO000" THEN 8 ELSE 0!0 THEN %%% [DPN 08620000 - IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010 - IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020 - BEGIN EMITNO(ACCUM1); STEPIT END 08621000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [NS,UNLOCK 08621002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08621004 - ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP 08621010 - ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020 - ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000 - IF STEPI=COMMA THEN %%% HAVE [*, 08622010 - IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000 - BEGIN EMITNO(1); STEPIT END 08624000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [*,UNLOCK 08624002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08624004 - ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000 - ELSE EMITNO(1) %%% HAVE ONLY [* 08626000 - ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000 - %% HAVE [AEXP 08627100 - IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000 - IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,* 08629000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [AEXP,UNLOCK 08629002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08629004 - ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A 08630000 - EMITL(0) ; %%% 0 IS NO DPN. 08631000 - END ; 08632000 - IF CHECK(RTBRKET,441) 08633000 - THEN GO TO EXIT; 08634000 - COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE 08635000 - CONTROL PART; 08636000 - CHKRTPAREN:IF STEPI = RTPAREN 08637000 - THEN GO TO ONEPARENSH; 08638000 - IF CHECK(COMMA,442) 08639000 - THEN GO TO EXIT; 08640000 - COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000 - DELIMITER IN A WRITE STATEMENT; 08642000 - CHKSECOND:STEPIT; 08643000 - IF RANGE(FRMTID,SUPERFRMTID) 08644000 - THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 - PASSFORMAT; 08646000 -WRITXFORM: IF STEPI = RTPAREN 08647000 - THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000 - CASE OF THE WRITE; 08649000 - STEPIT; EMITL(0); GO EMITCALL; 08650000 - END; 08651000 - GO PASSLIST; 08652000 - END; 08653000 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100 - BEGIN I_I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110 - IF ELCLASS!MULOP THEN ERR(443) 08653120 - ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130 - BEGIN I_I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END 08653140 - ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150 - GO TO PASSLIST ; 08653160 - END 08653170 - ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180 - BEGIN EMITL(1) ; 08653190 - IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200 - BEGIN I_I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END 08653210 - ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220 - GO TO PASSLIST ; 08653230 - END OF SCANNING FOR FREE FIELD FORMAT ; 08653240 - IF ELCLASS = FACTOP 08654000 - THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE; 08655000 - EMITL(0); EMITL(0); STEPIT; 08656000 - GO PASSLIST; 08657000 - END; 08658000 - IF ACCUM[1]="1<0000" THEN 08658010 - BEGIN EXPLICITFORMAT; GO TO WRITXFORM; END; 08658020 - IF ARC THEN 08658100 - BEGIN KLUDGE(-HOLD); 08658200 - GO TO EXIT; 08658300 - END ARRAY TO ARRAY CASE; 08658400 - EMITL(0); AEXP; 08659000 - IF CHECK(COMMA,443) 08660000 - THEN GO TO EXIT; 08661000 - COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000 - PARAMETER IN WRITE STATEMENT; 08663000 - STEPIT; 08664000 - IF RANGE(BOOARRAYID,INTARRAYID) 08665000 - THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 - VARIABLE(FL); 08667000 - IF TABLE(I-2) ! FACTOP 08668000 - THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000 - DESIGNATOR IN A WRITE STATEMENT; 08670000 - ERROR(444); GO TO EXIT; 08671000 - END; 08672000 - IF CHECK(RTPAREN,445) 08673000 - THEN GO TO EXIT; 08674000 - COMMENT ERROR 445 MEANS MISSING RIGHT 08675000 - PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000 - STATEMENT; 08677000 - GOGOGO _ TRUE;% 08677100 - STEPIT; GO EMITCALL; 08678000 - END 08679000 - ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR; 08680000 - ERROR(446); GO TO EXIT; 08681000 - END; 08682000 - PASSLIST:IF CHECK(COMMA,447) 08683000 - THEN GO TO EXIT; 08684000 - COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000 - LIST IN A WRITE STATEMENT; 08686000 - IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000 - THEN BEGIN RR1_LISTGEN; GO TO EMITCALL END; 08688000 - CHECKER(ELBAT[I]); 08688500 - IF ELCLASS = SUPERLISTID THEN 08689000 - BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000 - LISTADDRESS_ELBAT[I].ADDRESS; 08692000 - BANA; 08693000 - EMITV(LISTADDRESS); 08694000 - IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08694500 - EMITO(LOD); 08695000 - I_I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500 - END ELSE 08696000 - BEGIN COMMENT A COMMON LIST ID; 08696500 - EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520 - END; 08696530 - STEPIT; 08696540 - IF CHECK(RTPAREN,448( THEN GO TO EXIT; 08696550 - COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560 - STEPIT; 08697000 - EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000 - BEGIN EMITO(MKS); 08698100 - IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200 - IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300 - BEGIN STEPIT; DEXP END; 08698400 - IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500 - EMITL(15); EMITV(5); STEPIT; 08698600 - END;% 08698700 - IF GOGOGO THEN% 08698750 - BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800 - EMIT(0); EMIT(0); EMITV(12);% 08698850 - END ELSE EMITV(GNAT(INTERPTO));% 08698900 - GOGOGO _ FALSE;% 08698950 - EXIT:; 08699000 - END WRITESTMT; 08700000 -PROCEDURE LOCKSTMT; 08701000 - BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000 - FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000 - ********************************************************** 08705000 - ::=LOCK(,SAVE)/ 08706000 - - - - - - - - - - - - - - - 08707000 - (2,0,FILE,4) 08708000 - ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08709000 - LOCK(,RELEASE) 08710000 - - - - - - - - - - - - - - - 08711000 - (6,0,FILE,4); 08712000 - LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08713000 - EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000 - DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000 - FOR THE CURRENT L REGISTER; 08716000 - DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000 - L REGISTER SETTING FOR THE 08718000 - SAVE OR RELEASE LITERAL THAT 08719000 - GETS PASSED TO KEN MEYERS; 08720000 - STEPIT; 08721000 - IF CHECK(LEFTPAREN,45) 08722000 - THEN GO TO EXIT; 08723000 - COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 08724000 - IN A LOCK STATEMENT; 08725000 - STEPIT; 08726000 - IF NOT RANGE(FILEID,SUPERFILEID) 08727000 - THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000 - IF NOT RANGE(BOOARRAYID,INTARRAYID) THEN 08728100 - BEGIN ERR(451); GO TO EXIT END; 08728200 - VARIABLE(FL); L _ L-1; 08728300 - IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400 - EMITO(DUP); EMITO(LOD); EMITL(24); 08728500 - EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600 - IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000 - GO TO EXIT 08730000 - END; 08731000 - PASFILE; 08732000 - IF ELCLASS=RTPAREN THEN ELBAT[(I_I-2)+1].CLASS_ 08732100 - RELEASEV ELSE 08732200 - IF CHECK(COMMA,452) 08733000 - THEN GO TO EXIT; 08734000 - COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT 08735000 - ; 08736000 - THISL_L; L_LTEMP; 08737000 - IF(RRB1_STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000 - ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000 - THEN EMITL(IF RRB1 08740000 - THEN 6 08741000 - ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000 - ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000 - DISPOSITION PART; 08744000 - ERROR(453); GO TO EXIT; 08745000 - END; 08746000 - L_THISL; 08747000 - STEPIT; 08748000 - IF CHECK(RTPAREN,454) 08749000 - THEN GO TO EXIT; 08750000 - COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000 - LOCK STATEMENT; 08752000 - STEPIT; 08753000 - EXIT:; 08754000 - END LOCKSTMT; 08755000 -PROCEDURE CLOSESTMT; 08756000 - BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000 - FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000 - ********************************************************** 08760000 - ::=CLOSE(,SAVE)/ 08761000 - - - - - - - - - - - - - - - 08762000 - (3,0,FILE,4) 08763000 - ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08764000 - CLOSE(,RELEASE)/ 08765000 - - - - - - - - - - - - - - - 08766000 - (7,0,FILE,4) 08767000 - ** ** ** ** ** ** ** ** ** ** ** ** ** ** 08768000 - CLOSE(,*) 08769000 - - - - - - - - - - - - - - - 08770000 - (1,0,FILE,4) 08771000 - ::= CLOSE(, PURGE) 08771100 - -- -- -- -- -- --- -- -- -- -- -- -- 08771200 - (4,0,FILE,4) 08771300 - ** ** ** ** ** ** *** ** ** ** ** ** ; 08771400 - LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08772000 - EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE; 08773000 - DEFINE THISL = RR1#; COMMENT 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 THREE 08781000 - PARAMETERS TO THE FILE CONTROL ROUTINE 08782000 - MUST NOW BE GENERATED; 08783000 - STEPIT; 08784000 - IF CHECK(LEFTPAREN,455) 08785000 - THEN GO TO EXIT; 08786000 - COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 08787000 - CLOSE STATEMENT; 08788000 - STEPIT; 08789000 - IF NOT RANGE(FILEID,SUPERFILEID) 08790000 - THEN BEGIN COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A 08791000 - CLOSE STATEMENT; 08792000 - ERROR(456); GO TO EXIT; 08793000 - END; 08794000 - PASFILE; 08795000 - IF ELCLASS=RTPAREN THEN ELBAT[(I_I-2)+1].CLASS_ 08795100 - RELEASEV ELSE 08795200 - IF CHECK(COMMA,457) 08796000 - THEN GO TO EXIT; 08797000 - COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000 - STATEMENT; 08799000 - THISL_L; L_LTEMP; 08800000 - IF STEPI = RELEASEV 08801000 - THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000 - EMITL(7); GO EMITREST; 08803000 - END; 08804000 - IF ELCLASS = FACTOP 08805000 - THEN BEGIN COMMENT ASTERISK UNTI DISPOSITION PART CASE; 08806000 - EMITL(1); GO EMITREST; 08807000 - END; 08808000 - IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000 - THEN BEGIN COMMENT SAVE UNIT DISPOSITION PART CASE; 08810000 - EMITL(3); GO EMITREST; 08811000 - END; 08812000 - IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100 - EMITL(4); GO EMITREST; 08812200 - END; 08812300 - ERROR(458); GO TO EXIT; 08813000 - COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000 - IN A CLOSE STATEMENT; 08815000 - EMITREST:STEPIT; 08816000 - L_THISL; 08817000 - IF CHECK(RTPAREN,459) 08818000 - THEN GO TO EXIT; 08819000 - COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000 - CLOSE STATEMENT; 08821000 - STEPIT; 08822000 - EXIT:; 08823000 - END CLOSESTMT; 08824000 - PROCEDURE RWNDSTMT; 08825000 - BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000 - FOLLOWING PARAMETERS. 08828000 - ********************************************************** 08829000 - ::=REWIND() 08830000 - - - - - - - - - - - - - - - 08831000 - (0,0,FILE,4); 08832000 - LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 08833000 - 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 THE 08837000 - L REGISTER SETTING FOR THE 08838000 - SAVE OR RELEASE LITERAL THAT 08839000 - GETS PASSED TO KEN MEYERS; 08840000 - STEPIT; 08841000 - IF CHECK(LEFTPAREN,460) 08842000 - THEN GO TO EXIT; 08843000 - COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 08844000 - REWIND STATEMENT; 08845000 - STEPIT; 08846000 - IF NOT RANGE(FILEID,SUPERFILEID) 08847000 - THEN BEGIN COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A 08848000 - 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 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 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 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 - ; 09251200 - NEXTTEXT_26 ; 09251300 - DO UNTIL STEPI = BEGINV; 09252000 - BUILDLINE.[45:1]_FALSE; 09252050 - 09252100 - COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 09253000 - THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 09254000 - LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 09255000 - AND IS ALSO USED AS A ONE SYLLABLE 09256000 - CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 09257000 - ITS PRIMARY FUNCTION IS TO CUT BACK 09258000 - THE STACK AFTER A COMMUNICATE OPERATOR. 09259000 - MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 09260000 - IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 09261000 - C-RELATIVE ADDRESSING FOR CONSTANTS 09262000 - IN THE PROGRAM STREAM 09263000 - OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 09264000 - THAT GETS THE PROGRAM INTO SUBPROGRAM 09265000 - LEVEL. XXXX IS THE FIRST AVAILABLE PRT 09266000 - CELL.AT THE START OF COMPILATION XXXX IS 09267000 - ASSUMED TO CONTAIN A LABEL DESCRIPTOR 09268000 - IT IS CHANGED BEFORE COMPILATION IS 09269000 - COMPLETE TO LOOK LIKE A WORD MODE 09270000 - PROGRAM DESCRIPTOR; 09271000 - EMITL(0);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 - 09275800 - 09275850 - 09275900 - 09275950 - 09276000 - COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000 - WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000 - USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000 - THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000 - IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000 - PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000 - INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000 - ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000 - FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 09285000 - INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000 - THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000 - PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000 - DRUM ADDRESSES TO THE INTRINSICS; 09289000 - 09290000 - GT1 _ GT3 _ STARTINTRSC; 09291000 - L1: GT1 _ GT1 + (GT2 _ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000 - IF GT2>= 0 THEN % NOT POWERS OF TEN TABLE 09293000 - BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000 - BEGIN SGNO _ SGAVL; SGAVL _ SGAVL + 1; 09295000 - GT2 _ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000 - 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] + 1; 09305000 - GO TO L1; 09305100 - END; 09306000 - L_L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100 - EMITL(5);EMITO(COM); 09307000 - ENIL[0,1] _ 1023 & 99999999[10:20:28]; ENILPTR _ 1; 09307100 - SEGMENT((L+3) DIV 4,1,0); 09308000 -COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000 - AT THIS TIME AS A TYPE 2 SEGMENT; 09310000 - IF GT1_GT2.ADDRESS!0 THEN 09311000 - BEGIN SGAVL_(SGNO_SGAVL)+1; 09312000 - GT2_PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000 - MOVE(69,TEN,EDOC[0,0]); 09314000 - BUILDLINE _ BOOLEAN(2xREAL(BUILDLINE)); 09314100 - SEGMENT(-69, SGNO,0); 09315000 - BUILDLINE _ BUILDLINE.[46:1] ; 09315100 - END; 09316000 -BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000 - INTEGER PRTADR,SEGMNT,LINK; 09318000 -COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000 - 09334000 - 09335000 - 09336000 - 09337000 - 09338000 - 09339000 - 09340000 - 09341000 - 09342000 - 09343000 - 09344000 - 09345000 - 09346000 - 09347000 - FOR I_0 STEP 1 UNTIL PDINX 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 - END ELSE 09356000 - BEGIN SEGMNT_GT1.[28:10]; 09357000 - SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]_ 09358000 - SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]]>1[23:38:10] 09359000 - & GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 09360000 - END; 09361000 - COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; NEWINX_AKKUM; 09361005 - COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 09361010 - GTI1_0; 09361020 - COMMENT ADD IN ARRAYS; 09361030 - GTI1_GTI1+( IF NOOFARRAYS =0 THEN 0 ELSE IF NOOFARRAYS<=4 09361040 - THEN 2000 ELSE IF NOOFARRAYS<= 8 THEN 3500 09361050 - ELSE 5000); 09361060 - COMMENT ADD IN SEGMENT SIZE REQUIREMENTS; 09361070 - GTI1_GTI1+ (IF NEWINX<= 1000 THEN NEWINX ELSE IF NEWINX<=2000 09361080 - THEN 1000 ELSE NEWINX/2); 09361100 - COMMENT ADD IN STACK AND PRT; 09361110 - GTI1_GTI1+ 512 + PRTIMAX; 09361120 - COMMENT ADD IN JRT; 09361130 - GTI1_GTI1 + ( (FILENO +1)x 5); 09361140 - COMMENT ADD IN I/O BUFFER REQUIREMENTS; 09361150 - GTI1_GTI1+IOBUFFSIZE; COMMENT I/O SIZE CAL. IN P.IODEC; 09361160 - COMMENT ADD SEGMENT DICT.SIZE; 09361170 - GTI1_GTI1+ SGAVL-1; 09361180 -COMMENT ADD IN CORE ESTIMATE FOR SORT; 09361181 - GTI1:=GTI1+CORESZ; 09361182 - COMMENT CHECK IF TOTAL IS MORE THAN 8 MODS; 09361190 - IF GTI1>= 32000 THEN GTI1_ 32000; 09361200 - COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 09361210 -COMMENT WRITE OUT FILE PARAMETER BLOCK; 09393000 - GTI1_MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128);% AHA 09394000 - MOVE(GT1,IDARRAY[0],EDOC[0,0]); 09395000 - ZEROUT(IDARRAY[0],0,30); 09395500 - IDARRAY[4]:=MOVEANDBLOCK(EDOC,GT1,0); %106- 09396000 - IDARRAY[5]_GT1; 09397000 -COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000 - IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); %106- 09399000 - IF BUILDLINE THEN IDARRAY[0]_IDARRAY[0]&MOVEANDBLOCK 09399100 - (LDICT,SGAVL,2)[18:33:15]; %106- 09399150 - IDARRAY[1]_SGAVL; 09400000 -COMMENT WRITE OUT PRT; 09401000 - IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); %106- 09402000 - IDARRAY[3]_PRTIMAX; 09403000 -COMMENT MARK FIRST EXECUTABLE SEGMENT; 09404000 - IDARRAY[6]_1; 09405000 -COMMENT PASS NUMBER OF FILES; 09405100 - IDARRAY[7] _ (FILENO-1)>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 - LOCK(CODE,SAVE); 09407100 - CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. %119- 09407200 - CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. %119- 09407300 - LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. %119- 09407400 - IF LISTER OR NOT NOHEADING THEN 09408000 - BEGIN FORMAT PAN("NUMBER OF ERRORS DETECTED = ",I4,". COMPILAT" 09409000 - ,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000 - "PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000 - " WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000 - I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 09413000 - /"ESTIMATED AUXILLARY MEMORY REQUIRED =",I6," WORDS.", 09414000 - /"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 09414100 -FOMRAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 09414101 - MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4); 09415000 - MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4); 09416000 -IF CHECKTOG THEN 09416001 - WRITE(LINE[DBL] ,SERR,IF NUMSEQUENCEERRORS = 0 09416002 - THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004 - THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006 - WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2, 09417000 - PRTIMAX,AKKUM,IF DA<=CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000 - DIV CHUNK)xCHUNK,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 - 10070000 - MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000 - IF DEBUGTOG 10072000 - THEN BEGIN 10073000 - DEBUGWORD(B2D(F),W,LIN); 10074000 - WRITELINE END; 10075000 - IF (F_F+1) > 1024 THEN FLAG(307); 10076000 - 10077000 - 10078000 - 10079000 - 10080000 - 10081000 - END WHIPOUT; 10082000 -BOOLEAN PROCEDURE FORMATPHRASE; 10083000 - BEGIN 10084000 - LABEL EL,EX,EXIT,L1,L2,L3; 10085000 -PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000 - VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000 - REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000 - BOOLEAN S; 10089000 - BEGIN IF W > 63 THEN FLAG(163); 10090000 - W _ REPEAT & W [ 6:42:6] 10091000 - & SKIP [32:42:6] 10092000 - & W1 [28:44:4] 10093000 - & W2 [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-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)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 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)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 - COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 10267000 - PUTOGETHER(2130706432); 10268000 - PUTOGETHER(ACCUM[1]); 10269000 - PUTOGETHER(2130706432) END 10270000 - ELSE BEGIN 10271000 - IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) 10272000 - THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000 - PUTOGETHER(ACCUM[1]) END; 10274000 - IF TB1 THEN GO TO EXIT; 10275000 - LASTRESULT _ RESULT; 10276000 - IF MACRO THEN GO BACK; 10276500 - IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV 10277000 - THEN BEGIN DEFINECTR _ DEFINECTR+1; GO BACK END; 10278000 - IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000 - IF DEFINECTR ! 1 10280000 - THEN BEGIN STOPDEFINE _ TRUE; 10281000 - IF ELCLASS_TABLE(I)!COMMA THEN 10282000 - DEFINECTR_DEFINECTR-1; GO SKSC END; 10283000 - EXIT: DEFINECTR := 0; STREAMTOG_TSSTREAMTOG; % 1289 10284000 - NEXTTEXT _ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 - END DEFINEGEN; 10286000 - COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST 10287000 - ELEMENTS; 10288000 - PROCEDURE LISTELEMENT; 10289000 - BEGIN 10290000 - REAL T1,T2,T3; 10291000 - LABEL BOOFINISH,STORE,LRTS; 10292000 - DIALA _ DIALB _ 0; 10293000 - IF ELCLASS= FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000 - ELSE IF ELCLASS = LFTBRKET 10295000 - THEN BEGIN COMMENT GORUP OF LIST ELEMENTS; 10296000 - DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA; 10297000 - IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 - ELSE BEGIN COMMENT THE MEAT OF THE MATTER; 10299000 - VARIABLES AND EXPRESSIONS; 10300000 - L _ (T1_L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000 - EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000 - NEXT TIME AROUND; 10303000 - IF(GT1 _ TABLE(I+1) = COMMA 10304000 - OR GT1 = RTPAREN 10305000 - OR GT1 = RTBRKET) 10306000 - AND ELCLASS>= BOOID AND ELCLASS<= INTID 10307000 - THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 - CHECKER(ELBAT[I]); 10308100 - EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 - ELSE BEGIN IF ELCLASS>= BOOARRAYID 10310000 - AND ELCLASS<= INTARRAYID 10311000 - THEN BEGIN COMMENT IS EITHER A SUBSCRIPTED VARIABLE 10312000 - OR THE BEGINNING OF AN EXPRESSION. THIS 10313000 - SITUATION IS VERY SIMILAR TO THAT IN 10314000 - ACTUALPARAPART (SEE COMMENTS THERE FOR 10315000 - FURTHER DETAILS); 10316000 - T2 _ FL; T3 _ ELCLASS; VARIABLE(T2); 10317000 - IF TABLE(I-2)=FACTOP AND TABLE(I-1)=RTBRKET THEN ERR(157); 10318000 - IF ELCLASS = COMMA OR 10319000 - ELCLASS = RTPAREN OR 10320000 - ELCLASS = RTBRKET THEN 10321000 - IF T2 = 0 THEN GO TO STORE ELSE GO TO LRTS; 10322000 - IF T3 = BOOARRAYID THEN GO TO BOOFINISH; 10323000 - SIMPARITH; 10324000 - IF ELCLASS = RELOP THEN BEGIN RELATION; 10325000 - BOOFINISH: SIMPBOO END END 10326000 - ELSE IF EXPRSS = DTYPE THEN ERR(156); 10327000 - STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000 - LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000 - T2 _ L; L _ T1; EMITNUM(T2-LSTR); L_T2 END END LSTELMT; 10330000 - COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000 - LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000 - LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000 - CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000 - LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000 - FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000 - THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000 - FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000 - DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR, 10339000 - LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000 - LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000 - VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000 - ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000 - REAL PROCEDURE LISTGEN; 10344000 - BEGIN 10345000 - INTEGER JUMPLACE,LISTPLACE; 10346000 - JUMPLACE _ BAE; 10347000 - LISTGEN _ LISTPLACE _ PROGDESCBLDR(0,L,0); 10348000 - COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 - EMITV(LSTRTN); EMITO(BFW); LSTR _ L; 10350000 - COMMENT INITIAL JUMP OF A LIST; 10351000 - LISTMODE _ TRUE; 10352000 - COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000 - I_I-1; 10354000 - DO BEGIN 10355000 - STEPIT; 10356000 - LISTELEMENT 10357000 - END UNTIL ELCLASS ! COMMA; 10358000 - EMITL(1); EMITO(CHS); 10359000 - EMITPAIR(LSTRTN,SND); 10360000 - EMITO(RTS); 10361000 - COMMENT SET END FLAG OF -1; 10362000 - CONSTANTCLEAN; 10363000 - DIALA _ DIALB _ 0; 10364000 - LISTMODE _ FALSE; 10365000 - ADJUST; 10365100 - EMITB(BFW,JUMPLACE,L); 10366000 - STUFFF(LISTPLACE); 10367000 - IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT 10368000 - END LISTGEN; 10369000 - BOOLEAN PROCEDURE MERRIMAC; 10370000 - BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000 - 03 JULY 1963 10372000 - THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000 - LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, 10374000 - ARRAYS, AND FUNCTION DESIGNATORS. 10375000 - WITH ONE EXCEPTION, THE MERRIMAX ROUTINES ONLY FUNCTION 10376000 - IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE 10377000 - VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000 - THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000 - THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000 - A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN 10381000 - ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000 - ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000 - THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000 - INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000 - FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000 - EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000 - AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000 - POSSIBLE CALLS ON PRINTI. 10389000 - ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000 - THE IDENTIFIER TO BE PRINTED. 10391000 - N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000 - ARRAY OR SUBSCRIPTED VARIABLE. 10393000 - V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000 - S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000 - PRINTED. 10396000 - S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000 - MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000 - ONLY IF THEY ARE EQUAL. 10399000 - FORMAT TYPE MONITOR DUMP 10400000 - ----------- ------- ---- 10401000 - 0 LABELS 10402000 - SWITCHES 10403000 - --------- ----- -- 10404000 - 1 SIMPLE VARIABLES LABELS 10405000 - FUNCTION SIMPLE VARIABLES 10406000 - --------- ----- -- 10407000 - 2 ARRAYS SUBSCRIPTED VARS 10408000 - --------- ----- -- 10409000 - 3 SUBSCRIPTED VARS 10410000 - --------- ----- -- 10411000 - 4 ARRAYS 10412000 - ********* ***** ** 10413000 - FORMAT TYPE PRINTOUT 10414000 - ----------- -------- 10415000 - 0 ID 10416000 - --------- ----- 10417000 - 1 ID=V 10418000 - --------- ----- 10419000 - 2 ID[S1---SN]=V 10420000 - --------- ----- 10421000 - 3 ID[S1---SN]=V 10422000 - --------- ----- 10423000 - 4 ID=V1---VN 10424000 - *********** ******** 10425000 - THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY 10426000 - THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000 - PASSING THE TYPEV TO PRINTI. 10428000 - TYPE TYPEV 10429000 - ---- ----- 10430000 - BOOLEAN 0 10431000 - -- --- 10432000 - REAL 1 10433000 - -- --- 10434000 - ALPHA 2 10435000 - -- --- 10436000 - INTEGER 3 10437000 - **** ***** 10438000 - POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000 - AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000 - FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000 - ----------- --------------------------- 10442000 - 0 10443000 - --------- ------------------------- 10444000 - 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000 - --------- ------------------------- 10446000 - 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI, 10447000 - FILE,2) 10448000 - --------- ------------------------- 10449000 - 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN 10450000 - ,ID,CHARI,FILE,3) 10451000 - --------- ------------------------- 10452000 - 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000 - POWERSOFTEN,ID,CHARI,FILE,4) 10454000 - *********** *************************** 10455000 - SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000 - MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000 - THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000 - THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000 - ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000 - ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000 - MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000 - MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000 - WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000 - MONITORING INFORMATION. 10465000 - *********FORMAT OF INFO FOR MONITORED ITEMS********** 10466000 - ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000 - WORD WILL BE SET. 10468000 - SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000 - ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000 - THE MONITOR FILE IN [37:11], I WILL HAVE A 10471000 - DEFINE SVARMONFILE = [37:11]#. 10472000 - ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000 - NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000 - MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000 - FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000 - DEFINE ARRAYMONFILE = [27:11]#. 10477000 - SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000 - SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000 - TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD 10480000 - OF INFO CONTAINING LOWER BOUND INFORMATION 10481000 - ALSO CONTAINS MONITOR INFORMATION. EITHER 10482000 - A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000 - IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000 - DESIGNATES WHETHER AN OPDC OR A LITC 10485000 - SHOULD BE GENERATED USING [12:11]. IF THE 10486000 - BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000 - ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000 - MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000 - ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000 - PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000 - SI* TO THE PRINTI ROUTINE. 10492000 - LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000 - THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000 - ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A 10495000 - DEFINE LABLMONFILE = [13:11]#. 10496000 - SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS. 10497000 - I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000 - FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000 - WITH THE SAME NUMBER OF WORDS AS THE 10500000 - ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000 - REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000 - ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000 - FUNCMONFILE = [27:11]#; 10504000 - DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000 - ADDRESS OF THE MONITOR FILE; 10506000 - DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000 - SAVE THE ADDRESS OR VALUE OF A 10508000 - SUBSCRIPT. ONE ADDITIONAL BIT IS 10509000 - USED TO TELL WHETHER TO EMIT AN 10510000 - OPDC OR A LITC ON THIS ADDRESS OR 10511000 - VALUE; 10512000 - DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF 10513000 - DIMENSIONS OF AN ARRAY OR SUBSCRIPTED 10514000 - VARIABLE APPEARING IN A MONITOR LIST; 10515000 - DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000 - ADDITIONAL INFO AND IS USED WHEN MAKING 10517000 - A NEW ENTRY IN INFO FOR ARRAYS; 10518000 - DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000 - ELBAT WORD FOR A MONITOR LIST 10520000 - ELEMENT; 10521000 - DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING 10522000 - SUBSCRIPTED VARIABLES TO TELL ME 10523000 - WHETHER TO EMIT AN OPDC OR A LITC. 10524000 - 0 IS USED FOR OPDC, 1 FOR LITC; 10525000 - DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000 - POINTING AT THE END OF ADDITIONAL 10527000 - INFO AND IS USED TO TELL WHEN TO 10528000 - STOP MOVING INFO FOR THE NEW ENTRY 10529000 - FOR MONITORED ARRAYS; 10530000 - DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A 10531000 - LINK POINTING AT THE FIRST 10532000 - ADDITIONAL WORD OF INFO FOR 10533000 - MONITORED ARRAYS; 10534000 - DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000 - CONCATENATE DEFINE FOR 10536000 - STUFFING THE MONITOR FILE 10537000 - ADDRESS INTO THE FIRST 10538000 - ADDITIONAL INFO WORD FOR 10539000 - ARRAYS AND FUNCTIONS; 10540000 - DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000 - PARTIAL WORD DESIGNATOR [40 10542000 - :8] USED TO EXTRACT THE 10543000 - NUMBER OF PARAMETERS FOR A 10544000 - GIVEN PROCEDURE FROM INFO; 10545000 - DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000 - OF PARAMETERS FOR A FUNCTION 10547000 - DESIGNATOR APPEARING IN A MONITOR 10548000 - LIST; 10549000 - LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000 - POINTING AT THE FILE IDENTIFIER IN THE 10551000 - MONITOR DECLARATION; 10552000 - LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000 - TURNS ON THE MONITOR BIT OF THE ELBAT 10554000 - WORD IN THE MONITOR LIST AND STORES 10555000 - IT IN ACCUM[0] FOR THE E ROUTINE; 10556000 - LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000 - REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000 - EACH SUBSCRIPT EXPRESSION; 10559000 - LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000 - POINTING THE LAST LOGICAL QUANTITY OF THE 10561000 - MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000 - PROCESSED; 10563000 - LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000 - START:IF ELCLASS!FILEID THEN 10565000 - BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100 - "6EXPOV" OR Q="4ZERO0"THEN MERRIMAC_TRUE ELSE 10565200 - ERR(400); GO EXIT; 10565300 - END 10566000 - COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000 - CHECKER(ELBAT[I]); 10568000 - FILEIDENT_ELBAT[I].ADDRESS; I_I+1; 10569000 - IF CHECK(LEFTPAREN,401) 10570000 - THEN GO TO EXIT; 10571000 - COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000 -MARKMONITORED:STEPIT; ACCUM[0]_-ABS(ELBAT[I]); 10573000 - IF RANGE(BOOID,INTID) 10574000 - THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000 - E; PUTNBUMP(FILEIDENT); 10576000 - GO CHKCOMMA; 10577000 - END; 10578000 - IF RANGE(BOOARRAYID,INTARRAYID) 10579000 - THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000 - SUBSCRIPTED VARIABLES; 10581000 - E; NXTINFOTEMP_NEXTINFO; 10582000 - PUTNBUMP(NODIM_TAKEFRST&FILEIDENT[INSERTFILE]); 10583000 - TESTVARB_(NODIM_NODIM. NODIMPART )+(INC_( 10584000 - ELBATWORD_ELBAT[I]).LINK+ELBATWORD.INCR); 10585000 - DO PUTNBUMP(TAKE(INC_INC+1)) 10586000 - UNTIL INC>= TESTVARB; 10587000 - IF TABLE(I+1) ! LFTBRKET 10588000 - THEN GO CHKCOMMA; 10589000 - TESTVARB_NODIM+NXTINFOTEMP; 10590000 - STEPIT; 10591000 - STORESUBS:IF(RR3_TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000 - STEPI ! NONLITNO 10593000 - THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000 - SUBSCRIPTED VARIABLES. EITHER A LITC 10595000 - OR AN OPDC ON A VARIABLE IS ALL THAT 10596000 - IS NEEDED TO CALL THE SUBSCRIPT; 10597000 - SUBSCRIPT_ELBAT[I].ADDRESS; 10598000 - OPLIT_0; 10598500 - IF NOT RANGE( INTRNSICPROCID,INTID) 10599000 - THEN IF CHECK(LITNO,402) 10600000 - THEN GO TO EXIT 10601000 - ELSE COMMENT MARK FOR LITC; 10602000 - OPLIT_1; 10603000 - COMMENT ERROR 402 IS BAD 10604000 - SUBSCRIPT IN MONITOR DECLARATION; 10605000 - STEPIT; 10606000 - END 10607000 - ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000 - SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000 - SUBSCRIPT EXPRESSION MUST BE GENERATED 10610000 - AND JUMPED AROUND, AN ACCIDENTAL ENTRY 10611000 - PROGRAM DESCRIPTOR CREATED AND THE 10612000 - ADDRESS SAVED IN SUBSCRIPT, SUBSCRIPT 10613000 - MUST BE MARKED FOR AN OPDC; 10614000 - JUMPCHKNX; SUBSCRIPT_PROGDESCBLDR( 10615000 - ADES,L,0); AEXP; EMITO(RTS); 10616000 - JUMPCHKX; 10616500 - OPLIT_0; 10617000 - IF MODE > 0 10618000 - THEN BEGIN COMMENT STUFF F AT THIS 10619000 - POINT IF MODE > 0; 10620000 - STUFFF(SUBSCRIPT);EMITPAIR( 10621000 - SUBSCRIPT,STD); 10622000 - END; 10623000 - END; 10624000 - PUT(TAKE(NXTINFOTEMP_NXTINFOTEMP+1) & 10625000 - SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000 - NXTINFOTEMP); 10627000 - IF ELCLASS = COMMA 10628000 - THEN GO TO STORESUBS; 10629000 - IF CHECK(RTBRKET,403) 10630000 - THEN GO TO EXIT; 10631000 - COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000 - EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000 - IF NXTINFOTEMP ! TESTVARB 10634000 - THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000 - ELEMENT HAS IMPROPER NUMBER OF 10636000 - SUBSCRIPTS; 10637000 - I_I-1; ERROR(404); GO TO EXIT; 10638000 - END; 10639000 - GO CHKCOMMA; 10640000 - END; 10641000 - IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000 - THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000 - IF(ELBATWORD_ELBAT[I]).LVL ! LEVEL 10644000 - THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000 - SWITCH MONITORED AT IMPROPER LEVEL; 10646000 - ERROR(405); GO TO EXIT; 10647000 - END; 10648000 - PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I]) 10649000 - ); 10650000 - PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000 - ELBATWORD); GO CHKCOMMA; 10652000 - END; 10653000 - IF RANGE(BOOPROCID,INTPROCID) 10654000 - THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000 - E ;% 10656000 -IF LEVEL=(RR2_ELBAT[I]).LVL THEN 10656010 - BEGIN 10656011 - %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012 - %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013 - PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014 - PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015 - END ; 10656016 - PUTNBUMP(NOPAR _ TAKEFRST & 10656030 - FILEIDENT[INSERTFILE]); TESTVARB_(NOPAR 10657000 - _NOPAR. NOPARPART )+(INC_(ELBATWORD_ELBAT[I]). 10658000 - LINK+ELBATWORD.INCR); 10659000 - DO PUTNBUMP(TAKE(INC_INC+1)) 10660000 - UNTIL INC>= TESTVARB; 10661000 - GO CHKCOMMA; 10662000 - END; 10663000 - ERROR(406); GO TO EXIT; 10664000 - COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000 - CHKCOMMA:IF STEPI = COMMA 10666000 - THEN GO MARKMONITORED; 10667000 - IF CHECK(RTPAREN,407) 10668000 - THEN GO TO EXIT; 10669000 - COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN 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 -PROCEDURE DMUP; 10681000 - BEGIN COMMENT 15 JULY 1963 10682000 - THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000 - ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000 - ARRAYS. 10685000 - THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000 - THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000 - OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE 10688000 - THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000 - A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000 - HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000 - BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS 10692000 - COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000 - WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000 - THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000 - FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000 - THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000 - INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000 - ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000 - OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED 10700000 - . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000 - DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000 - IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000 - FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000 - SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000 - LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000 - POINTING AT THE FILE IDENTIFIER IN THE DUMP 10707000 - DECLARATION; 10708000 - LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000 - ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000 - IS REACHED; 10711000 - DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000 - ADDRESS OF THE MONITOR FILE; 10713000 - LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000 - CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000 - STARTCALL IS REACHED, I MUST BE POINTING 10716000 - AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000 - DUMP LIST ELEMENT TO BE PASSED TO PRINTI; 10718000 - DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF 10719000 - DIMENSIONS OF AN ARRAY OR A 10720000 - SUBSCRIPTED VARIABLE APPEARING IN A 10721000 - DUMP LIST; 10722000 - DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000 - COUNTER SETTING AT WHICH CODE IS 10724000 - GENERATED TO EXIT THE ROUTINE EMITTED 10725000 - BY DMUP; 10726000 - DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000 - LOCATION OF THE COUNTER 10728000 - ASSOCIATED WITH THIS LABEL IF 10729000 - SPACE HAS BEEN ASSIGNED FOR IT; 10730000 - DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000 - NODIM. IT IS THEN COUNTED DOWN TO 10732000 - ZERO AS SUBSCRIPT CODE IS GENERATED; 10733000 - LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000 - NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000 - LABEL SUBSLOOP; COMMENT THE CODE AT SUBLOOP PASSES 10736000 - SUBSCRIPTS TO PRINTI; 10737000 - ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000 - HOLDS THE ADDRESSES OF ALL LABEL 10739000 - COUNTERS FOR LABELS APPEARING IN 10740000 - THIS DUMP DECLARATION. IT IS 10741000 - NECESSARY TO RETAIN THIS 10742000 - INFORMATION SO THAT CODE MAY BE 10743000 - GENERATED AT THE END OF THE 10744000 - DECLARATION TO INITIALIZE THE 10745000 - COUNTERS; 10746000 - DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000 - VARIABLE USED TO INDEX INTO THE 10748000 - LABELCTR ARRAY; 10749000 - DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000 - CONCATENATE DEFINE FOR INSERTING 10751000 - THE COUNTER ASSOCIATED WITH THIS 10752000 - LABEL INTO THE FIRST ADDITIONAL 10753000 - WORD OF INFO; 10754000 - DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000 - BOUND FOR MONITORED SUBSCRIPTED 10756000 - VARIABLES; 10757000 - DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000 - FORMAT TYPE REFERRED TO IN THE 10759000 - COMMENTS FOR THE MERRIMAC 10760000 - ROUTINE DESCRIBING PRINTI; 10761000 - DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000 - USED TO HOLD L WHILE THE DUMP 10763000 - INDICATOR TEST CODE IS BEING 10764000 - GENERATED; 10765000 - DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000 - LOCATION OF THE CODE THAT MUST BE 10767000 - GENERATED TO MAKE THE TEST TO 10768000 - DETERMINE WHETHER OR NOT DUMPING 10769000 - SHOULD OCCUR; 10770000 - DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000 - CONCATENATE DEFINE USED TO 10772000 - INSERT THE ADDRESS OF THE 10773000 - PROGRAM DESCRIPTOR FOR THE CODE 10774000 - GENERATED FROM THE DUMP 10775000 - DECLARATION; 10776000 - DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000 - ADDRESS OF THE PROGRAM DESCRIPTOR 10778000 - THAT DESCRIBES THE CODE GENERATED 10779000 - BY DMUP; 10780000 - DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000 - ELBAT WORD FOR THE DUMP LIST 10782000 - ELEMENT CURRENTLY BEING OPERATED 10783000 - ON; 10784000 - LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000 - ON PRINTI. IT GENERATES THE CODE TO 10786000 - PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000 - FILE, AND FORMAT TYPE; 10788000 - DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000 - DIMENSION NUMBER THAT IS CURRENTLY 10790000 - BEING WORKED ON; 10791000 - START:IF CHECK(FILEID,409) 10792000 - THEN GO TO EXIT; 10793000 - COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000 - CHECKER(ELBAT[I]); 10795000 - FILEIDENT_ELBAT[I].ADDRESS; STEPIT; 10796000 - IF CHECK(LEFTPAREN,410) 10797000 - THEN GO TO EXIT; 10798000 - COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000 - JUMPCHKNX; ADJUST; DUMPLOC_PROGDESCBLDR 10800000 - (ADES,L,0); TESTLOC_L; L_L+3; 10801000 - LABELCTRINX_1; EMITO(NOP); BUMPL; 10802000 - STARTCALL:EMITO(MKS); STEPIT; ELBATWORD_-ABS(ELBAT 10803000 - [I]); 10804000 - IF RANGE(BOOARRAYID,INTARRAYID) 10805000 - THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000 - SUBSCRIPTED VARIABLES; 10807000 - NODIM_DIMCTR_TAKEFRST.NODIMPART; 10808000 - IF STEPI = LFTBRKET 10809000 - THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED 10810000 - VARIABLES; 10811000 - STEPIT; AEXP; EMITO(DUP); 10812000 - SUBSCTR_1; 10813000 - IF(LWRBND_TAKE(GIT(ELBATWORD)+SUBSCTR) 10814000 - ).[35:13] ! 0 10815000 - THEN BEGIN COMMENT SUBTRACT OFF THE 10816000 - LOWER BOUND BEFORE INDEXING; 10817000 - IF LWRBND.[46:2] = 0 10818000 - THEN EMIT(LWRBND) 10819000 - ELSE EMITV(LWRBND.[35:11]); 10820000 - EMIT(LWRBND.[23:12]); 10821000 - END; 10822000 - IF DIMCTR-SUBSCTR = 0 10823000 - THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000 - VALUE,N; 10825000 - EMITV(ELBATWORD.ADDRESS); 10826000 - PASSN:EMITL(NODIM); 10827000 - IF CHECK(RTBRKET,411) 10828000 - THEN GO TO EXIT; 10829000 - COMMENT ERROR 411 MEANS 10830000 - DUMP LIST ELEMENT HAS WRONG 10831000 - NUMBER OF SUBSCRIPTS; 10832000 - FORMATTYPE_2; GO CALLPRINTI 10833000 - END; 10834000 - EMITN(ELBATWORD.ADDRESS); 10835000 - SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000 - EMITL(JUNK); EMITO(SND); 10837000 - SUBSCTR_SUBSCTR+1; 10838000 - IF(LWRBND_TAKE(GIT(ELBATWORD)+SUBSCTR) 10839000 - ).[35:13] ! 0 10840000 - THEN BEGIN COMMENT SUBTRACT OFF THE 10841000 - LOWER BOUND BEFORE INDEXING; 10842000 - IF LWRBND.[46:2] = 0 10843000 - THEN EMIT(LWRBND) 10844000 - ELSE EMITV(LWRBND.[35:11]); 10845000 - EMIT(LWRBND.[23:12]); 10846000 - END; 10847000 - IF DIMCTR-SUBSCTR = 0 10848000 - THEN BEGIN COMMENT EMIT COC; 10849000 - EMITO(COC); EMITV(JUNK 10850000 - ); EMITO(XCH); 10851000 - GO PASSN; 10852000 - END; 10853000 - EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000 - IF CHECK(COMMA,412) 10855000 - THEN GO TO EXIT 10856000 - ELSE GO TO SUBSLOOP; 10857000 - COMMENT ERROR 412 MEANS DUMP LIST 10858000 - ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS 10859000 - ; 10860000 - END; 10861000 - COMMENT THIS CODE HANDLES ARRAYS; 10862000 - IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000 - THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000 - ARRAY DUMP LIST ELEMENT; 10865000 - ERR(413); GO TO EXIT; 10866000 - END; 10867000 - EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000 - FORMATTYPE_4; I_I-1; GO CALLPRINTI; 10869000 - END; 10870000 - FORMATTYPE_1; 10871000 - IF RANGE(BOOID,INTID) 10872000 - THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000 - EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000 - END; 10875000 - IF CHECK(LABELID,414) 10876000 - THEN GO TO EXIT; 10877000 - COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000 - CODE HANDLES LABELS; 10879000 - PUT(TAKEFRST & (LABELCTR[LABELCTRINX_LABELCTRINX+1]- 10880000 - IF DUMPETEMP_TAKEFRST.DUMPEE = 0 10881000 - THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000 - ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000 - EMITV(LABELCTR[ 10884000 - LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34] 10885000 - ,ELBATWORD); 10886000 - EMITL(3); IF FALSE THEN 10887000 - CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000 - POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000 - EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000 - FILEIDENT); %109- 10891000 - EMITNUM(FORMATTYPE&CARDNUMBER[1:4:44]); %109- 10891100 - EMITV(GNAT(PRINTI)); %109- 10891200 - IF STEPI = COMMA 10892000 - THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000 - IF LABELCTRINX = 100 10894000 - THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000 - ABOUT TO OVERFLOW WITH LABEL 10896000 - INFORMATION; 10897000 - ERR(415); GO TO EXIT; 10898000 - END; 10899000 - GO STARTCALL; 10900000 - END; 10901000 - IF CHECK(RTPAREN,416) 10902000 - THEN GO TO EXIT; 10903000 - COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000 - DELIMETER; 10905000 - LEXIT_L; EMITL(0); EMITO(RTS); 10906000 - JUMPCHKX; STEPIT; 10907000 - IF CHECK(LABELID,417) 10908000 - THEN GO TO EXIT; 10909000 - COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000 - PUT(TAKE(ELBATWORD_-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000 - ELBATWORD); 10912000 - IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100 - PUT(TAKEFRST & (LABELCTR[LABELCTRINX_LABELCTRINX+1]_ 10913000 - IF DUMPETEMP_TAKEFRST.DUMPEE = 0 10914000 - THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000 - ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000 - EMITL(0); 10917000 - DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS; 10918000 - EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000 - END 10920000 - UNTIL LABELCTRINX_LABELCTRINX-1 < 0; 10921000 - L_L-1; EMITO(STD); STEPIT; 10922000 - IF CHECK(COLON,418) 10923000 - THEN GO TO EXIT; 10924000 - COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000 - FINALL_L; L_TESTLOC; STEPIT; 10926000 - IF (GT1 _ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500 - AND GT1 < REALID AND GT1 > INTID) OR (GT1 _ TABLE(I+1) 10926510 - ! COMMA AND GT1 ! SEMICOLON) 10926520 - THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530 - UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540 - FLAG(465); GO TO EXIT; 10926550 - END; 10926560 - PRIMARY; EMITV(DUMPETEMP); 10927000 - EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000 - L_FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000 - DUMPR],GIT(ELBAT[I-3])); 10930000 - IF ELCLASS = COMMA 10931000 - THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000 - STEPIT; GO TO START; 10933000 - END; 10934000 - IF CHECK(SEMICOLON,419) 10935000 - THEN; 10936000 - COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000 - EXIT:; 10938000 - END DMUP; 10939000 - COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000 - AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000 - OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000 - SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000 - OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000 - IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000 - A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000 - SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 10947000 - SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC 10948000 - SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000 - THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000 - JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000 - TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 - SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 -BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); %113- 10954000 - VALUE BEFORE; BOOLEAN BEFORE; REAL PD; %113- 10954100 - BEGIN 10955000 - LABEL LX,EXIT,BEF; 10956000 - REAL K,N,T1,TL; 10957000 - TL _ L; 10958000 - EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000 - L _ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000 - EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000 - AND PREPARATION FOR SWITCH-JUMP; 10962000 - GOTOG _ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000 - IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000 - LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000 - THEN BEGIN 10966000 - INFO[0,N] _ ELBAT[I]; 10967000 - IF N _ N+1 = 256 10968000 - THEN EBGIN ERR(147); GO TO EXIT END; 10969000 - IF STEPI = COMMA THEN GO TO LX; 10970000 - EMITO(BFC); L _ BUMPL; N _ N-1; 10971000 - FOR K _ 0 STEP 1 UNTIL N 10972000 - DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000 - EMIT((GT1_INFO[0,K]).[35:1]); 10974000 - EMIT(GT1) END; 10975000 - SWITCHGEN _ FALSE END 10976000 - ELSE BEGIN 10977000 - BEF: L _ BUMPL; N _ N-1; 10978000 - PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500 - [16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600 - FOR K _ 0 STEP 1 UNTIL N 10979000 - DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000 - ADJUST; T1 _ L; 10981000 - EMITL(GNAT(GT1_INFO[0,K])); 10982000 - GENGO(GT1); 10983000 - INFO[0,K] _ T1; 10984000 - EMITO(RTS); 10985000 - CONSTANTCLEAN END; 10986000 - I _ I-1; N _ N+1; 10987000 - DO BEGIN ADJUST; 10988000 - STEPIT; INFO[0,N] _ L; 10989000 - IF N _ N+1 = 256 10990000 - THEN BEGIN ERR(147); GO TO EXIT END; 10991000 - DEXP; EMITO(RTS) END 10992000 - UNTIL ELCLASS ! COMMA; ADJUST; 10993000 - EMITB(BFW,TL+12,L); EMITO(BFC); 10994000 - EMIT(0); EMITO(RTS); N _ N-1; 10995000 - FOR K _ 0 STEP 1 UNTIL N 10996000 - DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000 - SWITCHGEN _ TRUE END; 10998000 - T1 _ L; 10999000 - L _ TL+4; 11000000 - EMITL(N+1); 11001000 - L _ T1; 12000000 - EXIT: END SWITCHGEN; 12001000 - PROCEDURE DBLSTMT; 12002000 - BEGIN 12003000 - REAL S,T; 12004000 - BOOLEAN B ; 12004100 - LABEL L1,L2,L3,L4,EXIT ; 12005000 - S_0; 12006000 - IF STEPI!LEFTPAREN THEN ERR(281) 12007000 - ELSE 12008000 - L1: BEGIN 12009000 - IF STEPI=COMMA THEN 12010000 - BEGIN 12011000 - DPTOG_TRUE; 12012000 - IF STEPI=ADOP THEN STEPIT; 12013000 - EMITNUM(NLO); 12014000 - EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000 - DPTOG_FALSE; 12016000 - STEPIT; 12017000 - GO TO L2; 12018000 - END; 12019000 - IF TABLE(I+1)=COMMA THEN 12020000 - BEGIN 12021000 - IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000 - BEGIN 12023000 - EMITO(ELBAT[I].ADDRESS+1); 12024000 - L4: IF (S_S-1)<=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 - DO 12031000 - BEGIN 12032000 - IF ELCLASS !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000 - STEPIT; 12034000 - B_ELCLASS=INTID OR ELCLASS=INTARRYID 12034100 - OR ELCLASS=INTPROCID ; 12034110 - IF ELCLASS<=INTID AND ELCLASS>=REALID THEN 12035000 - BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000 - ELSE IF ELCLASS<=INTPROCID AND ELCLASS>=REALPROCID THEN 12036100 - 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 - BEGIN 12043000 - CHECKER(T_ELBAT[I]); 12044000 - STEPIT;STEPIT; 12045000 - AEXP; 12046000 - EMITV(T.ADDRESS); 12047000 - GO TO L2; 12048000 - END; 12049000 - END ; 12050000 - AEXP; 12051000 - IF ELCLASS!COMMA THEN BEGIN ERR(284);GO EXIT 12052000 - END; 12053000 - STEPIT; AEXP; EMITO(XCH); 12054000 - L2: S_S+1; 12055000 - L3: IF ELCLASS!COMMA THEN BEGIN ERR(284);GO TO EXIT END; 12056000 - GO TO L1; 12057000 - EXIT:END 12058000 - END DBLSTMT; 12059000 -PROCEDURE CMPLXSTMT ; 12060000 - BEGIN 12060100 - REAL S,T ; 12060200 - BOOLEAN B ; 12060250 - LABEL L1,L2,L3,L4,L5,EXIT,ERROR ; 12060300 - DEFINE ERRX(ERRX1) = BEGIN T_ERRX1; GO ERROR END #; 12060400 - IF STEPI!LEFTPAREN THEN ERRX(381) ; 12060500 -L1: STEPIT ; 12060550 - IF TABLE(I+1)=COMMA THEN 12060600 - BEGIN 12060700 - IF ELCLASS=ADOP THEN 12060800 - BEGIN 12060900 - T_ELBAT[I].ADDRESS ; 12061000 - EMITPAIR(9,STD); EMITO(XCH); EMITV(9); EMITO(T) ; 12061100 - EMITPAIR(9,STD); EMITO(T); EMITV(9) ; 12061200 -L4: IF S_S-1<1 THEN FLAG(382); STEPIT; GO L1 ; 12061300 - END ; 12061400 - IF ELCLASS=MULOP THEN 12061500 - BEGIN 12061600 - EMITO(MKS) ; 12061700 - EMITL(IF ELBAT[I].ADDRESS=MUL THEN 26 ELSE 35) ; 12061725 - EMITV(GNAT(SPECIALMATH)) ; 12061750 -L5: EMITO(DEL); EMITO(DEL); GO L4 ; 12061800 - END ; 12061900 - IF ELCLASS=ASSIGNOP THEN 12062000 - BEGIN 12062100 - IF S_S-1<0 THEN FLAG(385); T_0; STEPIT ; 12062200 - B_ELCLASS=INTID OR ELCLASS=INTPROCID 12062250 - OR ELCLASS=INTARRAYID ; 12062255 - DO BEGIN 12062300 - IF ELCLASS!COMMA THEN ERRX(384); STEPIT ; 12062400 - IF ELCLASS>BOOID AND ELCLASSBOOPROCID AND ELCLASSBOOARRAYID 12063000 - THEN VARIABLE(FL) 12063100 - ELSE ERRX(386) ; 12063200 - EMITO(IF B THEN ISD ELSE STD) ; 12063300 - END 12063400 - UNTIL T_T+1=2 ; 12063500 - IF ELCLASS!RTPAREN THEN GO L3 ; 12063600 - IF S!0 THEN FLAG(383) ELSE BEGIN STEPIT; GO EXIT END ; 12063610 - END ; 12063700 - IF ELCLASS=FACTOP THEN 12063800 - BEGIN 12063900 - EMITO(MKS); EMITL(8); EMITV(GNAT(POWERALL)); GO L5 ; 12064000 - END ; 12064100 - IF ELCLASS>BOOID AND ELCLASS="0" 13011000 - THEN IF SC<"8" 13012000 - THEN 13013000 - BEGIN 13014000 - SI_T1; DS_ T CHR;GO TO EXIT 13015000 - END; 13016000 - SI_T1;DS _ 7 CHR; 13017000 - EXIT: 13018000 - END; 13019000 - STREAM PROCEDURE ENTERID(IDLOC,FILENO,TYPE,MULFID,FILID,FILID1,N); 13020000 - VALUE FILENO,TYPE,MULFID,FILID,N; 13021000 - BEGIN 13022000 - DI_IDLOC; DI_DI+5;DI_DC; 13023000 - SI_LOC FILENO; SI_SI+6; 13024000 - DS_ 2 CHR; SI_LOC TYPE; 13025000 - SI_ SI+7; DS_ CHR; 13026000 - SI_ LOC MULFID;SI+SI+1; 13027000 - DS_ 7 CHR; 13028000 - SI_ LOC FILID;SI_SI+1; 13029000 - DS_ 7 CHR; 13030000 - SI_ LOC N; SI_SI+7; 13031000 - DS_ CHR; 13032000 - SI_ FILID1; SI_SI+3; 13033000 - DS_ N CHR; N_DI; 13034000 - DI_ IDLOC; DI_DI+5; 13035000 - SI_ LOC N; SI_SI+5; 13036000 - DS_ 3 CHR 13037000 - END; 13038000 - REAL MULFID,FILID,TYPE,M,K; 13039000 - DEFINE CALL5=EMITL(0); EMITL(IOT); EMITL(8); EMITV(5) # ; 13039400 - REAL SAVADDRSF ; 13039450 - REAL ACCUM1; 13039500 - INTEGER CURRENT, IOTEMP, IOTEMPO; 13039550 - LABEL START; 13040000 - JUMPCHKX; 13041000 - IF G_GTA1[J_J-1]=FILEV 13042000 - THEN 13043000 - BEGIN 13044000 - IF G_GTA1[J_J-1]=SWITCHV 13045000 - THEN 13046000 - BEGIN 13047000 - STOPENTRY_NOT SPECTOG; 13048000 - ENTRY(SUPERFILEID); 13049000 - IF SPECTOG THEN GO TO START; 13050000 - IF ELCLASS!ASSIGNOP 13051000 - THEN FLAG(34); 13052000 - EMITO(MKS); 13053000 - CHECKDISJOINT(ADDRSF); 13054000 - G_L;L_L+1; 13055000 - EMITL(1); 13056000 - EMITL(1); 13057000 - EMITL(1); 13058000 - EMITV(5) ; 13059000 - 13060000 - J_-1; STOPENTRY_FALSE; 13061000 - DO 13062000 - BEGIN 13063000 - IF STEPI ! FILEID% 13064000 - THEN FLAG(35); 13065000 - PASSFILE; 13066000 - EMITL(J_J+1); 13067000 - EMITN(ADDRSF); 13068000 - EMITO(STD); 13069000 - END 13070000 - UNTIL ELCLASS!COMMA; 13071000 - GT2_L;L_G; EMITL(J+1); L_GT2; GO TO START 13072000 - END; 13073000 - I_I-1;M_1; 13074000 - IF G=ALFAV 13075000 - THEN M_0 13076000 - ELSE J_J+1;K_J; STOPENTRY_NOT SPECTOG; 13077000 - DO 13078000 - BEGIN 13079000 - STOPDEFINE := TRUE ; 13079500 - STEPIT; J:=K;P2:=P3:=P4:=FALSE;GTA1[0]:=0; GET7(ACCUM[1],FILID); 13080000 - MULFID_0;TYPE_2; ENTER(FILEID); 13081000 - SAVADDRSF_ADDRSF ; 13081500 - IF SPECTOG THEN GO TO START; 13082000 - EMITO(MKS);EMITL(0);EMITL(0); 13082500 - IF ELCLASS=LITNO 13083000 - THEN 13084000 - BEGIN 13085000 - TYPE_ELBAT[I].ADDRESS; 13086000 - STEPIT 13087000 - END; 13088000 - IF ELCLASS<=IDMAX THEN 13088010 - BEGIN 13088020 - % TO VOID A CARD 13088025 - IF ACCUM1_ACCUM[1]="5PRINT" THEN TYPE_1 ELSE 13088030 - IF ACCUM1="6REMOT" THEN TYPE _ 19 ELSE 13088035 - IF ACCUM1="5PUNCH" THEN TYPE_0 ELSE 13088040 - IF ACCUM1="4DISK0" THEN BEGIN STOPDEFINE_TRUE ; 13088050 - TYPE:=12; IF STEPI <=IDMAX THEN BEGIN IF ACCUM1 := ACCUM[1] ! 13088060 - "6SERIA" THEN BEGIN IF ACCUM1 = "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 - 13115000 - 13116000 - 13117000 - 13118000 - 13119000 - 13120000 - 13121000 - 13122000 - 13123000 - 13124000 - 13125000 - 13126000 - 13127000 - 13128000 - 13129000 - 13130000 - 13131000 - 13132000 - 13133000 - 13134000 - 13135000 - 13136000 - 13137000 - 13138000 - 13139000 - 13140000 - 13141000 - 13142000 - 13143000 - 13144000 - IF ELCLASS ! COMMA THEN BEGIN FLAG(27); GO TO START END 13145000 - ELSE 13146000 - BEGIN 13147000 - STEPIT; AEXP; 13148000 - 13148100 - IF (IOTEMP_GET(L-1)).[46:2] = 0 THEN IOTEMP_IOTEMP DIV 4 13148200 - ELSE IOTEMP_ 256; 13148300 - IF ELCLASS!COMMA 13149000 - THEN 13150000 - BEGIN 13151000 - EMITL(0); 13152000 - CALL5 ; 13153000 - END 13154000 - ELSE 13155000 - BEGIN 13156000 - IF GT1_FILEATTRIBUTEINDX(FALSE)=0 THEN 13157000 - BEGIN AEXP; 13157010 - IF (IOTEMPO:=GET(L-1)).[46:2] = 0 THEN 13157020 - IF IOTEMPO DIV 4 > IOTEMP THEN 13157030 - IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040 - ELSE BEGIN 13158000 - EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000 - EMITN(SAVADDRSF); GT1_FILEATTRIBUTEHANDLER(FIO); 13160000 - END ; 13161000 - WHILE ELCLASS=COMMA DO 13162000 - IF GT1_FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000 - BEGIN ERR(291); GO START END 13164000 - ELSE BEGIN 13165000 - EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000 - GT1_FILEATTRIBUTEHANDLER(FIO); 13167000 - END ; 13168000 - END ; 13169000 - END ; 13170000 - ARRAYFLAG_FALSE ; 13181000 - IF ELCLASS!RTPAREN THEN FLAG(29); 13182000 - COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000 - IOBUFFSIZE_IOBUFFSIZE + 50 + ( CURRENT x IOTEMP); 13184000 -% VOID 13185000 -% VOID 13186000 - END 13187000 - UNTIL STEPI!COMMA; 13188000 - STOPENTRY_FALSE; 13189000 - END ELSE 13190000 - BEGIN 13191000 - IF G!FORMATV THEN FLAG(33) ELSE 13192000 - IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN 13193000 - END; 13194000 - START: 13195000 - END; 13196000 - PROCEDURE HANDLESWLIST; 13196300 - BEGIN 13196310 - LABEL OVER; 13196320 - 13196330 - JUMPCHKX; 13196340 - STOPENTRY_ NOT SPECTOG; 13196350 - ENTRY(SUPERLISTID); 13196360 - IF SPECTOG THEN GO TO OVER; 13196370 - IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380 - COMMENT MISSING _; 13196390 - EMITO(MKS); 13196400 - CHECKDISJOINT(ADDRSF); 13196410 - G_L; L_L+1; 13196420 - EMITL(1); 13196430 - EMITL(1); 13196440 - EMITL(1); 13196450 - EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460 - LIST DESCRIPTORS FOR SWITCH LIST; 13196470 - COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480 - J_-1; STOPENTRY _ FALSE; 13196490 - DO 13196500 - BEGIN 13196510 - IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520 - THEN BEGIN ERR(42); GO TO OVER END; 13196530 - PASSLIST; 13196540 - EMITL(J_J+1); 13196550 - EMITN(ADDRSF); 13196560 - EMITO(STD); COMMENT STORE LIST DESC IN ARRAY; 13196570 - END 13196580 - UNTIL ELCLASS ! COMMA; 13196590 - GT2_L; L_G; EMITL(J+1); L_GT2; 13196600 - OVER: END OF HANDLESWLIST; 13196610 - PROCEDURE SCATTERELBAT; 13197000 - BEGIN 13198000 - REAL T; 13199000 - T _ ELBAT[I]; 13200000 - KLASSF _ T.CLASS; 13201000 - FORMALF _ BOOLEAN(T.FORMAL); 13202000 - VONF _ BOOLEAN(T.VO); 13203000 - LEVELF _ T.LVL; 13204000 - ADDRSF _ T.ADDRESS; 13205000 - INCRF _ T.INCR; 13206000 - LINKF _ T.LINK; 13207000 - END SCATTERELBAT; 13208000 - PROCEDURE CHKSOB; 13209000 - IF GTA1[J_J-1]!0 THEN FLAG(23); 13210000 - DEFINE SUBOP=48#, 13211000 - ADDC=532480#, 13212000 - SUBC=1581056#, 13213000 - EMITSTORE=EMITPAIR#; 13214000 - PROCEDURE PURGE(STOPPER); 13215000 - VALUE STOPPER; 13216000 - REAL STOPPER; 13217000 - BEGIN 13218000 - INTEGER POINTER; 13219000 - LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000 - REAL J,N,OCR,TL,ADD; 13221000 - POINTER_LASTINFO; 13222000 - WHILE POINTER>= STOPPER 13223000 - DO 13224000 - BEGIN 13225000 - IF ELCLASS_(GT1_TAKE(POINTER)).CLASS=NONLITNO 13226000 - THEN BEGIN 13227000 - NCII_NCII-1; 13228000 - EMITNUM(TAKE(POINTER+1)); 13229000 - EMITSTORE(MAXSTACK,STD); 13230000 - MAXSTACK_(G_MAXSTACK)+1; 13231000 - J_L; L_GT1.LINK; 13232000 - DO 13233000 - BEGIN 13234000 - GT4_GET(L); 13235000 - EMITV(G) 13236000 - END 13237000 - UNTIL (L_GT4)=4095; 13238000 - L_J; 13239000 - POINTER_POINTER-GT1.INCR 13240000 - END 13241000 - ELSE 13242000 - BEGIN 13243000 - IF NOT BOOLEAN(GT1.FORMAL) 13244000 - THEN BEGIN 13245000 - IF ELCLASS = LABELID 13246000 - THEN BEGIN 13247000 - ADD _ GT1.ADDRESS; 13248000 - IF NOT BOOLEAN(OCR_TAKE(GIT(POINTER))).[1:1] 13249000 - THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000 - THEN BEGIN GT1 _ 160; GO TO RECOV END; 13251000 - IF ADD ! 0 THEN GT1_PROGDESCBLDR(2,OCR,ADD) END 13252000 - ELSE IF ELCLASS = SWITCHID 13253000 - THEN BEGIN 13254000 - IF TAKE(POINTER+1) < 0 13255000 - THEN BEGIN GT1 _ 162; GO TO RECOV END; 13256000 - OCR _(J _ TAKE(GIT(POINTER))).[24:12]; 13257000 - N _ GET( (J_J.[36:12])+4); TL _ L; 13258000 - IF ADD _ GT1.ADDRESS ! 0 13259000 - THEN BEGIN 13260000 - GT5 _ PROGDESCBLDR(0,J,ADD); 13261000 - IF OCR ! 0 13262000 - THEN BEGIN L_OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000 - L_J+11; EMITL(15); EMITO(RTS); 13264000 - FOR J _ 4 STEP 4 UNTIL N 13265000 - DO BEGIN 13266000 - EMITL(GNAT(GET(L)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 - 13275000 - 13276000 - L _ TL END 13277000 - ELSE IF ELCLASS >=PROCID AND ELCLASS<= INTPROCID 13278000 - THEN IF TAKE(POINTER+1) < 0 13279000 - THEN BEGIN GT1 _ 161; 13280000 - RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM); 13281000 - Q _ ACCUM[1]; FLAG(GT1); ERRORTOG _ TRUE END 13282000 - END; 13283000 - XREFDUMP(POINTER); % DUMP XREF INFO %116- 13283500 - GT2_TAKE(POINTER+1); 13284000 - GT3_GT2.PURPT; 13285000 - STACKHEAD(0>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 %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 - BEGIN 13323000 - BOOLEAN SVTOG;% 13323010 - J_0;I_I-1; 13324000 - DO 13325000 - BEGIN 13326000 - STOPDEFINE _TRUE; STEPIT; SCATTERELBAT; 13327000 - IF FORMALF_SPECTOG 13328000 - THEN 13329000 - BEGIN 13330000 - IF TYPE<=INTARRAYID AND TYPE>=BOOARRAYID THEN% 13330550 - IF VONF THEN BEGIN SVTOG _ ERRORTOG; FLAG(15);% 13330600 - SPECTOG _ ERRORTOG _ SVTOG; END;% 13330650 - IF ELCLASS!SECRET 13331000 - THEN FLAG(002); 13332000 - BUP_BUP+1 13333000 - END 13334000 - ELSE 13335000 - BEGIN 13336000 - IF ELCLASS>IDMAX AND ELCLASS<=FACTOP 13337000 - THEN FLAG(003); 13338000 - IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 13339000 - IF NOT (PTOG OR STREAMTOG) AND LINKF>= GLOBALNINFOO 13339100 - THEN FLAG(1) %118- 13339200 - ELSE %118- 13339300 - ELSE %118- 13339400 - IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION %118- 13339500 - FLAG(1); %118- 13340000 - VONF_P2; 13341000 - IF ((FORMALF_PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000 - THEN ADDRSF _ 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 CHECKDISJOIUNT(ADDRSF); 13347520 - END; 13348000 - IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100 - XREFPT_XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200 - KLASSF_TYPE; MAKEUPACCUM;E; J_J+1; 13349000 - END 13350000 - UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]_J 13351000 - END; 13352000 - PROCEDURE UNHOOK; 13353000 - COMMENT 13354000 - UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000 - FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000 - E WILL WORK AS NORMAL. ; 13357000 - BEGIN 13358000 - REAL LINKT,A,LINKP; 13359000 - LABEL L; 13360000 - LINKT_STACKHEAD[SCRAM] ; LINKP_ELBAT[I].LINK; 13361000 - IF LINKT=LINKP THEN STACKHEAD[SCRAM]_TAKE(LINKT).LINK 13362000 - ELSE 13363000 - L: IF A_TAKE(LINKT).LINK=LINKP 13364000 - THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000 - ELSE BEGIN LINKT_A; GO TO L END; 13366000 - END; 13367000 -PROCEDURE MAKEUPACCUM; 13368000 - BEGIN 13369000 - IF PTOG 13370000 - THEN GT1_LEVELF ELSE GT1_LEVEL; 13371000 - ACCUM[0]_ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000 - & REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11] 13373000 - ) 13374000 - END; 13375000 -PROCEDURE ARRAE; 13376000 -COMMENT 13377000 - ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000 - IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000 - STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000 - MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000 - EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000 - ARRAY A[0:10], 13383000 - MKS (THIS MARKS STACK TO CUT BACK AFTER COM) 13384000 - DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000 - THE ADDRESS OF A) 13386000 - LITC 11 (SIZE OF ARRAY) 13387000 - LITC 1 (NUMBER OF DIMENSIONS) 13388000 - LITC 1 (NUMBER OF ARRAYS) 13389000 - LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000 - NON OWN ARRAYS) 13391000 - COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000 - DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000 - STACK) 13394000 - OWN ARRAY B,C[0:X,-1:10], 13395000 - MKS 13396000 - DESC B 13397000 - DESC C 13398000 - LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000 - OPDC X 13400000 - LITC JUNK (JUNK CELL) 13401000 - ISN (INTEGERIZE UPPER BOUND) 13402000 - LITC 1 (COMPUTE SIZE 13403000 - ADD OF DIMENSION 13404000 - LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000 - CHS 13406000 - LITC 12 (SIZE SECOND DIMENSION) 13407000 - LITC 2 (NUMBER DIMENSIONS) 13408000 - LITC 2 (NUMBER ARRAYS) 13409000 - LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000 - COM 13411000 - DESC XITR 13412000 - SAVE OWN ARRAY D,E,F[X:Y,M+N:TxV], 13413000 - MKS 13414000 - DESC D 13415000 - DESC E 13416000 - DESC F 13417000 - OPDC X 13418000 - LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000 - ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000 - DUP (MUST PASS LOWER BOUND FOR OWN) 13421000 - OPDC Y (INTEGERIZE 13422000 - LITC JUNK UPPER 13423000 - ISN BOUND) 13424000 - XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000 - SUB UPPER 13426000 - LITC 1 -LOWER 13427000 - ADD +1) 13428000 - OPDC M (COMPUTER LOWER BOUND 13429000 - OPDC N SECOND DIM) 13430000 - ADD 13431000 - LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000 - ISN (INTEGERIZE) 13433000 - DUP (PASS LOWER BOUND FOR OWN) 13434000 - OPDC T 13435000 - MUL V 13436000 - LITC JUNK (INTEGERIZE 13437000 - ISN UPPER) 13438000 - XCH (COMPUTE 13439000 - SUB SIZE 13440000 - LITC 1 13441000 - ADD ) 13442000 - LITC 2 (NUMBER DIMENSIONS) 13443000 - LITC 3 (NUMBER ARRAYS) 13444000 - LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000 - COM 13446000 - DESC XITR ; 13447000 - BEGIN 13448000 - REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000 - BOOLEAN LLITOG,ULITOG; 13450000 -REAL ADDCON; 13451000 - LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000 - ARRAYFLAG _ TRUE; 13452100 - TYPEV_REALARRAYID; 13453000 - IF T1_GTA1[J_J-1]=0 THEN J_J+1 13454000 -ELSE 13455000 - IF T1=OWNV THEN 13456000 - BEGIN P2:=TRUE;IF SPECTOG THE FLAG(13) END 13457000 -ELSE 13458000 - IF T1= SAVEV THEN 13459000 - BEGIN 13460000 - P3:=TRUE; 13461000 - IF SPECTOG THEN FLAG(13); 13462000 -% IF REMOTOG THEN FLAG(508); % NOT ALLOWED IN XALGOL ON TSS. 13463000 - END 13464000 -ELSE 13465000 - IF T1= AUXMEMV THEN 13466000 - BEGIN P4:=TRUE; IF SPECTOG THEN FLAG(13) END 13467000 -ELSE 13468000 - TYPEV :=REALID+T1; 13469000 - IF NOT SPECTOG THEN EMITO(MKS); SAVEINFO_NEXTINFO; 13470000 - ENTER(TYPEV); SAVEINFO2_NEXTINFO_NEXTINFO+1; 13471000 -BETA1: 13472000 - IF ELCLASS!LFTBRKET THEN FLAG(016); LBJ_0;SAVEDIM_1; 13473000 -TWO:IF STEPI=ADOP THEN 13474000 - BEGIN 13475000 - T1_ELBAT[I].ADDRESS; I_I+1 13476000 - END 13477000 - ELSE T1_0;IF SPECTOG THEN GO TO BETA2; 13478000 - APROGS_L; 13479000 - IF TABLE(I+1)=COLON AND TABLE(I)=LITNO THEN 13480000 - BEGIN 13481000 - LLITOG_TRUE; 13482000 - IF T3_ELBAT[I].ADDRESS!0 13483000 - THEN 13484000 - BEGIN 13485000 - EMITL(T3); 13486000 - IF T1=SUBOP THEN 13487000 - BEGIN 13488000 - EMITO(CHS); 13489000 - ADDCON_ADDC 13490000 - END ELSE 13491000 - ADDCON_SUBC 13492000 - END; 13493000 - T2_T3x4+ADDCON 13494000 - END 13495000 - ELSE 13496000 - BEGIN 13497000 - LLITOG_FALSE; 13498000 - IF T1!0 THEN I_I-1; 13499000 - T2:=GETSPACE(P2,-1);%TEMP. 13500000 - AEXP;EMITSTORE(T2,ISN); 13501000 - T2_T2x4+SUBC+2; 13502000 - IF ELCLASS!COLON THEN 13503000 - FLAG(017);I_I-1 13504000 - END; 13505000 - IF P2 THEN 13506000 - BEGIN 13507000 - IF LLITOG AND T3=0 THEN EMITL(0); 13508000 - ARPROGS_L;EMITO(DUP); 13509000 - END; 13510000 - IF ELCLASS_TABLE(I_I+2)=LITNO THEN 13511000 - BEGIN 13512000 - IF T_TABLE(I_I+1)=COMMA OR 13513000 - T_RTBRKET 13514000 - THEN 13515000 - BEGIN 13516000 - EMITL(T4_ELBAT[I-1].ADDRESS); 13517000 - ULITOG_TRUE;GO TO CSZ 13518000 - END 13519000 - ELSE 13520000 - I_I-1 13521000 - END; 13522000 - ULITOG_FALSE; 13523000 - AEXP; 13524000 - EMITL(JUNK); 13525000 - EMITL(ISN); 13526000 - CSZ: IF LLITOG AND ULITOG THEN 13527000 - BEGIN 13528000 - L_ARPROGS; 13529000 - IF(T_IF ADDCON=ADDC THEN T4+T3+1 ELSE 13530000 - T4-T3+1)<=0 OR T>1023 THEN FLAG(59); 13531000 - EMITL(T); 13531100 - IF P3 THEN BEGIN SAVEDIM_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 - PROCEDURE JUMPCHKNX; 13616000 -COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 13617000 - EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 13618000 - NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH HTEN L IS BUMPED 13619000 - AND SAVED FOR A LATER BRANCH; 13620000 -IF NOT SPECTOG THEN 13621000 -BEGIN 13622000 - IF FIRSTX!4095 13623000 - THEN 13624000 - BEGIN 13625000 - IF NOT AJUMP 13626000 - THEN 13627000 - SAVEL_BUMPL; 13628000 - AJUMP_TRUE 13629000 - END;ADJUST 13630000 -END; 13631000 -PROCEDURE SEGMENTSTART; 13632000 - BEGIN 13632100 - IF NOHEADING THEN DATIME; 13633000 - IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 - ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 - END SEGMENTSTART; 13633300 -PROCEDURE SEGMENT(SIZE,NO,NOO); %106- 13634000 - VALUE SIZE,NO,NOO; %106- 13635000 - REAL SIZE,NO,NOO; %106- 13636000 - BEGIN %106- 13637000 - INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT %106- 13637100 - % IS NOT TOO BIG %106- 13637200 - PDPRT[PDINX.[37:5],PDINX.[42:6]] := %106- 13638000 - SIZE & NO[28:38:10] & %106- 13639000 - MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & %106- 13640000 - REAL(SAVEPRTOG)[3:47:1]; %106- 13641000 - PDINX:=PDINX+1; SIZE:=ABS(SIZE); %106- 13642000 - IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; %106- 13643000 - AKKUM:=AKKUM+SIZE; %106- 13644000 - IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16x(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 - 13700000 - 13701000 - 13702000 - 13703000 - 13704000 - 13705000 - 13706000 - 13707000 - 13708000 - 13709000 - 13710000 - 13711000 - 13712000 - 13713000 -PROCEDURE ENTER(TYPE); VALUE TYPE; INTEGER TYPE; 13714000 - BEGIN 13715000 - G:=GTA1[J:=J-1]; 13716000 - IF NOT SPECTOG THEN 13717000 - BEGIN 13718000 - IF NOT P2 THEN 13719000 - IF P2:=(G=OWNV) THEN G:=GTA1[J:=J-1]; 13720000 - IF NOT P3 THEN 13721000 - IF P3:=(G=SAVEV) THEN G:=GTA1[J:=J-1]; 13722000 - IF NOT P4 THEN 13723000 - IF P4:=(G=AUXMEMV) THEN G:=GTA1[J:=J-1]; 13724000 - END; 13725000 - IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE) 13726000 - END ENTER; 13727000 - 13728000 - 13729000 - 13730000 -PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000 - VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD; 13732000 - BOOLEAN GOTSTORAGE; 13733000 - REAL RELAD,STOPPER,PRTAD; 13734000 - BEGIN 13735000 - BOOLEAN BT; 13736000 - REAL K,LS; 13737000 - LS_RELAD; 13738000 - BT_JUMPCTR=LEVEL; 13739000 - IF FUNCTOG 13740000 - THEN 13741000 - BEGIN 13742000 - EMITV(514); 13743000 - EMITO(RTN) 13744000 - END 13745000 - ELSE 13746000 - EMITO(XIT); 13747000 - IF STACKCTR>MAXSTACK THEN MAXSTACK_STACKCTR; 13748000 - CONSTANTCLEAN; 13749000 - IF K_MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000 - THEN 13751000 - BEGIN ADJUST;LS_L; 13752000 - IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000 - THEN 13754000 - BEGIN 13755000 -% 13755500 - EMITV(BLOCKCTR); 13756000 - EMITL(1); 13757000 - EMITO(ADD); 13758000 - IF GOTSTORAGE OR FAULTOG.[46:1] 13759000 - THEN 13760000 - EMITSTORE(BLOCKCTR,SND) 13761000 - END 13762000 -% 13762500 - ELSE EMITL(0); 13763000 - K_K+NCII; 13764000 - WHILE K_K-1>=0 13765000 - DO EMITL(0); 13766000 - PURGE(STOPPER); 13767000 - IF FAULTLEVEL<=LEVEL THEN 13767100 - BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL_32; 13767200 - EMITPAIR(0,MDS); EMITO(CHS); 13767300 - END OF THIS PART OF ERROR KLUDGE; 13767400 - EMIT(0); % DC & DISK 13767500 - BUMPL; 13768000 - 13768100 - EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000 - CONSTANTCLEAN 13770000 - END ELSE PURGE(STOPPER); 13771000 - Z_PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000 - END HTTEOAP; 13773000 - PROCEDURE FORMATGEN; 13774000 - BEGIN 13775000 - INTEGER PRT;LABEL L; 13776000 - BOOLEAN TB2; 13777000 - ARRAY TEDOC[0:7,0:127]; 13777500 - MOVECODE(TEDOC,EDOC); 13777600 - BUILDLINE _ BOOLEAN(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 - 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 - 13799000 - END ELSE 13800000 - BEGIN 13801000 - I_I-1; 13802000 - DO 13803000 - BEGIN 13804000 - STOPDEFINE_TRUE;STEPIT ; 13805000 - ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="<"; 13806000 - PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000 - TB1_FORMATPHRASE; 13808000 - END 13809000 - UNTIL ELCLASS!"," OR TB1_F>=256 ; 13810000 - 13811000 - 13812000 - END; 13813000 - SEGMENT(-F,SGNO,GT5);SGAVL_SGAVL+1; 13814000 - IF TB1 AND ELCLASS="," THEN BEGIN I_I+1;GO TO L END; 13815000 - IF ELCLASS!";" THEN ELBAT[I]_0 ELSE ELBAT[I].CLASS_SEMICOLON; 13816000 - STOPGSP_STOPENTRY_FALSE; 13817000 - SGNO_GT5; 13818000 - MOVECODE(TEDOC,EDOC); 13818500 - BUILDLINE _ BUILDLINE.[46:1] ; 13818600 - END FORMATGEN; 13819000 - PROCEDURE CHECKBOUNDLVL ; 13819100 - COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200 - DECLARED AT SAME LEVEL; 13819300 - IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400 - THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410 - COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 - ARARY DECLARATION; 13819600 - PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR 13900000 - THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 13901000 - PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 13902000 - INTRINSIC, WHO WILL BUILD AIT ENTRIES; 13903000 - BEGIN INTEGER TP; REAL A; 13903100 - J_0; JUMPCHKX; EMITO(MKS); 13904000 - IF FAULTLEVEL>LEVEL THEN FAULTLEVEL_LEVEL; 13905000 - IF MODE=0 THEN FAULTLEVEL_1; 13906000 - DO BEGIN IF J>0 THEN STEPIT; J_J+1; 13907000 - SCATTERELBAT; A_ACCUM[1]; 13908000 - IF TP_REAL((Q="6INTOV")&(Q="6EXPOV")[46:47:1]&(Q="5INDEX" 13909000 - )[45:47:1]&(Q="4ZERO0")[44:47:1]&(Q="4FLAG0")[43:47:1])=0 13910000 - THEN ERR (61) ELSE 13911000 - BEGIN IF TABLE(I+1)=ASSIGNOP THEN 13911100 - BEGIN STEPIT; COMMENT OVER THE _; 13911200 - IF GT1_STEPI>IDMAX AND 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; %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)x10]); 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) x %117- 14269520 - (NB := ELBAT[I].ADDRESS) ! 0 AND %117- 14269540 - SB + NB<= 48 THEN %117- 14269560 - BEGIN %117- 14269580 - SAVEIT: %117- 14269590 - PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, %117- 14269600 - SAVEINFO); %117- 14269620 - STEPIT; %117- 14269640 - IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. %117- 14269660 - IF ELCLASS = RTBRKET THEN %117- 14269680 - BEGIN %117- 14269700 - STEPIT; %117- 14269705 - GO TO EXIT; %117- 14269710 - END %117- 14269715 - ELSE %117- 14269720 - ELSE %117- 14269740 - GO TO EXIT; %117- 14269760 - END; %117- 14269780 - END; %117- 14269800 - FLAG(114); %117- 14269820 - DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; %117- 14269840 - EXIT: %117- 14269860 - END %117- 14269880 - UNTIL %117- 14269900 - ELCLASS ! COMMA; %117- 14269920 - STOPENTRY := STOPGSP := FALSE; %117- 14269940 - END; %117- 14269960 - GO TO START; %117- 14269980 -PROCEDUREDEC: 14270000 - BEGIN 14271000 - LABEL START,START1; 14272000 - LABEL START2, DOITANYWAY; 14273000 - COMMENT FWDTOG NOW GLOBAL TO BLOCK; 14274000 - IF NOT SPECTOG THEN FUNCTOG_FALSE; 14275000 - FWDTOG := NEXTSAVE := FALSE; 14276000 - IF LASTENTRY!0 THEN BEGIN JUMPCHKNX;CONSTANTCLEAN END; 14276500 - MAXSTACKO_ MAXSTACK; 14277000 - IF G_GTA1[J_J-1]=STREAMV 14278000 - THEN 14279000 - BEGIN STREAMTOG_TRUE; 14280000 - IF G_GTA1[J_J-1]=0 THEN TYPEV_STRPROCID 14281000 - ELSE 14282000 - BEGIN 14283000 - IF TYPEV_PROCID +G>INSTRPROCID OR 14284000 - TYPEV INTRPROCID THEN FLAG(005) 14295000 - ELSE BEGIN IF (NEXTSAVE:=GTA1[J-1]=SAVEV) THEN J:=J-1; 14295100 - IF NOT SPECTOG THEN FUNCTOG:=TRUE; CHKSOB 14296000 - END; 14297000 - IF SPECTOG 14298000 - THEN 14299000 - BEGIN 14300000 - ENTRY(TYPEV); GO TO START2 14301000 - END; 14302000 - MODE_MODE+1; 14303000 - LO_PROINFO; 14304000 - SCATTERELBAT; 14305000 -COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ; 14306000 - IF LEVELF=LEVEL 14307000 - THEN IF KLASSF!TYPEV THEN BEGIN FLAG(6); GO DOITANYWAY END ELSE 14308000 - BEGIN 14309000 -IF G _ TAKE(LINKF+1)>= 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000 - XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST %116- 14310500 - % XREF ENTRY AS A DECLARATION. %116- 14310501 - IF REAL(NEXTSAVE)!G.[3:1] THEN FLAG(051); 14311100 - FWDTOG_TRUE; 14312000 - PROAD_ADDRSF; 14313000 - PROINFO_ELBAT[I];MARK_LINKF+INCRF;STEPIT 14314000 - END 14316000 - ELSE 14317000 - DOITANYWAY: BEGIN STOPENTRY_P2_TRUE; 14318000 - ENTRY(TYPEV); MARK_NEXTINFO;PUTNBUMP(0); 14319000 - PROINFO_TAKE(LASTINFO)& LASTINFO[35:35:13];PROAD_ADDRSF; 14320000 - P2_STOPENTRY_FALSE 14321000 - END; 14322000 - IF LEVEL < 31 THEN LEVEL _ LEVEL + 1 14323000 - ELSE FLAG(039); 14323100 - PJ _ 0; 14323200 - IF STREAMTOG THEN STREAMWORDS; 14324000 - IF ELCLASS=SEMICOLON THEN GO TO START1; 14325000 - IF ECLASS!LEFTPAREN THEN FLAG(007); 14326000 -COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 14327000 - FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 14328000 - RR1_NEXTINFO; 14329000 - LASTINFOT_LASTINFO; LASTINFO_NEXTINFO_1; 14330000 - PUTNBUMP(0); 14331000 - PTOG_TRUE; I_I+1; 14332000 - ENTRY(SECRET); 14333000 -IF FWDTOG THEN BEGIN IF GT1 _ TAKE(MARK).[40:8] ! PJ THEN% 14333100 - FLAG(48); COMMENT WRONG NUMBER OF PARAMETERS; 14333200 - COMMENT SO THAT WE DONT CLOBBER INFO; END ELSE 14333300 - PUT(PJ,MARK); 14334000 - P_PJ; 14335000 - IF ELCLASS!RTPAREN 14336000 - THEN FLAG(008); 14337000 - IF STEPI!SEMICOLON 14338000 - THEN FLAG(009); 14339000 -COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 14340000 - IF STEPI=VALUEV 14341000 - THEN 14342000 - BEGIN 14343000 - DO 14344000 - IF STEPI!SECRET 14345000 - THEN FLAG(010) 14346000 - ELSE 14347000 - BEGIN 14348000 - IF G_ELBAT[I].ADDRESS=0 OR G>PJ 14349000 - THEN 14350000 - FLAG(010); 14351000 - G_TAKE(ELBAT[I]); 14352000 - PUT(G&1[10:47:1],ELBAT[I]) 14353000 - END 14354000 - UNTIL 14355000 - STEPI!COMMA; 14356000 - IF ELCLASS!SEMICOLON 14357000 - THEN FLAG(011) 14358000 - ELSE STEPIT 14359000 - END;I_I-1; 14360000 - IF STREAMTOG 14361000 - THEN 14362000 - BEGIN 14363000 - BUP_PJ; SPECTOG_TRUE;GO TO START1 14364000 - END 14365000 - ELSE 14366000 - BEGIN 14367000 - SPECTOG_TRUE; 14368000 - BUP_0; 14369000 - IF ELCLASS!DECLARATORS 14370000 - THEN FLAG(012) 14371000 - END; 14372000 -START:PTOG_FALSE;LASTINFO_LASTINFOT;NEXTINFO_IF FWDTOG THEN RR1 ELSE 14373000 - MARK+PJ+1; 14374000 -START1:PINFOO_NEXTINFO; 14375000 -START2: END; 14376000 - IF SPECTOG OR STREAMTOG 14377000 - THEN 14378000 - GO TO START; 14379000 -COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 14380000 - PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS; 14381000 -HF: 14382000 - BEGIN 14383000 - LABEL START,STOP; 14384000 - IF STREAMTOG 14385000 - THEN BEGIN 14386000 - JUMPCHKNX_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 UNTIL 14403000 - 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] ! 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 -% 14478000 - COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 14478010 - COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 14478020 - IF MODE = 1 THEN FRSTLEVEL _LEVEL; 14478030 - MAXSTACK_STACKCTR_514 + REAL(FUNCTOG); 14478040 - IF ELCLASS = BEGINV THEN 14479000 - IF TABLE(I+1) = DECLARATORS THEN 14480000 - BEGIN 14481000 - BLOCK(TRUE & NEXTSAVE[46:47:1]); 14482000 - ; PURGE(PINFOO); 14483000 - GO TO STOP END; 14484000 - BEGIN 14485000 - JUMPCHKNX; 14486000 - RELAD_L ; 14487000 - IF NEXTSAVE THEN FLAG(052); 14487010 - STMT; 14488000 - IF FAULTOG.[46:1] THEN BEGIN EMITL(10); EMITO(COM); END; 14488500 - HTTEOAP(FALSE,RELAD,PINFOO,PROAD); 14489000 - END; 14490000 - STOP: 14491000 - SUBLEVEL_TSUBLEVEL; 14492000 - STACKCTR_STACKCTRO; 14493000 - IF LISTER AND FORMATOG THEN SPACEITDOWN; 14493500 - END; 14494000 - END; 14495000 - PROINFO_LO; 14496000 - IF JUMPCTR=LEVEL 14497000 - THEN 14498000 - JUMPCTR_LEVEL-1; 14499000 - LEVEL_LEVEL-1; 14500000 - MODE_MODE-1; 14501000 - MAXSTACK_MAXSTACKO; 14502000 -START:END; 14503000 - GO TO START; 14504000 -CALLSTATEMENT: 14505000 - JUMPCHKX; 14506000 - IF SPECTOG THEN BEGIN 14507000 - IF (PJ ! BUP) THEN 14507010 - BEGIN 14507020 - INTEGER II,SSCRAM,SCOUNT; 14507030 - MOVE(10,ACCUM,INFO[31,240]); 14507040 - II :=I;SSCRAM:=SCRAM;SCOUNT:=COUNT; 14507050 - FOR SCRAM := 0 STEP 1 UNTIL 124 14507060 - DO IF((I_STACKHEAD[SCRAM]) < 256) 14507070 - THEN IF I ! 0 THEN 14507080 - BEGIN ELBAT[76]:=INFO[0,I]&I[35:35: 14507090 - 13]; 14507095 - COUNT:=INFO[0,I+1].[12:6]; 14507100 - MOVE(COUNT,INFO[0,I],ACCUM); 14507105 - I:=76; SCATTERELBAT; 14507110 - FORMALF := TRUE; 14507120 - KLASSF := REALID; 14507130 - MAKEUPACCUM; E; 14507140 - END; 14507150 - I_II;SCRAM_SSCRAM;COUNT_SCOUNT; 14507160 - MOVE(10,INFO[31,240],ACCUM); 14507170 - BUP_PJ; FLAG(12);SPECTOG_TRUE; 14507180 - GO TO START; 14507190 - END ; 14507200 - FLAG(12);GO TO HF 14508000 - END; 14509000 - BEGINCTR _ BEGINCTR-1; 14510000 - IF ERRORTOG 14511000 - THEN COMPOUNDTAIL 14512000 - ELSE 14513000 - BEGIN 14514000 - STMT; 14515000 - IF ELCLASS_TABLE(I+1)=DECLARATORS 14516000 - THEN 14517000 - BEGIN 14518000 - ELBAT[I].CLASS_SEMICOLON; 14519000 - BEGINCTR_BEGINCTR+1; 14520000 - GO TO START 14521000 - END 14522000 - ELSE 14523000 - COMPOUNDTAIL 14524000 - END; 14525000 -BEGIN 14526000 - RELAD_FIRSTX; 14534000 - IF STACKCTR>MAXSTACK 14535000 - THEN MAXSTACK_STACKCTR; 14536000 - IF GOTSTORAGE OR JUMPCTR=LEVEL OR FAULTOG.[46:1] 14537000 - THEN 14538000 - IF NOT(GOTSTORAGE OR FAULTOG.[46:1]) 14539000 - THEN 14540000 - BEGIN 14541000 - EMITV(BLOCKCTR); 14542000 - EMITL(1); 14543000 - EMITO(SUB); 14544000 - EMITSTORE(BLOCKCTR,STD); 14545000 - GOTSTORAGE_TRUE 14546000 - END 14547000 - ELSE 14548000 - BEGIN 14549000 - EMITL(10); 14550000 - EMITO(COM) 14551000 - END; 14552000 - FUNCTOG_FUNCTOGO; 14553000 - IF SOP 14554000 - THEN HTTEOAP(GOTSTORAGE,FIRSTX,NINFOO,BLKAD) 14555000 - ELSE 14556000 - BEGIN 14557000 - IF LEVEL = 1 THEN EMITO(XIT) 14557500 - ELSE BEGIN 14557600 - EMITV(ADDRSF := GETSPACE(TRUE,-6)); % SEG. DESCR. 14558000 - EMITO(BFW); 14558500 - END; 14558600 - CONSTANTCLEAN; 14559000 - IF GOTSTORAGE OR NCII>0 OR LEVEL=1 14560000 - OR FAULTOG.[46:1] THEN 14561000 - BEGIN 14562000 - ADJUST; RELAD_L; 14563000 - IF GOTSTORAGE OR FAULTOG.[46:1] 14564000 - THEN BEGIN EMITV(BLOCKCTR); EMITL(1); 14564100 - EMITO(ADD);EMITSTORE(BLOCKCTR,STD); 14565000 - END; 14566000 - IF LEVEL=1 THEN IF G_NCII+MAXSTACK-512>0 THEN DO EMITL(0) UNTIL G_G-1 14567000 - =0; 14568000 - PURGE(NINFOO); 14569000 - IF LEVEL=1 THEN IF FAULTLEVEL=1 THEN 14569100 - BEGIN EMITPAIR(0,MDS); EMITO(CHS); END; 14569200 - BUMPL; 14570000 - EMITB(BBW,L,IF FIRSTX=4095 THEN 0 ELSE FIRSTX); 14571000 - CONSTANTCLEAN 14572000 - END ELSE PURGE(NINFOO); 14573000 - IF RELAD =4095 THEN RELAD_0; 14574000 - NEXTTEXT _ NTEXTO; 14574500 - G_PROGDESCBLDR(LDES-REAL(LEVEL=1),RELAD,BLKAD) 14575000 - END; 14576000 - ENILSPOT _ 1023 & CARDNUMBER[10:20:28]; 14576100 - SEGMENT((L+3)DIV 4,SGNO,SGNOO); 14577000 - 14578000 - 14579000 - 14580000 - 14581000 - 14582000 - 14583000 - 14584000 - 14585000 - 14586000 - 14587000 - 14588000 - 14589000 - 14590000 - 14591000 - 14592000 - ENILPTR _ OLDENILPTR; LASTADDRESS _ OLDLASTADDRESS; 14593000 - MOVECODE(TENIL,ENIL); 14594000 - MOVECODE(TEDOC,EDOC);L_LOLD; 14595000 - DOUBLE(SGNO,SGNOO,_,SGNOO,SGNO); 14596000 - IF NOT SOP AND LEVEL ! 1 14597000 - THEN 14598000 - BEGIN 14599000 - ADJUST; 14600000 - G_PROGDESCBLDR(LDES,L,ADDRSF); 14601000 - IF ELCLASS = FACTOP THEN 14601100 - BEGIN COMMENT SPECIAL CASE FOR COBOL ONLY; 14601200 - 14601300 - 14601400 - 14601500 - 14601600 - 14601610 - STEPIT; 14601700 - END; 14601800 - END; 14602000 - IF JUMPCTR=LEVEL THEN JUMPCTR_LEVEL-1; 14603000 - LEVEL_LEVEL-1; 14604000 - FUNCTOG_FUNCTOGO; 14605000 - AJUMP_AJUMPO; 14606000 - GLOBALNINFOO := OLDNINFOO; %118- 14606100 - PRTI_PRTIO; 14607000 - FIRSTX_FIRSTXO; 14608000 - SAVEL_SAVELO; 14609000 - STACKCTR_STACKCTRO; 14610000 - SAVEPRTOG := SAVEPRTOGO; 14610100 - NCII_NCIIO; FAULTOG_FAULTOGO AND(FALSE&FAULTLEVEL 7 15035000 - THEN 7 15036000 - ELSE SIZEALPHA)); EMITB(BFW.LTEMP,L); 15037000 - END PASSALPHA; 15038000 - COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 15039000 - OF SIMPLE VARIABLES: 15040000 - 1. V _ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15041000 - 2. V _ EXP ,ALL V EXCEPT FORMAL-NAME. 15042000 - 3. V.[S:L] _ EXP ,WHERE V IS FORMAL-CALL BY NAME. 15043000 - 4. V.[S:L] _ EXP ,ALL V EXCEPT FORMAL-NAME. 15044000 - 5. V.[S:L] ,ALL V. 15045000 - 6. V ,ALL V. 15046000 - CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 15047000 - 1. VN,EXP,M*,XCH,_. 15048000 - 2. EXP,M*,VL,_. 15049000 - 3. VN,DUP,COC,EXP,T,M*,XCH,_. 15050000 - 4. VV,EXP,T,M*,VL,_. 15051000 - 5. ZEROL,VV,T . 15052000 - 6. VV . 15053000 - WHERE VN = DESC V 15054000 - EXP= ARITH, OR BOOLEAN EXPRESSION,AS REQUIRED. 15055000 - M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 15056000 - VL = LITC V 15057000 - VV = OPDC V 15058000 - _ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 15059000 - T = BIT TRANSFER CODE(DIA,DIB,TRB). 15060000 - ZEROL = LITC 0 15061000 - DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 15062000 - OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 15063000 - THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 15064000 - GLOBAL FASHION. 15065000 - THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 15066000 - WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 15067000 - SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 15068000 - ; 15069000 - PROCEDURE VARIABLE(P1); REAL P1; 15070000 - BEGIN 15071000 - REAL TALL, COMMENT ELBAT WORD FOR VARIABLE; 15072000 - T1 , COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 15073000 - T2 , COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 15074000 - J ; COMMENT SUBSCRIPT COUNTER ; 15075000 - REAL X, Z; 15075500 - REAL REMEMBERSEQNO; % REMEMBERS SEQUENCE NUMBER OF VARIABLE %116- 15075550 - % ON LEFT HAND SIDE OF ASSIGNMENT SO WE %116- 15075551 - % CAN XREF IT CORRECTLY. %116- 15075552 - LABEL EXIT; 15076000 - TALL_ELBAT[I] ; 15077000 - IF ELCLASS<= INTPROCID THEN 15078000 - BEGIN 15079000 - IF TALL.LINK !PROINFO.LINK THEN 15080000 - BEGIN ERR(211); GO TO EXIT END; 15081000 -COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 15082000 - TALL _ TALL & (ELCLASS+4) [2:41:7] & 514 [16:37:11]; 15083000 - END 15084000 - ELSE CHECKER(TALL); 15085000 - REMEMBERSEQNO := CARDNUMBER %116- 15085100 - IF TALL.CLASS<= INTID THEN 15086000 - BEGIN 15087000 - LABEL L1, EXIT ; 15088000 - DEFINE FORMALNAME=[9:2]=2 #; 15089000 - J _ ELCLASS ; 15089010 - IF STEPI= ASSIGNOP THEN 15090000 - BEGIN STACKCT _ 1; %A 15091000 - XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. %116- 15091100 -L1: 15092000 - IF TALL.FORMALNAME THEN 15092020 - BEGIN 15093000 - EMITN(TALL.ADDRESS); 15094000 - IF T1!0 THEN BEGIN EMITO(DUP);EMITO(COC) END; 15095000 - END 15096000 - ELSE IF T1!0 THEN EMITV(TALL.ADDRESS) 15097000 - ; STACKCT _ REAL(T1!0); STEPIT; %A 15098000 - IF TALL.CLASS =BOOID THEN BEXP ELSE AEXP; 15099000 - EMITD(48-T2 ,T1 ,T2); 15100000 - IF TALL<0 THEN CLSMPMN(TALL,J>=BOOPROCID AND J<=INTPROCID) ; 15101000 - STACKCT _ 0; %A 15101500 - GT1 _ IF TALL.CLASS =INTID THEN IF P1= FS 15102000 - THEN ISD ELSE ISN ELSE 15103000 - IF P1 = FS THEN STD ELSE SND ; 15104000 - IF TALL.FORMALNAME THEN 15105000 - BEGIN EMITO(XCH); EMITO(GT1) END 15106000 - ELSE EMITPAIR(TALL.ADDRESS,GT1); 15107000 - END 15108000 - ELSE 15109000 - BEGIN 15110000 - IF ELCLASS= PERIOD THEN 15111000 - BEGIN IF DOTSYNTAX(T1,T2) THEN GO TO EXIT ; 15112000 - IF STEPI=ASSIGNOP THEN 15113000 - BEGIN %116- 15113100 - IF P1! FS THEN 15114000 - BEGIN %116- 15115000 - ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100 - GO TO EXIT; %116- 15115200 - END; %116- 15115300 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); %116- 15116000 - GO TO L1; %116- 15116100 - END; %116- 15116200 - %A 15117000 - END ; 15118000 - IF P1! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000 -COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000 - BY A LEFT ARROW OR PERIOD *; 15121000 -COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000 - LEFT-MOST OF A LEFT PART LIST *; 15123000 - EMITI(TALL,T1,T2); %A 15124000 - %A 15125000 - END ; 15126000 - EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000 - ELSE 15128000 - COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 15129000 - VARIABLES: 15130000 - 1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 15131000 - 2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 15132000 - 3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 15133000 - 4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 15134000 - 5. V[R] _ ,ASSIGNMENT TO ARRAY ELEMENT. 15135000 - 6. V[R].[S:L] _ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000 - R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 15137000 - IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 15138000 - IS EMITTED FOR THE ABOVE CASES: 15139000 - 1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 15140000 - DIMENSION. THE CODE EMITTED IS: 15141000 - VL,LOD . 15142000 - EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 15143000 - 2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS. 15144000 - EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE 15145000 - OF CODE: 15146000 - AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000 - ,LOD. 15148000 - FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 15149000 - PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 15150000 - THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000 - PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS, 15152000 - [* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000 - NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 15154000 - EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000 - EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A 15156000 - . THE SPECIFIC ROW DEPENDS UPON THE 15157000 - VALUES OF THE K-1 SUBSCRIPTS. 15158000 - FOR THE REMAINING CASES, 15159000 - SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 15160000 - HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000 - ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT. 15162000 - K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 15163000 - ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 15164000 - SUBSCRIPTS,IF K>1. 15165000 - AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 15166000 - AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 15167000 - EMITTED. 15168000 - 3. ADD THE SEQUENCE: 15169000 - IF FIRST SUBSCRIPT THEN VV ELSE COC. 15170000 - EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000 - 4. ADD THE SEQUENCE: 15172000 - IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL. 15173000 - XCH,T. 15174000 - 5. ADD THE SEQUENCE: 15175000 - IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000 - XCH,_. 15177000 - 6. ADD THE SEQUENCE: 15178000 - IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD. 15179000 - EXP,T, XCH,_. 15180000 - EXP,T,_,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 15181000 - SIMPLE VARIABLE BLOCK. ; 15182000 - BEGIN 15183000 - LABEL EXIT,LAST,NEXT ; 15184000 - INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100 - DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF 15185000 - DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000 - VARIABLE; 15187000 - DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000 - INDEX OF THE LAST ENTRY IN INFO 15189000 - FOR A MONITORED SUBSCRIPTED 15190000 - VARIABLE; 15191000 - DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX 15192000 - INTO INFO TO PICK OUT SPECIAL MONITOR 15193000 - INFORMATION; 15194000 - DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT 15195000 - POSITION OF THE SPECIAL MONITOR 15196000 - INFORMATION FOR SUBSCRIPTED 15197000 - VARIABLES; 15198000 - DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000 - EMIT AN OPDC OR LITC FOR PASSING 15200000 - THE SUBSCRIPTS FOR MONITORED 15201000 - SUBSCRIPTED VARIABLES.1 MEANS 15202000 - LITC, 0 MEANS OPDC; 15203000 - DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000 - BOUND WORD FROM INFO FOR MONITORED 15205000 - SUBSCRIPTED VARIABLES; 15206000 - DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000 - THE ADDRESS THAT WILL BE 15208000 - EMITTED IN AN OPDC OR LITC 15209000 - DEPENDING ON OPBIT; 15210000 - BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT 15211000 - IS SET TRUE IF THE VARIABLE IN 15212000 - TALL IS SPECIAL MONITORED. 15213000 -; 15214000 -PROCEDURE M4(TALL,J); 15215000 - VALUE TALL,J ; 15216000 - REAL TALL,J ; 15217000 - BEGIN STACKCT _ 1; %A 15217500 - IF J = 1 15218000 - THEN BEGIN COMMENT FIRST TIME AROUND; 15219000 - IF TALL < 0 15220000 - THEN BEGIN COMMENT TALL IS MONITORED; 15221000 - EMITV(JUNK); EMITO(XCH); 15222000 - END; 15223000 - EMITN(TALL.ADDRESS ) 15224000 - END 15225000 - ELSE BEGIN COMMENT NOT THE FIRST TIME AROUND; 15226000 - EMITO(CDC); 15227000 - IF TALL < 0 15228000 - THEN BEGIN COMMENT CALL SUBSCRIPT; 15229000 - EMITV(JUNK); EMITO(XCH); 15230000 - END; 15231000 - END; END; %A 15232000 - IF STEPI ! LFTBRKET THEN BEGIN ERR(207);GO TO EXIT END; 15233000 - THENUMBEROFDECLAREDDIMENSIONS _ TAKE(GIT(TALL)).[40:8]; 15233100 - J _ 0; 15234000 - STACKCT _ 0; %A 15234500 -COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 15235000 - IF P1 > FP THEN TALL _ ABS(TALL) ELSE 15236000 - IF TALL < 0 THEN 15237000 -COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 15238000 - BEGIN COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 15239000 - VARIABLE; 15240000 - EMITO(MKS); 15241000 - IF SPCLMON_TAKE(GIT(TALL)+1).SPMON ! 0 15242000 - THEN BEGIN COMMENT THIS IS SPECIAL MONITORED; 15243000 - TESTVARB_(NODIM_TAKE(INC_GIT(TALL)) 15244000 - .NODIMPART)+INC; 15245000 - DO IF BOOLEAN(LWRBND_TAKE(INC_INC+1)). 15246000 - OPBIT 15247000 - THEN EMITL(LWRBND,SPMONADR) 15248000 - ELSE EMITV(LWRBND,SPMONADR) 15249000 - UNTIL INC>= TESTVARB 15250000 - END; 15251000 - END; 15252000 - NEXT: IF STEPI = FACTOP THEN 15253000 - BEGIN 15254000 - STLB _ 1; 15254400 - WHILE TABLE(I+1) = COMMA DO 15254500 - BEGIN STEPIT; 15254600 - IF STEPI = FACTOP THEN STLB _ STLB+1 ELSE 15254700 - BEGIN ERR(204); GO TO EXIT END; 15254800 - END; 15254900 - IF J+STLB ! THENUMBEROFDECLAREDDIMENSIONS THEN 15255000 - BEGIN ERR(203);GO EXIT END; 15256000 -COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 15257000 - ROW DESIGNATOR DOES NOT MATCH THE ARRAY * 15258000 - DECLARATION. *; 15259000 - IF STEPI = RTBRKET THEN 15260000 - BEGIN ERR(204);GO EXIT END; 15261000 -COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *; 15262000 - IF P1 ! FA THEN 15262500 - IF STLB > 1 THEN FLAG(212) ELSE 15262600 - IF P1!FI AND P1!FL THEN 15263000 - IF P1 = FP AND REL THEN ELSE 15263050 - BEGIN ERR(205); GO TO EXIT; END; 15263100 -COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 15264000 - STATEMENT OR ACTUAL PARAMETER LIST. *; 15265000 - IF J=0 THEN 15266000 - EMITPAIR(TALL.ADDRESS,LOD); 15267000 -COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 15268000 - IF TALL < 0 THEN 15269000 - BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15270000 - EMITNUM(5&CARDNUMBER[1:4:44]); %109- 15271000 - EMITN(GNAT(PRINTI)); %109- 15271100 - END; 15272000 - IF P1 = FA THEN 15272900 - FOR X _ 1 STEP 1 UNTIL STLB DO 15273000 - BEGIN IF (Z_TAKE(GIT(TALL)+J+X)).[35:11] > 1023 15273100 - THEN EMITV(Z) ELSE EMIT(Z); 15273200 - IF Z.[23:10] = ADD THEN EMITO(CHS); 15273300 - END; 15273400 - STEPIT; 15274000 - GO TO EXIT; 15275000 - END OF ROW DESIGNATOR PORTION ; 15276000 - AEXP: 15277000 -COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 15278000 - IF TALL < 0 THEN EMITPAIR(JUNK,ISN); 15279000 - J _ J + 1; 15280000 - IF(GT1 _ TAKE( GIT(TALL)+ J)).[35:13] ! 0 THEN 15281000 - BEGIN 15282000 - IF GT1.[46:2] = 0 THEN EMIT(GT1) 15283000 - ELSE EMITV(GT1.[35:11]) ; 15284000 - EMIT(GT1.[23:12]); 15285000 - END OF LOWER BOUND ADJUSTMENT ; 15286000 - IF ELCLASS = COMMA THEN 15287000 - BEGIN 15288000 -COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15289000 - M4 (TALL,J); 15290000 - EMITO(LOD) ; 15291000 - IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 15291100 - BEGIN ERR(208); GO TO EXIT END; 15291200 - COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 15291300 - DECLARATION *; 15291400 - GO TO NEXT; 15292000 - END OF SUBSCRIPT COMMA HANDLER ; 15293000 - IF ELCLASS ! RTBRKET THEN BEGIN ERR(206);GO EXIT END; 15294000 -COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 15295000 - IF J ! THENUMBEROFDECLAREDDIMENSIONS THEN 15296000 - BEGIN ERR(208); GO TO EXIT END; 15297000 - 15298000 - 15299000 - STACKCT _ 0; %A 15299500 - IF STEPI = ASSIGNOP THEN 15300000 - BEGIN 15301000 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO 15301100 - % SUBSCRIPTED VARIABLE. %116- 15301200 -COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 15302000 - LAST: M4(TALL,J); 15303000 - IF T1= 0 THEN 15304000 - BEGIN IF P1= FR THEN GO TO EXIT END 15305000 - ELSE BEGIN EMITO(DUP); EMITO(COC) END; STEPIT; %WF 15306000 - IF TALL.CLASS = BOOARRAYID THEN BEXP ELSE AEXP ; 15307000 - EMITD(48-T2,T1,T2) ; 15308000 - EMITO(XCH); 15309000 -COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 15310000 - IF TALL < 0 15311000 - THEN BEGIN COMMENT STORE THE VALUE OF THE EXPRESSION 15312000 - IN JUNK AND CALL PRINTI, THEN RECALL THE 15313000 - VALUE FROM JUNK; 15314000 - EMITO( 15315000 - IF TALL.CLASS = INTARRAYID 15316000 - THEN ISN 15317000 - ELSE SND); 15318000 - IF P1 ! FS 15319000 - THEN EMITPAIR(JUNK,SND); 15320000 - EMITL(J); EMITL(PASSTYPE(TALL)); 15321000 - EMITPAIR(GNAT(POWERSOFTEN),LOD); 15322000 - PASSALPHA(TALL); EMITPAIR(GNAT( 15323000 - CHARI),LOD); PASSMONFILE(TAKE(GIT(TALL)). 15324000 - ARRAYMONFILE); 15325000 - EMITNUM((IF SPCLMON THEN 3 ELSE 2) %109- 15326000 - &CARDNUMBER[1:4:44]); %109- 15327000 - EMITV(GNAT(PRINTI)); %109- 15328000 - IF P1 ! FS 15329000 - THEN EMITV(JUNK); 15330000 - P1_0; GO TO EXIT; 15331000 - END; 15332000 - EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000 - IF P1 = FS TEHN ISD ELSE ISN ELSE 15334000 - IF P1=FS TEHN STD ELSE SND); 15335000 - P1_0 ; 15336000 - GO TO EXIT ; 15337000 - END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000 - IF ELCLASS=PERIOD THEN 15339000 - BEGIN 15340000 - IF DOTSYNTAX(T1,T2) THEN GO TO EXIT; 15341000 - IF STEPI = ASSIGNOP THEN %116- 15342000 - IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST %116- 15342100 - BEGIN %116- 15342200 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % PARTIAL 15342300 - % WORD ASSIGNMENT TO SUBSCR. VAR. 15342400 - GO TO LAST; %116- 15342500 - END %116- 15342600 - ELSE BEGIN ERR(209); GO EXIT END; 15343000 - IF J=1 THEN EMITV(TALL.ADDRESS)ELSE EMITO(COC); 15344000 - END 15345000 - ELSE 15346000 -COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 15347000 - BEGIN COMMENT MONITOR FUNCTION M10; 15348000 - SPCLMON_P1 = FP OR ELCLASS >=AMPERSAND; 15349000 - IF J = 1 15350000 - THEN IF SPCLMON 15351000 - THEN EMITV(TALL.ADDRESS) 15352000 - ELSE EMITN(TALL.ADDRESS) 15353000 - ELSE EMITO(IF SPCLMON 15354000 - THEN COC 15355000 - ELSE CDC); 15356000 - IF TALL < 0 15357000 - THEN BEGIN COMMENT DO NOT MONITOR AFTER ALL; 15358000 - EMITNUM(5&CARDNUMBER[1:4:44]); %109- 15359000 - IF SPCLMON 15360000 - THEN EMITV(GNAT(PRINTI)) 15361000 - ELSE EMITN(GNAT(PRINTI)) 15362000 - END; 15363000 - IF P1 =FS THEN ERR(210); 15364000 - IF P1 = FI THEN P1_0; 15364500 - GO TO EXIT; 15365000 - END; 15366000 - IF P1=FS THEN BEGIN ERR(210); GO TO EXIT END ; 15367000 -COMMENT 210 VARIABLE-MISSING LEFT ARROW OR PERIOD. *; 15368000 - IF T1!0 THEN BEGIN EMITI(0,T1,T2); 15369000 - IF P1!FI THEN P1_0; 15369100 - END; 15369200 - IF P1=FI THEN 15369300 - IF ELCLASS!COMMA AND ELCLASS!RTPAREN 15369400 - THEN SIMPARITH; 15369500 - IF P1=FI THEN P1_0;% 15369600 - %A 15370000 -COMMENT ***** MONITOR FUNCTION M9 ; 15371000 - IF TALL < 0 15372000 - THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000 - EMITNUM(5&CARDNUMBER[1:4:44]); %109- 15374000 - EMITV(GNAT(PRINTI)); %109- 15374100 - END ; 15375000 - EXIT: STACKCT _ 0 END OF SUBSCRIPTED BLOCK; %A 15376000 - EXIT : END OF THE VARIABLE ROUTINE; 15377000 -COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 16000000 - PROCEDURE STREAMSTMT ; 16001000 - BEGIN 16002000 - DEFINE LFTPAREN=LEFTPAREN#,LOC=[36:12]#,LASTGT=[24:12]#, 16003000 - LOCFLD=36:36:12#,LGTFLD=24:24:12#; 16004000 - DEFINE LEVEL=LVL#,ADDOP=ADOP#; 16005000 - DEFINE 16006000 - JFW = 39#, COMMENT 7,5,5,1 JUMP FORWARD UNCONDITIONAL ; 16007000 - RCA = 40#, COMMENT 7,5,7,6 RECALL CONTROL ADDRESS ; 16008000 - JRV = 47#, COMMENT 7,5,5,2 JUMP REVERSE UNCONDITIONAL ; 16009000 - CRF = 35#, COMMENT 7,5,10,6 CALL REPEAT FIELD ; 16010000 - BNS = 42#, COMMENT 7,5,5,5 BEGIN LOOP ; 16011000 - NOP = 1#, COMMENT ; 16012000 - ENS = 41#, COMMENT 7,5,5,6 END LOOP ; 16013000 - TAN = 30#, COMMENT 7,5,3,7 TEST FOR ALPHAMERIC ; 16014000 - BIT = 31#, COMMENT 7,5,3,8 TEST BIT ; 16015000 - JFC = 37#, COMMENT 7,5,5,3 JUMP FORWARD CONDITIONAL ; 16016000 - SFD = 06#, COMMENT 7,5,7,8 SET DESTINATION ADDRESS ; 16017000 - RSA = 43#, COMMENT 7,5,7,4 RECALL SOURCE ADDRESS ; 16018000 - TRP = 60#, COMMENT 7,5,2,2 TRANSFER PROGRAM CHARACTERS ; 16019000 - BSS = 3#, COMMENT 7,5,6,6 SKIP SOURCE BIT ; 16020000 - BSD = 2#, COMMENT 7,5,6,5 SKIP DESTINATION BITS ; 16021000 - SEC = 34#, COMMENT 7,5,10,1 SET COUNT ; 16022000 - JNS = 38#; COMMENT 7,5,5,7 JUMP OUT LOOP ; 16023000 - COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 16024000 - OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 16025000 - A VALUE = 0 AND THE JUMP>= 64 SYLLABLES A JFW 1 AND 16026000 - A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH 16027000 - MUST ALSO BE MANUFACTURED) IS EMITTED. ; 16028000 - PROCEDURE FIXC(S); VALUE S; REAL S; 16029000 - BEGIN 16030000 - REAL SAVL,D,F; 16031000 - SAVL_L; 16032000 -F_GET( S); 16033000 - IF D _ L -( L_S) -1<=63 THEN 16034000 - BEGIN 16035000 - IF F=BNS THEN 16036000 - BEGIN 16037000 - S_GET(L_L-1);EMIT(NOP);EMIT(NOP);EMIT(S);D_D-2; 16038000 - END; 16039000 - EMITC(D,F); L _ SAVL 16040000 - END 16041000 - ELSE BEGIN 16042000 - IF F!JFW THEN BEGIN 16043000 - EMITC(1,F); 16044000 - EMITC(1,JFW) END ; 16045000 - EMITC(PJ_PJ+1,RCA); 16046000 - L _ SAVL; 16047000 - ADJUST; 16048000 - LPRT _ PROGDESCBLDR(2,L,0); 16049000 - COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 16050000 - PUTNBUMP(0&(STLABIDx2+1) 16051000 - [2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000 - PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000 - PUTNBUMP(0); 16054000 - LASTINFO _ NEXTINFO-3; 16055000 - END; 16056000 - END FIXC ; 16057000 - COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 16058000 - THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS<= 63 16059000 - SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 16060000 - STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 16061000 - RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000 - INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000 - POINTING TO OUR LABEL IN QUESTION. ; 16064000 - PROCEDURE EMITJUMP( E); VALUE E; REAL E; 16065000 - BEGIN 16066000 - REAL T,D; 16067000 - REAL ADDR; 16068000 - IF ABS( 16069000 - D_(T_TAKE(GIT(E)).LOC)-L-1)>=64 THEN 16070000 - BEGIN 16071000 - IF ADDR_TAKE(E).ADDRESS=0 THEN 16072000 - BEGIN 16073000 - PUT(TAKE(E)&(ADDR_PJ_PJ+1)[16:37:11],E); 16074000 - LPRT _ PROGDESCBLDR(2,T,0); 16075000 - END ; 16076000 - EMITC(ADDR,RCA); 16077000 - 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 CODE 16081000 - ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 16082000 - TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000 - LINK IS = 4096. ; 16084000 - PROCEDURE JUMPCHAIN( E); VALUE E;REAL E; 16085000 - BEGIN 16086000 - REAL SAVL ,LINK; 16087000 - SAVL _ L; 16088000 - L _ TAKE(GIT(E)).LASTGT ; 16089000 - WHILE L! 4095 DO 16090000 - BEGIN 16091000 - LINK _ GET(L); 16092000 - EMITJUMP( E); 16093000 - L _ LINK 16094000 - END; 16095000 - L_SAVL; 16096000 - END JUMPCHAIN ; 16097000 - COMMENT NESTS COMPILES THE NEST STATEMENT. 16098000 - A VARIABLE NEST INDEX CAUSES THE CODE, 16099000 - CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000 - AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 16101000 - THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH<=63,OTHERWISE 16102000 - IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000 - RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000 - MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000 - JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 - NEST LEVEL INCREASED BY ONE. 16107000 - WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000 - THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000 - OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000 - ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000 - JUMPS. 16112000 - FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000 - AND JOINFO RESOTRED TO THEIR ORIGINAL VALUES. ; 16114000 - PROCEDURE NESTS; 16115000 - BEGIN 16116000 - LABEL EXIT; 16117000 - REAL JOINT,BNSFIX; 16118000 - IF ELCLASS!LITNO THEN 16119000 - BEGIN 16120000 - EMITC(ELBAT[I].ADDRESS,CRF); BNSFIX_ L; 16121000 - EMIT ( BNS); EMIT(NOP);EMIT(NOP); 16122000 - END 16123000 - ELSE EMITC(ELBAT[I].ADDRESS,BNS); 16124000 - IF STEPI ! LFTPAREN THEN BEGIN ERR(262); GO TO EXIT END; 16125000 - NESTLEVEL_NESTLEVEL + 1; 16126000 - JOINT _ JOINFO; 16127000 - JOINFO _ 0; 16128000 - DO BEGIN 16129000 - STEPIT; ERRORTOG _ TRUE; STREAMSTMT 16130000 - END UNTIL ELCLASS ! SEMICOLON ; 16131000 - IF ELCLASS ! RTPAREN THEN BEGIN ERR(262);GO TO EXIT END; 16132000 - EMIT ( ENS); 16133000 - IF JOINFO ! 0 THEN 16134000 - BEGIN 16135000 - COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 16136000 - ADJUST; 16137000 - PUT(TAKE(GIT(JOINFO))&L[LOCFLD],GIT(JOINFO)); 16138000 - JUMPCHAIN(TAKE(JOINFO)&JOINFO[35:35:13]); 16139000 - END; 16140000 - IF BNSFIX ! 0 THEN FIXC(BNSFIX); 16141000 - NESTLEVEL _ NESTLEVEL-1; 16142000 - JOINFO _ JOINT ; 16143000 - EXIT: END NESTS ; 16144000 - COMMENT LABELS HANDLES STREAM LABELS. 16145000 - ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 16146000 - WORD (IN THE PROGRAMSTREAM). 16147000 - IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 16148000 - THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 16149000 - [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 16150000 - HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 16151000 - MATCHES THE LEVEL OF THE LABEL. 16152000 - MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 16153000 - FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 16154000 - AND GET A PRT LOCATION FOR ANY JUMPS>=64 SYLLABLES. ; 16155000 -PROCEDURE LABELS; 16156000 - BEGIN 16157000 - ADJUST; 16158000 - GT1 _ ELBAT[I]; 16159000 - XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF %116- 16159100 - IF STEPI ! COLON THEN ERR(258) 16160000 - ELSE 16161000 - BEGIN 16162000 - IF TAKE(GT2_GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000 - IF GT1>0 THEN 16164000 - BEGIN 16165000 - PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000 - PUT(-L,GT2) 16167000 - END 16168000 - ELSE 16169000 - BEGIN 16170000 - IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000 - PUT((-L)&TAKE(GT2)[LGTFLD].GT2); 16172000 - JUMPCHAIN(GT1); 16173000 - END; 16174000 - END 16175000 - ; STEPIT; 16176000 - END LABELS ; 16177000 - COMMENT IFS COMPILES IF STATEMENTS. 16178000 - FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000 - CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000 - THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000 - IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR, OTHERWISE 16182000 - THE CODE IS EMITTED STRAIGHTAWAY. 16183000 - A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000 - "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000 - SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000 - TO BE GENERATED. 16187000 - THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000 - IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000 - IF THEN GO TO L1 ELSE GO TO L2 ; 16190000 - PROCEDURE IFS; BEGIN 16191000 - DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000 - LABEL IFSB,IFTOG,IFSC,EXIT; 16193000 - SWITCH IFSW _ IFSB,IFTOG,IFSC; 16194000 - REAL ADDR,FIX1,FIX2 ; 16195000 - ADDR_1 ; 16196000 - GO TO IFSW[STEPI -SBV+1] ; 16197000 - IF ELCLASS=LOCLID THEN 16198000 - BEGIN 16199000 - EMITC(ELBAT[I],ADDRESS,CRF); 16200000 - ADDR_0; 16201000 - END 16202000 - ELSE 16203000 - IF ELCLASS=LITNO THEN ADDR _ ELBAT[I].ADDRESS 16204000 - ELSE BEGIN ERR(250); GO TO EXIT END; 16205000 - IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000 -IFSC: 16207000 - IF STEPI!RELOP THEN BEGIN ERR(264);GO EXIT END; 16208000 - IF STEPI=DCV THEN EMITC(ADDR,ELBAT[I-1],COMPARECODE) 16209000 - ELSE IF ELCLASS=STRNGCON THEN 16210000 - BEGIN 16211000 - IF ACCUM[1].[12:6]!1 OR ELBAT[I-3].CLASS!IFV THEN 16211100 - BEGIN ERR(271); GO EXIT END 16211200 - ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 - END 16211400 - ELSE IF ELCLASS=LOCLID THEN 16212000 - BEGIN 16212100 - IF ELBAT[I-3].CLASS!IFV THEN 16212200 - BEGIN ERR(271); GO EXIT END 16212300 - ELSE BEGIN 16212400 - EMITC(0,ELBAT[I-1].TESTCODE); % RESET TFFF. 16212500 - EMITC(ELBAT[I].ADDRESS,CRF); 16212600 - EMITC(0,ELBAT[I-1].TESTCODE); % COMPARE. 16212700 - END 16212800 - END 16212900 - ELSE IF ACCUM[1]!"5ALPHA" THEN 16213000 - BEGIN ERR(265);GO EXIT END 16213100 - ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 - ELSE BEGIN FLAG(270); ERRORTOG:=TRUE END; 16214100 - GO IFTOG; 16215000 -IFSB: EMITC(1,BIT); 16216000 -IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000 - FIX1 _ L; 16218000 - EMIT(JFC); 16219000 - STEPIT; 16220000 - IF ELCLASS = BEGINV OR 16221000 - ELCLASS = IFV OR 16222000 - ELCLASS = LITNO OR 16223000 - ELCLASS = STLABID OR 16224000 - ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000 - BEGIN 16226000 - EMIT (NOP); EMIT (NOP) 16227000 - END; 16228000 - IF ELCLASS= ELSEV THEN ELSE 16228500 - STREAMSTMT; 16229000 - IF ELCLASS= ELSEV THEN 16230000 - BEGIN 16231000 - FIX2 _ L; EMIT(JFW); 16232000 - FIXC(FIX1); 16233000 - STEPIT; 16234000 - STREAMSTMT; 16235000 - FIXC(FIX2); 16236000 - END 16237000 - ELSE FIXC(FIX1); 16238000 - EXIT:END IFS ; 16239000 - COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000 - STATEMENTS. 16241000 - IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000 - AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS>=64 SYLLABL 16243000 - ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000 - GO TOS IN THE CASE OF FORWARD JUMPS. 16245000 - FIRNALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000 - AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000 - BE JUMPED OUT, OTHERWISE,NEST LEVEL IS DEFINED. ; 16248000 - PROCEDURE GOTOS; 16249000 - BEGIN 16250000 - LABEL EXIT; 16251000 - IF STEPI !TOV THEN I_I-1 ; 16252000 - IF STEPI ! STLABID THEN BEGIN ERR(260); GO TO EXIT END; 16253000 - IF(GT2_TAKE(GIT(GT1_ELBAT[I]))).MON=1 16254000 - OR GT2.LOC!0 THEN EMITJUMP(GT1) 16255000 - ELSE 16256000 - BEGIN PUT(0&L[24:36:12],GIT(GT1)); 16257000 - IF GT1>0 THEN 16258000 - BEGIN 16259000 - PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEBEL)[11:43:5]),GT1); 16260000 - EMITN(1023); 16261000 - END 16262000 - ELSE 16263000 - BEGIN 16264000 - IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257); 16265000 - EMIT(GT2,LASTGT); 16266000 - END; 16267000 - END; 16268000 - JUMPLEVEL_0 ; 16269000 - EXIT: END GOTOS ; 16270000 - COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000 - THE CODE GENERATED IS : 16272000 - SED FILE 16273000 - RSA 0. 16274000 - AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000 - INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000 - BY THE DESTINATION ADDRESS. 16277000 - THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000 - THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 16279000 - MUST BE PASSED FOR THIS FORMAL PARAMETER; 16280000 -PROCEDURE RELEASES; 16281000 - IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000 - (GT1_ELBAT[I-1]).FORMAL=0 16283000 - THEN ERR(256) ELSE 16284000 - BEGIN 16285000 - EMITC( GT1.ADDRESS,SED); 16286000 - EMIT(FILETHING); FILETHING_L-1; 16287000 - INFO[GT1.LINKR,GT1.LINKC].MON _ 1; 16288000 - END RELEASES; 16289000 - COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 16290000 - OR LOCALIDS . 16291000 - THREE CASES PRESENT THEMSELVES, 16292000 - LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 16293000 - CASE I LOCLID _ X 16294000 - CASE II X _ X ... 16295000 - CASE III X _ EITHER LOC,LOCLID,SC OR DC. 16296000 - THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 16297000 - CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS 16298000 - THE CODE TO BE EMITTED. 16299000 - EACH ELEMENT OF MACRO HAS 1-3 SYLLABES ORDERED FROM 16300000 - RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 16301000 - MAY REQUIRE AT MOST ONE REPEAT PART. 16302000 - IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 16303000 - PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE' IS 16304000 - ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 16305000 - ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 16306000 - USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 16307000 - THE PROPER ADDRESS AND OPERATOR . 16308000 - NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 16309000 - ERROR. ; 16310000 -PROCEDURE INDEXS; 16311000 - BEGIN 16312000 - LABEL EXIT,GENERATE,L,L1; 16313000 - INTEGER TCLASS,INDEX,ADDR,J; 16314000 - TCLASS _ ELCLASS ; 16315000 - IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16316000 - IF TCLASS = LOCLID THEN 16317000 - BEGIN 16318000 - XMARK(ASSIGNREF); %116- 16318500 - IF SIV>STEPI OR ELCASS>TALLYV THEN GO TO L; 16319000 - INDEX _ 32 + ELCLASS-SIV; 16320000 - ADDR _ ELBAT[I-2].ADDRESS; 16321000 - GO TO GENERATE; 16322000 - END; 16323000 - IF TCLASS = STEPI THEN 16324000 - BEGIN 16325000 - IF STEPI!ADDOP THEN BEGIN ERR(252); GO EXIT END ELSE 16326000 - IF STEPI!LITNO AND ELCLASS!LOCLID THEN 16326100 - BEGIN ERR(253); GO EXIT END; 16327000 - INDEX _ TCLASS-SIV 16328000 - +REAL(ELBAT[I-1].ADDRESS=SUB) x 4 16329000 - + REAL(ELCLASS =LOCLID) x 8; 16330000 - END 16331000 - ELSE 16332000 - BEGIN 16333000 - INDEX _ TCLASS -SIV 16334000 - + ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000 - IF ELCLASS = LOCV THEN 20 ELSE 16336000 - IF ELCLASS = SCV THEN 24 ELSE 16337000 - IF ELCLASS= DCV THEN 28 ELSE 25); 16338000 - IF ELCLASS = LOCV THEN 16339000 - IF STEPI ! LOCLID THEN GO TO L; 16340000 - IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000 - BEGIN EMITC(ELBAT[I].ADDRESS,SEC); GO TO EXIT END; 16342000 - END ; 16343000 - ADDR _ ELBAT[I].ADDRESS; 16344000 - GENERATE: 16345000 - IF MACRO[INDEX]= 0 THEN 16346000 - L: BEGIN ERR(250); GO TO EXIT END; 16347000 - J _ 8; TCLASS _0 ; 16348000 - L1: MOVECHARACTERS(2,MACRO[INDEX],J_J-2,TCLASS,6 ); 16349000 - IF TCLASS!0 THEN 16350000 - BEGIN 16351000 - EMITC(IF TCLASS>=64 THEN ADDR ELSE 0,TCLASS); 16352000 - GO TO L1 16353000 - END; 16354000 - EXIT:END INDEXS ; 16355000 - COMMENT DSS COMPILES DESINTATION STREAM STATEMENTS. 16356000 - DS_ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 16357000 - STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 16358000 - NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 16359000 - ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 16360000 - THE OPCODE FIELD ; 16361000 -PROCEDURE DSS; 16362000 - BEGIN 16363000 - INTEGER ADDR,J,K,L,T; 16364000 - LABEL EXIT,L1; 16365000 - DEFINE OPCODE=[27:16]#; 16366000 - IF STEPI!= ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000 - IF STEPI = LOCLID THEN 16368000 - BEGIN 16369000 - EMITC(ELBAT[I],ADDRESS,CRF); 16370000 - ADDR_ 0; 16371000 - IF STEPI = LITV THEN GO TO L1 16372000 - END 16373000 - ELSE IF ELCLASS= LITNO THEN 16374000 - BEGIN 16375000 - ADDR _ ELBAT[I].ADDRESS; STEPIT ; 16376000 - END 16377000 - ELSE ADDR _ 1 ; 16378000 - IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN %A 16379000 - EMITC(ADDR,ELBAT[I],OPCODE) %A 16379500 - ELSE 16380000 - IF ELCLASS = LITV THEN 16381000 - BEGIN 16382000 - EMITC(ADDR,TRP); 16383000 - IF STEPI!=STRING AND ELCLASS!=STRNGCON AND %111- 16384000 - ELCLASS!= LITNO AND ELCLASS!= NONLITNO THEN %111- 16384100 - BEGIN ERR(255); GO TO EXIT END; 16384500 - IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN %111- 16384700 - MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800 - C,8-COUNT,ACCUM[1],3); %111- 16384900 - IF ADDR MOD 2!= 0 THEN 16385000 - BEGIN 16386000 - EMIT(ACCUM[1],[18:6]); j _ 1; 16387000 - END ; 16388000 - FOR K _J+2 STEP 2 UNTIL ADDR DO 16389000 - BEGIN 16390000 - FOR L _6,7 DO 16391000 - MOVECHARACTERS(1,ACCUM[1],2+(IF J_J+1>COUNT THEN J-1 16392000 - ELSE J),T,L ); 16393000 - EMIT(T); 16394000 - END END 16395000 - ELSE 16396000 - L1: ERR(250); 16397000 - EXIT:END DSS ; 16398000 - COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000 - IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000 - A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000 - OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000 -PROCEDURE SKIPS ; 16403000 - BEGIN 16404000 - REAL ADDR; 16405000 - IF STEPI = LOCLID THEN 16406000 - BEGIN 16407000 - EMITC(ELBAT[I],ADDRESS,CRF); ADDR_0; STEPIT; 16408000 - END 16409000 - ELSE IF ELCLASS = LITNO THEN 16410000 - BEGIN 16411000 - ADDR_ ELBAT[I].ADDRESS; STEPIT 16412000 - END 16413000 - ELSE ADDR _ 1 ; 16414000 - IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000 - ELSE 16416000 - IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000 - ELSE ERR(250); 16418000 - END SKIPS ; 16419000 - COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000 - JUMP OUT TO STATEMENTS CAUSE JUMP LEBEL TO BE SET TO 16421000 - THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 16422000 - JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 16423000 - JUMP INSTRUCTION. 16424000 - SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000 - A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 16426000 - THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 16427000 - UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000 - THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING 16429000 - 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 - ELSE BEGIN 16436000 - IF ELCLASS!=TOV AND ELCLASS!=STLABID THEN 16437000 - BEGIN 16438000 - COMMENT SIMPLE JUMP OUT STATEMENT; 16439000 - IF JOINFO = 0 THEN 16440000 - BEGIN 16441000 - JOINFO _ NEXTINFO ; 16442000 - PUTNBUMP(0&(STLABIDx2+1) 16443000 - [2:40:8]&2[27:40:8 ]); 16444000 - PUTNBUMP(0&(JOINFO-LASTINFO )[ 4:40:8]); 16445000 - PUTNBUMP (0); 16446000 - LASTINFO _ JOINFO; 16447000 - END; 16448000 - ELBAT[I_ I-1]_ TAKE(JOINFO)&JOINFO[35:35:13]; 16449000 - END; I_I-1 ; 16450000 - END; 16451000 - FOR GT1_1 STEP 1 UNTIL JUMPLEVEL DO 16452000 - EMIT( JNS); 16453000 - GOTOS; 16454000 - END JUMPS; 16455000 - COMMENT STREAMSTMT ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE 16456000 - THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 16457000 - THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 16458000 - IDENTIFIED BY PROCEDURE ENVOKED 16459000 - END GO TO FINI 16460000 - SEMICOLON GO TO FINI 16461000 - ) GO TO FINI 16462000 - IF IFS 16463000 - GO GOTOS 16464000 - RELEASE RELEASES 16465000 - BEGIN COMPOUNDTAIL 16466000 - SI,DI,CI,TALLY,LOCALID INDEXS 16467000 - DS DSS 16468000 - SKIP SKIPS 16469000 - JUMP JUMPS 16470000 - LABELID LABELS 16471000 - LITERAL NO.,LOCALID( NESTS 16472000 - UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO 16473000 - THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 16474000 - LABEL L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,EXIT,FINI,START; 16475000 - SWITCH TYPE + FINI,L,FINI,L3,L4,L5,L6,L7,L7,L7,L7,L8,L9,L10; 16476000 - START: GO TO TYPE[ ELCLASS-ENDV+1]; 16477000 - IF ELCLASS= RTPAREN THEN GO TO FINI ; 16478000 - IF ELCLASS = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 - = LFTPAREN THEN GO TO L1; 16480000 - IF ELCLASS= STLABID THEN GO TO L2 ; 16481000 - IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000 - L: ERR( 250 ); GO TO FINI ; 16483000 - L1: NESTS; GO TO EXIT; 16484000 - L2: LABELS; GO TO START; 16485000 - L3: IFS; GO TO FINI; 16486000 - L4: GOTOS; GO TO EXIT; 16487000 - L5: RELEASES; GO TO EXIT; 16488000 - L6: I_I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000 - L7: INDEXS; GO TO EXIT; 16490000 - L8: DSS; GO TO EXIT; 16491000 - L9: SKIPS; GO TO EXIT; 16492000 - L10: JUMPS; GO TO EXIT; 16493000 - EXIT: STEPIT; 16494000 - FINI: END STREAMSTMT; 16495000 - 16496000 - TIME1 _ TIME(1); PROGRAM; 17000000 - ENDOFITALL: 17000100 -IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN %116- 17001000 - BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ=<=#; %DFB 17002000 - DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], %116- 17002005 - ((INDEX).CF DIV 2).LINKC]#, %116- 17002006 - CF = [33:15]#, %116- 17002007 - FF = [18:15]#, %116- 17002008 - NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF 17002009 - ELSE XREFINFO[INDEX].CF)#; %116- 17002010 - ARRAY TIMINGS[0:2,0:3]; %116- 17002012 - PROCEDURE SAVETIMES(I); %116- 17002015 - VALUE I; INTEGER I; %116- 17002020 - BEGIN %116- 17002025 - INTEGER J; %116- 17002030 - FOR J := 1 STEP 1 UNTIL 3 DO %116- 17002035 - TIMINGS[I,J] := TIME(J); %116- 17002040 - END; %116- 17002045 - PROCEDURE UPDATETIMES(I); %116- 17002050 - VALUE I; INTEGER I; %116- 17002055 - BEGIN %116- 17002060 - INTEGER J; %116- 17002065 - FOR J := 1 STEP 1 UNTIL 3 DO %116- 17002070 - TIMINGS[I,J] := TIME(J) - TIMINGS[I,J]; %116- 17002075 - END; %116- 17002080 - WRITE(LINE[PAGE]); 17002520 - SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. %116- 17002525 - LASTADDRESS_0; 17002530 - FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000 - WRITE(DSK2,30,XREFAY2[*]); %DFB 17004000 - TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. %116- 17004500 - XREFPT_XLUN_0; %DFB- 17004600 - FOR I:= 0 STEP 1 UNTIL 8191 DO %116- 17004700 - XREFINFO[I] := 0; %116- 17004710 - BEGIN %DFB 17005000 - BOOLEAN PROCEDURE INPUT1(A); %DFB 17006000 - ARRAY A[0]; %DFB 17007000 - BEGIN %DFB 17008000 - LABEL L,EOF; %DFB 17009000 - READ(DSK1,10,A[*])[EOF]; %DFB 17010000 - GO TO L; %DFB 17011000 - EOF: INPUT1:=TRUE; %DFB 17012000 - REWIND(DSK1); %DFB 17013000 - L: %DFB 17014000 - END; %DFB 17015000 - PROCEDURE OUTPUT1(B,A); %DFB 17016000 - VALUE B; %DFB 17017000 - BOOLEAN B; %DFB 17018000 - ARRAY A[0]; %DFB 17019000 - BEGIN %DFB 17020000 - IF B THEN %DFB 17021000 - BEGIN %116- 17022000 - REWIND(DSK1); %116- 17022100 - UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 17022200 - TIMINGS[0,0] := XLUN; % NUMBER OF IDENTIFIERS SORTED. 17022300 - END %116- 17022400 - ELSE %DFB 17023000 - BEGIN %DFB 17024000 - IF BOOLEAN(A[8]) THEN %116- 17025000 - XREFINFO[A[8]].FF := XLUN := XLUN + 1 %116- 17025100 - ELSE %116- 17025200 - XREFINFO[A[8]].CF := XLUN := XLUN + 1; %116- 17025300 - A[8].IDNOF := XLUN; %116- 17025400 - WRITE(DSK1,10,A[*]); %DFB 17026000 - END; %DFB 17027000 - END; %DFB 17028000 - BOOLEAN STREAM PROCEDURE COMPS1(A,B); %DFB 17029000 - BEGIN %DFB 17030000 - SI:=A; %DFB 17031000 - DI:=B; %DFB 17032000 - IF 63 SC < DC THEN %116- 17033000 - TALLY := 1 %116- 17033100 - ELSE %116- 17033200 - BEGIN %116- 17033300 - SI := A; %116- 17033400 - DI := B; %116- 17033500 - IF 63 SC = DC THEN %116- 17033600 - TALLY := 2; %116- 17033700 - END; %116- 17033800 - COMPS1:=TALLY; %DFB 17034000 - END; %DFB 17035000 - STREAM PROCEDURE HVS1(A); %DFB 17036000 - BEGIN %DFB 17037000 - DI:=A; %DFB 17038000 - DS:=8 LIT "9"; %DFB 17039000 - SI:=A; %DFB 17040000 - DS:= 7 WDS; %DFB 17041000 - DS := 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS %116- 17041100 - END; %DFB 17042000 - BOOLEAN PROCEDURE COMP1(A,B); %DFB 17042100 - ARRAY A,B[0]; %DFB 17042200 - IF REAL(COMP1:=COMPS1(A,B)) = 2 THEN % IDS EQUAL %116- 17042300 - COMP1 := A[8].IDNOF < B[8].IDNOF; %116- 17042350 - PROCEDURE HV1(A); %DFB 17042400 - ARRAY A[0]; %DFB 17042500 - HVS1(A); %DFB 17042600 - XLUN:=0; %DFB 17043000 - REWIND(DSK1); %DFB 17044000 - SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN %116- 17045000 - 7000 ELSE 10000); %116- 17045100 - END; %DFB 17046000 - BEGIN %DFB 17047000 - 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 FWDSFQNO; %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 - PROCEDURE PRINTXREFSTATISTICS; %116- 17053300 - BEGIN %116- 17053400 - SWITCH FORMAT STATS := %116- 17053500 - (///, "CROSS REFERENCE STATISTICS", /, %116- 17053600 - "----- --------- ----------", /), %116- 17053700 - ("PHASE ONE - SORT",I6," IDENTIFIERS"), %116- 17053800 - ("PHASE TWO - SORT",I7," REFERENCES"), %116- 17053900 - ("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), %116- 17054000 - (X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), %116- 17054100 - (X5,I4,":",2I1," PROCESSOR TIME"), %116- 17054200 - (X5,I4,":",2I1," I/O TIME",/); %116- 17054300 - INTEGER I,J,K; %116- 17054400 - WRITE(LINE,STATS[0]); %116- 17054500 - FOR I := 0 STEP 1 UNTIL 2 DO %116- 17054600 - BEGIN %116- 17054700 - WRITE(LINE,STATS[I+1],TIMINGS[I,0]); %116- 17054800 - FOR J := 1 STEP 1 UNTIL 3 DO %116- 17054900 - BEGIN %116- 17055000 - K := (TIMINGS[I,J] + 30) DIV 60; % ROUND TO NEAREST SECON 17055010 - WRITE(LINE,STATS[J+3],K DIV 60,(K:=K MOD 60) DIV 10,%116- 17055020 - K MOD 10); %116- 17055025 - END; %116- 17055030 - END; %116- 17055100 - END PRINTXREFSTATISTICS; %116- 17055200 - DEFINE REFCOUNT = TIMINGS[1,0]#; % NUMBER OF REFERENCES SORTED. 17069300 - BOOLEAN FIRSTTIME; % TRUE ON FIRST CALL OF OUTPUT PROCEDURE. 17069400 - ARRAY PAY[0:17]; %DFB 17069500 - REAL LASTADDRESS; %116- 17069600 - BOOLEAN PROCEDURE INPUT2(A); %DFB 17070000 - ARRAY A[0]; %DFB 17071000 - BEGIN %DFB 17072000 - LABEL L,EOF; %DFB 17073000 - DEFINE I = LASTADDRESS#; %116- 17073100 - IF XREFPT:=XREFPT+1=30 THEN %DFB 17074000 - BEGIN %DFB 17075000 - READ(DSK2,30,XREFAY2[*])[EOF]; %DFB 17076000 - XREFPT:=0; %DFB 17077000 - END; %DFB 17078000 - IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF; 17079000 - A[0] := I & NEWID[I,REFIDNOF] REFIDNOF; %116- 17080000 - REFCOUNT := REFCOUNT + 1; %116- 17080100 - GO TO L; %DFB 17081000 - EOF: INPUT2:=TRUE; %DFB 17082000 - BLANKET(PAY); %DFB 17083000 - XREFAY1[8] := XREFPT := LASTADDRESS := 0; %116- 17084000 - FILL IDTYPE[*] WITH %116- 17084010 - "UNKNOWN. ", % 0 %116- 17084020 - "STREAM LABEL. ", % 1 %116- 17084030 - "STREAM VARIABLE. ", % 2 %116- 17084040 - "DEFINE. ", % 3 %116- 17084050 - "LIST. ", % 4 %116- 17084060 - "FORMAT. ", % 5 %116- 17084070 - "SWITCH FORMAT. ", % 6 %116- 17084080 - "FILE. ", % 7 %116- 17084090 - "SWITCH FILE. ", % 8 %116- 17084100 - "SWITCH LABEL. ", % 9 %116- 17084110 - "PROCEDURE. ", % 10 %116- 17084120 - "INTRINSIC. ", % 11 %116- 17084130 - "STREAM PROCEDURE. ", % 12 %116- 17084140 - "BOOLEAN STREAM PROCEDURE. ", % 13 %116- 17084150 - "REAL STREAM PROCEDURE. ", % 14 %116- 17084160 - "ALPHA STREAM PROCEDURE. ", % 15 %116- 17084170 - "INTEGER STREAM PROCEDURE. ", % 16 %116- 17084180 - "BOOLEAN PROCEDURE. ", % 17 %116- 17084182 - "REAL PROCEDURE. ", % 18 %116- 17084184 - "ALPHA PROCEDURE. ", % 19 %116- 17084186 - "INTEGER PROCEDURE. ", % 20 %116- 17084188 - "BOOLEAN. ", % 21 %116- 17084190 - "REAL. ", % 22 %116- 17084200 - "ALPHA. ", % 23 %116- 17084210 - "INTEGER. ", % 24 %116- 17084220 - "BOOLEAN ARRAY. ", % 25 %116- 17084230 - "REAL ARRAY. ", % 26 %116- 17084240 - "ALPHA ARRAY. ", % 27 %116- 17084250 - "INTEGER ARRAY. ", % 28 %116- 17084260 - "LABEL. ", % 29 %116- 17084270 - "FAULT. ", % 30 (CLASS = 125) %117- 17084275 - "SWITCH LIST. ", % 32 (CLASS = 126) %117- 17084280 - "SWITCH LIST. "; % 31 (CLASS = 127) %117- 17084290 - L: %DFB 17085000 - END; %DFB 17086000 - PROCEDURE OUTPUT2(B,A); %DFB 17087000 - VALUE B; %DFB 17088000 - BOOLEAN B; %DFB 17089000 - ARRAY A[0]; %DFB 17090000 - BEGIN DEFINE PRINTER=LINE#; %DFB 17091000 - LABEL EOF2, SKIP; %116- 17091100 - OWN BOOLEAN B2, FWDTOG, LBLTOG, WAITINGFORFWDREF; %116- 17091110 - DEFINE MATCH(A,B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = %116- 17091115 - REAL(NOT FALSE)#; %116- 17091116 - REAL I; %116- 17091120 - DEFINE LINECOUNT = TIMINGS[2,0]#; % NUMBER OF LINES PRINTED. 17091140 - OWN REAL FWDSEQNO; %116- 17091150 - IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. %116- 17091155 - BEGIN %116- 17091160 - FIRSTTIME := FALSE; %116- 17091162 - TIME1 := TIME(1); %116- 17091165 - DATIME; %116- 17091170 - UPATETIMES(1); %116- 17091175 - SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. %116- 17091180 - END; %116- 17091200 - IF NOT B2 THEN %116- 17091210 - IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. %116- 17091300 - IF XREFPT!= 0 THEN % WE GOT SOME TO LIST OUT %116- 17091400 - BEGIN %116- 17091500 - WRITE(LINE[DBL],15,PAY[*]); %116- 17091510 - LINECOUNT := LINECOUNT + 1; %116- 17091520 - END %116- 17091530 - ELSE % NOTHING TO LIST OUT %116- 17091600 - ELSE % NOT END OF SORT %116- 17091700 - IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF!= 0 AND 17091800 - A[0].REFIDNOF>= XREFAY1[8].IDNOF THEN %116- 17091900 - IF A[0].TYPEREF = FORWARDREF THEN % %116- 17092000 - WAITINGFORFWDREF := TRUE %116- 17092100 - ELSE %116- 17092200 - IF A[0].TYPEREF = LBLREF THEN % %116- 17092300 - BEGIN %116- 17092400 - LBLTOG := TRUE; %116- 17092500 - FWDSEQNO := A[0].SEQNOF; %116- 17092600 - END %116- 17092700 - ELSE %116- 17092800 - IF A[0].TYPEREF = DECLREF THEN %116- 17092900 - IF WAITINGFORFWDREF THEN % THIS MUST BE IT %116- 17093000 - BEGIN %116- 17093100 - WAITINGFORFWDREF := FALSE; %116- 17093200 - FWDTOG := TRUE; %116- 17093300 - FWDSEQNO := A[0].SEQNOF; %116- 17093400 - END %116- 17093500 - ELSE % ITS A NORMAL DECLARATION - NOT FORWARD%116- 17093600 - BEGIN %116- 17093700 - IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN %116- 17093850 - DO %116- 17093900 - READ(DSK1,10,XREFAY1[*]) [EOF2] %116- 17093950 - UNTIL %116- 17094000 - A[0].REFIDNOF<= XREFAY1[8].IDNOF; %116- 17094050 - IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN%116- 17094100 - GO TO SKIP; %116- 17094150 - IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200 - BEGIN %116- 17094240 - IF SINGLTOG THEN %116- 17094250 - WRITE(LINE,15,PAY[*]) %116- 17094300 - ELSE %116- 17094350 - WRITE(LINE[DBL],15,PAY[*]); %116- 17094400 - LINECOUNT := LINECOUNT + 1; %116- 17094410 - END %116- 17094420 - ELSE %116- 17094450 - IF NOT SINGLTOG THEN %116- 17094500 - WRITE(LINE); %116- 17094550 - XREFPT := 0; %116- 17094600 - BLANKET(PAY[*]); %116- 17094650 - SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8], 17094700 - SEGNOF,A[0],SEQNOF,FWDTOG,LBLTOG, %116- 17094800 - FWDSEQNO.IDTYPE[(IF (I := %116- 17094900 - XREFAY1[9].CLASS)>= FIELDID THEN %117- 17095000 - (IDMAX + I - FIELDID + 1) ELSE %117- 17095100 - IF I > IDMAX THEN 0 ELSE I) 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 - ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 17096600 - ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 17096700 - EOF2: B2 := TRUE; % SO SORT CAN GO TO NORMAL EOJ %116- 17096800 - IF NOT B THEN SKIP: LASTADDRESS := A[0]; %116- 17096850 - END OF OUTPUT2; %116- 17096900 - PROCEDURE HV2(A); %DFB 17112000 - ARRAY A[0]; %DFB 17113000 - A[0] := 3"777777777777777"; % BIGGEST FLOATING PT. NO. %116- 17114000 - BOOLEAN PROCEDURE COMP2(A,B); %DFB 17115000 - ARRAY A,B[0]; %DFB 17116000 - COMP2 := IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 17117000 - TRUE %116- 17117100 - ELSE %116- 17117200 - IF A[0].REFIDNOF = B[0].REFIDNOF THEN %116- 17117300 - IF A[0].[1:4] LSS B[0].[1:4] THEN %116- 17117400 - TRUE %116- 17117500 - ELSE %116- 17117600 - IF A[0].[1:4] = B[0].[1:4] THEN %116- 17117700 - IF A[0].SEQNOF < B[0].SEQNOF THEN %116- 17117702 - TRUE %116- 17117704 - ELSE %116- 17117706 - IF A[0].SEQNOF = B[0].SEQNOF THEN%116- 17117708 - BOOLEAN(A[0].[5:1]) %116- 17117710 - ELSE %116- 17117712 - FALSE %116- 17117714 - ELSE %116- 17117720 - FALSE %116- 17117730 - ELSE %116- 17117800 - FALSE; %116- 17117900 - SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT %116- 17117910 - FIRSTTIME := TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 17117920 - XREFPT:=20; REWIND(DSK2); %DFB 17118000 - SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,6000); %116- 17119000 - UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE%116- 17119100 - PRINTXREFSTATISTICS; %116- 17119200 - END; %DFB 17120000 - END; %DFB 17121000 - END OF MAIN BLOCK; 17121500 - END. %DFB 17122000 -%NUMBER OF ERRORS DETECTED = 1. COMPILATION TIME = 532 SECONDS. 99990000 -%NUMBER OF CARD-IMAGES PROCESSED = 12712. 99991000