COMMENT STANFORD ALGOL W COMPILER PHASE A - SCAN AND PARSE PASSES MAY 1971 VERSION ; GLOBAL PROCEDURE AWXCMPA2(R14); BEGIN FUNCTION DECR(6,#0600), ZONE(8,#96F0); STM(R14,R12,B13(12)); R4 := R1; R5 := R13; R0 := 4096; R1 := R0; R3 := B4(20); BALR(R2,R3); COMMENT GETMAIN; R13 := R0; COMMENT ESTABLISH 4K INITIAL DATA SEGMENT, BASE R13; BEGIN DUMMY BASE R13; COMMENT SHARED DATA SEGMENT; LOGICAL SYSINF, OLDSAVE, NEWSAVE; ARRAY 15 LOGICAL SAVEAREA; ARRAY 16 INTEGER XFERVECTOR; COMMENT SUPV ENTRY ADDRESSES; ARRAY 2 INTEGER COMMLIM SYN XFERVECTOR(0); INTEGER APUTLINE SYN XFERVECTOR(8); COMMENT WRITE ENTRY; BYTE CARRCONT SYN APUTLINE(0); COMMENT PRINT CONTROL CHAR; INTEGER AGETCARD SYN XFERVECTOR(12); COMMENT READ ENTRY; INTEGER APUTCARD SYN XFERVECTOR(16); COMMENT PUNCH ENTRY; INTEGER AGETMAIN SYN XFERVECTOR(20); COMMENT GETMAIN ENTRY; INTEGER AFREEMAIN SYN XFERVECTOR(24); COMMENT FREEMAIN ENTRY; INTEGER AGETTIME SYN XFERVECTOR(28); COMMENT GETTIME ENTRY; INTEGER ARUNID SYN XFERVECTOR(60); COMMENT ADDRESS OF SYSTEM ID; BYTE SYSOPTIONS SYN XFERVECTOR(60); COMMENT OPTION INHIBIT BITS; ARRAY 5 INTEGER BASESAVE; COMMENT DATA BASES FOR PASS 2; LOGICAL PHASEFLAGS; COMMENT FLAGS FOR PASS1/PASS2 COMMUNICATION; BYTE NOGO SYN PHASEFLAGS(0); BYTE NOPASSTWO SYN PHASEFLAGS(1); BYTE STACKFLAG SYN PHASEFLAGS(2); BYTE DEBUG SYN PHASEFLAGS(3); SHORT INTEGER LINENO, PAGENO; LONG REAL PKDEC; COMMENT USED WITH CVD; ARRAY 132 BYTE HEADING; COMMENT PAGE HEADER; ARRAY 132 BYTE BUFFER; COMMENT PRINT BUFFER; PROCEDURE PRINT(R1); COMMENT DETERMINES REQUIRED CONTROL CHARACTER, PRINTS LINE AT (R0); BEGIN ARRAY 4 LOGICAL SAVE03; STM(R0,R3,SAVE03); R1 := R1-R1; IC(R1,CARRCONT); R2 := LINENO + 1; R3 := APUTLINE; IF R1 = "0" THEN BEGIN IF R2 >= 60 THEN R1 := "1" ELSE R2 := R2 + 1; END; IF R1 = "1" THEN BEGIN R0 := PAGENO + 1; PAGENO := R0; CVD(R0,PKDEC); MVC(3,HEADING(117),#40202120); ED(3,HEADING(117),PKDEC(6)); R0 := @HEADING; BALR(R2,R3); R0 := SAVE03(0); R2 := 3; R1 := "0"; END; LINENO := R2; IF R2 = 60 THEN MVI("1",CARRCONT) ELSE MVI(" ",CARRCONT); BALR(R2,R3); COMMENT LINK TO WRITE; LM(R0,R3,SAVE03); END; DUMMY BASE R11; COMMENT COMPILER COMMON FORMAT; INTEGER COMMTIME; SHORT INTEGER COMMLINE, COMMPAGE; ARRAY 3 LOGICAL COMMFLAGS; BYTE CHECKFLAG SYN COMMFLAGS(0); COMMENT CODE FOR VALIDITY TESTS; BYTE DEBUGFLAG SYN COMMFLAGS(1); COMMENT DEBUG SYSTEM OUTPUT; BYTE PROCCOMP SYN COMMFLAGS(2); COMMENT COMPILING PROC DECL; BYTE TRACE SYN COMMFLAGS(3); COMMENT COMPILER TRACE OPTION; ARRAY 2 LOGICAL TRACEBITS SYN COMMFLAGS(4); SHORT INTEGER BLOCKLISTSIZE, NAMETABLESIZE, NRECCLASS; INTEGER REFRECBASE, IDDIRBASE, IDLISTBASE, INPOINT; INTEGER TREELINK, TREEBASE, TREETOP, EDITBASE; INTEGER TREEORG SYN TREETOP; INTEGER XSN; COMMENT LOWEST ASSIGNED EXTERNAL SEGMENT NUMBER; ARRAY 8 CHARACTER ESDROOT; COMMENT MODULE IDENTIFIER ROOT; ARRAY 256 BYTE ESDICT; COMMENT EXTERNAL PROCEDURE IDENTIFIERS; ARRAY 512 LOGICAL BLOCKLIST; SHORT INTEGER BLENGTH SYN BLOCKLIST(0); COMMENT LENGTH OF NAMETAB; SHORT INTEGER NPOINT SYN BLOCKLIST(2); COMMENT POINTER TO NAMETAB; COMMENT *** SIZE OF OTHER TABLES IS DYNAMIC *** ; ARRAY 3 LOGICAL NAMETABLE; SHORT INTEGER IDLOC1 SYN NAMETABLE(0); SHORT INTEGER IDLOC2 SYN NAMETABLE(2); BYTE HIERARCHY SYN IDLOC2(0); BYTE PROGSEG SYN IDLOC2(1); SHORT INTEGER SIMTYPEINFO SYN NAMETABLE(4); SHORT INTEGER TYPEINFO SYN NAMETABLE(6); BYTE VR SYN TYPEINFO(0); BYTE DIMEN SYN TYPEINFO(1); BYTE RCCLNUMBER SYN TYPEINFO(1); SHORT INTEGER TYPES SYN NAMETABLE(8); BYTE TYPE SYN TYPES(0); BYTE SIMPLETYPE SYN TYPES(1); SHORT INTEGER IDNO SYN NAMETABLE(10); ARRAY 1 SHORT INTEGER REFRECLIST SYN B5; ARRAY 1 LOGICAL IDDIR SYN B3; SHORT INTEGER IDLENGTH SYN IDDIR; SHORT INTEGER IDPOINT SYN IDDIR(2); ARRAY 1 BYTE IDLIST SYN B3; LOGICAL TREE SYN 0; COMMENT PASS TWO OUTPUT; BYTE PROGRAM SYN 0; COMMENT PASS ONE OUTPUT; CLOSE BASE; SEGMENT PROCEDURE PASS1(R10); BEGIN COMMENT PASS 1 -- SCANNER; DUMMY BASE R13; COMMENT WORK AREA SHARED WITH PASS 2; ARRAY 18 LOGICAL SAVEINFO; COMMENT REPEAT PRECEDING DECLARATIONS; ARRAY 16 LOGICAL XFERVECTOR; INTEGER NTBASE SYN XFERVECTOR(0); COMMENT COMMON BASE ADDRESS; ARRAY 5 LOGICAL BASESAVE; LOGICAL PHASEFLAGS; SHORT INTEGER LINENO, PAGENO; LONG REAL PKDEC; ARRAY 132 BYTE HEADING; COMMENT PAGE HEADER; ARRAY 132 BYTE INBUF; ARRAY 132 BYTE OUTPUT SYN INBUF; COMMENT USED FOR ERROR LOG ONLY; ARRAY 4 LOGICAL PRINTEMP; COMMENT * * * LOCAL VARIABLE DECLARATIONS BEGIN HERE * * * ; INTEGER SAVE14, RETADDR; COMMENT REGISTER ALLOCATION R0-R4 GENERAL PURPOSE R5 CONSTANT 1 R6 INDEX TO PASS TWO OUTPUT R7 CURBUF AND NEXTBUF BASE REGISTER R8 INDEX TO NEXT CHARACTER R9 (COUNT-1) OF CHARACTERS REMAINING IN INPUT BUFFER RA-RB PROCEDURE LINKAGE RC-RD DATA BASE REGISTERS RF PROGRAM BASE REGISTER ; INTEGER REGISTER C1 SYN R5; COMMENT CONSTANT 1; INTEGER REGISTER PP SYN R6; COMMENT PROGRAM POINTER; INTEGER REGISTER BB SYN R7; COMMENT CURBUF/NEXTBUF BASE; LOGICAL ARUNVARORG SYN B13(#120); COMMENT BLOCK OF SYSTEM VARIABLES; INTEGER RFRCLISTBASE, RFRCLISTLIMIT, PRBASE, PROGLIMIT; INTEGER IDDBASE, IDLBASE; LOGICAL SAVERB; ARRAY 2 LOGICAL STATE; COMMENT SCANNER STATE FLAGS; BYTE DECLARFLAG SYN STATE(0), ARRAYFLAG SYN STATE(1), PROCFLAG SYN STATE(4), RECORDFLAG SYN STATE(5), REFERFLAG SYN STATE(6), FARRAYFLAG SYN STATE(7); ARRAY 2 LOGICAL FLAGS; COMMENT COMPILER FLAGS; BYTE LISTFLAG SYN FLAGS(0), TRACEFLAG SYN FLAGS(1), EOF SYN FLAGS(2), ENDBLOCK SYN FLAGS(3), ENDDOT SYN FLAGS(4), EFLAG SYN FLAGS(5); BYTE LINEHOLD, BEGINSET; COMMENT LISTING CONTROL; SHORT INTEGER NESTLEVEL; COMMENT BEGIN/END NESTING LEVEL; SHORT INTEGER SYMBOLINDEX, IDDIRINDEX, IDLISTINDEX; SHORT INTEGER BLLIMIT, SCRATCHINDEX; INTEGER LASTIDPTR, LASTIDNO; LOGICAL TYPE; COMMENT FIELD CONTAINING TYPE INFO OF ID BEING PROCESSED; SHORT INTEGER BLOCKNO; SHORT INTEGER DIMCNT; INTEGER FARRAYPNT; SHORT INTEGER ERRORCOUNT; ARRAY 50 LOGICAL ERRORS; ARRAY 50 SHORT INTEGER ERRORCODE SYN ERRORS(0); ARRAY 50 SHORT INTEGER ERRORLOC SYN ERRORS(2); EQUATE ERRORLIMIT SYN 4*50 - 4; INTEGER OUTCHAR,SAVEADD; SHORT INTEGER SCOORD; COMMENT SOURCE REFERENCE COORDINATE; SHORT INTEGER RECORDNO; SHORT INTEGER SIMTYPEINFO; SHORT INTEGER RLISTPOINT; ARRAY 68 LONG REAL SYMBUFFERS; INTEGER CURBUFBASE, NEXTBUFBASE; DUMMY BASE BB; COMMENT CURBUF FORMAT; INTEGER CURBUFTYPE, CURBUFCOUNT; ARRAY 257 BYTE CURBUF; ARRAY 2 LOGICAL CURBUFI SYN CURBUF; LONG REAL CURBUFL SYN CURBUF; ARRAY 256 BYTE CURBUF1 SYN CURBUF(1); CLOSE BASE; DUMMY BASE BB; COMMENT NEXTBUF FORMAT; INTEGER NEXTBUFTYPE, NEXTBUFCOUNT; ARRAY 257 BYTE NEXTBUF; ARRAY 2 LOGICAL NEXTBUFI SYN NEXTBUF; LONG REAL NEXTBUFL SYN NEXTBUF; ARRAY 256 BYTE NEXTBUF1 SYN NEXTBUF(1); CLOSE BASE; ARRAY 64 INTEGER STACK; SHORT INTEGER STACKLNG SYN STACK(4); COMMENT LENGTH FIELD OF STACK; SHORT INTEGER STACKIND SYN STACK(6); COMMENT INDEX TO SCRATCH TAB; INTEGER STACKINDEX; COMMENT POINTER TO TOP OF STACK TABLE; INTEGER STACKMAX; COMMENT MAXIMUM VALUE OF STACKINDEX; EQUATE STACKLIMIT SYN 4*64 - 8; COMMENT PRIVATE COMMON FIELDS KNOWN TO PASS 1; ARRAY 6 SHORT INTEGER SCRATCHNAMETABLE SYN NAMETABLE(2); SHORT INTEGER SCRNAMETAB SYN SCRATCHNAMETABLE(0); SHORT INTEGER SIMTYPEIN SYN SCRATCHNAMETABLE(4); INTEGER TYPEINFO SYN SCRATCHNAMETABLE(6); SHORT INTEGER IDNOSC SYN SCRATCHNAMETABLE(10); ARRAY 1 SHORT INTEGER REFRCDLIST SYN B1; ARRAY 2 SHORT INTEGER IDDIR SYN B12; SHORT INTEGER IDDIRLNG SYN IDDIR(0); SHORT INTEGER IDDIRIND SYN IDDIR(2); BYTE PROGRAMM4 SYN 0; BYTE PROGRAMM3 SYN 1; BYTE PROGRAMM2 SYN 2; BYTE PROGRAMM1 SYN 3; BYTE PROGRAM SYN 4; FUNCTION CL(12,#5500); INTEGER HCODE; ARRAY 512 SHORT INTEGER HASHID; ARRAY 2 LOGICAL CHAININFO; COMMENT STORAGE CONTROL INFO; INTEGER CHAIN SYN CHAININFO(0); ARRAY 0 SHORT INTEGER CHAINID SYN B11; COMMENT HASH CHAIN TABLE, DYNAMICALLY ALLOCATED; SEGMENT BASE R14; COMMENT *** THIS SEGMENT IS READ-ONLY DATA *** ; LONG REAL DBLANK = " "; ARRAY 306 SHORT INTEGER RESERVED = COMMENT MUST BE WORD ALIGNED; (( _1, 12, #9301, 0, "DO " ), ( _1, _1, #FF01, 12, "GO " ), ( 0, 36, #7801, 24, "IF " ), ( _1, 48, #7D01, 36, "IS " ), ( _1, _1, #7C01, 48, "OF " ), ( 24, _1, #8001, 60, "OR " ), ( _1, _1, #8D01, 72, "ABS " ), ( 72, 96, #8601, 84, "AND " ), ( _1, _1, #8401, 96, "DIV " ), ( 84, _1, #6F0D,108, "END " ), (108,132, #9B0A,120, "FOR " ), ( _1,156, #8501,132, "REM " ), ( _1, _1, #8801,144, "SHL " ), (144, _1, #8901,156, "SHR " ), ( _1,180, #080F,168, "BITS" ), ( _1, _1, #7B01,180, "CASE" ), (168, _1, #7A01,192, "ELSE" ), ( _1, _1, #0000,204, "...." ), (192,228, #9401,216, "GOTO" ), ( _1, _1, #8C0B,228, "LONG" ), (216,276, #8201,240, "NULL" ), ( _1,264, #020E,252, "REAL" ), ( _1, _1, #9C01,264, "STEP" ), (252,288, #7901,276, "THEN" ), ( _1, _1, #8A01,288, "TRUE" ), ( _1, _1, #6B01,300, "ALGOL "), (300, _1, #6E13,316, "ARRAY "), (316,380, #970C,332, "BEGIN "), ( _1,364, #8B01,348, "FALSE "), ( _1, _1, #9F01,364, "SHORT "), (348,412, #9D01,380, "UNTIL "), ( _1, _1, #7211,396, "VALUE "), (396, _1, #9E01,412, "WHILE "), ( _1, _1, #9801,428, "ASSERT "), (428,492, #7514,444, "RECORD "), ( _1, _1, #0000,460, "...... "), ( _1, _1, #7312,476, "RESULT "), (476, _1, #0716,492, "STRING "), ( _1,524, #040E,508, "COMPLEX "), ( _1, _1, #6C01,524, "FORTRAN "), (508,556, #010E,540, "INTEGER "), ( _1, _1, #060E,556, "LOGICAL "), ( _1,592, #7115,572, "PROCEDURE "), ( _1, _1, #6810,592, "REFERENCE ")); SHORT INTEGER LLINK SYN RESERVED(0), GLINK SYN RESERVED(2); BYTE CODE1 SYN RESERVED(4), CODE2 SYN RESERVED(5); LOGICAL RSVTEXT SYN RESERVED(8); ARRAY 9 SHORT INTEGER RINDEX = ( _1, 60, 120, 240, 332, 444, 540, _1, 572 ); EQUATE ISYMBOLINDEX SYN 4*204; ARRAY 204 INTEGER NAMETFILL = ( #00000C01, #00000000, #0300001B, #00000000, #00000100, #0800001C, #00000000, #00000100, #0800001D, #00000000, #00000200, #0800001E, #00000000, #00000200, #0800001F, #00000000, #00000200, #08000020, #00000000, #00000100, #08000021, #00000000, #00000001, #07060022, #00000000, #00000001, #07080023, #00000000, #00000008, #07010024, #00000000, #00000007, #07010025, #00000000, #00000001, #07070026, #00000000, #00000002, #07010027, #00000000, #00000002, #07010028, #00000000, #00000002, #07010029, #00000000, #00000002, #0701002A, #00000000, #00000003, #0702002B, #00000000, #00000004, #0702002C, #00000000, #00000004, #0702002D, #00000000, #00000005, #0703002E, #00000000, #00000005, #0703002F, #00000000, #00000002, #07040030, #00000000, #00000003, #07050031, #00000000, #00000002, #07020032, #00000000, #00000002, #07020033, #00000000, #00000002, #07020034, #00000000, #00000002, #07020035, #00000000, #00000002, #07020036, #00000000, #00000002, #07020037, #00000000, #00000002, #07020038, #00000000, #00000003, #07030039, #00000000, #00000003, #0703003A, #00000000, #00000003, #0703003B, #00000000, #00000003, #0703003C, #00000000, #00000003, #0703003D, #00000000, #00000003, #0703003E, #00000000, #00000003, #0703003F, #00000000, #00000100, #08000040, #00000000, #000B0001, #07070041, #00000000, #000B0001, #07070042, #00000000, #000B0002, #07070043, #00000000, #000B0002, #07070044, #00000000, #00130003, #07070045, #00000000, #00130003, #07070046, #00000000, #00000001, #07010047, #00000000, #00000100, #0800005E, @ARUNVARORG(#20), #00000000, #00010048, @ARUNVARORG(#20), #00000000, #00010049, @ARUNVARORG(#1C), #00000000, #0001004A, @ARUNVARORG(#18), #00000000, #0002004B, @ARUNVARORG(#00), #00000000, #0003004C, @ARUNVARORG(#08), #00000000, #0003004D, @ARUNVARORG(#10), #00000000, #0003004E, @ARUNVARORG(#24), #00010001, #0009004F, @ARUNVARORG(#28), #00010001, #00090050, @ARUNVARORG(#2C), #00010001, #00090051, @ARUNVARORG(#30), #00010001, #00090052, @ARUNVARORG(#38), #00010001, #00090053, @ARUNVARORG(#3C), #00010001, #00090054, @ARUNVARORG(#40), #00010001, #00090055, @ARUNVARORG(#44), #00010001, #00090056, @ARUNVARORG(#48), #00010001, #00090057, #000D0000, #00500501, #04000058, #000D000C, #00000001, #05060059, #000D0004, #00000001, #0501005A, #000D0008, #00000001, #0501005B, #000D000D, #00000001, #0506005C, #000D000E, #003F0001, #0507005D ); EQUATE IIDDIRINDEX SYN 2*190; ARRAY 190 SHORT INTEGER IDDIRFILL = (6,_7, 0,_8, 0,_9, 0,_10, 0,_11, 0,_12, 0,_13, 0,_14, 0,_15, 0,_16, 0,_17, 0,_18, 0,_19, 0,_20, 0,_21, 0,_22, 0,_23, 0,_24, 0,_25, 0,_26, 0,_27, 0,_28, 0,_29, 0,_30, 0,_31, 0,_32, 0,_33, 5,_39, 4,_46, 6,_46, 3,_52, 5,_52, 7,_60, 8,_69, 2,_72, 8,_81, 5,_87, 5,_93, 3,_91, 7,_101, 4,_106, 5,_112, 7,_375, 10,_386, 7,_120, 7,_132, 11,_124, 11,_136, 3,_132, 7,_136, 3,_143, 2,_153, 1,_165, 2,_163, 2,_185, 2,_182, 5,_202, 7,_147, 6,_157, 5,_169, 6,_176, 6,_189, 6,_196, 9,_206, 8,_215, 8,_224, 8,_233, 5,_239, 5,_249, 9,_243, 9,_253, 3,_257, 11,_269, 8,_266, 9,_279, 6,_286, 1,_292, 6,_299, 10,_290, 6,_306, 9,_320, 3,_303, 3,_310, 6,_317, 6,_143, 5,_153, 7,_165, 8,_185, 8,_329, 7,_337, 7,_345, 8,_354, 6,_361, 5,_367, 4,_391 ); EQUATE IIDLISTINDEX SYN 392; ARRAY 392 CHARACTER IDLISTFILL = (" TRACE", "ROUNDTOREAL", "EXPONENT", "XCPMSG", "XCPMARK", "XCPACTION", "XCPLIMIT", "XCPNOTED", "EXCEPTION", "INTDIVZERO", "UNFL", "INTOVFL", "MAXREAL", "PI", "LONGEPSILON", "MAXINTEGER", "INTFIELDSIZE", "TIME", "LONGBASE16", "LONGBASE10", "INTBASE16", "INTBASE10", "WRITECARD", "LONGARCTAN", "LONGCOS", "LONGSINCOSERR", "LONGLOG", "LONGLNLOGERR", "LONGEXPERR", "LONGSQRTERR", "LONGIMAGPART", "LONGREALPART", "ENTIER", "ROUND", "TRUNCATE", "DECODE", "NUMBER", "BITSTRING", "ODD", "IOCONTROL", "READCARD", "READON", "WRITEON", "(MAIN)", "ZYXWVUTSRQPONMLKJIHGFEDCBA", "" ); ARRAY 18 BYTE PSYMBOLS = ("?;():=+-*/,<>|#""~."); ARRAY 18 SHORT INTEGER PCODE = (#0002, #7009, #6A06, #6707, #9904, #9001, #7E01, #7F01, #7405, #8301, #6908, #8F03, #9103, #7601, #8E00, #8100, #8703, #9217); COMMENT SPECIAL CODES; EQUATE IDCODE SYN #65, GOCODE SYN #FF; BYTE ID SYN #65, NUMBER SYN #77, STRING SYN #81, BITS SYN #8E, SIMPLETYPE SYN #03, SPECCOMMA SYN #66, SPECCOLON SYN #6D, EXPONENT SYN #A1, ASSIGN SYN #9A, GOTOO SYN #94, ENDFILE SYN #92, NEQ SYN #A0, GEQ SYN #96, LEQ SYN #95; BYTE VOID SYN 0; COMMENT REPLACES DELETED SYMBOLS; COMMENT INSTRUCTIONS TO BE USED WITH EXECUTE INSTRUCTION; ARRAY 256 CHARACTER TRTBLANKS = (64(#03), #00, 10(#03), #06, 18(#03), #07, 28(#03), #05, #03, #02, #03, #04, 65(#03), 9(#01), 7(#03), 9(#01), 8(#03), 8(#01), 6(#03), 10(#02), 6(#03)); ARRAY 256 CHARACTER TRTIDS = (109(#01),#00,83(#01),9(#00),7(#01),9(#00),8(#01), 8(#00),6(#01),10(#00),6(#03)); COMMENT THE NEXT TWO TRANSLATE TABLES OVERLAP AND MUST BE CONTIGUOUS; ARRAY 256 CHARACTER TRRESERVED = (75(0), 34, 22, 4, 12, 26, 12(0), 16, 6, 2, 32, 14, 18, 9(0), 20, 2(0), 24, 11(0), 8, 28, 2(0), 10, 30, 128(0)); ARRAY 162 CHARACTER TRCOMMENT = (#01, 161(#00)); COMMENT SCAN FOR SEMICOLON; ARRAY 256 CHARACTER TRTCOMMENT SYN TRCOMMENT(_94); ARRAY 48 BYTE LETTERIDNO = (0,1,2,3,4,5,6,7,8,9, 7(0), 10,11,12,13,14,15,16,17,18, 8(0), 19,20,21,22,23,24,25,26, 6(0)); CLOSE BASE; PROCEDURE OUTCODE(R11); BEGIN COMMENT R1 HAS CODE TO BE OUTPUT AS 1 BYTE; STC(R1,PROGRAM(PP)); PP := PP + C1; END; PROCEDURE OUTCODE2(R11); BEGIN COMMENT R1 HAS CODE TO BE OUTPUT AS 2 BYTES; STC(R1,PROGRAM(PP+1)); R1 := R1 SHRL 8; STC(R1,PROGRAM(PP)); PP := PP + 2; END; PROCEDURE OUTCODE4(R11); BEGIN COMMENT R2 HAS CODE TO BE OUTPUT AS 4 BYTES; OUTCHAR := R2; MVC(3,PROGRAM(PP),OUTCHAR); PP := PP + 4; END; PROCEDURE OUTSTRING(R10); COMMENT MOVE STRING IN CURBUF TO PROGRAM; BEGIN R1 := CURBUFCOUNT; OUTCODE; EX(R1,MVC(0,PROGRAM(PP),CURBUF1)); PP := PP + R1 + C1; END; PROCEDURE SETTYPE(R10); BEGIN COMMENT R1 HAS PARTIAL TYPE CODE; IF PROCFLAG THEN R1 := R1 OR #1000 ELSE IF RECORDFLAG THEN BEGIN R2 := RECORDNO SHLL 16; R1 := R1 OR R2 OR #500; END; END; PROCEDURE ERROR(R11); BEGIN COMMENT R4 HAS ERROR NUMBER; R1 := ERRORCOUNT + 4; IF R1 = ERRORLIMIT THEN R4 := 11; IF R1 <= ERRORLIMIT THEN BEGIN ERRORCODE(R1) := R4; ERRORCOUNT := R1; R4 := SCOORD; ERRORLOC(R1) := R4; END; END; PROCEDURE SOFTSTOP(R11); GOTO ENDPROGRAM; SEGMENT PROCEDURE FETCHCARD(R11); BEGIN COMMENT PRINTS LAST LINE, READS NEW CARD, DETECTS OPTIONS, SETS R8 = ADDRESS OF NEXT CHARACTER, R9 = (NUMBER - 1) CHARACTERS ON CARD; ARRAY 3 LOGICAL SAVE13; STM(R1,R3,SAVE13); IF LISTFLAG AND LINEHOLD THEN BEGIN RESET(LINEHOLD); R0 := @INBUF; PRINT; END; L: R0 := @INBUF(13); R8 := R0; IF EOF THEN BEGIN R4 := 7; ERROR; SOFTSTOP; END; R3 := AGETCARD; BALR(R2,R3); COMMENT READ; IF ~= OR R0 < 0 THEN BEGIN R8 := @INBUF(80); MVI(";",B8); MVI(";",B8(1)); R9 := 1; SET(EOF); GOTO XIT; END; CLI("@",B8); IF = THEN BEGIN SAVERB := R11; R11 := NTBASE; CLC(4,"DUMP*",B8(1)); IF = THEN BEGIN MVC(0,TRACEFLAG,B8(6)); NI(#0F,TRACEFLAG); MVC(0,TRACE,B8(7)); NI(#0F,TRACE); CLC(1,B8(9)," "); IF = THEN BEGIN R0 := #FFFFFFFF; R1 := R0; END ELSE BEGIN IC(R1,B8(10)); R1 := R1 AND #F; IC(R2,B8(9)); R2 := R2 AND #F * 10S + R1; R0 := #80000000; R1 := R1 - R1; SRDL(R0,B2); R0 := R0 OR TRACEBITS(0); R1 := R1 OR TRACEBITS(4); END; STM(R0,R1,TRACEBITS); GOTO M; END; CLC(4,"STACK",B8(1)); IF = THEN BEGIN SET(STACKFLAG); GOTO M; END; CLC(3,"LIST",B8(1)); IF = THEN BEGIN SET(LISTFLAG); GOTO M; END; CLC(5,"NOLIST",B8(1)); IF = THEN BEGIN RESET(LISTFLAG); GOTO M; END; CLC(6,"NOCHECK",B8(1)); IF = THEN BEGIN TM(#80,SYSOPTIONS); IF = THEN RESET(CHECKFLAG); GOTO M; END; CLC(4,"DEBUG",B8(1)); IF = THEN BEGIN MVC(0,DEBUGFLAG,B8(7)); CLI("0",DEBUGFLAG); IF >= THEN BEGIN NI(#0F,DEBUGFLAG); R2 := @B8(8); END ELSE BEGIN MVI(4,DEBUGFLAG); R2 := @B8(7); END; CLI("(",B2); IF ~= THEN R0 := 2 ELSE BEGIN R0 := R0-R0; R1 := R0; L: R2 := @B2(1); IC(R1,B2(0)); IF R1 ~= ")" AND R1 ~= " " THEN BEGIN R1 := R1 AND #F; R0 := R0*10S + R1; GOTO L; END; END; XFERVECTOR(40) := R0; GOTO M; END; CLC(5,"SYNTAX",B8(1)); IF = THEN BEGIN SET(NOGO); GOTO M; END; CLC(4,"TITLE",B8(1)); IF = THEN BEGIN PROCEDURE SCAN(R3); BEGIN IF R1 > 71 OR R2 > 74 THEN GOTO M; IC(R0,B8(R1)); R1 := @B1(1); END; MVI("1",CARRCONT); MVC(39,HEADING(40),HEADING(36)); R0 := " "; R1 := 6; R2 := 43; WHILE R0 ~= """" DO SCAN; SCAN; S1: STC(R0,HEADING(R2)); R2 := @B2(1); SCAN; IF R0 ~= """" THEN GOTO S1; SCAN; IF R0 = """" THEN GOTO S1; GOTO M; END; R11 := SAVERB; GOTO N; M: R11 := SAVERB; GOTO L; END; N: SET(LINEHOLD); RESET(BEGINSET); MVC(1,INBUF(5),"--"); R9 := 71; R1 := SCOORD; CVD(R1,PKDEC); UNPK(3,7,INBUF,PKDEC); OI("0",INBUF(3)); MVC(7,INBUF(93),INBUF(85)); MVC(7,INBUF(85)," "); XIT: LM(R1,R3,SAVE13); END; PROCEDURE STOP(R1); BEGIN R4 := 12; ERROR; SET(NOPASSTWO); GOTO ENDPROGRAM; END; PROCEDURE INSERTSYMBOL(R11); BEGIN COMMENT R2 HAS ID NUMBER AT ENTRANCE; SAVERB := R11; R11 := NTBASE; R1 := STACKINDEX; R0 := STACKLNG(R1-8) + 12; STACKLNG(R1-8) := R0; R0 := TYPE; R1 := SCRATCHINDEX; IF R1 < SYMBOLINDEX THEN STOP; COMMENT NT OVERFLOW; R3 := R3-R3; SCRNAMETAB(R1) := R3; SCRNAMETAB(R1+2) := R3; TYPEINFO(R1) := R0; IDNOSC(R1) := R2; R3 := SIMTYPEINFO; SIMTYPEIN(R1) := R3; R1 := R1 - 12; SCRATCHINDEX := R1; R11 := SAVERB; END; PROCEDURE PROCESSID(R10); COMMENT LOOK-UP ID, ENTER IN IDDIR IF NECESSARY. R2 := ID NUMBER, ID OUTPUT TO PROGRAM; BEGIN LASTIDPTR := PP; R4 := CURBUFCOUNT; IF R4 = 0 THEN BEGIN R1 := R1-R1; R2 := R1; IC(R1,CURBUF(0)); IC(R2,LETTERIDNO(R1-192)); OUTCODE; END ELSE BEGIN IC(R3,CURBUF(0)); R3 := R3 AND #3F; IC(R1,CURBUF(R4)); R1 := R1 AND #3F SHLL 3 XOR R3; R1 := R1 ++ R1; HCODE := R1; R1 := HASHID(R1); R11 := CHAIN; WHILE R1 ~= 0 DO BEGIN R3 := R1 ++ R1; IF R4 = IDDIRLNG(R3) THEN BEGIN R2 := IDDIRIND(R3) + IDLBASE; EX(R4,CLC(0,B2,CURBUF)); IF = THEN GOTO FOUND; END; R1 := CHAINID(R1); END; COMMENT NOT IN TABLE; R1 := IDDIRINDEX; R2 := IDLISTINDEX - R4 - C1; IDDIRIND(R1) := R2; IDDIRLNG(R1) := R4; R0 := R1 + 4; IDDIRINDEX := R0; IDLISTINDEX := R2; R2 := R2 + IDLBASE; R0 := R0 + IDDBASE; IF R0 > R2 THEN STOP; EX(R4,MVC(0,B2,CURBUF)); R1 := R1 SHRL 1; R4 := HCODE; R2 := HASHID(R4); CHAINID(R1) := R2; HASHID(R4) := R1; FOUND: R2 := R1 SHRL 1; R1 := @ID; OUTCODE; R1 := R2; OUTCODE2; END; LASTIDNO := R2; IF DECLARFLAG THEN BEGIN IF ~REFERFLAG THEN INSERTSYMBOL ELSE BEGIN R1 := RLISTPOINT + 2; RLISTPOINT := R1; R1 := R1 + RFRCLISTBASE; REFRCDLIST := R2; END; END; END; PROCEDURE OPENBLOCK(R10); BEGIN R1 := BLOCKNO + C1; BLOCKNO := R1; R2 := STACKINDEX; IF R1 > BLLIMIT OR R2 >= STACKLIMIT THEN STOP; COMMENT TOO MANY BLOCKS OR NESTING TOO DEEP; STACK(R2) := R1; R1 := SCRATCHINDEX; STACK(R2+4) := R1; R2 := R2 + 8; STACKINDEX := R2; IF R2 > STACKMAX THEN STACKMAX := R2; END; PROCEDURE CLOSEBLOCK(R10); BEGIN LOGICAL SAVERB; SAVERB := R11; R1 := STACKINDEX - 8; IF <= AND ~ENDDOT THEN BEGIN R2 := STACKMAX; L: R2 := R2 - 8; IF <= THEN BEGIN R4 := 4; ERROR; IF ENDBLOCK THEN PP := PP - C1; END ELSE BEGIN R0 := STACK(R2); IF R0 = 0 THEN GOTO L; R3 := SCOORD; SCOORD := R0; R4 := 4; ERROR; SCOORD := R3; R1 := STACK(R2+4); R0 := @VOID; STC(R0,PROGRAM(R1-1)); R0 := R0-R0; STACK(R2) := R0; END; GOTO XIT; END; STACKINDEX := R1; R11 := NTBASE; R3 := STACK(R1) SHLA 2; R0 := STACKLNG(R1); COMMENT R0 = #ID'S*12, R3 = BLOCKLIST INDEX; R2 := SYMBOLINDEX; IF ENDBLOCK THEN BEGIN COMMENT MAKE ENTRY FOR POSSIBLE PROCEDURE; NPOINT(R3) := R2; R4 := R4-R4; NAMETABLE(R2) := R4; NAMETABLE(R2+4) := R4; R4 := #0F000000; NAMETABLE(R2+8) := R4; R2 := R2 + 12; R4 := R0 + 12; BLENGTH(R3) := R4; R4 := SCOORD; END ELSE BEGIN R4 := R4-R4; IF R0 = 0 THEN BLOCKLIST(R3) := R0 ELSE BEGIN NPOINT(R3) := R2; BLENGTH(R3) := R0; END; END; STACK(R1) := R4; R4 := R2 + R0; SYMBOLINDEX := R4; R4 := STACKIND(R1); STACK(R1+4) := PP; SCRATCHINDEX := R4; R2 := @NAMETABLE(R2); R4 := @SCRATCHNAMETABLE(R4); FOR R0 := R0-12 STEP _12 UNTIL 0 DO BEGIN R3 := @B2(12); IF R3 >= R4 THEN STOP; MVC(11,B2,B4); R2 := R3; R4 := R4 - 12; END; XIT: R11 := SAVERB; END; SEGMENT PROCEDURE ADVANCESYMBOL(R10); COMMENT CYCLES BUFFERS, FILLS NEXTBUF WITH NEXT TOKEN ATTRIBUTES; BEGIN PROCEDURE NEXTCHAR(R3); COMMENT R0 := NEXT INPUT CHARACTER; BEGIN R9 := R9 - C1; IF < THEN BEGIN LOGICAL SAVERB; SAVERB := R11; FETCHCARD; R0 := R0-R0; R11 := SAVERB; END ELSE R8 := R8 + C1; IC(R0,B8); END; PROCEDURE NUMBERSCAN(R11); COMMENT PUT EBCDIC FOR NUMBER IN NEXTBUF; BEGIN LOGICAL SAVERB; PROCEDURE ADVANCE(R4); BEGIN LOGICAL SAVER4; R2 := R2 + C1; IF R2 < 256 THEN STC(R0,NEXTBUF1(R2)) ELSE IF R2 = 256 THEN BEGIN SAVER4 := R4; SAVERB := R11; R4 := 2; ERROR; R4 := SAVER4; R11 := SAVERB; END; NEXTCHAR; END; R2 := NEG C1; MVI("0",NEXTBUF); WHILE R0 >= "0" DO ADVANCE; IF R0 = "." THEN BEGIN ADVANCE; WHILE R0 >= "0" DO ADVANCE; END; IF R0 = "'" THEN BEGIN ADVANCE; IF R0 = "+" OR R0 = "-" THEN ADVANCE; IF R0 < "0" THEN BEGIN SAVERB := R11; R4 := 2; ERROR; R11 := SAVERB; END; WHILE R0 >= "0" DO ADVANCE; END; IF R0 = "I" THEN ADVANCE; IF R0 = "L" THEN ADVANCE; IF R2 > 255 THEN R2 := 255; NEXTBUFCOUNT := R2; END; BB := CURBUFBASE; COMMENT CURBUF IS RELEASED AND REFILLED; R1 := R1-R1; R2 := R1; L1: EX(R9,TRT(0,B8,TRTBLANKS)); IF = THEN BEGIN FETCHCARD; GOTO L1; END; R8 := R1; R9 := @INBUF(84) - R8; NEXTBUFTYPE := R2; CASE R2 OF BEGIN BEGIN COMMENT 1 => LETTER ; NEXTBUFL := F01; R2 := R2-R2; R3 := R2; L2: EX(R9,TRT(0,B8,TRTIDS)); IF = THEN BEGIN R4 := @NEXTBUF(R3); R3 := R3 + R9 + C1; IF R3 > 256 THEN BEGIN R2 := @NEXTBUF(255) - R4; IF R2 >= 0 THEN EX(R2,MVC(0,B4,B8)); R3 := 257; END ELSE EX(R9,MVC(0,B4,B8)); FETCHCARD; GOTO L2; END ELSE IF R1 ~= R8 THEN BEGIN R4 := @NEXTBUF(R3); R2 := R1 - R8; R3 := R3 + R2; R2 := R2 - C1; IF R3 > 256 THEN BEGIN R2 := @NEXTBUF(255) - R4; IF R2 >= 0 THEN EX(R2,MVC(0,B4,B8)); R3 := 256; R2 := R1; R4 := 13; ERROR; R1 := R2; END ELSE EX(R2,MVC(0,B4,B8)); END; R3 := R3 - C1; R8 := R1; R9 := @INBUF(84) - R8; NEXTBUFCOUNT := R3; IF R3 = 4 THEN BEGIN CLC(4,NEXTBUF,"BEGIN"); IF = THEN BEGIN R1 := NESTLEVEL + C1; NESTLEVEL := R1; IF ~BEGINSET THEN BEGIN SET(BEGINSET); R0 := 0; R1 := ABS R1/10; STC(R0,INBUF(5)); OI("0",INBUF(5)); END; R1 := SCOORD + C1; SCOORD := R1; END; END ELSE IF R3 = 2 THEN BEGIN CLC(2,NEXTBUF,"END"); IF = THEN BEGIN R0 := 0; R1 := ABS NESTLEVEL / 10; STC(R0,INBUF(6)); OI("0",INBUF(6)); R1 := NESTLEVEL - C1; NESTLEVEL := R1; END; END ELSE IF R3 = 6 THEN BEGIN CLC(6,NEXTBUF,"COMMENT"); IF = THEN BEGIN L3: EX(R9,TRT(0,B8,TRTCOMMENT)); IF = THEN BEGIN FETCHCARD; GOTO L3; END ELSE IF EOF THEN GOTO L1 ELSE BEGIN R8 := R1 + C1; R9 := @INBUF(84) - R8; IF R9 < 0 THEN FETCHCARD; GOTO L1; END; END; END; END; BEGIN COMMENT 2 => DIGIT OR "'" ; R0 := R0-R0; IC(R0,B8); NUMBERSCAN; END; BEGIN COMMENT 3 => PUNCTUATION ; R0 := R0-R0; NEXTBUFCOUNT := R0; IC(R0,B8); STC(R0,NEXTBUF(0)); R9 := R9 - C1; IF < THEN FETCHCARD ELSE R8 := R8 + C1; END; BEGIN COMMENT 4 => """ ; R2 := NEG C1; MVI("""",NEXTBUF); R0 := R0-R0; NEXTCHAR; QUOTE: WHILE R0 ~= """" AND ~EOF DO BEGIN R2 := R2 + C1; IF R2 < 256 THEN STC(R0,NEXTBUF1(R2)) ELSE IF R2 = 256 THEN BEGIN SAVERB := R11; R4 := 8; ERROR; R11 := SAVERB; END; NEXTCHAR; END; NEXTCHAR; IF R0 = """" THEN BEGIN IF R2 < 255 THEN BEGIN R2 := R2 + C1; STC(R0,NEXTBUF1(R2)); END; NEXTCHAR; GOTO QUOTE; END; IF R2 > 255 THEN R2 := 255; NEXTBUFCOUNT := R2; END; BEGIN COMMENT 5 => "#" ; MVI("#",NEXTBUF(0)); R0 := R0-R0; R1 := R0; L4: NEXTCHAR; IF R0 >= "A" AND R0 <= "F" THEN R0 := R0 - #B7 ELSE IF R0 >= "0" AND R0 <= "9" THEN R0 := R0 AND #F ELSE BEGIN NEXTBUFCOUNT := R1; GOTO L5; END; R1 := R1 + C1; IF R1 < 256 THEN STC(R0,NEXTBUF(R1)); GOTO L4; L5: END; BEGIN COMMENT 6 => "." ; R9 := R9 - C1; IF < THEN FETCHCARD ELSE R8 := R8 + C1; CLI("0",B8); IF >= THEN BEGIN R0 := "."; R8 := R8 - C1; R9 := R9 + C1; NUMBERSCAN; R1 := 2; END ELSE BEGIN R1 := 0; NEXTBUFCOUNT := R1; MVI(".",NEXTBUF); R1 := 3; END; NEXTBUFTYPE := R1; END; BEGIN COMMENT 7 => SEMICOLON ; R1 := SCOORD + C1; SCOORD := R1; MVI(";",NEXTBUF(0)); R0 := 0; NEXTBUFCOUNT := R0; R1 := 3; NEXTBUFTYPE := R1; R9 := R9 - C1; IF < THEN FETCHCARD ELSE R8 := R8 + C1; END; END; R1 := NEXTBUFBASE; NEXTBUFBASE := BB; BB := R1; CURBUFBASE := BB; END; PROCEDURE MATCHRESERVED(R10); COMMENT MATCH EBCDIC IN CURBUF WITH RESERVED WORD TABLE. R3 := 0 IF SUCCESSFUL ELSE 1. R1 := CODE, R2 := CASE INDEX; BEGIN LOGICAL RASAVE; R2 := CURBUFCOUNT; R2 := R2 + R2; IF > THEN BEGIN R0 := CURBUFI(0); R4 := RINDEX(R2); IF R2 < 8 THEN BEGIN WHILE R4 >= 0 DO BEGIN CL(R0,RSVTEXT(R4)); IF = THEN GOTO L; IF < THEN R4 := LLINK(R4) ELSE R4 := GLINK(R4); END; END ELSE IF R2 < 16 THEN BEGIN R1 := CURBUFI(4); WHILE R4 >= 0 DO BEGIN CL(R0,RSVTEXT(R4)); IF = THEN BEGIN CL(R1,RSVTEXT(R4+4)); IF = THEN GOTO L; END; IF < THEN R4 := LLINK(R4) ELSE R4 := GLINK(R4); END; END ELSE IF = THEN BEGIN WHILE R4 >= 0 DO BEGIN R3 := @RSVTEXT(R4); CLC(8,CURBUF,B3); IF = THEN GOTO L; IF < THEN R4 := LLINK(R4) ELSE R4 := GLINK(R4); END; END; END; R3 := C1; GOTO D; L: R1 := R1-R1; R2 := R1; R3 := R1; IC(R1,CODE1(R4)); IC(R2,CODE2(R4)); IF R1 = GOCODE THEN BEGIN BB := NEXTBUFBASE; IF C1 ~= NEXTBUFCOUNT THEN BEGIN R3 := C1; BB := CURBUFBASE; END ELSE BEGIN CLC(1,NEXTBUF,"TO"); IF = THEN BEGIN RASAVE := R10; ADVANCESYMBOL; R10 := RASAVE; R1 := @GOTOO; R2 := 1; R3 := R3-R3; END ELSE BEGIN R3 := C1; BB := CURBUFBASE; END; END; END; D: END; PROCEDURE DECODELENGTH(R10); COMMENT DECODE AND CONVERT STRING OR BITS LENGTH SPECIFICATION. R1 := LENGTH (-1 FOR SYNTAX ERROR); BEGIN LOGICAL SAVERA; INTEGER LENGTH; SAVERA := R10; ADVANCESYMBOL; R7 := NEXTBUFBASE; R3 := NEXTBUFTYPE; IF R3 ~= 2 THEN BEGIN R4 := 1; ERROR; R1 := NEG C1; GOTO Y; END; ADVANCESYMBOL; R0 := R0-R0; R1 := R0; FOR R2 := 0 STEP 1 UNTIL CURBUFCOUNT DO BEGIN IC(R0,CURBUF1(R2)); IF R0 < "0" THEN BEGIN R4 := 1; ERROR; R1 := NEG C1; GOTO X; END; R0 := R0 AND #F; R1 := R1*10S + R0; END; X: LENGTH := R1; R7 := NEXTBUFBASE; CLI(")",NEXTBUF); IF = THEN BEGIN ADVANCESYMBOL; R1 := LENGTH; END ELSE BEGIN R4 := 5; ERROR; R1 := NEG C1; END; Y: R10 := SAVERA; END; PROCEDURE MOVETABLE(R10); BEGIN R0 := 256; WHILE R3 >= R0 DO BEGIN MVC(255,B1,B2); R1 := R1 + R0; R2 := R2 + R0; R3 := R3 - R0; END; IF R3 ~= 0 THEN BEGIN DECR(R3); EX(R3,MVC(0,B1,B2)); R1 := @B1(R3+1); END; END; SEGMENT PROCEDURE INITIALIZE(R9); BEGIN R7 := @SYMBUFFERS(0); CURBUFBASE := R7; R7 := @SYMBUFFERS(272); NEXTBUFBASE := R7; LM(R0,R1,COMMLIM); R11 := R0; COMMENT OBTAIN COMMON LIMITS; R6 := R1 - R0; COMMENT COMMON SIZE; R0 := ISYMBOLINDEX-12 SHLL 16 OR 12; BLOCKLIST(0) := R0; R3 := 511; BLLIMIT := R3; R7 := @NAMETABLE; R2 := @NAMETFILL; R1 := R7; R3 := ISYMBOLINDEX; SYMBOLINDEX := R3; MOVETABLE; FOR R5 := 552 STEP 12 UNTIL 732 DO BEGIN R0 := NAMETABLE(R5) AND #FFF OR #D0000; NAMETABLE(R5) := R0; END; COMMENT SET R6 TO SIZE OF DYNAMICALLY ALLOCATED COMMON; R6 := @B11(R6) - R7; IF R6 > #2AAA8 THEN R6 := #2AAA8; R5 := R6 SHRA 4 * 3S AND #FFFFF8; R0 := R5 - 16; SCRATCHINDEX := R0; R7 := R7 + R5; REFRECBASE := R7; RFRCLISTBASE := R7; XC(1,B7,B7); R4 := R6 SHRA 5 AND #FFFFF8; R7 := R7 + R4; RFRCLISTLIMIT := R7; R7 := R7 + 1020; PRBASE := R7; R1 := R6 SHRA 4 AND #FFFFF8; IF R1 < #2000 THEN R0 := R1 ELSE R0 := #2000; R3 := AGETMAIN; BALR(R2,R3); COMMENT GETMAIN; STM(R0,R1,CHAININFO); R5 := R1 * 3S AND #FFFFF8; R8 := COMMLIM(4) AND #FFFFF8; IDLISTBASE := R8; IDLBASE := R8; R3 := IIDLISTINDEX; R0 := NEG R3; IDLISTINDEX := R0; R1 := R8 - R3; R2 := @IDLISTFILL; MOVETABLE; R8 := R8 - R5; IDDIRBASE := R8; IDDBASE := R8; R3 := IIDDIRINDEX; IDDIRINDEX := R3; R1 := R8; R2 := @IDDIRFILL; MOVETABLE; R7 := @B7(4); INPOINT := R7; PROGLIMIT := R8; XC(7,STATE,STATE); XC(7,FLAGS,FLAGS); SET(LISTFLAG); RESET(NOGO); MVI(0,TRACE); SET(CHECKFLAG); TM(#20,SYSOPTIONS);IF = THEN MVI(1,DEBUGFLAG) ELSE MVI(2,DEBUGFLAG); RESET(DEBUG); RESET(PROCCOMP); MVC(7,ESDROOT,"AWXSC001"); XC(7,TRACEBITS,TRACEBITS); RESET(STACKFLAG); RESET(NOPASSTWO); R0 := _4; ERRORCOUNT := R0; R0 := 0; STACKINDEX := R0; BLOCKNO := R0; SCOORD := R0; RLISTPOINT := R0; DIMCNT := R0; TYPE := R0; SIMTYPEINFO := R0; STACKMAX := R0; NESTLEVEL := R0; RESET(LINEHOLD); R0 := 1; RECORDNO := R0; F01 := DBLANK; MVI(" ",INBUF); MVC(130,INBUF(1),INBUF); XC(255,HASHID,HASHID); MVC(255,HASHID(256),HASHID); MVC(255,HASHID(512),HASHID); MVC(255,HASHID(768),HASHID); R12 := IDDBASE; R11 := CHAIN; R2 := IDDIRINDEX-4; R3 := R2 SHRA 1; FOR R2 := R2 STEP _4 UNTIL 108 DO BEGIN R4 := IDDIRLNG(R2); R1 := IDDIRIND(R2) + IDLBASE; IC(R0,B1(0)); R0 := R0 AND #3F; IC(R1,B1(R4)); R1 := R1 AND #3F SHLL 3 XOR R0; R1 := R1 ++ R1; R4 := HASHID(R1); CHAINID(R3) := R4; HASHID(R1) := R3; R3 := R3 - 2; END; BB := CURBUFBASE; PP := PRBASE + 1; C1 := 1; OPENBLOCK; END; SEGMENT PROCEDURE CLEANUP(R9); BEGIN IF LISTFLAG AND LINEHOLD THEN BEGIN RESET(LINEHOLD); R0 := @INBUF; PRINT; END; SET(ENDDOT); SET(ENDBLOCK); CLOSEBLOCK; R1 := STACKINDEX; WHILE R1 > 0 DO BEGIN CLOSEBLOCK; R4 := 3; ERROR; COMMENT ERROR NO 3; R1 := STACKINDEX; END; R0 := 31; FOR R1 := IDDIRINDEX-4 STEP _4 UNTIL IIDDIRINDEX DO IF R0 < IDDIRLNG(R1) THEN IDDIRLNG(R1) := R0; MVI(" ",OUTPUT); MVC(130,OUTPUT(1),OUTPUT); R11 := NTBASE; MVC(39,HEADING(40),HEADING(36)); TM(#40,SYSOPTIONS); IF OVERFLOW THEN MVI(0,DEBUGFLAG); CLI(2,DEBUGFLAG); IF > THEN SET(DEBUG); MVC(25,OUTPUT,"EXECUTION OPTIONS: DEBUG,0"); OC(0,OUTPUT(25),DEBUGFLAG); OI("0",CARRCONT); IF ~CHECKFLAG THEN MVC(6,OUTPUT(27),"NOCHECK"); R0 := @OUTPUT; PRINT; MVC(39,OUTPUT,OUTPUT(40)); MVC(22,HEADING(46),"COMPILATION DIAGNOSTICS"); MVI("1",CARRCONT); R3 := ERRORCOUNT; IF R3 >= 0 THEN BEGIN SET(NOGO); MVC(25,OUTPUT(1),"ERROR 1XXX NEAR COORDINATE"); FOR R3 := 0 STEP 4 UNTIL ERRORCOUNT DO BEGIN R1 := ERRORCODE(R3); CVD(R1,PKDEC); UNPK(2,1,OUTPUT(8),PKDEC(6)); OI("0",OUTPUT(10)); CASE R1 OF BEGIN MVC(29,OUTPUT(35),"INCORRECTLY FORMED DECLARATION"); MVC(17,OUTPUT(35),"INCORRECT CONSTANT"); MVC(12,OUTPUT(35),"MISSING ""END"""); MVC(24,OUTPUT(35),"UNMATCHED ""END"" (DELETED)"); MVC(10,OUTPUT(35),"MISSING "")"""); MVC(16,OUTPUT(35),"ILLEGAL CHARACTER"); MVC(16,OUTPUT(35),"MISSING FINAL ""."""); MVC(20,OUTPUT(35),"INVALID STRING LENGTH"); MVC(18,OUTPUT(35),"INVALID BITS LENGTH"); MVC(10,OUTPUT(35),"MISSING ""("""); MVC(19,OUTPUT(35),"ERROR TABLE OVERFLOW"); MVC(22,OUTPUT(35),"COMPILER TABLE OVERFLOW"); MVC(14,OUTPUT(35),"ID LENGTH > 256"); MVC(13,OUTPUT(35),"UNEXPECTED ""."""); MVC(22,OUTPUT(35),"TOO MANY RECORD CLASSES"); END; R1 := ERRORLOC(R3); CVD(R1,PKDEC); UNPK(3,7,OUTPUT(28),PKDEC); OI("0",OUTPUT(31)); MVI("-",OUTPUT(33)); OI("0",CARRCONT); R0 := @OUTPUT; PRINT; MVC(40,OUTPUT(35),OUTPUT(75)); END; END; R3 := RECORDNO; NRECCLASS := R3; R3 := BLOCKNO SHLL 2; BLOCKLISTSIZE := R3; R3 := SYMBOLINDEX - 12; NAMETABLESIZE := R3; R1 := @NAMETABLE + SYMBOLINDEX + 19 AND #FFFFF8; R2 := REFRECBASE; R3 := RLISTPOINT + 2; REFRECBASE := R1; MOVETABLE; R1 := R1 + 7 AND #FFFFF8 + 1024; COMMENT ALLOW LIT TABLE SPACE; R2 := INPOINT; R3 := R6 + 11 AND #FFFFF8 - INPOINT; INPOINT := R1; MOVETABLE; R1 := R1 + 7 AND #FFFFF8; TREEBASE := R1; R1 := IDDIRINDEX + 255 AND #FFFF00; R1 := @IDDIR(R1); R2 := IDLISTBASE + IDLISTINDEX AND #FFFFF8; R0 := R2 - 256; IF R0 > R1 THEN FOR R1 := R1-256 STEP _256 UNTIL IDDIRBASE DO BEGIN R2 := R2 - 256; MVC(255,B2,B1); END; IDDIRBASE := R2; LM(R0,R1,CHAININFO); R3 := AFREEMAIN; BALR(R2,R3); END; SAVE14 := R14; RETADDR := R10; INITIALIZE; FETCHCARD; ADVANCESYMBOL; COMMENT PRIME SCANNER; COMMENT * * * MAIN PASS1 ROUTINE BEGINS HERE * * * ; L: ADVANCESYMBOL; R3 := CURBUFTYPE; IF PP >= PROGLIMIT THEN STOP; COMMENT MEMORY OVERFLOW; CASE R3 OF BEGIN BEGIN COMMENT 1 => IDENTIFIER, RESERVED WORD ; MATCHRESERVED; IF R3 ~= 0 THEN BEGIN PROCESSID; GOTO L; END; END; BEGIN COMMENT 2 => NUMBER ; R2 := CURBUFCOUNT; IF R2 = 0 THEN BEGIN CLI("'",CURBUF1(0)); IF ~= THEN BEGIN IC(R1,CURBUF1(0)); OUTCODE; END; END ELSE BEGIN R1 := @NUMBER; OUTCODE; OUTSTRING; END; GOTO L; END; BEGIN COMMENT 3 => PUNCTUATION ; R1 := R1-R1; R2 := R1; IC(R2,CURBUF(0)); IC(R1,TRRESERVED(R2)); IC(R2,PCODE(R1+1)); IC(R1,PCODE(R1)); END; BEGIN COMMENT 4 => STRING LITERAL (") ; R1 := @STRING; OUTCODE; R1 := CURBUFCOUNT; IF R1 < 0 THEN BEGIN R4 := 8; ERROR; R1 := R1-R1; CURBUFCOUNT := R1; END; OUTSTRING; GOTO L; END; BEGIN COMMENT 5 => BITS LITERAL (#) ; R1 := @BITS; OUTCODE; R1 := CURBUFCOUNT; R0 := 0; R2 := R0; IF R1 = 0 OR R1 > 8 THEN BEGIN R4 := 9; ERROR; END ELSE FOR R3 := 1 STEP 1 UNTIL R1 DO BEGIN IC(R0,CURBUF(R3)); R2 := R2 SHLL 4 OR R0; END; OUTCODE4; GOTO L; END; END; COMMENT HERE R1 = OUTPUT CODE, R2 = PROCESSING CODE; L1: CASE R2 OF BEGIN OUTCODE; COMMENT SYMBOLS NEEDING NO PROCESSING; 1 BEGIN COMMENT INVALID CHARACTERS ; 2 R4 := 6; ERROR; END; BEGIN COMMENT ~, >, < ; 3 R2 := R2-R2; IC(R2,CURBUF(0)); BB := NEXTBUFBASE; CLI("=",NEXTBUF); IF ~= THEN OUTCODE ELSE BEGIN IF R2 = "~" THEN R1 := @NEQ ELSE IF R2 = ">" THEN R1 := @GEQ ELSE R1 := @LEQ; OUTCODE; ADVANCESYMBOL; END; END; BEGIN COMMENT : ; 4 BB := NEXTBUFBASE; CLI("=",NEXTBUF); IF = THEN BEGIN R1 := @ASSIGN; OUTCODE; ADVANCESYMBOL; END ELSE BEGIN CLI(":",NEXTBUF); IF = THEN BEGIN R1 := @SPECCOLON; OUTCODE; ADVANCESYMBOL; END ELSE BEGIN OUTCODE; R1 := PP - LASTIDPTR; IF R1 = 2 OR R1 = 4 THEN BEGIN R1 := #100; TYPE := R1; R1 := 0; SIMTYPEINFO := R1; R2 := LASTIDNO; INSERTSYMBOL; END; END; END; END; BEGIN COMMENT * ; 5 BB := NEXTBUFBASE; CLI("*",NEXTBUF); IF = THEN BEGIN R1 := @EXPONENT; OUTCODE; ADVANCESYMBOL; END ELSE BEGIN OUTCODE; IF FARRAYFLAG THEN BEGIN R1 := DIMCNT + C1; DIMCNT := R1; END; END; END; BEGIN COMMENT ( ; 6 IF ARRAYFLAG THEN BEGIN RESET(ARRAYFLAG); RESET(DECLARFLAG); IF PROCFLAG THEN SET(FARRAYFLAG); END; OUTCODE; END; BEGIN COMMENT ) ; 7 OUTCODE; R1 := STATE(4); IF R1 ~= 0 THEN BEGIN IF REFERFLAG THEN BEGIN RESET(REFERFLAG); R1 := RLISTPOINT + 2; RLISTPOINT := R1; R2 := R2-R2; R1 := R1 + RFRCLISTBASE; REFRCDLIST := R2; IF R1 >= RFRCLISTLIMIT THEN STOP; END ELSE IF RECORDFLAG THEN BEGIN RESET(RECORDFLAG); RESET(DECLARFLAG); END ELSE IF PROCFLAG THEN BEGIN IF FARRAYFLAG THEN BEGIN RESET(FARRAYFLAG); R1 := DIMCNT; R11 := NTBASE; FOR R2 := SCRATCHINDEX + 12 STEP 12 UNTIL FARRAYPNT DO STC(R1,TYPEINFO(R2+1)); R1 := R1 - R1; DIMCNT := R1; END ELSE BEGIN CLOSEBLOCK; RESET(PROCFLAG); RESET(DECLARFLAG); END; END; END; END; BEGIN COMMENT , ; 8 IF DECLARFLAG THEN R1 := @SPECCOMMA; OUTCODE; END; BEGIN COMMENT SEMICOLON; 9 OUTCODE; RESET(DECLARFLAG); RESET(REFERFLAG); RESET(ARRAYFLAG); RESET(FARRAYFLAG); R1 := 0; SIMTYPEINFO := R1; SETTYPE; TYPE := R1; END; BEGIN COMMENT FOR; 10 OUTCODE; OPENBLOCK; BB := NEXTBUFBASE; IF C1 = NEXTBUFTYPE THEN BEGIN ADVANCESYMBOL; MATCHRESERVED; IF R3 = 0 THEN BEGIN COMMENT RESERVED WORD - SAVE CODES & CLOSE BLOCK; ARRAY 2 INTEGER CODESAVE; STM(R1,R2,CODESAVE); CLOSEBLOCK; LM(R1,R2,CODESAVE); GOTO L1; END; PROCESSID; R3 := #0601; TYPE := R3; INSERTSYMBOL; R3 := R3-R3; TYPE := R3; END; CLOSEBLOCK; END; BEGIN COMMENT LONG ; 11 BB := NEXTBUFBASE; IF C1 = NEXTBUFTYPE THEN BEGIN R4 := NEXTBUFCOUNT; IF R4 = 3 THEN BEGIN CLC(3,NEXTBUF,"REAL"); IF ~= THEN GOTO X; R1 := 3; END ELSE IF R4 = 6 THEN BEGIN CLC(6,NEXTBUF,"COMPLEX"); IF ~= THEN GOTO X; R1 := 5; END ELSE GOTO X; SET(DECLARFLAG); SETTYPE; TYPE := R1; ADVANCESYMBOL; R1 := @SIMPLETYPE; OUTCODE; R1 := TYPE AND #F; END; X: OUTCODE; END; BEGIN COMMENT BEGIN ; 12 OUTCODE; OPENBLOCK; END; BEGIN COMMENT END; 13 OUTCODE; SET(ENDBLOCK); CLOSEBLOCK; RESET(ENDBLOCK); BB := NEXTBUFBASE; IF C1 = NEXTBUFTYPE THEN BEGIN ADVANCESYMBOL; MATCHRESERVED; IF R3 = 0 THEN GOTO L1; END; END; BEGIN COMMENT INTEGER, REAL, COMPLEX, LOGICAL (R1 = TYPE) ; 14 SET(DECLARFLAG); SETTYPE; TYPE := R1; R0 := R0-R0; SIMTYPEINFO := R0; R1 := @SIMPLETYPE; OUTCODE; R1 := TYPE AND #F; OUTCODE; END; BEGIN COMMENT BITS; 15 SET(DECLARFLAG); SETTYPE; TYPE := R1; R1 := @SIMPLETYPE; OUTCODE; R1 := 8; OUTCODE; BB := NEXTBUFBASE; CLI("(",NEXTBUF); IF = THEN BEGIN DECODELENGTH; IF R1 >= 0 AND R1 ~= 32 THEN BEGIN R4 := 1; ERROR; END; END; END; BEGIN COMMENT REFERENCE; 16 OUTCODE; R1 := RLISTPOINT+2; SIMTYPEINFO := R1; R1 := 9; SETTYPE; TYPE := R1; SET(DECLARFLAG); BB := NEXTBUFBASE; CLI("(",NEXTBUF); IF = THEN BEGIN ADVANCESYMBOL; SET(REFERFLAG); END ELSE BEGIN R4 := 10; ERROR; END; END; BEGIN COMMENT VALUE; 17 OUTCODE; R1 := #1000000 OR TYPE; TYPE := R1; END; BEGIN COMMENT RESULT; 18 OUTCODE; R1 := #2000000 OR TYPE; TYPE := R1; END; BEGIN COMMENT ARRAY; 19 OUTCODE; SET(ARRAYFLAG); IF PROCFLAG THEN BEGIN R2 := SCRATCHINDEX; FARRAYPNT := R2; END; R1 := #000200 OR TYPE; TYPE := R1; END; BEGIN COMMENT RECORD; 20 OUTCODE; R1 := RECORDNO + 1; RECORDNO := R1; IF R1 > 15 THEN BEGIN R4 := 15; ERROR; END; R1 := R1 SHLL 16 OR #0400; TYPE := R1; SET(RECORDFLAG); SET(DECLARFLAG); END; BEGIN COMMENT PROCEDURE; 21 OUTCODE; SET(DECLARFLAG); IF PROCFLAG THEN BEGIN R1 := TYPE OR #1300; TYPE := R1; END ELSE BEGIN R1 := TYPE OR #0300; TYPE := R1; BB := NEXTBUFBASE; IF C1 = NEXTBUFTYPE THEN BEGIN ADVANCESYMBOL; MATCHRESERVED; IF R3 = 0 THEN GOTO L1; BB := NEXTBUFBASE; CLI("(",NEXTBUF); BB := CURBUFBASE; IF ~= THEN BEGIN PROCESSID; OPENBLOCK; CLOSEBLOCK; END ELSE BEGIN R1 := BLOCKNO + 1 SHLL 16 OR TYPE; TYPE := R1; PROCESSID; R1 := R1-R1; TYPE := R1; OPENBLOCK; SET(PROCFLAG); END; R1 := BLOCKNO; IF R1 = 2 THEN BEGIN R11 := NTBASE; SET(PROCCOMP); MVC(7,ESDROOT,"#####001"); R1 := CURBUFCOUNT; IF R1 > 4 THEN R1 := 4; EX(R1,MVC(0,ESDROOT,CURBUF)); END; END; END; END; BEGIN COMMENT STRING; 22 SET(DECLARFLAG); SETTYPE; TYPE := R1; R1 := @SIMPLETYPE; OUTCODE; R1 := 7; OUTCODE; BB := NEXTBUFBASE; CLI("(",NEXTBUF); IF ~= THEN R1 := 16 ELSE BEGIN DECODELENGTH; IF R1 < 0 THEN R1 := C1 ELSE IF R1 = 0 OR R1 > 256 THEN BEGIN R4 := 1; ERROR; R1 := C1; END; END; OUTCODE; R1 := R1 - C1; SIMTYPEINFO := R1; END; BEGIN COMMENT . ; 23 IF EOF THEN GOTO ENDPROGRAM ELSE BEGIN R4 := 14; ERROR; END; END; END; GOTO L; ENDPROGRAM: R1 := @ENDFILE; OUTCODE; CLEANUP; R10 := RETADDR; END; COMMENT END OF PASS 1; SEGMENT PROCEDURE PASS2(R10); BEGIN INTEGER REGISTER I SYN R7, J SYN R8; COMMENT STACK POINTERS; LOGICAL RASAVE; INTEGER SAVE14, METABASE; INTEGER COMMONBASE SYN XFERVECTOR(0); INTEGER SCOORD; COMMENT SOURCE TEXT COORDINATE; BYTE FLAG, ERRFLAG; BYTE UNDECLFLAG, COMMONFLAG; BYTE SIMTYPE, STRINGLENGTH; INTEGER VALUE; ARRAY 0 BYTE EDITCODE SYN 0; COMMENT COMPILED EDITING STRING; INTEGER EDITINDEX, NODEINDEX, OLDINPOINT, OLDEDIT; INTEGER NODECHAIN; COMMENT PTR TO LAST COUNT IN EDITCODE; INTEGER CHARTLEVEL; COMMENT GRAPHIC NESTING LEVEL; BYTE SIGN; INTEGER SCALE; LONG REAL FCONV; COMMENT FOR CONVERSION; ARRAY 2 LONG REAL NUMBUFFER; LONG REAL NUMVALUE SYN NUMBUFFER(8); INTEGER INUMVALUE SYN NUMVALUE(4), NUMVALHIGH SYN NUMVALUE(0); LONG REAL DEC SYN PKDEC; INTEGER HEX SYN PKDEC; DUMMY BASE R12; COMMENT ALLOCATED FROM WORK SPACE; ARRAY 8 LOGICAL PARSEREG; COMMENT PARSE LOOP REGISTER IMAGE; INTEGER R3SAVE SYN PARSEREG(8); INTEGER RULENUMBER SYN PARSEREG(16); INTEGER R6SAVE SYN PARSEREG(20); INTEGER ISAVE SYN PARSEREG(24), JSAVE SYN PARSEREG(28); INTEGER OUTBASE; COMMENT BASE OF CURRENT TREE SEGMENT; INTEGER PLIMIT; COMMENT MAXIMUM P INDEX; ARRAY 0 LONG REAL PALIGN; COMMENT ALIGN P; ARRAY 0 LOGICAL P; COMMENT OUTPUT WORK AREA, SIZE IS DYNAMIC; BYTE OP SYN P; BYTE CONV SYN P(1); SHORT INTEGER POINTER SYN P(2); SHORT INTEGER PSTACK SYN P; CLOSE BASE; ARRAY 32 SHORT INTEGER DISPLAY; COMMENT STATIC LINK CHAIN; INTEGER BN, BLC; COMMENT BLOCK NO., NESTING LEVEL; INTEGER HN; COMMENT HIERARCHY NUMBER; INTEGER IHN; COMMENT IMPLICIT SUBROUTINE HN; INTEGER DISPLAYORG; COMMENT SEGMENT DISPLAY ORIGIN; INTEGER DRELAD; COMMENT LOCAL VARIABLE BASE; INTEGER SN, SNC; COMMENT MAXIMUM, CURRENT SEGMENT NO.; SHORT INTEGER CTPNT; COMMENT CONSTANTTABLE POINTER; SHORT INTEGER LITPNT; COMMENT LITERALTABLE POINTER; SHORT INTEGER CTORG, LITORG; ARRAY 0 LOGICAL LITERALTABLE SYN B3; COMMENT LITERALS (DYNAMIC); INTEGER LITBASE; ARRAY 96 BYTE S; COMMENT PARSER SYMBOL STACK; ARRAY 96 BYTE S2; COMMENT STACK OF RELATIONS; ARRAY 96 LONG REAL V; COMMENT INTERPRETATION STACK; LOGICAL V12 SYN V(0); SHORT INTEGER V1 SYN V(0); SHORT INTEGER V2 SYN V(2); COMMENT BOTH TYPE FIELDS; BYTE V21 SYN V2(0); COMMENT TYPE; BYTE V22 SYN V2(1); COMMENT SIMPLE TYPE; SHORT INTEGER V34 SYN V(4); COMMENT REGISTER FIELDS; BYTE V3 SYN V34(0); COMMENT GENERAL REGISTER COUNT; BYTE V4 SYN V34(1); COMMENT FLOATING REGISTER COUNT; SHORT INTEGER V5 SYN V(6); COMMENT OUTPUT POINTER FIELD; ARRAY 96 LONG REAL T; COMMENT EDITCODE INTERPRETATION STACK; LOGICAL VA SYN T(0); COMMENT ATTRIBUTE BITS; SHORT INTEGER T0 SYN VA(0); INTEGER VX SYN T(4); COMMENT EDITCODE POINTER; INTEGER LABELADDR; ARRAY 256 INTEGER CONSTANTTABLE; SHORT INTEGER CINFO SYN CONSTANTTABLE; BYTE CLENGTH SYN CONSTANTTABLE; BYTE CTYPE SYN CONSTANTTABLE(1); SHORT INTEGER CADDR SYN CONSTANTTABLE(2); INTEGER TREELENGTH, INPOINTSAVE; SEGMENT BASE R14; COMMENT *** READ ONLY CONSTANTS *** ; ARRAY 7 LONG REAL POWER10 = (#41A0000000000000L, #4264000000000000L, #4427100000000000L, #475F5E1000000000L, #4E2386F26FC10000L, #5B4EE2D6D415B85BL, #76184F03E93FF9F5L); EQUATE LSS SYN #1, GTR SYN #2, EQL SYN #3; EQUATE DPDORG SYN 40; COMMENT STACK MARK LENGTH; ARRAY 8 BYTE MASK = (" ",5(#20),2(" ")), MASK2 = (" ",3(#20),2(#21),2(" ")); ARRAY 256 BYTE INPUTSW = (10, 2(0), 8, 97(0), 3, 10(1), 9, 6(1), 5, 9(1), 6, 12(1), 7, 8(1), 9, 11(1), 30(0), 9(2), 7(0), 9(2), 8(0), 8(2), 6(0), 10(4), 6(0)); ARRAY 16 CHARACTER TRANSTABLE = ("0123456789ABCDEF"); ARRAY 48 BYTE LETTERIDNO = (0,1,2,3,4,5,6,7,8,9, 7(0), 10,11,12,13,14,15,16,17,18, 8(0), 19,20,21,22,23,24,25,26, 6(0)); ARRAY 10 BYTE LENGTHTABLE = (0, 2(4), 2(8), 16, 1, 0, 2(4)); ARRAY 17 SHORT INTEGER BITTABLE = (#0, #1, #2, #4, #8, #10, #20, #40, #80, #100, #200, #400, #800, #1000, #2000, #4000, #8000); ARRAY 10 SHORT INTEGER INCREASE = (0, 1, #100, #100, #200, #200, 1, 2, 1, 1); EQUATE IDCODE SYN #65, NUMBERCODE SYN #77, STRINGCODE SYN #81, ENDFILE SYN #92, APARHEAD SYN #1C, TPROCHD SYN #0A; BYTE COLON1 SYN #99; EQUATE COMMENT SYMBOLS DISTINGUISHED IN ERROR RECOVERY; BEGINCODE SYN #97, ENDCODE SYN #6F, SCOLCODE SYN #70, BHCODE SYN #29, BBCODE SYN #28, BBEXPCODE SYN #21, CASESEQCODE SYN #2D, PROCNT SYN #0C, PROCDCL SYN #08, GOTOCODE SYN #94, LPARCODE SYN #6A, FORCODE SYN #9B, FORCLCODE SYN #2E, FORLISTCODE SYN #30, FORHD SYN #2F, BNDLSTHD SYN #07; EQUATE TRACEINDEX SYN 540; COMMENT TRACE NT INDEX; ARRAY 3 SHORT INTEGER MOVE = (#D200S,@BUFFER(75),@B1), ERRMOVE = (#D200S,@BUFFER(65),@B1), ERRMOVE1 = (#D200S,@BUFFER(36),@B1), MOVE31=(#D200S,@B3,@B1), MOVE14=(#D200S,@B1,@B4), COMPARE24=(#D500S,@B2,@B4), TREEMOVE=(#D200S,@B2(4),@B4), MOVE24=(#D200S,@B2,@B4), MOVENUMBER=(#D200S,@NUMVALUE,@B5); BYTE PLUS SYN 1 ; BYTE MINUS SYN 2 ; BYTE TIMES SYN 3 ; BYTE DIVIDE SYN 4 ; BYTE EXPON SYN 5; BYTE LCOLONEQ SYN 6; SHORT INTEGER LASSIGN = @LCOLONEQ; BYTE ACOLONEQ SYN 7; SHORT INTEGER AASSIGN = @ACOLONEQ; BYTE SCOLONEQ SYN 8; SHORT INTEGER SASSIGN = @SCOLONEQ; BYTE RCOLONEQ SYN 9; SHORT INTEGER RASSIGN = @RCOLONEQ; BYTE STEPUNTIL SYN 12; BYTE DIV SYN 13; BYTE REM SYN 14; BYTE LESS SYN 15; BYTE LESSEQ SYN 16; BYTE GREATER SYN 17; BYTE GTEQ SYN 18; BYTE EQUAL SYN 19; BYTE UNEQ SYN 20; BYTE LCOLONEQ2 SYN 22; BYTE ACOLONEQ2 SYN 23; BYTE SCOLONEQ2 SYN 24; BYTE RCOLONEQ2 SYN 25; BYTE APPAREN SYN 29; BYTE INDX SYN 30; BYTE REFX SYN 31; BYTE IFEXP SYN 32; BYTE COMMA SYN 33; BYTE LCOMMA SYN 34; BYTE SHL SYN 35; BYTE SHR SYN 36; BYTE BBB SYN 37; BYTE ENDD SYN 38; BYTE PCL SYN 39; BYTE SUBSTRING SYN 40; BYTE BAR SYN 41; BYTE APCOMMA SYN 42; BYTE RCOMMA SYN 43; BYTE ARCOMMA SYN 44; BYTE ARPAREN SYN 45; BYTE RPAREN SYN 46; BYTE LOGOR SYN 47; BYTE BITOR SYN 48; BYTE LOGAND SYN 49; BYTE BITAND SYN 50; BYTE ITERST SYN 51; BYTE ITERST2 SYN 52; BYTE FORLIST SYN 53; BYTE FORCL SYN 54; BYTE ENDFORLIST SYN 55; BYTE UJIFEXP SYN 56; BYTE UJ SYN 57; BYTE CLL SYN 58; BYTE IFST SYN 59; BYTE COLON SYN 60; BYTE IS SYN 61; BYTE IFST2 SYN 62; BYTE WHILEOP SYN 64; BYTE WHILEST SYN 65; BYTE IFJ SYN 66; COMMENT UNARY OPERATORS; BYTE UMINUS SYN 67; BYTE ABSS SYN 68; BYTE LOGNOT SYN 71; BYTE BITNOT SYN 72; BYTE ASSERT SYN 73; BYTE EXIT SYN 74; BYTE GOTOO SYN 75; BYTE CARD SYN 79; SHORT INTEGER CARDD = @CARD; BYTE CASEIDX SYN 80; SHORT INTEGER CASEIDXX = @CASEIDX; BYTE UCOUNT SYN 81; COMMENT TERMINAL NODES; BYTE BEGINN SYN 83; BYTE INUMBER SYN 85; BYTE NUMBER SYN 86; BYTE ID SYN 87; BYTE LABELID SYN 88; BYTE ARRAYID SYN 89; BYTE FUNCID SYN 90; SHORT INTEGER FUNCIDD = @FUNCID; BYTE RCCLID SYN 91; BYTE FIELDID SYN 92; BYTE CONID SYN 93; BYTE FTN SYN 94; BYTE PROCDC SYN 95; BYTE CONTROL SYN 97; BYTE BITT SYN 98; BYTE STRINGG SYN 99; BYTE TRUE SYN 100; BYTE FALSE SYN 101; BYTE WHILEE SYN 102; BYTE NUL SYN 103; BYTE NULLST SYN 104; BYTE ARRAYDC SYN 105; BYTE ARSTAR SYN 106; BYTE STFUNCID SYN 107; BYTE STPROCID SYN 108; BYTE IFF SYN 109; BYTE COMMENT EDIT CODE CONTROL OPERATORS; JB SYN #00, JC SYN #01, PV SYN #02, SEMI1 SYN #A3, UPOS SYN #A4, UNEG SYN #A5, SPACECODE SYN #A6, NTAB SYN #DA, LTAB0 SYN #DB, RTAB0 SYN #DC, JD SYN #EA, JAD SYN #EB, JPD SYN #EC, FD SYN #ED, VRSTOP SYN #EE, JLOOP SYN #EF, LTAB SYN #FA, LTAB1 SYN #FB, COUNTCODE SYN #FC, COUNTCODE1 SYN #FD, RTAB SYN #FE, RTAB1 SYN #FF; ARRAY 163 SHORT INTEGER MTB = (0,1,2,13,31,43,44,56,73,74,75,102,108,119,120,136,185,195,208,220, 221,238,245,253,261,262,269,294,303,338,365,366,379,390,396,403,426, 427,428,433,443,483,512,513,518,519,542,552,570,583,590,591,601,626, 632,633,634,635,696,697,728,729,748,749,762,768,769,770,780,790,800, 806,811,817,823,824,825,826,827,828,829,830,831,832,833,834,835,836, 837,838,839,840,841,842,843,844,845,846,847,848,849,850,892,893,894, 900,901,954,955,956,957,958,959,960,966,967,968,969,975,981,986,993, 994,999,1006,1007,1008,1014,1020,1021,1026,1031,1032,1033,1034,1035, 1041,1042,1043,1048,1053,1059,1065,1070,1071,1072,1073,1080,1081, 1087,1088,1089,1094,1100,1101,1102,1108,1115,1120,1127,1133,1134, 1135); ARRAY 163 SHORT INTEGER RMAP = (0,61,122,183,244,61,305,366,427,0,488,61,549,610,671,732,793,854, 305,61,915,976,1037,366,610,366,1098,1159,1220,1281,1342,366,1403, 1464,366,1525,0,1586,1647,1708,1769,1830,1891,1952,2013,2074,2013, 2135,366,2196,366,2013,2257,2318,2379,0,2379,2440,2501,2562,2623, 2684,1159,2196,1037,0,1952,2745,2806,2867,1037,1159,2(1037),27(0), 2928,2989,3050,2989,3111,3172,2(3233),366,2989,1159,3294,2989,3355, 2989,3416,2989,3477,1159,366,3538,3599,366,3660,3721,3(3782),2(2501), 5(3843),2(3904),2(1159),2(3904),1159,3(3965),4026,4087,4148,2(3965), 4209,1342,1891,4270,2989,366,4331,366,3904,3965,3904,4392); ARRAY 163 BYTE CMAP = (0,1,2,3,4,1,2,2,5,0,3(6),7,5(8),1,3(2),9,10,4(9),11,12,13,11,14,14, 15,0,16,17,18,9,9,19,20,12,5(18),21,18,18,22,23,0,24,15,25,26,27,28, 29,30,9,0,31,9,9,32,9,14,14,18,27(0),33,34,35,4,36,37,38,38,10,39,40, 41,42,39,43,44,2,45,46,11,10,47,11,10,48,49,49,48,50,15,4(51),28,52, 52,5(14),3(48),53,54,18,48,48,55,18,56,57,18,58,59,18,14,48,52,60); ARRAY 163 BYTE BBCONTEXT = COMMENT BASIC BLOCK DELIMITERS; (10(2),1,18(2),3(0),12(2),3(0),4(2),0,111(2)); ARRAY 167 BYTE ATTRTB = (14(0),5,1,2(0),5,32(0),6,0,1,2,4,2(0),4,2(0),2(4),2(0),2(4), 0,6,4,2,2(0),4,2,6(3),0,2(2),3(3),0,4,0,2(1),5(3),2,3(3),0, 4,0,2,2(1),3(2),2(1),3(0),4,0,2,0,4,0,4,0,2(4),6,0,4,2(0), 2,4,0,2,0,2(4),0,4,2(0),1,0,4,3(0),2(3),0,1,0,4,0,6,0,4,3,0, 4,1,2,1,2,0,4,0); ARRAY 163 BYTE LCTYPE = COMMENT LEFT CONTEXT TYPE HINTS; (7(0),#11,2(0),4,12(0),#11,0,#19,#11,0,3,0,2(1),3(0),4,12(0),#11,0, #11,0,#11,48(0), 8(0),#11,6(0),#11,0,#11,4(0),#11,2(0),2(#11),#16,2(0),3(#11),2(#16), 2(#11),2(0),2(#11),0,3(2),#10,2(0),2(2),3(0),2,0,2(#11),0,#13,2, #11,0); EQUATE OPS SYN 109; COMMENT FIRST INFORMATIVE OPERATOR (::); ARRAY 54 BYTE RCTYPE = COMMENT RIGHT CONTEXT TYPE HINTS; (#11,6(0),#11,0,#11,5(0),#11,#19,2(#11),#16,2(0),3(#11),#16,0,2(#18), 5(0),3(#11),3(0),2(#11),3(0),#15,0,2(#11),2(0),2(#11),0); ARRAY 163 BYTE LC1 = (7(0),53,0,0,54,12(0),53,0,53,53,0,53,0,54,53,0,0,53,53,4(0),53,7(0), 53,0,53,0,53,56(0),53,6(0),60,3(0),53,0,0,53,0,0,3(58),0,0,5(60),62, 62,0,0,62,62,0,3(56),3(0),56,56,0,54,0,54,0,53,0,53,62,56,62,0); ARRAY 163 BYTE RC1 = (103(0),53,0,53,64,0,0,53,0,53,53,3(0),59,0,53,0,0,53,53,0,53,4(57), 0,0,4(59),0,61,61,5(0),3(57),0,53,0,57,57,3(0),63,0,0,53,0,0,57,61,0) ; ARRAY 1136 BYTE PRTB = (2(255),0,2,1,0,2,2,102,101,2,11,255,1,3,101,2,10,2,3,110,101,6,16,2, 3,113,101,12,28,255,1,4,103,3,12,2,4,102,101,4,14,2(255),2,6,102,101, 6,17,1,6,106,7,18,255,4,7,53,109,53,103,5,15,4,7,53,109,53,105,7,19, 3(255),1,10,38,8,20,0,10,8,21,1,10,54,8,22,2,10,107,129,8,23,2,10, 108,129,8,24,255,1,11,112,10,25,255,0,12,11,0,2,12,13,103,11,26, 2(255),0,14,13,0,2,14,102,101,14,41,1,14,112,15,0,255,2,15,3,101,14, 35,3,15,3,114,101,14,36,3,15,3,115,101,14,37,3,15,3,113,101,14,38,4, 15,3,114,115,101,14,39,2,15,113,101,14,40,3,15,3,110,101,18,44,255,0, 16,13,0,1,16,112,15,0,255,2,17,116,103,16,42,2,17,116,105,17,0,255,1, 18,106,17,0,2,18,102,101,18,45,2(255),1,20,103,19,46,2,20,102,101,20, 48,1,20,112,21,0,255,2,21,3,101,20,49,255,3,22,106,3,101,20,47,255,3, 23,53,24,103,191,52,2(255),2,25,53,103,192,55,255,2,26,53,103,192,56, 2,26,116,103,192,57,2,26,53,105,26,59,2,26,116,105,26,60,255,0,27, 190,102,0,27,39,130,255,2,28,53,103,27,62,2,28,37,103,27,63,1,28,103, 27,64,2,28,53,105,28,66,2,28,37,105,28,67,1,28,105,28,68,255,2,29,30, 54,182,69,0,29,38,123,1,29,38,38,124,1,29,44,38,125,2,29,44,38,38, 126,2(255),2,31,53,103,182,70,2,31,53,105,31,74,255,1,32,106,31,73,1, 32,151,45,152,255,1,33,111,190,104,255,2,34,53,103,190,105,255,2,35, 53,103,185,89,1,35,103,185,90,2,35,53,105,35,116,1,35,105,35,117, 3(255),0,38,37,0,255,0,39,38,0,1,39,122,44,150,255,2,40,53,111,190, 103,1,40,111,39,135,2,40,37,111,39,136,2,40,53,112,33,137,2,40,37, 112,40,139,1,40,42,40,140,1,40,112,40,141,255,0,41,40,138,2,41,1,112, 41,143,2,41,5,112,41,144,2,41,8,112,41,145,2,41,19,112,41,146,2(255), 0,43,39,129,2(255),1,45,111,38,127,2,45,37,111,38,128,2,45,37,112,45, 153,1,45,112,45,154,255,0,46,38,119,1,46,38,38,120,255,3,47,50,53, 147,46,155,1,47,147,46,156,1,47,105,48,159,255,2,48,53,147,46,157,2, 48,53,105,48,160,255,2,49,154,54,47,158,2(255),0,51,38,121,1,51,38, 38,122,255,2,52,53,103,39,132,2,52,162,103,39,133,2,52,53,105,52,166, 2,52,162,105,52,167,255,1,53,122,30,72,4(255),2,57,144,56,183,76,2, 57,160,56,183,77,2,57,143,56,183,78,2,57,149,56,183,79,2,57,150,56, 183,80,2,57,145,56,183,81,2,57,125,69,183,82,2,57,126,58,185,85,2,57, 127,58,185,86,2,57,128,58,185,87,2(255),2,59,116,60,187,93,2,59,131, 60,187,94,2,59,132,60,187,95,2,59,133,60,187,96,2,59,134,60,187,97, 2(255),2,61,161,62,189,99,2,61,136,62,189,100,2,61,137,62,189,101, 2(255),2,63,154,54,43,148,2,63,154,43,43,149,255,1,64,106,23,53, 3(255),0,67,191,51,1,67,106,26,58,255,0,68,27,61,1,68,106,28,65,255, 0,69,185,88,1,69,106,35,115,255,1,70,106,25,0,255,0,71,190,0,255,1, 72,106,34,114,255,1,73,106,52,165,28(255),0,101,193,1,0,101,66,2,0, 101,67,3,0,101,68,4,0,101,69,5,0,101,70,6,0,101,71,7,0,101,72,8,0, 101,73,9,1,101,153,42,147,3(255),1,104,101,4,13,2(255),2,106,3,101, 14,29,3,106,3,114,101,14,30,3,106,3,115,101,14,31,4,106,3,114,115, 101,14,32,3,106,3,113,101,14,33,2,106,113,101,14,34,3,106,3,110,101, 18,43,0,106,34,113,7(255),1,113,101,12,27,4(255),1,117,101,22,50,255, 1,118,119,24,54,255,0,119,190,111,255,2,120,53,121,29,71,2(255),0, 122,44,151,255,2,123,53,124,32,75,3(255),1,126,58,185,83,255,1,127, 58,185,84,2(255),0,129,185,91,255,0,130,185,92,5(255),1,135,60,188, 98,3(255),0,138,190,106,255,0,139,190,107,255,1,140,62,190,108,255,1, 141,62,190,110,255,0,142,190,112,4(255),2,146,8,146,36,118,2(255),1, 148,66,39,131,3(255),0,151,41,142,255,1,152,54,39,134,3(255),1,155, 101,49,161,255,2,156,53,157,50,162,255,0,157,50,163,255,2,158,53,147, 51,164,255,1,159,62,190,109,4(255)); ARRAY 4453 BYTE MATRIX = (102(0),3,53(0),3,6(0),2,52(0),3,5(0),3,0,0,3,3,51(0),3,3,59(0),3,0, 0,3,32(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,8(0),1,0,0, 1,1,4(0),1,46(0),3,11(0),3,16(0),1,0,1,0,3(1),0,3,1,0,1,0,0,3,0,0,1, 0,1,0,1,0,1,1,3(0),1,3,0,0,2,4(0),1,0,0,1,1,0,0,2,0,1,12(0),3,1, 28(0),1,3(0),2,54(0),3,59(0),3,2,5(0),3,22(0),3,1,37(0),3,53(0),2, 5(0),3,63(0),3,50(0),3,3,5(0),3,22(0),3,1,93(0),3,32(0),1,0,1,0,3(1), 6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,6(0),3,0,1,0,0,1,1,4(0),1,15(0),2, 10(0),2,13(0),2,2,3(0),2,2,0,0,2,2,0,3(2),0,4(2),3(0),2,2,10(0),1,0, 1,0,3(1),3,1,1,0,1,0,3,3(0),1,0,1,0,1,0,1,1,0,3,3,1,8(0),1,0,0,1,1, 4(0),1,14(0),1,0,1,3,3(1),0,3,1,0,1,0,1,3(0),1,0,1,0,1,0,1,1,0,2,2,1, 0,0,2,2,4(0),1,1,0,1,1,0,0,2,0,1,14(0),1,0,1,0,3(1),7(0),3,0,0,1,0,1, 3(0),1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,42(0),3,17(0),3,45(0),3,29(0), 1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,0,3,3,1,8(0),1,0,0,1,1,4(0), 1,40(0),3,3,3(0),3,3,54(0),2,2,3(0),2,2,11(0),2,42(0),2,2,3(0),2,2, 5(0),3,5(0),2,16(0),1,0,1,0,3(1),3,1,1,3,1,0,3,3(0),1,0,1,0,1,0,1,1, 3(0),1,0,0,3,3,4(0),1,0,0,1,1,4(0),1,6(0),3,3(1),3,1,0,0,2,0,2,0, 8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,2,2,1,3(0),2,0,0,2,2,4(0),2, 14(0),2,0,2,0,8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,2,2,4(0),2,0, 0,2,2,4(0),2,40(0),2,2,3(0),2,2,5(0),2,5(0),2,16(0),1,0,1,5(0),3,1,0, 1,9(0),1,0,0,1,0,2,2,3(0),2,2,11(0),2,0,1,14(0),1,0,1,4(0),3,1,1,0,1, 9(0),1,0,0,1,6(0),3,3,13(0),1,26(0),3,14(0),3,17(0),3,3(0),1,1,58(0), 3,12(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,8(0),1,0,0,1, 1,4(0),1,4(0),3,10(0),3,24(0),3,3,3(0),3,3,3(0),1,0,3,6(0),3,4(0),3, 11(0),2,10(0),2,13(0),2,2,3(0),2,2,3(0),2,0,2,5(0),2,2,3(0),2,2, 49(0),3,3,21(0),2,10(0),2,13(0),2,2,3(0),2,2,3(0),2,0,3(2),3(0),2,2, 3(0),2,2,45(0),3,6(0),3,19(0),2,10(0),2,13(0),2,2,3(0),2,2,0,0,2,2,0, 3(2),0,2,0,2,2,3(0),2,2,53(0),3,18(0),2,10(0),2,13(0),2,2,3,0,0,2,2, 0,0,2,2,0,3(2),0,4(2),0,0,3(2),11(0),2,10(0),2,13(0),2,2,3,0,0,2,2,0, 0,2,2,0,3(2),0,4(2),3(0),2,2,11(0),2,10(0),2,13(0),2,2,3,0,0,2,2, 3(0),2,0,3(2),3(0),2,2,3(0),2,2,8(0),2,2,0,2,10(0),2,12(0),4(2),0,0, 2,2,0,0,2,2,0,3(2),0,4(2),0,3,3(2),34(0),3,37(0),2,10(0),2,11(0),2,0, 3(2),0,7(2),0,3(2),0,4(2),0,0,3(2),10(0),2,0,2,0,6(2),0,2,0,2,3(0),2, 0,2,0,2,0,2,2,0,3(2),6(0),2,0,2,0,0,2,2,4(0),2,4(0),2,3(0),3,1,4(0), 2,0,2,0,6(2),0,2,0,2,3(0),2,0,2,0,2,0,2,2,0,3(2),4(0),3,0,2,0,2,0,0, 2,2,4(0),2,4(0),2,50(0),3,11(0),6(2),0,0,2,0,2,0,8(2),0,2,2,0,0,2,0, 2,0,2,0,2,2,3(0),2,2,0,3(2),3(0),2,0,0,2,2,0,0,2,0,2,38(0),3,9(0),3, 26(0),1,4(0),1,12(0),3,1,4(0),1,0,3,3,1,8(0),1,8(0),1,51(0),3,23(0), 2,0,5(2),0,2,2,0,2,0,2,3(0),2,0,2,0,2,0,2,2,0,3(2),0,0,2,2,4(0),2,2, 0,2,2,0,0,2,0,2,14(0),2,0,2,0,3(2),0,2,2,0,2,0,0,2,0,0,2,0,2,0,2,0,2, 2,0,3(2),0,0,2,2,4(0),2,0,0,2,2,0,0,2,0,2,42(0),2,17(0),2,37(0),3,1, 36(0),1,4(0),1,10(0),3,1,0,1,4(0),1,3(0),1,8(0),1,8(0),1,14(0),1, 4(0),1,12(0),3,1,4(0),1,3(0),1,8(0),1,8(0),1,14(0),1,4(0),1,14(0),3, 3(0),1,3(0),1,8(0),1,8(0),1,14(0),1,4(0),1,1,8(0),3,0,1,0,1,3(0),1,1, 3(0),1,8(0),1,0,0,1,1,4(0),1,8(0),1,1,3,1,35(0),1,27(0),2,0,2,5(0),2, 2,0,2,9(0),2,0,0,2,0,2,2,3(0),2,2,11(0),2,0,2,36(0),3,0,1,28(0),6(2), 0,0,2,0,2,0,8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,3(2),3(0),2,0,0, 2,2,4(0),2,14(0),1,0,1,0,3(1),4(0),3,0,0,3,0,0,1,0,1,0,1,0,1,1,3(0), 1,8(0),1,0,0,1,1,4(0),1,14(0),2,0,2,0,3(2),6(0),2,3(0),2,0,2,3(0),2, 2,3(0),2,8(0),2,0,0,2,2,4(0),2,40(0),3,3,24(0)); CLOSE BASE; SEGMENT BASE R6; COMMENT SYMBOLS OF GRAMMAR; ARRAY 1992 CHARACTER METATABLE = (" ", " ", " ", " ", " ", " ", " ", " ", " ", "