1078 lines
42 KiB
OpenEdge ABL
1078 lines
42 KiB
OpenEdge ABL
~>|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
|