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