diff --git a/tools/NEATUP55.alg_m b/tools/NEATUP55.alg_m new file mode 100644 index 0000000..d0612cb --- /dev/null +++ b/tools/NEATUP55.alg_m @@ -0,0 +1,2102 @@ + $ VERSION 31.000.001 0000010081/10/14.1 + $ SET LINEINFO 0000020081/10/14.1 + $ SET LEVEL 2 0000030081/10/14.1 +PROCEDURE NEATUP(PARA); 0000100076/07/14 +ARRAY 0000200076/07/14 + PARA[*]; 0000300076/07/14 +BEGIN 00004000 + $ SET OMIT 0000495081/10/14.1 + SRCE/NEATUP55 00005000120323PK + 0000600081/10/14.1 +MODIFICATION LOG. 0000601081/10/14.1 +----------------- 0000602081/10/14.1 +2012-03-23 P.KIMPEL 00006030120323PK + CLONE "NEATUP55" VERSION FROM CURRENT E-MODE MCP VERSION TO PREPARE 00006040120323PK + B5500 ALGOL SOURCE FILES FOR CROSS-COMPILING ON E-MODE. 00006050120323PK + 0000790081/10/14.1 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%0000791081/10/14.1 +% %0000792081/10/14.1 +% DOCUMENTATION %0000793081/10/14.1 +% 12/1/75 %0000794081/10/14.1 +% NEATUP/ALGOL %0000795081/10/14.1 +% %00008000 +% FILES: %00009000 +% AN INPUT FILE WITH THE NAME "INPUT" AND AN OUTPUT FILE WITH %00010000 +% THE NAME "OUTPUT" ON DISK ARE ASSUMED. THESE SHOULD BE FILE %00011000 +% EQUATED AS DESIRED. %00012000 +% $ OPTIONS: %00013000 +% AS WITH THE ALGOL COMPILERS DOLLAR CARDS ARE USED TO CONTROL %00014000 +% OPTIONS AVAILABLE FOR NEATING A SOURCE FILE. NOTE THAT THE %00015000 +% CARD IMAGE WILL BE COPIED TO THE OUTPUT FILE ONLY IF THE "$" %00016000 +% CHARACTER IS IN OTHER THAN COL 1. %00017000 +% %00018000 +% OPTION DEFAULT EFFECT %00019000 +% %00020000 +% BEGINOFFSET 0 MAY BE POSITIVE, NEGATIVE OR 0. %00021000 +% SPECIFIES THE POSITION OF A "BEGIN" %00022000 +% IN RELATION TO THE CURRENT MARGIN. %00023000 +% DECINDENT 7 MUST BE >= 0. SPECIFIES THE %00024000 +% INDENTATION OF DECLARATIONS. %00025000 +% DEFINEINDENT 22 MUST BE >= 0. SPECIFIES THE %0002600076/11/15 +% INDENTATION OF THE TEXT OF DEFINES. %0002700076/11/15 +% ELSEOFFSET 0 MAY BE POSITIVE, NEGATIVE OR 0. %00028000 +% SPECIFIES THE POSITION OF AN "ELSE" %00029000 +% IN RELATION TO THE CURRENT MARGIN. %00030000 +% INDENT 3 MUST BE >= 0. SPECIFIES THE AMOUNT %00031000 +% STATEMENTS ARE INDENTED. %00032000 +% INDENTELSEIF RESET MAY BE SET, RESET OR POP-ED. IF SET %00033000 +% AN "IF" FOLLOWING AN "ELSE" WILL BE %00034000 +% INDENTED. %00035000 +% INDENTTHENIF SET MAY BE SET, RESET OR POP-ED. IF SET %0003600080/08/04 +% AN "IF" FOLLOWING A "THEN" WILL BE %00037000 +% INDENTED. %00038000 +% LINELENGTH 72 MUST BE BETWEEN 22 AND 72. %00039000 +% SPECIFIES THE PORTION OF THE OUTPUT %00040000 +% CARD IMAGE THAT WILL BE USED. %00041000 +% LOCKCOMMENTS SET MAY BE SET, RESET OR POP-ED. %0004200076/09/01 +% CONTROLS PROCESSING OF "%" COMMENTS %00043000 +% WHEN RESET "%" COMMENTS ON A LINE %00044000 +% WITH A STATEMENT WILL BE RIGHT %00045000 +% JUSTIFIED, WHEN SET SUCH COMMENTS %00046000 +% WILL NOT BE MOVED. IN EITHER CASE %00047000 +% IF A "%" COMMENT WILL NOT FIT ON A %00048000 +% LINE IT IS MOVED TO THE NEXT LINE %00049000 +% BY ITSELF. %00050000 +% MARGIN 5 MUST BE >= 0. SPECIFIES THE %00051000 +% INDENTATION OF THE OUTER BLOCK %00052000 +% OF THE PROGRAM UNIT. %00053000 +% NEATUP SET MAY BE SET, RESET OR POP-ED. %00054000 +% CONTROLS REFORMATING - WHEN %00055000 +% RESET LINES ARE COPIED TO THE %00056000 +% OUTPUT FILE AS THEY ARE. %00057000 +% NEATUPLIST RESET MAY BE SET, RESET OR POP-ED. %00058000 +% SPECIFIES THAT A PRINTER LISTING %00059000 +% OF THE GENERATED OUTPUT IS TO BE %00060000 +% PRODUCED. %00061000 +% NEATUPSEQ 1000 + 1000 ALLOWS SPECIFICATION OF THE BASE %0006200076/08/19 +% VALUE AND INCREMENT USED IN %0006300076/08/19 +% SEQUENCING THE OUTPUT FILE. %0006400076/08/19 +% ONEPERLINE SET MAY BE SET, RESET OR POP-ED. %00065000 +% CONTROLS DECLARATIONS. WHEN SET %00066000 +% EACH DECLARED IDENTIFIER IS PLACED %00067000 +% ON A LINE OF ITS OWN. WHEN RESET %00068000 +% AS MANY IDENTIFIERS AS POSSABLE ARE %00069000 +% PLACED ON EACH LINE. %0007000079/01/03 +% PROCINDENT 5 MUST BE >= 0. SPECIFIES THE AMOUNT %00071000 +% STATEMENTS WITHIN A PROCEDURE ARE %00072000 +% TO BE INDENTED. %00073000 +% %00074000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00075000 + $ POP OMIT 0007599081/10/14.1 + $ PAGE 0007600081/10/14.1 +FILE 0007700078/05/03 + INPUT(KIND = DISK,FILETYPE = 8), 0007800081/10/14.1 + OUTPUT(KIND = DISK,MAXRECSIZE = 15,BLOCKSIZE = 450,AREAS = 20, 0007900081/10/14.1 + AREASIZE = 900,FLEXIBLE), 0008000081/10/14.1 + LINE(KIND = PRINTER); 00081000 +ARRAY 00082000 + STMARKS[0:8191], 00083000110115PK + PARENSTACK, 00084000 + BRACKETSTACK, 00085000 + DOBLOCKCOUNTS[0:31]; 0008600077/07/05 +EBCDIC ARRAY 0008700076/07/19 + SOURCE, 0008800076/07/19 + DEST[0:89], 0008900076/07/19 + PBUF[0:131], 0009000076/07/19 + ACCUM[0:359], 0009100076/07/19 + SUPERTOK[0:47999]; 00092000110115PK +POINTER 0009300076/07/20 + PIN, 0009400076/07/20 + POUT, 0009500076/07/20 + PA, 0009600076/07/20 + STOKP; 0009700076/07/20 +REAL 00098000 + CA, 00099000 + CIN, 00100000 + COT, 00101000 + TYPE, 00102000 + LASTTYPE, 0010300077/07/05 + IDFRDESC, 0010400077/07/05 + INCREMENT, 00105000 + GMARGIN, 00106000 + OBMARGIN, 0010700078/07/24 + BLOCKBASE, 00108000 + SEQ, 00109000 + SEQINC, 00110000 + DECINDENT, 00111000 + DEFINEINDENT, 00112000 + PROCINDENT, 00113000 + BEGINOFFSET, 00114000 + ELSEOFFSET, 0011500076/07/22 + LINELENGTH, 0011600076/07/22 + MARKER, 0011700076/07/22 + STL, 0011800076/07/22 + ACTIVEPARENS, 0011900076/07/22 + ACTIVEBRACKETS, 00120000 + SUPERTOKENSTARTER, 00121000 + STM, 00122000 + LASTCOMMA, 00123000 + DOSDOING, 0012400077/03/18 + IFSDOING, 0012500077/07/05 + INPUTFKIND; 0012600077/07/05 +LABEL 0012700076/08/16 + EOF; 0012800076/08/16 +BOOLEAN 00129000 + DECLFLAG, 00130000 + LOOKINGFORDO, 00131000 + LISTTOG, 00132000 + DEFINEINPROGRESS, 00133000 + PROCINPROGRESS, 00134000 + PROCESSINGGLOBALDECS, 0013500078/07/25 + ONEPERLINE, 00136000 + INDENTTHENIF, 00137000 + INDENTELSEIF, 00138000 + INHIBITSCAN, 00139000 + NEATUPTOG, 00140000 + OMITTOG, 0014100081/10/14.1 + MAKENEWFILE, 00142000 + LOOKINGFOROF, 00143000 + LEFTCOMMENTS, 0014400077/07/05 + LOCKCOMMENTS, 0014500077/07/05 + ACTIVESUPERTOKEN, 00146000 + SPACEFLAG, 0014700077/03/22 + FIRSTBLOCK, 0014800078/07/25 + ALREADYINDENTED; 00149000 +TRUTHSET 0015000077/07/07 + NUMERICS("0123456789"), 0015100077/07/07 + IDFRSTARTERS(ALPHA AND ^ NUMERICS), 00152000110115PK + IDFRVALIDS(IDFRSTARTERS OR NUMERICS), 00153000120323PK + CLOSERS(")]"), 0015400077/07/07 + OPENERS("(["), 0015500076/07/22 + OCTALS("01234567"), 00155100120323PK + WEIRDOS("~!|{}"), 00156000120323PK + BLANKAROUNDS(":=<>&*," OR WEIRDOS); 00157000120323PK +DEFINE 0015800081/09/21 + NXTCOMMA = [47:11] #, 0015900081/09/21 + FLNKINDX = [36:11] #, 0016000081/09/21 + STDISPF = [25:14] #, 0016100081/09/21 + STLENF = [11:08] #, 0016200081/09/21 + STTYPEF = [03:04] #, 0016300081/09/21 + STTYPE(I) = STMARKS[I].STTYPEF #, % TYPE OF THIS TOKEN 0016400076/11/16 + STLENGTH(I) = STMARKS[I].STLENF #, % LENGTH OF THIS TOKEN 0016500076/11/16 + STDISP(I) = STMARKS[I].STDISPF #, % START POS OF THIS TOKEN 0016600076/11/16 + STLINK(I) = STMARKS[I].FLNKINDX #, % LINK TO TERMINATOR 0016700076/11/16 + QUOTE = """ #, 0016800077/07/07 + UNDEFINED = 0 #, 0016900077/03/22 + IDFR = 1 #, 0017000077/07/06 + KIDFR = 2 #, 0017100077/07/06 + ANUMBER = 3 #, 0017200077/07/06 + SPECIALCHAR = 4 #, 0017300077/07/06 + ASTRING = 5 #, 0017400081/05/07 + PCOMMENT = 6 #, 0017500077/07/06 + CCOMMENT = 7 #, 0017600077/07/06 + BRKTCLASS = 0 #, 00177000 + PARENCLASS = 1 #, 00178000 + REPLCLASS = 2 #, 00179000 + COPY = BEGIN 0018000076/07/19 + REPLACE DEST BY SOURCE FOR 12 WORDS; 0018100076/07/19 + EMITWITHNOCOMMENTCHK; 0018200076/07/15 + END #, 00183000 + EMIT = EMITTER(FALSE) #, 0018400076/07/20 + EMITWITHNOCOMMENTCHK = 0018500076/07/20 + EMITTER(TRUE) #, 0018600076/07/20 + EMITANDINDENT2 = 00187000 + BEGIN 0018800076/07/23 + EMITWITHNOCOMMENTCHK; 0018900076/07/23 + COT := 0019000077/03/22 + IF DECLFLAG THEN 0019100077/03/22 + BLOCKBASE + DECINDENT + 2 0019200077/03/22 + ELSE 0019300077/03/22 + GMARGIN + 2; 0019400077/03/22 + POUT := DEST[COT]; 0019500076/07/20 + COT := LINELENGTH - COT; 0019600076/07/20 + END #, 00197000 + SCANTILNOTBLANK = 00198000 + DO BEGIN 00199000 + IF CIN <= 0 THEN 00200000 + NEXTCARD; 00201000 + SCAN PIN:PIN FOR CIN:CIN UNTIL ^= " "; 0020200076/07/20 + END 0020300076/07/20 + UNTIL CIN ^= 0 #, 0020400076/07/20 + TRANSFER(THISMUCH) = 00205000 + DO BEGIN 00206000 + IF CIN <= 0 THEN 00207000 + NEXTCARD; 00208000 + REPLACE PA:PA BY PIN:PIN FOR T:CIN THISMUCH;0020900076/07/20 + CA := CA + CIN - (CIN := T); 0021000076/07/20 + END 0021100076/07/20 + UNTIL CIN ^= 0 #, 0021200076/07/20 + TRANSFERCT(THISMANY) = 00213000 + THRU THISMANY DO 00214000 + BEGIN 00215000 + IF CIN <= 0 THEN 00216000 + NEXTCARD; 00217000 + REPLACE PA:PA BY PIN:PIN FOR 1; 0021800076/07/19 + CA := CA + 1; 00219000 + CIN := CIN - 1; 0022000076/07/20 + END #, 00221000 + INITIALIZEDEST(K) = 0022200077/03/21 + BEGIN 0022300076/07/19 + POUT := DEST[GMARGIN := K]; 0022400076/07/19 + COT := LINELENGTH - GMARGIN; 0022500076/07/20 + END #, 00226000 + STRIPTRAILINGBLANKS = 00227000 + BEGIN 0022800076/07/19 + DO 0022900076/07/19 + UNTIL ACCUM[CA := CA - 1] ^= " "; 0023000076/07/19 + CA := CA + 1; 00231000 + END #, 00232000 + PUTBLANK = IF ACTIVESUPERTOKEN THEN 0023300076/07/20 + BEGIN 0023400076/07/20 + REPLACE STOKP:STOKP BY " "; 0023500076/07/20 + STL := * + 1; 0023600077/03/21 + IF STM = 0 THEN 0023700077/03/21 + BEGIN 0023800077/03/21 + STMARKS[0] := SPECIALCHAR & 1 STLENF; 0023900077/03/21 + STM := 1; 0024000077/03/21 + END 0024100076/07/19 + ELSE 0024200076/07/19 + STLENGTH[STM - 1] := STLENGTH[STM - 1] + 1; 0024300076/07/19 + END 0024400076/07/19 + ELSE 0024500076/07/19 + IF COT = 0 THEN 0024600076/07/19 + EMITANDINDENT2 0024700076/07/19 + ELSE 0024800076/07/19 + BEGIN 0024900076/07/19 + REPLACE POUT:POUT BY " "; 0025000076/07/19 + COT := COT - 1; 0025100076/07/20 + END #, 00252000 + SPACENEEDED = (LASTTYPE = IDFR OR LASTTYPE = ANUMBER OR LASTTYPE00253000 + = ASTRING OR LASTTYPE = SPECIALCHAR AND 00254000 + SPACEKEY) #, 00255000 + NEXTLINESIZE = (LINELENGTH - 2 - (IF DECLFLAG THEN BLOCKBASE + 0025600076/07/22 + DECINDENT ELSE GMARGIN)) #, 0025700076/07/22 + PROCESSCOMMA = IF DECLFLAG THEN 00278000 + IF ONEPERLINE AND ACTIVEPARENS = 0 AND 00279000 + ACTIVEBRACKETS = 0 00280000 + THEN 00281000 + BEGIN 00282000 + EMIT; 00283000 + INITIALIZEDEST(BLOCKBASE + DECINDENT); 0028400076/07/28 + END 00285000 + ELSE 00286000 + IF ACTIVEPARENS = 0 THEN 00287000 + PUTBLANK #, 00288000 + ITSAPROCEDURE = 00289000 + ITEMKEY[IDFRDESC] = PROCEDUREC #, 0029000077/07/05 + ITSACOMMENT = ITEMKEY[IDFRDESC] = COMMENTC #, 0029100077/07/05 + ITSASWITCH = ITEMKEY[IDFRDESC] = SWITCHC #, 0029200077/07/05 + ITSADEFINE = ITEMKEY[IDFRDESC] = DEFINEC #, 0029300077/07/05 + ITSABEGIN = ITEMKEY[IDFRDESC] = BEGINC #, 0029400077/07/05 + ITSANELSE = ITEMKEY[IDFRDESC] = ELSEC #, 0029500077/07/05 + ITSACASE = ITEMKEY[IDFRDESC] = CASEC #, 0029600077/07/05 + ITSATHEN = ITEMKEY[IDFRDESC] = THENC #, 0029700077/07/05 + ITSANITER = RESWORDTYPE[IDFRDESC,ITERATIONOP] #, 0029800077/07/05 + ITSANEND = ITEMKEY[IDFRDESC] = ENDC #, 0029900077/07/05 + ITSANIF = ITEMKEY[IDFRDESC] = IFC #, 0030000077/07/05 + ITSANOF = ITEMKEY[IDFRDESC] = OFC #, 0030100077/07/05 + ITSADO = ITEMKEY[IDFRDESC] = DOC #, 0030200077/07/05 + ITSABY = ITEMKEY[IDFRDESC] = BYC #, 0030300077/07/05 + ITSANUNTIL = ITEMKEY[IDFRDESC] = UNTILC #, 0030400077/07/05 + ITSARESWORD = (TYPE = KIDFR AND ITEMTYPE[IDFRDESC] = RESWORD) #,0030500077/07/06 + ITSADECLARATION = 0030600077/07/05 + (TYPE = KIDFR AND ITEMTYPE[IDFRDESC] = DECLARATOR 0030700077/07/05 + AND PIN ^= "(") #, 0030800077/07/05 + DOINGADO = DOSDOING > 0 #, 00309000 + DOBLOCKCOUNT = DOBLOCKCOUNTS[DOSDOING] #, 00310000 + ELSEMARGINF = [23:8] #, 00311000 + ATERMINATOR = (TYPE = SPECIALCHAR OR TYPE = ASTRING OR TYPE = 0031200077/07/05 + PCOMMENT OR TYPE = KIDFR AND 0031300077/07/05 + RESWORDTYPE[IDFRDESC,TERMINATOR]) #, 0031400077/07/05 + THISENDSTHESUPERTOKEN = 00315000 + IF SUPERTOKENSTARTER = BRKTCLASS THEN 0031600077/03/21 + PA = "]" AND ACTIVEBRACKETS = 0 0031700077/03/21 + ELSE 0031800077/03/21 + IF SUPERTOKENSTARTER = PARENCLASS THEN 0031900077/03/21 + PA = ")" AND ACTIVEPARENS = 0 0032000077/03/21 + ELSE 0032100077/03/21 + IF SUPERTOKENSTARTER = REPLCLASS THEN 0032200077/03/21 + (PA = "," OR PA = ";" OR ITSANELSE) AND 0032300077/03/21 + ACTIVEPARENS = 0 AND ACTIVEBRACKETS = 0 0032400077/03/21 + ELSE 0032500077/03/21 + FALSE #, 0032600077/03/21 + LENGTHOFGROUP(I) = 0032700076/11/16 + (STDISP[STLINK[I]] - THISSTARTPOS + 00328000 + STLENGTH[STLINK[I]]) #, 00329000 + LINEEMPTY = DEST = " " FOR 72 #, 0034600076/07/19 + BLANKOUT = REPLACE POUT:= DEST BY " " FOR COT:= 72 #, 00347000120323PK + DIGITSIN(N) = ((FIRSTONE(SCALERIGHTF(N,12)) - 1).[8:7] + 1) #; 0034800080/09/11 +EBCDIC VALUE ARRAY LEXICONTEXT 0034900081/10/14.1 + ("TRANSLATETABLELOCKCOMMENTSLEFTCOMMENTSINDENTTHENIFINDE", 0034901081/10/14.1 + "NTELSEIFDEFINEINDENTBEGINOFFSETELSEOFFSETLINELENGTHONE", 0034902081/10/14.1 + "PERLINEATUPLISTPROCINDENTNEATUPSEQDECINDENTREFERENCEPR", 0034903081/10/14.1 + "OCEDUREINTERRUPTINTERLOCKTRUTHSETDATABASECOMPLEXBOOLEA", 0034904081/10/14.1 + "NPOINTERPICTUREINTEGERMONITORMESSAGELIBRARYLAYOUTFORMA", 0034905081/10/14.1 + "TEXPORTNUMBERSTRINGSWITCHEBCDICDOUBLEDIRECTMARGINEVENT", 0034906081/10/14.1 + "ASCIIARRAYRESETALPHAVALUEQUEUEFIELDLABELWHILEUNTILCASE", 0034907081/10/14.1 + "THRUSTEPLONGFILEREALWORDOMITPAGEPOPBCLANDOWNHEXNOTNEQM", 0034908081/10/14.1 + "ODLSSEQLENDIVLEQIMPGTRGEQVBY"); 0034909081/10/14.1 +VALUE ARRAY COARSEINDEX( 0034910081/10/14.1 + 4"000000000003",4"000004000008",4"00000900000B",4"00000C000013", 0034911081/10/14.1 + 4"00001400001B",4"00001C00001F",4"000020000021",4"000022000022", 0034912081/10/14.1 + 4"00002300002B",4"000001000000",4"000001000000",4"00002C000036", 0034913081/10/14.1 + 4"00003700003A",4"00003B000040",4"000041000046",4"00004700004C", 0034914081/10/14.1 + 4"00004D00004D",4"00004E000050",4"000051000054",4"000055000058", 0034915081/10/14.1 + 4"000059000059",4"00005A00005A",4"00005B00005C",4"000001000000", 0034916081/10/14.1 + 4"000001000000",4"000001000000",4"000001000000",4"000001000000", 0034917081/10/14.1 + 4"000001000000",4"000001000000",4"000001000000",4"000001000000", 0034918081/10/14.1 + 4"000001000000",4"000001000000",4"000001000000"); 0034919081/10/14.1 +VALUE ARRAY INFOARRAY( 0034920081/10/14.1 + 4"0C30841A0012",4"000000000000",4"14502E149000",4"14502C153000", 00349210120323PK + 4"000000000000",4"000000000000",4"14508604A002",4"1C70340D2000", 00349220120323PK + 4"2CB00204A001",4"10408A176002",4"000000000000",4"1C7036012000", 00349230120323PK + 4"08208E12D002",4"0C308C1BA002",4"18603C03E000",4"000000000000", 00349240120323PK + 4"000000000000",4"000000000000",4"24900408E001",4"30C00603E001", 00349250120323PK + 4"0C30941B5022",4"0C30921B8182",4"0C30961C7012",4"104090038182", 0034926081/10/14.1 + 4"000000000000",4"000000000000",4"000000000000",4"28A008055001", 00349270120323PK + 4"0C3098109042",4"10404A186000",4"145048162008",4"18604C109000", 0034928081/10/14.1 + 4"0C309C1C3022",4"0C309A1C6022",4"000000000000",4"000000000000", 00349290120323PK + 4"08209E030002",4"0C30A21C0012",4"18600A026001",4"1C70500E7000", 0034930081/10/14.1 + 4"000000000000",4"000000000000",4"30C00C032001",4"30C00E026001", 00349310120323PK + 4"0C30A41BD022",4"0C30A61B2022",4"000000000000",4"000000000000", 00349320120323PK + 4"10405C077000",4"145056167000",4"186058103008",4"000000000000", 00349330120323PK + 4"28A01405F001",4"30C01200E001",4"30C01001A001",4"0C30A81AF002", 0034934081/10/14.1 + 4"186016139001",4"1C70640EE000",4"000000000000",4"0C30AC1A9012", 00349350120323PK + 4"0C30AA1AC022",4"000000000000",4"186018071001",4"24901C085001", 00349360120323PK + 4"28A01A071001",4"000000000000",4"0820B00F3012",4"000000000000", 00349370120323PK + 4"0C306A1A3000",4"10401E192001",4"28A020069001",4"0C302419A001", 0034938081/10/14.1 + 4"104022196001",4"000000000000",4"000000000000",4"2490700A0000", 00349390120323PK + 4"28A02607B001",4"000000000000",4"10407418A000",4"14502814E001", 00349400120323PK + 4"000000000000",4"0C302A052001",4"1040B417E002",4"18607811B000", 00349410120323PK + 4"18607A121000",4"1040B202C102",4"000000000000",4"000000000000", 00349420120323PK + 4"000000000000",4"1450B8171082",4"145080158000",4"000000000000", 00349430120323PK + 4"1450BA16C042"); 0034944081/10/14.1 +DEFINE 0034945081/10/14.1 + ALPHAC = 22 #, 0034946081/10/14.1 + ANDC = 66 #, 0034947081/10/14.1 + ARRAYC = 23 #, 0034948081/10/14.1 + ASCIIC = 24 #, 0034949081/10/14.1 + BCLC = 25 #, 0034950081/10/14.1 + BEGINC = 67 #, 0034951081/10/14.1 + BEGINOFFSETC = 1 #, 0034952081/10/14.1 + BOOLEANC = 26 #, 0034953081/10/14.1 + BYC = 68 #, 0034954081/10/14.1 + CASEC = 69 #, 0034955081/10/14.1 + COMMENTC = 27 #, 0034956081/10/14.1 + COMPLEXC = 28 #, 0034957081/10/14.1 + DATABASEC = 29 #, 0034958081/10/14.1 + DECINDENTC = 2 #, 0034959081/10/14.1 + DEFINEC = 30 #, 0034960081/10/14.1 + DEFINEINDENTC = 3 #, 0034961081/10/14.1 + DIRECTC = 31 #, 0034962081/10/14.1 + DIVC = 70 #, 0034963081/10/14.1 + DOC = 71 #, 0034964081/10/14.1 + DOUBLEC = 32 #, 0034965081/10/14.1 + EBCDICC = 33 #, 0034966081/10/14.1 + ELSEC = 72 #, 0034967081/10/14.1 + ELSEOFFSETC = 4 #, 0034968081/10/14.1 + ENDC = 73 #, 0034969081/10/14.1 + EQLC = 74 #, 0034970081/10/14.1 + EQVC = 75 #, 0034971081/10/14.1 + EVENTC = 34 #, 0034972081/10/14.1 + EXPORTC = 35 #, 0034973081/10/14.1 + FIELDC = 36 #, 0034974081/10/14.1 + FILEC = 37 #, 0034975081/10/14.1 + FORC = 76 #, 0034976081/10/14.1 + FORMATC = 38 #, 0034977081/10/14.1 + GEQC = 77 #, 0034978081/10/14.1 + GTRC = 78 #, 0034979081/10/14.1 + HEXC = 39 #, 0034980081/10/14.1 + IFC = 79 #, 0034981081/10/14.1 + IMPC = 81 #, 0034982081/10/14.1 + INC = 80 #, 0034983081/10/14.1 + INDENTC = 5 #, 0034984081/10/14.1 + INDENTELSEIFC = 6 #, 0034985081/10/14.1 + INDENTTHENIFC = 7 #, 0034986081/10/14.1 + INTEGERC = 40 #, 0034987081/10/14.1 + INTERLOCKC = 41 #, 0034988081/10/14.1 + INTERRUPTC = 42 #, 0034989081/10/14.1 + LABELC = 43 #, 0034990081/10/14.1 + LAYOUTC = 44 #, 0034991081/10/14.1 + LEFTCOMMENTSC = 8 #, 0034992081/10/14.1 + LEQC = 82 #, 0034993081/10/14.1 + LIBRARYC = 45 #, 0034994081/10/14.1 + LINELENGTHC = 10 #, 0034995081/10/14.1 + LISTC = 46 #, 0034996081/10/14.1 + LOCKC = 47 #, 0034997081/10/14.1 + LOCKCOMMENTSC = 9 #, 0034998081/10/14.1 + LONGC = 48 #, 0034999081/10/14.1 + LSSC = 83 #, 0035000081/10/14.1 + MARGINC = 11 #, 0035001081/10/14.1 + MESSAGEC = 49 #, 0035002081/10/14.1 + MODC = 84 #, 0035003081/10/14.1 + MONITORC = 50 #, 0035004081/10/14.1 + NEATUPC = 12 #, 0035005081/10/14.1 + NEATUPLISTC = 13 #, 0035006081/10/14.1 + NEATUPSEQC = 14 #, 0035007081/10/14.1 + NEQC = 85 #, 0035008081/10/14.1 + NOTC = 86 #, 0035009081/10/14.1 + NUMBERC = 51 #, 0035010081/10/14.1 + OFC = 87 #, 0035011081/10/14.1 + OMITC = 15 #, 0035012081/10/14.1 + ONC = 52 #, 0035013081/10/14.1 + ONEPERLINEC = 16 #, 0035014081/10/14.1 + ORC = 88 #, 0035015081/10/14.1 + OWNC = 53 #, 0035016081/10/14.1 + PAGEC = 17 #, 0035017081/10/14.1 + PICTUREC = 54 #, 0035018081/10/14.1 + POINTERC = 55 #, 0035019081/10/14.1 + POPC = 18 #, 0035020081/10/14.1 + PROCEDUREC = 56 #, 0035021081/10/14.1 + PROCINDENTC = 19 #, 0035022081/10/14.1 + QUEUEC = 57 #, 0035023081/10/14.1 + REALC = 58 #, 0035024081/10/14.1 + REFERENCEC = 59 #, 0035025081/10/14.1 + RESETC = 20 #, 0035026081/10/14.1 + SETC = 21 #, 0035027081/10/14.1 + STEPC = 90 #, 0035028081/10/14.1 + STREAMC = 60 #, 00350290120323PK + SWITCHC = 61 #, 0035030081/10/14.1 + THENC = 89 #, 0035031081/10/14.1 + THRUC = 91 #, 0035032081/10/14.1 + TRANSLATETABLEC = 62 #, 0035033081/10/14.1 + TRUTHSETC = 63 #, 0035034081/10/14.1 + UNTILC = 92 #, 0035035081/10/14.1 + VALUEC = 64 #, 0035036081/10/14.1 + WHILEC = 93 #, 0035037081/10/14.1 + WORDC = 65 #; 0035038081/10/14.1 +DEFINE 0035039081/10/14.1 + ALGOL = 0 #, 0035040081/10/14.1 + BOOLEANOP = 0 #, 0035041081/10/14.1 + DCALGOL = 1 #, 0035042081/10/14.1 + DECLARATOR = 0 #, 0035043081/10/14.1 + ESPOL = 2 #, 0035044081/10/14.1 + ESPOLORDCALGOL = 3 #, 0035045081/10/14.1 + ITERATIONOP = 2 #, 0035046081/10/14.1 + LINEENDER = 4 #, 0035047081/10/14.1 + MYOPTION = 1 #, 0035048081/10/14.1 + RELATIONOP = 1 #, 0035049081/10/14.1 + RESWORD = 2 #, 0035050081/10/14.1 + TERMINATOR = 3 #; 0035051081/10/14.1 +DEFINE 0035052081/10/14.1 + COARSEFINISHF = [23:24] # 0035053081/10/14.1 + ,COARSESTARTF = [47:24] # 0035054081/10/14.1 + ,INFODEFINEVALUE(INX) = INFOARRAY[INX].[35:11] # 0035055081/10/14.1 + ,DEFINEVALUE(INX) = INFOARRAY[INX].[35:11] # 0035056081/10/14.1 + ,INFOMINSIZE(INX) = INFOARRAY[INX].[47:6] # 0035057081/10/14.1 + ,MINSIZE(INX) = INFOARRAY[INX].[47:6] # 0035058081/10/14.1 + ,INFOLEXPTR(INX) = INFOARRAY[INX].[24:13] # 0035059081/10/14.1 + ,INFOTEXTSIZE(INX) = INFOARRAY[INX].[41:6] # 0035060081/10/14.1 + ,ITEMTYPE(INX) = INFOARRAY[INX].[1:2] # 0035061081/10/14.1 + ,DECLANGUAGE(INX) = INFOARRAY[INX].[3:2] # 0035062081/10/14.1 + ,RESWORDTYPE(INX,BIT) = BOOLEAN(INFOARRAY[INX].[4+BIT:1]) # 0035063081/10/14.1 + ,ITEMKEY(INX) = INFOARRAY[INX].[35:11] # 0035064081/10/14.1 + ,INFOENTRYSIZE = 1 #; 0035065081/10/14.1 + 0035099081/10/14.1 +BOOLEAN PROCEDURE ADOSUNTIL; 00351000 + FORWARD; 00352000 +PROCEDURE BLOCK(MARGIN,BACKOFF); 00353000 +VALUE 00354000 + MARGIN, 00355000 + BACKOFF; 00356000 +INTEGER 00357000 + MARGIN, 00358000 + BACKOFF; 00359000 + FORWARD; 00360000 +PROCEDURE BREAKITUP; 00361000 + FORWARD; 00362000 +PROCEDURE BUILDSUPERTOKEN; 00363000 + FORWARD; 00364000 +PROCEDURE CASESTMT(M); 0036500077/06/30 +VALUE 00366000 + M; 00367000 +INTEGER 00368000 + M; 00369000 + FORWARD; 00370000 +PROCEDURE DEFINEDECLARATION; 00371000 + FORWARD; 00372000 +PROCEDURE DOLLARCARD(TP,TS); 00373000 +VALUE 00374000 + TP, 00375000 + TS; 00376000 +INTEGER 00377000 + TS; 00378000 +POINTER 00379000 + TP; 00380000 + FORWARD; 00381000 +PROCEDURE DOSTMT(M); 00382000 +VALUE 00383000 + M; 00384000 +INTEGER 00385000 + M; 00386000 + FORWARD; 00387000 +PROCEDURE EMITTER(NOCOMMENTCHK); 00388000 +VALUE 00389000 + NOCOMMENTCHK; 00390000 +BOOLEAN 00391000 + NOCOMMENTCHK; 00392000 + FORWARD; 00393000 +BOOLEAN PROCEDURE FIND(P,N,DESC); 0039400077/07/05 +VALUE 00395000 + P, 00396000 + N; 0039700077/07/05 +POINTER 00398000 + P; 00399000 +INTEGER 0040000077/07/05 + N, 0040100077/07/05 + DESC; 0040200077/07/05 + FORWARD; 00403000 +BOOLEAN PROCEDURE FOUNDVERB(VERB,SZ,DESC); 0040350081/10/14.1 +VALUE 0040351081/10/14.1 + VERB, 0040352081/10/14.1 + SZ; 0040353081/10/14.1 +INTEGER 0040354081/10/14.1 + SZ, 0040355081/10/14.1 + DESC; 0040356081/10/14.1 +POINTER 0040357081/10/14.1 + VERB; 0040358081/10/14.1 + FORWARD; 0040359081/10/14.1 +PROCEDURE IFCLAUSE(SS,M,F,E); % ENTER WITH PA POINTING TO "IF" 00404000 +VALUE 00405000 + SS, 00406000 + M; 00407000 +BOOLEAN 00408000 + SS, % SS = TRUE IF THIS "IF" IS A STMT STARTER 00409000 + F, % TRUE IF TRANSFERSTMT IS TO EXIT (OUTPUT PARAMETER) 00410000 + E; % TRUE IF THIS "IF" HAS AN "ELSE" 00411000 +INTEGER 00412000 + M; % M IS THE MARGIN OF THE IF CLAUSE 00413000 + FORWARD; 00414000 +BOOLEAN PROCEDURE INITIALIZATION; 0041500078/07/27 + FORWARD; 00416000 +PROCEDURE ITERATIONCLAUSE(M); 00417000 +VALUE 00418000 + M; 00419000 +INTEGER 00420000 + M; 00421000 + FORWARD; 00422000 +BOOLEAN PROCEDURE ITSALABEL; 00423000 + FORWARD; 00424000 +PROCEDURE NEXTCARD; 00425000 + FORWARD; 00426000 +PROCEDURE PRINTITNEAT; 00427000 + FORWARD; 00428000 +PROCEDURE PUTCOMMENT; % SCANNER HAS ENCOUNTERED A "%" COMMENT WHICH 00429000 + FORWARD; 00430000 +PROCEDURE PUTLABEL(LP,LL,MARGIN,BACKOFF); 00431000 +VALUE 00432000 + LP, 00433000 + LL, 00434000 + MARGIN, 00435000 + BACKOFF; 00436000 +INTEGER 00437000 + LL, 00438000 + MARGIN, 00439000 + BACKOFF; 00440000 +POINTER 00441000 + LP; 00442000 + FORWARD; 00443000 +PROCEDURE PUTTOKEN; % MOVES THE CURRENT TOKEN FROM PA TO DEST 00444000 + FORWARD; 00445000 +PROCEDURE SKAN; % RETURNS (1) TYPE AND (2) CA--ITS SIZE 00446000 + FORWARD; 00447000 +PROCEDURE TRANSFERSTMT(STMTSTARTER,MARGIN,BACKOFF); 00448000 +VALUE 00449000 + STMTSTARTER, 00450000 + MARGIN, 00451000 + BACKOFF; 00452000 +BOOLEAN 00453000 + STMTSTARTER; 00454000 +INTEGER 00455000 + MARGIN, 00456000 + BACKOFF; 00457000 + FORWARD; 00458000 +PROCEDURE TRANSFERSUPERTOKEN; 00459000 + FORWARD; 00460000 +PROCEDURE XFERSTRING; % MOVES A STRING FROM ACCUM TO DEST 00461000 + FORWARD; 0046200081/10/14.1 +BOOLEAN PROCEDURE ADOSUNTIL; 00463000 +BEGIN 00464000 + INTEGER 00465000 + C; 00466000 + IF DOINGADO THEN 00467000 + IF DOBLOCKCOUNT = 0 THEN 00468000 + IF ITSANUNTIL THEN 00469000 + BEGIN 00470000 + SCANTILNOTBLANK; 00471000 + IF PIN IN IDFRSTARTERS THEN 00472000 + BEGIN 00473000 + ADOSUNTIL := TRUE; % UNTIL PROVEN OTHERWISE 00474000 + SCAN PIN FOR C:CIN WHILE IN IDFRVALIDS; 0047500077/07/05 + IF FIND(PIN,CIN - C,C) THEN 0047600077/07/05 + ADOSUNTIL := ^ RESWORDTYPE(IDFRDESC,RELATIONOP); 0047700077/07/05 + END 0047800076/07/19 + ELSE 0047900076/07/19 + ADOSUNTIL := PIN = "(" OR 0048000076/07/19 + (PIN = "^" AND PIN + 1 ^= "="); 0048100076/07/19 + END; 00482000 +END ADOSUNTIL; 0048300081/10/14.1 +PROCEDURE BLOCK(MARGIN,BACKOFF); 0048400076/07/28 +VALUE 0048500076/07/28 + MARGIN, 0048600076/07/28 + BACKOFF; 0048700076/07/28 +INTEGER 0048800076/07/28 + MARGIN, 0048900076/07/28 + BACKOFF; 0049000076/07/28 +BEGIN 0049100078/07/26 + BOOLEAN 0049200078/07/26 + ENDCTERMINATOR; 0049300078/07/26 + INTEGER 0049400078/07/26 + BEGINMARGIN = ENDCTERMINATOR; 0049500078/07/26 + BEGINMARGIN := MAX(0,MARGIN - BACKOFF + BEGINOFFSET); 0049600076/07/28 + INITIALIZEDEST(BEGINMARGIN); 0049700076/07/28 + PUTTOKEN; % THE "BEGIN" 0049800076/09/01 + DO BEGIN 00499000 + EMIT; 00500000 + TRANSFERSTMT(TRUE,MARGIN,INCREMENT); 0050100076/07/28 + END 00502000 + UNTIL ITSANEND; 00503000 + IF ACTIVESUPERTOKEN THEN 0050400081/09/17 + TRANSFERSUPERTOKEN; 0050500081/09/17 + IF ^ LINEEMPTY THEN 0050600081/09/17 + EMITWITHNOCOMMENTCHK; % HAVE STEPPED BEYOND THE "END" HERE 0050700081/09/17 + INITIALIZEDEST(BEGINMARGIN); 0050800076/07/28 + DO BEGIN % PROCESS "END " COMMENTS 0050900078/07/26 + PUTTOKEN; % FIRST TIME "END" - THEN COMMENTS 0051000078/07/26 + SKAN; 0051100078/07/26 + IF ^ ENDCTERMINATOR := ATERMINATOR THEN 0051200078/07/26 + PUTBLANK; 0051300078/07/26 + END 0051400078/07/26 + UNTIL ENDCTERMINATOR; 0051500078/07/26 + LASTTYPE := TYPE; 0051600078/07/26 +END OF BLOCK; 0051700081/10/14.1 +PROCEDURE BREAKITUP; 00518000 +BEGIN 00519000 + BOOLEAN 00520000 + COMMAFG; 00521000 + INTEGER 00522000 + THISSTARTPOS, 00523000 + M, 00524000 + J, 00525000 + K, 00526000 + SAVECA; 00527000 + LABEL 00528000 + AGN; 00529000 + POINTER 00530000 + SAVEPA FOR PA; 00531000 + SAVEPA := PA; 00532000 + SAVECA := CA; 00533000 + LASTTYPE := UNDEFINED; 0053400077/03/22 + FOR K := 0 STEP 1 UNTIL STM - 1 DO 00535000 + BEGIN 00536000 + PA := SUPERTOK[THISSTARTPOS := STDISP[K]]; 00537000 + CA := STLENGTH[K]; 00538000 + IF STTYPE[K] = IDFR THEN 0053900081/09/18 + IF SUPERTOK[THISSTARTPOS + CA] IN OPENERS THEN % ID( OR ID[ 0054000081/09/18 + BEGIN % FIND MATCHING ")" OR "]" 0054100081/09/18 + M := LENGTHOFGROUP(K + 1); 00542000 + IF M > COT AND M <= NEXTLINESIZE THEN 0054300081/09/18 + BEGIN % IDEA IS TO KEEP A SUPER 0054400081/09/18 + CA := M; % TOKEN TOGETHER. THIS CODE0054500081/09/18 + PUTTOKEN; % AND THAT BELOW FOR STUFF 0054600081/09/18 + K := STMARKS[K + 1].FLNKINDX;% BETWEEN ","'S, "("'S OR 0054700081/09/18 + GO AGN; % "["'S WILL MOVE THE WHOLE0054800081/09/18 + END; % SUPER TOKEN TO NEXT LINE 0054900081/09/18 + END; % IF IT FITS THERE BUT WONT0055000081/09/18 + IF COMMAFG THEN % FIT ON THE CURRENT LINE. 0055100081/09/18 + IF J := STMARKS[K - 1].NXTCOMMA ^= 0 THEN 00552000 + BEGIN % J IS INDEX OF NEXT COMMA 00553000 + M := STDISP[J] - STDISP[K - 1]; 00554000 + IF M > COT AND M <= NEXTLINESIZE THEN 00555000 + BEGIN 00556000 + CA := M; 00557000 + PUTTOKEN; 00558000 + K := STMARKS[K - 1].NXTCOMMA; 00559000 + GO AGN; 00560000 + END; 00561000 + END; 00562000 + IF PA IN OPENERS THEN % ( OR [ 0056300081/09/18 + IF M := LENGTHOFGROUP(K) > COT AND M <= NEXTLINESIZE THEN 00564000 + BEGIN 00565000 + CA := M; 00566000 + PUTTOKEN; 00567000 + K := STMARKS[K].FLNKINDX; 00568000 + GO AGN; 00569000 + END; 00570000 + IF STTYPE[K] = ASTRING THEN 00571000 + XFERSTRING 00572000 + ELSE 00573000 + PUTTOKEN; 00574000 + AGN: COMMAFG := PA = ","; 00575000 + END OF FOR K; 00576000 + PA := SAVEPA; 00577000 + CA := SAVECA; 00578000 +END OF BREAKITUP; 0057900081/10/14.1 +PROCEDURE BUILDSUPERTOKEN; 00580000 +BEGIN 0058100076/07/22 + DEFINE 0058200076/07/22 + POP(STAKN,INX) = 0058300076/07/22 + BEGIN 0058400076/07/22 + STMARKS[STAKN[INX]] := * & STM FLNKINDX; 0058500076/07/22 + INX := INX - 1; 0058600076/07/22 + END #; 0058700076/07/22 + STMARKS[STM] := TYPE & CA STLENF & STL STDISPF; 0058800076/11/16 + IF PA = "(" THEN 0058900076/07/22 + PARENSTACK[ACTIVEPARENS := * + 1] := STM 0059000076/07/22 + ELSE 0059100076/07/22 + IF PA = "[" THEN 0059200076/07/22 + BRACKETSTACK[ACTIVEBRACKETS := * + 1] := STM 0059300076/07/22 + ELSE 0059400076/07/22 + IF PA = ")" THEN 0059500076/07/22 + POP(PARENSTACK,ACTIVEPARENS) 0059600076/07/22 + ELSE 0059700076/07/22 + IF PA = "]" THEN 0059800076/07/22 + POP(BRACKETSTACK,ACTIVEBRACKETS) 0059900076/07/22 + ELSE 0060000076/07/22 + IF PA = "," AND ACTIVEPARENS = 1 AND ACTIVEBRACKETS = 0 THEN 0060100076/07/22 + BEGIN 0060200076/07/22 + STMARKS[LASTCOMMA] := * & STM NXTCOMMA; 0060300076/07/22 + LASTCOMMA := STM; 0060400076/07/22 + END; 0060500076/07/22 + STM := STM + 1; 0060600076/07/22 + REPLACE STOKP:STOKP BY PA FOR CA; 0060700076/07/20 + STL := STL + CA; 00608000 + IF THISENDSTHESUPERTOKEN THEN 00609000 + TRANSFERSUPERTOKEN; 00610000 +END OF BUILDSUPERTOKEN; 0061100081/10/14.1 +PROCEDURE CASESTMT(M); 0061200077/06/30 +VALUE 00613000 + M; 00614000 +INTEGER 00615000 + M; 00616000 +BEGIN 0061700076/07/20 + LOOKINGFOROF := TRUE & LOOKINGFOROF[46:46]; % "SET" 0061800076/07/20 + PUTTOKEN; % TRANSFER "CASE" 00619000 + SPACEFLAG := PIN IN OPENERS; 0062000077/07/06 + LASTTYPE := IDFR; 0062100077/07/06 + TRANSFERSTMT(FALSE,M,INCREMENT); % TRANSFER TIL "OF" 0062200076/07/20 + LOOKINGFOROF := LOOKINGFOROF.[46:46]; % "POP" 00623000 + PUTTOKEN; % THE "OF" 0062400078/07/26 + IF ^ ACTIVESUPERTOKEN THEN % CASE - OF ON OWN LINE0062500077/06/30 + EMIT; 00626000 +END OF CASESTMT; 0062700081/10/14.1 +PROCEDURE DEFINEDECLARATION; 00628000 +BEGIN 0062900076/11/15 + DEFINE 0063000076/11/15 + EQUALINDENT = (DEFINEINDENT - 3) #; 0063100076/11/15 + INTEGER 0063200076/07/28 + DEFINEBASE; 0063300076/07/28 + DEFINEINPROGRESS := TRUE; 00634000 + DEFINEBASE := BLOCKBASE; 0063500077/06/28 + INITIALIZEDEST(DEFINEBASE); 0063600077/06/28 + PUTTOKEN; % "DEFINE" 00637000 + DO BEGIN 0063800077/03/21 + SKAN; 00638100120323PK + EMIT; 0063900077/03/21 + INITIALIZEDEST(DEFINEBASE + DECINDENT); 0064100076/07/28 + WHILE TYPE IS PCOMMENT DO % COMMENT AFTER "DEFINE" OR "," 0064200077/03/21 + BEGIN 00643000 + PUTCOMMENT; 00644000 + SKAN; 0064500077/03/21 + INITIALIZEDEST(DEFINEBASE + DECINDENT); 0064600077/03/21 + END; 00647000 + DO BEGIN 00648000 + PUTTOKEN; % FIRST TIME FOR IDENTIFIER 00649000 + SKAN; % ALL OTHERS (IF ANY) FOR PARAMETRIC DEFINE.00650000 + END 0065100076/07/19 + UNTIL PA = " ="; 0065200076/07/19 + IF COT < LINELENGTH - EQUALINDENT - DEFINEBASE THEN 0065300077/03/21 + BEGIN % A LONG DEFINE IDENTIFIER 0065400077/03/21 + PUTTOKEN; 00655000 + EMIT; % "=" 0065600076/11/15 + END 0065700076/11/15 + ELSE 0065800076/11/15 + BEGIN 0065900076/11/15 + INITIALIZEDEST(EQUALINDENT + DEFINEBASE); 0066000076/11/15 + PUTTOKEN; % "=" 00661000 + END; 00662000 + DO BEGIN 0066300077/07/05 + BLOCKBASE := DEFINEBASE + DEFINEINDENT; 0066400077/07/05 + TRANSFERSTMT(TRUE,BLOCKBASE,INCREMENT); 0066500077/07/05 + IF PA ^= "#" THEN 0066600077/07/05 + EMIT; 0066700077/07/05 + END 0066800077/07/05 + UNTIL PA = "#"; 0066900077/07/05 + LOOKINGFORDO := FALSE; 00670000 + IF ACTIVESUPERTOKEN THEN 00671000 + TRANSFERSUPERTOKEN; 00672000 + SKAN; 00673000 + WHILE TYPE IS PCOMMENT DO % COMMENT BEFORE "," OR ";" 0067400077/03/21 + BEGIN 00675000 + PUTCOMMENT; 00676000 + SKAN; % FOR THE "," OR ";" 00677000 + INITIALIZEDEST(DEFINEBASE + DECINDENT); 0067800076/07/28 + END; 00679000 + PUTTOKEN; 00680000 + END 0068100077/03/21 + UNTIL PA ^= ","; 0068200077/03/21 + EMIT;% THE ";" LINE 0068300077/03/21 + DEFINEINPROGRESS := FALSE; 00684000 + BLOCKBASE := DEFINEBASE; 0068500076/07/28 +END OF DEFINEDECLARATION; 0068600081/10/14.1 +PROCEDURE DOLLARCARD(TP,TS); 0068700076/07/19 +VALUE 0068800076/07/19 + TP, 0068900076/07/19 + TS; 0069000076/07/19 +INTEGER 00691000 + TS; 00692000 +POINTER 00693000 + TP; 00694000 +BEGIN 00695000 + INTEGER 00696000 + CT, 00697000 + K, 00698000 + DKEY; 00699000 + POINTER 0070000076/07/15 + PT; 0070100076/07/15 + PROCEDURE SWITCHIT(XTOG); 00702000 + BOOLEAN 00703000 + XTOG; 00704000 + BEGIN 0070500076/07/19 + CASE DKEY OF 0070600076/07/19 + BEGIN 0070700076/07/19 + XTOG := TRUE & XTOG[46:46]; % "SET" 0070800076/07/19 + XTOG := FALSE & XTOG[46:46]; % "RESET" 00709000 + XTOG := XTOG.[46:46]; % "POP" 0071000076/07/19 + END CASES; 00711000 + END OF SWITCHIT; 0071200081/10/14.1 + INTEGER PROCEDURE FINDVALUE; 00713000 + BEGIN 00714000 + REAL 00715000 + MINUS; 00716000 + INTEGER 00717000 + CT; 00718000 + SCAN TP:TP FOR TS:TS WHILE = " "; 00719000 + IF TP = "-" THEN 00720000 + BEGIN 00721000 + MINUS := 1; 00722000 + TP := TP + 1; 00723000 + TS := TS - 1; 00724000 + END; 00725000 + SCAN TP FOR CT:TS WHILE IN NUMERICS; 0072600076/07/22 + FINDVALUE := INTEGER(TP,TS - CT) & MINUS[46:1]; 00727000 + TP := TP + (TS - (TS := CT)); 00728000 + END OF FINDVALUE; 0072900081/10/14.1 + WHILE TS > 0 DO 0073000076/07/15 + BEGIN 0073100076/07/15 + SCAN PT:TP FOR CT:TS UNTIL IN ALPHA; 0073200076/07/15 + SCAN TP:PT FOR TS:CT WHILE IN ALPHA; 0073300076/07/15 + IF CT := CT - TS > 0 THEN 0073400077/07/05 + IF FIND(PT,CT,K) THEN 0073500077/07/05 + IF ITEMTYPE[K] = MYOPTION THEN 0073600077/07/05 + CASE ITEMKEY[K] OF 0073700077/07/05 + BEGIN 0073800077/07/05 + BEGINOFFSETC: 0073900077/07/05 + BEGINOFFSET := FINDVALUE; 0074000077/07/05 + DECINDENTC: 0074100077/07/05 + DECINDENT := FINDVALUE; 0074200077/07/05 + DEFINEINDENTC: 0074300077/07/05 + DEFINEINDENT := FINDVALUE; 0074400077/07/05 + ELSEOFFSETC: 0074500077/07/05 + ELSEOFFSET := FINDVALUE; 0074600077/07/05 + INDENTC: 0074700077/07/05 + INCREMENT := FINDVALUE; 0074800077/07/05 + INDENTELSEIFC: 0074900077/07/05 + SWITCHIT(INDENTELSEIF); 0075000077/07/05 + INDENTTHENIFC: 0075100077/07/05 + SWITCHIT(INDENTTHENIF); 0075200077/07/05 + LEFTCOMMENTSC: 0075300077/07/05 + SWITCHIT(LEFTCOMMENTS); 0075400077/07/05 + LOCKCOMMENTSC: 0075500077/07/05 + SWITCHIT(LOCKCOMMENTS); 0075600077/07/05 + LINELENGTHC: 0075700077/07/05 + LINELENGTH := FINDVALUE; 0075800077/07/05 + MARGINC: 0075900078/07/24 + OBMARGIN := FINDVALUE; 0076000078/07/24 + NEATUPC: 0076100077/07/05 + SWITCHIT(NEATUPTOG); 0076200077/07/05 + NEATUPLISTC: 0076300077/07/05 + SWITCHIT(LISTTOG); 0076400077/07/05 + NEATUPSEQC: 0076500077/07/05 + BEGIN 0076600077/07/05 + SEQ := FINDVALUE; 0076700077/07/05 + SCAN TP:TP FOR TS:TS UNTIL ^= " "; 0076800077/07/05 + IF TS >= 0 THEN 0076900077/07/05 + IF TP = "+" THEN 0077000077/07/05 + BEGIN 0077100077/07/05 + TP := TP + 1; 0077200077/07/05 + TS := TS - 1; 0077300077/07/05 + SEQINC := FINDVALUE; 0077400077/07/05 + END; 0077500077/07/05 + SEQ := SEQ - SEQINC; 0077600077/07/05 + END OF NEATUPSEQC; 0077700077/07/05 + OMITC: 0077800081/09/22 + BEGIN 0077900081/09/22 + SCAN TP:TP FOR TS:TS WHILE = " "; 0078000081/09/22 + IF IF DKEY = 1 THEN % RESET 0078100081/09/22 + TRUE 0078200081/09/22 + ELSE 0078300081/09/22 + IF DKEY = 2 THEN % POP 0078400081/09/22 + OMITTOG % ONLY IF OMITTING 0078500081/10/14.1 + ELSE % SET 0078600081/09/22 + IF TS >= 0 THEN 0078700081/09/22 + TP ^= "=" % ONLY IF NOT SET OMIT = 0078800081/09/22 + ELSE 0078900081/09/22 + TRUE 0079000081/09/22 + THEN 0079100081/09/22 + SWITCHIT(OMITTOG); 0079200081/10/14.1 + END OMIT; 0079300081/09/22 + ONEPERLINEC: 0079400077/07/05 + SWITCHIT(ONEPERLINE); 0079500077/07/05 + PAGEC: 0079600077/07/05 + IF LISTTOG THEN 0079700077/07/05 + WRITE(LINE[SKIP 1]); 0079800077/07/05 + POPC: DKEY := 2; 0079900077/07/05 + PROCINDENTC: 0080000077/07/05 + PROCINDENT := FINDVALUE; 0080100077/07/05 + RESETC: 0080200077/07/05 + DKEY := 1; 0080300077/07/05 + SETC: DKEY := 0; 0080400077/07/05 + END CASES; 0080500077/07/05 + END WHILE; 00806000 +END OF DOLLARCARD; 0080700081/10/14.1 +PROCEDURE DOSTMT(M); 00808000 +VALUE 00809000 + M; 00810000 +INTEGER 00811000 + M; 00812000 +BEGIN 00813000 + INTEGER 00814000 + DODELTA; 00815000 + DOSDOING := * + 1; 00816000 + DOBLOCKCOUNT := 0; 00817000 + PUTTOKEN; % THE "DO" 00818000 + IF BEGINOFFSET >= 0 THEN 0081900077/03/22 + BEGIN 0082000077/03/22 + SKAN; 0082100077/03/22 + INHIBITSCAN := TRUE; 0082200077/03/22 + IF ITSABEGIN THEN 00823000 + DODELTA := 3; 00824000 + END; 00825000 + IF DODELTA = 0 THEN 0082600076/07/20 + BEGIN 0082700076/07/20 + EMIT; 0082800076/07/20 + DODELTA := INCREMENT; 00829000 + END; 00830000 + LASTTYPE := UNDEFINED; 0083100077/03/22 + ALREADYINDENTED := FALSE; 00832000 + TRANSFERSTMT(TRUE,M + DODELTA,INCREMENT);% XFER UNTIL "UNTIL" 00833000 + IF ^ LINEEMPTY THEN 0083400076/07/29 + EMIT; % SO THAT THE "END" WILL BE ON A LINE OF ITS ON 0083500076/07/29 + INITIALIZEDEST(M); 0083600076/07/20 + LASTTYPE := UNDEFINED; 0083700077/03/22 + DOSDOING := * - 1; 00838000 + TYPE := KIDFR; % LOOKING AT THE "UNTIL" 0083900078/07/24 +END DOSTMT; 0084000081/10/14.1 +PROCEDURE EMITTER(NOCOMMENTCHK); 0084100076/07/20 +VALUE 0084200076/07/20 + NOCOMMENTCHK; 0084300076/07/20 +BOOLEAN 0084400076/07/20 + NOCOMMENTCHK; 0084500076/07/20 +BEGIN 0084600076/07/20 + IF ^ NOCOMMENTCHK THEN 0084700076/07/20 + BEGIN 0084800076/07/20 + SCAN PIN:PIN FOR CIN:CIN UNTIL ^= " "; 0084900076/07/20 + IF PIN = "%" OR PIN = "$" THEN 0085000076/07/20 + BEGIN % DO % COMMENT THAT STAYS ON A CARD. 0085100076/07/20 + SKAN; 0085200076/07/20 + PUTCOMMENT; 0085300076/07/20 + END 0085400076/07/20 + ELSE 0085500076/07/20 + NOCOMMENTCHK := ^ LINEEMPTY; 0085600076/07/20 + END; 0085700076/07/20 + IF NOCOMMENTCHK AND (ACTIVESUPERTOKEN IMP DECLFLAG) THEN 0085800076/07/20 + BEGIN 0085900076/07/20 + REPLACE DEST[72] BY SEQ := SEQ + SEQINC FOR 8 DIGITS; 0086000076/07/20 + IF LISTTOG THEN 0086100076/07/20 + PRINTITNEAT; 0086200076/07/20 + IF MAKENEWFILE THEN 0086300076/07/20 + WRITE(OUTPUT,15,DEST); 0086400076/07/20 + BLANKOUT; 0086500076/07/20 + LASTTYPE := UNDEFINED; 0086600077/03/22 + END; 0086700076/07/20 +END EMITTER; 0086800081/10/14.1 +BOOLEAN PROCEDURE FIND(P,N,DESC); 0086900077/07/05 +VALUE 00870000 + P, 00871000 + N; 0087200077/07/05 +POINTER 00873000 + P; 00874000 +INTEGER 0087500077/07/05 + N, 0087600077/07/05 + DESC; 0087700077/07/05 +BEGIN 0087800077/07/05 + DESC := 0; 0087900077/07/05 + IF P = "'" THEN % CT STUFF 0088000077/07/05 + BEGIN 0088100077/07/05 + P := * + 1; 0088200077/07/05 + N := * - 1; 0088300077/07/05 + END; 0088400077/07/05 + IF FOUNDVERB(P,N,DESC) THEN 0088500077/07/05 + CASE DECLANGUAGE(DESC) OF 0088600077/07/05 + BEGIN 0088700077/07/05 + ALGOL: 0088800077/07/05 + FIND := TRUE; 0088900077/07/05 + DCALGOL: 0089000077/07/05 + IF ^ FIND := INPUTFKIND = VALUE(DCALGOLSYMBOL) THEN 0089100077/07/05 + DESC := 0; 0089200077/07/05 + ESPOL: 0089300077/07/05 + IF ^ FIND := INPUTFKIND = VALUE(ESPOLSYMBOL) THEN 0089400077/07/05 + DESC := 0; 0089500077/07/05 + ESPOLORDCALGOL: 0089600077/07/05 + IF ^ FIND := INPUTFKIND = VALUE(DCALGOLSYMBOL) OR INPUTFKIND 0089700077/07/05 + = VALUE(ESPOLSYMBOL) 0089800077/07/05 + THEN 0089900077/07/05 + DESC := 0; 0090000077/07/05 + END DECLANGUAGE CASE; 0090100077/07/05 +END OF FIND; 0090200081/10/14.1 + 0090210081/10/14.1 + % INCLUDE FOUNDVERB="COPYLIB/PUBLISH/FOUNDVERB" 0090211081/10/14.1 +BOOLEAN PROCEDURE FOUNDVERB(VERB,SZ,DESC); 0090212081/10/14.1 +VALUE VERB,SZ; 0090213081/10/14.1 +INTEGER SZ,DESC; 0090214081/10/14.1 +POINTER VERB; 0090215081/10/14.1 +BEGIN 0090216081/10/14.1 +DEFINE HASH(R,PTR) = 0090217081/10/14.1 + (R:=(R:=REAL(PTR,1)).[3:4]-1-R.[5:1]+9*R.[5:2])#; 0090218081/10/14.1 +INTEGER FIRST 0090219081/10/14.1 + ,LAST 0090220081/10/14.1 + ,H = LAST; 0090221081/10/14.1 +IF SZ > 0 THEN 0090222081/10/14.1 + IF HASH(H,VERB) < 35 AND H >= 0 THEN 0090223081/10/14.1 + BEGIN 0090224081/10/14.1 + FIRST:=COARSEINDEX[H].COARSESTARTF-INFOENTRYSIZE; 0090225081/10/14.1 + LAST := COARSEINDEX[H].COARSEFINISHF; 0090226081/10/14.1 + DO FIRST := *+INFOENTRYSIZE 0090227081/10/14.1 + UNTIL IF FIRST > LAST THEN TRUE 0090228081/10/14.1 + ELSE 0090229081/10/14.1 + IF SZ < MINSIZE(FIRST) THEN TRUE 0090230081/10/14.1 + ELSE 0090231081/10/14.1 + IF SZ <= INFOTEXTSIZE(FIRST) THEN 0090232081/10/14.1 + FOUNDVERB:=VERB=LEXICONTEXT[INFOLEXPTR(FIRST)] FOR SZ 0090233081/10/14.1 + ELSE 0090234081/10/14.1 + FALSE; 0090235081/10/14.1 + IF FOUNDVERB := * THEN 0090236081/10/14.1 + DESC := FIRST; 0090237081/10/14.1 + END HASH LSS 35; 0090238081/10/14.1 +END PROCEDURE FOUNDVERB; 0090239081/10/14.1 +PROCEDURE HANDLECOMMENT; 00902400120323PK +BEGIN 00902420120323PK + INTEGER 00902440120323PK + INDENT, 00902460120323PK + OUTDENT; 00902480120323PK + INDENT:= MAX(OFFSET(PIN)-7, 0); 00902500120323PK + OUTDENT:= OFFSET(POUT); 00902520120323PK + IF INDENT <= OUTDENT+1 THEN 00902540120323PK + EMITWITHNOCOMMENTCHK; 00902580120323PK + INITIALIZEDEST(INDENT); 00902600120323PK + PUTTOKEN; % "COMMENT" 00902640120323PK + DO BEGIN 0090268076/07/19 + IF CIN <= 0 THEN 0090270076/07/19 + BEGIN 0090272076/07/19 + EMITWITHNOCOMMENTCHK; 0090274076/07/19 + NEXTCARD; 00902760120323PK + INITIALIZEDEST(0); 00902780120323PK + END; 00902800120323PK + REPLACE POUT:POUT BY 0090282076/07/20 + PIN:PIN FOR CIN:CIN UNTIL = ";"; 0090284076/07/20 + END 0090286076/07/19 + UNTIL PIN = ";"; 0090288076/07/19 + REPLACE POUT:POUT BY PIN:PIN FOR 1; 0090290076/07/19 + EMITWITHNOCOMMENTCHK; 0090292076/07/19 + CIN := CIN - 1; 0090294076/07/20 +END OF HANDLECOMMENT; 00902960120323PK +PROCEDURE IFCLAUSE(SS,M,F,E); % ENTER WITH PA POINTING TO "IF" 0090300076/07/19 +VALUE 00904000 + SS, 00905000 + M; 00906000 +BOOLEAN 00907000 + SS, % SS = TRUE IF THIS "IF" IS A STMT STARTER 00908000 + F, % TRUE IF TRANSFERSTMT IS TO EXIT (OUTPUT PARAMETER) 00909000 + E; % TRUE IF THIS "IF" HAS AN "ELSE" 00910000 +INTEGER 00911000 + M; % M IS THE MARGIN OF THE IF CLAUSE 00912000 +BEGIN 0091300077/03/21 + BOOLEAN 0091400077/03/21 + DOINGSUPERTOKEN; 0091500077/03/21 + INTEGER 0091600076/07/19 + IE = E, 0091700076/07/19 + INDENT, 0091800077/03/18 + THISSEQ; 0091900077/03/18 + IFSDOING := * + 1; 0092000077/03/18 + F := TRUE; 0092100077/03/21 + IF ^ (SS OR DOINGSUPERTOKEN := ACTIVESUPERTOKEN) THEN 0092200077/03/21 + IF LASTTYPE = IDFR THEN 0092300077/03/21 + M := * + INCREMENT 0092400077/03/21 + ELSE 0092500077/03/21 + IF ^ LINEEMPTY THEN 0092600077/03/21 + BEGIN 0092700077/03/21 + EMITANDINDENT2; 0092800077/03/21 + M := * + 2; 0092900077/03/18 + END; 0093000077/03/21 + PUTTOKEN; % XFER THE "IF" TO OUTPUT LINE 0093100076/07/19 + THISSEQ := SEQ; 0093200077/03/18 + LASTTYPE := IDFR; 0093300077/03/18 + TRANSFERSTMT(FALSE,M,INCREMENT); % XFER UNTIL THE "THEN" 0093400076/07/19 + IF PA ^= "#" THEN 0093500077/03/21 + IF DOINGSUPERTOKEN THEN 0093600077/03/21 + BUILDSUPERTOKEN 0093700077/03/21 + ELSE 0093800077/03/21 + BEGIN 0093900077/03/21 + IF THISSEQ ^= SEQ OR CA > COT THEN 0094000077/03/21 + BEGIN % IF CLAUSE NEEDS MORE THAN ONE LINE 0094100077/03/21 + IF ^ LINEEMPTY THEN 0094200077/03/18 + EMITWITHNOCOMMENTCHK; 0094300077/03/18 + INITIALIZEDEST(M); 0094400077/03/18 + END; 0094500077/03/18 + PUTTOKEN; % THE "THEN" 0094600077/03/18 + EMIT; % SPOUT THE IF CLAUSE 00947000 + SKAN; % PEEK 00948000 + INHIBITSCAN := ALREADYINDENTED := TRUE; 00949000 + IF ITSANIF IMP INDENTTHENIF THEN 0095000077/03/18 + INDENT := INCREMENT; % FOR STMT FOLLOWING "THEN" 0095100077/03/18 + END; 0095200077/02/24 + IF PA ^= "#" THEN % XFER TILL "ELSE" OR ";" 0095300077/03/21 + TRANSFERSTMT(^DOINGSUPERTOKEN,M + INDENT,INCREMENT); 0095400077/03/21 + IF E := ITSANELSE THEN % "ELSE" IS NOT YET IN DEST 0095500077/03/21 + IF DOINGSUPERTOKEN THEN 0095600077/03/21 + BEGIN 0095700077/03/21 + BUILDSUPERTOKEN; 0095800077/03/21 + IF ^ ACTIVESUPERTOKEN THEN % THIS "ELSE" STOPPED IT 0095900077/03/24 + IF SUPERTOKENSTARTER = REPLCLASS THEN 0096000077/03/24 + BEGIN % RESTART IT 0096100077/03/24 + EMITANDINDENT2; 0096200077/03/24 + ACTIVESUPERTOKEN := TRUE; 0096300077/03/24 + END; 0096400077/03/24 + E := F := FALSE; 0096500077/03/21 + END 0096600077/03/21 + ELSE 0096700077/03/21 + BEGIN 0096800077/03/21 + IF ACTIVESUPERTOKEN THEN % THIS ELSE ENDS A REPLACE 0096900077/03/21 + TRANSFERSUPERTOKEN; 0097000077/03/21 + IF ^ LINEEMPTY THEN 00971000 + EMITWITHNOCOMMENTCHK; 00972000 + INITIALIZEDEST(M + ELSEOFFSET); 0097300076/07/19 + PUTTOKEN; % TRANSFER THE "ELSE" TO DESTINATION 00974000 + EMIT; % SETS "LASTTYPE" TO UNDEFINED 0097500077/03/21 + SKAN; 00976000 + INHIBITSCAN := TRUE; 0097700077/03/18 + IE.ELSEMARGINF := 0097800077/03/21 + IF ITSANIF IMP INDENTELSEIF THEN 0097900077/03/21 + M + INCREMENT 0098000077/03/21 + ELSE 0098100077/03/21 + M; 0098200077/03/21 + END 0098300076/07/19 + ELSE % NOT AN "ELSE"; MUST BE ";" OR "END" 0098400076/07/19 + F := ^ ITSANEND; % SET F IF ITS A ";" 0098500077/03/18 + IFSDOING := * - 1; 0098600077/03/18 +END OF IFCLAUSE; 0098700081/10/14.1 +BOOLEAN PROCEDURE INITIALIZATION; 0098800078/07/27 +BEGIN 0098900078/07/27 + EBCDIC VALUE ARRAY 0099000078/07/27 + FKMSGS("INPUT MUST BE ALGOL, DCALGOL OR ESPOL SYMBOLIC" 0099100078/07/27 + 48"00""SEQDATA FILE ASSUMED TO BE ALGOL SYMBOLIC"48"00"); 0099200078/07/27 + BOOLEAN 0099300078/07/27 + FKOK; 0099400078/07/27 + INTEGER 0099500078/07/27 + COL = FKOK; 0099600078/07/27 + POINTER 0099700076/07/14 + SP, 0099800076/07/14 + PFNA; 0099900076/07/14 + PROCEDURE PUTPERIODAFTERFILENAME(SP,COL); 0100000076/07/14 + INTEGER 0100100076/07/14 + COL; 0100200076/07/14 + POINTER 0100300076/07/14 + SP; 0100400076/07/14 + BEGIN 0100500076/07/14 + POINTER 0100600076/07/14 + TP; 0100700076/07/14 + DO BEGIN 0100800076/07/14 + IF SP = "/" THEN 0100900076/07/14 + BEGIN 0101000076/07/14 + SP := * + 1; 0101100076/07/14 + COL := * - 1; 0101200076/07/14 + END; 0101300076/07/14 + IF SP = QUOTE THEN 0101400077/07/07 + BEGIN 0101500077/07/07 + SCAN SP:SP + 1 FOR COL:COL - 1 UNTIL = QUOTE; 0101600077/07/07 + SP := * + 1; 0101700076/07/14 + COL := * - 1; 0101800076/07/14 + END 0101900076/07/14 + ELSE 0102000076/07/14 + SCAN SP:SP FOR COL:COL WHILE IN ALPHA; 0102100076/07/14 + END 0102200076/07/19 + UNTIL SP ^= "/"; 0102300076/07/19 + TP := SP; 0102400076/07/14 + SCAN SP:SP FOR COL:COL WHILE = " "; 0102500076/07/14 + IF COL > 0 THEN 0102600076/07/14 + IF SP = "ON " THEN 0102700076/07/14 + BEGIN 0102800076/07/14 + SCAN SP:SP + 3 FOR COL:COL - 3 UNTIL IN ALPHA; 0102900076/07/14 + SCAN SP:SP FOR COL:COL WHILE IN ALPHA; 0103000076/07/14 + TP := SP; 0103100076/07/14 + END; 0103200076/07/14 + REPLACE TP BY "."; 0103300076/07/14 + END PUT PERIOD AFTER FILE NAME; 0103400081/10/14.1 + INDENTTHENIF := LEFTCOMMENTS := LOCKCOMMENTS := NEATUPTOG := 0103500080/08/04 + ONEPERLINE := TRUE; 0103600080/08/04 + INCREMENT := 3; 01037000 + DECINDENT := 7; 01038000 + DEFINEINDENT := 22; 0103900076/11/15 + PROCINDENT := OBMARGIN := 5; 0104000078/07/24 + LINELENGTH := 72; 01041000 + SEQINC := 1000; 01042000 + STOKP := SUPERTOK; 0104300076/07/20 + SCAN SP := PARA FOR COL:256 UNTIL = 48"00"; 0104400076/07/14 + COL := 256 - COL; 0104500076/07/14 + SCAN SP:SP FOR COL:COL WHILE = " "; 0104600076/07/14 + PFNA := SP; 0104700076/07/14 + PUTPERIODAFTERFILENAME(SP,COL); 0104800076/07/14 + REPLACE INPUT.TITLE BY PFNA; 0104900076/07/19 + INPUT.OPEN := TRUE; 0105000076/07/19 + SCAN SP:SP FOR COL:COL UNTIL IN ALPHA; 0105100076/07/14 + IF COL > 0 THEN 0105200076/07/15 + BEGIN 0105300076/07/15 + IF IF COL >= 4 THEN 0105400076/07/15 + SP = "MAKE" 0105500076/07/15 + ELSE 0105600076/07/15 + FALSE 0105700076/07/15 + THEN 0105800076/07/15 + BEGIN 0105900076/07/15 + SCAN SP:SP + 4 FOR COL:COL - 4 WHILE = " "; 0106000076/07/15 + IF IF COL >= 4 THEN 0106100076/07/19 + SP = "SELF" AND SP + 4 ^= "/" 0106200076/07/19 + ELSE 0106300076/07/19 + FALSE 0106400076/07/19 + THEN 0106500076/07/19 + ELSE 0106600076/07/19 + BEGIN 0106700076/07/19 + PFNA := SP; 0106800076/07/19 + PUTPERIODAFTERFILENAME(SP,COL); 0106900076/07/19 + END; 0107000076/07/19 + REPLACE OUTPUT.TITLE BY PFNA; 0107100076/07/19 + MAKENEWFILE := TRUE; 0107200076/07/14 + SCAN SP:SP FOR COL:COL UNTIL IN ALPHA; 0107300076/07/14 + END; 0107400076/07/14 + IF COL > 0 THEN % NEATUP OPTIONS INCLUDED 0107500076/07/14 + DOLLARCARD(SP,COL); 0107600076/07/19 + END; 0107700076/07/14 + INPUTFKIND := INPUT.FILEKIND; 0107800078/07/27 + OUTPUT.FILEKIND := INPUTFKIND; 0107900078/07/27 + FKOK := TRUE; 0108000078/07/27 + IF INPUTFKIND ^= VALUE(ALGOLSYMBOL) THEN 0108100078/07/27 + IF INPUTFKIND ^= VALUE(DCALGOLSYMBOL) THEN 0108200078/07/27 + IF INPUTFKIND ^= VALUE(DMALGOLSYMBOL) THEN 0108300078/07/27 + IF INPUTFKIND ^= VALUE(ESPOLSYMBOL) THEN 0108400078/07/27 + IF INPUTFKIND = VALUE(SEQDATA) THEN 0108500078/07/27 + BEGIN 0108600078/07/27 + INPUTFKIND := VALUE(ALGOLSYMBOL); 0108700078/07/27 + DISPLAY(FKMSGS[47]); 0108800078/07/27 + END 0108900078/07/27 + ELSE 0109000078/07/27 + BEGIN 0109100078/07/27 + FKOK := FALSE; 0109200078/07/27 + DISPLAY(FKMSGS[0]); 0109300078/07/27 + END; 0109400078/07/27 + IF INITIALIZATION := FKOK THEN 01095000 + BEGIN 01096000 + BLANKOUT; 01097000 + REPLACE SOURCE BY " " FOR 15 WORDS; 01098000 + INITIALIZEDEST(0); 0109900078/07/25 + DO BEGIN % PROCESS INITIAL "$" AND "%" CARDS 0110000078/07/24 + SKAN; 0110100078/07/24 + IF TYPE = PCOMMENT THEN 0110200078/07/24 + PUTCOMMENT; 0110300078/07/24 + END 0110400078/07/24 + UNTIL TYPE ^= PCOMMENT; 0110500078/07/24 + IF PA = "[" THEN % PROCESS GLOBAL DECLARATIONS 0110600078/07/24 + BEGIN 0110700078/07/24 + INITIALIZEDEST(0); 0110800078/07/24 + ACTIVESUPERTOKEN := FALSE; 0110900078/07/24 + PUTTOKEN; 0111000078/07/24 + PROCESSINGGLOBALDECS := TRUE; 0111100078/07/25 + DO BEGIN 0111200078/07/25 + EMIT; 0111300078/07/25 + TRANSFERSTMT(TRUE,0,INCREMENT); 0111400078/07/24 + END 0111500078/07/25 + UNTIL PA = "]"; 0111600078/07/25 + PROCESSINGGLOBALDECS := FALSE; 0111700078/07/25 + EMIT; 0111800078/07/25 + SKAN; 0111900078/07/24 + END; 0112000078/07/24 + INHIBITSCAN := ALREADYINDENTED := FIRSTBLOCK := TRUE; 0112100078/07/25 + END; 0112200078/07/27 +END INITIALIZATION; 0112300081/10/14.1 +PROCEDURE ITERATIONCLAUSE(M); 01124000 +VALUE 01125000 + M; 01126000 +INTEGER 01127000 + M; 01128000 +BEGIN 0112900077/07/08 + INTEGER 0113000077/07/08 + THISSEQ; 0113100077/07/08 + PUTTOKEN; % TRANSFER START OF ITERATION CLAUSE 01132000 + SPACEFLAG := PIN IN OPENERS; 0113300078/07/24 + LOOKINGFORDO := TRUE; 01134000 + LASTTYPE := IDFR; 01135000 + THISSEQ := SEQ; 0113600077/07/08 + TRANSFERSTMT(FALSE,M,INCREMENT); % XFER UNTIL "DO" 01137000 + LOOKINGFORDO := FALSE; 01138000 + IF PA ^= "#" THEN 0113900077/07/08 + BEGIN 0114000077/07/08 + IF THISSEQ ^= SEQ OR CA > COT THEN % DO ON ANOTHER LINE 0114100077/07/08 + BEGIN 0114200077/07/08 + IF ^ LINEEMPTY THEN 0114300077/07/08 + EMITWITHNOCOMMENTCHK; 0114400077/07/08 + INITIALIZEDEST(M); 0114500077/07/08 + END; 0114600077/07/08 + PUTTOKEN; 0114700077/07/08 + EMIT; % SPOUT THE ITERATION CLAUSE 0114800077/07/08 + END; 0114900077/07/08 +END OF ITERATIONCLAUSE; 0115000081/10/14.1 +BOOLEAN PROCEDURE ITSALABEL; 01151000 +BEGIN 01152000 + SCANTILNOTBLANK; 01153000 + IF ^ DECLFLAG THEN 01154000 + IF PIN = ":" THEN 01155000 + ITSALABEL := PIN + 1 ^= "="; 01156000 +END OF ITSALABEL; 0115700081/10/14.1 +PROCEDURE NEXTCARD; 01158000 +BEGIN 01159000 + INTEGER 01160000 + TS; 01161000 + POINTER 01162000 + TP; 01163000 + DO BEGIN 0116400078/07/27 + READ(INPUT,90,SOURCE)[EOF]; 0116500078/07/27 + REPLACE DEST[80] BY "=", 01166000120323PK + SOURCE[72] FOR 8, "="; % PRESERVE ORIGINAL SEQ NBR 01166100120323PK + SCAN TP:PIN := SOURCE FOR TS:CIN := 72 WHILE = " "; 0116700076/07/20 + IF ^ NEATUPTOG OR OMITTOG THEN 0116800081/10/14.1 + IF TP = "$" THEN 0116900076/07/19 + DOLLARCARD(TP,TS); 0117000076/07/19 + IF ^ NEATUPTOG OR OMITTOG THEN 0117100081/10/14.1 + COPY; 0117200076/07/19 + END 0117300081/09/22 + UNTIL NEATUPTOG AND ^ OMITTOG; 0117400081/10/14.1 +END NEXTCARD; 0117500081/10/14.1 +PROCEDURE PRINTITNEAT; 01176000 +BEGIN 01177000 + REAL 01178000 + T; 01179000 + OWN BOOLEAN 01180000 + HADAHEADING; 01181000 + IF HADAHEADING THEN % NOTHING 01182000 + ELSE 01183000 + BEGIN 01184000 + REPLACE PBUF BY " " FOR 22 WORDS; 01185000 + IF MAKENEWFILE THEN 01186000 + REPLACE PBUF BY OUTPUT.TITLE 01187000 + ELSE 01188000 + REPLACE PBUF BY INPUT.TITLE; 01189000 + REPLACE PBUF[80] BY 0119000081/10/14.1 + (T:= TIME (15)).[15:48] FOR 2, "/", 0119010081/10/14.1 + T FOR 2, "/", 0119020081/10/14.1 + T.[31:48] FOR 2, " " FOR 3, 0119030081/10/14.1 + (T:= TIME (1) DIV 3600) DIV 60 FOR 2 DIGITS, ":", 0119040081/10/14.1 + T MOD 60 FOR 2 DIGITS; 0119050081/10/14.1 + WRITE(LINE[SPACE 3],22,PBUF); 01191000 + HADAHEADING := TRUE; 01192000 + END; 01193000 + REPLACE PBUF BY " " FOR 22 WORDS; 01194000 + REPLACE PBUF BY " " FOR 8 - T := DIGITSIN(SEQ), SEQ FOR T DIGITS, 01195000 + " " FOR 5,DEST FOR 72, " " FOR 8, SEQ FOR 8 DIGITS, " " FOR 5, 01196000 + DEST[80] FOR 10 WHILE >= " "; 01197000 + WRITE(LINE,22,PBUF); 01198000 +END PRINTITNEAT; 0119900081/10/14.1 +PROCEDURE PUTCOMMENT; % SCANNER HAS ENCOUNTERED A "%" COMMENT WHICH 0120000077/07/06 +BEGIN % IS CURRENTLY IN ACCUM. -- IF COMMENT WAS 01201000 + BOOLEAN 0120200077/07/06 + DOLLAR, 0120300077/07/06 + DOLLARDONE, 0120400077/07/06 + REACTIVATESUPERTOKEN; 0120500077/03/01 + INTEGER 0120600077/03/01 + OLDACTIVEPARENS, 0120700077/03/01 + OLDACTIVEBRACKETS; 0120800077/03/01 + POINTER 01209000 + PC; 01210000 + IF ACTIVESUPERTOKEN THEN 0121100077/03/01 + BEGIN 0121200077/03/01 + REACTIVATESUPERTOKEN := TRUE; 0121300077/03/01 + OLDACTIVEPARENS := ACTIVEPARENS; 0121400077/03/01 + OLDACTIVEBRACKETS := ACTIVEBRACKETS; 0121500077/03/01 + TRANSFERSUPERTOKEN; 01216000 + END; 0121700077/03/01 + IF DOLLAR := PA = "$" THEN 01218000 + BEGIN 01219000 + SCAN PC:SOURCE FOR 72 WHILE = " "; 01220000 + IF PC = "$" THEN % ON A LINE OF ITS ON - DO IT FIRST 01221000 + BEGIN 01222000 + DOLLARDONE := TRUE; 01223000 + DOLLARCARD(PA,CA); 01224000 + END; 01225000 + END; 01226000 + IF CA = 72 THEN % ON A CARD BY ITSELF IT IS SIMPLY TRANSFERRED01227000 + BEGIN 01228000 + IF ^ LINEEMPTY THEN 01229000 + EMITWITHNOCOMMENTCHK; % SPOUT CURRENT CONTENTS 01230000 + REPLACE DEST BY PA FOR 72; 01231000 + END 01232000 + ELSE 01233000 + BEGIN 01234000 + STRIPTRAILINGBLANKS; 01235000 + PC := 0123600080/09/11 + IF DOLLAR OR (LOCKCOMMENTS 0123700077/07/06 + AND (LEFTCOMMENTS IMP MARKER + OFFSET(POUT) <= 72)) 0123800077/07/06 + THEN 0123900077/07/06 + DEST[72 - MARKER] 0124000077/07/06 + ELSE 0124100077/07/06 + IF LEFTCOMMENTS AND CA + OFFSET(POUT) < 72 THEN 0124200077/07/06 + POUT + REAL(DEST[OFFSET(POUT) - 1] ^= " ") 0124300077/07/06 + ELSE 0124400077/07/06 + IF LOCKCOMMENTS THEN 0124500077/07/06 + DEST[72 - MARKER] 0124600077/07/06 + ELSE 0124700077/07/06 + DEST[LINELENGTH - CA]; 0124800077/07/06 + IF OFFSET(PC) < OFFSET(POUT) THEN 01249000 + IF ^ LINEEMPTY THEN 01250000 + EMITWITHNOCOMMENTCHK; % WON'T FIT 01251000 + REPLACE PC BY PA FOR CA; 01252000 + COT := 0125300077/03/21 + IF DECLFLAG THEN 0125400077/03/21 + BLOCKBASE + DECINDENT + 2 0125500077/03/21 + ELSE 0125600077/03/21 + GMARGIN + 2; 0125700077/03/21 + POUT := DEST[COT]; 01258000 + COT := LINELENGTH - COT; 01259000 + END; 01260000 + IF (CA = 72 AND DOLLAR) THEN % NEVER COPY $ CARDS IN COL 1 0126100077/07/06 + BLANKOUT 01262000 + ELSE 01263000 + EMITWITHNOCOMMENTCHK; 01264000 + IF DOLLAR AND ^ DOLLARDONE THEN 0126500077/03/01 + DOLLARCARD(PA,CA); 0126600077/03/01 + IF REACTIVATESUPERTOKEN THEN 0126700077/03/01 + BEGIN 0126800077/03/01 + ACTIVESUPERTOKEN := TRUE; 0126900077/03/01 + ACTIVEPARENS := OLDACTIVEPARENS; 0127000077/03/01 + ACTIVEBRACKETS := OLDACTIVEBRACKETS; 0127100077/03/01 + END; 0127200077/03/01 +END OF PUTCOMMENT; 0127300081/10/14.1 +PROCEDURE PUTLABEL(LP,LL,MARGIN,BACKOFF); 01274000 +VALUE 01275000 + LP, 01276000 + LL, 01277000 + MARGIN, 01278000 + BACKOFF; 01279000 +INTEGER 01280000 + LL, 01281000 + MARGIN, 01282000 + BACKOFF; 01283000 +POINTER 01284000 + LP; 01285000 +BEGIN 01286000 + REAL 01287000 + LLLIMIT = MARGIN; 01288000 + IF ^ LINEEMPTY THEN 01289000 + EMIT; 01290000 + REPLACE POUT:DEST[MAX(0,MARGIN - 2 * BACKOFF)] BY LP FOR LL, ":"; 01291000120323PK + COT:= 72-OFFSET(POUT); 01291100120323PK + PIN := PIN + 1; % MOVE SOURCE PTR PAST THE ":" 01292000 + CIN := CIN - 1; 01293000 + SKAN; 0129400077/03/22 + INHIBITSCAN := TRUE; 0129500077/03/22 + LLLIMIT := 0129600077/03/21 + IF 2 * BACKOFF >= MARGIN THEN 0129700077/03/21 + MARGIN 0129800077/03/21 + ELSE 0129900077/03/21 + IF ITSABEGIN AND ALREADYINDENTED THEN 0130000077/03/21 + BACKOFF 0130100077/03/21 + ELSE 0130200077/03/21 + 2 * BACKOFF; 0130300077/03/21 + IF LL + 1 >= LLLIMIT THEN 01304000 + EMITWITHNOCOMMENTCHK; % LABEL IS TOO LONG FOR WHAT FOLLOWS 01305000 +END OF PUTLABEL; 0130600081/10/14.1 +PROCEDURE PUTTOKEN; % MOVES THE CURRENT TOKEN FROM PA TO DEST 01307000 +BEGIN 01308000 + IF ACTIVESUPERTOKEN THEN 01309000 + BUILDSUPERTOKEN 01310000 + ELSE 01311000 + BEGIN 01312000 + IF CA > COT THEN % NOT ENOUGH ROOM IN OUTPUT LINE 01313000 + EMITANDINDENT2; 01314000 + REPLACE POUT:POUT BY PA FOR CA; 01315000 + COT := COT - CA; 01316000 + END; 01317000 +END OF PUTTOKEN; 0131800081/10/14.1 +PROCEDURE SKANPRIMITIVE; % RETURNS (1) TYPE AND (2) CA--ITS SIZE 01319000120323PK +BEGIN 01320000 + LABEL 01321000 + AGAIN, 01322000 + NBR, 01323000 + EXPO; 01324000 + BOOLEAN 0132500077/03/01 + AFTERBLANK, 0132600077/03/01 + BEFOREBLANK; 01327000120323PK + INTEGER 01328000 + T; 01329000 + POINTER 0133000077/03/01 + OLDPA; 0133100077/03/01 + OLDPA := ACCUM[MAX(0,CA - 1)]; % LAST THING OUT 0133200077/03/01 + PA := ACCUM[CA := IDFRDESC := 0]; 0133300077/07/05 + SCANTILNOTBLANK; 01334000 + IF PIN IN IDFRSTARTERS THEN 0133500077/07/05 + BEGIN 0133600077/07/05 + TYPE := IDFR; 0133700077/07/05 + TRANSFER(WHILE IN IDFRVALIDS); 0133800077/07/05 + IF FIND(ACCUM,CA,IDFRDESC) THEN 0134000077/07/06 + TYPE := 0134100077/07/06 + IF ITEMKEY[IDFRDESC] = COMMENTC THEN 0134200077/07/06 + CCOMMENT 0134300077/07/06 + ELSE 0134400077/07/06 + KIDFR 01345000120323PK + ELSE 01345100120323PK + IF CA > 3 THEN 01345200120323PK + BEGIN 01345300120323PK + IF ACCUM[0] = "OCT" THEN 01345400120323PK + IF ACCUM[3] IN OCTALS FOR CA-3 THEN 01345500120323PK + REPLACE PA:ACCUM[0] BY "3"""", 01345600120323PK + ACCUM[3] FOR CA-3, """; 01345700120323PK + % CA IS UNCHANGED WITH THIS TRANSFORM. 01345800120323PK + END; 01345900120323PK + %% SCANTILNOTBLANK; 01346000120323PK + END IDENTIFIER 0134700077/07/05 + ELSE 0134800077/07/05 + IF PIN IN NUMERICS THEN 0134900077/07/05 + BEGIN 0135000077/07/05 + NBR: TYPE := ANUMBER; 0135100077/07/05 + TRANSFER(WHILE IN NUMERICS); 0135200077/07/05 + IF PIN = "." THEN % PICK UP FRACTIONAL PART 0135400077/07/05 + BEGIN 0135500077/07/05 + TRANSFERCT(1); 0135600077/07/05 + TRANSFER(WHILE IN NUMERICS); 0135700077/07/05 + END 0135800077/07/07 + ELSE 0135900077/07/07 + IF PIN = "@" THEN 0136000077/07/07 + GO TO EXPO 0136100077/07/07 + ELSE 0136200077/07/07 + IF PIN = QUOTE THEN % CALL STRING WITH CHAR SIZE A NUMBER 0136300077/07/07 + BEGIN 0136400077/07/07 + TRANSFERCT(2); 0136500077/07/07 + TRANSFER(UNTIL = QUOTE); 0136600077/07/07 + TRANSFERCT(1); 0136700077/07/07 + END; 0136800077/07/07 + END NUMBER 01369000 + ELSE 01370000 + IF PIN = QUOTE THEN 01371000 + BEGIN 01372000 + IF LASTTYPE ^= ANUMBER THEN 01372100120323PK + BEGIN 01372200120323PK + REPLACE PA:PA BY "6"; 01372300120323PK + CA := *+1; 01372400120323PK + END; 01372500120323PK + TRANSFERCT(2); 01373000 + AGAIN: 0137400077/07/07 + TRANSFER(UNTIL = QUOTE); 0137500077/07/07 + TRANSFERCT(1); 01376000 + $ SET OMIT 01376600110115PK + SCANTILNOTBLANK; % CHECK FOR A CONTINUED STRING ON0137700081/05/07 + IF LASTTYPE ^= ANUMBER THEN % === NEEDS WORK FOR 48" STUFF ==0137800081/05/07 + IF PIN = QUOTE THEN % THE SOURCE 0137900081/05/07 + IF PIN + 1 ^= QUOTE THEN % IF NEXT STRING DOESN'T START 0138000081/05/07 + BEGIN % WITH A QUOTE THEN CONNECT THEM.0138100081/05/07 + PIN := PIN + 1; 01382000 + CIN := CIN - 1; 01383000 + PA := PA - 1; % WIPE OUT THE OLD QUOTE 01384000 + CA := CA - 1; % ADJUST THE COUNT 01385000 + GO AGAIN; 01386000 + END; 01387000 + $ POP OMIT 01387100110115PK + TYPE := ASTRING; 0138800081/05/07 + END STRING 01389000 + ELSE 01390000 + IF PIN = "%" OR PIN = "$" THEN 01391000 + BEGIN 01392000 + MARKER := CIN; % FOR "LOCKCOMMENTS" OPTION 01393000 + TYPE := PCOMMENT; 01394000 + REPLACE PA BY PIN:PIN FOR CA := CIN; 01395000 + CIN := 0; 01396000 + END 0139700077/07/05 + ELSE 0139800077/07/05 + BEGIN %% OTHER SPECIAL CHARACTERS 0139900077/07/05 + %%IF PIN = 48"C0" THEN 01400000120323PK + %% REPLACE PIN BY "+"; 01401000120323PK + IF PIN = "." THEN 01402000 + IF PIN + 1 IN NUMERICS THEN % IT'S A DECIMAL POINT 01403000 + GO TO NBR; 01404000 + IF PIN = "@" THEN 01405000 + BEGIN 01406000 + EXPO: TRANSFERCT(1); 01407000 + IF PIN = "-" OR PIN = "+" THEN 01408000 + TRANSFERCT(1); 01409000 + GO TO NBR; 01410000 + END; 01411000 + TYPE := SPECIALCHAR; 01412000 + IF PIN IN BLANKAROUNDS THEN % ADD "AND PUTEXTRASPACES" FOR OPT 01414000 + BEGIN 01415000 + CASE REAL(PIN, 1) OF 01415020120323PK + BEGIN 01415030120323PK + "~": 01415040120323PK + REPLACE PA:PA BY ":= "; 01415060120323PK + CA := 3; 01415080120323PK + "!": 01415100120323PK + REPLACE PA:PA BY " ^= "; 01415120120323PK + CA := 4; 01415140120323PK + "{": 01415160120323PK + REPLACE PA:PA BY " <= "; 01415180120323PK + CA := 4; 01415200120323PK + "}": 01415220120323PK + REPLACE PA:PA BY " >= "; 01415240120323PK + CA := 4; 01415260120323PK + "|": 01415280120323PK + REPLACE PA:PA BY "*"; 01415300120323PK + CA := 1; 01415320120323PK + "*": 01415340120323PK + REPLACE PA:PA BY "**"; 01415360120323PK + CA := 2; 01415380120323PK + ":": 01415400120323PK + IF PIN+1 = "=" THEN 01415420120323PK + BEGIN 01415440120323PK + REPLACE PA:PA BY PIN FOR 2, " "; 01415460120323PK + PIN := *+1; 01415480120323PK + CIN := *-1; 01415500120323PK + CA := 3; 01415520120323PK + END 01415540120323PK + ELSE 01415560120323PK + BEGIN 01415580120323PK + REPLACE PA:PA BY PIN FOR 1; 01415600120323PK + CA := 1; 01415620120323PK + END; 01415640120323PK + ",": 01415700120323PK + REPLACE PA:PA BY ", "; 01415720120323PK + CA := 2; 01415740120323PK + ELSE: 01416800120323PK + IF PIN + 1 = "=" THEN 01416900120323PK + BEGIN 01417000 + REPLACE PA:PA BY " ", PIN FOR 2, " "; 01418000120323PK + PIN:= *+1; 01418100120323PK + CIN:= *-1; 01418200120323PK + CA := 4; 01419000120323PK + END 0142000077/07/07 + ELSE 0142100077/07/07 + BEGIN 01422000120323PK + IF LASTTYPE = SPECIALCHAR THEN 0142300077/07/07 + BEGIN 0142400077/07/07 + BEFOREBLANK := AFTERBLANK := 01425000120323PK + OLDPA IN BLANKAROUNDS OR OLDPA IN CLOSERS; 01425100120323PK + IF ^ BEFOREBLANK THEN 01426000120323PK + AFTERBLANK := OLDPA = " "; 0142700077/03/01 + % JUST ADD BLANK AFTER CHAR 0142800077/03/01 + END 0142900081/05/07 + ELSE 0143000081/05/07 + BEFOREBLANK := AFTERBLANK := LASTTYPE ^= ASTRING;01431000120323PK + IF BEFOREBLANK THEN 01431050120323PK + REPLACE PA:PA BY " "; 01431100120323PK + REPLACE PA:PA BY PIN FOR 1; 01431150120323PK + IF AFTERBLANK THEN 01431200120323PK + REPLACE PA:PA BY " "; 01431250120323PK + CA := 1 + REAL(BEFOREBLANK) + REAL(AFTERBLANK); 01431300120323PK + END; 01431350120323PK + END CASE; 01431400120323PK + PIN:= *+1; 01431450120323PK + CIN:= *-1; 01431500120323PK + END BLANKAROUNDS 01432000120323PK + ELSE 01433000 + BEGIN 01433100120323PK + IF PIN IN OPENERS THEN 01434000 + IF ^ ACTIVESUPERTOKEN THEN 01435000 + BEGIN 01436000 + ACTIVESUPERTOKEN := TRUE; 01437000 + SUPERTOKENSTARTER := REAL(PIN = "("); 01438000 + END; 01439000 + CIN := CIN - 1; 01440000120323PK + REPLACE PA BY PIN:PIN FOR (CA := 1); 01441000120323PK + END; 01441100120323PK + END SPECIAL CHARACTERS; 0144700077/07/05 + PA := ACCUM[0]; 0144800077/07/05 +END OF THE SCANNER; 0144900081/10/14.1 +PROCEDURE SKAN; % HANDLES INTER-TOKEN "COMMENT ... ;" SEQUENCES. 01449100120323PK +BEGIN 01449200120323PK + DO BEGIN 01449300120323PK + SKANPRIMITIVE; 01449400120323PK + IF TYPE = CCOMMENT THEN 01449500120323PK + BEGIN 01449550120323PK + HANDLECOMMENT; 01449600120323PK + COT := 0144961077/03/21 + IF DECLFLAG THEN 0144962077/03/21 + BLOCKBASE + DECINDENT + 2 0144963077/03/21 + ELSE 0144964077/03/21 + GMARGIN; 01449650120323PK + POUT := DEST[COT]; 01449660120323PK + COT := LINELENGTH - COT; 01449670120323PK + END; 01449680120323PK + END 01449700120323PK + UNTIL TYPE ^= CCOMMENT; 01449800120323PK +END OF SKAN; 01449900120323PK +PROCEDURE TRANSFERSTMT(STMTSTARTER,MARGIN,BACKOFF); 01450000 +VALUE 01451000 + STMTSTARTER, 01452000 + MARGIN, 01453000 + BACKOFF; 01454000 +BOOLEAN 01455000 + STMTSTARTER; 01456000 +INTEGER 01457000 + MARGIN, 01458000 + BACKOFF; 01459000 +BEGIN 01460000 + LABEL 01461000 + LOOP, 01462000 + XIT, 01463000 + DOIT; 01464000 + BOOLEAN 01465000 + ELSEF, 01466000 + FINIS, 01467000 + SPACEKEY, 01468000 + FLAG, 0146900078/07/26 + DONTPUTIT = FLAG, 0147000078/07/26 + ENDOFLINE; 01471000 + INTEGER 01472000 + OLDBLOCKBASE; 01473000 +LOOP: 01474000 + ENDOFLINE := FALSE; 01475000 + DO BEGIN 0147600077/03/22 + IF SPACEFLAG THEN 0147700077/03/22 + PUTBLANK; 0147800077/03/22 + SPACEFLAG := FALSE; 0147900077/03/22 + IF ^ INHIBITSCAN THEN 01480000 + SKAN; 01481000 + INHIBITSCAN := FALSE; 01482000 + IF STMTSTARTER THEN 0148300077/07/05 + BEGIN 0148400077/07/05 + IF DECLFLAG := ITSADECLARATION THEN 0148500077/07/05 + BEGIN 0148600077/07/05 + INITIALIZEDEST(BLOCKBASE); 0148700077/07/05 + IF ITSADEFINE THEN 01488000 + BEGIN 01489000 + DEFINEDECLARATION; 01490000 + GO LOOP; 01491000 + END; 01492000 + FLAG := FALSE; 01493000 + DO BEGIN 01494000 + IF ITSAPROCEDURE THEN 01495000 + PROCINPROGRESS := FLAG := TRUE; 01496000 + PUTTOKEN; 01497000 + PUTBLANK; 01498000 + SKAN; 01499000 + END 01500000 + UNTIL ^ ITSADECLARATION; 01501000 + IF ONEPERLINE THEN 01502000 + IF ^ (FLAG OR DEFINEINPROGRESS) THEN 01503000 + BEGIN 01504000 + EMITWITHNOCOMMENTCHK; 01505000 + INITIALIZEDEST(BLOCKBASE + DECINDENT); 01506000 + END; 01507000 + END 01508000 + ELSE % *** NOT A DECLARATION *** 01509000 + BEGIN 01510000 + IF PROCINPROGRESS AND TYPE ^= PCOMMENT THEN 01511000 + BEGIN 01512000 + PROCINPROGRESS := FALSE; 01513000 + ALREADYINDENTED := INHIBITSCAN := TRUE; 01514000 + TRANSFERSTMT(TRUE,BLOCKBASE+PROCINDENT,PROCINDENT); 01515000120323PK + EMIT; 01516000120323PK + REPLACE DEST[MARGIN] BY "%" FOR 72-MARGIN; 01516100120323PK + EMIT; 01516200120323PK + GO XIT; 01517000 + END; 01518000 + INITIALIZEDEST(MARGIN); 01519000 + IF ITSANITER THEN 01520000 + BEGIN 01521000 + ITERATIONCLAUSE(MARGIN); 01522000 + IF PA = "#" THEN 01523000 + GO XIT; 01524000 + MARGIN := MARGIN + INCREMENT; 01525000 + ALREADYINDENTED := TRUE; 01526000 + GO LOOP; 01527000 + END; 01528000 + IF ITSACASE THEN 0152900077/06/30 + BEGIN 0153000077/06/30 + CASESTMT(MARGIN); 0153100077/06/30 + GO LOOP; 0153200077/06/30 + END; 0153300077/06/30 + END OF STMTS; 01534000 + END OF STATEMENT STARTERS; 01535000 + DOIT: CASE TYPE OF 0153600078/07/24 + BEGIN 0153700078/07/24 + KIDFR: 0153800078/07/24 + IDFR: BEGIN % -- IDFR 0153900078/07/24 + IF SPACENEEDED THEN 01540000 + PUTBLANK; 01541000 + IF PIN IN OPENERS THEN % "([" 0154200077/03/22 + IF ^ SPACEFLAG := ITSARESWORD THEN % PUT IN A BLANK 0154300077/03/22 + IF ^ ACTIVESUPERTOKEN THEN 0154400081/05/07 + BEGIN 0154500081/05/07 + % DO NOW SO NONRESWORD IS PART OF SUPERTOKEN 0154600081/05/07 + ACTIVESUPERTOKEN := TRUE; 0154700077/03/22 + SUPERTOKENSTARTER := REAL(PIN = "("); 0154800077/03/22 + END; 0154900077/07/06 + TYPE := IDFR; 0155000077/07/06 + IF ITSABEGIN THEN 0155100078/07/25 + BEGIN 0155200078/07/25 + IF ALREADYINDENTED THEN 0155300078/07/25 + ALREADYINDENTED := FALSE 0155400078/07/25 + ELSE 0155500078/07/25 + MARGIN := MARGIN + INCREMENT; 0155600078/07/25 + IF DOINGADO THEN 01557000 + DOBLOCKCOUNT := * + 1; 01558000 + OLDBLOCKBASE := BLOCKBASE; 01559000 + IF FIRSTBLOCK THEN 0156000078/07/25 + FIRSTBLOCK := FALSE 0156100078/07/25 + ELSE 0156200078/07/25 + BLOCKBASE := MARGIN; 0156300078/07/25 + BLOCK(MARGIN,BACKOFF); 0156400078/07/25 + BLOCKBASE := OLDBLOCKBASE; 01565000 + IF DOINGADO THEN 01566000 + DOBLOCKCOUNT := * - 1; 01567000 + GO DOIT; 01568000 + END 01569000 + ELSE 01570000 + IF ITSANIF THEN 01571000 + BEGIN 01572000 + IFCLAUSE(STMTSTARTER,MARGIN,FINIS,ELSEF); 01573000 + IF ELSEF THEN 0157400077/03/18 + BEGIN 0157500077/03/18 + MARGIN := REAL(ELSEF.ELSEMARGINF); 0157600077/03/18 + INITIALIZEDEST(MARGIN); 0157700077/03/18 + ALREADYINDENTED := TRUE; 01578000 + GO LOOP; 01579000 + END; 01580000 + IF FINIS THEN 01581000 + GO XIT; 01582000 + IF ACTIVESUPERTOKEN THEN 0158300077/03/21 + GO LOOP; 0158400077/03/21 + END 01585000 + ELSE 01586000 + IF ITSADO AND ^ (LOOKINGFORDO OR ACTIVESUPERTOKEN) THEN01587000 + BEGIN 01588000 + DOSTMT(MARGIN); 01589000 + GO DOIT; 01590000 + END 0159100077/07/05 + ELSE 0159200077/07/05 + IF DECLFLAG AND PA = "'" THEN % CT OK IN DEC 0159300077/07/05 + IF ITSANITER THEN 0159400077/07/05 + BEGIN 0159500077/07/05 + ITERATIONCLAUSE(BLOCKBASE + DECINDENT); 0159600077/07/05 + IF PA = "#" THEN 0159700077/07/05 + GO XIT; 0159800077/07/05 + GO LOOP; 0159900077/07/05 + END; 0160000077/07/05 + IF STMTSTARTER THEN 01601000 + IF ITSALABEL THEN 01602000 + BEGIN 01603000 + PUTLABEL(PA,CA,MARGIN,BACKOFF); 01604000 + GO LOOP; 01605000 + END; 01606000 + DONTPUTIT := FALSE; 0160700078/07/26 + CASE ITEMKEY[IDFRDESC] OF 0160800078/07/26 + BEGIN 0160900078/07/26 + DOC: ENDOFLINE := DONTPUTIT := LOOKINGFORDO; 0161000078/07/26 + ELSE: ; 0161100078/07/26 + ENDC: ENDOFLINE := DONTPUTIT := TRUE; 0161200078/07/26 + OFC: ENDOFLINE := DONTPUTIT := LOOKINGFOROF; 0161300078/07/26 + THENC: 0161400078/07/26 + ELSEC: 0161500078/07/26 + ENDOFLINE := TRUE; 0161600078/07/26 + DONTPUTIT := IFSDOING > 0; 0161700078/07/26 + UNTILC: 0161800078/07/26 + ENDOFLINE := DONTPUTIT := ADOSUNTIL; 0161900078/07/26 + END CASE ON ITEMKEY; 0162000078/07/26 + IF ^ DONTPUTIT THEN 01621000 + BEGIN 01622000 + PUTTOKEN; 01623000 + IF ITSABY THEN 01624000 + BEGIN 01625000 + ACTIVESUPERTOKEN := TRUE; 01626000 + SUPERTOKENSTARTER := REPLCLASS; 01627000 + END; 01628000 + END; 01629000 + END OF IDFR; 01630000 + ANUMBER: 0163100078/07/24 + BEGIN % -- NUMBER 0163200078/07/24 + IF STMTSTARTER AND ^ DEFINEINPROGRESS THEN 01633000 + IF ITSALABEL THEN 01634000 + BEGIN % EMIT CASE NUMBER OF FORM 1: 01635000 + PUTLABEL(PA,CA,MARGIN,BACKOFF); 01636000 + GO LOOP; 01637000 + END; 01638000 + IF LASTTYPE = IDFR THEN 01639000 + PUTBLANK; 01640000 + PUTTOKEN; 01641000 + END OF NUMBER; 01642000 + SPECIALCHAR: 0164300078/07/24 + BEGIN % -- SPECIAL CHARACTER 0164400078/07/24 + IF PA = "#" THEN 01645000 + PUTBLANK 01646000 + ELSE 01647000 + IF ACTIVESUPERTOKEN AND SUPERTOKENSTARTER = PARENCLASS 01648000 + AND ACTIVEBRACKETS = 0 AND ACTIVEPARENS = 1 01649000 + THEN 01650000 + IF PA = ")" THEN 01651000 + IF ITSALABEL THEN 01652000 + BEGIN % EMIT CASE NUMBER OF FORM (--): 01653000 + ACTIVEPARENS := 2; % SO WON'T XFER SUPERTOKEN 0165400077/03/22 + BUILDSUPERTOKEN; 0165500077/03/22 + ACTIVESUPERTOKEN := FALSE; 0165600077/03/22 + PUTLABEL(STOKP := SUPERTOK,STL,MARGIN,BACKOFF)0165700077/03/22 + ; 0165800077/03/22 + ACTIVEPARENS := ACTIVEBRACKETS := STM := STL 01659000 + := LASTCOMMA := LASTTYPE := 0; 01660000 + STMTSTARTER := TRUE; 01661000 + GO LOOP; 01662000 + END; 01663000 + SPACEKEY := PA IN CLOSERS; % ) OR ] 0166400077/07/07 + IF ^ ENDOFLINE := PA = ";" OR PA = "#" THEN 0166500078/07/25 + IF PROCESSINGGLOBALDECS THEN 0166600078/07/25 + IF ^ DEFINEINPROGRESS THEN 0166700078/07/25 + ENDOFLINE := PA = "]" AND ^ ACTIVESUPERTOKEN; 0166800078/07/25 + PUTTOKEN; 01669000 + IF PA = "," AND ^ DEFINEINPROGRESS THEN 01670000 + BEGIN 01670100120323PK + SKAN; 01670200120323PK + INHIBITSCAN := TRUE; 01670300120323PK + SPACEFLAG := FALSE; 01670400120323PK + PROCESSCOMMA; 01671000 + END 01671100120323PK + END OF SPECIAL CHARACTER; 01672000 + ASTRING: 01673000 + BEGIN 01674000 + IF STMTSTARTER THEN 01675000 + IF ITSALABEL THEN 01676000 + BEGIN 01677000 + PUTLABEL(PA,CA,MARGIN,BACKOFF); 01678000 + GO LOOP; 01679000 + END; 01680000 + XFERSTRING; 01681000 + END; 01682000 + PCOMMENT: 0168300078/07/24 + BEGIN 0168400078/07/24 + PUTCOMMENT; % -- "%" COMMENT AND "$" CARDS 0168500078/07/24 + IF DECLFLAG THEN 01686000 + STMTSTARTER := FALSE; 01687000 + GO LOOP; 01688000 + END OF PERCENT COMMENT; 01689000 + CCOMMENT: 0169000077/07/06 + BEGIN 0169100077/07/06 + HANDLECOMMENT; 0169200077/07/06 + GO LOOP; 0169300077/07/06 + END OF NORMAL COMMENT; 0169400077/07/06 + ELSE: ; 01695000 + END OF CASES; 01696000 + LASTTYPE := TYPE; 01697000 + STMTSTARTER := FALSE; 01698000 + END 01699000 + UNTIL ENDOFLINE; 01700000 +XIT: ALREADYINDENTED := FALSE; 01701000 +END OF TRANSFERSTMT; 0170200081/10/14.1 +PROCEDURE TRANSFERSUPERTOKEN; 01703000 +BEGIN 01704000 + ACTIVESUPERTOKEN := FALSE; 01705000 + IF STL > 0 THEN % HAVE SOMETHING TO TRANSFER 0170600077/03/01 + IF COT >= STL THEN % IT FITS ON CURRENT LINE 01707000 + BEGIN 01708000 + REPLACE POUT:POUT BY SUPERTOK FOR STL; 01709000 + COT := COT - STL; 01710000 + IF SUPERTOKENSTARTER = REPLCLASS THEN 01711000 + PUTBLANK; 01712000 + END 01713000 + ELSE 01714000 + IF STL <= NEXTLINESIZE THEN % PUT IT ON THE NEXT LINE 01715000 + BEGIN 0171600077/03/24 + EMITANDINDENT2; 0171700077/03/24 + SCAN STOKP:SUPERTOK FOR STL:STL WHILE = " "; % NOT NEEDED 0171800077/03/21 + REPLACE POUT:POUT BY STOKP FOR STL; 0171900077/03/21 + COT := COT - STL; 01720000 + END 01721000 + ELSE 01722000 + BREAKITUP; 01723000 + ACTIVESUPERTOKEN := SUPERTOKENSTARTER = REPLCLASS AND PA = ","; 01724000 + ACTIVEPARENS := ACTIVEBRACKETS := STM := STL := LASTCOMMA := 0; 01725000 + STOKP := SUPERTOK; 01726000 +END OF TRANSFERSUPERTOKEN; 0172700081/10/14.1 +PROCEDURE XFERSTRING; % MOVES A STRING FROM ACCUM TO DEST 01728000 +BEGIN 01729000 + LABEL 01730000 + LOOP; 01731000 + BOOLEAN 01732000 + F; 01733000 + INTEGER 01734000 + NT, 01735000 + C1, 01736000 + C2; 01737000 + POINTER 01738000 + TP1, 01739000 + TP2; 01740000 + IF LASTTYPE IS IDFR THEN 01741000 + PUTBLANK; 01742000 + IF ACTIVESUPERTOKEN THEN 0174300077/06/14 + BUILDSUPERTOKEN 0174400077/06/14 + ELSE 0174500077/06/14 + BEGIN 0174600077/06/14 + IF F := PA + (CA - 1) = " " THEN % A BLANK HAS BENN TACKED ON 0174700077/06/14 + CA := CA - 1; 01748000 + IF CA > COT THEN % IT WON'T FIT ON THIS LINE 01749000 + IF CA < NEXTLINESIZE THEN% PUT IT ALL ON THE NEXT LINE 0175000081/09/21 + EMITANDINDENT2; 01751000 + LOOP: TP2 := PA; 01752000 + C2 := NT := MIN(CA,COT); 01753000 + DO 01754000 + SCAN TP2:TP1 := TP2 + 1 FOR C2:C1 := C2 - 1 UNTIL = " " 01755000 + UNTIL C2 < 2; 01756000 + IF C2 = 1 THEN % BLANK WON'T FIT 01757000 + BEGIN 01758000 + TP1 := TP2; 01759000 + C1 := C2; 01760000 + END; 01761000 + NT := 01762000 + IF CA <= COT THEN 01763000 + CA 01764000 + ELSE 01765000 + NT - C1; 01766000 + IF NT = 1 THEN 01767000 + NT := COT - 1; 01768000 + REPLACE POUT:POUT BY PA:PA FOR NT; 01769000 + CA := CA - NT; 01770000 + COT := COT - NT; 01771000 + IF CA ^= 0 THEN 01772000 + BEGIN 01773000 + REPLACE POUT:POUT BY QUOTE; 01774000 + EMITANDINDENT2; 01775000 + REPLACE POUT:POUT BY QUOTE; 01776000 + COT := COT - 1; 01777000 + GO LOOP; 01778000 + END; 01779000 + END; 01780000 + IF F THEN 01781000 + PUTBLANK; 01782000 +END OF XFERSTRING; 0178300081/10/14.1 +% *************************** 01784000 +% ***** MAIN PROGRAM ****** 01785000 +% *************************** 01786000 + IF INITIALIZATION THEN 0178700078/07/25 + BEGIN 0178800078/07/25 + WHILE TRUE DO 0178900078/07/25 + BEGIN 0179000078/07/25 + TRANSFERSTMT(TRUE,OBMARGIN,OBMARGIN + BEGINOFFSET); 0179100078/07/25 + EMIT; 0179200078/07/24 + END; 0179300078/07/24 + EOF: IF ^ LINEEMPTY THEN 0179400078/07/25 + EMITWITHNOCOMMENTCHK; 0179500078/07/25 + CLOSE(INPUT,CRUNCH); 0179600078/07/27 + LOCK(OUTPUT,CRUNCH); 0179700078/07/27 + END; 0179800078/07/27 +END. 0179900078/07/24 diff --git a/tools/xem/ALGOLXEM.alg_m b/tools/xem/ALGOLXEM.alg_m index 4af1cf0..d61c23d 100644 --- a/tools/xem/ALGOLXEM.alg_m +++ b/tools/xem/ALGOLXEM.alg_m @@ -1,12722 +1,19806 @@ -$ MARGIN 0 INDENT 2 BEGINOFFSET 2 00000100 -$ DECINDENT 2 DEFINEINDENT 18 PROCINDENT 2 00000200120324PK - $SET OMIT LISTA = LIST 00000999 -%#######################################################################00001000 -% 00001010 -% B-5700 ALGOL/TSPOL SYMBOLIC 00001020 -% MARK XVI.0.122 00001030 -% MAY 9, 1977 00001040 -% 00001050 -%#######################################################################00001060 -% 00001070 - COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00001072 - * FILE ID: SYMBOL/ALGOL TAPE ID: SYMBOL1/FILE000 * 00001073 - * THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00001074 - * AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00001075 - * EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00001076 - * WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00001077 - * BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00001078 - * * 00001079 - * COPYRIGHT (C) 1965, 1971, 1972, 1974 * 00001080 - * BURROUGHS CORPORATION * 00001081 - * AA759915 AA320206 AA393180 AA332366 *; 00001082 -COMMENT#################################################################00001110 - ERROR MESSAGES 00001120 -########################################################################00001130 -% 00001140 -ERROR NUMBER ROUTINE:ERROR MESSAGE 00002000 - 000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00003000 - 001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00004000 - 002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00005000 - IDENTIFIER NOT APPEARING IN 00006000 - FORMAL PARAMETER PART. 00007000 - 003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00008000 - LIST OF DECLARATION. 00009000 - 004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00010000 - PRECEDED BY ILLEGAL DECLARATOR. 00011000 - 005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00012000 - BY ILLEGAL DECLARATOR. 00013000 - 006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00014000 - IN SAME BLOCK(NOT FORWARD). 00015000 - 007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00016000 - BY ( OR SEMICOLON IN PROCEDURE 00017000 - DECLARATION. 00018000 - 008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00019000 - BY ). 00020000 - 009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00021000 - BY SEMICOLON. 00022000 - 010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00023000 - WHICH DID NOT APPEAR IN FORMAL 00024000 - PARAPART. 00025000 - 011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00026000 - 012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00027000 - PART. 00028000 - 013 PROCEDUREDEC: OWN, SAVE, OR AUXMEM USED IN 00029000 - ARRAY SPECIFICATION. 00029500 - 014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00030000 - 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00030500 - 00031000 - 016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00032000 - BY [ . 00033000 - 017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00034000 - FOLLOWED BY : . 00035000 - 018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00036000 - 019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00037000 - ARRAY SPECIFICATION. 00038000 - 020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00039000 - IDENTIFIER(NO TYPE). 00040000 - 021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00041000 - IDENTIFIER(NO TYPE). 00042000 - 022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00043000 - IDENTIFIER(THE WORD PROCEDURE LEFT 00044000 - OUT). 00045000 - 023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00046000 - ANOTHER DECLARATOR. 00047000 - 024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00048000 - 025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00049000 - PRECEDED BY OWN OR SAVE OR SOME 00050000 - OTHER DECLARATOR. 00051000 - 026 FILEDEC: MISSING ( IN FILE DEC. 00052000 - 027 FILEDEC: MISSING RECORD SIZE. 00053000 - 00054000 - 028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00055000 - IN FILE DEC. 00056000 - 029 FILEDEC: MISSING ) IN FILE DEC. 00057000 - 030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00058000 - 00059000 - 031 LISTDEC: MISSING ( IN LISTDEC. 00060000 - 032 FORMATDEC: MISSING ( IN FORMAT DEC. 00061000 - 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00062000 - FORWARD AFTER IDENTIFIER. 00063000 - 034 SWITCHFILEDEC:MISSING ~ AFTER FILED. 00064000 - 035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00065000 - OF SWITCHFILE. 00066000 - 036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~ . 00067000 - 037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00068000 - 038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00069000 - 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00069100 - 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00069200 - 041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00069300 - 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00069400 - 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00069500 - 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00069600 -045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00069700 -046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00069800 -047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00069900 - 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00069910 - 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00069920 - 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00069930 - 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00069931 - ACTUAL DECLARATION 00069932 - 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00069933 - IDENTIFIER. 00069934 - 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00069938 - 060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00069940 - 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00069950 - INTOVR, OR INDEX. 00069960 - 070 CASESTMT: MISSING BEGIN. 00069970 - 071 CASESTMT: MISSING END. 00069980 - 080 PRIMARY: MISSING COMMA . 00069990 - 090 PARSE: MISSING LEFT BRACKET 00069991 - 091 PARSE: MISSING COLON 00069992 - 092 PARSE: ILLEGAL BIT NUMBER 00069993 - 093 PARSE: FIELD SIZE MUST BE LITERAL 00069994 - 094 PARSE: MISSING RIGHT BRACKET 00069995 - 095 PARSE: ILLEGAL FIELD SIZE 00069996 - 100 ANYWHERE: UNDECLARED IDENTIFIER. 00070000 - 101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00071000 - IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00072000 - TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00073000 - AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00074000 - 102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00075000 - 103 PRIMARY: PRIMARY MAY NOT 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 SAME00109000 - NUMBER OF DIMENSIONS. 00110000 - 125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00111000 - PARAMETER TO A PROCEDURE. 00112000 - 126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00113000 - QUANTITY OF THIS TYPE. 00114000 - 127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00115000 - STREAM PROCEDURE. 00116000 - 128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00117000 - NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00118000 - 129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00119000 - 130 RELSESTMT: NO FILE NAME. 00120000 - 131 DOSTMT: MISSING UNTIL. 00121000 - 132 WHILESTMT: MISSING DO. 00122000 - 133 LABELR: MISSING C OLON. 00123000 - 134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00124000 - 135 LABELR: THE LABEL HAS ALREADY OCCURED. 00125000 - 136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00126000 - 137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00127000 - INTEGER WHERE AN INTEGER IS REQUIRED. 00128000 - 138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00129000 - PHRASE. 00130000 - 139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00131000 - 140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00132000 - 141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00133000 - CHARACTORS. 00134000 - 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00135000 - (BLANK SUPPRESSED). 00136000 - 143 COMPOUNDTAIL: EXTRA END. 00137000 - 144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00138000 - 145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00139000 - 146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00140000 - A MISSING END OF A PROCEDURE OR A MISPLACED 00141000 - DECLARATION. 00142000 - 147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00143000 - DECLARATION. 00144000 - 148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00145000 - ARE REQUIRED FOR THIS PROGRAM. 00146000 - 149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00147000 - PROCEDURE. 00148000 - 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00149000 - STREAM PROCEDURES. 00150000 - 151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00151000 - 152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00152000 - 153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00153000 - 154 FORSTMT: MISSING DO IN FOR CLAUSE. 00154000 - 155 IFEXP: MISSING ELSE 00155000 - 156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A 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 IDENTIFIER00160000 - 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00161000 - 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00162000 - 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00162500 - 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00163000 - 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00164000 - 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00164100 - 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00164720 - DECLARATION. 00164725 - 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00164730 - AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00164735 - 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00164740 - PARAMETRIC DEFINE INVOCATION. 00164745 - 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00164750 - 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00164850 - VARIABLE, OR A TYPE PROCEDURE IDENTIFIER. 00164851 - 199 E: INFO ARRAY HAS OVERFLOWED. 00164900 - 200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00165000 - 201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00166000 - IN A LEFT PART LIST. 00167000 - 202 SIMPLE VARIABLE: MISSING . OR ~ . 00168000 - 203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00169000 - DESIGNATOR. 00170000 - 204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00171000 - 205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00172000 - AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00173000 - 206 SUBSCRIPTED VARIABLE: MISSING ]. 00174000 - 207 SUBSCRIPTED VARIABLE: MISSING [. 00175000 - 208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00176000 - 209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00177000 - MOST IN A LEFT PART LIST. 00178000 - 210 SUBSCRIPTED VARIABLE: MISSING , OR ~ . 00179000 - 211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00180000 - 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00180100 - PARAMETER ONLY. 00180200 - 250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00181000 - 251 ANY STREAM STMT PROCEDURE: MISSING ~. 00182000 - 252 INDEX: MISSING + OR - . 00183000 - 253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00184000 - 254 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 00185000 - 255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00186000 - 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00187000 - A FORMAL PARAMETER. 00188000 - 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00189000 - 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 ATTRIBUTE00211520 - 292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00211530 - 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00211540 - 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00211550 - 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00211551 - IN A LEFT PART LIST. 00211552 - 300 FILLSTMT: THE IDENTIFIER FOLLOWING "FILL" IS NOT 00212000 - AN ARRAY 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 PRO00218300 - 357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00218310 - PARAMETER. 00218320 - 358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00218330 - 359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00218340 - 360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00218350 - TWO PARAMETERS. 00218360 - 361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00218370 - 362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00218380 - 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00218390 - 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00218400 - PARAMETER. 00218410 - 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00218420 - 366 SORTSTMT: MISSING ). 00218430 - 367 MERGESTMT: MISSING (. 00218440 - 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00218450 - 369 MERGESTMT: MISSING ). 00218460 - 381 CMPLXSTMT: MISSING (. 00218500 - 382 CMPLXSTMT: TOO MANY OPERATORS. 00218505 - 383 CMPLXSTMT: TOO MANY OPERANDS. 00218510 - 384 CMPLXSTMT: MISSING , . 00218515 - 385 CMPLXSTMT: TOO FEW OPERANDS. 00218520 - 386 CMPLXSTMT: ILLEGAL PARAMETER. 00218525 - 400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00219000 - 401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00220000 - 402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00221000 - 403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00222000 - MONITOR LIST ELEMENT. 00223000 - 404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00224000 - ELEMENT. 00225000 - 405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00226000 - 406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00227000 - 407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00228000 - 408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00229000 - 409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00230000 - 410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00231000 - 411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00232000 - SUBSCRIPTS. 00233000 - 412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00234000 - SUBSCRIPTS. 00235000 - 413 DMUP:IMPROPER ARRAY DUMP LIST ELEMENT. 00236000 - 414 DMUP:ILLEGAL DUMP LIST ELEMENT. 00237000 - 415 DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS 00238000 - IN ONE DUMP DECLARATION. 00239000 - 416 DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER. 00240000 - 417 DMUP:MISSING OR NON-LOCAL LABEL IN DUMP DECLARATION. 00241000 - 418 DMUP:MISSING COLON IN DUMP DECLARATION. 00242000 - 419 DMUP:IMPROPER DUMP DECLARATION DELIMITER. 00243000 - 420 READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT. 00244000 - 421 READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE 00245000 - STATEMENT. 00246000 - 422 READSTMT:MISSING FILE IN READ STATEMENT. 00247000 - 00248000 - 424 READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT 00249000 - 425 READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT. 00250000 - 426 READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ 00251000 - STATEMENT. 00252000 - 427 READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT. 00253000 - 428 READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ 00254000 - STATEMENT. 00255000 - 429 READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT. 00256000 - 430 READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00257000 - STATEMENT. 00258000 - 00259000 - 00260000 - 00261000 - 00262000 - 433 HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT 00263000 - BRACKET IN READ OR SPACE STATEMENT. 00264000 - 434 SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT. 00265000 - 435 SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT. 00266000 - 436 SPACESTMT:MISSING COMMA IN SPACE STATEMENT. 00267000 - 437 SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT. 00268000 - 438 WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT. 00269000 - 439 WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT. 00270000 - 440 WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A 00271000 - WRITE STATEMENT. 00272000 - 441 WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART 00273000 - OF A WRITE STATEMENT. 00274000 - 442 WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE 00275000 - STATEMENT. 00276000 - 443 WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE 00277000 - STATEMENT. 00278000 - 444 WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT. 00279000 - 445 WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00280000 - IN A WRITE STATEMENT. 00281000 - 446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00282000 - 447 WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00283000 - STATEMENT. 00284000 - 448 WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT. 00285000 - 449 READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT. 00286000 - 450 LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT. 00287000 - 451 LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT. 00288000 - 452 LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT. 00289000 - 453 LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK 00290000 - STATEMENT. 00291000 - 454 LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT. 00292000 - 455 CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT. 00293000 - 456 CLOSESTMT:IMPROPER FILE PART IN A CLOSE STATEMENT. 00294000 - 457 CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT. 00295000 - 458 CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE 00296000 - STATEMENT. 00297000 - 459 CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00298000 - 460 RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT. 00299000 - 461 RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT. 00300000 - 462 RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00301000 - 463 BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION 00302000 - PART OF A PROCEDURE. 00303000 - 464 BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00304000 - OF A PROCEDURE. 00305000 - 465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00305003 - SIMPLE VARIABLE 00305004 - 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00305010 - 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00305020 - 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00305030 - 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00305040 - 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00305050 - 505 SEARCHLIB: MISSING BRACKET. 00305060 - 00305070 - 507 SEARCHLIB: TAPE POSITIONING ERROR. 00305080 - 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00305100 - 520 TABLE: STRING LONGER THAN ONE WORD (48 BITS). 00306200 - 521 TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER. 00306300 - 600 DOLLARCARD: NUMBER EXPECTED. 00400000 - 601 DOLLARCARD: OPTION IDENTIFIER EXPECTED. 00401000 - 602 DOLLARCARD: TOO MANY USER-DEFINED OPTIONS. 00403000 - 603 DOLLARCARD: UNRECOGNIZED WORD OR CHARACTER. 00404000 - 604 DOLLARCARD: MISMATCHED PARENTHESES. 00405000 - 610 READACARD: SEQUENCE ERROR. 00410000 - 611 READACARD: ERROR LIMIT HAS BEEN EXCEEDED. 00411000 - 612 INCLUDECARD: TOOMANY NESTED INCLUDES. 00412000 - 613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. 00413000 - 614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. 00414000 - 615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. 00415000 - 616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD 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 00499999 -BEGIN COMMENT OUTERMOST BLOCK; 00500000 -$SET NEATUP NEATUPSEQ 505000+5000 00500100120324PK - 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 OPTION"S SETTING 01000802 - BOOLEAN GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01000810 -PROCEDURE CHECKBOUNDLVL;FORWARD; 01000830 - BOOLEAN ARRAYFLAG;% USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01000840 - % EVALUATING AN ARRAY BOUND 01000850 - INTEGER NEWINX, ADDVALUE, BASENUM, TOTALNO; 01000860 - COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01000870 - BASENUM IS STARTING VALUE 01000880 - TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01000890 - CARD AS TOTALNO = TOTALNO + ADDVALUE; 01000900 -DEFINE OPARSIZE = 200 #; 01000902 -ARRAY OPTIONS[0:OPARSIZE]; 01000904 -BOOLEAN OPTIONWORD; 01000910 -DEFINE CHECKBIT = 1#, 01000920 - DEBUGBIT = 2#, 01000930 - DECKBIT = 3#, 01000940 - FORMATBIT = 4#, 01000950 - INTBIT = 5#, 01000960 - LISTABIT = 6#, 01000970 - LISTBIT = 7#, 01000980 - LISTPBIT = 8#, 01000990 - MCPBIT = 9#, 01001000 - MERGEBIT = 10#, 01001010 - NESTBIT = 11#, 01001020 - NEWBIT = 12#, 01001030 - NEWINCLBIT = 13#, 01001040 - OMITBIT = 14#, 01001050 - PRINTDOLLARBIT = 15#, 01001060 - PRTBIT = 16#, 01001070 - PUNCHBIT = 17#, 01001080 - PURGEBIT = 18#, 01001090 - SEGSBIT = 19#, 01001100 - SEQBIT = 20#, 01001110 - SEQERRBIT = 21#, 01001120 - SINGLBIT = 22#, 01001130 - STUFFBIT = 23#, 01001140 - VOIDBIT = 24#, 01001150 - VOIDTBIT = 25#, 01001160 - XREFBIT = 26#, 01001170 - BENDBIT = 27#, 01001171 - CODEFILEBIT = 29#, 01001172 - USEROPINX = 30#; 01001173120324PK -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] #, 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 01007010 -%***********************************************************************01007015 -% 01007020 -ARRAY 01007025 - XREFAY2[0:29], % ARRAY OF ONE WORD REFERENCE RECORDS. 01007030 - % THE LAYOUT OF EACH WORD IS 01007035 - % 01007040 - % .[1:5] TYPE OF REFERENCE 01007045 - % = 0 FOR FORWARD DECL 01007050 - % = 1 FOR LABEL OCCURENCE 01007051 - % = 2 FOR NORMAL DECL 01007055 - % = 4 FOR NORMAL REFERENCE 01007060 - % = 5 FOR ASSIGNMENT 01007065 - % 01007070 - % NOTE: THE LOWER ORDER BIT 01007075 - % OF THIS FIELD IS ON 01007080 - % IF YOU WANT STARS 01007085 - % AROUND THIS REFERENCE 01007090 - % IN THE XREF 01007095 - % 01007100 - % .[6:15] IDENTIFIER ID. NO. 01007105 - % THIS IS A UNIQUE NUMBER THAT 01007110 - % IS ASSIGNED WHEN THE 01007115 - % IDENTIFIER IS ENCOUNTERE 01007120 - % FOR THE FIRST TIME. 01007125 - % 01007130 - % .[21:27] SEQUENCE NUMBER 01007135 - % 01007140 - XREFAY1[0:9], % RECORD BUFFER AREA FOR WRITING OUT THE 01007145 - % NAME INFORMATION RECORDS, ONE RECORD 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 01007165 - % IN WHICH THE IDENTIFIER IS DECLARED. 01007170 - % 01007175 - % THE LAYOUT OF EACH IS: 01007180 - % 01007185 - % WORDS 0-7 THE IDENTIFIER WITH BLANK 01007190 - % FILE ON THE RIGHT 01007195 - % 01007200 - % WORD 8 01007205 - % .[21:12] SEGMENT NUMBER IN WHICH 01007210 - % THIS IDENTIFIER WAS DECLARED01007215 - % 01007220 - % .[33:15] IDENTIFIER ID. NO. 01007225 - % 01007230 - % WORD 9 ELBAT WORD 01007235 - % 01007240 - XINFO[0:31,0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 01007245 - % IN THE INFO TABLE. IF YOU HAVE THE INDEX 01007250 - % OF THE ELBAT WORD FOR AN IDENTIFIER IN 01007255 - % THE INFO TABLE YOU CAN FIND THE XINFO WORD 01007260 - % FOR THE IDENTIFIER BY REFERRING TO: 01007265 - % 01007270 - % XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] 01007275 - % 01007280 - % EACH ENTRY CONTAINS: 01007285 - % 01007290 - % .[21:12] SEGMENT NUMBER IN WHICH 01007295 - % THIS IDENTIFIER WAS DECL01007300 - % 01007305 - % .[33:15] IDENTIFIER ID. NO. 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. 01007340 - % 01007345 -INTEGER % 01007350 - XREFPT, % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN 01007355 - % XREFAY2, WHEN THIS BECOMES GREATER 01007360 - % THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 01007365 - % AND XREFPT IS RESET TO ZERO. 01007370 - % 01007375 - XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF 01007380 - % ID. NO. TO IDENTIFIERS. IT IS INCREMENTED 01007385 - % EACH TIME A NEW IDENTIFIER IS ENCOUNTERED. 01007390 - % 01007395 -DEFINE % 01007400 - SEGNOF = [21:12]#, % FIELDS IN XINFO ENTRIES AND WORD 8 OF 01007405 - IDNOF = [33:15]#, % IDENTIFIER RECORDS. 01007410 - % 01007415 - TYPEREF = [1:5]#, % FIELDS OF REFERENCE WORDS 01007420 - REFIDNOF =[6:15]#, % 01007425 - SEQNOF = [21:27]#, % 01007430 - % 01007435 - XREFIT(INDEX,SEQNO,REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE 01007440 - BEGIN IF XREF THEN CROSSREFIT(INDEX,SEQNO,REFTYPE); END#, 01007445 - % 01007450 - XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 01007455 - BEGIN IF XREF THEN XREFAY2[XREFPT-1].TYPEREF := REFTYPE END#, 01007460 - % 01007465 - XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER01007470 - BEGIN IF DEFINING.[1:1] THEN CROSSREFDUMP(INDEX); END#, 01007475 - % 01007480 - XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO 01007481 - XINFO[(INDEX).LINKR,(INDEX).LINKC DIV 2]#, % XINFO ROW AND COL 01007482 - % 01007483 - FORWARDREF = 0#, % DEFINES FOR DIFFERENT REFERENCE TYPES 01007485 - LBLREF = 1#, % 01007486 - DECLREF = 2#, % 01007490 - NORMALREF = 4#, % 01007495 - ASSIGNREF = 5#; % 01007500120324PK - ARRAY BEGINSTACK[0:255]; INTEGER BSPOINT; 01007600 - BOOLEAN DEFINING; 01007650 - COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 01008000 - OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 01009000 - THE INTERNAL CODE (OR ELBAT WORD AS IT IS USUALLY 01010000 - CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 01011000 - [1:1]) FOR PROCEDURES. THE LINK TO PREVIOUS ENTRY (IN 01012000 - [4:8]). THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 01013000 - TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 01014000 - SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,01015000 - FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 01016000 - AND THE ALPHA FOR ANY QUANTITY ARE NOT 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 QUANTITY01020000 - IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 01021000 - OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 01022000 - ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 01023000 - THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 01024000 - THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 01025000 - RESERVED WORDS OCCUPY THE SECOND ROW, IT IS FILLED DURING 01026000 - INITIALIZATION; 01027000 -COMMENT INFO FORMAT 01028000 - FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 01029000 - ENTERED IN INFO: 01030000 - THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 01031000 - THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 01032000 - ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 01033000 - ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 01034000 - E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 01035000 - LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 01036000 - THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 01037000 - THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 01038000 - POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 01039000 - THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.. THE 01040000 - LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 01041000 - FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 01042000 - ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 01043000 - WILL NOT DETRACT FROM THE DISCUSSION. 01044000 - ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 01045000 - THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 01046000 - FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 01047000 - THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 01048000 - S[L] 01049000 - NOW THE DECLARATION 01050000 - BEGIN REAL A,B,C IS ENCOUNTERED 01051000 - IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 01052000 - THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 01053000 - CONSTRUCTED FOR A) 01054000 - T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 01055000 - INFO[NEXTINFO]~T, S[L]~NEXTINFO. 01056000 - NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 01057000 - ENTRY. 01058000 - NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 01059000 - ITSELF CONTAINS THE STOP FLAG ZERO 01060000 - B IS ENTERED SIMILARLY TO A. 01061000 - NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 01062000 - ENTRY FOR A. 01063000 - SIMILARLY,AFTER C IS ENTERED 01064000 - 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. 01154200 - NBITF =[27:6]#, % NUMBER OF BITS FOR FIELD ID. 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 - BOOSTRPROCID =13#, COMMENT 015; 01190000 - REALSTRPROCID =14#, COMMENT 016; 01191000 - ALFASTRPROCID =15#, COMMENT 017; 01192000 - INTSTRPROCID =16#, COMMENT 020; 01193000 - BOOPROCID =17#, COMMENT 021; 01194000 - REALPROCID =18#, COMMENT 022; 01195000 - ALFAPROCID =19#, COMMENT 023; 01196000 - INTPROCID =20#, COMMENT 024; 01197000 - BOOID =21#, COMMENT 025; 01198000 - REALID =22#, COMMENT 026; 01199000 - ALFAID =23#, COMMENT 027; 01200000 - INTID =24#, COMMENT 030; 01201000 - BOOARRAYID =25#, COMMENT 031; 01202000 - 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; 01215000120324PK - 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; 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; 01298500 - FIELDV =21#; COMMENT 25; 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 ACCUM[1] = 00NAAAAA, ACCUM[I] , I> 1. 01307000 - HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 01308000 - THE ELBAT WORD BY THE ENTER ROUTINES; 01309000 - ARRAY STACKHEAD,SUPERSTACK[0:124]; 01310000 - COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX 01311000 - POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A 01311100 - LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, 01311200 - BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS 01311300 - AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE 01311400 - WORDS POINTED TO (IN THREE GROUPS) ARE: 01311500 - 1) ALPHA, LABEL, OWN, REAL, SAVE 01311600 - 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE 01311700 - 3) BEGIN, DO, ELSE, END, FOR, GO, IF, 01311800 - STEP, THEN, TO, UNTIL, WHILE, WRITE. 01311900 - FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE 01312000 - COMMENTS IN THE TABLE PROCEDURE. ; 01312100 - INTEGER COUNT; 01313000 - COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 01314000 - SCANNED; 01315000 - ALPHA Q; 01316000 - COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 01317000 - WORD SCANNED; 01318000 - ARRAY ELBAT[0:76]; INTEGER I,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 CHARACTOR OF 01332000 - THE CARD IMAGE CURRENTLY BEING SCANNED. NCR THE ADDRESS 01333000 - OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 01334000 - CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 01335000 - THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 01336000 - IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 01337000 - DEFINE BUFFSIZE = 56#; 01338000 - INTEGER GTIX; 01339050 - ARRAY TEN[0:69]; 01340000 - INTEGER NOOFARRAYS; COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 01340050 - DECLARED IN THE OBJECT PROGRAM; 01340060 - INTEGER IOBUFFSIZE; COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 01340070 - GTI1 EQUALS TOTAL CORE STORAGE REQD; 01340080 - REAL FSAVE; COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 01340500 - INTEGER IDLOC,IDLOCTEMP; 01341000 - ARRAY PDPRT[0:31,0:63]; 01342000 - COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 01343000 - IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 01344000 - BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 01345000 - OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 01346000 - TYPE 1 ENTRY 01347000 - BIT POSITION KIND OF ENTRY 01348000 - 0-3 ZERO 01349000 - 4 MODE BIT(1=CHAR 0=WORD) 01350000 - 5 ARGUMENT BIT 01351000 - 6-7 ZERO 01352000 - 8-17 RELATIVE ADDRESS IN PRT 01353000 - 18-27 RELATIVE ADDRESS IN SEGMENT 01354000 - 28-37 SEGMENT NUMBER 01355000 - 38-47 ZERO 01356000 - TYPE 2 ENTRY 01357000 - BIT POSITION KIND OF ENTRY 01358000 - 0 EMPTY 01359000 - 1 ON IFF TYPE 2 (DATA) SEGMENT 01360000 - 2 ON IFF INTRINSIC PROCEDURE 01361000 - 3 ON IFF "PSEUDO-SAVE" SEGMENT 01361050 - 4-12 EMPTY 01361100 - 13-27 DISK ADDRESS OR INTRINSIC NUMBER 01361200 - 28-37 SEGMENT NUMBER 01361300 - 38-47 NUMBER OF WORDS IN SEGMENT 01362000 - THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 01363000 - IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 01364000 - ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 01365000 - DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT01366000 - IS READY FOR OUTPUT; 01367000 -COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 01367010 - COMPILATION IS AS FOLLOWS: 01367020 - SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 01367030 - BIT POSITIONS CONTENTS OF FIELD 01367040 - [0:1] EMPTY 01367050 - [1:1] ON IFF TYPE 2 (DATA) SEGMENT 01367060 - [2:1] ON IFF INTRINSIC PROCEDURE 01367070 - [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 01367075 - [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 01367080 - [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 01367085 - [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 01367090 - [18:15] SIZE (NOT USED FOR INTRINSICS) 01367100 - [33:15] DISK ADDRESS OR INTRINSIC NUMBER 01367110 - PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 01367120 - BIT POSITIONS CONTENTS OF FIELD 01367130 - [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. IDBITS 01367140 - [4:2] MODE AND ARGUMENT BITS 01367150 - [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 01367160 - [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 01367170 - PRT ENTRY FOR SEGMENT I 01367180 - [18:15] I 01367190 - [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;01367200 -COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:01367210 - WORD CONTENTS 01367220 - 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 01367230 - 1 SIZE OF SEGMENT DICTIONARY 01367240 - 2 RELATIVE LOCATION OF PRT 01367250 - 3 SIZE OF PRT 01367260 - 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 01367270 - 5 SIZE OF FILE PARAMETER BLOCK 01367280 - 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 01367290 - 7 N 01367300 - . O U 01367310 - . T S 01367320 - . E 01367330 - 29 D; 01367340 -INTEGER PDINX;COMMENT THIS IS THE INDEX FOR PDPRT; 01368000 -INTEGER SGAVL;COMMENT NEXT AVAILABLE SEGMENT NUMBER; 01369000 -INTEGER SGNO;COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 01370000 - ARRAY EDOC[0:7,0:127],COP[0:63],WOP[0:127],POP[0:10]; 01371000 - COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 01372000 - AS SPECIFIED BY "L". 01373000 - IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 01374000 - THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 01375000 - REAL LASTENTRY ; 01376000 - COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 01377000 - INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 01378000 - BOOLEAN MRCLEAN ; 01379000 - COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 01380000 - FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 01381000 - POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 01382000 - DURING AN ARRAY DECLARATION ; 01383000 - REAL GT1,GT2,GT3,GT4,GT5; 01384000 - INTEGER GTI1; 01384500 - COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 01385000 - INTEGER RESULT; 01386000 - COMMENT THIS 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 PROCEDURE01405000 - GIVES RISE TO A NEW LEVEL. SUBLEVEL GIVES THE LEVEL OF 01406000 - THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 01407000 - FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST 01408000 - GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED. MODE 01409000 - IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 01410000 - NESTED (AT COMPILE TIME); 01411000 - INTEGER AUXMEMREQ; 01411010 - BOOLEAN SAVEPRTOG; 01411020 - COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 01411030 - ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 01411040 - AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 01411050 - WHICH WOULD BE REQUIRED IF ALL OF THESE 01411060 - "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 01411070 - TO AUXILIARY MEMORY. SAVEPRTOG IS USED 01411080 - TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 01411090 - ROUTINE IS "PSEUDO-SAVE". 01411100 - ; 01411110 - BOOLEAN ERRORTOG; 01412000 - COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE01413000 - ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 01414000 -BOOLEAN ENDTOG; COMMENT ENDTOG TELLS THE TABLE TO ALLOW 01415000 - COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 01416000 -BOOLEAN STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 01416500 - % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 01417000 - % IT IS USED TO CONTROL COUMPOUNDTAIL. 01417500 - % IT IS ALSO USED WHEN WE ARE COMPILING A 01418000 - % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 01418500 - % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 01419000 -DEFINE FS = 1#, FP = 2#, FL = 3#, FR = 4#, FA = 5#, 01420000 - FI = 6#, FIO = 7#; 01420500 - COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 01421000 - THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 01422000 - THEIR MEANING IS: 01423000 - FS MEANS FROM STATEMENT. 01424000 - FP MEANS FROM PRIMARY. 01425000 - FL MEANS FROM LIST. 01426000 - FR MEANS FROM FOR. 01427000 - FIO MEANS FROM IODEC. 01427250 - FA MEANS FROM ACTUALPARAPART. 01427500 - FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 01427600 - INTEGER L; 01428000 - COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 01429000 - DEFINE BLOCKCTR = 16#, JUNK = 17 #, XITR = 18 #, LSTRTN = 19#; 01430000 - COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 01431000 - PROGRAMS. 01432000 - BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 01433000 - BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 01434000 - IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 01435000 - BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T301436000 - INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 01437000 - JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 01438000 - IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 01439000 - THINGS ON THE TOP OF THE STACK. 01440000 - XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 01441000 - WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 01442000 - USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 01443000 - THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE01444000 - STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 01445000 - LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 01446000 - THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 01447000 - BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW, THIS CARRIES YOU 01448000 - TO THE PROPER ITEM IN THE LIST. THE FORMATING ROUTINES 01449000 - SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 01450000 - LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 01451000 - DEFINE BTYPE =1#, DTYPE =2#, ATYPE =3#; 01452000 - COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 01453000 - ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 01454000 - BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 01455000 - FOR ARITHMETIC EXPRESSIONS; 01456000 - BOOLEAN TB1; 01457000 - COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE; 01458000 - INTEGER JUMPCTR; 01459000 - COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK 01460000 - AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 01461000 - BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 01462000 - SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 01463000 - MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 01464000 - OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED 01465000 - IF LEVEL = JUMPCTR; 01466000 -BOOLEAN GOTOG; 01467000 - COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 01468000 - LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 01469000 - MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 01470000 -REAL STLB; 01471000 - COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 01472000 - THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 01473000 - ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 01474000 - INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 01475000 - FOR TEMPORARY STORAGE; 01476000 -DEFINE BUMPL = L~L+2#; 01477000 - COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 01478000 -DEFINE IDMAX = LABELID#; 01479000 - COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 01480000 -INTEGER DEFINECTR,DEFINEINDEX; 01481000 -ALPHA ARRAY DEFINFO[0:89]; 01481100 -ALPHA ARRAY TEXT[0:31,0:255]; 01481200 -INTEGER DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 01481300 -INTEGER NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 01481400 - REAL JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 01482000 - LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 01483000 - NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS; 01484000 - JUMPLEVEL; COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 01485000 - COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 01486000 - ARRAY MACRO[0:35]; 01487000 - COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 01488000 -REAL P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 01489000 - Z; COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 01490000 -SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 01491000 - COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 01492000 - DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS. 01493000 - THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 01494000 - TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 01495000 - THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 01496000 - ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 01497000 - THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 01498000 -INTEGER BEGINCTR; 01499000 - COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS 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 SVARMONFILE = [37:11]#; COMMENT MONITORFILE IS THE DEFINE FOR 01529000 - THE ADDRESS OF THE FILE DESCRIPTOR IN 01530000 - INFO FOR MONITORED SIMPLE VARIABLES; 01531000 -DEFINE NODIMPART = [40:8]#; COMMENT THE FIRST ADDITIONAL WORD OF INFO 01532000 - FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS01533000 - IN NODIMPART; 01534000 -DEFINE LABLMONFILE = [13:11]#; COMMENT LABLMONFILE DESIGNATES THE BIT 01535000 - POSITION IN THE FIRST WORD OF ADDITIONAL 01536000 - INFO THAT CONTAINS THE MONITOR FILE 01537000 - ADDRESS FOR LABELS; 01538000 -DEFINE SWITMONFILE = [13:11]#; COMMENT SWITMONFILE DESIGNATES THE BIT 01539000 - POSITION IN THE FIRST WORD OF ADDITIONAL 01540000 - INFO THAT CONTAINS THE MONITOR FILE 01541000 - ADDRESS FOR LABELS; 01542000 -DEFINE FUNCMONFILE = [27:11]#; COMMENT FUNCMONFILE DESIGNATES THE BIT 01543000 - POSITION IN THE FIRST WORD OF ADDITIONAL 01544000 - INFO THAT CONTAINS THE MONITOR FILE 01545000 - ADDRESS FOR LABELS; 01546000 -DEFINE DUMPEE = [2:11]#; COMMENT THE DUMPEE FIELD IN THE FIRST 01547000 - ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01548000 - THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 01549000 - EACH TIME THE LABEL IS PASSED IF THAT LABEL 01550000 - APPEARS IN A DUMP DECLARATION; 01551000 -DEFINE DUMPOR = [24:11]#; COMMENT THE DUMPOR FIELD IN THE FIRST 01552000 - ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 01553000 - THE ADDRESS OF THE ROUTINE THAT IS GENERATED 01554000 - FROM THE DUMP DECLARATION THAT IN TURN CALLS 01555000 - THE PRINTI ROUTINE; 01556000 - DEFINE CHUNK = 180#; 01556100 - FILE OUT CODE DISK[20:CHUNK](4,30,SAVE ABS(SAVETIME)); 01556200 - FILE IN CARD (RR1,10,RR2); 01557000 - SAVE 01558000 - FILE OUT LINE DISK SERIAL [20:2400] (RR3,15,RR4,SAVE 10); 01559000 - ARRAY LIN[0:20]; COMMENT PRINT OUTPUT BUILT IN LIN; 01559010 -INTEGER DA; 01559020 - SAVE FILE OUT NEWTAPE DISK SERIAL [20:2400] (RR5,RR6,RR7,SAVE 1); 01560000 - FILE IN TAPE "OCRDIMG" (2,RR8,RR9); 01561000 - SAVE FILE OUT PNCH DISK SERIAL [20:2400](2,10,RR10,SAVE 1); 01561005 - COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 01561010 - FILE IN CASTA DISK SERIAL "CASTA" "LIBRARY"(1,BUFFSIZE); 01561020 - FILE IN CASTB(1,BUFFSIZE); 01561030 - FILE IN CASTC(1,BUFFSIZE); 01561040 - SWITCH FILE LIBRARY~CASTA,CASTB,CASTC; 01561050 - FILE OUT REMOTE 19 (2,10); 01561055 -SAVE ARRAY 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); 01561085 - FILE DSK2 DISK SERIAL [20:450](2,30,30); 01561087 - DEFINE LSTUSD=[9:3]#, FILEINDEX=[12:4]#, STOPPOINT=[16:16]#, 01561090 - NEXTENTRY =[32:16]#; COMMENT SECOND WORD IS THE $$ SEQ NO; 01561100 - DEFINE NCRLINK = [18:15]#, LCRLINK= [33:15]#; 01561110 - INTEGER LIBINDEX,LTLCR,MAXLTLCR,FILEINX,SEQSUM; 01561120 - COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 01561130 - INDICATING LAST ENTRY MADE IN THE ARRAY. 01561140 - LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 01561150 - MAXTLCR USED IN READACARD, FILEINX IS THE 01561160 - LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 01561170 - SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 01561180 - FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 01561190 - REAL RECOUNT,FINISHPT; 01561200 - BOOLEAN FIRSTIMEX; COMMENT USED TO INDICATE WHEN 01561202 - PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 01561204 - BOOLEAN CARDCALL; COMMENT TRUE IF NESTED CALL CAME FROM THE 01561206 - CARD READER ELSE FALSE; 01561208 - COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 01561210 - BOOLEAN NORELEASE; COMMENT NORELEASE ALLOWS PRINTING 01561215 - OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 01561217 - DEFINE NOROWS = 3#; COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 01561220 - BLOCKS PER LIBRARY TAPE; 01561230 - ARRAY DIRECTORY[0:3|NOROWS-1, 0:55]; COMMENT THIS IS THE ACTUAL 01561240 - DIRECTORY AND IS MADE UP AS FOLLOWS: 01561250 - A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 01561260 - B: 1 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 01561270 - IDENTIFIER NAME. 01561280 - C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 01561290 - D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 01561300 - ENTRIES. 01561310 - ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 01561320 - LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 01561330 - DIRECTORY BLOCKS. 01561340 - ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 01561350 - AND THE ITEM D WILL FOLLOW INDICATING THE 01561360 - LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 01561370 - ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 01561380 - BLOCK. 01561390 - IN ORDER TO CHANGE: 01561400 - NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 01561410 - 01561020 - 01561050. 01561420 - - CHANGE "3" AT 01561430 - NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 01561440 - AT ; 01561450 -DEFINE 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 01561550 - INSERTSEQ = INSERTINFO[INSERTDEPTH,3]#; % LAST SEQUENCE TO BE INCLUD01561560120324PK -INTEGER SAVECARD, INSERTDEPTH; 01561570 -ARRAY INSERTINFO[0:INSERTMAX,0:4]; 01561580 -FILE LIBRARYFIL DISK RANDOM(2,10,30); 01561590 -DEFINE LF = LIBRARYFIL#; 01561600 -SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER 01561610 -REAL STREAM PROCEDURE CMPD(A,B); 01561620 - BEGIN 01561630 - SI:=A; DI:=B; 01561640 - IF 8 SC } DC THEN 01561650 - BEGIN 01561660 - SI:=SI-8; DI=DI-8; TALLY:=2; 01561670 - IF 8 SC = DC THEN TALLY:=1; 01561680 - END; 01561690 - CMPD:=TALLY; 01561700 - END CMPD; 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; 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#, 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#; 01580000120324PK - COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX01581000 - IN INFO OF THE CORRESPONDING ROUTINE; 01582000 -INTEGER KOUNT,BUFFACCUM; 01583000 -INTEGER FILENO; 01584000 - BOOLEAN 01585000 - FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 01586000 - FUNCTION; 01587000 - P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 01588000 - P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 01589000120324PK - P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 01589500 - VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 01590000 - FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 01591000 - PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;01592000 -SPECTOG, 01593000 - STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 01594000 - ONE ID AND THEN EIXT; 01595000 - AJUMP; COMMENT TELLS WHETHER A JUMP IS HANGING; 01596000 -BOOLEAN STOPDEFINE; 01597000 -REAL CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 01597100 -INTEGER MAXSAVE; 01598000 - COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 01599000 - DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 01600000 - FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 01601000 - REAL 01602000 - KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 01603000 - ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 01604000 - LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 01605000 - LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 01606000 - INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 01607000 - PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 01608000 - DECLARED; 01609000 - G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 01610000 - TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 01611000 - BEING DECLARED; 01612000 - PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 01613000 - DECLARED; 01614000 - MARK , COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 01615000 - OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 01616000 - PJ, COMMENT FORMAL PARAMETER COUNTER; 01617000 - J, COMMENT ARRAY COUNTER; 01618000 - LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 01619000 - NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 01620000 - GLOBALNINFOO,COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 01620100 - GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 01620200 - CAN CHECK FOR DUPLICATE DECLARATIONS; 01620300 - OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; 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. THE01630000 - FULL NAME IS ALSO GIVEN; 01631000 -$RESET NEATUP 01631100120324PK - 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; 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 -$SET NEATUP 01682100120324PK -REAL MAXSTACK,STACKCTR; 01683000 -INTEGER MAXROW; 01684000 - COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 01685000 - ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 01686000 -INTEGER SEGSIZEMAX; COMMENT CONTAINS MAX SEGMENT SIZE; 01687000 -INTEGER F; 01688000 - STREAM PROCEDURE MOVECODE(EDOC,TEDOC); 01688010 - BEGIN LOCAL T1,T2,T3; 01688020 - SI~EDOC;T1~SI;SI~TEDOC;T2~SI;SI~LOC EDOC;SI~SI+3;DI~LOC T3; 01688030 - DI~DI+5;SKIP 3 DB;15(IF SB THEN DS~1 SET ELSE DS~1 RESET; 01688040 - SKIP 1 SB);SI~LOC EDOC;DI~LOC T2; DS~5 CHR;3(IF SB THEN DS~ 01688050 - 1 SET ELSE DS ~ 1 RESET; SKIP 1 SB);DI~T3;SI~LOC T2;DS~WDS; 01688060 - DI~LOC T3;DI~DI+5;SKIP 3 DB;SI~LOC TEDOC;SI~SI+3;15(IF SB 01688070 - THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB);SI~ LOC TEDOC;DI~LOC 01688080 - T1; DS~5 CHR;3(IF SB THEN DS~1 SET ELSE DS~1 RESET;SKIP 1 SB); 01688090 - DI~T3;SI~LOC T1;DS~WDS 01688100 - END; 01688110 - REAL NLO,NHI,TLO,THI; 01689000 - BOOLEAN DPTOG; 01690000 - COMMENT THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;01691000 -DEFINE FZERO=896#; 01692000 -REAL T1,T2,N,K,AKKUM; 01693000 -BOOLEAN STOPGSP; 01694000 -INTEGER BUP; 01695000 - COMMENT UNIQUE GLOBAL TEMP FOR BLOCK; 01696000 -ARRAY GTA1[0:10]; 01697000 - BOOLEAN ARRAY SPRT[0:31]; 01698000 - COMMENT SPRT IS TO BE CONSIDERED TO BE AN ARRAY OF 32 32 BIT 01699000 - FIELDS. THE 32 BITS ARE IN THE LOW ORDER PART OF EACH 01700000 - WORD. THE BIT IS ON IF AND ONLY IF THE CORRESPONDING 01701000 - PRT CELL HAS A PERMANENT ASSIGNMENT; 01702000 - INTEGER PRTI,PRTIMAX; 01703000 - COMMENT PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-01704000 - MENT. PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 01705000 - TEMPORARY ASSIGNMENT; 01706000 -DEFINE ALPHASIZE = [12:6]#; COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT01707000 - POSITION IN THE SECOND WORD OF INFO WHICH 01708000 - CONTAINS THE LENGTH OF ALPHA; 01709000 -DEFINE EDOCINDEX = L.[36:3],L.[39:7]#; COMMENT EDOCINDEX IS THE WORD 01710000 - PORTION OF L SPLIT INTO A ROW AND01711000 - COLUMN INDEX FOR EDOC; 01712000 -DEFINE CPLUS1 = 769#; COMMENT SEE COMMENT AT CPLUS2 DEFINE; 01713000 -DEFINE CPLUS2 = 770#; COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 01714000 - USED IN THE GENERATION OF C-RELATIVE CODE; 01715000 - PROCEDURE FLAG(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01716000 - ALPHA PROCEDURE B2D(B); VALUE B; REAL B; FORWARD; 01717000 - BOOLEAN MACROID; 01717800 - REAL PROCEDURE FIXDEFINEINFO(T); VALUE T; REAL T; FORWARD; 01717900 - PROCEDURE DEFINEPARAM(D,N); VALUE D,N; INTEGER D,N; FORWARD; 01717950 - PROCEDURE ERR (ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; FORWARD; 01718000 - REAL PROCEDURE TAKE(X); VALUE X; INTEGER X; FORWARD; 01718100 - PROCEDURE PUT(W,X); VALUE W,X; REAL W,X; FORWARD ; 01718200 - INTEGER PROCEDURE GIT(L); VALUE L; REAL L; FORWARD; 01719000 - BOOLEAN LISTMODE; 01720000 - COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 01721000 - IS BEING GENERATED OR A STATEMENT; 01722000 - INTEGER LSTR; 01723000 - COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 01724000 - USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 01725000 - PROCEDURE SCANNER; FORWARD; 01730000 - COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 01732000 - REAL STREAM PROCEDURE MKABS(A); 01733000 - BEGIN DI ~ A; MKABS ~ DI END MKABS; 01734000 - STREAM PROCEDURE MOVE(W)"WORDS FROM"(A)"TO"(B); VALUE W; 01735000 - BEGIN LOCAL T; 01736000 - SI~LOC W; DI~LOC T; SI~SI+6; DI~DI+7; DS~CHR; 01736100 - SI~A; DI~B; T(DS~32 WDS; DS~32 WDS); DS~W WDS; 01736200 - END MOVE; 01736300 - STREAM PROCEDURE ZEROUT(DEST,NDIV32,NMOD32); 01737000 - VALUE NDIV32,NMOD32 ; 01737050 - BEGIN DI := DEST; 01737100 - NDIV32(32(DS :=8 LIT"0")); 01737150 - NMOD32(DS := 8 LIT"0"); 01737200 - END; 01737250 -COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 01737300 -STREAM PROCEDURE BLANKET(N,THERE); VALUE N; 01737350 - BEGIN 01737400 - DI:=THERE; DS:=8 LIT" "; SI:=THERE; DS:=N WDS; 01737450 - END BLANKET; 01737500 - 01738000 - 01739000 - 01740000 - PROCEDURE STEPIT; FORWARD; 01741000 - COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 01741100 - STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); VALUE OLDSEQ; 01741200 - BEGIN 01741300 - DI ~ OLDSEQ; SI~VAL ; DS ~ 8 DEC 01741400 - END; 01741500 -STREAM PROCEDURE SEQUENCEWARNING(L); 01742100 - BEGIN DI:=L; DI:=DI-8; DS:=24 LIT "SEQUENCE WARNING<<<<<<<<"; END; 01742110 - BOOLEAN STREAM PROCEDURE NONBLANK(FCR); VALUE FCR; 01742200 - COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 01742300 - TRUE IF ANY VISIBLE CHARACTER ; 01742400 - BEGIN 01742500 - LABEL NED; 01742600 - SI~FCR; 01742700 - TALLY~0; 01742800 - 2(36(IF SC ! " " THEN JUMP OUT 2 TO NED; SI~ SI+1)); 01742900 - TALLY~63; 01743000 - NED: TALLY~TALLY+1; 01743100 - NONBLANK~TALLY 01743200 - END NONBLANK; 01743300 - INTEGER FAULTLEVEL; COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE-- 01750000 - GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 01751000 - FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 01752000 - BOOLEAN FAULTOG; COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 01753000 - ABOUT FAULTLEVEL; 01754000 - INTEGER SFILENO; COMMENT FILENO OF FIRST SORT FILE; 01755000 -STREAM PROCEDURE GETVOID(VP,NCR,VR,LCR,SEQ); VALUE NCR; 01756000 - BEGIN 01757000 - LABEL L,TRANS; 01758000 - LOCAL N; 01759000 - SI:=SEQ; DI:=LCR; DI:=DI-1; DS:=LIT"%"; % PUT "%" IN CC 72. 01759100 - DS:=WDS; % RESTORE SEQ. NO. FOR $VOID(T) CARDS. 01759200 - SI:=LCR; DI:=LOC N; DS:=CHR; % SAVE COL. 73 01760000 - SI:=NCR; DI:=VP; DS:=8 LIT "0"; 01761000 - 2(34(IF SC=" " THEN SI:=SI+1 ELSE JUMP OUT 2 TO L)); 01762000 - SI:=LCR; TALLY:=8; GO TRANS;% NO VOID RANGE FOUND, USE 73-80. 01763000 -L: 01764000 - IF SC=""" THEN 01765000 - BEGIN 01766000 - SI:=SI+1; DI:=LCR; DS:=1 LIT"""; % STOPPER FOR SCAN 01767000 - NCR:=SI; % TEMP, STORAGE. SINCE NCR IS "LOCAL" TO GETVOID. 01768000 - 8(IF SC=""" THEN JUMP OUT ELSE 01769000 - BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01770000 - END 01771000 - ELSE BEGIN 01772000 - NCR:=SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 01773000 - DI:=LCR; DS:=1 LIT" "; % STOPPER FOR SCAN 01774000 - 8(IF SC=" " THEN JUMP OUT ELSE 01775000 - BEGIN TALLY:=TALLY+1; SI:=SI+1 END); 01776000 - END; 01777000 -TRANS: 01778000 - SI:=LOC N; DI:=LCR; DS:=CHR; % RESTORE COLUMN 73 01779000 - SI:=NCR; DI:=VP; DI:=DI+8; % RESTORE POINTERS. 01780000 - N:=TALLY; DI:=DI-N; DS:=N CHR; 01781000 - DI:=DI-8; VP:=DI; % I.E., "LOC VP":=DI. 01782000 - DI:=VR; SI:=LOC VP; DS:=WDS; % ADDRESS OF VOID RANGE. 01783000 - END OF GETVOID; 01784000 -REAL VOIDCR,VOIDPLACE; 01785000 -BOOLEAN SORTMERGETOG; 01786000 -$RESET NEATUP 01786100120324PK - FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 01800000 - PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 01801000 - BUG(X24,4(A4,X2)); 01802000 -$SET NEATUP 01802100120324PK -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 -$RESET NEATUP 01829100120324PK - $ SET OMIT = NOT ALGOL 01829900 -"XVI.0.122" 01831000 - ," ",A6,"DAY, ",O,", ",I2,":",A2,X1,A3, 01832000 - ////X45,A1,A6,"/",A1,A6,/X45,15("=")//>, 01832500 - TIME(6),DATER(TIME(5)),12|REAL(Q:=H MOD 12=0)+Q, 01833000 - Q:=MIN MOD 10+(MIN DIV 10)|64, 01834000 - IF H}12THEN "PM." ELSE "AM.", 01835000 - N1.[6:6],N1,N2.[6:6],N2); 01835500 -$SET NEATUP 01835550120324PK - IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. 01835600 - WRITE(LINE,, 01835700 - (N1:=TAPE.MFID).[6:6],N1,(N2:=TAPE.FID).[6:6],N2); 01835800 - NOHEADING:=FALSE; 01836000 - END OF DATIME; 01837000 - DEFINE DOT= BEGIN IF ELCLASS = PERIOD THEN DOTIT END#; 01841000 - COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 02000000 - AND SCANNING THEM; 02001000 - BOOLEAN STREAM PROCEDURE LOOK(ACC1,DIR,ROW,STRTPOS,STOPOS); 02001020 - VALUE ROW ; 02001030 - BEGIN COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 02001040 - REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY02001050 - ; 02001060 - LOCAL DPPOS,TEMP,LGTH; 02001070 - LABEL LOOP,EXIT; 02001080 - SI~DIR; ROW(SI~SI+8); DPPOS~SI; 02001090 - DI~LOC TEMP; DS~WDS; SI~TEMP; 02001100 - SI~SI+8; 02001110 - LOOP:DI ~ LOC LGTH; DI~DI+7; DS~CHR; 02001120 - DI~ACC1; DI~DI+2; SI~SI-1; 02001130 - IF SC = DC 02001140 - THEN BEGIN COMMENT THE LENGTHS ARE EQUAL; 02001150 - IF LGTH SC = DC 02001160 - THEN BEGIN COMMENT FOUND IT; 02001170 - DI~STRTPOS;DS~5 LIT "0"; DS~3 CHR; 02001180 - IF SC = "0" 02001190 - THEN BEGIN COMMENT WE MAY BE IN THE02001200 - WRONG ROW; 02001210 - SI~SI+1;DI~LOC LOOK; 02001220 - IF 3 SC = DC 02001230 - THEN BEGIN COMMENT WE ARE02001240 - IN THE WRONG 02001250 - ROW; 02001260 - SI~DPPOS; 02001270 - SI~SI+8; 02001280 - DPPOS~SI; 02001290 - DI~LOC TEMP; 02001300 - DS~WDS; 02001310 - SI~TEMP; 02001320 - END 02001330 - ELSE SI~SI-4; 02001340 - END; 02001350 - DI~LOC LGTH; DI~DI+7; DS~CHR; 02001360 - SI~SI+ LGTH; 02001370 - DI~STOPOS; DS~5 LIT"0"; 02001375 - DS~3 CHR; GO TO EXIT; 02001380 - END; 02001390 - SI~SI+3; 02001400 - END 02001410 - ELSE BEGIN COMMENT THE LENGTHS ARE NOT EQUAL; 02001420 - SI~SI-1; 02001430 - IF SC = "0" 02001440 - THEN BEGIN COMMENT MAY BE A NEW ROW; 02001450 - SI~SI+1; DI~LOC LOOK; 02001460 - IF 3 SC = DC 02001470 - THEN BEGIN COMMENT CHANGE ROWS; 02001480 - SI~DPPOS;SI~SI+8;DPPOS~SI;02001490 - DI~LOC TEMP; DS~WDS; 02001500 - SI~TEMP; 02001510 - END 02001520 - ELSE BEGIN COMMENT IT IS NOT HERE; 02001530 - TALLY~1; LOOK~TALLY; 02001540 - GO TO EXIT; 02001550 - END; 02001560 - GO TO LOOP; 02001563 - END; 02001565 - SI~SI~LGTH; SI~SI+4; COMMENT POSITION TO NEXT ID.; 02001568 - END; 02001570 - GO TO LOOP; 02001580 - EXIT:; 02001590 - END LOOK; 02001600 -%***********************************************************************02001605 -% 02001610 -% MISCELLANEOUS CROSS REFERENCE PROCEDURES 02001615 -% 02001620 -%***********************************************************************02001630 -% 02001635 -PROCEDURE CROSSREFIT(INDEX,SEQNO,REFTYPE); 02001640 - VALUE INDEX,SEQNO,REFTYPE; 02001645 - REAL INDEX,SEQNO,REFTYPE; 02001650 -BEGIN 02001655 - IF XREFINFO[INDEX].IDNOF ! 0 THEN % SAVE 02001660 - BEGIN 02001665 - IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. 02001670 - BEGIN 02001675 - WRITE(DSK2,30,XREFAY2[*]); 02001680 - XREFPT := 0; 02001685 - END; 02001690 - XREFAY2[XREFPT] := SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] 02001695 - REFIDNOF; 02001700 - XREFPT := XREFPT + 1; % EVEN THOUGH THE ARRAY MAY BE FULL NOW WE 02001705 - % CANT WRITE IT OUT BECAUSE SOME ROUTINES 02001710 - % WILL LOOK BACK AT THE ENTRY WE JUST PUT 02001715 - % IN AND FIX IT UP. 02001720 - END; 02001725 -END OF CROSSREFIT; 02001730 -% 02001735 -PROCEDURE CROSSREFDUMP(INDEX); 02001740 - VALUE INDEX; 02001745 - REAL INDEX; 02001750 -BEGIN 02001755 - STREAM PROCEDURE MOVEREFINFO(S,D,N); 02001760 - VALUE N; 02001765 - BEGIN 02001770 - SI := D; DI := D; DS := 8 LIT " "; DS := 7 WDS; % BLANK RECORD 02001775 - SI := S; SI := SI + 3; DI := D; DS := N CHR; % MOVE IDENTIFIER 02001780 - END OF MOVEXREFINFO; 02001785 - % 02001790 - IF XREFINFO[INDEX].IDNOF ! 0 THEN % DUMP IT 02001795 - BEGIN 02001800 - MOVEXREFINFO(INFO[INDEX.LINKR,INDEX.LINKC+1],XREFAY1[*], 02001805 - TAKE(INDEX+1).[12:6]); 02001810 - XREFAY1[8] := XREFINFO[INDEX]; 02001815 - XREFAY1[9] := TAKE(INDEX); % ELBAT WORD 02001820 - WRITE(DSK1,10,XREFAY1[*]); 02001821 - XREFINFO[INDEX] := 0; 02001822 - END; 02001825 -END OF CROSSREFDUMP; 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:=SI; T2:=DI; DI:=T1; SI:=T2; % FLIP, MAN. 02001874 - DS:=3 RESET; SI:=T1; DI:=T2; % FLIP BACK. 02001876 - DS:=1 ADD; DI:=DI-1; SKIP 2 DB; DS:=1 SET; SKIP 3 DB; 02001878 - GO AGIN; 02001880 - END; 02001882 - IF SC<"0" THEN TALLY:=1; DS:=CHR; % < 0 = NON-HEX CHARACTER. 02001884 -AGIN: 02001886 - ); 02001888 - SI:=LOC TEMP1; DI:=D; SKP(DS:=4 RESET); % RIGHT ADJUST CONSTANT. 02001890 - CNT(SKIP 2 SB; 02001892 - 4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB));% FINAL CONVERT. 02001894 - HEXIZE:=TALLY; % "1" IF PROGRAMMER GOOFED. 02001896 - END HEXIZE; 02001898 -COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 02002000 - CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 02003000 - IT IS NEEDED FOR FUTURE REFERENCE; 02004000 -STREAM PROCEDURE PUTSEQNO(INFO,LCR); VALUE LCR; 02005000 - BEGIN DI:=INFO; SI:=LCR; DS:=WDS; END PUTSEQNO; 02006000 -COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 02007000 - I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 02008000 - CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 02009000 - THE SCANNER; 02010000 - STREAM PROCEDURE TURNONSTOPLIGHT(RED,CORNER); VALUE RED,CORNER; 02011000 - BEGIN DI:=CORNER; SI:=LOC CORNER; SI:=SI-1; DS:=CHR END; 02012000 - COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 02013010 - IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 02013020 - THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 02013030 - NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 02013040 - VARIABLE AD; 02013050 - STREAM PROCEDURE ADDER(SUM,SEQLOC,AD,DESCRP); 02013060 - VALUE AD,DESCRP; 02013065 - BEGIN 02013070 - LOCAL HOLD,ZONEP; 02013073 - DI~LOC ZONEP; SI~SUM; DS~8 ZON; 02013074 - COMMENT SAVED ZONE PART OF THE SEQ.NO.; 02013075 - DI~SUM; DI~DI+7; DS~2 RESET; 02013076 - COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 02013077 - SI~LOC DESCRP; SI~SI+7; 02013078 - IF SC="1" THEN BEGIN DI~LOC HOLD; SI~SEQLOC; 02013080 - DS~WDS; DI~HOLD; END 02013085 - ELSE DI~SEQLOC; 02013090 - COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 02013091 - HOLD~DI; DI~DI+7; DS~2 RESET; DI~HOLD; 02013095 - SI ~ LOC AD; 02013100 - SI ~ SI + 7; 02013110 - IF SC = "1" THEN BEGIN SI~ SUM; DS~8 ADD; END 02013120 - ELSE BEGIN SI~ SUM; DS~8 SUB; END; 02013130 - SI~LOC ZONEP; DI~HOLD; DS~8 ZON; 02013135 - SI~LOC ZONEP; DI~SUM; DS~8 ZON; 02013136 - COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 02013137 - END ADDER; 02013140 -COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 02013150 -COMPILABLE QUANTITIES. THE PARAMETER INDICATES THAT WE ARE ENTERING 02013155 -A LIBRARY CALL IF TRUE, ELSE WE ARE EXITING.; 02013160 -PROCEDURE SEARCHLIB(DOLLAR); VALUE DOLLAR; BOOLEAN DOLLAR; 02013165 - BEGIN 02013170 - LABEL EXIT,EXITOUT, NOPARTIAL; 02013175 - PROCEDURE FLAGIT(N); VALUE N; INTEGER N; 02013176 - BEGIN 02013177 - BOOLEAN TL,TS; 02013178 - TL:=LISTOG; TS:=SINGLTOG; LISTOG:=FALSE; SINGLTOG:=FALSE; 02013179 - Q:=ACCUM[1]; FLAG(N); 02013180 - LISTOG:=TL; SINGLTOG:=TS; 02013181 - END FLAGIT; 02013183 - IF DOLLAR THEN 02013184 - BEGIN COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 02013190 - RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013195 - RESULT~COUNT~ACCUM[1] ~0; SCANNER; 02013200 - IF ACCUM[1] > "1+0000" AND ACCUM[1] < "1D0000" THEN 02013205 - FILEINX:=ACCUM[1].[21:3] ELSE BEGIN 02013210 - COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 02013219 - FLAGIT(500); GO EXIT; 02013222 - END; 02013225 - FILEINX ~ FILEINX -1; 02013230 - IF DIRECTORY[GT1~3|FILEINX,0]=0 THEN 02013235 - BEGIN COMMENT MUST READ DIRECTORY; 02013240 - GT3~MKABS(LIBRARY[FILEINX](0)); 02013245 - MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1,0]); 02013250 - GT2~DIRECTORY[GT1,0]; DIRECTORY[FILEINX|3,0] ~ -2; 02013255 - WHILE GT2 ~ GT2-1 > 0 DO 02013260 - BEGIN 02013265 - READ(LIBRARY[FILEINX]); 02013270 - MOVE(56,LIBRARY[FILEINX](0),DIRECTORY[GT1~GT1+1,0]); 02013275 - END; 02013280 - END; 02013285 - RESULT~ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET THE PROD.ID.; 02013290 - IF LOOK(ACCUM[1],DIRECTORY,3|FILEINX, GT1,GT2) THEN 02013295 - BEGIN COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 02013300 - FLAGIT(501); GO EXIT; 02013305 - END; 02013310 - WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013313 - DO BEGIN 02013315 - IF EXAMIN(NCR) = "[" THEN GO TO EXITOUT ; 02013317 - RESULT~5; SCANNER; 02013318 - END; 02013319 - GO TO NOPARTIAL; 02013320 - EXITOUT: BEGIN COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 02013325 - RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT SPACE PAST "[" ;02013330 - RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET START POINT;02013335 - IF RESULT ! 3 THEN 02013340 - BEGIN COMMENT ERROR 502 - IMPROPER START POINT; 02013345 - FLAGIT(502); GO EXIT; 02013350 - END; 02013355 - GT1 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]) - 1; 02013360 - RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013365 - IF RESULT ! 2 THEN 02013370 - BEGIN COMMENT ERROR 503 - NO SEPARATOR; 02013375 - FLAGIT(503); GO EXIT; 02013380 - END; 02013385 - RESULT~ ACCUM[1]~ COUNT~0; SCANNER; COMMENT GET LENGTH; 02013390 - IF RESULT ! 3 THEN 02013395 - BEGIN COMMENT ERROR 504 - IMPROPER LENGTH; 02013400 - FLAGIT(504); GO EXIT; 02013405 - END; 02013410 - GT2 ~ GT1 + CONV(ACCUM[1],0,ACCUM[1].[12:6]); 02013415 - RESULT~ ACCUM[1]~ COUNT~0; SCANNER; 02013420 - IF ACCUM[1] ! "1]0000" THEN 02013425 - BEGIN COMMENT ERROR 505 - NO RIGHT BRACKET; 02013430 - FLAGIT(505); GO EXIT; 02013435 - END; 02013440 - WHILE LCR.[33:15] - NCR.[33:15] ! 1 OR NCR.[30:3] ! 7 02013445 - DO BEGIN RESULT ~ 5; SCANNER END; 02013446 - END; 02013450 - NOPARTIAL: COMMENT NOW SET UP THE LINKS; 02013475 - LIBARRAY[LIBINDEX].LSTUSD ~ LASTUSED; 02013480 - LIBARRAY[LIBINDEX].FILEINDEX ~ FILEINX; 02013490 - LIBARRAY[LIBINDEX].STOPPOINT ~ FINISHPT; 02013495 - LIBARRAY[LIBINDEX].NEXTENTRY ~ RECOUNT-1; 02013497 - FINISHPT ~ GT2; 02013500 - IF LIBINDEX>0 THEN DIRECTORY[(LIBARRAY[LIBINDEX-3].FILEINDEX) 02013505 - |3,0] ~ RECOUNT -1; 02013510 - RECOUNT~GT1; 02013515 - IF EXAMIN(LCR) ! "%" THEN 02013516 - PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02013517 - MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIBARRAY[LIBINDEX+1]); 02013520 - MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],SEQSUM); 02013525 - IF LASTUSED{2 OR LASTUSED=5 THEN GTI1~0 02013526 - ELSE IF MAXLTLCR.[33:15]-NCR.[33:15]<11 THEN 02013527 - GTI1~MKABS(LIBRARY[FILEINX](0)) ELSE GTI1~(NCR+2).[33:15]; 02013528 - LIBARRAY[LIBINDEX+2],NCRLINK~GTI1.[33:15]; COMMENT GTI1=NCR; 02013530 - IF LASTUSED{2 OR LASTUSED=5 THEN 02013533 - LIBARRAY[LIBINDEX+2].LCRLINK~0 ELSE 02013534 - LIBARRAY[LIBINDEX+2].LCRLINK~GTI1.[33:15]+10; 02013535 - IF LIBINDEX> 0 THEN IF CARDCALL THEN BEGIN 02013536 - LASTUSED~5; LIBARRAY[LIBINDEX].NEXTENTRY~ 02013537 - LIBARRAY[LIBINDEX].NEXTENTRY -1; 02013538 - END ELSE BEGIN 02013539 - LASTUSED~6; FIRSTIMEX~ TRUE; END 02013540 - ELSE BEGIN IF LASTUSED=3 THEN FIRSTIMEX:=TRUE; LASTUSED:=5; END; 02013541 - LIBINDEX ~ LIBINDEX + 3; 02013542 - END 02013545 - ELSE 02013550 - BEGIN COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 02013555 - LIBINDEX ~ LIBINDEX -3; 02013560 - RECOUNT~RECOUNT-1; 02013563 - LASTUSED ~ LIBARRAY[LIBINDEX].LSTUSD; 02013565 - IF LASTUSED =1 THEN MEDIUM := "C "; 02013566 - IF LIBINDEX > 0 THEN BEGIN GTI1~LIBARRAY[LIBINDEX].NEXTENTRY; 02013567 - DIRECTORY[FILEINX|3,0]~RECOUNT; RECOUNT~GTI1+2; END ELSE 02013568 - DIRECTORY[FILEINX|3,0] ~ RECOUNT; 02013570 - IF LIBINDEX > 0 THEN 02013575 - FILEINX ~ LIBARRAY[LIBINDEX -3].FILEINDEX; 02013580 - FINISHPT ~ LIBARRAY[LIBINDEX].STOPPOINT; 02013600 - IF LIBINDEX ! 0 THEN 02013610 - MOVE(1,LIBARRAY[LIBINDEX -3 +1], SEQSUM); 02013615 - IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[0]) ELSE 02013617 - NCR ~ LIBARRAY[LIBINDEX+2].NCRLINK; 02013620 - IF LASTUSED{2 OR LASTUSED=5 THEN LCR:=MKABS(CBUFF[9]) ELSE 02013621 - LCR ~ LIBARRAY[LIBINDEX+2].LCRLINK; 02013625 - NORELEASE~TRUE; 02013627 - IF LASTUSED=6 THEN FIRSTIMEX~TRUE; 02013628 - END OF UNLINK; 02013630 - IF LIBINDEX = 0 THEN 02013635 - BEGIN COMMENT GOING BACK TO OUTSIDE WORLD; 02013640 - SEQSUM~0; 02013645 - END 02013650 - ELSE 02013655 - BEGIN 02013660 - GT1~(GTI1~(DIRECTORY[FILEINX|3,0]+3)/5)|5+1; 02013665 - GT2~(GTI1~(RECOUNT-3)/5)|5+1; 02013670 - GT3 ~(GT2 - GT1)DIV 5; 02013675 - SPACE(LIBRARY[FILEINX],GT3); 02013680 - 02013681 - 02013682 - READ(LIBRARY[FILEINX]); 02013685 - 02013690 - 02013693 - 02013695 - MOVE(1,LIBRARY[FILEINX](0),GTI1); 02013697 - IF GTI1!GT2 AND GTI1 ! 0 THEN 02013699 - BEGIN COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 02013701 - FLAG(507); GO TO EXIT; 02013702 - END; 02013703 - LTLCR~MKABS(LIBRARY[FILEINX](10))+(GTI1~(((RECOUNT-1) MOD 5) |11)); 02013705 - MAXLTLCR~MKABS(LIBRARY[FILEINX](0))+54; 02013710 - ADDER(SEQSUM,LTLCR,TRUE,TRUE); 02013713 - IF LASTUSED= 6 THEN BEGIN 02013714 - NCR~LCR~MKABS(LIBRARY[FILEINX](0)); 02013715 - PUTSEQNO(GT1,LCR); 02013716 - TURNONSTOPLIGHT("%",LCR); 02013717 - END; END; 02013718 - EXIT: END SEARCHLIB; 02013720 - COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 02014000 - AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 02015000 - BOOLEAN STREAM PROCEDURE WRITNEW(NEW,FCR); VALUE FCR; 02016000 - BEGIN SI~FCR; IF SC!"$" THEN TALLY~1; 02017000 - DI~NEW; DS~10 WDS; WRITNEW~TALLY 02018000 - END WRITNEW; 02019000 - 02020000 - 02021000 - 02022000 - 02023000 - 02041000 - 02042000 - 02043000 - 02044000 - 02045000 - 02046000 - 02047000 - 02047050 - 02047055 - 02047060 - 02047065 - 02047070 - 02047075 - 02048000 - 02049000 - 02050000 - 02051000 - 02052000 - 02053000 - 02054000 - 02055000 - 02055100 - 02055200 - 02055300 - 02056000 - 02057000 - 02058000 - 02059000 - 02060000 -COMMENT EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR 02061000 - EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 02061500 - QUANTITIES IN THE DIRECTORY; 02062000 -BOOLEAN STREAM PROCEDURE EQUAL(COUNT,A,B); VALUE COUNT; 02062500 - BEGIN 02063000 - TALLY:=1; SI:=A; DI:=B; 02063500 - IF COUNT SC=DC THEN EQUAL:=TALLY 02064000 - END EQUAL; 02064500 -PROCEDURE READACARD; FORWARD; 02065000 -PROCEDURE DOLLARCARD; FORWARD; 02065500 -BOOLEAN PROCEDURE BOOLEXP; FORWARD; 02065600 -PROCEDURE SCANNER; 02066000 - BEGIN 02066500 -COMMENT "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 02067000 - IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER". 02067500 - WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 02068000 - IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO 02068500 - INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE. 02069000 - HENCE THE VARIABLE "RESULT" IS PASSED BY BOTH NAME AND VALUE. 02069500 - THE MEANING OF "RESULT" AS INPUT IS: 02070000 - VALUE MEANING 02070500 - ===== ========================================= 02071000 - 0 INITIAL CODE - DEBLANK AND START TO FETCH THE 02071500 - NEXT QUANTITY. 02072000 - 1 CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 02072500 - END-OF-CARD BREAK). 02073000 - 2 LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE, 02073500 - EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT 02074000 - IMPORTANT). 02074500 - 3 CONTINUE BUILDING A NUMBER (INTERRUPTED BY END-OF- 02075000 - CARD BREAK). 02075500 - 4 LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE,02076000 - EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT 02076500 - IMPORTANT). 02077000 - 5 GET NEXT CHARACTER AND EXIT. 02077500 - 6 SCAN A COMMENT. 02078000 - 7 DEBLANK ONLY. 02078500 - THE MEANING OF "RESULT" AS OUTPUT IS: 02079000 - VALUE MEANING 02079500 - ===== ======================================= 02080000 - 1 AN IDENTIFIER WAS BUILT. 02080500 - 2 A SPECIAL CHARACTER WAS OBTAINED. 02081000 - 3 A NUMBER (INTEGER) WAS BUILT. 02081500 - "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 02082000 - DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR" 02082500 - FOR THE REST OF THIS DISCUSSION). 02083000 - "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS 02083500 - "SCAN" HAS PUT INTO THE "ACCUMULATOR". SINCE "SCAN" NEEDS 02084000 - THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM- 02084500 - ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD. 02085000 - "COUNT" IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 02085500 - CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT". 02086000 - "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY 02086500 - NAME AND VALUE SO THAT IT MAY BE UPDATED. 02087000 - "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 02087500 - PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK 02088000 - ARRANGEMENT. 02088500 - ; 02089000 - STREAM PROCEDURE SCAN(NCR,COUNTV,ACCUM,COMCOUNT,RESULT,RESULTV, 02089500 - COUNT,ST2,NCRV,ST1); 02090000 - VALUE COUNTV, COMCOUNT,RESULTV,ST2,NCRV,ST1; 02090500 - BEGIN 02091000 - LABEL DEBLANK,NUMBERS,IDBLDR,GNC,K,EXIT,FINIS,L,ERROR, 02091500 - COMMENTS,COMMANTS; 02092000 - DI:=RESULT; DI:=DI+7; SI:=NCRV; 02092500 -COMMENT SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT 02093000 - THE BUFFER; 02093500 - CI:=CI+RESULTV; % SWITCH ON VALUE OF RESULT; 02094000 - GO DEBLANK; % 0 IS INITIAL CODE. 02094500 - GO IDBLDR; % 1 IS ID CODE. 02095000 - GO FINIS; % 2 IS SPECIAL CHARACTER CODE. 02095500 - GO NUMBERS; % 3 IS NUMBER CODE. 02096000 - GO FINIS; % 4 IS ERROR CODE. 02096500 - GO GNC; % 5 IS GET NEXT CHARACTER CODE. 02097000 - GO COMMANTS; % 6 IS COMMENT CODE. 02097500 - % 7 IS DEBLANK ONLY CODE. 02098000 - IF SC=" " THEN 02098500 -K: BEGIN SI:=SI+1; IF SC=" " THEN GO K END; 02099000 - GO FINIS; 02099500 -DEBLANK: 02100000 - IF SC=" " THEN 02100500 -L: BEGIN SI:=SI+1; IF SC=" " THEN GO L END; 02101000 -COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 02101500 - NCRV:=SI; 02102000 - IF SC } "0" THEN GO NUMBERS; 02102500 - IF SC=ALPHA THEN GO IDBLDR; 02103000 -COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 02103500 -GNC: 02104000 - DS:=LIT"2"; TALLY:=1; SI:=SI+1; GO EXIT; 02104500 -COMMANTS: 02105000 - IF SC!";" THEN 02105500 - BEGIN 02106000 -COMMENTS: 02106500 - SI:=SI+1; 02107000 - IF SC > "%" THEN GO COMMENTS; 02107500 - IF SC < ";" THEN GO COMMENTS; 02108000 -COMMENT CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD- 02108500 - MODE PART OF COMMENT ROUTINE; 02109000 - END; 02109500 - GO FINIS; 02110000 -IDBLDR: 02110500 - TALLY:=63; DS:=LIT "1"; 02111000 - COMCOUNT(TALLY:=TALLY+1; 02111500 - IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO EXIT); 02112000 - TALLY:=TALLY+1; 02112500 - IF SC=ALPHA THEN 02113000 - BEGIN 02113500 -ERROR: 02114000 - DI:=DI-1; DS:=LIT "4"; GO EXIT; 02114500 - END 02115000 - ELSE GO EXIT; 02115500 -COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS 02116000 - IN AN IDENTIFIER OR NUMBER; 02116500 -NUMBERS: 02117000 - TALLY:=63; DS:=LIT "3"; 02117500 - COMCOUNT(TALLY:=TALLY+1; 02118000 - IF SC <"0"THEN JUMP OUT TO EXIT; SI:=SI+1); 02118500 - GO ERROR; 02119000 -EXIT: 02119500 - ST1:=TALLY; % "ST1" CONTAINS 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], 02182750 - SGNO,L.[45:2],MEDIUM,OMITTING); 02182760 - IF NOHEADING THEN DATIME; WRITELINE; 02183000 - END #; 02183250 -STREAM PROCEDURE EDITLINE(LINE,NGR,R,S,L,SYMBOL,OMIT); 02183500 - VALUE NCR,R,S,L,SYMBOL,OMIT; 02183750 - BEGIN 02184000 - DI := LINE; DS := 16 LIT " "; 02184250 - SI := NCR; DS := 9 WDS; 02184500 - DS := 8 LIT " "; 02184750 - DS := WDS; % SEQUENCE NUMBER. 02185000 - DS:=LIT" "; SI:=LOC SYMBOL; SI:=SI+6; 02185250 - DS:=2 CHR; DS:=LIT" "; 02185500 - SI:=LOC R; SI:=SI+4; 02185750 - IF SC=" " THEN DS:=12 LIT" " ELSE 02186000 - BEGIN 02186250 - SI:=LOC S; DS:=4 DEC; DS:=LIT ":"; 02186300 - SI:=LOC R; DS:=4 DEC; DS:=LIT ":"; 02186400 - SI:=LOC L; DS:=1 DEC; DS:=LIT " "; 02186500 - END; 02186600 - OMIT(DI := DI - 12; DS := 12 LIT " :OMIT: "; DI:= LINE; 02186750 - DS := 8 LIT " :OMIT:"); 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 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 02198755 -LABEL ENDREADTAPE, EOFT; 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]; 02201750 -MAXLCR:=LCR:=MKABS(TBUFF[9]); 02202000 -GO TO ENDREADTAPE; 02202010 -EOFT: 02202020 -DEFINEARRAY[25]:="ND;END."& "E"[1:43:5]; 02202030 -DEFINEARRAY[34]:="9999" & "9999"[1:25:23]; 02202040 -TLCR:= MKABS(DEFINEARRAY[34]); 02202050 -PUTSEQNO (DEFINEARRAY[33],TLCR-8); 02202060 -TURNONSTOPLIGHT("%", TLCR-8); 02202070 -ENDREADTAPE: 02202080 -END; 02202090 - END READTAPE; 02202250 - PROCEDURE SEQCOMPARE(TLCR,CLCR, LIB); VALUE LIB; BOOLEAN LIB; 02202500 - REAL TLCR, CLCR ; 02202750 - BEGIN 02203000 - MEDIUM:="C "; % CARD READER. 02203250 - IF GT1:=COMPARE(TLCR,CLCR)=0 THEN % TAPE HAS LOW SEQUENCE NUMB02203500 - BEGIN 02203750 - LCR:=TLCR; LASTUSED:=IF LIB THEN 6 ELSE 3; 02204000 - MEDIUM:=IF LIB THEN "CA"+FILEINX ELSE "T ";%CA,CB,CC,OR T.02204250 - END 02204500 - ELSE BEGIN 02204750 - IF GT1 ! 1 THEN % TAPE AND CARD HAVE SAME SEQ 02205000 - BEGIN 02205250 - MEDIUM:="P "; % CARD PATCHES TAPE. 02205500 - IF LIB THEN IF FINISHPT-RECOUNT=1 THEN 02207750 - LASTCRDPATCH:=TRUE ELSE 02208000 - READTAPE(LTLCR,MAXLTLCR,TRUE) ELSE 02208250 - READTAPE(TLCR,MAXTLCR,FALSE); 02208500 - END; 02208750 - LCR:=CLCR; 02209000 - LASTUSED:=IF LIB THEN 5 ELSE 2; 02209250 - END; 02209500 - END OF SEQCOMPARE; 02209750 - LABEL CARDONLY, CARDLAST, TAPELAST, EXIT, FIRSTTIME, 02210000 - EOF, USETHESWITCH, 02210250 - COMPAR,XIT,LIBEND, LIBTLAST,LIBCLAST; 02210500 - LABEL COPYLIB, COPYEOF; 02210600 - SWITCH USESWITCH := CARDONLY,CARDLAST,TAPELAST,FIRSTTIME, 02210750 - LIBCLAST, LIBTLAST, COPYLIB; 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 - TURNONSTOPLIGHT("%",LCR); 02214500 - GO XIT; 02214750 -COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 02215000 -CARDONLY: 02215250 - IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*]); 02215500 - LCR := MKABS(CBUFF[9]); GO EXIT; 02215750 -CARDLAST: 02216000 - IF NORELEASE THEN GO TO EXIT; READ(CARD,10,CBUFF[*])[EOF]; 02216250 - CLCR := MKABS(CBUFF[9]); 02216500 - GO COMPAR; 02216750 -EOF: 02217000 - DEFINEARRAY[25]:="ND;END."&"E"[1:43:5]; 02217250 - DEFINEARRAY[34]:="9999"&"9999"[1:25:23]; 02217500 - CLCR:=MKABS(DEFINEARRAY[34]); 02217750 - PUTSEQNO(DEFINEARRAY[33],CLCR-8); 02218000 - TURNONSTOPLIGHT("%",CLCR-8); 02218250 -% 02218400 - GO COMPAR; 02218500 -COMMENT THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND 02218750 - SETS UP CLCR; 02219000 -TAPELAST: 02219250 - READTAPE(TLCR,MAXTLCR,FALSE); GO TO COMPAR; 02219500 -COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 02219750 -LIBCLAST: 02220000 - IF FIRSTIMEX THEN 02220250 - BEGIN FIRSTIMEX:=FALSE; GO COMPAR END; 02220500 - READ(CARD,10,CBUFF[*])[EOF]; 02220750 - CLCR := MKABS(CBUFF[9]); 02221000 - IF LASTCRDPATCH THEN 02221250 - BEGIN 02221500 - LASTCRDPATCH:=FALSE; 02221750 - RECOUNT:=RECOUNT+1; 02222000 - GO TO XIT 02222250 - END; 02222500 - GO TO COMPAR; 02222750 -LIBTLAST: 02223000 - IF FIRSTIMEX THEN 02223250 - BEGIN FIRSTIMEX:=FALSE; GO TO COMPAR END; 02223500 - READTAPE(LTLCR,MAXLTLCR,TRUE); 02223750 - IF RECOUNT=FINISHPT THEN GO TO XIT; 02224000 - GO COMPAR; 02224010 -COPYLIB: 02224020 - READ(LF[INSERTINX:=INSERTINX+1],10,LBUFF[*])[COPYEOF]; 02224030 - READ SEEK(LF[INSERTINX+1]); 02224032 - IF(CMPD(INSERTSEQ,LBUFF[9]) = 0) THEN GO COPYEOF; 02224040 - LCR:=MKABS(LBUFF[9]); 02224050 - GO TO EXIT; 02224060 -COPYEOF: 02224070 - CLOSE(LF,RELEASE); 02224080 - IF((INSERTDEPTH:=INSERTDEPTH-1) = 0) THEN 02224090 - BEGIN LASTUSED:=SAVECARD; MEDIUM:=MEDIUM.[24:12]; 02224100 - GO USETHESWITCH; 02224102 - END; 02224104 - FILL LF WITH INSERTMID, INSERTFID; 02224110 - GO COPYLIB; 02224120 -COMPAR: 02224250 - IF LASTUSED = 2 OR LASTUSED = 3 THEN SEQCOMPARE(TLCR,CLCR,FALSE) 02224500 - ELSE SEQCOMPARE(LTLCR,CLCR,TRUE); 02224750 -EXIT: 02225000 - NCR := FCR:= LCR - 9; 02225250 -COMMENT SETS UP NCR AND FCR; 02225500 - IF CHECKTOG AND EXAMIN(FCR)!"$" THEN %$=CARDS DON"T COUNT. 02225750 - IF COMPARE(MKABS(INFO[LASTSEQROW,LASTSEQUENCE]),LCR)=1 THEN 02226000 - IF SEQERRTOG THEN BEGIN FLAG(610); 02226250 - NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1;END 02226300 - ELSE BEGIN % SEQUENCE WARNING 02226500 - BLANKET(14,LIN); 02226750 - SEQUENCEWARNING(LIN[13]); 02227000 - IF NOHEADING THEN DATIME; WRITELINE; 02227250 - IF NOT LISTER THEN PRINTCARD; 02227500 - NUMSEQUENCEERRORS:=NUMSEQUENCEERRORS+1; 02227600 - END; 02227750 - IF EXAMIN(FCR)="$" THEN 02228250 - BEGIN 02228500 - IF LISTPTOG OR PRINTDOLLARTOG THEN PRINTCARD; 02228750 - IF EXAMIN(NCR:=NCR+32768)="$" THEN MAKCAST ELSE DOLLARCARD; 02229000 - NORELEASE := FALSE; 02229100 -COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 02229250 - GO USETHESWITCH; 02229500 - END; 02229750 - IF EXAMIN(FCR)=" " THEN 02230000 - IF DOLLAR2TOG:=EXAMIN(FCR+32768)="$" THEN 02230100 - BEGIN 02230250 - OUTPUTSOURCE; 02230500 - IF EXAMIN(NCR:=NCR+65536)="$" THEN MAKCAST ELSE 02230750 - DOLLARCARD; 02231000 - END; 02231250 - IF VOIDING OR VOIDTAPE THEN 02231500 - BEGIN 02231750 - IF COMPARE(LCR,VOIDCR)=0 THEN 02232000 - BEGIN 02232250 - IF VOIDTAPE AND LASTUSED=3 OR NOT VOIDTAPE THEN 02232500 - GO USETHESWITCH; 02232750 - END 02233000 - ELSE BEGIN 02233250 - VOIDCR:=VOIDPLACE:=0; 02233500 - VOIDING:=FALSE; VOIDTAPE:=FALSE 02233750 - END; 02234000 - END; 02234250 - CARDCOUNT:=CARDCOUNT+1; 02234500 - IF DOLLAR2TOG THEN 02234600 - BEGIN DOLLAR2TOG:=NORELEASE:=FALSE; GO USETHESWITCH;END; 02234650 - PUTSEQNO(INFO[LASTSEQROW,LASTSEQUENCE],LCR); 02234750 - CARDNUMBER:=IF SEQTOG THEN TOTALNO+ADDVALUE ELSE 02234800 - CONV(INFO[LASTSEQROW,LASTSEQUENCE-1],5,8); 02234900 - OUTPUTSOURCE; 02235000 - IF OMITTING THEN GO USETHESWITCH; 02235250 -% 02235500 - TURNONSTOPLIGHT("%",LCR); 02235750 - IF BUILDLINE THEN 02236000 - IF LASTADDRESS ! (LASTADDRESS := L.[36:10]) THEN 02236250 - BEGIN 02236500 - ENILSPOT := LASTADDRESS & CARDNUMBER[10:20:28]; 02236750 - IF (ENILPTR := ENILPTR+1)}1023 THEN 02237000 - BEGIN FLAG(80); ENILPTR := 512; END; 02237250 - END; 02237500 -XIT: 02237750 - END READACARD; 02238000 -PROCEDURE INCLUDECARD; 02238100 - BEGIN 02238110 - REAL V; 02238112 - LABEL EEXIT,AGAIN,GETEM,EOF,EXIT,DONTSCAN; 02238120 - REAL STREAM PROCEDURE SCNN(A,B); VALUE B; 02238130 - BEGIN 02238140 - SI:=A; DI:=LOC SCNN; DS:=8 LIT"0 "; 02238150 - DI:=DI-7; SI:=SI+3; DS:=B CHR; 02238160 - END; 02238170 - STREAM PROCEDURE MVE(A,B,C,D); VALUE B,C; 02238180 - BEGIN 02238190 - SI:=A; SI:=SI+3; DI:=D; C(DS:=LIT"0"); DS:=B CHR; 02238200 - END; 02238210 -STREAM PROCEDURE MVEWD(A,B); VALUE A; 02238212 - BEGIN SI:=A; DI:=B; DS:=10 WDS; END; 02238214 - DEFINE SKAN = BEGIN 02238220 - COUNT:=RESULT:=ACCUM[0]:=0; 02238230 - SCANNER; 02238240 - V:=SCNN(ACCUM[1],MIN(COUNT,7)); 02238250 - END#; 02238260 - DEFINE ERR(ERR1) = BEGIN FLAG(ERR1); GO TO EEXIT; END#; 02238270 - IF((INSERTDEPTH:=INSERTDEPTH+1) > INSERTMAX) THEN ERR(612); 02238280 - INSERTMID:=INSERTFID:=INSERTINX:=INSERTCOP:=0; 02238290 - INSERTSEQ:="9999"&"9999"[1:23]; 02238300 -AGAIN: 02238330 - SKAN; 02238340 -DONTSCAN: 02238342 - IF V="% " THEN GO GETEM; 02238350 - IF V="/ " THEN GO AGAIN; 02238360 - IF RESULT=3 THEN % SEQ RANGE 02238370 - BEGIN 02238380 - MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTINX); 02238385 - SKAN; 02238390 - IF V="- " THEN 02238400 - BEGIN 02238410 - SKAN; 02238420 - IF RESULT ! 3 THEN ERR(614); 02238430 - MVE(ACCUM[1],COUNT:=MIN(COUNT,8),8-COUNT,INSERTSEQ); 02238440 - END ELSE GO TO DONTSCAN; 02238450 - GO AGAIN; 02238460 - END; % SEQ RANGE 02238470 - IF V="+ " THEN % WE HAVE COPY FORM 02238480 - BEGIN 02238490 - SKAN; 02238500 - IF V="COPY " THEN 02238510 - IF EXAMIN(LCR-9)="$" THEN 02238512 - INSERTCOP:=INSERTINFO[INSERTDEPTH-1,4] 02238514 - ELSE ERR(617) 02238520 - ELSE ERR(616); 02238522 - GO AGAIN; 02238530 - END; 02238540 - IF INSERTMID=0 THEN INSERTMID:=V 02238550 - ELSE IF INSERTFID=0 THEN INSERTFID:=V ELSE ERR(616); 02238552 - GO AGAIN; 02238555 -GETEM: 02238560 - IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN 02238570 - IF EXAMIN(FCR) = "$" THEN % ONLY IF "$" IS IN COLUMN ONE 02238572 - IF BOOLEAN(INSERTINFO[INSERTDEPTH-1,4]) THEN % ONLY IF LAST HAD COPY02238574 - BEGIN MVEWD(FCR,LBUFF[0]); 02238580 - PUTSEQNO(LBUFF[9],MKABS(INFO[LASTSEQROW,LASTSEQUENCE])); 02238582 - WRITE(NEWTAPE,10,LBUFF[*]); 02238590 - END; 02238600 - IF INSERTMID=0 THEN ERR(613); 02238602 - IF INSERTFID=0 THEN INSERTFID:=TIME(-1); 02238610 - IF INSERTFID=0 THEN 02238620 - BEGIN INSERTFID:=INSERTMID; INSERTMID:=0; END; 02238630 - IF INSERTDEPTH > 1 THEN CLOSE(LF,RELEASE); 02238640 - FILL LF WITH INSERTMID,INSERTFID; 02238650 - READ(LF[0],10,LBUFF[*])[EEXIT]; % DO THE FOLLOWING SO THAT 02238652 - INSERTMID:=LF.MFID; % IF THE OPERATOR IL-ED US 02238654 - INSERTFID:=LF.FID; % WE WILL HAVE THE PROPER NAMES. 02238656 - V:=-1; 02238658 - IF INSERTINX > 0 THEN 02238660 - BEGIN 02238670 - DO READ(LF[V:=V+1],10,LBUFF[*])[EEXIT] 02238680 - UNTIL CMPD(INSERTINX,LBUFF[9]) { 1; 02238690 - V:=V-1; 02238700 - END; 02238702 - INSERTINX:=V; 02238704 - IF INSERTDEPTH = 1 THEN 02238710 - BEGIN SAVECARD:=LASTUSED; LASTUSED:=7; MEDIUM:="L "& MEDIUM[24:12]; 02238720 - END; 02238730 - GO TO EXIT; 02238760 -EEXIT: 02238770 - IF((INSERTDEPTH:=INSERTDEPTH-1) > 0) THEN 02238780 - BEGIN 02238790 - CLOSE(LF,RELEASE); 02238800 - FILL LF WITH INSERTMID,INSERTFID; 02238810 - END; 02238820 -EXIT: 02238830 - Q:="1%0000"; 02238832 - END; 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,|,CONV(ACCUM[1],N,8),0,+,~, 02255000 - THI,TLO); 02256000 - T~THI; 02257000 - END ELSE 02258000 - T~ T|100000000+ CONV(ACCUM[1],N,8); 02259000 - CONVERT~T; 02260000 - END; 02261000 -REAL STREAM PROCEDURE FETCH(F); VALUE F; 02262000 - BEGIN SI:=F; SI:=SI-8; DI:=LOC FETCH; DS:=WDS END FETCH; 02263000 -PROCEDURE DUMPINFO; 02264000 - BEGIN 02264050 - ARRAY A[0:14]; INTEGER JEDEN,DWA; 02264100 - STREAM PROCEDURE OCTALWORDS(S,D,N); VALUE N; 02264400 - BEGIN 02264450 - SI:=S; DI:=D; 02264500 - N(2(8(DS:=3 RESET; 3(IF SB THEN DS:=1 SET ELSE 02264550 - DS:=1 RESET; SKIP 1 SB)); DS:=1 LIT " ");DS:=2 LIT" "); 02264600 - END OF OCTALWORDS; 02264650 - STREAM PROCEDURE ALPHAWORDS(S,D,N); VALUE N; 02264700 - BEGIN 02264750 - SI:=S; DI:=D; 02264800 - N(2(4(DS:=1 LIT" "; DS:=1 CHR); DS:=1 LIT" "); DS:=2 LIT" "); 02264850 - END OF ALPHAWORDS; 02264900 - IF NOHEADING THEN DATIME;WRITE(LINE[DBL],); 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: 02285000120324PK - 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 - LOCATES 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:=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: 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 02331050 - BUILDLINE.[47:1]:=SEQXEQTOG:=FALSE; 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 XBIT9 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; 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; 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 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 02722000 - GT2 := TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 02722500 - DO 02723000 - PUT(TEXT[(NEXTTEXT:=(GT1:=TAKE(DEFSTACKHEAD)).DYNAM-1) 02723500 - .LINKR,NEXTTEXT.LINKC],DEFSTACKHEAD) 02724000 - % THIS RESTORES THE PREVIOUS ELBAT WORD FOR 02724500 - % THIS PARAMETER IN CASE OF NESTED DEFINE. 02725000 - UNTIL 02725500 - GT2 = (DEFSTACKHEAD := GT1.LINK); 02726000 - END; 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. 02761500 - LINKR, LASTINFO.LINKC] = ACCUM[0])THEN 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 := (C|COUNT-1)DIV 6 + 1; % # OF CHARS. 02776100 - T.CLASS:= STRNGCON; 02776200 - MOVECHARACTERS(1,ACCUM[4],0,ACCUM[1],3); 02776300 - IF BOOLEAN(ACCUM[1].[18:1]) THEN % FLAG BIT SET. 02776400 - IF STREAMTOG THEN 02776500 - T.CLASS := STRING 02776600 - ELSE 02776700 - FLAG(254) 02776800 - ELSE 02776900 - C := ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 02777000 - MOVECHARACTERS(COUNT,ACCUM[4],8-COUNT,ACCUM[1],3); 02777050 - GO TO COMPLETE; 02777100 - MOVECHARACTERS(8,ACCUM[4],0,ACCUM[1],3); 02781000 - GO COMPLETE; 02782000 - END OCTAL OR HEX STRING; 02783000 - IF DPTOG THEN 02784000 - BEGIN NHI:=THI; NLO:=TLO; END; 02785000 - IF EXAMIN(NCR)="." THEN 02786000 - BEGIN 02787000 - RESULT:=0; SCANNER; 02788000 - C:=1.0| C; 02789000 - FPART: TCOUNT:=COUNT; 02790000 - IF EXAMIN(NCR){9 THEN 02791000 - BEGIN 02792000 - RESULT:=0; SCANNER; 02793000 - IF DPTOG THEN 02794000 - BEGIN 02795000 - DOUBLE(CONVERT,TLO,TEN[(COUNT-TCOUNT)MOD 12], 02796000 - 0,/,:=,THI,TLO); 02797000 - FOR T:=12 STEP 12 UNTIL COUNT - TCOUNT DO 02798000 - DOUBLE(THI,TLO,TEN[12],0,/,:=,THI,TLO); 02799000 - DOUBLE(THI,TLO,NHI,NLO,+,:=,NHI,NLO); 02800000 - C:=NHI 02801000 - END 02802000 - ELSE C:=CONVERT+C|TEN[FSAVE:=COUNT-TCOUNT]; 02803000 - END 02804000 - END; 02805000 - RESULT:=7; SCANNER; 02806000 - IF EXAMIN(NCR)="@" THEN 02807000 - BEGIN 02808000 - RESULT:=0; SCANNER; 02809000 - EPART: TCOUNT:=COUNT; 02810000 - C:=C|1.0; 02811000 - RESULT:=7; SCANNER; 02812000 - IF T:=EXAMIN(NCR)>9 THEN 02813000 - IF T="-" OR T = "+" THEN 02814000 - BEGIN 02815000 - RESULT:=0; SCANNER; 02816000 - TCOUNT:=COUNT; 02817000 - END 02818000 - ELSE FLAG(47); 02819000 - RESULT:=0; SCANNER; 02820000 - IF RESULT ! 3 THEN FLAG (47); COMMENT NOT A NUMBER; 02821000 - Q:=ACCUM[1]; 02822000 - IF GT1:=T:=(IF T="-" THEN -CONVERT ELSE CONVERT)<-46 OR 02823000 - T>69 THEN FLAG(269) 02824000 - ELSE BEGIN 02825000 - T:=TEN[ABS(GT3:=T-FSAVE)]; 02826000 - IF ABS(0&C[42:3:6]&C[1:2:1]+0&T[42:3:6]>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 - 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 02877010 - T:= 0; GO TO COMPLETE END; 02877020 - T:=INFO[GT1,GT2]; 02878000 - IF INFO[GT1,GT2+1]&0[1:1:11] ! Q THEN GO ROSE; 02879000 - IF COUNT { 5 THEN GO COMPOST ; 02880000 - IF NOT EQUAL(COUNT-5,ACCUM[2],INFO[GT1,GT2+2])THEN GO ROSE; 02881000 -COMPOST: T:=T>1[35:43:5]>2[40:40:8]; 02882000 - IF GT1 !1 AND NOT MACROID THEN % NOT RESERVED WORD 02882100 - XREFIT(T,LINK,CARDNUMBER,NORMALREF); % BUILD XREF ENTRY 02882200 -COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 02883000 - IF NOT ENDTOG THEN 02884000 - BEGIN 02885000 - IF GT1:=T.CLASS = COMMENTV THEN 02886000 - BEGIN 02887000 - WHILE EXAMIN(NCR) ! ";" DO 02888000 - BEGIN RESULT:=6; COUNT:=0; SCANNER END; 02889000 - RESULT:=0;SCANNER;GO SCANAGAIN 02890000 - END 02891000 - END; 02892000 - IF STOPDEFINE THEN GO COMPLETE; 02893000 - IF GT1 ! DEFINEDID THEN GO COMPLETE; 02894000 -COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 02895000 - IF BOOLEAN(T,MON) THEN % THIS IS A PARAMETRIC DEFINE 02896000 - GT1:=GIT(T:=FIXDEFINEINFO(T)) ELSE GT1:=0; 02897000 - IF DEFINEINDEX = 24 THEN 02898000 - BEGIN FLAG(139);GO ARGH END; 02899000 - DEFINEARRAY[DEFINEINDEX]:=LASTUSED & GT1[18:33:15]; 02900000 - LASTUSED:=T.DYNAM; 02901000 - DEFINEARRAY[DEFINEINDEX+2]:=262144|LCR+NCR; 02902000 - LCR:=(NCR:=MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 02903000 - PUTSEQNO(GT4,LCR); 02904000 - TURNONSTOPLIGHT("%",LCR); DEFINEINDEX:=DEFINEINDEX+3; 02905000 - GO PERCENT; 02906000 -DBLDOLLAR: 02907000 - MAKCAST; GO SCANAGAIN; 02908000 -COMPLETE: 02909000 - ELBAT[NXTELBT]:=T; 02910000 - IF NOT DEFINING THEN 02910100 - IF T.CLASS = BEGINV THEN 02910200 - BEGINSTACK[BSPOINT:=BSPOINT+1]:=CARDNUMBER ELSE 02910300 - IF T.CLASS = ENDV THEN 02910400 - BEGIN 02910500 - IF LISTER THEN IF BEND THEN BEGINPRINT; 02910600 - BSPOINT:=BSPOINT - REAL(BSPOINT > 0); % PREVENT INVALID INDEX 02910700 - END; 02910800 - STOPDEFINE:=FALSE; COMMENT ALLOW DEFINES AGAIN; 02911000 - IF NXTELBT:=NXTELBT+1 > 74 THEN 02912000 - IF NOT MACROID THEN 02913000 - BEGIN 02914000 -COMMENT ELBAT IS FULL: ADJUST IT; 02915000 - MOVE(10,ELBAT[65],ELBAT); 02916000 - I:=I-65; P:=P-65; NXTELBT:=10; 02917000 - END 02918000 - END; 02919000 - IF TABLE:=ELBAT[P].CLASS = COMMENTV THEN 02920000 - BEGIN 02921000 -COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 02922000 - C:=INFO[0,ELBAT[P].ADDRESS]; 02923000 - ELBAT[P].CLASS:=TABLE:=NONLITNO 02924000 - END; 02925000 - STOPDEFINE:=FALSE; COMMENT ALLOW DEFINE; 02926000 - END TABLE ; 02927000 -INTEGER PROCEDURE MOVEANDBLOCK(FROM,SIZE,NAME) 02927100 - VALUE SIZE,NAME; REAL SIZE,NAME; ARRAY FROM [0,0]; 02927110 - BEGIN 02927120 - INTEGER NSEGS,I,J,K; 02927130 - ARRAY A[0:14]; 02927140 - SWITCH FORMAT FMT := 02927150 -$RESET NEATUP 02927155120324PK - (/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), 02927160 - (/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927170 - (/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927180 - (/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), 02927190 - (/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 02927200 - (/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), 02927210 - (/,"SEGMENT ZERO",I*,/), 02927220 - (/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); 02927230 -$SET NEATUP 02927235120324PK - STREAM PROCEDURE OCTALWORDS(N,W,S,D); VALUE N,W; 02927240 - BEGIN 02927250 - DI:=D; DS:=LIT" "; 02927260 - SI:=LOC N; SI:=SI+6; 02927270 - 4(DS:=3 RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 02927272 - DI:=DI-4; DS:=3 FILL; 02927280 - DI:=D; DI:=DI+5; DS:=4 LIT" "; 02927290 - SI:=S; 02927300 - W(2(8(DS:=3 RESET; 02927310 - 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); 02927320 - ); 02927330 - DS:=LIT" "); 02927340 - DS:=2 LIT" "); 02927350 - END OF OCTALWORDS; 02927360 - %********** S T A R T ********** 02927370 - NSEGS:=(SIZE+29) DIV 30; 02927380 - IF DA DIV CHUNK < T:=(DA+NSEGS) DIV CHUNK THEN 02927390 - DA:=CHUNK|T; 02927400 - MOVEANDBLOCK:=DA; 02927410 - IF CODEFILE THEN 02927420 - IF NAME}0 THEN 02927430 - WRITE(LINE,FMT[NAME],DA) 02927440 - ELSE 02927450 - WRITE(LINE,FMT[7],ABS(NAME),DA); 02927460 - IF SIZE!0 THEN 02927470 - BEGIN 02927480 - FOR J:=0 STEP 30 WHILE J < SIZE DO 02927490 - BEGIN 02927500 - IF (K:=(128-(J MOD 128))) < 30 THEN 02927510 - BEGIN 02927520 - MOVE(K,FROM[J DIV 128,J MOD 128],CODE(0)); 02927530 - MOVE(30-K,FROM[(J DIV 128)+1,0],CODE(K)); 02927540 - END 02927550 - ELSE 02927560 - MOVE(30,FROM[J DIV 128,J MOD 128],CODE(0)); 02927570 - IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION 02927580 - BEGIN 02927590 - K:=0; 02927600 - MOVE(1,K,CODE(SIZE-J)); 02927610 - IF (SIZE-J) < 29 THEN % MORE THAN ONE WORD 02927612 - MOVE(29-SIZE+J,CODE(SIZE-J),CODE(SIZE-J+1)); 02927620 - END; 02927630 - IF CODEFILE THEN 02927640 - BEGIN 02927650 - FOR K:=0 STEP 5 WHILE K{25 AND (J+K){SIZE DO 02927660 - BEGIN 02927670 - BLANKET(14,A); 02927680 - OCTALWORDS(J+K,IF (J~K+5){SIZE THEN 5 ELSE 02927690 - SIZE-J-K,CODE(K),A); 02927700 - WRITE(LINE,15,A[*]); 02927710 - END; 02927720 - WRITE(LINE); 02927722 - END; 02927730 - WRITE(CODE[DA]); DA:=DA+1; 02927740 - END; 02927750 - END; 02927760 - END OF MOVEANDBLOCK; 02927770 -COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 02928000 - IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 02929000 - PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 02930000 - NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 02931000 -PROCEDURE NEXTENT; 02932000 - BEGIN LABEL DEBLANK; 02933000 - COUNT:=ACCUM[1]:=0; LASTELCLASS:=ELCLASS; 02934000 -DEBLANK: 02935000 - IF EXAMIN(NCR)=" "THEN 02936000 - BEGIN 02937000 - RESULT:=7; SCANNER; 02938000 - END; 02939000 - IF EXAMIN(NCR) { 9 THEN % WE HAVE A NO. (WORD MODE COLLATING SEQ.) 02940000 - BEGIN 02941000 - RESULT:=3; SCANNER; TCOUNT:=0; Q:=ACCUM[1]; 02942000 - IF COUNT>4 THEN FLAG(140) % INTEGER > 1023. 02943000 - ELSE IF ELCLASS:=-CONVERT < -1023 THEN FLAG(140) % INTEGER > 1023. 02944000 - END 02945000 -ELSE IF EXAMIN(NCR)="%" THEN 02946000 - BEGIN 02947000 - READACARD; COUNT:=ACCUM[1]:=0; GO DEBLANK; 02948000 - END 02949000 -ELSE BEGIN 02950000 - RESULT:=5; SCANNER; % GET NEXT CHARACTER. 02951000 - Q:=ACCUM[1]; ELCLASS:=ACCUM[1].[18:6] 02952000 - END 02953000 - END OF NEXTENT; 02954000 - BOOLEAN PROCEDURE BOOLPRIM; FORWARD; 02955000 - PROCEDURE BOOLCOMP(B); BOOLEAN B; FORWARD; 02955500 - INTEGER PROCEDURE NEXT; 02956000 - BEGIN 02956500 - LABEL EXIT; 02957000 - INTEGER T; 02957500 - DEFINE ERROR = BEGIN FLAG(603); GO EXIT END#; 02958000 - SKAN; 02958500 - IF RESULT=3 THEN ERROR; % NUMBERS NOT ALLOWED. 02959000 - IF RESULT=2 THEN % SPECIAL CHARACTER. 02959500 - BEGIN 02960000 - T:=IF Q="1,0000" OR Q="1%0000" THEN 20 % FAKE OUT BOOLEXP.02960500 - ELSE ((T:=Q.[18:6]-2) & T[42:41:3]); 02961000 - IF T=11 OR T=19 OR T=20 THEN BATMAN:=SPECIAL[T] % (,),OR ;02961500 - ELSE FLAG(603); 02962000 - GO EXIT 02962500 - END SPECIAL CHARACTERS; 02963000 -COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 02963500 - T:= IF Q="3NOT00" THEN NOTOP 02964000 - ELSE IF Q="3AND00" THEN ANDOP 02964500 - ELSE IF Q="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 1023 THEN EMITO(PRTE); 04018000 - EMIT(2 & ADDRESS [36:38:10]) END EMITV; 04019000 - COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 04020000 - SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 04021000 - PROCEDURE EMITN(ADDRESS); VALUE ADDRESS; INTEGER ADDRESS; 04022000 - BEGIN IF ADDRESS > 1023 THEN EMITO(PRTE); 04023000 - EMIT(3 & ADDRESS [36:38:10] END EMITN; 04024000 - COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 04025000 - ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 04026000 - EMITS PRTE; 04027000 - PROCEDURE EMITPAIR(ADDRESS,OPERATOR); 04028000 - VALUE ADDRESS,OPERATOR; 04029000 - INTEGER ADDRESS,OPERATOR; 04030000 - BEGIN 04031000 - EMITL(ADDRESS); 04032000 - IF ADDRESS > 1023 THEN EMITO(PRTE); 04033000 - EMITO(OPERATOR) END EMITPAIR; 04034000 - COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 04035000 - EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 04036000 - OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS04037000 - CODE CONSISTS OF A SERIES OF DUPS AND MULS, AS WITH 04038000 - EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 04039000 - AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 04040000 - NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 04041000 - IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 04042000 - (APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 04043000 - OTHERWISE IT CALLS LN AND EXP; 04044000 - PROCEDURE EMITUP; 04045000 - BEGIN INTEGER BACKUP, CTR; 04046000 - LABEL E; 04047000 - IF NOT LINKTOG THEN GO TO E; 04048000 - COMMENT CALL XTOTHEI IF LAST THING IS LINK; 04049000 - IF GET(L-1) = 537 THEN 04050000 - COMMENT LAST OPERATOR IS CHS; 04051000 - BEGIN BACKUP ~ 1; L ~ L-1 END; 04052000 - IF(GT4 ~ GET(L-1)).[46:2] = 0 04053000 - THEN BEGIN 04054000 - COMMENT IT IS A LITERAL; 04055000 - BACKUP ~ BACKUP+1; L ~ L-1; 04056000 - IF GET(L-1).[39:9] = 153 THEN GO TO E; 04057000 - COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 04058000 - CTR ~ 1; GT4 ~ GT4 DIV 4; 04059000 - WHILE GT4 DIV 2 ! 0 04060000 - DO BEGIN 04061000 - EMITO(DUP); 04062000 - IF BOOLEAN(GT4) THEN BEGIN CTR~CTR+1;EMITO(DUP)END; 04063000 - EMITO(MUL); 04064000 - GT4 ~ GT4 DIV 2 END; 04065000 - IF GT4 =0 THEN BEGIN EMITO(DEL);EMITL(1) END 04066000 - ELSE WHILE CTR ~ CTR-1 ! 0 DO EMITO(MUL); 04067000 - IF BACKUP = 2 04068000 - THEN BEGIN 04069000 - EMITL(1); 04070000 - EMITO(XCH); 04071000 - EMITO(128) END END 04072000 - ELSE BEGIN 04073000 - E: L ~ L+BACKUP; 04074000 - EMITO(MKS); 04075000 - EMITPAIR(GNAT(LOGI),LOD); 04076000 - EMITPAIR(GNAT(EXPI),LOD); 04077000 - EMITV(GNAT(XTOTHEI)); 04078000 - STACKCT ~ 0; 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] 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 ~ LSTSEQ; DI ~ DI-8; DS ~ WDS; 05023000 - DI~LINE; SI~RMT; SI~SI+7; 05024000 - IF SC="1" THEN 05024100 - BEGIN SI~LSTSEQ; DS~10 LIT "NEAR LINE "; 05024200 - 7(IF SC>"0" THEN JUMP OUT; 05024300 - SI~SI+1; TALLY~TALLY+1); 05024400 - RMT~TALLY; DS~8 CHR; DI~DI-RMT; 05024500 - END ELSE DI~DI+7; 05024600 - DS~14 LIT " ERROR NUMBER "; 05025000 - SI ~ LOC ERRNUM; DS ~ 3 DEC; COMMENT CONVERT ERRNUM; 05026000 - DS ~ 4 LIT " -- "; 05027000 - SI ~ ACCUM; SI ~ SI+3; DS ~ COUNT CHR; 05028000 - COMMENT PLACE ALPHA IN BUFFER; 05029000 - DS ~ LIT "." 05030000 - END WRITERROR; 05031000 - IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 05032000 - BEGIN 05033000 - SPECTOG := FALSE; 05034000 - ERRORCOUNT := ERRORCOUNT+1; COMMENT COUNT ERRORS; 05035000 - IF NOT(LISTER OR REMOTOG) THEN 05036000 - BEGIN 05037000 - EDITLINE(LIN,FCR," ",0,0,MEDIUM,0); 05038000 - MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE],LIN[12]); 05039000 - IF NOHEADING THEN DATIME; WRITELINE; 05039500 - END; 05041000 - COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 05042000 - ACCUM[1] ~ Q; COMMENT RESTORE ACCUMULATOR; 05043000 - WRITERROR(REMOTOG,ERRNUM,ACCUM[1],LIN,Q.[12:6], 05044000 - INFO[LASTSEQROW,LASTSEQUENCE]); 05045000 - IF REMOTOG THEN WRITE(REMOTE,10,LIN[*]); 05045900 - IF NOT NOHEADING THEN BEGIN WRITE (LINE); WRITELINE; END; 05046000 - ERRORTOG ~ FALSE; COMMENT INHIBIT MESSAGES; 05047000 -IF PUNCHTOG THEN 05048000 - BEGIN 05049000 - STREAM PROCEDURE PUNCH(FL,ST); 05050000 - VALUE ST; 05051000 - BEGIN 05052000 - DI ~ FL; 05053000 - SI ~ ST; 05054000 - DS ~ 9 WDS 05055000 - END PUNCH; 05056000 - PUNCH(PNCH(0),FCR); 05057000 - MOVE(1,INFO[LASTSEQROW,LASTSEQUENCE], PNCH(9)); 05058000 - WRITE(PNCH) 05059000 - END 05060000 - END END FLAG; 05101000 - LABEL ENDOFITALL; 05101100 -COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 05102000 - RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 05103000 - SEMICOLON, END, OR BEGIN; 05104000 -PROCEDURE ERR(ERRNUM); VALUE ERRNUM; INTEGER ERRNUM; 05105000 - BEGIN FLAG(ERRNUM); 05106000 - I ~ I-1; 05107000 - IF ERRNUM=200 THEN GO TO ENDOFITALL; 05107100 - IF ERRNUM=611 THEN GO TO ENDOFITALL;%ERRMAX EXCEEDED. 05107200 - DO IF STEPI = BEGINV THEN STMT UNTIL 05108000 - ELCLASS = ENDV OR ELCLASS = SEMICOLON END ERR; 05109000 - DEFINE ERROR = ERR#; COMMENT ERROR IS A SYNONM FOR ERR; 05110000 - COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 05111000 - UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 05112000 - PROCEDURE CHECKER(ELBATWORD); VALUE ELBATWORD; REAL ELBATWORD; 05113000 - BEGIN 05114000 - IF MODE } 2 THEN 05115000 - IF 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 GNAT ~(A~TAKE(L)).ADDRESS=0 05131000 - THEN PUT(A&(GNAT:=GETSPACE(TRUE,L.LINK+1))[16:37:11],L) 05132000 - END GNAT; 05133000 - COMMENT PASSFILE COMPILES CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR05134000 - POINTING AT THE I/O DESCRIPTOR (ON TOP). IT HANDLES 05135000 - SUPERFILES AS WELL AS ORDINARY FILES; 05136000 - PROCEDURE PASSFILE; 05137000 - BEGIN INTEGER ADDRES; 05138000 - CHECKER(ELBAT[I]); 05139000 - ADDRES ~ ELBAT[I].ADDRESS; 05140000 - IF ELCLASS = SUPERFILEID 05141000 - THEN BEGIN 05142000 - BANA; EMITN(ADDRES); EMITO(LOD) END 05143000 - ELSE BEGIN 05144000 - IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN EMITL(5); 05145000 - STEPIT; 05146000 - EMITN(ADDRES) END END PASSFILE; 05147000 -PROCEDURE PASSMONFILE(ADDRESS); 05148000 - VALUE ADDRESS ; 05149000 - REAL ADDRESS ; 05150000 - BEGIN COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 05151000 - FILE TO PRINTI; 05152000 - IF ADDRESS < 768 OR ADDRESS > 1023 05153000 - THEN EMITL(5); 05154000 - EMITN(ADDRESS); 05155000 - END PASSMONFILE; 05156000 -PROCEDURE PASFILE; 05157000 - BEGIN COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 05158000 - MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 05159000 - DEFINE ELBATWORD = RR1#; COMMENT ELBATWORD CONTAINS THE 05160000 - ELBATWORD FOR THE FILE BEING 05161000 - OPERATED ON; 05162000 - DEFINE LTEMP = RR2#; COMMENT LTEMP IS USED TO HOLD THE L 05163000 - REGISTER SETTING FOR THE SAVE OR 05164000 - RELEASE LITERAL THAT GETS PASSED TO 05165000 - KEN MYERS; 05166000 - EMITO(MKS); L~(LTEMP~L)+1; EMITL(0); 05167000 - EMITL(2); CHECKER(ELBATWORD~ELBAT[I]); 05168000 - IF RRB1~(RRB2~ ELCLASS = SUPERFILEID)OR 05169000 - BOOLEAN(ELBATWORD.FORMAL) 05170000 - THEN EMITO(LNG); 05171000 - IF RRB2 05172000 - THEN BANA 05173000 - ELSE STEPIT; 05174000 - EMITN(ELBATWORD.ADDRESS); 05175000 - IF RRB2 05176000 - THEN EMITO(LOD); 05177000 - IF RRB1 05178000 - THEN EMITO(INX); 05179000 - EMITL(4); EMITV(14); 05180000 - END PASFILE; 05181000 - COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE05182000 - PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 05183000 - PROCEDURE CHECKPRESENCE; 05184000 - BEGIN 05185000 - EMITO(DUP); EMITO(LOD); EMITL(0); EMITO(CDC); EMITO(DEL); 05186000 - END CHECKPRESENCE; 05187000 -COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 05187500 - TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 05187510 -PROCEDURE PASSLIST; 05187520 - BEGIN 05187530 - INTEGER LISTADDRESS; 05187540 -COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 05187550 - CHECKER(ELBAT[I]); 05187560 - LISTADDRESS:=ELBAT[I].ADDRESS; 05187570 - IF 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 MODE05251000 - AND ARGUMENT BIT FOR THE PROGRAM 05252000 - DESCRIPTOR TO BE BUILT. 05253000 - RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 05254000 - SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 05255000 - IF!0 THEN SPACE IS ALREADY GOTTEN 05256000 - ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 05257000 - PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 05258000 - VALUE TYPE,RELAD,SPAC;REAL TYPE,RELAD,SPAC; 05259000 - BEGIN IF SPAC=0 THEN SPAC:=GETSPACE(TRUE,-2);% DESCR. 05260000 - PDPRT[PDINX.[37:5],PDINX.[42:6]]~0&RELAD[18:36:10] 05261000 - &SGNO[28:38:10]&TYPE[4:46:2]&SPAC[8:38:10]; 05262000 - IF DEBUGTOG THEN 05263000 - BEGIN 05263500 - BLANKET(14,LIN); 05264000 - DEBUGDESC(LIN,B2D(SPAC),TYPE,B2D(RELAD),B2D(SGNO));05264500 - IF NOHEADING THEN DATIME; WRITELINE; 05265000 - END; 05265100 - PDINX~PDINX+1;PROGDESCBLDR~SPAC END PROGDESCBLDR; 05266000 - COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 05267000 - IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 05268000 - LITERALS INVOLVED; 05269000 - BOOLEAN PROCEDURE DOTSYNTAX(FIRST,SECOND); 05270000 - INTEGER FIRST,SECOND; 05271000 - BEGIN 05272000 - LABEL EXIT; 05273000 - IF STEPI = FIELDID THEN % GET INFO FROM INFO 05273100 - BEGIN 05273200 - FIRST := ELBAT[I].SBITF; 05273300 - SECOND := ELBAT[I].NBITF; 05273400 - GO TO EXIT; 05273500 - END 05273600 - ELSE 05273700 - IF ELCLASS = LFTBRKET THEN 05273800 - IF STEPI = FIELDID THEN 05273900 - BEGIN 05274000 - FIRST := ELBAT[I].SBITF; 05274100 - SECOND := ELBAT[I].NBITF; 05274200 - IF STEPI = RTBRKET THEN 05274300 - GO TO EXIT; 05274400 - END 05274500 - ELSE 05274600 - IF ELCLASS = LITNO THEN 05275000 - IF STEPI = COLON THEN 05276000 - IF STEPI = LITNO THEN 05277000 - IF STEPI = RTBRKET THEN 05278000 - COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 05279000 - IF (FIRST ~ ELBAT[I-3].ADDRESS) | 05280000 - (SECOND ~ ELBAT[I-1].ADDRESS)!0 THEN 05281000 - IF FIRST + SECOND { 48 THEN 05282000 - COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 05283000 - GO TO EXIT; 05284000 - ERR(114); COMMENT ERROR IF SYNTAX OR RANGE FAILS; 05285000 - DOTSYNTAX ~ TRUE; EXIT: END DOTSYNTAX; 05286000 -BOOLEAN PROCEDURE CHECK(ELBATCLASS,ERRORNUMBER); 05287000 - VALUE ELBATCLASS,ERRORNUMBER; 05288000 - REAL ELBATCLASS,ERRORNUMBER; 05289000 - BEGIN COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 05290000 - ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 05291000 - CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET05292000 - FALSE; 05293000 - IF CHECK~(ELBATCLASS ! TABLE(I)) 05294000 - THEN ERR(ERRORNUMBER); 05295000 - END; 05296000 -BOOLEAN PROCEDURE RANGE(LOWER,UPPER); 05297000 - VALUE LOWER,UPPER; 05298000 - REAL LOWER,UPPER; 05299000 - COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 05300000 - IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 05301000 - UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 05302000 - CLASS MUST BE IN ELCLASS; 05303000 - RANGE~ELCLASS } LOWER AND ELCLASS { UPPER; 05304000 - COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 05305000 - EMITTED; 05306000 - INTEGER PROCEDURE GET(L); VALUE L; REAL; 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 - BEGIN DI~LOC MASK; DI~DI+2; SKIP K DB; DS~SET END MASK; 05342000120324PK - 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 ~ 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(357) ELSE 05391000 - IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(358) ELSE 05392000 - HVCHECK~TRUE; 05393000 - COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 05394000 - BOOLEAN PROCEDURE OUTPROCHECK(ELBW); VALUE ELBW; REAL ELBW; 05395000 - IF ELBW.CLASS!PROCID THEN ERR(351) ELSE 05396000 - IF BOOLEAN(ELBW.FORMAL) THEN OUTPROCHECK~TRUE ELSE 05396100 - IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(352) ELSE 05397000 - IF TAKE(GT1~1).CLASS!BOOID THEN ERR(353) ELSE 05398000 - IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(354) ELSE 05399000 - OUTPROCHECK~TRUE; 05400000 - COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 05401000 - BOOLEAN PROCEDURE EQLESCHECK(ELBW); VALUE ELBW; REAL ELBW; 05402000 - IF ELBW.CLASS!BOOPROCID THEN ERR(359) ELSE 05403000 - IF BOOLEAN (ELBW.FORMAL) THEN EQLESCHECK ~ TRUE ELSE 05403100 - IF TAKE(GT1~GIT(ELBW))!2 THEN ERR(360) ELSE 05404000 - IF ARRAYCHECK(TAKE(GT1+1)) THEN ERR(361) ELSE 05405000 - IF ARRAYCHECK(TAKE(GT1+2)) THEN ERR(362) ELSE 05406000 - EQLESCHECK~TRUE; 05407000 - COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;06000000 - COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 06001000 - PROCEDURE AEXP; 06002000 - BEGIN 06003000 - IF ELCLASS = IFV 06004000 - THEN BEGIN IF IFEXP ! ATYPE THEN ERR(102) END 06005000 - ELSE BEGIN ARITHSEC; SIMPARITH END 06006000 - END AEXP; 06007000 - COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 06008000 - IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 06009000 - AND Q ARE PRIMARIES; 06010000 - PROCEDURE ARITHSEC; 06011000 - BEGIN 06012000 - IF ELCLASS = ADOP 06013000 - THEN BEGIN 06014000 - STEPIT; 06015000 - IF ELBAT[I-1].ADDRESS = ADD THEN PRIMARY 06016000 - ELSE BEGIN 06017000 - PRIMARY; 06018000 - WHILE ELCLASS = FACTOP DO 06019000 - BEGIN STEPIT; PRIMARY; EMITUP END; 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; 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 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; 06098000 - L14: L15: L16: 06099000 - COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 06100000 - IF ARRAYFLAG THEN CHECKBOUNDLVL; 06100100 - STRMPROCSTMT; GO TO LDOT; 06101000 - L18: L19: L20: 06102000 - COMMENT ORDINARY FUNCTION DESIGNATORS; 06103000 - IF ARRAYFLAG THEN CHECKBOUNDLVL; 06103100 - PROCSTMT(FALSE); GO TO LDOT; 06104000 - L22: L23: L24: L26: L27: L28: 06105000 - COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 06106000 - IF ARRAYFLAG THEN CHECKBOUNDLVL; 06106100 - VARIABLE(FP); GO TO LAMPER; 06107000 - L32: 06108000 - COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 06109000 - EMIT(0&ELBAT[I] [36:17:10]); STEPIT;GO TO LAMPER; 06110000 - L31: L33: 06111000 - COMMENT STRINGS AND NONLITERALS; 06112000 - EMITNUM(C); STEPIT; GO TO LAMPER; 06113000 - L35: 06114000 - COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN06115000 - EXPRESSION - OTHERWISE AN ERROR; 06116000 - IF ELBAT[I].ADDRESS = 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; 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; 06128000 - WHILE ELCLASS = AMPERSAND 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; 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; 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; 06267000 - WHILE ELCLASS = AMPERSAND DO 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; 06296500 - THENBRANCH ~ BUMPL; 06297000 - COMMENT SAVE L FOR LATER FIXUP; 06298000 - IFEXP ~ TYPE ~ EXPRSS; COMMENT COMPILE 1ST EXPRSS; 06299000 - STACKCT ~ 0; 06299500 - ELSEBRANCH ~ BUMPL; 06300000 - EMITB(BFC,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; 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 06313550 - BEGIN 06313600 - FIRST := ELBAT[I].SBITF; 06313650 - SECOND := 48 - (THIRD := ELBAT[I].NBITF); 06313700 - GO TO SKIP1; 06313750 - END 06313800 - ELSE 06313850 - IF ELCLASS ! LFTBRKET THEN BEGIN ERR(90);GO TO EXIT END; 06314000 - IF STEPI = FIELDID THEN 06314050 - BEGIN 06314100 - FIRST := ELBAT[I].SBITF; 06314150 - SECOND := 48 - (THIRD := ELBAT[I].NBITF); 06314200 - IF STEPI ! RTBRKET THEN 06314250 - BEGIN 06314300 - ERR(94); 06314350 - GO TO EXIT; 06314400 - END; 06314450 - GO TO SKIP1; 06314500 - END 06314550 - ELSE 06314600 - IF ELCLASS ! LITNO THEN % PREPARE FOR DYNAMIC DIAL 06314650 - GO TO L1; 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 - 06342000 - EMITI(0,FIRST,SECOND); 06343000 - 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; 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{ENDV AND ELCLASS}UNTILV 07018000 - OR NOT ENDTOG; 07019000 - ENDTOG~FALSE; 07020000 - IF BEGINCTR ~ BEGINCTR-1 ! 0 EQV ELCLASS = PERIOD 07021000 - THEN BEGIN 07022000 - IF BEGINCTR = 0 THEN 07023000 - BEGIN FLAG(143); BEGINCTR ~ 1; GO ANOTHER END; 07024000 -FLAG (120); 07025000 -FCR:= (LCR:=MKABS(CBUFF[9]))-9; 07025010 -IF LISTER THEN PRINTCARD; 07025020 -FCR:= (LCR:=MKABS(TBUFF[9]))-9 END; 07025030 - IF ELCLASS = PERIOD THEN 07026000 - BEGIN 07027000 - GT5 ~ "ND;END."&"E"[1:43:5]; 07028000 - MOVE(1,GT5,CBUFF[0]); 07029000 - LASTUSED~4; 07030000 - ELBAT[I~I-2] ~SPECIAL[20]; 07031000 - ELCLASS ~ SEMICOLON END 07032000 - END COMPOUNDTAIL; 07033000 - 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; 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 THUNK07301000 - CONSTRUCTIONS; 07302000 - GOBBLE: 07303000 - TB1 ~ FALSE; T5 ~ BAE; 07304000 - T6 ~ PROGDESCBLDR(1,L,0) END; 07305000 - EMITV(T4 ~ T3.ADDRESS); EMITPAIR(T4,STD)END END;07306000 - COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 07307000 - IF NOT TB1 07308000 - THEN BEGIN 07309000 - COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 07310000 - EMITPAIR(ADDRSF,LOD); EMITO(BFW); 07311000 - CONSTANTCLEAN; EMITB(BFW,T5,L); ADDRSF ~ T6 END; 07312000 - GO TO LODPOINT; COMMENT IN ANY CASE LOAD A DESCRIPTOR; 07313000 - L11: 07314000 - COMMENT INTRINSIC PROCEDURE; 07315000 - ADDRSF ~ GNAT(WHOLE); 07316000 - COMMENT GET PRT SPACE IF NOT ASSIGNED; 07317000 - ACLASS ~ REALPROCID; 07318000 - T3.ADDRESS ~ 897; T2~T1~1; GO TO GOBBLE; 07319000 - COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 07320000 - PROCEDURES; 07321000 - L19:L20: 07322000 - COMMENT ALFAPROC AND INTPROC; 07323000 - ACLASS ~ REALPROCID; 07324000 - L17:L18: 07325000 - COMMENT BOOPROC AND REAL PROC; 07326000 - IF FORMALF 07327000 - THEN BEGIN 07328000 - COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 07329000 - IF SCLASS > INTPROCID THEN ACLASS ~ ACLASS+4; 07330000 - COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 07331000 - EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 07332000 - PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 07333000 - IF VBIT 07334000 - THEN BEGIN EMITV(ADDRSF); GO TO BS END 07335000 - ELSE GO TO LODPOINT; 07336000 - COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 07337000 - DESCRIPTOR ALONG; 07338000 - END; 07339000 - TB1 ~ FALSE; GO TO LP; 07340000 - L23:L24: 07341000 - COMMENT INTEGER AND ALPHA IDS; 07342000 - ACLASS ~ REALID; 07343000 - L21:L22: 07344000 - COMMENT BOOLEAN AND REAL IDS; 07345000 - IF VBIT THEN EMITV(ADDRSF) 07346000 - ELSE IF NOT(SBIT OR VONF) AND FORMALF 07347000 - THEN GO TO LODPOINT ELSE EMITN(ADDRSF); 07348000 - COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 07349000 - AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 07350000 - THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 07351000 - GO TO BS; 07352000 - L27:L28: 07353000 - COMMENT INTEGER AND ALPHA ARRAYS; 07354000 - ACLASS ~ REALARRAYID; 07355000 - L25:L26: 07356000 - COMMENT BOOLEAN AND REAL ARRAYS; 07357000 - EMITPAIR(ADDRSF,LOD); 07358000 - IF SBIT THEN GO TO BS; 07359000 - COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 07360000 - T1 ~ TAKE(WHOLE ~ GIT(WHOLE)).NODIMPART; 07361000 - FOR T2 ~ 1 STEP 1 UNTIL T1 07362000 - DO BEGIN 07363000 - IF T3 ~ (STLB ~ TAKE(WHOLE+T2)).[35:11] >1023 07364000 - THEN EMITV(T3) ELSE EMIT(STLB); 07365000 - IF STLB.[23:10] = ADD THEN EMITO(CHS) END; 07366000 - COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 07367000 - IF FBIT THEN GO TO BS; 07368000 - IF TAKE(INDEX+PCTR).INCR ! T1 THEN FLAG(124); GO TO BS; 07369000 - COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 07370000 - OF DIMENSIONS; 07371000 - L29: 07372000 - COMMENT LABEL; 07373000 - ELCLASS ~ TABLE(I~I-1); DEXP; GO TO NSBS; 07374000 - L30: 07375000 - COMMENT TRUTH VALUE; 07376000 - EMITL(ADDRSF); ACLASS ~ BOOID; GO TO BSX; 07377000 - L32: 07378000 - COMMENT LITERAL; 07379000 - EMITL(ADDRSF); 07380000 - BSXX: ACLASS ~ REALID; 07381000 - BSX: IF SBIT AND NOT VBIT THEN FLAG(150); GO TO BS; 07382000 - L31:L33: 07383000 - EMITNUM(C); GO TO BSXX; 07384000 - EXIT: STACKCT ~ 0 END OF ACTUALPARAPART; 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); 07422000 - EMITNUM(1&CARDNUMBER[1:4:44]); 07422100 - EMITV(GNAT(PRINTI)); 07423000 - END; 07424000 - EXIT: END PROCSTMT; 07425000 - COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;07426000 - PROCEDURE STRMPROCSTMT; 07427000 - BEGIN 07428000 - INTEGER ADDRS; 07429000 - IF ADDRS ~ ELBAT[I].ADDRESS = 0 07430000 - THEN BEGIN 07431000 - UNKNOWNSTMT; 07432000 - END 07433000 - 07434000 - 07435000 - 07436000 - 07437000 - 07438000 - 07439000 - ELSE BEGIN 07440000 - IF ELCLASS ! STRPROCID THEN EMIT(0); EMITO(MKS); STEPIT; 07441000 - GT1 ~ (GT2 ~ TAKE(GT3 ~ GIT(ELBAT[I-1]))).[14:10]; 07442000 - GT4 ~ GT1-GT2.[7:6]; 07443000 - FOR GT1 ~ GT1-1 STEP -1 UNTIL GT4 07444000 - DO EMITV(IF GT1 } 512 THEN GT1+1024 ELSE GT1); 07445000 - COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 07446000 - JUMPS INSIDE OF STREAM PROCEDURES; 07447000 - GT4 ~ GT2.[1:6]; 07448000 - FOR GT1 ~ 1 STEP 1 UNTIL GT4 DO EMIT(0); 07449000 - COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE07450000 - OF STREAM PROCEDURES; 07451000 - IF ELCLASS ! LEFTPAREN THEN ERR(128) 07452000 - ELSE BEGIN 07453000 - ACTUALPARAPART(FALSE,TRUE,GT3); EMITV(ADDRS) END; 07454000 - END END STRMPROCSTMT; 07455000 - COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 07456000 - ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 07457000 - INTEGER PROCEDURE BAE; 07458000 - BEGIN BAE ~ BUMPL; CONSTANTCLEAN; ADJUST END BAE; 07459000 -COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 07460000 - RELEASE() % 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 FLCLASS!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); 07516000 - EMITNUM(0&CARDNUMBER[1:4:44]); 07516100 - EMITV(GNAT( 07516200 - PRINTI)); 07517000 - END; 07518000 - BANA; EMITPAIR(JUNK,ISD); 07519000 - IF (GT1 ~ TAKE(GT2 ~ GIT(ELBW))).[24:12] = 0 07520000 - AND ELBW.ADDRESS = 0 THEN BEGIN 07521000 - PUT(GT1&(BUMPL)[24:36:12],GT2); 07522000 - EMITB(BBW,L,GT4~GT1.[36:12]); 07523000 - EMITB(BFW,GT4+13,L+3); 07524000 - EMITO(NOP); EMITO(NOP); EMITO(NOP) END 07525000 - ELSE BEGIN CALLSWITCH(ELBW); EMITO(BFW) END; 07526000 - GO EXIT; 07527000 - GOMCP: GOTOG ~ FALSE; DEXP; 07528000 - IF GOTOG THEN 07529000 - BEGIN EMITO(MKS); EMITL(9); EMITV(5); EMITO(BFW) END 07529100 - ELSE BEGIN EMITO(PRTE); EMITO(LOD); EMITO(BFW) END; 07529200 - EXIT:END GOSTMT; 07530000 - COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 07531000 - PARAMETER. GOGEN ASSUMES THAt THE LABEL IS LOCAL. THE 07532000 - PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL07533000 - OR NOT; 07534000 - PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 07535000 - VALUE LABELBAT,BRANCHTYPE; 07536000 - REAL LABELBAT,BRANCHTYPE; 07537000 - BEGIN 07538000 - IF BOOLEAN(GT1~TAKE(GT2~GIT(LABELBAT))).[1:1] 07539000 - THEN EMITB(BRANCHTYPE,BUMPL,GT1.[36:12]) 07540000 - COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 07541000 - NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 07542000 - THAT WE NOW KNOW WHERE TO GO; 07543000 - ELSE BEGIN EMIT(GT1); EMIT(BRANCHTYPE); 07544000 - PUT(GT1&L[36:36:12],GT2) END END GOGEN; 07545000 - COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 07546000 - A STATEMENT IS A SIMPLE GO TO STATEMENT; 07547000 - BOOLEAN PROCEDURE SIMPGO; 07548000 - BEGIN LABEL EXIT; 07549000 - IF ELCLASS = GOV 07550000 - THEN BEGIN 07551000 - IF STEPI = TOV THEN STEPIT; 07552000 - IF ELCLASS = LABELID THEN 07553000 - IF LOCAL(ELBAT[I]) THEN 07554000 - BEGIN SIMPGO ~ TRUE; GO EXIT END; 07555000 - I ~ I-1; ELCLASS ~ GOV END; 07556000 - EXIT: END SIMPGO; 07557000 - COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 07558000 - OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 07559000 - EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 07560000 - PROCEDURE IFSTMT; 07561000 - BEGIN REAL T1,T2; LABEL EXIT; 07562000 - IFCLAUSE; 07563000 - IF SIMPGO 07564000 - THEN BEGIN 07565000 - T1 ~ ELBAT[I]; 07566000 - IF STEPI = ELSEV 07567000 - THEN BEGIN 07568000 - STEPIT; 07569000 - IF SIMPGO 07570000 - THEN BEGIN 07571000 - GOGEN(ELBAT[I],BFC); GOGEN(T1,BFW); 07572000 - STEPIT; GO TO EXIT END ELSE BEGIN EMITLNG;GOGEN(T1,BFC); 07573000 - STMT ; GO TO EXIT END END ; 07574000 - EMITLNG; GOGEN(T1,BFC); 07575000 - GO EXIT END; 07576000 - T1 ~ BUMPL; STMT; 07577000 - IF ELCLASS ! ELSEV THEN 07578000 - BEGIN DIALA ~ DIALB ~ 0; EMITB(BFC,T1,L); GO EXIT END; 07579000 - 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 07598100 - % WHEN WE GET AROUND TO THE XREF. 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); 07619000 - EMITNUM(0&CARDNUMBER[1:4:44]); 07619100 - EMITV(GNAT(PRINTI)); 07620000 - END; 07621000 - IF RR1~ADDITIONAL.DUMPEE ! 0 07622000 - THEN BEGIN COMMENT EMIT CODE TO INCREMENT THE 07623000 - LABEL COUNTER; 07624000 - EMITV(RR1); EMITL(1); EMITO(ADD); 07625000 - EMITPAIR (RR1,STD); 07626000 - IF RR1~ADDITIONAL.DUMPOR ! 0 07627000 - THEN BEGIN COMMENT EMIT CODE TO CALL 07628000 - THE DUMP ROUTINE; 07629000 - 07630000 - 07631000 - 07632000 - STUFFF(RR1); EMITO07633000 - (XCH);EMITO(COC); 07634000 - 07635000 - 07636000 - 07637000 - 07638000 - 07639000 - 07640000 - EMITO(DEL); 07641000 - END; 07642000 - END; 07643000 - END; 07644000 - ROUND: ERRORTOG ~ TRUE END UNTIL STEPI ! LABELID; 07645000 - EXIT: END LABELR; 07646000 -PROCEDURE CASESTMT; 07646100 -BEGIN COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 07646110 - CASE 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(2|REAL(BUILDLINE)) ; 07646635 - TEMP := SGNO; IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07646640 - SGNO ~ SGAVL; 07646650 - Z ~ PROGDESCBLDR(LDES, 0, PRT); 07646660 - SEGMENT(-N, SGNO, TEMP); 07646670 - SGAVL ~ SGAVL + 1; SGNO ~ TEMP; 07646680 - BUILDLINE ~ BUILDLINE.[46:1] ; 07646685 - MOVECODE(TEDOC, EDOC); 07646690 - COMMENT FIX UP BRANCHES TO RESUME POINT; 07646700 - IF (L-ADR)>1019 THEN ADJUST;% 07646705 - WHILE LINK ! 0 DO 07646710 - BEGIN TEMP ~ GET(LINK-2); 07646720 - EMITB(BFW, LINK, L); 07646730 - LINK ~ TEMP; 07646740 - IF LASTENTRY } 126 THEN 07646750 - BEGIN REAL C; 07646760 - COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 07646770 - C ~ BUMPL; 07646780 - CONSTANTCLEAN; 07646790 - EMITB(BFW, C, L); 07646800 - END; 07646810 - END; 07646820 -XIT: 07646830 -END CASESTMT; 07646840 -COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 07647000 - IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 07647500 - THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 07648000 - THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 07648500 - NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 07649000 - RESIDES ON THE DISK AND IS READ INTO THE ROW DESIGNATED 07649500 - BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 07650000 - EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 07650500 - ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 07651000 - NUMBERS LOOK LIKE IDENITIFERS TO FILLSTMT AND ARE CONVERTED 07651500 - BY OCTIZE.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN 07652000 - PDPRT TO SUPPLY INFO TO BUILD A DISK DESCRIPTOR IN THE 07652500 - SEGMENT DICTIONARY.THE COMMUNICATE LITERAL IS 7; 07653000 -PROCEDURE FILLSTMT; 07653500 - BEGIN 07654000 - LABEL EXIT; 07654500 - DEFINE PARENCOUNTER = RR1#, 07655000 - T = RR2#, 07655500 - J = RR3#; 07656000 - ARRAY TEDOC[0:7,0:127], FILLTEMP[0:1022]; 07656500 - BOOLEAN PROCEDURE FILLIT(A); ARRAY A[0]; 07657000 - BEGIN 07657500 - REAL T1, T2, T3; 07658000 - BOOLEAN BOO; 07658500 - LABEL CHECK, GOOFUP, EXIT; 07659000 - PARENCOUNTER:=PARENCOUNTER+1; 07659500 - WHILE T<1023 DO 07660000 - BEGIN 07660500 - IF STEPI>IDMAX THEN 07661000 - BEGIN 07661500 - IF ELCLASS=LITNO THEN 07662000 - IF TABLE(I+1)=LEFTPAREN THEN 07662500 - BEGIN 07663000 - T1:=ELBAT[I].ADDRESS; T2:=T; 07663500 - STEPIT; IF FILLIT(A) THEN GO GOOFUP; 07664000 - IF T1=0 THEN T:=T2 07664500 - ELSE BEGIN 07665000 - IF (T3:=(T1-1)|(T-T2))+T>1022 THEN 07665500 - BEGIN ERROR(305); GO GOOFUP END;%>102307666000 - MOVE(T3,A[T2],A[T]); T:=T+T3; 07666500 - END; 07667000 - GO CHECK; 07667500 - END REPEAT PART; 07668000 - IF (BOO:=ELCLASS=ADOP) THEN STEPIT; 07668500 - IF ELCLASS!LITNO AND ELCLASS!NONLITNO THEN 07669000 - IF 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 07687600 - IF ELCLASS!WITHV THEN 07688000 - BEGIN ERROR(301); GO EXIT END; % MISSING "WITH". 07688500 - STREAMTOG:=TRUE; 07689000 - IF TABLE(I+1){IDMAX THEN 07689500 - IF Q="7INQUI" THEN 07690000 - BEGIN 07690500 - STREAMTOG:=FALSE; I:=I+1; STEPIT; 07691000 - EMITPAIR(9,COM); EMITO(DEL); 07691500 - GO EXIT; 07692000 - END; 07692500 - EMITNUM(SGAVL); EMITPAIR(7,COM); EMITO(DEL); EMITO(DEL); 07693000 - IF LISTER OR SEGSTOG THEN SEGMENTSTART; 07693500 - MOVECODE(TEDOC,EDOC); PARENCOUNTER:=T:=0; 07694000 - BUILDLINE:=BOOLEAN(2|REAL(BUILDLINE)) ; 07694500 - IF FILLIT(FILLTEMP) THEN % DO NOTHING. 07695000 - ELSE IF PARENCOUNTER!1 THEN ERROR(306) % ODD # OF PARENS. 07695500 - ELSE BEGIN 07696000 - FOR J:=0 STEP 32 UNTIL T DO 07696500 - MOVE(32,FILLTEMP[J],EDOC[J.[38:3],J.[41:7]]); 07697000 - SEGMENT(T,SGAVL,SGNO); 07697500 - END; 07698000 - MOVECODE(TEDOC,EDOC); STREAMTOG:=FALSE; 07698500 - BUILDLINE:=BUILDLINE.[46:1] ; SGAVL:=SGAVL+1; 07699000 -EXIT: 07699500 - END FILLSTMT; 07700000 - COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 07710000 - CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 07711000 - WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 07712000 - AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 07713000 - PROCEDURE STMT ; 07714000 - BEGIN 07715000 - LABEL AGAIN,LERR,LDEC,LPROC,LSPROC,LVAR,LAB,LREAD,LWRITE, 07716000 - LSPACE,LCLOSE,LLOCK,LRWND,LDBL,LFOR,LWHILE,LDO,LFILL,LIF, 07717000 - LGO, LRELSE, LBEG, LBRK, EXIT; 07718000 - SWITCH S ~ 07719000 - LPROC, LERR, LSPROC,LERR, LERR, LERR, LERR, 07720000 - LPROC, LPROC, LPROC, LPROC, LVAR, LVAR, LVAR, 07721000 -LVAR, 07722000 - LVAR, LVAR, LVAR, LVAR, LAB, LERR, LERR, 07723000 - LERR, LERR, LERR, LDEC, LREAD, LWRITE,LSPACE, 07724000 - LCLOSE,LLOCK, LRWND, LDBL, LFOR, LWHILE,LDO, 07725000 - EXIT, EXIT, EXIT, LFILL, EXIT, LIF, LGO, 07726000 - LRELSE,LBEG; 07727000 - COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 07727010 - CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 07727020 - GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 07727030 - ADDRESSING IS NOT POSSIBLE; 07727040 - IF LASTENTRY !0 THEN 07727050 - BEGIN GT2 ~ INFO [0,255]; 07727055 - DO GT1 ~ GT2 UNTIL GT2~GET(GT1) = 4095; 07727060 - IF L- GT1 > 400 THEN 07727065 - BEGIN GT1 ~ BUMPL; 07727070 - CONSTANTCLEAN; 07727075 - EMITB(BFW, GT1,L); 07727080 - END; 07727085 - END; 07727090 - STACKCT ~ 0; 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 = "3ZIP00" THEN 07811000 - BEGIN IF TABLE(I+1) = WITHV THEN 07812000 - BEGIN STEPIT; 07813000 - IF STEPI < BOOARRAYID OR ELCLASS > 07814000 - INTARRAYID THEN 07814100 - IF ELCLASS=FILEID OR 07814200 - ELCLASS=SUPERFILEID THEN 07814300 - PASSFILE ELSE 07814400 - GO E ELSE 07814500 - BEGIN 07814600 - VARIABLE(FL); 07815000 - IF TABLE(I-2) ! FACTOP THEN GO TO E; 07816000 - END; 07816100 - EMIT(16); EMITO(COM); EMITO(DEL); 07817000 - GO TO XXX; 07818000 - END; 07819000 - N ~ 1; C ~ 8 07820000 - END ELSE 07821000 - IF Q = "5CHAIN" THEN 07821100 - BEGIN N ~ 1; C ~ 37 END ELSE 07821200 - IF Q = "4WHEN0" THEN 07822000 - BEGIN N ~ 0; C ~ 6 END ELSE 07823000 - IF Q = "4WAIT0" THEN 07824000 - BEGIN N ~ 1; C ~ 2 END ELSE 07825000 - IF Q = "4CASE0" THEN BEGIN CASESTMT; GO TO XXX END ELSE 07825500 - IF Q = "4SORT0" THEN BEGIN SORTSTMT; GO XXX END ELSE 07826000 - IF Q = "5MERGE" THEN BEGIN MERGESTMT; GO XXX END ELSE 07827000 - IF Q = "6SEARC" THEN 07828000 - BEGIN IF STEPI!LEFTPAREN THEN 07829000 - BEGIN ERR(105); GO TO XXX END; 07830000 - IF STEPI=FILEID OR ELCLASS=SUPERFILEID THEN 07831000 - PASSFILE ELSE GO TO E; 07832000 - IF ELCLASS!COMMA THEN GO TO E; 07833000 - IF STEPIINTARRAYID THEN 07834000 - GO TO E; 07835000 - XMARK(ASSIGNREF); % SEARCH STATEMENT 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 - END SIMPLE; 08038100120324PK - COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 08040000 - PROCEDURE TEST; 08041000 - BEGIN 08042000 - IF NOT CONSTANB THEN 08043000 - BEGIN EMITO(SUB); IF SIMPLEB THEN EMITV(B.ADDRESS) 08044000 - ELSE BEGIN 08045000 - EMITL(2+L-BRET); 08046000 - EMITB(BBW,BUMPL,B); 08047000 - END; 08048000 - EMITO(MUL); EMIT(0) END; 08049000 - EMITO(IF SIGNB THEN GEQ ELSE LEQ); EMIT (0); L~L-1 08050000 - END TEST; 08051000 - BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 08052000 - BEGIN 08053000 - CHECKER(VRET~ALL); 08054000 - ADDRES ~ ALL.ADDRESS; 08055000 - FORMALV ~ ALL.[9:2] = 2; 08056000 - IF T ~ ALL.CLASS > INTARRAYID OR T < BOOID OR 08057000 - GT1 ~ (T-BOOID) MOD 4 < 1 THEN 08058000 - ERR(REAL(T ! 0) | 51 + 100); 08059000 - INT ~ GT1 = 3; 08060000 - SIMPI ~ T { INTID END SIMPI; 08061000 - COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 08062000 - PROCEDURE STORE(S); VALUE S; BOOLEAN S; 08063000 - BEGIN 08064000 - IF FORMALV THEN BEGIN EMITO(XCH); S ~ FALSE END 08065000 - ELSE BEGIN 08066000 - EMITL(ADDRES); 08067000 - IF ADDRES > 1023 THEN EMITO(PRTE) END; 08068000 - T ~ (REAL(S)+1)|16; 08069000 - EMITO((IF INT THEN T+512 ELSE 4|T)+4) END STORE; 08070000 - COMMENT CALL EFFECTS A CALL ON THE INDEX; 08071000 - PROCEDURE CALL(S); VALUE S; BOOLEAN S; 08072000 - BEGIN 08073000 - IF SIMPLEV 08074000 - THEN IF S THEN EMITV(ADDRES) ELSE EMITN(ADDRES) 08075000 - ELSE BEGIN 08076000 - EMITL(2+L-VRET); 08077000 - EMITB(BBW,BUMPL,V); 08078000 - IF S THEN EMITO(LOD) END END CALL; 08079000 - PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 08080000 - BEGIN 08081000 - PROCEDURE FIX(STORE,BACK,FORWART,START); 08082000 - VALUE STORE,BACK,FORWART,START; 08083000 - REAL STORE,BACK,FORWART,START; 08084000 - BEGIN 08085000 - EMITB(GET(FORWART-1),FORWART,START); 08086000 - IF RETURNSTORE ! 0 08087000 - THEN BEGIN 08088000 - L ~ STORE; EMITNUM(B-BACK); 08089000 - EMITPAIR(RETURNSTORE,STD) END END FIX; 08090000 - INTEGER BACKFIX, FORWARDBRANCH, FOOT, STOREFIX; 08091000 - LABEL BRNCH,EXIT; 08092000 - STOREFIX ~ L; Q ~ REAL(MODE=0)+3; 08093000 - FOR K ~ 1 STEP 1 UNTIL Q DO EMITO(NOP); 08094000 - IF NUMLE 08095000 - THEN BEGIN 08096000 - BACKFIX ~ L; 08097000 - IF FORMALV THEN CALL(DESC) END 08098000 - ELSE BACKFIX ~ V + REAL(SIMPLEV)-1; 08099000 - DIALA + DIALB ~ 0; 08100000 - AEXP; DIALA ~ DIALB ~ 0; 08101000 - COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 08102000 - IF ELCLASS = STEPV 08103000 - THEN BEGIN 08104000 - COMMENT HERE WE HAVE A STEP ELEMENT; 08105000 - BACKFIX ~ BUMPL; 08106000 - COMMENT LEAVE ROOM FOR FORWARD JUMP; 08107000 - IF FORMALV THEN CALL(DESC); CALL(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)|32+ADD); 08126000 - EMITB(BFW,BACKFIX,L); 08127000 - IF ELCLASS = UNTILV 08128000 - THEN BEGIN COMMENT STEP-UNTIL ELEMENT; 08129000 - STORE(TRUE); IF FORMALV THEN CALL(OPDC); 08130000 - STEPIT; AEXP; TEST END 08131000 - ELSE BEGIN COMMENT STEP-WHILE ELEMENT; 08132000 - IF ELCLASS ! WHILEV THEN 08133000 - BEGIN ERR(153); GO TO EXIT END; 08134000 - STEPIT; STORE(FALSE); BEXP END END 08135000 - ELSE BEGIN 08136000 - COMMENT WE DO NOT HAVE A STEP ELEMENT; 08137000 - STORE(FALSE); 08138000 - IF ELCLASS = WHILEV 08139000 - THEN BEGIN 08140000 - COMMENT WE HAVE A WHILE ELEMENT; 08141000 - STEPIT; BEXP END 08142000 - ELSE BEGIN 08143000 - COMMENT ONE EXPRESSION ELEMENT; 08144000 - IF ELCLASS ! COMMA THEN BEGIN 08145000 - EMITB(BFW,BUMPL,L+2); BACKFIX ~ L END 08146000 - ELSE BACKFIX ~ L + 2; 08147000 - L ~ L+1; EMIT(BFW); GO TO BRNCH END END; 08148000 - COMMENT THIS IS THE COMMON POINT; 08149000 - IF ELCLASS = COMMA THEN EMITLNG; L ~ L+1; 08150000 - EMIT(BFC); 08151000 - BRNCH: FORWARDBRANCH ~ L; DIALA ~ DIALB ~ 0; 08152000 - IF ELCLASS = COMMA 08153000 - THEN BEGIN 08154000 - STEPIT; 08155000 - FORLIST(TRUE); 08156000 - FIX(STOREFIX,BACKFIX,FORWARDBRANCH,STMTSTART) END 08157000 - ELSE BEGIN 08158000 - IF ELCLASS ! DOV 08159000 - THEN BEGIN ERR(154); REGO~L; GO EXIT END; 08160000 - STEPIT; 08161000 - IF NUMLE THEN FOOT := GETSPACE(FALSE,-1); % TEMP. 08162000 - IF LISTMODE THEN LISTELEMENT ELSE STMT; 08163000 - 08164000 - IF NUMLE THEN BEGIN 08165000 - EMITV(RETURNSTORE + FOOT); EMITO(BBW) END 08166000 - ELSE BEGIN 08167000 - EMITB(BBW,BUMPL,BACKFIX); RETURNSTORE ~ 0 END; 08168000 - STMTSTART ~ FORWARDBRANCH; B ~ L; 08169000 - CONSTANTCLEAN; REGO ~ L; 08170000 - FIX(STOREFIX,BACKFIX,FORWARDBRANCH,L) END; 08171000 - EXIT: END FORLIST; 08172000 - REAL T1,T2,T3,T4; 08173000 - NXTELBT ~ 1; I ~ 0; 08174000 - STEPIT; 08175000 - IF SIMPI(VRET~ELBAT[I]) 08176000 - THEN BEGIN 08177000 - IF STEPI ! ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08178000 - XMARK(ASSIGNREF); % FOR STATEMENT 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 | RETURNSTORE+STMTSTART)|2+ 08193000 - REAL(CONSTANB))|2+ 08194000 - REAL(CONSTANC))|2+ 08195000 - REAL(SIGNB))|2+ 08196000 - REAL(SIGNC); 08197000 - T2 ~ VRET; 08198000 - T3 ~ B; 08199000 - T4 ~ Q; 08200000 - IF LISTMODE THEN LISTELEMENT ELSE STMT; 08201000 - SIGNC ~ BOOLEAN(T1.[47:1]); 08202000 - SIGNB ~ BOOLEAN(T1.[46:1]); 08203000 - CONSTANC ~ BOOLEAN(T1.[45:1]); 08204000 - CONSTANB ~ BOOLEAN(T1.[44:1]); 08205000 - STMTSTART ~ T1.[32:12]; 08206000 - RETURNSTORE ~ T1.[20:12]; 08207000 - VRET ~ T2; 08208000 - B ~ T3; 08209000 - Q ~ T4; 08210000 - SIMPLEV~ SIMPI(VRET); 08211000 - IF FORMALV THEN EMITN(ADDRES); EMITV(ADDRES); 08212000 - PLUG(CONSTANB,B); 08213000 - EMITO(IF SIGNB THEN SUB ELSE ADD); 08214000 - EMITB(BFW,RETURNSTORE,L); 08215000 - STORE(TRUE); 08216000 - IF FORMALV THEN CALL(OPDC); 08217000 - PLUG(CONSTANC,Q); 08218000 - IF SIGNC THEN EMITO(CHS); 08219000 - SIMPLEB ~ TRUE; TEST; EMITLNG; 08220000 - EMITB(BBC,BUMPL,STMTSTART); 08221000 - GO TO EXIT END; 08222000 - I ~ 2; K ~ 0; 08223000 - SIMPLEV ~ SIMPI(VRET); 08224000 - V ~ T1 END 08225000 - ELSE BEGIN 08226000 - EMIT(0); V ~ L; SIMPLEV ~ FALSE; FORMALV ~ TRUE; 08227000 - VARIABLE(FR); EMITO(XCH); VRET ~ L; EMITO(BFW); 08228000 - IF ELCLASS!ASSIGNOP THEN BEGIN ERR(152); GO EXIT END;08229000 - END; 08230000 - STEPIT; FORLIST(FALSE); L ~ REGO; 08231000 - EXIT: K ~ 0 END FORSTMT; 08232000 -PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08233000 - BEGIN COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 08234000 - SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 08235000 - LABEL PASSPARLABL; COMMENT WHEN I REACH THIS LABEL A 08236000 - COLON HAS JUST BEEN DETECTED; 08237000 - LABEL EXIT; COMMENT THE LABEL EXIT APPEARS AFTER THE LAST08238000 - EXECUTABLE STATEMENT IN THIS ROUTINE; 08239000 - IF STEPI = LFTBRKET 08240000 - THEN BEGIN COMMENT THIS CODE HANDLES PARITY AND END OF 08241000 - FILE LABELS; 08242000 - IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08243000 - IF ELCLASS ! COLON THEN EMIT(0) ELSE 08244000 - BEGIN STEPIT; DEXP END; 08245000 - 08246000 - 08247000 - 08248000 - 08249000 - 08250000 - 08251000 - 08252000 - 08253000 - 08254000 - 08255000 - 08256000 - 08257000 - 08258000 - 08259000 - 08260000 - 08261000 - 08262000 - 08263000 - 08264000 - 08265000 - 08266000 - 08267000 - 08268000 - 08269000 - 08270000 - 08271000 - 08272000 - 08273000 - 08274000 - 08275000 - 08276000 - IF CHECK(RTBRKET,433) 08277000 - THEN GO TO EXIT; 08278000 - COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 08279000 - IN READ OR SPACE STATEMENT; 08280000 - STEPIT; 08281000 - END 08282000 - ELSE BEGIN COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS08283000 - CASE; 08284000 - EMITL(0); EMITL(0); 08285000 - END; 08286000 - IF GOGOGO THEN BEGIN EMIT(0); EMIT(0); EMIT(0); 08287000 - EMITV(13) 08287100 - END ELSE EMITV(GNAT(INTERPTI)); 08287200 - GOGOGO ~ FALSE;% 08287300 - EXIT:; 08288000 - END HANDLETHETAILENDORAREADORSPACESTATEMENT; 08289000 - DEFINE EMITNO(EMITNO1)=BEGIN EMITL(0); EMITL(EMITNO1)END#,08289010 - EMITTIME=BEGIN EMITN(2); EMITO(259); AEXP ; 08289020 - EMITPAIR(JUNK,ISN); EMITO(965) END#;08289030 -PROCEDURE READSTMT; 08290000 - BEGIN COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS08291000 - SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 08292000 - DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF08293000 - THE READ OR SPACE STATEMENT. 08294000 - THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ08295000 - STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 08296000 - REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 08297000 - EXPRESSION IN THE SPACE STATEMENT. 08298000 - I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08299000 - READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 08300000 - ARE PASSED TO INTERPTI. 08301000 - **********************************************************08302000 - ::=REVERSE/ 08303000 - ::=/ 08304000 - ::=[NO]/ 08305000 - ::=[:]/ 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]="2NO000" THEN 1 ELSE 08412010 - IF ACCUM[1]="4STOP0" THEN 2 ELSE 08412020 - 0 ! 0 THEN %%% HAVE [NS 08412030 - IF STEPI=COMMA THEN %%% HAVE [NS, 08412040 - IF STEPI=FACTOP THEN %%% HAVE [NS,* 08412050 - BEGIN 08412060 - IF RR1=1 THEN EMITNO(1) 08412070 - ELSE BEGIN EMITL(1); EMITL(2) END ; 08412080 - STEPIT ; 08412090 - END 08413000 - ELSE 08413010 - IF ACCUM[1]="4LOCK0" THEN 08413012 - BEGIN %%% [NS,LOCK 08413014 - EMITL(1); EMITD(47,4,1); 08413016 - STEPIT; 08413018 - END ELSE 08413020 - BEGIN %%% HAVE [NS,AEXP 08413022 - IF RR1=2 THEN EMITL(1) ; 08413030 - EMITTIME ; 08413040 - IF RR1=2 THEN 08413050 - BEGIN EMITO(LOR); EMITL(2) END 08413060 - ELSE EMITL(1) ; 08413080 - END 08413090 - ELSE IF RR1=1 THEN EMITNO(1) %%% ONLY HAVE [NS 08413100 - ELSE BEGIN EMITL(1); EMITL(2) END 08413110 - ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08413120 - IF STEPI=COMMA THEN %%% HAVE [*, 08413130 - IF STEPI=FACTOP THEN %%% HAVE [*,* 08414000 - BEGIN EMITNO(2); STEPIT END 08414010 - ELSE IF ACCUM[1]="4LOCK0" THEN 08414012 - BEGIN %%% [*,LOCK 08414014 - EMITL(1); EMITD(47,4,1); 08414016 - STEPIT; 08414018 - END ELSE 08414020 - BEGIN EMITTIME; EMITL(2); END % [*,A 08414022 - ELSE EMITNO(2) %%% HAVE ONLY [* 08414030 - ELSE BEGIN %%% HAVE [AEXP 08415000 - AEXP;EMITO(SSP);EMITL(1);EMITO(ADD); 08415010 - IF SEEKTOG THEN EMITO(CHS) ; 08415020 - EMITPAIR(JUNK,ISN) ; 08415030 - IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08416000 - IF STEPI=FACTOP THEN STEPIT %%%[AEXP,* 08416010 - ELSE IF ACCUM[1]="4LOCK0" THEN 08416012 - BEGIN %%% [AEXP,LOCK 08416014 - EMITL(1); EMITD(47,4,1); 08416016 - STEPIT; 08416018 - END ELSE 08416020 - BEGIN EMITTIME; EMITO(LOR) END ; 08416022 - EMITL(2) ; %%% ABOVE ELSE WAS [AEXP,AEXP 08416030 - END ; 08417000 - IF CHECK(RTBRKET,424) THEN GO EXIT ELSE STEPIT ; 08417010 - END 08418000 - ELSE IF ELCLASS=LEFTPAREN THEN 08418100 - BEGIN STEPIT; AEXP; IF ELCLASS=COMMA THEN 08418200 - IF STEPI!FACTOP THEN% 08418250 - BEGIN AEXP; EMITPAIR(JUNK,ISN) END ELSE% 08418300 - BEGIN EMITL(1); GRABTOG~TRUE; STEPIT END ELSE 08418350 - EMITPAIR(0,LNG); 08418400 - EMITD(33,33,15); 08418500 - EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08418600 - EMITL(REAL(SEEKTOG)); EMITD(33,18,15); 08418650 - IF CHECK(RTPAREN,104) THEN GO EXIT; 08418700 - EMITL(REAL(GRABTOG)+2); STEPIT;% 08418800 - END 08418900 - ELSE BEGIN EMITL(0); EMITL(2); END; 08419000 - IF REVERSETOG 08420000 - THEN EMITO(CHS); 08421000 - END; 08421500 - IF ELCLASS = RTPAREN 08422000 - THEN BEGIN COMMENT NO FORMAT,NO LIST CASE; 08423000 - EMITL(0); EMITL(0); EMITL(0); 08424000 - GOGOGO ~ NOT MAYI;% 08424100 - GO CHKACTIONLABELS; 08425000 - END; 08426000 - IF CHECK(COMMA,424) 08427000 - THEN GO TO EXIT; 08428000 - COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 08429000 - STATEMENT; 08430000 - IF STEPI = FACTOP 08431000 - THEN BEGIN COMMENT *,LIST CASE; 08432000 - EMITL(0); EMITL(0); GO PASSLIST; 08433000 - END; 08434000 - IF ELCLASS = MULOP 08435000 - THEN BEGIN COMMENT FREE FIELD FORMAT CASE; 08436000 - IF STEPI=MULOP THEN EMITL(2) ELSE 08437000 - BEGIN EMITL(1); I~I-1; END ; 08437050 - EMITL(0); GO TO PASSLIST ; 08437075 - END; 08438000 - IF RANGE(FRMTID,SUPERFRMTID) 08439000 - THEN BEGIN COMMENT THE SECOND PARAMETER IS A FORMAT; 08440000 - PASSFORMAT; 08441000 -READXFORM: IF TABLE(I+1) = COMMA 08442000 - THEN GO PASSLIST; 08443000 - STEPIT; 08444000 - IF CHECK(RTPAREN,425) 08445000 - THEN GO TO EXIT; 08446000 - COMMENT ERROR 425 MEANS IMPROPER FORMAT 08447000 - DELIMITER IN READ STATEMENT; 08448000 - EMITL(0); GO CHKACTIONLABELS; 08449000 - END; 08450000 - IF Q:=ACCUM[1]="1<0000" THEN 08450010 - BEGIN EXPLICITFORMAT; GO TO READXFORM; END; 08450020 - IF MAYI THEN 08450100 - BEGIN KLUDGE(HOLD); 08450200 - GO TO EXIT; 08450300 - END ARRAY TO ARRAY CASE; 08450400 - EMITL(0); AEXP; 08451000 - IF CHECK(COMMA,426) 08452000 - THEN GO TO EXIT; 08453000 - COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 08454000 - PARAMETER; 08455000 - STEPIT; 08456000 - IF RANGE(BOOARRAYID,INTARRAYID) 08457000 - THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08458000 - VARIABLE(FL); 08459000 - IF TABLE(I-2) ! FACTOP 08460000 - THEN BEGIN COMMENT ERROR 427 MEANS IMPROPER 08461000 - ROW DESIGNATOR IN READ; 08462000 - ERROR(427); GO TO EXIT; 08463000 - END; 08464000 - IF CHECK(RTPAREN,428) 08465000 - THEN GO TO EXIT; 08466000 - COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR08467000 - DELIMITER IN READ STATEMENT; 08468000 - GOGOGO ~ TRUE;% 08468100 - GO CHKACTIONLABELS; 08469000 - END 08470000 - ELSE BEGIN COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;08471000 - ERROR(429); GO TO EXIT; 08472000 - END; 08473000 - PASSLIST:STEPIT; 08474000 - IF CHECK(COMMA,430) 08475000 - THEN GO TO EXIT; 08476000 - COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 08477000 - THE LIST IN A READ STATEMENT; 08478000 - IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08479000 - THEN BEGIN 08480000 - RR1~LISTGEN; 08481000 - I~I-1; 08482000 - GO TO CHKACTIONLABELS 08483000 - END; 08484000 - CHECKER(ELBAT[I]); 08484500 - IF ELCLASS = SUPERLISTID THEN 08485000 - BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08486000 - LISTADDRESS ~ELBAT[I].ADDRESS; 08488000 - BANA; 08489000 - EMITV(LISTADDRESS); 08489500 - IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08489510 - EMITO(LOD); I~I-1 END 08489520 - ELSE BEGIN COMMENT A COMMON LIST; 08489530 - EMITPAIR (ELBAT[I].ADDRESS,LOD); 08489550 - END; 08489560 - STEPIT; 08489570 - IF CHECK(RTPAREN,449) THEN GO TO EXIT; 08489580 - COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 08489590 - 08490000 -CHKACTIONLABELS:HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08491000 - EXIT:; 08492000 - END READSTMT; 08493000 -REAL PROCEDURE FILEATTRIBUTEINDX(T) ; % RETURNS A ZERO IF THE NEXTSCANND08493010 -VALUE T; BOOLEAN T ; % ITEM IS NOT A FILE ATTRIBUTE. 08493015 - BEGIN % RETURNS THE ASSOCIATED INDEX IF 08493020 - REAL I ; % IT IS A FILE ATTRIBUTE. 08493030 - LABEL EXIT ; 08493040 - STOPDEFINE~T ; % MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 08493050 - STEPIT ; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 08493060 - IF I~FILEATTRIBUTES[0]=0 THEN 08493070 - BEGIN 08493080 -$RESET NEATUP 08493085120324PK - FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=108493090 - % BOOLEAN ATTRIBUTES HAVE .[2:1]=1,08493091 - % ALPHA ATTRIBUTES HAVE .[3:1]=1. 08493092 - % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 08493093 - 17 08493094 - ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***08493095 - ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******08493096 - ,"4SAVE0" 08493097 - ,"8OTHER" % "OTHERUSE". 08493098 - ,"404MFID0" 08493099 - ,"403FID00" 08493100 - ,"4REEL0" 08493101 - ,"4DATE0" 08493102 - ,"5CYCLE" 08493103 - ,"4TYPE0" 08493104 - ,"5AREAS" 08493105 - ,"8AREAS" % "AREASIZE". 08493106 - ,"2EU000" 08493107 - ,"5SPEED" 08493108 - ,"9TIMEL" % "TIMELIMIT" 08493109 - ,"+08IOSTA" % "IOSTATUS" 08493110 - ,"9SENSI" % "SENSITIVE" 08493111 - % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 08493120 - ; % END OF FILL STATEMENT. 08493130 -$SET NEATUP 08493135120324PK - I~FILEATTRIBUTES[0] ; 08493140 - END ; 08493150 - FOR I~I STEP -1 UNTIL 1 DO IF FILEATTRIBUTES[I].[12:36]=Q THEN 08493160 - BEGIN FILEATTRIBUTEINDX~I; GO EXIT END ; 08493170 - EXIT: 08493180 - END OF FILEATTRIBUTEINDX ; 08493190 -COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS08493200 - A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:08493210 - 1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 08493220 - FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE08493230 - AND XIT. 08493240 - 2. ACTUALPARAPART: 08493250 - PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 08493260 - ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 08493270 - THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 08493280 - 3. PRIMARY: 08493290 - PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 08493300 - IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 08493310 - ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF08493320 - THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 08493330 - TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 08493340 - IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 08493350 - ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 08493360 - ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 08493370 - FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 08493380 - (ATYPE OR BTYPE). 08493390 - 4. BOOPRIM: 08493400 - PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 08493410 - 5. IODEC: 08493420 - PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 08493430 - HAVE ALREADY BEEN EMITTED, THE ATTRIBUTEINDX IS 08493440 - DETERMINED BY IODEC, AND IS PASSED VIA GT1. 08493450 -END OF COMMENT ; 08493460 -INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); VALUE N; REAL N ; 08493470 - BEGIN 08493480 - REAL ATTRIBUTEINDX ; 08493490 - BOOLEAN ASSOP ; 08493500 - LABEL DONESOME,DONEMORE,EXIT ; 08493510 - IF N=FA THEN GO TO DONESOME ELSE IF N=FIO THEN 08493520 - BEGIN ATTRIBUTEINDX~GT1; IF STEPI!RELOP THEN I~I-1; ASSOP~TRUE;08493530 - EMITL(0); EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.08493540 - GO TO DONEMORE ; 08493550 - END ; 08493560 - EMITO(MKS); PASSFILE ; % MARK THE STACK & STACK A FILE DESCRIPTOR. 08493570 - IF ELCLASS!PERIOD THEN ERR(290) ELSE 08493580 - BEGIN 08493590 - DONESOME: 08493600 - IF ATTRIBUTEINDX~FILEATTRIBUTEINDX(TRUE)=0 THEN ERR(291) ELSE 08493610 - BEGIN 08493620 -STEPIT;IF FALSE THEN BEGIN COMMENT$$DELETE THIS CARD TO GET ACTION LABEL08493625 - IF STEPI=LFTBRKET THEN 08493630 - BEGIN 08493640 - STEPIT;DEXP;IF CHECK(RTBRKET,433)THEN GO EXIT;STEPIT;08493650 - END 08493660 - ELSE EMITL(0) ; 08493670 - EMITL(0) ; %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 08493675 - IF ASSOP~ELCLASS=ASSIGNOP THEN 08493680 - BEGIN 08493700 -IF N!FS THEN FLAG(295);%**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT08493705 - DONEMORE: IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) 08493710 - THEN FLAG(293) ; 08493720 - STEPIT ; 08493730 - IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493740 - THEN BEXP ELSE AEXP ; 08493750 - END 08493760 - ELSE IF N=FS THEN BEGIN ERR(292); GO EXIT END 08493770 - ELSE EMITL(0) ; 08493780 - EMITNUM(IF ATTRIBUTEINDX= 1 THEN "6ACCESS" ELSE 08493790 - IF ATTRIBUTEINDX= 4 THEN "6OTHRUS" ELSE 08493795 - IF ATTRIBUTEINDX=12 THEN "6ARASIZ" ELSE 08493800 - IF ATTRIBUTEINDX=15 THEN "6TIMLMT" ELSE 08493805 - IF ATTRIBUTEINDX=16 THEN "6IOSTAT" ELSE 08493810 - IF ATTRIBUTEINDX=17 THEN "6SNSTIV" ELSE 08493812 - 0 & FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] 08493820 - & FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]) ; 08493830 - EMITL((ATTRIBUTEINDX-1) & REAL(N=FP OR N=FA)[39:47:1] 08493840 - & REAL(ASSOP)[38:47:1]) ; 08493850 - EMITPAIR(GNAT(POWERSOFTEN),LOD); EMITV(GNAT(FILATTINT)) ;08493860 - FILEATTRIBUTEHANDLER~ 08493870 - IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) 08493880 - THEN BTYPE ELSE ATYPE ; 08493890 - END ; 08493900 - END ; 08493910 - EXIT: 08493920 - END OF FILEATTRIBUTEHANDLER ; 08493930 -PROCEDURE SPACESTMT; 08494000 - BEGIN COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 08495000 - SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 08496000 - FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 08497000 - PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS08498000 - FOR THE READ STATEMENT; 08499000 - LABEL EXIT; COMMENT EXIT APPEARS AFTER THE LAST 08500000 - EXECUTABLE STATEMENT IN SPACESTMT; 08501000 - STEPIT; 08502000 - IF CHECK(LEFTPAREN,434) 08503000 - THEN GO TO EXIT; 08504000 - COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 08505000 - SPACE STATEMENT; 08506000 - STEPIT; 08507000 - IF NOT RANGE(FILEID,SUPERFILEID) 08508000 - THEN BEGIN COMMENT ERROR 435 MEANS IMPROPER FILE 08509000 - IDENTIFIER IN SPACE STATEMENT; 08510000 - ERROR(435); GO TO EXIT; 08511000 - END; 08512000 - EMITO(MKS); 08513000 - EMITPAIR(GNAT( 08514000 - POWERSOFTEN),LOD); PASSFILE; 08515000 - EMITL(0); 08515100 - IF CHECK(COMMA,436) 08516000 - THEN GO TO EXIT; 08517000 - COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;08518000 - STEPIT; AEXP; 08519000 - IF CHECK(RTPAREN,437) 08520000 - THEN GO TO EXIT; 08521000 - COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 08522000 - SPACE STATEMENT; 08523000 - EMITL(0); EMITL(0); EMITL(1); 08524000 - HANDLETHETAILENDOFAREADORSPACESTATEMENT; 08525000 - EXIT:; 08526000 - END SPACESTMT; 08527000 -PROCEDURE WRITESTMT; 08528000 - BEGIN COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 08529000 - INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 08530000 - DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 08531000 - I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 08532000 - WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH08533000 - ARE PASSED TO INTERPTO. 08534000 - **********************************************************08535000 - FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 08536000 - UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 08537000 - READSTMT ROUTINE. 08538000 - ::= [DBL]/[PAGE]/[NO]// 08540000 - CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR08541000 - 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 ONEPARENSH; COMMENT I IS POINT AT THE RIGHT 08576000 - PARENTHESIS AT THIS POINT AND I HAVE 08577000 - JUST DISCOVERED THAT THIS IS THE ONE 08578000 - PARAMETER CASE; 08579000 - DEFINE ACCUM1 = RR1#; COMMENT ACCUM1 IS USED AS A 08580000 - TEMPORARY CELL FOR ACCUM[1]; 08581000 -%VOID 08582000 -%VOID 08583000 -%VOID 08584000 -%VOID 08585000 - LABEL PASSLIST; COMMENT I IS POINTING AT THE COMMA 08586000 - PRECEEDING THE LIST WHEN THIS LABEL IS 08587000 - REACHED; 08588000 - LABEL EMITCALL; COMMENT I IS POINTING AT THE STATEMENT 08589000 - DELIMITER. THE CODE AT EMITCALL EMITS THE08590000 - CODE TO CALL INTERPTO; 08591000 - LABEL CHKRTPAREN; 08591100 - LABEL WRITXFORM; 08591200 - INTEGER LISTADDRESS; COMMENT TEMP TO HOLD LIST ADD DESC; 08591500 - BOOLEAN LOCKTOG,ARC; 08591600 - INTEGER HOLD;% 08591700 - IF (LOCKTOG~STEPI=LOCKV) THEN STEPIT; 08592000 - IF CHECK(LEFTPAREN,438) 08593000 - THEN GO TO EXIT; 08594000 - COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 08595000 - WRITE STATEMENT; 08596000 - EMITO(MKS); 08597000 - IF STEPI } BOOARRAYID AND ELCLASS { INTARRAYID THEN 08597100 - BEGIN VARIABLE(FL); 08597200 - IF TABLE(I-2) ! FACTOP THEN 08597300 - BEGIN ERR(439); GO TO EXIT END; 08597400 - ARC ~ TRUE; HOLD ~ L; 08597450 - EMIT(11); EMIT(4); EMITO(280); 08597500 - EMITPAIR(GNAT(POWERSOFTEN),LOD); 08597600 - EMITO(XCH); 08597700 - END ELSE 08597800 - BEGIN 08597900 - IF NOT RANGE(FILEID,SUPERFILEID) 08598000 - THEN BEGIN COMMENT ERROR 439 MEANS IMPROPER FILE 08599000 - IDENTIFIER IN A WRITE STATEMENT; 08600000 - ERR(439); GO TO EXIT; 08601000 - END; 08602000 - 08603000 - EMITPAIR(GNAT( 08604000 - POWERSOFTEN),LOD); PASSFILE; 08605000 - END; 08605500 - IF(RRB1~ELCLASS = COMMA) OR ELCLASS = RTPAREN 08606000 - THEN BEGIN COMMENT STANDARD CARRIAGE CONTROL CASE; 08607000 - EMITL(0); EMITL(1); 08608000 - IF RRB1 08609000 - THEN GO CHKSECOND; 08610000 - ONEPARENSH:STEPIT; EMITL(0); EMITL(0); 08611000 - GOGOGO ~ NOT ARC;% 08611100 - EMITL(0); GO EMITCALL; 08612000 - END; 08613000 - IF ELCLASS=LEFTPAREN THEN 08613100 - BEGIN STEPIT; AEXP; EMITO(IF LOCKTOG THEN SSN ELSE SSP); 08613200 - IF ELCLASS=COMMA THEN BEGIN STEPIT; AEXP END ELSE 08613300 - EMITPAIR(0,LNG); 08613400 - EMITD(33,33,15); EMIT(0); 08613500 - IF CHECK(RTPAREN,104) THEN GO EXIT ELSE GO CHKRTPAREN08613600 - END; 08613700 - IF CHECK(LFTBRKET,440) 08614000 - THEN GO TO EXIT; 08615000 - COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 08616000 - PARAMETER IN A WRITE STATEMENT; 08617000 - STEPIT; 08618000 - %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 08619000 - %%% [DPN,],[*],[*,*],[*,],[],[,*] 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 %%% [DPN08620000 - IF STEPI=COMMA THEN %%% HAVE [DPN, 08620010 - IF STEPI=FACTOP THEN %%% HAVE [DPN,* 08620020 - BEGIN EMITNO(ACCUM1); STEPIT END 08621000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [NS,UNLOCK 08621002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08621004 - ELSE BEGIN EMITTIME; EMITL(ACCUM1) END%[DPN,AEXP08621010 - ELSE EMITNO(ACCUM1) %%% HAVE ONLY [DPN 08621020 - ELSE IF ELCLASS=FACTOP THEN %%% HAVE [* 08622000 - IF STEPI=COMMA THEN %%% HAVE [*, 08622010 - IF STEPI=FACTOP THEN %%% HAVE [*,* 08623000 - BEGIN EMITNO(1); STEPIT END 08624000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [*,UNLOCK 08624002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08624004 - ELSE BEGIN EMITTIME; EMITL(1) END %[*,AEXP 08625000 - ELSE EMITNO(1) %%% HAVE ONLY [* 08626000 - ELSE BEGIN AEXP; EMITO(SSP); EMITPAIR(JUNK,ISN); 08627000 - %% HAVE [AEXP 08627100 - IF ELCLASS=COMMA THEN %%% HAVE [AEXP, 08628000 - IF STEPI=FACTOP THEN STEPIT %%%HAVE [AEXP,*08629000 - ELSE IF ACCUM[1]="6UNLOC" THEN %%% [AEXP,UNLOCK 08629002 - BEGIN EMITL(1); EMITD(47,4,1); STEPIT END 08629004 - ELSE BEGIN EMITTIME; EMITO(LOR)END;%[AEXP,A08630000 - EMITL(0) ; %%% 0 IS NO DPN. 08631000 - END ; 08632000 - IF CHECK(RTBRKET,441) 08633000 - THEN GO TO EXIT; 08634000 - COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE08635000 - CONTROL PART; 08636000 - CHKRTPAREN:IF STEPI = RTPAREN 08637000 - THEN GO TO ONEPARENSH; 08638000 - IF CHECK(COMMA,442) 08639000 - THEN GO TO EXIT; 08640000 - COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 08641000 - DELIMITER IN A WRITE STATEMENT; 08642000 - CHKSECOND:STEPIT; 08643000 - IF RANGE(FRMTID,SUPERFRMTID) 08644000 - THEN BEGIN COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 08645000 - PASSFORMAT; 08646000 -WRITXFORM: IF STEPI = RTPAREN 08647000 - THEN BEGIN COMMENT THIS IS THE TWO PARAMETER 08648000 - CASE OF THE WRITE; 08649000 - STEPIT; EMITL(0); GO EMITCALL; 08650000 - END; 08651000 - GO PASSLIST; 08652000 - END; 08653000 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 08653100 - BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD); 08653110 - IF ELCLASS!MULOP THEN ERR(443) 08653120 - ELSE IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653125 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 08653130 - BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653140 - ELSE EMITL(1) ; %%% FREE FIELD = [AEXP]/. 08653150 - GO TO PASSLIST ; 08653160 - END 08653170 - ELSE IF ELCLASS=MULOP THEN %%% FREE FIELD AT LEAST = /. 08653180 - BEGIN EMITL(1) ; 08653190 - IF STEPI=MULOP THEN BEGIN EMITO(SSN); STEPIT END ; 08653195 - IF ELCLASS=LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 08653200 - BEGIN I~I-1; BANA; EMITO(SSP); EMITPAIR(1,ADD) END08653210 - ELSE EMITL(1) ; %%% FREE FIELD = /. 08653220 - GO TO PASSLIST ; 08653230 - END OF SCANNING FOR FREE FIELD FORMAT ; 08653240 - IF ELCLASS = FACTOP 08654000 - THEN BEGIN COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;08655000 - EMITL(0); EMITL(0); STEPIT; 08656000 - GO PASSLIST; 08657000 - END; 08658000 - IF ACCUM[1]="1<0000" THEN 08658010 - BEGIN EXPLICITFORMAT; GO TO WRITXFORM; END; 08658020 - IF ARC THEN 08658100 - BEGIN KLUDGE(-HOLD); 08658200 - GO TO EXIT; 08658300 - END ARRAY TO ARRAY CASE; 08658400 - EMITL(0); AEXP; 08659000 - IF CHECK(COMMA,443) 08660000 - THEN GO TO EXIT; 08661000 - COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 08662000 - PARAMETER IN WRITE STATEMENT; 08663000 - STEPIT; 08664000 - IF RANGE(BOOARRAYID,INTARRAYID) 08665000 - THEN BEGIN COMMENT THIS IS THE ROW DESIGNATOR CASE; 08666000 - VARIABLE(FL); 08667000 - IF TABLE(I-2) ! FACTOP 08668000 - THEN BEGIN COMMENT ERROR 444 MEANS IMPROPER ROW 08669000 - DESIGNATOR IN A WRITE STATEMENT; 08670000 - ERROR(444); GO TO EXIT; 08671000 - END; 08672000 - IF CHECK(RTPAREN,445) 08673000 - THEN GO TO EXIT; 08674000 - COMMENT ERROR 445 MEANS MISSING RIGHT 08675000 - PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 08676000 - STATEMENT; 08677000 - GOGOGO ~ TRUE;% 08677100 - STEPIT; GO EMITCALL; 08678000 - END 08679000 - ELSE BEGIN COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;08680000 - ERROR(446); GO TO EXIT; 08681000 - END; 08682000 - PASSLIST:IF CHECK(COMMA,447) 08683000 - THEN GO TO EXIT; 08684000 - COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 08685000 - LIST IN A WRITE STATEMENT; 08686000 - IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 08687000 - THEN BEGIN RR1~LISTGEN; GO TO EMITCALL END; 08688000 - CHECKER(ELBAT[I]); 08688500 - IF ELCLASS = SUPERLISTID THEN 08689000 - BEGIN COMMENT SUBSCRIPTED SWITCH LIST ID; 08690000 - LISTADDRESS~ELBAT[I].ADDRESS; 08692000 - BANA; 08693000 - EMITV(LISTADDRESS); 08694000 - IF LISTADDRESS > 1023 THEN EMITO(PRTE); 08694500 - EMITO(LOD); 08695000 - I~I-1; COMMENT STEP DOWN THE&I FROM BANA; 08695500 - END ELSE 08696000 - BEGIN COMMENT A COMMON LIST ID; 08696500 - EMITPAIR(ELBAT[I].ADDRESS,LOD); 08696520 - END; 08696530 - STEPIT; 08696540 - IF CHECK(RTPAREN,448) THEN GO TO EXIT; 08696550 - COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 08696560 - STEPIT; 08697000 - EMITCALL: IF ELCLASS=LFTBRKET AND NOT ARC THEN 08698000 - BEGIN EMITO(MKS); 08698100 - IF STEPI ! COLON THEN DEXP ELSE EMIT(0); 08698200 - IF ELCLASS!COLON THEN EMIT(0) ELSE 08698300 - BEGIN STEPIT; DEXP END; 08698400 - IF CHECK(RTBRKET,433) THEN GO EXIT; 08698500 - EMITL(15); EMITV(5); STEPIT; 08698600 - END;% 08698700 - IF GOGOGO THEN% 08698750 - BEGIN EMIT(0); EMIT(0); EMIT(0);% 08698800 - EMIT(0); EMIT(0); EMITV(12);% 08698850 - END ELSE EMITV(GNAT(INTERPTO));% 08698900 - GOGOGO ~ FALSE;% 08698950 - EXIT:; 08699000 - END WRITESTMT; 08700000 -PROCEDURE LOCKSTMT; 08701000 - BEGIN COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 08702000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08703000 - FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08704000 - **********************************************************08705000 - ::=LOCK(,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 LAST08713000 - EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 08714000 - DEFINE THISL = RR1#; COMMENT THISL IS A TEMP CELL 08715000 - FOR THE CURRENT L REGISTER; 08716000 - DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08717000 - L REGISTER SETTING FOR THE 08718000 - SAVE OR RELEASE LITERAL THAT 08719000 - GETS PASSED TO KEN MEYERS; 08720000 - STEPIT; 08721000 - IF CHECK(LEFTPAREN,450) 08722000 - THEN GO TO EXIT; 08723000 - COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 08724000 - IN A LOCK STATEMENT; 08725000 - STEPIT; 08726000 - IF NOT RANGE(FILEID,SUPERFILEID) 08727000 - THEN BEGIN COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 08728000 - IF NOT RANGE(BOOARRAYID,INTARRAYID) THEN 08728100 - BEGIN ERR(451); GO TO EXIT END; 08728200 - VARIABLE(FL); L ~ L-1; 08728300 - IF TABLE(I-2)!FACTOP THEN FLAG(208); 08728400 - EMITO(DUP); EMITO(LOD); EMITL(24); 08728500 - EMITD(43,3,5); EMITO(XCH); EMITO(STD); 08728600 - IF ELCLASS=RTPAREN THEN STEPIT ELSE ERR(104); 08729000 - GO TO EXIT 08730000 - END; 08731000 - PASFILE; 08732000 - IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08732100 - RELEASEV ELSE 08732200 - IF CHECK(COMMA,452) 08733000 - THEN GO TO EXIT; 08734000 - COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT08735000 - ; 08736000 - THISL~L; L~LTEMP; 08737000 - IF(RRB1~STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND 08738000 - ELBAT[I].ADDRESS=SAVEV OR ELCLASS=FACTOP 08739000 - THEN EMITL(IF RRB1 08740000 - THEN 6 08741000 - ELSE IF ELCLASS=FACTOP THEN 8 ELSE 2) 08742000 - ELSE BEGIN COMMENT ERROR 453 MEANS IMPROPER UNIT 08743000 - DISPOSITION PART; 08744000 - ERROR(453); GO TO EXIT; 08745000 - END; 08746000 - L~THISL; 08747000 - STEPIT; 08748000 - IF CHECK(RTPAREN,454) 08749000 - THEN GO TO EXIT; 08750000 - COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 08751000 - LOCK STATEMENT; 08752000 - STEPIT; 08753000 - EXIT:; 08754000 - END LOCKSTMT; 08755000 -PROCEDURE CLOSESTMT; 08756000 - BEGIN COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 08757000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08758000 - FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 08759000 - **********************************************************08760000 - ::=CLOSE(,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 THISL IS A TEMP CELL 08774000 - FOR THE CURRENT LREGISTER; 08775000 - DEFINE LTEMP = RR2#; COMMENT LTEMP CONTAINS THE 08776000 - L REGISTER SETTING FOR THE 08777000 - SAVE OR RELEASE LITERAL THAT 08778000 - GETS PASSED TO KEN MEYERS; 08779000 - LABEL EMITREST; COMMENT I IS POINTING AT THE UNIT 08780000 - DISPOTION PART AND CODE FOR THE LAST THREE08781000 - PARAMETERS TO THE FILE CONTROL ROUTINE 08782000 - MUST NOW BE GENERATED; 08783000 - STEPIT; 08784000 - IF CHECK(LEFTPAREN,455) 08785000 - THEN GO TO EXIT; 08786000 - COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 08787000 - CLOSE STATEMENT; 08788000 - STEPIT; 08789000 - IF NOT RANGE(FILEID,SUPERFILEID) 08790000 - THEN BEGIN COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A08791000 - CLOSE STATEMENT; 08792000 - ERROR(456); GO TO EXIT; 08793000 - END; 08794000 - PASFILE; 08795000 - IF ELCLASS=RTPAREN THEN ELBAT[(I~I-2)+1].CLASS~ 08795100 - RELEASEV ELSE 08795200 - IF CHECK(COMMA,457) 08796000 - THEN GO TO EXIT; 08797000 - COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 08798000 - STATEMENT; 08799000 - THISL~L; L~LTEMP; 08800000 - IF STEPI = RELEASEV 08801000 - THEN BEGIN COMMENT RELEASE UNIT DISPOSITION PART CASE; 08802000 - EMITL(7); GO EMITREST; 08803000 - END; 08804000 - IF ELCLASS = FACTOP 08805000 - THEN BEGIN COMMENT ASTERISK UNTI DISPOSITION PART CASE; 08806000 - EMITL(1); GO EMITREST; 08807000 - END; 08808000 - IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV 08809000 - THEN BEGIN COMMENT SAVE UNIT DISPOSITION PART CASE; 08810000 - EMITL(3); GO EMITREST; 08811000 - END; 08812000 - IF ACCUM[1] ="5PURGE" THEN BEGIN COMMENT FILE PURGE; 08812100 - EMITL(4); GO EMITREST; 08812200 - END; 08812300 - ERROR(458); GO TO EXIT; 08813000 - COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 08814000 - IN A CLOSE STATEMENT; 08815000 - EMITREST:STEPIT; 08816000 - L~THISL; 08817000 - IF CHECK(RTPAREN,459) 08818000 - THEN GO TO EXIT; 08819000 - COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 08820000 - CLOSE STATEMENT; 08821000 - STEPIT; 08822000 - EXIT:; 08823000 - END CLOSESTMT; 08824000 -PROCEDURE RWNDSTMT; 08825000 - BEGIN COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 08826000 - CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 08827000 - FOLLOWING PARAMETERS. 08828000 - **********************************************************08829000 - ::=REWIND() 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 |; 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 -$SET NEATUP 09214450120324PK - 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 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 -$RESET NEATUP 09215100120324PK - 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 -$SET NEATUP 09251250120324PK -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 - INSERTCOP:=1; 09274100 - ERRORTOG~TRUE; BLOCK(FALSE); 09275000 - COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 09275100 - THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 09275200 - THE END. CARD OFF AN INPUT TAPE; 09275250 - IF NEWTOG THEN 09275300 - BEGIN FILL LIBARRAY[*] WITH "END;END."," ","LAST CAR", 09275350 - "D ON OCR","DING TAPE","E ", " "," ", 09275400 - " ","999999999"; 09275450 - WRITE(NEWTAPE,10,LIBARRAY[*]) 09275500 - END; 09275550 - 09275600 - 09275650 - 09275700 - 09275750 - 09275800 - 09275850 - 09275900 - 09275950 - 09276000 - COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 09277000 - WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 09278000 - USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 09279000 - THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 09280000 - IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 09281000 - PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 09282000 - INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 09283000 - ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 09284000 - FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 09285000 - INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 09286000 - THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 09287000 - PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 09288000 - DRUM ADDRESSES TO THE INTRINSICS; 09289000 - 09290000 - GT1 ~ GT3 ~ STARTINTRSC; 09291000 - L1: GT1 ~ GT1 + (GT2 ~ INFO[GT1.LINKR,GT1.LINKC]).[33:2]; 09292000 - IF GT2 } 0 THEN % NOT POWERS OF TEN TABLE 09293000 - BEGIN IF GT2.ADDRESS ! 0 THEN % IT WAS USED 09294000 - BEGIN SGNO ~ SGAVL; SGAVL ~ SGAVL + 1; 09295000 - GT2 ~ PROGDESCBLDR(INFO[GT1.LINKR,GT1.LINKC].[1:1] 09296000 - | 2 + 1, 0, GT2.ADDRESS); 09296100 - PDPRT[PDINX.[37:5],PDINX.[42:6]] ~ 09297000 - 1 & INFO[GT1.LINKR,GT1.LINKC][13:18:15] 09298000 - & SGNO[28:38:10] & 1[2:47:1]; 09298100 - PDINX ~ PDINX + 1; 09299000 - IF PRTOG THEN % WRITE OUT INTRINSICS USED. 09300000 - BEGIN GT3 ~ GT3 + 1; 09300100 - BLANKET(14,LIN); % BLANK BUFFER. 09300150 - WRTINTRSC(SGNO, INFO[GT3.LINKR,GT3.LINKC], 09300200 - B2D(GT2.[38:10]), LIN); 09301000 - IF NOHEADING THEN DATIME; WRITELINE; 09302000 - END 09303000 - END; 09304000 - GT3 ~ GT1 ~ GT1 + INFO[GT1.LINKR,GT1.LINKC].[33:15] + 1; 09305000 - GO TO L1; 09305100 - END; 09306000 - L~L-1; COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 09306100 - EMITL(5);EMITO(COM); 09307000 - ENIL[0,1] ~ 1023 & 99999999[10:20:28]; ENILPTR ~ 1; 09307100 - SEGMENT((L+3) DIV 4,1,0); 09308000 -COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 09309000 - AT THIS TIME AS A TYPE 2 SEGMENT; 09310000 - IF GT1~GT2.ADDRESS!0 THEN 09311000 - BEGIN SGAVL~(SGNO~SGAVL)+1; 09312000 - GT2~PROGDESCBLDR(2,0,GT2.ADDRESS); 09313000 - MOVE(69,TEN,EDOC[0,0]); 09314000 - BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)); 09314100 - SEGMENT(-69, SGNO,0); 09315000 - BUILDLINE ~ BUILDLINE.[46:1] ; 09315100 - END; 09316000 -BEGIN ARRAY PRT[0:7,0:127],SEGDICT[0:7,0:127]; 09317000 - INTEGER PRTADR,SEGMNT,LINK; 09318000 -COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 09333000 - 09334000 - 09335000 - 09336000 - 09337000 - 09338000 - 09339000 - 09340000 - 09341000 - 09342000 - 09343000 - 09344000 - 09345000 - 09346000 - 09347000 - FOR I~0 STEP 1 UNTIL PDINX-1 DO 09348000 - IF (GT1~PDPRT[I.[37:5],I.[42:6]]).[38:10]=0 THEN 09349000 - BEGIN PRTADR~GT1.[8:10]; SEGMNT~GT1.[28:10]; 09350000 - LINK~SEGDICT[SEGMNT.[36:5],SEGMNT.[41:7]].[8:10]; 09351000 - MDESC(GT1.[18:10]&SEGMNT[18:33:15] 09352000 - &(IF LINK=0 THEN SEGMNT+2048 ELSE LINK) 09353000 - [6:36:12]>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)| 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); 09396000 - IDARRAY[5]~GT1; 09397000 -COMMENT WRITE OUT SEGMENT DICTIONARY; 09398000 - IDARRAY[0]:=MOVEANDBLOCK(SEGDICT,SGAVL,1); 09399000 - IF BUILDLINE THEN IDARRAY[0]~IDARRAY[0]&MOVEANDBLOCK 09399100 - (LDICT,SGAVL,2)[18:33:15]; 09399150 - IDARRAY[1]~SGAVL; 09400000 -COMMENT WRITE OUT PRT; 09401000 - IDARRAY[2]:=MOVEANDBLOCK(PRT,PRTIMAX,3); 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]); 09407000 - GT2:=MOVEANDBLOCK(PRT,30,6); DA:=GT1; 09407010 - IF CODEFILE THEN WRITE(LINE); 09407020 - IF SAVETIME } 0 AND ERRORCOUNT = 0THEN 09407050 - LOCK(CODE,SAVE); 09407100 - CLOSE(CARD,RELEASE); % RELEASE PRIMARY INPUT FILE. 09407200 - CLOSE(TAPE,RELEASE); % RELEASE SECONDARY INPUT FILE. 09407300 - LOCK(NEWTAPE,*); % CLOSE WITH CRUNCH. 09407400 - IF LISTER OR NOT NOHEADING THEN 09408000 - BEGIN 09409000120324PK -$RESET NEATUP 09409100120324PK - FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT" 09409200120324PK - ,"ION TIME = ",I5," SECONDS."X22,2A4/ 09410000 - "PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 09411000 - " WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 09412000 - I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 09413000 - /"ESTIMATED AUXILIARY MEMORY REQUIRED =",I6," WORDS.", 09414000 - /"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 09414100 -FOMRAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 09414101 -$SET NEATUP 09414200120324PK - MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],0,GT1,4);09415000 - MOVECHARACTERS(4,INFO[LASTSEQROW,LASTSEQUENCE-1],4,GT2,4);09416000 -IF CHECKTOG THEN 09416001 - WRITE(LINE[DBL] ,SERR,IF NUMSEQUENCEERRORS = 0 09416002 - THEN "A" ELSE "I", IF NUMSEQUENCEERRORS = 0 09416004 - THEN " NO" ELSE NUMSEQUENCEERRORS); 09416006 - WRITE(LINE[DBL],PAN,ERRORCOUNT,(TIME(1)-TIME1)/60,GT1,GT2,09417000 - PRTIMAX,AKKUM,IF DA{CHUNK THEN DA ELSE ((DA+CHUNK-1) 09418000 - DIV CHUNK)|CHUNK,SGAVL-1,GTI1,AUXMEMREQ,CARDCOUNT); 09419000 -END END END PROGRAM; 09420000 - COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 10000000 - COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 10001000 - FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 10002000 - WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 10003000 - ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 10004000 - RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 10005000 - STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 10006000 - EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 10007000 - THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 10008000 - TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 10009000 - S = [1:1], 10010000 - REPEAT = [38:10], 10011000 - SKIP = [32:6], 10012000 - CODE = [2:4], 10013000 - W = [6:6], 10014000 - W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 10015000 - S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 10016000 - TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 10017000 - BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 10018000 - WORDS. GIVEN S = 1 WE HAVE: 10019000 - IF CODE = 0 THEN RIGHTPAREN, 10020000 - IF CODE = 2 THEN STRING, 10021000 - IF CODE = 4 THEN LEFTPAREN, 10022000 - IF CODE = 6 THEN STROKE, 10023000 - IF CODE = 8 THEN SCALE. 10023100 - GIVEN S = 0 WE HAVE 10024000 - IF CODE = 0 THEN D, 10025000 - IF CODE=1 THEN T, 10025010 - IF CODE = 2 THEN X, 10026000 - IF CODE = 4 THEN A, 10027000 - IF CODE = 6 THEN I, 10028000 - IF CODE = 8 THEN F, 10029000 - IF CODE =10 THEN E, 10030000 - IF CODE = 11 THEN U, 10030100 - IF CODE =12 THEN O, 10031000 - IF CODE = 13 THEN V, 10031100 - IF CODE =14 THEN L, 10032000 - IF CODE = 15 THEN R, 10032100 - W IS THE FIELD WIDTH. 10033000 - FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 10034000 - ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 10035000 - REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 10036000 - REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 10037000 - HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 10038000 - IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 10039000 - A NON-ZERO REPEAT FIELDS. 10040000 - THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 10041000 - FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 10042000 - D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 10043000 - THEN FOR D, W1=W2=D1=D2=SKIP=0. 10044000 - FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 10045000 - W2 = D1 = D2 =0. 10046000 - FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 10046010 - W2=D1=D2=0. 10046020 - FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 10047000 - W1 = 6, SKIP = W-6, W2=D1=D2=0. 10048000 - FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 10049000 - IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 10050000 - IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 10051000 - FOR F IF D < 8 THEN D1 = D, D2=0, 10052000 - IF D > 8 THEN D1 = 8, D2=D-8, 10053000 - IF D >16 THEN ERROR. 10054000 - IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 10055000 - SKIP=0. 10056000 - IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 10057000 - IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 10058000 - FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 10059000 - D+1 FOR D, SKIP = W-D-6, W1=W2=0. 10060000 - FOR O, W1=W2=D1=D2=SKIP=0, 10061000 - FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 10062000 - SKIP = W-W1, 10063000 - FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 10063100 - FOR B: SEE U-PHRASE DESCRIPTION. 10063110 - FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 10063200 - FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 10063300 - F-PHRASE DESCRIPTION. 10063400 - FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE10064000 - WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 10065000 - BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS10066000 - IF IT NOTICES AN ERROR; 10067000 - PROCEDURE WHIPOUT(W); VALUE W; REAL W; 10068000 - BEGIN 10069000 - 10070000 - MOVE(1,W,EDOC(F.[38:3],F.[41:7]]); 10071000 - IF DEBUGTOG 10072000 - THEN BEGIN 10073000 - DEBUGWORD(B2D(F),W,LIN); 10074000 - WRITELINE END; 10075000 - IF (F~F+1) > 1024 THEN FLAG(307); 10076000 - 10077000 - 10078000 - 10079000 - 10080000 - 10081000 - END WHIPOUT; 10082000 - BOOLEAN PROCEDURE FORMATPHRASE; 10083000 - BEGIN 10084000 - LABEL EL,EX,EXIT,L1,L2,L3; 10085000 - PROCEDURE EMITFORMAT(S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2); 10086000 - VALUE S,CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10087000 - REAL CODE,REPEAT,SKIP,W,W1,W2,D1,D2 ; 10088000 - BOOLEAN S; 10089000 - BEGIN IF W > 63 THEN FLAG(163); 10090000 - W ~ REPEAT & W [ 6:42:6] 10091000 - & SKIP [32:42:6] 10092000 - & W1 [28:44:4] 10093000 - & W2 [24:44:4] 10094000 - & D1 [20:44:4] 10095000 - & D2 [16:44:4] 10096000 - & CODE [ 2:44:4] 10097000 - & REAL(S) [ 1:47:1]; 10098000 - WHIPOUT(W) END EMITFORMAT; 10099000 - STREAM PROCEDURE PACKALPHA(PLACE,LETTER,CTR); 10100000 - VALUE LETTER, CTR; 10101000 - BEGIN DI ~ PLACE; DS ~ LIT "B"; 10102000 - SI ~ LOC CTR; SI ~ SI+7; DS ~ CHR; 10103000 - SI ~ PLACE; SI ~ SI+3; DS ~ 5 CHR; 10104000 - SI ~ LOC LETTER; SI ~ SI+7; DS ~ CHR END PACKALPHA; 10105000 - INTEGER REPEAT,SKIP,W,W1,W2,D1,D2,CODE; BOOLEAN S; 10106000 - DEFINE RRIGHT = 0#, 10107000 - RLEFT = 4#, 10108000 - RSTROKE = 6#; 10109000 - DEFINE RSCALE = 8 #, RU = 11 #, RV = 13 #, RR = 15 # ; 10109500 - DEFINE RD = 0#, RX = 2#, RA = 4#, RI = 6#, 10110000 - RT=1 #, 10110010 - RF = 8#, RE = 10#, RO = 12#, RL = 14#; 10111000 - IF ELCLASS < 0 THEN BEGIN REPEAT ~ -ELCLASS;NEXTENT; 10112000 - IF ELCLASS="," OR ELCLASS=")" THEN GO EX END 10112100 - ELSE BEGIN REPEAT:=REAL(ELCLASS!"<"); 10113000 - IF ELCLASS="*" THEN BEGIN REPEAT.[12:1]~1; 10113100 - NEXTENT; 10113200 - END END; 10113300 - IF ELCLASS="(" OR ELCLASS="<" 10114000 - THEN BEGIN 10115000 - SKIP ~ F; 10116000 - EMITFORMAT(TRUE,RLEFT,REPEAT,1,0,0,0,0,0); 10117000 - DO BEGIN NEXTENT; 10118000 - EL: IF FORMATPHRASE THEN GO TO EX END 10119000 - UNTIL ELCLASS ! ","; 10120000 - WHILE ELCLASS = "/" 10121000 - DO BEGIN EMITFORMAT(TRUE,RSTROKE,0,1,0,0,0,0,0); 10122000 - NEXTENT END; 10123000 - IF ELCLASS ! ")" AND ELCLASS ! ">" 10124000 - THEN GO TO EL; 10124100 - IF LASTELCLASS = "," THEN GO TO EX; 10124200 - IF REPEAT = 0 THEN 10125000 - EMITFORMAT(TRUE,RSTROKE,1,0,0,0,0,0,0); 10126000 - REPEAT~F-SKIP; F~SKIP; 10127000 - WHIPOUT(EDOC[F.[38:3],F.[41:7]]&REPEAT[28:38:10]); 10127100 - F~SKIP+REPEAT; S~TRUE; CODE~RRIGHT END 10127200 - ELSE IF ELCLASS = "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 - PUTOGETHER(2130706432) END 10270000 - ELSE BEGIN 10271000 - IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) 10272000 - THEN PUTOGETHER("1 0000"); COMMENT INSERT BLANK; 10273000 - PUTOGETHER(ACCUM[1]) END; 10274000 - IF TB1 THEN GO TO EXIT; 10275000 - LASTRESULT ~ RESULT; 10276000 - IF MACRO THEN GO BACK; 10276500 - IF ELCLASS=DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV10277000 - THEN BEGIN DEFINECTR ~ DEFINECTR+1; GO BACK END; 10278000 - IF ELCLASS ! CROSSHATCH THEN GO BACK; 10279000 - IF DEFINECTR ! 1 10280000 - THEN BEGIN STOPDEFINE ~ TRUE; 10281000 - IF ELCLASS~TABLE(I)!COMMA THEN 10282000 - DEFINECTR~DEFINECTR-1; GO SKSC END; 10283000 -EXIT: DEFINECTR := 0; STREAMTOG~TSSTREAMTOG; % 1289 10284000 - NEXTTEXT ~ (CHARCOUNT+7) DIV 8 + NEXTTEXT; 10285000 - END DEFINEGEN; 10286000 - COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST10287000 - ELEMENTS; 10288000 - PROCEDURE LISTELEMENT; 10289000 - BEGIN 10290000 - REAL T1,T2,T3; 10291000 - LABEL BOOFINISH,STORE,LRTS; 10292000 - DIALA ~ DIALB ~ 0; 10293000 - IF ELCLASS= FORV THEN FORSTMT COMMENT FORCLAUSE; 10294000 - ELSE IF ELCLASS = LFTBRKET 10295000 - THEN BEGIN COMMENT GORUP OF LIST ELEMENTS; 10296000 - DO BEGIN STEPIT; LISTELEMENT END UNTIL ELCLASS!COMMA;10297000 - IF ELCLASS = RTBRKET THEN STEPIT ELSE ERR(158) END 10298000 - ELSE BEGIN COMMENT THE MEAT OF THE MATTER: 10299000 - VARIABLES AND EXPRESSIONS; 10300000 - L ~ (T1~L)+1; COMMENT SAVE L FOR LATER FIXUP; 10301000 - EMITPAIR(LSTRTN,STD); COMMENT PREPARE LSTRTN FOR 10302000 - NEXT TIME AROUND; 10303000 - IF(GT1 ~ TABLE(I+1) = COMMA 10304000 - OR GT1 = RTPAREN 10305000 - OR GT1 = RTBRKET) 10306000 - AND ELCLASS } BOOID AND ELCLASS { INTID 10307000 - THEN BEGIN COMMENT SIMPLE VARIABLES; 10308000 - CHECKER(ELBAT[I]); 10308100 - EMITN(ELBAT[I].ADDRESS); STEPIT END 10309000 - ELSE BEGIN IF ELCLASS } BOOARRAYID 10310000 - AND ELCLASS { INTARRAYID 10311000 - THEN BEGIN COMMENT IS EITHER A SUBCRIPTED VARIABLE 10312000 - OR THE BEGINNING OF AN EXPRESSION. THIS10313000 - SITUATION IS VERY SIMILAR TO THAT IN 10314000 - ACTUALPARAPART (SEE COMMENTS THERE FOR 10315000 - FURTHER DETAILS); 10316000 - T2 ~ FL; T3 ~ ELCLASS; VARIABLE(T2); 10317000 - IF TABLE(I-2)=FACTOP AND TABLE(I-1)=RTBRKET THEN ERR(157);10318000 - IF ELCLASS = COMMA OR 10319000 - ELCLASS = RTPAREN OR 10320000 - ELCLASS = RTBRKET THEN 10321000 - IF T2 = 0 THEN GO TO STORE ELSE GO TO LRTS; 10322000 - IF T3 = BOOARRAYID THEN GO TO BOOFINISH; 10323000 - SIMPARITH; 10324000 - IF ELCLASS = RELOP THEN BEGIN RELATION; 10325000 - BOOFINISH: SIMPBOO END END 10326000 - ELSE IF EXPRSS = DTYPE THEN ERR(156); 10327000 - STORE: EMITPAIR(JUNK,STD); EMITN(JUNK) END; 10328000 - LRTS: EMITO(RTS); CONSTANTCLEAN; 10329000 - T2 ~ L; L ~ T1; EMITNUM(T2-LSTR); L~T2 END END LSTELMT; 10330000 - COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 10331000 - LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 10332000 - LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 10333000 - CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 10334000 - LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 10335000 - FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 10336000 - THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 10337000 - FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 10338000 - DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR, 10339000 - LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 10340000 - LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 10341000 - VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 10342000 - ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 10343000 - REAL PROCEDURE LISTGEN; 10344000 - BEGIN 10345000 - INTEGER JUMPLACE,LISTPLACE; 10346000 - JUMPLACE ~ BAE; 10347000 - LISTGEN ~ LISTPLACE ~ PROGDESCBLDR(0,L,0); 10348000 - COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 10349000 - EMITV(LSTRTN); EMITO(BFW); LSTR ~ L; 10350000 - COMMENT INITIAL JUMP OF A LIST; 10351000 - LISTMODE ~ TRUE; 10352000 - COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 10353000 - I~I-1; 10354000 - DO BEGIN 10355000 - STEPIT; 10356000 - LISTELEMENT 10357000 - END UNTIL ELCLASS ! COMMA; 10358000 - EMITL(1); EMITO(CHS); 10359000 - EMITPAIR(LSTRTN,SND); 10360000 - EMITO(RTS); 10361000 - COMMENT SET END FLAG OF -1; 10362000 - CONSTANTCLEAN; 10363000 - DIALA ~ DIALB ~ 0; 10364000 - LISTMODE ~ FALSE; 10365000 - ADJUST; 10365100 - EMITB(BFW,JUMPLACE,L); 10366000 - STUFFF(LISTPLACE); 10367000 - IF ELCLASS ! RTPAREN THEN ERR(104) ELSE STEPIT 10368000 - END LISTGEN; 10369000 - BOOLEAN PROCEDURE MERRIMAC; 10370000 - BEGIN COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 10371000 - 03 JULY 1963 10372000 - THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 10373000 - LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,10374000 - ARRAYS, AND FUNCTION DESIGNATORS. 10375000 - WITH ONE EXCEPTION, THE MERRIMAX ROUTINES ONLY FUNCTION 10376000 - IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE10377000 - VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 10378000 - THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 10379000 - THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 10380000 - A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN10381000 - ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 10382000 - ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 10383000 - THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 10384000 - INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 10385000 - FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 10386000 - EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 10387000 - AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 10388000 - POSSIBLE CALLS ON PRINTI. 10389000 - ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 10390000 - THE IDENTIFIER TO BE PRINTED. 10391000 - N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 10392000 - ARRAY OR SUBSCRIPTED VARIABLE. 10393000 - V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 10394000 - S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10395000 - PRINTED. 10396000 - S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 10397000 - MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 10398000 - ONLY IF THEY ARE EQUAL. 10399000 - FORMAT TYPE MONITOR DUMP 10400000 - ----------- ------- ---- 10401000 - 0 LABELS 10402000 - SWITCHES 10403000 - --------- ----- -- 10404000 - 1 SIMPLE VARIABLES LABELS 10405000 - FUNCTION SIMPLE VARIABLES 10406000 - --------- ----- -- 10407000 - 2 ARRAYS SUBSCRIPTED VARS 10408000 - --------- ----- -- 10409000 - 3 SUBSCRIPTED VARS 10410000 - --------- ----- -- 10411000 - 4 ARRAYS 10412000 - ********* ***** ** 10413000 - FORMAT TYPE PRINTOUT 10414000 - ----------- -------- 10415000 - 0 ID 10416000 - --------- ----- 10417000 - 1 ID=V 10418000 - --------- ----- 10419000 - 2 ID[S1---SN]=V 10420000 - --------- ----- 10421000 - 3 ID[S1---SN]=V 10422000 - --------- ----- 10423000 - 4 ID=V1---VN 10424000 - *********** ******** 10425000 - THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY10426000 - THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 10427000 - PASSING THE TYPEV TO PRINTI. 10428000 - TYPE TYPEV 10429000 - ---- ----- 10430000 - BOOLEAN 0 10431000 - -- --- 10432000 - REAL 1 10433000 - -- --- 10434000 - ALPHA 2 10435000 - -- --- 10436000 - INTEGER 3 10437000 - **** ***** 10438000 - POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 10439000 - AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 10440000 - FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 10441000 - ----------- --------------------------- 10442000 - 0 10443000 - --------- ------------------------- 10444000 - 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 10445000 - --------- ------------------------- 10446000 - 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,10447000 - FILE,2) 10448000 - --------- ------------------------- 10449000 - 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN10450000 - ,ID,CHARI,FILE,3) 10451000 - --------- ------------------------- 10452000 - 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 10453000 - POWERSOFTEN,ID,CHARI,FILE,4) 10454000 - *********** *************************** 10455000 - SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 10456000 - MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 10457000 - THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 10458000 - THAT IS GATHERED BY THE MONITOR IS STORED IN THE 10459000 - ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 10460000 - ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 10461000 - MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 10462000 - MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 10463000 - WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 10464000 - MONITORING INFORMATION. 10465000 - *********FORMAT OF INFO FOR MONITORED ITEMS**********10466000 - ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 10467000 - WORD WILL BE SET. 10468000 - SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 10469000 - ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 10470000 - THE MONITOR FILE IN [37:11], I WILL HAVE A 10471000 - DEFINE SVARMONFILE = [37:11]#. 10472000 - ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 10473000 - NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 10474000 - MONITOR FILE IS REMEMBERED IN [27:11] OF THE 10475000 - FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 10476000 - DEFINE ARRAYMONFILE = [27:11]#. 10477000 - SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 10478000 - SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 10479000 - TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD10480000 - OF INFO CONTAINING LOWER BOUND INFORMATION10481000 - ALSO CONTAINS MONITOR INFORMATION. EITHER10482000 - A LITERAL OR AN ADDRESS WILL BE CONTAINED 10483000 - IN BITS [12:11]. IN [11:1] IS A BIT THAT 10484000 - DESIGNATES WHETHER AN OPDC OR A LITC 10485000 - SHOULD BE GENERATED USING [12:11]. IF THE10486000 - BIT IS 1 THEN AN OPDC WILL BE GENERATED, 10487000 - ELSE A LITC. IF AN OPDC IS GENERATED IT 10488000 - MAY BE ON A SIMPLE VARIABLE, OR ON AN 10489000 - ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 10490000 - PURPOSE OF THE LITC OR OPDC IS TO PASS 10491000 - SI* TO THE PRINTI ROUTINE. 10492000 - LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 10493000 - THE ADDRESS OF THE FILE DESCRIPTOR IN THE 10494000 - ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A10495000 - DEFINE LABLMONFILE = [13:11]#. 10496000 - SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.10497000 - I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 10498000 - FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 10499000 - WITH THE SAME NUMBER OF WORDS AS THE 10500000 - ORIGIONAL ENTRY. THE MONITOR FILE IS 10501000 - REMEMBERED IN [27:11] OF THE FIRST WORD OF 10502000 - ADDITIONAL INFO. I WILL HAVE A DEFINE 10503000 - FUNCMONFILE = [27:11]#; 10504000 - DEFINE FILEIDENT = RR7#; COMMENT FILEIDENT CONTAINS THE 10505000 - ADDRESS OF THE MONITOR FILE; 10506000 - DEFINE SUBSCRIPT = RR1#; COMMENT SUBSCRIPT IS USED TO 10507000 - SAVE THE ADDRESS OR VALUE OF A 10508000 - SUBSCRIPT. ONE ADDITIONAL BIT IS10509000 - USED TO TELL WHETHER TO EMIT AN 10510000 - OPDC OR A LITC ON THIS ADDRESS OR10511000 - VALUE; 10512000 - DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10513000 - DIMENSIONS OF AN ARRAY OR SUBSCRIPTED10514000 - VARIABLE APPEARING IN A MONITOR LIST;10515000 - DEFINE INC = RR3#; COMMENT INC CONTAINS THE LINK TO 10516000 - ADDITIONAL INFO AND IS USED WHEN MAKING10517000 - A NEW ENTRY IN INFO FOR ARRAYS; 10518000 - DEFINE ELBATWORD = RR4#; COMMENT ELBATWORD CONTAINS THE 10519000 - ELBAT WORD FOR A MONITOR LIST 10520000 - ELEMENT; 10521000 - DEFINE OPLIT = RR4#; COMMENT OPLIT IS USED FOR MARKING10522000 - SUBSCRIPTED VARIABLES TO TELL ME 10523000 - WHETHER TO EMIT AN OPDC OR A LITC.10524000 - 0 IS USED FOR OPDC, 1 FOR LITC; 10525000 - DEFINE TESTVARB = RR5#; COMMENT TESTVARB CONTAINS A LINK 10526000 - POINTING AT THE END OF ADDITIONAL 10527000 - INFO AND IS USED TO TELL WHEN TO 10528000 - STOP MOVING INFO FOR THE NEW ENTRY10529000 - FOR MONITORED ARRAYS; 10530000 - DEFINE NXTINFOTEMP = RR6#; COMMENT NXTINFOTEMP CONTAINS A10531000 - LINK POINTING AT THE FIRST 10532000 - ADDITIONAL WORD OF INFO FOR 10533000 - MONITORED ARRAYS; 10534000 - DEFINE INSERTFILE = 27:37:11#; COMMENT INSERTFILE IS THE 10535000 - CONCATENATE DEFINE FOR 10536000 - STUFFING THE MONITOR FILE 10537000 - ADDRESS INTO THE FIRST 10538000 - ADDITIONAL INFO WORD FOR 10539000 - ARRAYS AND FUNCTIONS; 10540000 - DEFINE NOPARPART = NODIMPART#; COMMENT NOPARPART IS A 10541000 - PARTIAL WORD DESIGNATOR [4010542000 - :8] USED TO EXTRACT THE 10543000 - NUMBER OF PARAMETERS FOR A 10544000 - GIVEN PROCEDURE FROM INFO; 10545000 - DEFINE NOPAR = NODIM#; COMMENT NOPAR CONTAINS THE NUMBER 10546000 - OF PARAMETERS FOR A FUNCTION 10547000 - DESIGNATOR APPEARING IN A MONITOR 10548000 - LIST; 10549000 - LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10550000 - POINTING AT THE FILE IDENTIFIER IN THE 10551000 - MONITOR DECLARATION; 10552000 - LABEL MARKMONITORED; COMMENT THE CODE AT MARKMONITORED 10553000 - TURNS ON THE MONITOR BIT OF THE ELBAT10554000 - WORD IN THE MONITOR LIST AND STORES 10555000 - IT IN ACCUM[0] FOR THE E ROUTINE; 10556000 - LABEL STORESUBS; COMMENT STORESUBS IS THE CODE THAT 10557000 - REMEMBERS ALL THAT IS NECESSARY ABOUT 10558000 - EACH SUBSCRIPT EXPRESSION; 10559000 - LABEL CHKCOMMA; COMMENT CHKCOMMA REQUIRES THAT I BE 10560000 - POINTING THE LAST LOGICAL QUANTITY OF THE 10561000 - MONITOR LIST ELEMENT THAT HAS JUST BEEN 10562000 - PROCESSED; 10563000 - LABEL EXIT; COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 10564000 - START:IF ELCLASS!FILEID THEN 10565000 - BEGIN IF Q="5INDEX" OR Q="4FLAG0" OR Q="6INTOV" OR Q= 10565100 - "6EXPOV" OR Q="4ZERO0"THEN MERRIMAC~TRUE ELSE 10565200 - ERR(400); GO EXIT; 10565300 - END 10566000 - COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 10567000 - CHECKER(ELBAT[I]); 10568000 - FILEIDENT~ELBAT[I].ADDRESS; I~I+1; 10569000 - IF CHECK(LEFTPAREN,401) 10570000 - THEN GO TO EXIT; 10571000 - COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 10572000 -MARKMONITORED:STEPIT; ACCUM[0]~-ABS(ELBAT[I]); 10573000 - IF RANGE(BOOID,INTID) 10574000 - THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10575000 - E; PUTNBUMP(FILEIDENT); 10576000 - GO CHKCOMMA; 10577000 - END; 10578000 - IF RANGE(BOOARRAYID,INTARRAYID) 10579000 - THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10580000 - SUBSCRIPTED VARIABLES; 10581000 - E; NXTINFOTEMP~NEXTINFO; 10582000 - PUTNBUMP(NODIM~TAKEFRST&FILEIDENT[INSERTFILE]); 10583000 - TESTVARB~(NODIM~NODIM. NODIMPART )+(INC~( 10584000 - ELBATWORD~ELBAT[I]).LINK+ELBATWORD.INCR); 10585000 - DO PUTNBUMP(TAKE(INC~INC+1)) 10586000 - UNTIL INC } TESTVARB; 10587000 - IF TABLE(I+1) ! LFTBRKET 10588000 - THEN GO CHKCOMMA; 10589000 - TESTVARB~NODIM+NXTINFOTEMP; 10590000 - STEPIT; 10591000 - STORESUBS:IF(RR3~TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND 10592000 - STEPI ! NONLITNO 10593000 - THEN BEGIN COMMENT THIS IS THE SIMPLE CASE OF 10594000 - SUBSCRIPTED VARIABLES. EITHER A LITC 10595000 - OR AN OPDC ON A VARIABLE IS ALL THAT 10596000 - IS NEEDED TO CALL THE SUBSCRIPT; 10597000 - SUBSCRIPT~ELBAT[I].ADDRESS; 10598000 - OPLIT~0; 10598500 - IF NOT RANGE( INTRNSICPROCID,INTID) 10599000 - THEN IF CHECK(LITNO,402) 10600000 - THEN GO TO EXIT 10601000 - ELSE COMMENT MARK FOR LITC; 10602000 - OPLIT~1; 10603000 - COMMENT ERROR 402 IS BAD 10604000 - SUBSCRIPT IN MONITOR DECLARATION;10605000 - STEPIT; 10606000 - END 10607000 - ELSE BEGIN COMMENT THIS IS THE SPECIAL CASE OF 10608000 - SUBSCRIPTED VARIABLES. CODE FOR THIS 10609000 - SUBSCRIPT EXPRESSION MUST BE GENERATED10610000 - AND JUMPED AROUND, AN ACCIDENTAL ENTRY10611000 - PROGRAM DESCRIPTOR CREATED AND THE 10612000 - ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT10613000 - MUST BE MARKED FOR AN OPDC; 10614000 - JUMPCHKNX; SUBSCRIPT~PROGDESCBLDR( 10615000 - ADES,L,0); AEXP; EMITO(RTS); 10616000 - JUMPCHKX; 10616500 - OPLIT~0; 10617000 - IF MODE > 0 10618000 - THEN BEGIN COMMENT STUFF F AT THIS 10619000 - POINT IF MODE > 0; 10620000 - STUFFF(SUBSCRIPT);EMITPAIR( 10621000 - SUBSCRIPT,STD); 10622000 - END; 10623000 - END; 10624000 - PUT(TAKE(NXTINFOTEMP~NXTINFOTEMP+1) & 10625000 - SUBSCRIPT[12:37:11] & OPLIT[11:47:01], 10626000 - NXTINFOTEMP); 10627000 - IF ELCLASS = COMMA 10628000 - THEN GO TO STORESUBS; 10629000 - IF CHECK(RTBRKET,403) 10630000 - THEN GO TO EXIT; 10631000 - COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 10632000 - EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 10633000 - IF NXTINFOTEMP ! TESTVARB 10634000 - THEN BEGIN COMMENT ERROR 404 MONITOR LIST 10635000 - ELEMENT HAS IMPROPER NUMBER OF 10636000 - SUBSCRIPTS; 10637000 - I~I-1; ERROR(404); GO TO EXIT; 10638000 - END; 10639000 - GO CHKCOMMA; 10640000 - END; 10641000 - IF ELCLASS = LABELID OR ELCLASS = SWITCHID 10642000 - THEN BEGIN COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 10643000 - IF(ELBATWORD~ELBAT[I]).LVL ! LEVEL 10644000 - THEN BEGIN COMMENT ERROR 405 MEANS LABEL OR 10645000 - SWITCH MONITORED AT IMPROPER LEVEL; 10646000 - ERROR(405); GO TO EXIT; 10647000 - END; 10648000 - PUT(TAKEFRST & FILEIDENT[13:37:11],GIT(ELBAT[I])10649000 - ); 10650000 - PUT(TAKE(ELBATWORD)&(0-ABS(ELBATWORD))[1:1:34], 10651000 - ELBATWORD); GO CHKCOMMA; 10652000 - END; 10653000 - IF RANGE(BOOPROCID,INTPROCID) 10654000 - THEN BEGIN COMMENT THIS CODE HANDLES FUNCTIONS; 10655000 - E ;% 10656000 -IF LEVEL=(RR2~ELBAT[I]).LVL THEN 10656010 - BEGIN 10656011 - %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 10656012 - %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 10656013 - PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1],LASTINFO+1) ; 10656014 - PUT(ABS(TAKE(RR2.LINK+1)),RR2.LINK+1) ; 10656015 - END ; 10656016 - PUTNBUMP(NOPAR ~ TAKEFRST & 10656030 - FILEIDENT[INSERTFILE]); TESTVARB~(NOPAR10657000 - ~NOPAR. NOPARPART )+(INC~(ELBATWORD~ELBAT[I]). 10658000 - LINK+ELBATWORD.INCR); 10659000 - DO PUTNBUMP(TAKE(INC~INC+1)) 10660000 - UNTIL INC } TESTVARB; 10661000 - GO CHKCOMMA; 10662000 - END; 10663000 - ERROR(406); GO TO EXIT; 10664000 - COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 10665000 - CHKCOMMA:IF STEPI = COMMA 10666000 - THEN GO MARKMONITORED; 10667000 - IF CHECK(RTPAREN,407) 10668000 - THEN GO TO EXIT; 10669000 - COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR10670000 - DECLARATION; 10671000 - IF STEPI = SEMICOLON 10672000 - THEN GO TO EXIT; 10673000 - IF CHECK(COMMA,408) 10674000 - THEN GO TO EXIT; 10675000 - COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 10676000 - DELIMITER; 10677000 - STEPIT; GO TO START; 10678000 - EXIT:; 10679000 - END MERRIMAC; 10680000 -PROCEDURE DMUP; 10681000 - BEGIN COMMENT 15 JULY 1963 10682000 - THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 10683000 - ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 10684000 - ARRAYS. 10685000 - THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 10686000 - THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 10687000 - OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE10688000 - THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 10689000 - A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 10690000 - HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 10691000 - BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS10692000 - COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 10693000 - WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 10694000 - THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 10695000 - FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 10696000 - THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 10697000 - INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 10698000 - ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 10699000 - OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED10700000 - . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 10701000 - DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 10702000 - IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 10703000 - FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 10704000 - SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 10705000 - LABEL START; COMMENT WHEN START IS REACHED, I MUST BE 10706000 - POINTING AT THE FILE IDENTIFIER IN THE DUMP 10707000 - DECLARATION; 10708000 - LABEL EXIT; COMMENT EXIT APPEARS AT THE END OF THE DMUP 10709000 - ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 10710000 - IS REACHED; 10711000 - DEFINE FILEIDENT = RR1#; COMMENT FILEIDENT CONTAINS THE 10712000 - ADDRESS OF THE MONITOR FILE; 10713000 - LABEL STARTCALL; COMMENT THE CODE AT STARTCALL GENERATES 10714000 - CODE TO CALL THE PRINTI ROUTINE. WHEN 10715000 - STARTCALL IS REACHED, I MUST BE POINTING 10716000 - AT THE CHARACTER IMMEDIATELY BEFORE THE 10717000 - DUMP LIST ELEMENT TO BE PASSED TO PRINTI;10718000 - DEFINE NODIM = RR2#; COMMENT NODIM CONTAINS THE NUMBER OF10719000 - DIMENSIONS OF AN ARRAY OR A 10720000 - SUBSCRIPTED VARIABLE APPEARING IN A 10721000 - DUMP LIST; 10722000 - DEFINE LEXIT = RR3#; COMMENT LEXIT CONTAINS THE PROGRAM 10723000 - COUNTER SETTING AT WHICH CODE IS 10724000 - GENERATED TO EXIT THE ROUTINE EMITTED10725000 - BY DMUP; 10726000 - DEFINE DUMPETEMP = RR2#; COMMENT DUMPETEMP HOLDS THE 10727000 - LOCATION OF THE COUNTER 10728000 - ASSOCIATED WITH THIS LABEL IF 10729000 - SPACE HAS BEEN ASSIGNED FOR IT; 10730000 - DEFINE DIMCTR = RR3#; COMMENT DIMCTR IS INITIALIZED TO 10731000 - NODIM. IT IS THEN COUNTED DOWN TO 10732000 - ZERO AS SUBSCRIPT CODE IS GENERATED;10733000 - LABEL PASSN; COMMENT THE CODE AT PASSN PASSES N (THE 10734000 - NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 10735000 - LABEL SUBSLOOP; COMMENT THE CODE AT SUBLOOP PASSES 10736000 - SUBSCRIPTS TO PRINTI; 10737000 - ARRAY LABELCTR[0:100]; COMMENT LABELCTR IS AN ARRAY THAT 10738000 - HOLDS THE ADDRESSES OF ALL LABEL 10739000 - COUNTERS FOR LABELS APPEARING IN 10740000 - THIS DUMP DECLARATION. IT IS 10741000 - NECESSARY TO RETAIN THIS 10742000 - INFORMATION SO THAT CODE MAY BE 10743000 - GENERATED AT THE END OF THE 10744000 - DECLARATION TO INITIALIZE THE 10745000 - COUNTERS; 10746000 - DEFINE LABELCTRINX = RR4#; COMMENT LABELCTRINX IS THE 10747000 - VARIABLE USED TO INDEX INTO THE10748000 - LABELCTR ARRAY; 10749000 - DEFINE DUMPE = 2:37:11#; COMMENT DUMPE IS THE 10750000 - CONCATENATE DEFINE FOR INSERTING10751000 - THE COUNTER ASSOCIATED WITH THIS10752000 - LABEL INTO THE FIRST ADDITIONAL 10753000 - WORD OF INFO; 10754000 - DEFINE LWRBND = RR5#; COMMENT LWRBND CONTAINS THE LOWER 10755000 - BOUND FOR MONITORED SUBSCRIPTED 10756000 - VARIABLES; 10757000 - DEFINE FORMATTYPE = RR5#; COMMENT FORMATTYPE IS THE 10758000 - FORMAT TYPE REFERRED TO IN THE 10759000 - COMMENTS FOR THE MERRIMAC 10760000 - ROUTINE DESCRIBING PRINTI; 10761000 - DEFINE FINALL = RR5#; COMMENT FINALL IS A TEMPORARY CELL 10762000 - USED TO HOLD L WHILE THE DUMP 10763000 - INDICATOR TEST CODE IS BEING 10764000 - GENERATED; 10765000 - DEFINE TESTLOC = RR6#; COMMENT TESTLOC CONTAINS THE 10766000 - LOCATION OF THE CODE THAT MUST BE 10767000 - GENERATED TO MAKE THE TEST TO 10768000 - DETERMINE WHETHER OR NOT DUMPING 10769000 - SHOULD OCCUR; 10770000 - DEFINE DUMPR = 24:37:11#; COMMENT DUMPR IS THE 10771000 - CONCATENATE DEFINE USED TO 10772000 - INSERT THE ADDRESS OF THE 10773000 - PROGRAM DESCRIPTOR FOR THE CODE 10774000 - GENERATED FROM THE DUMP 10775000 - DECLARATION; 10776000 - DEFINE DUMPLOC = RR7#; COMMENT DUMPLOC CONTAINS THE 10777000 - ADDRESS OF THE PROGRAM DESCRIPTOR 10778000 - THAT DESCRIBES THE CODE GENERATED 10779000 - BY DMUP; 10780000 - DEFINE ELBATWORD = RR8#; COMMENT ELBATWORD CONTAINS THE 10781000 - ELBAT WORD FOR THE DUMP LIST 10782000 - ELEMENT CURRENTLY BEING OPERATED 10783000 - ON; 10784000 - LABEL CALLPRINTI; COMMENT CALLPRINTI FINISHES THE CALL 10785000 - ON PRINTI. IT GENERATES THE CODE TO 10786000 - PASS TYPEV, POWERSOFTEN, ID, CHARI, 10787000 - FILE, AND FORMAT TYPE; 10788000 - DEFINE SUBSCTR = RR9#; COMMENT SUBSCTR CONTAINS THE 10789000 - DIMENSION NUMBER THAT IS CURRENTLY 10790000 - BEING WORKED ON; 10791000 - START:IF CHECK(FILEID,409) 10792000 - THEN GO TO EXIT; 10793000 - COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 10794000 - CHECKER(ELBAT[I]); 10795000 - FILEIDENT~ELBAT[I].ADDRESS; STEPIT; 10796000 - IF CHECK(LEFTPAREN,410) 10797000 - THEN GO TO EXIT; 10798000 - COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 10799000 - JUMPCHKNX; ADJUST; DUMPLOC~PROGDESCBLDR10800000 - (ADES,L,0); TESTLOC~L; L~L+3; 10801000 - LABELCTRINX~-1; EMITO(NOP); BUMPL; 10802000 - STARTCALL:EMITO(MKS); STEPIT; ELBATWORD~-ABS(ELBAT10803000 - [I]); 10804000 - IF RANGE(BOOARRAYID,INTARRAYID) 10805000 - THEN BEGIN COMMENT THIS CODE HANDLES ARRAYS AND 10806000 - SUBSCRIPTED VARIABLES; 10807000 - NODIM~DIMCTR~TAKEFRST.NODIMPART; 10808000 - IF STEPI = LFTBRKET 10809000 - THEN BEGIN COMMENT THIS CODE HANDLES SUBSCRIPTED10810000 - VARIABLES; 10811000 - STEPIT; AEXP; EMITO(DUP); 10812000 - SUBSCTR~1; 10813000 - IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10814000 - ).[35:13] ! 0 10815000 - THEN BEGIN COMMENT SUBTRACT OFF THE 10816000 - LOWER BOUND BEFORE INDEXING;10817000 - IF LWRBND.[46:2] = 0 10818000 - THEN EMIT(LWRBND) 10819000 - ELSE EMITV(LWRBND.[35:11]); 10820000 - EMIT(LWRBND.[23:12]); 10821000 - END; 10822000 - IF DIMCTR-SUBSCTR = 0 10823000 - THEN BEGIN COMMENT PASS SUBSCRIPT, 10824000 - VALUE,N; 10825000 - EMITV(ELBATWORD.ADDRESS); 10826000 - PASSN:EMITL(NODIM); 10827000 - IF CHECK(RTBRKET,411) 10828000 - THEN GO TO EXIT; 10829000 - COMMENT ERROR 411 MEANS 10830000 - DUMP LIST ELEMENT HAS WRONG 10831000 - NUMBER OF SUBSCRIPTS; 10832000 - FORMATTYPE~2; GO CALLPRINTI10833000 - END; 10834000 - EMITN(ELBATWORD.ADDRESS); 10835000 - SUBSLOOP:EMITO(LOD); STEPIT; AEXP; 10836000 - EMITL(JUNK); EMITO(SND); 10837000 - SUBSCTR~SUBSCTR+1; 10838000 - IF(LWRBND~TAKE(GIT(ELBATWORD)+SUBSCTR)10839000 - ).[35:13] ! 0 10840000 - THEN BEGIN COMMENT SUBTRACT OFF THE 10841000 - LOWER BOUND BEFORE INDEXING;10842000 - IF LWRBND.[46:2] = 0 10843000 - THEN EMIT(LWRBND) 10844000 - ELSE EMITV(LWRBND.[35:11]); 10845000 - EMIT(LWRBND.[23:12]); 10846000 - END; 10847000 - IF DIMCTR-SUBSCTR = 0 10848000 - THEN BEGIN COMMENT EMIT COC; 10849000 - EMITO(COC); EMITV(JUNK10850000 - ); EMITO(XCH); 10851000 - GO PASSN; 10852000 - END; 10853000 - EMITO(CDC); EMITV(JUNK);EMITO(XCH); 10854000 - IF CHECK(COMMA,412) 10855000 - THEN GO TO EXIT 10856000 - ELSE GO TO SUBSLOOP; 10857000 - COMMENT ERROR 412 MEANS DUMP LIST 10858000 - ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS10859000 - ; 10860000 - END; 10861000 - COMMENT THIS CODE HANDLES ARRAYS; 10862000 - IF ELCLASS ! COMMA AND ELCLASS ! RTPAREN 10863000 - THEN BEGIN COMMENT ERROR 413 MEANS IMPROPER 10864000 - ARRAY DUMP LIST ELEMENT; 10865000 - ERR(413); GO TO EXIT; 10866000 - END; 10867000 - EMITPAIR(ELBATWORD.ADDRESS,LOD);EMITL(NODIM); 10868000 - FORMATTYPE~4; I~I-1; GO CALLPRINTI; 10869000 - END; 10870000 - FORMATTYPE~1; 10871000 - IF RANGE(BOOID,INTID) 10872000 - THEN BEGIN COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 10873000 - EMITV(ELBATWORD.ADDRESS); GO CALLPRINTI; 10874000 - END; 10875000 - IF CHECK(LABELID,414) 10876000 - THEN GO TO EXIT; 10877000 - COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 10878000 - CODE HANDLES LABELS; 10879000 - PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]- 10880000 - IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10881000 - THEN GETSPACE(FALSE,-7) % LABEL DESCRIPTOR. 10882000 - ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10883000 - EMITV(LABELCTR[ 10884000 - LABELCTRINX]); PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34]10885000 - ,ELBATWORD); 10886000 - EMITL(3); IF FALSE THEN 10887000 - CALLPRINTI:EMITL(PASSTYPE(ELBATWORD)); EMITPAIR(GNAT( 10888000 - POWERSOFTEN),LOD); PASSALPHA(ELBATWORD); 10889000 - EMITPAIR(GNAT(CHARI),LOD); PASSMONFILE( 10890000 - FILEIDENT); 10891000 - EMITNUM(FORMATTYPE&CARDNUMBER[1:4:44]); 10891100 - EMITV(GNAT(PRINTI)); 10891200 - IF STEPI = COMMA 10892000 - THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10893000 - IF LABELCTRINX = 100 10894000 - THEN BEGIN COMMENT ERROR 415 MEANS LABELCTR IS 10895000 - ABOUT TO OVERFLOW WITH LABEL 10896000 - INFORMATION; 10897000 - ERR(415); GO TO EXIT; 10898000 - END; 10899000 - GO STARTCALL; 10900000 - END; 10901000 - IF CHECK(RTPAREN,416) 10902000 - THEN GO TO EXIT; 10903000 - COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 10904000 - DELIMETER; 10905000 - LEXIT~L; EMITL(0); EMITO(RTS); 10906000 - JUMPCHKX; STEPIT; 10907000 - IF CHECK(LABELID,417) 10908000 - THEN GO TO EXIT; 10909000 - COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 10910000 - PUT(TAKE(ELBATWORD~-ABS(ELBAT[I])) & ELBATWORD[1:1:34], 10911000 - ELBATWORD); 10912000 - IF NOT LOCAL(ELBATWORD) THEN FLAG(417); 10912100 - PUT(TAKEFRST & (LABELCTR[LABELCTRINX~LABELCTRINX+1]~ 10913000 - IF DUMPETEMP~TAKEFRST.DUMPEE = 0 10914000 - THEN DUMPETEMP:=GETSPACE(FALSE,-7) % LABEL DESCR. 10915000 - ELSE DUMPETEMP)[DUMPE],GIT(ELBATWORD)); 10916000 - EMITL(0); 10917000 - DO BEGIN COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;10918000 - EMITPAIR(LABELCTR[LABELCTRINX],SND) 10919000 - END 10920000 - UNTIL LABELCTRINX~LABELCTRINX-1 < 0; 10921000 - L~L-1; EMITO(STD); STEPIT; 10922000 - IF CHECK(COLON,418) 10923000 - THEN GO TO EXIT; 10924000 - COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 10925000 - FINALL~L; L~TESTLOC; STEPIT; 10926000 - IF (GT1 ~ TABLE(I) ! NONLITNO AND GT1 ! LITNO 10926500 - AND GT1 < REALID AND GT1 > INTID) OR (GT1 ~ TABLE(I+1) 10926510 - ! COMMA AND GT1 ! SEMICOLON) 10926520 - THEN BEGIN COMMENT ERROR 465-DUMP INDICATOR MUST BE 10926530 - UNSIGNED INTEGER OR SIMPLE VARIABLE; 10926540 - FLAG(465); GO TO EXIT; 10926550 - END; 10926560 - PRIMARY; EMITV(DUMPETEMP); 10927000 - EMITO(EQL); EMITB(BFC,TESTLOC+6,LEXIT); 10928000 - L~FINALL; PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[ 10929000 - DUMPR],GIT(ELBAT[I-3])); 10930000 - IF ELCLASS = COMMA 10931000 - THEN BEGIN COMMENT GO AROUND ONE MORE TIME; 10932000 - STEPIT; GO TO START; 10933000 - END; 10934000 - IF CHECK(SEMICOLON,419) 10935000 - THEN; 10936000 - COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 10937000 - EXIT:; 10938000 - END DMUP; 10939000 - COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 10940000 - AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 10941000 - OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 10942000 - SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 10943000 - OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 10944000 - IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 10945000 - A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 10946000 - SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 10947000 - SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC10948000 - SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 10949000 - THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 10950000 - JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 10951000 - TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 10952000 - SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 10953000 -BOOLEAN PROCEDURE SWITCHGEN(BEFORE,PD); 10954000 - VALUE BEFORE; BOOLEAN BEFORE; REAL PD; 10954100 - BEGIN 10955000 - LABEL LX,EXIT,BEF; 10956000 - REAL K,N,T1,TL; 10957000 - TL ~ L; 10958000 - EMIT(0); EMITV(JUNK); EMITO(GEQ); EMITV(JUNK); 10959000 - L ~ L+1; EMITO(GTR); EMITO(LOR); EMITV(JUNK); 10960000 - EMITO(DUP); EMITO(ADD); COMMENT WE HAVE GENERATED TEST 10961000 - AND PREPARATION FOR SWITCH-JUMP; 10962000 - GOTOG ~ FALSE; COMMENT IF WE COMPILE JUMP OUT WE KNOW; 10963000 - IF BEFORE THEN BEGIN STEPIT; GO TO BEF END; 10964000 - LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL 10965000 - THEN BEGIN 10966000 - INFO[0,N] ~ ELBAT[I]; 10967000 - IF N ~ N+1 = 256 10968000 - THEN BEGIN ERR(147); GO TO EXIT END; 10969000 - IF STEPI = COMMA THEN GO TO LX; 10970000 - EMITO(BFC); L ~ BUMPL; N ~ N-1; 10971000 - FOR K ~ 0 STEP 1 UNTIL N 10972000 - DO BEGIN COMMENT SAVE LINKS TO LABELS IN EDOC; 10973000 - EMIT((GT1~INFO[0,K]).[35:1]); 10974000 - EMIT(GT1) END; 10975000 - SWITCHGEN ~ FALSE END 10976000 - ELSE BEGIN 10977000 - BEF: L ~ BUMPL; N ~ N-1; 10978000 - PUT(TAKE(LASTINFO)&(PD:=PROGDESCBLDR(ADES,TL,PD)) 10978500 - [16:37:11],LASTINFO); % GET PRT LOC AND SAVE 10978600 - FOR K ~ 0 STEP 1 UNTIL N 10979000 - DO BEGIN COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 10980000 - ADJUST; T1 ~ L; 10981000 - EMITL(GNAT(GT1~INFO[0,K])); 10982000 - GENGO(GT1); 10983000 - INFO[0,K] ~ T1; 10984000 - EMITO(RTS); 10985000 - CONSTANTCLEAN END; 10986000 - I ~ I-1; N ~ N+1; 10987000 - DO BEGIN ADJUST; 10988000 - STEPIT; INFO[0,N] ~ L; 10989000 - IF N ~ N+1 = 256 10990000 - THEN BEGIN ERR(147); GO TO EXIT END; 10991000 - DEXP; EMITO(RTS) END 10992000 - UNTIL ELCLASS ! COMMA; ADJUST; 10993000 - EMITB(BFW,TL+12,L); EMITO(BFC); 10994000 - EMIT(0); EMITO(RTS); N ~ N-1; 10995000 - FOR K ~ 0 STEP 1 UNTIL N 10996000 - DO EMITB(BBW,BUMPL,INFO[0,K]); 10997000 - SWITCHGEN ~ TRUE END; 10998000 - T1 ~ L; 10999000 - L ~ TL+4; 11000000 - EMITL(N+1); 11001000 - L ~ T1; 12000000 - EXIT: END SWITCHGEN; 12001000 - PROCEDURE DBLSTMT; 12002000 - BEGIN 12003000 - REAL S,T; 12004000 - BOOLEAN B ; 12004100 - LABEL L1,L2,L3,L4,EXIT ; 12005000 - S~0; 12006000 - IF STEPI!LEFTPAREN THEN ERR(281) 12007000 - ELSE 12008000 - L1: BEGIN 12009000 - IF STEPI=COMMA THEN 12010000 - BEGIN 12011000 - DPTOG~TRUE; 12012000 - IF STEPI=ADOP THEN STEPIT; 12013000 - EMITNUM(NLO); 12014000 - EMITNUM(IF ELBAT[I-1].ADDRESS =SUB THEN -NHI ELSE NHI); 12015000 - DPTOG~FALSE; 12016000 - STEPIT; 12017000 - GO TO L2; 12018000 - END; 12019000 - IF TABLE(I+1)=COMMA THEN 12020000 - BEGIN 12021000 - IF ELCLASS=ADOP OR ELCLASS=MULOP THEN 12022000 - BEGIN 12023000 - EMITO(ELBAT[I].ADDRESS+1); 12024000 - L4: IF (S~S-1){0 THEN FLAG(282); STEPIT ; 12025000 - GO TO L3; 12026000 - END; 12027000 - IF ELCLASS=ASSIGNOP THEN 12028000 - BEGIN 12029000 - IF S~S-1<0 THEN FLAG(285); T~0; STEPIT ; 12030000 - DO 12031000 - BEGIN 12032000 - IF ELCLASS !COMMA THEN BEGIN ERR(284);GO EXIT END; 12033000 - STEPIT; 12034000 - B~ELCLASS=INTID OR ELCLASS=INTARRAYID 12034100 - OR ELCLASS=INTPROCID ; 12034110 - IF ELCLASS{INTID AND ELCLASS}REALID THEN 12035000 - BEGIN EMITN(ELBAT[I].ADDRESS); STEPIT END 12036000 - ELSE IF ELCLASS{INTPROCID AND ELCLASS}REALPROCID THEN12036100 - IF ELBAT[I].LINK ! PROINFO.LINK THEN FLAG(211) 12036200 - ELSE BEGIN EMITL(514); STEPIT END 12036300 - ELSE IF ELCLASS>INTARRAYID OR ELCLASSBOOID 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 IOTEMP THEN 13157030 - IOTEMP:=IOTEMPO DIV 4; CALL5; END 13157040 - ELSE BEGIN 13158000 - EMITL(0); CALL5; EMITO(MKS); EMITL(5) ; 13159000 - EMITN(SAVADDRSF); GT1~FILEATTRIBUTEHANDLER(FIO);13160000 - END ; 13161000 - WHILE ELCLASS=COMMA DO 13162000 - IF GT1~FILEATTRIBUTEINDX(TRUE)=0 THEN 13163000 - BEGIN ERR(291); GO START END 13164000 - ELSE BEGIN 13165000 - EMITO(MKS); EMITL(5); EMITN(SAVADDRSF) ; 13166000 - GT1~FILEATTRIBUTEHANDLER(FIO); 13167000 - END ; 13168000 - END ; 13169000 - END ; 13170000 - ARRAYFLAG~FALSE ; 13181000 - IF ELCLASS!RTPAREN THEN FLAG(29); 13182000 - COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 13183000 - IOBUFFSIZE~IOBUFFSIZE + 50 + ( CURRENT | IOTEMP); 13184000 -% VOID 13185000 -% VOID 13186000 - END 13187000 - UNTIL STEPI!COMMA; 13188000 - STOPENTRY~FALSE; 13189000 - END ELSE 13190000 - BEGIN 13191000 - IF G!FORMATV THEN FLAG(33) ELSE 13192000 - IF SPECTOG THEN ENTRY(FRMTID+REAL(GTA1[J-1]=SWITCHV))ELSE FORMATGEN13193000 - END; 13194000 - START: 13195000 - END; 13196000 - PROCEDURE HANDLESWLIST; 13196300 - BEGIN 13196310 - LABEL OVER; 13196320 - 13196330 - JUMPCHKX; 13196340 - STOPENTRY~ NOT SPECTOG; 13196350 - ENTRY(SUPERLISTID); 13196360 - IF SPECTOG THEN GO TO OVER; 13196370 - IF ELCLASS ! ASSIGNOP THEN FLAG(41); 13196380 - COMMENT MISSING ~; 13196390 - EMITO(MKS); 13196400 - CHECKDISJOINT(ADDRSF); 13196410 - G~L; L~L+1; 13196420 - EMITL(1); 13196430 - EMITL(1); 13196440 - EMITL(1); 13196450 - EMITV(5); COMMENT CREATE AN ARRAY TO HOLD 13196460 - LIST DESCRIPTORS FOR SWITCH LIST; 13196470 - COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 13196480 - J~-1; STOPENTRY ~ FALSE; 13196490 - DO 13196500 - BEGIN 13196510 - IF STEPI ! LISTID AND ELCLASS ! SUPERLISTID 13196520 - THEN BEGIN ERR(42); GO TO OVER END; 13196530 - PASSLIST; 13196540 - EMITL(J~J+1); 13196550 - EMITN(ADDRSF); 13196560 - EMITO(STD); COMMENT STORE LIST DESC IN ARRAY;13196570 - END 13196580 - UNTIL ELCLASS ! COMMA; 13196590 - GT2~L; L~G; EMITL(J+1); L~GT2; 13196600 - OVER: END OF HANDLESWLIST; 13196610 - PROCEDURE SCATTERELBAT; 13197000 - BEGIN 13198000 - REAL T; 13199000 - T ~ ELBAT[I]; 13200000 - KLASSF ~ T.CLASS; 13201000 - FORMALF ~ BOOLEAN(T.FORMAL); 13202000 - VONF ~ BOOLEAN(T.VO); 13203000 - LEVELF ~ T.LVL; 13204000 - ADDRSF ~ T.ADDRESS; 13205000 - INCRF ~ T.INCR; 13206000 - LINKF ~ T.LINK; 13207000 - END SCATTERELBAT; 13208000 -PROCEDURE CHKSOB; 13209000 - IF GTA1[J~J-1]!0 THEN FLAG(23); 13210000 -DEFINE SUBOP=48#, 13211000 - ADDC=532480#, 13212000 - SUBC=1581056#, 13213000 - EMITSTORE=EMITPAIR#; 13214000 - PROCEDURE PURGE(STOPPER); 13215000 - VALUE STOPPER; 13216000 - REAL STOPPER; 13217000 - BEGIN 13218000 - INTEGER POINTER; 13219000 - LABEL RECOV; DEFINE ELCLASS = KLASSF#; 13220000 - REAL J,N,OCR,TL,ADD; 13221000 - POINTER~LASTINFO; 13222000 - WHILE POINTER } STOPPER 13223000 - DO 13224000 - BEGIN 13225000 - IF ELCLASS~(GT1~TAKE(POINTER)).CLASS=NONLITNO 13226000 - THEN BEGIN 13227000 - NCII~NCII-1; 13228000 - EMITNUM(TAKE(POINTER+1)); 13229000 - EMITSTORE(MAXSTACK,STD); 13230000 - MAXSTACK~(G~MAXSTACK)+1; 13231000 - J~L; L~GT1.LINK; 13232000 - DO 13233000 - BEGIN 13234000 - GT4~GET(L); 13235000 - EMITV(G) 13236000 - END 13237000 - UNTIL (L~GT4)=4095; 13238000 - L~J; 13239000 - POINTER~POINTER-GT1.INCR 13240000 - END 13241000 - ELSE 13242000 - BEGIN 13243000 - IF NOT BOOLEAN(GT1.FORMAL) 13244000 - THEN BEGIN 13245000 - IF ELCLASS = LABELID 13246000 - THEN BEGIN 13247000 - ADD ~ GT1.ADDRESS; 13248000 - IF NOT BOOLEAN(OCR~TAKE(GIT(POINTER))).[1:1] 13249000 - THEN IF OCR.[36:12] ! 0 OR ADD ! 0 13250000 - THEN BEGIN GT1 ~ 160; GO TO RECOV END; 13251000 - IF ADD ! 0 THEN GT1~PROGDESCBLDR(2,OCR,ADD) END 13252000 - ELSE IF ELCLASS = SWITCHID 13253000 - THEN BEGIN 13254000 - IF TAKE(POINTER+1) < 0 13255000 - THEN BEGIN GT1 ~ 162; GO TO RECOV END; 13256000 - OCR ~(J ~ TAKE(GIT(POINTER))).[24:12]; 13257000 - N ~ GET( (J~J.[36:12])+4); TL ~ L; 13258000 - IF ADD ~ GT1.ADDRESS ! 0 13259000 - THEN BEGIN 13260000 - GT5 ~ PROGDESCBLDR(0,J,ADD); 13261000 - IF OCR ! 0 13262000 - THEN BEGIN L~OCR-2; CALLSWITCH(POINTER); EMITO(BFW);END; 13263000 - L~J+11; EMITL(15); EMITO(RTS); 13264000 - FOR J ~ 4 STEP 4 UNTIL N 13265000 - DO BEGIN 13266000 - EMITL(GNAT(GET(L)|4096+GET(L+1))); 13267000 - EMITO(RTS) END END 13268000 - ELSE BEGIN 13269000 - L ~ J+13; 13270000 - FOR J ~ 4 STEP 4 UNTIL N 13271000 - DO BEGIN 13272000 - GT1 ~ GET(L)|4096+GET(L+1); 13273000 - GOGEN(GT1,BFW) END;END; 13274000 - 13275000 - 13276000 - L ~ TL END 13277000 - ELSE IF ELCLASS } PROCID AND ELCLASS { INTPROCID 13278000 - THEN IF TAKE(POINTER+1) < 0 13279000 - THEN BEGIN GT1 ~ 161; 13280000 - RECOV: MOVE(9,INFO[POINTER.LINKR,POINTER.LINKC],ACCUM);13281000 - Q ~ ACCUM[1]; FLAG(GT1); ERRORTOG ~ TRUE END 13282000 - END; 13283000 - XREFDUMP(POINTER); % DUMP XREF INFO 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 13310050 - IF (ACCUM[0].CLASS ! DEFINEID OR NOT 13310075 - BOOLEAN(ACCUM[0].FORMAL)) THEN % NOT DEFINE PARAMETER 13310080 - BEGIN 13310100 - XREFINFO[NEXTINFO] := 13310200 - IF SPECTOG THEN 13310300 - XREFINFO[ELBAT[I]] 13310350 - ELSE 13310400 - ((XLUN := XLUN + 1) & SGNO SEGNOF); 13310450 - IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY 13310500 - XMARK(DECLREF) 13310525 - ELSE 13310550 - XREFIT(NEXTINFO,CARDNUMBER,IF PTOG AND NOT STREAMTOG 13310575 - THEN NORMALREF ELSE DECLREF); 13310580 - END 13310600 - ELSE % DEFINE PARAMETERS - DONT CROSS REF. 13310700 - XREFINFO[NEXTINFO] := 0 13310750 - ELSE 13310800 - IF DEFINING.[1:1] THEN % WE ARE DOING XREFING 13310900 - XREFINFO[NEXTINFO] := 0; 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) 13339200 - ELSE 13339300 - ELSE 13339400 - IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION 13339500 - FLAG(1); 13340000 - VONF~P2; 13341000 - IF ((FORMALF~PTOG)OR (STREAMTOG AND NOT STOPGSP)) AND NOT P2 13342000 - THEN ADDRSF ~ PJ ~PJ+1 13343000 - ELSE IF STOPGSP THEN ADDRSF ~ 0 13344000 - ELSE ADDRSF:=GETSPACE(P2,1); % ID IN ACCUM[1]. 13345000 - IF TYPE{INTARRAYID AND TYPE}BOOARRAYID 13346000 - THEN IF P2 THEN BEGIN COMMENT OWN ARRAY; 13347000 - EMITL(ADDRSF); EMITN(10); 13347500 - END 13347510 - ELSE CHECKDISJOINT(ADDRSF); 13347520 - END; 13348000 - IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 13348100 - XREFPT~XREFPT-REAL(ELBAT[I]!0); % GET RID OF LAST CREF 13348200 - KLASSF~TYPE; MAKEUPACCUM;E; J~J+1; 13349000 - END 13350000 - UNTIL STEPI!COMMA OR STOPENTRY; GTA1[0]~J 13351000 - END; 13352000 - PROCEDURE UNHOOK; 13353000 -COMMENT 13354000 - UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 13355000 - FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 13356000 - E WILL WORK AS NORMAL. ;13357000 - BEGIN 13358000 - REAL LINKT,A,LINKP; 13359000 - LABEL L; 13360000 - LINKT~STACKHEAD[SCRAM] ; LINKP~ELBAT[I].LINK; 13361000 - IF LINKT=LINKP THEN STACKHEAD[SCRAM]~TAKE(LINKT).LINK 13362000 - ELSE 13363000 - L: IF A~TAKE(LINKT).LINK=LINKP 13364000 - THEN PUT((TAKE(LINKT))&(TAKE(A))[35:35:13],LINKT) 13365000 - ELSE BEGIN LINKT~A; GO TO L END; 13366000 - END; 13367000 -PROCEDURE MAKEUPACCUM; 13368000 - BEGIN 13369000 - IF PTOG 13370000 - THEN GT1~LEVELF ELSE GT1~LEVEL; 13371000 - ACCUM[0]~ ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] 13372000 - & REAL(VONF)[10:47:1] & GT1[11:43:5] &ADDRSF[16:37:11]13373000 - ) 13374000 - END; 13375000 -PROCEDURE ARRAE; 13376000 -COMMENT 13377000 - ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 13378000 - IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 13379000 - STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 13380000 - MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 13381000 - EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 13382000 - ARRAY A[0:10], 13383000 - MKS (THIS MARKS STACK TO CUT BACK AFTER COM)13384000 - DESC A (THIS FORMS A DESCRITOR POINTING TO 13385000 - THE ADDRESS OF A) 13386000 - LITC 11 (SIZE OF ARRAY) 13387000 - LITC 1 (NUMBER OF DIMENSIONS) 13388000 - LITC 1 (NUMBER OF ARRAYS) 13389000 - LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 13390000 - NON OWN ARRAYS) 13391000 - COM (COMMUNICATE TO MCP TO GET STORAGE) 13392000 - DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 13393000 - STACK) 13394000 - OWN ARRAY B,C[0:X,-1:10], 13395000 - MKS 13396000 - DESC B 13397000 - DESC C 13398000 - LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 13399000 - OPDC X 13400000 - LITC JUNK (JUNK CELL) 13401000 - ISN (INTEGERIZE UPPER BOUND) 13402000 - LITC 1 (COMPUTE SIZE 13403000 - ADD OF DIMENSION 13404000 - LITC 1 (LOWER BOUND,SECOND DIMENSION) 13405000 - CHS 13406000 - LITC 12 (SIZE SECOND DIMENSION) 13407000 - LITC 2 (NUMBER DIMENSIONS) 13408000 - LITC 2 (NUMBER ARRAYS) 13409000 - LITC OWNCOM (OWN ARRAY COMMUNICATE) 13410000 - COM 13411000 - DESC XITR 13412000 - SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 13413000 - MKS 13414000 - DESC D 13415000 - DESC E 13416000 - DESC F 13417000 - OPDC X 13418000 - LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 13419000 - ISN (PUT INTEGERIZED LOWER BOUND AWAY) 13420000 - DUP (MUST PASS LOWER BOUND FOR OWN) 13421000 - OPDC Y (INTEGERIZE 13422000 - LITC JUNK UPPER 13423000 - ISN BOUND) 13424000 - XCH (COMPUTE SIZE OF FIRST DIMENSION 13425000 - SUB UPPER 13426000 - LITC 1 -LOWER 13427000 - ADD +1) 13428000 - OPDC M (COMPUTER LOWER BOUND 13429000 - OPDC N SECOND DIM) 13430000 - ADD 13431000 - LITC MNT (GET CELL FOR SECOND LOWER BOUND) 13432000 - ISN (INTEGERIZE) 13433000 - DUP (PASS LOWER BOUND FOR OWN) 13434000 - OPDC T 13435000 - MUL V 13436000 - LITC JUNK (INTEGERIZE 13437000 - ISN UPPER) 13438000 - XCH (COMPUTE 13439000 - SUB SIZE 13440000 - LITC 1 13441000 - ADD ) 13442000 - LITC 2 (NUMBER DIMENSIONS) 13443000 - LITC 3 (NUMBER ARRAYS) 13444000 - LITC SAVON (SAVE OWN LITERAL FOR COM) 13445000 - COM 13446000 - DESC XITR ; 13447000 - BEGIN 13448000 - REAL T1,T2,T3,K,LBJ,ARPROGS,SAVEDIM,T,T4,SAVEINFO,SAVEINFO2; 13449000 - BOOLEAN LLITOG,ULITOG; 13450000 -REAL ADDCON; 13451000 - LABEL CSZ,BETA1,TWO,START,SLB,BETA2; 13452000 - ARRAYFLAG ~ TRUE; 13452100 - TYPEV~REALARRAYID; 13453000 - IF T1~GTA1[J~J-1]=0 THEN J~J+1 13454000 -ELSE 13455000 - IF T1=OWNV THEN 13456000 - BEGIN P2:=TRUE;IF SPECTOG THEN FLAG(13) END 13457000120324PK -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~T3|4+ADDCON 13494000 - END 13495000 - ELSE 13496000 - BEGIN 13497000 - LLITOG~FALSE; 13498000 - IF T1!0 THEN I~I-1; 13499000 - T2:=GETSPACE(P2,-1);%TEMP. 13500000 - AEXP;EMITSTORE(T2,ISN); 13501000 - T2~T2|4+SUBC+2; 13502000 - IF ELCLASS!COLON THEN 13503000 - FLAG(017);I~I-1 13504000 - END; 13505000 - IF P2 THEN 13506000 - BEGIN 13507000 - IF LLITOG AND T3=0 THEN EMITL(0);13508000 - ARPROGS~L;EMITO(DUP); 13509000 - END; 13510000 - IF ELCLASS~TABLE(I~I+2)=LITNO THEN 13511000 - BEGIN 13512000 - IF T~TABLE(I~I+1)=COMMA OR 13513000 - T~RTBRKET 13514000 - THEN 13515000 - BEGIN 13516000 - EMITL(T4~ELBAT[I-1].ADDRESS);13517000 - ULITOG~TRUE;GO TO CSZ 13518000 - END 13519000 - ELSE 13520000 - I~I-1 13521000 - END; 13522000 - ULITOG~FALSE; 13523000 - AEXP; 13524000 - EMITL(JUNK); 13525000 - 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=0) 13540000 - OR P2 13541000 - THEN 13542000 - BEGIN 13543000 - EMITO(XCH);EMITO(SUB) 13544000 - END;EMITL(1);EMITO(ADD) 13545000 - END; 13546000 -SLB:PUTNBUMP(T2);LBJ~LBJ+1;IF T~TABLE(I)=COMMA THEN GO TO TWO 13547000 - ELSE 13548000 - IF T!RTBRKET THEN FLAG(018); 13549000 - IF NOT SPECTOG THEN 13550000 - BEGIN 13551000 -COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 13551400 - NOOFARRAYS:=NOOFARRAYS + GTA1[0]; 13551500 - EMITL(LBJ);EMITL(GTA1[0]); 13552000 - IF P3 AND P4 THEN FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 13552500 - EMITL(REAL(P3)+2|REAL(P2)+REAL(P4)|64); 13553000 - EMITV(5) 13554000 - END; 13555000 - PUT(LBJ,SAVEINFO2-1); 13556000 - DO BEGIN 13557000 - T~TAKE(SAVEINFO); 13558000 - K~T.INCR; 13559000 - T.INCR~SAVEINFO2-SAVEINFO-1; 13560000 - PUT(T,SAVEINFO); 13561000 - END 13562000 - UNTIL SAVEINFO~SAVEINFO+K=SAVEINFO2-1; 13563000 - IF STEPI!COMMA THEN GO TO START; 13564000 - IF NOT SPECTOG THEN EMITO(MKS); 13565000 - SAVEINFO~NEXTINFO; 13566000 - I~I+1;ENTRY(TYPEV);SAVEINFO2~NEXTINFO~NEXTINFO+1;GO TO BETA1; 13567000 -BETA2: 13568000 - IF T~ TABLE(I~I+1)=COMMA OR T=RTBRKET 13569000 - THEN 13570000 - BEGIN 13571000 - IF ELCLASS~TABLE(I-1)=LITNO 13572000 - THEN 13573000 - BEGIN 13574000 - T3~ELBAT[I-1].ADDRESS; 13575000 - IF T1= SUBOP THEN 13576000 - ADDCON ~ADDC 13577000 - ELSE 13578000 - ADDCON ~SUBC; 13579000 - T2~T3|4+ADDCON; GO TO SLB; 13580000 - END; 13581000 - IF ELCLASS=FACTOP THEN 13582000 - BEGIN 13583000 - T2~-SUBC; GO TO SLB 13584000 - END 13585000 - END; 13586000 - FLAG(019); 13587000 -START: ARRAYFLAG ~ FALSE END; 13588000 - PROCEDURE PUTNBUMP(X); 13589000 - VALUE X; 13590000 - REAL X; 13591000 - BEGIN 13592000 - INFO[NEXTINFO.LINKR,NEXTINFO.LINKC]~X; 13593000 - NEXTINFO~NEXTINFO+1 13594000 - END ; 13595000 - PROCEDURE 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 THEN L IS BUMPED 13619000 - AND SAVED FOR A LATER BRANCH; 13620000 -IF NOT SPECTOG THEN 13621000 -BEGIN 13622000 - IF FIRSTX!4095 13623000 - THEN 13624000 - BEGIN 13625000 - IF NOT AJUMP 13626000 - THEN 13627000 - SAVEL~BUMPL; 13628000 - AJUMP~TRUE 13629000 - END;ADJUST 13630000 -END; 13631000 -PROCEDURE SEGMENTSTART; 13632000 - BEGIN 13632100 - IF NOHEADING THEN DATIME; 13633000 - IF SINGLTOG THEN WRITE(LINE,PRINTSEGNO,SGAVL) 13633100 - ELSE WRITE(LINE[DBL],PRINTSEGNO,SGAVL); 13633200 - END SEGMENTSTART; 13633300 -PROCEDURE SEGMENT(SIZE,NO,NOO); 13634000 - VALUE SIZE,NO,NOO; 13635000 - REAL SIZE,NO,NOO; 13636000 - BEGIN 13637000 - INTEGER DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT 13637100 - % IS NOT TOO BIG 13637200 - PDPRT[PDINX.[37:5],PDINX.[42:6]] := 13638000 - SIZE & NO[28:38:10] & 13639000 - MOVEANDBLOCK(EDOC,ABS(SIZE),-ABS(NO))[13:33:15] & 13640000 - REAL(SAVEPRTOG)[3:47:1]; 13641000 - PDINX:=PDINX+1; SIZE:=ABS(SIZE); 13642000 - IF SIZE>SEGSIZEMAX THEN SEGSIZEMAX:=SIZE; 13643000 - AKKUM:=AKKUM+SIZE; 13644000 - IF SAVEPRTOG THEN AUXMEMREQ:=AUXMEMREQ+16|(SIZE.[38:6]+1); 13645000 - IF LISTER OR SEGSTOG THEN 13646000 - BEGIN 13647000 - IF NOHEADING THEN DATIME; 13648000 - IF SINGLTOG THEN WRITE(LINE,PRINTSIZE,NO,SIZE,NOO) 13649000 - ELSE WRITE(LINE,PRINTSIZE,NO,SIZE,NOO); 13650000 - END; 13651000 - LDICT[NO.[38:3],NO.[41:7]] := 13652000 - IF BUILDLINE THEN 13653000 - MOVENADBLOCK(ENIL,ENILPTR+1,4) & SIZE[18:33:15] 13654000 - ELSE -1; 13655000 - END OF SEGMENT; 13656000 - 13697000 - 13698000 - 13699000 - 13700000 - 13701000 - 13702000 - 13703000 - 13704000 - 13705000 - 13706000 - 13707000 - 13708000 - 13709000 - 13710000 - 13711000 - 13712000 - 13713000 -PROCEDURE ENTER(TYPE); VALUE TYPE; INTEGER TYPE; 13714000 - BEGIN 13715000 - G:=GTA1[J:=J-1]; 13716000 - IF NOT SPECTOG THEN 13717000 - BEGIN 13718000 - IF NOT P2 THEN 13719000 - IF P2:=(G=OWNV) THEN G:=GTA1[J:=J-1]; 13720000 - IF NOT P3 THEN 13721000 - IF P3:=(G=SAVEV) THEN G:=GTA1[J:=J-1]; 13722000 - IF NOT P4 THEN 13723000 - IF P4:=(G=AUXMEMV) THEN G:=GTA1[J:=J-1]; 13724000 - END; 13725000 - IF G!0 THEN FLAG(25) ELSE ENTRY(TYPE) 13726000 - END ENTER; 13727000 - 13728000 - 13729000 - 13730000 -PROCEDURE HTTEOAP(GOTSTORAGE,RELAD,STOPPER,PRTAD); 13731000 - VALUE GOTSTORAGE,RELAD,STOPPER,PRTAD; 13732000 - BOOLEAN GOTSTORAGE; 13733000 - REAL RELAD,STOPPER,PRTAD; 13734000 - BEGIN 13735000 - BOOLEAN BT; 13736000 - REAL K,LS; 13737000 - LS~RELAD; 13738000 - BT~JUMPCTR=LEVEL; 13739000 - IF FUNCTOG 13740000 - THEN 13741000 - BEGIN 13742000 - EMITV(514); 13743000 - EMITO(RTN) 13744000 - END 13745000 - ELSE 13746000 - EMITO(XIT); 13747000 - IF STACKCTR>MAXSTACK THEN MAXSTACK~STACKCTR; 13748000 - CONSTANTCLEAN; 13749000 - IF K~MAXSTACK-514>0 OR GOTSTORAGE OR BT OR NCII>0 OR FAULTOG.[46:1] 13750000 - THEN 13751000 - BEGIN ADJUST;LS~L; 13752000 - IF BT OR GOTSTORAGE OR FAULTOG.[46:1] 13753000 - THEN 13754000 - BEGIN 13755000 -% 13755500 - EMITV(BLOCKCTR); 13756000 - EMITL(1); 13757000 - EMITO(ADD); 13758000 - IF GOTSTORAGE OR FAULTOG.[46:1] 13759000 - THEN 13760000 - EMITSTORE(BLOCKCTR,SND) 13761000 - END 13762000 -% 13762500 - ELSE EMITL(0); 13763000 - K~K+NCII; 13764000 - WHILE K~K-1}0 13765000 - DO EMITL(0); 13766000 - PURGE(STOPPER); 13767000 - IF FAULTLEVEL{LEVEL THEN 13767100 - BEGIN IF FAULTLEVEL=LEVEL THEN FAULTLEVEL~32; 13767200 - EMITPAIR(0,MDS); EMITO(CHS); 13767300 - END OF THIS PART OF ERROR KLUDGE; 13767400 - EMIT(0); % DC & DISK 13767500 - BUMPL; 13768000 - 13768100 - EMITB(BBC,L,IF RELAD=4095 THEN 0 ELSE RELAD) ; % DC & DISK 13769000 - CONSTANTCLEAN 13770000 - END ELSE PURGE(STOPPER); 13771000 - Z~PROGDESCBLDR(PDES,IF LS=4095 THEN 0 ELSE LS,PRTAD); 13772000 - END HTTEOAP; 13773000 -PROCEDURE FORMATGEN; 13774000 - BEGIN 13775000 - INTEGER PRT;LABEL L; 13776000 - BOOLEAN TB2; 13777000 - ARRAY TEDOC[0:7,0:127]; 13777500 - MOVECODE(TEDOC,EDOC); 13777600 - BUILDLINE ~ BOOLEAN(2|REAL(BUILDLINE)) ; 13777700 - TB2~GTA1[J-1]=SWITCHV; 13778000 - GT5~SGNO; 13779000 -L: GT1:=(2|SGAVL-1)&2[4:46:2]; STOPENTRY:=TRUE; 13780000 - IF LISTER OR SEGSTOG THEN SEGMENTSTART; 13780002 - SGNO~SGAVL; 13781000 - 13782000 - F:=0; PRT:=GETSPACE(TRUE,1);STOPGSP:=TRUE; % FORMAT. 13783000 - Z~PROGDESCBLDR(LDES,0,PRT); 13784000 - IF TB2 THEN 13785000 - BEGIN 13786000 - ENTRY(SUPERFRMTID);IF ELCLASS!ASSIGNOP THEN FLAG(36); 13787000 - PUT(TAKE(LASTINFO)&PRT[16:37:11],LASTINFO); 13788000 - RR4~NEXTINFO;PUTNBUMP(0); 13789000 - DO 13790000 - BEGIN PUTNBUMP(F); IF STEPI=LEFTPAREN THEN FLAG(37); 13791000 - ELCLASS:="<"; 13791050 - TB1~FORMATPHRASE; 13792000 - END 13793000 - UNTIL ELCLASS!","; 13794000 - RR3~NEXTINFO-1;NEXTINFO~RR4;PUTNBUMP(F); 13795000 - DO 13796000 - WHIPOUT(TAKE(RR4~RR4+1)) 13797000 - UNTIL RR4=RR3; IF F>1022 THEN FLAG(38); 13798000 - 13799000 - END ELSE 13800000 - BEGIN 13801000 - I~I-1; 13802000 - DO 13803000 - BEGIN 13804000 - STOPDEFINE~TRUE;STEPIT ; 13805000 - ENTRY(FRMTID); IF ELCLASS!LEFTPAREN THEN FLAG(32); ELCLASS:="<";13806000 - PUT(TAKE(LASTINFO)&PRT[16:37:11]&F[27:40:8],LASTINFO); 13807000 - TB1~FORMATPHRASE; 13808000 - END 13809000 - UNTIL ELCLASS!"," OR TB1~F}256 ; 13810000 - 13811000 - 13812000 - END; 13813000 - SEGMENT(-F,SGNO,GT5);SGAVL~SGAVL+1; 13814000 - IF TB1 AND ELCLASS="," THEN BEGIN I~I+1;GO TO L END; 13815000 - IF ELCLASS!";" THEN ELBAT[I]~0 ELSE ELBAT[I].CLASS~SEMICOLON; 13816000 - STOPGSP~STOPENTRY~FALSE; 13817000 - SGNO~GT5; 13818000 - MOVECODE(TEDOC,EDOC); 13818500 - BUILDLINE ~ BUILDLINE.[46:1] ; 13818600 - END FORMATGEN; 13819000 -PROCEDURE CHECKBOUNDLVL ; 13819100 - COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 13819200 - DECLARED AT SAME LEVEL; 13819300 - IF NOT SPECTOG AND ELBAT[I].LVL=LEVEL 13819400 - THEN FLAG(IF REAL(ARRAYFLAG)=3 THEN 509 ELSE 46) ; 13819410 - COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 13819500 - ARARY DECLARATION; 13819600 - PROCEDURE FAULTDEC; COMMENT FAULTDEC HANDLES THE MONITOR 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 GT10 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; 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; 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: 14269020 - BEGIN 14269040 - REAL SAVEINFO, SB, NB; 14269060 - BOOLEAN FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC. 14269080 - LABEL EXIT, SAVEIT; 14269100 - STOPENTRY := STOPGSP := TRUE; 14269120 - I := I - 1; 14269140 - DO 14269160 - BEGIN 14269180 - STOPDEFINE := TRUE; 14269200 - STEPIT; 14269220 - ENTRY(FIELDID); 14269240 - SAVEINFO := LASTINFO; 14269260 - IF ELCLASS = RELOP AND ACCUM[1] = "1=0000" THEN 14269280 - BEGIN 14269300 - IF STEPI = LFTBRKET THEN % REMEMBER THIS 14269320 - BEGIN 14269340 - FOUNDLB := TRUE; 14269360 - STEPIT; 14269380 - END 14269400 - ELSE 14269420 - FOUNDLB := FALSE; 14269440 - IF ELCLASS = FIELDID THEN 14269442 - BEGIN 14269444 - SB := ELBAT[I].SBITF; 14269446 - NB := ELBAT[I].NBITF; 14269448 - GO TO SAVEIT; 14269450 - END; 14269452 - IF ELCLASS = LITNO THEN 14269460 - IF STEPI = COLON THEN 14269480 - IF STEPI = LITNO THEN 14269500 - IF (SB := ELBAT[I-2].ADDRESS) | 14269520 - (NB := ELBAT[I].ADDRESS) ! 0 AND 14269540 - SB + NB { 48 THEN 14269560 - BEGIN 14269580 - SAVEIT: 14269590 - PUT(TAKE(SAVEINFO) & SB SBITF & NB NBITF, 14269600 - SAVEINFO); 14269620 - STEPIT; 14269640 - IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. 14269660 - IF ELCLASS = RTBRKET THEN 14269680 - BEGIN 14269700 - STEPIT; 14269705 - GO TO EXIT; 14269710 - END 14269715 - ELSE 14269720 - ELSE 14269740 - GO TO EXIT; 14269760 - END; 14269780 - END; 14269800 - FLAG(114); 14269820 - DO STEPIT UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; 14269840 - EXIT: 14269860 - END 14269880 - UNTIL 14269900 - ELCLASS ! COMMA; 14269920 - STOPENTRY := STOPGSP := FALSE; 14269940 - END; 14269960 - GO TO START; 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 ELSE14308000 - BEGIN 14309000 -IF G ~ TAKE(LINKF+1) } 0 THEN FLAG(006) ELSE PUT(-G,LINKF+1) ; 14310000 - XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST 14310500 - % XREF ENTRY AS A DECLARATION. 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;G~PROGDESCBLDR(CHAR,L,PROAD);PJ~P; 14387000 - PTOG~FALSE; 14388000 - IF FUNCTOG 14389000 - THEN 14390000 - PUT((Z~TAKE(PROINFO))&LOCLID[2:41:7]&(PJ~PJ+1)[16:37:11] 14391000 - , PROINFO); 14392000 - IF STEPI=BEGINV 14393000 - THEN 14394000 - BEGIN 14395000 - WHILE STEPI=DECLARATORS OR ELCLASS=LOCALV 14396000 - DO 14397000 - BEGIN 14398000 - IF ELBAT[I].ADDRESS=LABELV 14399000 - THEN 14400000 - BEGIN 14401000 - STOPDEFINE~STOPGSP~STOPENTRY~TRUE; 14402000 - DO BEGIN STOPDEFINE~TRUE;STEPIT;ENTRY(STLABID);PUTNBUMP(0) END UNTIL14403000 - ELCLASS!COMMA;STOPGSP~STOPENTRY~FALSE 14404000 - END 14405000 - ELSE 14406000 - BEGIN 14407000 - I+I+1; 14408000 - ENTRY(LOCLID) 14409000 - END 14410000 - END; 14411000 - COMPOUNDTAIL 14412000 - END 14413000 - ELSE 14414000 - STREAMSTMT ; 14415000 - COMMENT THE FOLLOWING BLOCK CONSTITUTES THE STREAM PROCEDURE PURGE; 14416000 - BEGIN 14417000 - REAL NLOC,NLAB; 14418000 - DEFINE SES=18#,SED=6#,TRW=5#; 14419000 - DEFINE RSA = 43 #; 14419100 - DEFINE LOC=[36:12]#,LASTGT=[24:12]#; 14420000 - J~ LASTINFO; 14421000 - NLOC~NLAB~0; 14422000 - DO 14423000 - BEGIN 14424000 - IF(GT1~TAKE(J)).CLASS=LOCLID THEN 14425000 - BEGIN 14426000 - IF BOOLEAN(GT1.FORMAL) THEN 14427000 - BEGIN 14428000 - IF GT1<0 THEN 14429000 - PUT(TAKE(GT2~MARK+P-GT1.ADDRESS+1)&FILEID[2:41:7] 14430000 - ,GT2); 14431000 - END 14432000 - ELSE NLOC~NLOC+1; 14433000 - END 14434000 - ELSE 14435000 - BEGIN 14436000 - IF GT1.ADDRESS!0 THEN NLAB~NLAB+1; 14437000 - IF(GT3~TAKE(GIT(J))).LASTGT!0 AND GT3.LOC =0 THEN 14438000 - BEGIN 14439000 - MOVE(9,INFO[0,J],ACCUM[0]); 14440000 - Q~ACCUM[1]; 14441000 - FLAG(267); 14442000 - ERRORTOG~TRUE; 14443000 - END; 14444000 - END; 14445000 - XREFDUMP(J); % DUMP XREF INFO 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 - 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; 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 15075550 - % ON LEFT HAND SIDE OF ASSIGNMENT SO WE 15075551 - % CAN XREF IT CORRECTLY. 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 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; 15091000 - XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. 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; 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; 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 15113100 - IF P1! FS THEN 15114000 - BEGIN 15115000 - ERR(201); % PARTIAL WORD NOT LEFT-MOST 15115100 - GO TO EXIT; 15115200 - END; 15115300 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); 15116000 - GO TO L1; 15116100 - END; 15116200 - 15117000 - END ; 15118000 - IF P1 ! FP THEN BEGIN ERR(202); GO TO EXIT END; 15119000 -COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 15120000 - BY A LEFT ARROW OR PERIOD *;15121000 -COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 15122000 - LEFT-MOST OF A LEFT PART LIST *;15123000 - EMITI(TALL,T1,T2); 15124000 - 15125000 - END ; 15126000 - EXIT: END OF BLOCK OF SIMPLE VARIABLES 15127000 - ELSE 15128000 - COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 15129000 - VARIABLES: 15130000 - 1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 15131000 - 2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 15132000 - 3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 15133000 - 4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 15134000 - 5. V[R] ~ ,ASSIGNMENT TO ARRAY ELEMENT. 15135000 - 6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 15136000 - R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 15137000 - IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 15138000 - IS EMITTED FOR THE ABOVE CASES: 15139000 - 1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 15140000 - DIMENSION. THE CODE EMITTED IS: 15141000 - VL,LOD . 15142000 - EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 15143000 - 2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.15144000 - EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE15145000 - OF CODE: 15146000 - AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 15147000 - ,LOD. 15148000 - FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 15149000 - PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 15150000 - THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 15151000 - PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,15152000 - [* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 15153000 - NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 15154000 - EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 15155000 - EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A15156000 - . THE SPECIFIC ROW DEPENDS UPON THE 15157000 - VALUES OF THE K-1 SUBSCRIPTS. 15158000 - FOR THE REMAINING CASES, 15159000 - SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 15160000 - HOWEVER,THE ACTUAL SEQUENCES ARE: 15161000 - ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.15162000 - K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 15163000 - ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 15164000 - SUBSCRIPTS,IF K>1. 15165000 - AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 15166000 - AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 15167000 - EMITTED. 15168000 - 3. ADD THE SEQUENCE: 15169000 - IF FIRST SUBSCRIPT THEN VV ELSE COC. 15170000 - EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 15171000 - 4. ADD THE SEQUENCE: 15172000 - IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL. 15173000 - XCH,T. 15174000 - 5. ADD THE SEQUENCE: 15175000 - IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 15176000 - XCH,~. 15177000 - 6. ADD THE SEQUENCE: 15178000 - IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD. 15179000 - EXP,T, XCH,~. 15180000 - EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 15181000 - SIMPLE VARIABLE BLOCK. ; 15182000 - BEGIN 15183000 - LABEL EXIT,LAST,NEXT ; 15184000 - INTEGER THENUMBEROFDECLAREDDIMENSIONS; 15184100 - DEFINE NODIM = RR1#; COMMENT NODIM CONTAINS THE NUMBER OF15185000 - DIMENSIONS OF A MONITORED SUBSCRIPTED 15186000 - VARIABLE; 15187000 - DEFINE TESTVARB = RR2#; COMMENT TESTVARB CONTAINS THE 15188000 - INDEX OF THE LAST ENTRY IN INFO 15189000 - FOR A MONITORED SUBSCRIPTED 15190000 - VARIABLE; 15191000 - DEFINE INC = RR3#; COMMENT INC IS A COUNTER USED TO INDEX15192000 - INTO INFO TO PICK OUT SPECIAL MONITOR 15193000 - INFORMATION; 15194000 - DEFINE SPMON = [11:12]#; COMMENT SPMON DESIGNATES THE BIT15195000 - POSITION OF THE SPECIAL MONITOR 15196000 - INFORMATION FOR SUBSCRIPTED 15197000 - VARIABLES; 15198000 - DEFINE OPBIT = [11: 1]#; COMMENT OPBIT TELLS WHETHER TO 15199000 - EMIT AN OPDC OR LITC FOR PASSING 15200000 - THE SUBSCRIPTS FOR MONITORED 15201000 - SUBSCRIPTED VARIABLES.1 MEANS 15202000 - LITC, 0 MEANS OPDC; 15203000 - DEFINE LWRBND = RR4#; COMMENT LWRBND HOLDS THE LOWER 15204000 - BOUND WORD FROM INFO FOR MONITORED 15205000 - SUBSCRIPTED VARIABLES; 15206000 - DEFINE SPMONADR = [12:11]#; COMMENT SPMONADR CONTAINS 15207000 - THE ADDRESS THAT WILL BE 15208000 - EMITTED IN AN OPDC OR LITC 15209000 - DEPENDING ON OPBIT; 15210000 - BOOLEAN SPCLMON; COMMENT SPCLMON IS A BOOLEAN THAT15211000 - IS SET TRUE IF THE VARIABLE IN 15212000 - TALL IS SPECIAL MONITORED. 15213000 -; 15214000 -PROCEDURE M4(TALL,J); 15215000 - VALUE TALL,J ; 15216000 - REAL TALL,J ; 15217000 - BEGIN STACKCT ~ 1; 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; 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; 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]); 15271000 - EMITN(GNAT(PRINTI)); 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; 15299500 - IF STEPI = ASSIGNOP THEN 15300000 - BEGIN 15301000 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % ASSIGNMENT TO15301100 - % SUBSCRIPTED VARIABLE. 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; 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) 15326000 - &CARDNUMBER[1:4:44]); 15327000 - EMITV(GNAT(PRINTI)); 15328000 - IF P1 ! FS 15329000 - THEN EMITV(JUNK); 15330000 - P1~0; GO TO EXIT; 15331000 - END; 15332000 - EMITO(IF TALL.CLASS = INTARRAYID THEN 15333000 - IF P1 = FS THEN ISD ELSE ISN ELSE 15334000 - IF P1=FS THEN STD ELSE SND); 15335000 - P1~0 ; 15336000 - GO TO EXIT ; 15337000 - END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 15338000 - IF ELCLASS=PERIOD THEN 15339000 - BEGIN 15340000 - IF DOTSYNTAX(T1,T2) THEN GO TO EXIT; 15341000 - IF STEPI = ASSIGNOP THEN 15342000 - IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST 15342100 - BEGIN 15342200 - XREFIT(TALL,REMEMBERSEQNO,ASSIGNREF); % PARTIAL15342300 - % WORD ASSIGNMENT TO SUBSCR. VAR. 15342400 - GO TO LAST; 15342500 - END 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]); 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 - 15370000 -COMMENT ***** MONITOR FUNCTION M9 ; 15371000 - IF TALL < 0 15372000 - THEN BEGIN COMMENT MONITOR FUNCTION M9; 15373000 - EMITNUM(5&CARDNUMBER[1:4:44]); 15374000 - EMITV(GNAT(PRINTI)); 15374100 - END ; 15375000 - EXIT: STACKCT ~ 0 END OF SUBSCRIPTED BLOCK; 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&(STLABID|2+1) 16051000 - [2:40:8]&PJ[16:37:11]&2[27:40:8]); 16052000 - PUTNBUMP(0&(NEXTINFO-LASTINFO-1)[4:40:8]); 16053000 - PUTNBUMP(0); 16054000 - LASTINFO ~ NEXTINFO-3; 16055000 - END; 16056000 - END FIXC ; 16057000 - COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 16058000 - THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63 16059000 - SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 16060000 - STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 16061000 - RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 16062000 - INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 16063000 - POINTING TO OUR LABEL IN QUESTION. ; 16064000 - PROCEDURE EMITJUMP( E); VALUE E; REAL E; 16065000 - BEGIN 16066000 - REAL T,D; 16067000 - REAL ADDR; 16068000 - IF ABS( 16069000 - D~(T~TAKE(GIT(E)).LOC)-L-1)}64 THEN 16070000 - BEGIN 16071000 - IF ADDR~TAKE(E).ADDRESS=0 THEN 16072000 - BEGIN 16073000 - PUT(TAKE(E)&(ADDR~PJ~PJ+1)[16:37:11],E); 16074000 - LPRT ~ PROGDESCBLDR(2,T,0); 16075000 - END ; 16076000 - EMITC(ADDR,RCA); 16077000 - END 16078000 - ELSE EMITC(D,IF D <0 THEN JRV ELSE JFW); 16079000 - END EMIT JUMP; 16080000 - COMMENT WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE16081000 - ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 16082000 - TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 16083000 - LINK IS = 4096. ; 16084000 - PROCEDURE JUMPCHAIN( E); VALUE E;REAL E; 16085000 - BEGIN 16086000 - REAL SAVL ,LINK; 16087000 - SAVL ~ L; 16088000 - L ~ TAKE(GIT(E)).LASTGT ; 16089000 - WHILE L ! 4095 DO 16090000 - BEGIN 16091000 - LINK ~ GET(L); 16092000 - EMITJUMP( E); 16093000 - L ~ LINK 16094000 - END; 16095000 - L~SAVL; 16096000 - END JUMPCHAIN ; 16097000 - COMMENT NESTS COMPILES THE NEST STATEMENT. 16098000 - A VARIABLE NEST INDEX CAUSES THE CODE, 16099000 - CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 16100000 - AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 16101000 - THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH{63,OTHERWISE 16102000 - IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 16103000 - RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 16104000 - MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 16105000 - JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 16106000 - NEST LEVEL INCREASED BY ONE. 16107000 - WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 16108000 - THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 16109000 - OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 16110000 - ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 16111000 - JUMPS. 16112000 - FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 16113000 - AND JOINFO 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 16159100 - IF STEPI ! COLON THEN ERR(258) 16160000 - ELSE 16161000 - BEGIN 16162000 - IF TAKE(GT2~GIT(GT1)).LOC ! 0 THEN FLAG(259) ELSE 16163000 - IF GT1>0 THEN 16164000 - BEGIN 16165000 - PUT(-(TAKE(GT1)&NESTLEVEL[11:43:5]),GT1); 16166000 - PUT(-L,GT2) 16167000 - END 16168000 - ELSE 16169000 - BEGIN 16170000 - IF GT1.LEVEL!NESTLEVEL THEN FLAG(257); 16171000 - PUT((-L)&TAKE(GT2)[LGTFLD],GT2); 16172000 - JUMPCHAIN(GT1); 16173000 - END; 16174000 - END 16175000 - ; STEPIT; 16176000 - END LABELS ; 16177000 - COMMENT IFS COMPILES IF STATEMENTS. 16178000 - FIRST THE TEST IS COMPILED. NOTE THAT IN THE 16179000 - CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 16180000 - THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 16181000 - IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR, OTHERWISE 16182000 - THE CODE IS EMITTED STRAIGHTAWAY. 16183000 - A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 16184000 - "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 16185000 - SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 16186000 - TO BE GENERATED. 16187000 - THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 16188000 - IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 16189000 - IF THEN GO TO L1 ELSE GO TO L2 ; 16190000 - PROCEDURE IFS; BEGIN 16191000 - DEFINE COMPARECODE =[42:6]#,TESTCODE=[36:6]#,EQUALV=48#; 16192000 - LABEL IFSB,IFTOG,IFSC,EXIT; 16193000 - SWITCH IFSW ~ IFSB,IFTOG,IFSC; 16194000 - REAL ADDR,FIX1,FIX2 ; 16195000 - ADDR~1 ; 16196000 - GO TO IFSW[STEPI -SBV+1] ; 16197000 - IF ELCLASS=LOCLID THEN 16198000 - BEGIN 16199000 - EMITC(ELBAT[I].ADDRESS,CRF); 16200000 - ADDR~0; 16201000 - END 16202000 - ELSE 16203000 - IF ELCLASS=LITNO THEN ADDR ~ ELBAT[I].ADDRESS 16204000 - ELSE BEGIN ERR(250); GO TO EXIT END; 16205000 - IF STEPI ! SCV THEN BEGIN ERR(263);GO TO EXIT END; 16206000 -IFSC: 16207000 - IF STEPI!RELOP THEN BEGIN ERR(264);GO EXIT END; 16208000 - IF STEPI=DCV THEN EMITC(ADDR,ELBAT[I-1],COMPARECODE) 16209000 - ELSE IF ELCLASS=STRNGCON THEN 16210000 - BEGIN 16211000 - IF ACCUM[1].[12:6]!1 OR ELBAT[I-3].CLASS!IFV THEN 16211100 - BEGIN ERR(271); GO EXIT END 16211200 - ELSE EMITC(ACCUM[1].[18:6],ELBAT[I-1].TESTCODE) 16211300 - END 16211400 - ELSE IF ELCLASS=LOCLID THEN 16212000 - BEGIN 16212100 - IF ELBAT[I-3].CLASS!IFV THEN 16212200 - BEGIN ERR(271); GO EXIT END 16212300 - ELSE BEGIN 16212400 - EMITC(0,ELBAT[I-1].TESTCODE); % RESET TFFF. 16212500 - EMITC(ELBAT[I].ADDRESS,CRF); 16212600 - EMITC(0,ELBAT[I-1].TESTCODE); % COMPARE. 16212700 - END 16212800 - END 16212900 - ELSE IF ACCUM[1]!"5ALPHA" THEN 16213000 - BEGIN ERR(265);GO EXIT END 16213100 - ELSE IF ELBAT[I-1].COMPARECODE=EQUALV THEN EMITC(17,TAN) 16214000 - ELSE BEGIN FLAG(270); ERRORTOG:=TRUE END; 16214100 - GO IFTOG; 16215000 -IFSB: EMITC(1,BIT); 16216000 -IFTOG: IF STEPI!THENV THEN BEGIN ERR(266); GO EXIT END; 16217000 - FIX1 ~ L; 16218000 - EMIT(JFC); 16219000 - STEPIT; 16220000 - IF ELCLASS = BEGINV OR 16221000 - ELCLASS = IFV OR 16222000 - ELCLASS = LITNO OR 16223000 - ELCLASS = STLABID OR 16224000 - ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN THEN 16225000 - BEGIN 16226000 - EMIT (NOP); EMIT (NOP) 16227000 - END; 16228000 - IF ELCLASS= ELSEV THEN ELSE 16228500 - STREAMSTMT; 16229000 - IF ELCLASS= ELSEV THEN 16230000 - BEGIN 16231000 - FIX2 ~ L; EMIT(JFW); 16232000 - FIXC(FIX1); 16233000 - STEPIT; 16234000 - STREAMSTMT; 16235000 - FIXC(FIX2); 16236000 - END 16237000 - ELSE FIXC(FIX1); 16238000 - EXIT:END IFS ; 16239000 - COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 16240000 - STATEMENTS. 16241000 - IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 16242000 - AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 16243000 - ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 16244000 - GO TOS IN THE CASE OF FORWARD JUMPS. 16245000 - FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 16246000 - AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 16247000 - BE JUMPED OUT, OTHERWISE,NEST LEVEL IS DEFINED. ; 16248000 - PROCEDURE GOTOS; 16249000 - BEGIN 16250000 - LABEL EXIT; 16251000 - IF STEPI !TOV THEN I~I-1 ; 16252000 - IF STEPI ! STLABID THEN BEGIN ERR(260); GO TO EXIT END; 16253000 - IF(GT2~TAKE(GIT(GT1~ELBAT[I]))).MON=1 16254000 - OR GT2.LOC!0 THEN EMITJUMP(GT1) 16255000 - ELSE 16256000 - BEGIN PUT(0&L[24:36:12],GIT(GT1)); 16257000 - IF GT1>0 THEN 16258000 - BEGIN 16259000 - PUT(-(TAKE(GT1)&(NESTLEVEL-JUMPLEVEL)[11:43:5]),GT1);16260000 - EMITN(1023); 16261000 - END 16262000 - ELSE 16263000 - BEGIN 16264000 - IF GT1.LEVEL ! NESTLEVEL-JUMPLEVEL THEN FLAG(257); 16265000 - EMIT(GT2,LASTGT); 16266000 - END; 16267000 - END; 16268000 - JUMPLEVEL~0 ; 16269000 - EXIT: END GOTOS ; 16270000 - COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 16271000 - THE CODE GENERATED IS : 16272000 - SED FILE 16273000 - RSA 0. 16274000 - AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 16275000 - INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 16276000 - BY THE DESTINATION ADDRESS. 16277000 - THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 16278000 - THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 16279000 - MUST BE PASSED FOR THIS FORMAL PARAMETER; 16280000 -PROCEDURE RELEASES; 16281000 - IF STEPI ! LFTPAREN OR STEPI!LOCLID OR STEPI ! RTPAREN OR 16282000 - (GT1~ELBAT[I-1]).FORMAL=0 16283000 - THEN ERR(256) ELSE 16284000 - BEGIN 16285000 - EMITC( GT1.ADDRESS,SED); 16286000 - EMIT(FILETHING); FILETHING~L-1; 16287000 - INFO[GT1.LINKR,GT1.LINKC].MON ~ 1; 16288000 - END RELEASES; 16289000 - COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 16290000 - OR LOCALIDS . 16291000 - THREE CASES PRESENT THEMSELVES, 16292000 - LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 16293000 - CASE I LOCLID ~ X 16294000 - CASE II X ~ X ... 16295000 - CASE III X ~ EITHER LOC,LOCLID,SC OR DC. 16296000 - THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 16297000 - CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS16298000 - THE CODE TO BE EMITTED. 16299000 - EACH ELEMENT OF MACRO HAS 1-3 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); 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) | 4 16329000 - + REAL(ELCLASS =LOCLID) | 8; 16330000 - END 16331000 - ELSE 16332000 - BEGIN 16333000 - INDEX ~ TCLASS -SIV 16334000 - + ( IF ELCLASS = LOCLID THEN 16 ELSE 16335000 - IF ELCLASS = LOCV THEN 20 ELSE 16336000 - IF ELCLASS = SCV THEN 24 ELSE 16337000 - IF ELCLASS= DCV THEN 28 ELSE 25); 16338000 - IF ELCLASS = LOCV THEN 16339000 - IF STEPI ! LOCLID THEN GO TO L; 16340000 - IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 16341000 - BEGIN EMITC(ELBAT[I].ADDRESS,SEC); GO TO EXIT END; 16342000 - END ; 16343000 - ADDR ~ ELBAT[I].ADDRESS; 16344000 - GENERATE: 16345000 - IF MACRO[INDEX]= 0 THEN 16346000 - L: BEGIN ERR(250); GO TO EXIT END; 16347000 - J ~ 8; TCLASS ~0 ; 16348000 - L1: MOVECHARACTERS(2,MACRO[INDEX],J~J-2,TCLASS,6 ); 16349000 - IF TCLASS!0 THEN 16350000 - BEGIN 16351000 - EMITC(IF TCLASS}64 THEN ADDR ELSE 0,TCLASS); 16352000 - GO TO L1 16353000 - END; 16354000 - EXIT:END INDEXS ; 16355000 - COMMENT DSS COMPILES 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:6]#; 16366000 - IF STEPI ! ASSIGNOP THEN BEGIN ERR(251); GO TO EXIT END; 16367000 - IF STEPI = LOCLID THEN 16368000 - BEGIN 16369000 - EMITC(ELBAT[I].ADDRESS,CRF); 16370000 - ADDR~ 0; 16371000 - IF STEPI = LITV THEN GO TO L1 16372000 - END 16373000 - ELSE IF ELCLASS= LITNO THEN 16374000 - BEGIN 16375000 - ADDR ~ ELBAT[I].ADDRESS; STEPIT ; 16376000 - END 16377000 - ELSE ADDR ~ 1 ; 16378000 - IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN 16379000 - EMITC(ADDR,ELBAT[I].OPCODE) 16379500 - ELSE 16380000 - IF ELCLASS = LITV THEN 16381000 - BEGIN 16382000 - EMITC(ADDR,TRP); 16383000 - IF STEPI!STRING AND ELCLASS!STRNGCON AND 16384000 - ELCLASS ! LITNO AND ELCLASS ! NONLITNO THEN 16384100 - BEGIN ERR(255); GO TO EXIT END; 16384500 - IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN 16384700 - MOVECHARACTERS(COUNT:=IF ADDR < 8 THEN ADDR ELSE 8, 16384800 - C,8-COUNT,ACCUM[1],3); 16384900 - IF ADDR MOD 2 ! 0 THEN 16385000 - BEGIN 16386000 - EMIT(ACCUM[1].[18:6]); J ~ 1; 16387000 - END ; 16388000 - FOR K ~J+2 STEP 2 UNTIL ADDR DO 16389000 - BEGIN 16390000 - FOR L ~6,7 DO 16391000 - MOVECHARACTERS(1,ACCUM[1],2+(IF J~J+1>COUNT THEN J~1 16392000 - ELSE J),T,L ); 16393000 - EMIT(T); 16394000 - END END 16395000 - ELSE 16396000 - L1: ERR(250); 16397000 - EXIT:END DSS ; 16398000 - COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 16399000 - IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 16400000 - A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 16401000 - OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 16402000 -PROCEDURE SKIPS ; 16403000 - BEGIN 16404000 - REAL ADDR; 16405000 - IF STEPI = LOCLID THEN 16406000 - BEGIN 16407000 - EMITC(ELBAT[I].ADDRESS,CRF); ADDR~0; STEPIT; 16408000 - END 16409000 - ELSE IF ELCLASS = LITNO THEN 16410000 - BEGIN 16411000 - ADDR~ ELBAT[I].ADDRESS; STEPIT 16412000 - END 16413000 - ELSE ADDR ~ 1 ; 16414000 - IF ELCLASS =SBV THEN EMITC(ADDR,BSS) 16415000 - ELSE 16416000 - IF ELCLASS =DBV THEN EMITC(ADDR,BSD) 16417000 - ELSE ERR(250); 16418000 - END SKIPS ; 16419000 - COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 16420000 - JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO 16421000 - THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 16422000 - JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 16423000 - JUMP INSTRUCTION. 16424000 - SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 16425000 - A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 16426000 - THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 16427000 - UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 16428000 - THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING16429000 - GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 16430000 -PROCEDURE JUMPS; 16431000 - BEGIN 16432000 - JUMPLEVEL~1; 16433000 - IF STEPI!DECLARATORS THEN FLAG(261); 16434000 - IF STEPI!LITNO THEN JUMPLEVEL~ ELBAT[I].ADDRESS 16435000 - ELSE BEGIN 16436000 - IF ELCLASS! TOV AND ELCLASS! STLABID THEN 16437000 - BEGIN 16438000 - COMMENT SIMPLE JUMP OUT STATEMENT; 16439000 - IF JOINFO = 0 THEN 16440000 - BEGIN 16441000 - JOINFO ~ NEXTINFO ; 16442000 - PUTNBUMP(0&(STLABID|2+1) 16443000 - [2:40:8]&2[27:40:8 ]); 16444000 - PUTNBUMP(0&(JOINFO-LASTINFO )[ 4:40:8]); 16445000 - PUTNBUMP (0); 16446000 - LASTINFO ~ JOINFO; 16447000 - END; 16448000 - ELBAT[I~ I-1]~ TAKE(JOINFO)&JOINFO[35:35:13]; 16449000 - END; I~I-1 ; 16450000 - END; 16451000 - FOR GT1~1 STEP 1 UNTIL JUMPLEVEL DO 16452000 - EMIT( JNS); 16453000 - GOTOS; 16454000 - END JUMPS; 16455000 - COMMENT STREAMSTMT ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE 16456000 - THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 16457000 - THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 16458000 - IDENTIFIED BY PROCEDURE ENVOKED 16459000 - END GO TO FINI 16460000 - SEMICOLON GO TO FINI 16461000 - ) GO TO FINI 16462000 - IF IFS 16463000 - GO GOTOS 16464000 - RELEASE RELEASES 16465000 - BEGIN COMPOUNDTAIL 16466000 - SI,DI,CI,TALLY,LOCALID INDEXS 16467000 - DS DSS 16468000 - SKIP SKIPS 16469000 - JUMP JUMPS 16470000 - LABELID LABELS 16471000 - LITERAL NO.,LOCALID( NESTS 16472000 - UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO 16473000 - THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 16474000 - LABEL L,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,EXIT,FINI,START; 16475000 - SWITCH TYPE ~ FINI,L,FINI,L3,L4,L5,L6,L7,L7,L7,L7,L8,L9,L10; 16476000 - START: GO TO TYPE[ ELCLASS-ENDV+1]; 16477000 - IF ELCLASS= RTPAREN THEN GO TO FINI ; 16478000 - IF ELCLASS = LITNO OR ELCLASS=LOCLID AND TABLE(I+1) 16479000 - = LFTPAREN THEN GO TO L1; 16480000 - IF ELCLASS= STLABID THEN GO TO L2 ; 16481000 - IF ELCLASS= LOCLID THEN GO TO L7 ; 16482000 - L: ERR( 250 ); GO TO FINI ; 16483000 - L1: NESTS; GO TO EXIT; 16484000 - L2: LABELS; GO TO START; 16485000 - L3: IFS; GO TO FINI; 16486000 - L4: GOTOS; GO TO EXIT; 16487000 - L5: RELEASES; GO TO EXIT; 16488000 - L6: I~I+1 ; COMPOUNDTAIL; GO TO FINI; 16489000 - L7: INDEXS; GO TO EXIT; 16490000 - L8: DSS; GO TO EXIT; 16491000 - L9: SKIPS; GO TO EXIT; 16492000 - L10: JUMPS; GO TO EXIT; 16493000 - EXIT: STEPIT; 16494000 - FINI: END STREAMSTMT; 16495000 - 16496000 - TIME1 ~ TIME(1); PROGRAM; 17000000 - ENDOFITALL: 17000100 -IF (XREF OR DEFINING.[1:1) AND XLUN > 0 THEN 17001000 - BEGIN DEFINE LSS= <#,GTR=>#,NEQ = !#,LEQ={#; 17002000 - DEFINE XREFINFO[INDEX] = INFO[((INDEX).CF DIV 2).[33:7], 17002005 - ((INDEX).CF DIV 2).LINKC]#, 17002006 - CF = [33:15]#, 17002007 - FF = [18:15]#, 17002008 - NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF 17002009 - ELSE XREFINFO[INDEX].CF)#; 17002010 - ARRAY TIMINGS[0:2,0:3]; 17002012 - PROCEDURE SAVETIMES(I); 17002015 - VALUE I; INTEGER I; 17002020 - BEGIN 17002025 - INTEGER J; 17002030 - FOR J := 1 STEP 1 UNTIL 3 DO 17002035 - TIMINGS[I,J] := TIME(J); 17002040 - END; 17002045 - PROCEDURE UPDATETIMES(I); 17002050 - VALUE I; INTEGER I; 17002055 - BEGIN 17002060 - INTEGER J; 17002065 - FOR J := 1 STEP 1 UNTIL 3 DO 17002070 - TIMINGS[I,J] := TIME(J) - TIMINGS[I,J]; 17002075 - END; 17002080 - WRITE(LINE[PAGE]); 17002520 - SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. 17002525 - LASTADDRESS~0; 17002530 - FOR XREFPT:=XREFPT STEP 1 UNTIL 29 DO XREFAY2[XREFPT]:=100000000; 17003000 - WRITE(DSK2,30,XREFAY2[*]); 17004000 - TOTALNO := XLUN; % REMEMBER NUMBER OF IDENTIFIERS. 17004500 - XREFPT~XLUN~0; 17004600 - FOR I:= 0 STEP 1 UNTIL 8191 DO 17004700 - XREFINFO[I] := 0; 17004710 - BEGIN 17005000 - BOOLEAN PROCEDURE INPUT1(A); 17006000 - ARRAY A[0]; 17007000 - BEGIN 17008000 - LABEL L,EOF; 17009000 - READ(DSK1,10,A[*])[EOF]; 17010000 - GO TO L; 17011000 - EOF: INPUT1:=TRUE; 17012000 - REWIND(DSK1); 17013000 - L: 17014000 - END; 17015000 - PROCEDURE OUTPUT1(B,A); 17016000 - VALUE B; 17017000 - BOOLEAN B; 17018000 - ARRAY A[0]; 17019000 - BEGIN 17020000 - IF B THEN 17021000 - BEGIN 17022000 - REWIND(DSK1); 17022100 - UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 17022200 - TIMINGS[0,0] := XLUN; % NUMBER OF IDENTIFIERS SORTED. 17022300 - END 17022400 - ELSE 17023000 - BEGIN 17024000 - IF BOOLEAN(A[8]) THEN 17025000 - XREFINFO[A[8]].FF := XLUN := XLUN + 1 17025100 - ELSE 17025200 - XREFINFO[A[8]].CF := XLUN := XLUN + 1; 17025300 - A[8].IDNOF := XLUN; 17025400 - WRITE(DSK1,10,A[*]); 17026000 - END; 17027000 - END; 17028000 - BOOLEAN STREAM PROCEDURE COMPS1(A,B); 17029000 - BEGIN 17030000 - SI:=A; 17031000 - DI:=B; 17032000 - IF 63 SC < DC THEN 17033000 - TALLY := 1 17033100 - ELSE 17033200 - BEGIN 17033300 - SI := A; 17033400 - DI := B; 17033500 - IF 63 SC = DC THEN 17033600 - TALLY := 2; 17033700 - END; 17033800 - COMPS1:=TALLY; 17034000 - END; 17035000 - STREAM PROCEDURE HVS1(A); 17036000 - BEGIN 17037000 - DI:=A; 17038000 - DS:=8 LIT "9"; 17039000 - SI:=A; 17040000 - DS:= 7 WDS; 17041000 - DS := 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS 17041100 - END; 17042000 - BOOLEAN PROCEDURE COMP1(A,B); 17042100 - ARRAY A,B[0]; 17042200 - IF REAL(COMP1:=COMPS1(A,B)) = 2 THEN % IDS EQUAL 17042300 - COMP1 := A[8].IDNOF < B[8].IDNOF; 17042350 - PROCEDURE HV1(A); 17042400 - ARRAY A[0]; 17042500 - HVS1(A); 17042600 - XLUN:=0; 17043000 - REWIND(DSK1); 17044000 - SORT(OUTPUT1,INPUT1,0,HV1,COMP1,10,IF TOTALNO < 1000 THEN 17045000 - 7000 ELSE 10000); 17045100 - END; 17046000 - BEGIN 17047000 - ARRAY IDTYPE[0:(IDMAX+4)|4-1]; 17047100 - STREAM PROCEDURE SETUPHEADING(S,D,SEG,SEQNO,FWDTOG,LBLTOG, 17047200 - FWDSEQNO,TYPE,OWNTOG,PARAMTOG, 17047300 - VALTOG); 17047350 - VALUE SEQG,SEQNO,FWDTOG,LBLTOG,FWDSEQNO,OWNTOG,PARAMTOG, 17047400 - VALTOG; 17047450 - BEGIN 17047500 - SI := S; 17047700 - DI := D; 17047800 - 63 (IF SC = " " THEN JUMP OUT ELSE DS := CHR); 17047900 - DS := 6 LIT " -- "; 17048000 - OWNTOG (DS := 4 LIT "OWN "); 17048100 - SI := TYPE; 17049300 - 32 (IF SC = "." THEN JUMP OUT ELSE DS := CHR); 17049400 - PARAMTOG (DS := 6 LIT " -- "; 17049410 - DS := 4 LIT "NAME"; 17049420 - VALTOG (DI := DI - 4; DS := 5 LIT "VALUE"); 17049430 - DS := 10 LIT " PARAMETER"); 17049440 - DS := 26 LIT " -- DECLARED IN SEGMENT "; 17049500 - SI := LOC SEG; 17049600 - S := DI; 17049700 - DS := 4 DEC; DI := DI - 4; DS := 3 FILL; % CONV AND ZERO SUPPR 17049800 - DI := DI + 8; % TO FORCE STORE OF LAST WORD 17049900 - SI := S; 17050000 - DI := S; 17050100 - 4(IF SC ! " " THEN DS:= CHR ELSE SI := SI + 1); 17050200 - DS := 4 LIT " AT "; 17050300 - SI := LOC SEQNO; 17050400 - DS := 8 DEC; 17050500 - FWDTOG (DS := 17 LIT " -- FORWARD AT "; 17050600 - SI := LOC FWDSEQNO; 17050700 - DS := 8 DEC); 17050800 - LBLTOG (DS := 16 LIT " -- OCCURS AT "; 17050900 - SI := LOC FWDSEQNO; 17051000 - DS := 8 DEC); 17051100 - END OF SETUPHEADING; 17051200 - 17051300 - STREAM PROCEDURE ADDASEQNO(SEQNO,N,STARS,D); 17051400 - VALUE SEQNO,N,STARS; 17051500 - BEGIN 17051600 - DI := D; 17051700 - DI := DI + 8; 17051800 - N (DI := DI + 10); 17051900 - STARS(DO := DI - 1; DS := LIT "*"); 17052000 - SI := LOC SEQNO; 17052100 - DS := 8 DEC; 17052200 - DS := LIT " "; 17052300 - STARS (DI := DS - 1; DS := LIT "*"); 17052400 - END; 17052500 - STREAM PROCEDURE BLANKET(D); 17052600 - BEGIN 17052700 - DI := D; 17052800 - DS := 8 LIT " "; 17052900 - SI := D; 17053000 - DS := 16 WDS; 17053100 - END OF BLANKET; 17053200 - PROCEDURE PRINTXREFSTATISTICS; 17053300 - BEGIN 17053400 -$RESET NEATUP 17053450120324PK - SWITCH FORMAT STATS := 17053500 - (///, "CROSS REFERENCE STATISTICS", /, 17053600 - "----- --------- ----------", /), 17053700 - ("PHASE ONE - SORT",I6," IDENTIFIERS"), 17053800 - ("PHASE TWO - SORT",I7," REFERENCES"), 17053900 - ("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), 17054000 - (X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), 17054100 - (X5,I4,":",2I1," PROCESSOR TIME"), 17054200 - (X5,I4,":",2I1," I/O TIME",/); 17054300 -$SET NEATUP 17054350120324PK - INTEGER I,J,K; 17054400 - WRITE(LINE,STATS[0]); 17054500 - FOR I := 0 STEP 1 UNTIL 2 DO 17054600 - BEGIN 17054700 - WRITE(LINE,STATS[I+1],TIMINGS[I,0]); 17054800 - FOR J := 1 STEP 1 UNTIL 3 DO 17054900 - BEGIN 17055000 - K := (TIMINGS[I,J] + 30) DIV 60; % ROUND TO NEAREST SECON17055010 - WRITE(LINE,STATS[J+3],K DIV 60,(K:=K MOD 60) DIV 10, 17055020 - K MOD 10); 17055025 - END; 17055030 - END; 17055100 - END PRINTXREFSTATISTICS; 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]; 17069500 - REAL LASTADDRESS; 17069600 - BOOLEAN PROCEDURE INPUT2(A); 17070000 - ARRAY A[0]; 17071000 - BEGIN 17072000 - LABEL L,EOF; 17073000 - DEFINE I = LASTADDRESS#; 17073100 - IF XREFPT:=XREFPT+1=30 THEN 17074000 - BEGIN 17075000 - READ(DSK2,30,XREFAY2[*])[EOF]; 17076000 - XREFPT:=0; 17077000 - END; 17078000 - IF ( I :=XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN GO TO EOF;17079000 - A[0] := I & NEWID[I.REFIDNOF] REFIDNOF; 17080000 - REFCOUNT := REFCOUNT + 1; 17080100 - GO TO L; 17081000 - EOF: INPUT2:=TRUE; 17082000 - BLANKET(PAY); 17083000 - XREFAY1[8] := XREFPT := LASTADDRESS := 0; 17084000 - FILL IDTYPE[*] WITH 17084010 - "UNKNOWN. ", % 0 17084020 - "STREAM LABEL. ", % 1 17084030 - "STREAM VARIABLE. ", % 2 17084040 - "DEFINE. ", % 3 17084050 - "LIST. ", % 4 17084060 - "FORMAT. ", % 5 17084070 - "SWITCH FORMAT. ", % 6 17084080 - "FILE. ", % 7 17084090 - "SWITCH FILE. ", % 8 17084100 - "SWITCH LABEL. ", % 9 17084110 - "PROCEDURE. ", % 10 17084120 - "INTRINSIC. ", % 11 17084130 - "STREAM PROCEDURE. ", % 12 17084140 - "BOOLEAN STREAM PROCEDURE. ", % 13 17084150 - "REAL STREAM PROCEDURE. ", % 14 17084160 - "ALPHA STREAM PROCEDURE. ", % 15 17084170 - "INTEGER STREAM PROCEDURE. ", % 16 17084180 - "BOOLEAN PROCEDURE. ", % 17 17084182 - "REAL PROCEDURE. ", % 18 17084184 - "ALPHA PROCEDURE. ", % 19 17084186 - "INTEGER PROCEDURE. ", % 20 17084188 - "BOOLEAN. ", % 21 17084190 - "REAL. ", % 22 17084200 - "ALPHA. ", % 23 17084210 - "INTEGER. ", % 24 17084220 - "BOOLEAN ARRAY. ", % 25 17084230 - "REAL ARRAY. ", % 26 17084240 - "ALPHA ARRAY. ", % 27 17084250 - "INTEGER ARRAY. ", % 28 17084260 - "LABEL. ", % 29 17084270 - "FIELD. ", % 30 (CLASS = 125) 17084275 - "FAULT. ", % 32 (CLASS = 126) 17084280 - "SWITCH LIST. "; % 31 (CLASS = 127) 17084290 - L: 17085000 - END; 17086000 - PROCEDURE OUTPUT2(B,A); 17087000 - VALUE B; 17088000 - BOOLEAN B; 17089000 - ARRAY A[0]; 17090000 - BEGIN DEFINE PRINTER=LINE#; 17091000 - LABEL EOF2, SKIP; 17091100 - OWN BOOLEAN B2, FWDTOG, LBLTOG, WAITINGFORFWDREF; 17091110 - DEFINE MATCH(A,B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = 17091115 - REAL(NOT FALSE)#; 17091116 - REAL I; 17091120 - DEFINE LINECOUNT = TIMINGS[2,0]#; % NUMBER OF LINES PRINTED. 17091140 - OWN REAL FWDSEQNO; 17091150 - IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. 17091155 - BEGIN 17091160 - FIRSTTIME := FALSE; 17091162 - TIME1 := TIME(1); 17091165 - DATIME; 17091170 - UPDATETIMES(1); 17091175 - SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. 17091180 - END; 17091200 - IF NOT B2 THEN 17091210 - IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. 17091300 - IF XREFPT ! 0 THEN % WE GOT SOME TO LIST OUT 17091400 - BEGIN 17091500 - WRITE(LINE[DBL],15,PAY[*]); 17091510 - LINECOUNT := LINECOUNT + 1; 17091520 - END 17091530 - ELSE % NOTHING TO LIST OUT 17091600 - ELSE % NOT END OF SORT 17091700 - IF NOT MATCH(LASTADDRESS,A[0]) AND A[0].REFIDNOF ! 0 AND 17091800 - A[0].REFIDNOF } XREFAY1[8].IDNOF THEN 17091900 - IF A[0].TYPEREF = FORWARDREF THEN % 17092000 - WAITINGFORFWDREF := TRUE 17092100 - ELSE 17092200 - IF A[0].TYPEREF = LBLREF THEN % 17092300 - BEGIN 17092400 - LBLTOG := TRUE; 17092500 - FWDSEQNO := A[0].SEQNOF; 17092600 - END 17092700 - ELSE 17092800 - IF A[0].TYPEREF = DECLREF THEN 17092900 - IF WAITINGFORFWDREF THEN % THIS MUST BE IT 17093000 - BEGIN 17093100 - WAITINGFORFWDREF := FALSE; 17093200 - FWDTOG := TRUE; 17093300 - FWDSEQNO := A[0].SEQNOF; 17093400 - END 17093500 - ELSE % ITS A NORMAL DECLARATION - NOT FORWARD 17093600 - BEGIN 17093700 - IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN 17093850 - DO 17093900 - READ(DSK1,10,XREFAY1[*]) [EOF2] 17093950 - UNTIL 17094000 - A[0].REFIDNOF { XREFAY1[8].IDNOF; 17094050 - IF A[0]. REFIDNOF < XREFAY1[8].IDNOF THEN 17094100 - GO TO SKIP; 17094150 - IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 17094200 - BEGIN 17094240 - IF SINGLTOG THEN 17094250 - WRITE(LINE,15,PAY[*]) 17094300 - ELSE 17094350 - WRITE(LINE[DBL],15,PAY[*]); 17094400 - LINECOUNT := LINECOUNT + 1; 17094410 - END 17094420 - ELSE 17094450 - IF NOT SINGLTOG THEN 17094500 - WRITE(LINE); 17094550 - XREFPT := 0; 17094600 - BLANKET(PAY[*]); 17094650 - SETUPHEADING(XREFAY1[*],PAY[*],XREFAY1[8]. 17094700 - SEGNOF,A[0].SEQNOF,FWDTOG,LBLTOG, 17094800 - FWDSEQNO.IDTYPE[(IF (I := 17094900 - XREFAY1[9].CLASS) } FIELDID THEN 17095000 - (IDMAX + I - FIELDID + 1) ELSE 17095100 - IF I > IDMAX THEN 0 ELSE I) | 4], 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; 17095400 - WRITE(LINE,15,PAY[*]); 17095500 - LINECOUNT := LINECOUNT + 1; 17095510 - BLANKET(PAY[*]); 17095550 - END 17095600 - ELSE % IT MUST BE A NORMAL REFERENCE 17095700 - IF A[0].SEQNOF ! LASTADDRESS.SEQNOF THEN 17095750 - BEGIN 17095800 - ADDASEQNO(A[0].SEQNOF,XREFPT,A[0].[5:1], 17095900 - PAY[*]); 17096000 - IF (XREFPT := XREFPT + 1) = 11 THEN %FULL 17096100 - BEGIN 17096200 - WRITE(LINE,15,PAY[*]); 17096300 - LINECOUNT := LINECOUNT + 1; 17096350 - XREFPT := 0; 17096400 - BLANKET(PAY[*]); 17096450 - END 17096500 - END 17096550 - ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT 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 17096800 - IF NOT B THEN SKIP: LASTADDRESS := A[0]; 17096850 - END OF OUTPUT2; 17096900 - PROCEDURE HV2(A); 17112000 - ARRAY A[0]; 17113000 - A[0] := 3"777777777777777"; % BIGGEST FLOATING PT. NO. 17114000 - BOOLEAN PROCEDURE COMP2(A,B); 17115000 - ARRAY A,B[0]; 17116000 - COMP2 := IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 17117000 - TRUE 17117100 - ELSE 17117200 - IF A[0].REFIDNOF = B[0].REFIDNOF THEN 17117300 - IF A[0].[1:4] LSS B[0].[1:4] THEN 17117400 - TRUE 17117500 - ELSE 17117600 - IF A[0].[1:4] = B[0].[1:4] THEN 17117700 - IF A[0].SEQNOF < B[0].SEQNOF THEN 17117702 - TRUE 17117704 - ELSE 17117706 - IF A[0].SEQNOF = B[0].SEQNOF THEN 17117708 - BOOLEAN(A[0].[5:1]) 17117710 - ELSE 17117712 - FALSE 17117714 - ELSE 17117720 - FALSE 17117730 - ELSE 17117800 - FALSE; 17117900 - SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT 17117910 - FIRSTTIME := TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 17117920 - XREFPT:=29; REWIND(DSK2); 17118000 - SORT(OUTPUT2,INPUT2,0,HV2,COMP2,1,6000); 17119000 - UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE 17119100 - PRINTXREFSTATISTICS; 17119200 - END; 17120000 - END; 17121000 - END OF MAIN BLOCK; 17121500 - END. 17122000 + $SET OMIT LISTA = LIST 00001000=00000999= +%#######################################################################00002000=00001000= +% 00003000=00001010= +% B-5700 ALGOL/TSPOL SYMBOLIC 00004000=00001020= +% MARK XVI.0.122 00005000=00001030= +% MAY 9, 1977 00006000=00001040= +% 00007000=00001050= +%#######################################################################00008000=00001060= +% 00009000=00001070= + COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00010000=00001072= + * FILE ID: SYMBOL/ALGOL TAPE ID: SYMBOL1/FILE000 * 00011000=00001073= + * THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00012000=00001074= + * AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00013000=00001075= + * EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00014000=00001076= + * WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00015000=00001077= + * BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00016000=00001078= + * * 00017000=00001079= + * COPYRIGHT (C) 1965, 1971, 1972, 1974 * 00018000=00001080= + * BURROUGHS CORPORATION * 00019000=00001081= + * AA759915 AA320206 AA393180 AA332366 *; 00020000=00001082= +COMMENT#################################################################00021000=00001110= + ERROR MESSAGES 00022000=00001120= +########################################################################00023000=00001130= +% 00024000=00001140= +ERROR NUMBER ROUTINE:ERROR MESSAGE 00025000=00002000= + 000 BLOCK: DECLARATION NOT FOLLOWED BY SEMICOLON. 00026000=00003000= + 001 BLOCK: IDENTIFIER DECLARED TWICE IN SAME BLOCK. 00027000=00004000= + 002 PROCEDUREDEC: SPECIFICATION PART CONTAINS 00028000=00005000= + IDENTIFIER NOT APPEARING IN 00029000=00006000= + FORMAL PARAMETER PART. 00030000=00007000= + 003 BLOCK: NON-IDENTIFIER APPEARS IN IDENTIFIER 00031000=00008000= + LIST OF DECLARATION. 00032000=00009000= + 004 PROCEDUREDEC: STREAM PROCEDURE DECLARATION 00033000=00010000= + PRECEDED BY ILLEGAL DECLARATOR. 00034000=00011000= + 005 PROCEDUREDEC: PROCEDURE DECLARATION PRECEDED 00035000=00012000= + BY ILLEGAL DECLARATOR. 00036000=00013000= + 006 PROCEDUREDEC: PROCEDURE IDENTIFIER USED BEFORE 00037000=00014000= + IN SAME BLOCK(NOT FORWARD). 00038000=00015000= + 007 PROCEDUREDEC: PROCEDURE IDENTIFIER NOT FOLLOWED 00039000=00016000= + BY ( OR SEMICOLON IN PROCEDURE 00040000=00017000= + DECLARATION. 00041000=00018000= + 008 PROCEDUREDEC: FORMAL PARAMETER LIST NOT FOLLOWED 00042000=00019000= + BY ). 00043000=00020000= + 009 PROCEDUREDEC: FORMAL PARAMETER PART NOT FOLLOWED 00044000=00021000= + BY SEMICOLON. 00045000=00022000= + 010 PROCEDUREDEC: VALUE PART CONTAINS IDENTIFIER 00046000=00023000= + WHICH DID NOT APPEAR IN FORMAL 00047000=00024000= + PARAPART. 00048000=00025000= + 011 PROCEDUREDEC: VALUE PART NOT ENDED BY SEMICOLON. 00049000=00026000= + 012 PROCEDUREDEC: MISSING OR ILLEGAL SPECIFICATION 00050000=00027000= + PART. 00051000=00028000= + 013 PROCEDUREDEC: OWN, SAVE, OR AUXMEM USED IN 00052000=00029000= + ARRAY SPECIFICATION. 00053000=00029500= + 014 ARRAYDEC: AUXMEM AND SAVE ARE MUTUALLY EXCLUSIVE. 00054000=00030000= + 015 ARRAYDEC: ARRAY CALL-BY-VALUE NOT IMPLEMENTED. 00055000=00030500= + 00056000=00031000= + 016 ARRAYDEC: ARRAY ID IN DECLARATION NOT FOLLOWED 00057000=00032000= + BY [ . 00058000=00033000= + 017 ARRAYDEC: LOWER BOUND IN ARRAY DEC NOT 00059000=00034000= + FOLLOWED BY : . 00060000=00035000= + 018 ARRAYDEC: BOUND PAIR LIST NOT FOLLOWED BY ]. 00061000=00036000= + 019 ARRAYSPEC: ILLEGAL LOWER BOUND DESIGNATOR IN 00062000=00037000= + ARRAY SPECIFICATION. 00063000=00038000= + 020 BLOCK: OWN APPEARS IMMEDIATELY BEFORE 00064000=00039000= + IDENTIFIER(NO TYPE). 00065000=00040000= + 021 BLOCK: SAVE APPEARS IMMEDIATELY BEFORE 00066000=00041000= + IDENTIFIER(NO TYPE). 00067000=00042000= + 022 BLOCK: STREAM APPEARS IMMEDIATELY BEFORE 00068000=00043000= + IDENTIFIER(THE WORD PROCEDURE LEFT 00069000=00044000= + OUT). 00070000=00045000= + 023 BLOCK: DECLARATOR PRECEDED ILLEGALLY BY 00071000=00046000= + ANOTHER DECLARATOR. 00072000=00047000= + 024 PROCEDUREDEC: LABEL CANNOT BE PASSED TO FUNCTION. 00073000=00048000= + 025 BLOCK: DECLARATOR OR SPECIFIER ILLEGALLY 00074000=00049000= + PRECEDED BY OWN OR SAVE OR SOME 00075000=00050000= + OTHER DECLARATOR. 00076000=00051000= + 026 FILEDEC: MISSING ( IN FILE DEC. 00077000=00052000= + 027 FILEDEC: MISSING RECORD SIZE. 00078000=00053000= + 00079000=00054000= + 028 FILEDEC: ILLEGAL BUFFER PART OR SAVE FACTOR 00080000=00055000= + IN FILE DEC. 00081000=00056000= + 029 FILEDEC: MISSING ) IN FILE DEC. 00082000=00057000= + 030 IODEC: MISSING COLON IN DISK DESCRIPTION. 00083000=00058000= + 00084000=00059000= + 031 LISTDEC: MISSING ( IN LISTDEC. 00085000=00060000= + 032 FORMATDEC: MISSING ( IN FORMAT DEC. 00086000=00061000= + 033 SWITCHDEC: SWITCH DEC DOES NOT HAVE ~ OR 00087000=00062000= + FORWARD AFTER IDENTIFIER. 00088000=00063000= + 034 SWITCHFILEDEC:MISSING ~ AFTER FILED. 00089000=00064000= + 035 SWITCHFILEDEC:NON FILE ID APPEARING IN DECLARATION 00090000=00065000= + OF SWITCHFILE. 00091000=00066000= + 036 SUPERFORMATDEC:FORMAT ID NOT FOLLOWED BY ~ . 00092000=00067000= + 037 SUPERFORMATDEC:MISSING ( AT START OF FORMATPHRASE . 00093000=00068000= + 038 SUPERFORMATDEC:FORMAT SEGMENT >1022 WORDS. 00094000=00069000= + 039 BLOCK: NUMBER OF NESTED BLOCKS IS GREATER THAN 31 00095000=00069100= + 040 IODEC: PROGRAM PARAMETER BLOCK SIZE EXCEEDED 00096000=00069200= + 041 HANDLESWLIST: MISSING ~ AFTER SWITCH LIST ID. 00097000=00069300= + 042 HANDLESWLIST: ILLEGAL LIST ID APPEARING IN SWITCH LIST. 00098000=00069400= + 043 IODEC: MISSING ] AFTER DISK IN FILEDEC. 00099000=00069500= + 044 IODEC: MISSING [ AFTER DISK IN FILEDEC. 00100000=00069600= +045 DEFINEDEC: MISSING "*" AFTER DEFINE ID. 00101000=00069700= +046 ARRAE: NON-LITERAL ARRAY BOUND NOT GLOBAL TO ARRAY DECL. 00102000=00069800= +047 TABLE: ITEM FOLLOWING @ NOT A NUMBER. 00103000=00069900= + 048: PROCEDUREDEC: NUMBER OF PARAMETERS DIFFERS FROM FWD DECL. 00104000=00069910= + 049: PROCEDUREDEC: CLASS OF PARAMETER DIFFERS FROM FWD DECL. 00105000=00069920= + 050: PROCEDUREDEC: VALUE PART DIFFERS FROM FWD DECL. 00106000=00069930= + 051 SAVEPROC : FORWARD DECLARATION DOES NOT AGREE WITH 00107000=00069931= + ACTUAL DECLARATION 00108000=00069932= + 052 SAVEPROC :STATEMENT MAY NOT START WITH THIS KIND OF 00109000=00069933= + IDENTIFIER. 00110000=00069934= + 059 ARRAYDEC: IMPROPER ARRAY SIZE. 00111000=00069938= + 060 FAULTSTMT: MISSING ~ IN FAULT STATEMENT. 00112000=00069940= + 061 FAULTDEC: INVALID FAULT TYPE: MUST BE FLAG, EXPOVR, ZERO, 00113000=00069950= + INTOVR, OR INDEX. 00114000=00069960= + 070 CASESTMT: MISSING BEGIN. 00115000=00069970= + 071 CASESTMT: MISSING END. 00116000=00069980= + 080 PRIMARY: MISSING COMMA . 00117000=00069990= + 090 PARSE: MISSING LEFT BRACKET 00118000=00069991= + 091 PARSE: MISSING COLON 00119000=00069992= + 092 PARSE: ILLEGAL BIT NUMBER 00120000=00069993= + 093 PARSE: FIELD SIZE MUST BE LITERAL 00121000=00069994= + 094 PARSE: MISSING RIGHT BRACKET 00122000=00069995= + 095 PARSE: ILLEGAL FIELD SIZE 00123000=00069996= + 100 ANYWHERE: UNDECLARED IDENTIFIER. 00124000=00070000= + 101 CHECKER: AN ATTEMPT HAS BEEN MADE TO ADDRESS AN 00125000=00071000= + IDENTIFIER WHICH IS LOCAL TO ONE PROCEDURE AND GLOBAL00126000=00072000= + TO ANOTHER. IF THE QUANTITY IS A PROCEDURE NAME OR 00127000=00073000= + AN OWN VARIABLE THIS RESTRICTION IS RELAXED. 00128000=00074000= + 102 AEXP: CONDITIONAL EXPRESSION IS NOT OF ARITHMETIC TYPEH 00129000=00075000= + 103 PRIMARY: PRIMARY MAY NOT BEING WITH A QUANTITY OF THIS 00130000=00076000= + TYPE. 00131000=00077000= + 104 ANYWHERE: MISSING RIGHT PARENTHESIS. 00132000=00078000= + 105 ANYWHERE: MISSING LEFT PARENTHESIS. 00133000=00079000= + 106 PRIMARY: PRIMARY MAY NOT START WITH DECLARATOR. 00134000=00080000= + 107 BEXP: THE EXPRESSION IS NOT OF BOOLEAN TYPE. 00135000=00081000= + 108 EXPRSS: A RELATION MAY NOT HAVE CONDITIONAL EXPRESSIONS 00136000=00082000= + AS THE ARITHMETIC EXPRESSIONS. 00137000=00083000= + 109 BOOSEC,SIMBOO, AND BOOCOMP: THE PRIMARY IS NOT BOOLEAN. 00138000=00084000= + 110 BOOCOMP: A NON-BOOLEAN OPERATOR OCCURS IN A BOOLEAN 00139000=00085000= + EXPRESSION. 00140000=00086000= + 111 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00141000=00087000= + TIONAL) MAY BEGIN WITH A QUANTITY OF THIS TYPE. 00142000=00088000= + 112 BOOPRIM: NO EXPRESSION (ARITHMETIC, BOOLEAN, OR DESIGNA- 00143000=00089000= + TIONAL) MAY BEGIN WITH A DECLARATOR. 00144000=00090000= + 113 PARSE: EITHER THE SYTAX OR THE RANGE OF THE LITERALS FOR 00145000=00091000= + A CONCATENATE OPERATOR IS INCORRECT. 00146000=00092000= + 114 DOTSYNTAX: EITHER THE SYNTAX OR THE RANGE OF THE LITERALS 00147000=00093000= + FOR A PARTIAL WORD DESIGNATOR IS INCORRECT. 00148000=00094000= + 115 DEXP: THE EXPRESSION IS NOT OF DESIGNATIONAL TYPE 00149000=00095000= + 116 IFCLAUSE: MISSING THEN. 00150000=00096000= + 117 BANA: MISSING LEFT BRAKET. 00151000=00097000= + 118 BANA: MISSING RIGHT BRAKET. 00152000=00098000= + 119 COMPOUNDTAIL: MISSING SEMICOLON OR END. 00153000=00099000= + 120 COMPOUNDTAIL: MISSING END. 00154000=00100000= + 121 ACTUALPARAPART: AN INDEXED FILE MAY BE PASSED BY NAME 00155000=00101000= + ONLY AND ONLY TO A STREAM PROCEDURE - THE STREAM 00156000=00102000= + PROCEDURE MAY NOT DO A RELEASE ON THIS TYPE PARA- 00157000=00103000= + METER. 00158000=00104000= + 122 ACTUALPARAPART: STREAM PROCEDURE MAY NOT HAVE AN 00159000=00105000= + EXPRESSION PASSED TO IT BY NAME. 00160000=00106000= + 123 ACTUALPARAPART: THE ACTUAL AND FORMAL PARAMETERS DO NOT 00161000=00107000= + AGREE AS TO TYPE. 00162000=00108000= + 124 ACTUALPARAPART: ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME00163000=00109000= + NUMBER OF DIMENSIONS. 00164000=00110000= + 125 ACTUALPARAPART: STREAM PROCEDURES MAY NOT BE PASSED AS A 00165000=00111000= + PARAMETER TO A PROCEDURE. 00166000=00112000= + 126 ACTUALPARAPART: NO ACTUAL PARAMETER MAY BEGIN WITH A 00167000=00113000= + QUANTITY OF THIS TYPE. 00168000=00114000= + 127 ACTUALPARAPART: THIS TYPE QUANTITY MAY NOT BE PASSED TO A00169000=00115000= + STREAM PROCEDURE. 00170000=00116000= + 128 ACTUALPARAPART: EITHER ACTUAL AND FORMAL PARAMETERS DO 00171000=00117000= + NOT AGREE AS TO NUMBER, OR EXTRA RIGHT PARENTHESIS. 00172000=00118000= + 129 ACTUALPARAPART: ILLEGAL PARAMETER DELIMITER. 00173000=00119000= + 130 RELSESTMT: NO FILE NAME. 00174000=00120000= + 131 DOSTMT: MISSING UNTIL. 00175000=00121000= + 132 WHILESTMT: MISSING DO. 00176000=00122000= + 133 LABELR: MISSING C OLON. 00177000=00123000= + 134 LABELR: THE LABEL WAS NOT DECLARED IN THIS BLOCK. 00178000=00124000= + 135 LABELR: THE LABEL HAS ALREADY OCCURED. 00179000=00125000= + 136 FORMATPHRASE: IMPROPER FORMAT EDITING PHRASE. 00180000=00126000= + 137 FORMATPHRASE: A FORMAT EDITING PHRASE DOES NOT HAVE AN 00181000=00127000= + INTEGER WHERE AN INTEGER IS REQUIRED. 00182000=00128000= + 138 FORMATPHRASE: THE WIDTH IS TOO SMALL IN E OR F EDITING 00183000=00129000= + PHRASE. 00184000=00130000= + 139 TABLE: DEFINE IS NESTED MORE THAN EIGHT DEEP. 00185000=00131000= + 140 NEXTENT: AN INTEGER IN A FORMAT IS GREATER THAN 1023. 00186000=00132000= + 141 SCANNER: INTEGER OR IDENTIFIER HAS MORE THAN 63 00187000=00133000= + CHARACTORS. 00188000=00134000= + 142 DEFINEGEN: A DEFINE CONTAINS MORE THAN 2047 CHARACTORS 00189000=00135000= + (BLANK SUPPRESSED). 00190000=00136000= + 143 COMPOUNDTAIL: EXTRA END. 00191000=00137000= + 144 STMT: NO STATEMENT MAY START WITH THIS TYPE IDENTIFIER. 00192000=00138000= + 145 STMT: NO STATEMENT MAY START WITH THIS TYPE QUANTITY. 00193000=00139000= + 146 STMT: NO STATEMENT MAY START WITH A DECLARATOR - MAY BE 00194000=00140000= + A MISSING END OF A PROCEDURE OR A MISPLACED 00195000=00141000= + DECLARATION. 00196000=00142000= + 147 SWITCHGEN: MORE THAN 256 EXPRESSIONS IN A SWITCH 00197000=00143000= + DECLARATION. 00198000=00144000= + 148 GETSPACE: MORE THAN 1023 PROGRAM REFERENCE TABLE CELLS 00199000=00145000= + ARE REQUIRED FOR THIS PROGRAM. 00200000=00146000= + 149 GETSPACE: MORE THAN 255 STACK CELLS ARE REQUIRED FOR THIS00201000=00147000= + PROCEDURE. 00202000=00148000= + 150 ACTUALPARAPART: CONSTANTS MAY NOT BE PASSED BY NAME TO 00203000=00149000= + STREAM PROCEDURES. 00204000=00150000= + 151 FORSTMT: INDEX VARIABLE MAY NOT BE BOOLEAN 00205000=00151000= + 152 FORSTMT: MISSING LEFT ARROW FOLLOWING INDEX VARIABLE. 00206000=00152000= + 153 FORSTMT: MISSING UNTIL OR WHILE IN STEP ELEMENT. 00207000=00153000= + 154 FORSTMT: MISSING DO IN FOR CLAUSE. 00208000=00154000= + 155 IFEXP: MISSING ELSE 00209000=00155000= + 156 LISTELEMENT: A DESIGNATIONAL EXPRESSION MAY NOT BE A LIST 00210000=00156000= + ELEMENT. 00211000=00157000= + 157 LISTELEMENT: A ROW DESIGNATOR MAY NOT BE A LISTELEMENT 00212000=00158000= + 158 LISTELEMENT: MISSING RIGHT BRAKET IN GROUP OF ELEMENTS 00213000=00159000= + 159 PROCSTMT: ILLEGAL USE OF PROCEDURE OF FUNCTION IDENTIFIER00214000=00160000= + 160 PURGE: DECLARED LABEL DOES NOT OCCUR. 00215000=00161000= + 161 PURGE: DECLARED FORWARD PROCEDURE DOES NOT OCCUR. 00216000=00162000= + 162 PURGE: DECLARED SWITCH FORWARD DOES NOT OCCUR. 00217000=00162500= + 163 FORMATPHRASE: THE WIDTH OF A FIELD IS MORE THAN 63. 00218000=00163000= + 164 UNKNOWNSTMT: MISSING COMMA IN ZIP OR WAIT STATEMENT. 00219000=00164000= + 165 IMPFUN: MISSING COMMA IN DELAY PARAMETER LIST 00220000=00164100= + 172 DEFINEDEC: TOO MANY PARAMETERS IN PARAMETRIC DEFINE 00221000=00164720= + DECLARATION. 00222000=00164725= + 173 DEFINEDEC: RIGHT PARENTHESIS OR RIGHT BRACKET EXPECTED 00223000=00164730= + AFTER PARAMETERS IN PARAMETRIC DEFINE DECLARATION. 00224000=00164735= + 174 FIXDEFINEINFO: INCORRECT NUMBER OF PARAMETERS IN 00225000=00164740= + PARAMETRIC DEFINE INVOCATION. 00226000=00164745= + 175 FIXDEFINEINFO: LEFT BRACKET OR LEFT PARENTHESIS EXPECTED. 00227000=00164750= + 185 IMPFUN: LAST PARAMETER MUST BE A SIMPLE OR SUBSCRIPTED 00228000=00164850= + VARIABLE, OR A TYPE PROCEDURE IDENTIFIER. 00229000=00164851= + 199 E: INFO ARRAY HAS OVERFLOWED. 00230000=00164900= + 200 EMIT: SEGMENT TOO LARGE ( > 4093SYLLABLES). 00231000=00165000= + 201 SIMPLE VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT-MOST 00232000=00166000= + IN A LEFT PART LIST. 00233000=00167000= + 202 SIMPLE VARIABLE: MISSING . OR ~ . 00234000=00168000= + 203 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS IN A ROW 00235000=00169000= + DESIGNATOR. 00236000=00170000= + 204 SUBSCRIPTED VARIABLE: MISSING ] IN A ROW DESIGNATOR. 00237000=00171000= + 205 SUBSCRIPTED VARIABLE: A ROW DESIGNATOR APPEARS OUTSIDE OF 00238000=00172000= + AN ACTUAL PARAMETER LIST OR FILL STATEMENT. 00239000=00173000= + 206 SUBSCRIPTED VARIABLE: MISSING ]. 00240000=00174000= + 207 SUBSCRIPTED VARIABLE: MISSING [. 00241000=00175000= + 208 SUBSCRIPTED VARIABLE: WRONG NUMBER OF SUBSCRIPTS. 00242000=00176000= + 209 SUBSCRIPTED VARIABLE: PARTIAL WORD DESIGNATOR NOT LEFT- 00243000=00177000= + MOST IN A LEFT PART LIST. 00244000=00178000= + 210 SUBSCRIPTED VARIABLE: MISSING , OR ~ . 00245000=00179000= + 211 VARIABLE: PROCEDURE ID USED OUTSIDE OF SCOPE IN LEFT PART.00246000=00180000= + 212 VARIABLE: SUB-ARRAY DESIGNATOR PERMITTED AS ACTUAL 00247000=00180100= + PARAMETER ONLY. 00248000=00180200= + 250 STREAM STMT:ILLEGAL STREAM STATEMENT. 00249000=00181000= + 251 ANY STREAM STMT PROCEDURE: MISSING ~. 00250000=00182000= + 252 INDEX: MISSING + OR - . 00251000=00183000= + 253 INDEX: MISSING NUMBER OR STREAM VARIABLE. 00252000=00184000= + 254 SCANNER: STRING, OCTAL, OR HEX CONSTANT HAS FLAG BIT SET. 00253000=00185000= + 255 DSS: MISSING STRING IN DS~ LIT STATEMENT. 00254000=00186000= + 256 RELEASES: MISSING PARENTHESIS OR FILE IDENTIFIER IS NOT 00255000=00187000= + A FORMAL PARAMETER. 00256000=00188000= + 257 GOTOS,LABELS,OR JUMPS: LABEL SPECIFIED IS NOT ON THE SAME 00257000=00189000= + NEXT LEVEL AS A PRECEDING APPEARANCE OF THE 00258000=00190000= + LABEL. 00259000=00191000= + 258 LABELS: MISSING :. 00260000=00192000= + 259 LABELS: LABEL APPEARS MORE THAN ONCE. 00261000=00193000= + 260 GOTOS: MISSING LABEL IN A GO TO OR JUMP OUT TO STATEMENT. 00262000=00194000= + 261 JUMPS: MISSING OUT IN JUMP OUT STATEMENT. 00263000=00195000= + 262 NESTS: MISSING PARENTHESIS. 00264000=00196000= + 263 IFS:MISSING SC IN IF STATEMENT. 00265000=00197000= + 264 IFS: MISSING RELATIONAL IN IF STATEMENT. 00266000=00198000= + 265 IFS: MISSING ALPHA,DC OR STRING IN IF STATEMENT. 00267000=00199000= + 266 IFS: MISSING THEN INIF STATEMENT. 00268000=00200000= + 267 FREDFIX: THERE ARE GO TO STATEMENTS IN WHICH THE LABEL IS 00269000=00201000= + UNDEFINED. 00270000=00202000= + 268 EMITO: A REPEAT INDEX } 64 WAS SPECIFIED OR TOO MANY 00271000=00203000= + FORMAL PARAMETERS,LOCALS AND LABELS. 00272000=00204000= + 269 TABLE: A CONSTANT IS SPECIFIED WHICH IS TOO LARGE 00273000=00205000= + OR TOO SMALL. 00274000=00206000= + 270 IFS: RELATIONAL IN SCALPHA MUST BE "EQUAL". 00275000=00206100= + 271 IFS: IMPROPER CONSTRUCT FOR . 00276000=00206200= + 281 DBLSTMT: MISSING (. 00277000=00207000= + 282 DBLSTMT: TOO MANY OPERATORS. 00278000=00208000= + 283 DBLSTMT: TOO MANY OPERANDS. 00279000=00209000= + 284 DBLSTMT: MISSING , . 00280000=00210000= + 285 DBLSTMT: TOO FEW OPERANDS. 00281000=00211000= + 286 DBLSTMT: ILLEGAL PARAMETER . 00282000=00211100= + 290 FILEATTRIBUTEHANDLER: MISSING . IN FILE ATTRIBUTE PART 00283000=00211510= + 291 FILEATTRIBUTEHANDLER: MISSING OR UNDEFINED FILE ATTRIBUTE00284000=00211520= + 292 FILEATTRIBUTEHANDLER: MISSING ~ IN FILE ATTR ASSIGN STMT 00285000=00211530= + 293 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE IS NON ASSIGNABLE 00286000=00211540= + 294 PRIMARY: FILE ATTRIBUTE IS NOT TYPE REAL 00287000=00211550= + 295 FILEATTRIBUTEHANDLER: FILE ATTRIBUTE MUST BE LEFT MOST 00288000=00211551= + IN A LEFT PART LIST. 00289000=00211552= + 300 FILLSTMT: THE IDENTIFIER FOLLOWING "FILL" IS NOT 00290000=00212000= + AN ARRAY IDENTIFER. 00291000=00213000= + 301 FILLSTMT: MISSING "WITH" IN FILL STATEMENT. 00292000=00214000= + 302 FILLSTMT: IMPROPER FILL ELEMENT. 00293000=00215000= + 303 FILLSTMT: NON-OCTAL CHARACTER IN OCTAL FILL. 00294000=00216000= + 304 FILLSTMT: IMPROPER ARRAY ROW DESIGNATOR IN FILL. 00295000=00217000= + 305 FILLSTMT: DATA IN FILL EXCEEDS 1023 WORDS. 00296000=00218000= +304 FILLSTMT: IMPROPER ROW DESIGNATOR. 00297000=00218100= + 306 FILLSTMT: ODD NUMBER OF PARENTHESES IN FILL. 00298000=00218110= + 307 WHIPOUT: FORMAT > 1023 WORDS. 00299000=00218112= + 350 CHECKCOMMA: MISSING OR ILLEGAL PARAMETER DELIMITER IN 00300000=00218200= + SORT OR MERGE STATEMENT. 00301000=00218210= + 351 OUTPROCHECK: ILLEGAL TYPE FOR SORT OR MERGE OUTPUT PROC. 00302000=00218220= + 352 OUTPROCHECK: OUTPUT PROCEDURE IN SORT OR MERGE STMT DOES 00303000=00218230= + NOT HAVE EXACTLY TWO PARAMETERS. 00304000=00218240= + 353 OUTPROCHECK: FIRST PAREMETER OF OUTPUT PROCEDURE MUST 00305000=00218250= + BE BOOLEAN. 00306000=00218260= + 354 OUTPROCHECK: SECOND PARAM OF OUTPUT PROCEDURE MUST BE 00307000=00218270= + ONE-DIM ARRAY. 00308000=00218280= + 355 SORTSTMT: MISSING (. 00309000=00218290= + 356 HVCHECK: ILLEGAL TYPE FOR SORT OR MERGE HIGHVALUE PRO00310000=00218300= + 357 HVCHECK: HIVALUE PROCEDURE DOES NOT HAVE EXACTLY ONE 00311000=00218310= + PARAMETER. 00312000=00218320= + 358 HVCHECK: HIVALUE PROCEDURE PARAM NOT ONE-DIM ARRAY. 00313000=00218330= + 359 EQLESCHECK: SORT OR MERGE COMPARE PROCEDURE NOT BOOLEAN.00314000=00218340= + 360 EQLESCHECK: COMPARE PROCEDURE DOES NOT HAVE EXACTLY 00315000=00218350= + TWO PARAMETERS. 00316000=00218360= + 361 EQLESCHECK: COMPARE PROCEDURE FIRST PARAM NOT 1-D ARRAY.00317000=00218370= + 362 EQLESCHECK: COMPARE PROCEDURE SECOND PARAM NOT 1-D ARRAY00318000=00218380= + 363 INPROCHECK: SORT STMT INPUT PROCEDURE NOT BOOLEAN. 00319000=00218390= + 364 INPROCHECK: INPUT PROCEDURE DOES NOT HAVE EXACTLY ONE 00320000=00218400= + PARAMETER. 00321000=00218410= + 365 INPROCHECK: INPUT PROCEDURE PARAMETER NOT ONE-D ARRAY. 00322000=00218420= + 366 SORTSTMT: MISSING ). 00323000=00218430= + 367 MERGESTMT: MISSING (. 00324000=00218440= + 368 MERGESTMT: MORE THAN 7 OR LESS THAN 2 FILES TO MERGE. 00325000=00218450= + 369 MERGESTMT: MISSING ). 00326000=00218460= + 381 CMPLXSTMT: MISSING (. 00327000=00218500= + 382 CMPLXSTMT: TOO MANY OPERATORS. 00328000=00218505= + 383 CMPLXSTMT: TOO MANY OPERANDS. 00329000=00218510= + 384 CMPLXSTMT: MISSING , . 00330000=00218515= + 385 CMPLXSTMT: TOO FEW OPERANDS. 00331000=00218520= + 386 CMPLXSTMT: ILLEGAL PARAMETER. 00332000=00218525= + 400 MERRIMAC:MISSING FILE ID IN MONITOR DEC. 00333000=00219000= + 401 MERRIMAC:MISSING LEFT PARENTHESIS IN MONITOR DEC. 00334000=00220000= + 402 MERRIMAC:IMPROPER SUBSCRIPT FOR MONITOR LIST ELEMENT. 00335000=00221000= + 403 MERRIMAC:IMPROPER SUBSCRIPT EXPRESSION DELIMITER IN 00336000=00222000= + MONITOR LIST ELEMENT. 00337000=00223000= + 404 MERRIMAC:IMPROPER NUMBER OF SUBSCRIPTS IN MONITOR LIST 00338000=00224000= + ELEMENT. 00339000=00225000= + 405 MERRIMAC:LABEL OR SWITCH MONITORED AT IMPROPER LAVEL. 00340000=00226000= + 406 MERRIMAC:IMPROPER MONITOR LIST ELEMENT. 00341000=00227000= + 407 MERRIMAC:MISSING RIGHT PARENTHESIS IN MONITOR DECLARATION.00342000=00228000= + 408 MERRIMAC:IMPROPER MONITOR DECLARATION DELIMITER. 00343000=00229000= + 409 DMUP:MISSING FILE IDENTIFIER IN DUMP DECLARATION. 00344000=00230000= + 410 DMUP:MISSING LEFT PARENTHESIS IN DUMP DECLARATION. 00345000=00231000= + 411 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00346000=00232000= + SUBSCRIPTS. 00347000=00233000= + 412 DMUP:SUBSCRIPTED VARIABLE IN DUMP LIST HAS WRONG NUMBER OF00348000=00234000= + SUBSCRIPTS. 00349000=00235000= + 413 DMUP:IMPROPER ARRAY DUMP LIST ELEMENT. 00350000=00236000= + 414 DMUP:ILLEGAL DUMP LIST ELEMENT. 00351000=00237000= + 415 DMUP:MORE THAN 100 LABELS APPEAR AS DUMP LIST ELEMENTS 00352000=00238000= + IN ONE DUMP DECLARATION. 00353000=00239000= + 416 DMUP:ILLEGAL DUMP LIST ELEMENT DELIMITER. 00354000=00240000= + 417 DMUP:MISSING OR NON-LOCAL LABEL IN DUMP DECLARATION. 00355000=00241000= + 418 DMUP:MISSING COLON IN DUMP DECLARATION. 00356000=00242000= + 419 DMUP:IMPROPER DUMP DECLARATION DELIMITER. 00357000=00243000= + 420 READSTMT:MISSING LEFT PARENTHESIS IN READ STATEMENT. 00358000=00244000= + 421 READSTMT:MISSING LEFT PARENTHESIS IN READ REVERSE 00359000=00245000= + STATEMENT. 00360000=00246000= + 422 READSTMT:MISSING FILE IN READ STATEMENT. 00361000=00247000= + 00362000=00248000= + 424 READSTMT:IMPROPER FILE DELIMITER IN READ STATEMENT 00363000=00249000= + 425 READSTMT:IMPROPER FORMAT DELIMITER IN READ STATEMENT. 00364000=00250000= + 426 READSTMT:IMPROPER DELIMITER FOR SECOND PARAMETER IN READ 00365000=00251000= + STATEMENT. 00366000=00252000= + 427 READSTMT:IMPROPER ROW DESIGNATOR IN READ STATEMENT. 00367000=00253000= + 428 READSTMT:IMPROPER ROW DESIGNATOR DELIMITER IN READ 00368000=00254000= + STATEMENT. 00369000=00255000= + 429 READSTMT:MISSING ROW DESIGNATOR IN READ STATEMENT. 00370000=00256000= + 430 READSTMT:IMPROPER DELIMITER PRECEEDING THE LIST IN A READ 00371000=00257000= + STATEMENT. 00372000=00258000= + 00373000=00259000= + 00374000=00260000= + 00375000=00261000= + 00376000=00262000= + 433 HANDLETHETAILENDOFAREADORSPACESTATEMENT:MISSING RIGHT 00377000=00263000= + BRACKET IN READ OR SPACE STATEMENT. 00378000=00264000= + 434 SPACESTMT:MISSING LEFT PARENTHESIS IN SPACE STATEMENT. 00379000=00265000= + 435 SPACESTMT:IMPROPER FILE IDENTIFIER IN SPACE STATEMENT. 00380000=00266000= + 436 SPACESTMT:MISSING COMMA IN SPACE STATEMENT. 00381000=00267000= + 437 SPACESTMT:MISSING RIGHT PARENTHESIS IN SPACE STATEMENT. 00382000=00268000= + 438 WRITESTMT:MISSING LEFT PARENTHESIS IN A WRITE STATEMENT. 00383000=00269000= + 439 WRITESTMT:IMPROPER FILE IDENTIFIER IN A WRITE STATEMENT. 00384000=00270000= + 440 WRITESTMT:IMPROPER DELIMITER FOR FIRST PARAMETER IN A 00385000=00271000= + WRITE STATEMENT. 00386000=00272000= + 441 WRITESTMT:MISSING RIGHT BRACKET IN CARRIAGE CONTROL PART 00387000=00273000= + OF A WRITE STATEMENT. 00388000=00274000= + 442 WRITESTMT:ILLEGAL CARRIAGE CONTROL DELIMITER IN A WRITE 00389000=00275000= + STATEMENT. 00390000=00276000= + 443 WRITESTMT:IMPROPER SECOND PARAMETER DELIMITER IN WRITE 00391000=00277000= + STATEMENT. 00392000=00278000= + 444 WRITESTMT:IMPROPER ROW DESIGNATOR IN A WRITE STATEMENT. 00393000=00279000= + 445 WRITESTMT:MISSING RIGHT PARENTHESIS AFTER A ROW DESIGNATOR00394000=00280000= + IN A WRITE STATEMENT. 00395000=00281000= + 446 WRITESTMT:MISSING ROW DESIGNATOR IN A WRITE STATEMENT. 00396000=00282000= + 447 WRITESTMT:IMPROPER DELIMITER PRECEEDING A LIST IN A WRITE 00397000=00283000= + STATEMENT. 00398000=00284000= + 448 WRITESTMT:IMPROPER LIST DELIMITER IN A WRITE STATEMENT. 00399000=00285000= + 449 READSTMT:IMPROPER LIST DELIMITER IN A READ STATEMENT. 00400000=00286000= + 450 LOCKSTMT:MISSING LEFT PARENTHESIS IN A LOCK STATEMENT. 00401000=00287000= + 451 LOCKSTMT:IMPROPER FILE PART IN A LOCK STATEMENT. 00402000=00288000= + 452 LOCKSTMT:MISSING COMMA IN A LOCK STATEMENT. 00403000=00289000= + 453 LOCKSTMT:IMPROPER UNIT DISPOSITION PART IN A LOCK 00404000=00290000= + STATEMENT. 00405000=00291000= + 454 LOCKSTMT:MISSING RIGHT PARENTHESIS IN A LOCK STATEMENT. 00406000=00292000= + 455 CLOSESTMT:MISSING LEFT PARENTHESIS IN A CLOSE STATEMENT. 00407000=00293000= + 456 CLOSESTMT:IMPROPER FILE PART IN A CLOSE STATEMENT. 00408000=00294000= + 457 CLOSESTMT:MISSING COMMA IN A CLOSE STATEMENT. 00409000=00295000= + 458 CLOSESTMT:IMPROPER UNIT DISPOSITION PART IN A CLOSE 00410000=00296000= + STATEMENT. 00411000=00297000= + 459 CLOSESTMT:MISSING RIGHT PARENTHESIS IN A CLOSE STATEMENT. 00412000=00298000= + 460 RWNDSTMT:MISSING LEFT PARENTHESIS IN A REWIND STATEMENT. 00413000=00299000= + 461 RWNDSTMT:IMPROPER FILE PART IN A REWIND STATEMENT. 00414000=00300000= + 462 RWNDSTMT:MISSING RIGHT PARENTHESIS IN A REWIND STATEMENT. 00415000=00301000= + 463 BLOCK:A MONITOR DECLARATION APPEARS IN THE SPECIFICATION 00416000=00302000= + PART OF A PROCEDURE. 00417000=00303000= + 464 BLOCK:A DUMP DECLARATION APPEARS IN THE SPECIFICATION PART00418000=00304000= + OF A PROCEDURE. 00419000=00305000= + 465 DMUP:DUMP INDICATOR MUST BE UNSIGNED INTEGER OR 00420000=00305003= + SIMPLE VARIABLE 00421000=00305004= + 500 SEARCHLIB: ILLEGAL LIBRARY IDENTIFIER. 00422000=00305010= + 501 SEARCHLIB: LIBRARY IDENTIFIER NOT CONTAINED IN DIRECTORY. 00423000=00305020= + 502 SEARCHLIB: ILLEGAL LIBRARY START POINT. 00424000=00305030= + 503 SEARCHLIB: SEPARATOR REQUIRED BETWEEN START POINT AND LENGTH. 00425000=00305040= + 504 SEARCHLIB: ILLEGAL LIBRARY LENGTH. 00426000=00305050= + 505 SEARCHLIB: MISSING BRACKET. 00427000=00305060= + 00428000=00305070= + 507 SEARCHLIB: TAPE POSITIONING ERROR. 00429000=00305080= + 509 IODEC: NON-LITERAL FILE VALUE NOT GLOBAL TO FILE DECL. 00430000=00305100= + 520 TABLE: STRING LONGER THAN ONE WORD (48 BITS). 00431000=00306200= + 521 TABLE: STRING CONTAINS A NON-PERMISSIBLE CHARACTER. 00432000=00306300= + 600 DOLLARCARD: NUMBER EXPECTED. 00433000=00400000= + 601 DOLLARCARD: OPTION IDENTIFIER EXPECTED. 00434000=00401000= + 602 DOLLARCARD: TOO MANY USER-DEFINED OPTIONS. 00435000=00403000= + 603 DOLLARCARD: UNRECOGNIZED WORD OR CHARACTER. 00436000=00404000= + 604 DOLLARCARD: MISMATCHED PARENTHESES. 00437000=00405000= + 610 READACARD: SEQUENCE ERROR. 00438000=00410000= + 611 READACARD: ERROR LIMIT HAS BEEN EXCEEDED. 00439000=00411000= + 612 INCLUDECARD: TOOMANY NESTED INCLUDES. 00440000=00412000= + 613 INCLUDECARD: MISSING FILE NAME ON INCLUDE CARD. 00441000=00413000= + 614 INCLUDECARD: ENDING SEQUENCE NUMBER MISSING. 00442000=00414000= + 615 INCLUDECARD: COPY MISSING ON INCLUDE CARD. 00443000=00415000= + 616 INCLUDECARD: MORE THAN ONE FILE NAME ON INCLUDE CARD 00444000=00416000= + 617 INCLUDECARD: + COPY CAN NOT BE USED UNLESS $ IS IN COLUMN ONE 00445000=00417000= + 618 BLOCK: AUXMEM APPEARS IMMEDIATELY BEFORE IDENTIFIER (NO TYPE) 00446000=00418000= + ; 00447000=00490000= + $POP OMIT LISTA 00448000=00499999= +BEGIN 00449000=00500000= + COMMENT OUTERMOST BLOCK; 00450000=00500000= +INTEGER 00505000=00501000= + ERRORCOUNT; 00510000=00501000= + COMMENT NUMBER OF ERROR MSGS. MCP WILL TYPE 00515000=00501000= + SYNTX ERR AT EOJ IF THIS IS NON-ZERO. MUST BE @R+25; 00520000=00502000= +INTEGER 00525000=00503000= + SAVETIME; 00530000=00503000= + COMMENT SAVE-FACTOR FOR CODE FILE, GIVEN BY MCP. 00535000=00503000= + IF COMPILER & GO =0.FOR SYNTAX, =-1. MUST BE AT R+26;00540000=00504000= +INTEGER 00545000=00504100= + CARDNUMBER; % SEQ # OF CARD BEING PROCESSED. 00550000=00504100= +INTEGER 00555000=00504150= + CARDCOUNT; % NUMBER OF CARDS PROCESSED. 00560000=00504150= +INTEGER 00565000=00504200= + LASTADDRESS; 00570000=00504200= +ARRAY 00575000=00504300= + ENIL[0:7, 0:127]; 00580000=00504300= +INTEGER 00585000=00504400= + ENILPTR; 00590000=00504400= +DEFINE 00595000=00504500= + ENILSPOT = ENIL[ENILPTR.[38:3], ENILPTR.[41:7]] #; 00600000=00504500= +ARRAY 00605000=00504600= + LDICT[0:7, 0:127]; 00610000=00504600= +BOOLEAN 00615000=00504700= + BUILDLINE; 00620000=00504700= +BOOLEAN 00625000=00504801= + REL; 00630000=00504801= + COMMENT RR1-RR11 ARE USED BY SOME PROCEDURES IN LIEU OF LOCALS. 00635000=00505000= + TO SAVE SOME STACK SPACE; 00640000=00506000= +REAL 00645000=00507000= + RR1, 00650000=00507000= + RR2, 00655000=00507000= + RR3, 00660000=00507000= + RR4, 00665000=00507000= + RR5, 00670000=00507000= + RR6, 00675000=00507000= + RR7, 00680000=00507000= + RR8, 00685000=00507000= + RR9, 00690000=00507000= + RR10, 00695000=00507000= + RR11; 00700000=00507000= + COMMENT SOME OF THE RRI ARE USED TO PASS FILE INFORMATION TO 00705000=00508000= + THE MAIN BLOCK; 00710000=00509000= + 00715000=00510000= + COMMENT EXAMIN RETURNS THE CHARACTER AT ABSOLUTE ADDRESS NCR; 00720000=00510000= +REAL 00725000=00511000= + STREAM PROCEDURE EXAMIN(NCR); 00730000=00511000= +VALUE 00735000=00511000= + NCR; 00740000=00511000= + BEGIN 00745000=00512000= + SI:= NCR; 00750000=00512000= + DI:= LOC EXAMIN; 00755000=00512000= + DI:= DI+7; 00760000=00512000= + DS:= CHR 00765000=00512000= + END; 00770000=00512000= +REAL 00775000=00512100= + STREAM PROCEDURE EXAMINELAST(AC, CT); 00780000=00512100= +VALUE 00785000=00512100= + CT; 00790000=00512100= + BEGIN 00795000=00512200= + SI:= AC; 00800000=00512300= + SI:= SI+CT; 00805000=00512300= + DI:= LOC EXAMINELAST; 00810000=00512400= + DI:= DI+7; 00815000=00512400= + DS:= 1 CHR; 00820000=00512500= + END EXAMINELAST; 00825000=00512600= + COMMENT MOVECHARACTERS MOVES N CHARACTERS FROM THE SK-TH CHARACTER 00830000=00513000= + IN SORCE TO THE DK-TH CHARACTER IN DEST, 0{N{63,0{SK{127; 00835000=00514000= +DEFINE 00840000=00514500= + DK = DSK #; 00845000=00514500= +STREAM PROCEDURE MOVECHARACTERS(N, SORCE, SK, DEST, DSK); 00850000=00515000= +VALUE 00855000=00516000= + N, 00860000=00516000= + SK, 00865000=00516000= + DSK; 00870000=00516000= + BEGIN 00875000=00517000= + SI:= LOC SK; 00880000=00517000= + SI:= SI+6; 00885000=00517000= + IF SC ^= 6"0" THEN 00890000=00518000= + BEGIN 00895000=00518000= + SI:= SORCE; 00900000=00518000= + 2(SI:= SI+32); 00905000=00518000= + SORCE:= SI 00910000=00518000= + END; 00915000=00518000= + SI:= LOC DK; 00920000=00519000= + SI:= SI+6; 00925000=00519000= + DI:= DEST; 00930000=00519000= + IF SC ^= 6"0" THEN 00935000=00520000= + 2(DI:= DI+32); 00940000=00520000= + SI:= SORCE; 00945000=00521000= + SI:= SI+SK; 00950000=00521000= + DI:= DI+DK; 00955000=00521000= + DS:= N CHR; 00960000=00521000= + END MOVECHARACTERS; 00965000=00522000= +INTEGER 00970000=00523000= + STREAM PROCEDURE GETF(Q); 00975000=00523000= +VALUE 00980000=00523000= + Q; 00985000=00523000= + BEGIN 00990000=00524000= + SI:= LOC GETF; 00995000=00524000= + SI:= SI-7; 01000000=00524000= + DI:= LOC Q; 01005000=00524000= + DI:= DI+5; 01010000=00524000= + SKIP 3 DB; 01015000=00525000= + (IF SB THEN DS:= SET ELSE DS:= RESET;SKIP SB); 01020000=00525000= + DI:= LOC Q; 01025000=00526000= + SI:= Q; 01030000=00526000= + DS:= WDS; 01035000=00526000= + SI:= Q; 01040000=00526000= + GETF:= SI 01045000=00527000= + END GETF; 01050000=00527000= + 01055000=00528000= + COMMENT START SETTING UP FILE PARAMETERS; 01060000=00528000= +IF EXAMIN(RR11:= GETF(3)+6"Y08") ^= 12 THEN 01065000=00529000= + RR1:= 5 01070000=00529000= +ELSE 01075000=00529000= + BEGIN 01080000=00530000= + RR1:= 2; 01085000=00530000= + RR2:= 150 01090000=00530000= + END; 01095000=00530000= +IF EXAMIN(RR11+5) ^= 12 THEN 01100000=00531000= + RR3:= 4 01105000=00531000= +ELSE 01110000=00531000= + BEGIN 01115000=00532000= + RR3:= 2; 01120000=00532000= + RR4:= 150 01125000=00532000= + END; 01130000=00532000= +IF EXAMIN(RR11+10) = 12 THEN 01135000=00533000= + BEGIN 01140000=00534000= + RR5:= 2; 01145000=00534000= + RR6:= 10; 01150000=00534000= + RR7:= 150 01155000=00534000= + END 01160000=00535000= +ELSE 01165000=00535000= + BEGIN 01170000=00535000= + RR5:= 1; 01175000=00535000= + RR6:= 56; 01180000=00535000= + RR7:= 10 01185000=00535000= + END; 01190000=00535000= +IF EXAMIN(RR11+15) = 12 THEN 01195000=00536000= + BEGIN 01200000=00537000= + RR8:= 10; 01205000=00537000= + RR9:= 150 01210000=00537000= + END 01215000=00538000= +ELSE 01220000=00538000= + BEGIN 01225000=00538000= + RR8:= 56; 01230000=00538000= + RR9:= 10 01235000=00538000= + END; 01240000=00538000= +IF EXAMIN(RR11+20) = 12 THEN 01245000=00539000= + RR10:= 150; 01250000=00539000= + BEGIN 01255000=01000000= + INTEGER 01260000=01000700= + NUMSEQUENCEERRORS; 01265000=01000700= + INTEGER 01270000=01000800= + OPINX; % USED FOR INDEXING INTO OPTIONS ARRAY. 01275000=01000800= + BOOLEAN 01280000=01000802= + SETTING; % USED BY DOLLARCARD FOR AN OPTION"S SETTING 01285000=01000802= + BOOLEAN 01290000=01000810= + GOGOGO; % TRUE FOR SPECIAL WRITES AND READS 01295000=01000810= + PROCEDURE CHECKBOUNDLVL; 01300000=01000830= + FORWARD; 01305000=01000830= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%01310000=01000830= + BOOLEAN 01315000=01000840= + ARRAYFLAG; % USED TO INFORM PRIMARY AND BOOPRIM THAT WE ARE 01320000=01000840= + % EVALUATING AN ARRAY BOUND 01325000=01000850= + INTEGER 01330000=01000860= + NEWINX, 01335000=01000860= + ADDVALUE, 01340000=01000860= + BASENUM, 01345000=01000860= + TOTALNO; 01350000=01000860= + COMMENT ADDVALUE IS INCREMENT VALUE FOR RESEQUENCING 01355000=01000870= + BASENUM IS STARTING VALUE 01360000=01000880= + TOTALNO IS BASENUM + ADDVALUE CALCULATED FOR EACH 01365000=01000890= + CARD AS TOTALNO = TOTALNO + ADDVALUE; 01370000=01000900= + DEFINE 01375000=01000902= + OPARSIZE = 200 #; 01380000=01000902= + ARRAY 01385000=01000904= + OPTIONS[0:OPARSIZE]; 01390000=01000904= + BOOLEAN 01395000=01000910= + OPTIONWORD; 01400000=01000910= + DEFINE 01405000=01000920= + CHECKBIT = 1 #, 01410000=01000930= + DEBUGBIT = 2 #, 01415000=01000940= + DECKBIT = 3 #, 01420000=01000950= + FORMATBIT = 4 #, 01425000=01000960= + INTBIT = 5 #, 01430000=01000970= + LISTABIT = 6 #, 01435000=01000980= + LISTBIT = 7 #, 01440000=01000990= + LISTPBIT = 8 #, 01445000=01001000= + MCPBIT = 9 #, 01450000=01001010= + MERGEBIT = 10 #, 01455000=01001020= + NESTBIT = 11 #, 01460000=01001030= + NEWBIT = 12 #, 01465000=01001040= + NEWINCLBIT = 13 #, 01470000=01001050= + OMITBIT = 14 #, 01475000=01001060= + PRINTDOLLARBIT = 01480000=01001060= + 15 #, 01485000=01001070= + PRTBIT = 16 #, 01490000=01001080= + PUNCHBIT = 17 #, 01495000=01001090= + PURGEBIT = 18 #, 01500000=01001100= + SEGSBIT = 19 #, 01505000=01001110= + SEQBIT = 20 #, 01510000=01001120= + SEQERRBIT = 21 #, 01515000=01001130= + SINGLBIT = 22 #, 01520000=01001140= + STUFFBIT = 23 #, 01525000=01001150= + VOIDBIT = 24 #, 01530000=01001160= + VOIDTBIT = 25 #, 01535000=01001170= + XREFBIT = 26 #, 01540000=01001171= + BENDBIT = 27 #, 01545000=01001172= + CODEFILEBIT = 29 #, 01550000=01001173= + USEROPINX = 30 #; 01555000=01001173= + 01560000=01001180= +COMMENT IF A NEW COMPILER-DEFINED OPTION IS ADDED, CHANGE USEROPINX 01565000=01001180= + AND ADD OPTION IN DEFINES BELOW, IN DOLLARCARD, AND IN 01570000=01001190= + FILL STATEMENT IN INITIALIZATION OF COMPILER; 01575000=01001200= + DEFINE 01580000=01001210= + CHECKTOG = OPTIONWORD.[CHECKBIT:1] #, 01585000=01001220= + DEBUGTOG = OPTIONWORD.[DEBUGBIT:1] #, 01590000=01001230= + DECKTOG = OPTIONWORD.[DECKBIT:1] #, 01595000=01001240= + FORMATTOG = OPTIONWORD.[FORMATBIT:1] #, 01600000=01001250= + INTOG = OPTIONWORD.[INTBIT:1] #, 01605000=01001260= + LISTATOG = OPTIONWORD.[LISTABIT:1] #, 01610000=01001270= + LISTOG = OPTIONWORD.[LISTBIT:1] #, 01615000=01001280= + LISTPTOG = OPTIONWORD.[LISTPBIT:1] #, 01620000=01001290= + MCPTOG = OPTIONWORD.[MCPBIT:1] #, 01625000=01001300= + MERGETOG = OPTIONWORD.[MERGEBIT:1] #, 01630000=01001310= + NESTTOG = OPTIONWORD.[NESTBIT:1] #, 01635000=01001320= + NEWTOG = OPTIONWORD.[NEWBIT:1] #, 01640000=01001330= + NEWINCL = OPTIONWORD.[NEWINCLBIT:1] #, 01645000=01001340= + OMITTING = OPTIONWORD.[OMITBIT:1] #, 01650000=01001350= + PRINTDOLLARTOG = 01655000=01001350= + OPTIONWORD.[PRINTDOLLARBIT:1] #, 01660000=01001360= + PRTOG = OPTIONWORD.[PRTBIT:1] #, 01665000=01001370= + PUNCHTOG = OPTIONWORD.[PUNCHBIT:1] #, 01670000=01001380= + PURGETOG = OPTIONWORD.[PURGEBIT:1] #, 01675000=01001390= + SEGSTOG = OPTIONWORD.[SEGSBIT:1] #, 01680000=01001400= + SEQTOG = OPTIONWORD.[SEQBIT:1] #, 01685000=01001410= +COMMENT SEQTOG INDICATES RESEQUENCING IS TO BE DONE; 01690000=01001410= + SEQERRTOG = OPTIONWORD.[SEQERRBIT:1] #, 01695000=01001430= + SINGLTOG = OPTIONWORD.[SINGLBIT:1] #, 01700000=01001440= + STUFFTOG = OPTIONWORD.[STUFFBIT:1] #, 01705000=01001450= + VOIDING = OPTIONWORD.[VOIDBIT:1] #, 01710000=01001460= + VOIDTAPE = OPTIONWORD.[VOIDTBIT:1] #, 01715000=01001461= + XREF = OPTIONWORD.[XREFBIT:1] #, 01720000=01001462= + BEND = OPTIONWORD.[BENDBIT:1] #, 01725000=01001463= + CODEFILE = OPTIONWORD.[CODEFILEBIT:1] #, 01730000=01001470= + DUMMY = #; 01735000=01001470= + BOOLEAN 01740000=01001480= + NOHEADING; % TRUE IF DATIME HAS NOT BEEN CALLED. 01745000=01001480= + BOOLEAN 01750000=01001490= + NEWBASE; % NEW BASENUM FOUND ON A NEW $-CARD. 01755000=01001490= + BOOLEAN 01760000=01001500= + LASTCRDPATCH; % NORMALLY FALSE, SET TO TRUE WHEN THE 01765000=01001500= + % LAST CARD FROM SYMBOLIC LIBRARY READ 01770000=01001510= + % IS PATCHED FROM THE CARD READER. 01775000=01001520= + INTEGER 01780000=01001530= + XMODE; % TELLS DOLLARCARD HOW TO SET OPTIONS. 01785000=01001530= + BOOLEAN 01790000=01001540= + DOLLARTOG; % TRUE IF SCANNING A DOLLAR CARD. 01795000=01001540= + INTEGER 01800000=01001550= + ERRMAX; % COMPILATION STOPS IF EXCEEDED. 01805000=01001550= + BOOLEAN 01810000=01001560= + SEQXEQTOG; % GIVE SEQ. NO. WHEN DS-ING OBJ. 01815000=01001560= + BOOLEAN 01820000=01001570= + LISTER; % LISTOG OR LISTATOG OR DEBUGTOG. 01825000=01001570= + ALPHA 01830000=01001580= + MEDIUM; % INPUT IS: T,C,P,CA,CB,CC. 01835000=01001580= + INTEGER 01840000=01001590= + MYCLASS; % USED IN DOLLARCARD EVALUATION. 01845000=01001590= + REAL 01850000=01001600= + BATMAN; % USED IN DOLLARCARD EVALUATION. 01855000=01001600= + ARRAY 01860000=01003000= + SPECIAL[0:31]; 01865000=01003000= + COMMENT THIS ARRAY HOLDS THE INTERNAL CODE FOR THE SPECIAL 01870000=01004000= + CHARACTORS: IT IS FILLED DURING INITIALIZATION; 01875000=01005000= + SAVE ALPHA ARRAY IDARRAY[0:127]; 01880000=01006000= + ARRAY 01885000=01007000= + INFO[0:31, 0:255]; 01890000=01007000= +%***********************************************************************01895000=01007005= +% X R E F S T U F F 01900000=01007010= +%***********************************************************************01905000=01007015= +% 01910000=01007020= + ARRAY 01915000=01007030= + XREFAY2[0:29], 01920000=01007030= + % ARRAY OF ONE WORD REFERENCE RECORDS. 01925000=01007030= + % THE LAYOUT OF EACH WORD IS 01930000=01007035= + % 01935000=01007040= + % .[1:5] TYPE OF REFERENCE 01940000=01007045= + % = 0 FOR FORWARD DECL 01945000=01007050= + % = 1 FOR LABEL OCCURENCE 01950000=01007051= + % = 2 FOR NORMAL DECL 01955000=01007055= + % = 4 FOR NORMAL REFERENCE 01960000=01007060= + % = 5 FOR ASSIGNMENT 01965000=01007065= + % 01970000=01007070= + % NOTE: THE LOWER ORDER BIT 01975000=01007075= + % OF THIS FIELD IS ON 01980000=01007080= + % IF YOU WANT STARS 01985000=01007085= + % AROUND THIS REFERENCE 01990000=01007090= + % IN THE XREF 01995000=01007095= + % 02000000=01007100= + % .[6:15] IDENTIFIER ID. NO. 02005000=01007105= + % THIS IS A UNIQUE NUMBER THAT 02010000=01007110= + % IS ASSIGNED WHEN THE 02015000=01007115= + % IDENTIFIER IS ENCOUNTERE 02020000=01007120= + % FOR THE FIRST TIME. 02025000=01007125= + % 02030000=01007130= + % .[21:27] SEQUENCE NUMBER 02035000=01007135= + % 02040000=01007140= +XREFAY1[0:9], 02045000=01007145= + % RECORD BUFFER AREA FOR WRITING OUT THE 02050000=01007145= + % NAME INFORMATION RECORDS, ONE RECORD 02055000=01007150= + % IS WRITTEN FOR EACH IDENTIFIER IN THE SYMBOL 02060000=01007155= + % TABLE WHEN THE IDENTIFIER IS PURGED FROM THE 02065000=01007160= + % SYMBOL TABLE, I.E., WHEN LEAVING THE BLOCK 02070000=01007165= + % IN WHICH THE IDENTIFIER IS DECLARED. 02075000=01007170= + % 02080000=01007175= + % THE LAYOUT OF EACH IS: 02085000=01007180= + % 02090000=01007185= + % WORDS 0-7 THE IDENTIFIER WITH BLANK 02095000=01007190= + % FILE ON THE RIGHT 02100000=01007195= + % 02105000=01007200= + % WORD 8 02110000=01007205= + % .[21:12] SEGMENT NUMBER IN WHICH 02115000=01007210= + % THIS IDENTIFIER WAS DECLARED02120000=01007215= + % 02125000=01007220= + % .[33:15] IDENTIFIER ID. NO. 02130000=01007225= + % 02135000=01007230= + % WORD 9 ELBAT WORD 02140000=01007235= + % 02145000=01007240= +XINFO[0:31, 0:127]; % THIS ARRAY CONTAINS ONE ENTRY FOR EACH ENTRY 02150000=01007245= + % IN THE INFO TABLE. IF YOU HAVE THE INDEX 02155000=01007250= + % OF THE ELBAT WORD FOR AN IDENTIFIER IN 02160000=01007255= + % THE INFO TABLE YOU CAN FIND THE XINFO WORD 02165000=01007260= + % FOR THE IDENTIFIER BY REFERRING TO: 02170000=01007265= + % 02175000=01007270= + % XINFO[INDEX.LINKR,INDEX.LINKC DIV 2] 02180000=01007275= + % 02185000=01007280= + % EACH ENTRY CONTAINS: 02190000=01007285= + % 02195000=01007290= + % .[21:12] SEGMENT NUMBER IN WHICH 02200000=01007295= + % THIS IDENTIFIER WAS DECL02205000=01007300= + % 02210000=01007305= + % .[33:15] IDENTIFIER ID. NO. 02215000=01007310= + % IF THIS ID. NO. IS ZERO 02220000=01007315= + % THEN XREF WAS NOT ON 02225000=01007320= + % AT THE TIME THE IDENT 02230000=01007325= + % WAS DECLARED AND ALL 02235000=01007330= + % FUTURE REFERENCES WILL 02240000=01007335= + % BE DISCARDED. 02245000=01007340= + % 02250000=01007345= + INTEGER 02255000=01007350= + % 02260000=01007350= +XREFPT, 02265000=01007355= + % CONTAINS INDEX OF NEXT AVAILABLE SLOT IN 02270000=01007355= + % XREFAY2, WHEN THIS BECOMES GREATER 02275000=01007360= + % THAN 30 THE CURRENT ARRAY IS DUMPED TO DISK 02280000=01007365= + % AND XREFPT IS RESET TO ZERO. 02285000=01007370= + % 02290000=01007375= +XLUN; % THIS VARIABLE CONTROLS THE ASSIGNING OF 02295000=01007380= + % ID. NO. TO IDENTIFIERS. IT IS INCREMENTED 02300000=01007385= + % EACH TIME A NEW IDENTIFIER IS ENCOUNTERED. 02305000=01007390= + % 02310000=01007395= + DEFINE 02315000=01007400= + % 02320000=01007400= + SEGNOF = [21:12] #, 02325000=01007405= + % FIELDS IN XINFO ENTRIES AND WORD 8 OF 02330000=01007405= + IDNOF = [33:15] #, 02335000=01007410= + % IDENTIFIER RECORDS. 02340000=01007410= + % 02345000=01007415= + TYPEREF = [1:5] #, 02350000=01007420= + % FIELDS OF REFERENCE WORDS 02355000=01007420= + REFIDNOF = [6:15] #, 02360000=01007425= + % 02365000=01007425= + SEQNOF = [21:27] #, 02370000=01007430= + % 02375000=01007430= + % 02380000=01007435= + XREFIT(INDEX, SEQNO, REFTYPE) = % DEFINE TO ADD INFO TO REF TABLE 02385000=01007440= + BEGIN 02390000=01007445= + IF XREF THEN 02395000=01007445= + CROSSREFIT(INDEX, SEQNO, REFTYPE); 02400000=01007445= + END #, 02405000=01007450= + % 02410000=01007450= + XMARK(REFTYPE) = % DEFINE TO CHANGE LAST ENTRY IN REF TABLE TO A 02415000=01007455= + BEGIN 02420000=01007460= + IF XREF THEN 02425000=01007460= + XREFAY2[XREFPT-1].TYPEREF:= REFTYPE 02430000=01007460= + END #, 02435000=01007465= + % 02440000=01007465= + XREFDUMP(INDEX) = % DEFINE TO DUMP SYMBOL TABLE INFO FOR IDENTIFIER02445000=01007470= + BEGIN 02450000=01007475= + IF DEFINING.[1:1] THEN 02455000=01007475= + CROSSREFDUMP(INDEX); 02460000=01007475= + END #, 02465000=01007480= + % 02470000=01007480= + XREFINFO[INDEX] = % DEFINE TO TRANSLATE INFO ROW AND COLUMN TO 02475000=01007481= + XINFO[(INDEX).LINKR, (INDEX).LINKC DIV 2] #, 02480000=01007482= + % XINFO ROW AND COL 02485000=01007482= + % 02490000=01007483= + FORWARDREF = 0 #, 02495000=01007485= + % DEFINES FOR DIFFERENT REFERENCE TYPES 02500000=01007485= + LBLREF = 1 #, 02505000=01007486= + % 02510000=01007486= + DECLREF = 2 #, 02515000=01007490= + % 02520000=01007490= + NORMALREF = 4 #, 02525000=01007495= + % 02530000=01007495= + ASSIGNREF = 5 #; % 02535000=01007500= + ARRAY 02540000=01007600= + BEGINSTACK[0:255]; 02545000=01007600= + INTEGER 02550000=01007600= + BSPOINT; 02555000=01007600= + BOOLEAN 02560000=01007650= + DEFINING; 02565000=01007650= + COMMENT INFO CONTAINS ALL THE INFORMATION ABOUT A GIVEN IDENTIFIER 02570000=01008000= + OR RESERVED WORD. THE FIRST WORD OF A GIVEN ENTRY IS 02575000=01009000= + THE INTERNAL CODE (OR ELBAT WORD AS IT IS USUALLY 02580000=01010000= + CALLED). THE SECOND WORD CONTAINS THE FORWARD BIT (IN 02585000=01011000= + [1:1]) FOR PROCEDURES. THE LINK TO PREVIOUS ENTRY (IN 02590000=01012000= + [4:8]). THE NUMBER OF CHARACTORS IN THE ALPHA REPRESENTA- 02595000=01013000= + TION (IN [12:6]), AND THE FIRST 5 CHARACTERS OF ALPHA. 02600000=01014000= + SUCCEDING WORDS CONTAIN THE REMAINING CHARACTORS OF ALPHA,02605000=01015000= + FOLLOWED BY ANY ADDITIONAL INFORMATION. THE ELBAT WORD 02610000=01016000= + AND THE ALPHA FOR ANY QUANTITY ARE NOT SPLUT ACROSS A ROW 02615000=01017000= + OF INFO. FOR PURPOSES OF FINDING AN IDENTIFIER OR 02620000=01018000= + RESERVED WORD THE QUANTITIES ARE SCATTERED INTO 125 02625000=01019000= + DIFERENT LISTS OR STACKES. WHICH STACK CONTAINS A QUANTITY02630000=01020000= + IS GIVEN BY TAKING NAAAAA MOD 125 WHERE N IS THE NUMBER 02635000=01021000= + OF CHARACTORS AND AAAAA IS THE FIRST 5 CHARACTORS OF 02640000=01022000= + ALPHA, FILLED IN WITH ZEROS FROM THE RIGHT IF NEEDED. 02645000=01023000= + THIS NUMBER IS CALLED THE SCRAMBLE NUMBER OR INDEX. 02650000=01024000= + THE FIRST ROW OF INFO IS USED FOR OTHER PURPOSES. THE 02655000=01025000= + RESERVED WORDS OCCUPY THE SECOND ROW, IT IS FILLED DURING 02660000=01026000= + INITIALIZATION; 02665000=01027000= + 02670000=01028000= +COMMENT INFO FORMAT 02675000=01028000= + FOLLOWING IS A DESCRIPTION OF THE FORMAT OF ALL TYPES OF ENTRIES 02680000=01029000= + ENTERED IN INFO: 02685000=01030000= + THE FIRST WORD OF ALL ENTRIES IS THE ELBAT WORD. 02690000=01031000= + THE INCR FIELD ([27:8]) CONTAINS AN INCREMENT WHICH WHEN 02695000=01032000= + ADDED TO THE CURRENT INDEX INTO INFO YELDSAN INDEX TO ANY 02700000=01033000= + ADDITIONAL INFO (IF ANY) FOR THIS ENTRY. 02705000=01034000= + E.G. IF THE INDEX IS IX THEN INFO[(IX+INCR).LINKR,(IX+INCR). 02710000=01035000= + LINKC] WILL CONTAIN THE FIRST WORD OF ADDITIONAL INFO. 02715000=01036000= + THE LINK FIELD OF THE ELBAT WORD IN INFO IS DIFFERENT FROM 02720000=01037000= + THAT OF THE ENTRY IN ELBAT PUT IN BY TABLE.THE ENTRY IN ELBAT 02725000=01038000= + POINTS TO ITS OWN LOCATION (RELATIVE) IN INFO. 02730000=01039000= + THE LINK IN INFO POINTS TO THE PREVIOUS ENTRY E.G.. THE 02735000=01040000= + LINK FROM STACKHEAD WHICH THE CURRENT ENTRY REPLACED. 02740000=01041000= + FOR SIMPLICITY,I WILL CONSIDER INFO TO BE A ONE DIMENSIONAL 02745000=01042000= + ARRAY,SO THAT THE BREAKING UP OF THE LINKS INTO ROW AND COLUMN 02750000=01043000= + WILL NOT DETRACT FROM THE DISCUSSION. 02755000=01044000= + ASSUME THAT THREE IDENTIFIERS A,B,AND C "SCRAMBLE" INTO 02760000=01045000= + THE SAME STACKHEAD LOCATION IN THE ORDER OF APPEARANCE. 02765000=01046000= + FURTHER ASSUME THERE ARE NO OTHER ENTRIES CONNECTED TO 02770000=01047000= + THIS STACKHEAD INDEX. LET THIS STACKHEAD LOCATION BE 02775000=01048000= + S[L] 02780000=01049000= + NOW THE DECLARATION 02785000=01050000= + BEGIN REAL A,B,C IS ENCOUNTERED 02790000=01051000= + IF THE NEXT AVAILABLE INFO SPACE IS CALLED NEXTINFO 02795000=01052000= + THEN A IS ENTERED AS FOLLOWS:(ASSUME AN ELBAT WORD T HAS BEEN 02800000=01053000= + CONSTRUCTED FOR A) 02805000=01054000= + T.LINK~ S[L]. (WHICH IS ZERO AT FIRST). 02810000=01055000= + INFO[NEXTINFO]~T, S[L]~NEXTINFO. 02815000=01056000= + NEXTINFO~NEXTINFO+NUMBER OF WORDS IN THIS 02820000=01057000= + ENTRY. 02825000=01058000= + NOW S[L] POINTS TO THE ENTRY FOR A IN INFO AND THE ENTRY 02830000=01059000= + ITSELF CONTAINS THE STOP FLAG ZERO 02835000=01060000= + B IS ENTERED SIMILARLY TO A. 02840000=01061000= + NOW S[L] POINTS TO THE ENTRY FOR B AND IT POINTS TO THE 02845000=01062000= + ENTRY FOR A. 02850000=01063000= + SIMILARLY,AFTER C IS ENTERED 02855000=01064000= + A[L] POINTS TO C,WHOSE ENTRY POINTS TO B WHOSE ENTRY 02860000=01065000= + POINTS TO A. 02865000=01066000= + THE SECOND WORD OF EACH ENTRY IN INFO IS MADE UP AS FOLLOWS: 02870000=01067000= + FWDPT =[1:1],THIS TELLS WHETHER A PROCEDURE WAS DECLARED 02875000=01068000= + FORWARD.IT IS RESET AT THE TIME OF ITS ACTUAL 02880000=01069000= + FULL DECLARATION. 02885000=01070000= + PURPT =[4:8] THIS GIVES A DECREMENT WHICH GIVES THE RELATIVE 02890000=01071000= + INDEX TO THE PREVIOUS INFO ENTRY WHEN SUBSTRACTED 02895000=01072000= + FROM THE CURRENT ENTRY INDEX. 02900000=01073000= + [12:6] TELLS THE NUMBER OF CHARACTERS IN THE ENTRY,(<64) 02905000=01074000= + [18:30] CONTAINS THE FIRST FIVE ALPHA CHARACTERS OF THE ENTRY 02910000=01075000= + AND SUCCEEDING WORDS CONTAIN ALL OVERFLOW IF NEEDED. 02915000=01076000= + THESE WORDS CONTAIN 8 CHARACTERS EACH,LEFT JUSTIFIED. 02920000=01077000= + THUS,AN ENTRY FOR SYMBOL FOLLOWED BY AN ENTRY 02925000=01078000= + FOR X WOULD APPEAR AS FOLLOWS: 02930000=01079000= + INFO[I] = ELBATWRD (MADE FOR SYMBOL) 02935000=01080000= + I+1 = OP6SYMBO (P DEPENDS ON PREVIOUS ENTRY) 02940000=01081000= + I+2 = L 02945000=01082000= + I+3 = ELBATWRD (MADE FOR X) 02950000=01083000= + I+4 = O31X 02955000=01084000= + THIS SHOWS THAT INFO[I-P] WOULD POINT TO THE BEGINNING OF 02960000=01085000= + THE ENTRY BEFORE SYMBOL, AND 02965000=01086000= + INFO[I+3-3] POINTS TO THE ENTRY FOR SYMBOL. 02970000=01087000= + ALL ENTRIES OF IDNETIFIERS HAVE THE INFORMATION DESCRIBED ABOVE 02975000=01088000= + THAT IS,THE ELBAT WORD FOLLOWED BY THE WORD CONTAING THE FIRST 02980000=01089000= + FIVE CHARACTERS OF ALPHA,AND ANY ADDITIONAL WORDS OF ALPHA IF 02985000=01090000= + NECESSARY. 02990000=01091000= + THIS IS SUFFICIENT FOR ENTRIES OF THE FOLLOWING TYPES, 02995000=01092000= + REAL 03000000=01093000= + BOOLEAN 03005000=01094000= + INTEGER 03010000=01095000= + ALPHA 03015000=01096000= + FILE 03020000=01097000= + FORMAT 03025000=01098000= + LIST 03030000=01099000= + OTHER ENTRIES REQUIRE ADDITIONAL INFORMATION. 03035000=01100000= + ARRAYS: 03040000=01101000= + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 03045000=01102000= + DIMENSIONS(IN THE LOW ORDER PART).[40:8] 03050000=01103000= + EACH SUCCEEDING WORD CONTAINS INFORMATION ABOUT EACH LOWER 03055000=01104000= + BOUND IN ORDER OF APPEARANCE,ONE WORD FOR EACH LOWER BOUND. 03060000=01105000= + THESE WORDS ARE MADE UP AS FOLLOWS: 03065000=01106000= + [23:12] =ADD OPERATOR SYLLABLE (0101) OR 03070000=01107000= + SUB OPERATOR SYLLABLE (0301) CORRESPONDING 03075000=01108000= + RESPECTIVELY TO WHETHER THE LOWER BOUND IS 03080000=01109000= + TO BE ADDED TO THE SUBSCRIPT IN INDEXING OR 03085000=01110000= + SUBTRACTED. 03090000=01111000= + [35:11] =11 BIT ADDRESS OF LOWER BOUND,IF THE LOWER BOUND 03095000=01112000= + REQUIRES A PRT OR STACK CELL.OTHERWISE THE BIT 03100000=01113000= + 35 IS IGNORED AND THE NEXT TEN BITS([36:10]) 03105000=01114000= + REPRESENT THE ACTUAL VALUE OF THE LOWER BOUND 03110000=01115000= + [46:2] =00 OR 10 DEPENDING ON WHETHER THE [35:11] VALUE 03115000=01116000= + IS A LITERAL OR OPERAND,RESPECTIVELY. 03120000=01117000= + PROCEDURES: 03125000=01118000= + THE FIRST WORD OF ADDITIONAL INFO CONTAINS THE NUMBER OF 03130000=01119000= + PARAMETERS [40:8] 03135000=01120000= + IF A STREAM PROCEDURE THEN THIS WORD CONTAINS ALSO IN 03140000=01121000= + [13:11] ENDING PRT ADDRESS FOR LABELS. 03145000=01122000= + [ 7:6] NO OF LABELS REQUIRING PRT ADDRESSES, AND [1:6] NUMBER 03150000=01123000= + OF LOCALS. 03155000=01124000= + SUCCEEDING WORDS (ONE FOR EACH FORMAL PARAMETER,IN ORDER 03160000=01125000= + OF APPEARANCE IN FORMAL PARAPART) ARE 03165000=01126000= + ELBAT WORDS SPECIFYING TYPE OF EACH PARAMETER AND WHETHER 03170000=01127000= + VALUE OR NOT([10:1]). 03175000=01128000= + THE ADDRESS([16:11]) IS THE F- ADDRESS FOR EACH. 03180000=01129000= + IF THE PARAMETER IS AN ARRAY THEN THE INCR FIELD([27:8]) 03185000=01130000= + CONTAINS THE NUMBER OF DIMENSIONS,OTHERWISE INCR IS MEANINGLESS. 03190000=01131000= + LINK([35:13]) IS MEANINGLESS. 03195000=01132000= + IF A STREAM PROCEDURE THEN THE CLASS OF EACH PARAMETER IS 03200000=01133000= + THAT OF LOCAL ID OR FILE ID, DEPENDING ON WHETHER OR NOT A RELEASE03205000=01134000= + IS DONE IN THE STREAM PROCEDURE. 03210000=01135000= + LABELS: 03215000=01136000= + AT DECLARATION TIME THE ADDITIONAL INFO CONTAINS 0. THE SIGN 03220000=01137000= + BIT TELLS WHETHER OR NOT THE DEFINITION POINT HAS BEEN REACHED. 03225000=01138000= + IF SIGN = 0, THEN [36:12] CONTAINS AN ADDRESS IN CODEARRAY OF A 03230000=01139000= + LIST OF FORWARD REFERENCES TO THIS LABEL. THE END OF LIST FLAG IS03235000=01140000= + 0. IF SIGN =0, THEN [36:12] CONTAINS L FOR THIS LABEL. 03240000=01141000= + SWITCHES: 03245000=01142000= + THE FIELD [36:12] CONTAINS L FOR THE BEGINNING OF SWITCH DECLAR- 03250000=01143000= + ATION. [24:12] CONTAINS L FOR FIRST SIMPLE REFERENCE TO SWITCH. 03255000=01144000= + IF SWITCH IS NOT SIMPLE, IT IS MARKED FORMAL. HERE SIMPLE MEANS 03260000=01145000= + NO POSSIBILITY OF JUMPING OUT OF A BLOCK. ;03265000=01146000= + DEFINE 03270000=01147000= + MON = [1:1] #, 03275000=01148000= + CLASS = [2:7] #, 03280000=01149000= + FORMAL = [9:1] #, 03285000=01150000= + VO = [10:1] #, 03290000=01151000= + LVL = [11:5] #, 03295000=01152000= + ADDRESS = [16:11] #, 03300000=01153000= + INCR = [27:8] #, 03305000=01154000= + LINK = [35:13] #, 03310000=01154100= + DYNAM = [11:16] #, 03315000=01154200= + SBITF = [21:6] #, 03320000=01154200= + % STARTING BIT FOR FIELD ID. 03325000=01154200= + NBITF = [27:6] #, 03330000=01154300= + % NUMBER OF BITS FOR FIELD ID. 03335000=01154300= + LINKR = [35:5] #, 03340000=01156000= + LINKC = [40:8] #; 03345000=01156000= + 03350000=01157000= + COMMENT THESE DEFINES ARE USED TO PICK APART THE ELBAT WORD, 03355000=01157000= + MON IS THE BIT WHICH IS TURNED ON IF: 03360000=01158000= + 1. THE QUANTITY IS TO BE MONITORED, OR 03365000=01158100= + 2. THE QUANTITY IS A PARAMETRIC DEFINE AND NOT 03370000=01158200= + A DEFINE WITHOUT PARAMETERS. 03375000=01158300= + CLASS IS THE PRINCIPAL IDENTIFICATION OF A GIVEN 03380000=01159000= + QUANTITY. 03385000=01160000= + FORMAL IS THE BIT WHICH IS ON IF THE QUANTITY IS A FORMAL 03390000=01161000= + PARAMETER. 03395000=01162000= + V0 IS THE VALUE-OWN BIT. IF FORMAL = 1 THEN THE BIT 03400000=01163000= + DISTINGUISHES VALUE PARAMETERS FROM OTHERS. IF 03405000=01164000= + FORMAL = 0 THEN THE BIT DISTINGUISHES OWN VARIABLES 03410000=01165000= + FROM OTHERS. 03415000=01166000= + LVL GIVES THE LEVEL AT WHICH A QUANTITY WAS DECLARED. 03420000=01167000= + ADDRESS GIVES THE STACK OR PRT ADDRESS. 03425000=01168000= + DYNAM IS USED INSTEAD OF LVL AND ADDRESS FOR DEFINE AND 03430000=01168100= + DEFINE PARAMETER ENTRIES, ONLY, IT IS AN INDEX 03435000=01168200= + INTO THE ARRAY CONTAINING THE DEFINE TEXT. 03440000=01168300= + THEREFORE, WHEN THE COMPILER CHECKS TO SEE IF A 03445000=01168400= + DEFINE WAS DECLARED B4 IN THE SAME BLOCK, IT DOES 03450000=01168500= + NOT USE THE LVL FIELD, BUT MAKES USE OF NINF00 03455000=01168600= + INCR GIVES A RELATIVE LINK TO ANY ADDITIONAL INFORMATION 03460000=01169000= + NEEDED, RELATIVE TO THE LOCATION IN INFO. 03465000=01170000= + LINK CONTAINS A LINK TO THE LOCATION IN INFO IF THE 03470000=01171000= + QUANTITY LIES IN ELBAT, OTHERWISE IT LINKS TO THE 03475000=01172000= + NEXT ITEM IN THE STACK, ZERO IS AN END FLAG. 03480000=01173000= + LINKR AND LINKC ARE SUBDIVISIONS OF LINK.; 03485000=01174000= + 03490000=01175000= + COMMENT CLASSES FOR ALL QUANTITIES - OCTAL CLASS IS IN COMMENT; 03495000=01175000= + COMMENT CLASSES FOR IDENTIFIERS; 03500000=01176000= + DEFINE 03505000=01177000= + UNKNOWNID = 00 #, COMMENT 000; 03510000=01177000= + STLABID = 01 #, COMMENT 001; 03515000=01178000= + LOCLID = 02 #, COMMENT 002; 03520000=01179000= + DEFINEID = 03 #, COMMENT 003; 03525000=01180000= + LISTID = 04 #, COMMENT 004; 03530000=01181000= + FRMTID = 05 #, COMMENT 005; 03535000=01182000= + SUPERFRMTID = 06 #, COMMENT 006; 03540000=01183000= + FILEID = 07 #, COMMENT 006; 03545000=01184000= + SUPERFILEID = 08 #, COMMENT 007; 03550000=01185000= + SWITCHID = 09 #, COMMENT 011; 03555000=01186000= + PROCID = 10 #, COMMENT 012; 03560000=01187000= + INTRNSICPROCID = 03565000=01188000= + 11 #, COMMENT 013; 03570000=01188000= + STRPROCID = 12 #, COMMENT 014; 03575000=01189000= + BOOSTRPROCID = 13 #, COMMENT 015; 03580000=01190000= + REALSTRPROCID = 14 #, COMMENT 016; 03585000=01191000= + ALFASTRPROCID = 15 #, COMMENT 017; 03590000=01192000= + INTSTRPROCID = 16 #, COMMENT 020; 03595000=01193000= + BOOPROCID = 17 #, COMMENT 021; 03600000=01194000= + REALPROCID = 18 #, COMMENT 022; 03605000=01195000= + ALFAPROCID = 19 #, COMMENT 023; 03610000=01196000= + INTPROCID = 20 #, COMMENT 024; 03615000=01197000= + BOOID = 21 #, COMMENT 025; 03620000=01198000= + REALID = 22 #, COMMENT 026; 03625000=01199000= + ALFAID = 23 #, COMMENT 027; 03630000=01200000= + INTID = 24 #, COMMENT 030; 03635000=01201000= + BOOARRAYID = 25 #, COMMENT 031; 03640000=01202000= + REALARAYID = 26 #, COMMENT 032; 03645000=01203000= + ALFARRAYID = 27 #, COMMENT 033; 03650000=01204000= + INTARRAYID = 28 #, COMMENT 034; 03655000=01205000= + LABELID = 29 #, COMMENT 035; 03660000=01206000= + 03665000=01207000= + COMMENT CLASSES FOR PRIMARY BEGINNERS; 03670000=01207000= + TRUTHV = 30 #, COMMENT 036; 03675000=01208000= + NONLITNO = 31 #, COMMENT 037; 03680000=01209000= + LITNO = 32 #, COMMENT 040; 03685000=01210000= + STRNGCON = 33 #, COMMENT 041; 03690000=01211000= + LEFTPAREN = 34 #, COMMENT 042; 03695000=01212000= + 03700000=01213000= + COMMENT CLASSES FOR ALL DECLARATORS; 03705000=01213000= + DECLARATORS = 35 #, COMMENT 043; 03710000=01214000= + 03715000=01215000= + COMMENT CLASSES FOR STATEMENT BEGINNERS; 03720000=01215000= + READV = 36 #, COMMENT 044; 03725000=01216000= + WRITEV = 37 #, COMMENT 045; 03730000=01217000= + SPACEV = 38 #, COMMENT 046; 03735000=01218000= + CLOSEV = 39 #, COMMENT 047; 03740000=01219000= + LOCKV = 40 #, COMMENT 050; 03745000=01220000= + REWINDV = 41 #, COMMENT 051; 03750000=01221000= + DOUBLEV = 42 #, COMMENT 052; 03755000=01222000= + FORV = 43 #, COMMENT 053; 03760000=01223000= + WHILEV = 44 #, COMMENT 054; 03765000=01224000= + DOV = 45 #, COMMENT 055; 03770000=01225000= + UNTILV = 46 #, COMMENT 056; 03775000=01226000= + ELSEV = 47 #, COMMENT 057; 03780000=01227000= + ENDV = 48 #, COMMENT 060; 03785000=01228000= + FILLV = 49 #, COMMENT 061; 03790000=01229000= + SEMICOLON = 50 #, COMMENT 062; 03795000=01230000= + IFV = 51 #, COMMENT 063; 03800000=01231000= + GOV = 52 #, COMMENT 064; 03805000=01232000= + RELEASEV = 53 #, COMMENT 065; 03810000=01233000= + BEGINV = 54 #, COMMENT 066; 03815000=01234000= + 03820000=01235000= + COMMENT CLASSES FOR STREAM RESERVED WORDS; 03825000=01235000= + SIV = 55 #, COMMENT 067; 03830000=01236000= + DIQ = 56 #, COMMENT 070; 03835000=01237000= + CIV = 57 #, COMMENT 071; 03840000=01238000= + TALLYV = 58 #, COMMENT 072; 03845000=01239000= + DSV = 59 #, COMMENT 073; 03850000=01240000= + SKIPV = 60 #, COMMENT 074; 03855000=01241000= + JUMPV = 61 #, COMMENT 075; 03860000=01242000= + DBV = 62 #, COMMENT 076; 03865000=01243000= + SBV = 63 #, COMMENT 077; 03870000=01244000= + TOGGLEV = 64 #, COMMENT 100; 03875000=01245000= + SCV = 65 #, COMMENT 101; 03880000=01246000= + LOCV = 66 #, COMMENT 102; 03885000=01247000= + DCV = 67 #, COMMENT 103; 03890000=01248000= + LOCALV = 68 #, COMMENT 104; 03895000=01249000= + LITV = 69 #, COMMENT 105; 03900000=01250000= + TRNSFER = 70 #, COMMENT 106; 03905000=01251000= + 03910000=01252000= + COMMENT CLASSES FOR VARIOUS MISCELLANEOUS QUANTITIES; 03915000=01252000= + COMMENTV = 71 #, COMMENT 107; 03920000=01253000= + FORWARDV = 72 #, COMMENT 110; 03925000=01254000= + STEPV = 73 #, COMMENT 111; 03930000=01255000= + THENV = 74 #, COMMENT 112; 03935000=01256000= + TOV = 75 #, COMMENT 113; 03940000=01257000= + VALUEV = 76 #, COMMENT 114; 03945000=01258000= + WITHV = 77 #, COMMENT 115; 03950000=01259000= + COLON = 78 #, COMMENT 116; 03955000=01260000= + COMMA = 79 #, COMMENT 117; 03960000=01261000= + CROSSHATCH = 80 #, COMMENT 120; 03965000=01262000= + LFTBRKET = 81 #, COMMENT 121; 03970000=01263000= + PERIOD = 82 #, COMMENT 122; 03975000=01264000= + RTBRKET = 83 #, COMMENT 123; 03980000=01265000= + RTPAREN = 84 #, COMMENT 124; 03985000=01266000= + 03990000=01267000= + COMMENT CLASSES FOR OPERATORS; 03995000=01267000= + NOTOP = 85 #, COMMENT 125; 04000000=01268000= + ASSIGNOP = 86 #, COMMENT 126; 04005000=01269000= + AMPERSAND = 87 #, COMMENT 127; 04010000=01270000= + EQVOP = 88 #, COMMENT 130; 04015000=01271000= + IMPOP = 89 #, COMMENT 131; 04020000=01272000= + OROP = 90 #, COMMENT 132; 04025000=01273000= + ANDOP = 91 #, COMMENT 133; 04030000=01274000= + RELOP = 92 #, COMMENT 134; 04035000=01275000= + ADOP = 93 #, COMMENT 135; 04040000=01276000= + MULOP = 94 #, COMMENT 136; 04045000=01277000= + FACTOP = 95 #, COMMENT 137; 04050000=01278000= + STRING = 99 #, COMMENT 143; 04055000=01278050= + FIELDID = 125 #, COMMENT 175; 04060000=01278090= + FAULTID = 126 #, COMMENT 176; 04065000=01278100= + SUPERLISTID = 127 #, COMMENT 177; 04070000=01278500= + 04075000=01279000= + COMMENT SUBCLASSES FOR DECLARATORS (KEPT IN ADDRESS); 04080000=01279000= + OWNV = 01 #, COMMENT 01; 04085000=01280000= + SAVEV = 02 #, COMMENT 02; 04090000=01281000= + BOOV = 03 #, COMMENT 03; 04095000=01282000= + REALV = 04 #, COMMENT 04; 04100000=01283000= + ALFAV = 05 #, COMMENT 05; 04105000=01284000= + INTV = 06 #, COMMENT 06; 04110000=01285000= + LABELV = 07 #, COMMENT 07; 04115000=01286000= + DUMPV = 08 #, COMMENT 10; 04120000=01287000= + LISTV = 09 #, COMMENT 11; 04125000=01288000= + OUTV = 10 #, COMMENT 12; 04130000=01289000= + INV = 11 #, COMMENT 13; 04135000=01290000= + MONITORV = 12 #, COMMENT 14; 04140000=01291000= + SWITCHV = 13 #, COMMENT 15; 04145000=01292000= + PROCV = 14 #, COMMENT 16; 04150000=01293000= + ARRAYV = 15 #, COMMENT 17; 04155000=01294000= + FORMATV = 16 #, COMMENT 20; 04160000=01295000= + FILEV = 17 #, COMMENT 21; 04165000=01296000= + STREAMV = 18 #, COMMENT 22; 04170000=01297000= + DEFINEV = 19 #, COMMENT 23; 04175000=01298000= + AUXMEMV = 20 #, COMMENT 24; 04180000=01298500= + FIELDV = 21 #; 04185000=01298600= + COMMENT 25; 04190000=01298600= + DEFINE 04195000=01299000= + ADES = 0 #, 04200000=01299000= + LDES = 2 #, 04205000=01299000= + PDES = 1 #, 04210000=01299000= + CHAR = 3 #; 04215000=01299000= + REAL 04220000=01300000= + TIME1; 04225000=01300000= + INTEGER 04230000=01301000= + SCRAM; 04235000=01301000= + COMMENT SCRAM CONTAINS THE SCRAMBLE INDEX FOR THE LAST IDENTIFIER 04240000=01302000= + OR RESERVED WORD SCANNED; 04245000=01303000= + ARRAY 04250000=01303500= + FILEATTRIBUTES[0:30]; 04255000=01303500= + ALPHA ARRAY 04260000=01304000= + ACCUM[0:10]; 04265000=01304000= + COMMENT ACCUM HOLDS THE ALPHA AND CHARACTER COUNT OF THE LAST 04270000=01305000= + SCANNER ITEM IN A FORM COMPATIBLE WITH ITS APPEARANCE 04275000=01306000= + IN INFO. THAT IS ACCUM[1] = 00NAAAAA, ACCUM[I] , I> 1. 04280000=01307000= + HAS ANY ADDITIONAL CHARACTERS. ACCUM[0] IS USED FOR 04285000=01308000= + THE ELBAT WORD BY THE ENTER ROUTINES; 04290000=01309000= + ARRAY 04295000=01310000= + STACKHEAD, 04300000=01310000= + SUPERSTACK[0:124]; 04305000=01310000= + COMMENT STACKHEAD[N] CONTAINS AN INDEX INTO INFO, THIS INDEX 04310000=01311000= + POINTS TO THE TOP ITEM IN THE N-TH STACK (ACTUALLY A 04315000=01311100= + LINKED-LIST). SUPERSTACK IS NOT A TELEVISION STAR, 04320000=01311200= + BUT RATHER A SPECIAL STACKHEAD WHICH ALWAYS POINTS 04325000=01311300= + AT CERTAIN COMMONLY USED RESERVED WORDS. THOSE 04330000=01311400= + WORDS POINTED TO (IN THREE GROUPS) ARE: 04335000=01311500= + 1) ALPHA, LABEL, OWN, REAL, SAVE 04340000=01311600= + 2) AND, DIV, EQV, IMP, MOD, NOT, OR, TRUE 04345000=01311700= + 3) BEGIN, DO, ELSE, END, FOR, GO, IF, 04350000=01311800= + STEP, THEN, TO, UNTIL, WHILE, WRITE. 04355000=01311900= + FOR MORE INFORMATION ON THE USE OF SUPERSTACKM SEE 04360000=01312000= + COMMENTS IN THE TABLE PROCEDURE. ; 04365000=01312100= + INTEGER 04370000=01313000= + COUNT; 04375000=01313000= + COMMENT COUNT CONTAINS THE NUMBER OF CHARACTORS OF THE LAST ITEM 04380000=01314000= + SCANNED; 04385000=01315000= + ALPHA 04390000=01316000= + Q; 04395000=01316000= + COMMENT Q CONTAINS ACCUM[1] FOR THE LAST IDENTIFIER OR RESERVED 04400000=01317000= + WORD SCANNED; 04405000=01318000= + ARRAY 04410000=01319000= + ELBAT[0:76]; 04415000=01319000= + INTEGER 04420000=01319000= + I, 04425000=01319000= + NEXTELBT; 04430000=01319000= + COMMENT ELBAT IS AN ARRAY HOLDING ELBAT WORDS FOR RECENTLY SCANNED 04435000=01320000= + QUANTITIES. THE TABLE ROUTINE MAINTAINS THIS ARRAY. 04440000=01321000= + (ELBAT IS TABLE SPELLED BACKWARDS.) THE TABLE ROUTINE 04445000=01322000= + GUARANTIES THAT ELBAT ALWAYS CONTAINS THE ELBAT WORDS 04450000=01323000= + FOR THE LAST 10 QUANTITIES SCANNED. NXTELBT IS AN INDEX 04455000=01324000= + POINTING TO THE NEXT AVAILABLE WORD IN ELBAT. I IS AN 04460000=01325000= + INDEX USED BY THE REST OF THE COMPILER TO FETCH THINGS 04465000=01326000= + FROM ELBAT. I IS ALSO MAINTAINED BY THE TABLE ROUTINE; 04470000=01327000= + INTEGER 04475000=01328000= + ELCLASS; 04480000=01328000= + COMMENT ELCLASS USUALLY CONTAINS ELBAT[I].CLASS; 04485000=01329000= + INTEGER 04490000=01329100= + LASTELCLASS; 04495000=01329100= + COMMENT LASTELCLASS IS SET TO PREV ELCLASS BY NEXTENT; 04500000=01329200= + INTEGER 04505000=01330000= + FCR, 04510000=01330000= + NCR, 04515000=01330000= + LCR, 04520000=01330000= + TLCR, 04525000=01330000= + CLCR; 04530000=01330000= + INTEGER 04535000=01331000= + MAXTCLR; 04540000=01331000= + COMMENT FCR CONTAINS ABSOLUTE ADDRESS OF THE FIRST CHARACTOR OF 04545000=01332000= + THE CARD IMAGE CURRENTLY BEING SCANNED. NCR THE ADDRESS 04550000=01333000= + OF THE NEXT CHARACTOR TO BE SCANNED, AND LCR THE LAST 04555000=01334000= + CHARACTOR (COLUMN 73). TLCR AND CLCR CONTAIN ADDRESS OF 04560000=01335000= + THE LAST CHARACTER IN THE TAPE AND CARD BUFFERS. MAXTLCR 04565000=01336000= + IS THE MAXIMUM OF TLCR WHEN THE INPUT IS BLOCKED; 04570000=01337000= + DEFINE 04575000=01338000= + BUFFSIZE = 56 #; 04580000=01338000= + INTEGER 04585000=01339050= + GTIX; 04590000=01339050= + ARRAY 04595000=01340000= + TEN[0:69]; 04600000=01340000= + INTEGER 04605000=01340050= + NOOFARRAYS; 04610000=01340050= + COMMENT NOOFARRAYS IS THE SUM OF ARRAYS 04615000=01340050= + DECLARED IN THE OBJECT PROGRAM; 04620000=01340060= + INTEGER 04625000=01340070= + IOBUFFSIZE; 04630000=01340070= + COMMENT IOBUFFSIZE IS FILE SPACE NEEDED. 04635000=01340070= + GTI1 EQUALS TOTAL CORE STORAGE REQD; 04640000=01340080= + REAL 04645000=01340500= + FSAVE; 04650000=01340500= + COMMENT SAVES FRACTIONAL PART EXPONENT WHEN CONV NUM; 04655000=01340500= + INTEGER 04660000=01341000= + IDLOC, 04665000=01341000= + IDLOCTEMP; 04670000=01341000= + ARRAY 04675000=01342000= + PDPRT[0:31, 0:63]; 04680000=01342000= + COMMENT PDPRT CONTAINS INFORMATION FOR USE AT THE END OF COMPILATION 04685000=01343000= + IT IS BUILT BY PROGDESCBLDR.THIS INFORMATION IS USED TO 04690000=01344000= + BUILD THE SEGMENT DICTIONARY AND PRT. THERE ARE TWO TYPES 04695000=01345000= + OF ENTRIES IN THIS TABLE AS DESCRIBED BELOW. 04700000=01346000= + TYPE 1 ENTRY 04705000=01347000= + BIT POSITION KIND OF ENTRY 04710000=01348000= + 0-3 ZERO 04715000=01349000= + 4 MODE BIT(1=CHAR 0=WORD) 04720000=01350000= + 5 ARGUMENT BIT 04725000=01351000= + 6-7 ZERO 04730000=01352000= + 8-17 RELATIVE ADDRESS IN PRT 04735000=01353000= + 18-27 RELATIVE ADDRESS IN SEGMENT 04740000=01354000= + 28-37 SEGMENT NUMBER 04745000=01355000= + 38-47 ZERO 04750000=01356000= + TYPE 2 ENTRY 04755000=01357000= + BIT POSITION KIND OF ENTRY 04760000=01358000= + 0 EMPTY 04765000=01359000= + 1 ON IFF TYPE 2 (DATA) SEGMENT 04770000=01360000= + 2 ON IFF INTRINSIC PROCEDURE 04775000=01361000= + 3 ON IFF "PSEUDO-SAVE" SEGMENT 04780000=01361050= + 4-12 EMPTY 04785000=01361100= + 13-27 DISK ADDRESS OR INTRINSIC NUMBER 04790000=01361200= + 28-37 SEGMENT NUMBER 04795000=01361300= + 38-47 NUMBER OF WORDS IN SEGMENT 04800000=01362000= + THERE IS ONLY ONE TYPE 2 ENTRY PER SEGMENT.THE TYPE 2 ENTRY 04805000=01363000= + IS DISTINGUISHED BY THE NON ZERO FIELD IN BITS 38-47. THIS 04810000=01364000= + ENTRY IS USED TO BUILD THE DRUM DESCRIPTOR IN THE SEGMENT 04815000=01365000= + DICTIONARY.TYPE 2 ENTRIES ARE PUT INTO PDPRT WHEN ANY SEGMENT04820000=01366000= + IS READY FOR OUTPUT; 04825000=01367000= + 04830000=01367010= +COMMENT THE FORMAT OF SEGMENT DICTIONARY AND PRT ENTRIES AT THE END OF 04835000=01367010= + COMPILATION IS AS FOLLOWS: 04840000=01367020= + SEGMENT DICTIONARY ENTRY (IE., SD[I] FOR SEGMENT NUM. I) 04845000=01367030= + BIT POSITIONS CONTENTS OF FIELD 04850000=01367040= + [0:1] EMPTY 04855000=01367050= + [1:1] ON IFF TYPE 2 (DATA) SEGMENT 04860000=01367060= + [2:1] ON IFF INTRINSIC PROCEDURE 04865000=01367070= + [3:1] EMPTY (USED BY MCP PRESENCE-BIT ROUTINE) 04870000=01367075= + [4:1] ON IFF "PSEUDO-SAVE" SEGMENT 04875000=01367080= + [5:1] EMPTY (USED BY MCP OVERLAY ROUTINE) 04880000=01367085= + [8:10] R-RELATIVE LINK TO PRT ENTRY FOR THIS SEGMENT 04885000=01367090= + [18:15] SIZE (NOT USED FOR INTRINSICS) 04890000=01367100= + [33:15] DISK ADDRESS OR INTRINSIC NUMBER 04895000=01367110= + PRT ENTRY (IE., PROGRAM DESCRIPTOR FOR SEGMENT NUMBER I) 04900000=01367120= + BIT POSITIONS CONTENTS OF FIELD 04905000=01367130= + [0:4] 1101 (BINARY) NON-PRESENT PROG, DESC. IDBITS 04910000=01367140= + [4:2] MODE AND ARGUMENT BITS 04915000=01367150= + [6:1] STOPPER (ON IFF THIS ENTRY LINKS TO SEG. DICT.) 04920000=01367160= + [7:11] IF [6:1] THEN I ELSE R-RELATIVE LINK TO ANOTHER 04925000=01367170= + PRT ENTRY FOR SEGMENT I 04930000=01367180= + [18:15] I 04935000=01367190= + [33:15] RELATIVE ADDRESS WITHIN THE SEGMENT OF THIS DESC;04940000=01367200= + 04945000=01367210= +COMMENT THE CONTENTS OF RELATIVE DISK SEGMENT ZERO OF THE CODE FILE ARE:04950000=01367210= + WORD CONTENTS 04955000=01367220= + 0 RELATIVE LOCATION OF SEGMENT DICTIONARY 04960000=01367230= + 1 SIZE OF SEGMENT DICTIONARY 04965000=01367240= + 2 RELATIVE LOCATION OF PRT 04970000=01367250= + 3 SIZE OF PRT 04975000=01367260= + 4 RELATIVE LOCATION OF FILE PARAMETER BLOCK 04980000=01367270= + 5 SIZE OF FILE PARAMETER BLOCK 04985000=01367280= + 6 SEGMENT NUMBER OF FIRST SEGMENT TO EXECUTE (IE., 1) 04990000=01367290= + 7 N 04995000=01367300= + . O U 05000000=01367310= + . T S 05005000=01367320= + . E 05010000=01367330= + 29 D; 05015000=01367340= + INTEGER 05020000=01368000= + PDINX; 05025000=01368000= + COMMENT THIS IS THE INDEX FOR PDPRT; 05030000=01368000= + INTEGER 05035000=01369000= + SGAVL; 05040000=01369000= + COMMENT NEXT AVAILABLE SEGMENT NUMBER; 05045000=01369000= + INTEGER 05050000=01370000= + SGNO; 05055000=01370000= + COMMENT THIS IS THE CURRENT SEGMENT NUMBER; 05060000=01370000= + ARRAY 05065000=01371000= + EDOC[0:7, 0:127], 05070000=01371000= + COP[0:63], 05075000=01371000= + WOP[0:127], 05080000=01371000= + POP[0:10]; 05085000=01371000= + COMMENT THE EMIT ROUTINES PLACE EACH SYLLABLE INTO THE EDOC ARRAY 05090000=01372000= + AS SPECIFIED BY "L". 05095000=01373000= + IF DEBUGTOG IS TRUE, COP, WOP, AND POP ARE FILLED 05100000=01374000= + THE BCD FOR THE OPERATORS,OTHERWISE THEY ARE NOT USED; 05105000=01375000= + REAL 05110000=01376000= + LASTENTRY; 05115000=01376000= + COMMENT LASTENTRY IS USED BY EMITNUM AND CONSTANTCLEAN. IT POINTS 05120000=01377000= + INTO INFO[0,*] AT THE NEXT AVAILABLE CELL FOR CONSTANTS; 05125000=01378000= + BOOLEAN 05130000=01379000= + MRCLEAN; 05135000=01379000= + COMMENT NO CONSTANTCLEAN ACTION TAKES PLACE WHILE MRCLEAN IS 05140000=01380000= + FALSE. THIS FEATURE IS USED BY BLOCK BECAUSE OF THE 05145000=01381000= + POSSIBILITY THAT CONSTANTCLEAN WILL USE INFO[NEXTINFO] 05150000=01382000= + DURING AN ARRAY DECLARATION ; 05155000=01383000= + REAL 05160000=01384000= + GT1, 05165000=01384000= + GT2, 05170000=01384000= + GT3, 05175000=01384000= + GT4, 05180000=01384000= + GT5; 05185000=01384000= + INTEGER 05190000=01384500= + GTI1; 05195000=01384500= + COMMENT THESE VARIABLES ARE USED FOR TEMPORARY STORAGE; 05200000=01385000= + INTEGER 05205000=01386000= + RESULT; 05210000=01386000= + COMMENT THIS VARIALE IS USED FOR A DUAL PURPOSE BY THE TABLE 05215000=01387000= + ROUTINE AND THE SCANNER. THE TABLE ROUTINE USES THIS 05220000=01388000= + VARIABLE TO SPECIFY SCANNER OPERATIONS AND THE SCANNER 05225000=01389000= + USES IT TO INFORM THE TABLE ROUTINE OF THE ACTION TAKEN; 05230000=01390000= + INTEGER 05235000=01391000= + LASTUSED; 05240000=01391000= + COMMENT LASTUSED IS A VARIABLE THAT CONTROLS THE ACTION OF 05245000=01392000= + READACARD. THE ROUTINE WHICH READS CARDS AND INITIALIZES 05250000=01393000= + OR PREPARES THE CARD FOR THE SCANNER. 05255000=01394000= + LASTUSED LAST CARD READ FROM 05260000=01394500= + -------- ------------------- 05265000=01394600= + 1 CARD READ ONLY, NO TAPE. 05270000=01395000= + 2 CARD READER, TAPE AND CARD MERGE. 05275000=01396000= + 3 TAPE, TAPE AND CARD MERGE. 05280000=01397000= + 4 INITIALIZATION ONLY, CARD ONLY. 05285000=01398000= + 5 CARD READER - MAKCAST, MERGING. 05290000=01398100= + 6 TAPE - MAKCAST, MERGING. 05295000=01398200= + ; 05300000=01398300= + BOOLEAN 05305000=01399000= + LINKTOG; 05310000=01399000= + COMMENT LINKTOG IS FALSE IF THE LAST THING EMITTED IS A LINK. 05315000=01400000= + OTHERWISE IT IS TRUE; 05320000=01401000= + INTEGER 05325000=01402000= + LEVEL, 05330000=01402000= + FRSTLEVEL, 05335000=01402000= + SUBLEVEL, 05340000=01402000= + MODE; 05345000=01402000= + COMMENT THESE VARIABLES ARE MAINTAINED BY THE BLOCK ROUTINE TO KEEP 05350000=01403000= + TRACK OF LEVELS OF DEFINITION. LEVEL GIVES THE DEPTH OF 05355000=01404000= + NESTING IN DEFINITION. WHERE EACH BLOCK AND EACH PROCEDURE05360000=01405000= + GIVES RISE TO A NEW LEVEL. SUBLEVEL GIVES THE LEVEL OF 05365000=01406000= + THE PARAMETERS OF THE PROCEDURE CURRENTLY BEING COMPILED. 05370000=01407000= + FRSTLEVEL IS THE LEVEL OF THE PARAMETERS OF THE MOST 05375000=01408000= + GLOBAL OF THE PROCEDURES CURRENTLY BEING COMPILED. MODE 05380000=01409000= + IS THE CURRENT DEPTH OF THE PROCEDURE IN WHICH WE ARE 05385000=01410000= + NESTED (AT COMPILE TIME); 05390000=01411000= + INTEGER 05395000=01411010= + AUXMEMREQ; 05400000=01411010= + BOOLEAN 05405000=01411020= + SAVEPRTOG; 05410000=01411020= + COMMENT VARIABLES USED TO CONTROL SEGMENT DICTIONARY 05415000=01411030= + ENTRIES FOR "PSEUDO-SAVE" PROCEDURES. 05420000=01411040= + AUXMEMREQ IS THE AMOUNT OF AUXILIARY MEMORY 05425000=01411050= + WHICH WOULD BE REQUIRED IF ALL OF THESE 05430000=01411060= + "PSEUDO-SAVE" ROUTINES ARE TO BE OVERLAID 05435000=01411070= + TO AUXILIARY MEMORY. SAVEPRTOG IS USED 05440000=01411080= + TO COMMUNICATE TO THE OUTSIDE WORLD THAT A 05445000=01411090= + ROUTINE IS "PSEUDO-SAVE". 05450000=01411100= + ; 05455000=01411110= + BOOLEAN 05460000=01412000= + ERRORTOG; 05465000=01412000= + COMMENT ERRORTOG IS TRUE IF MESSAGES ARE CURRENTLY ACCEPTABLE TO THE05470000=01413000= + ERROR ROUTINES. ERRORCOUNT IS THE COUNT OF ERROR MSSGS; 05475000=01414000= + BOOLEAN 05480000=01415000= + ENDTOG; 05485000=01415000= + COMMENT ENDTOG TELLS THE TABLE TO ALLOW 05490000=01415000= + COMMENT TO BE PASSED BACK TO COMPOUNDTAIL; 05495000=01416000= + BOOLEAN 05500000=01416500= + STREAMTOG; % STREAMTOG IS TRUE IF WE ARE COMPILING A 05505000=01416500= + % STREAM STATEMENT IN ALGOL, TSPOL, OR ESPOL: 05510000=01417000= + % IT IS USED TO CONTROL COUMPOUNDTAIL. 05515000=01417500= + % IT IS ALSO USED WHEN WE ARE COMPILING A 05520000=01418000= + % "FILL" STATEMENT (SEE "FILLSTMT" PROCEDURE) OR 05525000=01418500= + % AN ALPHA (BCL) STRING (SEE "TABLE" PROCEDURE). 05530000=01419000= + DEFINE 05535000=01420000= + FS = 1 #, 05540000=01420000= + FP = 2 #, 05545000=01420000= + FL = 3 #, 05550000=01420000= + FR = 4 #, 05555000=01420000= + FA = 5 #, 05560000=01420500= + FI = 6 #, 05565000=01420500= + FIO = 7 #; 05570000=01420500= + COMMENT THESE DEFINES ARE USED WHEN CALLING THE VARIABLE ROUTINE, 05575000=01421000= + THEIR PURPOSES IS TO TELL VARIABLE WHO IS CALLING. 05580000=01422000= + THEIR MEANING IS: 05585000=01423000= + FS MEANS FROM STATEMENT. 05590000=01424000= + FP MEANS FROM PRIMARY. 05595000=01425000= + FL MEANS FROM LIST. 05600000=01426000= + FR MEANS FROM FOR. 05605000=01427000= + FIO MEANS FROM IODEC. 05610000=01427250= + FA MEANS FROM ACTUALPARAPART. 05615000=01427500= + FI MEANS FUNNY CALL FROM STATUS (IMPFUN); 05620000=01427600= + INTEGER 05625000=01428000= + L; 05630000=01428000= + COMMENT L IS THE LOCATION OF THE NEXT SYLLABLE TO BE EMITTED; 05635000=01429000= + DEFINE 05640000=01430000= + BLOCKCTR = 16 #, 05645000=01430000= + JUNK = 17 #, 05650000=01430000= + XITR = 18 #, 05655000=01430000= + LSTRTN = 19 #; 05660000=01430000= + COMMENT THESE DEFINES NAME THE FIXED PRT CELLS USED BY ALL OBJECT 05665000=01431000= + PROGRAMS. 05670000=01432000= + BLOCKCTR IS A TALLY WHICH IS INCREMENT EACH TIME A 05675000=01433000= + BLOCK IS ENTERED WHICH OBTAINS STORAGE, OR CONTAINS WITH 05680000=01434000= + IN IT A NON-LOCAL GO TO. EACH TIME SUCH A BLOCK IS LEFT 05685000=01435000= + BLOCKCTR IS DECREMENTED. THE PRIMARY PURPOSE SERVED IS T305690000=01436000= + INFORM THE MCP OF THE STORAGE WHICH NEEDS TO BE RETURNED. 05695000=01437000= + JUNK IS AN ALL-PURPOSE CELL FOR STORING VALUES USED 05700000=01438000= + IN LINKAGE BETWEEN VARIOUS ROUTINES AND FOR INTEGERIZING 05705000=01439000= + THINGS ON THE TOP OF THE STACK. 05710000=01440000= + XITR CONTAINS A CHARACTOR MODE PROGRAM DESCRIPTOR 05715000=01441000= + WHICH POINTS AT AN EXIT CHARACTOR MODE OPERATOR. IT IS 05720000=01442000= + USED TO CLEAN UP THE STACK AFTER A MKS HAS BEEN GIVEN. 05725000=01443000= + THIS A USFULL WAY TO ELIMINATE MANY REDUNDENT ITEMS IN THE05730000=01444000= + STACK. SEE FOR EXAMPLE THE ARRAY DECLARATIONS. 05735000=01445000= + LSTRTN IS A CELL USED AS LINKAGE BETWEEN A LIST AND 05740000=01446000= + THE I-O FORMATING ROUTINES. THE FIRST SYLLABLES EXECUTED 05745000=01447000= + BY A LIST ARE: 1) OPDC LSTRTN, 2) BFW, THIS CARRIES YOU 05750000=01448000= + TO THE PROPER ITEM IN THE LIST. THE FORMATING ROUTINES 05755000=01449000= + SET LSTRTN INITIALLY TO ZERO. THE LIST ITSELF UPDATES 05760000=01450000= + LSTRTN. THE LIST EXHAUSTED FLAG IS -1; 05765000=01451000= + DEFINE 05770000=01452000= + BTYPE = 1 #, 05775000=01452000= + DTYPE = 2 #, 05780000=01452000= + ATYPE = 3 #; 05785000=01452000= + COMMENT THESE DEFINES NAME THE VALUES USED BY THE EXPRESSION 05790000=01453000= + ROUTINES IF REPORT THE TYPE OF EXPRESSION COMPILED. 05795000=01454000= + BTYPE IS FOR BOOLEAN, DTYPE FOR DESIGNATIONAL, AND ATYPE 05800000=01455000= + FOR ARITHMETIC EXPRESSIONS; 05805000=01456000= + BOOLEAN 05810000=01457000= + TB1; 05815000=01457000= + COMMENT TB1 IS A TEMPORARY BOOLEAN VARIABLE; 05820000=01458000= + INTEGER 05825000=01459000= + JUMPCTR; 05830000=01459000= + COMMENT JUMPCTR IS A VARIABLE USED FOR COMMUNICATION BETWEEN BLOCK 05835000=01460000= + AND GENGO. IT GIVES HIGHEST LEVEL TO WHICH A JUMP HAS 05840000=01461000= + BEEN MADE FROM WITHIN A THE PRESENTLY BEING COMPILED 05845000=01462000= + SEGMENT. THE BLOCK COMPILES CODE TO INCREMENT AND DECRE- 05850000=01463000= + MENT THE BLOCKCTR ON THE BASIS OF JUMPCTR AT COMPLETION 05855000=01464000= + OF COMPILATION OF A SEGMENT - I.E. THE BLOCKCTR IS TALLIED 05860000=01465000= + IF LEVEL = JUMPCTR; 05865000=01466000= + BOOLEAN 05870000=01467000= + GOTOG; 05875000=01467000= + COMMENT GOTOG IS SET FALSE BY GOSTMT. DEXP SETS GOTOG TRUE IF ANY 05880000=01468000= + LABEL OR SWITCH IS NON LOCAL. GOSTMT FINDS OUT BY THIS 05885000=01469000= + MEANS WHETHER OR NOT A CALL ON MCP IS NECESSARY; 05890000=01470000= + REAL 05895000=01471000= + STLB; 05900000=01471000= + COMMENT STLB IS USED BY VARIABLE AND ACTUALPARAPART TO COMMUNICATE 05905000=01472000= + THE LOWER BOUND INFORMATION FOR THE LAST DIMENSION OF THE 05910000=01473000= + ARRAY INVOLVED IN A ROW DESIGNATOR. THE FORMAT OF THE 05915000=01474000= + INFORMATION IS THAT OF INFO. STLB IS ALSO SOMETIMES USED 05920000=01475000= + FOR TEMPORARY STORAGE; 05925000=01476000= + DEFINE 05930000=01477000= + BUMPL = L:= L+2 #; 05935000=01477000= + COMMENT BUMPL IS USED MOSTLY TO PREPARE A FORWARD JUMP; 05940000=01478000= + DEFINE 05945000=01479000= + IDMAX = LABELID #; 05950000=01479000= + COMMENT IDMAX IS THE MAXIMUM CLASS NUMBER FOR IDENTIFIERS; 05955000=01480000= + INTEGER 05960000=01481000= + DEFINECTR, 05965000=01481000= + DEFINEINDEX; 05970000=01481000= + ALPHA ARRAY 05975000=01481100= + DEFINFO[0:89]; 05980000=01481100= + ALPHA ARRAY 05985000=01481200= + TEXT[0:31, 0:255]; 05990000=01481200= + INTEGER 05995000=01481300= + DEFSTACKHEAD; % STACKHEAD FOR DEFINE PARAMETERS 06000000=01481300= + INTEGER 06005000=01481400= + NEXTTEXT; % NEDEX OF NEXT DEFINE TEXT 06010000=01481400= + REAL 06015000=01482000= + JOINFO, COMMENT POINTS TO PSEUDO LABEL FOR JUMP OUTS; 06020000=01482000= + LPRT, COMMENT SHOWS LOCATION OF THE LAST LABEL IN THE PRT ; 06025000=01483000= + NESTLEVEL, COMMENT COUNTS NESTING FOR GO TO AND JUMP OUTS; 06030000=01484000= + JUMPLEVEL; 06035000=01485000= + COMMENT NUMBER OF LEVELS TO BE JUMPED OUT; 06040000=01485000= + 06045000=01486000= + COMMENT THE REALS ABOVE ARE FOR STREAM STATEMENT; 06050000=01486000= + ARRAY 06055000=01487000= + MACRO[0:35]; 06060000=01487000= + COMMENT MACRO IS FILLED WITH SYLLABLES FOR STREAM STATEMENT; 06065000=01488000= + REAL 06070000=01489000= + P, COMMENT CONTAINS NUMBER OF FORMALS FOR STREAM PROCS; 06075000=01489000= + Z; 06080000=01490000= + COMMENT CONTAINS 1ST WORD OF INFO FOR STREAM FUNCTIONS; 06085000=01490000= + SAVE ALPHA ARRAY DEFINEARRAY[0:34]; 06090000=01491000= + COMMENT THESE VARIABLES ARE USED TO CONTROL ACTION OF THE DEFINE. 06095000=01492000= + DEFINECTR COUNTS DEPTH OF NESTING OF DEFINE-# PAIRS. 06100000=01493000= + THE CROSSHATCH PART OF THE TABLE ROUTINE USES DEFINECTR 06105000=01494000= + TO DETERMINE THE MEANING OF A CROSSHATCH. DEFINEINDEX IS 06110000=01495000= + THE NEXT AVAILABLE CELL IN THE DEFINEARRAY. THE DEFINE- 06115000=01496000= + ARRAY HOLDS THE ALPHA OF THE DEFINE BEING RECREATED AND 06120000=01497000= + THE PREVIOUS VALUES OF LASTUSED, LCR, AND NCR; 06125000=01498000= + INTEGER 06130000=01499000= + BEGINCTR; 06135000=01499000= + COMMENT BEGINCTR GIVES THE NUMBER OF UNMATCHED BEGINS. IT IS USED 06140000=01500000= + FOR ERROR CONTROL ONLY; 06145000=01501000= + INTEGER 06150000=01502000= + DIALA, 06155000=01502000= + DIALB; 06160000=01502000= + COMMENT THESE VARIABLES GIVE THE LAST VALUE TO WHICH A AND B WERE 06165000=01503000= + DIALED. THIS GIVES SOME LOCAL OPTIMIZATION. EMITD 06170000=01504000= + WORRIES ABOUT THIS. OTHER ROUTINES CAUSE A LOSS OF MEMORY 06175000=01505000= + BY SETTING DIALA AND DIALB TO ZERO; 06180000=01506000= + BOOLEAN 06185000=01522000= + RRB1; 06190000=01522000= + COMMENT RRB1---RRBN ARE BOOLEAN VARIABLES THAT SERVE THE 06195000=01522000= + SAME FUNCTION AS RR1---RRN FOR REAL VARIABLES. SEE 06200000=01523000= + COMMENT AT RR1; 06205000=01524000= + BOOLEAN 06210000=01525000= + RRB2; 06215000=01525000= + COMMENT SEE COMMENT AT RRB1 DECLARATION; 06220000=01525000= + DEFINE 06225000=01526000= + ARRAYMONFILE = [27:11] #; 06230000=01526000= + COMMENT ARRAYMONFILE IS THE DEFINE FOR 06235000=01526000= + THE ADDRESS OF THE FILE DESCRIPTOR IN 06240000=01527000= + THE FIRST WORD OF ADDITIONAL INFO; 06245000=01528000= + DEFINE 06250000=01529000= + SVARMONFILE = [37:11] #; 06255000=01529000= + COMMENT MONITORFILE IS THE DEFINE FOR 06260000=01529000= + THE ADDRESS OF THE FILE DESCRIPTOR IN 06265000=01530000= + INFO FOR MONITORED SIMPLE VARIABLES; 06270000=01531000= + DEFINE 06275000=01532000= + NODIMPART = [40:8] #; 06280000=01532000= + COMMENT THE FIRST ADDITIONAL WORD OF INFO 06285000=01532000= + FOR ARRAYS CONTAINS THE NUMBER OF DIMENSIONS06290000=01533000= + IN NODIMPART; 06295000=01534000= + DEFINE 06300000=01535000= + LABLMONFILE = [13:11] #; 06305000=01535000= + COMMENT LABLMONFILE DESIGNATES THE BIT 06310000=01535000= + POSITION IN THE FIRST WORD OF ADDITIONAL 06315000=01536000= + INFO THAT CONTAINS THE MONITOR FILE 06320000=01537000= + ADDRESS FOR LABELS; 06325000=01538000= + DEFINE 06330000=01539000= + SWITMONFILE = [13:11] #; 06335000=01539000= + COMMENT SWITMONFILE DESIGNATES THE BIT 06340000=01539000= + POSITION IN THE FIRST WORD OF ADDITIONAL 06345000=01540000= + INFO THAT CONTAINS THE MONITOR FILE 06350000=01541000= + ADDRESS FOR LABELS; 06355000=01542000= + DEFINE 06360000=01543000= + FUNCMONFILE = [27:11] #; 06365000=01543000= + COMMENT FUNCMONFILE DESIGNATES THE BIT 06370000=01543000= + POSITION IN THE FIRST WORD OF ADDITIONAL 06375000=01544000= + INFO THAT CONTAINS THE MONITOR FILE 06380000=01545000= + ADDRESS FOR LABELS; 06385000=01546000= + DEFINE 06390000=01547000= + DUMPEE = [2:11] #; 06395000=01547000= + COMMENT THE DUMPEE FIELD IN THE FIRST 06400000=01547000= + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 06405000=01548000= + THE ADDRESS OF THE COUNTER THAT IS INCREMENTED 06410000=01549000= + EACH TIME THE LABEL IS PASSED IF THAT LABEL 06415000=01550000= + APPEARS IN A DUMP DECLARATION; 06420000=01551000= + DEFINE 06425000=01552000= + DUMPOR = [24:11] #; 06430000=01552000= + COMMENT THE DUMPOR FIELD IN THE FIRST 06435000=01552000= + ADDITIONAL WORD OF INFO FOR LABELS CONTAINS 06440000=01553000= + THE ADDRESS OF THE ROUTINE THAT IS GENERATED 06445000=01554000= + FROM THE DUMP DECLARATION THAT IN TURN CALLS 06450000=01555000= + THE PRINTI ROUTINE; 06455000=01556000= + DEFINE 06460000=01556100= + CHUNK = 180 #; 06465000=01556100= + FILE 06470000=01556200= + OUT CODE DISK[20:CHUNK](4, 30, SAVE ABS(SAVETIME)); 06475000=01556200= + FILE 06480000=01557000= + IN CARD(RR1, 10, RR2); 06485000=01557000= + SAVE FILE OUT LINE DISK SERIAL[20:2400](RR3, 15, RR4, SAVE 10); 06490000=01559000= + ARRAY 06495000=01559010= + LIN[0:20]; 06500000=01559010= + COMMENT PRINT OUTPUT BUILT IN LIN; 06505000=01559010= + INTEGER 06510000=01559020= + DA; 06515000=01559020= + SAVE FILE OUT NEWTAPE DISK SERIAL[20:2400](RR5, RR6, RR7, SAVE 1); 06520000=01560000= + FILE 06525000=01561000= + IN TAPE 6"OCRDIMG"(2, RR8, RR9); 06530000=01561000= + SAVE FILE OUT PNCH DISK SERIAL[20:2400](2, 10, RR10, SAVE 1); 06535000=01561005= + COMMENT THE FOLLOWING ARE DECLARATIONS FOR THE SYMBOLIC LIBRARIES; 06540000=01561010= + FILE 06545000=01561020= + IN CASTA DISK SERIAL 6"CASTA"6"LIBRARY"(1, BUFFSIZE); 06550000=01561020= + FILE 06555000=01561030= + IN CASTB(1, BUFFSIZE); 06560000=01561030= + FILE 06565000=01561040= + IN CASTC(1, BUFFSIZE); 06570000=01561040= + SWITCH FILE 06575000=01561050= + LIBRARY:= CASTA, 06580000=01561050= + CASTB, 06585000=01561050= + CASTC; 06590000=01561050= + FILE 06595000=01561055= + OUT REMOTE 19(2, 10); 06600000=01561055= + SAVE ARRAY CBUF, TBUFF[0:9]; % INPUT BUFFERS. 06605000=01561056= + BOOLEAN 06610000=01561060= + REMOTEG; 06615000=01561060= + ARRAY 06620000=01561065= + LIBARRAY[0:24]; % LIBARRAY IS USED TO KEEP INFORMATION AS 06625000=01561065= + % TO LAST COMPILED LIBRARY SEQUENCE NUMBERS. 06630000=01561070= + % EACH ENTRY CONSISTS OF THREE WORDS CONTAINING: 06635000=01561080= + FILE 06640000=01561085= + DSK1 DISK SERIAL[20:816](2, 10, 30); 06645000=01561085= + FILE 06650000=01561087= + DSK2 DISK SERIAL[20:450](2, 30, 30); 06655000=01561087= + DEFINE 06660000=01561090= + LSTUSD = [9:3] #, 06665000=01561090= + FILEINDEX = [12:4] #, 06670000=01561090= + STOPPOINT = [16:16] #, 06675000=01561100= + NEXTENTRY = [32:16] #; 06680000=01561100= + COMMENT SECOND WORD IS THE $$ SEQ NO; 06685000=01561100= + DEFINE 06690000=01561110= + NCRLINK = [18:15] #, 06695000=01561110= + LCRLINK = [33:15] #; 06700000=01561110= + INTEGER 06705000=01561120= + LIBINDEX, 06710000=01561120= + LTLCR, 06715000=01561120= + MAXLTLCR, 06720000=01561120= + FILEINX, 06725000=01561120= + SEQSUM; 06730000=01561120= + COMMENT LIBINDEX IS A INDEX INTO LIBRARRAY 06735000=01561130= + INDICATING LAST ENTRY MADE IN THE ARRAY. 06740000=01561140= + LTLCR AND MAXLTLCR CORRESPOND TO TLCR AND 06745000=01561150= + MAXTLCR USED IN READACARD, FILEINX IS THE 06750000=01561160= + LIBRARY SWITCH FILE INDEX. SEQSUM IS THE 06755000=01561170= + SUM OF BASE SEQUENCE NUMBERS AT THIS POINT. 06760000=01561180= + FINISHPT IS THE LAST RECORD NUMBER TO COMPILE; 06765000=01561190= + REAL 06770000=01561200= + RECOUNT, 06775000=01561200= + FINISHPT; 06780000=01561200= + BOOLEAN 06785000=01561202= + FIRSTIMEX; 06790000=01561202= + COMMENT USED TO INDICATE WHEN 06795000=01561202= + PROCESSING FIRST CARDIMAGE OF A NESTED CALL; 06800000=01561204= + BOOLEAN 06805000=01561206= + CARDCALL; 06810000=01561206= + COMMENT TRUE IF NESTED CALL CAME FROM THE 06815000=01561206= + CARD READER ELSE FALSE; 06820000=01561208= + COMMENT RECOUNT IS THE LIBRARY RECORD COUNT; 06825000=01561210= + BOOLEAN 06830000=01561215= + NORELEASE; 06835000=01561215= + COMMENT NORELEASE ALLOWS PRINTING 06840000=01561215= + OF CURRENT BUFFER WHEN COMMING OUT OF LIBRARIES; 06845000=01561217= + DEFINE 06850000=01561220= + NOROWS = 3 #; 06855000=01561220= + COMMENT THIS IS THE MAXIMUM NUMBER OF DIRECTORY 06860000=01561220= + BLOCKS PER LIBRARY TAPE; 06865000=01561230= + ARRAY 06870000=01561240= + DIRECTORY[0:3*NOROWS-1, 0:55]; 06875000=01561240= + COMMENT THIS IS THE ACTUAL 06880000=01561240= + DIRECTORY AND IS MADE UP AS FOLLOWS: 06885000=01561250= + A: 1 CAR- NUMBER OF DIRECTORY BLOCKS. 06890000=01561260= + B: 1 CHR - NUMBER OF CHARACTERS IN THE LIBRARY 06895000=01561270= + IDENTIFIER NAME. 06900000=01561280= + C N CHR - ACTUAL ALPHA OF THE LIBRARY IDENTIFIER. 06905000=01561290= + D: 3 CHR - STARTING RECORD NUMBER FOR THE ACTUAL 06910000=01561300= + ENTRIES. 06915000=01561310= + ITEMS B,C,D ARE THE REPEATED FOR EACH IDENTIFIER. 06920000=01561320= + LIBRARY DIRECTORY ENTRIES ARE NOT SPLIT ACROSS 06925000=01561330= + DIRECTORY BLOCKS. 06930000=01561340= + ITEM B WHEN 0 INDICATES THE END OF THE DIRECTORY 06935000=01561350= + AND THE ITEM D WILL FOLLOW INDICATING THE 06940000=01561360= + LAST SEQUENCE NUMBER + 1 PUT ON THE LIBRARY. 06945000=01561370= + ITEM B WHEN INDICATS LAST DIRECTORY ITEM IN THIS 06950000=01561380= + BLOCK. 06955000=01561390= + IN ORDER TO CHANGE: 06960000=01561400= + NUMBER OF LIBRARY TAPES - ADD FILE DECLARATIONS AT 06965000=01561410= + 01561020 - 01561050. 06970000=01561420= + - CHANGE "3" AT 06975000=01561430= + NUMBER OF LIBRARY ENTRIES PER TAPE - CHANGE NOROWS 06980000=01561440= + AT ; 06985000=01561450= + DEFINE 06990000=01561510= + INSERTMAX = 20 #, 06995000=01561510= + % CHANGE THIS IF YOU NEED MORE LEVELS OF INCLUDES 07000000=01561510= + INSERTCOP = INSERTINFO[INSERTDEPTH, 4] #, 07005000=01561520= + % = 1 IF COPY TO NEWTAPE 07010000=01561520= + INSERTMID = INSERTINFO[INSERTDEPTH, 0] #, 07015000=01561530= + % MFID OF THE LIBRARY FILE 07020000=01561530= + INSERTFID = INSERTINFO[INSERTDEPTH, 1] #, 07025000=01561540= + % FID OF THE LIBRARY FILE 07030000=01561540= + INSERTINX = INSERTINFO[INSERTDEPTH, 2] #, 07035000=01561550= + % POINTER TO THE RECORD 07040000=01561550= + INSERTSEQ = INSERTINFO[INSERTDEPTH, 3] #; 07045000=01561560= + % LAST SEQUENCE TO BE INCLUD07050000=01561560= + INTEGER 07055000=01561570= + SAVECARD, 07060000=01561570= + INSERTDEPTH; 07065000=01561570= + ARRAY 07070000=01561580= + INSERTINFO[0:INSERTMAX, 0:4]; 07075000=01561580= + FILE 07080000=01561590= + LIBRARYFIL DISK RANDOM(2, 10, 30); 07085000=01561590= + DEFINE 07090000=01561600= + LF = LIBRARYFIL #; 07095000=01561600= + SAVE ARRAY LBUFF[0:9]; % INPUT BUFFER 07100000=01561610= + REAL 07105000=01561620= + STREAM PROCEDURE CMPD(A, B); 07110000=01561620= + BEGIN 07115000=01561630= + SI:= A; 07120000=01561640= + DI:= B; 07125000=01561640= + IF 8 SC >= DC THEN 07130000=01561650= + BEGIN 07135000=01561660= + SI:= SI-8; 07140000=01561670= + DI = DI-8; 07145000=01561670= + TALLY:= 2; 07150000=01561670= + IF 8 SC = DC THEN 07155000=01561680= + TALLY:= 1; 07160000=01561680= + END; 07165000=01561690= + CMPD:= TALLY; 07170000=01561700= + END CMPD; 07175000=01561710= + REAL 07180000=01562000= + C; 07185000=01562000= + COMMENT C CONTAINS ACTUAL VALUE OF LAST CONSTANT SCANNED; 07190000=01563000= + REAL 07195000=01564000= + T; 07200000=01564000= + COMMENT T IS A TEMPORARY CELL; 07205000=01565000= + INTEGER 07210000=01566000= + TCOUNT; 07215000=01566000= + COMMENT TCOUNT IS A VARIABLE WHICH HOLDS A PREVIOUS VALUE OF COUNT 07220000=01567000= + FOR THE USE OF CONVERT; 07225000=01568000= + REAL 07230000=01568500= + STACKCT; 07235000=01568500= + DEFINE 07240000=01569000= + LOGI = 443 #, 07245000=01570000= + EXPI = 440 #, 07250000=01571000= + XTOTHEI = 480 #, 07255000=01572000= + GOTOSOLVER = 484 #, 07260000=01573000= + PRINTI = 477 #, 07265000=01573100= + MERGEI = 500 #, 07270000=01574000= + POWERSOFTEN = 670 #, 07275000=01575000= + LASTSEQUENCE = 166 #, 07280000=01576000= + LASTSEQROW = 2 #, 07285000=01577000= + INTERPTO = 461 #, 07290000=01577500= + SUPERMOVER = 555 #, 07295000=01578000= + CHARI = 465 #, 07300000=01579000= + INTERPTI = 469 #, 07305000=01579100= + SORTI = 473 #, 07310000=01579200= + DIALER = 559 #, 07315000=01579300= + FILEATTINT = 563 #, 07320000=01579350= + POWERALL = 567 #, 07325000=01579355= + SPECIALMATH = 570 #, 07330000=01580000= + SORTA = 673 #; 07335000=01580000= + COMMENT THESE DEFINES ARE USED TO TALK TO GNAT. THEY GIVE THE INDEX07340000=01581000= + IN INFO OF THE CORRESPONDING ROUTINE; 07345000=01582000= + INTEGER 07350000=01583000= + KOUNT, 07355000=01583000= + BUFFACCUM; 07360000=01583000= + INTEGER 07365000=01584000= + FILENO; 07370000=01584000= + BOOLEAN 07375000=01586000= + FUNCTOG, COMMENT TELLS WHETHER PROCEDURE BEING DECLARED IS A 07380000=01586000= + FUNCTION; 07385000=01587000= + P2, COMMENT GENERALY TELLS WHETHER OWN WAS SEEN; 07390000=01588000= + P3, COMMENT TELLS WHETHER SAVE WAS SEEN; 07395000=01589000= + P4, COMMENT TELLS WHETHER AUXMEM WAS SEEN; 07400000=01589500= + VONF, COMMENT VALUE OR OWN FIELD OF ELBAT WORD; 07405000=01590000= + FORMALF, COMMENT FORMAL FIELD OF ELBAT WORD; 07410000=01591000= + PTOG, COMMENT TELLS THAT FORMAL PARAPART IS BEING PROCESSD;07415000=01592000= + SPECTOG, 07420000=01594000= + STOPENTRY, COMMENT THIS MAKES THE ENTRY PROCEDURE ENTER ONLY 07425000=01594000= + ONE ID AND THEN EIXT; 07430000=01595000= + AJUMP; 07435000=01596000= + COMMENT TELLS WHETHER A JUMP IS HANGING; 07440000=01596000= + BOOLEAN 07445000=01597000= + STOPDEFINE; 07450000=01597000= + REAL 07455000=01597100= + CORESZ; % CORE ESTIMATE NEEDED FOR SORT. 07460000=01597100= + INTEGER 07465000=01598000= + MAXSAVE; 07470000=01598000= + COMMENT THIS CONTAINS THE SIZE OF THE MAXIMUM SAVE ARRAY 07475000=01599000= + DECLARED. IT IS USED TO HELP DETERMINE STORAGE REQUIREMENTS 07480000=01600000= + FOR THE PROGRAM PARAMETER BLOCK FOR THE OBJECT PROGRAM; 07485000=01601000= + REAL 07490000=01603000= + KLASSF, COMMENT CLASS IN LOW ORDER 7 BITS; 07495000=01603000= + ADDRSF, COMMENT ADDRESS IN LOW ORDER 11 BITS; 07500000=01604000= + LEVELF, COMMENT LVL IN LOW ORDER 5 BITS; 07505000=01605000= + LINKF, COMMENT LINK IN LOW ORDER 13 BITS; 07510000=01606000= + INCRF, COMMENT INCR CN LOW ORDER 8 BITS; 07515000=01607000= + PROINFO, COMMENT CONTAINS ELBAT WORD FOR PROCEDURE BEING 07520000=01608000= + DECLARED; 07525000=01609000= + G, COMMENT GLOBAL TEMPORARY FOR BLOCK; 07530000=01610000= + TYPEV, COMMENT USED TO CARRY CLASS OF IDENTIFIER 07535000=01611000= + BEING DECLARED; 07540000=01612000= + PROADO, COMMENT CONTAINS ADDRESS OF PROCEDURE BEING 07545000=01613000= + DECLARED; 07550000=01614000= + MARK, COMMENT CONTAINS INDEX INTO INFO WHERE FIRST WORD 07555000=01615000= + OF ADDITIONAL INFO FOR A PROCEDURE ENTRY; 07560000=01616000= + PJ, COMMENT FORMAL PARAMETER COUNTER; 07565000=01617000= + J, COMMENT ARRAY COUNTER; 07570000=01618000= + LASTINFO, COMMENT INDEX TO LAST ENTRY IN INFO; 07575000=01619000= + NEXTINFO, COMMENT INDEX FOR NEXT ENTRYIN INFO; 07580000=01620000= + GLOBALNINFOO, 07585000=01620100= + COMMENT MAINTAINS VALUE OF NINFOO FROM BLOCK ON A 07590000=01620100= + GLOBAL LEVEL SO TAHT THE PROCEDURE "ENTRY" 07595000=01620200= + CAN CHECK FOR DUPLICATE DECLARATIONS; 07600000=01620300= + OLDNINFOO, COMMENT REMEMBERS OLD VALUE OF GLOBALNINFOO; 07605000=01620400= + FIRSTX, COMMENT RELATIVE ADD OF FIRST EXECUTABLE CODE 07610000=01621000= + IN BLOCK,INITIALIZED TO 4095 EACH TIME; 07615000=01622000= + SAVEL, COMMENT SAVE LOCATION FOR FIXUPS IN BLOCK; 07620000=01623000= + INTEGER NCII; 07625000=01624000= + COMMENT THIS CONTAINS THE COUNT OF CONSTANTS 07630000=01624000= + ENTERED IN INFO AT ANY GIVEN TIME; 07635000=01625000= + REAL 07640000=01625100= + FILETHING; 07645000=01625100= + COMMENT HOLDS LINKS FOR STREAM RELEASES ; 07650000=01625100= + PROCEDURE UNHOOK; 07655000=01626000= + FORWARD; 07660000=01626000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%07665000=01626000= + PROCEDURE MAKEUPACCUM; 07670000=01627000= + FORWARD; 07675000=01627000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%07680000=01627000= + DEFINE 07685000=01628000= + PURPT = [4:8] #, 07690000=01628000= + SECRET = 2 #; 07695000=01628000= + 07700000=01629000= + COMMENT THESE DEFINES GIVE THE NAMES OF THE WORD MODE OPERATORS. THE 07705000=01629000= + NUMBERS REFERS TO THE APPROPRIATE SECTION OF THE PRODUCT SPECS. THE07710000=01630000= + FULL NAME IS ALSO GIVEN; 07715000=01631000= + DEFINE 07720000=01632000= + ADD = 16#, COMMENT (0101) 7.4.2.1 ADD; 07725000=01633000= + BBC = 22#, COMMENT (0131) 7.4.5.4 BRANCH BACKWARD CONDITIONAL;07730000=01634000= + BBW = 534#, COMMENT (4131) 7.4.5.2 BRANCH BACKWARD; 07735000=01635000= + BFC = 38#, COMMENT (0231) 7.4.5.3 BRANCH FORWARD CONDITIONAL; 07740000=01636000= + BFW = 550#, COMMENT (4231) 7.4.5.1 BRANCH FORWARD; 07745000=01637000= + CDC = 168#, COMMENT (1241) 7.4.10.4 CONSTRUCT DESCRIPTOR CALL; 07750000=01638000= + CHS = 134#, COMMENT (1031) 7.4.7.11 CHANGE SIGN; 07755000=01639000= + COC = 40#, COMMENT (0241) 7.4.10.3 CONSTRUCT OPERAND CALL; 07760000=01640000= + COM = 130#, COMMENT (1011) 7.4.10.5 COMMUNICATION OPERATOR; 07765000=01641000= + DEL = 10#, COMMENT (0051) 7.4.9.3 DELETE; 07770000=01642000= + DUP = 261#, COMMENT (2025) 7.4.9.2 DUPLICATE; 07775000=01643000= + EQL = 581#, COMMENT (4425) 7.4.4.3 EQUAL; 07780000=01644000= + LBC = 278#, COMMENT(2131) 7.4.5.9 GO BACKWARD CONDITIONAL; 07785000=01645000= + LBU = 790#, COMMENT(6131) 7.4.5.7 GO BACKWARD (WORD); 07790000=01646000= + GEQ = 21#, COMMENT (0125) 7.4.4.2 GREATER THAN OR EQUAL TO; 07795000=01647000= + LFC = 294#, COMMENT(2231) 7.4.5.8 GO FORWARD CONDITIONAL; 07800000=01648000= + LFU = 806#, COMMENT(6231) 7.4.5.6 GO FORWARD (WORD); 07805000=01649000= + GTR = 37#, COMMENT (0225) 7.4.4.1 GREATER THAN; 07810000=01650000= + IDV = 384#, COMMENT (3001) 7.4.2.5 INTEGER DIVIDE; 07815000=01651000= + INX = 24#, COMMENT (0141) 7.4.10.2 INDEX; 07820000=01652000= + ISD = 532#, COMMENT (4121) 7.4.6.3 INTEGER STORE DESTRUCTIVE; 07825000=01653000= + ISN = 548#, COMMENT (4221) 7.4.6.4 INTEGER STORE NON-DESTRUCT; 07830000=01654000= + LEQ = 533#, COMMENT (4125) 7.4.4.4 LESS THAN OR EQUAL TO; 07835000=01655000= + LND = 67#, COMMENT (0415) 7.4.3.1 LOGICAL AND; 07840000=01656000= + LNG = 19#, COMMENT (0115) 7.4.3.4 LOGICAL NEGATE; 07845000=01657000= + LOD = 260#, COMMENT (2021) 7.4.10.1 LOAD OPERATOR; 07850000=01658000= + LOR = 35#, COMMENT (0215) 7.4.3.2 LOGICAL OR; 07855000=01659000= + LQV = 131#, COMMENT (1015) 7.4.3.3 LOGICAL EQUIVALENCE; 07860000=01660000= + LSS = 549#, COMMENT (4225) 7.4.4.5 LESS THAN; 07865000=01661000= + MDS = 515#, COMMENT (4015) 7.4.7.7 SET FLAG BIT; 07870000=01661100= + MKS = 72#, COMMENT (0441) 7.4.8.1 MARK STACK; 07875000=01662000= + MUL = 64#, COMMENT (0401) 7.4.2.3 MULTIPLY; 07880000=01663000= + NEQ = 69#, COMMENT (0425) 7.4.4.6 NOT EQUAL TO; 07885000=01664000= + NOP = 11#, COMMENT (0055) 7.4.7.1 NO OPERATION; 07890000=01665000= + PRL = 18#, COMMENT (0111) 7.4.10.6 PROGRAM RELEASE; 07895000=01666000= + PRTE= 12#, COMMENT (0061) 7.4.10.9 EXTEND PRT; 07900000=01667000= + RDV = 896#, COMMENT (7001) 7.4.2.6 REMAINDER DIVIDE; 07905000=01668000= + RTN = 39#, COMMENT (0235) 7.4.8.3 RETURN NORMAL; 07910000=01669000= + RTS = 167#, COMMENT (1235) 7.4.8.4 RETURN SPECIAL; 07915000=01670000= + SND = 132#, COMMENT (1021) 7.4.6.2 STORE NON-DESTRUCTIVE; 07920000=01671000= + SSN = 70#, COMMENT (0431) 7.4.7.10 SET SIGN NEGATIVE; 07925000=01671100= + SSP = 582#, COMMENT (4431) 7.4.7.10 SET SIGN PLUS; 07930000=01672000= + STD = 68#, COMMENT (0421) 7.4.6.1 STORE DESTRUCTIVE; 07935000=01673000= + SUB = 48#, COMMENT (0301) 7.4.2.2 SUBTRACT; 07940000=01674000= + XCH = 133#, COMMENT (1025) 7.4.9.1 EXCHANGE; 07945000=01675000= + XIT = 71#, COMMENT (0435) 7.4.8.2 EXIT; 07950000=01676000= + ZP1 = 322#; COMMENT (2411) 7.4.10.8 CONDITIONAL HALT; 07955000=01677000= + COMMENT THESE DEFINES ARE USED BY EMITD; 07960000=01678000= + DEFINE 07965000=01679000= + DIA = 45#, COMMENT (XX55) 7.4.7.1 DIAL A; 07970000=01680000= + DIB = 49#, COMMENT (XX61) 7.4.7.2 DIAL B; 07975000=01681000= + TRB = 53#; COMMENT (XX65) 7.4.7.3 TRANSFER BITS; 07980000=01682000= + REAL 07985000=01683000= + MAXSTACK, 07990000=01683000= + STACKCTR; 07995000=01683000= + INTEGER 08000000=01684000= + MAXROW; 08005000=01684000= + COMMENT THIS CONTAINS THE MAXIMUM ROW SIZE OF ALL NON-SAVE 08010000=01685000= + ARRAYS DECLARED. ITS USE IS LIKE THAT OF MAXSAVE; 08015000=01686000= + INTEGER 08020000=01687000= + SEGSIZEMAX; 08025000=01687000= + COMMENT CONTAINS MAX SEGMENT SIZE; 08030000=01687000= + INTEGER 08035000=01688000= + F; 08040000=01688000= + STREAM PROCEDURE MOVECODE(EDOC, TEDOC); 08045000=01688010= + BEGIN 08050000=01688020= + LOCAL T1, T2, T3; 08055000=01688020= + SI:= EDOC; 08060000=01688030= + T1:= SI; 08065000=01688030= + SI:= TEDOC; 08070000=01688030= + T2:= SI; 08075000=01688030= + SI:= LOC EDOC; 08080000=01688030= + SI:= SI+3; 08085000=01688030= + DI:= LOC T3; 08090000=01688030= + DI:= DI+5; 08095000=01688040= + SKIP 3 DB; 08100000=01688040= + (IF SB THEN DS:= 1 SET ELSE DS:= 1 RESET;SKIP 1 SB); 08105000=01688050= + SI:= LOC EDOC; 08110000=01688050= + DI:= LOC T2; 08115000=01688050= + DS:= 5 CHR; 08120000=01688050= + (IF SB THEN DS:= 1 SET ELSE DS:= 1 RESET;SKIP 1 SB); 08125000=01688060= + DI:= T3; 08130000=01688060= + SI:= LOC T2; 08135000=01688060= + DS:= WDS; 08140000=01688060= + DI:= LOC T3; 08145000=01688070= + DI:= DI+5; 08150000=01688070= + SKIP 3 DB; 08155000=01688070= + SI:= LOC TEDOC; 08160000=01688070= + SI:= SI+3; 08165000=01688070= + (IF SB THEN DS:= 1 SET ELSE DS:= 1 RESET;SKIP 1 SB); 08170000=01688080= + SI:= LOC TEDOC; 08175000=01688080= + DI:= LOC T1; 08180000=01688090= + DS:= 5 CHR; 08185000=01688090= + (IF SB THEN DS:= 1 SET ELSE DS:= 1 RESET;SKIP 1 SB); 08190000=01688090= + DI:= T3; 08195000=01688100= + SI:= LOC T1; 08200000=01688100= + DS:= WDS 08205000=01688110= + END; 08210000=01688110= + REAL 08215000=01689000= + NLO, 08220000=01689000= + NHI, 08225000=01689000= + TLO, 08230000=01689000= + THI; 08235000=01689000= + BOOLEAN 08240000=01690000= + DPTOG; 08245000=01690000= + COMMENT THE ABOVE THINGS ARE TEMP STORAGE FOR DOUBLE NOS;08250000=01691000= + DEFINE 08255000=01692000= + FZERO = 896 #; 08260000=01692000= + REAL 08265000=01693000= + T1, 08270000=01693000= + T2, 08275000=01693000= + N, 08280000=01693000= + K, 08285000=01693000= + AKKUM; 08290000=01693000= + BOOLEAN 08295000=01694000= + STOPGSP; 08300000=01694000= + INTEGER 08305000=01695000= + BUP; 08310000=01695000= + COMMENT UNIQUE GLOBAL TEMP FOR BLOCK; 08315000=01696000= + ARRAY 08320000=01697000= + GTA1[0:10]; 08325000=01697000= + BOOLEAN ARRAY 08330000=01698000= + SPRT[0:31]; 08335000=01698000= + COMMENT SPRT IS TO BE CONSIDERED TO BE AN ARRAY OF 32 32 BIT 08340000=01699000= + FIELDS. THE 32 BITS ARE IN THE LOW ORDER PART OF EACH 08345000=01700000= + WORD. THE BIT IS ON IF AND ONLY IF THE CORRESPONDING 08350000=01701000= + PRT CELL HAS A PERMANENT ASSIGNMENT; 08355000=01702000= + INTEGER 08360000=01703000= + PRTI, 08365000=01703000= + PRTIMAX; 08370000=01703000= + COMMENT PRTIMAX GIVES NEXT PRT CELL AVAILABLE FOR PERMANENT ASSIGN-08375000=01704000= + MENT. PRTI GIVES NEXT PRT CELL POSSIBLY AVAILABLE FOR 08380000=01705000= + TEMPORARY ASSIGNMENT; 08385000=01706000= + DEFINE 08390000=01707000= + ALPHASIZE = [12:6] #; 08395000=01707000= + COMMENT ALPHASIZE IS THE DEFINE FOR THE BIT08400000=01707000= + POSITION IN THE SECOND WORD OF INFO WHICH 08405000=01708000= + CONTAINS THE LENGTH OF ALPHA; 08410000=01709000= + DEFINE 08415000=01710000= + EDOCINDEX = L.[36:3], L.[39:7] #; 08420000=01710000= + COMMENT EDOCINDEX IS THE WORD 08425000=01710000= + PORTION OF L SPLIT INTO A ROW AND08430000=01711000= + COLUMN INDEX FOR EDOC; 08435000=01712000= + DEFINE 08440000=01713000= + CPLUS1 = 769 #; 08445000=01713000= + COMMENT SEE COMMENT AT CPLUS2 DEFINE; 08450000=01713000= + DEFINE 08455000=01714000= + CPLUS2 = 770 #; 08460000=01714000= + COMMENT CPLUS1 AND CPLUS2 ARE EXPLICIT CONSTANTS 08465000=01714000= + USED IN THE GENERATION OF C-RELATIVE CODE; 08470000=01715000= + PROCEDURE FLAG(ERRNUM); 08475000=01716000= + VALUE 08480000=01716000= + ERRNUM; 08485000=01716000= + INTEGER 08490000=01716000= + ERRNUM; 08495000=01716000= + FORWARD; 08500000=01716000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08505000=01716000= + ALPHA PROCEDURE B2D(B); 08510000=01717000= + VALUE 08515000=01717000= + B; 08520000=01717000= + REAL 08525000=01717000= + B; 08530000=01717000= + FORWARD; 08535000=01717000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08540000=01717000= + BOOLEAN 08545000=01717800= + MACROID; 08550000=01717800= + REAL PROCEDURE FIXDEFINEINFO(T); 08555000=01717900= + VALUE 08560000=01717900= + T; 08565000=01717900= + REAL 08570000=01717900= + T; 08575000=01717900= + FORWARD; 08580000=01717900= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08585000=01717900= + PROCEDURE DEFINEPARAM(D, N); 08590000=01717950= + VALUE 08595000=01717950= + D, 08600000=01717950= + N; 08605000=01717950= + INTEGER 08610000=01717950= + D, 08615000=01717950= + N; 08620000=01717950= + FORWARD; 08625000=01717950= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08630000=01717950= + PROCEDURE ERR(ERRNUM); 08635000=01718000= + VALUE 08640000=01718000= + ERRNUM; 08645000=01718000= + INTEGER 08650000=01718000= + ERRNUM; 08655000=01718000= + FORWARD; 08660000=01718000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08665000=01718000= + REAL PROCEDURE TAKE(X); 08670000=01718100= + VALUE 08675000=01718100= + X; 08680000=01718100= + INTEGER 08685000=01718100= + X; 08690000=01718100= + FORWARD; 08695000=01718100= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08700000=01718100= + PROCEDURE PUT(W, X); 08705000=01718200= + VALUE 08710000=01718200= + W, 08715000=01718200= + X; 08720000=01718200= + REAL 08725000=01718200= + W, 08730000=01718200= + X; 08735000=01718200= + FORWARD; 08740000=01718200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08745000=01718200= + INTEGER PROCEDURE GIT(L); 08750000=01719000= + VALUE 08755000=01719000= + L; 08760000=01719000= + REAL 08765000=01719000= + L; 08770000=01719000= + FORWARD; 08775000=01719000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08780000=01719000= + BOOLEAN 08785000=01720000= + LISTMODE; 08790000=01720000= + COMMENT LISTMODE IS A VARIABLE USED BY FORSTMT TO DECEIDE IF A LIST 08795000=01721000= + IS BEING GENERATED OR A STATEMENT; 08800000=01722000= + INTEGER 08805000=01723000= + LSTR; 08810000=01723000= + COMMENT LSTR GIVES THE LOCATION OF FIRST SYLABLE OF A LIST. IT IS 08815000=01724000= + USED BY LISTELEMENT TO COMPUTE VALUES TO STORE IS LSTRTN; 08820000=01725000= + PROCEDURE SCANNER; 08825000=01730000= + FORWARD; 08830000=01730000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08835000=01730000= + COMMENT MKABS CONVERTS A DESCRIPTOR TO AN ABSOLTE ADDRESS; 08840000=01732000= + REAL 08845000=01733000= + STREAM PROCEDURE MKABS(A); 08850000=01733000= + BEGIN 08855000=01734000= + DI:= A; 08860000=01734000= + MKABS:= DI 08865000=01734000= + END MKABS; 08870000=01734000= + STREAM PROCEDURE MOVE(W)6"WORDS FROM"(A)6"TO"(B); 08875000=01735000= + VALUE 08880000=01735000= + W; 08885000=01735000= + BEGIN 08890000=01736000= + LOCAL T; 08895000=01736000= + SI:= LOC W; 08900000=01736100= + DI:= LOC T; 08905000=01736100= + SI:= SI+6; 08910000=01736100= + DI:= DI+7; 08915000=01736100= + DS:= CHR; 08920000=01736100= + SI:= A; 08925000=01736200= + DI:= B; 08930000=01736200= + T(DS:= 32 WDS;DS:= 32 WDS); 08935000=01736200= + DS:= W WDS; 08940000=01736200= + END MOVE; 08945000=01736300= + STREAM PROCEDURE ZEROUT(DEST, NDIV32, NMOD32); 08950000=01737000= + VALUE 08955000=01737050= + NDIV32, 08960000=01737050= + NMOD32; 08965000=01737050= + BEGIN 08970000=01737100= + DI:= DEST; 08975000=01737100= + NDIV32(32(DS:= 8 LIT 6"0")); 08980000=01737150= + NMOD32(DS:= 8 LIT 6"0"); 08985000=01737200= + END; 08990000=01737250= + 08995000=01737300= +COMMENT "BLANKET" BLANKS OUT N+1 WORDS IN "THERE"; 09000000=01737300= + STREAM PROCEDURE BLANKET(N, THERE); 09005000=01737350= + VALUE 09010000=01737350= + N; 09015000=01737350= + BEGIN 09020000=01737400= + DI:= THERE; 09025000=01737450= + DS:= 8 LIT 6" "; 09030000=01737450= + SI:= THERE; 09035000=01737450= + DS:= N WDS; 09040000=01737450= + END BLANKET; 09045000=01737500= + PROCEDURE STEPIT; 09050000=01741000= + FORWARD; 09055000=01741000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%09060000=01741000= + COMMENT SEQCHANGE WILL CONV A MACHING NO. TO PROPER OUTPUT FORM; 09065000=01741100= + STREAM PROCEDURE CHANGESEQ(VAL, OLDSEQ); 09070000=01741200= + VALUE 09075000=01741200= + OLDSEQ; 09080000=01741200= + BEGIN 09085000=01741300= + DI:= OLDSEQ; 09090000=01741400= + SI:= VAL; 09095000=01741400= + DS:= 8 DEC 09100000=01741500= + END; 09105000=01741500= + STREAM PROCEDURE SEQUENCEWARNING(L); 09110000=01742100= + BEGIN 09115000=01742110= + DI:= L; 09120000=01742110= + DI:= DI-8; 09125000=01742110= + DS:= 24 LIT 6"SEQUENCE WARNING<<<<<<<<"; 09130000=01742110= + END; 09135000=01742110= + BOOLEAN 09140000=01742200= + STREAM PROCEDURE NONBLANK(FCR); 09145000=01742200= + VALUE 09150000=01742200= + FCR; 09155000=01742200= + COMMENT NONBLANK SCANS CARD FOR ALL BLANKS-- 09160000=01742300= + TRUE IF ANY VISIBLE CHARACTER ; 09165000=01742400= + BEGIN 09170000=01742500= + LABEL 09175000=01742600= + NED; 09180000=01742600= + SI:= FCR; 09185000=01742700= + TALLY:= 0; 09190000=01742800= + (36(IF SC ^= 6" " THEN JUMP OUT 2 TO NED;SI:= SI+1)); 09195000=01742900= + TALLY:= 63; 09200000=01743000= +NED: 09205000=01743100= + TALLY:= TALLY+1; 09210000=01743100= + NONBLANK:= TALLY 09215000=01743300= + END NONBLANK; 09220000=01743300= + INTEGER 09225000=01750000= + FAULTLEVEL; 09230000=01750000= + COMMENT THIS IS FOR THE RUN0TIME ERROR KLUDGE-- 09235000=01750000= + GIVES THE LOWEST LEVEL AT WHICH THERE IS AN ACTIVE 09240000=01751000= + FAULT DECL OR LABEL USED IN A FAULT STATEMENT; 09245000=01752000= + BOOLEAN 09250000=01753000= + FAULTOG; 09255000=01753000= + COMMENT FAULTSTMT USES THIS TO TELL DEXP TO WORRY 09260000=01753000= + ABOUT FAULTLEVEL; 09265000=01754000= + INTEGER 09270000=01755000= + SFILENO; 09275000=01755000= + COMMENT FILENO OF FIRST SORT FILE; 09280000=01755000= + STREAM PROCEDURE GETVOID(VP, NCR, VR, LCR, SEQ); 09285000=01756000= + VALUE 09290000=01756000= + NCR; 09295000=01756000= + BEGIN 09300000=01757000= + LABEL 09305000=01758000= + L, 09310000=01758000= + TRANS; 09315000=01758000= + LOCAL N; 09320000=01759000= + SI:= SEQ; 09325000=01759100= + DI:= LCR; 09330000=01759100= + DI:= DI-1; 09335000=01759100= + DS:= LIT 6"%"; % PUT "%" IN CC 72. 09340000=01759100= + DS:= WDS;% RESTORE SEQ. NO. FOR $VOID(T) CARDS. 09345000=01759200= + SI:= LCR; 09350000=01760000= + DI:= LOC N; 09355000=01760000= + DS:= CHR; % SAVE COL. 73 09360000=01760000= + SI:= NCR; 09365000=01761000= + DI:= VP; 09370000=01761000= + DS:= 8 LIT 6"0"; 09375000=01761000= + 2(34(IF SC = 6" " THEN SI:= SI+1 ELSE JUMP OUT 2 TO L)); 09380000=01762000= + SI:= LCR; 09385000=01763000= + TALLY:= 8; 09390000=01763000= + GO TRANS; % NO VOID RANGE FOUND, USE 73-80. 09395000=01763000= +L: IF SC = 6""" THEN 09400000=01765000= + BEGIN 09405000=01766000= + SI:= SI+1; 09410000=01767000= + DI:= LCR; 09415000=01767000= + DS:= 1 LIT 6"""; % STOPPER FOR SCAN 09420000=01767000= + NCR:= SI; % TEMP, STORAGE. SINCE NCR IS "LOCAL" TO GETVOID. 09425000=01768000= + 8 (IF SC = 6""" THEN JUMP OUT ELSE BEGIN TALLY:= TALLY+1;SI:= SI+ 09430000=01770000= + 1 09435000=01770000= + END); 09440000=01770000= + END 09445000=01772000= + ELSE 09450000=01772000= + BEGIN 09455000=01772000= + NCR:= SI; % TEMP. STORAGE, SINCE NCR IS "LOCAL" TO GETVOID. 09460000=01773000= + DI:= LCR; 09465000=01774000= + DS:= 1 LIT 6" "; % STOPPER FOR SCAN 09470000=01774000= + 8 (IF SC = 6" " THEN JUMP OUT ELSE BEGIN TALLY:= TALLY+1;SI:= SI+ 09475000=01776000= + 1 09480000=01776000= + END); 09485000=01776000= + END; 09490000=01777000= +TRANS: 09495000=01779000= + SI:= LOC N; 09500000=01779000= + DI:= LCR; 09505000=01779000= + DS:= CHR; % RESTORE COLUMN 73 09510000=01779000= + SI:= NCR; 09515000=01780000= + DI:= VP; 09520000=01780000= + DI:= DI+8; % RESTORE POINTERS. 09525000=01780000= + N:= TALLY; 09530000=01781000= + DI:= DI-N; 09535000=01781000= + DS:= N CHR; 09540000=01781000= + DI:= DI-8; 09545000=01782000= + VP:= DI; % I.E., "LOC VP":=DI. 09550000=01782000= + DI:= VR; 09555000=01783000= + SI:= LOC VP; 09560000=01783000= + DS:= WDS; % ADDRESS OF VOID RANGE. 09565000=01783000= + END OF GETVOID; 09570000=01784000= + REAL 09575000=01785000= + VOIDCR, 09580000=01785000= + VOIDPLACE; 09585000=01785000= + BOOLEAN 09590000=01786000= + SORTMERGETOG; 09595000=01786000= + FORMAT PRINTSEGNO(X88,"START OF SEGMENT ********** ",I4), 09600000=01800000= + PRINTSIZE(X88,I4," IS ",I4," LONG, NEXT SEG ",I4), 09605000=01801000= + BUG(X24,4(A4,X2)); 09610000=01802000= + PROCEDURE DATIME; 09615000=01820000= + BEGIN 09620000=01821000= + INTEGER 09625000=01822000= + H, 09630000=01822000= + MIN, 09635000=01822000= + Q; 09640000=01822000= + ALPHA 09645000=01822000= + N1, 09650000=01822000= + N2; 09655000=01822000= + ALPHA 09660000=01823000= + STREAM PROCEDURE DATER(DATE); 09665000=01823000= + VALUE 09670000=01823000= + DATE; 09675000=01823000= + BEGIN 09680000=01824000= + DI:= LOC DATER; 09685000=01825000= + SI:= LOC DATE; 09690000=01825000= + SI:= SI+2; 09695000=01825000= + (DS:= 2 CHR;DS:= LIT 6"/"); 09700000=01826000= + DS:= 2 CHR; 09705000=01826000= + END OF DATER; 09710000=01827000= + H:= TIME1 DIV 216000; 09715000=01828000= + MIN:= (TIME1 DIV 3600) MOD 60; 09720000=01828000= + N1:= CODE.MFID; 09725000=01828500= + N2:= CODE.FID; 09730000=01828500= + WRITE(LINE, 09735000=01829100= + N1.[6:6],N1,N2.[6:6],N2); 09740000=01835550= +IF MERGETOG THEN % INDICATE NAME OF SOURCE FILE. 09745000=01835600= + WRITE(LINE, < X40, 6"SOURCE FILE: ", A1, A6, 6"/", A1, A6, //> 09750000=01837000= + , (N1:= TAPE.MFID).[6:6], N1, (N2:= TAPE.FID).[6:6], N2); 09755000=01837000= + NOHEADING:= FALSE; 09760000=01837000= + END OF DATIME; 09765000=01837000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%09770000=01837000= + DEFINE 09775000=01841000= + DOT = BEGIN 09780000=01841000= + IF ELCLASS = PERIOD THEN 09785000=01841000= + DOTIT 09790000=01841000= + END #; 09795000=01841000= + 09800000=02000000= + COMMENT THIS SECTION CONTAINS ALL CODE PERTAINENT TO READING CARDS 09805000=02000000= + AND SCANNING THEM; 09810000=02001000= + BOOLEAN 09815000=02001020= + STREAM PROCEDURE LOOK(ACC1, DIR, ROW, STRTPOS, STOPOS); 09820000=02001020= + VALUE 09825000=02001030= + ROW; 09830000=02001030= + BEGIN 09835000=02001040= + COMMENT LOOK DOES THE ACTUAL DIRECTORY SEARCH. IT 09840000=02001040= + REPORTS TRUE IF THE ITEM WAS NOT FOUND IN THE DIRECTORY09845000=02001050= + ; 09850000=02001060= + LOCAL DPPOS, TEMP, LGTH; 09855000=02001070= + LABEL 09860000=02001080= + LOOP, 09865000=02001080= + EXIT; 09870000=02001080= + SI:= DIR; 09875000=02001090= + ROW(SI:= SI+8); 09880000=02001090= + DPPOS:= SI; 09885000=02001090= + DI:= LOC TEMP; 09890000=02001100= + DS:= WDS; 09895000=02001100= + SI:= TEMP; 09900000=02001100= + SI:= SI+8; 09905000=02001110= +LOOP: 09910000=02001120= + DI:= LOC LGTH; 09915000=02001120= + DI:= DI+7; 09920000=02001120= + DS:= CHR; 09925000=02001120= + DI:= ACC1; 09930000=02001130= + DI:= DI+2; 09935000=02001130= + SI:= SI-1; 09940000=02001130= + IF SC = DC THEN 09945000=02001150= + BEGIN 09950000=02001150= + COMMENT THE LENGTHS ARE EQUAL; 09955000=02001150= + IF LGTH SC = DC THEN 09960000=02001170= + BEGIN 09965000=02001170= + COMMENT FOUND IT; 09970000=02001170= + DI:= STRTPOS; 09975000=02001180= + DS:= 5 LIT 6"0"; 09980000=02001180= + DS:= 3 CHR; 09985000=02001180= + IF SC = 6"0" THEN 09990000=02001200= + BEGIN 09995000=02001200= + COMMENT WE MAY BE IN THE10000000=02001200= + WRONG ROW; 10005000=02001210= + SI:= SI+1; 10010000=02001220= + DI:= LOC LOOK; 10015000=02001220= + IF 3 SC = DC THEN 10020000=02001240= + BEGIN 10025000=02001240= + COMMENT WE ARE10030000=02001240= + IN THE WRONG 10035000=02001250= + ROW; 10040000=02001260= + SI:= DPPOS; 10045000=02001270= + SI:= SI+8; 10050000=02001280= + DPPOS:= SI; 10055000=02001290= + DI:= LOC TEMP; 10060000=02001300= + DS:= WDS; 10065000=02001310= + SI:= TEMP; 10070000=02001320= + END 10075000=02001340= + ELSE 10080000=02001340= + SI:= SI-4; 10085000=02001340= + END; 10090000=02001350= + DI:= LOC LGTH; 10095000=02001360= + DI:= DI+7; 10100000=02001360= + DS:= CHR; 10105000=02001360= + SI:= SI+LGTH; 10110000=02001370= + DI:= STOPOS; 10115000=02001375= + DS:= 5 LIT 6"0"; 10120000=02001375= + DS:= 3 CHR; 10125000=02001380= + GO TO EXIT; 10130000=02001380= + END; 10135000=02001390= + SI:= SI+3; 10140000=02001400= + END 10145000=02001420= + ELSE 10150000=02001420= + BEGIN 10155000=02001420= + COMMENT THE LENGTHS ARE NOT EQUAL; 10160000=02001420= + SI:= SI-1; 10165000=02001430= + IF SC = 6"0" THEN 10170000=02001450= + BEGIN 10175000=02001450= + COMMENT MAY BE A NEW ROW; 10180000=02001450= + SI:= SI+1; 10185000=02001460= + DI:= LOC LOOK; 10190000=02001460= + IF 3 SC = DC THEN 10195000=02001480= + BEGIN 10200000=02001480= + COMMENT CHANGE ROWS; 10205000=02001480= + SI:= DPPOS; 10210000=02001490= + SI:= SI+8; 10215000=02001490= + DPPOS:= SI; 10220000=02001490= + DI:= LOC TEMP; 10225000=02001500= + DS:= WDS; 10230000=02001500= + SI:= TEMP; 10235000=02001510= + END 10240000=02001530= + ELSE 10245000=02001530= + BEGIN 10250000=02001530= + COMMENT IT IS NOT HERE; 10255000=02001530= + TALLY:= 1; 10260000=02001540= + LOOK:= TALLY; 10265000=02001540= + GO TO EXIT; 10270000=02001550= + END; 10275000=02001560= + GO TO LOOP; 10280000=02001563= + END; 10285000=02001565= + SI:= SI:= LGTH; 10290000=02001568= + SI:= SI+4; 10295000=02001568= + COMMENT POSITION TO NEXT ID.; 10300000=02001568= + END; 10305000=02001570= + GO TO LOOP; 10310000=02001580= +EXIT: 10315000=02001590= + ; 10320000=02001590= + END LOOK; 10325000=02001600= +%***********************************************************************10330000=02001605= +% 10335000=02001610= +% MISCELLANEOUS CROSS REFERENCE PROCEDURES 10340000=02001615= +% 10345000=02001620= +%***********************************************************************10350000=02001630= +% 10355000=02001635= + PROCEDURE CROSSREFIT(INDEX, SEQNO, REFTYPE); 10360000=02001640= + VALUE 10365000=02001645= + INDEX, 10370000=02001645= + SEQNO, 10375000=02001645= + REFTYPE; 10380000=02001645= + REAL 10385000=02001650= + INDEX, 10390000=02001650= + SEQNO, 10395000=02001650= + REFTYPE; 10400000=02001650= + BEGIN 10405000=02001655= + IF XREFINFO[INDEX].IDNOF ^= 0 THEN % SAVE 10410000=02001660= + BEGIN 10415000=02001665= + IF XREFPT > 29 THEN % NO SLOTS LEFT IN ARRAY, WRITE IT OUT. 10420000=02001670= + BEGIN 10425000=02001675= + WRITE(DSK2, 30, XREFAY2[**]); 10430000=02001680= + XREFPT:= 0; 10435000=02001685= + END; 10440000=02001690= + XREFAY2[XREFPT]:= SEQNO & REFTYPE TYPEREF & XREFINFO[INDEX] 10445000=02001700= + REFIDNOF; 10450000=02001700= + XREFPT:= XREFPT+1;% EVEN THOUGH THE ARRAY MAY BE FULL NOW WE 10455000=02001705= + % CANT WRITE IT OUT BECAUSE SOME ROUTINES 10460000=02001710= + % WILL LOOK BACK AT THE ENTRY WE JUST PUT 10465000=02001715= + % IN AND FIX IT UP. 10470000=02001720= + END; 10475000=02001725= + END OF CROSSREFIT; 10480000=02001730= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10485000=02001730= +% 10490000=02001735= + PROCEDURE CROSSREFDUMP(INDEX); 10495000=02001740= + VALUE 10500000=02001745= + INDEX; 10505000=02001745= + REAL 10510000=02001750= + INDEX; 10515000=02001750= + BEGIN 10520000=02001755= + STREAM PROCEDURE MOVEREFINFO(S, D, N); 10525000=02001760= + VALUE 10530000=02001765= + N; 10535000=02001765= + BEGIN 10540000=02001770= + SI:= D; 10545000=02001775= + DI:= D; 10550000=02001775= + DS:= 8 LIT 6" "; 10555000=02001775= + DS:= 7 WDS; % BLANK RECORD 10560000=02001775= + SI:= S; 10565000=02001780= + SI:= SI+3; 10570000=02001780= + DI:= D; 10575000=02001780= + DS:= N CHR; % MOVE IDENTIFIER 10580000=02001780= + END OF MOVEXREFINFO; 10585000=02001785= + % 10590000=02001790= + IF XREFINFO[INDEX].IDNOF ^= 0 THEN % DUMP IT 10595000=02001795= + BEGIN 10600000=02001800= + MOVEXREFINFO(INFO[INDEX.LINKR, INDEX.LINKC+1], XREFAY1[**], 10605000=02001810= + TAKE(INDEX+1).[12:6]); 10610000=02001810= + XREFAY1[8]:= XREFINFO[INDEX]; 10615000=02001815= + XREFAY1[9]:= TAKE(INDEX); % ELBAT WORD 10620000=02001820= + WRITE(DSK1, 10, XREFAY1[**]); 10625000=02001821= + XREFINFO[INDEX]:= 0; 10630000=02001822= + END; 10635000=02001825= + END OF CROSSREFDUMP; 10640000=02001830= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10645000=02001830= + REAL 10650000=02001831= + STREAM PROCEDURE CONV(ACCUM, SKP, N); 10655000=02001831= + VALUE 10660000=02001831= + SKP, 10665000=02001831= + N; 10670000=02001831= + BEGIN 10675000=02001832= + SI:= ACCUM; 10680000=02001833= + SI:= SI+SKP; 10685000=02001833= + SI:= SI+3; 10690000=02001833= + DI:= LOC CONV; 10695000=02001833= + DS:= N OCT 10700000=02001834= + END CONV; 10705000=02001834= + 10710000=02001836= +COMMENT OCTIZE REFORMATS ACCUM FOR OCTAL CONSTANTS; 10715000=02001836= + BOOLEAN 10720000=02001838= + STREAM PROCEDURE OCTIZE(S, D, SKP, CNT); 10725000=02001838= + VALUE 10730000=02001838= + SKP, 10735000=02001838= + CNT; 10740000=02001838= + BEGIN 10745000=02001840= + SI:= S; 10750000=02001842= + SI:= SI+3; 10755000=02001842= + DI:= D; 10760000=02001842= + SK(DS:= 3 RESET); % RIGHT JUSTIFY. 10765000=02001842= + CNT(IF SC >= 6"8" THEN TALLY:= 1 ELSE IF SC < 6"0" THEN TALLY:= 1; 10770000=02001846= + SKIP 3 SB;3(IF SB THEN DS:= SET ELSE DS:= RESET;SKIP SB)); 10775000=02001846= +% 10780000=02001848= +% 10785000=02001850= + OCTIZE:= TALLY;% "1" = NON OCTAL CHARACTER. 10790000=02001852= + END OCTIZE; 10795000=02001854= + 10800000=02001856= +COMMENT HEXIZE REFORMATS ACCUM FOR HEXADECIMAL CONSTANTS; 10805000=02001856= + BOOLEAN 10810000=02001858= + STREAM PROCEDURE HEXIZE(S, D, SKP, CNT); 10815000=02001858= + VALUE 10820000=02001858= + SKP, 10825000=02001858= + CNT; 10830000=02001858= + BEGIN 10835000=02001860= + LOCAL T1, T2, TEMP2, TEMP1; 10840000=02001860= + LABEL 10845000=02001860= + AGIN; 10850000=02001860= + 10855000=02001862= +COMMENT LOCAL VARIABLES ARE LOCATED IN REVERSE ORDER FROM THE 10860000=02001862= + WAY THEY ARE DECLARED IN STREAM PROCEDURES; 10865000=02001864= + DI:= LOC TEMP1; 10870000=02001866= + CNT(DS:= LIT 6"1"); % IN CASE A CHAR=A,B,C,D,OR F. 10875000=02001866= + SI:= S; 10880000=02001868= + SI:= SI+3; 10885000=02001868= + DI:= LOC TEMP1; % WE MAY OVERFLOW INTO TEMP2. 10890000=02001868= + CNT(IF SC < 6"0" THEN IF SC >= 6"A" THEN IF SC <= 6"F" THEN 10895000=02001870= + % WORK HARD. 10900000=02001870= + BEGINT1:= SI;T2:= DI;DI:= T1;SI:= T2; % FLIP, MAN. 10905000=02001874= + DS:= 3 RESET;SI:= T1;DI:= T2; % FLIP BACK. 10910000=02001876= + DS:= 1 ADD;DI:= DI-1;SKIP 2 DB;DS:= 1 SET;SKIP 3 DB;GO AGIN; 10915000=02001882= + END; 10920000=02001882= + IF SC < 6"0" THEN 10925000=02001884= + TALLY:= 1; 10930000=02001884= + DS:= CHR; % < 0 = NON-HEX CHARACTER. 10935000=02001884= +AGIN: 10940000=02001888= + ); 10945000=02001888= + SI:= LOC TEMP1; 10950000=02001890= + DI:= D; 10955000=02001890= + SKP(DS:= 4 RESET); % RIGHT ADJUST CONSTANT. 10960000=02001890= + CNT(SKIP 2 SB;4(IF SB THEN DS:= SET ELSE DS:= RESET;SKIP SB)); 10965000=02001894= + % FINAL CONVERT. 10970000=02001894= + HEXIZE:= TALLY;% "1" IF PROGRAMMER GOOFED. 10975000=02001896= + END HEXIZE; 10980000=02001898= + 10985000=02002000= +COMMENT PUTSEQNO PUTS THE SEQUENCE NUMBER OF THE CARD-IMAGE 10990000=02002000= + CURRENTLY BEING SCANNED INTO THE INFO TABLE IN CASE 10995000=02003000= + IT IS NEEDED FOR FUTURE REFERENCE; 11000000=02004000= + STREAM PROCEDURE PUTSEQNO(INFO, LCR); 11005000=02005000= + VALUE 11010000=02005000= + LCR; 11015000=02005000= + BEGIN 11020000=02006000= + DI:= INFO; 11025000=02006000= + SI:= LCR; 11030000=02006000= + DS:= WDS; 11035000=02006000= + END PUTSEQNO; 11040000=02006000= + 11045000=02007000= +COMMENT TURNONSTOPLIGHT TURNS THE LIGHT "RED" ON THE "CORNER". 11050000=02007000= + I.E., THE PURPOSE OF THIS ROUTINE IS TO INSERT A PER- 11055000=02008000= + CENT SIGN IN COLUMN 73 AS AN END OF CARD SENTINEL FOR 11060000=02009000= + THE SCANNER; 11065000=02010000= + STREAM PROCEDURE TURNONSTOPLIGHT(RED, CORNER); 11070000=02011000= + VALUE 11075000=02011000= + RED, 11080000=02011000= + CORNER; 11085000=02011000= + BEGIN 11090000=02012000= + DI:= CORNER; 11095000=02012000= + SI:= LOC CORNER; 11100000=02012000= + SI:= SI-1; 11105000=02012000= + DS:= CHR 11110000=02012000= + END; 11115000=02012000= + COMMENT ADDER COMPUTES SEQUENCE NUMBERS FOR LIBRARY FUNCTIONS. 11120000=02013010= + IT WILL EITHER ADD THE NUMBER IN SUM TO THE NUMBER IS SEQLOC STORING 11125000=02013020= + THE RESULT IN SEQLOC OR SUBTRACT THE NUMBER IN SUM FROM THE 11130000=02013030= + NUMBER IN SEQLOC AND STORE THE RESULT IN SEQLOC,DEPENDING ON THE 11135000=02013040= + VARIABLE AD; 11140000=02013050= + STREAM PROCEDURE ADDER(SUM, SEQLOC, AD, DESCRP); 11145000=02013060= + VALUE 11150000=02013065= + AD, 11155000=02013065= + DESCRP; 11160000=02013065= + BEGIN 11165000=02013070= + LOCAL HOLD, ZONEP; 11170000=02013073= + DI:= LOC ZONEP; 11175000=02013074= + SI:= SUM; 11180000=02013074= + DS:= 8 ZON; 11185000=02013074= + COMMENT SAVED ZONE PART OF THE SEQ.NO.; 11190000=02013075= + DI:= SUM; 11195000=02013076= + DI:= DI+7; 11200000=02013076= + DS:= 2 RESET; 11205000=02013076= + COMMENT HAVE ZEROED OUT SIGN VALUE OF SEQ.NO.; 11210000=02013077= + SI:= LOC DESCRP; 11215000=02013078= + SI:= SI+7; 11220000=02013078= + IF SC = 6"1" THEN 11225000=02013080= + BEGIN 11230000=02013080= + DI:= LOC HOLD; 11235000=02013080= + SI:= SEQLOC; 11240000=02013080= + DS:= WDS; 11245000=02013085= + DI:= HOLD; 11250000=02013085= + END 11255000=02013090= + ELSE 11260000=02013090= + DI:= SEQLOC; 11265000=02013090= + COMMENT DI IS NOW POINTING TO THE SEQNUMBER; 11270000=02013091= + HOLD:= DI; 11275000=02013095= + DI:= DI+7; 11280000=02013095= + DS:= 2 RESET; 11285000=02013095= + DI:= HOLD; 11290000=02013095= + SI:= LOC AD; 11295000=02013100= + SI:= SI+7; 11300000=02013110= + IF SC = 6"1" THEN 11305000=02013120= + BEGIN 11310000=02013120= + SI:= SUM; 11315000=02013120= + DS:= 8 ADD; 11320000=02013120= + END 11325000=02013130= + ELSE 11330000=02013130= + BEGIN 11335000=02013130= + SI:= SUM; 11340000=02013130= + DS:= 8 SUB; 11345000=02013130= + END; 11350000=02013130= + SI:= LOC ZONEP; 11355000=02013135= + DI:= HOLD; 11360000=02013135= + DS:= 8 ZON; 11365000=02013135= + SI:= LOC ZONEP; 11370000=02013136= + DI:= SUM; 11375000=02013136= + DS:= 8 ZON; 11380000=02013136= + COMMENT MOVE IN ZONE PORTION TO RESULT SEQ.NO.; 11385000=02013137= + END ADDER; 11390000=02013140= + 11395000=02013150= +COMMENT SEARCHLIB IS RESPONSIBLE FOR SEARCHING THE LIBRARY TAPES FOR 11400000=02013150= +COMPILABLE QUANTITIES. THE PARAMETER INDICATES THAT WE ARE ENTERING 11405000=02013155= +A LIBRARY CALL IF TRUE, ELSE WE ARE EXITING.; 11410000=02013160= + PROCEDURE SEARCHLIB(DOLLAR); 11415000=02013165= + VALUE 11420000=02013165= + DOLLAR; 11425000=02013165= + BOOLEAN 11430000=02013165= + DOLLAR; 11435000=02013165= + BEGIN 11440000=02013170= + LABEL 11445000=02013175= + EXIT, 11450000=02013175= + EXITOUT, 11455000=02013175= + NOPARTIAL; 11460000=02013175= + PROCEDURE FLAGIT(N); 11465000=02013176= + VALUE 11470000=02013176= + N; 11475000=02013176= + INTEGER 11480000=02013176= + N; 11485000=02013176= + BEGIN 11490000=02013177= + BOOLEAN 11495000=02013178= + TL, 11500000=02013178= + TS; 11505000=02013178= + TL:= LISTOG; 11510000=02013179= + TS:= SINGLTOG; 11515000=02013179= + LISTOG:= FALSE; 11520000=02013179= + SINGLTOG:= FALSE; 11525000=02013179= + Q:= ACCUM[1]; 11530000=02013180= + FLAG(N); 11535000=02013180= + LISTOG:= TL; 11540000=02013181= + SINGLTOG:= TS; 11545000=02013181= + END FLAGIT; 11550000=02013183= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%11555000=02013183= + IF DOLLAR THEN 11560000=02013184= + BEGIN 11565000=02013190= + COMMENT WE ARE ON A DOUBLE DOLLAR CARD; 11570000=02013190= + RESULT:= COUNT:= ACCUM[1]:= 0; 11575000=02013195= + SCANNER; 11580000=02013195= + RESULT:= COUNT:= ACCUM[1]:= 0; 11585000=02013200= + SCANNER; 11590000=02013200= + IF ACCUM[1] > 6"1+0000" AND ACCUM[1] < 6"1D0000" THEN 11595000=02013205= + FILEINX:= ACCUM[1].[21:3] 11600000=02013210= + ELSE 11605000=02013210= + BEGIN 11610000=02013210= + COMMENT ERROR 500 - ILLEGAL LIBRARY NAME; 11615000=02013219= + FLAGIT(500); 11620000=02013222= + GO EXIT; 11625000=02013222= + END; 11630000=02013225= + FILEINX:= FILEINX-1; 11635000=02013230= + IF DIRECTORY[GT1:= 3*FILEINX, 0] = 0 THEN 11640000=02013235= + BEGIN 11645000=02013240= + COMMENT MUST READ DIRECTORY; 11650000=02013240= + GT3:= MKABS(LIBRARY[FILEINX](0)); 11655000=02013245= + MOVE(56, LIBRARY[FILEINX](0), DIRECTORY[GT1, 0]); 11660000=02013250= + GT2:= DIRECTORY[GT1, 0]; 11665000=02013255= + DIRECTORY[FILEINX*3, 0]:= -2; 11670000=02013255= + WHILE GT2:= GT2-1 > 0 DO 11675000=02013260= + BEGIN 11680000=02013265= + READ(LIBRARY[FILEINX]); 11685000=02013270= + MOVE(56, LIBRARY[FILEINX](0), DIRECTORY[GT1:= GT1+1, 0]); 11690000=02013275= + END; 11695000=02013280= + END; 11700000=02013285= + RESULT:= ACCUM[1]:= COUNT:= 0; 11705000=02013290= + SCANNER; 11710000=02013290= + COMMENT GET THE PROD.ID.; 11715000=02013290= + IF LOOK(ACCUM[1], DIRECTORY, 3*FILEINX, GT1, GT2) THEN 11720000=02013295= + BEGIN 11725000=02013300= + COMMENT ERROR 501 - ITEM NOT IN DIRECTORY; 11730000=02013300= + FLAGIT(501); 11735000=02013305= + GO EXIT; 11740000=02013305= + END; 11745000=02013310= + WHILE LCR.[33:15]-NCR.[33:15] ^= 1 OR NCR.[30:3] ^= 7 DO 11750000=02013315= + BEGIN 11755000=02013315= + IF EXAMIN(NCR) = 6"[" THEN 11760000=02013317= + GO TO EXITOUT; 11765000=02013317= + RESULT:= 5; 11770000=02013318= + SCANNER; 11775000=02013318= + END; 11780000=02013319= + GO TO NOPARTIAL; 11785000=02013320= + EXITOUT: 11790000=02013325= + BEGIN 11795000=02013325= + COMMENT WE HAVE A PARTIAL LIBRARY OPERATION; 11800000=02013325= + RESULT:= ACCUM[1]:= COUNT:= 0; 11805000=02013330= + SCANNER; 11810000=02013330= + COMMENT SPACE PAST "[" ;11815000=02013330= + RESULT:= ACCUM[1]:= COUNT:= 0; 11820000=02013335= + SCANNER; 11825000=02013335= + COMMENT GET START POINT;11830000=02013335= + IF RESULT ^= 3 THEN 11835000=02013340= + BEGIN 11840000=02013345= + COMMENT ERROR 502 - IMPROPER START POINT; 11845000=02013345= + FLAGIT(502); 11850000=02013350= + GO EXIT; 11855000=02013350= + END; 11860000=02013355= + GT1:= GT1+CONV(ACCUM[1], 0, ACCUM[1].[12:6])-1; 11865000=02013360= + RESULT:= ACCUM[1]:= COUNT:= 0; 11870000=02013365= + SCANNER; 11875000=02013365= + IF RESULT ^= 2 THEN 11880000=02013370= + BEGIN 11885000=02013375= + COMMENT ERROR 503 - NO SEPARATOR; 11890000=02013375= + FLAGIT(503); 11895000=02013380= + GO EXIT; 11900000=02013380= + END; 11905000=02013385= + RESULT:= ACCUM[1]:= COUNT:= 0; 11910000=02013390= + SCANNER; 11915000=02013390= + COMMENT GET LENGTH; 11920000=02013390= + IF RESULT ^= 3 THEN 11925000=02013395= + BEGIN 11930000=02013400= + COMMENT ERROR 504 - IMPROPER LENGTH; 11935000=02013400= + FLAGIT(504); 11940000=02013405= + GO EXIT; 11945000=02013405= + END; 11950000=02013410= + GT2:= GT1+CONV(ACCUM[1], 0, ACCUM[1].[12:6]); 11955000=02013415= + RESULT:= ACCUM[1]:= COUNT:= 0; 11960000=02013420= + SCANNER; 11965000=02013420= + IF ACCUM[1] ^= 6"1]0000" THEN 11970000=02013425= + BEGIN 11975000=02013430= + COMMENT ERROR 505 - NO RIGHT BRACKET; 11980000=02013430= + FLAGIT(505); 11985000=02013435= + GO EXIT; 11990000=02013435= + END; 11995000=02013440= + WHILE LCR.[33:15]-NCR.[33:15] ^= 1 OR NCR.[30:3] ^= 7 DO 12000000=02013446= + BEGIN 12005000=02013446= + RESULT:= 5; 12010000=02013446= + SCANNER 12015000=02013446= + END; 12020000=02013446= + END; 12025000=02013450= + NOPARTIAL: COMMENT NOW SET UP THE LINKS; 12030000=02013475= + 12035000=02013480= + LIBARRAY[LIBINDEX].LSTUSD:= LASTUSED; 12040000=02013480= + LIBARRAY[LIBINDEX].FILEINDEX:= FILEINX; 12045000=02013490= + LIBARRAY[LIBINDEX].STOPPOINT:= FINISHPT; 12050000=02013495= + LIBARRAY[LIBINDEX].NEXTENTRY:= RECOUNT-1; 12055000=02013497= + FINISHPT:= GT2; 12060000=02013500= + IF LIBINDEX > 0 THEN 12065000=02013505= + DIRECTORY[(LIBARRAY[LIBINDEX-3].FILEINDEX)*3, 0]:= RECOUNT-1; 12070000=02013510= + RECOUNT:= GT1; 12075000=02013515= + IF EXAMIN(LCR) ^= 6"%" THEN 12080000=02013516= + PUTSEQNO(INFO[LASTSEQROW, LASTSEQUENCE], LCR); 12085000=02013517= + MOVE(1, INFO[LASTSEQROW, LASTSEQUENCE], LIBARRAY[LIBINDEX+1]); 12090000=02013520= + MOVE(1, INFO[LASTSEQROW, LASTSEQUENCE], SEQSUM); 12095000=02013525= + IF LASTUSED <= 2 OR LASTUSED = 5 THEN 12100000=02013526= + GTI1:= 0 12105000=02013527= + ELSE 12110000=02013527= + IF MAXLTLCR.[33:15]-NCR.[33:15] < 11 THEN 12115000=02013527= + GTI1:= MKABS(LIBRARY[FILEINX](0)) 12120000=02013528= + ELSE 12125000=02013528= + GTI1:= (NCR+2).[33:15]; 12130000=02013528= + LIBARRAY[LIBINDEX+2], NCRLINK:= GTI1.[33:15]; 12135000=02013530= + COMMENT GTI1=NCR; 12140000=02013530= + IF LASTUSED <= 2 OR LASTUSED = 5 THEN 12145000=02013533= + LIBARRAY[LIBINDEX+2].LCRLINK:= 0 12150000=02013534= + ELSE 12155000=02013534= + LIBARRAY[LIBINDEX+2].LCRLINK:= GTI1.[33:15]+10; 12160000=02013535= + IF LIBINDEX > 0 THEN 12165000=02013536= + IF CARDCALL THEN 12170000=02013536= + BEGIN 12175000=02013536= + LASTUSED:= 5; 12180000=02013537= + LIBARRAY[LIBINDEX].NEXTENTRY:= LIBARRAY[LIBINDEX].NEXTENTRY-1;12185000=02013538= + END 12190000=02013539= + ELSE 12195000=02013539= + BEGIN 12200000=02013539= + LASTUSED:= 6; 12205000=02013540= + FIRSTIMEX:= TRUE; 12210000=02013540= + END 12215000=02013541= + ELSE 12220000=02013541= + BEGIN 12225000=02013541= + IF LASTUSED = 3 THEN 12230000=02013541= + FIRSTIMEX:= TRUE; 12235000=02013541= + LASTUSED:= 5; 12240000=02013541= + END; 12245000=02013541= + LIBINDEX:= LIBINDEX+3; 12250000=02013542= + END 12255000=02013555= + ELSE 12260000=02013555= + BEGIN 12265000=02013555= + COMMENT WE DID NOT COME FROM DOUBLE DOLLAR SO UNLINK; 12270000=02013555= + LIBINDEX:= LIBINDEX-3; 12275000=02013560= + RECOUNT:= RECOUNT-1; 12280000=02013563= + LASTUSED:= LIBARRAY[LIBINDEX].LSTUSD; 12285000=02013565= + IF LASTUSED = 1 THEN 12290000=02013566= + MEDIUM:= 6"C "; 12295000=02013566= + IF LIBINDEX > 0 THEN 12300000=02013567= + BEGIN 12305000=02013567= + GTI1:= LIBARRAY[LIBINDEX].NEXTENTRY; 12310000=02013567= + DIRECTORY[FILEINX*3, 0]:= RECOUNT; 12315000=02013568= + RECOUNT:= GTI1+2; 12320000=02013568= + END 12325000=02013570= + ELSE 12330000=02013570= + DIRECTORY[FILEINX*3, 0]:= RECOUNT; 12335000=02013570= + IF LIBINDEX > 0 THEN 12340000=02013575= + FILEINX:= LIBARRAY[LIBINDEX-3].FILEINDEX; 12345000=02013580= + FINISHPT:= LIBARRAY[LIBINDEX].STOPPOINT; 12350000=02013600= + IF LIBINDEX ^= 0 THEN 12355000=02013610= + MOVE(1, LIBARRAY[LIBINDEX-3+1], SEQSUM); 12360000=02013615= + IF LASTUSED <= 2 OR LASTUSED = 5 THEN 12365000=02013617= + LCR:= MKABS(CBUFF[0]) 12370000=02013617= + ELSE 12375000=02013617= + NCR:= LIBARRAY[LIBINDEX+2].NCRLINK; 12380000=02013620= + IF LASTUSED <= 2 OR LASTUSED = 5 THEN 12385000=02013621= + LCR:= MKABS(CBUFF[9]) 12390000=02013621= + ELSE 12395000=02013621= + LCR:= LIBARRAY[LIBINDEX+2].LCRLINK; 12400000=02013625= + NORELEASE:= TRUE; 12405000=02013627= + IF LASTUSED = 6 THEN 12410000=02013628= + FIRSTIMEX:= TRUE; 12415000=02013628= + END OF UNLINK; 12420000=02013630= + IF LIBINDEX = 0 THEN 12425000=02013635= + BEGIN 12430000=02013640= + COMMENT GOING BACK TO OUTSIDE WORLD; 12435000=02013640= + SEQSUM:= 0; 12440000=02013645= + END 12445000=02013660= + ELSE 12450000=02013660= + BEGIN 12455000=02013660= + GT1:= (GTI1:= (DIRECTORY[FILEINX*3, 0]+3)/5)*5+1; 12460000=02013665= + GT2:= (GTI1:= (RECOUNT-3)/5)*5+1; 12465000=02013670= + GT3:= (GT2-GT1) DIV 5; 12470000=02013675= + SPACE(LIBRARY[FILEINX], GT3); 12475000=02013680= + READ(LIBRARY[FILEINX]); 12480000=02013685= + MOVE(1, LIBRARY[FILEINX](0), GTI1); 12485000=02013697= + IF GTI1 ^= GT2 AND GTI1 ^= 0 THEN 12490000=02013699= + BEGIN 12495000=02013701= + COMMENT ERROR 507 MEANS TAPE POSITIONING ERROR; 12500000=02013701= + FLAG(507); 12505000=02013702= + GO TO EXIT; 12510000=02013702= + END; 12515000=02013703= + LTLCR:= MKABS(LIBRARY[FILEINX](10))+ 12520000=02013705= + (GTI1:= (((RECOUNT-1) MOD 5)*11)); 12525000=02013705= + MAXLTLCR:= MKABS(LIBRARY[FILEINX](0))+54; 12530000=02013710= + ADDER(SEQSUM, LTLCR, TRUE, TRUE); 12535000=02013713= + IF LASTUSED = 6 THEN 12540000=02013714= + BEGIN 12545000=02013714= + NCR:= LCR:= MKABS(LIBRARY[FILEINX](0)); 12550000=02013715= + PUTSEQNO(GT1, LCR); 12555000=02013716= + TURNONSTOPLIGHT(6"%", LCR); 12560000=02013717= + END; 12565000=02013718= + END; 12570000=02013718= +EXIT: 12575000=02013720= + END SEARCHLIB; 12580000=02013720= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%12585000=02013720= + COMMENT WRITNEW TRANSFERS THE CARD IMAGE TO THE NEWTAPE BUFFER 12590000=02014000= + AND REPORTS IF THE CARD MIGHT BE CONTROL CARD; 12595000=02015000= + BOOLEAN 12600000=02016000= + STREAM PROCEDURE WRITNEW(NEW, FCR); 12605000=02016000= + VALUE 12610000=02016000= + FCR; 12615000=02016000= + BEGIN 12620000=02017000= + SI:= FCR; 12625000=02017000= + IF SC ^= 6"$" THEN 12630000=02017000= + TALLY:= 1; 12635000=02017000= + DI:= NEW; 12640000=02018000= + DS:= 10 WDS; 12645000=02018000= + WRITNEW:= TALLY 12650000=02019000= + END WRITNEW; 12655000=02019000= + 12660000=02061000= +COMMENT EQUAL COMPARES COUNT CHARACTERS LOCATED AT A AND B FOR 12665000=02061000= + EQUALITY. THIS ROUTINE IS USED IN THE LOOK-UP OF ALPHA 12670000=02061500= + QUANTITIES IN THE DIRECTORY; 12675000=02062000= + BOOLEAN 12680000=02062500= + STREAM PROCEDURE EQUAL(COUNT, A, B); 12685000=02062500= + VALUE 12690000=02062500= + COUNT; 12695000=02062500= + BEGIN 12700000=02063000= + TALLY:= 1; 12705000=02063500= + SI:= A; 12710000=02063500= + DI:= B; 12715000=02063500= + IF COUNT SC = DC THEN 12720000=02064000= + EQUAL:= TALLY 12725000=02064500= + END EQUAL; 12730000=02064500= + PROCEDURE READACARD; 12735000=02065000= + FORWARD; 12740000=02065000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%12745000=02065000= + PROCEDURE DOLLARCARD; 12750000=02065500= + FORWARD; 12755000=02065500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%12760000=02065500= + BOOLEAN PROCEDURE BOOLEXP; 12765000=02065600= + FORWARD; 12770000=02065600= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%12775000=02065600= + PROCEDURE SCANNER; 12780000=02066000= + BEGIN 12785000=02066500= + 12790000=02067000= +COMMENT "SCAN" IS THE STREAM PROCEDURE WHICH DOES THE ACTUAL SCANNING. 12795000=02067000= + IT IS DRIVEN BY A SMALL WORD MODE PROCEDURE CALLED "SCANNER". 12800000=02067500= + WHICH CHECKS FOR A QUANTITY BEING BROKEN ACROSS A CARD. "SCAN" 12805000=02068000= + IS CONTROLLED BY A VARIABLE CALLED "RESULT". "SCAN" ALSO 12810000=02068500= + INFORMS THE WORLD OF ITS ACTION BY MEANS OF THE SAME VARIABLE. 12815000=02069000= + HENCE THE VARIABLE "RESULT" IS PASSED BY BOTH NAME AND VALUE. 12820000=02069500= + THE MEANING OF "RESULT" AS INPUT IS: 12825000=02070000= + VALUE MEANING 12830000=02070500= + ===== ========================================= 12835000=02071000= + 0 INITIAL CODE - DEBLANK AND START TO FETCH THE 12840000=02071500= + NEXT QUANTITY. 12845000=02072000= + 1 CONTINUE BUILDING AN IDENTIFIER (INTERRUPTED BY 12850000=02072500= + END-OF-CARD BREAK). 12855000=02073000= + 2 LAST QUANTITY BUILT WAS SPECIAL CHARACTER. HENCE, 12860000=02073500= + EXIT (INTERRUPTION BY END-OF-CARD BREAK IS NOT 12865000=02074000= + IMPORTANT). 12870000=02074500= + 3 CONTINUE BUILDING A NUMBER (INTERRUPTED BY END-OF- 12875000=02075000= + CARD BREAK). 12880000=02075500= + 4 LAST THING WAS AN ERROR (COUNT EXCEEDED 63). HENCE,12885000=02076000= + EXIT (INTERRUPTION BY END-OF-CARD BREAK NOT 12890000=02076500= + IMPORTANT). 12895000=02077000= + 5 GET NEXT CHARACTER AND EXIT. 12900000=02077500= + 6 SCAN A COMMENT. 12905000=02078000= + 7 DEBLANK ONLY. 12910000=02078500= + THE MEANING OF "RESULT" AS OUTPUT IS: 12915000=02079000= + VALUE MEANING 12920000=02079500= + ===== ======================================= 12925000=02080000= + 1 AN IDENTIFIER WAS BUILT. 12930000=02080500= + 2 A SPECIAL CHARACTER WAS OBTAINED. 12935000=02081000= + 3 A NUMBER (INTEGER) WAS BUILT. 12940000=02081500= + "SCAN" PUTS ALL STUFF SCANNED (EXCEPT FOR COMMENTS AND 12945000=02082000= + DISCARDED BLANKS) INTO "ACCUM" (CALLED "ACCUMULATOR" 12950000=02082500= + FOR THE REST OF THIS DISCUSSION). 12955000=02083000= + "COUNT" IS THE VARIABLE THAT GIVES THE NUMBER OF CHARACTERS 12960000=02083500= + "SCAN" HAS PUT INTO THE "ACCUMULATOR". SINCE "SCAN" NEEDS 12965000=02084000= + THE VALUE SO THAT IT CAN PUT MORE CHARACTERS INTO THE "ACCUM- 12970000=02084500= + ULATOR" AND NEEDS TO UPDATE "COUNT" FOR THE OUTSIDE WORLD. 12975000=02085000= + "COUNT" IS PASSED BY BOTH NAME AND VALUE. IT IS ALSO 12980000=02085500= + CONVENIENT TO HAVE (63-COUNT). THIS IS CALLED "COMCOUNT". 12985000=02086000= + "NCR" (NEXT CHARACTER TO BE SCANNED) IS ALSO PASSED BY 12990000=02086500= + NAME AND VALUE SO THAT IT MAY BE UPDATED. 12995000=02087000= + "ST1" AND "ST2" ARE TEMPORARY STORAGES WHICH ARE EXPLICITLY 13000000=02087500= + PASSED TO "SCAN" IN ORDER TO OBTAIN THE MOST USEFULL STACK 13005000=02088000= + ARRANGEMENT. 13010000=02088500= + ; 13015000=02089000= + STREAM PROCEDURE SCAN(NCR, COUNTV, ACCUM, COMCOUNT, RESULT, 13020000=02090000= + RESULTV, COUNT, ST2, NCRV, ST1); 13025000=02090000= + VALUE 13030000=02090500= + COUNTV, 13035000=02090500= + COMCOUNT, 13040000=02090500= + RESULTV, 13045000=02090500= + ST2, 13050000=02090500= + NCRV, 13055000=02090500= + ST1; 13060000=02090500= + BEGIN 13065000=02091000= + LABEL 13070000=02091500= + DEBLANK, 13075000=02091500= + NUMBERS, 13080000=02091500= + IDBLDR, 13085000=02091500= + GNC, 13090000=02091500= + K, 13095000=02091500= + EXIT, 13100000=02091500= + FINIS, 13105000=02091500= + L, 13110000=02091500= + ERROR, 13115000=02092000= + COMMENTS, 13120000=02092000= + COMMANTS; 13125000=02092000= + DI:= RESULT; 13130000=02092500= + DI:= DI+7; 13135000=02092500= + SI:= NCRV; 13140000=02092500= + 13145000=02093000= +COMMENT SETUP "DI" FOR A CHANGE IN "RESULT" AND "SI" FOR A LOOK AT 13150000=02093000= + THE BUFFER; 13155000=02093500= + CI:= CI+RESULTV; % SWITCH ON VALUE OF RESULT; 13160000=02094000= + GO DEBLANK; % 0 IS INITIAL CODE. 13165000=02094500= + GO IDBLDR; % 1 IS ID CODE. 13170000=02095000= + GO FINIS; % 2 IS SPECIAL CHARACTER CODE. 13175000=02095500= + GO NUMBERS; % 3 IS NUMBER CODE. 13180000=02096000= + GO FINIS; % 4 IS ERROR CODE. 13185000=02096500= + GO GNC; % 5 IS GET NEXT CHARACTER CODE. 13190000=02097000= + GO COMMANTS; % 6 IS COMMENT CODE. 13195000=02097500= + % 7 IS DEBLANK ONLY CODE. 13200000=02098000= + IF SC = 6" " THEN 13205000=02098500= + K: 13210000=02099000= + BEGIN 13215000=02099000= + SI:= SI+1; 13220000=02099000= + IF SC = 6" " THEN 13225000=02099000= + GO K 13230000=02099000= + END; 13235000=02099000= + GO FINIS; 13240000=02099500= + DEBLANK: 13245000=02100500= + IF SC = 6" " THEN 13250000=02100500= + L: 13255000=02101000= + BEGIN 13260000=02101000= + SI:= SI+1; 13265000=02101000= + IF SC = 6" " THEN 13270000=02101000= + GO L 13275000=02101000= + END; 13280000=02101000= + 13285000=02101500= +COMMENT IF WE ARRIVE HERE WE HAVE A NON-BLANK CHARACTER; 13290000=02101500= + NCRV:= SI; 13295000=02102000= + IF SC >= 6"0" THEN 13300000=02102500= + GO NUMBERS; 13305000=02102500= + IF SC = ALPHA THEN 13310000=02103000= + GO IDBLDR; 13315000=02103000= + 13320000=02103500= +COMMENT IF WE ARRIVE HERE WE HAVE A SPECIAL CHARACTER (OR GNC); 13325000=02103500= + GNC: 13330000=02104500= + DS:= LIT 6"2"; 13335000=02104500= + TALLY:= 1; 13340000=02104500= + SI:= SI+1; 13345000=02104500= + GO EXIT; 13350000=02104500= + COMMANTS: 13355000=02105500= + IF SC ^= 6";" THEN 13360000=02105500= + BEGIN 13365000=02106000= + COMMENTS: 13370000=02107000= + SI:= SI+1; 13375000=02107000= + IF SC > 6"%" THEN 13380000=02107500= + GO COMMENTS; 13385000=02107500= + IF SC < 6";" THEN 13390000=02108000= + GO COMMENTS; 13395000=02108000= + 13400000=02108500= +COMMENT CHARACTERS BETWEEN % AND SEMICOLON ARE HANDLED BY WORD- 13405000=02108500= + MODE PART OF COMMENT ROUTINE; 13410000=02109000= + END; 13415000=02109500= + GO FINIS; 13420000=02110000= + IDBLDR: 13425000=02111000= + TALLY:= 63; 13430000=02111000= + DS:= LIT 6"1"; 13435000=02111000= + COMCOUNT(TALLY:= TALLY+1;IF SC = ALPHA THEN SI:= SI+1 ELSE JUMP 13440000=02112000= + OUT TO EXIT); 13445000=02112000= + TALLY:= TALLY+1; 13450000=02112500= + IF SC = ALPHA THEN 13455000=02113000= + BEGIN 13460000=02113500= + ERROR: 13465000=02114500= + DI:= DI-1; 13470000=02114500= + DS:= LIT 6"4"; 13475000=02114500= + GO EXIT; 13480000=02114500= + END 13485000=02115500= + ELSE 13490000=02115500= + GO EXIT; 13495000=02115500= + 13500000=02116000= +COMMENT IF WE ARRIVE AT ERROR WE HAVE MORE THAN 63 CHARACTERS 13505000=02116000= + IN AN IDENTIFIER OR NUMBER; 13510000=02116500= + NUMBERS: 13515000=02117500= + TALLY:= 63; 13520000=02117500= + DS:= LIT 6"3"; 13525000=02117500= + COMCOUNT 13530000=02118500= + (TALLY:= TALLY+1;IF SC < 6"0" THEN JUMP OUT TO EXIT;SI:= SI+1); 13535000=02118500= + GO ERROR; 13540000=02119000= + EXIT: 13545000=02120000= + ST1:= TALLY; % "ST1" CONTAINS THE NUMBER OF CHARACTERS WE ARE 13550000=02120000= + % GOING TO MOVE INTO THE "ACCUMULATOR". 13555000=02120500= + TALLY:= TALLY+COUNTV; 13560000=02121000= + ST2:= TALLY; 13565000=02121000= + DI:= COUNT; 13570000=02121500= + SI:= LOC ST2; 13575000=02121500= + DS:= WDS; 13580000=02121500= + 13585000=02122000= +COMMENT THIS CODE UPDATED "COUNT'; 13590000=02122000= + DI:= ACCUM; 13595000=02122500= + SI:= SI-3; 13600000=02122500= + DS:= 3 CHR; 13605000=02122500= + 13610000=02123000= +COMMENT THIS CODE PLACES "COUNT" IN "ACCUM" AS WELL; 13615000=02123000= + DI:= DI+COUNTV; % POSITION "DI" PAST CHARACTERS ALREADY 13620000=02123500= + % IN THE "ACCUMULATOR", IF ANY. 13625000=02124000= + SI:= NCRV; 13630000=02124500= + DS:= ST1 CHR; 13635000=02124500= + 13640000=02125000= +COMMENT MOVE CHARACTERS INTO "ACCUM"; 13645000=02125000= + FINIS: 13650000=02126000= + DI:= NCR; 13655000=02126000= + ST1:= SI; 13660000=02126000= + SI:= LOC ST1; 13665000=02126000= + DS:= WDS; 13670000=02126000= + 13675000=02126500= +COMMENT RESET "NCR" TO LOCATION OF NEXT CHARACTER TO BE SCANNED; 13680000=02126500= + END OF SCAN; 13685000=02127000= + LABEL 13690000=02127500= + L; % 13695000=02127500= +L: SCAN(NCR, COUNT, ACCUM[1], 63-COUNT, RESULT, RESULT, COUNT, 0 13700000=02129000= + , NCR, 0); 13705000=02129000= + IF NCR = LCR THEN 13710000=02129500= + BEGIN 13715000=02130000= + READACARD; 13720000=02130500= + IF LIBINDEX ^= 0 THEN 13725000=02131500= + IF RECOUNT = FINISHPT THEN 13730000=02132000= + BEGIN 13735000=02132500= + SEARCHLIB(FALSE); 13740000=02133000= + READACARD; 13745000=02133500= + NORELEASE:= FALSE; 13750000=02134000= + END; 13755000=02134500= + GO TO L; % GO DIRECTLY TO L, DO NOT PASS GO. 13760000=02135500= + % DO NOT COLLECT $200. 13765000=02136000= + END; 13770000=02136500= + END SCANNER; 13775000=02137000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%13780000=02137000= + DEFINE 13785000=02181000= + WRITELINE = IF SINGLTOG THEN 13790000=02181000= + WRITE(LINE, 15, LIN[**]) 13795000=02181250= + ELSE 13800000=02181250= + WRITE(LINE[DBL], 15, LIN[**]) #, 13805000=02181500= + MAKCAST = BEGIN 13810000=02181500= + CARDCALL:= 13815000=02181750= + IF LASTUSED = 5 THEN 13820000=02181750= + TRUE 13825000=02181750= + ELSE 13830000=02181750= + FALSE; 13835000=02181750= + SEARCHLIB(TRUE); 13840000=02182000= + END #, 13845000=02182500= + PRINTCARD = BEGIN 13850000=02182500= + EDITLINE(LIN, FCR, L.[36:10], SGNO, L.[45:2], 13855000=02182760= + MEDIUM, OMITTING); 13860000=02182760= + IF NOHEADING THEN 13865000=02183000= + DATIME; 13870000=02183000= + WRITELINE; 13875000=02183000= + END #; 13880000=02183250= + STREAM PROCEDURE EDITLINE(LINE, NGR, R, S, L, SYMBOL, OMIT); 13885000=02183500= + VALUE 13890000=02183750= + NCR, 13895000=02183750= + R, 13900000=02183750= + S, 13905000=02183750= + L, 13910000=02183750= + SYMBOL, 13915000=02183750= + OMIT; 13920000=02183750= + BEGIN 13925000=02184000= + DI:= LINE; 13930000=02184250= + DS:= 16 LIT 6" "; 13935000=02184250= + SI:= NCR; 13940000=02184500= + DS:= 9 WDS; 13945000=02184500= + DS:= 8 LIT 6" "; 13950000=02184750= + DS:= WDS; % SEQUENCE NUMBER. 13955000=02185000= + DS:= LIT 6" "; 13960000=02185250= + SI:= LOC SYMBOL; 13965000=02185250= + SI:= SI+6; 13970000=02185250= + DS:= 2 CHR; 13975000=02185500= + DS:= LIT 6" "; 13980000=02185500= + SI:= LOC R; 13985000=02185750= + SI:= SI+4; 13990000=02185750= + IF SC = 6" " THEN 13995000=02186000= + DS:= 12 LIT 6" " 14000000=02186000= + ELSE 14005000=02186000= + BEGIN 14010000=02186250= + SI:= LOC S; 14015000=02186300= + DS:= 4 DEC; 14020000=02186300= + DS:= LIT 6":"; 14025000=02186300= + SI:= LOC R; 14030000=02186400= + DS:= 4 DEC; 14035000=02186400= + DS:= LIT 6":"; 14040000=02186400= + SI:= LOC L; 14045000=02186500= + DS:= 1 DEC; 14050000=02186500= + DS:= LIT 6" "; 14055000=02186500= + END; 14060000=02186600= + OMIT(DI:= DI-12;DS:= 12 LIT 6" :OMIT: ";DI:= LINE;DS:= 8 LIT 14065000=02186760= + 6" :OMIT:"); 14070000=02186760= + END EDITLINE; 14075000=02187000= + 14080000=02187250= +COMMENT COMPARE COMPARES SEQUENCE NUMBERS OF TAPE AND CARD. IF 14085000=02187250= + TAPE IS SMALLER THEN RESULT = 0 ELSE IF CARD IS SMALLER 14090000=02187500= + RESULT = 1 ELSE RESULT = 2; 14095000=02187750= + REAL 14100000=02188000= + STREAM PROCEDURE COMPARE(TAPE, CARD); 14105000=02188000= + VALUE 14110000=02188000= + TAPE, 14115000=02188000= + CARD; 14120000=02188000= + BEGIN 14125000=02188250= + SI:= TAPE; 14130000=02188500= + DI:= CARD; 14135000=02188500= + IF 8 SC >= DC THEN 14140000=02188750= + BEGIN 14145000=02189000= + SI:= SI-8; 14150000=02189250= + DI:= DI-8; 14155000=02189250= + TALLY:= 1; 14160000=02189250= + IF 8 SC = DC THEN 14165000=02189500= + TALLY:= 2 14170000=02189750= + END; 14175000=02189750= + COMPARE:= TALLY; 14180000=02190000= + END COMPARE; 14185000=02190250= + PROCEDURE OUTPUTSOURCE; 14190000=02190500= + BEGIN 14195000=02190750= + LABEL 14200000=02191000= + LCARD, 14205000=02191000= + LTAPE, 14210000=02191000= + AWAY; 14215000=02191000= + SWITCH 14220000=02191250= + SW:= LCARD, 14225000=02191250= + LCARD, 14230000=02191250= + LTAPE, 14235000=02191250= + AWAY, 14240000=02191250= + LCARD, 14245000=02191250= + LTAPE; 14250000=02191250= + IF SEQTOG THEN % RESEQUENCING. 14255000=02191500= + BEGIN 14260000=02191750= + IF TOTALNO = -10 OR NEWBASE THEN 14265000=02192000= + BEGIN 14270000=02192250= + NEWBASE:= FALSE; 14275000=02192500= + GTI1:= TOTALNO:= BASENUM 14280000=02192750= + END 14285000=02193000= + ELSE 14290000=02193000= + GTI1:= TOTALNO:= TOTALNO+ADDVALUE; 14295000=02193000= + CHANGESEQ(GTI1, LCR); 14300000=02193250= + END; 14305000=02193500= + IF NEWTOG THEN 14310000=02193750= + IF INSERTDEPTH > 0 AND INSERTCOP = 1 OR INSERTDEPTH = 0 THEN 14315000=02193800= + IF WRITNEW(LIN, FCR) THEN 14320000=02194000= + WRITF(NEWTAPE, 10, LIN[**]); 14325000=02194000= + IF OMITTING THEN 14330000=02194250= + IF NOT LISTATOG THEN 14335000=02194250= + GO AWAY; 14340000=02194250= + GO SW[LASTUSED]; 14345000=02194500= +LCARD: 14350000=02195000= + IF LISTER OR LISTPTOG THEN 14355000=02195000= + PRINTCARD; 14360000=02195000= + GO AWAY; 14365000=02195250= +LTAPE: 14370000=02195750= + IF LISTER THEN 14375000=02195750= + PRINTCARD; 14380000=02195750= +% GO AWAY; 14385000=02196000= +AWAY: 14390000=02196500= + END OUTPUTSOURCE; 14395000=02196500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%14400000=02196500= + PROCEDURE BEGINPRINT; 14405000=02196510= + BEGIN 14410000=02196520= + STREAM PROCEDURE STUFF(N, L); 14415000=02196530= + VALUE 14420000=02196530= + N; 14425000=02196530= + BEGIN 14430000=02196540= + DI:= L; 14435000=02196550= + DS:= 8 LIT 6" "; 14440000=02196550= + SI:= L; 14445000=02196550= + DS:= 13 WDS; 14450000=02196550= + SI:= LOC N; 14455000=02196560= + DS:= 8 DEC; 14460000=02196560= + END; 14465000=02196570= + STUFF(BEGINSTACK[BSPOINT], LIN); 14470000=02196580= + IF NOHEADING THEN 14475000=02196590= + DATIME; 14480000=02196590= + WRITELINE; 14485000=02196590= + END BEGINPRINT; 14490000=02196610= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%14495000=02196610= + PROCEDURE READACARD; 14500000=02196750= + 14505000=02197000= +COMMENT READACARD READS CARDS FROM EITHER THE CARD READER OR THE 14510000=02197000= + TAPE MERGING AS REQUESTED AND CREATING A NEW TAPE AND 14515000=02197250= + LISTING IF REQUESTED. READACARD ALSO INSERTS A PERCENT 14520000=02197500= + SIGN AS AN END OF CARD SENTINEL IN COLUMN 73 AND SETS 14525000=02197750= + FCR,NCR,LCR,TLCR, AND CLCR; 14530000=02198000= + BEGIN 14535000=02198250= + PROCEDURE READTAPE(LCR, MAXLCR, LIB); 14540000=02198500= + VALUE 14545000=02198500= + LIB; 14550000=02198500= + BOOLEAN 14555000=02198500= + LIB; 14560000=02198500= + REAL 14565000=02198750= + LCR, 14570000=02198750= + MAXLCR; 14575000=02198750= + BEGIN 14580000=02198755= + LABEL 14585000=02198760= + ENDREADTAPE, 14590000=02198760= + EOFT; 14595000=02198760= + IF LIB THEN 14600000=02199000= + BEGIN 14605000=02199250= + RECOUNT:= RECOUNT+1; 14610000=02199500= + IF LCR:= LCR+11 > MAXLCR THEN 14615000=02199750= + BEGIN 14620000=02200000= + READ(LIBRARY, FILEINX); 14625000=02200250= + MAXLCR:= 46+LCR:= MKABS(LIBRARY[FILEINX](0))+10; 14630000=02200500= + END; 14635000=02200750= + ADDER(SEQSUM, LCR, TRUE, TRUE); 14640000=02201000= + END 14645000=02201500= + ELSE 14650000=02201500= + BEGIN 14655000=02201500= + READ(TAPE, 10, TBUFF[**])[EOFT]; 14660000=02201750= + MAXLCR:= LCR:= MKABS(TBUFF[9]); 14665000=02202000= + GO TO ENDREADTAPE; 14670000=02202010= + EOFT: 14675000=02202030= + DEFINEARRAY[25]:= 6"ND;END."&6"E"[1:43:5]; 14680000=02202030= + DEFINEARRAY[34]:= 6"9999"&6"9999"[1:25:23]; 14685000=02202040= + TLCR:= MKABS(DEFINEARRAY[34]); 14690000=02202050= + PUTSEQNO(DEFINEARRAY[33], TLCR-8); 14695000=02202060= + TURNONSTOPLIGHT(6"%", TLCR-8); 14700000=02202070= + ENDREADTAPE: 14705000=02202090= + END; 14710000=02202090= + END READTAPE; 14715000=02202250= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%14720000=02202250= + PROCEDURE SEQCOMPARE(TLCR, CLCR, LIB); 14725000=02202500= + VALUE 14730000=02202500= + LIB; 14735000=02202500= + BOOLEAN 14740000=02202500= + LIB; 14745000=02202500= + REAL 14750000=02202750= + TLCR, 14755000=02202750= + CLCR; 14760000=02202750= + BEGIN 14765000=02203000= + MEDIUM:= 6"C "; % CARD READER. 14770000=02203250= + IF GT1:= COMPARE(TLCR, CLCR) = 0 THEN% TAPE HAS LOW SEQUENCE NUMB14775000=02203500= + BEGIN 14780000=02203750= + LCR:= TLCR; 14785000=02204000= + LASTUSED:= 14790000=02204000= + IF LIB THEN 14795000=02204000= + 6 14800000=02204000= + ELSE 14805000=02204000= + 3; 14810000=02204000= + MEDIUM:= 14815000=02204250= + IF LIB THEN 14820000=02204250= + 6"CA"+FILEINX 14825000=02204250= + ELSE 14830000=02204250= + 6"T "; %CA,CB,CC,OR T.14835000=02204250= + END 14840000=02204750= + ELSE 14845000=02204750= + BEGIN 14850000=02204750= + IF GT1 ^= 1 THEN % TAPE AND CARD HAVE SAME SEQ 14855000=02205000= + BEGIN 14860000=02205250= + MEDIUM:= 6"P "; % CARD PATCHES TAPE. 14865000=02205500= + IF LIB THEN 14870000=02207750= + IF FINISHPT-RECOUNT = 1 THEN 14875000=02207750= + LASTCRDPATCH:= TRUE 14880000=02208000= + ELSE 14885000=02208000= + READTAPE(LTLCR, MAXLTLCR, TRUE) 14890000=02208250= + ELSE 14895000=02208250= + READTAPE(TLCR, MAXTLCR, FALSE); 14900000=02208500= + END; 14905000=02208750= + LCR:= CLCR; 14910000=02209000= + LASTUSED:= 14915000=02209250= + IF LIB THEN 14920000=02209250= + 5 14925000=02209250= + ELSE 14930000=02209250= + 2; 14935000=02209250= + END; 14940000=02209500= + END OF SEQCOMPARE; 14945000=02209750= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%14950000=02209750= + LABEL 14955000=02210000= + CARDONLY, 14960000=02210000= + CARDLAST, 14965000=02210000= + TAPELAST, 14970000=02210000= + EXIT, 14975000=02210000= + FIRSTTIME, 14980000=02210250= + EOF, 14985000=02210250= + USETHESWITCH, 14990000=02210500= + COMPAR, 14995000=02210500= + XIT, 15000000=02210500= + LIBEND, 15005000=02210500= + LIBTLAST, 15010000=02210500= + LIBCLAST; 15015000=02210500= + LABEL 15020000=02210600= + COPYLIB, 15025000=02210600= + COPYEOF; 15030000=02210600= + SWITCH 15035000=02210750= + USESWITCH:= CARDONLY, 15040000=02210750= + CARDLAST, 15045000=02210750= + TAPELAST, 15050000=02210750= + FIRSTTIME, 15055000=02211000= + LIBCLAST, 15060000=02211000= + LIBTLAST, 15065000=02211000= + COPYLIB; 15070000=02211000= + BOOLEAN 15075000=02211250= + DOLLAR2TOG; 15080000=02211250= + IF ERRORCOUNT >= ERRMAX THEN 15085000=02211500= + ERR(611); % ERR LIMIT EXCEEDED - STOP. 15090000=02211500= +USETHESWITCH: 15095000=02212000= + GO TO USESWITCH[LASTUSED]; 15100000=02212000= + MOVE(1, TEXT[LASTUSED.LINKR, LASTUSED.LINKC], 15105000=02212500= + DEFINEARRAY[DEFINEINDEX-2]); 15110000=02212500= + LASTUSED:= LASTUSED+1; 15115000=02212750= + NCR:= LCR-1; 15120000=02213000= + GO TO XIT; 15125000=02213250= +FIRSTTIME: 15130000=02213750= + READ(CARD, 10, CBUFF[**]); 15135000=02213750= + FCR:= NCR:= (LCR:= MKABS(CBUFF[9]))-9; 15140000=02214000= + MEDIUM:= 6"C "; 15145000=02214100= + IF EXAMIN(FCR) ^= 6"$" AND LISTER THEN 15150000=02214200= + PRINTCARD; 15155000=02214200= + PUTSEQNO(INFO[LASTSEQROW, LASTSEQENCE], LCR); 15160000=02214250= + CARDNUMBER:= CONV(INFO[LASTSEQROW, LASTSEQUENCE-1], 5, 8); 15165000=02214260= + TURNONSTOPLIGHT(6"%", LCR); 15170000=02214500= + GO XIT; 15175000=02214750= + 15180000=02215000= +COMMENT WE HAVE JUST INITIALIZED CARD INPUT; 15185000=02215000= +CARDONLY: 15190000=02215500= + IF NORELEASE THEN 15195000=02215500= + GO TO EXIT; 15200000=02215500= + READ(CARD, 10, CBUFF[**]); 15205000=02215500= + LCR:= MKABS(CBUFF[9]); 15210000=02215750= + GO EXIT; 15215000=02215750= +CARDLAST: 15220000=02216250= + IF NORELEASE THEN 15225000=02216250= + GO TO EXIT; 15230000=02216250= + READ(CARD, 10, CBUFF[**])[EOF]; 15235000=02216250= + CLCR:= MKABS(CBUFF[9]); 15240000=02216500= + GO COMPAR; 15245000=02216750= +EOF: 15250000=02217250= + DEFINEARRAY[25]:= 6"ND;END."&6"E"[1:43:5]; 15255000=02217250= + DEFINEARRAY[34]:= 6"9999"&6"9999"[1:25:23]; 15260000=02217500= + CLCR:= MKABS(DEFINEARRAY[34]); 15265000=02217750= + PUTSEQNO(DEFINEARRAY[33], CLCR-8); 15270000=02218000= + TURNONSTOPLIGHT(6"%", CLCR-8); 15275000=02218250= +% 15280000=02218400= + GO COMPAR; 15285000=02218500= + 15290000=02218750= +COMMENT THIS RELEASES THE PREVIOUS CARD FROM THE CARD READER AND 15295000=02218750= + SETS UP CLCR; 15300000=02219000= +TAPELAST: 15305000=02219500= + READTAPE(TLCR, MAXTLCR, FALSE); 15310000=02219500= + GO TO COMPAR; 15315000=02219500= + 15320000=02219750= +COMMENT THIS RELEASES THE PREVIOUS CARD FROM TAPE AND SETS UP TLCR; 15325000=02219750= +LIBCLAST: 15330000=02220250= + IF FIRSTIMEX THEN 15335000=02220250= + BEGIN 15340000=02220500= + FIRSTIMEX:= FALSE; 15345000=02220500= + GO COMPAR 15350000=02220500= + END; 15355000=02220500= + READ(CARD, 10, CBUFF[**])[EOF]; 15360000=02220750= + CLCR:= MKABS(CBUFF[9]); 15365000=02221000= + IF LASTCRDPATCH THEN 15370000=02221250= + BEGIN 15375000=02221500= + LASTCRDPATCH:= FALSE; 15380000=02221750= + RECOUNT:= RECOUNT+1; 15385000=02222000= + GO TO XIT 15390000=02222500= + END; 15395000=02222500= + GO TO COMPAR; 15400000=02222750= +LIBTLAST: 15405000=02223250= + IF FIRSTIMEX THEN 15410000=02223250= + BEGIN 15415000=02223500= + FIRSTIMEX:= FALSE; 15420000=02223500= + GO TO COMPAR 15425000=02223500= + END; 15430000=02223500= + READTAPE(LTLCR, MAXLTLCR, TRUE); 15435000=02223750= + IF RECOUNT = FINISHPT THEN 15440000=02224000= + GO TO XIT; 15445000=02224000= + GO COMPAR; 15450000=02224010= +COPYLIB: 15455000=02224030= + READ(LF[INSERTINX:= INSERTINX+1], 10, LBUFF[**])[COPYEOF]; 15460000=02224030= + READ SEEK(LF[INSERTINX+1]); 15465000=02224032= + IF (CMPD(INSERTSEQ, LBUFF[9]) = 0) THEN 15470000=02224040= + GO COPYEOF; 15475000=02224040= + LCR:= MKABS(LBUFF[9]); 15480000=02224050= + GO TO EXIT; 15485000=02224060= +COPYEOF: 15490000=02224080= + CLOSE(LF, RELEASE); 15495000=02224080= + IF ((INSERTDEPTH:= INSERTDEPTH-1) = 0) THEN 15500000=02224090= + BEGIN 15505000=02224100= + LASTUSED:= SAVECARD; 15510000=02224100= + MEDIUM:= MEDIUM.[24:12]; 15515000=02224100= + GO USETHESWITCH; 15520000=02224102= + END; 15525000=02224104= + FILL LF WITH INSERTMID, INSERTFID; 15530000=02224110= + GO COPYLIB; 15535000=02224120= +COMPAR: 15540000=02224500= + IF LASTUSED = 2 OR LASTUSED = 3 THEN 15545000=02224500= + SEQCOMPARE(TLCR, CLCR, FALSE) 15550000=02224750= + ELSE 15555000=02224750= + SEQCOMPARE(LTLCR, CLCR, TRUE); 15560000=02224750= +EXIT: 15565000=02225250= + NCR:= FCR:= LCR-9; 15570000=02225250= + 15575000=02225500= +COMMENT SETS UP NCR AND FCR; 15580000=02225500= + IF CHECKTOG AND EXAMIN(FCR) ^= 6"$" THEN %$=CARDS DON"T COUNT. 15585000=02225750= + IF COMPARE(MKABS(INFO[LASTSEQROW, LASTSEQUENCE]), LCR) = 1 THEN 15590000=02226000= + IF SEQERRTOG THEN 15595000=02226250= + BEGIN 15600000=02226250= + FLAG(610); 15605000=02226250= + NUMSEQUENCEERRORS:= NUMSEQUENCEERRORS+1; 15610000=02226300= + END 15615000=02226500= + ELSE 15620000=02226500= + BEGIN % SEQUENCE WARNING 15625000=02226500= + BLANKET(14, LIN); 15630000=02226750= + SEQUENCEWARNING(LIN[13]); 15635000=02227000= + IF NOHEADING THEN 15640000=02227250= + DATIME; 15645000=02227250= + WRITELINE; 15650000=02227250= + IF NOT LISTER THEN 15655000=02227500= + PRINTCARD; 15660000=02227500= + NUMSEQUENCEERRORS:= NUMSEQUENCEERRORS+1; 15665000=02227600= + END; 15670000=02227750= + IF EXAMIN(FCR) = 6"$" THEN 15675000=02228250= + BEGIN 15680000=02228500= + IF LISTPTOG OR PRINTDOLLARTOG THEN 15685000=02228750= + PRINTCARD; 15690000=02228750= + IF EXAMIN(NCR:= NCR+32768) = 6"$" THEN 15695000=02229000= + MAKCAST 15700000=02229000= + ELSE 15705000=02229000= + DOLLARCARD; 15710000=02229000= + NORELEASE:= FALSE; 15715000=02229100= + 15720000=02229250= +COMMENT DONT FORGET THAT NCR IS NOT WORD MODE, BUT CHAR. MODE POINTER; 15725000=02229250= + GO USETHESWITCH; 15730000=02229500= + END; 15735000=02229750= + IF EXAMIN(FCR) = 6" " THEN 15740000=02230000= + IF DOLLAR2TOG:= EXAMIN(FCR+32768) = 6"$" THEN 15745000=02230100= + BEGIN 15750000=02230250= + OUTPUTSOURCE; 15755000=02230500= + IF EXAMIN(NCR:= NCR+65536) = 6"$" THEN 15760000=02230750= + MAKCAST 15765000=02230750= + ELSE 15770000=02230750= + DOLLARCARD; 15775000=02231000= + END; 15780000=02231250= + IF VOIDING OR VOIDTAPE THEN 15785000=02231500= + BEGIN 15790000=02231750= + IF COMPARE(LCR, VOIDCR) = 0 THEN 15795000=02232000= + BEGIN 15800000=02232250= + IF VOIDTAPE AND LASTUSED = 3 OR NOT VOIDTAPE THEN 15805000=02232500= + GO USETHESWITCH; 15810000=02232750= + END 15815000=02233250= + ELSE 15820000=02233250= + BEGIN 15825000=02233250= + VOIDCR:= VOIDPLACE:= 0; 15830000=02233500= + VOIDING:= FALSE; 15835000=02233750= + VOIDTAPE:= FALSE 15840000=02234000= + END; 15845000=02234000= + END; 15850000=02234250= + CARDCOUNT:= CARDCOUNT+1; 15855000=02234500= + IF DOLLAR2TOG THEN 15860000=02234600= + BEGIN 15865000=02234650= + DOLLAR2TOG:= NORELEASE:= FALSE; 15870000=02234650= + GO USETHESWITCH; 15875000=02234650= + END; 15880000=02234650= + PUTSEQNO(INFO[LASTSEQROW, LASTSEQUENCE], LCR); 15885000=02234750= + CARDNUMBER:= 15890000=02234800= + IF SEQTOG THEN 15895000=02234800= + TOTALNO+ADDVALUE 15900000=02234800= + ELSE 15905000=02234800= + CONV(INFO[LASTSEQROW, LASTSEQUENCE-1], 5, 8); 15910000=02234900= + OUTPUTSOURCE; 15915000=02235000= + IF OMITTING THEN 15920000=02235250= + GO USETHESWITCH; 15925000=02235250= +% 15930000=02235500= + TURNONSTOPLIGHT(6"%", LCR); 15935000=02235750= + IF BUILDLINE THEN 15940000=02236000= + IF LASTADDRESS ^= (LASTADDRESS:= L.[36:10]) THEN 15945000=02236250= + BEGIN 15950000=02236500= + ENILSPOT:= LASTADDRESS & CARDNUMBER[10:20:28]; 15955000=02236750= + IF(ENILPTR:= ENILPTR+1) >= 1023 THEN 15960000=02237000= + BEGIN 15965000=02237250= + FLAG(80); 15970000=02237250= + ENILPTR:= 512; 15975000=02237250= + END; 15980000=02237250= + END; 15985000=02237500= +XIT: 15990000=02238000= + END READACARD; 15995000=02238000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%16000000=02238000= + PROCEDURE INCLUDECARD; 16005000=02238100= + BEGIN 16010000=02238110= + REAL 16015000=02238112= + V; 16020000=02238112= + LABEL 16025000=02238120= + EEXIT, 16030000=02238120= + AGAIN, 16035000=02238120= + GETEM, 16040000=02238120= + EOF, 16045000=02238120= + EXIT, 16050000=02238120= + DONTSCAN; 16055000=02238120= + REAL 16060000=02238130= + STREAM PROCEDURE SCNN(A, B); 16065000=02238130= + VALUE 16070000=02238130= + B; 16075000=02238130= + BEGIN 16080000=02238140= + SI:= A; 16085000=02238150= + DI:= LOC SCNN; 16090000=02238150= + DS:= 8 LIT 6"0 "; 16095000=02238150= + DI:= DI-7; 16100000=02238160= + SI:= SI+3; 16105000=02238160= + DS:= B CHR; 16110000=02238160= + END; 16115000=02238170= + STREAM PROCEDURE MVE(A, B, C, D); 16120000=02238180= + VALUE 16125000=02238180= + B, 16130000=02238180= + C; 16135000=02238180= + BEGIN 16140000=02238190= + SI:= A; 16145000=02238200= + SI:= SI+3; 16150000=02238200= + DI:= D; 16155000=02238200= + C(DS:= LIT 6"0"); 16160000=02238200= + DS:= B CHR; 16165000=02238200= + END; 16170000=02238210= + STREAM PROCEDURE MVEWD(A, B); 16175000=02238212= + VALUE 16180000=02238212= + A; 16185000=02238212= + BEGIN 16190000=02238214= + SI:= A; 16195000=02238214= + DI:= B; 16200000=02238214= + DS:= 10 WDS; 16205000=02238214= + END; 16210000=02238214= + DEFINE 16215000=02238220= + SKAN = BEGIN 16220000=02238220= + COUNT:= RESULT:= ACCUM[0]:= 0; 16225000=02238230= + SCANNER; 16230000=02238240= + V:= SCNN(ACCUM[1], MIN(COUNT, 7)); 16235000=02238250= + END #; 16240000=02238260= + DEFINE 16245000=02238270= + ERR(ERR1) = BEGIN 16250000=02238270= + FLAG(ERR1); 16255000=02238270= + GO TO EEXIT; 16260000=02238270= + END #; 16265000=02238270= + IF ((INSERTDEPTH:= INSERTDEPTH+1) > INSERTMAX) THEN 16270000=02238280= + ERR(612); 16275000=02238280= + INSERTMID:= INSERTFID:= INSERTINX:= INSERTCOP:= 0; 16280000=02238290= + INSERTSEQ:= 6"9999"&6"9999"[1:23]; 16285000=02238300= +AGAIN: 16290000=02238340= + SKAN; 16295000=02238340= +DONTSCAN: 16300000=02238350= + IF V = 6"% " THEN 16305000=02238350= + GO GETEM; 16310000=02238350= + IF V = 6"/ " THEN 16315000=02238360= + GO AGAIN; 16320000=02238360= + IF RESULT = 3 THEN % SEQ RANGE 16325000=02238370= + BEGIN 16330000=02238380= + MVE(ACCUM[1], COUNT:= MIN(COUNT, 8), 8-COUNT, INSERTINX); 16335000=02238385= + SKAN; 16340000=02238390= + IF V = 6"- " THEN 16345000=02238400= + BEGIN 16350000=02238410= + SKAN; 16355000=02238420= + IF RESULT ^= 3 THEN 16360000=02238430= + ERR(614); 16365000=02238430= + MVE(ACCUM[1], COUNT:= MIN(COUNT, 8), 8-COUNT, INSERTSEQ); 16370000=02238440= + END 16375000=02238450= + ELSE 16380000=02238450= + GO TO DONTSCAN; 16385000=02238450= + GO AGAIN; 16390000=02238460= + END; % SEQ RANGE 16395000=02238470= + IF V = 6"+ " THEN % WE HAVE COPY FORM 16400000=02238480= + BEGIN 16405000=02238490= + SKAN; 16410000=02238500= + IF V = 6"COPY " THEN 16415000=02238510= + IF EXAMIN(LCR-9) = 6"$" THEN 16420000=02238512= + INSERTCOP:= INSERTINFO[INSERTDEPTH-1, 4] 16425000=02238520= + ELSE 16430000=02238520= + ERR(617) 16435000=02238522= + ELSE 16440000=02238522= + ERR(616); 16445000=02238522= + GO AGAIN; 16450000=02238530= + END; 16455000=02238540= + IF INSERTMID = 0 THEN 16460000=02238550= + INSERTMID:= V 16465000=02238552= + ELSE 16470000=02238552= + IF INSERTFID = 0 THEN 16475000=02238552= + INSERTFID:= V 16480000=02238552= + ELSE 16485000=02238552= + ERR(616); 16490000=02238552= + GO AGAIN; 16495000=02238555= +GETEM: 16500000=02238570= + IF NOT BOOLEAN(INSERTCOP) AND NEWTOG THEN 16505000=02238570= + IF EXAMIN(FCR) = 6"$" THEN % ONLY IF "$" IS IN COLUMN ONE 16510000=02238572= + IF BOOLEAN(INSERTINFO[INSERTDEPTH-1, 4]) THEN 16515000=02238574= + % ONLY IF LAST HAD COPY16520000=02238574= + BEGIN 16525000=02238580= + MVEWD(FCR, LBUFF[0]); 16530000=02238580= + PUTSEQNO(LBUFF[9], MKABS(INFO[LASTSEQROW, LASTSEQUENCE])); 16535000=02238582= + WRITE(NEWTAPE, 10, LBUFF[**]); 16540000=02238590= + END; 16545000=02238600= + IF INSERTMID = 0 THEN 16550000=02238602= + ERR(613); 16555000=02238602= + IF INSERTFID = 0 THEN 16560000=02238610= + INSERTFID:= TIME(-1); 16565000=02238610= + IF INSERTFID = 0 THEN 16570000=02238620= + BEGIN 16575000=02238630= + INSERTFID:= INSERTMID; 16580000=02238630= + INSERTMID:= 0; 16585000=02238630= + END; 16590000=02238630= + IF INSERTDEPTH > 1 THEN 16595000=02238640= + CLOSE(LF, RELEASE); 16600000=02238640= + FILL LF WITH INSERTMID, INSERTFID; 16605000=02238650= + READ(LF[0], 10, LBUFF[**])[EEXIT];% DO THE FOLLOWING SO THAT 16610000=02238652= + INSERTMID:= LF.MFID; % IF THE OPERATOR IL-ED US 16615000=02238654= + INSERTFID:= LF.FID; % WE WILL HAVE THE PROPER NAMES. 16620000=02238656= + V:= -1; 16625000=02238658= + IF INSERTINX > 0 THEN 16630000=02238660= + BEGIN 16635000=02238670= + DO 16640000=02238680= + READ(LF[V:= V+1], 10, LBUFF[**])[EEXIT] 16645000=02238690= + UNTIL CMPD(INSERTINX, LBUFF[9]) <= 1; 16650000=02238690= + V:= V-1; 16655000=02238700= + END; 16660000=02238702= + INSERTINX:= V; 16665000=02238704= + IF INSERTDEPTH = 1 THEN 16670000=02238710= + BEGIN 16675000=02238720= + SAVECARD:= LASTUSED; 16680000=02238720= + LASTUSED:= 7; 16685000=02238720= + MEDIUM:= 6"L "&MEDIUM[24:12]; 16690000=02238720= + END; 16695000=02238730= + GO TO EXIT; 16700000=02238760= +EEXIT: 16705000=02238780= + IF ((INSERTDEPTH:= INSERTDEPTH-1) > 0) THEN 16710000=02238780= + BEGIN 16715000=02238790= + CLOSE(LF, RELEASE); 16720000=02238800= + FILL LF WITH INSERTMID, INSERTFID; 16725000=02238810= + END; 16730000=02238820= +EXIT: 16735000=02238832= + Q:= 6"1%0000"; 16740000=02238832= + END; 16745000=02238840= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%16750000=02238840= + REAL PROCEDURE CONVERT; 16755000=02248000= + BEGIN 16760000=02249000= + REAL 16765000=02249000= + T; 16770000=02249000= + INTEGER 16775000=02249000= + N; 16780000=02249000= + TL0:= 0; 16785000=02250000= + THI:= T:= CONV(ACCUM[1], TCOUNT, N:= (COUNT-TCOUNT) MOD 8); 16790000=02251000= + FOR N:= TCOUNT+N STEP 8 UNTIL COUNT-1 DO 16795000=02252000= + IF DPTOG THEN 16800000=02253000= + BEGIN 16805000=02254000= + DOUBLE(THI, TLO, 100000000.0, 0, *, CONV(ACCUM[1], N, 8), 0, 16810000=02256000= + +, := , THI, TLO); 16815000=02256000= + T:= THI; 16820000=02257000= + END 16825000=02259000= + ELSE 16830000=02259000= + T:= T*100000000+CONV(ACCUM[1], N, 8); 16835000=02259000= + CONVERT:= T; 16840000=02260000= + END; 16845000=02261000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%16850000=02261000= + REAL 16855000=02262000= + STREAM PROCEDURE FETCH(F); 16860000=02262000= + VALUE 16865000=02262000= + F; 16870000=02262000= + BEGIN 16875000=02263000= + SI:= F; 16880000=02263000= + SI:= SI-8; 16885000=02263000= + DI:= LOC FETCH; 16890000=02263000= + DS:= WDS 16895000=02263000= + END FETCH; 16900000=02263000= + PROCEDURE DUMPINFO; 16905000=02264000= + BEGIN 16910000=02264050= + ARRAY 16915000=02264100= + A[0:14]; 16920000=02264100= + INTEGER 16925000=02264100= + JEDEN, 16930000=02264100= + DWA; 16935000=02264100= + STREAM PROCEDURE OCTALWORDS(S, D, N); 16940000=02264400= + VALUE 16945000=02264400= + N; 16950000=02264400= + BEGIN 16955000=02264450= + SI:= S; 16960000=02264500= + DI:= D; 16965000=02264500= + N(2(8(DS:= 3 RESET;3 16970000=02264600= + (IF SB THEN DS:= 1 SET ELSE DS:= 1 RESET;SKIP 1 SB));DS:= 1 LIT 16975000=02264600= + 6" ");DS:= 2 LIT 6" "); 16980000=02264600= + END OF OCTALWORDS; 16985000=02264650= + STREAM PROCEDURE ALPHAWORDS(S, D, N); 16990000=02264700= + VALUE 16995000=02264700= + N; 17000000=02264700= + BEGIN 17005000=02264750= + SI:= S; 17010000=02264800= + DI:= D; 17015000=02264800= + N(2(4(DS:= 1 LIT 6" ";DS:= 1 CHR);DS:= 1 LIT 6" ");DS:= 2 LIT 6" "17020000=02264850= + ); 17025000=02264850= + END OF ALPHAWORDS; 17030000=02264900= + IF NOHEADING THEN 17035000=02264950= + DATIME; 17040000=02264950= + WRITE(LINE[DBL], < //6"ELBAT">); 17045000=02264950= + FOR JEDEN:= 0 STEP 6 UNTIL 71 DO 17050000=02265000= + BEGIN 17055000=02265050= + BLANKET(14, A); 17060000=02265100= + OCTALWORDS(ELBAT[JEDEN], A, 6); 17065000=02265100= + WRITE(LINE[DBL], 15, A[**]); 17070000=02265150= + END; 17075000=02265200= + BLANKET(14, A); 17080000=02265250= + OCTALWORDS(ELBAT[72], A, 4); 17085000=02265250= + WRITE(LINE[DBL], 15, A[**]); 17090000=02265300= + FOR JEDEN:= 0 STEP 1 UNTIL NEXTINFO DIV 256 DO 17095000=02265350= + BEGIN 17100000=02265400= + WRITE(LINE[DBL], < //6"INFO[", I2, 6",*]">, JEDEN); 17105000=02265450= + FOR DWA:= 0 STEP 6 UNTIL 251 DO 17110000=02265500= + BEGIN 17115000=02265550= + BLANKET(14, A); 17120000=02265600= + ALPHAWORDS(INFO[JEDEN, DWA], A, 6); 17125000=02265600= + WRITE(LINE, 15, A[**]); 17130000=02265650= + BLANKET(14, A); 17135000=02265700= + OCTALWORDS(INFO[JEDEN, DWA], A, 6); 17140000=02265700= + WRITE(LINE[DBL], 15, A[**]); 17145000=02265750= + END; 17150000=02265800= + BLANKET(14, A); 17155000=02265850= + ALPHAWORDS(INFO[JEDEN, 252], A, 4); 17160000=02265850= + WRITE(LINE, 15, A[**]); 17165000=02265900= + BLANKET(14, A); 17170000=02265950= + OCTALWORDS(INFO[JEDEN, 252], A, 4); 17175000=02265950= + WRITE(LINE[DBL], 15, A[**]); 17180000=02266000= + END; 17185000=02266050= + END OF DUMPINFO; 17190000=02266100= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%17195000=02266100= + DEFINE 17200000=02277000= + SKAN = BEGIN 17205000=02277000= + COUNT:= RESULT:= ACCUM[1]:= 0; 17210000=02278000= + SCANNER; 17215000=02279000= + Q:= ACCUM[1]; 17220000=02280000= + END #; 17225000=02281000= + 17230000=02282000= +COMMENT DOLLARCARD HANDLES THE COMPILER CONTROL CARDS. 17235000=02282000= + ALL COMPILER- AND USER-DEFINED OPTIONS ARE KEPT 17240000=02283000= + IN THE ARRAY "OPTIONS". 17245000=02284000= + EACH OPTION HAS A TWO-WORD ENTRY: 17250000=02285000= + 17255000=02286000= + WORD CONTAINS 17260000=02287000= + ---- -------- 17265000=02288000= + 1 ENTRY FROM ACCUM[1]: 00XZZZZ, WHERE 17270000=02289000= + X IS THE SIZE OF THE ID AND 17275000=02290000= + ZZZZZ IS THE FIRST FIVE CHARS OF THE ID. 17280000=02291000= + 2 PUSH-DOWN, 47-BIT STACK CONTAINING THE 17285000=02292000= + HISTORY OF THE SETTINGS OF THIS OPTION. 17290000=02293000= + 17295000=02294000= + IN "FINDOPTION", ALL COMPILER-DEFINED OPTIONS ARE USUALLY 17300000=02295000= + LOCATES BASED UPON A UNIQUE NUMBER ASSIGNED TO EACH. 17305000=02296000= + FOR ALL USER-DEFINED OPTIONS, A SEQUENTIAL TABLE SEARCH IS 17310000=02297000= + INITIATED USING "USEROPINX" AS THE INITIAL INDEX INTO THE 17315000=02298000= + "OPTIONS" ARRAY. IF THE NUMBER OF COMPILER-DEFINED OPTIONS 17320000=02299000= + IS CHANGED, THEN "USEROPINX" MUST BE ACCORDINGLY CHANGED. 17325000=02300000= + THE NUMBER OF USER DEFINED OPTIONS ALLOWED CAN BE 17330000=02301000= + CHANGED BY CHANGING THE DEFINE "OPARSIZE". 17335000=02302000= + THE VARIABLE "OPTIONWORD" CONTAINS THE CURRENT TRUE OR FALSE 17340000=02303000= + SETTING OF ALL THE COMPILER-DEFINED OPTIONS, ONE BIT PER 17345000=02304000= + OPTION. 17350000=02305000= + ; 17355000=02306000= + BOOLEAN PROCEDURE FINDOPTION(BIT); 17360000=02307000= + VALUE 17365000=02307000= + BIT; 17370000=02307000= + INTEGER 17375000=02307000= + BIT; 17380000=02307000= + BEGIN 17385000=02308000= + LABEL 17390000=02309000= + FOUND; 17395000=02309000= + REAL 17400000=02310000= + ID; 17405000=02310000= + OPINX:= 2*BIT-4; 17410000=02311000= + WHILE ID:= OPTIONS[OPINX:= OPINX+2] ^= D0 IF Q = ID THEN 17415000=02313000= + GO FOUND; 17420000=02313000= + ; 17425000=02313000= + OPTIONS[OPINX]:= Q; % NEW USER-DEFINED OPTION. 17430000=02314000= +FOUND: 17435000=02316000= + IF OPINX+1 > OPARSIZE THEN 17440000=02316000= + FLAG(602) 17445000=02316000= + ELSE % TOO MANY USER OPTIONS 17450000=02316000= + FINDOPTION:= BOOLEAN(OPTIONS[OPINX+1]); 17455000=02317000= + END FINDOPTION; 17460000=02318000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%17465000=02318000= + PROCEDURE DOLLARCARD; 17470000=02319000= + BEGIN 17475000=02320000= + PROCEDURE SWITCHIT(XBIT); 17480000=02321000= + VALUE 17485000=02321000= + XBIT; 17490000=02321000= + INTEGER 17495000=02321000= + XBIT; 17500000=02321000= + BEGIN 17505000=02322000= + BOOLEAN 17510000=02323000= + B, 17515000=02323000= + T; 17520000=02323000= + INTEGER 17525000=02324000= + SAVEINX; 17530000=02324000= + LABEL 17535000=02325000= + XMODE0, 17540000=02325000= + XMODE1, 17545000=02325000= + XMODE2, 17550000=02325000= + XMODE3, 17555000=02325000= + XMODE4, 17560000=02325000= + ALONG; 17565000=02325000= + SWITCH 17570000=02326000= + SW:= XMODE0, 17575000=02326000= + XMODE1, 17580000=02326000= + XMODE2, 17585000=02326000= + XMODE3, 17590000=02326000= + XMODE4; 17595000=02326000= + SETTING:= FINDOPTION(XBIT); 17600000=02327000= + SKAN; 17605000=02327000= + GO SW[XMODE+1]; 17610000=02328000= + XMODE0: 17615000=02329000= + % FIRST OPTION ON CARD, BUT NOT SET, RESET, OR POP. 17620000=02329000= + OPTIONWORD:= BOOLEAN(0); 17625000=02330000= + FOR SAVEINX:= 1 STEP 2 UNTIL OPARSIZE DO 17630000=02331000= + OPTIONS[SAVEINX]:= 0; 17635000=02331000= + IF BUILDLINE.[45:1] THEN 17640000=02331050= + BUILDLINE.[47:1]:= SEQXEQTOG:= FALSE; 17645000=02331060= + XMODE:= 1; 17650000=02332000= + IF LASTUSED < 5 AND LASTUSED ^= 3 THEN 17655000=02332000= + LASTUSED:= 1; 17660000=02332000= + XMODE1: 17665000=02333000= + % NOT FIRST OPTION AND NOT BEING SET, RESET, OR POPPED. 17670000=02333000= + OPTIONS[OPINX+1]:= REAL(TRUE); 17675000=02334000= + IF XBIT < USEROPINX THEN 17680000=02335000= + OPTIONWORD:= OPTIONWORD & TRUE[XBIT:1]; 17685000=02335000= + GO ALONG; 17690000=02336000= + XMODE2: 17695000=02337000= + % RESET. 17700000=02337000= + OPTIONS[OPINX+1]:= REAL(FALSE & SETTINGS[1:2:46]); 17705000=02338000= + IF XBIT < USEROPINX THEN 17710000=02339000= + OPTIONWORD:= OPTIONWORD & FALSE[XBIT:1]; 17715000=02339000= + GO ALONG; 17720000=02340000= + XMODE3: 17725000=02341000= + % SET. 17730000=02341000= + SAVEINX:= OPINX; % REMEMBER OPTION WE ARE SETTING. 17735000=02342000= + B:= 17740000=02343000= + IF Q = 6"1=0000" THEN 17745000=02343000= + BOOLEXP 17750000=02343000= + ELSE 17755000=02343000= + TRUE; 17760000=02343000= + OPTIONS[SAVEINX+1]:= REAL(B & SETTING[1:46]); 17765000=02352000= + IF XBIT < USEROPINX THEN 17770000=02353000= + OPTIONWORD:= OPTIONWORD & B[XBIT:1]; 17775000=02353000= + GO ALONG; 17780000=02354000= + XMODE4: 17785000=02355000= + % POP. 17790000=02355000= + OPTIONS[OPINX+1]:= REAL(B:= SETTING.[1:46]); 17795000=02356000= + IF XBIT < USEROPINX THEN 17800000=02357000= + OPTIONWORD:= OPTIONWORD & B[XBIT:1]; 17805000=02357000= + ALONG: 17810000=02359000= + END SWITCHIT; 17815000=02359000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%17820000=02359000= + LABEL 17825000=02360000= + EXIT, 17830000=02360000= + AGAIN, 17835000=02360000= + SKANAGAIN, 17840000=02360000= + LENGTH1, 17845000=02360000= + LENGTH2, 17850000=02360000= + LENGTH3, 17855000=02360000= + LENGTH4, 17860000=02361000= + LENGTH5, 17865000=02361000= + LENGTH6, 17870000=02361000= + LENGTH7, 17875000=02361000= + LENGTH8, 17880000=02361000= + LENGTH9, 17885000=02362000= + WHATISIT, 17890000=02363000= + CARDOPTION, 17895000=02363000= + MERGEOPTION; 17900000=02363000= + SWITCH 17905000=02364000= + OPTIONLENGTH:= LENGTH1, 17910000=02364000= + WHATISIT, 17915000=02364000= + LENGTH3, 17920000=02364000= + LENGTH4, 17925000=02364000= + LENGTH5, 17930000=02365000= + LENGTH6, 17935000=02365000= + LENGTH7, 17940000=02365000= + LENGTH8, 17945000=02365000= + LENGTH9, 17950000=02365000= + WHATISIT; 17955000=02365000= + INTEGER 17960000=02365100= + SRESULT, 17965000=02365100= + SCOUNT; 17970000=02365100= + INTEGER 17975000=02365200= + SAVEINX; 17980000=02365200= + DOLLARTOG:= TRUE; 17985000=02366000= + MOVE(10, ACCUM[0], DEFINEARRY[0]); % SAVE INFORMATION FOR 17990000=02366100= + SCOUNT:= COUNT; 17995000=02366200= + SRESULT:= RESULT; % "TABLE" TO RESUME SCAN. 18000000=02366200= + XMODE:= 0; 18005000=02367000= + PUTSEQNO(INFO[LASTSEQROW, LASTSEQUENCE], LCR); 18010000=02368000= + TURNONSTOPLIGHT(6"%", LCR); 18015000=02369000= +SKANAGAIN: 18020000=02371000= + SKAN; 18025000=02371000= +AGAIN: 18030000=02373000= + GO OPTIONLENGTH[MIN(COUNT, 10)]; 18035000=02373000= +LENGTH: 18040000=02375000= + IF Q = 6"1%0000" THEN 18045000=02375000= + GO EXIT; 18050000=02375000= + IF Q = 6"1$0000" THEN 18055000=02376000= + BEGIN 18060000=02377000= + SWITCHIT(PRINTDOLLARBIT); 18065000=02377000= + GO AGAIN 18070000=02377000= + END; 18075000=02377000= + IF Q = 6"1,0000" THEN 18080000=02378000= + GO SKANAGAIN; 18085000=02378000= + GO WHATISIT; 18090000=02379000= +LENGTH2: 18095000=02380000= + % NO OPTIONS OF THIS LENGTH ARE CURRENTLY IMPLEMENTED. 18100000=02380000= +LENGTH3: 18105000=02382000= + IF Q = 6"3SET00" THEN 18110000=02382000= + BEGIN 18115000=02383000= + XMODE:= 3; 18120000=02383000= + GO SKANAGAIN 18125000=02383000= + END; 18130000=02383000= + IF Q = 6"3POP00" THEN 18135000=02384000= + BEGIN 18140000=02385000= + XMODE:= 4; 18145000=02385000= + GO SKANAGAIN 18150000=02385000= + END; 18155000=02385000= + IF Q = 6"3NEW00" THEN 18160000=02386000= + BEGIN 18165000=02387000= + SWITCHIT(NEWBIT); 18170000=02388000= + IF Q = 6"4TAPE0" THEN 18175000=02389000= + GO SKANAGAIN; 18180000=02389000= + GO AGAIN; 18185000=02390000= + END; 18190000=02391000= + IF Q = 6"3SEQ00" THEN 18195000=02392000= + BEGIN 18200000=02393000= + SWITCHIT(SEQBIT); 18205000=02393000= + GO AGAIN 18210000=02393000= + END; 18215000=02393000= + IF Q = 6"3PRT00" THEN 18220000=02394000= + BEGIN 18225000=02395000= + SWITCHIT(PRTBIT); 18230000=02395000= + GO AGAIN 18235000=02395000= + END; 18240000=02395000= + IF Q = 6"3MCP00" THEN 18245000=02396000= + BEGIN 18250000=02397000= + SWITCHIT(MCPBIT); 18255000=02397000= + GO AGAIN 18260000=02397000= + END; 18265000=02397000= + GO WHATISIT; 18270000=02398000= +LENGTH4: 18275000=02400000= + IF Q = 6"4LIST0" THEN 18280000=02400000= + BEGIN 18285000=02401000= + SWITCHIT(LISTBIT); 18290000=02402000= + GO AGAIN; 18295000=02404000= + END; 18300000=02405000= + IF Q = 6"4VOID0" THEN 18305000=02406000= + BEGIN 18310000=02407000= + IF XMODE = 0 THEN 18315000=02408000= + BEGIN 18320000=02409000= + GETVOID(VOIDPLACE, NCR, VOIDCR, LCR, 18325000=02411000= + INFO[LASTSEQROW, LASTSEQUENCE]); 18330000=02411000= + XMODE:= 1; 18335000=02412000= + SWITCHIT(VOIDBIT); 18340000=02412000= + GO EXIT; 18345000=02413000= + END; 18350000=02414000= + SWITCHIT(VOIDBIT); 18355000=02415000= + VOIDPLACE:= 6"9999"&6"9999"[1:23];%2 B COMPATIBLE W/B-5700 VOIDS 18360000=02416000= + VOIDCR:= MKABS(VOIDPLACE); % AND FAKE OUT READACARD. 18365000=02417000= + GO AGAIN; 18370000=02418000= + END; 18375000=02419000= + IF Q = 6"4XREF0" THEN 18380000=02419100= + BEGIN 18385000=02419100= + SWITCHIT(XREFBIT); 18390000=02419100= + IF BOOLEAN(XMODE) THEN 18395000=02419110= + DEFINING:= BOOLEAN(REAL(DEFINING) & 1[1:47:1]); 18400000=02419110= + GO AGAIN 18405000=02419120= + END; 18410000=02419120= + IF Q = 6"4BEND0" THEN 18415000=02419200= + BEGIN 18420000=02419200= + SWITCHIT(BENDBIT); 18425000=02419200= + GO AGAIN 18430000=02419200= + END; 18435000=02419200= + IF Q = 6"4OMIT0" THEN 18440000=02420000= + BEGIN 18445000=02421000= + SWITCHIT(OMITBIT); 18450000=02421000= + GO AGAIN 18455000=02421000= + END; 18460000=02421000= + IF Q = 6"4CARD0" THEN 18465000=02422000= + BEGIN 18470000=02423000= + Q:= 6"4TAPE0"; % FAKE OUT SWITCHIT. 18475000=02424000= + SWITCHIT(MERGEBIT); 18480000=02425000= + IF XMODE ^= 2 THEN 18485000=02425500= + MERGETOG:= NOT MERGETOG; 18490000=02425500= + OPTIONS[2*MERGEBIT-1]:= % CARD IS 18495000=02426000= +REAL(SETTING & (MERGETOG)[47:1]); % INVERSE OF MERGE. 18500000=02427000= + IF MERGETOG THEN 18505000=02428000= + GO MERGEOPTION; 18510000=02428000= + CARDOPTION: 18515000=02430000= + IF LASTUSED < 5 THEN 18520000=02430000= + LASTUSED:= 1; 18525000=02430000= + GO AGAIN; 18530000=02431000= + END; 18535000=02432000= + IF Q = 6"4TAPE0" THEN 18540000=02433000= + BEGIN 18545000=02434000= + SWITCHIT(MERGEBIT); 18550000=02435000= + IF NOT MERGETOG THEN 18555000=02436000= + GO CARDOPTION; 18560000=02436000= + MERGEOPTION: 18565000=02437500= + IF LASTUSED ^= 1 THEN 18570000=02437500= + GO TO AGAIN; 18575000=02437500= + LASTUSED:= 2; % NEXT CARD IS READ FROM READER. 18580000=02438000= + IF MAXTLCR = 0 THEN 18585000=02439000= + BEGIN 18590000=02440000= + INTEGER 18595000=02441000= + STREAM PROCEDURE FEJ(F, T); 18600000=02441000= + VALUE 18605000=02441000= + T; 18610000=02441000= + BEGIN 18615000=02442000= + SI:= F; 18620000=02443000= + DI:= LOC T; 18625000=02443000= + DS:= WDS; 18630000=02443000= + SI:= T; 18635000=02444000= + SI:= SI-16; 18640000=02444000= + DI:= LOC FEJ; 18645000=02444000= + DS:= WDS; 18650000=02444000= + END FEJ; 18655000=02445000= + STREAM PROCEDURE FIX(F, T); 18660000=02446000= + VALUE 18665000=02446000= + T; 18670000=02446000= + BEGIN 18675000=02447000= + SI:= F; 18680000=02448000= + SI:= SI-24; 18685000=02448000= + DI:= LOC T; 18690000=02448000= + DS:= WDS; 18695000=02448000= + DI:= T; 18700000=02449000= + DI:= DI+47; 18705000=02449000= + SKIP 4 DB; 18710000=02449000= + DS:= 2 RESET; 18715000=02449000= + (DI:= DI+48;DS:= 8 LIT 6"00#01+0#"; 18720000=02451000= + END FIX; 18725000=02451000= + IF GT1:= FEJ(TAPE, 0) = 10 THEN 18730000=02452000= + BEGIN 18735000=02453000= + REWIND(TAPE); 18740000=02454000= + FIX(TAPE, 0); 18745000=02454000= + END; 18750000=02455000= + MAXTLCR:= GT1+TLCR:= 9+MKABS(TBUFF[0]); 18755000=02456000= + READ(TAPE, 10, TBUFF[**]); % INITIALIZE TAPE INPUT. 18760000=02457000= + LASTUSED:= 2; 18765000=02458000= + END; 18770000=02459000= + GO AGAIN; 18775000=02460000= + END; 18780000=02461000= + IF Q = 6"4PAGE0" THEN 18785000=02462000= + BEGIN 18790000=02463000= + IF LISTER THEN 18795000=02464000= + WRITE(LINE[PAGE]); 18800000=02464000= + GO SKANAGAIN; 18805000=02465000= + END; 18810000=02466000= + IF Q = 6"4INFO0" THEN 18815000=02467000= + BEGIN 18820000=02468000= + DUMPINFO; 18825000=02468000= + GO SKANAGAIN 18830000=02468000= + END; 18835000=02468000= + IF Q = 6"4SEGS0" THEN 18840000=02469000= + BEGIN 18845000=02470000= + SWITCHIT(SEGSBIT); 18850000=02470000= + GO AGAIN 18855000=02470000= + END; 18860000=02470000= + IF Q = 6"4NEST0" THEN 18865000=02471000= + BEGIN 18870000=02472000= + SWITCHIT(NESTBIT); 18875000=02472000= + GO AGAIN 18880000=02472000= + END; 18885000=02472000= + IF Q = 6"4DECK0" THEN 18890000=02473000= + BEGIN 18895000=02474000= + SWITCHIT(DECKBIT); 18900000=02474000= + GO AGAIN 18905000=02474000= + END; 18910000=02474000= + GO WHATISIT; 18915000=02475000= +LENGTH5: 18920000=02477000= + IF Q = 6"5RESET" THEN 18925000=02477000= + BEGIN 18930000=02478000= + XMODE:= 2; 18935000=02478000= + GO SKANAGAIN 18940000=02478000= + END; 18945000=02478000= + IF Q = 6"5LISTP" THEN 18950000=02479000= + BEGIN 18955000=02480000= + SWITCHIT(LISTPBIT); 18960000=02480000= + GO AGAIN; 18965000=02480000= + END; 18970000=02480000= + IF Q = 6"5VOIDT" THEN 18975000=02481000= + BEGIN 18980000=02482000= + IF XMODE = 0 THEN 18985000=02483000= + BEGIN 18990000=02484000= + GETVOID(VOIDPLACE, NCR, VOIDCR, LCR, 18995000=02486000= + INFO[LASTSEQROW, LASTSEQUENCE]); 19000000=02486000= + XMODE:= 1; 19005000=02487000= + SWITCHIT(VOIDBIT); 19010000=02487000= + GO EXIT; 19015000=02488000= + END; 19020000=02489000= + SWITCHIT(VOIDTBIT); 19025000=02490000= + VOIDPLACE:= 6"9999"&6"9999"[1:23];%2 B COMPATIBLE W/B-5700 VOIDS 19030000=02491000= + VOIDCR:= MKABS(VOIDPLACE); % AND FAKE OUT READACARD. 19035000=02492000= + GO AGAIN; 19040000=02493000= + END; 19045000=02494000= + IF Q = 6"5CHECK" THEN 19050000=02495000= + BEGIN 19055000=02496000= + SWITCHIT(CHECKBIT); 19060000=02496000= + GO AGAIN 19065000=02496000= + END; 19070000=02496000= + IF Q = 6"5LIMIT" THEN 19075000=02497000= + BEGIN 19080000=02498000= + SKAN; 19085000=02499000= + IF RESULT ^= 3 THEN % SHOULD BE NUMBER. 19090000=02500000= + BEGIN 19095000=02501000= + FLAG(600); 19100000=02501000= + GO AGAIN 19105000=02501000= + END; 19110000=02501000= + ERRMAX:= CONV(ACCUM[1], 0, ACCUM[1].[12:6]); 19115000=02502000= + GO SKANAGAIN; 19120000=02503000= + END; 19125000=02504000= + IF Q = 6"5PUNCH" THEN 19130000=02505000= + BEGIN 19135000=02506000= + SWITCHIT(PUNCHBIT); 19140000=02506000= + GO AGAIN; 19145000=02506000= + END; 19150000=02506000= + IF Q = 6"5PURGE" THEN 19155000=02507000= + BEGIN 19160000=02508000= + SWITCHIT(PURGEBIT); 19165000=02508000= + GO AGAIN; 19170000=02508000= + END; 19175000=02508000= + IF Q = 6"5LISTA" THEN 19180000=02509000= + BEGIN 19185000=02510000= + SWITCHIT(LISTABIT); 19190000=02511000= + GO AGAIN; 19195000=02513000= + END; 19200000=02514000= + IF Q = 6"5STUFF" THEN 19205000=02515000= + BEGIN 19210000=02516000= + SWITCHIT(STUFFBIT); 19215000=02516000= + GO AGAIN; 19220000=02516000= + END; 19225000=02516000= + GO WHATISIT; 19230000=02517000= +LENGTH6: 19235000=02519000= + IF Q = 6"6SEQER" THEN 19240000=02519000= + BEGIN 19245000=02520000= + SWITCHIT(SEQERRBIT); 19250000=02520000= + GO AGAIN 19255000=02520000= + END; 19260000=02520000= + IF Q = 6"6SINGL" THEN 19265000=02521000= + BEGIN 19270000=02522000= + SWITCHIT(SINGLBIT); 19275000=02522000= + GO AGAIN 19280000=02522000= + END; 19285000=02522000= + IF Q = 6"6SEQXE" THEN 19290000=02523000= + BEGIN 19295000=02524000= + IF BUILDLINE.[45:1] THEN 19300000=02525000= + BEGIN 19305000=02525001= + IF XMODE = 0 THEN 19310000=02525003= + BEGIN 19315000=02525004= + OPTIONWORD:= BOOLEAN(0); 19320000=02525005= + FOR SAVEINX:= 1 STEP 2 UNTIL OPARSIZE DO 19325000=02525006= + OPTIONS[SAVEINX]:= 0; 19330000=02525007= + BUILDLINE.[47:1]:= SEQXEQTOG:= FALSE; 19335000=02525008= + IF LASTUSED < 5 THEN 19340000=02525009= + LASTUSED:= 1; 19345000=02525009= + XMODE:= 1; 19350000=02525010= + END; 19355000=02525011= + SEQXEQTOG:= XMODE ^= 2 AND XMODE ^= 4; 19360000=02525012= + BUILDLINE.[47:1]:= SEQXEQTOG; 19365000=02525013= + END; 19370000=02526000= + GO SKANAGAIN; 19375000=02527000= + END; 19380000=02528000= + IF Q = 6"6DEBUG" THEN 19385000=02529000= + BEGIN 19390000=02530000= + SWITCHIT(DEBUGIT); 19395000=02531000= + IF DEBUGTOG THEN 19400000=02533000= + IF WOP[0] = 0 THEN 19405000=02534000= + BEGIN 19410000=02535000= + FILL WOP[**] WITH 6"LITC", 6" ", 6"OPDC", 6"DESC", 10, 19415000=02539000= + "DFL ", 11, "NOP ", 12, "XRT ", 16, "ADD ", 17, "AD2 ", 18, 19420000=02539000= + "PRL ", 19, "LNG ", 21, "GEQ ", 22, "BBC ", 24, "INX ", 35, 19425000=02540000= + "LOR ", 37, "GTR ", 38, "BFC ", 39, "RTN ", 40, "COC ", 48, 19430000=02541000= + "SUB ", 49, "SB2 ", 64, "MUL ", 65, "ML2 ", 67, "LND ", 68, 19435000=02542000= + "STD ", 69, "NEQ ", 71, "XIT ", 72, "MKS ", 128, "DIV ", 12919440000=02543000= + , 6"DV2 ", 130, "COM ", 131, "LQV ", 132, "SND ", 133, 19445000=02543000= + "XCH ", 134, "CHS ", 167, "RTS ", 168, "CDC ", 197, "FTC ", 19450000=02544000= + 260, "LOD ", 261, "DUP ", 278, "LBC ", 280, "SSF ", 294, 19455000=02545000= + "LFC ", 322, "ZP1 ", 384, "IDV ", 453, "FTF ", 515, "MDS ", 19460000=02546000= + 532, "ISD ", 533, "LEQ ", 534, "BBW ", 548, "ISN ", 549, 19465000=02546000= + "LSS ", 550, "BFW ", 581, "EQL ", 582, "SSP ", 584, "ECM ", 19470000=02547000= + 709, "CTC ", 790, "LBU ", 806, "LFU ", 896, "RDV ", 965, 19475000=02548000= + "CTF ", 1023, 1023, 1023, 1023, 1023, 1023, 1023, 1023, 102319480000=02549000= + , 1023, 1023, 1023; 19485000=02549000= + FILL COP[**] WITH % CHARACTER MODE MNEMONICS 19490000=02550000= +6"EXC ", 6"NOP ", 6"BSD ", 6"BSS ", 6"RDA ", 6"TRW ", 6"SED ", 6"TDA ", 19495000=02552000= + 6" ", 6" ", 6"TBN ", 6" ", 6"SDA ", 6"SSA ", 19500000=02552000= + 6"SFD ", 6"SRD ", 6" ", 6" ", 6"SES ", 6" ", 19505000=02553000= + 6"TEQ ", 6"TNE ", 6"TEG ", 6"TGR ", 6"SRS ", 6"SFS ", 19510000=02554000= + 6" ", 6" ", 6"TEL ", 6"TLS ", 6"TAN ", 6"BIT ", 19515000=02555000= + 6"INC ", 6"STC ", 6"SEC ", 6"CRF ", 6"JNC ", 6"JFC ", 19520000=02555000= + 6"JNS ", 6"JFW ", 6"RCA ", 6"ENS ", 6"BNS ", 6"RSA ", 19525000=02556000= + 6"SCA ", 6"JRC ", 6"TSA ", 6"JRV ", 6"CEQ ", 6"CNE ", 19530000=02557000= + 6"CEG ", 6"CGR ", 6"BIS ", 6"BIR ", 6"OCV ", 6"ICV ", 19535000=02558000= + 6"CEL ", 6"CLS ", 6"FSU ", 6"FAD ", 6"TRP ", 6"TRN ", 19540000=02558000= + 6"TRZ ", 6"TRS "; 19545000=02558000= + FILL POP[**] WITH 6"ZFN ", 6"ZBN ", 6"ZFD ", 6"ZBD ", 6"ISO " 19550000=02561000= + , 0, "DIA ", 6"DIB ", 6"TRB ", 6"CFL ", 6"CFE "; 19555000=02562000= + END; 19560000=02563000= + GO AGAIN; 19565000=02564000= + END; 19570000=02565000= + IF Q = 6"6FORMA" THEN 19575000=02566000= + BEGIN 19580000=02567000= + SWITCHIT(FORMATBIT); 19585000=02567000= + GO AGAIN; 19590000=02567000= + END; 19595000=02567000= + GO WHATISIT; 19600000=02568000= +LENGTH7: 19605000=02570000= + IF Q = 6"7INCLU" THEN 19610000=02570000= + BEGIN 19615000=02571000= + INCLUDECARD; 19620000=02571000= + GO EXIT; 19625000=02571000= + END; 19630000=02571000= +% IF Q = "7INCLN" THEN 19635000=02572000= +% BEGIN SWITCHIT(NEWINCLBIT); GO AGAIN; END; 19640000=02573000= +LENGTH8: 19645000=02574100= + IF Q = 6"8CODEF" THEN 19650000=02574100= + BEGIN 19655000=02574200= + SWITCHIT(CODEFILEBIT); 19660000=02574200= + GO AGAIN; 19665000=02574200= + END; 19670000=02574200= + GO WHATISIT; 19675000=02574300= +LENGTH9: 19680000=02576000= + IF Q = 6"9INTRI" THEN 19685000=02576000= + BEGIN 19690000=02577000= + SWITCHIT(INTBIT); 19695000=02577000= + GO AGAIN; 19700000=02577000= + END; 19705000=02577000= +WHATISIT: 19710000=02579000= + IF RESULT = 3 THEN 19715000=02579000= + BEGIN 19720000=02580000= + BASENUM:= CONV(ACCUM[1], 0, ACCUM[1].[12:6]); 19725000=02581000= + TOTALNO:= -10; 19730000=02582000= + NEWBASE:= TRUE; 19735000=02583000= + GO SKANAGAIN; 19740000=02584000= + END; 19745000=02585000= + IF RESULT = 2 THEN 19750000=02586000= + BEGIN 19755000=02587000= + IF Q = 6"1+0000" THEN 19760000=02588000= + BEGIN 19765000=02589000= + SKAN; 19770000=02590000= + IF RESULT = 3 THEN 19775000=02591000= + ADDVALUE:= CONV(ACCUM[1], 0, ACCUM[1].[12:6]); 19780000=02592000= + FLAG(600); % NUMBER EXPECTED. 19785000=02593000= + END; 19790000=02594000= + GO SKANAGAIN; 19795000=02595000= + END; 19800000=02596000= + 19805000=02597000= +COMMENT DID NOT RECOGNIZE OPTION; 19810000=02597000= + IF RESULT ^= 1 THEN % NOT AN IDENTIFIER. 19815000=02598000= + BEGIN 19820000=02599000= + FLAG(601); 19825000=02599000= + GO SKANAGAIN 19830000=02599000= + END; 19835000=02599000= + SWITCHIT(USEROPINX); % USEROPINX MEANS A USER-DEFINED OPTION. 19840000=02600000= + GO AGAIN; 19845000=02601000= +EXIT: 19850000=02602500= + LISTER:= DEBUGTOG OR LISTOG OR LISTATOG; 19855000=02602500= + MOVE(10, DEFINEARRAY[0], ACCUM[0]); % RESTORE INFORMATION FOR 19860000=02602600= + COUNT:= SCOUNT; 19865000=02602700= + RESULT:= SRESULT; % "TABLE" TO RESUME SCAN. 19870000=02602700= + DOLLARTOG:= FALSE; 19875000=02603000= + END DOLLARCARD; 19880000=02604000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%19885000=02604000= + 19890000=02605000= +COMMENT TABLE IS THE ROUTINE THAT MOST CODE IN THE COMPILER 19895000=02605000= + USES WHEN IT IS DESIRED TO SCAN ANOTHER LOGICAL QUANTITY. 19900000=02606000= + THE RESULT RETURNED IS THE CLASS OF THE ITEM DESIRED. 19905000=02607000= + TABLE MAINTAINS THE VARIABLES I AND NXTELBT AND THE ARRAY 19910000=02608000= + ELBAT. ELBAT AND I ARE PRINCIPAL VARIABLES USED FOR 19915000=02609000= + COMMUNICATION BETWEEN TABLE AND THE OUTSIDE WORLD. NXTELBT 19920000=02610000= + IS ALMOST EXCLUSIVELY USED BY TABLE. ALTHOUGH AN OCCASION- 19925000=02611000= + AL OTHER USE IS MADE IN ORDER TO FORGET THAT SOMETHING WAS 19930000=02612000= + SCANNED. (SEE. FOR EXAMPLE, COMPOUNDTAIL). FOR FURTHER 19935000=02613000= + GENERAL DISCUSSION SEE THE DECLARATION OF THESE VARIABLES. 19940000=02614000= + THE PARAMETER P IS THE ACTUAL INDEX OF THE QUANTITY 19945000=02615000= + DESIRED (USUALLY I-1,I, OR I+1). 19950000=02616000= + THE GENERAL PLAN OF TABLE IS THIS: 19955000=02617000= + I) IF P < NXTELBAT GO ON TO III). 19960000=02618000= + II) PROCESS ONE QUANTITY. 19965000=02619000= + A) SCAN. 19970000=02620000= + B) TEST FOR IDENTIFIER, NUMBER, OR SPECIAL CHARACTER. 19975000=02621000= + 1) IDENTIFIER - LOOKUP IN DIRECTORY AND PROCESS 19980000=02622000= + IN SPECIAL MANNER IF COMMENT OR DEFINED ID. 19985000=02623000= + 2) NUMBER - PROCESS INTEGER PART, FRACTIONAL PART, 19990000=02624000= + AND EXPONENT PART. 19995000=02625000= + 3) TEST IF SPECIAL CHARACTER REQUIRES SPECIAL 20000000=02626000= + PROCESSING - OTHERWISE GET ELBAT WORD FROM 20005000=02627000= + SPECIAL. 20010000=02628000= + C) LOAD ELBAT AND INCREMENT NXTELBT. 20015000=02629000= + D) IF ELBAT IS FULL ADJUST ELBAT, NXTELBT, I, AND P. 20020000=02630000= + E) GO BACK TO I). 20025000=02631000= + III) RETURN WITH CLASS OF ELBAT[P]. 20030000=02632000= + FURTHER DETAILS ARE GIVEN IN BODY OF TABLE. 20035000=02633000= + ; 20040000=02634000= + INTEGER PROCEDURE TABLE(P); 20045000=02635000= + VALUE 20050000=02635000= + P; 20055000=02635000= + INTEGER 20060000=02635000= + P; 20065000=02635000= + BEGIN 20070000=02636000= + LABEL 20075000=02637000= + PERCENT, 20080000=02637000= + SPECIALCHAR, 20085000=02637000= + COMPLETE, 20090000=02637000= + COLON, 20095000=02637000= + DOT, 20100000=02637000= + ATSIGN, 20105000=02637000= + QUOTE, 20110000=02638000= + STRNGXT, 20115000=02638000= + MOVEIT, 20120000=02638000= + ARGH, 20125000=02638000= + FINISHNUMBER, 20130000=02639000= + SCANAGAIN, 20135000=02639000= + FPART, 20140000=02639000= + EPART, 20145000=02639000= + IPART, 20150000=02639000= + IDENT, 20155000=02639000= + ROSE, 20160000=02639000= + COMPOST, 20165000=02639000= + DOLLAR, 20170000=02639000= + RTPAREN, 20175000=02640000= + CROSSHATCH, 20180000=02640000= + DBLDOLLAR; 20185000=02640000= + SWITCH 20190000=02641000= + SPECIALSWITCH:= PERCENT, 20195000=02641000= + DOLLAR, 20200000=02641000= + DOT, 20205000=02641000= + ATSIGN, 20210000=02641000= + COLON, 20215000=02641000= + QUOTE, 20220000=02642000= + RTPAREN, 20225000=02642000= + CROSSHATCH, 20230000=02642000= + DBLDOLLAR; 20235000=02642000= + SWITCH 20240000=02643000= + RESULTSWITCH:= IDENT, 20245000=02643000= + SPECIALCHAR, 20250000=02643000= + IPART; 20255000=02643000= + WHILE P >= NXTELBT DO 20260000=02645000= + BEGIN 20265000=02645000= + SCANAGAIN: 20270000=02647000= + COUNT:= RESULT:= ACCUM[1]:= 0; 20275000=02647000= + SCANNER; 20280000=02647000= + GO RESULTSWITCH[RESULT]; 20285000=02648000= + ARGH: 20290000=02650000= + Q:= ACCUM[1]; 20295000=02650000= + FLAG(141); 20300000=02650000= + GO SCANAGAIN; 20305000=02650000= + SPECIALCHAR: 20310000=02652000= + GT1:= ACCUM[1].[18:6]-2; 20315000=02652000= + ENDTOG:= GT1 = 57 AND ENDTOG; 20320000=02653000= + 20325000=02654000= +COMMENT OBTAIN ACTUAL CHARACTER FROM ACCUM; 20330000=02654000= + SPECIAL[GT1 & GT1[42:41:3];COMMENTIF GT1:= T.INCR = 0 THEN GO 20335000=02666000= + COMPLETE;GO SPECIALSWITCH[GT1];COMMENTRESULT:= 7;SCANNER; 20340000=02666000= + COMMENTIF EXAMIN(NCR) = 6"=" THEN BEGIN RESULT:= 0;SCANNER;T 20345000=02666000= + := SPECIAL[13] 20350000=02666000= + END; 20355000=02666000= + RESULT:= 2; 20360000=02667000= + GO COMPLETE; 20365000=02667000= + DOT: 20370000=02680000= + IF EXAMIN(NCR) > 9 OR ENDTOG THEN 20375000=02680000= + GO COMPLETE; 20380000=02680000= + NHI:= NLO:= 0; 20385000=02681000= + C:= 0; 20390000=02682000= + FSAVE:= 0; 20395000=02682000= + GO FPART; 20400000=02682000= + ATSIGN: 20405000=02684000= +% RESULT:=0; SCANNER; 20410000=02684000= +% IF COUNT>17 THEN GO ARGH; 20415000=02685000= +% IF OCTIZE(ACCUM[1],COUNT-1,17-COUNT,C) THEN GO ARGH 20420000=02686000= +% ELSE GO NUMBEREND; 20425000=02687000= + NHI:= C:= 1; 20430000=02688000= + NLO:= FSAVE:= 0; 20435000=02688000= + GO EPART; 20440000=02688000= + 20445000=02689000= +COMMENT DOT AND ATSIGN ENTER NUMBER CONVERSION AT CORRECT SPOT; 20450000=02689000= + QUOTE: 20455000=02691000= + COUNT:= 0; 20460000=02691000= + T:= 20465000=02691000= + IF STREAMTOG THEN 20470000=02691000= + 63 20475000=02691000= + ELSE 20480000=02691000= + 8; 20485000=02691000= +% 20490000=02692000= +% 20495000=02692500= + DO BEGIN 20500000=02693000= + RESULT:= 5; 20505000=02694000= + SCANNER; 20510000=02694000= + IF COUNT = T THEN 20515000=02695000= + IF EXAMIN(NCR) ^= 6""" THEN 20520000=02696000= + GO ARGH; 20525000=02696000= + END 20530000=02697000= + UNTIL EXAMIN(NCR) = 6"""; 20535000=02697000= + IF NOT STREAMTOG AND COUNT = 8 AND BOOLEAN(ACCUM[1].[18:1]) THEN 20540000=02697500= + BEGIN 20545000=02697600= + Q:= ACCUM[1]; 20550000=02697600= + FLAG(254); 20555000=02697600= + GO TO SCANAGAIN; 20560000=02697600= + END; 20565000=02697600= + Q:= ACCUM[1]; 20570000=02698000= + RESULT:= 5; 20575000=02698000= + SCANNER; 20580000=02698000= + COUNT:= COUNT-1; 20585000=02698000= + IF COUNT < 0 THEN 20590000=02699000= + COUNT:= COUNT+64; 20595000=02699000= + ACCUM[1]:= Q; 20600000=02700000= + RESULT:= 4; 20605000=02700000= + STRNGXT: 20610000=02701000= + T:= C:= 0; 20615000=02701000= + T.CLASS:= STRNGCON; 20620000=02702000= + IF COUNT < 8 OR(COUNT = 8 AND NOT BOOLEAN(ACCUM[1].[18:1])) THEN 20625000=02703050= + % FLAG BIT NOT SET, FULL WORD CONST. 20630000=02703050= + MOVEIT: 20635000=02705000= + MOVECHARACTERS(COUNT, ACCUM[1], 3, C, 8-COUNT) 20640000=02705100= + ELSE 20645000=02705100= + T.CLASS:= STRING; 20650000=02705100= + T.INCR:= COUNT; 20655000=02705200= + GO COMPLETE; 20660000=02705200= +% 20665000=02706000= + 20670000=02707000= +COMMENT CROSSHATCH HANDLES TWO SITUATIONS: 20675000=02707000= + THE CROSSHATCH AT END OF DEFINE DECLARATIONS AND 20680000=02708000= + THE CROSSHATCH AT END OF ALPHA REPRESENTING DEFINED IDS. 20685000=02709000= + THE TWO CASES ARE PROCESSED DIFFERENTLY. THE FIRST CASE 20690000=02710000= + MERELY PLACES THE CROSSHATCH IN ELBAT. THE SECOND CASE 20695000=02711000= + CAUSES AN EXIT FROM SCANNING THE ALPHA FOR THE DEFINED ID. 20700000=02712000= + FOR A FULL DISCUSSION SEE DEFINEGEN; 20705000=02713000= + CROSSHATCH: 20710000=02715000= + IF DEFINECTR ^= 0 THEN 20715000=02715000= + GO COMPLETE; 20720000=02715000= + PUTSEQNO(GT1, LCR); 20725000=02716000= + TURNONSTOPLIGHT(0, LCR); 20730000=02717000= + IF DEFINEINDEX = 0 THEN 20735000=02718000= + GO ARGH; 20740000=02718000= + LCR:= (GT1:= DEFINEARRAY[DEFINEINDEX-1]) DIV 262144; 20745000=02719000= + NCR:= GT1 MOD 262144; 20750000=02720000= + LASTUSED:= (T:= DEFINEARRAY[DEFINEINDEX:= DEFINEINDEX-3]).[33:15];20755000=02721000= + IF(GT2:= T.[18:15]) ^= 0 THEN % THIS WAS A PARAMETRIC DEFINE 20760000=02721500= + BEGIN % PURGING PARAMETERS FROM DEFSTACKHEAD 20765000=02722000= + GT2:= TAKE(GT2).LINK; % GET POINTER TO NEW DEFSTACKHEAD 20770000=02722500= + DO 20775000=02723500= + PUT(TEXT[(NEXTTEXT:= (GT1:= TAKE(DEFSTACKHEAD)).DYNAM-1).LINKR20780000=02724500= + , NEXTTEXT.LINKC], DEFSTACKHEAD) 20785000=02724500= + % THIS RESTORES THE PREVIOUS ELBAT WORD FOR 20790000=02724500= + % THIS PARAMETER IN CASE OF NESTED DEFINE. 20795000=02725000= + UNTIL GT2 = (DEFSTACKHEAD:= GT1.LINK); 20800000=02726000= + END; 20805000=02727000= + GO SCANAGAIN; 20810000=02728000= + DOLLAR: 20815000=02729000= + COMMENT THIS CODE HANDLES CONTROL CARDS; 20820000=02729000= + 20825000=02730000= + IF GT1:= EXAMIN(NCR) = 6"$" THEN 20830000=02730000= + GO DBLDOLLAR 20835000=02730000= + ELSE 20840000=02730000= + DOLLARCARD; 20845000=02730000= + PERCENT: 20850000=02731000= + IF NCR ^= FCR THEN 20855000=02731000= + READACARD; 20860000=02731000= + IF LIBINDEX ^= 0 THEN 20865000=02732000= + IF RECOUNT = FINISHPT THEN 20870000=02733000= + BEGIN 20875000=02734000= + SEARCHLIB(FALSE); 20880000=02735000= + READACARD; 20885000=02735000= + NORELEASE:= FALSE 20890000=02736000= + END; 20895000=02736000= + GO SCANAGAIN; 20900000=02737000= + 20905000=02738000= +COMMENT MOST PERCENT SIGNS ACTING AS END OF CARD SENTINELS GET TO 20910000=02738000= + PERCENT. PERCENT READS THE NEXT CARD AND STARTS OVER. A 20915000=02739000= + SIDE EFFECT IS THAT ALL CHARACTERS ON A CARD ARE IGNORED 20920000=02740000= + AFTER A FREE PERCENT SIGN (ONE NOT IMBEDDED IN A STRING OR 20925000=02741000= + COMMENT); 20930000=02742000= + 20935000=02743000= +COMMENT MIGHT BE FUNNY COMMA - HANDLE HERE; 20940000=02743000= + RTPAREN: 20945000=02744000= + RESULT:= 7; 20950000=02744000= + SCANNER; 20955000=02744000= + IF EXAMIN(NCR) = 6""" THEN 20960000=02745000= + BEGIN 20965000=02746000= + RESULT:= 0; 20970000=02747000= + SCANNER; 20975000=02747000= + DO BEGIN 20980000=02748000= + RESULT:= 5; 20985000=02749000= + SCANNER 20990000=02750000= + END 20995000=02750000= + UNTIL EXAMIN(NCR) = 6"""; 21000000=02750000= + RESULT:= 0; 21005000=02751000= + SCANNER; 21010000=02751000= + RESULT:= 7; 21015000=02752000= + SCANNER; 21020000=02752000= + IF EXAMIN(NCR) ^= 6"(" THEN 21025000=02753000= + GO ARGH; 21030000=02753000= + RESULT:= 0; 21035000=02754000= + SCANNER; 21040000=02754000= + Q:= ACCUM[1]; 21045000=02754000= + T:= SPECIAL[24] 21050000=02756000= + END; 21055000=02756000= + RESULT:= 2; 21060000=02757000= + GO COMPLETE; 21065000=02757000= + IPART: 21070000=02758000= + TCOUNT:= FSAVE:= 0; 21075000=02758000= + C:= CONVERT; 21080000=02758000= + RESULT:= 7; 21085000=02759000= + SCANNER; % DEBLANK. 21090000=02759000= + IF DEFINECTR = 0 THEN 21095000=02760000= + IF(C = 3 OR C = 4) AND EXAMIN(NCR) = 6""" THEN 21100000=02761000= + %OCTAL OR HEX STRING.21105000=02761000= + IF NOT(ACCUM[0].CLASS = FILEID AND 21110000=02761501= + INFO[LASTINFO.LINKR, LASTINFO.LINKC] = ACCUM[0]) 21115000=02761501= + THEN 21120000=02761501= + BEGIN 21125000=02762000= + INTEGER 21130000=02762000= + SIZ; 21135000=02762000= + RESULT:= 5; 21140000=02763000= + SCANNER; % SKIP QUOTE. 21145000=02763000= + COUNT:= 0; 21150000=02764000= + DO BEGIN 21155000=02765000= + RESULT:= 5; 21160000=02766000= + SCANNER; 21165000=02766000= + IF COUNT > SIZ:= 48 DIV C THEN % > 1 WORD LONG. 21170000=02767000= + BEGIN 21175000=02768000= + ERR(520); 21180000=02768000= + GO SCANAGAIN 21185000=02768000= + END; 21190000=02768000= + END 21195000=02769000= + UNTIL EXMAIN(NCR) = 6"""; 21200000=02769000= + Q:= ACCUM[1]; 21205000=02770000= + RESULT:= 5; 21210000=02770000= + SCANNER; 21215000=02770000= + COUNT:= COUNT-1; 21220000=02770000= + IF C = 3 THEN % OCTAL STRING. 21225000=02771000= + IF OCTIZE(ACCUM[1], ACCUM[4], 16-COUNT, COUNT) THEN 21230000=02772000= + FLAG(521) % NON-OCTAL CHARACTER IN STRING. 21235000=02773000= + ELSE 21240000=02774000= + ELSE 21245000=02774000= + IF HEXIZE(ACCUM[1], ACCUM[4], 12-COUNT, COUNT) THEN 21250000=02774000= + FLAG(521); % NON-HEX CHARACTER IN HEX STRING. 21255000=02775000= + T.INCR:= COUNT:= (C*COUNT-1) DIV 6+1; % # OF CHARS. 21260000=02776100= + T.CLASS:= STRNGCON; 21265000=02776200= + MOVECHARACTERS(1, ACCUM[4], 0, ACCUM[1], 3); 21270000=02776300= + IF BOOLEAN(ACCUM[1].[18:1]) THEN% FLAG BIT SET. 21275000=02776400= + IF STREAMTOG THEN 21280000=02776500= + T.CLASS:= STRING 21285000=02776700= + ELSE 21290000=02776700= + FLAG(254) 21295000=02776900= + ELSE 21300000=02776900= + C:= ACCUM[4]; % GET FULL WORD EQUIVALENT OF STRING. 21305000=02777000= + MOVECHARACTERS(COUNT, ACCUM[4], 8-COUNT, ACCUM[1], 3); 21310000=02777050= + GO TO COMPLETE; 21315000=02777100= + MOVECHARACTERS(8, ACCUM[4], 0, ACCUM[1], 3); 21320000=02781000= + GO COMPLETE; 21325000=02782000= + END OCTAL OR HEX STRING; 21330000=02783000= + IF DPTOG THEN 21335000=02784000= + BEGIN 21340000=02785000= + NHI:= THI; 21345000=02785000= + NLO:= TLO; 21350000=02785000= + END; 21355000=02785000= + IF EXAMIN(NCR) = 6"." THEN 21360000=02786000= + BEGIN 21365000=02787000= + RESULT:= 0; 21370000=02788000= + SCANNER; 21375000=02788000= + C:= 1.0*C; 21380000=02789000= + FPART: 21385000=02790000= + TCOUNT:= COUNT; 21390000=02790000= + IF EXAMIN(NCR) <= 9 THEN 21395000=02791000= + BEGIN 21400000=02792000= + RESULT:= 0; 21405000=02793000= + SCANNER; 21410000=02793000= + IF DPTOG THEN 21415000=02794000= + BEGIN 21420000=02795000= + DOUBLE(CONVERT, TLO, TEN[(COUNT-TCOUNT) MOD 12], 0, /, 21425000=02797000= + := , THI, TLO); 21430000=02797000= + FOR T:= 12 STEP 12 UNTIL COUNT-TCOUNT DO 21435000=02798000= + DOUBLE(THI, TLO, TEN[12], 0, /, := , THI, TLO); 21440000=02799000= + DOUBLE(THI, TLO, NHI, NLO, +, := , NHI, NLO); 21445000=02800000= + C:= NHI 21450000=02802000= + END 21455000=02803000= + ELSE 21460000=02803000= + C:= CONVERT+C*TEN[FSAVE:= COUNT-TCOUNT]; 21465000=02803000= + END 21470000=02805000= + END; 21475000=02805000= + RESULT:= 7; 21480000=02806000= + SCANNER; 21485000=02806000= + IF EXAMIN(NCR) = 6"@" THEN 21490000=02807000= + BEGIN 21495000=02808000= + RESULT:= 0; 21500000=02809000= + SCANNER; 21505000=02809000= + EPART: 21510000=02810000= + TCOUNT:= COUNT; 21515000=02810000= + C:= C*1.0; 21520000=02811000= + RESULT:= 7; 21525000=02812000= + SCANNER; 21530000=02812000= + IF T:= EXAMIN(NCR) > 9 THEN 21535000=02813000= + IF T = 6"-" OR T = 6"+" THEN 21540000=02814000= + BEGIN 21545000=02815000= + RESULT:= 0; 21550000=02816000= + SCANNER; 21555000=02816000= + TCOUNT:= COUNT; 21560000=02817000= + END 21565000=02819000= + ELSE 21570000=02819000= + FLAG(47); 21575000=02819000= + RESULT:= 0; 21580000=02820000= + SCANNER; 21585000=02820000= + IF RESULT ^= 3 THEN 21590000=02821000= + FLAG(47); 21595000=02821000= + COMMENT NOT A NUMBER; 21600000=02821000= + Q:= ACCUM[1]; 21605000=02822000= + IF GT1:= T:= (IF T = 6"-" THEN-CONVERT ELSE CONVERT) < -46 OR T 21610000=02824000= + > 69 21615000=02824000= + THEN 21620000=02824000= + FLAG(269) 21625000=02825000= + ELSE 21630000=02825000= + BEGIN 21635000=02825000= + T:= TEN[ABS(GT3:= T-FSAVE)]; 21640000=02826000= + IF ABS(0 & C[42:3:6] & C[1:2:1]+0 & T[42:3:6] & GT3[1:1:1]+12)21645000=02828000= + > 63 21650000=02828000= + THEN 21655000=02828000= + FLAG(269) 21660000=02829000= + ELSE 21665000=02829000= + IF DPTOG THEN 21670000=02829000= + IF GT1 < 0 THEN 21675000=02830000= + BEGIN 21680000=02831000= + GT1:= -GT1; 21685000=02832000= + DOUBLE(NHI, NLO, TEN[GT1 MOD 12], 0, /, := , NHI, NLO)21690000=02833000= + ; 21695000=02833000= + FOR GT2:= 12 STEP 12 UNTIL GT1 DO 21700000=02834000= + DOUBLE(NHI, NLO, TEN[12], 0, /, := , NHI, NLO); 21705000=02835000= + END 21710000=02837000= + ELSE 21715000=02837000= + BEGIN 21720000=02837000= + DOUBLE(NHI, NLO, TEN[GT1 MOD 12], 0, *, := , NHI, NLO)21725000=02838000= + ; 21730000=02838000= + FOR GT2:= 12 STEP 12 UNTIL GT1 DO 21735000=02839000= + DOUBLE(NHI, NLO, TEN[12], 0, *, := , NHI, NLO); 21740000=02840000= + END 21745000=02842000= + ELSE 21750000=02842000= + C:= 21755000=02842000= + IF GT3 < 0 THEN 21760000=02842000= + C/T 21765000=02842000= + ELSE 21770000=02842000= + C*T; 21775000=02842000= + END; 21780000=02843000= + END 21785000=02845000= + ELSE 21790000=02845000= + IF FSAVE ^= 0 THEN 21795000=02845000= + C:= C/TEN[FSAVE]; 21800000=02845000= + Q:= ACCUM[1]; 21805000=02846000= + RESULT:= 3; 21810000=02846000= + FINISHNUMBER: 21815000=02848000= + T:= 0; 21820000=02848000= + IF C.[1:37] = 0 THEN 21825000=02849000= + BEGIN 21830000=02850000= + T.CLASS:= LITNO; 21835000=02850000= + T.ADDRESS:= C 21840000=02850000= + END 21845000=02851000= + ELSE 21850000=02851000= + T.CLASS:= NONLITNO; 21855000=02851000= + GO COMPLETE; 21860000=02852000= + 21865000=02853000= +COMMENT THE CODE BETWEEN IDENT AND COMPOST DOES A LOOKUP IN INFO. 21870000=02853000= + IF QUANTITY IS NOT FOUND THE ELBAT WORD EXPECTS TO BE 21875000=02854000= + ZERO. THE SCRAMBLE FOR APPROPRIATE STACK IS FIRST THING 21880000=02855000= + TO BE DONE. THEN A CHECK IS MADE, USING SUPERSTACK. 21885000=02856000= + TO DETERMINE WHETHER THE IDENTIFIER IS ONE OF OUR 21890000=02857000= + COMMON RESERVED WORDS. IF IT IS, EXIT IS MADE TO 21895000=02858000= + COMPLETE, OTHERWISE THE LOOP BETWEEN COMPOST AND 21900000=02859000= + ROSE IS ENTERED. THE LAST THING DONE FOR ANY 21905000=02860000= + IDENTIFIER WHICH IS FOUND IS TO STUFF THE LOCATION 21910000=02861000= + OF THE ELBATWORD IN INFO INTO THE LINK FIELD. THIS 21915000=02862000= + ALLOWS REFERENCE BACK TO INFO FOR ADDITIONAL DATA, 21920000=02863000= + SHOULD THIS BE REQUIRED. ; 21925000=02864000= + IDENT: 21930000=02865000= + IF T:= SUPERSTACK[SCRAM:= (Q:= ACCUM[1]) MOD 125] ^= 0 THEN 21935000=02865000= + BEGIN 21940000=02866000= + IF INFO[GT1:= T.LINKR, (GT2:= T.LINKC)+1] = Q THEN 21945000=02867000= + BEGIN 21950000=02868000= + T:= INFO[GT1, GT2] & T[35:35:13]; 21955000=02869000= + GO COMPLETE 21960000=02871000= + END 21965000=02872000= + END; 21970000=02872000= + IF EXAMINELAST(ACCUM[1], COUNT+2) = 12 THEN 21975000=02873000= + T:= DEFSTACKHEAD 21980000=02874000= + ELSE 21985000=02874000= + T:= STACKHEAD[SCRAM]; 21990000=02874000= + ROSE: 21995000=02875000= + GT1:= T.LINKR; 22000000=02875000= + IF (GT2:= T.LINKC)+GT1 = 0 THEN 22005000=02876000= + BEGIN 22010000=02877000= + T:= 0; 22015000=02877000= + GO COMPLETE 22020000=02877000= + END; 22025000=02877000= + IF T = INFO[GT1, GT2] THEN 22030000=02877010= + BEGIN 22035000=02877010= + T:= 0; 22040000=02877020= + GO TO COMPLETE 22045000=02877020= + END; 22050000=02877020= + T:= INFO[GT1, GT2]; 22055000=02878000= + IF INFO[GT1, GT2+1] & 0[1:1:11] ^= Q THEN 22060000=02879000= + GO ROSE; 22065000=02879000= + IF COUNT <= 5 THEN 22070000=02880000= + GO COMPOST; 22075000=02880000= + IF NOT EQUAL(COUNT-5, ACCUM[2], INFO[GT1, GT2+2]) THEN 22080000=02881000= + GO ROSE; 22085000=02881000= + COMPOST: 22090000=02882000= + T:= T & GT1[35:43:5] & GT2[40:40:8]; 22095000=02882000= + IF GT1 ^= 1 AND NOT MACROID THEN % NOT RESERVED WORD 22100000=02882100= + XREFIT(T, LINK, CARDNUMBER, NORMALREF); % BUILD XREF ENTRY 22105000=02882200= + 22110000=02883000= +COMMENT CHECK HERE FOR COMMENTS AND DEFINED IDS; 22115000=02883000= + IF NOT ENDTOG THEN 22120000=02884000= + BEGIN 22125000=02885000= + IF GT1:= T.CLASS = COMMENTV THEN 22130000=02886000= + BEGIN 22135000=02887000= + WHILE EXAMIN(NCR) ^= 6";" DO 22140000=02888000= + BEGIN 22145000=02889000= + RESULT:= 6; 22150000=02889000= + COUNT:= 0; 22155000=02889000= + SCANNER 22160000=02889000= + END; 22165000=02889000= + RESULT:= 0; 22170000=02890000= + SCANNER; 22175000=02890000= + GO SCANAGAIN 22180000=02891000= + END 22185000=02892000= + END; 22190000=02892000= + IF STOPDEFINE THEN 22195000=02893000= + GO COMPLETE; 22200000=02893000= + IF GT1 ^= DEFINEDID THEN 22205000=02894000= + GO COMPLETE; 22210000=02894000= + 22215000=02895000= +COMMENT SETUP FOR DEFINED IDS - SEE DEFINEGEN FOR MORE DETAILS; 22220000=02895000= + IF BOOLEAN(T, MON) THEN % THIS IS A PARAMETRIC DEFINE 22225000=02896000= + GT1:= GIT(T:= FIXDEFINEINFO(T)) 22230000=02897000= + ELSE 22235000=02897000= + GT1:= 0; 22240000=02897000= + IF DEFINEINDEX = 24 THEN 22245000=02898000= + BEGIN 22250000=02899000= + FLAG(139); 22255000=02899000= + GO ARGH 22260000=02899000= + END; 22265000=02899000= + DEFINEARRAY[DEFINEINDEX]:= LASTUSED & GT1[18:33:15]; 22270000=02900000= + LASTUSED:= T.DYNAM; 22275000=02901000= + DEFINEARRAY[DEFINEINDEX+2]:= 262144*LCR+NCR; 22280000=02902000= + LCR:= (NCR:= MKABS(DEFINEARRAY[DEFINEINDEX+1]))+1; 22285000=02903000= + PUTSEQNO(GT4, LCR); 22290000=02904000= + TURNONSTOPLIGHT(6"%", LCR); 22295000=02905000= + DEFINEINDEX:= DEFINEINDEX+3; 22300000=02905000= + GO PERCENT; 22305000=02906000= + DBLDOLLAR: 22310000=02908000= + MAKCAST; 22315000=02908000= + GO SCANAGAIN; 22320000=02908000= + COMPLETE: 22325000=02910000= + ELBAT[NXTELBT]:= T; 22330000=02910000= + IF NOT DEFINING THEN 22335000=02910100= + IF T.CLASS = BEGINV THEN 22340000=02910200= + BEGINSTACK[BSPOINT:= BSPOINT+1]:= CARDNUMBER 22345000=02910300= + ELSE 22350000=02910300= + IF T.CLASS = ENDV THEN 22355000=02910400= + BEGIN 22360000=02910500= + IF LISTER THEN 22365000=02910600= + IF BEND THEN 22370000=02910600= + BEGINPRINT; 22375000=02910600= + BSPOINT:= BSPOINT-REAL(BSPOINT > 0); % PREVENT INVALID INDEX 22380000=02910700= + END; 22385000=02910800= + STOPDEFINE:= FALSE; 22390000=02911000= + COMMENT ALLOW DEFINES AGAIN; 22395000=02911000= + IF NXTELBT:= NXTELBT+1 > 74 THEN 22400000=02912000= + IF NOT MACROID THEN 22405000=02913000= + BEGIN 22410000=02914000= + 22415000=02915000= +COMMENT ELBAT IS FULL: ADJUST IT; 22420000=02915000= + MOVE(10, ELBAT[65], ELBAT); 22425000=02916000= + I:= I-65; 22430000=02917000= + P:= P-65; 22435000=02917000= + NXTELBT:= 10; 22440000=02917000= + END 22445000=02919000= + END; 22450000=02919000= + IF TABLE:= ELBAT[P].CLASS = COMMENTV THEN 22455000=02920000= + BEGIN 22460000=02921000= + 22465000=02922000= +COMMENT SPECIAL HANDLING OF CONSTANTS FOR SAKE OF FOR STATEMENTS; 22470000=02922000= + C:= INFO[0, ELBAT[P].ADDRESS]; 22475000=02923000= + ELBAT[P].CLASS:= TABLE:= NONLITNO 22480000=02925000= + END; 22485000=02925000= + STOPDEFINE:= FALSE; 22490000=02926000= + COMMENT ALLOW DEFINE; 22495000=02926000= + END TABLE; 22500000=02927000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%22505000=02927000= + INTEGER PROCEDURE MOVEANDBLOCK(FROM, SIZE, NAME) VALUE SIZE, 22510000=02927110= + NAME; 22515000=02927110= + REAL 22520000=02927110= + SIZE, 22525000=02927110= + NAME; 22530000=02927110= + ARRAY 22535000=02927110= + FROM[0, 0]; 22540000=02927110= + BEGIN 22545000=02927120= + INTEGER 22550000=02927130= + NSEGS, 22555000=02927130= + I, 22560000=02927130= + J, 22565000=02927130= + K; 22570000=02927130= + ARRAY 22575000=02927140= + A[0:14]; 22580000=02927140= + SWITCH FORMAT 22585000=02927150= + FMT:= 22590000=02927155= + (/,"FILE PARAMETER BLOCK IS CODE FILE SEGMENT",I5,/), 22595000=02927160= + (/,"SEGMENT DICTIONARY IS CODE FILE SEGMENT",I5,/), 22600000=02927170= + (/,"PROGRAM-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 22605000=02927180= + (/,"PROGRAM REFERENCE TABLE IS CODE FILE SEGMENT",I5,/), 22610000=02927190= + (/,"SEGMENT-LINE DICTIONARY IS CODE FILE SEGMENT",I5,/), 22615000=02927200= + (/,"POWER OF TEN ARRAY IS CODE FILE SEGMENT",I5,/), 22620000=02927210= + (/,"SEGMENT ZERO",I*,/), 22625000=02927220= + (/,"SEGMENT NUMBER",I5," IS CODE FILE SEGMENT",I5,/); 22630000=02927230= +STREAM PROCEDURE OCTALWORDS(N, W, S, D); 22635000=02927240= + VALUE 22640000=02927240= + N, 22645000=02927240= + W; 22650000=02927240= + BEGIN 22655000=02927250= + DI:= D; 22660000=02927260= + DS:= LIT 6" "; 22665000=02927260= + SI:= LOC N; 22670000=02927270= + SI:= SI+6; 22675000=02927270= + (DS:= 3 RESET;3(IF SB THEN DS:= SET ELSE DS:= RESET;SKIP SB)); 22680000=02927272= + DI:= DI-4; 22685000=02927280= + DS:= 3 FILL; 22690000=02927280= + DI:= D; 22695000=02927290= + DI:= DI+5; 22700000=02927290= + DS:= 4 LIT 6" "; 22705000=02927290= + SI:= S; 22710000=02927300= + W(2(8 22715000=02927350= + (DS:= 3 RESET;3(IF SB THEN DS:= SET ELSE DS:= RESET;SKIP SB);); 22720000=02927350= + DS:= LIT 6" ");DS:= 2 LIT 6" "); 22725000=02927350= + END OF OCTALWORDS; 22730000=02927360= + %********** S T A R T ********** 22735000=02927370= + NSEGS:= (SIZE+29) DIV 30; 22740000=02927380= + IF DA DIV CHUNK < T:= (DA+NSEGS) DIV CHUNK THEN 22745000=02927390= + DA:= CHUNK*T; 22750000=02927400= + MOVEANDBLOCK:= DA; 22755000=02927410= + IF CODEFILE THEN 22760000=02927420= + IF NAME >= 0 THEN 22765000=02927430= + WRITE(LINE, FMT[NAME], DA) 22770000=02927450= + ELSE 22775000=02927450= + WRITE(LINE, FMT[7], ABS(NAME), DA); 22780000=02927460= + IF SIZE ^= 0 THEN 22785000=02927470= + BEGIN 22790000=02927480= + FOR J:= 0 STEP 30 WHILE J < SIZE DO 22795000=02927490= + BEGIN 22800000=02927500= + IF(K:= (128-(J MOD 128))) < 30 THEN 22805000=02927510= + BEGIN 22810000=02927520= + MOVE(K, FROM[J DIV 128, J MOD 128], CODE(0)); 22815000=02927530= + MOVE(30-K, FROM[(J DIV 128)+1, 0], CODE(K)); 22820000=02927540= + END 22825000=02927570= + ELSE 22830000=02927570= + MOVE(30, FROM[J DIV 128, J MOD 128], CODE(0)); 22835000=02927570= + IF J+30 > SIZE THEN % ZERO OUT UNUSED SECTION 22840000=02927580= + BEGIN 22845000=02927590= + K:= 0; 22850000=02927600= + MOVE(1, K, CODE(SIZE-J)); 22855000=02927610= + IF(SIZE-J) < 29 THEN % MORE THAN ONE WORD 22860000=02927612= + MOVE(29-SIZE+J, CODE(SIZE-J), CODE(SIZE-J+1)); 22865000=02927620= + END; 22870000=02927630= + IF CODEFILE THEN 22875000=02927640= + BEGIN 22880000=02927650= + FOR K:= 0 STEP 5 WHILE K <= 25 AND(J+K) <= SIZE DO 22885000=02927660= + BEGIN 22890000=02927670= + BLANKET(14, A); 22895000=02927680= + OCTALWORDS(J+K, IF(J:= K+5) <= SIZE THEN 5 ELSE SIZE-J-K, 22900000=02927700= + CODE(K), A); 22905000=02927700= + WRITE(LINE, 15, A[**]); 22910000=02927710= + END; 22915000=02927720= + WRITE(LINE); 22920000=02927722= + END; 22925000=02927730= + WRITE(CODE[DA]); 22930000=02927740= + DA:= DA+1; 22935000=02927740= + END; 22940000=02927750= + END; 22945000=02927760= + END OF MOVEANDBLOCK; 22950000=02927770= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%22955000=02927770= + 22960000=02928000= +COMMENT NEXTENT IS THE PROCEDURE WHICH SCANS FOR THE FORMAT GENERATOR. 22965000=02928000= + IT USES THE SAME SCANNER AS THE TABLE ROUTINE. NEXTENT 22970000=02929000= + PLACES EITHER A CHARACTER OR A CONVERTED NUMBER WITH A 22975000=02930000= + NEGATIVE SIGN IN ELCLASS. NEXTENT SUPPRESSES BLANKS; 22980000=02931000= + PROCEDURE NEXTENT; 22985000=02932000= + BEGIN 22990000=02933000= + LABEL 22995000=02933000= + DEBLANK; 23000000=02933000= + COUNT:= ACCUM[1]:= 0; 23005000=02934000= + LASTELCLASS:= ELCLASS; 23010000=02934000= +DEBLANK: 23015000=02936000= + IF EXAMIN(NCR) = 6" " THEN 23020000=02936000= + BEGIN 23025000=02937000= + RESULT:= 7; 23030000=02938000= + SCANNER; 23035000=02938000= + END; 23040000=02939000= + IF EXAMIN(NCR) <= 9 THEN% WE HAVE A NO. (WORD MODE COLLATING SEQ.) 23045000=02940000= + BEGIN 23050000=02941000= + RESULT:= 3; 23055000=02942000= + SCANNER; 23060000=02942000= + TCOUNT:= 0; 23065000=02942000= + Q:= ACCUM[1]; 23070000=02942000= + IF COUNT > 4 THEN 23075000=02943000= + FLAG(140) % INTEGER > 1023. 23080000=02943000= + ELSE 23085000=02944000= + IF ELCLASS:= -CONVERT < -1023 THEN 23090000=02944000= + FLAG(140) % INTEGER > 1023. 23095000=02944000= + END 23100000=02946000= + ELSE 23105000=02946000= + IF EXAMIN(NCR) = 6"%" THEN 23110000=02946000= + BEGIN 23115000=02947000= + READACARD; 23120000=02948000= + COUNT:= ACCUM[1]:= 0; 23125000=02948000= + GO DEBLANK; 23130000=02948000= + END 23135000=02950000= + ELSE 23140000=02950000= + BEGIN 23145000=02950000= + RESULT:= 5; 23150000=02951000= + SCANNER; % GET NEXT CHARACTER. 23155000=02951000= + Q:= ACCUM[1]; 23160000=02952000= + ELCLASS:= ACCUM[1].[18:6] 23165000=02953000= + END 23170000=02954000= + END OF NEXTENT; 23175000=02954000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23180000=02954000= + BOOLEAN PROCEDURE BOOLPRIM; 23185000=02955000= + FORWARD; 23190000=02955000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23195000=02955000= + PROCEDURE BOOLCOMP(B); 23200000=02955500= + BOOLEAN 23205000=02955500= + B; 23210000=02955500= + FORWARD; 23215000=02955500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23220000=02955500= + INTEGER PROCEDURE NEXT; 23225000=02956000= + BEGIN 23230000=02956500= + LABEL 23235000=02957000= + EXIT; 23240000=02957000= + INTEGER 23245000=02957500= + T; 23250000=02957500= + DEFINE 23255000=02958000= + ERROR = BEGIN 23260000=02958000= + FLAG(603); 23265000=02958000= + GO EXIT 23270000=02958000= + END #; 23275000=02958000= + SKAN; 23280000=02958500= + IF RESULT = 3 THEN 23285000=02959000= + ERROR; % NUMBERS NOT ALLOWED. 23290000=02959000= + IF RESULT = 2 THEN % SPECIAL CHARACTER. 23295000=02959500= + BEGIN 23300000=02960000= + T:= 23305000=02960500= + IF Q = 6"1,0000" OR Q = 6"1%0000" THEN 23310000=02960500= + 20 % FAKE OUT BOOLEXP.23315000=02960500= + ELSE 23320000=02961000= + ((T:= Q.[18:6]-2) & T[42:41:3]); 23325000=02961000= + IF T = 11 OR T = 19 OR T = 20 THEN 23330000=02961500= + BATMAN:= SPECIAL[T] % (,),OR ;23335000=02961500= + ELSE 23340000=02962000= + FLAG(603); 23345000=02962000= + GO EXIT 23350000=02963000= + END SPECIAL CHARACTERS; 23355000=02963000= + 23360000=02963500= +COMMENT LOOK FOR BOOLEAN OPERATORS, THEN OPTIONS; 23365000=02963500= + T:= 23370000=02964000= + IF Q = 6"3NOT00" THEN 23375000=02964000= + NOTOP 23380000=02964500= + ELSE 23385000=02964500= + IF Q = 6"3AND00" THEN 23390000=02964500= + ANDOP 23395000=02965000= + ELSE 23400000=02965000= + IF Q = 6"3OR000" THEN 23405000=02965000= + OROP 23410000=02965500= + ELSE 23415000=02965500= + IF Q = 6"3EQV00" THEN 23420000=02965500= + EQVOP 23425000=02966000= + ELSE 23430000=02966000= + 0; 23435000=02966000= + IF T ^= 0 THEN 23440000=02966500= + BATMAN.CLASS:= T 23445000=02967000= + ELSE 23450000=02967000= + BATMAN:= 1 & BOOID[2:7] & REAL(FINDOPTION(1))[1:1]; % OPTION. 23455000=02967000= +EXIT: 23460000=02968000= + NEXT:= MYCLASS:= BATMAN.CLASS; 23465000=02968000= + END NEXT; 23470000=02968500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23475000=02968500= + BOOLEAN PROCEDURE BOOLEXP; 23480000=02969000= + BEGIN 23485000=02969500= + BOOLEAN 23490000=02970000= + B; 23495000=02970000= + B:= BOOLPRIM; 23500000=02970500= + WHILE MYCLASS >= EQVOP AND MYCLASS <= ANDOP DO 23505000=02971000= + BOOLCOMP(B); 23510000=02971000= + BOOLEXP:= B 23515000=02972000= + END BOOLEXP; 23520000=02972000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23525000=02972000= + BOOLEAN PROCEDURE BOOLPRIM; 23530000=02972500= + BEGIN 23535000=02973000= + BOOLEAN 23540000=02973500= + B, 23545000=02973500= + KNOT; 23550000=02973500= + DEFINE 23555000=02974000= + SKIPIT = MYCLASS:= NEXT #; 23560000=02974000= + IF KNOT:= (NEXT = NOTOP) THEN 23565000=02974500= + SKIPIT; 23570000=02974500= + IF MYCLASS = LEFTPAREN THEN 23575000=02975000= + BEGIN 23580000=02975500= + B:= BOOLEXP; 23585000=02976000= + IF MYCLASS ^= RTPAREN THEN 23590000=02976500= + FLAG(604); 23595000=02976500= + END 23600000=02977500= + ELSE 23605000=02977500= + IF MYCLASS ^= BOOID THEN 23610000=02977500= + FLAG(601) 23615000=02978000= + ELSE 23620000=02978000= + B:= BATMAN < 0; 23625000=02978000= + IF KNOT THEN 23630000=02978500= + B:= NOT B; 23635000=02978500= + SKIPIT; 23640000=02978500= + BOOLPRIM:= B 23645000=02979500= + END BOOLPRIM; 23650000=02979500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23655000=02979500= + PROCEDURE BOOLCOMP(B); 23660000=02980000= + BOOLEAN 23665000=02980000= + B; 23670000=02980000= + BEGIN 23675000=02980500= + REAL 23680000=02981000= + OPCLASS; 23685000=02981000= + BOOLEAN 23690000=02981500= + T; 23695000=02981500= + OPCLASS:= MYCLASS; 23700000=02982000= + T:= BOOLPRIM; 23705000=02982500= + WHILE OPCLASS < MYCLASS DO 23710000=02983000= + BOOLCOMP(T); 23715000=02983000= + B:= 23720000=02983500= + IF OPCLASS = ANDOP THEN 23725000=02983500= + (B AND T) 23730000=02984000= + ELSE 23735000=02984000= + IF OPCLASS = OROP THEN 23740000=02984000= + (B OR T) 23745000=02984500= + ELSE 23750000=02984500= + (B EQV T); 23755000=02984500= + END BOOLCOMP; 23760000=02985000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23765000=02985000= +% 23770000=02985500= + 23775000=02986000= +COMMENT#################################################################23780000=02986000= + FORWARD DECLARATIONS 23785000=02986500= +#######################################################################;23790000=02987000= +% 23795000=02987500= + PROCEDURE AEXP; 23800000=03001000= + FORWARD; 23805000=03001000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23810000=03001000= + PROCEDURE ARITHSEC; 23815000=03002000= + FORWARD; 23820000=03002000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23825000=03002000= + PROCEDURE SIMPARITH; 23830000=03003000= + FORWARD; 23835000=03003000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23840000=03003000= + PROCEDURE ARITHCOMP; 23845000=03004000= + FORWARD; 23850000=03004000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23855000=03004000= + PROCEDURE PRIMARY; 23860000=03005000= + FORWARD; 23865000=03005000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23870000=03005000= + PROCEDURE BEXP; 23875000=03006000= + FORWARD; 23880000=03006000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23885000=03006000= + INTEGER PROCEDURE EXPRSS; 23890000=03007000= + FORWARD; 23895000=03007000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23900000=03007000= + INTEGER PROCEDURE BOOSEC; 23905000=03008000= + FORWARD; 23910000=03008000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23915000=03008000= + PROCEDURE SIMPBOO; 23920000=03009000= + FORWARD; 23925000=03009000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23930000=03009000= + PROCEDURE BOOCOMP; 23935000=03010000= + FORWARD; 23940000=03010000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23945000=03010000= + INTEGER PROCEDURE BOOPRIM; 23950000=03011000= + FORWARD; 23955000=03011000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23960000=03011000= + PROCEDURE RELATION; 23965000=03012000= + FORWARD; 23970000=03012000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23975000=03012000= + INTEGER PROCEDURE IFEXP; 23980000=03013000= + FORWARD; 23985000=03013000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%23990000=03013000= + PROCEDURE PARSE; 23995000=03014000= + FORWARD; 24000000=03014000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24005000=03014000= + PROCEDURE DOTIT; 24010000=03015000= + FORWARD; 24015000=03015000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24020000=03015000= + PROCEDURE GENGO(ELBATWORD); 24025000=03016000= + VALUE 24030000=03016000= + ELBATWORD; 24035000=03016000= + REAL 24040000=03016000= + ELBATWORD; 24045000=03016000= + FORWARD; 24050000=03016000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24055000=03016000= + PROCEDURE DEXP; 24060000=03017000= + FORWARD; 24065000=03017000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24070000=03017000= + PROCEDURE IFCLAUSE; 24075000=03018000= + FORWARD; 24080000=03018000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24085000=03018000= + INTEGER PROCEDURE GET(SYLLABLE); 24090000=03019000= + VALUE 24095000=03019000= + SYLLABLE; 24100000=03019000= + REAL 24105000=03019000= + SYLLABLE; 24110000=03019000= + FORWARD; 24115000=03019000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24120000=03019000= + INTEGER PROCEDURE GNAT(L); 24125000=03020000= + VALUE 24130000=03020000= + L; 24135000=03020000= + REAL 24140000=03020000= + L; 24145000=03020000= + FORWARD; 24150000=03020000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24155000=03020000= + PROCEDURE PANA; 24160000=03021000= + FORWARD; 24165000=03021000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24170000=03021000= + PROCEDURE IFSTMT; 24175000=03022000= + FORWARD; 24180000=03022000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24185000=03022000= + PROCEDURE GOGEN(LABELBAT, BRANCHTYPE); 24190000=03023000= + VALUE 24195000=03024000= + LABELBAT, 24200000=03024000= + BRANCHTYPE; 24205000=03024000= + REAL 24210000=03025000= + LABELBAT, 24215000=03025000= + BRANCHTYPE; 24220000=03025000= + FORWARD; 24225000=03025000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24230000=03025000= + BOOLEAN PROCEDURE SIMPGO; 24235000=03026000= + FORWARD; 24240000=03026000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24245000=03026000= + PROCEDURE STMT; 24250000=03027000= + FORWARD; 24255000=03027000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24260000=03027000= + PROCEDURE EMIT(SYLLABLE); 24265000=03028000= + VALUE 24270000=03028000= + SYLLABLE; 24275000=03028000= + REAL 24280000=03028000= + SYLLABLE; 24285000=03028000= + FORWARD; 24290000=03028000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24295000=03028000= + PROCEDURE PROCSTMT(FROM); 24300000=03029000= + VALUE 24305000=03029000= + FROM; 24310000=03029000= + BOOLEAN 24315000=03029000= + FROM; 24320000=03029000= + FORWARD; 24325000=03029000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24330000=03029000= + PROCEDURE STRMPROCSTMT; 24335000=03030000= + FORWARD; 24340000=03030000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24345000=03030000= + BOOLEAN PROCEDURE GETINT; 24350000=03031000= + FORWARD; 24355000=03031000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24360000=03031000= + INTEGER PROCEDURE DIVIDE(NUMBER, P1, P2); 24365000=03032000= + VALUE 24370000=03032000= + NUMBER; 24375000=03032000= + INTEGER 24380000=03033000= + P1, 24385000=03033000= + P2, 24390000=03033000= + NUMBER; 24395000=03033000= + FORWARD; 24400000=03033000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24405000=03033000= + PROCEDURE CONSTANTCLEAN; 24410000=03034000= + FORWARD; 24415000=03034000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24420000=03034000= + PROCEDURE SCATTERELBAT; 24425000=03035000= + FORWARD; 24430000=03035000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24435000=03035000= + PROCEDURE EMITB(BRANCH, FROM, TOWARDS); 24440000=03036000= + VALUE 24445000=03036000= + BRANCH, 24450000=03036000= + FROM, 24455000=03036000= + TOWARDS; 24460000=03036000= + INTEGER 24465000=03037000= + BRANCH, 24470000=03037000= + FROM, 24475000=03037000= + TOWARDS; 24480000=03037000= + FORWARD; 24485000=03037000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24490000=03037000= + PROCEDURE VARIABLE(FROM); 24495000=03038000= + REAL 24500000=03038000= + FROM; 24505000=03038000= + FORWARD; 24510000=03038000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24515000=03038000= + PROCEDURE IMPFUN; 24520000=03039000= + FORWARD; 24525000=03039000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24530000=03039000= + PROCEDURE STREAMSTMT; 24535000=03040000= + FORWARD; 24540000=03040000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24545000=03040000= + PROCEDURE SEGMENTSTART; 24550000=03041000= + FORWARD; 24555000=03041000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24560000=03041000= + PROCEDURE SEGMENT(SIZE, NO, NOO); 24565000=03042000= + VALUE 24570000=03043000= + SIZE, 24575000=03043000= + NO, 24580000=03043000= + NOO; 24585000=03043000= + REAL 24590000=03044000= + SIZE, 24595000=03044000= + NO, 24600000=03044000= + NOO; 24605000=03044000= + FORWARD; 24610000=03045000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24615000=03045000= + INTEGER PROCEDURE BAE; 24620000=03046000= + FORWARD; 24625000=03046000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24630000=03046000= + REAL PROCEDURE PROGDESCBLDR(A, B, C); 24635000=03047000= + VALUE 24640000=03047000= + A, 24645000=03047000= + B, 24650000=03047000= + C; 24655000=03047000= + REAL 24660000=03047000= + A, 24665000=03047000= + B, 24670000=03047000= + C; 24675000=03047000= + FORWARD; 24680000=03047000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24685000=03047000= + PROCEDURE BANA; 24690000=03048000= + FORWARD; 24695000=03048000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24700000=03048000= + PROCEDURE EMITNUM(A); 24705000=03049000= + VALUE 24710000=03049000= + A; 24715000=03049000= + REAL 24720000=03049000= + A; 24725000=03049000= + FORWARD; 24730000=03049000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24735000=03049000= + PROCEDURE EMITD(A, B, T); 24740000=03050000= + VALUE 24745000=03050000= + A, 24750000=03050000= + B, 24755000=03050000= + T; 24760000=03050000= + INTEGER 24765000=03050000= + A, 24770000=03050000= + B, 24775000=03050000= + T; 24780000=03050000= + FORWARD; 24785000=03050000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24790000=03050000= + INTEGER PROCEDURE GETSPACE(S, L); 24795000=03051000= + VALUE 24800000=03051000= + S, 24805000=03051000= + L; 24810000=03051000= + INTEGER 24815000=03051001= + L; 24820000=03051001= + BOOLEAN 24825000=03051001= + S; 24830000=03051001= + FORWARD; 24835000=03051001= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24840000=03051001= + PROCEDURE FORSTMT; 24845000=03052000= + FORWARD; 24850000=03052000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24855000=03052000= + PROCEDURE F; 24860000=03054000= + FORWARD; 24865000=03054000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24870000=03054000= + PROCEDURE ENTRY(TYPE); 24875000=03055000= + VALUE 24880000=03055000= + TYPE; 24885000=03055000= + REAL 24890000=03055000= + TYPE; 24895000=03055000= + FORWARD; 24900000=03055000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24905000=03055000= + PROCEDURE FORMATGEN; 24910000=03056000= + FORWARD; 24915000=03056000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24920000=03056000= + PROCEDURE EXPLICITFORMAT; 24925000=03056100= + FORWARD; 24930000=03056100= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24935000=03056100= + BOOLEAN PROCEDURE FORMATPHRASE; 24940000=03056200= + FORWARD; 24945000=03056200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24950000=03056200= + PROCEDURE PUTNBUMP(P1); 24955000=03057000= + VALUE 24960000=03057000= + P1; 24965000=03057000= + REAL 24970000=03057000= + P1; 24975000=03057000= + FORWARD; 24980000=03057000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24985000=03057000= + PROCEDURE JUMPCHKNX; 24990000=03058000= + FORWARD; 24995000=03058000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25000000=03058000= + PROCEDURE JUMPCHKX; 25005000=03059000= + FORWARD; 25010000=03059000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25015000=03059000= + PROCEDURE DBLSTMT; 25020000=03060000= + FORWARD; 25025000=03060000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25030000=03060000= + PROCEDURE READSTMT; 25035000=03061000= + FORWARD; 25040000=03061000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25045000=03061000= + INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); 25050000=03061010= + VALUE 25055000=03061010= + N; 25060000=03061010= + REAL 25065000=03061010= + N; 25070000=03061010= + FORWARD; 25075000=03061010= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25080000=03061010= + PROCEDURE WRITESTMT; 25085000=03062000= + FORWARD; 25090000=03062000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25095000=03062000= + PROCEDURE SPACESTMT; 25100000=03063000= + FORWARD; 25105000=03063000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25110000=03063000= + PROCEDURE CLOSESTMT; 25115000=03064000= + FORWARD; 25120000=03064000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25125000=03064000= + PROCEDURE LOCKSTMT; 25130000=03065000= + FORWARD; 25135000=03065000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25140000=03065000= + PROCEDURE RWNDSTMT; 25145000=03066000= + FORWARD; 25150000=03066000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25155000=03066000= + PROCEDURE BLOCK(S); 25160000=03067000= + VALUE 25165000=03067000= + S; 25170000=03067000= + BOOLEAN 25175000=03067000= + S; 25180000=03067000= + FORWARD; 25185000=03067000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25190000=03067000= + PROCEDURE PURGE(STOPPER); 25195000=03068000= + VALUE 25200000=03068000= + STOPPER; 25205000=03068000= + REAL 25210000=03068000= + STOPPER; 25215000=03068000= + FORWARD; 25220000=03068000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25225000=03068000= + PROCEDURE ENTER(TYPEV); 25230000=03069000= + VALUE 25235000=03070000= + TYPEV; 25240000=03070000= + INTEGER 25245000=03071000= + TYPEV; 25250000=03071000= + FORWARD; 25255000=03071000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25260000=03071000= + INTEGER PROCEDURE PASSTYPE(P); 25265000=03074000= + VALUE 25270000=03074000= + P; 25275000=03074000= + REAL 25280000=03074000= + P; 25285000=03074000= + FORWARD; 25290000=03074000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25295000=03074000= + PROCEDURE PASSALPHA(P); 25300000=03075000= + VALUE 25305000=03075000= + P; 25310000=03075000= + REAL 25315000=03075000= + P; 25320000=03075000= + FORWARD; 25325000=03075000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25330000=03075000= + PROCEDURE LISTELEMENT; 25335000=03076000= + FORWARD; 25340000=03076000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25345000=03076000= + REAL PROCEDURE LISTGEN; 25350000=03077000= + FORWARD; 25355000=03077000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25360000=03077000= + PROCEDURE UNKNOWNSTMT; 25365000=03078000= + FORWARD; 25370000=03078000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25375000=03078000= + PROCEDURE FAULTSTMT; 25380000=03079000= + FORWARD; 25385000=03079000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25390000=03079000= + PROCEDURE FAULTDEC; 25395000=03080000= + FORWARD; 25400000=03080000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25405000=03080000= + PROCEDURE SORTSTMT; 25410000=03081000= + FORWARD; 25415000=03081000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25420000=03081000= + PROCEDURE MERGESTMT; 25425000=03082000= + FORWARD; 25430000=03082000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25435000=03082000= + PROCEDURE CASESTMT; 25440000=03083000= + FORWARD; 25445000=03083000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25450000=03083000= + PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 25455000=03084000= + FORWARD; 25460000=03084000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25465000=03084000= + ALPHA PROCEDURE BUGGER(S); 25470000=03100000= + VALUE 25475000=03100000= + S; 25480000=03100000= + INTEGER 25485000=03100000= + S; 25490000=03100000= + FORWARD; 25495000=03100000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25500000=03100000= + 25505000=04000000= + COMMENT THIS SECTION CONTAINS THE EMITTERS. THEY ARE THE AGENTS WHICH 25510000=04000000= + ACTUALLY PRODUCE CODE AND DEBUGING OUTPUT; 25515000=04001000= + 25520000=04002000= + COMMENT EMITL EMITS A LIT CALL; 25525000=04002000= + PROCEDURE EMITL(LITERAL); 25530000=04003000= + VALUE 25535000=04003000= + LITERAL; 25540000=04003000= + INTEGER 25545000=04003000= + LITERAL; 25550000=04003000= + EMIT(0 & LITERAL[36:38:10]); 25555000=04004000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25560000=04004000= + 25565000=04005000= + COMMENT EMITO EMIT AN OPERATOR; 25570000=04005000= + PROCEDURE EMITO(OPERATOR); 25575000=04006000= + VALUE 25580000=04006000= + OPERATOR; 25585000=04006000= + INTEGER 25590000=04006000= + OPERATOR; 25595000=04006000= + EMIT(1 & OPERATOR[36:38:10]); 25600000=04007000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25605000=04007000= + 25610000=04008000= + COMMENT EMITC IS PRIMARILY FOR USE BY STRMSTMT TO EMIT CHARACTER MODE 25615000=04008000= + OPERATORS. HOWEVER IT ALSO HANDLES DIA, DIB, AND TRB; 25620000=04009000= + PROCEDURE EMITC(REPEAT, OPERATOR); 25625000=04010000= + VALUE 25630000=04010000= + REPEAT, 25635000=04010000= + OPERATOR; 25640000=04010000= + INTEGER 25645000=04011000= + REPEAT, 25650000=04011000= + OPERATOR; 25655000=04011000= + BEGIN 25660000=04012000= + IF REPEAT >= 64 THEN 25665000=04013000= + FLAG(268); 25670000=04013000= + EMIT(OPERATOR & REPEAT[36:42:6]) 25675000=04014000= + END EMITC; 25680000=04014000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25685000=04014000= + 25690000=04015000= + COMMENT EMITV EMITS AN OPERAND CALL. IF THE ADDRESS IS FOR THE SECOND 25695000=04015000= + HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 25700000=04016000= + PROCEDURE EMITV(ADDRESS); 25705000=04017000= + VALUE 25710000=04017000= + ADDRESS; 25715000=04017000= + INTEGER 25720000=04017000= + ADDRESS; 25725000=04017000= + BEGIN 25730000=04018000= + IF ADDRESS > 1023 THEN 25735000=04018000= + EMITO(PRTE); 25740000=04018000= + EMIT(2 & ADDRESS[36:38:10]) 25745000=04019000= + END EMITV; 25750000=04019000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25755000=04019000= + 25760000=04020000= + COMMENT EMITN EMITS A DESCRIPTOR CALL. IF THE ADDRESS IS FOR THE 25765000=04020000= + SECOND HALF OF THE PRT, THEN IT ALSO EMITS A PRTE; 25770000=04021000= + PROCEDURE EMITN(ADDRESS); 25775000=04022000= + VALUE 25780000=04022000= + ADDRESS; 25785000=04022000= + INTEGER 25790000=04022000= + ADDRESS; 25795000=04022000= + BEGIN 25800000=04023000= + IF ADDRESS > 1023 THEN 25805000=04023000= + EMITO(PRTE); 25810000=04023000= + EMIT(3 & ADDRESS[36:38:10] 25815000=04024000= + END EMITN; 25820000=04024000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25825000=04024000= + 25830000=04025000= + COMMENT EMITPAIR EMITS A LITC ADDRESS FOLLOWED BY OPERATOR. IF THE 25835000=04025000= + ADDRESS IS FOR THE SECOND HALF OF THE PRT, THEN IT ALSO 25840000=04026000= + EMITS PRTE; 25845000=04027000= + PROCEDURE EMITPAIR(ADDRESS, OPERATOR); 25850000=04028000= + VALUE 25855000=04029000= + ADDRESS, 25860000=04029000= + OPERATOR; 25865000=04029000= + INTEGER 25870000=04030000= + ADDRESS, 25875000=04030000= + OPERATOR; 25880000=04030000= + BEGIN 25885000=04031000= + EMITL(ADDRESS); 25890000=04032000= + IF ADDRESS > 1023 THEN 25895000=04033000= + EMITO(PRTE); 25900000=04033000= + EMITO(OPERATOR) 25905000=04034000= + END EMITPAIR; 25910000=04034000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%25915000=04034000= + 25920000=04035000= + COMMENT EMITUP IS RESPONSIBLE FOR COMPILING THE CODE TO RAISE AN 25925000=04035000= + EXPRESSION TO SOME POWER IF THE EXPONENT IS A LITERAL 25930000=04036000= + OR A NEGATIVE LITERAL THEN IN LINE CODE IS COMPILED. THIS25935000=04037000= + CODE CONSISTS OF A SERIES OF DUPS AND MULS, AS WITH 25940000=04038000= + EMITLNG CARE MUST BE TAKEN TO AVOID CONFUSION WITH LINKS 25945000=04039000= + AND CONDITIONAL EXPRESSIONS. IF THESE SPECIAL CASES DO 25950000=04040000= + NOT HOLD, THEN A CALL ON AN INTRINSIC PROCEDURE, XTOTHEI, 25955000=04041000= + IS CONSTRUCTED. XTOTHEI PRODUCES A SERIES OF MULTIPLIES 25960000=04042000= + (APPROXIMATELY LN I MULTIPLIES) IF I IS AN INTEGER. 25965000=04043000= + OTHERWISE IT CALLS LN AND EXP; 25970000=04044000= + PROCEDURE EMITUP; 25975000=04045000= + BEGIN 25980000=04046000= + INTEGER 25985000=04046000= + BACKUP, 25990000=04046000= + CTR; 25995000=04046000= + LABEL 26000000=04047000= + E; 26005000=04047000= + IF NOT LINKTOG THEN 26010000=04048000= + GO TO E; 26015000=04048000= + COMMENT CALL XTOTHEI IF LAST THING IS LINK; 26020000=04049000= + IF GET(L-1) = 537 THEN 26025000=04050000= + COMMENT LAST OPERATOR IS CHS; 26030000=04051000= + BEGIN 26035000=04052000= + BACKUP:= 1; 26040000=04052000= + L:= L-1 26045000=04052000= + END; 26050000=04052000= + IF (GT4:= GET(L-1)).[46:2] = 0 THEN 26055000=04054000= + BEGIN 26060000=04054000= + COMMENT IT IS A LITERAL; 26065000=04055000= + BACKUP:= BACKUP+1; 26070000=04056000= + L:= L-1; 26075000=04056000= + IF GET(L-1).[39:9] = 153 THEN 26080000=04057000= + GO TO E; 26085000=04057000= + COMMENT CALL XTOTHE IF THE LAST OPERATOR IS A BRANCH; 26090000=04058000= + CTR:= 1; 26095000=04059000= + GT4:= GT4 DIV 4; 26100000=04059000= + WHILE GT4 DIV 2 ^= 0 DO 26105000=04061000= + BEGIN 26110000=04061000= + EMITO(DUP); 26115000=04062000= + IF BOOLEAN(GT4) THEN 26120000=04063000= + BEGIN 26125000=04063000= + CTR:= CTR+1; 26130000=04063000= + EMITO(DUP) 26135000=04063000= + END; 26140000=04063000= + EMITO(MUL); 26145000=04064000= + GT4:= GT4 DIV 2 26150000=04065000= + END; 26155000=04065000= + IF GT4 = 0 THEN 26160000=04066000= + BEGIN 26165000=04066000= + EMITO(DEL); 26170000=04066000= + EMITL(1) 26175000=04066000= + END 26180000=04067000= + ELSE 26185000=04067000= + WHILE CTR:= CTR-1 ^= 0 DO 26190000=04067000= + EMITO(MUL); 26195000=04067000= + IF BACKUP = 2 THEN 26200000=04069000= + BEGIN 26205000=04069000= + EMITL(1); 26210000=04070000= + EMITO(XCH); 26215000=04071000= + EMITO(128) 26220000=04072000= + END 26225000=04073000= + END 26230000=04073000= + ELSE 26235000=04073000= + BEGIN 26240000=04073000= + E: L:= L+BACKUP; 26245000=04074000= + EMITO(MKS); 26250000=04075000= + EMITPAIR(GNAT(LOGI), LOD); 26255000=04076000= + EMITPAIR(GNAT(EXPI), LOD); 26260000=04077000= + EMITV(GNAT(XTOTHEI)); 26265000=04078000= + STACKCT:= 0; 26270000=04078500= + EMITO(DEL) 26275000=04079000= + END 26280000=04079000= + END EMITUP; 26285000=04079000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%26290000=04079000= + 26295000=04080000= + COMMENT ADJUST ADJUST L TO THE BEGINING OF A WORD AND FILLS IN THE 26300000=04080000= + INERVENING SPACE WITH NOPS, IT CHECKS STREAMTOG TO DECIDE 26305000=04081000= + WHICH SORT OF NOP TO USE; 26310000=04082000= + PROCEDURE ADJUST; 26315000=04083000= + BEGIN 26320000=04084000= + DIALA:= DIALB:= 0; 26325000=04085000= + WHILE L.[46:2] ^= 0 DO 26330000=04086000= + EMIT(IF STREAMTOG THEN 1 ELSE 45) 26335000=04087000= + END ADJUST; 26340000=04087000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%26345000=04087000= + 26350000=04088000= + COMMENT EMITLNG CHANGES A RELATIONAL FOLLOWED BY A NEGATE TO THE 26355000=04088000= + NEGATED RELATIONAL. IT ALSO CHANGES A NEGATE FOLLOWED 26360000=04089000= + BY A NEGATE TO NOTHING. CARE MUST BE EXERCIZED. A LINK 26365000=04090000= + (FOR CONSTANT TO BE EMITTED LATER) MIGHT LOOK LIKE AN LNG 26370000=04091000= + OR A RELATIONAL OPERATOR. THIS IS THE USE OF LINKTOG. 26375000=04092000= + ALSO A CONSTRUCT AS NOT ( IF B THEN X=Y ELSE Y=Z) 26380000=04093000= + COULD GIVE TROUBLE. THIS IS THE MEANING OF THE OBSCURE 26385000=04094000= + EMITS FOLLOWED BY L ~ L-1 FOUND IN IFEXP, BOOSEC, BOOCOMP,26390000=04095000= + AND RELATION - THAT CODE SERVES TO SET A FLAG FOR USE BY 26395000=04096000= + EMITLNG; 26400000=04097000= + PROCEDURE EMITLNG; 26405000=04098000= + BEGIN 26410000=04099000= + LABEL 26415000=04099000= + E; 26420000=04099000= + IF NOT LINKTOG THEN 26425000=04100000= + GO TO E; 26430000=04100000= + COMMENT GO TO E IF LAST THING IS A LINK; 26435000=04101000= + IF GET(L) ^= 0 THEN 26440000=04102000= + GO TO E; 26445000=04102000= + COMMENT EITHER LAST EXPRESSION WAS CONDITIONAL OR THERE IS NO 26450000=04103000= + LNG OR RELATIONAL OPERATOR; 26455000=04104000= + IF GT1:= GET(L-1) = 77 THEN 26460000=04105000= + L:= L-1 26465000=04106000= + COMMENT LAST THING WAS AN LNG - SO CANCEL IT; 26470000=04106000= + ELSE 26475000=04107000= + IF GT1.[42:6] = 21 AND GT1.[37:2] = 0 THEN % AHA 26480000=04107000= + COMMENT LAST THING WAS A RELATIONAL; 26485000=04108000= + BEGIN 26490000=04109000= + L:= L-1; 26495000=04109000= + EMITO(REAL(BOOLEAN(GT1.[36:10]) EQV 26500000=04111000= + BOOLEAN(IF GT1.[40:2] = 0 THEN 511 ELSE 463))) 26505000=04111000= + COMMENT NEGATE THE RELATIONAL; 26510000=04111000= + END 26515000=04112000= + ELSE 26520000=04112000= + E: EMITO(LNG) 26525000=04112000= + END EMITLNG; 26530000=04112000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%26535000=04112000= + COMMENT EMITB EMITS A BRANCH OPERATOR AND ITS ASSOCIATED NUMBER; 26540000=04113000= + PROCEDURE EMITB(BRANCH, FROM, TOWARDS); 26545000=04114000= + VALUE 26550000=04115000= + BRANCH, 26555000=04115000= + FROM, 26560000=04115000= + TOWARDS; 26565000=04115000= + INTEGER 26570000=04116000= + BRANCH, 26575000=04116000= + FROM, 26580000=04116000= + TOWARDS; 26585000=04116000= + BEGIN 26590000=04117000= + INTEGER 26595000=04118000= + TL; 26600000=04118000= + TL:= L; 26605000=04119000= + L:= FROM-2; 26610000=04120000= + GT1:= TOWARDS-FROM; 26615000=04120100= + IF TOWARDS.[46:2] = 0 THEN 26620000=04120300= + BEGIN 26625000=04120300= + BRANCH:= BRANCH & 1[39:47:1]; 26630000=04120400= + GT1:= TOWARDS DIV 4-(FROM-1) DIV 4 26635000=04120500= + END; 26640000=04120500= + EMITNUM(ABS(GT1)); 26645000=04121000= + EMITO(BRANCH & (REAL(GT1 >= 0)+1)[42:46:2]); 26650000=04122000= + IF BOOLEAN(BRANCH.[38:1]) THEN 26655000=04123000= + DIALA:= DIALB:= 0; 26660000=04123000= + L:= TL; 26665000=04124000= + END EMITB; 26670000=04125000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%26675000=04125000= + COMMENT DEBUGWORD FORMATS TWO FIELDS FOR DEBUGGING OUTPUT IN 26680000=04126000= + OCTAL, NAMELY : 26685000=04127000= + 1. 4 CHARACTERS FOR THE L REGISTER. 26690000=04128000= + 2.16 CHARACTERS FOR THE WORD BEING EMITTED. ; 26695000=04129000= + STREAM PROCEDURE DEBUGWORD(SFQ, CODE, FEIL); 26700000=04130000= + VALUE 26705000=04130000= + SEQ, 26710000=04130000= + CODE; 26715000=04130000= + BEGIN 26720000=04131000= + DI:= FEIL; 26725000=04132000= + SI:= LOC SEQ; 26730000=04132000= + SI:= SI+4; 26735000=04132000= + DS:= 4 CHR; 26740000=04132000= + DS:= 2 LIT 6" "; 26745000=04133000= + SI:= LOC CODE; 26750000=04134000= + (DS:= 3 RESET;3(IF SB THEN DS:= SET ELSE DS:= RESET;SKIP 1 SB)); 26755000=04136000= + 49(DS:= 2 LIT 6" "); 26760000=04137000= + END; 26765000=04138000= + COMMENT EMITWORD PLACES THE PARAMETER,"WORD",INTO EDOC. IF 26770000=04139000= + DEBUGGING IS REQUIRED. "L" AND "WORD" ARE OUTPUT ON 26775000=04140000= + THE PRINTER FILE IN OCTAL FORMAT. ; 26780000=04141000= + PROCEDURE EMITWORD(WORD); 26785000=04142000= + VALUE 26790000=04142000= + WORD; 26795000=04142000= + REAL 26800000=04142000= + WORD; 26805000=04142000= + BEGIN 26810000=04143000= + ADJUST; 26815000=04144000= + IF L >= 4092 THEN 26820000=04145000= + ERR(200); 26825000=04145000= + ELSE 26830000=04146000= + BEGIN 26835000=04146000= + MOVE(1, WORD, EDOC[L.[36:3], L.[39:7]]); 26840000=04147000= + IF DEBUGTOG THEN 26845000=04148000= + BEGIN 26850000=04149000= + DEBUGWORD(B2D(L), WORD, LIN); 26855000=04149000= + WRITELINE 26860000=04150000= + END; 26865000=04150000= + L:= L+4 26870000=04151000= + END 26875000=04152000= + END EMITWORD; 26880000=04152000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%26885000=04152000= + COMMENT CONSTANTCLEAN IS CALLED AFTER AN UNCONDITIONAL BRANCH HAS 26890000=04153000= + BEEN EMITTED. IF ANY CONSTANTS HAVE BEEN ACCUMULATED BY 26895000=04154000= + EMITNUM IN INFO[0,*], CONSTANTCLEAN WILL FIX THE CHAIN 26900000=04155000= + OF C-RELATIVE OPDC S LEFT BY EMITNUM, IF C-RELATIVE 26905000=04156000= + ADDRESSING IS IMPOSSIBLE (I.E. THE ADDRESS 26910000=04157000= + IF GREATER THAN 127 WORDS) THEN THE CONSTANT ALONG WITH 26915000=04158000= + THE 1ST LINK OF THE OPDC CHAIN IS ENTERED IN INFO. 26920000=04159000= + AT PURGE TIME THE REMAINING OPDC S ARE EMITTED WITH 26925000=04160000= + F -RELATIVE ADDRESSING AND CODE EMITTED TO STORE THE 26930000=04161000= + CONSTANTS INTO THE PROPER F-RELATIVE CELLS. ; 26935000=04162000= + PROCEDURE CONSTANTCLEAN; 26940000=04163000= + IF MRCLEAN THEN 26945000=04164000= + BEGIN 26950000=04165000= + INTEGER 26955000=04166000= + J, 26960000=04166000= + TEMPL, 26965000=04166000= + D, 26970000=04166000= + LINK; 26975000=04166000= + BOOLEAN 26980000=04167000= + CREL; 26985000=04167000= + LABEL 26990000=04168000= + ALLTHU; 26995000=04168000= + DIALA:= DIALB:= 0; 27000000=04169000= + FOR J:= 1 STEP 2 UNTIL LASTENTRY DO 27005000=04170000= + BEGIN 27010000=04171000= + ADJUST; 27015000=04172000= + TEMPL:= L; 27020000=04172000= + L:= INFO[0, 255-J+1]; 27025000=04172000= + CREL:= FALSE; 27030000=04173000= + DO BEGIN 27035000=04174000= + IF D:= (TEMPL-L+3) DIV 4 >= 128 THEN 27040000=04175000= + BEGIN 27045000=04176000= + NCII:= NCII+1; 27050000=04177000= + PUTNBUMP 27055000=04178000= + (L & NONLITNO[2:41:7] & (NEXTINFO-LASTINFO)[27:40:8]); 27060000=04178000= + PUTNBUMP(TAKE(255-J)); 27065000=04179000= + LASTINFO:= NEXTINFO-2; 27070000=04179000= + GO TO ALLTHU; 27075000=04180000= + END; 27080000=04181000= + LINK:= GET(L); 27085000=04182000= + CREL:= TRUE; 27090000=04183000= + EMITV(D+768); 27095000=04184000= + END 27100000=04185000= + UNTIL L:= LINK = 4095; 27105000=04185000= + ALLTHU: 27110000=04186000= + L:= TEMPL; 27115000=04186000= + IF CREL THEN 27120000=04187000= + EMITWORD(INFO[0, 255-J]); 27125000=04187000= + END; 27130000=04188000= + LASTENTRY:= 0; 27135000=04189000= + END; 27140000=04190000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27145000=04190000= + COMMENT EMITNUM HANDLES THE EMISSION OF CODE FOR CONSTANTS,BOTH 27150000=04191000= + EXPLICIT AND IMPLICIT, IN EVERY CASE,EMITNUM WILL 27155000=04192000= + PRODUCE CODE TO GET THE DESIRED CONSTANT ON TOP OF 27160000=04193000= + THE STACK. IF THE NUMBER IS A LITERAL A SIMPLE LITC 27165000=04194000= + SYLLABLE IS PRODUCED, HOWEVER,NON-LITERALS ARE KEPT 27170000=04195000= + IN THE ZERO-TH ROW OF INFO WITH THE SYLLABLE 27175000=04196000= + POSITION,L. THE FIRST EMITNUM ON A PARTICULAR 27180000=04197000= + CONSTANT CAUSES THE VALUES OF L AND THE CONSTANT 27185000=04198000= + TO BE STORED IN INFO[0,*] (NOTE:ITEMS ARE STORED 27190000=04199000= + IN REVERSE STARTING WITH INFO[0,255],ETC.). THEN 27195000=04200000= + ITS THE JOB OF CONSTANTCLEAN TO EMIT THE ACTUAL 27200000=04201000= + OPDC (SEE CONSTANTCLEAN PROCEDURE FOR DETAILS) ; 27205000=04202000= + PROCEDURE EMITNUM(C); 27210000=04203000= + VALUE 27215000=04203000= + C; 27220000=04203000= + REAL 27225000=04203000= + C; 27230000=04203000= + BEGIN 27235000=04204000= + LABEL 27240000=04204000= + FINISHED, 27245000=04204000= + FOUND; 27250000=04204000= + REAL 27255000=04204000= + N; 27260000=04204000= + IF C.[1:37] = 0 THEN 27265000=04205000= + EMITL(C) 27270000=04206000= + ELSE 27275000=04206000= + BEGIN 27280000=04207000= + FOR N:= 1 STEP 2 UNTIL LASTENTRY DO 27285000=04208000= + IF INFO[0, 255-N] = C THEN 27290000=04209000= + GO TO FOUND; 27295000=04209000= + INFO[0, 255-LASTENTRY]:= L; 27300000=04210000= + INFO[0, 255-LASTENTRY-1]:= C; 27305000=04211000= + EMITN(1023); 27310000=04212000= + LINKTOG:= FALSE; 27315000=04213000= + IF LASTENTRY:= LASTENTRY+2 >= 128 THEN 27320000=04214000= + BEGIN 27325000=04215000= + C:= BUMPL; 27330000=04216000= + CONSTANTCLEAN; 27335000=04217000= + EMITB(BFW, C, L); 27340000=04218000= + END; 27345000=04219000= + GO TO FINISHED; 27350000=04220000= + FOUND: 27355000=04221000= + EMIT(INFO[0, 255-N+1]); 27360000=04221000= + LINKTOG:= FALSE; 27365000=04222000= + INFO[0, 255-N+1]:= L-1; 27370000=04223000= + END; 27375000=04224000= +FINSIHED: 27380000=04225000= + END EMITNUM; 27385000=04225000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27390000=04225000= + COMMENT SEARCH PERFORMS A BINARY SEARCH ON THE COP AND WOP 27395000=04226000= + ARRAYS, GIVEN THE OPERATOR BITS SEARCH YIELDS THE BCD 27400000=04227000= + MNEUMONIC FOR THAT OPERATOR. IF THE OPERATOR CANNOT 27405000=04228000= + BE FOUND SEARCH YIELDS BLANKS. 27410000=04229000= + NOTE: DIA,DIB,TRB ARE RETURNED AS BLANKS. ; 27415000=04230000= + ALPHA PROCEDURE SEARCH(Q, KEY); 27420000=04231000= + VALUE 27425000=04231000= + KEY; 27430000=04231000= + ARRAY 27435000=04231000= + Q[0]; 27440000=04231000= + REAL 27445000=04231000= + KEY; 27450000=04231000= + BEGIN 27455000=04232000= + LABEL 27460000=04232000= + L; 27465000=04232000= + COMMENT GT1 AND GT2 ARE INITIALIZED ASSUMMING THAT Q IS ORDERED 27470000=04233000= + BY PAIRS (ARGUMENT,FUNCTION,ARGUMENT,FUNCTION,ETC.) 27475000=04234000= + AND THAT THE FIRST ARGUMENT IS IN Q[4]. FURTHERMORE 27480000=04235000= + THE LENGTH OF Q IS 128. ; 27485000=04236000= + INTEGER 27490000=04237000= + N, 27495000=04237000= + I; 27500000=04237000= + N:= 64; 27505000=04238000= + FOR I:= 66 STEP IF Q[I] < KEY THEN 27510000=04239000= + N 27515000=04239000= + ELSE 27520000=04239000= + -N WHILE N:= N DIV 2 >= 1 27525000=04240000= + DO 27530000=04240000= + IF Q[I] = KEY THEN 27535000=04241000= + GO TO L; 27540000=04241000= + I:= 0; 27545000=04242000= + COMMENT ARGUMENT NOT FOUND,SEARCH=Q[1] ; 27550000=04242000= +L: SEARCH:= Q[I+1]; 27555000=04243000= + END SEARCH; 27560000=04244000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27565000=04244000= + COMMENT B2D CONVERTS THE FOUR LOW ORDER OCTAL DIGITS TO BCD 27570000=04245000= + CODE ; 27575000=04246000= + ALPHA PROCEDURE B2D(B); 27580000=04247000= + VALUE 27585000=04247000= + B; 27590000=04247000= + REAL 27595000=04247000= + B; 27600000=04247000= + B2D:= 0 & B[45:45:3] & B[39:42:3] & B[33:39:3] & B[27:36:3]; 27605000=04248000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27610000=04248000= + COMMENT PACK IS A STREAM PROCEDURE WHICH INSERTS THE SYLLABLE 27615000=04265000= + INTO THE EDOC ARRAY. THE SPECIFIC ELEMENT OF EDOC 27620000=04266000= + IS PRECISILY = EDOC[(L DIV 4) DIV 128,(< DIV 4)MOD 128] 27625000=04267000= + SYLLABLE POSITION=(L MOD 4 ). WHERE L IS THE SYLLABLE 27630000=04268000= + NUMBER RELATIVE TO THE BEGINNING OF THE SEGMENT; 27635000=04269000= + STREAM PROCEDURE PACK(WORD, POSITION, SYLLABLE); 27640000=04270000= + VALUE 27645000=04271000= + POSITION, 27650000=04271000= + SYLLABLE; 27655000=04271000= + BEGIN 27660000=04272000= + DI:= WORD; 27665000=04273000= + DI:= DI+POSITION; 27670000=04273000= + DI:= DI:= POSITION; 27675000=04273000= + SI:= LOC SYLLABLE; 27680000=04274000= + SI:= SI+6; 27685000=04274000= + DS:= 2 CHR; 27690000=04275000= + END PACK; 27695000=04276000= + PROCEDURE DEBUG(S); 27700000=04277000= + VALUE 27705000=04278000= + S; 27710000=04278000= + REAL 27715000=04278000= + S; 27720000=04278000= + IF STREAMTOG THEN 27725000=04279000= + IF SINGLTOG THEN 27730000=04279100= + WRITE 27735000=04279200= + (LINE, BUG, B2D(L), COP[S.[42:6]], B2D(S.[36:6]), B2D(S))27740000=04279200= + ; 27745000=04279200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27750000=04279200= + ELSE 27755000=04280000= + WRITE 27760000=04281000= + (LINE[DBL], BUG, B2D(L), COP[S.[42:6], B2D(S.[36:6]), B2D(S)) 27765000=04283000= + ELSE 27770000=04283000= + IF SINGLTOG THEN 27775000=04284100= + WRITE(LINE, BUG, B2D(L), 27780000=04284500= + IF T1:= S.[46:2] = 1 THEN BUGGER(S.[36:10]) ELSE WOP[T1], IF T1 = 27785000=04284500= + 1 THEN WOP[1] ELSE B2D(S.[36:10]), B2D(S)) 27790000=04284500= + ELSE 27795000=04284500= + WRITE(LINE[DBL], BUG, B2D(L), 27800000=04287000= + IF T1:= S.[46:2] = 1 THEN BUGGER(S.[36:10]) ELSE WOP[T1], IF T1 = 27805000=04287000= + 1 THEN WOP[1] ELSE B2D(S.[36:10]), B2D(S)); 27810000=04287000= + COMMENT EMIT PLACES SYLLABLES INTO EDOC, CALLS DEBUG FOR 27815000=04288000= + DEBUGGING OUTPUT ON THE PRINTER, AND CHECKS FOR SEGMENTS 27820000=04289000= + GREATER THAN 4093 SYLLABLES. ; 27825000=04290000= + PROCEDURE EMIT(S); 27830000=04291000= + VALUE 27835000=04291000= + S; 27840000=04291000= + REAL 27845000=04291000= + S; 27850000=04291000= + BEGIN 27855000=04292000= + IF L < 4092 THEN 27860000=04293000= + BEGIN 27865000=04294000= + LINKTOG:= TRUE; 27870000=04295000= + PACK(EDOC[L.[36:3], L.[39:7]], L.[46:2], S); 27875000=04296000= + IF DEBUGTOG THEN 27880000=04297000= + DEBUG(S); 27885000=04297000= + L:= L+1; 27890000=04298000= + END 27895000=04300000= + ELSE 27900000=04300000= + ERR(200) 27905000=04301000= + COMMENT 200 EMIT - SEGMENT GREATER THAN 4093 SYLLABLES *; 27910000=04301000= + END EMIT; 27915000=04302000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%27920000=04302000= + COMMENT THE PRINCIPLE FUNCTION OF DEBUG IS TO COMPUTER THE PROPER 27925000=04303000= + PARAMETERS FOR STREAM PROCEDURE BUG; 27930000=04304000= + COMMENT EMITD EMITS THE DIA,DIB,TRB SEQUENCE OF CODE. THE 27935000=04305000= + PREVIOUS SETTING OF THE G-H AND K-V REGISTERS IS COMPARED 27940000=04306000= + THE CURRENT . IF THE G-H,K-V OR BOTH ARE ALREADY SET THEN 27945000=04307000= + THE APPROIATE SYLLABLES(S) ARE OMITTED 27950000=04308000= + IF 0 BITS ARE TO BE TRANSFERED THEN NO SYLLABLES ARE 27955000=04309000= + EMITTED ; 27960000=04310000= + PROCEDURE EMITD(A, B, T); 27965000=04311000= + VALUE 27970000=04311000= + A, 27975000=04311000= + B, 27980000=04311000= + T; 27985000=04311000= + INTEGER 27990000=04311000= + A, 27995000=04311000= + B, 28000000=04311000= + T; 28005000=04311000= + BEGIN 28010000=04311010= + LABEL 28015000=04311010= + EXIT, 28020000=04311010= + NORMAL; 28025000=04311010= + REAL 28030000=04311020= + Q; 28035000=04311020= + IF T = 15 THEN 28040000=04311030= + BEGIN 28045000=04311040= + IF A = 33 THEN 28050000=04311050= + Q:= 512 28055000=04311060= + ELSE 28060000=04311060= + IF A ^= 18 THEN 28065000=04311060= + GO TO NORMAL; 28070000=04311060= + IF B = 18 THEN 28075000=04311070= + Q:= Q+256 28080000=04311080= + ELSE 28085000=04311080= + IF B ^= 33 THEN 28090000=04311080= + GO TO NORMAL; 28095000=04311080= + EMITO(Q+197); 28100000=04311090= + COMMENT -- THIS GETS OUT FIXED FIELD; 28105000=04311090= + GO TO EXIT; 28110000=04311100= + END; 28115000=04311110= +NORMAL: 28120000=04312000= + IF T ^= 0 THEN 28125000=04312000= + BEGIN 28130000=04313000= + IF DIALA ^= A THEN 28135000=04314000= + EMIT((DIALA:= A) DIV 6)*512+(A:= A MOD 6)*64+DIA); 28140000=04315000= + IF DIALB ^= B THEN 28145000=04316000= + EMIT((DIALB:= B) DIV 6)*512+(B:= B MOD 6)*64+DIB); 28150000=04317000= + EMIT(TRB+64*T); 28155000=04318000= + DIALA:= DIALB:= 0; 28160000=04319000= + COMMENT THE PRECEEDING STATEMENT CAN BE REMOVED FOR OPTIMIZING 28165000=04320000= + G-H AND K-V REGISTERS, OTHERWISE NO OPTIMIZING OCCURS; 28170000=04321000= + END EMITD; 28175000=04322000= +EXIT: 28180000=04322100= + END; 28185000=04322100= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28190000=04322100= + PROCEDURE EMITI(E, A, B); 28195000=04500000= + VALUE 28200000=04500000= + E, 28205000=04500000= + A, 28210000=04500000= + B; 28215000=04500000= + REAL 28220000=04500000= + E, 28225000=04500000= + A, 28230000=04500000= + B; 28235000=04500000= + BEGIN 28240000=04501000= + LABEL 28245000=04501000= + EXIT, 28250000=04501000= + IS; 28255000=04501000= + INTEGER 28260000=04502000= + S, 28265000=04502000= + T1, 28270000=04502000= + T2; 28275000=04502000= + PROCEDURE EMIT21(E, B); 28280000=04503000= + VALUE 28285000=04503000= + E, 28290000=04503000= + B; 28295000=04503000= + REAL 28300000=04504000= + E; 28305000=04504000= + BOOLEAN 28310000=04505000= + B; 28315000=04505000= + BEGIN 28320000=04506000= + IF E = 0 THEN 28325000=04506000= + BEGIN 28330000=04507000= + IF B THEN 28335000=04507000= + EMITO(XCH); 28340000=04507000= + END 28345000=04508000= + ELSE 28350000=04508000= + BEGIN 28355000=04508000= + GT1:= E.ADDRESS; 28360000=04508000= + IF E:= E.CLASS <= INTID THEN 28365000=04509000= + EMITV(GT1) 28370000=04522000= + ELSE 28375000=04522000= + IF E <= INTARRAYID THEN 28380000=04522000= + EMITPAIR(GT1, LOD) 28385000=04523000= + ELSE 28390000=04523000= + EMITN(GT1) 28395000=04525000= + END 28400000=04526000= + END; 28405000=04526000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28410000=04526000= + IF B = 0 THEN 28415000=04526100= + BEGIN 28420000=04526200= + EMIT21(E, FALSE); 28425000=04526200= + GO TO EXIT 28430000=04526200= + END; 28435000=04526200= + IF STACK ^= 0 THEN 28440000=04527000= + GO TO IS; 28445000=04527000= + IF B = 15 THEN 28450000=04528000= + BEGIN 28455000=04529000= + IF A = 33 THEN 28460000=04529000= + BEGIN 28465000=04530000= + EMIT21(E, FALSE); 28470000=04530000= + EMIT(0); 28475000=04531000= + EMITO(INX); 28480000=04531000= + GO TO EXIT; 28485000=04532000= + END; 28490000=04533000= + IF A = 18 THEN 28495000=04534000= + BEGIN 28500000=04535000= + EMIT(0); 28505000=04535000= + EMIT21(E, TRUE); 28510000=04536000= + EMITO(197); 28515000=04537000= + GO TO EXIT; 28520000=04538000= + END; 28525000=04539000= + GO TO IS; 28530000=04540000= + END; 28535000=04541000= + IF B <= 10 AND A+B = 48 THEN 28540000=04542000= + BEGIN 28545000=04543000= + EMIT21(E, FALSE); 28550000=04543000= + EMITL(2**B-1); 28555000=04544000= + EMITO(LND); 28560000=04545000= + GO TO EXIT; 28565000=04546000= + END; 28570000=04547000= +IS: IF(S:= (48-A-B) MOD 6)+B <= 39 THEN 28575000=04548000= + BEGIN 28580000=04549000= + EMIT21(E, FALSE); 28585000=04549000= + EMIT(T2:= (T1:= A DIV 6)*512+(A MOD 6)*64+DIA); 28590000=04550000= + EMIT((A+B-1) DIV 6-T1+1)*512+64*S+37); 28595000=04551000= + GO TO EXIT; 28600000=04552000= + END; 28605000=04553000= + EMIT(0); 28610000=04554000= + EMIT21(E, TRUE); 28615000=04555000= + EMITD(A, 48-B, B); 28620000=04556000= +EXIT: 28625000=04558000= + END; 28630000=04558000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28635000=04558000= + ALPHA PROCEDURE BUGGER(OP); 28640000=04600000= + VALUE 28645000=04600000= + OP; 28650000=04600000= + INTEGER 28655000=04600000= + OP; 28660000=04600000= + BEGIN 28665000=04601000= + INTEGER 28670000=04601000= + Q; 28675000=04601000= + WOP[1]:= 6" "; 28680000=04602000= + IF BUGGER:= SEARCH(WOP, OP) = 6" " THEN 28685000=04603000= + IF Q:= OP.[44:4] >= 9 THEN 28690000=04604000= + BEGIN 28695000=04605000= + BUGGER:= POP[IF Q ^= 10 THEN Q-5 ELSE OP.[42:2]]; 28700000=04605000= + WOP[1]:= (IF Q = 10 THEN OP.[39:3] & OP[41:38:1] ELSE OP.[41:3] 28705000=04607000= + & OP[39:38:3]) & 6" "[24:36:12]; 28710000=04607000= + END; 28715000=04608000= + END BUGGER; 28720000=04608000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28725000=04608000= + PROCEDURE CHECKDISJOINT(A); 28730000=04609000= + VALUE 28735000=04609000= + A; 28740000=04609000= + INTEGER 28745000=04609000= + A; 28750000=04609000= + BEGIN 28755000=04610000= + IF LEVEL > SUBLEVEL+1 THEN 28760000=04611000= + BEGIN 28765000=04612000= + EMIT(0); 28770000=04613000= + EMITPAIR(A, STD); 28775000=04614000= + END; 28780000=04615000= + EMITN(A); 28785000=04616000= + END CHECKDISJOINT; 28790000=04617000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28795000=04617000= + 28800000=05000000= + COMMENT THIS SECTION CONTAINS MISCELLANEOUS SERVICE ROUTINES; 28805000=05000000= + 28810000=05001000= + COMMENT STEPI AND STEPIT ARE SHORT CALLS ON TABLE; 28815000=05001000= + PROCEDURE STEPIT; 28820000=05002000= + ELCASS:= TABLE(I:= I+1); 28825000=05002000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28830000=05002000= + INTEGER PROCEDURE STEPI; 28835000=05003000= + STEPI:= ELCLASS:= TABLE(I:= I+1); 28840000=05003000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28845000=05003000= + 28850000=05004000= + COMMENT TAKE FETCHS A WORD FROM INFO; 28855000=05004000= + REAL PROCEDURE TAKE(INDEX); 28860000=05005000= + VALUE 28865000=05005000= + INDEX; 28870000=05005000= + INTEGER 28875000=05005000= + INDEX; 28880000=05005000= + TAKE:= INFO[INDEX.LINKR, INDEX.LINKC]; 28885000=05006000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28890000=05006000= + 28895000=05007000= + COMMENT PUT PLACES A WORD INTO INFO; 28900000=05007000= + PROCEDURE PUT(WORD, INDEX); 28905000=05008000= + VALUE 28910000=05008000= + WORD, 28915000=05008000= + INDEX; 28920000=05008000= + REAL 28925000=05008000= + WORD, 28930000=05008000= + INDEX; 28935000=05008000= + INFO[INDEX.LINKR, INDEX.LINKC]:= WORD; 28940000=05009000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%28945000=05009000= + 28950000=05010000= + COMMENT FLAG FLAGS ERROR MESSAGES, COUNTS THEM AND SUPRESS FUTURE 28955000=05010000= + ERROR MESSAGES UNTIL THE COMPILER THINKS IT HAS RECOVERED;28960000=05011000= + PROCEDURE FLAG(ERRNUM); 28965000=05012000= + VALUE 28970000=05012000= + ERRNUM; 28975000=05012000= + INTEGER 28980000=05012000= + ERRNUM; 28985000=05012000= + BEGIN 28990000=05013000= + COMMENT WRITERROR IS THE STREAM PROCEDURE WHICH ACTUALLY PRODUCES 28995000=05014000= + THE ERROR MESSAGE ON THE PRINTER; 29000000=05015000= + STREAM PROCEDURE 29005000=05016000= + WRITERROR(RMT, ERRNUM, ACCUM, LINE, COUNT, LSTSEQ); 29010000=05016000= + VALUE 29015000=05017000= + ERRNUM, 29020000=05017000= + COUNT; 29025000=05017000= + BEGIN 29030000=05018000= + DI:= LINE; 29035000=05019000= + 11(DS:= 8 LIT 6" "); % BLANK LINE 29040000=05019000= + SI:= LSTSEQ; 29045000=05020000= + SI:= SI-8; 29050000=05020000= + DS:= WDS; 29055000=05020000= + DS:= 24 LIT 6" <<<<<<<<<<<<<<<<<<<<"; % SET FLAG 29060000=05021000= + SI:= LSTSEQ; 29065000=05023000= + DI:= LSTSEQ; 29070000=05023000= + DI:= DI-8; 29075000=05023000= + DS:= WDS; 29080000=05023000= + DI:= LINE; 29085000=05024000= + SI:= RMT; 29090000=05024000= + SI:= SI+7; 29095000=05024000= + IF SC = 6"1" THEN 29100000=05024100= + BEGIN 29105000=05024200= + SI:= LSTSEQ; 29110000=05024200= + DS:= 10 LIT 6"NEAR LINE "; 29115000=05024200= + (IF SC > 6"0" THEN JUMP OUT;SI:= SI+1;TALLY:= TALLY+1); 29120000=05024400= + RMT:= TALLY; 29125000=05024500= + DS:= 8 CHR; 29130000=05024500= + DI:= DI-RMT; 29135000=05024500= + END 29140000=05024600= + ELSE 29145000=05024600= + DI:= DI+7; 29150000=05024600= + DS:= 14 LIT 6" ERROR NUMBER "; 29155000=05025000= + SI:= LOC ERRNUM; 29160000=05026000= + DS:= 3 DEC; 29165000=05026000= + COMMENT CONVERT ERRNUM; 29170000=05026000= + DS:= 4 LIT 6" -- "; 29175000=05027000= + SI:= ACCUM; 29180000=05028000= + SI:= SI+3; 29185000=05028000= + DS:= COUNT CHR; 29190000=05028000= + COMMENT PLACE ALPHA IN BUFFER; 29195000=05029000= + DS:= LIT 6"." 29200000=05031000= + END WRITERROR; 29205000=05031000= + IF ERRORTOG THEN % DO NOTHING IF WE SUPPRESS MSSGS. 29210000=05032000= + BEGIN 29215000=05033000= + SPECTOG:= FALSE; 29220000=05034000= + ERRORCOUNT:= ERRORCOUNT+1; 29225000=05035000= + COMMENT COUNT ERRORS; 29230000=05035000= + IF NOT (LISTER OR REMOTOG) THEN 29235000=05036000= + BEGIN 29240000=05037000= + EDITLINE(LIN, FCR, 6" ", 0, 0, MEDIUM, 0); 29245000=05038000= + MOVE(1, INFO[LASTSEQROW, LASTSEQUENCE], LIN[12]); 29250000=05039000= + IF NOHEADING THEN 29255000=05039500= + DATIME; 29260000=05039500= + WRITELINE; 29265000=05039500= + END; 29270000=05041000= + COMMENT PRINT CARDIMAGE IF WE ARE NOT LISTING; 29275000=05042000= + ACCUM[1]:= Q; 29280000=05043000= + COMMENT RESTORE ACCUMULATOR; 29285000=05043000= + WRITERROR(REMOTOG, ERRNUM, ACCUM[1], LIN, Q.[12:6], 29290000=05045000= + INFO[LASTSEQROW, LASTSEQUENCE]); 29295000=05045000= + IF REMOTOG THEN 29300000=05045900= + WRITE(REMOTE, 10, LIN[**]); 29305000=05045900= + IF NOT NOHEADING THEN 29310000=05046000= + BEGIN 29315000=05046000= + WRITE(LINE); 29320000=05046000= + WRITELINE; 29325000=05046000= + END; 29330000=05046000= + ERRORTOG:= FALSE; 29335000=05047000= + COMMENT INHIBIT MESSAGES; 29340000=05047000= + IF PUNCHTOG THEN 29345000=05048000= + BEGIN 29350000=05049000= + STREAM PROCEDURE PUNCH(FL, ST); 29355000=05050000= + VALUE 29360000=05051000= + ST; 29365000=05051000= + BEGIN 29370000=05052000= + DI:= FL; 29375000=05053000= + SI:= ST; 29380000=05054000= + DS:= 9 WDS 29385000=05056000= + END PUNCH; 29390000=05056000= + PUNCH(PNCH(0), FCR); 29395000=05057000= + MOVE(1, INFO[LASTSEQROW, LASTSEQUENCE], PNCH(9)); 29400000=05058000= + WRITE(PNCH) 29405000=05060000= + END 29410000=05101000= + END 29415000=05101000= + END FLAG; 29420000=05101000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29425000=05101000= + LABEL 29430000=05101100= + ENDOFITALL; 29435000=05101100= + 29440000=05102000= +COMMENT ERR. IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 29445000=05102000= + RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A 29450000=05103000= + SEMICOLON, END, OR BEGIN; 29455000=05104000= + PROCEDURE ERR(ERRNUM); 29460000=05105000= + VALUE 29465000=05105000= + ERRNUM; 29470000=05105000= + INTEGER 29475000=05105000= + ERRNUM; 29480000=05105000= + BEGIN 29485000=05106000= + FLAG(ERRNUM); 29490000=05106000= + I:= I-1; 29495000=05107000= + IF ERRNUM = 200 THEN 29500000=05107100= + GO TO ENDOFITALL; 29505000=05107100= + IF ERRNUM = 611 THEN 29510000=05107200= + GO TO ENDOFITALL; %ERRMAX EXCEEDED. 29515000=05107200= + DO 29520000=05108000= + IF STEPI = BEGINV THEN 29525000=05108000= + STMT 29530000=05109000= + UNTIL ELCLASS = ENDV OR ELCLASS = SEMICOLON 29535000=05109000= + END ERR; 29540000=05109000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29545000=05109000= + DEFINE 29550000=05110000= + ERROR = ERR #; 29555000=05110000= + COMMENT ERROR IS A SYNONM FOR ERR; 29560000=05110000= + 29565000=05111000= + COMMENT CHECKER IS A SMALL PROCEDURE THAT CHECKS TO SEE THAT THE 29570000=05111000= + UPLEVEL ADDRESSING CONVENTIONS ARE OBEYED; 29575000=05112000= + PROCEDURE CHECKER(ELBATWORD); 29580000=05113000= + VALUE 29585000=05113000= + ELBATWORD; 29590000=05113000= + REAL 29595000=05113000= + ELBATWORD; 29600000=05113000= + BEGIN 29605000=05114000= + IF MODE >= 2 THEN 29610000=05115000= + IF GTI1:= ELBATWORD.LVL >= FRSTLEVEL THEN 29615000=05116000= + IF GTI1 < SUBLEVEL THEN 29620000=05117000= + IF ELBATWORD.[9:2] ^= 1 THEN 29625000=05119000= + BEGIN 29630000=05119000= + FLAG(101); 29635000=05119000= + ERRORTOG:= TRUE 29640000=05119000= + END 29645000=05120000= + END CHECKER; 29650000=05120000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29655000=05120000= + COMMENT GIT IS USED TO OBTAIN THE INDEX TO ADDITIONAL INFORMATION 29660000=05121000= + GIVEN THE LINK TO THE ELBAT WORD; 29665000=05122000= + INTEGER PROCEDURE GIT(L); 29670000=05123000= + VALUE 29675000=05123000= + L; 29680000=05123000= + REAL 29685000=05123000= + L; 29690000=05123000= + GIT:= TAKE(L).INCR+L.LINK; 29695000=05124000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29700000=05124000= + 29705000=05125000= + COMMENT GNAT IS USED TO OBTAIN THE PRT ADDRESS OF A GIVEN DESCRIPTOR. 29710000=05125000= + IF THE ADDRESS HAS NOT BEEN ASSIGNED, THEN IT USES 29715000=05126000= + GETSPACE TO OBTAIN THE PRT ADDRESS; 29720000=05127000= + INTEGER PROCEDURE GNAT(L); 29725000=05128000= + VALUE 29730000=05128000= + L; 29735000=05128000= + REAL 29740000=05128000= + L; 29745000=05128000= + BEGIN 29750000=05129000= + REAL 29755000=05130000= + A; 29760000=05130000= + IF GNAT:= (A:= TAKE(L)).ADDRESS = 0 THEN 29765000=05132000= + PUT(A & (GNAT:= GETSPACE(TRUE, L.LINK+1))[16:37:11], L) 29770000=05133000= + END GNAT; 29775000=05133000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29780000=05133000= + 29785000=05134000= + COMMENT PASSFILE COMPILES CODE THAT BRINGS TO TOP OF STACK A DESCRIPTOR29790000=05134000= + POINTING AT THE I/O DESCRIPTOR (ON TOP). IT HANDLES 29795000=05135000= + SUPERFILES AS WELL AS ORDINARY FILES; 29800000=05136000= + PROCEDURE PASSFILE; 29805000=05137000= + BEGIN 29810000=05138000= + INTEGER 29815000=05138000= + ADDRES; 29820000=05138000= + CHECKER(ELBAT[I]); 29825000=05139000= + ADDRES:= ELBAT[I].ADDRESS; 29830000=05140000= + IF ELCLASS = SUPERFILEID THEN 29835000=05142000= + BEGIN 29840000=05142000= + BANA; 29845000=05143000= + EMITN(ADDRES); 29850000=05143000= + EMITO(LOD) 29855000=05143000= + END 29860000=05144000= + ELSE 29865000=05144000= + BEGIN 29870000=05144000= + IF NOT BOOLEAN(ELBAT[I].FORMAL) THEN 29875000=05145000= + EMITL(5); 29880000=05145000= + STEPIT; 29885000=05146000= + EMITN(ADDRES) 29890000=05147000= + END 29895000=05147000= + END PASSFILE; 29900000=05147000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29905000=05147000= + PROCEDURE PASSMONFILE(ADDRESS); 29910000=05148000= + VALUE 29915000=05149000= + ADDRESS; 29920000=05149000= + REAL 29925000=05150000= + ADDRESS; 29930000=05150000= + BEGIN 29935000=05151000= + COMMENT PASSMONFILE GENERATES CODE TO PASS THE MONITOR 29940000=05151000= + FILE TO PRINTI; 29945000=05152000= + IF ADDRESS < 768 OR ADDRESS > 1023 THEN 29950000=05154000= + EMITL(5); 29955000=05154000= + EMITN(ADDRESS); 29960000=05155000= + END PASSMONFILE; 29965000=05156000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%29970000=05156000= + PROCEDURE PASFILE; 29975000=05157000= + BEGIN 29980000=05158000= + COMMENT PASFILE PASSES THE LAST THREE PARAMETERS TO KEN 29985000=05158000= + MEYERS FOR THE LOCK, CLOSE, AND REWIND STATEMENTS; 29990000=05159000= + DEFINE 29995000=05160000= + ELBATWORD = RR1 #; 30000000=05160000= + COMMENT ELBATWORD CONTAINS THE 30005000=05160000= + ELBATWORD FOR THE FILE BEING 30010000=05161000= + OPERATED ON; 30015000=05162000= + DEFINE 30020000=05163000= + LTEMP = RR2 #; 30025000=05163000= + COMMENT LTEMP IS USED TO HOLD THE L 30030000=05163000= + REGISTER SETTING FOR THE SAVE OR 30035000=05164000= + RELEASE LITERAL THAT GETS PASSED TO 30040000=05165000= + KEN MYERS; 30045000=05166000= + EMITO(MKS); 30050000=05167000= + L:= (LTEMP:= L)+1; 30055000=05167000= + EMITL(0); 30060000=05167000= + EMITL(2); 30065000=05168000= + CHECKER(ELBATWORD:= ELBAT[I]); 30070000=05168000= + IF RRB1:= (RRB2:= ELCLASS = SUPERFILEID) OR 30075000=05171000= + BOOLEAN(ELBATWORD.FORMAL) 30080000=05171000= + THEN 30085000=05171000= + EMITO(LNG); 30090000=05171000= + IF RRB2 THEN 30095000=05173000= + BANA 30100000=05174000= + ELSE 30105000=05174000= + STEPIT; 30110000=05174000= + EMITN(ELBATWORD.ADDRESS); 30115000=05175000= + IF RRB2 THEN 30120000=05177000= + EMITO(LOD); 30125000=05177000= + IF RRB1 THEN 30130000=05179000= + EMITO(INX); 30135000=05179000= + EMITL(4); 30140000=05180000= + EMITV(14); 30145000=05180000= + END PASFILE; 30150000=05181000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30155000=05181000= + 30160000=05182000= + COMMENT CHECKPRESENCE CAUSES THE CORRECT CODE TO BE GENERATED TO CAUSE30165000=05182000= + PRESENCE BIT INTERRUPTS ON I/O DESCRIPTORS; 30170000=05183000= + PROCEDURE CHECKPRESENCE; 30175000=05184000= + BEGIN 30180000=05185000= + EMITO(DUP); 30185000=05186000= + EMITO(LOD); 30190000=05186000= + EMITL(0); 30195000=05186000= + EMITO(CDC); 30200000=05186000= + EMITO(DEL); 30205000=05186000= + END CHECKPRESENCE; 30210000=05187000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30215000=05187000= + 30220000=05187500= +COMMENT PROCEDURE PASSLIST WILL BRING THE LIST PROGRAM DESCRIPTOR 30225000=05187500= + TO TOP OF STACK FOR A SUBSCRIPTED LIST ID OR SIMPLE ID; 30230000=05187510= + PROCEDURE PASSLIST; 30235000=05187520= + BEGIN 30240000=05187530= + INTEGER 30245000=05187540= + LISTADDRESS; 30250000=05187540= + 30255000=05187550= +COMMENT PASSLIST ASSUMES I IS POINTING AT LIST ID; 30260000=05187550= + CHECKER(ELBAT[I]); 30265000=05187560= + LISTADDRESS:= ELBAT[I].ADDRESS; 30270000=05187570= + IF FLCLASS = SUPERLISTID THEN % SUBSCRIPTED LIST ID. 30275000=05187580= + BEGIN 30280000=05187590= + BANA; 30285000=05187600= + EMITN(LISTADDRESS); 30290000=05187600= + EMITO(LOD); 30295000=05187600= + END 30300000=05187620= + ELSE 30305000=05187620= + BEGIN 30310000=05187620= + EMITL(LISTADDRESS); 30315000=05187620= + STEPIT 30320000=05187620= + END; 30325000=05187620= + END OF PASSLIST; 30330000=05187630= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30335000=05187630= + REAL PROCEDURE TAKEFRST; 30340000=05188000= + TAKEFRST:= TAKE(ELBAT[I].LINK+ELBAT[I].INCR); 30345000=05189000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30350000=05189000= + 30355000=05196000= + COMMENT STUFFF DIALS THE F-REGISTER INTO THE F-REGISTER FIELD OF A 30360000=05196000= + DESCRIPTOR. THE DESCRIPTOR REMAINS ON THE TOP OF THE 30365000=05197000= + STACK; 30370000=05198000= + PROCEDURE STUFFF(ADDRESS); 30375000=05199000= + VALUE 30380000=05199000= + ADDRESS; 30385000=05199000= + INTEGER 30390000=05199000= + ADDRESS; 30395000=05199000= + BEGIN 30400000=05200000= + EMITPAIR(ADDRESS, LOD); 30405000=05201000= + EMITN(512); 30410000=05202000= + EMITD(33, 18, 15) 30415000=05203000= + END STUFFF; 30420000=05203000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30425000=05203000= + 30430000=05204000= + COMMENT LOCAL IS USED TO SEE WHETHER OR NOT A LABEL IS LOCAL TO OUR 30435000=05204000= + PRESENT CODE; 30440000=05205000= + BOOLEAN PROCEDURE LOCAL(ELBATWORD); 30445000=05206000= + VALUE 30450000=05207000= + ELBATWORD; 30455000=05207000= + REAL 30460000=05207000= + ELBATWORD; 30465000=05207000= + BEGIN 30470000=05208000= + IF ELBATWORD.LVL = LEVEL AND NOT BOOLEAN(ELBATWORD.FORMAL) THEN 30475000=05209000= + LOCAL:= TRUE 30480000=05210000= + END LOCAL; 30485000=05210000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30490000=05210000= + 30495000=05211000= + COMMENT PASSFORMAT COMPILES CODE THAT PASSES A FORMAT. TWO ITEMS ARE 30500000=05211000= + PASSED - THE ARRAY REFERENCING FORMAT TABLE AND THE 30505000=05212000= + STARTING INDEX. THE ROUTINE HANDLES SUPERFORMATS ALSO; 30510000=05213000= + PROCEDURE PASSFORMAT; 30515000=05214000= + BEGIN 30520000=05215000= + INTEGER 30525000=05215000= + ADRES; 30530000=05215000= + CHECKER(ELBAT[I]); 30535000=05216000= + ADRES:= ELBAT[I].ADDRESS; 30540000=05217000= + IF BOOLEAN(ELBAT[I].FORMAL) THEN 30545000=05219000= + BEGIN 30550000=05219000= + EMITV(ADRES); 30555000=05219000= + ADRES:= ADRES-1 30560000=05219000= + END 30565000=05220000= + ELSE 30570000=05220000= + BEGIN 30575000=05220000= + IF TABLE(I) = SUPERFRMTID THEN 30580000=05222000= + EMITL(TAKEFRST) 30585000=05222000= + ELSE 30590000=05222000= + EMITL(ELBAT[I].INCR) 30595000=05223000= + END; 30600000=05223000= + IF TABLE(I) = SUPERFRMTID THEN 30605000=05225000= + BEGIN 30610000=05225000= + BANA; 30615000=05225000= + I:= I-1; 30620000=05225000= + EMITO(SSP); 30625000=05226000= + EMITO(ADD); 30630000=05226000= + EMITV(ADRES) 30635000=05226000= + END; 30640000=05226000= + EMITPAIR(ADRES, LOD) 30645000=05227000= + END PASSFORMAT; 30650000=05227000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30655000=05227000= + 30660000=05228000= + COMMENT STREAMWORDS EITHER RESERVES OR UNRESERVES STREAM RESERVED 30665000=05228000= + WORDS - IT COMPLEMENTS THEIR STATE; 30670000=05229000= + PROCEDURE STREAMWORDS; 30675000=05230000= + BEGIN 30680000=05231000= + GT1:= 0; 30685000=05231000= + DO BEGIN 30690000=05232000= + INFO[1, GT1].LINK:= 30695000=05233000= + STACKHEAD[GT2:= (T:= INFO[1, GT1]).ADDRESS]; 30700000=05233000= + STACKHEAD[GT2]:= T.LINK; 30705000=05234000= + GT1:= GT1+2; 30710000=05235000= + END 30715000=05236000= + UNTIL BOOLEAN(T.FORMAL) 30720000=05236000= + END STREAMWORDS; 30725000=05236000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%30730000=05236000= + STREAM PROCEDURE DEBUGDESC(LIN, PRT, TYP, RELAD, SGNO); 30735000=05237000= + VALUE 30740000=05237500= + PRT, 30745000=05237500= + TYP, 30750000=05237500= + RELAD, 30755000=05237500= + SGNO; 30760000=05237500= + BEGIN 30765000=05238000= + LOCAL COUNT; 30770000=05238000= + DI:= LIN; 30775000=05238500= + DS:= 6 LIT 6" PRT("; 30780000=05238500= + SI:= LOC PRT; 30785000=05238500= + SI:= SI+4; 30790000=05238500= + TALLY:= 4; 30795000=05238500= + 3(IF SC = 6"0" THEN % DONT PRINT LEADING ZEROES. 30800000=05239000= + BEGINSI:= SI+1;TALLY:= TALLY+63 30805000=05239500= + ENDELSE 30810000=05239500= + JUMP OUT); 30815000=05239500= + COUNT:= TALLY; 30820000=05240000= + DS:= COUNT CHR; 30825000=05240000= + DS:= 31 LIT 6") = SEGMENT DESCRIPTOR, TYPE = "; 30830000=05240500= + SI:= LOC TYP; 30835000=05241000= + SI:= SI+7; 30840000=05241000= + DS:= CHR; % TYPE. 30845000=05241000= + DS:= 21 LIT 6", RELATIVE ADDRESS = "; 30850000=05241500= + SI:= LOC RELAD; 30855000=05242000= + SI:= SI+4; 30860000=05242000= + DS:= 4 CHR; % REL. ADDR. 30865000=05242000= + DS:= 19 LIT 6", SEGMENT NUMBER = "; 30870000=05242500= + SI:= LOC SGNO; 30875000=05243000= + SI:= SI+4; 30880000=05243000= + DS:= 4 CHR; 30885000=05243000= + DS:= LIT 6"."; 30890000=05243000= + END DEBUGDESC; 30895000=05243500= + REAL PROCEDURE ELSEPROGDESCBLDR(TYPE, RELAD, SPAC); 30900000=05245000= + COMMENT THIS PROCEDURE BUILDS PDPRT AS DESCRIBED ABOVE, IT IS 30905000=05246000= + CONCERNED WITH TYPE 1 ENTRIES.THE INFORMATION FURNISHED 30910000=05247000= + BY PDPRT ALLOWS A DRUM DESCRIPTOR TO BE BUILT FOR EACH 30915000=05248000= + SEGMENT AND A PSEUDO PROGRAM DESCRIPTOR TO BE BUILT INTO 30920000=05249000= + THE OBJECT TIME PRT. THE 3 PARAMETERS FUNCTION AS FOLLOWS: 30925000=05250000= + TYPE --- THIS 2 BIT QUANTITY FURNISHES THE MODE30930000=05251000= + AND ARGUMENT BIT FOR THE PROGRAM 30935000=05252000= + DESCRIPTOR TO BE BUILT. 30940000=05253000= + RELAD --- RELATIVE WORD ADDRESS WITHIN SEGMENT 30945000=05254000= + SPAC --- IF=0 THEN A SPACE MUST BE OBTAINED 30950000=05255000= + IF!0 THEN SPACE IS ALREADY GOTTEN 30955000=05256000= + ALL PROGRAM DESCRIPTORS REQUIRE A PERMANENT SPACE IN PRT. 30960000=05257000= + PDINX IS THE INDEX FOR PDPRT.IT IS GLOBAL AND 0 INITIALLY; 30965000=05258000= + VALUE 30970000=05259000= + TYPE, 30975000=05259000= + RELAD, 30980000=05259000= + SPAC; 30985000=05259000= + REAL 30990000=05259000= + TYPE, 30995000=05259000= + RELAD, 31000000=05259000= + SPAC; 31005000=05259000= + BEGIN 31010000=05260000= + IF SPAC = 0 THEN 31015000=05260000= + SPAC:= GETSPACE(TRUE, -2); % DESCR. 31020000=05260000= + PDPRT[PDINX.[37:5], PDINX.[42:6]]:= 0 & RELAD[18:36:10] & 31025000=05262000= + SGNO[28:38:10] & TYPE[4:46:2] & SPAC[8:38:10]; 31030000=05262000= + IF DEBUGTOG THEN 31035000=05263000= + BEGIN 31040000=05263500= + BLANKET(14, LIN); 31045000=05264000= + DEBUGDESC(LIN, B2D(SPAC), TYPE, B2D(RELAD), B2D(SGNO)); 31050000=05264500= + IF NOHEADING THEN 31055000=05265000= + DATIME; 31060000=05265000= + WRITELINE; 31065000=05265000= + END; 31070000=05265100= + PDINX:= PDINX+1; 31075000=05266000= + PROGDESCBLDR:= SPAC 31080000=05266000= + END PROGDESCBLDR; 31085000=05266000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31090000=05266000= + 31095000=05267000= + COMMENT DOTSYNTAX ANALYSES THE SYNTAX OF A PARTIAL WORD DESIGNATOR. 31100000=05267000= + IT REPORTS IF AN ERROR IS FOUND. IT RETURNS WITH THE 31105000=05268000= + LITERALS INVOLVED; 31110000=05269000= + BOOLEAN PROCEDURE DOTSYNTAX(FIRST, SECOND); 31115000=05270000= + INTEGER 31120000=05271000= + FIRST, 31125000=05271000= + SECOND; 31130000=05271000= + BEGIN 31135000=05272000= + LABEL 31140000=05273000= + EXIT; 31145000=05273000= + IF STEPI = FIELDID THEN % GET INFO FROM INFO 31150000=05273100= + BEGIN 31155000=05273200= + FIRST:= ELBAT[I].SBITF; 31160000=05273300= + SECOND:= ELBAT[I].NBITF; 31165000=05273400= + GO TO EXIT; 31170000=05273500= + END 31175000=05273800= + ELSE 31180000=05273800= + IF ELCLASS = LFTBRKET THEN 31185000=05273800= + IF STEPI = FIELDID THEN 31190000=05273900= + BEGIN 31195000=05274000= + FIRST:= ELBAT[I].SBITF; 31200000=05274100= + SECOND:= ELBAT[I].NBITF; 31205000=05274200= + IF STEPI = RTBRKET THEN 31210000=05274300= + GO TO EXIT; 31215000=05274400= + END 31220000=05275000= + ELSE 31225000=05275000= + IF ELCLASS = LITNO THEN 31230000=05275000= + IF STEPI = COLON THEN 31235000=05276000= + IF STEPI = LITNO THEN 31240000=05277000= + IF STEPI = RTBRKET THEN 31245000=05278000= + COMMENT IF TESTS ARE PASSED THEN SYNTAX IS CORRECT; 31250000=05279000= + IF(FIRST:= ELBAT[I-3].ADDRESS)* 31255000=05281000= + (SECOND:= ELBAT[I-1].ADDRESS) ^= 0 31260000=05281000= + THEN 31265000=05281000= + IF FIRST+SECOND <= 48 THEN 31270000=05282000= + COMMENT IF TESTS ARE PASSED THEN RANGES OF LITERALS ARE O.K.; 31275000=05283000= + GO TO EXIT; 31280000=05284000= + ERR(114); 31285000=05285000= + COMMENT ERROR IF SYNTAX OR RANGE FAILS; 31290000=05285000= + DOTSYNTAX:= TRUE; 31295000=05286000= +EXIT: 31300000=05286000= + END DOTSYNTAX; 31305000=05286000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31310000=05286000= + BOOLEAN PROCEDURE CHECK(ELBATCLASS, ERRORNUMBER); 31315000=05287000= + VALUE 31320000=05288000= + ELBATCLASS, 31325000=05288000= + ERRORNUMBER; 31330000=05288000= + REAL 31335000=05289000= + ELBATCLASS, 31340000=05289000= + ERRORNUMBER; 31345000=05289000= + BEGIN 31350000=05290000= + COMMENT CHECK COMPARES ELBATCLASS WITH TABLE(I). IF THEY 31355000=05290000= + ARE NOT EQUAL, CHECK IS SET TRUE AND THE ERROR ROUTINE IS 31360000=05291000= + CALLED PASSING ERRORNUMBER. IF THEY ARE EQUAL CHECK IS SET31365000=05292000= + FALSE; 31370000=05293000= + IF CHECK:= (ELBATCLASS ^= TABLE(I)) THEN 31375000=05295000= + ERR(ERRORNUMBER); 31380000=05295000= + END; 31385000=05296000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31390000=05296000= + BOOLEAN PROCEDURE RANGE(LOWER, UPPER); 31395000=05297000= + VALUE 31400000=05298000= + LOWER, 31405000=05298000= + UPPER; 31410000=05298000= + REAL 31415000=05299000= + LOWER, 31420000=05299000= + UPPER; 31425000=05299000= + COMMENT RANGE TESTS THE CLASS OF THE ITEM IN ELBAT[I] TO SEE IF 31430000=05300000= + IT IS GREATER THAN OR EQUAL TO LOWER OR LESS THAN OR EQUAL TO 31435000=05301000= + UPPER AND SETS RANGE TO TRUE OR FALSE ACCORDINGLY. THE ITEMS 31440000=05302000= + CLASS MUST BE IN ELCLASS; 31445000=05303000= + RANGE:= ELCLASS >= LOWER AND ELCLASS <= UPPER; 31450000=05304000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31455000=05304000= + 31460000=05305000= + COMMENT GET OBTAINS A SYLLABLE FROM EDOC. THE ARRAY INTO WHICH CODE IS 31465000=05305000= + EMITTED; 31470000=05306000= + INTEGER PROCEDURE GET(L); 31475000=05307000= + VALUE 31480000=05307000= + L; 31485000=05307000= + REAL 31490000=05307000= + ; 31495000=05307000= + BEGIN 31500000=05308000= + INTEGER 31505000=05309000= + STREAM PROCEDURE GETSYL(W, S); 31510000=05309000= + VALUE 31515000=05309000= + S; 31520000=05309000= + BEGIN 31525000=05310000= + DI:= LOC GETSYL; 31530000=05310000= + DI:= DI+6; 31535000=05310000= + SI:= W; 31540000=05311000= + SI:= SI+S; 31545000=05311000= + SI+SI+S; 31550000=05311000= + DS:= 2 CHR 31555000=05311000= + END; 31560000=05311000= + GET:= GETSYL(EDOC[L.[36:3], L.[39:7]], L.[46:2]) 31565000=05312000= + END GET; 31570000=05312000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31575000=05312000= + 31580000=05313000= + COMMENT CALL SWITCH PERFORMS THE FINAL MESS OF GETTING A PROPER DE- 31585000=05313000= + SCRIPTOR TO THE TOP OF THE STACK; 31590000=05314000= + PROCEDURE CALLSWITCH(H); 31595000=05315000= + VALUE 31600000=05315000= + H; 31605000=05315000= + REAL 31610000=05315000= + H; 31615000=05315000= + BEGIN 31620000=05316000= + EMITV(GNAT(H)); 31625000=05316000= + EMITO(PRTE); 31630000=05316000= + EMITO(LOD) 31635000=05316000= + END CALLSWITCH; 31640000=05316000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%31645000=05316000= + REAL 31650000=05317000= + STREAM PROCEDURE GETALPHA(INFOINDEX, SIZE); 31655000=05317000= + VALUE 31660000=05318000= + SIZE; 31665000=05318000= + BEGIN 31670000=05319000= + COMMENT GETALPHA PICKS ALPHA CHARACTERS OUT OF INFO AND 31675000=05319000= + FORMATS THE ID WORD THAT IS PASSED TO PRINTI. THE FIRST 31680000=05320000= + CHARACTER CONTAINS THE SIZE. THE NEXT CHARACTER CONTAINS THE 31685000=05321000= + ALPHA LEFT JUSTIFIED WITH TRAILING ZEROS; 31690000=05322000= + DI:= LOC GETALPHA; 31695000=05323000= + DS:= 8 LIT 6"0 "; 31700000=05323000= + D:= DI-7; 31705000=05323000= + SI:= INFOINDEX; 31710000=05324000= + SI:= SI+3; 31715000=05324000= + DS:= SIZE CHR; 31720000=05324000= + END GETALPHA; 31725000=05325000= + PROCEDURE WRITEPRT(PORS, N, GS); 31730000=05325010= + VALUE 31735000=05325010= + PORS, 31740000=05325010= + N, 31745000=05325010= + GS; 31750000=05325010= + INTEGER 31755000=05325010= + PORS, 31760000=05325010= + N, 31765000=05325010= + GS; 31770000=05325010= + BEGIN 31775000=05325020= + LABEL 31780000=05325030= + EXIT; 31785000=05325030= + STREAM PROCEDURE FILLIT(LIN, PORS, CELL, N, ID); 31790000=05325040= + VALUE 31795000=05325050= + PORS, 31800000=05325050= + CELL, 31805000=05325050= + N; 31810000=05325050= + BEGIN 31815000=05325060= + LOCAL COUNT; 31820000=05325070= + LABEL 31825000=05325080= + M0, 31830000=05325080= + M1, 31835000=05325080= + M2, 31840000=05325080= + M3, 31845000=05325080= + M4, 31850000=05325080= + M5, 31855000=05325080= + M6, 31860000=05325080= + M7, 31865000=05325080= + XIT; 31870000=05325080= + SI:= LOC PORS; 31875000=05325090= + SI:= SI+3; 31880000=05325090= + DI:= LIN; % "PRT" OR "STACK". 31885000=05325090= + IF SC = 6"P" THEN 31890000=05325100= + BEGIN 31895000=05325110= + DS:= 3 CHR; 31900000=05325110= + DS:= LIT 6"("; 31905000=05325110= + END 31910000=05325120= + ELSE 31915000=05325120= + BEGIN 31920000=05325120= + DS:= 5 CHR; 31925000=05325130= + DS:= LIT 6"("; 31930000=05325130= + SI:= LOC CELL; 31935000=05325130= + SI:= SI+5; 31940000=05325130= + IF SC >= 6"6" THEN 31945000=05325140= + DS:= 2 LIT 6"F-" 31950000=05325140= + ELSE 31955000=05325140= + DS:= 2 LIT 6"F+"; 31960000=05325140= + COUNT:= DI; 31965000=05325150= + DI:= LOC CELL; 31970000=05325150= + DI:= DI+4; 31975000=05325150= + DS:= 11 RESET; 31980000=05325160= + DI:= COUNT; 31985000=05325160= + END; 31990000=05325170= + SI:= LOC CELL; 31995000=05325180= + SI:= SI+4; 32000000=05325180= + TALLY:= 4; % LOCATION. 32005000=05325180= + 3(IF SC = 6"0" THEN % DONT PRINT LEADING ZEROES. 32010000=05325190= + BEGINSI:= SI+1;TALLY:= TALLY+63 32015000=05325200= + ENDELSE 32020000=05325200= + JUMP OUT); 32025000=05325200= + COUNT:= TALLY; 32030000=05325210= + DS:= COUNT CHR; 32035000=05325210= + TALLY:= 0; 32040000=05325210= + COUNT:= TALLY; 32045000=05325210= + DS:= 4 LIT 6") = "; 32050000=05325220= + CELL:= DI; % SAVE OUR PLACE. 32055000=05325220= + CI:= CI+N; 32060000=05325230= + GO M0; 32065000=05325240= + GO M1; 32070000=05325250= + GO M2; 32075000=05325260= + GO M3; 32080000=05325270= + GO M4; 32085000=05325280= + GO M5; 32090000=05325290= + GO M6; 32095000=05325300= + GO M7; 32100000=05325310= + M0: SI:= ID; 32105000=05325320= + SI:= SI+2; 32110000=05325320= + DI:= LOC COUNT; 32115000=05325320= + DI:= DI+7; 32120000=05325330= + DS:= CHR; 32125000=05325330= + DI:= CELL; 32130000=05325330= + DS:= COUNT CHR; 32135000=05325330= + GO XIT; 32140000=05325340= + M1: DI:= CELL; 32145000=05325350= + DS:= 19 LIT 6"*TEMPORARY STORAGE*"; 32150000=05325350= + GO XIT; 32155000=05325350= + M2: DI:= CELL; 32160000=05325360= + DS:= 36 LIT 6"*LIST, LABEL, OR SEGMENT DESCRIPTOR*"; 32165000=05325370= + GO XIT; 32170000=05325370= + M3: DI:= CELL; 32175000=05325380= + DS:= 27 LIT 6"*CASE STATEMENT DESCRIPTOR*"; 32180000=05325380= + GO XIT; 32185000=05325380= + M4: DI:= CELL; 32190000=05325390= + DS:= 19 LIT 6"*FORMAT DESCRIPTOR*"; 32195000=05325390= + GO XIT; 32200000=05325390= + M5: DI:= CELL; 32205000=05325400= + DS:= 24 LIT 6"*OUTER BLOCK DESCRIPTOR*"; 32210000=05325400= + GO XIT; 32215000=05325400= + M6: DI:= CELL; 32220000=05325410= + DS:= 20 LIT 6"*SEGMENT DESCRIPTOR*"; 32225000=05325410= + GO XIT; 32230000=05325410= + M7: DI:= CELL; 32235000=05325420= + DS:= 18 LIT 6"*LABEL DESCRIPTOR*"; 32240000=05325420= + XIT: 32245000=05325440= + END FILLIT; 32250000=05325440= + ELSEBLANKET(14, LIN); 32255000=05325450= + IF N = 1 THEN 32260000=05325460= + FILLIT(LIN, PORS, GS, 0, ACCUM[1]) 32265000=05325470= + ELSE 32270000=05325470= + IF N > 1 THEN 32275000=05325470= + FILLIT(LIN, PORS, GS, 0, INFO[N.LINKR, N.LINKC]) 32280000=05325480= + ELSE 32285000=05325480= + FILLIT(LIN, PORS, GS, ABS(N), N); 32290000=05325480= + IF NOHEADING THEN 32295000=05325490= + DATIME; 32300000=05325490= + WRITELINE; 32305000=05325490= + END WRITEPRT; 32310000=05325500= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%32315000=05325500= + 32320000=05326000= + COMMENT GETSPACE MAKES ASSIGNMENTS TO VARIABLES AND DESCRIPTORS IN 32325000=05326000= + THE STACK AND PRT. PERMANENT TELLS WHETHER IT IS A 32330000=05327000= + PERMANENTLY ASSIGNED CELL (ALWAYS IN PRT) OR NOT. NON 32335000=05328000= + PERMANENT CELLS ARE EITHER IN STACK OR PRT ACCORDING TO 32340000=05329000= + MODE. CARE IS TAKEN TO REUSE NON PERMANENT PRT CELLS; 32345000=05330000= + INTEGER PROCEDURE GETSPACE(PERMANENT, L); 32350000=05331000= + VALUE 32355000=05331000= + PERMANENT, 32360000=05331000= + L; 32365000=05331000= + BOOLEAN 32370000=05333000= + PERMANENT; 32375000=05333000= + INTEGER 32380000=05333000= + L; 32385000=05333000= + BEGIN 32390000=05334000= + LABEL 32395000=05334000= + L1, 32400000=05334000= + L2, 32405000=05334000= + EXIT; 32410000=05334000= + BOOLEAN 32415000=05341000= + STREAM PROCEDURE MASK(K); 32420000=05341000= + VALUE 32425000=05341000= + K; 32430000=05341000= + BEGIN 32435000=05342000= + DI:= LOC MASK; 32440000=05342000= + DI:= DI+2; 32445000=05342000= + SKIP K DB; 32450000=05342000= + DS:= SET 32455000=05342000= + END MASK; 32460000=05342000= + BOOLEAN 32465000=05343000= + M, 32470000=05343000= + Q; 32475000=05343000= + INTEGER 32480000=05344000= + ROW, 32485000=05344000= + COL, 32490000=05344000= + GS; 32495000=05344000= + IF PERMANENT THEN 32500000=05346000= + BEGIN 32505000=05346000= + IF PRTIMAX > 1022 THEN 32510000=05347000= + FLAG(148); % 32515000=05347000= + SPRT[GS:= PRTIMAX.[38:5]]:= MASK(PRTIMAX.[43:5]-35) OR SPRT[GS]; 32520000=05349000= + PRTIMAX:= (GS:= PRTIMAX)+1 32525000=05350000= + END 32530000=05351000= + ELSE 32535000=05351000= + IF MODE = 0 THEN 32540000=05351000= + BEGIN 32545000=05351000= + Q:= SPRT[ROW:= PRTI.[38:5]]; 32550000=05352000= + M:= MASK(COL:= PRTI.[43:4]-35); 32555000=05353000= + COL:= COL+35; 32560000=05354000= + L1: IF REAL(M AND Q) ^= 0 THEN 32565000=05356000= + BEGIN 32570000=05356000= + IF REAL(BOOLEAN(GS:= 4294967296-REAL(M)) AND Q) = GS THEN 32575000=05358000= + BEGIN 32580000=05358000= + COL:= 0; 32585000=05359000= + M:= TRUE; 32590000=05359000= + IF ROW:= ROW+1 > 31 THEN 32595000=05361000= + BEGIN 32600000=05361000= + FLAG(148); 32605000=05361000= + GS:= PRTIMAX; 32610000=05361000= + GO TO L2 32615000=05362000= + END; 32620000=05362000= + Q:= SPRT[ROW]; 32625000=05363000= + GO TO L1 32630000=05364000= + END; 32635000=05364000= + COL:= COL+1; 32640000=05365000= + M:= BOOLEAN(REAL(M)+REAL(M)); 32645000=05365000= + GO TO L1 32650000=05366000= + END; 32655000=05366000= + PRTI:= (GS:= 32*ROW+COL)+1; 32660000=05367000= + IF PRTI > PRTIMAX THEN 32665000=05368000= + PRTIMAX:= PRTI 32670000=05369000= + END 32675000=05369000= + ELSE 32680000=05369000= + BEGIN 32685000=05369000= + IF STACKCTR > 767 THEN 32690000=05370000= + FLAG(149); 32695000=05370000= + STACKCTR:= (GS:= STACKCTR)+1; 32700000=05371000= + Q:= FALSE; 32705000=05371000= + GO TO EXIT 32710000=05372000= + END; 32715000=05372000= +L2: IF GS >= 512 THEN 32720000=05373000= + GS:= GS+1024; 32725000=05373000= + Q:= TRUE; 32730000=05374000= +EXIT: 32735000=05375000= + GETSPACE:= GS; 32740000=05375000= + IF GS > 1023 THEN 32745000=05376000= + GS:= GS-1024; 32750000=05376000= + IF PRTOG THEN 32755000=05376100= + WRITEPRT(IF Q THEN 6"PRT " ELSE 6"STACK", L, B2D(GS)); 32760000=05376100= + END GETSPACE; 32765000=05378000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%32770000=05378000= + COMMENT ARRAYCHECK CHECKS A PARAMTER-INFO WORD FOR SORT/MERGE; 32775000=05379000= + BOOLEAN PROCEDURE ARRAYCHECK(AAW); 32780000=05380000= + VALUE 32785000=05380000= + AAW; 32790000=05380000= + REAL 32795000=05380000= + AAW; 32800000=05380000= + ARRAYCHECK:= AAW.CLASS < BOOARRAYID OR AAW.CLASS > INTARRAYID OR AAW32805000=05382000= + .INCR ^= 1; 32810000=05382000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%32815000=05382000= + COMMENT COMMACHECK LOOKS FOR COMMAS AND STEPS AROUND THEM; 32820000=05383000= + BOOLEAN PROCEDURE COMMACHECK; 32825000=05384000= + BEGIN 32830000=05385000= + IF NOT (COMMACHECK:= (STEPI = COMMA)) THEN 32835000=05385000= + ERR(350); 32840000=05385000= + STEPIT 32845000=05387000= + END COMMACHECK; 32850000=05387000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%32855000=05387000= + COMMENT HVCHECK CHECKS VALIDITY OF HIVALU PROCEDURE FOR SORT; 32860000=05388000= + BOOLEAN PROCEDURE HVCHECK(ELBW); 32865000=05389000= + VALUE 32870000=05389000= + ELBW; 32875000=05389000= + REAL 32880000=05389000= + ELBW; 32885000=05389000= + IF ELBW.CLASS ^= PROCID THEN 32890000=05390000= + ERR(356) 32895000=05390000= + ELSE 32900000=05390000= + IF BOOLEAN(ELBW.FORMAL) THEN 32905000=05390100= + HVCHECK:= TRUE 32910000=05390100= + ELSE 32915000=05390100= + IFTAKE(GT1:= GIT(ELBW) ^= 1 THEN ERR(357) 32920000=05391000= + ELSE 32925000=05391000= + IF ARRAYCHECK(TAKE(GT1+1)) THEN 32930000=05392000= + ERR(358) 32935000=05392000= + ELSE 32940000=05392000= + HVCHECK:= TRUE; 32945000=05393000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%32950000=05393000= + COMMENT OUTPROCHECK CHECKS SORT/MERGE OUTPUT PROCEDURE; 32955000=05394000= + BOOLEAN PROCEDURE OUTPROCHECK(ELBW); 32960000=05395000= + VALUE 32965000=05395000= + ELBW; 32970000=05395000= + REAL 32975000=05395000= + ELBW; 32980000=05395000= + IF ELBW.CLASS ^= PROCID THEN 32985000=05396000= + ERR(351) 32990000=05396000= + ELSE 32995000=05396000= + IF BOOLEAN(ELBW.FORMAL) THEN 33000000=05396100= + OUTPROCHECK:= TRUE 33005000=05396100= + ELSE 33010000=05396100= + IF TAKE(GT1:= GIT(ELBW)) ^= 2 THEN 33015000=05397000= + ERR(352) 33020000=05397000= + ELSE 33025000=05397000= + IF TAKE(GT1:= 1).CLASS ^= BOOID THEN 33030000=05398000= + ERR(353) 33035000=05398000= + ELSE 33040000=05398000= + IF ARRAYCHECK(TAKE(GT1+2)) THEN 33045000=05399000= + ERR(354) 33050000=05399000= + ELSE 33055000=05399000= + OUTPROCHECK:= TRUE; 33060000=05400000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33065000=05400000= + COMMENT EQLESCHECK CHECKS THE COMPARE ROUTINE FOR SORT/MERGE; 33070000=05401000= + BOOLEAN PROCEDURE EQLESCHECK(ELBW); 33075000=05402000= + VALUE 33080000=05402000= + ELBW; 33085000=05402000= + REAL 33090000=05402000= + ELBW; 33095000=05402000= + IF ELBW.CLASS ^= BOOPROCID THEN 33100000=05403000= + ERR(359) 33105000=05403000= + ELSE 33110000=05403000= + IF BOOLEAN(ELBW.FORMAL) THEN 33115000=05403100= + EQLESCHECK:= TRUE 33120000=05403100= + ELSE 33125000=05403100= + IF TAKE(GT1:= GIT(ELBW)) ^= 2 THEN 33130000=05404000= + ERR(360) 33135000=05404000= + ELSE 33140000=05404000= + IF ARRAYCHECK(TAKE(GT1+1)) THEN 33145000=05405000= + ERR(361) 33150000=05405000= + ELSE 33155000=05405000= + IF ARRAYCHECK(TAKE(GT1+2)) THEN 33160000=05406000= + ERR(362) 33165000=05406000= + ELSE 33170000=05406000= + EQLESCHECK:= TRUE; 33175000=05407000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33180000=05407000= + 33185000=06000000= + COMMENT ROUTINES IN THIS SECTION COMPILE CODE FOR ALL EXPRESSIONS;33190000=06000000= + 33195000=06001000= + COMMENT AEXP IS THE ARITHMETIC EXRESSION ROUTINE; 33200000=06001000= + PROCEDURE AEXP; 33205000=06002000= + BEGIN 33210000=06003000= + IF ELCLASS = IFV THEN 33215000=06005000= + BEGIN 33220000=06005000= + IF IFEXP ^= ATYPE THEN 33225000=06005000= + ERR(102) 33230000=06006000= + END 33235000=06006000= + ELSE 33240000=06006000= + BEGIN 33245000=06006000= + ARITHSEC; 33250000=06006000= + SIMPARITH 33255000=06006000= + END 33260000=06007000= + END AEXP; 33265000=06007000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33270000=06007000= + 33275000=06008000= + COMMENT ARITHSEC COMPILES FIRST PRIMARY IN AN ARITHMETIC EXPRESSION. 33280000=06008000= + IN PARTICULAR IT HANDLES P, +P, -P, AND -P*Q WHERE P 33285000=06009000= + AND Q ARE PRIMARIES; 33290000=06010000= + PROCEDURE ARITHSEC; 33295000=06011000= + BEGIN 33300000=06012000= + IF ELCLASS = ADOP THEN 33305000=06014000= + BEGIN 33310000=06014000= + STEPIT; 33315000=06015000= + IF ELBAT[I-1].ADDRESS = ADD THEN 33320000=06016000= + PRIMARY 33325000=06017000= + ELSE 33330000=06017000= + BEGIN 33335000=06017000= + PRIMARY; 33340000=06018000= + WHILE ELCLASS = FACTOP DO 33345000=06019000= + BEGIN 33350000=06020000= + STEPIT; 33355000=06020000= + PRIMARY; 33360000=06020000= + EMITUP 33365000=06020000= + END; 33370000=06020000= + ENDTOG:= LINKTOG; 33375000=06021000= + EMITO(CHS); 33380000=06021000= + LINKTOG:= ENDTOG; 33385000=06022000= + ENDTOG:= FALSE 33390000=06022000= + END 33395000=06023000= + END 33400000=06023000= + ELSE 33405000=06023000= + PRIMARY 33410000=06023000= + END ARITHSEC; 33415000=06023000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33420000=06023000= + 33425000=06024000= + COMMENT SIMPARITH COMPILES SIMPLE ARITHMETIC EXPRESSIONS ON THE 33430000=06024000= + ASSUMPTION THAT AN ARITHMETIC PRIMARY HAS ALREADY BEEN 33435000=06025000= + COMPILED. IT ALSO HANDLES THE CASE OF A CONCATENATE 33440000=06026000= + WHERE ACTUALPARAPART CAUSED THE VARIABLE ROUTINE TO 33445000=06027000= + COMPILE ONLY PART OF A PRIMARY. MOST OF THE WORK OF 33450000=06028000= + SIMPARITH IS DONE BY ARITHCOMP. AN ARTIFIAL ROUTINE 33455000=06029000= + WHICH DOES THE HIERARCHY ANALYSIS USING RECURSION. 33460000=06030000= + ARITHOCMP IS A SUBROUTINE ONLY TO GET THIS RECURSION; 33465000=06031000= + PROCEDURE SIMPARITH; 33470000=06032000= + BEGIN 33475000=06033000= + WHILE ELCLASS = AMPERSAND DO 33480000=06035000= + BEGIN 33485000=06035000= + STEPIT; 33490000=06035000= + PRIMARY; 33495000=06035000= + PARSE 33500000=06035000= + END; 33505000=06035000= + WHILE ELCLASS >= ADOP AND ELCLASS <= FACTOP DO 33510000=06036000= + ARITHCOMP 33515000=06036000= + END; 33520000=06036000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33525000=06036000= + 33530000=06037000= + COMMENT ARITHCOMP IS THE GUTS OF THE ARITHMETIC EXPRESSION ROUTINE 33535000=06037000= + ANALYSIS. IT CALLS PRIMARY AT APPROPRIATE TIMES AND 33540000=06038000= + EMITS THE ARITHMETIC OPERATORS. THE HIERARCHY ANALYSIS 33545000=06039000= + IS OBTAINED BY RECURSION; 33550000=06040000= + PROCEDURE ARITHCOMP; 33555000=06041000= + BEGIN 33560000=06042000= + INTEGER 33565000=06042000= + OPERATOR, 33570000=06042000= + OPCLASS; 33575000=06042000= + DO BEGIN 33580000=06043000= + OPERATOR:= 1 & ELBAT[I][36:17:10]; 33585000=06044000= + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 33590000=06045000= + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 33595000=06046000= + OF THE ELBAT WORD; 33600000=06047000= + OPCLASS:= ELCLASS; 33605000=06048000= + STEPIT; 33610000=06049000= + PRIMARY; 33615000=06049000= + IF OPCLASS = FACTOP THEN 33620000=06050000= + EMITUP 33625000=06051000= + ELSE 33630000=06051000= + BEGIN 33635000=06051000= + WHILE OPCLASS < ELCLASS DO 33640000=06052000= + ARITHCOMP; 33645000=06052000= + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 33650000=06053000= + STACKCT:= 1; 33655000=06053500= + EMIT(OPERATOR) 33660000=06054000= + END 33665000=06055000= + END 33670000=06055000= + UNTIL OPCLASS ^= ELCLASS 33675000=06055000= + END ARITHCOMP; 33680000=06055000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%33685000=06055000= + 33690000=06056000= + COMMENT IMPFUN HANDLES ALL OF THE SPECIAL FUNCTIONS; 33695000=06056000= + PROCEDURE IMPFUN; 33700000=06057000= + BEGIN 33705000=06058000= + REAL 33710000=06059000= + T1, 33715000=06059000= + T2, 33720000=06059000= + T3; 33725000=06059000= + BOOLEAN 33730000=06059050= + B; 33735000=06059050= + DEFINE 33740000=06059100= + ERRX(ERRX1) = BEGIN 33745000=06059100= + T1:= ERRX1; 33750000=06059100= + GO ERROR 33755000=06059100= + END #; 33760000=06059100= + LABEL 33765000=06060000= + ABS, 33770000=06060000= + SIGN, 33775000=06060000= + ENTIER, 33780000=06060000= + TIME, 33785000=06060000= + STATUS, 33790000=06060000= + % 33795000=06060000= +MAXANDMIN, 33800000=06060100= + DELAY, 33805000=06060100= + OTHERS, 33810000=06060100= + EXIT; % 33815000=06060100= + LABEL 33820000=06060110= + ERROR, 33825000=06060110= + L1, 33830000=06060110= + L2, 33835000=06060110= + L3; 33840000=06060110= + SWITCH 33845000=06061000= + S:= OTHERS, 33850000=06061000= + ABS, 33855000=06061000= + SIGN, 33860000=06061000= + ENTIER, 33865000=06061000= + TIME, 33870000=06061000= + STATUS, 33875000=06061000= + % 33880000=06061000= +MAXANDMIN, 33885000=06061100= + MAXANDMIN, 33890000=06061100= + DELAY; % 33895000=06061100= + DEFINE 33900000=06061200= + MAXV = 6 #; % 33905000=06061200= + IF T2:= (T1:= ELBAT[I]).[27:6] < 9 THEN 33910000=06062000= + GO S[T2+1]; 33915000=06062000= + IF T2 ^= 25 THEN 33920000=06062110= + EMITO(MKS); 33925000=06062110= + IF STEPI ^= LEFTPAREN THEN 33930000=06062120= + ERRX(105); 33935000=06062120= + STEPIT; 33940000=06062120= + IF T2 < 24 THEN 33945000=06062125= + BEGIN 33950000=06062130= + L3: IF TABLE(I+1) = COMMA THEN 33955000=06062135= + IF ELCLASS > BOOID AND ELCLASS < BOOARRAYID THEN 33960000=06062140= + BEGIN 33965000=06062145= + CHECKER(T3:= ELBAT[I]); 33970000=06062150= + STEPIT; 33975000=06062150= + STEPIT; 33980000=06062150= + AEXP; 33985000=06062155= + EMITV(T3.ADDRESS); 33990000=06062155= + GO L1; 33995000=06062155= + END; 34000000=06062160= + L2: AEPX; 34005000=06062165= + IF ELCLASS ^= COMMA THEN 34010000=06062165= + ERRX(80); 34015000=06062165= + STEPIT; 34020000=06062165= + AEXP; 34025000=06062170= + IF T2 < 24 THEN 34030000=06062170= + EMITO(XCH); 34035000=06062170= + END 34040000=06062180= + ELSE 34045000=06062180= + BEGIN 34050000=06062180= + IF T2 = 24 THEN 34055000=06062185= + GO L2; 34060000=06062185= + EMITL(0); 34065000=06062185= + AEXP; 34070000=06062185= + IF ELCLASS ^= COMMA THEN 34075000=06062190= + ERRX(80); 34080000=06062190= + EMITPAIR(9, SND); 34085000=06062190= + EMITD(1, 1, 8); 34090000=06062195= + STEPIT; 34095000=06062195= + AEXP; 34100000=06062195= + END; 34105000=06062200= +L1: IF T2 < 23 THEN 34110000=06062210= + BEGIN 34115000=06062210= + IF ELCLASS ^= COMMA THEN 34120000=06062210= + ERRX(80) 34125000=06062220= + END 34130000=06062220= + ELSE 34135000=06062220= + IF ELCLASS ^= RTPAREN THEN 34140000=06062220= + ERRX(104); 34145000=06062220= + STEPIT; 34150000=06062230= + IF T2 < 21 OR B THEN 34155000=06062280= + BEGIN 34160000=06062285= + EMITV(GNAT(T1)); 34165000=06062285= + B:= ELCLASS = INTID OR ELCLASS = INTARRAYID OR ELCLASS = INTPROCID34170000=06062295= + ; 34175000=06062295= + IF ELCLASS >= REALID AND ELCLASS <= INTID THEN 34180000=06062340= + BEGIN 34185000=06062350= + EMITN(ELBAT[I].ADDRESS); 34190000=06062350= + STEPIT 34195000=06062350= + END 34200000=06062370= + ELSE 34205000=06062370= + IF ELCLASS < BOOID AND ELCLASS > BOOPROCID THEN 34210000=06062370= + IF ELBAT[I].LINK ^= PROINFO.LINK THEN 34215000=06062380= + FLAG(211) 34220000=06062385= + ELSE 34225000=06062385= + BEGIN 34230000=06062385= + EMITL(514); 34235000=06062385= + STEPIT 34240000=06062385= + END 34245000=06062390= + ELSE 34250000=06062390= + IF ELCLASS < LABELID AND ELCLASS > BOOARRAYID THEN 34255000=06062400= + VARIABLE(FL) 34260000=06062420= + ELSE 34265000=06062420= + ERRX(185); 34270000=06062420= + IF ELCLASS ^= RTPAREN THEN 34275000=06062430= + ERRX(104); 34280000=06062430= + STEPIT; 34285000=06062430= + EMITO(IF B THEN ISD ELSE STD); 34290000=06062435= + EMITV(17); 34295000=06062435= + GO EXIT; 34300000=06062435= + END; 34305000=06062440= + IF T2 < 23 THEN 34310000=06062470= + BEGIN % DMOD, DARCTAN2 34315000=06062480= + B:= TRUE; 34320000=06062500= + GO L3; 34325000=06062500= + END; 34330000=06062535= + IF T2 < 25 THEN 34335000=06062540= + BEGIN 34340000=06062540= + EMITV(GNAT(T1)); 34345000=06062540= + GO EXIT 34350000=06062540= + END; 34355000=06062540= + EMITD(9, 47, 1); 34360000=06062560= + EMITV(9); 34365000=06062560= + EMITO(ADD); 34370000=06062560= + GO EXIT; 34375000=06062560= +ERROR: 34380000=06062565= + ERR(T1); 34385000=06062565= + GO EXIT; 34390000=06062565= +OTHERS: 34395000=06064000= + EMITO(MKS); 34400000=06064000= + PANA; 34405000=06065000= + EMITV(GNAT(T1)); 34410000=06066000= + GO TO EXIT; 34415000=06066000= +ABS: 34420000=06067000= + PANA; 34425000=06067000= + EMITO(SSP); 34430000=06067000= + GO TO EXIT; 34435000=06067000= +SIGN: 34440000=06068000= + PANA; 34445000=06068000= + EMITO(DUP); 34450000=06069000= + EMITL(0); 34455000=06069000= + EMITO(NEQ); 34460000=06069000= + EMITO(XCH); 34465000=06069000= + EMITD(1, 1, 1); 34470000=06070000= + GO TO EXIT; 34475000=06070000= +ENTIER: 34480000=06071000= + PANA; 34485000=06071000= + EMITNUM(.5); 34490000=06071000= + EMITO(SUB); 34495000=06071000= + EMITPAIR(JUNK, ISN); 34500000=06072000= + GO TO EXIT; 34505000=06072000= +MAXANDMIN: 34510000=06072010= + % 34515000=06072010= + IF STEPI ^= LEFTPAREN THEN 34520000=06072030= + ERR(105) 34525000=06072030= + ELSE % 34530000=06072030= + BEGIN 34535000=06072040= + STEPIT; 34540000=06072040= + AEXP; % 34545000=06072040= + WHILE ELCLASS = COMMA DO % 34550000=06072050= + BEGIN 34555000=06072060= + STEPIT; 34560000=06072060= + EMITO(DUP); 34565000=06072060= + AEXP; % 34570000=06072060= + EMITPAIR(JUNK, SND); % 34575000=06072070= + IF T2 = MAXV THEN 34580000=06072080= + EMITO(LSS) 34585000=06072080= + ELSE 34590000=06072080= + EMITO(GTR); 34595000=06072080= + EMITPAIR(2, BFC); 34600000=06072090= + EMITO(DEL); 34605000=06072090= + EMITV(JUNK); 34610000=06072090= + END; % 34615000=06072100= + IF ELCLASS ^= RTPAREN THEN 34620000=06072110= + ERR(104) 34625000=06072110= + ELSE 34630000=06072110= + STEPIT; % 34635000=06072110= + END; % 34640000=06072120= + GO TO EXIT; % 34645000=06072130= +DELAY: 34650000=06072200= + IF STEPI ^= LEFTPAREN THEN % 34655000=06072200= + BEGIN 34660000=06072210= + ERR(105); 34665000=06072210= + GO TO EXIT 34670000=06072210= + END; % 34675000=06072210= + STEPIT; 34680000=06072220= + AEXP; 34685000=06072220= + IF ELCLASS ^= COMMA THEN % 34690000=06072220= + BEGIN 34695000=06072230= + ERR(165); 34700000=06072230= + GO TO EXIT 34705000=06072230= + END; % 34710000=06072230= + STEPIT; 34715000=06072240= + AEXP; 34720000=06072240= + IF ELCLASS ^= COMMA THEN % 34725000=06072240= + BEGIN 34730000=06072250= + ERR(165); 34735000=06072250= + GO TO EXIT 34740000=06072250= + END; % 34745000=06072250= + STEPIT; 34750000=06072260= + AEXP; 34755000=06072260= + IF ELCLASS ^= RTPAREN THEN % 34760000=06072260= + BEGIN 34765000=06072270= + ERR(104); 34770000=06072270= + GO TO EXIT 34775000=06072270= + END 34780000=06072270= + ELSE 34785000=06072270= + STEPIT; % 34790000=06072270= + EMITPAIR(31, COM); 34795000=06072280= + EMITO(DEL); 34800000=06072280= + EMITO(DEL); % 34805000=06072280= + GO TO EXIT; % 34810000=06072290= +TIME: 34815000=06073000= + PANA; 34820000=06073000= + EMITL(1); 34825000=06073000= + EMITO(COM); 34830000=06073000= + GO TO EXIT; 34835000=06073100= +STATUS: 34840000=06073200= + IF STEPI ^= LEFTPAREN THEN 34845000=06073200= + BEGIN 34850000=06073200= + ERR(105); 34855000=06073200= + GO TO EXIT 34860000=06073200= + END; 34865000=06073200= + IF STEPI = SUPERFILEID OR ELCLASS = FILEID THEN 34870000=06073250= + BEGIN 34875000=06073300= + EMIT(16); 34880000=06073300= + EMIT(0); 34885000=06073300= + EMIT(0); 34890000=06073300= + PASSFILE; 34895000=06073300= + EMITPAIR(32, COM); 34900000=06073350= + T1:= 3; 34905000=06073350= + END 34910000=06073400= + ELSE 34915000=06073400= + BEGIN 34920000=06073400= + EMIT(4); 34925000=06073400= + EMIT(0); 34930000=06073400= + T1:= 0; 34935000=06073400= + IF ELCLASS >= BOOARRAYID AND ELCLASS <= INTARRAYID THEN 34940000=06073450= + BEGIN 34945000=06073500= + T1:= FI; 34950000=06073500= + VARIABLE(T1); 34955000=06073500= + END 34960000=06073500= + ELSE 34965000=06073500= + AEXP; 34970000=06073500= + IF T1 = FI THEN 34975000=06073550= + BEGIN 34980000=06073600= + EMITPAIR(0, XCH); 34985000=06073600= + EMITPAIR(32, COM); 34990000=06073600= + T1:= 3 34995000=06073650= + END 35000000=06073650= + ELSE 35005000=06073650= + BEGIN 35010000=06073650= + IF ELCLASS = RTPAREN THEN 35015000=06073650= + BEGIN 35020000=06073700= + EMIT(0); 35025000=06073700= + EMITPAIR(32, COM); 35030000=06073700= + T1:= 3 35035000=06073700= + END 35040000=06073750= + ELSE 35045000=06073750= + BEGIN 35050000=06073750= + EMITO(XCH); 35055000=06073750= + EMITO(DEL); 35060000=06073750= + EMITO(XCH); 35065000=06073800= + EMITO(DEL); 35070000=06073800= + IF ELCLASS ^= COMMA THEN 35075000=06073810= + BEGIN 35080000=06073820= + ERR(129); 35085000=06073820= + GO TO EXIT 35090000=06073820= + END; 35095000=06073820= + STEPIT; 35100000=06073830= + AEXP; 35105000=06073830= + EMITPAIR(28, COM); 35110000=06073830= + T1:= 1; 35115000=06073830= + END; 35120000=06073840= + END; 35125000=06073840= + END; 35130000=06073840= + GTI1:= 0; 35135000=06073845= + DO 35140000=06073850= + EMITO(DEL) 35145000=06073850= + UNTIL GTI1:= GTI1-1 = T1; % 35150000=06073850= + IF ELCLASS ^= RTPAREN THEN 35155000=06073860= + ERR(104) 35160000=06073860= + ELSE 35165000=06073860= + STEPIT; 35170000=06073860= + GO TO EXIT; 35175000=06073870= +EXIT: 35180000=06074000= + END IMPFUN; 35185000=06074000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%35190000=06074000= + 35195000=06075000= + COMMENT PRIMARY COMPILES ARITHMETIC PRIMARIES. IT HANDLES MOST CASES 35200000=06075000= + OF THE CONCATENATE AND SOME CASES OF THE PARTIAL WORD 35205000=06076000= + DESIGNATORS, ALTHOUGH VARIABLE HANDLES THE MORE COMMON 35210000=06077000= + CASES; 35215000=06078000= + PROCEDURE PRIMARY; 35220000=06079000= + BEGIN 35225000=06080000= + LABEL 35230000=06082000= + L11, 35235000=06082000= + L12, 35240000=06082000= + L13, 35245000=06082000= + L14, 35250000=06082000= + L15, 35255000=06082000= + L16, 35260000=06082000= + L17, 35265000=06082000= + L18, 35270000=06082000= + L19, 35275000=06083000= + L20, 35280000=06083000= + L21, 35285000=06083000= + L22, 35290000=06083000= + L23, 35295000=06083000= + L24, 35300000=06083000= + L25, 35305000=06083000= + L26, 35310000=06083000= + L27, 35315000=06083000= + L28, 35320000=06083000= + L29, 35325000=06084000= + L30, 35330000=06084000= + L31, 35335000=06084000= + L32, 35340000=06084000= + L33, 35345000=06084000= + L34, 35350000=06084000= + L35; 35355000=06084000= + SWITCH 35360000=06085000= + S:= L11, 35365000=06086000= + L12, 35370000=06086000= + L13, 35375000=06086000= + L14, 35380000=06086000= + L15, 35385000=06086000= + L16, 35390000=06086000= + L17, 35395000=06086000= + L18, 35400000=06086000= + L19, 35405000=06087000= + L20, 35410000=06087000= + L21, 35415000=06087000= + L22, 35420000=06087000= + L23, 35425000=06087000= + L24, 35430000=06087000= + L25, 35435000=06087000= + L26, 35440000=06087000= + L27, 35445000=06087000= + L28, 35450000=06087000= + L29, 35455000=06088000= + L30, 35460000=06088000= + L31, 35465000=06088000= + L32, 35470000=06088000= + L33, 35475000=06088000= + L34, 35480000=06088000= + L35; 35485000=06088000= + COMMENT LN IS THE LABEL FOR THE CLASS N; 35490000=06089000= + LABEL 35495000=06090000= + EXIT, 35500000=06090000= + RP, 35505000=06090000= + LDOT, 35510000=06090000= + LAMPER; 35515000=06090000= + GO TO S[ELCLASS-PROCID]; 35520000=06091000= + COMMENT GO TO PROPER SYNTAXER; 35525000=06091000= + IF ELCLASS = UNKNOWNID THEN 35530000=06092000= + ERR(100); 35535000=06092000= + IF ELCLASS = FILEID OR ELCLASS = SUPERFILEID THEN 35540000=06092005= + BEGIN 35545000=06092010= + IF FILEATTRIBUTEHANDLER(FP) ^= ATYPE THEN 35550000=06092015= + FLAG(294); 35555000=06092015= + GO TO LAMPER; 35560000=06092020= + END; 35565000=06092025= +L12: 35570000=06093000= +L13: 35575000=06093000= +L17: 35580000=06093000= +L21: 35585000=06093000= +L25: 35590000=06093000= +L29: 35595000=06093000= +L30: 35600000=06094000= + COMMENT NO PRIMARY MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 35605000=06094000= + 35610000=06094950= + IF REL AND ELCLASS = BOOARRAYID THEN 35615000=06094950= + GO L22; 35620000=06094950= + ERR(103); 35625000=06095000= + GO TO EXIT; 35630000=06095000= +L11: 35635000=06097000= + COMMENT INTRINSIC FUNCTIONS; 35640000=06097000= + 35645000=06098000= + IMPFUN; 35650000=06098000= + STACKCT:= STACKCT-1; 35655000=06098000= + GO TO LDOT; 35660000=06098000= +L14: 35665000=06099000= +L15: 35670000=06099000= +L16: 35675000=06100000= + COMMENT STREAM PROCEDURE FUNCTION DESIGNATORS; 35680000=06100000= + 35685000=06100100= + IF ARRAYFLAG THEN 35690000=06100100= + CHECKBOUNDLVL; 35695000=06100100= + STRMPROCSTMT; 35700000=06101000= + GO TO LDOT; 35705000=06101000= +L18: 35710000=06102000= +L19: 35715000=06102000= +L20: 35720000=06103000= + COMMENT ORDINARY FUNCTION DESIGNATORS; 35725000=06103000= + 35730000=06103100= + IF ARRAYFLAG THEN 35735000=06103100= + CHECKBOUNDLVL; 35740000=06103100= + PROCSTMT(FALSE); 35745000=06104000= + GO TO LDOT; 35750000=06104000= +L22: 35755000=06105000= +L23: 35760000=06105000= +L24: 35765000=06105000= +L26: 35770000=06105000= +L27: 35775000=06105000= +L28: 35780000=06106000= + COMMENT VARIABLES, SIMPLE AND SUBSCRIPTED; 35785000=06106000= + 35790000=06106100= + IF ARRAYFLAG THEN 35795000=06106100= + CHECKBOUNDLVL; 35800000=06106100= + VARIABLE(FP); 35805000=06107000= + GO TO LAMPER; 35810000=06107000= +L32: 35815000=06109000= + COMMENT LITERALS - I.E. INTEGERS BETWEEN 0 AND 1023; 35820000=06109000= + 35825000=06110000= + EMIT(0 & ELBAT[I][36:17:10]); 35830000=06110000= + STEPIT; 35835000=06110000= + GO TO LAMPER; 35840000=06110000= +L31: 35845000=06111000= +L33: 35850000=06112000= + COMMENT STRINGS AND NONLITERALS; 35855000=06112000= + 35860000=06113000= + EMITNUM(C); 35865000=06113000= + STEPIT; 35870000=06113000= + GO TO LAMPER; 35875000=06113000= +L35: 35880000=06115000= + COMMENT COULD BE REAL TRANSFER FUNCTION. IF IT IS COMPILE BOOLEAN35885000=06115000= + EXPRESSION - OTHERWISE AN ERROR; 35890000=06116000= + 35895000=06117000= + IF ELBAT[I].ADDRESS = REALV THEN 35900000=06117000= + BEGIN 35905000=06117000= + IF STEPI ^= LEFTPAREN THEN 35910000=06119000= + BEGIN 35915000=06119000= + ERR(105); 35920000=06119000= + GO TO EXIT 35925000=06119000= + END; 35930000=06119000= + STEPIT; 35935000=06120000= + BEXP; 35940000=06120000= + GO TO RP 35945000=06120000= + END; 35950000=06120000= + IF ELBAT[I].ADDRESS = INTV THEN 35955000=06120100= + BEGIN 35960000=06120200= + PANA; 35965000=06120200= + EMITPAIR(JUNK, ISN); 35970000=06120200= + GO TO LDOT 35975000=06120200= + END; 35980000=06120200= + ERR(106); 35985000=06121000= + GO TO EXIT; 35990000=06121000= +L34: 35995000=06123000= + COMMENT (; 36000000=06123000= + 36005000=06124000= + STEPIT; 36010000=06124000= + AEXP; 36015000=06124000= + STACKCT:= STACKCT-1; 36020000=06124500= +RP: IF ELCLASS ^= RTPAREN THEN 36025000=06125000= + BEGIN 36030000=06125000= + ERR(104); 36035000=06125000= + GO EXIT 36040000=06125000= + END; 36045000=06125000= + STEPIT; 36050000=06126000= +LDOT: 36055000=06127000= + DOT; 36060000=06127000= + COMMENT THIS CHECKS FOR PARTIAL WORDS; 36065000=06127000= +LAMPER: 36070000=06128000= + STACKCT:= STACKCT+1; 36075000=06128000= + WHILE ELCLASS = AMPERSAND DO 36080000=06129000= + BEGIN 36085000=06129000= + STEPIT; 36090000=06129000= + PRIMARY; 36095000=06129000= + PARSE 36100000=06129000= + END; 36105000=06129000= + COMMENT THIS CODE HANDLES CANCATENATES; 36110000=06130000= +EXIT: 36115000=06131000= + END PRIMARY; 36120000=06131000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36125000=06131000= + 36130000=06132000= + COMMENT BEXP IS THE BOOLEAN EXPRESSION ROUTINE; 36135000=06132000= + PROCEDURE BEXP; 36140000=06133000= + IF EXPRSS ^= BTYPE THEN 36145000=06133000= + ERR(107); 36150000=06133000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36155000=06133000= + 36160000=06134000= + COMMENT EXPRSS IS A GENERAL EXPRESSION ROUTINE CAPABLE OF COMPILING 36165000=06134000= + ANY GIVEN TYPE OF EXPRESSION. IT REPORTS ON ITS ACTION 36170000=06135000= + BY GIVING AS A RESULT EITHER ATYPE,BTYPE, OR DTYPE 36175000=06136000= + DEPENDING ON WHETHER IT COMPILED AN ARITHMETIC, BOOLEAN, 36180000=06137000= + OR DESIGNATIONAL EXPRESSION; 36185000=06138000= + INTEGER PROCEDURE EXPRSS; 36190000=06139000= + BEGIN 36195000=06140000= + IF ELCLASS = IFV THEN 36200000=06142000= + BEGIN 36205000=06142000= + IF EXPRSS:= IFEXP = ATYPE THEN 36210000=06144000= + IF ELCLASS = RELOP THEN 36215000=06144000= + ERR(108) 36220000=06145000= + END 36225000=06145000= + ELSE 36230000=06145000= + IF EXPRSS:= BOOSEC = BTYPE THEN 36235000=06145000= + SIMPBOO 36240000=06146000= + END EXPRSS; 36245000=06146000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36250000=06146000= + 36255000=06147000= + COMMENT BOOSEC COMPILES EITHER A BOOLEAN SECONDARY OR AN ARITHMETIC 36260000=06147000= + EXPRESSION OR A DESIGNATIONAL EXPRESSION. IT REPORTS 36265000=06148000= + AS EXPRSS REPORTS; 36270000=06149000= + INTEGER PROCEDURE BOOSEC; 36275000=06150000= + BEGIN 36280000=06151000= + BOOLEAN 36285000=06151000= + N; 36290000=06151000= + IF N:= ELCLASS = NOTOP THEN 36295000=06152000= + STEPIT; 36300000=06152000= + GT4:= BOOSEC:= BOOPRIM; 36305000=06153000= + IF N THEN 36310000=06154000= + BEGIN 36315000=06154000= + EMITLNG; 36320000=06154000= + EMIT(0); 36325000=06154000= + L:= L-1; 36330000=06154000= + COMMENT THE LAST LINE IS PREPARATORY. LATER ROUTINES USE THE 36335000=06155000= + RESULTS HERE TO ELIMINATE PAIRS OF LNGS; 36340000=06156000= + IF GT4 ^= BTYPE THEN 36345000=06157000= + ERR(109) 36350000=06158000= + COMMENT AN ARITHMETIC OR DESIGNATIONAL EXPRESSION MAY NOT BE 36355000=06158000= + LOGICALLY NEGATED; 36360000=06159000= + END 36365000=06160000= + END BOOSEC; 36370000=06160000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36375000=06160000= + 36380000=06161000= + COMMENT SIMPBOO COMPILES SIMPLE BOOLEAN EXPRESSIONS ON THE ASSUMPTION 36385000=06161000= + THAT A BOOLEAN PRIMARY HAS ALREADY BEEN COMPILED. IT 36390000=06162000= + ALSO HANDLES THE CASE OF A CONCATENATE WHERE ACTUALPARA- 36395000=06163000= + PART CAUSED THE VARIABLE ROUTINE TO COMPILE ONLY PART OF 36400000=06164000= + A PRIMARY. MOST OF THE WORK OF SIMPBOO IS DONE BY BOO- 36405000=06165000= + COMP. AN ARTIFIAL ROUTINE WHICH DOES THE HIERARCHY ANA- 36410000=06166000= + LYSIS USING RECURSION; 36415000=06167000= + PROCEDURE SIMPBOO; 36420000=06168000= + BEGIN 36425000=06169000= + WHILE ELCLASS = AMPERSAND DO 36430000=06171000= + BEGIN 36435000=06171000= + STEPIT; 36440000=06172000= + IF BOOPRIM ^= BTYPE THEN 36445000=06173000= + ERR(109); 36450000=06173000= + PARSE 36455000=06174000= + END; 36460000=06174000= + WHILE ELCLASS >= EQVOP AND ELCLASS <= ANDOP DO 36465000=06175000= + BOOCOMP 36470000=06176000= + END BOOCOMP; 36475000=06176000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36480000=06176000= + 36485000=06177000= + COMMENT BOOCOMP IS THE GUTS OF THE BOOLEAN EXPRESSION ROUTINE ANALYSIS.36490000=06177000= + IT CALLS BOOSEC AT APPROPRIATE TIMES AND EMITS THE BOOLEAN36495000=06178000= + OPERATORS. THE HIERARCHY ANALYSIS IS OBTAINED BY RECUR- 36500000=06179000= + SION; 36505000=06180000= + PROCEDURE BOOCOMP; 36510000=06181000= + BEGIN 36515000=06182000= + INTEGER 36520000=06182000= + OPCLASS, 36525000=06182000= + OPERATOR; 36530000=06182000= + LABEL 36535000=06182000= + EXIT; 36540000=06182000= + DO BEGIN 36545000=06183000= + OPERATOR:= 1 & ELBAT[I][36:17:10]; 36550000=06184000= + COMMENT THIS SETS UP THE OPERATOR WHICH WILL BE EMITTED. THE HIGH 36555000=06185000= + ORDER TEN BITS OF THE OPERATOR ARE LOCATED IN [17:10] 36560000=06186000= + OF THE ELBAT WORD; 36565000=06187000= + OPCLASS:= ELCLASS; 36570000=06188000= + STEPIT; 36575000=06189000= + IF BOOSEC ^= BTYPE THEN 36580000=06191000= + BEGIN 36585000=06191000= + ERR(109); 36590000=06191000= + GO TO EXIT 36595000=06191000= + END; 36600000=06191000= + WHILE OPCLASS < ELCLASS DO 36605000=06193000= + IF ELCLASS <= ANDOP THEN 36610000=06193000= + BOOCOMP 36615000=06194000= + ELSE 36620000=06194000= + BEGIN 36625000=06194000= + ERR(110); 36630000=06194000= + GO TO EXIT 36635000=06194000= + END; 36640000=06194000= + COMMENT THE CLASSES ARE ARRANGED IN ORDER OF HIERARCHY; 36645000=06195000= + STACKCT:= 1; 36650000=06195500= + IF OPCLASS = IMPOP THEN 36655000=06197000= + BEGIN 36660000=06197000= + COMMENT SINCE IMP IS NOT IN THE MACHINE REPETOIRE WE MUST CONSTRUCT 36665000=06198000= + ONE. NOTICE THAT WE USE EMITLNG IN ONE SPOT TO OBTAIN 36670000=06199000= + THE CANCELING OF POSSIBLE MULTIBLE LNGS. ALSO THE 0 36675000=06200000= + EMITTED PROVIDES THE POSSIBILITY OF DOING THIS IN THE 36680000=06201000= + FUTURE. (SEE CODE FOR EMITLNG); 36685000=06202000= + EMITLNG; 36690000=06203000= + EMITO(LND); 36695000=06204000= + EMITO(LNG); 36700000=06205000= + EMITO(0); 36705000=06206000= + L:= L-1 36710000=06207000= + END 36715000=06208000= + ELSE 36720000=06208000= + EMIT(OPERATOR) 36725000=06209000= + END 36730000=06209000= + UNTIL OPCLASS ^= ELCLASS; 36735000=06209000= +EXIT: 36740000=06210000= + END BOOCOMP; 36745000=06210000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%36750000=06210000= + 36755000=06211000= + COMMENT BOOPRIM COMPILES BOOLEAN PRIMARIES, AND ARITHMETIC OR 36760000=06211000= + DESIGNATIONAL EXPRESSIONS. IT REPORTS AS EXPRSS REPORTS; 36765000=06212000= + INTEGER PROCEDURE BOOPRIM; 36770000=06213000= + BEGIN 36775000=06214000= + INTEGER 36780000=06214000= + TYPE; 36785000=06214000= + LABEL 36790000=06215000= + L9, 36795000=06216000= + L10, 36800000=06216000= + L11, 36805000=06216000= + L12, 36810000=06216000= + L13, 36815000=06216000= + L14, 36820000=06216000= + L15, 36825000=06216000= + L16, 36830000=06216000= + L17, 36835000=06216000= + L18, 36840000=06216000= + L19, 36845000=06217000= + L20, 36850000=06217000= + L21, 36855000=06217000= + L22, 36860000=06217000= + L23, 36865000=06217000= + L24, 36870000=06217000= + L25, 36875000=06217000= + L26, 36880000=06217000= + L27, 36885000=06217000= + L28, 36890000=06217000= + L29, 36895000=06218000= + L30, 36900000=06218000= + L31, 36905000=06218000= + L32, 36910000=06218000= + L33, 36915000=06218000= + L34, 36920000=06218000= + L35; 36925000=06218000= + SWITCH 36930000=06219000= + S:= L9, 36935000=06220000= + L10, 36940000=06220000= + L11, 36945000=06220000= + L12, 36950000=06220000= + L13, 36955000=06220000= + L14, 36960000=06220000= + L15, 36965000=06220000= + L16, 36970000=06220000= + L17, 36975000=06220000= + L18, 36980000=06220000= + L19, 36985000=06221000= + L20, 36990000=06221000= + L21, 36995000=06221000= + L22, 37000000=06221000= + L23, 37005000=06221000= + L24, 37010000=06221000= + L25, 37015000=06221000= + L26, 37020000=06221000= + L27, 37025000=06221000= + L28, 37030000=06221000= + L29, 37035000=06222000= + L30, 37040000=06222000= + L31, 37045000=06222000= + L32, 37050000=06222000= + L33, 37055000=06222000= + L34, 37060000=06222000= + L35; 37065000=06222000= + COMMENT LN IS THE LABEL FOR THE CLASS N; 37070000=06223000= + LABEL 37075000=06224000= + EXIT, 37080000=06224000= + LE, 37085000=06224000= + D, 37090000=06224000= + TD, 37095000=06224000= + T; 37100000=06224000= + LABEL 37105000=06224500= + FAH; 37110000=06224500= + GO TO S[ELCLASS-SUPERFILEID]; 37115000=06225000= + IF ELCLASS = ADOP THEN 37120000=06226000= + GO TO L11; 37125000=06226000= + IF ELCLASS = UNKNOWNID THEN 37130000=06227000= + ERR(100); 37135000=06227000= + IF ELCLASS = FILEID OR ELCLASS = SUPERFILEID THEN 37140000=06227500= + BEGIN 37145000=06227510= + BOOPRIM:= TYPE:= FILEATTRIBUTEHANDLER(FP); 37150000=06227520= + GO FAH; 37155000=06227530= + END; 37160000=06227540= +LE: 37165000=06228000= +L10: 37170000=06228000= +L12: 37175000=06229000= + COMMENT NO BOOLEAN PRIMARY, ARITHMETIC EXPRESSION, OR DESIGNATIONAL 37180000=06229000= + EXPRESSION MAY BEGIN WITH QUANTITIES WITH THESE CLASSES; 37185000=06230000= + 37190000=06231000= + ERR(111); 37195000=06231000= + GO TO EXIT; 37200000=06231000= +L35: 37205000=06232000= + IF GT1:= ELBAT[I].ADDRESS = BOOV THEN 37210000=06233000= + BEGIN 37215000=06233000= + PANA; 37220000=06233000= + GO TO TD 37225000=06233000= + END; 37230000=06233000= + IF GT1 ^= REALV THEN 37235000=06234000= + BEGIN 37240000=06234000= + ERR(112); 37245000=06234000= + GO TO EXIT 37250000=06234000= + END; 37255000=06234000= +L11: 37260000=06235000= +L14: 37265000=06235000= +L15: 37270000=06235000= +L16: 37275000=06235000= +L18: 37280000=06235000= +L19: 37285000=06235000= +L20: 37290000=06235000= +L22: 37295000=06235000= +L23: 37300000=06235000= +L24: 37305000=06235000= +L26: 37310000=06235000= +L27: 37315000=06235000= +L28: 37320000=06236000= +L31: 37325000=06236000= +L32: 37330000=06236000= +L33: 37335000=06237000= + COMMENT ARITHMETIC TYPE STUFF; 37340000=06237000= + 37345000=06238000= + AEXP; 37350000=06238000= +D: IF ELCLASS ^= RELOP THEN 37355000=06239000= + BEGIN 37360000=06239000= + BOOPRIM:= ATYPE; 37365000=06239000= + GO EXIT 37370000=06239000= + END; 37375000=06239000= + RELATION; 37380000=06240000= + BOOPRIM:= BTYPE; 37385000=06241000= + GO TO EXIT; 37390000=06241000= +L13: 37395000=06243000= + COMMENT BOOLEAN STREAM PROCEDURE DESIGNATOR; 37400000=06243000= + 37405000=06243100= + IF ARRAYFLAG THEN 37410000=06243100= + CHECKBOUNDLVL; 37415000=06243100= + STRMPROCSTMT; 37420000=06244000= + GO TO TD; 37425000=06244000= +L17: 37430000=06246000= + COMMENT BOOLEAN PROCEDURE DESIGNATOR; 37435000=06246000= + 37440000=06246100= + IF ARRAYFLAG THEN 37445000=06246100= + CHECKBOUNDLVL; 37450000=06246100= + PROCSTMT(FALSE); 37455000=06247000= + GO TO TD; 37460000=06247000= +L21: 37465000=06248000= +L25: 37470000=06249000= + COMMENT BOOLEAN VARIABLES; 37475000=06249000= + 37480000=06249100= + IF ARRAYFLAG THEN 37485000=06249100= + CHECKBOUNDLVL; 37490000=06249100= + VARIABLE(FP); 37495000=06250000= + GO TO T; 37500000=06250000= +L9: 37505000=06251000= +L29: 37510000=06252000= + COMMENT LABELS AND SWITCHES; 37515000=06252000= + 37520000=06253000= + DEXP; 37525000=06253000= + BOOPRIM:= DTYPE; 37530000=06253000= + GO TO EXIT; 37535000=06253000= +L30: 37540000=06255000= + COMMENT TRUE OR FALSE; 37545000=06255000= + 37550000=06256000= + EMIT(0 & ELBAT[I][45:26:1]); 37555000=06256000= + STEPIT; 37560000=06256000= + GO TO T; 37565000=06256000= +L34: 37570000=06258000= + COMMENT (; 37575000=06258000= + 37580000=06259000= + STEPIT; 37585000=06259000= + TYPE:= BOOPRIM:= EXPRSS; 37590000=06259000= + COMMENT COMPILE THE EXPRESSION, WHATEVER IT IS; 37595000=06260000= + STACKCT:= STACKCT-1; 37600000=06260500= + IF ELCLASS ^= RTPAREN THEN 37605000=06261000= + BEGIN 37610000=06261000= + ERR(104); 37615000=06261000= + GO TO EXIT 37620000=06261000= + END; 37625000=06261000= + STEPIT; 37630000=06262000= +FAH: 37635000=06263000= + IF TYPE = DTYPE THEN 37640000=06263000= + GO TO EXIT; 37645000=06263000= + COMMENT FINISHED IF EXPRESSION COMPILED WAS DESIGNATIONAL; 37650000=06264000= + IF TYPE = BTYPE THEN 37655000=06265000= + BEGIN 37660000=06265000= + TD: DOT; 37665000=06266000= + COMMENT HANDLES PARTIAL WORDS; 37670000=06266000= + T: STACKCT:= STACKCT+1; 37675000=06267000= + WHILE ELCLASS = AMPERSAND DO 37680000=06267500= + COMMENT HANDLES CONCATENATE; 37685000=06268000= + BEGIN 37690000=06269000= + STEPIT; 37695000=06270000= + IF BOOPRIM ^= BTYPE THEN 37700000=06272000= + BEGIN 37705000=06272000= + ERR(109); 37710000=06272000= + GO TO EXIT 37715000=06272000= + END; 37720000=06272000= + PARSE 37725000=06273000= + END; 37730000=06273000= + BOOPRIM:= BTYPE; 37735000=06274000= + GO TO EXIT 37740000=06274000= + END; 37745000=06274000= + COMMENT IF NOT BOOLEAN OR DESIGNATIONAL, MUST COMPLETE ARITHMETIC 37750000=06275000= + EXPRESSION; 37755000=06276000= + DOT; 37760000=06277000= + SIMPARITH; 37765000=06277000= + GO TO D; 37770000=06277000= +EXIT: 37775000=06278000= + END BOOPRIM; 37780000=06278000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%37785000=06278000= + 37790000=06279000= + COMMENT RELATION COMPILES RELATIONS. IT ASSUMES THAT THE LEFTHAND 37795000=06279000= + EXPRESSION HAS ALREADY BEEN COMPILED; 37800000=06280000= + PROCEDURE RELATION; 37805000=06281000= + BEGIN 37810000=06282000= + INTEGER 37815000=06282200= + OPERATOR; 37820000=06282200= + REAL 37825000=06282400= + A; 37830000=06282400= + BOOLEAN 37835000=06282600= + SIGNA, 37840000=06282600= + CONSTANA, 37845000=06282600= + SIMPLE, 37850000=06282600= + MANY, 37855000=06282600= + SIGN; 37860000=06282600= + DEFINE 37865000=06282800= + FORMALNAME = [9:2] = 2 #; 37870000=06282800= + PROCEDURE PLUG(C, A, S); 37875000=06283000= + VALUE 37880000=06283000= + C, 37885000=06283000= + A, 37890000=06283000= + S; 37895000=06283000= + BOOLEAN 37900000=06283000= + C, 37905000=06283000= + S:REAL A; 37910000=06283000= + BEGIN 37915000=06283200= + IF C THEN 37920000=06283400= + EMITNUM(A) 37925000=06283600= + ELSE 37930000=06283600= + BEGIN 37935000=06283600= + CHECKER(A); 37940000=06283600= + EMITV(A.ADDRESS) 37945000=06283600= + END; 37950000=06283600= + IF S THEN 37955000=06283800= + EMITO(CHS); 37960000=06283800= + END PLUG; 37965000=06284000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%37970000=06284000= + DO BEGIN 37975000=06284200= + OPERATOR:= 1 & ELBAT[I][36:17:10]; 37980000=06284400= + 37985000=06284600= +COMMENT SET UP CODE FOR RELATIONAL OPERATOR TO BE 37990000=06284600= + EMITTED LATER (AFTER PROCESSING SECOND HALF). 37995000=06284800= + THE HIGH-ORDER BITS OF THE BINARY OPERATOR 38000000=06285000= + ARE TAKEN FROM THE [17:10] FIELD OF THE 38005000=06285200= + ELBAT WORD FRO THE RELATIONAL SYMBOL; 38010000=06285400= + IF MANY THEN 38015000=06285600= + IF SIMPLE THEN 38020000=06285800= + PLUG(CONSTANA, A, SIGNA) 38025000=06285800= + ELSE 38030000=06285800= + EMITV(JUNK); 38035000=06285800= + SIGNA:= FALSE; 38040000=06286000= + IF STEPI = ADOP THEN 38045000=06286200= + SIGNA:= ELBAT[I].ADDRESS = SUB; 38050000=06286200= + IF SIGN:= ELCLASS = ADOP THEN 38055000=06286400= + STEPIT; 38060000=06286400= + CONSTANA:= ELCLASS >= NONLITNO AND ELCLASS <= STRNGCON; 38065000=06286600= + A:= REAL(ELCLASS >= REALID AND ELCLASS <= INTID AND NOT 38070000=06287000= + ELBAT[I].FORMALNAME); 38075000=06287000= + SIMPLE:= (CONSTANA OR BOOLEAN(A)) AND STEPI = RELOP; 38080000=06287200= + IF SIMPLE THEN 38085000=06287400= + BEGIN 38090000=06287600= + IF CONSTANA THEN 38095000=06287800= + A:= C 38100000=06287800= + ELSE 38105000=06287800= + A:= ELBAT[I-1]; 38110000=06287800= + PLUG(CONSTANA, A, SIGNA) 38115000=06288200= + END 38120000=06288400= + ELSE 38125000=06288400= + BEGIN 38130000=06288400= + I:= I-REAL(SIGN)-2; 38135000=06288600= + STEPIT; 38140000=06288600= + AEXP; 38145000=06288600= + IF ELCLASS = RELOP THEN 38150000=06288800= + EMITPAIR(JUNK, SND); 38155000=06288800= + END; 38160000=06289000= + STACKCT:= 1; 38165000=06289200= + EMIT(OPERATOR); 38170000=06289200= + IF MANY THEN 38175000=06289400= + EMITO(LND); 38180000=06289400= + ELSE 38185000=06289600= + BEGIN 38190000=06289600= + EMIT(0); 38195000=06289600= + L:= L-1 38200000=06289600= + END; 38205000=06289600= + MANY:= TRUE; 38210000=06289800= + END 38215000=06290000= + UNTIL ELCASS ^= RELOP 38220000=06290200= + END RELATION; 38225000=06290200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%38230000=06290200= + 38235000=06292000= + COMMENT IFEXP COMPILES CONDITIONAL EXPRESSIONS. IT REPORTS THE TYPE 38240000=06292000= + OF EXPRESSIONS AS EXPRSS REPORTS; 38245000=06293000= + INTEGER PROCEDURE IFEXP; 38250000=06294000= + BEGIN 38255000=06295000= + INTEGER 38260000=06295000= + TYPE, 38265000=06295000= + THENBRANCH, 38270000=06295000= + ELSEBRANCH; 38275000=06295000= + IFCLAUSE; 38280000=06296000= + STACKCT:= 0; 38285000=06296500= + THENBRANCH:= BUMPL; 38290000=06297000= + COMMENT SAVE L FOR LATER FIXUP; 38295000=06298000= + IFEXP:= TYPE:= EXPRSS; 38300000=06299000= + COMMENT COMPILE 1ST EXPRSS; 38305000=06299000= + STACKCT:= 0; 38310000=06299500= + ELSEBRANCH:= BUMPL; 38315000=06300000= + EMITB(BFC, THEBRANCH, L); 38320000=06301000= + IF ELCLASS ^= ELSEV THEN 38325000=06302000= + ERR(155) 38330000=06302000= + ELSE 38335000=06302000= + BEGIN 38340000=06302000= + STEPIT; 38345000=06303000= + IF TYPE = ATYPE THEN 38350000=06304000= + AEXP 38355000=06304000= + ELSE 38360000=06304000= + IF TYPE = DTYPE THEN 38365000=06305000= + DEXP 38370000=06305000= + ELSE 38375000=06305000= + BEXP; 38380000=06305000= + STACKCT:= 1; 38385000=06305500= + COMMENT THIS COMPILES PROPER TYPE SECOND EXPRSS; 38390000=06306000= + EMITB(BFW, ELSEBRANCH, L); 38395000=06307000= + EMIT(1); 38400000=06308000= + L:= L-1; 38405000=06308000= + COMMENT THIS IS USED BY EMITLNG TO CLEANUP CODE. COMPARE WITH 38410000=06309000= + BOOSEC, BOOCOMP, AND RELATION; 38415000=06310000= + END 38420000=06311000= + END IFEXP; 38425000=06311000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%38430000=06311000= + PROCEDURE PARSE;%COMPILES CODE FOR THE CONCATENATE ; 38435000=06312000= + BEGIN 38440000=06312500= + INTEGER 38445000=06312500= + FIRST, 38450000=06312500= + SECOND, 38455000=06312500= + THIRD; 38460000=06312500= + BOOLEAN 38465000=06313000= + P1, 38470000=06313000= + P2, 38475000=06313000= + P3; 38480000=06313000= + LABEL 38485000=06313500= + L1, 38490000=06313500= + L2, 38495000=06313500= + L3, 38500000=06313500= + SKIP1, 38505000=06313500= + SKIP2, 38510000=06313500= + EXIT; 38515000=06313500= + IF ELCLASS = FIELDID THEN 38520000=06313550= + BEGIN 38525000=06313600= + FIRST:= ELBAT[I].SBITF; 38530000=06313650= + SECOND:= 48-(THIRD:= ELBAT[I].NBITF); 38535000=06313700= + GO TO SKIP1; 38540000=06313750= + END 38545000=06314000= + ELSE 38550000=06314000= + IF ELCLASS ^= LFTBRKET THEN 38555000=06314000= + BEGIN 38560000=06314000= + ERR(90); 38565000=06314000= + GO TO EXIT 38570000=06314000= + END; 38575000=06314000= + IF STEPI = FIELDID THEN 38580000=06314050= + BEGIN 38585000=06314100= + FIRST:= ELBAT[I].SBITF; 38590000=06314150= + SECOND:= 48-(THIRD:= ELBAT[I].NBITF); 38595000=06314200= + IF STEPI ^= RTBRKET THEN 38600000=06314250= + BEGIN 38605000=06314300= + ERR(94); 38610000=06314350= + GO TO EXIT; 38615000=06314400= + END; 38620000=06314450= + GO TO SKIP1; 38625000=06314500= + END 38630000=06314650= + ELSE 38635000=06314650= + IF ELCLASS ^= LITNO THEN % PREPARE FOR DYNAMIC DIAL 38640000=06314650= + GO TO L1; 38645000=06314700= + FIRST:= C; 38650000=06315000= + IF TABLE(I+1) = COLON THEN 38655000=06315500= + BEGIN 38660000=06316000= + STEPIT; 38665000=06316500= + IF FIRST <= 0 THEN 38670000=06317000= + FLAG(92); 38675000=06317000= + END 38680000=06318000= + ELSE 38685000=06318000= + BEGIN 38690000=06318000= + L1: EMITO(MKS); 38695000=06318500= + AEXP; 38700000=06319000= + P1:= TRUE; 38705000=06319500= + IF ELCLASS ^= COLON THEN 38710000=06320000= + BEGIN 38715000=06320000= + ERR(91); 38720000=06320000= + GO TO EXIT 38725000=06320000= + END; 38730000=06320000= + END; 38735000=06320500= + IF STEPI ^= LITNO THEN 38740000=06321000= + GO TO L2; 38745000=06321000= + SECOND:= C; 38750000=06321500= + IF GT1:= TABLE(I+1) = COLON THEN 38755000=06322000= + BEGIN 38760000=06322500= + STEPIT; 38765000=06323000= + IF SECOND <= 0 THEN 38770000=06323500= + FLAG(092); 38775000=06323500= + END 38780000=06324500= + ELSE 38785000=06324500= + BEGIN 38790000=06324500= + IF GT1 = RTBRKET THEN 38795000=06325000= + BEGIN 38800000=06325500= + STEPIT; 38805000=06326000= + SECOND:= 48-(THIRD:= SECOND); 38810000=06326500= + GO TO SKIP2; 38815000=06327000= + END; 38820000=06327500= + L2: IF NOT P1 THEN 38825000=06328000= + BEGIN 38830000=06328000= + EMITO(MKS); 38835000=06328000= + EMITL(FIRST) 38840000=06328000= + END; 38845000=06328000= + AEXP; 38850000=06328500= + P1:= P2:= TRUE; 38855000=06329000= + IF ELCLASS = COLON THEN 38860000=06329100= + ELSE 38865000=06329400= + IF ELCLASS = RTBRKET THEN 38870000=06329400= + BEGIN 38875000=06329450= + EMITO(DUP); 38880000=06329500= + EMITL(48); 38885000=06329550= + EMITO(SUB); 38890000=06329550= + EMITO(CHS); 38895000=06329600= + EMITO(XCH); 38900000=06329600= + P3:= TRUE; 38905000=06329700= + GO TO SKIP1; 38910000=06329800= + END 38915000=06329900= + ELSE 38920000=06329900= + BEGIN 38925000=06329900= + ERR(91); 38930000=06329900= + GO TO EXIT 38935000=06329900= + END; 38940000=06329900= + END; 38945000=06330000= + IF STEPI ^= LITNO THEN 38950000=06330500= + GO L3; 38955000=06330500= + THIRD:= C; 38960000=06330600= + IF TABLE(I+1) = RTBRKET THEN 38965000=06330700= + BEGIN 38970000=06330800= + STEPIT; 38975000=06331000= + SKIP2: 38980000=06331100= + IF THIRD <= 0 OR THIRD > 47 THEN 38985000=06331100= + FLAG(95); 38990000=06331100= + END 38995000=06331300= + ELSE 39000000=06331300= + BEGIN 39005000=06331300= + L3: IF NOT P2 THEN 39010000=06331500= + BEGIN 39015000=06331600= + IF NOT P1 THEN 39020000=06331700= + BEGIN 39025000=06331700= + EMITO(MKS); 39030000=06331700= + EMITL(FIRST) 39035000=06331700= + END; 39040000=06331700= + EMITL(SECOND); 39045000=06331800= + END; 39050000=06332000= + AEXP; 39055000=06332100= + P1:= P2:= P3:= TRUE; 39060000=06332200= + IF ELCLASS ^= RTBRKET THEN 39065000=06332300= + BEGIN 39070000=06332300= + ERR(94); 39075000=06332300= + GO TO EXIT 39080000=06332300= + END; 39085000=06332300= + END; 39090000=06332400= +SKIP1: 39095000=06332500= + IF P1 THEN 39100000=06332500= + BEGIN 39105000=06333000= + IF NOT P2 THEN 39110000=06333500= + EMITL(SECOND); 39115000=06333500= + IF NOT P3 THEN 39120000=06334000= + BEGIN 39125000=06334100= + EMITL(THIRD); 39130000=06334200= + EMITL(1); 39135000=06334200= + EMITV(GNAT(DIALER)); 39140000=06334500= + EMIT(TRB & THIRD[36:42:6]); 39145000=06334600= + END 39150000=06335000= + ELSE 39155000=06335000= + BEGIN 39160000=06335000= + EMITL(0); 39165000=06335100= + EMITV(GNAT(DIALER)); 39170000=06335200= + EMITO(DEL); 39175000=06335500= + END; 39180000=06335700= + END 39185000=06336100= + ELSE 39190000=06336100= + BEGIN 39195000=06336100= + IF FIRST+THIRD > 48 OR SECOND+THIRD > 48 THEN 39200000=06336200= + FLAG(095); 39205000=06336200= + EMITD(SECOND, FIRST, THIRD); 39210000=06336300= + END; 39215000=06336400= + STEPIT; 39220000=06336500= +EXIT: 39225000=06336600= + STACKCT:= 1; 39230000=06336600= + END PARSE; 39235000=06336700= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39240000=06336700= + 39245000=06337000= + COMMENT DOT COMPILES CODE FOR PARTIAL WORD DESIGNATORS,EXCEPT FOR 39250000=06337000= + THOSE CASES HANDLED BY THE VARIABLE ROUTINE ; 39255000=06337100= + PROCEDURE DOTIT; 39260000=06338000= + BEGIN 39265000=06339000= + INTEGER 39270000=06339000= + FIRST, 39275000=06339000= + SECOND; 39280000=06339000= + LABEL 39285000=06339000= + EXIT; 39290000=06339000= + IF DOTSYNTAX(FIRST, SECOND) THEN 39295000=06340000= + GO TO EXIT; 39300000=06340000= + EMITI(0, FIRST, SECOND); 39305000=06343000= + STEPIT; 39310000=06345000= +EXIT: 39315000=06346000= + END DOTIT; 39320000=06346000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39325000=06346000= + 39330000=06347000= + COMMENT GENGO CONSTRUCTS THE CALL ON AN INTRINSIC PROCEDURE WHICH 39335000=06347000= + PREPARES A LABEL DESCRIPTOR FOR THE MCP. THE MCP EXPECTS 39340000=06348000= + THE F-REGISTER AND THE BLOCKCTR TO BE IN THIS DESCRIPTOR, 39345000=06349000= + SO THAT STORAGE CAN BE PROPERLY RETURNED. THE BLOCKCTR 39350000=06350000= + IS AN OBJECT TIME COUNTER IN A FIXED CELL IN THE PRT. IT 39355000=06351000= + IS INCREMENTED AND DECREMENTED AT ENTRY AND EXIT FROM 39360000=06352000= + BLOCKS,IF NECESSARY. THE CODE TO DO THIS IS COMPILED BY 39365000=06353000= + THE BLOCK ROUTINE. IN A PROCEDURE, THE BLOCKCTR AT ENTRY 39370000=06354000= + IS ALSO STORED IN F+1; 39375000=06355000= + PROCEDURE GENGO(ELBATWORD); 39380000=06356000= + VALUE 39385000=06356000= + ELBATWORD; 39390000=06356000= + REAL 39395000=06356000= + ELBATWORD; 39400000=06356000= + BEGIN 39405000=06357000= + INTEGER 39410000=06357000= + TLEVEL; 39415000=06357000= + EMITO(MKS); 39420000=06358000= + IF TLEVEL:= ELBATWORD.LVL > JUMPCTR THEN 39425000=06359000= + JUMPCTR:= TLEVEL; 39430000=06360000= + COMMENT JUMPCTR IS USED BY THE BLOCK ROUTINE TO THINK ABOUT 39435000=06361000= + INCREMENTING AND DECREMENTING THE BLOCKCTR. HERE WE TELL 39440000=06362000= + BLOCK ROUTINE ABOUT THE LEVEL TO WHICH OUR BAD GO TO IS 39445000=06363000= + JUMPING; 39450000=06364000= + IF TLEVEL < FRSTLEVEL OR MODE = 0 THEN 39455000=06366000= + BEGIN 39460000=06366000= + COMMENT OUR BAD GO TO IS JUMPING OUTSIDE OF ALL PROCEDURES; 39465000=06367000= + EMIT(0); 39470000=06368000= + EMIT(TLEVEL); 39475000=06369000= + END 39480000=06370000= + ELSE 39485000=06370000= + BEGIN 39490000=06370000= + EMITN(512); 39495000=06371000= + EMITV(513); 39500000=06372000= + COMENT PICK UP BLOCKCTR AT ENTRY FROM F+1; 39505000=06373000= + IF TLEVEL:= TLEVEL-SUBLEVEL-1 ^= 0 THEN 39510000=06375000= + BEGIN 39515000=06375000= + EMITL(TLEVEL); 39520000=06376000= + EMITO(ADD) COMMENT IF JUMP IS NOT TO SAME LEVEL 39525000=06377000= + AS AT ENTRY TIME, FUDGE THE COUNTER; 39530000=06378000= + END 39535000=06379000= + END; 39540000=06379000= + EMITV(GNAT(GOTOSOLVER)) COMMENT CALL THE INTRINSIC; 39545000=06380000= + END GENGO; 39550000=06381000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39555000=06381000= + 39560000=06382000= + COMMENT DEXP COMPILES DESIGNATIONAL EXPRESSIONS. FOR THE MOST PART 39565000=06382000= + IT ASSUMES THAT A COMMUNICATE IS GOING TO BE USED AGAINST 39570000=06383000= + THE LABEL DESCRIPTOR IN ORDER TO OBTAIN GO TO ACTION, 39575000=06384000= + STORAGE RETURN, AND STACK CUT BACK. HOWEVER IF IT NEVER 39580000=06385000= + SETS GOTOG TO TRUE THEN THE LABELS ARE ALL LOCAL AND NO 39585000=06386000= + COMMUNICATE WILL BE DONE; 39590000=06387000= + PROCEDURE DEXP; 39595000=06388000= + BEGIN 39600000=06389000= + LABEL 39605000=06390000= + EXIT; 39610000=06390000= + BOOLEAN 39615000=06391000= + S, 39620000=06391000= + F; 39625000=06391000= + REAL 39630000=06392000= + ELBW; 39635000=06392000= + IF(S:= ELCLASS = SWITCHID) OR ELCLASS = LABELID THEN 39640000=06394000= + BEGIN 39645000=06394000= + CHECKER(ELBW:= ELBAT[I]); 39650000=06395000= + SCATTERELBAT; 39655000=06396000= + IF LEVEL ^= LEVELF OR F:= FORMALF THEN 39660000=06397000= + GOTOG:= TRUE; 39665000=06397000= + IF FAULTOG THEN 39670000=06397100= + IF S OR F THEN 39675000=06397200= + FAULTLEVEL:= 1 39680000=06397200= + ELSE 39685000=06397200= + IF FAULTLEVEL > LEVELF THEN 39690000=06397300= + FAULTLEVEL:= LEVELF; 39695000=06397300= + IF S THEN 39700000=06398000= + BEGIN 39705000=06398000= + BANA; 39710000=06399000= + EMITPAIR(JUNK, ISD); 39715000=06399000= + EMITV(GNAT(ELBW)); 39720000=06400000= + IF F THEN 39725000=06401000= + GO TO EXIT; 39730000=06401000= + END 39735000=06402000= + ELSE 39740000=06402000= + BEGIN 39745000=06402000= + STEPIT; 39750000=06403000= + IF F THEN 39755000=06404000= + BEGIN 39760000=06404000= + EMITV(ADDRSF); 39765000=06404000= + GO TO EXIT 39770000=06404000= + END; 39775000=06404000= + EMITL(GNAT(ELBW)) 39780000=06405000= + END; 39785000=06405000= + GENGO(ELBW); 39790000=06406000= + END 39795000=06407000= + ELSE 39800000=06407000= + IF EXPRSS ^= DTYPE THEN 39805000=06407000= + ERR(115); 39810000=06407000= +EXIT: 39815000=06408000= + END DEXP; 39820000=06408000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39825000=06408000= + PROCEDURE IFCLAUSE; 39830000=06409000= + BEGIN 39835000=06410000= + STEPIT; 39840000=06410000= + STACKCT:= 0; 39845000=06410000= + BEXP; 39850000=06410000= + IF ELCLASS ^= THENV THEN 39855000=06411000= + ERR(116) 39860000=06411000= + ELSE 39865000=06411000= + STEPIT 39870000=06411000= + END IFCLAUS; 39875000=06411000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39880000=06411000= + 39885000=06412000= + COMMENT PANA COMPILES THE CONSTRUCT: (); 39890000=06412000= + PROCEDURE PANA; 39895000=06413000= + BEGIN 39900000=06414000= + IF STEPI ^= LEFTPAREN THEN 39905000=06415000= + ERR(105) 39910000=06416000= + ELSE 39915000=06416000= + BEGIN 39920000=06416000= + STEPIT; 39925000=06416000= + AEXP; 39930000=06416000= + IF ELCLASS ^= RTPAREN THEN 39935000=06416000= + ERR(104) 39940000=06417000= + ELSE 39945000=06417000= + STEPIT 39950000=06417000= + END 39955000=06417000= + END PANA; 39960000=06417000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%39965000=06417000= + 39970000=06418000= + COMMENT BANA COMPILES THE CONSTRUCT: []; 39975000=06418000= + PROCEDURE BANA; 39980000=06419000= + BEGIN 39985000=06420000= + IF STEPI ^= LFTBRKET THEN 39990000=06421000= + ERR(117) 39995000=06422000= + ELSE 40000000=06422000= + BEGIN 40005000=06422000= + STEPIT; 40010000=06422000= + AEXP; 40015000=06422000= + IF ELCLASS ^= RTBRKET THEN 40020000=06422000= + ERR(118) 40025000=06423000= + ELSE 40030000=06423000= + STEPIT 40035000=06423000= + END 40040000=06423000= + END BANA; 40045000=06423000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40050000=06423000= + PROCEDURE MAKEALABEL; 40055000=06500000= + BEGIN 40060000=06501000= + LABEL 40065000=06501000= + EXIT; 40070000=06501000= + REAL 40075000=06501000= + I; 40080000=06501000= + STREAMTOG:= FALSE; 40085000=06502000= + EMITO(MKS); 40090000=06503000= + PASSFILE; 40095000=06503000= + IF ELCLASS ^= WITHV THEN 40100000=06504000= + BEGIN 40105000=06505000= + ERR(301); 40110000=06505000= + GO TO EXIT 40115000=06505000= + END; 40120000=06505000= + FOR I:= 1 STEP 1 UNTIL 6 DO 40125000=06506000= + BEGIN 40130000=06507000= + IF STEPI = FACTOP THEN 40135000=06507000= + BEGIN 40140000=06508000= + EMIT(4); 40145000=06508000= + EMITO(CHS); 40150000=06508000= + STEPIT 40155000=06508000= + END 40160000=06509000= + ELSE 40165000=06509000= + AEXP; 40170000=06509000= + IF ELCLASS ^= COMMA THEN 40175000=06510000= + GO TO EXIT; 40180000=06510000= + END; 40185000=06511000= +EXIT: 40190000=06512000= + FOR I:= I STEP 1 UNTIL 5 DO 40195000=06512000= + BEGIN 40200000=06512100= + EMIT(4); 40205000=06512100= + EMITO(CHS) 40210000=06512100= + END; 40215000=06512100= + EMITL(11); 40220000=06512200= + EMITV(5); 40225000=06513000= + END; 40230000=06514000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40235000=06514000= + 40240000=07000000= + COMMENT THIS SECTION CONTAINS THE STATEMENT ROUTINES; 40245000=07000000= + 40250000=07001000= + COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 40255000=07001000= + COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES 40260000=07002000= + ARE SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE 40265000=07003000= + FOR RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME 40270000=07004000= + CARE IS ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 40275000=07005000= + PROCEDURE COMPOUNDTAIL; 40280000=07006000= + BEGIN 40285000=07007000= + LABEL 40290000=07007000= + ANOTHER; 40295000=07007000= + I:= I-1; 40300000=07008000= + BEGINCTR:= BEGINCTR+1; 40305000=07008000= +ANOTHER: 40310000=07009000= + ERRORTOG:= TRUE; 40315000=07009000= + COMMENT ALLOW ERROR MESSAGES; 40320000=07009000= + STEPTIT; 40325000=07010000= + IF STREAMTOG THEN 40330000=07011000= + STREAMSTMT 40335000=07011000= + ELSE 40340000=07011000= + STMT; 40345000=07011000= + IF ELCLASS = SEMICOLON THEN 40350000=07012000= + GO TO ANOTHER; 40355000=07012000= + IF ELCLASS ^= ENDV THEN 40360000=07014000= + BEGIN 40365000=07014000= + ERR(119); 40370000=07015000= + GO TO ANOTHER 40375000=07015000= + END; 40380000=07015000= + ENDTOG:= TRUE; 40385000=07016000= + DO 40390000=07017000= + STOPDEFINE:= TRUE 40395000=07018000= + UNTIL STEPI <= ENDV AND ELCLASS >= UNTILV OR NOT ENDTOG; 40400000=07019000= + ENDTOG:= FALSE; 40405000=07020000= + IF BEGINCTR:= BEGINCTR-1 ^= 0 EQV ELCLASS = PERIOD THEN 40410000=07022000= + BEGIN 40415000=07022000= + IF BEGINCTR = 0 THEN 40420000=07023000= + BEGIN 40425000=07024000= + FLAG(143); 40430000=07024000= + BEGINCTR:= 1; 40435000=07024000= + GO ANOTHER 40440000=07024000= + END; 40445000=07024000= + FLAG(120); 40450000=07025000= + FCR:= (LCR:= MKABS(CBUFF[9]))-9; 40455000=07025010= + IF LISTER THEN 40460000=07025020= + PRINTCARD; 40465000=07025020= + FCR:= (LCR:= MKABS(TBUFF[9]))-9 40470000=07025030= + END; 40475000=07025030= + IF ELCLASS = PERIOD THEN 40480000=07026000= + BEGIN 40485000=07027000= + GT5:= 6"ND;END."&6"E"[1:43:5]; 40490000=07028000= + MOVE(1, GT5, CBUFF[0]); 40495000=07029000= + LASTUSED:= 4; 40500000=07030000= + ELBAT[I:= I-2]:= SPECIAL[20]; 40505000=07031000= + ELCLASS:= SEMICOLON 40510000=07032000= + END 40515000=07033000= + END COMPOUNDTAIL; 40520000=07033000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%40525000=07033000= + COMMENT ACTUAPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON 40530000=07034000= + PARAMETERS. IT HANDLES THE ENTIRE PARAMETER LIST WITH 40535000=07035000= + ONE CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR 40540000=07036000= + NON-CORRESPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 40545000=07037000= + CONCERNING THE PARAMETERS: 40550000=07038000= + FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL 40555000=07039000= + OR NOT. 40560000=07040000= + SBIT TELLS IF THE PROCEDURE BEING CALLED IS A STREAM 40565000=07041000= + PROCEDURE OR NOT. 40570000=07042000= + INDEX IS THE INDEX INTO INFO OF THE ADDITIONAL 40575000=07043000= + INFORMATION; 40580000=07044000= + PROCEDURE ACTUALPARAPART(FBIT, SBIT, INDEX); 40585000=07045000= + VALUE 40590000=07046000= + FBIT, 40595000=07046000= + SBIT, 40600000=07046000= + INDEX; 40605000=07046000= + BOOLEAN 40610000=07047000= + FBIT, 40615000=07047000= + SBIT; 40620000=07047000= + INTEGER 40625000=07048000= + INDEX; 40630000=07048000= + BEGIN 40635000=07049000= + INTEGER 40640000=07050000= + PCTR, 40645000=07050000= + ACLASS, 40650000=07050000= + SCLASS; 40655000=07050000= + COMMENT 40660000=07051000= + PCTR IS A COUNT OF THE NUMBER OF PARAMETERS 40665000=07052000= + COMPILED. 40670000=07053000= + ACLASS IS THE CLASS OF THE ACTUAL PARAMETER- 40675000=07054000= + SCLASS IS TEH CLASS OF THE FORMAL PARAMETER. 40680000=07055000= + THEY ARE PUT IN A NORMALIZED FORM IN ORDER 40685000=07056000= + TO ALLOW INTEGER, REAL, AND ALPHA TO HAVE 40690000=07057000= + SIMILAR MEANINGS; 40695000=07058000= + REAL 40700000=07059000= + WHOLE; 40705000=07059000= + COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL 40710000=07060000= + PARAMETERS; 40715000=07061000= + BOOLEAN 40720000=07062000= + VBIT; 40725000=07062000= + COMMENT VBIT TELLS WHETHER OR NOT THE PARAMETER IS TO40730000=07063000= + BE CALLED BY VALUE OR BY NAME; 40735000=07064000= + LABEL 40740000=07065000= + ANOTHER, 40745000=07065000= + NORMAL, 40750000=07065000= + VE, 40755000=07065000= + STORE, 40760000=07065000= + LRTS, 40765000=07065000= + LOWBD, 40770000=07065000= + FINISHBOO, 40775000=07066000= + LODPOINT, 40780000=07066000= + NSBS, 40785000=07066000= + BS, 40790000=07066000= + COMMON, 40795000=07066000= + LP, 40800000=07066000= + GOBBLE, 40805000=07066000= + BSXX, 40810000=07066000= + BSX, 40815000=07066000= + EXIT, 40820000=07067000= + CERR, 40825000=07067000= + FGEN; 40830000=07067000= + LABEL 40835000=07069000= + L4, 40840000=07069000= + L5, 40845000=07069000= + L6, 40850000=07069000= + L7, 40855000=07069000= + L8, 40860000=07069000= + L9, 40865000=07069000= + L10, 40870000=07069000= + L11, 40875000=07069000= + L12, 40880000=07069000= + L13, 40885000=07069000= + L14, 40890000=07069000= + L15, 40895000=07069000= + L16, 40900000=07069000= + L17, 40905000=07070000= + L18, 40910000=07070000= + L19, 40915000=07070000= + L20, 40920000=07070000= + L21, 40925000=07070000= + L22, 40930000=07070000= + L23, 40935000=07070000= + L24, 40940000=07070000= + L25, 40945000=07070000= + L26, 40950000=07070000= + L27, 40955000=07070000= + L28, 40960000=07070000= + L29, 40965000=07070000= + L30, 40970000=07071000= + L31, 40975000=07071000= + L32, 40980000=07071000= + L33; 40985000=07071000= + SWITCH 40990000=07072000= + S:= L4, 40995000=07073000= + L5, 41000000=07073000= + L6, 41005000=07073000= + L7, 41010000=07073000= + L8, 41015000=07073000= + L9, 41020000=07073000= + L10, 41025000=07073000= + L11, 41030000=07073000= + L12, 41035000=07073000= + L13, 41040000=07073000= + L14, 41045000=07073000= + L15, 41050000=07073000= + L16, 41055000=07073000= + L17, 41060000=07074000= + L18, 41065000=07074000= + L19, 41070000=07074000= + L20, 41075000=07074000= + L21, 41080000=07074000= + L22, 41085000=07074000= + L23, 41090000=07074000= + L24, 41095000=07074000= + L25, 41100000=07074000= + L26, 41105000=07074000= + L27, 41110000=07074000= + L28, 41115000=07074000= + L29, 41120000=07074000= + L30, 41125000=07075000= + L31, 41130000=07075000= + L32, 41135000=07075000= + L33; 41140000=07075000= + REAL 41145000=07076000= + T1, 41150000=07076000= + T2, 41155000=07076000= + T3, 41160000=07076000= + T4, 41165000=07076000= + T5, 41170000=07076000= + T6; 41175000=07076000= + COMMENT EXAMINE LATER WITH EYE 41180000=07076000= + TO REDUCING TOTAL NUMBER; 41185000=07077000= + PCTR:= 1; 41190000=07078000= +ANOTHER: 41195000=07079000= + ACLASS:= STEPI; 41200000=07079000= + WHOLE:= ELBAT[I]; 41205000=07079000= + SCATTERELBAT; 41210000=07079000= + STACKCT:= 0; 41215000=07079500= + COMMENT SETUP FIELDS OF AN ACTUAL PARAMETER; 41220000=07080000= + IF FBIT THEN 41225000=07081000= + BEGIN 41230000=07081000= + VBIT:= FALSE; 41235000=07081000= + SCLASS:= LOCLID 41240000=07081000= + END 41245000=07082000= + COMMENT IF PROCEDURE IS FORMAL ALL CALLS ARE BY NAME AND NO CHECK 41250000=07082000= + IS MADE FOR CORRESPONDENCE OF ACTUAL AND FORMAL PARA 41255000=07083000= + METERS SETTING SCLASS TO LOCID HELPS TO COMPRESS CHECK; 41260000=07084000= + ELSE 41265000=07085000= + BEGIN 41270000=07085000= + VBIT:= BOOLEAN(GT1:= TAKE(INDEX+PCTR)).V0; 41275000=07086000= + IF SCLASS:= GT1.CLASS <= INTARRAYID AND SCLASS >= BOOSTRPROCID 41280000=07089000= + THEN 41285000=07089000= + IF GT1:= (SCLASS-BOOSTRPROCID) MOD 4 ^= 0 THEN 41290000=07090000= + SCLASS:= SCLASS-GT1+1 41295000=07091000= + COMMENT IF PROCEDURE IS NOT FORMAL WE OBTAIN VBIT FROM THE ADDITION-41300000=07091000= + AL INFO FOR THE PROCEDURE. WE ALSO GET SCLASS FROM THIS 41305000=07092000= + SOURCE. HOWEVER SCLASS IS NORMALIZED TO REAL, IF NEEDED; 41310000=07093000= + END; 41315000=07094000= + IF T1:= TABLE(I+1) ^= COMMA THEN 41320000=07095000= + IF T1 ^= RTPAREN THEN 41325000=07096000= + COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY - 41330000=07097000= + HENCE A DIFFERENT ANALYSIS IS REQUIRED; 41335000=07098000= + BEGIN 41340000=07099000= + IF ACLASS <= IDMAX OR ACLESS = SUPERLISTID THEN 41345000=07099000= + CHECKER(WHOLE); 41350000=07099500= + IF ACLASS < BOOARRAYID OR ACLASS > INTARRAYID THEN 41355000=07101000= + BEGIN 41360000=07101000= + COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY NAME - 41365000=07102000= + HENCE THE PARAMETER IS AN EXPRESSION, A SUPERFORMAT, A 41370000=07103000= + SUPERFILE, AN INDEXED FILE OR SUPERLIST; 41375000=07104000= + IF ACLASS = SUPERFRMTID THEN 41380000=07105000= + BEGIN 41385000=07106000= + ACLASS:= FRMTID; 41390000=07106000= + GO TO FGEN 41395000=07106000= + END; 41400000=07106000= + IF ACLASS = SUPERFILEID OR ACLASS = FILEID THEN 41405000=07108000= + BEGIN 41410000=07108000= + T4:= L; 41415000=07108500= + EMITO(NOP); %MAY NEED FOR FILEATTRIBUTES. 41420000=07108500= + IF NOT VBIT THEN 41425000=07108505= + EMITO(NOP); % DITTO. 41430000=07108505= + ACLASS:= FILEID; 41435000=07109000= + COMMENT IT IS EITHER AN INDEXED FILE OR A SUPERFILE (OR BOTH); 41440000=07110000= + PASSFILE; 41445000=07111000= + IF ELCLASS = PERIOD THEN % THEN FILE ATTRIBUTE 41450000=07111200= + BEGIN 41455000=07111210= + IF VBIT THEN 41460000=07111220= + BEGIN 41465000=07111225= + T5:= L; 41470000=07111230= + L:= T4; 41475000=07111230= + EMITO(MKS); 41480000=07111230= + L:= T5; 41485000=07111230= + T5:= 0; 41490000=07111230= + END; 41495000=07111235= + ACLASS:= 41500000=07111240= + IF FILEATTRIBUTEHANDLER(FA) = ATYPE THEN 41505000=07111250= + REALID 41510000=07111250= + ELSE 41515000=07111250= + BOOID; 41520000=07111250= + IF ELCLASS ^= COMMA AND ELCLASS ^= RTPAREN THEN 41525000=07111255= + IF ACLASS = BOOID THEN 41530000=07111260= + SIMPBOO 41535000=07111260= + ELSE 41540000=07111260= + BEGIN 41545000=07111265= + SIMPARITH; 41550000=07111270= + IF ELCLASS = RELOP THEN 41555000=07111275= + BEGIN 41560000=07111280= + ACLASS:= BOOID; 41565000=07111285= + RELATION; 41570000=07111285= + SIMPBOO; 41575000=07111290= + END; 41580000=07111295= + END; 41585000=07111300= + IF NOT VBIT THEN 41590000=07111303= + BEGIN 41595000=07111307= + EMITPAIR(JUNK, STD); 41600000=07111310= + EMITN(JUNK); 41605000=07111310= + EMITO(RTS); 41610000=07111315= + ADJUST; 41615000=07111315= + CONSTANTCLEAN; 41620000=07111315= + EMITO(MKS); 41625000=07111320= + EMITB(BBW, BUMPL, T4+2); 41630000=07111320= + EMITB(BFW, T4+2, L); 41635000=07111325= + STUFFF(PROGDESCBLDR(0, L-3, 0)); 41640000=07111330= + END; 41645000=07111335= + GO BS; 41650000=07111340= + END OF FILE ATTRIBUTE PARAMETER EXPRESSION; 41655000=07111345= + IF ELCLASS ^= LEFTPAREN THEN 41660000=07112000= + GO TO BS; 41665000=07112000= + I:= I-1; 41670000=07113000= + COMMENT IF WE ARE HERE IT IS INDEXED; 41675000=07114000= + CHECKPRESENCE; 41680000=07115000= + EMITO(LOD); 41685000=07116000= + PANA; 41690000=07116000= + EMITO(CDC); 41695000=07116000= + IF SCLASS = FILEID OR NOT SBIT OR VBIT THEN 41700000=07118000= + BEGIN 41705000=07118000= + ERR(121); 41710000=07118000= + GO TO CERR 41715000=07118000= + END 41720000=07119000= + COMMENT AN INDEXED FILE MAY BE PASSED BY NAME ONLY AND ONLY TO A 41725000=07119000= + STREAM PROCEDURE THE STREAM PROCEDURE MAY NOT DO A 41730000=07120000= + RELEASE ON THIS DESCRIPTOR; 41735000=07121000= + ELSE 41740000=07122000= + GO TO COMMON 41745000=07122000= + END; 41750000=07122000= + IF ACLASS = SUPERLISTID THEN 41755000=07122500= + BEGIN 41760000=07122500= + BANA; 41765000=07122500= + EMITV(WHOLE.ADDRESS); 41770000=07122510= + IF WHOLE.ADDRESS > 1023 THEN 41775000=07122520= + EMITO(PRTE); 41780000=07122520= + EMITO(LOD); 41785000=07122530= + ACLASS:= LISTID; 41790000=07122540= + GO TO BS 41795000=07122540= + END; 41800000=07122540= + COMMENT NORMAL IS REACHED ONLY IF THE PARAMETER IS AN EXPRESSION; 41805000=07123000= + NORMAL: 41810000=07124000= + IF VBIT THEN 41815000=07124000= + VE: T1:= EXPRSS COMMENT VALUE CALL EXPRESSION; 41820000=07125000= + ELSE 41825000=07126000= + BEGIN 41830000=07126000= + COMMENT NAME CALL EXPRESSION; 41835000=07126000= + IF SBIT THEN 41840000=07127000= + BEGIN 41845000=07127000= + FLAG(122); 41850000=07127000= + GO TO CERR 41855000=07127000= + END; 41860000=07127000= + COMMENT STREAM PROCEDURES MAY NOT HAVE EXPRESSIONS PASSED BY NAME;41865000=07128000= + T2:= BAE; 41870000=07129000= + T3:= PROGDESCBLDR(0, L, 0); 41875000=07130000= + COMMENT BUILD DESCRIPTOR FOR ACCIDENTAL ENTRY AND PREPARE JUMP 41880000=07131000= + AROUND CODE FOR EXPRESSION; 41885000=07132000= + T1:= EXPRSS; 41890000=07133000= + COMMENT COMPILE EXPRESSION; 41895000=07133000= + STORE: 41900000=07134000= + EMITPAIR(JUNK, STD); 41905000=07134000= + EMITN(JUNK); 41910000=07134000= + COMMENT THIS PROVIDES FOR PROTECTION IF ONE ATTEMPTS INSIDE OF A 41915000=07135000= + PROCEDURE TO STORE INTO AN EXPRESSION - THE STORE GOES 41920000=07136000= + INTO JUNK; 41925000=07137000= + LRTS: 41930000=07138000= + EMITO(RTS); 41935000=07138000= + CONSTANTCLEAN; 41940000=07138000= + EMITB(BFW, T2, L); 41945000=07138000= + STUFFF(T3) 41950000=07139000= + COMMENT LRTS IS RESPONSIBLE FOR THE CLEANUP ASSOCIATED WITH ALL 41955000=07139000= + THE ACCIIDENTAL ENTRIES COMPILED BY ACTUALPARAPART. IT 41960000=07140000= + EMITS THE RETURN SPECIAL, DOES A CONSTANTCLEAN, FINISHES 41965000=07141000= + THE BRANCH OPERATION AND PROVIDES FOR THE POSSIBILITY 41970000=07142000= + OF STUFFING F INTO THE ACCIDENTAL ENTRY DESCRIPTOR; 41975000=07143000= + END OF NAME CALL EXPRESSIONS; 41980000=07144000= + ACLASS:= 41985000=07145000= + IF T1 = ATYPE THEN 41990000=07145000= + REALID 41995000=07145000= + ELSE 42000000=07145000= + IF T1 = BTYPE THEN 42005000=07146000= + BOOID 42010000=07146000= + ELSE 42015000=07146000= + LABELID; 42020000=07146000= + GO TO BS; 42025000=07146000= + END OF EXPRESSION CALL CODE; 42030000=07147000= + COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS WITH AN 42035000=07148000= + ARRAY NAME FOLLOWED BY SOMETHING ELSE; 42040000=07149000= + IF SCLASS >= BOOARRAYID THEN 42045000=07150000= + IF SCLASS <= INTARRAYID THEN 42050000=07151000= + BEGIN 42055000=07152000= + T2:= TAKE(INDEX+PCTR).INCR; 42060000=07152000= + COMMENT THE FORMAL PARAMETER CALLS FOR AN ARRAY AS ACTUAL PARAMETER.42065000=07153000= + THUS WE MUST HAVE A ROW DESIGNATOR; 42070000=07154000= + IF ACLASS ^= BOOARRAYID THEN 42075000=07155000= + ACLASS:= REALARRAYID; 42080000=07155000= + COMMENT NORMALISE ACLASS FOR LATER COMPARISON; 42085000=07156000= + VARIABLE(FA); 42090000=07157000= + IF TABLE(I-2) ^= FACTOP THEN 42095000=07158000= + BEGIN 42100000=07158000= + ERR(123); 42105000=07158000= + GO TO EXIT 42110000=07158000= + END; 42115000=07158000= + COMMENT IT MUST BE A ROW DESIGNATOR - OTHERWISE IT IS AN ERROR; 42120000=07159000= + 42125000=07163000= + COMMENT VARIABLE EMITS LOWER BOUNDS FOR EACH ASTERISK SUBSCRIPT. 42130000=07163000= + STLB IS THE NUMBER OF SUCH SUBSCRIPTS; 42135000=07164000= + LOWBD: 42140000=07165000= + IF T2 ^= STLB THEN 42145000=07165000= + BEGIN 42150000=07165000= + FLAG(124); 42155000=07165000= + GO TO CERR 42160000=07165000= + END THE FORMAL PARAMETER MUST BE AN ARRAY OF ONE DIMENSION42165000=07167000= + ELSE 42170000=07167000= + GO TO BS 42175000=07167000= + END; 42180000=07167000= + IF VBIT THEN 42185000=07168000= + GO TO VE; 42190000=07168000= + COMMENT IF THE FORMAL PARAMETER DOES NOT CALL FOR AN ARRAY AND 42195000=07169000= + VBIT IS SET WE MUST HAVE A VALUE CALL EXPRESSION; 42200000=07170000= + IF SBIT THEN 42205000=07172000= + BEGIN 42210000=07172000= + T6:= FL; 42215000=07173000= + VARIABLE(T6); 42220000=07173000= + IF T6 ^= 0 THEN 42225000=07174000= + GO TO BS; 42230000=07174000= + FLAG(122); 42235000=07175000= + GO TO CERR 42240000=07175000= + END; 42245000=07175000= + COMMENT IF PROCEDURE IS A STREAM PROCEDURE THEN WE COMPILE NAME 42250000=07176000= + CALL EXPRESSION. IT MUST BE SIMPLY A SUBSCRIPTED 42255000=07177000= + VARIABLE OR A ROW DESIGNATOR. IF VARIABLE DOES MORE 42260000=07178000= + THAN THIS IT SETS T6 TO ZERO; 42265000=07179000= + COMMENT IF THIS PLACE IS REACHED WE HAVE A NON-STREAM PROCEDURE. 42270000=07180000= + WE HAVE NOT YET DECEIDED WHETHER WE HAVE 42275000=07181000= + 1) A ROW DESIGNATOR WITH FORMAL PROCEDURE. 42280000=07182000= + 2) A SUBSCRIPTED VARIABLE, OR 42285000=07183000= + 3) A GENUINE NAME CALL EXPRESSION; 42290000=07184000= + IF TABLE(I+2) = LITNO AND 42295000=07187000= + (GT1:= TABLE(I+4) = COMMA OR GT1 = RTPAREN) 42300000=07187000= + THEN 42305000=07187000= + BEGIN 42310000=07187000= + COMMENT WE HAVE HERE A ONE DIMENSIONAL SUBCRIPTED VARIABLE WITH 42315000=07188000= + CONSTANT LOWER BOUNDS. WE MAKE A SPECIAL CASE TO AVOID 42320000=07189000= + ACCIDENTAL ENTRY AND ADDITIONAL PRT CELL; 42325000=07190000= + VARIABLE(FL); 42330000=07191000= + ACLASS:= 42335000=07192000= + IF ACLASS = BOOARRAYID THEN 42340000=07192000= + BOOID 42345000=07192000= + ELSE 42350000=07192000= + REALID; 42355000=07193000= + GO TO BS 42360000=07193000= + END; 42365000=07193000= + T2:= BAE; 42370000=07194000= + T3:= L; 42375000=07194000= + COMMENT WE PREPARE FOR ACCIDENTAL ENTRY EVEN THOUGH WE KNOW NOT YET 42380000=07195000= + IF WE HAVE ROW DESIGNATOR; 42385000=07196000= + T6:= FA; 42390000=07197000= + VARIABLE(T6); 42395000=07197000= + IF TABLE(I-2) = FACTOP THEN 42400000=07199000= + BEGIN 42405000=07199000= + COMMENT WE HAVE A ROW DESIGNATOR AFTER ALL; 42410000=07200000= + EMITB(BFW, T2, T3); 42415000=07201000= + T2:= STLB; 42420000=07201000= + GO TO LOWBD 42425000=07201000= + END; 42430000=07201000= + COMMENT WE NOW KNOW WE NEED ACCIDENTAL ENTRY; 42435000=07202000= + T3:= PROGDESCBLDR(0, T3, 0); 42440000=07203000= + T1:= 42445000=07204000= + IF BOOARRAYID = ACLASS THEN 42450000=07204000= + BTYPE 42455000=07204000= + ELSE 42460000=07204000= + ATYPE; 42465000=07204000= + IF ELCLASS = COMMA OR ELCLASS = RTPAREN THEN 42470000=07205000= + COMMENT WE ARE AT END OF PARAMETER; 42475000=07206000= + IF T6 = 0 THEN 42480000=07207000= + COMMENT MORE THAN SUBSCRIPTED VARIABLE; 42485000=07207000= + GO TO STORE 42490000=07208000= + ELSE 42495000=07208000= + COMMENT SUBSCRIPTED VARIABLE; 42500000=07208000= + GO TO LRTS; 42505000=07209000= + IF T1 = BTYPE THEN 42510000=07210000= + GO TO FINISHBOO; 42515000=07210000= + SIMPARITH; 42520000=07210000= + IF ELCLASS = RELOP THEN 42525000=07211000= + BEGIN 42530000=07211000= + T1:= BTYPE; 42535000=07211000= + RELATION; 42540000=07211000= + FINISHBOO: 42545000=07212000= + SIMPBOO 42550000=07212000= + END; 42555000=07212000= + GO TO STORE 42560000=07212000= + END; 42565000=07212000= + COMMENT WHEN WE GET HERE WE HAVE THE CASE OF A SINGLE QUANTITY 42570000=07213000= + ACTUAL PARAMETER; 42575000=07214000= + IF ACLASS <= IDMAX OR ACLASS = SUPERLISTID THEN 42580000=07215000= + CHECKER(WHOLE); 42585000=07215500= + STEPIT; 42590000=07215500= + GO TO S[ACLASS-3]; 42595000=07216000= + IF ACLASS = 0 THEN 42600000=07217000= + FLAG(100) 42605000=07217000= + ELSE 42610000=07217000= + IF ACLASS = SUPERLISTID THEN 42615000=07217500= + BEGIN 42620000=07217510= + EMITPAIR(ADDRSF, LOD); 42625000=07217510= + GO TO BS 42630000=07217510= + END; 42635000=07217510= + FLAG(126); 42640000=07217520= +CERR: 42645000=07219000= +L12: 42650000=07219000= +L13: 42655000=07219000= +L14: 42660000=07219000= +L15: 42665000=07219000= +L16: 42670000=07220000= + COMMENT STREAM PROCEDURES MAY NOT BE PASSED AS PARAMETERS; 42675000=07220000= + 42680000=07221000= + FLAG(125); 42685000=07221000= + ERRORTOG:= TRUE; 42690000=07221000= + GO TO COMMON; 42695000=07221000= +LODPOINT: 42700000=07223000= +L4: 42705000=07223000= +L8: COMMENT LIST, SUPERLIST OR SUPERFILE; 42710000=07224000= + EMITPAIR(ADDRSF, LOD); 42715000=07225000= +NSBS: 42720000=07226000= + IF SBIT THEN 42725000=07226000= + BEGIN 42730000=07226000= + FLAG(127); 42735000=07226000= + GO TO CERR 42740000=07226000= + END; 42745000=07226000= + COMMENT ITEMS WHICH FIND THEIR WAY HERE MAY NOT BE PASSED TO 42750000=07227000= + STREAM PROCEDURES; 42755000=07228000= +BS: IF SCLASS ^= ACLASS THEN 42760000=07229000= + IF SCLASS ^= LOCLID THEN 42765000=07230000= + COMMENT IF WE ARRIVE HERE THE ACTUAL AND FORMAL PARAMETERS DO NOT 42770000=07231000= + AGREE; 42775000=07232000= + BEGIN 42780000=07233000= + FLAG(123); 42785000=07233000= + GO TO CERR 42790000=07233000= + END; 42795000=07233000= +COMMON: 42800000=07235000= + COMMENT ARRIVAL HERE CAUSES THE NEXT PARAMETER TO BE EXAMINED; 42805000=07235000= + 42810000=07236000= + PCTR:= PCTR+1; 42815000=07236000= + IF ELCLASS = COMMA THEN 42820000=07237000= + GO TO ANOTHER; 42825000=07237000= + IF ELCLASS ^= RTPAREN THEN 42830000=07239000= + BEGIN 42835000=07239000= + ERROR(129); 42840000=07239000= + GO TO EXIT 42845000=07239000= + END; 42850000=07239000= + IF NOT FBIT THEN 42855000=07240000= + IF TAKE(INDEX).NODIMPART+1 ^= PCTR THEN 42860000=07242000= + BEGIN 42865000=07242000= + COMMENT WRONG NUMBER OF PARAMETERS; 42870000=07242000= + ERR(128); 42875000=07243000= + GO TO EXIT 42880000=07243000= + END; 42885000=07243000= + STEPIT; 42890000=07244000= + GO TO EXIT; 42895000=07244000= +L5: 42900000=07246000= + COMMENT FORMATS; 42905000=07246000= + I:= I-1; 42910000=07247000= +FGEN: 42915000=07248000= + PASSFORMAT; 42920000=07248000= + IF SBIT THEN 42925000=07249000= + BEGIN 42930000=07249000= + EMITO(XCH); 42935000=07249000= + EMITO(CDC) 42940000=07249000= + END; 42945000=07249000= + I:= I+1; 42950000=07250000= + GO TO BS; 42955000=07251000= +L6: 42960000=07253000= + COMMENT SUPERFORMAT; 42965000=07253000= + IF FBIT THEN 42970000=07255000= + BEGIN 42975000=07255000= + EMITV(ADDRSF); 42980000=07255000= + ADDRSF:= ADDRSF-1 42985000=07255000= + END 42990000=07256000= + ELSE 42995000=07256000= + BEGIN 43000000=07256000= + I:= I-1; 43005000=07256000= + EMITL(TAKEFRST); 43010000=07256000= + I:= I+1 43015000=07256000= + END; 43020000=07256000= + GO TO LODPOINT; 43025000=07257000= +L7: 43030000=07259000= + COMMENT FILE; 43035000=07259000= + I:= I-1; 43040000=07260000= + ELCLASS:= FILEID; 43045000=07260000= + PASSFILE; 43050000=07261000= + GO TO BS; 43055000=07261000= +L9: 43060000=07263000= + COMMENT SWITCH; 43065000=07263000= + IF FORMALF THEN 43070000=07264000= + GO TO LODPOINT; 43075000=07264000= + COMMENT OTHERWISE WE BUILD ACCIDENTAL ENTRY AND SET UP SO THAT 43080000=07265000= + MCP HANDLES LABEL PROPERLY. SEE IN PARTICULAR OTHER 43085000=07266000= + DISCUSSIONS OF GO TO PROBLEM. IT SHOULD BE NOTED THAT 43090000=07267000= + ALL BUT VERY SIMPLE SWITCHES ARE MARKED FORMAL, WHETHER 43095000=07268000= + THEY ARE OR NOT; 43100000=07269000= + T2:= BAE; 43105000=07270000= + T3:= PROGDESCBLDR(0, L, 0); 43110000=07270000= + EMITV(GNAT(WHOLE)); 43115000=07270000= + GENGO(WHOLE); 43120000=07271000= + EMITO(RTS); 43125000=07272000= + EMITB(BFW, T2, L); 43130000=07272000= + STUFFF(T3); 43135000=07272000= + GO TO NSBS; 43140000=07272000= +L10: 43145000=07274000= + COMMENT PROCEDURE; 43150000=07274000= + 43155000=07275000= + TB1:= TRUE; 43160000=07275000= + IF FORMALF THEN 43165000=07275000= + GO LODPOINT; 43170000=07275000= +LP: IF T1:= TAKE(WHOLE:= GIT(WHOLE)).[40:8] = 0 THEN 43175000=07277000= + BEGIN 43180000=07277000= + COMMENT THE PRCOEDURE BEING PASSED HAS ZERO PARAMETERS; 43185000=07278000= + IF TB1 THEN 43190000=07279000= + GO TO LODPOINT; 43195000=07279000= + COMMENT IF THE PROCEDURE IS NOT A FUNCTION, WE PASS THE PROCEDURE 43200000=07280000= + DESCRIPTOR ITSELF (IN BOTH CASES THE PARAMETER PROCEDURE);43205000=07281000= + IF NOT FBIT THEN 43210000=07281900= + IF SCLASS <= INTPROCID THEN 43215000=07282000= + SCLASS:= SCLASS+4; 43220000=07282000= + I:= I-2; 43225000=07283000= + STEPIT; 43230000=07283000= + GO TO NORMAL; 43235000=07284000= + COMMENT WE LET OUT NORMAL MECHANISM FOR 43240000=07284000= + EXPRESSIONS HANDLE THIS CASE; 43245000=07285000= + END THE CASE OF ZERO PARAMETERS; 43250000=07286000= + TB1:= TRUE; 43255000=07287000= + FOR T2:= 1 STEP 1 UNTIL T1 DO 43260000=07289000= + BEGIN 43265000=07289000= + IF BOOLEAN(T3:= TAKE(WHOLE+T2)).V0 THEN 43270000=07291000= + IF T4:= T3.CLASS < BOOARRAYID OR T4 > INTARRAYID THEN 43275000=07293000= + BEGIN 43280000=07293000= + COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS VALUE; 43285000=07294000= + IF TB1 THEN 43290000=07295000= + BEGIN 43295000=07296000= + COMMENT THIS IS THE FIRST VALUE PARAMETER. IF ANY PARAMETERS ARE 43300000=07297000= + VALUE WE BUILD A THINK WHICH SEES THAT WHEN THIS 43305000=07298000= + PROCEDURE IS CALLED FORMALLY, ITS PARAMETERS THAT ARE 43310000=07299000= + VALUE GET CALLED BY VALUE. SINCE THIS IS FIRST VALUE 43315000=07300000= + PARAMETER WE CONSTRUCT THUNK HERE AND INHIBIT FUTURE THUNK43320000=07301000= + CONSTRUCTIONS; 43325000=07302000= + GOBBLE: 43330000=07304000= + TB1:= FALSE; 43335000=07304000= + T5:= BAE; 43340000=07304000= + T6:= PROGDESCBLDR(1, L, 0) 43345000=07305000= + END; 43350000=07305000= + EMITV(T4:= T3.ADDRESS); 43355000=07306000= + EMITPAIR(T4, STD) 43360000=07306000= + END 43365000=07306000= + END; 43370000=07306000= + COMMENT THIS CALLS THE T2-TH PARAMETER BY VALUE; 43375000=07307000= + IF NOT TB1 THEN 43380000=07309000= + BEGIN 43385000=07309000= + COMMENT THERE WERE VALUE CALLS SO FINISH CONSTRUCTION OF THINK; 43390000=07310000= + EMITPAIR(ADDRSF, LOD); 43395000=07311000= + EMITO(BFW); 43400000=07311000= + CONSTANTCLEAN; 43405000=07312000= + EMITB(BFW, T5, L); 43410000=07312000= + ADDRSF:= T6 43415000=07312000= + END; 43420000=07312000= + GO TO LODPOINT; 43425000=07313000= + COMMENT IN ANY CASE LOAD A DESCRIPTOR; 43430000=07313000= +L11: 43435000=07315000= + COMMENT INTRINSIC PROCEDURE; 43440000=07315000= + 43445000=07316000= + ADDRSF:= GNAT(WHOLE); 43450000=07316000= + COMMENT GET PRT SPACE IF NOT ASSIGNED; 43455000=07317000= + ACLASS:= REALPROCID; 43460000=07318000= + T3.ADDRESS:= 897; 43465000=07319000= + T2:= T1:= 1; 43470000=07319000= + GO TO GOBBLE; 43475000=07319000= + COMMENT THIS MAKES THE INTRINSICS LOOK LIKE ORDINARY 43480000=07320000= + PROCEDURES; 43485000=07321000= +L19: 43490000=07322000= +L20: 43495000=07323000= + COMMENT ALFAPROC AND INTPROC; 43500000=07323000= + 43505000=07324000= + ACLASS:= REALPROCID; 43510000=07324000= +L17: 43515000=07325000= +L18: 43520000=07326000= + COMMENT BOOPROC AND REAL PROC; 43525000=07326000= + 43530000=07327000= + IF FORMALF THEN 43535000=07328000= + BEGIN 43540000=07328000= + COMMENT THE PROCEDURE BEING PASSED IS ACTUALLY A FORMAL PARAMETER; 43545000=07329000= + IF SCLASS > INTPROCID THEN 43550000=07330000= + ACLASS:= ACLASS+4; 43555000=07330000= + COMMENT CHANGE ACLASS SO THAT IT LOOKS LIKE WE ARE PASSING AN 43560000=07331000= + EXPRESSION. THE FORMAL PARAMETER DOES NOT CALL FOR A 43565000=07332000= + PROCEDURE SO IT MUST CALL FOR AN EXPRESSION; 43570000=07333000= + IF VBIT THEN 43575000=07335000= + BEGIN 43580000=07335000= + EMITV(ADDRSF); 43585000=07335000= + GO TO BS 43590000=07335000= + END 43595000=07336000= + ELSE 43600000=07336000= + GO TO LODPOINT; 43605000=07336000= + COMMENT IF VBIT WE DO VALUE CALL. OTHERWISE WE PASS PROCEDURE 43610000=07337000= + DESCRIPTOR ALONG; 43615000=07338000= + END; 43620000=07339000= + TB1:= FALSE; 43625000=07340000= + GO TO LP; 43630000=07340000= +L23: 43635000=07341000= +L24: 43640000=07342000= + COMMENT INTEGER AND ALPHA IDS; 43645000=07342000= + 43650000=07343000= + ACLASS:= REALID; 43655000=07343000= +L21: 43660000=07344000= +L22: 43665000=07345000= + COMMENT BOOLEAN AND REAL IDS; 43670000=07345000= + 43675000=07346000= + IF VBIT THEN 43680000=07346000= + EMITV(ADDRSF) 43685000=07347000= + ELSE 43690000=07347000= + IF NOT (SBIT OR VONF) AND FORMALF THEN 43695000=07348000= + GO TO LODPOINT 43700000=07348000= + ELSE 43705000=07348000= + EMITN(ADDRSF); 43710000=07348000= + COMMENT JUST PASS THE DESCRIPTOR ALONG IF PROCEDURE IS NOT STREAM 43715000=07349000= + AND ACTUAL PARAMETER IS A NAME CALL FORMAL PARAMETER. IF 43720000=07350000= + THESE CONDITIONS ARE NOT MET DO DESCRIPTOR CALL; 43725000=07351000= + GO TO BS; 43730000=07352000= +L27: 43735000=07353000= +L28: 43740000=07354000= + COMMENT INTEGER AND ALPHA ARRAYS; 43745000=07354000= + 43750000=07355000= + ACLASS:= REALARRAYID; 43755000=07355000= +L25: 43760000=07356000= +L26: 43765000=07357000= + COMMENT BOOLEAN AND REAL ARRAYS; 43770000=07357000= + 43775000=07358000= + EMITPAIR(ADDRSF, LOD); 43780000=07358000= + IF SBIT THEN 43785000=07359000= + GO TO BS; 43790000=07359000= + COMMENT LOWER BOUNDS ARE NOT PASSED TO STREAM PROCEDURES; 43795000=07360000= + T1:= TAKE(WHOLE:= GIT(WHOLE)).NODIMPART; 43800000=07361000= + FOR T2:= 1 STEP 1 UNTIL T1 DO 43805000=07363000= + BEGIN 43810000=07363000= + IF T3:= (STLB:= TAKE(WHOLE+T2)).[35:11] > 1023 THEN 43815000=07365000= + EMITV(T3) 43820000=07365000= + ELSE 43825000=07365000= + EMIT(STLB); 43830000=07365000= + IF STLB.[23:10] = ADD THEN 43835000=07366000= + EMITO(CHS) 43840000=07366000= + END; 43845000=07366000= + COMMENT THIS CODE EMITTED CALLS ON LOWER BOUNDS; 43850000=07367000= + IF FBIT THEN 43855000=07368000= + GO TO BS; 43860000=07368000= + IF TAKE(INDEX+PCTR).INCR ^= T1 THEN 43865000=07369000= + FLAG(124); 43870000=07369000= + GO TO BS; 43875000=07369000= + COMMENT ERROR IF ACTUAL AND FORMAL ARRAY DO NOT HAVE SAME NUMBER 43880000=07370000= + OF DIMENSIONS; 43885000=07371000= +L29: 43890000=07373000= + COMMENT LABEL; 43895000=07373000= + 43900000=07374000= + ELCLASS:= TABLE(I:= I-1); 43905000=07374000= + DEXP; 43910000=07374000= + GO TO NSBS; 43915000=07374000= +L30: 43920000=07376000= + COMMENT TRUTH VALUE; 43925000=07376000= + 43930000=07377000= + EMITL(ADDRSF); 43935000=07377000= + ACLASS:= BOOID; 43940000=07377000= + GO TO BSX; 43945000=07377000= +L32: 43950000=07379000= + COMMENT LITERAL; 43955000=07379000= + 43960000=07380000= + EMITL(ADDRSF); 43965000=07380000= +BSXX: 43970000=07381000= + ACLASS:= REALID; 43975000=07381000= +BSX: 43980000=07382000= + IF SBIT AND NOT VBIT THEN 43985000=07382000= + FLAG(150); 43990000=07382000= + GO TO BS; 43995000=07382000= +L31: 44000000=07383000= +L33: 44005000=07384000= + EMITNUM(C); 44010000=07384000= + GO TO BSXX; 44015000=07384000= +EXIT: 44020000=07385000= + STACKCT:= 0 44025000=07385000= + END OF ACTUALPARAPART; 44030000=07385000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%44035000=07385000= + 44040000=07386000= + COMMENT PROCSTMT COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND 44045000=07386000= + FUNCTION CALLS (EXCEPT FOR STREAM PROCEDURES). THE 44050000=07387000= + PARAMETERS, FROM, TELLS WHO CALLED. IF STMT CALLED FROM 44055000=07388000= + IS TRUE, PROCSTMT ALSO HANDLES FUNCTION NAME ASSIGNMENT 44060000=07389000= + OPERATIONS; 44065000=07390000= + PROCEDURE PROCSTMT(FROM); 44070000=07391000= + VALUE 44075000=07391000= + FROM; 44080000=07391000= + BOOLEAN 44085000=07391000= + FROM; 44090000=07391000= + BEGIN 44095000=07392000= + REAL 44100000=07393000= + HOLE, 44105000=07393000= + ADDRESS; 44110000=07393000= + LABEL 44115000=07394000= + EXIT; 44120000=07394000= + SCATTERELBAT; 44125000=07395000= + HOLE:= ELBAT[I]; 44130000=07396000= + ADDRESS:= ADDRSF; 44135000=07397000= + CHECKER(HOLE); 44140000=07398000= + IF ELCLASS ^= PROCID THEN 44145000=07399000= + IF NOT FORMALF THEN 44150000=07400000= + IF TABLE(I+1) = ASSIGNOP THEN 44155000=07401000= + BEGIN 44160000=07402000= + VARIABLE(2-REAL(FROM)); 44165000=07402000= + GO TO EXIT 44170000=07402000= + END; 44175000=07402000= + COMMENT CALL VARIABLE TO HANDLE THIS ASSIGNMENT OPERATION; 44180000=07403000= + IF ELCLASS ^= PROCID EQV FROM THEN 44185000=07405000= + BEGIN 44190000=07405000= + ERR(159); 44195000=07405000= + GO TO EXIT 44200000=07405000= + END; 44205000=07405000= + COMMENT IT IS PROCEDURE IF AND ONLY WE COME FROM STMT; 44210000=07406000= + STEPIT; 44215000=07407000= + EMITO(MKS); 44220000=07408000= + IF ELCLASS = LEFTPAREN THEN 44225000=07410000= + ACTUALPARAPART(FORMALF, FALSE, GIT(HOLE)) 44230000=07411000= + ELSE 44235000=07411000= + IF FORMALF THEN 44240000=07411000= + IF FROM THEN 44245000=07411100= + ELSE 44250000=07411100= + L:= L-1 44255000=07412000= + ELSE 44260000=07412000= + IF TAKE(GIT(HOLE)).NODIMPART ^= 0 THEN 44265000=07412000= + ERR(128); 44270000=07412000= + EMITV(ADDRESS); 44275000=07413000= + COMMENT MONITOR CODE GOES HERE; 44280000=07414000= + IF HOLE < 0 THEN 44285000=07416000= + BEGIN 44290000=07416000= + COMMENT THIS IS A MONITORED FUNCTION DESIGNATOR44295000=07416000= + ; 44300000=07417000= + EMITL(JUNK); 44305000=07418000= + EMITO(SND); 44310000=07418000= + EMITO(MKS); 44315000=07418000= + EMITL(JUNK); 44320000=07419000= + EMITL(PASSTYPE(HOLE)); 44325000=07419000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 44330000=07420000= + PASSALPHA(HOLE); 44335000=07420000= + EMITPAIR(GNAT(CHARI), LOD); 44340000=07421000= + PASSMONFILE(TAKE(GIT(HOLE)).FUNCMONFILE); 44345000=07422000= + EMITNUM(1 & CARDNUMBER[1:4:44]); 44350000=07422100= + EMITV(GNAT(PRINTI)); 44355000=07423000= + END; 44360000=07424000= +EXIT: 44365000=07425000= + END PROCSTMT; 44370000=07425000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%44375000=07425000= + 44380000=07426000= + COMMENT STRMPROCSTMT COMPILES CODE FOR CALLS ON ALL STREAM PROCEDURES;44385000=07426000= + PROCEDURE STRMPROCSTMT; 44390000=07427000= + BEGIN 44395000=07428000= + INTEGER 44400000=07429000= + ADDRS; 44405000=07429000= + IF ADDRS:= ELBAT[I].ADDRESS = 0 THEN 44410000=07431000= + BEGIN 44415000=07431000= + UNKNOWNSTMT; 44420000=07432000= + END 44425000=07440000= + ELSE 44430000=07440000= + BEGIN 44435000=07440000= + IF ELCLASS ^= STRPROCID THEN 44440000=07441000= + EMIT(0); 44445000=07441000= + EMITO(MKS); 44450000=07441000= + STEPIT; 44455000=07441000= + GT1:= (GT2:= TAKE(GT3:= GIT(ELBAT[I-1]))).[14:10]; 44460000=07442000= + GT4:= GT1-GT2.[7:6]; 44465000=07443000= + FOR GT1:= GT1-1 STEP-1 UNTIL GT4 DO 44470000=07445000= + EMITV(IF GT1 >= 512 THEN GT1+1024 ELSE GT1); 44475000=07445000= + COMMENT THIS CODE CALLS LABELS FROM PRT WHICH ARE NEEDED FOR LONG 44480000=07446000= + JUMPS INSIDE OF STREAM PROCEDURES; 44485000=07447000= + GT4:= GT2.[1:6]; 44490000=07448000= + FOR GT1:= 1 STEP 1 UNTIL GT4 DO 44495000=07449000= + EMIT(0); 44500000=07449000= + COMMENT THIS CODE CALLS ZERO LISTS TO MAKE SPACE FOR LOCALS INSIDE44505000=07450000= + OF STREAM PROCEDURES; 44510000=07451000= + IF ELCLASS ^= LEFTPAREN THEN 44515000=07452000= + ERR(128) 44520000=07453000= + ELSE 44525000=07453000= + BEGIN 44530000=07453000= + ACTUALPARAPART(FALSE, TRUE, GT3); 44535000=07454000= + EMITV(ADDRS) 44540000=07454000= + END; 44545000=07454000= + END 44550000=07455000= + END STRMPROCSTMT; 44555000=07455000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%44560000=07455000= + 44565000=07456000= + COMMENT BAE BUILDS AN ACCIDENTAL ENTRY ( OR AT LEAST PREPARES FOR 44570000=07456000= + ONE TO BE BUILT). IT RETURNS VALUE OF L AT ENTRY; 44575000=07457000= + INTEGER PROCEDURE BAE; 44580000=07458000= + BEGIN 44585000=07459000= + BAE:= BUMPL; 44590000=07459000= + CONSTANTCLEAN; 44595000=07459000= + ADJUST 44600000=07459000= + END BAE; 44605000=07459000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%44610000=07459000= + 44615000=07460000= +COMMENT RELSESTMT COMPILES THE RELEASE STATEMENT: 44620000=07460000= + RELEASE() % AUXMEM RELEASE STATEMENT. 44625000=07460250= + RELEASE() % DATACOM RELEASE STATEMENT. 44630000=07460500= + RELEASE() % FILE RELEASE STATEMENT. 44635000=07460750= + ; 44640000=07461000= + PROCEDURE RELSESTMT; 44645000=07461250= + BEGIN 44650000=07461500= + LABEL 44655000=07461750= + DCR, 44660000=07461750= + PARENCHECK, 44665000=07461750= + EXIT; 44670000=07461750= + IF STEPI ^= LEFTPAREN THEN 44675000=07462000= + BEGIN 44680000=07462250= + ERR(105); 44685000=07462250= + GO EXIT 44690000=07462250= + END; 44695000=07462250= + IF STEPI = UNKNOWNID THEN 44700000=07462500= + BEGIN 44705000=07462750= + ERR(100); 44710000=07462750= + GO EXIT 44715000=07462750= + END; 44720000=07462750= + IF ELCLASS = PROCID OR RANGE(BOOPROCID, INTPROCID) THEN 44725000=07463000= + BEGIN 44730000=07463250= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 44735000=07463500= + EMITPAIR(38, COM); 44740000=07463500= + EMITO(DEL); 44745000=07463750= + STEPIT; 44750000=07463750= + GO PARENCHECK; 44755000=07463750= + END; 44760000=07464000= + IF RANGE(BOOARRAYID, INTARRAYID) THEN 44765000=07464250= + BEGIN 44770000=07464500= + REL:= TRUE; 44775000=07464750= + AEXP; 44780000=07464750= + REL:= FALSE; 44785000=07464750= + IF TABLE(I-2) = FACTOP THEN 44790000=07465000= + BEGIN 44795000=07465250= + STACKCT:= STACKCT-1; 44800000=07465250= + EMITPAIR(38, COM); 44805000=07465500= + EMIT0(DEL); 44810000=07465500= + GO PARENCHECK; 44815000=07465500= + END 44820000=07466000= + ELSE 44825000=07466000= + BEGIN % DATACOM RELEASE. 44830000=07466000= + DCR: 44835000=07466500= + EMITL(2); 44840000=07466500= + EMITO(XCH); 44845000=07466500= + EMITL(0); 44850000=07466500= + EMITO(XCH); 44855000=07466500= + EMITL(0); 44860000=07466750= + EMITPAIR(32, COM); 44865000=07466750= + EMITO(DEL); 44870000=07466750= + EMITO(DEL); 44875000=07467000= + EMITO(DEL); 44880000=07467000= + EMITO(DEL); 44885000=07467000= + GO PARENCHECK; 44890000=07467000= + END; 44895000=07467250= + END; 44900000=07467500= + IF FLCLASS ^= FILEID AND ELCLASS ^= SUPERFILEID THEN 44905000=07467750= + % DATACOM RELEASE. 44910000=07467750= + BEGIN 44915000=07468000= + AEXP; 44920000=07468000= + GO DCR; 44925000=07468000= + END; 44930000=07468000= + CHECKER(ELBAT[I]); 44935000=07468250= + PASSFILE; 44940000=07468250= + IF ELCLASS = COMMA THEN 44945000=07468500= + EMITO(DUP); 44950000=07468500= + 44955000=07468750= +COMMENT THIS WILL FETCH DESCRIPTOR POINTING TO I/O DESCRIPTOR; 44960000=07468750= + CHECKPRESENCE; 44965000=07469000= + 44970000=07469250= +COMMENT THIS WILL CAUSE PRESENCE BIT INTERRUPT IF PREVIOUS I/O IS 44975000=07469250= + NOT COMPLETED; 44980000=07469500= + EMITO(DUP); 44985000=07469750= + EMITO(LOD); 44990000=07469750= + EMITO(XCH); 44995000=07469750= + IF ELCLASS = COMMA THEN 45000000=07470000= + BEGIN 45005000=07470250= + EMITO(DUP); 45010000=07470500= + EMITO(LOD); 45015000=07470500= + STEPIT; 45020000=07470500= + AEXP; 45025000=07470500= + EMITD(38, 8, 10); 45030000=07470750= + EMITO(XCH); 45035000=07470750= + EMITO(STD); 45040000=07470750= + EMITO(XCH); 45045000=07470750= + END; 45050000=07471000= + EMITO(PRL); 45055000=07471250= + EMITO(DEL); 45060000=07471250= +PARENCHECK: 45065000=07471750= + IF ELCLASS = RTPAREN THEN 45070000=07471750= + STEPIT 45075000=07471750= + ELSE 45080000=07471750= + ERR(104); 45085000=07471750= +EXIT: 45090000=07472250= + END RELSESTMT; 45095000=07472250= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45100000=07472250= + 45105000=07481000= + COMMENT DOTSTMT HANDLES THE DO STATEMENT; 45110000=07481000= + PROCEDURE DOSTMT; 45115000=07482000= + BEGIN 45120000=07483000= + INTEGER 45125000=07483000= + TL; 45130000=07483000= + DIALA:= DIALB:= 0; 45135000=07484000= + ADJUST; 45140000=07484100= + STEPIT; 45145000=07485000= + TL:= L; 45150000=07485000= + STMT; 45155000=07485000= + IF ELCLASS ^= UNTILV THEN 45160000=07485000= + ERR(131) 45165000=07486000= + ELSE 45170000=07486000= + BEGIN 45175000=07486000= + STEPIT; 45180000=07487000= + BEXP; 45185000=07487000= + EMITB(BBC, BUMPL, TL) 45190000=07487000= + END 45195000=07488000= + END DOSTMT; 45200000=07488000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45205000=07488000= + 45210000=07489000= + COMMENT WHILESTMT COMPILES THE WHILE STATEMENT; 45215000=07489000= + PROCEDURE WHILESTMT; 45220000=07490000= + BEGIN 45225000=07491000= + INTEGER 45230000=07491000= + BACK, 45235000=07491000= + FRONT; 45240000=07491000= + DIALA:= DIALB:= 0; 45245000=07492000= + ADJUST; 45250000=07492100= + STEPIT; 45255000=07493000= + BACK:= L; 45260000=07493000= + BEXP; 45265000=07493000= + FRONT:= BUMPL; 45270000=07493000= + IF ELCLASS ^= DOV THEN 45275000=07494000= + ERR(132) 45280000=07494000= + ELSE 45285000=07494000= + BEGIN 45290000=07495000= + STEPIT; 45295000=07495000= + STMT; 45300000=07495000= + EMITB(BBW, BUMPL, BACK); 45305000=07495000= + CONSTANTCLEAN; 45310000=07496000= + EMITB(BFC, FRONT, L) 45315000=07496000= + END 45320000=07496000= + END WHILESTMT; 45325000=07496000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45330000=07496000= + 45335000=07497000= + COMMENT GOSTMT COMPILES GO TO STATEMENTS. GOSTMT LOOKS AT THE 45340000=07497000= + EXPRESSION. IF IT IS SIMPLE ENOUGH WE GO DIRECTLY. 45345000=07498000= + OTHERWISE A CALL ON THE MCP IS GENERATED IN ORDER TO GET 45350000=07499000= + STORAGE RETURNED. SEE DEXP AND GENGO; 45355000=07500000= + PROCEDURE GOSTMT; 45360000=07501000= + BEGIN 45365000=07502000= + REAL 45370000=07503000= + ELBW; 45375000=07503000= + LABEL 45380000=07504000= + GOMCP, 45385000=07504000= + EXIT; 45390000=07504000= + IF STEPI = TOV THEN 45395000=07505000= + STEPIT; 45400000=07505000= + IF ELCLASS = LABELID THEN 45405000=07506000= + TB1:= TRUE 45410000=07507000= + ELSE 45415000=07507000= + IF ELCLASS = SWITCHID THEN 45420000=07507000= + TB1:= FALSE 45425000=07507000= + ELSE 45430000=07507000= + GO GOCMP; 45435000=07507000= + IF NOT LOCAL(ELBAT[I]) THEN 45440000=07508000= + GO GOCMP; 45445000=07508000= + IF TB1 THEN 45450000=07509000= + BEGIN 45455000=07509000= + GOGEN(ELBAT[I], BFW); 45460000=07509000= + STEPIT; 45465000=07509000= + CONSTANTCLEAN; 45470000=07510000= + GO EXIT 45475000=07510000= + END; 45480000=07510000= + ELBW:= ELBAT[I]; 45485000=07511000= + IF ELBW < 0 THEN 45490000=07513000= + BEGIN 45495000=07513000= + COMMENT THIS IS A MONITORED SWITCH; 45500000=07513000= + EMITO(MKS); 45505000=07514000= + PASSALPHA(ELBW); 45510000=07514000= + EMITPAIR(GNAT(CHARI), LOD); 45515000=07515000= + PASSMONFILE(TAKE(GIT(ELBW)), SWITMONFILE); 45520000=07516000= + EMITNUM(0 & CARDNUMBER[1:4:44]); 45525000=07516100= + EMITV(GNAT(PRINTI)); 45530000=07517000= + END; 45535000=07518000= + BANA; 45540000=07519000= + EMITPAIR(JUNK, ISD); 45545000=07519000= + IF(GT1:= TAKE(GT2:= GIT(ELBW))).[24:12] = 0 AND ELBW.ADDRESS = 0 45550000=07521000= + THEN 45555000=07521000= + BEGIN 45560000=07521000= + PUT(GT1 & (BUMPL)[24:36:12], GT2); 45565000=07522000= + EMITB(BBW, L, GT4:= GT1.[36:12]); 45570000=07523000= + EMITB(BFW, GT4+13, L+3); 45575000=07524000= + EMITO(NOP); 45580000=07525000= + EMITO(NOP); 45585000=07525000= + EMITO(NOP) 45590000=07525000= + END 45595000=07526000= + ELSE 45600000=07526000= + BEGIN 45605000=07526000= + CALLSWITCH(ELBW); 45610000=07526000= + EMITO(BFW) 45615000=07526000= + END; 45620000=07526000= + GO EXIT; 45625000=07527000= +GOMCP: 45630000=07528000= + GOTOG:= FALSE; 45635000=07528000= + DEXP; 45640000=07528000= + IF GOTOG THEN 45645000=07529000= + BEGIN 45650000=07529100= + EMITO(MKS); 45655000=07529100= + EMITL(9); 45660000=07529100= + EMITV(5); 45665000=07529100= + EMITO(BFW) 45670000=07529100= + END 45675000=07529200= + ELSE 45680000=07529200= + BEGIN 45685000=07529200= + EMITO(PRTE); 45690000=07529200= + EMITO(LOD); 45695000=07529200= + EMITO(BFW) 45700000=07529200= + END; 45705000=07529200= +EXIT: 45710000=07530000= + END GOSTMT; 45715000=07530000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45720000=07530000= + 45725000=07531000= + COMMENT GOGEN GENERATES CODE TO GO TO A LABEL, GIVEN THAT LABEL AS A 45730000=07531000= + PARAMETER. GOGEN ASSUMES THAt THE LABEL IS LOCAL. THE 45735000=07532000= + PARAMETER BRANCH TYPE TELL WHETHER THE JUMP IS CONDITIONAL45740000=07533000= + OR NOT; 45745000=07534000= + PROCEDURE GOGEN(LABELBAT, BRANCHTYPE); 45750000=07535000= + VALUE 45755000=07536000= + LABELBAT, 45760000=07536000= + BRANCHTYPE; 45765000=07536000= + REAL 45770000=07537000= + LABELBAT, 45775000=07537000= + BRANCHTYPE; 45780000=07537000= + BEGIN 45785000=07538000= + IF BOOLEAN(GT1:= TAKE(GT2:= GIT(LABELBAT))).[1:1] THEN 45790000=07540000= + EMITB(BRANCHTYPE, BUMPL, GT1.[36:12]) 45795000=07541000= + COMMENT LABELR SETS THE SIGN OF THE ADDITIONAL INFO FOR A LABEL 45800000=07541000= + NEGATIVE WHEN THE LABEL IS ENCOUNTERED. SO THIS MEANS 45805000=07542000= + THAT WE NOW KNOW WHERE TO GO; 45810000=07543000= + ELSE 45815000=07544000= + BEGIN 45820000=07544000= + EMIT(GT1); 45825000=07544000= + EMIT(BRANCHTYPE); 45830000=07544000= + PUT(GT1 & L[36:36:12], GT2) 45835000=07545000= + END 45840000=07545000= + END GOGEN; 45845000=07545000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45850000=07545000= + 45855000=07546000= + COMMENT SIMPGO IS USED ONLY BY THE IF STMT ROUTINE. IT DETERMINES IF 45860000=07546000= + A STATEMENT IS A SIMPLE GO TO STATEMENT; 45865000=07547000= + BOOLEAN PROCEDURE SIMPGO; 45870000=07548000= + BEGIN 45875000=07549000= + LABEL 45880000=07549000= + EXIT; 45885000=07549000= + IF ELCLASS = GOV THEN 45890000=07551000= + BEGIN 45895000=07551000= + IF STEPI = TOV THEN 45900000=07552000= + STEPIT; 45905000=07552000= + IF ELCLASS = LABELID THEN 45910000=07553000= + IF LOCAL(ELBAT[I]) THEN 45915000=07554000= + BEGIN 45920000=07555000= + SIMPGO:= TRUE; 45925000=07555000= + GO EXIT 45930000=07555000= + END; 45935000=07555000= + I:= I-1; 45940000=07556000= + ELCLASS:= GOV 45945000=07556000= + END; 45950000=07556000= +EXIT: 45955000=07557000= + END SIMPGO; 45960000=07557000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%45965000=07557000= + 45970000=07558000= + COMMENT IFSTMT COMPILES IF STATEMENTS. SPECIAL CARE IS TAKEN TO 45975000=07558000= + OPTIMIZE CODE IN THE NEIGHBORHOOD OF THE JUMPS. TO SOME 45980000=07559000= + EXTENT SUPPERFULOUS BRANCHING IS AVOIDED; 45985000=07560000= + PROCEDURE IFSTMT; 45990000=07561000= + BEGIN 45995000=07562000= + REAL 46000000=07562000= + T1, 46005000=07562000= + T2; 46010000=07562000= + LABEL 46015000=07562000= + EXIT; 46020000=07562000= + IFCLAUSE; 46025000=07563000= + IF SIMPGO THEN 46030000=07565000= + BEGIN 46035000=07565000= + T1:= ELBAT[I]; 46040000=07566000= + IF STEPI = ELSEV THEN 46045000=07568000= + BEGIN 46050000=07568000= + STEPIT; 46055000=07569000= + IF SIMPGO THEN 46060000=07571000= + BEGIN 46065000=07571000= + GOGEN(ELBAT[I], BFC); 46070000=07572000= + GOGEN(T1, BFW); 46075000=07572000= + STEPIT; 46080000=07573000= + GO TO EXIT 46085000=07573000= + END 46090000=07573000= + ELSE 46095000=07573000= + BEGIN 46100000=07573000= + EMITLNG; 46105000=07573000= + GOGEN(T1, BFC); 46110000=07573000= + STMT; 46115000=07574000= + GO TO EXIT 46120000=07574000= + END 46125000=07574000= + END; 46130000=07574000= + EMITLNG; 46135000=07575000= + GOGEN(T1, BFC); 46140000=07575000= + GO EXIT 46145000=07576000= + END; 46150000=07576000= + T1:= BUMPL; 46155000=07577000= + STMT; 46160000=07577000= + IF ELCLASS ^= ELSEV THEN 46165000=07578000= + BEGIN 46170000=07579000= + DIALA:= DIALB:= 0; 46175000=07579000= + EMITB(BFC, T1, L); 46180000=07579000= + GO EXIT 46185000=07579000= + END; 46190000=07579000= + STEPTIT; 46195000=07580000= + IF SIMPGO THEN 46200000=07582000= + BEGIN 46205000=07582000= + T2:= L; 46210000=07583000= + L:= T1-2; 46215000=07583000= + GOGEN(ELBAT[I], BFC); 46220000=07583000= + L:= T2; 46225000=07583000= + STEPIT; 46230000=07584000= + GO EXIT 46235000=07584000= + END; 46240000=07584000= + T2:= BUMPL; 46245000=07585000= + CONSTANTCLEAN; 46250000=07585000= + EMITB(BFC, T1, L); 46255000=07586000= + STMT; 46260000=07586000= + EMITB(BFW, T2, L); 46265000=07586000= +EXIT: 46270000=07587000= + END IFSTMT; 46275000=07587000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%46280000=07587000= + 46285000=07588000= + COMMENT LABELR HANDLES LABELED STATEMENTS. IT PUTS L INTO THE 46290000=07588000= + ADDITIONAL INFO AND MAKES ITS SIGN NEGATIVE. IT COMPILES 46295000=07589000= + AT THE SAME TIME ALL THE PREVIOUS FORWARD REFERENCES SET 46300000=07590000= + UP FOR IT BY GOGEN. (THE ADDITIONAL INFO LINKS TO A LIST 46305000=07591000= + IN THE CODE ARRAY OF ALL FORWARD REFERENCES); 46310000=07592000= + PROCEDURE LABELR; 46315000=07593000= + BEGIN 46320000=07594000= + LABEL 46325000=07594000= + EXIT, 46330000=07594000= + ROUND; 46335000=07594000= + DEFINE 46340000=07595000= + ELBATWORD = RR9 #, 46345000=07595000= + LINK = GT2 #, 46350000=07595000= + INDEX = GT3 #, 46355000=07595000= + ADDITIONAL = GT4 #, 46360000=07596000= + NEXTLINK = GT5 #; 46365000=07596000= + DO BEGIN 46370000=07597000= + ADJUST; 46375000=07597000= + IF STEPI ^= COLON THEN 46380000=07597000= + BEGIN 46385000=07598000= + ERR(133); 46390000=07598000= + GO TO EXIT 46395000=07598000= + END; 46400000=07598000= + XMARK(LBLREF); % THIS WILL SORT AHEAD OF DECLARATION 46405000=07598100= + % WHEN WE GET AROUND TO THE XREF. 46410000=07598200= + IF NOT LOCAL(ELBATWORD:= ELBAT[I-1]) THEN 46415000=07600000= + BEGIN 46420000=07600000= + FLAG(134); 46425000=07600000= + GO TO ROUND 46430000=07600000= + END; 46435000=07600000= + LINK:= (ADDITIONAL:= TAKE(INDEX:= GIT(ELBATWORD))).[36:12]; 46440000=07602000= + IF ADDITIONAL < 0 THEN 46445000=07603000= + BEGIN 46450000=07604000= + FLAG(135); 46455000=07604000= + GO TO ROUND 46460000=07604000= + END; 46465000=07604000= + WHILE LINK ^= 0 DO 46470000=07606000= + BEGIN 46475000=07606000= + NEXTLINK:= GET(LINK-2); 46480000=07607000= + EMITB(GET(LINK-1), LINK, L); 46485000=07608000= + LINK:= NEXTLINK; 46490000=07609000= + IF LASTENTRY >= 126 THEN % DONT LET EMITNUM DO IT 46495000=07609100= + BEGIN 46500000=07609200= + REAL 46505000=07609200= + C; % HOLD L FOR A WHILE 46510000=07609200= + COMMENT THIS IS TO ALLOW FOR MORE THAN 56 LONG 46515000=07609300= + (>1023 WORD) FORWARD REFERENCES TO A LABEL;46520000=07609400= + C:= BUMPL; 46525000=07609500= + CONSTANTCLEAN; 46530000=07609600= + EMITB(BFW, C, L) 46535000=07609700= + END; 46540000=07609700= + END; 46545000=07609700= + PUT(-ADDITIONAL & L[36:36:12], INDEX); 46550000=07610000= + IF ELBATWORD < 0 THEN 46555000=07612000= + BEGIN 46560000=07612000= + COMMENT THIS LABEL IS EITHER APPEARS IN A DUMP 46565000=07612000= + OR MONITOR DECLARATION; 46570000=07613000= + IF RR1:= ADDITIONAL.LABLMONFILE ^= 0 THEN 46575000=07615000= + BEGIN 46580000=07615000= + COMMENT THIS CODE IS FOR MONITORED 46585000=07615000= + LABELS; 46590000=07616000= + EMITO(MKS); 46595000=07617000= + PASSALPHA(ELBATWORD); 46600000=07617000= + EMITPAIR(GNAT(CHARI), LOD); 46605000=07618000= + PASSMONFILE(RR1); 46610000=07619000= + EMITNUM(0 & CARDNUMBER[1:4:44]); 46615000=07619100= + EMITV(GNAT(PRINTI)); 46620000=07620000= + END; 46625000=07621000= + IF RR1:= ADDITIONAL.DUMPEE ^= 0 THEN 46630000=07623000= + BEGIN 46635000=07623000= + COMMENT EMIT CODE TO INCREMENT THE 46640000=07623000= + LABEL COUNTER; 46645000=07624000= + EMITV(RR1); 46650000=07625000= + EMITL(1); 46655000=07625000= + EMITO(ADD); 46660000=07625000= + EMITPAIR(RR1, STD); 46665000=07626000= + IF RR1:= ADDITIONAL.DUMPOR ^= 0 THEN 46670000=07628000= + BEGIN 46675000=07628000= + COMMENT EMIT CODE TO CALL 46680000=07628000= + THE DUMP ROUTINE; 46685000=07629000= + STUFFF(RR1); 46690000=07633000= + EMITO(XCH); 46695000=07634000= + EMITO(COC); 46700000=07634000= + EMITO(DEL); 46705000=07641000= + END; 46710000=07642000= + END; 46715000=07643000= + END; 46720000=07644000= + ROUND: 46725000=07645000= + ERRORTOG:= TRUE 46730000=07645000= + END 46735000=07645000= + UNTIL STEPI ^= LABELID; 46740000=07645000= +EXIT: 46745000=07646000= + END LABELR; 46750000=07646000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%46755000=07646000= + PROCEDURE CASESTMT; 46760000=07646100= + BEGIN 46765000=07646110= + COMMENT THE CASE STATEMENT HAS THE FOLLOWING FORM: 46770000=07646110= + CASE OF BEGIN 46775000=07646120= + AT EXECUTION THE CASE STATEMENT SELECTS ONE OF THE STATEMENTS 46780000=07646130= + IN THE , DEPENDING ON THE VALUE OF THE , 46785000=07646140= + ONLY THE SELECTED STATEMENT IS EXECUTED AND CONTROL RESUMES AFTER 46790000=07646150= + THE . IF THERE ARE N STATEMENTS IN THE 46795000=07646160= + , THEY MAY BE CONSIDERED NUMBERED 0,1,...,N-1. 46800000=07646170= + AND THE MUST TAKE ON ONLY THESE VALUES. OTHER VALUES 46805000=07646180= + WILL RESULT IN AN INVALID INDEX TERMINATION OF THE OBJECT PROGRAM. 46810000=07646190= + THE STATEMENTS IN THE MAY BE ANY EXECUTABLE 46815000=07646200= + STATEMENTS, INCLUDING COMPOUND STATEMENTS, BLOCKS, CASE STATEMENTS 46820000=07646210= + AND NULL STATEMENTS. THE CODE GENERATED IS AS FOLLOWS: 46825000=07646220= + 46830000=07646230= + OPDC ARRAY 46835000=07646240= + BFW 46840000=07646250= + STMT 0 46845000=07646260= + BRANCH TO RESUME 46850000=07646270= + STMT 1 46855000=07646280= + BRANCH TO RESUME 46860000=07646290= + . 46865000=07646300= + . 46870000=07646310= + . 46875000=07646320= + STMT N-1 46880000=07646330= + RESUME: 46885000=07646340= + "ARRAY" IS COMPILED AS A TYPE-2 SEGMENT OF N WORDS AND IS 46890000=07646350= + CHANGED TO A DATA ARRAY AT THE FIRST REFERENCE. IT IS SUBSCRIPTED 46895000=07646360= + BY THE VALUE OF AND CONTAINS SYLLABLE COUNTS 46900000=07646370= + FOR THE BRANCH TO EACH OF THE N STATEMENTS. THE BRANCH TO RESUME 46905000=07646375= + IS OMITTED FOR A NULL STATEMENT. INSTEAD, THE INITIAL BRANCH 46910000=07646380= + TRANSFERS TO RESUME DIRECTLY; 46915000=07646385= + REAL 46920000=07646390= + LINK, 46925000=07646390= + TEMP, 46930000=07646390= + N, 46935000=07646390= + ADR, 46940000=07646390= + PRT, 46945000=07646390= + NULL; 46950000=07646390= + BOOLEAN 46955000=07646395= + GOTOG; 46960000=07646395= + REAL ARRAY 46965000=07646400= + TEDOC[0:7, 0:127]; 46970000=07646400= + LABEL 46975000=07646410= + LOOP, 46980000=07646410= + XIT; 46985000=07646410= + LINK:= N:= NULL:= 0; 46990000=07646420= + STEPIT; 46995000=07646430= + AEXP; 47000000=07646430= + IF STEPI ^= BEGINV THEN 47005000=07646440= + BEGIN 47010000=07646440= + ERR(70); 47015000=07646440= + GO TO XIT 47020000=07646440= + END; 47025000=07646440= + EMITV(PRT:= GETSPACE(TRUE, -3)); % CASE STMNT. DESCR. 47030000=07646450= + EMITO(BFW); 47035000=07646460= + ADR:= L; 47040000=07646460= +LOOP: 47045000=07646475= + ERRORTOG:= TRUE; 47050000=07646475= + IF STEPI = SEMICOLON THEN 47055000=07646480= + BEGIN 47060000=07646485= + COMMENT NULL STATEMENT; 47065000=07646485= + TEDOC[N.[38:3], N.[41:7]]:= NULL; 47070000=07646490= + NULL:= N:= N+1; 47075000=07646495= + GO TO LOOP; 47080000=07646495= + END; 47085000=07646500= + TEDOC[N.[38:3], N.[41:7]]:= L-ADR; 47090000=07646510= + N:= N+1; 47095000=07646510= + IF GOTOG:= SIMPGO THEN 47100000=07646515= + ELBAT[I:= I-1]:= ELCLASS:= GOV; 47105000=07646515= + STMT; 47110000=07646520= + IF ELCLASS = SEMICOLON THEN 47115000=07646525= + BEGIN 47120000=07646530= + IF NOT GOTOG THEN 47125000=07646530= + BEGIN 47130000=07646533= + EMIT(LINK); 47135000=07646533= + LINK:= L:= L+1; 47140000=07646533= + END; 47145000=07646533= + GO TO LOOP; 47150000=07646535= + END 47155000=07646538= + ELSE 47160000=07646538= + IF ELCLASS = ENDV THEN 47165000=07646538= + BEGIN 47170000=07646540= + IF NOT GOTOG THEN 47175000=07646540= + BEGIN 47180000=07646543= + EMIT(LINK); 47185000=07646543= + LINK:= L:= L+1; 47190000=07646543= + END; 47195000=07646543= + TEDOC[N.[38:3], N.[41:7]]:= L-ADR; 47200000=07646545= + N:= N+1; 47205000=07646548= + END; 47210000=07646550= + IF ELCLASS ^= ENDV THEN 47215000=07646555= + BEGIN 47220000=07646555= + ERR(71); 47225000=07646555= + GO TO LOOP 47230000=07646555= + END; 47235000=07646555= + N:= N-1; 47240000=07646556= + WHILE NULL ^= 0 DO 47245000=07646560= + BEGIN 47250000=07646565= + TEMP:= TEDOC[(NULL:= NULL-1).[38:3], NULL.[41:7]]; 47255000=07646565= + TEDOC[NULL.[38:3], NULL.[41:7]]:= L-ADR; 47260000=07646570= + NULL:= TEMP; 47265000=07646575= + END; 47270000=07646580= + ENDTOG:= TRUE; 47275000=07646585= + COMMENT SKIP ANY COMMENTS AFTER "END"; 47280000=07646590= + DO 47285000=07646595= + STOPDEFINE:= TRUE 47290000=07646595= + UNTIL STEPI <= ENDV AND ELCLASS >= UNTILV OR NOT ENDTOG; 47295000=07646600= + ENDTOG:= FALSE; 47300000=07646610= + COMMENT DEFINE TEDOC AS TYPE-2 SEGMENT; 47305000=07646620= + MOVECODE(TEDOC, EDOC); 47310000=07646630= + BUILDLINE:= BOOLEAN(2*REAL(BUILDLINE)); 47315000=07646635= + TEMP:= SGNO; 47320000=07646640= + IF LISTER OR SEGSTOG THEN 47325000=07646640= + SEGMENTSTART; 47330000=07646640= + SGNO:= SGAVL; 47335000=07646650= + Z:= PROGDESCBLDR(LDES, 0, PRT); 47340000=07646660= + SEGMENT(-N, SGNO, TEMP); 47345000=07646670= + SGAVL:= SGAVL+1; 47350000=07646680= + SGNO:= TEMP; 47355000=07646680= + BUILDLINE:= BUILDLINE.[46:1]; 47360000=07646685= + MOVECODE(TEDOC, EDOC); 47365000=07646690= + COMMENT FIX UP BRANCHES TO RESUME POINT; 47370000=07646700= + IF(L-ADR) > 1019 THEN 47375000=07646705= + ADJUST; % 47380000=07646705= + WHILE LINK ^= 0 DO 47385000=07646710= + BEGIN 47390000=07646720= + TEMP:= GET(LINK-2); 47395000=07646720= + EMITB(BFW, LINK, L); 47400000=07646730= + LINK:= TEMP; 47405000=07646740= + IF LASTENTRY >= 126 THEN 47410000=07646750= + BEGIN 47415000=07646760= + REAL 47420000=07646760= + C; 47425000=07646760= + COMMENT PERMITS SEVERAL LONG BRANCHES IF NECESSARY; 47430000=07646770= + C:= BUMPL; 47435000=07646780= + CONSTANTCLEAN; 47440000=07646790= + EMITB(BFW, C, L); 47445000=07646800= + END; 47450000=07646810= + END; 47455000=07646820= +XIT: 47460000=07646840= + END CASESTMT; 47465000=07646840= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%47470000=07646840= + 47475000=07647000= +COMMENT THE FOLLOWING PROCEDURE HANDLES THE FILL STATEMENT. 47480000=07647000= + IT EMITS CODE TO PASS THE ROW TO BE FILLED AND TO PASS 47485000=07647500= + THE INDEX IN THE SEGMENT DICTIONARY OF THE FILL SEGMENT. 47490000=07648000= + THESE SEGMENTS LOOK LIKE ANY OTHER SEGMENT TO THE MCP. 47495000=07648500= + NO FILL SEGMENT IS EVER BROUGHT INTO CORE.THE SEGMENT 47500000=07649000= + RESIDES ON THE DISK AND IS READ INTO THE ROW DESIGNATED 47505000=07649500= + BY THE FILL STATEMENT EVERY TIME THE FILL STATEMENT IS 47510000=07650000= + EXECUTED.STRINGCONSTANTS,LITERAL ,AND NONLITERAL NUMBERS 47515000=07650500= + ARE ALL CONVERTED BY THE SCANNER AND NUMBER BUILDER.OCTAL 47520000=07651000= + NUMBERS LOOK LIKE IDENITIFERS TO FILLSTMT AND ARE CONVERTED 47525000=07651500= + BY OCTIZE.AFTER BUILDING THE SEGMENT AN ENTRY IS MADE IN 47530000=07652000= + PDPRT TO SUPPLY INFO TO BUILD A DISK DESCRIPTOR IN THE 47535000=07652500= + SEGMENT DICTIONARY.THE COMMUNICATE LITERAL IS 7; 47540000=07653000= + PROCEDURE FILLSTMT; 47545000=07653500= + BEGIN 47550000=07654000= + LABEL 47555000=07654500= + EXIT; 47560000=07654500= + DEFINE 47565000=07655000= + PARENCOUNTER = RR1 #, 47570000=07655500= + T = RR2 #, 47575000=07656000= + J = RR3 #; 47580000=07656000= + ARRAY 47585000=07656500= + TEDOC[0:7, 0:127], 47590000=07656500= + FILLTEMP[0:1022]; 47595000=07656500= + BOOLEAN PROCEDURE FILLIT(A); 47600000=07657000= + ARRAY 47605000=07657000= + A[0]; 47610000=07657000= + BEGIN 47615000=07657500= + REAL 47620000=07658000= + T1, 47625000=07658000= + T2, 47630000=07658000= + T3; 47635000=07658000= + BOOLEAN 47640000=07658500= + BOO; 47645000=07658500= + LABEL 47650000=07659000= + CHECK, 47655000=07659000= + GOOFUP, 47660000=07659000= + EXIT; 47665000=07659000= + PARENCOUNTER:= PARENCOUNTER+1; 47670000=07659500= + WHILE T < 1023 DO 47675000=07660000= + BEGIN 47680000=07660500= + IF STEPI > IDMAX THEN 47685000=07661000= + BEGIN 47690000=07661500= + IF ELCLASS = LITNO THEN 47695000=07662000= + IF TABLE(I+1) = LEFTPAREN THEN 47700000=07662500= + BEGIN 47705000=07663000= + T1:= ELBAT[I].ADDRESS; 47710000=07663500= + T2:= T; 47715000=07663500= + STEPIT; 47720000=07664000= + IF FILLIT(A) THEN 47725000=07664000= + GO GOOFUP; 47730000=07664000= + IF T1 = 0 THEN 47735000=07664500= + T:= T2 47740000=07665000= + ELSE 47745000=07665000= + BEGIN 47750000=07665000= + IF(T3:= (T1-1)*(T-T2))+T > 1022 THEN 47755000=07665500= + BEGIN 47760000=07666000= + ERROR(305); 47765000=07666000= + GO GOOFUP 47770000=07666000= + END; %>102347775000=07666000= + MOVE(T3, A[T2], A[T]); 47780000=07666500= + T:= T+T3; 47785000=07666500= + END; 47790000=07667000= + GO CHECK; 47795000=07667500= + END REPEAT PART; 47800000=07668000= + IF(BOO:= ELCLASS = ADOP) THEN 47805000=07668500= + STEPIT; 47810000=07668500= + IF ELCLASS ^= LITNO AND ELCLASS ^= NONLITNO THEN 47815000=07669000= + IF ELCASS ^= STRING AND (ELCASS ^= STRNGCON OR BOO) THEN 47820000=07669500= + BEGIN 47825000=07670000= + ERROR(302); 47830000=07670000= + GO GOOFUP 47835000=07670000= + END; % WHATISIT. 47840000=07670000= + IF BOO THEN 47845000=07670500= + C:= C & ELBAT[I-1][1:21:1]; 47850000=07670500= + IF ELCLASS = STRING THEN 47855000=07671000= + BEGIN 47860000=07671500= + IF(T2:= T+(COUNT+7) DIV 8-1) > 1022 THEN 47865000=07672000= + BEGIN 47870000=07672500= + ERROR(305); 47875000=07672500= + GO GOOFUP 47880000=07672500= + END; % > 1023. 47885000=07672500= + T3:= 6" "; 47890000=07673000= + MOVE(1, T3, A[T2]); 47895000=07673000= + MOVECHARACTERS(COUNT, ACCUM[1], 3, A[T], 0); 47900000=07673500= + T:= T2; 47905000=07674000= + END 47910000=07675000= + ELSE 47915000=07675000= + MOVE(1, C, A[T]); 47920000=07675000= + END 47925000=07676000= + ELSE 47930000=07676000= + IF COUNT <= 19 AND ACCUM[1].[18:18] = 6"OCT" THEN 47935000=07676000= + BEGIN % GET RID OF "OCT" FOR OCTIZE. 47940000=07676500= + MOVECHARACTERS(COUNT-3, ACCUM[1], 6, ACCUM[1], 3); 47945000=07677000= + IF OCTIZE(ACCUM[1], A[T], 19-COUNT, COUNT-3) THEN 47950000=07677500= + FLAG(303); % NON-OCTAL CHARACTER. 47955000=07678000= + END 47960000=07679000= + ELSE 47965000=07679000= + BEGIN 47970000=07679000= + ERROR(302); 47975000=07679000= + GO GOOFUP 47980000=07679000= + END; % WHATISIT. 47985000=07679000= + T:= T+1; 47990000=07679500= + CHECK: 47995000=07680500= + IF STEPI ^= COMMA THEN 48000000=07680500= + GO EXIT; 48005000=07680500= + END T LOOP; 48010000=07681000= + ERROR(305); % > 1023 ITEMS IN LIST. 48015000=07681500= + GOOFUP: 48020000=07682500= + FILLIT:= TRUE; 48025000=07682500= + EXIT: 48030000=07683500= + PARENCOUNTER:= PARENCOUNTER-REAL(ELCLASS = RTPAREN); 48035000=07683500= + END RECURSIVE FILLIT; 48040000=07684000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%48045000=07684000= + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 48050000=07684500= + BEGIN 48055000=07685000= + IF ELCLASS = FILEID OR ELCLASS = SUPERFILEID THEN 48060000=07685500= + MAKEALABEL 48065000=07686000= + ELSE 48070000=07686000= + ERROR(300); % NO ARRAY ID. 48075000=07686000= + GO EXIT; 48080000=07686500= + END; 48085000=07687000= + VARIABLE(FL); 48090000=07687500= + IF TABLE(I-2) ^= FACTOP THEN 48095000=07687500= + FLAG(304); % NOT ARR. ROW. 48100000=07687500= + XMARK(ASSIGNREF); % FILL STATEMENT 48105000=07687600= + IF ELCLASS ^= WITHV THEN 48110000=07688000= + BEGIN 48115000=07688500= + ERROR(301); 48120000=07688500= + GO EXIT 48125000=07688500= + END; % MISSING "WITH". 48130000=07688500= + STREAMTOG:= TRUE; 48135000=07689000= + IF TABLE(I+1) <= IDMAX THEN 48140000=07689500= + IF Q = 6"7INQUI" THEN 48145000=07690000= + BEGIN 48150000=07690500= + STREAMTOG:= FALSE; 48155000=07691000= + I:= I+1; 48160000=07691000= + STEPIT; 48165000=07691000= + EMITPAIR(9, COM); 48170000=07691500= + EMITO(DEL); 48175000=07691500= + GO EXIT; 48180000=07692000= + END; 48185000=07692500= + EMITNUM(SGAVL); 48190000=07693000= + EMITPAIR(7, COM); 48195000=07693000= + EMITO(DEL); 48200000=07693000= + EMITO(DEL); 48205000=07693000= + IF LISTER OR SEGSTOG THEN 48210000=07693500= + SEGMENTSTART; 48215000=07693500= + MOVECODE(TEDOC, EDOC); 48220000=07694000= + PARENCOUNTER:= T:= 0; 48225000=07694000= + BUILDLINE:= BOOLEAN(2*REAL(BUILDLINE)); 48230000=07694500= + IF FILLIT(FILLTEMP) THEN % DO NOTHING. 48235000=07695000= + ELSE 48240000=07695500= + IF PARENCOUNTER ^= 1 THEN 48245000=07695500= + ERROR(306) % ODD # OF PARENS. 48250000=07695500= + ELSE 48255000=07696000= + BEGIN 48260000=07696000= + FOR J:= 0 STEP 32 UNTIL T DO 48265000=07696500= + MOVE(32, FILLTEMP[J], EDOC[J.[38:3], J.[41:7]]); 48270000=07697000= + SEGMENT(T, SGAVL, SGNO); 48275000=07697500= + END; 48280000=07698000= + MOVECODE(TEDOC, EDOC); 48285000=07698500= + STREAMTOG:= FALSE; 48290000=07698500= + BUILDLINE:= BUILDLINE.[46:1]; 48295000=07699000= + SGAVL:= SGAVL+1; 48300000=07699000= +EXIT: 48305000=07700000= + END FILLSTMT; 48310000=07700000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%48315000=07700000= + 48320000=07710000= + COMMENT STMT DIRECTS TRAFFIC TO THE VARIOUS STATEMENT ROUTINES. SOME 48325000=07710000= + CARE IS TAKEN TO PICK UP EXTRANEOUS DECLARATIONS. THIS 48330000=07711000= + WILL SOMETIMES CAUSE ADDITIONAL ERROR MESSAGES. THIS IS 48335000=07712000= + AN IMPERFECT ANALYSIS OF BEGIN-END PAIRS; 48340000=07713000= + PROCEDURE STMT; 48345000=07714000= + BEGIN 48350000=07715000= + LABEL 48355000=07716000= + AGAIN, 48360000=07716000= + LERR, 48365000=07716000= + LDEC, 48370000=07716000= + LPROC, 48375000=07716000= + LSPROC, 48380000=07716000= + LVAR, 48385000=07716000= + LAB, 48390000=07716000= + LREAD, 48395000=07716000= + LWRITE, 48400000=07717000= + LSPACE, 48405000=07717000= + LCLOSE, 48410000=07717000= + LLOCK, 48415000=07717000= + LRWND, 48420000=07717000= + LDBL, 48425000=07717000= + LFOR, 48430000=07717000= + LWHILE, 48435000=07717000= + LDO, 48440000=07717000= + LFILL, 48445000=07717000= + LIF, 48450000=07718000= + LGO, 48455000=07718000= + LRELSE, 48460000=07718000= + LBEG, 48465000=07718000= + LBRK, 48470000=07718000= + EXIT; 48475000=07718000= + SWITCH 48480000=07719000= + S:= LPROC, 48485000=07720000= + LERR, 48490000=07720000= + LSPROC, 48495000=07720000= + LERR, 48500000=07720000= + LERR, 48505000=07720000= + LERR, 48510000=07720000= + LERR, 48515000=07721000= + LPROC, 48520000=07721000= + LPROC, 48525000=07721000= + LPROC, 48530000=07721000= + LPROC, 48535000=07721000= + LVAR, 48540000=07721000= + LVAR, 48545000=07721000= + LVAR, 48550000=07722000= + LVAR, 48555000=07723000= + LVAR, 48560000=07723000= + LVAR, 48565000=07723000= + LVAR, 48570000=07723000= + LVAR, 48575000=07723000= + LAB, 48580000=07723000= + LERR, 48585000=07723000= + LERR, 48590000=07724000= + LERR, 48595000=07724000= + LERR, 48600000=07724000= + LERR, 48605000=07724000= + LDEC, 48610000=07724000= + LREAD, 48615000=07724000= + LWRITE, 48620000=07724000= + LSPACE, 48625000=07725000= + LCLOSE, 48630000=07725000= + LLOCK, 48635000=07725000= + LRWND, 48640000=07725000= + LDBL, 48645000=07725000= + LFOR, 48650000=07725000= + LWHILE, 48655000=07725000= + LDO, 48660000=07726000= + EXIT, 48665000=07726000= + EXIT, 48670000=07726000= + EXIT, 48675000=07726000= + LFILL, 48680000=07726000= + EXIT, 48685000=07726000= + LIF, 48690000=07726000= + LGO, 48695000=07727000= + LRELSE, 48700000=07727000= + LBEG; 48705000=07727000= + COMMENT THESE ADDITIONS ARE BEING MADE TO FORCE 48710000=07727010= + CONSTANTCLEAN ACTION WHEN IT APPEARS THAT CONSTANTS WILL BE 48715000=07727020= + GENERATED IN THE STACK WHICH ARE TOO FAR AWAY AND CREL 48720000=07727030= + ADDRESSING IS NOT POSSIBLE; 48725000=07727040= + IF LASTENTRY ^= 0 THEN 48730000=07727050= + BEGIN 48735000=07727055= + GT2:= INFO[0, 255]; 48740000=07727055= + DO 48745000=07727060= + GT1:= GT2 48750000=07727060= + UNTIL GT2:= GET(GT1) = 4095; 48755000=07727060= + IF L-GT1 > 400 THEN 48760000=07727065= + BEGIN 48765000=07727070= + GT1:= BUMPL; 48770000=07727070= + CONSTANTCLEAN; 48775000=07727075= + EMITB(BFW, GT1, L); 48780000=07727080= + END; 48785000=07727085= + END; 48790000=07727090= + STACKCT:= 0; 48795000=07727100= +AGAIN: 48800000=07728000= + GO TO S[ELCLASS-SWITCHID]; 48805000=07728000= + IF ELCLASS = 0 THEN 48810000=07728500= + BEGIN 48815000=07729000= + UNKNOWNSTMT; 48820000=07729000= + GO TO EXIT 48825000=07729000= + END; 48830000=07729000= + IF ELCLASS = FAULTID THEN 48835000=07729100= + BEGIN 48840000=07729100= + FAULTSTMT; 48845000=07729100= + GO EXIT 48850000=07729100= + END; 48855000=07729100= + IF ELCLASS = FILEDID OR ECLASS = SUPERFILEID THEN 48860000=07729190= + BEGIN 48865000=07729200= + GT1:= FILEATTRIBUTEHANDLER(FS); 48870000=07729200= + GO EXIT 48875000=07729200= + END; 48880000=07729200= + FLAG(145); 48885000=07729500= +LERR: 48890000=07730000= + ERR(144); 48895000=07730000= + GO TO EXIT; 48900000=07730000= +LDEC: 48905000=07731000= + FLAG(146); 48910000=07731000= + IF TABLE(I-2) = ENV AND MODE > 0 THEN 48915000=07733000= + BEGIN 48920000=07733000= + I:= I-2; 48925000=07733000= + ELCLASS:= ENDV; 48930000=07733000= + GO TO EXIT 48935000=07733000= + END; 48940000=07733000= + I:= I-1; 48945000=07734000= + ERRORTOG:= TRUE; 48950000=07734000= + BLOCK(FALSE); 48955000=07734000= + ELCLASS:= TABLE(I:= I-1); 48960000=07735000= + GO TO EXIT; 48965000=07735000= +LPROC: 48970000=07736000= + PROCSTMT(TRUE); 48975000=07736000= + GO TO EXIT; 48980000=07736000= +LSPROC: 48985000=07737000= + STRMPROCSTMT; 48990000=07737000= + GO TO EXIT; 48995000=07737000= +LVAR: 49000000=07738000= + VARIABLE(FS); 49005000=07738000= + GO TO EXIT; 49010000=07738000= +LAB: 49015000=07739000= + LABELR; 49020000=07739000= + GO TO AGAIN; 49025000=07739000= +LREAD: 49030000=07740000= + READSTMT; 49035000=07740000= + GO TO EXIT; 49040000=07740000= +LWRITE: 49045000=07741000= + WRITESTMT; 49050000=07741000= + GO TO EXIT; 49055000=07741000= +LSPACE: 49060000=07742000= + SPACESTMT; 49065000=07742000= + GO TO EXIT; 49070000=07742000= +LCLOSE: 49075000=07743000= + CLOSESTMT; 49080000=07743000= + GO TO EXIT; 49085000=07743000= +LLOCK: 49090000=07744000= + LOCKSTMT; 49095000=07744000= + GO TO EXIT; 49100000=07744000= +LRWND: 49105000=07745000= + RWNDSTMT; 49110000=07745000= + GO TO EXIT; 49115000=07745000= +LDBL: 49120000=07746000= + DBLSTMT; 49125000=07746000= + GO TO EXIT; 49130000=07746000= +LFOR: 49135000=07747000= + FORSTMT; 49140000=07747000= + GO TO EXIT; 49145000=07747000= +LWHILE: 49150000=07748000= + WHILESTMT; 49155000=07748000= + GO TO EXIT; 49160000=07748000= +LDO: 49165000=07749000= + DOSTMT; 49170000=07749000= + GO TO EXIT; 49175000=07749000= +LFILL: 49180000=07750000= + FILLSTMT; 49185000=07750000= + GO TO EXIT; 49190000=07750000= +LIF: 49195000=07751000= + IFSTMT; 49200000=07751000= + GO TO EXIT; 49205000=07751000= +LGO: 49210000=07752000= + GOSTMT; 49215000=07752000= + GO TO EXIT; 49220000=07752000= +LRELSE: 49225000=07753000= + RELSESTMT; 49230000=07753000= + GO TO EXIT; 49235000=07753000= +LBEG: 49240000=07754000= + IF STEPI = DECLARATORS THEN 49245000=07755000= + BEGIN 49250000=07755000= + I:= I-1; 49255000=07755000= + BLOCK(FALSE) 49260000=07755000= + END 49265000=07756000= + ELSE 49270000=07756000= + COMPOUNDTIAL; 49275000=07756000= +EXIT: 49280000=07757000= + END STMT; 49285000=07757000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%49290000=07757000= + PROCEDURE CMPLXSTMT; 49295000=07777777= + FORWARD; 49300000=07777777= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%49305000=07777777= + PROCEDURE UNKNOWNSTMT; 49310000=07800000= + BEGIN 49315000=07801000= + LABEL 49320000=07801000= + XXX, 49325000=07801000= + E; 49330000=07801000= + REAL 49335000=07802000= + J, 49340000=07802000= + N, 49345000=07802000= + C; 49350000=07802000= + IF Q = 6"5BREAK" THEN 49355000=07803000= + BEGIN 49360000=07804000= + EMIT(0); 49365000=07804000= + EMIT(48); 49370000=07805000= + EMITO(COM); 49375000=07806000= + EMITO(DEL); 49380000=07807000= + STEPIT; 49385000=07808000= + GO TO XXX; 49390000=07809000= + END; 49395000=07810000= + IF Q = 6"7COMPL" THEN 49400000=07810100= + BEGIN 49405000=07810100= + CMPLXSTMT; 49410000=07810100= + GO XXX 49415000=07810100= + END; 49420000=07810100= + IF Q = 6"3ZIP00" THEN 49425000=07811000= + BEGIN 49430000=07812000= + IF TABLE(I+1) = WITHV THEN 49435000=07812000= + BEGIN 49440000=07813000= + STEPIT; 49445000=07813000= + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 49450000=07814100= + IF ELCLASS = FILEID OR ELCLASS = SUPERFILEID THEN 49455000=07814300= + PASSFILE 49460000=07814400= + ELSE 49465000=07814400= + GO E 49470000=07814500= + ELSE 49475000=07814500= + BEGIN 49480000=07814600= + VARIABLE(FL); 49485000=07815000= + IF TABLE(I-2) ^= FACTOP THEN 49490000=07816000= + GO TO E; 49495000=07816000= + END; 49500000=07816100= + EMIT(16); 49505000=07817000= + EMITO(COM); 49510000=07817000= + EMITO(DEL); 49515000=07817000= + GO TO XXX; 49520000=07818000= + END; 49525000=07819000= + N:= 1; 49530000=07820000= + C:= 8 49535000=07821000= + END 49540000=07821100= + ELSE 49545000=07821100= + IF Q = 6"5CHAIN" THEN 49550000=07821100= + BEGIN 49555000=07821200= + N:= 1; 49560000=07821200= + C:= 37 49565000=07821200= + END 49570000=07822000= + ELSE 49575000=07822000= + IF Q = 6"4WHEN0" THEN 49580000=07822000= + BEGIN 49585000=07823000= + N:= 0; 49590000=07823000= + C:= 6 49595000=07823000= + END 49600000=07824000= + ELSE 49605000=07824000= + IF Q = 6"4WAIT0" THEN 49610000=07824000= + BEGIN 49615000=07825000= + N:= 1; 49620000=07825000= + C:= 2 49625000=07825000= + END 49630000=07825500= + ELSE 49635000=07825500= + IF Q = 6"4CASE0" THEN 49640000=07825500= + BEGIN 49645000=07825500= + CASESTMT; 49650000=07825500= + GO TO XXX 49655000=07825500= + END 49660000=07826000= + ELSE 49665000=07826000= + IF Q = 6"4SORT0" THEN 49670000=07826000= + BEGIN 49675000=07826000= + SORTSTMT; 49680000=07826000= + GO XXX 49685000=07826000= + END 49690000=07827000= + ELSE 49695000=07827000= + IF Q = 6"5MERGE" THEN 49700000=07827000= + BEGIN 49705000=07827000= + MERGESTMT; 49710000=07827000= + GO XXX 49715000=07827000= + END 49720000=07828000= + ELSE 49725000=07828000= + IF Q = 6"6SEARC" THEN 49730000=07828000= + BEGIN 49735000=07829000= + IF STEPI ^= LEFTPAREN THEN 49740000=07829000= + BEGIN 49745000=07830000= + ERR(105); 49750000=07830000= + GO TO XXX 49755000=07830000= + END; 49760000=07830000= + IF STEPI = FILEID OR ELCLASS = SUPERFILEID THEN 49765000=07831000= + PASSFILE 49770000=07832000= + ELSE 49775000=07832000= + GO TO E; 49780000=07832000= + IF ELCLASS ^= COMMA THEN 49785000=07833000= + GO TO E; 49790000=07833000= + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 49795000=07834000= + GO TO E; 49800000=07835000= + XMARK(ASSIGNREF); % SEARCH STATEMENT 49805000=07835500= + VARIABLE(FL); 49810000=07836000= + IF TABLE(I-2) ^= FACTOP THEN 49815000=07837000= + GO TO E; 49820000=07837000= + IF ELCLASS ^= RTPAREN THEN 49825000=07838000= + BEGIN 49830000=07839000= + ERR(104); 49835000=07839000= + GO TO XXX 49840000=07839000= + END; 49845000=07839000= + EMITPAIR(30, COM); 49850000=07840000= + EMITO(DEL); 49855000=07840000= + EMITO(DEL); 49860000=07840000= + STEPIT; 49865000=07841000= + GO TO XXX; 49870000=07841000= + END 49875000=07843000= + ELSE 49880000=07843000= + IF Q = 6"4SEEK0" THEN 49885000=07843000= + BEGIN 49890000=07844000= + IF STEPI ^= LEFTPAREN THEN 49895000=07844000= + BEGIN 49900000=07845000= + ERR(105); 49905000=07845000= + GO TO XXX; 49910000=07845000= + END; 49915000=07845000= + IF STEPI ^= FILEID AND ELCLASS ^= SUPERFILED THEN 49920000=07846000= + GO TO E 49925000=07847000= + ELSE 49930000=07847000= + BEGIN 49935000=07848000= + EMITL(0); 49940000=07848000= + EMITL(0); 49945000=07848000= + PASSFILE; 49950000=07848000= + IF ELCLASS ^= LEFTPAREN THEN 49955000=07849000= + BEGIN 49960000=07850000= + ERR(105); 49965000=07850000= + GO TO XXX; 49970000=07850000= + END; 49975000=07850000= + STEPIT; 49980000=07851000= + AEXP; 49985000=07851000= + EMITO(XCH); 49990000=07851000= + IF ELCLASS ^= RTPAREN THEN 49995000=07852000= + BEGIN 50000000=07853000= + ERR(104); 50005000=07853000= + GO TO XXX; 50010000=07853000= + END; 50015000=07853000= + IF STEPI ^= RTPAREN THEN 50020000=07854000= + BEGIN 50025000=07855000= + ERR(104); 50030000=07855000= + GO TO XXX; 50035000=07855000= + END; 50040000=07855000= + EMITPAIR(32, COM); 50045000=07856000= + EMITO(DEL); 50050000=07856000= + EMITO(DEL); 50055000=07856000= + EMITO(DEL); 50060000=07857000= + EMITO(DEL); 50065000=07857000= + STEPIT; 50070000=07857000= + END; 50075000=07858000= + GO TO XXX; 50080000=07858000= + END 50085000=07859010= + ELSE 50090000=07859010= + IF Q = 6"6UNLOC" THEN 50095000=07859010= + BEGIN 50100000=07859020= + IF STEPI ^= LEFTPAREN THEN 50105000=07859020= + BEGIN 50110000=07859030= + ERR(105); 50115000=07859030= + GO TO XXX 50120000=07859030= + END; 50125000=07859030= + STEPIT; 50130000=07859040= + VARIABLE(FL); 50135000=07859040= + L:= L-1; 50140000=07859040= + IF TABLE(I-2) ^= FACTOP THEN 50145000=07859050= + FLAG(208); 50150000=07859050= + EMITO(DUP); 50155000=07859060= + EMITO(LOD); 50160000=07859060= + EMITL(0); 50165000=07859060= + EMITD(43, 3, 5); 50170000=07859070= + EMITO(XCH); 50175000=07859070= + EMITO(STD); 50180000=07859070= + IF ELCLASS = RTPAREN THEN 50185000=07859080= + STEPIT 50190000=07859080= + ELSE 50195000=07859080= + ERR(104); 50200000=07859080= + GO TO XXX 50205000=07859100= + END 50210000=07859900= + ELSE 50215000=07859900= + $ SET OMIT = NOT TSPOL 50220000=07859900= + BEGIN 50225000=07900000= + ERROR(100); 50230000=07900000= + GO TO XXX 50235000=07900000= + END; 50240000=07900000= + IF STEPI ^= LEFTPAREN THEN 50245000=07901000= + BEGIN 50250000=07902000= + ERR(105); 50255000=07902000= + GO TO XXX 50260000=07902000= + END; 50265000=07902000= + STEPIT; 50270000=07903000= + AEXP; 50275000=07903000= + FOR J:= 1 STEP 1 UNTIL N DO 50280000=07904000= + BEGIN 50285000=07905000= + IF ELCLASS ^= COMMA THEN 50290000=07905000= + E: 50295000=07906000= + BEGIN 50300000=07906000= + ERR(164); 50305000=07906000= + GO TO XXX 50310000=07906000= + END; 50315000=07906000= + STEPIT; 50320000=07907000= + AEXP; 50325000=07907000= + END; 50330000=07908000= + IF ELCLASS ^= RTPAREN THEN 50335000=07909000= + BEGIN 50340000=07910000= + ERR(104); 50345000=07910000= + GO TO XXX 50350000=07910000= + END; 50355000=07910000= + EMITL(C); 50360000=07911000= + EMITO(COM); 50365000=07911000= + FOR J:= 0 STEP 1 UNTIL N DO 50370000=07912000= + EMITO(DEL); 50375000=07912000= + STEPIT; 50380000=07913000= +XXX: 50385000=07914000= + END; 50390000=07914000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50395000=07914000= + PROCEDURE FAULTSTMT; 50400000=07920000= + COMMENT THIS IS WHAT HAPPENS FOR THE"~" 50405000=07920000= + KIND OF STATEMENT. FOR THE RUN-TIME ERROR MESS; 50410000=07921000= + BEGIN 50415000=07922000= + REAL 50420000=07922000= + ELBW, 50425000=07922000= + STR; 50430000=07922000= + DEFINE 50435000=07922000= + ADRES = ELBW.ADDRESS #; 50440000=07922000= + CHECKER(ELBW:= ELBAT[I]); 50445000=07923000= + STR:= 50450000=07923000= + IF FAULTOG THEN 50455000=07923000= + SND 50460000=07923000= + ELSE 50465000=07923000= + STD; 50470000=07923000= + FAULTOG:= BOOLEAN(1) OR FAULTOG; 50475000=07923100= + COMMENT TELLS DEXP TO MESS 50480000=07923100= + WITH FAULTLEVEL; 50485000=07923150= + IF STEPI ^= ASSIGNOP THEN 50490000=07924000= + ERR(60) 50495000=07924000= + ELSE 50500000=07924000= + IF STEPI = LITNO THEN 50505000=07925000= + BEGIN 50510000=07925000= + EMIT(0); 50515000=07925000= + STEPIT 50520000=07925000= + END 50525000=07925100= + ELSE 50530000=07925100= + IF ELCLASS = FAULTID THEN 50535000=07925100= + FAULTSTMT 50540000=07925100= + ELSE 50545000=07925100= + DEXP; 50550000=07925100= + EMITPAIR(ADRES, STR); 50555000=07926000= + FAULTOG:= FALSE & (ELBW.LVL < LEVEL OR FAULTOG.[46:1])[46:47:1]; 50560000=07926100= + END FAULTSTMT NOW WASNT THAT SIMPLE; 50565000=07927000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50570000=07927000= + PROCEDURE KLUDGE(T); 50575000=07930000= + VALUE 50580000=07930000= + T; 50585000=07930000= + INTEGER 50590000=07930000= + T; 50595000=07930000= + BEGIN 50600000=07931000= + COMMENT KLUDGE HANDLES ARRAY-ROW READS AND WRITES FOR 50605000=07931000= + THOSE CASES WHICH DO NOT NEED TO GO THROUGH THE 50610000=07932000= + FORMATTING INTRINSICS. A NEW MCP INTRINSIC IS 50615000=07933000= + USED, TO FURTHER IMPROVE SPEED/DECREASE CORE USE; 50620000=07934000= + LABEL 50625000=07935000= + EXIT; 50630000=07935000= + L:= ABS(T); 50635000=07936000= + AEXP; 50640000=07937000= + IF ELCLASS ^= COMMA THEN 50645000=07938000= + BEGIN 50650000=07938000= + ERR(426); 50655000=07938000= + GO TO EXIT; 50660000=07938000= + END; 50665000=07938000= + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN 50670000=07939000= + BEGIN 50675000=07940000= + ERR(429); 50680000=07940000= + GO TO EXIT; 50685000=07940000= + END; 50690000=07940000= + VARIABLE(FL); 50695000=07941000= + IF TABLE(I-2) ^= FACTOP THEN 50700000=07941000= + BEGIN 50705000=07942000= + ERR(427); 50710000=07942000= + GO TO EXIT; 50715000=07942000= + END; 50720000=07942000= + IF ELCLASS ^= RTPAREN THEN 50725000=07943000= + BEGIN 50730000=07943000= + ERR(428); 50735000=07943000= + GO TO EXIT; 50740000=07943000= + END; 50745000=07943000= + EMITO(XCH); 50750000=07944000= + IF T < 0 THEN 50755000=07945000= + COMMENT FROM WRITE...(<0 IS FROM READ); 50760000=07945000= + BEGIN 50765000=07946000= + EMITPAIR(JUNK, STD); 50770000=07946000= + EMITO(XCH); 50775000=07946000= + EMITV(JUNK); 50780000=07946000= + END; 50785000=07946000= + IF T > 0 THEN 50790000=07947000= + IF TABLE(I+1) = LFTBRKET THEN 50795000=07947000= + BEGIN 50800000=07948000= + GOGOGO:= FALSE; % JUST TO MAKE SURE... 50805000=07948000= + HANDLETHETAILENDOFAREADORSPACESTATEMENT; % 50810000=07949000= + L:= L-1; % REMOVE THE OPDC ON INPUTINT... 50815000=07950000= + EMITO(DEL); 50820000=07951000= + EMITO(DEL); % REMOVE LABEL WORDS... 50825000=07951000= + END 50830000=07952000= + ELSE 50835000=07952000= + STEPIT 50840000=07952000= + ELSE 50845000=07952000= + STEPIT; % WALTZ ON BY... 50850000=07952000= + EMITV(GNAT(SUPERMOVER)); % BET YOU THOUGHT I"D NEVER DO IT 50855000=07953000= +EXIT: 50860000=07954000= + END THIS HAIRY KLUDGE; % 50865000=07954000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%50870000=07954000= + 50875000=08000000= + COMMENT FORSTMT IS RESPONSIBLE FOR THE COMPILATION OF FOR STATEMENTS. 50880000=08000000= + IF THE FOR STATEMENT HAS A SINGLE STEP-UNTIL ELEMENT SUCH 50885000=08001000= + THAT THE INITIAL VALUE, THE STEP AND THE FINAL VALUE ARE 50890000=08002000= + ALL OF THE FORM V,+V, OR -V WHERE V IS A VARIABLE OR A 50895000=08003000= + CONSTANT, THEN THE CODE TAKES ON MORE EFFICIENT FORM. 50900000=08004000= + IN OTHER CASES THE CODE IS SOMEWHAT LESS EFFICIENT, SINCE 50905000=08005000= + THE BODY OF THE FOR STATEMENT BECOMES A SUBROUTINE. THE 50910000=08006000= + STEP ALSO BECOMES A SUBROUTINE IF IT IS NOT SIMPLE; 50915000=08007000= + PROCEDURE FORSTMT; 50920000=08008000= + BEGIN 50925000=08009000= + OWN REAL 50930000=08010000= + B, 50935000=08010000= + STMTSTART, 50940000=08010000= + REGO, 50945000=08010000= + RETURNSTORE, 50950000=08010000= + ADDRES, 50955000=08010000= + V, 50960000=08010000= + VRET, 50965000=08011000= + BRET; 50970000=08011000= + OWN BOOLEAN 50975000=08012000= + SIGNA, 50980000=08012000= + SIGNB, 50985000=08012000= + SIGNC, 50990000=08012000= + INT, 50995000=08013000= + CONSTANA, 51000000=08013000= + CONSTANB, 51005000=08013000= + CONSTANC; 51010000=08013000= + DEFINE 51015000=08014000= + SIMPLEB = SIGNC #, 51020000=08014000= + FORMALV = SIGNA #, 51025000=08015000= + SIMPLEV = CONSTANA #, 51030000=08015000= + A = V #, 51035000=08015000= + Q = REGO #, 51040000=08016000= + OPDC = TRUE #, 51045000=08016000= + DESC = FALSE #, 51050000=08016000= + K = BRET #; 51055000=08016000= + LABEL 51060000=08017000= + EXIT; 51065000=08017000= + 51070000=08017100= + COMMENT FORCLASS CHECKS FOR THE APPROPRIATE WORD STEP, UNTIL, OR DO-- 51075000=08017100= + IF A CONSTANT IS FOUND, IT STORES OFF THE VALUE (FROM C) AT 51080000=08017200= + INFO[0,K] AND STUFFS K INTO THE ELBAT WORD, SO THAT TABLE CAN 51085000=08017300= + RECONSTRUCT THE CONSTANT EHEN WE SCAN ELBAT AGAIN; 51090000=08017400= + BOOLEAN PROCEDURE FORCLASS(CLSS); 51095000=08017500= + VALUE 51100000=08017500= + CLSS; 51105000=08017500= + INTEGER 51110000=08017500= + CLSS; 51115000=08017500= + IF STEPI = CLSS THEN 51120000=08017600= + FORCLASS:= TRUE 51125000=08017600= + ELSE 51130000=08017600= + IF ELCLASS >= NONLITNO AND ELCLASS <= STRNGCON THEN 51135000=08017700= + BEGIN 51140000=08017800= + INFO[0, K:= K+1]:= C; 51145000=08017800= + ELBAT[I]:= 0 & COMMENTV[2:41:7] & K[16:37:11] 51150000=08017950= + END FORCLASS; 51155000=08017950= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51160000=08017950= + 51165000=08018000= + COMMENT PLUG EMITS EITHER AN OPERAND CALL ON A VARIABLE OR A CALL ON A 51170000=08018000= + CONSTANT DEPENDING ON THE REQUIREMENTS; 51175000=08019000= + PROCEDURE PLUG(C, A); 51180000=08020000= + VALUE 51185000=08020000= + C, 51190000=08020000= + A; 51195000=08020000= + REAL 51200000=08020000= + A; 51205000=08020000= + BOOLEAN 51210000=08020000= + C; 51215000=08020000= + IF C THEN 51220000=08021000= + EMITNUM(A) 51225000=08021000= + ELSE 51230000=08021000= + BEGIN 51235000=08021000= + CHECKER(A); 51240000=08021100= + EMITV(A.ADDRESS) 51245000=08021200= + END; 51250000=08021200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51255000=08021200= + 51260000=08022000= + COMMENT SIMPLE DETERMINES IF AN ARITHMETIC EXPRESSION IS + OR - A 51265000=08022000= + CONSTANT OR A SIMPLE VARIABLE. IT MAKES A THROUGH REPORT 51270000=08023000= + ON ITS ACTIVITY. IT ALSO MAKES PROVISION FOR THE RESCAN 51275000=08024000= + OF ELBAT (THIS IS THE ACTION WITH K - SEE CODE IN THE 51280000=08025000= + TABLE ROUTINE FOR FURTHER DETAILS); 51285000=08026000= + BOOLEAN PROCEDURE SIMPLE(B, A, S); 51290000=08027000= + BOOLEAN 51295000=08027000= + B, 51300000=08027000= + S; 51305000=08027000= + REAL 51310000=08027000= + A; 51315000=08027000= + BEGIN 51320000=08028000= + S:= 51325000=08029000= + IF STEPI ^= ADOP THEN 51330000=08029000= + FALSE 51335000=08029000= + ELSE 51340000=08029000= + ELBAT[I].ADDRESS = SUB; 51345000=08030000= + IF ELCLASS = ADOP THEN 51350000=08031000= + STEPIT; 51355000=08031000= + IF ELCLASS >= NONLITNO AND ELCLASS <= STRNGCON THEN 51360000=08033000= + BEGIN 51365000=08033000= + K:= K+1; 51370000=08033000= + SIMPLE:= TRUE; 51375000=08033000= + ELBAT[I]:= 0 & COMMENTV[2:41:7] & K[16:37:11]; 51380000=08034000= + INFO[0, K]:= A:= C; 51385000=08035000= + B:= TRUE 51390000=08035000= + END 51395000=08036000= + ELSE 51400000=08036000= + BEGIN 51405000=08036000= + B:= FALSE; 51410000=08037000= + A:= ELBAT[I]; 51415000=08037000= + SIMPLE:= REALID <= ELCLASS AND ELCLASS <= INTID 51420000=08038000= + END; 51425000=08038000= + END SIMPLE; 51430000=08038100= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51435000=08038100= + 51440000=08040000= + COMMENT TEST EMITS THE STEP-UNTIL ELEMENT TEST; 51445000=08040000= + PROCEDURE TEST; 51450000=08041000= + BEGIN 51455000=08042000= + IF NOT CONSTANB THEN 51460000=08043000= + BEGIN 51465000=08044000= + EMITO(SUB); 51470000=08044000= + IF SIMPLEB THEN 51475000=08044000= + EMITV(B.ADDRESS) 51480000=08045000= + ELSE 51485000=08045000= + BEGIN 51490000=08045000= + EMITL(2+L-BRET); 51495000=08046000= + EMITB(BBW, BUMPL, B); 51500000=08047000= + END; 51505000=08048000= + EMITO(MUL); 51510000=08049000= + EMIT(0) 51515000=08049000= + END; 51520000=08049000= + EMITO(IF SIGNB THEN GEQ ELSE LEQ); 51525000=08050000= + EMIT(0); 51530000=08050000= + L:= L-1 51535000=08051000= + END TEST; 51540000=08051000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51545000=08051000= + BOOLEAN PROCEDURE SIMPI(ALL); 51550000=08052000= + VALUE 51555000=08052000= + ALL; 51560000=08052000= + REAL 51565000=08052000= + ALL; 51570000=08052000= + BEGIN 51575000=08053000= + CHECKER(VRET:= ALL); 51580000=08054000= + ADDRES:= ALL.ADDRESS; 51585000=08055000= + FORMALV:= ALL.[9:2] = 2; 51590000=08056000= + IF T:= ALL.CLASS > INTARRAYID OR T < BOOID OR GT1:= (T-BOOID) MOD 51595000=08058000= + 4 < 1 51600000=08058000= + THEN 51605000=08058000= + ERR(REAL(T ^= 0)*51+100); 51610000=08059000= + INT:= GT1 = 3; 51615000=08060000= + SIMPI:= T <= INTID 51620000=08061000= + END SIMPI; 51625000=08061000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51630000=08061000= + 51635000=08062000= + COMMENT STORE EMITS THE CODE FOR THE STORE INTO THE FOR INDEX; 51640000=08062000= + PROCEDURE STORE(S); 51645000=08063000= + VALUE 51650000=08063000= + S; 51655000=08063000= + BOOLEAN 51660000=08063000= + S; 51665000=08063000= + BEGIN 51670000=08064000= + IF FORMALV THEN 51675000=08065000= + BEGIN 51680000=08065000= + EMITO(XCH); 51685000=08065000= + S:= FALSE 51690000=08065000= + END 51695000=08066000= + ELSE 51700000=08066000= + BEGIN 51705000=08066000= + EMITL(ADDRES); 51710000=08067000= + IF ADDRES > 1023 THEN 51715000=08068000= + EMITO(PRTE) 51720000=08068000= + END; 51725000=08068000= + T:= (REAL(S)+1)*16; 51730000=08069000= + EMITO((IF INT THEN T+512 ELSE 4*T)+4) 51735000=08070000= + END STORE; 51740000=08070000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51745000=08070000= + 51750000=08071000= + COMMENT CALL EFFECTS A CALL ON THE INDEX; 51755000=08071000= + PROCEDURE CALL(S); 51760000=08072000= + VALUE 51765000=08072000= + S; 51770000=08072000= + BOOLEAN 51775000=08072000= + S; 51780000=08072000= + BEGIN 51785000=08073000= + IF SIMPLEV THEN 51790000=08075000= + IF S THEN 51795000=08075000= + EMITV(ADDRES) 51800000=08075000= + ELSE 51805000=08075000= + EMITN(ADDRES) 51810000=08076000= + ELSE 51815000=08076000= + BEGIN 51820000=08076000= + EMITL(2+L-VRET); 51825000=08077000= + EMITB(BBW, BUMPL, V); 51830000=08078000= + IF S THEN 51835000=08079000= + EMITO(LOD) 51840000=08079000= + END 51845000=08079000= + END CALL; 51850000=08079000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51855000=08079000= + PROCEDURE FORLIST(NUMLE); 51860000=08080000= + VALUE 51865000=08080000= + NUMLE; 51870000=08080000= + BOOLEAN 51875000=08080000= + NUMLE; 51880000=08080000= + BEGIN 51885000=08081000= + PROCEDURE FIX(STORE, BACK, FORWART, START); 51890000=08082000= + VALUE 51895000=08083000= + STORE, 51900000=08083000= + BACK, 51905000=08083000= + FORWART, 51910000=08083000= + START; 51915000=08083000= + REAL 51920000=08084000= + STORE, 51925000=08084000= + BACK, 51930000=08084000= + FORWART, 51935000=08084000= + START; 51940000=08084000= + BEGIN 51945000=08085000= + EMITB(GET(FORWART-1), FORWART, START); 51950000=08086000= + IF RETURNSTORE ^= 0 THEN 51955000=08088000= + BEGIN 51960000=08088000= + L:= STORE; 51965000=08089000= + EMITNUM(B-BACK); 51970000=08089000= + EMITPAIR(RETURNSTORE, STD) 51975000=08090000= + END 51980000=08090000= + END FIX; 51985000=08090000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%51990000=08090000= + INTEGER 51995000=08091000= + BACKFIX, 52000000=08091000= + FORWARDBRANCH, 52005000=08091000= + FOOT, 52010000=08091000= + STOREFIX; 52015000=08091000= + LABEL 52020000=08092000= + BRNCH, 52025000=08092000= + EXIT; 52030000=08092000= + STOREFIX:= L; 52035000=08093000= + Q:= REAL(MODE = 0)+3; 52040000=08093000= + FOR K:= 1 STEP 1 UNTIL Q DO 52045000=08094000= + EMITO(NOP); 52050000=08094000= + IF NUMLE THEN 52055000=08096000= + BEGIN 52060000=08096000= + BACKFIX:= L; 52065000=08097000= + IF FORMALV THEN 52070000=08098000= + CALL(DESC) 52075000=08099000= + END 52080000=08099000= + ELSE 52085000=08099000= + BACKFIX:= V+REAL(SIMPLEV)-1; 52090000=08099000= + DIALA+DIALB:= 0; 52095000=08100000= + AEXP; 52100000=08101000= + DIALA:= DIALB:= 0; 52105000=08101000= + COMMENT PICK UP FIRST ARITHMETIC EXPRESSION; 52110000=08102000= + IF ELCLASS = STEPV THEN 52115000=08104000= + BEGIN 52120000=08104000= + COMMENT HERE WE HAVE A STEP ELEMENT; 52125000=08105000= + BACKFIX:= BUMPL; 52130000=08106000= + COMMENT LEAVE ROOM FOR FORWARD JUMP; 52135000=08107000= + IF FORMALV THEN 52140000=08108000= + CALL(DESC); 52145000=08108000= + CALL(OPOC); 52150000=08108000= + COMMENT FETCH INDEX; 52155000=08109000= + IF I > 70 THEN 52160000=08110000= + BEGIN 52165000=08110000= + NXTELBT:= 1; 52170000=08110000= + I:= 0 52175000=08110000= + END 52180000=08111000= + ELSE 52185000=08111000= + REGO:= I; 52190000=08111000= + IF SIMPLEB:= SIMPLE(CONSTANB, B, SIGNB) AND 52195000=08114000= + (STEPI = UNTILV OR ELCLASS = WHILEV) 52200000=08114000= + THEN 52205000=08114000= + BEGIN 52210000=08114000= + COMMENT WE HAVE A SIMPLE STEP FUNCTION; 52215000=08115000= + PLUG(CONSTANB, B); 52220000=08116000= + END 52225000=08117000= + ELSE 52230000=08117000= + BEGIN 52235000=08117000= + COMMENT THE STEP FUNCTION IS NOT SIMPLE: WE CONSTRUCT A 52240000=08118000= + SUBROUTINE; 52245000=08119000= + I:= 52250000=08120000= + IF I < 4 THEN 52255000=08120000= + 0 52260000=08120000= + ELSE 52265000=08120000= + REGO; 52270000=08120000= + STEPIT; 52275000=08120000= + SIGNB:= CONSTANB:= FALSE; 52280000=08121000= + EMIT(0); 52285000=08122000= + B:= L; 52290000=08122000= + AEXP; 52295000=08123000= + EMITO(XCH); 52300000=08123000= + BRET:= L; 52305000=08124000= + EMITO(BFW) 52310000=08125000= + END; 52315000=08125000= + EMITO(REAL(SIGNB)*32+ADD); 52320000=08126000= + EMITB(BFW, BACKFIX, L); 52325000=08127000= + IF ELCLASS = UNTILV THEN 52330000=08129000= + BEGIN 52335000=08129000= + COMMENT STEP-UNTIL ELEMENT; 52340000=08129000= + STORE(TRUE); 52345000=08130000= + IF FORMALV THEN 52350000=08130000= + CALL(OPDC); 52355000=08130000= + STEPIT; 52360000=08131000= + AEXP; 52365000=08131000= + TEST 52370000=08131000= + END 52375000=08132000= + ELSE 52380000=08132000= + BEGIN 52385000=08132000= + COMMENT STEP-WHILE ELEMENT; 52390000=08132000= + IF ELCLASS ^= WHILEV THEN 52395000=08133000= + BEGIN 52400000=08134000= + ERR(153); 52405000=08134000= + GO TO EXIT 52410000=08134000= + END; 52415000=08134000= + STEPIT; 52420000=08135000= + STORE(FALSE); 52425000=08135000= + BEXP 52430000=08135000= + END 52435000=08136000= + END 52440000=08136000= + ELSE 52445000=08136000= + BEGIN 52450000=08136000= + COMMENT WE DO NOT HAVE A STEP ELEMENT; 52455000=08137000= + STORE(FALSE); 52460000=08138000= + IF ELCLASS = WHILEV THEN 52465000=08140000= + BEGIN 52470000=08140000= + COMMENT WE HAVE A WHILE ELEMENT; 52475000=08141000= + STEPIT; 52480000=08142000= + BEXP 52485000=08142000= + END 52490000=08143000= + ELSE 52495000=08143000= + BEGIN 52500000=08143000= + COMMENT ONE EXPRESSION ELEMENT; 52505000=08144000= + IF ELCLASS ^= COMMA THEN 52510000=08145000= + BEGIN 52515000=08145000= + EMITB(BFW, BUMPL, L+2); 52520000=08146000= + BACKFIX:= L 52525000=08146000= + END 52530000=08147000= + ELSE 52535000=08147000= + BACKFIX:= L+2; 52540000=08147000= + L:= L+1; 52545000=08148000= + EMIT(BFW); 52550000=08148000= + GO TO BRNCH 52555000=08148000= + END 52560000=08148000= + END; 52565000=08148000= + COMMENT THIS IS THE COMMON POINT; 52570000=08149000= + IF ELCLASS = COMMA THEN 52575000=08150000= + EMITLNG; 52580000=08150000= + L:= L+1; 52585000=08150000= + EMIT(BFC); 52590000=08151000= + BRNCH: 52595000=08152000= + FORWARDBRANCH:= L; 52600000=08152000= + DIALA:= DIALB:= 0; 52605000=08152000= + IF ELCLASS = COMMA THEN 52610000=08154000= + BEGIN 52615000=08154000= + STEPIT; 52620000=08155000= + FORLIST(TRUE); 52625000=08156000= + FIX(STOREFIX, BACKFIX, FORWARDBRANCH, STMTSTART) 52630000=08157000= + END 52635000=08158000= + ELSE 52640000=08158000= + BEGIN 52645000=08158000= + IF ELCLASS ^= DOV THEN 52650000=08160000= + BEGIN 52655000=08160000= + ERR(154); 52660000=08160000= + REGO:= L; 52665000=08160000= + GO EXIT 52670000=08160000= + END; 52675000=08160000= + STEPIT; 52680000=08161000= + IF NUMLE THEN 52685000=08162000= + FOOT:= GETSPACE(FALSE, -1); % TEMP. 52690000=08162000= + IF LISTMODE THEN 52695000=08163000= + LISTELEMENT 52700000=08163000= + ELSE 52705000=08163000= + STMT; 52710000=08163000= + IF NUMLE THEN 52715000=08165000= + BEGIN 52720000=08165000= + EMITV(RETURNSTORE+FOOT); 52725000=08166000= + EMITO(BBW) 52730000=08166000= + END 52735000=08167000= + ELSE 52740000=08167000= + BEGIN 52745000=08167000= + EMITB(BBW, BUMPL, BACKFIX); 52750000=08168000= + RETURNSTORE:= 0 52755000=08168000= + END; 52760000=08168000= + STMTSTART:= FORWARDBRANCH; 52765000=08169000= + B:= L; 52770000=08169000= + CONSTANTCLEAN; 52775000=08170000= + REGO:= L; 52780000=08170000= + FIX(STOREFIX, BACKFIX, FORWARDBRANCH, L) 52785000=08171000= + END; 52790000=08171000= + EXIT: 52795000=08172000= + END FORLIST; 52800000=08172000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%52805000=08172000= + REAL 52810000=08173000= + T1, 52815000=08173000= + T2, 52820000=08173000= + T3, 52825000=08173000= + T4; 52830000=08173000= + NXTELBT:= 1; 52835000=08174000= + I:= 0; 52840000=08174000= + STEPIT; 52845000=08175000= + IF SIMPI(VRET:= ELBAT[I]) THEN 52850000=08177000= + BEGIN 52855000=08177000= + IF STEPI ^= ASSIGNOP THEN 52860000=08178000= + BEGIN 52865000=08178000= + ERR(152); 52870000=08178000= + GO EXIT 52875000=08178000= + END; 52880000=08178000= + XMARK(ASSIGNREF); % FOR STATEMENT 52885000=08178100= + T1:= L; 52890000=08179000= + IF FORMALV THEN 52895000=08179000= + EMITN(ADDRES); 52900000=08179000= + K:= 0; 52905000=08180000= + IF SIMPLE(CONSTANA, A, SIGNA) THEN 52910000=08181000= + IF FORCLASS(STEPV) THEN 52915000=08182000= + IF SIMPLE(CONSTANB, B, SIGNB) THEN 52920000=08183000= + IF FORCLASS(UNTILV) THEN 52925000=08184000= + IF SIMPLE(CONSTANC, C, SIGNC) THEN 52930000=08185000= + IF FORCLASS(DOV) THEN 52935000=08186000= + BEGIN 52940000=08187000= + PLUG(CONSTANA, A); 52945000=08188000= + IF SIGNA THEN 52950000=08189000= + EMITO(CHS); 52955000=08189000= + RETURNSTORE:= BUMPL; 52960000=08190000= + ADJUST; 52965000=08190000= + CONSTANTCLEAN; 52970000=08190000= + STMTSTART:= L; 52975000=08191000= + STEPIT; 52980000=08192000= + T1:= (((4096*RETURNSTORE+STMTSTART)*2+REAL(CONSTANB))*52985000=08195000= + 2+REAL(CONSTANC))*2+REAL(SIGNB))*2+REAL(SIGNC); 52990000=08197000= + T2:= VRET; 52995000=08198000= + T3:= B; 53000000=08199000= + T4:= Q; 53005000=08200000= + IF LISTMODE THEN 53010000=08201000= + LISTELEMENT 53015000=08201000= + ELSE 53020000=08201000= + STMT; 53025000=08201000= + SIGNC:= BOOLEAN(T1.[47:1]); 53030000=08202000= + SIGNB:= BOOLEAN(T1.[46:1]); 53035000=08203000= + CONSTANC:= BOOLEAN(T1.[45:1]); 53040000=08204000= + CONSTANB:= BOOLEAN(T1.[44:1]); 53045000=08205000= + STMTSTART:= T1.[32:12]; 53050000=08206000= + RETURNSTORE:= T1.[20:12]; 53055000=08207000= + VRET:= T2; 53060000=08208000= + B:= T3; 53065000=08209000= + Q:= T4; 53070000=08210000= + SIMPLEV:= SIMPI(VRET); 53075000=08211000= + IF FORMALV THEN 53080000=08212000= + EMITN(ADDRES); 53085000=08212000= + EMITV(ADDRES); 53090000=08212000= + PLUG(CONSTANB, B); 53095000=08213000= + EMITO(IF SIGNB THEN SUB ELSE ADD); 53100000=08214000= + EMITB(BFW, RETURNSTORE, L); 53105000=08215000= + STORE(TRUE); 53110000=08216000= + IF FORMALV THEN 53115000=08217000= + CALL(OPDC); 53120000=08217000= + PLUG(CONSTANC, Q); 53125000=08218000= + IF SIGNC THEN 53130000=08219000= + EMITO(CHS); 53135000=08219000= + SIMPLEB:= TRUE; 53140000=08220000= + TEST; 53145000=08220000= + EMITLNG; 53150000=08220000= + EMITB(BBC, BUMPL, STMTSTART); 53155000=08221000= + GO TO EXIT 53160000=08222000= + END; 53165000=08222000= + I:= 2; 53170000=08223000= + K:= 0; 53175000=08223000= + SIMPLEV:= SIMPI(VRET); 53180000=08224000= + V:= T1 53185000=08225000= + END 53190000=08226000= + ELSE 53195000=08226000= + BEGIN 53200000=08226000= + EMIT(0); 53205000=08227000= + V:= L; 53210000=08227000= + SIMPLEV:= FALSE; 53215000=08227000= + FORMALV:= TRUE; 53220000=08227000= + VARIABLE(FR); 53225000=08228000= + EMITO(XCH); 53230000=08228000= + VRET:= L; 53235000=08228000= + EMITO(BFW); 53240000=08228000= + IF ELCLASS ^= ASSIGNOP THEN 53245000=08229000= + BEGIN 53250000=08229000= + ERR(152); 53255000=08229000= + GO EXIT 53260000=08229000= + END; 53265000=08229000= + END; 53270000=08230000= + STEPIT; 53275000=08231000= + FORLIST(FALSE); 53280000=08231000= + L:= REGO; 53285000=08231000= +EXIT: 53290000=08232000= + K:= 0 53295000=08232000= + END FORSTMT; 53300000=08232000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%53305000=08232000= + PROCEDURE HANDLETHETAILENDOFAREADORSPACESTATEMENT; 53310000=08233000= + BEGIN 53315000=08234000= + COMMENT THIS ROUTINE CHECK FOR ACTION LABELS IN READ AND 53320000=08234000= + SPACE STATEMENTS AND GENERATES THE APPROPRIATE CODE; 53325000=08235000= + LABEL 53330000=08236000= + PASSPARLABL; 53335000=08236000= + COMMENT WHEN I REACH THIS LABEL A 53340000=08236000= + COLON HAS JUST BEEN DETECTED; 53345000=08237000= + LABEL 53350000=08238000= + EXIT; 53355000=08238000= + COMMENT THE LABEL EXIT APPEARS AFTER THE LAST53360000=08238000= + EXECUTABLE STATEMENT IN THIS ROUTINE; 53365000=08239000= + IF STEPI = LFTBRKET THEN 53370000=08241000= + BEGIN 53375000=08241000= + COMMENT THIS CODE HANDLES PARITY AND END OF 53380000=08241000= + FILE LABELS; 53385000=08242000= + IF STEPI ^= COLON THEN 53390000=08243000= + DEXP 53395000=08243000= + ELSE 53400000=08243000= + EMIT(0); 53405000=08243000= + IF ELCLASS ^= COLON THEN 53410000=08244000= + EMIT(0) 53415000=08244000= + ELSE 53420000=08244000= + BEGIN 53425000=08245000= + STEPIT; 53430000=08245000= + DEXP 53435000=08245000= + END; 53440000=08245000= + IF CHECK(RTBRKET, 433) THEN 53445000=08278000= + GO TO EXIT; 53450000=08278000= + COMMENT ERROR 433 MEANS MISSING RIGHT BRACKET 53455000=08279000= + IN READ OR SPACE STATEMENT; 53460000=08280000= + STEPIT; 53465000=08281000= + END 53470000=08283000= + ELSE 53475000=08283000= + BEGIN 53480000=08283000= + COMMENT THERE ARE NOT ANY ACTION LABELS IN THIS53485000=08283000= + CASE; 53490000=08284000= + EMITL(0); 53495000=08285000= + EMITL(0); 53500000=08285000= + END; 53505000=08286000= + IF GOGOGO THEN 53510000=08287000= + BEGIN 53515000=08287000= + EMIT(0); 53520000=08287000= + EMIT(0); 53525000=08287000= + EMIT(0); 53530000=08287000= + EMITV(13) 53535000=08287200= + END 53540000=08287200= + ELSE 53545000=08287200= + EMITV(GNAT(INTERPTI)); 53550000=08287200= + GOGOGO:= FALSE; % 53555000=08287300= +EXIT: 53560000=08288000= + ; 53565000=08288000= + END HANDLETHETAILENDORAREADORSPACESTATEMENT; 53570000=08289000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%53575000=08289000= + DEFINE 53580000=08289010= + EMITNO(EMITNO1) = 53585000=08289010= + BEGIN 53590000=08289010= + EMITL(0); 53595000=08289010= + EMITL(EMITNO1) 53600000=08289010= + END #, 53605000=08289020= + EMITTIME = BEGIN 53610000=08289020= + EMITN(2); 53615000=08289020= + EMITO(259); 53620000=08289020= + AEXP; 53625000=08289020= + EMITPAIR(JUNK, ISN); 53630000=08289030= + EMITO(965) 53635000=08289030= + END #; 53640000=08289030= + PROCEDURE READSTMT; 53645000=08290000= + BEGIN 53650000=08291000= + COMMENT READSTMT GENERATES CODE TO CALL INTERPTI)WHICH IS53655000=08291000= + SHORT FOR INTERPRET INPUT) AN INTRINSIC PROCEDURE ON THE 53660000=08292000= + DRUM, PASSING TO IT PARAMETERS DETERMINED BY THE FORMAT OF53665000=08293000= + THE READ OR SPACE STATEMENT. 53670000=08294000= + THE SPACE STATEMENT IS HANDLED AS A SPECIAL CASE OF READ53675000=08295000= + STATEMENT WHERE ZERO WORDS ARE READ IN A FORWARD OR 53680000=08296000= + REVERSE DIRECTION DEPENDING ON THE SIGN OF THE ARITHMETIC 53685000=08297000= + EXPRESSION IN THE SPACE STATEMENT. 53690000=08298000= + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 53695000=08299000= + READSTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH 53700000=08300000= + ARE PASSED TO INTERPTI. 53705000=08301000= + **********************************************************53710000=08302000= + ::=REVERSE/ 53715000=08303000= + ::=/ 53720000=08304000= + ::=[NO]/ 53725000=08305000= + ::=[:]/ 53730000=08306000= + []/[:]/53735000=08307000= + 53740000=08308000= + CIMI IS THE CHARACTER MODE INPUT EDITING ROUTINE. 53745000=08309000= + POWERSOFTEN IS A TABLE OF POWERS OF TEN USED FOR 53750000=08310000= + CONVERSION. 53755000=08311000= + FILE IS A DATA DESCRIPTOR DESCRIBING THE I/O DESCRIPTOR. 53760000=08312000= + ACTION TYPE IS A FOUR VALUED PARAMETER. IT MAY BE + OR-, 53765000=08313000= + 1 OR 2. THE SIGN OF THE VALUE INDICATES FORWARD OR 53770000=08314000= + REVERSE DIRECTION FOR + AND - RESPECTIVELY. THE 53775000=08315000= + VALUE IS ONE MORE THAN THE NUMBER OF RECORDS TO BE 53780000=08316000= + PROCESSED. 53785000=08317000= + END OF FILE LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL53790000=08318000= + DESCRIPTOR FOR THE END OF FILE JUMPS. 53795000=08319000= + PARITY LABEL IS A DATA DESCRIPTOR POINTING TO A LABEL 53800000=08320000= + DESCRIPTOR FOR PARITY CONDITION JUMPS. 53805000=08321000= + + OR - N IS SIMILAR TO ACTION TYPE. IT CONTAINS THE EXACT53810000=08322000= + DISTANCE AND DIRECTION TO SPACE RATHER THAN ONE53815000=08323000= + GREATER THAN THE NUMBER OF RECORDS TO BE SPACED AS53820000=08324000= + IN ACTION TYPE. 53825000=08325000= + LIST ROUTINE DESCRIPTOR IS AN ACCIDENTAL ENTRY PROGRAM 53830000=08326000= + DESCRIPTRO WHICH WILL EITHER RETURN53835000=08327000= + AN ADDRESS OR VALUE DEPENDING ON 53840000=08328000= + THE CALL. 53845000=08329000= + N IS THE VALUE OF THE ARITHMETIC EXPRESSION IN READ STMT. 53850000=08330000= + READ() 53855000=08331000= + 53860000=08332000= + - - - - - - - - - - - - - - 53865000=08333000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,0,END OF FILE LABEL53870000=08334000= + ,PARITY LABEL) 53875000=08335000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 53880000=08336000= + READ(, 53885000=08337000= + ) 53890000=08338000= + - - - - - - - - - - - - - - 53895000=08339000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 53900000=08340000= + ARRAY DESCRIPTOR,0,END OF FILE LABEL,PARITY LABEL) 53905000=08341000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 53910000=08342000= + SPACE(,) 53915000=08343000= + - - - - - - - - - - - - - - 53920000=08344000= + (CIMI,POWERSOFTEN,FILE,+ OR - N,0,0,1,END OF FILE LABEL, 53925000=08345000= + PARITY LABEL) 53930000=08346000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 53935000=08347000= + READ(, 53940000=08348000= + ,) 53945000=08349000= + - - - - - - - - - - - - - - 53950000=08350000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,FORMAT INDEX,FORMAT 53955000=08351000= + ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR,END OF FILE 53960000=08352000= + LABEL,PARITY LABEL) 53965000=08353000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 53970000=08354000= + READ(, 53975000=08355000= + *,) 53980000=08356000= + - - - - - - - - - - - - - - 53985000=08357000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,0,LIST ROUTINE 53990000=08358000= + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 53995000=08359000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 54000000=08360000= + READ(, 54005000=08361000= + ,) 54015000=08363000= + - - - - - - - - - - - - - - 54020000=08364000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,0,N,ROW DESCRIPTOR, 54025000=08365000= + END OF FILE LABEL,PARITY LABEL) 54030000=08366000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 54035000=08367000= + READ(, 54040000=08368000= + ,) 54045000=08369000= + - - - - - - - - - - - - - - 54050000=08370000= + (CIMI,POWERSOFTEN,FILE,ACTION TYPE,1,0,LIST ROUTINE 54055000=08371000= + DESCRIPTOR,END OF FILE LABEL,PARITY LABEL) 54060000=08372000= + *********************************************************;54065000=08373000= + DEFINE 54070000=08374000= + REVERSETOG = RRB1 #; 54075000=08374000= + COMMENT REVERSETOG IS SET TRUE54080000=08374000= + IF THE STATEMENT BEING COMPILED54085000=08375000= + IS A READ REVERSE, OTHERWISE IT54090000=08376000= + IS SET FALSE; 54095000=08377000= + LABEL 54100000=08378000= + EXIT; 54105000=08378000= + COMMENT EXIT APPEARS AFTER THE LAST 54110000=08378000= + EXECUTABLE STATEMENT IN READSTMT; 54115000=08379000= + LABEL 54120000=08380000= + CHKACTIONLABELS; 54125000=08380000= + COMMENT THE CODE AT THIS LABEL 54130000=08380000= + ASSUMES I IS POINTING AT THE RIGHT 54135000=08381000= + PARENTHESIS; 54140000=08382000= + LABEL 54145000=08383000= + PASSLIST; 54150000=08383000= + COMMENT THE CODE AT PASSLIST EXPECTS I TO54155000=08383000= + BE POINTING AT THE LAST QUANTITY IN THE 54160000=08384000= + SECOND PARAMETER; 54165000=08385000= + LABEL 54170000=08385100= + READXFORM; 54175000=08385100= + INTEGER 54180000=08385500= + LISTADDRESS; 54185000=08385500= + COMMENT TEMP TO HOLD LIST ADD DESC; 54190000=08385500= + BOOLEAN 54195000=08385600= + SEEKTOG, 54200000=08385600= + LOCKTOG, 54205000=08385600= + GRABTOG; % 54210000=08385600= + BOOLEAN 54215000=08385700= + MAYI; 54220000=08385700= + COMMENT TRUE IF "FILE" IS ARRAY ROW; 54225000=08385700= + INTEGER 54230000=08385800= + HOLD; 54235000=08385800= + COMMENT L MAY GET CUT BACK TO HERE; 54240000=08385800= + IF STEPI = LEFTPAREN THEN 54245000=08387000= + REVERSETOG:= SEEKTOG:= FALSE; 54250000=08387000= + ELSE 54255000=08388000= + BEGIN 54260000=08388000= + COMMENT THIS HAD BETTER SAY REVERSE; 54265000=08388000= + REVERSETOG:= ACCUM[1] = 6"7REVER"; 54270000=08389000= + LOCKTOG:= ELCLASS = LOCKV; 54275000=08390000= + SEEKTOG:= ACCUM[1] = 6"4SEEK0"; 54280000=08390500= + IF REVERSETOG OR LOCKTOG OR SEEKTOG THEN 54285000=08391000= + STEPIT 54290000=08392000= + ELSE 54295000=08392000= + BEGIN 54300000=08392000= + ERR(420); 54305000=08392000= + GO TO EXIT; 54310000=08393000= + END; 54315000=08394000= + IF CHECK(LEFTPAREN, 421);; 54320000=08395000= + GO TO EXIT; 54325000=08396000= + COMMENT ERROR 421 MEANS MISSING LEFT 54330000=08397000= + PARENTHESIS IN READ REVERSE STATEMENT; 54335000=08398000= + END; 54340000=08399000= + EMITO(MKS); 54345000=08400000= + IF STEPI >= BOOARRAYID AND ELCLASS <= INTARRAYID THEN 54350000=08401000= + BEGIN 54355000=08401020= + VARIABLE(FL); 54360000=08401020= + IF TABLE(I-2) ^= FACTOP THEN 54365000=08401030= + BEGIN 54370000=08401040= + ERR(422); 54375000=08401040= + GO TO EXIT 54380000=08401040= + END; 54385000=08401040= + WAYI:= TRUE; 54390000=08401045= + HOLD:= L; 54395000=08401045= + EMIT(11); 54400000=08401050= + EMIT(4); 54405000=08401050= + EMITO(280); 54410000=08401050= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 54415000=08401060= + EMITO(XCH); 54420000=08401070= + EMITL(0); 54425000=08401070= + EMITL(1); 54430000=08401070= + END 54435000=08401090= + ELSE 54440000=08401090= + BEGIN 54445000=08401090= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 54450000=08402000= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 54455000=08404000= + BEGIN 54460000=08404000= + COMMENT ERROR 422 MEANS MISSING FILE IN READ 54465000=08404000= + STATEMENT; 54470000=08405000= + ERR(422); 54475000=08406000= + GO TO EXIT; 54480000=08406000= + END; 54485000=08407000= + PASSFILE; 54490000=08408000= + IF ELCLASS = LFTBRKET THEN 54495000=08410000= + BEGIN %%% COMPILES CODE FOR [NS],[NS,*],[NS,], 54500000=08410000= + %%% [*],[*,*],[*,],[],[,*], 54505000=08410010= + %%% AND [,]. THE FIRST (LEFTMOST) 54510000=08410020= + %%% IS THE READSEEKDISTADDRESS, RESIDING 54515000=08410030= + %%% IN THE C-FIELD OF THE DSKADDR. THE SECOND 54520000=08411000= + %%% IS THE WAIT-TIME, RESIDING IN THE 54525000=08411010= + %%% F-FIELD OF THE DSKADDR, AND ALSO TURNING-ON 54530000=08411020= + %%% THE EXP-SIGN BIT OF DSKADDR,X"S ARE EMPTIES 54535000=08411030= + %%% IN THE ABOVE, NS = NO OR STOP. 54540000=08411040= + STEPIT; %%% STEP OVER [, AND POINT AT NEXT ITEM. 54545000=08412000= + IF RR1:= 54550000=08412010= + IF ACCUM[1] = 6"2NO000" THEN 54555000=08412010= + 1 54560000=08412010= + ELSE 54565000=08412010= + IF ACCUM[1] = 6"4STOP0" THEN 54570000=08412020= + 2 54575000=08412020= + ELSE 54580000=08412020= + 0 ^= 0 54585000=08412030= + THEN %%% HAVE [NS 54590000=08412030= + IF STEPI = COMMA THEN %%% HAVE [NS, 54595000=08412040= + IF STEPI = FACTOP THEN %%% HAVE [NS,* 54600000=08412050= + BEGIN 54605000=08412060= + IF RR1 = 1 THEN 54610000=08412070= + EMITNO(1) 54615000=08412080= + ELSE 54620000=08412080= + BEGIN 54625000=08412080= + EMITL(1); 54630000=08412080= + EMITL(2) 54635000=08412080= + END; 54640000=08412080= + STEPIT; 54645000=08412090= + END 54650000=08413012= + ELSE 54655000=08413012= + IF ACCUM[1] = 6"4LOCK0" THEN 54660000=08413012= + BEGIN %%% [NS,LOCK 54665000=08413014= + EMITL(1); 54670000=08413016= + EMITD(47, 4, 1); 54675000=08413016= + STEPIT; 54680000=08413018= + END 54685000=08413022= + ELSE 54690000=08413022= + BEGIN %%% HAVE [NS,AEXP 54695000=08413022= + IF RR1 = 2 THEN 54700000=08413030= + EMITL(1); 54705000=08413030= + EMITTIME; 54710000=08413040= + IF RR1 = 2 THEN 54715000=08413050= + BEGIN 54720000=08413060= + EMITO(LOR); 54725000=08413060= + EMITL(2) 54730000=08413060= + END 54735000=08413080= + ELSE 54740000=08413080= + EMITL(1); 54745000=08413080= + END 54750000=08413100= + ELSE 54755000=08413100= + IF RR1 = 1 THEN 54760000=08413100= + EMITNO(1) %%% ONLY HAVE [NS 54765000=08413100= + ELSE 54770000=08413110= + BEGIN 54775000=08413110= + EMITL(1); 54780000=08413110= + EMITL(2) 54785000=08413110= + END 54790000=08413120= + ELSE 54795000=08413120= + IF ELCLASS = FACTOP THEN %%% HAVE [* 54800000=08413120= + IF STEPI = COMMA THEN %%% HAVE [*, 54805000=08413130= + IF STEPI = FACTOP THEN %%% HAVE [*,* 54810000=08414000= + BEGIN 54815000=08414010= + EMITNO(2); 54820000=08414010= + STEPIT 54825000=08414010= + END 54830000=08414012= + ELSE 54835000=08414012= + IF ACCUM[1] = 6"4LOCK0" THEN 54840000=08414012= + BEGIN %%% [*,LOCK 54845000=08414014= + EMITL(1); 54850000=08414016= + EMITD(47, 4, 1); 54855000=08414016= + STEPIT; 54860000=08414018= + END 54865000=08414022= + ELSE 54870000=08414022= + BEGIN 54875000=08414022= + EMITTIME; 54880000=08414022= + EMITL(2); 54885000=08414022= + END % [*,A 54890000=08414022= + ELSE 54895000=08414030= + EMITNO(2) %%% HAVE ONLY [* 54900000=08414030= + ELSE 54905000=08415000= + BEGIN %%% HAVE [AEXP 54910000=08415000= + AEXP; 54915000=08415010= + EMITO(SSP); 54920000=08415010= + EMITL(1); 54925000=08415010= + EMITO(ADD); 54930000=08415010= + IF SEEKTOG THEN 54935000=08415020= + EMITO(CHS); 54940000=08415020= + EMITPAIR(JUNK, ISN); 54945000=08415030= + IF ELCLASS = COMMA THEN %%% HAVE [AEXP, 54950000=08416000= + IF STEPI = FACTOP THEN 54955000=08416010= + STEPIT %%%[AEXP,* 54960000=08416010= + ELSE 54965000=08416012= + IF ACCUM[1] = 6"4LOCK0" THEN 54970000=08416012= + BEGIN %%% [AEXP,LOCK 54975000=08416014= + EMITL(1); 54980000=08416016= + EMITD(47, 4, 1); 54985000=08416016= + STEPIT; 54990000=08416018= + END 54995000=08416022= + ELSE 55000000=08416022= + BEGIN 55005000=08416022= + EMITTIME; 55010000=08416022= + EMITO(LOR) 55015000=08416022= + END; 55020000=08416022= + EMITL(2); %%% ABOVE ELSE WAS [AEXP,AEXP 55025000=08416030= + END; 55030000=08417000= + IF CHECK(RTBRKET, 424) THEN 55035000=08417010= + GO EXIT 55040000=08417010= + ELSE 55045000=08417010= + STEPIT; 55050000=08417010= + END 55055000=08418100= + ELSE 55060000=08418100= + IF ELCLASS = LEFTPAREN THEN 55065000=08418100= + BEGIN 55070000=08418200= + STEPIT; 55075000=08418200= + AEXP; 55080000=08418200= + IF ELCLASS = COMMA THEN 55085000=08418200= + IF STEPI ^= FACTOP THEN % 55090000=08418250= + BEGIN 55095000=08418300= + AEXP; 55100000=08418300= + EMITPAIR(JUNK, ISN) 55105000=08418300= + END 55110000=08418300= + ELSE % 55115000=08418300= + BEGIN 55120000=08418350= + EMITL(1); 55125000=08418350= + GRABTOG:= TRUE; 55130000=08418350= + STEPIT 55135000=08418350= + END 55140000=08418400= + ELSE 55145000=08418400= + EMITPAIR(0, LNG); 55150000=08418400= + EMITD(33, 33, 15); 55155000=08418500= + EMITO(IF LOCKTOG THEN SSN ELSE SSP); 55160000=08418600= + EMITL(REAL(SEEKTOG)); 55165000=08418650= + EMITD(33, 18, 15); 55170000=08418650= + IF CHECK(RTPAREN, 104) THEN 55175000=08418700= + GO EXIT; 55180000=08418700= + EMITL(REAL(GRABTOG)+2); 55185000=08418800= + STEPIT; % 55190000=08418800= + END 55195000=08419000= + ELSE 55200000=08419000= + BEGIN 55205000=08419000= + EMITL(0); 55210000=08419000= + EMITL(2); 55215000=08419000= + END; 55220000=08419000= + IF REVERSETOG THEN 55225000=08421000= + EMITO(CHS); 55230000=08421000= + END; 55235000=08421500= + IF ELCLASS = RTPAREN THEN 55240000=08423000= + BEGIN 55245000=08423000= + COMMENT NO FORMAT,NO LIST CASE; 55250000=08423000= + EMITL(0); 55255000=08424000= + EMITL(0); 55260000=08424000= + EMITL(0); 55265000=08424000= + GOGOGO:= NOT MAYI; % 55270000=08424100= + GO CHKACTIONLABELS; 55275000=08425000= + END; 55280000=08426000= + IF CHECK(COMMA, 424) THEN 55285000=08428000= + GO TO EXIT; 55290000=08428000= + COMMENT ERROR 424 MEANS IMPROPER FILE DELIMITER IN READ 55295000=08429000= + STATEMENT; 55300000=08430000= + IF STEPI = FACTOP THEN 55305000=08432000= + BEGIN 55310000=08432000= + COMMENT *,LIST CASE; 55315000=08432000= + EMITL(0); 55320000=08433000= + EMITL(0); 55325000=08433000= + GO PASSLIST; 55330000=08433000= + END; 55335000=08434000= + IF ELCLASS = MULOP THEN 55340000=08436000= + BEGIN 55345000=08436000= + COMMENT FREE FIELD FORMAT CASE; 55350000=08436000= + IF STEPI = MULOP THEN 55355000=08437000= + EMITL(2) 55360000=08437000= + ELSE 55365000=08437000= + BEGIN 55370000=08437050= + EMITL(1); 55375000=08437050= + I:= I-1; 55380000=08437050= + END; 55385000=08437050= + EMITL(0); 55390000=08437075= + GO TO PASSLIST; 55395000=08437075= + END; 55400000=08438000= + IF RANGE(FRMTID, SUPERFRMTID) THEN 55405000=08440000= + BEGIN 55410000=08440000= + COMMENT THE SECOND PARAMETER IS A FORMAT; 55415000=08440000= + PASSFORMAT; 55420000=08441000= + READXFORM: 55425000=08442000= + IF TABLE(I+1) = COMMA THEN 55430000=08443000= + GO PASSLIST; 55435000=08443000= + STEPIT; 55440000=08444000= + IF CHECK(RTPAREN, 425) THEN 55445000=08446000= + GO TO EXIT; 55450000=08446000= + COMMENT ERROR 425 MEANS IMPROPER FORMAT 55455000=08447000= + DELIMITER IN READ STATEMENT; 55460000=08448000= + EMITL(0); 55465000=08449000= + GO CHKACTIONLABELS; 55470000=08449000= + END; 55475000=08450000= + IF Q:= ACCUM[1] = 6"1<0000" THEN 55480000=08450010= + BEGIN 55485000=08450020= + EXPLICITFORMAT; 55490000=08450020= + GO TO READXFORM; 55495000=08450020= + END; 55500000=08450020= + IF MAYI THEN 55505000=08450100= + BEGIN 55510000=08450200= + KLUDGE(HOLD); 55515000=08450200= + GO TO EXIT; 55520000=08450300= + END ARRAY TO ARRAY CASE; 55525000=08450400= + EMITL(0); 55530000=08451000= + AEXP; 55535000=08451000= + IF CHECK(COMMA, 426) THEN 55540000=08453000= + GO TO EXIT; 55545000=08453000= + COMMENT ERROR 426 MEANS IMPROPER DELIMITER FOR SECOND 55550000=08454000= + PARAMETER; 55555000=08455000= + STEPIT; 55560000=08456000= + IF RANGE(BOOARRAYID, INTARRAYID) THEN 55565000=08458000= + BEGIN 55570000=08458000= + COMMENT THIS IS THE ROW DESIGNATOR CASE; 55575000=08458000= + VARIABLE(FL); 55580000=08459000= + IF TABLE(I-2) ^= FACTOP THEN 55585000=08461000= + BEGIN 55590000=08461000= + COMMENT ERROR 427 MEANS IMPROPER 55595000=08461000= + ROW DESIGNATOR IN READ; 55600000=08462000= + ERROR(427); 55605000=08463000= + GO TO EXIT; 55610000=08463000= + END; 55615000=08464000= + IF CHECK(RTPAREN, 428) THEN 55620000=08466000= + GO TO EXIT; 55625000=08466000= + COMMENT ERROR 428 MEANS IMPROPER ROW DESIGNATOR55630000=08467000= + DELIMITER IN READ STATEMENT; 55635000=08468000= + GOGOGO:= TRUE; % 55640000=08468100= + GO CHKACTIONLABELS; 55645000=08469000= + END 55650000=08471000= + ELSE 55655000=08471000= + BEGIN 55660000=08471000= + COMMENT ERROR 429 MEANS MISSING ROW DESIGNATOR;55665000=08471000= + ERROR(429); 55670000=08472000= + GO TO EXIT; 55675000=08472000= + END; 55680000=08473000= +PASSLIST: 55685000=08474000= + STEPIT; 55690000=08474000= + IF CHECK(COMMA, 430) THEN 55695000=08476000= + GO TO EXIT; 55700000=08476000= + COMMENT ERROR 430 MEANS IMPROPER DELIMITER PRECEEDING 55705000=08477000= + THE LIST IN A READ STATEMENT; 55710000=08478000= + IF STEPI ^= LISTID AND ELCLASS ^= SUPERLISTID THEN 55715000=08480000= + BEGIN 55720000=08480000= + RR1:= LISTGEN; 55725000=08481000= + I:= I-1; 55730000=08482000= + GO TO CHKACTIONLABELS 55735000=08484000= + END; 55740000=08484000= + CHECKER(ELBAT[I]); 55745000=08484500= + IF ELCLASS = SUPERLISTID THEN 55750000=08485000= + BEGIN 55755000=08486000= + COMMENT SUBSCRIPTED SWITCH LIST ID; 55760000=08486000= + LISTADDRESS:= ELBAT[I].ADDRESS; 55765000=08488000= + BANA; 55770000=08489000= + EMITV(LISTADDRESS); 55775000=08489500= + IF LISTADDRESS > 1023 THEN 55780000=08489510= + EMITO(PRTE); 55785000=08489510= + EMITO(LOD); 55790000=08489520= + I:= I-1 55795000=08489520= + END 55800000=08489530= + ELSE 55805000=08489530= + BEGIN 55810000=08489530= + COMMENT A COMMON LIST; 55815000=08489530= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 55820000=08489550= + END; 55825000=08489560= + STEPIT; 55830000=08489570= + IF CHECK(RTPAREN, 449) THEN 55835000=08489580= + GO TO EXIT; 55840000=08489580= + COMMENT 449 IS IMPROPER LIST DELIMETER IN READ STATEMENT; 55845000=08489590= +CHKACTIONLABELS: 55850000=08491000= + HANDLETHETAILENDOFAREADORSPACESTATEMENT; 55855000=08491000= +EXIT: 55860000=08492000= + ; 55865000=08492000= + END READSTMT; 55870000=08493000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55875000=08493000= + REAL PROCEDURE FILEATTRIBUTEINDX(T);% RETURNS A ZERO IF THE NEXTSCANND55880000=08493010= + VALUE 55885000=08493015= + T; 55890000=08493015= + BOOLEAN 55895000=08493015= + T; % ITEM IS NOT A FILE ATTRIBUTE. 55900000=08493015= + BEGIN % RETURNS THE ASSOCIATED INDEX IF 55905000=08493020= + REAL 55910000=08493030= + I; % IT IS A FILE ATTRIBUTE. 55915000=08493030= + LABEL 55920000=08493040= + EXIT; 55925000=08493040= + STOPDEFINE:= T;% MAY DISALLOW DEFINES IN FILE-ATTRIBUTE PART. 55930000=08493050= + STEPIT; % NOW POINTED AT ATTRIBUTE (STEPIT TURNS OFF STOP DEFINE). 55935000=08493060= + IF I:= FILEATTRIBUTES[0] = 0 THEN 55940000=08493070= + BEGIN 55945000=08493080= + FILL FILEATTRIBUTES[*] WITH % NON-ASSGNBL ATTRBTS HAVE .[1:1]=155950000=08493090= + % BOOLEAN ATTRIBUTES HAVE .[2:1]=1,55955000=08493091= + % ALPHA ATTRIBUTES HAVE .[3:1]=1. 55960000=08493092= + % THIS NEXT NUMBER IS THE CURRENT # OF FILE ATTRIBUTES: 55965000=08493093= + 17 55970000=08493094= + ,"6ACCES"%***ANY ADDITIONAL ATTRIBUTES MUST BE INSERTED***55975000=08493095= + ,"5MYUSE"%******IMMEDIATELY AFTER THE LAST ATTRIBUTE******55980000=08493096= + ,"4SAVE0" 55985000=08493097= + ,"8OTHER" % "OTHERUSE". 55990000=08493098= + ,"404MFID0" 55995000=08493099= + ,"403FID00" 56000000=08493100= + ,"4REEL0" 56005000=08493101= + ,"4DATE0" 56010000=08493102= + ,"5CYCLE" 56015000=08493103= + ,"4TYPE0" 56020000=08493104= + ,"5AREAS" 56025000=08493105= + ,"8AREAS" % "AREASIZE". 56030000=08493106= + ,"2EU000" 56035000=08493107= + ,"5SPEED" 56040000=08493108= + ,"9TIMEL" % "TIMELIMIT" 56045000=08493109= + ,"+08IOSTA" % "IOSTATUS" 56050000=08493110= + ,"9SENSI" % "SENSITIVE" 56055000=08493111= + % THIS CARD MERELY OCCUPIES A SEQUENCE NUMBER. 56060000=08493120= + ; % END OF FILL STATEMENT. 56065000=08493130= + I:= FILEATTRIBUTES[0]; 56070000=08493140= + END; 56075000=08493150= + FOR I:= I STEP-1 UNTIL 1 DO 56080000=08493160= + IF FILEATTRIBUTES[I].[12:36] = Q THEN 56085000=08493160= + BEGIN 56090000=08493170= + FILEATTRIBUTEINDX:= I; 56095000=08493170= + GO EXIT 56100000=08493170= + END; 56105000=08493170= +EXIT: 56110000=08493190= + END OF FILEATTRIBUTEINDX; 56115000=08493190= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%56120000=08493190= + 56125000=08493200= +COMMENT FILEATTRIBUTEHANDLER HANDLES FILE ATTRIBUTE STUFF. IT CONSTRUCTS56130000=08493200= + A CALL ON FILEATTRIBUTES INTRINSIC.IT IS CALLED BY 5 PROCEDURES:56135000=08493210= + 1. STMT: PASSES N=FS, AND TELLS FAH TO EXPECT AN ASSIGNOP. 56140000=08493220= + FAH WILL TELL FILEATTRIBUTES TO CHANGE THE ATTRIBUTE56145000=08493230= + AND XIT. 56150000=08493240= + 2. ACTUALPARAPART: 56155000=08493250= + PASSES N=FA, AND TELLS FAH THAT THE FILE DESC HAS 56160000=08493260= + ALREADY BEEN EMITTED. IT ALSO TELLS FAH TO LEAVE 56165000=08493270= + THE VALUE OF THE ATTRIBUTE IN THE TOP OF THE STACK. 56170000=08493280= + 3. PRIMARY: 56175000=08493290= + PASSES N=FP, AND TELLS FAH TO HANDLE AN ASSIGNOP 56180000=08493300= + IF THERE IS ONE (BY CALLING AEXP OR BEXP, DEPENDING 56185000=08493310= + ON THE TYPE OF ATTRIBUTE) OR JUST TO EMIT A ZERO. IF56190000=08493320= + THERE IS AN ASSIGNOP, THEN FAH TELLS FILEATTRIBUTES 56195000=08493330= + TO BOTH CHANGE THE ATTRIBUTE AND LEAVE THE VALUE 56200000=08493340= + IN THE TOP OF THE STACK. OTHERWISE, FAH TELLS FILE- 56205000=08493350= + ATTRIBUTES TO ONLY LEAVE THE VALUE OF THE REQUIRED 56210000=08493360= + ATTRIBUTE IN THE TOP OF THE STACK. IN ALL CASES, 56215000=08493370= + FAH WILL RETURN THE TYPE OF ATTRIBUTE COMPILED 56220000=08493380= + (ATYPE OR BTYPE). 56225000=08493390= + 4. BOOPRIM: 56230000=08493400= + PASSES N=FP, AND DOES THE SAME AS #3 (ABOVE). 56235000=08493410= + 5. IODEC: 56240000=08493420= + PASSES N=FIO, AND TELLS FAH THAT A MKS & FILE DESC 56245000=08493430= + HAVE ALREADY BEEN EMITTED, THE ATTRIBUTEINDX IS 56250000=08493440= + DETERMINED BY IODEC, AND IS PASSED VIA GT1. 56255000=08493450= +END OF COMMENT ; 56260000=08493460= + INTEGER PROCEDURE FILEATTRIBUTEHANDLER(N); 56265000=08493470= + VALUE 56270000=08493470= + N; 56275000=08493470= + REAL 56280000=08493470= + N; 56285000=08493470= + BEGIN 56290000=08493480= + REAL 56295000=08493490= + ATTRIBUTEINDX; 56300000=08493490= + BOOLEAN 56305000=08493500= + ASSOP; 56310000=08493500= + LABEL 56315000=08493510= + DONESOME, 56320000=08493510= + DONEMORE, 56325000=08493510= + EXIT; 56330000=08493510= + IF N = FA THEN 56335000=08493520= + GO TO DONESOME 56340000=08493520= + ELSE 56345000=08493520= + IF N = FIO THEN 56350000=08493520= + BEGIN 56355000=08493530= + ATTRIBUTEINDX:= GT1; 56360000=08493530= + IF STEPI ^= RELOP THEN 56365000=08493530= + I:= I-1; 56370000=08493530= + ASSOP:= TRUE; 56375000=08493530= + EMITL(0); 56380000=08493540= + EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTR USE.56385000=08493540= + GO TO DONEMORE; 56390000=08493550= + END; 56395000=08493560= + EMITO(MKS); 56400000=08493570= + PASSFILE; % MARK THE STACK & STACK A FILE DESCRIPTOR. 56405000=08493570= + IF ELCLASS ^= PERIOD THEN 56410000=08493580= + ERR(290) 56415000=08493580= + ELSE 56420000=08493580= + BEGIN 56425000=08493590= + DONESOME: 56430000=08493610= + IF ATTRIBUTEINDX:= FILEATTRIBUTEINDX(TRUE) = 0 THEN 56435000=08493610= + ERR(291) 56440000=08493610= + ELSE 56445000=08493610= + BEGIN 56450000=08493620= + STEPIT; 56455000=08493625= + IF FALSE THEN 56460000=08493625= + BEGIN 56465000=08493625= + COMMENT$$DELETE THIS CARD TO GET ACTION LABEL56470000=08493625= + IF STEPI=LFTBRKET THEN 56475000=08493630= + BEGIN 56480000=08493640= + STEPIT; 56485000=08493650= + DEXP; 56490000=08493650= + IF CHECK(RTBRKET, 433) THEN 56495000=08493650= + GO EXIT; 56500000=08493650= + STEPIT; 56505000=08493650= + END 56510000=08493670= + ELSE 56515000=08493670= + EMITL(0); 56520000=08493670= + EMITL(0); %%% DUM1 PARAMETER...FOR POSSIBLE FUTURE USE. 56525000=08493675= + IF ASSOP:= ELCLASS = ASSIGNOP THEN 56530000=08493680= + BEGIN 56535000=08493700= + IF N ^= FS THEN 56540000=08493705= + FLAG(295); %**DELETE THIS CARD TO ALLOW GENRL FILATT ASSGNMT56545000=08493705= + DONEMORE: 56550000=08493710= + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[1:1]) THEN 56555000=08493720= + FLAG(293); 56560000=08493720= + STEPIT; 56565000=08493730= + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) THEN 56570000=08493750= + BEXP 56575000=08493750= + ELSE 56580000=08493750= + AEXP; 56585000=08493750= + END 56590000=08493770= + ELSE 56595000=08493770= + IF N = FS THEN 56600000=08493770= + BEGIN 56605000=08493770= + ERR(292); 56610000=08493770= + GO EXIT 56615000=08493770= + END 56620000=08493780= + ELSE 56625000=08493780= + EMITL(0); 56630000=08493780= + EMITNUM(IF ATTRIBUTEINDX = 1 THEN 6"6ACCESS" ELSE IF 56635000=08493830= + ATTRIBUTEINDX = 4 THEN 6"6OTHRUS" ELSE IF ATTRIBUTEINDX = 12 56640000=08493830= + THEN 6"6ARASIZ" ELSE IF ATTRIBUTEINDX = 15 THEN 6"6TIMLMT" 56645000=08493830= + ELSE IF ATTRIBUTEINDX = 16 THEN 6"6IOSTAT" ELSE IF 56650000=08493830= + ATTRIBUTEINDX = 17 THEN 6"6SNSTIV" ELSE 0 & 56655000=08493830= + FILEATTRIBUTES[ATTRIBUTEINDX][6:12:36] & 56660000=08493830= + FILEATTRIBUTES[ATTRIBUTEINDX][1:3:1]); 56665000=08493830= + EMITL((ATTRIBUTEINDX-1) & REAL(N = FP OR N = FA)[39:47:1] & 56670000=08493850= + REAL(ASSOP)[38:47:1]); 56675000=08493850= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 56680000=08493860= + EMITV(GNAT(FILATTINT)); 56685000=08493860= + FILEATTRIBUTEHANDLER:= 56690000=08493880= + IF BOOLEAN(FILEATTRIBUTES[ATTRIBUTEINDX].[2:1]) THEN 56695000=08493890= + BTYPE 56700000=08493890= + ELSE 56705000=08493890= + ATYPE; 56710000=08493890= + END; 56715000=08493900= + END; 56720000=08493910= +EXIT: 56725000=08493930= + END OF FILEATTRIBUTEHANDLER; 56730000=08493930= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%56735000=08493930= + PROCEDURE SPACESTMT; 56740000=08494000= + BEGIN 56745000=08495000= + COMMENT THE SPACE STATEMENT IS BEST THOUGHT OF AS A 56750000=08495000= + SUBSET OF THE READ STATEMENT WHERE ZERO WORDS ARE READ. 56755000=08496000= + FOR THE EXACT SYNTAX FOR THE SPACE STATEMENT AND THE 56760000=08497000= + PARAMETERS PASSED TO THE INTERPTI ROUTINE SEE THE COMMENTS56765000=08498000= + FOR THE READ STATEMENT; 56770000=08499000= + LABEL 56775000=08500000= + EXIT; 56780000=08500000= + COMMENT EXIT APPEARS AFTER THE LAST 56785000=08500000= + EXECUTABLE STATEMENT IN SPACESTMT; 56790000=08501000= + STEPIT; 56795000=08502000= + IF CHECK(LEFTPAREN, 434) THEN 56800000=08504000= + GO TO EXIT; 56805000=08504000= + COMMENT ERROR 434 MEANS MISSING LEFT PARENTHESIS IN 56810000=08505000= + SPACE STATEMENT; 56815000=08506000= + STEPIT; 56820000=08507000= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 56825000=08509000= + BEGIN 56830000=08509000= + COMMENT ERROR 435 MEANS IMPROPER FILE 56835000=08509000= + IDENTIFIER IN SPACE STATEMENT; 56840000=08510000= + ERROR(435); 56845000=08511000= + GO TO EXIT; 56850000=08511000= + END; 56855000=08512000= + EMITO(MKS); 56860000=08513000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 56865000=08515000= + PASSFILE; 56870000=08515000= + EMITL(0); 56875000=08515100= + IF CHECK(COMMA, 436) THEN 56880000=08517000= + GO TO EXIT; 56885000=08517000= + COMMENT ERROR 436 MEANS MISSING COMMA IN SPACE STATEMENT;56890000=08518000= + STEPIT; 56895000=08519000= + AEXP; 56900000=08519000= + IF CHECK(RTPAREN, 437) THEN 56905000=08521000= + GO TO EXIT; 56910000=08521000= + COMMENT ERROR 437 MEANS MISSING RIGHT PARENTHESIS IN 56915000=08522000= + SPACE STATEMENT; 56920000=08523000= + EMITL(0); 56925000=08524000= + EMITL(0); 56930000=08524000= + EMITL(1); 56935000=08524000= + HANDLETHETAILENDOFAREADORSPACESTATEMENT; 56940000=08525000= +EXIT: 56945000=08526000= + ; 56950000=08526000= + END SPACESTMT; 56955000=08527000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%56960000=08527000= + PROCEDURE WRITESTMT; 56965000=08528000= + BEGIN 56970000=08529000= + COMMENT WRITESTMT GENERATES CODE TO CALL INTERPTO, AN 56975000=08529000= + INTRINSIC PROCEDURE ON THE DRUM, PASSING TO IT PARAMETERS 56980000=08530000= + DETERMINED BY THE FORMAT OF THE WRITE STATEMENT. 56985000=08531000= + I HAVE LISTED BELOW THE VARIOUS CASES CONSIDERED BY THE 56990000=08532000= + WRITESTMT PROCEDURE AND THE CORRESPONDING PARAMETERS WHICH56995000=08533000= + ARE PASSED TO INTERPTO. 57000000=08534000= + **********************************************************57005000=08535000= + FOR AN EXPLANATION OF THE PARAMETERS AND SYNTACTICAL 57010000=08536000= + UNITS NOT DESCRIBED HERE, SEE THE COMMENTS FOR THE 57015000=08537000= + READSTMT ROUTINE. 57020000=08538000= + ::= [DBL]/[PAGE]/[NO]// 57030000=08540000= + CHARI IS THE CHARACTER MODE OUTPUT EDITING ROUTINE SIMILAR57035000=08541000= + TO CIMI FOR INPUT. 57040000=08542000= + [DBL] [PAGE] [NO] 57045000=08543000= + CHANNEL SKIP 0 0 0 0 EXPRESSIONS VALUE 57050000=08544000= + LINESKIP 1 2 4 8 0 57055000=08545000= + WRITE()/ 57060000=08546000= + - - - - - - - - - - - - - - 57065000=08547000= + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,0) 57070000=08548000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 57075000=08549000= + WRITE(,)/ 57080000=08550000= + - - - - - - - - - - - - - - 57085000=08551000= + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 57090000=08552000= + INDEX,FORMAT ARRAY DESCRIPTOR,0) 57095000=08553000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 57100000=08554000= + WRITE(,,)/57105000=08555000= + - - - - - - - - - - - - - - 57110000=08556000= + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,FORMAT 57115000=08557000= + INDEX,FORMAT ARRAY DESCRIPTOR,LIST ROUTINE DESCRIPTOR) 57120000=08558000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 57125000=08559000= + WRITE(,*,)/ 57130000=08560000= + - - - - - - - - - - - - - - 57135000=08561000= + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,0,LIST 57140000=08562000= + ROUTINE DESCRIPTOR) 57145000=08563000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 57150000=08564000= + WRITE((CARRIAGE CONTROL>,,) 57160000=08566000= + - - - - - - - - - - - - - - 57165000=08567000= + (CHARI,POWERSOFTEN,FILE,CHANNEL SKIP,LINE SKIP,0,N,ARRAY 57170000=08568000= + ROW DESCRIPTOR) 57175000=08569000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 57180000=08570000= + LABEL EXIT; 57185000=08571000= + COMMENT EXIT APPEARS AFTER THE LAST 57190000=08571000= + EXECUTABLE STATEMENT IN WRITESTMT; 57195000=08572000= + LABEL 57200000=08573000= + CHKSECOND; 57205000=08573000= + COMMENT I IS NOW POINTING AT THE COMMA 57210000=08573000= + SEPARATING THE FIRST AND SECOND 57215000=08574000= + PARAMETERS; 57220000=08575000= + LABEL 57225000=08576000= + ONEPARENSH; 57230000=08576000= + COMMENT I IS POINT AT THE RIGHT 57235000=08576000= + PARENTHESIS AT THIS POINT AND I HAVE 57240000=08577000= + JUST DISCOVERED THAT THIS IS THE ONE 57245000=08578000= + PARAMETER CASE; 57250000=08579000= + DEFINE 57255000=08580000= + ACCUM1 = RR1 #; 57260000=08580000= + COMMENT ACCUM1 IS USED AS A 57265000=08580000= + TEMPORARY CELL FOR ACCUM[1]; 57270000=08581000= +%VOID 57275000=08582000= +%VOID 57280000=08583000= +%VOID 57285000=08584000= +%VOID 57290000=08585000= + LABEL 57295000=08586000= + PASSLIST; 57300000=08586000= + COMMENT I IS POINTING AT THE COMMA 57305000=08586000= + PRECEEDING THE LIST WHEN THIS LABEL IS 57310000=08587000= + REACHED; 57315000=08588000= + LABEL 57320000=08589000= + EMITCALL; 57325000=08589000= + COMMENT I IS POINTING AT THE STATEMENT 57330000=08589000= + DELIMITER. THE CODE AT EMITCALL EMITS THE57335000=08590000= + CODE TO CALL INTERPTO; 57340000=08591000= + LABEL 57345000=08591100= + CHKRTPAREN; 57350000=08591100= + LABEL 57355000=08591200= + WRITXFORM; 57360000=08591200= + INTEGER 57365000=08591500= + LISTADDRESS; 57370000=08591500= + COMMENT TEMP TO HOLD LIST ADD DESC; 57375000=08591500= + BOOLEAN 57380000=08591600= + LOCKTOG, 57385000=08591600= + ARC; 57390000=08591600= + INTEGER 57395000=08591700= + HOLD; % 57400000=08591700= + IF(LOCKTOG:= STEPI = LOCKV) THEN 57405000=08592000= + STEPIT; 57410000=08592000= + IF CHECK(LEFTPAREN, 438) THEN 57415000=08594000= + GO TO EXIT; 57420000=08594000= + COMMENT ERROR 438 MEANS MISSING LEFT PARENTHESIS IN A 57425000=08595000= + WRITE STATEMENT; 57430000=08596000= + EMITO(MKS); 57435000=08597000= + IF STEPI >= BOOARRAYID AND ELCLASS <= INTARRAYID THEN 57440000=08597100= + BEGIN 57445000=08597200= + VARIABLE(FL); 57450000=08597200= + IF TABLE(I-2) ^= FACTOP THEN 57455000=08597300= + BEGIN 57460000=08597400= + ERR(439); 57465000=08597400= + GO TO EXIT 57470000=08597400= + END; 57475000=08597400= + ARC:= TRUE; 57480000=08597450= + HOLD:= L; 57485000=08597450= + EMIT(11); 57490000=08597500= + EMIT(4); 57495000=08597500= + EMITO(280); 57500000=08597500= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 57505000=08597600= + EMITO(XCH); 57510000=08597700= + END 57515000=08597900= + ELSE 57520000=08597900= + BEGIN 57525000=08597900= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 57530000=08599000= + BEGIN 57535000=08599000= + COMMENT ERROR 439 MEANS IMPROPER FILE 57540000=08599000= + IDENTIFIER IN A WRITE STATEMENT; 57545000=08600000= + ERR(439); 57550000=08601000= + GO TO EXIT; 57555000=08601000= + END; 57560000=08602000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 57565000=08605000= + PASSFILE; 57570000=08605000= + END; 57575000=08605500= + IF (RRB1:= ELCLASS = COMMA) OR ELCLASS = RTPAREN THEN 57580000=08607000= + BEGIN 57585000=08607000= + COMMENT STANDARD CARRIAGE CONTROL CASE; 57590000=08607000= + EMITL(0); 57595000=08608000= + EMITL(1); 57600000=08608000= + IF RRB1 THEN 57605000=08610000= + GO CHKSECOND; 57610000=08610000= + ONEPARENSH: 57615000=08611000= + STEPIT; 57620000=08611000= + EMITL(0); 57625000=08611000= + EMITL(0); 57630000=08611000= + GOGOGO:= NOT ARC; % 57635000=08611100= + EMITL(0); 57640000=08612000= + GO EMITCALL; 57645000=08612000= + END; 57650000=08613000= + IF ELCLASS = LEFTPAREN THEN 57655000=08613100= + BEGIN 57660000=08613200= + STEPIT; 57665000=08613200= + AEXP; 57670000=08613200= + EMITO(IF LOCKTOG THEN SSN ELSE SSP); 57675000=08613200= + IF ELCLASS = COMMA THEN 57680000=08613300= + BEGIN 57685000=08613300= + STEPIT; 57690000=08613300= + AEXP 57695000=08613300= + END 57700000=08613400= + ELSE 57705000=08613400= + EMITPAIR(0, LNG); 57710000=08613400= + EMITD(33, 33, 15); 57715000=08613500= + EMIT(0); 57720000=08613500= + IF CHECK(RTPAREN, 104) THEN 57725000=08613600= + GO EXIT 57730000=08613600= + ELSE 57735000=08613600= + GO CHKRTPAREN 57740000=08613700= + END; 57745000=08613700= + IF CHECK(LFTBRKET, 440) THEN 57750000=08615000= + GO TO EXIT; 57755000=08615000= + COMMENT ERROR 440 MEANS IMPROPER DELIMITER FOR FIRST 57760000=08616000= + PARAMETER IN A WRITE STATEMENT; 57765000=08617000= + STEPIT; 57770000=08618000= + %%% THE FOLLOWING CODE COMPILES CODE FOR [DPN],[DPN,*], 57775000=08619000= + %%% [DPN,],[*],[*,*],[*,],[],[,*] 57780000=08619010= + %%% AND [,], WHERE DPN IN STOP, DBL, PAGE, OR 57785000=08619020= + %%% NO. THE FIRST (LEFTMOST) IS THE CHANNELSKIP, 57790000=08619030= + %%% RIGHT JUSTIFIED TO ITS C-FIELD. THE SECOND IS 57795000=08619040= + %%% THE WAIT-TIME, RESIDING IN THE F-FIELD OF CHANNELSKIP,57800000=08619050= + %%% AND ALSO TURNING ON THE EXP-SIGN BIT OF CHANNELSKIP, 57805000=08619060= + %%% *"S ARE CONSIDERED TO BE EMPTIES. 57810000=08619070= + IF ACCUM1:= 57815000=08619080= + IF ACCUM1:= ACCUM[1] = 6"3DBL00" THEN 57820000=08619080= + 2 57825000=08619080= + ELSE 57830000=08619080= + IF ACCUM1 = 6"4PAGE0" THEN 57835000=08619090= + 4 57840000=08619090= + ELSE 57845000=08619090= + IF ACCUM1 = 6"4STOP0" THEN 57850000=08619095= + 16 57855000=08619095= + ELSE 57860000=08619095= + IF ACCUM1 = 6"2NO000" THEN 57865000=08620000= + 8 57870000=08620000= + ELSE 57875000=08620000= + 0 ^= 0 57880000=08620000= + THEN %%% [DPN57885000=08620000= + IF STEPI = COMMA THEN %%% HAVE [DPN, 57890000=08620010= + IF STEPI = FACTOP THEN %%% HAVE [DPN,* 57895000=08620020= + BEGIN 57900000=08621000= + EMITNO(ACCUM1); 57905000=08621000= + STEPIT 57910000=08621000= + END 57915000=08621002= + ELSE 57920000=08621002= + IF ACCUM[1] = 6"6UNLOC" THEN %%% [NS,UNLOCK 57925000=08621002= + BEGIN 57930000=08621004= + EMITL(1); 57935000=08621004= + EMITD(47, 4, 1); 57940000=08621004= + STEPIT 57945000=08621004= + END 57950000=08621010= + ELSE 57955000=08621010= + BEGIN 57960000=08621010= + EMITTIME; 57965000=08621010= + EMITL(ACCUM1) 57970000=08621010= + END %[DPN,AEXP57975000=08621010= + ELSE 57980000=08621020= + EMITNO(ACCUM1) %%% HAVE ONLY [DPN 57985000=08621020= + ELSE 57990000=08622000= + IF ELCLASS = FACTOP THEN %%% HAVE [* 57995000=08622000= + IF STEPI = COMMA THEN %%% HAVE [*, 58000000=08622010= + IF STEPI = FACTOP THEN %%% HAVE [*,* 58005000=08623000= + BEGIN 58010000=08624000= + EMITNO(1); 58015000=08624000= + STEPIT 58020000=08624000= + END 58025000=08624002= + ELSE 58030000=08624002= + IF ACCUM[1] = 6"6UNLOC" THEN %%% [*,UNLOCK 58035000=08624002= + BEGIN 58040000=08624004= + EMITL(1); 58045000=08624004= + EMITD(47, 4, 1); 58050000=08624004= + STEPIT 58055000=08624004= + END 58060000=08625000= + ELSE 58065000=08625000= + BEGIN 58070000=08625000= + EMITTIME; 58075000=08625000= + EMITL(1) 58080000=08625000= + END %[*,AEXP 58085000=08625000= + ELSE 58090000=08626000= + EMITNO(1) %%% HAVE ONLY [* 58095000=08626000= + ELSE 58100000=08627000= + BEGIN 58105000=08627000= + AEXP; 58110000=08627000= + EMITO(SSP); 58115000=08627000= + EMITPAIR(JUNK, ISN); 58120000=08627000= + %% HAVE [AEXP 58125000=08627100= + IF ELCLASS = COMMA THEN %%% HAVE [AEXP, 58130000=08628000= + IF STEPI = FACTOP THEN 58135000=08629000= + STEPIT %%%HAVE [AEXP,*58140000=08629000= + ELSE 58145000=08629002= + IF ACCUM[1] = 6"6UNLOC" THEN %%% [AEXP,UNLOCK 58150000=08629002= + BEGIN 58155000=08629004= + EMITL(1); 58160000=08629004= + EMITD(47, 4, 1); 58165000=08629004= + STEPIT 58170000=08629004= + END 58175000=08630000= + ELSE 58180000=08630000= + BEGIN 58185000=08630000= + EMITTIME; 58190000=08630000= + EMITO(LOR) 58195000=08630000= + END; %[AEXP,A58200000=08630000= + EMITL(0); %%% 0 IS NO DPN. 58205000=08631000= + END; 58210000=08632000= + IF CHECK(RTBRKET, 441) THEN 58215000=08634000= + GO TO EXIT; 58220000=08634000= + COMMENT ERROR 441 MEANS MISSING RIGHT BRACKET IN CARRIAGE58225000=08635000= + CONTROL PART; 58230000=08636000= +CHKRTPAREN: 58235000=08637000= + IF STEPI = RTPAREN THEN 58240000=08638000= + GO TO ONEPARENSH; 58245000=08638000= + IF CHECK(COMMA, 442) THEN 58250000=08640000= + GO TO EXIT; 58255000=08640000= + COMMENT ERROR 442 MEANS ILLEGAL CARRIAGE CONTROL 58260000=08641000= + DELIMITER IN A WRITE STATEMENT; 58265000=08642000= +CHKSECOND: 58270000=08643000= + STEPIT; 58275000=08643000= + IF RANGE(FRMTID, SUPERFRMTID) THEN 58280000=08645000= + BEGIN 58285000=08645000= + COMMENT THIS IS THE FORMAT FORM OF THE WRITE; 58290000=08645000= + PASSFORMAT; 58295000=08646000= + WRITXFORM: 58300000=08647000= + IF STEPI = RTPAREN THEN 58305000=08648000= + BEGIN 58310000=08648000= + COMMENT THIS IS THE TWO PARAMETER 58315000=08648000= + CASE OF THE WRITE; 58320000=08649000= + STEPIT; 58325000=08650000= + EMITL(0); 58330000=08650000= + GO EMITCALL; 58335000=08650000= + END; 58340000=08651000= + GO PASSLIST; 58345000=08652000= + END; 58350000=08653000= + IF ELCLASS = LFTBRKET THEN %%% FREE FIELD AT LEAST = [AEXP]/. 58355000=08653100= + BEGIN 58360000=08653110= + I:= I-1; 58365000=08653110= + BANA; 58370000=08653110= + EMITO(SSP); 58375000=08653110= + EMITPAIR(1, ADD); 58380000=08653110= + IF ELCLASS ^= MULOP THEN 58385000=08653120= + ERR(443) 58390000=08653125= + ELSE 58395000=08653125= + IF STEPI = MULOP THEN 58400000=08653125= + BEGIN 58405000=08653125= + EMITO(SSN); 58410000=08653125= + STEPIT 58415000=08653125= + END; 58420000=08653125= + IF ELCLASS = LFTBRKET THEN %%% FREE FIELD = [AEXP]/[AEXP]. 58425000=08653130= + BEGIN 58430000=08653140= + I:= I-1; 58435000=08653140= + BANA; 58440000=08653140= + EMITO(SSP); 58445000=08653140= + EMITPAIR(1, ADD) 58450000=08653150= + END 58455000=08653150= + ELSE 58460000=08653150= + EMITL(1); %%% FREE FIELD = [AEXP]/. 58465000=08653150= + GO TO PASSLIST; 58470000=08653160= + END 58475000=08653180= + ELSE 58480000=08653180= + IF ELCLASS = MULOP THEN %%% FREE FIELD AT LEAST = /. 58485000=08653180= + BEGIN 58490000=08653190= + EMITL(1); 58495000=08653190= + IF STEPI = MULOP THEN 58500000=08653195= + BEGIN 58505000=08653195= + EMITO(SSN); 58510000=08653195= + STEPIT 58515000=08653195= + END; 58520000=08653195= + IF ELCLASS = LFTBRKET THEN %%% FREE FIELD = /[AEXP]. 58525000=08653200= + BEGIN 58530000=08653210= + I:= I-1; 58535000=08653210= + BANA; 58540000=08653210= + EMITO(SSP); 58545000=08653210= + EMITPAIR(1, ADD) 58550000=08653220= + END 58555000=08653220= + ELSE 58560000=08653220= + EMITL(1); %%% FREE FIELD = /. 58565000=08653220= + GO TO PASSLIST; 58570000=08653230= + END OF SCANNING FOR FREE FIELD FORMAT; 58575000=08653240= + IF ELCLASS = FACTOP THEN 58580000=08655000= + BEGIN 58585000=08655000= + COMMENT THIS IS THE ASTERISK FORM OF THE WRITE;58590000=08655000= + EMITL(0); 58595000=08656000= + EMITL(0); 58600000=08656000= + STEPIT; 58605000=08656000= + GO PASSLIST; 58610000=08657000= + END; 58615000=08658000= + IF ACCUM[1] = 6"1<0000" THEN 58620000=08658010= + BEGIN 58625000=08658020= + EXPLICITFORMAT; 58630000=08658020= + GO TO WRITXFORM; 58635000=08658020= + END; 58640000=08658020= + IF ARC THEN 58645000=08658100= + BEGIN 58650000=08658200= + KLUDGE(-HOLD); 58655000=08658200= + GO TO EXIT; 58660000=08658300= + END ARRAY TO ARRAY CASE; 58665000=08658400= + EMITL(0); 58670000=08659000= + AEXP; 58675000=08659000= + IF CHECK(COMMA, 443) THEN 58680000=08661000= + GO TO EXIT; 58685000=08661000= + COMMENT ERROR 443 MEANS IMPROPER DELIMITER FOR SECOND 58690000=08662000= + PARAMETER IN WRITE STATEMENT; 58695000=08663000= + STEPIT; 58700000=08664000= + IF RANGE(BOOARRAYID, INTARRAYID) THEN 58705000=08666000= + BEGIN 58710000=08666000= + COMMENT THIS IS THE ROW DESIGNATOR CASE; 58715000=08666000= + VARIABLE(FL); 58720000=08667000= + IF TABLE(I-2) ^= FACTOP THEN 58725000=08669000= + BEGIN 58730000=08669000= + COMMENT ERROR 444 MEANS IMPROPER ROW 58735000=08669000= + DESIGNATOR IN A WRITE STATEMENT; 58740000=08670000= + ERROR(444); 58745000=08671000= + GO TO EXIT; 58750000=08671000= + END; 58755000=08672000= + IF CHECK(RTPAREN, 445) THEN 58760000=08674000= + GO TO EXIT; 58765000=08674000= + COMMENT ERROR 445 MEANS MISSING RIGHT 58770000=08675000= + PARENTHESIS AFTER A ROW DESIGNATOR IN A WRITE 58775000=08676000= + STATEMENT; 58780000=08677000= + GOGOGO:= TRUE; % 58785000=08677100= + STEPIT; 58790000=08678000= + GO EMITCALL; 58795000=08678000= + END 58800000=08680000= + ELSE 58805000=08680000= + BEGIN 58810000=08680000= + COMMENT ERROR 446 MEANS MISSING ROW DESIGNATOR;58815000=08680000= + ERROR(446); 58820000=08681000= + GO TO EXIT; 58825000=08681000= + END; 58830000=08682000= +PASSLIST: 58835000=08683000= + IF CHECK(COMMA, 447) THEN 58840000=08684000= + GO TO EXIT; 58845000=08684000= + COMMENT ERROR 447 MEANS IMPROPER DELIMITER PRECEEDING A 58850000=08685000= + LIST IN A WRITE STATEMENT; 58855000=08686000= + IF STEPI ^= LISTID AND ELCLASS ^= SUPERLISTID THEN 58860000=08688000= + BEGIN 58865000=08688000= + RR1:= LISTGEN; 58870000=08688000= + GO TO EMITCALL 58875000=08688000= + END; 58880000=08688000= + CHECKER(ELBAT[I]); 58885000=08688500= + IF ELCLASS = SUPERLISTID THEN 58890000=08689000= + BEGIN 58895000=08690000= + COMMENT SUBSCRIPTED SWITCH LIST ID; 58900000=08690000= + LISTADDRESS:= ELBAT[I].ADDRESS; 58905000=08692000= + BANA; 58910000=08693000= + EMITV(LISTADDRESS); 58915000=08694000= + IF LISTADDRESS > 1023 THEN 58920000=08694500= + EMITO(PRTE); 58925000=08694500= + EMITO(LOD); 58930000=08695000= + I:= I-1; 58935000=08695500= + COMMENT STEP DOWN THE&I FROM BANA; 58940000=08695500= + END 58945000=08696500= + ELSE 58950000=08696500= + BEGIN 58955000=08696500= + COMMENT A COMMON LIST ID; 58960000=08696500= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 58965000=08696520= + END; 58970000=08696530= + STEPIT; 58975000=08696540= + IF CHECK(RTPAREN, 448) THEN 58980000=08696550= + GO TO EXIT; 58985000=08696550= + COMMENT 448 IS IMPROPER LIST DELMETER IN WRITE STATEMENT; 58990000=08696560= + STEPIT; 58995000=08697000= +EMITCALL: 59000000=08698000= + IF ELCLASS = LFTBRKET AND NOT ARC THEN 59005000=08698000= + BEGIN 59010000=08698100= + EMITO(MKS); 59015000=08698100= + IF STEPI ^= COLON THEN 59020000=08698200= + DEXP 59025000=08698200= + ELSE 59030000=08698200= + EMIT(0); 59035000=08698200= + IF ELCLASS ^= COLON THEN 59040000=08698300= + EMIT(0) 59045000=08698300= + ELSE 59050000=08698300= + BEGIN 59055000=08698400= + STEPIT; 59060000=08698400= + DEXP 59065000=08698400= + END; 59070000=08698400= + IF CHECK(RTBRKET, 433) THEN 59075000=08698500= + GO EXIT; 59080000=08698500= + EMITL(15); 59085000=08698600= + EMITV(5); 59090000=08698600= + STEPIT; 59095000=08698600= + END; % 59100000=08698700= + IF GOGOGO THEN % 59105000=08698750= + BEGIN 59110000=08698800= + EMIT(0); 59115000=08698800= + EMIT(0); 59120000=08698800= + EMIT(0); % 59125000=08698800= + EMIT(0); 59130000=08698850= + EMIT(0); 59135000=08698850= + EMITV(12); % 59140000=08698850= + END 59145000=08698900= + ELSE 59150000=08698900= + EMITV(GNAT(INTERPTO)); % 59155000=08698900= + GOGOGO:= FALSE; % 59160000=08698950= +EXIT: 59165000=08699000= + ; 59170000=08699000= + END WRITESTMT; 59175000=08700000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%59180000=08700000= + PROCEDURE LOCKSTMT; 59185000=08701000= + BEGIN 59190000=08702000= + COMMENT THE LOCK STATEMENT ROUTINE GENERATES CODE THAT 59195000=08702000= + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 59200000=08703000= + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 59205000=08704000= + **********************************************************59210000=08705000= + ::=LOCK(,SAVE)/ 59215000=08706000= + - - - - - - - - - - - - - - 59220000=08707000= + (2,0,FILE,4) 59225000=08708000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 59230000=08709000= + LOCK(,RELEASE) 59235000=08710000= + - - - - - - - - - - - - - - 59240000=08711000= + (6,0,FILE,4); 59245000=08712000= + LABEL 59250000=08713000= + EXIT; 59255000=08713000= + COMMENT THE LABEL EXIT APPEARS AFTER THE LAST59260000=08713000= + EXECUTABLE STATEMENT IN THE LOCK ROUTINE; 59265000=08714000= + DEFINE 59270000=08715000= + THISL = RR1 #; 59275000=08715000= + COMMENT THISL IS A TEMP CELL 59280000=08715000= + FOR THE CURRENT L REGISTER; 59285000=08716000= + DEFINE 59290000=08717000= + LTEMP = RR2 #; 59295000=08717000= + COMMENT LTEMP CONTAINS THE 59300000=08717000= + L REGISTER SETTING FOR THE 59305000=08718000= + SAVE OR RELEASE LITERAL THAT 59310000=08719000= + GETS PASSED TO KEN MEYERS; 59315000=08720000= + STEPIT; 59320000=08721000= + IF CHECK(LEFTPAREN, 450) THEN 59325000=08723000= + GO TO EXIT; 59330000=08723000= + COMMENT ERROR NUMBER 450 MEANS MISSING LEFT PARENTHESIS 59335000=08724000= + IN A LOCK STATEMENT; 59340000=08725000= + STEPIT; 59345000=08726000= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 59350000=08728000= + BEGIN 59355000=08728000= + COMMENT MUST BE READ-ONLY ARRAY TYPE LOCK; 59360000=08728000= + IF NOT RANGE(BOOARRAYID, INTARRAYID) THEN 59365000=08728100= + BEGIN 59370000=08728200= + ERR(451); 59375000=08728200= + GO TO EXIT 59380000=08728200= + END; 59385000=08728200= + VARIABLE(FL); 59390000=08728300= + L:= L-1; 59395000=08728300= + IF TABLE(I-2) ^= FACTOP THEN 59400000=08728400= + FLAG(208); 59405000=08728400= + EMITO(DUP); 59410000=08728500= + EMITO(LOD); 59415000=08728500= + EMITL(24); 59420000=08728500= + EMITD(43, 3, 5); 59425000=08728600= + EMITO(XCH); 59430000=08728600= + EMITO(STD); 59435000=08728600= + IF ELCLASS = RTPAREN THEN 59440000=08729000= + STEPIT 59445000=08729000= + ELSE 59450000=08729000= + ERR(104); 59455000=08729000= + GO TO EXIT 59460000=08731000= + END; 59465000=08731000= + PASFILE; 59470000=08732000= + IF ELCLASS = RTPAREN THEN 59475000=08732100= + ELBAT[(I:= I-2)+1].CLASS:= RELEASEV 59480000=08732200= + ELSE 59485000=08732200= + IF CHECK(COMMA, 452) THEN 59490000=08734000= + GO TO EXIT; 59495000=08734000= + COMMENT ERROR 452 MEANS MISSING COMMA IN A LOCK STATEMENT59500000=08735000= + ; 59505000=08736000= + THISL:= L; 59510000=08737000= + L:= LTEMP; 59515000=08737000= + IF (RRB1:= STEPI = RELEASEV) OR ELCLASS = DECLARATORS AND ELBAT[I]. 59520000=08739000= + ADDRESS = SAVEV OR ELCLASS = FACTOP 59525000=08740000= + THEN 59530000=08740000= + EMITL(IF RRB1 THEN 6 ELSE IF ELCLASS = FACTOP THEN 8 ELSE 2) 59535000=08743000= + ELSE 59540000=08743000= + BEGIN 59545000=08743000= + COMMENT ERROR 453 MEANS IMPROPER UNIT 59550000=08743000= + DISPOSITION PART; 59555000=08744000= + ERROR(453); 59560000=08745000= + GO TO EXIT; 59565000=08745000= + END; 59570000=08746000= + L:= THISL; 59575000=08747000= + STEPIT; 59580000=08748000= + IF CHECK(RTPAREN, 454) THEN 59585000=08750000= + GO TO EXIT; 59590000=08750000= + COMMENT ERROR 454 MEANS MISSING RIGHT PARENTHESIS IN A 59595000=08751000= + LOCK STATEMENT; 59600000=08752000= + STEPIT; 59605000=08753000= +EXIT: 59610000=08754000= + ; 59615000=08754000= + END LOCKSTMT; 59620000=08755000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%59625000=08755000= + PROCEDURE CLOSESTMT; 59630000=08756000= + BEGIN 59635000=08757000= + COMMENT THE CLOSE STATEMENT ROUTINE GENERATES CODE THAT 59640000=08757000= + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 59645000=08758000= + FOLLOWING PARAMETERS FOR THE CORRESPONDING CASES. 59650000=08759000= + **********************************************************59655000=08760000= + ::=CLOSE(,SAVE)/ 59660000=08761000= + - - - - - - - - - - - - - - 59665000=08762000= + (3,0,FILE,4) 59670000=08763000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 59675000=08764000= + CLOSE(,RELEASE)/ 59680000=08765000= + - - - - - - - - - - - - - - 59685000=08766000= + (7,0,FILE,4) 59690000=08767000= + ** ** ** ** ** ** ** ** ** ** ** ** ** ** 59695000=08768000= + CLOSE(,*) 59700000=08769000= + - - - - - - - - - - - - - - 59705000=08770000= + (1,0,FILE,4) 59710000=08771000= + ::= CLOSE(, PURGE) 59715000=08771100= + -- -- -- -- -- --- -- -- -- -- -- -- 59720000=08771200= + (4,0,FILE,4) 59725000=08771300= + ** ** ** ** ** ** *** ** ** ** ** ** ; 59730000=08771400= + LABEL 59735000=08772000= + EXIT; 59740000=08772000= + COMMENT THE LABEL EXIT APPEARS AFTER THE LAST 59745000=08772000= + EXECUTABLE STATEMENT IN THE CLOSESTMT ROUTINE; 59750000=08773000= + DEFINE 59755000=08774000= + THISL = RR1 #; 59760000=08774000= + COMMENT THISL IS A TEMP CELL 59765000=08774000= + FOR THE CURRENT LREGISTER; 59770000=08775000= + DEFINE 59775000=08776000= + LTEMP = RR2 #; 59780000=08776000= + COMMENT LTEMP CONTAINS THE 59785000=08776000= + L REGISTER SETTING FOR THE 59790000=08777000= + SAVE OR RELEASE LITERAL THAT 59795000=08778000= + GETS PASSED TO KEN MEYERS; 59800000=08779000= + LABEL 59805000=08780000= + EMITREST; 59810000=08780000= + COMMENT I IS POINTING AT THE UNIT 59815000=08780000= + DISPOTION PART AND CODE FOR THE LAST THREE59820000=08781000= + PARAMETERS TO THE FILE CONTROL ROUTINE 59825000=08782000= + MUST NOW BE GENERATED; 59830000=08783000= + STEPIT; 59835000=08784000= + IF CHECK(LEFTPAREN, 455) THEN 59840000=08786000= + GO TO EXIT; 59845000=08786000= + COMMENT ERROR 455 MEANS MISSING LEFT PARENTHESIS IN A 59850000=08787000= + CLOSE STATEMENT; 59855000=08788000= + STEPIT; 59860000=08789000= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 59865000=08791000= + BEGIN 59870000=08791000= + COMMENT ERROR 456 MEANS IMPROPER FILE PART IN A59875000=08791000= + CLOSE STATEMENT; 59880000=08792000= + ERROR(456); 59885000=08793000= + GO TO EXIT; 59890000=08793000= + END; 59895000=08794000= + PASFILE; 59900000=08795000= + IF ELCLASS = RTPAREN THEN 59905000=08795100= + ELBAT[(I:= I-2)+1].CLASS:= RELEASEV 59910000=08795200= + ELSE 59915000=08795200= + IF CHECK(COMMA, 457) THEN 59920000=08797000= + GO TO EXIT; 59925000=08797000= + COMMENT ERROR 457 MEANS MISSING COMMA IN A CLOSE 59930000=08798000= + STATEMENT; 59935000=08799000= + THISL:= L; 59940000=08800000= + L:= LTEMP; 59945000=08800000= + IF STEPI = RELEASEV THEN 59950000=08802000= + BEGIN 59955000=08802000= + COMMENT RELEASE UNIT DISPOSITION PART CASE; 59960000=08802000= + EMITL(7); 59965000=08803000= + GO EMITREST; 59970000=08803000= + END; 59975000=08804000= + IF ELCLASS = FACTOP THEN 59980000=08806000= + BEGIN 59985000=08806000= + COMMENT ASTERISK UNTI DISPOSITION PART CASE; 59990000=08806000= + EMITL(1); 59995000=08807000= + GO EMITREST; 60000000=08807000= + END; 60005000=08808000= + IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = SAVEV THEN 60010000=08810000= + BEGIN 60015000=08810000= + COMMENT SAVE UNIT DISPOSITION PART CASE; 60020000=08810000= + EMITL(3); 60025000=08811000= + GO EMITREST; 60030000=08811000= + END; 60035000=08812000= + IF ACCUM[1] = 6"5PURGE" THEN 60040000=08812100= + BEGIN 60045000=08812100= + COMMENT FILE PURGE; 60050000=08812100= + EMITL(4); 60055000=08812200= + GO EMITREST; 60060000=08812200= + END; 60065000=08812300= + ERROR(458); 60070000=08813000= + GO TO EXIT; 60075000=08813000= + COMMENT ERROR 458 MEANS IMPROPER UNIT DISPOSITION PART 60080000=08814000= + IN A CLOSE STATEMENT; 60085000=08815000= +EMITREST: 60090000=08816000= + STEPIT; 60095000=08816000= + L:= THISL; 60100000=08817000= + IF CHECK(RTPAREN, 459) THEN 60105000=08819000= + GO TO EXIT; 60110000=08819000= + COMMENT ERROR 459 MEANS MISSING RIGHT PARENTHESIS IN A 60115000=08820000= + CLOSE STATEMENT; 60120000=08821000= + STEPIT; 60125000=08822000= +EXIT: 60130000=08823000= + ; 60135000=08823000= + END CLOSESTMT; 60140000=08824000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60145000=08824000= + PROCEDURE RWNDSTMT; 60150000=08825000= + BEGIN 60155000=08826000= + COMMENT THE REWIND STATEMENT ROUTINE GENERATES CODE THAT 60160000=08826000= + CALLS ON THE FILE CONTROL ROUTINE PASSING TO IT THE 60165000=08827000= + FOLLOWING PARAMETERS. 60170000=08828000= + **********************************************************60175000=08829000= + ::=REWIND() 60180000=08830000= + - - - - - - - - - - - - - - 60185000=08831000= + (0,0,FILE,4); 60190000=08832000= + LABEL 60195000=08833000= + EXIT; 60200000=08833000= + COMMENT THE LABEL EXIT APPEARS AFTER THE LAST60205000=08833000= + EXECUTABLE STATEMENT IN THE REWIND ROUTINE; 60210000=08834000= + DEFINE 60215000=08835000= + THISL = RR1 #; 60220000=08835000= + COMMENT THISL IS A TEMP CELL 60225000=08835000= + FOR THE CURRENT L REGISTER; 60230000=08836000= + DEFINE 60235000=08837000= + LTEMP = RR2 #; 60240000=08837000= + COMMENT LTEMP SETTING FOR THE60245000=08837000= + L REGISTER SETTING FOR THE 60250000=08838000= + SAVE OR RELEASE LITERAL THAT 60255000=08839000= + GETS PASSED TO KEN MEYERS; 60260000=08840000= + STEPIT; 60265000=08841000= + IF CHECK(LEFTPAREN, 460) THEN 60270000=08843000= + GO TO EXIT; 60275000=08843000= + COMMENT ERROR 460 MEANS MISSING LEFT PARENTHESIS IN A 60280000=08844000= + REWIND STATEMENT; 60285000=08845000= + STEPIT; 60290000=08846000= + IF NOT RANGE(FILEID, SUPERFILEID) THEN 60295000=08848000= + BEGIN 60300000=08848000= + COMMENT ERROR 461 MEANS IMPROPER FILE PART IN A60305000=08848000= + REWIND STATEMENT; 60310000=08849000= + ERROR(461); 60315000=08850000= + GO TO EXIT; 60320000=08850000= + END; 60325000=08851000= + PASFILE; 60330000=08852000= + IF CHECK(RTPAREN, 462) THEN 60335000=08854000= + GO TO EXIT; 60340000=08854000= + COMMENT ERROR 462 MEANS MISSING RIGHT PARENTHESIS IN A 60345000=08855000= + REWIND STATEMENT; 60350000=08856000= + STEPIT; 60355000=08857000= + THISL:= L; 60360000=08857000= + L:= LTEMP; 60365000=08857000= + EMITL(0); 60370000=08858000= + L:= THISL; 60375000=08858000= +EXIT: 60380000=08859000= + ; 60385000=08859000= + END RWNDSTMT; 60390000=08860000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60395000=08860000= + PROCEDURE EXPLICITFORMAT; 60400000=08860050= + BEGIN 60405000=08860100= + INTEGER 60410000=08860100= + PRT; 60415000=08860100= + ARRAY 60420000=08860100= + TEDOC[0:7, 0:127]; 60425000=08860100= + MOVECODE(TEDOC, EDOC); 60430000=08860150= + GT5:= SGNO; 60435000=08860200= + GT1:= (2*SGAVL-1) & 2[4:46:2]; 60440000=08860200= + SGNO:= SGAVL; 60445000=08860200= + F:= 0; 60450000=08860250= + PRT:= GETSPACE(TRUE, -4); % FORMAT DESCR. 60455000=08860250= + PRT:= PROGDESCBLDR(LDES, 0, PRT); 60460000=08860300= + ELCLASS:= 6"<"; 60465000=08860350= + TB1:= FORMATPHRASE; 60470000=08860350= + SEGMENT(-F, SGNO, GT5); 60475000=08860400= + SGAVL:= SGAVL+1; 60480000=08860400= + SGNO:= GT5; 60485000=08860450= + MOVECODE(TEDOC, EDOC); 60490000=08860450= + IF LASTELCLASS ^= 6">" THEN 60495000=08860500= + ERR(136); 60500000=08860500= + IF ELCLASS = 6"," THEN 60505000=08860600= + ELBAT[I].CLASS:= COMMA 60510000=08860600= + ELSE 60515000=08860600= + IF ELCLASS = 6")" THEN 60520000=08860650= + ELBAT[I].CLASS:= RTPAREN 60525000=08860650= + ELSE 60530000=08860650= + ELBAT[I].CLASS:= 0; 60535000=08860700= + I:= I-1; 60540000=08860700= + EMITL(0); 60545000=08860750= + EMITPAIR(PRT, LOD); 60550000=08860750= + END EXPLICITFORMAT; 60555000=08860800= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%60560000=08860800= + COMMENT SORTSTMT AND MERGESTMT ANALYZE THEIR APPROPRIATE SYNTAXES 60565000=08861000= + AND CALL SORTI, PASSING THE FOLLOWING: 60570000=08862000= + SORT: MERGE: 60575000=08863000= + 0 DISK SIZE,IF SPECIFIED 60580000=08864000= + 0 CORE SIZE,IF SPECIFIED 60585000=08865000= + 0 0 ALFA FLAG 60590000=08866000= + RECORD SIZE 60595000=08867000= + PROG.DESC. PROG.DESC. DESCRIPTOR TO COMPARE PROCEDURE 60600000=08868000= + PROG.DESC. PROG.DESC. DESCRIPTOR TO HIVALUE PROCEDURE 60605000=08869000= + ... 2,3,4,5,6,7 NUMBER OF FILES TO MERGE, OR 60610000=08870000= + 0,3,4,5 ... NUMBER OF SORTTAPES TO USE 60615000=08871000= + TP5 FL7 SCRATCH TAPES FOR SORT, 60620000=08872000= + TP4 FL6 OR MERGE FILES, POINTERS TO 60625000=08873000= + TP3 FL5 TOP I/O DESCRIPTORS, OR ZERO 60630000=08874000= + TP2 FL4 IF NOT USED. 60635000=08875000= + TP1 FL3 60640000=08876000= + 0 FL2 DISK FILES FOR SORT 60645000=08877000= + DK0 FL1 60650000=08878000= + 0/1 0 TRUE IF INPUT PROCEDURE 60655000=08879000= + 0/1 0/1 TRUE IF OUTPUT PROCEDURE 60660000=08880000= + INF 0 POINTER TO I/O DESC FOR INPUT 60665000=08881000= + OUTF OUTF OR OUTPUT FILE, OR MOTHER 60670000=08882000= + OF WORK ARRAY. 60675000=08883000= + PD/0 0 INPUT PROCEDURE DESCRIPTOR 60680000=08884000= + PD/0 PD/0 OUTPUT PROCEDURE 60685000=08885000= + 0 0 60690000=08886000= + 0 0 60695000=08887000= + 0 0 60700000=08888000= + LIT LIT PRT INDEX OF MERGE INTRINSIC 60705000=08889000= + 0 0 60710000=08890000= + 0 1 SORT/MERGE FLAG 60715000=08891000= + ... MSCW 60720000=08892000= + 0 SORT-FILE MOTHER 60725000=08893000= + 0 DESCRIPTORS 60730000=08894000= + 0 . 60735000=08895000= + 0 . 60740000=08896000= + 0 . 60745000=08897000= + 0 . 60750000=08898000= + MSCW; 60755000=08900000= + PROCEDURE MERGESTMT; 60760000=08901000= + BEGIN 60765000=08902000= + INTEGER 60770000=08902000= + J, 60775000=08902000= + K, 60780000=08902000= + FILER, 60785000=08902000= + FILEND; 60790000=08902000= + BOOLEAN 60795000=08903000= + OPTOG; 60800000=08903000= + LABEL 60805000=08904000= + QUIT; 60810000=08904000= + STEPIT; 60815000=08905000= + IF CHECK(LEFTPAREN, 367) THEN 60820000=08905000= + GO QUIT; 60825000=08905000= + EMITO(MKS); 60830000=08906000= + EMITL(1); 60835000=08906000= + EMIT(0); 60840000=08906000= + EMITL(GNAT(MERGEI)); 60845000=08906000= + EMIT(0); 60850000=08907000= + EMIT(0); 60855000=08907000= + EMIT(0); 60860000=08907000= + IF OPTOG:= (STEPI = FILEID OR ELCLASS = SUPERFILEID) THEN 60865000=08908000= + EMIT(0) 60870000=08909000= + ELSE 60875000=08909000= + IF NOT OUTPROCHECK(ELBAT[I]) THEN 60880000=08909000= + GO QUIT 60885000=08909000= + ELSE 60890000=08909000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 60895000=08910000= + EMIT(0); 60900000=08911000= + IF OPTOG THEN 60905000=08911000= + BEGIN 60910000=08911000= + PASSFILE; 60915000=08911000= + I:= I-1 60920000=08911000= + END 60925000=08911100= + ELSE 60930000=08911100= + EMITN(GNAT(SORTA)); 60935000=08911100= + IF NOT COMMACHECK THEN 60940000=08912000= + GO QUIT; 60945000=08912000= + EMIT(0); 60950000=08913000= + EMITL(REAL(TRUE AND NOT OPTOG)); 60955000=08913000= + EMIT(0); 60960000=08913000= + FILE 60965000=08914000= + := BUMPL; 60970000=08914000= + IF NOT HVCHECK(ELBAT[I]) THEN 60975000=08914000= + GO QUIT; 60980000=08914000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 60985000=08915000= + IF NOT COMMACHECK THEN 60990000=08915000= + GO QUIT; 60995000=08915000= + IF NOT EQLESCHECK(ELBAT[I]) THEN 61000000=08916000= + GO QUIT; 61005000=08916000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 61010000=08917000= + IF NOT COMMACHECK THEN 61015000=08917000= + GO QUIT; 61020000=08917000= + AEXP; 61025000=08918000= + EMITB(BFW, FILER, FILEND:= BUMPL); 61030000=08918000= + FOR J:= 1 STEP 1 WHILE ELCLASS = COMMA DO 61035000=08919000= + BEGIN 61040000=08920000= + STEPIT; 61045000=08920000= + PASSFILE 61050000=08920000= + END; 61055000=08920000= + FOR K:= J STEP 1 UNTIL 7 DO 61060000=08921000= + EMIT(0); 61065000=08921000= + J:= J-1; 61070000=08921000= + IF J > 7 OR J < 2 THEN 61075000=08922000= + BEGIN 61080000=08922000= + ERR(368); 61085000=08922000= + GO QUIT 61090000=08922000= + END; 61095000=08922000= + EMITL(J); 61100000=08923000= + EMITB(BBW, BUMPL, FILER); 61105000=08923000= + EMITB(BFW, FILEND, L); 61110000=08923000= + IF CHECK(RTPAREN, 369) THEN 61115000=08924000= + GO QUIT; 61120000=08924000= + STEPIT; 61125000=08924000= + EMITO(SSN); 61130000=08924000= + EMIT(0); 61135000=08925000= + EMIT(0); 61140000=08925000= + EMIT(0); 61145000=08925000= +QUIT: 61150000=08926000= + EMITV(GNAT(SORTI)); 61155000=08926000= + END MERGESTMT; 61160000=08927000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%61165000=08927000= + PROCEDURE SORTSTMT; 61170000=08928000= + BEGIN 61175000=08929000= + BOOLEAN 61180000=08929000= + INPRO, 61185000=08929000= + OUTPRO; 61190000=08929000= + INTEGER 61195000=08930000= + A, 61200000=08930000= + J; 61205000=08930000= + LABEL 61210000=08931000= + QUIT; 61215000=08931000= + DEFINE 61220000=08931000= + RDS = 1, 280 #; 61225000=08931000= + STREAM PROCEDURE STUFFILE(IDLOC, FN, SFN); 61230000=08932000= + VALUE 61235000=08933000= + FN, 61240000=08933000= + SFN; 61245000=08933000= + BEGIN 61250000=08934000= + DI:= IDLOC; 61255000=08934000= + DI:= DI+5; 61260000=08934000= + DI:= DC; 61265000=08934000= + SI:= LOC FN; 61270000=08935000= + SI:= SI+5; 61275000=08935000= + DS:= 3 CHR; 61280000=08935000= + SI:= SI+7; 61285000=08935000= + DS:= 11 LIT 6"0000000DSRT"; 61290000=08936000= + DS:= CHR; 61295000=08936000= + SI:= SI-1; 61300000=08936000= + DS:= 7 LIT 6" 5DSRT"; 61305000=08937000= + DS:= CHR; 61310000=08937000= + SFN:= DI; 61315000=08937000= + SI:= LOC SFN; 61320000=08937000= + DI:= IDLOC; 61325000=08938000= + DI:= DI+5; 61330000=08938000= + SI:= SI+5; 61335000=08938000= + DS:= 3 CHR; 61340000=08938000= + END STUFFILE; 61345000=08939000= + BOOLEAN PROCEDURE INPROCHECK(ELBW); 61350000=08940000= + VALUE 61355000=08940000= + ELBW; 61360000=08940000= + REAL 61365000=08940000= + ELBW; 61370000=08940000= + IF ELBW.CLASS ^= BOOPROCID THEN 61375000=08941000= + ERR(363) 61380000=08941000= + ELSE 61385000=08941000= + IF BOOLEAN(ELBW.FORMAL) THEN 61390000=08941100= + INPROCHECK:= TRUE 61395000=08941100= + ELSE 61400000=08941100= + IF TAKE(GT1:= GIT(ELBW)) ^= 1 THEN 61405000=08942000= + ERR(364) 61410000=08942000= + ELSE 61415000=08942000= + IF ARRAYCHECK(TAKE(GT1+1)) THEN 61420000=08943000= + ERR(365) 61425000=08943000= + ELSE 61430000=08943000= + INPROCHECK:= TRUE; 61435000=08944000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%61440000=08944000= + IF SFILENO = 0 THEN 61445000=08945000= + BEGIN 61450000=08946000= + SFILENO:= FILENO; 61455000=08946000= + FOR J:= 1 STEP 1 UNTIL 7 DO 61460000=08947000= + IF MKABS(IDARRAY[127]) < IDLOC.[33:15]+3 THEN 61465000=08948000= + FLAG(40) 61470000=08948000= + ELSE 61475000=08948000= + BEGIN 61480000=08949000= + STUFFILE 61485000=08950000= + (IDLOC, (IF J <= 2 THEN 12 ELSE 2) & FILENO[30:36:12], J); 61490000=08950000= + FILENO:= FILENO+1; 61495000=08951000= + END; 61500000=08952000= + END; 61505000=08952000= + EMITO(MKS); 61510000=08953000= + EMITV(BLOCKCTR); 61515000=08953000= + EMITPAIR(1, ADD); 61520000=08953000= + EMITPAIR(BLOCKCTR, STD); 61525000=08954000= + EMIT(0); 61530000=08954000= + EMIT(0); 61535000=08954000= + EMITN(2); 61540000=08955000= + EMITPAIR(RDS); 61545000=08955000= + EMITPAIR(A:= GNAT(SORTA), STD); 61550000=08955000= + EMITO(MKS); 61555000=08956000= + EMITL(20); 61560000=08956000= + EMITL(1000); 61565000=08956000= + EMITL(3); 61570000=08956000= + EMITL(SFILENO); 61575000=08956000= + EMIT(0); 61580000=08957000= + EMITO(LNG); 61585000=08957000= + EMITN(A); 61590000=08957000= + EMITO(INX); 61595000=08957000= + EMITL(2); 61600000=08957000= + EMITL(1); 61605000=08958000= + EMITL(10); 61610000=08958000= + EMIT(0); 61615000=08958000= + EMIT(0); 61620000=08958000= + EMITL(10); 61625000=08958000= + EMITL(8); 61630000=08959000= + EMITV(5); 61635000=08959000= + EMIT(0); 61640000=08964000= + EMIT(0); 61645000=08964000= + EMIT(0); 61650000=08964000= + EMIT(0); 61655000=08964000= + EMIT(0); 61660000=08964000= + EMIT(0); 61665000=08964000= + EMITL(GNAT(MERGEI)); 61670000=08965000= + EMIT(0); 61675000=08965000= + EMIT(0); 61680000=08965000= + EMIT(0); 61685000=08965000= + STEPIT; 61690000=08965000= + IF CHECK(LEFTPAREN, 355) THEN 61695000=08966000= + GO QUIT; 61700000=08966000= +% OUTPUT OPTION. 61705000=08966500= + IF STEPI = FILEID OR ELCLASS = SUPERFILEID THEN 61710000=08967000= + BEGIN 61715000=08968000= + EMIT(0); 61720000=08968000= + PASSFILE; 61725000=08968000= + I:= I-1 61730000=08968000= + END 61735000=08969000= + ELSE 61740000=08969000= + BEGIN 61745000=08969000= + IF NOT (OUTPRO:= OUTPROCHECK(ELBAT[I])) THEN 61750000=08969000= + GO QUIT; 61755000=08969000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 61760000=08970000= + EMITL(A); 61765000=08970000= + EMITN(10) 61770000=08971000= + END; 61775000=08971000= + IF NOT COMMACHECK THEN 61780000=08972000= + GO QUIT; 61785000=08972000= +% INPUT OPTION. 61790000=08972500= + IF ELCLASS = FILEID OR ELCLASS = SUPEFILEID THEN 61795000=08973000= + BEGIN 61800000=08974000= + EMITPAIR(0, XCH); 61805000=08974000= + PASSFILE; 61810000=08974000= + I:= I-1 61815000=08974000= + END 61820000=08975000= + ELSE 61825000=08975000= + IF NOT (INPRO:= INPROCHECK(ELBAT[I])) THEN 61830000=08975000= + GO QUIT 61835000=08975000= + ELSE 61840000=08975000= + BEGIN 61845000=08976000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 61850000=08976000= + EMITO(XCH); 61855000=08976000= + IF OUTPRO THEN 61860000=08977000= + EMITO(DUP) 61865000=08977000= + ELSE 61870000=08977000= + BEGIN 61875000=08977000= + EMITL(A); 61880000=08977000= + EMITN(10) 61885000=08978000= + END; 61890000=08978000= + END INPUT PRO; 61895000=08978000= + EMITL(REAL(OUTPRO)); 61900000=08979000= + EMITL(REAL(INPRO)); 61905000=08979000= + EMIT(0); 61910000=08979000= + EMITO(LNG); 61915000=08980000= + EMITN(A); 61920000=08980000= + EMITO(INX); 61925000=08980000= + EMITO(LOD); 61930000=08980000= + EMITPAIR(5, CDC); 61935000=08981000= + EMIT(0); 61940000=08981000= + IF NOT COMMACHECK THEN 61945000=08983000= + GO QUIT; 61950000=08983000= +% NUMBER OF TAPES. 61955000=08983500= + EMIT(0); 61960000=08984000= + EMIT(0); 61965000=08984000= + EMIT(0); 61970000=08984000= + EMIT(0); 61975000=08984000= + EMIT(0); 61980000=08984000= + EMITO(MKS); 61985000=08985000= + EMITN(A); 61990000=08985000= + EMITL(SFILENO+2); 61995000=08985000= + AEXP; 62000000=08985000= + I:= I-1; 62005000=08985000= + EMITL(14); 62010000=08986000= + EMITV(5); 62015000=08986000= + IF NOT COMMACHECK THEN 62020000=08987000= + GO QUIT; 62025000=08987000= +% HIVALUE PROCEDURE. 62030000=08987500= + IF NOT HVCHECK(ELBAT[I]) THEN 62035000=08988000= + GO QUIT; 62040000=08988000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 62045000=08989000= + IF NOT COMMACHECK THEN 62050000=08990000= + GO QUIT; 62055000=08990000= +% COMPARE PROCEDURE. 62060000=08990500= + IF NOT EQLESCHECK(ELBAT[I]) THEN 62065000=08991000= + GO QUIT; 62070000=08991000= + EMITPAIR(ELBAT[I].ADDRESS, LOD); 62075000=08992000= +% RECORD LENGTH. 62080000=08992500= + IF NOT COMMACHECK THEN 62085000=08993000= + GO QUIT; 62090000=08993000= + AEXP; 62095000=08993000= + EMITO(SSN); 62100000=08993000= + EMIT(0); 62105000=08993500= + EMITPAIR(A, SND); 62110000=08993500= +% CORE SIZE. 62115000=08993900= + IF ELCLASS = COMMA THEN 62120000=08994000= + BEGIN 62125000=08994010= + STEPIT; 62130000=08994020= + CORESZ:= MAX(IF ELCLASS = NONLITNO THEN C ELSE 12000, CORESZ); 62135000=08994040= + AEXP; 62140000=08994060= + END 62145000=08994080= + ELSE 62150000=08994080= + IF ELCLASS = RTPAREN THEN 62155000=08994080= + BEGIN 62160000=08994090= + IF CORESZ < 1023 THEN 62165000=08994500= + CORESZ:= 12000; 62170000=08994500= + EMIT(0); 62175000=08994510= + END 62180000=08994530= + ELSE 62185000=08994530= + ERR(366); 62190000=08994530= +% DISK SIZE. 62195000=08994900= + IF ELCLASS = COMMA THEN 62200000=08995000= + BEGIN 62205000=08995000= + STEPIT; 62210000=08995000= + AEXP 62215000=08995000= + END 62220000=08995500= + ELSE 62225000=08995500= + IF ELCLASS = RTPAREN THEN 62230000=08995500= + EMIT(0) 62235000=08995500= + ELSE 62240000=08995500= + ERR(366); 62245000=08995500= + IF ELCLASS ^= RTPAREN THEN 62250000=08996000= + ERR(366) 62255000=08996000= + ELSE 62260000=08996000= + STEPIT; 62265000=08996000= +QUIT: 62270000=08997000= + EMITV(GNAT(SORTI)); 62275000=08997000= + END SORTSTMT; 62280000=08998000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%62285000=08998000= + 62290000=09000000= + COMMENT THE PROGRAM ROUTINE DOES THE INITIALIZATION AND THE WRAPUP 62295000=09000000= + FOR THE REST OF THE COMPILER. THE MAIN PROGRAM OF THE COMPILER62300000=09001000= + IS SIMPLY A CALL ON THE PROGRAM ROUTINE; 62305000=09002000= + PROCEDURE PROGRAM; 62310000=09003000= + BEGIN 62315000=09004000= + STREAM PROCEDURE MDESC(WD, TOLOC); 62320000=09005000= + VALUE 62325000=09005000= + WD; 62330000=09005000= + BEGIN 62335000=09006000= + DI:= LOC WD; 62340000=09006000= + DS:= SET; 62345000=09006000= + SI:= LOC WD; 62350000=09006000= + DI:= TOLOC; 62355000=09006000= + DS:= WDS 62360000=09006000= + END; 62365000=09006000= + 62370000=09007000= + COMMENT THE FOLLOWING PROCEDURE PRINTS OUT THE PRT, NAME, AND 62375000=09007000= + SEGMENT NUMBER OF THE INTRINSIC PROCEDURES USED IN THE 62380000=09008000= + OBJECT PROGRAM; 62385000=09009000= + STREAM PROCEDURE WRTINTRSC(SGNO, ALFA, PRT, FIL); 62390000=09010000= + VALUE 62395000=09011000= + SGNO, 62400000=09011000= + PRT; 62405000=09011000= + BEGIN 62410000=09012000= + LOCAL COUNT, DEST; 62415000=09012000= + DI:= FIL; 62420000=09013000= + DS:= 4 LIT 6"PRT("; 62425000=09013000= + SI:= LOC PRT; 62430000=09013000= + SI:= SI+4; 62435000=09013000= + TALLY:= 4; 62440000=09013000= + 3(IF SC = 6"0" THEN % DONT PRINT LEADING ZEROES. 62445000=09014000= + BEGINSI:= SI+1;TALLY:= TALLY+63 62450000=09015000= + ENDELSE 62455000=09015000= + JUMP OUT); 62460000=09015000= + COUNT:= TALLY; 62465000=09016000= + DS:= COUNT CHR; 62470000=09016000= + DS:= 4 LIT 6") = "; 62475000=09016000= + SI:= ALFA; 62480000=09017000= + SI:= SI+2; 62485000=09017000= + DEST:= DI; % SAVE DI. 62490000=09017000= + DI:= LOC COUNT; 62495000=09018000= + DS:= 7 LIT 6"0"; 62500000=09018000= + DS:= CHR; % NO OF CHARS IN NAME. 62505000=09018000= + DI:= DEST; 62510000=09019000= + DS:= COUNT CHR; % INT. NAME. 62515000=09019000= + DS:= 29 LIT 6" INTRINSIC, SEGMENT NUMBER = "; 62520000=09020000= + SI:= LOC SGNO; 62525000=09021000= + DS:= 4 DEC; 62530000=09021000= + DS:= LIT 6"."; 62535000=09021000= + DI:= DI-5; 62540000=09022000= + DS:= 4 FILL; % JUNK LEADING BLANKS. 62545000=09022000= + END WRTINTRSC; 62550000=09023000= + DEFINE 62555000=09024000= + STARTINTRSC = 426 #; 62560000=09024000= + LABEL 62565000=09025000= + L1; 62570000=09025000= + IDLOC:= ELSEMKABS(IDARRAY[0]); 62575000=09026000= + IDLOCTEMP:= IDLOC; 62580000=09027000= + FILL OPTIONS[**] WITH 6"5CHECK", 0, % 0, 1 62585000=09027002= +6"6DEBUG", 0, % 2, 3 62590000=09027004= +6"4DECK0", 0, % 4, 5 62595000=09027006= +6"6FORMA", 0, % 6, 7 62600000=09027008= +6"9INTRI", 0, % 8, 9 62605000=09027010= +6"5LISTA", 0, % 10, 11 62610000=09027012= +6"4LIST0", 0, % 12, 13 62615000=09027014= +6"5LISTP", 0, % 14, 15 62620000=09027016= +6"3MCP00", 0, % 16, 17 62625000=09027018= +6"4TAPE0", 0, % 18, 19 62630000=09027020= +6"4NEST0", 0, % 20, 21 62635000=09027022= +6"3NEW00", 0, % 22, 23 62640000=09027024= +6"7NEWIN", 0, % 24, 25 62645000=09027026= +6"4OMIT0", 0, % 26, 27 62650000=09027028= +6"1$0000", 0, % 28, 29 62655000=09027030= +6"3PRT00", 0, % 30, 31 62660000=09027032= +6"5PUNCH", 0, % 32, 33 62665000=09027034= +6"5PURGE", 0, % 34, 35 62670000=09027036= +6"4SEGS0", 0, % 36, 37 62675000=09027038= +6"3SEQ00", 0, % 38, 39 62680000=09027040= +6"6SEQER", 0, % 40, 41 62685000=09027042= +6"6SINGL", 0, % 42, 43 62690000=09027044= +6"5STUFF", 0, % 44, 45 62695000=09027046= +6"4VOID0", 0, % 46, 47 62700000=09027048= +6"5VOIDT", 0, % 48, 49 62705000=09027050= +6"4BEND0", 0, % 50, 51 62710000=09027052= +6"4XREF0", 0, % 52, 53 62715000=09027054= +6"7INCLU", 0, % 54,55 62720000=09027056= +6"8CODEF", 0, % 56,57 62725000=09027058= +0; 62730000=09027100= + LISTOG:= LISTER:= BOOLEAN(1-ERRORCOUNT.[46:1]); 62735000=09028000= + OPTIONS[13]:= REAL(LISTER); 62740000=09028005= + 62745000=09028010= +COMMENT LISTOG IS NOT SET BY DEFAULT ON TIMESHARING; 62750000=09028010= + NOHEADING:= TRUE; 62755000=09028050= + BUILDLINE.[47:1]:= SEQXEQTOG:= REMOTOG:= BOOLEAN(ERRORCOUNT.[47:1]);62760000=09028150= + ERRORCOUNT:= 0; 62765000=09028900= + ERRMAX:= 999; % MAY BE CHANGED IN DOLLARCARD. 62770000=09028910= + BASENUM:= 10000; 62775000=09028920= + ADDVALUE:= 1000; 62780000=09028920= + NEWBASE:= TRUE; 62785000=09028920= + 62790000=09028930= +COMMENT DEFAULT VALUES FOR "$SEQ" OPTION; 62795000=09028930= + LASTUSED:= 4; % FOR INITIALIZATION. 62800000=09029000= + SGNO:= 1; 62805000=09030000= + SGAVL:= 2; 62810000=09030000= + PDINX:= 0; 62815000=09030000= + FILENO:= DA:= 1; 62820000=09031000= + FILETHING:= 4095; 62825000=09031100= + MAXSTACK:= 513; 62830000=09032000= + NEXTINFO:= LASTINFO:= LASTSEQROW*256+LASTSEQUENCE+1; 62835000=09033000= + PUTNBUMP(0); 62840000=09034000= + BLANKET(0, INFO[LASTSEQROW, LASTSEQUENCE]); % FOR "$ CHECK".62845000=09034500= + READACARD; % INITIALIZATION OF NCR,FCR, AND LCR, AND 62850000=09035000= + % READS FIRST CARD INTO CARD BUFFER. 62855000=09036000= + LASTUSED:= 1; % ASSUMES CARD ONLY UNTIL TOLD DIFFERENTLY.62860000=09037000= + NXTELBT:= 1; 62865000=09038000= + FAULTLEVEL:= 32; 62870000=09038000= + PRTI:= PRTIMAX:= 18; 62875000=09039000= + MRCLEAN:= TRUE; 62880000=09040000= + 62885000=09040100= +COMMENT START FILLING TABLES NEEDED TO COMPILE A PROGRAM; 62890000=09040100= + FILL TEN[**] WITH 3"1141000000000000", 3"1131200000000000", 62895000=09058000= + 3"1121440000000000", 3"1111750000000000", 3"1102342000000000", 62900000=09059000= + 3"1073032400000000", 3"1063641100000000", 3"1054611320000000", 62905000=09060000= + 3"1045753604000000", 3"1037346545000000", 3"1011124027620000", 62910000=09061000= + 3"0001351035564000", 3"0011643245121000", 3"0022214116345200", 62915000=09062000= + 3"0032657142036440", 3"0043432772446150", 3"0054341571157602", 62920000=09063000= + 3"0065432127413543", 3"0076740555316473", 3"0111053071060221", 62925000=09064000= + 3"0121265707274266", 3"0131543271153343", 3"0142074147406234", 62930000=09065000= + 3"0152513201307703", 3"0163236041571663", 3"0174105452130240", 62935000=09066000= + 3"0205126764556310", 3"0216354561711772", 3"0231004771627437", 62940000=09067000= + 3"0241206170175347", 3"0251447626234641", 3"0261761573704011", 62945000=09068000= + 3"0272356132665013", 3"0303051561442216", 3"0313664115752661", 62950000=09069000= + 3"0324641141345435", 3"0336011371636745", 3"0347413670206536", 62955000=09070000= + 3"0361131664625027", 3"0371360241772234", 3"0401654312370703", 62960000=09071000= + 3"0412227375067064", 3"0422675274304701", 3"0433454553366062", 62965000=09072000= + 3"0444367706263476", 3"0455465667740415", 3"0467003245730521", 62970000=09073000= + 3"0501060411731665", 3"0511274514320242", 3"0521553637404312", 62975000=09074000= + 3"0532106607305375", 3"0542530351166674", 3"0553256443424453", 62980000=09075000= + 3"0564132154331566", 3"0575160607420123", 3"0606414751324150", 62985000=09076000= + 3"0621012014361120", 3"0631214417455344", 3"0641457523370635", 62990000=09077000= + 3"0651773450267005", 3"0662372362344606", 3"0673071057035747", 62995000=09078000= + 3"0703707272645341", 3"0714671151416632", 3"0726047403722400", 63000000=09079000= + 3"0737461304707100", 3"0751137556607072", 3"0761367512350710", 63005000=09080000= + 3"0771665435043073"; 63010000=09080000= + 63015000=09081000= +COMMENT THIS IS THE FULL FOR THE SECOND ROW OF INFO: 63020000=09081000= + THE FIRST ITEMS ARE STREAM RESERVED WORDS, 63025000=09082000= + THEN ORDINARY RESERVED WORDS, 63030000=09083000= + THEN INTRINSIC FUNCTIONS; 63035000=09084000= + FILL INFO[1,*] WITH 63040000=09085000= + OCT0670000600000400, "2SI000", COMMENT 256;63045000=09086000= + OCT0700001040000402, "2DI000", COMMENT 258;63050000=09087000= + OCT0710001460000404, "2CI000", COMMENT 260;63055000=09088000= + OCT0720001630000406, "5TALLY", COMMENT 262;63060000=09089000= + OCT0730000530000410, "2DS000", COMMENT 264;63065000=09090000= + OCT0740000150000412, "4SKIP0", COMMENT 266;63070000=09091000= + OCT0750001620000414, "4JUMP0", COMMENT 268;63075000=09092000= + OCT0760000740000416, "2DB000", COMMENT 270;63080000=09093000= + OCT0770000500000420, "2SB000", COMMENT 272;63085000=09094000= + OCT1010000730000422, "2SC000", COMMENT 274;63090000=09095000= + OCT1020001160000424, "3LOC00", COMMENT 276;63095000=09096000= + OCT1030001170000426, "2DC000", COMMENT 278;63100000=09097000= + OCT1040001430000430, "5LOCAL", COMMENT 280;63105000=09098000= + OCT1050000340000432, "3LIT00", COMMENT 282;63110000=09099000= + OCT1060001036400434, "3SET00", COMMENT 284;63115000=09100000= + OCT1060001066500436, "5RESET", COMMENT 286;63120000=09101000= + OCT1060001020500440, "3WDS00", COMMENT 288;63125000=09102000= + OCT1060001357700442, "3CHR00", COMMENT 290;63130000=09103000= + OCT1060001057300444, "3ADD00", COMMENT 292;63135000=09104000= + OCT1060001617200446, "3SUB00", COMMENT 294;63140000=09105000= + OCT1060000727600450, "3ZON00", COMMENT 296;63145000=09106000= + OCT1060000417500452, "3NUM00", COMMENT 298;63150000=09107000= + OCT1060000766700454, "3OCT00", COMMENT 300;63155000=09108000= + OCT1060000176600456, "3DEC00", COMMENT 302;63160000=09109000= + OCT1004000260000460, "6TOGGL", "E0000000", COMMENT 304;63165000=09110000= + OCT0430000050000000, "5ALPHA", COMMENT 307;63170000=09111000= + OCT1330001030000000, "3AND00", COMMENT 309;63175000=09112000= + OCT0430000170000525, "5ARRAY", COMMENT 311;63180000=09113000= + OCT0660000000000000, "5BEGIN", COMMENT 313;63185000=09114000= + OCT0430000030000503, "7BOOLE", "AN000000", COMMENT 315;63190000=09115000= + OCT0470000000000000, "5CLOSE", COMMENT 318;63195000=09116000= + OCT1070000000000655, "7COMME", "NT000000", COMMENT 320;63200000=09117000= + OCT0430000230000000, "6DEFIN", "E0000000", COMMENT 323;63205000=09118000= + OCT1360006000000000, "3DIV00", COMMENT 326;63210000=09119000= + OCT0550000000000000, "2DO000", COMMENT 328;63215000=09120000= + OCT0520000000000000, "6DOUBL", "E0000000", COMMENT 330;63220000=09121000= + OCT0430000100000000, "4DUMP0", COMMENT 333;63225000=09122000= + OCT0570000000000000, "4ELSE0", COMMENT 335;63230000=09123000= + OCT0600000000000000, "3END00", COMMENT 337;63235000=09124000= + OCT1300002030000000, "3EQV00", COMMENT 339;63240000=09125000= + OCT0360000000000644, "5FALSE", COMMENT 341;63245000=09126000= + OCT0430000210000000, "4FILE0", COMMENT 343;63250000=09127000= + OCT0610000001200000, "4FILL0", 63255000=09128000= + OCT0530000000000000, "3FOR00", COMMENT 347;63260000=09129000= + OCT0430000200000554, "6FORMA", "T0000000", COMMENT 349;63265000=09130000= + OCT1100000000000000, "7FORWA", "RD000000", COMMENT 352;63270000=09131000= + OCT0640000000000604, "2GO000", COMMENT 355;63275000=09132000= + OCT0630000000000000, "2IF000", COMMENT 357;63280000=09133000= + OCT0430000130000000, "2IN000", COMMENT 359;63285000=09134000= + OCT0430000060000000, "7INTEG", "ER000000", COMMENT 361;63290000=09135000= + OCT1310000000000000, "3IMP00", COMMENT 364;63295000=09136000= + OCT0430000070000000, "5LABEL", COMMENT 366;63300000=09137000= + OCT0430000110000613, "4LIST0", COMMENT 368;63305000=09138000= + OCT0500000000000000, "4LOCK0", COMMENT 370;63310000=09139000= + OCT1360016000000000, "3MOD00", COMMENT 372;63315000=09140000= + OCT0430000140000000, "7MONIT", "OR000000", COMMENT 374;63320000=09141000= + OCT1250000000000000, "3NOT00", COMMENT 377;63325000=09142000= + OCT1320000430000624, "2OR000", COMMENT 379;63330000=09143000= + OCT0430000120000000, "3OUT00", COMMENT 381;63335000=09144000= + OCT0430000010000476, "3OWN00", COMMENT 383;63340000=09145000= + OCT0430000160000463, "9PROCE", "DURE0000", COMMENT 385;63345000=09146000= + OCT0440000000000000, "4READ0", COMMENT 388;63350000=09147000= + OCT0430000040000000, "4REAL0", COMMENT 390;63355000=09148000= + OCT0650000000000000, "7RELEA", "SE000000", COMMENT 392;63360000=09149000= + OCT0510000000000000, "6REWIN", "D0000000", COMMENT 395;63365000=09150000= + OCT0430000020000773, "4SAVE0", COMMENT 398;63370000=09151000= + OCT0460000000000000, "5SPACE", COMMENT 400;63375000=09152000= + OCT1110000000000000, "4STEP0", COMMENT 402;63380000=09153000= + OCT0430000220000000, "6STREA", "M0000000", COMMENT 404;63385000=09154000= + OCT0430000150000562, "6SWITC", "H0000000", COMMENT 407;63390000=09155000= + OCT1120000000000000, "4THEN0", COMMENT 410;63395000=09156000= + OCT1130000000000000, "2TO000", COMMENT 412;63400000=09157000= + OCT0360000010000000, "4TRUE0", COMMENT 414;63405000=09158000= + OCT0560000000000000, "5UNTIL", COMMENT 416;63410000=09159000= + OCT1140000000000000, "5VALUE", COMMENT 418;63415000=09160000= + OCT0540000000000540, "5WHILE", COMMENT 420;63420000=09161000= + OCT1150000000000000, "4WITH0", COMMENT 422;63425000=09162000= + OCT0450000000000531, "5WRITE", COMMENT 424;63430000=09163000= + OCT0130000000140673, "3ABS00", OCT0000000000700000,%426 63435000=09164000= + OCT0130000000060000, "6ARCTA", "N0000000", OCT0000000001600000,%429;63440000=09165000= + OCT0130000000040000, "3COS00", OCT0000000001500000,%433;63445000=09166000= + OCT0130000000360000, "6ENTIE", "R0000000", OCT0000000001100000,%436 63450000=09167000= + OCT0130000000040000, "3EXP00", OCT0000000002000000,%440;63455000=09168000= + OCT0130000000040000, "2LN000", OCT0000000001700000,%443;63460000=09169000= + OCT0130000000240000, "4SIGN0", OCT0000000001000000,%446 63465000=09170000= + OCT0130000000040000, "3SIN00", OCT0000000001400000,%449;63470000=09171000= + OCT0130000000040515, "4SQRT0", OCT0000000001300000,%452;63475000=09172000= + OCT0130000000440000, "4TIME0", OCT0000000001200000,%455 63480000=09173000= + OCT0140000000040000, "3ZIP00", 0, COMMENT 455;63485000=09174000= + OCT0130000000060000, "9OUTPU", "T(W)0000", OCT0000000000100000,%461;63490000=09175000= + OCT0130000050060000, ":BLOCK", " CONTROL", OCT0000000000200000,%465;63495000=09176000= + OCT0130000000060000, "8INPUT", "(W)00000", OCT0000000000300000,%469;63500000=09177000= + OCT0000000000060000, "4SORT0", 0, OCT0000000000400000,% 473 63505000=09178000= + OCT0130000000040000, "4DUMP0", OCT0000000000500000,%477;63510000=09179000= + OCT0130000000060000, "#X TO ", "THE I000", OCT0000000000600000,%480;63515000=09180000= + OCT0130000000060000, ":GO TO", " SOLVER ", OCT0000000002100000,%484;63520000=09181000= + OCT0130000140060000, ":ALGOL", " WRITE ", OCT0000000002200000,%488;63525000=09182000= + OCT0130000150060000, ":ALGOL", " READ ", OCT0000000002300000,%492;63530000=09183000= + OCT0130000160060000, ":ALGOL", " SELECT ", OCT0000000002400000,%496;63535000=09184000= + OCT0000000000040000, "5MERGE", OCT0000000002700000,% 500 63540000=09184100= + OCT0130000000560652, "6STATU", "S0000000", OCT0000000003000000,%503 63545000=09184200= + OCT0130000000640000, "3MAX00", OCT0000000003100047,%507 63550000=09184300= + OCT0430000240000000, "6AUXME", "M0000000"; %510 63555000=09185000= + 63560000=09185100= + 63565000=09186000= + COMMENT THIS IS THE FILL FOR STACKHEAD; 63570000=09187000= + FILL STACKHEAD[*] WITH 63575000=09188000= +320,359,313,458,385, 0,337,347,383,361,379,412, 0, 0, 0,372, 63580000=09189000= +355,309, 0, 0,368, 0,446, 0, 0,549,311,410, 0, 0,400, 0, 63585000=09190000= + 0, 0, 0, 0,503,315, 0, 0,330, 0, 0, 0, 0, 0, 0,440, 63590000=09191000= +390,449,349, 0,414, 0, 0, 0,452, 0, 0, 0, 0, 0, 0, 0, 63595000=09192000= +381,328, 0, 0, 0, 0, 0, 0, 0, 0, 0,436, 0,402,407, 0, 63600000=09193000= + 0, 0,377, 0, 0, 0,416,455,355, 0, 0,357, 0,552,374, 0, 63605000=09194000= + 0, 0,433, 0,418,398,343, 0, 0,326,339, 0, 0, 0,366, 0, 63610000=09195000= + 0, 0, 0, 0, 0,422, 0,392, 0, 0, 0,424, 0; 63615000=09196000= + FILL SUPERSTACK[*] WITH 63620000=09196100= + 0, 0,313, 0,307, 0,337,347,383, 0,379,412, 0, 0, 0,372, 63625000=09196200= +335,309, 0, 0, 0, 0, 0, 0, 0, 0,420,410, 0, 0, 0, 0, 63630000=09196300= + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 63635000=09196400= +390, 0,364, 0,414, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 63640000=09196500= + 0,328, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,402, 0, 0, 63645000=09196600= + 0, 0,377, 0,510, 0,416, 0,355, 0, 0,357, 0, 0, 0, 0, 63650000=09196700= + 0, 0, 0, 0, 0,398, 0, 0, 0,326,339, 0, 0, 0,366, 0, 63655000=09196800= + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,424, 0; 63660000=09196900= + COMMENT THIS IS THE FILL FOR THE SPECIAL CHARACTORS; 63665000=09197000= + FILL SPECIAL[*] WITH 63670000=09198000= + OCT1200000000200000, COMMENT #; OCT0000000000100000, COMMENT @; 63675000=09199000= + OCT0000000000000000, OCT1160000000120000, COMMENT :; 63680000=09200000= + OCT1340000450002763, COMMENT >; OCT1340000250002662, COMMENT }; 63685000=09201000= + OCT1350000200000000, COMMENT +; OCT0000000000000000, 63690000=09202000= + OCT1220000000060000, COMMENT .; OCT1210000000000000, COMMENT [; 63695000=09203000= + OCT1270000000000000, COMMENT &; OCT0420000000000000, COMMENT (; 63700000=09204000= + OCT1340010450003571, COMMENT <; OCT1260000000000000, COMMENT ~; 63705000=09205000= + OCT1360001000000000, COMMENT |; OCT0000000000000000, 63710000=09206000= + OCT0000000000040000, COMMENT $; OCT1370000000000000, COMMENT *; 63715000=09207000= + OCT1350000600000000, COMMENT -; OCT1240000000160000, COMMENT ); 63720000=09208000= + OCT0620000000000000, COMMENT .,; OCT1340010250003470, COMMENT {; 63725000=09209000= + OCT0000000000000000, OCT1360002000000000, COMMENT /; 63730000=09210000= + OCT1170000000000000, COMMENT ,; OCT0000000000020000, COMMENT %; 63735000=09211000= + OCT1340001050002561, COMMENT !; OCT1340011050002460, COMMENT =; 63740000=09212000= + OCT1230000000000000, COMMENT ]; OCT0000000000140000, COMMENT "; 63745000=09213000= + 0,0; 63750000=09214000= + COMMENT THIS IS THE FILL FOR THE REALLY SPECIAL CHARACTERS FOR DATACOM;63755000=09214100= +FILL INFO[2,*] WITH OCT0030000120000000, "2LB000", % THESE ENTRIES ARE 63760000=09214105= + OCT0030000130000000, "2RB000", % DESIGNED TO LOOK 63765000=09214110= + OCT0030000140000000, "3GTR00", % LIKE DEFINE 63770000=09214115= + OCT0030000150000000, "3GEQ00", % DECLARATIONS AT 63775000=09214120= + OCT0030000160000000, "3EQL00", % BLOCK LEVEL 0. 63780000=09214125= + OCT0030000170000000, "3NEQ00", 63785000=09214130= + OCT0030000200000000, "3LEQ00", 63790000=09214135= + OCT0030000210000000, "3LSS00", 63795000=09214140= + OCT0030000220000000, "5TIMES", 63800000=09214145= + OCT0030000230000000, "5INPUT", 63805000=09214150= + OCT0030000240000000, "2IO000", 63810000=09214155= + OCT0030000250000000, "6SERIA","L0000000", 63815000=09214160= + OCT0030000260000000, "6RANDO","M0000000", 63820000=09214165= + OCT0030000270000000, "6UPDAT","E0000000", 63825000=09214170= + OCT0030000300000000, "6OUTPU","T0000000", 63830000=09214180= + OCT0030000310000000, "7CANTU","SE000000", 63835000=09214190= + OCT0130000000740000, "3MIN00", OCT0000000003200000,%549 63840000=09214200= + OCT0130000001040000, "5DELAY", OCT0000000003300000,%552 63845000=09214210= + OCT0000000000060000, ":SUPER", " MOVER ", OCT0000000003400000,%555 63850000=09214220= + OCT0000000000060000, ":DYNAM", "IC DIALS", OCT0000000004000000,%559 63855000=09214230= + OCT0130000000060000, ":FILE ", "ATTRBUTS", OCT0000000015000000,%563 63860000=09214240= + OCT0000000000040000, "5DCPWR", OCT0000000005600000,%567 63865000=09214250= + OCT0000000000040000, "5DCMTH", OCT0000000005500000,%570 63870000=09214255= + OCT0130000001140000, "5DSQRT", OCT0000000012300000,%573 63875000=09214260= + OCT0130000001240000, "4CEXP0", OCT0000000010000000,%576 63880000=09214270= + OCT0130000001340000, "3CLN00", OCT0000000010200000,%579 63885000=09214295= + OCT0130000001440000, "4CSIN0", OCT0000000010600000,%582 63890000=09214300= + OCT0130000001540000, "4CCOS0", OCT0000000011000000,%585 63895000=09214305= + OCT0130000001640000, "5CSQRT", OCT0000000012400000,%588 63900000=09214310= + OCT0130000001740000, "4DEXP0", OCT0000000007700000,%591 63905000=09214315= + OCT0130000002040000, "3DLN00", OCT0000000010100000,%594 63910000=09214320= + OCT0130000002140000, "4DSIN0", OCT0000000010500000,%597 63915000=09214325= + OCT0130000002240000, "4DCOS0", OCT0000000010700000,%600 63920000=09214330= + OCT0130000002360000, "7DARCT","AN0000000", OCT0000000011300000,%603 63925000=09214340= + OCT0130000002460000, "6DLOG1","000000000", OCT0000000010400000,%607 63930000=09214345= + OCT0130000002560000, "8DARCT","AN2000000", OCT0000000011500000,%611 63935000=09214350= + OCT0130000002640000, "4DMOD0", OCT0000000006500000,%615 63940000=09214355= + OCT0130000002740000, "4CABS0", OCT0000000005300000,%618 63945000=09214360= + OCT0130000003060000, "7ARCTA","N20000000", OCT0000000011400000,%621 63950000=09214365= + OCT0130000003160000, "6DROUN","D00000000", OCT0000000006100000,%625 63955000=09214370= + OCT0130000000040000, "5LOG10", OCT0000000010300000,%629 63960000=09214375= + OCT0130000000040000, "5COTAN", OCT0000000011200000,%632 63965000=09214380= + OCT0130000000060000, "6ARCSI","N00000000", OCT0000000011600000,%635 63970000=09214385= + OCT0130000000040000, "5ARCOS", OCT0000000011700000,%639 63975000=09214390= + OCT0130000000040000, "4SINH0", OCT0000000012000000,%642 63980000=09214395= + OCT0130000000040000, "4COSH0", OCT0000000012100000,%645 63985000=09214400= + OCT0130000000040000, "4TANH0", OCT0000000012200000,%648 63990000=09214405= + OCT0130000000040000, "3ERF00", OCT0000000012500000,%651 63995000=09214410= + OCT0130000000040000, "5GAMMA", OCT0000000012600000,%654 64000000=09214415= + OCT0130000000040000, "5LNGAM", OCT0000000012700000,%657 64005000=09214420= + OCT0130000000040000, "3TAN00", OCT0000000011100000,%660 64010000=09214425= + OCT0130000260000000, "4FAST0", %663 64015000=09214426= + OCT0130000270000000, "4SLOW0", %665 64020000=09214427= + OCT0130000240000000, "7PROTE", "CT000000", %667 64025000=09214428= + OCT2000000000004050, COMMENT POWERS OF TEN ; %670 64030000=09214430= + OCT0430000250000000, "5FIELD", %671 64035000=09214432= + 0, ">SORT ", "TEMPORAR", "Y0000000", % SORTA %673 64040000=09214435= + " " ; COMMENT LASTSEQUENCE,LASTSEQROW ; %674 64045000=09214440= + 64050000=09214500= + COMMENT NOW LINK THESE ENTRIES INTO STACKHEAD; 64055000=09214500= + FOR NEXTINFO:= 512 STEP 2 UNTIL 534, 537 STEP 3 UNTIL 546, 567 STEP 64060000=09214515= + 3 UNTIL 603, 607 STEP 4 UNTIL 615, 618, 621 STEP 4 UNTIL 629, 632 64065000=09214515= + , 635, 639 STEP 3 UNTIL 660, 663 STEP 2 UNTIL 667, 671 64070000=09214520= + DO 64075000=09214520= + PUT(TAKE(NEXTINFO) & STACKHEAD[GT2:= TAKE(NEXTINFO+1) MOD 125] 64080000=09214530= + [35:35:13], LASTINFO:= STACKHEAD[GT2]:= NEXTINFO); 64085000=09214530= + NEXTINFO:= LASTINFO:= LASTSEQROW*256+LASTSEQUENCE+1; 64090000=09214980= + BUILDLINE.[45:1]:= TRUE; 64095000=09214985= + PUTNBUMP(0); 64100000=09214990= + FILL MACRO[**] WITH 64105000=09215100= + OCT0131, COMMENT SFS A 00 ; 64110000=09216000= + OCT0116, COMMENT SFD A 01 ; 64115000=09217000= + OCT0000, COMMENT SYNTAX ERROR02 ; 64120000=09218000= + OCT0140, COMMENT INC A 03 ; 64125000=09219000= + OCT0130, COMMENT SRS A 04 ; 64130000=09220000= + OCT0117 COMMENT SRD A 05 ; 64135000=09221000= + OCT0000, COMMENT SYNTAX ERROR06 ; 64140000=09222000= + OCT0000, COMMENT SYNTAX ERROR07 ; 64145000=09223000= + OCT00310143, COMMENT CRF A, SFS 008 ; 64150000=09224000= + OCT00160143, COMMENT CRF A, SFD 009 ; 64155000=09225000= + OCT00470143, COMMENT CRF A, JFW 0 10 ; 64160000=09226000= + OCT00400143, COMMENT CRF A, INC 011 ; 64165000=09227000= + OCT00300143, COMMENT CRF A, SRS 012 ; 64170000=09228000= + OCT00170143, COMMENT CRF A, SRD 013 ; 64175000=09229000= + OCT0000, COMMENT SYNTAX ERROR14 ; 64180000=09230000= + OCT0000, COMMENT SYNTAX ERROR15 ; 64185000=09231000= + OCT0153, COMMENT RSA A 16 ; 64190000=09232000= + OCT0104, COMMENT RDA A 17 ; 64195000=09233000= + OCT0150, COMMENT RCA A 18 ; 64200000=09234000= + OCT004201430042, COMMENT SEC 0, CRF A, SEC 0 19 ; 64205000=09235000= + OCT0122, COMMENT SES A 20 ; 64210000=09236000= + OCT0106, COMMENT SED A 21 ; 64215000=09237000= + OCT0000, COMMENT SYNTAX ERROR22 ; 64220000=09238000= + OCT0000, COMMENT SYNTAX ERROR23 ; 64225000=09239000= + OCT0056, COMMENT TSA 0 24 ; 64230000=09240000= + OCT0000, COMMENT SYNTAX ERROR25 ; 64235000=09241000= + OCT0000, COMMENT SYNTAX ERROR26 ; 64240000=09242000= + OCT0000, COMMENT SYNTAX ERROR27 ; 64245000=09243000= + OCT0000, COMMENT SYNTAX ERROR28 ; 64250000=09244000= + OCT0007, COMMENT TDA 0 29 ; 64255000=09245000= + OCT0000, COMMENT SYNTAX ERROR30 ; 64260000=09246000= + OCT0000, COMMENT SYNTAX ERROR31 ; 64265000=09247000= + OCT0115, COMMENT SSA A 32 ; 64270000=09248000= + OCT0114, COMMENT SDA A 33 ; 64275000=09249000= + OCT0154, COMMENT SCA A 34 ; 64280000=09250000= + OCT0141; COMMENT STC A 35 ; 64285000=09251000= + FILL TEXT[0,*] WITH 0,0,0,0,0,0,0,0,0,0, 64290000=09251010= + "[# ", 64295000=09251020= + "]# ", 64300000=09251030= + "># ", 64305000=09251040= + "}# ", 64310000=09251050= + "=# ", 64315000=09251060= + "!# ", 64320000=09251070= + "{# ", 64325000=09251080= + "<# ", 64330000=09251090= + "|# ", 64335000=09251100= + "1# ", 64340000=09251101= + "3# ", 64345000=09251102= + "0# ", 64350000=09251103= + "1# ", 64355000=09251104= + "2# ", 64360000=09251105= + "2# ", 64365000=09251106= + "0# " 64370000=09251107= + ; 64375000=09251200= +NEXTTEXT:= 26; 64380000=09251300= + DO 64385000=09252000= + UNTIL STEPI = BEGINV; 64390000=09252000= + BUILDLINE.[45:1]:= FALSE; 64395000=09252050= + COMMENT THE FOLLOWING IS THE FIRST CODE EXECUTED IN ANY PROGRAM. 64400000=09253000= + THE OUTER BLOCK(NUMBER 1) CONSISTS OF THE FOLLOWING CODE: 64405000=09254000= + LITC 0 --- THIS PUTS A BOTTOM ON THE STACK 64410000=09255000= + AND IS ALSO USED AS A ONE SYLLABLE 64415000=09256000= + CHARACTER MODE PROGRAM TO CAUSE AN EXIT. 64420000=09257000= + ITS PRIMARY FUNCTION IS TO CUT BACK 64425000=09258000= + THE STACK AFTER A COMMUNICATE OPERATOR. 64430000=09259000= + MKS --- THIS SETS THE PROGRAM UP FOR RUNNING 64435000=09260000= + IN SUBPROGRAM LEVEL.THIS IS TO ALLOW 64440000=09261000= + C-RELATIVE ADDRESSING FOR CONSTANTS 64445000=09262000= + IN THE PROGRAM STREAM 64450000=09263000= + OPDC XXXX--- THIS ACCESSES A PROGRAM DESCRIPTOR 64455000=09264000= + THAT GETS THE PROGRAM INTO SUBPROGRAM 64460000=09265000= + LEVEL. XXXX IS THE FIRST AVAILABLE PRT 64465000=09266000= + CELL.AT THE START OF COMPILATION XXXX IS 64470000=09267000= + ASSUMED TO CONTAIN A LABEL DESCRIPTOR 64475000=09268000= + IT IS CHANGED BEFORE COMPILATION IS 64480000=09269000= + COMPLETE TO LOOK LIKE A WORD MODE 64485000=09270000= + PROGRAM DESCRIPTOR; 64490000=09271000= + EMITL(0); 64495000=09272000= + EMIT0(MKS); 64500000=09272000= + GT1:= PROGDESCBLDR(3, 0, 0); 64505000=09273000= + GT1:= GETSPACE(TRUE, -5); % SEG.#2 DESCR. 64510000=09274000= + INSERTCOP:= 1; 64515000=09274100= + ERRORTOG:= TRUE; 64520000=09275000= + BLOCK(FALSE); 64525000=09275000= + COMMENT THIS CODE WILL PUT AN EXTRA CARD ON OCRDIMG TAPE 64530000=09275100= + THUS AVOIDING E.O.F. NO LABEL CONDITION WHEN PATCHING 64535000=09275200= + THE END. CARD OFF AN INPUT TAPE; 64540000=09275250= + IF NEWTOG THEN 64545000=09275300= + BEGIN 64550000=09275350= + FILL LIBARRAY[**] WITH 6"END;END.", 6" ", 6"LAST CAR", 64555000=09275400= + 6"D ON OCR", 6"DING TAPE", 6"E ", 6" ", 6" " 64560000=09275400= + , 6" ", 6"999999999"; 64565000=09275450= + WRITE(NEWTAPE, 10, LIBARRAY[**]) 64570000=09275550= + END; 64575000=09275550= + COMMENT THE FOLLOWING CODE SEARCHES THROUGH INFO TO DETERMINE 64580000=09277000= + WHICH INTRINSICS HAVE BEEN USED.IF AN INTRINSIC HAS BEEN 64585000=09278000= + USED THEN A PRT ADDRESS WILL HAVE BEEN ASSIGNED AND 64590000=09279000= + THIS INDICATES THAT A DESCRIPTOR MUST BE BUILT FOR PLACING 64595000=09280000= + IN THE PRT.POWERSOFTEN IS ENTERED IN THE OBJECT PROGRAM 64600000=09281000= + PRT AS AN ABSENT DATA DESCRIPTOR.IT MAY BE RECOGNIZED IN 64605000=09282000= + INFO BECAUSE IT IS MINUS. THE FIRST WORD IN EACH OF THESE 64610000=09283000= + ENTRIES LOOKS LIKE THE REST OF INFO EXCEPT THAT THE INCR 64615000=09284000= + FIELD IS BROKEN INTO 2 PARTS, [33:2] IS USED TO ADD TO THE 64620000=09285000= + INDEX OF CURRENT WORD TO LINK TO NEXT ENTRY.THE REST OF 64625000=09286000= + THE INCR FIELD IS USED BY IMPFUN. THE ADDITIONAL INFO 64630000=09287000= + PORTION INDICATES AN INDEX THAT ALLOWS THE MCP TO ASSIGN 64635000=09288000= + DRUM ADDRESSES TO THE INTRINSICS; 64640000=09289000= + GT1:= GT3:= STARTINTRSC; 64645000=09291000= +L1: GT1:= GT1+(GT2:= INFO[GT1.LINKR, GT1.LINKC]).[33:2]; 64650000=09292000= + IF GT2 >= 0 THEN % NOT POWERS OF TEN TABLE 64655000=09293000= + BEGIN 64660000=09294000= + IF GT2.ADDRESS ^= 0 THEN % IT WAS USED 64665000=09294000= + BEGIN 64670000=09295000= + SGNO:= SGAVL; 64675000=09295000= + SGAVL:= SGAVL+1; 64680000=09295000= + GT2:= PROGDESCBLDR 64685000=09296100= + (INFO[GT1.LINKR, GT1.LINKC].[1:1]*2+1, 0, GT2.ADDRESS); 64690000=09296100= + PDPRT[PDINX.[37:5], PDINX.[42:6]]:= 1 & 64695000=09298000= + INFO[GT1.LINKR, GT1.LINKC][13:18:15] & SGNO[28:38:10] & 1 64700000=09298100= + [2:47:1]; 64705000=09298100= + PDINX:= PDINX+1; 64710000=09299000= + IF PRTOG THEN % WRITE OUT INTRINSICS USED. 64715000=09300000= + BEGIN 64720000=09300100= + GT3:= GT3+1; 64725000=09300100= + BLANKET(14, LIN); % BLANK BUFFER. 64730000=09300150= + WRTINTRSC(SGNO, INFO[GT3.LINKR, GT3.LINKC], 64735000=09301000= + B2D(GT2.[38:10]), LIN); 64740000=09301000= + IF NOHEADING THEN 64745000=09302000= + DATIME; 64750000=09302000= + WRITELINE; 64755000=09302000= + END 64760000=09304000= + END; 64765000=09304000= + GT3:= GT1:= GT1+INFO[GT1.LINKR, GT1.LINKC].[33:15]+1; 64770000=09305000= + GO TO L1; 64775000=09305100= + END; 64780000=09306000= + L:= L-1; 64785000=09306100= + COMMENT WIPES OUT EXTRANEOUS BFW EMITTED BY BLOCK; 64790000=09306100= + EMITL(5); 64795000=09307000= + EMITO(COM); 64800000=09307000= + ENIL[0, 1]:= 1023 & 99999999[10:20:28]; 64805000=09307100= + ENILPTR:= 1; 64810000=09307100= + SEGMENT((L+3) DIV 4, 1, 0); 64815000=09308000= + 64820000=09309000= +COMMENT IF THE POWERS-OF-TEN TABLE HAS BEEN USED, IT IS WRITTEN OUT 64825000=09309000= + AT THIS TIME AS A TYPE 2 SEGMENT; 64830000=09310000= + IF GT1:= GT2.ADDRESS ^= 0 THEN 64835000=09311000= + BEGIN 64840000=09312000= + SGAVL:= (SGNO:= SGAVL)+1; 64845000=09312000= + GT2:= PROGDESCBLDR(2, 0, GT2.ADDRESS); 64850000=09313000= + MOVE(69, TEN, EDOC[0, 0]); 64855000=09314000= + BUILDLINE:= BOOLEAN(2*REAL(BUILDLINE)); 64860000=09314100= + SEGMENT(-69, SGNO, 0); 64865000=09315000= + BUILDLINE:= BUILDLINE.[46:1]; 64870000=09315100= + END; 64875000=09316000= + BEGIN 64880000=09317000= + ARRAY 64885000=09317000= + PRT[0:7, 0:127], 64890000=09317000= + SEGDICT[0:7, 0:127]; 64895000=09317000= + INTEGER 64900000=09318000= + PRTADR, 64905000=09318000= + SEGMNT, 64910000=09318000= + LINK; 64915000=09318000= + 64920000=09333000= +COMMENT THE PRT AND SEGMENT DICTIONARY ARE NOW BUILT; 64925000=09333000= + FOR I:= 0 STEP 1 UNTIL PDINX-1 DO 64930000=09348000= + IF(GT1:= PDPRT[I.[37:5], I.[42:6]]).[38:10] = 0 THEN 64935000=09349000= + BEGIN 64940000=09350000= + PRTADR:= GT1.[8:10]; 64945000=09350000= + SEGMNT:= GT1.[28:10]; 64950000=09350000= + LINK:= SEGDICT[SEGMNT.[36:5], SEGMNT.[41:7]].[8:10]; 64955000=09351000= + MDESC(GT1.[18:10] & SEGMNT[18:33:15] & 64960000=09354100= + (IF LINK = 0 THEN SEGMNT+2048 ELSE LINK)[6:36:12] & 64965000=09354100= + GT1[4:4:2] & 5[1:45:3], 64970000=09354100= + PRT[PRTADR DIV 128, PRTADR MOD 128]); 64975000=09354100= + SEGDICT[SEGMNT.[36:5], SEGMNT.[41:7]].[8:10]:= PRTADR; 64980000=09355000= + END 64985000=09357000= + ELSE 64990000=09357000= + BEGIN 64995000=09357000= + SEGMNT:= GT1.[28:10]; 65000000=09357000= + SEGDICT[SEGMNT.[36:5], SEGMNT.[41:7]]:= 65005000=09359000= + SEGDICT[SEGMNT.[36:5], SEGMNT.[41:7]] & GT1[23:38:10] & 65010000=09360000= + GT1[33:13:15] & GT1[4:3:1] & GT1[1:1:2]; 65015000=09360000= + END; 65020000=09361000= + COMMENT SET UP NEWINX = TOTAL SEGMENT SIZE; 65025000=09361005= + NEWINX:= AKKUM; 65030000=09361005= + COMMENT CODE TO ADD IN CORE STORAGE REQUIREMENTS; 65035000=09361010= + GTI1:= 0; 65040000=09361020= + COMMENT ADD IN ARRAYS; 65045000=09361030= + GTI1:= GTI1+(IF NOOFARRAYS = 0 THEN 0 ELSE IF NOOFARRAYS <= 4 65050000=09361060= + THEN 2000 ELSE IF NOOFARRAYS <= 8 THEN 3500 ELSE 5000); 65055000=09361060= + COMMENT ADD IN SEGMENT SIZE REQUIREMENTS; 65060000=09361070= + GTI1:= GTI1+(IF NEWINX <= 1000 THEN NEWINX ELSE IF NEWINX <= 2000 65065000=09361100= + THEN 1000 ELSE NEWINX/2); 65070000=09361100= + COMMENT ADD IN STACK AND PRT; 65075000=09361110= + GTI1:= GTI1+512+PRTIMAX; 65080000=09361120= + COMMENT ADD IN JRT; 65085000=09361130= + GTI1:= GTI1+((FILENO+1)*5); 65090000=09361140= + COMMENT ADD IN I/O BUFFER REQUIREMENTS; 65095000=09361150= + GTI1:= GTI1+IOBUFFSIZE; 65100000=09361160= + COMMENT I/O SIZE CAL. IN P.IODEC; 65105000=09361160= + 65110000=09361170= + COMMENT ADD SEGMENT DICT.SIZE; 65115000=09361170= + GTI1:= GTI1+SGAVL-1; 65120000=09361180= + 65125000=09361181= +COMMENT ADD IN CORE ESTIMATE FOR SORT; 65130000=09361181= + GTI1:= GTI1+CORESZ; 65135000=09361182= + COMMENT CHECK IF TOTAL IS MORE THAN 8 MODS; 65140000=09361190= + IF GTI1 >= 32000 THEN 65145000=09361200= + GTI1:= 32000; 65150000=09361200= + COMMENT AT THIS POINT GTI1 HAS THE NEEDED TOTAL CORE REQD; 65155000=09361210= + 65160000=09393000= +COMMENT WRITE OUT FILE PARAMETER BLOCK; 65165000=09393000= + GTI1:= MIN((IDLOC-IDLOCTEMP).[33:15]+1, 128); % AHA 65170000=09394000= + MOVE(GT1, IDARRAY[0], EDOC[0, 0]); 65175000=09395000= + ZEROUT(IDARRAY[0], 0, 30); 65180000=09395500= + IDARRAY[4]:= MOVEANDBLOCK(EDOC, GT1, 0); 65185000=09396000= + IDARRAY[5]:= GT1; 65190000=09397000= + 65195000=09398000= +COMMENT WRITE OUT SEGMENT DICTIONARY; 65200000=09398000= + IDARRAY[0]:= MOVEANDBLOCK(SEGDICT, SGAVL, 1); 65205000=09399000= + IF BUILDLINE THEN 65210000=09399100= + IDARRAY[0]:= IDARRAY[0] & MOVEANDBLOCK(LDICT, SGAVL, 2) 65215000=09399150= + [18:33:15]; 65220000=09399150= + IDARRAY[1]:= SGAVL; 65225000=09400000= + 65230000=09401000= +COMMENT WRITE OUT PRT; 65235000=09401000= + IDARRAY[2]:= MOVEANDBLOCK(PRT, PRTIMAX, 3); 65240000=09402000= + IDARRAY[3]:= PRTIMAX; 65245000=09403000= + 65250000=09404000= +COMMENT MARK FIRST EXECUTABLE SEGMENT; 65255000=09404000= + IDARRAY[6]:= 1; 65260000=09405000= + 65265000=09405100= +COMMENT PASS NUMBER OF FILES; 65270000=09405100= + IDARRAY[7]:= (FILENO-1) & GTI1[18:27:15]; 65275000=09405200= + 65280000=09406000= +COMMENT WRITE DISK SEGMENT ZERO; 65285000=09406000= + GT1:= DA; 65290000=09407000= + DA:= 0; 65295000=09407000= + MOVE(30, IDARRAY[0], PRT[0, 0]); 65300000=09407000= + GT2:= MOVEANDBLOCK(PRT, 30, 6); 65305000=09407010= + DA:= GT1; 65310000=09407010= + IF CODEFILE THEN 65315000=09407020= + WRITE(LINE); 65320000=09407020= + IF SAVETIME >= 0 AND ERRORCOUNT = 0 THEN 65325000=09407050= + LOCK(CODE, SAVE); 65330000=09407100= + CLOSE(CARD, RELEASE); % RELEASE PRIMARY INPUT FILE. 65335000=09407200= + CLOSE(TAPE, RELEASE); % RELEASE SECONDARY INPUT FILE. 65340000=09407300= + LOCK(NEWTAPE, **); % CLOSE WITH CRUNCH. 65345000=09407400= + IF LISTER OR NOT NOHEADING THEN 65350000=09408000= + BEGIN 65355000=09409000= + FORMAT PAN("NUMBER OF ERRORS DETECTED =",I4,". COMPILAT" 65360000=09409200= + ,"ION TIME = ",I5," SECONDS."X22,2A4/ 65365000=09410000= + "PRT SIZE =",I4,"; TOTAL SEGMENT SIZE =",I6, 65370000=09411000= + " WORDS; DISK SIZE =",I4," SEGS; NO. PGM. SEGS =", 65375000=09412000= + I4/"ESTIMATED CORE STORAGE REQUIRED =",I6," WORDS.", 65380000=09413000= + /"ESTIMATED AUXILIARY MEMORY REQUIRED =",I6," WORDS.", 65385000=09414000= + /"NUMBER OF CARD-IMAGES PROCESSED =",F7.0); 65390000=09414100= +FOMRAT SERR("THERE WERE ",V8," SEQUENCE ERRORS"); 65395000=09414101= + MOVECHARACTERS 65400000=09415000= + (4, INFO[LASTSEQROW, LASTSEQUENCE-1], 0, GT1, 4); 65405000=09415000= + MOVECHARACTERS 65410000=09416000= + (4, INFO[LASTSEQROW, LASTSEQUENCE-1], 4, GT2, 4); 65415000=09416000= + IF CHECKTOG THEN 65420000=09416001= + WRITE(LINE[DBL], SERR, 65425000=09416006= + IF NUMSEQUENCEERRORS = 0 THEN 6"A" ELSE 6"I", IF 65430000=09416006= + NUMSEQUENCEERRORS = 0 THEN 6" NO" ELSE NUMSEQUENCEERRORS)65435000=09416006= + ; 65440000=09416006= + WRITE(LINE[DBL], PAN, ERRORCOUNT, (TIME(1)-TIME1)/60, GT1, 65445000=09419000= + GT2, PRTIMAX, AKKUM, 65450000=09419000= + IF DA <= CHUNK THEN DA ELSE((DA+CHUNK-1) DIV CHUNK)*CHUNK, 65455000=09419000= + SGAVL-1, GTI1, AUXMEMREQ, CARDCOUNT); 65460000=09419000= + END 65465000=09420000= + END 65470000=09420000= + END PROGRAM; 65475000=09420000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%65480000=09420000= + 65485000=10000000= + COMMENT THIS SECTION CONTAINS GENERATORS USED BY THE BLOCK ROUTINE; 65490000=10000000= + 65495000=10001000= + COMMENT FORMATPHRASE COMPILES A PSEUDO CODE USED BY THE OBJECT TIME 65500000=10001000= + FORMATING ROUTINES TO PRODUCE DESIRED I/O. THERE IS ONE 65505000=10002000= + WORD OF PSEUDO CODE PRODUCED FOR EACH EDITING PHRASE. IN 65510000=10003000= + ADDITION ONE WORD IS PRODUCED FOR EACH LEFT PARENTHESIS, 65515000=10004000= + RIGHT PARENTHESIS, AND STROKE. EACH SIX CHARACTERS OF 65520000=10005000= + STRING ALSO PRODUCES ONE WORD. IN ADDITION THERE IS ONE 65525000=10006000= + EXTRA WORD FOR EACH LEFT PARENTHESIS WITH NO REPEAT PART. 65530000=10007000= + THIS IS AN IMPLIED STROKE TO CONTROL END OF LINE CONDI- 65535000=10008000= + TIONS. THE WORD IS BROKEN UP INTO NINE FIELDS: 65540000=10009000= + S = [1:1], 65545000=10010000= + REPEAT = [38:10], 65550000=10011000= + SKIP = [32:6], 65555000=10012000= + CODE = [2:4], 65560000=10013000= + W = [6:6], 65565000=10014000= + W1 = [28:4], W2 = [24:4], D1 = [20:4], D2 = [16:4], 65570000=10015000= + S IS A DISTINGUISHER BETWEEN EDITING PHRASES AND OTHER 65575000=10016000= + TYPE WORDS. CODE IS THE INTERNAL CODE TO DISTINGUISH 65580000=10017000= + BETWEEN THE VARIOUS EDITING PHRASES OR BETWEEN THE OTHER 65585000=10018000= + WORDS. GIVEN S = 1 WE HAVE: 65590000=10019000= + IF CODE = 0 THEN RIGHTPAREN, 65595000=10020000= + IF CODE = 2 THEN STRING, 65600000=10021000= + IF CODE = 4 THEN LEFTPAREN, 65605000=10022000= + IF CODE = 6 THEN STROKE, 65610000=10023000= + IF CODE = 8 THEN SCALE. 65615000=10023100= + GIVEN S = 0 WE HAVE 65620000=10024000= + IF CODE = 0 THEN D, 65625000=10025000= + IF CODE=1 THEN T, 65630000=10025010= + IF CODE = 2 THEN X, 65635000=10026000= + IF CODE = 4 THEN A, 65640000=10027000= + IF CODE = 6 THEN I, 65645000=10028000= + IF CODE = 8 THEN F, 65650000=10029000= + IF CODE =10 THEN E, 65655000=10030000= + IF CODE = 11 THEN U, 65660000=10030100= + IF CODE =12 THEN O, 65665000=10031000= + IF CODE = 13 THEN V, 65670000=10031100= + IF CODE =14 THEN L, 65675000=10032000= + IF CODE = 15 THEN R, 65680000=10032100= + W IS THE FIELD WIDTH. 65685000=10033000= + FOR STRINGS [12:36] IS W CHARACTORS OF ALPHA, RIGHT 65690000=10034000= + ADJUSTED. THE REST OF THE FIELDS ARE MEANINGLESS. 65695000=10035000= + REPEAT IS THE REPEAT FIELD - FOR LEFTPARENS WITH NO 65700000=10036000= + REPEAT FIELD, REPEAT = 0. FOR RIGHTPARENS, REPEAT TELLS 65705000=10037000= + HOW MANY WORDS BACK THE CORRESPONDING LEFTPAREN IS. 65710000=10038000= + IMPLIED STROKES ARE DISTINGUISHED FROM VISIBLE STROKES BY 65715000=10039000= + A NON-ZERO REPEAT FIELDS. 65720000=10040000= + THE DESCRIPTION OF W1,W2, D1, AND D2 APPLIES ONLY TO 65725000=10041000= + FORMATING TYPES. FOR THE PURPOSES OF DESCRIPTION LET 65730000=10042000= + D BE THE DECIMAL PART. W IS, OF COURSE, THE WIDTH, 65735000=10043000= + THEN FOR D, W1=W2=D1=D2=SKIP=0. 65740000=10044000= + FOR X, W = SKIP = WIDTH MOD 64 AND W1 = WIDTH DIV 64. 65745000=10045000= + W2 = D1 = D2 =0. 65750000=10046000= + FOR T, W=(WIDTH-1) MOD 64, W1=(WIDTH-1) DIV 64, AND 65755000=10046010= + W2=D1=D2=0. 65760000=10046020= + FOR A, W1 = W, SKIP = 0 IF W < 6, OTHERWISE 65765000=10047000= + W1 = 6, SKIP = W-6, W2=D1=D2=0. 65770000=10048000= + FOR I: SKIP = IF W > 16 THEN W-16 ELSE 0. 65775000=10049000= + IF W > 8 THEN W1 = 8, W2 = W-SKIP-8. 65780000=10050000= + IF W < 8 THEN W1 = W, W2 = 0, ALWAYS D1=D2=0. 65785000=10051000= + FOR F IF D < 8 THEN D1 = D, D2=0, 65790000=10052000= + IF D > 8 THEN D1 = 8, D2=D-8, 65795000=10053000= + IF D >16 THEN ERROR. 65800000=10054000= + IF W-D-1 > 16 THEN SKIP = W-D-17, OTHERWISE 65805000=10055000= + SKIP=0. 65810000=10056000= + IF W-D-1 > 8 THEN W1=8, W2=W-D-1-SKIP-8, 65815000=10057000= + IF W-D-1 < 8 THEN W1=W-D-1,W2=0. 65820000=10058000= + FOR E D1 AND D2 ARE CALCULATED AS IN F EXCEPT THAT WE 65825000=10059000= + D+1 FOR D, SKIP = W-D-6, W1=W2=0. 65830000=10060000= + FOR O, W1=W2=D1=D2=SKIP=0, 65835000=10061000= + FOR L, W2=D1=D2=0, IF W > 5 THEN W1=5 ELSE W1 = W, 65840000=10062000= + SKIP = W-W1, 65845000=10063000= + FOR U: SKIP = W1 = W2 = D1 = D2 = 0. 65850000=10063100= + FOR B: SEE U-PHRASE DESCRIPTION. 65855000=10063110= + FOR R: SEE ABOVE F-PHRASE DESCRIPTION. 65860000=10063200= + FOR V: SKIP = W1 = W2 = UNSET, D1,D2 AS IN ABOVE 65865000=10063300= + F-PHRASE DESCRIPTION. 65870000=10063400= + FORMATPHRASE USES RECURSION TO DO ANALYSIS OF SYNTAX. THE65875000=10064000= + WORDS ARE GENERATED AND PLACED DIRECTLY INTO THE CODE 65880000=10065000= + BUFFER. FORMATPHRASE IS A BOOLEAN PROCEDURE WHICH REPORTS65885000=10066000= + IF IT NOTICES AN ERROR; 65890000=10067000= + PROCEDURE WHIPOUT(W); 65895000=10068000= + VALUE 65900000=10068000= + W; 65905000=10068000= + REAL 65910000=10068000= + W; 65915000=10068000= + BEGIN 65920000=10069000= + MOVE(1, W, EDOC(F.[38:3], F.[41:7]]);IF DEBUGTOG THEN BEGIN 65925000=10075000= + DEBUGWORD(B2D(F), W, LIN);WRITELINE 65930000=10075000= + END; 65935000=10075000= + IF(F:= F+1) > 1024 THEN 65940000=10076000= + FLAG(307); 65945000=10076000= + END WHIPOUT; 65950000=10082000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%65955000=10082000= + BOOLEAN PROCEDURE FORMATPHRASE; 65960000=10083000= + BEGIN 65965000=10084000= + LABEL 65970000=10085000= + EL, 65975000=10085000= + EX, 65980000=10085000= + EXIT, 65985000=10085000= + L1, 65990000=10085000= + L2, 65995000=10085000= + L3; 66000000=10085000= + PROCEDURE 66005000=10086000= + EMITFORMAT(S, CODE, REPEAT, SKIP, W, W1, W2, D1, D2); 66010000=10086000= + VALUE 66015000=10087000= + S, 66020000=10087000= + CODE, 66025000=10087000= + REPEAT, 66030000=10087000= + SKIP, 66035000=10087000= + W, 66040000=10087000= + W1, 66045000=10087000= + W2, 66050000=10087000= + D1, 66055000=10087000= + D2; 66060000=10087000= + REAL 66065000=10088000= + CODE, 66070000=10088000= + REPEAT, 66075000=10088000= + SKIP, 66080000=10088000= + W, 66085000=10088000= + W1, 66090000=10088000= + W2, 66095000=10088000= + D1, 66100000=10088000= + D2; 66105000=10088000= + BOOLEAN 66110000=10089000= + S; 66115000=10089000= + BEGIN 66120000=10090000= + IF W > 63 THEN 66125000=10090000= + FLAG(163); 66130000=10090000= + W:= REPEAT & W[6:42:6] & SKIP[32:42:6] & W1[28:44:4] & W2[24:44:4]66135000=10095000= + & D1[20:44:4] & D2[16:44:4] & CODE[2:44:4] & REAL(S)[1:47:1]; 66140000=10098000= + WHIPOUT(W) 66145000=10099000= + END EMITFORMAT; 66150000=10099000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%66155000=10099000= + STREAM PROCEDURE PACKALPHA(PLACE, LETTER, CTR); 66160000=10100000= + VALUE 66165000=10101000= + LETTER, 66170000=10101000= + CTR; 66175000=10101000= + BEGIN 66180000=10102000= + DI:= PLACE; 66185000=10102000= + DS:= LIT 6"B"; 66190000=10102000= + SI:= LOC CTR; 66195000=10103000= + SI:= SI+7; 66200000=10103000= + DS:= CHR; 66205000=10103000= + SI:= PLACE; 66210000=10104000= + SI:= SI+3; 66215000=10104000= + DS:= 5 CHR; 66220000=10104000= + SI:= LOC LETTER; 66225000=10105000= + SI:= SI+7; 66230000=10105000= + DS:= CHR 66235000=10105000= + END PACKALPHA; 66240000=10105000= + INTEGER 66245000=10106000= + REPEAT, 66250000=10106000= + SKIP, 66255000=10106000= + W, 66260000=10106000= + W1, 66265000=10106000= + W2, 66270000=10106000= + D1, 66275000=10106000= + D2, 66280000=10106000= + CODE; 66285000=10106000= + BOOLEAN 66290000=10106000= + S; 66295000=10106000= + DEFINE 66300000=10107000= + RRIGHT = 0 #, 66305000=10108000= + RLEFT = 4 #, 66310000=10109000= + RSTROKE = 6 #; 66315000=10109000= + DEFINE 66320000=10109500= + RSCALE = 8 #, 66325000=10109500= + RU = 11 #, 66330000=10109500= + RV = 13 #, 66335000=10109500= + RR = 15 #; 66340000=10109500= + DEFINE 66345000=10110000= + RD = 0 #, 66350000=10110000= + RX = 2 #, 66355000=10110000= + RA = 4 #, 66360000=10110000= + RI = 6 #, 66365000=10110010= + RT = 1 #, 66370000=10111000= + RF = 8 #, 66375000=10111000= + RE = 10 #, 66380000=10111000= + RO = 12 #, 66385000=10111000= + RL = 14 #; 66390000=10111000= + IF ELCLASS < 0 THEN 66395000=10112000= + BEGIN 66400000=10112000= + REPEAT:= -ELCLASS; 66405000=10112000= + NEXTENT; 66410000=10112000= + IF ELCLASS = 6"," OR ELCLASS = 6")" THEN 66415000=10112100= + GO EX 66420000=10113000= + END 66425000=10113000= + ELSE 66430000=10113000= + BEGIN 66435000=10113000= + REPEAT:= REAL(ELCLASS ^= 6"<"); 66440000=10113000= + IF ELCLASS = 6"*" THEN 66445000=10113100= + BEGIN 66450000=10113100= + REPEAT.[12:1]:= 1; 66455000=10113100= + NEXTENT; 66460000=10113200= + END 66465000=10113300= + END; 66470000=10113300= + IF ELCLASS = 6"(" OR ELCLASS = 6"<" THEN 66475000=10115000= + BEGIN 66480000=10115000= + SKIP:= F; 66485000=10116000= + EMITFORMAT(TRUE, RLEFT, REPEAT, 1, 0, 0, 0, 0, 0); 66490000=10117000= + DO BEGIN 66495000=10118000= + NEXTENT; 66500000=10118000= + EL: IF FORMATPHRASE THEN 66505000=10119000= + GO TO EX 66510000=10120000= + END 66515000=10120000= + UNTIL ELCLASS ^= 6","; 66520000=10120000= + WHILE ELCLASS = 6"/" DO 66525000=10122000= + BEGIN 66530000=10122000= + EMITFORMAT(TRUE, RSTROKE, 0, 1, 0, 0, 0, 0, 0); 66535000=10122000= + NEXTENT 66540000=10123000= + END; 66545000=10123000= + IF ELCLASS ^= 6")" AND ELCLASS ^= 6">" THEN 66550000=10124100= + GO TO EL; 66555000=10124100= + IF LASTELCLASS = 6"," THEN 66560000=10124200= + GO TO EX; 66565000=10124200= + IF REPEAT = 0 THEN 66570000=10125000= + EMITFORMAT(TRUE, RSTROKE, 1, 0, 0, 0, 0, 0, 0); 66575000=10126000= + REPEAT:= F-SKIP; 66580000=10127000= + F:= SKIP; 66585000=10127000= + WHIPOUT(EDOC[F.[38:3], F.[41:7]] & REPEAT[28:38:10]); 66590000=10127100= + F:= SKIP+REPEAT; 66595000=10127200= + S:= TRUE; 66600000=10127200= + CODE:= RRIGHT 66605000=10127200= + END 66610000=10128000= + ELSE 66615000=10128000= + IF ELCLASS = 6"0" THEN 66620000=10129000= + BEGIN 66625000=10129000= + CODE:= RO; 66630000=10129000= + W:= 8 66635000=10129000= + END 66640000=10130000= + ELSE 66645000=10130000= + IF ELCLASS = 6"D" THEN 66650000=10131000= + BEGIN 66655000=10131000= + CODE:= RD; 66660000=10131000= + W:= 8 66665000=10131000= + END 66670000=10132000= + ELSE 66675000=10132000= + IF ELCLASS = 6"," THEN 66680000=10132000= + GO TO L2 66685000=10133000= + ELSE 66690000=10133000= + IF ELCLASS = 6"/" THEN 66695000=10133000= + GO TO EXIT 66700000=10134000= + ELSE 66705000=10134000= + IF ELCLASS = 6")" OR ELCLASS = 6">" THEN 66710000=10134000= + IF LASTELCLASS = 6"," THEN 66715000=10134100= + GO EX 66720000=10134100= + ELSE 66725000=10134100= + GO EXIT 66730000=10134500= + ELSE 66735000=10134500= + IF ELCLASS = 6"S" THEN 66740000=10134500= + BEGIN 66745000=10134510= + NEXTENT; 66750000=10134520= + W:= 66755000=10134530= + IF ELCLASS = 6"-" THEN 66760000=10134530= + 1 66765000=10134530= + ELSE 66770000=10134530= + 0; 66775000=10134530= + IF ELCLASS = 6"+" OR ELCLASS = 6"-" THEN 66780000=10134540= + NEXTENT; 66785000=10134540= + IF ELCLASS = 6"*" THEN 66790000=10134545= + REPEAT.[12:1]:= 1 66795000=10134545= + ELSE 66800000=10134545= + IF ELCLASS > 0 THEN 66805000=10134550= + BEGIN 66810000=10134550= + ERR(136); 66815000=10134550= + GO TO EXIT 66820000=10134570= + END 66825000=10134580= + ELSE 66830000=10134580= + REPEAT:= -ELCLASS; 66835000=10134580= + EMITFORMAT(TRUE, RSCALE, REPEAT, 0, W, 0, 0, 0, 0); 66840000=10134590= + GO TO L2 66845000=10134610= + END 66850000=10135000= + ELSE 66855000=10135000= + IF ELCLASS = 6""" THEN 66860000=10136000= + BEGIN 66865000=10136000= + IF REPEAT ^= 1 THEN 66870000=10136500= + FLAG(136); 66875000=10136500= + CODE:= 100; 66880000=10137000= + DO BEGIN 66885000=10138000= + SKIP:= 1; 66890000=10139000= + DO BEGIN 66895000=10140000= + RESULT:= 5; 66900000=10140000= + COUNT:= 0; 66905000=10140000= + SCANNER; 66910000=10140000= + IF ELCLASS:= ACCUM[1].[18:6] = CODE THEN 66915000=10142000= + BEGIN 66920000=10142000= + IF SKIP ^= 1 THEN 66925000=10143000= + WHIPOUT(W); 66930000=10143000= + GO TO L2 66935000=10144000= + END; 66940000=10144000= + CODE:= 6"""; 66945000=10145000= + PACKALPHA(W, ELCLASS, SKIP); 66950000=10146000= + END 66955000=10147000= + UNTIL SKIP:= SKIP+1 = 7; 66960000=10147000= + WHIPOUT(W) 66965000=10149000= + END 66970000=10149000= + UNTIL FALSE 66975000=10149000= + END 66980000=10150000= + ELSE 66985000=10150000= + BEGIN 66990000=10150000= + CODE:= ELCLASS; 66995000=10150000= + IF CODE = 6"U" OR CODE = 6"B" THEN 67000000=10150100= + BEGIN %%% ALL OF COMPILER CODE TO HANDLE U-PHRASE. 67005000=10150110= + NEXTENT; 67010000=10150120= + SKIP:= 0; 67015000=10150125= + IF ELCLASS = 6"*" OR ELCLASS <= 0 THEN 67020000=10150130= + BEGIN %%% PHRASE IS AT LEAST UW OR U*. 67025000=10150135= + IF ELCLASS = 6"*" THEN 67030000=10150140= + REPEAT.[13:1]:= 1 67035000=10150145= + ELSE 67040000=10150145= + W:= -ELCLASS; 67045000=10150145= + NEXTENT; 67050000=10150150= + IF ELCLASS = 6"." THEN 67055000=10150155= + BEGIN %%% PHRASE IS AT LEAST UW. OR U*.. 67060000=10150160= + NEXTENT; 67065000=10150165= + IF ELCLASS = 6"*" OR ELCLASS <= 0 THEN 67070000=10150170= + BEGIN %%% PHRASE IS UW*.D*. 67075000=10150175= + IF ELCLASS = 6"*" THEN 67080000=10150185= + REPEAT.[14:1]:= 1 67085000=10150190= + ELSE 67090000=10150190= + SKIP:= -ELCLASS; 67095000=10150190= + NEXTENT; 67100000=10150195= + END 67105000=10150205= + ELSE 67110000=10150205= + GO TO EX 67115000=10150210= + END 67120000=10150220= + END 67125000=10150220= + ELSE 67130000=10150220= + W:= -63; %%% PHRASE IS D. 67135000=10150220= + EMITFORMAT(FALSE, RD, REPEAT, SKIP, W, REAL(CODE = 6"B"), 67140000=10150230= + REAL(W < 0), 0, 0); 67145000=10150230= + GO TO EXIT; 67150000=10150260= + END OF U PHRASE HANDLER; 67155000=10150270= + IF GETINT THEN 67160000=10150280= + BEGIN 67165000=10150280= + W:= 11; 67170000=10150280= + REPEAT.[13:1]:= 1 67175000=10150280= + END 67180000=10150290= + ELSE 67185000=10150290= + ELCLASS:= -(W:= ELCLASS); 67190000=10150290= + IF CODE = 6"I" THEN 67195000=10152000= + BEGIN 67200000=10152000= + SKIP:= DIVIDE(W, W1, W2); 67205000=10153000= + CODE:= RI 67210000=10153000= + END 67215000=10154000= + ELSE 67220000=10154000= + IF CODE = 6"F" THEN 67225000=10155000= + BEGIN 67230000=10155000= + CODE:= RF; 67235000=10155000= + GO TO L1 67240000=10155000= + END 67245000=10155500= + ELSE 67250000=10155500= + IF CODE = 6"R" THEN 67255000=10155500= + BEGIN 67260000=10155500= + CODE:= RR; 67265000=10155500= + GO TO L1 67270000=10155500= + END 67275000=10156000= + ELSE 67280000=10156000= + IF CODE = 6"E" THEN 67285000=10157000= + BEGIN 67290000=10157000= + CODE:= RE; 67295000=10157000= + D1:= 1; 67300000=10157000= + L1: NEXTENT; 67305000=10158000= + IF ELCLASS ^= 6"." THEN 67310000=10159000= + GO EX; 67315000=10159000= + IF GETINT THEN 67320000=10159100= + BEGIN 67325000=10159100= + ELCLASS:= 3; 67330000=10159100= + REPEAT.[14:1]:= 1 67335000=10159100= + END; 67340000=10159100= + IF DIVIDE(ELCLASS+D1, D1, D2) > 0 THEN 67345000=10160000= + GO TO EX; 67350000=10160000= + IF CODE = RF OR CODE = RR THEN 67355000=10161000= + SKIP:= DIVIDE(W-ELCLASS-1, W1, W2) 67360000=10162000= + ELSE 67365000=10162000= + IF SKIP:= W-ELCLASS-6 < 0 THEN 67370000=10162000= + GO TO EX 67375000=10163000= + END 67380000=10163000= + ELSE 67385000=10163000= + IF CODE = 6"X" THEN 67390000=10164000= + BEGIN 67395000=10164000= + CODE:= RX; 67400000=10164000= + W1:= W.[38:4]; 67405000=10164000= + SKIP:= W:= W.[42:6] 67410000=10165000= + END 67415000=10165500= + ELSE 67420000=10165500= + IF CODE = 6"T" THEN 67425000=10165500= + IF W:= ABS(W)-1 < 0 THEN 67430000=10165500= + FLAG(136) 67435000=10165505= + ELSE 67440000=10165505= + BEGIN 67445000=10165505= + CODE:= RT; 67450000=10165505= + W1:= W.[38:4]; 67455000=10165505= + W:= W.[42:6] 67460000=10165505= + END 67465000=10166000= + ELSE 67470000=10166000= + IF CODE = 6"A" THEN 67475000=10167000= + BEGIN 67480000=10167000= + CODE:= RA; 67485000=10167000= + W1:= 6; 67490000=10167000= + GO TO L3 67495000=10167000= + END 67500000=10167100= + ELSE 67505000=10167100= + IF CODE = 6"V" THEN 67510000=10167100= + BEGIN 67515000=10167200= + CODE:= RV; 67520000=10167200= + COUNT:= ACCUM[1]:= 0; 67525000=10167300= + IF EXAMIN(NCR) = 6" " THEN 67530000=10167400= + BEGIN 67535000=10167500= + RESULT:= 7; 67540000=10167500= + SCANNER 67545000=10167500= + END; 67550000=10167500= + IF EXAMIN(NCR) = 6"." THEN 67555000=10167600= + BEGIN 67560000=10167700= + NEXTENT; 67565000=10167700= + IF GETINT THEN 67570000=10167800= + REPEAT.[14:1]:= 1 67575000=10167800= + ELSE 67580000=10167800= + GT1:= DIVIDE(ELCLASS, D1, D2); 67585000=10167900= + ELCLASS:= -ELCLASS; 67590000=10167910= + END; 67595000=10168000= + END 67600000=10168000= + ELSE 67605000=10168000= + IF CODE = 6"L" THEN 67610000=10169000= + BEGIN 67615000=10169000= + CODE:= RL; 67620000=10169000= + W1:= 5; 67625000=10169000= + L3: IF W < W1 THEN 67630000=10170000= + W1:= W; 67635000=10170000= + SKIP:= W-W1 67640000=10170000= + END 67645000=10170000= + ELSE 67650000=10170000= + GO EX 67655000=10170000= + END; 67660000=10170000= + EMITFORMAT(S, CODE, REPEAT, SKIP, W, W1, W2, D1, D2); 67665000=10171000= +L2: NEXTENT; 67670000=10172000= + GO TO EXIT; 67675000=10172000= +EX: FORMATPHRASE:= TRUE; 67680000=10173000= + ERR(136); 67685000=10173000= +EXIT: 67690000=10174000= + END FORMATPHRASE; 67695000=10174000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%67700000=10174000= + 67705000=10175000= + COMMENT GETINT DOES A CALL ON NEXTEND AND CHECKS TO SEE IF AN INTEGER 67710000=10175000= + WAS THE RESULT: IF NOT ERROR - OTHERWISE MAKE SIGN PLUS; 67715000=10176000= + BOOLEAN PROCEDURE GETINT; 67720000=10177000= + BEGIN 67725000=10178000= + NEXTENT; 67730000=10178000= + IF ELCLASS:= -ELCLASS < 0 THEN 67735000=10178000= + IF ELCLASS = -(6"*") THEN 67740000=10178100= + GETINT:= TRUE 67745000=10178100= + ELSE 67750000=10178100= + BEGIN 67755000=10179000= + FLAG(137); 67760000=10179000= + ELCLASS:= 0 67765000=10179000= + END 67770000=10180000= + END GETINT; 67775000=10180000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%67780000=10180000= + 67785000=10181000= + COMMENT DIVIDE PARTIONS THE PARAMETER NUMBER INTO THREE PARTS. THE 67790000=10181000= + RESULT IS PASSED BACK THROUGH P1,P2, AND THE FUNCTION 67795000=10182000= + IDENTIFIER. SEE CODE FOR DETAILS; 67800000=10183000= + INTEGER PROCEDURE DIVIDE(NUMBER, P1, P2); 67805000=10184000= + VALUE 67810000=10185000= + NUMBER; 67815000=10185000= + INTEGER 67820000=10185000= + P1, 67825000=10185000= + P2, 67830000=10185000= + NUMBER; 67835000=10185000= + BEGIN 67840000=10186000= + IF NUMBER < 0 THEN 67845000=10187000= + BEGIN 67850000=10187000= + FLAG(138); 67855000=10187000= + ERRORTOG:= TRUE; 67860000=10187000= + NUMBER:= 0 67865000=10188000= + END; 67870000=10188000= + P1:= 67875000=10189000= + IF NUMBER < 8 THEN 67880000=10189000= + NUMBER 67885000=10189000= + ELSE 67890000=10189000= + 8; 67895000=10189000= + NUMBER:= NUMBER-P1; 67900000=10190000= + P2:= 67905000=10191000= + IF NUMBER < 8 THEN 67910000=10191000= + NUMBER 67915000=10191000= + ELSE 67920000=10191000= + 8; 67925000=10191000= + DIVIDE:= NUMBER-P2 67930000=10192000= + END DIVIDE; 67935000=10192000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%67940000=10192000= + 67945000=10193000= + COMMENT DEFINEGEN PACKS THE ALPHA FOR A DEFINE INTO INFO. DEFINEGEN 67950000=10193000= + PRINCIPALLY ELIMINATES BLANKS AND COMMENTS. PUTOGETHER 67955000=10194000= + ACTUALLY DOES THE MECHANICAL WORK OF PROCESSING THE 67960000=10195000= + CHARACTORS FROM ACCUM TO INFO. THE FINAL TRANSFER IS DONE67965000=10196000= + IN PACKINFO. THE OTHER FUNCTION SERVED BY DEFINEGEN IS 67970000=10197000= + THAT OF COUNTING DEFINES AND CROSSHATCHES IN ORDER TO 67975000=10198000= + ALLOW NESTED DEFINES. 67980000=10199000= + A WORD ON THE OVERALL PLAN OF ATTACK ON HANDLEING 67985000=10200000= + DEFINES: 67990000=10201000= + THERE ARE FOUR PLACES THAT THERE IS CODE WRITTEN 67995000=10202000= + EXPLICITLY FOR THE DEFINE. 68000000=10203000= + FIRST IS DEFINEGEN WHICH LOADS THE ALPHA INTO INFO. 68005000=10204000= + SECOND IS IN THE TABLE ROUTINE AFTER A DEFINED ID IS 68010000=10205000= + NOTICED. HERE A SETUP IS PERFORMED SO THAT THE SCANNER 68015000=10206000= + WILL SCAN INFO. SINCE INFO (UNLIKE I/O BUFFERS) IS NOT 68020000=10207000= + A SAVE ARRAY, WE CAN NOT DIRECTLY SCAN INFO. INSTEAD WE 68025000=10208000= + FOOL READACARD SO TAHT THE ALPHA IS FETCHED FRO INFO AND 68030000=10209000= + PLACED INTO A SMALL SAVE ARRAY (DEFINEARRAY) INSTEAD OF 68035000=10210000= + BEING FETCHED FROM AN I/O DEVICE. NATURALLY WE MUST HAVE 68040000=10211000= + NESTING WHICH IS OBTAINED BY USING DEFINEARRAY AS A SMALL 68045000=10212000= + STACK. THE QUANTITIES SAVE ARE LCR,NCR, AND LASTUSED. 68050000=10213000= + LASTUSED DOUBLES AS A DEVICE FOR DIRECTING THE FLOW OF 68055000=10214000= + INFORMATION FROM I/O GEAR AND FROM INFO DURING ANALYSIS OF68060000=10215000= + DEFINES. THIS STACKING IS DONE HERE BY THE TABLE ROUTINE.68065000=10216000= + THIRD IS READACARD WHICH HAS NOW BEEN FAIRLY WELL 68070000=10217000= + DESCRIBED. THE ONLY ADDITIONAL COMMENT NECESSARY IS THAT 68075000=10218000= + LASTUSED SERVES AS AN INDEX TO FETCH NEXT WORD OF ALPHA 68080000=10219000= + FROM INFO. READACARD FETCHES ONLY ONE WORD AT A TIME. 68085000=10220000= + FOURTH IS ALSO IN THE TABLE ROUTINE. IT IS AT THE 68090000=10221000= + PLACE THAT A CROSSHATCH IS NOTICED. IT CAUSES AN UNSETUP 68095000=10222000= + SO THAT THE SCANNER WILL STOP SCANNING THAT PART OF INFO 68100000=10223000= + AND RESUME ITS PREVIOUS TASKS. A DISTINCTION IS MADE 68105000=10224000= + BETWEEN CROSSHATCHES SCANNED AFTER A DEFINE DECLARATION 68110000=10225000= + AND THOSE SCANNED DURING THE RECALL PROCESS. THE LATER 68115000=10226000= + ONLY CAUSES AN UNSETUP; 68120000=10227000= + PROCEDURE DEFINEGEN(MACRO, J); 68125000=10228000= + VALUE 68130000=10228000= + MACRO, 68135000=10228000= + J; 68140000=10228000= + BOOLEAN 68145000=10228000= + MACRO; 68150000=10228000= + REAL 68155000=10228000= + J; 68160000=10228000= + BEGIN 68165000=10229000= + OWN INTEGER 68170000=10230000= + CHARCOUNT, 68175000=10230000= + REMCOUNT; 68180000=10230000= + COMMENT CHARCOUNT CONTAINS NUMBER OFCHARACTORS OF THE DEFINE THAT WE68185000=10231000= + HAVE PUT INTO INFO. REMCOUNT CONTAINS NUMBER OF CHARACT- 68190000=10232000= + ORS REMAINING IN THIS ROW OF INFO; 68195000=10233000= + PROCEDURE PUTOGETHER(CHAR); 68200000=10234000= + REAL 68205000=10234000= + CHAR; 68210000=10234000= + BEGIN 68215000=10235000= + STREAM PROCEDURE PACKINFO(INFO, ISKIP, COUNT, ASKIP, ACCUM); 68220000=10236000= + VALUE 68225000=10237000= + ISKIP, 68230000=10237000= + COUNT, 68235000=10237000= + ASKIP; 68240000=10237000= + BEGIN 68245000=10238000= + DI:= INFO; 68250000=10238000= + DI:= DI+ISKIP; 68255000=10238000= + SI:= ACCUM; 68260000=10239000= + SI:= SI+ASKIP; 68265000=10239000= + SI:= SI+3; 68270000=10239000= + DS:= COUNT CHR 68275000=10240000= + END PACKINFO; 68280000=10240000= + INTEGER 68285000=10241000= + COUNT, 68290000=10241000= + SKIPCOUNT; 68295000=10241000= + IF(COUNT:= CHAR.[12:6])+CHARCOUNT > 2047 THEN 68300000=10243000= + BEGIN 68305000=10243000= + FLAG(142); 68310000=10243000= + TB1:= TRUE 68315000=10243000= + END 68320000=10244000= + ELSE 68325000=10244000= + BEGIN 68330000=10244000= + IF COUNT > REMCOUNT THEN 68335000=10246000= + BEGIN 68340000=10246000= + SKIPCOUNT:= COUNT-(COUNT:= REMCOUNT); 68345000=10247000= + REMCOUNT:= 2048 68350000=10248000= + END 68355000=10249000= + ELSE 68360000=10249000= + REMCOUNT:= REMCOUNT-COUNT; 68365000=10249000= + GT1:= CHARCOUNT DIV 8:= NEXTTEXT; 68370000=10250000= + PACKINFO(TEXT[GT1.LINKR, GT1.LINKC], CHARCOUNT.[45:3], 68375000=10252000= + COUNT, 00, CHAR); 68380000=10252000= + IF SKIPCOUNT ^= 0 THEN 68385000=10253000= + PACKINFO 68390000=10255000= + (TEXT[NEXTTEXT.LINKR+1, 0], 0, SKIPCOUNT, COUNT, CHAR); 68395000=10255000= + CHARCOUNT:= CHARCOUNT+SKIPCOUNT+COUNT 68400000=10256000= + END 68405000=10257000= + END PUTOGETHER; 68410000=10257000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%68415000=10257000= + INTEGER 68420000=10258000= + LASTRESULT; 68425000=10258000= + REAL 68430000=10258100= + K, 68435000=10258100= + N, 68440000=10258100= + ELCLASS; 68445000=10258100= + DEFINE 68450000=10258200= + I = NXTELBT #; 68455000=10258200= + LABEL 68460000=10258300= + FINAL, 68465000=10258300= + PACKIN; 68470000=10258300= + LABEL 68475000=10259000= + BACK, 68480000=10259000= + SKSC, 68485000=10259000= + EXIT; 68490000=10259000= + REAL 68495000=10259200= + DINFO; 68500000=10259200= + BOOLEAN 68505000=10259400= + TSSTREAMTOG; % 1289 68510000=10259400= + DINFO:= J.[18:15]; 68515000=10259600= + J:= J.[33:15]; 68520000=10259700= + TB1:= FALSE; 68525000=10260000= + TSSTREAMTOG:= STREAMTOG; % 1289 68530000=10260050= + STREAMTOG:= TRUE; 68535000=10260100= + CHARCOUNT:= 0; 68540000=10261000= + DEFINECTR:= 1; 68545000=10262000= + LASTRESULT:= 2; 68550000=10262000= + REMCOUNT:= (256-NEXTTEXT.LINKC)*8; 68555000=10263000= + K:= 0; 68560000=10263200= +BACK: 68565000=10263300= + STOPDEFINE:= TRUE; 68570000=10263300= + ELCLASS:= TABLE(NXTELBT); 68575000=10263400= +SKSC: 68580000=10263500= + NXTELBT:= NXTELBT-1; 68585000=10263500= + IF MACRO THEN 68590000=10263600= + BEGIN 68595000=10263700= + IF ELCLASS = COMMA THEN 68600000=10263700= + IF K = 0 THEN 68605000=10263800= + FINAL: 68610000=10263900= + BEGIN 68615000=10263900= + PUTOGETHER(6"1#0000"); 68620000=10263900= + GO TO EXIT 68625000=10263900= + END 68630000=10264000= + ELSE 68635000=10264000= + GO PACKIN; 68640000=10264000= + IF ELCLASS = LEFTPAREN OR ELCLASS = LFTBRKET THEN 68645000=10264100= + BEGIN 68650000=10264200= + K:= K+1; 68655000=10264200= + GO TO PACKIN 68660000=10264200= + END; 68665000=10264200= + IF ELCLASS = RTPAREN OR ELCLASS = RTBRKET THEN 68670000=10264300= + IF K:= K-1 < 0 THEN 68675000=10264400= + GO FINAL 68680000=10264400= + ELSE 68685000=10264400= + GO PACKIN; 68690000=10264400= + IF ELCLASS = SEMICOLON THEN 68695000=10264410= + BEGIN 68700000=10264420= + FLAG(142); 68705000=10264420= + GO TO FINAL 68710000=10264420= + END 68715000=10264420= + ELSE 68720000=10264420= + GO PACKIN 68725000=10264500= + END; 68730000=10264500= + IF RESULT = 1 THEN 68735000=10264600= + IF J ^= 0 THEN 68740000=10264600= + FOR N:= 1 STEP 1 UNTIL J DO 68745000=10264650= + BEGIN 68750000=10264700= + IF EQUAL(ACCUM[1].[12:6]+3, ACCUM[1].DEFINFO[(N-1)*10]) THEN 68755000=10264760= + BEGIN 68760000=10264800= + DEFINEPARAM(DINFO+1, N); 68765000=10264810= + GO PACKIN; 68770000=10264820= + END; 68775000=10264830= + END; 68780000=10264900= +PACKIN: 68785000=10265000= + IF RESULT = 4 THEN 68790000=10266000= + BEGIN 68795000=10266000= + COMMENT INSERT " MARKS - 2130706432 IS DECIMAL FOR 1"0000; 68800000=10267000= + PUTOGETHER(2130706432); 68805000=10268000= + PUTOGETHER(ACCUM[1]); 68810000=10269000= + PUTOGETHER(2130706432) 68815000=10270000= + END 68820000=10271000= + ELSE 68825000=10271000= + BEGIN 68830000=10271000= + IF BOOLEAN(RESULT) AND BOOLEAN(LASTRESULT) THEN 68835000=10273000= + PUTOGETHER(6"1 0000"); 68840000=10273000= + COMMENT INSERT BLANK; 68845000=10273000= + PUTOGETHER(ACCUM[1]) 68850000=10274000= + END; 68855000=10274000= + IF TB1 THEN 68860000=10275000= + GO TO EXIT; 68865000=10275000= + LASTRESULT:= RESULT; 68870000=10276000= + IF MACRO THEN 68875000=10276500= + GO BACK; 68880000=10276500= + IF ELCLASS = DECLARATORS AND ELBAT[I].ADDRESS = DEFINEV THEN 68885000=10278000= + BEGIN 68890000=10278000= + DEFINECTR:= DEFINECTR+1; 68895000=10278000= + GO BACK 68900000=10278000= + END; 68905000=10278000= + IF ELCLASS ^= CROSSHATCH THEN 68910000=10279000= + GO BACK; 68915000=10279000= + IF DEFINECTR ^= 1 THEN 68920000=10281000= + BEGIN 68925000=10281000= + STOPDEFINE:= TRUE; 68930000=10281000= + IF ELCLASS:= TABLE(I) ^= COMMA THEN 68935000=10282000= + DEFINECTR:= DEFINECTR-1; 68940000=10283000= + GO SKSC 68945000=10283000= + END; 68950000=10283000= +EXIT: 68955000=10284000= + DEFINECTR:= 0; 68960000=10284000= + STREAMTOG:= TSSTREAMTOG; % 1289 68965000=10284000= + NEXTTEXT:= (CHARCOUNT+7) DIV 8+NEXTTEXT; 68970000=10285000= + END DEFINEGEN; 68975000=10286000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%68980000=10286000= + 68985000=10287000= + COMMENT LISTELEMENT IS RESPONSIBLE FOR THE GENERATION OF CODE FOR LIST68990000=10287000= + ELEMENTS; 68995000=10288000= + PROCEDURE LISTELEMENT; 69000000=10289000= + BEGIN 69005000=10290000= + REAL 69010000=10291000= + T1, 69015000=10291000= + T2, 69020000=10291000= + T3; 69025000=10291000= + LABEL 69030000=10292000= + BOOFINISH, 69035000=10292000= + STORE, 69040000=10292000= + LRTS; 69045000=10292000= + DIALA:= DIALB:= 0; 69050000=10293000= + IF ELCLASS = FORV THEN 69055000=10294000= + FORSTMT COMMENT FORCLAUSE; 69060000=10294000= + ELSE 69065000=10295000= + IF ELCLASS = LFTBRKET THEN 69070000=10296000= + BEGIN 69075000=10296000= + COMMENT GORUP OF LIST ELEMENTS; 69080000=10296000= + DO BEGIN 69085000=10297000= + STEPIT; 69090000=10297000= + LISTELEMENT 69095000=10297000= + END 69100000=10297000= + UNTIL ELCLASS ^= COMMA; 69105000=10297000= + IF ELCLASS = RTBRKET THEN 69110000=10298000= + STEPIT 69115000=10298000= + ELSE 69120000=10298000= + ERR(158) 69125000=10298000= + END 69130000=10299000= + ELSE 69135000=10299000= + BEGIN 69140000=10299000= + COMMENT THE MEAT OF THE MATTER: 69145000=10299000= + VARIABLES AND EXPRESSIONS; 69150000=10300000= + L:= (T1:= L)+1; 69155000=10301000= + COMMENT SAVE L FOR LATER FIXUP; 69160000=10301000= + EMITPAIR(LSTRTN, STD); 69165000=10302000= + COMMENT PREPARE LSTRTN FOR 69170000=10302000= + NEXT TIME AROUND; 69175000=10303000= + IF (GT1:= TABLE(I+1) = COMMA OR GT1 = RTPAREN OR GT1 = RTBRKET) 69180000=10307000= + AND ELCLASS >= BOOID AND ELCLASS <= INTID 69185000=10308000= + THEN 69190000=10308000= + BEGIN 69195000=10308000= + COMMENT SIMPLE VARIABLES; 69200000=10308000= + CHECKER(ELBAT[I]); 69205000=10308100= + EMITN(ELBAT[I].ADDRESS); 69210000=10309000= + STEPIT 69215000=10309000= + END 69220000=10310000= + ELSE 69225000=10310000= + BEGIN 69230000=10310000= + IF ELCLASS >= BOOARRAYID AND ELCLASS <= INTARRAYID THEN 69235000=10312000= + BEGIN 69240000=10312000= + COMMENT IS EITHER A SUBCRIPTED VARIABLE 69245000=10312000= + OR THE BEGINNING OF AN EXPRESSION. THIS69250000=10313000= + SITUATION IS VERY SIMILAR TO THAT IN 69255000=10314000= + ACTUALPARAPART (SEE COMMENTS THERE FOR 69260000=10315000= + FURTHER DETAILS); 69265000=10316000= + T2:= FL; 69270000=10317000= + T3:= ELCLASS; 69275000=10317000= + VARIABLE(T2); 69280000=10317000= + IF TABLE(I-2) = FACTOP AND TABLE(I-1) = RTBRKET THEN 69285000=10318000= + ERR(157); 69290000=10318000= + IF ELCLASS = COMMA OR ELCLASS = RTPAREN OR ELCLASS = RTBRKET 69295000=10321000= + THEN 69300000=10321000= + IF T2 = 0 THEN 69305000=10322000= + GO TO STORE 69310000=10322000= + ELSE 69315000=10322000= + GO TO LRTS; 69320000=10322000= + IF T3 = BOOARRAYID THEN 69325000=10323000= + GO TO BOOFINISH; 69330000=10323000= + SIMPARITH; 69335000=10324000= + IF ELCLASS = RELOP THEN 69340000=10325000= + BEGIN 69345000=10325000= + RELATION; 69350000=10325000= + BOOFINISH: 69355000=10326000= + SIMPBOO 69360000=10326000= + END 69365000=10327000= + END 69370000=10327000= + ELSE 69375000=10327000= + IF EXPRSS = DTYPE THEN 69380000=10327000= + ERR(156); 69385000=10327000= + STORE: 69390000=10328000= + EMITPAIR(JUNK, STD); 69395000=10328000= + EMITN(JUNK) 69400000=10328000= + END; 69405000=10328000= + LRTS: 69410000=10329000= + EMITO(RTS); 69415000=10329000= + CONSTANTCLEAN; 69420000=10329000= + T2:= L; 69425000=10330000= + L:= T1; 69430000=10330000= + EMITNUM(T2-LSTR); 69435000=10330000= + L:= T2 69440000=10330000= + END 69445000=10330000= + END LSTELMT; 69450000=10330000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%69455000=10330000= + 69460000=10331000= + COMMENT LISTGEN COMPILES ALL THE CODE FOR A LIST. LISTGEN CALLS 69465000=10331000= + LISTELEMENT WHICH IS RESPONSIBLE FOR EACH INDIVIDUAL 69470000=10332000= + LIST ELEMENT. LIST ELEMENT ALSO TAKES CARE TO GENERATE 69475000=10333000= + CODE WHICH UPDATES LSTRTN AFTER EACH CALL ON THE LIST. 69480000=10334000= + LISTGEN GENERATES THE CHANGING OF LSTRTN TO -1, THE END 69485000=10335000= + FLAG FOR A LIST, THE CODE TO JUMP AROUND THE LIST, 69490000=10336000= + THE INITIAL JUMP OF THE LIST, THE OBTAINING OF A PRT CELL 69495000=10337000= + FOR THE LIST, THE OBTAINING OF AN ACCIDENTAL PROGRAM 69500000=10338000= + DESCRIPTOR, THE STUFFING OF F INTO THIS DESCRIPTOR, 69505000=10339000= + LISTGEN EXPECTS I TO POINT AT FIRST LIST ELEMENT AND 69510000=10340000= + LEAVES I POINTING AT FIRST ITEM BEYOND RIGHTPAREN. THE 69515000=10341000= + VALUE RETURNED BY LISTGEN IS THE LOCATION OF THE 69520000=10342000= + ACCIDENTAL ENTRY DESCRIPTOR IN THE PRT; 69525000=10343000= + REAL PROCEDURE LISTGEN; 69530000=10344000= + BEGIN 69535000=10345000= + INTEGER 69540000=10346000= + JUMPLACE, 69545000=10346000= + LISTPLACE; 69550000=10346000= + JUMPLACE:= BAE; 69555000=10347000= + LISTGEN:= LISTPLACE:= PROGDESCBLDR(0, L, 0); 69560000=10348000= + COMMENT BUILDS ACCIDENTAL ENTRY FOR LIST; 69565000=10349000= + EMITV(LSTRTN); 69570000=10350000= + EMITO(BFW); 69575000=10350000= + LSTR:= L; 69580000=10350000= + COMMENT INITIAL JUMP OF A LIST; 69585000=10351000= + LISTMODE:= TRUE; 69590000=10352000= + COMMENT CAUSES FORSTMT TO RECOGNIZE THAT WE ARE COMPILING LISTS; 69595000=10353000= + I:= I-1; 69600000=10354000= + DO BEGIN 69605000=10355000= + STEPIT; 69610000=10356000= + LISTELEMENT 69615000=10358000= + END 69620000=10358000= + UNTIL ELCLASS ^= COMMA; 69625000=10358000= + EMITL(1); 69630000=10359000= + EMITO(CHS); 69635000=10359000= + EMITPAIR(LSTRTN, SND); 69640000=10360000= + EMITO(RTS); 69645000=10361000= + COMMENT SET END FLAG OF -1; 69650000=10362000= + CONSTANTCLEAN; 69655000=10363000= + DIALA:= DIALB:= 0; 69660000=10364000= + LISTMODE:= FALSE; 69665000=10365000= + ADJUST; 69670000=10365100= + EMITB(BFW, JUMPLACE, L); 69675000=10366000= + STUFFF(LISTPLACE); 69680000=10367000= + IF ELCLASS ^= RTPAREN THEN 69685000=10368000= + ERR(104) 69690000=10368000= + ELSE 69695000=10368000= + STEPIT 69700000=10369000= + END LISTGEN; 69705000=10369000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%69710000=10369000= + BOOLEAN PROCEDURE MERRIMAC; 69715000=10370000= + BEGIN 69720000=10371000= + COMMENT THIS TIME THE MERRIMAC WILL HANDLE THE MONITOR. 69725000=10371000= + 03 JULY 1963 69730000=10372000= + THERE ARE SIX TYPES OF MONITOR LIST ELEMENTS. THEY ARE 69735000=10373000= + LABELS, SWITCHES, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES,69740000=10374000= + ARRAYS, AND FUNCTION DESIGNATORS. 69745000=10375000= + WITH ONE EXCEPTION, THE MERRIMAX ROUTINES ONLY FUNCTION 69750000=10376000= + IS TO SAVE INFORMATION SO THAT OTHER ROUTINES, SUCH AS THE69755000=10377000= + VARIABLE ROUTINE, CAN GENERATE THE ACTUAL CODE THAT CALLS 69760000=10378000= + THE PRINTI ROUTINE AT OBJECT TIME. THE ONE EXCEPTION IS 69765000=10379000= + THE CASE OF A SUBSCRIPTED VARIABLE WITH AN EXPRESSION FOR 69770000=10380000= + A SUBSCRIPT. THE CODE FOR THE EXPRESSION IS GENERATED, AN69775000=10381000= + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR IS CREATED, AND THE 69780000=10382000= + ADDRESS OF THE DESCRIPTOR IS REMEMBERED. 69785000=10383000= + THE PRINTI ROUTINE IS AN INTRINSIC WHICH PRINTS THE 69790000=10384000= + INFORMATION IT RECEIVES ACCORDING TO A SPECIFIED FORMAT 69795000=10385000= + FOR BOTH MONITORING AND DUMPING. THE FOLLOWING CHART 69800000=10386000= + EXPLAINS THE VARIOUS ACTIONS TAKEN BY THE PRINTI ROUTINE 69805000=10387000= + AND THE PARAMETERS THAT MUST BE PASSED FOR THE FIVE 69810000=10388000= + POSSIBLE CALLS ON PRINTI. 69815000=10389000= + ID IS DEFINED TO MEAN THE FIRST SEVEN CHARACTERS OF 69820000=10390000= + THE IDENTIFIER TO BE PRINTED. 69825000=10391000= + N IS DEFINED TO MEAN THE NUMBER OF DIMENSIONS OF AN 69830000=10392000= + ARRAY OR SUBSCRIPTED VARIABLE. 69835000=10393000= + V IS DEFINED TO MEAN THE VALUE TO BE PRINTED. 69840000=10394000= + S1---SN IS DEFINED TO MEAN THE SUBSCRIPT TO BE 69845000=10395000= + PRINTED. 69850000=10396000= + S1*---SN* IS DEFINED TO MEAN THE SUBSCRIPT TO BE 69855000=10397000= + MONITORED. PRINTI COMPARES SN* TO SN AND PRINTS 69860000=10398000= + ONLY IF THEY ARE EQUAL. 69865000=10399000= + FORMAT TYPE MONITOR DUMP 69870000=10400000= + ----------- ------- ---- 69875000=10401000= + 0 LABELS 69880000=10402000= + SWITCHES 69885000=10403000= + --------- ----- -- 69890000=10404000= + 1 SIMPLE VARIABLES LABELS 69895000=10405000= + FUNCTION SIMPLE VARIABLES 69900000=10406000= + --------- ----- -- 69905000=10407000= + 2 ARRAYS SUBSCRIPTED VARS 69910000=10408000= + --------- ----- -- 69915000=10409000= + 3 SUBSCRIPTED VARS 69920000=10410000= + --------- ----- -- 69925000=10411000= + 4 ARRAYS 69930000=10412000= + ********* ***** ** 69935000=10413000= + FORMAT TYPE PRINTOUT 69940000=10414000= + ----------- -------- 69945000=10415000= + 0 ID 69950000=10416000= + --------- ----- 69955000=10417000= + 1 ID=V 69960000=10418000= + --------- ----- 69965000=10419000= + 2 ID[S1---SN]=V 69970000=10420000= + --------- ----- 69975000=10421000= + 3 ID[S1---SN]=V 69980000=10422000= + --------- ----- 69985000=10423000= + 4 ID=V1---VN 69990000=10424000= + *********** ******** 69995000=10425000= + THE FORMAT THAT V IS PRINTED IN WILL BE DETERMINED BY70000000=10426000= + THE TYPE OF V. THE FOLLOWING CONVENTIONS APPLY FOR 70005000=10427000= + PASSING THE TYPEV TO PRINTI. 70010000=10428000= + TYPE TYPEV 70015000=10429000= + ---- ----- 70020000=10430000= + BOOLEAN 0 70025000=10431000= + -- --- 70030000=10432000= + REAL 1 70035000=10433000= + -- --- 70040000=10434000= + ALPHA 2 70045000=10435000= + -- --- 70050000=10436000= + INTEGER 3 70055000=10437000= + **** ***** 70060000=10438000= + POWERSOFTEN IS A TABLE OF POWERS OF TEN THAT PRINTI 70065000=10439000= + AND OTHER ROUTINES USE FOR CONVERSION PURPOSES. 70070000=10440000= + FORMAT TYPE ACTUAL PARAMETERS TO PRINTI 70075000=10441000= + ----------- --------------------------- 70080000=10442000= + 0 70085000=10443000= + --------- ------------------------- 70090000=10444000= + 1 (V,TYPEV,POWERSOFTEN,ID,CHARI,FILE,1) 70095000=10445000= + --------- ------------------------- 70100000=10446000= + 2 (S1---SN,V,N,TYPEV,POWERSOFTEN,ID,CHARI,70105000=10447000= + FILE,2) 70110000=10448000= + --------- ------------------------- 70115000=10449000= + 3 (S1*---SN*,S1---SN,V,N,TYPEV,POWERSOFTEN70120000=10450000= + ,ID,CHARI,FILE,3) 70125000=10451000= + --------- ------------------------- 70130000=10452000= + 4 (DESCRIPTOR FOR THE ARRAY,N,TYPEV, 70135000=10453000= + POWERSOFTEN,ID,CHARI,FILE,4) 70140000=10454000= + *********** *************************** 70145000=10455000= + SINCE THE RESTRICTION EXISTS THAT THE SCOPE OF THE 70150000=10456000= + MONITOR FOR A LABEL OR SWITCH MUST BE THE SAME AS 70155000=10457000= + THE SCOPE OF THE LABEL OR SWITCH, THE INFORMATION 70160000=10458000= + THAT IS GATHERED BY THE MONITOR IS STORED IN THE 70165000=10459000= + ORIGIONAL ENTRY IN INFO. IN THE CASES OF VARIABLES, 70170000=10460000= + ARRAYS, AND FUNCTION DESIGNATORS,THE MONITORS SCOPE 70175000=10461000= + MAY BE DIFFERENT THAN THE SCOPE OF THE ITEM BEING 70180000=10462000= + MONITORED, THEREFORE, A NEW ENTRY IS MADE IN INFO 70185000=10463000= + WITH THE CURRENT LEVEL COUNTER AND THE ADDITIONAL 70190000=10464000= + MONITORING INFORMATION. 70195000=10465000= + *********FORMAT OF INFO FOR MONITORED ITEMS**********70200000=10466000= + ALL MONITORED ITEMS- MONITOR BIT [1:1] IN THE ELBAT 70205000=10467000= + WORD WILL BE SET. 70210000=10468000= + SIMPLE VARIABLES- A NEW ENTRY IS MADE IN INFO WITH 70215000=10469000= + ONE EXTRA WORD WHICH CONTAINS THE ADDRESS OF 70220000=10470000= + THE MONITOR FILE IN [37:11], I WILL HAVE A 70225000=10471000= + DEFINE SVARMONFILE = [37:11]#. 70230000=10472000= + ARRAYS- A NEW ENTRY IS MADE IN INFO WITH THE SAME 70235000=10473000= + NUMBER OF WORDS AS THE ORIGIONAL ENTRY. THE 70240000=10474000= + MONITOR FILE IS REMEMBERED IN [27:11] OF THE 70245000=10475000= + FIRST WORD OF ADDITIONAL INFO. I WILL HAVE A 70250000=10476000= + DEFINE ARRAYMONFILE = [27:11]#. 70255000=10477000= + SUBSCRIPTED VARIABLES- THE TECHNIQUE FOR HANDLING 70260000=10478000= + SUBSCRIPTED VARIABLES IS IDENTICLE TO THE 70265000=10479000= + TECHNIQUE FOR ARRAYS EXCEPT THAT EACH WORD70270000=10480000= + OF INFO CONTAINING LOWER BOUND INFORMATION70275000=10481000= + ALSO CONTAINS MONITOR INFORMATION. EITHER70280000=10482000= + A LITERAL OR AN ADDRESS WILL BE CONTAINED 70285000=10483000= + IN BITS [12:11]. IN [11:1] IS A BIT THAT 70290000=10484000= + DESIGNATES WHETHER AN OPDC OR A LITC 70295000=10485000= + SHOULD BE GENERATED USING [12:11]. IF THE70300000=10486000= + BIT IS 1 THEN AN OPDC WILL BE GENERATED, 70305000=10487000= + ELSE A LITC. IF AN OPDC IS GENERATED IT 70310000=10488000= + MAY BE ON A SIMPLE VARIABLE, OR ON AN 70315000=10489000= + ACCIDENTAL ENTRY PROGRAM DESCRIPTOR. THE 70320000=10490000= + PURPOSE OF THE LITC OR OPDC IS TO PASS 70325000=10491000= + SI* TO THE PRINTI ROUTINE. 70330000=10492000= + LABELS- THE FIRST WORD OF ADDITIONAL INFO CONTAINS 70335000=10493000= + THE ADDRESS OF THE FILE DESCRIPTOR IN THE 70340000=10494000= + ORIGIONAL ENTRY IN BITS [13:11]. I WILL HAVE A70345000=10495000= + DEFINE LABLMONFILE = [13:11]#. 70350000=10496000= + SWITCHES- THE MONITOR IS THE SAME AS THAT FOR LABELS.70355000=10497000= + I WILL HAVE A DEFINE SWITMONFILE = [13:11]#. 70360000=10498000= + FUNCTION DESIGNATORS- A NEW ENTRY IS MADE IN INFO 70365000=10499000= + WITH THE SAME NUMBER OF WORDS AS THE 70370000=10500000= + ORIGIONAL ENTRY. THE MONITOR FILE IS 70375000=10501000= + REMEMBERED IN [27:11] OF THE FIRST WORD OF 70380000=10502000= + ADDITIONAL INFO. I WILL HAVE A DEFINE 70385000=10503000= + FUNCMONFILE = [27:11]#; 70390000=10504000= + DEFINE 70395000=10505000= + FILEIDENT = RR7 #; 70400000=10505000= + COMMENT FILEIDENT CONTAINS THE 70405000=10505000= + ADDRESS OF THE MONITOR FILE; 70410000=10506000= + DEFINE 70415000=10507000= + SUBSCRIPT = RR1 #; 70420000=10507000= + COMMENT SUBSCRIPT IS USED TO 70425000=10507000= + SAVE THE ADDRESS OR VALUE OF A 70430000=10508000= + SUBSCRIPT. ONE ADDITIONAL BIT IS70435000=10509000= + USED TO TELL WHETHER TO EMIT AN 70440000=10510000= + OPDC OR A LITC ON THIS ADDRESS OR70445000=10511000= + VALUE; 70450000=10512000= + DEFINE 70455000=10513000= + NODIM = RR2 #; 70460000=10513000= + COMMENT NODIM CONTAINS THE NUMBER OF70465000=10513000= + DIMENSIONS OF AN ARRAY OR SUBSCRIPTED70470000=10514000= + VARIABLE APPEARING IN A MONITOR LIST;70475000=10515000= + DEFINE 70480000=10516000= + INC = RR3 #; 70485000=10516000= + COMMENT INC CONTAINS THE LINK TO 70490000=10516000= + ADDITIONAL INFO AND IS USED WHEN MAKING70495000=10517000= + A NEW ENTRY IN INFO FOR ARRAYS; 70500000=10518000= + DEFINE 70505000=10519000= + ELBATWORD = RR4 #; 70510000=10519000= + COMMENT ELBATWORD CONTAINS THE 70515000=10519000= + ELBAT WORD FOR A MONITOR LIST 70520000=10520000= + ELEMENT; 70525000=10521000= + DEFINE 70530000=10522000= + OPLIT = RR4 #; 70535000=10522000= + COMMENT OPLIT IS USED FOR MARKING70540000=10522000= + SUBSCRIPTED VARIABLES TO TELL ME 70545000=10523000= + WHETHER TO EMIT AN OPDC OR A LITC.70550000=10524000= + 0 IS USED FOR OPDC, 1 FOR LITC; 70555000=10525000= + DEFINE 70560000=10526000= + TESTVARB = RR5 #; 70565000=10526000= + COMMENT TESTVARB CONTAINS A LINK 70570000=10526000= + POINTING AT THE END OF ADDITIONAL 70575000=10527000= + INFO AND IS USED TO TELL WHEN TO 70580000=10528000= + STOP MOVING INFO FOR THE NEW ENTRY70585000=10529000= + FOR MONITORED ARRAYS; 70590000=10530000= + DEFINE 70595000=10531000= + NXTINFOTEMP = RR6 #; 70600000=10531000= + COMMENT NXTINFOTEMP CONTAINS A70605000=10531000= + LINK POINTING AT THE FIRST 70610000=10532000= + ADDITIONAL WORD OF INFO FOR 70615000=10533000= + MONITORED ARRAYS; 70620000=10534000= + DEFINE 70625000=10535000= + INSERTFILE = 27:37:11 #; 70630000=10535000= + COMMENT INSERTFILE IS THE 70635000=10535000= + CONCATENATE DEFINE FOR 70640000=10536000= + STUFFING THE MONITOR FILE 70645000=10537000= + ADDRESS INTO THE FIRST 70650000=10538000= + ADDITIONAL INFO WORD FOR 70655000=10539000= + ARRAYS AND FUNCTIONS; 70660000=10540000= + DEFINE 70665000=10541000= + NOPARPART = NODIMPART #; 70670000=10541000= + COMMENT NOPARPART IS A 70675000=10541000= + PARTIAL WORD DESIGNATOR [4070680000=10542000= + :8] USED TO EXTRACT THE 70685000=10543000= + NUMBER OF PARAMETERS FOR A 70690000=10544000= + GIVEN PROCEDURE FROM INFO; 70695000=10545000= + DEFINE 70700000=10546000= + NOPAR = NODIM #; 70705000=10546000= + COMMENT NOPAR CONTAINS THE NUMBER 70710000=10546000= + OF PARAMETERS FOR A FUNCTION 70715000=10547000= + DESIGNATOR APPEARING IN A MONITOR 70720000=10548000= + LIST; 70725000=10549000= + LABEL 70730000=10550000= + START; 70735000=10550000= + COMMENT WHEN START IS REACHED, I MUST BE 70740000=10550000= + POINTING AT THE FILE IDENTIFIER IN THE 70745000=10551000= + MONITOR DECLARATION; 70750000=10552000= + LABEL 70755000=10553000= + MARKMONITORED; 70760000=10553000= + COMMENT THE CODE AT MARKMONITORED 70765000=10553000= + TURNS ON THE MONITOR BIT OF THE ELBAT70770000=10554000= + WORD IN THE MONITOR LIST AND STORES 70775000=10555000= + IT IN ACCUM[0] FOR THE E ROUTINE; 70780000=10556000= + LABEL 70785000=10557000= + STORESUBS; 70790000=10557000= + COMMENT STORESUBS IS THE CODE THAT 70795000=10557000= + REMEMBERS ALL THAT IS NECESSARY ABOUT 70800000=10558000= + EACH SUBSCRIPT EXPRESSION; 70805000=10559000= + LABEL 70810000=10560000= + CHKCOMMA; 70815000=10560000= + COMMENT CHKCOMMA REQUIRES THAT I BE 70820000=10560000= + POINTING THE LAST LOGICAL QUANTITY OF THE 70825000=10561000= + MONITOR LIST ELEMENT THAT HAS JUST BEEN 70830000=10562000= + PROCESSED; 70835000=10563000= + LABEL 70840000=10564000= + EXIT; 70845000=10564000= + COMMENT EXIT EXITS THE MERRIMAC PROCEDURE; 70850000=10564000= +START: 70855000=10565000= + IF ELCLASS ^= FILEID THEN 70860000=10565000= + BEGIN 70865000=10565100= + IF Q = 6"5INDEX" OR Q = 6"4FLAG0" OR Q = 6"6INTOV" OR Q = 70870000=10565200= + 6"6EXPOV" OR Q = 6"4ZERO0" 70875000=10565200= + THEN 70880000=10565200= + MERRIMAC:= TRUE 70885000=10565200= + ELSE 70890000=10565200= + ERR(400); 70895000=10565300= + GO EXIT; 70900000=10565300= + END COMMENT ERROR 400 IS MISSING FILE ID IN MONITOR DEC; 70905000=10567000= + CHECKER(ELBAT[I]); 70910000=10568000= + FILEIDENT:= ELBAT[I].ADDRESS; 70915000=10569000= + I:= I+1; 70920000=10569000= + IF CHECK(LEFTPAREN, 401) THEN 70925000=10571000= + GO TO EXIT; 70930000=10571000= + COMMENT ERROR 401 IS MISSING LEFT PARENTHSIS IN MONITOR; 70935000=10572000= +MARKMONITORED: 70940000=10573000= + STEPIT; 70945000=10573000= + ACCUM[0]:= -ABS(ELBAT[I]); 70950000=10573000= + IF RANGE(BOOID, INTID) THEN 70955000=10575000= + BEGIN 70960000=10575000= + COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 70965000=10575000= + E; 70970000=10576000= + PUTNBUMP(FILEIDENT); 70975000=10576000= + GO CHKCOMMA; 70980000=10577000= + END; 70985000=10578000= + IF RANGE(BOOARRAYID, INTARRAYID) THEN 70990000=10580000= + BEGIN 70995000=10580000= + COMMENT THIS CODE HANDLES ARRAYS AND 71000000=10580000= + SUBSCRIPTED VARIABLES; 71005000=10581000= + E; 71010000=10582000= + NXTINFOTEMP:= NEXTINFO; 71015000=10582000= + PUTNBUMP(NODIM:= TAKEFRST & FILEIDENT[INSERTFILE]); 71020000=10583000= + TESTVARB:= (NODIM:= NODIM.NODIMPART)+ 71025000=10585000= + (INC:= (ELBATWORD:= ELBAT[I]).LINK+ELBATWORD.INCR); 71030000=10585000= + DO 71035000=10586000= + PUTNBUMP(TAKE(INC:= INC+1)) 71040000=10587000= + UNTIL INC >= TESTVARB; 71045000=10587000= + IF TABLE(I+1) ^= LFTBRKET THEN 71050000=10589000= + GO CHKCOMMA; 71055000=10589000= + TESTVARB:= NODIM+NXTINFOTEMP; 71060000=10590000= + STEPIT; 71065000=10591000= + STORESUBS: 71070000=10592000= + IF (RR3:= TABLE(I+2) = COMMA OR RR3 = RTBRKET) AND STEPI ^= 71075000=10593000= + NONLITNO 71080000=10594000= + THEN 71085000=10594000= + BEGIN 71090000=10594000= + COMMENT THIS IS THE SIMPLE CASE OF 71095000=10594000= + SUBSCRIPTED VARIABLES. EITHER A LITC 71100000=10595000= + OR AN OPDC ON A VARIABLE IS ALL THAT 71105000=10596000= + IS NEEDED TO CALL THE SUBSCRIPT; 71110000=10597000= + SUBSCRIPT:= ELBAT[I].ADDRESS; 71115000=10598000= + OPLIT:= 0; 71120000=10598500= + IF NOT RANGE(INTRNSICPROCID, INTID) THEN 71125000=10600000= + IF CHECK(LITNO, 402) THEN 71130000=10601000= + GO TO EXIT 71135000=10602000= + ELSE 71140000=10602000= + COMMENT MARK FOR LITC; 71145000=10602000= + OPLIT:= 1; 71150000=10603000= + COMMENT ERROR 402 IS BAD 71155000=10604000= + SUBSCRIPT IN MONITOR DECLARATION;71160000=10605000= + STEPIT; 71165000=10606000= + END 71170000=10608000= + ELSE 71175000=10608000= + BEGIN 71180000=10608000= + COMMENT THIS IS THE SPECIAL CASE OF 71185000=10608000= + SUBSCRIPTED VARIABLES. CODE FOR THIS 71190000=10609000= + SUBSCRIPT EXPRESSION MUST BE GENERATED71195000=10610000= + AND JUMPED AROUND, AN ACCIDENTAL ENTRY71200000=10611000= + PROGRAM DESCRIPTOR CREATED AND THE 71205000=10612000= + ADDRESS SAVED IN SUBSCRIPT. SUBSCRIPT71210000=10613000= + MUST BE MARKED FOR AN OPDC; 71215000=10614000= + JUMPCHKNX; 71220000=10615000= + SUBSCRIPT:= PROGDESCBLDR(ADES, L, 0); 71225000=10616000= + AEXP; 71230000=10616000= + EMITO(RTS); 71235000=10616000= + JUMPCHKX; 71240000=10616500= + OPLIT:= 0; 71245000=10617000= + IF MODE > 0 THEN 71250000=10619000= + BEGIN 71255000=10619000= + COMMENT STUFF F AT THIS 71260000=10619000= + POINT IF MODE > 0; 71265000=10620000= + STUFFF(SUBSCRIPT); 71270000=10621000= + EMITPAIR(SUBSCRIPT, STD); 71275000=10622000= + END; 71280000=10623000= + END; 71285000=10624000= + PUT(TAKE(NXTINFOTEMP:= NXTINFOTEMP+1) & SUBSCRIPT[12:37:11] & 71290000=10627000= + OPLIT[11:47:01], NXTINFOTEMP); 71295000=10627000= + IF ELCLASS = COMMA THEN 71300000=10629000= + GO TO STORESUBS; 71305000=10629000= + IF CHECK(RTBRKET, 403) THEN 71310000=10631000= + GO TO EXIT; 71315000=10631000= + COMMENT ERROR 403 IS IMPROPER SUBSCRIPT 71320000=10632000= + EXPRESSION DELIMITER IN MONITOR LIST ELEMENT; 71325000=10633000= + IF NXTINFOTEMP ^= TESTVARB THEN 71330000=10635000= + BEGIN 71335000=10635000= + COMMENT ERROR 404 MONITOR LIST 71340000=10635000= + ELEMENT HAS IMPROPER NUMBER OF 71345000=10636000= + SUBSCRIPTS; 71350000=10637000= + I:= I-1; 71355000=10638000= + ERROR(404); 71360000=10638000= + GO TO EXIT; 71365000=10638000= + END; 71370000=10639000= + GO CHKCOMMA; 71375000=10640000= + END; 71380000=10641000= + IF ELCLASS = LABELID OR ELCLASS = SWITCHID THEN 71385000=10643000= + BEGIN 71390000=10643000= + COMMENT THIS CODE HANDLES LABELS AND SWITCHES; 71395000=10643000= + IF (ELBATWORD:= ELBAT[I]).LVL ^= LEVEL THEN 71400000=10645000= + BEGIN 71405000=10645000= + COMMENT ERROR 405 MEANS LABEL OR 71410000=10645000= + SWITCH MONITORED AT IMPROPER LEVEL; 71415000=10646000= + ERROR(405); 71420000=10647000= + GO TO EXIT; 71425000=10647000= + END; 71430000=10648000= + PUT(TAKEFRST & FILEIDENT[13:37:11], GIT(ELBAT[I])); 71435000=10650000= + PUT(TAKE(ELBATWORD) & (0-ABS(ELBATWORD))[1:1:34], ELBATWORD); 71440000=10652000= + GO CHKCOMMA; 71445000=10652000= + END; 71450000=10653000= + IF RANGE(BOOPROCID, INTPROCID) THEN 71455000=10655000= + BEGIN 71460000=10655000= + COMMENT THIS CODE HANDLES FUNCTIONS; 71465000=10655000= + E; % 71470000=10656000= + IF LEVEL = (RR2:= ELBAT[I]).LVL THEN 71475000=10656010= + BEGIN 71480000=10656011= + %%% COPY FORWARD BIT FROM ELBAT[I] INFO ENTRY INTO MONITOR"S INFO 71485000=10656012= + %%% ENTRY, AND THEN TURN OFF THE ELBAT[I] INFO ENTRY"S FORWARD BIT. 71490000=10656013= + PUT(TAKE(LASTINFO+1) & TAKE(RR2.LINK+1)[1:1:1], LASTINFO+1); 71495000=10656014= + PUT(ABS(TAKE(RR2.LINK+1)), RR2.LINK+1); 71500000=10656015= + END; 71505000=10656016= + PUTNBUMP(NOPAR:= TAKEFRST & FILEIDENT[INSERTFILE]); 71510000=10657000= + TESTVARB:= (NOPAR:= NOPAR.NOPARPART)+ 71515000=10659000= + (INC:= (ELBATWORD:= ELBAT[I]).LINK+ELBATWORD.INCR); 71520000=10659000= + DO 71525000=10660000= + PUTNBUMP(TAKE(INC:= INC+1)) 71530000=10661000= + UNTIL INC >= TESTVARB; 71535000=10661000= + GO CHKCOMMA; 71540000=10662000= + END; 71545000=10663000= + ERROR(406); 71550000=10664000= + GO TO EXIT; 71555000=10664000= + COMMENT ERROR 406 IS IMPROPER MONITOR LIST ELEMENT; 71560000=10665000= +CHKCOMMA: 71565000=10666000= + IF STEPI = COMMA THEN 71570000=10667000= + GO MARKMONITORED; 71575000=10667000= + IF CHECK(RTPAREN, 407) THEN 71580000=10669000= + GO TO EXIT; 71585000=10669000= + COMMENT ERROR 407 IS MISSING RIGHT PARENTHESIS IN MONITOR71590000=10670000= + DECLARATION; 71595000=10671000= + IF STEPI = SEMICOLON THEN 71600000=10673000= + GO TO EXIT; 71605000=10673000= + IF CHECK(COMMA, 408) THEN 71610000=10675000= + GO TO EXIT; 71615000=10675000= + COMMENT ERROR 408 MEANS IMPROPER MONITOR DECLARATION 71620000=10676000= + DELIMITER; 71625000=10677000= + STEPIT; 71630000=10678000= + GO TO START; 71635000=10678000= +EXIT: 71640000=10679000= + ; 71645000=10679000= + END MERRIMAC; 71650000=10680000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%71655000=10680000= + PROCEDURE DMUP; 71660000=10681000= + BEGIN 71665000=10682000= + COMMENT 15 JULY 1963 71670000=10682000= + THERE ARE FOUR TYPES OF DUMP LIST ELEMENTS. THERE 71675000=10683000= + ARE LABELS, SIMPLE VARIABLES, SUBSCRIPTED VARIABLES, AND 71680000=10684000= + ARRAYS. 71685000=10685000= + THE DMUP ROUTINE GENERATES CODE AND SAVES INFORMATION. 71690000=10686000= + THE INFORMATION THAT IS SAVED IS OF TWO TYPES. FOR EASE 71695000=10687000= + OF REFERENCE I WOULD LIKE TO DEFINE THE DUMP LABEL OUTSIDE71700000=10688000= + THE PARENTHESES AS THE DUMPOR, AND ANY LABEL APPEARING AS 71705000=10689000= + A DUMP LIST ELEMENT A DUMPEE. BOTH DUMPORS AND DUMPEES 71710000=10690000= + HAVE A COUNTER ASSOCIATED WITH THEM WHICH IS INCREMENTED 71715000=10691000= + BY ONE EACH TIME THE LABEL IS PASSED. THE ADDRESS OF THIS71720000=10692000= + COUNTER IS KEPT IN BITS [2:11] OF THE FIRST ADDITIONAL 71725000=10693000= + WORD OF INFO. THE ADDRESS OF THE PROGRAM DESCRIPTOR FOR 71730000=10694000= + THE CODE GENERATED BY DMUP IS KEPT IN BITS [24:11] OF THE 71735000=10695000= + FIRST ADDITIONAL WORD OF INFO FOR THE DUMPOR. 71740000=10696000= + THE CODE THAT IS GENERATED IS OF TWO TYPES. CODE TO 71745000=10697000= + INITIALIZE THE COUNTERS MENTIONED ABOVE IS EXECUTED UPON 71750000=10698000= + ENTRY TO THE BLOCK CONTAINING THE DUMP DECLARATION. THE 71755000=10699000= + OTHER TYPE CODE IS ONLY EXECUTED WHEN THE DUMPOR IS PASSED71760000=10700000= + . THIS CODE THEN COMPARES THE DUMPORS COUNTER WITH THE 71765000=10701000= + DUMP INDICATOR, IF THEY ARE NOT EQUAL IT JUMPS TO EXIT. 71770000=10702000= + IF THEY ARE EQUAL IT THEN PROCEEDS TO CALL PRINTI ONCE 71775000=10703000= + FOR EACH DUMP LIST ELEMENT. FOR A DESCRIPTION OF PRINTI 71780000=10704000= + SEE THE COMMENTS FOR THE MERRIMAC ROUTINE; 71785000=10705000= + LABEL 71790000=10706000= + START; 71795000=10706000= + COMMENT WHEN START IS REACHED, I MUST BE 71800000=10706000= + POINTING AT THE FILE IDENTIFIER IN THE DUMP 71805000=10707000= + DECLARATION; 71810000=10708000= + LABEL 71815000=10709000= + EXIT; 71820000=10709000= + COMMENT EXIT APPEARS AT THE END OF THE DMUP 71825000=10709000= + ROUTINE. NO STATMENTS ARE EXECUTED AFTER IT 71830000=10710000= + IS REACHED; 71835000=10711000= + DEFINE 71840000=10712000= + FILEIDENT = RR1 #; 71845000=10712000= + COMMENT FILEIDENT CONTAINS THE 71850000=10712000= + ADDRESS OF THE MONITOR FILE; 71855000=10713000= + LABEL 71860000=10714000= + STARTCALL; 71865000=10714000= + COMMENT THE CODE AT STARTCALL GENERATES 71870000=10714000= + CODE TO CALL THE PRINTI ROUTINE. WHEN 71875000=10715000= + STARTCALL IS REACHED, I MUST BE POINTING 71880000=10716000= + AT THE CHARACTER IMMEDIATELY BEFORE THE 71885000=10717000= + DUMP LIST ELEMENT TO BE PASSED TO PRINTI;71890000=10718000= + DEFINE 71895000=10719000= + NODIM = RR2 #; 71900000=10719000= + COMMENT NODIM CONTAINS THE NUMBER OF71905000=10719000= + DIMENSIONS OF AN ARRAY OR A 71910000=10720000= + SUBSCRIPTED VARIABLE APPEARING IN A 71915000=10721000= + DUMP LIST; 71920000=10722000= + DEFINE 71925000=10723000= + LEXIT = RR3 #; 71930000=10723000= + COMMENT LEXIT CONTAINS THE PROGRAM 71935000=10723000= + COUNTER SETTING AT WHICH CODE IS 71940000=10724000= + GENERATED TO EXIT THE ROUTINE EMITTED71945000=10725000= + BY DMUP; 71950000=10726000= + DEFINE 71955000=10727000= + DUMPETEMP = RR2 #; 71960000=10727000= + COMMENT DUMPETEMP HOLDS THE 71965000=10727000= + LOCATION OF THE COUNTER 71970000=10728000= + ASSOCIATED WITH THIS LABEL IF 71975000=10729000= + SPACE HAS BEEN ASSIGNED FOR IT; 71980000=10730000= + DEFINE 71985000=10731000= + DIMCTR = RR3 #; 71990000=10731000= + COMMENT DIMCTR IS INITIALIZED TO 71995000=10731000= + NODIM. IT IS THEN COUNTED DOWN TO 72000000=10732000= + ZERO AS SUBSCRIPT CODE IS GENERATED;72005000=10733000= + LABEL 72010000=10734000= + PASSN; 72015000=10734000= + COMMENT THE CODE AT PASSN PASSES N (THE 72020000=10734000= + NUMBER OF DIMENSIONS) TO THE PRINTI ROUTINE; 72025000=10735000= + LABEL 72030000=10736000= + SUBSLOOP; 72035000=10736000= + COMMENT THE CODE AT SUBLOOP PASSES 72040000=10736000= + SUBSCRIPTS TO PRINTI; 72045000=10737000= + ARRAY 72050000=10738000= + LABELCTR[0:100]; 72055000=10738000= + COMMENT LABELCTR IS AN ARRAY THAT 72060000=10738000= + HOLDS THE ADDRESSES OF ALL LABEL 72065000=10739000= + COUNTERS FOR LABELS APPEARING IN 72070000=10740000= + THIS DUMP DECLARATION. IT IS 72075000=10741000= + NECESSARY TO RETAIN THIS 72080000=10742000= + INFORMATION SO THAT CODE MAY BE 72085000=10743000= + GENERATED AT THE END OF THE 72090000=10744000= + DECLARATION TO INITIALIZE THE 72095000=10745000= + COUNTERS; 72100000=10746000= + DEFINE 72105000=10747000= + LABELCTRINX = RR4 #; 72110000=10747000= + COMMENT LABELCTRINX IS THE 72115000=10747000= + VARIABLE USED TO INDEX INTO THE72120000=10748000= + LABELCTR ARRAY; 72125000=10749000= + DEFINE 72130000=10750000= + DUMPE = 2:37:11 #; 72135000=10750000= + COMMENT DUMPE IS THE 72140000=10750000= + CONCATENATE DEFINE FOR INSERTING72145000=10751000= + THE COUNTER ASSOCIATED WITH THIS72150000=10752000= + LABEL INTO THE FIRST ADDITIONAL 72155000=10753000= + WORD OF INFO; 72160000=10754000= + DEFINE 72165000=10755000= + LWRBND = RR5 #; 72170000=10755000= + COMMENT LWRBND CONTAINS THE LOWER 72175000=10755000= + BOUND FOR MONITORED SUBSCRIPTED 72180000=10756000= + VARIABLES; 72185000=10757000= + DEFINE 72190000=10758000= + FORMATTYPE = RR5 #; 72195000=10758000= + COMMENT FORMATTYPE IS THE 72200000=10758000= + FORMAT TYPE REFERRED TO IN THE 72205000=10759000= + COMMENTS FOR THE MERRIMAC 72210000=10760000= + ROUTINE DESCRIBING PRINTI; 72215000=10761000= + DEFINE 72220000=10762000= + FINALL = RR5 #; 72225000=10762000= + COMMENT FINALL IS A TEMPORARY CELL 72230000=10762000= + USED TO HOLD L WHILE THE DUMP 72235000=10763000= + INDICATOR TEST CODE IS BEING 72240000=10764000= + GENERATED; 72245000=10765000= + DEFINE 72250000=10766000= + TESTLOC = RR6 #; 72255000=10766000= + COMMENT TESTLOC CONTAINS THE 72260000=10766000= + LOCATION OF THE CODE THAT MUST BE 72265000=10767000= + GENERATED TO MAKE THE TEST TO 72270000=10768000= + DETERMINE WHETHER OR NOT DUMPING 72275000=10769000= + SHOULD OCCUR; 72280000=10770000= + DEFINE 72285000=10771000= + DUMPR = 24:37:11 #; 72290000=10771000= + COMMENT DUMPR IS THE 72295000=10771000= + CONCATENATE DEFINE USED TO 72300000=10772000= + INSERT THE ADDRESS OF THE 72305000=10773000= + PROGRAM DESCRIPTOR FOR THE CODE 72310000=10774000= + GENERATED FROM THE DUMP 72315000=10775000= + DECLARATION; 72320000=10776000= + DEFINE 72325000=10777000= + DUMPLOC = RR7 #; 72330000=10777000= + COMMENT DUMPLOC CONTAINS THE 72335000=10777000= + ADDRESS OF THE PROGRAM DESCRIPTOR 72340000=10778000= + THAT DESCRIBES THE CODE GENERATED 72345000=10779000= + BY DMUP; 72350000=10780000= + DEFINE 72355000=10781000= + ELBATWORD = RR8 #; 72360000=10781000= + COMMENT ELBATWORD CONTAINS THE 72365000=10781000= + ELBAT WORD FOR THE DUMP LIST 72370000=10782000= + ELEMENT CURRENTLY BEING OPERATED 72375000=10783000= + ON; 72380000=10784000= + LABEL 72385000=10785000= + CALLPRINTI; 72390000=10785000= + COMMENT CALLPRINTI FINISHES THE CALL 72395000=10785000= + ON PRINTI. IT GENERATES THE CODE TO 72400000=10786000= + PASS TYPEV, POWERSOFTEN, ID, CHARI, 72405000=10787000= + FILE, AND FORMAT TYPE; 72410000=10788000= + DEFINE 72415000=10789000= + SUBSCTR = RR9 #; 72420000=10789000= + COMMENT SUBSCTR CONTAINS THE 72425000=10789000= + DIMENSION NUMBER THAT IS CURRENTLY 72430000=10790000= + BEING WORKED ON; 72435000=10791000= +START: 72440000=10792000= + IF CHECK(FILEID, 409) THEN 72445000=10793000= + GO TO EXIT; 72450000=10793000= + COMMENT ERROR 409 MEANS MISSING FILE ID IN DUMP DEC; 72455000=10794000= + CHECKER(ELBAT[I]); 72460000=10795000= + FILEIDENT:= ELBAT[I].ADDRESS; 72465000=10796000= + STEPIT; 72470000=10796000= + IF CHECK(LEFTPAREN, 410) THEN 72475000=10798000= + GO TO EXIT; 72480000=10798000= + COMMENT ERROR 410 MEANS MISSING LEFT PAREN IN DUMP DEC; 72485000=10799000= + JUMPCHKNX; 72490000=10800000= + ADJUST; 72495000=10800000= + DUMPLOC:= PROGDESCBLDR(ADES, L, 0); 72500000=10801000= + TESTLOC:= L; 72505000=10801000= + L:= L+3; 72510000=10801000= + LABELCTRINX:= -1; 72515000=10802000= + EMITO(NOP); 72520000=10802000= + BUMPL; 72525000=10802000= +STARTCALL: 72530000=10803000= + EMITO(MKS); 72535000=10803000= + STEPIT; 72540000=10803000= + ELBATWORD:= -ABS(ELBAT[I]); 72545000=10804000= + IF RANGE(BOOARRAYID, INTARRAYID) THEN 72550000=10806000= + BEGIN 72555000=10806000= + COMMENT THIS CODE HANDLES ARRAYS AND 72560000=10806000= + SUBSCRIPTED VARIABLES; 72565000=10807000= + NODIM:= DIMCTR:= TAKEFRST.NODIMPART; 72570000=10808000= + IF STEPI = LFTBRKET THEN 72575000=10810000= + BEGIN 72580000=10810000= + COMMENT THIS CODE HANDLES SUBSCRIPTED72585000=10810000= + VARIABLES; 72590000=10811000= + STEPIT; 72595000=10812000= + AEXP; 72600000=10812000= + EMITO(DUP); 72605000=10812000= + SUBSCTR:= 1; 72610000=10813000= + IF (LWRBND:= TAKE(GIT(ELBATWORD)+SUBSCTR)).[35:13] ^= 0 THEN 72615000=10816000= + BEGIN 72620000=10816000= + COMMENT SUBTRACT OFF THE 72625000=10816000= + LOWER BOUND BEFORE INDEXING;72630000=10817000= + IF LWRBND.[46:2] = 0 THEN 72635000=10819000= + EMIT(LWRBND) 72640000=10820000= + ELSE 72645000=10820000= + EMITV(LWRBND.[35:11]); 72650000=10820000= + EMIT(LWRBND.[23:12]); 72655000=10821000= + END; 72660000=10822000= + IF DIMCTR-SUBSCTR = 0 THEN 72665000=10824000= + BEGIN 72670000=10824000= + COMMENT PASS SUBSCRIPT, 72675000=10824000= + VALUE,N; 72680000=10825000= + EMITV(ELBATWORD.ADDRESS); 72685000=10826000= + PASSN: 72690000=10827000= + EMITL(NODIM); 72695000=10827000= + IF CHECK(RTBRKET, 411) THEN 72700000=10829000= + GO TO EXIT; 72705000=10829000= + COMMENT ERROR 411 MEANS 72710000=10830000= + DUMP LIST ELEMENT HAS WRONG 72715000=10831000= + NUMBER OF SUBSCRIPTS; 72720000=10832000= + FORMATTYPE:= 2; 72725000=10833000= + GO CALLPRINTI 72730000=10834000= + END; 72735000=10834000= + EMITN(ELBATWORD.ADDRESS); 72740000=10835000= + SUBSLOOP: 72745000=10836000= + EMITO(LOD); 72750000=10836000= + STEPIT; 72755000=10836000= + AEXP; 72760000=10836000= + EMITL(JUNK); 72765000=10837000= + EMITO(SND); 72770000=10837000= + SUBSCTR:= SUBSCTR+1; 72775000=10838000= + IF (LWRBND:= TAKE(GIT(ELBATWORD)+SUBSCTR)).[35:13] ^= 0 THEN 72780000=10841000= + BEGIN 72785000=10841000= + COMMENT SUBTRACT OFF THE 72790000=10841000= + LOWER BOUND BEFORE INDEXING;72795000=10842000= + IF LWRBND.[46:2] = 0 THEN 72800000=10844000= + EMIT(LWRBND) 72805000=10845000= + ELSE 72810000=10845000= + EMITV(LWRBND.[35:11]); 72815000=10845000= + EMIT(LWRBND.[23:12]); 72820000=10846000= + END; 72825000=10847000= + IF DIMCTR-SUBSCTR = 0 THEN 72830000=10849000= + BEGIN 72835000=10849000= + COMMENT EMIT COC; 72840000=10849000= + EMITO(COC); 72845000=10850000= + EMITV(JUNK); 72850000=10851000= + EMITO(XCH); 72855000=10851000= + GO PASSN; 72860000=10852000= + END; 72865000=10853000= + EMITO(CDC); 72870000=10854000= + EMITV(JUNK); 72875000=10854000= + EMITO(XCH); 72880000=10854000= + IF CHECK(COMMA, 412) THEN 72885000=10856000= + GO TO EXIT 72890000=10857000= + ELSE 72895000=10857000= + GO TO SUBSLOOP; 72900000=10857000= + COMMENT ERROR 412 MEANS DUMP LIST 72905000=10858000= + ELEMENT HAS WRONG NUMBER OF SUBSCRIPTS72910000=10859000= + ; 72915000=10860000= + END; 72920000=10861000= + COMMENT THIS CODE HANDLES ARRAYS; 72925000=10862000= + IF ELCLASS ^= COMMA AND ELCLASS ^= RTPAREN THEN 72930000=10864000= + BEGIN 72935000=10864000= + COMMENT ERROR 413 MEANS IMPROPER 72940000=10864000= + ARRAY DUMP LIST ELEMENT; 72945000=10865000= + ERR(413); 72950000=10866000= + GO TO EXIT; 72955000=10866000= + END; 72960000=10867000= + EMITPAIR(ELBATWORD.ADDRESS, LOD); 72965000=10868000= + EMITL(NODIM); 72970000=10868000= + FORMATTYPE:= 4; 72975000=10869000= + I:= I-1; 72980000=10869000= + GO CALLPRINTI; 72985000=10869000= + END; 72990000=10870000= + FORMATTYPE:= 1; 72995000=10871000= + IF RANGE(BOOID, INTID) THEN 73000000=10873000= + BEGIN 73005000=10873000= + COMMENT THIS CODE HANDLES SIMPLE VARIABLES; 73010000=10873000= + EMITV(ELBATWORD.ADDRESS); 73015000=10874000= + GO CALLPRINTI; 73020000=10874000= + END; 73025000=10875000= + IF CHECK(LABELID, 414) THEN 73030000=10877000= + GO TO EXIT; 73035000=10877000= + COMMENT ERROR 414 MEANS ILLEGAL DUMP LIST ELEMENT. THIS 73040000=10878000= + CODE HANDLES LABELS; 73045000=10879000= + PUT(TAKEFRST & (LABELCTR[LABELCTRINX:= LABELCTRINX+1]-IF DUMPETEMP 73050000=10882000= + := TAKEFRST.DUMPEE = 0 THEN GETSPACE(FALSE, -7) 73055000=10882000= + % LABEL DESCRIPTOR. 73060000=10882000= +ELSE DUMPETEMP)[DUMPE], GIT(ELBATWORD)); 73065000=10883000= + EMITV(LABELCTR[LABELCTRINX]); 73070000=10885000= + PUT(TAKE(ELBATWORD) & ELBATWORD[1:1:34], ELBATWORD); 73075000=10886000= + EMITL(3); 73080000=10887000= + IF FALSE THEN 73085000=10887000= + CALLPRINTI: 73090000=10888000= + EMITL(PASSTYPE(ELBATWORD)); 73095000=10888000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 73100000=10889000= + PASSALPHA(ELBATWORD); 73105000=10889000= + EMITPAIR(GNAT(CHARI), LOD); 73110000=10890000= + PASSMONFILE(FILEIDENT); 73115000=10891000= + EMITNUM(FORMATTYPE & CARDNUMBER[1:4:44]); 73120000=10891100= + EMITV(GNAT(PRINTI)); 73125000=10891200= + IF STEPI = COMMA THEN 73130000=10893000= + BEGIN 73135000=10893000= + COMMENT GO AROUND ONE MORE TIME; 73140000=10893000= + IF LABELCTRINX = 100 THEN 73145000=10895000= + BEGIN 73150000=10895000= + COMMENT ERROR 415 MEANS LABELCTR IS 73155000=10895000= + ABOUT TO OVERFLOW WITH LABEL 73160000=10896000= + INFORMATION; 73165000=10897000= + ERR(415); 73170000=10898000= + GO TO EXIT; 73175000=10898000= + END; 73180000=10899000= + GO STARTCALL; 73185000=10900000= + END; 73190000=10901000= + IF CHECK(RTPAREN, 416) THEN 73195000=10903000= + GO TO EXIT; 73200000=10903000= + COMMENT ERROR 416 MEANS ILLEGAL DUMP LIST ELEMENT 73205000=10904000= + DELIMETER; 73210000=10905000= + LEXIT:= L; 73215000=10906000= + EMITL(0); 73220000=10906000= + EMITO(RTS); 73225000=10906000= + JUMPCHKX; 73230000=10907000= + STEPIT; 73235000=10907000= + IF CHECK(LABELID, 417) THEN 73240000=10909000= + GO TO EXIT; 73245000=10909000= + COMMENT ERROR 417 MEANS MISSING DUMP LABEL; 73250000=10910000= + PUT 73255000=10912000= + (TAKE(ELBATWORD:= -ABS(ELBAT[I])) & ELBATWORD[1:1:34], ELBATWORD)73260000=10912000= + ; 73265000=10912000= + IF NOT LOCAL(ELBATWORD) THEN 73270000=10912100= + FLAG(417); 73275000=10912100= + PUT(TAKEFRST & (LABELCTR[LABELCTRINX:= LABELCTRINX+1]:= IF DUMPETEMP73280000=10915000= + := TAKEFRST.DUMPEE = 0 THEN DUMPETEMP:= GETSPACE(FALSE, -7) 73285000=10915000= + % LABEL DESCR. 73290000=10915000= +ELSE DUMPETEMP)[DUMPE], GIT(ELBATWORD)); 73295000=10916000= + EMITL(0); 73300000=10917000= + DO BEGIN 73305000=10918000= + COMMENT THIS CODE INITIALIZES THE LABEL COUNTERS;73310000=10918000= + EMITPAIR(LABELCTR[LABELCTRINX], SND) 73315000=10920000= + END 73320000=10921000= + UNTIL LABELCTRINX:= LABELCTRINX-1 < 0; 73325000=10921000= + L:= L-1; 73330000=10922000= + EMITO(STD); 73335000=10922000= + STEPIT; 73340000=10922000= + IF CHECK(COLON, 418) THEN 73345000=10924000= + GO TO EXIT; 73350000=10924000= + COMMENT ERROR 418 MEANS MISSING COLON IN DUMP DEC; 73355000=10925000= + FINALL:= L; 73360000=10926000= + L:= TESTLOC; 73365000=10926000= + STEPIT; 73370000=10926000= + IF(GT1:= TABLE(I) ^= NONLITNO AND GT1 ^= LITNO AND GT1 < REALID AND 73375000=10926510= + GT1 > INTID) OR(GT1:= TABLE(I+1) ^= COMMA AND GT1 ^= SEMICOLON) 73380000=10926530= + THEN 73385000=10926530= + BEGIN 73390000=10926530= + COMMENT ERROR 465-DUMP INDICATOR MUST BE 73395000=10926530= + UNSIGNED INTEGER OR SIMPLE VARIABLE; 73400000=10926540= + FLAG(465); 73405000=10926550= + GO TO EXIT; 73410000=10926550= + END; 73415000=10926560= + PRIMARY; 73420000=10927000= + EMITV(DUMPETEMP); 73425000=10927000= + EMITO(EQL); 73430000=10928000= + EMITB(BFC, TESTLOC+6, LEXIT); 73435000=10928000= + L:= FINALL; 73440000=10929000= + PUT(TAKE(GIT(ELBAT[I-3])) & DUMPLOC[DUMPR], GIT(ELBAT[I-3])); 73445000=10930000= + IF ELCLASS = COMMA THEN 73450000=10932000= + BEGIN 73455000=10932000= + COMMENT GO AROUND ONE MORE TIME; 73460000=10932000= + STEPIT; 73465000=10933000= + GO TO START; 73470000=10933000= + END; 73475000=10934000= + IF CHECK(SEMICOLON, 419) THEN 73480000=10936000= + ; 73485000=10936000= + COMMENT ERROR 419 MEANS IMPROPER DUMP DEC DELIMITER; 73490000=10937000= +EXIT: 73495000=10938000= + ; 73500000=10938000= + END DMUP; 73505000=10939000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%73510000=10939000= + 73515000=10940000= + COMMENT CODE FOR SWITCHES IS COMPILED FROM TWO PLACES - IN SWITCHGEN 73520000=10940000= + AND IN PURGE. COMPLEX SWITCHES (I.E. SWITCHES CONTAINING 73525000=10941000= + OTHER THAN LOCAL LABELS) ARE COMPILED HERE. SIMPLE 73530000=10942000= + SWITCHES ARE COMPILED AT PURGE TIME. THIS IS FOR REASONS 73535000=10943000= + OF EFFICIENCY. IF A SWITCH IS ONLY CALLED ONE THE CODE 73540000=10944000= + IS QUITE A BIT BETTER. AFTER SWITCHGEN GOTOG IS TRUE IF 73545000=10945000= + A COMMUNICATE MUST BE USED. THE BLOCK ROUTINE MARKS SUCH 73550000=10946000= + SWITCHES FORMAL. THIS IS, OF COURSE, A FICTION, FOR 73555000=10947000= + SIMPLE SWITCHES SWITCHGEN LEAVES THE INDEX TO INFO IN EDOC73560000=10948000= + SO THAT PURGE CAN FIND THE LABELS. IT SHOULD BE NOTED 73565000=10949000= + THAT A SWITCH EXPECTS THE SWITCH INDEX TO BE FOUND IN 73570000=10950000= + JUNK. THE RESULT RETURNED BY SWITCHGEN IS WHETHER OR NOT 73575000=10951000= + TO STUFF F INOT A SWITCH DESCRIPTOR, SINCE A SWITCH DE- 73580000=10952000= + SCRIPTOR IS AN ACCIDENTAL ENTRY DESCRIPTOR; 73585000=10953000= + BOOLEAN PROCEDURE SWITCHGEN(BEFORE, PD); 73590000=10954000= + VALUE 73595000=10954100= + BEFORE; 73600000=10954100= + BOOLEAN 73605000=10954100= + BEFORE; 73610000=10954100= + REAL 73615000=10954100= + PD; 73620000=10954100= + BEGIN 73625000=10955000= + LABEL 73630000=10956000= + LX, 73635000=10956000= + EXIT, 73640000=10956000= + BEF; 73645000=10956000= + REAL 73650000=10957000= + K, 73655000=10957000= + N, 73660000=10957000= + T1, 73665000=10957000= + TL; 73670000=10957000= + TL:= L; 73675000=10958000= + EMIT(0); 73680000=10959000= + EMITV(JUNK); 73685000=10959000= + EMITO(GEQ); 73690000=10959000= + EMITV(JUNK); 73695000=10959000= + L:= L+1; 73700000=10960000= + EMITO(GTR); 73705000=10960000= + EMITO(LOR); 73710000=10960000= + EMITV(JUNK); 73715000=10960000= + EMITO(DUP); 73720000=10961000= + EMITO(ADD); 73725000=10961000= + COMMENT WE HAVE GENERATED TEST 73730000=10961000= + AND PREPARATION FOR SWITCH-JUMP; 73735000=10962000= + GOTOG:= FALSE; 73740000=10963000= + COMMENT IF WE COMPILE JUMP OUT WE KNOW; 73745000=10963000= + IF BEFORE THEN 73750000=10964000= + BEGIN 73755000=10964000= + STEPIT; 73760000=10964000= + GO TO BEF 73765000=10964000= + END; 73770000=10964000= +LX: IF STEPI = LABELID AND ELBAT[I].LVL = LEVEL THEN 73775000=10966000= + BEGIN 73780000=10966000= + INFO[0, N]:= ELBAT[I]; 73785000=10967000= + IF N:= N+1 = 256 THEN 73790000=10969000= + BEGIN 73795000=10969000= + ERR(147); 73800000=10969000= + GO TO EXIT 73805000=10969000= + END; 73810000=10969000= + IF STEPI = COMMA THEN 73815000=10970000= + GO TO LX; 73820000=10970000= + EMITO(BFC); 73825000=10971000= + L:= BUMPL; 73830000=10971000= + N:= N-1; 73835000=10971000= + FOR K:= 0 STEP 1 UNTIL N DO 73840000=10973000= + BEGIN 73845000=10973000= + COMMENT SAVE LINKS TO LABELS IN EDOC; 73850000=10973000= + EMIT((GT1:= INFO[0, K]).[35:1]); 73855000=10974000= + EMIT(GT1) 73860000=10975000= + END; 73865000=10975000= + SWITCHGEN:= FALSE 73870000=10976000= + END 73875000=10977000= + ELSE 73880000=10977000= + BEGIN 73885000=10977000= + BEF: 73890000=10978000= + L:= BUMPL; 73895000=10978000= + N:= N-1; 73900000=10978000= + PUT(TAKE(LASTINFO) & (PD:= PROGDESCBLDR(ADES, TL, PD))[16:37:11]73905000=10978600= + , LASTINFO); % GET PRT LOC AND SAVE 73910000=10978600= + FOR K:= 0 STEP 1 UNTIL N DO 73915000=10980000= + BEGIN 73920000=10980000= + COMMENT EMIT CODE FOR SIMPLE LABELS SEEN; 73925000=10980000= + ADJUST; 73930000=10981000= + T1:= L; 73935000=10981000= + EMITL(GNAT(GT1:= INFO[0, K])); 73940000=10982000= + GENGO(GT1); 73945000=10983000= + INFO[0, K]:= T1; 73950000=10984000= + EMITO(RTS); 73955000=10985000= + CONSTANTCLEAN 73960000=10986000= + END; 73965000=10986000= + I:= I-1; 73970000=10987000= + N:= N+1; 73975000=10987000= + DO BEGIN 73980000=10988000= + ADJUST; 73985000=10988000= + STEPIT; 73990000=10989000= + INFO[0, N]:= L; 73995000=10989000= + IF N:= N+1 = 256 THEN 74000000=10991000= + BEGIN 74005000=10991000= + ERR(147); 74010000=10991000= + GO TO EXIT 74015000=10991000= + END; 74020000=10991000= + DEXP; 74025000=10992000= + EMITO(RTS) 74030000=10992000= + END 74035000=10993000= + UNTIL ELCLASS ^= COMMA; 74040000=10993000= + ADJUST; 74045000=10993000= + EMITB(BFW, TL+12, L); 74050000=10994000= + EMITO(BFC); 74055000=10994000= + EMIT(0); 74060000=10995000= + EMITO(RTS); 74065000=10995000= + N:= N-1; 74070000=10995000= + FOR K:= 0 STEP 1 UNTIL N DO 74075000=10997000= + EMITB(BBW, BUMPL, INFO[0, K]); 74080000=10997000= + SWITCHGEN:= TRUE 74085000=10998000= + END; 74090000=10998000= + T1:= L; 74095000=10999000= + L:= TL+4; 74100000=11000000= + EMITL(N+1); 74105000=11001000= + L:= T1; 74110000=12000000= +EXIT: 74115000=12001000= + END SWITCHGEN; 74120000=12001000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%74125000=12001000= + PROCEDURE DBLSTMT; 74130000=12002000= + BEGIN 74135000=12003000= + REAL 74140000=12004000= + S, 74145000=12004000= + T; 74150000=12004000= + BOOLEAN 74155000=12004100= + B; 74160000=12004100= + LABEL 74165000=12005000= + L1, 74170000=12005000= + L2, 74175000=12005000= + L3, 74180000=12005000= + L4, 74185000=12005000= + EXIT; 74190000=12005000= + S:= 0; 74195000=12006000= + IF STEPI ^= LEFTPAREN THEN 74200000=12007000= + ERR(281) 74205000=12008000= + ELSE 74210000=12008000= + L1: 74215000=12009000= + BEGIN 74220000=12009000= + IF STEPI = COMMA THEN 74225000=12010000= + BEGIN 74230000=12011000= + DPTOG:= TRUE; 74235000=12012000= + IF STEPI = ADOP THEN 74240000=12013000= + STEPIT; 74245000=12013000= + EMITNUM(NLO); 74250000=12014000= + EMITNUM(IF ELBAT[I-1].ADDRESS = SUB THEN-NHI ELSE NHI); 74255000=12015000= + DPTOG:= FALSE; 74260000=12016000= + STEPIT; 74265000=12017000= + GO TO L2; 74270000=12018000= + END; 74275000=12019000= + IF TABLE(I+1) = COMMA THEN 74280000=12020000= + BEGIN 74285000=12021000= + IF ELCLASS = ADOP OR ELCLASS = MULOP THEN 74290000=12022000= + BEGIN 74295000=12023000= + EMITO(ELBAT[I].ADDRESS+1); 74300000=12024000= + L4: IF(S:= S-1) <= 0 THEN 74305000=12025000= + FLAG(282); 74310000=12025000= + STEPIT; 74315000=12025000= + GO TO L3; 74320000=12026000= + END; 74325000=12027000= + IF ELCLASS = ASSIGNOP THEN 74330000=12028000= + BEGIN 74335000=12029000= + IF S:= S-1 < 0 THEN 74340000=12030000= + FLAG(285); 74345000=12030000= + T:= 0; 74350000=12030000= + STEPIT; 74355000=12030000= + DO BEGIN 74360000=12032000= + IF ELCLASS ^= COMMA THEN 74365000=12033000= + BEGIN 74370000=12033000= + ERR(284); 74375000=12033000= + GO EXIT 74380000=12033000= + END; 74385000=12033000= + STEPIT; 74390000=12034000= + B:= ELCLASS = INTID OR ELCLASS = INTARRAYID OR ELCLASS = 74395000=12034110= + INTPROCID; 74400000=12034110= + IF ELCLASS <= INTID AND ELCLASS >= REALID THEN 74405000=12035000= + BEGIN 74410000=12036000= + EMITN(ELBAT[I].ADDRESS); 74415000=12036000= + STEPIT 74420000=12036000= + END 74425000=12036100= + ELSE 74430000=12036100= + IF ELCLASS <= INTPROCID AND ELCLASS >= REALPROCID THEN 74435000=12036200= + IF ELBAT[I].LINK ^= PROINFO.LINK THEN 74440000=12036200= + FLAG(211) 74445000=12036300= + ELSE 74450000=12036300= + BEGIN 74455000=12036300= + EMITL(514); 74460000=12036300= + STEPIT 74465000=12036300= + END 74470000=12036400= + ELSE 74475000=12036400= + IF ELCLASS > INTARRAYID OR ELCLASS < REALARRAYID THEN 74480000=12036500= + ERR(286) 74485000=12037000= + ELSE 74490000=12037000= + VARIABLE(FL); 74495000=12037000= + EMITO(IF B THEN ISD ELSE STD) 74500000=12038000= + END 74505000=12038000= + UNTIL T:= T+1 = 2; 74510000=12038000= + IF ELCLASS ^= RTPAREN THEN 74515000=12039000= + GO L3; 74520000=12039000= + IF S ^= 0 THEN 74525000=12039100= + FLAG(283) 74530000=12040000= + ELSE 74535000=12040000= + BEGIN 74540000=12040000= + STEPIT; 74545000=12040000= + GO EXIT 74550000=12040000= + END; 74555000=12040000= + END; 74560000=12041000= + IF ELCLASS = FACTOP THEN 74565000=12041100= + BEGIN 74570000=12041110= + EMITO(MKS); 74575000=12041130= + EMITL(4); 74580000=12041130= + EMITV(GNAT(POWERALL)); 74585000=12041130= + EMITO(DEL); 74590000=12041140= + EMITO(DEL); 74595000=12041140= + GO L4; 74600000=12041140= + END; 74605000=12041160= + IF ELCLASS <= INTID AND ELCLASS >= BOOID THEN 74610000=12042000= + BEGIN 74615000=12043000= + CHECKER(T:= ELBAT[I]); 74620000=12044000= + STEPIT; 74625000=12045000= + STEPIT; 74630000=12045000= + AEXP; 74635000=12046000= + EMITV(T.ADDRESS); 74640000=12047000= + GO TO L2; 74645000=12048000= + END; 74650000=12049000= + END; 74655000=12050000= + AEXP; 74660000=12051000= + IF ELCLASS ^= COMMA THEN 74665000=12052000= + BEGIN 74670000=12052000= + ERR(284); 74675000=12052000= + GO EXIT 74680000=12053000= + END; 74685000=12053000= + STEPIT; 74690000=12054000= + AEXP; 74695000=12054000= + EMITO(XCH); 74700000=12054000= + L2: S:= S+1; 74705000=12055000= + L3: IF ELCLASS ^= COMMA THEN 74710000=12056000= + BEGIN 74715000=12056000= + ERR(284); 74720000=12056000= + GO TO EXIT 74725000=12056000= + END; 74730000=12056000= + GO TO L1; 74735000=12057000= + EXIT: 74740000=12058000= + END 74745000=12059000= + END DBLSTMT; 74750000=12059000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%74755000=12059000= + PROCEDURE CMPLXSTMT; 74760000=12060000= + BEGIN 74765000=12060100= + REAL 74770000=12060200= + S, 74775000=12060200= + T; 74780000=12060200= + BOOLEAN 74785000=12060250= + B; 74790000=12060250= + LABEL 74795000=12060300= + L1, 74800000=12060300= + L2, 74805000=12060300= + L3, 74810000=12060300= + L4, 74815000=12060300= + L5, 74820000=12060300= + EXIT, 74825000=12060300= + ERROR; 74830000=12060300= + DEFINE 74835000=12060400= + ERRX(ERRX1) = BEGIN 74840000=12060400= + T:= ERRX1; 74845000=12060400= + GO ERROR 74850000=12060400= + END #; 74855000=12060400= + IF STEPI ^= LEFTPAREN THEN 74860000=12060500= + ERRX(381); 74865000=12060500= +L1: STEPIT; 74870000=12060550= + IF TABLE(I+1) = COMMA THEN 74875000=12060600= + BEGIN 74880000=12060700= + IF ELCLASS = ADOP THEN 74885000=12060800= + BEGIN 74890000=12060900= + T:= ELBAT[I].ADDRESS; 74895000=12061000= + EMITPAIR(9, STD); 74900000=12061100= + EMITO(XCH); 74905000=12061100= + EMITV(9); 74910000=12061100= + EMITO(T); 74915000=12061100= + EMITPAIR(9, STD); 74920000=12061200= + EMITO(T); 74925000=12061200= + EMITV(9); 74930000=12061200= + L4: IF S:= S-1 < 1 THEN 74935000=12061300= + FLAG(382); 74940000=12061300= + STEPIT; 74945000=12061300= + GO L1; 74950000=12061300= + END; 74955000=12061400= + IF ELCLASS = MULOP THEN 74960000=12061500= + BEGIN 74965000=12061600= + EMITO(MKS); 74970000=12061700= + EMITL(IF ELBAT[I].ADDRESS = MUL THEN 26 ELSE 35); 74975000=12061725= + EMITV(GNAT(SPECIALMATH)); 74980000=12061750= + L5: EMITO(DEL); 74985000=12061800= + EMITO(DEL); 74990000=12061800= + GO L4; 74995000=12061800= + END; 75000000=12061900= + IF ELCLASS = ASSIGNOP THEN 75005000=12062000= + BEGIN 75010000=12062100= + IF S:= S-1 < 0 THEN 75015000=12062200= + FLAG(385); 75020000=12062200= + T:= 0; 75025000=12062200= + STEPIT; 75030000=12062200= + B:= ELCLASS = INTID OR ELCLASS = INTPROCID OR ELCLASS = 75035000=12062255= + INTARRAYID; 75040000=12062255= + DO BEGIN 75045000=12062300= + IF ELCLASS ^= COMMA THEN 75050000=12062400= + ERRX(384); 75055000=12062400= + STEPIT; 75060000=12062400= + IF ELCLASS > BOOID AND ELCLASS < BOOARRAYID THEN 75065000=12062500= + BEGIN 75070000=12062600= + EMITN(ELBAT[I].ADDRESS); 75075000=12062600= + STEPIT 75080000=12062600= + END 75085000=12062700= + ELSE 75090000=12062700= + IF ELCLASS > BOOPROCID AND ELCLASS < BOOID THEN 75095000=12062700= + IF ELBAT[I].LINK ^= PROINFO.LINK THEN 75100000=12062800= + FLAG(211) 75105000=12062900= + ELSE 75110000=12062900= + BEGIN 75115000=12062900= + EMITL(514); 75120000=12062900= + STEPIT 75125000=12062900= + END 75130000=12063000= + ELSE 75135000=12063000= + IF ELCLASS < LABELID AND ELCLASS > BOOARRAYID THEN 75140000=12063100= + VARIABLE(FL) 75145000=12063200= + ELSE 75150000=12063200= + ERRX(386); 75155000=12063200= + EMITO(IF B THEN ISD ELSE STD); 75160000=12063300= + END 75165000=12063500= + UNTIL T:= T+1 = 2; 75170000=12063500= + IF ELCLASS ^= RTPAREN THEN 75175000=12063600= + GO L3; 75180000=12063600= + IF S ^= 0 THEN 75185000=12063610= + FLAG(383) 75190000=12063610= + ELSE 75195000=12063610= + BEGIN 75200000=12063610= + STEPIT; 75205000=12063610= + GO EXIT 75210000=12063610= + END; 75215000=12063610= + END; 75220000=12063700= + IF ELCLASS = FACTOP THEN 75225000=12063800= + BEGIN 75230000=12063900= + EMITO(MKS); 75235000=12064000= + EMITL(8); 75240000=12064000= + EMITV(GNAT(POWERALL)); 75245000=12064000= + GO L5; 75250000=12064000= + END; 75255000=12064100= + IF ELCLASS > BOOID AND ELCLASS < BOOARRAYID THEN 75260000=12064200= + BEGIN 75265000=12064300= + CHECKER(T:= ELBAT[I]); 75270000=12064400= + STEPIT; 75275000=12064400= + STEPIT; 75280000=12064400= + AEXP; 75285000=12064400= + EMITV(T.ADDRESS); 75290000=12064500= + GO L2; 75295000=12064500= + END; 75300000=12064600= + END; 75305000=12064700= + AEXP; 75310000=12064800= + IF ELCLASS ^= COMMA THEN 75315000=12064800= + ERRX(384); 75320000=12064800= + STEPIT; 75325000=12064800= + AEXP; 75330000=12064800= + EMITO(XCH); 75335000=12064800= +L2: S:= S+1; 75340000=12064900= +L3: IF ELCLASS = COMMA THEN 75345000=12065000= + GO L1; 75350000=12065000= + T:= 384; 75355000=12065000= +ERROR: 75360000=12065200= + ERR(T); 75365000=12065200= +EXIT: 75370000=12065400= + END OF CMPLXSTMT; 75375000=12065400= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%75380000=12065400= + REAL PROCEDURE FIXDEFINEINFO(T); 75385000=12101000= + VALUE 75390000=12101000= + T; 75395000=12101000= + REAL 75400000=12101000= + T; 75405000=12101000= + BEGIN 75410000=12102000= + REAL 75415000=12102000= + K, 75420000=12102000= + S, 75425000=12102000= + P, 75430000=12102000= + J, 75435000=12102000= + EL; 75440000=12102000= + MACROID:= TRUE; 75445000=12107000= + P:= GIT(FIXDEFINEINFO:= T); 75450000=12108000= + STOPDEFINE:= TRUE; 75455000=12111000= + FL:= TABLE(NXTELBT); 75460000=12112000= + NXTELBT:= NXTELBT-1; 75465000=12113000= + IF EL ^= LEFTPAREN AND EL ^= LFTBRKET THEN 75470000=12114000= + FLAG(175) % [ OR ( EXPECTED. 75475000=12115000= + ELSE 75480000=12116000= + DO BEGIN 75485000=12116000= + J:= J+1; 75490000=12116000= + TEXT[NEXTTEXT.LINKR, NEXTTEXT.LINKC]:= TAKE(P); 75495000=12117000= + NEXTTEXT:= NEXTTEXT+1; 75500000=12118000= + PUT 75505000=12122000= + (TAKE(P) & NEXTTEXT[11:32:16] & DEFSTACKHEAD[35:35:13], P)75510000=12122000= + ; 75515000=12122000= + DEFSTACKHEAD:= P.LINK; 75520000=12123000= + P:= GIT(K:= P); 75525000=12123500= + DEFINEGEN(TRUE, 0); 75530000=12124000= + END 75535000=12125000= + UNTIL EL:= ELBAT[NXTELBT].CLASS ^= COMMA OR K = P; 75540000=12125000= + IF EL ^= RTPAREN AND EL ^= RTBRKET OR K ^= P THEN 75545000=12126000= + FLAG(174); %INCORRECT # OF PARAMS IN DEFINE INVOCATION. 75550000=12126100= + MACROID:= FALSE; 75555000=12127000= + END; 75560000=12128000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%75565000=12128000= + PROCEDURE DEFINEPARAM(DINFO, N); 75570000=12150000= + 75575000=12150100= +COMMENT DEFINEPARAM GENERATES EVERYTHING (EXCEPT THE ELBAT 75580000=12150100= + WORD) FOR AN INFO TABLE ENTRY FOR A PARAMETER OF A 75585000=12150200= + PARAMETRIC DEFINE. 75590000=12150300= + ; 75595000=12150400= + VALUE 75600000=12151000= + DINFO, 75605000=12151000= + N; 75610000=12151000= + INTEGER 75615000=12151000= + DINFO, 75620000=12151000= + N; 75625000=12151000= + BEGIN 75630000=12152000= + INTEGER 75635000=12153000= + J; 75640000=12153000= + STREAM PROCEDURE MAKEPARAM(INF, ACC, C, Q, N); 75645000=12154000= + VALUE 75650000=12154000= + C, 75655000=12154000= + Q, 75660000=12154000= + N; 75665000=12154000= + BEGIN 75670000=12155000= + DI:= ACC; 75675000=12156000= + DI:= DI+3; 75680000=12156000= + SI:= INF; 75685000=12157000= + SI:= SI+3; 75690000=12157000= + DS:= C CHR; 75695000=12157000= + SI:= LOC N; 75700000=12158000= + SI:= SI+7; 75705000=12158000= + DS:= 1 CHR; 75710000=12158000= + SI:= LOC Q; 75715000=12159000= + SI:= SI+6; 75720000=12159000= + DS:= 1 CHR; 75725000=12159000= + DI:= ACC; 75730000=12160000= + DI:= DI+2; 75735000=12160000= + DS:= 1 CHR; 75740000=12160000= + END MAKEPARAM; 75745000=12161000= + ACCUM[1]:= 0; 75750000=12161500= + MAKEPARAM(INFO[DINFO.LINKR, DINFO.LINKC], ACCUM[1], 75755000=12163000= + J:= INFO[DINFO.LINKR, DINFO.LINKC].[12:6], 7770+J, N); 75760000=12163000= + SCRAM:= ACCUM[1] MOD 125; 75765000=12164000= + COUNT:= J+2; 75770000=12165000= + END DEFINEPARAM; 75775000=12166000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%75780000=12166000= + 75785000=13000000= + COMMENT THIS SECTION CONTAINS THE PROCEDURES USED BY THE BLOCK ROUTINE;75790000=13000000= + PROCEDURE IODEC(IOT); 75795000=13001000= + VALUE 75800000=13002000= + IOT; 75805000=13002000= + INTEGER 75810000=13003000= + IOT; 75815000=13003000= + BEGIN 75820000=13004000= + STREAM PROCEDURE GET7(ACCUM, RESULT); 75825000=13005000= + BEGIN 75830000=13006000= + LOCAL T, T1; 75835000=13007000= + LABEL 75840000=13007000= + EXIT; 75845000=13007000= + SI:= ACCUM; 75850000=13008000= + SI:= SI+2; 75855000=13008000= + DI:= LOC T; 75860000=13008000= + DI:= DI+7; 75865000=13008000= + DS:= CHR; 75870000=13009000= + T1:= SI; 75875000=13009000= + SI:= LOC T; 75880000=13009000= + SI:= SI+7; 75885000=13009000= + DI:= RESULT; 75890000=13010000= + DS:= 8 LIT 6"0 "; 75895000=13010000= + DI:= DI-7; 75900000=13010000= + IF SC >= 6"0" THEN 75905000=13012000= + IF SC < 6"8" THEN 75910000=13013000= + BEGIN 75915000=13014000= + SI:= T1; 75920000=13015000= + DS:= T CHR; 75925000=13015000= + GO TO EXIT 75930000=13016000= + END; 75935000=13016000= + SI:= T1; 75940000=13017000= + DS:= 7 CHR; 75945000=13017000= + EXIT: 75950000=13019000= + END; 75955000=13019000= + STREAM PROCEDURE 75960000=13020000= + ENTERID(IDLOC, FILENO, TYPE, MULFID, FILID, FILID1, N); 75965000=13020000= + VALUE 75970000=13021000= + FILENO, 75975000=13021000= + TYPE, 75980000=13021000= + MULFID, 75985000=13021000= + FILID, 75990000=13021000= + N; 75995000=13021000= + BEGIN 76000000=13022000= + DI:= IDLOC; 76005000=13023000= + DI:= DI+5; 76010000=13023000= + DI:= DC; 76015000=13023000= + SI:= LOC FILENO; 76020000=13024000= + SI:= SI+6; 76025000=13024000= + DS:= 2 CHR; 76030000=13025000= + SI:= LOC TYPE; 76035000=13025000= + SI:= SI+7; 76040000=13026000= + DS:= CHR; 76045000=13026000= + SI:= LOC MULFID; 76050000=13027000= + SI+SI+1; 76055000=13027000= + DS:= 7 CHR; 76060000=13028000= + SI:= LOC FILID; 76065000=13029000= + SI:= SI+1; 76070000=13029000= + DS:= 7 CHR; 76075000=13030000= + SI:= LOC N; 76080000=13031000= + SI:= SI+7; 76085000=13031000= + DS:= CHR; 76090000=13032000= + SI:= FILID1; 76095000=13033000= + SI:= SI+3; 76100000=13033000= + DS:= N CHR; 76105000=13034000= + N:= DI; 76110000=13034000= + DI:= IDLOC; 76115000=13035000= + DI:= DI+5; 76120000=13035000= + SI:= LOC N; 76125000=13036000= + SI:= SI+5; 76130000=13036000= + DS:= 3 CHR 76135000=13038000= + END; 76140000=13038000= + REAL 76145000=13039000= + MULFID, 76150000=13039000= + FILID, 76155000=13039000= + TYPE, 76160000=13039000= + M, 76165000=13039000= + K; 76170000=13039000= + DEFINE 76175000=13039400= + CALL5 = EMITL(0); 76180000=13039400= + EMITL(IOT); 76185000=13039400= + EMITL(8); 76190000=13039400= + EMITV(5) #; 76195000=13039400= + REAL 76200000=13039450= + SAVADDRSF; 76205000=13039450= + REAL 76210000=13039500= + ACCUM1; 76215000=13039500= + INTEGER 76220000=13039550= + CURRENT, 76225000=13039550= + IOTEMP, 76230000=13039550= + IOTEMPO; 76235000=13039550= + LABEL 76240000=13040000= + START; 76245000=13040000= + JUMPCHKX; 76250000=13041000= + IF G:= GTA1[J:= J-1] = FILEV THEN 76255000=13043000= + BEGIN 76260000=13044000= + IF G:= GTA1[J:= J-1] = SWITCHV THEN 76265000=13046000= + BEGIN 76270000=13047000= + STOPENTRY:= NOT SPECTOG; 76275000=13048000= + ENTRY(SUPERFILEID); 76280000=13049000= + IF SPECTOG THEN 76285000=13050000= + GO TO START; 76290000=13050000= + IF ELCLASS ^= ASSIGNOP THEN 76295000=13052000= + FLAG(34); 76300000=13052000= + EMITO(MKS); 76305000=13053000= + CHECKDISJOINT(ADDRSF); 76310000=13054000= + G:= L; 76315000=13055000= + L:= L+1; 76320000=13055000= + EMITL(1); 76325000=13056000= + EMITL(1); 76330000=13057000= + EMITL(1); 76335000=13058000= + EMITV(5); 76340000=13059000= + J:= -1; 76345000=13061000= + STOPENTRY:= FALSE; 76350000=13061000= + DO BEGIN 76355000=13063000= + IF STEPI ^= FILEID % 76360000=13064000= + THEN 76365000=13065000= + FLAG(35); 76370000=13065000= + PASSFILE; 76375000=13066000= + EMITL(J:= J+1); 76380000=13067000= + EMITN(ADDRSF); 76385000=13068000= + EMITO(STD); 76390000=13069000= + END 76395000=13071000= + UNTIL ELCLASS ^= COMMA; 76400000=13071000= + GT2:= L; 76405000=13072000= + L:= G; 76410000=13072000= + EMITL(J+1); 76415000=13072000= + L:= GT2; 76420000=13072000= + GO TO START 76425000=13073000= + END; 76430000=13073000= + I:= I-1; 76435000=13074000= + M:= 1; 76440000=13074000= + IF G = ALFAV THEN 76445000=13076000= + M:= 0 76450000=13077000= + ELSE 76455000=13077000= + J:= J+1; 76460000=13077000= + K:= J; 76465000=13077000= + STOPENTRY:= NOT SPECTOG; 76470000=13077000= + DO BEGIN 76475000=13079000= + STOPDEFINE:= TRUE; 76480000=13079500= + STEPIT; 76485000=13080000= + J:= K; 76490000=13080000= + P2:= P3:= P4:= FALSE; 76495000=13080000= + GTA1[0]:= 0; 76500000=13080000= + GET7(ACCUM[1], FILID); 76505000=13080000= + MULFID:= 0; 76510000=13081000= + TYPE:= 2; 76515000=13081000= + ENTER(FILEID); 76520000=13081000= + SAVADDRSF:= ADDRSF; 76525000=13081500= + IF SPECTOG THEN 76530000=13082000= + GO TO START; 76535000=13082000= + EMITO(MKS); 76540000=13082500= + EMITL(0); 76545000=13082500= + EMITL(0); 76550000=13082500= + IF ELCLASS = LITNO THEN 76555000=13084000= + BEGIN 76560000=13085000= + TYPE:= ELBAT[I].ADDRESS; 76565000=13086000= + STEPIT 76570000=13088000= + END; 76575000=13088000= + IF ELCLASS <= IDMAX THEN 76580000=13088010= + BEGIN 76585000=13088020= +% TO VOID A CARD 76590000=13088025= + IF ACCUM1:= ACCUM[1] = 6"5PRINT" THEN 76595000=13088030= + TYPE:= 1 76600000=13088030= + ELSE 76605000=13088030= + IF ACCUM1 = 6"6REMOT" THEN 76610000=13088035= + TYPE:= 19 76615000=13088035= + ELSE 76620000=13088035= + IF ACCUM1 = 6"5PUNCH" THEN 76625000=13088040= + TYPE:= 0 76630000=13088040= + ELSE 76635000=13088040= + IF ACCUM1 = 6"4DISK0" THEN 76640000=13088050= + BEGIN 76645000=13088050= + STOPDEFINE:= TRUE; 76650000=13088050= + TYPE:= 12; 76655000=13088060= + IF STEPI <= IDMAX THEN 76660000=13088060= + BEGIN 76665000=13088060= + IF ACCUM1:= ACCUM[1] ^= 6"6SERIA" THEN 76670000=13088070= + BEGIN 76675000=13088070= + IF ACCUM1 = 6"6RANDO" THEN 76680000=13088070= + TYPE:= TYPE-2 76685000=13088075= + ELSE 76690000=13088075= + IF ACCUM1 = 6"6UPDAT" THEN 76695000=13088075= + TYPE:= TYPE+1 76700000=13088080= + ELSE 76705000=13088080= + IF ACCUM1 = 6"7PROTE" THEN 76710000=13088082= + TYPE:= 26 76715000=13088082= + ELSE 76720000=13088082= + FLAG(43); 76725000=13088085= + END; 76730000=13088085= + STEPIT; 76735000=13088085= + END; 76740000=13088085= + IF ELCLASS = LFTBRKET THEN 76745000=13088085= + BEGIN 76750000=13088090= + STEPIT; 76755000=13088090= + L:= L-2; 76760000=13088090= + AEXP; 76765000=13088090= + IF ELCLASS = COLON THEN 76770000=13088090= + BEGIN 76775000=13088090= + STEPIT; 76780000=13088100= + AEXP 76785000=13088100= + END 76790000=13088100= + ELSE 76795000=13088100= + FLAG(30); 76800000=13088100= + IF ELCLASS ^= RTBRKET THEN 76805000=13088105= + FLAG(44); 76810000=13088105= + END 76815000=13088105= + ELSE 76820000=13088105= + I:= I-1; 76825000=13088105= + END; 76830000=13088110= + STEPIT 76835000=13088130= + END; 76840000=13088130= + IF ELCLASS = STRNGCON THEN 76845000=13089000= + BEGIN 76850000=13090000= + GET7(ACCUM[1], G); 76855000=13091000= + IF STEPI = STRNGCON THEN 76860000=13093000= + BEGIN 76865000=13094000= + GET7(ACCUM[1], FILID); 76870000=13095000= + STEPIT; 76875000=13096000= + MULFID:= G 76880000=13098000= + END 76885000=13100000= + ELSE 76890000=13100000= + FILID:= G; 76895000=13100000= + END; 76900000=13101000= + IF MKABS(IDARRAY[127])-IDLOC.[33:15] < (26+KOUNT).[41:4] THEN76905000=13101200= + FLAG(040) 76910000=13101200= + ELSE 76915000=13101200= + ENTERID(IDLOC, FILENO, TYPE, MULFID, FILID, 76920000=13103000= + INFO[(LASTINFO+1).LINKR, (LASTINFO+1).LINKC], KOUNT); 76925000=13103000= + IF ELCLASS ^= LEFTPAREN THEN 76930000=13105000= + FLAG(26); 76935000=13105000= + ARRAYFLAG:= BOOLEAN(3); 76940000=13106000= + EMITL(REAL(NOT (P2 OR P3)).[46:2]); 76945000=13108000= + EMITL(FILENO); 76950000=13109000= + FILENO:= FILENO+1; 76955000=13109000= + CHECKDISJOINT(TAKE(LASTINFO).ADDRESS); 76960000=13110000= + STEPIT; 76965000=13111000= + AEXP; 76970000=13111000= + EMITL(M); 76975000=13111000= + COMMENT GUESS AT THE NO. OF BUFFERS DECLARED; 76980000=13112000= + IF(IOTEMP:= GET(L-2)).[46:2] = 0 THEN 76985000=13113000= + CURRENT:= IOTEMP DIV 4 76990000=13114000= + ELSE 76995000=13114000= + CURRENT:= 2; 77000000=13114000= + IF ELCLASS ^= COMMA THEN 77005000=13145000= + BEGIN 77010000=13145000= + FLAG(27); 77015000=13145000= + GO TO START 77020000=13145000= + END 77025000=13147000= + ELSE 77030000=13147000= + BEGIN 77035000=13147000= + STEPIT; 77040000=13148000= + AEXP; 77045000=13148000= + ; 77050000=13148100= + IF(IOTEMP:= GET(L-1)).[46:2] = 0 THEN 77055000=13148200= + IOTEMP:= IOTEMP DIV 4 77060000=13148300= + ELSE 77065000=13148300= + IOTEMP:= 256; 77070000=13148300= + IF ELCLASS ^= COMMA THEN 77075000=13150000= + BEGIN 77080000=13151000= + EMITL(0); 77085000=13152000= + CALL5; 77090000=13153000= + END 77095000=13156000= + ELSE 77100000=13156000= + BEGIN 77105000=13156000= + IF GT1:= FILEATTRIBUTEINDX(FALSE) = 0 THEN 77110000=13157000= + BEGIN 77115000=13157010= + AEXP; 77120000=13157010= + IF(IOTEMPO:= GET(L-1)).[46:2] = 0 THEN 77125000=13157020= + IF IOTEMPO DIV 4 > IOTEMP THEN 77130000=13157030= + IOTEMP:= IOTEMPO DIV 4; 77135000=13157040= + CALL5; 77140000=13157040= + END 77145000=13158000= + ELSE 77150000=13158000= + BEGIN 77155000=13158000= + EMITL(0); 77160000=13159000= + CALL5; 77165000=13159000= + EMITO(MKS); 77170000=13159000= + EMITL(5); 77175000=13159000= + EMITN(SAVADDRSF); 77180000=13160000= + GT1:= FILEATTRIBUTEHANDLER(FIO); 77185000=13160000= + END; 77190000=13161000= + WHILE ELCLASS = COMMA DO 77195000=13162000= + IF GT1:= FILEATTRIBUTEINDX(TRUE) = 0 THEN 77200000=13163000= + BEGIN 77205000=13164000= + ERR(291); 77210000=13164000= + GO START 77215000=13164000= + END 77220000=13165000= + ELSE 77225000=13165000= + BEGIN 77230000=13165000= + EMITO(MKS); 77235000=13166000= + EMITL(5); 77240000=13166000= + EMITN(SAVADDRSF); 77245000=13166000= + GT1:= FILEATTRIBUTEHANDLER(FIO); 77250000=13167000= + END; 77255000=13168000= + END; 77260000=13169000= + END; 77265000=13170000= + ARRAYFLAG:= FALSE; 77270000=13181000= + IF ELCLASS ^= RTPAREN THEN 77275000=13182000= + FLAG(29); 77280000=13182000= + COMMENT TOTAL UP THE BUFFER REQ. PER FILE DECLARATION; 77285000=13183000= + IOBUFFSIZE:= IOBUFFSIZE+50+(CURRENT*IOTEMP); 77290000=13184000= +% VOID 77295000=13185000= +% VOID 77300000=13186000= + END 77305000=13188000= + UNTIL STEPI ^= COMMA; 77310000=13188000= + STOPENTRY:= FALSE; 77315000=13189000= + END 77320000=13191000= + ELSE 77325000=13191000= + BEGIN 77330000=13191000= + IF G ^= FORMATV THEN 77335000=13192000= + FLAG(33) 77340000=13192000= + ELSE 77345000=13192000= + IF SPECTOG THEN 77350000=13193000= + ENTRY(FRMTID+REAL(GTA1[J-1] = SWITCHV)) 77355000=13193000= + ELSE 77360000=13193000= + FORMATGEN 77365000=13194000= + END; 77370000=13194000= +START: 77375000=13196000= + END; 77380000=13196000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%77385000=13196000= + PROCEDURE HANDLESWLIST; 77390000=13196300= + BEGIN 77395000=13196310= + LABEL 77400000=13196320= + OVER; 77405000=13196320= + JUMPCHKX; 77410000=13196340= + STOPENTRY:= NOT SPECTOG; 77415000=13196350= + ENTRY(SUPERLISTID); 77420000=13196360= + IF SPECTOG THEN 77425000=13196370= + GO TO OVER; 77430000=13196370= + IF ELCLASS ^= ASSIGNOP THEN 77435000=13196380= + FLAG(41); 77440000=13196380= + COMMENT MISSING ~; 77445000=13196390= + EMITO(MKS); 77450000=13196400= + CHECKDISJOINT(ADDRSF); 77455000=13196410= + G:= L; 77460000=13196420= + L:= L+1; 77465000=13196420= + EMITL(1); 77470000=13196430= + EMITL(1); 77475000=13196440= + EMITL(1); 77480000=13196450= + EMITV(5); 77485000=13196460= + COMMENT CREATE AN ARRAY TO HOLD 77490000=13196460= + LIST DESCRIPTORS FOR SWITCH LIST; 77495000=13196470= + COMMENT USED TO USE EMITN(XITR), DOESN"T ANYMORE; 77500000=13196480= + J:= -1; 77505000=13196490= + STOPENTRY:= FALSE; 77510000=13196490= + DO BEGIN 77515000=13196510= + IF STEPI ^= LISTID AND ELCLASS ^= SUPERLISTID THEN 77520000=13196530= + BEGIN 77525000=13196530= + ERR(42); 77530000=13196530= + GO TO OVER 77535000=13196530= + END; 77540000=13196530= + PASSLIST; 77545000=13196540= + EMITL(J:= J+1); 77550000=13196550= + EMITN(ADDRSF); 77555000=13196560= + EMITO(STD); 77560000=13196570= + COMMENT STORE LIST DESC IN ARRAY;77565000=13196570= + END 77570000=13196590= + UNTIL ELCLASS ^= COMMA; 77575000=13196590= + GT2:= L; 77580000=13196600= + L:= G; 77585000=13196600= + EMITL(J+1); 77590000=13196600= + L:= GT2; 77595000=13196600= +OVER: 77600000=13196610= + END OF HANDLESWLIST; 77605000=13196610= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%77610000=13196610= + PROCEDURE SCATTERELBAT; 77615000=13197000= + BEGIN 77620000=13198000= + REAL 77625000=13199000= + T; 77630000=13199000= + T:= ELBAT[I]; 77635000=13200000= + KLASSF:= T.CLASS; 77640000=13201000= + FORMALF:= BOOLEAN(T.FORMAL); 77645000=13202000= + VONF:= BOOLEAN(T.VO); 77650000=13203000= + LEVELF:= T.LVL; 77655000=13204000= + ADDRSF:= T.ADDRESS; 77660000=13205000= + INCRF:= T.INCR; 77665000=13206000= + LINKF:= T.LINK; 77670000=13207000= + END SCATTERELBAT; 77675000=13208000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%77680000=13208000= + PROCEDURE CHKSOB; 77685000=13209000= + IF GTA1[J:= J-1] ^= 0 THEN 77690000=13210000= + FLAG(23); 77695000=13210000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%77700000=13210000= + DEFINE 77705000=13211000= + SUBOP = 48 #, 77710000=13212000= + ADDC = 532480 #, 77715000=13213000= + SUBC = 1581056 #, 77720000=13214000= + EMITSTORE = EMITPAIR #; 77725000=13214000= + PROCEDURE PURGE(STOPPER); 77730000=13215000= + VALUE 77735000=13216000= + STOPPER; 77740000=13216000= + REAL 77745000=13217000= + STOPPER; 77750000=13217000= + BEGIN 77755000=13218000= + INTEGER 77760000=13219000= + POINTER; 77765000=13219000= + LABEL 77770000=13220000= + RECOV; 77775000=13220000= + DEFINE 77780000=13220000= + ELCLASS = KLASSF #; 77785000=13220000= + REAL 77790000=13221000= + J, 77795000=13221000= + N, 77800000=13221000= + OCR, 77805000=13221000= + TL, 77810000=13221000= + ADD; 77815000=13221000= + POINTER:= LASTINFO; 77820000=13222000= + WHILE POINTER >= STOPPER DO 77825000=13224000= + BEGIN 77830000=13225000= + IF ELCLASS:= (GT1:= TAKE(POINTER)).CLASS = NONLITNO THEN 77835000=13227000= + BEGIN 77840000=13227000= + NCII:= NCII-1; 77845000=13228000= + EMITNUM(TAKE(POINTER+1)); 77850000=13229000= + EMITSTORE(MAXSTACK, STD); 77855000=13230000= + MAXSTACK:= (G:= MAXSTACK)+1; 77860000=13231000= + J:= L; 77865000=13232000= + L:= GT1.LINK; 77870000=13232000= + DO BEGIN 77875000=13234000= + GT4:= GET(L); 77880000=13235000= + EMITV(G) 77885000=13237000= + END 77890000=13238000= + UNTIL (L:= GT4) = 4095; 77895000=13238000= + L:= J; 77900000=13239000= + POINTER:= POINTER-GT1.INCR 77905000=13241000= + END 77910000=13243000= + ELSE 77915000=13243000= + BEGIN 77920000=13243000= + IF NOT BOOLEAN(GT1.FORMAL) THEN 77925000=13245000= + BEGIN 77930000=13245000= + IF ELCLASS = LABELID THEN 77935000=13247000= + BEGIN 77940000=13247000= + ADD:= GT1.ADDRESS; 77945000=13248000= + IF NOT BOOLEAN(OCR:= TAKE(GIT(POINTER))).[1:1] THEN 77950000=13250000= + IF OCR.[36:12] ^= 0 OR ADD ^= 0 THEN 77955000=13251000= + BEGIN 77960000=13251000= + GT1:= 160; 77965000=13251000= + GO TO RECOV 77970000=13251000= + END; 77975000=13251000= + IF ADD ^= 0 THEN 77980000=13252000= + GT1:= PROGDESCBLDR(2, OCR, ADD) 77985000=13253000= + END 77990000=13253000= + ELSE 77995000=13253000= + IF ELCLASS = SWITCHID THEN 78000000=13254000= + BEGIN 78005000=13254000= + IF TAKE(POINTER+1) < 0 THEN 78010000=13256000= + BEGIN 78015000=13256000= + GT1:= 162; 78020000=13256000= + GO TO RECOV 78025000=13256000= + END; 78030000=13256000= + OCR:= (J:= TAKE(GIT(POINTER))).[24:12]; 78035000=13257000= + N:= GET((J:= J.[36:12])+4); 78040000=13258000= + TL:= L; 78045000=13258000= + IF ADD:= GT1.ADDRESS ^= 0 THEN 78050000=13260000= + BEGIN 78055000=13260000= + GT5:= PROGDESCBLDR(0, J, ADD); 78060000=13261000= + IF OCR ^= 0 THEN 78065000=13263000= + BEGIN 78070000=13263000= + L:= OCR-2; 78075000=13263000= + CALLSWITCH(POINTER); 78080000=13263000= + EMITO(BFW); 78085000=13263000= + END; 78090000=13263000= + L:= J+11; 78095000=13264000= + EMITL(15); 78100000=13264000= + EMITO(RTS); 78105000=13264000= + FOR J:= 4 STEP 4 UNTIL N DO 78110000=13266000= + BEGIN 78115000=13266000= + EMITL(GNAT(GET(L)*4096+GET(L+1))); 78120000=13267000= + EMITO(RTS) 78125000=13268000= + END 78130000=13269000= + END 78135000=13269000= + ELSE 78140000=13269000= + BEGIN 78145000=13269000= + L:= J+13; 78150000=13270000= + FOR J:= 4 STEP 4 UNTIL N DO 78155000=13272000= + BEGIN 78160000=13272000= + GT1:= GET(L)*4096+GET(L+1); 78165000=13273000= + GOGEN(GT1, BFW) 78170000=13274000= + END; 78175000=13274000= + END; 78180000=13274000= + L:= TL 78185000=13277000= + END 78190000=13278000= + ELSE 78195000=13278000= + IF ELCLASS >= PROCID AND ELCLASS <= INTPROCID THEN 78200000=13279000= + IF TAKE(POINTER+1) < 0 THEN 78205000=13280000= + BEGIN 78210000=13280000= + GT1:= 161; 78215000=13280000= + RECOV: 78220000=13281000= + MOVE(9, INFO[POINTER.LINKR, POINTER.LINKC], ACCUM); 78225000=13281000= + Q:= ACCUM[1]; 78230000=13282000= + FLAG(GT1); 78235000=13282000= + ERRORTOG:= TRUE 78240000=13282000= + END 78245000=13283000= + END; 78250000=13283000= + XREFDUMP(POINTER); % DUMP XREF INFO 78255000=13283500= + GT2:= TAKE(POINTER+1); 78260000=13284000= + GT3:= GT2.PURPT; 78265000=13285000= + STACKHEAD(0 & GT2[12:12:36]) MOD 125]:= TAKE(POINTER).LINK; 78270000=13286000= + POINTER:= POINTER-GT3 78275000=13288000= + END 78280000=13289000= + END; 78285000=13289000= + LASTINFO:= POINTER; 78290000=13290000= + NEXTINFO:= STOPPER 78295000=13292000= + END; 78300000=13292000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%78305000=13292000= + PROCEDURE E; 78310000=13293000= + 78315000=13294000= +COMMENT 78320000=13294000= + E IS THE PROCEDURE WHICH PLACES AN ENTRY IN INFO AND 78325000=13295000= + HOOKS IT INTO STACKHEAD. THE PREVIOUS STACKHEAD LINK 78330000=13296000= + IS SAVED IN THE LINK OF THE ELBAT WORD IN THE NEW ENTRY 78335000=13297000= + E PREVENTS AN ENTRY FROM OVERFLOWING A ROW,STARTING AT THE 78340000=13298000= + BEGINNING OF THE NEXT ROW IF NECESSARY ;78345000=13299000= + BEGIN 78350000=13300000= + REAL 78355000=13301000= + WORDCOUNT, 78360000=13301000= + RINX; 78365000=13301000= + IF RINX:= (NEXTINFO+WORDCOUNT:= (COUNT+18) DIV 8).LINKR ^= NEXTINFO.78370000=13303000= + LINKR 78375000=13304000= + THEN 78380000=13304000= + BEGIN 78385000=13304000= + PUT(0 & (RINX*256-NEXTINFO)[27:40:8], NEXTINFO); 78390000=13304000= + NEXTINFO:= 256*RINX 78395000=13305000= + END; 78400000=13305000= + IF SPECTOG THEN 78405000=13305100= + IF NOT MACROID THEN 78410000=13305200= + UNHOOK; 78415000=13305300= + KOUNT:= COUNT; 78420000=13306000= + ACCUM[0].INCR:= WORDCOUNT; 78425000=13307000= + ACCUM[0].LINK:= STACKHEAD[SCRAM]; 78430000=13308000= + STACKHEAD[SCRAM]:= NEXTINFO; 78435000=13308000= + ACCUM[1].PURPT:= NEXTINFO:= LASTINFO; 78440000=13309000= + MOVE(WORDCOUNT, ACCUM, INFO[NEXTINFO.LINKR, NEXTINFO.LINKC]); 78445000=13310000= + IF XREF THEN % MAKE DECLARATION REFERENCE 78450000=13310050= + IF(ACCUM[0].CLASS ^= DEFINEID OR NOT BOOLEAN(ACCUM[0].FORMAL)) 78455000=13310080= + THEN % NOT DEFINE PARAMETER 78460000=13310080= + BEGIN 78465000=13310100= + XREFINFO[NEXTINFO]:= 78470000=13310300= + IF SPECTOG THEN 78475000=13310300= + XREFINFO[ELBAT[I]] 78480000=13310400= + ELSE 78485000=13310400= + ((XLUN:= XLUN+1) & SGNO SEGNOF); 78490000=13310450= + IF SPECTOG THEN % JUST GO BACK AND FIX UP XREF ENTRY 78495000=13310500= + XMARK(DECLREF) 78500000=13310550= + ELSE 78505000=13310550= + XREFIT(NEXTINFO, CARDNUMBER, IF PTOG AND NOT STREAMTOG THEN 78510000=13310580= + NORMALREF ELSE DECLREF); 78515000=13310580= + END 78520000=13310700= + ELSE % DEFINE PARAMETERS - DONT CROSS REF. 78525000=13310700= + XREFINFO[NEXTINFO]:= 0 78530000=13310800= + ELSE 78535000=13310800= + IF DEFINING.[1:1] THEN % WE ARE DOING XREFING 78540000=13310900= + XREFINFO[NEXTINFO]:= 0; 78545000=13310950= + LASTINFO:= NEXTINFO; 78550000=13311000= + IF NEXTINFO:= NEXTINFO+WORDCOUNT >= 8192 THEN 78555000=13312000= + BEGIN 78560000=13312500= + FLAG(199); 78565000=13312500= + GO TO ENDOFITALL 78570000=13312500= + END; 78575000=13312500= + END; 78580000=13313000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%78585000=13313000= + PROCEDURE ENTRY(TYPE); 78590000=13314000= + VALUE 78595000=13315000= + TYPE; 78600000=13315000= + REAL 78605000=13316000= + TYPE; 78610000=13316000= + 78615000=13317000= +COMMENT 78620000=13317000= + ENTRY ASSUMES THAT I IS POINTING AT AN IDENTIFIER WHICH 78625000=13318000= + IS BEING DECLARED AND MAKES UP THE ELBAT ENTRY FOR IT 78630000=13319000= + ACCORD TO TYPE .IF THE ENTRY IS AN ARRAY AND NOT 78635000=13320000= + A SPECIFICATION THEN A DESCRIPTOR IS PALCED IN THE STACK 78640000=13321000= + FOR THE UPCOMING COMMUNICATE TO GET STORAGE FOR THE ARRAY(S) ;78645000=13322000= + BEGIN 78650000=13323000= + BOOLEAN 78655000=13323010= + SVTOG; % 78660000=13323010= + J:= 0; 78665000=13324000= + I:= I-1; 78670000=13324000= + DO BEGIN 78675000=13326000= + STOPDEFINE:= TRUE; 78680000=13327000= + STEPIT; 78685000=13327000= + SCATTERELBAT; 78690000=13327000= + IF FORMALF:= SPECTOG THEN 78695000=13329000= + BEGIN 78700000=13330000= + IF TYPE <= INTARRAYID AND TYPE >= BOOARRAYID THEN % 78705000=13330550= + IF VONF THEN 78710000=13330600= + BEGIN 78715000=13330600= + SVTOG:= ERRORTOG; 78720000=13330600= + FLAG(15); % 78725000=13330600= + SPECTOG:= ERRORTOG:= SVTOG; 78730000=13330650= + END; % 78735000=13330650= + IF ELCLASS ^= SECRET THEN 78740000=13332000= + FLAG(002); 78745000=13332000= + BUP:= BUP+1 78750000=13334000= + END 78755000=13336000= + ELSE 78760000=13336000= + BEGIN 78765000=13336000= + IF ELCLASS > IDMAX AND ELCLASS <= FACTOP THEN 78770000=13338000= + FLAG(003); 78775000=13338000= + IF ELCLASS = DEFINEDID THEN % CHECK IF NEW DECLARATION 78780000=13339000= + IF NOT(PTOG OR STREAMTOG) AND LINKF >= GLOBALNINFOO THEN 78785000=13339200= + FLAG(1) 78790000=13339300= + ELSE 78795000=13339300= + ELSE 78800000=13339500= + IF LEVELF = LEVEL THEN % DUPLICATE DECLARATION 78805000=13339500= + FLAG(1); 78810000=13340000= + VONF:= P2; 78815000=13341000= + IF((FORMALF:= PTOG) OR(STREAMTOG AND NOT STOPGSP)) AND NOT P278820000=13343000= + THEN 78825000=13343000= + ADDRSF:= PJ:= PJ+1 78830000=13344000= + ELSE 78835000=13344000= + IF STOPGSP THEN 78840000=13344000= + ADDRSF:= 0 78845000=13345000= + ELSE 78850000=13345000= + ADDRSF:= GETSPACE(P2, 1); % ID IN ACCUM[1]. 78855000=13345000= + IF TYPE <= INTARRAYID AND TYPE >= BOOARRAYID THEN 78860000=13347000= + IF P2 THEN 78865000=13347000= + BEGIN 78870000=13347000= + COMMENT OWN ARRAY; 78875000=13347000= + EMITL(ADDRSF); 78880000=13347500= + EMITN(10); 78885000=13347500= + END 78890000=13347520= + ELSE 78895000=13347520= + CHECKDISJOINT(ADDRSF); 78900000=13347520= + END; 78905000=13348000= + IF XREF AND NOT SPECTOG THEN % ERASE PREVIOUS XREF ENTRY. 78910000=13348100= + XREFPT:= XREFPT-REAL(ELBAT[I] ^= 0);% GET RID OF LAST CREF 78915000=13348200= + KLASSF:= TYPE; 78920000=13349000= + MAKEUPACCUM; 78925000=13349000= + E; 78930000=13349000= + J:= J+1; 78935000=13349000= + END 78940000=13351000= + UNTIL STEPI ^= COMMA OR STOPENTRY; 78945000=13351000= + GTA1[0]:= J 78950000=13352000= + END; 78955000=13352000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%78960000=13352000= + PROCEDURE UNHOOK; 78965000=13353000= + 78970000=13354000= +COMMENT 78975000=13354000= + UNHOOK ASSUMES THAT THE WORD IN ELBAT[I] POINTS TO A PSUEDO ENTRY 78980000=13355000= + FOR APARAMETER.ITS JOB IS TO UNHOOK THAT FALSE ENTRY SO THAT 78985000=13356000= + E WILL WORK AS NORMAL. ;78990000=13357000= + BEGIN 78995000=13358000= + REAL 79000000=13359000= + LINKT, 79005000=13359000= + A, 79010000=13359000= + LINKP; 79015000=13359000= + LABEL 79020000=13360000= + L; 79025000=13360000= + LINKT:= STACKHEAD[SCRAM]; 79030000=13361000= + LINKP:= ELBAT[I].LINK; 79035000=13361000= + IF LINKT = LINKP THEN 79040000=13362000= + STACKHEAD[SCRAM]:= TAKE(LINKT).LINK 79045000=13363000= + ELSE 79050000=13363000= + L: IF A:= TAKE(LINKT).LINK = LINKP THEN 79055000=13365000= + PUT((TAKE(LINKT)) & (TAKE(A))[35:35:13], LINKT) 79060000=13366000= + ELSE 79065000=13366000= + BEGIN 79070000=13366000= + LINKT:= A; 79075000=13366000= + GO TO L 79080000=13366000= + END; 79085000=13366000= + END; 79090000=13367000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%79095000=13367000= + PROCEDURE MAKEUPACCUM; 79100000=13368000= + BEGIN 79105000=13369000= + IF PTOG THEN 79110000=13371000= + GT1:= LEVELF 79115000=13371000= + ELSE 79120000=13371000= + GT1:= LEVEL; 79125000=13371000= + ACCUM[0]:= ABS(ELBAT[I] & KLASSF[2:41:7] & REAL(FORMALF)[9:47:1] & 79130000=13375000= + REAL(VONF)[10:47:1] & GT1[11:43:5] & ADDRSF[16:37:11]) 79135000=13375000= + END; 79140000=13375000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%79145000=13375000= + PROCEDURE ARRAE; 79150000=13376000= + 79155000=13377000= +COMMENT 79160000=13377000= + ARRAE ENTERS INFO ABOUT ARRAYS AND THEIR LOWER BOUNDS. 79165000=13378000= + IT ALSO EMITS CODE TO COMMUNICATE WITH THE MCP TO OBTAIN 79170000=13379000= + STORAGE FOR THE ARRAY AT OBJECT TIME.SPECIAL ANALYSIS IS 79175000=13380000= + MADE TO GENERATE EFFICIENT CODE WHEN DETERMING THE SIZE OF 79180000=13381000= + EACH DIMENSION.FOLLOWING ARE A FEW EXAMPLES OF CODE EMITTED: 79185000=13382000= + ARRAY A[0:10], 79190000=13383000= + MKS (THIS MARKS STACK TO CUT BACK AFTER COM)79195000=13384000= + DESC A (THIS FORMS A DESCRITOR POINTING TO 79200000=13385000= + THE ADDRESS OF A) 79205000=13386000= + LITC 11 (SIZE OF ARRAY) 79210000=13387000= + LITC 1 (NUMBER OF DIMENSIONS) 79215000=13388000= + LITC 1 (NUMBER OF ARRAYS) 79220000=13389000= + LITC ARCOM (COMMUNICATE LITERAL FOR NON SAVE, 79225000=13390000= + NON OWN ARRAYS) 79230000=13391000= + COM (COMMUNICATE TO MCP TO GET STORAGE) 79235000=13392000= + DESC XITR (XITR JUST EXITS,THUS CUTTING BACK 79240000=13393000= + STACK) 79245000=13394000= + OWN ARRAY B,C[0:X,-1:10], 79250000=13395000= + MKS 79255000=13396000= + DESC B 79260000=13397000= + DESC C 79265000=13398000= + LITC 0 (LOWER BOUND MUST BE PASSED FOR OWN) 79270000=13399000= + OPDC X 79275000=13400000= + LITC JUNK (JUNK CELL) 79280000=13401000= + ISN (INTEGERIZE UPPER BOUND) 79285000=13402000= + LITC 1 (COMPUTE SIZE 79290000=13403000= + ADD OF DIMENSION 79295000=13404000= + LITC 1 (LOWER BOUND,SECOND DIMENSION) 79300000=13405000= + CHS 79305000=13406000= + LITC 12 (SIZE SECOND DIMENSION) 79310000=13407000= + LITC 2 (NUMBER DIMENSIONS) 79315000=13408000= + LITC 2 (NUMBER ARRAYS) 79320000=13409000= + LITC OWNCOM (OWN ARRAY COMMUNICATE) 79325000=13410000= + COM 79330000=13411000= + DESC XITR 79335000=13412000= + SAVE OWN ARRAY D,E,F[X:Y,M+N:T|V], 79340000=13413000= + MKS 79345000=13414000= + DESC D 79350000=13415000= + DESC E 79355000=13416000= + DESC F 79360000=13417000= + OPDC X 79365000=13418000= + LITC XT (CELL OBTAINED TO KEEP LOWER BOUND) 79370000=13419000= + ISN (PUT INTEGERIZED LOWER BOUND AWAY) 79375000=13420000= + DUP (MUST PASS LOWER BOUND FOR OWN) 79380000=13421000= + OPDC Y (INTEGERIZE 79385000=13422000= + LITC JUNK UPPER 79390000=13423000= + ISN BOUND) 79395000=13424000= + XCH (COMPUTE SIZE OF FIRST DIMENSION 79400000=13425000= + SUB UPPER 79405000=13426000= + LITC 1 -LOWER 79410000=13427000= + ADD +1) 79415000=13428000= + OPDC M (COMPUTER LOWER BOUND 79420000=13429000= + OPDC N SECOND DIM) 79425000=13430000= + ADD 79430000=13431000= + LITC MNT (GET CELL FOR SECOND LOWER BOUND) 79435000=13432000= + ISN (INTEGERIZE) 79440000=13433000= + DUP (PASS LOWER BOUND FOR OWN) 79445000=13434000= + OPDC T 79450000=13435000= + MUL V 79455000=13436000= + LITC JUNK (INTEGERIZE 79460000=13437000= + ISN UPPER) 79465000=13438000= + XCH (COMPUTE 79470000=13439000= + SUB SIZE 79475000=13440000= + LITC 1 79480000=13441000= + ADD ) 79485000=13442000= + LITC 2 (NUMBER DIMENSIONS) 79490000=13443000= + LITC 3 (NUMBER ARRAYS) 79495000=13444000= + LITC SAVON (SAVE OWN LITERAL FOR COM) 79500000=13445000= + COM 79505000=13446000= + DESC XITR ; 79510000=13447000= + BEGIN 79515000=13448000= + REAL 79520000=13449000= + T1, 79525000=13449000= + T2, 79530000=13449000= + T3, 79535000=13449000= + K, 79540000=13449000= + LBJ, 79545000=13449000= + ARPROGS, 79550000=13449000= + SAVEDIM, 79555000=13449000= + T, 79560000=13449000= + T4, 79565000=13449000= + SAVEINFO, 79570000=13449000= + SAVEINFO2; 79575000=13449000= + BOOLEAN 79580000=13450000= + LLITOG, 79585000=13450000= + ULITOG; 79590000=13450000= + REAL 79595000=13451000= + ADDCON; 79600000=13451000= + LABEL 79605000=13452000= + CSZ, 79610000=13452000= + BETA1, 79615000=13452000= + TWO, 79620000=13452000= + START, 79625000=13452000= + SLB, 79630000=13452000= + BETA2; 79635000=13452000= + ARRAYFLAG:= TRUE; 79640000=13452100= + TYPEV:= REALARRAYID; 79645000=13453000= + IF T1:= GTA1[J:= J-1] = 0 THEN 79650000=13454000= + J:= J+1 79655000=13455000= + ELSE 79660000=13455000= + IF T1 = OWNV THEN 79665000=13456000= + BEGIN 79670000=13457000= + P2:= TRUE; 79675000=13457000= + IF SPECTOG THEN 79680000=13457000= + FLAG(13) 79685000=13458000= + END 79690000=13459000= + ELSE 79695000=13459000= + IF T1 = SAVEV THEN 79700000=13459000= + BEGIN 79705000=13460000= + P3:= TRUE; 79710000=13461000= + IF SPECTOG THEN 79715000=13462000= + FLAG(13); 79720000=13462000= +% IF REMOTOG THEN FLAG(508); % NOT ALLOWED IN XALGOL ON TSS. 79725000=13463000= + END 79730000=13466000= + ELSE 79735000=13466000= + IF T1 = AUXMEMV THEN 79740000=13466000= + BEGIN 79745000=13467000= + P4:= TRUE; 79750000=13467000= + IF SPECTOG THEN 79755000=13467000= + FLAG(13) 79760000=13468000= + END 79765000=13469000= + ELSE 79770000=13469000= + TYPEV:= REALID+T1; 79775000=13469000= + IF NOT SPECTOG THEN 79780000=13470000= + EMITO(MKS); 79785000=13470000= + SAVEINFO:= NEXTINFO; 79790000=13470000= + ENTER(TYPEV); 79795000=13471000= + SAVEINFO2:= NEXTINFO:= NEXTINFO+1; 79800000=13471000= +BETA1: 79805000=13473000= + IF ELCLASS ^= LFTBRKET THEN 79810000=13473000= + FLAG(016); 79815000=13473000= + LBJ:= 0; 79820000=13473000= + SAVEDIM:= 1; 79825000=13473000= +TWO: 79830000=13474000= + IF STEPI = ADOP THEN 79835000=13474000= + BEGIN 79840000=13475000= + T1:= ELBAT[I].ADDRESS; 79845000=13476000= + I:= I+1 79850000=13477000= + END 79855000=13478000= + ELSE 79860000=13478000= + T1:= 0; 79865000=13478000= + IF SPECTOG THEN 79870000=13478000= + GO TO BETA2; 79875000=13478000= + APROGS:= L; 79880000=13479000= + IF TABLE(I+1) = COLON AND TABLE(I) = LITNO THEN 79885000=13480000= + BEGIN 79890000=13481000= + LLITOG:= TRUE; 79895000=13482000= + IF T3:= ELBAT[I].ADDRESS ^= 0 THEN 79900000=13484000= + BEGIN 79905000=13485000= + EMITL(T3); 79910000=13486000= + IF T1 = SUBOP THEN 79915000=13487000= + BEGIN 79920000=13488000= + EMITO(CHS); 79925000=13489000= + ADDCON:= ADDC 79930000=13491000= + END 79935000=13492000= + ELSE 79940000=13492000= + ADDCON:= SUBC 79945000=13493000= + END; 79950000=13493000= + T2:= T3*4+ADDCON 79955000=13495000= + END 79960000=13497000= + ELSE 79965000=13497000= + BEGIN 79970000=13497000= + LLITOG:= FALSE; 79975000=13498000= + IF T1 ^= 0 THEN 79980000=13499000= + I:= I-1; 79985000=13499000= + T2:= GETSPACE(P2, -1); %TEMP. 79990000=13500000= + AEXP; 79995000=13501000= + EMITSTORE(T2, ISN); 80000000=13501000= + T2:= T2*4+SUBC+2; 80005000=13502000= + IF ELCLASS ^= COLON THEN 80010000=13503000= + FLAG(017); 80015000=13504000= + I:= I-1 80020000=13505000= + END; 80025000=13505000= + IF P2 THEN 80030000=13506000= + BEGIN 80035000=13507000= + IF LLITOG AND T3 = 0 THEN 80040000=13508000= + EMITL(0); 80045000=13508000= + ARPROGS:= L; 80050000=13509000= + EMITO(DUP); 80055000=13509000= + END; 80060000=13510000= + IF ELCLASS:= TABLE(I:= I+2) = LITNO THEN 80065000=13511000= + BEGIN 80070000=13512000= + IF T:= TABLE(I:= I+1) = COMMA OR T:= RTBRKET THEN 80075000=13515000= + BEGIN 80080000=13516000= + EMITL(T4:= ELBAT[I-1].ADDRESS); 80085000=13517000= + ULITOG:= TRUE; 80090000=13518000= + GO TO CSZ 80095000=13519000= + END 80100000=13521000= + ELSE 80105000=13521000= + I:= I-1 80110000=13522000= + END; 80115000=13522000= + ULITOG:= FALSE; 80120000=13523000= + AEXP; 80125000=13524000= + EMITL(JUNK); 80130000=13525000= + EMITL(ISN); 80135000=13526000= +CSZ: 80140000=13527000= + IF LLITOG AND ULITOG THEN 80145000=13527000= + BEGIN 80150000=13528000= + L:= ARPROGS; 80155000=13529000= + IF (T:= IF ADDCON = ADDC THEN T4+T3+1 ELSE T4-T3+1) <= 0 OR T > 80160000=13531000= + 1023 80165000=13531000= + THEN 80170000=13531000= + FLAG(59); 80175000=13531000= + EMITL(T); 80180000=13531100= + IF P3 THEN 80185000=13532000= + BEGIN 80190000=13532000= + SAVEDIM:= SAVEDIM*T; 80195000=13532000= + IF SAVEDIM > MAXSAVE THEN 80200000=13534000= + MAXSAVE:= SAVEDIM 80205000=13536000= + END 80210000=13537000= + ELSE 80215000=13537000= + IF T > MAXROW THEN 80220000=13537000= + MAXROW:= T; 80225000=13537000= + END 80230000=13540000= + ELSE 80235000=13540000= + BEGIN 80240000=13540000= + IF NOT (LLITOG AND T3 = 0) OR P2 THEN 80245000=13542000= + BEGIN 80250000=13543000= + EMITO(XCH); 80255000=13544000= + EMITO(SUB) 80260000=13545000= + END; 80265000=13545000= + EMITL(1); 80270000=13545000= + EMITO(ADD) 80275000=13546000= + END; 80280000=13546000= +SLB: 80285000=13547000= + PUTNBUMP(T2); 80290000=13547000= + LBJ:= LBJ+1; 80295000=13547000= + IF T:= TABLE(I) = COMMA THEN 80300000=13547000= + GO TO TWO 80305000=13548000= + ELSE 80310000=13548000= + IF T ^= RTBRKET THEN 80315000=13549000= + FLAG(018); 80320000=13549000= + IF NOT SPECTOG THEN 80325000=13550000= + BEGIN 80330000=13551000= + 80335000=13551400= +COMMENT KEEP COUNT OF NO. OF ARRAYS DECLARED; 80340000=13551400= + NOOFARRAYS:= NOOFARRAYS+GTA1[0]; 80345000=13551500= + EMITL(LBJ); 80350000=13552000= + EMITL(GTA1[0]); 80355000=13552000= + IF P3 AND P4 THEN 80360000=13552500= + FLAG(14); % SAVE AND AUXMEM MUTUALLY EXCL. 80365000=13552500= + EMITL(REAL(P3)+2*REAL(P2)+REAL(P4)*64); 80370000=13553000= + EMITV(5) 80375000=13555000= + END; 80380000=13555000= + PUT(LBJ, SAVEINFO2-1); 80385000=13556000= + DO BEGIN 80390000=13557000= + T:= TAKE(SAVEINFO); 80395000=13558000= + K:= T.INCR; 80400000=13559000= + T.INCR:= SAVEINFO2-SAVEINFO-1; 80405000=13560000= + PUT(T, SAVEINFO); 80410000=13561000= + END 80415000=13563000= + UNTIL SAVEINFO:= SAVEINFO+K = SAVEINFO2-1; 80420000=13563000= + IF STEPI ^= COMMA THEN 80425000=13564000= + GO TO START; 80430000=13564000= + IF NOT SPECTOG THEN 80435000=13565000= + EMITO(MKS); 80440000=13565000= + SAVEINFO:= NEXTINFO; 80445000=13566000= + I:= I+1; 80450000=13567000= + ENTRY(TYPEV); 80455000=13567000= + SAVEINFO2:= NEXTINFO:= NEXTINFO+1; 80460000=13567000= + GO TO BETA1; 80465000=13567000= +BETA2: 80470000=13569000= + IF T:= TABLE(I:= I+1) = COMMA OR T = RTBRKET THEN 80475000=13570000= + BEGIN 80480000=13571000= + IF ELCLASS:= TABLE(I-1) = LITNO THEN 80485000=13573000= + BEGIN 80490000=13574000= + T3:= ELBAT[I-1].ADDRESS; 80495000=13575000= + IF T1 = SUBOP THEN 80500000=13576000= + ADDCON:= ADDC 80505000=13578000= + ELSE 80510000=13578000= + ADDCON:= SUBC; 80515000=13579000= + T2:= T3*4+ADDCON; 80520000=13580000= + GO TO SLB; 80525000=13580000= + END; 80530000=13581000= + IF ELCLASS = FACTOP THEN 80535000=13582000= + BEGIN 80540000=13583000= + T2:= -SUBC; 80545000=13584000= + GO TO SLB 80550000=13585000= + END 80555000=13586000= + END; 80560000=13586000= + FLAG(019); 80565000=13587000= +START: 80570000=13588000= + ARRAYFLAG:= FALSE 80575000=13588000= + END; 80580000=13588000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80585000=13588000= + PROCEDURE PUTNBUMP(X); 80590000=13589000= + VALUE 80595000=13590000= + X; 80600000=13590000= + REAL 80605000=13591000= + X; 80610000=13591000= + BEGIN 80615000=13592000= + INFO[NEXTINFO.LINKR, NEXTINFO.LINKC]:= X; 80620000=13593000= + NEXTINFO:= NEXTINFO+1 80625000=13595000= + END; 80630000=13595000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80635000=13595000= + PROCEDURE JUMPCHX; 80640000=13596000= + 80645000=13597000= +COMMENT THIS PROCEDURE IS CALLED AT THE START OF ANY EXECUTABLE CODE 80650000=13597000= + WHICH THE BLOCK MIGHT EMIT.IT DETERMINES WHETHER ANY JUMPS 80655000=13598000= + ARROUND NONEXECUTABLE CODE MAY BE WAITING AND WHETHER IT 80660000=13599000= + IS THE FIRST EXECUTABLE CODE; 80665000=13600000= + IF NOT SPECTOG THEN 80670000=13601000= + BEGIN 80675000=13602000= + IF AJUMP THEN 80680000=13604000= + BEGIN 80685000=13605000= + ADJUST; 80690000=13605000= + EMITB(BFW, SAVEL, L) 80695000=13607000= + END 80700000=13608000= + ELSE 80705000=13608000= + IF FIRSTX = 4095 THEN 80710000=13609000= + BEGIN 80715000=13610000= + ADJUST; 80720000=13611000= + FIRSTX:= L; 80725000=13612000= + END; 80730000=13613000= + AJUMP:= FALSE 80735000=13615000= + END; 80740000=13615000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80745000=13615000= + PROCEDURE JUMPCHKNX; 80750000=13616000= + 80755000=13617000= +COMMENT JUMPCHKNX DETERMINES WHETHER ANY EXECUTABLE CODE HAS BEEN 80760000=13617000= + EMITTED AND IF SO WHETHER IT WAS JUST PREVIOUS TO THE 80765000=13618000= + NON EXECUTABLE ABOUT TO BE EMITTED.IF BOTH THEN L IS BUMPED 80770000=13619000= + AND SAVED FOR A LATER BRANCH; 80775000=13620000= + IF NOT SPECTOG THEN 80780000=13621000= + BEGIN 80785000=13622000= + IF FIRSTX ^= 4095 THEN 80790000=13624000= + BEGIN 80795000=13625000= + IF NOT AJUMP THEN 80800000=13627000= + SAVEL:= BUMPL; 80805000=13628000= + AJUMP:= TRUE 80810000=13630000= + END; 80815000=13630000= + ADJUST 80820000=13631000= + END; 80825000=13631000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80830000=13631000= + PROCEDURE SEGMENTSTART; 80835000=13632000= + BEGIN 80840000=13632100= + IF NOHEADING THEN 80845000=13633000= + DATIME; 80850000=13633000= + IF SINGLTOG THEN 80855000=13633100= + WRITE(LINE, PRINTSEGNO, SGAVL) 80860000=13633200= + ELSE 80865000=13633200= + WRITE(LINE[DBL], PRINTSEGNO, SGAVL); 80870000=13633200= + END SEGMENTSTART; 80875000=13633300= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80880000=13633300= + PROCEDURE SEGMENT(SIZE, NO, NOO); 80885000=13634000= + VALUE 80890000=13635000= + SIZE, 80895000=13635000= + NO, 80900000=13635000= + NOO; 80905000=13635000= + REAL 80910000=13636000= + SIZE, 80915000=13636000= + NO, 80920000=13636000= + NOO; 80925000=13636000= + BEGIN 80930000=13637000= + INTEGER 80935000=13637100= + DUMMY; % THIS IS HERE SO THAT OUR CODE SEGMENT 80940000=13637100= + % IS NOT TOO BIG 80945000=13637200= + PDPRT[PDINX.[37:5], PDINX.[42:6]]:= SIZE & NO[28:38:10] & 80950000=13640000= + MOVEANDBLOCK(EDOC, ABS(SIZE), -ABS(NO))[13:33:15] & 80955000=13641000= + REAL(SAVEPRTOG)[3:47:1]; 80960000=13641000= + PDINX:= PDINX+1; 80965000=13642000= + SIZE:= ABS(SIZE); 80970000=13642000= + IF SIZE > SEGSIZEMAX THEN 80975000=13643000= + SEGSIZEMAX:= SIZE; 80980000=13643000= + AKKUM:= AKKUM+SIZE; 80985000=13644000= + IF SAVEPRTOG THEN 80990000=13645000= + AUXMEMREQ:= AUXMEMREQ+16*(SIZE.[38:6]+1); 80995000=13645000= + IF LISTER OR SEGSTOG THEN 81000000=13646000= + BEGIN 81005000=13647000= + IF NOHEADING THEN 81010000=13648000= + DATIME; 81015000=13648000= + IF SINGLTOG THEN 81020000=13649000= + WRITE(LINE, PRINTSIZE, NO, SIZE, NOO) 81025000=13650000= + ELSE 81030000=13650000= + WRITE(LINE, PRINTSIZE, NO, SIZE, NOO); 81035000=13650000= + END; 81040000=13651000= + LDICT[NO.[38:3], NO.[41:7]]:= 81045000=13653000= + IF BUILDLINE THEN 81050000=13653000= + MOVENADBLOCK(ENIL, ENILPTR+1, 4) & SIZE[18:33:15] 81055000=13655000= + ELSE 81060000=13655000= + -1; 81065000=13655000= + END OF SEGMENT; 81070000=13656000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%81075000=13656000= + PROCEDURE ENTER(TYPE); 81080000=13714000= + VALUE 81085000=13714000= + TYPE; 81090000=13714000= + INTEGER 81095000=13714000= + TYPE; 81100000=13714000= + BEGIN 81105000=13715000= + G:= GTA1[J:= J-1]; 81110000=13716000= + IF NOT SPECTOG THEN 81115000=13717000= + BEGIN 81120000=13718000= + IF NOT P2 THEN 81125000=13719000= + IF P2:= (G = OWNV) THEN 81130000=13720000= + G:= GTA1[J:= J-1]; 81135000=13720000= + IF NOT P3 THEN 81140000=13721000= + IF P3:= (G = SAVEV) THEN 81145000=13722000= + G:= GTA1[J:= J-1]; 81150000=13722000= + IF NOT P4 THEN 81155000=13723000= + IF P4:= (G = AUXMEMV) THEN 81160000=13724000= + G:= GTA1[J:= J-1]; 81165000=13724000= + END; 81170000=13725000= + IF G ^= 0 THEN 81175000=13726000= + FLAG(25) 81180000=13726000= + ELSE 81185000=13726000= + ENTRY(TYPE) 81190000=13727000= + END ENTER; 81195000=13727000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%81200000=13727000= + PROCEDURE HTTEOAP(GOTSTORAGE, RELAD, STOPPER, PRTAD); 81205000=13731000= + VALUE 81210000=13732000= + GOTSTORAGE, 81215000=13732000= + RELAD, 81220000=13732000= + STOPPER, 81225000=13732000= + PRTAD; 81230000=13732000= + BOOLEAN 81235000=13733000= + GOTSTORAGE; 81240000=13733000= + REAL 81245000=13734000= + RELAD, 81250000=13734000= + STOPPER, 81255000=13734000= + PRTAD; 81260000=13734000= + BEGIN 81265000=13735000= + BOOLEAN 81270000=13736000= + BT; 81275000=13736000= + REAL 81280000=13737000= + K, 81285000=13737000= + LS; 81290000=13737000= + LS:= RELAD; 81295000=13738000= + BT:= JUMPCTR = LEVEL; 81300000=13739000= + IF FUNCTOG THEN 81305000=13741000= + BEGIN 81310000=13742000= + EMITV(514); 81315000=13743000= + EMITO(RTN) 81320000=13745000= + END 81325000=13747000= + ELSE 81330000=13747000= + EMITO(XIT); 81335000=13747000= + IF STACKCTR > MAXSTACK THEN 81340000=13748000= + MAXSTACK:= STACKCTR; 81345000=13748000= + CONSTANTCLEAN; 81350000=13749000= + IF K:= MAXSTACK-514 > 0 OR GOTSTORAGE OR BT OR NCII > 0 OR FAULTOG. 81355000=13750000= + [46:1] 81360000=13751000= + THEN 81365000=13751000= + BEGIN 81370000=13752000= + ADJUST; 81375000=13752000= + LS:= L; 81380000=13752000= + IF BT OR GOTSTORAGE OR FAULTOG.[46:1] THEN 81385000=13754000= + BEGIN 81390000=13755000= +% 81395000=13755500= + EMITV(BLOCKCTR); 81400000=13756000= + EMITL(1); 81405000=13757000= + EMITO(ADD); 81410000=13758000= + IF GOTSTORAGE OR FAULTOG.[46:1] THEN 81415000=13760000= + EMITSTORE(BLOCKCTR, SND) 81420000=13762500= + END 81425000=13762500= +% 81430000=13762500= + ELSE 81435000=13763000= + EMITL(0); 81440000=13763000= + K:= K+NCII; 81445000=13764000= + WHILE K:= K-1 >= 0 DO 81450000=13766000= + EMITL(0); 81455000=13766000= + PURGE(STOPPER); 81460000=13767000= + IF FAULTLEVEL <= LEVEL THEN 81465000=13767100= + BEGIN 81470000=13767200= + IF FAULTLEVEL = LEVEL THEN 81475000=13767200= + FAULTLEVEL:= 32; 81480000=13767200= + EMITPAIR(0, MDS); 81485000=13767300= + EMITO(CHS); 81490000=13767300= + END OF THIS PART OF ERROR KLUDGE; 81495000=13767400= + EMIT(0); % DC & DISK 81500000=13767500= + BUMPL; 81505000=13768000= + EMITB(BBC, L, IF RELAD = 4095 THEN 0 ELSE RELAD); % DC & DISK 81510000=13769000= + CONSTANTCLEAN 81515000=13771000= + END 81520000=13771000= + ELSE 81525000=13771000= + PURGE(STOPPER); 81530000=13771000= + Z:= PROGDESCBLDR(PDES, IF LS = 4095 THEN 0 ELSE LS, PRTAD); 81535000=13772000= + END HTTEOAP; 81540000=13773000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%81545000=13773000= + PROCEDURE FORMATGEN; 81550000=13774000= + BEGIN 81555000=13775000= + INTEGER 81560000=13776000= + PRT; 81565000=13776000= + LABEL 81570000=13776000= + L; 81575000=13776000= + BOOLEAN 81580000=13777000= + TB2; 81585000=13777000= + ARRAY 81590000=13777500= + TEDOC[0:7, 0:127]; 81595000=13777500= + MOVECODE(TEDOC, EDOC); 81600000=13777600= + BUILDLINE:= BOOLEAN(2*REAL(BUILDLINE)); 81605000=13777700= + TB2:= GTA1[J-1] = SWITCHV; 81610000=13778000= + GT5:= SGNO; 81615000=13779000= +L: GT1:= (2*SGAVL-1) & 2[4:46:2]; 81620000=13780000= + STOPENTRY:= TRUE; 81625000=13780000= + IF LISTER OR SEGSTOG THEN 81630000=13780002= + SEGMENTSTART; 81635000=13780002= + SGNO:= SGAVL; 81640000=13781000= + F:= 0; 81645000=13783000= + PRT:= GETSPACE(TRUE, 1); 81650000=13783000= + STOPGSP:= TRUE; % FORMAT. 81655000=13783000= + Z:= PROGDESCBLDR(LDES, 0, PRT); 81660000=13784000= + IF TB2 THEN 81665000=13785000= + BEGIN 81670000=13786000= + ENTRY(SUPERFRMTID); 81675000=13787000= + IF ELCLASS ^= ASSIGNOP THEN 81680000=13787000= + FLAG(36); 81685000=13787000= + PUT(TAKE(LASTINFO) & PRT[16:37:11], LASTINFO); 81690000=13788000= + RR4:= NEXTINFO; 81695000=13789000= + PUTNBUMP(0); 81700000=13789000= + DO BEGIN 81705000=13791000= + PUTNBUMP(F); 81710000=13791000= + IF STEPI = LEFTPAREN THEN 81715000=13791000= + FLAG(37); 81720000=13791000= + ELCLASS:= 6"<"; 81725000=13791050= + TB1:= FORMATPHRASE; 81730000=13792000= + END 81735000=13794000= + UNTIL ELCLASS ^= 6","; 81740000=13794000= + RR3:= NEXTINFO-1; 81745000=13795000= + NEXTINFO:= RR4; 81750000=13795000= + PUTNBUMP(F); 81755000=13795000= + DO 81760000=13797000= + WHIPOUT(TAKE(RR4:= RR4+1)) 81765000=13798000= + UNTIL RR4 = RR3; 81770000=13798000= + IF F > 1022 THEN 81775000=13798000= + FLAG(38); 81780000=13798000= + END 81785000=13801000= + ELSE 81790000=13801000= + BEGIN 81795000=13801000= + I:= I-1; 81800000=13802000= + DO BEGIN 81805000=13804000= + STOPDEFINE:= TRUE; 81810000=13805000= + STEPIT; 81815000=13805000= + ENTRY(FRMTID); 81820000=13806000= + IF ELCLASS ^= LEFTPAREN THEN 81825000=13806000= + FLAG(32); 81830000=13806000= + ELCLASS:= 6"<"; 81835000=13806000= + PUT(TAKE(LASTINFO) & PRT[16:37:11] & F[27:40:8], LASTINFO); 81840000=13807000= + TB1:= FORMATPHRASE; 81845000=13808000= + END 81850000=13810000= + UNTIL ELCLASS ^= 6"," OR TB1:= F >= 256; 81855000=13810000= + END; 81860000=13813000= + SEGMENT(-F, SGNO, GT5); 81865000=13814000= + SGAVL:= SGAVL+1; 81870000=13814000= + IF TB1 AND ELCLASS = 6"," THEN 81875000=13815000= + BEGIN 81880000=13815000= + I:= I+1; 81885000=13815000= + GO TO L 81890000=13815000= + END; 81895000=13815000= + IF ELCLASS ^= 6";" THEN 81900000=13816000= + ELBAT[I]:= 0 81905000=13816000= + ELSE 81910000=13816000= + ELBAT[I].CLASS:= SEMICOLON; 81915000=13816000= + STOPGSP:= STOPENTRY:= FALSE; 81920000=13817000= + SGNO:= GT5; 81925000=13818000= + MOVECODE(TEDOC, EDOC); 81930000=13818500= + BUILDLINE:= BUILDLINE.[46:1]; 81935000=13818600= + END FORMATGEN; 81940000=13819000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%81945000=13819000= + PROCEDURE CHECKBOUNDLVL; 81950000=13819100= + COMMENT CHECK DYNAMIC ARRAY BOUND: MUST NOT BE 81955000=13819200= + DECLARED AT SAME LEVEL; 81960000=13819300= + IF NOT SPECTOG AND ELBAT[I].LVL = LEVEL THEN 81965000=13819410= + FLAG(IF REAL(ARRAYFLAG) = 3 THEN 509 ELSE 46); 81970000=13819410= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%81975000=13819410= + COMMENT 46-ARRAE NON-LITERAL ARRAY BOUND NOT GLOBAL TO 81980000=13819500= + ARARY DECLARATION; 81985000=13819600= + PROCEDURE FAULTDEC; 81990000=13900000= + COMMENT FAULTDEC HANDLES THE MONITOR 81995000=13900000= + THING, FOR THE RUN-TIME ERROR BUSINESS. IT GETS STACK OR 82000000=13901000= + PRT SPACE AND PASSES SOME STUFF TO THE BLOCK CONTROL 82005000=13902000= + INTRINSIC, WHO WILL BUILD AIT ENTRIES; 82010000=13903000= + BEGIN 82015000=13903100= + INTEGER 82020000=13903100= + TP; 82025000=13903100= + REAL 82030000=13903100= + A; 82035000=13903100= + J:= 0; 82040000=13904000= + JUMPCHKX; 82045000=13904000= + EMITO(MKS); 82050000=13904000= + IF FAULTLEVEL > LEVEL THEN 82055000=13905000= + FAULTLEVEL:= LEVEL; 82060000=13905000= + IF MODE = 0 THEN 82065000=13906000= + FAULTLEVEL:= 1; 82070000=13906000= + DO BEGIN 82075000=13907000= + IF J > 0 THEN 82080000=13907000= + STEPIT; 82085000=13907000= + J:= J+1; 82090000=13907000= + SCATTERELBAT; 82095000=13908000= + A:= ACCUM[1]; 82100000=13908000= + IF TP:= REAL((Q = 6"6INTOV") & (Q = 6"6EXPOV")[46:47:1] & 82105000=13910000= + (Q = 6"5INDEX")[45:47:1] & (Q = 6"4ZERO0")[44:47:1] & 82110000=13910000= + (Q = 6"4FLAG0")[43:47:1]) = 0 82115000=13911000= + THEN 82120000=13911000= + ERR(61) 82125000=13911000= + ELSE 82130000=13911000= + BEGIN 82135000=13911100= + IF TABLE(I+1) = ASSIGNOP THEN 82140000=13911100= + BEGIN 82145000=13911200= + STEPIT; 82150000=13911200= + COMMENT OVER THE ~; 82155000=13911200= + IF GT1:= STEPI > IDMAX AND GT1 < FAULTID THEN 82160000=13911300= + ERR(3); 82165000=13911300= + LEVELF:= ELBAT[I].LVL; 82170000=13911400= + END 82175000=13911500= + ELSE 82180000=13911500= + COUNT:= (ACCUM[1]:= A).[12:6]; 82185000=13911500= + IF LEVELF = LEVEL THEN 82190000=13912000= + ERR(1) 82195000=13912000= + ELSE 82200000=13912000= + BEGIN 82205000=13913000= + KLASSF:= FAULTID; 82210000=13913000= + ADDRSF:= GETSPACE(FALSE, 1); 82215000=13913000= + FORMALF:= VONF:= FALSE; 82220000=13913100= + EMITL(TP); 82225000=13914000= + IF MODE = 0 THEN 82230000=13914000= + BEGIN 82235000=13914000= + EMITL(0); 82240000=13914000= + EMITPAIR(ADDRSF, STD); 82245000=13915000= + END; 82250000=13915000= + EMITN(ADDRSF); 82255000=13915000= + EMIT(6"!E"); 82260000=13916000= + COMMENT C-TO-F; 82265000=13916000= + MAKEUPACCUM; 82270000=13917000= + E; 82275000=13917000= + STEPIT 82280000=13918000= + END; 82285000=13918000= + END; 82290000=13918000= + END 82295000=13918000= + UNTIL ELCLASS ^= COMMA; 82300000=13918000= + EMITL(J); 82305000=13919000= + EMITL(13); 82310000=13919000= + EMITV(5); 82315000=13919000= + END FAULTDEC; 82320000=13920000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%82325000=13920000= + 82330000=14000000= + COMMENT THIS SECTION CONTAINS THE BLOCK ROUTINE ; 82335000=14000000= + PROCEDURE BLOCK(SOP); 82340000=14001000= + VALUE 82345000=14002000= + SOP; 82350000=14002000= + BOOLEAN 82355000=14003000= + SOP; 82360000=14003000= + 82365000=14004000= +COMMENT SOP IS TRUE IF THE BLOCK WAS CALLED BY ITSELF THROUGH THE 82370000=14004000= + PROCEDURE DECLARATION-OTHERWISE IT WAS CALLED BY STATEMENT. 82375000=14005000= + THE BLOCK ROUTINE IS RESPONSIBLE FOR HANDLING THE BLOCK 82380000=14006000= + STRUCTURE OF AN ALGOL PROGRAM-SEGMENTING EACH BLOCK,HANDLING 82385000=14007000= + ALL DECLARATIONS,DOING NECESSARY BOOKKEEPING REGARDING EACH 82390000=14008000= + BLOCK, AND SUPPLYING THE SCANNER WITH ALL NECESSARY INFORMATION 82395000=14009000= + ABOUT DECLARED IDENTIFIERS. 82400000=14010000= + IT ALSO WRITES EACH SEGMENT ONTO THE PCT; 82405000=14011000= + BEGIN 82410000=14012000= + LABEL 82415000=14013000= + OWNERR, 82420000=14013000= + SAVERR, 82425000=14013000= + BOOLEANDEC, 82430000=14013000= + REALDEC, 82435000=14013000= + ALPHADEC, 82440000=14013000= + INTEGERDEC, 82445000=14014000= + LABELDEC, 82450000=14014000= + DUMPDEC, 82455000=14014000= + LISTDEC, 82460000=14014000= + OUTDEC, 82465000=14014000= + INDEC, 82470000=14014000= + MONITORDEC, 82475000=14015000= + SWITCHDEC, 82480000=14015000= + PROCEDUREDEC, 82485000=14015000= + ARRAYDEC, 82490000=14015000= + FORMATDEC, 82495000=14015000= + FILEDEC, 82500000=14016000= + GOTSCHK, 82505000=14016000= + FIELDDEC, 82510000=14016000= + AUXMEMERR, 82515000=14017000= + STREAMERR, 82520000=14017000= + DEFINEDEC, 82525000=14017000= + CALLSTATEMENT, 82530000=14017000= + HF, 82535000=14017000= + START; 82540000=14017000= + SWITCH 82545000=14018000= + DECLSW:= OWNERR, 82550000=14018000= + SAVERR, 82555000=14018000= + BOOLEANDEC, 82560000=14018000= + REALDEC, 82565000=14018000= + ALPHADEC, 82570000=14018000= + INTEGERDEC, 82575000=14019000= + LABELDEC, 82580000=14019000= + DUMPDEC, 82585000=14019000= + LISTDEC, 82590000=14019000= + OUTDEC, 82595000=14019000= + INDEC, 82600000=14019000= + MONITORDEC, 82605000=14020000= + SWITCHDEC, 82610000=14020000= + PROCEDUREDEC, 82615000=14020000= + ARRAYDEC, 82620000=14020000= + FORMATDEC, 82625000=14020000= + FILEDEC, 82630000=14021000= + STREAMERR, 82635000=14021000= + DEFINEDEC, 82640000=14021000= + AUXMEMERR, 82645000=14021000= + FIELDDEC; 82650000=14021000= + DEFINE 82655000=14022000= + NLOCS = 10 #, 82660000=14022000= + LOCBEGIN = PRTI #, 82665000=14023000= + LBP = [36:12] #, 82670000=14023100= + SPACEITDOWN = BEGIN 82675000=14023100= + WRITE(LINE[DBL]); 82680000=14023100= + WRITE(LINE[DBL]) 82685000=14023100= + END #; 82690000=14023100= + ARRAY 82695000=14024000= + TEDOC[0:7, 0:127], 82700000=14024000= + LOCALS[0:NLOCS]; 82705000=14024000= + ARRAY 82710000=14024100= + TENIL[0:7, 0:127]; 82715000=14024100= + INTEGER 82720000=14024200= + OLDLASTADDRESS; 82725000=14024200= + INTEGER 82730000=14024300= + OLDENILPTR; 82735000=14024300= + BOOLEAN 82740000=14025000= + GOTSTORAGE; 82745000=14025000= + BOOLEAN 82750000=14025100= + FWDTOG; 82755000=14025100= + COMMENT PREVIOUS FORWARD DECLARATION INDICATOR; 82760000=14025100= + INTEGER 82765000=14026000= + PINFOO, 82770000=14026000= + BLKAD; 82775000=14026000= + COMMENT LOCAL TO BLOCK TO SAVE WHERE A PROCEDURE IS EMTERED 82780000=14027000= + IN INFO; 82785000=14028000= + REAL 82790000=14029000= + MAXSTACKO, 82795000=14029000= + LASTINFOT, 82800000=14029000= + RELAD, 82805000=14029000= + LO, 82810000=14029000= + TSUBLEVEL, 82815000=14029000= + STACKCTRO; 82820000=14029000= + INTEGER 82825000=14030000= + SNGOO, 82830000=14030000= + LOD, 82835000=14030000= + SAVELO, 82840000=14030000= + PRTIO, 82845000=14030000= + NINFOO; 82850000=14030000= + INTEGER 82855000=14031000= + NCIIO; 82860000=14031000= + INTEGER 82865000=14032000= + PROAD; 82870000=14032000= + INTEGER 82875000=14032500= + NTEXTO; 82880000=14032500= + INTEGER 82885000=14033000= + FIRSTXO; 82890000=14033000= + BOOLEAN 82895000=14034000= + FUNCTOGO, 82900000=14034000= + AJUMPO, 82905000=14034000= + FAULTOGO; 82910000=14034000= + BOOLEAN 82915000=14034100= + SAVEPRTOGO, 82920000=14034100= + NEXTSAVE; 82925000=14034100= + BEGINCTR:= BEGINCTR+1; 82930000=14035000= + IF SOP THEN 82935000=14036000= + BLKAD:= PROADO 82940000=14044000= + ELSE 82945000=14044000= + BEGIN 82950000=14044000= + BLKAD:= GETSPACE(TRUE, -6); % SEG. DESCR. 82955000=14044000= + EMITV(BLKAD); 82960000=14045000= + EMITO(BFW); 82965000=14046000= + CONSTANTCLEAN 82970000=14048000= + END; 82975000=14048000= + MOVECODE(TEDOC, EDOC); 82980000=14049000= + MOVECODE(TENIL, ENIL); 82985000=14049000= + OLDLASTADDRESS:= LASTADDRESS; 82990000=14049100= + LASTADDRESS:= -1; 82995000=14049100= + OLDENILPTR:= ENILPTR; 83000000=14049200= + ENILPTR:= 0; 83005000=14049200= + ENILSPOT:= 0 & CARDNUMBER[10:20:28]; 83010000=14049300= + ENILPTR:= 1; 83015000=14049300= + MOVE(NLOCS, LOCBEGIN, LOCALS); 83020000=14050000= + FIRSTXO:= FIRSTX; 83025000=14051000= + FIRSTX:= 4095; 83030000=14052000= + IF LEVEL < 31 THEN 83035000=14053000= + LEVEL:= LEVEL+1 83040000=14053100= + ELSE 83045000=14053100= + FLAG(039); 83050000=14053100= + LOLD:= L; 83055000=14054000= + FUNCTOGO:= FUNCTOG; 83060000=14054000= + AJUMPO:= AJUMP; 83065000=14054000= + PRTIO:= PRTI; 83070000=14054000= + SGNOO:= SGNO; 83075000=14054000= + SAVELO:= SAVEL; 83080000=14055000= + AJUMP:= FALSE; % NO PENDING JUMPS IN THIS BLOCK YET. 83085000=14055100= + L:= 0; % START GENERATING CODE AT WORD 0, SYLLABLE 0. 83090000=14055200= + OLDNINFOO:= GLOBALNINFOO; % REMEMBER WHERE PREVIOUS BLOCKS 83095000=14055250= + % SYMBOLS BEGAN IN SYMBOL TABLE. 83100000=14055260= + GLOBALNINFOO:= NINFOO:= NEXTINFO; % REMEMBER WHERE THE SYMBOLS 83105000=14055300= + % FROM THIS BLOCK WILL GO 83110000=14055400= + % IN THE SYMBOL TABLE. 83115000=14055450= + NTEXTO:= NEXTTEXT; 83120000=14055500= + NCIIO:= NCII; 83125000=14056000= + NCII:= 0; 83130000=14057000= + STACKCTRO:= STACKCTR; 83135000=14058000= + FAULTOGO:= FAULTOG; 83140000=14058100= + FAULTOG:= GOTSTORAGE:= FALSE; 83145000=14059000= + SAVEPRTOG:= (SAVEPRTOGO:= SAVEPRTOG) OR SOP.[46:1]; 83150000=14059100= + IF LISTER OR SEGSTOG THEN 83155000=14060000= + SEGMENTSTART; 83160000=14060000= + SGNO:= SGAVL; 83165000=14061000= + SGAVL:= SGAVL+1; 83170000=14061000= + ELBAT[I].CLASS:= SEMICOLON; 83175000=14062000= +START: 83180000=14063000= + IF TABLE(I) ^= SEMICOLON THEN 83185000=14064000= + BEGIN 83190000=14065000= + FLAG(0); 83195000=14066000= + I:= I-1 83200000=14068000= + END; 83205000=14068000= + GTA1[0]:= J:= 0; 83210000=14069000= + IF SPECTOG THEN 83215000=14071000= + BEGIN 83220000=14072000= + IF BUP = PJ THEN 83225000=14074000= + BEGIN 83230000=14075000= + BEGIN 83235000=14076000= + LABEL 83240000=14076000= + GETLP; 83245000=14076000= + IF STREAMTOG THEN 83250000=14077000= + F:= 0 83255000=14077000= + ELSE 83260000=14077000= + F:= FZERO; 83265000=14078000= + BUP:= LASTINFO; 83270000=14079000= + DO BEGIN 83275000=14081000= + IF NOT STREAMTOG THEN 83280000=14082000= + BUP:= LASTINFO; 83285000=14083000= + GETLP: 83290000=14084000= + G:= TAKE(BUP); 83295000=14084000= + IF K:= G.ADDRESS ^= PJ THEN 83300000=14086000= + BEGIN 83305000=14087000= + IF BUP ^= BUP:= BUP-TAKE(BUP+1).PURPT THEN 83310000=14088000= + GO TO GETLP 83315000=14090000= + END; 83320000=14090000= + IF TYPEV:= G.CLASS = FRMTID OR TYPEV = SUPERFRMTID THEN 83325000=14091000= + G.ADDRESS:= F:= F+2 83330000=14093000= + ELSE 83335000=14093000= + IF TYPEV:= G.CLASS <= INTARRAYID AND TYPEV >= BOOARRAYID 83340000=14096000= + THEN 83345000=14096000= + BEGIN 83350000=14097000= + T1:= G.INCR; 83355000=14098000= + GT1:= N:= TAKE(BUP+T1); 83360000=14099000= + G.ADDRESS:= F:= F+N+1; 83365000=14100000= + WHILE N ^= 0 DO 83370000=14102000= + BEGIN 83375000=14103000= + IF T2:= TAKE(BUP+T1+N) < 0 THEN 83380000=14105000= + BEGIN 83385000=14106000= + T2:= -T2; 83390000=14107000= + T2.LBP:= 4*(F-N)+2; 83395000=14108000= + PUT(T2, BUP+T1+N) 83400000=14110000= + END; 83405000=14110000= + N:= N-1 83410000=14112000= + END 83415000=14114000= + END 83420000=14115000= + ELSE 83425000=14115000= + G.ADDRESS:= F:= F+1; 83430000=14115000= + PUT(G, BUP); 83435000=14116000= + G.INCR:= GT1; 83440000=14116000= + IF FWDTOG THEN 83445000=14116100= + COMMENT CHECK CORRESPONDENCE W/ FWD; 83450000=14116100= + BEGIN 83455000=14116200= + IF (GT1:= TAKE(MARK+PJ)).CLASS ^= G.CLASS 83460000=14116400= + COMMENT CLASS ERROR; 83465000=14116400= + THEN 83470000=14116400= + FLAG(49); 83475000=14116400= + COMMENT VALUE ERROR; 83480000=14116500= + IF GT1.VO ^= G.VO THEN 83485000=14116500= + FLAG(50) 83490000=14116600= + END 83495000=14117000= + ELSE 83500000=14117000= + PUT(G, MARK+PJ); 83505000=14118000= + BUP:= BUP-TAKE(BUP+1).PURPT 83510000=14119000= + END 83515000=14120000= + UNTIL PJ:= PJ-1 = 0 83520000=14121000= + END; 83525000=14121000= + SPECTOG:= FALSE; 83530000=14122000= + GO TO HF 83535000=14124000= + END 83540000=14125000= + END; 83545000=14125000= + STACKCT:= 0; 83550000=14125500= + WHILE STEPI = DECLARATORS DO 83555000=14127000= + BEGIN 83560000=14128000= + STOPDEFINE:= (GTA1[J:= J+1]:= ELBAT[I].ADDRESS) ^= MONITORV AND 83565000=14130000= + GTA1[J] ^= DUMPV; 83570000=14130000= + ERRORTOG:= TRUE; 83575000=14130000= + END; 83580000=14131000= + IF J = 0 THEN 83585000=14132000= + GO TO CALLSTATEMENT; 83590000=14132000= + P2:= P3:= P4:= FALSE; 83595000=14133000= + GO TO DECLSW[GTA1[J]]; 83600000=14134000= +OWNERR: 83605000=14135000= + FLAG(20); 83610000=14135000= + J:= J+1; 83615000=14135000= + GO TO REALDEC; 83620000=14135000= +SAVERR: 83625000=14136000= + FLAG(21); 83630000=14136000= + J:= J+1; 83635000=14136000= + GO TO REALDEC; 83640000=14136000= +AUXMEMERR: 83645000=14136100= + FLAG(618); 83650000=14136100= + J:= J+1; 83655000=14136100= + GO TO REALDEC; 83660000=14136100= +STREAMERR: 83665000=14137000= + FLAG(22); 83670000=14137000= + J:= J+1; 83675000=14137000= + GO TO PROCEDUREDEC; 83680000=14137000= +REALDEC: 83685000=14138000= + P3:= TRUE; 83690000=14138000= + ENTER(REALID); 83695000=14138000= + GO TO START; 83700000=14138000= +ALPHADEC: 83705000=14139000= + P3:= TRUE; 83710000=14139000= + ENTER(ALFAID); 83715000=14139000= + GO TO START; 83720000=14139000= +BOOLEANDEC: 83725000=14140000= + P3:= TRUE; 83730000=14140000= + ENTER(BOOID); 83735000=14140000= + GO TO START; 83740000=14140000= +INTEGERDEC: 83745000=14141000= + P3:= TRUE; 83750000=14141000= + ENTER(INTID); 83755000=14141000= + GO TO START; 83760000=14141000= +MONITORDEC: 83765000=14142000= + IF SPECTOG THEN 83770000=14143000= + BEGIN 83775000=14143000= + COMMENT ERROR 463 MEANS THAT A MONITOR 83780000=14143000= + DECLARATION APPEARS IN THE SPECIFICATION 83785000=14144000= + PART OF A PROCEDURE; 83790000=14145000= + FLAG(463); 83795000=14146000= + END; 83800000=14147000= + IF MERRIMAC THEN 83805000=14148000= + BEGIN 83810000=14148000= + FAULTDEC; 83815000=14148000= + GO GOTSCHK 83820000=14148000= + END; 83825000=14148000= + GO START; 83830000=14148000= +DUMPDEC: 83835000=14149000= + IF SPECTOG THEN 83840000=14150000= + BEGIN 83845000=14150000= + COMMENT ERROR 464 MEANS A DUMP DECLARATION 83850000=14150000= + APPEARS IN THE SPECIFICATION PART OF A 83855000=14151000= + PROCEDURE; 83860000=14152000= + FLAG(464); 83865000=14153000= + END; 83870000=14154000= + DMUP; 83875000=14155000= + GO TO START; 83880000=14155000= +ARRAYDEC: 83885000=14156000= + JUMPCHKX; 83890000=14156000= + ARRAE; 83895000=14156000= + GO TO GOTSCHK; 83900000=14156000= +FILEDEC: 83905000=14157000= + J:= J+1; 83910000=14157000= + IODEC(11); 83915000=14157000= + GO TO GOTSCHK; 83920000=14157000= +INDEC: 83925000=14158000= + IODEC(9); 83930000=14158000= + IF G ^= FORMATV THEN 83935000=14158000= + GO GOTSCHK; 83940000=14158000= + GO START; % 83945000=14158000= +OUTDEC: 83950000=14159000= + IODEC(10); 83955000=14159000= + IF G = FORMATV THEN 83960000=14159000= + GO TO START; 83965000=14159000= +GOTSCHK: 83970000=14160000= + GOTSTORAGE:= NOT SPECTOG OR GOTSTORAGE; 83975000=14160000= + GO TO START; 83980000=14160000= +FORMATDEC: 83985000=14161000= + IF SPECTOG THEN 83990000=14161000= + ENTRY(FRMTID+REAL(GTA1[J-1] = SWITCHV)) 83995000=14161000= + ELSE 84000000=14161000= + FORMATGEN; 84005000=14162000= + GO TO START; 84010000=14162000= +LISTDEC: 84015000=14164000= + BEGIN 84020000=14164000= + REAL 84025000=14165000= + SAVEINFO; 84030000=14165000= + LABEL 84035000=14166000= + START; 84040000=14166000= + IF G:= GTA1[J] = LISTV AND G:= GTA1[J-1] = SWITCHV THEN 84045000=14167000= + BEGIN 84050000=14168000= + HANDLESWLIST; 84055000=14168000= + GO TO GOTSCHK 84060000=14168000= + END; 84065000=14168000= + IF SPECTOG THEN 84070000=14169000= + BEGIN 84075000=14170000= + ENTRY(LISTID); 84080000=14170000= + GO TO START 84085000=14170000= + END; 84090000=14170000= + STOPENTRY:= STOPGSP:= TRUE; 84095000=14171000= + I:= I-1; 84100000=14171000= + DO BEGIN 84105000=14172000= + I:= I+1; 84110000=14173000= + JUMPCHKX; 84115000=14173000= + ENTRY(LISTID); 84120000=14174000= + IF ELCLASS ^= LEFTPAREN THEN 84125000=14174000= + FLAG(31) 84130000=14174000= + ELSE 84135000=14174000= + STEPIT; 84140000=14174000= + SAVEINFO:= LASTINFO; % IN CASE C-RELATIVE CONSTANTS ARE 84145000=14175000= + % EMITTED B4 DOING THE PUT-TAKE BELOW. 84150000=14176000= + F:= LISTGEN; 84155000=14177000= + PUT(TAKE(SAVEINFO) & 84160000=14179000= + (IF MODE = 0 THEN F ELSE F:= GETSPACE(FALSE, SAVEINFO+1)) 84165000=14179000= + % LIST DESCR. 84170000=14179000= +[16:11], SAVEINFO); 84175000=14180000= + EMITSTORE(F, STD); 84180000=14181000= + END 84185000=14182000= + UNTIL ELCLASS ^= COMMA; 84190000=14182000= + STOPENTRY:= STOPGSP:= FALSE; 84195000=14183000= + START: 84200000=14185000= + END LISTDEC; 84205000=14185000= + GO TO START; 84210000=14186000= +LABELDEC: 84215000=14187000= + IF SPECTOG AND FUNCTOG THEN 84220000=14187000= + FLAG(24); 84225000=14187000= + STOPENTRY:= STOPGSP:= TRUE; 84230000=14188000= + I:= I-1; 84235000=14189000= + DO BEGIN 84240000=14191000= + STOPDEFINE:= TRUE; 84245000=14192000= + STEPIT; 84250000=14193000= + ENTRY(LABELID); 84255000=14194000= + PUTNBUMP(0) 84260000=14196000= + END 84265000=14197000= + UNTIL ELCLASS ^= COMMA; 84270000=14197000= + STOPENTRY:= STOPGSP:= FALSE; 84275000=14198000= + GO TO START; 84280000=14199000= +SWITCHDEC: 84285000=14201000= + BEGIN 84290000=14201000= + LABEL 84295000=14202000= + START; 84300000=14202000= + INTEGER 84305000=14203000= + GT1, 84310000=14203000= + GT2, 84315000=14203000= + GT4, 84320000=14203000= + GT5; 84325000=14203000= + BOOLEAN 84330000=14204000= + TB1; 84335000=14204000= + STOPENTRY:= NOT SPECTOG; 84340000=14205000= + STOPGSP:= TRUE; 84345000=14205000= + SCATTERELBAT; 84350000=14206000= + GT1:= 0; 84355000=14206000= + TB1:= FALSE; 84360000=14206000= + IF LEVELF = LEVEL THEN 84365000=14208000= + BEGIN 84370000=14209000= + IF TAKE(LINKF+1) >= 0 THEN 84375000=14211000= + FLAG(1); 84380000=14211000= + PUT(-TAKE(LINKF+1), LINKF+1); 84385000=14211000= + TB1:= TRUE; 84390000=14212000= + GT2:= ADDRSF; 84395000=14212000= + GT1:= TAKEFRST; 84400000=14213000= + GT4:= LASTINFO; 84405000=14213000= + LASTINFO:= LINKF; 84410000=14213000= + STEPIT; 84415000=14214000= + GT5:= NEXTINFO; 84420000=14214000= + NEXTINFO:= LINKF+INCRF 84425000=14215000= + END 84430000=14217000= + ELSE 84435000=14217000= + ENTRY(SWITCHID); 84440000=14217000= + STOPGSP:= STOPENTRY:= FALSE; 84445000=14217000= + IF SPECTOG THEN 84450000=14217000= + GO TO START: 84455000=14219000= + IF ELCLASS = ASSIGNOP THEN 84460000=14220000= + BEGIN 84465000=14221000= + JUMPCHKNX; 84470000=14222000= + PUTNBUMP(L); 84475000=14222000= + G:= L; 84480000=14222000= + IF FORMALF:= SWITCHGEN(TB1, GT1) THEN 84485000=14224000= + BEGIN 84490000=14225000= + JUMPCHKX; 84495000=14227000= + STUFFF(GT1); 84500000=14228000= + IF MODE > 0 THEN 84505000=14230000= + IF TB1 THEN 84510000=14231000= + GT1:= GT2 84515000=14231000= + ELSE 84520000=14231000= + GT1:= GETSPACE(FALSE, LASTINFO+1); % SWITCH. 84525000=14232000= + EMITSTORE(GT1, STD) 84530000=14234000= + END; 84535000=14234000= + END 84540000=14237000= + ELSE 84545000=14237000= + BEGIN 84550000=14237000= + IF ELCLASS ^= FORWARDV THEN 84555000=14238000= + FLAG(33); 84560000=14238000= + PUT(-TAKE(LASTINFO+1), LASTINFO+1); 84565000=14239000= + PUTNBUMP(GT1:= GETSPACE(TRUE, LASTINFO+1)); %SWITCH. 84570000=14240000= + IF MODE > 0 THEN 84575000=14241000= + GT1:= GETSPACE(FALSE, -1); %TEMP. STOR. 84580000=14241000= + STEPIT; 84585000=14242000= + FORMALF:= TRUE 84590000=14244000= + END; 84595000=14244000= + PUT(TAKE(LASTINFO) & REAL(FORMALF)[9:47:1] & GT1[16:37:11], 84600000=14245000= + LASTINFO); 84605000=14245000= + IF TB1 THEN 84610000=14246000= + BEGIN 84615000=14247000= + NEXTINFO:= GT5; 84620000=14248000= + LASTINFO:= GT4; 84625000=14249000= + END; 84630000=14250000= + START: 84635000=14252000= + END SWITCHDEC; 84640000=14252000= + GO TO START; 84645000=14253000= +DEFINEDEC: 84650000=14254050= + BEGIN 84655000=14254050= + LABEL 84660000=14254050= + START; 84665000=14254050= + REAL 84670000=14254100= + J, 84675000=14254100= + K, 84680000=14254100= + DINFO, 84685000=14254100= + LINKA, 84690000=14254100= + LINKB; 84695000=14254100= + STOPENTRY:= STOPGSP:= TRUE; 84700000=14255000= + I:= I-1; 84705000=14255000= + DEFINING:= BOOLEAN(REAL(DEFINING) & 1[47:47:1]); 84710000=14255500= + DO BEGIN 84715000=14257000= + STOPDEFINE:= TRUE; 84720000=14258000= + STEPIT; 84725000=14259000= + MOVE(9, ACCUM[1], GTA1); 84730000=14259000= + K:= COUNT+1; 84735000=14259010= + J:= GTA1[0]; 84740000=14259010= + ENTRY(DEFINEDID); 84745000=14259010= + GTA1[0]:= J+6"100000"; 84750000=14259015= + J:= 0; 84755000=14259015= + DINFO:= LASTINFO; 84760000=14259017= + IF ELCLASS = LEFTPAREN OR ELCLASS = LFTBRKET THEN 84765000=14259020= + BEGIN 84770000=14259030= + IF K > 62 THEN 84775000=14259040= + BEGIN 84780000=14259040= + ERR(141); 84785000=14259040= + GO START 84790000=14259040= + END; 84795000=14259040= + DO BEGIN 84800000=14259060= + STOPDEFINE:= TRUE; 84805000=14259060= + STEPIT; 84810000=14259070= + IF(J:= J+1) > 9 THEN 84815000=14259075= + BEGIN 84820000=14259075= + ERR(172); 84825000=14259075= + GO START 84830000=14259075= + END; 84835000=14259075= + MOVE(9, ACCUM[1], DEFINFO[(J-1)*10]); 84840000=14259080= + DEFINEPARAM(DINFO+1, J); 84845000=14259085= + ACCUM[0]:= 0 & DEFINEDID CLASS & 1 FORMAL; 84850000=14259090= + LINKA:= LASTINFO; 84855000=14259094= + LINKB:= NEXTINFO; 84860000=14259094= + E; 84865000=14259096= + IF LASTINFO ^= LINKB THEN % NEW INFO ROW ENTERED. 84870000=14259098= + PUT(TAKE(LINKA) & (LASTINFO-LINKA)[27:40:8], LINKA)84875000=14259100= + ; 84880000=14259100= + STACKHEAD[SCRAM]:= TAKE(LASTINFO).LINK; 84885000=14259102= + STOPDEFINE:= TRUE; 84890000=14259104= + END 84895000=14259110= + UNTIL STEPI ^= COMMA; 84900000=14259110= + IF ELCLASS ^= RTPAREN AND ELCLASS ^= RTBRKET THEN 84905000=14259120= + ERR(173); 84910000=14259120= + STOPDEFINE:= TRUE; 84915000=14259130= + STEPIT; 84920000=14259140= + PUT(-TAKE(DINFO), DINFO); % MARK AS PARAMETRIC 84925000=14259150= + PUT(TAKE(LASTINFO) & 0[27:40:8], LASTINFO); 84930000=14259155= + END; 84935000=14259160= + IF ELCLASS ^= RELOP OR ACCUM[1] ^= 6"1=0000" THEN 84940000=14261000= + BEGIN 84945000=14262000= + FLAG(45); 84950000=14263000= + COMMENT ERROR 45 IS NO = FOLLOWING DEFINE ID; 84955000=14263100= + I:= I-1; 84960000=14264000= + END; 84965000=14265000= + MACROID:= TRUE; 84970000=14265900= + LASTINFO:= DINFO; 84975000=14265930= + PUT(TAKE(DINFO) & NEXTTEXT[11:32:16], DINFO); 84980000=14265950= + DEFINEGEN(FALSE, J & DINFO[18:33:15]); 84985000=14266000= + MACROID:= FALSE; 84990000=14266100= + END 84995000=14268000= + UNTIL STEPI ^= COMMA; 85000000=14268000= + DEFINING:= BOOLEAN(REAL(DEFINING) & 0[47:47:1]); 85005000=14268500= + START: 85010000=14269000= + STOPENTRY:= STOPGSP:= FALSE; 85015000=14269000= + END; 85020000=14269000= + GO TO START; 85025000=14269000= +FIELDDEC: 85030000=14269040= + BEGIN 85035000=14269040= + REAL 85040000=14269060= + SAVEINFO, 85045000=14269060= + SB, 85050000=14269060= + NB; 85055000=14269060= + BOOLEAN 85060000=14269080= + FOUNDLB; % TRUE IF LEFT-BRACKET WAS USED IN FIELD SPEC. 85065000=14269080= + LABEL 85070000=14269100= + EXIT, 85075000=14269100= + SAVEIT; 85080000=14269100= + STOPENTRY:= STOPGSP:= TRUE; 85085000=14269120= + I:= I-1; 85090000=14269140= + DO BEGIN 85095000=14269180= + STOPDEFINE:= TRUE; 85100000=14269200= + STEPIT; 85105000=14269220= + ENTRY(FIELDID); 85110000=14269240= + SAVEINFO:= LASTINFO; 85115000=14269260= + IF ELCLASS = RELOP AND ACCUM[1] = 6"1=0000" THEN 85120000=14269280= + BEGIN 85125000=14269300= + IF STEPI = LFTBRKET THEN% REMEMBER THIS 85130000=14269320= + BEGIN 85135000=14269340= + FOUNDLB:= TRUE; 85140000=14269360= + STEPIT; 85145000=14269380= + END 85150000=14269440= + ELSE 85155000=14269440= + FOUNDLB:= FALSE; 85160000=14269440= + IF ELCLASS = FIELDID THEN 85165000=14269442= + BEGIN 85170000=14269444= + SB:= ELBAT[I].SBITF; 85175000=14269446= + NB:= ELBAT[I].NBITF; 85180000=14269448= + GO TO SAVEIT; 85185000=14269450= + END; 85190000=14269452= + IF ELCLASS = LITNO THEN 85195000=14269460= + IF STEPI = COLON THEN 85200000=14269480= + IF STEPI = LITNO THEN 85205000=14269500= + IF(SB:= ELBAT[I-2].ADDRESS)*(NB:= ELBAT[I].ADDRESS) 85210000=14269540= + ^= 0 AND SB+NB <= 48 85215000=14269560= + THEN 85220000=14269560= + BEGIN 85225000=14269580= + SAVEIT: 85230000=14269600= + PUT 85235000=14269620= + (TAKE(SAVEINFO) & SB SBITF & NB NBITF, SAVEINFO)85240000=14269620= + ; 85245000=14269620= + STEPIT; 85250000=14269640= + IF FOUNDLB THEN % BETTER HAVE RIGHT BRACKET. 85255000=14269660= + IF ELCLASS = RTBRKET THEN 85260000=14269680= + BEGIN 85265000=14269700= + STEPIT; 85270000=14269705= + GO TO EXIT; 85275000=14269710= + END 85280000=14269740= + ELSE 85285000=14269740= + ELSE 85290000=14269760= + GO TO EXIT; 85295000=14269760= + END; 85300000=14269780= + END; 85305000=14269800= + FLAG(114); 85310000=14269820= + DO 85315000=14269840= + STEPIT 85320000=14269840= + UNTIL ELCLASS = COMMA OR ELCLASS = SEMICOLON; 85325000=14269840= + EXIT: 85330000=14269880= + END 85335000=14269920= + UNTIL ELCLASS ^= COMMA; 85340000=14269920= + STOPENTRY:= STOPGSP:= FALSE; 85345000=14269940= + END; 85350000=14269960= + GO TO START; 85355000=14269980= +PROCEDUREDEC: 85360000=14271000= + BEGIN 85365000=14271000= + LABEL 85370000=14272000= + START, 85375000=14272000= + START1; 85380000=14272000= + LABEL 85385000=14273000= + START2, 85390000=14273000= + DOITANYWAY; 85395000=14273000= + COMMENT FWDTOG NOW GLOBAL TO BLOCK; 85400000=14274000= + IF NOT SPECTOG THEN 85405000=14275000= + FUNCTOG:= FALSE; 85410000=14275000= + FWDTOG:= NEXTSAVE:= FALSE; 85415000=14276000= + IF LASTENTRY ^= 0 THEN 85420000=14276500= + BEGIN 85425000=14276500= + JUMPCHKNX; 85430000=14276500= + CONSTANTCLEAN 85435000=14276500= + END; 85440000=14276500= + MAXSTACKO:= MAXSTACK; 85445000=14277000= + IF G:= GTA1[J:= J-1] = STREAMV THEN 85450000=14279000= + BEGIN 85455000=14280000= + STREAMTOG:= TRUE; 85460000=14280000= + IF G:= GTA1[J:= J-1] = 0 THEN 85465000=14281000= + TYPEV:= STRPROCID 85470000=14282000= + ELSE 85475000=14282000= + BEGIN 85480000=14283000= + IF TYPEV:= PROCID+G > INSTRPROCID OR TYPEV < BOOSTRPROCID THEN85485000=14286000= + FLAG(004); 85490000=14286000= + IF NOT SPECTOG THEN 85495000=14287000= + FUNCTOG:= TRUE; 85500000=14288000= + CHKSOB 85505000=14290000= + END 85510000=14291000= + END 85515000=14292000= + ELSE 85520000=14292000= + IF G = 0 THEN 85525000=14292000= + TYPEV:= PROCID 85530000=14293000= + ELSE 85535000=14293000= + IF(TYPEV:= REALSTRPROCID+G) = INTSTRPROCID THEN 85540000=14294000= + BEGIN 85545000=14294100= + NEXTSAVE:= TRUE; 85550000=14294100= + TYPEV:= PROCID 85555000=14294100= + END 85560000=14295000= + ELSE 85565000=14295000= + IF TYPEV < BOOPROCID OR TYPEV > INTRPROCID THEN 85570000=14295000= + FLAG(005) 85575000=14295100= + ELSE 85580000=14295100= + BEGIN 85585000=14295100= + IF(NEXTSAVE:= GTA1[J-1] = SAVEV) THEN 85590000=14295100= + J:= J-1; 85595000=14295100= + IF NOT SPECTOG THEN 85600000=14296000= + FUNCTOG:= TRUE; 85605000=14296000= + CHKSOB 85610000=14297000= + END; 85615000=14297000= + IF SPECTOG THEN 85620000=14299000= + BEGIN 85625000=14300000= + ENTRY(TYPEV); 85630000=14301000= + GO TO START2 85635000=14302000= + END; 85640000=14302000= + MODE:= MODE+1; 85645000=14303000= + LO:= PROINFO; 85650000=14304000= + SCATTERELBAT; 85655000=14305000= + 85660000=14306000= +COMMENT CHECK TO SEE IF DECLARED FORWARD PREVIOUSLY ;85665000=14306000= + IF LEVELF = LEVEL THEN 85670000=14308000= + IF KLASSF ^= TYPEV THEN 85675000=14308000= + BEGIN 85680000=14308000= + FLAG(6); 85685000=14308000= + GO DOITANYWAY 85690000=14308000= + END 85695000=14309000= + ELSE 85700000=14309000= + BEGIN 85705000=14309000= + IF G:= TAKE(LINKF+1) >= 0 THEN 85710000=14310000= + FLAG(006) 85715000=14310000= + ELSE 85720000=14310000= + PUT(-G, LINKF+1); 85725000=14310000= + XMARK(DECLREF); % PROCEDURE DECLARED FORWARD. MARK LAST 85730000=14310500= + % XREF ENTRY AS A DECLARATION. 85735000=14310501= + IF REAL(NEXTSAVE) ^= G.[3:1] THEN 85740000=14311100= + FLAG(051); 85745000=14311100= + FWDTOG:= TRUE; 85750000=14312000= + PROAD:= ADDRSF; 85755000=14313000= + PROINFO:= ELBAT[I]; 85760000=14314000= + MARK:= LINKF+INCRF; 85765000=14314000= + STEPIT 85770000=14316000= + END 85775000=14318000= + ELSE 85780000=14318000= + DOITANYWAY: 85785000=14318000= + BEGIN 85790000=14318000= + STOPENTRY:= P2:= TRUE; 85795000=14318000= + ENTRY(TYPEV); 85800000=14319000= + MARK:= NEXTINFO; 85805000=14319000= + PUTNBUMP(0); 85810000=14319000= + PROINFO:= TAKE(LASTINFO) & LASTINFO[35:35:13]; 85815000=14320000= + PROAD:= ADDRSF; 85820000=14320000= + P2:= STOPENTRY:= FALSE 85825000=14322000= + END; 85830000=14322000= + IF LEVEL < 31 THEN 85835000=14323000= + LEVEL:= LEVEL+1 85840000=14323100= + ELSE 85845000=14323100= + FLAG(039); 85850000=14323100= + PJ:= 0; 85855000=14323200= + IF STREAMTOG THEN 85860000=14324000= + STREAMWORDS; 85865000=14324000= + IF ELCLASS = SEMICOLON THEN 85870000=14325000= + GO TO START1; 85875000=14325000= + IF ECLASS ^= LEFTPAREN THEN 85880000=14326000= + FLAG(007); 85885000=14326000= + 85890000=14327000= +COMMENT: THE FOLLOWING 8 STATEMENTS FOOL THE SCANNER AND BLOCK,PUTTING 85895000=14327000= + FORMAL PARAMETER ENTRIES IN THE ZERO ROW OF INFO; 85900000=14328000= + RR1:= NEXTINFO; 85905000=14329000= + LASTINFOT:= LASTINFO; 85910000=14330000= + LASTINFO:= NEXTINFO:= 1; 85915000=14330000= + PUTNBUMP(0); 85920000=14331000= + PTOG:= TRUE; 85925000=14332000= + I:= I+1; 85930000=14332000= + ENTRY(SECRET); 85935000=14333000= + IF FWDTOG THEN 85940000=14333100= + BEGIN 85945000=14333100= + IF GT1:= TAKE(MARK).[40:8] ^= PJ THEN % 85950000=14333100= + FLAG(48); 85955000=14333200= + COMMENT WRONG NUMBER OF PARAMETERS; 85960000=14333200= + 85965000=14333300= + COMMENT SO THAT WE DONT CLOBBER INFO; 85970000=14333300= + END 85975000=14334000= + ELSE 85980000=14334000= + PUT(PJ, MARK); 85985000=14334000= + P:= PJ; 85990000=14335000= + IF ELCLASS ^= RTPAREN THEN 85995000=14337000= + FLAG(008); 86000000=14337000= + IF STEPI ^= SEMICOLON THEN 86005000=14339000= + FLAG(009); 86010000=14339000= + 86015000=14340000= +COMMENT MARK PARAMETERS VALUE IF THERE IS A VALUE PART; 86020000=14340000= + IF STEPI = VALUEV THEN 86025000=14342000= + BEGIN 86030000=14343000= + DO 86035000=14345000= + IF STEPI ^= SECRET THEN 86040000=14346000= + FLAG(010) 86045000=14347000= + ELSE 86050000=14347000= + BEGIN 86055000=14348000= + IF G:= ELBAT[I].ADDRESS = 0 OR G > PJ THEN 86060000=14350000= + FLAG(010); 86065000=14351000= + G:= TAKE(ELBAT[I]); 86070000=14352000= + PUT(G & 1[10:47:1], ELBAT[I]) 86075000=14354000= + END 86080000=14356000= + UNTIL STEPI ^= COMMA; 86085000=14356000= + IF ELCLASS ^= SEMICOLON THEN 86090000=14358000= + FLAG(011) 86095000=14359000= + ELSE 86100000=14359000= + STEPIT 86105000=14360000= + END; 86110000=14360000= + I:= I-1; 86115000=14360000= + IF STREAMTOG THEN 86120000=14362000= + BEGIN 86125000=14363000= + BUP:= PJ; 86130000=14364000= + SPECTOG:= TRUE; 86135000=14364000= + GO TO START1 86140000=14365000= + END 86145000=14367000= + ELSE 86150000=14367000= + BEGIN 86155000=14367000= + SPECTOG:= TRUE; 86160000=14368000= + BUP:= 0; 86165000=14369000= + IF ELCLASS ^= DECLARATORS THEN 86170000=14371000= + FLAG(012) 86175000=14372000= + END; 86180000=14372000= + START: 86185000=14373000= + PTOG:= FALSE; 86190000=14373000= + LASTINFO:= LASTINFOT; 86195000=14373000= + NEXTINFO:= 86200000=14373000= + IF FWDTOG THEN 86205000=14373000= + RR1 86210000=14373000= + ELSE 86215000=14373000= + MARK+PJ+1; 86220000=14374000= + START1: 86225000=14375000= + PINFOO:= NEXTINFO; 86230000=14375000= + START2: 86235000=14376000= + END; 86240000=14376000= + IF SPECTOG OR STREAMTOG THEN 86245000=14378000= + GO TO START; 86250000=14379000= + 86255000=14380000= +COMMENT IF SPECTOG IS ON THEN THE BLOCK WILL PROCESS THE SPECIFICATION 86260000=14380000= + PART SIMILARY TO DECLARATIONS WITH A FEW NECESSARY VARIATIONS; 86265000=14381000= +HF: BEGIN 86270000=14383000= + LABEL 86275000=14384000= + START, 86280000=14384000= + STOP; 86285000=14384000= + IF STREAMTOG THEN 86290000=14386000= + BEGIN 86295000=14386000= + JUMPCHKNX; 86300000=14387000= + G:= PROGDESCBLDR(CHAR, L, PROAD); 86305000=14387000= + PJ:= P; 86310000=14387000= + PTOG:= FALSE; 86315000=14388000= + IF FUNCTOG THEN 86320000=14390000= + PUT((Z:= TAKE(PROINFO)) & LOCLID[2:41:7] & (PJ:= PJ+1) 86325000=14392000= + [16:37:11], PROINFO); 86330000=14392000= + IF STEPI = BEGINV THEN 86335000=14394000= + BEGIN 86340000=14395000= + WHILE STEPI = DECLARATORS OR ELCLASS = LOCALV DO 86345000=14397000= + BEGIN 86350000=14398000= + IF ELBAT[I].ADDRESS = LABELV THEN 86355000=14400000= + BEGIN 86360000=14401000= + STOPDEFINE:= STOPGSP:= STOPENTRY:= TRUE; 86365000=14402000= + DO BEGIN 86370000=14403000= + STOPDEFINE:= TRUE; 86375000=14403000= + STEPIT; 86380000=14403000= + ENTRY(STLABID); 86385000=14403000= + PUTNBUMP(0) 86390000=14403000= + END 86395000=14404000= + UNTIL ELCLASS ^= COMMA; 86400000=14404000= + STOPGSP:= STOPENTRY:= FALSE 86405000=14405000= + END 86410000=14407000= + ELSE 86415000=14407000= + BEGIN 86420000=14407000= + I+I+1; 86425000=14408000= + ENTRY(LOCLID) 86430000=14410000= + END 86435000=14411000= + END; 86440000=14411000= + COMPOUNDTAIL 86445000=14413000= + END 86450000=14415000= + ELSE 86455000=14415000= + STREAMSTMT; 86460000=14415000= + COMMENT THE FOLLOWING BLOCK CONSTITUTES THE STREAM PROCEDURE PURGE; 86465000=14416000= + BEGIN 86470000=14417000= + REAL 86475000=14418000= + NLOC, 86480000=14418000= + NLAB; 86485000=14418000= + DEFINE 86490000=14419000= + SES = 18 #, 86495000=14419000= + SED = 6 #, 86500000=14419000= + TRW = 5 #; 86505000=14419000= + DEFINE 86510000=14419100= + RSA = 43 #; 86515000=14419100= + DEFINE 86520000=14420000= + LOC = [36:12] #, 86525000=14420000= + LASTGT = [24:12] #; 86530000=14420000= + J:= LASTINFO; 86535000=14421000= + NLOC:= NLAB:= 0; 86540000=14422000= + DO BEGIN 86545000=14424000= + IF (GT1:= TAKE(J)).CLASS = LOCLID THEN 86550000=14425000= + BEGIN 86555000=14426000= + IF BOOLEAN(GT1.FORMAL) THEN 86560000=14427000= + BEGIN 86565000=14428000= + IF GT1 < 0 THEN 86570000=14429000= + PUT(TAKE(GT2:= MARK+P-GT1.ADDRESS+1) & 86575000=14431000= + FILEID[2:41:7], GT2); 86580000=14431000= + END 86585000=14433000= + ELSE 86590000=14433000= + NLOC:= NLOC+1; 86595000=14433000= + END 86600000=14436000= + ELSE 86605000=14436000= + BEGIN 86610000=14436000= + IF GT1.ADDRESS ^= 0 THEN 86615000=14437000= + NLAB:= NLAB+1; 86620000=14437000= + IF (GT3:= TAKE(GIT(J))).LASTGT ^= 0 AND GT3.LOC = 0 86625000=14438000= + THEN 86630000=14438000= + BEGIN 86635000=14439000= + MOVE(9, INFO[0, J], ACCUM[0]); 86640000=14440000= + Q:= ACCUM[1]; 86645000=14441000= + FLAG(267); 86650000=14442000= + ERRORTOG:= TRUE; 86655000=14443000= + END; 86660000=14444000= + END; 86665000=14445000= + XREFDUMP(J); % DUMP XREF INFO 86670000=14445100= + G:= (GT2:= TAKE(J+1)).PURPT; 86675000=14446000= + IF GT1.[2:8] ^= STLABID*2+1 THEN 86680000=14447000= + STACKHEAD[(0 & GT2[12:12:36]) MOD 125]:= TAKE(J).LINK; 86685000=14448000= + END 86690000=14449000= + UNTIL J:= J-G <= 1; 86695000=14449000= + PUT(P & NLAB[7:42:6] & (NLOC+REAL(FUNCTOG))[1:42:6] & (LPRT+1)86700000=14451000= + [13:37:11], MARK); 86705000=14451000= + GT1:= L; 86710000=14451100= + L:= FILETHING; 86715000=14451100= + WHILE L ^= 4095 DO 86720000=14451200= + BEGIN 86725000=14451300= + FILETHING:= GET(L); 86730000=14451300= + EMITC(PJ+1, RSA); 86735000=14451400= + L:= FILETHING; 86740000=14451500= + END; 86745000=14451600= + L:= GT1; 86750000=14451700= + FILETHING:= 4095; 86755000=14451700= + IF FUNCTOG THEN 86760000=14452000= + BEGIN 86765000=14453000= + EMITC(TAKE(PROINFO).ADDRESS, SES); 86770000=14454000= + EMITC(PJ+2, SED); 86775000=14455000= + EMITC(1, TRW); 86780000=14456000= + PUT(Z, PROINFO); 86785000=14457000= + END; 86790000=14458000= + EMIT(0); 86795000=14459000= + STREAMWORDS; 86800000=14460000= + STREAMTOG:= FALSE; 86805000=14461000= + IF LISTER AND FORMATOG THEN 86810000=14461500= + SPACEITDOWN; 86815000=14461500= + END; 86820000=14462000= + LASTINFO:= LASTINFOT; 86825000=14463000= + NEXTINFO:= MARK+P+1; 86830000=14463000= + END 86835000=14466000= + ELSE 86840000=14466000= + BEGIN 86845000=14466000= + IF STEPI = FORWARDV THEN 86850000=14468000= + BEGIN 86855000=14469000= + XREFIT(PROINFO, 0, FORWARDREF); % WE NEED THIS SO WE CAN FIND86860000=14469100= + % THE FORWARD DECL. DURING XREF 86865000=14469101= + PUT(-TAKE(G:= PROINFO.LINK+1) & REAL(NEXTSAVE)[3:47:1], G); 86870000=14470000= + PURGE(PINFOO); 86875000=14471000= + STEPIT 86880000=14473000= + END 86885000=14475000= + ELSE 86890000=14475000= + BEGIN 86895000=14475000= + PROADO:= PROAD; 86900000=14476000= + TSUBLEVEL:= SUBLEVEL; 86905000=14477000= + SUBLEVEL:= LEVEL; 86910000=14477000= + STACKCTRO:= STACKCTR; 86915000=14477000= +% 86920000=14478000= + COMMENT ADDITIONS MADE TO COMPILER TO INSURE THAT STACKCELLS 86925000=14478010= + COUNTER DOES NOT OVERFLOW FOR PROCEDURE DECLARATIONS; 86930000=14478020= + IF MODE = 1 THEN 86935000=14478030= + FRSTLEVEL:= LEVEL; 86940000=14478030= + MAXSTACK:= STACKCTR:= 514+REAL(FUNCTOG); 86945000=14478040= + IF ELCLASS = BEGINV THEN 86950000=14479000= + IF TABLE(I+1) = DECLARATORS THEN 86955000=14480000= + BEGIN 86960000=14481000= + BLOCK(TRUE & NEXTSAVE[46:47:1]); 86965000=14482000= + ; 86970000=14483000= + PURGE(PINFOO); 86975000=14483000= + GO TO STOP 86980000=14484000= + END; 86985000=14484000= + BEGIN 86990000=14485000= + JUMPCHKNX; 86995000=14486000= + RELAD:= L; 87000000=14487000= + IF NEXTSAVE THEN 87005000=14487010= + FLAG(052); 87010000=14487010= + STMT; 87015000=14488000= + IF FAULTOG.[46:1] THEN 87020000=14488500= + BEGIN 87025000=14488500= + EMITL(10); 87030000=14488500= + EMITO(COM); 87035000=14488500= + END; 87040000=14488500= + HTTEOAP(FALSE, RELAD, PINFOO, PROAD); 87045000=14489000= + END; 87050000=14490000= + STOP: 87055000=14492000= + SUBLEVEL:= TSUBLEVEL; 87060000=14492000= + STACKCTR:= STACKCTRO; 87065000=14493000= + IF LISTER AND FORMATOG THEN 87070000=14493500= + SPACEITDOWN; 87075000=14493500= + END; 87080000=14494000= + END; 87085000=14495000= + PROINFO:= LO; 87090000=14496000= + IF JUMPCTR = LEVEL THEN 87095000=14498000= + JUMPCTR:= LEVEL-1; 87100000=14499000= + LEVEL:= LEVEL-1; 87105000=14500000= + MODE:= MODE-1; 87110000=14501000= + MAXSTACK:= MAXSTACKO; 87115000=14502000= + START: 87120000=14503000= + END; 87125000=14503000= + GO TO START; 87130000=14504000= +CALLSTATEMENT: 87135000=14506000= + JUMPCHKX; 87140000=14506000= + IF SPECTOG THEN 87145000=14507000= + BEGIN 87150000=14507000= + IF(PJ ^= BUP) THEN 87155000=14507010= + BEGIN 87160000=14507020= + INTEGER 87165000=14507030= + II, 87170000=14507030= + SSCRAM, 87175000=14507030= + SCOUNT; 87180000=14507030= + MOVE(10, ACCUM, INFO[31, 240]); 87185000=14507040= + II:= I; 87190000=14507050= + SSCRAM:= SCRAM; 87195000=14507050= + SCOUNT:= COUNT; 87200000=14507050= + FOR SCRAM:= 0 STEP 1 UNTIL 124 DO 87205000=14507070= + IF ((I:= STACKHEAD[SCRAM]) < 256) THEN 87210000=14507080= + IF I ^= 0 THEN 87215000=14507080= + BEGIN 87220000=14507090= + ELBAT[76]:= INFO[0, I] & I[35:35:13]; 87225000=14507095= + COUNT:= INFO[0, I+1].[12:6]; 87230000=14507100= + MOVE(COUNT, INFO[0, I], ACCUM); 87235000=14507105= + I:= 76; 87240000=14507110= + SCATTERELBAT; 87245000=14507110= + FORMALF:= TRUE; 87250000=14507120= + KLASSF:= REALID; 87255000=14507130= + MAKEUPACCUM; 87260000=14507140= + E; 87265000=14507140= + END; 87270000=14507150= + I:= II; 87275000=14507160= + SCRAM:= SSCRAM; 87280000=14507160= + COUNT:= SCOUNT; 87285000=14507160= + MOVE(10, INFO[31, 240], ACCUM); 87290000=14507170= + BUP:= PJ; 87295000=14507180= + FLAG(12); 87300000=14507180= + SPECTOG:= TRUE; 87305000=14507180= + GO TO START; 87310000=14507190= + END; 87315000=14507200= + FLAG(12); 87320000=14508000= + GO TO HF 87325000=14509000= + END; 87330000=14509000= + BEGINCTR:= BEGINCTR-1; 87335000=14510000= + IF ERRORTOG THEN 87340000=14512000= + COMPOUNDTAIL 87345000=14513000= + ELSE 87350000=14513000= + BEGIN 87355000=14514000= + STMT; 87360000=14515000= + IF ELCLASS:= TABLE(I+1) = DECLARATORS THEN 87365000=14517000= + BEGIN 87370000=14518000= + ELBAT[I].CLASS:= SEMICOLON; 87375000=14519000= + BEGINCTR:= BEGINCTR+1; 87380000=14520000= + GO TO START 87385000=14522000= + END 87390000=14524000= + ELSE 87395000=14524000= + COMPOUNDTAIL 87400000=14525000= + END; 87405000=14525000= + BEGIN 87410000=14526000= + RELAD:= FIRSTX; 87415000=14534000= + IF STACKCTR > MAXSTACK THEN 87420000=14536000= + MAXSTACK:= STACKCTR; 87425000=14536000= + IF GOTSTORAGE OR JUMPCTR = LEVEL OR FAULTOG.[46:1] THEN 87430000=14538000= + IF NOT (GOTSTORAGE OR FAULTOG.[46:1]) THEN 87435000=14540000= + BEGIN 87440000=14541000= + EMITV(BLOCKCTR); 87445000=14542000= + EMITL(1); 87450000=14543000= + EMITO(SUB); 87455000=14544000= + EMITSTORE(BLOCKCTR, STD); 87460000=14545000= + GOTSTORAGE:= TRUE 87465000=14547000= + END 87470000=14549000= + ELSE 87475000=14549000= + BEGIN 87480000=14549000= + EMITL(10); 87485000=14550000= + EMITO(COM) 87490000=14552000= + END; 87495000=14552000= + FUNCTOG:= FUNCTOGO; 87500000=14553000= + IF SOP THEN 87505000=14555000= + HTTEOAP(GOTSTORAGE, FIRSTX, NINFOO, BLKAD) 87510000=14556000= + ELSE 87515000=14556000= + BEGIN 87520000=14557000= + IF LEVEL = 1 THEN 87525000=14557500= + EMITO(XIT) 87530000=14557600= + ELSE 87535000=14557600= + BEGIN 87540000=14557600= + EMITV(ADDRSF:= GETSPACE(TRUE, -6)); % SEG. DESCR. 87545000=14558000= + EMITO(BFW); 87550000=14558500= + END; 87555000=14558600= + CONSTANTCLEAN; 87560000=14559000= + IF GOTSTORAGE OR NCII > 0 OR LEVEL = 1 OR FAULTOG.[46:1] THEN 87565000=14561000= + BEGIN 87570000=14562000= + ADJUST; 87575000=14563000= + RELAD:= L; 87580000=14563000= + IF GOTSTORAGE OR FAULTOG.[46:1] THEN 87585000=14564100= + BEGIN 87590000=14564100= + EMITV(BLOCKCTR); 87595000=14564100= + EMITL(1); 87600000=14564100= + EMITO(ADD); 87605000=14565000= + EMITSTORE(BLOCKCTR, STD); 87610000=14565000= + END; 87615000=14566000= + IF LEVEL = 1 THEN 87620000=14567000= + IF G:= NCII+MAXSTACK-512 > 0 THEN 87625000=14567000= + DO 87630000=14567000= + EMITL(0) 87635000=14567000= + UNTIL G:= G-1 = 0; 87640000=14568000= + PURGE(NINFOO); 87645000=14569000= + IF LEVEL = 1 THEN 87650000=14569100= + IF FAULTLEVEL = 1 THEN 87655000=14569100= + BEGIN 87660000=14569200= + EMITPAIR(0, MDS); 87665000=14569200= + EMITO(CHS); 87670000=14569200= + END; 87675000=14569200= + BUMPL; 87680000=14570000= + EMITB(BBW, L, IF FIRSTX = 4095 THEN 0 ELSE FIRSTX); 87685000=14571000= + CONSTANTCLEAN 87690000=14573000= + END 87695000=14573000= + ELSE 87700000=14573000= + PURGE(NINFOO); 87705000=14573000= + IF RELAD = 4095 THEN 87710000=14574000= + RELAD:= 0; 87715000=14574000= + NEXTTEXT:= NTEXTO; 87720000=14574500= + G:= PROGDESCBLDR(LDES-REAL(LEVEL = 1), RELAD, BLKAD) 87725000=14576000= + END; 87730000=14576000= + ENILSPOT:= 1023 & CARDNUMBER[10:20:28]; 87735000=14576100= + SEGMENT((L+3) DIV 4, SGNO, SGNOO); 87740000=14577000= + ENILPTR:= OLDENILPTR; 87745000=14593000= + LASTADDRESS:= OLDLASTADDRESS; 87750000=14593000= + MOVECODE(TENIL, ENIL); 87755000=14594000= + MOVECODE(TEDOC, EDOC); 87760000=14595000= + L:= LOLD; 87765000=14595000= + DOUBLE(SGNO, SGNOO, := , SGNOO, SGNO); 87770000=14596000= + IF NOT SOP AND LEVEL ^= 1 THEN 87775000=14598000= + BEGIN 87780000=14599000= + ADJUST; 87785000=14600000= + G:= PROGDESCBLDR(LDES, L, ADDRSF); 87790000=14601000= + IF ELCLASS = FACTOP THEN 87795000=14601100= + BEGIN 87800000=14601200= + COMMENT SPECIAL CASE FOR COBOL ONLY; 87805000=14601200= + STEPIT; 87810000=14601700= + END; 87815000=14601800= + END; 87820000=14602000= + IF JUMPCTR = LEVEL THEN 87825000=14603000= + JUMPCTR:= LEVEL-1; 87830000=14603000= + LEVEL:= LEVEL-1; 87835000=14604000= + FUNCTOG:= FUNCTOGO; 87840000=14605000= + AJUMP:= AJUMPO; 87845000=14606000= + GLOBALNINFOO:= OLDNINFOO; 87850000=14606100= + PRTI:= PRTIO; 87855000=14607000= + FIRSTX:= FIRSTXO; 87860000=14608000= + SAVEL:= SAVELO; 87865000=14609000= + STACKCTR:= STACKCTRO; 87870000=14610000= + SAVEPRTOG:= SAVEPRTOGO; 87875000=14610100= + NCII:= NCIIO; 87880000=14611000= + FAULTOG:= FAULTOGO AND (FALSE & FAULTLEVEL < LEVEL[46:47:1]); 87885000=14611000= + END; 87890000=14612000= + END BLOCK; 87895000=14613000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%87900000=14613000= + 87905000=15000000= + COMMENT THIS SECTION CONTAINS THE VARIABLE ROUTINE AND ITS SIDEKICKS; 87910000=15000000= + PROCEDURE CLSMPMN(ELBATWORD, TYPEDPROC); 87915000=15001000= + VALUE 87920000=15002000= + ELBATWORD, 87925000=15002000= + TYPEDPROC; 87930000=15002000= + REAL 87935000=15003000= + ELBATWORD; 87940000=15003000= + BOOLEAN 87945000=15003010= + TYPEDPROC; 87950000=15003010= + BEGIN 87955000=15004000= + COMMENT CALL SIMPLE MONITOR IS USED TO CALL PRINTI FOR 87960000=15004000= + SIMPLE VARIABLES. SEE THE MERRIMAC ROUTINE FOR A 87965000=15005000= + DESCRIPTION OF PRINTI; 87970000=15006000= + EMITPAIR(JUNK, SND); 87975000=15007000= + EMITO(MKS); 87980000=15007000= + EMITV(JUNK); 87985000=15007000= + EMITL(PASSTYPE(ELBATWORD)); 87990000=15008000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 87995000=15009000= + PASSALPHA(ELBATWORD); 88000000=15009000= + EMITPAIR(GNAT(CHARI), LOD); 88005000=15010000= + IF TYPEDPROC THEN 88010000=15010010= + PASSMONFILE(TAKE(GIT(ELBATWORD)).[27:11]) 88015000=15010010= + ELSE 88020000=15010010= + PASSMONFILE(TAKE(GIT(ELBATWORD)).SVARMONFILE); 88025000=15010020= + EMITNUM(1 & CARDNUMBER[1:4:44]); 88030000=15011000= + EMITV(GNAT(PRINTI)); 88035000=15012000= + END CLSMPMN; 88040000=15013000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%88045000=15013000= + INTEGER PROCEDURE PASSTYPE(ELBATWORD); 88050000=15014000= + VALUE 88055000=15015000= + ELBATWORD; 88060000=15015000= + REAL 88065000=15016000= + ELBATWORD; 88070000=15016000= + COMMENT PASSTYPE IS USED TO PASS THE TYPE OF VARIABLE BEING 88075000=15017000= + MONITORED TO PRINTI; 88080000=15018000= + PASSTYPE:= (ELBATWORD.CLASS-BOOPROCID) MOD 4; 88085000=15019000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%88090000=15019000= + PROCEDURE PASSALPHA(ELBATWORD); 88095000=15020000= + VALUE 88100000=15021000= + ELBATWORD; 88105000=15021000= + REAL 88110000=15022000= + ELBATWORD; 88115000=15022000= + BEGIN 88120000=15023000= + COMMENT PASSALPHA GENERATES CODE THAT PASSES THE ID 88125000=15023000= + PARAMETER TO PRINTI; 88130000=15024000= + DEFINE 88135000=15025000= + SIZEALPHA = RR9 #; 88140000=15025000= + COMMENT SIZEALPHA CONTAINS THE 88145000=15025000= + LENGTH OF THE ALPHA FOR THE 88150000=15026000= + VARIABLE DESCRIBED BY ELBATWORD; 88155000=15027000= + DEFINE 88160000=15028000= + INDEX = RR10 #; 88165000=15028000= + COMMENT INDEX CONTAINS THE INDEX 88170000=15028000= + INTO INFO FOR ID. INFO[INDEX] = ID; 88175000=15029000= + DEFINE 88180000=15030000= + LTEMP = RR11 #; 88185000=15030000= + COMMENT LTEMP IS A TEMP FOR L; 88190000=15030000= + EMITV(IF BOOLEAN(L.[46:1]) THEN CPLUS2 ELSE CPLUS1); 88195000=15033000= + LTEMP:= BUMPL; 88200000=15033000= + EMITWORD(GETALPHA( 88205000=15037000= + INFO[(INDEX:= ELBATWORD.LINK+1).LINKR, INDEX.LINKC], IF SIZEALPHA88210000=15037000= + := TAKE(INDEX).ALPHASIZE > 7 THEN 7 ELSE SIZEALPHA)); 88215000=15037000= + EMITB(BFW, LTEMP, L); 88220000=15037000= + END PASSALPHA; 88225000=15038000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%88230000=15038000= + COMMENT THE FOLLOWING BLOCK HANDLES THE FOLLOWING CASES 88235000=15039000= + OF SIMPLE VARIABLES: 88240000=15040000= + 1. V ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 88245000=15041000= + 2. V ~ EXP ,ALL V EXCEPT FORMAL-NAME. 88250000=15042000= + 3. V.[S:L] ~ EXP ,WHERE V IS FORMAL-CALL BY NAME. 88255000=15043000= + 4. V.[S:L] ~ EXP ,ALL V EXCEPT FORMAL-NAME. 88260000=15044000= + 5. V.[S:L] ,ALL V. 88265000=15045000= + 6. V ,ALL V. 88270000=15046000= + CODE EMITED FOR THE ABOVE CASES IS AS FOLLOWS: 88275000=15047000= + 1. VN,EXP,M*,XCH,~. 88280000=15048000= + 2. EXP,M*,VL,~. 88285000=15049000= + 3. VN,DUP,COC,EXP,T,M*,XCH,~. 88290000=15050000= + 4. VV,EXP,T,M*,VL,~. 88295000=15051000= + 5. ZEROL,VV,T . 88300000=15052000= + 6. VV . 88305000=15053000= + WHERE VN = DESC V 88310000=15054000= + EXP= ARITH, OR BOOLEAN EXPRESSION,AS REQUIRED. 88315000=15055000= + M* = CALL ON MONITOR ROUTINE,IF REQUIRED. 88320000=15056000= + VL = LITC V 88325000=15057000= + VV = OPDC V 88330000=15058000= + ~ = STORE INSTRUCTION(ISD,ISN,SND OR STD). 88335000=15059000= + T = BIT TRANSFER CODE(DIA,DIB,TRB). 88340000=15060000= + ZEROL = LITC 0 88345000=15061000= + DUP,COC,XCH = THE INSTRUCTIONS DUP,COC,AND XCH. 88350000=15062000= + OF COURSE, EXP WILL CAUSE RECURSION,IN GENERAL,AND THUS 88355000=15063000= + THE PARAMETER P1 AND THE LOCALS CAN NOT BE HANDLED IN A 88360000=15064000= + GLOBAL FASHION. 88365000=15065000= + THE PARAMETER P1 IS USED TO TELL THE VARIABLE ROUTINE 88370000=15066000= + WHO CALLED IT. SOME OF THE CODE GENERATION AND SOME 88375000=15067000= + SYNTAX CHECKS DEPEND UPON A PARTICULAR VALUE OF P1 . 88380000=15068000= + ; 88385000=15069000= + PROCEDURE VARIABLE(P1); 88390000=15070000= + REAL 88395000=15070000= + P1; 88400000=15070000= + BEGIN 88405000=15071000= + REAL 88410000=15072000= + TALL, COMMENT ELBAT WORD FOR VARIABLE; 88415000=15072000= + T1, COMMENT 1ST INTEGER OF PARTIAL WORD SYNTAX; 88420000=15073000= + T2, COMMENT 2ND INTEGER OF PARTIAL WORD SYNTAX; 88425000=15074000= + J; 88430000=15075000= + COMMENT SUBSCRIPT COUNTER ; 88435000=15075000= + REAL 88440000=15075500= + X, 88445000=15075500= + Z; 88450000=15075500= + REAL 88455000=15075550= + REMEMBERSEQNO; % REMEMBERS SEQUENCE NUMBER OF VARIABLE 88460000=15075550= + % ON LEFT HAND SIDE OF ASSIGNMENT SO WE 88465000=15075551= + % CAN XREF IT CORRECTLY. 88470000=15075552= + LABEL 88475000=15076000= + EXIT; 88480000=15076000= + TALL:= ELBAT[I]; 88485000=15077000= + IF ELCLASS <= INTPROCID THEN 88490000=15078000= + BEGIN 88495000=15079000= + IF TALL.LINK ^= PROINFO.LINK THEN 88500000=15080000= + BEGIN 88505000=15081000= + ERR(211); 88510000=15081000= + GO TO EXIT 88515000=15081000= + END; 88520000=15081000= + 88525000=15082000= +COMMENT 211 VARIABLE-FUNCTION IDENTIFIER USED OUTSIDE OF ITS SCOPE*; 88530000=15082000= + TALL:= TALL & (ELCLASS+4)[2:41:7] & 514[16:37:11]; 88535000=15083000= + END 88540000=15085000= + ELSE 88545000=15085000= + CHECKER(TALL); 88550000=15085000= + REMEMBERSEQNO:= CARDNUMBER IF TALL.CLASS <= INTID THEN 88555000=15086000= + BEGIN 88560000=15087000= + LABEL 88565000=15088000= + L1, 88570000=15088000= + EXIT; 88575000=15088000= + DEFINE 88580000=15089000= + FORMALNAME = [9:2] = 2 #; 88585000=15089000= + J:= ELCLASS; 88590000=15089010= + IF STEPI = ASSIGNOP THEN 88595000=15090000= + BEGIN 88600000=15091000= + STACKCT:= 1; 88605000=15091000= + XMARK(ASSIGNREF); % ASSIGNMENT TO SIMPLE VARIABLE. 88610000=15091100= + L1: IF TALL.FORMALNAME THEN 88615000=15092020= + BEGIN 88620000=15093000= + EMITN(TALL.ADDRESS); 88625000=15094000= + IF T1 ^= 0 THEN 88630000=15095000= + BEGIN 88635000=15095000= + EMITO(DUP); 88640000=15095000= + EMITO(COC) 88645000=15095000= + END; 88650000=15095000= + END 88655000=15097000= + ELSE 88660000=15097000= + IF T1 ^= 0 THEN 88665000=15097000= + EMITV(TALL.ADDRESS); 88670000=15098000= + STACKCT:= REAL(T1 ^= 0); 88675000=15098000= + STEPIT; 88680000=15098000= + IF TALL.CLASS = BOOID THEN 88685000=15099000= + BEXP 88690000=15099000= + ELSE 88695000=15099000= + AEXP; 88700000=15099000= + EMITD(48-T2, T1, T2); 88705000=15100000= + IF TALL < 0 THEN 88710000=15101000= + CLSMPMN(TALL, J >= BOOPROCID AND J <= INTPROCID); 88715000=15101000= + STACKCT:= 0; 88720000=15101500= + GT1:= 88725000=15102000= + IF TALL.CLASS = INTID THEN 88730000=15102000= + IF P1 = FS THEN 88735000=15103000= + ISD 88740000=15103000= + ELSE 88745000=15103000= + ISN 88750000=15103000= + ELSE 88755000=15103000= + IF P1 = FS THEN 88760000=15104000= + STD 88765000=15104000= + ELSE 88770000=15104000= + SND; 88775000=15104000= + IF TALL.FORMALNAME THEN 88780000=15105000= + BEGIN 88785000=15106000= + EMITO(XCH); 88790000=15106000= + EMITO(GT1) 88795000=15106000= + END 88800000=15107000= + ELSE 88805000=15107000= + EMITPAIR(TALL.ADDRESS, GT1); 88810000=15107000= + END 88815000=15110000= + ELSE 88820000=15110000= + BEGIN 88825000=15110000= + IF ELCLASS = PERIOD THEN 88830000=15111000= + BEGIN 88835000=15112000= + IF DOTSYNTAX(T1, T2) THEN 88840000=15112000= + GO TO EXIT; 88845000=15112000= + IF STEPI = ASSIGNOP THEN 88850000=15113000= + BEGIN 88855000=15113100= + IF P1 ^= FS THEN 88860000=15114000= + BEGIN 88865000=15115000= + ERR(201); % PARTIAL WORD NOT LEFT-MOST 88870000=15115100= + GO TO EXIT; 88875000=15115200= + END; 88880000=15115300= + XREFIT(TALL, REMEMBERSEQNO, ASSIGNREF); 88885000=15116000= + GO TO L1; 88890000=15116100= + END; 88895000=15116200= + END; 88900000=15118000= + IF P1 ^= FP THEN 88905000=15119000= + BEGIN 88910000=15119000= + ERR(202); 88915000=15119000= + GO TO EXIT 88920000=15119000= + END; 88925000=15119000= + 88930000=15120000= +COMMENT 202 VARIABLE- A VARIABLE APPEARS WHICH IS NOT FOLLOWED * 88935000=15120000= + BY A LEFT ARROW OR PERIOD *;88940000=15121000= + 88945000=15122000= +COMMENT 201 VARIABLE- A PARTIAL WORD DESIGNATOR IS NOT THE * 88950000=15122000= + LEFT-MOST OF A LEFT PART LIST *;88955000=15123000= + EMITI(TALL, T1, T2); 88960000=15124000= + END; 88965000=15126000= + EXIT: 88970000=15127000= + END OF BLOCK OF SIMPLE VARIABLES 88975000=15129000= + ELSE 88980000=15129000= + COMMENT THE FOLLOWING BLOCK HANDLES THESE CASES OF SUBSCRIPTED 88985000=15129000= + VARIABLES: 88990000=15130000= + 1. V[*] ,ROW DESIGNATOR FOR SINGLE-DIMENSION. 88995000=15131000= + 2. V[R,*] ,ROW DESIGNATOR FOR MULTI-DIMENSION. 89000000=15132000= + 3. V[R] ,ARRAY ELEMENT,NAME OR VALUE. 89005000=15133000= + 4. V[R].[S:L] ,PARTIAL WORD DESIGNATOR, VALUE. 89010000=15134000= + 5. V[R] ~ ,ASSIGNMENT TO ARRAY ELEMENT. 89015000=15135000= + 6. V[R].[S:L] ~ ,ASSIGNMENT TO PARTIAL WORD,LEFT-MOST. 89020000=15136000= + R IS A K-ORDER SUBSCRIPT LIST,I.E. R= R1,R2,...,RK. 89025000=15137000= + IN THE CASE OF NO MONITORING ON V, THE FOLLOWING CODE 89030000=15138000= + IS EMITTED FOR THE ABOVE CASES: 89035000=15139000= + 1. CASE #1 IS A SPECIAL CASE OF #2,NAMELY,SINGLE 89040000=15140000= + DIMENSION. THE CODE EMITTED IS: 89045000=15141000= + VL,LOD . 89050000=15142000= + EXECUTION: PLACES ARRAY DESCRIPTER IN REG A. 89055000=15143000= + 2. THIS CODE IS BASIC TO THE SUBSCRIPTION PROCESS.89060000=15144000= + EACH SUBSCRIPT GENERATES THE FOLLOWING SEQUENCE89065000=15145000= + OF CODE: 89070000=15146000= + AEXP,L*,IF FIRST SUBSCRIPT THEN VN ELSE CDC 89075000=15147000= + ,LOD. 89080000=15148000= + FOR A K-ORDER SUBSCRIPTION,K-1 SEQUENCE ARE 89085000=15149000= + PRODUCED. THE AEXP IN EACH SEQUENCE REFERS TO 89090000=15150000= + THE CODE PRODUCED BY THE ARITHMETIC EXPRESSION 89095000=15151000= + PROCEDURE FOR THE ACTUAL SUBSCRIPT EXPRESSIONS,89100000=15152000= + [* REFERS TO THE CODE PRODUCED FOR SUBTRACTING 89105000=15153000= + NON-ZERO LOWER BOUNDS FROM THE SUBSCRIPT 89110000=15154000= + EXPRESSION(L* YIELDS NO CODE FOR ZERO BOUNDS). 89115000=15155000= + EXECUTION: PLACES ARRAY ROW DESCRIPTOR IN REG A89120000=15156000= + . THE SPECIFIC ROW DEPENDS UPON THE 89125000=15157000= + VALUES OF THE K-1 SUBSCRIPTS. 89130000=15158000= + FOR THE REMAINING CASES, 89135000=15159000= + SEQUENCES OF CODE ARE EMITED AS IN CASE #2. 89140000=15160000= + HOWEVER,THE ACTUAL SEQUENCES ARE: 89145000=15161000= + ONE SEQUENCE ,(AEXP,L*),FOR THE 1ST SUBSCRIPT.89150000=15162000= + K-1 SEQUENCES,(IF FIRST SUBSCRIPT THEN VN 89155000=15163000= + ELSE CDC,LOD,AEXP,L*), FOR THE REMAINING 89160000=15164000= + SUBSCRIPTS,IF K>1. 89165000=15165000= + AT THIS POINT, CASES #3-6 ARE DIFFERENTIATED 89170000=15166000= + AND ADDITION CODE,PARTICULAR TO EACH CASE,IS 89175000=15167000= + EMITTED. 89180000=15168000= + 3. ADD THE SEQUENCE: 89185000=15169000= + IF FIRST SUBSCRIPT THEN VV ELSE COC. 89190000=15170000= + EXECUTION: THE ARRAY ELEMENT IS PUT IN REG A. 89195000=15171000= + 4. ADD THE SEQUENCE: 89200000=15172000= + IF FIRST SUBSCRIPT THEN VV ELSE COC,ZEROL. 89205000=15173000= + XCH,T. 89210000=15174000= + 5. ADD THE SEQUENCE: 89215000=15175000= + IF FIRST SUBSCRIPT THEN VN ELSE CDC,EXP, 89220000=15176000= + XCH,~. 89225000=15177000= + 6. ADD THE SEQUENCE: 89230000=15178000= + IF FIRST SUBSCRIPT THEN VN ELSE CDC,DUP,LOD. 89235000=15179000= + EXP,T, XCH,~. 89240000=15180000= + EXP,T,~,ZEROL,ETC. HAVE SAME MEANINGS AS DEFINED IN 89245000=15181000= + SIMPLE VARIABLE BLOCK. ; 89250000=15182000= + BEGIN 89255000=15183000= + LABEL 89260000=15184000= + EXIT, 89265000=15184000= + LAST, 89270000=15184000= + NEXT; 89275000=15184000= + INTEGER 89280000=15184100= + THENUMBEROFDECLAREDDIMENSIONS; 89285000=15184100= + DEFINE 89290000=15185000= + NODIM = RR1 #; 89295000=15185000= + COMMENT NODIM CONTAINS THE NUMBER OF89300000=15185000= + DIMENSIONS OF A MONITORED SUBSCRIPTED 89305000=15186000= + VARIABLE; 89310000=15187000= + DEFINE 89315000=15188000= + TESTVARB = RR2 #; 89320000=15188000= + COMMENT TESTVARB CONTAINS THE 89325000=15188000= + INDEX OF THE LAST ENTRY IN INFO 89330000=15189000= + FOR A MONITORED SUBSCRIPTED 89335000=15190000= + VARIABLE; 89340000=15191000= + DEFINE 89345000=15192000= + INC = RR3 #; 89350000=15192000= + COMMENT INC IS A COUNTER USED TO INDEX89355000=15192000= + INTO INFO TO PICK OUT SPECIAL MONITOR 89360000=15193000= + INFORMATION; 89365000=15194000= + DEFINE 89370000=15195000= + SPMON = [11:12] #; 89375000=15195000= + COMMENT SPMON DESIGNATES THE BIT89380000=15195000= + POSITION OF THE SPECIAL MONITOR 89385000=15196000= + INFORMATION FOR SUBSCRIPTED 89390000=15197000= + VARIABLES; 89395000=15198000= + DEFINE 89400000=15199000= + OPBIT = [11:1] #; 89405000=15199000= + COMMENT OPBIT TELLS WHETHER TO 89410000=15199000= + EMIT AN OPDC OR LITC FOR PASSING 89415000=15200000= + THE SUBSCRIPTS FOR MONITORED 89420000=15201000= + SUBSCRIPTED VARIABLES.1 MEANS 89425000=15202000= + LITC, 0 MEANS OPDC; 89430000=15203000= + DEFINE 89435000=15204000= + LWRBND = RR4 #; 89440000=15204000= + COMMENT LWRBND HOLDS THE LOWER 89445000=15204000= + BOUND WORD FROM INFO FOR MONITORED 89450000=15205000= + SUBSCRIPTED VARIABLES; 89455000=15206000= + DEFINE 89460000=15207000= + SPMONADR = [12:11] #; 89465000=15207000= + COMMENT SPMONADR CONTAINS 89470000=15207000= + THE ADDRESS THAT WILL BE 89475000=15208000= + EMITTED IN AN OPDC OR LITC 89480000=15209000= + DEPENDING ON OPBIT; 89485000=15210000= + BOOLEAN 89490000=15211000= + SPCLMON; 89495000=15211000= + COMMENT SPCLMON IS A BOOLEAN THAT89500000=15211000= + IS SET TRUE IF THE VARIABLE IN 89505000=15212000= + TALL IS SPECIAL MONITORED. 89510000=15213000= +; 89515000=15214000= + PROCEDURE M4(TALL, J); 89520000=15215000= + VALUE 89525000=15216000= + TALL, 89530000=15216000= + J; 89535000=15216000= + REAL 89540000=15217000= + TALL, 89545000=15217000= + J; 89550000=15217000= + BEGIN 89555000=15217500= + STACKCT:= 1; 89560000=15217500= + IF J = 1 THEN 89565000=15219000= + BEGIN 89570000=15219000= + COMMENT FIRST TIME AROUND; 89575000=15219000= + IF TALL < 0 THEN 89580000=15221000= + BEGIN 89585000=15221000= + COMMENT TALL IS MONITORED; 89590000=15221000= + EMITV(JUNK); 89595000=15222000= + EMITO(XCH); 89600000=15222000= + END; 89605000=15223000= + EMITN(TALL.ADDRESS) 89610000=15225000= + END 89615000=15226000= + ELSE 89620000=15226000= + BEGIN 89625000=15226000= + COMMENT NOT THE FIRST TIME AROUND; 89630000=15226000= + EMITO(CDC); 89635000=15227000= + IF TALL < 0 THEN 89640000=15229000= + BEGIN 89645000=15229000= + COMMENT CALL SUBSCRIPT; 89650000=15229000= + EMITV(JUNK); 89655000=15230000= + EMITO(XCH); 89660000=15230000= + END; 89665000=15231000= + END; 89670000=15232000= + END; 89675000=15232000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%89680000=15232000= + IF STEPI ^= LFTBRKET THEN 89685000=15233000= + BEGIN 89690000=15233000= + ERR(207); 89695000=15233000= + GO TO EXIT 89700000=15233000= + END; 89705000=15233000= + THENUMBEROFDECLAREDDIMENSIONS:= TAKE(GIT(TALL)).[40:8]; 89710000=15233100= + J:= 0; 89715000=15234000= + STACKCT:= 0; 89720000=15234500= + 89725000=15235000= +COMMENT 207 VARIABLE-MISSING LEFTBRACKET ON SUBSCRIPTED VARIABLE *; 89730000=15235000= + IF P1 > FP THEN 89735000=15236000= + TALL:= ABS(TALL) 89740000=15236000= + ELSE 89745000=15236000= + IF TALL < 0 THEN 89750000=15237000= + 89755000=15238000= +COMMENT **** MONITOR FUNCTION M1 GOES HERE ; 89760000=15238000= + BEGIN 89765000=15239000= + COMMENT THIS MAY BE A MONITORED SUBSCRIPTED 89770000=15239000= + VARIABLE; 89775000=15240000= + EMITO(MKS); 89780000=15241000= + IF SPCLMON:= TAKE(GIT(TALL)+1).SPMON ^= 0 THEN 89785000=15243000= + BEGIN 89790000=15243000= + COMMENT THIS IS SPECIAL MONITORED; 89795000=15243000= + TESTVARB:= (NODIM:= TAKE(INC:= GIT(TALL)).NODIMPART)+INC; 89800000=15245000= + DO 89805000=15246000= + IF BOOLEAN(LWRBND:= TAKE(INC:= INC+1)). OPBIT THEN 89810000=15248000= + EMITL(LWRBND, SPMONADR) 89815000=15249000= + ELSE 89820000=15249000= + EMITV(LWRBND, SPMONADR) 89825000=15250000= + UNTIL INC >= TESTVARB 89830000=15251000= + END; 89835000=15251000= + END; 89840000=15252000= + NEXT: 89845000=15253000= + IF STEPI = FACTOP THEN 89850000=15253000= + BEGIN 89855000=15254000= + STLB:= 1; 89860000=15254400= + WHILE TABLE(I+1) = COMMA DO 89865000=15254500= + BEGIN 89870000=15254600= + STEPIT; 89875000=15254600= + IF STEPI = FACTOP THEN 89880000=15254700= + STLB:= STLB+1 89885000=15254700= + ELSE 89890000=15254700= + BEGIN 89895000=15254800= + ERR(204); 89900000=15254800= + GO TO EXIT 89905000=15254800= + END; 89910000=15254800= + END; 89915000=15254900= + IF J+STLB ^= THENUMBEROFDECLAREDDIMENSIONS THEN 89920000=15255000= + BEGIN 89925000=15256000= + ERR(203); 89930000=15256000= + GO EXIT 89935000=15256000= + END; 89940000=15256000= + 89945000=15257000= +COMMENT 203 VARIABLE- THE NUMBER OF SUBSCRIPTS USED IN A ROW * 89950000=15257000= + ROW DESIGNATOR DOES NOT MATCH THE ARRAY * 89955000=15258000= + DECLARATION. *;89960000=15259000= + IF STEPI = RTBRKET THEN 89965000=15260000= + BEGIN 89970000=15261000= + ERR(204); 89975000=15261000= + GO EXIT 89980000=15261000= + END; 89985000=15261000= + 89990000=15262000= +COMMENT 204 VARIABLE- COMPILER EXPECTS A ] IN A ROW DESIGNATER *;89995000=15262000= + IF P1 ^= FA THEN 90000000=15262500= + IF STLB > 1 THEN 90005000=15262600= + FLAG(212) 90010000=15262600= + ELSE 90015000=15262600= + IF P1 ^= FI AND P1 ^= FL THEN 90020000=15263000= + IF P1 = FP AND REL THEN 90025000=15263050= + ELSE 90030000=15263100= + BEGIN 90035000=15263100= + ERR(205); 90040000=15263100= + GO TO EXIT; 90045000=15263100= + END; 90050000=15263100= + 90055000=15264000= +COMMENT 205 VARIABLE- A ROW DESIGNATER APPEARS OUTSIDE OF A FILL * 90060000=15264000= + STATEMENT OR ACTUAL PARAMETER LIST. *;90065000=15265000= + IF J = 0 THEN 90070000=15266000= + EMITPAIR(TALL.ADDRESS, LOD); 90075000=15267000= + 90080000=15268000= +COMMENT ***** MONITOR FUNCTION M2 GOES HERE ; 90085000=15268000= + IF TALL < 0 THEN 90090000=15269000= + BEGIN 90095000=15270000= + COMMENT DO NOT MONITOR AFTER ALL; 90100000=15270000= + EMITNUM(5 & CARDNUMBER[1:4:44]); 90105000=15271000= + EMITN(GNAT(PRINTI)); 90110000=15271100= + END; 90115000=15272000= + IF P1 = FA THEN 90120000=15272900= + FOR X:= 1 STEP 1 UNTIL STLB DO 90125000=15273000= + BEGIN 90130000=15273100= + IF(Z:= TAKE(GIT(TALL)+J+X)).[35:11] > 1023 THEN 90135000=15273200= + EMITV(Z) 90140000=15273200= + ELSE 90145000=15273200= + EMIT(Z); 90150000=15273200= + IF Z.[23:10] = ADD THEN 90155000=15273300= + EMITO(CHS); 90160000=15273300= + END; 90165000=15273400= + STEPIT; 90170000=15274000= + GO TO EXIT; 90175000=15275000= + END OF ROW DESIGNATOR PORTION; 90180000=15276000= + AEXP: 90185000=15278000= +COMMENT ***** MONITOR FUNCTION M3 GOES HERE ; 90190000=15278000= + 90195000=15279000= + IF TALL < 0 THEN 90200000=15279000= + EMITPAIR(JUNK, ISN); 90205000=15279000= + J:= J+1; 90210000=15280000= + IF (GT1:= TAKE(GIT(TALL)+J)).[35:13] ^= 0 THEN 90215000=15281000= + BEGIN 90220000=15282000= + IF GT1.[46:2] = 0 THEN 90225000=15283000= + EMIT(GT1) 90230000=15284000= + ELSE 90235000=15284000= + EMITV(GT1.[35:11]); 90240000=15284000= + EMIT(GT1.[23:12]); 90245000=15285000= + END OF LOWER BOUND ADJUSTMENT; 90250000=15286000= + IF ELCLASS = COMMA THEN 90255000=15287000= + BEGIN 90260000=15288000= + 90265000=15289000= +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 90270000=15289000= + M4(TALL, J); 90275000=15290000= + EMITO(LOD); 90280000=15291000= + IF J+1 > THENUMBEROFDECLAREDDIMENSIONS THEN 90285000=15291100= + BEGIN 90290000=15291200= + ERR(208); 90295000=15291200= + GO TO EXIT 90300000=15291200= + END; 90305000=15291200= + 90310000=15291300= + COMMENT 208 VARIABLE- NUMBER OF SUBSCRIPTS DOES NOT MATCH ARRAY * 90315000=15291300= + DECLARATION *;90320000=15291400= + GO TO NEXT; 90325000=15292000= + END OF SUBSCRIPT COMMA HANDLER; 90330000=15293000= + IF ELCLASS ^= RTBRKET THEN 90335000=15294000= + BEGIN 90340000=15294000= + ERR(206); 90345000=15294000= + GO EXIT 90350000=15294000= + END; 90355000=15294000= + 90360000=15295000= +COMMENT 206 VARIABLE- MISSING RIGHT BRACKET ON SUBSCRIPTED VARIABLE*; 90365000=15295000= + IF J ^= THENUMBEROFDECLAREDDIMENSIONS THEN 90370000=15296000= + BEGIN 90375000=15297000= + ERR(208); 90380000=15297000= + GO TO EXIT 90385000=15297000= + END; 90390000=15297000= + STACKCT:= 0; 90395000=15299500= + IF STEPI = ASSIGNOP THEN 90400000=15300000= + BEGIN 90405000=15301000= + XREFIT(TALL, REMEMBERSEQNO, ASSIGNREF); % ASSIGNMENT TO90410000=15301100= + % SUBSCRIPTED VARIABLE. 90415000=15301200= + 90420000=15302000= +COMMENT ***** MONITOR FUNCTION M4 GOES HERE ; 90425000=15302000= + LAST: 90430000=15303000= + M4(TALL, J); 90435000=15303000= + IF T1 = 0 THEN 90440000=15304000= + BEGIN 90445000=15305000= + IF P1 = FR THEN 90450000=15305000= + GO TO EXIT 90455000=15306000= + END 90460000=15306000= + ELSE 90465000=15306000= + BEGIN 90470000=15306000= + EMITO(DUP); 90475000=15306000= + EMITO(COC) 90480000=15306000= + END; 90485000=15306000= + STEPIT; 90490000=15306000= + IF TALL.CLASS = BOOARRAYID THEN 90495000=15307000= + BEXP 90500000=15307000= + ELSE 90505000=15307000= + AEXP; 90510000=15307000= + EMITD(48-T2, T1, T2); 90515000=15308000= + EMITO(XCH); 90520000=15309000= + 90525000=15310000= +COMMENT ***** MONITOR FUNCTION M6 GOES BEFORE EMITO(XCH); 90530000=15310000= + IF TALL < 0 THEN 90535000=15312000= + BEGIN 90540000=15312000= + COMMENT STORE THE VALUE OF THE EXPRESSION 90545000=15312000= + IN JUNK AND CALL PRINTI, THEN RECALL THE 90550000=15313000= + VALUE FROM JUNK; 90555000=15314000= + EMITO(IF TALL.CLASS = INTARRAYID THEN ISN ELSE SND); 90560000=15318000= + IF P1 ^= FS THEN 90565000=15320000= + EMITPAIR(JUNK, SND); 90570000=15320000= + EMITL(J); 90575000=15321000= + EMITL(PASSTYPE(TALL)); 90580000=15321000= + EMITPAIR(GNAT(POWERSOFTEN), LOD); 90585000=15322000= + PASSALPHA(TALL); 90590000=15323000= + EMITPAIR(GNAT(CHARI), LOD); 90595000=15324000= + PASSMONFILE(TAKE(GIT(TALL)).ARRAYMONFILE); 90600000=15325000= + EMITNUM((IF SPCLMON THEN 3 ELSE 2) & CARDNUMBER[1:4:44]); 90605000=15327000= + EMITV(GNAT(PRINTI)); 90610000=15328000= + IF P1 ^= FS THEN 90615000=15330000= + EMITV(JUNK); 90620000=15330000= + P1:= 0; 90625000=15331000= + GO TO EXIT; 90630000=15331000= + END; 90635000=15332000= + EMITO(IF TALL.CLASS = INTARRAYID THEN IF P1 = FS THEN ISD 90640000=15335000= + ELSE ISN ELSE IF P1 = FS THEN STD ELSE SND); 90645000=15335000= + P1:= 0; 90650000=15336000= + GO TO EXIT; 90655000=15337000= + END OF ASSIGNMENT STATEMENT SUBSCRIPTED VARIABLES; 90660000=15338000= + IF ELCLASS = PERIOD THEN 90665000=15339000= + BEGIN 90670000=15340000= + IF DOTSYNTAX(T1, T2) THEN 90675000=15341000= + GO TO EXIT; 90680000=15341000= + IF STEPI = ASSIGNOP THEN 90685000=15342000= + IF P1 = FS THEN % PARTIAL WORD IS LEFT-MOST 90690000=15342100= + BEGIN 90695000=15342200= + XREFIT(TALL, REMEMBERSEQNO, ASSIGNREF); % PARTIAL90700000=15342300= + % WORD ASSIGNMENT TO SUBSCR. VAR. 90705000=15342400= + GO TO LAST; 90710000=15342500= + END 90715000=15343000= + ELSE 90720000=15343000= + BEGIN 90725000=15343000= + ERR(209); 90730000=15343000= + GO EXIT 90735000=15343000= + END; 90740000=15343000= + IF J = 1 THEN 90745000=15344000= + EMITV(TALL.ADDRESS) 90750000=15344000= + ELSE 90755000=15344000= + EMITO(COC); 90760000=15344000= + END 90765000=15347000= + ELSE 90770000=15347000= + 90775000=15347000= +COMMENT ***** MONITOR FUNCTION M10 GOES HERE ; 90780000=15347000= + BEGIN 90785000=15348000= + COMMENT MONITOR FUNCTION M10; 90790000=15348000= + SPCLMON:= P1 = FP OR ELCLASS >= AMPERSAND; 90795000=15349000= + IF J = 1 THEN 90800000=15351000= + IF SPCLMON THEN 90805000=15352000= + EMITV(TALL.ADDRESS) 90810000=15353000= + ELSE 90815000=15353000= + EMITN(TALL.ADDRESS) 90820000=15354000= + ELSE 90825000=15354000= + EMITO(IF SPCLMON THEN COC ELSE CDC); 90830000=15356000= + IF TALL < 0 THEN 90835000=15358000= + BEGIN 90840000=15358000= + COMMENT DO NOT MONITOR AFTER ALL; 90845000=15358000= + EMITNUM(5 & CARDNUMBER[1:4:44]); 90850000=15359000= + IF SPCLMON THEN 90855000=15361000= + EMITV(GNAT(PRINTI)) 90860000=15362000= + ELSE 90865000=15362000= + EMITN(GNAT(PRINTI)) 90870000=15363000= + END; 90875000=15363000= + IF P1 = FS THEN 90880000=15364000= + ERR(210); 90885000=15364000= + IF P1 = FI THEN 90890000=15364500= + P1:= 0; 90895000=15364500= + GO TO EXIT; 90900000=15365000= + END; 90905000=15366000= + IF P1 = FS THEN 90910000=15367000= + BEGIN 90915000=15367000= + ERR(210); 90920000=15367000= + GO TO EXIT 90925000=15367000= + END; 90930000=15367000= + 90935000=15368000= +COMMENT 210 VARIABLE-MISSING LEFT ARROW OR PERIOD. *;90940000=15368000= + IF T1 ^= 0 THEN 90945000=15369000= + BEGIN 90950000=15369000= + EMITI(0, T1, T2); 90955000=15369000= + IF P1 ^= FI THEN 90960000=15369100= + P1:= 0; 90965000=15369100= + END; 90970000=15369200= + IF P1 = FI THEN 90975000=15369300= + IF ELCLASS ^= COMMA AND ELCLASS ^= RTPAREN THEN 90980000=15369500= + SIMPARITH; 90985000=15369500= + IF P1 = FI THEN 90990000=15369600= + P1:= 0; % 90995000=15369600= + 91000000=15371000= +COMMENT ***** MONITOR FUNCTION M9 ; 91005000=15371000= + IF TALL < 0 THEN 91010000=15373000= + BEGIN 91015000=15373000= + COMMENT MONITOR FUNCTION M9; 91020000=15373000= + EMITNUM(5 & CARDNUMBER[1:4:44]); 91025000=15374000= + EMITV(GNAT(PRINTI)); 91030000=15374100= + END; 91035000=15375000= + EXIT: 91040000=15376000= + STACKCT:= 0 91045000=15376000= + END OF SUBSCRIPTED BLOCK; 91050000=15376000= +EXIT: 91055000=15377000= + END OF THE VARIABLE ROUTINE; 91060000=15377000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%91065000=15377000= + 91070000=16000000= +COMMENT THIS SECTION GENERATES CODE FOR STREAM PROCEDURES; 91075000=16000000= + PROCEDURE STREAMSTMT; 91080000=16001000= + BEGIN 91085000=16002000= + DEFINE 91090000=16003000= + LFTPAREN = LEFTPAREN #, 91095000=16003000= + LOC = [36:12] #, 91100000=16003000= + LASTGT = [24:12] #, 91105000=16004000= + LOCFLD = 36:36:12 #, 91110000=16004000= + LGTFLD = 24:24:12 #; 91115000=16004000= + DEFINE 91120000=16005000= + LEVEL = LVL #, 91125000=16005000= + ADDOP = ADOP #; 91130000=16005000= + DEFINE 91135000=16007000= + JFW = 39 #, 91140000=16007000= + COMMENT 7.5.5.1 JUMP FORWARD UNCONDITIONAL ; 91145000=16007000= + RCA = 40 #, 91150000=16008000= + COMMENT 7.5.7.6 RECALL CONTROL ADDRESS ; 91155000=16008000= + JRV = 47 #, 91160000=16009000= + COMMENT 7.5.5.2 JUMP REVERSE UNCONDITIONAL ; 91165000=16009000= + CRF = 35 #, 91170000=16010000= + COMMENT 7.5.10.6 CALL REPEAT FIELD ; 91175000=16010000= + BNS = 42 #, 91180000=16011000= + COMMENT 7.5.5.5 BEGIN LOOP ; 91185000=16011000= + NOP = 1 #, 91190000=16012000= + COMMENT ; 91195000=16012000= + ENS = 41 #, 91200000=16013000= + COMMENT 7.5.5.6 END LOOP ; 91205000=16013000= + TAN = 30 #, 91210000=16014000= + COMMENT 7.5.3.7 TEST FOR ALPHAMERIC ; 91215000=16014000= + BIT = 31 #, 91220000=16015000= + COMMENT 7.5.3.8 TEST BIT ; 91225000=16015000= + JFC = 37 #, 91230000=16016000= + COMMENT 7.5.5.3 JUMP FORWARD CONDITIONAL ; 91235000=16016000= + SFD = 06 #, 91240000=16017000= + COMMENT 7.5.7.8 SET DESTINATION ADDRESS ; 91245000=16017000= + RSA = 43 #, 91250000=16018000= + COMMENT 7.5.7.4 RECALL SOURCE ADDRESS ; 91255000=16018000= + TRP = 60 #, 91260000=16019000= + COMMENT 7.5.2.2 TRANSFER PROGRAM CHARACTERS ; 91265000=16019000= + BSS = 3 #, 91270000=16020000= + COMMENT 7.5.6.6 SKIP SOURCE BIT ; 91275000=16020000= + BSD = 2 #, 91280000=16021000= + COMMENT 7.5.6.5 SKIP DESTINATION BITS ; 91285000=16021000= + SEC = 34 #, 91290000=16022000= + COMMENT 7.5.10.1 SET COUNT ; 91295000=16022000= + JNS = 38 #; 91300000=16023000= + COMMENT 7.5.5.7 JUMP OUT LOOP ; 91305000=16023000= + 91310000=16024000= + COMMENT FIXC EMITS BASICLY FORWARD JUMPS. HOWEVER IN THE CASE 91315000=16024000= + OF INSTRUCTIONS INTERPTED AS JUMPS BECAUSE OF A CRF ON 91320000=16025000= + A VALUE = 0 AND THE JUMP } 64 SYLLABLES A JFW 1 AND 91325000=16026000= + A RCA L (L IS STACK ADDRESS OF A PSEUDO LABEL WHICH 91330000=16027000= + MUST ALSO BE MANUFACTURED) IS EMITTED. ; 91335000=16028000= + PROCEDURE FIXC(S); 91340000=16029000= + VALUE 91345000=16029000= + S; 91350000=16029000= + REAL 91355000=16029000= + S; 91360000=16029000= + BEGIN 91365000=16030000= + REAL 91370000=16031000= + SAVL, 91375000=16031000= + D, 91380000=16031000= + F; 91385000=16031000= + SAVL:= L; 91390000=16032000= + F:= GET(S); 91395000=16033000= + IF D:= L-(L:= S)-1 <= 63 THEN 91400000=16034000= + BEGIN 91405000=16035000= + IF F = BNS THEN 91410000=16036000= + BEGIN 91415000=16037000= + S:= GET(L:= L-1); 91420000=16038000= + EMIT(NOP); 91425000=16038000= + EMIT(NOP); 91430000=16038000= + EMIT(S); 91435000=16038000= + D:= D-2; 91440000=16038000= + END; 91445000=16039000= + EMITC(D, F); 91450000=16040000= + L:= SAVL 91455000=16041000= + END 91460000=16042000= + ELSE 91465000=16042000= + BEGIN 91470000=16042000= + IF F ^= JFW THEN 91475000=16043000= + BEGIN 91480000=16043000= + EMITC(1, F); 91485000=16044000= + EMITC(1, JFW) 91490000=16045000= + END; 91495000=16045000= + EMITC(PJ:= PJ+1, RCA); 91500000=16046000= + L:= SAVL; 91505000=16047000= + ADJUST; 91510000=16048000= + LPRT:= PROGDESCBLDR(2, L, 0); 91515000=16049000= + COMMENT NOW ENTER PSEUDO LABEL INTO INFO WITH ADDRESS=PJ-1; 91520000=16050000= + PUTNBUMP(0 & (STLABID*2+1)[2:40:8] & PJ[16:37:11] & 2[27:40:8]);91525000=16052000= + PUTNBUMP(0 & (NEXTINFO-LASTINFO-1)[4:40:8]); 91530000=16053000= + PUTNBUMP(0); 91535000=16054000= + LASTINFO:= NEXTINFO-3; 91540000=16055000= + END; 91545000=16056000= + END FIXC; 91550000=16057000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%91555000=16057000= + COMMENT EMITJUMP IS CALLED BY GOTOS AND JUMPCHAIN. 91560000=16058000= + THIS ROUTINE WILL EMIT A JUMP IF THE DISTANCE IS { 63 91565000=16059000= + SYLLABLES ,OTHERWISE, IT GETS A PRT CELL AND STUFFS THE 91570000=16060000= + STACK ADDRESS INTO THE LABEL ENTRY IN INFO AND EMITS AN 91575000=16061000= + RCA ON THIS STACK CELL. AT EXECUTION TIME ACTUAL PARAPART 91580000=16062000= + INSURES US THAT THIS CELL WILL CONATIN A LABEL DESCRIPTOR 91585000=16063000= + POINTING TO OUR LABEL IN QUESTION. ; 91590000=16064000= + PROCEDURE EMITJUMP(E); 91595000=16065000= + VALUE 91600000=16065000= + E; 91605000=16065000= + REAL 91610000=16065000= + E; 91615000=16065000= + BEGIN 91620000=16066000= + REAL 91625000=16067000= + T, 91630000=16067000= + D; 91635000=16067000= + REAL 91640000=16068000= + ADDR; 91645000=16068000= + IF ABS(D:= (T:= TAKE(GIT(E)).LOC)-L-1) >= 64 THEN 91650000=16070000= + BEGIN 91655000=16071000= + IF ADDR:= TAKE(E).ADDRESS = 0 THEN 91660000=16072000= + BEGIN 91665000=16073000= + PUT(TAKE(E) & (ADDR:= PJ:= PJ+1)[16:37:11], E); 91670000=16074000= + LPRT:= PROGDESCBLDR(2, T, 0); 91675000=16075000= + END; 91680000=16076000= + EMITC(ADDR, RCA); 91685000=16077000= + END 91690000=16079000= + ELSE 91695000=16079000= + EMITC(D, IF D < 0 THEN JRV ELSE JFW); 91700000=16079000= + END EMIT JUMP; 91705000=16080000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%91710000=16080000= + COMMENT WHEN JUMPCHAIN IS CALLED THERE IS A LINKEDLIST IN THE CODE91715000=16081000= + ARRAY WHERE JFWS MUST BE PLACED. THE 1ST LINK IS POINTED 91720000=16082000= + TO BY THE LOC FIELD OF EACH LABEL ENTRY IN INFO. THE LAST 91725000=16083000= + LINK IS = 4096. ; 91730000=16084000= + PROCEDURE JUMPCHAIN(E); 91735000=16085000= + VALUE 91740000=16085000= + E; 91745000=16085000= + REAL 91750000=16085000= + E; 91755000=16085000= + BEGIN 91760000=16086000= + REAL 91765000=16087000= + SAVL, 91770000=16087000= + LINK; 91775000=16087000= + SAVL:= L; 91780000=16088000= + L:= TAKE(GIT(E)).LASTGT; 91785000=16089000= + WHILE L ^= 4095 DO 91790000=16090000= + BEGIN 91795000=16091000= + LINK:= GET(L); 91800000=16092000= + EMITJUMP(E); 91805000=16093000= + L:= LINK 91810000=16095000= + END; 91815000=16095000= + L:= SAVL; 91820000=16096000= + END JUMPCHAIN; 91825000=16097000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%91830000=16097000= + COMMENT NESTS COMPILES THE NEST STATEMENT. 91835000=16098000= + A VARIABLE NEST INDEX CAUSES THE CODE, 91840000=16099000= + CRF V, BNS 0 ,NOP,NOP, TO BE GENERATED INITIALLY. 91845000=16100000= + AT THE RIGHT PAREN THE BNS IS FIXED WITH THE LENGTH OF 91850000=16101000= + THE NEST (NUMBER OF SYLLABLES) IF THE LENGTH{63,OTHERWISE 91855000=16102000= + IT IS FIXED WITH A 1 AND THE NOPS REPLACED WITH JFW 1, 91860000=16103000= + RCA P. THIS IS DONE BECAUSE THE VALUE OF V AT EXECUTION 91865000=16104000= + MAY = 0 AND THIS CODE CAUSES A JUMP AROUND THE NEST. 91870000=16105000= + JUMPOUT INFO IS REMEMBERED IN A RECURSIVE CELL AND 91875000=16106000= + NEST LEVEL INCREASED BY ONE. 91880000=16107000= + WHEN THE RIGHT PAREN IS REACHED,(IF THE STATEMENTS IN 91885000=16108000= + THE NEST COMPILED), JOINFO IS CHECKED FOR THE EXISTANCE 91890000=16109000= + OF JUMPOUT STATEMENTS IN THE NEST,IF SO,THE THE JUMPS 91895000=16110000= + ARE FIXED BY FAKING TOTOS INTO COMPILING THE REQUIRED 91900000=16111000= + JUMPS. 91905000=16112000= + FINALLY THE BNS IS FIXED,IF REQUIRED,AND NEST LEVEL 91910000=16113000= + AND JOINFO RESOTRED TO THEIR ORIGINAL VALUES. ; 91915000=16114000= + PROCEDURE NESTS; 91920000=16115000= + BEGIN 91925000=16116000= + LABEL 91930000=16117000= + EXIT; 91935000=16117000= + REAL 91940000=16118000= + JOINT, 91945000=16118000= + BNSFIX; 91950000=16118000= + IF ELCLASS ^= LITNO THEN 91955000=16119000= + BEGIN 91960000=16120000= + EMITC(ELBAT[I].ADDRESS, CRF); 91965000=16121000= + BNSFIX:= L; 91970000=16121000= + EMIT(BNS); 91975000=16122000= + EMIT(NOP); 91980000=16122000= + EMIT(NOP); 91985000=16122000= + END 91990000=16124000= + ELSE 91995000=16124000= + EMITC(ELBAT[I].ADDRESS, BNS); 92000000=16124000= + IF STEPI ^= LFTPAREN THEN 92005000=16125000= + BEGIN 92010000=16125000= + ERR(262); 92015000=16125000= + GO TO EXIT 92020000=16125000= + END; 92025000=16125000= + NESTLEVEL:= NESTLEVEL+1; 92030000=16126000= + JOINT:= JOINFO; 92035000=16127000= + JOINFO:= 0; 92040000=16128000= + DO BEGIN 92045000=16129000= + STEPIT; 92050000=16130000= + ERRORTOG:= TRUE; 92055000=16130000= + STREAMSTMT 92060000=16131000= + END 92065000=16131000= + UNTIL ELCLASS ^= SEMICOLON; 92070000=16131000= + IF ELCLASS ^= RTPAREN THEN 92075000=16132000= + BEGIN 92080000=16132000= + ERR(262); 92085000=16132000= + GO TO EXIT 92090000=16132000= + END; 92095000=16132000= + EMIT(ENS); 92100000=16133000= + IF JOINFO ^= 0 THEN 92105000=16134000= + BEGIN 92110000=16135000= + COMMENT PREPARE TO CALL JUMPCHAIN FORJUMPOUTS; 92115000=16136000= + ADJUST; 92120000=16137000= + PUT(TAKE(GIT(JOINFO)) & L[LOCFLD], GIT(JOINFO)); 92125000=16138000= + JUMPCHAIN(TAKE(JOINFO) & JOINFO[35:35:13]); 92130000=16139000= + END; 92135000=16140000= + IF BNSFIX ^= 0 THEN 92140000=16141000= + FIXC(BNSFIX); 92145000=16141000= + NESTLEVEL:= NESTLEVEL-1; 92150000=16142000= + JOINFO:= JOINT; 92155000=16143000= + EXIT: 92160000=16144000= + END NESTS; 92165000=16144000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%92170000=16144000= + COMMENT LABELS HANDLES STREAM LABELS. 92175000=16145000= + ALL LABELS ARE ADJUSTED TO THE BEGINING OF THE NEXT 92180000=16146000= + WORD (IN THE PROGRAMSTREAM). 92185000=16147000= + IF A GO TO HAS NOT BEEN ENCOUNTERED BEFORE THE LABEL 92190000=16148000= + THEN THE NEST LEVEL FIELD IS ENTERED AND THE DEFINED BIT, 92195000=16149000= + [1:1], SET TO ONE. FOR DEFINED LABELS,IF WHERE A GO TO 92200000=16150000= + HAS APPEARED, A CHECK IS MADE THAT THE CURRENT NEST LEVEL 92205000=16151000= + MATCHES THE LEVEL OF THE LABEL. 92210000=16152000= + MULTIPLE OCCURANCES ARE ALSO CHECKED FOR AND FLAGGED. 92215000=16153000= + FINALLY,JUMPCHAIN IS CALLED TO FIX UP ANY FORWARD GO TOS 92220000=16154000= + AND GET A PRT LOCATION FOR ANY JUMPS }64 SYLLABLES. ; 92225000=16155000= + PROCEDURE LABELS; 92230000=16156000= + BEGIN 92235000=16157000= + ADJUST; 92240000=16158000= + GT1:= ELBAT[I]; 92245000=16159000= + XMARK(LBLREF); % MARK LABEL OCCURENCE FOR XREF 92250000=16159100= + IF STEPI ^= COLON THEN 92255000=16160000= + ERR(258) 92260000=16161000= + ELSE 92265000=16161000= + BEGIN 92270000=16162000= + IF TAKE(GT2:= GIT(GT1)).LOC ^= 0 THEN 92275000=16163000= + FLAG(259) 92280000=16163000= + ELSE 92285000=16163000= + IF GT1 > 0 THEN 92290000=16164000= + BEGIN 92295000=16165000= + PUT(-(TAKE(GT1) & NESTLEVEL[11:43:5]), GT1); 92300000=16166000= + PUT(-L, GT2) 92305000=16168000= + END 92310000=16170000= + ELSE 92315000=16170000= + BEGIN 92320000=16170000= + IF GT1.LEVEL ^= NESTLEVEL THEN 92325000=16171000= + FLAG(257); 92330000=16171000= + PUT((-L) & TAKE(GT2)[LGTFLD], GT2); 92335000=16172000= + JUMPCHAIN(GT1); 92340000=16173000= + END; 92345000=16174000= + END; 92350000=16176000= + STEPIT; 92355000=16176000= + END LABELS; 92360000=16177000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%92365000=16177000= + COMMENT IFS COMPILES IF STATEMENTS. 92370000=16178000= + FIRST THE TEST IS COMPILED. NOTE THAT IN THE 92375000=16179000= + CONSTRUCTS "SC RELOP DC" AND "SC RELOP STRING" THAT 92380000=16180000= + THE SYLLABLE EMITTED IS FETCHED FROM ONE OF TWO FIELDS 92385000=16181000= + IN THE ELBAT WORD FOR THE RELATIONAL OPERATOR, OTHERWISE 92390000=16182000= + THE CODE IS EMITTED STRAIGHTAWAY. 92395000=16183000= + A TEST IS MADE TO SEE WHETHER THE STATEMENT AFTER THE 92400000=16184000= + "THEN" COULD POSSIBLY BE LONGER THAN 63 SYLLABLES,AND IF 92405000=16185000= + SO, Z NOPS ARE EMITTED FOR FIXC IN CASE A RCA WILL HAVE 92410000=16186000= + TO BE GENERATED. 92415000=16187000= + THIS PROCEDURE DOES NO OPTIMAZATION IN THE CASES 92420000=16188000= + IF THEN GO TO L,IF THEN STATEMENT ELSE GO TO L, OR 92425000=16189000= + IF THEN GO TO L1 ELSE GO TO L2 ; 92430000=16190000= + PROCEDURE IFS; 92435000=16191000= + BEGIN 92440000=16191000= + DEFINE 92445000=16192000= + COMPARECODE = [42:6] #, 92450000=16192000= + TESTCODE = [36:6] #, 92455000=16192000= + EQUALV = 48 #; 92460000=16192000= + LABEL 92465000=16193000= + IFSB, 92470000=16193000= + IFTOG, 92475000=16193000= + IFSC, 92480000=16193000= + EXIT; 92485000=16193000= + SWITCH 92490000=16194000= + IFSW:= IFSB, 92495000=16194000= + IFTOG, 92500000=16194000= + IFSC; 92505000=16194000= + REAL 92510000=16195000= + ADDR, 92515000=16195000= + FIX1, 92520000=16195000= + FIX2; 92525000=16195000= + ADDR:= 1; 92530000=16196000= + GO TO IFSW[STEPI-SBV+1]; 92535000=16197000= + IF ELCLASS = LOCLID THEN 92540000=16198000= + BEGIN 92545000=16199000= + EMITC(ELBAT[I].ADDRESS, CRF); 92550000=16200000= + ADDR:= 0; 92555000=16201000= + END 92560000=16204000= + ELSE 92565000=16204000= + IF ELCLASS = LITNO THEN 92570000=16204000= + ADDR:= ELBAT[I].ADDRESS 92575000=16205000= + ELSE 92580000=16205000= + BEGIN 92585000=16205000= + ERR(250); 92590000=16205000= + GO TO EXIT 92595000=16205000= + END; 92600000=16205000= + IF STEPI ^= SCV THEN 92605000=16206000= + BEGIN 92610000=16206000= + ERR(263); 92615000=16206000= + GO TO EXIT 92620000=16206000= + END; 92625000=16206000= + IFSC: 92630000=16208000= + IF STEPI ^= RELOP THEN 92635000=16208000= + BEGIN 92640000=16208000= + ERR(264); 92645000=16208000= + GO EXIT 92650000=16208000= + END; 92655000=16208000= + IF STEPI = DCV THEN 92660000=16209000= + EMITC(ADDR, ELBAT[I-1], COMPARECODE) 92665000=16210000= + ELSE 92670000=16210000= + IF ELCLASS = STRNGCON THEN 92675000=16210000= + BEGIN 92680000=16211000= + IF ACCUM[1].[12:6] ^= 1 OR ELBAT[I-3].CLASS ^= IFV THEN 92685000=16211100= + BEGIN 92690000=16211200= + ERR(271); 92695000=16211200= + GO EXIT 92700000=16211200= + END 92705000=16211300= + ELSE 92710000=16211300= + EMITC(ACCUM[1].[18:6], ELBAT[I-1].TESTCODE) 92715000=16211400= + END 92720000=16212000= + ELSE 92725000=16212000= + IF ELCLASS = LOCLID THEN 92730000=16212000= + BEGIN 92735000=16212100= + IF ELBAT[I-3].CLASS ^= IFV THEN 92740000=16212200= + BEGIN 92745000=16212300= + ERR(271); 92750000=16212300= + GO EXIT 92755000=16212300= + END 92760000=16212400= + ELSE 92765000=16212400= + BEGIN 92770000=16212400= + EMITC(0, ELBAT[I-1].TESTCODE); % RESET TFFF. 92775000=16212500= + EMITC(ELBAT[I].ADDRESS, CRF); 92780000=16212600= + EMITC(0, ELBAT[I-1].TESTCODE); % COMPARE. 92785000=16212700= + END 92790000=16213000= + END 92795000=16213000= + ELSE 92800000=16213000= + IF ACCUM[1] ^= 6"5ALPHA" THEN 92805000=16213000= + BEGIN 92810000=16213100= + ERR(265); 92815000=16213100= + GO EXIT 92820000=16213100= + END 92825000=16214000= + ELSE 92830000=16214000= + IF ELBAT[I-1].COMPARECODE = EQUALV THEN 92835000=16214000= + EMITC(17, TAN) 92840000=16214100= + ELSE 92845000=16214100= + BEGIN 92850000=16214100= + FLAG(270); 92855000=16214100= + ERRORTOG:= TRUE 92860000=16214100= + END; 92865000=16214100= + GO IFTOG; 92870000=16215000= + IFSB: 92875000=16216000= + EMITC(1, BIT); 92880000=16216000= + IFTOG: 92885000=16217000= + IF STEPI ^= THENV THEN 92890000=16217000= + BEGIN 92895000=16217000= + ERR(266); 92900000=16217000= + GO EXIT 92905000=16217000= + END; 92910000=16217000= + FIX1:= L; 92915000=16218000= + EMIT(JFC); 92920000=16219000= + STEPIT; 92925000=16220000= + IF ELCLASS = BEGINV OR ELCLASS = IFV OR ELCLASS = LITNO OR ELCLASS92930000=16224000= + = STLABID OR ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN 92935000=16225000= + THEN 92940000=16225000= + BEGIN 92945000=16226000= + EMIT(NOP); 92950000=16227000= + EMIT(NOP) 92955000=16228000= + END; 92960000=16228000= + IF ELCLASS = ELSEV THEN 92965000=16228500= + ELSE 92970000=16229000= + STREAMSTMT; 92975000=16229000= + IF ELCLASS = ELSEV THEN 92980000=16230000= + BEGIN 92985000=16231000= + FIX2:= L; 92990000=16232000= + EMIT(JFW); 92995000=16232000= + FIXC(FIX1); 93000000=16233000= + STEPIT; 93005000=16234000= + STREAMSTMT; 93010000=16235000= + FIXC(FIX2); 93015000=16236000= + END 93020000=16238000= + ELSE 93025000=16238000= + FIXC(FIX1); 93030000=16238000= + EXIT: 93035000=16239000= + END IFS; 93040000=16239000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%93045000=16239000= + COMMENT GOTOS HANDLES GO TO AND THE LAST PART OF JUMP OUT TO 93050000=16240000= + STATEMENTS. 93055000=16241000= + IF THE LABEL HAS BEEN ENCOUNTERED THEN EMITJUMP IS CALLED 93060000=16242000= + AN PRODUCES A JRV OR RCA IN THE CASE OF JUMPS}64 SYLLABL 93065000=16243000= + ES. OTHERWISE, A LINK IS EMITTED POINTING ANY PREVIOUS 93070000=16244000= + GO TOS IN THE CASE OF FORWARD JUMPS. 93075000=16245000= + FINALLY, IF THE NEST LEVEL IS DEFINED THEN IT IS CHECKED 93080000=16246000= + AGAINST THE CURRENT LEVEL MINUS THE NUMBER OF LEVELS TO 93085000=16247000= + BE JUMPED OUT, OTHERWISE,NEST LEVEL IS DEFINED. ; 93090000=16248000= + PROCEDURE GOTOS; 93095000=16249000= + BEGIN 93100000=16250000= + LABEL 93105000=16251000= + EXIT; 93110000=16251000= + IF STEPI ^= TOV THEN 93115000=16252000= + I:= I-1; 93120000=16252000= + IF STEPI ^= STLABID THEN 93125000=16253000= + BEGIN 93130000=16253000= + ERR(260); 93135000=16253000= + GO TO EXIT 93140000=16253000= + END; 93145000=16253000= + IF (GT2:= TAKE(GIT(GT1:= ELBAT[I]))).MON = 1 OR GT2.LOC ^= 0 THEN 93150000=16255000= + EMITJUMP(GT1) 93155000=16256000= + ELSE 93160000=16256000= + BEGIN 93165000=16257000= + PUT(0 & L[24:36:12], GIT(GT1)); 93170000=16257000= + IF GT1 > 0 THEN 93175000=16258000= + BEGIN 93180000=16259000= + PUT(-(TAKE(GT1) & (NESTLEVEL-JUMPLEVEL)[11:43:5]), GT1); 93185000=16260000= + EMITN(1023); 93190000=16261000= + END 93195000=16264000= + ELSE 93200000=16264000= + BEGIN 93205000=16264000= + IF GT1.LEVEL ^= NESTLEVEL-JUMPLEVEL THEN 93210000=16265000= + FLAG(257); 93215000=16265000= + EMIT(GT2, LASTGT); 93220000=16266000= + END; 93225000=16267000= + END; 93230000=16268000= + JUMPLEVEL:= 0; 93235000=16269000= + EXIT: 93240000=16270000= + END GOTOS; 93245000=16270000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%93250000=16270000= + COMMENT RELEASES COMPILES THE STREAM RELEASE STATEMENT. 93255000=16271000= + THE CODE GENERATED IS : 93260000=16272000= + SED FILE 93265000=16273000= + RSA 0. 93270000=16274000= + AT EXECUTION TIME THIS CAUSES AN INVALID ADDRESS WHICH IS 93275000=16275000= + INTERPETED BY THE MCP TO MEAN RELEASE THE FILE POINTED TO 93280000=16276000= + BY THE DESTINATION ADDRESS. 93285000=16277000= + THE MONITOR BIT IS SET IN INFO FOR THE LOCAL VARIABLE SO 93290000=16278000= + THAT ACUTAL PARAPART MAY BE INFORMED LATER THAT A FILE 93295000=16279000= + MUST BE PASSED FOR THIS FORMAL PARAMETER; 93300000=16280000= + PROCEDURE RELEASES; 93305000=16281000= + IF STEPI ^= LFTPAREN OR STEPI ^= LOCLID OR STEPI ^= RTPAREN OR 93310000=16283000= + (GT1:= ELBAT[I-1]).FORMAL = 0 93315000=16284000= + THEN 93320000=16284000= + ERR(256) 93325000=16284000= + ELSE 93330000=16284000= + BEGIN 93335000=16285000= + EMITC(GT1.ADDRESS, SED); 93340000=16286000= + EMIT(FILETHING); 93345000=16287000= + FILETHING:= L-1; 93350000=16287000= + INFO[GT1.LINKR, GT1.LINKC].MON:= 1; 93355000=16288000= + END RELEASES; 93360000=16289000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%93365000=16289000= + COMMENT INDEXS COMPILE STATEMENTS BEGINING WITH SI,DI,CI,TALLY 93370000=16290000= + OR LOCALIDS . 93375000=16291000= + THREE CASES PRESENT THEMSELVES, 93380000=16292000= + LETING X BE EITHER OF SI,DI,CI OR TALLY, THEY ARE: 93385000=16293000= + CASE I LOCLID ~ X 93390000=16294000= + CASE II X ~ X ... 93395000=16295000= + CASE III X ~ EITHER LOC,LOCLID,SC OR DC. 93400000=16296000= + THE VARIABLE "INDEX" IS COMPUTED,DEPENDING UPON WHICH 93405000=16297000= + CASE EXISTS,SUCH THAT ARRAY ELEMENT "MACRO[INDEX]"CONTAINS93410000=16298000= + THE CODE TO BE EMITTED. 93415000=16299000= + EACH ELEMENT OF MACRO HAS 1-3 SYLLABES ORDERED FROM 93420000=16300000= + RIGHT TO LEFT, UNUSED SYLLABLES MUST = 0. EACH MACRO 93425000=16301000= + MAY REQUIRE AT MOST ONE REPEAT PART. 93430000=16302000= + IN THIS PROCEDURE,INDEXS,THE VARIABLE "ADDR" CONTAINS THE 93435000=16303000= + PROPER REPEAT PART BY THE TIME THE LABEL "GENERATE' IS 93440000=16304000= + ENCOUNTERED. THE SYLLABLES ARE FETCHED FROM MACRO[TYPE] 93445000=16305000= + ONE AT A TIME AND IF THE REPEAT PART ! 0 THEN"ADDR" IS 93450000=16306000= + USED AS THE REPEAT PART,THUS BUILDING A SYLLABLE WITH 93455000=16307000= + THE PROPER ADDRESS AND OPERATOR . 93460000=16308000= + NOTE: IF MACRO[TYPE] = 0 THEN THIS SIGNIFIES A SYNTAX 93465000=16309000= + ERROR. ; 93470000=16310000= + PROCEDURE INDEXS; 93475000=16311000= + BEGIN 93480000=16312000= + LABEL 93485000=16313000= + EXIT, 93490000=16313000= + GENERATE, 93495000=16313000= + L, 93500000=16313000= + L1; 93505000=16313000= + INTEGER 93510000=16314000= + TCLASS, 93515000=16314000= + INDEX, 93520000=16314000= + ADDR, 93525000=16314000= + J; 93530000=16314000= + TCLASS:= ELCLASS; 93535000=16315000= + IF STEPI ^= ASSIGNOP THEN 93540000=16316000= + BEGIN 93545000=16316000= + ERR(251); 93550000=16316000= + GO TO EXIT 93555000=16316000= + END; 93560000=16316000= + IF TCLASS = LOCLID THEN 93565000=16317000= + BEGIN 93570000=16318000= + XMARK(ASSIGNREF); 93575000=16318500= + IF SIV > STEPI OR ELCASS > TALLYV THEN 93580000=16319000= + GO TO L; 93585000=16319000= + INDEX:= 32+ELCLASS-SIV; 93590000=16320000= + ADDR:= ELBAT[I-2].ADDRESS; 93595000=16321000= + GO TO GENERATE; 93600000=16322000= + END; 93605000=16323000= + IF TCLASS = STEPI THEN 93610000=16324000= + BEGIN 93615000=16325000= + IF STEPI ^= ADDOP THEN 93620000=16326000= + BEGIN 93625000=16326000= + ERR(252); 93630000=16326000= + GO EXIT 93635000=16326000= + END 93640000=16326100= + ELSE 93645000=16326100= + IF STEPI ^= LITNO AND ELCLASS ^= LOCLID THEN 93650000=16326100= + BEGIN 93655000=16327000= + ERR(253); 93660000=16327000= + GO EXIT 93665000=16327000= + END; 93670000=16327000= + INDEX:= TCLASS-SIV+REAL(ELBAT[I-1].ADDRESS = SUB)*4+ 93675000=16330000= + REAL(ELCLASS = LOCLID)*8; 93680000=16330000= + END 93685000=16333000= + ELSE 93690000=16333000= + BEGIN 93695000=16333000= + INDEX:= TCLASS-SIV+(IF ELCLASS = LOCLID THEN 16 ELSE IF ELCLASS 93700000=16338000= + = LOCV THEN 20 ELSE IF ELCLASS = SCV THEN 24 ELSE IF ELCLASS 93705000=16338000= + = DCV THEN 28 ELSE 25); 93710000=16338000= + IF ELCLASS = LOCV THEN 93715000=16339000= + IF STEPI ^= LOCLID THEN 93720000=16340000= + GO TO L; 93725000=16340000= + IF ELCLASS = LITNO AND TCLASS = TALLYV THEN 93730000=16341000= + BEGIN 93735000=16342000= + EMITC(ELBAT[I].ADDRESS, SEC); 93740000=16342000= + GO TO EXIT 93745000=16342000= + END; 93750000=16342000= + END; 93755000=16343000= + ADDR:= ELBAT[I].ADDRESS; 93760000=16344000= + GENERATE: 93765000=16346000= + IF MACRO[INDEX] = 0 THEN 93770000=16346000= + L: 93775000=16347000= + BEGIN 93780000=16347000= + ERR(250); 93785000=16347000= + GO TO EXIT 93790000=16347000= + END; 93795000=16347000= + J:= 8; 93800000=16348000= + TCLASS:= 0; 93805000=16348000= + L1: MOVECHARACTERS(2, MACRO[INDEX], J:= J-2, TCLASS, 6); 93810000=16349000= + IF TCLASS ^= 0 THEN 93815000=16350000= + BEGIN 93820000=16351000= + EMITC(IF TCLASS >= 64 THEN ADDR ELSE 0, TCLASS); 93825000=16352000= + GO TO L1 93830000=16354000= + END; 93835000=16354000= + EXIT: 93840000=16355000= + END INDEXS; 93845000=16355000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%93850000=16355000= + COMMENT DSS COMPILES DESINTATION STREAM STATEMENTS. 93855000=16356000= + DS~ LIT"STRING" IS HANDLED AS A SPECIAL CASE BECAUE THE 93860000=16357000= + STRING MUST BE SCANED FROM RIGHT TO LEFT,REPEATEDLY IF 93865000=16358000= + NECESSARY, AND EMITTED TO THE PROGRAM STREAM. IN 93870000=16359000= + ALL OTHER CASES,THE ELBAT WORD CONTAINS THE OPERATOR IN 93875000=16360000= + THE OPCODE FIELD ; 93880000=16361000= + PROCEDURE DSS; 93885000=16362000= + BEGIN 93890000=16363000= + INTEGER 93895000=16364000= + ADDR, 93900000=16364000= + J, 93905000=16364000= + K, 93910000=16364000= + L, 93915000=16364000= + T; 93920000=16364000= + LABEL 93925000=16365000= + EXIT, 93930000=16365000= + L1; 93935000=16365000= + DEFINE 93940000=16366000= + OPCODE = [27:6] #; 93945000=16366000= + IF STEPI ^= ASSIGNOP THEN 93950000=16367000= + BEGIN 93955000=16367000= + ERR(251); 93960000=16367000= + GO TO EXIT 93965000=16367000= + END; 93970000=16367000= + IF STEPI = LOCLID THEN 93975000=16368000= + BEGIN 93980000=16369000= + EMITC(ELBAT[I].ADDRESS, CRF); 93985000=16370000= + ADDR:= 0; 93990000=16371000= + IF STEPI = LITV THEN 93995000=16372000= + GO TO L1 94000000=16374000= + END 94005000=16374000= + ELSE 94010000=16374000= + IF ELCLASS = LITNO THEN 94015000=16374000= + BEGIN 94020000=16375000= + ADDR:= ELBAT[I].ADDRESS; 94025000=16376000= + STEPIT; 94030000=16376000= + END 94035000=16378000= + ELSE 94040000=16378000= + ADDR:= 1; 94045000=16378000= + IF ELCLASS = TRNSFER OR ELCLASS = FILLV THEN 94050000=16379000= + EMITC(ADDR, ELBAT[I].OPCODE) 94055000=16380000= + ELSE 94060000=16380000= + IF ELCLASS = LITV THEN 94065000=16381000= + BEGIN 94070000=16382000= + EMITC(ADDR, TRP); 94075000=16383000= + IF STEPI ^= STRING AND ELCLASS ^= STRNGCON AND ELCLASS ^= LITNO 94080000=16384100= + AND ELCLASS ^= NONLITNO 94085000=16384100= + THEN 94090000=16384100= + BEGIN 94095000=16384500= + ERR(255); 94100000=16384500= + GO TO EXIT 94105000=16384500= + END; 94110000=16384500= + IF ELCLASS = LITNO OR ELCLASS = NONLITNO THEN 94115000=16384700= + MOVECHARACTERS(COUNT:= IF ADDR < 8 THEN ADDR ELSE 8, C, 94120000=16384900= + 8-COUNT, ACCUM[1], 3); 94125000=16384900= + IF ADDR MOD 2 ^= 0 THEN 94130000=16385000= + BEGIN 94135000=16386000= + EMIT(ACCUM[1].[18:6]); 94140000=16387000= + J:= 1; 94145000=16387000= + END; 94150000=16388000= + FOR K:= J+2 STEP 2 UNTIL ADDR DO 94155000=16389000= + BEGIN 94160000=16390000= + FOR L:= 6, 7 DO 94165000=16391000= + MOVECHARACTERS(1, ACCUM[1], 94170000=16393000= + 2+(IF J:= J+1 > COUNT THEN J:= 1 ELSE J), T, L); 94175000=16393000= + EMIT(T); 94180000=16394000= + END 94185000=16396000= + END 94190000=16397000= + ELSE 94195000=16397000= + L1: ERR(250); 94200000=16397000= + EXIT: 94205000=16398000= + END DSS; 94210000=16398000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%94215000=16398000= + COMMENT SKIPS COMPILES THE SKIP BIT STATEMENT. 94220000=16399000= + IF THE REPEAT INDEX IS A LOCALID THEN A CRF IS EMITTED. 94225000=16400000= + A BSS OR BSD IS THEN EMITTED FOR SKIP SOURCE BITS (SB) 94230000=16401000= + OR SKIP DESTINATION BITS (DB) RESPECTIVELY ; 94235000=16402000= + PROCEDURE SKIPS; 94240000=16403000= + BEGIN 94245000=16404000= + REAL 94250000=16405000= + ADDR; 94255000=16405000= + IF STEPI = LOCLID THEN 94260000=16406000= + BEGIN 94265000=16407000= + EMITC(ELBAT[I].ADDRESS, CRF); 94270000=16408000= + ADDR:= 0; 94275000=16408000= + STEPIT; 94280000=16408000= + END 94285000=16410000= + ELSE 94290000=16410000= + IF ELCLASS = LITNO THEN 94295000=16410000= + BEGIN 94300000=16411000= + ADDR:= ELBAT[I].ADDRESS; 94305000=16412000= + STEPIT 94310000=16413000= + END 94315000=16414000= + ELSE 94320000=16414000= + ADDR:= 1; 94325000=16414000= + IF ELCLASS = SBV THEN 94330000=16415000= + EMITC(ADDR, BSS) 94335000=16416000= + ELSE 94340000=16416000= + IF ELCLASS = DBV THEN 94345000=16417000= + EMITC(ADDR, BSD) 94350000=16418000= + ELSE 94355000=16418000= + ERR(250); 94360000=16418000= + END SKIPS; 94365000=16419000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%94370000=16419000= + COMMENT JUMPS COMPILES JUMP OUT AND JUMP OUT TO STATEMENTS. 94375000=16420000= + JUMP OUT TO STATEMENTS CAUSE JUMP LEVEL TO BE SET TO 94380000=16421000= + THE NUMBER OF LEVELS SPECIFIED. THEN THIS NUMBER OF 94385000=16422000= + JNS ARE EMITTED AND GOTOS IS CALLED TO COMPILE THE 94390000=16423000= + JUMP INSTRUCTION. 94395000=16424000= + SIMPLE JUMP OUTS ARE HANDLED BY EMITTING ONE JNS,ENTERING 94400000=16425000= + A PSEUDO STLABID IN INFO AND SETTING ELBAT[I] SUCH THAT 94405000=16426000= + THE GOTOS PROCEDURE WILL PERFORM THE ACTION OF SETTING 94410000=16427000= + UP THE LINKS FOR LATER FIX UPS. THE NEST STATEMENT CAUSES 94415000=16428000= + THESE FIX UPS(IF EMITTING OF JUMP INSTRUCTIONS) BY CALLING94420000=16429000= + GO TOS WHEN THE RIGHT PAREN IS ENCOUNTERED. ; 94425000=16430000= + PROCEDURE JUMPS; 94430000=16431000= + BEGIN 94435000=16432000= + JUMPLEVEL:= 1; 94440000=16433000= + IF STEPI ^= DECLARATORS THEN 94445000=16434000= + FLAG(261); 94450000=16434000= + IF STEPI ^= LITNO THEN 94455000=16435000= + JUMPLEVEL:= ELBAT[I].ADDRESS 94460000=16436000= + ELSE 94465000=16436000= + BEGIN 94470000=16436000= + IF ELCLASS ^= TOV AND ELCLASS ^= STLABID THEN 94475000=16437000= + BEGIN 94480000=16438000= + COMMENT SIMPLE JUMP OUT STATEMENT; 94485000=16439000= + IF JOINFO = 0 THEN 94490000=16440000= + BEGIN 94495000=16441000= + JOINFO:= NEXTINFO; 94500000=16442000= + PUTNBUMP(0 & (STLABID*2+1)[2:40:8] & 2[27:40:8]); 94505000=16444000= + PUTNBUMP(0 & (JOINFO-LASTINFO)[4:40:8]); 94510000=16445000= + PUTNBUMP(0); 94515000=16446000= + LASTINFO:= JOINFO; 94520000=16447000= + END; 94525000=16448000= + ELBAT[I:= I-1]:= TAKE(JOINFO) & JOINFO[35:35:13]; 94530000=16449000= + END; 94535000=16450000= + I:= I-1; 94540000=16450000= + END; 94545000=16451000= + FOR GT1:= 1 STEP 1 UNTIL JUMPLEVEL DO 94550000=16452000= + EMIT(JNS); 94555000=16453000= + GOTOS; 94560000=16454000= + END JUMPS; 94565000=16455000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%94570000=16455000= + COMMENT STREAMSTMT ENVOKES THE APPROPRIATE PROCEDURE TO HANDLE 94575000=16456000= + THE VARIOUS AND SUNDRY STREAM PROCEDURE STATEMENTS. 94580000=16457000= + THE STATEMENTS ARE BROKEN DOWN AS FOLLOWS: 94585000=16458000= + IDENTIFIED BY PROCEDURE ENVOKED 94590000=16459000= + END GO TO FINI 94595000=16460000= + SEMICOLON GO TO FINI 94600000=16461000= + ) GO TO FINI 94605000=16462000= + IF IFS 94610000=16463000= + GO GOTOS 94615000=16464000= + RELEASE RELEASES 94620000=16465000= + BEGIN COMPOUNDTAIL 94625000=16466000= + SI,DI,CI,TALLY,LOCALID INDEXS 94630000=16467000= + DS DSS 94635000=16468000= + SKIP SKIPS 94640000=16469000= + JUMP JUMPS 94645000=16470000= + LABELID LABELS 94650000=16471000= + LITERAL NO.,LOCALID( NESTS 94655000=16472000= + UPON EXITING,STREAMSTMT ASSURES THAT "I" POINTS TO 94660000=16473000= + THE SEMICOLON ,END OR ) IN SYNTACICALLY CORRECT PROGRAMS; 94665000=16474000= + LABEL 94670000=16475000= + L, 94675000=16475000= + L1, 94680000=16475000= + L2, 94685000=16475000= + L3, 94690000=16475000= + L4, 94695000=16475000= + L5, 94700000=16475000= + L6, 94705000=16475000= + L7, 94710000=16475000= + L8, 94715000=16475000= + L9, 94720000=16475000= + L10, 94725000=16475000= + EXIT, 94730000=16475000= + FINI, 94735000=16475000= + START; 94740000=16475000= + SWITCH 94745000=16476000= + TYPE:= FINI, 94750000=16476000= + L, 94755000=16476000= + FINI, 94760000=16476000= + L3, 94765000=16476000= + L4, 94770000=16476000= + L5, 94775000=16476000= + L6, 94780000=16476000= + L7, 94785000=16476000= + L7, 94790000=16476000= + L7, 94795000=16476000= + L7, 94800000=16476000= + L8, 94805000=16476000= + L9, 94810000=16476000= + L10; 94815000=16476000= +START: 94820000=16477000= + GO TO TYPE[ELCLASS-ENDV+1]; 94825000=16477000= + IF ELCLASS = RTPAREN THEN 94830000=16478000= + GO TO FINI; 94835000=16478000= + IF ELCLASS = LITNO OR ELCLASS = LOCLID AND TABLE(I+1) = LFTPAREN 94840000=16480000= + THEN 94845000=16480000= + GO TO L1; 94850000=16480000= + IF ELCLASS = STLABID THEN 94855000=16481000= + GO TO L2; 94860000=16481000= + IF ELCLASS = LOCLID THEN 94865000=16482000= + GO TO L7; 94870000=16482000= +L: ERR(250); 94875000=16483000= + GO TO FINI; 94880000=16483000= +L1: NESTS; 94885000=16484000= + GO TO EXIT; 94890000=16484000= +L2: LABELS; 94895000=16485000= + GO TO START; 94900000=16485000= +L3: IFS; 94905000=16486000= + GO TO FINI; 94910000=16486000= +L4: GOTOS; 94915000=16487000= + GO TO EXIT; 94920000=16487000= +L5: RELEASES; 94925000=16488000= + GO TO EXIT; 94930000=16488000= +L6: I:= I+1; 94935000=16489000= + COMPOUNDTAIL; 94940000=16489000= + GO TO FINI; 94945000=16489000= +L7: INDEXS; 94950000=16490000= + GO TO EXIT; 94955000=16490000= +L8: DSS; 94960000=16491000= + GO TO EXIT; 94965000=16491000= +L9: SKIPS; 94970000=16492000= + GO TO EXIT; 94975000=16492000= +L10: 94980000=16493000= + JUMPS; 94985000=16493000= + GO TO EXIT; 94990000=16493000= +EXIT: 94995000=16494000= + STEPIT; 95000000=16494000= +FINI: 95005000=16495000= + END STREAMSTMT; 95010000=16495000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95015000=16495000= + TIME1:= TIME(1); 95020000=17000000= + PROGRAM; 95025000=17000000= +ENDOFITALL: 95030000=17001000= + IF(XREF OR DEFINING.[1:1) AND XLUN > 0 THEN 95035000=17001000= + BEGIN 95040000=17002000= + DEFINE 95045000=17002000= + LSS = < #, 95050000=17002000= + GTR = > #, 95055000=17002000= + NEQ = ^= #, 95060000=17002000= + LEQ = <= #; 95065000=17002000= + DEFINE 95070000=17002005= + XREFINFO[INDEX] = 95075000=17002005= + INFO[((INDEX).CF DIV 2).[33:7], ((INDEX).CF DIV 2)95080000=17002006= + .LINKC] #, 95085000=17002007= + CF = [33:15] #, 95090000=17002008= + FF = [18:15] #, 95095000=17002009= + NEWID[INDEX] = (IF BOOLEAN(INDEX) THEN XREFINFO[INDEX].FF ELSE 95100000=17002010= + XREFINFO[INDEX].CF) #; 95105000=17002010= + ARRAY 95110000=17002012= + TIMINGS[0:2, 0:3]; 95115000=17002012= + PROCEDURE SAVETIMES(I); 95120000=17002015= + VALUE 95125000=17002020= + I; 95130000=17002020= + INTEGER 95135000=17002020= + I; 95140000=17002020= + BEGIN 95145000=17002025= + INTEGER 95150000=17002030= + J; 95155000=17002030= + FOR J:= 1 STEP 1 UNTIL 3 DO 95160000=17002035= + TIMINGS[I, J]:= TIME(J); 95165000=17002040= + END; 95170000=17002045= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95175000=17002045= + PROCEDURE UPDATETIMES(I); 95180000=17002050= + VALUE 95185000=17002055= + I; 95190000=17002055= + INTEGER 95195000=17002055= + I; 95200000=17002055= + BEGIN 95205000=17002060= + INTEGER 95210000=17002065= + J; 95215000=17002065= + FOR J:= 1 STEP 1 UNTIL 3 DO 95220000=17002070= + TIMINGS[I, J]:= TIME(J)-TIMINGS[I, J]; 95225000=17002075= + END; 95230000=17002080= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95235000=17002080= + WRITE(LINE[PAGE]); 95240000=17002520= + SAVETIMES(0); % SAVE TIMES FOR START OF IDENTIFIER SORT. 95245000=17002525= + LASTADDRESS:= 0; 95250000=17002530= + FOR XREFPT:= XREFPT STEP 1 UNTIL 29 DO 95255000=17003000= + XREFAY2[XREFPT]:= 100000000; 95260000=17003000= + WRITE(DSK2, 30, XREFAY2[**]); 95265000=17004000= + TOTALNO:= XLUN; % REMEMBER NUMBER OF IDENTIFIERS. 95270000=17004500= + XREFPT:= XLUN:= 0; 95275000=17004600= + FOR I:= 0 STEP 1 UNTIL 8191 DO 95280000=17004700= + XREFINFO[I]:= 0; 95285000=17004710= + BEGIN 95290000=17005000= + BOOLEAN PROCEDURE INPUT1(A); 95295000=17006000= + ARRAY 95300000=17007000= + A[0]; 95305000=17007000= + BEGIN 95310000=17008000= + LABEL 95315000=17009000= + L, 95320000=17009000= + EOF; 95325000=17009000= + READ(DSK1, 10, A[**])[EOF]; 95330000=17010000= + GO TO L; 95335000=17011000= + EOF: 95340000=17012000= + INPUT1:= TRUE; 95345000=17012000= + REWIND(DSK1); 95350000=17013000= + L: 95355000=17015000= + END; 95360000=17015000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95365000=17015000= + PROCEDURE OUTPUT1(B, A); 95370000=17016000= + VALUE 95375000=17017000= + B; 95380000=17017000= + BOOLEAN 95385000=17018000= + B; 95390000=17018000= + ARRAY 95395000=17019000= + A[0]; 95400000=17019000= + BEGIN 95405000=17020000= + IF B THEN 95410000=17021000= + BEGIN 95415000=17022000= + REWIND(DSK1); 95420000=17022100= + UPDATETIMES(0); % UPDATE TIMES FOR IDENTIFIER SORT. 95425000=17022200= + TIMINGS[0, 0]:= XLUN; % NUMBER OF IDENTIFIERS SORTED. 95430000=17022300= + END 95435000=17024000= + ELSE 95440000=17024000= + BEGIN 95445000=17024000= + IF BOOLEAN(A[8]) THEN 95450000=17025000= + XREFINFO[A[8]].FF:= XLUN:= XLUN+1 95455000=17025200= + ELSE 95460000=17025200= + XREFINFO[A[8]].CF:= XLUN:= XLUN+1; 95465000=17025300= + A[8].IDNOF:= XLUN; 95470000=17025400= + WRITE(DSK1, 10, A[**]); 95475000=17026000= + END; 95480000=17027000= + END; 95485000=17028000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95490000=17028000= + BOOLEAN 95495000=17029000= + STREAM PROCEDURE COMPS1(A, B); 95500000=17029000= + BEGIN 95505000=17030000= + SI:= A; 95510000=17031000= + DI:= B; 95515000=17032000= + IF 63 SC < DC THEN 95520000=17033000= + TALLY:= 1 95525000=17033200= + ELSE 95530000=17033200= + BEGIN 95535000=17033300= + SI:= A; 95540000=17033400= + DI:= B; 95545000=17033500= + IF 63 SC = DC THEN 95550000=17033600= + TALLY:= 2; 95555000=17033700= + END; 95560000=17033800= + COMPS1:= TALLY; 95565000=17034000= + END; 95570000=17035000= + STREAM PROCEDURE HVS1(A); 95575000=17036000= + BEGIN 95580000=17037000= + DI:= A; 95585000=17038000= + DS:= 8 LIT 6"9"; 95590000=17039000= + SI:= A; 95595000=17040000= + DS:= 7 WDS; 95600000=17041000= + DS:= 8 LIT 3"777777777"; % ID,NO, AND SEG.NO. FIELDS 95605000=17041100= + END; 95610000=17042000= + BOOLEAN PROCEDURE COMP1(A, B); 95615000=17042100= + ARRAY 95620000=17042200= + A, 95625000=17042200= + B[0]; 95630000=17042200= + IF REAL(COMP1:= COMPS1(A, B)) = 2 THEN % IDS EQUAL 95635000=17042300= + COMP1:= A[8].IDNOF < B[8].IDNOF; 95640000=17042350= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95645000=17042350= + PROCEDURE HV1(A); 95650000=17042400= + ARRAY 95655000=17042500= + A[0]; 95660000=17042500= + HVS1(A); 95665000=17042600= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%95670000=17042600= + XLUN:= 0; 95675000=17043000= + REWIND(DSK1); 95680000=17044000= + SORT(OUTPUT1, INPUT1, 0, HV1, COMP1, 10, IF TOTALNO < 1000 95685000=17045100= + THEN 7000 ELSE 10000); 95690000=17045100= + END; 95695000=17046000= + BEGIN 95700000=17047000= + ARRAY 95705000=17047100= + IDTYPE[0:(IDMAX+4)*4-1]; 95710000=17047100= + STREAM PROCEDURE SETUPHEADING(S, D, SEG, SEQNO, FWDTOG, 95715000=17047350= + LBLTOG, FWDSEQNO, TYPE, OWNTOG, PARAMTOG, VALTOG); 95720000=17047350= + VALUE 95725000=17047400= + SEQG, 95730000=17047400= + SEQNO, 95735000=17047400= + FWDTOG, 95740000=17047400= + LBLTOG, 95745000=17047400= + FWDSEQNO, 95750000=17047400= + OWNTOG, 95755000=17047400= + PARAMTOG, 95760000=17047450= + VALTOG; 95765000=17047450= + BEGIN 95770000=17047500= + SI:= S; 95775000=17047700= + DI:= D; 95780000=17047800= + 63(IF SC = 6" " THEN JUMP OUT ELSE DS:= CHR); 95785000=17047900= + DS:= 6 LIT 6" -- "; 95790000=17048000= + OWNTOG(DS:= 4 LIT 6"OWN "); 95795000=17048100= + SI:= TYPE; 95800000=17049300= + 32(IF SC = 6"." THEN JUMP OUT ELSE DS:= CHR); 95805000=17049400= + (DS:= 6 LIT 6" -- ";DS:= 4 LIT 6"NAME"; 95810000=17049440= + VALTOG(DI:= DI-4;DS:= 5 LIT 6"VALUE");DS:= 10 LIT 95815000=17049440= + 6" PARAMETER"); 95820000=17049440= + DS:= 26 LIT 6" -- DECLARED IN SEGMENT "; 95825000=17049500= + SI:= LOC SEG; 95830000=17049600= + S:= DI; 95835000=17049700= + DS:= 4 DEC; 95840000=17049800= + DI:= DI-4; 95845000=17049800= + DS:= 3 FILL; % CONV AND ZERO SUPPR 95850000=17049800= + DI:= DI+8; % TO FORCE STORE OF LAST WORD 95855000=17049900= + SI:= S; 95860000=17050000= + DI:= S; 95865000=17050100= + 4(IF SC ^= 6" " THEN DS:= CHR ELSE SI:= SI+1); 95870000=17050200= + DS:= 4 LIT 6" AT "; 95875000=17050300= + SI:= LOC SEQNO; 95880000=17050400= + DS:= 8 DEC; 95885000=17050500= + (DS:= 17 LIT 6" -- FORWARD AT ";SI:= LOC FWDSEQNO;DS:= 8 DEC);95890000=17050800= + (DS:= 16 LIT 6" -- OCCURS AT ";SI:= LOC FWDSEQNO;DS:= 8 DEC); 95895000=17051100= + END OF SETUPHEADING; 95900000=17051200= + STREAM PROCEDURE ADDASEQNO(SEQNO, N, STARS, D); 95905000=17051400= + VALUE 95910000=17051500= + SEQNO, 95915000=17051500= + N, 95920000=17051500= + STARS; 95925000=17051500= + BEGIN 95930000=17051600= + DI:= D; 95935000=17051700= + DI:= DI+8; 95940000=17051800= + N(DI:= DI+10); 95945000=17051900= + STARS(DO:= DI-1;DS:= LIT 6"*"); 95950000=17052000= + SI:= LOC SEQNO; 95955000=17052100= + DS:= 8 DEC; 95960000=17052200= + DS:= LIT 6" "; 95965000=17052300= + (DI:= DS-1;DS:= LIT 6"*"); 95970000=17052400= + END; 95975000=17052500= + STREAM PROCEDURE BLANKET(D); 95980000=17052600= + BEGIN 95985000=17052700= + DI:= D; 95990000=17052800= + DS:= 8 LIT 6" "; 95995000=17052900= + SI:= D; 96000000=17053000= + DS:= 16 WDS; 96005000=17053100= + END OF BLANKET; 96010000=17053200= + PROCEDURE PRINTXREFSTATISTICS; 96015000=17053300= + BEGIN 96020000=17053400= + SWITCH FORMAT STATS := 96025000=17053500= + (///, "CROSS REFERENCE STATISTICS", /, 96030000=17053600= + "----- --------- ----------", /), 96035000=17053700= + ("PHASE ONE - SORT",I6," IDENTIFIERS"), 96040000=17053800= + ("PHASE TWO - SORT",I7," REFERENCES"), 96045000=17053900= + ("PHASE THREE - PRINT CROSS REFERENCE (",I7," LINES)"), 96050000=17054000= + (X5,I4,":",2I1," ELAPSED TIME (MIN:SEC)"), 96055000=17054100= + (X5,I4,":",2I1," PROCESSOR TIME"), 96060000=17054200= + (X5,I4,":",2I1," I/O TIME",/); 96065000=17054300= + INTEGER 96070000=17054400= + I, 96075000=17054400= + J, 96080000=17054400= + K; 96085000=17054400= + WRITE(LINE, STATS[0]); 96090000=17054500= + FOR I:= 0 STEP 1 UNTIL 2 DO 96095000=17054600= + BEGIN 96100000=17054700= + WRITE(LINE, STATS[I+1], TIMINGS[I, 0]); 96105000=17054800= + FOR J:= 1 STEP 1 UNTIL 3 DO 96110000=17054900= + BEGIN 96115000=17055000= + K:= (TIMINGS[I, J]+30) DIV 60; % ROUND TO NEAREST SECON96120000=17055010= + WRITE(LINE, STATS[J+3], K DIV 60, (K:= K MOD 60) DIV 10, 96125000=17055025= + K MOD 10); 96130000=17055025= + END; 96135000=17055030= + END; 96140000=17055100= + END PRINTXREFSTATISTICS; 96145000=17055200= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%96150000=17055200= + DEFINE 96155000=17069300= + REFCOUNT = TIMINGS[1, 0] #; % NUMBER OF REFERENCES SORTED.96160000=17069300= + BOOLEAN 96165000=17069400= + FIRSTTIME; % TRUE ON FIRST CALL OF OUTPUT PROCEDURE. 96170000=17069400= + ARRAY 96175000=17069500= + PAY[0:17]; 96180000=17069500= + REAL 96185000=17069600= + LASTADDRESS; 96190000=17069600= + BOOLEAN PROCEDURE INPUT2(A); 96195000=17070000= + ARRAY 96200000=17071000= + A[0]; 96205000=17071000= + BEGIN 96210000=17072000= + LABEL 96215000=17073000= + L, 96220000=17073000= + EOF; 96225000=17073000= + DEFINE 96230000=17073100= + I = LASTADDRESS #; 96235000=17073100= + IF XREFPT:= XREFPT+1 = 30 THEN 96240000=17074000= + BEGIN 96245000=17075000= + READ(DSK2, 30, XREFAY2[**])[EOF]; 96250000=17076000= + XREFPT:= 0; 96255000=17077000= + END; 96260000=17078000= + IF(I:= XREFAY2[XREFPT]).[21:27] GTR 99999999 THEN 96265000=17079000= + GO TO EOF; 96270000=17079000= + A[0]:= I & NEWID[I.REFIDNOF] REFIDNOF; 96275000=17080000= + REFCOUNT:= REFCOUNT+1; 96280000=17080100= + GO TO L; 96285000=17081000= + EOF: 96290000=17082000= + INPUT2:= TRUE; 96295000=17082000= + BLANKET(PAY); 96300000=17083000= + XREFAY1[8]:= XREFPT:= LASTADDRESS:= 0; 96305000=17084000= + FILL IDTYPE[**] WITH 6"UNKNOWN. ", % 0 96310000=17084020= +6"STREAM LABEL. ", % 1 96315000=17084030= +6"STREAM VARIABLE. ", % 2 96320000=17084040= +6"DEFINE. ", % 3 96325000=17084050= +6"LIST. ", % 4 96330000=17084060= +6"FORMAT. ", % 5 96335000=17084070= +6"SWITCH FORMAT. ", % 6 96340000=17084080= +6"FILE. ", % 7 96345000=17084090= +6"SWITCH FILE. ", % 8 96350000=17084100= +6"SWITCH LABEL. ", % 9 96355000=17084110= +6"PROCEDURE. ", % 10 96360000=17084120= +6"INTRINSIC. ", % 11 96365000=17084130= +6"STREAM PROCEDURE. ", % 12 96370000=17084140= +6"BOOLEAN STREAM PROCEDURE. ", % 13 96375000=17084150= +6"REAL STREAM PROCEDURE. ", % 14 96380000=17084160= +6"ALPHA STREAM PROCEDURE. ", % 15 96385000=17084170= +6"INTEGER STREAM PROCEDURE. ", % 16 96390000=17084180= +6"BOOLEAN PROCEDURE. ", % 17 96395000=17084182= +6"REAL PROCEDURE. ", % 18 96400000=17084184= +6"ALPHA PROCEDURE. ", % 19 96405000=17084186= +6"INTEGER PROCEDURE. ", % 20 96410000=17084188= +6"BOOLEAN. ", % 21 96415000=17084190= +6"REAL. ", % 22 96420000=17084200= +6"ALPHA. ", % 23 96425000=17084210= +6"INTEGER. ", % 24 96430000=17084220= +6"BOOLEAN ARRAY. ", % 25 96435000=17084230= +6"REAL ARRAY. ", % 26 96440000=17084240= +6"ALPHA ARRAY. ", % 27 96445000=17084250= +6"INTEGER ARRAY. ", % 28 96450000=17084260= +6"LABEL. ", % 29 96455000=17084270= +6"FIELD. ", % 30 (CLASS = 125) 96460000=17084275= +6"FAULT. ", % 32 (CLASS = 126) 96465000=17084280= +6"SWITCH LIST. "; % 31 (CLASS = 127) 96470000=17084290= + L: 96475000=17086000= + END; 96480000=17086000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%96485000=17086000= + PROCEDURE OUTPUT2(B, A); 96490000=17087000= + VALUE 96495000=17088000= + B; 96500000=17088000= + BOOLEAN 96505000=17089000= + B; 96510000=17089000= + ARRAY 96515000=17090000= + A[0]; 96520000=17090000= + BEGIN 96525000=17091000= + DEFINE 96530000=17091000= + PRINTER = LINE #; 96535000=17091000= + LABEL 96540000=17091100= + EOF2, 96545000=17091100= + SKIP; 96550000=17091100= + OWN BOOLEAN 96555000=17091110= + B2, 96560000=17091110= + FWDTOG, 96565000=17091110= + LBLTOG, 96570000=17091110= + WAITINGFORFWDREF; 96575000=17091110= + DEFINE 96580000=17091115= + MATCH(A, B) = REAL(BOOLEAN(A) EQV BOOLEAN(B)) = 96585000=17091116= + REAL(NOT FALSE) #; 96590000=17091116= + REAL 96595000=17091120= + I; 96600000=17091120= + DEFINE 96605000=17091140= + LINECOUNT = TIMINGS[2, 0] #; % NUMBER OF LINES PRINTED. 96610000=17091140= + OWN REAL 96615000=17091150= + FWDSEQNO; 96620000=17091150= + IF FIRSTTIME THEN % PRINT HEADINGS AND SAVE TIMINGS. 96625000=17091155= + BEGIN 96630000=17091160= + FIRSTTIME:= FALSE; 96635000=17091162= + TIME1:= TIME(1); 96640000=17091165= + DATIME; 96645000=17091170= + UPDATETIMES(1); 96650000=17091175= + SAVETIMES(2); % SAVE TIMES FOR START OF XREF PRINT. 96655000=17091180= + END; 96660000=17091200= + IF NOT B2 THEN 96665000=17091210= + IF B THEN % END OF SORT - LIST OUT REST OF SEQ. NO. 96670000=17091300= + IF XREFPT ^= 0 THEN % WE GOT SOME TO LIST OUT 96675000=17091400= + BEGIN 96680000=17091500= + WRITE(LINE[DBL], 15, PAY[**]); 96685000=17091510= + LINECOUNT:= LINECOUNT+1; 96690000=17091520= + END 96695000=17091600= + ELSE % NOTHING TO LIST OUT 96700000=17091600= + ELSE % NOT END OF SORT 96705000=17091700= + IF NOT MATCH(LASTADDRESS, A[0]) AND A[0].REFIDNOF ^= 0 AND 96710000=17091900= + A[0].REFIDNOF >= XREFAY1[8].IDNOF 96715000=17091900= + THEN 96720000=17091900= + IF A[0].TYPEREF = FORWARDREF THEN % 96725000=17092000= + WAITINGFORFWDREF:= TRUE 96730000=17092200= + ELSE 96735000=17092200= + IF A[0].TYPEREF = LBLREF THEN % 96740000=17092300= + BEGIN 96745000=17092400= + LBLTOG:= TRUE; 96750000=17092500= + FWDSEQNO:= A[0].SEQNOF; 96755000=17092600= + END 96760000=17092900= + ELSE 96765000=17092900= + IF A[0].TYPEREF = DECLREF THEN 96770000=17092900= + IF WAITINGFORFWDREF THEN % THIS MUST BE IT 96775000=17093000= + BEGIN 96780000=17093100= + WAITINGFORFWDREF:= FALSE; 96785000=17093200= + FWDTOG:= TRUE; 96790000=17093300= + FWDSEQNO:= A[0].SEQNOF; 96795000=17093400= + END 96800000=17093600= + ELSE % ITS A NORMAL DECLARATION - NOT FORWARD 96805000=17093600= + BEGIN 96810000=17093700= + IF A[0].REFIDNOF > XREFAY1[8].IDNOF THEN 96815000=17093850= + DO 96820000=17093950= + READ(DSK1, 10, XREFAY1[**])[EOF2] 96825000=17094050= + UNTIL A[0].REFIDNOF <= XREFAY1[8].IDNOF; 96830000=17094050= + IF A[0].REFIDNOF < XREFAY1[8].IDNOF THEN 96835000=17094100= + GO TO SKIP; 96840000=17094150= + IF XREFPT > 0 THEN % THERE IS STUFF TO PRINT 96845000=17094200= + BEGIN 96850000=17094240= + IF SINGLTOG THEN 96855000=17094250= + WRITE(LINE, 15, PAY[**]) 96860000=17094350= + ELSE 96865000=17094350= + WRITE(LINE[DBL], 15, PAY[**]); 96870000=17094400= + LINECOUNT:= LINECOUNT+1; 96875000=17094410= + END 96880000=17094500= + ELSE 96885000=17094500= + IF NOT SINGLTOG THEN 96890000=17094500= + WRITE(LINE); 96895000=17094550= + XREFPT:= 0; 96900000=17094600= + BLANKET(PAY[**]); 96905000=17094650= + SETUPHEADING(XREFAY1[**], PAY[**], 96910000=17095320= + XREFAY1[8].SEGNOF, A[0].SEQNOF, FWDTOG, LBLTOG, 96915000=17095320= + FWDSEQNO.IDTYPE[(IF(I:= XREFAY1[9].CLASS) >= FIELDID 96920000=17095320= + THEN(IDMAX+I-FIELDID+1) ELSE IF I > IDMAX THEN 0 ELSE 96925000=17095320= + I)*4], REAL(I >= BOOID AND XREFAY1[9].[9:2] = 1), REAL96930000=17095320= + ((I >= BOOID OR I = LOCLID) AND 96935000=17095320= + BOOLEAN(XREFAY1[9].[9:1])), XREFAY1[9].[10:1]); 96940000=17095320= + FWDTOG:= LBLTOG:= FALSE; 96945000=17095400= + WRITE(LINE, 15, PAY[**]); 96950000=17095500= + LINECOUNT:= LINECOUNT+1; 96955000=17095510= + BLANKET(PAY[**]); 96960000=17095550= + END 96965000=17095700= + ELSE % IT MUST BE A NORMAL REFERENCE 96970000=17095700= + IF A[0].SEQNOF ^= LASTADDRESS.SEQNOF THEN 96975000=17095750= + BEGIN 96980000=17095800= + ADDASEQNO(A[0].SEQNOF, XREFPT, A[0].[5:1], PAY[**]); 96985000=17096000= + IF(XREFPT:= XREFPT+1) = 11 THEN %FULL 96990000=17096100= + BEGIN 96995000=17096200= + WRITE(LINE, 15, PAY[**]); 97000000=17096300= + LINECOUNT:= LINECOUNT+1; 97005000=17096350= + XREFPT:= 0; 97010000=17096400= + BLANKET(PAY[**]); 97015000=17096450= + END 97020000=17096575= + END 97025000=17096575= + ELSE % REFERENCE TO SAME SEQ. NO. SKIP IT 97030000=17096575= + ELSE % THIS IS A REFERENCE TO THE SAME SEQ. NO. - SKIP 97035000=17096600= + ELSE % HIT END OF IDENTIFIER FILE - JUST SKIP OVER REFERENCES 97040000=17096700= + EOF2: 97045000=17096800= + B2:= TRUE; % SO SORT CAN GO TO NORMAL EOJ 97050000=17096800= + IF NOT B THEN 97055000=17096850= + SKIP: 97060000=17096850= + LASTADDRESS:= A[0]; 97065000=17096850= + END OF OUTPUT2; 97070000=17096900= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%97075000=17096900= + PROCEDURE HV2(A); 97080000=17112000= + ARRAY 97085000=17113000= + A[0]; 97090000=17113000= + A[0]:= 3"777777777777777"; % BIGGEST FLOATING PT. NO. 97095000=17114000= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%97100000=17114000= + BOOLEAN PROCEDURE COMP2(A, B); 97105000=17115000= + ARRAY 97110000=17116000= + A, 97115000=17116000= + B[0]; 97120000=17116000= + COMP2:= 97125000=17117000= + IF A[0].REFIDNOF < B[0].REFIDNOF THEN % DIF IDS 97130000=17117000= + TRUE 97135000=17117200= + ELSE 97140000=17117200= + IF A[0].REFIDNOF = B[0].REFIDNOF THEN 97145000=17117300= + IF A[0].[1:4] LSS B[0].[1:4] THEN 97150000=17117400= + TRUE 97155000=17117600= + ELSE 97160000=17117600= + IF A[0].[1:4] = B[0].[1:4] THEN 97165000=17117700= + IF A[0].SEQNOF < B[0].SEQNOF THEN 97170000=17117702= + TRUE 97175000=17117706= + ELSE 97180000=17117706= + IF A[0].SEQNOF = B[0].SEQNOF THEN 97185000=17117708= + BOOLEAN(A[0].[5:1]) 97190000=17117712= + ELSE 97195000=17117712= + FALSE 97200000=17117720= + ELSE 97205000=17117720= + FALSE 97210000=17117800= + ELSE 97215000=17117800= + FALSE; 97220000=17117900= + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%97225000=17117900= + SAVETIMES(1); % SAVE TIMES FOR START OF REFERENCES SORT 97230000=17117910= + FIRSTTIME:= TRUE; % LET OUTPUT PROCEDURE KNOW ABOUT FIRST CAL 97235000=17117920= + XREFPT:= 29; 97240000=17118000= + REWIND(DSK2); 97245000=17118000= + SORT(OUTPUT2, INPUT2, 0, HV2, COMP2, 1, 6000); 97250000=17119000= + UPDATETIMES(2); % UPDATE TIMES FOR PRINTING CROSS REFERENCE 97255000=17119100= + PRINTXREFSTATISTICS; 97260000=17119200= + END; 97265000=17120000= + END; 97270000=17121000= + END OF MAIN BLOCK; 97275000=17121500= +END. 97280000=17122000=