COMMENT STANFORD ALGOL W COMPILER PHASE B - CODE GENERATION MAY 1971 VERSION ; GLOBAL PROCEDURE AWXCMPB2(R14); BEGIN STM(R14,R12,B13(12)); R5 := R13; BEGIN SEGMENT BASE R13; LOGICAL SYSINF, OLDSAVE, NEWSAVE; ARRAY 15 LOGICAL SAVEAREA; ARRAY 16 INTEGER XFERVECTOR; COMMENT SUPV ENTRY ADDRESSES; ARRAY 2 INTEGER COMMLIM SYN XFERVECTOR(0); INTEGER COMSTART SYN COMMLIM(0); INTEGER APUTLINE SYN XFERVECTOR(8); COMMENT WRITE ENTRY; BYTE CARRCONT SYN APUTLINE(0); COMMENT PRINT CONTROL CHAR; 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 ADDR OF SYSTEM ID; FUNCTION DECR(6,#0600), ZONE(8,#96F0); LONG REAL PKDEC; INTEGER WORK SYN PKDEC(0); LOGICAL ALGOLDATAORG SYN B13(0); COMMENT ALGOLRUN DATA ORIGIN; DUMMY BASE R11; COMMENT COMPILER COMMON FORMAT; INTEGER COMMTIME; SHORT INTEGER LINENO, PAGENO; ARRAY 3 LOGICAL COMMFLAGS; BYTE CHECKFLAG SYN COMMFLAGS(0); COMMENT CHECK VALIDITY; BYTE DEBUGSW SYN COMMFLAGS(1); COMMENT DEBUG SYSTEM OUTPUT; BYTE PROCCOMP SYN COMMFLAGS(2); COMMENT COMPILE PROC DECL; BYTE TRACE SYN COMMFLAGS(3); COMMENT 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 XSN; ARRAY 8 CHARACTER ESDROOT; COMMENT MODULE IDENTIFIER ROOT; ARRAY 256 BYTE ESDICT; ARRAY 512 LOGICAL BLOCKLIST; SHORT INTEGER BLENGTH SYN BLOCKLIST(0), NPOINT SYN BLOCKLIST(2); COMMENT *** SIZE OF OTHER TABLES IS DYNAMIC ***; ARRAY 3 LOGICAL NAMETABLE; SHORT INTEGER IDLOC1 SYN NAMETABLE; SHORT INTEGER IDLOC2 SYN NAMETABLE(2); BYTE HIERARCHY SYN IDLOC2(0); SHORT INTEGER SIMTYPEINFO SYN NAMETABLE(4); SHORT INTEGER TYPEINFO SYN NAMETABLE(6); BYTE VR SYN TYPEINFO(0); BYTE RCCLNUMBER SYN TYPEINFO(1); BYTE TYPE SYN NAMETABLE(8); BYTE SIMPLETYPE SYN NAMETABLE(9); SHORT INTEGER IDNO SYN NAMETABLE(10); SHORT INTEGER INSCTAB SYN 0, CARDTAB SYN 2; SHORT INTEGER DSPLINK SYN B12; COMMENT DSP OF ENCLOSING SEGMENT; LOGICAL TREE SYN B12; BYTE CONV SYN TREE(1); SHORT INTEGER TREEP SYN TREE(2); CLOSE BASE; LOGICAL SAVE14; COMMENT STACK BASE ADDRESS; INTEGER SSEGLEN; COMMENT LENGTH OF STACK SEGMENT; DUMMY BASE R14; COMMENT DYNAMIC AREA, PROGRAM GROWS UP, STACK DOWN; INTEGER NUMSTACKP; ARRAY 10 INTEGER NUMSTACK; ARRAY 10 SHORT INTEGER NUMSEQLEN SYN NUMSTACK(0); ARRAY 10 SHORT INTEGER NUMORIGIN SYN NUMSTACK(2); INTEGER LOGPOINTER; COMMENT LOGSTACK POINTER; ARRAY 50 INTEGER LOGSTACK; COMMENT INSTRUCTION FIXUP STACK; SHORT INTEGER LOGSTACK1 SYN LOGSTACK(0); SHORT INTEGER LOGSTACK2 SYN LOGSTACK(2); INTEGER LPOINTER; COMMENT LSTACK POINTER (R5 ALSO); ARRAY 52 LOGICAL LSTACKM4; COMMENT OPERAND DESCRIPTOR STACK; LOGICAL LSTACK SYN LSTACKM4(4); LOGICAL LSTACKM8 SYN LSTACKM4(_4); ARRAY 2300 LOGICAL STACK; COMMENT MINIMUM SIZE; SHORT INTEGER STACKP SYN STACK(2); COMMENT TREE POINTER FIELD; LOGICAL STACKP4 SYN STACK(4), STACKP8 SYN STACK(8); LOGICAL STACK1 SYN STACK(4); SHORT INTEGER STACK11 SYN STACK(4), STACK12 SYN STACK(6); LOGICAL STACK2 SYN STACK(8); SHORT INTEGER STACK21 SYN STACK(8), STACK22 SYN STACK(10); ARRAY 2048 LOGICAL PROGRAMM SYN STACK; ARRAY 4096 SHORT INTEGER PROGRAM SYN PROGRAMM; CLOSE BASE; ARRAY 5 INTEGER FSTACKM4; INTEGER FSTACK SYN FSTACKM4(4); ARRAY 13 INTEGER RSTACKM4; INTEGER RSTACK SYN RSTACKM4(4); ARRAY 32 LOGICAL RLDTABLE; ARRAY 32 SHORT INTEGER SEGNO SYN RLDTABLE(0); SHORT INTEGER LOGSEG SYN SEGNO(0); COMMENT LOGICAL SEGMENT NO; ARRAY 32 SHORT INTEGER CHAIN SYN RLDTABLE(2); ARRAY 20 SHORT INTEGER UMREC,MREC; SHORT INTEGER PUMREC, PMREC; COMMENT INDEX OF UMREC, MREC; ARRAY 14 SHORT INTEGER R; COMMENT GPR ALLOCATION FLAGS; ARRAY 4 SHORT INTEGER F; COMMENT FPR ALLOCATION FLAGS; LOGICAL CONSPTTAB SYN 0; LOGICAL CPTBASE; INTEGER CONSTAB,CONSTABL,CONSPTTABL; INTEGER INSCOUNTER; COMMENT INSTRUCTION COUNTER; INTEGER PPMARK; COMMENT LAST POINT MARKED BY COUNTER; INTEGER LITORG; INTEGER CLN; COMMENT CURRENT HIERARCHY NUMBER; INTEGER NEXTADDR; COMMENT NEXT AVAILABLE LOCAL STACK ADDRESS; INTEGER SAVEL, MNBASE; INTEGER REFPCOUNT; LOGICAL FIRSTCASE; SHORT INTEGER FIRSTCASE1 SYN FIRSTCASE; INTEGER RUNERRSTART,RUNERRPT,WRITRUNPT; INTEGER CARDNUM; COMMENT SOURCE COORDINATE NUMBER; INTEGER CODELENGTH; COMMENT TOTAL CODE LENGTH; INTEGER CTABLENGTH, NTABLENGTH; COMMENT DIRECTORY SIZES; INTEGER SEGNTLEN; COMMENT LOCAL NAME TABLE INFO; INTEGER SEGIDNO; COMMENT PROCEDURE IDNO*4; SHORT INTEGER SEGTABIDX; SHORT INTEGER SEQNO; SHORT INTEGER PROCLINK, BLOCKLINK, FORLINK, LASTFOR; SHORT INTEGER SB1 SYN B1, SB2 SYN B2; SHORT INTEGER RIGHTHALF SYN MEM(2); BYTE PRINT, TRACEIT; COMMENT LOCAL TRACEFLAGS; BYTE DEBUGFLAG, DEBUG; BYTE COMPACTED; COMMENT SET AFTER FIRST STORAGE COMPACTION; ARRAY 16 BYTE FLAGS; COMMENT COMPILER FLAGS; BYTE R3FLAG SYN FLAGS(0); COMMENT R3 CONTAINS L-VALUE; BYTE ANDFLAG SYN FLAGS(1), LOGFLAG SYN FLAGS(2); BYTE PAIRFLAG SYN FLAGS(3), DIVIDE SYN FLAGS(4), REMAINDER SYN FLAGS(5); BYTE IFEXP SYN FLAGS(6), UJIFEXP SYN FLAGS(7), CLFLAG SYN FLAGS(8); BYTE ARGFLAG SYN FLAGS(9); COMMENT ARG2 PROCESSING; BYTE CEQ2 SYN FLAGS(10); COMMENT :=2 PROCESSING; BYTE SUBARFLAG SYN FLAGS(11); COMMENT SUBARRAY PROCESSING; COMMENT BLOCK MARK FIELD DISPLACEMENTS; EQUATE PB SYN 8, COMMENT PROGRAM BASE; FP SYN 16, COMMENT FREE POINTER; RETA SYN 20, COMMENT RETURN ADDRESS; DL SYN 24, COMMENT DYNAMIC LINK; REFVAR SYN 28, COMMENT REFERENCE INFO; DPDORG SYN 40; COMMENT DPD ORIGIN; INTEGER DSP; COMMENT CURRENT DISPLAY ORIGIN; INTEGER TERMINALNODE=#53000000, UNARYOP=#43000000; LOGICAL MP = @ALGOLDATAORG(#48), STRINGERR = @ALGOLDATAORG(#180), REFBINDERR = @ALGOLDATAORG(#18C), REFTEMP = @ALGOLDATAORG(#17C), CASEERR = @ALGOLDATAORG(#196), ARRAYERR = @ALGOLDATAORG(#1AA), NAMEERR = @ALGOLDATAORG(#1BE), PARAMERR = @ALGOLDATAORG(#1C8), ALLOCATE = @ALGOLDATAORG(#210), ALLOCATE1 = @ALGOLDATAORG(#218), ALLOCERR = @ALGOLDATAORG(#22A), ALLOCERR1 = @ALGOLDATAORG(#238), MKDESC1 = @ALGOLDATAORG(#1E6), DUBLMASK = @ALGOLDATAORG(#0FC), ALLONES = @ALGOLDATAORG(#100), NULLREF = @ALGOLDATAORG(#104), UNDEFINED = @ALGOLDATAORG(#108), FIXEDONE = @ALGOLDATAORG(#F8), BLANKS = @ALGOLDATAORG(#260); LOGICAL ASSIGNVR = @ALGOLDATAORG(#360); LOGICAL PL11 = @ALGOLDATAORG(#368), COUNTBASE = @ALGOLDATAORG(#36C); LOGICAL LOINTREF=@ALGOLDATAORG(#144), HIINTREF=@ALGOLDATAORG(#168); LOGICAL FCON1 = @ALGOLDATAORG(#110), FCON2 = @ALGOLDATAORG(#118); LOGICAL SIGN=#80000000, TYPEMASK=#00FF0000, MASK=#0000FFFF, MASK1=#FFFF0000, MASK2=#FF00FFFF, MASK4=#000F0000, MASK5=#00F00000, MASK8=#00000FFF, SMASK=#FFFFFFFC, BASEMASK=#0000F000, OPCODEMASK=#FF000000; LOGICAL A=#0A000000, D=#0D000000, M=#0C000000, S=#0B000000; ARRAY 5 LOGICAL OPTYPE = COMMENT OPCODE DATA FORMAT BITS; (#10000000, #30000000, #20000000, #30000000, #20000000); LOGICAL ICC =#43000000,STCC=#42000000,MVII=#92000000; LOGICAL OII=#96000000, NII=#94000000, CLII=#95000000; LOGICAL LAA=#41000000; LOGICAL TRUEE=#00010000; LOGICAL NULLST=#68000000, CONID=#5D; EQUATE SSIZE SYN _12; COMMENT -WIDTH OF STACK; INTEGER READFLAG = @ALGOLDATAORG(#F1); INTEGER WRITEFLAG = @ALGOLDATAORG(#F2); SHORT INTEGER READINDX = 3S, WRITEINDX = 1S; SHORT INTEGER UCOUNT=81, BEGINN=83, ENDD=38, NUMBER=86, BIT=98, STRYNG=99, TRUE=100, FALSE=101, NULLL=103, ID=87, FUNCID=90, ARRAYDC=105, ARRAYID=89, RCCLID=91, IFJ = 66, RCCLDC=96, APPAREN=29, BB=37, PROCDC=95, FTN=94; SHORT INTEGER INDX=30, REFX=31, SUBSTR=40; BYTE FORMALCALL SYN 1, FPARCONV SYN 2, REFCHECK SYN 3, RECALLOCATE SYN 4, TRACEFN SYN 5, GTIME SYN 6, POWER SYN 7, EXPONENT SYN 8, REALINTEGER SYN 9, READIN SYN 10, WRITEEDIT SYN 11, SANALFN SYN 12, LANALFN SYN 13, CARITHFN SYN 14, CHECKASSERT SYN 15; SHORT INTEGER STFCASELOW=@REALINTEGER, STFCASEHIGH=@CARITHFN; SHORT INTEGER STFUNCID=107,STPROCID=108,ARSTAR=106,APRPAREN=29; SHORT INTEGER FLAG =#FFFFS, ENDCHAIN=1S; ARRAY 16 BYTE INSLENGTH = (4(2), 8(4), 4(6)); ARRAY 10 BYTE SITYPELEN = (1,4,4,8,8,16,1,0,4,4); ARRAY 20 BYTE SUBRCONV = COMMENT USED BY PROCRETURN; (#00,5(#06),#00,#03,2(#00), #00,#06,4(#07),#00,#03,2(#00)); ARRAY 46 BYTE STFNSWITCH = COMMENT STANDARD FUNCTION CASE CODES; (0,2(1),3(2),1,3,4,5,6,7,8,9,10,11,12,13,14,15,16, 17,18,14(19),1,6(20),21,22); ARRAY 16 CHARACTER OTRTABLE = "0123456789ABCDEF"; ARRAY 132 BYTE OWBUF; COMMENT OUTPUT LINE; ARRAY 132 BYTE HEADING; PROCEDURE WRITE(R14); COMMENT OUTPUT 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; PROCEDURE EROR(R1); COMMENT PRINTS ERROR MESSAGE AND TAKES ABNORMAL EXIT; BEGIN MVC(59,OWBUF(4),OWBUF); OI("0",CARRCONT); MVC(25,OWBUF,"ERROR 3XXX NEAR COORDINATE"); CVD(R3,PKDEC); UNPK(2,7,OWBUF(7),PKDEC); ZONE(OWBUF(9)); R0 := CARDNUM; CVD(R0,PKDEC); UNPK(3,7,OWBUF(27),PKDEC); ZONE(OWBUF(30)); MVI("-",OWBUF(32)); CASE R3 OF BEGIN MVC(23,OWBUF(34),"PROGRAM SEGMENT OVERFLOW"); MVC(22,OWBUF(34),"COMPILER STACK OVERFLOW"); MVC(19,OWBUF(34),"COMPILER LOGIC ERROR"); MVC(20,OWBUF(34),"PROGRAM AREA OVERFLOW"); MVC(20,OWBUF(34),"DATA SEGMENT OVERFLOW"); MVC(24,OWBUF(34),"COORDINATE TABLE OVERFLOW"); MVC(23,OWBUF(34),"TOO MANY PROCEDURE CALLS"); END; R0 := @OWBUF; WRITE; R14 := SAVE14; MVI(" ",OWBUF); MVC(130,OWBUF(1),OWBUF); MVC(33,OWBUF(4),"COORDINATE - OFFSET/LENGTH OF CODE"); OI("0",CARRCONT); R0 := @OWBUF; WRITE; R14 := SAVE14; R3 := RUNERRPT - 4; OI("0",CARRCONT); FOR R1 := RUNERRSTART+8 STEP 4 UNTIL R3 DO BEGIN MVC(130,OWBUF(1),OWBUF); R0 := CARDTAB(R1); CVD(R0,PKDEC); UNPK(3,7,OWBUF(7),PKDEC); ZONE(OWBUF(10)); R0 := INSCTAB(R1); CVD(R0,PKDEC); UNPK(3,7,OWBUF(18),PKDEC); ZONE(OWBUF(21)); IF R1 = R3 THEN R0 := INSCOUNTER ELSE R0 := INSCTAB(R1+4); R0 := R0 - INSCTAB(R1); CVD(R0,PKDEC); MVC(3,OWBUF(24),#40202120); ED(3,OWBUF(24),PKDEC(6)); R0 := @OWBUF; WRITE; R14 := SAVE14; END; R0 := 16; GOTO ERXIT; END; PROCEDURE INCRADDR(R1); COMMENT INCREASES NEXTADDR BY NUMBER OF BYTES SPECIFIED IN RA; BEGIN R10 := R10 + NEXTADDR; NEXTADDR := R10; END; PROCEDURE EMIT (R1); COMMENT TAKES ASSEMBLED INSTRUCTION FROM R0 (AND R3 IF 6 BYTE INSTRUCTION), WRITES, AND UPDATES INSTRUCTION COUNTER. ALL INSTRUCTIONS MUST BE LEFT JUSTIFIED; BEGIN PROCEDURE WRITEINSTRUCTION(R1); BEGIN ARRAY 4 INTEGER TEMP; BYTE SEGNO SYN OWBUF (12); BYTE LC SYN OWBUF(21); BYTE MNEM SYN OWBUF(32); BYTE INS SYN OWBUF (39); STM(R0,R3,TEMP); MVC(59,OWBUF(4),OWBUF); R1 := R0 SHRL 24 SHLL 2; R2 := MNBASE + R1; MVC(3,MNEM,B2); R1 := R1 SHRL 8; UNPK(4,2,INS,TEMP); TR(3,INS,OTRTABLE(_240)); IF R1 = 0 THEN MVI(" ",INS(4) )ELSE BEGIN UNPK(4,2,INS(4),TEMP(2)); TR(3,INS(4),OTRTABLE(_240)); IF R1 < 3 THEN MVI(" ",INS(8) )ELSE BEGIN UNPK(4,2,INS(8),TEMP(12)); MVI(" ",INS(12)); TR(3,INS(8),OTRTABLE(_240)); END; END; R1 := CARDNUM; R2 := INSCOUNTER; CVD(R1,PKDEC); UNPK(3,7,SEGNO,PKDEC); OI(#F0,SEGNO(3)); WORK := R2; UNPK(4,2,LC,WORK(2)); TR(3,LC,OTRTABLE(_240)); MVI(" ",LC(4)); R0 := @OWBUF; WRITE; R14 := SAVE14; LM(R0,R3,TEMP); END; ARRAY 2 INTEGER SAVEREG; INTEGER SAVER1; ARRAY 3 SHORT INTEGER INSTRUCTION SYN SAVEREG(0); ARRAY 3 SHORT INTEGER MOVECODE=(#D200,@B3,@INSTRUCTION); SAVER1 := R1; IF PRINT THEN WRITEINSTRUCTION; R1 := R3; STM(R0,R1,SAVEREG); R1 := R0 SHRL 28; IC(R1,INSLENGTH(R1)); R3 := INSCOUNTER; R0 := R3 + R1; INSCOUNTER := R0; IF R0 > 8192 THEN BEGIN R3 := 1; EROR; END; IF R0 >= R8 THEN BEGIN R3 := 2; EROR; END; R3 := @PROGRAM(R3); DECR(R1); EX(R1,MOVECODE); LM(R0,R1,SAVEREG); R3 := R1; R1 := SAVER1; END; PROCEDURE CHAINOUT(R1); BEGIN COMMENT INPUT - R0 = SEG NO, OUTPUT - R0 = SEG CHAIN; ARRAY 2 LOGICAL SAVE12; STM(R1,R2,SAVE12); FOR R2 := 4 STEP 4 UNTIL SEGTABIDX DO IF R0 = SEGNO(R2) THEN BEGIN R0 := CHAIN(R2); GOTO X; END; R2 := SEGTABIDX + 4; SEGTABIDX := R2; IF R2 > 124 THEN BEGIN R3 := 7; EROR; END; SEGNO(R2) := R0; R0 := ENDCHAIN; X: R1 := INSCOUNTER; CHAIN(R2) := R1; LM(R1,R2,SAVE12); END; PROCEDURE CHAININ(R1); COMMENT EMITS CODE TO LOAD PROG BASE FROM BLOCK MARK. INPUT: R0 = BLOCK MARK ACCESS REGISTER; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := CHAIN(0) OR #A000 SHLL 16; R0 := R0 SHLL 12 OR PB OR R1; R1 := INSCOUNTER; CHAIN(0) := R1; EMIT; R1 := SAVER1; END; PROCEDURE EMITCALL(R1); BEGIN COMMENT EMITS CALL AND RELOAD TO SEG NO IN R0; ARRAY 2 LOGICAL SAVE01; STM(R0,R1,SAVE01); CHAINOUT; R0 := R0 OR #58F00000; EMIT; R0 := #051F0000; EMIT; R0 := ABS SAVE01(0); IF R0 <= STFCASEHIGH AND R0 >= STFCASELOW THEN BEGIN R0 := R3; EMIT; END; R0 := CLN; CHAININ; LM(R0,R1,SAVE01); END; PROCEDURE ASSEMBLE(R1); COMMENT ASSEMBLES AND EMITS INSTRUCTION ACCORDING TO TYPE. INPUTS: R6 = TYPE, R0(8:11/8:15) = FIRST OPERAND REGISTER/REGISTERS, R3(16:31) = SECOND OPERAND (R3>0) OR R3(8:11/8:15) = SECOND REG, R0(4:7) = OPERATION. R0, R1 CHANGED; BEGIN LOGICAL SAVER1, SAVER6, TEMP; SAVER1 := R1; SAVER6 := R6; IF R6 > 5 THEN R6 := 1; IF R6 >= 4 THEN BEGIN COMMENT COMPLEX, SAVE FIRST OPERAND FIELDS; R1 := R0 AND #00F00000; TEMP := R1; R1 := R0 SHLL 4 AND #00F00000; R0 := R0 AND #FF000000 OR R1; IF R3 < 0 THEN BEGIN R1 := R3 AND #00F00000; R3 := R3 SHLL 4 AND #00F00000 OR SIGN; END ELSE BEGIN R1 := R3; IF R6 = 4 THEN R3 := R3 + 4 ELSE R3 := R3 + 8; END; R1 := R1 OR TEMP; TEMP := R1; END; IF R3 >= 0 THEN R0 := R0 OR #40000000; COMMENT SELECT RR OR RX; R1 := R6 SHLA 2; R0 := R0 OR OPTYPE(R1-4); COMMENT TYPE CODE; R0 := R0 AND #7FF00000; COMMENT OPERATION, FIRST REGISTER; IF R3 >= 0 THEN R0 := R0 OR R3 ELSE BEGIN R1 := R3 AND #00F00000 SHRL 4; R0 := R0 OR R1; END; EMIT; IF R6 >= 4 THEN BEGIN R0 := R0 AND #FF000000 OR TEMP; EMIT; END; R6 := SAVER6; R1 := SAVER1; END; PROCEDURE WRITENUMBER(R1); COMMENT THIS PROCEDURE WRITES OUT A 4 BYTE NUMBER FOUND IN R0 AND UPDATES INSCOUNTER BY 4; BEGIN ARRAY 2 LOGICAL TEMP; INTEGER NUMB SYN TEMP(0); STM(R0,R1,TEMP); CLI(#00,TRACEIT); IF ~= THEN BEGIN R1 := NUMSTACKP; R0 := NUMORIGIN(R1) + NUMSEQLEN(R1) + 4; IF R0 = INSCOUNTER THEN BEGIN R0 := NUMSEQLEN(R1) + 4; NUMSEQLEN(R1) := R0; END ELSE BEGIN R1 := R1 + 4; NUMSTACKP := R1; R0 := INSCOUNTER; NUMSTACK(R1) := R0; END; END; R1 := INSCOUNTER; R1 := @PROGRAM(R1); MVC(3,B1,NUMB); IF PRINT THEN BEGIN MVC(59,OWBUF(4),OWBUF); UNPK(8,4,OWBUF(39),NUMB); MVI(" ",OWBUF(47)); TR(7,OWBUF(39),OTRTABLE(_240)); UNPK(4,2,OWBUF(21),INSCOUNTER(2)); MVI(" ",OWBUF(25)); TR(3,OWBUF(21),OTRTABLE(_240)); R0 := @OWBUF; WRITE; R14 := SAVE14; END; R0 := INSCOUNTER + 4; INSCOUNTER := R0; IF R0 > 8192 THEN BEGIN R3 := 1; EROR; END; IF R0 >= R8 THEN BEGIN R3 := 2; EROR; END; LM(R0,R1,TEMP); END; PROCEDURE RESTOREDISPLAY(R1); COMMENT EMITS L/LM TO RESTORE DISPLAY UPON PROCEDURE RETURN. INPUT: R0 = MAX HN OF CALLED PROCEDURE/SUBR; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := CLN; IF R0 >= R1 THEN BEGIN IF = THEN R0 := #18020000 ELSE R0 := R0 SHLL 16 OR #98002000 OR DSP; R1 := R1 SHLL 20; R0 := R0 OR R1; EMIT; END; R1 := SAVER1; END; PROCEDURE REFSTOR(R1); COMMENT STORING A REFERENCE - CHECK FOR INTERRUPT. R3=4 IF ST , R3=6 IF MVC ; BEGIN INTEGER SAVER1; SAVER1 := R1; R1 := INSCOUNTER - R3; R3 := PROGRAM(R1+2) AND MASK; R1 := R3 AND MASK8; IF R1 = 0 OR R3 >= LOINTREF THEN BEGIN R0 := #41000000 OR R3; EMIT; R0 := @REFCHECK; R0 := NEG R0; EMITCALL; END; R1 := SAVER1; END; PROCEDURE PROCCALLCODE(R1); COMMENT EMITS THE CODE FOR A PROCEDURE CALL. INPUT: R7 = NT INDEX, R3 = PARAMETER COUNT; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := R1-R1; IC(R1,TYPE(R7)); IF R1 = #13 THEN BEGIN COMMENT FORMAL PROCEDURE (CLN <= 11); R0 := IDLOC1(R7) SHLL 12 + IDLOC2(R7); IF R3 = 0 THEN BEGIN R3 := R0; R0 := R0 OR #98340000; EMIT; R0 := R3 OR #91A00000; EMIT; R0 := R0-R0; IC(R0,SIMPLETYPE(R7)); IF R0 ~= 0 THEN BEGIN R0 := CLN; IF R0 = 11 THEN R0 := 16 ELSE R0 := 18; R0 := R0 + INSCOUNTER OR #4780E000; EMIT; END; R0 := #45100000 OR PARAMERR; EMIT; R0 := #05130000; END ELSE BEGIN R0 := R0 OR #98340000; EMIT; R0 := #41000000 OR R3; EMIT; R0 := @FORMALCALL; R0 := NEG R0; CHAINOUT; R0 := R0 OR #58F00000; EMIT; R0 := #051F0000; END; R3 := 11; COMMENT MAX HN OF A FORMAL PROCEDURE; END ELSE BEGIN R0 := IDLOC1(R7) AND #8000; IF ~= THEN BEGIN COMMENT PROCEDURE ASSUMES GENERAL CASE CONVENTIONS; IC(R0,HIERARCHY(R7)); R0 := R0 AND #F; IF R0 < 11 THEN BEGIN R0 := R0 SHLL 16 ++ #18410000; EMIT; END; END; R0 := IDLOC2(R7) AND #FF; IF R0 ~= LOGSEG THEN BEGIN CHAINOUT; R0 := R0 OR #58E00000; EMIT; END; R0 := #051E0000; IC(R3,HIERARCHY(R7)); R3 := R3 AND #F; END; EMIT; R0 := 2; CHAININ; R0 := R3; RESTOREDISPLAY; R1 := SAVER1; END; PROCEDURE WRITEALL(R1); COMMENT THIS PROCEDURE WRITES OUT THE CODE GENERATED FOR AN ENTIRE PROGRAM SEGMENT; BEGIN LOGICAL SAVER1, NUMINFO; INTEGER INSC; SHORT INTEGER NUMBYT SYN NUMINFO(0), INUM SYN NUMINFO(2); SAVER1 := R1; MVI(#00,TRACEIT); SET(PRINT); R0 := NUMSTACK(4); NUMINFO := R0; R0 := 4; R1 := NUMSTACKP; NUMSTACK(R1+4) := R0; NUMSTACKP := R0; R0 := RUNERRSTART + 8; WRITRUNPT := R0; R0 := INSCOUNTER; INSC := R0; R10 := 0; INSCOUNTER := R10; WHILE R10 < INSC DO BEGIN IF R10 = INUM THEN BEGIN COMMENT OUTPUT A SEQUENCE OF NUMBERS; FOR R3 := 0 STEP 4 UNTIL NUMBYT DO BEGIN R1 := INSCOUNTER; R0 := PROGRAM(R1) SHLL 16; R1 := PROGRAM(R1+2) AND #FFFF; R0 := R0 OR R1; WRITENUMBER; END; R1 := NUMSTACKP + 4; NUMSTACKP := R1; R0 := NUMSTACK(R1); NUMINFO := R0; END ELSE BEGIN R3 := WRITRUNPT; R1 := B3 SHRL 16; IF R1 = R10 THEN BEGIN R1 := B3 AND MASK; CARDNUM := R1; R3 := @B3(4); WRITRUNPT := R3; END; R3 := PROGRAM(R10) SHLL 16; R0 := PROGRAM(R10+2) AND MASK OR R3; R3 := PROGRAM(R10+4) SHLL 16; EMIT; END; R10 := INSCOUNTER; END; RESET(PRINT); R1 := SAVER1; END; PROCEDURE GETTYPE(R1); COMMENT TAKES SIMPLE TYPE FROM NAME TABLE AND PUTS IT IN LOW ORDER BYTE OF R3; BEGIN R3 := R7 SHRL 24; IF R3 = NUMBER THEN BEGIN R3 := R7 AND MASK + CPTBASE; R3 := CONSPTTAB(R3) SHRL 16; END ELSE IF R3 = TRUE OR R3 = FALSE THEN R3 := 6 ELSE IF R3 = STRYNG THEN R3 := 7 ELSE IF R3 = BIT THEN R3 := 8 ELSE IF R3 = NULLL OR R3 = RCCLID THEN R3 := 9 ELSE BEGIN R3 := R7 AND #FFFF; IC(R3,SIMPLETYPE(R3)); R3 := R3 AND #FF; END; END; PROCEDURE GETLENGTH(R1); COMMENT PUT LENGTH OF STRING QUANTITY (R7=NODE) INTO R3; BEGIN R3 := R7 AND #FFFF; R0 := R7 SHRL 24; IF R0 = STRYNG THEN BEGIN R3 := R3 + CPTBASE; IC(R3,CONSPTTAB(R3)); R3 := R3 AND #FF; END ELSE R3 := SIMTYPEINFO(R3); END; PROCEDURE DUMPFLREG(R1); COMMENT WRITES INSTRUCTION TO DUMP OLDEST FLOATING REGISTER VALUE INTO LOCAL STACK, MAKES ADJUSTMENTS IN FSTACK AND LSTACK, PUTS REGISTER NUMBER IN R3, BITS 8 TO 11; BEGIN LOGICAL SAVER1, SAVER4, SAVERA; SAVER1 := R1; SAVER4 := R4; SAVERA := R10; MVC(11,FSTACK,FSTACK(4)); R10 := R0 AND MASK; R4 := NEXTADDR; R3 := LSTACK(R10) SHLL 1 SHRL 1; R0 := R0 AND MASK1 SHLL 1; IF R0 < 0 THEN BEGIN COMMENT SHORT; R4 := R4 + 3 AND SMASK; LSTACK(R10) := R4; R0 := R3 OR R4 OR #70000000; R4 := R4+4; END ELSE BEGIN COMMENT LONG; R4 := R4 + 7 AND #FFFFFFF8; LSTACK(R10) := R4; R0 := R3 OR R4 OR #60000000; R4 := R4+8; END; NEXTADDR := R4; EMIT; R1 := SAVER1; R4 := SAVER4-4; R10 := SAVERA; END; PROCEDURE DUMPPRFLREG(R1); COMMENT WRITES INSTRUCTIONS TO DUMP OLDEST VALUE , WHICH IS COMPLEX, IN LOCAL STACK. UPDATES LSTACK AND FSTACK, PUTS REGISTER NUMBERS IN BITS 8 TO 11 AND 12 TO 15 OF R3; BEGIN LOGICAL SAVER1, SAVER4; LOGICAL SAVERA; SAVERA := R10; SAVER1 := R1; SAVER4 := R4; MVC(11,FSTACK,FSTACK(4)); R10 := R0 AND MASK; R4 := NEXTADDR; R3 := LSTACK(R10); R0 := R0 AND MASK1 SHLL 1; IF R0 < 0 THEN BEGIN COMMENT SHORT; R4 := R4 + 3 AND SMASK; LSTACK(R10) := R4; R10 := R3 AND MASK5; R0 := R10 OR R4 OR #70000000; EMIT; R4 := R4+4; R10 := R3 AND MASK4 SHLL 4; R0 := R10 OR R4 OR #70000000; R4 := R4+4; END ELSE BEGIN COMMENT LONG; R4 := R4 + 7 AND #FFFFFFF8; LSTACK(R10) := R4; R10 := R3 AND MASK5; R0 := R10 OR R4 OR #60000000; EMIT; R4 := R4+8; R10 := R3 AND MASK4 SHLL 4; R0 := R10 OR R4 OR #60000000; R4 := R4+8; END; NEXTADDR := R4; EMIT; R1 := SAVER1; R4 := SAVER4-4; R10 := SAVERA; END; PROCEDURE FLREG(R1); COMMENT MAKES AVAILABLE A FLOATING REGISTER, LEAVING ITS NUMBER IN BITS 8 TO 11 OF R0. FSTACK AND LSTACK ARE UPDATED. R0 IS AN INPUT WITH ITS SIGN BIT TO INDICATE REAL(1) OR COMPLEX(0) AND THE ADJACENT BIT TO INDICATE SHORT(1) OR LONG(0); BEGIN LOGICAL SAVER0, SAVER1; SAVER0 := R0; SAVER1 := R1; FOR R3 := 0 STEP 2 UNTIL 6 DO BEGIN R0 := F(R3); IF R0 >= 0 THEN BEGIN COMMENT REGISTER FREE; R0 := FLAG; F(R3) := R0; R3 := R3 SHLA 20; GOTO FLR1; END; END; COMMENT NO REGISTER FREE; R0 := FSTACK(0); IF R0 < 0 THEN DUMPFLREG ELSE BEGIN DUMPPRFLREG; R1 := R3 AND MASK4 SHRL 16; R0 := 0; F(R1) := R0; R3 := R3 AND MASK5; END; FLR1: R0 := R3; R3 := R3 OR SIGN; LSTACK(R5) := R3; R3 := R5 OR SAVER0; FSTACK(R4) := R3; R4 := R4+4; R5 := R5+4; R1 := SAVER1; END; PROCEDURE PRFLREG(R1); COMMENT MAKES AVAILABLE A PAIR OF FLOATING REGISTERS: LEAVING THEIR NUMBERS IN BITS 8 TO 11 AND 12 TO 15 OF R0. OTHERWISE SIMILAR TO FLREG; BEGIN LOGICAL SAVER0, SAVER1, SAVERA; SAVER0 := R0; SAVER1 := R1; SAVERA := R10; R10 := 0; PRF5: FOR R3 := 0 STEP 2 UNTIL 6 DO BEGIN R0 := F(R3); IF R0 >= 0 THEN BEGIN R0 := FLAG; F(R3) := R0; GOTO PRF1; END; END; PRF3: R0 := FSTACK(0); IF R0 < 0 THEN BEGIN DUMPFLREG; IF R10 < 0 THEN BEGIN R3 := R3 SHRA 4; GOTO PRF2; END ELSE BEGIN R10 := R3 OR SIGN; GOTO PRF3; END; END ELSE BEGIN DUMPPRFLREG; IF R10 < 0 THEN BEGIN R3 := R3 SHRA 4; R1 := R3 AND MASK SHRA 12; R0 := 0; F(R1) := R0; R3 := R3 AND MASK1; GOTO PRF2; END ELSE BEGIN R0 := R3 OR SIGN; GOTO PRF4; END; END; PRF1: IF R10 >= 0 THEN BEGIN R10 := R3 SHLA 20 OR SIGN; GOTO PRF5; END ELSE R3 := R3 SHLA 16; PRF2: R0 := R10 OR R3; PRF4: LSTACK(R5) := R0; R3 := R5 OR SAVER0; FSTACK(R4) := R3; R4 := R4+4; R5 := R5+4; R10 := SAVERA; R1 := SAVER1; END; PROCEDURE DUMPALLFLREG(R1); COMMENT WRITES INSTRUCTIONS TO DUMP ALL OCCUPIED FLOATING REGISTERS INTO THE LOCAL STACK, CLEARS F AND FSTACK, UPDATES LSTACK; BEGIN LOGICAL SAVER0,SAVER1,SAVER3; STM(R0,R1,SAVER0); SAVER3:=R3; WHILE R4 > 0 DO BEGIN R0 := FSTACK(0); IF R0 < 0 THEN DUMPFLREG ELSE DUMPPRFLREG; END; FOR R3 := 0 STEP 2 UNTIL 6 DO F(R3) := R4; LM(R0,R1,SAVER0); R3 := SAVER3; END; SEGMENT PROCEDURE LEVELA(R1); BEGIN LOGICAL SAVER1; PROCEDURE RELEASE(R1); COMMENT ADJUSTS THE REGISTER ARRAYS TO EFFECT THE FREEING OF A REGISTER OR PAIR OF REGISTERS. R3 IS AN INPUT IN THE SAME FORMAT AS FOR ASSEMBLE. TYPE IN LOW BITS OF R6; BEGIN LOGICAL SAVER3, SAVER0; LOGICAL SAVER6,SAVERA; SAVER6 := R6; SAVERA := R10; SAVER3 := R3; SAVER0 := R0; R0 := 0; IF R6 > 5 THEN R6 := 1; R10 := R3 SHRL 12; IF R3 >= 0 AND R10 >= CLN THEN NULL ELSE IF R3 >=0 THEN BEGIN R3 := R10 + R10; R(R3) := R0; R2 := R2-4; END ELSE IF R6 = 1 THEN BEGIN R10 := R3 SHLL 12; IF R10 ~= 0 THEN BEGIN R10 := R10 SHRL 27; R(R10) := R0; R3 := R3 AND MASK5 SHRL 19; R(R3) := R0; END ELSE BEGIN R3 := R3 SHLL 1 SHRL 20; R(R3) := R0; END; R2 := R2-4; END ELSE IF R6 < 4 THEN BEGIN R3 := R3 SHLL 1 SHRL 21; F(R3) := R0; R4 := R4-4; END ELSE BEGIN R3 := R3 AND MASK4 SHRL 16; F(R3) := R0; R3 := SAVER3 AND MASK5 SHRL 20; F(R3) := R0; R4 := R4-4; END; R3 := SAVER3; R0 := SAVER0; R10 := SAVERA; R6 := SAVER6; END; PROCEDURE ZRELEASE(R1); COMMENT SAME AS RELEASE EXCEPT INPUT IN R0. R0 AND R3 MUST BE SAVED; BEGIN LOGICAL SAVER3; LOGICAL SAVER1; SAVER1 := R1; SAVER3 := R3; R3 := R0; RELEASE; R0 := R3; R3 := SAVER3; R1 := SAVER1; END; PROCEDURE DUMPGENREG(R1); COMMENT WRITES INSTRUCTION TO DUMP OLDEST GENERAL REGISTER VALUE INTO LOCAL STORE, ADJUSTS LSTACK AND RSTACK, AND PUTS AVAILABLE REGISTER NUMBER IN BITS 8 TO 11 OF R3. IF THE LSTACK ENTRY IS A PAIR, ONLY THE ODD REGISTER IS SAVED AND THE EVEN REGISTER IS FREED; BEGIN LOGICAL SAVER1,TEMP; SAVER1 := R1; R0 := RSTACK(0); TEMP := R0; R2 := R2-8; FOR R3 := 0 STEP 4 UNTIL R2 DO BEGIN R10 := R3+4; R0 := RSTACK(R10); RSTACK(R3) := R0; END; R3 := TEMP; R0 := LSTACK(R3); R10 := NEXTADDR +3 AND SMASK; NEXTADDR := R10; LSTACK(R3) := R10; IF R0 < 0 THEN BEGIN R3 := R0; R0 := R0 SHLL 12; IF R0 ~= 0 THEN BEGIN R3 := R3 AND MASK5 SHRL 19; TEMP := R0; R0 := 0; R(R3) := R0; R3 := TEMP SHRL 8; END; R3 := R3 SHLL 1 SHRL 1; END ELSE BEGIN R3 := R0 AND BASEMASK SHLL 8; R10 := R0 AND MASK8; IF R10 ~= 0 THEN BEGIN R0 := R0 OR R3 OR #41000000; EMIT; END; END; R0 := R3 OR NEXTADDR OR #50000000; EMIT; R10 := 4; INCRADDR; R2 := R2+4; R1 := SAVER1; END; PROCEDURE FORCECOMPLEX(R1); COMMENT FORCES REAL PART INTO F0 AND IMAG PART INTO F2. INPUT IS R0 = #38000000 OR R0 = #28000000 DEPENDING ON SIMPLETYPE SHORT OR LONG COMPLEX; BEGIN INTEGER SAVER1,SAVER3,SAVERA,PREFX; SAVER1 := R1; SAVER3 := R3; SAVERA := R10; PREFX := R0; R3 := LSTACKM4(R5) AND MASK5 SHRL 4; R10 := LSTACKM4(R5) AND MASK4; R1 := F(0); IF R1 = 0 AND R10 ~= 0 THEN BEGIN COMMENT F0 NOT OCCUPIED; R0 := PREFX OR R3; IF R0 ~= PREFX THEN EMIT; END ELSE BEGIN COMMENT F0 OCCUPIED; IF R3 ~= 0 THEN BEGIN COMMENT REAL PART NOT IN F0; R1 := F(2); IF R1 = 0 AND R3 ~= #00020000 THEN BEGIN COMMENT F2 NOT OCCUPIED. IMAG PART IN F0 - MOVE INTO F2. MOVE REAL PART INTO F0; R0 := PREFX OR #00200000; EMIT; R0 := PREFX OR R3; EMIT; END ELSE BEGIN COMMENT F2 OCCUPIED. SWAP F0 AND F2; R0 := #00600000 OR PREFX; EMIT; R0 := #00020000 OR PREFX; EMIT; R0 := #00260000 OR PREFX; EMIT; END; R10 := #20000; END; END; R1 := F(2); IF R1 = 0 AND R10 ~= #20000 THEN BEGIN COMMENT MOVE IMAG PART INTO F2; R0 := PREFX OR #00200000 OR R10; EMIT; END; R1 := SAVER1; R3 := SAVER3; R10 := SAVERA; END; PROCEDURE GENREG(R1); COMMENT MAKES AVAILABLE A GENERAL REGISTER. NUMBER TO R0(8:11), LSTACK, RSTACK UPDATED. CHANGES R1, R3 ALSO; BEGIN LOGICAL SAVER1, SAVERA; SAVER1 := R1; SAVERA := R10; R10 := CLN - 1 SHLA 1; R0 := FLAG; FOR R3 := 4 STEP 2 UNTIL R10 DO IF R0 ~= R(R3) THEN BEGIN COMMENT REGISTER FREE UNLESS R3 AND PROTECTED BY R3FLAG; IF ~R3FLAG OR R3 ~= 6 THEN BEGIN R(R3) := R0; R3 := R3 SHLA 19; GOTO X; END; END; DUMPGENREG; COMMENT NO REGISTER FREE, DUMP AND ALLOCATE OLDEST; X: R0 := R3; RESET(R3FLAG); RSTACK(R2) := R5; R5 := R5 + 4; R3 := R3 OR SIGN; LSTACKM4(R5) := R3; R2 := R2 + 4; R10 := SAVERA; R1 := SAVER1; END; PROCEDURE FIXUP(R1); COMMENT R3 HAS BRANCH ADDRESS : LOGPOINTER POINTS TO FIRST FIXUP; BEGIN LOGICAL SAVER1,SAVER2; SAVER1 := R1; SAVER2 := R2; R2 := LOGPOINTER; R2 := R2 - 4; LOGPOINTER := R2; R0 := LOGSTACK(R2); R3 := R3 OR #E000; WHILE R0 ~= 0 DO BEGIN R2 := R0; R0 := PROGRAM(R2+2); R0 := R0 AND #1FFF; PROGRAM(R2+2) := R3; END; R3 := LOGPOINTER; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; R1 := SAVER1; R2 := SAVER2; END; PROCEDURE LOGBRANCH(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := R0 SHLL 20 OR #4700E000; EMIT; R1 := SAVER1; END; PROCEDURE LINKBRANCHES(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := INSCOUNTER - 4; R10 := LOGPOINTER; R1 := LOGSTACK2(R10); LOGSTACK2(R10) := R0; R10 := R0; PROGRAM(R10+2) := R1; R1 := SAVER1; END; PROCEDURE EVALUATELOG(R1); COMMENT CONVERT BRANCH CHAIN TO REGISTER VALUE; BEGIN R0 := R7 SHRL 16; IF R0 = #8600 THEN BEGIN LOGICAL SAVER1, TEMP; SAVER1 := R1; R3 := LOGPOINTER; R0 := 0; IC(R0,LOGSTACK(R3+1)); R3 := R3 - 4; LOGPOINTER := R3; LOGBRANCH; LINKBRANCHES; GENREG; R3 := LOGPOINTER; R1 := 0; IC(R1,LOGSTACK(R3+4)); IF R1 = 1 THEN R0 := R0 OR #41000000 ELSE R0 := R0 OR #41000001; R1 := R0 XOR #1; TEMP := R1; EMIT; R3 := INSCOUNTER - 4; FIXUP; R0 := INSCOUNTER ++ #47F0E008; EMIT; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R3 := INSCOUNTER; FIXUP; R0 := TEMP; EMIT; R3 := LOGPOINTER - 4; LOGPOINTER := R3; R7 := #86020000; R1 := SAVER1; END; END; PROCEDURE SETRECORD(R1); BEGIN LOGICAL SR3,SRA; SR3 := R3; SRA := R10; R3 := PUMREC; R10 := R5 - 4; UMREC(R3) := R10; R3 := R3 + 2; PUMREC := R3; COMMENT TEST FOR ERROR; R3 := SR3; R10 := SRA; END; PROCEDURE RESETRECORD(R1); BEGIN LOGICAL SR1,SR3,SR0,SRA; SR1 := R1; SR3 := R3; SR0 := R0; SRA := R10; FOR R10 := PUMREC - 2 STEP _2 UNTIL 0 DO IF R5 = UMREC(R10) THEN BEGIN R0 := PUMREC -2 ; PUMREC := R0; FOR R3 := R10 STEP 2 UNTIL PUMREC DO BEGIN R0 := UMREC(R3+2); UMREC(R3) := R0; END; GOTO RS1; END; FOR R10 := PMREC - 2 STEP _2 UNTIL 0 DO IF R5 = MREC(R10) THEN BEGIN R0 := LSTACK(R5); IF R0 >= 0 THEN BEGIN R0 := R0 OR #58100000; EMIT; R0 := NII OR #3F1000; EMIT; END ELSE BEGIN R0 := R0 XOR SIGN SHRL 8 OR NII OR #3F0000; EMIT; END; R0 := PMREC - 2; PMREC := R0; FOR R3 := R10 STEP 2 UNTIL PMREC DO BEGIN R0 := MREC(R3+2); MREC(R3) := R0; END; GOTO RS1; END; RS1: R1 := SR1; R3 :=SR3; R0 := SR0; R10 := SRA; END; PROCEDURE MARKRECORDS(R1); BEGIN LOGICAL SR1,SR2; SR1 := R1; SR2 := R2; R10 := PUMREC - 2; R2 := PMREC; FOR R3 := 0 STEP 2 UNTIL R10 DO BEGIN R1 := UMREC(R3); R0 := LSTACK(R1); IF R0 >= 0 THEN BEGIN R0 := R0 OR #58100000; EMIT; R0 := OII OR #401000; EMIT; END ELSE BEGIN R0 := R0 XOR SIGN SHRL 8 OR OII OR #400000; EMIT; END; R1 := UMREC(R3); MREC(R2) := R1; R2 := R2 + 2; END; PMREC := R2; R0 := R0 - R0; PUMREC := R0; R1 := SR1; R2 := SR2; END; SEGMENT PROCEDURE LEVEL0(R1); BEGIN LOGICAL SAVER1; PROCEDURE DUMPALLGENREG(R1); BEGIN LOGICAL SAVER1, SAVER0, SAVER3; SAVER1 := R1; SAVER0 := R0; SAVER3 := R3; WHILE R2 > 0 DO BEGIN DUMPGENREG; R3 := R3 SHRL 19; R0 := 0; R(R3) := R0; END; R1 := SAVER1; R0 := SAVER0; R3 := SAVER3; END; PROCEDURE PRGENREG(R1); COMMENT MAKES AVAILABEL AN EVEN-ODD PAIR OF GENERAL REGISTERS, LEAVING THE EVEN OR ODD NUMBER, ACCORDING AS THE DIVIDE FLAG IS ON OR OFF, IN BITS 8 TO 11 OF R0. RSTACK AND LSTACK ARE UPDATED. THE LSTACK ENTRY CONTAINS THE EVEN NUMBER IN BITS 8 TO 11 AND THE ODD NUMBER IN BITS 12 TO 15. BOTH REGISTERS ARE FLAGGED IN R; BEGIN LOGICAL SAVER1, TOP; SAVER1 := R1; R1 := CLN - 1 SHLA 1 - 2; TOP := R1; A: R0 := 4; TEST(R3FLAG); IF = THEN BEGIN RESET(R3FLAG); R0 := 8; END; FOR R3 := R0 STEP 4 UNTIL TOP DO BEGIN R0 := R(R3); IF R0 = 0 THEN BEGIN R10 := R3+2; R0 := R(R10); IF R0 = 0 THEN BEGIN R0 := FLAG; R(R3) := R0; R(R10) := R0; GOTO B; END; END; END; COMMENT NO FREE PAIR SO DUMP OLDEST VALUE AND TRY AGAIN; DUMPGENREG; R3 := R3 SHRL 19; R0 := 0; R(R3) := R0; GOTO A; B: TEST(DIVIDE); IF = THEN R0 := R3 SHLL 19 ELSE R0 := R10 SHLL 19; R3 := R3 SHLL 4 OR R10 SHLL 15 OR SIGN; LSTACK(R5) := R3; RSTACK(R2) := R5; R2 := R2+4; R5 := R5+4; R1 := SAVER1; END; PROCEDURE FORCEPAIR(R1); COMMENT A VALUE IN A GENERAL REGISTER IS FORCED INTO THE ODD REGISTER OF AN EVEN-ODD PAIR. R0 IS AN INPUT SHOWING THE REGISTER(S) HOLDING THE VALUE. IF THIS IS A PAIR NO CODE IS GENERATED. R0 IS AN OUTPUT WITH EVEN REGISTER IN BITS 8 TO 11. THE TOP LSTACK ENTRY IS UPDATED TO SHOW THE PAIR UNLESS THE DIVIDE FLAG IS ON, IN WHICH CASE IT SHOWS THE EVEN OR ODD REGISTER ACCORDING AS THE REMAINDER FLAG IS ON OR OFF. JUST THE REGISTER(S) IN THIS ENTRY ARE FLAGGED AS OCCUPIED BY THE RESULT; BEGIN LOGICAL SAVER0, SAVER1, SAVER3; PROCEDURE NEWPAIR(R1); COMMENT FINDS NEW EVEN-ODD PAIR AND LOADS ODD REGISTER; BEGIN LOGICAL SAVER1; SAVER1 := R1; R2 := R2-4; R5 := R5-4; PRGENREG; R3 := SAVER0 SHRL 19; R10 := 0; R(R3) := R10; R3 := SAVER0 SHRL 4; TEST(DIVIDE); IF ~= THEN BEGIN R0 := R0 OR R3 OR #18000000; EMIT; COMMENT LOAD NEW ODD REGISTER; R0 := LSTACKM4(R5) AND MASK5; END ELSE BEGIN LOGICAL SAVER0; SAVER0 := R0; R0 := R0 OR R3 OR #18000000; EMIT; COMMENT LOAD NEW EVEN REGISTER AND SHIFT; R0 := SAVER0 OR #8E000020; EMIT; R0 := SAVER0; R1 := R1 - R1; IF REMAINDER THEN BEGIN COMMENT MARK ODD FREE; R3 := LSTACKM4(R5) AND MASK4 SHRL 15; R(R3) := R1; R3 := LSTACKM4(R5) AND MASK5 OR SIGN; END ELSE BEGIN COMMENT MARK EVEN FREE; R3 := LSTACKM4(R5) AND MASK5 SHRL 19; R(R3) := R1; R3 := LSTACKM4(R5) AND MASK4 SHLL 4 OR SIGN; END; LSTACKM4(R5) := R3; END; R1 := SAVER1; END; SAVER3 := R3; SAVER1 := R1; R0 := R0 SHLL 1 SHRL 1; SAVER0 := R0; R3 := R0 SHLL 12; IF R3 = 0 THEN BEGIN R0 := R0 SHRL 20; R3 := R0 SHRL 1 SHLL 1; IF R0 = R3 THEN BEGIN R3 := R3+1 SHLL 1; R10 := R(R3); IF R10 = 0 THEN BEGIN TEST(REMAINDER); IF ~= THEN BEGIN R10 := FLAG; R(R3) := R10; END; R0 := SAVER0 OR #8E000020; EMIT; COMMENT SHIFT TO ODD REGISTER; R0 := SAVER0; TEST(DIVIDE); IF ~= THEN BEGIN R3 := R3 SHLL 15; R10 := R0 OR R3 OR SIGN; LSTACKM4(R5) := R10; END ELSE BEGIN TEST(REMAINDER); IF ~= THEN BEGIN R10 := R0 SHRL 19; R0 := 0; R(R10) := R0; R3 := R3 SHLL 19; R10 := R3 OR SIGN; LSTACKM4(R5) := R10; R0 := SAVER0; END; END; END ELSE NEWPAIR; END ELSE BEGIN R3 := R3 SHLL 1; R10 := R(R3); IF R10 = 0 THEN BEGIN TEST(DIVIDE); IF = THEN BEGIN R3 := R3 SHLL 19; R0 := SAVER0 SHRL 4 OR R3 OR #18000000; EMIT; COMMENT LOAD FROM ODD TO EVEN REGISTER AND SHIFT TO EXTEND SIGN; R0 := R3 OR #8A00001F; EMIT; R0 := R3; TEST(REMAINDER); IF = THEN BEGIN R3 := R3 OR SIGN; LSTACKM4(R5) := R3; R3 := R3 SHLL 1 SHRL 20; R10 := FLAG; R(R3) := R10; R10 := R10 - R10; R(R3+2) := R10; END; END ELSE BEGIN R10 := FLAG; R(R3) := R10; R3 := R3 SHLL 19; R0 := R0 SHLL 16 OR R3 OR SIGN; LSTACKM4(R5) := R0; R0 := R3; END; END ELSE NEWPAIR; END; END ELSE BEGIN TEST(DIVIDE); IF = THEN BEGIN TEST(REMAINDER); IF = THEN BEGIN R3 := R0 AND MASK4 SHRL 15; R10 := 0; R(R3) := R10; R10 := R0 AND MASK5 OR SIGN; END ELSE BEGIN R3 := R0 AND MASK5 SHRL 19; R10 := 0; R(R3) := R10; R10 := R0 AND MASK4 SHLL 4 OR SIGN; END; LSTACKM4(R5) := R10; END; R0 := R0 AND MASK5; END; R1 := SAVER1; R3 := SAVER3; R0 := R0 OR SIGN; END; PROCEDURE ADJSTACKS(R1); COMMENT DEPENDING ON TYPE (IN R6), DECREMENTS BY 4 THE TOP OF RSTACK OR FSTACK TO POINT TO TOP OF LSTACK AFTER BINARY OPERATION; BEGIN LOGICAL SAVERA; SAVERA := R10; IF R6 = 1 OR R6 >= 8 THEN BEGIN R10 := RSTACKM4(R2)-4; RSTACKM4(R2) := R10; END ELSE BEGIN R10 := FSTACKM4(R4)-4; FSTACKM4(R4) := R10; END; R10 := SAVERA; END; PROCEDURE FPARCODE(R1); COMMENT EMITS CODE TO ACCESS A NAME PARAMETER. INPUTS: R0 = 0/#FF FOR LHV/RHV, R3 = DPD ADDRESS; BEGIN INTEGER SAVER1, SAVERA, DPOINT; BYTE SWW; SAVER1 := R1; SAVERA := R10; DPOINT := R3; STC(R0,SWW); MARKRECORDS; DUMPALLGENREG; DUMPALLFLREG; R0 := #98340000 OR DPOINT; EMIT; IF SWW THEN R0 := #12330000 ELSE BEGIN R0 := #91C00000 OR DPOINT; EMIT; R0 := #45100000 OR NAMEERR; END; EMIT; R1 := LOGPOINTER + 4; LOGPOINTER := R1; R0 := INSCOUNTER; LOGSTACK(R1) := R0; R0 := #47A0E000; EMIT; COMMENT SKIP ON =(TM), >(LTR); R0 := #05130000; EMIT; R0 := 2; CHAININ; R0 := 11; RESTOREDISPLAY; R1 := LOGPOINTER; R3 := LOGSTACK(R1); R1 := R1 - 4; LOGPOINTER := R1; R0 := INSCOUNTER OR #E000; PROGRAM(R3+2) := R0; R10 := SAVERA; R1 := SAVER1; END; PROCEDURE CALLPROPROCWOPARAM(R1); BEGIN INTEGER SAVER1; SAVER1 := R1; DUMPALLGENREG; DUMPALLFLREG; R3 := R3 - R3; PROCCALLCODE; R1 := SAVER1; END; PROCEDURE RECORDALLOCATE(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; MARKRECORDS; R3 := 0; IF R3 ~= R(6) THEN DUMPALLGENREG; R3 := #FFFFFFFF; IF R3 = R(4) THEN GENREG ELSE BEGIN R(4) := R3; GENREG; R3 := 0; R(4) := R3; END; R0 := 0; IC(R0,TYPEINFO(R7+1)); R0 := R0 SHLL 4 OR #41300000; EMIT; R0 := @RECALLOCATE; R0 := NEG R0; EMITCALL; SETRECORD; R7 := #89000000; R1 := SAVER1; END; PROCEDURE GETADDRESS(R1); COMMENT GETS ADDRESS FROM NAMETABLE OR CONSTANT POINTER TABLE. ENTRY INDEXED BY R7, RESULT IN R3 HIERARCHY NUMBER INCLUDED FOR ARRAYS, SIMPLE VARIABLES FOR LITERALS HIERARCHY NUMBER IS E ; BEGIN ARRAY 2 LOGICAL SAVE01; LOGICAL SAVER7; PROCEDURE PROCPARAM(R1); COMMENT SETS R3 AFTER NAME PARAM (R0=0) OR FUNCTION CALL AND ADJUSTS R7. FOR STRING PROCEDURES, MOVES RESULT TO LOCAL STACK; BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := R3-R3; IC(R3,SIMPLETYPE(R7)); IF R3 = 7 THEN BEGIN R3 := #3000; R1 := SIMTYPEINFO(R7) SHLL 16 OR #87000000; END ELSE IF R3 = 6 THEN BEGIN R1 := #86010000; R3 := #3000; END ELSE BEGIN IF R3 = 1 OR R3 >= 8 THEN SET(R3FLAG); R3 := R3 SHLL 24 OR SIGN; R1 := SAVER7 AND #00FFFFFF OR R3; R3 := #3000; END; SAVER7 := R1; R1 := SAVER1; END; STM(R0,R1,SAVE01); SAVER7 := R7; R7 := R7 AND #7F00FFFF; COMMENT EXTRACT OPCODE, TABLE PTR; R0 := R7 SHRL 24; IF R0 = ID THEN BEGIN R3 := IDLOC1(R7) SHLL 12 + IDLOC2(R7); R1 := 0; IC(R1,TYPE(R7)); IF R1 = 16 THEN BEGIN COMMENT FORMAL NAME PARAMETER; R1 := STACK(R8) AND #FFFF; R1 := TREE(R1); R0 := R1 SHRL 24 AND #7F; IF R0 >= 6 AND R0 <= 9 THEN R0 := 0 ELSE IF R0 >= 22 AND R0 <= 25 THEN R0 := 0 ELSE R0 := #FF; IF R0 = 0 THEN BEGIN COMMENT := OR :=2, LEFT OR RIGHT; IF ARGFLAG THEN R1 := NEG R1; IF R1 < 0 THEN R0 := #FF; COMMENT ON RIGHT; END; FPARCODE; R0 := 0; PROCPARAM; END; END ELSE IF R0 = CONID OR R0 = ARRAYID THEN R3 := IDLOC1(R7) SHLL 12 + IDLOC2(R7) ELSE IF R0 = FUNCID THEN BEGIN COMMENT PARAMETERLESS FUNCTION PROCEDURE; MARKRECORDS; CALLPROPROCWOPARAM; R0 := 1; PROCPARAM; END ELSE IF R0 = RCCLID THEN BEGIN COMMENT RECORD CREATOR, UNITIALIZED FIELDS; RECORDALLOCATE; R3 := #80300000; R6 := 9; RELEASE; R5 := R5-4; END ELSE IF R0 = NULLL THEN R3 := NULLREF ELSE BEGIN COMMENT NUMBER, STRYNG, BIT, TRUE, FALSE; R7 := R7 ++ CPTBASE; R3 := CONSPTTAB(R7) AND #FFF OR #E000; END; LM(R0,R1,SAVE01); R7 := SAVER7; END; PROCEDURE LOADREG(R1); COMMENT WRITES INSTRUCTION TO LOAD A REGISTER; BEGIN LOGICAL SAVER1,SAVER3,SAVER6,SAVEADD,TEMP; SAVER1 := R1; SAVER3 := R3; SAVER6 := R6; IF R7 >= 0 THEN BEGIN GETTYPE; R6 := R3; TEMP := R6; GETADDRESS; SAVEADD := R3; R6 := TEMP; R3 := R6; IF R3 = 0 OR R3 > 5 THEN R3 := 1; CASE R3 OF BEGIN IF PAIRFLAG THEN PRGENREG ELSE GENREG; BEGIN R0 := #C0000000; FLREG; END; BEGIN R0 := #80000000; FLREG; END; BEGIN R0 := #40000000; PRFLREG; END; BEGIN R0 := #00000000; PRFLREG; END; END; TEMP := R0; R3 := SAVEADD; R1 := R7 SHRL 24; IF R1 ~= NUMBER OR R6 > 3 THEN R0 := R0 OR #08000000 ELSE BEGIN R1 := R3 AND #1FFF; R1 := PROGRAMM(R1); IF R1 = 0 THEN BEGIN R3 := R0 OR SIGN; R0 := R0 OR #0B000000; END ELSE IF R6 = 1 AND R1 > 0 AND R1 < 4096 THEN BEGIN R0 := R0 AND #00F00000 OR #41000000 OR R1; EMIT; GOTO X; END ELSE R0 := R0 OR #08000000; END; ASSEMBLE; X: IF R6 = 1 AND DIVIDE THEN BEGIN R0 := TEMP OR #8E000020; EMIT; END; R7 := R6 SHLL 24 OR SIGN; END ELSE BEGIN COMMENT SET UP INSTRUCTION FOR LOADING A REGISTER FROM EITHER A COMPUTED ADDRESS OR A LOCAL STACK ADDRESS. TYPE IN LOW BITS OF R6; LOGICAL SAVETYPE, SAVER3; R6 := R7 SHLL 1 SHRL 25; SAVETYPE := R6; R3 := LSTACKM4(R5); IF R3 >= 0 THEN BEGIN R0 := R3 SHRL 12; R5 := R5 - 4; IF R0 < CLN THEN RELEASE; COMMENT COMPUTED ADDRESS; SAVER3 := R3; IF R6 > 5 THEN R6 := 1; CASE R6 OF BEGIN IF PAIRFLAG THEN PRGENREG ELSE GENREG; BEGIN R0 := #C0000000; FLREG; END; BEGIN R0 := #80000000; FLREG; END; BEGIN R0 := #40000000; PRFLREG; END; BEGIN R0 := #00000000; PRFLREG; END; END; TEMP := R0; R0 := R0 OR #08000000; R6 := SAVETYPE; R3 := SAVER3; ASSEMBLE; IF R6 = 1 AND DIVIDE THEN BEGIN R0 := TEMP OR #8E000020; EMIT; END; END; END; R6 := SAVER6; R3 := SAVER3; R1 := SAVER1; END; PROCEDURE LOADSTRING(R1); COMMENT FORCES STRING VALUES (EXCEPT CONSTANTS) TO ACCUMULATORS; BEGIN LOGICAL SAVER1, SAVER3, SAVER6, SAVERA; INTEGER LEN; SAVER1 := R1; SAVER3 := R3; SAVER6 := R6; SAVERA := R10; IF R7 >= 0 THEN BEGIN GETLENGTH; LEN := R3; GETADDRESS; R5 := R5 + 4; R1 := R7 SHRL 24; IF R1 ~= STRYNG THEN BEGIN R0 := LEN SHLL 16 OR NEXTADDR OR #D2000000; R3 := R3 SHLL 16; EMIT; R3 := NEXTADDR; R10 := LEN + 1; INCRADDR; END; LSTACKM4(R5) := R3; R7 := LEN SHLL 16 OR #87000000; END ELSE BEGIN R0 := LSTACKM4(R5) SHRL 12; IF R0 < CLN THEN BEGIN COMMENT COMPUTED ADDRESS (NOT ACCUMULATOR); R3 := LSTACKM4(R5); R6 := 7; RELEASE; R0 := R7 AND #00FF0000 OR NEXTADDR OR #D2000000; R3 := R3 SHLL 16; EMIT; R0 := NEXTADDR; LSTACKM4(R5) := R0; R10 := R7 SHRL 16 AND #FF + 1; INCRADDR; END; END; R10 := SAVERA; R6 := SAVER6; R3 := SAVER3; R1 := SAVER1; END; SEGMENT PROCEDURE LEVEL1(R1); BEGIN LOGICAL SAVER1; PROCEDURE INTREALCODE(R1); BEGIN COMMENT GENERATE IN-LINE CODE TO FLOAT AN INTEGER; INTEGER SAVER1, SAVEFL, GPR, FPR; SAVER1 := R1; SAVEFL := R0; LOADREG; R3 := LSTACKM4(R5); R0 := R3 XOR SIGN; GPR := R0; R6 := 1; RELEASE; R5 := R5-4; R0 := SAVEFL; FLREG; FPR := R0; R0 := #50000004 OR GPR ++ FCON1; EMIT; R0 := #97800004 ++ FCON1; EMIT; R0 := #68000000 OR FPR OR FCON1; EMIT; R0 := #6A000000 OR FPR OR FCON2; EMIT; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) := R1; R1 := SAVER1; END; SEGMENT PROCEDURE CONVERT(R1); COMMENT EMITS CODE TO CONVERT TERMINALS FROM DECLARED TYPE TO TYPE IN LOW ORDER BITS OF R7; IF R7 >= 0 THEN BEGIN ARRAY 2 LOGICAL SAVE01; LOGICAL SAVER3,SAVER6,SAVERA,SAVEFL; PROCEDURE INTREAL(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := SAVEFL; INTREALCODE; R7 := SAVER6; R1 := SAVER1; END; PROCEDURE INTCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; INTREAL; R0:= SAVEFL; FLREG; R5:=R5-4; R3:=LSTACK(R5); R0 := R3; R3 := R3 XOR SIGN SHRL 4 OR LSTACKM4(R5); LSTACKM4(R5) := R3; R3 := R0; R0 := R0 XOR SIGN OR S; R6 := 3; ASSEMBLE; R4 := R4 - 4; R1:=FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4):=R1; R7 := SAVER6; R1 := SAVER1; END; PROCEDURE REALCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; LOADREG; R0:=SAVEFL; FLREG; R3:=R0 OR SIGN; R0:=R0 OR S; R6 := 3; ASSEMBLE; R3 := LSTACKM4(R5) XOR SIGN SHRL 4 OR LSTACKM8(R5); LSTACKM8(R5) := R3; R5 := R5 - 4; R1:=FSTACK(R4-8) AND MASK OR SAVEFL; FSTACK(R4-8):=R1; R4 := R4 - 4; R7 := SAVER6; R1 := SAVER1; END; PROCEDURE RLONGREAL(R1); BEGIN LOGICAL SAVER1,TEMP; SAVER1 := R1; GETADDRESS; R0 := SAVEFL; TEMP := R3; FLREG; R0 := R0 OR S; R3 := LSTACKM4(R5); R6 := 3; ASSEMBLE; R0 := LSTACKM4(R5) XOR SIGN OR #78000000 OR TEMP; EMIT; R1 := SAVER1; R7 := SAVER6; END; PROCEDURE LONGSHORT(R1); BEGIN INTEGER SAVER1; SAVER1 := R1; LOADREG; R1:=FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4):=R1; R7 := SAVER6; R1 := SAVER1; END; PROCEDURE CLONGCOMPLEX(R1); BEGIN LOGICAL SAVER1,TEMP; SAVER1 := R1; GETADDRESS; TEMP := R3; R0 := SAVEFL; FLREG; R0 := R0 OR S; R3 := LSTACKM4(R5); R6 := 3; ASSEMBLE; R0:=SAVEFL; FLREG; R0:=R0 OR S; R3:=LSTACKM4(R5); R6 := 3; ASSEMBLE; R0 := LSTACKM4(R5) XOR SIGN OR #78000000 OR TEMP ++ 4; EMIT; R0 := LSTACKM8(R5) XOR SIGN OR #78000000 OR TEMP; EMIT; R0 := LSTACKM4(R5) XOR SIGN SHRL 4 OR LSTACKM8(R5); LSTACKM8(R5) := R0; R5 := R5 - 4; R4 := R4 - 4; R1:=FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4):=R1; R7 := SAVER6; R1 := SAVER1; END; PROCEDURE REALLONGCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; RLONGREAL; R0:=SAVEFL; FLREG; R3:=R0 OR SIGN; R0 := R0 OR S; R6 := 3; ASSEMBLE; R0 := LSTACKM4(R5) XOR SIGN SHRL 4 OR LSTACKM8(R5); LSTACKM8(R5) := R0; R5 := R5 - 4; R1:=FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4):=R1; R4 := R4 - 4; R7 := SAVER6; R1 := SAVER1; END; STM(R0,R1,SAVE01); SAVERA := R10; R10 := R7 SHRL 16 AND #FF; IF ~= THEN BEGIN SAVER3 := R3; GETTYPE; R6 := R6 AND #FFFF; IF R3 = 7 THEN BEGIN COMMENT STRING, PAD WITH BLANKS; INTEGER LEN; R0 := R10 SHLL 16; R6 := R6 OR R0 OR #87000000; SAVER6 := R6; GETLENGTH; LEN := R3; GETADDRESS; R1 := NEXTADDR; R5 := R5+4; LSTACKM4(R5) := R1; R0 := LEN SHLL 16 OR R1 OR #D2000000; R3 := R3 SHLL 16; EMIT; R1 := R10 - LEN; IF > THEN BEGIN R1 := R1-1 SHLL 16; R3 := BLANKS SHLL 16; R0 := NEXTADDR + LEN ++ #D2000001 OR R1; EMIT; END; R7 := SAVER6; R10 := R10 + 1; INCRADDR; END ELSE BEGIN R0 := R10 SHLL 24; R6 := R6 OR R0 OR SIGN; R1 := 5 - R10 SHLL 30; SAVEFL := R1; SAVER6 := R6; IF R3 <= 5 THEN CASE R10 OF BEGIN NULL; BEGIN COMMENT CONVERT TO REAL; CASE R3 OF BEGIN INTREAL; NULL; LONGSHORT; END; END; BEGIN COMMENT CONVERT TO LONG REAL; CASE R3 OF BEGIN INTREAL; RLONGREAL; NULL; END; END; BEGIN COMMENT CONVERT TO COMPLEX; CASE R3 OF BEGIN INTCOMPLEX; REALCOMPLEX; REALCOMPLEX; NULL; LONGSHORT; END; END; BEGIN COMMENT CONVERT TO LONG COMPLEX; CASE R3 OF BEGIN INTCOMPLEX; REALLONGCOMPLEX; REALCOMPLEX; CLONGCOMPLEX; NULL; END; END; END; END; R6 := SAVER6; R3 := SAVER3; END; R10 := SAVERA; LM(R0,R1,SAVE01); END; SEGMENT PROCEDURE CONVERTRESULT(R1); COMMENT EMITS CODE TO CONVERT NON-TERMINALS FROM SYNTACTIC TYPE TO TYPE IN CONV BITS OF OPERATOR NODE; BEGIN LOGICAL SAVER1,SAVETYPE; BYTE KEEPREG; LOGICAL SAVER3,SAVEFL; PROCEDURE INTREAL(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := SAVEFL; INTREALCODE; R7 := SAVETYPE SHLL 24 OR SIGN; R1 := SAVER1; END; PROCEDURE INTCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; INTREAL; R0 := SAVEFL; FLREG; R5 := R5 - 4; R3 := LSTACK(R5) ; R0 := R3; R3 := R3 XOR SIGN SHRL 4 OR LSTACKM4(R5) OR SIGN; LSTACKM4(R5) := R3; R3 := R0; R4 := R4 - 4; R0 := R0 XOR SIGN OR S; R6 := 3; ASSEMBLE; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) :=R1; R1 := SAVER1; R7 := SAVETYPE SHLL 24 OR SIGN; END; PROCEDURE RLONGREAL(R1); BEGIN LOGICAL SAVER1,TEMP; SAVER1 := R1; R3 := LSTACKM4(R5); IF R3 >= 0 THEN BEGIN TEMP := R3; R3 := R3 AND #F000 SHRL 12; IF R3 < CLN AND ~KEEPREG THEN BEGIN R10 := R7; R6 := 1; R3 := TEMP; RELEASE; END; R0 := SAVEFL; R5 := R5 - 4; FLREG; R0 := R0 OR S; R3 := LSTACKM4(R5); R6 := 3; ASSEMBLE; R0 := LSTACKM4(R5) XOR SIGN OR #78000000 OR TEMP; EMIT; END ELSE BEGIN R3 := NEXTADDR + 3 AND SMASK; NEXTADDR := R3; R6 := 2; R0 := LSTACKM4(R5) SHLL 1 SHRL 1; R10:=R0; ASSEMBLE; R0:=R10 OR #2F000000; R3 := R10 SHRL 4; R0 := R0 OR R3; EMIT; R3 := NEXTADDR; R6 := 2; R0 := R10 OR #08000000; R6 := 2; ASSEMBLE; R10 := 4; INCRADDR; END; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) :=R1; R1 := SAVER1; R7 := SAVETYPE SHLL 24 OR SIGN; END; PROCEDURE REALCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; LOADREG; R0 := SAVEFL; FLREG; R3 := R0 OR SIGN; R0 := R0 OR S; R6 := SAVEFL SHLL 1; IF R6 < 0 THEN R6 := 2 ELSE R6 := 3; ASSEMBLE; R3 := LSTACKM4(R5) XOR SIGN SHRL 4 OR LSTACKM8(R5); LSTACKM8(R5) := R3; R5 := R5 - 4; R4 := R4 - 4; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) :=R1; R7 := SAVETYPE SHLL 24 OR SIGN; R1 := SAVER1; END; PROCEDURE LONGSHORT(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; LOADREG; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) := R1; R7 := SAVETYPE SHLL 24 OR SIGN; R1 := SAVER1; END; PROCEDURE CLONGCOMPLEX(R1); BEGIN LOGICAL SAVER1,TEMP; SAVER1 := R1; R3 := LSTACKM4(R5); IF R3 < 0 THEN BEGIN R0 := R3 AND MASK5 OR SIGN; LSTACKM4(R5) := R0; R3 := R3 SHLL 4 AND MASK5 OR SIGN; R5 := R5 + 4; LSTACKM4(R5) := R3; END ELSE BEGIN R3 := R3 + 4; R5 := R5 + 4; LSTACKM4(R5) := R3; END; SET(KEEPREG); RLONGREAL; R0 := LSTACKM4(R5); TEMP := R0; R0 := LSTACKM8(R5); IF R0 > 0 THEN R4 := R4 - 4; R5 := R5 - 4; RESET(KEEPREG); RLONGREAL; R0 := TEMP SHLL 1 SHRL 5 OR LSTACKM4(R5) OR SIGN; LSTACKM4(R5) := R0; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) :=R1; R1 := SAVER1; R7 := SAVETYPE SHLL 24 OR SIGN; END; PROCEDURE REALLONGCOMPLEX(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; RLONGREAL; R0 := SAVEFL; FLREG; R3 := R0 OR SIGN; R0 := R0 OR S; R6 := 3; ASSEMBLE; R0 := LSTACKM4(R5) XOR SIGN SHRL 4 OR LSTACKM8(R5); LSTACKM8(R5) := R0; R5 := R5 - 4; R4 := R4 - 4; R1 := FSTACK(R4-4) AND MASK OR SAVEFL; FSTACK(R4-4) :=R1; R7 := SAVETYPE SHLL 24 OR SIGN; R1 := SAVER1; END; RESET(KEEPREG); R6 := SAVEL; R10 := R10-R10; IC(R10,CONV(R6)); IF R10 ~= 0 THEN BEGIN SAVER1 := R1; SAVER3 := R3; R3 := R7 SHRL 24 AND #7F; COMMENT CURRENT TYPE; IF R3 = 7 THEN BEGIN COMMENT STRING, PAD WITH BLANKS; INTEGER LEN; R3 := LSTACKM4(R5); R6 := 7; RELEASE; R0 := R7 SHRL 16 AND #FF; LEN := R0; R0 := R0 SHLL 16 OR NEXTADDR OR #D2000000; R3 := R3 SHLL 16; EMIT; R0 := NEXTADDR; LSTACKM4(R5) := R0; R1 := R10 - LEN; IF > THEN BEGIN R1 := R1-1 SHLL 16; R3 := BLANKS SHLL 16; R0 := R0 + LEN ++ #D2000001 OR R1; EMIT; END; R7 := R10 SHLL 16 OR #87000000; R10 := R10 + 1; INCRADDR; END ELSE BEGIN SAVETYPE := R10; R1 := 5 - R10 SHLL 30; SAVEFL := R1; IF R3 <= 5 THEN CASE R10 OF BEGIN NULL; BEGIN CASE R3 OF BEGIN INTREAL; NULL; LONGSHORT; END; END; BEGIN CASE R3 OF BEGIN INTREAL; RLONGREAL; NULL; END; END; BEGIN CASE R3 OF BEGIN INTCOMPLEX; REALCOMPLEX; REALCOMPLEX; NULL; LONGSHORT; END; END; BEGIN CASE R3 OF BEGIN INTCOMPLEX; REALLONGCOMPLEX; REALCOMPLEX; CLONGCOMPLEX; NULL; END; END; END; END; R3 := SAVER3; R1 := SAVER1; END; END; PROCEDURE DIVREM(R1); COMMENT GENERATES CODE FOR DIVISION OF INTEGER ARGUMENTS; BEGIN LOGICAL SAVER1; SAVER1 := R1; SET(PAIRFLAG); SET(DIVIDE); R10 := R6; R6 := 1; IF R7 >= 0 THEN BEGIN R10 := TREE(R10); IF R10 < 0 THEN BEGIN LOADREG; R0 := LSTACKM4(R5); FORCEPAIR; R5 := R5-4; R3 := LSTACKM4(R5); IF R3 < 0 THEN RELEASE; R10:=R3 SHRL 12; IF R3>=0 AND R10>=CLN THEN ADJSTACKS; R1 := LSTACK(R5); LSTACKM4(R5) := R1; END ELSE BEGIN LOGICAL SAVEADD; GETADDRESS; SAVEADD := R3; R0 := LSTACKM4(R5); IF R0 < 0 THEN FORCEPAIR ELSE BEGIN COMMENT LEFT SIDE STORED WHILE PROCESSING RIGHT; LOADREG; R0 := LSTACKM4(R5) AND #00F00000; END; R3 := SAVEADD; END; END ELSE BEGIN R10 := TREE(R10); IF R10 < 0 THEN BEGIN LOADREG; R0 := LSTACKM4(R5); FORCEPAIR; R5 := R5-4; R3 := LSTACKM4(R5); IF R3 < 0 THEN RELEASE; R0 := R0 OR SIGN; R10 := LSTACK(R5); LSTACKM4(R5) := R10; ADJSTACKS; END ELSE BEGIN R5 := R5-4; LOADREG; R0 := LSTACKM4(R5); FORCEPAIR; R3 := LSTACK(R5); RELEASE; END; END; R0 := R0 OR D; ASSEMBLE; R7 := R6 SHLL 24 OR SIGN; RESET(PAIRFLAG); RESET(DIVIDE); R1 := SAVER1; END; PROCEDURE BITSANDORARG2(R1); COMMENT SETS UP INSTRUCTION FOR ASSEMBLE EXCEPT OPCODE PART. MAY ALSO WRITE INSTRUCTION TO RELOAD BITS VALUE; BEGIN LOGICAL SAVER1; SAVER1 := R1; R6 := R6 SHLL 1 SHRL 25; IF R7 >= 0 THEN BEGIN GETADDRESS; R0 := LSTACKM4(R5); IF R7 < 0 THEN BEGIN R7 := #88000000; LOADREG; R0 := LSTACKM4(R5); END; END ELSE BEGIN R0 := LSTACKM8(R5); R3 := LSTACKM4(R5); IF R0 >= 0 THEN BEGIN IF R3 >= 0 THEN LOADREG; R3 := LSTACKM8(R5); R0 := LSTACKM4(R5); LSTACKM8(R5) := R0; R6 := 1; ADJSTACKS; R6 := 8; END ELSE RELEASE; R5 := R5-4; END; R1 := SAVER1; END; PROCEDURE SHIFTAMOUNT(R1); COMMENT GENERATES INSTRUCTIONS TO LOAD ABSOLUTE VALUE OF SHIFT EXPRESSION; BEGIN LOGICAL SAVER1; SAVER1 := R1; LOADREG; R0 := LSTACKM4(R5); R3 := R0; ASSEMBLE; R1 := SAVER1; END; PROCEDURE BITSSHIFTARG2(R1); COMMENT GENERATES INSTRUCTIONS TO SET UP SHIFT OF BITS VALUE. R0 IS AN OUTPUT CONTAINING THE SHIFT INSTRUC- TION MINUS THE OPCODE; BEGIN LOGICAL SAVER1, TEMP; SAVER1 := R1; R10 := R6; R6 := 8; R10 := TREE(R10); IF R10 < 0 THEN BEGIN LOADREG; R0 := LSTACKM4(R5); TEMP := R0; R5 := R5-4; LOADREG; R3 := LSTACKM4(R5); RELEASE; R0 := TEMP; LSTACKM4(R5) := R0; R3 := R3 AND MASK5 SHRL 8; R0 := R0 AND MASK5 OR R3; END ELSE BEGIN SHIFTAMOUNT; R0 := LSTACKM4(R5) AND MASK5 SHRL 8; TEMP := R0; R5 := R5-4; LOADREG; R3 := TEMP; RELEASE; R0 := LSTACKM4(R5) AND MASK5 OR TEMP; END; R1 := RSTACKM4(R2) + 4; IF R1 ~= R5 THEN ADJSTACKS; R1 := SAVER1; END; COMMENT SELECTION INDICES FOR PROCEDURE ARRAYS; BYTE INITAREF SYN 1, INDEXOP SYN 2, INITADCL SYN 6, LBOUND SYN 5, FILLDESCRIP SYN 3, CLOSEDESCRIP SYN 4; SEGMENT PROCEDURE ARRAYS(R1); COMMENT THIS PROCEDURE CONTAINS ALL PROC RELEVANT TO ARRAY DECLARATIONS AND REFERENCES. THE APPROPRIATE PROCEDURE IS SELECTED BY THE PARAMETER R3; BEGIN PROCEDURE INITAREF(R1); COMMENT SET UP STACK FOR AN ARRAY REFERENCE (ARG1 - INDX); BEGIN LOGICAL SAVER1; SAVER1 := R1; GETADDRESS; R0 := TYPEINFO(R7) AND #F SHLL 4; R1 := R3 SHLL 8 OR R0 OR #1; STACKP4(R8) := R1; IC(R0,SIMPLETYPE(R7)); STC(R0,STACKP4(R8)); COMMENT STACKP4 FORMAT: SIMPLETYPE(0:7), ADDR(8:23), #DIMEN(24:27), CURR DIM(28:31); IF R0 ~= 7 THEN R1 := 0 ELSE R1 := SIMTYPEINFO(R7) SHLL 16; IC(R0,TYPE(R7)); IF R0 = 18 THEN R1 := R1 OR SIGN; STACKP8(R8) := R1; COMMENT STACKP8 FORMAT: FORMAL SWITCH(0:0), STRING LEN(8:15), SUBARRAY MASK(16:31); R1 := SAVER1; END; PROCEDURE INDEXOP(R1); COMMENT PERFORM AN INDEXING OPERATION (ARG2 - INDX); BEGIN LOGICAL SAVER1; INTEGER NDIMEN, DESPOINT; SAVER1 := R1; R0 := STACKP4(R8) AND #F0 SHRL 4; NDIMEN := R0; R0 := STACKP4(R8) SHRL 8 AND #FFFF; R1 := STACKP4(R8) AND #F * 12S - 8 + R0; DESPOINT := R1; COMMENT R1 -> (DELTA(I), L(I), U(I)); R1 := R7 SHRL 24; IF R1 = ARSTAR THEN BEGIN COMMENT SUBARRAY DESIGNATOR; R1 := STACKP4(R8) AND #F - 1; R0 := #1 SHLL R1 OR STACKP8(R8); STACKP8(R8) := R0; IF R1 = 0 THEN BEGIN COMMENT FIRST DIMENSION, ESTABLISH REGISTER; GENREG; R0 := R0 SHRL 4 OR LSTACKM4(R5); R0 := R0 AND #00FF0000 OR #1B000000; EMIT; END; END ELSE BEGIN LOADREG; R10 := LSTACKM4(R5) AND #00F00000; IF CHECKFLAG THEN BEGIN R0 := #59000008 ++ DESPOINT OR R10; EMIT; R0 := #45100000 OR ARRAYERR; EMIT; R0 := #59000004 ++ DESPOINT OR R10; EMIT; END; R0 := STACKP4(R8) AND #F; IF R0 = 1 THEN BEGIN COMMENT FIRST DIMENSION, TYPE TO R3; R3 := 0; IC(R3,STACKP4(R8)); R0 := STACKP8(R8); IF R3 = 7 OR R0 < 0 THEN BEGIN COMMENT STRING OR FORMAL - MULTIPLY; R0 := #4C000002 ++ DESPOINT OR R10; EMIT; END ELSE IF R3 ~= 6 THEN BEGIN COMMENT SHIFT; IF R3 <= 2 OR R3 >= 8 THEN R0 := 2 ELSE IF R3 = 5 THEN R0 := 4 ELSE R0 := 3; R0 := R0 OR #89000000 OR R10; EMIT; END; END ELSE BEGIN COMMENT NOT FIRST DIMENSION; R0 := #4C000002 ++ DESPOINT OR R10; EMIT; R3 := LSTACKM4(R5-4); IF R3 < 0 THEN BEGIN COMMENT ACCUMULATING REGISTER NOT DUMPED; R0 := R10 SHRL 4 OR R3 XOR SIGN OR #1A000000; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5-4; END ELSE BEGIN COMMENT ACCUMULATING REGISTER DUMPED; R0 := R10 OR R3 OR #5A000000; EMIT; R0 := LSTACKM4(R5); R5 := R5-4; LSTACKM4(R5) := R0; R0 := RSTACKM4(R2) - 4; RSTACKM4(R2) := R0; END; END; END; R1 := STACKP4(R8) AND #F; IF R1 = NDIMEN THEN BEGIN COMMENT END OF INDEXING OPERATION; R1 := STACKP4(R8) SHRL 8 AND #FFFF; R3 := LSTACKM4(R5); R0 := R3 AND #00F00000 OR R1 OR #5E000000; EMIT; R7 := STACKP4(R8) AND #FF000000 OR SIGN; R10 := STACKP8(R8) AND #FFFF; IF = THEN BEGIN R3 := R3 SHRL 8 AND #FFFF; LSTACKM4(R5) := R3; R0 := 0; IC(R0,STACKP4(R8)); IF R0 = 6 THEN R7 := R7 OR #10000 ELSE IF R0 = 7 THEN BEGIN R0 := STACKP8(R8) AND #00FF0000; R7 := R7 OR R0; END; CONVERTRESULT; END ELSE BEGIN COMMENT PROCESS SUBARRAY ACTUAL PARAMETER; INTEGER LDESCRIP; R0 := STACKP4(R8) SHRL 8 AND #FFFF + 4; DESPOINT := R0; R0 := NEXTADDR + 3 AND #FFFC; NEXTADDR := R0; R0 := R0 + 4; LDESCRIP := R0; R0 := 0; NDIMEN := R0; WHILE R10 ~= 0 DO BEGIN R0 := R10 AND #1; IF ~= THEN BEGIN COMMENT STARRED DIMENSION; R0 := NDIMEN + 1; NDIMEN := R0; R1 := LDESCRIP; R0 := #D20B0000 OR R1; R3 := DESPOINT SHLL 16; R1 := R1 + 12; LDESCRIP := R1; EMIT; END; R1 := DESPOINT + 12; DESPOINT := R1; R10 := R10 SHRL 1; END; R0 := NEXTADDR; LDESCRIP := R0; R10 := NDIMEN * 12S + 4; INCRADDR; R10 := LSTACKM4(R5) AND #00F00000; R0 := #50000000 OR R10 OR LDESCRIP; EMIT; R0 := R10 SHLL 4 OR SIGN; R1 := NDIMEN SHLL 16 OR R0; R0 := R7 SHRL 24 AND #7F; IF R0 = 7 THEN R0 := STACKP8(R8) AND #FF0000 SHRL 8 + 7; R0 := R0 OR R1; LSTACKM4(R5) := R0; R0 := #41300000 OR LDESCRIP; EMIT; SET(SUBARFLAG); END; END ELSE BEGIN COMMENT NOT LAST SUBSCRIPT, UPDATE STACK; R0 := STACKP4(R8) ++ 1; R1 := STACKP8(R8); STACKP4(R8-SSIZE) := R0; STACKP8(R8-SSIZE) := R1; END; R1 := SAVER1; END; PROCEDURE INITADCL(R1); COMMENT SET UP STACK FOR ARRAY DECL (AR, & AR) - ARG1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := R7 AND #FFFF; R3 := IDLOC1(R1) SHLL 12 + IDLOC2(R1)+4; STACK11(R8) := R1; STACK12(R8) := R3; COMMENT STACK1 FORMAT: NT PTR(0:15), @(DELTA(I),LB(I),UB(I))(16:31); R10 := 0; IC(R10,SIMPLETYPE(R1)); IF R10 = 7 THEN R10 := SIMTYPEINFO(R1) + 1 ELSE IC(R10,SITYPELEN(R10)); R0 := R7 SHRL 16 AND #FF; STACK21(R8) := R10; STACK22(R8) := R0; COMMENT STACK2 FORMAT: ELEMENT SIZE(0:15), #ID'S(16:31); R7 := SIGN; R1 := SAVER1; END; PROCEDURE LBOUND(R1); COMMENT PUT L(I) INTO DESCRIPTOR (:: - ARG1); BEGIN LOGICAL SAVER1, SAVER6; SAVER1 := R1; SAVER6 := R6; R10 := STACK12(R8-SSIZE) AND #FFFF; R0 := LSTACKM4(R5) AND #00F00000 OR R10 ++ #50000004; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; R6 := SAVER6; R1 := SAVER1; END; PROCEDURE UBOUND(R1); COMMENT PUT U(I) INTO DESCRIPTOR; BEGIN LOGICAL SAVER1; SAVER1 := R1; R10 := STACK12(R8) AND #FFFF; R0 := LSTACKM4(R5) AND #00F00000 OR R10 ++ #50000008; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; R1 := SAVER1; END; PROCEDURE FILLDESCRIP(R1); COMMENT COMPLETE BOUND PAIR, UPDATE STACK (AR, - ARG2); BEGIN LOGICAL SAVER1; SAVER1 := R1; UBOUND; R0 := STACK1(R8) ++ 12; R1 := STACK2(R8); STACK1(R8-SSIZE) := R0; STACK2(R8-SSIZE) := R1; R7 := R7 OR SIGN; R1 := SAVER1; END; PROCEDURE CLOSEDESCRIP(R1); COMMENT COMPLETE LAST BOUND PAIR & DECLARATION (AR) - ARG2); BEGIN LOGICAL SAVER1; INTEGER DESCSIZE; BYTE SIMTYPE; SAVER1 := R1; UBOUND; R3 := STACK11(R8); R0 := TYPEINFO(R3); R1 := R0*12S + 4; DESCSIZE := R1; IC(R1,SIMPLETYPE(R3)); STC(R1,SIMTYPE); R10 := IDLOC1(R3) SHLL 12 + IDLOC2(R3); R0 := R0 OR #41000000; EMIT; R0 := R10 ++ #41200004; EMIT; R0 := STACK21(R8) OR #41300000; EMIT; R0 := #1B440000; EMIT; R0 := #45100000 OR MKDESC1; EMIT; R0 := CLN SHLL 12 OR FP OR #58100000; EMIT; R0 := #18010000; EMIT; R0 := #1A040000; EMIT; FOR R7 := 1 STEP 1 UNTIL STACK22(R8) DO BEGIN R0 := #50000000 OR R10; EMIT; R3 := R10; R10 := R10 + DESCSIZE; CLI(#09,SIMTYPE); IF = THEN BEGIN R0 := #50300004 ++ R10; EMIT; R0 := #50100000 OR R10; EMIT; R10 := R10 + 8; R0 := DESCSIZE SHLL 16 OR #92000000 OR R3; EMIT; END; R0 := #1A130000; EMIT; R3 := R3 + 4 SHLL 16; R0 := DESCSIZE-5 SHLL 16 OR R10 ++ #D2000004; EMIT; R0 := #1A030000; EMIT; END; R0 := INSCOUNTER - 8; INSCOUNTER := R0; R1 := STACK21(R8)*STACK22(R8) AND #7; IF ~= THEN BEGIN R0 := #41101007; EMIT; R0 := #54100000 OR DUBLMASK; EMIT; END; R0 := CLN SHLL 16 OR #18200000; EMIT; CLI(#09,SIMTYPE); IF = OR CHECKFLAG THEN R0 := ALLOCERR1 ELSE R0 := ALLOCERR; R0 := R0 OR #45300000; EMIT; R7 := SIGN; R1 := SAVER1; END; INTEGER SAVER1; SAVER1 := R1; CASE R3 OF BEGIN INITAREF; INDEXOP; FILLDESCRIP; CLOSEDESCRIP; LBOUND; INITADCL; END; R1 := SAVER1; END; PROCEDURE ALLOCATECODE(R1); COMMENT EMITS CODE FOR DATA SEGMENT PRIMARY ALLOCATION; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := LOGPOINTER + 4; LOGPOINTER := R1; R0 := INSCOUNTER; LOGSTACK(R1) := R0; R0 := #41000000; EMIT; R0 := #45300000; R1 := SAVER1; END; PROCEDURE SETDISPLAY(R1); COMMENT EMITS ST OR STM TO SAVE DISPLAY IN BLOCK MARK; BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := CLN SHLL 20 OR #18050000; EMIT; R1 := CLN; IF R1 <= 11 THEN BEGIN IF = THEN R0 := #50B05000 ELSE R0 := R1 SHLL 20 OR #900B5000; R0 := R0 OR DSP; EMIT; END; R1 := SAVER1; END; PROCEDURE SUBRENTRY(R1); COMMENT EMITS IMPLICIT SUBROUTINE ENTRY CODE (AP, & AP) - ARG1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := STACK12(R8) + 1; STACK12(R8) := R0; COMMENT # PARAMS; R1 := LOGPOINTER + 8; LOGPOINTER := R1; R0 := INSCOUNTER OR #E000; LOGSTACK(R1) := R0; R0 := 4; CHAININ; ALLOCATECODE; R0 := R0 OR ALLOCATE; EMIT; R0 := #90E35000 OR PB; EMIT; R0 := #50500000 OR MP; EMIT; R3 := CLN; R0 := 12 - R3 SHLA 2 + DSP; R1 := R3 SHLL 12 OR R0; NEXTADDR := R1; IF R3 <= 10 THEN BEGIN IF = THEN R0 := #18B40000 ELSE R0 := R3 + 1 SHLL 20 OR #980B4000 + STACK21(R8); EMIT; COMMENT NEED STACKED VALUE OF DSP HERE; END; SETDISPLAY; R1 := SAVER1; END; PROCEDURE PROCSUBREXIT(R1); COMMENT EMITS COMMON EXIT CODE FOR PROCEDURE, IMPLICIT SUBROUTINE; BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := NEXTADDR + 7 AND #FFFFF8; R1 := R0 SHRL 12; R0 := R0 AND #FFF; IF R1 ~= CLN THEN BEGIN R3 := 5; EROR; END; R3 := LOGPOINTER; R1 := LOGSTACK(R3); PROGRAM(R1+2) := R0; R3 := R3 - 4; LOGPOINTER := R3; R0 := CLN SHLL 12 OR #98120000 OR RETA; EMIT; R0 := #50200000 OR MP; EMIT; R0 := #07F10000; EMIT; R1 := SAVER1; END; PROCEDURE TERMBLOCKEXPR(R1); COMMENT PROCESSES TERMINAL EXPRESSIONS FOR TYPED PROC EXIT; BEGIN LOGICAL SAVER1, TEMP; SAVER1 := R1; GETTYPE; IF R3 = 6 THEN BEGIN COMMENT LOGICAL; GETADDRESS; TEMP := R3; GENREG; R0 := R0 OR TEMP OR #43000000; EMIT; R7 := #86020000; END ELSE BEGIN CONVERT; IF R3 = 7 THEN LOADSTRING ELSE LOADREG; END; R1 := SAVER1; END; PROCEDURE STORERESULT(R1); COMMENT STORES TOP REGISTER(S) IN LOCAL STACK, EMITS LA. INPUT: R6 = SIMPLE TYPE (DOES NOT PROCESS STRINGS); BEGIN LOGICAL SAVER1, SAVERA; INTEGER SAVER3; SAVER1 := R1; SAVERA := R10; SAVER3 := R3; R3 := R6; IF R3 >= 8 THEN R3 := 1; R10 := NEXTADDR; IF R3 < 3 OR R3 = 4 THEN R10 := R10 + 3 AND _4 ELSE IF R3 = 3 OR R3 = 5 THEN R10 := R10 + 7 AND _8; NEXTADDR := R10; R0 := LSTACKM4(R5); IF R3 = 6 THEN BEGIN R0 := R0 AND #00F00000 OR #42000000 OR R10; EMIT; END ELSE BEGIN R3 := R10; ASSEMBLE; END; R0 := #41300000 OR R10; EMIT; R10 := 0; IC(R10,SITYPELEN(R6)); INCRADDR; R3 := SAVER3; R10 := SAVERA; R1 := SAVER1; END; BYTE PROCENTRY SYN 1, PROCEXIT SYN 2, BLOCKENTRY SYN 3, GOTOO SYN 4, PROCCALL SYN 5, PROCRETURN SYN 6; SEGMENT PROCEDURE ENTRYEXIT(R1); COMMENT THIS PROCEDURE CONTAINS PROCEDURES RELEVANT TO BLOCK AND PROCEDURE ENTRY AND EXIT. R3 CONTAINS A SELECTION INDEX; BEGIN PROCEDURE CALLCONV(R1); COMMENT SETS-UP CALL TO CONVERSION ROUTINE FOR VALUE/RESULT. INPUTS: R0 = DPD, R3 = TYPE (NEGATED FOR RESULT), R10 = NT INDX; BEGIN ARRAY 2 LOGICAL SAVE01; STM(R0,R1,SAVE01); R0 := ABS R3 SHLL 8 OR #41000000; EMIT; R0 := SAVE01(0) ++ #43000004; EMIT; IF R3 < 0 THEN BEGIN R0 := #11000000; EMIT; COMMENT NEGATE FOR RESULT; END; IF R3 >= 0 THEN R1 := #41200000 ELSE BEGIN R0 := #18230000; EMIT; R1 := #41300000; END; R0 := IDLOC1(R10) SHLL 12 + IDLOC2(R10) OR R1; EMIT; R0 := @FPARCONV; R0 := NEG R0; EMITCALL; R0 := #18100000; EMIT; R0 := #44100000 OR ASSIGNVR; EMIT; LM(R0,R1,SAVE01); END; SEGMENT PROCEDURE PROCENTRY(R1); COMMENT EMITS PROCEDURE ENTRY, PARAM RECOVERY CODE (PCL - ARG1); BEGIN INTEGER DPD, TEMP; BYTE FORMAL; LOGICAL SAVER1; SAVER1 := R1; COMMENT SET COMPILER VARIABLES, EMIT INITIAL CODE; R3 := 0; INSCOUNTER := R3; NUMSTACKP := R3; NUMSTACK(0) := R3; REFPCOUNT := R3; SEGTABIDX := R3; IC(R3,HIERARCHY(R7)); R3 := R3 AND #F; CLN := R3; R1 := IDLOC1(R7) AND #FFF; R0 := R3 SHLL 12 OR R1; NEXTADDR := R0; IC(R3,IDLOC2(R7+1)); SEGNO(0) := R3; R0 := IDNO(R7) SHLA 2; SEGIDNO := R0; R0 := ENDCHAIN; CHAIN(0) := R0; RESET(PRINT); MVI(0,TRACEIT); CLI(0,TRACE); IF ~= THEN BEGIN LM(R0,R1,TRACEBITS); SLDL(R0,B3); IF R0 < 0 THEN BEGIN R0 := R0-R0; IC(R0,TRACE); STC(R0,TRACEIT); IF R0 = 2 OR R0 = 5 OR R0 = 8 THEN SET(PRINT); END; END; R0 := #47F00000; EMIT; EMIT; R0 := 0; WRITENUMBER; R0 := 4096; WRITENUMBER; R0 := 0; WRITENUMBER; WRITENUMBER; R1 := NEXTADDR AND #FFF; R0 := CLN SHLL 16 OR R1; WRITENUMBER; COMMENT EMIT SFPD'S, SET UP STACK, LOCATE REF VAL/RESULT PAR. STACK1 FORMAT: RESULT PARAM SW(0:0), STRING LEN(8:15), PROC SI TYPE(16:31) STACK2 FORMAT: (0S,_12S) = NO PARAMETERS FIRST PARAM NT INDEX(0:15), LAST PARAM NT INDEX(16:31); R1 := 0; IC(R1,SIMPLETYPE(R7)); STACK12(R8) := R1; R0 := 0; IF R1 = 7 THEN R0 := SIMTYPEINFO(R7); STACK11(R8) := R0; R3 := TYPEINFO(R7) SHLA 2; IF = THEN R1 := 0 COMMENT NO PARAMETERS; ELSE BEGIN R1 := BLENGTH(R3); R3 := NPOINT(R3); END; STACK21(R8) := R3; R0 := R3 + R1 - 12; STACK22(R8) := R0; R0 := 0; R1 := R1/12; COMMENT R1 = NO OF PARAMETERS; R10 := STACK12(R8); R0 := R10 SHLL 8; IF R10 = 7 THEN IC(R0,STACK11(R8+1)) ELSE BEGIN IC(R0,SITYPELEN(R10)); DECR(R0); END; R0 := R0 SHLL 16 OR R1; R1 := R1 SHLA 3; SEGNTLEN := R1; R1 := R1 + DPDORG; DSP := R1; WRITENUMBER; R0 := TYPEINFO(R7) SHLA 2; PROCLINK := R0; R10 := R10-R10; BLOCKLINK := R10; FORLINK := R10; FOR R3 := STACK21(R8) STEP 12 UNTIL STACK22(R8) DO BEGIN R0 := 0; R1 := R0; IC(R0,SIMPLETYPE(R3)); IC(R1,VR(R3)); IF R0 = 9 AND R1 ~= 0 THEN BEGIN R0 := REFPCOUNT + 1; REFPCOUNT := R0; IF R0 = 1 THEN R10 := IDLOC2(R3); R0 := 9; END; IF R1 = 2 OR R1 = 3 THEN BEGIN R1 := STACK1(R8) OR SIGN; STACK1(R8) := R1; R1 := 0; IC(R1,VR(R3)); END; IF R0 = 7 THEN R0 := SIMTYPEINFO(R3) SHLL 8 OR #07; R1 := R1 SHLL 24 OR R0; R0 := 0; IC(R0,TYPE(R3)); IF R0 = #12 THEN R0 := TYPEINFO(R3) SHLL 16 OR R1 ELSE R0 := R1; WRITENUMBER; END; PROGRAM(22) := R10; COMMENT FIRST REF VAR OFFSET; COMMENT PROCESS LABEL, CONSTANT, AND CONSTANT POINTER TABLES; R0 := #47F00000; R3 := LITORG; WHILE R3 ~= INSCOUNTER DO EMIT; R10 := CPTBASE + CONSPTTABL - 4; FOR R1 := CPTBASE STEP 4 UNTIL R10 DO BEGIN R0 := CONSPTTAB(R1) + R3; CONSPTTAB(R1) := R0; END; R10 := CONSTABL + 3 AND _4 - 4; FOR R3 := 0 STEP 4 UNTIL R10 DO BEGIN R1 := CONSTAB; R0 := B1(R3); WRITENUMBER; END; COMMENT EMIT PROCEDURE ENTRY CODE; R0 := INSCOUNTER OR #E000; PROGRAM(2) := R0; PROGRAM(6) := R0; ALLOCATECODE; R1 := STACK21(R8); IF R1 > STACK22(R8) THEN R1 := ALLOCATE ELSE R1 := ALLOCATE1; R0 := R0 OR R1; EMIT; R10 := REFPCOUNT; IF R10 = 0 THEN R0 := #1B330000 ELSE R0 := R10 OR #41300000; EMIT; R0 := #90E35000 OR PB; EMIT; IF R10 ~= 0 AND ~CHECKFLAG THEN BEGIN R0 := #58000000 OR NULLREF; EMIT; R3 := PROGRAM(22) OR #5000; R0 := #50000000 OR R3; EMIT; IF R10 > 1 THEN BEGIN R0 := R10 SHLA 2 - 5 SHLL 16 OR #D2000004 ++ R3; R3 := R3 SHLL 16; EMIT; END; END; COMMENT SET LOCAL VARIABLES TO UNDEFINED; R10 := 12-CLN SHLA 2 + DSP + 7 AND #FFFFF8; R1 := NEXTADDR AND #FFF - R10; IF > AND CHECKFLAG THEN BEGIN TEMP := R1; R0 := #D2075000 OR R10; R3 := UNDEFINED SHLL 16; EMIT; R3 := R10 OR #5000 SHLL 16; R0 := #D2FF5008 ++ R10; R10 := TEMP - 8; WHILE R10 >= 256 DO BEGIN EMIT; R0 := R0 ++ 256; R10 := R10 - 256; END; IF R10 > 0 THEN BEGIN R10 := R10-1 SHLL 16; R0 := R0 AND #FF00FFFF OR R10; EMIT; END; END; COMMENT SET DISPLAY; R0 := #50500000 OR MP; EMIT; R1 := CLN; R0 := IDLOC1(R7) AND #8000; IF = THEN RESET(FORMAL) ELSE BEGIN COMMENT PROCEDURE MAY BE CALLED FORMALLY; SET(FORMAL); IF R1 <= 10 THEN BEGIN IF = THEN R0 := #18B40000 ELSE R0 := R1 + 1 SHLL 20 OR #980B4000 + DSPLINK; EMIT; END; END; SETDISPLAY; R1 := SAVEL; R1 := TREEP(R1); IC(R0,TREE(R1)); R0 := R0 AND #7F; IF R0 = UCOUNT AND DEBUGFLAG THEN BEGIN R0 := TREEP(R1) + COUNTBASE OR #FA300000; R3 := PL11 SHLL 16; EMIT; R0 := INSCOUNTER; PPMARK := R0; END; COMMENT EMIT DPD -> PV OPERATIONS; R0 := CLN SHLL 12 OR DPDORG; DPD := R0; FOR R10 := STACK21(R8) STEP 12 UNTIL STACK22(R8) DO BEGIN R0 := 0; IC(R0,VR(R10)); IF R0 = 1 OR R0 = 3 THEN BEGIN COMMENT VALUE OR VALUE RESULT; R0 := #FF; R3 := DPD; FPARCODE; R0 := 0; R3 := R0; IC(R0,VR(R10)); IC(R3,SIMPLETYPE(R10)); IF FORMAL OR R0 = 3 THEN BEGIN IF R3 > 1 AND R3 <= 5 THEN BEGIN COMMENT CONVERSION MAY BE REQUIRED; R0 := DPD; CALLCONV; GOTO SKIP; END; END; IF R3 ~= 7 THEN BEGIN IC(R1,SITYPELEN(R3)); R1 := R1 AND #FF - 1; END ELSE BEGIN COMMENT STRING, PAD IF NECESSARY; R1 := SIMTYPEINFO(R10); IF R0 ~= 3 AND R1 > 0 THEN BEGIN R0 := IDLOC1(R10) SHLL 12 + IDLOC2(R10) + 1; R1 := R1 - 1; IF = THEN R0 := R0 OR #92400000 ELSE BEGIN R3 := BLANKS SHLL 16; R1 := R1 SHLL 16; R0 := R0 OR R1 OR #D2000000; END; EMIT; R0 := #43100004 ++ DPD; EMIT; R0 := #4410E008 ++ INSCOUNTER; EMIT; R0 := #47F0E00A ++ INSCOUNTER; EMIT; R1 := 0; END; END; R1 := R1 SHLL 16; R3 := #30000000; R0 := IDLOC1(R10) SHLL 12 + IDLOC2(R10) OR R1 OR #D2000000; EMIT; SKIP: END ELSE BEGIN IC(R0,TYPE(R10)); IF R0 = #12 THEN BEGIN COMMENT ARRAY - COPY DESCRIPTOR; R0 := #FF; R3 := DPD; FPARCODE; R1 := TYPEINFO(R10)*12S + 3 SHLL 16; R0 := IDLOC1(R10) SHLL 12 + IDLOC2(R10) OR #D2000000 OR R1; R3 := #30000000; EMIT; END; END; R0 := DPD ++ 8; DPD := R0; END; R1 := SAVER1; END; PROCEDURE FTNCALL(R1); COMMENT EMITS CODE TO BUILD FORTRAN LINKAGE (PCL - ARG2); BEGIN LOGICAL SAVER1; INTEGER PLISTADDR, PARMADDR; SAVER1 := R1; R1 := R7 AND #FFFF; R3 := TYPEINFO(R1) SHLA 2; IF ~= THEN BEGIN R0 := NEXTADDR + 3 AND _4; NEXTADDR := R0; PLISTADDR := R0; R0 := R0-4; PARMADDR := R0; R0 := R0-R0; R1 := BLENGTH(R3)/3; R10 := R1; INCRADDR; FOR R10 := STACK21(R8) STEP 12 UNTIL STACK22(R8) DO BEGIN LOGICAL SAVERA; SAVERA := R10; R3 := IDLOC1(R10) SHLL 12 + IDLOC2(R10); R1 := R1-R1; IC(R1,TYPE(R10)); IF R1 = #12 THEN BEGIN R0 := #58300000 OR R3; EMIT; FOR R10 := TYPEINFO(R10) STEP _1 UNTIL 1 DO BEGIN R0 := #5A300004 ++ R3; EMIT; R3 := R3 + 12; END; END ELSE BEGIN IF R1 = #10 THEN BEGIN LOGICAL DPD; DPD := R3; R0 := #FF; FPARCODE; R0 := #91C00000 ++ DPD; EMIT; R0 := #4790E00E ++ INSCOUNTER; EMIT; R1 := R1-R1; IC(R1,SIMPLETYPE(R10)); IF R1=3 OR R1=5 THEN R0 := NEXTADDR + 7 AND _8 ELSE R0 := NEXTADDR + 3 AND _4; NEXTADDR := R0; IF R1 = 7 THEN R1 := SIMTYPEINFO(R10) ELSE BEGIN IC(R1,SITYPELEN(R1)); DECR(R1); END; R10 := R1+1; R3 := #30000000; R0 := R1 SHLL 16 OR NEXTADDR OR #D2000000; EMIT; R3 := NEXTADDR; INCRADDR; END; R0 := #41300000 OR R3; EMIT; END; R0 := PARMADDR + 4; PARMADDR := R0; R0 := R0 OR #50300000; EMIT; R10 := SAVERA; END; R0 := #92800000 OR PARMADDR; EMIT; R0 := #41100000 OR PLISTADDR; EMIT; END; R0 := R7 SHRL 16 AND #FF; CHAINOUT; R0 := R0 OR #58F00000; EMIT; R0 := #05EF0000; EMIT; R0 := CLN; CHAININ; R6 := STACK12(R8); R7 := R6 SHLL 24 OR SIGN; IF R6 ~= 0 THEN BEGIN IF R6 = 6 THEN R7 := R7 OR #00020000; R1 := R6; IF R1 > 5 THEN R1 := 1; CASE R1 OF BEGIN BEGIN R0 := FLAG; R(4) := R0; GENREG; R0 := R0-R0; R(4) := R0; R0 := #18300000; EMIT; END; BEGIN R0 := #C0000000; FLREG; END; BEGIN R0 := #80000000; FLREG; END; BEGIN R0 := #40000000; PRFLREG; END; BEGIN R0 := R0-R0; PRFLREG; END; END; END; R1 := SAVER1; END; SEGMENT PROCEDURE PROCEXIT(R1); COMMENT EMITS PROCEDURE EXIT CODE (PCL - ARG2); BEGIN INTEGER DPD; BYTE TYPESW; LOGICAL SAVER1; SAVER1 := R1; COMMENT FORCE EVALUATION OF FINAL EXPRESSION OR STATEMENT; R1 := R7 SHRL 24; IF R1 = FTN THEN FTNCALL; R1 := STACK12(R8); IF R1 ~= 0 THEN BEGIN COMMENT TYPED PROCEDURE; IF R7 >= 0 THEN TERMBLOCKEXPR; R6 := STACK12(R8); IF R6 = 6 THEN BEGIN EVALUATELOG; R10 := LSTACKM4(R5); IF R10 >= 0 THEN BEGIN R0 := R10 AND #0000F000 SHLL 8; R3 := R0 OR SIGN; LSTACKM4(R5) := R3; R0 := R0 OR #43000000 OR R10; EMIT; END; END ELSE IF R6 = 7 THEN LOADSTRING ELSE LOADREG; END ELSE BEGIN R1 := R7 SHRL 24; IF R1 = FUNCID THEN CALLPROPROCWOPARAM ELSE IF R7 = NULLST THEN BEGIN R0 := #07000000; EMIT; END; R7 := SIGN; END; COMMENT ASSIGN ANY RESULT PARAMETERS; R0 := STACK1(R8); IF R0 < 0 THEN BEGIN COMMENT RESULT PARAMETERS; IF DEBUG THEN BEGIN COMMENT MARK OBJECT CODE; R0 := #07010000; EMIT; END; DUMPALLGENREG; DUMPALLFLREG; R0 := CLN SHLL 12 OR DPDORG; DPD := R0; FOR R10 := STACK21(R8) STEP 12 UNTIL STACK22(R8) DO BEGIN R0 := 0; IC(R0,VR(R10)); IF R0 = 2 OR R0 = 3 THEN BEGIN COMMENT RESULT OR VALUE RESULT; R0 := 0; R3 := DPD; FPARCODE; R0 := 0; R3 := R0; IC(R3,SIMPLETYPE(R10)); IF R3 <= 5 THEN BEGIN COMMENT CONVERSION MAY BE REQUIRED; R0 := DPD; R3 := NEG R3; CALLCONV; END ELSE BEGIN STC(R3,TYPESW); IF R3 ~= 7 THEN BEGIN IC(R1,SITYPELEN(R3)); R1 := R1 AND #FF - 1; END ELSE BEGIN IC(R0,VR(R10)); IF R0 ~= 3 THEN BEGIN COMMENT BLANK RESULT LOCATION; R0 := #43100004 ++ DPD; EMIT; R0 := #4410E008 ++ INSCOUNTER; EMIT; R0 := #47F0E00A ++ INSCOUNTER; EMIT; R0 := #D2003000; R3 := BLANKS SHLL 16; EMIT; END; R1 := SIMTYPEINFO(R10); END; R0 := R1 SHLL 16 OR #D2003000; R3 := IDLOC1(R10) SHLL 12 + IDLOC2(R10) SHLL 16; EMIT; CLI(9,TYPESW); IF = THEN BEGIN R3 := 6; REFSTOR; END; END; END; R0 := DPD ++ 8; DPD := R0; END; END; COMMENT SET-UP RESULT IF TYPED PROCEDURE; R6 := STACK12(R8); IF R6 ~= 0 THEN BEGIN R1 := STACK22(R8) - STACK21(R8); COMMENT 12*(#PAR-1); IF < OR R6 = 6 OR R6 = 7 THEN BEGIN COMMENT RETURN RESULT IN STORAGE; R0 := LSTACKM4(R5); IF R0 < 0 THEN STORERESULT ELSE BEGIN R1 := R0 SHRL 12; IF R1 = CLN AND R6 = 6 THEN R0 := R0 ++ 3; R0 := R0 OR #41300000; EMIT; END; END ELSE BEGIN COMMENT RETURN RESULT IN REGISTER; R3 := LSTACKM4(R5); IF R3 >= 0 THEN BEGIN R0 := FLAG; R(4) := R0; LOADREG; R0 := 0; R(4) := R0; R3 := LSTACKM4(R5); END; IF R6 = 1 OR R6 >= 8 THEN BEGIN R0 := R3 AND #00F00000 SHRL 4 OR #18300000; IF R0 ~= #18330000 THEN EMIT; END ELSE IF R6 <= 3 THEN BEGIN R0 := #88000000; IF R3 ~= #80000000 THEN ASSEMBLE; END ELSE BEGIN COMMENT COMPLEX; IF R6 = 4 THEN R0 := #38000000 ELSE R0 := #28000000; FORCECOMPLEX; END; END; R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; RESETRECORD; END; COMMENT EMIT PROCEDURE CLOSE CODE, BUILD ADDRESS TABLE; PROCSUBREXIT; R0 := INSCOUNTER + 3 AND _4; IF R0 ~= INSCOUNTER THEN BEGIN R0 := 0; EMIT; END; FOR R3 := 4 STEP 4 UNTIL SEGTABIDX DO BEGIN R10 := INSCOUNTER; R0 := 0; WRITENUMBER; R1 := CHAIN(R3); CHAIN(R3) := R10; R10 := R10 OR #E000; WHILE R1 ~= ENDCHAIN DO BEGIN R0 := PROGRAM(R1+2); PROGRAM(R1+2) := R10; R1 := R0; END; END; R1 := CHAIN(0); R0 := 8; CHAIN(0) := R0; R10 := INSCOUNTER; IF R10 <= 4096 THEN R0 := #58E0 ELSE BEGIN R0 := #58F0E00C; PROGRAMM(0) := R0; R0 := #98EF; END; WHILE R1 ~= ENDCHAIN DO BEGIN R10 := PROGRAM(R1); PROGRAM(R1) := R0; R1 := R10 AND #1FFF; END; R1 := SAVER1; END; PROCEDURE BLOCKENTRY(R1); COMMENT EMITS BLOCK ENTRY CODE, COUNTS REFERENCES (BB - ARG1); BEGIN LOGICAL SAVER1; INTEGER NTLIM; SAVER1 := R1; R1 := 0; STACK1(R8) := R1; STACK2(R8) := R1; R10 := R7 AND #FFFF; R3 := NPOINT(R10); R10 := BLENGTH(R10) + R3 - 12; NTLIM := R10; R10 := R10-R10; FOR R3 := R3 STEP 12 UNTIL NTLIM DO BEGIN IC(R1,TYPE(R3)); IF R1 = 0 THEN BEGIN R10 := R10 + 8; IC(R1,SIMPLETYPE(R3)); IF R1 = 9 THEN BEGIN COMMENT SIMPLE REFERENCE VARIABLE; R0 := STACK12(R8) + 1; STACK12(R8) := R0; IF R0 = 1 THEN BEGIN R0 := IDLOC2(R3); STACK11(R8) := R0; END; END; END ELSE IF R1 = 2 THEN BEGIN R10 := R10 + 8; IC(R1,SIMPLETYPE(R3)); IF R1 = 9 THEN BEGIN COMMENT REFERENCE ARRAY; R0 := STACK22(R8) + 1; STACK22(R8) := R0; IF R0 = 1 THEN BEGIN R0 := IDLOC2(R3); STACK21(R8) := R0; END; END; END; END; IF R10 ~= 0 THEN BEGIN R10 := R10 + SEGNTLEN; SEGNTLEN := R10; BLOCKLINK := R7; END; R0 := 0; IF R0 = REFPCOUNT AND R0 ~= STACK12(R8) THEN BEGIN R10 := STACK11(R8); PROGRAM(22) := R10; END; IF R0 ~= STACK22(R8) THEN BEGIN R10 := STACK21(R8); PROGRAM(20) := R10; END; R3 := STACK12(R8); IF R3 ~= 0 THEN BEGIN R10 := INSCOUNTER; IF ~CHECKFLAG THEN BEGIN R0 := #58000000 OR NULLREF; EMIT; R0 := CLN SHLL 12 + STACK11(R8) OR #50000000; EMIT; IF R3 > 1 THEN BEGIN R0 := R3 SHLL 2 - 5 SHLL 16 OR #D2000004; R3 := CLN SHLL 12 + STACK11(R8); R0 := R0 ++ R3; R3 := R3 SHLL 16; EMIT; END; END; R0 := STACK12(R8) + REFPCOUNT SHLL 4 OR CLN SHLL 12 OR REFVAR ++ #92000003; EMIT; IF R10 = PPMARK THEN BEGIN R0 := INSCOUNTER; PPMARK := R0; END; END; R1 := SAVER1; END; PROCEDURE GOTOO(R1); COMMENT EMITS CODE FOR GO TO (GOTO - ARG2); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := TYPEINFO(R7); IF R3 ~= CLN THEN BEGIN R0 := R3 SHLL 20 OR #50000000 OR MP; EMIT; R0 := IDLOC1(R7); IF R0 ~= LOGSEG THEN BEGIN COMMENT OUT OF PROCEDURE; R0 := R3 SHLL 12 OR PB OR #98EF0000; EMIT; END; END; R0 := IDLOC2(R7) OR #47F0E000; EMIT; R7 := SIGN; R1 := SAVER1; END; PROCEDURE PROCCALL(R1); COMMENT SETS UP STACK FOR PROCEDURE CALL (AP, & AP) - ARG1); BEGIN LOGICAL SAVER1; SAVER1 := R1; MARKRECORDS; DUMPALLGENREG; DUMPALLFLREG; STACK11(R8) := R7; R0 := R0-R0; STACK12(R8) := R0; R0 := DSP; STACK21(R8) := R0; R0 := DPDORG; DSP := R0; R0 := NEXTADDR; STACK22(R8) := R0; R0 := CLN-1; CLN := R0; COMMENT STACK FORMAT STACK11: NT POINTER, STACK12: PARAMETER COUNT, STACK21: DSP, STACK22: NEXTADDR (PUSH DOWN); R1 := LOGPOINTER + 4; LOGPOINTER := R1; R0 := INSCOUNTER; LOGSTACK(R1) := R0; R0 := #47F00000; EMIT; COMMENT BRANCH AROUND ANY SUBRS; R1 := SAVER1; END; PROCEDURE PROCRETURN(R1); COMMENT COMPLETES CODE FOR PROCEDURE CALL (AP) - ARG2); BEGIN LOGICAL SAVER1; INTEGER DPD, PROCCLASS; COMMENT ENTRY OF LOGSTACK ENTRY FOR EACH ACTUAL PARAMETER; LOGICAL SAPD SYN LOGSTACK(_4); INTEGER ADDR SYN LOGSTACK(0); BYTE PQX SYN SAPD(0), NDIM SYN SAPD(1), LEN SYN SAPD(2), SITYPE SYN SAPD(3); COMMENT RESTORE VARIABLES AND FIX BRANCH AROUND SUBRS; SAVER1 := R1; R0 := STACK21(R8); DSP := R0; R0 := STACK22(R8) AND #FFFF; NEXTADDR := R0; R0 := DPDORG OR #5000; DPD := R0; R1 := STACK12(R8) SHLA 3; R10 := LOGPOINTER - R1; R0 := INSCOUNTER - 4; IF R0 = LOGSTACK(R10) THEN INSCOUNTER := R0 ELSE BEGIN R0 := INSCOUNTER OR #E000; R1 := LOGSTACK(R10); PROGRAM(R1+2) := R0; END; R0 := CLN + 1; CLN := R0; R0 := R0 SHLL 16 OR #18200000; EMIT; R0 := CLN SHLL 12 OR FP OR #58500000; EMIT; COMMENT BUILD DPDS FROM LOGSTACK ENTRIES (2 WORDS/PARAMETER); R7 := STACK11(R8); COMMENT NT POINTER FOR PROCEDURE ID; R0 := R0-R0; IC(R0,TYPE(R7)); IF R0 = #13 THEN R0 := _1 COMMENT NO FPAR INFO; ELSE BEGIN COMMENT NOT FORMAL, MATCH APARS AGAINST FPAR INFO; R0 := IDLOC1(R7) AND #8000 SHRL 15; R7 := TYPEINFO(R7) SHLA 2; R7 := NPOINT(R7); END; PROCCLASS := R0; COMMENT -1=NO INFO, 0=~FORMAL, 1=FORMAL; FOR R10 := R10+8 STEP 8 UNTIL LOGPOINTER DO BEGIN R3 := R3-R3; IC(R3,PQX(R10)); IF R3 = #F0 THEN BEGIN R0 := #98010000 OR ADDR(R10); EMIT; R0 := #90010000 OR DPD; EMIT; END ELSE BEGIN R0 := #41100000 OR ADDR(R10); EMIT; R0 := R3 AND #80; COMMENT P-BIT (ON FOR SUBR); IF ~= OR DEBUG THEN R0 := #90120000 ELSE R0 := #50100000; R0 := R0 OR DPD; EMIT; IF R3 ~= 0 THEN BEGIN R0 := R3 SHLL 16 OR #92000000 OR DPD; EMIT; END; END; R1 := PROCCLASS; IF R1 < 0 THEN BEGIN R1 := NEG R1; R0 := #7; COMMENT UNIVERSAL MASK; END ELSE BEGIN R0 := R0-R0; IC(R0,VR(R7)); IF R0=3 THEN R0 := #4; R7 := R7 + 12; END; COMMENT INDEX INTO TABLE OF CONVERSION CODE INFO MASKS, SI TYPE(COLUMN) * PROCCLASS(ROW) * PARAM SPEC(BIT); R3 := R3 AND #C0; COMMENT FOR RESULT, P BIT = Q BIT; IF R3 = #80 OR R3 = #40 THEN R0 := R0 AND #1; IC(R3,NDIM(R10)); IF R3 ~= 0 THEN R0 := 0; IC(R3,SITYPE(R10)); R1 := R1*10S + R3; IC(R1,SUBRCONV(R1)); R0 := R0 AND R1; IF ~= THEN BEGIN COMMENT CONVERSION SUBR POSSIBLE, TYPE INFO TO DPD; IF R3 = 7 THEN IC(R3,LEN(R10)); R0 := R3 SHLL 16 OR DPD ++ #92000004; EMIT; END; R0 := DPD + 8; DPD := R0; END; COMMENT CALL PROCEDURE; R7 := STACK11(R8); R3 := STACK12(R8); PROCCALLCODE; COMMENT RESET POINTERS, BUILD SAPDS IF NECESSARY; R1 := PROCCLASS; IF R1 < 0 THEN BEGIN R3 := STACK12(R8) SHLA 3; R0 := R3 SHRA 1 + INSCOUNTER ++ #47F0E004; EMIT; FOR R10 := LOGPOINTER-R3+8 STEP 8 UNTIL LOGPOINTER DO BEGIN R0 := SAPD(R10) AND #FFFFFF OR SIGN; EMIT; END; END; R10 := STACK12(R8) SHLA 3; R0 := LOGPOINTER - R10 - 4; LOGPOINTER := R0; R10 := R10-R10; COMMENT PROCESS RESULT OF FUNCTION PROCEDURE; IC(R10,SIMPLETYPE(R7)); R7 := R10 SHLL 24 OR SIGN; IF R10 ~= 0 THEN BEGIN COMMENT TYPED PROCEDURE WITH PARAMS, MARK REGISTER; IF R10 = 1 OR R10 > 5 THEN BEGIN R0 := FLAG; R(4) := R0; GENREG; R0 := 0; R(4) := R0; END ELSE BEGIN R0 := 5 - R10 SHLL 30; IF R10 < 4 THEN FLREG ELSE PRFLREG; END; IF R10 = 6 OR R10 = 7 THEN BEGIN COMMENT STRING OR LOGICAL, RESULT IN MEMORY; R0 := LSTACKM4(R5) AND #00F00000 SHRL 8; LSTACKM4(R5) := R0; IF R10 = 6 THEN R1 := 1 ELSE BEGIN R3 := STACK11(R8); R1 := SIMTYPEINFO(R3); END; R1 := R1 SHLL 16; R7 := R7 OR R1; END ELSE IF R10 = 9 THEN SETRECORD; CONVERTRESULT; END; R1 := SAVER1; END; LOGICAL SAVER1; SAVER1 := R1; CASE R3 OF BEGIN PROCENTRY; PROCEXIT; BLOCKENTRY; GOTOO; PROCCALL; PROCRETURN; END; R1 := SAVER1; END; SEGMENT PROCEDURE ACPARAM(R1); COMMENT CONSTRUCTS SAPD, IMPLICIT SUBR (AP, & AP) - ARG2); BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := R7 SHRL 24; IF R1 = RCCLID THEN RECORDALLOCATE; IF R7 = NULLST THEN R7 := SIGN; CONVERT; IF R7 >= 0 THEN BEGIN COMMENT PARAMETER IS ID OR CONSTANT; R10 := LOGPOINTER - 4; LOGPOINTER := R10; R1 := LOGSTACK(R10) AND #1FFF; INSCOUNTER := R1; R3 := CHAIN(0); WHILE R3 >= R1 DO R3 := PROGRAM(R3) AND #1FFF; CHAIN(0) := R3; GETTYPE; IF R3 = 7 THEN BEGIN GETLENGTH; R3 := R3 SHLL 8 OR #07; END; LOGSTACK(R10-4) := R3; R1 := R7 SHRL 24; R3 := R3-R3; IF R1 = ID OR R1 = FUNCID THEN IC(R3,TYPE(R7)); IF R3 >= #10 THEN BEGIN COMMENT FORMAL PROCEDURE OR NAME PARAMETER; R0 := #F0; STC(R0,LOGSTACK(R10-4)); R3 := IDLOC1(R7) SHLL 12 + IDLOC2(R7); LOGSTACK(R10) := R3; END ELSE IF R1 = FUNCID THEN BEGIN COMMENT ACTUAL PROCEDURE; R1 := TYPEINFO(R7); IF R1 = 0 THEN R0 := #80 ELSE BEGIN R0 := #47F00002 ++ PARAMERR; EMIT; R0 := #A0; END; STC(R0,LOGSTACK(R10-4)); R0 := 4; CHAININ; R0 := IDLOC2(R7) AND #FF; CHAINOUT; R0 := R0 OR #58300000; EMIT; R0 := #18E30000; EMIT; COMMENT SET R4 TO CORRECT EP (STACK21 = STACKED DSP); R0 := R0-R0; IC(R0,HIERARCHY(R7)); R0 := R0 AND #F; R0 := R0-CLN SHLA 2 + STACK21(R8) OR #58404000; EMIT; R0 := #07FE0000; EMIT; END ELSE BEGIN IF R1 = ARRAYID THEN BEGIN R1 := TYPEINFO(R7); LOGSTACK1(R10-4) := R1; END ELSE BEGIN IF R1 = ID THEN R0 := #00 ELSE R0 := #40; STC(R0,LOGSTACK(R10-4)); END; GETADDRESS; LOGSTACK(R10) := R3; END; END ELSE BEGIN COMMENT NON-TERMINAL; R6 := R7 SHRL 24 AND #7F; IF = THEN R10 := #80000000 COMMENT STATEMENT; ELSE IF SUBARFLAG THEN BEGIN COMMENT SUBARRAY; RESET(SUBARFLAG); R10 := LSTACKM4(R5) AND #FFFFFF OR #80000000; R3 := LSTACKM4(R5) AND #0F000000 SHRL 12; R6 := 1; RELEASE; R5 := R5 - 4; END ELSE BEGIN COMMENT EXPRESSION; IF R6 = 6 THEN EVALUATELOG; R0 := LSTACKM4(R5); IF R0 < 0 THEN BEGIN COMMENT RESULT IN REGISTER GIVEN BY LSTACK ENTRY; R10 := #80000000 OR R6; STORERESULT; END ELSE BEGIN COMMENT COMPUTED ADDRESS (FIELD, ARRAY ELEMENT), ALSO, STRING OR LOGICAL PROCEDURE WITH PARAMETERS; R1 := SAVEL - 4; IC(R0,TREE(R1)); R0 := R0 AND #7F; IF R0 = INDX OR R0 = REFX OR R0 = SUBSTR THEN R10 := #C0000000 ELSE R10 := #80000000; IF R6 = 7 THEN R6 := R7 AND #00FF0000 SHRL 8 OR #07; R10 := R10 OR R6; R0 := LSTACKM4(R5); R1 := R0 AND #FFF; IF ~= THEN BEGIN R0 := R0 OR #41300000; EMIT; END ELSE BEGIN R0 := R0 AND #F000 SHLL 4 OR #18300000; IF R0 ~= #18330000 THEN EMIT; END; END; R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; END; R1 := LOGPOINTER - 4; LOGSTACK(R1-4) := R10; RESETRECORD; PROCSUBREXIT; END; R7 := SIGN; R1 := SAVER1; END; PROCEDURE INDICATEBRANCH(R1); BEGIN R0 := R0 SHLL 16; R3 := LOGPOINTER + 4; LOGPOINTER := R3; LOGSTACK(R3) := R0; END; PROCEDURE LOGCOMPARE(R1); COMMENT EMIT CLI INSTRUCTION FOR LOGICAL EXPRESSIONS; BEGIN LOGICAL SAVER1; SAVER1 := R1; GETADDRESS; R0 := CLII OR #00010000 OR R3; EMIT; R1 := SAVER1; END; PROCEDURE INITIALIZELINK(R1); BEGIN R0 := INSCOUNTER - 4; R3 := LOGPOINTER + 4; LOGPOINTER := R3; LOGSTACK(R3) := R0; END; PROCEDURE IFJARG2 (R1); BEGIN COMMENT IFJ; LOGICAL SAVER1; SAVER1 := R1; IF R7 >= 0 THEN BEGIN LOGCOMPARE; R0 := 7; LOGBRANCH; INITIALIZELINK; END ELSE BEGIN R3 := R7 SHLL 8 SHRL 24; IF R3 = 1 THEN BEGIN R0 := LSTACKM4(R5) OR CLII OR #00010000; EMIT; R3 := LSTACKM4(R5); RELEASE; R5 := R5 -4; R0 := 7; LOGBRANCH; INITIALIZELINK; END ELSE BEGIN R3 := LOGPOINTER; IC(R10,LOGSTACK(R3)); R10 := R10 AND #FF; CASE R10 OF BEGIN BEGIN R0 := LOGSTACK(R3) SHRL 16 AND #FF; R0 := R0 XOR #F; LOGBRANCH; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER - 4; LOGPOINTER := R3; LINKBRANCHES; END; BEGIN R0 := LOGSTACK(R3) SHRL 16 AND #FF; LOGBRANCH; R3 := LOGPOINTER - 4; LOGPOINTER := R3; LINKBRANCHES; R3 := INSCOUNTER; FIXUP; END; END; END; END; R7 := #86000000; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R0 := 0; LOGSTACK(R3) := R0; R1 := SAVER1; END; PROCEDURE MERGE(R1); COMMENT JOIN LINKS OF THE TWO TOP EMEMENTS OF LOGSTACK; BEGIN R3 := LOGPOINTER - 8; R0 := LOGSTACK(R3); IF R0 = 0 THEN BEGIN R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; R3 := R3 + 4; LOGPOINTER := R3; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; GOTO XIT; END; R3 := R0; WHILE R3 ~= 0 DO BEGIN R10 := R3; R3 := PROGRAM(R3+2) AND #1FFF; END; R3 := LOGPOINTER-4; R0 := LOGSTACK(R3); PROGRAM(R10+2) := R0; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; LOGPOINTER := R3; XIT:END; PROCEDURE CORRECTREG(R1); COMMENT SETS PROPER RESULT REGISTER FOR CASE AND IF EXPR; BEGIN LOGICAL SAVER1, SAVER6, TEMP; SAVER1 := R1; SAVER6 := R6; R0 := LSTACKM4(R5); IF R3 > 5 THEN R3 := 1; R6 := R3; CASE R3 OF BEGIN IF R0 ~= #80200000 AND R0 ~= #2000 THEN 1 BEGIN TEMP := R0; R3 := R0; RELEASE; R5 := R5-4; GENREG; COMMENT GENREG MUST OBTAIN R2 HERE; R0 := TEMP; IF R0 < 0 THEN R0 := R0 XOR SIGN SHRL 4 OR #18200000 ELSE BEGIN R1 := #2000; LSTACKM4(R5) := R1; R0 := R0 AND #FFF; IF ~= THEN R0 := #41200000 OR TEMP ELSE R0 := TEMP SHLL 4 OR #18200000; END; EMIT; END; IF R0 ~= #80000000 THEN 2 BEGIN R0 := R0 XOR SIGN SHRL 4 OR #38000000; EMIT; R3 := LSTACKM4(R5); RELEASE; R5 := R5-4; R0 := #C0000000; FLREG; COMMENT FLREG MUST OBTAIN F0; END; IF R0 ~= #80000000 THEN 3 BEGIN R0 := R0 XOR SIGN SHRL 4 OR #28000000; EMIT; R3 := LSTACKM4(R5); RELEASE; R5 := R5-4; R0 := #80000000; FLREG; COMMENT FLREG MUST OBTAIN F01; END; BEGIN R0 := #38000000; FORCECOMPLEX; R3 := LSTACKM4(R5); 4 R6 := 4; RELEASE; R5 := R5-4; R0 := #40000000; PRFLREG; END; BEGIN R0 := #28000000; FORCECOMPLEX; R3 := LSTACKM4(R5); 5 R6 := 5; RELEASE; R5 := R5-4; R0 := #00000000; PRFLREG; END; END; R6 := SAVER6; R1 := SAVER1; END; PROCEDURE FILLCASETABLE(R1); COMMENT FILL TABLE BACKWARDS. START WITH ADDRESS IN TOP LOGSTACK POSITION. LAST ONE IN FIRSTCASE1(2). LENGTH OF TABLE IN FIRSTCASE1; BEGIN LOGICAL SAVER1; SAVER1 := R1; R10 := FIRSTCASE1 SHLL 2; R10 := R10 + INSCOUNTER; INSCOUNTER := R10; R10 := R10 - 4; COMMENT RA HAS ADDRESS OF LAST CASETABLE ENTRY; R3 := LOGPOINTER; R3 := LOGSTACK(R3); FOR R1 := 2 STEP 1 UNTIL FIRSTCASE1 DO BEGIN R3 := PROGRAM(R3+2); R0 := R3 ++ #47F0E004; PROGRAM(R10+2) := R0; R0 := R0 SHRL 16; PROGRAM(R10) := R0; R3 := R3 AND #1FFF; R10 := R10 - 4; END; R0 := FIRSTCASE1( 2)++ #47F0E004; PROGRAM(R10+2) := R0; R0 := R0 SHRL 16; PROGRAM(R10) := R0; R1 := SAVER1; END; PROCEDURE ANDORARG1(R1); BEGIN COMMENT IF AND, ANDFLAG IS ON, IF OR, ANDFLAG IS OFF; LOGICAL SAVER1; SAVER1 := R1; IF R7 >= 0 THEN BEGIN LOGCOMPARE; TEST(ANDFLAG); IF = THEN R0 := 7 ELSE R0 := 8; R3 := LOGPOINTER+4; LOGPOINTER := R3; R10 := 0; LOGSTACK(R3) := R10; LOGBRANCH; INITIALIZELINK; END ELSE BEGIN R3 := R7 SHLL 8 SHRL 24; IF R3 = 1 THEN BEGIN R0 := LSTACKM4(R5) OR CLII OR #00010000; EMIT; R3 := LSTACKM4(R5); R5 := R5 - 4; RELEASE; TEST(ANDFLAG); IF = THEN R0 := 7 ELSE R0 := 8; R3 := LOGPOINTER+4; LOGPOINTER := R3; R10 := 0; LOGSTACK(R3) := R10; LOGBRANCH; INITIALIZELINK; END ELSE BEGIN R3 := LOGPOINTER; R10 := R3 - 4; LOGPOINTER := R10; IC(R10,LOGSTACK(R3)); R10 := R10 AND #FF; TEST(ANDFLAG); IF = THEN R10 :=R10 XOR #3; CASE R10 OF BEGIN BEGIN R0 := 0; IC(R0,LOGSTACK(R3+1)); LOGBRANCH; LINKBRANCHES; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER+4; LOGPOINTER := R3; R0 := LOGSTACK(R3-4); LOGSTACK(R3) := R0; R0 := 0; LOGSTACK(R3-4) := R0; END; BEGIN R0 := LOGSTACK(R3) SHRL 16 AND #FF XOR #F; LOGBRANCH; R0 := LOGPOINTER+4; LOGPOINTER := R0; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER; R0 := LOGSTACK(R3-4); LOGSTACK(R3) := R0; R0 := 0; LOGSTACK(R3-4) :=R0; LINKBRANCHES; END; END; END; END; R6 := R6 OR #06000000; R1 := SAVER1; END; PROCEDURE MERGE24(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := LOGPOINTER - 12; R0 := LOGSTACK(R3); R1 := LOGSTACK(R3+4); LOGSTACK(R3) := R1; LOGSTACK(R3+4) := R0; MERGE; R0 := LOGPOINTER-4; LOGPOINTER := R0; MERGE; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; R1 := SAVER1; END; PROCEDURE MERGE34(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := LOGPOINTER - 4; LOGPOINTER := R3; MERGE; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; R3 := LOGPOINTER-12; R0 := LOGSTACK(R3); R1 := LOGSTACK(R3+4); LOGSTACK(R3) := R1; LOGSTACK(R3+4) := R0; MERGE; R1 := SAVER1; END; SEGMENT PROCEDURE UNCONDJUMP(R1); BEGIN LOGICAL SAVER1, LNGTH; SAVER1 := R1; IF R7 = NULLST THEN R7 := SIGN; CONVERT; IF R7 >= 0 THEN BEGIN GETTYPE; IF R3 = 0 THEN BEGIN R1 := R7 SHRL 24; IF R1 = FUNCID THEN CALLPROPROCWOPARAM; GOTO STMNT; END; IF R3 = 7 THEN BEGIN GETLENGTH; R3 := R3 SHLL 16; LNGTH := R3; GETADDRESS; R10 := R3; GENREG; R0 := R0 OR R10 OR #41000000; EMIT; R3 := 7; R0 := LSTACKM4(R5) SHRL 8 AND #F000; LSTACKM4(R5) := R0; END ELSE IF R3 ~= 6 THEN LOADREG; END ELSE BEGIN R3 := R7 SHRL 24 AND #7F; IF = THEN GOTO STMNT; IF R3 = 7 THEN BEGIN R1 := R7 AND #00FF0000; LNGTH := R1; END ELSE IF R3 ~= 6 THEN LOADREG; END; IF R3 = 6 THEN BEGIN LOGICAL SAVE; SET(LOGFLAG); SET(ANDFLAG); ANDORARG1; R3 := LOGPOINTER; TEST(UJIFEXP); IF = THEN BEGIN R0 := LOGSTACK(R3-12); R10 := LOGSTACK(R3-4); LOGSTACK(R3-12) := R10; LOGSTACK(R3-4) := R0; R0 := LOGSTACK(R3-8); R10 := LOGSTACK(R3); LOGSTACK(R3-8) := R10; LOGSTACK(R3) := R0; GOTO STMNT; END; R0 := LOGSTACK(R3-8); R10 := LOGSTACK(R3-4); LOGSTACK(R3-8):= R10; R10 := LOGSTACK(R3); LOGSTACK(R3-4) := R10; LOGSTACK(R3) :=R0; R7 := #86000000; R6 := R6 OR R7; MERGE24; TEST(IFEXP); IF ~= THEN GOTO STMNT; R3:=LOGPOINTER-4; LOGPOINTER:=R3; R0 :=LOGSTACK(R3+4); SAVE := R0; R0 := #0200; INDICATEBRANCH; R0 := SAVE; R3 := LOGPOINTER+4; LOGPOINTER := R3; LOGSTACK(R3) := R0; GOTO XIT; END ELSE BEGIN LOGICAL SAVER6; SAVER6 := R6; R6 := R3; R7 := R3 SHLL 24 OR SIGN; IF R3 = 7 THEN R7:=R7 OR LNGTH; IF R3 = 9 THEN BEGIN R5 := R5 - 4; RESETRECORD; R5 := R5 + 4; END; CORRECTREG; TEST(IFEXP); IF ~= THEN BEGIN R0 := #F; LOGBRANCH; LINKBRANCHES; TEST(CLFLAG); IF ~= THEN BEGIN R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; END; END; R6 := SAVER6 OR R7; END; GOTO XIT; STMNT: R0 := #F; LOGBRANCH; LINKBRANCHES; R7 := SIGN; XIT: R1 := SAVER1; END; SEGMENT PROCEDURE STFUNCTION (R1); BEGIN COMMENT GENERATES CODE TO LOAD R3 OR F01/F23 WITH VALUE, RETURNS (LENGTH, TYPE) IN R3; INTEGER SR1, SAVEADD, SAVETYPE; SR1 := R1; IF R7>= 0 THEN BEGIN COMMENT ID; GETTYPE; SAVETYPE := R3; R6 := R3; IF R3 ~= 7 THEN GETADDRESS ELSE BEGIN LOADSTRING; R3 := LSTACKM4(R5); RELEASE; R5 := R5-4; END; SAVEADD := R3; DUMPALLGENREG; DUMPALLFLREG; R3 := SAVETYPE; R1 := R3; IF R3 = 7 THEN R3 := R7 AND #00FF0000 OR 7; SAVETYPE := R3; R3 := SAVEADD; CASE R1 OF BEGIN R0 := #58300000; COMMENT INTEGER; R0 := #78000000; COMMENT REAL; R0 := #68000000; COMMENT LONG REAL; BEGIN COMMENT COMPLEX; R0 := #78000000 OR R3; EMIT; R3 := R3 + 4; R0 := #78200000; END; BEGIN COMMENT LONG CCOMPLEX; R0 := #68000000 OR R3; EMIT; R3 := R3 + 8; R0 := #68200000 ; END; R0 := #43300000; COMMENT LOGICAL; R0 := #41300000; COMMENT STRING; R0 := #58300000; COMMENT BITS; BEGIN COMMENT REFERENCE; IF R3 > 0 THEN R0 := #58300000 ELSE BEGIN R3 := R3 SHLL 1 SHRL 5; R0 := #18300000; RESETRECORD; END; END; END; R0 := R0 OR R3; EMIT; END ELSE BEGIN COMMENT IT IS A ; R6 := R7 SHLL 1 SHRL 25; IF R6 = 4 OR R6 = 5 THEN LOADREG ELSE IF R6 = 6 THEN EVALUATELOG ELSE IF R6 = 7 THEN LOADSTRING; R3 := LSTACKM4(R5); RELEASE; R5 := R5-4; DUMPALLGENREG; DUMPALLFLREG; R1 := R6; IF R1 >= 8 THEN R1 := 1; CASE R1 OF BEGIN IF R3 ~= #80300000 THEN BEGIN COMMENT INTEGER, BITS, REFERENCE; R0 := #08300000; ASSEMBLE; END; IF R3 ~= #80000000 THEN BEGIN COMMENT REAL; R0 := #08000000; ASSEMBLE; END; IF R3 ~= #80000000 THEN BEGIN COMMENT LONG REAL; R0 := #08000000; ASSEMBLE; END; IF R3 ~= #80020000 THEN BEGIN COMMENT COMPLEX; R5 := R5 + 4; R0 := #38000000; FORCECOMPLEX; R5 := R5-4; END; IF R3 ~= #80020000 THEN BEGIN COMMENT LONG COMPLEX; R5 := R5 + 4; R0 := #28000000; FORCECOMPLEX; R5 := R5-4; END; BEGIN COMMENT LOGICAL; IF R3 > 0 THEN R0 := #43300000 OR R3 ELSE BEGIN R3 := R3 SHLL 1 SHRL 5; R0 := #18300000 OR R3; END; EMIT; END; BEGIN COMMENT STRING; R0 := #41300000 OR R3; EMIT; R0 := R7 AND #00FF0000 OR R6; SAVETYPE := R0; END; END; IF R6 ~= 7 THEN SAVETYPE := R6; END; R3 := SAVETYPE; RESET(R3FLAG); R1 := SR1; END; SEGMENT PROCEDURE STANDARDFUNCTION(R1); IF R7 = NULLST THEN R7 := SIGN ELSE BEGIN LOGICAL SAVER1; LOGICAL SAVEADD, TEMP; BYTE RLF, LONGFLAG, TERMFLAG; PROCEDURE IMAGLONGIMAG(R1); BEGIN ARRAY 2 LOGICAL TEMP; STM(R0,R1,TEMP); CONVERT; LOADREG; R0 := TEMP; FLREG; R6 := 3; R3 := R0 OR SIGN; R0 := R0 OR S; ASSEMBLE; R1 := LSTACKM8(R5) AND MASK5 SHRL 4 OR LSTACKM4(R5); LSTACKM8(R5) := R1; R5 := R5 - 4; R4 := R4 - 4; R1 := FSTACKM4(R4) XOR SIGN; FSTACKM4(R4) := R1; R1 := TEMP(4); END; PROCEDURE REALINT(R1); BEGIN LOGICAL SR0,SR1; SR0 := R0; SR1 := R1; CONVERT; IF R7 >= 0 THEN GETADDRESS ELSE BEGIN R3 := LSTACKM4(R5); IF R3 < 0 THEN BEGIN R6 := 2; RELEASE; R5 := R5 - 4; R0 := R3 XOR SIGN; R3 := NEXTADDR + 3 AND SMASK; NEXTADDR := R3; R10 := 4; INCRADDR; R0 := R0 OR #70000000 OR R3; EMIT; END ELSE BEGIN R6 := 1; RELEASE; R5 := R5 - 4; END; END; TEMP := R3; R3 := 0; IF R3 ~= R(6) THEN DUMPALLGENREG; R3:=#FFFFFFFF; IF R3 = R(4) THEN GENREG ELSE BEGIN R( 4):= R3; GENREG; R3 := 0; R( 4):= R3; END; R0 := TEMP; R3 := SR0; IF R3 = 4 THEN BEGIN R0 := R0 OR #58300000; EMIT; R0 := @EXPONENT; END ELSE BEGIN R0 := R0 OR #58000000; EMIT; R0 := @REALINTEGER; END; R0 := NEG R0; R3 := R3 SHLL 16; EMITCALL; R7 := #81000000; R1 := SR1; END; PROCEDURE REALPART(R1); BEGIN COMMENT R0 IS INPUT AS FOR FLREG; LOGICAL SR1; SR1 := R1; IF R7 > 0 THEN BEGIN GETADDRESS; SAVEADD := R3; TEST(RLF); IF = THEN R3 := 0 ELSE IF R7 < 0 THEN R3 := R7 XOR SIGN SHRL 24 ELSE GETTYPE; IF R3 = 5 THEN R3 := 8; R3 := R3 + SAVEADD; SAVEADD := R3; FLREG; R0 := R0 OR #08000000; R3 := SAVEADD; ASSEMBLE; END ELSE BEGIN R3 := LSTACKM4(R5); IF R3 < 0 THEN BEGIN R0 := FSTACK(R4-4) XOR SIGN; FSTACK(R4-4) := R0; R4 := R4 + 4; R0 := R3 AND MASK5 OR SIGN; LSTACKM4(R5) := R0; R3 := R3 AND MASK4 SHLL 4 OR SIGN; RELEASE; END; END; R1 := SR1; END; SAVER1 := R1; R1 := R1-R1; IC(R1,STFNSWITCH(R3)); CASE R1 OF BEGIN BEGIN COMMENT WRITE, WRITEON, WRITECARD, SYSACT; IF R3 = 37 THEN R3 := 1 ELSE IF R3 = 6 THEN R3 := 2 ELSE R3 := R3-R3; R3 := R3 SHLL 24; TEMP := R3; CONVERT; STFUNCTION; R3 := R3 OR TEMP OR #B0000000; R0 := @WRITEEDIT; R0 := NEG R0; EMITCALL; R7 := SIGN; END; BEGIN COMMENT READ, READON, READCARD; R0 := R0-R0; TEMP := R0; IF R3 = 5 THEN MVI(#01,TEMP(0)); IF R7 < 0 THEN BEGIN R0 := R7 SHRL 24 AND #7F; STC(R0,TEMP(3)); IF R0 = 7 THEN BEGIN R0 := R7 SHRL 16; STC(R0,TEMP(1)); END; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; END ELSE BEGIN GETTYPE; STC(R3,TEMP(3)); IF R3 = 7 THEN BEGIN GETLENGTH; STC(R3,TEMP(1)); END; GETADDRESS; END; SAVEADD := R3; CLI(#07,TEMP(3)); IF = THEN BEGIN R0 := #41000000 OR NEXTADDR; EMIT; END; R3 := TEMP OR #B0000000; R0 := @READIN; R0 := NEG R0; EMITCALL; R6 := R6-R6; IC(R6,TEMP(3)); IF R6 = 6 THEN BEGIN R0 := #42000000 OR SAVEADD; EMIT; END ELSE IF R6 = 7 THEN BEGIN R10 := R10-R10; IC(R10,TEMP(1)); R0 := R10 SHLL 16 OR SAVEADD OR #D2000000; R3 := NEXTADDR SHLL 16; EMIT; R10 := R10+1; INCRADDR; END ELSE BEGIN R3 := SAVEADD; IF R6 = 4 OR R6 = 5 THEN R0 := #00020000 ELSE R0 := 0; ASSEMBLE; END; R7 := SIGN; END; BEGIN COMMENT ODD; LOADREG; R1 := CPTBASE; R0 := CONSPTTAB(R1) AND MASK OR LSTACKM4(R5) XOR SIGN OR #5400E000; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R0 := 0; R3 := LOGPOINTER + 8; R5 := R5 - 4; LOGPOINTER := R3; LOGSTACK(R3-4) := R0; LOGSTACK(R3) := R0; R0 := #0107; INDICATEBRANCH; R7 := #86000000; END; BEGIN COMMENT BITSTRING; LOADREG; R7 := #88000000; END; BEGIN COMMENT NUMBER; LOADREG; R7 := #81000000; END; BEGIN COMMENT DECODE; LOADSTRING; R3 := LSTACKM4(R5); SAVEADD := R3; R6 := 1; RELEASE; R5 := R5 - 4; GENREG; R3 := R0 OR SIGN; R0 := R0 OR S; ASSEMBLE; R0 := LSTACKM4(R5) AND #00F00000 OR SAVEADD OR #43000000; EMIT; R7 := #81000000; END; BEGIN COMMENT CODE; LOGICAL SAVER3; LOADREG; R3 := LSTACKM4(R5); IF R3 >= 0 THEN BEGIN R6 := 1; RELEASE; END ELSE BEGIN R3 := R3 XOR SIGN; R0 := R3 OR #50000000 OR NEXTADDR + 3 AND SMASK; R10 := R0 AND MASK; NEXTADDR:=R10; EMIT; R3:=LSTACKM4(R5); R6:=1; RELEASE; R3 := NEXTADDR; R10 := 4; INCRADDR; R5 := R5 - 4; END; SAVER3 := R3; GENREG; R3 := R0 SHRL 8; LSTACKM4(R5) := R3; R0 := R0 OR LAA OR SAVER3 ++ 3; EMIT; R7 := #87000000; END; BEGIN COMMENT TRUNCATE; R0 := 1; REALINT; END; BEGIN COMMENT ROUND; R0 := 2; REALINT; END; BEGIN COMMENT ENTIER; R0 := 3; REALINT; END; BEGIN COMMENT EXPONENT; R0 := 4; REALINT; END; BEGIN COMMENT ROUNDED; LOADREG; R7 := LSTACKM4(R5) AND MASK5; R10 := NEXTADDR + 7 AND _8; R7 := R7 OR R10; R0 := R7 OR #60000000; EMIT; R10 := R10 + 1; R0 := #D7020000 OR R10; R3 := R10 SHLL 16; EMIT; R0 := R7 OR #6A000000; EMIT; R10 := R10 + 7; NEXTADDR := R10; R7 := #82000000; END; BEGIN COMMENT REALPART; SET(RLF); CONVERT; R0 := #C0000000; R6 := 2; REALPART; R7 := #82000000; END; BEGIN COMMENT IMAGPART; CONVERT; IF R7 < 0 THEN BEGIN R0 := LSTACKM4(R5); IF R0 < 0 THEN BEGIN R3 := R0 AND MASK4 SHLL 4; R0 := R0 AND MASK5 SHRL 4; R0 := R0 OR R3 OR SIGN; END ELSE R0 := R0 + 4; LSTACKM4(R5) := R0; END; RESET(RLF); R0 := #C0000000; R6 := 2; REALPART; R7 := #82000000; END; BEGIN COMMENT LONGREALPART; SET(RLF); CONVERT; R0 := #80000000; R6 := 3; REALPART; R7 := #83000000; END; BEGIN COMMENT LONGIMAGPART; CONVERT; IF R7 < 0 THEN BEGIN R0 := LSTACKM4(R5); IF R0 < 0 THEN BEGIN R3 := R0 AND MASK4 SHLL 4; R0 := R0 AND MASK5 SHRL 4; R0 := R0 OR R3 OR SIGN; END ELSE R0 := R0 + 8; LSTACKM4(R5) := R0; END; RESET(RLF); R0 := #80000000; R6 := 3; REALPART; R7 := #83000000; END; BEGIN COMMENT IMAG; R0 := #C0000000; IMAGLONGIMAG; R7 := #84000000; END; BEGIN COMMENT LONGIMAG; R0 := SIGN; IMAGLONGIMAG; R7 := #85000000; END; BEGIN TEMP := R3; CONVERT; STFUNCTION; R10 := TEMP; IF R10 <= 29 THEN BEGIN R3 := R10 - 22 SHLL 16; R0 := @SANALFN; R0 := NEG R0; EMITCALL; R0 := #C0000000; FLREG; R7 := #82000000; END ELSE BEGIN R3 := R10 - 29 SHLL 16; R0 := @LANALFN; R0 := NEG R0; EMITCALL; R0 := #80000000; FLREG; R7 := #83000000; END; END; BEGIN COMMENT STRING CONVERSION FUNCTIONS; INTEGER LENGTH, FUNCNO, SAVER0; R3 := R3-36; FUNCNO := R3; COMMENT (FUNCNO DIV 2) = TYPE ; IF R3 = 6 OR R3 = 7 THEN R0 := 19 ELSE R0 := 11; LENGTH := R0; CONVERT; STFUNCTION; R0 := FUNCNO; IF R0 <= 3 THEN BEGIN R0 := #18030000; EMIT; END; R0 := #FFFF; R(4) := R0; GENREG; R3 := R0 SHRL 8; LSTACKM4(R5) := R3; R0 := R0 OR LAA OR NEXTADDR; EMIT; R0 := R0-R0; R(4) := R0; R10 := LENGTH + 1; INCRADDR; R3 := FUNCNO + 1 SHLL 24 OR #B0000000; R0 := @WRITEEDIT; R0 := NEG R0; EMITCALL; R7 := LENGTH SHLL 16 OR #87000000; END; BEGIN COMMENT TIME (R3 = 44); LOADREG; R0 := LSTACKM4(R5) AND MASK5 SHRL 4 OR #18000000; EMIT; R0 := @GTIME; R0 := NEG R0; EMITCALL; R0 := LSTACKM4(R5) AND MASK5 OR #18000000; EMIT; R7 := #81000000; END; BEGIN COMMENT TRACE (R3 = 45); STFUNCTION; R0 := @TRACEFN; R0 := NEG R0; EMITCALL; R7 := SIGN; END; END; R1 := SAVER1; END; SEGMENT PROCEDURE LEVEL2(R1); BEGIN PROCEDURE CHAINFOR(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := SEGNTLEN + 8; SEGNTLEN := R1; R0 := R0-R0; IF R0 = FORLINK THEN FORLINK := R7 ELSE BEGIN R1 := LASTFOR; SIMTYPEINFO(R1) := R7; END; LASTFOR := R7; SIMTYPEINFO(R7) := R0; R1 := SAVER1; END; PROCEDURE RCCLTEST(R1); COMMENT TESTS REF VALUE FOR CLASS INDICATED IN STACK11(R8). IF R0 = #FF, LOADS REGISTER, OTHERWISE RELEASES; BEGIN LOGICAL SAVER1, ADDR; BYTE LOADFLAG; SAVER1 := R1; STC(R0,LOADFLAG); IF R7 >= 0 THEN BEGIN GETADDRESS; ADDR := R3; IF LOADFLAG THEN BEGIN GENREG; R0 := R0 OR #08000000; R3 := ADDR; R6 := 1; ASSEMBLE; RESET(LOADFLAG); END; END ELSE BEGIN R3 := LSTACKM4(R5); ADDR := R3; IF ~LOADFLAG THEN BEGIN R6 := 1; RELEASE; R5 := R5 - 4; END; END; R0 := STACK11(R8); IF R0 ~= 0 THEN BEGIN R3 := ADDR; IF R3 < 0 THEN BEGIN R0 := R3 AND #00F00000 OR #50000000 OR REFTEMP; EMIT; R3 := REFTEMP; END; R0 := STACK11(R8) SHLL 16 OR #95000000 OR R3; EMIT; END; IF LOADFLAG THEN LOADREG; COMMENT NONTERMINAL ONLY; R1 := SAVER1; END; SEGMENT PROCEDURE NUMERICALASSIGN(R1); COMMENT PROCESSES NUMERICAL ASSIGNMENT (A:=, A:=2 - ARG2); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := TREE(R6); IF R3 < 0 THEN BEGIN COMMENT ON LEFT, EXPRESSION ON RIGHT PROCESSED; IF R7 >= 0 THEN BEGIN COMMENT TERMINAL ON LEFT; GETTYPE; R6 := R3; R0 := R7 SHRL 24; IF R0 = CONID THEN BEGIN COMMENT INITIAL FOR VALUE, FORCE TO R2; R3 := 1; CORRECTREG; R0 := LSTACKM4(R5); R3 := IDLOC1(R7) SHLL 12 + IDLOC2(R7); LSTACKM4(R5) := R3; R5 := R5 + 4; LSTACKM4(R5) := R0; CHAINFOR; END ELSE BEGIN GETADDRESS; R0 := LSTACKM4(R5); IF R0 > 0 THEN BEGIN COMMENT EXPR DUMPED TO PROCESS LEFT SIDE; R7 := R6 SHLL 24 OR SIGN; LOADREG; R0 := LSTACKM4(R5); END; ASSEMBLE; IF R6 = 9 THEN BEGIN R3 := 4; REFSTOR; END; END; END ELSE BEGIN COMMENT NON-TERMINAL ON LEFT; R6 := R7 SHRL 24 AND #7F; RESET(ARGFLAG); R0 := LSTACKM4(R5-4); IF R0 > 0 THEN BEGIN COMMENT EXPR DUMPED TO PROCESS LEFT SIDE; R5 := R5 - 4; R7 := R6 SHLL 24 OR SIGN; LOADREG; R5 := R5 + 4; R0 := LSTACKM4(R5-4); SET(ARGFLAG); END; R3 := LSTACKM4(R5); ASSEMBLE; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; R6 := R7 SHRL 24 AND #7F; IF ARGFLAG THEN IF R6 = 1 OR R6 >= 8 THEN ADJSTACKS; END; IF ~CEQ2 THEN BEGIN COMMENT RELEASE EXPR REGISTER; R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; END; END ELSE BEGIN COMMENT ON RIGHT, LEFT SIDE PROCESSED; CONVERT; LOADREG; R6 := R7 SHRL 24 AND #7F; R3 := LSTACKM4(R5-4); R1 := CLN SHLL 12; IF R3 > R1 THEN BEGIN COMMENT HAD TO DUMP ADDRESS FROM LEFT; R5 := R5 - 4; R7 := #81000000; LOADREG; R5 := R5 + 4; R3 := LSTACKM8(R5) SHLL 1 SHRL 9; END ELSE BEGIN COMMENT DID NOT DUMP ADDRESS FROM LEFT; R3 := LSTACKM8(R5); END; R0 := LSTACKM4(R5); ASSEMBLE; R3 := LSTACKM4(R5); RELEASE; R3 := LSTACKM8(R5); R10 := R6; R6 := 1; RELEASE; R6 := R10; R5 := R5 - 8; END; R7 := R6 SHLL 24 OR SIGN; R1 := SAVER1; END; SEGMENT PROCEDURE LCOLEQARG2(R1); BEGIN LOGICAL SAVER1; BYTE ADJFLAG; SAVER1 := R1; R3 := R6 AND #FFFF; R3 := TREE(R3); IF R3 < 0 THEN BEGIN COMMENT ON LEFT, CC CONVERTED TO VALUE BY ARG1; IF R7 >= 0 THEN BEGIN GETADDRESS; IF R7 < 0 THEN BEGIN R7 := #86000000; SET(R3FLAG); LOADREG; END; R0 := LSTACKM4(R5) AND #00F00000 OR R3 OR #42000000; EMIT; END ELSE BEGIN COMMENT NON-TERMINAL LHV, ADDRESS COMPUTED; RESET(ADJFLAG); R1 := LSTACKM4(R5-4); IF R1 > 0 THEN BEGIN COMMENT VALUE WAS DUMPED; SET(ADJFLAG); R5 := R5 - 4; R7 := #81000000; LOADREG; R5 := R5 + 4; END; R0 := LSTACKM4(R5-4) AND #00F00000 OR LSTACKM4(R5) OR #42000000; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; IF ADJFLAG THEN ADJSTACKS; END; IF ~CEQ2 THEN BEGIN R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; END; END ELSE BEGIN COMMENT ON RIGHT; IF R7 >= 0 THEN BEGIN INTEGER SAVEADDR; GETADDRESS; SAVEADDR := R3; IF R7 < 0 THEN BEGIN SET(R3FLAG); LOADREG; R0 := LSTACKM4(R5) SHRL 8 AND #F000; LSTACKM4(R5) := R0; END; GENREG; R0 := R0 OR SAVEADDR OR #43000000; EMIT; R0 := LSTACKM4(R5) AND #00F00000 OR LSTACKM4(R5-4); END ELSE BEGIN R0 := R7 SHRL 16; IF R0 = #8600 THEN EVALUATELOG; R0 := LSTACKM4(R5-4) SHRL 12 AND #F; IF R0 >= CLN THEN BEGIN R5 := R5-4; R7 := #81000000; LOADREG; R5 := R5+4; R0 := LSTACKM4(R5-4) XOR SIGN SHRL 8; LSTACKM4(R5-4) := R0; END; R0 := R7 SHRL 16; IF R0 = #8601 THEN BEGIN R3 := LSTACKM4(R5) SHLL 8 AND #00F00000; R0 := LSTACKM4(R5) OR R3 OR #43000000; EMIT; R0 := LSTACKM4(R5-4) OR R3; END ELSE BEGIN COMMENT RESULT IN REGISTER OR CC; R0 := LSTACKM4(R5) XOR SIGN OR LSTACKM4(R5-4); END; END; R0 := R0 OR #42000000; EMIT; R6 := 1; R3 := LSTACKM4(R5); RELEASE; R3 := LSTACKM4(R5-4); RELEASE; R5 := R5 - 8; END; R1 := SAVER1; END; PROCEDURE SCOLEQARG2(R1); COMMENT COMPLETES STRING ASSIGNMENT (FORCED ON LEFT); BEGIN LOGICAL SAVER1; INTEGER LEN; SAVER1 := R1; IF R7 >= 0 THEN BEGIN GETLENGTH; LEN := R3; GETADDRESS; END ELSE BEGIN R3 := R7 SHRL 16 AND #FF; LEN := R3; R3 := LSTACKM4(R5); R6 := 7; RELEASE; R5 := R5-4; END; R0 := LEN SHLL 16 OR R3 OR #D2000000; R3 := LSTACKM4(R5) SHLL 16; EMIT; IF ~CEQ2 THEN BEGIN R3 := LSTACKM4(R5); R6 := 7; RELEASE; R5 := R5-4; END; R7 := LEN SHLL 16 OR #87000000; R1 := SAVER1; END; PROCEDURE RCOLEQARG2(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := TREE(R6); IF R3 < 0 THEN NUMERICALASSIGN ELSE BEGIN IF R7 >= 0 THEN BEGIN R3 := R7 SHRL 24; IF R3 = RCCLID THEN RECORDALLOCATE; END; NUMERICALASSIGN; END; RESETRECORD; R5 := R5 + 4; RESETRECORD; R5 := R5 - 4; TEST(CEQ2); IF ~= THEN R7 := SIGN ELSE R7 := #89000000; R1 := SAVER1; END; SEGMENT PROCEDURE RECDESIGASSIGN(R1); COMMENT INITIALIZED RECORD CREATION (R, AND R) - ARG2); IF R7 = NULLST THEN R7 := #89000000 ELSE BEGIN LOGICAL SAVER1, SAVER6; INTEGER LEN, TEMP; BYTE RELFLAG; SAVER1 := R1; SAVER6 := R6; IF R7 >= 0 THEN GETTYPE ELSE R3 := R7 SHRL 24 AND #7F; R6 := R3; SET(RELFLAG); IF R3 = 6 THEN BEGIN COMMENT LOGICAL; IF R7 >= 0 THEN BEGIN GETADDRESS; TEMP := R3; GENREG; R0 := R0 OR TEMP OR #43000000; EMIT; END ELSE BEGIN EVALUATELOG; R10 := LSTACKM4(R5); IF R10 >= 0 THEN BEGIN R0 := R10 AND #0000F000 SHLL 8; R3 := R0 OR SIGN; LSTACKM4(R5) := R3; R0 := R0 OR #43000000 OR R10; EMIT; END; END; END ELSE IF R3 = 7 THEN BEGIN COMMENT STRING; IF R7 >= 0 THEN BEGIN GETLENGTH; LEN := R3; GETADDRESS; RESET(RELFLAG); R5 := R5+4; LSTACKM4(R5) := R3; END ELSE BEGIN R3 := R7 SHRL 16 AND #FF; LEN := R3; END; END ELSE BEGIN CONVERT; LOADREG; END; R10 := STACK1(R8); COMMENT NT INDEX; R0 := LSTACKM4(R5-4); IF R0 > 0 THEN BEGIN COMMENT REFERENCE VALUE HAS BEEN DUMPED; TEMP := R0; R5 := R5-8; GENREG; R5 := R5+4; R0 := R0 OR TEMP OR #58000000; EMIT; END; R6 := 0; IC(R6,SIMPLETYPE(R10)); R3 := LSTACKM4(R5-4) AND #00F00000 SHRL 8 + IDLOC2(R10); IF R6 = 6 THEN BEGIN R0 := LSTACKM4(R5) AND #00F00000 OR R3 OR #42000000; EMIT; END ELSE IF R6 = 7 THEN BEGIN TEMP := R3; R1 := SIMTYPEINFO(R10) - LEN; IF > THEN BEGIN R1 := R1-1 SHLL 16; R3 := BLANKS SHLL 16; R0 := TEMP + LEN ++ #D2000001 OR R1; EMIT; END; R0 := LEN SHLL 16 OR TEMP OR #D2000000; R3 := LSTACKM4(R5) SHLL 16; EMIT; END ELSE BEGIN R0 := LSTACKM4(R5); ASSEMBLE; END; R3 := LSTACKM4(R5); IF RELFLAG THEN RELEASE; R5 := R5-8; RSTACK(R2-4) := R5; R5 := R5+4; IF R6 = 9 THEN RESETRECORD; R7 := #89000000; R6 := SAVER6 OR R7; R1 := SAVER1; END; PROCEDURE CEQUAL(R1); BEGIN LOGICAL SAVER1,SAVER3,RELATE; SAVER1 := R1; SAVER3 := R3; RELATE := R0; LOADREG; BEGIN R0 := LSTACKM4(R5); IF R0 < 0 THEN BEGIN R0 := R0 AND MASK5; R3 := LSTACKM8(R5); IF R3 < 0 THEN R3 := R3 AND MASK5 OR SIGN; R0 := R0 OR #09000000; R6 := SAVER3 - 2; ASSEMBLE; R0 := RELATE; IF R0 = 7 THEN BEGIN R1 := 0; R3 := LOGPOINTER + 4; LOGPOINTER := R3; LOGSTACK(R3) := R1; END; R0 := 7; LOGBRANCH; INITIALIZELINK; R0 := LSTACKM4(R5) SHLL 4 AND MASK5; R3 := LSTACKM8(R5); IF R3 < 0 THEN R3 := R3 SHLL 4 AND MASK5 OR SIGN ELSE IF R6 = 2 THEN R3 := R3 + 4 ELSE R3 := R3 + 8; R0 := R0 OR #09000000; ASSEMBLE; R0 := RELATE; IF R0 = 8 THEN BEGIN R3 := LOGPOINTER + 4; R1 := 0; LOGPOINTER := R3; LOGSTACK(R3) := R1; END; R0 := R0 OR #100 SHLL 16; R3 := LOGPOINTER + 4; LOGPOINTER := R3; LOGSTACK(R3) := R0; R10 := R6; R6 := 4; R3 := LSTACKM4(R5); RELEASE; R3 := LSTACKM8(R5); RELEASE; R6 := R10; R5:=R5-8; END; END; R7 := #86000000; R1 := SAVER1; END; PROCEDURE ARG2RELATION(R1); BEGIN COMMENT R0 HAS LEFT TO RIGHT COMPARE BRANCH; LOGICAL SAVER1, RELATE; SAVER1 := R1; RELATE := R0; CONVERT; R6 := R6 SHRL 24 AND #7F; IF R7 >= 0 THEN BEGIN GETADDRESS; IF R7 < 0 THEN LOADREG; R5 := R5-4; RESETRECORD; R5 := R5+4; R0 := LSTACKM4(R5); R1 := R7 SHRL 24; IF R1 = NUMBER OR R1 = BIT THEN BEGIN R1 := R3 AND #1FFF; R1 := PROGRAMM(R1); IF R1 = 0 THEN BEGIN R3 := R0; R0 := R0 OR #02000000; GOTO X; END; END; R0 := R0 OR #09000000; X: ASSEMBLE; END ELSE BEGIN COMMENT NONTERMINAL; LOADREG; R0 := LSTACKM4(R5) OR #09000000; R5 := R5 - 4; RESETRECORD; R5 := R5 - 4; RESETRECORD; R5 := R5 + 8; R3 := LSTACKM8(R5); ASSEMBLE; R3 := LSTACKM8(R5); R5 := R5 - 4; RELEASE; R3 := LSTACK(R5); LSTACKM4(R5) := R3; R0 := RELATE; IF R0 ~= 8 THEN IF R0 ~= 7 THEN BEGIN R0 := R0 XOR #7; RELATE := R0; END; END; R3 := LSTACKM4(R5); R5 := R5 - 4; RELEASE; R3 := LOGPOINTER + 12; LOGPOINTER := R3; R1 := 0; R0 := RELATE OR #100 SHLL 16; LOGSTACK(R3) := R0; LOGSTACK(R3-4) := R1; LOGSTACK(R3-8) := R1; R7 := #86000000; R1 := SAVER1; END; PROCEDURE LEQUAL(R1); BEGIN LOGICAL SAVER1,SAVER6; SAVER1 := R1; SAVER6 := R6; IF R7 < 0 THEN BEGIN R3 := R7 SHLL 8 SHRL 24; IF R3 = 1 THEN BEGIN R0 := LSTACKM4(R5); R3 := R0 AND #F000 SHLL 8; R10 := R3; R0 := R0 OR R3; R3 := R3 OR SIGN; LSTACKM4(R5) := R3; R0 := R0 OR #43000000; EMIT; R1 := CPTBASE; R3 := CONSPTTAB(R1) AND MASK OR #E000; R0 := R10 OR #04000000; R6 := 1; ASSEMBLE ; END ELSE EVALUATELOG; END ELSE BEGIN LOGICAL SAVEADD; GETADDRESS; SAVEADD := R3; GENREG; R0 := R0 OR SAVEADD OR ICC; EMIT; R0 := LSTACKM4(R5) XOR SIGN OR #04000000; R1:=CPTBASE; R3:=CONSPTTAB(R1) AND MASK OR #E000; R6:=1;ASSEMBLE; END; R1 := SAVER1; R6 := SAVER6; END; SEGMENT PROCEDURE ARG2EQUALITIES(R1); BEGIN LOGICAL SAVER1,RELATE,SAVEADD; LOGICAL SR6; SAVER1 := R1; SR6 := R6; IF R0 ~= 7 AND R0 ~= 8 THEN BEGIN COMMENT CHECK TREE SWITCH, COMPLEMENT RELATION; R3 := SAVEL; R3 := TREE(R3); IF R3 < 0 THEN R0 := R0 XOR #7; END; RELATE := R0; R3 := R7 SHLL 1 SHRL 25; IF R7>0 THEN IF R3~=RCCLID THEN BEGIN GETTYPE; IF R3 < 6 THEN BEGIN CONVERT; IF R7 < 0 THEN R3 := R7 SHLL 1 SHRL 25 ELSE GETTYPE; END; END ELSE R3 := 9; R0 := RELATE; IF R3 < 4 THEN ARG2RELATION ELSE IF R3 < 6 THEN CEQUAL ELSE BEGIN R3 := R3 - 5; CASE R3 OF BEGIN BEGIN COMMENT = LOGICAL ARG2; LEQUAL; R0 := LSTACKM4(R5) OR #09000000; R3 := LSTACKM8(R5); R6 := 1; ASSEMBLE; R6 := 1; R3 := LSTACKM4(R5); RELEASE; R3 := LSTACKM8(R5); RELEASE; R5 := R5 - 8; R7 := #86000000; R3 := LOGPOINTER + 12; LOGPOINTER := R3; R1 := 0; R0 := RELATE OR #100 SHLL 16; LOGSTACK(R3) := R0; LOGSTACK(R3-4) := R1; LOGSTACK(R3-8) := R1; END; BEGIN COMMENT STRING COMPARISON; INTEGER LEN; IF R7 < 0 THEN BEGIN R1 := R7 SHRL 16 AND #FF; LEN := R1; R3 := LSTACKM4(R5); R6 := 7; RELEASE; R5 := R5-4; END ELSE BEGIN GETLENGTH; LEN := R3; GETADDRESS; END; R0 := LEN SHLL 16 OR LSTACKM4(R5) OR #D5000000; R3 := R3 SHLL 16; EMIT; R3 := LSTACKM4(R5); R6 := 7; RELEASE; R5 := R5-4; R3 := LOGPOINTER + 12; LOGPOINTER := R3; R1 := R1-R1; LOGSTACK(R3-8) := R1; LOGSTACK(R3-4) := R1; R0 := RELATE OR #100 SHLL 16; LOGSTACK(R3) := R0; R7 := #86000000; END; BEGIN ARG2RELATION; END; BEGIN LOGICAL SAVER6; SAVER6 := R6; IF R7 >= 0 THEN BEGIN R3 := R7 SHRL 24; IF R3 = RCCLID THEN RECORDALLOCATE; END; R0 := RELATE; R6 := SAVER6; ARG2RELATION; END; END; END; R1 := SAVER1; END; PROCEDURE IFSTANDEXP(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := LOGPOINTER; R0 := LOGSTACK(R3); IF R0 ~= 0 THEN BEGIN R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER; R0 := LOGSTACK(R3+4); LOGSTACK(R3) := R0; END ELSE BEGIN R3 := R3 - 4; LOGPOINTER := R3; END; R1:= SAVER1; END; PROCEDURE ANDORARG2(R1); BEGIN COMMENT ANDFLAG IS ON IF AND, OFF IF OR; LOGICAL SAVER1; SAVER1 := R1; IF R7 >= 0 THEN BEGIN LOGCOMPARE; TEST(ANDFLAG); IF = THEN R0 := #0207 ELSE R0 := #0108; INDICATEBRANCH; END ELSE BEGIN R3 := R7 SHLL 8 SHRL 24; IF R3 = 1 THEN BEGIN R0 := LSTACKM4(R5) OR CLII OR #00010000; EMIT; R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; TEST(ANDFLAG); IF = THEN R0 := #0207 ELSE R0 := #0108; INDICATEBRANCH; END ELSE BEGIN R3 := LOGPOINTER; IC(R10,LOGSTACK(R3)); R10 := R10 AND #FF; TEST(ANDFLAG); IF = THEN R10 := R10 XOR #3; CASE R10 OF BEGIN MERGE24; MERGE34; END; END; END; R7 := #86000000; R1 := SAVER1; END; PROCEDURE ARG2FORLIST(R1); COMMENT FORCE REGISTER, EMIT LINK; BEGIN INTEGER SAVER1; SAVER1 := R1; LOADREG; R3 := 1; CORRECTREG; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 4; R0 := STACKP4(R8) + 1; STACKP4(R8-SSIZE) := R0; R0 := INSCOUNTER; STACKP8(R8-SSIZE) := R0; R0 := #45100000 OR STACKP8(R8); EMIT; R1 := SAVER1; END; PROCEDURE ARG2COUNT(R1); COMMENT CHECKS FOR COUNT AS RIGHT SUBNODE, EMITS INCREMENT; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := SAVEL - 4; IC(R3,TREE(R1)); R3 := R3 AND #7F; IF R3 = UCOUNT THEN BEGIN R3 := TREEP(R1) + COUNTBASE; R0 := #FA300000 OR R3; R3 := PL11 SHLL 16; EMIT; R0 := INSCOUNTER; PPMARK := R0; END; R1 := SAVER1; END; PROCEDURE ARG2SKIP(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER-4; LOGPOINTER := R3; R1 := SAVEL - 4; IC(R0,TREE(R1)); R0 := R0 AND #7F; IF R0 = UCOUNT AND DEBUG THEN BEGIN R0 := TREEP(R1) + COUNTBASE OR #FA300000; R3 := PL11+2 SHLL 16; EMIT; R0 := INSCOUNTER; PPMARK := R0; END; R7 := SIGN; R1 := SAVER1; END; PROCEDURE ARG2COMMA(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := STACK11(R8) AND #FFFF; R1 := STACK12(R8) AND #FFFF; IF R1 < NEXTADDR THEN R1 := NEXTADDR; NEXTADDR := R0; STACK11(R8-SSIZE) := R0; STACK12(R8-SSIZE) := R1; IF DEBUGFLAG THEN ARG2COUNT; R1 := SAVER1; END; SEGMENT PROCEDURE ARG21(R1); BEGIN LOGICAL SAVER1; BYTE DIVFLAG; COMMENT SET TO CONTROL MULT/DIV CODE IN PCLL; PROCEDURE PCLL(R1); COMMENT GENERATE CALL FOR COMPLEX MULT/DIV; BEGIN LOGICAL SAVER1; SAVER1 := R1; R0 := @CARITHFN; R0 := NEG R0; R3 := R6-3; IF DIVFLAG THEN R3 := R3+2; COMMENT 1=CMULT, 2=LCMULT, 3=CDIV, 4=LCDIV ; R3 := R3 SHLL 16; EMITCALL; IF DIVFLAG AND R6 = 4 THEN R0 := #40000000 ELSE R0 := 0; IF ~DIVFLAG THEN R6 := 5; PRFLREG; R1 := SAVER1; END; PROCEDURE SUBDIV(R1); COMMENT DOES SETUP FOR ARG2 SUBTRA DIVIDE; BEGIN LOGICAL SAVER1; PROCEDURE SUBSUBDIV(R1); COMMENT HANDLES COMMON CASE; BEGIN LOGICAL SAVER1; SAVER1 := R1; LOADREG; R0 := LSTACKM4(R5); R3 := LSTACKM8(R5); IF R3 < 0 THEN RELEASE ELSE ADJSTACKS; LSTACKM8(R5) := R0; R5 := R5-4; R1 := SAVER1; END; SAVER1 := R1; IF R7 > 0 THEN BEGIN IF R10 < 0 THEN SUBSUBDIV ELSE BEGIN GETADDRESS; IF R7 < 0 THEN LOADREG; R0 := LSTACKM4(R5); END; END ELSE BEGIN IF R10 < 0 THEN SUBSUBDIV ELSE BEGIN R5 := R5-4; R0 := LSTACKM4(R5); R3 := LSTACK(R5); IF R0 < 0 THEN RELEASE ELSE BEGIN LOADREG; RELEASE; IF R3 < 0 OR R6 = 1 THEN ADJSTACKS; R0 := LSTACKM4(R5); END; END; END; R1 := SAVER1; END; SET(ARGFLAG); SAVER1 := R1; CASE R3 OF BEGIN BEGIN COMMENT + ; 1 CONVERT; R6 := R6 SHLL 1 SHRL 25; IF R7 >= 0 THEN BEGIN GETADDRESS; IF R7 < 0 THEN LOADREG; R0 := LSTACKM4(R5); END ELSE BEGIN R0 := LSTACKM8(R5); R3 := LSTACKM4(R5); IF R0 >= 0 THEN BEGIN IF R3 > 0 THEN LOADREG; R0 := LSTACKM4(R5); R3 := LSTACKM8(R5); LSTACKM8(R5) := R0; ADJSTACKS; END ELSE RELEASE; R5 := R5-4; END; R0 := R0 OR A; ASSEMBLE; R7 := R6 SHLL 24 OR SIGN; CONVERTRESULT; END; BEGIN COMMENT - ; 2 CONVERT; R10 := R6; R10 := TREE(R10); R6 := R6 SHLL 1 SHRL 25; SUBDIV; R0 := R0 OR S; ASSEMBLE; R7 := R6 SHLL 24 OR SIGN; CONVERTRESULT; END; BEGIN COMMENT * ; 3 CONVERT; R6 := R6 SHLL 1 SHRL 25; IF R6 <= 3 THEN BEGIN SET(PAIRFLAG); IF R7 >= 0 THEN BEGIN GETADDRESS; IF R7 < 0 THEN LOADREG; R0 := LSTACKM4(R5); IF R6 = 1 THEN FORCEPAIR; END ELSE BEGIN R0 := LSTACKM8(R5); R3 := LSTACKM4(R5); IF R0 >= 0 THEN BEGIN IF R3 >= 0 THEN LOADREG; R0 := LSTACKM4(R5); IF R6 = 1 THEN FORCEPAIR; R3 := LSTACKM8(R5); R0 := LSTACKM4(R5); LSTACKM8(R5) := R0; ADJSTACKS; END ELSE BEGIN IF R6 = 1 THEN BEGIN IF R3 < 0 THEN R3 := LSTACKM4(R5); R5 := R5-4; FORCEPAIR; R5 := R5+4; END; RELEASE; END; R5 := R5-4; END; RESET(PAIRFLAG); R0:=R0 AND #FFF0FFFF OR M; ASSEMBLE; END ELSE BEGIN RESET(DIVFLAG); CONVERT; IF R7 > 0 THEN BEGIN GETADDRESS; R0 := #41000000 OR R3; EMIT; R7 := R6 SHLL 24 OR SIGN; STFUNCTION; PCLL; END ELSE BEGIN R0 := LSTACKM4(R5); IF R0 > 0 THEN BEGIN R3 := R0; R0 := R0 OR #41000000; EMIT; RELEASE; R5 := R5-4; R7 := R6 SHLL 24 OR SIGN; STFUNCTION; PCLL; END ELSE BEGIN R3 := LSTACKM8(R5); IF R3 < 0 THEN BEGIN R0 := FSTACK(0); DUMPPRFLREG; END; R0 := LSTACKM4(R5); R7 := R6 SHLL 24 OR SIGN; IF R0 < 0 THEN R0 := LSTACKM8(R5); R0 := R0 OR #41000000; EMIT; STFUNCTION; R5 := R5-4; PCLL; END; END; END; R7 := R6 SHLL 24 OR SIGN; IF R6 = 1 THEN BEGIN COMMENT EVEN-ODD PAIR IN LSTACKM4. UNFLAG ODD IN R AND ERASE FROM LSTACKM4. EMIT SLDA ODDREG,32; R3 := LSTACKM4(R5) AND MASK4 SHRL 15; R0:=R0-R0; R(R3) := R0; R0 := LSTACKM4(R5) AND MASK5 OR #8F000020; EMIT; R0 := R0 AND MASK5 OR SIGN; LSTACKM4(R5) := R0; END ELSE IF R6 = 2 THEN BEGIN R7 := #83000000; R1 := FSTACKM4(R4) AND #BFFFFFFF; FSTACKM4(R4) := R1; END ELSE IF R6 = 4 THEN BEGIN R7 := #85000000; R1 := FSTACKM4(R4) AND #3FFFFFFF; FSTACKM4(R4) := R1; END; CONVERTRESULT; END; BEGIN COMMENT / ; 4 CONVERT; R10 := R6; R10 := TREE(R10); R6 := R6 SHLL 1 SHRL 25; IF R6 <= 3 THEN BEGIN SUBDIV; R0 := R0 OR D; ASSEMBLE; END ELSE BEGIN SET(DIVFLAG); IF R10 < 0 THEN BEGIN COMMENT ON LEFT SIDE; STFUNCTION; R0 := LSTACKM4(R5) OR #41000000; EMIT; R5 := R5-4; END ELSE BEGIN COMMENT ON RIGHT SIDE; IF R7 > 0 THEN BEGIN GETADDRESS; R0 := R3 OR #41000000; EMIT; R7 := R6 SHLL 24 OR SIGN; STFUNCTION; END ELSE BEGIN DUMPALLFLREG; R0 := LSTACKM4(R5) OR #41000000; EMIT; R5 := R5-4; R7 := R6 SHLL 24 OR SIGN; STFUNCTION; END; END; PCLL; END; R7 := R6 SHLL 24 OR SIGN; CONVERTRESULT; END; BEGIN COMMENT ** ; 5 INTEGER TYPE; COMMENT ON EXPONENT SIDE; PROCEDURE PCALL(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := R3 SHLL 16; R0 := NEG R0; EMITCALL; R1 := SAVER1; END; R6 := STACKP4(R8) SHLL 1 SHRL 25; TYPE := R6; R0 := 0; R1 := R7 SHRL 24; IF R1 = NUMBER THEN BEGIN R1 := R7 AND #FFFF + CPTBASE; R1 := CONSPTTAB(R1) AND #FFFF; R0 := PROGRAMM(R1); END; IF R0 = 2 AND R6 <= 3 THEN BEGIN COMMENT SQUARE OF INTEGER, REAL, LONG REAL; R0 := LSTACKM4(R5); IF R0 > 0 THEN BEGIN LOADREG; R0 := LSTACKM4(R5); END; R3 := R0; R0 := R0 OR M; ASSEMBLE; END ELSE BEGIN LOADREG; R0 := R0-R0; IF R0 < LSTACKM8(R5) THEN BEGIN R7 := STACKP4(R8); R5 := R5-4; LOADREG; R5 := R5+4; END; R6 := 1; R3 := LSTACKM4(R5); RELEASE; R6 := TYPE; R10 := R6; R0 := LSTACKM4(R5) SHLL 8 SHRL 28; IF R6 > 3 THEN R3 := R6 SHLL 8 ELSE R3 := 0; R0 := R0 OR R3 OR #41000000; IF R6 <= 3 THEN BEGIN R3 := LSTACKM8(R5) AND MASK5 SHRL 16; R0 := R0 OR R3; EMIT; R5 := R5-4; R0 := @POWER; PCALL; END ELSE BEGIN EMIT; R5 := R5-4; R7 := STACKP4(R8) OR SIGN; STFUNCTION; R3 := 7; R0 := @CARITHFN; PCALL; IF R6 = 4 THEN R0 := #40000000 ELSE R0 := 0; PRFLREG; END; END; R7 := R6 SHLL 24 OR SIGN; CONVERTRESULT; END; BEGIN COMMENT L:= ; 6 LCOLEQARG2; R7 := SIGN; END; BEGIN COMMENT A:= ; 7 NUMERICALASSIGN; R7 := SIGN; END; BEGIN COMMENT S:= ; 8 SCOLEQARG2; R7 := SIGN; END; BEGIN COMMENT R:= ; 9 RCOLEQARG2; END; NULL; 10 NULL; 11 BEGIN COMMENT STEPUNTIL ; 12 LOADREG; R0 := STACKP4(R8); IF R0 ~= 1 THEN R10 := LSTACKM4(R5-4) + 4 ELSE BEGIN R3 := NEXTADDR + 3 AND #FFFC; NEXTADDR := R3; R10 := 4; INCRADDR; R10 := R3; END; R0 := LSTACKM4(R5) AND #00F00000 OR R10 OR #50000000; EMIT; R3 := LSTACKM4(R5); LSTACKM4(R5) := R10; R6 := 1; RELEASE; END; BEGIN COMMENT DIV ; 13 DIVREM; CONVERTRESULT; END; BEGIN COMMENT REM ; 14 SET(REMAINDER); DIVREM; RESET(REMAINDER); CONVERTRESULT; END; BEGIN COMMENT < ; 15 R0 := #4; ARG2EQUALITIES; END; BEGIN COMMENT <= ; 16 R0 := #C; ARG2EQUALITIES; END; BEGIN COMMENT > ; 17 R0 := #2; ARG2EQUALITIES; END; BEGIN COMMENT >= ; 18 R0 := #A; ARG2EQUALITIES; END; BEGIN COMMENT = ; 19 R0 := #8; ARG2EQUALITIES; END; BEGIN COMMENT ~= ; 20 R0 := #7; ARG2EQUALITIES; END; NULL; 21 BEGIN COMMENT L:=2 ; 22 SET(CEQ2); LCOLEQARG2; R7 := #86020000; RESET(CEQ2); END; BEGIN COMMENT A:=2 ; 23 SET(CEQ2); NUMERICALASSIGN; CONVERTRESULT; RESET(CEQ2); END; BEGIN COMMENT S:=2 ; 24 SET(CEQ2); SCOLEQARG2; CONVERTRESULT; RESET(CEQ2); END; BEGIN COMMENT R:=2 ; 25 SET(CEQ2); RCOLEQARG2; RESET(CEQ2); END; NULL; 26 NULL; 27 NULL; 28 BEGIN COMMENT AP) ; 29 R0 := STACK21(R8); IF R0 = FLAG THEN BEGIN COMMENT STANDARD FUNCTION OR PROCEDURE; R3 := STACK22(R8); STANDARDFUNCTION; CONVERTRESULT; END ELSE BEGIN COMMENT ALGOL PROCEDURE; ACPARAM; R3 := @PROCRETURN; ENTRYEXIT; END; END; BEGIN COMMENT INDX ; 30 R3 := @INDEXOP; ARRAYS; END; BEGIN COMMENT REFX ; 31 R0 := #FF; RCCLTEST; COMMENT TEST RCCL, LOAD REG; R0 := STACK11(R8); IF R0 ~= 0 THEN BEGIN R0 := #45100000 OR REFBINDERR; EMIT; END; R5 := R5 - 4; RESETRECORD; R5 := R5 + 4; R0 := LSTACKM4(R5) SHRL 8 AND #FFFF + STACK12(R8); LSTACKM4(R5) := R0; R7 := STACK2(R8) OR SIGN; CONVERTRESULT; END; BEGIN COMMENT IFEXP ; 32 SET(IFEXP); UNCONDJUMP; RESET(IFEXP); R3 := LOGPOINTER + 4; LOGPOINTER := R3; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER - 4; LOGPOINTER := R3; IF DEBUG THEN ARG2COUNT; CONVERTRESULT; END; BEGIN COMMENT , ; 33 IF R7 = NULLST THEN BEGIN IF DEBUG THEN BEGIN R0 := #07000000; EMIT; END; END ELSE IF R7 >= 0 THEN BEGIN GETTYPE; IF R3 ~= 0 THEN TERMBLOCKEXPR ELSE BEGIN CALLPROPROCWOPARAM; R7 := SIGN; END; END; ARG2COMMA; END; BEGIN COMMENT L, ; 34 COMMENT FIX-UP BRANCH TABLE ADDRESS; R0 := INSCOUNTER OR #E000; R1 := IDLOC2(R7); PROGRAM(R1+2) := R0; R7 := SIGN; ARG2COMMA; END; END; R1 := SAVER1; END; SEGMENT PROCEDURE ARG22(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; CASE R3 OF BEGIN BEGIN COMMENT SHL ; 35 BITSSHIFTARG2; R0 := R0 OR #89000000; EMIT; R7 := R6 SHLL 24 OR SIGN; END; BEGIN COMMENT SHR ; 36 BITSSHIFTARG2; R0 := R0 OR #88000000; EMIT; R7 := R6 SHLL 24 OR SIGN; END; BEGIN COMMENT BB ; 37 R1 := STACK22(R8) SHLA 16; IF ~= THEN BEGIN COMMENT REFERENCE ARRAYS; R0 := CLN SHLL 12 OR REFVAR ++ #92000001 OR R1; EMIT; END; IF R7 >= 0 THEN R1 := NEXTADDR ELSE BEGIN R0 := STACK11(R8) AND #FFFF; NEXTADDR := R0; R1 := STACK12(R8) AND #FFFF; END; STACK2(R8-SSIZE) := R1; R7 := SIGN; END; BEGIN COMMENT END ; 38 CONVERTRESULT; IF R7 ~= NULLST THEN R0 := STACK12(R8) AND #FFFF ELSE BEGIN R0 := NEXTADDR; R7 := 0; END; IF R0 < STACK2(R8) THEN R0 := STACK2(R8); NEXTADDR := R0; R7 := R7 OR SIGN; END; BEGIN COMMENT PCL ; 39 R3 := @PROCEXIT; ENTRYEXIT; END; BEGIN COMMENT SUBSTRIN ; 40 BYTE LOADFLAG; RESET(LOADFLAG); IF R7 < 0 THEN BEGIN R0 := LSTACKM8(R5) AND #FFF; IF R0 > 0 THEN BEGIN R5 := R5 - 4; LOADREG; R5 := R5 + 4; SET(LOADFLAG); END; R0 := STACKP4(R8); IF R0 < 0 THEN BEGIN R0 := R0 XOR SIGN + STACKP8(R8); R3 := R7 SHLL 8 SHRL 24; IF R3 >= R0 THEN GOTO OPT1; END; IF CHECKFLAG THEN BEGIN R0 := R7 SHLL 8 SHRL 24 -STACKP8(R8) OR LAA; EMIT; R3 := LSTACKM8(R5) AND MASK5; R0 := R3 OR #15000000; EMIT; R0 := #45100000 OR STRINGERR; EMIT; END; OPT1: R0 := LSTACKM8(R5) AND MASK5 SHRL 4 OR LSTACKM8(R5) AND #FFF000 OR LSTACKM4(R5) OR #41000000; EMIT; R0 := LSTACKM8(R5) XOR SIGN SHRL 8; LSTACKM8(R5):=R0; R3 := LSTACKM4(R5); RELEASE; R5 := R5 - 4; IF LOADFLAG THEN BEGIN R6 := 1; ADJSTACKS; R6 := 7; END; R7 := STACKP8(R8) SHLL 16 OR #7000000; END ELSE BEGIN LOGICAL SAVEADD; R10 := STACKP4(R8); IF R10 < 0 THEN BEGIN GETLENGTH; R0 := R10 XOR SIGN + STACKP8(R8); IF R3 >= R0 THEN GOTO OPT2; END; IF CHECKFLAG THEN BEGIN GETLENGTH; R0 := R3 - STACKP8(R8) OR LAA; EMIT; R3 := LSTACKM4(R5) AND MASK5; R0 := R3 OR #15000000; EMIT; R0 := #45100000 OR STRINGERR; EMIT; END; OPT2: GETADDRESS; R0 := LSTACKM4(R5); SAVEADD := R3; IF R0 < 0 THEN BEGIN R0 := R0 AND MASK5 SHRL 4 OR LSTACKM4(R5) XOR SIGN OR R3 OR LAA; EMIT; END ELSE BEGIN R10 := R0; R5 := R5 - 4; GENREG; R3 := R0 SHRL 8; IF R3 = SAVEADD THEN BEGIN R0 := LSTACKM4(R5) XOR SIGN OR A; R3 := R10; R6 := 1; ASSEMBLE; END ELSE BEGIN R0 := R0 OR #58000000 OR R10; EMIT; R3 := LSTACKM4(R5) XOR SIGN; R0 := R3 SHRL 4 OR R3 OR SAVEADD OR LAA; EMIT; END; END; R0 := LSTACKM4(R5) XOR SIGN SHRL 8; LSTACKM4(R5) := R0; R7 := STACKP8(R8) SHLL 16 OR #7000000; END; R7 := R7 OR SIGN; CONVERTRESULT; END; BEGIN COMMENT | ; 41 R3 := R7 AND #FFFF; STACKP8(R8-SSIZE) := R3; R3 := STACKP4(R8); STACKP4(R8-SSIZE) := R3; END; BEGIN COMMENT AP, ; 42 R0 := STACK21(R8); IF R0 ~= FLAG THEN ACPARAM ELSE BEGIN COMMENT STANDARD FUNCTION OR PROCEDURE; R3 := STACK22(R8); STANDARDFUNCTION; END; R7 := SIGN; R0 := STACK1(R8); STACK1(R8-SSIZE) := R0; R0 := STACK2(R8); STACK2(R8-SSIZE) := R0; END; BEGIN COMMENT R, ; 43 RECDESIGASSIGN; END; BEGIN COMMENT AR, ; 44 R3 := @FILLDESCRIP; ARRAYS; END; BEGIN COMMENT AR) ; 45 R3 := @CLOSEDESCRIP; ARRAYS; END; BEGIN COMMENT R) ; 46 RECDESIGASSIGN; END; BEGIN COMMENT LOGOR ; 47 RESET(ANDFLAG); ANDORARG2; END; BEGIN COMMENT BITOR ; 48 BITSANDORARG2; R0 := R0 OR #06000000; ASSEMBLE; R7 := R6 SHLL 24 OR SIGN; END; BEGIN COMMENT LOGAND ; 49 SET(ANDFLAG); ANDORARG2; END; BEGIN COMMENT BITAND ; 50 BITSANDORARG2; R0 := R0 OR #04000000; ASSEMBLE; R7 := R6 SHLL 24 OR SIGN; END; BEGIN COMMENT ITERST ; 51 IF R7 >= 0 AND R7 ~= NULLST THEN CALLPROPROCWOPARAM; R0 := #58200000 OR LSTACKM4(R5); EMIT; R10 := STACKP8(R8); R1 := STACKP4(R8); CASE R1 OF BEGIN BEGIN R0 := #47F0E004 ++ R10; EMIT; R0 := INSCOUNTER OR #E000; PROGRAM(R10+14) := R0; END; BEGIN R0 := #98010000 OR LSTACKM4(R5-8); EMIT; R0 := #8720E008 ++ R10; EMIT; R0 := INSCOUNTER OR #E000; PROGRAM(R10+6) := R0; END; BEGIN R0 := #47F0E004 ++ R10; EMIT; R0 := INSCOUNTER OR #E000; PROGRAM(R10+18) := R0; R0 := R0 ++ #47000004; EMIT; END; END; IF DEBUGFLAG THEN BEGIN R0 := #92990000 OR LSTACKM4(R5); EMIT; IF DEBUG THEN ARG2COUNT; END; R5 := R5 - 12; R7 := SIGN; END; BEGIN COMMENT ITERST2 ; 52 IF R7 >= 0 AND R7 ~= NULLST THEN CALLPROPROCWOPARAM; R10 := STACKP4(R8); IF R10 ~= 0 THEN BEGIN R0 := LSTACKM4(R5) OR #58200000; EMIT; R0 := #07F20000; EMIT; R5 := R5 - 4; R0 := INSCOUNTER OR #E000; PROGRAM(R10+2) := R0; IF DEBUG THEN ARG2COUNT; END; R0 := #92990000 OR STACKP8(R8); IF DEBUGFLAG THEN EMIT; R7 := SIGN; END; BEGIN COMMENT FORLIST ; 53 ARG2FORLIST; R7 := #81000000; END; BEGIN COMMENT FORCL ; 54 R10 := STACKP4(R8); R0 := INSCOUNTER; STACKP4(R8-SSIZE) := R10; STACKP8(R8-SSIZE) := R0; IF R10 ~= 2 THEN BEGIN R0 := #47F0E008 ++ INSCOUNTER; EMIT; R0 := #5A200000 OR LSTACKM4(R5-8); EMIT; END; R0 := #59200000 OR LSTACKM4(R5-4); EMIT; IF R10 = 1 THEN R0 := #47400000 ELSE IF R10 = 2 THEN R0 := #47200000 ELSE BEGIN R0 := #58300008 ++ LSTACKM4(R5-8); EMIT; R0 := #44300000; END; EMIT; R0 := #50200000 OR LSTACKM4(R5); EMIT; END; BEGIN COMMENT ENDFORLI ; 55 R0 := STACKP4(R8); IF R0 = 0 THEN BEGIN LOADREG; R10 := 0; COMMENT FLAG THIS CASE; R0 := LSTACKM4(R5) AND #00F00000 OR LSTACKM4(R5-4) OR #50000000; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; R5 := R5 - 8; END ELSE BEGIN ARG2FORLIST; R0 := #47F00000; EMIT; R0 := INSCOUNTER OR #E000; R1 := INSCOUNTER - 8; WHILE R1 ~= 0 DO BEGIN R3 := PROGRAM(R1+2); PROGRAM(R1+2) := R0; R1 := R3; END; R3 := NEXTADDR + 3 AND #FFFC; NEXTADDR := R3; R0 := R3 OR #50100000; EMIT; R10 := 4; INCRADDR; R0 := #50200000 OR LSTACKM4(R5); EMIT; LSTACKM4(R5) := R3; R10 := INSCOUNTER - 12; END; STACKP4(R8-SSIZE) := R10; R0 := R0 AND #FFFF; STACKP8(R8-SSIZE) := R0; END; BEGIN COMMENT UJIFEXP ; 56 SET(UJIFEXP); UNCONDJUMP; RESET(UJIFEXP); END; BEGIN COMMENT UJ ; 57 UNCONDJUMP; END; BEGIN COMMENT CL ; 58 RESET(LOGFLAG); SET(CLFLAG); UNCONDJUMP; RESET(CLFLAG); TEST(LOGFLAG); IF = THEN BEGIN R3 := LOGPOINTER; R0 := LOGSTACK(R3-12); R10 := LOGSTACK(R3-8); LOGSTACK(R3-12) := R10; R10 := LOGSTACK(R3-4); LOGSTACK(R3-8) := R10; LOGSTACK(R3-4) := R0; R7 := #86000000; END; R3 := LOGPOINTER - 4; R10 := @LOGSTACK(R3); R3 := LOGSTACK(R3); MVI(0,B10(1)); FIRSTCASE := R3; R3 := INSCOUNTER - 4; FIXUP; R3 := LOGPOINTER + 4; LOGPOINTER := R3; FILLCASETABLE; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER - 8; LOGPOINTER := R3; TEST(LOGFLAG); IF = THEN BEGIN R0 := #0200; INDICATEBRANCH; END; R7 := R7 OR SIGN; RESET(LOGFLAG); IF DEBUG THEN ARG2COUNT; IF R7 ~= SIGN THEN CONVERTRESULT; END; BEGIN COMMENT IFST ; 59 IF R7 >= 0 THEN BEGIN R1 := R7 SHRL 24; IF R1 = FUNCID THEN CALLPROPROCWOPARAM; END; R7 := SIGN; R3 := LOGPOINTER + 4; LOGPOINTER := R3; R3 := INSCOUNTER; FIXUP; R3 := LOGPOINTER - 4; LOGPOINTER := R3; IF DEBUG THEN ARG2COUNT; END; BEGIN COMMENT :: ; 60 LOADREG; R7 := R7 OR SIGN; END; END; R1 := SAVER1; END; SEGMENT PROCEDURE ARG23(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; CASE R3 OF BEGIN BEGIN COMMENT IS ; 61 R0 := R0-R0; RCCLTEST; COMMENT TEST RCCL, RELEASE; RESETRECORD; R3 := LOGPOINTER + 8; LOGPOINTER := R3; R0 := 0; LOGSTACK(R3) := R0; LOGSTACK(R3-4) := R0; R0 := #0108; INDICATEBRANCH; R7 := #86000000; END; BEGIN COMMENT IFST2 ; 62 IF R7 >= 0 AND R7 ~= NULLST THEN CALLPROPROCWOPARAM; R0 := #07000000; IF DEBUG THEN EMIT; R3 := LOGPOINTER + 4; LOGPOINTER := R3; ARG2SKIP; END; NULL; 63 BEGIN COMMENT WHILEOP ; 64 IFJARG2; END; BEGIN COMMENT WHILEST ; 65 IF R7 >= 0 AND R7 ~= NULLST THEN CALLPROPROCWOPARAM; R0 := #47F0E000 OR STACKP4(R8); EMIT; ARG2SKIP; END; BEGIN COMMENT IFJ ; 66 IFJARG2; END; BEGIN COMMENT UMINUS ; 67 CONVERT; LOADREG; R6 := R7 SHLL 1 SHRL 25; R0 := LSTACKM4(R5); R3 := R0; R0 := R0 OR #03000000; ASSEMBLE; CONVERTRESULT; R7 := R7 AND OPCODEMASK; END; BEGIN COMMENT ABS ; 68 CONVERT; IF R7 < 0 THEN R3 := R7 SHLL 1 SHRL 25 ELSE GETTYPE; IF R3 < 4 THEN BEGIN LOADREG; R6 := R7 SHLL 1 SHRL 25; R0 := LSTACKM4(R5); R3 := R0; ASSEMBLE; END ELSE BEGIN SHORT INTEGER SAVETYPE; SAVETYPE := R3; STFUNCTION; R0 := @CARITHFN; R0 := NEG R0; R3 := SAVETYPE + 1; COMMENT 5 = CABS, 6 = LCABS; R3 := R3 SHLL 16; EMITCALL; R3 := SAVETYPE; IF R3 = 4 THEN BEGIN R0 := #C0000000; R7 := #82000000; END ELSE BEGIN R0:=#80000000; R7:=#83000000; END; FLREG; END; CONVERTRESULT; R7 := R7 AND OPCODEMASK; END; NULL; 69 NULL; 70 BEGIN COMMENT LOG~ ; 71 IF R7 >= 0 THEN BEGIN LOGCOMPARE; R3 := LOGPOINTER + 8; LOGPOINTER := R3; R0 := 0; LOGSTACK(R3) := R0; LOGSTACK(R3-4) := R0; R0 := #0107; INDICATEBRANCH; END ELSE BEGIN R3 := R7 SHLL 8 SHRL 24; IF R3 = 1 THEN BEGIN R0 := LSTACKM4(R5) OR CLII OR #00010000; EMIT; R3 := LOGPOINTER + 8; LOGPOINTER := R3; R0 := 0; LOGSTACK(R3) := R0; LOGSTACK(R3-4) :=R0; R3 := LSTACKM4(R5); R5 := R5 - 4; RELEASE; R0 := #0107; INDICATEBRANCH; END ELSE BEGIN R3 := LOGPOINTER; R0 := LOGSTACK1(R3) XOR #0300; LOGSTACK1(R3) := R0; END; END; R7 :=#86000000; END; BEGIN COMMENT BIT~ ; 72 LOADREG; R6 := R7 SHLL 1 SHRL 25; R0 := LSTACKM4(R5) AND MASK5 OR #57000000; R0 := R0 OR ALLONES; EMIT; END; BEGIN COMMENT ASSERT ; 73 IF R7 >= 0 THEN BEGIN GETADDRESS; RESET(R3FLAG); R0 := R3 OR #43000000; EMIT; END ELSE BEGIN EVALUATELOG; R0 := R7 SHRL 16; R3 := LSTACKM4(R5); IF R0 = #8601 THEN R0 := R3 OR #43000000 ELSE R0 := R3 AND #00F00000 SHRL 4 OR #18000000; EMIT; R6 := 6; RELEASE; R5 := R5 - 4; END; R0 := @CHECKASSERT; R0 := NEG R0; EMITCALL; R7 := SIGN; END; NULL; 74 BEGIN COMMENT GOTO ; 75 R3 := @GOTOO; ENTRYEXIT; END; NULL; 76 NULL; 77 NULL; 78 BEGIN COMMENT CARD ; 79 R3 := SAVEL; R3 := TREEP(R3); CARDNUM := R3; R0 := R7 SHRL 24; R10 := RUNERRPT; IF R0 = PROCDC THEN R1 := 0 ELSE BEGIN R1 := INSCOUNTER; R10 := R10 - 4; IF R3 = CARDTAB(R10) THEN R1 := INSCTAB(R10) ELSE IF R1 ~= INSCTAB(R10) THEN R10 := R10 + 4; END; IF R10 >= TREEBASE THEN BEGIN R3 := 6; EROR; END; INSCTAB(R10) := R1; CARDTAB(R10) := R3; R10 := @B10(4); RUNERRPT := R10; IF R7 < 0 THEN BEGIN COMMENT SON IS ',' - PROPOGATE STACK1 FIELDS; R0 := STACK1(R8); STACK1(R8-SSIZE) := R0; END; COMMENT MUST NOT RESET R7 HERE; END; BEGIN COMMENT CASE ; 80 LOGICAL TEMP; TEMP := R6; LOADREG; R10 := TEMP; R0 := TREE(R10); TEMP := R0; R0 := R0 AND MASK OR #41000000; IF CHECKFLAG THEN EMIT; R3 := LSTACKM4(R5) XOR SIGN; IF CHECKFLAG THEN BEGIN R0 := R3 OR #15000000; EMIT; R0 := #45100000 OR CASEERR; EMIT; END; R0 := R3 OR #8B000002; EMIT; R3 := LSTACKM4(R5); R6 := 1; RELEASE; MARKRECORDS; DUMPALLGENREG; DUMPALLFLREG; R0 := LSTACKM4(R5) XOR SIGN SHRL 4 OR #47F00000; EMIT; R5 := R5 - 4; R0 := INSCOUNTER - 4; R3 := LOGPOINTER + 4; R10 := TEMP SHLL 16; R0 := R0 OR R10; LOGSTACK(R3) := R0; R3 := R3 + 4; CLI(6,TEMP(1)); IF = THEN BEGIN R10 := 0; LOGSTACK(R3+4) := R10; LOGSTACK(R3) := R10; R3 := R3 + 8; END; LOGPOINTER := R3; R0 := 0; LOGSTACK(R3) := R0; END; BEGIN COMMENT UCOUNT ; 81 COMMENT TRANSMIT STACK FIELDS IF ON ARG1 SIDE; R0 := STACK(R8-SSIZE); IF R0 >= 0 THEN BEGIN R0 := STACK1(R8); R1 := STACK2(R8); STACK1(R8-SSIZE) := R0; STACK2(R8-SSIZE) := R1; END; END; END; R1 := SAVER1; END; SEGMENT PROCEDURE ARG1(R1); BEGIN LOGICAL SAVER1; PROCEDURE ARG1RELATION(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; IF R7 >= 0 THEN GETTYPE ELSE R3 := R7 SHRL 24 AND #7F; IF R3 = 6 THEN LEQUAL ELSE BEGIN CONVERT; IF R3 = 7 THEN LOADSTRING ELSE LOADREG; R6 := R6 OR R7; END; R1 := SAVER1; END; PROCEDURE ARG1LHV(R1); IF R7 >= 0 THEN BEGIN LOGICAL SAVER1; INTEGER SAVEADDR; SAVER1 := R1; GETADDRESS; SAVEADDR := R3; RESET(R3FLAG); R0 := FLAG; R(4) := R0; GENREG; R3 := R0 SHRL 8; LSTACKM4(R5) := R3; IF R3 ~= SAVEADDR THEN BEGIN R0 := R0 OR SAVEADDR OR #41000000; EMIT; END; R0 := R0-R0; R(4) := R0; R1 := SAVER1; END; PROCEDURE LCOLEQARG1(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; R3 := R6 AND #FFFF; R3 := TREE(R3); IF R3 >= 0 THEN ARG1LHV ELSE BEGIN INTEGER SAVEADDR; IF R7 >= 0 THEN BEGIN GETADDRESS; SAVEADDR := R3; GENREG; R0 := R0 OR SAVEADDR OR #43000000; EMIT; END ELSE BEGIN R0 := R7 SHRL 16; IF R0 = #8601 THEN BEGIN R0 := LSTACKM4(R5); R10 := R0 AND #F000 SHLL 8; R0 := R0 OR #43000000 OR R10; R10 := R10 OR SIGN; LSTACKM4(R5) := R10; EMIT; END ELSE EVALUATELOG; END; R7 := #86020000; END; R1 := SAVER1; END; PROCEDURE ARG1FORLIST(R1); COMMENT SAVE FOR VAR ADDR, INITIALIZE STACK; IF R7 >= 0 THEN BEGIN R0 := 0; STACKP4(R8) := R0; STACKP8(R8) := R0; R0 := IDLOC1(R7) SHLL 12 + IDLOC2(R7); R5 := R5 + 4; LSTACKM4(R5) := R0; END; PROCEDURE ARG1PARAMETER(R1); BEGIN LOGICAL SAVER1; SAVER1 := R1; IF R7 >= 0 THEN BEGIN R1 := R7 SHRL 24; IF R1 = FUNCID THEN BEGIN COMMENT ALGOL PROCEDURE; R3 := @PROCCALL; ENTRYEXIT; END ELSE BEGIN COMMENT STANDARD FUNCTION OR PROCEDURE; R0 := FLAG; STACK21(R8) := R0; COMMENT MARK STACK ENTRY; R0 := 0; R1 := R7 AND #FFFF / 12; STACK22(R8) := R1; IF R1 = READINDX THEN BEGIN R0 := #92FF0000 OR READFLAG; EMIT; END ELSE IF R1 = WRITEINDX THEN BEGIN R0 := #92FF0000 OR WRITEFLAG; EMIT; END; END; END; R0 := STACK21(R8); IF R0 ~= FLAG THEN SUBRENTRY; R1 := SAVER1; END; PROCEDURE ARG1COMMA(R1); BEGIN R0 := NEXTADDR; STACK11(R8) := R0; STACK12(R8) := R0; END; PROCEDURE ARG1COUNT(R1); COMMENT CHECKS FOR COUNT AS LEFT SUBNODE, EMITS INCREMENT; IF DEBUGFLAG THEN BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := SAVEL; R1 := TREEP(R1); IC(R0,TREE(R1)); R0 := R0 AND #7F; IF R0 = UCOUNT THEN BEGIN R0 := TREEP(R1) + COUNTBASE OR #FA300000; R3 := R3+PL11 SHLL 16; EMIT; R0 := INSCOUNTER; PPMARK := R0; END; R1 := SAVER1; END; SAVER1 := R1; COMMENT ARG1; RESET(ARGFLAG); CASE R3 OF BEGIN BEGIN COMMENT + ; 1 CONVERT; LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT - ; 2 CONVERT; LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT * ; 3 CONVERT; SET(PAIRFLAG); LOADREG; RESET(PAIRFLAG); R6 := R6 OR R7; END; BEGIN COMMENT / ; 4 CONVERT; SET(PAIRFLAG); SET(DIVIDE); LOADREG; RESET(PAIRFLAG); RESET(DIVIDE); R6 := R6 OR R7; END; BEGIN COMMENT ** ; 5 CONVERT; COMMENT ON BASE SIDE; LOADREG; R6 := R6 OR R7; STACKP4(R8) := R7; END; BEGIN COMMENT L:= ; 6 LCOLEQARG1; END; BEGIN COMMENT A:= ; 7 R3 := TREE(R6); IF R3 >= 0 THEN ARG1LHV ELSE BEGIN CONVERT; LOADREG; R6 := R6 OR R7; END; END; BEGIN COMMENT S:= ; 8 CONVERT; LOADSTRING; COMMENT FORCED RIGHT; END; BEGIN COMMENT R:= ; 9 R3 := TREE(R6); IF R3 >= 0 THEN ARG1LHV ELSE BEGIN LOADREG; R6 := R6 OR R7; END; END; NULL; 10 NULL; 11 BEGIN COMMENT STEPUNTIL ; 12 LOGICAL SAVER6; SAVER6 := R6; R6 := 0; R1 := R7 SHRL 24; IF R1 = NUMBER THEN BEGIN R1 := R7 AND #FFFF + CPTBASE; R1 := CONSPTTAB(R1) AND #FFFF; R6 := PROGRAMM(R1); END; IF R6 < 0 THEN BEGIN COMMENT NEGATIVE CONSTANT; R5 := R5+4; R1 := R1 OR #E000; LSTACKM4(R5) := R1; R0 := 1; COMMENT TYPE 1; END ELSE BEGIN LOADREG; R10 := NEXTADDR; IF R6 > 0 THEN R10 := R10 + 7 AND #FFF8 ELSE R10 := R10 + 3 AND #FFFC; NEXTADDR := R10; R3 := LSTACKM4(R5) AND #00F00000; LSTACKM4(R5) := R10; R0 := #50000000 OR R3 OR R10; EMIT; IF R6 > 0 THEN R10 := 8 ELSE BEGIN R0 := R3 SHRL 4 OR R3 OR #12000000; EMIT; R0 := #41000020 OR R3; EMIT; R0 := #47A0E006 ++ INSCOUNTER; EMIT; R0 := R3 SHRL 4 OR R3 OR #1E000000; EMIT; R0 := #50000008 OR R3 ++ R10; EMIT; R10 := 12; END; R6 := 1; R3 := R3 OR SIGN; RELEASE; R0 := R10 SHRL 2; COMMENT TYPES 2, 3; INCRADDR; END; STACKP4(R8-SSIZE) := R0; STACKP4(R8) := R0; R6 := SAVER6; END; BEGIN COMMENT DIV ; 13 R10 := TREE(R6); IF R10 > 0 THEN BEGIN SET(PAIRFLAG); SET(DIVIDE); LOADREG; RESET(PAIRFLAG); RESET(DIVIDE); END ELSE LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT REM ; 14 R10 := TREE(R6); IF R10 > 0 THEN BEGIN SET(PAIRFLAG); SET(DIVIDE); LOADREG; RESET(PAIRFLAG); RESET(DIVIDE); R6 := R6 OR R7; END ELSE LOADREG; END; BEGIN COMMENT < ; 15 ARG1RELATION; END; BEGIN COMMENT <= ; 16 ARG1RELATION; END; BEGIN COMMENT > ; 17 ARG1RELATION; END; BEGIN COMMENT >= ; 18 ARG1RELATION; END; BEGIN COMMENT = ; 19 ARG1RELATION; END; BEGIN COMMENT ~= ; 20 ARG1RELATION; END; NULL; 21 BEGIN COMMENT L:=2 ; 22 LCOLEQARG1; END; BEGIN COMMENT A:=2 ; 23 CONVERT; LOADREG; END; BEGIN COMMENT S:=2 ; 24 CONVERT; LOADSTRING; END; BEGIN COMMENT R:=2 ; 25 LOADREG; R6 := R6 OR R7; END; NULL; 26 NULL; 27 NULL; 28 BEGIN COMMENT AP) ; 29 ARG1PARAMETER; END; BEGIN COMMENT INDX ; 30 R1 := R7 SHRL 24; IF R1 = ARRAYID THEN BEGIN R3 := @INITAREF; ARRAYS; END; END; BEGIN COMMENT REFX ; 31 R3 := R7 SHRL 16 AND #FF; COMMENT RC CL NUMBER; IF ~CHECKFLAG THEN R3 := R3-R3; STACK11(R8) := R3; R3 := R7 AND #FFFF; R3 := IDLOC2(R3); STACK12(R8) := R3; GETTYPE; IF R3 = 6 THEN R1 := #10000 ELSE IF R3 = 7 THEN BEGIN GETLENGTH; R1 := R3 SHLL 16; R3 := 7; END ELSE R1 := R1-R1; R3 := R3 SHLL 24 OR R1; STACK2(R8) := R3; R7 := SIGN; END; BEGIN COMMENT IFEXP ; 32 IFSTANDEXP; R3 := 2; ARG1COUNT; END; BEGIN COMMENT , ; 33 IF R7 >= 0 THEN ARG1COMMA; IF DEBUG THEN BEGIN R0 := INSCOUNTER; IF R0 ~= PPMARK THEN BEGIN R0 := #07010000; EMIT; END; END; END; BEGIN COMMENT L, ; 34 IF R7 >= 0 THEN ARG1COMMA; END; BEGIN COMMENT SHL ; 35 R10 := TREE(R6); IF R10 < 0 THEN SHIFTAMOUNT ELSE LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT SHR ; 36 R10 := TREE(R6); IF R10 < 0 THEN SHIFTAMOUNT ELSE LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT BB ; 37 DUMPALLGENREG; DUMPALLFLREG; R3 := @BLOCKENTRY; ENTRYEXIT; END; BEGIN COMMENT END ; 38 IF R7 >= 0 THEN BEGIN R0 := NEXTADDR; STACK2(R8) := R0; DUMPALLGENREG; DUMPALLFLREG; END; END; BEGIN COMMENT PCL ; 39 R3 := @PROCENTRY; ENTRYEXIT; IF DEBUG THEN BEGIN R0 := INSCOUNTER; R3 := SAVEL - 4; IC(R1,TREE(R3)); R1 := R1 AND #7F; IF R1 ~= ENDD AND R0 ~= PPMARK THEN BEGIN R0 := #07010000; EMIT; END; END; END; BEGIN COMMENT SUBSTRIN ; 40 END; BEGIN COMMENT | ; 41 R3 := R7 SHRL 24; IF R3 = NUMBER THEN BEGIN R1 := R7 AND #FFFF + CPTBASE; R1 := CONSPTTAB(R1) AND #FFFF; R3 := PROGRAMM(R1); IF R3 < 0 THEN R3 := 0 ELSE R3 := R3 OR SIGN; END ELSE R3 := 0; STACKP4(R8) := R3; LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT AP, ; 42 ARG1PARAMETER; END; BEGIN COMMENT R, ; 43 IF R7 >= 0 THEN BEGIN R3 := R7 AND #FFFF + 12; STACKP4(R8) := R3; R3 := R3 + 12; STACKP4(R8-SSIZE) := R3; RECORDALLOCATE; END ELSE BEGIN R3 := STACKP4(R8) + 12; STACKP4(R8-SSIZE) := R3; END; R7 := #89000000; END; BEGIN COMMENT AR, ; 44 IF R7 >= 0 THEN BEGIN R3 := @INITADCL; ARRAYS; END; END; BEGIN COMMENT AR) ; 45 IF R7 >= 0 THEN BEGIN R3 := @INITADCL; ARRAYS; END; END; BEGIN COMMENT R) ; 46 IF R7 >= 0 THEN BEGIN R3 := R7 AND MASK + 12; STACKP4(R8) := R3; RECORDALLOCATE; END; END; BEGIN COMMENT LOGOR ; 47 RESET(ANDFLAG); ANDORARG1; END; BEGIN COMMENT BITOR ; 48 LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT LOGAND ; 49 SET(ANDFLAG); ANDORARG1; END; BEGIN COMMENT BITAND ; 50 LOADREG; R6 := R6 OR R7; END; BEGIN COMMENT ITERST ; 51 R3 := 0; ARG1COUNT; END; BEGIN COMMENT ITERST2 ; 52 R3 := 0; ARG1COUNT; END; BEGIN COMMENT FORLIST ; 53 ARG1FORLIST; IF R7 >= 0 THEN CHAINFOR; R6 := R6 OR #81000000; END; BEGIN COMMENT FORCL ; 54 END; BEGIN COMMENT ENDFORLI ; 55 ARG1FORLIST; IF R7 >= 0 THEN CHAINFOR; END; BEGIN COMMENT UJIFEXP ; 56 R3 := 1; ARG1COUNT; END; BEGIN COMMENT UJ ; 57 R1 := SAVEL; R1 := TREEP(R1)-4; IC(R3,TREE(R1)); R3 := R3 AND #7F; IF R3 = IFJ THEN R3 := 1 ELSE R3 := 0; ARG1COUNT; END; BEGIN COMMENT CL ; 58 R3 := 0; ARG1COUNT; END; BEGIN COMMENT IFST ; 59 IFSTANDEXP; R3 := 2; ARG1COUNT; END; BEGIN COMMENT :: ; 60 LOADREG; R6 := R6 OR R7; R3 := @LBOUND; ARRAYS; END; BEGIN COMMENT IS ; 61 R0 := R0-R0; IC(R0,RCCLNUMBER(R7)); STACK11(R8) := R0; R7 := SIGN; END; BEGIN COMMENT IFST2 ; 62 IFSTANDEXP; R3 := 1; ARG1COUNT; END; NULL; 63 BEGIN COMMENT WHILEOP ; 64 R0 := INSCOUNTER; STACKP4(R8-SSIZE) := R0; END; BEGIN COMMENT WHILEST ; 65 R3 := 1; ARG1COUNT; END; BEGIN COMMENT IFJ ; 66 MARKRECORDS; DUMPALLGENREG; DUMPALLFLREG; END; END; R1 := SAVER1; END; PROCEDURE NTITEM(R1); COMMENT R3 = NT POINTER, R2 = DICTIONARY POINTER, R0 := SI TYPE; BEGIN LOGICAL SAVER1; ARRAY 4 SHORT INTEGER RUNDICT SYN 0; SAVER1 := R1; R1 := R1-R1; R0 := IDLOC2(R3); RUNDICT(R2+0) := R0; R0 := IDNO(R3) SHLA 2; RUNDICT(R2+2) := R0; IC(R1,TYPE(R3)); IF R1 = 0 THEN BEGIN IC(R1,VR(R3)); IF R1 ~= 0 THEN R1 := #20; END; STC(R1,RUNDICT(R2+4)); R1 := R1 AND #F; IF R1 = 2 THEN R1 := TYPEINFO(R3) ELSE IF R1 = 4 THEN IC(R1,TYPEINFO(R3)) ELSE R1 := R1-R1; STC(R1,RUNDICT(R2+5)); IC(R1,SIMPLETYPE(R3)); STC(R1,RUNDICT(R2+6)); R0 := R1; IF R1 = 7 THEN R1 := SIMTYPEINFO(R3) ELSE BEGIN IC(R1,SITYPELEN(R1)); DECR(R1); END; STC(R1,RUNDICT(R2+7)); R2 := @B2(8); R1 := SAVER1; END; SEGMENT PROCEDURE OUTPUTSEG(R1); BEGIN COMMENT PRODUCE OBJECT MODULE FOR SEGMENT; COMMENT SEE SRL FORM Y28-6610 FOR FORMATS AND CODES; ARRAY 5 LOGICAL SAVERS; ARRAY 20 INTEGER CARD; ARRAY 40 SHORT INTEGER SCARD SYN CARD; SHORT INTEGER SB2 SYN B2; BYTE SD SYN 0, ER SYN 2; ARRAY 2 INTEGER PTLIMS; INTEGER PTLOW SYN PTLIMS(0); COMMENT START ADDRESS OF FIELD; INTEGER PTHIGH SYN PTLIMS(4); COMMENT START ADDRESS OF SEQNO; ARRAY 3 SHORT INTEGER MVTREE=(#D200S,@B1,@B2), MVTXT=(#D200S,@CARD(16),@B1), MVCARD=(#D200S,@CARD(16),@B3); PROCEDURE MOVETREE(R1); COMMENT MOVES TREE TO RECOVER SPACE; IF COMPACTED THEN BEGIN R3 := 4; EROR; END ELSE BEGIN ARRAY 3 LOGICAL SAVE13; STM(R1,R3,SAVE13); SET(COMPACTED); R0 := TREELINK; IF R0 < 0 THEN R12 := COMSTART ELSE BEGIN R1 := RUNERRSTART + 1024; IF R1 < RUNERRPT THEN R1 := RUNERRPT; R0 := TREEBASE - R1; COMMENT R0 = SIZE OF FREE SPACE (MUST BE POSITIVE); R3 := R12 - TREEBASE; COMMENT # BYTES TO MOVE; R2 := TREEBASE; TREEBASE := R1; WHILE R3 > 256 DO BEGIN MVC(255,B1,B2); R3 := R3 - 256; R1 := @B1(256); R2 := @B2(256); END; DECR(R3); EX(R3,MVTREE); R1 := @TREELINK; WHILE R1 > 0 DO COMMENT FIX-UP TREE LINKS; BEGIN R2 := MEM(R1) - R0; MEM(R1) := R2; R1 := R2; END; R12 := R12 - R0; END; R0 := @CARD; R1 := R12; R3 := APUTCARD; BALR(R2,R3); LM(R1,R3,SAVE13); END; PROCEDURE CARDOUT(R1); COMMENT SET LENGTH FIELD, PUNCH, CLEAR; BEGIN INTEGER SAVER1, SAVER3; SAVER1 := R1; SAVER3 := R3; IF R2 ~= PTLOW THEN BEGIN R0 := R2 - PTLOW; SCARD(10) := R0; R0 := SEQNO+1; SEQNO := R0; CVD(R0,PKDEC); UNPK(4,2,CARD(75),PKDEC(5)); OI("0",CARD(79)); R0 := @CARD; R1 := R12; R3 := APUTCARD; BALR(R2,R3); WHILE R0 < 0 DO MOVETREE; COMMENT ATTEMPT ERROR RECOVERY; END; MVI(" ",CARD(16)); MVC(54,CARD(17),CARD(16)); R2 := @CARD(16); R1 := SAVER1; R3 := SAVER3; END; PROCEDURE SETNAME(R1); COMMENT R0 - SEGNO, NAME TO B2; IF R0 = 0 THEN MVC(7,B2,"AWXRCTBL") ELSE IF R0 >= XSN THEN BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := 255 - R0 SHLA 3; R1 := @ESDICT(R1); MVC(7,B2,B1); R1 := SAVER1; END ELSE IF R0 = 1 THEN MVC(7,B2,ESDROOT) ELSE BEGIN IF R0 < 0 THEN MVC(4,B2,"AWXSL") ELSE MVC(4,B2,ESDROOT); R0 := ABS R0; CVD(R0,PKDEC); UNPK(2,1,B2(5),PKDEC(6)); OI("0",B2(7)); END; PROCEDURE OUTITEM(R1); COMMENT OUTPUT NAME TABLE ENTRY; BEGIN LOGICAL SAVER1; SAVER1 := R1; R1 := R1-R1; IC(R1,TYPE(R3)); R0 := R1 AND #F; IF R1 ~= R0 OR R0 = 0 OR R0 = 2 OR R0 = 6 THEN BEGIN R0 := @B2(8); IF R0 > PTHIGH THEN CARDOUT; IF R2 = PTLOW THEN BEGIN R0 := 1; SCARD(14) := R0; CARD(4) := R4; MVI(" ",CARD(4)); END; NTITEM; R4 := R4 + 8; END; R1 := SAVER1; END; PROCEDURE OUTBLOCK(R1); COMMENT OUTPUT NAME TABLE BLOCK; IF R3 ~= 0 THEN BEGIN LOGICAL SAVER1; INTEGER NTLIM; SAVER1 := R1; R1 := NPOINT(R3); R0 := R1 + BLENGTH(R3) - 12; NTLIM := R0; FOR R3 := R1 STEP 12 UNTIL NTLIM DO OUTITEM; R1 := SAVER1; END; STM(R0,R4,SAVERS); MVC(7,CARD(72)," "); MVI(#02,CARD); R2 := @CARD(16); R3 := @CARD(72); STM(R2,R3,PTLIMS); MVC(3,CARD(1),"ESD "); MVC(66,CARD(5),CARD(4)); R2 := @CARD(16); R4 := 1; SCARD(14) := R4; R0 := LOGSEG; SETNAME; R0 := 0; B2(8) := R0; MVI(SD,B2(8)); R0 := INSCOUNTER; R1 := LOGSEG; IF R1 ~= 0 THEN BEGIN R1 := RUNERRPT; CLI(0,DEBUGSW); IF ~= THEN BEGIN R1 := @B1(4); RUNERRPT := R1; R0 := R0 + SEGNTLEN; END; R1 := R1 - RUNERRSTART; R0 := R0 + R1; END; B2(12) := R0; MVI(" ",B2(12)); R2 := @B2(16); FOR R3 := 4 STEP 4 UNTIL SEGTABIDX DO BEGIN R0 := SEGNO(R3); IF R0 ~= LOGSEG THEN BEGIN R4 := R4 + 1; R0 := @B2(16); IF R0 > PTHIGH THEN BEGIN CARDOUT; SCARD(14) := R4; END; R0 := SEGNO(R3); SETNAME; R0 := 0; B2(8) := R0; MVI(ER,B2(8)); R2 := @B2(16); END; END; CARDOUT; MVC(3,CARD(1),"TXT "); MVC(8,CARD(5),CARD(4)); R3 := 0; WHILE R3 < INSCOUNTER DO BEGIN R0 := 1; SCARD(14) := R0; CARD(4) := R3; MVI(" ",CARD(4)); R0 := INSCOUNTER - R3; IF R0 > 56 THEN R0 := 56; SCARD(10) := R0; R4 := R0-1; R1 := @PROGRAM(R3); EX(R4,MVTXT); R3 := R3+R0; R2 := R2+R0; CARDOUT; END; R0 := LOGSEG; IF R0 ~= 0 THEN BEGIN R3 := RUNERRSTART; WHILE R3 < RUNERRPT DO BEGIN R0 := 1; SCARD(14) := R0; R0 := R3 - RUNERRSTART + INSCOUNTER; CARD(4) := R0; MVI(" ",CARD(4)); R0 := RUNERRPT - R3; IF R0 > 56 THEN R0 := 56; SCARD(10) := R0; R4 := R0 - 1; EX(R4,MVCARD); R3 := R3 + R0; R2 := R2 + R0; CARDOUT; END; COMMENT OUTPUT SEGMENT NAME TABLE; CLI(0,DEBUGSW); IF ~= THEN BEGIN R4 := PROGRAM(18) + 4; R3 := PROCLINK; OUTBLOCK; R3 := BLOCKLINK; OUTBLOCK; R3 := FORLINK; WHILE R3 ~= 0 DO BEGIN OUTITEM; R3 := SIMTYPEINFO(R3); END; CARDOUT; END; END; R0 := LOGSEG; IF R0 ~= 0 THEN BEGIN MVC(3,CARD(1),"RLD "); MVC(10,CARD(5),CARD(4)); R0 := 1; SB2(0) := R0; SB2(2) := R0; R1 := 8; B2(4) := R1; MVI(#0C,B2(4)); R2 := @B2(8); R0 := INSCOUNTER; IF R0 > 4096 THEN BEGIN R0 := 1; SB2(0) := R0; SB2(2) := R0; R1 := 12; B2(4) := R1; MVI(#0C,B2(4)); R2 := @B2(8); END; R4 := 1; FOR R3 := 4 STEP 4 UNTIL SEGTABIDX DO BEGIN R0 := @B2(8); IF R0 > PTHIGH THEN CARDOUT; R0 := 1; SB2(2) := R0; R0 := CHAIN(R3); B2(4) := R0; R0 := SEGNO(R3); IF R0 = LOGSEG THEN BEGIN MVI(#0C,B2(4)); R0 := 1; END ELSE BEGIN MVI(#1C,B2(4)); R4 := R4 + 1; R0 := R4; END; SB2(0) := R0; R2 := @B2(8); END; CARDOUT; END; MVC(3,CARD(1),"END "); MVC(10,CARD(5),CARD(4)); R0 := " "; R2 := R2 + R0; COMMENT FORCE BLANK COUNT; CARDOUT; LM(R0,R4,SAVERS); END; COMMENT * * * EXECUTION * * * ; INTEGER STACKORG; BYTE FINISHED; COMMENT USED IN TREE PROCESSING; ARRAY 64 LOGICAL WORKAREA SYN STACK; INTEGER SAVER1; SAVER1 := R1; XC(15,FLAGS,FLAGS); RESET(COMPACTED); COMMENT RESET FLAGS; MVI(" ",OWBUF); MVC(130,OWBUF(1),OWBUF); MVC(131,HEADING,OWBUF); MVC(3,HEADING(113),"PAGE"); MVC(26,HEADING,"NUMAC ALGOL W (31MAY71) "); R0 := FLAG; R(0) := R0; R(2) := R0; R0 := R0-R0; FOR R1 := 4 STEP 2 UNTIL 26 DO R(R1) := R0; F(0) := R0; F(2) := R0; F(4) := R0; F(6) := R0; SET(DEBUGFLAG); RESET(DEBUG); CLI(2,DEBUGSW); IF < THEN RESET(DEBUGFLAG) ELSE IF > THEN SET(DEBUG); R0 := 0; CARDNUM := R0; CODELENGTH := R0; SEQNO := R0; CTABLENGTH := R0; NTABLENGTH := R0; SEGTABIDX := R0; PUMREC := R0; PMREC := R0; R0 := @STACK - R14; R1 := SSEGLEN-R0+SSIZE; STACKORG := R1; COMMENT SEARCH NAMETABLE TO BUILD RECTABLE IN WORKAREA; R2 := NRECCLASS+1 SHLA 4; R1 := R1-R1; R6 := R2 - 4; IF R2 < 256 THEN BEGIN R0 := #FFFFFFFF; WORKAREA(R2+4) := R0; R2 := R2 + 8; END; FOR R6 := R6 STEP _4 UNTIL 0 DO WORKAREA(R6) := R1; R10 := @WORKAREA; R2 := R2 + R10; FOR R6 := 0 STEP 12 UNTIL NAMETABLESIZE DO BEGIN SHORT INTEGER RECLEN SYN WORKAREA(8), NUMREF SYN WORKAREA(10), NTLINK SYN WORKAREA(14); IC(R1,TYPE(R6)); IF R1 = 4 THEN BEGIN COMMENT RECORD CLASS; R8 := TYPEINFO(R6) AND #F SHLL 4; COMMENT RCCL# * 16; R0 := SIMTYPEINFO(R6); RECLEN(R8) := R0; R0 := R2 - R10; NTLINK(R8) := R0; R3 := R6; NTITEM; R6 := R6-R6; IC(R6,TYPEINFO(R3)); R6 := R6*12S + R3; R9 := R9-R9; FOR R3 := R3+12 STEP 12 UNTIL R6 DO BEGIN NTITEM; IF R0 = 9 THEN R9 := R9 + 1; END; NUMREF(R8) := R9; R1 := R1-R1; END; END; IF ~PROCCOMP THEN BEGIN R0 := R0-R0; LOGSEG := R0; SEGTABIDX := R0; R0 := R2 - R10; INSCOUNTER := R0; NTABLENGTH := R0; R12 := TREETOP; OUTPUTSEG; R0 := R0-R0; CODELENGTH := R0; END; R1 := REFRECBASE; RUNERRSTART := R1; R2 := TREELINK; WHILE R2 >= 0 DO BEGIN R1 := MEM(R2); TREELINK := R1; R1 := @MEM(R2+12); R12 := R1; COMMENT ESTABLISH TREE BASE; R1 := R1 + RIGHTHALF(R1) + 4; COMMENT CONSTANT POINTER BASE; R0 := MEM(R1+4) + 7 AND #FFF8; LITORG := R0; R0 := @MEM(R1+8); CPTBASE := R0; R0 := MEM(R1) - 4; CONSPTTABL := R0; R1 := R1 + MEM(R1) + 4; COMMENT CONSTANT TABLE BASE; R0 := @MEM(R1+4); CONSTAB := R0; R0 := MEM(R1); CONSTABL := R0; R1 := RUNERRSTART; MVC(7,B1,B2(4)); COMMENT PROC ID; R1 := @B1(8); RUNERRPT := R1; R0 := 0; INSCOUNTER := R0; LPOINTER := R0; LOGPOINTER := R0; R2 := R0; R4 := R0; R5 := R0; COMMENT RESET STACK INDICES; R8 := STACKORG; R0 := SIGN; STACK(R8) := R0; R9 := TREEP(0); RESET(FINISHED); COMMENT * * * TREE TRANSVERSAL ALGORITHM * * *; WHILE ~FINISHED DO BEGIN R10 := TREE(R9); IF R10 < TERMINALNODE THEN BEGIN COMMENT NON-TERMINAL, TREE SWITCH IS SIGN BIT; R8 := R8 + SSIZE; IF R8 <= INSCOUNTER THEN BEGIN R3 := 2; EROR; END; IF R10 < 0 THEN BEGIN COMMENT BINARY OPERATOR, TREE SWITCH IS ON; STACK(R8) := R9; R9 := R9 - 4; END ELSE IF R10 < UNARYOP THEN BEGIN COMMENT BINARY OPERATOR, TREE SWITCH IS OFF; STACK(R8) := R9; R9 := TREEP(R9); END ELSE BEGIN COMMENT UNARY OPERATOR; R10 := R9 OR SIGN; STACK(R8) := R10; R9 := R9 - 4; END; END ELSE BEGIN COMMENT TERMINAL NODE - INITIATES PROCESSING; R7 := R10; R6 := STACK(R8); R5 := STACKP(R8); WHILE R6 < 0 AND ~FINISHED DO BEGIN COMMENT ARG2 PROCESSING; IC(R3,TREE(R5)); R3 := R3 AND #7F; COMMENT OPERATOR; SAVEL := R5; R5 := LPOINTER; COMMENT LSTACK INDEX; IF R3 <= 34 THEN ARG21 ELSE IF R3 <= 60 THEN BEGIN R3 := R3 - 34; ARG22; END ELSE BEGIN R3 := R3 - 60; ARG23; END; LPOINTER := R5; R8 := R8 - SSIZE; IF R8 = STACKORG THEN SET(FINISHED); R9 := STACKP(R8); R6 := STACK(R8); R5 := R9; END; IF R6 >= 0 THEN BEGIN COMMENT ARG1 PROCESSING, STACK NOT EMPTY; IC(R3,TREE(R5)); R3 := R3 AND #7F; COMMENT OPERATOR; SAVEL := R5; R5 := LPOINTER; COMMENT LSTACK INDEX; ARG1; LPOINTER := R5; R5 := SAVEL; R10 := SIGN OR R6; STACK(R8) := R10; R10 := TREE(R5); IF R10 >= 0 THEN R9 := R5-4 ELSE R9 := TREEP(R5); END; END; END; R5 := LPOINTER; IF R2 ~= 0 OR R4 ~= 0 OR R5 ~= 0 THEN BEGIN R3 := 3; EROR; END; R0 := INSCOUNTER; PROGRAM(16) := R0; R0 := R0 SHLL 16; R1 := RUNERRPT; B1(0) := R0; R1 := @B1(4); RUNERRPT := R1; R0 := R1 - RUNERRSTART + INSCOUNTER; PROGRAM(18) := R0; R0 := SEGIDNO; SB1(0) := R0; R0 := SEGNTLEN - 8; SB1(2) := R0; R0 := CODELENGTH + INSCOUNTER; CODELENGTH := R0; R0 := RUNERRPT - RUNERRSTART + CTABLENGTH; CTABLENGTH := R0; R0 := NTABLENGTH + SEGNTLEN + 4; NTABLENGTH := R0; OUTPUTSEG; IC(R1,TRACEIT); R1 := R1 AND #F; IF R1 ~= 0 AND R1 ~= 6 THEN BEGIN IF R1 ~= 3 THEN MVI("1",CARRCONT); MVC(7,OWBUF(4),"SEGMENT "); MVC(51,OWBUF(12),OWBUF(11)); R0 := LOGSEG; CVD(R0,PKDEC); UNPK(1,7,OWBUF(13),PKDEC); OI("0",OWBUF(14)); R0 := @OWBUF; WRITE; R14 := SAVE14; WORK := R2; UNPK(8,4,OWBUF(1),WORK); WORK := R4; UNPK(8,4,OWBUF(10),WORK); R5 := LPOINTER; WORK := R5; UNPK(8,4,OWBUF(19),WORK); TR(25,OWBUF(1),OTRTABLE(_240)); MVI(" ",OWBUF(9)); MVI(" ",OWBUF(18)); WRITE; MVC(62,OWBUF(1),OWBUF); OI("0",CARRCONT); R14 := SAVE14; IF R1 ~= 3 THEN WRITEALL; END; R2 := TREELINK; END; R1 := SAVER1; END; SAVER1 := R1; LEVEL2; R1 := SAVER1; END; SAVER1 := R1; LEVEL1; R1 := SAVER1; END; SAVER1 := R1; LEVEL0; R1 := SAVER1; END; SEGMENT BASE R3; ARRAY 256 INTEGER MNEMONIC =("****************SPM BALRBCTRBCR ********************************" ,"LPR LNR LTR LCR NR CLR OR XR LR CR AR SR MR DR ALR SLR " ,"LPDRLNDRLTDRLCDRHDR ************LDR CDR ADR SDR MDR DDR AWR SWR " ,"LPERLNERLTERLCERHER ************LER CER AER SER MER DER AUR SUR " ,"STH LA STC IC EX BAL BCT BC LH CH AH SH MH ****CVD CVB " ,"ST ************N CL O X L C A S M D AL SL " ,"STD ****************************LD CD AD SD MD DD AW SW " ,"STE ****************************LE CE AE SE ME DE AU SU " ,"************************BXH BXLESRL SLL SRA SLA SRDLSLDLSRDASLDA" ,"STM TM MVI TS NI CLI OI XI LM ****************************" ,"****************************************************************" ,"****************************************************************" ,"****************************************************************" ,"****MVN MVC MVZ NC CLC OC XC ****************TR TRT ED EDMK" ,"****************************************************************" ,"****MVO PACKUNPK****************ZAP CP AP SP MP DP ********" ); MNBASE := R3; OLDSAVE := R5; MVC(63,XFERVECTOR,B1); # R0 := #2600; R1 := #4A00; R3 := AGETMAIN; BALR(R2,R3); R14 := R0; SAVE14 := R14; SSEGLEN := R1; R11 := COMSTART; LEVELA; R0 := 0; ERXIT: R6 := R0; MVI("0",CARRCONT); MVC(63,OWBUF(6), " SECONDS IN COMPILATION, (XXXXX, XXXXX) BYTES OF CODE GENERATED "); R3 := AGETTIME; BALR(R2,R3); R1 := R0 -- COMMTIME; R1 := R1*5/1920; CVD(R1,PKDEC); UNPK(4,2,OWBUF(1),PKDEC(5)); MVC(2,OWBUF(0),OWBUF(1)); MVI(".",OWBUF(3)); OI("0",OWBUF(5)); R0 := CODELENGTH; CVD(R0,PKDEC); UNPK(4,2,OWBUF(32),PKDEC(5)); IF DEBUGFLAG THEN R0 := EDITBASE - COMMLIM(4) ELSE R0 := 0; CVD(R0,PKDEC); UNPK(4,2,OWBUF(39),PKDEC(5)); OI("0",OWBUF(36)); OI("0",OWBUF(43)); MVC(61,OWBUF(70),OWBUF(69)); R0 := @OWBUF; WRITE; IF DEBUGFLAG THEN BEGIN MVI(" ",OWBUF(0)); MVC(130,OWBUF(1),OWBUF); MVC(36,OWBUF(2),"DIRECTORY SIZES (XXXXX, XXXXX, XXXXX)"); R0 := CTABLENGTH; CVD(R0,PKDEC); UNPK(4,2,OWBUF(19),PKDEC(5)); R0 := NTABLENGTH; CVD(R0,PKDEC); UNPK(4,2,OWBUF(26),PKDEC(5)); R0 := IDLISTBASE - IDDIRBASE; CVD(R0,PKDEC); UNPK(4,2,OWBUF(33),PKDEC(5)); OI("0",OWBUF(23)); OI("0",OWBUF(30)); OI("0",OWBUF(37)); R0 := @OWBUF; WRITE; END; R0 := SAVE14; R1 := SSEGLEN; R3 := AFREEMAIN; BALR(R2,R3); R13 := OLDSAVE; R15 := R6; END; R14 := B13(12); LM(R0,R12,B13(20)); END.