~>|sed -e '/ *$/s/ *$/~~~~/' -e '/~~~~/s///' >a68s1ce.pp 00100 (*CODE EMITTER*) 00110 (**************) 00111 Things needing attention 00112 OCVIMMPTR and OCVIMMLONG (see PARAM and EMITOP) 00120 (**) 00130 (*+01() (*$T-+) ()+01*) 00140 (*+02() (*$T-+) ()+02*) 00150 (*-05() 00160 PROCEDURE LOAD (WHERE:SBTTYP; SB:PSB); FORWARD; 00170 PROCEDURE EMITEND; FORWARD; 00180 PROCEDURE EMITX1 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT); FORWARD; 00190 PROCEDURE EMITX2 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT); FORWARD; 00200 FUNCTION GENLCLGBL (VAR OPCOD:POP; SB:PSB):OFFSETR; FORWARD; 00210 PROCEDURE FIXUPF(ALABL:LABL);FORWARD; 00220 FUNCTION FIXUPM: LABL; FORWARD; 00230 PROCEDURE UNSTKP1(TYP:OPDTYP; OPND:PSB); FORWARD; 00240 ()-05*) 00250 PROCEDURE EMITOP (OPCOD:POP); FORWARD; 00260 PROCEDURE GENDENOT (OPCOD:POP; SB:PSB); FORWARD; 00270 FUNCTION GETNEXTLABEL: LABL; 00280 BEGIN GETNEXTLABEL := NEXTLABEL; NEXTLABEL := NEXTLABEL+1 END; 00290 (**) 00300 (**) 00310 (*+32() 00320 (*-01() PROCEDURE HALT; VAR I,K: INTEGER; BEGIN I:=0;K := K DIV I END; ()-01*) 00330 PROCEDURE ASSERT (ASSERTION:BOOLEAN; REASON:ALFA); 00340 BEGIN 00350 IF NOT (ASSERTION) THEN 00360 BEGIN 00370 WRITELN(OUTPUT,' ASSERT FAILED ',REASON); 00380 (*+01() PUTSEG(OUTPUT); ()+01*) 00390 EMITEND; 00400 HALT 00410 END 00420 END; 00430 (**) 00440 ()+32*) 00450 (* PERQ CODE EMITTER *) 00460 (*********************) 00470 (*+05() 00480 PROCEDURE PARAM(TYP:OPDTYP; OPND:INTEGER; OPCOD: POP; ALIGN: INTEGER; FIRSTIME: BOOLEAN); FORWARD; 00490 PROCEDURE EMITOPRAND(TYP:OPDTYP;OPERAND:ADDRINT); 00500 VAR REC: RECORD CASE SEVERAL OF 00510 1: (INT:ADDRINT); 00520 2: (LEX:PLEX); 00530 3,4,5,6,7,8,9,10: () 00540 END; 00550 I:INTEGER; 00560 BEGIN 00570 CASE TYP OF 00580 OCVIMMED: WRITE(LGO[ROUTNL^.RNLEVEL],' ',OPERAND:1); 00590 OCVFREF,OCVMEM,OCVFIM: 00600 WRITE(LGO[ROUTNL^.RNLEVEL],' L',OPERAND:1); 00610 OCVEXT: BEGIN 00620 REC.INT := OPERAND; 00630 WRITE(LGO[ROUTNL^.RNLEVEL], '_'); 00640 FOR I := 1 TO 7 DO 00650 (*IF REC.LEX^.S10[I]<>' ' THEN WRITE(LGO[ROUTNL^.RNLEVEL], CHR(ORD(REC.LEX^.S10[I])+32));*) 00660 WRITE(LGO[ROUTNL^.RNLEVEL], REC.LEX^.S10[I]); 00670 END 00680 END; 00690 END; 00700 (**) 00710 PROCEDURE EMITXWORD(TYP:OPDTYP;OPERAND:ADDRINT); 00720 VAR REC: RECORD CASE SEVERAL OF 00730 1: (INT:ADDRINT); 00740 2: (LEX:PLEX); 00750 3,4,5,6,7,8,9,10: () 00760 END; 00770 I:INTEGER; 00780 BEGIN 00790 (*+32() ASSERT(TYP<>OCVFIM, 'EMITXWORD '); ()+32*) 00800 IF TYP=OCVIMMED THEN WRITE(LGO[ROUTNL^.RNLEVEL],' int ') 00810 ELSE WRITE(LGO[ROUTNL^.RNLEVEL], ' ptrw '); 00820 EMITOPRAND(TYP,OPERAND); 00830 WRITELN(LGO[ROUTNL^.RNLEVEL]); 00840 END; 00850 (**) 00860 PROCEDURE EMITXPROC(TYP:OPDTYP;OPERAND:ADDRINT); 00870 VAR REC: RECORD CASE SEVERAL OF 00880 1: (INT:ADDRINT); 00890 2: (LEX:PLEX); 00900 3,4,5,6,7,8,9,10: () 00910 END; 00920 I:INTEGER; 00930 BEGIN 00940 WRITE(LGO[ROUTNL^.RNLEVEL],' ptrf ');EMITOPRAND(TYP,OPERAND); 00950 WRITELN(LGO[ROUTNL^.RNLEVEL]); 00960 END; 00970 (**) 00980 PROCEDURE EMITALF(OPERAND: ALFA); 00990 VAR I: INTEGER; 01000 BEGIN 01010 IF DATASTATE=STARTDATA THEN 01020 BEGIN WRITELN(LGO[ROUTNL^.RNLEVEL], 'data'); DATASTATE := INDATA END; 01030 WRITE(LGO[ROUTNL^.RNLEVEL], ' byte '); FOR I := 1 TO 9 DO WRITE(LGO[ROUTNL^.RNLEVEL], ORD(OPERAND[I]):3, ','); 01040 WRITELN(LGO[ROUTNL^.RNLEVEL], ORD(OPERAND[10]):3); 01050 END; 01060 (**) 01070 (**) 01080 PROCEDURE EMITOP (* (OPCOD:POP) *); 01090 VAR I,COUNT:INTEGER; JUMPOVER:LABL; 01100 TEMP:INTEGER; OP:MNEMONICS; 01110 PARAMNOTUSED: BOOLEAN; 01120 BEGIN 01130 IF DATASTATE<>OUTDATA THEN 01140 BEGIN DATASTATE := OUTDATA; WRITELN(LGO[ROUTNL^.RNLEVEL], 'text') END; 01150 COUNT := 0; PARAMNOTUSED := TRUE; 01160 WHILE OPCOD <> 0 DO WITH CODETABLE[OPCOD] DO 01170 BEGIN 01180 IF INLINE THEN 01190 BEGIN 01200 IF PERQCOD='CI ' THEN 01210 IF OCV=OCVFIM THEN WRITE(LGO[ROUTNL^.RNLEVEL], ' cil ') 01220 ELSE IF (OCV=OCVMEM) OR (OCV=OCVFREF) OR (OCV=OCVEXT) THEN WRITE(LGO[ROUTNL^.RNLEVEL], ' lga ') 01230 ELSE WRITE(LGO[ROUTNL^.RNLEVEL], ' ci ') 01240 ELSE IF OPCOD<>PNOOP THEN 01242 BEGIN 01250 WRITE(LGO[ROUTNL^.RNLEVEL],' '); 01260 FOR i := 1 TO 8 DO 01270 WRITE(LGO[ROUTNL^.RNLEVEL],CHR(ORD(PERQCOD[I])+32*ORD(ORD(PERQCOD[I])>63))); 01280 END; 01290 CASE PARTYP OF 01300 WOP,ACP: (* OPERAND SUPPLIED BY CODETABLE *) 01310 WRITE(LGO[ROUTNL^.RNLEVEL], ' ', PARM:1); 01320 WNP,ANP: (*NEGATIVE OPERAND SUPPLIED BY CODETABLE*) 01330 WRITE(LGO[ROUTNL^.RNLEVEL], ' ', -PARM:1); 01340 OPX,ACX: (* OPERAND IS SUPPLIED BY CODE GENERATOR *) 01350 BEGIN EMITOPRAND(OCV, OPRAND+PARM); PARAMNOTUSED := FALSE END; 01360 ONX,ANX: (* NEGATIVE OPERAND SUPPLIED BY CODE GENERATOR*) 01370 BEGIN EMITOPRAND(OCV, -OPRAND-PARM); PARAMNOTUSED := FALSE END; 01380 JMP: (* P-OP GENERATES ITS OWN LABELS FOR LOOPS ETC. *) 01390 BEGIN 01400 COUNT := PARM; 01410 JUMPOVER := GETNEXTLABEL; 01420 WRITE(LGO[ROUTNL^.RNLEVEL],' L',JUMPOVER:1); 01430 END; 01440 NON: (* NO OPERAND *); 01450 GBX: (* GLOBAL LABEL EXPECTED *) 01460 BEGIN WRITE(LGO[ROUTNL^.RNLEVEL],' L',OPRAND:1); PARAMNOTUSED := FALSE END; 01470 LCX: (* INSTRUCTION LABEL EXPECTED *) 01480 BEGIN WRITE(LGO[ROUTNL^.RNLEVEL],' L',OPRAND:1); PARAMNOTUSED := FALSE END; 01490 MOR: (* LONG OPERAND FOLLOWS IN NEXT OPCOD *) 01500 BEGIN OPCOD := NEXT; 01510 WRITE(LGO[ROUTNL^.RNLEVEL], CODETABLE[OPCOD].PERQCOD); 01520 END; 01530 END; (* OF CASE *) 01540 IF PARTYP>=ACP THEN BEGIN ADJUSTSP := ADJUSTSP+SZWORD; PARAMNOTUSED := FALSE END; 01550 IF OPCOD<>PNOOP THEN WRITELN(LGO[ROUTNL^.RNLEVEL]); 01560 IF (PERQCOD[1]=' ') AND (REGSINUSE.ECOUNT<>0) THEN EMITOP(PDISCARD); 01570 OPCOD := CODETABLE[OPCOD].NEXT; 01572 IF COUNT = 1 THEN WRITELN(LGO[ROUTNL^.RNLEVEL],' L',JUMPOVER: 1,':'); 01574 COUNT := COUNT-1; 01580 END 01590 ELSE 01600 BEGIN 01610 IF PARAMNOTUSED THEN PARAM(OCVNONE, 0, OPCOD, 0, FALSE); 01620 WRITE(LGO[ROUTNL^.RNLEVEL],' ','call _',ROUTINE); WRITELN(LGO[ROUTNL^.RNLEVEL]) ; 01630 OPCOD := 0; 01640 (*+32() ASSERT((RTSTKDEPTH+ADJUSTSP) MOD 4 = 0, 'EMITOP - A'); ()+32*) 01650 IF COUNT = 1 THEN WRITELN(LGO[ROUTNL^.RNLEVEL],' L',JUMPOVER: 1,':'); 01700 COUNT := COUNT-1; 01702 IF ADJUSTSP<>0 THEN EMITX1(PASP, OCVIMMED, ADJUSTSP); 01710 END; 01750 END; 01760 END; 01770 (**) 01780 PROCEDURE FIXUPF (*+05() (ALABL:LABL) ()+05*); 01790 BEGIN 01800 IF DATASTATE=STARTDATA THEN 01810 BEGIN WRITELN(LGO[ROUTNL^.RNLEVEL], 'data'); WRITELN(LGO[ROUTNL^.RNLEVEL], 'align4'); DATASTATE := INDATA END 01820 ELSE IF DATASTATE=ENDDATA THEN 01830 BEGIN WRITELN(LGO[ROUTNL^.RNLEVEL], 'text'); DATASTATE := OUTDATA END; 01840 WRITELN(LGO[ROUTNL^.RNLEVEL],'L',ALABL:1,':'); 01850 END; 01860 (**) 01870 FUNCTION FIXUPM:LABL; 01880 VAR L:LABL; 01890 BEGIN 01900 IF DATASTATE=STARTDATA THEN 01910 BEGIN WRITELN(LGO[ROUTNL^.RNLEVEL], 'data'); WRITELN(LGO[ROUTNL^.RNLEVEL], 'align4'); DATASTATE := INDATA END 01920 ELSE IF DATASTATE=ENDDATA THEN 01930 BEGIN WRITELN(LGO[ROUTNL^.RNLEVEL], 'text'); DATASTATE := OUTDATA END; 01940 L := GETNEXTLABEL; 01950 FIXUPM := L; 01960 WRITELN(LGO[ROUTNL^.RNLEVEL],'L',L:1,':'); 01970 END; 01980 (**) 01990 PROCEDURE FIXUPFIM(ALABL:LABL;VALUE:A68INT); 02000 BEGIN 02010 WRITELN(LGO[ROUTNL^.RNLEVEL], ' constant L', ALABL:1, ' ', VALUE: 1); 02020 END; 02030 (**) 02040 PROCEDURE FIXLABL(OLDLABL,NEWLABL:LABL; KNOWN:BOOLEAN); 02050 VAR JUMPOVER: LABL; 02060 BEGIN 02070 JUMPOVER := GETNEXTLABEL; 02080 WRITELN(LGO[ROUTNL^.RNLEVEL], ' jump L', JUMPOVER:1); 02090 WRITELN(LGO[ROUTNL^.RNLEVEL], 'L',OLDLABL:1, ':'); 02100 WRITELN(LGO[ROUTNL^.RNLEVEL], ' jump L', NEWLABL:1); 02110 WRITELN(LGO[ROUTNL^.RNLEVEL], 'L',JUMPOVER:1, ':'); 02120 END; 02130 FUNCTION NORMAL(SB: PSB): SBTTYP; 02140 (*RETURNS THE SBTTYP IN WHICH VALUES OF MODE SB^.SBMODE SHOULD BE STORED DURING BALANCES*) 02150 BEGIN WITH SB^ DO WITH SBMODE^.MDV DO 02160 IF SBTYP=SBTDL THEN NORMAL := SBTDL 02170 ELSE IF SBUNION IN SBINF THEN NORMAL := SBTSTKN 02180 ELSE IF SBNAKED IN SBINF THEN NORMAL := SBTFPR0 02190 ELSE IF MDPILE THEN NORMAL := SBTE 02200 ELSE CASE MDLEN OF 02210 0: NORMAL := SBTVOID; 02220 2: NORMAL := SBTE; 02230 4: NORMAL := SBTFPR0; 02240 END; 02250 END; 02260 (**) 02270 FUNCTION LENOF(SB: PSB): INTEGER; 02280 BEGIN 02290 WITH SB^,SBMODE^.MDV DO 02300 IF SBUNION IN SBINF THEN LENOF := SBLEN 02310 ELSE IF SBNAKED IN SBINF THEN LENOF := SZNAKED 02320 ELSE IF MDPILE THEN LENOF := SZADDR 02330 ELSE LENOF := MDLEN; 02340 END; 02350 (**) 02360 PROCEDURE LOADSTK(SB: PSB); 02370 BEGIN 02380 (*+21() WRITELN(OUTPUT, 'LOADSTK ', ORD(SB)); ()+21*) 02390 IF NOT(SB^.SBTYP IN [SBTSTKN,SBTDL]) THEN 02400 CASE LENOF(SB) OF 02410 0: LOAD(SBTVOID, SB); 02420 2: LOAD(SBTSTK, SB); 02430 4: LOAD(SBTSTK4, SB); 02440 END; 02450 END; 02460 (**) 02470 PROCEDURE TWIST; 02480 VAR TEMPPTR : PSB; 02490 NORM: SBTTYP; 02500 BEGIN 02510 (*+21() WRITELN(OUTPUT, 'TWIST'); ()+21*) 02520 IF [RTSTACK^.SBRTSTK^.SBTYP , RTSTACK^.SBTYP] * [SBTVOID..SBTDEN] = [] THEN 02530 (*NEITHER SB IS A FAKE*) 02540 BEGIN 02550 IF RTSTACK^.SBTYP IN [SBTSTK..SBTDL] THEN 02560 LOAD(NORMAL(RTSTACK),RTSTACK); (*GET IT INTO REGISTER 3*) 02570 TEMPPTR := RTSTACK^.SBRTSTK; 02580 RTSTACK^.SBRTSTK := TEMPPTR^.SBRTSTK; 02590 TEMPPTR^.SBRTSTK := RTSTACK; 02600 RTSTACK := TEMPPTR; 02610 IF RTSTACK^.SBTYP IN [SBTSTK..SBTDL] THEN 02620 BEGIN 02630 NORM := NORMAL(RTSTACK); 02640 IF NORM IN [SBTFPR0..SBTFPR3] THEN IF NORM IN REGSINUSE.FPR THEN NORM := SBTFPR1; 02650 LOAD(NORM,RTSTACK) (*GET IT INTO A REGISTER TOO*) 02660 END 02670 ELSE IF (RTSTACK^.SBTYP IN [SBTE,SBTER0]) AND (RTSTACK^.SBRTSTK^.SBTYP IN [SBTE,SBTER0]) THEN 02680 EMITOP(PSWAP) 02690 END 02700 ELSE BEGIN 02710 TEMPPTR := RTSTACK^.SBRTSTK; 02720 RTSTACK^.SBRTSTK := TEMPPTR^.SBRTSTK; 02730 TEMPPTR^.SBRTSTK := RTSTACK; 02740 RTSTACK := TEMPPTR 02750 END 02760 END; 02770 (**) 02780 PROCEDURE HOIST(HOISTLEN, LEN:INTEGER; ALIGN: BOOLEAN); 02782 (*HOISTLEN IS AMOUNT ALREADY STACKED; LEN IS TOTAL AMOUNT TO BE STACKED*) 02790 BEGIN 02800 IF ((RTSTKDEPTH-HOISTLEN+LEN) MOD 4 = 0) = ALIGN THEN 02810 BEGIN 02820 IF HOISTLEN=0 THEN EMITOP(PALIGN) 02830 ELSE 02840 BEGIN 02850 HOISTLEN := HOISTLEN-RTSTKDEPTH; CLEAR(RTSTACK); HOISTLEN := HOISTLEN+RTSTKDEPTH; 02860 EMITX1(PHEAVE, OCVIMMED, HOISTLEN); 02870 END; 02880 ADJUSTSP := ADJUSTSP+SZWORD; 02890 END; 02900 END; 02910 (**) 02920 PROCEDURE PROC1OP(OPCOD:POP;TYP:OPDTYP;OPND:INTEGER;NOTINL:BOOLEAN;ALIGN:INTEGER); 02930 VAR SB, SB1: PSB; 02940 HOISTLEN,LEN: INTEGER; 02950 BEGIN 02960 SB:=ASPTR(OPND); 02962 SB^.SBINF := SB^.SBINF-[SBSTKDELAY]; 02970 IF RTSTACK<>SB THEN TWIST; 02972 WITH CODETABLE[OPCOD] DO 02974 BEGIN 02980 IF NOTINL THEN WITH SB^ DO 02990 BEGIN 03000 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN LOADSTK(SBRTSTK) 03010 ELSE CLEAR(SBRTSTK); 03020 IF TYP=OCVSBS THEN 03030 BEGIN 03040 HOISTLEN := SUBSTLEN([SBTSTK..SBTDL]); 03050 LEN := HOISTLEN+LENOF(SB)*ORD(NOT(SB^.SBTYP IN [SBTSTK..SBTDL])); 03060 END 03070 ELSE BEGIN 03080 LEN := LENOF(SB)*ORD(P1 IN [SBTSTK..SBTDL,SBTPR1,SBTPR2]); 03090 HOISTLEN := SBLEN*ORD(SB^.SBTYP IN [SBTSTK..SBTDL]); 03100 END; 03110 HOIST(HOISTLEN, LEN, NOT ODD(ALIGN+APARAMS)); 03120 END; 03150 REPEAT 03151 IF PR IN (REGSINUSE.FPR-[P1]) THEN 03152 BEGIN SB1 := RTSTACK; 03153 WHILE NOT(SB1^.SBTYP IN (REGSINUSE.FPR-[P1])) DO SB1 := SB1^.SBRTSTK; 03155 CLEAR(SB1); 03156 END; 03157 LOAD(P1, SB); 03158 UNTIL P1 IN [SBTSTKN,SBTPR1,SBTPR2,SBTXN,SB^.SBTYP]; (*ESTACK MAY HAVE OVERFLOWED*) 03160 UNSTKP1(TYP,SB); 03180 END; 03190 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*) 03200 END; 03210 (**) 03220 PROCEDURE PROC2OP(OPCOD:POP;TYP1:OPDTYP;OPND1:INTEGER;TYP2:OPDTYP;OPND2:INTEGER;NOTINL:BOOLEAN;ALIGN:INTEGER); 03230 VAR SB1, SB2, SB3: PSB; 03240 HOISTLEN,LEN1,LEN2: INTEGER; 03250 BEGIN 03260 SB1:=ASPTR(OPND1); 03262 SB1^.SBINF := SB1^.SBINF-[SBSTKDELAY]; 03270 SB2:=ASPTR(OPND2); 03271 SB2^.SBINF := SB2^.SBINF-[SBSTKDELAY]; 03272 WITH CODETABLE[OPCOD] DO 03274 BEGIN 03280 IF NOTINL THEN WITH RTSTACK^.SBRTSTK^ DO 03290 BEGIN 03300 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN LOADSTK(SBRTSTK) 03310 ELSE CLEAR(SBRTSTK); 03312 IF TYP1=OCVSBS THEN 03314 HOIST(SUBSTLEN([SBTSTK..SBTDL]), SUBSTLEN([SBTID..SBTFPR1]), ODD(ALIGN+APARAMS)) 03316 ELSE 03318 BEGIN 03320 LEN1 := LENOF(SB1)*ORD(P1 IN [SBTSTK..SBTDL,SBTPR1,SBTPR2]); 03322 LEN2 := LENOF(SB2)*ORD(P2 IN [SBTSTK..SBTDL,SBTPR1,SBTPR2]); 03330 HOISTLEN := SB1^.SBLEN*ORD(SB1^.SBTYP IN [SBTSTK..SBTDL]) 03340 +SB2^.SBLEN*ORD(SB2^.SBTYP IN [SBTSTK..SBTDL]); 03350 HOIST(HOISTLEN, LEN1+LEN2, ODD(ALIGN+APARAMS)); 03352 END; 03360 END; 03370 IF RTSTACK<>SB2 THEN TWIST; 03400 IF (SB2^.SBTYP IN [SBTSTK..SBTSTKN,SBTVAR]) OR ((P1 IN REGSINUSE.FPR) AND (P1<>SB1^.SBTYP)) THEN 03410 LOAD(P2,SB2); 03412 REPEAT 03413 IF PR IN (REGSINUSE.FPR-[P1,P2]) THEN 03414 BEGIN SB3 := RTSTACK; 03415 WHILE NOT(SB3^.SBTYP IN (REGSINUSE.FPR-[P1,P2])) DO SB3 := SB3^.SBRTSTK; 03416 CLEAR(SB3); 03418 END; 03420 LOAD(P1, SB1); 03430 LOAD(P2, SB2); 03432 UNTIL (P1 IN [SBTSTKN,SBTPR1,SBTPR2,SBTXN,SB1^.SBTYP]) AND 03434 (P2 IN [SBTSTKN,SBTPR1,SBTPR2,SBTXN,SB2^.SBTYP]); (*ESTACK MAY HAVE OVERFLOWED*) 03440 UNSTKP1(TYP2,SB2); 03450 UNSTKP1(TYP1,SB1); 03470 END; 03480 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*) 03490 END; 03500 (**) 03510 PROCEDURE FILL (WHERE:SBTTYP; SB:PSB); 03520 BEGIN 03530 WITH SB^ DO WITH REGSINUSE DO 03540 BEGIN 03550 IF SBTYP IN [SBTER0..SBTFPR3] THEN FPR := FPR-[SBTYP]; 03560 IF SBTYP IN [SBTE,SBTER0] THEN ECOUNT := ECOUNT-1 03570 ELSE IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH := RTSTKDEPTH-SBLEN; 03572 SBTYP:=WHERE; 03580 IF NOT(WHERE IN [SBTSTKN,SBTDL,SBTXN]) THEN SBLEN := LENARRAY[WHERE]; 03590 IF WHERE IN [SBTSTK..SBTDL] THEN 03600 BEGIN 03610 RTSTKDEPTH := RTSTKDEPTH+SBLEN; 03620 WITH ROUTNL^ DO 03630 IF RTSTKDEPTH>RNLENSTK THEN RNLENSTK:=RTSTKDEPTH 03640 END 03650 ELSE 03654 BEGIN 03660 IF WHERE IN [SBTE,SBTER0] THEN 03662 BEGIN ECOUNT := ECOUNT+1; IF ECOUNT>=6 THEN CLEAR(RTSTACK) END; 03670 IF WHERE IN [SBTER0..SBTFPR3] THEN FPR := FPR+[WHERE]; 03674 END; 03690 END 03700 END; 03710 (**) 03720 FUNCTION SETINLINE (OPCOD:POP):BOOLEAN; 03730 VAR INL:BOOLEAN; 03740 BEGIN 03750 APARAMS := 0; 03760 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*) 03770 REPEAT WITH CODETABLE[OPCOD] DO 03780 BEGIN 03790 APARAMS := APARAMS+ORD(PARTYP IN [ACP,ANP]); (*NUMBER OF SECRET PARAMETERS*) 03800 INL := INLINE; 03810 OPCOD := NEXT 03820 END 03830 UNTIL NOT(INL) OR (OPCOD=0); 03840 SETINLINE := INL 03850 END; 03860 (**) 03870 (**) 03880 PROCEDURE LOAD (*+05() (WHERE:SBTTYP; SB:PSB) ()+05*); 03890 (*EMITS CODE TO MOVE SB TO WHERE: CALLS FILL TO RECORD THE MOVE*) 03900 VAR TEMPOP: POP; 03910 TOFFSET: INTEGER; 03920 TEMPTYP: SBTTYP; 03930 OCVFIX: OPDTYP; 03940 TWISTED: BOOLEAN; 03950 TYPS: SET OF SBTTYP; 03960 SB1, SB2: PSB; 03970 SAVE, EC:INTEGER; 03980 BEGIN 03990 (*+21() WRITELN(OUTPUT, 'LOAD ',ORD(SB):5,ORD(SB^.SBTYP):3,' TO ', ORD(WHERE):3, SB=RTSTACK); ()+21*) 04000 WITH SB^ DO 04010 BEGIN 04012 SBINF := SBINF-[SBSTKDELAY]; 04020 IF SBRTSTK<>NIL THEN 04030 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN 04040 LOADSTK(SBRTSTK); 04050 IF (WHERE IN [SBTSTK..SBTDL]) THEN CLEAR(SBRTSTK); 04060 TWISTED := FALSE; 04070 IF WHERE IN [SBTSTKN,SBTPR1,SBTPR2] THEN 04080 LOADSTK(SB) 04090 ELSE IF WHERE=SBTXN THEN LOAD(NORMAL(SB),SB) 04100 ELSE 04110 IF WHERE <> SBTVOID THEN 04120 BEGIN 04140 IF WHERE IN [SBTER0..SBTFPR3] THEN 04150 IF (WHERE IN REGSINUSE.FPR) AND (WHERE<>SBTYP) THEN 04160 BEGIN 04170 SB1 := RTSTACK; 04180 WHILE NOT(SB1^.SBTYP IN REGSINUSE.FPR) DO SB1 := SB1^.SBRTSTK; 04190 LOADSTK(SB1); 04200 END; 04240 TYPS := [WHERE, RTSTACK^.SBTYP]; 04250 IF (RTSTACK<>SB) THEN 04260 IF (TYPS <= [SBTSTK..SBTDL]) AND NOT(SBTYP IN [SBTSTK..SBTDL]) OR (TYPS<=[SBTE,SBTER0]) THEN 04270 BEGIN TWISTED:=TRUE; TWIST; 04280 (*+32() ASSERT (RTSTACK =SB,'LOAD-B '); ()+32*) 04290 END; 04310 TEMPOP := POPARRAY[WHERE,SBTYP]; 04320 (*+32() ASSERT(TEMPOP<>PNONE, 'LOAD-C '); ()+32*) 04330 IF (TEMPOP<>PNOOP) OR (SBTYP=SBTSTKR0) THEN 04340 CASE SBTYP OF 04350 SBTRPROC,SBTPROC,SBTVAR: BEGIN 04360 SAVE := ADJUSTSP; ADJUSTSP := 0; 04370 RTSTKDEPTH := RTSTKDEPTH+SAVE; 04380 IF WHERE <> SBTE THEN BEGIN LOAD(SBTE,SB); LOAD(WHERE,SB) END 04390 ELSE BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB); 04400 IF SBTYP=SBTVAR THEN 04410 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVIMMED,TOFFSET) 04420 ELSE BEGIN (*SBTPROC OR SBTRPROC*) 04430 IF SBTYP=SBTPROC THEN OCVFIX := OCVMEM 04440 ELSE (* SBTRPROC *) OCVFIX := OCVFREF; 04450 EMITX2(TEMPOP,OCVFIX,SBXPTR,OCVIMMED,TOFFSET); 04460 END; 04470 END; 04480 RTSTKDEPTH := RTSTKDEPTH-SAVE; 04490 ADJUSTSP := SAVE; 04500 END; 04510 (**) 04520 SBTID,SBTIDV: BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB); 04530 EMITX1(TEMPOP,OCVIMMED,TOFFSET) END; 04540 SBTLIT: EMITX1(TEMPOP, OCVIMMED, SBVALUE); 04550 SBTDEN: GENDENOT(TEMPOP,SB); 04560 SBTPR1,SBTPR2, 04570 SBTSTK,SBTSTK4,SBTDL,SBTER0: EMITOP(TEMPOP); 04580 SBTE: WITH REGSINUSE DO 04600 BEGIN 04610 (*ATTEMPT TO STACK E MUST FORCE STACKING OF ALL E'S ABOVE IT; 04612 THESE ARE THE EXTRAS*) 04620 SB1 := RTSTACK; EEXTRA := 0; EC := ECOUNT; TEMPOP := TEMPOP+ORD(EC=2)+ORD(EC>2); 04630 REPEAT WITH SB1^ DO (*PREVENT CLEAR IF TEMPOP IS AN OCODE*) 04632 BEGIN 04634 IF SBTYP=SBTE THEN 04636 BEGIN FILL(SBTSTK, SB1); EEXTRA := EEXTRA+1 END 04637 ELSE IF SBTYP=SBTER0 THEN 04638 BEGIN FILL(SBTSTKR0, SB1); EEXTRA := 0 END 04639 ELSE IF SBTYP IN [SBTFPR0,SBTFPR1] THEN EEXTRA := 0; 04640 SB2 := SB1; SB1 := SBRTSTK; 04642 END 04644 UNTIL SB2=SB; 04650 EMITX1(TEMPOP, OCVIMMED, ECOUNT); 04660 EEXTRA := EC-EEXTRA; 04661 (*NO. OF E'S OR ER0'S ABOVE FIRST FPR, OR ABOVE & INCL. FIRST ER0*) 04662 END; 04670 SBTSTKR0,SBTFPR0,SBTFPR1: WITH REGSINUSE DO 04680 BEGIN 04690 IF EEXTRA<>0 THEN 04700 BEGIN 04710 EMITX1(PSTKTOE+ORD(EEXTRA=2)+ORD(EEXTRA>2), OCVIMMED, EEXTRA); 04720 SB1 := RTSTACK; 04722 WHILE EEXTRA>0 DO WITH SB1^ DO 04723 BEGIN 04724 IF SBTYP=SBTSTK THEN 04725 BEGIN FILL(SBTE, SB1); EEXTRA := EEXTRA-1 END 04726 ELSE IF SBTYP=SBTSTKR0 THEN 04727 BEGIN FILL(SBTER0, SB1); EEXTRA := EEXTRA-1 END; 04728 SB1 := SBRTSTK; 04729 END; 04730 END; 04740 EMITOP(TEMPOP); 04750 END; 04760 END; 04770 FILL(WHERE,SB); 04780 END; 04790 IF TWISTED THEN TWIST; 04800 END; 04810 END; 04820 (**) 04830 PROCEDURE PARAM (*(TYP:OPDTYP; OPND:INTEGER; OPCOD: POP; ALIGN: INTEGER; FIRSTIME: BOOLEAN)*); 04840 VAR TEMPOP:POP; 04850 OPERANDUSED, INL: BOOLEAN; 04860 BEGIN 04870 IF OCV<>OCVNONE THEN 04880 BEGIN 04890 TEMPOP := PPUSHIM; 04900 EMITOP(TEMPOP) ; ADJUSTSP := ADJUSTSP+SZWORD; 04910 END; 04920 IF FIRSTIME AND (((RTSTKDEPTH+ADJUSTSP) MOD 4 = 0) = ODD(ALIGN+APARAMS)) THEN 04930 BEGIN EMITOP(PALIGN); ADJUSTSP := ADJUSTSP+SZWORD END; 04940 OPRAND:=OPND; OCV := TYP; 04950 END; 04960 (**) 04970 ()+05*) 04980 (**) 04990 (*+01() (*+31() (*$T+ +) ()+31+) ()+01*) 05000 (*+05() (*+31() (*$T+ +) ()+31+) ()+05*) 05010 (**) 05020 (**) 05030 (**) 05040 PROCEDURE CLEAR (SB:PSB); 05050 (*ENSURES THAT NOTHING ON RTSTACK FROM SB DOWNWARDS IS IN A REGISTER*) 05060 LABEL 9; 05070 VAR TEMPPTR: PSB; 05080 BEGIN 05090 (*INVARIANT: IF SBTYP IN [SBTSTK..SBTSTKN], NOTHING BELOW SB IS IN A REGISTER*) 05100 TEMPPTR:=SB; 05110 WHILE TEMPPTR<>NIL DO WITH TEMPPTR^ DO 05120 IF SBTYP>SBTSTKN THEN 05130 BEGIN LOADSTK(TEMPPTR); GOTO 9 END 05140 ELSE IF SBTYP>=SBTSTK THEN GOTO 9 (*BECAUSE OF INVARIANT*) 05150 ELSE TEMPPTR := SBRTSTK; 05160 9: 05170 END; 05180 (**) 05190 (*-23() 05200 ()-23*) 05210 PROCEDURE UNSTKP1 (*+05() (TYP:OPDTYP; OPND:PSB) ()+05*); 05220 BEGIN 05230 IF TYP = OCVSBS THEN 05240 (*ASSERT: OPND = RTSTACK*) 05250 REPEAT 05260 OPND := RTSTACK; 05270 UNSTACKSB; 05280 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN; 05290 OPND^.SBTYP := SBTVOID; 05300 UNTIL OPND=SRSTK[SRSUBP+1].SB 05310 ELSE IF TYP <> OCVSBP THEN 05320 BEGIN UNSTACKSB; 05330 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN; 05340 OPND^.SBTYP:=SBTVOID; 05350 END 05360 (*+02() ELSE (*TYP=OCVSBP*) ADJUSTSP := ADJUSTSP-LENOF(OPND); ()+02*) 05370 END; 05380 (**) 05390 (*-23() 05400 ()-23*) 05410 (**) 05420 PROCEDURE EMITX0(OPCOD: POP); 05430 BEGIN IF NOT SETINLINE(OPCOD) THEN BEGIN ADJUSTSP := 0; CLEAR(RTSTACK) END; 05440 (*+05() PARAM(OCVNONE,0,OPCOD,0,NOT SETINLINE(OPCOD)); ()+05*) 05450 EMITOP(OPCOD); 05460 END; 05470 (**) 05480 (**) 05490 PROCEDURE EMITX1 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT) ()+05*); 05500 VAR SB1:PSB; NOTINL:BOOLEAN; 05510 BEGIN 05520 (*-24()(*+23() WRITELN(LGO[ROUTNL^.RNLEVEL]); ()+23*) ()-24*) 05530 IF TYP1 = OCVRES THEN 05540 BEGIN 05550 SB1 := ASPTR(OPND1); 05560 EMITX0 (OPCOD); 05570 (*+32() ASSERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX1-A '); 05580 ASSERT(SB1^.SBTYP=SBTVOID,'EMITX1-B '); ()+32*) 05590 FILL(CODETABLE[OPCOD].PR,SB1); 05600 SB1^.SBRTSTK:=RTSTACK; RTSTACK:=SB1; 05610 END 05620 ELSE 05630 BEGIN 05640 NOTINL := NOT(SETINLINE(OPCOD)); 05650 IF NOTINL THEN ADJUSTSP := 0; 05660 IF TYP1 >= OCVSB THEN 05670 PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),1()+05*)) 05680 ELSE 05690 BEGIN 05700 IF NOTINL THEN CLEAR(RTSTACK); 05710 (*+01() NEXTREG := 0; ()+01*) 05720 PARAM(TYP1,OPND1,OPCOD(*+05(),1,NOTINL()+05*)); 05730 END; 05740 EMITOP(OPCOD) 05750 END 05760 END; 05770 (**) 05780 (**) 05790 PROCEDURE EMITX2 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; 05800 TYP2:OPDTYP; OPND2:ADDRINT) ()+05*); 05810 VAR SB2:PSB; NOTINL:BOOLEAN; 05820 BEGIN 05830 (*+23() WRITELN(LGO[ROUTNL^.RNLEVEL]); ()+23*) 05840 IF TYP2 = OCVRES THEN 05850 BEGIN 05860 SB2 := ASPTR(OPND2); 05870 EMITX1 (OPCOD, TYP1,OPND1); 05880 (*+32() ASSERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX2-A '); 05890 ASSERT(SB2^.SBTYP=SBTVOID,'EMITX2-B '); ()+32*) 05900 FILL(CODETABLE[OPCOD].PR,SB2); 05910 SB2^.SBRTSTK:=RTSTACK; RTSTACK:=SB2; 05920 END 05930 ELSE 05940 BEGIN 05950 NOTINL := NOT(SETINLINE(OPCOD)); 05960 IF NOTINL THEN ADJUSTSP := 0; 05970 IF TYP1 >= OCVSB THEN 05980 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),2()+05*)) 05990 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),2()+05*)); 06000 PARAM(TYP2,OPND2,OPCOD(*+05(),1,FALSE()+05*)) END 06010 ELSE 06020 BEGIN 06030 IF NOTINL THEN CLEAR(RTSTACK); 06040 (*+01() NEXTREG:=0; ()+01*) 06050 PARAM(TYP1,OPND1,OPCOD(*+05(),2,NOTINL()+05*)); 06060 PARAM(TYP2,OPND2,OPCOD(*+05(),1,FALSE()+05*)) 06070 END; 06080 EMITOP(OPCOD) 06090 END 06100 END; 06110 (**) 06120 (**) 06130 PROCEDURE EMITX3 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT; 06140 TYP3:OPDTYP; OPND3:ADDRINT); 06150 VAR SB3:PSB; NOTINL:BOOLEAN; 06160 BEGIN 06170 (*+23() WRITELN(LGO[ROUTNL^.RNLEVEL]); ()+23*) 06180 IF TYP3 = OCVRES THEN 06190 BEGIN 06200 SB3 := ASPTR(OPND3); 06210 EMITX2 (OPCOD, TYP1,OPND1, TYP2,OPND2); 06220 (*+32() ASSERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX3-A '); 06230 ASSERT(SB3^.SBTYP=SBTVOID,'EMITX3-B '); ()+32*) 06240 FILL(CODETABLE[OPCOD].PR,SB3); 06250 SB3^.SBRTSTK:=RTSTACK; RTSTACK:=SB3; 06260 END 06270 ELSE 06280 BEGIN 06290 NOTINL := NOT(SETINLINE(OPCOD)); 06300 IF NOTINL THEN ADJUSTSP := 0; 06310 IF TYP1 >= OCVSB THEN 06320 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),3()+05*)) 06330 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),3()+05*)); 06340 PARAM(TYP2,OPND2,OPCOD(*+05(),2,FALSE()+05*)) END 06350 ELSE 06360 BEGIN 06370 IF NOTINL THEN CLEAR(RTSTACK); 06380 (*+01() NEXTREG:=0; ()+01*) 06390 PARAM(TYP1,OPND1,OPCOD(*+05(),3,NOTINL()+05*)); 06400 PARAM(TYP2,OPND2,OPCOD(*+05(),2,FALSE()+05*)) 06410 END; 06420 PARAM(TYP3,OPND3,OPCOD(*+05(),1,FALSE()+05*)); 06430 EMITOP(OPCOD) 06440 END 06450 END; 06460 (**) 06470 (**) 06480 PROCEDURE EMITX4 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT; 06490 TYP3:OPDTYP; OPND3:ADDRINT; TYP4:OPDTYP;OPND4:ADDRINT); 06500 VAR SB4:PSB; NOTINL:BOOLEAN; 06510 BEGIN 06520 (*+23() WRITELN(LGO[ROUTNL^.RNLEVEL]); ()+23*) 06530 IF TYP4 = OCVRES THEN 06540 BEGIN 06550 SB4 := ASPTR(OPND4); 06560 EMITX3 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3); 06570 (*+32() ASSERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX4-A '); 06580 ASSERT(SB4^.SBTYP=SBTVOID,'EMITX4-B '); ()+32*) 06590 FILL(CODETABLE[OPCOD].PR,SB4); 06600 SB4^.SBRTSTK:=RTSTACK; RTSTACK:=SB4; 06610 END 06620 ELSE 06630 BEGIN 06640 NOTINL := NOT(SETINLINE(OPCOD)); 06650 IF NOTINL THEN ADJUSTSP := 0; 06660 IF TYP1 >= OCVSB THEN 06670 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),4()+05*)) 06680 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),4()+05*)); 06690 PARAM(TYP2,OPND2,OPCOD(*+05(),3,FALSE()+05*)) END 06700 ELSE 06710 BEGIN 06720 IF NOTINL THEN CLEAR(RTSTACK); 06730 (*+01() NEXTREG:=0; ()+01*) 06740 PARAM(TYP1,OPND1,OPCOD(*+05(),4,NOTINL()+05*)); 06750 PARAM(TYP2,OPND2,OPCOD(*+05(),3,FALSE()+05*)) 06760 END; 06770 PARAM(TYP3,OPND3,OPCOD(*+05(),2,FALSE()+05*)); 06780 PARAM(TYP4,OPND4,OPCOD(*+05(),1,FALSE()+05*)); 06790 EMITOP(OPCOD) 06800 END 06810 END; 06820 (**) 06830 (**) 06840 PROCEDURE EMITX5 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT; 06850 TYP3:OPDTYP;OPND3:ADDRINT;TYP4:OPDTYP;OPND4:ADDRINT;TYP5:OPDTYP;OPND5:ADDRINT); 06860 VAR SB5:PSB; NOTINL:BOOLEAN; 06870 BEGIN 06880 (*+23() WRITELN(LGO[ROUTNL^.RNLEVEL]); ()+23*) 06890 IF TYP5 = OCVRES THEN 06900 BEGIN 06910 SB5 := ASPTR(OPND5); 06920 EMITX4 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3,TYP4,OPND4); 06930 (*+32() ASSERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX5-A '); 06940 ASSERT(SB5^.SBTYP=SBTVOID,'EMITX5-B '); ()+32*) 06950 FILL(CODETABLE[OPCOD].PR,SB5); 06960 SB5^.SBRTSTK:=RTSTACK; RTSTACK:=SB5; 06970 END 06980 ELSE 06990 BEGIN 07000 NOTINL := NOT(SETINLINE(OPCOD)); 07010 IF NOTINL THEN ADJUSTSP := 0; 07020 IF TYP1 >= OCVSB THEN 07030 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),5()+05*)) 07040 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),5()+05*)); 07050 PARAM(TYP2,OPND2,OPCOD(*+05(),4,FALSE()+05*)) END 07060 ELSE 07070 BEGIN 07080 IF NOTINL THEN CLEAR(RTSTACK); 07090 (*+01() NEXTREG:=0; ()+01*) 07100 PARAM(TYP1,OPND1,OPCOD(*+05(),5,NOTINL()+05*)); 07110 PARAM(TYP2,OPND2,OPCOD(*+05(),4,FALSE()+05*)) 07120 END; 07130 PARAM(TYP3,OPND3,OPCOD(*+05(),3,FALSE()+05*)); 07140 PARAM(TYP4,OPND4,OPCOD(*+05(),2,FALSE()+05*)); 07150 PARAM(TYP5,OPND5,OPCOD(*+05(),1,FALSE()+05*)); 07160 EMITOP(OPCOD) 07170 END 07180 END; 07190 (**) 07200 (**) 07210 (*-23() 07220 ()-23*) (* MORE PERQ DEPENDENT ROUTINES *) 07230 (**) (********************************) 07240 (*+05() 07250 PROCEDURE EMITBEG; 07260 VAR TEMP : PLEX; 07270 S: ARGSTRING; 07280 I,J: INTEGER; 07290 PROCEDURE NAMEFILE(S: ARGSTRING; SU, SL: INTEGER; VAR F: ANYFILE); EXTERN; 07300 FUNCTION GETARG(VAR S: ARGSTRING; SU, SL: INTEGER; I: INTEGER): BOOLEAN; EXTERN; 07310 BEGIN 07320 NEXTLABEL := 1; 07330 DATASTATE := ENDDATA;(* ??? *) 07340 ADJUSTSP := 0; 07350 WITH REGSINUSE DO 07360 BEGIN 07370 ECOUNT := 0; 07380 EEXTRA := 0; 07390 FPR := []; 07400 END; 07410 IF GETARG(S, 50, 1, 2) THEN 07420 BEGIN 07430 J := 1; WHILE S[J]<>CHR(0) DO J := J+1; S[J+1] := CHR(0); 07440 FOR I := 0 TO LASTRNLEVEL DO 07450 BEGIN S[J] := CHR(I+ORD('0')); NAMEFILE(S, 50, 1, LGO[I]); REWRITE(LGO[I]) END; 07460 END; 07470 (*+33() WRITELN(LGO[ROUTNL^.RNLEVEL], 'stab "a68",8#44,0,0,_AL68_'); ()+33*) 07480 WRITELN(LGO[ROUTNL^.RNLEVEL],'global _AL68_'); 07490 WRITELN(LGO[ROUTNL^.RNLEVEL],'function _AL68_'); 07492 ROUTNL^.RNADDRESS := GETNEXTLABEL; 07494 WRITELN(LGO[ROUTNL^.RNLEVEL],'function L', ROUTNL^.RNADDRESS:1); 07500 ROUTNL^.RNPROCBLK := GETNEXTLABEL; 07502 WRITELN(LGO[ROUTNL^.RNLEVEL], 'data'); 07504 WRITELN(LGO[ROUTNL^.RNLEVEL], 'int 1,1,1,1'); 07506 (*so that no dblock has address < maxsize of undressed value*) 07510 EMITX1(PASP, OCVFIM, ROUTNL^.RNPROCBLK); 07520 EMITX0(PPBEGIN+1); 07530 EMITX0(PPBEGIN); 07540 END; 07550 (**) 07560 (**) 07570 FUNCTION EMITRTNHEAD: LABL; 07580 VAR L: LABL; 07590 BEGIN 07600 L := GETNEXTLABEL; 07610 (*+33() WRITELN(LGO[ROUTNL^.RNLEVEL], 'stab "a68",8#44,0,0,L', L:1); ()+33*) 07620 WRITELN(LGO[ROUTNL^.RNLEVEL], 'function L', L:1); 07630 EMITRTNHEAD := L; 07640 END; 07650 (**) 07660 (**) 07670 PROCEDURE EMITEND; 07680 BEGIN 07690 WITH ROUTNL^ DO IF (RNLENIDS MOD 4) = 0 THEN RNLENIDS := RNLENIDS+SZWORD; 07700 FIXUPFIM(ROUTNL^.RNPROCBLK, -(ROUTNL^.RNLENIDS+SIZIBTOP+SZWORD+FIRSTIBOFFSET)); 07710 RTSTKDEPTH := 0; 07720 EMITX0(PPEND); 07730 WRITELN(LGO[ROUTNL^.RNLEVEL],' return'); 07740 END; 07750 ()+05*) 07760 (**) 07770 (*+05() 07780 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ; 07790 VAR I: INTEGER; 07800 ALABL: LABL; 07810 THING: OBJECT; 07820 BEGIN WITH SB^ DO 07830 WITH SBLEX^ (*A LEXEME*) DO 07840 IF SBLEX=LEXFALSE THEN 07850 EMITX1(OPCOD, OCVIMMED, 0) 07860 ELSE IF SBLEX=LEXTRUE THEN 07870 EMITX1(OPCOD, OCVIMMED, TRUEVALUE) 07880 ELSE IF ((SBMODE=MDINT) OR (SBMODE=MDBITS) OR (SBMODE=MDCHAR)) 07890 AND (LXTOKEN=TKDENOT) THEN 07900 EMITX1(OPCOD, OCVIMMED, LXDENRP) 07910 ELSE 07920 BEGIN 07930 IF LXV.LXPYPTR=0 THEN 07940 BEGIN 07950 DATASTATE := STARTDATA; ALABL := FIXUPM; 07960 LXV.LXPYPTR := ALABL; 07970 IF SBMODE^.MDV.MDPILE THEN WITH THING DO 07980 BEGIN 07990 FIRSTWORD := 0; PCOUNT := 255; 08000 EMITXWORD(OCVIMMED, FIRSTWORD); 08010 EMITXWORD(OCVIMMED, 0); 08012 EMITXWORD(OCVIMMED, 0); 08014 EMITXWORD(OCVIMMED, 0); 08020 EMITXWORD(OCVIMMED, LXDENRP); 08030 FOR I := 3 TO LXCOUNT DO 08040 EMITXWORD(OCVIMMED, INTEGERS[I]) 08050 END 08060 ELSE IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN 08070 BEGIN 08080 EMITXWORD(OCVIMMED, -2); 08090 EMITXPROC(OCVEXT, ORD(SBLEX)); 08100 END 08110 ELSE 08120 BEGIN 08130 EMITXWORD(OCVIMMED,INTEGERS[2]); 08140 EMITXWORD(OCVIMMED,INTEGERS[3]); 08150 END; 08160 END; 08170 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR) 08180 END; 08190 END; 08200 (**) 08210 PROCEDURE GENDP(M: MODE); 08220 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH, 08230 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV. 08240 *) 08250 VAR OFFSET: 0..127; 08260 PROCEDURE DBLOCK(M: MODE); 08270 VAR I, J: INTEGER; 08280 BEGIN WITH M^ DO 08290 FOR I := 0 TO MDV.MDCNT-1 DO 08300 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO 08310 IF MDDRESSED THEN 08320 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END 08330 ELSE IF MDID=MDIDSTRUCT THEN 08340 DBLOCK(MDSTRFMD) 08350 ELSE OFFSET := OFFSET+MDLEN 08360 END; 08370 PROCEDURE DBLOCKM(M: MODE); 08380 VAR I: INTEGER; X: XTYPE; 08390 BEGIN WITH M^ DO 08400 FOR I := 0 TO MDV.MDCNT-1 DO 08410 WITH MDSTRFLDS[I] DO 08420 BEGIN X := TX(MDSTRFMD); 08430 IF X=12 THEN DBLOCKM(MDSTRFMD) 08440 ELSE EMITXWORD(OCVIMMED, X+1) 08450 END 08460 END; 08470 BEGIN WITH M^ DO 08480 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD) 08490 ELSE IF MDV.MDID=MDIDSTRUCT THEN 08500 BEGIN 08510 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*) 08520 BEGIN 08530 DATASTATE := STARTDATA; MDSTRSDB := FIXUPM; 08540 EMITXWORD(OCVIMMED, MDV.MDLEN); 08550 OFFSET := 0; DBLOCK(M); 08560 EMITXWORD(OCVIMMED, -1); 08570 DBLOCKM(M); 08580 END; 08590 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB 08600 END 08610 ELSE IF MDV.MDDRESSED THEN 08620 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMED END 08630 ELSE 08640 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMED END; 08650 END; 08660 (**) 08670 (**) 08680 ()+05*) 08690 (**) 08700 (**) 08710 (*-01() (*-02() (*-05() 08720 (*MODEL EMITBEG AND EMITEND FOR THOSE WHO HAVE NOT WRITTEN THEIR OWN YET*) 08730 PROCEDURE EMITBEG; 08740 BEGIN 08750 NEXTLABEL := 1; 08760 REWRITE(LGO); 08770 (*NOW INITIALIZE YOUR CODE BUFFER, OR WHATEVER, AND EMIT INIAL CODE*) 08780 END; 08790 (**) 08800 (**) 08810 PROCEDURE EMITEND; 08820 BEGIN 08830 (*EMIT YOUR FINAL CODE*) 08840 (*FLUSH YOUR CODE BUFFER, OR WHATEVER*) 08850 END; 08860 ()-05*) ()-02*) ()-01*) 08870 (**) 08880 (*-02() (*-05() 08890 (**) 08900 PROCEDURE GENDP(M: MODE); 08910 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH, 08920 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV. 08930 *) 08940 VAR JUMPOVER: LABL; 08950 OFFSET: 0..127; 08960 PROCEDURE DBLOCK(M: MODE); 08970 VAR I, J: INTEGER; 08980 BEGIN WITH M^ DO 08990 FOR I := 0 TO MDV.MDCNT-1 DO 09000 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO 09010 IF MDDRESSED THEN 09020 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END 09030 ELSE IF MDID=MDIDSTRUCT THEN 09040 DBLOCK(MDSTRFMD) 09050 ELSE OFFSET := OFFSET+MDLEN 09060 END; 09070 PROCEDURE DBLOCKM(M: MODE); 09080 VAR I: INTEGER; X: XTYPE; 09090 BEGIN WITH M^ DO 09100 FOR I := 0 TO MDV.MDCNT-1 DO 09110 WITH MDSTRFLDS[I] DO 09120 BEGIN X := TX(MDSTRFMD); 09130 IF X=12 THEN DBLOCKM(MDSTRFMD) 09140 ELSE EMITXWORD(OCVIMMED, X+1) 09150 END 09160 END; 09170 BEGIN WITH M^ DO 09180 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD) 09190 ELSE IF MDV.MDID=MDIDSTRUCT THEN 09200 BEGIN 09210 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*) 09220 BEGIN 09230 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER); 09240 MDSTRSDB := FIXUPM; 09250 EMITXWORD(OCVIMMED, MDV.MDLEN); 09260 OFFSET := 0; DBLOCK(M); 09270 EMITXWORD(OCVIMMED, -1); 09280 DBLOCKM(M); 09290 FIXUPF(JUMPOVER) 09300 END; 09310 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB 09320 END 09330 ELSE IF MDV.MDDRESSED THEN 09340 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMED END 09350 ELSE 09360 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMED END 09370 END; 09380 (**) 09390 ()-05*) ()-02*) 09400 (**) 09410 FUNCTION GETCASE(M: MODE; OLST: OLSTTYP; SB: PSB): STATE; 09420 (*FUNCTION: COMPUTES AN ADDITION TO SOME OPCOD. 09430 THE SB HERE AND IN RELATED PLACES IS A TEMPORARY KLUDGE ?????? 09440 *) 09450 VAR WHICH: STATE; 09460 WEAKREF: BOOLEAN; 09470 BEGIN WITH M^ DO 09480 BEGIN 09490 IF SB<>NIL THEN WEAKREF:=(SBWEAKREF IN SB^.SBINF) ELSE WEAKREF:=FALSE; 09500 IF NOT MDV.MDPILE THEN 09510 IF MDV.MDLEN=SZINT THEN WHICH := 0 ELSE WHICH := 1 09520 ELSE IF WEAKREF THEN WHICH:=2 09530 ELSE IF MDV.MDID=MDIDROW THEN WHICH:=3 09540 ELSE IF MDV.MDDRESSED THEN WHICH:=4 09550 ELSE WHICH:=5; 09560 NEEDDP := OLST[WHICH].DP; 09570 GETCASE := OLST[WHICH].OVAL 09580 END 09590 END; 09600 (**) 09610 (**) 09620 PROCEDURE GENOP(VAR OPCOD: POP; M: MODE; VAR OLIST: OLSTTYP; SB: PSB); 09630 (*USES GETCASE TO MODIFY OPCOD AND DOES GENDP IF NECESSARY*) 09640 BEGIN 09650 OPCOD := OPCOD+GETCASE(M, OLIST, SB); 09660 IF NEEDDP THEN 09670 BEGIN 09680 IF SB<>NIL THEN 09690 IF SBWEAKREF IN SB^.SBINF THEN M := M^.MDPRRMD; 09700 GENDP(M); 09710 END 09720 ELSE BEGIN GENDPOCV:=OCVNONE; GENDPVAL:=0 END 09730 END; 09740 (**) 09750 (**) 09760 FUNCTION GENLCLGBL (*+05() (VAR OPCOD: POP; SB: PSB):INTEGER ()+05*) ; 09770 VAR I,X: INTEGER; 09780 VP : SBTTYP; 09790 BEGIN WITH SB^ DO 09800 BEGIN 09810 (*-05() GENLCLGBL:=SBOFFSET; ()-05*) 09820 (*+05() GENLCLGBL:=-SBOFFSET; ()+05*) 09830 IF (SBLEVEL = 0) (*+05() AND (SBLEVEL<>ROUTNL^.RNLEVEL) ()+05*) THEN (*GLOBAL*) 09840 BEGIN X:=1; (*-05() GENLCLGBL:=SBOFFSET+FIRSTIBOFFSET; ()-05*) 09850 END 09860 ELSE IF SBLEVEL = ROUTNL^.RNLEVEL THEN (*LOCAL*) X := 0 09870 ELSE (*INTERMEDIATE*) BEGIN 09880 (*-02() EMITX0(PENVCHAIN); 09890 FOR I:=1 TO ROUTNL^.RNLEVEL-SBLEVEL-1 DO 09900 BEGIN 09910 EMITX0(PENVCHAIN+1); 09920 END; 09930 ()-02*) 09940 (*+02() EMITX1(PENVCHAIN,OCVIMMED,ROUTNL^.RNLEVEL-SBLEVEL); ()+02*) 09950 X := 2 END; 09960 OPCOD := OPCOD+X; 09970 END 09980 END; 09990 (**) 10000 (**) 10010 (*-05() 10020 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ; 10030 VAR THING: OBJECT; I: INTEGER; 10040 JUMPOVER: LABL; 10050 BEGIN WITH SB^ DO 10060 WITH SBLEX^ (*A LEXEME*) DO 10070 IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN 10080 EMITX1(OPCOD, OCVEXT, ORD(SBLEX)) 10090 ELSE IF SBLEX=LEXFALSE THEN 10100 EMITX1(OPCOD, OCVIMMED, 0) 10110 ELSE IF ((LXDENMD=MDINT) OR (LXDENMD=MDBITS) OR (LXDENMD=MDCHAR)) 10120 (*+01() AND (LXDENRP<400000B) ()+01*) AND (LXTOKEN=TKDENOT) THEN 10130 EMITX1(OPCOD, OCVIMMED, LXDENRP) 10140 ELSE 10150 BEGIN 10160 IF LXV.LXPYPTR=0 THEN 10170 BEGIN 10180 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER); 10190 LXV.LXPYPTR := FIXUPM; 10200 IF SBLEX=LEXTRUE THEN 10210 EMITXWORD(OCVIMMED, TRUEVALUE) 10220 ELSE IF LXDENMD^.MDV.MDPILE THEN WITH THING DO 10230 BEGIN 10240 FIRSTWORD := 0; PCOUNT := 255; 10250 LENGTH := (*-04() LXDENRP; ()-04*)(*+04() SHRINK(LXDENRP); ()+04*) 10260 EMITXWORD(OCVIMMED, FIRSTWORD); 10270 FOR I := 3 TO LXCOUNT DO 10280 EMITXWORD(OCVIMMED, INTEGERS[I]) 10290 END 10300 ELSE EMITXWORD(OCVIMMED, LXDENRP); 10310 FIXUPF(JUMPOVER) 10320 END; 10330 IF LXTOKEN=TKDENOT THEN (*NOT LEXTRUE*) 10340 IF LXDENMD^.MDV.MDPILE THEN OPCOD := OPCOD-1; 10350 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR) 10360 END 10370 END; 10380 ()-05*) ~> ####S