1348 lines
54 KiB
OpenEdge ABL
1348 lines
54 KiB
OpenEdge ABL
50000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
50010 (*+84() FUNCTION COERCE(M:MODE):MODE; FORWARD; ()+84*)
|
|
50020 (*+86()
|
|
50030 (**)
|
|
50040 (*CODE GENERATOR*)
|
|
50050 (****************)
|
|
50060 (**)
|
|
50070 PROCEDURE MARK(L: LABL);
|
|
50080 (*FUNCTION: PUSHES A BRAND NEW LABEL ONTO MARKCHAIN*)
|
|
50090 VAR NEWM: PMARKCHAIN;
|
|
50100 BEGIN NEW(NEWM); WITH NEWM^ DO
|
|
50110 BEGIN MKXPTR := L; LINK := MARKPTR; MARKPTR := NEWM END
|
|
50120 END;
|
|
50130 (**)
|
|
50140 (**)
|
|
50150 FUNCTION POPMARK: LABL;
|
|
50160 (*FUNCTION: POPS LABEL FROM MARKCHAIN*)
|
|
50170 VAR OLDM: PMARKCHAIN;
|
|
50180 BEGIN OLDM := MARKPTR; WITH OLDM^ DO
|
|
50190 BEGIN MARKPTR := LINK; POPMARK := MKXPTR; DISPOSE(OLDM) END
|
|
50200 END;
|
|
50210 (**)
|
|
50220 (**)
|
|
50230 PROCEDURE GENFLAD;
|
|
50240 (*FUNCTION: EMITS PJMP WITH FORWARD REFERENCE TO LABEL IN MARKCHAIN*)
|
|
50250 VAR NEWM: PMARKCHAIN;
|
|
50260 BEGIN
|
|
50270 NEW(NEWM); WITH NEWM^ DO
|
|
50280 BEGIN
|
|
50290 MKXPTR := GETNEXTLABEL; LINK := MARKPTR; MARKPTR := NEWM;
|
|
50300 EMITX1(PJMP, OCVFREF, MKXPTR)
|
|
50310 END
|
|
50320 END;
|
|
50330 (**)
|
|
50340 (**)
|
|
50350 PROCEDURE GENFLIF(OPCOD:POP; SB:PSB);
|
|
50360 VAR NEWM : PMARKCHAIN;
|
|
50370 BEGIN
|
|
50380 NEW(NEWM); WITH NEWM^ DO
|
|
50390 BEGIN
|
|
50400 MKXPTR := GETNEXTLABEL; LINK := MARKPTR; MARKPTR := NEWM;
|
|
50410 EMITX2(OPCOD,OCVSB,ORD(SB),OCVFREF,MKXPTR)
|
|
50420 END
|
|
50430 END;
|
|
50440 (**)
|
|
50450 (**)
|
|
50460 PROCEDURE ASSIGNFLAD;
|
|
50470 (*FUNCTION: FILLS IN FORWARD REFERENCE TO LABEL IN MARKCHAIN*)
|
|
50480 BEGIN (*+42() SETTEXTSTATE; ()+42*) FIXUPF(POPMARK) END;
|
|
50490 (**)
|
|
50500 (**)
|
|
50510 PROCEDURE STARTCHAIN;
|
|
50520 (*FUNCTION: PUSHES A MARKER (ZERO) ONTO MARKCHAIN*)
|
|
50530 VAR NEWM: PMARKCHAIN;
|
|
50540 BEGIN NEW(NEWM); WITH NEWM^ DO
|
|
50550 BEGIN MKXPTR := 0; LINK := MARKPTR; MARKPTR := NEWM END
|
|
50560 END;
|
|
50570 (**)
|
|
50580 (**)
|
|
50590 PROCEDURE ASSIGNCHAIN;
|
|
50600 (*FUNCTION: FILLS IN FORWARD REFERENCES TO LABELS IN TOP SECTION OF MARKCHAIN*)
|
|
50610 VAR PTR: LABL;
|
|
50620 BEGIN PTR := POPMARK;
|
|
50622 (*+42() SETTEXTSTATE; ()+42*)
|
|
50630 WHILE PTR<>0 DO
|
|
50640 BEGIN FIXUPF(PTR); PTR := POPMARK END
|
|
50650 END;
|
|
50660 (**)
|
|
50670 (**)
|
|
50680 (**)
|
|
50690 FUNCTION PUSHSB (PARAM:MODE) :PSB;
|
|
50700 VAR SB : PSB;
|
|
50710 BEGIN NEW(SB);
|
|
50720 WITH SB^ DO BEGIN
|
|
50730 SBDELAYS := 0; SBINF := [] (*NOT COERCEND*);
|
|
50740 SBTYP := SBTVOID; SBMODE := PARAM;
|
|
50750 IF PARAM^.MDV.MDPILE THEN SBLEN := SZADDR ELSE SBLEN := PARAM^.MDV.MDLEN;
|
|
50760 (*GUESS THE EVENTUAL SBLEN; GUESS ONLY USED IN UNITEDBAL*)
|
|
50770 SBRTSTK := RTSTACK; RTSTACK := SB END;
|
|
50780 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SB;
|
|
50790 PUSHSB := SB
|
|
50800 END;
|
|
50810 (**)
|
|
50820 (**)
|
|
50830 PROCEDURE STACKSB (*-01() (SB: PSB) ()-01*);
|
|
50840 (*FUNCTION: PUTS THE YIELD OF SB ONTO THE CONCEPTUAL RTSTACK.IN FACT, NO CODE
|
|
50850 IS GENERATED AT THIS POINT (AND IF SB IS SUBSEQUENTLY VOIDED, IT NEVER WILL BE.
|
|
50860 *)
|
|
50870 BEGIN WITH SB^ DO
|
|
50880 BEGIN
|
|
50890 SBRTSTK := RTSTACK; RTSTACK := SB;
|
|
50900 (*+01() REGSINUSE := REGSINUSE+REGISTERS[SBTYP]; ()+01*)
|
|
50910 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH := RTSTKDEPTH+SBLEN
|
|
50920 (*+05() ELSE WITH REGSINUSE DO
|
|
50924 BEGIN
|
|
50930 IF SBTYP IN [SBTE,SBTER0] THEN ECOUNT := ECOUNT+1;
|
|
50940 IF SBTYP IN [SBTER0..SBTFPR3] THEN FPR := FPR+[SBTYP];
|
|
50946 END;
|
|
50950 ()+05*)
|
|
50960 END
|
|
50970 END;
|
|
50980 (**)
|
|
50990 (**)
|
|
51000 PROCEDURE UNSTACKSB;
|
|
51010 (*FUNCTION: REDUCES THE CONCEPTUAL RTSTACK BY ONE.*)
|
|
51020 VAR SB: PSB;
|
|
51030 BEGIN SB := RTSTACK; WITH SB^ DO
|
|
51040 BEGIN
|
|
51050 RTSTACK := SBRTSTK;
|
|
51060 (*+01() REGSINUSE := REGSINUSE-REGISTERS[SBTYP]; ()+01*)
|
|
51070 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH:=RTSTKDEPTH-SBLEN
|
|
51080 (*+05() ELSE WITH REGSINUSE DO
|
|
51084 BEGIN
|
|
51090 IF SBTYP IN [SBTE,SBTER0] THEN ECOUNT := ECOUNT-1;
|
|
51100 IF SBTYP IN [SBTER0..SBTFPR3] THEN FPR := FPR-[SBTYP];
|
|
51104 END;
|
|
51110 ()+05*)
|
|
51120 END;
|
|
51130 END;
|
|
51140 (**)
|
|
51150 (**)
|
|
51160 PROCEDURE POPUNITS;
|
|
51170 (*FUNCTION: DISPOSE OF ALL THE UNITS (PARAMETERS OR BOUNDS) ON THE SUBSTACK*)
|
|
51180 BEGIN
|
|
51190 WHILE SRSEMP<>SRSUBP DO
|
|
51200 BEGIN
|
|
51210 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1 END;
|
|
51220 SUBREST
|
|
51230 END;
|
|
51240 (**)
|
|
51241 (**)
|
|
51242 PROCEDURE GETTOTCMN(SB: PSB);
|
|
51243 BEGIN
|
|
51244 WITH SB^ DO
|
|
51245 IF SBNOREF IN SBINF THEN
|
|
51246 EMITX2(PGETTOTCMN+ORD(SBNAKROW IN SBINF), OCVSB, ORD(SB), OCVRES, ORD(SB))
|
|
51247 ELSE EMITX2(PGETTOTCMN+2, OCVSB, ORD(SB), OCVRES, ORD(SB));
|
|
51248 END;
|
|
51249 (**)
|
|
51250 (**)
|
|
51260 PROCEDURE GETTOTAL(SB: PSB);
|
|
51270 (*ENSURES THAT SB IS NOT NAKED*)
|
|
51280 VAR OPCOD : POP;
|
|
51290 SB1 : PSB;
|
|
51300 BEGIN
|
|
51310 WITH SB^ DO
|
|
51320 IF SBNAKED IN SBINF THEN
|
|
51330 BEGIN
|
|
51340 OPCOD:=PGETTOTAL;
|
|
51350 GENOP(OPCOD, SBMODE, OLIST1, SB);
|
|
51360 IF SBWEAKREF IN SBINF THEN
|
|
51370 EMITX3(OPCOD, OCVSB, ORD(SB), GENDPOCV, GENDPVAL, OCVRES, ORD(SB))
|
|
51380 ELSE
|
|
51390 BEGIN
|
|
51400 GETTOTCMN(SB);
|
|
51410 IF GENDPOCV=OCVNONE THEN
|
|
51420 EMITX2(OPCOD, OCVSB, ORD(SB), OCVRES, ORD(SB))
|
|
51430 ELSE EMITX3(OPCOD, OCVSB, ORD(SB), GENDPOCV, GENDPVAL, OCVRES, ORD(SB));
|
|
51440 END;
|
|
51450 SBINF := SBINF-[SBWEAKREF,SBNOREF,SBNAKED,SBNAKROW];
|
|
51452 END
|
|
51454 ELSE IF SBSLN IN SBINF THEN
|
|
51456 BEGIN
|
|
51464 EMITX2(PGETMULT+ORD(SBWEAKREF IN SBINF), OCVSB, ORD(SB), OCVRES, ORD(SB));
|
|
51465 SBINF := SBINF-[SBWEAKREF,SBSLN];
|
|
51469 END;
|
|
51470 END;
|
|
51480 (**)
|
|
51490 (**)
|
|
51500 PROCEDURE LOADTOTAL(SB:PSB);
|
|
51510 BEGIN
|
|
51520 IF SBNAKED IN SB^.SBINF THEN GETTOTAL(SB);
|
|
51530 IF SB<>RTSTACK THEN TWIST;
|
|
51540 (*+32() ASERT(NOT(RTSTACK<>SB),'LOADTOTAL '); ()+32*)
|
|
51550 LOAD(NORMAL(SB),SB)
|
|
51560 END;
|
|
51570 (**)
|
|
51580 (**)
|
|
51590 PROCEDURE ALLOWNAK(SB:PSB);
|
|
51600 (*FUNCTION: DOES GETTOTAL IF ABSOLUTELY NECESSARY*)
|
|
51610 BEGIN WITH SB^ DO
|
|
51620 IF ((SBMODE^.MDV.MDID=MDIDREF) AND NOT(SBWEAKREF IN SBINF)) OR (SBSLN IN SBINF) THEN
|
|
51630 GETTOTAL(SB)
|
|
51640 END;
|
|
51650 (**)
|
|
51660 (**)
|
|
51670 PROCEDURE COMBINE;
|
|
51680 (*COMBINES TOP TWO ITEMS ON RTSTACK INTO ONE WITH THE SUM OF THEIR SBLENS
|
|
51690 DESTROYING WHICHEVER OF THEM IS AT SRSTK[SRSEMP]*)
|
|
51700 VAR SB1: PSB;
|
|
51710 BEGIN
|
|
51720 WITH SRSTK[SRSEMP] DO
|
|
51730 BEGIN
|
|
51740 IF SB=RTSTACK THEN SB1 := RTSTACK^.SBRTSTK ELSE SB1 := RTSTACK;
|
|
51750 UNSTACKSB; UNSTACKSB;
|
|
51760 SB1^.SBLEN := SB1^.SBLEN+SB^.SBLEN; STACKSB(SB1);
|
|
51770 DISPOSE(SB); SRSEMP := SRSEMP-1;
|
|
51780 END;
|
|
51790 END;
|
|
51800 (**)
|
|
51810 (**)
|
|
51820 PROCEDURE CGFIRM;
|
|
51830 (*MARKS SRSTK[SRSEMP] FOR DELAYED LOADING NEXT TIME*)
|
|
51840 BEGIN
|
|
51850 WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
|
51860 BEGIN
|
|
51870 GETTOTAL(SB);
|
|
51880 IF RTSTACK<>SB THEN TWIST;
|
|
51890 (*-02() SBINF := SBINF+[SBSTKDELAY]; ()-02*)
|
|
51892 (*+02() LOADSTK(SB); ()+02*)
|
|
51900 END;
|
|
51902 (*+05() ADJUSTSP := 0; ()+05*)
|
|
51906 (*-02()
|
|
51910 WITH RTSTACK^ DO
|
|
51920 IF SBRTSTK<>NIL THEN
|
|
51930 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
|
|
51940 BEGIN LOADSTK(SBRTSTK); SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY] END
|
|
51944 ELSE CLEAR(SBRTSTK);
|
|
51950 ()-02*)
|
|
51951 END;
|
|
51952 (**)
|
|
51953 (**)
|
|
51955 FUNCTION STKMAP(ROUTN: PSB): (*-02()A68INT()-02*)(*+02()LONG()+02*);
|
|
51956 (*YIELDS BIT PATTERN FOR STATE OF WORKING STACK DOWN TO CURRENT ROUTN OR RANGE*)
|
|
51962 VAR MAP: BITMAP;
|
|
51963 MASKINC: (*-02()A68INT()-02*)(*+02()LONG()+02*);
|
|
51964 SB, RANGSTOP: PSB;
|
|
51965 I, BIGMASK: INTEGER;
|
|
51966 FLAG: BOOLEAN;
|
|
51967 BEGIN WITH MAP DO
|
|
51968 BEGIN INT := 0; BIGMASK := 0;
|
|
51969 (*-01() MASKINC := -32000-768; ()-01*)
|
|
51970 (*+01() MASKINC := 20000B; ()+01*)
|
|
51971 SB := RTSTACK;
|
|
51972 IF ORD(ROUTN)<>0 THEN
|
|
51973 BEGIN RANGSTOP := NIL; FLAG := FALSE END
|
|
51974 ELSE
|
|
51975 BEGIN RANGSTOP := RANGEL^.RGRTSTACK; FLAG := TRUE END;
|
|
51976 WHILE (SB<>NIL) AND (SB<>RANGSTOP) DO WITH SB^ DO
|
|
51977 BEGIN
|
|
51978 IF SBTYP IN [SBTSTK..SBTSTKN] THEN
|
|
51979 BEGIN
|
|
51980 COUNT := COUNT+SBLEN;
|
|
51981 IF COUNT>=15*SZWORD THEN
|
|
51982 OUTERR(ESE+62, WARNING, NIL);
|
|
51983 BIGMASK := BIGMASK DIV 2; IF BIGMASK<0 THEN BIGMASK := BIGMASK-MASKINC;
|
|
51984 IF NOT FLAG THEN FLAG := SB=ROUTN; (*SEE IF ABLE TO START*)
|
|
51985 IF ((SBMODE^.MDV.MDPILE) OR (SBNAKED IN SBINF)) AND FLAG THEN
|
|
51986 BIGMASK := BIGMASK+MASKINC;
|
|
51987 FOR I := 1 TO (SBLEN DIV SZWORD)-1 DO
|
|
51988 BEGIN BIGMASK := BIGMASK DIV 2; IF BIGMASK<0 THEN BIGMASK := BIGMASK-MASKINC END;
|
|
51989 END;
|
|
51990 SB := SBRTSTK
|
|
51992 END;
|
|
51993 MASK := BIGMASK;
|
|
51994 STKMAP := INT;
|
|
51995 END;
|
|
51996 END;
|
|
51997 (**)
|
|
51998 (**)
|
|
51999 FUNCTION SUBSTLEN(SBTS: SBTTYPSET): INTEGER;
|
|
52000 VAR LEN: INTEGER;
|
|
52010 PTR,STOP: PSB;
|
|
52020 BEGIN
|
|
52030 LEN := 0; PTR := RTSTACK; STOP := SRSTK[SRSUBP+1].SB^.SBRTSTK;
|
|
52040 WHILE PTR<>STOP DO WITH PTR^ DO
|
|
52050 BEGIN
|
|
52055 IF SBTYP IN SBTS THEN
|
|
52056 (*+02() IF SBTYP=SBTPRR THEN LEN := LEN+LENOF(PTR) ELSE ()+02*)
|
|
52057 LEN := LEN+SBLEN;
|
|
52058 PTR := SBRTSTK;
|
|
52059 END;
|
|
52060 SUBSTLEN := LEN;
|
|
52070 END;
|
|
52080 (**)
|
|
52090 (**)
|
|
52100 PROCEDURE CGFLINE;
|
|
52102 (*+33()VAR L: LABL; ()+33*)
|
|
52104 BEGIN
|
|
52110 PREVLINE := LEXLINE; EMITX1(PLINE, OCVIMMED, LEXLINE);
|
|
52111 (*+33()
|
|
52112 L := GETNEXTLABEL;
|
|
52113 WRITELN(LGO[ROUTNL^.RNLEVEL], 'STAB "",8#104,0,', LEXLINE:1, ',LL', L:1);
|
|
52114 WRITELN(LGO[ROUTNL^.RNLEVEL], 'LL', L:1, ':');
|
|
52115 ()+33*)
|
|
52116 END;
|
|
52120 (**)
|
|
52130 (**)
|
|
52140 PROCEDURE CGACTBNDS(SB:PSB; N: CNTR);
|
|
52150 BEGIN
|
|
52160 EMITX3(PBOUNDS, OCVSBS,ORD(SRSTK[SRSEMP].SB), OCVIMMED,N, OCVRES,ORD(SB));
|
|
52170 SB^.SBLOCRG:= N
|
|
52180 END;
|
|
52190 (**)
|
|
52200 (**)
|
|
52210 PROCEDURE CGASSIGN;
|
|
52220 VAR M:MODE;
|
|
52230 TOFFSET: INTEGER;
|
|
52240 OPCOD: POP; OLIST: OLSTTYP;
|
|
52250 SCOPECASE: BOOLEAN;
|
|
52260 SSB,DSB: PSB; (*SOURCE, DESTINATION SEMBLKS*)
|
|
52270 BEGIN
|
|
52280 SSB := SRSTK[SRSEMP].SB; DSB := SRSTK[SRSEMP-1].SB;
|
|
52290 WITH DSB^ DO
|
|
52300 BEGIN
|
|
52310 M := SBMODE^.MDPRRMD;
|
|
52320 IF SBTYP=SBTVAR THEN
|
|
52330 BEGIN
|
|
52340 SCOPECASE := FALSE;
|
|
52350 IF SSB^.SBTYP IN [SBTVAR, SBTIDV] THEN
|
|
52360 IF (SSB^.SBLEVEL>SBLEVEL) OR ((SSB^.SBLEVEL=SBLEVEL) AND (SSB^.SBLOCRG>SBLOCRG)) THEN SEMERR(ESE+14)
|
|
52370 ELSE
|
|
52380 ELSE IF M^.MDV.MDSCOPE THEN SCOPECASE := TRUE;
|
|
52390 GETTOTAL(SSB);
|
|
52400 IF SCOPECASE THEN
|
|
52410 BEGIN
|
|
52420 OPCOD := PSCOPEVAR;
|
|
52430 TOFFSET := GENLCLGBL(OPCOD, DSB);
|
|
52440 EMITX3(OPCOD, OCVSB, ORD(SSB), OCVIMMED, SBLOCRG, OCVLCLGBL, TOFFSET)
|
|
52450 END
|
|
52460 ELSE BEGIN
|
|
52470 OPCOD := PASGVART+GETCASE(M, OLIST2, SSB);
|
|
52480 TOFFSET := GENLCLGBL(OPCOD, DSB);
|
|
52490 EMITX2(OPCOD, OCVSB, ORD(SSB), OCVLCLGBL, TOFFSET);
|
|
52500 END
|
|
52510 END
|
|
52520 ELSE
|
|
52530 BEGIN
|
|
52540 IF M^.MDV.MDID=MDIDSTRUCT THEN ALLOWNAK(SSB) ELSE GETTOTAL(SSB);
|
|
52542 IF SBNAKED IN SSB^.SBINF THEN GETTOTCMN(SSB);
|
|
52550 CASE ORD(SBNAKED IN SSB^.SBINF)*4
|
|
52560 +ORD(SBNAKED IN SBINF)*2
|
|
52570 +ORD(M^.MDV.MDSCOPE) OF
|
|
52580 0: BEGIN OPCOD:=PASSIGTT;OLIST:=OLIST3 END;
|
|
52590 1: BEGIN OPCOD:=PSCOPETT;OLIST:=OLIST3 END;
|
|
52600 2: BEGIN OPCOD:=PASSIGNT;OLIST:=OLIST1 END;
|
|
52610 3: BEGIN OPCOD:=PSCOPENT;OLIST:=OLIST1 END;
|
|
52620 4: BEGIN OPCOD:=PASSIGTN;OLIST:=OLIST5 END;
|
|
52630 5: BEGIN OPCOD:=PSCOPETN;OLIST:=OLIST5 END;
|
|
52640 6: BEGIN OPCOD:=PASSIGNN;OLIST:=OLIST5 END;
|
|
52650 7: BEGIN OPCOD:=PSCOPENN;OLIST:=OLIST5 END
|
|
52660 END;
|
|
52670 GENOP(OPCOD,M,OLIST,SSB);
|
|
52680 IF GENDPOCV=OCVNONE THEN
|
|
52690 EMITX3(OPCOD, OCVSB, ORD(DSB), OCVSB, ORD(SSB), OCVRES, ORD(DSB))
|
|
52700 ELSE EMITX4(OPCOD,OCVSB,ORD(DSB),OCVSB,ORD(SSB),GENDPOCV,GENDPVAL,OCVRES,ORD(DSB))
|
|
52710 END;
|
|
52720 END
|
|
52730 END;
|
|
52740 (**)
|
|
52750 (**)
|
|
52760 (*CGBALB IS TO BE FOUND AFTER CGCOERCE*)
|
|
52770 (**)
|
|
52780 (**)
|
|
52790 PROCEDURE CGBALC;
|
|
52800 (*END OF BALANCE*)
|
|
52810 BEGIN ASSIGNCHAIN;
|
|
52820 WITH SRSTK[SRSEMP] DO
|
|
52830 (*SRSTK[SRSEMP] IS ALREADY CORRECT FROM CGBALB*)
|
|
52840 FILL(NORMAL(SB), SB);
|
|
52850 END;
|
|
52860 (**)
|
|
52870 (**)
|
|
52880 PROCEDURE CGCALL(SB, SBR: PSB);
|
|
52890 (*ROUTINE CALL*)
|
|
52900 VAR OFFSET: INTEGER;
|
|
52910 OPCOD: POP;
|
|
52920 OCVFIX: OPDTYP;
|
|
52922 SB1: PSB;
|
|
52930 BEGIN
|
|
52932 (*-01()
|
|
52933 SB1 := PUSHSB(MDLINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := STKMAP(SB^.SBRTSTK); CGFIRM;
|
|
52934 SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := ROUTNL^.RNLOCRG+1; CGFIRM;
|
|
52938 ()-01*)
|
|
52960 IF SB^.SBTYP IN [SBTPROC,SBTRPROC] THEN
|
|
52970 BEGIN
|
|
52980 IF SB^.SBTYP = SBTPROC THEN OCVFIX := OCVMEM
|
|
52990 ELSE (* SBTRPROC *) OCVFIX := OCVFREF ;
|
|
52992 ADJUSTSP := 0;
|
|
53020 OPCOD := PCALLA;
|
|
53030 OFFSET := GENLCLGBL(OPCOD,SB);
|
|
53032 (*-01() EMITX3(OPCOD, OCVSBS,ORD(RTSTACK), ()-01*)
|
|
53040 (*+01() EMITX5(OPCOD, OCVSBS,ORD(RTSTACK),OCVIMMLONG,STKMAP(SB^.SBRTSTK),OCVIMMED,ROUTNL^.RNLOCRG+1, ()+01*)
|
|
53050 OCVFIX,SB^.SBXPTR,OCVLCLGBL,(*-02()OFFSET()-02*)(*+02()-SZADDR()+02*));
|
|
53060 END
|
|
53070 ELSE
|
|
53080 BEGIN
|
|
53082 LOADSTK(RTSTACK); (*TO ENSURE THAT SUBSTLEN WORKS*)
|
|
53090 EMITX1(PGETPROC, OCVIMMED, -SUBSTLEN([SBTSTK..SBTDL])(*+05()+ORD((RTSTKDEPTH MOD 4)<>0)*SZWORD()+05*));
|
|
53100 ADJUSTSP :=0;
|
|
53102 (*+02() ADJUSTSP := ADJUSTSP+2*SZADDR; (*ROUTN*) ()+02*)
|
|
53110 (*+05() ADJUSTSP := ADJUSTSP+2*SZWORD; ()+05*)
|
|
53112 (*-01() EMITX1(PCALL, OCVSBS,ORD(RTSTACK)); ()-01*)
|
|
53120 (*+01() EMITX3(PCALL, OCVSBS,ORD(RTSTACK),
|
|
53130 OCVIMMLONG,ORD(STKMAP(SB^.SBRTSTK)), OCVIMMED,ROUTNL^.RNLOCRG+1); ()+01*)
|
|
53140 END;
|
|
53150 EMITX1(PASP,OCVIMMED,ADJUSTSP);
|
|
53155 (*+02()CGFLINE;()+02*)
|
|
53160 (*-02()FILL(NORMAL(SBR), SBR);()-02*)
|
|
53162 (*+02()FILL(SBTPRR,SBR); ()+02*)
|
|
53164 SBR^.SBRTSTK := RTSTACK; RTSTACK := SBR;
|
|
53170 END;
|
|
53180 (**)
|
|
53190 (**)
|
|
53200 PROCEDURE CGCOLLUNIT;
|
|
53210 (*AT EACH UNIT OF DISPLAY*)
|
|
53220 VAR OPCOD : POP;
|
|
53230 BEGIN
|
|
53240 WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
|
53250 IF NOT (SBUNION IN SBINF) THEN (*NOT DATA LIST*)
|
|
53260 BEGIN
|
|
53270 IF NOT (SBCOLL IN SBINF) THEN
|
|
53280 BEGIN
|
|
53290 IF SBMODE^.MDV.MDID=MDIDSTRUCT THEN ALLOWNAK(SB) ELSE GETTOTAL(SB);
|
|
53300 IF SBNAKED IN SBINF THEN
|
|
53310 BEGIN OPCOD:=PCOLLNAKED; GENOP(OPCOD, SBMODE, OLIST5, SB); GETTOTCMN(SB) END
|
|
53320 ELSE
|
|
53330 BEGIN OPCOD:=PCOLLTOTAL; GENOP(OPCOD, SBMODE, OLIST6, SB) END;
|
|
53340 WITH RTSTACK^ DO
|
|
53350 IF GENDPOCV=OCVNONE THEN
|
|
53360 EMITX4(OPCOD,OCVSB,ORD(SBRTSTK),OCVSB,ORD(SB),OCVIMMED,SBRTSTK^.SBOFFSET,OCVRES,ORD(SBRTSTK))
|
|
53370 ELSE EMITX5(OPCOD,OCVSB,ORD(SBRTSTK),OCVSB,ORD(SB),
|
|
53380 GENDPOCV,GENDPVAL,OCVIMMED,SBRTSTK^.SBOFFSET,OCVRES,ORD(SBRTSTK));
|
|
53390 WITH RTSTACK^ DO SBOFFSET := SBOFFSET+SB^.SBMODE^.MDV.MDLEN;
|
|
53400 (*FOR A MULT, MDLEN=0, SO COLLTM ADVANCES POINTER AT RUN TIME *)
|
|
53410 END
|
|
53420 ELSE IF RTSTACK=SB THEN WITH SRSTK[SRSUBP-1] DO
|
|
53430 BEGIN SB^.SBTYP := RTSTACK^.SBTYP; SB^.SBOFFSET := RTSTACK^.SBOFFSET; UNSTACKSB; STACKSB(SB) END;
|
|
53440 DISPOSE(SB); SRSEMP := SRSEMP-1
|
|
53450 END
|
|
53460 END;
|
|
53470 (**)
|
|
53480 (**)
|
|
53490 PROCEDURE CGCASA;
|
|
53500 (*BEFORE .IN*)
|
|
53510 BEGIN
|
|
53520 GENFLIF(PCASE,SRSTK[SRSEMP].SB);
|
|
53530 STARTCHAIN;
|
|
53540 MARK(FIXUPM)
|
|
53550 END;
|
|
53560 (**)
|
|
53570 (**)
|
|
53580 PROCEDURE CGCASC;
|
|
53590 (*AT END OF .CASE, TO FORM JUMP TABLE*)
|
|
53600 VAR COUNT: INTEGER;
|
|
53602 FIRSTMARK: LABL;
|
|
53610 PROCEDURE CASECHAIN(L: LABL);
|
|
53622 VAR COUNTCOPY: INTEGER;
|
|
53630 BEGIN
|
|
53650 IF L<>0 THEN
|
|
53660 BEGIN
|
|
53670 COUNT := COUNT+1;
|
|
53672 COUNTCOPY := COUNT;
|
|
53680 CASECHAIN(POPMARK);
|
|
53690 (*+01() UPPER; ()+01*)
|
|
53700 (*-02() EMITX1(PCASJMP+ORD(COUNTCOPY=1), OCVMEM, L); ()-02*)
|
|
53702 (*+02() IF COUNTCOPY<>1 THEN EMITXWORD(OCVFREF(*FORCE INSTR. LABEL*), L); ()+02*)
|
|
53710 END
|
|
53720 ELSE
|
|
53730 BEGIN
|
|
53732 (*+02() IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; ()+02*)
|
|
53740 FIXUPF(POPMARK);
|
|
53750 (*-02() (*-05() EMITXWORD(OCVIMMED, COUNT); ()-05*) ()-02*)
|
|
53751 (*+02()
|
|
53752 EMITXWORD(OCVFREF(*FORCE INSTR. LABEL*), FIRSTMARK);
|
|
53754 EMITXWORD(OCVIMMED, 1); (*LWB*)
|
|
53756 EMITXWORD(OCVIMMED, COUNT-2); (*UPB-LWB*)
|
|
53757 ()+02*)
|
|
53758 (*+05() EMITX1(PCASCOUNT, OCVIMMED, COUNT-1); ()+05*)
|
|
53760 END
|
|
53770 END; (* OF CASECHAIN *)
|
|
53780 BEGIN
|
|
53790 COUNT := 0;
|
|
53792 FIRSTMARK := POPMARK;
|
|
53800 CASECHAIN(FIRSTMARK);
|
|
53810 END; (* OF CGCASC *)
|
|
53820 (**)
|
|
53830 (**)
|
|
53840 PROCEDURE CGPASC(SB, SBR: PSB);
|
|
53850 VAR SPACE: INTEGER;
|
|
53860 ORD1,ORD2: ADDRINT;
|
|
53870 BEGIN
|
|
53880 ORD1 := ORD(RTSTACK^.SBRTSTK); ORD2 := ORD(SB^.SBLEX);
|
|
53890 WITH SB^.SBMODE^.MDV DO
|
|
53900 BEGIN
|
|
53910 IF MDCNT=0 THEN SPACE := 0
|
|
53920 ELSE SPACE := SUBSTLEN([SBTID..SBTXN])-SZPROC; (*DON'T COUNT THE PROCEDURE AT SRSUBP+1*)
|
|
53930 (*+05() ADJUSTSP := 0; HOIST(SUBSTLEN([SBTSTK..SBTDL]), SPACE, FALSE); SPACE := SPACE+ADJUSTSP; ()+05*)
|
|
53940 (*+01()
|
|
53950 IF (SPACE=MDCNT) AND (MDCNT<3) THEN CASE MDCNT OF
|
|
53960 0: BEGIN UNSTACKSB; SBR^.SBTYP := SBTVOID; CLEAR(RTSTACK);
|
|
53970 EMITX2(PPASC, OCVEXT, ORD2, OCVRES, ORD(SBR)) END;
|
|
53980 1: BEGIN CLEAR(RTSTACK^.SBRTSTK);
|
|
53990 EMITX3(PPASC+1, OCVSBS, ORD(RTSTACK), OCVEXT, ORD2, OCVRES, ORD(SBR)) END;
|
|
54000 (*IN THE REMAINING CASES, CGFIRM WILL ALREADY HAVE DONE A SUITABLE CLEAR*)
|
|
54010 2: EMITX4(PPASC+2,OCVSBS,ORD1,OCVSB,ORD(RTSTACK),OCVEXT,ORD2,OCVRES,ORD(SBR));
|
|
54020 END
|
|
54030 ELSE ()+01*)
|
|
54040 IF RTSTACK^.SBTYP=SBTDL THEN (*CALL TO TRANSPUT*)
|
|
54050 BEGIN
|
|
54060 EMITX3(PPASC, OCVSBS, ORD(RTSTACK), OCVEXT, ORD2, OCVRES, ORD(SBR));
|
|
54064 (*-02() EMITX1(PASP, OCVIMMED, SPACE); ()-02*)
|
|
54070 (*+02() EMITX1(PASP, OCVIMMED, SPACE+SZADDR+SZADDR); (*SPACE+SPACE FOR FILE+STATIC LINK*) ()+02*)
|
|
54080 END
|
|
54090 ELSE (*NON-TRANSPUT*)
|
|
54100 (*+01() EMITX4(PPASC+3, OCVSBS, ORD(RTSTACK), OCVIMMED, SPACE, OCVEXT, ORD2, OCVRES, ORD(SBR)); ()+01*)
|
|
54120 (*-01() BEGIN
|
|
54130 EMITX3(PPASC+1, OCVSBS, ORD(RTSTACK), OCVEXT, ORD2, OCVRES, ORD(SBR));
|
|
54140 (*+02() EMITX1(PASP, OCVIMMED, SPACE+SZADDR); (*SPACE+STATIC LINK*)()+02*)
|
|
54142 (*-02() EMITX1(PASP, OCVIMMED, SPACE); ()-02*)
|
|
54150 END;
|
|
54155 (*-02()FILL(NORMAL(SBR),SBR); (*WHY IS THIS HERE?*) ()-02*)
|
|
54158 ()-01*)
|
|
54162 END;
|
|
54166 END;
|
|
54180 (**)
|
|
54190 (**)
|
|
54200 PROCEDURE CGFIXRG;
|
|
54210 (* PURPOSE: SETS RGNEXTFREE TO ITS CORRECT VALUE IF NECESSARY *)
|
|
54220 BEGIN
|
|
54222 (*+02()CLEAR(RTSTACK); (*IN CASE ANYTHING IN PRR*) ()+02*)
|
|
54230 IF (RGSTATE<16) AND NOT(DCLPARM IN RGINFO) THEN (*RGNEXTFREE NOT OK *)
|
|
54240 BEGIN
|
|
54250 EMITX1(PFIXRG,OCVIMMED,CURID-TODOCOUNT);
|
|
54260 EMITX1(PFIXRG+1,OCVIMMED,CURLEB+RGOFFSET);
|
|
54270 RGSTATE := RGSTATE + 16;
|
|
54280 END;
|
|
54290 END;
|
|
54300 (**)
|
|
54310 (**)
|
|
54320 PROCEDURE BRKASCR;
|
|
54322 LABEL 99;
|
|
54330 VAR I: INTEGER;
|
|
54340 SB1: PSB;
|
|
54350 PTR: PSTB;
|
|
54352 PILE: BOOLEAN;
|
|
54360 BEGIN
|
|
54370 (*THE UNITS TO BE ASCRIBED ARE ON THE SUBSTACK (SUBSAVE IN S-34)*)
|
|
54390 IF ((RGSTATE MOD 16) IN [1..DLACTION -1]) AND (PSCOUNT <> 0) THEN
|
|
54400 BEGIN
|
|
54410 IF NOT (DCLPARM IN RGINFO) THEN
|
|
54420 BEGIN
|
|
54421 I := CURID-PSCOUNT;
|
|
54436 PILE := DCLPRVMODE^.MDV.MDPILE;
|
|
54438 EMITX0(PDCLINIT+ORD(PILE));
|
|
54440 I := CURID-PSCOUNT;
|
|
54450 WHILE I<>CURID DO
|
|
54460 BEGIN EMITX1(PDCLINIT+2+ORD(PILE), OCVIMMED,I);
|
|
54462 I := I+SZINT (*+19()+(SZADDR-SZINT)*ORD(PILE)()+19*) END;
|
|
54464 (*+02() EMITX1(PASP, OCVIMMED, SZINT (*+19()+(SZADDR-SZINT)*ORD(PILE)()+19*) ); ()+02*)
|
|
54470 END;
|
|
54480 RGSTATE := RGSTATE MOD 16;
|
|
54490 END;
|
|
54500 IF ((RGSTATE MOD 16)>=DLACTION) AND NOT (DCLPARM IN RGINFO) THEN
|
|
54510 (*SOME SORT OF INITIALISATION NEEDED *)
|
|
54520 BEGIN
|
|
54530 IF ((RGSTATE MOD 16)<DLUNITS) AND NOT(DCLACTDR IN RGINFO) THEN (*UNINITIALIZED MULT OR STRUCT*)
|
|
54540 BEGIN
|
|
54550 RGINFO := RGINFO+[DCLACTDR];
|
|
54560 GENDP(DCLPRVMODE);
|
|
54570 IF DCLPRVMODE^.MDV.MDID=MDIDROW THEN
|
|
54580 EMITX3(PACTDRMULT, OCVSB, ORD(RTSTACK), GENDPOCV, GENDPVAL, OCVRES, ORD(RTSTACK))
|
|
54590 ELSE
|
|
54600 BEGIN
|
|
54610 SB1 := PUSHSB(MDBNDS); UNSTACKSB;
|
|
54620 EMITX2(PACTDRSTRUCT, GENDPOCV, GENDPVAL, OCVRES, ORD(SB1));
|
|
54630 END;
|
|
54640 END;
|
|
54642 I := 0 ;
|
|
54650 IF (RGSTATE MOD 16) > 11 THEN (*NOT STOWED VARIABLE-DECLARATIONS*)
|
|
54660 IF TODOCOUNT=0 THEN (* NO ACTION *)
|
|
54670 ELSE IF ((RGSTATE MOD 16)<>12) AND (TODOCOUNT=SZADDR) THEN
|
|
54675 EMITX2(PDCLSP+1, OCVSBS, ORD(RTSTACK), OCVIMMED, CURID-TODOCOUNT)
|
|
54676 ELSE IF TODOCOUNT=SZWORD THEN
|
|
54680 EMITX2(PDCLSP, OCVSBS, ORD(RTSTACK), OCVIMMED, CURID-TODOCOUNT)
|
|
54690 ELSE
|
|
54700 EMITX3(PDCLSP+2+ORD((RGSTATE MOD 16)<>12),OCVSBS,ORD(RTSTACK),OCVIMMED,TODOCOUNT,OCVIMMED,CURID-TODOCOUNT)
|
|
54710 ELSE WHILE I<TODOCOUNT DO
|
|
54720 BEGIN
|
|
54730 IF (RGSTATE MOD 16) IN [4, 5] THEN (*UNINITIALIZED STRUCT*)
|
|
54740 IF (DCLSAVEDESC IN RGINFO) OR (TODOCOUNT-I>SZADDR) THEN (*ACTDR WILL BE NEEDED AGAIN*)
|
|
54750 BEGIN
|
|
54760 SB1 := PUSHSB(RTSTACK^.SBMODE); UNSTACKSB;
|
|
54770 EMITX2(PDUP1PILE, OCVSBP, ORD(RTSTACK), OCVRES, ORD(SB1));
|
|
54780 END
|
|
54790 ELSE (*NO ACTION*)
|
|
54800 ELSE IF (RGSTATE MOD 16) IN [10, 11] THEN (*INITIALIZED MULT*)
|
|
54810 BEGIN
|
|
54820 SB1 := PUSHSB(RTSTACK^.SBMODE); UNSTACKSB;
|
|
54830 EMITX3(PDUP2PILE, OCVSBP, ORD(RTSTACK^.SBRTSTK), OCVSBP, ORD(RTSTACK), OCVRES, ORD(SB1));
|
|
54834 WITH RTSTACK^.SBRTSTK^ DO SBINF := SBINF-[SBSTKDELAY];
|
|
54840 EMITX3(PCHECKDESC, OCVSB, ORD(RTSTACK^.SBRTSTK), OCVSB, ORD(RTSTACK), OCVRES, ORD(RTSTACK));
|
|
54860 END;
|
|
54870 EMITX2(PCREATEREF + RGSTATE MOD 4, OCVSB, ORD(RTSTACK), OCVRES, ORD(RTSTACK));
|
|
54871 IF ((DCLSAVEDESC IN RGINFO) OR (TODOCOUNT-I>SZADDR)) AND ((RGSTATE MOD 16) IN [6, 7]) THEN
|
|
54872 BEGIN (*UNINITIALIZED MULT*)
|
|
54874 SB1 := PUSHSB(RTSTACK^.SBMODE); UNSTACKSB;
|
|
54876 EMITX2(PDUP1PILE, OCVSBP, ORD(RTSTACK), OCVRES, ORD(SB1));
|
|
54878 END;
|
|
54880 EMITX2(PDCLSP+1, OCVSB, ORD(RTSTACK), OCVIMMED, CURID -I -SZADDR);
|
|
54900 I := I+SZADDR
|
|
54910 END;
|
|
54920 IF NOT(DCLSAVEDESC IN RGINFO) AND ((RGSTATE MOD 16) IN [10, 11]) THEN
|
|
54930 EMITX1(PVARLISTEND+ORD(DCLACTDR IN RGINFO), OCVSB, ORD(RTSTACK));
|
|
54940 IF NOT(DCLSAVEDESC IN RGINFO) THEN RGINFO := RGINFO-[DCLACTDR];
|
|
54950 WHILE (SRSTK[SRSEMP].SB<>RTSTACK (*IN CASE DCLSAVEDESC*) ) AND (SRSEMP<>SRSUBP) DO
|
|
54960 BEGIN DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1 END;
|
|
54970 IF (RGSTATE MOD 16) <> 15 THEN
|
|
54980 BEGIN
|
|
54990 PTR := DCIL;
|
|
55000 WHILE TRUE DO
|
|
55002 IF PTR=NIL THEN GOTO 99
|
|
55004 ELSE WITH PTR^ DO
|
|
55010 BEGIN
|
|
55020 IF NOT(STCONST IN PTR^.STDEFTYP) AND (PTR^.STMODE<>NIL) THEN
|
|
55022 IF STOFFSET(*-41()<()-41*)(*+41()<=()+41*)CURID-TODOCOUNT THEN GOTO 99
|
|
55040 ELSE IF STUSED IN STDEFTYP THEN SEMERRP(ESE+63,STLEX);
|
|
55050 PTR := PTR^.STTHREAD;
|
|
55060 END;
|
|
55070 99: END;
|
|
55080 RGSTATE := 0 ;
|
|
55090 END;
|
|
55100 IF (RGSTATE IN [DLASCR..15]) THEN CGFIXRG;
|
|
55110 PSCOUNT := 0;
|
|
55120 TODOCOUNT := 0;
|
|
55130 IF RGSTATE <16 THEN RGSTATE := 0
|
|
55140 ELSE RGSTATE := 16 (* RGNEXTFREE OK *)
|
|
55150 END;
|
|
55160 (**)
|
|
55170 (**)
|
|
55180 (**)
|
|
55190 (**)
|
|
55200 (**)
|
|
55210 PROCEDURE CGDEPROC (SB:PSB);
|
|
55220 VAR OFFSET: INTEGER;
|
|
55230 OPCOD: POP;
|
|
55240 OCVFIX: OPDTYP;
|
|
55242 SB1: PSB;
|
|
55244 I: INTEGER;
|
|
55250 BEGIN
|
|
55252 (*-01()
|
|
55253 IF SB<>RTSTACK THEN TWIST;
|
|
55254 SB1 := PUSHSB(MDLINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := STKMAP(SB^.SBRTSTK); LOADSTK(SB1); TWIST;
|
|
55256 SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := ROUTNL^.RNLOCRG+1; LOADSTK(SB1); TWIST;
|
|
55258 ()-01*)
|
|
55260 IF SB^.SBTYP IN [SBTPROC,SBTRPROC] THEN
|
|
55270 BEGIN
|
|
55280 IF SB^.SBTYP = SBTPROC THEN OCVFIX := OCVMEM
|
|
55290 ELSE (*SBTRPROC *) OCVFIX := OCVFREF;
|
|
55300 (*-01() ADJUSTSP := 0; ()-01*)
|
|
55310 OPCOD := PCALLA ;
|
|
55320 OFFSET := GENLCLGBL(OPCOD,SB) ;
|
|
55330 (*+01() CGFIRM; (* TO FORCE ANY DELAYED STUFF TO BE LOADED *) ()+01*)
|
|
55340 UNSTACKSB;
|
|
55342 (*+05() HOIST(0, 0, FALSE);
|
|
55344 IF ADJUSTSP<>0 THEN FILL(SBTSTK, PUSHSB(MDINT));
|
|
55348 ()+05*)
|
|
55349 (*-01() EMITX2(OPCOD, ()-01*)
|
|
55350 (*+01() EMITX4(OPCOD,OCVIMMLONG,STKMAP(RTSTACK),OCVIMMED,ROUTNL^.RNLOCRG+1, ()+01*)
|
|
55360 OCVFIX,SB^.SBXPTR,OCVLCLGBL,(*-02()OFFSET()-02*)(*+02()-SZADDR()+02*));
|
|
55365 (*-01() ADJUSTSP:=ADJUSTSP+SZLONG+SZWORD; (*BITP & LOCRG*) ()-01*)
|
|
55370 END
|
|
55380 ELSE
|
|
55390 BEGIN
|
|
55400 EMITX1(PGETPROC+1, OCVSB, ORD(SB));
|
|
55410 (*-01() ADJUSTSP := 0; ()-01*)
|
|
55412 (*+02() ADJUSTSP := ADJUSTSP+SZLONG+SZWORD+2*SZADDR; (*BITP, LOCRG & ROUTN*) ()+02*)
|
|
55420 (*+05() HOIST(0, 0, FALSE);
|
|
55422 IF ADJUSTSP<>0 THEN FILL(SBTSTK, PUSHSB(MDINT));
|
|
55426 ADJUSTSP := ADJUSTSP+4*SZWORD;
|
|
55428 ()+05*)
|
|
55429 (*-01() EMITX0(PCALL); ()-01*)
|
|
55430 (*+01() EMITX2(PCALL, OCVIMMLONG,ORD(STKMAP(RTSTACK)), OCVIMMED,ROUTNL^.RNLOCRG+1); ()+01*)
|
|
55440 END;
|
|
55450 (*-01() EMITX1(PASP, OCVIMMED, ADJUSTSP); ()-01*)
|
|
55451 (*+02() CGFLINE; ()+02*)
|
|
55452 (*-01() FOR I := 1 TO 2 (*+05() +ORD((ADJUSTSP MOD 4)<>0) ()+05*) DO
|
|
55454 BEGIN UNSTACKSB; DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1 END;
|
|
55456 ()-01*)
|
|
55460 (*-02()FILL(NORMAL(SB), SB);()-02*)
|
|
55462 (*+02()FILL(SBTPRR, SB); ()+02*)
|
|
55464 SB^.SBRTSTK := RTSTACK; RTSTACK := SB;
|
|
55470 END;
|
|
55480 (**)
|
|
55490 PROCEDURE CGDEST;
|
|
55500 (*DESTINATION OF ASSIGNATION*)
|
|
55510 BEGIN ALLOWNAK(SRSTK[SRSEMP].SB) END;
|
|
55520 (**)
|
|
55530 (**)
|
|
55540 PROCEDURE CGFINCOLL(DEPTH: INTEGER);
|
|
55550 (*AT END OF DISPLAY*)
|
|
55560 VAR SB1: PSB;
|
|
55570 I, SPACE: INTEGER;
|
|
55580 NDL: BOOLEAN;
|
|
55590 BEGIN
|
|
55600 NDL := TRUE;
|
|
55610 WITH SRSTK[SRSUBP-1] DO WITH SB^ DO WITH SBMODE^ DO
|
|
55620 BEGIN
|
|
55630 IF MDV.MDID=MDIDROW THEN
|
|
55640 IF MDPRRMD^.MDV.MDID IN [MDIDOUT..MDIDINB] THEN
|
|
55650 BEGIN (*DATA LIST*)
|
|
55660 NDL := FALSE;
|
|
55670 (*+05() IF (RTSTKDEPTH MOD 4)<>0 THEN
|
|
55680 BEGIN SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := TX(MDVOID); LOADSTK(SB1) END;
|
|
55690 ()+05*)
|
|
55700 SPACE := SUBSTLEN([SBTSTK..SBTDL]);
|
|
55710 SBLEN := SPACE+SZDL;
|
|
55720 EMITX3(PDATALIST, OCVSBS, ORD(RTSTACK), OCVIMMED, SPACE, OCVRES, ORD(SB));
|
|
55730 POPUNITS;
|
|
55740 END
|
|
55750 ELSE
|
|
55760 IF SBLEFTCOLL IN SBINF THEN
|
|
55770 BEGIN FIXUPFIM(SBXPTR, SBLEVEL); SBXPTR := SBXPTR-1 END
|
|
55780 ELSE EMITX4(PCOLLCHECK,OCVSB,ORD(RTSTACK),OCVIMMED,DEPTH,OCVIMMED,SBLEVEL,OCVRES,ORD(RTSTACK));
|
|
55790 IF NDL THEN
|
|
55800 BEGIN
|
|
55810 SUBREST;
|
|
55820 IF DEPTH=0 THEN
|
|
55830 BEGIN
|
|
55840 EMITX2(PNAKEDPTR, OCVSB,ORD(SB), OCVRES,ORD(SB)); (*NOT NEEDED ON PDP11*)
|
|
55850 SBINF := SBINF-[SBNAKED,SBCOLL]
|
|
55860 END
|
|
55870 END
|
|
55880 END
|
|
55890 END;
|
|
55900 (**)
|
|
55910 (**)
|
|
55920 PROCEDURE CGFLADJUMP;
|
|
55930 BEGIN GENFLAD END;
|
|
55940 (**)
|
|
55950 (**)
|
|
55960 PROCEDURE CGIBAL;
|
|
55970 (*AFTER INNER UNIT OF A BALANCE (SEE INNERBAL)*)
|
|
55980 BEGIN WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
|
55990 IF SBMODE<>MDJUMP THEN
|
|
56000 BEGIN
|
|
56010 CLEAR(RTSTACK^.SBRTSTK);
|
|
56020 IF RTSTACK^.SBTYP=SBTPROC THEN LOAD(NORMAL(RTSTACK),RTSTACK);
|
|
56030 SBXPTR := GETNEXTLABEL;
|
|
56040 EMITX1(PJMP, OCVFREF, SBXPTR)
|
|
56050 (*POSTPONES ELABORATION TO POINT WHERE A POSTERIORI MODE IS KNOWN*)
|
|
56060 END;
|
|
56070 UNSTACKSB
|
|
56080 END;
|
|
56090 (**)
|
|
56100 (**)
|
|
56110 PROCEDURE CGIFA;
|
|
56120 (*BEFORE .THEN*)
|
|
56130 BEGIN GENFLIF(PJMPF,SRSTK[SRSEMP].SB) END;
|
|
56140 (**)
|
|
56150 (**)
|
|
56160 PROCEDURE CGINIT;
|
|
56170 BEGIN
|
|
56180 PREVLINE := 0;
|
|
56190 MARKPTR := NIL;
|
|
56200 (*+01() REGSINUSE := []; ()+01*)
|
|
56210 EMITBEG
|
|
56220 END;
|
|
56230 (**)
|
|
56240 (**)
|
|
56250 (**)
|
|
56260 (**)
|
|
56270 (**)
|
|
56280 PROCEDURE CGLABA(P: PSTB);
|
|
56290 (*NEW LABEL TO JUMP BACK TO*)
|
|
56300 BEGIN CLEAR(RTSTACK); (*+42() SETTEXTSTATE; ()+42*) P^.STXPTR[0] := FIXUPM END;
|
|
56310 (**)
|
|
56320 (**)
|
|
56330 PROCEDURE CGLABB(P: PSTB; WHICH: INTEGER);
|
|
56340 (*NEW LABEL WITH OUTSTANDING FORWARD JUMP*)
|
|
56350 BEGIN
|
|
56360 WITH P^ DO
|
|
56362 IF STXPTR[WHICH]<>0 THEN
|
|
56370 BEGIN CLEAR(RTSTACK); (*+42() SETTEXTSTATE; ()+42*) FIXUPF(STXPTR[WHICH]); STXPTR[WHICH] := 0 END
|
|
56380 END;
|
|
56390 (**)
|
|
56400 (**)
|
|
56410 PROCEDURE CGLABC(P: PSTB; WHICH: INTEGER);
|
|
56420 (*JUMP*)
|
|
56430 VAR MAP: BITMAP;
|
|
56440 BEGIN
|
|
56450 CLEAR(RTSTACK);
|
|
56460 MAP.INT := STKMAP(ASPTR(0));
|
|
56470 IF MAP.MASK<>0 THEN EMITX1(PGBSTK, OCVIMMLONG, MAP.INT);
|
|
56472 IF MAP.COUNT<>0 THEN EMITX1(PASP, OCVIMMED, MAP.COUNT);
|
|
56474 IF WHICH=1 THEN (*JUMP OUT OF ROUTINE*) WITH P^ DO
|
|
56476 BEGIN
|
|
56480 STXPTR[1] := GETNEXTLABEL;
|
|
56481 (*-01() (*-02() (*FOR SYSTEMS WHICH CANNOT JUMP INTO OTHER ROUTINES - SEE ALSO CHANGES IN RANGEXT*)
|
|
56482 EMITX2(POUTJUMP, OCVMEM, ROUTNL^.RNLINK^.RNADDRESS, OCVFREF, STXPTR[1]);
|
|
56483 (*JUMP INTO IMMEDIATELY SURROUDING ROUTINE*)
|
|
56484 ()-02*) ()-01*)
|
|
56485 (*+01() EMITX1(PJMP, OCVFREF, STXPTR[1]); ()+01*)
|
|
56486 (*+02() EMITX1(POUTJUMP, OCVFREF, STXPTR[1]); ()+02*)
|
|
56487 END
|
|
56488 ELSE
|
|
56490 WITH P^ DO
|
|
56500 IF STBLKTYP=STBAPPLAB THEN
|
|
56510 BEGIN IF STXPTR[WHICH]=0 THEN STXPTR[WHICH] := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, STXPTR[WHICH]) END
|
|
56520 ELSE EMITX1(PJMP, OCVMEM, STXPTR[WHICH])
|
|
56530 END;
|
|
56540 (**)
|
|
56550 (**)
|
|
56560 PROCEDURE CGLABD(P: PSTB);
|
|
56570 (*TRANSFER JUMP TO STB TO BE JUMP TO STB^.STLINK*)
|
|
56580 VAR I: INTEGER;
|
|
56582 BEGIN
|
|
56590 WITH P^ DO FOR I := 0 TO 1 DO
|
|
56600 IF STXPTR[I]<>0 THEN
|
|
56610 IF STLINK^.STXPTR[I]<>0 THEN BEGIN (*+42() SETTEXTSTATE; ()+42*)
|
|
56620 FIXLABL(STXPTR[I], STLINK^.STXPTR[I], (STLINK^.STBLKTYP=STBDEFLAB) AND (I=0)) END
|
|
56630 ELSE STLINK^.STXPTR[I] := STXPTR[I];
|
|
56640 END;
|
|
56650 (**)
|
|
56660 (**)
|
|
56670 PROCEDURE CGLABE(P: PSTB; LEVEL: DEPTHR; LEB: OFFSETR);
|
|
56680 (*JUMP OUT OF ROUTINE*)
|
|
56682 VAR PR: PRANGE;
|
|
56684 COUNT: INTEGER;
|
|
56685 LL: LABL;
|
|
56686 (*+05() SAVE: DEPTHR; ()+05*)
|
|
56687 BEGIN
|
|
56688 (*-02() LL := P^.STXPTR[1]; ()-02*)
|
|
56689 (*+02()
|
|
56690 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA;
|
|
56691 FIXUPF(P^.STXPTR[1]); (*LABEL FOR GTO DESCRIPTOR*)
|
|
56692 LL := GETNEXTLABEL; EMITXWORD(OCVFREF, LL);
|
|
56693 EMITXWORD(OCVIMMPTR, 0); EMITXWORD(OCVIMMPTR, 0);
|
|
56694 SETTEXTSTATE;
|
|
56695 ()+02*)
|
|
56696 FIXUPF(LL); (*LABL TO WHICH ROUTINES ACTUALLY JUMP*)
|
|
56697 PR := RANGEL;
|
|
56698 COUNT := 0;
|
|
56699 WHILE DCLLOOP IN PR^.RGINF DO
|
|
56700 BEGIN COUNT := COUNT+1; PR := PR^.RGLINK^.RGLINK END;
|
|
56701 (*+05() SAVE := RTSTKDEPTH; RTSTKDEPTH := 0; ()+05*)
|
|
56702 EMITX4(PGETOUT, OCVIMMED, LEVEL, OCVIMMED, LEB, OCVIMMLONG, STKMAP(RTSTACK), OCVIMMED, COUNT);
|
|
56710 (*ABOVE RETURNS IB PTR FOR TARGET RN*)
|
|
56720 EMITX0(PSETIB);
|
|
56722 (*+05() RTSTKDEPTH := SAVE;
|
|
56724 IF (RTSTKDEPTH MOD 4)<>0 THEN EMITX1(PASP, OCVIMMED, 2); (*BECAUSE SETIB CAN ONLY LEAVE SF QUAD-ALIGNED*)
|
|
56726 ()+05*)
|
|
56729 EMITX1(PJMP, OCVMEM, P^.STXPTR[0]); (*JUMP TO GENUINE LABEL*)
|
|
56730 END;
|
|
56740 (**)
|
|
56750 (**)
|
|
56760 PROCEDURE CGLEFTCOLL(SB: PSB);
|
|
56770 (*AT START OF DISPLAY*)
|
|
56780 VAR COLLM: MODE;
|
|
56790 ROWCOUNT: CNTR;
|
|
56800 XPTR: LABL;
|
|
56810 I: INTEGER;
|
|
56820 SB1: PSB;
|
|
56830 BEGIN
|
|
56840 WITH SRSTK[SRSEMP].SB^ DO IF NOT (SBUNION IN SBINF) THEN
|
|
56850 BEGIN
|
|
56855 WITH SB^ DO SBINF := SBINF+[SBNAKED];
|
|
56860 IF SBCOLL IN SBINF THEN
|
|
56870 SB^.SBXPTR := SBXPTR
|
|
56880 ELSE BEGIN
|
|
56890 COLLM := SCL^.SCMODE;
|
|
56900 GENDP(COLLM);
|
|
56910 IF COLLM^.MDV.MDID<>MDIDROW THEN (*INCLUDING ERRONEOUS COLLM*)
|
|
56920 EMITX2(PPREPSTRDISP, GENDPOCV,GENDPVAL, OCVRES,ORD(SB))
|
|
56930 ELSE WITH SBMODE^ DO
|
|
56940 BEGIN
|
|
56950 ROWCOUNT := COLLM^.MDV.MDCNT;
|
|
56960 IF MDV.MDID=MDIDROW THEN BEGIN ROWCOUNT := ROWCOUNT-MDV.MDCNT; LOADSTK(RTSTACK) END
|
|
56970 ELSE CLEAR(RTSTACK); (*BECAUSE OF THE PPUSHIMS WHICH FOLLOW*)
|
|
56980 SUBSAVE;
|
|
56990 FOR I := 1 TO ROWCOUNT DO
|
|
57000 BEGIN
|
|
57010 SB1 := PUSHSB(MDINT); UNSTACKSB;
|
|
57020 XPTR := GETNEXTLABEL;
|
|
57030 EMITX2(PPUSHIM(*+02()+3()+02*), OCVFIM, XPTR, OCVRES, ORD(SB1)) (*INSERT ABOVE TOP ITEM OF RTSTACK*)
|
|
57040 END;
|
|
57050 SB^.SBXPTR := XPTR;
|
|
57060 EMITX4(PPREPROWDISP+ORD(MDV.MDID=MDIDROW), OCVSBS, ORD(SB1),
|
|
57070 OCVIMMED, ROWCOUNT, GENDPOCV, GENDPVAL, OCVRES, ORD(SB));
|
|
57080 POPUNITS;
|
|
57090 (*STACK IS NOW TWISTED*)
|
|
57100 END;
|
|
57110 TWIST; (*UNTWIST*)
|
|
57120 SB^.SBOFFSET := 0;
|
|
57130 END;
|
|
57150 END;
|
|
57160 WITH SB^ DO
|
|
57170 SBINF := SBINF+[SBLEFTCOLL]
|
|
57180 END;
|
|
57190 (**)
|
|
57200 (**)
|
|
57210 PROCEDURE CGLEAPGEN(HEAP: BOOLEAN);
|
|
57220 VAR XCOD: POP;
|
|
57230 BEGIN WITH SRSTK[SRSEMP] DO WITH SB^.SBMODE^ DO
|
|
57240 BEGIN
|
|
57250 GENDP(MDPRRMD);
|
|
57260 WITH MDPRRMD^, ROUTNL^ DO
|
|
57270 BEGIN
|
|
57280 XCOD := ORD(HEAP)+2*ORD(MDV.MDRECUR AND NOT HEAP)+3*ORD(MDV.MDID=MDIDROW);
|
|
57290 CASE XCOD OF
|
|
57300 0,2: EMITX3(PLEAPGEN+XCOD, GENDPOCV, GENDPVAL, OCVIMMED, RNLOCRG, OCVRES, ORD(SB));
|
|
57310 1: EMITX2(PLEAPGEN+XCOD, GENDPOCV, GENDPVAL, OCVRES, ORD(SB));
|
|
57320 3,5: EMITX4(PLEAPGEN+XCOD, OCVSB, ORD(SB), GENDPOCV, GENDPVAL, OCVIMMED, RNLOCRG, OCVRES, ORD(SB));
|
|
57330 4: EMITX3(PLEAPGEN+XCOD, OCVSB, ORD(SB), GENDPOCV, GENDPVAL, OCVRES, ORD(SB));
|
|
57340 END;
|
|
57350 END;
|
|
57360 END
|
|
57370 END;
|
|
57380 (**)
|
|
57390 (**)
|
|
57400 (**)
|
|
57410 (**)
|
|
57420 PROCEDURE CGLPA(SB: PSB);
|
|
57430 (*LABEL AT START OF LOOP*)
|
|
57440 BEGIN CLEAR(RTSTACK); (*+42() SETTEXTSTATE; ()+42*) SB^.SBXPTR := FIXUPM END;
|
|
57450 (**)
|
|
57460 (**)
|
|
57470 PROCEDURE CGLPB(SB: PSB);
|
|
57480 (*START OF COUNTING LOOP*)
|
|
57490 BEGIN
|
|
57500 WITH SB^ DO
|
|
57510 BEGIN
|
|
57520 EMITX3(PLPINIT+ORD(SBEMPTYBY IN SBINF), OCVSBS, ORD(SRSTK[SRSEMP].SB), OCVIMMPTR, SBOFFSET, OCVRES, ORD(SB));
|
|
57525 (*+02()LOADSTK(SB);()+02*) (*FORCE RESULT FROM PRR TO THE STACK*)
|
|
57530 SBXPTR := FIXUPM;
|
|
57540 (*NOTE THAT SB MUST BE SET CONSISTENTLY IN CGLPE*)
|
|
57550 GENFLIF(PLPTEST, SB)
|
|
57560 END
|
|
57570 END;
|
|
57580 (**)
|
|
57590 (**)
|
|
57600 PROCEDURE CGLPC(SB: PSB);
|
|
57610 (*START OF NON-COUNTING LOOP*)
|
|
57620 BEGIN
|
|
57630 WITH SB^ DO
|
|
57640 EMITX2(PLPINIT+2+ORD(SBEMPTYBY IN SBINF), OCVSBS, ORD(SRSTK[SRSEMP].SB), OCVIMMED, SBOFFSET);
|
|
57650 CGLPA(SB);
|
|
57660 (*ON A PURE STACK MACHINE, THE RESULT OF PLPINCR MAY HAVE TO BE POPPED HERE*)
|
|
57670 END;
|
|
57680 (**)
|
|
57690 (**)
|
|
57700 PROCEDURE CGLPD;
|
|
57710 (*AFTER WHILE-PART*)
|
|
57720 BEGIN GENFLIF(PJMPF, SRSTK[SRSEMP].SB) END;
|
|
57730 (**)
|
|
57740 (**)
|
|
57750 PROCEDURE CGLPE;
|
|
57760 (*END OF LOOP*)
|
|
57770 BEGIN WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
|
57780 BEGIN
|
|
57790 IF [DCLLOCRNG,DCLLOOP]*RGINFO=[DCLLOCRNG] THEN EMITX0(PRANGEXT); (*END OF WHILE LOOP*)
|
|
57800 IF SBLEX<>NIL THEN (*COUNTING*)
|
|
57810 BEGIN
|
|
57811 IF SBEMPTYBY IN SBINF THEN
|
|
57812 EMITX2(PLPINCR+1, OCVIMMED, SBOFFSET(*-41()+SZWORD()-41*)(*+41()-SZINT()+41*), OCVRES, ORD(SB))
|
|
57814 ELSE EMITX2(PLPINCR, OCVIMMED, SBOFFSET, OCVRES, ORD(SB));
|
|
57816 (*+02() LOADSTK(SB); ()+02*)
|
|
57820 UNSTACKSB; SBTYP := SBTVOID; (*BUT REAPPEARS IN CGLPB*)
|
|
57830 END;
|
|
57840 EMITX1(PJMP, OCVMEM, SBXPTR)
|
|
57850 END
|
|
57860 END;
|
|
57870 (**)
|
|
57880 (**)
|
|
57890 PROCEDURE CGLPG;
|
|
57900 (*TO RESET LOOPCOUNT AFTER LOOP*)
|
|
57910 VAR P: PRANGE;
|
|
57920 COUNT: INTEGER;
|
|
57930 BEGIN
|
|
57940 P := RANGEL^.RGLINK;
|
|
57950 COUNT := 0;
|
|
57960 WHILE DCLLOOP IN P^.RGINF DO
|
|
57970 BEGIN COUNT := COUNT+1; P := P^.RGLINK^.RGLINK END;
|
|
57980 EMITX1(PDECM, OCVIMMED, COUNT);
|
|
57990 EMITX1(PDECM+1, OCVIMMED, CURLEB+LOOPOFFSET);
|
|
58000 END;
|
|
58010 (**)
|
|
58020 PROCEDURE CGOPCALL;
|
|
58030 (*CALL ROUTINE FOR USER DEFINED OPERATOR*)
|
|
58040 VAR SB,SB1,SB2: PSB;
|
|
58050 SPACE,OFFSET: INTEGER;
|
|
58060 OPCOD: POP;
|
|
58070 OCVFIX: OPDTYP;
|
|
58080 BEGIN
|
|
58090 SB := SRSTK[SRSEMP].SB;
|
|
58100 WITH SB^.SBMODE^ DO WITH MDV DO
|
|
58110 BEGIN
|
|
58120 UNSTACKSB; SRSEMP := SRSEMP-1; (*PRETEND ROUTINE ISNT STACKED YET*)
|
|
58130 IF MDCNT = 1 THEN SB1 := SB^.SBRTSTK^.SBRTSTK
|
|
58140 ELSE
|
|
58150 BEGIN
|
|
58160 SB1 := SB^.SBRTSTK^.SBRTSTK^.SBRTSTK;
|
|
58170 GETTOTAL(SRSTK[SRSEMP-1].SB); (*LH OPERAND*)
|
|
58180 IF RTSTACK=SRSTK[SRSEMP].SB THEN (*STACK IS NOT TWISTED*)
|
|
58190 LOADSTK(SRSTK[SRSEMP-1].SB)
|
|
58200 END;
|
|
58210 CGFIRM; (*FOR THE RH OPERAND - TWISTS IF NECESSARY*)
|
|
58212 (*-01()(*-02() LOADSTK(RTSTACK); ()-02*)()-01*)
|
|
58220 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SB; STACKSB(SB); (*STOP PRETENDING*)
|
|
58222 (*-01()
|
|
58224 SB2 := PUSHSB(MDLINT); SB2^.SBTYP := SBTLIT; SB2^.SBVALUE := STKMAP(SB1); LOADSTK(SB2); TWIST;
|
|
58226 SB2 := PUSHSB(MDINT); SB2^.SBTYP := SBTLIT; SB2^.SBVALUE := ROUTNL^.RNLOCRG+1; LOADSTK(SB2); TWIST;
|
|
58228 ()-01*)
|
|
58230 IF SB^.SBTYP IN [SBTPROC,SBTRPROC] THEN
|
|
58240 BEGIN
|
|
58250 IF SB^.SBTYP=SBTPROC THEN OCVFIX := OCVMEM
|
|
58260 ELSE (* SBTRPROC *) OCVFIX := OCVFREF;
|
|
58270 ADJUSTSP := 0;
|
|
58280 OPCOD := PCALLA;
|
|
58290 OFFSET := GENLCLGBL(OPCOD,SB);
|
|
58291 UNSTACKSB;
|
|
58292 (*-01() EMITX3(OPCOD, OCVSBS,ORD(RTSTACK), ()-01*)
|
|
58300 (*+01() EMITX5(OPCOD, OCVSBS,ORD(RTSTACK),OCVIMMLONG,STKMAP(SB1),OCVIMMED,ROUTNL^.RNLOCRG+1, ()+01*)
|
|
58310 OCVFIX,SB^.SBXPTR,OCVLCLGBL,(*-02()OFFSET()-02*)(*+02()-SZADDR()+02*));
|
|
58320 END
|
|
58330 ELSE
|
|
58340 BEGIN
|
|
58380 EMITX1(PGETPROC+1, OCVSB, ORD(SB));
|
|
58390 ADJUSTSP := 0;
|
|
58392 (*+02() ADJUSTSP := ADJUSTSP+2*SZADDR; (*ROUTN*) ()+02*)
|
|
58400 (*+05() ADJUSTSP := ADJUSTSP+2*SZWORD; ()+05*)
|
|
58402 (*-01() EMITX1(PCALL, OCVSBS,ORD(RTSTACK)); ()-01*)
|
|
58410 (*+01() EMITX3(PCALL, OCVSBS,ORD(RTSTACK), OCVIMMLONG,ORD(STKMAP(SB1)),
|
|
58420 OCVIMMED,ROUTNL^.RNLOCRG+1); ()+01*)
|
|
58430 END;
|
|
58440 EMITX1(PASP, OCVIMMED, ADJUSTSP);
|
|
58445 (*+02()CGFLINE; ()+02*)
|
|
58450 END;
|
|
58460 WITH SRSTK[SRSUBP-1] DO
|
|
58470 BEGIN
|
|
58472 (*-02() FILL(NORMAL(SB), SB);()-02*)
|
|
58474 (*+02() FILL(SBTPRR, SB); ()+02*)
|
|
58476 SB^.SBRTSTK := RTSTACK; RTSTACK := SB
|
|
58478 END;
|
|
58480 END;
|
|
58490 (**)
|
|
58500 PROCEDURE CGOPDA;
|
|
58510 (*DELAYED OPERAND*)
|
|
58520 BEGIN GETTOTAL(SRSTK[SRSEMP].SB) END;
|
|
58530 (**)
|
|
58540 (**)
|
|
58550 PROCEDURE CGOPDC;
|
|
58560 (*ORGANIZES SEMANTIC STACK FOR LH OPERAND POSTPONED BY CGIBAL*)
|
|
58570 BEGIN WITH SRSTK[SRSEMP] (*THE LOCUM TENENS*) DO
|
|
58580 BEGIN (*ASSERT: NO REGISTERS ON RTSTACK*)
|
|
58582 (*+42() SETTEXTSTATE; ()+42*)
|
|
58590 SB^.SBXPTR := FIXUPM;
|
|
58600 (*WE SHALL JUMP HERE FROM CGOPDE AFTER COERCING LH OPERAND*)
|
|
58610 FILL(NORMAL(SB),SB); (*THE LH OPERAND AS IT WILL HAVE BEEN LOADED BY CGOPDE*)
|
|
58620 END
|
|
58630 END;
|
|
58640 (**)
|
|
58650 (**)
|
|
58660 PROCEDURE CGOPDD;
|
|
58670 (*RH OPERAND WHEN LH OPERAND WAS BALANCED*)
|
|
58680 BEGIN
|
|
58690 LOADTOTAL(SRSTK[SRSEMP].SB);
|
|
58700 GENFLAD
|
|
58710 END;
|
|
58720 (**)
|
|
58730 (**)
|
|
58740 PROCEDURE CGOPDE(SBLH: PSB);
|
|
58750 (*LH OPERAND POSTPONED*)
|
|
58760 VAR M: MODE;
|
|
58770 LEN: 0..MAXSIZE;
|
|
58780 BEGIN (*ASSERT: SRSTK[SRSEMP].SB IS LOADTOTALED, ON ACCOUNT OF PRECEDING BALANCED COERCION*)
|
|
58790 WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
|
58800 BEGIN
|
|
58810 M := SBMODE; LEN := SBLEN; (*ITS TRUE MODE AND LENGTH*)
|
|
58820 SBMODE := SBLH^.SBMODE; (*THE MODE GUESSED FOR THE LOCUM TENENS IN LHOPBAL*)
|
|
58830 LOADTOTAL(SB); (*MAY ENLARGE ITS SBLEN TO THAT ANTICIPATED IN CGOPDC*)
|
|
58840 EMITX1(PJMP, OCVMEM, SBLH^.SBXPTR); (*JUMP BACK TO RH CODE*)
|
|
58850 ASSIGNFLAD;
|
|
58860 SBMODE := M; (*ITS TRUE MODE AGAIN*)
|
|
58870 SBTYP := SBLH^.SBTYP; (*LOCATION OF LH AFTER RH CODE & COERCION*)
|
|
58880 IF LEN<SBLEN THEN
|
|
58890 LOADSTK(SBLH); (*SHRINK ITS SBLEN AGAIN; THE STACK IS PROBABLY THE BEST PLACE FOR IT,
|
|
58900 SINCE EITHER CGOPBAL OR CGOPAB IS MOST LIKELY TO COME NEXT*)
|
|
58910 END;
|
|
58920 END;
|
|
58930 (**)
|
|
58940 (**)
|
|
58950 PROCEDURE CGOPR(OPCOD: POP; RESMODE: MODE; DYADIC: BOOLEAN);
|
|
58960 VAR SBLH, SBRH: PSB;
|
|
58970 BEGIN (*ASSERT: RH OPERAND IS TOTAL, BUT MAYBE TWISTED*)
|
|
58980 IF DYADIC THEN
|
|
58990 BEGIN
|
|
59000 SBLH := SRSTK[SRSEMP-1].SB;
|
|
59010 SBRH := SRSTK[SRSEMP].SB;
|
|
59020 GETTOTAL(SBLH);
|
|
59030 EMITX3(OPCOD, OCVSB, ORD(SBLH), OCVSB, ORD(SBRH), OCVRES, ORD(SBLH));
|
|
59040 END
|
|
59050 ELSE EMITX2(OPCOD, OCVSB, ORD(RTSTACK), OCVRES, ORD(RTSTACK));
|
|
59060 RTSTACK^.SBMODE := RESMODE;
|
|
59070 END;
|
|
59080 (**)
|
|
59090 (**)
|
|
59100 PROCEDURE CGOPAB(OPCOD: POP; RESMODE: MODE);
|
|
59110 VAR SB, SBLH1, SBLH2, SBRH: PSB;
|
|
59120 M: MODE;
|
|
59130 BEGIN (*ASSERT: RH OPERAND IS TOTAL, BUT MAYBE TWISTED*)
|
|
59140 SBLH1 := SRSTK[SRSEMP-1].SB; SBRH := SRSTK[SRSEMP].SB;
|
|
59150 NEW(SBLH2); SRSTK[SRSEMP].SB := SBLH2; SBLH2^ := SBLH1^;
|
|
59160 WITH SBLH1^ DO IF SBTYP>=SBTSTK THEN (*IT MUST BE DUPLICATED*)
|
|
59170 BEGIN
|
|
59180 SBLH2^.SBTYP := SBTVOID;
|
|
59190 IF SBRH^.SBTYP<SBTSTK THEN
|
|
59200 BEGIN
|
|
59210 UNSTACKSB; UNSTACKSB; STACKSB(SBLH1); (*SBRH IS UNSTACKED TEMPORARILY*)
|
|
59220 EMITX2(PDUP1ST+ORD(SBLH1^.SBLEN<>SZINT), OCVSBP, ORD(SBLH1), OCVRES, ORD(SBLH2));
|
|
59230 STACKSB(SBRH);
|
|
59240 END
|
|
59250 ELSE EMITX3(PDUP2ND+ORD(SBLH1^.SBLEN<>SZINT)+2*ORD(SBRH^.SBLEN<>SZINT),
|
|
59260 OCVSBP, ORD(SBLH1), OCVSBP, ORD(SBRH), OCVRES, ORD(SBLH2))
|
|
59270 END
|
|
59280 ELSE
|
|
59290 BEGIN UNSTACKSB; UNSTACKSB; STACKSB(SBLH1); STACKSB(SBRH); STACKSB(SBLH2) END;
|
|
59300 M := COERCE(SBLH2^.SBMODE^.MDPRRMD);
|
|
59310 GETTOTAL(SBLH2);
|
|
59320 EMITX3(OPCOD, OCVSB, ORD(SBLH2), OCVSB, ORD(SBRH), OCVRES, ORD(SBLH2));
|
|
59330 RTSTACK^.SBMODE := RESMODE^.MDPRRMD;
|
|
59332 (*ASSERT: NOT(SBSLN IN SBLH1^.SBINF)*)
|
|
59340 CGASSIGN;
|
|
59350 END;
|
|
59360 (**)
|
|
59370 (**)
|
|
59380 PROCEDURE CGRGID(STB: PSTB);
|
|
59390 (*ADD ENTRY TO RANGE IDBLOCK*)
|
|
59400 VAR IDBLOCK: BIGALFA;
|
|
59402 LALF: ALFA;
|
|
59470 LX: PLEX;
|
|
59490 M: MODE;
|
|
59500 BEGIN WITH STB^, IDBLOCK DO
|
|
59510 IF NOT(STCONST IN STDEFTYP) THEN
|
|
59520 BEGIN WITH STLEX^ DO IF LXV.LXIO=LXIOOPR THEN LX := LINK ELSE LX := STLEX;
|
|
59530 LEXALF(LX, LALF);
|
|
59540 ALF := LALF;
|
|
59550 IF STVAR IN STDEFTYP THEN
|
|
59560 BEGIN M := STMODE^.MDPRRMD; XMODE := TX(M)+17 END
|
|
59570 ELSE BEGIN M := STMODE; XMODE := TX(M)+1 END;
|
|
59580 IF M^.MDV.MDPILE THEN IDSIZE := 0
|
|
59590 ELSE IDSIZE := M^.MDV.MDLEN;
|
|
59600 EMITALF(IDBLOCK);
|
|
59610 END
|
|
59620 END;
|
|
59630 (**)
|
|
59640 (**)
|
|
59650 PROCEDURE CGRGN;
|
|
59660 (*RANGE ENTRY*)
|
|
59670 BEGIN
|
|
59680 CLEAR(RTSTACK);
|
|
59690 WITH RANGEL^ DO
|
|
59700 BEGIN
|
|
59710 RGIDBLK := GETNEXTLABEL;
|
|
59720 EMITX3(PRANGENT, OCVFREF, RGIDBLK, OCVIMMED, ROUTNL^.RNLOCRG, OCVIMMED, CURLEB(*+41()+SIZLEBBASE()+41*));
|
|
59730 END
|
|
59740 END;
|
|
59750 (**)
|
|
59760 (**)
|
|
59770 PROCEDURE CGRGXA(LOCRNG: BOOLEAN);
|
|
59780 (*SPECIAL RANGE EXIT, FOR JUMPS*)
|
|
59790 BEGIN IF LOCRNG THEN EMITX0(PRECGEN); EMITX0(PRANGEXT); END;
|
|
59800 (**)
|
|
59810 (**)
|
|
59820 PROCEDURE CGRGXB(SB: PSB);
|
|
59830 (*RANGE EXIT*)
|
|
59840 (*SB^.SBDELAYS=0 => RGINFO IS THE RANGE BEING EXITED; OTHERWISE,
|
|
59850 IT IS THE RANGE BEING EXITED TO*)
|
|
59860 BEGIN WITH SB^ DO
|
|
59870 BEGIN
|
|
59880 IF SBTYP IN [SBTVAR, SBTIDV] THEN
|
|
59890 IF SBLOCRG>ROUTNL^.RNLOCRG THEN SEMERR(ESE+14)
|
|
59900 ELSE (*NO ACTION*)
|
|
59910 ELSE WITH SBMODE^.MDV DO
|
|
59920 BEGIN
|
|
59930 IF MDSCOPE THEN
|
|
59940 IF NOT(DCLPARM IN RGINFO) OR (SBDELAYS<>0) (*NOT RANGE EXIT AT END OF ROUTINE*)
|
|
59950 OR (DCLLOCGEN IN RGINFO) OR (MDID=MDIDPROC) (*CHECK THESE EVEN AT END OF ROUTINE*) THEN
|
|
59960 BEGIN GETTOTAL(SB); EMITX2(PSCOPEEXT, OCVSB, ORD(SB), OCVRES, ORD(SB)) END;
|
|
59970 IF ((SBTYP=SBTID) AND (SBLOCRG>ROUTNL^.RNLOCRG)) OR (SBNAKED IN SBINF) THEN LOADTOTAL(SB);
|
|
59980 END;
|
|
59981 (*+02() CLEAR(RTSTACK); (*IN CASE ANYTHING IN PRR*) ()+02*)
|
|
59982 IF SBLOCGEN IN SBINF THEN EMITX0(PRECGEN);
|
|
59990 IF (SBPILEDECS IN SBINF) AND (SBTYP>=SBTSTK) AND SBMODE^.MDV.MDPILE THEN
|
|
60000 EMITX2(PRANGEXT+2, OCVSB, ORD(SB), OCVRES, ORD(SB) )
|
|
60010 ELSE IF SBPILEDECS IN SBINF THEN EMITX0(PRANGEXT)
|
|
60020 ELSE IF NOT(DCLPARM IN RGINFO) OR (SBDELAYS<>0) THEN EMITX0(PRANGEXT+1)
|
|
60030 (* ELSE DO NOT WASTE TIME FIXING RANGE STRUCTURE AT END OF ROUTINE*)
|
|
60040 END
|
|
60050 END;
|
|
60060 (**)
|
|
60070 (**)
|
|
60080 PROCEDURE CGRTA;
|
|
60090 VAR L: LABL;
|
|
60100 BEGIN WITH ROUTNL^ DO
|
|
60110 BEGIN
|
|
60120 (*-02() (*-05() GENFLAD; (*WILL BE MATCHED IN CGRTD*) ()-05*) ()-02*)
|
|
60130 RNADDRESS := EMITRTNHEAD;
|
|
60140 RNPROCBLK := GETNEXTLABEL ;
|
|
60150 (*-02() L := GETNEXTLABEL; MARK(L); (*MATCHED IN CGRTC*)
|
|
60160 (*-05() EMITX1(PRNSTART, OCVFIM, L); ()-05*) ()-02*)
|
|
60165 (*+02() EMITX0(PRNSTART); ()+02*)
|
|
60170 (*+05() EMITX2(PRNSTART, OCVNONE, 0, OCVFIM, L); ()+05*)
|
|
60180 (*-02() (*-04() (*-05() RNREGSINUSE := REGSINUSE; REGSINUSE := []; ()-05*) ()-04*) ()-02*)
|
|
60190 (*+05() RNREGSINUSE := REGSINUSE; WITH REGSINUSE DO
|
|
60200 BEGIN ECOUNT := 0; EEXTRA := 0; FPR := [] END;
|
|
60210 ()+05*)
|
|
60220 END
|
|
60230 END;
|
|
60240 (**)
|
|
60250 (**)
|
|
60260 PROCEDURE CGRTB;
|
|
60270 (*ROUTINE EXIT*)
|
|
60280 BEGIN WITH ROUTNL^, SRSTK[SRSEMP] DO WITH SB^ DO
|
|
60290 BEGIN
|
|
60300 GETTOTAL(SB);
|
|
60310 (*-02() EMITX1(PRETURN,OCVSB,ORD(SB)); ()-02*)
|
|
60315 (*+02() EMITX2(PRETURN,OCVSB,ORD(SB),OCVIMMED,LENOF(SB)); ()+02*)
|
|
60320 STACKSB(SB);
|
|
60330 END
|
|
60340 END;
|
|
60342 (**)
|
|
60344 (**)
|
|
60346 PROCEDURE CGRTE(R: PROUTN);
|
|
60348 (*OUTPUT PROCBLOCK*)
|
|
60350 VAR ROUTNAME: BIGALFA;
|
|
60351 LALF: ALFA;
|
|
60352 BEGIN WITH R^ DO
|
|
60354 BEGIN
|
|
60356 (*+42() IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; ()+42*)
|
|
60358 FIXUPF(RNPROCBLK);
|
|
60359 RNPROCBLK := FIXUPM;
|
|
60360 (*-02() (*-05()EMITXWORD()-05*)(*+05()EMITXPROC()+05*)(OCVMEM, RNADDRESS); ()-02*)
|
|
60361 (*+02() EMITXPROC (OCVEXT,RNADDRESS); ()+02*)
|
|
60362 RNADDRESS := 0; (*TO SHOW THAT PROCBLOCK HAS BEEN MADE*)
|
|
60363 EMITXWORD(OCVIMMED, RNLEVEL);
|
|
60364 EMITXWORD(OCVIMMED, RNNECLOCRG(*SCOFFSET*));
|
|
60366 EMITXWORD(OCVIMMED, RNNECLEV(*SCOPELEVEL*));
|
|
60368 EMITXWORD(OCVIMMED, (*RNLENSTK+*) RNLENIDS+SIZIBTOP); (*OBSOLETE*)
|
|
60370 EMITXWORD(OCVIMMED,RNPARAMS);
|
|
60372 LEXALF(RNLEX, LALF);
|
|
60373 ROUTNAME.ALF := LALF; (*-01() ROUTNAME.IDSIZE := 0; ROUTNAME.XMODE := 0; ()-01*)
|
|
60374 EMITALF(ROUTNAME);
|
|
60376 EMITXWORD(OCVMEM, RNIDBLK);
|
|
60378 END
|
|
60380 END;
|
|
60382 (**)
|
|
60384 (**)
|
|
60386 PROCEDURE CGRTC;
|
|
60390 BEGIN WITH ROUTNL^ DO
|
|
60400 BEGIN
|
|
60410 (*-02()(*-04() REGSINUSE := RNREGSINUSE; ()-04*)()-02*)
|
|
60420 (*+05() IF (RNLENIDS MOD 4)<>0 THEN RNLENIDS := RNLENIDS+SZWORD; ()+05*)
|
|
60430 (*-02() FIXUPFIM(POPMARK, (*+41()-()+41*)(RNLENIDS+SIZIBTOP)); ()-02*)
|
|
60470 IF (RNNONIC=1) OR (RGLEV=2) THEN
|
|
60500 CGRTE(ROUTNL);
|
|
60510 (*+02() EMITRNTAIL(RNLENIDS+SIZIBTOP+(RNLEVEL-RNNECLEV)*SZADDR); ()+02*)
|
|
60620 END;
|
|
60630 END;
|
|
60640 (**)
|
|
60650 (**)
|
|
60660 PROCEDURE CGRTD(PROCPTR: LABL);
|
|
60670 BEGIN
|
|
60680 (*-02() (*-05() ASSIGNFLAD; ()-05*) ()-02*)
|
|
60690 EMITX2(PLOADRT, OCVFREF, PROCPTR, OCVRES, ORD(SRSTK[SRSEMP].SB))
|
|
60700 END;
|
|
60710 (**)
|
|
60820 (**)
|
|
60830 PROCEDURE CGSELECT(OFFST: OFFSETR; M: MODE; SECDRY: INTEGER);
|
|
60832 VAR OPCOD: POP;
|
|
60840 BEGIN WITH SRSTK[SRSEMP] DO
|
|
60850 BEGIN
|
|
60860 ALLOWNAK(SB);
|
|
60870 IF SECDRY>=2 THEN
|
|
60880 BEGIN
|
|
60890 GENDP(M);
|
|
60900 EMITX4(PSELECTROW, OCVSB, ORD(SB), GENDPOCV, GENDPVAL, OCVIMMED, OFFST, OCVRES, ORD(SB))
|
|
60910 END
|
|
60920 ELSE WITH SRSTK[SRSEMP].SB^ DO
|
|
60930 BEGIN
|
|
60932 IF SBNAKED IN SBINF THEN OPCOD := PSELECT+2
|
|
60934 ELSE OPCOD := PSELECT+1-ORD(ODD(SECDRY));
|
|
60940 EMITX3(OPCOD, OCVSB, ORD(SB), OCVIMMED, OFFST, OCVRES, ORD(SB));
|
|
60950 IF ODD(SECDRY) THEN SBINF := SBINF+[SBWEAKREF,SBNAKED]
|
|
60960 ELSE SBINF := SBINF+[SBNOREF,SBNAKED];
|
|
60970 END
|
|
60980 END
|
|
60990 END;
|
|
61000 (**)
|
|
61010 (**)
|
|
61020 PROCEDURE CGEND;
|
|
61030 BEGIN EMITEND END;
|
|
61040 (**)
|
|
61050 (**)
|
|
61060 PROCEDURE CGSLICE(SB: PSB; REFED: BOOLEAN);
|
|
61070 VAR PTR, PTR1: PTRIMCHAIN;
|
|
61080 SB1: PSB;
|
|
61090 SPACE, I: INTEGER;
|
|
61100 (*+05() ALIGN: INTEGER; ()+05*)
|
|
61110 BEGIN
|
|
61120 SB1 := RTSTACK^.SBRTSTK;
|
|
61130 WITH SB^ DO
|
|
61140 BEGIN
|
|
61150 IF SBMODE=MDSTRNG THEN
|
|
61160 IF SBSLICEDIM=0 THEN EMITX3(PSTRNGSLICE, OCVSB, ORD(SB1), OCVSB, ORD(RTSTACK), OCVRES, ORD(SB))
|
|
61170 ELSE EMITX3(PSTRNGSLICE+1, OCVSBS, ORD(RTSTACK), OCVIMMED, SBTRIMS^.TRTYPE, OCVRES, ORD(SB))
|
|
61180 ELSE IF SBSLICEDIM=0 THEN
|
|
61190 BEGIN
|
|
61200 IF SBPRIMDIM=1 THEN EMITX3(PSLICE1, OCVSB, ORD(SB1), OCVSB, ORD(RTSTACK), OCVRES, ORD(SB))
|
|
61210 ELSE IF SBPRIMDIM=2 THEN EMITX3(PSLICE2, OCVSBS, ORD(SB1), OCVSB, ORD(RTSTACK), OCVRES, ORD(SB))
|
|
61220 ELSE EMITX3(PSLICEN, OCVSBS, ORD(RTSTACK), OCVIMMED, SBPRIMDIM, OCVRES, ORD(SB));
|
|
61230 IF REFED THEN SBINF := SBINF+[SBWEAKREF,SBNAKED,SBNAKROW]
|
|
61240 ELSE SBINF := SBINF+[SBNOREF,SBNAKED,SBNAKROW]
|
|
61250 END
|
|
61260 ELSE
|
|
61270 BEGIN
|
|
61280 LOADSTK(RTSTACK);
|
|
61290 (*+05() ALIGN := ORD((RTSTKDEPTH MOD 4)<>0)*SZWORD; ()+05*)
|
|
61300 EMITX2(PSTARTSLICE, OCVIMMED, SBSLICEDIM, OCVIMMED, SBUNITS*SZINT(*+05()+ALIGN()+05*));
|
|
61310 PTR := SBTRIMS;
|
|
61320 (*+05() ALIGN := ORD((RTSTKDEPTH MOD 4)=0)*SZWORD; ()+05*)
|
|
61330 SPACE := 0;
|
|
61340 WHILE PTR<>NIL DO
|
|
61350 BEGIN
|
|
61360 EMITX1(PTRIM+PTR^.TRTYPE, OCVIMMED, SPACE(*+05()+ALIGN()+05*));
|
|
61370 WITH PTR^ DO
|
|
61380 SPACE := SPACE+(ORD(ODD(TRTYPE))+ORD(ODD(TRTYPE DIV 2))+ORD(ODD(TRTYPE DIV 4)))*SZINT;
|
|
61390 PTR1 := PTR;
|
|
61400 PTR := PTR^.LINK;
|
|
61410 DISPOSE(PTR1);
|
|
61420 END;
|
|
61425 EMITX1(PASP, OCVIMMED, SPACE);
|
|
61428 WHILE RTSTACK<>SRSTK[SRSUBP+1].SB DO UNSTACKSB;
|
|
61430 EMITX2(PENDSLICE, OCVSB, ORD(RTSTACK), OCVRES, ORD(SB));
|
|
61440 IF REFED THEN
|
|
61442 SBINF := SBINF+[SBWEAKREF,SBSLN]
|
|
61450 ELSE SBINF := SBINF+[SBSLN];
|
|
61460 END;
|
|
61470 END
|
|
61480 END;
|
|
61490 PROCEDURE CGPARM(VAR PTR:PSTB);
|
|
61500 BEGIN
|
|
61510 WITH PTR^ DO
|
|
61530 IF STMODE^.MDV.MDPILE THEN
|
|
61550 EMITX1(PPARM,OCVIMMED,STOFFSET);
|
|
61580 END;
|
|
61590 (**)
|
|
61600 ()+86*)
|