2128 lines
82 KiB
OpenEdge ABL
2128 lines
82 KiB
OpenEdge ABL
|
30000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
30010 (*+84() FUNCTION TX(M: MODE): XTYPE; FORWARD; ()+84*)
|
||
|
|
30020 (*+86() PROCEDURE STACKSB (SB:PSB); FORWARD; ()+86*)
|
||
|
|
30030 (*+86() PROCEDURE UNSTACKSB ; FORWARD; ()+86*)
|
||
|
|
30040 (*+87()
|
||
|
|
30050 (**)
|
||
|
|
30060 (*CODE EMITTER*)
|
||
|
|
30070 (**************)
|
||
|
|
30080 (**)
|
||
|
|
30090 (*+01() (*$T-+) ()+01*)
|
||
|
|
30110 (*-05()
|
||
|
|
30120 PROCEDURE LOAD (WHERE:SBTTYP; SB:PSB); FORWARD;
|
||
|
|
30130 PROCEDURE EMITEND; FORWARD;
|
||
|
|
30140 PROCEDURE EMITX1 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT); FORWARD;
|
||
|
|
30150 PROCEDURE EMITX2 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT); FORWARD;
|
||
|
|
30160 FUNCTION GENLCLGBL (VAR OPCOD:POP; SB:PSB):OFFSETR; FORWARD;
|
||
|
|
30170 PROCEDURE FIXUPF(ALABL:LABL);FORWARD;
|
||
|
|
30180 FUNCTION FIXUPM: LABL; FORWARD;
|
||
|
|
30200 PROCEDURE CLEAR (SB:PSB); FORWARD;
|
||
|
|
30210 PROCEDURE UNSTKP1(TYP:OPDTYP; OPND:PSB); FORWARD;
|
||
|
|
30220 ()-05*)
|
||
|
|
30230 PROCEDURE EMITOP (OPCOD:POP); FORWARD;
|
||
|
|
30240 PROCEDURE GENDENOT (OPCOD:POP; SB:PSB); FORWARD;
|
||
|
|
30250 PROCEDURE EMITCONST (OPERAND:A68INT); FORWARD;
|
||
|
|
30260 FUNCTION GETNEXTLABEL: LABL;
|
||
|
|
30270 BEGIN GETNEXTLABEL := NEXTLABEL; NEXTLABEL := NEXTLABEL+1 END;
|
||
|
|
30280 (**)
|
||
|
|
30290 (**)
|
||
|
|
30300 (*+32()
|
||
|
|
30310 (*-01() (*-02() PROCEDURE HALT; VAR I,K: INTEGER; BEGIN I:=0;K := K DIV I END; ()-02*) ()-01*)
|
||
|
|
30320 PROCEDURE ASERT (ASERTION:BOOLEAN; REASON:ALFA);
|
||
|
|
30330 BEGIN
|
||
|
|
30340 IF NOT (ASERTION) THEN
|
||
|
|
30350 BEGIN
|
||
|
|
30360 WRITELN(OUTPUT,' ASSERT FAILED ',REASON);
|
||
|
|
30370 (*+01() PUTSEG(OUTPUT); ()+01*)
|
||
|
|
30380 EMITEND;
|
||
|
|
30390 HALT
|
||
|
|
30400 END
|
||
|
|
30410 END;
|
||
|
|
30420 (**)
|
||
|
|
30430 ()+32*)
|
||
|
|
30440 (*-24()
|
||
|
|
30450 PROCEDURE TAKELINE;
|
||
|
|
30460 BEGIN
|
||
|
|
30462 (*+23()WRITELN(LSTFILE);()+23*)
|
||
|
|
30470 (*+02()WRITELN(LGO); ()+02*)
|
||
|
|
30480 (*+23()LSTCNT:=LSTCNT+1;
|
||
|
|
30490 IF LSTCNT > LINESPERPAGE THEN CHECKPAGE
|
||
|
|
30492 ()+23*)
|
||
|
|
30500 END;
|
||
|
|
30510 ()-24*)
|
||
|
|
30520 (*+23()
|
||
|
|
30530 PROCEDURE EMITOP (* (OPCOD:POP) *);
|
||
|
|
30540 VAR FLAG,I: INTEGER;
|
||
|
|
30550 NAME: ALFA;
|
||
|
|
30560 BEGIN
|
||
|
|
30570 FLAG := 0;
|
||
|
|
30580 NAME := CODETABLE[OPCOD].ROUTINE;
|
||
|
|
30590 WHILE NAME = ' ' DO
|
||
|
|
30600 BEGIN
|
||
|
|
30610 IF OPCOD >= 0 THEN
|
||
|
|
30620 BEGIN OPCOD := OPCOD-1; FLAG := FLAG+1 END
|
||
|
|
30630 ELSE BEGIN OPCOD := OPCOD+1; FLAG := FLAG-1 END;
|
||
|
|
30640 NAME := CODETABLE[OPCOD].ROUTINE
|
||
|
|
30650 END;
|
||
|
|
30660 IF NUMPARAMS=0 THEN WRITE(LSTFILE,' ':25);
|
||
|
|
30670 FOR I:=3 DOWNTO NUMPARAMS+1 DO WRITE(LSTFILE,' ':20);
|
||
|
|
30680 WRITE (LSTFILE,NAME);
|
||
|
|
30690 IF FLAG >0 THEN WRITELN (LSTFILE,'+',FLAG:2)
|
||
|
|
30700 ELSE IF FLAG < 0 THEN WRITELN (LSTFILE,FLAG:3)
|
||
|
|
30710 ELSE WRITELN (LSTFILE);
|
||
|
|
30720 NUMPARAMS:=0;
|
||
|
|
30730 END;
|
||
|
|
30740 (**)
|
||
|
|
30750 PROCEDURE WRITEOPERAND (TYP:OPDTYP; OPERAND:ADDRINT);
|
||
|
|
30760 VAR REC: RECORD CASE SEVERAL OF
|
||
|
|
30770 1: (INT: INTEGER);
|
||
|
|
30780 2: (LEX: PLEX ) ;
|
||
|
|
30790 3,4,5,6,7,8,9,10: () ;
|
||
|
|
30800 END;
|
||
|
|
30810 BEGIN
|
||
|
|
30820 IF NUMPARAMS=1 THEN WRITE(LSTFILE,' ':25);
|
||
|
|
30830 CASE TYP OF
|
||
|
|
30840 OCVIMMED: WRITE (LSTFILE,' IMMED',OPERAND:10,', ');
|
||
|
|
30850 OCVMEM : WRITE (LSTFILE,' MEM',OPERAND:10,', ');
|
||
|
|
30860 OCVEXT : BEGIN REC.INT := OPERAND; WRITE(LSTFILE,' EXT ');
|
||
|
|
30870 WRITE(LSTFILE,REC.LEX^.S10)
|
||
|
|
30880 END;
|
||
|
|
30890 OCVFREF : WRITE (LSTFILE,' FREF',OPERAND:10,', ');
|
||
|
|
30900 OCVFIM : WRITE (LSTFILE,' FIM',OPERAND:10,', ')
|
||
|
|
30910 END
|
||
|
|
30920 END;
|
||
|
|
30930 (**)
|
||
|
|
30940 PROCEDURE UPPER;
|
||
|
|
30950 BEGIN WRITELN(LSTFILE,' UPPER.') END;
|
||
|
|
30960 PROCEDURE FILL(WHERE:SBTTYP;SB:PSB);
|
||
|
|
30970 BEGIN
|
||
|
|
30980 WITH SB^ DO
|
||
|
|
30990 BEGIN
|
||
|
|
31000 IF NOT (WHERE IN [SBTSTKN,SBTDL,SBTXN]) THEN SBLEN:=SZWORD;
|
||
|
|
31010 IF WHERE IN [SBTSTK..SBTSTKN] THEN
|
||
|
|
31020 BEGIN
|
||
|
|
31030 RTSTKDEPTH:=RTSTKDEPTH+SBLEN;
|
||
|
|
31040 WITH ROUTNL^ DO
|
||
|
|
31050 IF RTSTKDEPTH > RNLENSTK THEN RNLENSTK:=RTSTKDEPTH;
|
||
|
|
31060 END;
|
||
|
|
31070 SBTYP:=WHERE;
|
||
|
|
31080 END;
|
||
|
|
31090 END;
|
||
|
|
31100 (**)
|
||
|
|
31110 FUNCTION SETINLINE(OPCOD:POP):BOOLEAN;
|
||
|
|
31120 BEGIN
|
||
|
|
31130 SETINLINE:=TRUE;
|
||
|
|
31140 END;
|
||
|
|
31150 (**)
|
||
|
|
31160 FUNCTION NORMAL(SB:PSB) : SBTTYP;
|
||
|
|
31170 BEGIN
|
||
|
|
31180 WITH SB^ DO WITH SBMODE^.MDV DO
|
||
|
|
31190 IF(NOT(SBUNION IN SBINF)) AND (NOT MDPILE) AND (MDLEN=0) THEN
|
||
|
|
31200 NORMAL:=SBTVOID
|
||
|
|
31210 ELSE
|
||
|
|
31220 NORMAL:=SBTSTK;
|
||
|
|
31230 END;
|
||
|
|
31240 (**)
|
||
|
|
31250 PROCEDURE LOADSTK(SB: PSB);
|
||
|
|
31260 VAR LEN: INTEGER;
|
||
|
|
31270 BEGIN
|
||
|
|
31280 WITH SB^ DO WITH SBMODE^.MDV DO
|
||
|
|
31290 IF SBUNION IN SBINF THEN LEN:=SZWORD ELSE IF MDPILE THEN LEN:=SZADDR ELSE LEN:=MDLEN;
|
||
|
|
31300 IF LEN=0 THEN LOAD(SBTVOID,SB)
|
||
|
|
31310 ELSE LOAD(SBTSTK,SB);
|
||
|
|
31320 END;
|
||
|
|
31330 (**)
|
||
|
|
31340 PROCEDURE TWIST;
|
||
|
|
31350 VAR TEMPPTR:PSB;
|
||
|
|
31360 BEGIN
|
||
|
|
31370 WITH RTSTACK^ DO
|
||
|
|
31380 BEGIN
|
||
|
|
31390 IF (SBTYP >= SBTSTK) AND (SBRTSTK^.SBTYP >= SBTSTK) THEN
|
||
|
|
31400 BEGIN TAKELINE; EMITOP(PSWAP); END;
|
||
|
|
31410 TEMPPTR:=SBRTSTK;
|
||
|
|
31420 SBRTSTK:=TEMPPTR^.SBRTSTK;
|
||
|
|
31430 TEMPPTR^.SBRTSTK:=RTSTACK;
|
||
|
|
31440 RTSTACK:=TEMPPTR;
|
||
|
|
31450 END;
|
||
|
|
31460 END;
|
||
|
|
31470 (**)
|
||
|
|
31480 PROCEDURE LOAD (*+05() (WHERE: SBTTYP; SB: PSB) ()+05*);
|
||
|
|
31490 VAR TEMPOP:POP;
|
||
|
|
31500 TOFFSET:INTEGER;
|
||
|
|
31510 TEMPTYP:SBTTYP;
|
||
|
|
31520 TWISTED:BOOLEAN;
|
||
|
|
31530 SB1: PSB;
|
||
|
|
31540 BEGIN
|
||
|
|
31550 WITH SB^ DO
|
||
|
|
31560 BEGIN
|
||
|
|
31570 IF SBRTSTK <> NIL THEN
|
||
|
|
31580 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
|
||
|
|
31590 BEGIN
|
||
|
|
31600 LOADSTK(SBRTSTK);
|
||
|
|
31610 SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY];
|
||
|
|
31620 END;
|
||
|
|
31630 TWISTED:=FALSE;
|
||
|
|
31640 IF (WHERE IN [SBTVOID,SBTSTK..SBTXN]) AND (SBTYP IN [SBTID..SBTRPROC]) THEN
|
||
|
|
31650 BEGIN
|
||
|
|
31660 SB1 := RTSTACK;
|
||
|
|
31670 WHILE (SB1^.SBTYP IN [SBTID..SBTRPROC]) AND (SB1<>SB) DO
|
||
|
|
31680 SB1 := SB1^.SBRTSTK;
|
||
|
|
31690 IF SB1<>SB THEN
|
||
|
|
31700 BEGIN TWISTED:=TRUE; TWIST;
|
||
|
|
31710 (*+32() ASERT (RTSTACK =SB,'LOAD-A '); ()+32*)
|
||
|
|
31720 END;
|
||
|
|
31730 CASE SBTYP OF
|
||
|
|
31740 SBTVAR:BEGIN
|
||
|
|
31750 TEMPOP:=PLOADVAR;
|
||
|
|
31760 TOFFSET:=GENLCLGBL(TEMPOP,SB);
|
||
|
|
31770 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET);
|
||
|
|
31780 END;
|
||
|
|
31790 SBTID,SBTIDV:BEGIN
|
||
|
|
31800 TEMPOP:=PPUSH;
|
||
|
|
31810 TOFFSET:=GENLCLGBL(TEMPOP,SB);
|
||
|
|
31820 EMITX1(TEMPOP,OCVLCLGBL,TOFFSET);
|
||
|
|
31830 END;
|
||
|
|
31840 SBTLIT:EMITX1(PPUSHIM,OCVIMMED,SBVALUE);
|
||
|
|
31850 SBTDEN:GENDENOT(PPUSHIM,SB);
|
||
|
|
31860 END; (*OF CASE*)
|
||
|
|
31870 END;
|
||
|
|
31880 END;
|
||
|
|
31890 FILL(WHERE,SB);
|
||
|
|
31900 IF TWISTED THEN TWIST;
|
||
|
|
31910 END;
|
||
|
|
31920 (**)
|
||
|
|
31930 PROCEDURE PROC1OP(OPCOD:POP;TYP:OPDTYP;OPND:ADDRINT;NOTINL:BOOLEAN);
|
||
|
|
31940 VAR SB:PSB;
|
||
|
|
31950 BEGIN
|
||
|
|
31960 SB:=ASPTR(OPND);
|
||
|
|
31970 IF RTSTACK<>SB THEN TWIST;
|
||
|
|
31980 LOADSTK(SB);
|
||
|
|
31990 UNSTKP1(TYP,SB);
|
||
|
|
32000 END;
|
||
|
|
32010 (**)
|
||
|
|
32020 PROCEDURE PROC2OP(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;NOTINL:BOOLEAN);
|
||
|
|
32030 VAR SB1,SB2:PSB;
|
||
|
|
32040 BEGIN
|
||
|
|
32050 SB1:=ASPTR(OPND1);
|
||
|
|
32060 SB2:=ASPTR(OPND2);
|
||
|
|
32070 LOADSTK(SB1);
|
||
|
|
32080 LOADSTK(SB2);
|
||
|
|
32090 IF SB2<>RTSTACK THEN TWIST;
|
||
|
|
32100 UNSTKP1(TYP2,SB2);
|
||
|
|
32110 UNSTKP1(TYP1,SB1);
|
||
|
|
32120 END;
|
||
|
|
32130 (**)
|
||
|
|
32140 PROCEDURE PARAM(TYP:OPDTYP;OPND:ADDRINT;OPCOD:POP);
|
||
|
|
32150 BEGIN
|
||
|
|
32180 IF TYP <> OCVNONE THEN
|
||
|
|
32190 BEGIN
|
||
|
|
32200 NUMPARAMS:=NUMPARAMS+1;
|
||
|
|
32210 WRITEOPERAND(TYP,OPND);
|
||
|
|
32220 END;
|
||
|
|
32230 END;
|
||
|
|
32240 (**)
|
||
|
|
32250 (**)
|
||
|
|
32260 PROCEDURE FIXUPF (*+05() (ALABL:LABL) ()+05*);
|
||
|
|
32270 BEGIN
|
||
|
|
32280 TAKELINE;
|
||
|
|
32290 WRITELN (LSTFILE,' ':20,ALABL:6,':')
|
||
|
|
32300 END;
|
||
|
|
32310 (**)
|
||
|
|
32320 FUNCTION FIXUPM (*+05(): LABL()+05*);
|
||
|
|
32330 VAR L: LABL;
|
||
|
|
32340 BEGIN
|
||
|
|
32350 TAKELINE;
|
||
|
|
32360 L := GETNEXTLABEL;
|
||
|
|
32370 FIXUPM := L;
|
||
|
|
32380 WRITELN (LSTFILE,' ':20,L:6,':')
|
||
|
|
32390 END;
|
||
|
|
32400 (**)
|
||
|
|
32410 PROCEDURE EMITXWORD (TYP:OPDTYP; OPERAND:A68INT);
|
||
|
|
32420 BEGIN
|
||
|
|
32430 TAKELINE;
|
||
|
|
32440 WRITE(LSTFILE,' ':25);
|
||
|
|
32450 WRITEOPERAND (TYP,OPERAND);
|
||
|
|
32460 WRITELN (LSTFILE)
|
||
|
|
32470 END;
|
||
|
|
32480 (**)
|
||
|
|
32490 PROCEDURE EMITALF(OPERAND: ALFA);
|
||
|
|
32500 VAR I: INTEGER;
|
||
|
|
32510 BEGIN
|
||
|
|
32520 TAKELINE;
|
||
|
|
32530 WRITE(LSTFILE, ' ':25, '''');
|
||
|
|
32540 FOR I := 1 TO 10 DO WRITE(LSTFILE, OPERAND[I]);
|
||
|
|
32550 WRITELN(LSTFILE, '''');
|
||
|
|
32560 END;
|
||
|
|
32570 (**)
|
||
|
|
32580 PROCEDURE FIXUPFIM (ALABL:LABL; VALUE:A68INT);
|
||
|
|
32590 BEGIN
|
||
|
|
32600 TAKELINE;
|
||
|
|
32610 WRITELN (LSTFILE,' ':20,ALABL:6,': EQU ',VALUE:8)
|
||
|
|
32620 END;
|
||
|
|
32630 (**)
|
||
|
|
32640 PROCEDURE FIXLABL (OLDLABL, NEWLABL: LABL; KNOWN: BOOLEAN);
|
||
|
|
32650 BEGIN
|
||
|
|
32660 TAKELINE;
|
||
|
|
32670 WRITELN (LSTFILE,' ':20,OLDLABL:6, ' EQU ', NEWLABL:8,':')
|
||
|
|
32680 END;
|
||
|
|
32690 (**)
|
||
|
|
32700 ()+23*)
|
||
|
|
32710 (* EM-1 CODE EMITTER *)
|
||
|
|
32720 (*********************)
|
||
|
|
32730 (*+02()
|
||
|
|
32740 PROCEDURE PARAM(TYP:OPDTYP; OPND:ADDRINT; OPCOD: POP); FORWARD;
|
||
|
|
32750 (*-24()
|
||
|
|
32760 PROCEDURE WRITEBYTE(B:INTEGER); BEGIN WRITE(LGO,B:5) END;
|
||
|
|
32770 PROCEDURE WRITEINSTN(INST:COMPACT);
|
||
|
|
32775 VAR COUNT:INTEGER;
|
||
|
|
32780 BEGIN IF INST=EOOPNDS THEN TAKELINE
|
||
|
|
32782 ELSE BEGIN
|
||
|
|
32783 WRITE(LGO,' ');
|
||
|
|
32784 FOR COUNT:=1 TO 3 DO
|
||
|
|
32785 BEGIN
|
||
|
|
32787 WRITE(LGO,CHR(ORD(INST[COUNT])+32)); (*TRANSLATE TO LOWER CASE*)
|
||
|
|
32788 END;
|
||
|
|
32789 END;
|
||
|
|
32790 END;
|
||
|
|
32792 PROCEDURE WRITECON(COMMON, SIZE: INTEGER; OPERAND: ADDRINT);
|
||
|
|
32793 BEGIN WRITE(LGO,' ',OPERAND);
|
||
|
|
32794 IF SIZE<>SZWORD THEN
|
||
|
|
32796 WRITE(LGO, 'I', SIZE:1);
|
||
|
|
32799 END;
|
||
|
|
32800 PROCEDURE WRITELABEL(GLOBAL:BOOLEAN;OPERAND:INTEGER);
|
||
|
|
32810 BEGIN
|
||
|
|
32821 IF GLOBAL THEN WRITE(LGO,'.'); WRITE(LGO,OPERAND:0); TAKELINE; END;
|
||
|
|
32841 PROCEDURE WRITEOFFSET(L:LABL;OFFSET:INTEGER);
|
||
|
|
32842 BEGIN WRITE(LGO,' .',L:0);
|
||
|
|
32843 IF OFFSET<>0 THEN
|
||
|
|
32844 BEGIN IF OFFSET>0 THEN WRITE(LGO,'+');
|
||
|
|
32845 WRITE(LGO,OFFSET:0);
|
||
|
|
32846 END;
|
||
|
|
32848 END;
|
||
|
|
32850 ()-24*)
|
||
|
|
32860 (*+24()
|
||
|
|
32870 PROCEDURE WRITEBYTE(B:BYTE);
|
||
|
|
32880 (*PROCEDURE TO WRITE A BYTE OF COMPACT ASSEMBLER CODE *)
|
||
|
|
32890 BEGIN
|
||
|
|
32900 WRITE(LGO,B);
|
||
|
|
32910 END;
|
||
|
|
32920 (**)
|
||
|
|
32930 PROCEDURE WRITEINSTN(INST:COMPACT);
|
||
|
|
32940 BEGIN WRITE(LGO,INST) END;
|
||
|
|
32950 (**)
|
||
|
|
32960 PROCEDURE WRITECON(COMMON,SIZE:INTEGER;OPERAND:ADDRINT);
|
||
|
|
32970 (* WRITES A POSITIVE INTEGER IN BASE 256,OR AS AN OFFSET FROM 120 *)
|
||
|
|
32980 VAR I,COUNT,T:INTEGER;
|
||
|
|
32982 OUTSTR:PACKED ARRAY[1..10] OF CHAR;
|
||
|
|
32990 BEGIN
|
||
|
|
33000 IF (OPERAND < 120) AND (OPERAND >= -120) AND (COMMON=CPACTCONS) AND (SIZE=SZWORD) THEN
|
||
|
|
33010 WRITEBYTE(OPERAND+120)
|
||
|
|
33020 ELSE
|
||
|
|
33030 BEGIN
|
||
|
|
33040 COUNT := 1;
|
||
|
|
33050 CASE COMMON OF
|
||
|
|
33060 CPACTLCL:BEGIN
|
||
|
|
33070 (*+32() ASERT(OPERAND<65536,'WRITECON-A'); ()+32*)
|
||
|
|
33075 COUNT := 2;
|
||
|
|
33080 END;
|
||
|
|
33090 CPACTGBL:BEGIN
|
||
|
|
33100 (*+32() ASERT(OPERAND < 32768 ,'WRITECON-B'); ()+32*)
|
||
|
|
33110 IF OPERAND > 255 THEN BEGIN COMMON := COMMON+1; COUNT := 2 END
|
||
|
|
33120 END;
|
||
|
|
33130 CPACTCONS:BEGIN
|
||
|
|
33140 COUNT := 2;
|
||
|
|
33170 IF OPERAND > 32767 THEN BEGIN COMMON := COMMON+1; COUNT := 4 END;
|
||
|
|
33180 END;
|
||
|
|
33191 END;
|
||
|
|
33193 IF SIZE<>SZWORD THEN
|
||
|
|
33194 BEGIN
|
||
|
|
33195 T := 1;
|
||
|
|
33196 REPEAT
|
||
|
|
33197 OUTSTR[T] := CHR((OPERAND MOD 10)+ORD('0'));
|
||
|
|
33198 OPERAND := OPERAND DIV 10; T := T+1;
|
||
|
|
33199 UNTIL OPERAND=0;
|
||
|
|
33200 WRITEBYTE(CPACTUNS);
|
||
|
|
33201 WRITECON(CPACTCONS,SZWORD,SIZE);
|
||
|
|
33202 T := T-1;
|
||
|
|
33203 WRITEBYTE(120+T);
|
||
|
|
33204 FOR I := T DOWNTO 1 DO
|
||
|
|
33208 WRITEBYTE(ORD(OUTSTR[I]))
|
||
|
|
33209 END
|
||
|
|
33212 ELSE
|
||
|
|
33213 BEGIN
|
||
|
|
33214 WRITEBYTE(COMMON);
|
||
|
|
33220 FOR I := 1 TO COUNT DO
|
||
|
|
33230 BEGIN
|
||
|
|
33232 T := OPERAND MOD 256;
|
||
|
|
33244 WRITEBYTE(T);
|
||
|
|
33250 OPERAND := (OPERAND-T) DIV 256;
|
||
|
|
33260 END;
|
||
|
|
33265 END;
|
||
|
|
33270 END;
|
||
|
|
33280 END;
|
||
|
|
33290 (**)
|
||
|
|
33300 PROCEDURE WRITELABEL(GLOBAL:BOOLEAN;OPERAND:INTEGER);
|
||
|
|
33310 BEGIN
|
||
|
|
33320 IF GLOBAL THEN WRITECON(CPACTGBL, SZWORD, OPERAND) ELSE WRITECON(CPACTLCL, SZWORD, OPERAND);
|
||
|
|
33330 END;
|
||
|
|
33340 (**)
|
||
|
|
33350 (**)
|
||
|
|
33401 PROCEDURE WRITEOFFSET(L:LABL;OFFSET:INTEGER);
|
||
|
|
33402 BEGIN
|
||
|
|
33403 IF OFFSET<>0 THEN WRITEBYTE(CPACTLBL);
|
||
|
|
33404 WRITECON(CPACTGBL,SZWORD,L);
|
||
|
|
33407 IF OFFSET <>0 THEN WRITECON(CPACTCONS,SZWORD,OFFSET);
|
||
|
|
33408 END;
|
||
|
|
33409 (**)
|
||
|
|
33410 ()+24*)
|
||
|
|
33411 PROCEDURE SETTEXTSTATE;
|
||
|
|
33412 BEGIN
|
||
|
|
33413 IF DATASTATE=INDATA THEN WRITEINSTN(EOOPNDS);
|
||
|
|
33414 DATASTATE := ENDDATA
|
||
|
|
33415 END;
|
||
|
|
33416 (**)
|
||
|
|
33420 PROCEDURE EMITXWORD(TYP:OPDTYP;OPERAND:ADDRINT);
|
||
|
|
33430 VAR REC: RECORD CASE SEVERAL OF
|
||
|
|
33440 1: (INT:ADDRINT);
|
||
|
|
33450 2: (LEX:PLEX);
|
||
|
|
33455 3,4,5,6,7,8,9,10: ();
|
||
|
|
33460 END;
|
||
|
|
33470 I,K,STRLEN,HI:INTEGER;
|
||
|
|
33471 (*-24()J:CHAR;()-24*)
|
||
|
|
33480 BEGIN
|
||
|
|
33482 (* IN THE -24 MACHINE 'CON <DATA>' IS PRODUCED ON EACH LINE *)
|
||
|
|
33483 (* IN THE +24 MACHINE 'CON <DATA> <DATA> <DATA> ...' IS PRODUCED *)
|
||
|
|
33485 IF (DATASTATE=STARTDATA) (*-24() OR (DATASTATE=INDATA) ()-24*) THEN
|
||
|
|
33486 BEGIN
|
||
|
|
33487 WRITEINSTN(CON);DATASTATE:=INDATA;
|
||
|
|
33488 END;
|
||
|
|
33490 CASE TYP OF
|
||
|
|
33500 OCVIMMED: WRITECON(CPACTCONS, SZWORD, OPERAND);
|
||
|
|
33502 OCVIMMLONG: WRITECON(CPACTCONS, SZLONG, OPERAND);
|
||
|
|
33504 OCVIMMPTR: WRITECON(CPACTCONS, SZADDR, OPERAND);
|
||
|
|
33510 (*+24()OCVFREF: WRITELABEL(FALSE,OPERAND);
|
||
|
|
33520 OCVMEM,OCVFIM: WRITELABEL(TRUE,OPERAND); ()+24*)
|
||
|
|
33530 (*-24()OCVFREF: BEGIN
|
||
|
|
33532 WRITE(LGO,' *',OPERAND:0);
|
||
|
|
33533 END;
|
||
|
|
33540 OCVMEM,OCVFIM: BEGIN
|
||
|
|
33542 WRITE(LGO,' .',OPERAND:0);
|
||
|
|
33543 END; ()-24*)
|
||
|
|
33550 OCVEXT: BEGIN
|
||
|
|
33560 REC.INT := OPERAND;
|
||
|
|
33562 STRLEN:=REC.LEX^.LXCOUNT*SZWORD;
|
||
|
|
33563 HI := 1;
|
||
|
|
33564 WHILE (HI<=RTNLENGTH) AND (REC.LEX^.S10[HI]<>' ') DO HI := HI+1;
|
||
|
|
33566 HI := HI-1;
|
||
|
|
33570 (*+24() WRITEBYTE(CPACTPNAM);
|
||
|
|
33575 WRITECON(CPACTCONS,SZWORD,HI);
|
||
|
|
33591 FOR I := 1 TO HI DO
|
||
|
|
33600 WRITEBYTE(ORD(REC.LEX^.S10[I]));
|
||
|
|
33604 ()+24*)
|
||
|
|
33610 (*-24() WRITE(LGO,' $');
|
||
|
|
33611 FOR I:=1 TO HI DO
|
||
|
|
33612 BEGIN
|
||
|
|
33613 J:=REC.LEX^.S10[I];
|
||
|
|
33616 WRITE(LGO,J);
|
||
|
|
33617 END;
|
||
|
|
33619 IF HI<RTNLENGTH THEN
|
||
|
|
33620 FOR K:=I+1 TO RTNLENGTH DO
|
||
|
|
33624 WRITE(LGO,' ');
|
||
|
|
33626 ()-24*)
|
||
|
|
33628 END
|
||
|
|
33630 END;
|
||
|
|
33632 (*-24()IF DATASTATE=INDATA THEN WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
33640 END;
|
||
|
|
33650 (**)
|
||
|
|
33652 PROCEDURE EMITXPROC (TYP:OPDTYP;OPERAND:ADDRINT);
|
||
|
|
33654 VAR
|
||
|
|
33656 TEMP :PLEX;
|
||
|
|
33658 DIGIT,INDEX :INTEGER;
|
||
|
|
33660 ADDRESS :LABL;
|
||
|
|
33662 BEGIN
|
||
|
|
33664 ENEW (TEMP, LEX1SIZE+ (9*CHARPERWORD) DIV CHARPERWORD * SZWORD);
|
||
|
|
33666 WITH TEMP^ DO
|
||
|
|
33668 BEGIN
|
||
|
|
33670 S10:=' ';
|
||
|
|
33672 S10[1]:='R';
|
||
|
|
33674 DIGIT:=OPERAND;
|
||
|
|
33676 INDEX:=1;
|
||
|
|
33678 WHILE DIGIT>0 DO BEGIN DIGIT:=DIGIT DIV 10; INDEX:=INDEX+1; END;
|
||
|
|
33680 DIGIT:=OPERAND;
|
||
|
|
33682 WHILE DIGIT>0 DO
|
||
|
|
33684 BEGIN
|
||
|
|
33686 S10[INDEX]:= CHR ((DIGIT MOD 10) + ORD('0')); (*ONLY WORKS FOR NUMBERS THEN RUN CONTIGUOUSLY*)
|
||
|
|
33688 DIGIT:=DIGIT DIV 10; INDEX := INDEX-1;
|
||
|
|
33690 END;
|
||
|
|
33691 LXCOUNT:= (9*CHARPERWORD) DIV CHARPERWORD * SZWORD;
|
||
|
|
33692 END;
|
||
|
|
33693 EMITXWORD(OCVEXT,ORD(TEMP));
|
||
|
|
33694 EDISPOSE(TEMP, LEX1SIZE+ (9*CHARPERWORD) DIV CHARPERWORD * SZWORD);
|
||
|
|
33695 END;
|
||
|
|
33696 PROCEDURE EMITALF(ALF: BIGALFA);
|
||
|
|
33697 VAR I,L: INTEGER;
|
||
|
|
33702 BEGIN
|
||
|
|
33703 (*+24() IF DATASTATE=STARTDATA THEN WRITEINSTN(CON);
|
||
|
|
33704 WRITEBYTE(CPACTSTRING);
|
||
|
|
33706 WRITECON(CPACTCONS,SZWORD,10); FOR I := 1 TO 10 DO WRITEBYTE(ORD(ALF.ALF[I]));
|
||
|
|
33707 WRITECON(CPACTCONS,1,ALF.IDSIZE); WRITECON(CPACTCONS,1,ALF.XMODE); ()+24*)
|
||
|
|
33708 (*-24() WRITEINSTN(CON);
|
||
|
|
33709 WRITE(LGO, ' '''); FOR I := 1 TO 8 DO WRITE(LGO, ALF.ALF[I]);
|
||
|
|
33710 WRITE(LGO,''',',ALF.IDSIZE:1,'U1,',ALF.XMODE:1,'U1'); WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
33711 DATASTATE:=INDATA;
|
||
|
|
33712 END;
|
||
|
|
33713 (**)
|
||
|
|
33714 PROCEDURE EMITRNTAIL (LEN :INTEGER);
|
||
|
|
33715 BEGIN
|
||
|
|
33716 SETTEXTSTATE;
|
||
|
|
33717 WRITEINSTN(EEND);EMITXWORD(OCVIMMED,LEN);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
33718 END;
|
||
|
|
33719 (**)
|
||
|
|
33720 FUNCTION STKSPACE (INSTR:COMPACT;PARAM:INTEGER) :INTEGER;
|
||
|
|
33722 (*FUNCTION CALCULATES HOW MANY WORDS WILL BE PUT ON THE STACK*)
|
||
|
|
33723 (*BY THE INSTRUCTION INSTR*)
|
||
|
|
33730 BEGIN
|
||
|
|
33731 (*+32() ASERT(INSTR<>LOS,'STKSPACE-A'); ()+32*)
|
||
|
|
33735 IF (INSTR=LFR)OR(INSTR=LOI)OR(INSTR=DUP) THEN STKSPACE:=PARAM
|
||
|
|
33737 ELSE IF (INSTR=LDC)OR(INSTR=LDL)OR(INSTR=LDE)OR(INSTR=LDF) THEN STKSPACE:=SZWORD+SZWORD
|
||
|
|
33738 ELSE IF (INSTR=ADP)OR(INSTR=LAL)OR(INSTR=LAE)OR(INSTR=LXL)OR(INSTR=LXA)OR(INSTR=LOR) THEN STKSPACE:=SZADDR
|
||
|
|
33739 ELSE STKSPACE:=SZWORD;
|
||
|
|
33740 END;
|
||
|
|
33743 (**)
|
||
|
|
33744 (**)
|
||
|
|
33745 PROCEDURE EMITOP (* (OPCOD:POP) *);
|
||
|
|
33747 CONST MAXLABL = 2; (* MAXIMUM NUMBER OF OVERLAPPING LABELS *)
|
||
|
|
33748 (*-24() NOP='NOP'; ()-24*)
|
||
|
|
33750 VAR I,TEMPCNT,STRWLEN:INTEGER; TEMPLABL:LABL; TEMP:PLEX;
|
||
|
|
33760 COUNT : ARRAY [1..MAXLABL] OF INTEGER;
|
||
|
|
33765 JUMPOVER : ARRAY [1..MAXLABL] OF LABL;
|
||
|
|
33770 PARAMNOTUSED: BOOLEAN;
|
||
|
|
33772 SAVOPRAND: ADDRINT;
|
||
|
|
33780 BEGIN
|
||
|
|
33790 SETTEXTSTATE;
|
||
|
|
33810 PARAMNOTUSED := TRUE;
|
||
|
|
33811 FOR I:=1 TO MAXLABL DO COUNT[I]:=0;
|
||
|
|
33812 IF OCV=OCVLCLGBL THEN
|
||
|
|
33813 BEGIN
|
||
|
|
33814 IF LCLGBL<>0 THEN
|
||
|
|
33815 BEGIN CLEAR(RTSTACK); (*IN CASE ANYTHING IN PRR*)
|
||
|
|
33816 SAVOPRAND := OPRAND;
|
||
|
|
33817 EMITX1(PENVCHAIN+ORD(OPRAND>0),OCVIMMED,LCLGBL);
|
||
|
|
33818 OPRAND := SAVOPRAND;
|
||
|
|
33819 END;
|
||
|
|
33820 OCV := OCVIMMED;
|
||
|
|
33821 PARAMNOTUSED := FALSE; (*SPECIAL FIDDLE FOR PLOADRTA AND PCALLA*)
|
||
|
|
33822 END;
|
||
|
|
33824 WHILE OPCOD <> 0 DO WITH CODETABLE[OPCOD] DO
|
||
|
|
33830 BEGIN
|
||
|
|
33835 (*+21()WRITELN(OUTPUT,'EMITTING P-OP',OPCOD,' ADJUSTSP=',ADJUSTSP);()+21*)
|
||
|
|
33840 IF INLINE THEN
|
||
|
|
33850 BEGIN
|
||
|
|
33860 IF EMCOD<>NOP THEN WRITEINSTN(EMCOD);
|
||
|
|
33870 CASE PARTYP OF
|
||
|
|
33880 ACP,ANP,WOP,WNP : (* OPERAND SUPPLIED BY,AND NEGATION DONE BY,CODETABLE*)
|
||
|
|
33890 WRITECON(CPACTCONS, SZWORD, PARM);
|
||
|
|
33892 WLB,ACB : (*OPERAND SUPPLIED BY CODETABLE, GLOBAL LABEL OFFSET*)
|
||
|
|
33894 WRITEOFFSET(HOLTOP,PARM);
|
||
|
|
33900 OPX,ACX : (* OPERAND IS SUPPLIED BY CODE GENERATOR *)
|
||
|
|
33910 BEGIN IF OCV<=OCVIMMPTR THEN WRITECON(CPACTCONS, SZWORD, OPRAND+PARM)
|
||
|
|
33912 ELSE EMITXWORD(OCV, OPRAND+PARM); PARAMNOTUSED := FALSE END;
|
||
|
|
33920 ONX,ANX : (* NEGATIVE OF OPERAND SUPPLIED BY CODE GENERATOR *)
|
||
|
|
33930 BEGIN IF OCV<=OCVIMMPTR THEN WRITECON(CPACTCONS, SZWORD, -(OPRAND+PARM))
|
||
|
|
33932 ELSE EMITXWORD(OCV, -(OPRAND+PARM)); PARAMNOTUSED := FALSE END;
|
||
|
|
33933 OPL,ACL : (*OPERAND (SUPPLIED BY CODE GEN) IS A GLOBAL LABEL OFFSET*)
|
||
|
|
33934 BEGIN WRITEOFFSET(HOLTOP,OPRAND+PARM); PARAMNOTUSED:=FALSE; END;
|
||
|
|
33937 ONL,ANL : (*AS ABOVE BUT NEGATE OPERAND FIRST*)
|
||
|
|
33939 BEGIN WRITEOFFSET(HOLTOP,-(OPRAND+PARM));PARAMNOTUSED:=FALSE; END;
|
||
|
|
33940 JMP : (* P-OP GENERATES ITS OWN LABELS FOR LOOPS ETC. *)
|
||
|
|
33950 BEGIN
|
||
|
|
33960 TEMPCNT := PARM;
|
||
|
|
33970 TEMPLABL := GETNEXTLABEL;
|
||
|
|
33980 EMITXWORD(OCVFREF,TEMPLABL);
|
||
|
|
33990 IF TEMPCNT < 0 THEN (* A BACKWARD JUMP IS REQUIRED,USE THE EXC COMMAND *)
|
||
|
|
34000 BEGIN
|
||
|
|
34005 WRITELABEL(FALSE,TEMPLABL);
|
||
|
|
34007 WRITEINSTN(EXC); WRITECON(CPACTCONS, SZWORD, -TEMPCNT);
|
||
|
|
34010 WRITECON(CPACTCONS, SZWORD, 1); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
34015 END
|
||
|
|
34017 ELSE
|
||
|
|
34018 BEGIN (*FORWARD JUMP SO STORE IN ARRAYS*)
|
||
|
|
34020 I:=0;
|
||
|
|
34022 REPEAT I:=I+1; (*+32()ASERT(I<=MAXLABL,'EMITOP-A ');()+32*) UNTIL COUNT[I] = 0;
|
||
|
|
34024 COUNT[I]:=TEMPCNT; JUMPOVER[I]:=TEMPLABL;
|
||
|
|
34026 END;
|
||
|
|
34028 END;
|
||
|
|
34030 NON : ;
|
||
|
|
34040 GBX : (* GLOBAL LABEL EXPECTED *)
|
||
|
|
34050 BEGIN
|
||
|
|
34055 WRITEOFFSET(OPRAND, PARM);
|
||
|
|
34056 PARAMNOTUSED:=FALSE; END;
|
||
|
|
34060 LCX : (* INSTRUCTION LABEL EXPECTED *)
|
||
|
|
34070 (*+24() BEGIN WRITELABEL(FALSE,OPRAND); PARAMNOTUSED := FALSE END; ()+24*)
|
||
|
|
34072 (*-24() BEGIN WRITE(LGO,' *',OPRAND:0);
|
||
|
|
34073 PARAMNOTUSED:=FALSE; END; ()-24*)
|
||
|
|
34074 MOR : (* LONG (2-BYTE) OPERAND SUPPLIED BY CODETABLE *)
|
||
|
|
34076 EMITXWORD(OCVIMMED,PARM);
|
||
|
|
34080 END; (* OF CASE *)
|
||
|
|
34085 (*-24() TAKELINE; ()-24*)
|
||
|
|
34087 IF PARTYP>= ACP THEN
|
||
|
|
34090 BEGIN
|
||
|
|
34092 CASE PARTYP OF
|
||
|
|
34093 ANP,ACP: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,PARM(*-24()-120()-24*));
|
||
|
|
34094 ACX: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,OPRAND+PARM);
|
||
|
|
34095 ANX: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,-(OPRAND+PARM));
|
||
|
|
34096 ACB,ACL,ANL: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,0);
|
||
|
|
34097 END;
|
||
|
|
34099 END;
|
||
|
|
34100 OPCOD := NEXT;
|
||
|
|
34110 END
|
||
|
|
34120 ELSE
|
||
|
|
34130 BEGIN
|
||
|
|
34140 IF PARAMNOTUSED THEN PARAM(OCVNONE, 0, OPCOD);
|
||
|
|
34190 WRITEINSTN(LXL); WRITECON(CPACTCONS, SZWORD, 0); (*-24() TAKELINE; ()-24*) (*STATIC LINK*)
|
||
|
|
34200 WRITEINSTN(CAL);
|
||
|
|
34205 STRWLEN:=(RTNLENGTH+CHARPERWORD) DIV CHARPERWORD *SZWORD;
|
||
|
|
34210 ENEW(TEMP,LEX1SIZE+STRWLEN);
|
||
|
|
34220 WITH TEMP^ DO
|
||
|
|
34230 BEGIN
|
||
|
|
34240 FOR I:=1 TO RTNLENGTH DO S10[I]:=ROUTINE[I];
|
||
|
|
34250 LXCOUNT:=STRWLEN;
|
||
|
|
34260 END;
|
||
|
|
34262 EMITXWORD(OCVEXT,ORD(TEMP));
|
||
|
|
34264 EDISPOSE(TEMP,LEX1SIZE+STRWLEN);
|
||
|
|
34266 (*-24() TAKELINE ; ()-24*)
|
||
|
|
34270 OPCOD := 0;
|
||
|
|
34280 WRITEINSTN(ASP); WRITECON(CPACTCONS, SZWORD, ADJUSTSP+SZADDR);
|
||
|
|
34300 (*-24() TAKELINE ; ()-24*)
|
||
|
|
34310 END;
|
||
|
|
34312 FOR I:=1 TO MAXLABL DO
|
||
|
|
34320 IF COUNT[I] > 0 THEN (* ONE OF P-OPS REQUIRES A LABEL *)
|
||
|
|
34322 BEGIN
|
||
|
|
34330 IF COUNT[I] = 1 THEN WRITELABEL(FALSE,JUMPOVER[I]) ;
|
||
|
|
34340 COUNT[I] := COUNT[I]-1;
|
||
|
|
34342 END;
|
||
|
|
34350 END;
|
||
|
|
34360 END;
|
||
|
|
34370 (**)
|
||
|
|
34380 PROCEDURE FIXUPF (* (ALABL:LABL) *);
|
||
|
|
34390 BEGIN
|
||
|
|
34392 IF DATASTATE <> ENDDATA THEN BEGIN
|
||
|
|
34394 (*+24() IF DATASTATE=INDATA THEN BEGIN DATASTATE:=STARTDATA; WRITEINSTN(EOOPNDS) END; ()+24*)
|
||
|
|
34396 WRITELABEL(TRUE,ALABL); END
|
||
|
|
34398 ELSE
|
||
|
|
34400 WRITELABEL(FALSE,ALABL);
|
||
|
|
34410 END;
|
||
|
|
34420 (**)
|
||
|
|
34430 FUNCTION FIXUPM (* :LABL *);
|
||
|
|
34440 VAR L:LABL;
|
||
|
|
34450 BEGIN
|
||
|
|
34455 L := GETNEXTLABEL;
|
||
|
|
34456 FIXUPM := L;
|
||
|
|
34460 IF DATASTATE <> ENDDATA THEN (*GLOBAL DATA*)
|
||
|
|
34470 BEGIN
|
||
|
|
34480 (*+24() IF DATASTATE=INDATA THEN BEGIN DATASTATE:=STARTDATA; WRITEINSTN(EOOPNDS) END; ()+24*)
|
||
|
|
34500 WRITELABEL(TRUE,L);
|
||
|
|
34510 END
|
||
|
|
34520 ELSE
|
||
|
|
34530 BEGIN
|
||
|
|
34560 WRITELABEL(FALSE,L);
|
||
|
|
34570 END;
|
||
|
|
34580 END;
|
||
|
|
34590 (**)
|
||
|
|
34600 PROCEDURE FIXUPFIM(ALABL:LABL;VALUE:A68INT);
|
||
|
|
34610 BEGIN
|
||
|
|
34620 WRITELABEL(TRUE,ALABL); WRITEINSTN(CON);
|
||
|
|
34630 WRITECON(245, SZWORD, VALUE);
|
||
|
|
34640 WRITEINSTN(EOOPNDS);
|
||
|
|
34650 END;
|
||
|
|
34660 (**)
|
||
|
|
34670 PROCEDURE FIXLABL(OLDLABL,NEWLABL:LABL; KNOWN:BOOLEAN);
|
||
|
|
34680 VAR JUMPOVER: LABL;
|
||
|
|
34690 BEGIN
|
||
|
|
34700 JUMPOVER := GETNEXTLABEL;
|
||
|
|
34710 WRITEINSTN(BRA); (*+24() WRITELABEL(FALSE,JUMPOVER); ()+24*)
|
||
|
|
34712 (*-24()WRITE(LGO,' *',JUMPOVER:0); TAKELINE; ()-24*)
|
||
|
|
34720 WRITELABEL(FALSE,OLDLABL);
|
||
|
|
34730 WRITEINSTN(BRA); (*+24() WRITELABEL(FALSE,NEWLABL); ()+24*)
|
||
|
|
34732 (*-24()WRITE(LGO,' *',NEWLABL:0); TAKELINE; ()-24*)
|
||
|
|
34740 WRITELABEL(FALSE,JUMPOVER);
|
||
|
|
34750 (*-24() TAKELINE; ()-24*)
|
||
|
|
34760 END;
|
||
|
|
34770 (**)
|
||
|
|
34780 FUNCTION NORMAL(SB: PSB): SBTTYP;
|
||
|
|
34790 (*RETURNS THE SBTTYP IN WHICH VALUES OF MODE SB^.SBMODE SHOULD BE STORED DURING BALANCES*)
|
||
|
|
34800 BEGIN WITH SB^ DO WITH SBMODE^.MDV DO
|
||
|
|
34810 IF SBTYP=SBTDL THEN NORMAL := SBTDL
|
||
|
|
34820 ELSE IF SBUNION IN SBINF THEN NORMAL := SBTSTKN
|
||
|
|
34825 ELSE IF SBNAKED IN SBINF THEN NORMAL := SBTSTK4
|
||
|
|
34830 ELSE IF MDPILE THEN NORMAL := SBTSTK(*+19()2()+19*)
|
||
|
|
34840 ELSE CASE MDLEN OF
|
||
|
|
34850 0: NORMAL := SBTVOID;
|
||
|
|
34860 SZWORD: NORMAL := SBTSTK;
|
||
|
|
34870 (*+19() SZADDR: NORMAL := SBTSTK2; ()+19*)
|
||
|
|
34880 SZREAL: NORMAL := SBTSTK4;
|
||
|
|
34890 END;
|
||
|
|
34900 END;
|
||
|
|
34910 (**)
|
||
|
|
34920 FUNCTION LENOF(SB: PSB): INTEGER;
|
||
|
|
34930 BEGIN
|
||
|
|
34940 WITH SB^,SBMODE^.MDV DO
|
||
|
|
34950 IF (SBUNION IN SBINF) OR (SBTYP=SBTDL) THEN LENOF := SBLEN
|
||
|
|
34952 ELSE IF SBNAKED IN SBINF THEN LENOF := SZNAKED
|
||
|
|
34954 ELSE IF MDPILE THEN LENOF := SZADDR
|
||
|
|
34956 ELSE LENOF := MDLEN;
|
||
|
|
34960 END;
|
||
|
|
34970 (**)
|
||
|
|
34980 PROCEDURE LOADSTK(SB: PSB);
|
||
|
|
34990 BEGIN
|
||
|
|
34995 IF NOT(SB^.SBTYP IN [SBTSTKN,SBTDL]) THEN
|
||
|
|
35000 CASE LENOF(SB) OF
|
||
|
|
35010 0: LOAD(SBTVOID, SB);
|
||
|
|
35020 SZINT: LOAD(SBTSTK, SB);
|
||
|
|
35030 (*+19() SZADDR: LOAD(SBTSTK2, SB);
|
||
|
|
35032 6: LOAD(SBTSTK2A, SB); ()+19*)
|
||
|
|
35040 SZREAL: LOAD(SBTSTK4, SB);
|
||
|
|
35050 END;
|
||
|
|
35060 END;
|
||
|
|
35070 (**)
|
||
|
|
35080 PROCEDURE TWIST;
|
||
|
|
35090 VAR TEMPPTR : PSB;
|
||
|
|
35095 L1, L2, SAVE: INTEGER;
|
||
|
|
35100 BEGIN
|
||
|
|
35110 WITH RTSTACK^ DO BEGIN
|
||
|
|
35120 IF (SBRTSTK^.SBTYP IN [SBTSTK..SBTDL]) AND (SBTYP IN [SBTSTK..SBTPRR]) THEN
|
||
|
|
35121 BEGIN
|
||
|
|
35122 IF SBTYP=SBTPRR THEN LOADSTK(RTSTACK);
|
||
|
|
35123 SAVE := ADJUSTSP;
|
||
|
|
35124 L1:=LENOF(RTSTACK);L2:=LENOF(SBRTSTK);
|
||
|
|
35126 IF L1=L2 THEN
|
||
|
|
35128 CASE L1 OF
|
||
|
|
35130 SZWORD: EMITOP(PSWAP);
|
||
|
|
35132 (*+19() SZADDR: EMITOP(PSWAP+1); ()+19*)
|
||
|
|
35134 SZREAL: EMITOP(PSWAP+2);
|
||
|
|
35136 END
|
||
|
|
35138 ELSE (*STACK OBJECTS TO BE SWAPPED ARE NOT THE SAME SIZE*)
|
||
|
|
35140 EMITX2(PSWAP+3,OCVIMMED,L1,OCVIMMED,L2);
|
||
|
|
35141 ADJUSTSP := SAVE;
|
||
|
|
35142 END;
|
||
|
|
35144 TEMPPTR := SBRTSTK;
|
||
|
|
35150 SBRTSTK := TEMPPTR^.SBRTSTK;
|
||
|
|
35160 TEMPPTR^.SBRTSTK := RTSTACK;
|
||
|
|
35170 RTSTACK := TEMPPTR;
|
||
|
|
35180 END
|
||
|
|
35190 END;
|
||
|
|
35200 (**)
|
||
|
|
35210 PROCEDURE PROC1OP(OPCOD:POP;TYP:OPDTYP;OPND:ADDRINT;NOTINL:BOOLEAN);
|
||
|
|
35220 VAR SB:PSB;
|
||
|
|
35230 BEGIN
|
||
|
|
35240 SB:=ASPTR(OPND);
|
||
|
|
35250 IF RTSTACK<>SB THEN TWIST;
|
||
|
|
35255 IF NOTINL THEN CLEAR (RTSTACK^.SBRTSTK);
|
||
|
|
35260 LOAD(CODETABLE[OPCOD].P1,SB);
|
||
|
|
35270 UNSTKP1(TYP,SB);
|
||
|
|
35280 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
35290 END;
|
||
|
|
35300 (**)
|
||
|
|
35310 PROCEDURE PROC2OP(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;NOTINL:BOOLEAN);
|
||
|
|
35320 VAR SB1,SB2:PSB;
|
||
|
|
35330 BEGIN
|
||
|
|
35340 SB1:=ASPTR(OPND1);
|
||
|
|
35350 SB2:=ASPTR(OPND2);
|
||
|
|
35360 IF RTSTACK<>SB2 THEN TWIST;
|
||
|
|
35365 IF NOTINL THEN CLEAR (RTSTACK^.SBRTSTK^.SBRTSTK);
|
||
|
|
35370 WITH CODETABLE[OPCOD] DO
|
||
|
|
35380 BEGIN
|
||
|
|
35390 IF NOT (SB2^.SBTYP IN [SBTSTK..SBTSTKN,SBTVAR]) THEN
|
||
|
|
35400 BEGIN LOAD(P1,SB1); LOAD(P2,SB2) END
|
||
|
|
35410 ELSE BEGIN LOAD(P2,SB2); LOAD(P1,SB1); LOAD(P2,SB2) END;
|
||
|
|
35420 END;
|
||
|
|
35430 UNSTKP1(TYP2,SB2);
|
||
|
|
35440 UNSTKP1(TYP1,SB1);
|
||
|
|
35450 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
35460 END;
|
||
|
|
35470 (**)
|
||
|
|
35480 PROCEDURE FILL (WHERE:SBTTYP; SB:PSB);
|
||
|
|
35490 BEGIN
|
||
|
|
35500 WITH SB^ DO
|
||
|
|
35510 BEGIN
|
||
|
|
35515 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH:=RTSTKDEPTH-SBLEN;
|
||
|
|
35520 IF NOT(WHERE IN [SBTSTKN,SBTDL,SBTPRR,SBTXN]) THEN SBLEN := LENARRAY[WHERE];
|
||
|
|
35522 (*ELSE IF WHERE=SBTPRR THEN IT GET IT WRONG - SEE FIX IN SUBSTLEN*)
|
||
|
|
35530 IF WHERE IN [SBTSTK..SBTDL] THEN
|
||
|
|
35540 BEGIN
|
||
|
|
35550 RTSTKDEPTH := RTSTKDEPTH+SBLEN;
|
||
|
|
35560 WITH ROUTNL^ DO
|
||
|
|
35570 IF RTSTKDEPTH>RNLENSTK THEN RNLENSTK:=RTSTKDEPTH
|
||
|
|
35580 END;
|
||
|
|
35590 SBTYP:=WHERE;
|
||
|
|
35600 END
|
||
|
|
35610 END;
|
||
|
|
35620 (**)
|
||
|
|
35630 FUNCTION SETINLINE (OPCOD:POP):BOOLEAN;
|
||
|
|
35640 VAR INL:BOOLEAN;
|
||
|
|
35650 BEGIN
|
||
|
|
35660 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
35670 REPEAT WITH CODETABLE[OPCOD] DO
|
||
|
|
35680 BEGIN
|
||
|
|
35690 INL := INLINE;
|
||
|
|
35700 OPCOD := NEXT
|
||
|
|
35710 END
|
||
|
|
35720 UNTIL NOT(INL) OR (OPCOD=0);
|
||
|
|
35730 SETINLINE := INL
|
||
|
|
35740 END;
|
||
|
|
35750 (**)
|
||
|
|
35760 (**)
|
||
|
|
35770 PROCEDURE LOAD (* (WHERE:SBTTYP; SB:PSB) *);
|
||
|
|
35780 (*EMITS CODE TO MOVE SB TO WHERE: CALLS FILL TO RECORD THE MOVE*)
|
||
|
|
35790 VAR TEMPOP: POP;
|
||
|
|
35800 TOFFSET: OFFSETR;
|
||
|
|
35810 TEMPTYP: SBTTYP;
|
||
|
|
35812 OCVFIX: OPDTYP;
|
||
|
|
35820 TWISTED: BOOLEAN;
|
||
|
|
35830 SB1 :PSB;
|
||
|
|
35840 SAVE:INTEGER;
|
||
|
|
35850 BEGIN
|
||
|
|
35855 (*+21() WRITELN(OUTPUT,'LOAD ',ORD(SB),ORD(SB^.SBTYP):3,' TO ',ORD(WHERE):3, SB=RTSTACK); ()+21*)
|
||
|
|
35860 WITH SB^ DO
|
||
|
|
35870 BEGIN
|
||
|
|
35880 (*IF (SB=RTSTACK) AND (SBRTSTK<>NIL) THEN
|
||
|
|
35890 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
|
||
|
|
35900 BEGIN LOADSTK(SBRTSTK); SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY] END; *)
|
||
|
|
35902 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK);
|
||
|
|
35910 TWISTED := FALSE;
|
||
|
|
35930 IF WHERE IN [SBTSTKN,SBTPR1,SBTPR2] THEN
|
||
|
|
35940 LOADSTK(SB)
|
||
|
|
35950 ELSE IF WHERE=SBTXN THEN LOAD(NORMAL(SB),SB)
|
||
|
|
35960 ELSE
|
||
|
|
35970 IF (WHERE<>SBTVOID) AND (WHERE<>SBTYP) THEN
|
||
|
|
35980 BEGIN
|
||
|
|
35990 SB1 := RTSTACK;
|
||
|
|
36000 WHILE (SB1^.SBTYP IN [SBTID..SBTRPROC]) AND (SB1<>SB) DO
|
||
|
|
36010 SB1 := SB1^.SBRTSTK;
|
||
|
|
36020 IF SB1<>SB THEN
|
||
|
|
36030 BEGIN TWISTED:=TRUE; TWIST;
|
||
|
|
36032 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK);
|
||
|
|
36040 (*+32() ASERT (RTSTACK =SB,'LOAD-B '); ()+32*)
|
||
|
|
36050 END;
|
||
|
|
36080 IF WHERE IN [SBTPR1..SBTPRR] THEN TEMPOP := POPARRAY[NORMAL(SB),SBTYP]
|
||
|
|
36090 ELSE TEMPOP := POPARRAY[WHERE,SBTYP];
|
||
|
|
36100 (*+32() ASERT(TEMPOP<>PNONE,'LOAD-C '); ()+32*)
|
||
|
|
36110 IF TEMPOP<>PNOOP THEN
|
||
|
|
36120 CASE SBTYP OF
|
||
|
|
36130 SBTPROC,SBTRPROC,SBTVAR: BEGIN
|
||
|
|
36140 SAVE := ADJUSTSP;
|
||
|
|
36150 IF WHERE <> SBTPRR THEN BEGIN LOAD(SBTPRR,SB); LOAD(WHERE,SB) END
|
||
|
|
36160 ELSE BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);
|
||
|
|
36162 IF SBTYP=SBTVAR THEN
|
||
|
|
36170 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET)
|
||
|
|
36172 ELSE BEGIN (*SBTYP=SBTPROC OR SBTRPROC*)
|
||
|
|
36174 IF SBTYP=SBTPROC THEN OCVFIX := OCVMEM
|
||
|
|
36176 ELSE (* SBTRPROC *) OCVFIX := OCVFREF;
|
||
|
|
36177 EMITX2(TEMPOP,OCVFIX,SBXPTR,OCVLCLGBL,-SZADDR(*ANYTHING -VE*));
|
||
|
|
36178 END;
|
||
|
|
36179 END;
|
||
|
|
36180 ADJUSTSP := SAVE;
|
||
|
|
36190 END;
|
||
|
|
36200 (**)
|
||
|
|
36210 SBTID,SBTIDV: BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);EMITX1(TEMPOP,OCVLCLGBL,TOFFSET) END;
|
||
|
|
36220 SBTLIT: EMITX1(TEMPOP, OCVIMMED, SBVALUE);
|
||
|
|
36230 SBTDEN: GENDENOT(TEMPOP,SB);
|
||
|
|
36240 SBTPR1,SBTPR2,SBTPRR,
|
||
|
|
36250 SBTSTK,SBTSTK2,SBTDL,SBTSTK4: EMITOP(TEMPOP);
|
||
|
|
36260 END;
|
||
|
|
36270 FILL(WHERE,SB);
|
||
|
|
36280 END;
|
||
|
|
36290 IF TWISTED THEN TWIST;
|
||
|
|
36300 END;
|
||
|
|
36310 END;
|
||
|
|
36320 (**)
|
||
|
|
36330 PROCEDURE PARAM (*(TYP:OPDTYP; OPND:ADDRINT; OPCOD: POP)*);
|
||
|
|
36340 VAR TEMPOP:POP;
|
||
|
|
36350 OPERANDUSED, INL: BOOLEAN;
|
||
|
|
36360 BEGIN
|
||
|
|
36370 IF OCV<>OCVNONE THEN
|
||
|
|
36380 BEGIN
|
||
|
|
36390 TEMPOP := PPUSHIM;
|
||
|
|
36392 (*+19()IF OCV = OCVIMMLONG THEN TEMPOP:=TEMPOP+2 ELSE
|
||
|
|
36395 IF OCV = OCVIMMPTR THEN TEMPOP:=TEMPOP+2 ELSE ()+19*)
|
||
|
|
36400 IF OCV IN [OCVMEM,OCVFIM,OCVFREF] THEN TEMPOP:=TEMPOP+1; (*NOT FOR OCVFIM*)
|
||
|
|
36410 EMITOP(TEMPOP);ADJUSTSP:=ADJUSTSP+STKSPACE(CODETABLE[TEMPOP].EMCOD,0)
|
||
|
|
36420 END;
|
||
|
|
36450 IF TYP<>OCVNONE THEN
|
||
|
|
36460 BEGIN OPRAND:=OPND; OCV := TYP END;
|
||
|
|
36470 END;
|
||
|
|
36480 (**)
|
||
|
|
36490 ()+02*)
|
||
|
|
36500 (**)
|
||
|
|
36510 (*+01() (*+31() (*$T+ +) ()+31+) ()+01*)
|
||
|
|
36530 (**)
|
||
|
|
36540 (**)
|
||
|
|
36550 (* CYBER CODE EMITTER *)
|
||
|
|
36560 (**********************)
|
||
|
|
36570 (*-23()
|
||
|
|
36580 (*+01()
|
||
|
|
36590 PROCEDURE PUTLINK(OPCOD: POP);
|
||
|
|
36600 (*EMITS LINK TABLE FOR LINKINS CHAIN OF OPCOD*)
|
||
|
|
36610 VAR TABLEWORD: PACKED RECORD CASE INTEGER OF
|
||
|
|
36620 1: (INT: INTEGER);
|
||
|
|
36630 2: (ENTRY: PACKED ARRAY [1..7] OF CHAR; FILLER: 0..777777B);
|
||
|
|
36640 END;
|
||
|
|
36650 APFILLCHAIN, BPFILLCHAIN: PFILLCHAIN;
|
||
|
|
36660 SEQWORD, C: INTEGER;
|
||
|
|
36670 BEGIN WITH TABLEWORD, CODETABLE[OPCOD] DO
|
||
|
|
36680 BEGIN
|
||
|
|
36690 WRITE(LGO, 44000002000000000000B+(LINKINS^.COUNT DIV 2)*1000000000000B); (*LINK TABLE*)
|
||
|
|
36700 INT := 0;
|
||
|
|
36710 FOR C := 1 TO 7 DO
|
||
|
|
36720 IF ROUTINE[C]<>' ' THEN ENTRY[C] := ROUTINE[C];
|
||
|
|
36730 WRITE(LGO, INT);
|
||
|
|
36740 SEQWORD := 0;
|
||
|
|
36750 APFILLCHAIN := LINKINS;
|
||
|
|
36760 C := 1;
|
||
|
|
36770 REPEAT
|
||
|
|
36780 WITH APFILLCHAIN^ DO
|
||
|
|
36790 BEGIN
|
||
|
|
36800 SEQWORD := SEQWORD*10000000000B+(7-FFOUR)*1000000000B+1000000B+FSEGLOC;
|
||
|
|
36810 C := C+1;
|
||
|
|
36820 IF ODD(C) THEN BEGIN WRITE(LGO, SEQWORD); SEQWORD := 0 END;
|
||
|
|
36830 BPFILLCHAIN := APFILLCHAIN; APFILLCHAIN := LINK; DISPOSE(BPFILLCHAIN)
|
||
|
|
36840 END
|
||
|
|
36850 UNTIL APFILLCHAIN=NIL;
|
||
|
|
36860 IF NOT ODD(C) THEN
|
||
|
|
36870 BEGIN SEQWORD := SEQWORD*10000000000B; WRITE(LGO, SEQWORD) END;
|
||
|
|
36880 LINKINS := NIL
|
||
|
|
36890 END
|
||
|
|
36900 END;
|
||
|
|
36910 (**)
|
||
|
|
36920 PROCEDURE PLANTWORD;
|
||
|
|
36930 (*CALLED WHENEVER A COMPLETE WORD OF 15 OR 30 BIT INSTRUCTIONS IS COMPLETE*)
|
||
|
|
36940 VAR I: INTEGER;
|
||
|
|
36950 BEGIN
|
||
|
|
36960 WITH XSEG DO
|
||
|
|
36970 BEGIN
|
||
|
|
36980 FOUR := 1;
|
||
|
|
36990 IF FIFTEEN<15 THEN
|
||
|
|
37000 FIFTEEN := FIFTEEN+1
|
||
|
|
37010 ELSE
|
||
|
|
37020 BEGIN
|
||
|
|
37030 SEGLOC := SEGLOC+15;
|
||
|
|
37040 WITH BUFFER[LAST] DO CODEWORD := CODEWORD+RELOCATION; RELOCATION := 0;
|
||
|
|
37050 LAST := (LAST+16) MOD 128;
|
||
|
|
37060 FIFTEEN := 1;
|
||
|
|
37070 IF LAST=FIRST THEN WITH HEADERWORD DO
|
||
|
|
37080 BEGIN
|
||
|
|
37090 WRITE(LGO, WORD);
|
||
|
|
37100 FOR I := FIRST TO FIRST+15 DO
|
||
|
|
37110 WRITE(LGO, BUFFER[I].CODEWORD);
|
||
|
|
37120 FIRST := (FIRST+16) MOD 128;
|
||
|
|
37130 S := S+15
|
||
|
|
37140 END;
|
||
|
|
37150 BUFFER[LAST].CODEWORD := 0 (*NEXT RELOCATION*)
|
||
|
|
37160 END;
|
||
|
|
37170 BUFFER[LAST+FIFTEEN].CODEWORD := 0
|
||
|
|
37180 END
|
||
|
|
37190 END;
|
||
|
|
37200 (**)
|
||
|
|
37210 (**)
|
||
|
|
37220 PROCEDURE UPPER;
|
||
|
|
37230 (*FORCES NEXT INSTRUCTION TO BE AT START OF A WORD*)
|
||
|
|
37240 CONST SHIFT1=100000B; SHIFT2=10000000000B; SHIFT3=1000000000000000B;
|
||
|
|
37250 NOOP1=46000B; NOOP2=4600046000B; NOOP3=460004600046000B;
|
||
|
|
37260 BEGIN WITH XSEG DO WITH BUFFER[LAST+FIFTEEN] DO
|
||
|
|
37270 CASE FOUR OF
|
||
|
|
37280 1: (*NO ACTION*);
|
||
|
|
37290 2: BEGIN
|
||
|
|
37300 CODEWORD := CODEWORD*SHIFT3+NOOP3;
|
||
|
|
37310 RELOCATION := RELOCATION*8;
|
||
|
|
37320 PLANTWORD
|
||
|
|
37330 END;
|
||
|
|
37340 3: BEGIN
|
||
|
|
37350 CODEWORD := CODEWORD*SHIFT2+NOOP2;
|
||
|
|
37360 RELOCATION := RELOCATION*4;
|
||
|
|
37370 PLANTWORD
|
||
|
|
37380 END;
|
||
|
|
37390 4: BEGIN
|
||
|
|
37400 CODEWORD := CODEWORD*SHIFT1+NOOP1;
|
||
|
|
37410 RELOCATION := RELOCATION*2;
|
||
|
|
37420 PLANTWORD
|
||
|
|
37430 END
|
||
|
|
37440 END
|
||
|
|
37450 END;
|
||
|
|
37460 (**)
|
||
|
|
37470 (**)
|
||
|
|
37480 PROCEDURE DOFREF(OPERAND: INTEGER);
|
||
|
|
37490 VAR APFCHAIN: PFCHAIN;
|
||
|
|
37500 BEGIN NEW(APFCHAIN); WITH XSEG, APFCHAIN^ DO
|
||
|
|
37510 BEGIN
|
||
|
|
37520 FLAST := LAST; FFIFTEEN := FIFTEEN; FFOUR := FOUR;
|
||
|
|
37530 FSEGLOC := SEGLOC; FLABL := OPERAND;
|
||
|
|
37540 LINK := TPFCHAIN^.LINK; TPFCHAIN^.LINK := APFCHAIN
|
||
|
|
37550 END
|
||
|
|
37560 END;
|
||
|
|
37570 (**)
|
||
|
|
37580 (**)
|
||
|
|
37590 PROCEDURE EMITXWORD(TYP: OPDTYP; OPERAND: INTEGER);
|
||
|
|
37600 BEGIN
|
||
|
|
37610 UPPER;
|
||
|
|
37620 WITH XSEG DO WITH BUFFER[LAST+FIFTEEN] DO
|
||
|
|
37630 CASE TYP OF
|
||
|
|
37640 OCVIMMED:
|
||
|
|
37650 BEGIN CODEWORD := OPERAND; RELOCATION := RELOCATION*16 END;
|
||
|
|
37660 OCVMEM:
|
||
|
|
37670 BEGIN CODEWORD := OPERAND; RELOCATION := RELOCATION*16+2 END;
|
||
|
|
37680 OCVFIM,OCVFREF:
|
||
|
|
37690 BEGIN CODEWORD := 0; RELOCATION := RELOCATION*16; FOUR := 3; DOFREF(OPERAND) END;
|
||
|
|
37700 END;
|
||
|
|
37710 PLANTWORD
|
||
|
|
37720 END;
|
||
|
|
37730 (**)
|
||
|
|
37740 (**)
|
||
|
|
37750 PROCEDURE EMITALF(OPERAND: BIGALFA);
|
||
|
|
37760 VAR ALFWD: RECORD CASE SEVERAL OF
|
||
|
|
37770 1: (INT: INTEGER);
|
||
|
|
37780 2: (ALF: BIGALFA);
|
||
|
|
37790 END;
|
||
|
|
37800 BEGIN
|
||
|
|
37810 ALFWD.ALF := OPERAND;
|
||
|
|
37820 EMITXWORD(OCVIMMED, ALFWD.INT);
|
||
|
|
37830 END;
|
||
|
|
37840 (**)
|
||
|
|
37850 (**)
|
||
|
|
37860 (**)
|
||
|
|
37870 (**)
|
||
|
|
37880 PROCEDURE FILL (WHERE:SBTTYP; SB:PSB);
|
||
|
|
37890 BEGIN
|
||
|
|
37900 WITH SB^ DO
|
||
|
|
37910 BEGIN
|
||
|
|
37920 IF NOT(WHERE IN [SBTSTKN,SBTDL,SBTXN]) THEN SBLEN := LENARRAY[WHERE];
|
||
|
|
37930 IF WHERE IN [SBTSTK..SBTDL] THEN
|
||
|
|
37940 BEGIN
|
||
|
|
37950 RTSTKDEPTH := RTSTKDEPTH+SBLEN;
|
||
|
|
37960 WITH ROUTNL^ DO
|
||
|
|
37970 IF RTSTKDEPTH>RNLENSTK THEN RNLENSTK:=RTSTKDEPTH
|
||
|
|
37980 END
|
||
|
|
37990 (*+32()ELSE ASERT(REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SBTYP])=[],'FILL-A ') ()+32*);
|
||
|
|
38000 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH:=RTSTKDEPTH-SBLEN+ORD(WHERE=SBTDL);
|
||
|
|
38010 REGSINUSE:=REGSINUSE-REGISTERS[SBTYP]+REGISTERS[WHERE];
|
||
|
|
38020 SBTYP:=WHERE
|
||
|
|
38030 END
|
||
|
|
38040 END;
|
||
|
|
38050 (**)
|
||
|
|
38060 FUNCTION SETINLINE (OPCOD:POP):BOOLEAN;
|
||
|
|
38070 VAR INL:BOOLEAN;
|
||
|
|
38080 BEGIN
|
||
|
|
38090 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
38100 REPEAT WITH CODETABLE[OPCOD] DO
|
||
|
|
38110 BEGIN
|
||
|
|
38120 INL := INLINE;
|
||
|
|
38130 OPCOD := NEXT
|
||
|
|
38140 END
|
||
|
|
38150 UNTIL NOT(INL) OR (OPCOD=0);
|
||
|
|
38160 SETINLINE := INL
|
||
|
|
38170 END;
|
||
|
|
38180 (**)
|
||
|
|
38190 FUNCTION NORMAL(SB: PSB): SBTTYP;
|
||
|
|
38200 (*RETURNS THE SBTTYP IN WHICH VALUES OF MODE SB^.SBMODE SHOULD BE STORED DURING BALANCES*)
|
||
|
|
38210 BEGIN WITH SB^ DO WITH SBMODE^.MDV DO
|
||
|
|
38220 IF SBTYP=SBTDL THEN NORMAL := SBTDL
|
||
|
|
38230 ELSE IF SBUNION IN SBINF THEN NORMAL := SBTSTKN
|
||
|
|
38240 ELSE IF MDPILE THEN NORMAL := SBTX1
|
||
|
|
38250 ELSE CASE MDLEN OF
|
||
|
|
38260 0: NORMAL := SBTVOID;
|
||
|
|
38270 1: NORMAL := SBTX1;
|
||
|
|
38280 (*+61() 2: NORMAL := SBTX12; ()+61*)
|
||
|
|
38290 END;
|
||
|
|
38300 END;
|
||
|
|
38310 (**)
|
||
|
|
38320 (**)
|
||
|
|
38330 (**)
|
||
|
|
38340 PROCEDURE LOADSTK(SB: PSB);
|
||
|
|
38350 VAR LEN: 0..MAXSIZE;
|
||
|
|
38360 BEGIN
|
||
|
|
38370 WITH SB^ DO WITH SBMODE^.MDV DO
|
||
|
|
38380 BEGIN
|
||
|
|
38390 IF SBUNION IN SBINF THEN LEN := SBLEN ELSE IF MDPILE THEN LEN:=SZADDR ELSE LEN := MDLEN;
|
||
|
|
38400 IF SBTYP<>SBTDL THEN
|
||
|
|
38410 CASE LEN OF
|
||
|
|
38420 0: LOAD(SBTVOID, SB);
|
||
|
|
38430 1: LOAD(SBTSTK, SB);
|
||
|
|
38440 2: (*+61() LOAD(SBTSTK2, SB);
|
||
|
|
38450 3: ()+61*) (*LEAVE IT WHERE IT IS*);
|
||
|
|
38460 END;
|
||
|
|
38470 END;
|
||
|
|
38480 END;
|
||
|
|
38490 ()+01*)
|
||
|
|
38500 ()-23*)
|
||
|
|
38510 (**)
|
||
|
|
38520 PROCEDURE CLEAR (* (SB:PSB) *);
|
||
|
|
38530 (*ENSURES THAT NOTHING ON RTSTACK FROM SB DOWNWARDS IS IN A REGISTER*)
|
||
|
|
38540 VAR TEMPPTR:PSB; BOOL:BOOLEAN;
|
||
|
|
38550 BEGIN
|
||
|
|
38560 TEMPPTR:=SB;
|
||
|
|
38570 BOOL := TRUE;
|
||
|
|
38580 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP<SBTSTK THEN
|
||
|
|
38590 REPEAT
|
||
|
|
38600 BEGIN
|
||
|
|
38610 TEMPPTR:=TEMPPTR^.SBRTSTK;
|
||
|
|
38620 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP>SBTSTKN THEN BOOL:=FALSE;
|
||
|
|
38630 END
|
||
|
|
38640 UNTIL NOT(BOOL) OR (TEMPPTR=NIL);
|
||
|
|
38650 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP>SBTSTKN THEN LOADSTK(TEMPPTR);
|
||
|
|
38660 END;
|
||
|
|
38670 (**)
|
||
|
|
38680 (*-23()
|
||
|
|
38690 (*+01()
|
||
|
|
38700 (**)
|
||
|
|
38710 PROCEDURE TWIST;
|
||
|
|
38720 VAR TEMPPTR : PSB;
|
||
|
|
38730 BEGIN
|
||
|
|
38740 WITH RTSTACK^ DO BEGIN
|
||
|
|
38750 IF (SBRTSTK^.SBTYP IN [SBTSTK..SBTSTKN])AND(SBTYP>=SBTSTK) THEN (*PHYSICAL UNTWISTING NEEDED*)
|
||
|
|
38760 BEGIN
|
||
|
|
38770 (*+32() ASERT(SBTYP>SBTDL, 'TWIST-A '); ()+32*)
|
||
|
|
38780 LOAD(NORMAL(SBRTSTK),SBRTSTK);
|
||
|
|
38790 END;
|
||
|
|
38800 TEMPPTR := SBRTSTK;
|
||
|
|
38810 SBRTSTK := TEMPPTR^.SBRTSTK;
|
||
|
|
38820 TEMPPTR^.SBRTSTK := RTSTACK;
|
||
|
|
38830 RTSTACK := TEMPPTR;
|
||
|
|
38840 END
|
||
|
|
38850 END;
|
||
|
|
38860 (**)
|
||
|
|
38870 PROCEDURE LOAD (* (WHERE:SBTTYP; SB:PSB) *);
|
||
|
|
38880 (*EMITS CODE TO MOVE SB TO WHERE: CALLS FILL TO RECORD THE MOVE*)
|
||
|
|
38890 VAR TEMPOP: POP;
|
||
|
|
38900 TOFFSET: OFFSETR;
|
||
|
|
38910 TEMPTYP: SBTTYP;
|
||
|
|
38920 OCVFIX: OPDTYP;
|
||
|
|
38930 BEGIN
|
||
|
|
38940 WITH SB^ DO
|
||
|
|
38950 BEGIN
|
||
|
|
38960 (*+21() WRITELN('LOAD',ORD(SB):6 OCT,ORD(SB^.SBTYP):3,ORD(WHERE):3);()+21*)
|
||
|
|
38970 IF SBRTSTK<>NIL THEN
|
||
|
|
38980 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
|
||
|
|
38990 BEGIN LOADSTK(SBRTSTK); SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY] END;
|
||
|
|
39000 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK)
|
||
|
|
39010 ELSE
|
||
|
|
39020 BEGIN (*WHERE IS SOME REGISTER*)
|
||
|
|
39030 (*+32()ASERT((SB=RTSTACK)OR(SB=RTSTACK^.SBRTSTK)OR(SBTYP IN [SBTVAR,SBTPROC,SBTRPROC]),'LOAD-A '); ()+32*)
|
||
|
|
39040 IF SB=RTSTACK^.SBRTSTK THEN (*SB IS SECOND ON RTSTACK*) WITH RTSTACK^ DO
|
||
|
|
39050 BEGIN
|
||
|
|
39060 IF REGISTERS[WHERE]*REGISTERS[SBTYP]<>[] THEN
|
||
|
|
39070 IF WHERE IN [SBTX1,SBTX5(*+61(),SBTX12,SBTX45()+61*)] THEN
|
||
|
|
39080 IF (SB^.SBTYP IN [SBTX1,SBTX5]) AND (SBTYP IN [SBTX1,SBTX5]) THEN
|
||
|
|
39090 BEGIN EMITOP(PSWAP); TEMPTYP := SBTYP; SBTYP := SB^.SBTYP; SB^.SBTYP := TEMPTYP END
|
||
|
|
39100 ELSE IF SBTYP=SBTX1 THEN LOAD(SBTX5,RTSTACK)
|
||
|
|
39110 (*+61() ELSE IF SBTYP=SBTX12 THEN LOAD(SBTX45,RTSTACK)
|
||
|
|
39120 ELSE IF SBTYP=SBTX45 THEN LOAD(SBTX12,RTSTACK)
|
||
|
|
39130 ()+61*)
|
||
|
|
39140 ELSE LOAD(SBTX1,RTSTACK)
|
||
|
|
39150 ELSE IF REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SB^.SBTYP])<>[] THEN CLEAR(SBRTSTK)
|
||
|
|
39160 END
|
||
|
|
39170 ELSE (*SB IS FIRST ON RTSTACK*)
|
||
|
|
39180 IF REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SBTYP])<>[] THEN
|
||
|
|
39190 IF REGISTERS[SBRTSTK^.SBTYP]*REGISTERS[WHERE]<>[] THEN CLEAR(SBRTSTK)
|
||
|
|
39200 ELSE CLEAR(SBRTSTK^.SBRTSTK)
|
||
|
|
39210 END;
|
||
|
|
39220 IF WHERE = SBTXN THEN
|
||
|
|
39230 LOAD(NORMAL(SB), SB)
|
||
|
|
39240 ELSE IF WHERE = SBTSTKN THEN
|
||
|
|
39250 LOADSTK(SB)
|
||
|
|
39260 ELSE
|
||
|
|
39270 BEGIN
|
||
|
|
39280 IF WHERE<>SBTVOID THEN
|
||
|
|
39290 BEGIN
|
||
|
|
39300 TEMPOP := POPARRAY[WHERE,SBTYP];
|
||
|
|
39310 (*+32()ASERT(TEMPOP<>PNONE,'LOAD-C '); ()+32*)
|
||
|
|
39320 IF TEMPOP<>PNOOP THEN
|
||
|
|
39330 BEGIN
|
||
|
|
39340 CASE SBTYP OF
|
||
|
|
39350 SBTRPROC,SBTPROC,SBTVAR: IF WHERE<>SBTX6 THEN
|
||
|
|
39360 BEGIN LOAD(SBTX6, SB); LOAD(WHERE, SB) END
|
||
|
|
39370 ELSE BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);
|
||
|
|
39380 IF SBTYP=SBTVAR THEN
|
||
|
|
39390 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET)
|
||
|
|
39400 ELSE BEGIN (*SBTYP=SBTPROC OR SBTRPROC*)
|
||
|
|
39410 IF SBTYP=SBTPROC THEN OCVFIX := OCVMEM
|
||
|
|
39420 ELSE (* SBTRPROC *) OCVFIX := OCVFREF;
|
||
|
|
39430 EMITX2(TEMPOP,OCVFIX,SBXPTR,OCVLCLGBL,TOFFSET);
|
||
|
|
39440 END
|
||
|
|
39450 END;
|
||
|
|
39460 (**)
|
||
|
|
39470 SBTID,SBTIDV: BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);EMITX1(TEMPOP,OCVLCLGBL,TOFFSET) END;
|
||
|
|
39480 SBTLIT: EMITX1(TEMPOP, OCVIMMED, SBVALUE);
|
||
|
|
39490 SBTDEN: GENDENOT(TEMPOP,SB);
|
||
|
|
39500 SBTSTK,SBTDL,(*+61()SBTSTK2,SBTX12,SBTX45,()+61*)SBTX5,SBTX6,SBTX0,SBTX1: EMITOP(TEMPOP)
|
||
|
|
39510 END;
|
||
|
|
39520 END
|
||
|
|
39530 END;
|
||
|
|
39540 FILL(WHERE,SB);
|
||
|
|
39550 END;
|
||
|
|
39560 END
|
||
|
|
39570 END;
|
||
|
|
39580 (**)
|
||
|
|
39590 (**)
|
||
|
|
39600 ()+01*)
|
||
|
|
39610 ()-23*)
|
||
|
|
39620 PROCEDURE UNSTKP1 (*+05() (TYP:OPDTYP; OPND:PSB) ()+05*);
|
||
|
|
39630 BEGIN
|
||
|
|
39640 IF TYP = OCVSBS THEN
|
||
|
|
39650 (*ASSERT: OPND = RTSTACK*)
|
||
|
|
39660 REPEAT
|
||
|
|
39670 OPND := RTSTACK;
|
||
|
|
39680 UNSTACKSB;
|
||
|
|
39690 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN;
|
||
|
|
39700 OPND^.SBTYP := SBTVOID;
|
||
|
|
39710 UNTIL OPND^.SBRTSTK =SRSTK[SRSUBP+1].SB^.SBRTSTK
|
||
|
|
39720 ELSE IF TYP <> OCVSBP THEN
|
||
|
|
39730 BEGIN UNSTACKSB;
|
||
|
|
39740 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN;
|
||
|
|
39750 OPND^.SBTYP:=SBTVOID;
|
||
|
|
39760 END
|
||
|
|
39770 (*+02() ELSE (*TYP=OCVSBP*) ADJUSTSP := ADJUSTSP-LENOF(OPND); ()+02*)
|
||
|
|
39780 END;
|
||
|
|
39790 (**)
|
||
|
|
39800 (*-23()
|
||
|
|
39810 (*+01()
|
||
|
|
39820 (**)
|
||
|
|
39830 PROCEDURE PROC1OP (OPCOD:POP; TYP:OPDTYP; OPND:INTEGER; NOTINL:BOOLEAN);
|
||
|
|
39840 VAR SB:PSB;
|
||
|
|
39850 BEGIN
|
||
|
|
39860 SB := ASPTR(OPND);
|
||
|
|
39870 WITH CODETABLE[OPCOD] DO
|
||
|
|
39880 BEGIN
|
||
|
|
39890 (*+32()ASERT((P1<>SBTVOID)AND(P2=SBTVOID),'PROC1OP-A '); ()+32*)
|
||
|
|
39900 IF RTSTACK<>SB THEN TWIST;
|
||
|
|
39910 (*+32()ASERT(RTSTACK=SB,'PROC1OP-B '); ()+32*)
|
||
|
|
39920 LOAD(P1,SB);
|
||
|
|
39930 IF NOTINL THEN CLEAR(RTSTACK^.SBRTSTK);
|
||
|
|
39940 NEXTREG := ORD(P1 IN [SBTX0,SBTX1]);
|
||
|
|
39950 UNSTKP1(TYP,SB);
|
||
|
|
39960 END;
|
||
|
|
39970 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
39980 END;
|
||
|
|
39990 (**)
|
||
|
|
40000 PROCEDURE PROC2OP (OPCOD:POP; TYP1:OPDTYP;OPND1:INTEGER; TYP2:OPDTYP;OPND2:INTEGER; NOTINL:BOOLEAN);
|
||
|
|
40010 VAR SB1,SB2:PSB;
|
||
|
|
40012 TEMP:PSB;
|
||
|
|
40020 BEGIN
|
||
|
|
40030 SB1 := ASPTR(OPND1);
|
||
|
|
40040 SB2 := ASPTR(OPND2);
|
||
|
|
40050 WITH CODETABLE[OPCOD] DO
|
||
|
|
40060 BEGIN
|
||
|
|
40070 (*+32()ASERT((P1 <>SBTVOID)AND(P2<>SBTVOID),'PROC2OP-A '); ()+32*)
|
||
|
|
40080 IF RTSTACK<>SB2 THEN TWIST;
|
||
|
|
40090 (*+32()ASERT(RTSTACK=SB2,'PROC2OP-B '); ()+32*)
|
||
|
|
40100 IF NOT (SB2^.SBTYP IN [SBTSTK..SBTSTKN,SBTVAR,SBTPROC]) THEN
|
||
|
|
40110 BEGIN LOAD(P1,SB1); LOAD(P2,SB2) END
|
||
|
|
40120 ELSE BEGIN LOAD(P2,SB2); LOAD(P1,SB1); LOAD(P2,SB2) (*IN CASE SB1^.SBTYP WAS SBTVAR*) END;
|
||
|
|
40130 IF NOTINL THEN CLEAR(RTSTACK^.SBRTSTK^.SBRTSTK);
|
||
|
|
40140 NEXTREG:= ORD(P1 IN [SBTX0,SBTX1])+ ORD(P2 IN [SBTX0,SBTX1]);
|
||
|
|
40150 (*+32()ASERT((TYP1=OCVSBP)OR NOT(TYP2 IN[OCVSBP,OCVSBS]),'PROC2OP-C '); ()+32*)
|
||
|
|
40160 UNSTKP1(TYP2,SB2);
|
||
|
|
40170 UNSTKP1(TYP1,SB1)
|
||
|
|
40180 END;
|
||
|
|
40190 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
|
||
|
|
40200 END;
|
||
|
|
40210 (**)
|
||
|
|
40220 PROCEDURE PARAM (TYP:OPDTYP; OPND:INTEGER; OPCOD: POP);
|
||
|
|
40230 VAR TEMPOP:POP;
|
||
|
|
40240 TEMPREG: INTEGER;
|
||
|
|
40250 BEGIN
|
||
|
|
40260 IF OCV<>OCVNONE THEN
|
||
|
|
40270 BEGIN
|
||
|
|
40280 CASE NEXTREG OF
|
||
|
|
40290 0: TEMPOP := PLOADX0IM;
|
||
|
|
40300 1: TEMPOP := PLOADX1IM;
|
||
|
|
40310 2: TEMPOP := PLOADX2IM;
|
||
|
|
40320 3: TEMPOP := PLOADX3IM;
|
||
|
|
40330 4: TEMPOP := PLOADX4IM
|
||
|
|
40340 END;
|
||
|
|
40350 NEXTREG := NEXTREG+1;
|
||
|
|
40360 IF (OPRAND<400000B)AND(OPRAND>-400000B) THEN EMITOP(TEMPOP)
|
||
|
|
40370 ELSE BEGIN
|
||
|
|
40380 TEMPREG := NEXTREG;
|
||
|
|
40390 EMITCONST(OPRAND);
|
||
|
|
40400 NEXTREG := TEMPREG;
|
||
|
|
40410 OCV := OCVMEM; OPRAND := FIXUPM-1;
|
||
|
|
40420 EMITOP(TEMPOP+1)
|
||
|
|
40430 END
|
||
|
|
40440 END;
|
||
|
|
40470 OPRAND:=OPND; OCV := TYP;
|
||
|
|
40480 END;
|
||
|
|
40490 (**)
|
||
|
|
40500 PROCEDURE EMITOP (* (OPCOD: POP) *) ;
|
||
|
|
40510 LABEL 11;
|
||
|
|
40520 CONST NOOP1=46000B; NOOP2=4600046000B; SETX7=7170000000B; EQ=0400000000B;
|
||
|
|
40530 SHIFT1=100000B; SHIFT2=10000000000B;
|
||
|
|
40540 VAR LINKP: PFILLCHAIN; APFCHAIN: PFCHAIN;
|
||
|
|
40550 ALFWD: RECORD CASE SEVERAL OF
|
||
|
|
40560 1: (INT: INTEGER);
|
||
|
|
40570 2: (LEX: PLEX)
|
||
|
|
40580 END;
|
||
|
|
40590 I: INTEGER;
|
||
|
|
40600 FMIJKCOPY: 0..7777777777B;
|
||
|
|
40610 FORCOUNT, COUNT: INTEGER; FORLABL: LABL;
|
||
|
|
40620 VP1, VP2 : SBTTYP;
|
||
|
|
40630 PARAMNOTUSED: BOOLEAN;
|
||
|
|
40640 BEGIN
|
||
|
|
40650 (*SEMCLKS := SEMCLKS+1;
|
||
|
|
40660 EMITCLK := EMITCLK-CLOCK;*)
|
||
|
|
40670 COUNT := 0; FORCOUNT := 0; PARAMNOTUSED := TRUE;
|
||
|
|
40671 IF OCV=OCVLCLGBL THEN
|
||
|
|
40672 BEGIN
|
||
|
|
40673 IF LCLGBL<>0 THEN
|
||
|
|
40674 FOR I := 1 TO LCLGBL DO
|
||
|
|
40675 IF I=1 (*FIRST CASE*) THEN EMITX0(PENVCHAIN)
|
||
|
|
40676 ELSE EMITX0(PENVCHAIN+1);
|
||
|
|
40677 OCV := OCVIMMED;
|
||
|
|
40678 END;
|
||
|
|
40680 WHILE OPCOD<>0 DO WITH XSEG, CODETABLE[OPCOD] DO
|
||
|
|
40690 BEGIN
|
||
|
|
40700 IF INLINE THEN
|
||
|
|
40710 BEGIN
|
||
|
|
40720 11: WITH BUFFER[LAST+FIFTEEN] DO
|
||
|
|
40730 BEGIN
|
||
|
|
40740 CASE LEN OF
|
||
|
|
40750 F0:
|
||
|
|
40760 FORLABL := FIXUPM;
|
||
|
|
40770 F15:
|
||
|
|
40780 BEGIN
|
||
|
|
40790 CODEWORD := CODEWORD*SHIFT1+FMIJK;
|
||
|
|
40800 FOUR := FOUR+1; RELOCATION := RELOCATION*2
|
||
|
|
40810 END;
|
||
|
|
40820 F30:
|
||
|
|
40830 IF FOUR<4 THEN
|
||
|
|
40840 BEGIN
|
||
|
|
40850 IF REL >= 0 THEN
|
||
|
|
40860 BEGIN
|
||
|
|
40870 IF REL > 0 THEN
|
||
|
|
40880 BEGIN FORCOUNT:=COUNT+REL; FORLABL:=GETNEXTLABL;
|
||
|
|
40890 DOFREF(FORLABL) END;
|
||
|
|
40900 CODEWORD := CODEWORD*SHIFT2+FMIJK;
|
||
|
|
40910 FOUR := FOUR+2; RELOCATION := RELOCATION*4
|
||
|
|
40920 END
|
||
|
|
40930 ELSE IF REL < 0 THEN
|
||
|
|
40940 BEGIN
|
||
|
|
40950 CODEWORD := CODEWORD+SHIFT2+FMIJK+FORLABL;
|
||
|
|
40960 RELOCATION := RELOCATION*4+2
|
||
|
|
40970 END;
|
||
|
|
40980 END
|
||
|
|
40990 ELSE
|
||
|
|
41000 BEGIN
|
||
|
|
41010 CODEWORD := CODEWORD*SHIFT1+NOOP1;
|
||
|
|
41020 RELOCATION := RELOCATION*2;
|
||
|
|
41030 PLANTWORD; GOTO 11
|
||
|
|
41040 END;
|
||
|
|
41050 F30K:
|
||
|
|
41060 IF FOUR<4 THEN
|
||
|
|
41070 BEGIN
|
||
|
|
41080 IF ODD(FMIJK) THEN
|
||
|
|
41090 BEGIN
|
||
|
|
41100 (*+32() ASERT(OCV IN [OCVIMMED,OCVIMMLONG], 'EMITOP-A '); ()+32*)
|
||
|
|
41110 FMIJKCOPY := FMIJK-1; OPRAND := -OPRAND;
|
||
|
|
41120 END
|
||
|
|
41130 ELSE FMIJKCOPY := FMIJK;
|
||
|
|
41140 CASE OCV OF
|
||
|
|
41150 OCVIMMED,OCVIMMLONG,OCVIMMPTR:
|
||
|
|
41160 BEGIN
|
||
|
|
41170 IF OPRAND<0 THEN OPRAND := OPRAND+777777B;
|
||
|
|
41180 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY+OPRAND;
|
||
|
|
41190 RELOCATION := RELOCATION*4
|
||
|
|
41200 END;
|
||
|
|
41210 OCVMEM:
|
||
|
|
41220 BEGIN
|
||
|
|
41230 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY+OPRAND;
|
||
|
|
41240 RELOCATION := RELOCATION*4+2
|
||
|
|
41250 END;
|
||
|
|
41260 OCVEXT:
|
||
|
|
41270 BEGIN
|
||
|
|
41280 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY;
|
||
|
|
41290 RELOCATION := RELOCATION*4;
|
||
|
|
41300 NEW(LINKP); WITH LINKP^, ALFWD, CODETABLE[PPOP] DO
|
||
|
|
41310 BEGIN
|
||
|
|
41320 FSEGLOC := SEGLOC+FIFTEEN-1; FFOUR := FOUR;
|
||
|
|
41330 COUNT := 0;
|
||
|
|
41340 LINK := NIL;
|
||
|
|
41350 INT := OPRAND;
|
||
|
|
41360 FOR I := 1 TO 7 DO
|
||
|
|
41370 WITH LEX^ DO
|
||
|
|
41380 IF S10[I]=' ' THEN ROUTINE[I] := ':' ELSE ROUTINE[I] := S10[I];
|
||
|
|
41390 LINKINS := LINKP; PUTLINK(PPOP)
|
||
|
|
41400 END
|
||
|
|
41410 END;
|
||
|
|
41420 OCVFIM, OCVFREF:
|
||
|
|
41430 BEGIN
|
||
|
|
41440 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY;
|
||
|
|
41450 RELOCATION := RELOCATION*4;
|
||
|
|
41460 DOFREF(OPRAND);
|
||
|
|
41470 END
|
||
|
|
41480 END;
|
||
|
|
41490 FOUR := FOUR+2;
|
||
|
|
41500 PARAMNOTUSED := FALSE;
|
||
|
|
41510 END
|
||
|
|
41520 ELSE
|
||
|
|
41530 BEGIN
|
||
|
|
41540 CODEWORD := CODEWORD*SHIFT1+NOOP1;
|
||
|
|
41550 RELOCATION := RELOCATION*2;
|
||
|
|
41560 PLANTWORD; GOTO 11
|
||
|
|
41570 END
|
||
|
|
41580 END;
|
||
|
|
41590 IF FOUR>4 THEN PLANTWORD;
|
||
|
|
41600 OPCOD := NEXT
|
||
|
|
41610 END
|
||
|
|
41620 END
|
||
|
|
41630 ELSE
|
||
|
|
41640 BEGIN
|
||
|
|
41650 IF PARAMNOTUSED THEN PARAM(OCVNONE, 0, OPCOD);
|
||
|
|
41660 EMITOP(PSTATICLINK);
|
||
|
|
41670 UPPER;
|
||
|
|
41680 NEW(LINKP); WITH LINKP^ DO
|
||
|
|
41690 BEGIN
|
||
|
|
41700 FSEGLOC := SEGLOC+FIFTEEN-1; FFOUR := 3;
|
||
|
|
41710 IF LINKINS=NIL THEN COUNT :=0 ELSE COUNT := LINKINS^.COUNT+1;
|
||
|
|
41720 LINK := LINKINS; LINKINS := LINKP;
|
||
|
|
41730 IF COUNT=31 THEN PUTLINK(OPCOD)
|
||
|
|
41740 END;
|
||
|
|
41750 BUFFER[LAST+FIFTEEN].CODEWORD := (SETX7+SEGLOC+FIFTEEN)*SHIFT2+EQ;
|
||
|
|
41760 RELOCATION := RELOCATION*16+8;
|
||
|
|
41770 PLANTWORD;
|
||
|
|
41780 OPCOD := 0;
|
||
|
|
41790 IF ADJUSTSP<>0 THEN EMITX1(PASP, OCVIMMED, ADJUSTSP);
|
||
|
|
41800 END;
|
||
|
|
41810 COUNT := COUNT+1;
|
||
|
|
41820 IF COUNT=FORCOUNT THEN FIXUPF(FORLABL)
|
||
|
|
41830 END;
|
||
|
|
41840 (*EMITCLK := EMITCLK+CLOCK;
|
||
|
|
41850 EMITCLKS := EMITCLKS+1*)
|
||
|
|
41860 END;
|
||
|
|
41870 (**)
|
||
|
|
41880 ()+01*)
|
||
|
|
41890 ()-23*)
|
||
|
|
41900 (**)
|
||
|
|
41910 PROCEDURE EMITX0(OPCOD: POP);
|
||
|
|
41920 BEGIN IF NOT SETINLINE(OPCOD) THEN BEGIN ADJUSTSP := 0; CLEAR(RTSTACK) END;
|
||
|
|
41930 (*+05() PARAM(OCVNONE,0,OPCOD,EVEN,NOT SETINLINE(OPCOD)); ()+05*)
|
||
|
|
41940 EMITOP(OPCOD);
|
||
|
|
41950 END;
|
||
|
|
41960 (**)
|
||
|
|
41970 (**)
|
||
|
|
41980 PROCEDURE EMITX1 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT) ()+05*);
|
||
|
|
41990 VAR SB1:PSB; NOTINL:BOOLEAN;
|
||
|
|
42000 BEGIN
|
||
|
|
42010 (*-24()(*+23() TAKELINE; ()+23*) ()-24*)
|
||
|
|
42020 IF TYP1 = OCVRES THEN
|
||
|
|
42030 BEGIN
|
||
|
|
42040 SB1 := ASPTR(OPND1);
|
||
|
|
42050 EMITX0 (OPCOD);
|
||
|
|
42060 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX1-A ');
|
||
|
|
42070 ASERT(SB1^.SBTYP=SBTVOID,'EMITX1-B '); ()+32*)
|
||
|
|
42080 FILL(CODETABLE[OPCOD].PR,SB1);
|
||
|
|
42090 SB1^.SBRTSTK:=RTSTACK; RTSTACK:=SB1;
|
||
|
|
42100 END
|
||
|
|
42110 ELSE
|
||
|
|
42120 BEGIN
|
||
|
|
42130 NOTINL := NOT(SETINLINE(OPCOD));
|
||
|
|
42140 IF NOTINL THEN ADJUSTSP := 0;
|
||
|
|
42150 IF TYP1 >= OCVSB THEN
|
||
|
|
42160 PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*))
|
||
|
|
42170 ELSE
|
||
|
|
42180 BEGIN
|
||
|
|
42190 IF NOTINL THEN CLEAR(RTSTACK);
|
||
|
|
42200 (*+01() NEXTREG := 0; ()+01*)
|
||
|
|
42210 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
|
||
|
|
42220 END;
|
||
|
|
42230 EMITOP(OPCOD)
|
||
|
|
42240 END
|
||
|
|
42250 END;
|
||
|
|
42260 (**)
|
||
|
|
42270 (**)
|
||
|
|
42280 PROCEDURE EMITX2 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT;
|
||
|
|
42290 TYP2:OPDTYP; OPND2:ADDRINT) ()+05*);
|
||
|
|
42300 VAR SB2:PSB; NOTINL:BOOLEAN;
|
||
|
|
42310 BEGIN
|
||
|
|
42320 (*+23() TAKELINE; ()+23*)
|
||
|
|
42330 IF TYP2 = OCVRES THEN
|
||
|
|
42340 BEGIN
|
||
|
|
42350 SB2 := ASPTR(OPND2);
|
||
|
|
42360 EMITX1 (OPCOD, TYP1,OPND1);
|
||
|
|
42370 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX2-A ');
|
||
|
|
42380 ASERT(SB2^.SBTYP=SBTVOID,'EMITX2-B '); ()+32*)
|
||
|
|
42390 FILL(CODETABLE[OPCOD].PR,SB2);
|
||
|
|
42400 SB2^.SBRTSTK:=RTSTACK; RTSTACK:=SB2;
|
||
|
|
42410 END
|
||
|
|
42420 ELSE
|
||
|
|
42430 BEGIN
|
||
|
|
42440 NOTINL := NOT(SETINLINE(OPCOD));
|
||
|
|
42450 IF NOTINL THEN ADJUSTSP := 0;
|
||
|
|
42460 IF TYP1 >= OCVSB THEN
|
||
|
|
42470 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),EVEN()+05*))
|
||
|
|
42480 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),EVEN()+05*));
|
||
|
|
42490 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*)) END
|
||
|
|
42500 ELSE
|
||
|
|
42510 BEGIN
|
||
|
|
42520 IF NOTINL THEN CLEAR(RTSTACK);
|
||
|
|
42530 (*+01() NEXTREG:=0; ()+01*)
|
||
|
|
42540 PARAM(TYP1,OPND1,OPCOD(*+05(),EVEN,NOTINL()+05*));
|
||
|
|
42550 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*))
|
||
|
|
42560 END;
|
||
|
|
42570 EMITOP(OPCOD)
|
||
|
|
42580 END
|
||
|
|
42590 END;
|
||
|
|
42600 (**)
|
||
|
|
42610 (**)
|
||
|
|
42620 PROCEDURE EMITX3 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
|
||
|
|
42630 TYP3:OPDTYP; OPND3:ADDRINT);
|
||
|
|
42640 VAR SB3:PSB; NOTINL:BOOLEAN;
|
||
|
|
42650 BEGIN
|
||
|
|
42660 (*+23() TAKELINE; ()+23*)
|
||
|
|
42670 IF TYP3 = OCVRES THEN
|
||
|
|
42680 BEGIN
|
||
|
|
42690 SB3 := ASPTR(OPND3);
|
||
|
|
42700 EMITX2 (OPCOD, TYP1,OPND1, TYP2,OPND2);
|
||
|
|
42710 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX3-A ');
|
||
|
|
42720 ASERT(SB3^.SBTYP=SBTVOID,'EMITX3-B '); ()+32*)
|
||
|
|
42730 FILL(CODETABLE[OPCOD].PR,SB3);
|
||
|
|
42740 SB3^.SBRTSTK:=RTSTACK; RTSTACK:=SB3;
|
||
|
|
42750 END
|
||
|
|
42760 ELSE
|
||
|
|
42770 BEGIN
|
||
|
|
42780 NOTINL := NOT(SETINLINE(OPCOD));
|
||
|
|
42790 IF NOTINL THEN ADJUSTSP := 0;
|
||
|
|
42800 IF TYP1 >= OCVSB THEN
|
||
|
|
42810 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),ODDD()+05*))
|
||
|
|
42820 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*));
|
||
|
|
42830 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*)) END
|
||
|
|
42840 ELSE
|
||
|
|
42850 BEGIN
|
||
|
|
42860 IF NOTINL THEN CLEAR(RTSTACK);
|
||
|
|
42870 (*+01() NEXTREG:=0; ()+01*)
|
||
|
|
42880 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
|
||
|
|
42890 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*))
|
||
|
|
42900 END;
|
||
|
|
42910 PARAM(TYP3,OPND3,OPCOD(*+05(),ODDD,FALSE()+05*));
|
||
|
|
42920 EMITOP(OPCOD)
|
||
|
|
42930 END
|
||
|
|
42940 END;
|
||
|
|
42950 (**)
|
||
|
|
42960 (**)
|
||
|
|
42970 PROCEDURE EMITX4 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
|
||
|
|
42980 TYP3:OPDTYP; OPND3:ADDRINT; TYP4:OPDTYP;OPND4:ADDRINT);
|
||
|
|
42990 VAR SB4:PSB; NOTINL:BOOLEAN;
|
||
|
|
43000 BEGIN
|
||
|
|
43010 (*+23() TAKELINE; ()+23*)
|
||
|
|
43020 IF TYP4 = OCVRES THEN
|
||
|
|
43030 BEGIN
|
||
|
|
43040 SB4 := ASPTR(OPND4);
|
||
|
|
43050 EMITX3 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3);
|
||
|
|
43060 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX4-A ');
|
||
|
|
43070 ASERT(SB4^.SBTYP=SBTVOID,'EMITX4-B '); ()+32*)
|
||
|
|
43080 FILL(CODETABLE[OPCOD].PR,SB4);
|
||
|
|
43090 SB4^.SBRTSTK:=RTSTACK; RTSTACK:=SB4;
|
||
|
|
43100 END
|
||
|
|
43110 ELSE
|
||
|
|
43120 BEGIN
|
||
|
|
43130 NOTINL := NOT(SETINLINE(OPCOD));
|
||
|
|
43140 IF NOTINL THEN ADJUSTSP := 0;
|
||
|
|
43150 IF TYP1 >= OCVSB THEN
|
||
|
|
43160 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),EVEN()+05*))
|
||
|
|
43170 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),EVEN()+05*));
|
||
|
|
43180 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*)) END
|
||
|
|
43190 ELSE
|
||
|
|
43200 BEGIN
|
||
|
|
43210 IF NOTINL THEN CLEAR(RTSTACK);
|
||
|
|
43220 (*+01() NEXTREG:=0; ()+01*)
|
||
|
|
43230 PARAM(TYP1,OPND1,OPCOD(*+05(),EVEN,NOTINL()+05*));
|
||
|
|
43240 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*))
|
||
|
|
43250 END;
|
||
|
|
43260 PARAM(TYP3,OPND3,OPCOD(*+05(),EVEN,FALSE()+05*));
|
||
|
|
43270 PARAM(TYP4,OPND4,OPCOD(*+05(),ODDD,FALSE()+05*));
|
||
|
|
43280 EMITOP(OPCOD)
|
||
|
|
43290 END
|
||
|
|
43300 END;
|
||
|
|
43310 (**)
|
||
|
|
43320 (**)
|
||
|
|
43330 PROCEDURE EMITX5 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
|
||
|
|
43340 TYP3:OPDTYP;OPND3:ADDRINT;TYP4:OPDTYP;OPND4:ADDRINT;TYP5:OPDTYP;OPND5:ADDRINT);
|
||
|
|
43350 VAR SB5:PSB; NOTINL:BOOLEAN;
|
||
|
|
43360 BEGIN
|
||
|
|
43370 (*+23() TAKELINE; ()+23*)
|
||
|
|
43380 IF TYP5 = OCVRES THEN
|
||
|
|
43390 BEGIN
|
||
|
|
43400 SB5 := ASPTR(OPND5);
|
||
|
|
43410 EMITX4 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3,TYP4,OPND4);
|
||
|
|
43420 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX5-A ');
|
||
|
|
43430 ASERT(SB5^.SBTYP=SBTVOID,'EMITX5-B '); ()+32*)
|
||
|
|
43440 FILL(CODETABLE[OPCOD].PR,SB5);
|
||
|
|
43450 SB5^.SBRTSTK:=RTSTACK; RTSTACK:=SB5;
|
||
|
|
43460 END
|
||
|
|
43470 ELSE
|
||
|
|
43480 BEGIN
|
||
|
|
43490 NOTINL := NOT(SETINLINE(OPCOD));
|
||
|
|
43500 IF NOTINL THEN ADJUSTSP := 0;
|
||
|
|
43510 IF TYP1 >= OCVSB THEN
|
||
|
|
43520 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),ODDD()+05*))
|
||
|
|
43530 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*));
|
||
|
|
43540 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*)) END
|
||
|
|
43550 ELSE
|
||
|
|
43560 BEGIN
|
||
|
|
43570 IF NOTINL THEN CLEAR(RTSTACK);
|
||
|
|
43580 (*+01() NEXTREG:=0; ()+01*)
|
||
|
|
43590 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
|
||
|
|
43600 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*))
|
||
|
|
43610 END;
|
||
|
|
43620 PARAM(TYP3,OPND3,OPCOD(*+05(),ODDD,FALSE()+05*));
|
||
|
|
43630 PARAM(TYP4,OPND4,OPCOD(*+05(),EVEN,FALSE()+05*));
|
||
|
|
43640 PARAM(TYP5,OPND5,OPCOD(*+05(),ODDD,FALSE()+05*));
|
||
|
|
43650 EMITOP(OPCOD)
|
||
|
|
43660 END
|
||
|
|
43670 END;
|
||
|
|
43680 (**)
|
||
|
|
43690 (**)
|
||
|
|
43700 PROCEDURE EMITCONST (*OPERAND: A68INT*);
|
||
|
|
43710 VAR JUMPOVER: LABL;
|
||
|
|
43720 BEGIN JUMPOVER := GETNEXTLABEL;
|
||
|
|
43730 EMITX1(PJMP, OCVFREF, JUMPOVER);
|
||
|
|
43740 EMITXWORD(OCVIMMED, OPERAND);
|
||
|
|
43750 FIXUPF(JUMPOVER)
|
||
|
|
43760 END;
|
||
|
|
43770 (**)
|
||
|
|
43780 (*-23()
|
||
|
|
43790 (*+01()
|
||
|
|
43800 (**)
|
||
|
|
43810 PROCEDURE FIXUPFORW(ALABL: LABL; VALUE, NFOUR: INTEGER);
|
||
|
|
43820 CONST SHIFT1=100000B;
|
||
|
|
43830 VAR APFCHAIN, BPFCHAIN: PFCHAIN;
|
||
|
|
43840 I: INTEGER;
|
||
|
|
43850 TABLEWORD: PACKED RECORD CASE INTEGER OF
|
||
|
|
43860 1: (INT: INTEGER);
|
||
|
|
43870 2: (ENTRY: PACKED ARRAY [1..7] OF CHAR; FILLER: 0..777777B);
|
||
|
|
43880 END;
|
||
|
|
43890 TVALUE, TNFOUR: INTEGER;
|
||
|
|
43900 BEGIN
|
||
|
|
43910 TABLEWORD.INT := 0;
|
||
|
|
43920 APFCHAIN := TPFCHAIN;
|
||
|
|
43930 WHILE APFCHAIN^.LINK<>NIL DO
|
||
|
|
43940 BEGIN
|
||
|
|
43950 IF APFCHAIN^.LINK^.FLABL=ALABL THEN
|
||
|
|
43960 BEGIN WITH XSEG, APFCHAIN^.LINK^ DO
|
||
|
|
43970 IF FSEGLOC>=HEADERWORD.S THEN (*CODE TO BE ALTERED IS STILL IN BUFFER*)
|
||
|
|
43980 BEGIN
|
||
|
|
43990 TVALUE := VALUE; TNFOUR := NFOUR;
|
||
|
|
44000 IF FSEGLOC+FFIFTEEN=SEGLOC+FIFTEEN THEN UPPER; (*CAN ONLY HAPPEN FROM CGLABD*)
|
||
|
|
44010 FOR I := 2-FFOUR DOWNTO 0 DO
|
||
|
|
44020 BEGIN TNFOUR := TNFOUR*2; TVALUE := TVALUE*SHIFT1 END;
|
||
|
|
44030 WITH BUFFER[FLAST+FFIFTEEN] DO
|
||
|
|
44040 CODEWORD := CODEWORD+TVALUE;
|
||
|
|
44050 FOR I := 14-FFIFTEEN DOWNTO 0 DO
|
||
|
|
44060 TNFOUR := TNFOUR*16;
|
||
|
|
44070 WITH BUFFER[FLAST] DO
|
||
|
|
44080 CODEWORD := CODEWORD+TNFOUR
|
||
|
|
44090 END
|
||
|
|
44100 ELSE WITH TABLEWORD DO
|
||
|
|
44110 BEGIN
|
||
|
|
44120 IF INT=0 THEN
|
||
|
|
44130 BEGIN
|
||
|
|
44140 WRITE(LGO, 36000002000000000000B); (*ENTR TABLE*)
|
||
|
|
44150 FOR I := 1 TO 7 DO
|
||
|
|
44160 BEGIN ENTRY[I] := CHR(ORD('A') + FLABL MOD 10); FLABL := FLABL DIV 10 END;
|
||
|
|
44170 WRITE(LGO, INT);
|
||
|
|
44180 WRITE(LGO, VALUE+ORD(NFOUR<>0)*1000000B);
|
||
|
|
44190 END;
|
||
|
|
44200 WRITE(LGO, 44000002000000000000B); (*LINK TABLE*)
|
||
|
|
44210 WRITE(LGO, INT);
|
||
|
|
44220 WRITE(LGO, ((7-FFOUR)*1000000000B+1000000B+FSEGLOC+FFIFTEEN-1)*10000000000B)
|
||
|
|
44230 END;
|
||
|
|
44240 WITH APFCHAIN^ DO
|
||
|
|
44250 BEGIN
|
||
|
|
44260 BPFCHAIN := LINK;
|
||
|
|
44270 LINK := LINK^.LINK;
|
||
|
|
44280 DISPOSE(BPFCHAIN)
|
||
|
|
44290 END
|
||
|
|
44300 END
|
||
|
|
44310 ELSE APFCHAIN := APFCHAIN^.LINK
|
||
|
|
44320 END
|
||
|
|
44330 END;
|
||
|
|
44340 (**)
|
||
|
|
44350 (**)
|
||
|
|
44360 PROCEDURE FIXUPF (* (ALABL: LABL) *);
|
||
|
|
44370 BEGIN UPPER; WITH XSEG DO FIXUPFORW(ALABL, SEGLOC+FIFTEEN-1, 2) END;
|
||
|
|
44380 (**)
|
||
|
|
44390 (**)
|
||
|
|
44400 PROCEDURE FIXUPFIM(ALABL: LABL; VALUE: INTEGER);
|
||
|
|
44410 BEGIN WITH XSEG DO FIXUPFORW(ALABL, VALUE, 0) END;
|
||
|
|
44420 (**)
|
||
|
|
44430 (**)
|
||
|
|
44440 FUNCTION FIXUPM(*: LABL *);
|
||
|
|
44450 BEGIN
|
||
|
|
44460 UPPER;
|
||
|
|
44470 WITH XSEG DO
|
||
|
|
44480 FIXUPM := SEGLOC+FIFTEEN-1
|
||
|
|
44490 END;
|
||
|
|
44500 (**)
|
||
|
|
44510 (**)
|
||
|
|
44520 PROCEDURE FIXLABL(OLDLABL, NEWLABL: LABL; KNOWN: BOOLEAN);
|
||
|
|
44530 (*IF KNOWN, NEWLABL IS THE ACTUAL VALUE TO BE GIVEN TO OLDLABEL;
|
||
|
|
44540 OTHERWISE, IT IS JUST ANOTHER LABL TO BE FIXED UP LATER*)
|
||
|
|
44550 VAR APFCHAIN: PFCHAIN;
|
||
|
|
44560 BEGIN
|
||
|
|
44570 IF KNOWN THEN
|
||
|
|
44580 FIXUPFORW(OLDLABL, NEWLABL, 2)
|
||
|
|
44590 ELSE
|
||
|
|
44600 BEGIN
|
||
|
|
44610 APFCHAIN := TPFCHAIN^.LINK;
|
||
|
|
44620 WHILE APFCHAIN<>NIL DO WITH APFCHAIN^ DO
|
||
|
|
44630 BEGIN
|
||
|
|
44640 IF FLABL=OLDLABL THEN FLABL := NEWLABL;
|
||
|
|
44650 APFCHAIN := LINK
|
||
|
|
44660 END
|
||
|
|
44670 END
|
||
|
|
44680 END;
|
||
|
|
44690 (**)
|
||
|
|
44700 ()+01*)
|
||
|
|
44710 ()-23*) (* MORE EM-1 DEPENDENT ROUTINES *)
|
||
|
|
44720 (**) (********************************)
|
||
|
|
44730 (*+02()
|
||
|
|
44732 FUNCTION EMITRTNHEAD :LABL;
|
||
|
|
44734 VAR
|
||
|
|
44740 ADDRESS :LABL;
|
||
|
|
44742 BEGIN
|
||
|
|
44750 (*+42() DATASTATE:=ENDDATA; ()+42*)
|
||
|
|
44760 ADDRESS:=GETNEXTLABEL;
|
||
|
|
44770 WRITEINSTN(PRO);EMITXPROC(OCVEXT,ADDRESS);
|
||
|
|
44771 WRITEINSTN(EOOPNDS);
|
||
|
|
44774 DATASTATE := STARTDATA;
|
||
|
|
44776 EMITXWORD(OCVMEM, HOLBOTTOM); (*DUMMY TO LOAD BSS BLOCKS IN CORRECT ORDER ON VAX*)
|
||
|
|
44778 EMITRTNHEAD:=ADDRESS;
|
||
|
|
44780 END;
|
||
|
|
44784 PROCEDURE EMITBEG;
|
||
|
|
44786 VAR TEMP : PLEX;
|
||
|
|
44788 BEGIN
|
||
|
|
44790 REWRITE(LGO);
|
||
|
|
44791 (*+24() WRITEBYTE(173); WRITEBYTE(0); ()+24*)
|
||
|
|
44792 (*-24() TAKELINE; ()-24*)
|
||
|
|
44794 NEXTLABEL := 500;
|
||
|
|
44795 LCLGBL := 0; (*SO AS TO BE DEFINED ON FIRST USE*)
|
||
|
|
44796 DATASTATE := ENDDATA;
|
||
|
|
44800 ADJUSTSP := 0;
|
||
|
|
44810 WRITEINSTN(MES); (* DECLARE WORD,POINTER SIZES *)
|
||
|
|
44820 EMITXWORD(OCVIMMED,2); (*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
44830 EMITXWORD(OCVIMMED,SZWORD);(*-24() WRITE(LGO,',');()-24*)
|
||
|
|
44840 EMITXWORD(OCVIMMED,SZADDR);
|
||
|
|
44850 WRITEINSTN(EOOPNDS);
|
||
|
|
44900 ENEW(TEMP,LEX1SIZE + (9+CHARPERWORD) DIV CHARPERWORD * SZWORD);
|
||
|
|
44908 WITH TEMP^ DO
|
||
|
|
44909 BEGIN
|
||
|
|
44910 S10 := 'M_A_I_N ';
|
||
|
|
44911 S10[1]:=CHR(109); (*M*) (*THIS IS IN ASCII*)
|
||
|
|
44912 S10[3]:=CHR(97); (*A*)
|
||
|
|
44913 S10[5]:=CHR(105); (*I*)
|
||
|
|
44914 S10[7]:=CHR(110); (*N*)
|
||
|
|
44915 LXCOUNT:=(9+CHARPERWORD) DIV CHARPERWORD * SZWORD;
|
||
|
|
44916 END;
|
||
|
|
44920 WRITEINSTN(EXP);EMITXWORD(OCVEXT,ORD(TEMP)); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
44930 WRITEINSTN(PRO);EMITXWORD(OCVEXT,ORD(TEMP));
|
||
|
|
44935 (*-24()WRITE(LGO,','); ()-24*)
|
||
|
|
44940 EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
44950 EDISPOSE(TEMP,LEX1SIZE + (9+CHARPERWORD) DIV CHARPERWORD * SZWORD);
|
||
|
|
44951 HOLTOP:=GETNEXTLABEL;HOLBOTTOM:=GETNEXTLABEL;
|
||
|
|
44957 DATASTATE := STARTDATA;
|
||
|
|
44958 EMITXWORD(OCVMEM, HOLBOTTOM); (*DUMMY TO LOAD BSS BLOCKS IN CORRECT ORDER ON VAX*)
|
||
|
|
44960 EMITX0(PPBEGIN); (*CALL ESTART0*)
|
||
|
|
44970 WRITEINSTN(LAE); (*LOAD NEW ADDRESS OF M_A_I_N*)
|
||
|
|
44971 WRITEOFFSET(HOLTOP,-FIRSTIBOFFSET); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
44972 WRITEINSTN(STR); (*PLACE IN LB*)
|
||
|
|
44973 EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
44974 EMITX0(PPBEGIN+1); (*CALL START68, AND THUS ESTART_*)
|
||
|
|
44979 END;
|
||
|
|
44980 (**)
|
||
|
|
44981 PROCEDURE EMITEND;
|
||
|
|
44990 BEGIN
|
||
|
|
44991 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA;
|
||
|
|
44992 EMITXWORD(OCVIMMED, 0); WRITEINSTN(EOOPNDS); (*TO ENSURE THAT ANY OUTSTANDING DATA LABELS SEE CON RATHER THAN BSS*)
|
||
|
|
44995 WRITELABEL(TRUE,HOLBOTTOM);
|
||
|
|
45000 WRITEINSTN(BSS);
|
||
|
|
45010 EMITXWORD(OCVIMMED,ROUTNL^.RNLENIDS+SIZIBTOP+SZWORD+FIRSTIBOFFSET);
|
||
|
|
45015 (*-24()WRITE(LGO,','); ()-24*)
|
||
|
|
45020 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
45022 EMITXWORD(OCVIMMED,0);
|
||
|
|
45024 (*-24() WRITEINSTN(EOOPNDS); ()-24*) WRITELABEL(TRUE,HOLTOP);
|
||
|
|
45026 WRITEINSTN(BSS);
|
||
|
|
45028 EMITXWORD(OCVIMMED,0);(*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
45030 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
45032 EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
45034 WRITEINSTN(HOL); (*DUMMY HOL FOR RUNTIME AND FILE ACCESS*)
|
||
|
|
45036 EMITXWORD(OCVIMMED,0);(*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
45038 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
|
||
|
|
45040 EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
45041 DATASTATE := ENDDATA;
|
||
|
|
45042 EMITX0(PPEND);
|
||
|
|
45045 WRITEINSTN(RET);EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
45046 WRITEINSTN(EEND);EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
|
||
|
|
45048 END;
|
||
|
|
45050 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ;
|
||
|
|
45060 VAR I,J: INTEGER;
|
||
|
|
45065 THING: OBJECTP;
|
||
|
|
45066 MAP : RECORD CASE BOOLEAN OF
|
||
|
|
45067 TRUE : (OPTR: OBJECTP);
|
||
|
|
45068 FALSE: (IPTR: ^INTEGER);
|
||
|
|
45069 END;
|
||
|
|
45070 ALABL: LABL;
|
||
|
|
45080 BEGIN WITH SB^ DO
|
||
|
|
45090 WITH SBLEX^ (*A LEXEME*) DO
|
||
|
|
45100 IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN
|
||
|
|
45110 EMITX1(OPCOD, OCVEXT, ORD(SBLEX))
|
||
|
|
45120 ELSE IF SBLEX=LEXFALSE THEN
|
||
|
|
45130 EMITX1(OPCOD, OCVIMMED, 0)
|
||
|
|
45140 ELSE IF SBLEX=LEXTRUE THEN
|
||
|
|
45150 EMITX1(OPCOD, OCVIMMED, TRUEVALUE)
|
||
|
|
45160 ELSE IF ((LXDENMD=MDINT) OR (LXDENMD=MDBITS) OR (LXDENMD=MDCHAR))
|
||
|
|
45170 AND (LXTOKEN=TKDENOT) THEN
|
||
|
|
45180 EMITX1(OPCOD, OCVIMMED, LXDENRP)
|
||
|
|
45190 ELSE
|
||
|
|
45200 BEGIN
|
||
|
|
45210 IF LXV.LXPYPTR=0 THEN
|
||
|
|
45220 BEGIN
|
||
|
|
45230 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; ALABL := FIXUPM;
|
||
|
|
45240 LXV.LXPYPTR := ALABL;
|
||
|
|
45250 IF LXDENMD^.MDV.MDPILE THEN
|
||
|
|
45251 BEGIN
|
||
|
|
45255 NEW(THING);
|
||
|
|
45256 WITH THING^ DO
|
||
|
|
45257 BEGIN
|
||
|
|
45258 FIRSTWORD:=0; (*+13() DBLOCK:=NIL; ANCESTOR:=NIL; IHEAD:=NIL; DUMMY:=0; ()+13*)
|
||
|
|
45259 SORT:=0;PCOUNT:=255;LENGTH:=LXDENRP;
|
||
|
|
45260 MAP.OPTR:=THING;
|
||
|
|
45261 (*IF PACKING CHANGES THEN THIS FORMULA WILL HAVE TO AS WELL*)
|
||
|
|
45262 (* THIS IS (PCOUNT)+(SCOPE,SORT)+(LENGTH) *)
|
||
|
|
45263 FOR I:=1 TO (SZWORD+SZWORD+SZWORD(*+13() +SZWORD+SZWORD ()+13*)) DIV SZWORD DO
|
||
|
|
45264 BEGIN
|
||
|
|
45267 EMITXWORD(OCVIMMED,MAP.IPTR^);
|
||
|
|
45268 MAP.IPTR:=INCPTR(MAP.IPTR,SZWORD);
|
||
|
|
45269 END;
|
||
|
|
45271 (*-24() WRITEINSTN(CON); ()-24*)
|
||
|
|
45272 J:=(((SZADDR+SZINT) DIV SZINT) * CHARPERWORD) + 1;
|
||
|
|
45273 (*+24() WRITEBYTE(CPACTSTRNG);WRITECON(CPACTCONS,SZWORD,LXDENRP);
|
||
|
|
45280 FOR I:=J TO LXDENRP+J-1 DO
|
||
|
|
45290 WRITEBYTE(ORD(STRNG[I])); ()+24*)
|
||
|
|
45300 (*-24() WRITE(LGO,' ','''');
|
||
|
|
45310 FOR I:=J TO LXDENRP+J-1 DO
|
||
|
|
45311 BEGIN
|
||
|
|
45312 IF STRNG[I]='''' THEN
|
||
|
|
45313 WRITE(LGO, '\');
|
||
|
|
45315 WRITE(LGO,STRNG[I]);
|
||
|
|
45317 END;
|
||
|
|
45320 WRITE(LGO,'''');()-24*)
|
||
|
|
45325 WRITEINSTN(EOOPNDS);
|
||
|
|
45326 END; (* OF WITH *)
|
||
|
|
45330 DISPOSE(THING);
|
||
|
|
45336 END
|
||
|
|
45340 ELSE
|
||
|
|
45342 BEGIN
|
||
|
|
45343 J := (((SZADDR+SZREAL) DIV SZINT) * CHARPERWORD) + 1;
|
||
|
|
45345 (*+24() IF DATASTATE=STARTDATA THEN
|
||
|
|
45346 BEGIN WRITEINSTN(CON); DATASTATE := INDATA END;
|
||
|
|
45347 WRITEBYTE(CPACTFLOAT);
|
||
|
|
45348 WRITECON(CPACTCONS,SZWORD,SZREAL);
|
||
|
|
45349 WRITECON(CPACTCONS,SZWORD,LXDENRP);
|
||
|
|
45350 FOR I:=J TO LXDENRP+J-1 DO
|
||
|
|
45351 WRITEBYTE(ORD(STRNG[I])); ()+24*)
|
||
|
|
45352 (*-24() WRITEINSTN(CON);
|
||
|
|
45353 FOR I:=J TO LXDENRP+J-1 DO
|
||
|
|
45354 WRITE(LGO,STRNG[I]);
|
||
|
|
45355 WRITE(LGO,'F',SZREAL:1); ()-24*)
|
||
|
|
45356 WRITEINSTN(EOOPNDS);
|
||
|
|
45358 END;
|
||
|
|
45360 END;
|
||
|
|
45365 DATASTATE:=ENDDATA;
|
||
|
|
45370 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR)
|
||
|
|
45380 END;
|
||
|
|
45390 END;
|
||
|
|
45400 (**)
|
||
|
|
45410 PROCEDURE GENDP(M: MODE);
|
||
|
|
45420 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH,
|
||
|
|
45430 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV.
|
||
|
|
45440 *)
|
||
|
|
45450 VAR OFFSET: 0..127;
|
||
|
|
45460 PROCEDURE DBLOCK(M: MODE);
|
||
|
|
45470 VAR I, J: INTEGER;
|
||
|
|
45480 BEGIN WITH M^ DO
|
||
|
|
45490 FOR I := 0 TO MDV.MDCNT-1 DO
|
||
|
|
45500 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO
|
||
|
|
45510 IF MDDRESSED THEN
|
||
|
|
45520 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END
|
||
|
|
45530 ELSE IF MDID=MDIDSTRUCT THEN
|
||
|
|
45540 DBLOCK(MDSTRFMD)
|
||
|
|
45550 ELSE OFFSET := OFFSET+MDLEN
|
||
|
|
45560 END;
|
||
|
|
45570 PROCEDURE DBLOCKM(M: MODE);
|
||
|
|
45580 VAR I: INTEGER; X: XTYPE;
|
||
|
|
45590 BEGIN WITH M^ DO
|
||
|
|
45600 FOR I := 0 TO MDV.MDCNT-1 DO
|
||
|
|
45610 WITH MDSTRFLDS[I] DO
|
||
|
|
45620 BEGIN X := TX(MDSTRFMD);
|
||
|
|
45630 IF X=12 THEN DBLOCKM(MDSTRFMD)
|
||
|
|
45640 ELSE EMITXWORD(OCVIMMED, X+1)
|
||
|
|
45650 END
|
||
|
|
45660 END;
|
||
|
|
45670 BEGIN WITH M^ DO
|
||
|
|
45680 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD)
|
||
|
|
45690 ELSE IF MDV.MDID=MDIDSTRUCT THEN
|
||
|
|
45700 BEGIN
|
||
|
|
45710 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*)
|
||
|
|
45720 BEGIN
|
||
|
|
45730 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; MDSTRSDB := FIXUPM;
|
||
|
|
45740 EMITXWORD(OCVIMMED, MDV.MDLEN);
|
||
|
|
45750 OFFSET := 0; DBLOCK(M);
|
||
|
|
45760 EMITXWORD(OCVIMMED, -1);
|
||
|
|
45770 DBLOCKM(M);
|
||
|
|
45780 END;
|
||
|
|
45790 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB
|
||
|
|
45800 END
|
||
|
|
45810 ELSE IF MDV.MDDRESSED THEN
|
||
|
|
45820 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMPTR END
|
||
|
|
45830 ELSE
|
||
|
|
45840 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMPTR END;
|
||
|
|
45850 END;
|
||
|
|
45860 (**)
|
||
|
|
45870 (**)
|
||
|
|
45880 ()+02*)
|
||
|
|
45890 (*+01()
|
||
|
|
45900 (**)
|
||
|
|
45910 PROCEDURE EMITBEG;
|
||
|
|
45920 VAR I: INTEGER;
|
||
|
|
45930 TEMP: PLEX;
|
||
|
|
45940 BEGIN
|
||
|
|
45950 NEXTLABEL := 1;
|
||
|
|
45960 REWRITE(LGO);
|
||
|
|
45970 (*-23()
|
||
|
|
45980 WITH XSEG DO
|
||
|
|
45990 BEGIN
|
||
|
|
46000 BUFFER[3].ALFWORD := DAT; BUFFER[4].ALFWORD := TIM;
|
||
|
|
46010 (*WITH BUFFER[16] DO (*THIS WAS INTENDED TO IMPLEMENT THE SPACE PRAGMAT, BUT IT DOESN'T WORK
|
||
|
|
46020 BEGIN ALFWORD := ' :::'; CODEWORD := CODEWORD+WORDS END; *)
|
||
|
|
46030 FOR I := 1 TO BUFFER[0].CODEWORD DO
|
||
|
|
46040 WRITE(LGO, BUFFER[I].CODEWORD);
|
||
|
|
46050 END;
|
||
|
|
46060 NEW(TPFCHAIN); TPFCHAIN^.LINK := NIL;
|
||
|
|
46070 WITH XSEG DO
|
||
|
|
46080 BEGIN
|
||
|
|
46090 FIRST := 0; LAST := 0; SEGLOC := 0;
|
||
|
|
46100 BUFFER[FIRST].CODEWORD := 0; RELOCATION := 0;
|
||
|
|
46110 FOUR := 1; FIFTEEN := 1;
|
||
|
|
46120 BUFFER[LAST+FIFTEEN].CODEWORD := 0;
|
||
|
|
46130 HEADERWORD.WORD := 40000020000001000000B
|
||
|
|
46140 END;
|
||
|
|
46150 ENEW(TEMP,LEX1SIZE+5);
|
||
|
|
46160 TEMP^.S10 := 'PDERR '; (* ENTRY POINT FOR PASCAL DETECTED ERRORS *)
|
||
|
|
46170 EMITX1(PJMP, OCVEXT, ORD(TEMP));
|
||
|
|
46180 EMITX1(PJMP, OCVIMMED, OUTPUTEFET);
|
||
|
|
46190 EMITXWORD(OCVIMMED,01414320221707000000B); EMITXWORD(OCVIMMED,0);
|
||
|
|
46200 TEMP^.S10 := 'P.INIT ';
|
||
|
|
46210 EMITX1 (PPBEGIN,OCVEXT,ORD(TEMP));
|
||
|
|
46220 EDISPOSE(TEMP,LEX1SIZE+5);
|
||
|
|
46230 ()-23*)
|
||
|
|
46240 WITH ROUTNL^ DO BEGIN
|
||
|
|
46250 RNPROCBLK := GETNEXTLABEL;
|
||
|
|
46260 EMITX1 (PPBEGIN+1,OCVFIM,RNPROCBLK) END
|
||
|
|
46270 END;
|
||
|
|
46280 (**)
|
||
|
|
46290 (**)
|
||
|
|
46300 PROCEDURE EMITEND;
|
||
|
|
46310 VAR I: INTEGER;
|
||
|
|
46320 BEGIN
|
||
|
|
46330 FIXUPFIM(ROUTNL^.RNPROCBLK,ROUTNL^.RNLENIDS+SIZIBTOP+SZWORD+FIRSTIBOFFSET);
|
||
|
|
46340 EMITOP (PPEND);
|
||
|
|
46350 (*-23()
|
||
|
|
46360 UPPER; WHILE XSEG.FIFTEEN<>1 DO EMITXWORD( OCVIMMED, 0);
|
||
|
|
46370 WITH XSEG DO WITH HEADERWORD DO
|
||
|
|
46380 WHILE FIRST<>LAST DO
|
||
|
|
46390 BEGIN
|
||
|
|
46400 WRITE(LGO, WORD);
|
||
|
|
46410 FOR I := FIRST TO FIRST+15 DO
|
||
|
|
46420 WRITE(LGO, BUFFER[I].CODEWORD);
|
||
|
|
46430 FIRST := (FIRST+16) MOD 128; S := S+15
|
||
|
|
46440 END;
|
||
|
|
46450 FOR I := PNONE TO PLAST DO
|
||
|
|
46460 WITH CODETABLE[I] DO IF NOT INLINE THEN IF LINKINS<>NIL THEN PUTLINK(I);
|
||
|
|
46470 ()-23*)
|
||
|
|
46480 END;
|
||
|
|
46490 (**)
|
||
|
|
46500 (**)
|
||
|
|
46510 FUNCTION EMITRTNHEAD: LABL;
|
||
|
|
46520 BEGIN EMITRTNHEAD := FIXUPM END;
|
||
|
|
46530 ()+01*)
|
||
|
|
46540 (**)
|
||
|
|
46550 (**)
|
||
|
|
46560 (*-01() (*-02() (*-05()
|
||
|
|
46570 (*MODEL EMITBEG AND EMITEND FOR THOSE WHO HAVE NOT WRITTEN THEIR OWN YET*)
|
||
|
|
46580 PROCEDURE EMITBEG;
|
||
|
|
46590 BEGIN
|
||
|
|
46600 NEXTLABEL := 1;
|
||
|
|
46610 REWRITE(LGO);
|
||
|
|
46620 (*NOW INITIALIZE YOUR CODE BUFFER, OR WHATEVER, AND EMIT INIAL CODE*)
|
||
|
|
46630 END;
|
||
|
|
46640 (**)
|
||
|
|
46650 (**)
|
||
|
|
46660 PROCEDURE EMITEND;
|
||
|
|
46670 BEGIN
|
||
|
|
46680 (*EMIT YOUR FINAL CODE*)
|
||
|
|
46690 (*FLUSH YOUR CODE BUFFER, OR WHATEVER*)
|
||
|
|
46700 END;
|
||
|
|
46710 ()-05*) ()-02*) ()-01*)
|
||
|
|
46720 (**)
|
||
|
|
46730 (**)
|
||
|
|
47110 (*-02() (*-05()
|
||
|
|
47120 (**)
|
||
|
|
47130 PROCEDURE GENDP(M: MODE);
|
||
|
|
47140 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH,
|
||
|
|
47150 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV.
|
||
|
|
47160 *)
|
||
|
|
47170 VAR JUMPOVER: LABL;
|
||
|
|
47180 OFFSET: 0..127;
|
||
|
|
47190 PROCEDURE DBLOCK(M: MODE);
|
||
|
|
47200 VAR I, J: INTEGER;
|
||
|
|
47210 BEGIN WITH M^ DO
|
||
|
|
47220 FOR I := 0 TO MDV.MDCNT-1 DO
|
||
|
|
47230 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO
|
||
|
|
47240 IF MDDRESSED THEN
|
||
|
|
47250 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END
|
||
|
|
47260 ELSE IF MDID=MDIDSTRUCT THEN
|
||
|
|
47270 DBLOCK(MDSTRFMD)
|
||
|
|
47280 ELSE OFFSET := OFFSET+MDLEN
|
||
|
|
47290 END;
|
||
|
|
47300 PROCEDURE DBLOCKM(M: MODE);
|
||
|
|
47310 VAR I: INTEGER; X: XTYPE;
|
||
|
|
47320 BEGIN WITH M^ DO
|
||
|
|
47330 FOR I := 0 TO MDV.MDCNT-1 DO
|
||
|
|
47340 WITH MDSTRFLDS[I] DO
|
||
|
|
47350 BEGIN X := TX(MDSTRFMD);
|
||
|
|
47360 IF X=12 THEN DBLOCKM(MDSTRFMD)
|
||
|
|
47370 ELSE EMITXWORD(OCVIMMED, X+1)
|
||
|
|
47380 END
|
||
|
|
47390 END;
|
||
|
|
47400 BEGIN WITH M^ DO
|
||
|
|
47410 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD)
|
||
|
|
47420 ELSE IF MDV.MDID=MDIDSTRUCT THEN
|
||
|
|
47430 BEGIN
|
||
|
|
47440 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*)
|
||
|
|
47450 BEGIN
|
||
|
|
47460 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER);
|
||
|
|
47470 MDSTRSDB := FIXUPM;
|
||
|
|
47480 EMITXWORD(OCVIMMED, MDV.MDLEN);
|
||
|
|
47490 OFFSET := 0; DBLOCK(M);
|
||
|
|
47500 EMITXWORD(OCVIMMED, -1);
|
||
|
|
47510 DBLOCKM(M);
|
||
|
|
47520 FIXUPF(JUMPOVER)
|
||
|
|
47530 END;
|
||
|
|
47540 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB
|
||
|
|
47550 END
|
||
|
|
47560 ELSE IF MDV.MDDRESSED THEN
|
||
|
|
47570 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMED END
|
||
|
|
47580 ELSE
|
||
|
|
47590 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMED END
|
||
|
|
47600 END;
|
||
|
|
47610 (**)
|
||
|
|
47620 ()-05*) ()-02*)
|
||
|
|
47630 (**)
|
||
|
|
47640 FUNCTION GETCASE(M: MODE; OLST: OLSTTYP; SB: PSB): STATE;
|
||
|
|
47650 (*FUNCTION: COMPUTES AN ADDITION TO SOME OPCOD.
|
||
|
|
47660 THE SB HERE AND IN RELATED PLACES IS A TEMPORARY KLUDGE ??????
|
||
|
|
47670 *)
|
||
|
|
47680 VAR WHICH: STATE;
|
||
|
|
47690 WEAKREF: BOOLEAN;
|
||
|
|
47700 BEGIN WITH M^ DO
|
||
|
|
47710 BEGIN
|
||
|
|
47720 IF SB<>NIL THEN WEAKREF:=(SBWEAKREF IN SB^.SBINF) ELSE WEAKREF:=FALSE;
|
||
|
|
47730 IF NOT MDV.MDPILE THEN
|
||
|
|
47740 IF MDV.MDLEN=SZINT THEN WHICH := 0 ELSE WHICH := 1
|
||
|
|
47750 ELSE IF WEAKREF THEN WHICH:=2
|
||
|
|
47760 ELSE IF MDV.MDID=MDIDROW THEN WHICH:=3
|
||
|
|
47770 ELSE IF MDV.MDDRESSED THEN WHICH:=4
|
||
|
|
47780 ELSE WHICH:=5;
|
||
|
|
47790 NEEDDP := OLST[WHICH].DP;
|
||
|
|
47800 GETCASE := OLST[WHICH].OVAL
|
||
|
|
47810 END
|
||
|
|
47820 END;
|
||
|
|
47830 (**)
|
||
|
|
47840 (**)
|
||
|
|
47850 PROCEDURE GENOP(VAR OPCOD: POP; M: MODE; VAR OLIST: OLSTTYP; SB: PSB);
|
||
|
|
47860 (*USES GETCASE TO MODIFY OPCOD AND DOES GENDP IF NECESSARY*)
|
||
|
|
47870 BEGIN
|
||
|
|
47880 OPCOD := OPCOD+GETCASE(M, OLIST, SB);
|
||
|
|
47890 IF NEEDDP THEN
|
||
|
|
47900 BEGIN
|
||
|
|
47910 IF SB<>NIL THEN
|
||
|
|
47920 IF SBWEAKREF IN SB^.SBINF THEN M := M^.MDPRRMD;
|
||
|
|
47930 GENDP(M);
|
||
|
|
47940 END
|
||
|
|
47950 ELSE BEGIN GENDPOCV:=OCVNONE; GENDPVAL:=0 END
|
||
|
|
47960 END;
|
||
|
|
47970 (**)
|
||
|
|
47980 (**)
|
||
|
|
47990 FUNCTION GENLCLGBL (*+05() (VAR OPCOD: POP; SB: PSB):INTEGER ()+05*) ;
|
||
|
|
48000 VAR I,X: INTEGER;
|
||
|
|
48010 VP : SBTTYP;
|
||
|
|
48030 BEGIN WITH SB^ DO
|
||
|
|
48040 BEGIN
|
||
|
|
48050 (*-41() GENLCLGBL:=SBOFFSET; ()-41*)
|
||
|
|
48060 (*+41() GENLCLGBL:=-SBOFFSET; ()+41*)
|
||
|
|
48062 LCLGBL := 0;
|
||
|
|
48070 IF (SBLEVEL = 0) (*+05() AND (SBLEVEL<>ROUTNL^.RNLEVEL) ()+05*) THEN (*GLOBAL*)
|
||
|
|
48080 BEGIN X:=1;
|
||
|
|
48086 (*-05() (*-41() GENLCLGBL:=SBOFFSET+FIRSTIBOFFSET; ()-41*)
|
||
|
|
48087 (*+41() GENLCLGBL:=-(SBOFFSET+FIRSTIBOFFSET); ()+41*) ()-05*)
|
||
|
|
48090 (*+05() GENLCLGBL:=256-SBOFFSET ()+05*) END
|
||
|
|
48100 ELSE
|
||
|
|
48110 BEGIN
|
||
|
|
48120 IF SBLEVEL=ROUTNL^.RNLEVEL THEN(*LOCAL*) X:=0
|
||
|
|
48130 ELSE
|
||
|
|
48140 BEGIN (*INTERMEDIATE*)
|
||
|
|
48150 X:=2;
|
||
|
|
48152 LCLGBL := ROUTNL^.RNLEVEL-SBLEVEL;
|
||
|
|
48240 END
|
||
|
|
48250 END;
|
||
|
|
48260 OPCOD := OPCOD+X;
|
||
|
|
48270 END
|
||
|
|
48280 END;
|
||
|
|
48290 (**)
|
||
|
|
48300 (**)
|
||
|
|
48310 (*-02() (*-05()
|
||
|
|
48320 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ;
|
||
|
|
48330 VAR THING: OBJECT; I: INTEGER;
|
||
|
|
48340 JUMPOVER: LABL;
|
||
|
|
48350 BEGIN WITH SB^ DO
|
||
|
|
48360 WITH SBLEX^ (*A LEXEME*) DO
|
||
|
|
48370 IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN
|
||
|
|
48380 EMITX1(OPCOD, OCVEXT, ORD(SBLEX))
|
||
|
|
48390 ELSE IF SBLEX=LEXFALSE THEN
|
||
|
|
48400 EMITX1(OPCOD, OCVIMMED, 0)
|
||
|
|
48410 ELSE IF ((LXDENMD=MDINT) OR (LXDENMD=MDBITS) OR (LXDENMD=MDCHAR))
|
||
|
|
48420 (*+01() AND (LXDENRP<400000B) ()+01*) AND (LXTOKEN=TKDENOT) THEN
|
||
|
|
48430 EMITX1(OPCOD, OCVIMMED, LXDENRP)
|
||
|
|
48440 ELSE
|
||
|
|
48450 BEGIN
|
||
|
|
48460 IF LXV.LXPYPTR=0 THEN
|
||
|
|
48470 BEGIN
|
||
|
|
48480 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER);
|
||
|
|
48490 LXV.LXPYPTR := FIXUPM;
|
||
|
|
48500 IF SBLEX=LEXTRUE THEN
|
||
|
|
48510 EMITXWORD(OCVIMMED, TRUEVALUE)
|
||
|
|
48520 ELSE IF LXDENMD^.MDV.MDPILE THEN WITH THING DO
|
||
|
|
48530 BEGIN FIRSTWORD := 0; PCOUNT := 255;
|
||
|
|
48540 LENGTH := (*-04() LXDENRP; ()-04*)(*+04() SHRINK(LXDENRP); ()+04*)
|
||
|
|
48550 EMITXWORD(OCVIMMED, FIRSTWORD);
|
||
|
|
48560 FOR I := 3 TO LXCOUNT DO
|
||
|
|
48570 EMITXWORD(OCVIMMED, INTEGERS[I])
|
||
|
|
48580 END
|
||
|
|
48590 ELSE EMITXWORD(OCVIMMED, LXDENRP);
|
||
|
|
48600 FIXUPF(JUMPOVER)
|
||
|
|
48610 END;
|
||
|
|
48620 IF LXTOKEN=TKDENOT THEN (*NOT LEXTRUE*)
|
||
|
|
48630 IF LXDENMD^.MDV.MDPILE THEN OPCOD := OPCOD-1;
|
||
|
|
48640 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR)
|
||
|
|
48650 END
|
||
|
|
48660 END;
|
||
|
|
48670 ()-05*) ()-02*)
|
||
|
|
48680 ()+87*)
|