(original) (raw)

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 = (" ", " ", " ", " ", " ", " ", " ", " ", " <statement*> ", " ", " ", " <expr*> ", " <sum*> <term*> ", " ", " ", " ", " ", " ", " ", " ", " ", " , ) REFERENCE( , ", "( ALGOL FORTRAN :: ARRAY ", "END ; PROCEDURE VALUE RESULT ", "* RECORD | IF ", "THEN ELSE CASE OF IS ", "+ - OR NULL ", "/ DIV REM AND ~ ", "SHL SHR TRUE FALSE LONG ", "ABS < = > ", ". DO GOTO <= >= ", "BEGIN ASSERT : := FOR ", "STEP UNTIL WHILE SHORT ~= ", "** ; + - "); CLOSE BASE; BYTE MULTDEF SYN 1; BYTE UNDECL SYN 2; BYTE SYNTAXERROR SYN 3; BYTE RCCLERROR SYN 4; BYTE TYPE3ERROR SYN 5; BYTE APARERROR SYN 6; BYTE ARRAYERROR SYN 7; BYTE DATAERROR SYN 8; BYTE FIELDERROR SYN 9; BYTE LENGTHERROR SYN 10; BYTE REFERROR SYN 11; BYTE HIERARCHYERROR SYN 12; BYTE BLOCKEXPERROR SYN 13; BYTE REFRECERROR SYN 14; BYTE PROCERROR SYN 15; BYTE TYPEERROR SYN 16; BYTE RESULTERROR SYN 17; BYTE PPROCERROR SYN 18; BYTE RELATIONERROR SYN 19; BYTE ARRAY2ERROR SYN 20; BYTE CONSTANTERROR SYN 21; BYTE STRINGERROR SYN 22; BYTE TABLEERROR SYN 23; BYTE NPROCERROR SYN 24; BYTE CONVERR SYN 25; BYTE INDEXERROR SYN 26; BYTE TYPE1ERROR SYN 27; BYTE TYPE2ERROR SYN 28; BYTE PRECERROR SYN 29; BYTE ASSIGNERROR SYN 30; BYTE NAMEWARN SYN 31; BYTE VAR2ERROR SYN 32; SEGMENT PROCEDURE ERROR(R10); BEGIN ARRAY 6 LOGICAL REGSAVE; LONG REAL DEC; BYTE STACKDUMP; PROCEDURE IDWRITE(R5); BEGIN R3 := IDDIRBASE; R1 := R1 SHLA 2; R2 := IDLENGTH(R1); R1 := IDPOINT(R1) + IDLISTBASE; END; PROCEDURE METAWRITE(R5); BEGIN R1 := R1*12S + METABASE; R2 := @B1(12); L: DECR(R2); CLI(" ",B2); IF = THEN GOTO L; R2 := R2 - R1; END; PROCEDURE OPERANDERROR(R3); BEGIN MVC(28,BUFFER(35),"INCORRECT OPERAND TYPE(S) FOR"); METAWRITE; EX(R2,ERRMOVE); END; STM(R1,R6,REGSAVE); MVC(130,BUFFER(1),BUFFER); IF R0 >= 0 THEN SET(NOGO); R0 := ABS R0; RESET(STACKDUMP); R3 := R0; CVD(R0,PKDEC); MVC(25,BUFFER(1),"ERROR 2XXX NEAR COORDINATE"); UNPK(2,1,BUFFER(8),PKDEC(6)); OI("0",BUFFER(10)); CASE R3 OF BEGIN BEGIN MVC(29,BUFFER(35),"MORE THAN ONE DECLARATION OF """); IDWRITE; EX(R2,ERRMOVE); R4 := @BUFFER(R2+66); MVC(14,B4,""" IN THIS BLOCK"); END; IF R1 = 0 THEN GOTO L ELSE BEGIN MVI("""",BUFFER(35)); IDWRITE; EX(R2,ERRMOVE1); R4 := @BUFFER(R2+37); MVC(13,B4,""" IS UNDEFINED"); END; BEGIN MVC(12,BUFFER(35),"SYNTAX ERROR "); SET(STACKDUMP); R6SAVE := R6; END; MVC(34,BUFFER(35),"IDENTIFIER MUST BE RECORD CLASS ID "); MVC(20,BUFFER(35),"MISMATCHED PARAMETER "); MVC(37,BUFFER(35),"INCORRECT NUMBER OF ACTUAL PARAMETERS "); MVC(19,BUFFER(35),"INCORRECT DIMENSION "); MVC(18,BUFFER(35),"DATA AREA EXCEEDED "); MVC(26,BUFFER(35),"INCORRECT NUMBER OF FIELDS "); MVC(27,BUFFER(35),"INCOMPATIBLE STRING LENGTHS "); MVC(23,BUFFER(35),"INCOMPATIBLE REFERENCES "); MVC(23,BUFFER(35),"BLOCKS NESTED TOO DEEPLY"); MVC(41,BUFFER(35),""";"" SHOULD NOT FOLLOW EXPRESSION (WARNING)"); MVC(36,BUFFER(35),"REFERENCE MUST REFER TO RECORD CLASS "); MVC(36,BUFFER(35),"EXPRESSION MISSING IN PROCEDURE BODY "); MVC(28,BUFFER(35),"IMPROPER COMBINATION OF TYPES"); MVC(34,BUFFER(35),"RESULT PARAMETER MUST BE A VARIABLE"); MVC(39,BUFFER(35),"PROPER PROCEDURE ENDS WITH AN EXPRESSION"); BEGIN R6SAVE := R6; MVI("""",BUFFER(35)); R1 := R6; METAWRITE; EX(R2,ERRMOVE1); R4 := @BUFFER(R2+37); MVC(16,B4,""" CANNOT FOLLOW """); R4 := @B4(17); R1 := R1-R1; IC(R1,S(I)); METAWRITE; EX(R2,MVC(0,B4,B1)); R4 := @B4(R2+1); MVC(5,B4,""" HERE"); END; MVC(24,BUFFER(35),"ARRAY ID USED INCORRECTLY"); MVC(31,BUFFER(35),"TOO MANY CONSTANTS IN PROCEDURE "); MVC(23,BUFFER(35),"INCORRECT STRING LENGTH "); MVC(23,BUFFER(35),"COMPILER TABLE OVERFLOW "); MVC(18,BUFFER(35),"TOO MANY PROCEDURES"); BEGIN MVC(20,BUFFER(35),"CONSTANT OUT OF RANGE"); R6SAVE := R6; END; MVC(39,BUFFER(35),"INDEX OF ARRAY OR STRING MUST BE INTEGER"); BEGIN R1 := R1-R1; R2 := JSAVE; IC(R1,S(R2)); OPERANDERROR; END; BEGIN R1 := R1-R1; R2 := ISAVE+JSAVE SHRA 1; IC(R1,S(R2)); OPERANDERROR; END; MVC(39,BUFFER(35),"INCORRECT PARENTHESIZATION OF EXPRESSION"); MVC(25,BUFFER(35),"ASSIGNMENT INCOMPATIBILITY"); BEGIN MVC(4,BUFFER(1),".NOTE"); MVC(33,BUFFER(35),"NAME PARAMETER SPECIFIED (WARNING)"); END; MVC(34,BUFFER(35),"SIMPLE VARIABLE ID USED INCORRECTLY"); END; R6 := R6SAVE; R2 := SCOORD; IF R6 = SCOLCODE OR R6 = BEGINCODE THEN DECR(R2); CVD(R2,DEC); UNPK(3,7,BUFFER(28),DEC); OI("0",BUFFER(31)); MVI("-",BUFFER(33)); OI("0",CARRCONT); R0 := @BUFFER; PRINT; MVC(130,BUFFER(1),BUFFER); MVC(12,BUFFER(3),"(FOUND NEAR """); R2 := R2-R2; R0 := R2; R3 := OLDEDIT - 1; IF < THEN BEGIN MVC(2,BUFFER(17),"..."); R4 := @BUFFER(21); END ELSE BEGIN IC(R2,B3(0)); IC(R0,INPUTSW(R2)); IF R0 = 2 OR R0 = 4 THEN BEGIN R1 := R3; R2 := 0; END ELSE IF R0 = 3 THEN BEGIN R3 := R3 - 2; R1 := R1-R1; IC(R1,B3(0)); R1 := R1 SHLL 8; IC(R1,B3(1)); IDWRITE; END ELSE BEGIN R1 := R2; METAWRITE; END; EX(R2,MVC(0,BUFFER(17),B1)); R4 := @BUFFER(R2+19); END; R1 := R6; IF R1 ~= IDCODE THEN METAWRITE ELSE BEGIN R1 := VALUE; IDWRITE; END; EX(R2,MVC(0,B4,B1)); R4 := @B4(R2+2); MVC(1,B4,""")"); R0 := @BUFFER; PRINT; IF STACKFLAG AND STACKDUMP THEN BEGIN MVC(130,BUFFER(1),BUFFER); MVC(14,BUFFER(1),"STACK CONTAINS:"); PRINT; MVC(14,BUFFER(1),BUFFER); FOR R3 := 0 STEP 1 UNTIL I DO BEGIN R2 := 0; IC(R2,S(R3)); R2 := R2*12S + METABASE; MVC(11,BUFFER(3),B2); PRINT; END; END; L: R0 := R0-R0; LM(R1,R6,REGSAVE); END; PROCEDURE REFCOMPATIBLE (R10); COMMENT COMPARES REFERENCE INFO IN R1 TO REFERENCE INFO IN R4; IF R1 ~= 0 THEN BEGIN INTEGER RASAVE; R1 := R1 AND R4; IF = THEN BEGIN RASAVE := R10; R0 := @REFERROR; ERROR; R10 := RASAVE; END; END; PROCEDURE CNVRTASSN(R10); COMMENT LEFT SIMPLE TYPE IN R0, ITS SIMTYPEINFO IN R4, RIGHT SIMPLE TYPE IN V(J+1); BEGIN INTEGER RASAVE; RASAVE := R10; R1 := 0; IC(R1,V22(R8+8)); IF R0 ~= R1 THEN BEGIN IF R0 >5 THEN BEGIN R0 := @ASSIGNERROR; ERROR; END ELSE IF R0 = 1 THEN BEGIN R0 := @ASSIGNERROR; ERROR; END ELSE IF R0 = 0 THEN BEGIN R0 := @PPROCERROR; ERROR; END ELSE IF R0 < = 3 THEN BEGIN IF R1 > 3 THEN BEGIN R0 := @ASSIGNERROR; ERROR; END ELSE STC(R0,CONV(R9)); END ELSE IF R1 > 5 THEN BEGIN R0 := @ASSIGNERROR; ERROR; END ELSE STC(R0,CONV(R9)); R0 := @ACOLONEQ; END ELSE IF R1 = 7 THEN BEGIN R1 := V1(J+8); IF R1 > R4 THEN BEGIN R0 := @LENGTHERROR; ERROR; END ELSE IF R1 < R4 THEN STC(R4,CONV(R9)); R0 := @SCOLONEQ; END ELSE IF R1 = 9 THEN BEGIN R1 := V1(R8+8); REFCOMPATIBLE; R0 := @RCOLONEQ; END ELSE IF R1 = 6 THEN R0 := @LCOLONEQ ELSE R0 := @ACOLONEQ; R10 := RASAVE; END; PROCEDURE SAMETYPE(R10); COMMENT CHECKS THAT R0 AND V22(J+1) ARE SAME TYPE AND ARE STRING OR REFERENCE COMPATIBLE. R4 CONTAINS SIMTYPEINFO FOR R0; BEGIN INTEGER RASAVE; RASAVE := R10; R1 := R1-R1; IC(R1,V22(R8+8)); IF R0 ~= R1 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END ELSE IF R1 = 7 THEN BEGIN R1 := V1(R8+8); IF R1 ~= R4 THEN BEGIN R0 := @LENGTHERROR; ERROR; END; END ELSE IF R1 = 9 THEN BEGIN R1 := V1(R8+8); REFCOMPATIBLE; END; R10 := RASAVE; END; PROCEDURE REGPATH (R10); BEGIN R2 := V34(R8); R3 := V34(R7); IF R2= 1024 THEN BEGIN R0 := @CONSTANTERROR; ERROR; END ELSE BEGIN CINFO(R1) := R0; R0 := R0 AND #FF; R2 := LITPNT; IF R0 = 3 OR R0 = 5 THEN R2 := R2 + 7 SHRL 3 SHLL 3 ELSE IF R0 ~= 7 THEN R2 := R2 + 3 SHRL 2 SHLL 2; R0 := R2 - LITORG; CADDR(R1) := R0; R0 := R1; R1 := @LITERALTABLE(R2); EX(R5,MOVE14); R2 := @B2(R5+1); LITPNT := R2; R5 := R0 - CTORG; R0 := R0 + 4; CTPNT := R0; END; L:R0 := 0; LM(R1,R3,R1SAVE); END; PROCEDURE NULLSTATEMENT(R10); COMMENT PLACE "NULLST" IN TREE AND EDITCODE; BEGIN R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); R3 := EDITINDEX - 1; EDITINDEX := R3; R0 := @SPACECODE; STC(R0,B3(0)); END; PROCEDURE DECLARETEST(R10); COMMENT FINDS NAMETABLE ENTRY FOR ID IN V1(I). INSERTS NAMETABLE INDEX IN V1(J), TYPES IN V2(J); BEGIN LOGICAL RASAVE; ARRAY 4 LOGICAL SAVEREGS; STM(R1,R4,SAVEREGS); R1 := V1(I); R2 := BLC; WHILE R2 >= 0 DO BEGIN R4 := DISPLAY(R2); R3 := NPOINT(R4); R4 := BLENGTH(R4) + R3; WHILE R3 < R4 DO IF R1 ~= IDNO(R3) THEN R3 := R3 + 12 ELSE BEGIN COMMENT ENTRY FOUND; R4 := TYPES(R3) AND #EFFF; COMMENT ZERO FORMAL BIT; GOTO X; END; R2 := R2 - 2; END; R0 := @UNDECL; RASAVE := R10; ERROR; R1 := ISAVE; R3 := R3-R3; IC(R3,S(R1-1)); IF R3 = GOTOCODE THEN R4 := #0100 ELSE BEGIN R10 := R6SAVE; IC(R3,LCTYPE(R3)); IF R3 < #10 THEN BEGIN IF R10 >= OPS THEN IC(R0,RCTYPE(R10-OPS)); IF R0 > R3 THEN R3 := R0; WHILE R3 = 0 DO BEGIN DECR(R1); IC(R3,S(R1-1)); IC(R3,LCTYPE(R3)); END; END; IF R3 >= #10 THEN R4 := R3 AND #F ELSE BEGIN R4 := R4-R4; R1 := R1 SHLA 3; CASE R3 OF BEGIN IC(R4,V22(R1-8)); IC(R4,V22(R1-16)); BEGIN R1 := V34(R1-8); COMMENT APAR HEAD; IF R1 ~= 0 THEN IC(R4,SIMPLETYPE(R1)); END; BEGIN R1 := V1(R1-8); IC(R4,SIMPLETYPE(R1)); END; END; END; IF R10 = LPARCODE OR R4 = 0 THEN R4 := R4 OR #0300; END; R10 := RASAVE; R3 := R3-R3; X: T0(J) := R2; V1(J) := R3; V2(J) := R4; LM(R1,R4,SAVEREGS); END; PROCEDURE DECLAREID(R10); COMMENT FINDS NAMETABLE ENTRY IN CURRENT BLOCK FOR ID IN V1(I). INSERTS NAMETABLE INDEX IN V1(J); BEGIN LOGICAL RASAVE; R1 := V1(I); R2 := BLC; WHILE R2 >= 2 DO BEGIN R4 := DISPLAY(R2); R3 := NPOINT(R4); R4 := BLENGTH(R4) + R3; WHILE R3 < R4 DO IF R1 = IDNO(R3) THEN GOTO X ELSE R3 := R3 + 12; R2 := R2 - 2; END; X: V1(J) := R3; R3 := R3 + 12; WHILE R3 < R4 DO IF R1 ~= IDNO(R3) THEN R3 := R3 + 12 ELSE BEGIN RASAVE := R10; R0 := @MULTDEF; ERROR; R10 := RASAVE; R3 := R4; END; END; PROCEDURE BLOCKSTEP(R10); COMMENT STEP BN, BLC. UPDATE DISPLAY; BEGIN R1 := BN + 4; BN := R1; R2 := BLC + 2; IF <= THEN R2 := 2; DISPLAY(R2) := R1; BLC := R2; END; PROCEDURE RESETDISPLAY(R10); COMMENT RESTORE TOP DISPLAY ENTRY FROM V2(J) (ARRAY DC, FOR CL); BEGIN R2 := V2(J); R1 := BLC + 2; DISPLAY(R1) := R2; BLC := R1; END; PROCEDURE FORCEINTEGER(R10); IF R0 ~= 1 THEN BEGIN LOGICAL RASAVE; RASAVE := R10; R0 := @TYPE1ERROR; ERROR; R10 := RASAVE; END; PROCEDURE FORCELOGICAL(R10); IF R0 ~= 6 THEN BEGIN LOGICAL RASAVE; RASAVE := R10; R0 := @TYPE1ERROR; ERROR; R10 := RASAVE; END; PROCEDURE TYPEINTEGER (R5); COMMENT TYPEINTEGER CHECKS THAT R0 AND R1 ARE BOTH TYPE INTEGER; IF R0 ~= 1 OR R1 ~= 1 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; PROCEDURE OUTID (R10); COMMENT OUTID PUTS TERMINAL NODE AND POINTER TO NAME TABLE IN OUTPUT STRING. TAKES TERMINAL NODE FROM R0. LEAVES POINTER TO NAMETABLE IN R1; BEGIN R9 := @B9(4); COMMENT STEP OUTPUT POINTER; STC(R0,OP(R9)); R1:=V1(R8); POINTER(R9):=R1; V5(R8):=R9; COMMENT SAVE OUTPUT POINTER; END; PROCEDURE OUTOP (R10); COMMENT OUTOP PUTS OPERATOR AND POINTER TO FIRST ARGUMENT IN OUTPUT STRING. TAKES OPERATOR FROM R0; BEGIN R9 := @B9(4); COMMENT STEP OUTPUT POINTER; IF R9 >= PLIMIT THEN BEGIN R0 := @TABLEERROR; ERROR; GOTO EXIT; END; STC(R0,OP(R9)); R1 := V5(R8) - OUTBASE; POINTER(R9) := R1; V5(R8):=R9; COMMENT SAVE OUTPUT POINTER; END; PROCEDURE CARDOUT(R10); BEGIN R9 := @B9(4); R0 := @CARD; STC(R0,OP(R9)); V5(R8) := R9; R2 := SCOORD; POINTER(R9) := R2; END; PROCEDURE EDITCOUNT(R4); COMMENT STEP NODEINDEX, PLACE COUNT IN EDITCODE; BEGIN R1 := NODEINDEX + 4; NODEINDEX := R1; R3 := EDITINDEX - 4; R1 := EDITBASE - R3; EDITINDEX := R3; MVC(1,EDITCODE(R3),NODECHAIN(2)); NODECHAIN := R1; STC(R0,EDITCODE(R3+3)); R1 := CHARTLEVEL; STC(R1,EDITCODE(R3+2)); END; PROCEDURE TREECOUNT(R4); COMMENT PLACE UNARY COUNT OPERATOR IN TREE, SET V5(J); BEGIN R9 := @B9(4); R0 := @UCOUNT; R1 := NODEINDEX; STC(R0,OP(R9)); POINTER(R9) := R1; V5(J) := R9; END; PROCEDURE OUTCOUNT(R10); COMMENT PLACE 'COUNT' IN EDITCODE AND TREE; BEGIN R0 := @COUNTCODE; EDITCOUNT; TREECOUNT; END; PROCEDURE OUTRTAB(R10); COMMENT PLACE 'COUNT & RTAB' IN EDITCODE AND TREE; BEGIN R1 := CHARTLEVEL + 3; CHARTLEVEL := R1; R0 := @RTAB; EDITCOUNT; TREECOUNT; END; PROCEDURE OUTLTAB(R10); COMMENT PLACE LTAB IN EDITCODE, COUNT IN TREE; BEGIN R1 := CHARTLEVEL - 3; CHARTLEVEL := R1; IF DEBUG THEN BEGIN R0 := @LTAB; EDITCOUNT; R0 := @UCOUNT; R1 := NODEINDEX; R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; END ELSE BEGIN R3 := EDITINDEX - 1; EDITINDEX := R3; MVI(LTAB0,EDITCODE(R3)); END; END; PROCEDURE OUTLTABX(R10); COMMENT PLACE LTAB1 IN EDITCODE, COUNT IN TREE; BEGIN LOGICAL SAVERA; SAVERA := R10; OUTLTAB; IF DEBUG THEN BEGIN R3 := EDITINDEX; MVI(LTAB1,EDITCODE(R3+3)); END; R10 := SAVERA; END; PROCEDURE BOOLVALUE(R10); COMMENT VALUE IN R0, POINTER IN R1; BEGIN R9 := @B9(4); STC(R0,OP(R9)); COMMENT OUTPUT OPERATOR; POINTER(R9) := R1; R0 := 6; V2(R8):=R0; COMMENT SET VALUE STACK; R0 := 0; V34(R8) := R0; V5(R8):=R9; END; PROCEDURE REFBIND(R10); BEGIN INTEGER RASAVE,R4SAVE,R5SAVE; SHORT INTEGER B5 SYN #5000; R3 := SIMTYPEINFO(R1); RASAVE := R10; IF R3 = 0 THEN BEGIN R0 := @REFRECERROR; ERROR; END ELSE BEGIN STM(R4,R5,R4SAVE); F01 := V(R8); R4 := 0; R5 := REFRECBASE; R5 := @REFRECLIST(R3); R3 := B5; WHILE R3 ~= 0 DO BEGIN V1(R7) := R3; DECLARETEST; R3 := V1(R8); IC(R0,RCCLNUMBER(R3)); R3 := R0 SHLL 1; R3 := BITTABLE(R3); R4 := R4 OR R3; R5 := R5 + 2; R3 := B5; END; SIMTYPEINFO(R1) := R4; V(R8) := F01; LM(R4,R5,R4SAVE); END; R10 := RASAVE; END; PROCEDURE ALIGNSIMPVAR(R10); COMMENT ALIGNSIMPVAR ADJUSTS R4 TO THE APPROPRIATE HALF-WORD,WORD,OR DOUBLE-WORD BOUNDARY - AS DETERMINED BY THE SIMPLE TYPE IN R3. R3 IS NOT DESTROYED ; IF R3 = 3 OR R3 = 5 THEN R4 := R4 + 7 AND #FFFFFFF8 ELSE IF R3 ~= 7 AND R3 ~= 6 THEN R4 := R4 + 3 AND #FFFFFFFC; PROCEDURE MAXREG(R10); COMMENT SETS REGISTER COUNTS TO MAXIMUM OF V(R8) AND V(8)(R8); BEGIN IC(R0,V3(R8+8)); R1 := 0; IC(R1,V3(R8)); IF R1 < R0 THEN STC(R0,V3(R8)); IC(R0,V4(R8+8)); IC(R1,V4(R8)); IF R1 < R0 THEN STC(R0,V4(R8)); END; PROCEDURE STRINGOP(R10); COMMENT FORCES SELECTION AND CONVERSION OF SHORTER OPERAND. R0 = OPERATOR; BEGIN R1 := V1(J); IF R1 < V1(I) THEN BEGIN R0 := R0 AND #7F; R1 := V1(I); R2 := V5(J); STC(R1,CONV(R2)); END ELSE BEGIN R0 := R0 OR #80; IF R1 > V1(I) THEN STC(R1,CONV(R9)); END; END; PROCEDURE CASECOUNT(R10); COMMENT COUNT CASES, SET CONV(R1) AND SIMPLE TYPE(R2), R0 = OP; BEGIN R3 := 0; R4 := R9; R5 := 0; WHILE R0 ~= CASEIDXX DO BEGIN R3 := R3 + 1; IC(R0,CONV(R4-4)); IF R0 ~= R1 THEN STC(R1,CONV(R4-4)) ELSE STC(R5,CONV(R4-4)); R4 := POINTER(R4) - 4 + OUTBASE; IC(R0,OP(R4)); IF R0 = CARDD THEN BEGIN R4 := R4 - 4; IC(R0,OP(R4)); END; END; STC(R2,CONV(R4)); POINTER(R4) := R3; END; PROCEDURE CASEJUMP(R10); COMMENT FIXES EDITCODE JUMP FOR CONDITIONALS; IF DEBUG THEN BEGIN R3 := VX(J); R1 := EDITBASE - EDITINDEX; STC(R1,EDITCODE(R3+1)); R1 := R1 SHRL 8; STC(R1,EDITCODE(R3)); END; PROCEDURE OPENSEGMENT(R5); BEGIN R9 := @B9(12); COMMENT TREE ORIGIN FOR NEW SEGMENT; COMMENT STACK AND INCREMENT COMPILER VARIABLES; R1 := CTPNT; PSTACK(R9-8) := R1; R2 := LABELADDR; CONSTANTTABLE(R1) := R2; R1 := R1+4; CTORG := R1; R4 := @CONSTANTTABLE(R1); MVC(11,B4,CONSTANTTABLE(4)); R1 := R1+12; CTPNT := R1; R1 := 32; LABELADDR := R1; R1 := LITPNT; PSTACK(R9-6) := R1; R3 := LITBASE; R1 := R1+7 AND #FFF8; LITORG := R1; R2 := LITERALTABLE(0); LITERALTABLE(R1) := R2; R1 := R1+4; LITPNT := R1; R2 := IHN; STC(R2,PSTACK(R9-4)); R3 := SNC; STC(R3,PSTACK(R9-3)); R2 := HN-1; HN := R2; IHN := R2; IF R2 < 5 THEN BEGIN R0 := @HIERARCHYERROR; ERROR; END; R3 := SN+1; SN := R3; SNC := R3; IF R3 >= XSN THEN BEGIN R0 := @NPROCERROR; ERROR; END; R1 := V1(J); STC(R2,HIERARCHY(R1)); STC(R3,PROGSEG(R1)); R4 := DRELAD; PSTACK(R9-2) := R4; R4 := DISPLAYORG; PSTACK(R9) := R4; COMMENT TREE HEADER INFO; R0 := 0; R1 := TYPEINFO(R1) SHLA 2; IF ~= THEN R1 := BLENGTH(R1)/12; R1 := R1 SHLA 3 + DPDORG; DISPLAYORG := R1; R4 := 12-R2 SHLA 2 + 7 AND #FFF8 + R1; DRELAD := R4; R4 := OUTBASE; V34(J) := R4; OUTBASE := R9; R0 := @PROCDC; OUTID; END; SEGMENT PROCEDURE CLOSESEGMENT(R5); BEGIN PROCEDURE WRITETREE(R10); COMMENT WRITES TREE, CONSTANT POINTER TABLE, AND CONSTANT TABLE; BEGIN ARRAY 3 LOGICAL SAVE; INTEGER TEMP; INTEGER OPBASE SYN SAVE(0); SEGMENT BASE R2; ARRAY 880 BYTE OPTABL = ( " + - * / ** L:= A:= ", "S:= R:= F:= STEPUNTIDIV REM < ", "<= > >= = ~= L:=2 A:=2 ", "S:=2 R:=2 AP) INDX REFX ", "IFEXP , L, SHL SHR BB END PCL ", "SUBSTRIN| AP, R, AR, AR) R) LOGOR ", "BITOR LOGAND BITAND FORST FORST2 FORLIST FORCL ENDFORLI", "UJIFEXP UJ CL IFST :: IS IFST2 , ", "WHILEOP WHILEST IFJ U- ABS LOG~ ", "BIT~ ASSERT EXIT GOTO : STACKADD CARD ", "CASE COUNT BEGIN INUMBER NUMBER ID ", "LABELID ARRAYID FUNCID RCCLID FIELDID CONID FTN PROCDC ", "RCCLDC CONTROL BIT STRING TRUE FALSE ITERN NULL ", "NULLST ARRAYDC AR* STFUNCIDSTPROCIDIF "); STM(R2,R4,SAVE); MVC(130,BUFFER(1),BUFFER); R3 := R3 + R4; TEMP := R3; R0 := @BUFFER; OI("0",CARRCONT); MVC(16,BUFFER(1),"PROGRAM SEGMENT "); MVC(5,BUFFER(18),MASK2); R3 := SNC; CVD(R3,DEC); ED(5,BUFFER(18),DEC(5)); PRINT; MVC(36,BUFFER(1)," LOC FLAG OPCODE CONV POINTER"); PRINT; MVC(130,BUFFER(1),BUFFER); MVC(3,BUFFER(4),"0000"); R1 := @P(R4); UNPK(4,2,BUFFER(16),B1(0)); TR(3,BUFFER(16),TRANSTABLE(_240)); UNPK(4,2,BUFFER(34),B1(2)); TR(3,BUFFER(34),TRANSTABLE(_240)); MVI(" ",BUFFER(20)); MVI(" ",BUFFER(38)); PRINT; R1 := 0; R3 := 0; FOR R4 := R4+4 STEP 4 UNTIL TEMP DO BEGIN R3 := R3 + 4; HEX := R3; UNPK(4,2,BUFFER(4),HEX(2)); MVI(" ",BUFFER(8)); TR(3,BUFFER(4),TRANSTABLE(_240)); IC(R1,OP(R4)); IF R1 > #7F THEN BEGIN R2 := 1; R1 := R1 AND #7F; END ELSE R2 := 0; R2 := R2 OR #F0; STC(R2,BUFFER(13)); R2 := R1 SHLL 3; R2 := R2 + OPBASE; MVC(7,BUFFER(16),B2); MVI(" ",BUFFER(25)); MVC(4,BUFFER(26),BUFFER(25)); BEGIN IC(R1,CONV(R4)); IF R1 ~= 0 THEN BEGIN CVD (R1,DEC); MVC(5,BUFFER(25),MASK); ED(5,BUFFER(25),DEC(5)); END; R2 := POINTER(R4); END; HEX := R2; UNPK(4,2,BUFFER(34),HEX(2)); MVI(" ",BUFFER(38)); TR(3,BUFFER(34),TRANSTABLE(_240)); PRINT; R1 := 0; END; MVC(38,BUFFER(1),BUFFER); OI("0",CARRCONT); MVC(15,BUFFER(1),"LITERAL ORIGIN -"); UNPK(4,2,BUFFER(18),LABELADDR(2)); TR(3,BUFFER(18),TRANSTABLE(_240)); MVI(" ",BUFFER(22)); PRINT; MVC(20,BUFFER(1),"LITERAL POINTER TABLE"); PRINT; MVC(28,BUFFER(1)," LOC LENGTH TYPE POINTER"); PRINT; MVC(28,BUFFER(1),BUFFER); R4 := CTORG; R1 := 0; R2 := R4 + CTPNT - CTORG - 4; TEMP := R2; R3 := 0; FOR R4 := R4 STEP 4 UNTIL TEMP DO BEGIN HEX := R3; UNPK(4,2,BUFFER(3),HEX(2));MVI(" ",BUFFER(7)); TR(3,BUFFER(3),TRANSTABLE(_240)); R2 := CADDR(R4); HEX := R2; UNPK(4,2,BUFFER(26),HEX(2)); TR(3,BUFFER(26),TRANSTABLE(_240)); MVI(" ",BUFFER(30)); MVC(5,BUFFER(15),MASK2); IC(R1,CTYPE(R4)); CVD(R1,DEC); ED(5,BUFFER(15),DEC(5)); IF R1 = 7 THEN MVC(5,BUFFER(9),MASK2 )ELSE MVC(5,BUFFER(9),MASK); IC(R1,CLENGTH(R4)); CVD(R1,DEC); ED(5,BUFFER(9),DEC(5)); PRINT; R1 := 0; R3 := R3 + 4; END; MVC(30,BUFFER(1),BUFFER); R0 := R0-R0; R14 := SAVE14; LM(R3,R4,SAVE(4)); END; PROCEDURE CHECKSPACE(R10); COMMENT INPUT AS MOVETREE. CHECKS FOR SPACE, COMPACTS IF POSSIBLE; IF ~COMMONFLAG THEN BEGIN LOGICAL SAVERA; SAVERA := R10; R10 := @B2(R1+3) - EDITINDEX; IF > THEN BEGIN COMMENT R10 = ADDITIONAL SPACE REQUIRED; R10 := NEG R10 + INPOINT - INPOINTSAVE - LITPNT; IF < OR R2 > EDITINDEX THEN BEGIN COMMENT SPACE NOT AVAILABLE; SET(COMMONFLAG); R0 := @TABLEERROR; ERROR; END ELSE BEGIN ARRAY 4 LOGICAL SAVE03; STM(R0,R3,SAVE03); R3 := INPOINTSAVE + LITPNT; R1 := INPOINT; R0 := R1 - R3 AND #3; R3 := R3 + R0; COMMENT ALIGN DELTA; INPOINT := R3; COMMENT R1, R3 = SOURCE, DEST; R0 := R1 - R3; R10 := R2 - R1; COMMENT R0,R10=DELTA,BYTE CNT; WHILE R10 > 256 DO BEGIN MVC(255,B3,B1); R10 := R10 - 256; R1 := @B1(256); R3 := @B3(256); END; IF R10 > 0 THEN BEGIN R10 := R10 - 1; EX(R10,MOVE31); END; R2 := R2 - R0; R1 := TREEBASE - R0; TREEBASE := R1; R1 := @TREELINK; COMMENT ADJUST TREE POINTERS; WHILE R1 > 0 DO BEGIN R3 := MEM(R1) - R0; MEM(R1) := R3; R1 := R3; END; LM(R0,R1,SAVE03); R3 := SAVE03(12); END; END; R10 := SAVERA; END; PROCEDURE MOVETREE(R10); COMMENT HEADER WORD IN R1, R1(16:31) = BYTE COUNT, R2 = DESTINATION, R4 = SOURCE; BEGIN INTEGER R1SAVE, R4SAVE, RASAVE; RASAVE := R10; R1SAVE := R1; R1 := R1 AND #FFFF; R4SAVE := R4; CHECKSPACE; R10 := RASAVE; IF NOGO THEN R2 := @B2(R1+4) ELSE BEGIN R4 := R1SAVE; TREE(R2) := R4; R4 := R4SAVE; WHILE R1 > 256 DO BEGIN MVC(255,B2(4),B4); R2 := @B2(256); R4 := @B4(256); R1 := R1 - 256; END; IF R1 ~= 0 THEN BEGIN R1 := R1 - 1; EX(R1,TREEMOVE); R2 := @B2(R1+1); END; R2 := @B2(4); COMMENT SET TO NEXT FREE WORD; END; END; COMMENT COMPLETE AND OUTPUT TREE; R2 := DRELAD; IF R2 >= 4096 THEN BEGIN R0 := @DATAERROR; ERROR; END; R1 := V1(J); R3 := IDLOC1(R1) AND #F000 OR R2; IDLOC1(R1) := R3; R0 := @PCL; OUTOP; R4 := OUTBASE; R3 := R9 - R4; R1 := TREELENGTH + R3 + 4; TREELENGTH := R1; R9 := R4; POINTER(R9) := R3; IC(R0,TRACE); IF R0 > 5 THEN WRITETREE; R1 := 8; R2 := TREEORG; CHECKSPACE; IF ~NOGO THEN BEGIN ARRAY 2 INTEGER SAVE45; STM(R4,R5,SAVE45); R5 := TREELINK; B2(0) := R5; TREELINK := R2; MVC(7,B2(4)," "); R4 := V1(J); R4 := IDNO(R4) SHLL 2; R3 := IDDIRBASE; R5 := IDLENGTH(R4); IF R5 > 7 THEN R5 := 7; R4 := IDPOINT(R4); R3 := IDLISTBASE; R4 := @IDLIST(R4); EX(R5,TREEMOVE); LM(R4,R5,SAVE45); END; R1 := P(R9); R2 := @B2(12); R4 := @P(R9+4); MOVETREE; R4 := CTORG - 4; R1 := LABELADDR; R3 := CONSTANTTABLE(R4); CONSTANTTABLE(R4) := R1; LABELADDR := R3; R1 := CTPNT - R4; CTPNT := R4; R4 := @CONSTANTTABLE(R4); MOVETREE; R3 := LITBASE; R4 := LITORG; R1 := LITPNT - R4; R4 := @LITERALTABLE(R4); MOVETREE; R2 := R2 + 3 AND #FFFFFC; TREEORG := R2; COMMENT RESTORE COMPILER VARIABLES; R4 := PSTACK(R9); DISPLAYORG := R4; R4 := PSTACK(R9-2); DRELAD := R4; IC(R0,PSTACK(R9-3)); SNC := R0; R2 := HN+1; HN := R2; IC(R0,PSTACK(R9-4)); IHN := R0; R1 := V34(J); OUTBASE := R1; R2 := PSTACK(R9-6); LITPNT := R2; R2 := PSTACK(R1-8) + 4; CTORG := R2; R2 := PSTACK(R1-6) + 7 AND #FFF8; LITORG := R2; COMMENT CLEAR TREE AND STACK AREA; R0 := R0-R0; R1 := R0; R2 := R9-8; R3 := R9 + POINTER(R9); P(R2) := R0; R2 := R2+7 AND #FFF8; R2 := @P(R2); R3 := @P(R3); WHILE R2 <= R3 DO BEGIN STM(R0,R1,B2); R2 := @B2(8); END; R9 := R9 - 12; END; SEGMENT PROCEDURE EXECUTE1(R6); BEGIN PROCEDURE BNDPR(R10); COMMENT BNDPR CHECKS THAT BOTH BOUNDS ARE INTEGER, INCREASES THE DIMENSION COUNT, AND OUTPUTS COLON; BEGIN INTEGER RASAVE; RASAVE := R10; IC(R0,V22(R8+8)); COMMENT GET SIMPLE TYPE OF LOWER BOUND; IC(R1,V22(R8+24)); COMMENT GET SIMPLE TYPE OF UPPER BOUND; TYPEINTEGER; R9 := @B9(4); COMMENT STEP OUTPUT POINTER; R0 := @COLON; STC(R0,OP(R9)); R1 := V5(R8+8) - OUTBASE; POINTER(R9) := R1; IC(R0,V4(R8)); R0 := R0 + 1; STC(R0,V4(R8)); R10 := RASAVE; END; PROCEDURE PROCEDOPEN(R5); COMMENT STEPS BN, OPENS NEW PROGRAM SEGMENT, ALLOCATES SPACE FOR DPDS, ASSIGNS RELATIVE ADDRESSES TO FORMAL NAME PARAMETERS; BEGIN INTEGER R5SAVE, TEMP; R5SAVE := R5; DECLAREID; BLOCKSTEP; OPENSEGMENT; R4 := 0; R1 := V1(J); R2 := TYPEINFO(R1) SHLA 2; COMMENT BN OF FPARS; IF ~= THEN BEGIN R1 := NPOINT(R2); R3 := BLENGTH(R2); R2 := R1+R3; TEMP := R2; R2 := 0; R3 := R3/3 + LABELADDR; LABELADDR := R3; R2 := DPDORG; R3 := 0; R5 := HN; WHILE R1 < TEMP DO BEGIN IDLOC1(R1) := R5; IC(R0,VR(R1)); IF R0 ~= 0 THEN BEGIN STC(R3,TYPE(R1)); R4 := R4 OR R0; END ELSE BEGIN IC(R0,TYPE(R1)); IF R0 = #12 THEN R4 := R4 OR #1 ELSE IDLOC2(R1) := R2; END; R1 := R1 + 12; R2 := R2 + 8; END; END; VA(J) := R4; R5 := R5SAVE; END; PROCEDURE PROCEDCLOSE(R5); BEGIN INTEGER R5SAVE; R5SAVE := R5; R2 := T0(J+8); IF R2 >= BLC THEN R2 := #FE; R2 := R2 SHLL 3; R1 := V1(J); IF R2 > #F0 THEN R2 := #F0; IC(R0,HIERARCHY(R1)); R2 := R2 OR R0; STC(R2,HIERARCHY(R1)); R1 := BLC - 2; BLC := R1; CLOSESEGMENT; R3 := EDITINDEX - 1; R1 := VA(J) AND #2; IF ~= THEN BEGIN R3 := R3 - 2; MVI(VRSTOP,EDITCODE(R3+2)); MVI(PV,EDITCODE(R3+1)); END; R1 := CHARTLEVEL - 3; CHARTLEVEL := R1; EDITINDEX := R3; MVI(LTAB0,EDITCODE(R3)); R5 := R5SAVE; END; PROCEDURE EXTERNALESDINDEX(R5); COMMENT V(I) -> SEGMENT NAME, R2 := EXTERNAL SEGMENT NUMBER; BEGIN MVC(130,BUFFER(1),BUFFER); R2 := V1(I) + CTORG; R1 := LITBASE + LITORG + CADDR(R2); IC(R2,CLENGTH(R2)); R2 := R2 AND #FF; IF R2 > 7 THEN R2 := 7; EX(R2,MOVE); R3 := @ESDICT(0); FOR R2 := 255 STEP _1 UNTIL XSN DO BEGIN CLC(7,B3,BUFFER(75)); IF = THEN GOTO X; R3 := @B3(8); END; R2 := XSN - 1; IF R2 < 224 THEN BEGIN R0 := @NPROCERROR; ERROR; R2 := 224; R3 := @ESDICT(248); END; XSN := R2; MVC(7,B3,BUFFER(75)); X: R1 := CTORG + 12; CTPNT := R1; R1 := LITORG + 4; LITPNT := R1; R1 := #FF; T0(J+8) := R1; END; PROCEDURE NAMEP(R5); BEGIN DECLAREID; R0 := R0-R0; V34(J) := R0; END; PROCEDURE VALUEP(R5); BEGIN DECLAREID; R1 := V1(R8); R3 := TYPES(R1); IF R3 ~= 9 THEN BEGIN R4 := DRELAD; ALIGNSIMPVAR; IDLOC2(R1) := R4; IF R3 ~= 7 THEN IC(R3,LENGTHTABLE(R3)) ELSE R3 := SIMTYPEINFO(R1) + 1; R4 := R4 + R3; DRELAD := R4; END; R0 := 1; V34(R8) := R0; END; PROCEDURE RELADDRESS(R5); IF R1 ~= 0 THEN COMMENT ROUTINE EXECUTED ONLY IF ID DEFINED; BEGIN R4 := HN; IDLOC1(R1) := R4; R4 := DRELAD; R3 := TYPES(R1); IF R3 ~= 9 THEN BEGIN R0 := R3; ALIGNSIMPVAR; IDLOC2(R1) := R4; IF R3 ~= 7 THEN IC(R3,LENGTHTABLE(R3)) ELSE R3 := SIMTYPEINFO(R1) + 1; R3 := R3 + R4; DRELAD := R3; END; END; PROCEDURE FIELDDC(R5); BEGIN DECLAREID; R1 := V1(J); R3 := 0; IC(R3,SIMPLETYPE(R1)); IF R3 = 3 OR R3 = 5 THEN BEGIN R4 := V34(J) + 7 AND #FF8; IDLOC2(R1) := R4; IC(R3,LENGTHTABLE(R3)); R4 := R4 + R3; V34(J) := R4; END; END; CASE R5 OF BEGIN COMMENT ::= , ALSO RULE SELECTION ; BEGIN DECLARETEST; IC(R0,V21(J)); IF R0 ~= 0 THEN BEGIN R0 := R0-1 SHLA 2; COMMENT MTB POINTER INCREMENT; R3 := R3SAVE + R0; R3SAVE := R3; SET(FLAG); END ELSE BEGIN R0 := @ID; OUTID; IC(R0,TYPE(R1)); IF R0 > #F THEN R2 := #0A04 ELSE BEGIN R2 := #FF; T0(J) := R2; R2 := R2-R2; END; V34(J) := R2; R1 := SIMTYPEINFO(R1); V1(J) := R1; END; END; COMMENT ::= ; BEGIN R0 := @LABELID; OUTID; END; COMMENT ::= ; BEGIN R0 := @ARRAYID; OUTID; R2 := #0100; V34(J) := R2; R1 := #FF; T0(J) := R1; END; COMMENT ::= ; BEGIN R0 := @FUNCID; OUTID; R1 := V1(J); IC(R0,HIERARCHY(R1)); R0 := R0 SHRL 4 SHLL 1; T0(J) := R0; END; COMMENT ::= ; BEGIN R0 := @RCCLID; OUTID; R2 := #0100; V34(J) := R2; IC(R0,RCCLNUMBER(R1)); STC(R0,V22(J)); R1 := #FF; T0(J) := R1; END; COMMENT ::= ; BEGIN R0 := @FIELDID; OUTID; R2 := #0100; V34(J) := R2; IC(R0,RCCLNUMBER(R1)); STC(R0,V21(J)); R1 := SIMTYPEINFO(R1); V1(J) := R1; END; COMMENT ::= ; BEGIN R0 := @CONID; OUTID; R2 := R2-R2; V34(J) := R2; STC(R2,V21(J)); COMMENT RESET TYPE TO ZERO; R1 := #FF; T0(J) := R1; END; COMMENT ::= ; BEGIN R0 := @STFUNCID; OUTID; R2 := #0A04; V34(J) := R2; R1 := #FF; T0(J) := R1; END; COMMENT ::= ; BEGIN R0 := @STPROCID; OUTID; IC(R0,VR(R1)); V34(J) := R0; IF R1 = TRACEINDEX THEN R1 := 0 ELSE R1 := #FF; T0(J) := R1; END; COMMENT ::= ; COMMENT ::= ; BEGIN DECLAREID; R1 :=V1(J); RELADDRESS; END; COMMENT ::= ,, ; BEGIN DECLAREID; R1 := V1(J); RELADDRESS; END; COMMENT ::= ); BEGIN R3 := EDITINDEX - 1; EDITINDEX := R3; R0 := @SPACECODE; STC(R0,B3(0)); END; COMMENT ::= REFERENCE ; BEGIN DECLARETEST; IC(R0,V21(J)); IF R0 ~= 4 THEN BEGIN R0 := @RCCLERROR; ERROR; END; END; COMMENT ::= ,, ; BEGIN DECLARETEST; IC(R0,V21(J)); IF R0 ~= 4 THEN BEGIN R0 := @RCCLERROR; ERROR; END; END; COMMENT ::= :: ) ; BEGIN BYTE SIMTYPE; BNDPR; R0 := @ARPAREN; OUTOP; RESETDISPLAY; R4 := R4-R4; IC(R4,V3(J)); V2(J) := R4; R2 := R4-1 * 12S; R2 := NEG R2 + V1(J); IC(R0,SIMPLETYPE(R2)); STC(R0,SIMTYPE); IF R0 ~= 9 THEN R5 := DRELAD + 3 AND #FFFFFFFC; IC(R4,V4(J)); R1 := R4*12S + 4; FOR R3 := 1 STEP 1 UNTIL V2(J) DO BEGIN IC(R0,DIMEN(R2)); IF R0 = 0 THEN STC(R4,DIMEN(R2)) ELSE IF R0 ~= R4 THEN BEGIN R0 := @ARRAYERROR; ERROR; END; CLI(#09,SIMTYPE); IF ~= THEN BEGIN IDLOC2(R2) := R5; R5 := R5 + R1; DRELAD := R5; END ELSE IDLOC2(R2) := R1; R5 := HN; IDLOC1(R2) := R5; R5 := DRELAD; R2 := R2 + 12; END; END; COMMENT ::= ARRAY ; BEGIN DECLAREID; R0 := @ARRAYDC; OUTID; CARDOUT; R0 := 1; STC(R0,V3(R8)); COMMENT ID COUNT; END; COMMENT ::= ,, ; BEGIN DECLAREID; IC(R0,V3(J)); R0 := R0 + 1; STC(R0,V3(J)); END; COMMENT ::= ( ; BEGIN R0 := 0; STC(R0,V4(R8)); COMMENT INITIALIZE DIMEN COUNT; R1 := BLC; R2 := DISPLAY(R1); V2(J) := R2; R1 := R1 - 2; BLC := R1; IC(R0,V3(R8)); STC(R0,CONV(R9-4)); END; COMMENT ::= :: , ; BEGIN BNDPR; R0 := @ARCOMMA; OUTOP; END; COMMENT ::= <statement*> ; BEGIN R1 := V1(R8); IC(R0,SIMPLETYPE(R1)); IF R0 ~= 0 THEN BEGIN R0 := @PROCERROR; ERROR; END; PROCEDCLOSE; END; COMMENT ::= ; BEGIN NULLSTATEMENT; R1 := #FF; T0(J+8) := R1; R1 := V1(R8); IC(R0,SIMPLETYPE(R1)); IF R0 ~= 0 THEN BEGIN R0 := @PROCERROR; ERROR; END; PROCEDCLOSE; END; COMMENT ::= ; BEGIN R4 := V1(R8); IC(R0,SIMPLETYPE(R4)); R4 := SIMTYPEINFO(R4); CNVRTASSN; PROCEDCLOSE; END; COMMENT ::= ALGOL ; BEGIN EXTERNALESDINDEX; R1 := V1(J); STC(R2,PROGSEG(R1)); R2 := #8000; IDLOC1(R1) := R2; COMMENT EXTERNAL, FORMAL; R0 := 11; STC(R0,HIERARCHY(R1)); R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); PROCEDCLOSE; IF ~NOGO THEN BEGIN COMMENT DELETE SEGMENT IN COMMON; R1 := TREELINK; TREEORG := R1; R1 := B1; TREELINK := R1; END; END; COMMENT ::= FORTRAN ; BEGIN EXTERNALESDINDEX; R0 := @FTN; R1 := V1(J); R9 := @B9(4); STC(R0,OP(R9)); STC(R2,CONV(R9)); POINTER(R9) := R1; PROCEDCLOSE; END; COMMENT ::= ., ; BEGIN CARDOUT; OUTRTAB; R1 := VA(J) AND #1; IF ~= THEN BEGIN R3 := EDITINDEX - 2; EDITINDEX := R3; MVI(PV,EDITCODE(R3+1)); MVI(VRSTOP,EDITCODE(R3)); END; END; COMMENT ::= ; COMMENT ::= ) ; BEGIN R1 := V1(R8); R2 := TYPEINFO(R1) SHLA 2; R4 := DRELAD; R1 := NPOINT(R2); R3 := BLENGTH(R2) + R1; WHILE R1 < R3 DO BEGIN R2 := TYPES(R1); IF R2 = 9 THEN BEGIN R4 := R4 + 3 AND #FFFFFFFC; IDLOC2(R1) := R4; R4 := R4 + 4; END; R1 := R1 + 12; END; DRELAD := R4; END; COMMENT ::= PROCEDURE ; PROCEDOPEN; COMMENT ::= PROCEDURE ; PROCEDOPEN; COMMENT ::= ; COMMENT ::= ; COMMENT ::= ( ; BEGIN NAMEP; R0 := @NAMEWARN; R0 := NEG R0; ERROR; END; COMMENT ::= ( VALUE ; VALUEP; COMMENT ::= ( RESULT ; VALUEP; COMMENT ::= ( VALUE RESULT ; VALUEP; COMMENT ::= ( PROCEDURE ; NAMEP; COMMENT ::= ( PROCEDURE ; NAMEP; COMMENT ::= ; BEGIN NAMEP; R0 := @NAMEWARN; R0 := NEG R0; ERROR; END; COMMENT ::= VALUE ; VALUEP; COMMENT ::= RESULT ; VALUEP; COMMENT ::= PROCEDURE; NAMEP; COMMENT ::=VALUE RESULT; VALUEP; COMMENT ::= PROCEDURE ; NAMEP; COMMENT ::= ,, ; BEGIN R1 := V34(J); IF R1 = 0 THEN NAMEP ELSE VALUEP; END; COMMENT ::= ., ; COMMENT ::= ., ; COMMENT ::= * ) ; BEGIN R4 := DRELAD + 3 AND #FFFFFFFC; R2:=V1(R8); IC(R0,DIMEN(R2)); R1 := R0 * 12S +4; FOR R3 := 1 STEP 1 UNTIL V2(R8) DO BEGIN IDLOC2(R2) := R4; R2 := R2 - 12; R4 := R4 + R1; END; DRELAD := R4; END; COMMENT ::= ( ; COMMENT ::= * , ; COMMENT ::= ( ARRAY ; BEGIN DECLAREID; R1 := 1; V2(R8) := R1; END; COMMENT ::= ARRAY ; BEGIN DECLAREID; R1 := 1; V2(R8) := R1; END; COMMENT ::= ,, ; BEGIN DECLAREID; R1 := V2(J)+1; V2(J) := R1; END; COMMENT ::= ); BEGIN R1 := V5(R8); R4 := V34(R8); SIMTYPEINFO(R1) := R4; COMMENT INSERT RECORD LENGTH; END; COMMENT ::= ( ; FIELDDC; COMMENT ::= ,, ; FIELDDC; COMMENT ::= ; FIELDDC; COMMENT ::= ., ; COMMENT ::= RECORD ; BEGIN DECLAREID; R1 := V1(J); R3 := HN; IDLOC1(R1) := R3; V5(R8) := R1; COMMENT POINTER TO NAMETABLE IN V5(J); R4 := 4; R1 := R1 + 12; IC(R0,TYPE(R1)); R2 := 0; WHILE R0 = 5 DO BEGIN IC(R0,SIMPLETYPE(R1)); IF R0 = 9 THEN BEGIN IDLOC2(R1) := R4; R4 := R4+ 4; END; IDLOC1(R1) := R3; R2 := R2 + 1; R1 := R1 + 12; IC(R0,TYPE(R1)); END; R3 := R1-12; R1 := V5(R8); STC(R2,VR(R1)); FOR R1 := R1 + 12 STEP 12 UNTIL R3 DO BEGIN IC(R0,SIMPLETYPE(R1)); IF R0 = 1 OR R0 = 2 OR R0 = 4 OR R0 = 8 THEN BEGIN IDLOC2(R1) := R4; R4 := R4 + 4; END; IF R0 = 4 THEN R4 := R4 + 4; END; FOR R1 := V5(R8) + 12 STEP 12 UNTIL R3 DO BEGIN IC(R0,SIMPLETYPE(R1)); IF R0 = 6 THEN BEGIN IDLOC2(R1) := R4; R4 := R4 + 1; END ELSE IF R0 = 7 THEN BEGIN IDLOC2(R1) := R4; R4 := R4 + SIMTYPEINFO(R1) + 1; END; END; R4 := R4 + 3 AND #FFC; V34(R8) := R4; END; COMMENT ::= ; COMMENT ::= ; BEGIN R1 := V1(R8); R2 := SIMTYPEINFO(R1); V1(R8) := R2; IC(R0,DIMEN(R1)); V34(R8) := R0; R8 := R8 SHRA 3; IC(R0,S(R8-1)); R8 := R8 SHLA 3; IF R0 ~= APARHEAD THEN BEGIN R0 := @ARRAY2ERROR; ERROR; END; END; COMMENT ::= ) ; BEGIN IC(R0,V22(R8+8)); IF R0 ~=1 THEN BEGIN R0 := @INDEXERROR; ERROR;END; R1 := V1(R8+16); IF R1 > V1(R8) THEN BEGIN R0 := @LENGTHERROR; ERROR; END ELSE V1(R8) := R1; R0 := @BAR; R9 := @B9(4); STC(R0,OP(R9)); R1 := V5(R8+8) - OUTBASE; POINTER(R9) := R1; R0 := @SUBSTRING; R0 := R0 OR #80; OUTOP; END; COMMENT ::= ( ; BEGIN IC(R0,V22(R8)); IF R0 ~= 7 THEN BEGIN R0 := @VAR2ERROR; ERROR; END; IC(R0,V21(R8)); IF R0 = 2 THEN BEGIN R0 := @ARRAYERROR; ERROR; END; END; COMMENT ::= | ; BEGIN IC(R0,V22(I)); FORCEINTEGER; R5 := INUMVALUE; IF R5 <= 0 OR R5 > 256 THEN BEGIN R0 := @STRINGERROR; ERROR; END; R5 := R5 - 1; V1(R8) := R5; R0 := @INUMBER; OUTID; END; END; END; SEGMENT PROCEDURE EXECUTE2(R6); BEGIN PROCEDURE ARITHCHECK(R5); COMMENT FIRST ARGUMENT IS IN R1, SECOND IS IN V(I); BEGIN IC(R0,V22(R7)); IF R0 > 5 THEN BEGIN R0 := @TYPEERROR; ERROR; R0 := R1; END ELSE IF R1 > 5 THEN BEGIN R0 := @TYPEERROR; ERROR; R1 := R0; END; END; PROCEDURE BINARYOPCHECK(R5); BEGIN IC(R0,V22(I)); IF R0 > 5 OR R1 > 5 THEN BEGIN R0 := @TYPE2ERROR; ERROR; IF R1 > 5 THEN R1 := 1; R0 := R1; END; END; PROCEDURE CASETYPE(R10); BEGIN INTEGER RASAVE; IC(R1,V22(R8)); IC(R0,V22(R8+8)); STC(R0,V22(R7)); IF R1 ~= 0 THEN BEGIN RASAVE := R10; IF R0 ~= R1 THEN BEGIN ARITHCHECK; R5 := R0 AND R1 AND #1; COMMENT RECOVER LONG BIT; IF R0 > R1 THEN BEGIN IF R5 = 0 THEN R0 := R0 AND #FE; STC(R0,V22(R8)); END ELSE BEGIN IF R5 = 0 THEN R1 := R1 AND #FE; STC(R1,V22(R8)); END; END ELSE IF R1 = 7 THEN BEGIN R5 := V1(R8); IF R5 < V1(R8+8) THEN R5 := V1(R8+8); V1(R8) := R5; END ELSE IF R1 = 9 THEN BEGIN R5 := V1(R8+8); R1 := V1(R8) OR R5; V1(R8) := R1; END; R10 := RASAVE; END ELSE BEGIN STC(R1,V21(R8+8)); R1 := V12(R8+8); V12(R8) := R1; END; IC(R0,V22(R8)); IF R0 = 7 THEN R0 := V1(R8); STC(R0,CONV(R9)); END; PROCEDURE CONVERT1(R5); COMMENT FIRST ARGUMENT IS IN R1, SECOND IS IN R0, POINTER FOR FIRST IS IN R2; IF R0 ~= R1 THEN BEGIN IF R0 = 1 THEN STC(R1,CONV(R9) )ELSE CASE R1 OF BEGIN BEGIN STC(R0,V22(R8)); STC(R0,CONV(R2)); END; IF R0 = 3 THEN BEGIN R0 := 2; STC(R0,CONV(R9)); END ELSE IF R0 = 4 THEN BEGIN STC(R0,V22(R8)); STC(R0,CONV(R2)); END ELSE BEGIN R0 := 4; STC(R0,V22(R8)); STC(R0,CONV(R9)); STC(R0,CONV(R2)); END; BEGIN STC(R0,CONV(R2)); STC(R0,V22(R8)); END; BEGIN R0 := 4; STC(R0,CONV(R9)); END; IF R0 = 2 THEN BEGIN R0 := 4; STC(R0,V22(R8)); STC(R0,CONV(R9)); STC(R0,CONV(R2)); END ELSE IF R0 = 4 THEN BEGIN STC(R0,V22(R8)); STC(R0,CONV(R2)); END ELSE BEGIN R0 := 5; STC(R0,CONV(R9)); END; END; END; SEGMENT PROCEDURE APAREXPCHECK (R5); COMMENT POINTER TO NAMETABLE IN R2; BEGIN IC(R0,SIMPLETYPE(R2)); R3 := 0; IC(R3,VR(R2)); R4 := SIMTYPEINFO(R2); IF R3 ~= 0 THEN BEGIN CASE R3 OF BEGIN CNVRTASSN; BEGIN COMMENT RESULT; IC(R3,OP(R9)); R3 := R3 AND #7F; IF R3 ~=30 AND R3 ~= 31 AND R3 ~= 40 AND R3 ~= 87 AND R3 ~= 89 THEN BEGIN R0 := @RESULTERROR; ERROR; END ELSE BEGIN R3 := R0; IC(R0,V22(R8+8)); STC(R3,V22(R8+8)); R3 := R4; R4 := V1(R8+8); V1(R8+8) := R3; CNVRTASSN; R0 := 0; STC(R0,CONV(R9)); END; END; BEGIN COMMENT VALUE-RESULT; IC(R3,OP(R9)); R3 := R3 AND #7F; IF R3 ~= 30 AND R3 ~= 31 AND R3 ~= 40 AND R3 ~= 87 AND R3 ~= 89 THEN BEGIN R0 := @RESULTERROR; ERROR; END; IC(R1,V22(R8+8)); IF R0 = 2 AND R1 = 3 THEN NULL ELSE IF R0 = 3 AND R1 = 2 THEN NULL ELSE IF R0 = 4 AND R1 = 5 THEN NULL ELSE IF R0 = 5 AND R1 = 4 THEN NULL ELSE SAMETYPE; END; END; IC(R3,V21(J+8)); R3 := R3 AND #FF; IF ~= THEN BEGIN R3 := POINTER(R9); R3 := TYPEINFO(R3); IF R3 ~= 0 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END; END; END ELSE BEGIN IC(R3,TYPE(R2)); SAMETYPE; R1 := 0; IC(R1,V21(R8+8)); R1 := R1 OR #10; IF R1 ~= R3 THEN BEGIN IF R3 = #10 AND R1 = #13 THEN BEGIN R1 := POINTER(R9); R1 := TYPEINFO(R1); IF R1 ~= 0 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END; END ELSE IF R3 ~= #13 OR R1 ~= #10 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END; END ELSE IF R1 = #12 THEN BEGIN IC(R0,DIMEN(R2)); R1 := V34(R8+8); IF R1 = 0 THEN BEGIN COMMENT INSERT DIMEN IN NAMETABLE; R1 := POINTER(R9); STC(R0,DIMEN(R1)); END ELSE IF R0 ~= R1 THEN BEGIN R0 := @ARRAYERROR; ERROR; END; END; END; END; PROCEDURE APARCHECK(R5); COMMENT CHECKS FORMAL PROCEDURE USE, RESETS DRELAD; BEGIN IC(R0,OP(R9)); IF R0 = FUNCIDD THEN BEGIN R2 := POINTER(R9); R1 := IDLOC1(R2) OR #8000; IC(R0,TYPE(R2)); IF R0 < #10 THEN IDLOC1(R2) := R1; END; END; PROCEDURE APAREND(R5); COMMENT CHECKS NUMBER OF APARS, TYPE OF LAST. OUTPUTS " )" ; BEGIN IC(R0,V21(R8)); COMMENT CHECK NUMBER OF APARS; IF R0 ~= 1 AND R0 ~= #FF THEN BEGIN R0 := @APARERROR; ERROR; END; IC(R0,V22(R8)); IF R0 = 0 THEN R0 := 3 ELSE R0 := 0; STC(R0,V21(R8)); COMMENT SET TYPE; R0 := @APPAREN; COMMENT PREPARE TO OUTPUT; END; PROCEDURE APARLIST(R5); COMMENT CHECKS NUMBER OF APARS, INCREASES FPAR POINTER , OUTPUTS "," . POINTER TO FPAR IS IN R2; BEGIN IC(R0,V21(R8)); COMMENT GET NUMBER OF APARS LEFT; IF R0 = 1 THEN BEGIN R0 := @APARERROR; ERROR; R0 := #FF; STC(R0,V21(R8)); END ELSE BEGIN R0 := R0 - 1; STC(R0,V21(R8)); END; R2 := R2 + 12; V34(R8) := R2; COMMENT STEP FPAR POINTER; R0 := @APCOMMA; COMMENT PREPARE TO OUTPUT; END; PROCEDURE SUBSCRIPT(R5); COMMENT SUBSCRIPT CHECKS THAT SUBSCRIPT IS INTEGER AND THAT DIMENSION IS NOT TOO SMALL FOR IT ; BEGIN IC(R0,V22(R8+8)); IF R0 ~= 1 THEN BEGIN R0 := @INDEXERROR; ERROR; END; R2 := 0; IC(R2,V22(R8)); IF R2 = #FF THEN BEGIN R2 := V1(R8); IC(R0,DIMEN(R2)); R0 := R0 + 1; STC(R0,DIMEN(R2)); END ELSE BEGIN R2 := R2 - 1; STC(R2,V22(R8)); IF R2 < 0 THEN BEGIN R0 := @ARRAYERROR; ERROR; END; END; MAXREG; COMMENT ADJUST REGISTER COUNTS; R0 := @INDX; OUTOP; END; PROCEDURE ARRAYDES(R5); COMMENT R0 CONTAINS NUMBER OF *"S; BEGIN R1 := V1(R8); R2 := 0; IC(R2,V22(R8)); IF R2 = #FF THEN BEGIN IC(R2,DIMEN(R1)); R2 := R2 + R0; STC(R2,DIMEN(R1)); END ELSE IF R0 ~= R2 THEN BEGIN R3 := R0; R0 := @ARRAYERROR; ERROR; R0 := R3; END; IF R0 = 0 THEN BEGIN IC(R0,SIMPLETYPE(R1)); V2(R8) := R0; END ELSE BEGIN R2 := TYPES(R1); V2(R8) := R2; V34(R8) := R0; R8 := R8 SHRA 3; IC(R0,S(R8-1)); R8 := R8 SHLA 3; IF R0 ~= APARHEAD THEN BEGIN R0 := @ARRAY2ERROR; ERROR; END; END; R2 := SIMTYPEINFO(R1); V1(R8) := R2; END; PROCEDURE APSTATEND(R4); BEGIN APARCHECK; R2 := V34(R8); IC(R0,V21(R8)); IF R2 = 0 THEN R0 := @APPAREN ELSE IF R0 = #FF THEN APAREND ELSE BEGIN R1 := TYPES(R2); IF R1 ~= #1300 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END; APAREND; END; R1 := #0404; V34(R8) := R1; OUTOP; R1 := IHN + 1; IHN := R1; END; PROCEDURE APSTATLIST(R4); BEGIN APARCHECK; R2 := V34(R8); IC(R0,V21(R8)); IF R2 = 0 OR R0 = #FF THEN R0 := @APCOMMA ELSE BEGIN R1 := TYPES(R2); IF R1 ~= #1300 THEN BEGIN R0 := @TYPE3ERROR; ERROR; END; APARLIST; END; OUTOP; END; PROCEDURE EQUALOP(R5); BEGIN LOGICAL R5SAVE; R5SAVE := R5; V1(J+8) := R0; IC(R0,V22(I)); IC(R1,V22(J)); IF R0 ~= R1 THEN BEGIN BINARYOPCHECK; IF R0 < R1 THEN BEGIN IF R0 = 3 AND R1 = 4 THEN BEGIN R1 := 5; R2 := V5(R8); STC(R1,CONV(R2)); END; STC(R1,CONV(R9)); END ELSE BEGIN IF R1 = 3 AND R0 = 4 THEN BEGIN R0 := 5; STC(R0,CONV(R9)); END; R2 := V5(R8); STC(R0,CONV(R2)); END; END; R0 := V1(J+8); REGPATH; R1 := R1-R1; IC(R1,V22(J)); IF R1 = 7 THEN STRINGOP; OUTOP; R0 := 6; V2(J) := R0; R5 := R5SAVE; END; PROCEDURE RELOP(R5); BEGIN LOGICAL R5SAVE; R5SAVE := R5; V1(J+8) := R0; IC(R0,V22(J)); IC(R1,V22(I)); IF R0 <= 3 AND R1 <= 3 THEN BEGIN IF R1 < R0 THEN STC(R0,CONV(R9)) ELSE IF R0 < R1 THEN BEGIN R2 := V5(J); STC(R1,CONV(R2)); END; END ELSE IF R0 ~= 7 OR R1 ~= 7 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; R0 := V1(J+8); REGPATH; R1 := R1-R1; IC(R1,V22(J)); IF R1 = 7 THEN STRINGOP; OUTOP; R0 := 6; V2(J) := R0; R5 := R5SAVE; END; PROCEDURE SHIFT(R5); COMMENT OUTPUT NODE IN R2; BEGIN IC(R0,V22(J)); IC(R1,V22(I)); IF R0 ~= 8 OR R1 ~= 1 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; R0 := R2; REGPATH; OUTOP; IC(R0,V3(J)); IF R0 < 2 THEN R0 := 2; STC(R0,V3(J)); END; SEGMENT PROCEDURE LEVELTWO(R10); BEGIN INTEGER RASAVE; RASAVE := R10; CASE R5 OF BEGIN COMMENT ::= ; COMMENT ::= ) ; BEGIN IC(R0,V22(R8+8)); IF R0 ~= 9 THEN BEGIN R0 := @TYPE1ERROR; ERROR; END ELSE BEGIN IC(R1,V21(R8)); R2 := 1 SHLL R1 SHRL 1; R3 := V1(R8+8); IF R3 ~= R2 AND R3 ~= 0 THEN BEGIN R3 := R3 AND R2; IF = THEN BEGIN R0 := @REFERROR; ERROR; END ELSE BEGIN R3 := V5(R8); STC(R1,CONV(R3)); END; END; END; R0 := @REFX; OUTOP; R0 := 0; STC(R0,V21(R8)); MAXREG; END; COMMENT ::= ) ; BEGIN SUBSCRIPT; IC(R0,V21(R8)); ARRAYDES; END; COMMENT ::= * ) ; BEGIN R9 := @B9(4); R0 := @ARSTAR; STC(R0,OP(R9)); R0 := @INDX; OUTOP; IC(R0,V21(R8)); R0 := R0 + 1; ARRAYDES; END; COMMENT ::= ( ; COMMENT ::= ( ; BEGIN R1 := V1(R8); IC(R0,DIMEN(R1)); IF R0 = 0 THEN R0 := #00FF; V2(R8) := R0; END; COMMENT ::= , ; SUBSCRIPT; COMMENT ::= * , ; BEGIN R9 := @B9(4); R0 := @ARSTAR; STC(R0,OP(R9)); IC(R0,V21(R8)); R0 := R0 + 1; STC(R0,V21(R8)); R0 := @INDX; OUTOP; END; COMMENT ::= ; BEGIN R2 := V1(J); R1 := TYPEINFO(R2); IF R1 = 0 THEN STC(R1,V21(J)) ELSE BEGIN R3 := JSAVE; IC(R0,S(R3-1)); IF R0 ~= APARHEAD THEN BEGIN R0 := @APARERROR; ERROR; END; END; R1 := SIMTYPEINFO(R2); V1(J) := R1; END; COMMENT ::= ) ; BEGIN APARCHECK; R2 := V34(R8); IC(R0,V21(R8)); IF R2 = 0 THEN R0 := @APPAREN ELSE IF R0 = #FF THEN APAREND ELSE BEGIN APAREXPCHECK; APAREND; END; OUTOP; R1 := IHN + 1; IHN := R1; END; COMMENT ::= ) ; APSTATEND; COMMENT ::= ) ; BEGIN R0 := @NULLST; R9 := R9 + 4; STC(R0,OP(R9)); APSTATEND; END; COMMENT ::= ( ; BEGIN R2 := V1(R8); IC(R0,TYPE(R2)); IF R0 = #13 THEN R1 := 0 ELSE BEGIN R2 := TYPEINFO(R2) SHLA 2; IF = THEN BEGIN R0 := @APARERROR; ERROR; R1 := 0; END ELSE BEGIN R0 := 0; R1 := BLENGTH(R2)/12; STC(R1,V21(R8)); R1 := NPOINT(R2); END; R2 := V1(R8); END; V34(R8) := R1; R1 := SIMTYPEINFO(R2); V1(R8) := R1; R1 := IHN - 1; IHN := R1; IF R1 < 5 THEN BEGIN R0 := @HIERARCHYERROR; ERROR; END; END; COMMENT ::= , ; BEGIN APARCHECK; R2 := V34(R8); IC(R0,V21(R8)); IF R2 = 0 OR R0 = #FF THEN R0 := @APCOMMA ELSE BEGIN APAREXPCHECK; APARLIST; END; OUTOP; END; COMMENT ::= , ; APSTATLIST; COMMENT ::= , ; BEGIN R0 := @NULLST; R9 := R9 + 4; STC(R0,OP(R9)); APSTATLIST; END; COMMENT ::= ; COMMENT ::= ; COMMENT ::= ; BEGIN IC(R1,V22(R8+8)); R2 := V5(R8+8) - 8; IC(R0,V22(R7)); R5 := V12(R8+8); V12(R8) := R5; IF R0 ~= R1 THEN BEGIN ARITHCHECK; CONVERT1; END ELSE BEGIN IF R1 = 7 THEN BEGIN R5 := V1(I); IF R5 > V1(J+8) THEN STC(R5,CONV(R2)) ELSE IF R5 < V1(J+8) THEN BEGIN R5 := V1(J+8); STC(R5,CONV(R9)); END; V1(J) := R5; END ELSE IF R1 = 9 THEN BEGIN R5 := V1(R8+8); R1 := V1(R7) OR R5; V1(R8) := R1; END; END; R3 := VX(J); MVI(RTAB1,EDITCODE(R3+3)); OUTLTABX; R0 := @IFEXP; R1 := V5(J+8) - OUTBASE; R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; R1 := V5(J+8); R2 := V5(J) - OUTBASE; POINTER(R1-4):=R2; COMMENT PATCH UJ POINTER; V5(R8):=R9; R1 := #0A04; V34(J) := R1; END; COMMENT ::= ) ; BEGIN CASETYPE; R0 := @CLL; OUTOP; R2 := V2(J); R1 := R2; IF R1 = 7 THEN R1 := V1(R8); CASECOUNT; R2 := P(R9); R9 := R9-4; OUTLTABX; R9 := @B9(4); P(R9) := R2; R1 := #0A04; V34(J) := R1; CASEJUMP; END; COMMENT ::= IF THEN ; BEGIN IC(R0,V22(R8+8)); FORCELOGICAL; R0 := @IFF; STC(R0,OP(R9+4)); R9 := R9 + 8; R0 := @IFJ; R0 := R0 OR #80; STC(R0,OP(R9)); R1 := V5(R8+8)-OUTBASE; POINTER(R9) := R1; OUTRTAB; R3 := EDITINDEX; VX(J) := R3; END; COMMENT ::= ELSE ; BEGIN R9 := @B9(4); R0 := @UJIFEXP; STC(R0,OP(R9)); R0 := @COUNTCODE1; EDITCOUNT; TREECOUNT; END; COMMENT ::= ( ; BEGIN R0 := @RTAB1; EDITCOUNT; TREECOUNT; R0 := 0; V2(J) := R0; COMMENT CLEAR COUNT FIELDS; END; COMMENT := , ; BEGIN CASETYPE; COMMENT CHECK TYPES, SET TYPE BYTE; R0 := @UJ; OUTOP; COMMENT OUTPUT UJ; R0 := @COUNTCODE1; EDITCOUNT; TREECOUNT; END; COMMENT ::= CASE OF ; BEGIN IC(R0,V22(R8+8)); FORCEINTEGER; R9 := @B9(4); R0 := @CASEIDX; STC(R0,OP(R9)); V5(J) := R9; IF DEBUG THEN BEGIN R3 := EDITINDEX - 3; EDITINDEX := R3; VX(J) := R3; MVI(JC,EDITCODE(R3+2)); END; R1 := CHARTLEVEL + 3; CHARTLEVEL := R1; R0 := 0; V1(J) := R0; END; COMMENT ::= ; COMMENT ::= = ; BEGIN R0 := @EQUAL; EQUALOP; END; COMMENT ::= ~= ; BEGIN R0 := @UNEQ; EQUALOP; END; COMMENT ::= < ; BEGIN R0 := @LESS; RELOP; END; COMMENT ::= <= ; BEGIN R0 := @LESSEQ; RELOP; END; COMMENT ::= >= ; BEGIN R0 := @GTEQ; RELOP; END; COMMENT ::= > ; BEGIN R0 := @GREATER; RELOP; END; COMMENT ::= IS ; BEGIN IC(R0,V22(R8)); IF R0 ~= 9 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; R0 := @IS OR #80; OUTOP; R0 := 6; STC(R0,V22(R8)); COMMENT SIMPLE TYPE IS LOG; END; COMMENT ::= ; COMMENT ::= ; COMMENT := + ; BEGIN IC(R0,V22(R7)); IF R0>5 THEN BEGIN R0 := @TYPE1ERROR; ERROR; END; F01:=V(R7); V(R8):=F01; COMMENT SAVE STACK INFO; R3 := VX(J); MVI(UPOS,EDITCODE(R3)); END; COMMENT ::= - ; BEGIN IC(R0,V22(R7)); IF R0>5 THEN BEGIN R0 := @TYPE1ERROR; ERROR; END; F01:=V(R7); V(R8):=F01; R0 := @UMINUS; R9 := @B9(4); STC(R0,OP(R9)); V5(R8):=R9; R3 := VX(J); MVI(UNEG,EDITCODE(R3)); END; COMMENT ::= + ; BEGIN IC(R1,V22(R8)); R2 := V5(R8); BINARYOPCHECK; CONVERT1; R0 := @PLUS; REGPATH; OUTOP; END; COMMENT ::= - ; BEGIN IC(R1,V22(R8)); R2 := V5(R8); BINARYOPCHECK; CONVERT1; R0 := @MINUS; REGPATH; OUTOP; END; COMMENT ::= OR ; BEGIN IC(R0,V22(R8)); IC(R1,V22(R7)); IF R0 = 6 AND R1 = 6 THEN BEGIN F01 := V(R7); V(R8+8) := F01; MAXREG; R0 := @LOGOR; END ELSE IF R0 = 8 AND R1 = 8 THEN BEGIN R0 := @BITOR; REGPATH; END ELSE BEGIN R0 := @TYPE2ERROR; ERROR; R0 := 0; END; OUTOP; END; COMMENT ::= ; BEGIN IC(R1,V22(R8)); R2 := #1 SHLL R1 SHRL 1; V1(R8) := R2; R0 := 9; V2(R8) := R0; COMMENT SIMPLE TYPE := REF; END; COMMENT ::= ); BEGIN IC(R0,V21(R8)); COMMENT GET NUMBER OF FIELDS LEFT; IF R0 ~= 1 THEN BEGIN R0 := @FIELDERROR; ERROR; END; R2 := V1(R8); COMMENT POINTER TO FIELDS; IC(R0,SIMPLETYPE(R2)); R4 := SIMTYPEINFO(R2); CNVRTASSN; COMMENT TYPE CHECK AND CONVERSION; IC(R0,V22(J+8)); IF R0 = 7 THEN BEGIN R1 := R1-R1; STC(R1,CONV(R9)); END; R0 := @RPAREN; OUTOP; R1 := 0; IC(R1,V22(R8)); COMMENT MOVE RCCLNO; R2 := #1 SHLL R1 SHRL 1; V1(R8) := R2; MAXREG; R0 := 9; V2(R8) := R0; COMMENT SIMPLE TYPE := REF; END; COMMENT ::= ) ; BEGIN IC(R0,V21(R8)); IF R0 ~= 1 THEN BEGIN R0 := @FIELDERROR; ERROR; END; R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); R0 := @RPAREN; OUTOP; R1 := 0; IC(R1,V22(R8)); R2 := #1 SHLL R1 SHRL 1; V1(R8) := R2; R0 := 9; V2(R8) := R0; COMMENT REFERENCE; END; COMMENT ::= ; BEGIN R0 := @STRINGG; OUTID; R0 := 0; V34(R8) := R0; IC(R0,STRINGLENGTH); V1(R8) := R0; END; COMMENT ::= NULL; BEGIN R9 := @B9(4); R0 := @NUL; STC(R0,OP(R9)); R0 := 9; STC(R0,V22(R8)); COMMENT SIMPLE TYPE := REF; V5(R8) := R9; R0 := 0; V34(R8) := R0; R1 := 0; V1(R8) := R1; COMMENT SET RC CL MASK; END; COMMENT ::= ; COMMENT ::= ; COMMENT ::= * ; BEGIN IC(R1,V22(R8)); BINARYOPCHECK; COMMENT CHECK TYPES. FIRST ARG IN R1, SECOND IN R0; IF R0 ~= R1 THEN BEGIN R2 := V5(R8); CASE R1 OF BEGIN BEGIN STC(R0,CONV(R2)); IF R0 = 2 THEN R0 := 3 ELSE IF R0 = 4 THEN R0 := 5; STC(R0,V22(R8)); END; BEGIN IF R0 >1 THEN STC(R0,CONV(R2) )ELSE BEGIN R1 := 2; STC(R1,CONV(R9)); END; IF R0 >3 THEN R0 := 5 ELSE R0 := 3; STC(R0,V22(R8)); END; IF R0 < 3 THEN BEGIN R0 := 3; STC(R0,CONV(R9)); END ELSE IF R0 = 4 THEN BEGIN R0 := 5; STC(R0,CONV(R2)); STC(R0,CONV(R9)); STC(R0,V22(R8)); END ELSE BEGIN STC(R0,CONV(R2)); STC(R0,V22(R8)); END; BEGIN IF R0 = 3 THEN BEGIN R0 := 5; STC(R0,CONV(R9)); STC(R0,CONV(R2)); END ELSE IF R0 = 5 THEN STC(R0,CONV(R2) )ELSE BEGIN R0 := 4; STC(R0,CONV(R9)); R0 := 5; END; STC(R0,V22(R8)); END; BEGIN R0 := 5; STC(R0,CONV(R9)); END; END; END ELSE IF R0 = 2 THEN BEGIN R0 := 3; STC(R0,V22(R8)); END ELSE IF R0 = 4 THEN BEGIN R0 := 5; STC(R0,V22(R8)); END; R0 := @TIMES; REGPATH; OUTOP; END; COMMENT ::= / ; BEGIN IC(R1,V22(R8)); R2 := V5(R8); BINARYOPCHECK; CONVERT1; IF R0 = 1 THEN IF R1 = 1 THEN BEGIN R0 := 3; STC(R0,V22 (R8)); STC(R0,CONV(R9)); STC(R0,CONV(R2)); END; R0 := @DIVIDE; REGPATH; OUTOP; END; COMMENT ::= DIV ; BEGIN IC(R0,V22(R8)); IC(R1,V22(R7)); TYPEINTEGER; R0 := @DIV; REGPATH; OUTOP; R0 := 1; V2(J) := R0; R2 := V34(R8); IF R2 < 3 AND R3 ~= 0 THEN R2 := 3 ELSE IF R2 < 2 AND R3 = 0 THEN R2 := 2; V34(R8) := R2; END; COMMENT ::= REM ; BEGIN IC(R0,V22(R8)); IC(R1,V22(R7)); TYPEINTEGER; R0 := @REM; REGPATH; OUTOP; R0 := 1; V2(J) := R0; R2 := V34(R8); IF R2 < 3 AND R3 ~= 0 THEN R2 := 3 ELSE IF R2 < 2 AND R3 = 0 THEN R2 := 2; V34(R8) := R2; END; COMMENT ::= AND ; BEGIN IC(R0,V22(R8)); IC(R1,V22(R7)); IF R0 = 6 AND R1 = 6 THEN BEGIN F01 := V(R7); V(R8+8) := F01; MAXREG; R0 := @LOGAND; END ELSE IF R0 = 8 AND R1 = 8 THEN BEGIN R0 := @BITAND; REGPATH; END ELSE BEGIN R0 := @TYPE2ERROR; ERROR; R0 := 0; END; OUTOP; END; COMMENT ::= ; COMMENT ::= ~ ; BEGIN IC(R0,V22(R7)); IF R0 = 6 THEN R0 := @LOGNOT ELSE IF R0 = 8 THEN R0 := @BITNOT ELSE BEGIN R0 := @TYPE1ERROR; ERROR; END; R9 := @B9(4); STC(R0,OP(R9)); F01:=V(R7); V(R8):=F01; V5(R8):=R9; END; COMMENT ::= ; COMMENT ::= ** ; BEGIN IC(R0,V22(J)); IC(R1,V22(I)); IF R0 > 5 OR R1 ~= 1 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; IF R0 = 1 OR R0 = 2 THEN BEGIN R2 := V5(J); R0 := 3; STC(R0,CONV(R2)); STC(R0,V22(J)); END; REGPATH; R0 := @EXPON; OUTOP; COMMENT FORCE LEFT; END; COMMENT ::= SHL ; BEGIN R2 := @SHL; SHIFT; END; COMMENT ::= SHR ; BEGIN R2 := @SHR; SHIFT; END; END; COMMENT END OF CASE STATEMENT; R10 := RASAVE; END; COMMENT END OF LEVELTWO; LEVELTWO; END; COMMENT END OF EXECUTE2; SEGMENT PROCEDURE EXECUTE3(R6); BEGIN PROCEDURE DECLEDIT(R10); COMMENT FIX-UP EDITCODE DECLARATION JUMP (R0=TYPE); BEGIN R3 := VX(J+8); STC(R0,EDITCODE(R3+3)); R1 := EDITBASE - EDITINDEX; STC(R1,EDITCODE(R3+2)); R1 := R1 SHRL 8; STC(R1,EDITCODE(R3+1)); R3 := EDITINDEX - 3; EDITINDEX := R3; END; PROCEDURE CLOSEBLOCK(R5); BEGIN R1 := BLC - 2; BLC := R1; R9 := @B9(4); R0 := @ENDD; R1 := V2(J) - OUTBASE; STC(R0,OP(R9)); POINTER(R9) := R1; R2 := V1(J); IF R2 > 0 THEN BEGIN LOGICAL R5SAVE; R5SAVE := R5; R1 := OUTBASE + 12; V5(J) := R1; CLOSESEGMENT; R0 := @FUNCID; OUTID; R5 := R5SAVE; R3 := VX(J); R1 := EDITBASE - EDITINDEX; STC(R1,EDITCODE(R3+6)); R1 := R1 SHRL 8; STC(R1,EDITCODE(R3+5)); END; V5(J) := R9; END; PROCEDURE LABELCHECK(R5); COMMENT CHECKS FOR LABEL DEF AS NEXT PAIR OF INPUT TOKENS; BEGIN R2 := INPOINT; CLI(COLON1,B2(1)); IF = THEN BEGIN R0 := @COUNTCODE; EDITCOUNT; END; END; PROCEDURE IFTHENSTATEMENT(R5); BEGIN R1 := V5(R8+8); R2 := V5(R8) - OUTBASE; POINTER(R1-4) := R2; COMMENT PATCH UJ; OUTLTAB; R9 := @B9(4); R0 := @IFST; STC(R0,OP(R9)); R1 := V5(J+8) - OUTBASE; POINTER(R9) := R1; V5(J) := R9; R0 := 0; V34(J) := R0; END; PROCEDURE IFSTATEMENT(R5); BEGIN OUTLTAB; R0 := @IFST2; OUTOP; R0 := R0-R0; V34(J) := R0; END; PROCEDURE LOOPCLOSE(R10); COMMENT EMITS EDITCODE JUMP TO CLOSE LOOP; IF DEBUG THEN BEGIN R3 := EDITINDEX - 3; EDITINDEX := R3; R1 := EDITBASE - VX(J) - 1; R0 := @JLOOP; STC(R0,EDITCODE(R3+2)); STC(R1,EDITCODE(R3+1)); R1 := R1 SHRL 8; STC(R1,EDITCODE(R3)); END; PROCEDURE WHILESTATEMENT(R5); BEGIN LOOPCLOSE; OUTLTAB; R0 := @WHILEST; OUTOP; R0 := 0; V34(J) := R0; END; PROCEDURE FORSTATEMENT(R5); BEGIN R1 := V1(J); IF R1 ~= 1 THEN BEGIN LOOPCLOSE; OUTLTAB; END; R1 := V1(J); IF R1 = 0 THEN R0 := @ITERST ELSE R0 := @ITERST2; OUTOP; R0 := 0; V34(J) := R0; R1 := BLC - 2; BLC := R1; END; PROCEDURE ASSIGNMENT(R5); BEGIN R0 := V2(R8); IF R0 > #FF THEN BEGIN R0 := @ARRAYERROR; ERROR; R0 := V2(R8) AND #FF; END; F01 := V(R7); V(R8+8) := F01; R4 := V1(R8); CNVRTASSN; REGPATH; R1 := 0; IC(R1,V22(R7)); IF R1 = 7 THEN STRINGOP; OUTOP; END; PROCEDURE CASESEQEND(R5); BEGIN LOGICAL R5SAVE; R5SAVE := R5; R1 := BLC - 2; BLC := R1; OUTLTAB; CASEJUMP; R0 := @CLL; OUTOP; R1 := 0; R2 := R1; CASECOUNT; R0 := 0; V34(J) := R0; R5 := R5SAVE; END; PROCEDURE RESULT(R5); BEGIN R1 := V34(R8); IF R1 = 2 THEN BEGIN IC(R0,OP(R9)); R0 := R0 AND #7F; IF R0 ~= 30 AND R0 ~= 31 AND R0 ~= 40 AND R0 ~= 62 AND R0 ~= 87 AND R0 ~= 89 THEN BEGIN R0 := @RESULTERROR; ERROR; END; END; END; SEGMENT PROCEDURE LEVELTWO(R10); BEGIN INTEGER RASAVE; RASAVE := R10; CASE R5 OF BEGIN COMMENT ::= ; COMMENT ::= ; BEGIN IC(R0,V22(J)); IF R0 = 0 THEN SET(FLAG) ELSE BEGIN R1 := #0A04; V34(J) := R1; IC (R0,OP(R9)); R4 := @FUNCID; IF R0 ~= R4 THEN BEGIN R1 := 0; STC(R1,V21(J)); END; END; END; COMMENT ::= END ; BEGIN R0 := @COMMA; OUTOP; R2 := V1(J); IF R2 > 0 THEN BEGIN R1 := V1(J+8); SIMTYPEINFO(R2) := R1; IC(R0,V22(J+8)); STC(R0,SIMPLETYPE(R2)); END; CLOSEBLOCK; R1 := V12(J+8); V12(J) := R1; R1 := #0A04; V34(J) := R1; END; COMMENT ::= END ; BEGIN R0 := @BLOCKEXPERROR; R0 := NEG R0; ERROR; R1 := #0A04; V34(J) := R1; END; COMMENT ::= ) ; BEGIN R1 := V1(R8); IF R1 = 0 THEN BEGIN F01 := V(R8+8); V(R8) := F01; END ELSE BEGIN R0 := TYPEINFO(R1); COMMENT GET SIMPLE TYPE OF FPAR; R4 := IDLOC1(R1); COMMENT GET SIMTYPEINFO OF FPAR; CNVRTASSN; R0 := @APPAREN; OUTOP; R1 := V1(R8); R1 := SIMTYPEINFO(R1); V1(R8) := R1; END; END; COMMENT ::= TRUE; BEGIN R0 := @TRUE; R1 := 8; BOOLVALUE; END; COMMENT ::= FALSE ; BEGIN R0 := @FALSE; R1 := 4; BOOLVALUE; END; COMMENT ::= ; COMMENT ::= LONG ; BEGIN F01:=V(R8+8); V(R8):=F01; COMMENT SAVE VALUE INFO; IC(R0,V22(R8)); IF R0 = 1 OR R0 = 2 THEN R0 := 3 ELSE IF R0 = 4 THEN R0 := 5 ELSE BEGIN R0 := @TYPE1ERROR; ERROR; END; STC(R0,CONV(R9)); STC(R0,V22(R8)); END; COMMENT ::= SHORT ; BEGIN F01 := V(R8+8); V(R8) := F01; COMMENT SAVE VALUE INFO; IC(R0,V22(R8)); IF R0 = 3 THEN R0 := 2 ELSE IF R0 = 5 THEN R0 := 4 ELSE BEGIN R0 := @TYPE1ERROR; ERROR; END; STC(R0,CONV(R9)); STC(R0,V22(R8)); END; COMMENT ::= ABS ; BEGIN IC(R0,V22(R7)); IF R0 = 1 THEN BEGIN IC(R1,V3(R8)); IF R1 = 0 THEN STC(R0,V3(R8)); END ELSE IF R0 < 4 THEN BEGIN IC(R1,V4(R8)); IF R1 = 0 THEN R1 := 1; STC(R1,V4(R8)); END ELSE BEGIN IC(R1,V3(R8)); IF R1 < 4 THEN R1 := 4; STC(R1,V3(R8)); IC(R1,V4(R8)); IF R1 < 4 THEN R1 := 4; STC(R1,V4(R8)); END; IF R0 > 5 THEN BEGIN R0 := @TYPE1ERROR; ERROR; END ELSE IF R0 = 4 THEN BEGIN R0 := 2; STC(R0,V22(R7)); END ELSE IF R0 = 5 THEN BEGIN R0 := 3; STC(R0,V22(R7)); END; R9 := @B9(4); R0 := @ABSS; STC(R0,OP(R9)); F01:=V(R7); V(R8):=F01; V5(R8):=R9; END; COMMENT ::= ; BEGIN IC(R0,V22(R8)); LITERAL; V1(R8) := R5; R0 := @NUMBER; OUTID; R0 := 0; V34(R8) := R0; END; COMMENT ::= ; BEGIN R0 := @BITT; OUTID; R0 := 0; V34(R8) := R0; END; COMMENT ::= (; BEGIN R0 := 0; V1(R8) := R0; END; COMMENT ::= ( ; BEGIN R0 := 0; STC(R0,V21(R8)); COMMENT TYPE SET TO ZERO; END; COMMENT ::= (; BEGIN R2 := V1(R8); IC(R1,VR(R2)); COMMENT GET NUMBER OF FIELDS; IF R1 = 0 THEN BEGIN R2 := R2 + 12; IC(R0,TYPE(R2)); WHILE R0 = 5 DO BEGIN R2 := R2 + 12; R1 := R1 + 1; IC(R0,TYPE(R2)); END; R2 := V1(R8); STC(R1,VR(R2)); END; STC(R1,V21(R8)); R2 := R2 + 12; V1(R8) := R2; COMMENT POINTER TO FIELDS IN V1(J); END; COMMENT ::= , ; BEGIN IC(R0,V21(R8)); COMMENT GET NUMBER OF FIELDS LEFT; IF R0 = 1 THEN BEGIN R0 := @FIELDERROR; ERROR; END; R0 := R0 - 1; STC(R0,V21(R8)); COMMENT DECREASE FIELD CNT; R2 := V1(R8); COMMENT POINTER TO FIELDS; R4 := SIMTYPEINFO(R2); IC(R0,SIMPLETYPE(R2)); R2 := R2 + 12; V1(R8) := R2; COMMENT STEP FIELD POINTER; CNVRTASSN; COMMENT TYPE CHECK AND CONVERSION; IC(R0,V22(J+8)); IF R0 = 7 THEN BEGIN R1 := R1-R1; STC(R1,CONV(R9)); END; R0 := @RCOMMA; OUTOP; MAXREG; COMMENT ADJUST REGISTER COUNTS; END; COMMENT ::= , ; BEGIN IC(R0,V21(R8)); IF R0 = 1 THEN BEGIN R0 := @FIELDERROR; ERROR; END; R0 := R0 - 1; STC(R0,V21(R8)); COMMENT DECREMENT FIELD COUNT; R2 := V1(R8) + 12; V1(R8) := R2; COMMENT STEP FIELD POINTER; R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); R0 := @RCOMMA; OUTOP; END; COMMENT ::= . . ; NULL; COMMENT NEVER ENTERED. SEE END OF PROGRAM; COMMENT ::= <statement*> ; COMMENT <statement*> ::= ; COMMENT <statement*> ::= ; BEGIN NULLSTATEMENT; FORSTATEMENT; END; COMMENT <statement*> ::= <statement*> ; FORSTATEMENT; COMMENT <statement*> ::= ; BEGIN NULLSTATEMENT; WHILESTATEMENT; END; COMMENT <statement*> ::= <statement*> ; WHILESTATEMENT; COMMENT <statement*> ::= ; BEGIN NULLSTATEMENT; IFSTATEMENT; END; COMMENT <statement*> ::= <statement*> ; IFSTATEMENT; COMMENT <statement*> ::= ; BEGIN NULLSTATEMENT; IFTHENSTATEMENT; END; COMMENT <statement*> ::= <statement*>; IFTHENSTATEMENT; COMMENT <statement*> ::= END ; BEGIN R3 := EDITINDEX + 1; EDITINDEX := R3; NULLSTATEMENT; R3 := EDITINDEX - 1; EDITINDEX := R3; R0 := ENDCODE; STC(R0,EDITCODE(R3)); CASESEQEND; END; COMMENT <statement*> ::= END ; CASESEQEND; COMMENT ::= ; BEGIN R0 := 0; V34(R8) := R0; END; COMMENT ::= ; BEGIN R0 := 0; V34(R8) := R0; END; COMMENT ::= GOTO ; BEGIN R9 := @B9(4); R0 := @GOTOO;STC(R0,OP(R9)); V5(R8):=R9; R0 := 0; V34(R8) := R0; END; COMMENT ::= ); BEGIN RESULT; R0 := @APPAREN; OUTOP; R0 := 0; V34(R8) := R0; END; COMMENT ::= ) ; BEGIN R0 := @CONTROL; R1 := V1(J+8); R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; R0 := @APPAREN; OUTOP; R0 := R0-R0; V34(J) := R0; END; COMMENT ::= ASSERT ; BEGIN IC(R0,V22(R8+8)); FORCELOGICAL; R0 := @ASSERT; R9 := @B9(4); STC(R0,OP(R9)); V5(R8) := R9; END; COMMENT ::= END ; BEGIN R1 := EDITINDEX; IC(R0,EDITCODE(R1+1)); IF R0 = SCOLCODE THEN MVI(SEMI1,EDITCODE(R1+1)); CLOSEBLOCK; END; COMMENT ::= END ; BEGIN R0 := @COMMA; OUTOP; CLOSEBLOCK; END; COMMENT ::= ., ; BEGIN R2 := R6SAVE; IF R2 = ENDCODE THEN BEGIN R0 := @COMMA; OUTOP; R2 := V1(J); IF R2 > 0 THEN BEGIN R1 := V1(J+8); SIMTYPEINFO(R2) := R1; IC(R0,V22(J+8)); STC(R0,SIMPLETYPE(R2)); END; CLOSEBLOCK; R1 := V12(J+8); V12(J) := R1; END; END; COMMENT ::= ; BEGIN R3 := V1(R8); IF R3 ~= 0 THEN BEGIN R9 := @B9(4); R0 := @BBB; R1 := V2(J) - OUTBASE; STC(R0,OP(R9)); POINTER(R9) := R1; V2(J) := R9; R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); CARDOUT; R2 := BLC; R3 := DISPLAY(R2); R2 := BLENGTH(R3); R3 := NPOINT(R3); R4 := DRELAD + 3 AND #FFFFFFFC; R2 := R2 + R3 - 12; FOR R3 := R3 STEP 12 UNTIL R2 DO BEGIN R5 := TYPES(R3); IF R5 = #209 THEN BEGIN R5 := IDLOC2(R3) + R4 + 8; IDLOC2(R3) := R4; R4 := R5; END; END; DRELAD := R4; R3 := EDITINDEX + 2; MVI(FD,EDITCODE(R3)); END ELSE R3 := EDITINDEX + 3; EDITINDEX := R3; LABELCHECK; END; COMMENT ::= ., ; BEGIN R1 := T0(J+8); IF R1 <= BLC THEN BEGIN R0 := @COUNTCODE; EDITCOUNT; R0 := @UCOUNT; R1 := NODEINDEX; R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; END; R0 := @COMMA; OUTOP; CARDOUT; LABELCHECK; END; COMMENT ::= ; BEGIN R0 := @LCOMMA; OUTOP; LABELCHECK; END; COMMENT ::= ., ; BEGIN R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); R0 := @COMMA; OUTOP; LABELCHECK; END; COMMENT ::= BEGIN ; BEGIN BLOCKSTEP; COMMENT R1 := 4*BN; R2 := BLENGTH(R1); R4 := R4-R4; R3 := JSAVE; IC(R4,S(R3-1)); IC(R4,BBCONTEXT(R4)); COMMENT BB CONTEXT CODES: 0 = BASIC BLOCK BRACKET, 1 = PROC HEAD, 2 = OTHER; IF R4 = 0 THEN BEGIN IF R2 = 12 THEN BLOCKLIST(R1) := R4 ELSE BEGIN COMMENT CHECK FOR LABELS ONLY; R3 := NPOINT(R1); IC(R0,TYPE(R3+12)); IF R0 ~= 1 THEN R4 := 2; COMMENT FORCE SEGMENT; END; END; IF R4 = 0 THEN V1(J) := R4 ELSE BEGIN R1 := NPOINT(R1); IF R4 = 1 THEN BEGIN R4 := NEG R4; V1(J) := R4; END ELSE BEGIN COMMENT MAKE BLOCK INTO PROCEDURE; R0 := 3; STC(R0,TYPE(R1)); V1(J) := R1; V2(J) := R2; OPENSEGMENT; CARDOUT; R3 := EDITINDEX - 2; EDITINDEX := R3; MVI(JB,EDITCODE(R3+2)); R0 := @NTAB; EDITCOUNT; TREECOUNT; R0 := BEGINCODE; R3 := EDITINDEX - 1; STC(R0,EDITCODE(R3)); VX(J) := R3; EDITINDEX := R3; R1 := V1(J) + 12; R2 := V2(J) - 12; END; R4 := DRELAD; WHILE R2 > 0 DO BEGIN IC(R0,SIMPLETYPE(R1)); IF R0 = 9 THEN BEGIN REFBIND; IC(R0,TYPE(R1)); IF R0 = 0 THEN BEGIN R4 := R4+3 AND #FFFC; IDLOC2(R1) := R4; R4 := R4+4; END; END; IC(R0,TYPE(R1)); IF R0 = 3 THEN BEGIN R5 := TYPEINFO(R1) SHLL 2; IF R5 ~= 0 THEN BEGIN INTEGER R1SAVE; R1SAVE := R1; R1 := NPOINT(R5); R5 := BLENGTH(R5); WHILE R5 > 0 DO BEGIN IC(R0,SIMPLETYPE(R1)); IF R0 = 9 THEN REFBIND; R1 := R1 + 12; R5 := R5 - 12; END; R1 := R1SAVE; END; END; R1 := R1 + 12; R2 := R2 - 12; END; COMMENT END OF WHILE STATEMENT; DRELAD := R4; END; R9 := @B9(4); R0 := @BEGINN; R1 := BN; STC(R0,OP(R9)); POINTER(R9) := R1; CARDOUT; V2(J) := R9; R9 := @B9(4); R0 := @NULLST; STC(R0,OP(R9)); V5(J) := R9; R3 := EDITINDEX - 3; EDITINDEX := R3; END; COMMENT ::= ., ; BEGIN R0 := @JD; DECLEDIT; END; COMMENT ::= ., ; BEGIN R1 := T0(J+8); IF R1 <= BLC THEN BEGIN R0 := @COUNTCODE; EDITCOUNT; R9 := @B9(4); R0 := @UCOUNT; R1 := NODEINDEX; STC(R0,OP(R9)); POINTER(R9) := R1; END; R0 := @COMMA; OUTOP; R0 := @JAD; DECLEDIT; END; COMMENT ::= ., ; BEGIN R0 := @JPD; DECLEDIT; END; COMMENT ::= ., ; BEGIN R0 := @JD; DECLEDIT; END; COMMENT := : ; BEGIN R1 := V1(R8); V1(R7) := R1; DECLAREID; R0 := @ID; OUTID; R2 := LABELADDR; IDLOC2(R1) := R2; R2 := R2 + 4; LABELADDR := R2; R2 := SNC; IDLOC1(R1) := R2; R2 := HN; TYPEINFO(R1) := R2; TREECOUNT; END; COMMENT ::= := ; ASSIGNMENT; COMMENT ::= := ; BEGIN COMMENT MULTIPLE ASSIGNMENTS FORCED TO RIGHT; IC(R0,OP(R9)); R0 := R0 OR #90; STC(R0,OP(R9)); ASSIGNMENT; IC(R0,OP(R9)); R0:=R0 OR #80; STC(R0,OP(R9)); END; COMMENT ::= ELSE ; BEGIN R0 := @UJ; R9 := @B9(4); STC(R0,OP(R9)); OUTCOUNT; END; COMMENT ::= ELSE ; BEGIN NULLSTATEMENT; R0 := @UJ; R9 := @B9(4); STC(R0,OP(R9)); OUTCOUNT; END; COMMENT ::= BEGIN ; BEGIN R3 := EDITINDEX - 1; MVI(RTAB0,EDITCODE(R3+1)); R0 := BEGINCODE; STC(R0,EDITCODE(R3)); EDITINDEX := R3; CARDOUT; OUTCOUNT; BLOCKSTEP; END; COMMENT ::= ., ; BEGIN R0 := @UJ; OUTOP; CARDOUT; OUTCOUNT; END; COMMENT ::= ., ; BEGIN NULLSTATEMENT; R0 := @UJ; OUTOP; CARDOUT; OUTCOUNT; END; COMMENT ::= DO ; BEGIN IC(R0,V22(J+16)); IF R0 ~= 1 THEN BEGIN R0 := @TYPE2ERROR; ERROR; END; R0 := @STEPUNTIL; R1 := V5(J+8) - OUTBASE; R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; R0 := @FORCL OR #80; OUTOP; OUTRTAB; RESETDISPLAY; R1 := R1-R1; V1(J) := R1; END; COMMENT ::= DO ; BEGIN R0 := @ENDFORLIST; STC(R0,OP(R9)); RESETDISPLAY; R1 := 1; V1(J) := R1; R0 := @NTAB; EDITCOUNT; TREECOUNT; END; COMMENT ::= DO ; BEGIN IC(R0,V22(J+8)); FORCEINTEGER; R0 := @ENDFORLIST; OUTOP; OUTRTAB; RESETDISPLAY; R1 := 2; V1(J) := R1; END; COMMENT ::= := ; BEGIN IC(R0,V22(I)); FORCEINTEGER; R0 := @ACOLONEQ OR #80; OUTOP; END; COMMENT ::= , ; BEGIN R0 := @FORLIST; STC(R0,OP(R9)); END; COMMENT ::= , ; BEGIN IC(R0,V22(J+8)); FORCEINTEGER; R0 := @FORLIST; OUTOP; END; COMMENT ::= FOR ; BEGIN BLOCKSTEP; DECLAREID; R1 := V1(J); R4 := DRELAD + 3 AND #FFFFFFFFC; IDLOC2(R1) := R4; R4 := R4 + 4; DRELAD := R4; R4 := HN; IDLOC1(R1) := R4; R0 := @CONID; OUTID; R1 := BLC; R2 := DISPLAY(R1); V2(J) := R2; R1 := R1 - 2; BLC := R1; END; COMMENT ::= STEP UNTIL ; BEGIN IC(R0,V22(J+8)); FORCEINTEGER; F01 := V(J+8); V(J) := F01; END; COMMENT := UNTIL ; BEGIN R9 := @B9(4); R0 := @NUMBER; STC(R0,OP(R9)); V5(J) := R9; END; COMMENT ::= WHILE DO ; BEGIN IC(R0,V22(J+8)); FORCELOGICAL; R9 := @B9(4); R0 := @WHILEE; STC(R0,OP(R9)); R0 := @WHILEOP OR #80; R1 := V5(J+8) - OUTBASE; R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; OUTRTAB; END; COMMENT ::= ( ; NULL; COMMENT ::= , ; BEGIN RESULT; R0 := @APCOMMA; OUTOP; END; COMMENT ::= , ; BEGIN R0 := @CONTROL; R1 := V1(J+8); R9 := @B9(4); STC(R0,OP(R9)); POINTER(R9) := R1; R0 := @APCOMMA; OUTOP; END; END; COMMENT END OF CASE ST; R10 := RASAVE; END; COMMENT END OF LEVELTWO; LEVELTWO; END; COMMENT END OF EXECUTE3; SEGMENT PROCEDURE PARSE(R10); BEGIN LOGICAL RASAVE; T PROCEDURE INSYMBOL(R3); COMMENT INSYMBOL PUTS NEXT SYMBOL IN R6, BIT STRING OR STRING IN LITERAL TABLE, NUMBER IN NUMVAL, ID NO. IN VALUE; BEGIN R2 := INPOINT; L: R2 := @B2(1); OLDINPOINT := R2; IC(R6,PROGRAM(R2)); MVI(0,SIMTYPE); R4 := R4-R4; R5 := R4; IC(R4,INPUTSW(R6)); CASE R4 OF BEGIN NULL; COMMENT 1 => SYMBOLS NOT REQUIRING SPECIAL PROCESSING; BEGIN COMMENT 2 => LETTER ; IC(R5,LETTERIDNO(R6-192)); R6 := IDCODE; END; BEGIN COMMENT 3 => ID ; IC(R5,PROGRAM(R2+1)); R5 := R5 SHLL 8; IC(R5,PROGRAM(R2+2)); R2 := @B2(2); END; BEGIN COMMENT 4 => DIGIT ; R5 := R6 AND #F; INUMVALUE := R5; MVI(1,SIMTYPE); R6 := NUMBERCODE; END; BEGIN COMMENT 5 => NUMBER ; R4 := 1; COMMENT R4 = TYPE, F01 = VALUE; CLI("'",B2(2)); IF = THEN F01 := 1L ELSE F01 := 0L; IC(R5,B2(1)); R1 := @B2(2); R2 := @B2(R5+2); R5 := R5-R5; WHILE R1 <= R2 DO BEGIN IC(R0,B1); IF R0 >= "0" THEN BEGIN R0 := R0 AND #F; STC(R0,FCONV(1)); F01 := F01*10L + FCONV; IF R4 > 1 THEN R5 := R5 - 1; END ELSE IF R0 = "." THEN R4 := 2 ELSE IF R0 = "'" THEN BEGIN R4 := 2; SCALE := R5; RESET(SIGN); R5 := R5-R5; R1 := @B1(1); IC(R0,B1); IF R0 = "+" THEN R1 := @B1(1) ELSE IF R0 = "-" THEN BEGIN R1 := @B1(1); SET(SIGN); END; WHILE R1 <= R2 DO BEGIN IC(R0,B1); IF R0 < "0" THEN GOTO X; R0 := R0 AND #F; R5 := R5*10S + R0; R1 := @B1(1); END; X: IF SIGN THEN R5 := NEG R5; R5 := R5 + SCALE; DECR(R1); END ELSE IF R0 = "I" THEN R4 := 4 ELSE IF R0 = "L" THEN BEGIN IF R4 = 1 THEN R4 := 2; R4 := R4 + 1; END; R1 := @B1(1); END; IF F01 = 0L THEN NUMVALUE := F01 ELSE IF R4 = 1 THEN BEGIN COMMENT INTEGER; F01 := F01 ++ #4E00000000000000L; NUMVALUE := F01; R1 := NUMVALHIGH; IF R1 ~= #4E000000 THEN BEGIN R0 := @CONVERR; ERROR; END; END ELSE BEGIN COMMENT REAL, IMAGINARY WITH SCALING; IF R5 < 0 THEN SET(SIGN) ELSE RESET(SIGN); R0 := ABS R5; F23 := 1L; R5 := 0; IF R0 > 75 THEN BEGIN R0 := @CONVERR; ERROR; END ELSE WHILE R0 ~= 0 DO BEGIN SRDL(R0,1); LTR(R1,R1); IF < THEN F23 := F23*POWER10(R5); R5 := R5 + 8; END; NUMVALUE := F23; R1 := R1-R1; IC(R1,NUMVALUE(0)); R1 := R1 - #40; MVI(#40,NUMVALUE(0)); IF ~SIGN THEN F01 := F01*NUMVALUE ELSE BEGIN R1 := NEG R1; F01 := F01/NUMVALUE; END; NUMVALUE := F01; IC(R0,NUMVALUE(0)); R1 := R1 + R0; STC(R1,NUMVALUE(0)); IF < OR R1 > #7F THEN BEGIN R0 := @CONVERR; ERROR; END; IF R4 = 2 OR R4 = 4 THEN BEGIN F01 := NUMVALUE; MVC(2,NUMVALUE(1),#000000); F01 := F01 + NUMVALUE; NUMVALUE := F01; END; END; STC(R4,SIMTYPE); R1 := R1-R1; END; BEGIN COMMENT 6 => STRING ; R0 := 7; STC(R0,SIMTYPE); R4 := @PROGRAM(R2+2); IC(R5,PROGRAM(R2+1)); STC(R5,STRINGLENGTH); R2 := @B2(R5+2); LITERAL; END; BEGIN COMMENT 7 => BITS ; R0 := 8; STC(R0,SIMTYPE); R4 := @PROGRAM(R2+1); R2 := @B2(4); LITERAL; END; BEGIN COMMENT 8 => SITYPE ; CLI(#07,B2(1)); IF = THEN R2 := @B2(2) ELSE R2 := @B2(1); END; BEGIN COMMENT 9 => BEGIN, SEMICOLON ; R4 := SCOORD + 1; SCOORD := R4; END; BEGIN COMMENT 10 => VOID ; GOTO L; END; END; INPOINT := R2; VALUE := R5; END; PROCEDURE FETCH(R10); COMMENT R4 := RELATION(R1,R2). R1-R4 ARE ALTERED, R1 AND R2 ARE CLEARED; BEGIN R1 := R1 + R1; IC(R2,CMAP(R2)); R2 := R2 + RMAP(R1); R4 := R4-R4; R1 := R4; IC(R4,MATRIX(R2)); R2 := R1; END; PROCEDURE BACKUP(R10); COMMENT RESTORE INPUT STREAM BY 1 SYMBOL (ADVANCES BETWEEN CALLS); BEGIN R2 := OLDINPOINT - 1; INPOINT := R2; END; PROCEDURE RECOVER(R10); COMMENT ADJUSTS STACK AND INPUT AFTER SYNTAX ERRORS; BEGIN LOGICAL RASAVE; RASAVE := R10; RESET(FLAG); RESET(ERRFLAG); R0 := R0-R0; OLDEDIT := R0; COMMENT DELETE BRACKETED ERROR; IC(R0,S(I)); IF R0 = ENDCODE THEN BEGIN R1 := R0; R2 := R6; FETCH; IF R4 ~= 0 THEN BEGIN WHILE R0 ~= BHCODE AND R0 ~= BBCODE AND R0 ~= BBEXPCODE AND R0 ~= CASESEQCODE DO BEGIN DECR(I); IC(R0,S(I)); IF R0 = ENDFILE THEN GOTO ADVANCE; END; DECR(I); END; END; COMMENT ADVANCE INPUT TO ".,", "BEGIN", "END", OR "."; ADVANCE: WHILE R6 ~= BEGINCODE AND R6 ~= ENDCODE DO BEGIN IF R6 = FORCODE THEN BEGIN R4 := BN + 4; BN := R4; END; IF R6 = ENDFILE THEN GOTO Q; IF R6 = SCOLCODE THEN BEGIN INSYMBOL; GOTO UNSTACK; END; INSYMBOL; END; COMMENT UNSTACK TO , , OR ; UNSTACK: IC(R0,S(I)); IF R0 ~= BHCODE AND R0 ~= BBCODE AND R0 ~= BBEXPCODE AND R0 ~= CASESEQCODE AND R0 ~= ENDCODE AND R0 ~= ENDFILE THEN BEGIN IF R0 = BNDLSTHD OR R0 = FORHD OR R0 = FORLISTCODE THEN BEGIN J := I SHLA 3; RESETDISPLAY; END ELSE IF R0 = PROCNT THEN BEGIN R4 := BLC - 2; BLC := R4; R4 := HN + 1; HN := R4; END ELSE IF R0 = FORCLCODE THEN BEGIN R4 := BLC - 2; BLC := R4; END; IF I ~= 1 THEN DECR(I) ELSE BEGIN COMMENT OUTER BLOCK CLOSED PREMATURELY; R0 := BHCODE; STC(R0,S(1)); MVI(#01,S2(0)); END; GOTO UNSTACK; END; IF R0 = ENDCODE THEN BEGIN BACKUP; R6 := SCOLCODE; END; R3 := I SHLA 3; R9 := V5(R3); R1 := 0; IF R0 = BBCODE OR R0 = BBEXPCODE THEN BEGIN R0 := BHCODE; STC(R0,S(I)); V1(R3) := R1; END; J := I; R10 := RASAVE; END; RASAVE := R10; COMMENT INITIALIZE TREE AND PARSE VARIABLES; MVI(#13,TYPE(0)); COMMENT USED IN ERROR RECOVERY; R0 := ENDFILE; STC(R0,S(0)); MVI(#01,S2(0)); IF PROCCOMP THEN BEGIN COMMENT PARSE PROCEDURE; R1 := 0; I := 0; RESET(DEBUGFLAG); END ELSE BEGIN COMMENT COMPILE STATEMENT; R0 := @PROCDC; STC(R0,OP(R9+4)); R0 := @CARD; R1 := 1; STC(R0,OP(R9+8)); POINTER(R9+8) := R1; R0 := @UCOUNT; STC(R0,OP(R9+12)); R9 := @B9(12); R1 := 0; V12(8) := R1; R1 := 8; V34(8) := R1; V5(8) := R9; R1 := DPDORG; DRELAD := R1; R0 := TPROCHD; STC(R0,S(1)); MVI(#01,S2(1)); R1 := 1; I := 1; END; SN := R1; SNC := R1; R0 := 0; R1 := R0; R6 := R0; SCOORD := R0; INSYMBOL; WHILE R6 ~= ENDFILE DO BEGIN I := I + 1; R2 := I SHLA 3; STC(R6,S(I)); COMMENT NEW SYMBOL TO STACK; R5 := VALUE; V1(R2) := R5; IC(R0,SIMTYPE); V2(R2) := R0; COMMENT MOVE SYMBOL TO OUTPUT STRING; D R3 := EDITINDEX; OLDEDIT := R3; DECR(R3); VX(R2) := R3; R5 := OLDINPOINT; IC(R0,B5(0)); STC(R0,EDITCODE(R3)); R10 := INPOINT - R5; IF > THEN BEGIN IF R6 = NUMBERCODE OR R6 = STRINGCODE THEN BEGIN DECR(R3); R5 := @B5(1); IC(R0,B5(0)); STC(R0,EDITCODE(R3)); DECR(R10); END; R3 := R3 - R10; DECR(R10); EX(R10,MVC(0,EDITCODE(R3),B5(1))); END; EDITINDEX := R3; J := I; INSYMBOL; IC(R1,S(J)); RESET(ERRFLAG); R2 := R6; FETCH; Z0: WHILE R4 = GTR DO BEGIN IC(R4,S2(J-1)); WHILE R4 = EQL DO BEGIN DECR(J); IC(R4,S2(J-1)); END; R3 := R3-R3; IC(R3,S(J)); COMMENT FIND RULE; R3 := R3 ++ R3; R3 := MTB(R3); R3 := @PRTB(R3); R2 := I - J; Z1: IF R2 = 0 THEN BEGIN L: IC(R1,B3); IF R1 = 0 THEN GOTO Z2; IF R1 ~= #FF THEN BEGIN R3 := @B3(R1+4); GOTO L; END; END ELSE BEGIN R4 := @S(J); L: IC(R1,B3); IF R1 = R2 THEN BEGIN EX(R2,CLC(0,B3(1),B4)); IF = THEN GOTO Z2; END; IF R1 ~= #FF THEN BEGIN R3 := @B3(R1+4); GOTO L; END; END; SET(FLAG); GOTO Z3; Z2: RESET(FLAG); R5 := R5-R5; IC(R5,B3(R2+3)); IF R5 ~= 0 THEN BEGIN STM(R1,J,PARSEREG); I := I SHLA 3; J := J SHLA 3; IF R5 <= 54 THEN EXECUTE1 ELSE IF R5 <= 101 THEN BEGIN R5 := R5 - 54; EXECUTE2; END ELSE BEGIN R5 := R5 - 101; EXECUTE3; END; IF ~FLAG THEN BEGIN R5 := RULENUMBER; IC(R5,ATTRTB(R5-1)); IF R5 ~= 0 THEN BEGIN CASE R5 OF BEGIN BEGIN COMMENT 1 => NON-ID TERMINALS; R1 := #FF; COMMENT INFINITY; END; BEGIN COMMENT 2 => UNARY PREFIX OPERATOR; R1 := T0(J+8); END; BEGIN COMMENT 3 => BINARY INFIX OPERATOR; R1 := T0(J); IF R1 > T0(J+16) THEN R1 := T0(J+16); END; BEGIN COMMENT 4 => BINARY POSTFIX OPERATOR; R1 := T0(J); IF R1 > T0(J+8) THEN R1 := T0(J+8); END; BEGIN COMMENT 5 => TERNARY INFIX OPERATOR; R1 := T0(J); IF R1 > T0(J+8) THEN R1 := T0(J+8); IF R1 > T0(J+24) THEN R1 := T0(J+24); END; BEGIN COMMENT 6 => TERNARY POSTFIX OPERATOR; R1 := T0(J); IF R1 > T0(J+8) THEN R1 := T0(J+8); IF R1 > T0(J+16) THEN R1 := T0(J+16); END; END; T0(J) := R1; END; END; LM(R1,J,PARSEREG); IF FLAG THEN BEGIN R3 := @B3(R1+4); GOTO Z1; END; END; Z3: IF ~FLAG THEN BEGIN COMMENT RIGHT PART REPLACEMENT; I := J; IC(R2,B3(R2+2)); IC(R1,S(J-1)); R3 := R2 - #80; IF > THEN BEGIN IC(R2,LC1(R1)); IC(R0,RC1(R6)); IF R2 < R0 THEN R2 := R0; IF R2 > R3 THEN BEGIN R0 := @PRECERROR; ERROR; END; END; STC(R2,S(J)); FETCH; STC(R4,S2(J-1)); END ELSE BEGIN COMMENT NO APPLICABLE RULE; R0 := @SYNTAXERROR; ERROR; RECOVER; END; IC(R1,S(J)); R2 := R6; FETCH; END; COMMENT END OF GTR LOOP; IF R4 = 0 THEN BEGIN COMMENT NO RELATION BETWEEN SYMBOLS; R0 := @RELATIONERROR; ERROR; RECOVER; IC(R1,S(J)); R2 := R6; FETCH; GOTO Z0; END; STC(R4,S2(J)); END; R3 := EDITINDEX - 1; EDITINDEX := R3; STC(R6,B3(0)); IC(R0,S(1)); IF R0 ~= PROCDCL OR I ~= 1 THEN BEGIN R0 := @SYNTAXERROR; ERROR; END; R1 := V1(8); R2 := IDLOC1(R1) OR #8000; IDLOC1(R1) := R2; MVI(#03,TYPE(0)); COMMENT RESTORE TYPE OF (MAIN); Q: R2 := EDITBASE - EDITINDEX; R3 := NODEINDEX; IF R2 > #FFFF OR R3 > 1788 THEN BEGIN CLI(1,DEBUGFLAG); IF > THEN BEGIN MVI(1,DEBUGFLAG); MVC(130,BUFFER(1),BUFFER); MVC(32,BUFFER(1),"ERROR 2999 - DEBUG TABLE OVERFLOW"); OI("0",CARRCONT); R0 := @BUFFER; PRINT; END; END; R10 := RASAVE; END; SEGMENT PROCEDURE NTPRINT(R10); COMMENT PRINTS NAME TABLE, BLOCK LIST; BEGIN INTEGER HEX SYN PKDEC; LONG REAL DEC SYN PKDEC; LOGICAL RASAVE; RASAVE := R10; MVI("1",CARRCONT); MVC(130,BUFFER(1),BUFFER); R0 := @BUFFER; MVC(9,BUFFER(1),"NAME TABLE"); PRINT; MVC(9,BUFFER(1),BUFFER); MVC(61,BUFFER(12), "IDLOC1 IDLOC2 SIMTYPEINFO TYPEINFO TYPE SIMTYPE"); OI("0",CARRCONT); PRINT; MVC(130,BUFFER(1),BUFFER); MVC(15,BUFFER(12),"(HEX) A/H SEG"); MVC(19,BUFFER(45),"VR RCCLNO (HEX)"); PRINT; OI("0",CARRCONT); MVC(130,BUFFER(1),BUFFER); R0 := R0-R0; FOR R2 := 0 STEP 12 UNTIL NAMETABLESIZE DO BEGIN IC(R0,TYPE(R2)); IF R0 ~= #F THEN BEGIN HEX := R2; UNPK(4,2,BUFFER(4),HEX(2)); TR(3,BUFFER(4),TRANSTABLE(_240)); MVI(" ",BUFFER(8)); COMMENT IDLOC1 TO BUFFER; R1 := IDLOC1(R2); HEX := R1; UNPK(4,2,BUFFER(14),HEX(2)); MVI(" ",BUFFER(18)); TR(3,BUFFER(14),TRANSTABLE(_240)); COMMENT IDLOC2 TO BUFFER; IF R0 = 3 THEN BEGIN R1 := R1-R1; IC(R1,PROGSEG(R2)); CVD(R1,DEC); MVC(5,BUFFER(23),MASK2); ED(5,BUFFER(23),DEC(5)); IC(R1,HIERARCHY(R2)); R1 := R1 AND #F; STC(R1,BUFFER(23)); IC(R1,HIERARCHY(R2)); R1 := R1 SHRL 4; STC(R1,BUFFER(21)); TR(2,BUFFER(21),TRANSTABLE(0)); MVI(" ",BUFFER(22)); END ELSE BEGIN R1 := IDLOC2(R2); HEX := R1; UNPK(4,2,BUFFER(25),HEX(2)); MVI(" ",BUFFER(29)); TR(3,BUFFER(25),TRANSTABLE(_240)); MVC(2,BUFFER(21),BUFFER(90)); END; COMMENT TYPEINFO TO BUFFER; IF R0 = 0 OR R0 = 8 THEN BEGIN IC(R0,VR(R2)); CVD(R0,DEC); R0 := 0; MVC(5,BUFFER(40),MASK); ED(5,BUFFER(40),DEC(5)); MVC(5,BUFFER(50),BUFFER(90)); END ELSE IF R0 = 4 THEN BEGIN IC(R0,VR(R2)); HEX := R0; UNPK(2,1,BUFFER(43),HEX(3)); TR(1,BUFFER(43),TRANSTABLE(_240)); MVI(" ",BUFFER(45)); IC(R0,RCCLNUMBER(R2)); CVD(R0,DEC); MVC(5,BUFFER(50),MASK); ED(5,BUFFER(50),DEC(5)); R0 := 4; END ELSE BEGIN IF R0 = 3 THEN MVC(5,BUFFER(50),MASK2) ELSE MVC(5,BUFFER(50),MASK); R1 := TYPEINFO(R2); CVD(R1,DEC); ED(5,BUFFER(50),DEC(5)); MVC(5,BUFFER(40),BUFFER(90)); END; COMMENT TYPE TO BUFFER; HEX := R0; UNPK(2,1,BUFFER(62),HEX(3)); MVI(" ",BUFFER(64)); TR(1,BUFFER(62),TRANSTABLE(_240)); COMMENT SIMTYPEINFO TO BUFFER; IC(R0,SIMPLETYPE(R2)); IF R0 = 9 THEN BEGIN IC(R0,SIMTYPEINFO(R2)); CVD(R0,DEC); MVC(5,BUFFER(29),MASK); ED(5,BUFFER(29),DEC(5)); IC(R0,SIMTYPEINFO(R2+1)); CVD(R0,DEC); MVC(5,BUFFER(35),MASK); ED(5,BUFFER(35),DEC(5)); R0 := 9; END ELSE BEGIN R1 := SIMTYPEINFO(R2); IF R0 = 7 THEN MVC(5,BUFFER(35),MASK2) ELSE MVC(5,BUFFER(35),MASK); CVD(R1,DEC); ED(5,BUFFER(35),DEC(5)); MVC(5,BUFFER(29),BUFFER(90)); END; CVD(R0,DEC); MVC(5,BUFFER(67),MASK); ED(5,BUFFER(67),DEC(5)); R3 := IDDIRBASE; R1 := IDNO(R2) SHLL 2; R10 := IDLENGTH(R1); R1 := IDPOINT(R1); R3 := IDLISTBASE; R1 := @IDLIST(R1); EX(R10,MOVE); R0 := @BUFFER; PRINT; R0 := 0; MVI(" ",BUFFER(75)); MVC(54,BUFFER(76),BUFFER(75)); END; END; COMMENT BLOCKLIST OUTPUT; MVI("1",CARRCONT); R0 := @BUFFER; MVC(81,BUFFER(1),BUFFER); MVC(8,BUFFER(1),"BLOCKLIST"); PRINT; OI("0",CARRCONT); MVC(29,BUFFER(1)," BLOCKNO LENGTH POINTER"); PRINT; MVC(29,BUFFER(1),BUFFER); OI("0",CARRCONT); FOR R2 := 0 STEP 4 UNTIL BLOCKLISTSIZE DO BEGIN CVD(R2,DEC); MVC(5,BUFFER(3),MASK2); ED(5,BUFFER(3),DEC(5)); R1 := BLENGTH(R2); HEX := R1; UNPK(4,2,BUFFER(15),HEX(2)); TR(3,BUFFER(15),TRANSTABLE(_240)); MVI(" ",BUFFER(19)); R1 := NPOINT(R2); HEX := R1; UNPK(4,2,BUFFER(26),HEX(2)); TR(3,BUFFER(26),TRANSTABLE(_240)); MVI(" ",BUFFER(30)); PRINT; END; R10 := RASAVE; END; COMMENT END OF OUTPUT PROCEDURE; RASAVE := R10; R11 := COMMONBASE; SAVE14 := R14; METABASE := R6; R0 := #2000; R1 := #4B00; R3 := AGETMAIN; BALR(R2,R3); R12 := R0; BASESAVE(8) := R1; R0 := @P - R12; R0 := NEG R0 + R1 - 8 AND #FFFF00; COMMENT (R0) = SIZE OF P - 8; PLIMIT := R0; R1 := @P(0); R2 := R1 + R0 - 256; R0 := #FF000000; P(0) := R0; P(4) := R0; FOR R1 := R1 STEP 256 UNTIL R2 DO MVC(255,B1(8),B1); F01 := #4200000000000000L; FCONV := F01; F01 := 0L; NUMBUFFER(0) := F01; RESET(COMMONFLAG); R1 := _4; TREELINK := R1; R1 := TREEBASE; TREEORG := R1; R1 := INPOINT; INPOINTSAVE := R1; R1 := R1 - 1024; LITBASE := R1; R1 := 256; XSN := R1; R1 := IDDIRBASE; EDITBASE := R1; R0 := 4; NODECHAIN := R0; R1 := R1-R0; MVI(COUNTCODE,EDITCODE(R1+3)); R0 := 0; CHARTLEVEL := R0; STC(R0,EDITCODE(R1+2)); MVC(1,EDITCODE(R1),0S); EDITINDEX := R1; R1 := 0; NODEINDEX := R1; OLDEDIT := R1; LITORG := R1; R1 := 12; HN := R1; IHN := R1; R3 := LITBASE; R1 := 4; CTORG := R1; LITPNT := R1; R1 := 16; CTPNT := R1; R1 := 1; LITERALTABLE(0) := R1; CINFO(4) := R1; R1 := 6; CINFO(8) := R1; CINFO(12) := R1; R1 := 0; CADDR(4) := R1; CADDR(8) := R1; R1 := 3; CADDR(12) := R1; R2 := 4; R3 := 2; BN := R2; BLC := R3; R0 := 0; DISPLAY(0) := R0; DISPLAY(2) := R2; R1 := 32; LABELADDR := R1; MVI(" ",BUFFER); R1 := 0; PSTACK(0) := R1; PSTACK(2) := R1; R1 := #0D00; PSTACK(4) := R1; R1 := DPDORG; PSTACK(6) := R1; PSTACK(8) := R1; DISPLAYORG := R1; R9 := 8; OUTBASE := R9; PARSE; EXIT: CLI(3,TRACE); IF >= THEN NTPRINT; R0 := R12; R1 := BASESAVE(8); R3 := AFREEMAIN; BALR(R2,R3); COMMENT SET XFERVECTOR; R0 := R0-R0; IC(R0,DEBUGFLAG); IF R0 = 0 THEN R10 := COMMLIM(4) ELSE IF R0 = 1 THEN R10 := IDDIRBASE ELSE BEGIN COMMENT BUILD EDITCODE DIRECTORY; ARRAY 0 SHORT INTEGER NODETABLE SYN B5; R1 := EDITBASE; XFERVECTOR(56) := R1; R1 := NODEINDEX SHRA 1; R2 := NODECHAIN; R10 := EDITINDEX; R5 := R10 - R1 - 2 AND #FFFFFE; WHILE R2 ~= 0 DO BEGIN R3 := EDITBASE - R2; NODETABLE(R1) := R2; R2 := R1 + R1; MVC(1,NODECHAIN(2),EDITCODE(R3)); STC(R2,EDITCODE(R3+1)); R2 := R2 SHRL 8; STC(R2,EDITCODE(R3)); R2 := NODECHAIN; R1 := R1 - 2; END; IF R0 > 2 THEN R10 := R5; XFERVECTOR(44) := R5; END; STC(R0,XFERVECTOR(56)); R10 := R10 AND #FFFFF8; COMMLIM(4) := R10; R1 := IDLISTBASE; XFERVECTOR(52) := R1; R1 := IDDIRBASE; XFERVECTOR(48) := R1; CLI(7,TRACE); IF >= AND R0 > 1 THEN BEGIN COMMENT DUMP EDITCODE; MVI("1",CARRCONT); MVC(130,BUFFER(1),BUFFER); R0 := @BUFFER; R4 := EDITBASE; R5 := COMMLIM(4); WHILE R4 > R5 DO BEGIN R4 := R4 - 32; R1 := EDITBASE - R4; HEX := R1; UNPK(4,2,BUFFER(4),HEX(2)); UNPK(8,4,BUFFER(10),B4(0)); UNPK(8,4,BUFFER(18),B4(4)); UNPK(8,4,BUFFER(26),B4(8)); UNPK(8,4,BUFFER(34),B4(12)); UNPK(8,4,BUFFER(44),B4(16)); UNPK(8,4,BUFFER(52),B4(20)); UNPK(8,4,BUFFER(60),B4(24)); UNPK(8,4,BUFFER(68),B4(28)); TR(71,BUFFER(4),TRANSTABLE(_240)); MVI(" ",BUFFER(76)); MVC(1,BUFFER(8)," "); MVC(1,BUFFER(42)," "); PRINT; END; END; R10 := INPOINTSAVE; INPOINT := R10; R10 := RASAVE; END; OLDSAVE := R5; BASESAVE(0) := R4; MVC(63,XFERVECTOR,B4); R3 := AGETTIME; BALR(R2,R3); R11 := COMMLIM(0); COMMTIME := R0; R0 := 60; LINENO := R0; R0 := 0; PAGENO := R0; MVI("1",CARRCONT); MVC(36,HEADING,"NUMAC ALGOL W (31MAY71) "); MVC(94,HEADING(37),HEADING(36)); MVC(3,HEADING(113),"PAGE"); R1 := ARUNID; MVC(31,HEADING(80),B1); PASS1; IF ~NOPASSTWO THEN PASS2; IF NOGO THEN BEGIN OI("0",CARRCONT); MVC(42,BUFFER(6)," SECONDS IN COMPILATION, NO CODE GENERATED "); MVC(82,BUFFER(49),BUFFER(48)); R3 := AGETTIME; BALR(R2,R3); R1 := R0 -- COMMTIME; R1 := R1*5 / 1920; CVD(R1,PKDEC); UNPK(4,2,BUFFER(1),PKDEC(5)); MVC(2,BUFFER(0),BUFFER(1)); MVI(".",BUFFER(3)); OI("0",BUFFER(5)); R0 := @BUFFER; PRINT; R6 := 16; END ELSE BEGIN R0 := LINENO; COMMLINE := R0; R0 := PAGENO; COMMPAGE := R0; BEGIN COMMENT RETURN MODIFIED XFERVECTOR; R4 := BASESAVE(0); MVC(63,B4,XFERVECTOR); END; R6 := 0; END; R5 := OLDSAVE; R0 := R13; R1 := 4096; R3 := AFREEMAIN; BALR(R2,R3); END; R13 := R5; R14 := B13(12); R15 := R6; LM(R0,R12,B13(20)); END. </statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></statement*></term*></sum*></expr*></statement*>