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*)