--- /dev/null
+Makefile
+a68s1ce.p
+a68s1cg.p
+a68s1int.p
+a68s1lx.p
+a68s1md.p
+a68s1pa.p
+a68s1s1.p
+a68s1s2.p
+a68scod.p
+a68sdec.p
+a68sdum.p
+a68sin.p
+a68sint.p
+a68spar.p
+a68ssp.p
+cmpdum.p
+cybcod.p
+dec_main.p
+dec_main_s1.p
+getaddr.e
+make
+pcalls.e
+perqce.p
+perqcod.p
+syntax
--- /dev/null
+EMROOT=../../..
+ACK=$(EMROOT)/bin/$(MACH)
+A68S=$(EMROOT)/lib/em_a68s$(w)$(p)
+A68INIT=$(EMROOT)/lib/em_a68s_init$(w)$(p)
+PC=$(ACK) -.p -PR$(EMROOT)/lang/a68s/cpem/cpem
+PCFLAGS=-v -e -L
+UTIL=../util
+TAILOR=$(UTIL)/tailor
+CHECKSEQ=$(UTIL)/checkseq
+XREF=$(UTIL)/xref -i$(UTIL)/pascal.ign -p
+TERRS=/dev/tty
+TNOS=101 2 103 104 105 111 122 123 24 125 32 133 41 42 150 151 152 153 154 155 161 $(RECIPE)
+SFILES=a68sdec.p a68sdum.p a68sin.p a68ssp.p a68spar.p a68scod.p
+S1FILES=a68sdec.p a68s1int.p a68s1lx.p a68s1ce.p a68s1cg.p a68s1md.p a68s1s1.p a68s1s2.p a68s1pa.p
+OTHFILES=cmpdum.p getaddr.e dec_main.p dec_main_s1.p Makefile
+
+all: a68init$(w)$(p) a68s$(w)$(p)
+
+cmp: a68init$(w)$(p) a68s$(w)$(p)
+ -cmp a68init$(w)$(p) $(A68INIT)
+ -cmp a68s$(w)$(p) $(A68S)
+
+install: a68init$(w)$(p) a68s$(w)$(p)
+ rm -f $(A68S) $(A68INIT)
+ cp a68init$(w)$(p) $(A68INIT)
+ cp a68s$(w)$(p) $(A68S)
+
+getaddr.o: getaddr.e
+ $(ACK) -c.o -DEM_WSIZE=$(w) -DEM_PSIZE=$(p) -v getaddr.e
+
+pcalls.o: pcalls.e
+ $(ACK) -c.o -DEM_WSIZE=$(w) -DEM_PSIZE=$(p) -v pcalls.e
+
+init1: init1.out cmpdum
+ init1.out /dev/null /dev/null init1lst /dev/null f1
+ init1.out /dev/null Makefile init1lst /dev/null f2
+ cmpdum f1 f2 init >>init1lst
+ rm f1 f2
+ mv init init1
+
+init1.out: a68sdum.p a68sin.p a68sdec0.h lx1.o getaddr.o pcalls.o
+ (echo '#include "a68sdec0.h"';\
+ echo $(TNOS) 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 83 300 | $(TAILOR) a68sdum.p $(TERRS);\
+ echo $(TNOS) 81 83 184 300| $(TAILOR) a68sin.p $(TERRS); )\
+ >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ $(PC) $(PCFLAGS) -o init1.out pcalls.o temp.o getaddr.o lx1.o
+ rm temp.o
+
+init2: init1 init2.out cmpdum
+ init2.out /dev/null /dev/null init2lst init1 f1
+ init2.out /dev/null Makefile init2lst init1 f2
+ cmpdum f1 f2 init >>init2lst
+ rm f1 f2
+ mv init init2
+
+init2.out: a68sdum.p a68sin.p a68sdec4.h lx1.o lx4.o getaddr.o pcalls.o
+ (echo '#include "a68sdec4.h"';\
+ echo $(TNOS) 84 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 83 300 | $(TAILOR) a68sdum.p $(TERRS);\
+ echo $(TNOS) 181 83 84 300| $(TAILOR) a68sin.p $(TERRS); )\
+ >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ $(PC) $(PCFLAGS) -o init2.out pcalls.o temp.o lx4.o getaddr.o lx1.o
+ rm temp.o
+
+init3: init2 init3.out cmpdum syntax
+ init3.out syntax /dev/null init3lst init2 f1
+ init3.out syntax Makefile init3lst init2 f2
+ cmpdum f1 f2 init >>init3lst
+ rm f1 f2
+ mv init init3
+
+init3.out: a68sdum.p a68spar.p a68sdec2.h lx1.o lx2.o getaddr.o pcalls.o
+ (echo '#include "a68sdec2.h"';\
+ echo $(TNOS) 82 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 82 300 | $(TAILOR) a68sdum.p $(TERRS);\
+ echo $(TNOS) 82 300 | $(TAILOR) a68spar.p $(TERRS); )\
+ >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ $(PC) $(PCFLAGS) -o init3.out pcalls.o temp.o lx2.o getaddr.o lx1.o
+ rm temp.o
+
+init4: init3 init4.out cmpdum
+ init4.out /dev/null /dev/null init4lst init3 f1
+ init4.out /dev/null Makefile init4lst init3 f2
+ cmpdum f1 f2 init >>init4lst
+ rm f1 f2
+ mv init init4
+
+init4.out: a68sdum.p a68ssp.p a68sdec4.h lx1.o lx4.o getaddr.o pcalls.o
+ (echo '#include "a68sdec4.h"';\
+ echo $(TNOS) 84 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 85 300 | $(TAILOR) a68sdum.p $(TERRS);\
+ echo $(TNOS) 85 300 | $(TAILOR) a68ssp.p $(TERRS); )\
+ >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ $(PC) $(PCFLAGS) -o init4.out pcalls.o temp.o lx4.o getaddr.o lx1.o
+ rm temp.o
+
+a68init: a68init$(w)$(p)
+
+a68init$(w)$(p): init4 init5.out cmpdum
+ init5.out /dev/null /dev/null init5lst init4 f1
+ init5.out /dev/null Makefile init5lst init4 f2
+ cmpdum f1 f2 init >>init5lst
+ rm f1 f2
+ mv init a68init$(w)$(p)
+
+init5.out: a68sdum.p a68scod.p a68sdec5.h lx1.o getaddr.o pcalls.o
+ (echo '#include "a68sdec5.h"';\
+ echo $(TNOS) 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 86 300 | $(TAILOR) a68sdum.p $(TERRS);\
+ echo $(TNOS) 86 300 | $(TAILOR) a68scod.p $(TERRS); )\
+ >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ $(PC) $(PCFLAGS) -o init5.out pcalls.o temp.o getaddr.o lx1.o
+ rm temp.[op]
+
+cmpdum: check$(w)$(p) cmpdum.p
+ echo $(TNOS) 300 | $(TAILOR) cmpdum.p $(TERRS) >temp.p
+ $(PC) $(PCFLAGS) -o cmpdum temp.p
+
+a68sdec0.h: check$(w)$(p) a68sdec.p
+ echo $(TNOS) 70 171 172 73 174 175 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS) >a68sdec0.h
+
+a68sdec2.h: check$(w)$(p) a68sdec.p
+ echo $(TNOS) 70 171 72 73 174 175 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS) >a68sdec2.h
+
+a68sdec4.h: check$(w)$(p) a68sdec.p
+ echo $(TNOS) 70 171 172 73 74 75 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS) >a68sdec4.h
+
+a68sdec5.h: check$(w)$(p) a68sdec.p
+ echo $(TNOS) 70 171 172 173 174 75 76 177 78 300\
+ | $(TAILOR) a68sdec.p $(TERRS) >a68sdec5.h
+
+a68sdec6.h: check$(w)$(p) a68sdec.p
+ echo $(TNOS) 70 171 172 73 174 175 76 77 78 300\
+ | $(TAILOR) a68sdec.p $(TERRS) >a68sdec6.h
+
+lx1.o: check$(w)$(p) a68s1lx.p a68sdec.p dec_main.p
+ (echo $(TNOS) 70 71 172 73 174 175 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS);\
+ echo $(TNOS) 81 282 284 285 286 300\
+ | $(TAILOR) a68s1lx.p $(TERRS);\
+ cat dec_main.p ) |\
+ cat >temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ mv temp.o lx1.o
+
+lx1s1.o: check$(w)$(p) a68s1lx.p a68sdec.p dec_main_s1.p
+ (echo $(TNOS) 70 71 172 73 174 175 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS);\
+ echo $(TNOS) 81 282 284 285 286 300\
+ | $(TAILOR) a68s1lx.p $(TERRS);\
+ cat dec_main_s1.p ) |\
+ cat >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o lx1s1.o
+
+lx2.o: check$(w)$(p) a68s1lx.p a68sdec.p
+ (echo $(TNOS) 70 171 72 73 174 175 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS);\
+ echo $(TNOS) 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 281 82 284 285 286 300\
+ | $(TAILOR) a68s1lx.p $(TERRS) )\
+ > temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ mv temp.o lx2.o
+
+lx4.o: check$(w)$(p) a68s1lx.p a68sdec.p
+ (echo $(TNOS) 70 171 172 73 74 75 176 177 178 300\
+ | $(TAILOR) a68sdec.p $(TERRS);\
+ echo $(TNOS) 300 | $(TAILOR) a68sint.p $(TERRS); \
+ echo $(TNOS) 281 282 84 285 286 300\
+ | $(TAILOR) a68s1lx.p $(TERRS) )\
+ > temp.p
+ $(PC) $(PCFLAGS) -c.o temp.p
+ mv temp.o lx4.o
+
+a68s1ce.o: a68s1ce.p a68sdec6.h a68s1int.p
+ (echo '#include "a68sdec6.h"'; \
+ echo $(TNOS) 182 183 184 185 186 87 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 87 300 | $(TAILOR) a68s1ce.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o a68s1ce.o
+
+a68s1cg.o: a68s1cg.p a68sdec6.h a68s1int.p
+ (echo '#include "a68sdec6.h"'; \
+ echo $(TNOS) 182 183 184 185 86 187 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 86 300 | $(TAILOR) a68s1cg.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o a68s1cg.o
+
+a68s1md.o: a68s1md.p a68sdec6.h a68s1int.p
+ (echo '#include "a68sdec6.h"'; \
+ echo $(TNOS) 182 183 84 185 186 187 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 84 300 | $(TAILOR) a68s1md.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o a68s1md.o
+
+a68s1s1.o: a68s1s1.p a68sdec4.h a68s1int.p
+ (echo '#include "a68sdec4.h"'; \
+ echo $(TNOS) 182 183 184 85 186 187 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 85 300 | $(TAILOR) a68s1s1.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -t -c.o temps.p
+ mv temps.o a68s1s1.o
+
+a68s1s2.o: a68s1s2.p a68sdec4.h a68s1int.p
+ (echo '#include "a68sdec4.h"'; \
+ echo $(TNOS) 182 83 184 185 186 187 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 83 300 | $(TAILOR) a68s1s2.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o a68s1s2.o
+
+a68s1pa.o: a68s1pa.p a68sdec2.h a68s1int.p
+ (echo '#include "a68sdec2.h"'; \
+ echo $(TNOS) 82 183 184 185 186 187 300 | $(TAILOR) a68s1int.p $(TERRS); \
+ echo $(TNOS) 82 300 | $(TAILOR) a68s1pa.p $(TERRS) ) >temps.p
+ $(PC) $(PCFLAGS) -c.o temps.p
+ mv temps.o a68s1pa.o
+
+a68s: a68s$(w)$(p)
+
+a68s$(w)$(p): lx1s1.o lx2.o lx4.o a68s1ce.o a68s1cg.o a68s1md.o a68s1s1.o a68s1s2.o a68s1pa.o getaddr.o pcalls.o
+ $(PC) $(PCFLAGS) -o a68s$(w)$(p) pcalls.o lx2.o lx4.o a68s1*.o getaddr.o lx1s1.o
+ rm temps.[pikms]
+
+check$(w)$(p):
+ /bin/make clean
+ echo >> check$(w)$(p)
+
+checkseq:
+ $(CHECKSEQ) $(SFILES) $(S1FILES) syntax
+
+prs:
+ pr $(SFILES)
+
+xrefs:
+ (/bin/make prs; \
+ for II in $(SFILES); do echo 1000 | $(TAILOR) $$II $(TERRS); done \
+ | $(XREF) | pr -h a68init.xref \
+ ) | opr
+
+pr1:
+ pr $(S1FILES)
+
+xref1:
+ (/bin/make pr1; \
+ for II in $(S1FILES); do echo 1000 | $(TAILOR) $$II $(TERRS); done \
+ | $(XREF) | pr -h a68s1.xref \
+ ) | opr
+
+clean:
+ -rm *.[ho] *.out check?? init* cmpdum
+
+
--- /dev/null
+30000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+30010 (*+84() FUNCTION TX(M: MODE): XTYPE; FORWARD; ()+84*)
+30020 (*+86() PROCEDURE STACKSB (SB:PSB); FORWARD; ()+86*)
+30030 (*+86() PROCEDURE UNSTACKSB ; FORWARD; ()+86*)
+30040 (*+87()
+30050 (**)
+30060 (*CODE EMITTER*)
+30070 (**************)
+30080 (**)
+30090 (*+01() (*$T-+) ()+01*)
+30110 (*-05()
+30120 PROCEDURE LOAD (WHERE:SBTTYP; SB:PSB); FORWARD;
+30130 PROCEDURE EMITEND; FORWARD;
+30140 PROCEDURE EMITX1 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT); FORWARD;
+30150 PROCEDURE EMITX2 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT); FORWARD;
+30160 FUNCTION GENLCLGBL (VAR OPCOD:POP; SB:PSB):OFFSETR; FORWARD;
+30170 PROCEDURE FIXUPF(ALABL:LABL);FORWARD;
+30180 FUNCTION FIXUPM: LABL; FORWARD;
+30200 PROCEDURE CLEAR (SB:PSB); FORWARD;
+30210 PROCEDURE UNSTKP1(TYP:OPDTYP; OPND:PSB); FORWARD;
+30220 ()-05*)
+30230 PROCEDURE EMITOP (OPCOD:POP); FORWARD;
+30240 PROCEDURE GENDENOT (OPCOD:POP; SB:PSB); FORWARD;
+30250 PROCEDURE EMITCONST (OPERAND:A68INT); FORWARD;
+30260 FUNCTION GETNEXTLABEL: LABL;
+30270 BEGIN GETNEXTLABEL := NEXTLABEL; NEXTLABEL := NEXTLABEL+1 END;
+30280 (**)
+30290 (**)
+30300 (*+32()
+30310 (*-01() (*-02() PROCEDURE HALT; VAR I,K: INTEGER; BEGIN I:=0;K := K DIV I END; ()-02*) ()-01*)
+30320 PROCEDURE ASERT (ASERTION:BOOLEAN; REASON:ALFA);
+30330 BEGIN
+30340 IF NOT (ASERTION) THEN
+30350 BEGIN
+30360 WRITELN(OUTPUT,' ASSERT FAILED ',REASON);
+30370 (*+01() PUTSEG(OUTPUT); ()+01*)
+30380 EMITEND;
+30390 HALT
+30400 END
+30410 END;
+30420 (**)
+30430 ()+32*)
+30440 (*-24()
+30450 PROCEDURE TAKELINE;
+30460 BEGIN
+30462 (*+23()WRITELN(LSTFILE);()+23*)
+30470 (*+02()WRITELN(LGO); ()+02*)
+30480 (*+23()LSTCNT:=LSTCNT+1;
+30490 IF LSTCNT > LINESPERPAGE THEN CHECKPAGE
+30492 ()+23*)
+30500 END;
+30510 ()-24*)
+30520 (*+23()
+30530 PROCEDURE EMITOP (* (OPCOD:POP) *);
+30540 VAR FLAG,I: INTEGER;
+30550 NAME: ALFA;
+30560 BEGIN
+30570 FLAG := 0;
+30580 NAME := CODETABLE[OPCOD].ROUTINE;
+30590 WHILE NAME = ' ' DO
+30600 BEGIN
+30610 IF OPCOD >= 0 THEN
+30620 BEGIN OPCOD := OPCOD-1; FLAG := FLAG+1 END
+30630 ELSE BEGIN OPCOD := OPCOD+1; FLAG := FLAG-1 END;
+30640 NAME := CODETABLE[OPCOD].ROUTINE
+30650 END;
+30660 IF NUMPARAMS=0 THEN WRITE(LSTFILE,' ':25);
+30670 FOR I:=3 DOWNTO NUMPARAMS+1 DO WRITE(LSTFILE,' ':20);
+30680 WRITE (LSTFILE,NAME);
+30690 IF FLAG >0 THEN WRITELN (LSTFILE,'+',FLAG:2)
+30700 ELSE IF FLAG < 0 THEN WRITELN (LSTFILE,FLAG:3)
+30710 ELSE WRITELN (LSTFILE);
+30720 NUMPARAMS:=0;
+30730 END;
+30740 (**)
+30750 PROCEDURE WRITEOPERAND (TYP:OPDTYP; OPERAND:ADDRINT);
+30760 VAR REC: RECORD CASE SEVERAL OF
+30770 1: (INT: INTEGER);
+30780 2: (LEX: PLEX ) ;
+30790 3,4,5,6,7,8,9,10: () ;
+30800 END;
+30810 BEGIN
+30820 IF NUMPARAMS=1 THEN WRITE(LSTFILE,' ':25);
+30830 CASE TYP OF
+30840 OCVIMMED: WRITE (LSTFILE,' IMMED',OPERAND:10,', ');
+30850 OCVMEM : WRITE (LSTFILE,' MEM',OPERAND:10,', ');
+30860 OCVEXT : BEGIN REC.INT := OPERAND; WRITE(LSTFILE,' EXT ');
+30870 WRITE(LSTFILE,REC.LEX^.S10)
+30880 END;
+30890 OCVFREF : WRITE (LSTFILE,' FREF',OPERAND:10,', ');
+30900 OCVFIM : WRITE (LSTFILE,' FIM',OPERAND:10,', ')
+30910 END
+30920 END;
+30930 (**)
+30940 PROCEDURE UPPER;
+30950 BEGIN WRITELN(LSTFILE,' UPPER.') END;
+30960 PROCEDURE FILL(WHERE:SBTTYP;SB:PSB);
+30970 BEGIN
+30980 WITH SB^ DO
+30990 BEGIN
+31000 IF NOT (WHERE IN [SBTSTKN,SBTDL,SBTXN]) THEN SBLEN:=SZWORD;
+31010 IF WHERE IN [SBTSTK..SBTSTKN] THEN
+31020 BEGIN
+31030 RTSTKDEPTH:=RTSTKDEPTH+SBLEN;
+31040 WITH ROUTNL^ DO
+31050 IF RTSTKDEPTH > RNLENSTK THEN RNLENSTK:=RTSTKDEPTH;
+31060 END;
+31070 SBTYP:=WHERE;
+31080 END;
+31090 END;
+31100 (**)
+31110 FUNCTION SETINLINE(OPCOD:POP):BOOLEAN;
+31120 BEGIN
+31130 SETINLINE:=TRUE;
+31140 END;
+31150 (**)
+31160 FUNCTION NORMAL(SB:PSB) : SBTTYP;
+31170 BEGIN
+31180 WITH SB^ DO WITH SBMODE^.MDV DO
+31190 IF(NOT(SBUNION IN SBINF)) AND (NOT MDPILE) AND (MDLEN=0) THEN
+31200 NORMAL:=SBTVOID
+31210 ELSE
+31220 NORMAL:=SBTSTK;
+31230 END;
+31240 (**)
+31250 PROCEDURE LOADSTK(SB: PSB);
+31260 VAR LEN: INTEGER;
+31270 BEGIN
+31280 WITH SB^ DO WITH SBMODE^.MDV DO
+31290 IF SBUNION IN SBINF THEN LEN:=SZWORD ELSE IF MDPILE THEN LEN:=SZADDR ELSE LEN:=MDLEN;
+31300 IF LEN=0 THEN LOAD(SBTVOID,SB)
+31310 ELSE LOAD(SBTSTK,SB);
+31320 END;
+31330 (**)
+31340 PROCEDURE TWIST;
+31350 VAR TEMPPTR:PSB;
+31360 BEGIN
+31370 WITH RTSTACK^ DO
+31380 BEGIN
+31390 IF (SBTYP >= SBTSTK) AND (SBRTSTK^.SBTYP >= SBTSTK) THEN
+31400 BEGIN TAKELINE; EMITOP(PSWAP); END;
+31410 TEMPPTR:=SBRTSTK;
+31420 SBRTSTK:=TEMPPTR^.SBRTSTK;
+31430 TEMPPTR^.SBRTSTK:=RTSTACK;
+31440 RTSTACK:=TEMPPTR;
+31450 END;
+31460 END;
+31470 (**)
+31480 PROCEDURE LOAD (*+05() (WHERE: SBTTYP; SB: PSB) ()+05*);
+31490 VAR TEMPOP:POP;
+31500 TOFFSET:INTEGER;
+31510 TEMPTYP:SBTTYP;
+31520 TWISTED:BOOLEAN;
+31530 SB1: PSB;
+31540 BEGIN
+31550 WITH SB^ DO
+31560 BEGIN
+31570 IF SBRTSTK <> NIL THEN
+31580 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
+31590 BEGIN
+31600 LOADSTK(SBRTSTK);
+31610 SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY];
+31620 END;
+31630 TWISTED:=FALSE;
+31640 IF (WHERE IN [SBTVOID,SBTSTK..SBTXN]) AND (SBTYP IN [SBTID..SBTRPROC]) THEN
+31650 BEGIN
+31660 SB1 := RTSTACK;
+31670 WHILE (SB1^.SBTYP IN [SBTID..SBTRPROC]) AND (SB1<>SB) DO
+31680 SB1 := SB1^.SBRTSTK;
+31690 IF SB1<>SB THEN
+31700 BEGIN TWISTED:=TRUE; TWIST;
+31710 (*+32() ASERT (RTSTACK =SB,'LOAD-A '); ()+32*)
+31720 END;
+31730 CASE SBTYP OF
+31740 SBTVAR:BEGIN
+31750 TEMPOP:=PLOADVAR;
+31760 TOFFSET:=GENLCLGBL(TEMPOP,SB);
+31770 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET);
+31780 END;
+31790 SBTID,SBTIDV:BEGIN
+31800 TEMPOP:=PPUSH;
+31810 TOFFSET:=GENLCLGBL(TEMPOP,SB);
+31820 EMITX1(TEMPOP,OCVLCLGBL,TOFFSET);
+31830 END;
+31840 SBTLIT:EMITX1(PPUSHIM,OCVIMMED,SBVALUE);
+31850 SBTDEN:GENDENOT(PPUSHIM,SB);
+31860 END; (*OF CASE*)
+31870 END;
+31880 END;
+31890 FILL(WHERE,SB);
+31900 IF TWISTED THEN TWIST;
+31910 END;
+31920 (**)
+31930 PROCEDURE PROC1OP(OPCOD:POP;TYP:OPDTYP;OPND:ADDRINT;NOTINL:BOOLEAN);
+31940 VAR SB:PSB;
+31950 BEGIN
+31960 SB:=ASPTR(OPND);
+31970 IF RTSTACK<>SB THEN TWIST;
+31980 LOADSTK(SB);
+31990 UNSTKP1(TYP,SB);
+32000 END;
+32010 (**)
+32020 PROCEDURE PROC2OP(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;NOTINL:BOOLEAN);
+32030 VAR SB1,SB2:PSB;
+32040 BEGIN
+32050 SB1:=ASPTR(OPND1);
+32060 SB2:=ASPTR(OPND2);
+32070 LOADSTK(SB1);
+32080 LOADSTK(SB2);
+32090 IF SB2<>RTSTACK THEN TWIST;
+32100 UNSTKP1(TYP2,SB2);
+32110 UNSTKP1(TYP1,SB1);
+32120 END;
+32130 (**)
+32140 PROCEDURE PARAM(TYP:OPDTYP;OPND:ADDRINT;OPCOD:POP);
+32150 BEGIN
+32180 IF TYP <> OCVNONE THEN
+32190 BEGIN
+32200 NUMPARAMS:=NUMPARAMS+1;
+32210 WRITEOPERAND(TYP,OPND);
+32220 END;
+32230 END;
+32240 (**)
+32250 (**)
+32260 PROCEDURE FIXUPF (*+05() (ALABL:LABL) ()+05*);
+32270 BEGIN
+32280 TAKELINE;
+32290 WRITELN (LSTFILE,' ':20,ALABL:6,':')
+32300 END;
+32310 (**)
+32320 FUNCTION FIXUPM (*+05(): LABL()+05*);
+32330 VAR L: LABL;
+32340 BEGIN
+32350 TAKELINE;
+32360 L := GETNEXTLABEL;
+32370 FIXUPM := L;
+32380 WRITELN (LSTFILE,' ':20,L:6,':')
+32390 END;
+32400 (**)
+32410 PROCEDURE EMITXWORD (TYP:OPDTYP; OPERAND:A68INT);
+32420 BEGIN
+32430 TAKELINE;
+32440 WRITE(LSTFILE,' ':25);
+32450 WRITEOPERAND (TYP,OPERAND);
+32460 WRITELN (LSTFILE)
+32470 END;
+32480 (**)
+32490 PROCEDURE EMITALF(OPERAND: ALFA);
+32500 VAR I: INTEGER;
+32510 BEGIN
+32520 TAKELINE;
+32530 WRITE(LSTFILE, ' ':25, '''');
+32540 FOR I := 1 TO 10 DO WRITE(LSTFILE, OPERAND[I]);
+32550 WRITELN(LSTFILE, '''');
+32560 END;
+32570 (**)
+32580 PROCEDURE FIXUPFIM (ALABL:LABL; VALUE:A68INT);
+32590 BEGIN
+32600 TAKELINE;
+32610 WRITELN (LSTFILE,' ':20,ALABL:6,': EQU ',VALUE:8)
+32620 END;
+32630 (**)
+32640 PROCEDURE FIXLABL (OLDLABL, NEWLABL: LABL; KNOWN: BOOLEAN);
+32650 BEGIN
+32660 TAKELINE;
+32670 WRITELN (LSTFILE,' ':20,OLDLABL:6, ' EQU ', NEWLABL:8,':')
+32680 END;
+32690 (**)
+32700 ()+23*)
+32710 (* EM-1 CODE EMITTER *)
+32720 (*********************)
+32730 (*+02()
+32740 PROCEDURE PARAM(TYP:OPDTYP; OPND:ADDRINT; OPCOD: POP); FORWARD;
+32750 (*-24()
+32760 PROCEDURE WRITEBYTE(B:INTEGER); BEGIN WRITE(LGO,B:5) END;
+32770 PROCEDURE WRITEINSTN(INST:COMPACT);
+32775 VAR COUNT:INTEGER;
+32780 BEGIN IF INST=EOOPNDS THEN TAKELINE
+32782 ELSE BEGIN
+32783 WRITE(LGO,' ');
+32784 FOR COUNT:=1 TO 3 DO
+32785 BEGIN
+32787 WRITE(LGO,CHR(ORD(INST[COUNT])+32)); (*TRANSLATE TO LOWER CASE*)
+32788 END;
+32789 END;
+32790 END;
+32792 PROCEDURE WRITECON(COMMON, SIZE: INTEGER; OPERAND: ADDRINT);
+32793 BEGIN WRITE(LGO,' ',OPERAND);
+32794 IF SIZE<>SZWORD THEN
+32796 WRITE(LGO, 'I', SIZE:1);
+32799 END;
+32800 PROCEDURE WRITELABEL(GLOBAL:BOOLEAN;OPERAND:INTEGER);
+32810 BEGIN
+32821 IF GLOBAL THEN WRITE(LGO,'.'); WRITE(LGO,OPERAND:0); TAKELINE; END;
+32841 PROCEDURE WRITEOFFSET(L:LABL;OFFSET:INTEGER);
+32842 BEGIN WRITE(LGO,' .',L:0);
+32843 IF OFFSET<>0 THEN
+32844 BEGIN IF OFFSET>0 THEN WRITE(LGO,'+');
+32845 WRITE(LGO,OFFSET:0);
+32846 END;
+32848 END;
+32850 ()-24*)
+32860 (*+24()
+32870 PROCEDURE WRITEBYTE(B:BYTE);
+32880 (*PROCEDURE TO WRITE A BYTE OF COMPACT ASSEMBLER CODE *)
+32890 BEGIN
+32900 WRITE(LGO,B);
+32910 END;
+32920 (**)
+32930 PROCEDURE WRITEINSTN(INST:COMPACT);
+32940 BEGIN WRITE(LGO,INST) END;
+32950 (**)
+32960 PROCEDURE WRITECON(COMMON,SIZE:INTEGER;OPERAND:ADDRINT);
+32970 (* WRITES A POSITIVE INTEGER IN BASE 256,OR AS AN OFFSET FROM 120 *)
+32980 VAR I,COUNT,T:INTEGER;
+32982 OUTSTR:PACKED ARRAY[1..10] OF CHAR;
+32990 BEGIN
+33000 IF (OPERAND < 120) AND (OPERAND >= -120) AND (COMMON=CPACTCONS) AND (SIZE=SZWORD) THEN
+33010 WRITEBYTE(OPERAND+120)
+33020 ELSE
+33030 BEGIN
+33040 COUNT := 1;
+33050 CASE COMMON OF
+33060 CPACTLCL:BEGIN
+33070 (*+32() ASERT(OPERAND<65536,'WRITECON-A'); ()+32*)
+33075 COUNT := 2;
+33080 END;
+33090 CPACTGBL:BEGIN
+33100 (*+32() ASERT(OPERAND < 32768 ,'WRITECON-B'); ()+32*)
+33110 IF OPERAND > 255 THEN BEGIN COMMON := COMMON+1; COUNT := 2 END
+33120 END;
+33130 CPACTCONS:BEGIN
+33140 COUNT := 2;
+33170 IF OPERAND > 32767 THEN BEGIN COMMON := COMMON+1; COUNT := 4 END;
+33180 END;
+33191 END;
+33193 IF SIZE<>SZWORD THEN
+33194 BEGIN
+33195 T := 1;
+33196 REPEAT
+33197 OUTSTR[T] := CHR((OPERAND MOD 10)+ORD('0'));
+33198 OPERAND := OPERAND DIV 10; T := T+1;
+33199 UNTIL OPERAND=0;
+33200 WRITEBYTE(CPACTUNS);
+33201 WRITECON(CPACTCONS,SZWORD,SIZE);
+33202 T := T-1;
+33203 WRITEBYTE(120+T);
+33204 FOR I := T DOWNTO 1 DO
+33208 WRITEBYTE(ORD(OUTSTR[I]))
+33209 END
+33212 ELSE
+33213 BEGIN
+33214 WRITEBYTE(COMMON);
+33220 FOR I := 1 TO COUNT DO
+33230 BEGIN
+33232 T := OPERAND MOD 256;
+33244 WRITEBYTE(T);
+33250 OPERAND := (OPERAND-T) DIV 256;
+33260 END;
+33265 END;
+33270 END;
+33280 END;
+33290 (**)
+33300 PROCEDURE WRITELABEL(GLOBAL:BOOLEAN;OPERAND:INTEGER);
+33310 BEGIN
+33320 IF GLOBAL THEN WRITECON(CPACTGBL, SZWORD, OPERAND) ELSE WRITECON(CPACTLCL, SZWORD, OPERAND);
+33330 END;
+33340 (**)
+33350 (**)
+33401 PROCEDURE WRITEOFFSET(L:LABL;OFFSET:INTEGER);
+33402 BEGIN
+33403 IF OFFSET<>0 THEN WRITEBYTE(CPACTLBL);
+33404 WRITECON(CPACTGBL,SZWORD,L);
+33407 IF OFFSET <>0 THEN WRITECON(CPACTCONS,SZWORD,OFFSET);
+33408 END;
+33409 (**)
+33410 ()+24*)
+33411 PROCEDURE SETTEXTSTATE;
+33412 BEGIN
+33413 IF DATASTATE=INDATA THEN WRITEINSTN(EOOPNDS);
+33414 DATASTATE := ENDDATA
+33415 END;
+33416 (**)
+33420 PROCEDURE EMITXWORD(TYP:OPDTYP;OPERAND:ADDRINT);
+33430 VAR REC: RECORD CASE SEVERAL OF
+33440 1: (INT:ADDRINT);
+33450 2: (LEX:PLEX);
+33455 3,4,5,6,7,8,9,10: ();
+33460 END;
+33470 I,K,STRLEN,HI:INTEGER;
+33471 (*-24()J:CHAR;()-24*)
+33480 BEGIN
+33482 (* IN THE -24 MACHINE 'CON <DATA>' IS PRODUCED ON EACH LINE *)
+33483 (* IN THE +24 MACHINE 'CON <DATA> <DATA> <DATA> ...' IS PRODUCED *)
+33485 IF (DATASTATE=STARTDATA) (*-24() OR (DATASTATE=INDATA) ()-24*) THEN
+33486 BEGIN
+33487 WRITEINSTN(CON);DATASTATE:=INDATA;
+33488 END;
+33490 CASE TYP OF
+33500 OCVIMMED: WRITECON(CPACTCONS, SZWORD, OPERAND);
+33502 OCVIMMLONG: WRITECON(CPACTCONS, SZLONG, OPERAND);
+33504 OCVIMMPTR: WRITECON(CPACTCONS, SZADDR, OPERAND);
+33510 (*+24()OCVFREF: WRITELABEL(FALSE,OPERAND);
+33520 OCVMEM,OCVFIM: WRITELABEL(TRUE,OPERAND); ()+24*)
+33530 (*-24()OCVFREF: BEGIN
+33532 WRITE(LGO,' *',OPERAND:0);
+33533 END;
+33540 OCVMEM,OCVFIM: BEGIN
+33542 WRITE(LGO,' .',OPERAND:0);
+33543 END; ()-24*)
+33550 OCVEXT: BEGIN
+33560 REC.INT := OPERAND;
+33562 STRLEN:=REC.LEX^.LXCOUNT*SZWORD;
+33563 HI := 1;
+33564 WHILE (HI<=RTNLENGTH) AND (REC.LEX^.S10[HI]<>' ') DO HI := HI+1;
+33566 HI := HI-1;
+33570 (*+24() WRITEBYTE(CPACTPNAM);
+33575 WRITECON(CPACTCONS,SZWORD,HI);
+33591 FOR I := 1 TO HI DO
+33600 WRITEBYTE(ORD(REC.LEX^.S10[I]));
+33604 ()+24*)
+33610 (*-24() WRITE(LGO,' $');
+33611 FOR I:=1 TO HI DO
+33612 BEGIN
+33613 J:=REC.LEX^.S10[I];
+33616 WRITE(LGO,J);
+33617 END;
+33619 IF HI<RTNLENGTH THEN
+33620 FOR K:=I+1 TO RTNLENGTH DO
+33624 WRITE(LGO,' ');
+33626 ()-24*)
+33628 END
+33630 END;
+33632 (*-24()IF DATASTATE=INDATA THEN WRITEINSTN(EOOPNDS); ()-24*)
+33640 END;
+33650 (**)
+33652 PROCEDURE EMITXPROC (TYP:OPDTYP;OPERAND:ADDRINT);
+33654 VAR
+33656 TEMP :PLEX;
+33658 DIGIT,INDEX :INTEGER;
+33660 ADDRESS :LABL;
+33662 BEGIN
+33664 ENEW (TEMP, LEX1SIZE+ (9*CHARPERWORD) DIV CHARPERWORD * SZWORD);
+33666 WITH TEMP^ DO
+33668 BEGIN
+33670 S10:=' ';
+33672 S10[1]:='R';
+33674 DIGIT:=OPERAND;
+33676 INDEX:=1;
+33678 WHILE DIGIT>0 DO BEGIN DIGIT:=DIGIT DIV 10; INDEX:=INDEX+1; END;
+33680 DIGIT:=OPERAND;
+33682 WHILE DIGIT>0 DO
+33684 BEGIN
+33686 S10[INDEX]:= CHR ((DIGIT MOD 10) + ORD('0')); (*ONLY WORKS FOR NUMBERS THEN RUN CONTIGUOUSLY*)
+33688 DIGIT:=DIGIT DIV 10; INDEX := INDEX-1;
+33690 END;
+33691 LXCOUNT:= (9*CHARPERWORD) DIV CHARPERWORD * SZWORD;
+33692 END;
+33693 EMITXWORD(OCVEXT,ORD(TEMP));
+33694 EDISPOSE(TEMP, LEX1SIZE+ (9*CHARPERWORD) DIV CHARPERWORD * SZWORD);
+33695 END;
+33696 PROCEDURE EMITALF(ALF: BIGALFA);
+33697 VAR I,L: INTEGER;
+33702 BEGIN
+33703 (*+24() IF DATASTATE=STARTDATA THEN WRITEINSTN(CON);
+33704 WRITEBYTE(CPACTSTRING);
+33706 WRITECON(CPACTCONS,SZWORD,10); FOR I := 1 TO 10 DO WRITEBYTE(ORD(ALF.ALF[I]));
+33707 WRITECON(CPACTCONS,1,ALF.IDSIZE); WRITECON(CPACTCONS,1,ALF.XMODE); ()+24*)
+33708 (*-24() WRITEINSTN(CON);
+33709 WRITE(LGO, ' '''); FOR I := 1 TO 8 DO WRITE(LGO, ALF.ALF[I]);
+33710 WRITE(LGO,''',',ALF.IDSIZE:1,'U1,',ALF.XMODE:1,'U1'); WRITEINSTN(EOOPNDS); ()-24*)
+33711 DATASTATE:=INDATA;
+33712 END;
+33713 (**)
+33714 PROCEDURE EMITRNTAIL (LEN :INTEGER);
+33715 BEGIN
+33716 SETTEXTSTATE;
+33717 WRITEINSTN(EEND);EMITXWORD(OCVIMMED,LEN);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
+33718 END;
+33719 (**)
+33720 FUNCTION STKSPACE (INSTR:COMPACT;PARAM:INTEGER) :INTEGER;
+33722 (*FUNCTION CALCULATES HOW MANY WORDS WILL BE PUT ON THE STACK*)
+33723 (*BY THE INSTRUCTION INSTR*)
+33730 BEGIN
+33731 (*+32() ASERT(INSTR<>LOS,'STKSPACE-A'); ()+32*)
+33735 IF (INSTR=LFR)OR(INSTR=LOI)OR(INSTR=DUP) THEN STKSPACE:=PARAM
+33737 ELSE IF (INSTR=LDC)OR(INSTR=LDL)OR(INSTR=LDE)OR(INSTR=LDF) THEN STKSPACE:=SZWORD+SZWORD
+33738 ELSE IF (INSTR=ADP)OR(INSTR=LAL)OR(INSTR=LAE)OR(INSTR=LXL)OR(INSTR=LXA)OR(INSTR=LOR) THEN STKSPACE:=SZADDR
+33739 ELSE STKSPACE:=SZWORD;
+33740 END;
+33743 (**)
+33744 (**)
+33745 PROCEDURE EMITOP (* (OPCOD:POP) *);
+33747 CONST MAXLABL = 2; (* MAXIMUM NUMBER OF OVERLAPPING LABELS *)
+33748 (*-24() NOP='NOP'; ()-24*)
+33750 VAR I,TEMPCNT,STRWLEN:INTEGER; TEMPLABL:LABL; TEMP:PLEX;
+33760 COUNT : ARRAY [1..MAXLABL] OF INTEGER;
+33765 JUMPOVER : ARRAY [1..MAXLABL] OF LABL;
+33770 PARAMNOTUSED: BOOLEAN;
+33772 SAVOPRAND: ADDRINT;
+33780 BEGIN
+33790 SETTEXTSTATE;
+33810 PARAMNOTUSED := TRUE;
+33811 FOR I:=1 TO MAXLABL DO COUNT[I]:=0;
+33812 IF OCV=OCVLCLGBL THEN
+33813 BEGIN
+33814 IF LCLGBL<>0 THEN
+33815 BEGIN CLEAR(RTSTACK); (*IN CASE ANYTHING IN PRR*)
+33816 SAVOPRAND := OPRAND;
+33817 EMITX1(PENVCHAIN+ORD(OPRAND>0),OCVIMMED,LCLGBL);
+33818 OPRAND := SAVOPRAND;
+33819 END;
+33820 OCV := OCVIMMED;
+33821 PARAMNOTUSED := FALSE; (*SPECIAL FIDDLE FOR PLOADRTA AND PCALLA*)
+33822 END;
+33824 WHILE OPCOD <> 0 DO WITH CODETABLE[OPCOD] DO
+33830 BEGIN
+33835 (*+21()WRITELN(OUTPUT,'EMITTING P-OP',OPCOD,' ADJUSTSP=',ADJUSTSP);()+21*)
+33840 IF INLINE THEN
+33850 BEGIN
+33860 IF EMCOD<>NOP THEN WRITEINSTN(EMCOD);
+33870 CASE PARTYP OF
+33880 ACP,ANP,WOP,WNP : (* OPERAND SUPPLIED BY,AND NEGATION DONE BY,CODETABLE*)
+33890 WRITECON(CPACTCONS, SZWORD, PARM);
+33892 WLB,ACB : (*OPERAND SUPPLIED BY CODETABLE, GLOBAL LABEL OFFSET*)
+33894 WRITEOFFSET(HOLTOP,PARM);
+33900 OPX,ACX : (* OPERAND IS SUPPLIED BY CODE GENERATOR *)
+33910 BEGIN IF OCV<=OCVIMMPTR THEN WRITECON(CPACTCONS, SZWORD, OPRAND+PARM)
+33912 ELSE EMITXWORD(OCV, OPRAND+PARM); PARAMNOTUSED := FALSE END;
+33920 ONX,ANX : (* NEGATIVE OF OPERAND SUPPLIED BY CODE GENERATOR *)
+33930 BEGIN IF OCV<=OCVIMMPTR THEN WRITECON(CPACTCONS, SZWORD, -(OPRAND+PARM))
+33932 ELSE EMITXWORD(OCV, -(OPRAND+PARM)); PARAMNOTUSED := FALSE END;
+33933 OPL,ACL : (*OPERAND (SUPPLIED BY CODE GEN) IS A GLOBAL LABEL OFFSET*)
+33934 BEGIN WRITEOFFSET(HOLTOP,OPRAND+PARM); PARAMNOTUSED:=FALSE; END;
+33937 ONL,ANL : (*AS ABOVE BUT NEGATE OPERAND FIRST*)
+33939 BEGIN WRITEOFFSET(HOLTOP,-(OPRAND+PARM));PARAMNOTUSED:=FALSE; END;
+33940 JMP : (* P-OP GENERATES ITS OWN LABELS FOR LOOPS ETC. *)
+33950 BEGIN
+33960 TEMPCNT := PARM;
+33970 TEMPLABL := GETNEXTLABEL;
+33980 EMITXWORD(OCVFREF,TEMPLABL);
+33990 IF TEMPCNT < 0 THEN (* A BACKWARD JUMP IS REQUIRED,USE THE EXC COMMAND *)
+34000 BEGIN
+34005 WRITELABEL(FALSE,TEMPLABL);
+34007 WRITEINSTN(EXC); WRITECON(CPACTCONS, SZWORD, -TEMPCNT);
+34010 WRITECON(CPACTCONS, SZWORD, 1); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+34015 END
+34017 ELSE
+34018 BEGIN (*FORWARD JUMP SO STORE IN ARRAYS*)
+34020 I:=0;
+34022 REPEAT I:=I+1; (*+32()ASERT(I<=MAXLABL,'EMITOP-A ');()+32*) UNTIL COUNT[I] = 0;
+34024 COUNT[I]:=TEMPCNT; JUMPOVER[I]:=TEMPLABL;
+34026 END;
+34028 END;
+34030 NON : ;
+34040 GBX : (* GLOBAL LABEL EXPECTED *)
+34050 BEGIN
+34055 WRITEOFFSET(OPRAND, PARM);
+34056 PARAMNOTUSED:=FALSE; END;
+34060 LCX : (* INSTRUCTION LABEL EXPECTED *)
+34070 (*+24() BEGIN WRITELABEL(FALSE,OPRAND); PARAMNOTUSED := FALSE END; ()+24*)
+34072 (*-24() BEGIN WRITE(LGO,' *',OPRAND:0);
+34073 PARAMNOTUSED:=FALSE; END; ()-24*)
+34074 MOR : (* LONG (2-BYTE) OPERAND SUPPLIED BY CODETABLE *)
+34076 EMITXWORD(OCVIMMED,PARM);
+34080 END; (* OF CASE *)
+34085 (*-24() TAKELINE; ()-24*)
+34087 IF PARTYP>= ACP THEN
+34090 BEGIN
+34092 CASE PARTYP OF
+34093 ANP,ACP: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,PARM(*-24()-120()-24*));
+34094 ACX: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,OPRAND+PARM);
+34095 ANX: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,-(OPRAND+PARM));
+34096 ACB,ACL,ANL: ADJUSTSP:=ADJUSTSP+STKSPACE(EMCOD,0);
+34097 END;
+34099 END;
+34100 OPCOD := NEXT;
+34110 END
+34120 ELSE
+34130 BEGIN
+34140 IF PARAMNOTUSED THEN PARAM(OCVNONE, 0, OPCOD);
+34190 WRITEINSTN(LXL); WRITECON(CPACTCONS, SZWORD, 0); (*-24() TAKELINE; ()-24*) (*STATIC LINK*)
+34200 WRITEINSTN(CAL);
+34205 STRWLEN:=(RTNLENGTH+CHARPERWORD) DIV CHARPERWORD *SZWORD;
+34210 ENEW(TEMP,LEX1SIZE+STRWLEN);
+34220 WITH TEMP^ DO
+34230 BEGIN
+34240 FOR I:=1 TO RTNLENGTH DO S10[I]:=ROUTINE[I];
+34250 LXCOUNT:=STRWLEN;
+34260 END;
+34262 EMITXWORD(OCVEXT,ORD(TEMP));
+34264 EDISPOSE(TEMP,LEX1SIZE+STRWLEN);
+34266 (*-24() TAKELINE ; ()-24*)
+34270 OPCOD := 0;
+34280 WRITEINSTN(ASP); WRITECON(CPACTCONS, SZWORD, ADJUSTSP+SZADDR);
+34300 (*-24() TAKELINE ; ()-24*)
+34310 END;
+34312 FOR I:=1 TO MAXLABL DO
+34320 IF COUNT[I] > 0 THEN (* ONE OF P-OPS REQUIRES A LABEL *)
+34322 BEGIN
+34330 IF COUNT[I] = 1 THEN WRITELABEL(FALSE,JUMPOVER[I]) ;
+34340 COUNT[I] := COUNT[I]-1;
+34342 END;
+34350 END;
+34360 END;
+34370 (**)
+34380 PROCEDURE FIXUPF (* (ALABL:LABL) *);
+34390 BEGIN
+34392 IF DATASTATE <> ENDDATA THEN BEGIN
+34394 (*+24() IF DATASTATE=INDATA THEN BEGIN DATASTATE:=STARTDATA; WRITEINSTN(EOOPNDS) END; ()+24*)
+34396 WRITELABEL(TRUE,ALABL); END
+34398 ELSE
+34400 WRITELABEL(FALSE,ALABL);
+34410 END;
+34420 (**)
+34430 FUNCTION FIXUPM (* :LABL *);
+34440 VAR L:LABL;
+34450 BEGIN
+34455 L := GETNEXTLABEL;
+34456 FIXUPM := L;
+34460 IF DATASTATE <> ENDDATA THEN (*GLOBAL DATA*)
+34470 BEGIN
+34480 (*+24() IF DATASTATE=INDATA THEN BEGIN DATASTATE:=STARTDATA; WRITEINSTN(EOOPNDS) END; ()+24*)
+34500 WRITELABEL(TRUE,L);
+34510 END
+34520 ELSE
+34530 BEGIN
+34560 WRITELABEL(FALSE,L);
+34570 END;
+34580 END;
+34590 (**)
+34600 PROCEDURE FIXUPFIM(ALABL:LABL;VALUE:A68INT);
+34610 BEGIN
+34620 WRITELABEL(TRUE,ALABL); WRITEINSTN(CON);
+34630 WRITECON(245, SZWORD, VALUE);
+34640 WRITEINSTN(EOOPNDS);
+34650 END;
+34660 (**)
+34670 PROCEDURE FIXLABL(OLDLABL,NEWLABL:LABL; KNOWN:BOOLEAN);
+34680 VAR JUMPOVER: LABL;
+34690 BEGIN
+34700 JUMPOVER := GETNEXTLABEL;
+34710 WRITEINSTN(BRA); (*+24() WRITELABEL(FALSE,JUMPOVER); ()+24*)
+34712 (*-24()WRITE(LGO,' *',JUMPOVER:0); TAKELINE; ()-24*)
+34720 WRITELABEL(FALSE,OLDLABL);
+34730 WRITEINSTN(BRA); (*+24() WRITELABEL(FALSE,NEWLABL); ()+24*)
+34732 (*-24()WRITE(LGO,' *',NEWLABL:0); TAKELINE; ()-24*)
+34740 WRITELABEL(FALSE,JUMPOVER);
+34750 (*-24() TAKELINE; ()-24*)
+34760 END;
+34770 (**)
+34780 FUNCTION NORMAL(SB: PSB): SBTTYP;
+34790 (*RETURNS THE SBTTYP IN WHICH VALUES OF MODE SB^.SBMODE SHOULD BE STORED DURING BALANCES*)
+34800 BEGIN WITH SB^ DO WITH SBMODE^.MDV DO
+34810 IF SBTYP=SBTDL THEN NORMAL := SBTDL
+34820 ELSE IF SBUNION IN SBINF THEN NORMAL := SBTSTKN
+34825 ELSE IF SBNAKED IN SBINF THEN NORMAL := SBTSTK4
+34830 ELSE IF MDPILE THEN NORMAL := SBTSTK(*+19()2()+19*)
+34840 ELSE CASE MDLEN OF
+34850 0: NORMAL := SBTVOID;
+34860 SZWORD: NORMAL := SBTSTK;
+34870 (*+19() SZADDR: NORMAL := SBTSTK2; ()+19*)
+34880 SZREAL: NORMAL := SBTSTK4;
+34890 END;
+34900 END;
+34910 (**)
+34920 FUNCTION LENOF(SB: PSB): INTEGER;
+34930 BEGIN
+34940 WITH SB^,SBMODE^.MDV DO
+34950 IF (SBUNION IN SBINF) OR (SBTYP=SBTDL) THEN LENOF := SBLEN
+34952 ELSE IF SBNAKED IN SBINF THEN LENOF := SZNAKED
+34954 ELSE IF MDPILE THEN LENOF := SZADDR
+34956 ELSE LENOF := MDLEN;
+34960 END;
+34970 (**)
+34980 PROCEDURE LOADSTK(SB: PSB);
+34990 BEGIN
+34995 IF NOT(SB^.SBTYP IN [SBTSTKN,SBTDL]) THEN
+35000 CASE LENOF(SB) OF
+35010 0: LOAD(SBTVOID, SB);
+35020 SZINT: LOAD(SBTSTK, SB);
+35030 (*+19() SZADDR: LOAD(SBTSTK2, SB);
+35032 6: LOAD(SBTSTK2A, SB); ()+19*)
+35040 SZREAL: LOAD(SBTSTK4, SB);
+35050 END;
+35060 END;
+35070 (**)
+35080 PROCEDURE TWIST;
+35090 VAR TEMPPTR : PSB;
+35095 L1, L2, SAVE: INTEGER;
+35100 BEGIN
+35110 WITH RTSTACK^ DO BEGIN
+35120 IF (SBRTSTK^.SBTYP IN [SBTSTK..SBTDL]) AND (SBTYP IN [SBTSTK..SBTPRR]) THEN
+35121 BEGIN
+35122 IF SBTYP=SBTPRR THEN LOADSTK(RTSTACK);
+35123 SAVE := ADJUSTSP;
+35124 L1:=LENOF(RTSTACK);L2:=LENOF(SBRTSTK);
+35126 IF L1=L2 THEN
+35128 CASE L1 OF
+35130 SZWORD: EMITOP(PSWAP);
+35132 (*+19() SZADDR: EMITOP(PSWAP+1); ()+19*)
+35134 SZREAL: EMITOP(PSWAP+2);
+35136 END
+35138 ELSE (*STACK OBJECTS TO BE SWAPPED ARE NOT THE SAME SIZE*)
+35140 EMITX2(PSWAP+3,OCVIMMED,L1,OCVIMMED,L2);
+35141 ADJUSTSP := SAVE;
+35142 END;
+35144 TEMPPTR := SBRTSTK;
+35150 SBRTSTK := TEMPPTR^.SBRTSTK;
+35160 TEMPPTR^.SBRTSTK := RTSTACK;
+35170 RTSTACK := TEMPPTR;
+35180 END
+35190 END;
+35200 (**)
+35210 PROCEDURE PROC1OP(OPCOD:POP;TYP:OPDTYP;OPND:ADDRINT;NOTINL:BOOLEAN);
+35220 VAR SB:PSB;
+35230 BEGIN
+35240 SB:=ASPTR(OPND);
+35250 IF RTSTACK<>SB THEN TWIST;
+35255 IF NOTINL THEN CLEAR (RTSTACK^.SBRTSTK);
+35260 LOAD(CODETABLE[OPCOD].P1,SB);
+35270 UNSTKP1(TYP,SB);
+35280 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+35290 END;
+35300 (**)
+35310 PROCEDURE PROC2OP(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;NOTINL:BOOLEAN);
+35320 VAR SB1,SB2:PSB;
+35330 BEGIN
+35340 SB1:=ASPTR(OPND1);
+35350 SB2:=ASPTR(OPND2);
+35360 IF RTSTACK<>SB2 THEN TWIST;
+35365 IF NOTINL THEN CLEAR (RTSTACK^.SBRTSTK^.SBRTSTK);
+35370 WITH CODETABLE[OPCOD] DO
+35380 BEGIN
+35390 IF NOT (SB2^.SBTYP IN [SBTSTK..SBTSTKN,SBTVAR]) THEN
+35400 BEGIN LOAD(P1,SB1); LOAD(P2,SB2) END
+35410 ELSE BEGIN LOAD(P2,SB2); LOAD(P1,SB1); LOAD(P2,SB2) END;
+35420 END;
+35430 UNSTKP1(TYP2,SB2);
+35440 UNSTKP1(TYP1,SB1);
+35450 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+35460 END;
+35470 (**)
+35480 PROCEDURE FILL (WHERE:SBTTYP; SB:PSB);
+35490 BEGIN
+35500 WITH SB^ DO
+35510 BEGIN
+35515 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH:=RTSTKDEPTH-SBLEN;
+35520 IF NOT(WHERE IN [SBTSTKN,SBTDL,SBTPRR,SBTXN]) THEN SBLEN := LENARRAY[WHERE];
+35522 (*ELSE IF WHERE=SBTPRR THEN IT GET IT WRONG - SEE FIX IN SUBSTLEN*)
+35530 IF WHERE IN [SBTSTK..SBTDL] THEN
+35540 BEGIN
+35550 RTSTKDEPTH := RTSTKDEPTH+SBLEN;
+35560 WITH ROUTNL^ DO
+35570 IF RTSTKDEPTH>RNLENSTK THEN RNLENSTK:=RTSTKDEPTH
+35580 END;
+35590 SBTYP:=WHERE;
+35600 END
+35610 END;
+35620 (**)
+35630 FUNCTION SETINLINE (OPCOD:POP):BOOLEAN;
+35640 VAR INL:BOOLEAN;
+35650 BEGIN
+35660 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+35670 REPEAT WITH CODETABLE[OPCOD] DO
+35680 BEGIN
+35690 INL := INLINE;
+35700 OPCOD := NEXT
+35710 END
+35720 UNTIL NOT(INL) OR (OPCOD=0);
+35730 SETINLINE := INL
+35740 END;
+35750 (**)
+35760 (**)
+35770 PROCEDURE LOAD (* (WHERE:SBTTYP; SB:PSB) *);
+35780 (*EMITS CODE TO MOVE SB TO WHERE: CALLS FILL TO RECORD THE MOVE*)
+35790 VAR TEMPOP: POP;
+35800 TOFFSET: OFFSETR;
+35810 TEMPTYP: SBTTYP;
+35812 OCVFIX: OPDTYP;
+35820 TWISTED: BOOLEAN;
+35830 SB1 :PSB;
+35840 SAVE:INTEGER;
+35850 BEGIN
+35855 (*+21() WRITELN(OUTPUT,'LOAD ',ORD(SB),ORD(SB^.SBTYP):3,' TO ',ORD(WHERE):3, SB=RTSTACK); ()+21*)
+35860 WITH SB^ DO
+35870 BEGIN
+35880 (*IF (SB=RTSTACK) AND (SBRTSTK<>NIL) THEN
+35890 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
+35900 BEGIN LOADSTK(SBRTSTK); SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY] END; *)
+35902 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK);
+35910 TWISTED := FALSE;
+35930 IF WHERE IN [SBTSTKN,SBTPR1,SBTPR2] THEN
+35940 LOADSTK(SB)
+35950 ELSE IF WHERE=SBTXN THEN LOAD(NORMAL(SB),SB)
+35960 ELSE
+35970 IF (WHERE<>SBTVOID) AND (WHERE<>SBTYP) THEN
+35980 BEGIN
+35990 SB1 := RTSTACK;
+36000 WHILE (SB1^.SBTYP IN [SBTID..SBTRPROC]) AND (SB1<>SB) DO
+36010 SB1 := SB1^.SBRTSTK;
+36020 IF SB1<>SB THEN
+36030 BEGIN TWISTED:=TRUE; TWIST;
+36032 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK);
+36040 (*+32() ASERT (RTSTACK =SB,'LOAD-B '); ()+32*)
+36050 END;
+36080 IF WHERE IN [SBTPR1..SBTPRR] THEN TEMPOP := POPARRAY[NORMAL(SB),SBTYP]
+36090 ELSE TEMPOP := POPARRAY[WHERE,SBTYP];
+36100 (*+32() ASERT(TEMPOP<>PNONE,'LOAD-C '); ()+32*)
+36110 IF TEMPOP<>PNOOP THEN
+36120 CASE SBTYP OF
+36130 SBTPROC,SBTRPROC,SBTVAR: BEGIN
+36140 SAVE := ADJUSTSP;
+36150 IF WHERE <> SBTPRR THEN BEGIN LOAD(SBTPRR,SB); LOAD(WHERE,SB) END
+36160 ELSE BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);
+36162 IF SBTYP=SBTVAR THEN
+36170 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET)
+36172 ELSE BEGIN (*SBTYP=SBTPROC OR SBTRPROC*)
+36174 IF SBTYP=SBTPROC THEN OCVFIX := OCVMEM
+36176 ELSE (* SBTRPROC *) OCVFIX := OCVFREF;
+36177 EMITX2(TEMPOP,OCVFIX,SBXPTR,OCVLCLGBL,-SZADDR(*ANYTHING -VE*));
+36178 END;
+36179 END;
+36180 ADJUSTSP := SAVE;
+36190 END;
+36200 (**)
+36210 SBTID,SBTIDV: BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);EMITX1(TEMPOP,OCVLCLGBL,TOFFSET) END;
+36220 SBTLIT: EMITX1(TEMPOP, OCVIMMED, SBVALUE);
+36230 SBTDEN: GENDENOT(TEMPOP,SB);
+36240 SBTPR1,SBTPR2,SBTPRR,
+36250 SBTSTK,SBTSTK2,SBTDL,SBTSTK4: EMITOP(TEMPOP);
+36260 END;
+36270 FILL(WHERE,SB);
+36280 END;
+36290 IF TWISTED THEN TWIST;
+36300 END;
+36310 END;
+36320 (**)
+36330 PROCEDURE PARAM (*(TYP:OPDTYP; OPND:ADDRINT; OPCOD: POP)*);
+36340 VAR TEMPOP:POP;
+36350 OPERANDUSED, INL: BOOLEAN;
+36360 BEGIN
+36370 IF OCV<>OCVNONE THEN
+36380 BEGIN
+36390 TEMPOP := PPUSHIM;
+36392 (*+19()IF OCV = OCVIMMLONG THEN TEMPOP:=TEMPOP+2 ELSE
+36395 IF OCV = OCVIMMPTR THEN TEMPOP:=TEMPOP+2 ELSE ()+19*)
+36400 IF OCV IN [OCVMEM,OCVFIM,OCVFREF] THEN TEMPOP:=TEMPOP+1; (*NOT FOR OCVFIM*)
+36410 EMITOP(TEMPOP);ADJUSTSP:=ADJUSTSP+STKSPACE(CODETABLE[TEMPOP].EMCOD,0)
+36420 END;
+36450 IF TYP<>OCVNONE THEN
+36460 BEGIN OPRAND:=OPND; OCV := TYP END;
+36470 END;
+36480 (**)
+36490 ()+02*)
+36500 (**)
+36510 (*+01() (*+31() (*$T+ +) ()+31+) ()+01*)
+36530 (**)
+36540 (**)
+36550 (* CYBER CODE EMITTER *)
+36560 (**********************)
+36570 (*-23()
+36580 (*+01()
+36590 PROCEDURE PUTLINK(OPCOD: POP);
+36600 (*EMITS LINK TABLE FOR LINKINS CHAIN OF OPCOD*)
+36610 VAR TABLEWORD: PACKED RECORD CASE INTEGER OF
+36620 1: (INT: INTEGER);
+36630 2: (ENTRY: PACKED ARRAY [1..7] OF CHAR; FILLER: 0..777777B);
+36640 END;
+36650 APFILLCHAIN, BPFILLCHAIN: PFILLCHAIN;
+36660 SEQWORD, C: INTEGER;
+36670 BEGIN WITH TABLEWORD, CODETABLE[OPCOD] DO
+36680 BEGIN
+36690 WRITE(LGO, 44000002000000000000B+(LINKINS^.COUNT DIV 2)*1000000000000B); (*LINK TABLE*)
+36700 INT := 0;
+36710 FOR C := 1 TO 7 DO
+36720 IF ROUTINE[C]<>' ' THEN ENTRY[C] := ROUTINE[C];
+36730 WRITE(LGO, INT);
+36740 SEQWORD := 0;
+36750 APFILLCHAIN := LINKINS;
+36760 C := 1;
+36770 REPEAT
+36780 WITH APFILLCHAIN^ DO
+36790 BEGIN
+36800 SEQWORD := SEQWORD*10000000000B+(7-FFOUR)*1000000000B+1000000B+FSEGLOC;
+36810 C := C+1;
+36820 IF ODD(C) THEN BEGIN WRITE(LGO, SEQWORD); SEQWORD := 0 END;
+36830 BPFILLCHAIN := APFILLCHAIN; APFILLCHAIN := LINK; DISPOSE(BPFILLCHAIN)
+36840 END
+36850 UNTIL APFILLCHAIN=NIL;
+36860 IF NOT ODD(C) THEN
+36870 BEGIN SEQWORD := SEQWORD*10000000000B; WRITE(LGO, SEQWORD) END;
+36880 LINKINS := NIL
+36890 END
+36900 END;
+36910 (**)
+36920 PROCEDURE PLANTWORD;
+36930 (*CALLED WHENEVER A COMPLETE WORD OF 15 OR 30 BIT INSTRUCTIONS IS COMPLETE*)
+36940 VAR I: INTEGER;
+36950 BEGIN
+36960 WITH XSEG DO
+36970 BEGIN
+36980 FOUR := 1;
+36990 IF FIFTEEN<15 THEN
+37000 FIFTEEN := FIFTEEN+1
+37010 ELSE
+37020 BEGIN
+37030 SEGLOC := SEGLOC+15;
+37040 WITH BUFFER[LAST] DO CODEWORD := CODEWORD+RELOCATION; RELOCATION := 0;
+37050 LAST := (LAST+16) MOD 128;
+37060 FIFTEEN := 1;
+37070 IF LAST=FIRST THEN WITH HEADERWORD DO
+37080 BEGIN
+37090 WRITE(LGO, WORD);
+37100 FOR I := FIRST TO FIRST+15 DO
+37110 WRITE(LGO, BUFFER[I].CODEWORD);
+37120 FIRST := (FIRST+16) MOD 128;
+37130 S := S+15
+37140 END;
+37150 BUFFER[LAST].CODEWORD := 0 (*NEXT RELOCATION*)
+37160 END;
+37170 BUFFER[LAST+FIFTEEN].CODEWORD := 0
+37180 END
+37190 END;
+37200 (**)
+37210 (**)
+37220 PROCEDURE UPPER;
+37230 (*FORCES NEXT INSTRUCTION TO BE AT START OF A WORD*)
+37240 CONST SHIFT1=100000B; SHIFT2=10000000000B; SHIFT3=1000000000000000B;
+37250 NOOP1=46000B; NOOP2=4600046000B; NOOP3=460004600046000B;
+37260 BEGIN WITH XSEG DO WITH BUFFER[LAST+FIFTEEN] DO
+37270 CASE FOUR OF
+37280 1: (*NO ACTION*);
+37290 2: BEGIN
+37300 CODEWORD := CODEWORD*SHIFT3+NOOP3;
+37310 RELOCATION := RELOCATION*8;
+37320 PLANTWORD
+37330 END;
+37340 3: BEGIN
+37350 CODEWORD := CODEWORD*SHIFT2+NOOP2;
+37360 RELOCATION := RELOCATION*4;
+37370 PLANTWORD
+37380 END;
+37390 4: BEGIN
+37400 CODEWORD := CODEWORD*SHIFT1+NOOP1;
+37410 RELOCATION := RELOCATION*2;
+37420 PLANTWORD
+37430 END
+37440 END
+37450 END;
+37460 (**)
+37470 (**)
+37480 PROCEDURE DOFREF(OPERAND: INTEGER);
+37490 VAR APFCHAIN: PFCHAIN;
+37500 BEGIN NEW(APFCHAIN); WITH XSEG, APFCHAIN^ DO
+37510 BEGIN
+37520 FLAST := LAST; FFIFTEEN := FIFTEEN; FFOUR := FOUR;
+37530 FSEGLOC := SEGLOC; FLABL := OPERAND;
+37540 LINK := TPFCHAIN^.LINK; TPFCHAIN^.LINK := APFCHAIN
+37550 END
+37560 END;
+37570 (**)
+37580 (**)
+37590 PROCEDURE EMITXWORD(TYP: OPDTYP; OPERAND: INTEGER);
+37600 BEGIN
+37610 UPPER;
+37620 WITH XSEG DO WITH BUFFER[LAST+FIFTEEN] DO
+37630 CASE TYP OF
+37640 OCVIMMED:
+37650 BEGIN CODEWORD := OPERAND; RELOCATION := RELOCATION*16 END;
+37660 OCVMEM:
+37670 BEGIN CODEWORD := OPERAND; RELOCATION := RELOCATION*16+2 END;
+37680 OCVFIM,OCVFREF:
+37690 BEGIN CODEWORD := 0; RELOCATION := RELOCATION*16; FOUR := 3; DOFREF(OPERAND) END;
+37700 END;
+37710 PLANTWORD
+37720 END;
+37730 (**)
+37740 (**)
+37750 PROCEDURE EMITALF(OPERAND: BIGALFA);
+37760 VAR ALFWD: RECORD CASE SEVERAL OF
+37770 1: (INT: INTEGER);
+37780 2: (ALF: BIGALFA);
+37790 END;
+37800 BEGIN
+37810 ALFWD.ALF := OPERAND;
+37820 EMITXWORD(OCVIMMED, ALFWD.INT);
+37830 END;
+37840 (**)
+37850 (**)
+37860 (**)
+37870 (**)
+37880 PROCEDURE FILL (WHERE:SBTTYP; SB:PSB);
+37890 BEGIN
+37900 WITH SB^ DO
+37910 BEGIN
+37920 IF NOT(WHERE IN [SBTSTKN,SBTDL,SBTXN]) THEN SBLEN := LENARRAY[WHERE];
+37930 IF WHERE IN [SBTSTK..SBTDL] THEN
+37940 BEGIN
+37950 RTSTKDEPTH := RTSTKDEPTH+SBLEN;
+37960 WITH ROUTNL^ DO
+37970 IF RTSTKDEPTH>RNLENSTK THEN RNLENSTK:=RTSTKDEPTH
+37980 END
+37990 (*+32()ELSE ASERT(REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SBTYP])=[],'FILL-A ') ()+32*);
+38000 IF SBTYP IN [SBTSTK..SBTDL] THEN RTSTKDEPTH:=RTSTKDEPTH-SBLEN+ORD(WHERE=SBTDL);
+38010 REGSINUSE:=REGSINUSE-REGISTERS[SBTYP]+REGISTERS[WHERE];
+38020 SBTYP:=WHERE
+38030 END
+38040 END;
+38050 (**)
+38060 FUNCTION SETINLINE (OPCOD:POP):BOOLEAN;
+38070 VAR INL:BOOLEAN;
+38080 BEGIN
+38090 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+38100 REPEAT WITH CODETABLE[OPCOD] DO
+38110 BEGIN
+38120 INL := INLINE;
+38130 OPCOD := NEXT
+38140 END
+38150 UNTIL NOT(INL) OR (OPCOD=0);
+38160 SETINLINE := INL
+38170 END;
+38180 (**)
+38190 FUNCTION NORMAL(SB: PSB): SBTTYP;
+38200 (*RETURNS THE SBTTYP IN WHICH VALUES OF MODE SB^.SBMODE SHOULD BE STORED DURING BALANCES*)
+38210 BEGIN WITH SB^ DO WITH SBMODE^.MDV DO
+38220 IF SBTYP=SBTDL THEN NORMAL := SBTDL
+38230 ELSE IF SBUNION IN SBINF THEN NORMAL := SBTSTKN
+38240 ELSE IF MDPILE THEN NORMAL := SBTX1
+38250 ELSE CASE MDLEN OF
+38260 0: NORMAL := SBTVOID;
+38270 1: NORMAL := SBTX1;
+38280 (*+61() 2: NORMAL := SBTX12; ()+61*)
+38290 END;
+38300 END;
+38310 (**)
+38320 (**)
+38330 (**)
+38340 PROCEDURE LOADSTK(SB: PSB);
+38350 VAR LEN: 0..MAXSIZE;
+38360 BEGIN
+38370 WITH SB^ DO WITH SBMODE^.MDV DO
+38380 BEGIN
+38390 IF SBUNION IN SBINF THEN LEN := SBLEN ELSE IF MDPILE THEN LEN:=SZADDR ELSE LEN := MDLEN;
+38400 IF SBTYP<>SBTDL THEN
+38410 CASE LEN OF
+38420 0: LOAD(SBTVOID, SB);
+38430 1: LOAD(SBTSTK, SB);
+38440 2: (*+61() LOAD(SBTSTK2, SB);
+38450 3: ()+61*) (*LEAVE IT WHERE IT IS*);
+38460 END;
+38470 END;
+38480 END;
+38490 ()+01*)
+38500 ()-23*)
+38510 (**)
+38520 PROCEDURE CLEAR (* (SB:PSB) *);
+38530 (*ENSURES THAT NOTHING ON RTSTACK FROM SB DOWNWARDS IS IN A REGISTER*)
+38540 VAR TEMPPTR:PSB; BOOL:BOOLEAN;
+38550 BEGIN
+38560 TEMPPTR:=SB;
+38570 BOOL := TRUE;
+38580 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP<SBTSTK THEN
+38590 REPEAT
+38600 BEGIN
+38610 TEMPPTR:=TEMPPTR^.SBRTSTK;
+38620 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP>SBTSTKN THEN BOOL:=FALSE;
+38630 END
+38640 UNTIL NOT(BOOL) OR (TEMPPTR=NIL);
+38650 IF TEMPPTR<>NIL THEN IF TEMPPTR^.SBTYP>SBTSTKN THEN LOADSTK(TEMPPTR);
+38660 END;
+38670 (**)
+38680 (*-23()
+38690 (*+01()
+38700 (**)
+38710 PROCEDURE TWIST;
+38720 VAR TEMPPTR : PSB;
+38730 BEGIN
+38740 WITH RTSTACK^ DO BEGIN
+38750 IF (SBRTSTK^.SBTYP IN [SBTSTK..SBTSTKN])AND(SBTYP>=SBTSTK) THEN (*PHYSICAL UNTWISTING NEEDED*)
+38760 BEGIN
+38770 (*+32() ASERT(SBTYP>SBTDL, 'TWIST-A '); ()+32*)
+38780 LOAD(NORMAL(SBRTSTK),SBRTSTK);
+38790 END;
+38800 TEMPPTR := SBRTSTK;
+38810 SBRTSTK := TEMPPTR^.SBRTSTK;
+38820 TEMPPTR^.SBRTSTK := RTSTACK;
+38830 RTSTACK := TEMPPTR;
+38840 END
+38850 END;
+38860 (**)
+38870 PROCEDURE LOAD (* (WHERE:SBTTYP; SB:PSB) *);
+38880 (*EMITS CODE TO MOVE SB TO WHERE: CALLS FILL TO RECORD THE MOVE*)
+38890 VAR TEMPOP: POP;
+38900 TOFFSET: OFFSETR;
+38910 TEMPTYP: SBTTYP;
+38920 OCVFIX: OPDTYP;
+38930 BEGIN
+38940 WITH SB^ DO
+38950 BEGIN
+38960 (*+21() WRITELN('LOAD',ORD(SB):6 OCT,ORD(SB^.SBTYP):3,ORD(WHERE):3);()+21*)
+38970 IF SBRTSTK<>NIL THEN
+38980 IF SBSTKDELAY IN SBRTSTK^.SBINF THEN
+38990 BEGIN LOADSTK(SBRTSTK); SBRTSTK^.SBINF:=SBRTSTK^.SBINF-[SBSTKDELAY] END;
+39000 IF WHERE IN [SBTSTK..SBTDL] THEN CLEAR(SBRTSTK)
+39010 ELSE
+39020 BEGIN (*WHERE IS SOME REGISTER*)
+39030 (*+32()ASERT((SB=RTSTACK)OR(SB=RTSTACK^.SBRTSTK)OR(SBTYP IN [SBTVAR,SBTPROC,SBTRPROC]),'LOAD-A '); ()+32*)
+39040 IF SB=RTSTACK^.SBRTSTK THEN (*SB IS SECOND ON RTSTACK*) WITH RTSTACK^ DO
+39050 BEGIN
+39060 IF REGISTERS[WHERE]*REGISTERS[SBTYP]<>[] THEN
+39070 IF WHERE IN [SBTX1,SBTX5(*+61(),SBTX12,SBTX45()+61*)] THEN
+39080 IF (SB^.SBTYP IN [SBTX1,SBTX5]) AND (SBTYP IN [SBTX1,SBTX5]) THEN
+39090 BEGIN EMITOP(PSWAP); TEMPTYP := SBTYP; SBTYP := SB^.SBTYP; SB^.SBTYP := TEMPTYP END
+39100 ELSE IF SBTYP=SBTX1 THEN LOAD(SBTX5,RTSTACK)
+39110 (*+61() ELSE IF SBTYP=SBTX12 THEN LOAD(SBTX45,RTSTACK)
+39120 ELSE IF SBTYP=SBTX45 THEN LOAD(SBTX12,RTSTACK)
+39130 ()+61*)
+39140 ELSE LOAD(SBTX1,RTSTACK)
+39150 ELSE IF REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SB^.SBTYP])<>[] THEN CLEAR(SBRTSTK)
+39160 END
+39170 ELSE (*SB IS FIRST ON RTSTACK*)
+39180 IF REGISTERS[WHERE]*(REGSINUSE-REGISTERS[SBTYP])<>[] THEN
+39190 IF REGISTERS[SBRTSTK^.SBTYP]*REGISTERS[WHERE]<>[] THEN CLEAR(SBRTSTK)
+39200 ELSE CLEAR(SBRTSTK^.SBRTSTK)
+39210 END;
+39220 IF WHERE = SBTXN THEN
+39230 LOAD(NORMAL(SB), SB)
+39240 ELSE IF WHERE = SBTSTKN THEN
+39250 LOADSTK(SB)
+39260 ELSE
+39270 BEGIN
+39280 IF WHERE<>SBTVOID THEN
+39290 BEGIN
+39300 TEMPOP := POPARRAY[WHERE,SBTYP];
+39310 (*+32()ASERT(TEMPOP<>PNONE,'LOAD-C '); ()+32*)
+39320 IF TEMPOP<>PNOOP THEN
+39330 BEGIN
+39340 CASE SBTYP OF
+39350 SBTRPROC,SBTPROC,SBTVAR: IF WHERE<>SBTX6 THEN
+39360 BEGIN LOAD(SBTX6, SB); LOAD(WHERE, SB) END
+39370 ELSE BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);
+39380 IF SBTYP=SBTVAR THEN
+39390 EMITX2(TEMPOP,OCVIMMED,SBLOCRG,OCVLCLGBL,TOFFSET)
+39400 ELSE BEGIN (*SBTYP=SBTPROC OR SBTRPROC*)
+39410 IF SBTYP=SBTPROC THEN OCVFIX := OCVMEM
+39420 ELSE (* SBTRPROC *) OCVFIX := OCVFREF;
+39430 EMITX2(TEMPOP,OCVFIX,SBXPTR,OCVLCLGBL,TOFFSET);
+39440 END
+39450 END;
+39460 (**)
+39470 SBTID,SBTIDV: BEGIN TOFFSET:=GENLCLGBL(TEMPOP,SB);EMITX1(TEMPOP,OCVLCLGBL,TOFFSET) END;
+39480 SBTLIT: EMITX1(TEMPOP, OCVIMMED, SBVALUE);
+39490 SBTDEN: GENDENOT(TEMPOP,SB);
+39500 SBTSTK,SBTDL,(*+61()SBTSTK2,SBTX12,SBTX45,()+61*)SBTX5,SBTX6,SBTX0,SBTX1: EMITOP(TEMPOP)
+39510 END;
+39520 END
+39530 END;
+39540 FILL(WHERE,SB);
+39550 END;
+39560 END
+39570 END;
+39580 (**)
+39590 (**)
+39600 ()+01*)
+39610 ()-23*)
+39620 PROCEDURE UNSTKP1 (*+05() (TYP:OPDTYP; OPND:PSB) ()+05*);
+39630 BEGIN
+39640 IF TYP = OCVSBS THEN
+39650 (*ASSERT: OPND = RTSTACK*)
+39660 REPEAT
+39670 OPND := RTSTACK;
+39680 UNSTACKSB;
+39690 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN;
+39700 OPND^.SBTYP := SBTVOID;
+39710 UNTIL OPND^.SBRTSTK =SRSTK[SRSUBP+1].SB^.SBRTSTK
+39720 ELSE IF TYP <> OCVSBP THEN
+39730 BEGIN UNSTACKSB;
+39740 IF OPND^.SBTYP IN [SBTSTK..SBTDL] THEN ADJUSTSP := ADJUSTSP+OPND^.SBLEN;
+39750 OPND^.SBTYP:=SBTVOID;
+39760 END
+39770 (*+02() ELSE (*TYP=OCVSBP*) ADJUSTSP := ADJUSTSP-LENOF(OPND); ()+02*)
+39780 END;
+39790 (**)
+39800 (*-23()
+39810 (*+01()
+39820 (**)
+39830 PROCEDURE PROC1OP (OPCOD:POP; TYP:OPDTYP; OPND:INTEGER; NOTINL:BOOLEAN);
+39840 VAR SB:PSB;
+39850 BEGIN
+39860 SB := ASPTR(OPND);
+39870 WITH CODETABLE[OPCOD] DO
+39880 BEGIN
+39890 (*+32()ASERT((P1<>SBTVOID)AND(P2=SBTVOID),'PROC1OP-A '); ()+32*)
+39900 IF RTSTACK<>SB THEN TWIST;
+39910 (*+32()ASERT(RTSTACK=SB,'PROC1OP-B '); ()+32*)
+39920 LOAD(P1,SB);
+39930 IF NOTINL THEN CLEAR(RTSTACK^.SBRTSTK);
+39940 NEXTREG := ORD(P1 IN [SBTX0,SBTX1]);
+39950 UNSTKP1(TYP,SB);
+39960 END;
+39970 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+39980 END;
+39990 (**)
+40000 PROCEDURE PROC2OP (OPCOD:POP; TYP1:OPDTYP;OPND1:INTEGER; TYP2:OPDTYP;OPND2:INTEGER; NOTINL:BOOLEAN);
+40010 VAR SB1,SB2:PSB;
+40012 TEMP:PSB;
+40020 BEGIN
+40030 SB1 := ASPTR(OPND1);
+40040 SB2 := ASPTR(OPND2);
+40050 WITH CODETABLE[OPCOD] DO
+40060 BEGIN
+40070 (*+32()ASERT((P1 <>SBTVOID)AND(P2<>SBTVOID),'PROC2OP-A '); ()+32*)
+40080 IF RTSTACK<>SB2 THEN TWIST;
+40090 (*+32()ASERT(RTSTACK=SB2,'PROC2OP-B '); ()+32*)
+40100 IF NOT (SB2^.SBTYP IN [SBTSTK..SBTSTKN,SBTVAR,SBTPROC]) THEN
+40110 BEGIN LOAD(P1,SB1); LOAD(P2,SB2) END
+40120 ELSE BEGIN LOAD(P2,SB2); LOAD(P1,SB1); LOAD(P2,SB2) (*IN CASE SB1^.SBTYP WAS SBTVAR*) END;
+40130 IF NOTINL THEN CLEAR(RTSTACK^.SBRTSTK^.SBRTSTK);
+40140 NEXTREG:= ORD(P1 IN [SBTX0,SBTX1])+ ORD(P2 IN [SBTX0,SBTX1]);
+40150 (*+32()ASERT((TYP1=OCVSBP)OR NOT(TYP2 IN[OCVSBP,OCVSBS]),'PROC2OP-C '); ()+32*)
+40160 UNSTKP1(TYP2,SB2);
+40170 UNSTKP1(TYP1,SB1)
+40180 END;
+40190 OCV := OCVNONE; (*FOR 1ST CALL OF PARAM*)
+40200 END;
+40210 (**)
+40220 PROCEDURE PARAM (TYP:OPDTYP; OPND:INTEGER; OPCOD: POP);
+40230 VAR TEMPOP:POP;
+40240 TEMPREG: INTEGER;
+40250 BEGIN
+40260 IF OCV<>OCVNONE THEN
+40270 BEGIN
+40280 CASE NEXTREG OF
+40290 0: TEMPOP := PLOADX0IM;
+40300 1: TEMPOP := PLOADX1IM;
+40310 2: TEMPOP := PLOADX2IM;
+40320 3: TEMPOP := PLOADX3IM;
+40330 4: TEMPOP := PLOADX4IM
+40340 END;
+40350 NEXTREG := NEXTREG+1;
+40360 IF (OPRAND<400000B)AND(OPRAND>-400000B) THEN EMITOP(TEMPOP)
+40370 ELSE BEGIN
+40380 TEMPREG := NEXTREG;
+40390 EMITCONST(OPRAND);
+40400 NEXTREG := TEMPREG;
+40410 OCV := OCVMEM; OPRAND := FIXUPM-1;
+40420 EMITOP(TEMPOP+1)
+40430 END
+40440 END;
+40470 OPRAND:=OPND; OCV := TYP;
+40480 END;
+40490 (**)
+40500 PROCEDURE EMITOP (* (OPCOD: POP) *) ;
+40510 LABEL 11;
+40520 CONST NOOP1=46000B; NOOP2=4600046000B; SETX7=7170000000B; EQ=0400000000B;
+40530 SHIFT1=100000B; SHIFT2=10000000000B;
+40540 VAR LINKP: PFILLCHAIN; APFCHAIN: PFCHAIN;
+40550 ALFWD: RECORD CASE SEVERAL OF
+40560 1: (INT: INTEGER);
+40570 2: (LEX: PLEX)
+40580 END;
+40590 I: INTEGER;
+40600 FMIJKCOPY: 0..7777777777B;
+40610 FORCOUNT, COUNT: INTEGER; FORLABL: LABL;
+40620 VP1, VP2 : SBTTYP;
+40630 PARAMNOTUSED: BOOLEAN;
+40640 BEGIN
+40650 (*SEMCLKS := SEMCLKS+1;
+40660 EMITCLK := EMITCLK-CLOCK;*)
+40670 COUNT := 0; FORCOUNT := 0; PARAMNOTUSED := TRUE;
+40671 IF OCV=OCVLCLGBL THEN
+40672 BEGIN
+40673 IF LCLGBL<>0 THEN
+40674 FOR I := 1 TO LCLGBL DO
+40675 IF I=1 (*FIRST CASE*) THEN EMITX0(PENVCHAIN)
+40676 ELSE EMITX0(PENVCHAIN+1);
+40677 OCV := OCVIMMED;
+40678 END;
+40680 WHILE OPCOD<>0 DO WITH XSEG, CODETABLE[OPCOD] DO
+40690 BEGIN
+40700 IF INLINE THEN
+40710 BEGIN
+40720 11: WITH BUFFER[LAST+FIFTEEN] DO
+40730 BEGIN
+40740 CASE LEN OF
+40750 F0:
+40760 FORLABL := FIXUPM;
+40770 F15:
+40780 BEGIN
+40790 CODEWORD := CODEWORD*SHIFT1+FMIJK;
+40800 FOUR := FOUR+1; RELOCATION := RELOCATION*2
+40810 END;
+40820 F30:
+40830 IF FOUR<4 THEN
+40840 BEGIN
+40850 IF REL >= 0 THEN
+40860 BEGIN
+40870 IF REL > 0 THEN
+40880 BEGIN FORCOUNT:=COUNT+REL; FORLABL:=GETNEXTLABL;
+40890 DOFREF(FORLABL) END;
+40900 CODEWORD := CODEWORD*SHIFT2+FMIJK;
+40910 FOUR := FOUR+2; RELOCATION := RELOCATION*4
+40920 END
+40930 ELSE IF REL < 0 THEN
+40940 BEGIN
+40950 CODEWORD := CODEWORD+SHIFT2+FMIJK+FORLABL;
+40960 RELOCATION := RELOCATION*4+2
+40970 END;
+40980 END
+40990 ELSE
+41000 BEGIN
+41010 CODEWORD := CODEWORD*SHIFT1+NOOP1;
+41020 RELOCATION := RELOCATION*2;
+41030 PLANTWORD; GOTO 11
+41040 END;
+41050 F30K:
+41060 IF FOUR<4 THEN
+41070 BEGIN
+41080 IF ODD(FMIJK) THEN
+41090 BEGIN
+41100 (*+32() ASERT(OCV IN [OCVIMMED,OCVIMMLONG], 'EMITOP-A '); ()+32*)
+41110 FMIJKCOPY := FMIJK-1; OPRAND := -OPRAND;
+41120 END
+41130 ELSE FMIJKCOPY := FMIJK;
+41140 CASE OCV OF
+41150 OCVIMMED,OCVIMMLONG,OCVIMMPTR:
+41160 BEGIN
+41170 IF OPRAND<0 THEN OPRAND := OPRAND+777777B;
+41180 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY+OPRAND;
+41190 RELOCATION := RELOCATION*4
+41200 END;
+41210 OCVMEM:
+41220 BEGIN
+41230 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY+OPRAND;
+41240 RELOCATION := RELOCATION*4+2
+41250 END;
+41260 OCVEXT:
+41270 BEGIN
+41280 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY;
+41290 RELOCATION := RELOCATION*4;
+41300 NEW(LINKP); WITH LINKP^, ALFWD, CODETABLE[PPOP] DO
+41310 BEGIN
+41320 FSEGLOC := SEGLOC+FIFTEEN-1; FFOUR := FOUR;
+41330 COUNT := 0;
+41340 LINK := NIL;
+41350 INT := OPRAND;
+41360 FOR I := 1 TO 7 DO
+41370 WITH LEX^ DO
+41380 IF S10[I]=' ' THEN ROUTINE[I] := ':' ELSE ROUTINE[I] := S10[I];
+41390 LINKINS := LINKP; PUTLINK(PPOP)
+41400 END
+41410 END;
+41420 OCVFIM, OCVFREF:
+41430 BEGIN
+41440 CODEWORD := CODEWORD*SHIFT2+FMIJKCOPY;
+41450 RELOCATION := RELOCATION*4;
+41460 DOFREF(OPRAND);
+41470 END
+41480 END;
+41490 FOUR := FOUR+2;
+41500 PARAMNOTUSED := FALSE;
+41510 END
+41520 ELSE
+41530 BEGIN
+41540 CODEWORD := CODEWORD*SHIFT1+NOOP1;
+41550 RELOCATION := RELOCATION*2;
+41560 PLANTWORD; GOTO 11
+41570 END
+41580 END;
+41590 IF FOUR>4 THEN PLANTWORD;
+41600 OPCOD := NEXT
+41610 END
+41620 END
+41630 ELSE
+41640 BEGIN
+41650 IF PARAMNOTUSED THEN PARAM(OCVNONE, 0, OPCOD);
+41660 EMITOP(PSTATICLINK);
+41670 UPPER;
+41680 NEW(LINKP); WITH LINKP^ DO
+41690 BEGIN
+41700 FSEGLOC := SEGLOC+FIFTEEN-1; FFOUR := 3;
+41710 IF LINKINS=NIL THEN COUNT :=0 ELSE COUNT := LINKINS^.COUNT+1;
+41720 LINK := LINKINS; LINKINS := LINKP;
+41730 IF COUNT=31 THEN PUTLINK(OPCOD)
+41740 END;
+41750 BUFFER[LAST+FIFTEEN].CODEWORD := (SETX7+SEGLOC+FIFTEEN)*SHIFT2+EQ;
+41760 RELOCATION := RELOCATION*16+8;
+41770 PLANTWORD;
+41780 OPCOD := 0;
+41790 IF ADJUSTSP<>0 THEN EMITX1(PASP, OCVIMMED, ADJUSTSP);
+41800 END;
+41810 COUNT := COUNT+1;
+41820 IF COUNT=FORCOUNT THEN FIXUPF(FORLABL)
+41830 END;
+41840 (*EMITCLK := EMITCLK+CLOCK;
+41850 EMITCLKS := EMITCLKS+1*)
+41860 END;
+41870 (**)
+41880 ()+01*)
+41890 ()-23*)
+41900 (**)
+41910 PROCEDURE EMITX0(OPCOD: POP);
+41920 BEGIN IF NOT SETINLINE(OPCOD) THEN BEGIN ADJUSTSP := 0; CLEAR(RTSTACK) END;
+41930 (*+05() PARAM(OCVNONE,0,OPCOD,EVEN,NOT SETINLINE(OPCOD)); ()+05*)
+41940 EMITOP(OPCOD);
+41950 END;
+41960 (**)
+41970 (**)
+41980 PROCEDURE EMITX1 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT) ()+05*);
+41990 VAR SB1:PSB; NOTINL:BOOLEAN;
+42000 BEGIN
+42010 (*-24()(*+23() TAKELINE; ()+23*) ()-24*)
+42020 IF TYP1 = OCVRES THEN
+42030 BEGIN
+42040 SB1 := ASPTR(OPND1);
+42050 EMITX0 (OPCOD);
+42060 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX1-A ');
+42070 ASERT(SB1^.SBTYP=SBTVOID,'EMITX1-B '); ()+32*)
+42080 FILL(CODETABLE[OPCOD].PR,SB1);
+42090 SB1^.SBRTSTK:=RTSTACK; RTSTACK:=SB1;
+42100 END
+42110 ELSE
+42120 BEGIN
+42130 NOTINL := NOT(SETINLINE(OPCOD));
+42140 IF NOTINL THEN ADJUSTSP := 0;
+42150 IF TYP1 >= OCVSB THEN
+42160 PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*))
+42170 ELSE
+42180 BEGIN
+42190 IF NOTINL THEN CLEAR(RTSTACK);
+42200 (*+01() NEXTREG := 0; ()+01*)
+42210 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
+42220 END;
+42230 EMITOP(OPCOD)
+42240 END
+42250 END;
+42260 (**)
+42270 (**)
+42280 PROCEDURE EMITX2 (*+05() (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT;
+42290 TYP2:OPDTYP; OPND2:ADDRINT) ()+05*);
+42300 VAR SB2:PSB; NOTINL:BOOLEAN;
+42310 BEGIN
+42320 (*+23() TAKELINE; ()+23*)
+42330 IF TYP2 = OCVRES THEN
+42340 BEGIN
+42350 SB2 := ASPTR(OPND2);
+42360 EMITX1 (OPCOD, TYP1,OPND1);
+42370 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX2-A ');
+42380 ASERT(SB2^.SBTYP=SBTVOID,'EMITX2-B '); ()+32*)
+42390 FILL(CODETABLE[OPCOD].PR,SB2);
+42400 SB2^.SBRTSTK:=RTSTACK; RTSTACK:=SB2;
+42410 END
+42420 ELSE
+42430 BEGIN
+42440 NOTINL := NOT(SETINLINE(OPCOD));
+42450 IF NOTINL THEN ADJUSTSP := 0;
+42460 IF TYP1 >= OCVSB THEN
+42470 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),EVEN()+05*))
+42480 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),EVEN()+05*));
+42490 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*)) END
+42500 ELSE
+42510 BEGIN
+42520 IF NOTINL THEN CLEAR(RTSTACK);
+42530 (*+01() NEXTREG:=0; ()+01*)
+42540 PARAM(TYP1,OPND1,OPCOD(*+05(),EVEN,NOTINL()+05*));
+42550 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*))
+42560 END;
+42570 EMITOP(OPCOD)
+42580 END
+42590 END;
+42600 (**)
+42610 (**)
+42620 PROCEDURE EMITX3 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
+42630 TYP3:OPDTYP; OPND3:ADDRINT);
+42640 VAR SB3:PSB; NOTINL:BOOLEAN;
+42650 BEGIN
+42660 (*+23() TAKELINE; ()+23*)
+42670 IF TYP3 = OCVRES THEN
+42680 BEGIN
+42690 SB3 := ASPTR(OPND3);
+42700 EMITX2 (OPCOD, TYP1,OPND1, TYP2,OPND2);
+42710 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX3-A ');
+42720 ASERT(SB3^.SBTYP=SBTVOID,'EMITX3-B '); ()+32*)
+42730 FILL(CODETABLE[OPCOD].PR,SB3);
+42740 SB3^.SBRTSTK:=RTSTACK; RTSTACK:=SB3;
+42750 END
+42760 ELSE
+42770 BEGIN
+42780 NOTINL := NOT(SETINLINE(OPCOD));
+42790 IF NOTINL THEN ADJUSTSP := 0;
+42800 IF TYP1 >= OCVSB THEN
+42810 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),ODDD()+05*))
+42820 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*));
+42830 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*)) END
+42840 ELSE
+42850 BEGIN
+42860 IF NOTINL THEN CLEAR(RTSTACK);
+42870 (*+01() NEXTREG:=0; ()+01*)
+42880 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
+42890 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*))
+42900 END;
+42910 PARAM(TYP3,OPND3,OPCOD(*+05(),ODDD,FALSE()+05*));
+42920 EMITOP(OPCOD)
+42930 END
+42940 END;
+42950 (**)
+42960 (**)
+42970 PROCEDURE EMITX4 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
+42980 TYP3:OPDTYP; OPND3:ADDRINT; TYP4:OPDTYP;OPND4:ADDRINT);
+42990 VAR SB4:PSB; NOTINL:BOOLEAN;
+43000 BEGIN
+43010 (*+23() TAKELINE; ()+23*)
+43020 IF TYP4 = OCVRES THEN
+43030 BEGIN
+43040 SB4 := ASPTR(OPND4);
+43050 EMITX3 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3);
+43060 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX4-A ');
+43070 ASERT(SB4^.SBTYP=SBTVOID,'EMITX4-B '); ()+32*)
+43080 FILL(CODETABLE[OPCOD].PR,SB4);
+43090 SB4^.SBRTSTK:=RTSTACK; RTSTACK:=SB4;
+43100 END
+43110 ELSE
+43120 BEGIN
+43130 NOTINL := NOT(SETINLINE(OPCOD));
+43140 IF NOTINL THEN ADJUSTSP := 0;
+43150 IF TYP1 >= OCVSB THEN
+43160 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),EVEN()+05*))
+43170 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),EVEN()+05*));
+43180 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*)) END
+43190 ELSE
+43200 BEGIN
+43210 IF NOTINL THEN CLEAR(RTSTACK);
+43220 (*+01() NEXTREG:=0; ()+01*)
+43230 PARAM(TYP1,OPND1,OPCOD(*+05(),EVEN,NOTINL()+05*));
+43240 PARAM(TYP2,OPND2,OPCOD(*+05(),ODDD,FALSE()+05*))
+43250 END;
+43260 PARAM(TYP3,OPND3,OPCOD(*+05(),EVEN,FALSE()+05*));
+43270 PARAM(TYP4,OPND4,OPCOD(*+05(),ODDD,FALSE()+05*));
+43280 EMITOP(OPCOD)
+43290 END
+43300 END;
+43310 (**)
+43320 (**)
+43330 PROCEDURE EMITX5 (OPCOD:POP; TYP1:OPDTYP;OPND1:ADDRINT; TYP2:OPDTYP;OPND2:ADDRINT;
+43340 TYP3:OPDTYP;OPND3:ADDRINT;TYP4:OPDTYP;OPND4:ADDRINT;TYP5:OPDTYP;OPND5:ADDRINT);
+43350 VAR SB5:PSB; NOTINL:BOOLEAN;
+43360 BEGIN
+43370 (*+23() TAKELINE; ()+23*)
+43380 IF TYP5 = OCVRES THEN
+43390 BEGIN
+43400 SB5 := ASPTR(OPND5);
+43410 EMITX4 (OPCOD, TYP1,OPND1, TYP2,OPND2, TYP3,OPND3,TYP4,OPND4);
+43420 (*+32() ASERT(CODETABLE[OPCOD].PR<>SBTVOID,'EMITX5-A ');
+43430 ASERT(SB5^.SBTYP=SBTVOID,'EMITX5-B '); ()+32*)
+43440 FILL(CODETABLE[OPCOD].PR,SB5);
+43450 SB5^.SBRTSTK:=RTSTACK; RTSTACK:=SB5;
+43460 END
+43470 ELSE
+43480 BEGIN
+43490 NOTINL := NOT(SETINLINE(OPCOD));
+43500 IF NOTINL THEN ADJUSTSP := 0;
+43510 IF TYP1 >= OCVSB THEN
+43520 IF TYP2 >= OCVSB THEN PROC2OP(OPCOD,TYP1,OPND1,TYP2,OPND2,NOTINL(*+05(),ODDD()+05*))
+43530 ELSE BEGIN PROC1OP(OPCOD,TYP1,OPND1,NOTINL(*+05(),ODDD()+05*));
+43540 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*)) END
+43550 ELSE
+43560 BEGIN
+43570 IF NOTINL THEN CLEAR(RTSTACK);
+43580 (*+01() NEXTREG:=0; ()+01*)
+43590 PARAM(TYP1,OPND1,OPCOD(*+05(),ODDD,NOTINL()+05*));
+43600 PARAM(TYP2,OPND2,OPCOD(*+05(),EVEN,FALSE()+05*))
+43610 END;
+43620 PARAM(TYP3,OPND3,OPCOD(*+05(),ODDD,FALSE()+05*));
+43630 PARAM(TYP4,OPND4,OPCOD(*+05(),EVEN,FALSE()+05*));
+43640 PARAM(TYP5,OPND5,OPCOD(*+05(),ODDD,FALSE()+05*));
+43650 EMITOP(OPCOD)
+43660 END
+43670 END;
+43680 (**)
+43690 (**)
+43700 PROCEDURE EMITCONST (*OPERAND: A68INT*);
+43710 VAR JUMPOVER: LABL;
+43720 BEGIN JUMPOVER := GETNEXTLABEL;
+43730 EMITX1(PJMP, OCVFREF, JUMPOVER);
+43740 EMITXWORD(OCVIMMED, OPERAND);
+43750 FIXUPF(JUMPOVER)
+43760 END;
+43770 (**)
+43780 (*-23()
+43790 (*+01()
+43800 (**)
+43810 PROCEDURE FIXUPFORW(ALABL: LABL; VALUE, NFOUR: INTEGER);
+43820 CONST SHIFT1=100000B;
+43830 VAR APFCHAIN, BPFCHAIN: PFCHAIN;
+43840 I: INTEGER;
+43850 TABLEWORD: PACKED RECORD CASE INTEGER OF
+43860 1: (INT: INTEGER);
+43870 2: (ENTRY: PACKED ARRAY [1..7] OF CHAR; FILLER: 0..777777B);
+43880 END;
+43890 TVALUE, TNFOUR: INTEGER;
+43900 BEGIN
+43910 TABLEWORD.INT := 0;
+43920 APFCHAIN := TPFCHAIN;
+43930 WHILE APFCHAIN^.LINK<>NIL DO
+43940 BEGIN
+43950 IF APFCHAIN^.LINK^.FLABL=ALABL THEN
+43960 BEGIN WITH XSEG, APFCHAIN^.LINK^ DO
+43970 IF FSEGLOC>=HEADERWORD.S THEN (*CODE TO BE ALTERED IS STILL IN BUFFER*)
+43980 BEGIN
+43990 TVALUE := VALUE; TNFOUR := NFOUR;
+44000 IF FSEGLOC+FFIFTEEN=SEGLOC+FIFTEEN THEN UPPER; (*CAN ONLY HAPPEN FROM CGLABD*)
+44010 FOR I := 2-FFOUR DOWNTO 0 DO
+44020 BEGIN TNFOUR := TNFOUR*2; TVALUE := TVALUE*SHIFT1 END;
+44030 WITH BUFFER[FLAST+FFIFTEEN] DO
+44040 CODEWORD := CODEWORD+TVALUE;
+44050 FOR I := 14-FFIFTEEN DOWNTO 0 DO
+44060 TNFOUR := TNFOUR*16;
+44070 WITH BUFFER[FLAST] DO
+44080 CODEWORD := CODEWORD+TNFOUR
+44090 END
+44100 ELSE WITH TABLEWORD DO
+44110 BEGIN
+44120 IF INT=0 THEN
+44130 BEGIN
+44140 WRITE(LGO, 36000002000000000000B); (*ENTR TABLE*)
+44150 FOR I := 1 TO 7 DO
+44160 BEGIN ENTRY[I] := CHR(ORD('A') + FLABL MOD 10); FLABL := FLABL DIV 10 END;
+44170 WRITE(LGO, INT);
+44180 WRITE(LGO, VALUE+ORD(NFOUR<>0)*1000000B);
+44190 END;
+44200 WRITE(LGO, 44000002000000000000B); (*LINK TABLE*)
+44210 WRITE(LGO, INT);
+44220 WRITE(LGO, ((7-FFOUR)*1000000000B+1000000B+FSEGLOC+FFIFTEEN-1)*10000000000B)
+44230 END;
+44240 WITH APFCHAIN^ DO
+44250 BEGIN
+44260 BPFCHAIN := LINK;
+44270 LINK := LINK^.LINK;
+44280 DISPOSE(BPFCHAIN)
+44290 END
+44300 END
+44310 ELSE APFCHAIN := APFCHAIN^.LINK
+44320 END
+44330 END;
+44340 (**)
+44350 (**)
+44360 PROCEDURE FIXUPF (* (ALABL: LABL) *);
+44370 BEGIN UPPER; WITH XSEG DO FIXUPFORW(ALABL, SEGLOC+FIFTEEN-1, 2) END;
+44380 (**)
+44390 (**)
+44400 PROCEDURE FIXUPFIM(ALABL: LABL; VALUE: INTEGER);
+44410 BEGIN WITH XSEG DO FIXUPFORW(ALABL, VALUE, 0) END;
+44420 (**)
+44430 (**)
+44440 FUNCTION FIXUPM(*: LABL *);
+44450 BEGIN
+44460 UPPER;
+44470 WITH XSEG DO
+44480 FIXUPM := SEGLOC+FIFTEEN-1
+44490 END;
+44500 (**)
+44510 (**)
+44520 PROCEDURE FIXLABL(OLDLABL, NEWLABL: LABL; KNOWN: BOOLEAN);
+44530 (*IF KNOWN, NEWLABL IS THE ACTUAL VALUE TO BE GIVEN TO OLDLABEL;
+44540 OTHERWISE, IT IS JUST ANOTHER LABL TO BE FIXED UP LATER*)
+44550 VAR APFCHAIN: PFCHAIN;
+44560 BEGIN
+44570 IF KNOWN THEN
+44580 FIXUPFORW(OLDLABL, NEWLABL, 2)
+44590 ELSE
+44600 BEGIN
+44610 APFCHAIN := TPFCHAIN^.LINK;
+44620 WHILE APFCHAIN<>NIL DO WITH APFCHAIN^ DO
+44630 BEGIN
+44640 IF FLABL=OLDLABL THEN FLABL := NEWLABL;
+44650 APFCHAIN := LINK
+44660 END
+44670 END
+44680 END;
+44690 (**)
+44700 ()+01*)
+44710 ()-23*) (* MORE EM-1 DEPENDENT ROUTINES *)
+44720 (**) (********************************)
+44730 (*+02()
+44732 FUNCTION EMITRTNHEAD :LABL;
+44734 VAR
+44740 ADDRESS :LABL;
+44742 BEGIN
+44750 (*+42() DATASTATE:=ENDDATA; ()+42*)
+44760 ADDRESS:=GETNEXTLABEL;
+44770 WRITEINSTN(PRO);EMITXPROC(OCVEXT,ADDRESS);
+44771 WRITEINSTN(EOOPNDS);
+44774 DATASTATE := STARTDATA;
+44776 EMITXWORD(OCVMEM, HOLBOTTOM); (*DUMMY TO LOAD BSS BLOCKS IN CORRECT ORDER ON VAX*)
+44778 EMITRTNHEAD:=ADDRESS;
+44780 END;
+44784 PROCEDURE EMITBEG;
+44786 VAR TEMP : PLEX;
+44788 BEGIN
+44790 REWRITE(LGO);
+44791 (*+24() WRITEBYTE(173); WRITEBYTE(0); ()+24*)
+44792 (*-24() TAKELINE; ()-24*)
+44794 NEXTLABEL := 500;
+44795 LCLGBL := 0; (*SO AS TO BE DEFINED ON FIRST USE*)
+44796 DATASTATE := ENDDATA;
+44800 ADJUSTSP := 0;
+44810 WRITEINSTN(MES); (* DECLARE WORD,POINTER SIZES *)
+44820 EMITXWORD(OCVIMMED,2); (*-24() WRITE(LGO,','); ()-24*)
+44830 EMITXWORD(OCVIMMED,SZWORD);(*-24() WRITE(LGO,',');()-24*)
+44840 EMITXWORD(OCVIMMED,SZADDR);
+44850 WRITEINSTN(EOOPNDS);
+44900 ENEW(TEMP,LEX1SIZE + (9+CHARPERWORD) DIV CHARPERWORD * SZWORD);
+44908 WITH TEMP^ DO
+44909 BEGIN
+44910 S10 := 'M_A_I_N ';
+44911 S10[1]:=CHR(109); (*M*) (*THIS IS IN ASCII*)
+44912 S10[3]:=CHR(97); (*A*)
+44913 S10[5]:=CHR(105); (*I*)
+44914 S10[7]:=CHR(110); (*N*)
+44915 LXCOUNT:=(9+CHARPERWORD) DIV CHARPERWORD * SZWORD;
+44916 END;
+44920 WRITEINSTN(EXP);EMITXWORD(OCVEXT,ORD(TEMP)); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+44930 WRITEINSTN(PRO);EMITXWORD(OCVEXT,ORD(TEMP));
+44935 (*-24()WRITE(LGO,','); ()-24*)
+44940 EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
+44950 EDISPOSE(TEMP,LEX1SIZE + (9+CHARPERWORD) DIV CHARPERWORD * SZWORD);
+44951 HOLTOP:=GETNEXTLABEL;HOLBOTTOM:=GETNEXTLABEL;
+44957 DATASTATE := STARTDATA;
+44958 EMITXWORD(OCVMEM, HOLBOTTOM); (*DUMMY TO LOAD BSS BLOCKS IN CORRECT ORDER ON VAX*)
+44960 EMITX0(PPBEGIN); (*CALL ESTART0*)
+44970 WRITEINSTN(LAE); (*LOAD NEW ADDRESS OF M_A_I_N*)
+44971 WRITEOFFSET(HOLTOP,-FIRSTIBOFFSET); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+44972 WRITEINSTN(STR); (*PLACE IN LB*)
+44973 EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+44974 EMITX0(PPBEGIN+1); (*CALL START68, AND THUS ESTART_*)
+44979 END;
+44980 (**)
+44981 PROCEDURE EMITEND;
+44990 BEGIN
+44991 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA;
+44992 EMITXWORD(OCVIMMED, 0); WRITEINSTN(EOOPNDS); (*TO ENSURE THAT ANY OUTSTANDING DATA LABELS SEE CON RATHER THAN BSS*)
+44995 WRITELABEL(TRUE,HOLBOTTOM);
+45000 WRITEINSTN(BSS);
+45010 EMITXWORD(OCVIMMED,ROUTNL^.RNLENIDS+SIZIBTOP+SZWORD+FIRSTIBOFFSET);
+45015 (*-24()WRITE(LGO,','); ()-24*)
+45020 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
+45022 EMITXWORD(OCVIMMED,0);
+45024 (*-24() WRITEINSTN(EOOPNDS); ()-24*) WRITELABEL(TRUE,HOLTOP);
+45026 WRITEINSTN(BSS);
+45028 EMITXWORD(OCVIMMED,0);(*-24() WRITE(LGO,','); ()-24*)
+45030 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
+45032 EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+45034 WRITEINSTN(HOL); (*DUMMY HOL FOR RUNTIME AND FILE ACCESS*)
+45036 EMITXWORD(OCVIMMED,0);(*-24() WRITE(LGO,','); ()-24*)
+45038 EMITXWORD(OCVIMMED,-32000-768); (*-24() WRITE(LGO,','); ()-24*)
+45040 EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
+45041 DATASTATE := ENDDATA;
+45042 EMITX0(PPEND);
+45045 WRITEINSTN(RET);EMITXWORD(OCVIMMED,0); (*-24() WRITEINSTN(EOOPNDS); ()-24*)
+45046 WRITEINSTN(EEND);EMITXWORD(OCVIMMED,0);(*-24() WRITEINSTN(EOOPNDS); ()-24*)
+45048 END;
+45050 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ;
+45060 VAR I,J: INTEGER;
+45065 THING: OBJECTP;
+45066 MAP : RECORD CASE BOOLEAN OF
+45067 TRUE : (OPTR: OBJECTP);
+45068 FALSE: (IPTR: ^INTEGER);
+45069 END;
+45070 ALABL: LABL;
+45080 BEGIN WITH SB^ DO
+45090 WITH SBLEX^ (*A LEXEME*) DO
+45100 IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN
+45110 EMITX1(OPCOD, OCVEXT, ORD(SBLEX))
+45120 ELSE IF SBLEX=LEXFALSE THEN
+45130 EMITX1(OPCOD, OCVIMMED, 0)
+45140 ELSE IF SBLEX=LEXTRUE THEN
+45150 EMITX1(OPCOD, OCVIMMED, TRUEVALUE)
+45160 ELSE IF ((LXDENMD=MDINT) OR (LXDENMD=MDBITS) OR (LXDENMD=MDCHAR))
+45170 AND (LXTOKEN=TKDENOT) THEN
+45180 EMITX1(OPCOD, OCVIMMED, LXDENRP)
+45190 ELSE
+45200 BEGIN
+45210 IF LXV.LXPYPTR=0 THEN
+45220 BEGIN
+45230 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; ALABL := FIXUPM;
+45240 LXV.LXPYPTR := ALABL;
+45250 IF LXDENMD^.MDV.MDPILE THEN
+45251 BEGIN
+45255 NEW(THING);
+45256 WITH THING^ DO
+45257 BEGIN
+45258 FIRSTWORD:=0; (*+13() DBLOCK:=NIL; ANCESTOR:=NIL; IHEAD:=NIL; DUMMY:=0; ()+13*)
+45259 SORT:=0;PCOUNT:=255;LENGTH:=LXDENRP;
+45260 MAP.OPTR:=THING;
+45261 (*IF PACKING CHANGES THEN THIS FORMULA WILL HAVE TO AS WELL*)
+45262 (* THIS IS (PCOUNT)+(SCOPE,SORT)+(LENGTH) *)
+45263 FOR I:=1 TO (SZWORD+SZWORD+SZWORD(*+13() +SZWORD+SZWORD ()+13*)) DIV SZWORD DO
+45264 BEGIN
+45267 EMITXWORD(OCVIMMED,MAP.IPTR^);
+45268 MAP.IPTR:=INCPTR(MAP.IPTR,SZWORD);
+45269 END;
+45271 (*-24() WRITEINSTN(CON); ()-24*)
+45272 J:=(((SZADDR+SZINT) DIV SZINT) * CHARPERWORD) + 1;
+45273 (*+24() WRITEBYTE(CPACTSTRNG);WRITECON(CPACTCONS,SZWORD,LXDENRP);
+45280 FOR I:=J TO LXDENRP+J-1 DO
+45290 WRITEBYTE(ORD(STRNG[I])); ()+24*)
+45300 (*-24() WRITE(LGO,' ','''');
+45310 FOR I:=J TO LXDENRP+J-1 DO
+45311 BEGIN
+45312 IF STRNG[I]='''' THEN
+45313 WRITE(LGO, '\');
+45315 WRITE(LGO,STRNG[I]);
+45317 END;
+45320 WRITE(LGO,'''');()-24*)
+45325 WRITEINSTN(EOOPNDS);
+45326 END; (* OF WITH *)
+45330 DISPOSE(THING);
+45336 END
+45340 ELSE
+45342 BEGIN
+45343 J := (((SZADDR+SZREAL) DIV SZINT) * CHARPERWORD) + 1;
+45345 (*+24() IF DATASTATE=STARTDATA THEN
+45346 BEGIN WRITEINSTN(CON); DATASTATE := INDATA END;
+45347 WRITEBYTE(CPACTFLOAT);
+45348 WRITECON(CPACTCONS,SZWORD,SZREAL);
+45349 WRITECON(CPACTCONS,SZWORD,LXDENRP);
+45350 FOR I:=J TO LXDENRP+J-1 DO
+45351 WRITEBYTE(ORD(STRNG[I])); ()+24*)
+45352 (*-24() WRITEINSTN(CON);
+45353 FOR I:=J TO LXDENRP+J-1 DO
+45354 WRITE(LGO,STRNG[I]);
+45355 WRITE(LGO,'F',SZREAL:1); ()-24*)
+45356 WRITEINSTN(EOOPNDS);
+45358 END;
+45360 END;
+45365 DATASTATE:=ENDDATA;
+45370 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR)
+45380 END;
+45390 END;
+45400 (**)
+45410 PROCEDURE GENDP(M: MODE);
+45420 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH,
+45430 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV.
+45440 *)
+45450 VAR OFFSET: 0..127;
+45460 PROCEDURE DBLOCK(M: MODE);
+45470 VAR I, J: INTEGER;
+45480 BEGIN WITH M^ DO
+45490 FOR I := 0 TO MDV.MDCNT-1 DO
+45500 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO
+45510 IF MDDRESSED THEN
+45520 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END
+45530 ELSE IF MDID=MDIDSTRUCT THEN
+45540 DBLOCK(MDSTRFMD)
+45550 ELSE OFFSET := OFFSET+MDLEN
+45560 END;
+45570 PROCEDURE DBLOCKM(M: MODE);
+45580 VAR I: INTEGER; X: XTYPE;
+45590 BEGIN WITH M^ DO
+45600 FOR I := 0 TO MDV.MDCNT-1 DO
+45610 WITH MDSTRFLDS[I] DO
+45620 BEGIN X := TX(MDSTRFMD);
+45630 IF X=12 THEN DBLOCKM(MDSTRFMD)
+45640 ELSE EMITXWORD(OCVIMMED, X+1)
+45650 END
+45660 END;
+45670 BEGIN WITH M^ DO
+45680 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD)
+45690 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+45700 BEGIN
+45710 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*)
+45720 BEGIN
+45730 IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; MDSTRSDB := FIXUPM;
+45740 EMITXWORD(OCVIMMED, MDV.MDLEN);
+45750 OFFSET := 0; DBLOCK(M);
+45760 EMITXWORD(OCVIMMED, -1);
+45770 DBLOCKM(M);
+45780 END;
+45790 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB
+45800 END
+45810 ELSE IF MDV.MDDRESSED THEN
+45820 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMPTR END
+45830 ELSE
+45840 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMPTR END;
+45850 END;
+45860 (**)
+45870 (**)
+45880 ()+02*)
+45890 (*+01()
+45900 (**)
+45910 PROCEDURE EMITBEG;
+45920 VAR I: INTEGER;
+45930 TEMP: PLEX;
+45940 BEGIN
+45950 NEXTLABEL := 1;
+45960 REWRITE(LGO);
+45970 (*-23()
+45980 WITH XSEG DO
+45990 BEGIN
+46000 BUFFER[3].ALFWORD := DAT; BUFFER[4].ALFWORD := TIM;
+46010 (*WITH BUFFER[16] DO (*THIS WAS INTENDED TO IMPLEMENT THE SPACE PRAGMAT, BUT IT DOESN'T WORK
+46020 BEGIN ALFWORD := ' :::'; CODEWORD := CODEWORD+WORDS END; *)
+46030 FOR I := 1 TO BUFFER[0].CODEWORD DO
+46040 WRITE(LGO, BUFFER[I].CODEWORD);
+46050 END;
+46060 NEW(TPFCHAIN); TPFCHAIN^.LINK := NIL;
+46070 WITH XSEG DO
+46080 BEGIN
+46090 FIRST := 0; LAST := 0; SEGLOC := 0;
+46100 BUFFER[FIRST].CODEWORD := 0; RELOCATION := 0;
+46110 FOUR := 1; FIFTEEN := 1;
+46120 BUFFER[LAST+FIFTEEN].CODEWORD := 0;
+46130 HEADERWORD.WORD := 40000020000001000000B
+46140 END;
+46150 ENEW(TEMP,LEX1SIZE+5);
+46160 TEMP^.S10 := 'PDERR '; (* ENTRY POINT FOR PASCAL DETECTED ERRORS *)
+46170 EMITX1(PJMP, OCVEXT, ORD(TEMP));
+46180 EMITX1(PJMP, OCVIMMED, OUTPUTEFET);
+46190 EMITXWORD(OCVIMMED,01414320221707000000B); EMITXWORD(OCVIMMED,0);
+46200 TEMP^.S10 := 'P.INIT ';
+46210 EMITX1 (PPBEGIN,OCVEXT,ORD(TEMP));
+46220 EDISPOSE(TEMP,LEX1SIZE+5);
+46230 ()-23*)
+46240 WITH ROUTNL^ DO BEGIN
+46250 RNPROCBLK := GETNEXTLABEL;
+46260 EMITX1 (PPBEGIN+1,OCVFIM,RNPROCBLK) END
+46270 END;
+46280 (**)
+46290 (**)
+46300 PROCEDURE EMITEND;
+46310 VAR I: INTEGER;
+46320 BEGIN
+46330 FIXUPFIM(ROUTNL^.RNPROCBLK,ROUTNL^.RNLENIDS+SIZIBTOP+SZWORD+FIRSTIBOFFSET);
+46340 EMITOP (PPEND);
+46350 (*-23()
+46360 UPPER; WHILE XSEG.FIFTEEN<>1 DO EMITXWORD( OCVIMMED, 0);
+46370 WITH XSEG DO WITH HEADERWORD DO
+46380 WHILE FIRST<>LAST DO
+46390 BEGIN
+46400 WRITE(LGO, WORD);
+46410 FOR I := FIRST TO FIRST+15 DO
+46420 WRITE(LGO, BUFFER[I].CODEWORD);
+46430 FIRST := (FIRST+16) MOD 128; S := S+15
+46440 END;
+46450 FOR I := PNONE TO PLAST DO
+46460 WITH CODETABLE[I] DO IF NOT INLINE THEN IF LINKINS<>NIL THEN PUTLINK(I);
+46470 ()-23*)
+46480 END;
+46490 (**)
+46500 (**)
+46510 FUNCTION EMITRTNHEAD: LABL;
+46520 BEGIN EMITRTNHEAD := FIXUPM END;
+46530 ()+01*)
+46540 (**)
+46550 (**)
+46560 (*-01() (*-02() (*-05()
+46570 (*MODEL EMITBEG AND EMITEND FOR THOSE WHO HAVE NOT WRITTEN THEIR OWN YET*)
+46580 PROCEDURE EMITBEG;
+46590 BEGIN
+46600 NEXTLABEL := 1;
+46610 REWRITE(LGO);
+46620 (*NOW INITIALIZE YOUR CODE BUFFER, OR WHATEVER, AND EMIT INIAL CODE*)
+46630 END;
+46640 (**)
+46650 (**)
+46660 PROCEDURE EMITEND;
+46670 BEGIN
+46680 (*EMIT YOUR FINAL CODE*)
+46690 (*FLUSH YOUR CODE BUFFER, OR WHATEVER*)
+46700 END;
+46710 ()-05*) ()-02*) ()-01*)
+46720 (**)
+46730 (**)
+47110 (*-02() (*-05()
+47120 (**)
+47130 PROCEDURE GENDP(M: MODE);
+47140 (*FUNCTION: RETURNS THE ADDRESS OF THE DBLOCK FOR MODE M, OR THE VALULENGTH,
+47150 IN GLOBAL VARIABLE GENDPVAL, WITH CORRESPONDING OPDTYP IN GENDPOCV.
+47160 *)
+47170 VAR JUMPOVER: LABL;
+47180 OFFSET: 0..127;
+47190 PROCEDURE DBLOCK(M: MODE);
+47200 VAR I, J: INTEGER;
+47210 BEGIN WITH M^ DO
+47220 FOR I := 0 TO MDV.MDCNT-1 DO
+47230 WITH MDSTRFLDS[I] DO WITH MDSTRFMD^.MDV DO
+47240 IF MDDRESSED THEN
+47250 BEGIN EMITXWORD(OCVIMMED, OFFSET); OFFSET := OFFSET+MDLEN END
+47260 ELSE IF MDID=MDIDSTRUCT THEN
+47270 DBLOCK(MDSTRFMD)
+47280 ELSE OFFSET := OFFSET+MDLEN
+47290 END;
+47300 PROCEDURE DBLOCKM(M: MODE);
+47310 VAR I: INTEGER; X: XTYPE;
+47320 BEGIN WITH M^ DO
+47330 FOR I := 0 TO MDV.MDCNT-1 DO
+47340 WITH MDSTRFLDS[I] DO
+47350 BEGIN X := TX(MDSTRFMD);
+47360 IF X=12 THEN DBLOCKM(MDSTRFMD)
+47370 ELSE EMITXWORD(OCVIMMED, X+1)
+47380 END
+47390 END;
+47400 BEGIN WITH M^ DO
+47410 IF MDV.MDID=MDIDROW THEN GENDP(MDPRRMD)
+47420 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+47430 BEGIN
+47440 IF MDSTRSDB=0 THEN (*DBLOCK MUST BE CREATED*)
+47450 BEGIN
+47460 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER);
+47470 MDSTRSDB := FIXUPM;
+47480 EMITXWORD(OCVIMMED, MDV.MDLEN);
+47490 OFFSET := 0; DBLOCK(M);
+47500 EMITXWORD(OCVIMMED, -1);
+47510 DBLOCKM(M);
+47520 FIXUPF(JUMPOVER)
+47530 END;
+47540 GENDPOCV := OCVMEM; GENDPVAL :=MDSTRSDB
+47550 END
+47560 ELSE IF MDV.MDDRESSED THEN
+47570 BEGIN GENDPVAL:=0; GENDPOCV:=OCVIMMED END
+47580 ELSE
+47590 BEGIN GENDPVAL := MDV.MDLEN; GENDPOCV := OCVIMMED END
+47600 END;
+47610 (**)
+47620 ()-05*) ()-02*)
+47630 (**)
+47640 FUNCTION GETCASE(M: MODE; OLST: OLSTTYP; SB: PSB): STATE;
+47650 (*FUNCTION: COMPUTES AN ADDITION TO SOME OPCOD.
+47660 THE SB HERE AND IN RELATED PLACES IS A TEMPORARY KLUDGE ??????
+47670 *)
+47680 VAR WHICH: STATE;
+47690 WEAKREF: BOOLEAN;
+47700 BEGIN WITH M^ DO
+47710 BEGIN
+47720 IF SB<>NIL THEN WEAKREF:=(SBWEAKREF IN SB^.SBINF) ELSE WEAKREF:=FALSE;
+47730 IF NOT MDV.MDPILE THEN
+47740 IF MDV.MDLEN=SZINT THEN WHICH := 0 ELSE WHICH := 1
+47750 ELSE IF WEAKREF THEN WHICH:=2
+47760 ELSE IF MDV.MDID=MDIDROW THEN WHICH:=3
+47770 ELSE IF MDV.MDDRESSED THEN WHICH:=4
+47780 ELSE WHICH:=5;
+47790 NEEDDP := OLST[WHICH].DP;
+47800 GETCASE := OLST[WHICH].OVAL
+47810 END
+47820 END;
+47830 (**)
+47840 (**)
+47850 PROCEDURE GENOP(VAR OPCOD: POP; M: MODE; VAR OLIST: OLSTTYP; SB: PSB);
+47860 (*USES GETCASE TO MODIFY OPCOD AND DOES GENDP IF NECESSARY*)
+47870 BEGIN
+47880 OPCOD := OPCOD+GETCASE(M, OLIST, SB);
+47890 IF NEEDDP THEN
+47900 BEGIN
+47910 IF SB<>NIL THEN
+47920 IF SBWEAKREF IN SB^.SBINF THEN M := M^.MDPRRMD;
+47930 GENDP(M);
+47940 END
+47950 ELSE BEGIN GENDPOCV:=OCVNONE; GENDPVAL:=0 END
+47960 END;
+47970 (**)
+47980 (**)
+47990 FUNCTION GENLCLGBL (*+05() (VAR OPCOD: POP; SB: PSB):INTEGER ()+05*) ;
+48000 VAR I,X: INTEGER;
+48010 VP : SBTTYP;
+48030 BEGIN WITH SB^ DO
+48040 BEGIN
+48050 (*-41() GENLCLGBL:=SBOFFSET; ()-41*)
+48060 (*+41() GENLCLGBL:=-SBOFFSET; ()+41*)
+48062 LCLGBL := 0;
+48070 IF (SBLEVEL = 0) (*+05() AND (SBLEVEL<>ROUTNL^.RNLEVEL) ()+05*) THEN (*GLOBAL*)
+48080 BEGIN X:=1;
+48086 (*-05() (*-41() GENLCLGBL:=SBOFFSET+FIRSTIBOFFSET; ()-41*)
+48087 (*+41() GENLCLGBL:=-(SBOFFSET+FIRSTIBOFFSET); ()+41*) ()-05*)
+48090 (*+05() GENLCLGBL:=256-SBOFFSET ()+05*) END
+48100 ELSE
+48110 BEGIN
+48120 IF SBLEVEL=ROUTNL^.RNLEVEL THEN(*LOCAL*) X:=0
+48130 ELSE
+48140 BEGIN (*INTERMEDIATE*)
+48150 X:=2;
+48152 LCLGBL := ROUTNL^.RNLEVEL-SBLEVEL;
+48240 END
+48250 END;
+48260 OPCOD := OPCOD+X;
+48270 END
+48280 END;
+48290 (**)
+48300 (**)
+48310 (*-02() (*-05()
+48320 PROCEDURE GENDENOT (* (OPCOD: POP; SB: PSB) *) ;
+48330 VAR THING: OBJECT; I: INTEGER;
+48340 JUMPOVER: LABL;
+48350 BEGIN WITH SB^ DO
+48360 WITH SBLEX^ (*A LEXEME*) DO
+48370 IF SBMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC] THEN
+48380 EMITX1(OPCOD, OCVEXT, ORD(SBLEX))
+48390 ELSE IF SBLEX=LEXFALSE THEN
+48400 EMITX1(OPCOD, OCVIMMED, 0)
+48410 ELSE IF ((LXDENMD=MDINT) OR (LXDENMD=MDBITS) OR (LXDENMD=MDCHAR))
+48420 (*+01() AND (LXDENRP<400000B) ()+01*) AND (LXTOKEN=TKDENOT) THEN
+48430 EMITX1(OPCOD, OCVIMMED, LXDENRP)
+48440 ELSE
+48450 BEGIN
+48460 IF LXV.LXPYPTR=0 THEN
+48470 BEGIN
+48480 JUMPOVER := GETNEXTLABEL; EMITX1(PJMP, OCVFREF, JUMPOVER);
+48490 LXV.LXPYPTR := FIXUPM;
+48500 IF SBLEX=LEXTRUE THEN
+48510 EMITXWORD(OCVIMMED, TRUEVALUE)
+48520 ELSE IF LXDENMD^.MDV.MDPILE THEN WITH THING DO
+48530 BEGIN FIRSTWORD := 0; PCOUNT := 255;
+48540 LENGTH := (*-04() LXDENRP; ()-04*)(*+04() SHRINK(LXDENRP); ()+04*)
+48550 EMITXWORD(OCVIMMED, FIRSTWORD);
+48560 FOR I := 3 TO LXCOUNT DO
+48570 EMITXWORD(OCVIMMED, INTEGERS[I])
+48580 END
+48590 ELSE EMITXWORD(OCVIMMED, LXDENRP);
+48600 FIXUPF(JUMPOVER)
+48610 END;
+48620 IF LXTOKEN=TKDENOT THEN (*NOT LEXTRUE*)
+48630 IF LXDENMD^.MDV.MDPILE THEN OPCOD := OPCOD-1;
+48640 EMITX1(OPCOD+1, OCVMEM, LXV.LXPYPTR)
+48650 END
+48660 END;
+48670 ()-05*) ()-02*)
+48680 ()+87*)
--- /dev/null
+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*)
--- /dev/null
+00100 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+00110 (**)
+00140 (*-87() (*EXTERNALS TO CODE EMITTER*)
+00144 (**)
+00150 PROCEDURE FIXUPF(ALABL: LABL); EXTERN;
+00152 FUNCTION FIXUPM:LABL; EXTERN;
+00160 PROCEDURE EMITX1 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT); EXTERN;
+00170 PROCEDURE EMITX2 (OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT); EXTERN;
+00180 PROCEDURE EMITX3(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;TYP3:OPDTYP;OPND3:ADDRINT); EXTERN;
+00190 PROCEDURE EMITX4(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;
+00200 TYP3:OPDTYP;OPND3:ADDRINT;TYP4:OPDTYP;OPND4:ADDRINT); EXTERN;
+00210 (*+86() (*FOR CODE GENERATOR ONLY*)
+00212 PROCEDURE SETTEXTSTATE; EXTERN;
+00220 PROCEDURE EMITX5(OPCOD:POP;TYP1:OPDTYP;OPND1:ADDRINT;TYP2:OPDTYP;OPND2:ADDRINT;TYP3:OPDTYP;OPND3:ADDRINT;
+00230 TYP4:OPDTYP;OPND4:ADDRINT;TYP5:OPDTYP;OPND5:ADDRINT); EXTERN;
+00240 PROCEDURE EMITX0(OPCOD: POP); EXTERN;
+00250 (*+02()
+00260 PROCEDURE WRITEBYTE(BYT: BYTE); EXTERN;
+00270 ()+02*)
+00280 PROCEDURE EMITXWORD(TYP: OPDTYP; OPERAND: ADDRINT); EXTERN;
+00281 (*+02() PROCEDURE EMITXPROC(TYP :OPDTYP; OPERAND :ADDRINT); EXTERN;
+00282 PROCEDURE EMITRNTAIL(LEN :INTEGER); EXTERN;
+00283 FUNCTION LENOF(SB :PSB) :INTEGER; EXTERN; ()+02*)
+00284 (*+05() PROCEDURE EMITXPROC(TYP: OPDTYP; OPERAND: ADDRINT); EXTERN; ()+05*)
+00290 PROCEDURE EMITALF(OPERAND: BIGALFA); EXTERN;
+00300 FUNCTION GETNEXTLABEL: LABL; EXTERN;
+00320 PROCEDURE FIXUPFIM(ALABL: LABL; VALUE: INTEGER); EXTERN;
+00330 PROCEDURE FIXLABL(OLDLABL,NEWLABL: LABL; KNOWN: BOOLEAN); EXTERN;
+00340 FUNCTION NORMAL(SB: PSB): SBTTYP; EXTERN;
+00360 PROCEDURE LOAD(WHERE:SBTTYP; SB: PSB); EXTERN;
+00364 PROCEDURE UNSTKP1(TYP: OPDTYP; OPND: PSB); EXTERN;
+00370 PROCEDURE EMITBEG; EXTERN;
+00372 FUNCTION EMITRTNHEAD: LABL; EXTERN;
+00380 PROCEDURE EMITEND; EXTERN;
+00400 FUNCTION GETCASE(M: MODE; OLST: OLSTTYP; SB: PSB): STATE; EXTERN;
+00410 FUNCTION GENLCLGBL(VAR OPCOD: POP; SB: PSB): INTEGER; EXTERN;
+00411 ()+86*)
+00412 (*+05()
+00413 PROCEDURE HOIST(HOISTLEN, LEN: INTEGER; ALIGN: BOOLEAN); EXTERN;
+00414 ()+05*)
+00420 PROCEDURE CLEAR(SB: PSB); EXTERN;
+00430 PROCEDURE FILL(WHERE: SBTTYP; SB: PSB); EXTERN;
+00440 PROCEDURE TWIST; EXTERN;
+00450 PROCEDURE LOADSTK(SB: PSB); EXTERN;
+00460 PROCEDURE GENOP(VAR OPCOD: POP; M: MODE; VAR OLIST: OLSTTYP; SB: PSB); EXTERN;
+00470 PROCEDURE GENDP(M: MODE); EXTERN;
+00472 (*+32() PROCEDURE ASERT(ASERTION: BOOLEAN; REASON:ALFA); EXTERN; ()+32*)
+00480 ()-87*)
+00490 (**)
+00520 (*+04()
+00530 MODULE A68S1;
+00540 EXPORTS
+00550 PROCEDURE S1;
+00560 PRIVATE
+00570 IMPORTS A68SCOM FROM A68DEC;
+00580 ()+04*)
+12000 (* EXTERNALS TO THE LEXICAL ANALYSER *)
+12002 PROCEDURE FIND(VAR SEARCHLIST: MODE; RECURSIVE: BOOLEAN; LENGTH: CNTR); EXTERN;
+12010 PROCEDURE FINDPRC(RESMD: MODE; CNT: CNTR; CP:CODEPROC); EXTERN;
+12020 PROCEDURE FINSTRUCT(CNT: CNTR); EXTERN;
+12030 FUNCTION FINDREF(M: MODE): MODE; EXTERN;
+12040 FUNCTION FINDROW(M: MODE; CNT:CNTR): MODE; EXTERN;
+12050 PROCEDURE NEWFIELD(LEX: PLEX); EXTERN;
+12060 PROCEDURE RECURFIX(VAR BASEM: MODE); EXTERN;
+12090 (*+05() PROCEDURE OPENLOADFILE(VAR F: LOADFILE; PARAM: INTEGER; WRITING: BOOLEAN); EXTERN;
+12100 PROCEDURE OPENTEXT(VAR F: TEXT; PARAM: INTEGER; WRITING: BOOLEAN); EXTERN;
+12110 ()+05*)
+12120 PROCEDURE CHECKPAGE; EXTERN;
+12130 PROCEDURE OUTLST(LINE: INTEGER; VAR BUF: BUFFER; PTR: INTEGER); EXTERN;
+12140 PROCEDURE OUTERR(N: INTEGER; LEV: ERRLEV; LEX: PLEX); EXTERN;
+12150 PROCEDURE SEMERR(N: INTEGER); EXTERN;
+12160 PROCEDURE INITIO; EXTERN;
+12170 PROCEDURE SEMERRP(N: INTEGER; LEX: PLEX); EXTERN;
+12180 PROCEDURE SUBREST; EXTERN;
+12190 PROCEDURE SUBSAVE; EXTERN;
+12200 PROCEDURE SCPUSH(M: MODE); EXTERN;
+12210 FUNCTION SCPOP: MODE; EXTERN;
+12220 FUNCTION SRPOPMD: MODE; EXTERN;
+12230 PROCEDURE MODERR(M: MODE; N: INTEGER); EXTERN;
+12240 FUNCTION HASHIN: PLEX; EXTERN;
+12270 PROCEDURE INITLX; EXTERN;
+12280 PROCEDURE NEXTCH(LEVEL: INDEXTYPE); EXTERN;
+12290 PROCEDURE LXERR(N: INTEGER); EXTERN;
+12300 PROCEDURE LEXALF(LEX: PLEX; VAR ALF: ALFA); EXTERN;
+12310 FUNCTION PARSIN: PLEX; EXTERN;
+18808 (**)
+18810 (*-86() (*EXTERNALS TO CODE GENERATOR*)
+18811 (**)
+18812 PROCEDURE STACKSB (SB:PSB); EXTERN;
+18814 PROCEDURE UNSTACKSB ; EXTERN;
+18816 (*+05() FUNCTION SUBSTLEN(SBTS: SBTTYPSET): INTEGER; EXTERN; ()+05*)
+18820 (*+85() (*FOR SEMANTIC ROUTINES ONLY*)
+18840 PROCEDURE CGRTE(R: PROUTN); EXTERN;
+18850 PROCEDURE CGOPAB(OPCOD: POP; RESMODE: MODE); EXTERN;
+18860 PROCEDURE CGRGID(STB: PSTB); EXTERN;
+18870 PROCEDURE CGRGN; EXTERN;
+18880 PROCEDURE CGRGXA(LOCRNG: BOOLEAN); EXTERN;
+18890 PROCEDURE CGOPCALL; EXTERN;
+18900 PROCEDURE CGOPDA; EXTERN;
+18910 PROCEDURE CGOPDC; EXTERN;
+18920 PROCEDURE CGOPDD; EXTERN;
+18930 PROCEDURE CGOPDE(SBLH: PSB); EXTERN;
+18940 PROCEDURE CGLABA(P: PSTB); EXTERN;
+18950 PROCEDURE CGLABB(P: PSTB; WHICH: INTEGER); EXTERN;
+18960 PROCEDURE CGLABC(P: PSTB; WHICH: INTEGER); EXTERN;
+18970 PROCEDURE CGLABD(P: PSTB); EXTERN;
+18980 PROCEDURE CGLABE(P: PSTB; LEVEL: DEPTHR; LEB: OFFSETR); EXTERN;
+18990 ()+85*)
+19000 (*+84() (*FOR MODE HANDLING ONLY*)
+19010 PROCEDURE GENFLAD; EXTERN;
+19020 PROCEDURE STARTCHAIN; EXTERN;
+19030 PROCEDURE COMBINE; EXTERN;
+19040 PROCEDURE LOADTOTAL(SB: PSB); EXTERN;
+19050 PROCEDURE CGBALC; EXTERN;
+19060 PROCEDURE SETTEXTSTATE; EXTERN;
+19070 ()+84*)
+19080 (*+83() (*FOR SEMANTICROUTINE ONLY*)
+19090 PROCEDURE CGRTB; EXTERN;
+19100 PROCEDURE CGRTD(PROCPTR: LABL); EXTERN;
+19110 PROCEDURE CGRTA; EXTERN;
+19120 PROCEDURE CGRTC; EXTERN;
+19130 PROCEDURE CGLEFTCOLL(SB: PSB); EXTERN;
+19140 PROCEDURE CGLEAPGEN(HEAP: BOOLEAN); EXTERN;
+19150 PROCEDURE CGLPA(SB: PSB); EXTERN;
+19160 PROCEDURE CGLPB(SB: PSB); EXTERN;
+19170 PROCEDURE CGLPC(SB: PSB); EXTERN;
+19180 PROCEDURE CGLPD; EXTERN;
+19190 PROCEDURE CGLPE; EXTERN;
+19210 PROCEDURE CGIFA; EXTERN;
+19220 PROCEDURE CGINIT; EXTERN;
+19230 PROCEDURE CGDEST; EXTERN;
+19240 PROCEDURE CGFINCOLL(DEPTH: INTEGER); EXTERN;
+19250 PROCEDURE CGACTBNDS(SB:PSB; N: CNTR); EXTERN;
+19260 PROCEDURE CGASSIGN; EXTERN;
+19270 PROCEDURE CGCALL(SB, SBR: PSB); EXTERN;
+19280 PROCEDURE CGCASA; EXTERN;
+19290 PROCEDURE CGCASC; EXTERN;
+19300 PROCEDURE MARK(L: LABL); EXTERN;
+19310 PROCEDURE CGCOLLUNIT; EXTERN;
+19312 PROCEDURE CGPARM(VAR PTR:PSTB); EXTERN;
+19320 PROCEDURE CGSELECT(OFFST: OFFSETR; M: MODE; SECDRY: INTEGER); EXTERN;
+19330 PROCEDURE CGSLICE(SB: PSB; REFED: BOOLEAN); EXTERN;
+19340 PROCEDURE CGEND; EXTERN;
+19350 ()+83*)
+19360 FUNCTION PUSHSB (PARAM:MODE) :PSB; EXTERN;
+19370 PROCEDURE ASSIGNFLAD; EXTERN;
+19380 PROCEDURE POPUNITS; EXTERN;
+19390 PROCEDURE GETTOTAL(SB: PSB); EXTERN;
+19400 PROCEDURE CGFIRM; EXTERN;
+19430 PROCEDURE BRKASCR; EXTERN;
+19440 PROCEDURE CGDEPROC (SB:PSB); EXTERN;
+19442 PROCEDURE CGFIXRG; EXTERN;
+19450 PROCEDURE CGFLADJUMP; EXTERN;
+19460 PROCEDURE CGIBAL; EXTERN;
+19470 PROCEDURE CGLPG; EXTERN;
+19480 PROCEDURE CGOPR(OPCOD: POP; RESMODE: MODE; DYADIC: BOOLEAN); EXTERN;
+19482 PROCEDURE CGPASC(SB, SBR: PSB); EXTERN;
+19490 PROCEDURE CGRGXB(SB: PSB); EXTERN;
+19492 PROCEDURE CGFLINE; EXTERN;
+19500 ()-86*)
+19506 (**)
+19507 (*-84() (*EXTERNALS FOR MODE HANDLING*)
+19508 (**)
+19509 FUNCTION TX(M: MODE): XTYPE; EXTERN;
+19510 FUNCTION COERCE(M:MODE):MODE; EXTERN;
+29500 FUNCTION LENGTHEN(M: MODE; COUNT: INTEGER): MODE; EXTERN;
+29502 FUNCTION COFIRM(SRCM,DSTM: MODE): MODE; EXTERN;
+29504 FUNCTION COMEEK(SRCM: MODE): MODE; EXTERN;
+29510 (*+85() (*FOR SEMANTIC ROUTINES ONLY*)
+29530 PROCEDURE GETOPDM(PROCM: MODE); EXTERN;
+29540 ()+85*)
+29550 FUNCTION BALMOIDS(M1, M2: MODE): MODE; EXTERN;
+29560 FUNCTION BALANCE(STRENGTH: STRTYP): MODE; EXTERN;
+29570 FUNCTION SOFT: MODE; EXTERN;
+29580 FUNCTION WEAK: MODE; EXTERN;
+29590 PROCEDURE STRONG; EXTERN;
+29600 PROCEDURE SETBALFLAG; EXTERN;
+29610 PROCEDURE INNERBAL; EXTERN;
+29620 PROCEDURE LASTIBAL; EXTERN;
+29630 PROCEDURE MEEKLOAD(M: MODE; ERR: INTEGER); EXTERN;
+29640 FUNCTION FIRMBAL:MODE; EXTERN;
+50010 FUNCTION MEEK: MODE; EXTERN;
+50012 ()-84*)
+50018 (**)
+50020 (*-85() (*EXTERNALS FOR SEMANTIC ROUTINES*)
+50022 (**)
+50030 (*+83() (*FOR SEMANTICROUTINE ONLY*)
+50040 FUNCTION MAKESUBSTACK(N: INTEGER; M:MODE):PSB; EXTERN;
+50050 FUNCTION ALLOC(N: OFFSETR): OFFSETR; EXTERN;
+50052 PROCEDURE DISALLOCIND; EXTERN;
+50060 PROCEDURE RANGENT; EXTERN;
+50070 PROCEDURE ROUTNNT; EXTERN;
+50080 PROCEDURE NECENV(STB: PSTB); EXTERN;
+50090 PROCEDURE RANGEXT; EXTERN;
+50100 PROCEDURE ROUTNXT; EXTERN;
+50110 FUNCTION GETSTB(LEX: PLEX; DEF: DEFTYP; BLK: BLKTYP):PSTB; EXTERN;
+50120 PROCEDURE FILLSTB(STB: PSTB); EXTERN;
+50130 FUNCTION APPLAB(LEX: PLEX): PSTB; EXTERN;
+50140 FUNCTION APPID(LEX: PLEX): PSTB; EXTERN;
+50150 PROCEDURE DEFMI(LEX: PLEX); EXTERN;
+50160 PROCEDURE DEFPRIO(LEX,PRIO: PLEX); EXTERN;
+50170 PROCEDURE DEFLAB(LEX: PLEX); EXTERN;
+50180 PROCEDURE PUTIND(STB: PSTB); EXTERN;
+50190 PROCEDURE PUTDEN(LEX: PLEX); EXTERN;
+50200 PROCEDURE PUTLOOP(LEX: PLEX); EXTERN;
+50210 PROCEDURE ELABMI(LEX: PLEX); EXTERN;
+50220 PROCEDURE PARMSC; EXTERN;
+50230 PROCEDURE OPDSAVE(M: MODE); EXTERN;
+50240 PROCEDURE BALOPR; EXTERN;
+50250 PROCEDURE LHOPBAL(M: MODE); EXTERN;
+50260 PROCEDURE PUTMD(LHM,RHM: MODE); EXTERN;
+50270 PROCEDURE OPIDENT(MONADIC: BOOLEAN); EXTERN;
+50280 PROCEDURE DEFOPM(OP: PSTB; M: MODE); EXTERN;
+50290 PROCEDURE COLLSC(SB: PSB); EXTERN;
+50300 PROCEDURE DEFID(LEX: PLEX); EXTERN;
+50310 PROCEDURE DEFOP(LEX: PLEX); EXTERN;
+50320 ()+83*)
+50322 (*+82() (*FOR PARSER ONLY*)
+50324 PROCEDURE INITSR; EXTERN;
+50326 FUNCTION APPMI(LEX: PLEX): PSTB; EXTERN;
+50328 ()+82*)
+50330 ()-85*)
+50332 (**)
+71290 (*-83() (*+82()
+71292 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE); EXTERN;
+71294 (*+21() PROCEDURE MONITORSEMANTIC(SRTN: RTNTYPE); EXTERN; ()+21*)
+71296 ()+82*) ()-83*)
+73918 (**)
--- /dev/null
+12330 (*+81()
+12340 (**)
+12350 (*+04()
+12360 FUNCTION FLOAT(N: A68INT): REAL;
+12370 BEGIN FLOAT := SHRINK(N) (*THIS IS SLOPPY*) END;
+12380 ()+04*)
+12390 (*+25() (*+31() (*$P+ +) ()+31+) ()+25*)
+12400 (**)
+12410 (**)
+12420 (*LISTING*)
+12430 (*********)
+12440 (**)
+12450 (*+05()
+12460 PROCEDURE OPENLOADFILE(VAR F: LOADFILE; PARAM: INTEGER; WRITING: BOOLEAN);
+12470 VAR S: ARGSTRING;
+12480 PROCEDURE NAMEFILE(S: ARGSTRING; SU, SL: INTEGER; VAR F: ANYFILE); EXTERN;
+12490 FUNCTION GETARG(VAR S: ARGSTRING; SU, SL: INTEGER; I: INTEGER): BOOLEAN; EXTERN;
+12500 BEGIN
+12510 IF GETARG(S, 50 ,1, PARAM) THEN
+12520 NAMEFILE(S, 50, 1, F);
+12530 IF WRITING THEN REWRITE(F) ELSE RESET(F);
+12540 END;
+12550 PROCEDURE OPENTEXT(VAR F: TEXT; PARAM: INTEGER; WRITING: BOOLEAN);
+12560 VAR S: ARGSTRING;
+12570 PROCEDURE NAMEFILE(S: ARGSTRING; SU, SL: INTEGER; VAR F: ANYFILE); EXTERN;
+12580 FUNCTION GETARG(VAR S: ARGSTRING; SU, SL: INTEGER; I: INTEGER): BOOLEAN; EXTERN;
+12590 BEGIN
+12600 IF GETARG(S, 50, 1, PARAM) THEN
+12610 NAMEFILE(S, 50, 1, F);
+12620 IF WRITING THEN REWRITE(F) ELSE RESET(F);
+12630 END;
+12632 FUNCTION TIME: INTEGER; EXTERN;
+12634 PROCEDURE CTIME(VAR RESULT: TIMSTRING; SU, SL: INTEGER; CLOCK: INTEGER); EXTERN;
+12640 ()+05*)
+12650 (**)
+12660 (**)
+12670 PROCEDURE CHECKPAGE;
+12680 (*STARTS NEW PAGE IF LISTING IN PROGRESS AND OLD PAGE
+12690 EXHAUSTED*)
+12700 BEGIN
+12710 IF LSTCNT>LINESPERPAGE THEN
+12720 BEGIN
+12730 LSTCNT := 0;
+12740 IF PRGLIST IN PRAGFLGS THEN
+12750 BEGIN
+12760 LSTPAGE := LSTPAGE+1;
+12770 IF ONLINE THEN
+12780 BEGIN
+12782 (*-01() IF LSTPAGE<>1 THEN PAGE(LSTFILE); ()-01*)
+12790 WRITELN(LSTFILE, (*+01()'1',()+01*)
+12800 'ALGOL68S COMPILER ',VERSIONNUM,
+12810 (*-04() (*-02() (*-05()DAT, ' ',()-05*) TIM, ()-02*) ()-04*) ' PAGE ', LSTPAGE:3);
+12820 WRITELN(LSTFILE (*+01(),' '()+01*));
+12830 END
+12840 (*-02() (*-04() (*-05()
+12850 ELSE (*BATCH*)
+12860 BEGIN
+12862 (*-01() IF LSTPAGE<>1 THEN PAGE(LSTFILE); ()-01*)
+12870 WRITELN(OUTPUT, (*+01()'1',()+01*)
+12880 'ALGOL68S COMPILER ',VERSIONNUM,
+12890 DAT, ' ', TIM, ' PAGE ', LSTPAGE:3);
+12900 WRITELN(OUTPUT, ' ');
+12910 END
+12920 ()-05*) ()-04*) ()-02*)
+12930 END
+12940 END;
+12950 END;
+12960 (**)
+12970 (**)
+12980 PROCEDURE INITIO;
+12990 (*+01() VAR AW66: PW66; ()+01*)
+13000 (*+05() TYPE STRING = PACKED ARRAY [1..12] OF CHAR;
+13010 VAR S: STRING;
+13020 ()+05*)
+13030 BEGIN
+13040 ERRDEV := FALSE;
+13050 (*+23() NUMPARAMS:=0; (* TO COUNT NO OF P-OP PARAMETERS OUTPUT TO LSTFILE *) ()+23*)
+13060 LSTLINE := -1; (*FOR FIRST TIME OF OUTSRC*)
+13070 LSTCNT := 100; (*TO FORCE NEWPAGE*)
+13080 LSTPAGE := 0;
+13090 (*-03() (*-04() (*-05()
+13100 RESET(SOURCDECS);
+13110 REWRITE(LSTFILE);
+13120 ()-05*) ()-04*) ()-03*)
+13130 (*+03()
+13140 WRITE('SOURCE-FILE: ');
+13150 OPEN(SOURCDECS,'','SYMB',SEQRD);
+13160 WRITE('LIST-FILE: ');
+13170 OPEN(LSTFILE,'','DATA',SEQWR);
+13180 OPEN(OUTPUT,'TERMINAL','SYMB',SEQWR);
+13190 ()+03*)
+13200 (*+04()
+13210 RESET(SOURCDECS, 'SOURCDECS');
+13220 REWRITE(OUTPUT, 'CONSOLE');
+13230 REWRITE(LSTFILE, 'LSTFILE');
+13240 ()+04*)
+13250 (*+05()
+13260 OPENTEXT(SOURCDECS, 1, FALSE);
+13270 OPENTEXT(LSTFILE, 3, TRUE);
+13280 ()+05*)
+13290 SRCBUF[0] := ' '; (*IT WILL NEVER BE WRITTEN TO AGAIN*)
+13300 (*+01()
+13310 LINELIMIT(OUTPUT, 100000);
+13320 AW66 := ASPTR(66B);
+13330 ONLINE := AW66^.JOPR=3;
+13340 ()+01*)
+13350 (*+02() ONLINE := TRUE; ()+02*)
+13360 (*+03() ONLINE := FILENR(LSTFILE)<>1; ()+03*)
+13370 (*+04() ONLINE := TRUE; ()+04*)
+13380 (*+05() ONLINE := TRUE; ()+05*)
+13390 (*+01() DATE(DAT); TIME(TIM); ()+01*)
+13392 (*+03() DATE(DAT); TIME(TIM); ()+03*)
+13394 (*+05() CTIME(TIM, 26, 1, TIME); TIM[25] := CHR(0); ()+05*)
+13400 END;
+13410 (**)
+13420 (**)
+13430 PROCEDURE OUTLST(LINE: INTEGER; VAR BUF: BUFFER; PTR: INTEGER);
+13440 (*FUNCTION: SEND A SINGLE RECORD TO THE LISTING DEVICE (AND
+13450 POSSIBLY THE ERROR DEVICE AS WELL). THE PRAGMAT NOLIST MAY BE
+13460 USED TO SUPPRESS THE PRINTING OF THE LISTING. IN THIS CASE,
+13470 NO ACTION IS TAKEN UNLESS THE LINE IS BEING SENT TO THE ERROR
+13480 DEVICE. ERROR LINES ARE ALWAYS TRANSMITTED.
+13490 INPUTS:
+13500 LINE - THE LINE NUMBER; -VE IF NO NUMBER TO BE PRINTED
+13510 BUF - BUFFER CONTAINING THE LINE TO BE PRINTED; USUALLY
+13520 SRCBUF OR ERRBUF
+13530 PTR - NUMBER OF CHARACTERS IN BUF; USUALLY SRCPTR OR ERRPTR
+13540 GLOBALS:
+13550 PRAGFLGS
+13560 LSTCNT- THE NUMBER OF LINES ALREADY PRINTED ON THE CURRENT
+13570 PAGE
+13580 ERRDEV- TRUE IFF RECORD IS TO BE SENT TO ERROR DEVICE
+13590 SRCSTAT-THE VALUE OF SRCSTCH AT THE BEGINNING OF THE LINE
+13600 *)
+13610 VAR I: INTEGER;
+13620 BEGIN
+13630 IF ONLINE THEN
+13640 BEGIN
+13650 IF PRGLIST IN PRAGFLGS THEN
+13660 BEGIN
+13662 (*+01() WRITE(LSTFILE, ' '); ()+01*)
+13670 IF LINE>=0 THEN
+13680 WRITE(LSTFILE, SRCSTAT, ' ', LINE:5, ' ')
+13690 ELSE WRITE(LSTFILE, ' ');
+13700 FOR I := 0 TO PTR DO
+13710 WRITE(LSTFILE, BUF[I]);
+13720 WRITELN(LSTFILE);
+13730 LSTCNT := LSTCNT+1;
+13740 END;
+13750 IF ERRDEV THEN
+13760 BEGIN
+13770 IF LINE>=0 THEN
+13780 WRITE(OUTPUT, SRCSTAT, ' ', LINE:5, ' ')
+13790 ELSE WRITE(OUTPUT, ' ');
+13800 FOR I := 0 TO PTR DO
+13810 WRITE(OUTPUT, BUF[I]);
+13820 WRITELN(OUTPUT);
+13830 END
+13840 END
+13850 (*-02() (*-04() (*-05()
+13860 ELSE (*BATCH*)
+13870 IF ERRDEV OR (PRGLIST IN PRAGFLGS) THEN
+13880 BEGIN
+13882 (*+01() WRITE(LSTFILE, ' '); ()+01*)
+13890 IF LINE >=0 THEN
+13900 WRITE(OUTPUT, SRCSTAT, ' ', LINE:5, ' ')
+13910 ELSE WRITE(OUTPUT, ' ');
+13920 FOR I := 1 TO PTR DO
+13930 WRITE(OUTPUT, BUF[I]);
+13940 WRITELN(OUTPUT);
+13950 LSTCNT := LSTCNT+1
+13960 END;
+13970 ()-05*) ()-04*) ()-02*)
+13980 END;
+13990 (**)
+14000 (**)
+14010 (*ERROR HANDLING*)
+14020 (****************)
+14030 (**)
+14040 PROCEDURE OUTERR(N: INTEGER; LEV: ERRLEV; LEX: PLEX);
+14050 (*FUNCTION: OUTPUT ERROR MESSAGE AND WRITE CHARACTER TO
+14060 APPROPRIATE POSITION IN ERRBUF.
+14070 INPUTS:
+14080 N - IDENTIFIES MESSAGE TO BE PRINTED
+14090 LEV - INDICATES WARNING OR ERROR
+14100 GLOBALS:
+14110 ERRLXPTR - POINTS TO ERRBUF POSITION JUST BEFORE START OF
+14120 OFFENDING LEXEME
+14130 ERRDEV, ERRNONBLANK, ERRBUF, ERRS, LSTCNT, PRAGFLGS
+14140 *)
+14150 VAR I: INTEGER;
+14160 PROCEDURE PRINTLEX(VAR F: TEXT);
+14170 VAR I: INTEGER;
+14180 BEGIN WITH LEX^ DO
+14190 BEGIN
+14200 WRITE(F, ' - ');
+14210 CASE LXTOKEN OF
+14220 TKTAG: (*NOTHING*);
+14230 TKBOLD: WRITE(F, '.');
+14240 TKSYMBOL: WRITE(F, '''');
+14250 END;
+14260 FOR I := 1 TO LXCOUNT*CHARPERWORD DO
+14270 IF STRNG[I]<>' ' THEN WRITE(F, STRNG[I]);
+14280 IF LXTOKEN=TKSYMBOL THEN WRITE(F, '''');
+14290 END
+14300 END;
+14310 (**)
+14320 PROCEDURE ERRMSG(VAR F: TEXT);
+14330 BEGIN
+14340 WRITE(F, ' ');
+14350 CASE LEV OF
+14360 ERRORR: WRITE(F, 'ERROR ');
+14370 WARNING: WRITE(F, 'WARNING ')
+14380 END;
+14390 (*+55() WRITE(F,N:3); ()+55*)
+14400 (*-55()
+14410 CASE N OF
+14420 (*ELX*)
+14430 3: WRITE(F, 'MISSING CLOSE QUOTE IN STRING-DENOTATION');
+14440 4: WRITE(F, 'MISSING CLOSE-PRAGMENT-SYMBOL');
+14450 5: WRITE(F, 'ILLEGAL SYMBOL');
+14460 6: WRITE(F, 'ILL-FORMED DENOTATION');
+14470 7: WRITE(F, 'STRAY STROP MARK');
+14480 8: WRITE(F, 'ILLEGAL CHARACTER');
+14490 9: WRITE(F, 'IDENTIFIER OR STRING-DENOTATION TOO ',
+14500 'LONG, COMPLAIN TO CHL');
+14510 10: WRITE(F, 'DENOTATION OUT OF RANGE');
+14520 (*ESY*)
+14530 11: WRITE(F, 'MISSING UNIT (OR EXTRA ;)');
+14540 12: WRITE(F, 'DECLARER NOT FOUND WHERE EXPECTED');
+14550 13: WRITE(F, 'ILLEGAL FORM OF TRIMMER OR MISPLACED COLON');
+14560 14: WRITE(F, '.DO NOT FOUND WHERE EXPECTED');
+14570 15: WRITE(F, 'FIELD NOT SPECIFIED PROPERLY');
+14575 16: WRITE(F, 'MISMATCH AFTER ''[''');
+14580 17: WRITE(F, 'MISMATCH AFTER ''(''');
+14590 18: WRITE(F, 'END OF PROGRAM TEXT');
+14600 19: WRITE(F, 'MISSING LABEL-DECLARATION FOLLOWING .EXIT');
+14610 20: WRITE(F, 'MISSING = IN IDENTITY-DECLARATION');
+14620 21: WRITE(F, 'INCORRECT VARIABLE-DECLARATION');
+14630 22: WRITE(F, 'INCORRECT MODE-DECLARATION');
+14640 23: WRITE(F, '.GOTO NOT FOLLOWED BY LABEL');
+14650 24: WRITE(F, '.STRUCT NOT FOLLOWED BY ''(''');
+14660 25: WRITE(F, 'MISPLACED PROCEDURE-PLAN');
+14670 26: WRITE(F, 'MISSING DECLARER OR DENOTATION AFTER .LONG OR .SHORT');
+14680 27: WRITE(F, 'ILLEGAL BOUNDS IN FORMAL-DECLARER');
+14690 28: WRITE(F, 'FORMAL-PARAMETER NOT SPECIFIED PROPERLY');
+14700 29: WRITE(F, 'PARAMETER MODE NOT SPECIFIED PROPERLY');
+14710 30: WRITE(F, 'ACTUAL-BOUNDS NOT TERMINATED BY '','' OR '']''');
+14720 31: WRITE(F, 'ADDITIONAL TEXT FOLLOWS A COMPLETE PROGRAM');
+14730 32: WRITE(F, 'ILLEGAL ACTUAL-PARAMETER-LIST');
+14740 33: WRITE(F, 'MISSING COLON IN ROUTINE-TEXT');
+14750 34: WRITE(F, 'MISSING ;');
+14760 35: WRITE(F, 'MISPLACED COMMA OR MISSING COMMA');
+14770 36: WRITE(F, 'MISMATCH IN LOOP-CLAUSE');
+14780 37: WRITE(F, 'MISMATCH AFTER .BEGIN');
+14790 38: WRITE(F, 'MISMATCH IN CASE-CLAUSE');
+14800 39: WRITE(F, 'MISMATCH IN IF-CLAUSE');
+14810 40: WRITE(F, 'MISSING SEMICOLON AFTER DECLARATION');
+14820 41: WRITE(F, 'MISPLACED ACTUAL-DECLARER');
+14830 42: WRITE(F, 'LOOKS LIKE AN ILLEGAL DECLARATION');
+14840 43: WRITE(F, 'ILLEGAL UNIT IN THIS CONTEXT');
+14850 44: WRITE(F, 'ILLEGAL CONTEXT FOR DISPLAY IN ALGOL 68S');
+14860 45: WRITE(F, 'MODE IS ILLEGAL IN ALGOL 68S');
+14870 46: WRITE(F, 'MISSING IDENTIFIER AFTER .FOR');
+14880 47: WRITE(F, 'ILL-FORMED DISPLAY OR DATA-LIST');
+14890 48: WRITE(F, 'MISSING = IN OPERATION-DECLARATION');
+14900 49: WRITE(F, 'MISSING BOUNDS IN ACTUAL-DECLARER');
+14910 50: WRITE(F, 'INCORRECT PRIORITY-DECLARATION');
+14920 51: WRITE(F, 'MISSING = OR := IN ROUTINE-DECLARATION');
+14930 52: WRITE(F, 'ILLEGAL CASE-CLAUSE');
+14940 53: WRITE(F, 'PRIORITY MUST BE A DIGIT');
+14950 ()-55*)
+14960 (*+53()
+14970 END;
+14980 IF LEX<>NIL THEN PRINTLEX(F);
+14990 WRITELN(F);
+15000 END;
+15010 PROCEDURE ERRMSG2(VAR F: TEXT);
+15020 BEGIN
+15030 WRITE(F, ' ');
+15040 CASE LEV OF
+15050 ERRORR: WRITE(F, 'ERROR ');
+15060 WARNING: WRITE(F, 'WARNING ');
+15070 END;
+15080 (*+55() WRITE(F,N:3); ()+55*)
+15090 (*-55() CASE N OF ()-55*)
+15100 ()+53*)
+15110 (*ESE*)
+15120 (*-55()
+15130 61: WRITE(F, 'DUPLICATED FIELD-SELECTOR IN .STRUCT DECLARER');
+15140 62: WRITE(F, 'LABEL-DECLARATION IN ENQUIRY-CLAUSE');
+15150 63: WRITE(F, 'ILL-FORMED MODE IN MODE-DECLARATION');
+15160 64: WRITE(F, 'LABEL PRECEDES A DECLARATION IN CURRENT RANGE');
+15170 65: WRITE(F, 'LOCAL-GENERATOR MAY NOT PRECEDE FIRST DECLARATION OF RANGE IN ALGOL 68S');
+15180 66: WRITE(F, 'TOO MANY .SHORTS');
+15190 67: WRITE(F, 'LABEL ALREADY USED AS IDENTIFIER');
+15200 68: WRITE(F, 'IDENTIFIER ALREADY USED IN THIS REACH');
+15210 69: WRITE(F, 'IDENTIFIER ALREADY DECLARED');
+15220 70: WRITE(F, 'VALUE DISCARDED WITHOUT BEING USED');
+15230 71: WRITE(F, 'MODE-INDICATION ALREADY DECLARED');
+15240 72: WRITE(F, 'MODE-INDICATION ALREADY USED IN THIS REACH');
+15250 73: WRITE(F, 'LABEL ALREADY DECLARED');
+15260 74: WRITE(F, 'SCOPE VIOLATION');
+15270 75: WRITE(F, 'IDENTIFIER ALREADY USED AS LABEL');
+15280 76: WRITE(F, 'IDENTIFIER NOT DECLARED');
+15290 78: WRITE(F, 'DISPLAYS MUST BE IN STRONG NON-VOID POSITIONS');
+15300 79: WRITE(F, 'TOO MANY .LONGS');
+15310 80: WRITE(F, 'LEFT SIDE OF ASSIGNMENT IS NOT A VARIABLE');
+15320 81: WRITE(F, '.NIL OCCURS IN NON-REF CONTEXT');
+15330 82: WRITE(F, 'MONADIC-OPERATOR USED AS DYADIC-OPERATOR');
+15340 83: WRITE(F, 'UNSUITABLE OPERAND FOR MONADIC-OPERATOR');
+15350 84: WRITE(F, 'UNSUITABLE OPERANDS FOR DYADIC-OPERATOR');
+15360 85: WRITE(F, 'THE OBJECT CALLED IS NOT A .PROC');
+15370 86: WRITE(F, 'BALANCE CANNOT BE MADE IN A SOFT POSITION');
+15380 87: WRITE(F, 'BALANCE CANNOT BE MADE IN A WEAK POSITION');
+15390 88: WRITE(F, 'BALANCE CANNOT BE MADE IN A MEEK POSITION');
+15400 89: WRITE(F, 'BALANCE CANNOT BE MADE IN A FIRM POSITION');
+15410 90: WRITE(F, 'TOO MANY ACTUAL-PARAMETERS IN CALL');
+15420 91: WRITE(F, 'ILLEGAL MODE FOR TRANSPUT');
+15430 92: WRITE(F, 'STRING-SLICE MAY NOT CONTAIN .AT IN ALGOL 68S');
+15440 93: WRITE(F, 'ILLEGAL MODE FOR THIS POSITION');
+15450 94: WRITE(F, 'ENQUIRY IN IF-CLAUSE MUST BE .BOOL');
+15460 95: WRITE(F, 'ENQUIRY IN CASE-CLAUSE MUST BE .INT');
+15470 96: WRITE(F, 'ENQUIRY IN WHILE-PART OF LOOP-CLAUSE MUST BE .BOOL');
+15480 97: WRITE(F, 'ENQUIRY IN BRIEF CHOICE-CLAUSE MUST BE .BOOL OR .INT');
+15490 98: WRITE(F, '.GOTO UNDEFINED LABEL');
+15500 99: WRITE(F, 'UNIT AFTER .TO, .BY OR .FROM MUST BE .INT');
+15510 100: WRITE(F, 'JUMP MAY NOT OCCUR IN .PROC MODE CONTEXT IN ALGOL 68S');
+15520 101: WRITE(F, 'PRIORITY MUST BE FROM 1 TO 9');
+15530 102: WRITE(F, 'PRIORITY ALREADY GIVEN FOR THIS OPERATOR');
+15540 103: WRITE(F, 'THE OBJECT AFTER .OF IS NOT A .STRUCT');
+15550 104: WRITE(F, 'FIELD-SELECTOR NOT RECOGNIZED IN THIS .STRUCT');
+15560 105: WRITE(F, 'ROWED NAME USED IN IDENTITY-RELATION');
+15570 106: WRITE(F, 'MODE-INDICATION NOT DECLARED');
+15580 107: WRITE(F, 'THE OBJECT SLICED IS NOT AN ARRAY');
+15590 108: WRITE(F, 'TOO MANY TRIMSCRIPTS IN SLICE');
+15600 109: WRITE(F, 'TOO FEW TRIMSCRIPTS IN SLICE');
+15610 110: WRITE(F, 'UNIT AFTER .AT MUST BE .INT');
+15620 111: WRITE(F, 'UNIT IN SUBSCRIPT MUST BE .INT');
+15630 112: WRITE(F, 'UNIT IN LOWER-BOUND MUST BE .INT');
+15640 113: WRITE(F, 'UNIT IN UPPER-BOUND MUST BE .INT');
+15650 114: WRITE(F, 'TOO FEW/MANY PARAMETERS FOR OPERATOR');
+15660 115: WRITE(F, 'PRIORITY-DECLARATION MUST PRECEDE OPERATOR-DECLARATION IN ALGOL 68S');
+15670 116: WRITE(F, 'A MEEKLY-RELATED OPERATOR ALREADY EXISTS');
+15680 117: WRITE(F, 'OPERAND OF IDENTITY-RELATION IS NOT A NAME');
+15690 118: WRITE(F, 'TOO FEW UNITS IN STRUCTURE-DISPLAY');
+15700 119: WRITE(F, 'TOO MANY UNITS IN STRUCTURE-DISPLAY');
+15710 120: WRITE(F, 'DISPLAY DOES NOT HAVE REQUIRED MODE');
+15720 121: WRITE(F, 'A JUMP TO THIS LABEL BYPASSES A DECLARATION');
+15730 122: WRITE(F, 'TOO MANY INTERMEDIATE VALUES (POSSIBLE RUNTIME ERROR)');
+15740 123: WRITE(F, 'IDENTIFIER USED BEFORE DECLARATION COMPLETE');
+15750 132: WRITE(F, 'TOO FEW ACTUAL-PARAMETERS IN CALL');
+15760 133: WRITE(F, '.LOC OMITTED IN VARIABLE-DECLARATION');
+15770 END;
+15780 ()-55*)
+15790 IF LEX<>NIL THEN PRINTLEX(F);
+15800 WRITELN(F);
+15810 END;
+15820 (*START OF OUTERR*)
+15830 BEGIN
+15840 IF (LEV=ERRORR) OR (PRGWARN IN PRAGFLGS) THEN
+15850 BEGIN
+15860 ERRDEV := TRUE;
+15870 IF ERRPTR<ERRLXPTR THEN
+15880 BEGIN
+15890 FOR I := ERRPTR+1 TO ERRLXPTR-1 DO ERRBUF[I] := ERRCHAR;
+15900 ERRPTR := ERRLXPTR;
+15910 ERRBUF[ERRLXPTR] := '1'
+15920 END
+15930 ELSE
+15940 ERRBUF[ERRLXPTR] :=
+15950 CHR((ORD(ERRBUF[ERRLXPTR])-ORD('0')+1) MOD 10 + ORD('0'));
+15960 ERRNONBLANK := TRUE;
+15970 IF ONLINE THEN
+15980 BEGIN
+15990 (*+53() IF N<=ESE THEN ERRMSG(OUTPUT) ELSE ERRMSG2(OUTPUT); ()+53*)
+16000 (*-53() ERRMSG(OUTPUT); ()-53*)
+16010 IF PRGLIST IN PRAGFLGS THEN
+16020 BEGIN
+16030 IF LSTCNT>4+LINESPERPAGE THEN CHECKPAGE;
+16040 (*+01() WRITE(LSTFILE, ' '); ()+01*)
+16050 (*+53() IF N<=ESE THEN ERRMSG(LSTFILE) ELSE ERRMSG2(LSTFILE); ()+53*)
+16060 (*-53() ERRMSG(LSTFILE); ()-53*)
+16070 LSTCNT := LSTCNT+1;
+16080 END;
+16090 END
+16100 (*-02() (*-04() (*-05()
+16110 ELSE (*BATCH*)
+16120 BEGIN
+16130 IF LSTCNT>4+LINESPERPAGE THEN CHECKPAGE;
+16140 (*+01()WRITE(OUTPUT, ' '); ()+01*)
+16150 (*+53() IF N<=ESE THEN ERRMSG(OUTPUT) ELSE ERRMSG2(OUTPUT); ()+53*)
+16160 (*-53() ERRMSG(OUTPUT); ()-53*)
+16170 LSTCNT := LSTCNT+1;
+16180 END
+16190 ()-05*) ()-04*) ()-02*)
+16200 ; IF LEV=ERRORR THEN
+16210 ERRS := ERRS+1
+16220 ELSE WARNS := WARNS+1
+16230 END
+16240 END;
+16250 (**)
+16260 (**)
+16270 PROCEDURE SEMERR(N: INTEGER);
+16280 (*FUNCTION: PRINT ERROR MESSAGE PRODUCED BY SEMANTIC ROUTINES.
+16290 A FUTURE VERSION OF THIS PROCEDURE MIGHT INCREMENT A SPECIAL COUNTER
+16300 (AS DISTINCT FROM ERRS) FOR SEMANTIC ERRORS.
+16310 *)
+16320 BEGIN OUTERR(N, ERRORR, NIL); SEMERRS := SEMERRS+1 END;
+16330 (**)
+16340 (**)
+16350 PROCEDURE SEMERRP(N: INTEGER; LEX: PLEX);
+16360 (*FUNCTION: PRINTS ERROR MESSAGE FOLLOWED BY THE OFFENDING LEXEME*)
+16370 BEGIN OUTERR(N, ERRORR, LEX); SEMERRS := SEMERRS+1 END;
+16380 (**)
+16390 (**)
+16400 PROCEDURE MODERR(M: MODE; N: INTEGER);
+16410 (*FUNCTION: PRINTS ERROR MESSAGE UNLESS M=MDERROR*)
+16420 BEGIN
+16430 IF (M<>MDERROR) AND (M<>PRCERROR) THEN
+16440 BEGIN OUTERR(N, ERRORR, NIL); SEMERRS := SEMERRS+1 END
+16450 END;
+16460 (**)
+16470 ()+81*)
+16480 (*+82()
+16490 (**)
+16500 (*LEXICAL ANALYSIS*)
+16510 (******************)
+16520 (**)
+16530 PROCEDURE OUTSRC;
+16540 (*FUNCTION: OUTPUT A LINE OF SOURCE ON THE LISTING DEVICE.
+16550 IF AN ERROR OCCURRED IN THE LINE OR THE LINE WAS IGNORED DUE
+16560 TO A PREVIOUS ERROR, THEN A LINE OF ERROR INDICATION IS ALSO
+16570 OUTPUT.IF AN ERROR OCCURRED IN THE LINE, THEN ERRORDEV WILL
+16580 BE TRUE AND THUS ALL OUTPUT WILL GO TO THE ERROR DEVICE ALSO.
+16590 GLOBALS:
+16600 SRCBUF, SRCPTR - SOURCE BUFFER
+16610 ERRBUF, ERRPTR - BUFFER CONTAINING ERROR INDICATIONS
+16620 ERRNONBLANK - FALSE IF NO ERROR INDICATIONS
+16630 ERRLXPTR
+16640 PRAGFLGS
+16650 INDEX - INDEX TYPE OF CURRENT CHARACTER
+16660 LSTLINE - LINE NUMBER
+16670 SRCSTAT, SRCSTCH
+16680 *)
+16690 VAR I: INTEGER;
+16700 BEGIN
+16710 IF LSTCNT>4+LINESPERPAGE THEN CHECKPAGE; (*MAINLY FOR FIRST TIME*)
+16720 OUTLST(LSTLINE, SRCBUF, SRCPTR);
+16730 IF ERRNONBLANK THEN
+16740 BEGIN
+16750 FOR I := ERRPTR+1 TO SRCPTR DO ERRBUF[I] := ERRCHAR;
+16760 OUTLST(-1, ERRBUF, SRCPTR);
+16770 IF ERRCHAR=' ' THEN
+16780 ERRNONBLANK := FALSE;
+16790 ERRDEV := FALSE
+16800 END;
+16810 IF INDEX=EOL THEN
+16820 IF EOF(SOURCDECS) THEN INDEX := EOFF
+16830 ELSE IF (LINENUMBERS IN PRAGFLGS) THEN
+16840 BEGIN READ(SOURCDECS, LSTLINE); IF SOURCDECS^=' ' THEN GET(SOURCDECS); END
+16850 ELSE LSTLINE := LSTLINE+1;
+16860 SRCPTR := 0; ERRPTR := -1; ERRLXPTR := 0;
+16870 IF LSTCNT>LINESPERPAGE THEN CHECKPAGE;
+16880 SRCSTAT := SRCSTCH
+16890 END;
+16900 (**)
+16910 (**)
+16920 PROCEDURE NEXTCH(LEVEL: INDEXTYPE);
+16930 (*FUNCTION: GET THE NEXT ACCEPTABLE CHARACTER FROM THE SOURCE
+16940 INPUT. LEVEL IS USED TO INDICATE WHICH CHARACTERS ARE
+16950 ACCEPTABLE.
+16960 INPUTS
+16970 LEVEL - THE LOWEST INDEX TYPE WHICH IS ACCEPTABLE
+16980 OUTPUTS (GLOBAL)
+16990 CHA - THE CURRENT INPUT CHARACTER
+17000 TYPE - THE TYPE TYPE OF CHA
+17010 INDEX - THE INDEX TYPE OF CHA
+17020 *)
+17030 LABEL 99;
+17040 BEGIN
+17050 REPEAT
+17060 IF (INDEX=EOL) OR (SRCPTR>=CBUFSIZE) THEN
+17070 OUTSRC;
+17080 IF INDEX=EOFF THEN GOTO 99
+17090 ELSE CHA := SOURCDECS^;
+17100 SRCPTR := SRCPTR+1; SRCBUF[SRCPTR] := CHA;
+17110 CHAC:=UPC;
+17120 (*-50()
+17130 IF (ORD(CHA)>96) AND (ORD(CHA)<127) THEN
+17140 BEGIN
+17150 CHA:=CHR(ORD(CHA)-32);
+17160 CHAC:=LOWC
+17170 END;
+17180 ()-50*)
+17190 (*+02() (*-25() IF EOF(SOURCDECS) THEN BEGIN INDEX := EOFF; GOTO 99 END ELSE ()-25*) ()+02*)
+17192 (*-50() IF (ORD(CHA)<32) OR (ORD(CHA)>=127) THEN
+17194 BEGIN INDEX := ERRCH; TYP := [] END
+17196 ELSE ()-50*)
+17200 CASE CHA OF
+17210 ' ':
+17220 BEGIN
+17230 TYP := [];
+17240 IF EOF(SOURCDECS) THEN BEGIN INDEX:=EOFF; GOTO 99 END
+17250 ELSE IF EOLN(SOURCDECS) THEN INDEX:=EOL
+17260 ELSE INDEX := SPACE
+17270 END;
+17280 (*-51()
+17290 '$', '&', '''', '?', '\', '_':
+17300 ()-51*)
+17310 (*+51()
+17320 '$', '_', '"', '\', '?', '^':
+17330 ()+51*)
+17340 (*+50() BEGIN INDEX := ERRCH; TYP := [] END; ()+50*)
+17342 (*-50() BEGIN IF CHAC=UPC THEN INDEX := ERRCH ELSE INDEX := PUNCT; TYP := [] END; ()-50*)
+17350 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
+17360 BEGIN
+17370 INDEX := DIGIT;
+17380 TYP := [HEX, DIG]
+17390 END;
+17400 '.':
+17410 BEGIN
+17420 GET(SOURCDECS);
+17430 IF SOURCDECS^ IN ['0'..'9'] THEN INDEX := POINT
+17440 ELSE INDEX := STROP;
+17450 TYP := [];
+17460 GOTO 99
+17470 END;
+17480 (*-51()
+17490 '"': BEGIN INDEX := QUOTE; TYP := [] END;
+17500 ':', '!', '%', '(', ')', '*', '/', ',', ';', '<', '>',
+17510 '^', '=', '@', '[', ']':
+17520 ()-51*)
+17530 (*+51()
+17540 '!': BEGIN INDEX := QUOTE; TYP := [] END;
+17550 ':', '&', '%', '(', ')', '*', '/', ',', ';', '<', '>',
+17560 '''', '=', '@', '[', ']':
+17570 ()+51*)
+17580 (*+50() BEGIN INDEX := PUNCT; TYP :=[] END; ()+50*)
+17582 (*-50() BEGIN IF CHAC=UPC THEN INDEX := PUNCT ELSE INDEX := ERRCH; TYP := [] END; ()-50*)
+17590 '+', '-':
+17600 BEGIN INDEX := PLSMIN; TYP := [] END;
+17610 'A', 'B', 'C', 'D', 'E', 'F':
+17620 BEGIN
+17630 INDEX := LETTER;
+17640 TYP := [HEX, CHAC]
+17650 END;
+17660 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q',
+17670 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z':
+17680 BEGIN
+17690 INDEX := LETTER;
+17700 TYP := [CHAC]
+17710 END;
+17720 '#':
+17730 BEGIN INDEX := PRAG; TYP := [] END;
+17740 END;
+17750 GET(SOURCDECS);
+17760 99:
+17770 UNTIL INDEX>LEVEL
+17780 END;
+17790 (**)
+17800 (**)
+17810 PROCEDURE LXERR(N: INTEGER);
+17820 (*FUNCTION: PRINT ERROR MESSAGE UNLESS CURRENTLY PROCESSING
+17830 INSIDE A PRAGMENT.
+17840 INPUT:
+17850 N - IDENTIFIES MESSAGE TO BE PRINTED
+17860 GLOBALS:
+17870 INPRAGMENT
+17880 *)
+17890 BEGIN
+17900 IF NOT INPRAGMENT THEN
+17910 OUTERR(N, ERRORR, NIL)
+17920 END;
+17930 (**)
+17940 (**)
+17950 PROCEDURE INITLX;
+17960 (*FUNCTION: PERFORM PER-COMPILATION INITIALIZATION REQUIRED BY
+17970 THE LEXICAL ANALYZER.
+17980 *)
+17990 (*VAR I: 0..HTSIZE; *)
+18000 BEGIN
+18010 (*WORDS := 0;*)
+18020 (*+50()
+18030 (*-52() PRAGFLGS := [PRGPOINT, PRGWARN, PRGMACH, PRGLIST, PRGGO]; ()-52*)
+18040 (*+52() PRAGFLGS := [PRGPOINT, PRGWARN, PRGMACH, PRGLIST]; ()+52*)
+18050 ()+50*)
+18060 (*-50() PRAGFLGS := [PRGUPPER, PRGWARN, PRGMACH, PRGLIST, PRGGO]; ()-50*)
+18070 INDEX := CONTROL;
+18080 INPRAGMENT := FALSE;
+18090 LONGSCNT := 0;
+18100 ERRLXPTR := 0; ERRPTR := -1;
+18110 ERRCHAR := ' '; ERRNONBLANK := FALSE;
+18120 SRCPTR := 0;
+18130 (*KRONOS HAS A CONVENTION FOR LINE NUMBERING OF FILES.
+18140 THE FIRST CHARACTER OF THE FILE WILL NOW BE READ, AND IF
+18150 IT IS A DIGIT, IT WILL BE ASSUMED THAT THE SOURCE TEXT
+18160 IS NUMBERED ACCORDING TO THIS CONVENTION.*)
+18170 LSTLINE := 1;
+18180 IF NOT EOF(SOURCDECS) THEN
+18190 BEGIN
+18200 WHILE EOLN(SOURCDECS) DO GET(SOURCDECS);
+18210 IF SOURCDECS^ IN ['0'..'9'] THEN
+18220 BEGIN
+18230 READ(SOURCDECS,LSTLINE);
+18240 IF SOURCDECS^=' ' THEN GET(SOURCDECS);
+18250 PRAGFLGS := PRAGFLGS+[LINENUMBERS];
+18260 END
+18270 END;
+18280 LEXLINE := LSTLINE;
+18290 SRCSTAT := ' ';
+18340 END;
+18350 (**)
+18360 (**)
+18370 (*+04()
+18380 FUNCTION LABS(X: A68INT): A68INT;
+18390 BEGIN IF X>0 THEN LABS := X ELSE LABS := -X END;
+18400 ()+04*)
+18410 ()+82*)
+18420 (*+81()
+18430 FUNCTION HASHIN: PLEX;
+18440 (*FUNCTION: SEARCH HASH TABLE FOR LEXEME SITTING IN CURRENTLEX.
+18450 IF LEXEME IS ALREADY IN TABLE, THEN RETURN POINTER TO THIS OLD
+18460 LEXEME. IF IT IS NOT IN THE TABLE AND NOENTER IS FALSE AND WE
+18470 ARE NOT INSIDE A PRAGMENT, THEN ENTER THE LEXEME IN THE TABLE
+18480 AND RETURN A POINTER TO THE NEW LEXEME. IF LEXEME IS NOT
+18490 FOUND AND A NEW ENTRY IS NOT MADE, THEN RETURN NIL.
+18500 *)
+18510 LABEL 8, 9;
+18520 VAR TOTAL: A68INT; HASHVAL, HASHSTART: INTEGER; I: 1..TAXLENWD; THIS: PLEX;
+18530 BEGIN
+18540 WITH CURRENTLEX DO
+18550 BEGIN
+18560 TOTAL := 0;
+18570 HASHSTART := 1+ORD(LXTOKEN=TKDENOT);
+18580 FOR I := HASHSTART TO LXCOUNT DO
+18590 (*+11() TOTAL := TOTAL+FUDGE[2*I-1]+FUDGE[2*I];
+18592 HASHVAL := ABS(TOTAL MOD HTSIZE); (*HASH VALUE*) ()+11*)
+18600 (*-11()
+18601 (*-05() TOTAL := (TOTAL+INTEGERS[I]) MOD HTSIZE; ()-05*)
+18602 (*+05() TOTAL := TOTAL+INTEGERS[I]; ()+05*)
+18604 (*-04()(*-05() HASHVAL := TOTAL; (*HASH VALUE*) ()-05*)()-04*)
+18610 (*+05() HASHVAL := ABS(TOTAL MOD HTSIZE); (*HASH VALUE*) ()+05*)
+18620 (*+04() HASHVAL := SHRINK(LABS(TOTAL)); ()+04*)
+18624 ()-11*)
+18630 THIS := HT[HASHVAL];
+18640 WHILE THIS<>NIL DO
+18650 BEGIN
+18660 IF LXCOUNT<>THIS^.LXCOUNT THEN GOTO 8;
+18670 FOR I := 1 TO LXCOUNT DO
+18680 IF INTEGERS[I]<>THIS^.INTEGERS[I] THEN GOTO 8;
+18690 IF LXTOKEN=THIS^.LXTOKEN THEN
+18700 IF LXTOKEN<>TKDENOT THEN GOTO 9
+18710 ELSE IF LXDENMD=THIS^.LXDENMD THEN GOTO 9 ELSE GOTO 8;
+18720 8: THIS := THIS^.LINK
+18730 END;
+18740 9: IF (THIS=NIL) AND (NOT INPRAGMENT) THEN
+18750 BEGIN
+18760 (*NEW LEXEME MUST BE CREATED*)
+18770 (*CREATE LEXEME JUST BIG ENOUGH*)
+18780 ENEW(THIS, LXCOUNT*SZWORD+LEX1SIZE);
+18790 FOR I := 1 TO LXCOUNT + LEX1SIZE DIV SZWORD DO
+18800 THIS^.LEXWORDS[I] := LEXWORDS[I];
+18810 THIS^.LINK := HT[HASHVAL];
+18820 HT[HASHVAL] := THIS;
+18830 END;
+18840 HASHIN := THIS
+18850 END (*OF WITH CURRENTLEX*)
+18860 END;
+18870 (**)
+18880 ()+81*)
+18890 (*+82()
+18900 (**)
+18910 FUNCTION LX: PLEX;
+18920 (*FUNCTION: SCAN A SYMBOL FROM THE INPUT.
+18930 VALUE: PLEX FOR THE SYMBOL.
+18940 *)
+18950 LABEL 1, 6, 7, 8, 77, 88, 99;
+18960 CONST SKIPNONE=CONTROL; SKIPEOL=EOL; SKIPSPACES=SPACE;
+18970 SKIPDENS=PLSMIN; SKIPTAGS=LETTER;
+18980 (*+11() MAX10=3146314631463146313B;
+18990 MAX2=37777777777777777777B;
+19000 ()+11*)
+19002 (*+12()
+19004 MAX10=3277;
+19006 MAX2=16383;
+19008 ()+12*)
+19010 (*+13() MAX10=214748364;
+19020 MAX2=1073741824;
+19030 ()+13*)
+19040 VAR LEX: PLEX; SYMCNT, I: INTEGER;
+19050 S: 0..127;
+19060 STATE: (PT, INTPT, R, PM, FRACPT, E, EXP, BITS);
+19070 (*FOR GETPRIMDEN*)
+19080 EXPONENT, SIGN, SCALE, DIGT: INTEGER;
+19090 NS: BOOLEAN;
+19100 RR, FAC: REAL;
+19110 LEVEL: INDEXTYPE;
+19120 PROCEDURE FINISHOFF(C: CHAR);
+19130 (*FUNCTION: FILLS REST OF STRING WITH SPACES UP TO NEXT FULL
+19140 WORD AND SETS LXCOUNT.
+19150 *)
+19160 VAR I: 0..TAXLEN;
+19170 BEGIN
+19180 WITH CURRENTLEX DO
+19190 BEGIN
+19200 IF SYMCNT<TAXLEN THEN
+19210 BEGIN
+19220 LXCOUNT := (SYMCNT+CHARPERWORD-1) DIV CHARPERWORD;
+19230 FOR I := (SYMCNT-1) MOD CHARPERWORD TO CHARPERWORD-2 DO
+19240 BEGIN SYMCNT := SYMCNT+1; STRNG[SYMCNT] := C END
+19250 END
+19260 ELSE BEGIN LXCOUNT := TAXLENWD; LXERR(ELX+9) END
+19270 END
+19280 END;
+19290 (*START OF LX*)
+19300 BEGIN
+19310 WITH CURRENTLEX DO
+19320 BEGIN
+19330 REPEAT
+19340 1: ERRLXPTR := SRCPTR;
+19350 LEXLINE := LSTLINE;
+19360 CASE INDEX OF
+19370 (*SKIPSPACES*)
+19380 CONTROL, EOL, SPACE:
+19390 BEGIN NEXTCH(SKIPSPACES); GOTO 1 END;
+19400 (*ERRORCHAR*)
+19410 ERRCH: (*ERRORCHAR*)
+19420 BEGIN
+19430 LXERR(ELX+8);
+19440 NEXTCH(SKIPNONE);
+19450 LEX := LEXERROR;
+19460 GOTO 99
+19470 END;
+19480 (*GETPRIMDEN*)
+19490 DIGIT, POINT: (*GETPRIMDEN*)
+19500 BEGIN
+19510 LXDENRPREAL := 0.0; EXPONENT := 0; SIGN := +1; SCALE := 0;
+19514 (*+02() SYMCNT := ((SZADDR+SZREAL) DIV SZINT) * CHARPERWORD; ()+02*)
+19520 STATE := INTPT;
+19530 WHILE TRUE DO
+19540 BEGIN
+19550 6: (*LABEL TO REPEAT CASE WITH DIFFERENT STATE*)
+19560 CASE STATE OF
+19570 INTPT: (*SCAN DIGITS*)
+19580 (*+43() IF INDEX=POINT THEN STATE := PT
+19590 ELSE IF (CHA='R')(*-50() AND ((PRGPOINT IN PRAGFLGS) OR (LOWC IN TYP))()-50*) THEN
+19600 STATE := R
+19610 ELSE IF (CHA='E')(*-50() AND ((PRGPOINT IN PRAGFLGS) OR (LOWC IN TYP))()-50*) THEN
+19620 BEGIN STATE := PM;
+19630 IF LXDENRP<=MAXINT THEN
+19640 LXDENRPREAL := (*-04() LXDENRP ()-04*)(*+04() FLOAT(LXDENRP) ()+04*)
+19650 ELSE BEGIN OUTERR(ELX+10, ERRORR, NIL); LXDENRPREAL := 0.0 END
+19660 END
+19670 ELSE IF DIG IN TYP THEN
+19680 IF LXDENRP<MAX10 THEN
+19690 LXDENRP := LXDENRP*10+(ORD(CHA)-ORD('0'))
+19700 ELSE BEGIN OUTERR(ELX+10, ERRORR, NIL); LXDENRP := 0 END
+19710 (*+61() (*WORRY ABOUT LONG CONVERSIONS*) ()+61*)
+19720 ELSE
+19730 BEGIN (*+61() IF LONGSCNT=1 THEN LXDENMD := MDLINT ELSE ()+61*) LXDENMD := MDINT;
+19740 GOTO 7 END;
+19750 ()+43*)
+19760 (*-43() IF INDEX=POINT THEN STATE := PT
+19770 ELSE IF (CHA='R')(*-50() AND ((PRGPOINT IN PRAGFLGS) OR (LOWC IN TYP))()-50*) THEN
+19780 STATE:=R
+19790 ELSE IF (CHA='E')(*-50() AND ((PRGPOINT IN PRAGFLGS) OR (LOWC IN TYP))()-50*) THEN
+19800 STATE:=PM
+19810 ELSE IF DIG IN TYP THEN
+19820 LXDENRPREAL := LXDENRPREAL*10+(ORD(CHA)-ORD('0'))
+19830 ELSE IF LXDENRPREAL<=MAXINT
+19840 THEN BEGIN (*+61() IF LONGSCNT=1 THEN LXDENMD := MDLINT ELSE ()+61*) LXDENMD:=MDINT;
+19850 LXDENRP:=TRUNC(LXDENRPREAL);GOTO 7 END
+19860 ELSE BEGIN OUTERR(ELX+10,ERRORR,NIL);
+19870 (*+61() (*WORRY ABOUT LONG CONVERSIONS*) ()+61*)
+19880 LXDENMD := MDINT;
+19890 LXDENRP:=0 END;
+19900 ()-43*)
+19910 PT: (*FIXED-POINT-NUMERAL MUST FOLLOW IN
+19920 FRACTIONAL-PART*)
+19930 BEGIN STATE := FRACPT;
+19940 (*-02() (*+43() IF LXDENRP<=MAXINT THEN
+19950 LXDENRPREAL := LXDENRP
+19960 ELSE BEGIN OUTERR(ELX+10, ERRORR, NIL); LXDENRPREAL := 0.0 END;
+19970 (*+61() (*WORRY ABOUT LONG CONVERSIONS*) ()+61*)
+19980 ()+43*) ()-02*)
+19990 GOTO 6
+20000 END;
+20010 FRACPT: (*SCAN DIGITS OF FRACTIONAL-PART*)
+20020 IF (CHA='E') AND ((PRGPOINT IN PRAGFLGS) OR (LOWC IN TYP))
+20030 THEN STATE:=PM
+20040 ELSE IF DIG IN TYP THEN
+20050 (*-02() BEGIN LXDENRPREAL := LXDENRPREAL*10+(ORD(CHA)-ORD('0')); SCALE := SCALE-1 END ()-02*)
+20060 ELSE BEGIN STATE := EXP; GOTO 6 END;
+20070 PM: (*CHECK FOR PLUSMINUS IN EXPONENT-PART*)
+20080 IF INDEX=PLSMIN THEN
+20090 BEGIN IF CHA='-' THEN SIGN := -1; STATE := E END
+20100 ELSE IF DIG IN TYP THEN
+20110 BEGIN STATE := EXP; GOTO 6 END
+20120 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END;
+20130 E: (*FIXED-POINT-NUMERAL MUST FOLLOW PLUSMINUS*)
+20140 IF DIG IN TYP THEN
+20150 BEGIN STATE := EXP; GOTO 6 END
+20160 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END;
+20170 EXP: (*SCAN FIXED-POINT-NUMERAL IN EXPONENT-PART*)
+20180 IF DIG IN TYP THEN
+20190 (*-02() EXPONENT := EXPONENT*10+(ORD(CHA)-ORD('0'))*SIGN ()-02*)
+20200 ELSE
+20202 BEGIN
+20210 (*-02() SCALE := SCALE+EXPONENT;
+20220 RR := 1.0; NS := SCALE<0; SCALE := ABS(SCALE); FAC := 10.0;
+20230 WHILE SCALE<>0 DO
+20240 BEGIN IF ODD(SCALE) THEN RR := RR*FAC;
+20250 SCALE := SCALE DIV 2;
+20252 IF SCALE<>0 THEN FAC := SQR(FAC);
+20260 END; (*RR = 10^SCALE*)
+20270 IF NS THEN LXDENRPREAL := LXDENRPREAL/RR
+20280 ELSE LXDENRPREAL := LXDENRPREAL*RR;
+20284 ()-02*)
+20290 (*+61() IF LONGSCNT=1 THEN LXDENMD := MDLREAL ELSE ()+61*) LXDENMD := MDREAL;
+20300 GOTO 7;
+20310 END;
+20320 R: (*DIGITS MUST FOLLOW LETTER-R IN
+20330 BITS-DENOTATION*)
+20340 (*+43() IF (HEX IN TYP)(*-50() AND ((PRGPOINT IN PRAGFLGS) OR NOT(UPC IN TYP)) ()-50*)
+20350 (*-04() AND (LXDENRP IN [2,4,8,16]) THEN ()-04*)
+20360 (*+04() AND (SHRINK(LXDENRP) IN [2,4,8,16]) THE ()+04*)
+20370 BEGIN STATE := BITS;
+20380 EXPONENT := (*-04() LXDENRP; ()-04*)(*+04() SHRINK(LXDENRP); ()+04*)
+20390 LXDENRP := 0; GOTO 6;
+20400 END
+20410 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END;
+20420 ()+43*)
+20430 (*-43() IF (HEX IN TYP)(*-50() AND ((PRGPOINT IN PRAGFLGS) OR NOT(UPC IN TYP))()-50*)
+20440 AND (TRUNC(LXDENRPREAL)-1 IN [1,3,7,15]) THEN
+20450 BEGIN STATE := BITS; EXPONENT := TRUNC(LXDENRPREAL); LXDENRPREAL := 0; GOTO 6 END
+20460 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END;
+20470 ()-43*)
+20480 BITS: (*SCAN DIGITS IN BITS-DENOTATION*)
+20490 (*+43() IF (HEX IN TYP)(*-50() AND ((PRGPOINT IN PRAGFLGS) OR NOT(UPC IN TYP))()-50*) THEN
+20500 BEGIN IF DIG IN TYP THEN DIGT := ORD(CHA)-ORD('0')
+20510 ELSE DIGT := ORD(CHA)-ORD('A')+10;
+20520 IF DIGT<EXPONENT THEN
+20530 BEGIN SCALE := EXPONENT;
+20540 WHILE SCALE<>1 DO
+20550 IF LXDENRP<=MAX2 THEN
+20560 BEGIN LXDENRP := LXDENRP*2; SCALE := SCALE DIV 2 END
+20570 (*RELIES ON THE FACT THAT *2 IS A SHIFT*)
+20580 ELSE BEGIN OUTERR(ELX+10, ERRORR, NIL); LXDENRP := 0 END;
+20590 LXDENRP := LXDENRP+DIGT
+20600 END
+20610 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END
+20620 END
+20630 ELSE BEGIN LXDENMD := MDBITS; GOTO 7 END
+20640 ()+43*)
+20650 (*-43() IF (HEX IN TYP) AND ((PRGPOINT IN PRAGFLGS) OR (NOT(UPC IN TYP))) THEN
+20660 BEGIN IF DIG IN TYP THEN DIGT := ORD(CHA)-ORD('0')
+20670 ELSE DIGT := ORD(CHA)-ORD('A')+10;
+20680 IF DIGT<EXPONENT THEN
+20690 BEGIN SCALE := EXPONENT;
+20700 WHILE SCALE<>1 DO
+20710 BEGIN LXDENRPREAL := LXDENRPREAL*2; SCALE := SCALE DIV 2 END;
+20720 LXDENRPREAL := LXDENRPREAL+DIGT
+20730 END
+20740 ELSE BEGIN LXERR(ELX+6); LEX := LEXERROR; GOTO 99 END
+20750 END
+20760 ELSE BEGIN
+20770 IF LXDENRPREAL-MAXINT-1<=MAXINT THEN
+20780 IF LXDENRPREAL<=MAXINT THEN
+20790 LXDENRP := TRUNC(LXDENRPREAL)
+20800 ELSE LXDENRP := TRUNC(LXDENRPREAL-MAXINT-MAXINT-2)
+20810 ELSE BEGIN OUTERR(ELX+10, ERRORR, NIL); LXDENRP:=0 END ;
+20820 LXDENMD := MDBITS; GOTO 7 END
+20830 ()-43*)
+20840 END; (*OF CASE STATE*)
+20844 (*+02() SYMCNT := SYMCNT+1; STRNG[SYMCNT] := CHA; ()+02*)
+20850 NEXTCH(SKIPSPACES) (*SKIPNONE IN RES*)
+20860 END (*OF LOOP*);
+20870 7: (*EXIT LABEL FOR LOOP*)
+20880 (*+61() IF LONGSCNT<0 THEN SEMERR(ESE+6) ELSE IF LONGSCNT>1 THEN SEMERR(ESE+19); ()+61*)
+20884 IF LXDENMD=MDREAL THEN
+20886 BEGIN
+20890 (*-02() LXCOUNT := WORDSPERREAL + SZADDR DIV SZWORD ()-02*)
+20892 (*+02() LXDENRP := SYMCNT - ((SZADDR+SZREAL) DIV SZINT)*CHARPERWORD;
+20894 FINISHOFF(CHR(0));
+20896 ()+02*)
+20900 (*+61() (*WORRY ABOUT LONG MODES*) ()+61*)
+20904 END
+20910 ELSE LXCOUNT := (SZADDR+SZINT) DIV SZWORD;
+20920 LXV := LXVPRDEN;
+20930 LXTOKEN := TKDENOT;
+20940 GOTO 88
+20950 END (*OF GETPRIMDEN*);
+20960 (*GETSTRGDEN*)
+20970 QUOTE: (*GETSTRGDEN*)
+20980 BEGIN
+20990 SRCSTCH := 'S';
+21000 SYMCNT := ((SZADDR+SZINT) DIV SZINT)*CHARPERWORD; (*ALLOWS ROOM FOR LXDENMD AND LXDENRP*)
+21010 WHILE TRUE DO
+21020 BEGIN
+21030 NEXTCH(SKIPEOL);
+21040 IF INDEX=EOFF THEN
+21050 BEGIN LXERR(ELX+3); LEX := LEXERROR; GOTO 99 END
+21060 ELSE IF INDEX<>QUOTE THEN
+21070 BEGIN
+21080 (*-50() IF CHAC=LOWC THEN CHA := CHR(ORD(CHA)+32); ()-50*)
+21090 IF SYMCNT<TAXLEN THEN
+21100 BEGIN SYMCNT := SYMCNT+1; STRNG[SYMCNT] := CHA END
+21110 ELSE (*NO ACTION*)
+21120 END
+21130 ELSE
+21140 BEGIN
+21150 NEXTCH(SKIPNONE);
+21160 IF INDEX=QUOTE THEN
+21170 IF SYMCNT<TAXLEN THEN
+21180 BEGIN SYMCNT := SYMCNT+1; STRNG[SYMCNT] := CHA END
+21190 ELSE (*NO ACTION*)
+21200 ELSE
+21210 BEGIN
+21220 SRCSTCH := ' ';
+21230 IF INDEX<=SKIPSPACES THEN NEXTCH(SKIPSPACES);
+21240 IF INDEX<>QUOTE THEN GOTO 8;
+21250 SRCSTCH := 'S'
+21260 END
+21270 END
+21280 END (*OF LOOP*);
+21290 8: (*UPON RECOGNITION OF END OF STRING-DENOTATION*)
+21300 LXDENRP := SYMCNT-((SZADDR+SZINT)DIV SZINT)*CHARPERWORD; (*LENGTH OF STRING*)
+21310 IF SYMCNT=((SZADDR+SZINT) DIV SZINT)*CHARPERWORD+1 THEN
+21320 BEGIN LXDENMD := MDCHAR;
+21330 LXDENRP := ORD(STRNG[((SZADDR+SZINT) DIV SZINT)*CHARPERWORD+1]);
+21340 LXV := LXVPRDEN; LXCOUNT := (SZADDR+SZINT) DIV SZWORD;
+21350 END
+21360 ELSE
+21370 BEGIN LXDENMD := MDSTRNG; FINISHOFF(CHR(0)); LXV := LXVSTRGDEN END;
+21380 LXTOKEN := TKDENOT;
+21390 GOTO 88
+21400 END (*OF GETSTRGDEN*);
+21410 (*GETOPR*)
+21420 PUNCT, PLSMIN, PRAG: (*GETOPR*)
+21430 BEGIN
+21440 (*+01() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+01*)
+21450 (*+25() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+25*)
+21460 (*-01() (*-25() S := ORD(CHA)-ORD('!'); (*ASCII VERSION*)
+21462 IF CHA='%' THEN S := 23
+21465 IF CHA = '%' THEN S:=23 ELSE
+21470 IF CHA IN ['[',']','^','\'] THEN S:=S-55; ()-25*) ()-01*)
+21480 NEXTCH(SKIPNONE);
+21490 WITH OPCHTABLE[S] DO
+21500 BEGIN
+21510 LEX := OTLEX;
+21520 S := OTNEXT
+21530 END;
+21540 WHILE S<>0 DO
+21550 WITH OPCHTABLE[S] DO
+21560 IF CHA=OTCHAR THEN
+21570 BEGIN
+21580 NEXTCH(SKIPNONE);
+21590 LEX := OTLEX;
+21600 S := OTNEXT
+21610 END
+21620 ELSE S := OTALT;
+21630 IF LEX=LEXERROR THEN
+21640 BEGIN
+21650 NEXTCH(SKIPNONE);
+21660 LXERR(ELX+5);
+21670 END;
+21680 GOTO 99
+21690 END;
+21700 (*GETTAX*)
+21710 LETTER: (*GETTAX*)
+21720 BEGIN
+21730 (*IN RES STROPPING, NOENTER IS SET.
+21740 IF UPPER/LOWER STROP AND UPPER/LOWER OR IF RES
+21750 THEN USE HASHBOLD
+21760 ELSE*)
+21770 IF PRGPOINT IN PRAGFLGS THEN TTYPE:=[UPC, LOWC, DIG]
+21780 ELSE TTYPE:=[CHAC, DIG];
+21790 IF (PRGUPPER IN PRAGFLGS) AND (CHAC=UPC) THEN
+21800 BEGIN
+21810 LXV:=LXVTAB;
+21820 LXTOKEN:=TKBOLD;
+21830 LEVEL:=SKIPNONE
+21840 END
+21850 ELSE
+21860 BEGIN
+21870 LXV:=LXVTAG;
+21880 LXTOKEN:=TKTAG;
+21890 LEVEL:=SKIPSPACES
+21900 END
+21910 END (*OF GETTAX*);
+21920 (*GETBOLD*)
+21930 STROP: (*GETBOLD*)
+21940 BEGIN
+21950 NEXTCH(SKIPNONE);
+21960 IF INDEX=LETTER THEN
+21970 BEGIN
+21980 (*HASHBOLD*)
+21990 TTYPE:=[CHAC,DIG];
+22000 LXV := LXVTAB;
+22010 LXTOKEN := TKBOLD;
+22020 LEVEL := SKIPNONE
+22030 END
+22040 ELSE BEGIN LXERR(ELX+7); LEX := LEXERROR; GOTO 99 END
+22050 END (*OF GETBOLD*);
+22060 (*ENDOFFILE*)
+22070 EOFF: (*ENDOFFILE*)
+22080 BEGIN
+22090 LEX := LEXSTOP;
+22100 GOTO 99
+22110 END;
+22120 END (*OF CASE INDEX*);
+22130 77: (*SCANTAX*)
+22140 SYMCNT := 0;
+22150 REPEAT
+22160 IF SYMCNT<TAXLEN THEN
+22170 BEGIN SYMCNT := SYMCNT+1; STRNG[SYMCNT] := CHA END;
+22180 NEXTCH(LEVEL)
+22190 UNTIL TYP*TTYPE=[];
+22200 (*+11()
+22210 IF SYMCNT<11 THEN
+22220 BEGIN
+22230 LXCOUNT := 1;
+22240 WHILE SYMCNT<10 DO
+22250 BEGIN SYMCNT := SYMCNT+1; STRNG[SYMCNT] := ' ' END;
+22260 LEX := HT[(FUDGE1+FUDGE2) MOD HTSIZE];
+22270 WHILE LEX<>NIL DO
+22280 BEGIN
+22290 IF S10=LEX^.S10 THEN
+22300 IF LXTOKEN=LEX^.LXTOKEN THEN GOTO 99;
+22310 LEX := LEX^.LINK
+22320 END
+22330 END
+22340 ELSE ()+11*)
+22350 FINISHOFF(' ');
+22360 88: (*HASHIN*)
+22370 LEX := HASHIN;
+22380 99: (*LABEL REACHED FROM EXITLX*)
+22390 UNTIL (LEX<>LEXERROR) OR INPRAGMENT;
+22400 LX := LEX;
+22410 END (*OF WITH CURRENTLEX*)
+22420 END;
+22430 (**)
+22440 (**)
+22450 PROCEDURE LEXALF(LEX: PLEX; VAR ALF: ALFA);
+22460 (*OBTAINS 1ST 10 CHARS OF IDENTIFIER IN LEX*)
+22470 VAR I: INTEGER;
+22480 BEGIN
+22490 IF LEX=NIL THEN ALF := '-UNNAMED- '
+22500 ELSE WITH LEX^ DO
+22510 IF LXCOUNT=0 THEN ALF := '-UNNAMED- '
+22520 ELSE
+22530 (*-11() IF LXCOUNT*CHARPERWORD<10 THEN
+22540 BEGIN ALF := ' ';
+22550 FOR I := 1 TO LXCOUNT*CHARPERWORD DO ALF[I] := S10[I];
+22560 END
+22570 ELSE
+22580 ()-11*)
+22590 ALF := S10;
+22600 END;
+22610 (**)
+22620 (**)
+22630 (*+01()
+22640 PROCEDURE SETPARAM(S: ALFA; COUNT: INTEGER);
+22650 (*SETS S AS THE COUNTTH PARAMETER IN THE COMMUNICATION AREA*)
+22660 VAR PARAMS: PACKED RECORD CASE SEVERAL OF
+22670 1: (INT: INTEGER);
+22680 2: (REC: PACKED ARRAY [1..7] OF CHAR;
+22690 CODE: 0..777777B);
+22700 3,4,5,6,7,8,9,10: ()
+22710 END;
+22720 P: PINTEGER;
+22730 I: INTEGER;
+22740 BEGIN WITH PARAMS DO
+22750 BEGIN
+22760 IF COUNT=0 THEN P := ASPTR(64B)
+22770 ELSE P := ASPTR(1+COUNT);
+22780 FOR I := 1 TO 7 DO
+22790 IF S[I]=' ' THEN REC[I] := CHR(0)
+22800 ELSE REC[I] := S[I];
+22810 CODE := 1; (*FOR COMMA*)
+22820 P^ := INT;
+22830 P := ASPTR(64B);
+22840 INT := P^;
+22850 CODE := COUNT;
+22860 P^ := INT
+22870 END
+22880 END;
+22890 (**)
+22900 (**)
+22910 ()+01*)
+22920 FUNCTION PARSIN: PLEX;
+22930 (*FUNCTION: SCAN A TOKEN FROM THE INPUT AND RETURN ITS LEXEME.
+22940 A TOKEN CONSISTS OF AN OPTIONAL PRAGMENT (PRAGMAT OR COMMENT)
+22950 FOLLOWED BY A SYMBOL.
+22960 *)
+22970 LABEL 9;
+22980 CONST SKIPDENS=PLSMIN;
+22990 VAR LEX, LEX2: PLEX;
+23000 PTR: PLEXQ;
+23010 GOCOUNT, I: INTEGER;
+23020 BEGIN
+23030 (*PARSCLKS := PARSCLKS+1; LXCLOCK := LXCLOCK-CLOCK;*)
+23040 IF PLINPQ=NIL THEN
+23050 BEGIN
+23060 REPEAT
+23070 SRCSTCH := ' ';
+23080 LEX := LX;
+23090 WITH LEX^.LXV DO
+23100 BEGIN
+23110 IF (LXIO=LXIOCMMENT) OR (LXIO=LXIOPRAGMAT) THEN
+23120 BEGIN
+23130 IF LXIO=LXIOCMMENT THEN SRCSTCH := 'C'
+23140 ELSE SRCSTCH := 'P';
+23150 INPRAGMENT := TRUE; LEX2 := NIL;
+23160 REPEAT
+23170 IF INDEX=EOFF THEN
+23180 BEGIN OUTERR(ELX+4, ERRORR, LEX); GOTO 9 END
+23190 ELSE IF INDEX>=LETTER THEN
+23200 BEGIN
+23210 LEX2 := LX;
+23220 IF SRCSTCH='P' THEN
+23230 (*DOPRAG*) WITH CURRENTLEX DO
+23232 BEGIN
+23240 (*-11() FOR I:=LXCOUNT*CHARPERWORD+1 TO 10 DO S10[I]:=' '; ()-11*)
+23250 IF S10='WARN ' THEN PRAGFLGS := PRAGFLGS+[PRGWARN]
+23260 ELSE IF S10='NOWARN ' THEN PRAGFLGS := PRAGFLGS-[PRGWARN]
+23270 ELSE IF S10='POINT ' THEN PRAGFLGS := PRAGFLGS+[PRGPOINT]
+23280 -[PRGUPPER]
+23290 ELSE IF S10='UPPER ' THEN PRAGFLGS := PRAGFLGS+[PRGUPPER]
+23300 -[PRGPOINT]
+23310 ELSE IF S10='LIST ' THEN PRAGFLGS := PRAGFLGS+[PRGLIST]
+23320 ELSE IF S10='NOLIST ' THEN
+23330 BEGIN
+23340 PRAGFLGS := PRAGFLGS-[PRGLIST];
+23350 LSTCNT := 100 (*TO FORCE NEW PAGE ON RESTARTING*)
+23360 END
+23370 ELSE IF (S10='PAGE ') AND (PRGLIST IN PRAGFLGS) THEN
+23380 LSTCNT := 55
+23390 ELSE IF S10='GO ' THEN
+23400 BEGIN
+23410 PRAGFLGS := PRAGFLGS+[PRGGO]; GOCOUNT := 0;
+23420 (*+01()
+23430 REPEAT
+23440 SETPARAM(S10, GOCOUNT); GOCOUNT := GOCOUNT+1;
+23450 IF INDEX<=SKIPDENS THEN NEXTCH(SKIPDENS); LEX2 := LX
+23460 UNTIL LEX2=LEX
+23470 ()+01*)
+23480 END
+23490 ELSE IF S10='NOGO ' THEN PRAGFLGS := PRAGFLGS-[PRGGO]
+23500 (* ELSE IF S10='SPACE ' THEN
+23510 BEGIN
+23520 REPEAT LEX2 := LEX
+23530 UNTIL (LXTOKEN=TKDENOT) OR (LEX2=LEX);
+23540 IF LXTOKEN=TKDENOT THEN WORDS := LXDENRP
+23550 END
+23560 *)
+23570 END
+23580 END
+23590 ELSE NEXTCH(SKIPDENS) (*MAYBE DIFFERENT IN RES*)
+23600 UNTIL LEX2=LEX; (*MATCHING PRAGMENT-SYMBOL*)
+23610 INPRAGMENT := FALSE;
+23620 9: (*LABEL REACHED AFTER ELX+4*)
+23630 END
+23640 END
+23650 UNTIL SRCSTCH=' ';
+23660 IF LEX^.LXV.LXIO=LXIOLONG THEN
+23670 LONGSCNT := LONGSCNT+1
+23680 ELSE IF LEX^.LXV.LXIO=LXIOSHORT THEN
+23690 LONGSCNT := LONGSCNT-1
+23700 ELSE LONGSCNT := 0;
+23710 PARSIN := LEX
+23720 END
+23730 ELSE WITH PLINPQ^ DO
+23740 BEGIN
+23750 PARSIN := DATA1;
+23760 PTR := PLINPQ; PLINPQ := LINK; DISPOSE(PTR)
+23770 END;
+23780 (*LXCLOCK := LXCLOCK+CLOCK; LXCLOCKS := LXCLOCKS+1*)
+23790 END;
+23800 (**)
+23810 ()+82*)
+23820 (*+81()
+23830 (**)
+23840 (*STACK HANDLING*)
+23850 (****************)
+23860 (**)
+23870 PROCEDURE SUBSAVE;
+23880 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SUBP := SRSUBP; SRSUBP := SRSEMP END;
+23890 (**)
+23900 (**)
+23910 PROCEDURE SUBREST;
+23920 BEGIN SRSEMP := SRSUBP-1; SRSUBP := SRSTK[SRSEMP+1].SUBP END;
+23930 (**)
+23940 (**)
+23950 FUNCTION SRPOPMD: MODE;
+23960 BEGIN SRPOPMD := SRSTK[SRSEMP].MD; SRSEMP := SRSEMP-1 END;
+23970 (**)
+23980 (**)
+23990 PROCEDURE SCPUSH(M: MODE);
+24000 VAR SC: PMODECHAIN;
+24010 BEGIN NEW(SC); WITH SC^ DO
+24020 BEGIN LINK := SCL; SCMODE := M END;
+24030 SCL := SC
+24040 END;
+24050 (**)
+24060 (**)
+24070 FUNCTION SCPOP: MODE;
+24080 VAR SC: PMODECHAIN;
+24090 BEGIN SCPOP := SCL^.SCMODE; SC := SCL; SCL := SCL^.LINK; DISPOSE(SC) END;
+24100 (**)
+24110 (**)
+24120 ()+81*)
+24130 (*+84()
+24140 (*MODE CREATION*)
+24150 (***************)
+24160 (**)
+24170 PROCEDURE FIND(VAR SEARCHLIST: MODE; RECURSIVE: BOOLEAN; LENGTH: CNTR);
+24180 (*REPLACES THE FIRST MODE OF SEARCHLIST BY ANY DUPLICATES OF ITSELF*)
+24190 VAR PREV, THIS, NEXT: MODE;
+24200 FUNCTION COMPARE(M1, M2: MODE; ASSUMPTION: PMODECHAIN; SEARCHDEEP: BOOLEAN): BOOLEAN;
+24210 (*IF SEARCHDEEP THEN
+24220 RETURNS TRUE IFF M1 AND M2 ARE EQUIVALENT UNDER THE ASSUMPTION THAT
+24230 NIL AND ALL MODES IN ASSUMPTION ARE EQUIVALENT TO SEARCHLIST
+24240 ELSE
+24250 RETURNS TRUE IFF M1=M2
+24260 *)
+24270 VAR FOUND: BOOLEAN;
+24280 I: INTEGER;
+24290 APTR: PMODECHAIN;
+24300 BEGIN
+24310 IF M1=M2 THEN COMPARE := TRUE
+24320 ELSE IF SEARCHDEEP THEN
+24330 IF M1=NIL THEN
+24340 IF RECURSIVE THEN
+24350 BEGIN
+24360 APTR := ASSUMPTION; FOUND := FALSE;
+24370 WHILE (APTR<>NIL) AND NOT FOUND DO WITH APTR^ DO (*SCAN ASSUMPTIONS*)
+24380 BEGIN FOUND := SCMODE=M2; APTR := LINK END;
+24390 COMPARE := FOUND;
+24400 IF NOT FOUND THEN (*MAKE NEW ASSUMPTION*)
+24410 BEGIN
+24420 NEW(APTR);
+24430 APTR^.LINK := ASSUMPTION; APTR^.SCMODE := M2;
+24440 COMPARE := COMPARE(SEARCHLIST, M2, APTR, TRUE);
+24450 DISPOSE(APTR)
+24460 END
+24470 END
+24480 ELSE COMPARE := FALSE
+24490 ELSE IF M2=NIL THEN COMPARE := COMPARE(NIL, M1, ASSUMPTION, SEARCHDEEP)
+24500 ELSE WITH M1^ DO IF (MDV.MDCNT=M2^.MDV.MDCNT) AND (MDV.MDID=M2^.MDV.MDID) THEN
+24510 BEGIN
+24520 IF MDV.MDID IN [MDIDPROC, MDIDPASC, MDIDREF, MDIDROW] THEN
+24530 FOUND := COMPARE(MDPRRMD, M2^.MDPRRMD, ASSUMPTION, RECURSIVE)
+24540 ELSE FOUND := TRUE;
+24550 IF MDV.MDID IN [MDIDPROC, MDIDPASC] THEN
+24560 FOR I := 0 TO MDV.MDCNT-1 DO
+24570 FOUND := FOUND AND COMPARE(MDPRCPRMS[I], M2^.MDPRCPRMS[I], ASSUMPTION, RECURSIVE)
+24580 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+24590 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDSTRFLDS[I] DO
+24600 FOUND := FOUND
+24610 AND (MDSTRFLEX=M2^.MDSTRFLDS[I].MDSTRFLEX)
+24620 AND COMPARE(MDSTRFMD, M2^.MDSTRFLDS[I].MDSTRFMD, ASSUMPTION, RECURSIVE);
+24630 COMPARE := FOUND
+24640 END
+24650 ELSE COMPARE := FALSE
+24660 ELSE COMPARE := FALSE
+24670 END; (*COMPARE*)
+24680 BEGIN (*FIND*)
+24690 PREV := SEARCHLIST;
+24700 THIS := SEARCHLIST^.MDLINK; (*FIRST MODE TO BE TESTED*)
+24710 WHILE THIS<>NIL DO WITH THIS^ DO
+24720 BEGIN
+24730 NEXT := MDLINK;
+24740 IF COMPARE(SEARCHLIST, THIS, NIL, TRUE) THEN (*MOVE THIS TO START OF SEARCHLIST*)
+24750 BEGIN
+24760 PREV^.MDLINK := NEXT;
+24770 MDLINK := SEARCHLIST^.MDLINK;
+24780 IF PREV=SEARCHLIST THEN PREV := THIS;
+24790 EDISPOSE(SEARCHLIST, LENGTH+MODE1SIZE);
+24800 SEARCHLIST := THIS;
+24810 THIS := NEXT;
+24820 END
+24830 ELSE
+24840 BEGIN PREV := THIS; THIS := NEXT END;
+24850 END;
+24860 END;
+24870 (**)
+24880 (**)
+24890 FUNCTION FINDREF(M: MODE): MODE;
+24900 (*FIND, OR CREATE, A MODE TABLE ENTRY FOR .REF M*)
+24910 VAR CURRENTMD: MODE;
+24920 BEGIN
+24930 ENEW(CURRENTMD, MODE1SIZE);
+24940 WITH CURRENTMD^ DO
+24950 BEGIN
+24960 MDV := MDVREF; MDPRRMD := M;
+24970 MDLINK := REFL; REFL := CURRENTMD
+24980 END;
+24990 FIND(REFL, FALSE, 0);
+25000 FINDREF := REFL
+25010 END;
+25020 (**)
+25030 (**)
+25040 FUNCTION FINDROW(M: MODE; CNT: CNTR): MODE;
+25050 (*FIND, OR CREATE, A MODE TABLE ENTRY FOR ROWS OF M*)
+25060 VAR CURRENTMD: MODE;
+25070 BEGIN
+25080 IF CNT<=0 THEN FINDROW := M
+25090 ELSE BEGIN
+25100 ENEW(CURRENTMD, MODE1SIZE);
+25110 WITH CURRENTMD^ DO
+25120 BEGIN
+25130 MDV := MDVROW; MDPRRMD := M; MDV.MDCNT := CNT;
+25140 IF M<>NIL THEN
+25150 BEGIN MDV.MDIO := M^.MDV.MDIO; MDV.MDSCOPE := M^.MDV.MDSCOPE END;
+25152 IF M^.MDV.MDID IN [MDIDOUT..MDIDINB] THEN MDV.MDPILE := FALSE;
+25160 MDLINK := ROWL; ROWL := CURRENTMD
+25170 END;
+25180 FIND(ROWL, FALSE, 0);
+25190 FINDROW := ROWL
+25200 END
+25210 END;
+25220 (**)
+25230 (**)
+25240 PROCEDURE FINDPRC(RESMD: MODE; CNT: CNTR; CP: CODEPROC);
+25250 (*FIND, OR CREATE, A MODE TABLE ENTRY FOR A .PROC MODE.
+25260 RESMD IS THE RESULT MODE. THE PARAMETER MODES, IF ANY, ARE ON THE SUBSTACK
+25270 *)
+25280 VAR CURRENTMD: MODE;
+25290 LENGTH, I: INTEGER;
+25300 BEGIN
+25310 LENGTH := CNT*SZADDR;
+25320 ENEW(CURRENTMD, LENGTH+MODE1SIZE);
+25330 WITH CURRENTMD^ DO
+25340 BEGIN
+25350 CASE CP OF
+25360 PROC: BEGIN MDV := MDVPROC; MDLINK := PROCL; PROCL := CURRENTMD END;
+25370 PASC: BEGIN MDV := MDVPASC; MDLINK := PASCL; PASCL := CURRENTMD END;
+25390 END;
+25400 MDPRRMD := RESMD; MDV.MDCNT := CNT; MDV.MDDEPROC := CNT=0;
+25410 FOR I := 0 TO CNT-1 DO (*COPY PARAMETERS*)
+25420 MDPRCPRMS[I] := SRSTK[SRSUBP+1+I].MD;
+25430 SUBREST
+25440 END;
+25450 SRSEMP := SRSEMP+1; WITH SRSTK[SRSEMP] DO
+25460 CASE CP OF
+25470 PROC: BEGIN FIND(PROCL, FALSE, LENGTH); MD := PROCL END;
+25480 PASC: BEGIN FIND(PASCL, FALSE, LENGTH); MD := PASCL END;
+25500 END
+25510 END;
+25520 (**)
+25530 (**)
+25540 PROCEDURE FINSTRLEN(M: MODE);
+25550 (*FUNCTION: FILLS IN MDLEN, MDSCOPE AND MDIO FIELDS OF MODE,
+25560 IF ENOUGH INFORMATION IS AVAILABLE.
+25570 *)
+25580 LABEL 7;
+25590 VAR TOTAL: INTEGER; IO, SCOPE: BOOLEAN;
+25600 I: INTEGER;
+25610 BEGIN
+25620 WITH M^ DO
+25630 IF MDV.MDLEN=0 THEN
+25640 BEGIN (*LENGTH HAS NOT BEEN CALCULATED BEFORE*)
+25650 TOTAL := 0; IO := TRUE; SCOPE := FALSE;
+25660 FOR I := MDV.MDCNT-1 DOWNTO 0 DO
+25670 WITH MDSTRFLDS[I] DO
+25680 IF MDSTRFMD=NIL THEN GOTO 7
+25690 ELSE BEGIN
+25700 IF MDSTRFMD^.MDV.MDLEN=0 THEN GOTO 7;
+25710 IO := IO AND MDSTRFMD^.MDV.MDIO;
+25720 SCOPE := SCOPE OR MDSTRFMD^.MDV.MDSCOPE;
+25730 TOTAL := TOTAL+MDSTRFMD^.MDV.MDLEN
+25740 END;
+25750 MDV.MDIO := IO; MDV.MDLEN := TOTAL; MDV.MDSCOPE := SCOPE
+25760 END;
+25770 7: END;
+25780 (**)
+25790 (**)
+25800 PROCEDURE FINSTRUCT(CNT: CNTR);
+25810 (*FIND, OR CREATE, A MODE TABLE ENTRY FOR A .STRUCT MODE.
+25820 THE FIELDS ARE ALREADY ON THE SUBSTACK.
+25830 *)
+25840 VAR CURRENTMD: MODE;
+25850 LENGTH, I: INTEGER;
+25860 BEGIN
+25870 (*+01() LENGTH := SZADDR*CNT; ()+01*)
+25880 (*-01() LENGTH := 2*SZADDR*CNT; ()-01*)
+25890 ENEW(CURRENTMD, LENGTH+MODE1SIZE);
+25900 WITH CURRENTMD^ DO
+25910 BEGIN
+25920 MDV := MDVSTRUCT; MDSTRSDB := 0; MDV.MDCNT := CNT;
+25930 FOR I := 0 TO CNT-1 DO WITH MDSTRFLDS[I] DO
+25940 BEGIN MDSTRFMD := SRSTK[SRSUBP+1+2*I].MD; MDSTRFLEX := SRSTK[SRSUBP+2+2*I].LEX END;
+25950 SUBREST;
+25960 MDLINK := STRUCTL; STRUCTL := CURRENTMD
+25970 END;
+25980 FIND(STRUCTL, FALSE, LENGTH);
+25990 SRSEMP := SRSEMP+1; WITH SRSTK[SRSEMP] DO
+26000 BEGIN MD := STRUCTL; FINSTRLEN(MD) END
+26010 END;
+26020 (**)
+26030 (**)
+26040 PROCEDURE NEWFIELD(LEX: PLEX);
+26050 (*FUNCTION: CALLED FROM SR07A AND SR07B TO PROCESS ANOTHER FIELD-SELECTOR IN A DECLARER*)
+26060 VAR ISLEX: BOOLEAN;
+26070 SEMP: -1..SRSTKSIZE;
+26080 BEGIN
+26090 ISLEX := FALSE;
+26100 SEMP := SRSUBP+1;
+26110 WHILE SEMP<=SRSEMP DO
+26120 BEGIN
+26130 IF ISLEX THEN
+26140 IF SRSTK[SEMP].LEX=LEX THEN SEMERRP(ESE+01, LEX);
+26150 ISLEX := NOT ISLEX;
+26160 SEMP := SEMP+1
+26170 END;
+26180 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].LEX := LEX
+26190 END;
+26200 (**)
+26210 (**)
+26220 PROCEDURE RECURFIX(VAR BASEM: MODE);
+26230 (*BASEM IS THE MODE TO BE DEFINED IN A RECURSIVE MODE-DEFINITION.
+26240 IT IS AT THE START OF ITS APPROPRIATE MODE LIST.
+26250 IT IS REPLACED AT THE START OF THAT LIST BY ANY OTHER MODE EQUIVALENT
+26260 TO ITSELF, AND THEN ALL APPLIED OCCURRENCES OF THE MODE INDICATION WITHIN
+26270 IT ARE REPLACED BY THE NEW BASEM.
+26280 *)
+26290 FUNCTION FIXM(M: MODE): MODE;
+26300 VAR I: INTEGER;
+26310 BEGIN
+26320 IF M=NIL THEN FIXM := BASEM
+26330 ELSE WITH M^ DO
+26340 BEGIN
+26350 IF NOT MDV.MDRECUR THEN
+26360 BEGIN
+26370 IF MDV.MDID IN [MDIDPROC, MDIDPASC, MDIDREF, MDIDROW] THEN
+26380 MDPRRMD := FIXM(MDPRRMD);
+26390 IF MDV.MDID IN [MDIDPROC, MDIDPASC] THEN
+26400 FOR I := 0 TO MDV.MDCNT-1 DO
+26410 MDPRCPRMS[I] := FIXM(MDPRCPRMS[I])
+26420 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+26430 BEGIN
+26440 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDSTRFLDS[I] DO
+26450 MDSTRFMD := FIXM(MDSTRFMD);
+26460 FINSTRLEN(M)
+26470 END;
+26480 MDV.MDRECUR := TRUE
+26490 END;
+26500 FIXM := M
+26510 END
+26520 END; (*OF FIXM*)
+26530 BEGIN (*RECURFIX*)
+26540 WITH BASEM^ DO CASE MDV.MDID OF
+26550 MDIDREF: BEGIN FIND(REFL, TRUE, 0); BASEM := REFL END;
+26560 MDIDROW: BEGIN FIND(ROWL, TRUE, 0); BASEM := ROWL END;
+26570 MDIDPROC: BEGIN FIND(PROCL, TRUE, MDV.MDCNT); BASEM := PROCL END;
+26580 (*DON'T BOTHER WITH MDIDPASC FOR NOW*)
+26590 MDIDSTRUCT: BEGIN FIND(STRUCTL, TRUE,
+26600 (*+11() SZADDR*MDV.MDCNT ()+11*)
+26610 (*+12() 2*SZADDR*MDV.MDCNT ()+12*)
+26620 (*+13() 2*SZADDR*MDV.MDCNT ()+13*) );
+26630 BASEM := STRUCTL END;
+26640 END;
+26650 BASEM := FIXM(BASEM)
+26660 END;
+26670 (**)
+26680 ()+84*)
+26690 (**)
+26700 (*+04()
+26710 BEGIN SIN; S1
+26720 END.
+26730 ()+04*)
--- /dev/null
+63000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+63010 (**)
+63020 (*+84()
+63030 (**)
+63040 (**)
+63050 (*MODE HANDLING*)
+63060 (***************)
+63070 (**)
+63080 FUNCTION LENGTHEN(M: MODE; COUNT: INTEGER): MODE;
+63090 (*FUNCTION: RETURNS A LONG OR SHORT MODE DERIVED FROM M*)
+63100 BEGIN
+63110 LENGTHEN := M; (*DEFAULT*)
+63120 IF COUNT<0 THEN
+63130 SEMERR(ESE+06) (*NO SHORT MODES IMPLEMENTED*)
+63140 ELSE BEGIN
+63150 (*WHEN LONG MODES ARE IMPLEMENTED, SPECIFIC TESTS MUST BE MADE HERE
+63160 FOR MDINT, MDREAL AND MDCOMPL, AND THE APPROPRIATE LONG VERSIONS RETURNED*)
+63170 IF COUNT>0 THEN
+63180 (*+61() IF (COUNT=1) AND (M=MDREAL) THEN LENGTHEN := MDLREAL
+63190 ELSE IF (COUNT=1) AND (M=MDCOMPL) THEN LENGTHEN := MDLCOMPL
+63200 ELSE ()+61*)
+63210 SEMERR(ESE+19)
+63220 END;
+63230 END;
+63240 (**)
+63250 (**)
+63260 FUNCTION TX (*-01() (M: MODE): XTYPE ()-01*);
+63270 BEGIN
+63280 IF M=MDCOMPL THEN TX := 4
+63290 (*+61() ELSE IF M=MDLCOMPL THEN TX := 5 ()+61*)
+63300 ELSE TX := MODEID[M^.MDV.MDID]
+63310 END;
+63320 (**)
+63330 (**)
+63340 PROCEDURE THIPMD(HIP, M: MODE);
+63350 (*FUNCTION: ENSURES THAT THE MODE M IS SUITABLE FOR HIPPING LIKE HIP*)
+63360 BEGIN WITH HIP^.MDV DO
+63370 IF MDID IN [MDIDSKIP,MDIDJUMP,MDIDNIL] THEN
+63380 BEGIN
+63390 IF MDID=MDIDJUMP THEN
+63400 IF M^.MDV.MDID=MDIDPROC THEN SEMERR(ESE+40) ELSE (*NO ACTION*)
+63410 ELSE IF MDID=MDIDNIL THEN
+63420 IF M^.MDV.MDID<>MDIDREF THEN SEMERR(ESE+21);
+63430 IF M^.MDV.MDID IN [MDIDCOVER,MDIDBNDS,MDIDABSENT] THEN SEMERR(ESE+33)
+63440 (*TO CATCH NOSEY PARKERS WHO TRY TO MANUFACTURE .FILES*)
+63450 END
+63460 END;
+63470 (**)
+63480 (**)
+63490 FUNCTION TUNITED(M: MODE): BOOLEAN;
+63500 (*FUNCTION: TESTS WHETHER M IS A UNITED MODE*)
+63510 BEGIN WITH M^ DO
+63520 IF MDV.MDID=MDIDROW THEN
+63530 TUNITED := TUNITED(MDPRRMD)
+63540 ELSE
+63550 TUNITED := (MDV.MDID>=MDIDOUT) AND (MDV.MDID<=MDIDROWS)
+63560 END;
+63570 (**)
+63580 (**)
+63590 PROCEDURE TCOLL;
+63600 (*FUNCTION: ENSURES THAT NO UNIT ON THE SUBSTACK IS A COLLATERAL*)
+63610 VAR SEMP: -1..SRSTKSIZE;
+63620 BEGIN
+63630 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
+63640 WHILE SEMP<=SRSEMP DO
+63650 BEGIN
+63660 IF SBCOLL IN SRSTK[SEMP].SB^.SBINF THEN SEMERR(ESE+18);
+63670 SEMP := SEMP+1
+63680 END
+63690 END;
+63700 (**)
+63710 (**)
+63720 FUNCTION DEPASCAL(PASC: MODE): MODE;
+63730 VAR TEMPM: MODE;
+63740 I: INTEGER;
+63750 BEGIN WITH PASC^ DO BEGIN
+63760 ENEW(TEMPM, MDV.MDCNT*SZADDR + MODE1SIZE);
+63770 FOR I := 1 TO (MDV.MDCNT*SZADDR+MODE1SIZE) DIV SZWORD DO
+63780 TEMPM^.MDWORDS[I] := MDWORDS[I];
+63790 WITH TEMPM^ DO
+63800 BEGIN
+63810 MDV := MDVPROC;
+63820 MDV.MDCNT := PASC^.MDV.MDCNT;
+63830 MDLINK := PROCL
+63840 END;
+63850 PROCL := TEMPM;
+63860 FIND(PROCL, FALSE, MDV.MDCNT*SZADDR);
+63870 DEPASCAL := PROCL;
+63880 END
+63890 END;
+63900 (**)
+63910 (**)
+63920 PROCEDURE CGCSUPP(SB: PSB; M: MODE; ROWCOUNT: INTEGER);
+63930 (*FUNCTION: GENERATES CODE TO COERCE THE UNIT REPRESENTED BY SB TO THE MODE M ROWED ROWCOUNT TIMES.*)
+63940 VAR ROWM, NEWM: MODE;
+63950 WIDTYP: STATE;
+63960 OPCOD : POP;
+63970 I, PSPACE: INTEGER;
+63980 BEGIN WITH SB^ DO
+63990 BEGIN
+64000 WHILE SBMODE<>M DO WITH SBMODE^ DO
+64010 BEGIN
+64020 IF MDV.MDID=MDIDREF THEN
+64030 BEGIN
+64040 IF SBTYP=SBTVAR THEN SBTYP := SBTID
+64050 ELSE IF SBWEAKREF IN SBINF THEN SBINF := SBINF-[SBWEAKREF]
+64060 ELSE
+64070 BEGIN
+64080 GETTOTAL(SB); OPCOD := PDEREF;
+64090 GENOP(OPCOD,MDPRRMD,OLIST3,NIL);
+64100 IF GENDPOCV=OCVNONE THEN
+64110 EMITX2(OPCOD,OCVSB,ORD(SB),OCVRES,ORD(SB))
+64120 ELSE EMITX3(OPCOD,OCVSB,ORD(SB),GENDPOCV,GENDPVAL,OCVRES,ORD(SB))
+64130 END;
+64140 SBMODE := MDPRRMD;
+64150 END
+64160 ELSE IF MDV.MDDEPROC THEN
+64170 BEGIN
+64180 GETTOTAL(SB);
+64190 IF MDV.MDID=MDIDPROC THEN
+64200 CGDEPROC(SB)
+64210 ELSE (*MDV.MDID=MDIDPASC*)
+64220 CGPASC(SB, SB);
+64230 SBMODE := MDPRRMD;
+64240 END
+64250 ELSE BEGIN
+64260 GETTOTAL(SB);
+64270 IF MDV.MDID<=MDIDSTRNG THEN
+64280 BEGIN CASE MDV.MDID OF
+64290 MDIDINT : BEGIN WIDTYP := 0; NEWM := MDREAL END;
+64300 (*+61() MDIDLINT : BEGIN WIDTYP := 1; NEWM := MDLREAL END; ()+61*)
+64310 MDIDREAL : BEGIN WIDTYP := 2; NEWM := MDCOMPL END;
+64320 (*+61() MDIDLREAL: BEGIN WIDTYP := 3; NEWM := MDLCOMPL END; ()+61*)
+64330 MDIDCHAR : BEGIN WIDTYP := 4; NEWM := MDSTRNG END;
+64340 MDIDBITS : BEGIN WIDTYP := 5; NEWM := ROWBOOL END;
+64350 MDIDBYTES: BEGIN WIDTYP := 6; NEWM := ROWCHAR END;
+64360 MDIDSTRNG: BEGIN WIDTYP := 7; NEWM := ROWCHAR END;
+64370 END;
+64380 EMITX2(PWIDEN+WIDTYP,OCVSB,ORD(SB),OCVRES,ORD(SB));
+64382 SBMODE := NEWM;
+64390 IF (SBMODE^.MDV.MDID=MDIDROW) AND (SBMODE^.MDPRRMD=M) AND (ROWCOUNT>0) THEN
+64400 BEGIN ROWCOUNT := ROWCOUNT-1; M := SBMODE END
+64410 END
+64420 ELSE IF MDV.MDID=MDIDPASC THEN
+64430 BEGIN
+64432 PSPACE := 0;
+64434 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDPRCPRMS[I]^ DO
+64436 IF MDV.MDPILE THEN PSPACE := PSPACE+SZADDR ELSE PSPACE := PSPACE+MDV.MDLEN;
+64440 EMITX3(PLOADRTP, OCVSB, ORD(SB), OCVIMMED, PSPACE, OCVRES,ORD(SB));
+64450 SBMODE := DEPASCAL(SBMODE)
+64460 END
+64470 ELSE BEGIN
+64480 IF M<>MDERROR THEN MODERR(SBMODE, ESE+33);
+64490 SBMODE := M; SBTYP := SBTVOID;
+64500 END;
+64510 END;
+64520 END;
+64530 IF ROWCOUNT>0 THEN
+64540 BEGIN
+64550 GETTOTAL(SB);
+64560 IF SBMODE^.MDV.MDID=MDIDROW THEN
+64570 BEGIN
+64580 WITH SBMODE^ DO ROWM := FINDROW(MDPRRMD, MDV.MDCNT+ROWCOUNT);
+64590 EMITX3(PROWMULT, OCVSB, ORD(SB), OCVIMMED, ROWM^.MDV.MDCNT, OCVRES, ORD(SB))
+64600 END
+64610 ELSE
+64620 BEGIN
+64630 ROWM := FINDROW(SBMODE, ROWCOUNT);
+64640 GENDP(ROWM);
+64650 EMITX4(PROWNONMULT, OCVSB, ORD(SB), OCVIMMED, ROWM^.MDV.MDCNT, GENDPOCV, GENDPVAL, OCVRES, ORD(SB))
+64660 END;
+64670 SBMODE := ROWM;
+64680 END
+64690 END
+64700 END;
+64710 (**)
+64720 (**)
+64730 FUNCTION COSOFT(M: MODE): MODE;
+64740 (*FUNCTION: FINDS SOFTEST COERCION OF M*)
+64750 BEGIN
+64760 WHILE M^.MDV.MDDEPROC DO
+64770 M := M^.MDPRRMD;
+64780 COSOFT := M
+64790 END;
+64800 (**)
+64810 (**)
+64820 FUNCTION COMEEK(SRCM: MODE): MODE;
+64830 (*FUNCTION: MEEKLY COERCES SRCM AS FAR AS POSSIBLE
+64840 YIELDS THE MODE REACHED.
+64850 *)
+64860 LABEL 9;
+64870 BEGIN
+64880 LASTPREF := MDVOID; LASTPROC := NIL; COERCLEN := 0;
+64890 WHILE SRCM<>NIL DO WITH SRCM^ DO
+64900 IF MDV.MDDEPROC THEN
+64910 BEGIN LASTPROC := SRCM; LASTPREF := SRCM; COERCLEN := COERCLEN+1; SRCM := MDPRRMD END
+64920 ELSE IF MDV.MDID=MDIDREF THEN
+64930 BEGIN LASTPREF := SRCM; COERCLEN := COERCLEN+1; SRCM := MDPRRMD END
+64940 ELSE GOTO 9;
+64950 9:COMEEK := SRCM
+64960 END;
+64970 (**)
+64980 (**)
+64990 FUNCTION COFIRM(SRCM, DSTM: MODE): MODE;
+65000 (*FUNCTION: FIRMLY COERCES SRCM AS FAR AS POSSIBLE IN THE DIRECTION OF DSTM.
+65010 YIELDS THE MODE (POSSIBLY DSTM) REACHED.
+65020 *)
+65030 LABEL 9;
+65040 BEGIN
+65050 LASTPREF := MDVOID; LASTPROC := NIL; COERCLEN := 0;
+65060 WHILE SRCM<>DSTM DO WITH SRCM^ DO
+65070 IF MDV.MDDEPROC THEN
+65080 BEGIN LASTPROC := SRCM; LASTPREF := SRCM; COERCLEN := COERCLEN+1; SRCM := MDPRRMD END
+65090 ELSE IF MDV.MDID=MDIDREF THEN
+65100 BEGIN LASTPREF := SRCM; COERCLEN := COERCLEN+1; SRCM := MDPRRMD END
+65110 ELSE IF MDV.MDID=MDIDPASC THEN
+65120 SRCM := DEPASCAL(SRCM)
+65130 ELSE GOTO 9;
+65140 9:COFIRM := SRCM
+65150 END;
+65160 (**)
+65170 (**)
+65180 FUNCTION COWEAK(M: MODE): MODE;
+65190 (*FUNCTION: FINDS WEAKEST COERCION OF M*)
+65200 BEGIN
+65210 M := COMEEK(M);
+65220 IF LASTPREF^.MDV.MDID=MDIDREF THEN
+65230 M := LASTPREF;
+65240 COWEAK := M
+65250 END;
+65260 (**)
+65270 (**)
+65280 FUNCTION TSTRENGTH(SRCM, DSTM: MODE): STRTYP;
+65290 (*FUNCTION: DETERMINES THE STRENGTH OF COERCION NECESSARY TO GET FROM SRCM TO DSTM*)
+65300 BEGIN
+65310 IF DSTM=SRCM THEN TSTRENGTH := STREMPTY
+65320 ELSE IF COSOFT(DSTM)=COSOFT(SRCM) THEN TSTRENGTH := STRSOFT
+65330 ELSE IF COWEAK(DSTM)=COWEAK(SRCM) THEN TSTRENGTH := STRWEAK
+65340 ELSE IF COMEEK(DSTM)=COMEEK(SRCM) THEN TSTRENGTH := STRMEEK
+65350 ELSE TSTRENGTH := STRFIRM
+65360 END;
+65370 (**)
+65380 (**)
+65390 FUNCTION BALMOIDS(M1, M2: MODE): MODE;
+65400 (*FUNCTION: RETURNS THE PIVOTAL MODE OF THE BALANCE M1/M2.
+65410 ON EXIT, M1COERC AND M2COERC CONTAIN THE NECESSARY STRENGTHS.
+65420 *)
+65430 VAR FIRMM1, FIRMM2: MODE;
+65440 LEN1, LEN2, DIFF, I: INTEGER;
+65450 BEGIN
+65460 M1COERC := STREMPTY; M2COERC := STREMPTY;
+65470 IF (M1^.MDV.MDID>=MDIDSKIP) AND (M1^.MDV.MDID<=MDIDNIL) THEN
+65480 BEGIN M1COERC := STRSTRONG; BALMOIDS := M2 END;
+65490 IF (M2^.MDV.MDID>=MDIDSKIP) AND (M2^.MDV.MDID<=MDIDNIL) THEN
+65500 BEGIN M2COERC := STRSTRONG; BALMOIDS := M1 END;
+65510 IF (M1COERC=STREMPTY) AND (M2COERC=STREMPTY) THEN
+65520 IF M1=M2 THEN BALMOIDS := M1
+65530 ELSE BEGIN
+65540 FIRMM1 := COFIRM(M1, NIL); LEN1 := COERCLEN;
+65550 FIRMM2 := COFIRM(M2, NIL); LEN2 := COERCLEN;
+65560 IF FIRMM1=FIRMM2 THEN
+65570 BEGIN
+65580 DIFF := LEN2-LEN1;
+65590 IF DIFF>=0 THEN
+65600 BEGIN FIRMM1 := M1; FIRMM2 := M2 END
+65610 ELSE
+65620 BEGIN FIRMM1 := M2; FIRMM2 := M1; DIFF := -DIFF END;
+65630 FOR I := DIFF-1 DOWNTO 0 DO
+65640 FIRMM2 := FIRMM2^.MDPRRMD;
+65650 WHILE FIRMM1<>FIRMM2 DO
+65660 IF FIRMM1^.MDV.MDID=MDIDPASC THEN
+65670 BEGIN
+65680 FIRMM1 := DEPASCAL(FIRMM1);
+65690 FIRMM2 := DEPASCAL(FIRMM2)
+65700 END
+65710 ELSE
+65720 BEGIN
+65730 FIRMM1 := FIRMM1^.MDPRRMD;
+65740 FIRMM2 := FIRMM2^.MDPRRMD
+65750 END;
+65760 M1COERC := TSTRENGTH(M1, FIRMM1);
+65770 M2COERC := TSTRENGTH(M2, FIRMM1);
+65780 BALMOIDS := FIRMM1
+65790 END
+65800 ELSE BEGIN
+65810 WITH FIRMM1^.MDV DO
+65820 IF MDID=MDIDROW THEN LEN1 := 100+MDCNT ELSE LEN1 := MODEID[MDID];
+65830 WITH FIRMM2^.MDV DO
+65840 IF MDID=MDIDROW THEN LEN2 := 100+MDCNT ELSE LEN2 := MODEID[MDID];
+65850 IF LEN1<LEN2 THEN (*STRONG COERCION, IF ANY, IS FROM M1 TO FIRMM2*)
+65860 BEGIN
+65870 M1COERC := STRSTRONG; M2COERC := TSTRENGTH(M2, FIRMM2);
+65880 BALMOIDS := FIRMM2;
+65890 END
+65900 ELSE
+65910 BEGIN
+65920 M1COERC := TSTRENGTH(M1, FIRMM1); M2COERC := STRSTRONG;
+65930 BALMOIDS := FIRMM1;
+65940 END;
+65950 END;
+65960 END
+65970 END;
+65980 (**)
+65990 (**)
+66000 PROCEDURE CGCOERCE(SB: PSB (*CONTAINING SOURCE MODE*); M: MODE (*DESTINATION MODE*));
+66010 VAR FIRMM, MM: MODE;
+66020 SB1, SB2: PSB;
+66030 MODENO: -1..31;
+66040 SPACE: 0..MAXSIZE;
+66050 I:0..MAXINT;
+66052 OPCOD: POP;
+66060 BEGIN WITH SB^ DO
+66070 IF SBMODE<>M THEN
+66080 BEGIN
+66090 FIRMM := COFIRM(SBMODE,M);
+66100 IF M=MDVOID THEN (*VOIDING COERCION NEEDED*)
+66110 BEGIN
+66120 IF (SBMORF IN SBINF) AND (LASTPROC<>NIL) THEN
+66130 CGCSUPP(SB, LASTPROC^.MDPRRMD, 0);
+66140 IF SBTYP>SBTDEN THEN (*THE VALUE IS ALREADY STORED SOMEWHERE*)
+66150 BEGIN
+66160 IF SBNAKED IN SBINF THEN BEGIN EMITX1(PVOIDNAKED,OCVSB,ORD(SB)); STACKSB(SB) END
+66180 ELSE IF SBMODE^.MDV.MDPILE THEN BEGIN EMITX1(PVOIDNORMAL,OCVSB,ORD(SB)); STACKSB(SB) END
+66182 ELSE IF SBTYP IN [SBTSTK..SBTSTKN] THEN EMITX1(PASP, OCVIMMED, SBMODE^.MDV.MDLEN);
+66190 END;
+66200 IF (SBVOIDWARN IN SBINF) AND (SBMODE<>MDVOID) THEN
+66210 OUTERR(ESE+10, WARNING, NIL);
+66220 SBINF := SBINF-[SBNAKED]; FILL(SBTVOID,SB);
+66230 END
+66240 ELSE IF TUNITED(M) THEN (*TRANSPUT COERCION*)
+66250 BEGIN
+66260 FIRMM := COMEEK(SBMODE);
+66270 IF (FIRMM<>PRCVF) AND (FIRMM<>PASCVF) AND
+66280 ((M=MDIN) OR (M=MDINB) OR (M=ROWIN) OR (M=ROWINB) OR (M=MDROWS)) THEN
+66290 MM := COWEAK(SBMODE)
+66300 ELSE IF FIRMM=MDSKIP THEN
+66310 BEGIN MM := MDCHAR; FIRMM := MM END (*TO FORCE A RUN-TIME ERROR*)
+66320 ELSE MM := FIRMM;
+66330 CGCOERCE(SB, MM);
+66340 IF M<>MDROWS THEN
+66350 BEGIN
+66360 IF FIRMM^.MDV.MDID=MDIDROW THEN
+66370 MODENO := TX(FIRMM^.MDPRRMD)+16
+66380 ELSE MODENO := TX(FIRMM);
+66390 SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := MODENO; TWIST; LOADSTK(SB1);
+66400 (*-01() IF (M^.MDV.MDID=MDIDNUMBER) AND (MODENO=0(*INT*)) THEN
+66410 BEGIN
+66420 SB2 := PUSHSB(MDINT); SB2^.SBLEN := SZREAL-SZINT; SB2^.SBINF := SB2^.SBINF+[SBUNION]; SB2^.SBTYP := SBTLIT; SB1^.SBVALUE := 0; TWIST; LOADSTK(SB2);
+66430 GETTOTAL(SB); LOADSTK(SB);
+66440 COMBINE; SBTYP := SBTSTKN;
+66450 END;
+66460 ()-01*)
+66470 GETTOTAL(SB);
+66480 FOR I:= SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);(*DEAL WITH DELAYS*)
+66490 SBDELAYS:=0;LOADSTK(SB);
+66500 COMBINE; SBTYP := SBTSTKN; SBINF := SBINF+[SBUNION];
+66530 IF M^.MDV.MDID=MDIDROW THEN (*SINGLE UNIT TO BE ROWED TO A DATA LIST*)
+66540 BEGIN
+66550 (*+05() IF (RTSTKDEPTH MOD 4)<>0 THEN
+66560 BEGIN SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := TX(MDVOID);
+66570 LOADSTK(SB1); COMBINE; SB^.SBTYP := SBTSTKN END;
+66580 ()+05*)
+66590 SPACE := SBLEN;
+66600 SB1 := PUSHSB(MDVOID); UNSTACKSB; SB1^.SBLEN := SPACE+SZDL;
+66610 EMITX3(PDATALIST, OCVSB, ORD(SB), OCVIMMED, SPACE, OCVRES, ORD(SB1));
+66620 SBLEN := SB1^.SBLEN; SBINF := SBINF-[SBUNION]; SBTYP := SB1^.SBTYP;
+66630 UNSTACKSB; DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; STACKSB(SB);
+66640 END
+66650 ELSE M := MM; (*SBMODE WILL BE MM, FOR BENEFIT OF STKMAP*)
+66660 END
+66670 ELSE GETTOTAL(SB)
+66680 END
+66690 ELSE WITH SBMODE^ DO
+66700 IF (MDV.MDID<MDIDSKIP) OR (MDV.MDID>MDIDNIL) THEN (*NOT HIP*)
+66710 WITH M^ DO
+66720 IF MDV.MDID<>MDIDROW THEN
+66730 CGCSUPP(SB, M, 0)
+66740 ELSE IF COFIRM(SBMODE, MDPRRMD)=MDPRRMD THEN
+66750 CGCSUPP(SB, MDPRRMD, MDV.MDCNT)
+66760 ELSE IF FIRMM^.MDV.MDID=MDIDROW THEN
+66770 CGCSUPP(SB, FIRMM, MDV.MDCNT-FIRMM^.MDV.MDCNT)
+66780 ELSE
+66790 CGCSUPP(SB, MDPRRMD, MDV.MDCNT)
+66800 ELSE CASE MDV.MDID OF
+66810 MDIDSKIP:
+66820 BEGIN UNSTACKSB;
+66830 IF M^.MDV.MDID=MDIDSTRUCT THEN
+66840 BEGIN GENDP(M); EMITX2(PSKIPSTRUCT, GENDPOCV, GENDPVAL,OCVRES,ORD(SB)) END
+66850 ELSE
+66852 BEGIN
+66854 IF M^.MDV.MDPILE THEN OPCOD := PSKIP+1
+66856 ELSE IF M^.MDV.MDLEN>SZINT THEN OPCOD := PSKIP+2
+66857 ELSE OPCOD := PSKIP;
+66858 EMITX1(OPCOD, OCVRES, ORD(SB));
+66859 END;
+66860 END;
+66870 MDIDJUMP: (*NO ACTION*);
+66880 MDIDNIL: BEGIN UNSTACKSB; EMITX1(PNIL, OCVRES, ORD(SB)) END
+66890 END;
+66900 SBMODE := M
+66910 END
+66920 END;
+66930 (**)
+66940 (**)
+66950 PROCEDURE CGBALB(SB: PSB; M: MODE);
+66960 (*EACH UNIT TO BE BALANCED*)
+66970 VAR I: INTEGER;
+66980 SB1: PSB;
+66990 BEGIN WITH SB^ DO
+67000 IF SBMODE<>MDJUMP THEN
+67010 BEGIN
+67012 (*+42() SETTEXTSTATE; ()+42*)
+67020 FIXUPF(SBXPTR); (*SBXPTR WAS SET IN CGIBAL*)
+67030 STACKSB(SB);
+67040 CGCOERCE(SB, M);
+67050 FOR I := SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);
+67060 SBDELAYS := 0;
+67070 LOADTOTAL(SB);
+67080 IF SBUNION IN SBINF THEN
+67090 WHILE SBLEN<BALANLEN+SZWORD DO (*TO MAKE STKMAP HAPPY*)
+67100 BEGIN SB1 := PUSHSB(MDVOID); CGCOERCE(RTSTACK, M); COMBINE END;
+67110 IF (SBTYP=SBTDL) AND (SBLEN<BALANLEN) THEN
+67120 BEGIN
+67130 EMITX1(PHOIST, OCVIMMED, BALANLEN-SBLEN);
+67140 RTSTKDEPTH := RTSTKDEPTH+BALANLEN-SBLEN;
+67150 SBLEN := BALANLEN;
+67160 END;
+67170 UNSTACKSB;
+67180 IF SB<>SRSTK[SRSEMP].SB THEN
+67190 GENFLAD
+67200 END
+67210 END;
+67220 (**)
+67230 (**)
+67240 FUNCTION COERCE (*-01() (M: MODE): MODE ()-01*);
+67250 (*FUNCTION: GENERATE CODE TO PERFORM THE APPROPRIATE COERCIONS FOR THE UNIT ON THE STACK.
+67260 REDUCES THE STACK TO CONTAIN A SINGLE BLOCK REPRESENTING THE RESULTING UNIT.
+67270 RETURNS M UNALTERED ???
+67280 *)
+67290 VAR SEMP: -1..SRSTKSIZE;
+67300 NOTJUMP: BOOLEAN;
+67310 I: INTEGER;
+67320 BEGIN
+67330 IF BALFLAG THEN
+67340 BEGIN
+67350 STARTCHAIN;
+67360 SEMP := SRSUBP+1;
+67370 WHILE SEMP<=SRSEMP DO WITH SRSTK[SEMP] DO
+67380 BEGIN
+67390 THIPMD(SB^.SBMODE, M);
+67400 CGBALB(SB, M);
+67410 IF SEMP<>SRSEMP THEN DISPOSE(SB);
+67420 SEMP := SEMP+1
+67430 END;
+67440 SUBREST;
+67450 SRSEMP := SRSEMP+1; SRSTK[SRSEMP] := SRSTK[SEMP-1]; (*AS KEPT*)
+67460 STACKSB(SRSTK[SRSEMP].SB);
+67470 CGBALC;
+67480 BALFLAG := FALSE;
+67490 END
+67500 ELSE WITH SRSTK[SRSEMP] DO WITH SB^ DO
+67510 BEGIN
+67520 THIPMD(SBMODE, M);
+67530 NOTJUMP := SBMODE<>MDJUMP;
+67540 CGCOERCE(SB, M);
+67550 IF NOTJUMP THEN WITH SB^ DO
+67560 FOR I := SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);
+67570 SBDELAYS := 0
+67580 END;
+67590 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF];
+67600 COERCE := M
+67610 END;
+67620 (**)
+67630 (**)
+67640 FUNCTION BALANCE(STRENGTH: STRTYP): MODE;
+67650 (*FUNCTION: DEDUCES THE MODE OF THE BALANCE ON THE SUBSTACK.
+67660 COMPLAINS IF STRENGTH IS INSUFFICIENT.
+67670 RETURNS THE MODE OF THE BALANCE.
+67680 *)
+67690 VAR COMM, M: MODE;
+67700 SEMP: -1..SRSTKSIZE;
+67710 BEGIN
+67720 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
+67730 COMM := SRSTK[SEMP].SB^.SBMODE;
+67740 WITH COMM^.MDV DO
+67750 IF (MDID<MDIDSKIP) OR (MDID>MDIDNIL) (*NOT HIPMODE*) THEN BALSTR := STREMPTY
+67760 ELSE BALSTR := STRSTRONG;
+67770 WHILE SEMP<SRSEMP DO
+67780 BEGIN
+67790 SEMP := SEMP+1;
+67800 COMM := BALMOIDS(COMM, SRSTK[SEMP].SB^.SBMODE);
+67810 IF BALSTR<M1COERC THEN BALSTR := M1COERC;
+67820 IF BALSTR>M2COERC THEN BALSTR := M2COERC;
+67830 END;
+67840 IF BALSTR>STRENGTH THEN
+67850 IF (STRENGTH=STRFIRM) AND (COMM^.MDV.MDID=MDIDROW) THEN
+67860 COMM := MDROWS
+67870 ELSE BEGIN
+67880 CASE STRENGTH OF
+67890 STRSOFT: SEMERR(ESE+26);
+67900 STRWEAK: SEMERR(ESE+27);
+67910 STRMEEK: SEMERR(ESE+28);
+67920 STRFIRM: SEMERR(ESE+29);
+67930 END;
+67940 COMM := MDERROR;
+67950 END;
+67960 BALANCE := COMM
+67970 END;
+67980 (**)
+67990 (**)
+68000 FUNCTION SOFT: MODE;
+68010 (*FUNCTION: PERFORMS SOFTEST COERCION ON UNIT OR BALANCE ON THE STACK*)
+68020 BEGIN
+68030 TCOLL;
+68040 SOFT := COERCE(COSOFT(BALANCE(STRSOFT)))
+68050 END;
+68060 (**)
+68070 (**)
+68080 FUNCTION WEAK: MODE;
+68090 (*FUNCTION: PERFORMS WEAKEST COERCION ON UNIT OR BALANCE ON THE STACK*)
+68100 BEGIN
+68110 TCOLL;
+68120 WEAK := COERCE(COWEAK(BALANCE(STRWEAK)))
+68130 END;
+68140 (**)
+68150 (**)
+68160 FUNCTION FIRMBAL: MODE;
+68170 (*FUNCTION: PERFORMS FIRM BALANCE (BUT DOES NOT COERCE)*)
+68180 BEGIN
+68190 TCOLL;
+68200 FIRMBAL := COFIRM(BALANCE(STRFIRM), NIL);
+68210 END;
+68220 (**)
+68230 (**)
+68240 FUNCTION MEEK: MODE;
+68250 (*FUNCTION: PERFORMS FIRMEST COERCION ON UNIT OR BALANCE ON THE STACK*)
+68260 BEGIN
+68270 TCOLL;
+68280 MEEK := COERCE(COMEEK(BALANCE(STRMEEK)));
+68290 END;
+68300 (**)
+68310 (**)
+68320 FUNCTION UNITESTO(SRCM, DSTM: MODE): BOOLEAN;
+68330 (*DSTM MUST BE ONE OF THE TRANSPUT MODES OUT, IN, OUT, INB OR NUMBER.
+68340 FUNCTION: DETERMINES WHETHER SRCM CAN BE UNITED TO DSTM.
+68350 *)
+68360 LABEL 9;
+68370 VAR WEAKM, MEEKM: MODE;
+68380 BEGIN
+68390 IF SRCM=MDERROR THEN
+68400 BEGIN UNITESTO := TRUE; GOTO 9 END;
+68410 IF DSTM^.MDV.MDID=MDIDROW THEN
+68420 IF SRCM=DSTM THEN
+68430 BEGIN UNITESTO := TRUE; GOTO 9 END
+68440 ELSE DSTM := DSTM^.MDPRRMD;
+68450 WEAKM := COWEAK(SRCM); MEEKM := COMEEK(WEAKM);
+68460 UNITESTO := FALSE;
+68470 WITH DSTM^.MDV DO
+68480 IF (MDID>=MDIDOUT) AND (MDID<=MDIDNUMBER) (*A UNITED MODE*) THEN
+68490 CASE MDID OF
+68500 MDIDOUT:
+68510 IF (MEEKM=PRCVF) OR (MEEKM=PASCVF) OR (MEEKM^.MDV.MDIO) THEN UNITESTO := TRUE;
+68520 MDIDIN:
+68530 IF (MEEKM=PRCVF) OR (MEEKM=PASCVF) THEN UNITESTO := TRUE
+68540 ELSE IF WEAKM^.MDV.MDID=MDIDREF THEN
+68550 UNITESTO := MEEKM^.MDV.MDIO;
+68560 MDIDOUTB:
+68570 UNITESTO := MEEKM^.MDV.MDIO;
+68580 MDIDINB:
+68590 IF WEAKM^.MDV.MDID=MDIDREF THEN
+68600 UNITESTO := MEEKM^.MDV.MDIO;
+68610 MDIDNUMBER:
+68620 IF MEEKM^.MDV.MDID<=MDIDLREAL THEN UNITESTO := TRUE
+68630 END;
+68640 9: END;
+68650 (**)
+68660 (**)
+68670 FUNCTION UNITEDBAL(M: MODE): BOOLEAN;
+68680 (*FUNCTION: DETERMINES WHETHER THE UNIT OR BALANCE ON THE STACK CAN BE
+68690 UNITED TO THE TRANSPUT MODE M.
+68700 *)
+68710 VAR SEMP: -1..SRSTKSIZE;
+68720 BALCOUNT: INTEGER;
+68730 BEGIN
+68740 BALCOUNT := 0;
+68750 BALANLEN := 0;
+68760 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
+68770 WHILE SEMP<=SRSEMP DO WITH SRSTK[SEMP] DO WITH SB^ DO
+68780 BEGIN
+68790 IF UNITESTO(SBMODE, M) THEN BALCOUNT := BALCOUNT+1
+68800 ELSE IF (SBMODE^.MDV.MDID<MDIDSKIP) OR (SBMODE^.MDV.MDID>MDIDNIL) THEN BALCOUNT := -MAXINT;
+68810 IF SBLEN>BALANLEN THEN BALANLEN := SBLEN;
+68820 SEMP := SEMP+1
+68830 END;
+68840 UNITEDBAL := BALCOUNT>0
+68850 END;
+68860 (**)
+68870 (**)
+68880 PROCEDURE STRONG;
+68890 (*FUNCTION: STRONGLY COERCES THE UNIT OR BALANCE ON THE STACK AS FAR AS THE
+68900 MODE ON THE SC CHAIN.
+68910 WHEN THE A POSTERIORI MODE IS VOID IT IS POSSIBLE TO GENERATE DIRECTLY THE COERCION CODE
+68920 WITHOUT CALLING A BALANCING ROUTINE. THIS IS DUE TO THE FACT THAT ALL MODES CAN BE STRONGLY
+68930 COERCED TO VOID. HOWEVER, COLLATERAL-CLAUSES MAY NOT APPEAR IN STRONG VOID CONTEXTS.
+68940 *)
+68950 VAR M, M1: MODE;
+68960 BEGIN
+68970 M := SCPOP;
+68980 IF M=MDVOID THEN
+68990 TCOLL
+69000 ELSE WITH M^ DO
+69010 BEGIN
+69020 IF MDV.MDID=MDIDROW THEN M1 := MDPRRMD ELSE M1 := M;
+69030 WITH M1^.MDV DO IF (MDID>=MDIDOUT) AND (MDID<=MDIDNUMBER) (*UNITEDMODE*) THEN
+69040 IF NOT UNITEDBAL(M) THEN
+69050 BEGIN
+69060 SEMERR(ESE+31);
+69070 M := MDERROR
+69080 END
+69090 END;
+69100 M := COERCE(M)
+69110 END;
+69120 (**)
+69130 (**)
+69140 PROCEDURE SETBALFLAG;
+69150 (*FUNCTION: SETS THE BALANCE FLAG (BALFLAG) FOR THE VALUE OF A RANGE.
+69160 IF THE RANGE VALUE MAY BE ANY OF A NUMBER (>1) UNITS THEN THE FLAG IS SET AND THE STACK HOLDS
+69170 A MARK PLUS THE BLOCKS FOR THE UNITS. F THE RANGE VALUE IS A SINGLE UNIT,
+69180 THE FLAG IS CLEARED AND THE STACK HOLDS ONLY THE SINGLE BLOCK.
+69190 *)
+69200 VAR T: PSB;
+69210 BEGIN
+69220 IF SRSEMP<>SRSUBP+1 (*NOT ONE UNIT*) THEN
+69230 BALFLAG := TRUE
+69240 ELSE BEGIN
+69250 T := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1;
+69260 SUBREST;
+69270 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := T
+69280 END
+69290 END;
+69300 (**)
+69310 (**)
+69320 PROCEDURE INNERBAL;
+69330 (*FUNCTION: EXECUTED AFTER PROCESSING AN "INNER UNIT" OF A BALANCE.
+69340 EVERY BALANCE CONSISTS OF ONE OR MORE UNITS WHICH ARE EVENTUALLY BALANCED.
+69350 EACH UNIT EXCEPT THE LAST IS CALLED AN INNER UNIT. NOTE THAT EACH UNIT IN A BALANCE MAY IN FACT
+69360 BE A SINGLE BASIC (NON-BALANCE) UNIT OR A SEQUENCE OF BASIC UNITS WHICH RESULTED FROM SOME BALANCE.
+69370 *)
+69380 VAR I: INTEGER; T: -1..SRSTKSIZE;
+69390 BEGIN
+69400 IF NOT BALFLAG THEN CGIBAL
+69410 ELSE BEGIN
+69420 BALFLAG := FALSE;
+69430 T := SRSTK[SRSUBP].SUBP;
+69440 FOR I := SRSUBP TO SRSEMP-1 DO
+69450 SRSTK[I] := SRSTK[I+1];
+69460 SRSEMP := SRSEMP-1;
+69470 SRSUBP := T
+69480 END
+69490 END;
+69500 (**)
+69510 (**)
+69520 PROCEDURE LASTIBAL;
+69530 (*FUNCTION: CALLS INNERBAL IF NECESSARY*)
+69540 BEGIN
+69550 IF (BALFLAG) OR (SRSEMP<>SRSUBP+1) THEN INNERBAL
+69560 END;
+69570 (**)
+69580 (**)
+69590 PROCEDURE MEEKLOAD(M: MODE; ERR: INTEGER);
+69600 (*EXPECTS THE MAXIMUM COERCION OF THE STACKED UNIT OR BALANCE TO BE M*)
+69610 VAR M1: MODE;
+69620 BEGIN
+69630 M1 := MEEK;
+69640 IF M1<>M THEN MODERR(M1, ERR);
+69650 CGFIRM
+69660 END;
+69670 (**)
+69680 (**)
+69690 PROCEDURE GETOPDM(PROCM: MODE);
+69700 (*FUNCTION: PROCM IS THE MODE OF SOME OPERATOR.
+69710 SETS LHMODE AND RHMODE.*)
+69720 BEGIN WITH PROCM^ DO
+69730 IF MDV.MDCNT=1 THEN
+69740 BEGIN LHMODE := MDABSENT; RHMODE := MDPRCPRMS[0] END
+69750 ELSE
+69760 BEGIN LHMODE := MDPRCPRMS[0]; RHMODE := MDPRCPRMS[1] END
+69770 END;
+69780 (**)
+69790 ()+84*)
--- /dev/null
+93000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+93010 (*+82()
+93020 (**)
+93030 (*PARSING*)
+93040 (***********)
+93050 (**)
+93060 FUNCTION ACTIONROUTINE(ARTN: RTNTYPE): BOOLEAN;
+93070 LABEL 9;
+93080 VAR STB: PSTB;
+93090 M: MODE;
+93100 OPL, OPR: PSTB;
+93110 PREVLX: LXIOTYPE; INPT: PLEX;
+93120 HEAD, PTR, PTR1: PLEXQ;
+93130 LEV: INTEGER;
+93140 PL, PR, I: INTEGER;
+93150 PROCEDURE FORCEMATCH(LEX: PLEX);
+93160 (*FORCES SRPLSTK[PLSTKP]=LEX*)
+93170 LABEL 100;
+93180 VAR TSTKP: 0..SRPLSTKSIZE;
+93190 SLEX: PLEX;
+93200 BEGIN TSTKP := PLSTKP;
+93210 100: SLEX := SRPLSTK[TSTKP];
+93220 IF SLEX^.LXV.LXCLASS2=1 THEN (*.FOR, ..., .WHILE*) SLEX := LEXWHILE;
+93230 WITH SLEX^.LXV DO
+93240 IF (LXCLASS2<>1) AND (LXCLASS2<>2) AND (LXIO<>LXIOSTART) OR (SLEX<>LEX) AND (TSTKP=PLSTKP) THEN
+93250 BEGIN TSTKP := TSTKP+1; GOTO 100 END;
+93260 IF SLEX=LEX THEN (*LEAVE ALONE OR POP*) PLSTKP := TSTKP
+93270 ELSE (*PUSH*) BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := LEX END
+93280 END; (*OF FORCEMATCH*)
+93290 BEGIN
+93300 (*+21()
+93310 MONITORSEMANTIC(ARTN);
+93320 ()+21*)
+93330 CASE ARTN OF
+93340 (**)
+93350 1: (*AR1*)
+93360 (*FUNCTION: INVOKED AFTER OPERAND SURROUNDED BY DYADIC-OPERATORS.
+93370 DECIDES WHICH OPERATORS TAKE PRECEDENCE.
+93380 TRUE IFF OPERATOR TO LEFT OF OPERAND TAKES PRECEDENCE;
+93390 I.E. LEFT PRIORITY IS GREATER THAN OR EQUAL TO RIGHT PRIORITY.
+93400 *)
+93410 BEGIN
+93420 OPL := SRPLSTK[PLSTKP+1]^.LXV.LXPSTB; OPR := INP^.LXV.LXPSTB;
+93430 IF OPL<>NIL THEN PL := OPL^.STDYPRIO ELSE PL := 10;
+93440 IF OPR<>NIL THEN PR := OPR^.STDYPRIO ELSE PR := 10;
+93450 IF PL>=PR THEN
+93460 BEGIN
+93470 IF (ERRS-SEMERRS)=0 THEN SEMANTICROUTINE(79) (*SR45*);
+93480 ACTIONROUTINE := TRUE
+93490 END
+93500 ELSE ACTIONROUTINE := FALSE
+93510 END;
+93520 (**)
+93530 2: (*AR2*)
+93540 (*INVOKED: AFTER OPEN FOLLOWED BY HEAD SYMBOL OF A DECLARER.
+93550 FUNCTION: DECIDE WHETHER THIS IS START OF FORMAL-DECLARATIVE OF A
+93560 ROUTINE-TEXT OR START OF A CLOSED-CLAUSE
+93562 VALUE: TRUE IFF ROUTINE-TEXT*)
+93570 BEGIN
+93580 LEV := 0; PREVLX := LXIOERROR; NEW(HEAD); PTR := HEAD;
+93590 WHILE TRUE DO
+93600 BEGIN
+93610 INPT := PARSIN; PTR^.DATA1 := INPT;
+93620 WITH INPT^.LXV DO
+93630 IF LXIO<LXIOBUS THEN (*NOT TAG OR PART OF A FORMAL-DECLARER*)
+93640 BEGIN ACTIONROUTINE := FALSE; GOTO 9 END
+93650 ELSE IF LXIO=LXIOOPEN THEN
+93670 LEV := LEV+1
+93700 ELSE IF LXIO=LXIOCLOSE THEN
+93710 IF LEV<>0 THEN LEV := LEV-1
+93720 ELSE
+93730 BEGIN ACTIONROUTINE := TRUE; GOTO 9 END;
+93740 PREVLX := INPT^.LXV.LXIO;
+93750 NEW(PTR1); PTR^.LINK := PTR1; PTR := PTR1;
+93760 END;
+93770 9: PTR^.LINK := PLINPQ;
+93780 PLINPQ := HEAD
+93790 END;
+93800 (**)
+93810 (**)
+93820 (**)
+93830 3: (*AR3A*)
+93840 (*FUNCTION: INVOKED AFTER APPLIED-MODE-INDICATION.
+93850 DETERMINES IF ASCRIBED MODE IS NON-ROWED NON-VOID MODE.
+93860 TRUE IFF MODE IS NON-ROWED NON-VOID.
+93870 *)
+93880 BEGIN
+93890 STB := APPMI(SRPLSTK[PLSTKP]);
+93900 WITH STB^ DO IF STBLKTYP>STBDEFOP THEN STB := STDEFPTR;
+93910 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := STB^.STMODE;
+93920 IF STB^.STMODE=MDVOID THEN ACTIONROUTINE := FALSE
+93930 ELSE IF STB^.STOFFSET=0 THEN ACTIONROUTINE := TRUE
+93940 ELSE ACTIONROUTINE := FALSE
+93950 END;
+93960 (**)
+93970 4: (*AR3B*)
+93980 (*FUNCTION: INVOKED AFTER ROWED OR VOID APPLIED-MODE-INDICATION.
+93990 DETERMINES IF ASCRIBED MODE IS VOID.
+94000 TRUE IFF MODE IS VOID.
+94010 *)
+94020 IF SRSTK[SRSEMP].MD=MDVOID THEN ACTIONROUTINE := TRUE
+94030 ELSE ACTIONROUTINE := FALSE;
+94040 (**)
+94050 5: (*AR5*)
+94060 (*INVOKED: AFTER ENQUIRY-CLAUSE OF BRIEF-CHOICE-CLAUSE.
+94070 FUNCTION: DECIDE MORE SPECIFICALLY WHAT KIND OF CLAUSE THE BRIEF CLAUSE REPRESENTS.
+94080 THE LEGAL POSSIBILITIES ARE CONDITIONAL-CLAUSE AND CASE-CLAUSE.
+94090 A THIRD POSSIBILITY IS THAT THE SERIAL-CLAUSE PRESUMED TO BE AN ENQUIRY-CLAUSE
+94100 IN FACT DOES NOT YIELD THE REQUIRED MODE AND HENCE IS IN ERROR.
+94110 VALUE: TRUE IFF CONDITIONAL-CLAUSE OR ERROR.
+94120 *)
+94130 BEGIN
+94140 IF (ERRS-SEMERRS)=0 THEN M := MEEK ELSE M := MDERROR;
+94150 IF M=MDINT THEN ACTIONROUTINE := FALSE
+94160 ELSE IF M=MDBOOL THEN ACTIONROUTINE := TRUE
+94170 ELSE BEGIN MODERR(M, ESE+37); ACTIONROUTINE := TRUE END
+94180 END;
+94190 (**)
+94200 6: (*AR6*)
+94210 (*INVOKED: AFTER MODE-DEFINITION AND COMMA FOLLOWED BY MODE-INDICATION.
+94220 FUNCTION: DETERMINE IF TAB IS START OF ANOTHER MODE-DEFINITION OR START OF
+94230 VARIABLE- OR IDENTITY-DEFINITION-LIST.
+94240 VALUE: TRUE IFF TAB IS START OF MODE-DEFINITION.
+94250 *)
+94260 BEGIN
+94270 INPT := PARSIN;
+94280 PTR := PLINPQ; NEW(PLINPQ);
+94290 WITH PLINPQ^ DO
+94300 BEGIN LINK := PTR; DATA1 := INPT END;
+94310 ACTIONROUTINE := INPT^.LXV.LXIO = LXIOEQUAL
+94320 END;
+94330 (**)
+94340 7: (*AR7*)
+94350 (*TRUE IFF SEMANTIC CHECKING IS OFF*)
+94360 ACTIONROUTINE := ERRS>SEMERRS;
+94370 (**)
+94380 8: (*ERRX*)
+94390 (*INVOKED AFTER ERROR CORRECTING PRODUCTIONS HAVE FLUSHED THE SYNTAX STACK AND
+94400 INPUT STREAM TO A POINT WHERE IT IS DEEMED POSSIBLE TO CONTINUE NORMAL PARSING.
+94410 *)
+94420 BEGIN
+94430 FOR I := ERRPTR+1 TO ERRLXPTR DO ERRBUF[I] := ERRCHAR;
+94440 ERRPTR := ERRLXPTR;
+94450 ERRCHAR := ' ';
+94460 (*FIXUP BRACKET MISMATCHES*)
+94470 WITH INP^.LXV DO
+94480 IF (LXIO=LXIOOUSE) OR (LXIO=LXIOOUT) OR (LXIO=LXIOESAC) THEN FORCEMATCH(LEXCASE)
+94490 ELSE IF LXIO IN [LXIOELIF,LXIOELSE,LXIOFI] THEN FORCEMATCH(LEXIF)
+94500 ELSE IF (LXIO IN [LXIOCSTICK,LXIOAGAIN]) OR (LXIO=LXIOCSTICK) THEN
+94510 (*LXIONIL AND ABOVE ARE NOT ACCEPTABLE SET ELEMENTS IN CDC PASCAL*)
+94520 IF SRPLSTK[PLSTKP]^.LXV.LXIO<>LXIOBRINPT THEN FORCEMATCH(LEXBRTHPT)
+94530 ELSE (*NO ACTION*)
+94540 ELSE IF LXIO=LXIOCLOSE THEN FORCEMATCH(LEXOPEN)
+94550 ELSE IF LXIO=LXIOEND THEN FORCEMATCH(LEXBEGIN)
+94560 ELSE IF LXIO=LXIOOD THEN FORCEMATCH(LEXWHILE);
+94570 ACTIONROUTINE := TRUE
+94580 END;
+94590 (**)
+94622 9: (*INVOKED: AFTER A PRIMARY FOLLOWED BY OPEN.
+94624 FUNCTION: DETERMINES WHETHER IT IS START OF CALL OR SLICE.
+94626 VALUE: TRUE IFF CALL*)
+94628 IF (ERRS-SEMERRS)=0 THEN
+94630 BEGIN
+94632 M := COMEEK(BALANCE(STRMEEK));
+94634 IF M^.MDV.MDID IN [MDIDPASC,MDIDPROC] THEN
+94635 BEGIN SEMANTICROUTINE(76); ACTIONROUTINE := TRUE END
+94636 ELSE ACTIONROUTINE := FALSE;
+94637 END
+94638 ELSE ACTIONROUTINE := FALSE;
+94640 END;
+94642 END;
+94650 (**)
+94660 (**)
+94670 PROCEDURE INITPR;
+94680 (*FUNCTION: PERFORMS PER-COMPILATION INITIALIZATION REQUIRED BY
+94690 THE PARSING ROUTINES.
+94700 *)
+94710 BEGIN
+94720 PLINPQ := NIL;
+94730 PLPTR := 1;
+94740 SRPLSTK[SRPLSTKSIZE] := LEXSTOP;
+94750 SRPLSTK[SRPLSTKSIZE-1] := LEXSTOP;
+94760 PLSTKP := SRPLSTKSIZE-1;
+94770 ENDOFPROG := FALSE;
+94780 INP := LEXSTART
+94790 END;
+94800 (**)
+94810 (**)
+94820 PROCEDURE PARSER;
+94830 (*FUNCTION: THIS IS THE PRODUCTION LANGUAGE PARSER. IT PERFORMS THE
+94840 SYNTAX ANALYSIS BY INTERPRETING PRODUCTION RULES FOR THE ALGOL 68 SUBLANGUAGE.
+94850 *)
+94860 VAR MATCH: BOOLEAN;
+94870 STK: PLEX;
+94880 I: INTEGER;
+94890 MATCHES, UNMATCHES: INTEGER;
+94900 (*HISTO: ARRAY [1..PRODLEN] OF INTEGER;*)
+94910 BEGIN
+94920 (*+22() PARSCLK := PARSCLK-CLOCK; ()+22*)
+94930 MATCHES := 0; UNMATCHES := 0;
+94940 WHILE NOT ENDOFPROG DO
+94950 BEGIN
+94960 WITH PRODTBL[PLPTR] DO
+94970 BEGIN
+94980 (*HISTO[PLPTR] := HISTO[PLPTR]+1;*)
+94990 MATCH := TRUE;
+95000 IF PRSTKA<3 THEN (*I.E. NOT ANY*)
+95010 BEGIN
+95020 STK := SRPLSTK[PLSTKP+PRSTKA];
+95030 CASE PRSTKC OF
+95040 S: MATCH := SYLXV.LX1IO = STK^.LXV.LXIO;
+95050 C0: MATCH := SYLXV.LX1CL0 = STK^.LXV.LXCLASS0;
+95060 C1: MATCH := SYLXV.LX1CL1 = STK^.LXV.LXCLASS1;
+95070 C2: MATCH := SYLXV.LX1CL2 = STK^.LXV.LXCLASS2
+95080 END
+95090 END;
+95100 IF MATCH THEN
+95110 CASE PRINPC OF
+95120 A: (*NO ACTION*);
+95130 S: MATCH := SYLXV.LX2IO = INP^.LXV.LXIO;
+95140 C0: MATCH := SYLXV.LX2CL0 = INP^.LXV.LXCLASS0;
+95150 C1: MATCH := SYLXV.LX2CL1 = INP^.LXV.LXCLASS1;
+95160 C2: MATCH := SYLXV.LX2CL2 = INP^.LXV.LXCLASS2;
+95170 SSA: MATCH := SYLXV.LX2IO = SRPLSTK[PLSTKP+1]^.LXV.LXIO
+95180 END;
+95190 IF MATCH THEN
+95200 IF RTN>FINISH THEN
+95210 IF ((ERRS-SEMERRS)=0) OR (RTN>=119 (*SR81*) ) THEN
+95220 BEGIN
+95230 (*PARSCLKS := PARSCLKS+1; SEMCLK := SEMCLK-CLOCK;*)
+95240 SEMANTICROUTINE(RTN);
+95250 (*SEMCLK := SEMCLK+CLOCK; SEMCLKS := SEMCLKS+1*)
+95260 END
+95270 ELSE (*NOTHING*)
+95280 ELSE IF RTN<>DUMMY THEN
+95290 MATCH := ACTIONROUTINE(RTN);
+95300 IF MATCH THEN
+95310 BEGIN
+95320 MATCHES := MATCHES+1;
+95330 (*
+95340 WRITELN(PLPTR:3, PLSTKP:3, ERRLXPTR:3);
+95350 *)
+95360 PLSTKP := PLSTKP+PRPOP;
+95370 IF PRPUSH<>LXIODUMMY THEN
+95380 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := PUSHTBL[PRPUSH] END;
+95390 IF PRSKIP THEN
+95400 BEGIN IF LEXLINE <> PREVLINE THEN CGFLINE;
+95410 INP := PARSIN END;
+95420 FOR I := 1 TO PRSCAN DO
+95430 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := INP;
+95440 IF LEXLINE <> PREVLINE THEN CGFLINE;
+95450 INP := PARSIN END;
+95460 PLPTR := SEXIT
+95470 END
+95480 ELSE
+95490 BEGIN PLPTR := FEXIT; UNMATCHES := UNMATCHES+1 END
+95500 END
+95510 END
+95520 (*+22() ; PARSCLK := PARSCLK+CLOCK; PARSCLKS := PARSCLKS+1; ()+22*)
+95530 (*WRITELN('MATCHES', MATCHES, ' UNMATCHES', UNMATCHES);*)
+95540 (*FOR I := 1 TO PRODLEN DO WRITELN(REMARKS, I, HISTO[I]);*)
+95550 END;
+95560 (**)
+95570 ()+82*)
+95580 (**)
+95590 (**)
+95592 PROCEDURE ABORT; EXTERN;
+95600 (**)
+95610 (*+80()
+95620 (**)
+95630 (*+01()
+95640 FUNCTION PFL: INTEGER;
+95650 (*OBTAIN FIELD LENGTH FROM GLOBAL P.FL*)
+95660 EXTERN;
+95670 (**)
+95680 (**)
+95690 FUNCTION PFREE: PINTEGER;
+95700 (*OBTAIN ADDRESS OF GLOBAL P.FREE*)
+95710 EXTERN;
+95720 (**)
+95730 (**)
+95740 (*$T-+)
+95750 (*+25() (*$T-+) ()+25*)
+95760 FUNCTION RESTORE(VAR START: INTEGER): INTEGER;
+95770 (*RESTORES STACK AND HEAP FROM FILE A68INIT.
+95780 START IS FIRST VARIABLE ON STACK TO BE RESTORED*)
+95790 CONST TWO30=10000000000B;
+95800 VAR STACKSTART, STACKLENGTH, HEAPLENGTH: INTEGER;
+95810 FRIG: RECORD CASE INTEGER OF
+95820 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
+95830 D: DUMPOBJ;
+95840 MASKM,MASKL: INTEGER;
+95850 I: INTEGER;
+95860 BEGIN
+95870 STACKSTART := GETX(0);
+95880 RESET(A68INIT);
+95890 IF EOF(A68INIT) THEN BEGIN WRITELN(' A68INIT NOT AVAILABLE, OR WRONG RFL'); RESTORE := 1 END
+95900 ELSE
+95910 BEGIN
+95920 READ(A68INIT, D.INT, D.MASK); STACKLENGTH := D.INT; HEAPLENGTH := D.MASK;
+95930 FIELDLENGTH := PFL-LOADMARGIN; (*BECAUSE THE LOADER CANNOT LOAD RIGHT UP TO THE FIELDLENGTH*)
+95940 HEAPSTART := FIELDLENGTH-HEAPLENGTH;
+95950 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
+95960 BEGIN
+95970 READ(A68INIT, D.INT, D.MASK);
+95980 (*NOW WE HAVE TO MULTIPLY D.MASK BY HEAPSTART*)
+95990 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
+96000 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
+96010 D.INT := D.INT+MASKM*TWO30+MASKL;
+96020 FRIG.INT := I; FRIG.POINT^ := D.INT
+96030 END;
+96040 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO
+96050 BEGIN
+96060 READ(A68INIT, D.INT, D.MASK);
+96070 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
+96080 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
+96090 D.INT := D.INT+MASKM*TWO30+MASKL;
+96100 FRIG.INT := I; FRIG.POINT^ := D.INT
+96110 END;
+96120 FRIG.POINT := PFREE; FRIG.POINT^ := START;
+96130 RESTORE := 0
+96140 END
+96150 END;
+96160 (**)
+96170 (**)
+96190 PROCEDURE ACLOSE(VAR F: FYL); EXTERN;
+96200 (**)
+96210 (**)
+96220 FUNCTION INITINIT: INTEGER;
+96230 VAR WORD101: RECORD CASE INTEGER OF
+96240 1: (INT: INTEGER);
+96250 2: (REC: PACKED RECORD
+96260 WCS: 0..777777B;
+96270 FILLER: 0..77777777777777B
+96280 END)
+96290 END;
+96300 HWORD: RECORD CASE INTEGER OF
+96310 1: (INT: INTEGER);
+96320 2: (REC: PACKED RECORD
+96330 TABLE: 0..7777B; WC: 0..7777B;
+96340 FILLER: 0..777777777777B
+96350 END)
+96360 END;
+96370 I, J: INTEGER;
+96380 P: PINTEGER;
+96390 BEGIN
+96400 IF DUMPED=43 THEN (*WE ARE OBEYING THE DUMPED VERSION OF THE COMPILER*)
+96410 BEGIN
+96420 IF PFL-LOADMARGIN-ABSMARGIN>FIELDLENGTH THEN (*FIELDLENGTH HAS CHANGED SINCE DUMP*)
+96430 INITINIT := RESTORE(FIRSTSTACK)
+96440 ELSE INITINIT := 0;
+96450 SETB(4, HEAPSTART)
+96460 END
+96470 ELSE
+96480 BEGIN (*A DUMP MUST BE MADE*)
+96490 DUMPED := 43;
+96500 INITINIT := RESTORE(FIRSTSTACK);
+96510 REWRITE(LGO);
+96520 GETSEG(A68INIT); (*START OF A68SB*)
+96530 HWORD.INT := A68INIT^;
+96540 WHILE HWORD.REC.TABLE<>5400B DO
+96550 BEGIN GET(A68INIT);
+96560 WRITE(LGO, HWORD.INT);
+96570 FOR I := 1 TO HWORD.REC.WC DO (*COPY PRFX/LDSET TABLE*)
+96580 BEGIN READ(A68INIT, J); WRITE(LGO, J) END;
+96590 HWORD.INT := A68INIT^;
+96600 END;
+96610 WITH WORD101 DO (*MODIFY WORD 1 OF EACPM TABLE*)
+96620 BEGIN
+96630 P := ASPTR(101B);
+96640 INT := FIELDLENGTH;
+96650 REC.WCS := FIELDLENGTH-101B-LOADMARGIN;
+96660 P^ := INT;
+96670 P := ASPTR(104B);
+96680 P^ := FIELDLENGTH
+96690 END;
+96700 P := ASPTR(100B);
+96710 FOR I := 0 TO 8 DO (*WRITE EACPM TABLE FROM CORE*)
+96720 BEGIN
+96730 WRITE(LGO, P^);
+96740 P := ASPTR(ORD(P)+1);
+96750 GET(A68INIT)
+96760 END;
+96770 WHILE NOT EOS(A68INIT) DO (*COPY PROGRAM*)
+96780 BEGIN
+96790 READ(A68INIT, J); WRITE(LGO, J);
+96800 P := ASPTR(ORD(P)+1)
+96810 END;
+96820 WHILE ORD(P)<FIELDLENGTH DO (*WRITE STACK-HEAP*)
+96830 BEGIN
+96840 WRITE(LGO, P^);
+96850 P := ASPTR(ORD(P)+1)
+96860 END;
+96870 ABORT
+96880 END
+96890 END;
+96900 (**)
+96910 (**)
+96920 PROCEDURE LOADGO(VAR LGO: LOADFILE); EXTERN;
+96930 (**)
+96940 (**)
+96950 (*$E++)
+96960 PROCEDURE PASCPMD(VAR A: INTEGER; J,K,L,M: INTEGER; N: BOOLEAN;
+96970 VAR F: TEXT; VAR MSG: MESS);
+96980 (*TO CATCH NOS- AND PASCAL-DETECTED ERRORS*)
+96990 VAR I: INTEGER;
+97000 BEGIN
+97010 WRITELN(F);
+97020 I := 1;
+97030 REPEAT
+97040 WRITE(F, MSG[I]); I := I+1
+97050 UNTIL ORD(MSG[I])=0;
+97060 WRITELN(F);
+97070 ABORT
+97080 END;
+97090 ()+01*)
+97100 (**)
+97110 (**)
+97120 (**)
+97130 ()+80*)
+97140 (**)
+97150 (*-01() (*-03() (*-04()
+97160 FUNCTION GETADDRESS(VAR VARIABLE:INTEGER): ADDRINT; EXTERN;
+97170 (**)
+97180 PROCEDURE RESTORE(VAR START,FINISH: INTEGER);
+97190 VAR STACKSTART,STACKEND,GLOBALLENGTH,HEAPLENGTH,
+97191 HEAPSTART(*+19(),LENGTH,POINTER()+19*): ADDRINT;
+97195 I:INTEGER;
+97200 P: PINTEGER;
+97210 FRIG: RECORD CASE SEVERAL OF
+97220 1: (INT: ADDRINT);
+97221 2: (POINT: PINTEGER);
+97222 3: (PLEXP: PLEX);
+97223 (*+19() 4: (APOINT: ^ADDRINT); ()+19*)
+97230 (*-19()4,()-19*)5,6,7,8,9,10: ()
+97240 END;
+97250 D: RECORD INT,MASK: INTEGER END;
+97270 BEGIN
+97280 (*+05() OPENLOADFILE(A68INIT, 4, FALSE); ()+05*)
+97285 (*+02() RESET(A68INIT); ()+02*)
+97290 STACKSTART := GETADDRESS(START);
+97300 IF NOT EOF(A68INIT) THEN
+97310 BEGIN
+97320 READ(A68INIT,GLOBALLENGTH,HEAPLENGTH);
+97330 ENEW(FRIG.PLEXP, HEAPLENGTH);
+97340 HEAPSTART := FRIG.INT;
+97350 FRIG.INT := STACKSTART;
+97355 (*-19()
+97360 FOR I := 1 TO GLOBALLENGTH DIV SZWORD DO
+97370 BEGIN
+97380 READ(A68INIT,D.INT,D.MASK);
+97390 IF D.MASK=SZREAL THEN (*D.INT IS A POINTER OFFSET FROM HEAPSTART*)
+97400 D.INT := D.INT+HEAPSTART;
+97410 FRIG.POINT^ := D.INT;
+97420 FRIG.INT := FRIG.INT+SZWORD;
+97430 END;
+97440 FRIG.INT := HEAPSTART;
+97450 FOR I := 1 TO HEAPLENGTH DIV SZWORD DO
+97460 BEGIN
+97462 READ(A68INIT,D.INT,D.MASK);
+97464 IF D.MASK=SZREAL THEN
+97466 D.INT := D.INT+HEAPSTART;
+97468 FRIG.POINT^ := D.INT;
+97470 FRIG.INT := FRIG.INT+SZWORD
+97472 END
+97474 ()-19*)
+97479 (*+19()
+97480 LENGTH:=GLOBALLENGTH DIV SZWORD;
+97482 I:=1;
+97484 WHILE I<=LENGTH DO
+97486 BEGIN
+97488 READ(A68INIT,D.MASK);
+97490 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
+97492 BEGIN
+97494 READ(A68INIT,POINTER);
+97496 POINTER:=POINTER+HEAPSTART;
+97498 FRIG.APOINT^:=POINTER;
+97500 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
+97502 I:=I+2
+97504 END
+97506 ELSE
+97508 BEGIN
+97510 READ(A68INIT,D.INT);
+97511 FRIG.POINT^:=D.INT;
+97512 FRIG.INT:=FRIG.INT+SZWORD;
+97513 I:=I+1
+97514 END
+97515 END;
+97516 LENGTH:=HEAPLENGTH DIV SZWORD;
+97517 FRIG.INT:=HEAPSTART;
+97518 I:=1;
+97519 WHILE I<=LENGTH DO
+97520 BEGIN
+97521 READ(A68INIT,D.MASK);
+97522 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
+97523 BEGIN
+97524 READ(A68INIT,POINTER);
+97525 POINTER:=POINTER+HEAPSTART;
+97526 FRIG.APOINT^:=POINTER;
+97527 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
+97528 I:=I+2
+97529 END
+97530 ELSE
+97531 BEGIN
+97532 READ(A68INIT,D.INT);
+97533 FRIG.POINT^:=D.INT;
+97534 FRIG.INT:=FRIG.INT+SZWORD;
+97535 I:=I+1
+97536 END
+97537 END
+97538 ()+19*)
+97539 END
+97540 END;
+97550 ()-04*) ()-03*) ()-01*)
+97560 (**)
+97570 (*+82()
+97580 (**)
+97590 (*THE COMPILER*)
+97600 (**************)
+97610 (**)
+97630 PROCEDURE ALGOL68;
+97640 BEGIN
+97650 (*+01()
+97660 CPUCLK := -CLOCK;
+97670 (*+22() CPUCLK := -CLOCK; PARSCLK := 0; LXCLOCK := 0; SEMCLK := 0; EMITCLK := 0;
+97680 CPUCLKS := 0; PARSCLKS := 0; LXCLOCKS := 0; SEMCLKS := 0; EMITCLKS := 0; ()+22*)
+97690 WARNS := INITINIT;
+97700 ()+01*)
+97710 (*+25() WARNS := INITINIT; ()+25*)
+97720 ERRS := 0; SEMERRS := 0;
+97730 (*+03()
+97740 CLOSE(SOURCDECS);
+97750 CLOSE(LSTFILE);
+97760 CLOSE(OUTPUT);
+97770 RESTARTHERE;
+97780 CPUTIME(CPUCLK);
+97790 ()+03*)
+97800 (*-01() (*-03() (*-04() (*-25() RESTORE(FIRSTSTACK,LASTSTACK); ()-25*) ()-04*) ()-03*) ()-01*)
+97810 INITIO;
+97820 INITLX;
+97830 INITPR;
+97840 INITSR;
+97850 (*+01()
+97860 SETPARAM(' ', 0); (*FOR DEFAULT GO*)
+97870 ()+01*)
+97880 PARSER;
+97890 (*+01() (*+22() EMITCLK := EMITCLK-EMITCLKS DIV 6;
+97900 SEMCLK := SEMCLK-(SEMCLKS+EMITCLKS) DIV 6;
+97910 LXCLOCK := LXCLOCK-LXCLOCKS DIV 6;
+97920 PARSCLK := PARSCLK-(PARSCLKS+LXCLOCKS+SEMCLKS+EMITCLKS) DIV 6;
+97930 CPUCLK := CPUCLK-(PARSCLKS+LXCLOCKS+SEMCLKS+EMITCLKS) DIV 6;
+97940 WRITELN(' CPU', (CPUCLK+CLOCK)/1000:6:3,
+97950 ' PAR', (PARSCLK-LXCLOCK-SEMCLK)/1000:6:3,
+97960 ' LEX', LXCLOCK/1000:6:3,
+97970 ' SEM', (SEMCLK-EMITCLK)/1000:6:3,
+97980 ' EMIT', EMITCLK/1000:6:3); ()+22*) ()+01*)
+97990 (*+01()
+98000 IF LSTPAGE<>0 THEN
+98010 IF ONLINE THEN WRITELN(LSTFILE, ' ', 'CPU', (CPUCLK+CLOCK)/1000:6:3)
+98020 ELSE WRITELN(' ', 'CPU', (CPUCLK+CLOCK)/1000:6:3);
+98030 IF ERRS<>0 THEN BEGIN MESSAGE('BAD PROGRAM - ABORTED'); ACLOSE(OUTPUT); ABORT END
+98040 ELSE IF PRGGO IN PRAGFLGS THEN
+98050 BEGIN
+98060 PUTSEG(LGO);
+98070 IF ONLINE AND (LSTPAGE<>0) THEN ACLOSE(LSTFILE);
+98080 IF (WARNS<>0) OR NOT ONLINE AND (LSTPAGE<>0) THEN ACLOSE(OUTPUT);
+98090 LOADGO(LGO)
+98100 END
+98110 ELSE MESSAGE('NO ERRORS');
+98120 ()+01*)
+98130 (*+03()
+98140 CPUTIME(CPUCLK);
+98150 IF LSTPAGE<>0 THEN
+98160 IF ONLINE THEN WRITELN(LSTFILE, ' ', 'CPU', CPUCLK:4, 'SECS')
+98170 ELSE WRITELN(' ', 'CPU', CPUCLK:4, ' SECS');
+98180 IF ERRS<>0 THEN WRITELN(' ', 'ERRORS DETECTED')
+98190 ELSE WRITELN(' ', 'NO ERRORS');
+98200 CLOSE(SOURCDECS);
+98210 CLOSE(LSTFILE);
+98220 CLOSE(OUTPUT);
+98230 ()+03*)
+98232 (*+05()
+98234 IF ERRS<>0 THEN BEGIN WRITELN(ERROR); WRITELN(ERROR, 'BAD PROGRAM - ABORTED'); ABORT END;
+98236 ()+05*)
+98237 (*+02()
+98238 IF ERRS<>0 THEN BEGIN WRITELN; WRITELN('BAD PROGRAM - ABORTED'); ABORT END;
+98239 ()+02*)
+98240 END;
+98260 (**)
+98270 (**)
+98280 (*+01() (*$P++) (*SO THAT IT KNOWS ABOUT PASCPMD*) ()+01*)
+98290 (*+04() PROCEDURE S1; ()+04*)
+98300 (*+25() (*$P++) ()+25*)
+98310 (*-03()(*+71()
+98320 BEGIN
+98330 ALGOL68
+98340 (*+01() (*-31() (*$P-+) ()-31*) ()+01*)
+98350 (*+25() (*-31() (*$P-+) ()-31*) ()+25*)
+98360 END (*+01() (*$G-+) ()+01*)(*+25() (*$G-+) ()+25*).
+98370 ()+71*)()-03*)
+98380 ()+82*)
--- /dev/null
+70000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+70010 (*+85()
+70020 (**)
+70030 (*SEMANTIC ROUTINES*)
+70040 (*******************)
+70050 (**)
+70060 PROCEDURE INITSR;
+70070 (*FUNCTION: PERFORM PER-COMPILATION INITIALIZATION REQUIRED BY SEMANTIC ROUTINES*)
+70080 BEGIN
+70090 SCPUSH(MDERROR);
+70100 RTSTACK := NIL;
+70110 RGINFO := [];
+70120 RGSTATE := 16;
+70130 RGLEV := 0;
+70140 DCIL := NIL;
+70150 DCLMODE := MDABSENT;
+70160 DCLPRVMODE := MDABSENT;
+70170 PSCOUNT := 0;
+70180 NEW(RANGEL); RANGEL^.RGRTSTACK := RTSTACK;
+70190 BALFLAG := FALSE;
+70200 NEW(ROUTNL); WITH ROUTNL^ DO
+70210 (*-02() BEGIN RNLEVEL := 0; (*AND MAYBE SOME OTHERS*) END; ()-02*)
+70220 (*+02() BEGIN RNLEVEL := 255; (*AND MAYBE SOME OTHERS*) END; ()+02*)
+70230 CURLEB := 0;
+70240 SRSUBP := 0;
+70250 SRSEMP := -1;
+70260 RTSTKDEPTH := 0;
+70270 DCLDEFN := [];
+70280 END;
+70290 (**)
+70300 FUNCTION MAKESUBSTACK (N:INTEGER; M:MODE):PSB;
+70310 (*PLACES A SEMBLOCK (FOR A RESULT) WITH SBMODE=M, TOGETHER WITH A SUBSTACK MARKER
+70320 N LEVEL BELOW SRSEMP*)
+70330 VAR I : INTEGER;
+70340 SBB:PSB;
+70350 BEGIN
+70360 FOR I := 0 TO N-1 DO SRSTK[SRSEMP+2-I].SB:=SRSTK[SRSEMP-I].SB;
+70370 SRSEMP:=SRSEMP-N;
+70380 MAKESUBSTACK:=PUSHSB(M); UNSTACKSB;
+70390 SUBSAVE;
+70400 SRSEMP:=SRSEMP+N
+70410 END;
+70420 (**)
+70430 FUNCTION ALLOC(N: OFFSETR): OFFSETR;
+70440 (*FUNCTION: ALLOCATES A BLOCK OF N WORDS ON THE CURRENT INVOCATION BLOCK;
+70450 RETURNS THE OFFSET OF THE FIRST WORD.
+70460 *)
+70470 BEGIN
+70480 WITH ROUTNL^ DO
+70490 BEGIN
+70510 (*-41() ALLOC := CURID; CURID := CURID+N; ()-41*)
+70520 (*+41() CURID := CURID+N; ALLOC := CURID; ()+41*)
+70530 IF ABS(RNLENIDS)<ABS(CURID) THEN RNLENIDS := CURID;
+70540 END
+70550 END;
+70560 (**)
+70570 (**)
+70580 FUNCTION FINDSTATE: STATE;
+70590 (*FUNCTION: DETERMINES THE STATE IMPLIED BY THE DEFINITION CURRENTLY BEING PROCESSED*)
+70600 VAR S: STATE;
+70610 BEGIN
+70620 WITH DCLMODE^ DO
+70630 BEGIN
+70640 IF (DCLDEFN=[STINIT (*FOR STDIDTY*)]) OR (DCLPARM IN RGINFO) THEN
+70650 S := DLASCR
+70660 ELSE IF MDV.MDID=MDIDROW THEN
+70670 S := DLMULT
+70680 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+70690 S := DLSTRUCT
+70700 ELSE S := DLASCR;
+70710 IF S<>DLASCR THEN (*VARIABLE STRUCTS OR ROWS*)
+70720 BEGIN
+70730 IF DCLDEFN=[STINIT, STVAR] THEN S := S+4;
+70740 IF MDV.MDRECUR THEN S := S+1
+70750 END
+70760 ELSE
+70770 BEGIN
+70780 IF DCLDEFN=[STVAR] THEN S := DLVAREMPTY;
+70790 IF (STINIT IN DCLDEFN) AND (MDV.MDID=MDIDPROC) THEN S:= 15
+70800 ELSE IF (MDV.MDID=MDIDREF) AND NOT(DCLPARM IN RGINFO) THEN S := S+2
+70810 ELSE IF MDV.MDPILE THEN S := S+1
+70820 END;
+70830 FINDSTATE := S
+70840 END
+70850 END;
+70860 (* VALUES OF STATES:
+70870 0
+70880 DLVAREMPTY 1 NONSTOWED VAR NOT INIT
+70890 2 NONSTOWED PILE
+70900 3 NONSTOWED .REF MODE
+70910 DLSTRUCT=
+70920 DLACTION 4 .STRUCT VAR
+70930 5 .STRUCT VAR RECURSIVE
+70940 DLMULT 6 MULT VAR
+70950 7 MULT VAR RECURSIVE
+70960 DLUNITS 8 .STRUCT VAR INITIALIZED
+70970 9 .STRUCT VAR INITIALIZED RECURSIVE
+70980 DLBNDS 10 MULT VAR INITIALIZED
+70990 DLDESC 11 MULT VAR INITIALIZED RECURSIVE
+71000 DLASCR 12 IDENTITY OR NONSTOWED VAR INITIALIZED
+71010 13 DITTO PILE
+71020 14 DITTO .REF MODE
+71030 15 PROCEDURES
+71040 ANY STATE >= 16 REPRESENTS THAT STATE MOD 16 WITH RGNEXTFREE SET CORRECTLY.
+71050 *)
+71060 (**)
+71070 (**)
+71080 FUNCTION ALLOCIND(M: MODE): OFFSETR;
+71090 (*FUNCTION: ALLOCATES STACK SPACE FOR A NEWLY DECLARED INDICATOR
+71100 AND ATTENDS TO ITS INITIALIZATION.
+71110 *)
+71120 VAR NEWSTATE: STATE;
+71130 LEN: 0..MAXSIZE;
+71140 BEGIN
+71150 IF M^.MDV.MDPILE THEN LEN := SZADDR ELSE LEN := M^.MDV.MDLEN;
+71160 WITH DCLMODE^ DO
+71170 BEGIN
+71180 IF (PSCOUNT=0) OR (MDV.MDPILE<>(DCLPILE IN RGINFO)) THEN
+71190 BEGIN (*START OF A NEW GROUP OF DECLARATIONS ALL ON OR ALL OFF THE PILE*)
+71200 BRKASCR;
+71210 IF RGSTATE IN [DLASCR..15] THEN CGFIXRG;
+71220 IF DCLMODE^.MDV.MDPILE THEN RGINFO := RGINFO+[DCLPILEDECS];
+71230 IF MDV.MDPILE THEN RGINFO := RGINFO+[DCLPILE] ELSE RGINFO := RGINFO-[DCLPILE]
+71240 END;
+71250 NEWSTATE := FINDSTATE;
+71260 IF (NEWSTATE<>(RGSTATE MOD 16)) OR ((MDV.MDID=MDIDSTRUCT) AND (DCLMODE<>DCLPRVMODE)) THEN
+71270 BEGIN (*TIDY UP PREVIOUS DECLARATIONS*)
+71280 IF (DCLMODE=DCLPRVMODE) AND ((RGSTATE MOD 16) IN [6,7,10,11]) AND (NEWSTATE IN [6,7,10,11]) THEN
+71290 RGINFO := RGINFO+[DCLSAVEDESC];
+71300 BRKASCR;
+71310 IF RGSTATE>=16 THEN RGSTATE := NEWSTATE + 16 (*PRESERVE CODING *)
+71320 ELSE RGSTATE := NEWSTATE;
+71330 RGINFO := RGINFO-[DCLSAVEDESC];
+71340 END;
+71350 PSCOUNT := PSCOUNT+LEN;
+71360 TODOCOUNT := TODOCOUNT+LEN;
+71370 DCLPRVMODE := DCLMODE;
+71380 ALLOCIND := ALLOC(LEN);
+71390 END;
+71400 END;
+71410 (**)
+71420 (**)
+71430 PROCEDURE DISALLOCIND;
+71440 BEGIN
+71450 (*INITIALISE STBLOCK *)
+71460 WITH DCIL^,SRSTK[SRSEMP].SB^ DO
+71470 BEGIN
+71480 IF SBTYP IN [SBTPROC,SBTRPROC] THEN
+71490 BEGIN
+71500 STPTR:=SBXPTR;
+71510 STLEVEL:=SBLEVEL;
+71520 END
+71530 ELSE
+71540 STVALUE:=SBLEX;
+71550 STDEFTYP:=STDEFTYP+[STCONST]-[STRCONST];
+71560 (* UNDO PREVIOUS ALLOCIND *)
+71570 PSCOUNT := PSCOUNT-SBLEN;
+71580 TODOCOUNT := TODOCOUNT-SBLEN;
+71590 CURID:=CURID-SBLEN;
+71600 END;
+71610 UNSTACKSB;
+71620 END;
+71630 (**)
+71640 (**)
+71650 PROCEDURE LOCRNGE;
+71660 (*FUNCTION: TO MAKE THE CURRENT RANGE INTO A LOCAL RANGE*)
+71670 VAR DUMMY: INTEGER;
+71680 BEGIN
+71690 IF NOT (DCLLOCRNG IN RGINFO) THEN
+71700 WITH RANGEL^ DO
+71710 BEGIN
+71720 RGINFO := RGINFO+[DCLLOCRNG]; RGLEB:=CURLEB;
+71730 IF DCLPARM IN RGINFO THEN
+71740 CURLEB:=SIZIBBASE
+71750 ELSE
+71760 BEGIN
+71770 CGFIXRG;
+71780 CURLEB:=CURID;
+71790 DUMMY := ALLOC(SIZLEBBASE);
+71800 END;
+71810 RGDEFN := DCLDEFN;
+71820 RGMODE := DCLMODE;
+71830 RGPRVMODE := DCLPRVMODE;
+71840 RGTODOCOUNT := TODOCOUNT ;
+71850 WITH ROUTNL^ DO RNLOCRG := RNLOCRG+1;
+71860 IF DCLPARM IN RGINFO THEN
+71870 BEGIN RGPSCOUNT := PSCOUNT; PSCOUNT := 0; END
+71880 ELSE BEGIN
+71890 IF DCLLOCGEN IN RGINFO THEN SEMERR(ESE+05);
+71900 CGRGN;
+71920 END;
+71930 END
+71940 END;
+71950 (**)
+71960 (**)
+71970 PROCEDURE RANGENT;
+71980 (*FUNCTION: CREATE RANGE BLOCK FOR NEW RANGE*)
+71990 VAR R: PRANGE;
+72000 BEGIN
+72010 NEW(R);
+72020 WITH R^ DO
+72030 BEGIN
+72040 RGLINK := RANGEL; RANGEL := R;
+72050 RGINF := RGINFO; RGINFO := [];
+72060 RGSTAT := RGSTATE;
+72062 RGSTATE :=16;
+72070 RGDCIL := DCIL; DCIL := NIL;
+72080 RGLEV := RGLEV+1;
+72082 IF RGLEV=2 THEN LOCRNGE;
+72084 (*GLOBAL RANGE OF PROGRAM MUST ALWAYS BE LOCAL, BECAUSE STANDIN ETC. ARE EFFECTIVELY WITHIN IT*)
+72090 RGRTSTACK := RTSTACK;
+72100 END
+72110 END;
+72120 (**)
+72130 (**)
+72140 PROCEDURE INCROUTN(R: PROUTN; STB: PSTB);
+72150 (*FUNCTION ADD ROUTN R TO ROUTNCHAIN STARTING AT STROUTN OF THE LABEL STB*)
+72160 VAR PTR,TEMP: PROUTNCHAIN;
+72170 BEGIN
+72180 WITH R^ DO RNNONIC := RNNONIC+1;
+72190 NEW(PTR);
+72200 WITH PTR^ DO
+72210 BEGIN LINK := NIL; DATA := R END;
+72212 IF STB^.STROUTN=NIL THEN STB^.STROUTN := PTR
+72214 ELSE
+72216 BEGIN
+72218 TEMP := STB^.STROUTN;
+72220 WHILE TEMP^.LINK<>NIL DO
+72222 TEMP:=TEMP^.LINK;
+72224 TEMP^.LINK := PTR
+72226 END
+72228 END;
+72230 (**)
+72240 (**)
+72250 PROCEDURE DECROUTN(R: PROUTN; MUSTFIX: BOOLEAN);
+72260 (*FUNCTION: DISPOSE OF ROUTN, BUT ONLY AFTER ITS RNNONIC HAS REACHED ZERO*)
+72270 BEGIN
+72280 WITH R^ DO
+72290 BEGIN RNNONIC := RNNONIC-1;
+72300 IF RNNONIC<=0 THEN
+72310 BEGIN
+72320 IF MUSTFIX THEN CGRTE(R);
+72330 DISPOSE(R)
+72340 END
+72350 END
+72360 END;
+72370 (**)
+72380 (**)
+72390 PROCEDURE ROUTNNT;
+72400 (*FUNCTION: CREATE ROUTN BLOCK FOR NEW ROUTINE*)
+72410 VAR R: PROUTN;
+72420 DUMMY: INTEGER;
+72430 IDLEX: PLEX;
+72440 BEGIN
+72450 NEW(R);
+72460 WITH R^ DO
+72470 BEGIN
+72480 RNLEVEL := ROUTNL^.RNLEVEL+1; RNNECLEV := 0;
+72490 RNLINK := ROUTNL; ROUTNL := R;
+72500 RNLENSTK := 0; RNLENIDS := 0;
+72510 RNLOCRG := 0; RNNECLOCRG := 0;
+72520 RNSTKDEPTH := RTSTKDEPTH; RTSTKDEPTH := 0;
+72530 RNRTSTACK := RTSTACK;
+72540 RTSTACK := NIL;
+72550 RNNONIC := 1;
+72560 RNCURID := CURID; CURID := 0;
+72570 RANGENT;
+72580 RGINFO := RGINFO+[DCLPARM];
+72590 LOCRNGE
+72600 END
+72610 END;
+72620 (**)
+72630 (**)
+72640 PROCEDURE NECENV(STB: PSTB);
+72650 (*FUNCTION: ADJUST THE NECESSARY ENVIRON OF THE CURRENT ROUTINES TO ALLOW FOR STB*)
+72660 VAR R: PROUTN;
+72670 BEGIN
+72680 R := ROUTNL;
+72690 WITH STB^ DO
+72700 WHILE STLEVEL<R^.RNLEVEL DO WITH R^ DO
+72710 BEGIN
+72720 IF RNNECLEV<STLEVEL THEN
+72730 BEGIN RNNECLEV := STLEVEL; RNNECLOCRG := STLOCRG END
+72740 ELSE IF (RNNECLEV=STLEVEL) AND (RNNECLOCRG<STLOCRG) THEN
+72750 RNNECLOCRG := STLOCRG;
+72760 R := RNLINK;
+72770 END
+72780 END;
+72790 (**)
+72800 (**)
+72810 PROCEDURE NECLAB(STB: PSTB);
+72820 (*FUNCTION: ADJUST THE NECESSARY ENVIRONS OF ALL ROUTNS ON THE STROUTN CHAIN OF STB*)
+72830 VAR PTR, PTR1: PROUTNCHAIN;
+72840 SAVROUTN: PROUTN;
+72850 BEGIN
+72860 SAVROUTN := ROUTNL; PTR := STB^.STROUTN;
+72870 WHILE PTR<>NIL DO
+72880 BEGIN
+72890 ROUTNL := PTR^.DATA;
+72900 NECENV(STB);
+72910 DECROUTN(ROUTNL, ROUTNL^.RNADDRESS<>0);
+72920 PTR1 := PTR; PTR := PTR^.LINK; DISPOSE(PTR1)
+72930 END;
+72940 ROUTNL := SAVROUTN
+72950 END;
+72960 (**)
+72970 (**)
+72980 PROCEDURE RANGEXT;
+72990 (*FUNCTION: DEALS WITH ALL STBLOCKS THREADED ON DCIL AND
+73000 DISPOSES OF CURRENT RANGE
+73010 *)
+73020 VAR STB, CURDCL, T: PSTB;
+73030 TRYPREVRANGE: BOOLEAN;
+73040 R: PRANGE;
+73050 PTR: PROUTNCHAIN;
+73060 SB: PSB;
+73070 SEMP: -1..SRSTKSIZE;
+73080 FLADSET, FLADNEEDED, REDOJUMPS: BOOLEAN;
+73082 DUMMY: LABL;
+73090 BEGIN
+73100 WITH RANGEL^ DO
+73110 BEGIN
+73120 IF BALFLAG THEN FLADNEEDED := FALSE
+73130 ELSE BEGIN (*YIELD OF RANGE IS ON RTSTACK*)
+73140 FLADNEEDED := (RTSTACK^.SBMODE<>MDJUMP);
+73150 SB := RTSTACK; UNSTACKSB; (*PRETEND WE ARE IN VOID CONTEXT OUTSIDE THE RANGE*)
+73160 END;
+73170 FLADSET := FALSE;
+73180 STB := DCIL;
+73190 WHILE STB<>NIL DO WITH STB^ DO
+73200 BEGIN
+73210 IF (STBLKTYP=STBDEFLAB) AND (STROUTN<>NIL) THEN (*LABEL WAS JUMPED TO OUT OF A ROUTINE*)
+73220 BEGIN
+73230 IF NOT FLADSET AND FLADNEEDED THEN BEGIN CGFLADJUMP; FLADSET := TRUE END;
+73250 CGLABE(STB, ROUTNL^.RNLEVEL, CURLEB(*+41()+SIZLEBBASE()+41*)); (*GET OUT*)
+73280 NECLAB(STB)
+73290 END;
+73300 STB := STTHREAD
+73310 END;
+73320 IF FLADSET THEN BEGIN ASSIGNFLAD; FLADSET := FALSE END;
+73330 (*LOCRNGEXT - TO UNDO THE EFFECTS OF LOCRNGE*)
+73340 IF DCLLOCRNG IN RGINFO THEN
+73350 BEGIN
+73380 IF DCLPARM IN RGINFO THEN PSCOUNT := RGPSCOUNT
+73390 ELSE CGFIXRG;
+73400 WITH ROUTNL^ DO RNLOCRG := RNLOCRG-1;
+73410 IF DCLDELAY IN RGINFO THEN
+73420 BEGIN
+73430 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
+73440 WHILE SEMP<=SRSEMP DO
+73450 BEGIN
+73460 WITH SRSTK[SEMP].SB^ DO
+73462 BEGIN
+73464 SBDELAYS :=SBDELAYS+1;
+73466 IF DCLLOCGEN IN RGINFO THEN
+73468 SBINF := SBINF+[SBLOCGEN];
+73470 IF DCLPILEDECS IN RGINFO THEN
+73472 SBINF := SBINF+[SBPILEDECS]
+73476 END;
+73478 SEMP := SEMP+1
+73480 END
+73490 END
+73492 ELSE
+73493 WITH SB^ DO BEGIN
+73494 IF DCLLOCGEN IN RGINFO THEN
+73496 SBINF := SBINF+[SBLOCGEN];
+73498 IF DCLPILEDECS IN RGINFO THEN
+73500 SBINF := SBINF+[SBPILEDECS];
+73506 STACKSB(SB); CGRGXB(SB); UNSTACKSB
+73508 END;
+73510 (*-42() IF NOT FLADSET AND FLADNEEDED THEN BEGIN CGFLADJUMP; FLADSET := TRUE END; ()-42*)
+73520 (*+42() IF DATASTATE=ENDDATA THEN DATASTATE := STARTDATA; ()+42*)
+73530 CURID := CURLEB ; CURLEB := RGLEB;
+73540 TODOCOUNT := RGTODOCOUNT;
+73550 DCLDEFN := RGDEFN;
+73560 DCLMODE := RGMODE;
+73570 DCLPRVMODE := RGPRVMODE;
+73580 END
+73590 ELSE IF DCLLOCGEN IN RGINFO THEN
+73600 RGINF := RGINF+[DCLLOCGEN];
+73610 STB := DCIL;
+73612 DUMMY := FIXUPM; (*TO FORCE ALIGNMENT OF RGIDBLK*)
+73620 WHILE STB<>NIL DO WITH STB^ DO
+73630 BEGIN
+73640 IF STBLKTYP<=STBDEFOP THEN
+73650 BEGIN (*DEFINING OCCURRENCE*)
+73660 IF STLINK=NIL (*NO PREVIOUS INCARNATION*) THEN
+73670 IF STBLKTYP=STBDEFMI THEN
+73680 STLEX^.LXV := LXVTAB
+73690 ELSE IF STBLKTYP=STBDEFPRIO THEN STLEX^.LXV := LXVTAB;
+73700 IF DCLLOCRNG IN RGINFO THEN CGRGID(STB);
+73710 END;
+73720 STB := STTHREAD
+73730 END;
+73740 IF DCLLOCRNG IN RGINFO THEN IF DCLPARM IN RGINFO THEN ROUTNL^.RNIDBLK := FIXUPM ELSE FIXUPF(RGIDBLK);
+73760 REDOJUMPS := ([DCLLOCRNG, DCLLOOP]*RGINFO<>[]) OR (RGLINK^.RGRTSTACK<>RTSTACK);
+73770 RGLEV := RGLEV-1;
+73780 R := RANGEL; RANGEL := RGLINK; (*CONSIDER OURSELVES TO BE OUTSIDE RANGE NOW*)
+73790 STB := DCIL; CURDCL := RGDCIL;
+73800 IF CURDCL=NIL THEN DCIL := NIL
+73810 ELSE DCIL := CURDCL^.STTHREAD; (*LEAVE THE FIRST BEAD ON THE THREAD FOR NOW*)
+73820 WHILE STB<>NIL DO WITH STB^ DO
+73830 BEGIN
+73840 IF STBLKTYP>STBDEFOP THEN
+73850 BEGIN (*APPLIED OCCURRENCE*)
+73860 TRYPREVRANGE := STLINK=NIL; (*IT WAS A LABEL NOT YET DEFINED*)
+73870 IF NOT TRYPREVRANGE THEN
+73880 TRYPREVRANGE := STLINK^.STRANGE<RGLEV; (*IT WAS NOT SEEN IN PREVIOUS RANGE*)
+73890 IF TRYPREVRANGE THEN
+73900 BEGIN (*THREAD STB INTO PREVIOUS RANGE*)
+73910 STRANGE := STRANGE-1;
+73920 T := STTHREAD; STTHREAD := DCIL; DCIL := STB;
+73930 END;
+73940 IF STBLKTYP=STBAPPLAB THEN
+73950 BEGIN
+73960 IF REDOJUMPS THEN
+73962 BEGIN
+73964 IF STXPTR[0]<>0 THEN
+73970 BEGIN
+73980 IF NOT FLADSET AND FLADNEEDED THEN BEGIN CGFLADJUMP; FLADSET := TRUE END;
+73990 CGLABB(STB, 0); (*LABEL FOR EXISTING JUMP*)
+74000 IF (DCLLOCRNG IN RGINFO) THEN CGRGXA(DCLLOCGEN IN RGINFO); (*RANGE EXIT*)
+74010 IF DCLLOOP IN RGINFO THEN CGLPG;
+74020 IF TRYPREVRANGE THEN CGLABC(STB, ORD(DCLPARM IN RGINFO))
+74030 ELSE CGLABC(STB^.STLINK, ORD(DCLPARM IN RGINFO));
+74040 END
+74041 (*-01() (*-02() (*FOR SYSTEMS WHICH CANNOT JUMP INTO OTHER ROUTINES - SEE ALSO CHANGES IN CGLABC*)
+74042 ELSE IF (STXPTR[1]<>0) AND (DCLPARM IN RGINFO) THEN
+74043 BEGIN
+74044 CGLABB(STB, 1); (*LABEL FOR EXISTING JUMP*)
+74045 IF TRYPREVRANGE THEN CGLABC(STB, ORD(DCLPARM IN RGINFO))
+74046 ELSE CGLABC(STB^.STLINK, ORD(DCLPARM IN RGINFO));
+74047 END
+74048 ()-02*) ()-01*)
+74049 END;
+74050 IF NOT TRYPREVRANGE THEN CGLABD(STB);
+74060 IF DCLPARM IN RGINFO (*RANGE IS A ROUTINE*) THEN
+74070 BEGIN
+74080 INCROUTN(ROUTNL, STB); (*ADD ROUTNL TO ITS STROUTN CHAIN*)
+74090 STCURID := ROUTNL^.RNCURID
+74100 END
+74110 ELSE
+74120 IF DCLLOCRNG IN RGINFO THEN STCURID := CURID; (*FOR CATCHING JUMPS OVER DECLARATIONS*)
+74130 IF NOT TRYPREVRANGE THEN
+74140 WITH STLINK^ (*OCCURRENCE IN PREVIOUS RANGE*) DO
+74150 IF STBLKTYP IN [STBDEFID,STBAPPID] THEN
+74160 SEMERRP(ESE+07, STLEX)
+74170 ELSE (*PRESENT STROUTN CHAIN TO PREVIOUS OCCURRENCE*)
+74180 IF STROUTN<>NIL THEN
+74190 BEGIN
+74200 PTR := STROUTN;
+74210 WHILE PTR^.LINK<>NIL DO PTR := PTR^.LINK;
+74220 PTR^.LINK := STB^.STROUTN;
+74230 END
+74240 ELSE STROUTN := STB^.STROUTN;
+74250 END;
+74260 END
+74270 ELSE TRYPREVRANGE := FALSE;
+74280 IF TRYPREVRANGE THEN STB := T
+74290 ELSE
+74300 BEGIN
+74310 (*FREESTB*)
+74320 STLEX^.LXV.LXPSTB := STLINK;
+74330 T := STB; STB := STTHREAD;
+74340 DISPOSE(T)
+74350 END
+74360 END;
+74370 IF CURDCL<>NIL THEN
+74380 BEGIN CURDCL^.STTHREAD := DCIL; DCIL := CURDCL END; (*DEAL WITH THAT FIRST BEAD*)
+74390 (*DCIL IS NOW AS BEFORE THE RANGENT*)
+74400 IF FLADSET THEN ASSIGNFLAD;
+74410 IF NOT BALFLAG THEN STACKSB(SB); (*STOP PRETENDING*)
+74420 RGINFO := RGINF; RGSTATE := RGSTAT;
+74430 DISPOSE(R)
+74440 END
+74450 END;
+74460 (**)
+74470 (**)
+74480 PROCEDURE ROUTNXT;
+74490 (*FUNCTION: EXIT FROM ROUTINE. CALLS DECROUTN.*)
+74500 VAR R: PROUTN;
+74510 BEGIN
+74520 WITH ROUTNL^ DO
+74530 BEGIN
+74540 RTSTACK := RNRTSTACK;
+74550 RTSTKDEPTH := RNSTKDEPTH;
+74560 CURID := RNCURID;
+74570 R := ROUTNL; ROUTNL := RNLINK;
+74580 DECROUTN(R, FALSE)
+74590 END
+74600 END;
+74610 (**)
+74620 (**)
+74630 FUNCTION GETSTB(LEX: PLEX; DEF: DEFTYP; BLK: BLKTYP): PSTB;
+74640 (*FUNCTION: CREATE A NEW STBLOCK FOR LEX*)
+74650 VAR STB: PSTB;
+74660 BEGIN
+74670 NEW(STB); WITH STB^, LEX^.LXV, ROUTNL^ DO
+74680 BEGIN
+74690 STLINK := LXPSTB; LXPSTB := STB;
+74700 STLEX := LEX;
+74710 STTHREAD := DCIL; DCIL := STB;
+74720 STDEFTYP := DEF; STBLKTYP := BLK;
+74730 STRANGE := RGLEV;
+74740 STLEVEL := RNLEVEL; STLOCRG := RNLOCRG;
+74750 STMODE := NIL;
+74760 GETSTB := STB
+74770 END
+74780 END;
+74790 (**)
+74800 (**)
+74810 PROCEDURE FILLSTB(STB: PSTB);
+74820 (*FUNCTION: SETS THE MODE AND OFFSET FIELDS OF THE STBLOCK STB*)
+74830 CONST STDIDTY=STINIT;
+74840 BEGIN WITH STB^ DO
+74850 BEGIN
+74860 STOFFSET := ALLOCIND(DCLMODE);
+74870 IF DCLDEFN=[STDIDTY] THEN STMODE := DCLMODE
+74880 ELSE STMODE := FINDREF(DCLMODE);
+74890 END
+74900 END;
+74910 (**)
+74920 (**)
+74930 FUNCTION GETPRIO(LEX: PLEX): PSTB;
+74940 (*FUNCTION: CREATE AND INITIALIZE A PRIORITY STBLOCK*)
+74950 VAR STB,STB1: PSTB;
+74960 BEGIN
+74970 STB := GETSTB(LEX, [STCONST], STBDEFPRIO); WITH STB^, LEX^ DO
+74980 BEGIN
+74990 STSTDOP := 0; STUSERLEX := NIL;
+75000 STB1 := LXV.LXPSTB; LXV := LXVOPR; LXV.LXPSTB := STB1;
+75010 STDYPRIO := 11; (*FOR UNDECLARED OPS*)
+75020 GETPRIO := STB
+75030 END
+75040 END;
+75050 (**)
+75060 (**)
+75070 FUNCTION TESTSTB(LEX: PLEX): BLKTYP;
+75080 (*FUNCTION: LOOKS FOR A DEFINITION OR APPLICATION IN THE CURRENT RANGE OF THE SYMBOL
+75090 CORRESPONDING TO LEX. IF NONE IS FOUND, IT RETURNS STBNONE; IF ONE IS FOUND, IT RETURNS ITS BLKTYP
+75100 *)
+75110 BEGIN WITH LEX^.LXV DO
+75120 IF LXPSTB=NIL THEN TESTSTB := STBNONE
+75130 ELSE WITH LXPSTB^ DO
+75140 IF STRANGE<>RGLEV THEN TESTSTB := STBNONE
+75150 ELSE TESTSTB := STBLKTYP
+75160 END;
+75170 (**)
+75180 (**)
+75190 PROCEDURE NOLABELS;
+75200 (*FUNCTION: COMPLAINS IF LABELS HAVE BEEN ENCOUNTERED IN THE CURRENT RANGE*)
+75210 BEGIN
+75220 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+04)
+75230 END;
+75240 (**)
+75250 (**)
+75260 PROCEDURE DEFID(LEX: PLEX);
+75270 (*FUNCTION: MAKE STBLOCK FOR DEFINING-IDENTIFIER*)
+75280 VAR BLK: BLKTYP;
+75290 BEGIN
+75300 NOLABELS; LOCRNGE;
+75310 BLK := TESTSTB(LEX);
+75320 IF BLK=STBAPPID THEN SEMERRP(ESE+08, LEX);
+75330 IF BLK<STBNONE THEN (*STBDEFID OR STBDEF/APPLAB*)
+75340 IF BLK=STBDEFID THEN SEMERRP(ESE+09, LEX)
+75350 ELSE SEMERRP(ESE+15, LEX);
+75360 FILLSTB(GETSTB(LEX, DCLDEFN, STBDEFID))
+75370 END;
+75380 (**)
+75390 (**)
+75400 (**)
+75410 FUNCTION APPID(LEX: PLEX): PSTB;
+75420 (*FUNCTION: CREATE STBLOCK FOR APPLIED-IDENTIFIER UNLESS ALREADY APPLIED IN CURRENT RANGE.
+75430 RETURNS POINTER TO THE DEFINING OCCURRENCE
+75440 *)
+75450 VAR STB, NEWSTB: PSTB;
+75460 BLK: BLKTYP;
+75470 BEGIN
+75480 STB := LEX^.LXV.LXPSTB;
+75490 IF STB=NIL THEN
+75500 BEGIN SEMERRP(ESE+16, LEX); STB := GETSTB(LEX, [STINIT], STBDEFID); STB^.STMODE := MDERROR END;
+75510 WITH STB^ DO
+75520 BEGIN
+75530 BLK := STBLKTYP;
+75540 IF BLK=STBAPPID THEN STB := STDEFPTR
+75550 ELSE IF BLK<>STBDEFID THEN
+75560 BEGIN SEMERRP(ESE+15, LEX); STB := GETSTB(LEXALEPH, [STINIT], STBDEFID); STB^.STMODE := MDERROR END;
+75570 IF TESTSTB(LEX)=STBNONE (*NOT YET ENCOUNTERED IN CURRENT RANGE*) THEN
+75580 BEGIN NEWSTB := GETSTB(LEX, [], STBAPPID); NEWSTB^.STDEFPTR := STB END;
+75590 NECENV(STB)
+75600 END;
+75610 STB^.STDEFTYP:=STB^.STDEFTYP+[STUSED];
+75620 APPID := STB
+75630 END;
+75640 (**)
+75650 (**)
+75660 PROCEDURE DEFLAB(LEX: PLEX);
+75670 (*FUNCTION: MAKE STBLOCK FOR DEFINING-LABEL*)
+75680 VAR STB: PSTB;
+75690 BLK: BLKTYP;
+75700 BEGIN
+75710 RGINFO := RGINFO+[DCLLABEL];
+75720 CGFIXRG;
+75730 BLK := TESTSTB(LEX);
+75740 IF BLK=STBAPPLAB THEN
+75750 BEGIN
+75760 STB := LEX^.LXV.LXPSTB; WITH STB^, ROUTNL^ DO
+75770 BEGIN
+75780 IF STCURID<CURID THEN SEMERRP(ESE+61, LEX);
+75790 STDEFTYP := [STCONST]; STBLKTYP := STBDEFLAB;
+75800 STLEVEL := RNLEVEL;
+75810 CGLABB(STB, 0); CGLABA(STB) (*LABEL-DEFINITION WITH PREVIOUS APPLIED OCCURRENCES*)
+75820 END
+75830 END
+75840 ELSE IF BLK=STBNONE THEN
+75850 BEGIN
+75860 STB := GETSTB(LEX, [STCONST], STBDEFLAB); WITH STB^ DO
+75870 BEGIN STXPTR[1] := 0; STROUTN := NIL END;
+75880 CGLABA(STB) (*LABEL-DEFINITION WITH NO PREVIOUS APPLIED OCCURRENCE*)
+75890 END
+75900 ELSE IF BLK=STBDEFLAB THEN SEMERRP(ESE+13, LEX)
+75910 ELSE SEMERRP(ESE+07, LEX);
+75920 WITH STB^, ROUTNL^ DO
+75930 IF DCLLOCRNG IN RGINFO THEN STLOCRG := RNLOCRG
+75940 ELSE STLOCRG := RNLOCRG+1;
+75950 END;
+75960 (**)
+75970 (**)
+75980 FUNCTION APPLAB(LEX: PLEX): PSTB;
+75990 (*FUNCTION: CREATE STBLOCK FOR APPLIED-LABEL IF NO DEFINING OCCURRENCE YET EXISTS.
+76000 RETURNS POINTER TO MOST RECENT OCCURRENCE (APPLIED OR DEFINING).
+76010 *)
+76020 VAR STB: PSTB;
+76030 BLK: BLKTYP;
+76040 BEGIN
+76050 BLK := TESTSTB(LEX);
+76060 IF BLK<>STBNONE THEN
+76070 BEGIN
+76080 STB := LEX^.LXV.LXPSTB;
+76090 IF (BLK<>STBDEFLAB) AND (BLK<>STBAPPLAB) THEN SEMERRP(ESE+07, LEX)
+76100 END
+76110 ELSE
+76120 BEGIN
+76130 STB := GETSTB(LEX, [], STBAPPLAB); WITH STB^ DO
+76140 BEGIN
+76150 STCURID := CURID;
+76160 STXPTR[0] := 0; STXPTR[1] := 0; STROUTN := NIL;
+76170 END
+76180 END;
+76190 CGLABC(STB, 0);
+76200 APPLAB := STB
+76210 END;
+76220 (**)
+76230 (**)
+76240 PROCEDURE DEFMI(LEX: PLEX);
+76250 (*FUNCTION: MAKE STBLOCK FOR DEFINING-MODE-INDICATION*)
+76260 VAR STB: PSTB;
+76270 BLK: BLKTYP;
+76280 BEGIN
+76290 NOLABELS; LOCRNGE;
+76300 BLK := TESTSTB(LEX);
+76310 IF BLK=STBAPPMI THEN SEMERRP(ESE+12, LEX);
+76320 IF BLK<STBNONE THEN SEMERRP(ESE+11, LEX)
+76330 ELSE BEGIN
+76340 LEX^.LXV := LXVMDIND;
+76350 STB := GETSTB(LEX, [STINIT (*FOR STDIDTY*) (* , STDNONREC*)], STBDEFMI); STB^.STMODE := NIL;
+76360 STB^.STOFFSET := 0
+76370 END
+76380 END;
+76390 (**)
+76400 (**)
+76410 FUNCTION APPMI(LEX: PLEX): PSTB;
+76420 (*FUNCTION: CREATE STBLOCK FOR APPLIED-MODE-INDICATION UNLESS ALREADY APPLIED IN CURRENT RANGE.
+76430 RETURNS POINTER TO THE DEFINING OCCURRENCE.
+76440 *)
+76450 VAR STB, NEWSTB: PSTB;
+76460 I: INTEGER; LXIO: LXIOTYPE; SAFE: SET OF (YIN, YANG);
+76470 BEGIN
+76480 STB := LEX^.LXV.LXPSTB;
+76490 IF STB=NIL THEN BEGIN DEFMI(LEX); STB := LEX^.LXV.LXPSTB; STB^.STMODE := MDERROR; SEMERRP(ESE+46, LEX) END;
+76500 WITH STB^ DO IF STBLKTYP=STBAPPMI THEN STB := STDEFPTR;
+76510 IF TESTSTB(LEX)=STBNONE THEN WITH STB^ DO
+76520 BEGIN
+76530 IF STMODE=NIL THEN
+76540 BEGIN SEMERRP(ESE+46, LEX); STMODE := MDERROR END;
+76550 NEWSTB := GETSTB(LEX, [], STBAPPMI);
+76560 NEWSTB^.STDEFPTR := STB
+76570 END
+76580 ELSE WITH STB^ DO
+76590 IF STMODE=NIL THEN
+76600 BEGIN
+76610 STDEFTYP := [STINIT (*FOR STDIDTY*), STRECUR];
+76620 (*WELLFORMED*)
+76630 SAFE := []; I := PLSTKP+1;
+76640 WHILE (SAFE<>[YIN, YANG]) AND (I<SRPLSTKSIZE) DO WITH SRPLSTK[I]^.LXV DO
+76650 BEGIN
+76660 IF (LXIO=LXIOREF) OR (LXIO=LXIOPROC) THEN
+76670 SAFE := SAFE+[YIN]
+76680 ELSE IF (LXIO=LXIOOPEN) OR (LXIO=LXIOSTRUCT) THEN
+76690 SAFE := SAFE+[YANG]
+76700 ELSE IF LXIO=LXIOMDIND THEN
+76710 BEGIN SEMERR(ESE+03); SAFE := [YIN, YANG] END;
+76720 I := I+1
+76730 END;
+76740 END;
+76750 APPMI := STB
+76760 END;
+76770 (**)
+76780 (**)
+76790 PROCEDURE DEFPRIO(LEX, PRIO: PLEX);
+76800 (*FUNCTION: MAKE STBLOCK FOR PRIORITY-DEFINITION*)
+76810 VAR STB, OLDSTB: PSTB;
+76820 BEGIN
+76830 NOLABELS;
+76840 OLDSTB := LEX^.LXV.LXPSTB;
+76850 IF OLDSTB<>NIL THEN
+76860 IF OLDSTB^.STDYPRIO<>10 THEN SEMERRP(ESE+42, LEX);
+76870 WITH PRIO^ DO
+76880 IF (LXDENMD<>MDINT) OR (LXDENRP<=0) OR (LXDENRP>9) THEN SEMERR(ESE+41)
+76890 ELSE
+76900 BEGIN
+76910 STB := GETPRIO(LEX); WITH STB^ DO
+76920 BEGIN
+76930 IF OLDSTB<>NIL THEN
+76940 BEGIN STSTDOP := OLDSTB^.STSTDOP; STUSERLEX := OLDSTB^.STUSERLEX END;
+76950 STDYPRIO := (*-04() LXDENRP ()-04*)(*+04() SHRINK(LXDENRP) ()+04*)
+76960 END
+76970 END
+76980 END;
+76990 (**)
+77000 (**)
+77010 PROCEDURE DEFOP(LEX: PLEX);
+77020 (*FUNCTION: MAKE STBLOCK FOR USER OPERATION-DEFINITION*)
+77030 VAR STB: PSTB;
+77040 LX: PLEX;
+77050 BEGIN
+77060 NOLABELS; LOCRNGE;
+77070 WITH LEX^.LXV DO
+77080 IF LXPSTB=NIL THEN (*NO PRIORITY-DEFINITION EXISTS*)
+77090 BEGIN STB := GETPRIO(LEX); STB^.STDYPRIO := 10 (*FOR MONADICS*) END
+77100 ELSE STB := LXPSTB;
+77110 WITH STB^ DO
+77120 BEGIN
+77130 IF STUSERLEX=NIL THEN (*NO PREVIOUS OPERATION-DEFINITION*)
+77140 BEGIN
+77150 ENEW(LX, LEX1SIZE); STUSERLEX := LX; (*CREATE DUMMY LEXEME*)
+77160 STUSERLEX^.LXV := LXVOPR; STUSERLEX^.LINK := LEX;
+77170 END;
+77180 FILLSTB(GETSTB(STUSERLEX, [STINIT](*FOR STDIDTY*), STBDEFOP))
+77190 END
+77200 END;
+77210 (**)
+77220 (**)
+77230 FUNCTION APPOP(STB: PSTB): PSTB;
+77240 (*FUNCTION: HANDLE APPLIED-OPERATOR; NO NEED TO CREATE AN APPLIED STBLOCK IN THE SUBLANGUAGE*)
+77250 BEGIN
+77260 NECENV(STB);
+77270 STB^.STDEFTYP := STB^.STDEFTYP + [STUSED] ;
+77280 APPOP := STB
+77290 END;
+77300 (**)
+77310 (**)
+77320 PROCEDURE PUTDEN(LEX: PLEX);
+77330 (*FUNCTION: CREATES A SEMANTIC BLOCK FOR A DENOTATION*)
+77340 VAR SB: PSB;
+77350 BEGIN WITH LEX^ DO
+77360 BEGIN
+77370 IF LXV.LXIO=LXIOBOOLDEN THEN SB := PUSHSB(MDBOOL)
+77380 ELSE SB := PUSHSB(LXDENMD);
+77390 WITH SB^ DO
+77400 BEGIN
+77410 SBLEX := LEX;
+77420 SBINF := [SBMORF,SBVOIDWARN]; SBTYP := SBTDEN
+77430 END
+77440 END
+77450 END;
+77460 (**)
+77470 (**)
+77480 PROCEDURE PUTIND(STB: PSTB);
+77490 (*FUNCTION: CREATES A SEMANTIC BLOCK FOR AN APPLIED-INDICATOR*)
+77500 VAR SB: PSB;
+77510 BEGIN
+77520 WITH STB^ DO
+77530 BEGIN
+77540 IF STBLKTYP<>STBDEFMI THEN
+77550 SB := PUSHSB(STMODE)
+77560 ELSE IF STMODE^.MDV.MDID=MDIDROW THEN
+77570 SB := PUSHSB(PRCBNDS)
+77580 ELSE SB := PUSHSB(MDABSENT);
+77590 WITH SB^ DO
+77600 BEGIN
+77610 IF NOT (STCONST IN STDEFTYP) THEN
+77620 BEGIN SBLEVEL := STLEVEL; SBOFFSET := STOFFSET; SBLOCRG := STLOCRG ;
+77630 IF NOT (STVAR IN STDEFTYP) THEN
+77640 SBTYP := SBTID
+77650 ELSE WITH SBMODE^.MDPRRMD^ DO
+77660 IF (MDV.MDID=MDIDSTRUCT) OR (MDV.MDID=MDIDROW) THEN
+77670 SBTYP := SBTIDV
+77680 ELSE SBTYP := SBTVAR;
+77690 END
+77700 ELSE
+77710 IF (STMODE^.MDV.MDID=MDIDPROC) OR (STBLKTYP=STBDEFMI) THEN
+77720 BEGIN
+77730 IF STRCONST IN STDEFTYP THEN SBTYP := SBTRPROC
+77740 ELSE SBTYP:=SBTPROC;
+77750 SBLEVEL:=STLEVEL;
+77760 SBOFFSET:=0;
+77770 SBXPTR:=STPTR;
+77780 END
+77790 ELSE
+77800 BEGIN
+77810 SBLEX:=STVALUE;
+77820 SBTYP := SBTDEN;
+77830 END;
+77840 SBINF := [SBMORF,SBVOIDWARN];
+77850 END
+77860 END
+77870 END;
+77880 (**)
+77890 (**)
+77900 PROCEDURE PUTLOOP(LEX: PLEX);
+77910 (*FUNCTION: CREATES A SEMANTIC BLOCK FOR A LOOP*)
+77920 VAR SB: PSB;
+77930 BEGIN
+77940 SB := MAKESUBSTACK(0, MDINT);
+77950 SB^.SBLEX := LEX;
+77960 END;
+77970 (**)
+77980 (**)
+77990 (**)
+78000 PROCEDURE ELABMI(LEX: PLEX);
+78010 (*FUNCTION: ELABORATE MODE-INDICATION*)
+78020 VAR STB: PSTB;
+78030 BEGIN WITH LEX^ DO
+78040 BEGIN
+78050 STB := LXV.LXPSTB;
+78060 WITH STB^ DO IF STBLKTYP=STBAPPMI THEN STB := STDEFPTR;
+78070 NECENV(STB);
+78080 PUTIND(STB);
+78090 WITH SRSTK[SRSEMP] DO BEGIN CGDEPROC(SB); SB^.SBMODE:=MDBNDS END;
+78100 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := STB^.STMODE
+78110 END
+78120 END;
+78130 (**)
+78140 (**)
+78150 PROCEDURE PARMSC;
+78160 (*FUNCTION: PUT MODE OF NEXT ACTUAL-PARAMETER ONTO SCCHAIN*)
+78170 VAR SB: PSB;
+78180 BEGIN
+78190 SB := SRSTK[SRSUBP+1].SB;
+78200 WITH SB^ DO
+78210 WITH SBMODE^ DO
+78220 BEGIN
+78230 IF SBCNT>=MDV.MDCNT THEN
+78240 BEGIN
+78250 SCPUSH(MDERROR);
+78260 IF SBCNT=MDV.MDCNT THEN MODERR(SBMODE, ESE+30);
+78270 END
+78280 ELSE SCPUSH(MDPRCPRMS[SBCNT]);
+78290 SBCNT := SBCNT+1
+78300 END
+78310 END;
+78320 (**)
+78330 (**)
+78340 PROCEDURE OPDSAVE(M: MODE);
+78350 (*FUNCTION: SAVES MODE OF OPERAND AND BALFLAG ON SRSTACK*)
+78360 VAR SB: PSB;
+78370 BEGIN
+78380 SB := PUSHSB(M); WITH SB^ DO
+78390 BEGIN
+78400 RTSTACK := SBRTSTK;
+78410 IF BALFLAG THEN SBBALSTR := BALSTR
+78420 ELSE SBBALSTR := STRNONE;
+78430 BALFLAG := FALSE
+78440 END
+78450 END;
+78460 (**)
+78470 (**)
+78480 FUNCTION OPDREST: MODE;
+78490 (*FUNCTION: RESTORES MODE AND BALFLAG FROM SRSTACK*)
+78500 VAR SB: PSB;
+78510 BEGIN
+78520 SB := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1; WITH SB^ DO
+78530 BEGIN OPDREST := SBMODE; BALFLAG := SBBALSTR<>STRNONE; DISPOSE(SB) END
+78540 END;
+78550 (**)
+78560 (**)
+78570 PROCEDURE BALOPR;
+78580 (*FUNCTION: PERFORMS COERCION OF OPERANDS*)
+78590 VAR SBLH,SBRH: PSB;
+78600 LHM,M: MODE;
+78610 BEGIN
+78620 M := COERCE(OPDREST); (*COERCE RH OPERAND*)
+78630 IF LHFIRM=MDABSENT THEN (*MONADIC OPERATOR*)
+78640 CGOPDA (*TOTAL RH OPERAND*)
+78650 ELSE (*DYADIC OPERATOR*)
+78660 BEGIN
+78670 IF SRSTK[SRSEMP-1].SB^.SBBALSTR<>STRNONE THEN (*LH OPERAND WAS BALANCED OR DELAYED*)
+78680 BEGIN
+78690 (*CONTENTS OF SRSTK:
+78700 RH OPERAND (COERCED AND TOTALLED); = RTSTACK.
+78710 LOCUM TENENS REPRESENTING LH OPERAND AFTER COERCION AND AFTER RH CODE; ON RTSTACK.
+78720 SUBSTACK CONTAINING CONSTITUENTS (MAYBE ONLY 1) OF LH BALANCE
+78730 *)
+78740 CGOPDD; (*JUMP OVER LH COERCION*)
+78750 UNSTACKSB; SBRH := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1; (*FORGET RH RESULTS TEMPORARILY*)
+78760 LHM := OPDREST; (*BALFLAG IS NOW SET*)
+78770 UNSTACKSB; SBLH := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1; (*FORGET LOCUM TENENS*)
+78780 M := COERCE(COFIRM(SRSTK[SRSEMP].SB^.SBMODE, LHM)); (*COERCE LH BALANCE FIRMLY*)
+78790 CGOPDE(SBLH); (*JUMP BACK TO RH CODE; SET LABEL FOR RH EXIT*)
+78800 DISPOSE(SBLH);
+78810 STACKSB(SBRH);
+78820 M := COERCE(LHM); (*WIDEN RESULT OF LH BALANCE, IF REQUIRED*)
+78830 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SBRH; (*REMEMBER RH RESULTS AGAIN*)
+78840 END
+78850 ELSE
+78860 BEGIN
+78870 CGOPDA; (*TOTAL RH OPERAND*)
+78880 SBRH := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1;
+78890 M := COERCE(OPDREST); (*COERCE LH OPERAND*)
+78900 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SBRH
+78910 END;
+78920 END;
+78930 END;
+78940 (**)
+78950 (**)
+78960 (*
+78970 LHOPBAL BALOPR
+78980 1------! !--------------------------------------------!
+78990 CGOPDC CGOPDD CGOPDE
+79000 !--! !----! !----!
+79010 --------------->---------------
+79020 ! !
+79030 ! ---+---------->-----------
+79040 ! ! ! !
+79050 COMPUTE LH-- ->COMPUTE RH COERCE RH-- ->FIRMLY COERCE LH-- ->WIDEN LH CGOPR/CGOPAB
+79060 ! !
+79070 ------------------------<----------------------
+79080 *)
+79090 (**)
+79100 (**)
+79110 PROCEDURE LHOPBAL(M: MODE);
+79120 (*FOR LH OPERAND WHICH IS BALANCED OR DELAYED*)
+79130 VAR SB: PSB;
+79140 BEGIN
+79150 IF NOT BALFLAG THEN
+79160 BEGIN
+79170 SB := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1; SUBSAVE; SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SB;
+79180 CGIBAL; BALFLAG := TRUE
+79190 END;
+79200 SB := PUSHSB(M); (*PUT LOCUM TENENS; M HAS THE LARGEST POSSIBLE LEN (BAR WIDENING) FOR THE LH MODE*)
+79210 CGOPDC (*LABEL FOR START OF RH CODE; PUSHES LOCUM TENENS TO REPRESENT LH DURING RH CODE*)
+79220 END;
+79230 (**)
+79240 (**)
+79250 PROCEDURE PUTMD(LHM,RHM: MODE);
+79260 (*FUNCTION: SETS A POSTERIORI MODES OF OPERANDS*)
+79270 BEGIN
+79280 SRSTK[SRSEMP].SB^.SBMODE := RHM;
+79290 IF LHFIRM<>MDABSENT THEN (*NOT MONADIC OPERATOR*)
+79300 IF SRSTK[SRSEMP].SB^.SBBALSTR<>STRNONE THEN
+79310 SRSTK[SRSUBP-1].SB^.SBMODE := LHM
+79320 ELSE SRSTK[SRSEMP-2].SB^.SBMODE := LHM
+79330 END;
+79340 (**)
+79350 (**)
+79360 FUNCTION OPIDSTD(STB: PSTB): BOOLEAN;
+79370 (*FUNCTION: RETURNS TRUE IF OPERATOR STB CAN BE IDENTIFIED AS A STANDARD OPERATOR*)
+79380 VAR FOUND: BOOLEAN;
+79390 LHX, RHX: XTYPE;
+79400 BEGIN OPBLK := STB^.STSTDOP-1;
+79410 IF OPBLK<0 THEN OPIDSTD := FALSE
+79420 ELSE
+79430 BEGIN
+79440 REPEAT OPBLK := OPBLK+1; WITH OPTABL[OPBLK] DO
+79450 BEGIN
+79460 CASE OPIDNDX OF
+79470 IDAA: (*REQUIRES L AND R WITHIN GIVEN RANGE*)
+79480 BEGIN LHX := TX(LHFIRM); RHX := TX(RHFIRM);
+79490 IF LHX>RHX THEN COMMX := LHX ELSE COMMX := RHX;
+79500 FOUND := (LHX>=OPMIN) AND (RHX>=OPMIN) AND (LHX<=OPMAX) AND (RHX<=OPMAX)
+79510 (*+61() AND ((COMMX>XLCOMPL) OR (ODD(LHX)=ODD(RHX))) ()+61*) (*SAME LENGTH*)
+79520 END;
+79530 IDAAL: (*REQUIRES L AND R WITHIN GIVEN RANGE*)
+79540 BEGIN LHX := TX(LHFIRM); RHX := TX(RHFIRM);
+79550 (*-61() COMMX := OPMAX-1; ()-61*)
+79560 (*+61() IF ODD(LHX) THEN COMMX := OPMAX ELSE COMMX := OPMAX-1; ()+61*)
+79570 FOUND := (LHX>=OPMIN) AND (RHX>=OPMIN) AND (LHX<=OPMAX) AND (RHX<=OPMAX)
+79572 (*+61() AND ((COMMX>XLCOMPL) OR (ODD(LHX)=ODD(RHX))) ()+61*) (*SAME LENGTH*)
+79580 END;
+79590 IDRA: (*REQUIRES L WITHIN L AND R <= GIVEN RANGE*)
+79600 BEGIN LHX := TX(LHFIRM); RHX := TX(RHFIRM);
+79610 COMMX := LHX;
+79620 FOUND := (LHX>=OPMIN) AND (LHX<=OPMAX) AND (LHX>=RHX)
+79630 (* AND (ODD(LHX)=ODD(RHX)) *) (*SAME LENGTH*)
+79640 END;
+79650 IDBB: (*REQUIRES L AND R WITHIN GIVEN RANGE, AND L=R*)
+79660 BEGIN LHX := TX(LHFIRM); RHX := TX(RHFIRM);
+79670 COMMX := LHX;
+79680 FOUND := (LHX=RHX) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79690 END;
+79700 IDBI,IDSI: (*REQUIRES L WITHIN RANGE ANDR=INT*)
+79710 BEGIN COMMX := TX(LHFIRM);
+79720 FOUND := (RHFIRM=MDINT) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79730 END;
+79740 IDIB: (*REQUIRES L=INT AND R WITHIN RANGE*)
+79750 BEGIN COMMX := TX(RHFIRM);
+79760 FOUND := (LHFIRM=MDINT) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79770 END;
+79780 IDSC: (*REQUIRES L=STRNG AND R WITHIN RANGE*)
+79790 BEGIN COMMX := TX(RHFIRM);
+79800 FOUND := (LHFIRM=MDSTRNG) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79810 END;
+79820 IDCS: (*REQUIRES L WITHIN RANGE AND R=STRNG*)
+79830 BEGIN COMMX := TX(LHFIRM);
+79840 FOUND := (RHFIRM=MDSTRNG) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79850 END;
+79860 IDMON,IDMONL: (*MONADIC OPERATORS*)
+79870 BEGIN COMMX := TX(RHFIRM);
+79880 FOUND := (LHFIRM=MDABSENT) AND (COMMX>=OPMIN) AND (COMMX<=OPMAX)
+79890 END;
+79900 IDIBR, IDIBRM: (*.LWB AND .UPB*)
+79910 BEGIN LHX := TX(LHFIRM); COMMX := LHX;
+79920 FOUND := ((RHFIRM^.MDV.MDID=MDIDROW) OR (RHFIRM=MDROWS))
+79930 AND (LHX>=OPMIN) AND (LHX<=OPMAX)
+79940 AND ((LHX<>-1) OR (LHFIRM=MDABSENT))
+79950 END;
+79960 END;
+79970 END;
+79980 UNTIL FOUND OR (NOT OPTABL[OPBLK].OPMORE);
+79990 OPIDSTD := FOUND
+80000 END
+80010 END;
+80020 (**)
+80030 (**)
+80040 PROCEDURE OPDOSTD;
+80050 (*FUNCTION: GENERATES CODE FOR APPLICATION OF STANDARD OPERATOR*)
+80060 VAR RESMODE: MODE;
+80070 LENGS: INTEGER;
+80080 BEGIN WITH OPTABL[OPBLK] DO
+80090 BEGIN
+80100 CASE OPIDNDX OF
+80110 IDAA:
+80120 BEGIN RESMODE := XMODES[COMMX];
+80130 PUTMD(RESMODE, RESMODE);
+80140 IF OPMODE<>MDABSENT THEN RESMODE := OPMODE
+80150 END;
+80160 IDAAL:
+80170 BEGIN
+80180 (*+61() IF ODD(COMMX) THEN LENGS := 1 ELSE LENGS := 0; ()+61*)
+80190 RESMODE := XMODES[COMMX];
+80200 PUTMD(RESMODE, RESMODE);
+80210 RESMODE := (*-61() OPMODE ()-61*)(*+61() LENGTHEN(OPMODE, LENGS) ()+61*);
+80220 END;
+80230 IDRA:
+80240 BEGIN RESMODE := FINDREF(XMODES[COMMX]);
+80250 PUTMD(RESMODE, XMODES[COMMX])
+80260 END;
+80270 IDBI:
+80280 BEGIN IF OPMODE=MDABSENT THEN RESMODE := XMODES[COMMX] ELSE RESMODE := OPMODE;
+80290 PUTMD(XMODES[COMMX], MDINT)
+80300 END;
+80310 IDBB,IDIB:
+80320 BEGIN IF OPMODE=MDABSENT THEN RESMODE := XMODES[COMMX] ELSE RESMODE := OPMODE;
+80330 PUTMD(LHFIRM, RHFIRM)
+80340 END;
+80350 IDSI:
+80360 BEGIN RESMODE := OPMODE;
+80370 PUTMD(REFSTRNG, RHFIRM)
+80380 END;
+80390 IDSC:
+80400 BEGIN RESMODE := OPMODE;
+80410 PUTMD(REFSTRNG, MDSTRNG)
+80420 END;
+80430 IDCS:
+80440 BEGIN RESMODE := OPMODE;
+80450 PUTMD(MDSTRNG, REFSTRNG)
+80460 END;
+80470 IDMON:
+80480 BEGIN IF OPMODE=MDABSENT THEN RESMODE := XMODES[COMMX] ELSE RESMODE := OPMODE;
+80490 PUTMD(NIL, RHFIRM)
+80500 END;
+80510 IDMONL:
+80520 BEGIN IF ODD(COMMX) THEN LENGS := 1 ELSE LENGS := 0;
+80530 RESMODE := LENGTHEN(OPMODE, LENGS);
+80540 PUTMD(NIL, RHFIRM)
+80550 END;
+80560 IDIBR, IDIBRM:
+80570 BEGIN RESMODE := OPMODE;
+80580 PUTMD(LHFIRM, MDROWS)
+80590 END;
+80600 END;
+80610 BALOPR;
+80620 IF (OPIDNDX=IDRA) AND NOT(COMMX IN [XCOMPL,XLCOMPL]) (*NOT COMPLEX*) THEN
+80630 CGOPAB(OPOPCOD-COMMX+OPMIN, RESMODE)
+80640 ELSE CGOPR(OPOPCOD-COMMX+OPMIN, RESMODE, OPIDNDX>IDMONL);
+80650 IF OPIDNDX>IDMONL THEN (*DYADIC*)
+80660 BEGIN DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1 END;
+80670 WITH SRSTK[SRSEMP].SB^ DO
+80680 IF OPIDNDX IN [IDRA,IDSI,IDCS,IDSC] THEN SBINF := SBINF+[SBMORF]-[SBVOIDWARN]
+80690 ELSE SBINF := SBINF+[SBMORF,SBVOIDWARN];
+80700 END
+80710 END;
+80720 (**)
+80730 (**)
+80740 (**)
+80750 FUNCTION OPIDUSER(STB: PSTB): BOOLEAN;
+80760 (*FUNCTION: RETURNS TRUE IF OPERATOR STB CAN BE IDENTIFIED AS A USER OPERATOR*)
+80770 LABEL 9;
+80780 VAR PROCM: MODE;
+80790 BEGIN WHILE STB<>NIL DO
+80800 BEGIN
+80810 PROCM := STB^.STMODE; GETOPDM(PROCM);
+80820 IF (LHFIRM=COFIRM(LHMODE,NIL)) AND (RHFIRM=COFIRM(RHMODE,NIL)) THEN
+80830 BEGIN OPCOD := APPOP(STB); OPIDUSER := TRUE; GOTO 9 END;
+80840 STB := STB^.STLINK
+80850 END;
+80860 OPIDUSER := FALSE;
+80870 9: END;
+80880 (**)
+80890 (**)
+80900 (**)
+80910 (**)
+80920 PROCEDURE OPDOUSER;
+80930 (*FUNCTION: GENERATES CODE FOR APPLICATION OF USER-DEFINED OPERATOR*)
+80940 VAR SB:PSB;
+80942 ADIC: 1..2;
+80944 (*+05() OFFST, I: INTEGER; ()+05*)
+80950 BEGIN
+80952 ADIC := 1+ORD(LHFIRM<>MDABSENT);
+80960 PUTMD(LHMODE, RHMODE);
+80970 BALOPR;
+80972 SB := MAKESUBSTACK(ADIC, OPCOD^.STMODE^.MDPRRMD);
+80974 (*+05()
+80975 OFFST := 0;
+80976 FOR I := 0 TO ADIC-1 DO WITH OPCOD^.STMODE^.MDPRCPRMS[I]^ DO
+80978 IF MDV.MDPILE THEN OFFST := OFFST+SZADDR ELSE OFFST := OFFST+MDV.MDLEN;
+80979 CLEAR(RTSTACK);
+80980 ADJUSTSP := 0; HOIST(SUBSTLEN([SBTSTK..SBTDL]), OFFST, FALSE);
+80981 IF ADJUSTSP<>0 THEN
+80982 BEGIN
+80983 FOR I := 0 TO ADIC-1 DO
+80984 BEGIN SRSTK[SRSEMP+1-I] := SRSTK[SRSEMP-I]; UNSTACKSB END;
+80985 SRSEMP := SRSEMP-ADIC; FILL(SBTSTK, PUSHSB(MDINT));
+80986 SRSEMP := SRSEMP+ADIC;
+80987 FOR I := ADIC-1 DOWNTO 0 DO STACKSB(SRSTK[SRSEMP-I].SB);
+80988 END;
+80989 ()+05*)
+80990 PUTIND(OPCOD); CGOPCALL; POPUNITS;
+81000 WITH SB^ DO SBINF := SBINF+[SBMORF]-[SBVOIDWARN];
+81010 END;
+81020 (**)
+81030 (**)
+81040 PROCEDURE OPIDENT(MONADIC: BOOLEAN);
+81050 (*FUNCTION: IDENTIFIES APPLIED-OPERATOR AND ELABORATES FORMULA*)
+81060 LABEL 9;
+81070 VAR STB: PSTB;
+81080 LEX: PLEX;
+81090 BEGIN
+81100 RHFIRM := SRSTK[SRSEMP].SB^.SBMODE;
+81110 IF MONADIC THEN LHFIRM := MDABSENT
+81120 ELSE IF SRSTK[SRSEMP].SB^.SBBALSTR<>STRNONE THEN
+81130 LHFIRM := SRSTK[SRSUBP-1].SB^.SBMODE
+81140 ELSE
+81150 LHFIRM := SRSTK[SRSEMP-2].SB^.SBMODE;
+81160 LEX := SRPLSTK[PLSTKP+1];
+81170 STB := LEX^.LXV.LXPSTB;
+81180 IF STB=NIL THEN STB := GETPRIO(LEX);
+81190 IF OPIDSTD(STB) THEN OPDOSTD
+81200 ELSE WITH STB^ DO
+81210 BEGIN
+81220 IF STUSERLEX<>NIL THEN
+81230 IF OPIDUSER(STUSERLEX^.LXV.LXPSTB) THEN GOTO 9;
+81240 IF MONADIC THEN
+81250 BEGIN IF RHFIRM<>MDERROR THEN SEMERRP(ESE+23, LEX); OPCOD := MONADUMMY END
+81260 ELSE
+81270 BEGIN IF (LHFIRM<>MDERROR) AND (RHFIRM<>MDERROR) THEN SEMERRP(ESE+24, LEX); OPCOD := DYADUMMY END;
+81280 GETOPDM(OPCOD^.STMODE);
+81290 9: OPDOUSER
+81300 END;
+81310 END;
+81320 (**)
+81330 (**)
+81340 PROCEDURE DEFOPM(OP: PSTB; M: MODE);
+81350 (*FUNCTION: PROVIDES MODE FOR STBLOCK CREATED IN DEFOP*)
+81360 VAR PRIO: PSTB;
+81370 BEGIN
+81380 WITH M^ DO IF (MDV.MDCNT<=0) OR (MDV.MDCNT>2) THEN
+81390 BEGIN SEMERR(ESE+54); M := MONADUMMY^.STMODE END;
+81400 GETOPDM(M);
+81410 LHFIRM := COFIRM(LHMODE,NIL); RHFIRM := COFIRM(RHMODE,NIL);
+81420 PRIO := OP^.STLEX^.LINK^.LXV.LXPSTB;
+81430 IF (LHFIRM<>MDABSENT) AND (PRIO^.STDYPRIO=0) THEN SEMERR(ESE+55);
+81440 OP^.STMODE := M;
+81450 IF OPIDSTD(PRIO) OR OPIDUSER(OP^.STLINK) THEN SEMERR(ESE+56)
+81460 END;
+81470 (**)
+81480 (**)
+81490 PROCEDURE COLLSC(SB: PSB);
+81500 (*PUTS MODE OF NEXT UNIT OF DISPLAY ON SC CHAIN*)
+81510 BEGIN
+81520 WITH SB^ DO WITH SBMODE^ DO
+81530 BEGIN
+81540 IF MDV.MDID=MDIDROW THEN
+81550 SCPUSH(FINDROW(MDPRRMD, MDV.MDCNT-1))
+81560 ELSE IF MDV.MDID=MDIDSTRUCT THEN
+81570 BEGIN
+81580 IF SBLEVEL>=MDV.MDCNT THEN
+81590 BEGIN SEMERR(ESE+59); SCPUSH(MDERROR) END
+81600 ELSE SCPUSH(MDSTRFLDS[SBLEVEL].MDSTRFMD)
+81610 END
+81620 ELSE SCPUSH(MDERROR);
+81630 SBLEVEL := SBLEVEL+1
+81640 END
+81650 END;
+81660 (**)
+81670 (**)
+81680 (**)
+81690 (**)
+81700 ()+85*)
--- /dev/null
+82000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+82010 (*+83()
+82020 (**)
+82030 (*+21()
+82040 PROCEDURE MONITORSEMANTIC(SRTN: RTNTYPE);
+82050 BEGIN
+82060 WRITE(OUTPUT, LSTLINE:5, PLSTKP:3, RTSTKDEPTH:4, ' S ', SRTN:3);
+82070 (*+01() WRITELN(OUTPUT, SRSEMP:4,SRSUBP:4,' ', ORD(SRSTK[SRSEMP].SB):6OCT, ' ', ORD(RTSTACK):6OCT) ()+01*)
+82080 (*-01() IF SRSEMP<0 THEN WRITELN(OUTPUT)
+82090 ELSE WRITELN(OUTPUT, SRSEMP:4,SRSUBP:4,' ',ORD(SRSTK[SRSEMP].SB):6,' ',ORD(RTSTACK):6) ()-01*)
+82100 END;
+82110 ()+21*)
+82120 (**)
+82130 (**)
+82140 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
+82150 (*FUNCTION: CALLS THE SEMANTIC ROUTINE SPECIFIED BY THE PARSER*)
+82160 (*-53()
+82170 LABEL 759;
+82180 ()-53*)
+82190 VAR STB1: PSTB;
+82200 LEX1: PLEX;
+82210 SB, SBB: PSB;
+82220 R: PRANGE;
+82230 M, FLDM: MODE;
+82240 SECDRY: 0..3;
+82250 OFFST: OFFSETR;
+82260 ROWCOUNT: CNTR;
+82270 I, J: INTEGER;
+82280 L: LABL;
+82290 PTR: PTRIMCHAIN;
+82300 REFED: BOOLEAN;
+82310 (*+53()
+82320 PROCEDURE MONITOR1;
+82330 VAR I: INTEGER;
+82340 ()+53*)
+82350 BEGIN
+82360 IF SRTN>=ESY01 THEN
+82370 BEGIN
+82380 FOR I := ERRPTR+1 TO ERRLXPTR-1 DO ERRBUF[I] := ERRCHAR;
+82390 IF ERRPTR<ERRLXPTR THEN ERRPTR := ERRLXPTR-1;
+82400 OUTERR(SRTN-ESY01+ESY+1, ERRORR, NIL);
+82410 END
+82420 ELSE BEGIN
+82430 (*+21()
+82440 MONITORSEMANTIC(SRTN);
+82450 ()+21*)
+82460 CASE SRTN OF
+82470 (**)
+82480 10: (*SR01*)
+82490 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := SRPLSTK[PLSTKP]^.LXV.LXPSB END;
+82500 (**)
+82510 11: (*SR02*)
+82520 (*LONG/SHORT*)
+82530 SRSTK[SRSEMP].MD := LENGTHEN(INP^.LXV.LXPMD, SRSTK[SRSEMP].SUBP);
+82540 (**)
+82550 12: (*SR03A*)
+82560 (*LONG*)
+82570 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SUBP := 1 END;
+82580 (**)
+82590 13: (*SR03B*)
+82600 (*SHORT*)
+82610 BEGIN SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SUBP := -1 END;
+82620 (**)
+82630 14: (*SR04A*)
+82640 (*LONG AND FORMAL-ROWERS*)
+82650 WITH SRSTK[SRSEMP] DO SUBP := SUBP+1;
+82660 (**)
+82670 15: (*SR04B*)
+82680 (*SHORT*)
+82690 WITH SRSTK[SRSEMP] DO SUBP := SUBP-1;
+82700 (**)
+82710 16: (*SR05*)
+82720 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A .REF TO MODE DECLARATOR*)
+82730 WITH SRSTK[SRSEMP] DO MD := FINDREF(MD);
+82740 (**)
+82750 17: (*SR06*)
+82760 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION OF ROUTINE-TEXT WITHOUT PARAMETERS*)
+82770 BEGIN
+82780 ROUTNNT;
+82790 CGRTA;
+82800 M := SRPOPMD;
+82810 SUBSAVE (*BECAUSE FINDPRC DOES A SUBREST*);
+82820 FINDPRC(M, 0, PROC);
+82830 END;
+82840 (**)
+82850 18: (*SR07A*)
+82860 (*FIRST FIELD-SELECTOR AFTER DECLARER*)
+82870 NEWFIELD(SRPLSTK[PLSTKP]);
+82880 (**)
+82890 19: (*SR07B*)
+82900 (*SUBSEQUENT FIELD-SELECTORS*)
+82910 BEGIN
+82920 SRSTK[SRSEMP+1] := SRSTK[SRSEMP-1]; SRSEMP := SRSEMP+1;
+82930 NEWFIELD(INP)
+82940 END;
+82950 (**)
+82960 20: (*SR08A*)
+82970 BEGIN
+82980 DCLMODE := SRSTK[SRSEMP].MD;
+82990 DCLDEFN := [STINIT (*FOR STDIDTY*)];
+83000 DEFID(SRPLSTK[PLSTKP])
+83010 END;
+83020 (**)
+83030 21: (*SR08B*)
+83040 BEGIN
+83050 SRSEMP := SRSEMP+1; SRSTK[SRSEMP] := SRSTK[SRSEMP-1];
+83060 DEFID(INP)
+83070 END;
+83080 (**)
+83090 22: (*SR10*)
+83100 (*FUNCTION: BEFORE FIELD(PARAMETER) OF .STRUCT (.PROC) DECLARER*)
+83110 SUBSAVE;
+83120 (**)
+83130 23: (*SR11*)
+83140 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A STRUCTURED
+83150 WITH FIELDS MODE DECLARATOR
+83160 *)
+83170 FINSTRUCT((SRSEMP-SRSUBP) DIV 2);
+83180 (**)
+83190 24: (*SR12*)
+83200 (*FUNCTION: START ROWED-ACTUAL-DECLARER IN VARIABLE-DECLARATION OR SOME GENERATORS*)
+83210 BEGIN BRKASCR; SB:=MAKESUBSTACK(0, MDBNDS) END;
+83220 (**)
+83230 25: (*SR14A*)
+83240 (*FORMAL*)
+83250 BEGIN SRSEMP := SRSEMP-1; SRSTK[SRSEMP].MD := FINDROW(SRSTK[SRSEMP+1].MD, SRSTK[SRSEMP].SUBP) END;
+83260 (**)
+83270 26: (*SR14B*)
+83280 (*FUNCTION: EXECUTED AFTER AN ACTUAL-ROWER-LIST-BRACKET*)
+83290 BEGIN
+83300 J := (SRSEMP-SRSUBP) DIV 2;
+83310 CGACTBNDS(SRSTK[SRSUBP-1].SB,J); (*LOADS BOUNDS INTO SB*)
+83320 POPUNITS
+83330 END;
+83340 (**)
+83350 27: (*SR14C*)
+83360 (*FUNCTION: EXECUTED AFTER AN ACTUAL-DECLARER*)
+83370 WITH SRSTK[SRSEMP] DO
+83380 MD := FINDROW(MD, SRSTK[SRSEMP-1].SB^.SBLOCRG);
+83390 (**)
+83400 28: (*SR15*)
+83410 (*FUNCTION: CREATES A MODE TABLE ENTRY HAVING PARSED A PROCEDURE DECLARATOR*)
+83420 BEGIN
+83430 M := SRPOPMD;
+83440 FINDPRC(M, SRSEMP-SRSUBP, PROC);
+83450 END;
+83460 (**)
+83470 29: (*SR16A*)
+83480 BEGIN DCLMODE := SRPOPMD; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
+83490 (**)
+83500 30: (*SR16B*)
+83510 (*FUNCTION: EXECUTED AFTER DECLARER IN VARIABLE-DECLARATION*)
+83520 BEGIN DCLMODE := SRPOPMD; DCLDEFN := [STVAR] END;
+83530 (**)
+83540 31: (*SR16C*)
+83550 BEGIN DCLMODE := MDROUT; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
+83560 (**)
+83570 32: (*SR16D*)
+83580 BEGIN DCLMODE := PRCBNDS; DCLDEFN := [STINIT (*FOR STDIDTY*)] END;
+83590 (**)
+83600 33: (*SR17*)
+83610 (*FUNCTION: EXECUTED WHEN A VARIABLE-DEFINITION IS NOT PRECEDED BY .LOC*)
+83620 OUTERR(ESE+73, WARNING, NIL);
+83630 (**)
+83640 34: (*SR20A*)
+83650 (*FUNCTION: EXECUTED AT THE BEGINNING OF ANY RANGE EXCEPT A ROUTINE-TEXT.
+83660 PERFORMS RANGE ENTRY FUNCTIONS. MARKS STACK FOR BEGINNING OF A BALANCE.
+83670 THE BALANCE IS THE ESTABLISHING-CLAUSE WHICH STARTS ALL SUCH RANGES.
+83680 *)
+83690 BEGIN RANGENT; SUBSAVE END;
+83700 (**)
+83710 35: (*SR20B*)
+83720 (*FUNCTION: EXECUTED AT THE END OF A CONDITIONAL- OR CASE-CHOOSER*)
+83730 BEGIN RGINFO := RGINFO+[DCLDELAY]; RANGEXT; SEMANTICROUTINE(43) (*SR22A*) END;
+83740 (**)
+83750 36: (*SR20C*)
+83760 (*FUNCTION: EXECUTED WHEN AN ELSE-PART-OPTION OR OUT-PART-OPTION IS EMPTY.
+83770 THE NET EFFECT IS TO ACT AS THOUGH THE OMITTED OPTION WAS .SKIP.
+83780 *)
+83790 BEGIN SB := PUSHSB(MDSKIP);
+83800 SEMANTICROUTINE(43) (*SR22A*)
+83810 END;
+83820 (**)
+83830 37: (*SR20DB*)
+83840 (*FUNCTION: EXECUTED AFTER ENQUIRY-CLAUSE OF CONDITIONAL-CHOOSER*)
+83850 BEGIN
+83860 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
+83870 MEEKLOAD(MDBOOL, ESE+34);
+83880 CGIFA;
+83890 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; SUBSAVE;
+83900 SEMANTICROUTINE(34) (*SR20A*)
+83910 END;
+83920 (**)
+83930 38: (*SR20DI*)
+83940 (*FUNCTION: EXECUTED AFTER ENQUIRY-CLAUSE OF CASE-CHOOSER*)
+83950 BEGIN
+83960 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
+83970 MEEKLOAD(MDINT, ESE+35);
+83980 CGCASA;
+83990 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; SUBSAVE;
+84000 (*SEMANTICROUTINE(34) (*SR20A *)
+84010 END;
+84020 (**)
+84030 39: (*SR20EB*)
+84040 (*FUNCTION: EXECUTED AFTER A THEN-PART OF A CONDITIONAL-ALTERNATIVES*)
+84050 BEGIN
+84060 RGINFO := RGINFO+[DCLDELAY]; RANGEXT;
+84070 INNERBAL;
+84080 ASSIGNFLAD;
+84090 CGFLINE;
+84100 SEMANTICROUTINE(34) (*SR20A*)
+84110 END;
+84120 (**)
+84130 40: (*SR20EI*)
+84140 (*FUNCTION: START ROWED-ACTUAL-DECLARER IN GENERATOR*)
+84150 SB:=MAKESUBSTACK(0, MDBNDS);
+84160 (**)
+84170 41: (*SR20F*)
+84180 (*FUNCTION: EXECUTED AFTER EACH UNIT IN THE IN-PART OF A CASE-ALTERNATIVES*)
+84190 BEGIN INNERBAL; MARK(FIXUPM); CGFLINE END;
+84200 (**)
+84210 42: (*SR20G*)
+84220 (*FUNCTION: PERFORMS FINAL PROCESSING OF CASE-CLAUSE*)
+84230 BEGIN SEMANTICROUTINE(35) (*SR20B*); CGCASC END;
+84240 (**)
+84250 43: (*SR22A*)
+84260 (*FUNCTION: EXECUTED AFTER PROCESSING THE LAST UNIT OF A BALANCE.
+84270 NOTE THAT HERE BALANCES INCLUDE CONDITIONAL-, CASE- AND ESTABLISHING-CLAUSES.
+84280 AN ENQUIRY-CLAUSE DOES NOT REALLY REQUIRE BALANCING BUT THE PARSER DOES NOT DISTINGUISH
+84290 BETWEEN THE TWO KINDS OF ESTABLISHING-CLAUSES (ENQUIRY- AND SERIAL-).
+84300 THUS, ENQUIRY-CLAUSES ARE TREATED AS SERIAL-CLAUSES EVEN THOUGH THE YIELD IS
+84310 ALWAYS THE LAST UNIT.
+84320 *)
+84330 BEGIN LASTIBAL; SETBALFLAG END;
+84340 (**)
+84350 44: (*SR22B*)
+84360 (*FUNCTION: EXECUTED AFTER ENCLOSED-CLAUSE OF PROGRAM OR PRIMARY.
+84370 *)
+84380 BEGIN RGINFO := RGINFO+[DCLDELAY]; RANGEXT END;
+84390 (**)
+84400 45: (*SR23*)
+84410 (*FUNCTION: EXECUTED AFTER ENCLOSED-CLAUSE OF A CAST*)
+84420 BEGIN STRONG;
+84430 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF, SBVOIDWARN, SBCOLL];
+84440 RANGEXT
+84450 END;
+84460 (**)
+84470 46: (*SR24*)
+84480 (*FUNCTION: EXECUTED AFTER UNIT FOLLOWED BY A COMPLETER IN A SERIAL-CLAUSE*)
+84490 INNERBAL;
+84500 (**)
+84510 47: (*SR25A1*)
+84520 (*FUNCTION: EXECUTED AFTER NON-EMPTY FOR-PART.*)
+84530 PUTLOOP(INP);
+84540 (**)
+84550 48: (*25A2*)
+84560 (*FUNCTION: EXECUTED AFTER EMPTY FOR-PART WHEN COUNTING-PART IS NON-EMPTY.*)
+84570 PUTLOOP(LEXALEPH);
+84580 (**)
+84590 49: (*SR25B1*)
+84600 (*FUNCTION: EXECUTED AFTER NON-EMPTY FROM- BY- OR TO-PART.*)
+84610 MEEKLOAD(MDINT, ESE+39);
+84620 (**)
+84630 50: (*SR25B2*)
+84640 (*FUNCTION: EXECUTED AFTER EMPTY FROM-PART WHEN COUNTING-PART IS NON-EMPTY.*)
+84650 BEGIN PUTDEN(LEXONE); SEMANTICROUTINE(49) (*SR25B1*) END;
+84660 (**)
+84670 51: (*SPARE*);
+84680 (**)
+84690 52: (*SR25B3*)
+84700 (*FUNCTION: EXECUTED AFTER EMPTY TO-PART WHEN COUNTING PART IS NON-EMPTY*)
+84710 BEGIN
+84720 WITH SRSTK[SRSUBP-1].SB^ DO SBINF := SBINF+[SBEMPTYTO]
+84730 END;
+84740 (**)
+84750 53: (*SR25B5*)
+84760 (*FUNCTION: EXECUTED AFTER EMPTY BY-PART WHEN COUNTING PART IS NON-EMPTY*)
+84770 WITH SRSTK[SRSUBP-1].SB^ DO SBINF := SBINF+[SBEMPTYBY];
+84780 (**)
+84790 54: (*SR26A*)
+84800 (*FUNCTION: EXECUTED BEFORE WHILE-PART, OR BEFORE DO-PART IF NONE.*)
+84810 BEGIN WITH SRSTK[SRSUBP-1] DO WITH SB^ DO
+84820 BEGIN
+84830 RANGENT; (*START RANGE OF LOOPCLAUSE - MATCHED IN S-44*)
+84840 LEX1 := SBLEX;
+84850 IF LEX1<>NIL THEN
+84860 BEGIN
+84870 RGINFO := RGINFO+[DCLLOOP];
+84880 CGFIXRG;
+84890 SBOFFSET := ALLOC(SZWORD); (*DECMARKER*)
+84900 IF NOT(SBEMPTYBY IN SBINF) THEN I := ALLOC(SZINT); (*BY PART*)
+84910 STB1 := GETSTB(LEX1, [STINIT (*FOR STDIDTY*)], STBDEFID);
+84920 WITH STB1^ DO
+84930 BEGIN STMODE := MDINT; STOFFSET := ALLOC(SZINT); (*FROM PART*)
+84932 (*+41() SBOFFSET := STOFFSET+SZINT; (*OFFSET OF 'TO' PART*) ()+41*)
+84940 IF SBEMPTYTO IN SBINF THEN
+84950 CGLPC(SB)
+84960 ELSE
+84970 BEGIN I := ALLOC(SZINT) (*TO PART*); CGLPB(SB) END
+84980 END
+84990 END
+85000 ELSE CGLPA(SB);
+85010 POPUNITS;
+85020 CGFLINE;
+85030 SEMANTICROUTINE(34) (*SR20A*) (*START RANGE OF WHILE-PART ( OR DO-PART ) *)
+85040 END
+85050 END;
+85060 (**)
+85070 55: (*SR26B*)
+85080 (*FUNCTION: EXECUTED BEFORE WHILE-PART AFTER EMPTY COUNTING-PART.*)
+85090 BEGIN PUTLOOP(NIL); SEMANTICROUTINE(54) (*SR26A*) END;
+85100 (**)
+85110 56: (*SR26C*)
+85120 (*FUNCTION: EXECUTED AFTER WHILE-DO-PART WITH NON-EMPTY WHILE-PART.*)
+85130 BEGIN ASSIGNFLAD; RANGEXT END; (*END RANGE OF WHILE-PART*)
+85140 (**)
+85150 57: (*SR27A*)
+85160 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER NON-EMPTY WHILE-PART.*)
+85170 BEGIN
+85180 IF DCLLABEL IN RGINFO THEN SEMERR(ESE+02);
+85190 MEEKLOAD(MDBOOL, ESE+36);
+85200 CGLPD;
+85210 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
+85220 SCPUSH(MDVOID);
+85230 SEMANTICROUTINE(34) (*SR20A*) (*START RANGE OF DO-PART*)
+85240 END;
+85250 (**)
+85260 58: (*SR27B1*)
+85270 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER EMPTY WHILE-PART AND NON-EMPTY COUNTING-PART.*)
+85280 BEGIN SEMANTICROUTINE(54) (*SR26A*); SCPUSH(MDVOID) END;
+85290 (**)
+85300 59: (*SR27B2*)
+85310 (*FUNCTION: EXECUTED BEFORE DO-PART AFTER EMPTY-WHILE-PART AND EMPTY COUNTING-PART.*)
+85320 BEGIN PUTLOOP(NIL); SEMANTICROUTINE(58) (*SR27B1*) END;
+85330 (**)
+85340 60: (*SR27C*)
+85350 (*FUNCTION: EXECUTED AFTER DO-PART.*)
+85360 BEGIN
+85370 STRONG; RANGEXT; (*END RANGE OF DO-PART*)
+85380 UNSTACKSB;
+85390 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
+85400 CGLPE;
+85405 SRSTK[SRSEMP].SB^.SBMODE:=MDVOID;
+85410 STACKSB(SRSTK[SRSEMP].SB); (*THE .VOID RESULT OF THE DO-PART*)
+85420 END;
+85430 (**)
+85440 (*+53()
+85450 END;
+85460 END END;
+85470 PROCEDURE MONITOR2;
+85480 LABEL 759;
+85490 VAR I: INTEGER;
+85500 BEGIN
+85510 (*+21() MONITORSEMANTIC(SRTN); ()+21*)
+85520 CASE SRTN OF
+85530 ()+53*)
+85540 61: (*SR28*)
+85550 (*FUNCTION: EXECUTED AFTER LOOP-CLAUSE*)
+85560 WITH SRSTK[SRSEMP].SB^ DO
+85570 IF SBLEX<>NIL THEN
+85580 BEGIN CURID := CURID-SZWORD-(3-ORD(SBEMPTYBY IN SBINF)-ORD(SBEMPTYTO IN SBINF))*SZINT;
+85590 IF NOT(SBEMPTYTO IN SBINF) THEN ASSIGNFLAD;
+85600 CGLPG
+85610 END;
+85620 (**)
+85630 62: (*SR29*)
+85640 (*FUNCTION: VOIDS A UNIT FOLLOWED BY A SEMICOLON IN AN ESTABLISHING-CLAUSE.*)
+85650 BEGIN
+85660 SCPUSH(MDVOID); STRONG;
+85670 UNSTACKSB;
+85680 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
+85690 END;
+85700 (**)
+85710 63: (*SR33*)
+85720 (*APPLIED-LABEL*)
+85730 STB1 := APPLAB(SRPLSTK[PLSTKP]);
+85740 (**)
+85750 64: (*SR34A*)
+85760 (*FUNCTION: EXECUTED WHEN APPLIED-IDENTIFIER IS FOUND.
+85770 PLACES SEMANTIC BLOCK FOR THE IDENTIFIER ON THE STACK.
+85780 *)
+85790 PUTIND(APPID(SRPLSTK[PLSTKP]));
+85800 (**)
+85810 65: (*SR34B1*)
+85820 (*FUNCTION: EXECUTED WHEN DENOTATION IS ENCOUNTERED.
+85830 PLACES SEMANTIC BLOCK FOR THE DENOTATION ON THE STACK.
+85840 *)
+85850 BEGIN PUTDEN(SRPLSTK[PLSTKP]) END;
+85860 (**)
+85870 66: (*SR34B2*)
+85880 (*FUNCTION: AS SR34B1, BUT TAKES DENOTATION FROM INP*)
+85890 BEGIN SRSEMP := SRSEMP-1; PUTDEN(INP) END;
+85900 (**)
+85910 67: (*SR34C*)
+85920 (*FUNCTION: EXECUTED WHEN A HIP IS ENCOUNTERED.
+85930 PLACES SEMANTIC BLOCK FOR IT ON STACK.
+85940 *)
+85950 SB := PUSHSB(SRPLSTK[PLSTKP]^.LXV.LXPMD); (*COMORF*)
+85960 (**)
+85970 68: (*SR35*)
+85980 (*FUNCTION: EXECUTED AT START OF MODE-DEFINITION*)
+85990 BEGIN
+86000 DEFMI(SRPLSTK[PLSTKP]);
+86010 END;
+86020 (**)
+86030 69: (*SR36*)
+86040 (*FUNCTION: EXECUTED AT START OF ACTUAL-ROWED-DECLARER IN MODE-DEFINITION*)
+86050 BEGIN
+86060 ROUTNNT;
+86070 CGRTA;
+86080 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := PRCBNDS;
+86090 SEMANTICROUTINE(100) (*SR63B*);
+86100 SB:=MAKESUBSTACK(0,MDBNDS)
+86110 END;
+86120 (**)
+86130 70: (*SR37A*)
+86140 (*FUNCTION: EXECUTED WHEN "ROWED" MODE-INDICATION IS APPLIED IN AN ACTUAL-DECLARER
+86150 IN A GENERATOR.
+86160 *)
+86170 BEGIN
+86180 SRSEMP := SRSEMP-1;
+86190 ELABMI(SRPLSTK[PLSTKP]);
+86200 END;
+86210 (**)
+86220 71: (*SR37B*)
+86230 (*FUNCTION: EXECUTED WHEN A "ROWED" MODE-INDICATION ISAPPLIED IN AN ACTUAL-DECLARER
+86240 IN A VARIABLE-DEFINITION OR SOME GENERATORS.
+86250 *)
+86260 BEGIN
+86270 SRSEMP := SRSEMP-1;
+86280 BRKASCR;
+86290 ELABMI(SRPLSTK[PLSTKP + ORD(SRPLSTK[PLSTKP]^.LXV.LXIO<>LXIOMDIND)]);
+86300 END;
+86310 (**)
+86320 72: (*SR38A*)
+86330 (*FUNCTION: EXECUTED WHEN MODE-DEFINITION IS COMPLETED BY ASCRIBING
+86340 A USER DEFINED "ROWED" MODE-INDICATION.
+86350 *)
+86360 BEGIN
+86370 STB1 := SRPLSTK[PLSTKP+1]^.LXV.LXPSTB;
+86380 FILLSTB(STB1); STB1^.STMODE := SRPOPMD;
+86390 NECENV(SRPLSTK[PLSTKP]^.LXV.LXPSTB);
+86400 PUTIND(SRPLSTK[PLSTKP]^.LXV.LXPSTB);
+86410 CGFIRM
+86420 END;
+86430 (**)
+86440 73: (*SR38B*)
+86450 (*FUNCTION: EXECUTED AFTER MODE-DEFINITION IN CASES NOT COVERED BY SR38A.*)
+86460 BEGIN
+86470 M := SRPOPMD;
+86480 STB1 := SRPLSTK[PLSTKP+1]^.LXV.LXPSTB;
+86490 IF M=NIL THEN M := MDERROR; (*FOR .MODE .A = .A*)
+86500 IF M=NIL THEN M:=MDERROR;
+86510 WITH STB1^, SRSTK[SRSEMP].SB^ DO
+86520 BEGIN
+86530 IF M^.MDV.MDID=MDIDROW THEN (*ROWED MODE*)
+86540 BEGIN
+86550 UNSTACKSB;
+86560 STPTR := SBXPTR ; STLEVEL := SBLEVEL;
+86570 RGSTATE := 13;
+86580 END;
+86590 STDEFTYP := STDEFTYP+[STCONST];
+86600 IF STRECUR IN STDEFTYP THEN RECURFIX(M);
+86610 STMODE := M;
+86620 END;
+86630 END;
+86640 (**)
+86650 (**)
+86660 74: (*SR39*)
+86670 (*FUNCTION: EXECUTED AFTER DEFINING-LABEL*)
+86680 BEGIN
+86690 DEFLAB(SRPLSTK[PLSTKP]);
+86700 CGFLINE
+86710 END;
+86720 (**)
+86730 75: (*SR41*)
+86740 (*FUNCTION: EXECUTED AFTER SECONDARY OF SELECTION*)
+86750 BEGIN
+86760 M := WEAK;
+86770 SECDRY := 0;
+86780 WITH M^ DO IF MDV.MDID=MDIDREF THEN
+86790 BEGIN M := MDPRRMD; SECDRY := 1 END;
+86800 WITH M^ DO IF MDV.MDID=MDIDROW THEN
+86810 BEGIN ROWCOUNT := MDV.MDCNT; M := MDPRRMD; SECDRY := SECDRY+2 END;
+86820 IF M^.MDV.MDID<>MDIDSTRUCT THEN SEMERR(ESE+43)
+86830 ELSE WITH M^ DO
+86840 BEGIN OFFST := 0;
+86850 LEX1 := SRPLSTK[PLSTKP+2];
+86860 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDSTRFLDS[I] DO
+86870 BEGIN
+86880 FLDM := MDSTRFMD;
+86890 IF MDSTRFLEX=LEX1 THEN GOTO 759;
+86900 OFFST := OFFST+FLDM^.MDV.MDLEN
+86910 END;
+86920 SEMERRP(ESE+44, LEX1);
+86930 759: CGSELECT(OFFST, FLDM, SECDRY);
+86940 WITH SRSTK[SRSEMP].SB^ DO
+86950 BEGIN
+86960 IF SECDRY>=2 THEN FLDM := FINDROW(FLDM, ROWCOUNT);
+86970 IF ODD(SECDRY) THEN SBMODE := FINDREF(FLDM)
+86980 ELSE SBMODE := FLDM;
+86990 SBINF := SBINF+[SBMORF,SBVOIDWARN];
+87000 END;
+87010 END
+87020 END;
+87030 (**)
+87040 (**)
+87050 76: (*SR42*)
+87060 (*FUNCTION: EXECUTED AFTER PRIMARY OF CALL*)
+87070 BEGIN
+87080 M := MEEK;
+87090 SBB := MAKESUBSTACK(1,M^.MDPRRMD);
+87100 WITH M^, SRSTK[SRSEMP] DO WITH SB^ DO BEGIN
+87102 (*-02() CGFIRM; (*LOAD ANY DELAYED STUFF*)
+87104 SBINF := SBINF-[SBSTKDELAY]; (*BUT NOT NECESSARILY THIS STUFF*)
+87106 ()-02*)
+87110 IF (MDV.MDID=MDIDPASC) AND (SBTYP<>SBTDEN) THEN M := COERCE(COFIRM(M, NIL));
+87120 IF NOT (SBTYP IN [SBTDEN,SBTPROC,SBTRPROC]) THEN LOADSTK(RTSTACK);
+87130 IF NOT (MDV.MDID IN [MDIDPASC,MDIDPROC]) THEN
+87140 BEGIN MODERR(M, ESE+25); SBMODE := PRCERROR END;
+87150 UNSTACKSB; (*PRIMARY OF CALL*)
+87160 RANGENT; (*FOR PARAMETERS*)
+87170 STACKSB(SB); (*SO IT IS PART OF THE PARAMETERS RANGE*)
+87171 (*+05()
+87172 IF M^.MDV.MDID<>MDIDPASC THEN
+87173 BEGIN
+87174 OFFST := 0;
+87175 FOR I := 0 TO MDV.MDCNT-1 DO WITH MDPRCPRMS[I]^ DO
+87178 IF MDV.MDPILE THEN OFFST := OFFST+SZADDR ELSE OFFST := OFFST+MDV.MDLEN;
+87179 CLEAR(RTSTACK);
+87180 ADJUSTSP := 0; HOIST(0, OFFST, FALSE);
+87182 IF ADJUSTSP<>0 THEN FILL(SBTSTK, PUSHSB(MDINT));
+87183 END;
+87184 ()+05*)
+87186 RGINFO := RGINFO+[DCLLOCRNG];
+87190 WITH ROUTNL^ DO RNLOCRG := RNLOCRG+1;
+87200 SBCNT := 0;
+87210 PARMSC
+87220 END
+87230 END;
+87240 (**)
+87250 77: (*SR43*)
+87260 (*FUNCTION: EXECUTED FOR EVERY OPERAND WHICH MAY POSSIBLY BE A LEFT-DYADIC-OPERAND.
+87270 CHECKS THAT THE OPERATOR TO THE RIGHT OF THE OPERAND IS A LEGAL DYADIC-OPERATOR.
+87280 *)
+87290 WITH INP^.LXV DO
+87300 IF LXPSTB<>NIL THEN
+87310 IF LXPSTB^.STDYPRIO=10 THEN SEMERRP(ESE+22, INP);
+87320 (**)
+87330 78: (*SR44*)
+87340 (*FUNCTION: AFTER MONADIC-OPERATOR*)
+87350 BEGIN OPDSAVE(FIRMBAL); OPIDENT(TRUE) END;
+87360 (**)
+87370 79: (*SR45*)
+87380 (*FUNCTION: EXECUTED IN ORDER TO REDUCE OPRAND OPR OPRAND TO OPRAND*)
+87390 BEGIN OPDSAVE(FIRMBAL); OPIDENT(FALSE) ;
+87400 END;
+87410 (**)
+87420 80: (*SR46*)
+87430 (*FUNCTION: EXECUTED FOR EACH LEFT-HAND-OPERAND OF A DYADIC-OPERATOR*)
+87440 BEGIN
+87450 M := FIRMBAL;
+87460 IF BALFLAG OR (SRSTK[SRSEMP].SB^.SBDELAYS<>0) THEN LHOPBAL(M);
+87470 OPDSAVE(M)
+87480 END;
+87490 (**)
+87500 (**)
+87510 81: (*SR48A*)
+87520 (*FUNCTION: EXECUTED AFTER LEFT HAND TERTIARY OF IDENTITY-RELATION*)
+87530 BEGIN
+87540 M := BALANCE(STRSTRONG);
+87550 IF BALFLAG OR (SRSTK[SRSEMP].SB^.SBDELAYS<>0) THEN LHOPBAL(M);
+87560 OPDSAVE(M)
+87570 END;
+87580 (**)
+87590 82: (*SR48B*)
+87600 (*FUNCTION: EXECUTED AFTER RIGHT HAND TERTIARY OF IDENTITY-RELTION*)
+87610 BEGIN
+87620 OPDSAVE(BALANCE(STRSTRONG));
+87630 IF SRSTK[SRSEMP].SB^.SBBALSTR=STRNONE THEN SB := SRSTK[SRSEMP-2].SB
+87640 ELSE SB := SRSTK[SRSUBP-1].SB;
+87650 (*SB IS RESULT OF BALANCING LHS*)
+87660 M := BALMOIDS(SRSTK[SRSEMP].SB^.SBMODE, SB^.SBMODE);
+87670 WITH SRSTK[SRSEMP].SB^ DO
+87680 IF SBBALSTR>M1COERC THEN M1COERC := SBBALSTR;
+87690 WITH SB^ DO
+87700 IF SBBALSTR>M2COERC THEN M2COERC := SBBALSTR;
+87710 IF (M1COERC>STRSOFT) AND (M2COERC>STRSOFT) THEN SEMERR(ESE+26)
+87720 ELSE IF M^.MDV.MDID<>MDIDREF THEN MODERR(M, ESE+57);
+87730 LHFIRM := NIL; (*SO THAT PUTMD AND BALOPR DO NOT THINK IT IS MONADIC*)
+87740 PUTMD(M, M);
+87750 BALOPR;
+87760 CGOPR(PIDTYREL+SRPLSTK[PLSTKP+1]^.LXV.LXP, MDBOOL, TRUE);
+87770 DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1;
+87780 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF+[SBMORF,SBVOIDWARN]
+87790 END;
+87800 (**)
+87810 (**)
+87820 83: (*SR49A*)
+87830 (*FUNCTION: EXECUTED AFTER DESTINATION OF ASSIGNATION.*)
+87840 BEGIN M := SOFT;
+87850 WITH M^ DO
+87860 BEGIN
+87870 IF MDV.MDID<>MDIDREF THEN
+87880 BEGIN MODERR(M, ESE+20); SRSTK[SRSEMP].SB^.SBMODE := MDREFERROR; SCPUSH(MDERROR) END
+87890 ELSE SCPUSH(MDPRRMD);
+87900 CGDEST;
+87910 END
+87920 END;
+87930 (**)
+87940 (**)
+87950 84: (*SR49B*)
+87960 (*FUNCTION: EXECUTED AFTER SOURCE OF ASSIGNATION.*)
+87970 BEGIN
+87980 STRONG; CGASSIGN; DISPOSE(SRSTK[SRSEMP].SB);SRSEMP := SRSEMP-1;
+87990 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF,SBVOIDWARN]
+88000 END;
+88010 (**)
+88020 85: (*SR50*)
+88030 (*FUNCTION: EXECUTED AFTER PRIMARY OF SLICE*)
+88040 BEGIN M:= WEAK;
+88050 WITH M^ DO IF MDV.MDID=MDIDREF THEN M := MDPRRMD;
+88060 WITH M^ DO
+88070 IF M=MDSTRNG THEN BEGIN FLDM := COERCE(M); ROWCOUNT := 1 END
+88080 ELSE IF MDV.MDID=MDIDROW THEN ROWCOUNT:=MDV.MDCNT
+88090 ELSE BEGIN MODERR(M, ESE+47); ROWCOUNT := 63 (*MAX CNTR*) END;
+88100 SBB := MAKESUBSTACK(1, M);
+88110 WITH SBB^ DO
+88120 BEGIN
+88130 SBTRIMCNT := ROWCOUNT; SBSLICEDIM := ROWCOUNT; SBPRIMDIM := ROWCOUNT;
+88140 SBTRIMS := NIL; SBUNITS := 0 END;
+88150 CGFIRM;
+88160 SEMANTICROUTINE(86) (*SR51*)
+88170 END;
+88180 (**)
+88190 86: (*SR51*)
+88200 (*FUNCTION: EXECUTED AT START OF NEW TRIMSCRIPT*)
+88210 BEGIN
+88220 SB := SRSTK[SRSUBP-1].SB;
+88230 WITH SB^ DO
+88240 BEGIN
+88250 IF SBTRIMCNT=0 THEN SEMERR(ESE+48); (*TOO MANY TRIMSCRIPTS*)
+88260 SBTRIMCNT := SBTRIMCNT-1;
+88270 NEW(PTR); WITH PTR^ DO BEGIN LINK := SBTRIMS; TRTYPE := 0 END;
+88280 SBTRIMS := PTR
+88290 END
+88300 END;
+88310 (**)
+88320 87: (*SR52*)
+88330 (*FUNCTION: EXECUTED AFTER LOWER-BOUND OF TRIMMER*)
+88340 WITH SRSTK[SRSUBP-1].SB^ DO
+88350 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+4 END;
+88360 (**)
+88370 88: (*SR53*)
+88380 (*FUNCTION: EXECUTED AFTER UPPER-BOUND OF TRIMMER*)
+88390 WITH SRSTK[SRSUBP-1].SB^ DO
+88400 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+2 END;
+88410 (**)
+88420 89: (*SR54A*)
+88430 (*FUNCTION: EXECUTED BEFORE UNIT IN REVISED-LOWER-BOUND*)
+88440 IF SRSTK[SRSUBP-1].SB^.SBMODE=MDSTRNG THEN SEMERR(ESE+32);
+88450 (**)
+88460 90: (*SR54B*)
+88470 (*FUNCTION: EXECUTED AFTER REVISED-LOWER-BOUND OF TRIMMER*)
+88480 BEGIN
+88490 MEEKLOAD(MDINT, ESE+50);
+88494 WITH SRSTK[SRSUBP-1].SB^ DO
+88500 BEGIN SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+1 END;
+88510 END;
+88520 (**)
+88530 (*+53()
+88540 END END ;
+88550 PROCEDURE MONITOR3;
+88560 VAR I: INTEGER;
+88570 BEGIN
+88580 (*+21() MONITORSEMANTIC(SRTN); ()+21*)
+88590 CASE SRTN OF
+88600 ()+53*)
+88610 91: (*SR55*)
+88620 (*FUNCTION: EXECUTED WHEN DEFAULT TRIMMER IS ENCOUNTERED.
+88630 A DEFAULT TRIMMER CONSISTS OF A COLON (NO UMITS) *)
+88640 WITH SRSTK[SRSUBP-1].SB^.SBTRIMS^ DO TRTYPE := TRTYPE+8;
+88650 (**)
+88660 92: (*SR56*)
+88670 (*FUNCTION: EXECUTED AFTER SUBSCRIPT*)
+88672 BEGIN
+88674 IF BALFLAG THEN I := SRSTK[SRSUBP].SUBP ELSE I := SRSUBP;
+88680 WITH SRSTK[I-1].SB^ DO
+88690 BEGIN
+88700 IF (SBSLICEDIM=1) AND (SBPRIMDIM<3) THEN WITH SRSTK[I+1].SB^ DO
+88710 SBINF := SBINF-[SBSTKDELAY]; (*TO SAVE UNNECESSARY STACKING*)
+88720 MEEKLOAD(MDINT, ESE+51);
+88730 SBSLICEDIM := SBSLICEDIM-1;
+88740 SBUNITS := SBUNITS+1; WITH SBTRIMS^ DO TRTYPE := TRTYPE+9
+88750 END;
+88752 END;
+88760 (**)
+88770 93: (*SR57*)
+88780 (*FUNCTION: EXECUTED AFTER SLICE*)
+88790 BEGIN
+88800 SB := SRSTK[SRSUBP-1].SB;
+88810 WITH SB^ DO
+88820 BEGIN
+88830 M := SRSTK[SRSUBP+1].SB^.SBMODE;
+88840 IF SBTRIMCNT>0 THEN MODERR(M, ESE+49); (*TOO FEW TRIMSCRIPTS*)
+88850 WITH M^ DO
+88860 BEGIN REFED := MDV.MDID=MDIDREF; IF REFED THEN M := MDPRRMD END;
+88870 WITH M^ DO
+88880 IF MDV.MDID=MDIDROW THEN
+88890 BEGIN M := FINDROW(MDPRRMD, SBSLICEDIM);
+88900 IF REFED THEN M := FINDREF(M)
+88910 END
+88920 ELSE IF SBSLICEDIM=0 THEN
+88930 M := MDCHAR;
+88940 CGSLICE(SB, REFED);
+88950 POPUNITS;
+88960 SBMODE := M; SBINF := SBINF+[SBMORF,SBVOIDWARN];
+88970 END
+88980 END;
+88990 (**)
+89000 (**)
+89010 (**)
+89020 (**)
+89030 94: (*SR58*)
+89040 (*FUNCTION: EXECUTED AFTER LOWER-BOUND OF TRIMMER OR ACTUAL-ROWER.*)
+89050 MEEKLOAD(MDINT, ESE+52);
+89060 (**)
+89070 95: (*SR59*)
+89080 (*FUNCTION: EXECUTED AFTER UPPER-BOUND OF TRIMMER OR ACTUAL-ROWER.*)
+89090 MEEKLOAD(MDINT, ESE+53);
+89100 (**)
+89110 96: (*SR60*)
+89120 (*FUNCTION: EXECUTED AFTER ALL BUT LAST ACTUAL-PARAMETER IN ACTUAL-PARAMETER-LIST.*)
+89130 BEGIN STRONG;
+89140 CGFIRM;
+89150 PARMSC
+89160 END;
+89170 (**)
+89180 97: (*SR61*)
+89190 (*FUNCTION: EXECUTED AFTER A CALL*)
+89200 BEGIN
+89210 STRONG;
+89220 SB := SRSTK[SRSUBP+1].SB;
+89230 WITH SB^.SBMODE^ DO
+89240 BEGIN
+89250 (*+01() IF (MDV.MDID=MDIDPASC) AND (SB^.SBCNT<3) THEN
+89260 BEGIN
+89270 IF SB^.SBCNT>1 THEN WITH SRSTK[SRSEMP-1].SB^ DO SBINF := SBINF-[SBSTKDELAY];
+89280 GETTOTAL(SRSTK[SRSEMP].SB)
+89290 END
+89300 ELSE
+89310 ()+01*)
+89320 CGFIRM;
+89330 IF SB^.SBCNT<SB^.SBMODE^.MDV.MDCNT THEN SEMERR(ESE+72);
+89340 SBB := SRSTK[SRSUBP-1].SB; (*FOR RESULT*)
+89350 IF MDV.MDID=MDIDPROC THEN CGCALL(SB, SBB)
+89360 ELSE (*MDV.MDID=MDIDPASC*) CGPASC(SB, SBB);
+89370 IF SBB^.SBMODE=MDVOID THEN FILL(SBTVOID, SBB);
+89380 POPUNITS;
+89390 UNSTACKSB;
+89400 WITH ROUTNL^ DO RNLOCRG := RNLOCRG-1;
+89410 RGINFO := RGINFO-[DCLLOCRNG];
+89420 SB := PUSHSB(MDVOID); (*RANGEXT EXPECTS SBB FOR ITS YIELD*)
+89430 RANGEXT; (*FROM PARAMETERS RANGE*)
+89440 UNSTACKSB; DISPOSE(SRSTK[SRSEMP].SB);SRSEMP := SRSEMP-1;
+89450 STACKSB(SBB);
+89460 SBB^.SBINF := SBB^.SBINF+[SBMORF]-[SBVOIDWARN]
+89470 END
+89480 END;
+89490 (**)
+89500 98: (*SR62*)
+89510 (*FUNCTION: EXECUTED AFTER LEAP-GENERATOR.*)
+89520 BEGIN
+89530 M := SRPOPMD;
+89540 IF M^.MDV.MDID=MDIDROW THEN
+89550 SRSTK[SRSEMP].SB^.SBMODE := FINDREF(M)
+89560 ELSE BEGIN SB := PUSHSB(FINDREF(M)); UNSTACKSB END;
+89570 IF SRPLSTK[PLSTKP+1]^.LXV.LXIO=LXIOLOC THEN
+89580 BEGIN
+89590 RGINFO := RGINFO+[DCLLOCGEN];
+89600 CGLEAPGEN(FALSE)
+89610 END
+89620 ELSE CGLEAPGEN(TRUE);
+89630 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF+[SBMORF,SBVOIDWARN]
+89640 END;
+89650 (**)
+89660 99: (*SR63A*)
+89670 (*FUNCTION: EXECUTED AT THE BEGINNING OF ROUTINE-TEXT WITH A NON-EMPTY
+89680 FORMAL-DECLARATIVE-PACK-OPTION.
+89690 *)
+89700 BEGIN
+89710 ROUTNNT;
+89720 CGRTA;
+89730 SUBSAVE
+89740 END;
+89750 (**)
+89760 100: (*SR63B*)
+89770 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN A ROUTINE-TEXT.
+89780 SAVES THE MODE OF THE ROUTINE-TEXT AND ESTABLISHES THE MODE OF THE
+89790 STRONG CONTEXT OF THE UNIT WHICH FOLLOWS.
+89800 *)
+89810 BEGIN
+89820 ROUTNL^.RNPARAMS:=CURID;
+89830 STB1:=DCIL;
+89840 WHILE STB1<>NIL DO
+89850 WITH ROUTNL^ ,STB1^ DO
+89860 BEGIN
+89870 IF STBLKTYP=STBDEFID THEN
+89880 BEGIN
+89890 STOFFSET := STOFFSET -PARAMOFFSET -RNPARAMS;
+89910 CGPARM(STB1);
+89920 END;
+89930 STB1:=STTHREAD
+89940 END;
+89950 CURID:=0;I:=ALLOC(SIZIBBASE+SIZLEBBASE);
+89960 CGFLINE;
+89970 SCPUSH(SRSTK[SRSEMP].MD^.MDPRRMD);
+89980 ROUTNL^.RNMODE := SRPOPMD
+89990 END;
+90000 (**)
+90010 101: (*SR63C*)
+90020 (*FUNCTION: EXECUTED AFTER ROUTINE-TEXT.*)
+90030 BEGIN
+90040 STRONG;
+90050 RANGEXT;
+90060 CGRTB;
+90070 (*CURRENTLY, SRSTK[SRSEMP].SB REPRESENTS THE FINAL UNIT OF THE ROUTINE-TEXT, AND ITS
+90080 YIELD SITS UPON THE CONCEPTUAL RTSTACK. NOW, SRSTK[SRSEMP].SB IS MODIFIED TO REPRESENT
+90090 THE ROUTINE-TEXT ITSELF.
+90100 *)
+90102 WITH SRSTK[SRSEMP] DO WITH SB^, ROUTNL^ DO
+90104 BEGIN
+90110 IF ((RGSTATE MOD 16)=0) OR (STVAR IN DCLDEFN) THEN (*ANONYMOUS ROUTINE*) RNLEX := NIL
+90120 ELSE WITH DCIL^ DO
+90130 IF STBLKTYP=STBDEFOP THEN RNLEX := STLEX^.LINK
+90140 ELSE RNLEX := STLEX;
+90142 CGRTC;
+90150 UNSTACKSB;
+90180 SBMODE := RNMODE; SBINF := SBINF+[SBMORF,SBVOIDWARN];
+90190 IF (RNNONIC=1) OR (RGLEV=2) THEN
+90200 BEGIN
+90210 SBXPTR := RNPROCBLK;
+90220 SBLEVEL:=RNNECLEV;
+90230 SBOFFSET:=0;
+90240 SBLEN := SZADDR;
+90250 SBTYP:=SBTPROC;
+90260 ROUTNXT;
+90270 STACKSB(SB);
+90280 (*-05()(*-02()ASSIGNFLAD; ()-02*) ()-05*)
+90290 END
+90300 ELSE
+90310 BEGIN
+90320 ROUTNXT;
+90330 CGRTD(RNPROCBLK);
+90340 END
+90350 END
+90360 END;
+90370 (**)
+90380 102: (*SR65A*)
+90390 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN ROUTINE-IDENTITY-DEFINITION.*)
+90400 BEGIN DEFID(SRPLSTK[PLSTKP]); SRSEMP := SRSEMP+1; SRSTK[SRSEMP].STB := DCIL END;
+90410 (**)
+90420 103: (*SR65B*)
+90430 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN ROUTINE-VARIABLE-DEFINITION.*)
+90440 BEGIN DCLDEFN := [STVAR,STINIT]; SEMANTICROUTINE(102) (*SR65A*) END;
+90450 (**)
+90460 104: (*SR65C*)
+90470 (*FUNCTION: EXECUTED AFTER DEFINING-OPERATOR IN ROUTINE-OPERATION-DEFINITION*)
+90480 BEGIN DEFOP(SRPLSTK[PLSTKP]); SRSEMP := SRSEMP+1; SRSTK[SRSEMP].STB := DCIL END;
+90490 (**)
+90500 105: (*SR66A*)
+90510 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN ROUTINE-IDENTITY-DEFINITION
+90520 OR ROUTINE-VARIABLE-DEFINITION.*)
+90530 BEGIN
+90540 SEMANTICROUTINE(100) (*SR63B*);
+90550 STB1 := SRSTK[SRSEMP].STB; SRSEMP := SRSEMP-1;
+90560 WITH STB1^ DO
+90570 IF STMODE=MDROUT THEN
+90580 BEGIN
+90590 IF RGLEV=3 THEN
+90600 BEGIN
+90610 STPTR := ROUTNL^.RNPROCBLK ;
+90620 STLEVEL :=0 ; STDEFTYP := STDEFTYP+[STRCONST,STCONST];
+90630 END;
+90640 STMODE := ROUTNL^.RNMODE
+90650 END
+90660 ELSE STMODE := FINDREF(ROUTNL^.RNMODE)
+90670 END;
+90680 (**)
+90690 106: (*SR66C*)
+90700 (*FUNCTION: EXECUTED AFTER ROUTINE-SPECIFICATION IN ROUTINE-OPERATION-DEFINITION*)
+90710 BEGIN
+90720 SEMANTICROUTINE(100) (*SR63B*);
+90730 STB1 := SRSTK[SRSEMP].STB; SRSEMP := SRSEMP-1;
+90740 DEFOPM(STB1, ROUTNL^.RNMODE)
+90750 END;
+90760 (**)
+90770 107: (*SR67A*)
+90780 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN A VARIABLE-DEFINITION WHICH HAS NO INITIALIZING UNIT.*)
+90790 BEGIN DCLDEFN := [STVAR]; DEFID(SRPLSTK[PLSTKP]) END;
+90800 (**)
+90810 108: (*SR67B*)
+90820 (*FUNCTION: EXECUTED AFTER DEFINING-IDENTIFIER IN AN IDENTITY-DEFINITION OR A VARIABLE-DEFINITION
+90830 WHICH INCLUDES AN INITIALIZING UNIT. ENTERS THE IDENTIFIER IN THE SYMBOL TABLE AND
+90840 ESTABLISHES THE MODE OF THE STRONG CONTEXT OF THE UNIT WHICH FOLLOWS.
+90850 *)
+90860 BEGIN SCPUSH(DCLMODE); DCLDEFN := DCLDEFN+[STINIT]; DEFID(SRPLSTK[PLSTKP]) END;
+90870 (**)
+90880 109: (*SR67C*)
+90890 (*FUNCTION: EXECUTED AFTER THE DEFINING-OPERATOR IN AN OPERATION-DEFINITION*)
+90900 BEGIN
+90910 SCPUSH(DCLMODE);
+90920 DEFOP(SRPLSTK[PLSTKP]);
+90930 DEFOPM(DCIL, DCLMODE)
+90940 END;
+90950 (**)
+90960 110: (*SR68A*)
+90970 (*FUNCTION: EXECUTED AFTER UNIT IN IDENTITY- OR VARIABLE-DEFINITION*)
+90980 BEGIN STRONG;
+90990 WITH SRSTK[SRSEMP].SB^ DO
+91000 IF NOT(STVAR IN DCLDEFN) AND
+91010 ((SBTYP=SBTDEN) AND NOT(STUSED IN DCIL^.STDEFTYP)
+91020 OR ((SBTYP=SBTPROC) AND (NOT(STUSED IN DCIL^.STDEFTYP) OR (ROUTNL^.RNLEVEL=0))))
+91030 THEN
+91040 DISALLOCIND
+91050 ELSE CGFIRM;
+91060 END;
+91070 (**)
+91080 111: (*SR68B*)
+91090 (*FUNCTION: EXECUTED AFTER ROUTINE-TEXT IN ROUTINE-IDENTITY,
+91100 -VARIABLE OR -OPERATION DEFINITION.
+91110 *)
+91120 WITH SRSTK[SRSEMP].SB^ DO
+91130 IF NOT(STVAR IN DCLDEFN) AND ((SBTYP=SBTPROC) AND (NOT(STUSED IN DCIL^.STDEFTYP) OR (RGLEV=2)))
+91140 THEN
+91150 DISALLOCIND
+91160 ELSE CGFIRM;
+91170 (**)
+91180 112: (*SR69*)
+91190 (*FUNCTION: EXECUTED AFTER A DECLARATION-LIST.*)
+91200 BEGIN
+91210 BRKASCR;CGFIXRG;
+91220 END;
+91230 (**)
+91240 113: (*SR70*)
+91250 (*FUNCTION: EXECUTED AFTER FIRST UNIT OF COLLATERAL-CLAUSE*)
+91260 BEGIN
+91270 RGINFO := RGINFO+[DCLCOLL];
+91280 (*FINDTOPCOLL*)
+91290 J := PLSTKP+2;
+91300 R := RANGEL;
+91310 WHILE (SRPLSTK[J]=LEXBEGIN) OR (SRPLSTK[J]=LEXOPEN) DO
+91320 BEGIN
+91330 J := J+1;
+91340 WITH R^ DO
+91350 BEGIN RGINF := RGINF+[DCLCOLL]; R := RGLINK END
+91360 END;
+91370 I := J-PLSTKP-1;
+91380 (*FINDCOLLM*)
+91390 M := SCL^.SCMODE;
+91400 WITH M^ DO
+91410 IF MDV.MDID=MDIDROW THEN
+91420 BEGIN
+91430 I := I-MDV.MDCNT;
+91440 IF I>0 THEN M := MDPRRMD
+91450 ELSE M := FINDROW(MDPRRMD, -I+1)
+91460 END;
+91470 WHILE I>0 DO WITH M^ DO
+91480 BEGIN
+91490 I := I-1;
+91500 IF MDV.MDID<>MDIDSTRUCT THEN SEMERR(ESE+60)
+91510 ELSE IF I>0 THEN M := MDSTRFLDS[0].MDSTRFMD
+91520 END;
+91530 NEW(SB);
+91540 WITH SB^ DO
+91550 BEGIN SBMODE := M; SBLEVEL := 0; SBDELAYS := 0; SBTYP := SBTVOID; SBINF := [SBCOLL] END;
+91560 COLLSC(SB); STRONG;
+91570 (*AT THIS POINT, THERE IS AN UNWANTED SUBSTACK MARKER AS SRSEMP-1, PUT THERE
+91580 BY S-34. WE SHALL INSERT SB BELOW IT*)
+91590 SRSTK[SRSEMP+1].SB := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP+1;
+91600 SRSTK[SRSUBP+1].SUBP := SRSTK[SRSUBP].SUBP; SRSUBP := SRSUBP+1;
+91610 SRSTK[SRSUBP-1].SB := SB;
+91620 IF NOT (DCLCOLL IN R^.RGINF) OR (SRPLSTK[J]^.LXV.LXIO<>LXIOUNLC) THEN CGLEFTCOLL(SB);
+91630 CGCOLLUNIT;
+91640 COLLSC(SB)
+91650 END;
+91660 (**)
+91670 114: (*SR71*)
+91680 (*FUNCTION: EXECUTED AFTER MIDDLE UNITS OF COLLATERAL-CLAUSE*)
+91690 BEGIN STRONG; CGCOLLUNIT; COLLSC(SRSTK[SRSUBP-1].SB) END;
+91700 (**)
+91710 115: (*SR72*)
+91720 (*FUNCTION: EXECUTED AFTER LAST UNIT OF COLLATERAL-CLAUSE*)
+91730 BEGIN
+91740 STRONG;
+91750 CGCOLLUNIT;
+91760 WITH SRSTK[SRSUBP-1].SB^ DO WITH SBMODE^ DO
+91770 IF MDV.MDID=MDIDSTRUCT THEN
+91780 IF MDV.MDCNT>SBLEVEL THEN SEMERR(ESE+58);
+91790 J := PLSTKP+2; I := 0;
+91800 WHILE (SRPLSTK[J]=LEXBEGIN) OR (SRPLSTK[J]=LEXOPEN) OR (SRPLSTK[J]^.LXV.LXIO=LXIOUNLC) DO
+91810 BEGIN I := I+ORD(SRPLSTK[J]^.LXV.LXIO<>LXIOUNLC); J := J+1 END;
+91820 CGFINCOLL(I);
+91830 END;
+91840 (**)
+91850 116: (*SR73*)
+91860 (*FUNCTION: EXECUTED AFTER MOID-DECLARER OF CAST*)
+91870 SCPUSH(SRPOPMD);
+91880 (**)
+91890 117: (*SR74*)
+91900 (*FUNCTION: EXECUTED AFTER A PRIORITY-DEFINITION*)
+91910 BEGIN DEFPRIO(SRPLSTK[PLSTKP+1], SRPLSTK[PLSTKP]) END;
+91920 (**)
+91930 118: (*SR80*)
+91940 BEGIN
+91950 SEMANTICROUTINE(62) (*SR29*);
+91960 DEFLAB(LEXLSTOP);
+91970 STB1 := DCIL;
+91980 WHILE STB1<>NIL DO WITH STB1^ DO
+91990 BEGIN
+92000 IF STBLKTYP=STBAPPLAB THEN SEMERRP(ESE+38, STLEX);
+92010 STB1 := STTHREAD
+92020 END;
+92030 SBB := PUSHSB(MDVOID);(*RANGEXT EXPECTS IT*)
+92040 RANGEXT;
+92050 CGEND;
+92060 ROUTNXT
+92070 END;
+92080 (**)
+92090 119: (*SR81*)
+92100 (*FUNCTION: EXECUTED AFTER SYNTACTIC ERROR, BEFORE START OF IGNORED SYMBOLS*)
+92110 BEGIN
+92120 ERRCHAR := '=';
+92130 END;
+92140 (**)
+92150 120: (*SR00*)
+92160 BEGIN
+92170 I := CURID;
+92180 ROUTNNT;
+92190 CURID := I;
+92200 ROUTNL^.RNLEVEL := 0;
+92210 ROUTNL^.RNLENIDS := CURID;
+92220 CGINIT;
+92230 CGFLINE
+92240 END;
+92250 (**)
+92252 121: (*FINISH*) (*INVOKED: AFTER END OF PROGRAM TO INDICATE TO THE PARSER THAT
+92254 ITS JOB IS DONE*)
+92256 ENDOFPROG := TRUE;
+92260 END
+92270 END
+92280 (*+53()
+92290 ; BEGIN
+92300 IF (SRTN>120) OR (SRTN<61) THEN MONITOR1
+92310 ELSE IF SRTN<91 THEN MONITOR2
+92320 ELSE MONITOR3
+92330 ()+53*)
+92340 END;
+92350 (**)
+92360 ()+83*)
--- /dev/null
+60000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+60010 (**)
+60020 (**)
+60030 (*+86()
+60031 (************************************)
+60032 (* EM-1 VERSION *)
+60033 (************************************)
+60034 (**)
+60035 (************************************)
+60036 (* MEANING OF PARAMTYPES *)
+60037 (************************************)
+60038 (**)
+60040 (* WOP - OPERAND SUPPLIED BY CODETABLE
+60042 WNP - NEGATIVE OF OPERAND SUPPLIED BY CODETABLE
+60043 WLB - OPERAND SUPPLIED BY CODETABLE IS A GLOBAL LABEL OFFSET
+60044 OPX - OPERAND SUPPLIED BY CODE GENERATOR
+60046 ONX - NEGATIVE OF OPERAND SUPPLIED BY CODE GENERATOR
+60048 OPL - OPERAND SUPPLIED BY CODE GENERATOR IS A GLOBAL LABEL OFFSET
+60049 ONL - NEGATIVE OF ABOVE
+60050 LCX - LOCAL INSTRUCTION LABEL
+60052 GBX - GLOBAL DATA LABEL
+60054 NON - NO OPERAND
+60056 JMP - FORWARD JUMP WITHIN CODETABLE
+60058 ACP - AS WOP, BUT PROVIDES LAST OPERAND FOR AN OCODE
+60059 ACB - AS WLB, BUT DITTO
+60060 ANP - AS WNP, BUT DITTO
+60062 ACX - AS OPX, BUT DITTO
+60064 ANX - AS ONX, BUT DITTO
+60066 ACL - AS OPL, BUT DITTO
+60067 ANL - AS ONL, BUT DITTO
+60068 MOR - LONG OPERAND IN PARAM SUPPLIED BY CODETABLE
+60072 *)
+60080 PROCEDURE INITCODES;
+60090 (* INITIALISES CODETABLE *)
+60100 CONST
+60310 (* EXTRA P-OPS AND CODETABLE ENTRIES *)
+60320 PPUSH1(*3*)=200; PPUSHFTN(*3*)=203; PS4TOS2=206; PPUSHIM2(*2*)=207; PPUSH2(*3*)=209; PSTOS2=212; PPUSHIM4(*2*)=213;
+60328 PLOADRTA(*3*)=215; PPUSHI2A=218;
+60330 QDCLINIT(*5*)=219; QCOLLTOTAL(*8*)=224; QSELECT=232; QEQ=233; QGE=234; QGT=235;
+60340 QRANGENT=238; QLOADRTA=239; QLE=240; QLT=241; QNE=242;
+60350 QNOTB=243; QODD=244; QCAS=245; QSCOPENT=246; QLEBT=247;
+60360 QCFSTRNG=248; QVOIDNM(*5*)=249; QDCLSP(*6*)=254; QOUTJUMP(*4*)=260; QWIDEN(*2*)=264;
+60370 QELMBT=266; QRANGEXT(*2*)=267; QASGVART(*2*)=269; QASSIGNT(*2*)=271; QPASC(*2*)=273;
+60376 QLOOPINCR(*5*)=275; QPUSH2=280; QPUSHIM4(*2*)=281; QGETPROC(*2*)=283; QABSI(*6*)=285;
+60380 QDUP2ND(*2*)=291; QDUP2PILE=293; (*SPARE(2)=294;*) QCALLA(*4*)=296; QHOIST(*2*)=300; QLOADVAR(*5*)=302;
+60382 QLPINIT(*4*)=307; QSCOPEVAR(*5*)=311; QSETIB(*3*)=316; QRNSTART(*2*)=319;
+60384 (*321-350 SPARE*)
+60390 ST=SBTSTK; STP=SBTSTK; STS=SBTSTK;
+60400 ST2=SBTSTK2; S2P=SBTSTK2; S2S=SBTSTK2;
+60410 ST4=SBTSTK4; S4P=SBTSTK4; S4S=SBTSTK4;
+60420 STN=SBTSTKN; SNP=SBTSTKN; SNS=SBTSTKN;
+60430 PR1=SBTPR1; PR2=SBTPR2; PRR=SBTPRR;
+60440 O=SBTVOID; DLS=SBTDL;
+60445 SRE=SBTSTK4;SP=(*+19()SBTSTK2()+19*)(*-19()SBTSTK()-19*);
+60450 (**)
+60460 PROCEDURE ICODE(OPCOD:POP;EMCODE:COMPACT;TYP:PARAMTYPES;PM:INTEGER;PNXT:POP;VP1,VP2,VPR:SBTTYP);
+60470 BEGIN
+60480 WITH CODETABLE[OPCOD] DO
+60490 BEGIN
+60500 INLINE := TRUE;
+60510 EMCOD := EMCODE;
+60520 P1 := VP1;
+60530 P2 := VP2;
+60540 PR := VPR;
+60550 NEXT := PNXT;
+60560 PARTYP := TYP;
+60570 CASE TYP OF
+60580 LCX,GBX,WLB,ACB,OPX,ONX,ACX,ANX,OPL,ONL,ACL,ANL,NON:PARM := PM;
+60590 WOP,ACP,JMP: PARM := PM;
+60595 WNP,ANP: PARM := -PM;
+60596 MOR: PARM:=PM;
+60600 END;
+60610 END;
+60620 END;
+60630 (*+)
+60640 PROCEDURE QCODE(OPCOD:POP;EMCODE:COMPACT;TYP:PARAMTYPES;PM:INTEGER;PNXT:POP);
+60650 BEGIN
+60660 ICODE(OPCOD,EMCODE,TYP,PM,PNXT,O,O,O);
+60670 END;
+60680 (*+)
+60690 PROCEDURE OCODE(OPCOD:POP;PROUTINE:ALFA;VP1,VP2,VPR:SBTTYP);
+60700 VAR I:INTEGER;
+60710 BEGIN
+60720 WITH CODETABLE[OPCOD] DO
+60730 BEGIN
+60740 INLINE := FALSE;
+60750 P1 := VP1;
+60760 P2 := VP2;
+60770 PR := VPR;
+60780 IF (P1=O) AND (P2 <> O) THEN WRITELN(LSTFILE,'FAILED OCODE-A');
+60790 FOR I := 1 TO RTNLENGTH DO ROUTINE[I] := PROUTINE[I];
+60800 END;
+60810 END;
+60820 PROCEDURE FIRSTPART;
+60830 VAR I:INTEGER;
+60840 BEGIN
+60850 FOR I := PNONE TO PLAST DO OCODE(I,'DUMMY ',O,O,O);
+60860 OCODE(PPEND , 'STOP68 ' , O , O , O );
+60864 OCODE(PPBEGIN , 'ESTART0 ' , O , O , O );
+60870 OCODE(PPBEGIN+1 , 'START68 ' , O , O , O );
+60880 ICODE(PABSI , DUP , WOP , SZINT ,QABSI ,ST , O ,ST );
+60890 QCODE(QABSI , ZGE , JMP , 2 ,QABSI+1 );
+60900 QCODE(QABSI+1 , NGI , WOP , SZINT ,0 );
+60910 ICODE(PABSI-2 , DUP , WOP , SZREAL ,QABSI+2,SRE, O ,SRE);
+60920 OCODE(PABSI-4 , 'CABSI ' ,PR1, O ,PRR);
+60924 QCODE(QABSI+2 , ZRF , WOP , SZREAL ,QABSI+3 );
+60930 QCODE(QABSI+3 , CMF , WOP , SZREAL ,QABSI+4 );
+60940 QCODE(QABSI+4 , ZGE , JMP , 2 ,QABSI+5 );
+60950 QCODE(QABSI+5 , NGF , WOP , SZREAL ,0 );
+60960 ICODE(PABSB , NOP , NON , 0 ,0 ,ST , O ,ST );
+60970 ICODE(PABSB-1 , NOP , NON , 0 ,0 ,ST , O ,ST );
+60980 ICODE(PABSCH , NOP , NON , 0 ,0 ,ST , O ,ST );
+60990 ICODE(PADD , ADI , WOP , SZINT ,0 ,ST ,ST ,ST );
+61020 ICODE(PADD-2 , ADF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+61040 OCODE(PADD-4 , 'CPLUS ' ,PR1,PR2,PRR);
+61050 ICODE(PANDB , CAND , WOP , SZWORD ,0 ,ST ,ST ,ST );
+61060 ICODE(PANDB-1 , CAND , WOP , SZINT ,0 ,ST ,ST ,ST );
+61070 OCODE(PARG , 'CARG ' ,PR1,O ,PRR);
+61080 ICODE(PBIN , NOP , NON , 0 ,0 ,ST , O ,ST );
+61090 OCODE(PCAT , 'CATCC ' ,PR1,PR2,PRR);
+61100 OCODE(PCAT-1 , 'CATSS ' ,PR1,PR2,PRR);
+61110 OCODE(PCONJ , 'CCONJ ' ,PR1,O ,PRR);
+61120 OCODE(PDIV , 'DIV ' ,PR1,PR2,PRR);
+61130 ICODE(PDIV-2 , DVF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+61140 OCODE(PDIV-4 , 'CDIV ' ,PR1,PR2,PRR);
+61150 ICODE(PDIVAB , DVF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+61160 OCODE(PDIVAB-2 , 'CDIVAB ' ,PR1,PR2,PRR);
+61170 ICODE(PELMBT , EXG , WOP , SZINT ,QELMBT , ST, ST, ST);
+61180 QCODE(QELMBT , ROL , WOP , SZINT ,PODD );
+61210 OCODE(PELMBY , 'ELMBY ' ,PR1,PR2,PRR);
+61220 OCODE(PENTI , 'ENTIER ' ,PR1, O ,PRR);
+61230 ICODE(PEQ , CMI , WOP , SZINT ,QEQ ,ST ,ST ,ST );
+61240 QCODE(QEQ , TEQ , NON , 0 ,0 );
+61250 ICODE(PEQ-2 , CMF , WOP , SZREAL ,QEQ ,SRE,SRE,ST );
+61260 OCODE(PEQ-4 , 'CEQ ' ,PR1,PR2,PRR);
+61270 ICODE(PEQB , CMI , WOP , SZINT ,QEQ ,ST ,ST ,ST );
+61280 ICODE(PEQB-1 , CMI , WOP , SZWORD ,QEQ ,ST ,ST ,ST );
+61290 ICODE(PEQB-2 , CMI , WOP , SZWORD ,QEQ ,ST ,ST ,ST );
+61300 ICODE(PEQCS , CMI , WOP , SZINT ,QEQ ,ST ,ST ,ST );
+61310 ICODE(PEQCS-1 , LOC , ACP , 2 ,QCFSTRNG ,PR1,PR2,PRR);
+61320 OCODE(QCFSTRNG , 'CFSTR ' , O , O , O );
+61330 OCODE(PEXP , 'POWI ' ,PR1,PR2,PRR);
+61340 OCODE(PEXP-2 , 'POWR ' ,PR1,PR2,PRR);
+61350 OCODE(PEXP-4 , 'CPOW ' ,PR1,PR2,PRR);
+61355 ICODE(PPASC , LFC , WOP , 0 ,QPASC ,DLS, O ,PRR);
+61357 QCODE(QPASC , LXL , WOP , 0 ,QPASC+1 );
+61360 QCODE(QPASC+1 , CAL , OPX , 0 ,0 );
+61370 ICODE(PPASC+1 , LXL , WOP , 0 ,QPASC+1 ,PR1, O ,PRR);
+61380 ICODE(PPASC+2 , CAL , OPX , 0 ,0 ,PR1,PR2,PRR);
+61390 OCODE(PPASC+3 , 'PASC ' ,PR1,PR2,PRR);
+61395 ICODE(PASP , ASP , OPX , 0 ,0 , O , O , O );
+61400 ICODE(PENVCHAIN , LXL , OPX , 0 ,0 , O , O , O );
+61410 ICODE(PENVCHAIN+1, LXA , OPX , 0 ,0 , O , O , O );
+61420 ICODE(PGE , CMI , WOP , SZINT ,QGE ,ST ,ST ,ST );
+61430 ICODE(PGE-2 , CMF , WOP , SZREAL ,QGE ,SRE,SRE,ST );
+61440 ICODE(PGEBT , EXG , WOP , SZINT ,PLEBT ,ST ,ST ,ST );
+61450 ICODE(PGEBT-1 , CMU , WOP , SZINT ,QGE ,ST ,ST ,ST );
+61460 ICODE(PGECS , CMI , WOP , SZINT ,QGE ,ST ,ST ,ST );
+61470 ICODE(PGECS-1 , LOC , ACP , 4 ,QCFSTRNG ,PR1,PR2,PRR);
+61480 QCODE(QGE , TGE , NON , 0 ,0 );
+61490 ICODE(PGT , CMI , WOP , SZINT ,QGT ,ST ,ST ,ST );
+61500 QCODE(QGT , TGT , NON , 0 ,0 );
+61510 ICODE(PGT-2 , CMF , WOP , SZREAL ,QGT ,SRE,SRE,ST );
+61520 ICODE(PGTBY , CMU , WOP , SZINT ,QGT ,ST ,ST ,ST );
+61530 ICODE(PGTCS , CMI , WOP , SZINT ,QGT ,ST ,ST ,ST );
+61540 ICODE(PGTCS-1 , LOC , ACP , 5 ,QCFSTRNG ,PR1,PR2,PRR);
+61550 OCODE(PIM , 'CIM ' ,PR1, O ,PRR);
+61560 ICODE(PLE , CMI , WOP , SZINT ,QLE ,ST ,ST ,ST );
+61570 QCODE(QLE , TLE , NON , 0 ,0 );
+61580 ICODE(PLE-2 , CMF , WOP , SZREAL ,QLE ,SRE,SRE,ST );
+61590 ICODE(PLEBT , COM , WOP , SZINT ,QLEBT ,ST ,ST ,ST );
+61592 QCODE(QLEBT , CAND , WOP , SZINT ,QEQ );
+61600 ICODE(PLEBT-1 , CMU , WOP , SZINT ,QLE ,ST ,ST ,ST );
+61610 ICODE(PLECS , CMI , WOP , SZINT ,QLE ,ST ,ST ,ST );
+61620 ICODE(PLECS-1 , LOC , ACP , 1 ,QCFSTRNG ,PR1,PR2,PRR);
+61680 ICODE(PLT , CMI , WOP , SZINT ,QLT ,ST ,ST ,ST );
+61690 QCODE(QLT , TLT , NON , 0 ,0 );
+61700 ICODE(PLT-2 , CMF , WOP , SZREAL ,QLT ,SRE,SRE,ST );
+61710 ICODE(PLTBY , CMU , WOP , SZINT ,QLT ,ST ,ST ,ST );
+61720 ICODE(PLTCS , CMI , WOP , SZINT ,QLT ,ST ,ST ,ST );
+61730 ICODE(PLTCS-1 , LOC , ACP , 0 ,QCFSTRNG ,PR1,PR2,PRR);
+61740 OCODE(PLWBMSTR , 'LWBMSTR ' ,PR1, O ,PRR);
+61750 OCODE(PLWBM , 'LWBM ' ,PR1, O ,PRR);
+61760 OCODE(PLWB , 'LWB ' ,PR1,PR2,PRR);
+61770 ICODE(PMINUSAB , SBI , WOP , SZINT ,0 ,ST ,ST ,ST );
+61780 ICODE(PMINUSAB-2 , SBF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+61790 OCODE(PMINUSAB-4 , 'CMINAB ' ,PR1,PR2,PRR);
+61800 OCODE(PMOD , 'MOD ' ,PR1,PR2,PRR);
+61810 OCODE(PMODAB , 'MOD ' ,PR1,PR2,PRR);
+61820 ICODE(PMUL , MLI , WOP , SZINT ,0 ,ST ,ST ,ST );
+61830 ICODE(PMUL-2 , MLF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+61870 OCODE(PMUL-4 , 'CTIMS ' ,PR1,PR2,PRR);
+61880 OCODE(PMULCI , 'MULCI ' ,PR1,PR2,PRR);
+61890 OCODE(PMULCI-1 , 'MULSI ' ,PR1,PR2,PRR);
+61900 OCODE(PMULIC , 'MULIC ' ,PR1,PR2,PRR);
+61910 OCODE(PMULIC-1 , 'MULIS ' ,PR1,PR2,PRR);
+61920 END;
+61930 PROCEDURE SECONDPART;
+61940 BEGIN
+61950 ICODE(PNE , CMI , WOP , SZINT ,QNE ,ST ,ST ,ST );
+61960 QCODE(QNE , TNE , NON , 0 ,0 );
+61970 ICODE(PNE-2 , CMF , WOP , SZREAL ,QNE ,SRE,SRE,ST );
+61980 OCODE(PNE-4 , 'CNE ' ,PR1,PR2,PRR);
+61990 ICODE(PNEGI , NGI , WOP , SZINT ,0 ,ST , O ,ST );
+62000 ICODE(PNEB , CMI , WOP , SZINT ,QNE ,ST ,ST ,ST );
+62010 ICODE(PNEB-1 , CMI , WOP , SZINT ,QNE ,ST ,ST ,ST );
+62020 ICODE(PNEB-2 , CMI , WOP , SZINT ,QNE ,ST ,ST ,ST );
+62030 ICODE(PNECS , CMI , WOP , SZINT ,QNE ,ST ,ST ,ST );
+62040 ICODE(PNECS-1 , LOC , ACP , 3 ,QCFSTRNG ,PR1,PR2,PRR);
+62050 ICODE(PNEGI-2 , NGF , WOP , SZREAL ,0 ,SRE, O ,SRE);
+62060 OCODE(PNEGI-4 , 'CNEGI ' ,PR1,PR2,PRR);
+62070 ICODE(PNOTB , LOC , WOP , 1 ,QNOTB ,ST , O ,ST );
+62080 QCODE(QNOTB , XOR , WOP , SZWORD ,0 );
+62090 ICODE(PNOTB-1 , COM , WOP , SZWORD ,0 ,ST , O ,ST );
+62100 ICODE(PNOOP , NOP , NON , 0 ,0 ,ST , O ,ST );
+62110 ICODE(PNOOP-2 , NOP , NON , 0 ,0 ,SRE, O ,SRE);
+62120 ICODE(PNOOP-4 , NOP , NON , 0 ,0 ,SP, O ,SP);
+62130 ICODE(PODD , LOC , WOP , 1 ,QODD ,ST , O ,ST );
+62140 QCODE(QODD , CAND , WOP , SZINT ,0 );
+62150 ICODE(PORB , IOR , WOP , SZWORD ,0 ,ST ,ST ,ST );
+62160 ICODE(PORB-1 , IOR , WOP , SZWORD ,0 ,ST ,ST ,ST );
+62170 ICODE(POVER , DVI , WOP , SZINT,0 ,ST ,ST ,ST );
+62180 ICODE(POVERAB , DVI , WOP , SZINT,0 ,ST ,ST ,ST );
+62190 OCODE(PPLITM , 'CRCOMPLEX ' ,PR1,PR2,PRR);
+62200 ICODE(PPLSAB , ADI , WOP , SZINT ,0 ,ST ,ST ,ST );
+62210 ICODE(PPLSAB-2 , ADF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+62250 OCODE(PPLSAB-4 , 'CPLUSAB ' ,PR1,PR2,PRR);
+62260 OCODE(PPLSABS , 'PLABSS ' ,PR1,PR2,PRR);
+62270 OCODE(PPLSABS-1 , 'PLABSS ' ,PR1,PR2,PRR);
+62280 OCODE(PPLSTOCS , 'PLTOSS ' ,PR1,PR2,PRR);
+62290 OCODE(PPLSTOCS-1 , 'PLTOSS ' ,PR1,PR2,PRR);
+62300 OCODE(PRE , 'CRE ' ,PR1,O ,PRR);
+62310 ICODE(PREPR , NOP , NON , 0 ,0 ,ST ,ST ,ST );
+62320 OCODE(PROUN , 'ROUN ' ,PR1, O ,PRR);
+62330 OCODE(PSGNI , 'SIGNI ' ,PR1, O ,PRR);
+62340 OCODE(PSGNI-2 , 'SIGNR ' ,PR1, O ,PRR);
+62350 OCODE(PSHL , 'SHL ' ,PR1,PR2,PRR);
+62410 OCODE(PSHR , 'SHR ' ,PR1,PR2,PRR);
+62420 ICODE(PSUB , SBI , WOP , SZINT ,0 ,ST ,ST ,ST );
+62430 ICODE(PSUB-2 , SBF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+62440 OCODE(PSUB-4 , 'CMINUS ' ,PR1,PR2,PRR);
+62450 ICODE(PTIMSAB , MLI , WOP , SZINT ,0 ,ST ,ST ,ST );
+62460 ICODE(PTIMSAB-2 , MLF , WOP , SZREAL ,0 ,SRE,SRE,SRE);
+62500 OCODE(PTIMSAB-4 , 'CTIMSAB ' ,PR1,PR2,PRR);
+62510 OCODE(PTIMSABS , 'MULABSI ' ,PR1,PR2,PRR);
+62520 OCODE(PUPBMSTR , 'UPBMSTR ' ,PR1, O ,PRR);
+62530 OCODE(PUPBM , 'UPBM ' ,PR1, O ,PRR);
+62540 OCODE(PUPB , 'UPB ' ,PR1,PR2,PRR);
+62570 OCODE(PSELECT , 'SELECTT ' ,PR1, O ,PRR);
+62575 OCODE(PSELECT+1 , 'SELECTS ' ,PR1, O ,PRR);
+62576 OCODE(PSELECT+2 , 'SELECTN ' ,PR1, O ,PRR);
+62580 (* ICODE(PSELECT+1 , LOC , OPX , 0 ,QSELECT ,ST , O ,ST );
+62590 QCODE(QSELECT , ADI , WOP , SZINT ,0 );*)
+62600 OCODE(PSELECTROW , 'SELECTR ' ,PR1, O ,PRR);
+62610 OCODE(PSTRNGSLICE, 'STRSUB ' ,PR1,PR2,PRR);
+62620 OCODE(PSTRNGSLICE+1, 'STRTRIM ' ,PR1, O ,PRR);
+62630 OCODE(PSTARTSLICE, 'STARTSL ' , O , O , O );
+62640 OCODE(PSLICE1 , 'SLICE1 ' ,PR1,PR2,PRR);
+62650 OCODE(PSLICE2 , 'SLICE2 ' ,PR1,PR2,PRR);
+62660 OCODE(PSLICEN , 'SLICEN ' ,PR1, O ,PRR);
+62670 ICODE(PCASE , LAE , GBX , 0 ,QCAS ,ST , O , O );
+62680 QCODE(QCAS , CSA , WOP , SZWORD ,0 );
+62690 ICODE(PJMPF , ZEQ , LCX , 0 ,0 ,ST , O , O );
+62700 ICODE(PLPINIT , LAL , ANX , 0 ,QLPINIT ,PR1, O ,PRR);
+62704 OCODE(QLPINIT , 'LINIT1 ' , O , O , O );
+62710 ICODE(PLPINIT+1 , LAL , ANX , 0 ,QLPINIT+1 ,PR1, O ,PRR);
+62714 OCODE(QLPINIT+1 , 'LINIT2 ' , O , O , O );
+62720 ICODE(PLPINIT+2 , LAL , ANX , 0 ,QLPINIT+2 ,PR1, O , O );
+62724 OCODE(QLPINIT+2 , 'LINIT3 ' , O , O , O );
+62730 ICODE(PLPINIT+3 , LAL , ANX , 0 ,QLPINIT+3 ,PR1, O , O );
+62734 OCODE(QLPINIT+3 , 'LINIT4 ' , O , O , O );
+62740 ICODE(PLPTEST , ZEQ , LCX , 0 ,0 ,ST , O , O );
+62750 ICODE(PLPINCR , LAL , ANX , 0 ,QLOOPINCR+4 , O , O ,PRR);
+62760 ICODE(PLPINCR+1 , INL , ONX , 0 ,QLOOPINCR , O , O ,ST );
+62770 QCODE(QLOOPINCR , LOL , ONX , 0 ,QLOOPINCR+1 );
+62780 QCODE(QLOOPINCR+1, LOL , ONX , SZINT, QLOOPINCR+2 );
+62790 QCODE(QLOOPINCR+2, CMI , WOP , SZINT, QLOOPINCR+3 );
+62792 QCODE(QLOOPINCR+3, TLE , NON , 0 ,0 );
+62793 OCODE(QLOOPINCR+4, 'LOOPINC ' , O , O , O );
+62805 ICODE(PRANGENT , LAL , ANX , 0 ,QRANGENT , O , O , O );
+62810 OCODE(QRANGENT , 'RANGENT ' , O , O , O );
+62820 OCODE(PRANGEXT , 'RANGEXT ' , O , O , O );
+62830 ICODE(PRANGEXT+1 , LFL , WNP ,
+62835 SIZIBBASE+SIZLEBBASE-(2*SZWORD+2*SZADDR) ,QRANGEXT , O , O , O );
+62840 QCODE(QRANGEXT , LFF , WOP ,
+62845 2*SZWORD+2*SZADDR ,QRANGEXT+1 );
+62850 QCODE(QRANGEXT+1 , SFL , WNP ,
+62855 SIZIBBASE+SIZLEBBASE-(2*SZWORD+2*SZADDR) ,0 );
+62860 OCODE(PRANGEXT+2 , 'RANGXTP ' ,PR1, O ,PRR);
+62865 OCODE(PRECGEN , 'DORECGEN ' , O , O , O );
+62870 OCODE(PACTDRSTRUCT,'CRSTRUCT ' ,PR1, O ,PRR);
+62880 OCODE(PACTDRMULT , 'CRMULT ' ,PR1, O ,PRR);
+62910 OCODE(PCHECKDESC , 'CHKDESC ' ,PR1,PR2,PRR);
+62920 OCODE(PVARLISTEND, 'GARBAGE ' ,PR1, O , O );
+62930 ICODE(PVARLISTEND+1,ASP , WOP , SZINT ,0 , O , O ,ST );
+62940 ICODE(PDCLINIT , LOC , MOR , -32000-768,0 , O , O , O );
+62944 ICODE(PDCLINIT+1 , LAE , WLB ,-FIRSTIBOFFSET,QDCLINIT, O , O , O );
+62946 QCODE(QDCLINIT , LPB , NON , 0 ,QDCLINIT+1 );
+62948 QCODE(QDCLINIT+1 , ADP , WOP , (2*SZADDR)+(SZINT+SZLONG),QDCLINIT+2);
+62950 QCODE(QDCLINIT+2 , LOI , WOP , SZADDR,0 );
+62952 ICODE(PDCLINIT+2 , DUP , WOP , SZINT,QDCLINIT+3 , O , O , O );
+62953 QCODE(QDCLINIT+3 , STL , ONX , SZINT ,0 );
+62954 ICODE(PDCLINIT+3 , DUP , WOP , SZADDR,QDCLINIT+4 , O , O , O );
+62955 QCODE(QDCLINIT+4 , SFL , ONX , SZADDR ,0 );
+62960 OCODE(PCREATEREF , 'CRREFN ' ,PR1, O ,PRR);
+62970 OCODE(PCREATEREF+1, 'CRRECN ' ,PR1, O ,PRR);
+62980 OCODE(PCREATEREF+2, 'CRREFR ' ,PR1, O ,PRR);
+62990 OCODE(PCREATEREF+3, 'CRRECR ' ,PR1, O ,PRR);
+63000 OCODE(PCREATEREF+4, 'SETCC ' ,PR1, O ,PRR);
+63010 ICODE(PDCLSP , STL , ONX , SZWORD , 0 ,ST , O , O );
+63012 (*+12() ICODE(PDCLSP+1 , SFL , ONX , SZADDR ,QDCLSP ,SP , O , O );
+63040 QCODE(QDCLSP , LIL , ONX , SZADDR,QDCLSP+1 );
+63050 QCODE(QDCLSP+1 , INC , NON , 0 ,QDCLSP+2 );
+63060 QCODE(QDCLSP+2 , SIL , ONX , SZADDR, 0 ); ()+12*)
+63072 (*+13() ICODE(PDCLSP+1 , DUP , WOP , SZADDR,QDCLSP ,SP , O , O );
+63073 QCODE(QDCLSP , STL , ONX , SZADDR,QDCLSP+1 );
+63074 QCODE(QDCLSP+1 , DUP , WOP , SZADDR,QDCLSP+2 );
+63075 QCODE(QDCLSP+2 , LOI , WOP , 2 ,QDCLSP+3 );
+63076 QCODE(QDCLSP+3 , INC , NON , 0 ,QDCLSP+4 );
+63077 QCODE(QDCLSP+4 , EXG , WOP , SZADDR,QDCLSP+5 );
+63078 QCODE(QDCLSP+5 , STI , WOP , 2 , 0 ); ()+13*)
+63080 OCODE(PDCLSP+2 , 'DCLSN ' ,SNS, O , O );
+63090 OCODE(PDCLSP+3 , 'DCLPN ' ,SNS, O , O );
+63099 ICODE(PFIXRG , LAL , ONX , 0 ,0 , O , O , O );
+63100 ICODE(PFIXRG+1 , SFL , ONX , 0 ,0 , O , O , O );
+63101 END;
+63110 PROCEDURE THIRDPART;
+63120 BEGIN
+63130 OCODE(PBOUNDS , 'BOUND ' ,STS, O ,PRR);
+63140 ICODE(PLOADVAR , LAL , ACX , 0 ,QLOADVAR , O , O ,PRR);
+63145 QCODE(QLOADVAR , LXL , ACP , 0 ,QLOADVAR+4 );
+63150 ICODE(PLOADVAR+1 , LAE , ACL , 0 ,QLOADVAR+1 , O , O ,PRR);
+63155 QCODE(QLOADVAR+1 , LAE , ACB ,-FIRSTIBOFFSET,QLOADVAR+4 );
+63156 ICODE(PLOADVAR+2 , DUP , ACP ,SZADDR,QLOADVAR+2,O , O ,PRR);
+63157 QCODE(QLOADVAR+2 , ADP , ACX , 0 ,QLOADVAR+3 );
+63158 QCODE(QLOADVAR+3 , EXG , WOP , SZADDR,QLOADVAR+4 );
+63160 OCODE(QLOADVAR+4 , 'GLDVAR ' , O , O , O );
+63170 OCODE(PLOADRT , 'ROUTN ' , O , O ,PRR);
+63172 ICODE(PLOADRTA , LXL , ACP , 0 ,QLOADRTA , O , O ,SP);
+63174 ICODE(PLOADRTA+1 , LAE , ACB ,-FIRSTIBOFFSET,QLOADRTA, O , O ,SP);
+63176 ICODE(PLOADRTA+2 , ADP , ACP , 0 ,QLOADRTA , O , O ,SP);
+63178 OCODE(QLOADRTA , 'ROUTNA ' , O , O , O );
+63180 OCODE(PLOADRTP , 'ROUTNP ' ,PR1, O ,PRR);
+63190 OCODE(PSCOPETT+2 , 'TASSTPT ' ,PR1,PR2,PRR);
+63200 OCODE(PSCOPETT+3 , 'SCPTTP ' ,PR1,PR2,PRR);
+63210 OCODE(PSCOPETT+4 , 'SCPTTM ' ,PR1,PR2,PRR);
+63220 OCODE(PASSIGTT , 'TASSTS ' ,PR1,PR2,PRR);
+63225 OCODE(PASSIGTT+1 , 'TASSTS2 ' ,PR1,PR2,PRR);
+63230 OCODE(PASSIGTT+2 , 'TASSTPT ' ,PR1,PR2,PRR);
+63240 OCODE(PASSIGTT+3 , 'TASSTP ' ,PR1,PR2,PRR);
+63250 OCODE(PASSIGTT+4 , 'TASSTM ' ,PR1,PR2,PRR);
+63260 OCODE(PSCOPETN , 'SCPTNP ' ,PR1,PR2,PRR);
+63270 OCODE(PASSIGTN , 'TASSNP ' ,PR1,PR2,PRR);
+63300 OCODE(PSCOPENT+2 , 'SCPNTPT ' ,PR1,PR2,PRR);
+63310 OCODE(PSCOPENT+3 , 'SCPNTP ' ,PR1,PR2,PRR);
+63330 OCODE(PASSIGNT , 'NASSTS ' ,PR1,PR2,PRR);
+63340 OCODE(PASSIGNT+1 , 'NASSTS2 ' ,PR1,PR2,PRR);
+63350 OCODE(PASSIGNT+2 , 'NASSTPT ' ,PR1,PR2,PRR);
+63360 OCODE(PASSIGNT+3 , 'NASSTP ' ,PR1,PR2,PRR);
+63390 OCODE(PSCOPENN , 'SCPNNP ' ,PR1,PR2,PRR);
+63410 OCODE(PASSIGNN , 'NASSNP ' ,PR1,PR2,PRR);
+63430 ICODE(PSCOPEVAR , LAL , ACX , 0 ,QSCOPEVAR ,PR1, O , O );
+63435 QCODE(QSCOPEVAR , LXL , ACP , 0 ,QSCOPEVAR+4 );
+63440 ICODE(PSCOPEVAR+1, LAE , ACL , 0 ,QSCOPEVAR+1 ,PR1, O , O );
+63445 QCODE(QSCOPEVAR+1, LAE , ACB ,-FIRSTIBOFFSET,QSCOPEVAR+4 );
+63446 ICODE(PSCOPEVAR+2, DUP , ACP,SZADDR,QSCOPEVAR+2,PR1,O , O );
+63447 QCODE(QSCOPEVAR+2, ADP , ACX , 0 ,QSCOPEVAR+3 );
+63448 QCODE(QSCOPEVAR+3, EXG , WOP , SZADDR ,QSCOPEVAR+4 );
+63450 OCODE(QSCOPEVAR+4, 'GVSCOPE ' , O , O , O );
+63460 OCODE(PSCOPEEXT , 'SCOPEXT ' ,PR1, O ,PRR);
+63470 ICODE(PASGVART , STL , OPX , 0 ,0 ,ST , O , O );
+63480 ICODE(PASGVART+1 , STE , OPL , 0 ,0 ,ST , O , O );
+63490 ICODE(PASGVART+2 , STF , OPX , 0 ,0 ,ST , O , O );
+63510 ICODE(PASGVART+3 , LAL , OPX , 0 ,QASGVART ,SRE, O , O );
+63520 QCODE(QASGVART , STI , WOP , SZREAL ,0 );
+63530 ICODE(PASGVART+4 , LAE , OPL , 0 ,QASGVART ,SRE, O , O );
+63540 ICODE(PASGVART+5 , ADP , OPX , 0 ,QASGVART ,SRE, O , O );
+63560 ICODE(PASGVART+6 , LAL , ACX , 0 ,QASGVART+1 ,ST , O , O );
+63570 ICODE(PASGVART+7 , LAE , ACL , 0 ,QASGVART+1 ,ST , O , O );
+63572 ICODE(PASGVART+8 , ADP , ACX , 0 ,QASGVART+1 ,PR1, O , O );
+63580 OCODE(QASGVART+1 , 'GVASSTX ' , O , O , O );
+63590 OCODE(PIDTYREL , 'IS ' ,PR1,PR2,PRR);
+63600 OCODE(PIDTYREL+1 , 'ISNT ' ,PR1,PR2,PRR);
+63602 OCODE(PGETTOTCMN , 'GTOTSTR ' ,PR1, O ,PRR);
+63604 OCODE(PGETTOTCMN+1,'GTOTMUL ' ,PR1, O ,PRR);
+63606 OCODE(PGETTOTCMN+2,'GTOTRFR ' ,PR1, O ,PRR);
+63608 OCODE(PGETTOTAL , 'GTOTS ' ,PR1, O ,PRR);
+63610 OCODE(PGETTOTAL+1, 'GTOTS2 ' ,PR1, O ,PRR);
+63612 OCODE(PGETTOTAL+2, 'GTOTP ' ,PR1, O ,PRR);
+63614 OCODE(PGETTOTAL+3, 'GTOTN ' ,PR1, O ,PRR);
+63616 OCODE(PGETTOTAL+4, 'GTOTREF ' ,PR1, O ,PRR);
+63618 OCODE(PGETMULT , 'GETMULT ' ,PR1, O ,PRR);
+63620 OCODE(PGETMULT+1 , 'GETSLN ' ,PR1, O ,PRR);
+63630 OCODE(PDEREF , 'DREFS ' ,PR1, O ,PRR);
+63631 OCODE(PDEREF+1 , 'DREFS2 ' ,PR1, O ,PRR);
+63632 OCODE(PDEREF+2 , 'DREFPTR ' ,PR1, O ,PRR);
+63634 OCODE(PDEREF+3 , 'DREFN ' ,PR1, O ,PRR);
+63640 OCODE(PDEREF+4 , 'DREFM ' ,PR1, O ,PRR);
+63650 OCODE(PSKIP , 'SKIPS ' , O , O ,PRR);
+63660 OCODE(PSKIP+1 , 'SKIPPIL ' , O , O ,PRR);
+63665 OCODE(PSKIP+2 , 'SKIPS2 ' , O , O ,PRR);
+63670 OCODE(PSKIPSTRUCT, 'SKIPSTR ' , O , O ,PRR);
+63680 OCODE(PNIL , 'NILP ' , O , O ,PRR);
+63690 ICODE(PVOIDNORMAL, DUP , WOP , SZADDR ,QVOIDNM, SP, O , O );
+63700 QCODE(QVOIDNM , LOI , WOP , SZWORD ,QVOIDNM+1 );
+63710 QCODE(QVOIDNM+1 , ZEQ , JMP , 3 ,QVOIDNM+2 );
+63720 QCODE(QVOIDNM+2 , ASP , WOP , SZADDR ,QVOIDNM+3 );
+63730 QCODE(QVOIDNM+3 , BRA , JMP , 2 ,QVOIDNM+4 );
+63740 OCODE(QVOIDNM+4 , 'GARBAGE ' , O , O , O );
+63750 OCODE(PVOIDNAKED , 'VOIDN ' ,PR1, O , O );
+63760 ICODE(PWIDEN , LOC , WOP , SZINT ,QWIDEN , ST, O ,SRE);
+63770 QCODE(QWIDEN , LOC , WOP , SZREAL ,QWIDEN+1 );
+63780 QCODE(QWIDEN+1 , CIF , NON , 0 ,0 );
+63790 OCODE(PWIDEN+2 , 'WIDREAL ' ,PR1, O ,PRR);
+63800 OCODE(PWIDEN+4 , 'WIDCHAR ' ,PR1, O ,PRR);
+63810 OCODE(PWIDEN+5 , 'WIDBITS ' ,PR1, O ,PRR);
+63820 OCODE(PWIDEN+6 , 'WIDBYTS ' ,PR1, O ,PRR);
+63830 OCODE(PWIDEN+7 , 'WIDSTR ' ,PR1, O ,PRR);
+63840 OCODE(PROWNONMULT, 'ROWNM ' ,PR1, O ,PRR);
+63850 OCODE(PROWMULT , 'ROWM ' ,PR1, O ,PRR);
+63855 ICODE(PGETPROC , LOR , WOP , 1 ,QGETPROC ,PR1, O ,PRR);
+63856 QCODE(QGETPROC , ADP , ANX , SZADDR ,QGETPROC+1 );
+63857 QCODE(QGETPROC+1 , LOI , WOP , SZADDR,PGETPROC+1 );
+63859 OCODE(PGETPROC+1 , 'GETPROC ' ,PR1, O ,PRR);
+63860 ICODE(PCALL , LFR , WOP , 2*SZADDR,QCALLA,SNS, O , O );
+63862 ICODE(PCALLA , LXL , ACP , 0 ,QCALLA ,SNS, O , O );
+63865 ICODE(PCALLA+1 , LAE , ACB ,-FIRSTIBOFFSET,QCALLA,SNS, O , O );
+63867 ICODE(PCALLA+2 , ADP , ACP , 0 ,QCALLA ,SNS, O , O );
+63869 QCODE(QCALLA , DUP , WOP , 2*SZADDR,QCALLA+1 );
+63870 QCODE(QCALLA+1 , ASP , WOP , SZADDR,QCALLA+2 );
+63872 QCODE(QCALLA+2 , LOI , WOP , SZADDR,QCALLA+3 );
+63874 QCODE(QCALLA+3 , CAI , NON , 0 ,0 );
+63875 ICODE(PRNSTART , LOC , WOP ,A68STAMP,QRNSTART, O , O , O );
+63876 QCODE(QRNSTART , STL , WOP , -SZWORD ,QRNSTART+1 );
+63877 OCODE(QRNSTART+1 , 'RNSTART ' , O , O , O );
+63878 ICODE(PRETURN , RET , OPX , 0 ,0 ,STN, O , O );
+63880 OCODE(PGBSTK , 'GBSTK ' , O , O , O );
+63884 ICODE(POUTJUMP , LOR , WOP , 1 ,QOUTJUMP , O , O , O );
+63885 QCODE(QOUTJUMP , SFE , GBX , SZADDR ,QOUTJUMP+1 );
+63886 QCODE(QOUTJUMP+1 , LOR , WOP , 0 ,QOUTJUMP+2 );
+63887 QCODE(QOUTJUMP+2 , SFE , GBX , 2*SZADDR ,QOUTJUMP+3 );
+63888 QCODE(QOUTJUMP+3 , GTO , GBX , 0 ,0 );
+63890 OCODE(PGETOUT , 'GETOUT ' , O , O , O );
+63892 ICODE(PSETIB , LFR , WOP , 2*SZADDR,QSETIB, O , O , O );
+63895 QCODE(QSETIB , EXG , WOP , SZADDR ,QSETIB+1 );
+63896 QCODE(QSETIB+1 , STR , WOP , 0 ,QSETIB+2 );
+63897 QCODE(QSETIB+2 , STR , WOP , 1 ,0 );
+63900 OCODE(PLEAPGEN , 'GENSTR ' , O , O ,PRR);
+63910 OCODE(PLEAPGEN+1 , 'HEAPSTR ' , O , O ,PRR);
+63920 OCODE(PLEAPGEN+2 , 'GENRSTR ' , O , O ,PRR);
+63930 OCODE(PLEAPGEN+3 , 'GENMUL ' ,PR1, O ,PRR);
+63940 OCODE(PLEAPGEN+4 , 'HEAPMUL ' ,PR1, O ,PRR);
+63950 OCODE(PLEAPGEN+5 , 'GENRMUL ' ,PR1, O ,PRR);
+63960 OCODE(PPREPSTRDISP , 'PCOLLST ' , O , O ,PRR);
+63970 OCODE(PPREPROWDISP , 'PCOLLR ' ,STS, O ,PRR);
+63980 OCODE(PPREPROWDISP+1, 'PCOLLRM ' ,STS, O ,PRR);
+63990 OCODE(PCOLLCHECK , 'PCOLLCK ' ,STP, O , O );
+64000 (* ICODE(PCOLLTOTAL , DUP , WOP , SZINT ,QCOLLTOTAL,STP,ST ,O);
+64010 QCODE(QCOLLTOTAL , LOC , OPX , 0 ,QCOLLTOTAL+1 );
+64020 QCODE(QCOLLTOTAL+1, ADI , WOP , SZINT ,QCOLLTOTAL+2 );
+64030 QCODE(QCOLLTOTAL+2, EXG , WOP , SZINT ,QCOLLTOTAL+3 );
+64040 QCODE(QCOLLTOTAL+3, STI , WOP , SZINT ,0 );*)
+64050 (* ICODE(PCOLLTOTAL+2, DUP , WOP , SZINT,QCOLLTOTAL+4,STP,ST,O);
+64060 QCODE(QCOLLTOTAL+4, LOC , WOP ,15 ,QCOLLTOTAL+5 );
+64070 QCODE(QCOLLTOTAL+5,CSET , WOP , SZINT ,QCOLLTOTAL+6 );
+64080 QCODE(QCOLLTOTAL+6, EXG , WOP , SZINT ,QCOLLTOTAL+7 );
+64090 QCODE(QCOLLTOTAL+7, STI , WOP , SZINT ,PCOLLTOTAL );*)
+64092 OCODE(PCOLLTOTAL , 'COLLTS ' ,PR1,PR2,PRR);
+64093 OCODE(PCOLLTOTAL+1 , 'COLLTS2 ' ,PR1,PR2,PRR);
+64095 OCODE(PCOLLTOTAL+2 , 'COLLTPT ' ,PR1,PR2,PRR);
+64100 OCODE(PCOLLTOTAL+3 , 'COLLTP ' ,PR1,PR2,PRR);
+64110 OCODE(PCOLLTOTAL+4 , 'COLLTM ' ,PR1,PR2,PRR);
+64120 OCODE(PCOLLNAKED , 'COLLNP ' ,PR1,PR2,PRR);
+64130 OCODE(PNAKEDPTR , 'NAKPTR ' ,PR1, O ,PRR);
+64140 ICODE(PLINE , LIN , OPX , 0 ,0 , O , O , O );
+64170 OCODE(PENDSLICE , 'ENDSL ' ,PR1, O ,PRR);
+64180 OCODE(PTRIM , 'SLICEA ' , O , O , O );
+64190 OCODE(PTRIM+1 , 'SLICEB ' , O , O , O );
+64200 OCODE(PTRIM+2 , 'SLICEC ' , O , O , O );
+64210 OCODE(PTRIM+3 , 'SLICED ' , O , O , O );
+64220 OCODE(PTRIM+4 , 'SLICEE ' , O , O , O );
+64230 OCODE(PTRIM+5 , 'SLICEF ' , O , O , O );
+64240 OCODE(PTRIM+6 , 'SLICEG ' , O , O , O );
+64250 OCODE(PTRIM+7 , 'SLICEH ' , O , O , O );
+64260 OCODE(PTRIM+8 , 'SLICEI ' , O , O , O );
+64270 OCODE(PTRIM+9 , 'SLICEJ ' , O , O , O );
+64280 ICODE(PJMP , BRA , LCX , 0 ,0 , O , O , O );
+64282 ICODE(PDUP1PILE , DUP , WOP , SZADDR,0 ,SP , O , SP);
+64284 ICODE(PDUP2PILE , DUP , WOP , SZADDR*2,QDUP2PILE,SP,SP,SP);
+64286 QCODE(QDUP2PILE , ASP , WOP , SZADDR,0 );
+64290 ICODE(PDUP1ST , DUP , WOP , SZINT,0 , ST, O , ST);
+64294 ICODE(PDUP1ST+1 , DUP , WOP , SZREAL,0 ,SRE, O ,SRE);
+64300 ICODE(PDUP2ND , DUP , WOP , SZINT*2,QDUP2ND,ST ,ST , ST);
+64310 ICODE(PDUP2ND+1 , DUP , WOP ,SZREAL+SZINT,QDUP2ND,SRE, ST,SRE);
+64312 ICODE(PDUP2ND+2 , DUP , WOP , SZINT+SZREAL,QDUP2ND+1, ST,SRE, ST);
+64314 ICODE(PDUP2ND+3 , DUP , WOP , SZREAL*2,QDUP2ND+1,SRE,SRE,SRE);
+64318 QCODE(QDUP2ND , ASP , WOP , SZINT ,0 );
+64319 QCODE(QDUP2ND+1 , ASP , WOP , SZREAL ,0 );
+64320 ICODE(PDATALIST , LOC , OPX , 0 ,0 ,SNS, O ,DLS);
+64322 ICODE(PHOIST , ASP , ONX , 0 ,QHOIST , O , O , O );
+64324 QCODE(QHOIST , LOC , ACX , 0 ,QHOIST+1 );
+64326 OCODE(QHOIST+1 , 'HOIST ' , O , O , O );
+64330 ICODE(PPUSH , LOL , OPX , 0 ,0 , O , O , O );
+64340 ICODE(PPUSH+1 , LOE , OPL , 0 ,0 , O , O , O );
+64350 ICODE(PPUSH+2 , LOF , OPX , 0 ,0 , O , O , O );
+64360 ICODE(PPUSH1 , LFL , OPX , 0 ,0 , O , O , O );
+64375 ICODE(PPUSH1+1 , LFE , OPL , 0 ,0 , O , O , O );
+64376 ICODE(PPUSH1+2 , LFF , OPX , 0 ,0 , O , O , O );
+64377 ICODE(PPUSH2 , LAL , OPX , 0 ,QPUSH2 , O , O , O );
+64378 ICODE(PPUSH2+1 , LAE , OPL , 0 ,QPUSH2 , O , O , O );
+64379 ICODE(PPUSH2+2 , ADP , OPX , 0 ,QPUSH2 , O , O , O );
+64380 QCODE(QPUSH2 , LOI , WOP , SZREAL ,0 );
+64385 ICODE(PPUSHIM , LOC , OPX , 0 ,0 , O , O ,ST );
+64390 ICODE(PPUSHIM+1 , LAE , GBX , 0 ,0 , O , O ,SP );
+64395 ICODE(PPUSHIM+2 , LFC , OPX , 0 ,0 , O , O ,SP );
+64397 ICODE(PPUSHIM+3 , LOE , GBX , 0 ,0 , O , O ,ST );
+64400 ICODE(PPUSHIM2 , LFC , OPX , 0 ,0 , O , O , O );
+64410 ICODE(PPUSHIM2+1 , LAE , GBX , 0 ,0 , O , O , O );
+64411 ICODE(PPUSHI2A , ASP , WOP , SZINT-SZREAL,0 , O , O , O );
+64412 ICODE(PPUSHIM4 , LXL , WOP , 0 ,QPUSHIM4 , O , O , O );
+64414 QCODE(QPUSHIM4 , LPI , OPX , 0 ,0 );
+64415 ICODE(PPUSHIM4+1 , LAE , GBX , 0 ,QPUSHIM4+1 , O , O , O );
+64416 QCODE(QPUSHIM4+1 , LOI , WOP , SZREAL ,0 );
+64420 ICODE(PPUSHFTN , LFR , WOP , SZINT ,0 , O , O , O );
+64430 ICODE(PPUSHFTN+1 , LFR , WOP , SZADDR ,0 , O , O , O );
+64435 ICODE(PPUSHFTN+2 , LFR , WOP , SZREAL ,0 , O , O , O );
+64440 ICODE(PSWAP , EXG , WOP , SZWORD ,0 , O , O , O );
+64442 ICODE(PSWAP+1 , EXG , WOP , SZADDR ,0 , O , O , O );
+64444 ICODE(PSWAP+2 , EXG , WOP , SZREAL ,0 , O , O , O );
+64446 OCODE(PSWAP+3 , 'SWAP ' , O , O , O );
+64448 (*+13() ICODE(PPARM , LOL , ONX , 0 ,QDCLSP+1 , O , O , O ); ()+13*)
+64450 (*+12() ICODE(PPARM , LIL , ONX , 0 ,QDCLSP+4 , O , O , O );
+64460 QCODE(QDCLSP+4 , INC , NON , 0 ,QDCLSP+5 );
+64465 QCODE(QDCLSP+5 , SIL , ONX , 0 ,0 ); ()+12*)
+64470 (* ICODE(PSTOS2 , ASP , WOP ,-SZINT ,0 , O , O , O );
+64530 ICODE(PS4TOS2 , ASP , WOP , SZADDR ,0 , O , O , ST); *)
+64560 ICODE(PDECM , LOC , OPX , 0 ,0 , O , O , O );
+64565 ICODE(PDECM+1 , STL , ONX , 0 ,0 , O , O , O );
+64570 END;
+64580 PROCEDURE INITPOPARRAY;
+64590 VAR I,J:SBTTYP;
+64600 BEGIN
+64610 FOR I := SBTSTK TO SBTDL DO
+64620 FOR J := SBTVOID TO SBTPRR DO
+64630 BEGIN
+64640 POPARRAY [I,J] := PNONE;
+64650 POPARRAY [I,I] := PNOOP;
+64660 POPARRAY [I,SBTVOID] :=PNOOP;
+64670 POPARRAY [I,SBTVAR ] := PLOADVAR;
+64672 POPARRAY [I,SBTPROC] := PLOADRTA;
+64674 POPARRAY [I,SBTRPROC]:= PLOADRTA;
+64680 END;
+64700 POPARRAY[ SBTSTK2 , SBTSTK4 ] := PS4TOS2;
+64710 POPARRAY[ SBTSTK4 , SBTPRR ] := PPUSHFTN+2;
+64720 POPARRAY[ SBTSTK4 , SBTID ] := PPUSH2;
+64730 POPARRAY[ SBTSTK4 , SBTIDV ] := PPUSH2;
+64735 POPARRAY[ SBTSTK4 , SBTDEN ] := PPUSHIM4;
+64740 POPARRAY[ SBTSTK4 , SBTPR1 ] := PNOOP;
+64750 POPARRAY[ SBTSTK4 , SBTPR2 ] := PNOOP;
+64760 POPARRAY[ SBTSTK , SBTSTK2 ] := PVARLISTEND+1;
+64770 POPARRAY[ SBTSTK , SBTID ] := PPUSH;
+64780 POPARRAY[ SBTSTK , SBTIDV ] := PPUSH;
+64790 POPARRAY[ SBTSTK , SBTLIT ] := PPUSHIM;
+64800 POPARRAY[ SBTSTK , SBTDEN ] := PPUSHIM;
+64810 POPARRAY[ SBTSTK , SBTDL ] := PNOOP;
+64820 POPARRAY[ SBTSTK2 , SBTID ] := PPUSH1;
+64830 POPARRAY[ SBTSTK2 , SBTIDV ] := PPUSH1;
+64840 POPARRAY[ SBTSTK2 , SBTLIT ] := PPUSHIM2;
+64850 POPARRAY[ SBTSTK2 , SBTDEN ] := PPUSHIM2;
+64852 POPARRAY[ SBTSTK2A, SBTLIT ] := PPUSHI2A;
+64860 POPARRAY[ SBTSTK , SBTPRR ] := PPUSHFTN;
+64870 POPARRAY[ SBTSTK2 , SBTPRR ] := PPUSHFTN+1;
+64880 POPARRAY[ SBTSTK , SBTPR1 ] := PNOOP;
+64890 POPARRAY[ SBTSTK , SBTPR2 ] := PNOOP;
+64900 POPARRAY[ SBTSTK2 , SBTPR1 ] := PNOOP;
+64910 POPARRAY[ SBTSTK2 , SBTPR2 ] := PNOOP;
+64920 POPARRAY[ SBTSTK2 , SBTSTK ] := PSTOS2;
+64980 END;
+64990 PROCEDURE INITLENARRAY;
+65000 VAR I:SBTTYP;
+65010 BEGIN
+65020 FOR I := SBTSTK TO SBTPRR DO LENARRAY[I] := 0;
+65030 LENARRAY[SBTSTK ] := SZWORD;
+65040 (*+19() LENARRAY[SBTSTK2] := SZADDR;
+65042 LENARRAY[SBTSTK2A]:= 3*SZWORD; ()+19*)
+65050 LENARRAY[SBTSTK4] := SZREAL;
+65060 END;
+65070 BEGIN (* INITCODES +)
+65080 FIRSTPART; SECONDPART; THIRDPART; INITPOPARRAY; INITLENARRAY;
+65090 END;
+65100 (*+)
+65110 ()+86*)
+65120 (**)
+65130 (**)
+65140 (**)
+65150 (**)
+65160 (**)
+65170 (*+71() BEGIN
+65180 DUMP(FIRSTSTACK,LASTSTACK);
+65190 END . ()+71*)
--- /dev/null
+00100 (*+01() (*$L-*) ()+01*)
+00110 (*+02() (*$I32*)(*$T-*)(*$W-*)(*$G-*)(*$D+*)(*$R-*)(*$L+*)(*$E+*) ()+02*)
+00120 (*LIST OF TAILORING OPTIONS*)
+00130 (***************************)
+00140 (**)
+00150 (* 1..9 DIFFERENT MACHINES
+00160 01 = CDC
+00170 02 = EM SYSTEM
+00180 03 = NORD 100
+00190 04 = POS PERQ
+00200 05 = PNX PERQ
+00210 11..19 DIFFERENT WORD LENGTHS
+00220 11 = 60 BITS
+00230 12 = 16 BITS
+00240 13 = 32 BITS
+00245 19 = 16 BITS WITH SZADDR=32 BITS (EG VAX2)
+00250 21..29 DEBUGGING AIDS
+00260 21 = MONITORING OF SEMANTIC ROUTINES
+00270 22 = TIMING CHECK
+00280 23 = TEMPORARY CODE EMITTER
+00290 24 = EM CODE EMITTER
+00300 25 = EM MACHINE ON CYBER
+00310 31..39 PRAGMATS
+00320 31 = CHECKS (RUN TIME) ON
+00330 32 = ASSERTIONS (COMPILE TIME) CHECKED
+00332 33 = GENERATE CODE FOR SYMBOLIC DEBUGGER
+00340 41..49 DIFFERENT STACK STRATEGIES
+00350 41 = STACK GROWS IN NEGATIVE DIRECTION
+00360 42 = SEPARATE SPACES FOR CODE AND DATA
+00370 43 = INTEGER LENGTH > MANTISSA LENGTH (E.G. CYBER OR NO FLOATING POINT)
+00372 44 = FLOATING POINT NOT AVAILABLE
+00380 50..59 SPECIAL OPTIONS
+00390 50 = CDC CHARACTER CODE
+00400 51 = UMRCC SPECIAL 7600 CODE
+00410 52 = CDC 7600 (AS OPPOSED TO CYBER)
+00420 53 = VERY LONG PROCEDURES SPLIT IN TWO TO HELP PASCAL COMPILER
+00430 54 = EXPERIMENTAL ON ERROR FACILITY
+00440 55 = REDUCED LISTING AND ERROR MESSAGES
+00450 61..69 DIFFERENT LENGTH FEATURES
+00460 61 = LONG WORDS
+00470 (70..89 ARE ONLY RELEVANT FOR SEPARATE COMPILATION )
+00480 70 = ALL DECLARATIONS
+00490 71..79 UNIT INTERFACES
+00500 71 = PROGRAM HEADING
+00510 72 = A68 PARSER (PRODTABLE)
+00520 73 = A68 LEXICAL (LXIO'S)
+00530 75 = P-OPS FOR OPERATORS
+00540 76 = OTHER P-OPS
+00550 77 = A68 CODE EMITTER (RUN-TIME OBJECTS)
+00560 78 = CODETABLE
+00570 80 = GLOBAL UNIT
+00580 81..89 UNIT IMPLEMENTATIONS
+00590 81 = A68 LEXICAL *
+00600 82 = A68 PARSER *
+00610 83 = A68 LEXEME INITIALISATION *
+00620 84 = A68 MODE INITIALATION *
+00630 85 = A68 SEMANTICS *
+00640 86 = A68 CODE GENERATOR *
+00650 87 = A68 CODE EMITTER
+00660 *)
+00670 (*+01() (*$G-+) ()+01*)
+00680 (*+01() (*$W5750+) ()+01*)
+00690 (*+01() (*$T-,P-+) ()+01*)
+00700 (*+25() (*$G-+) ()+25*)
+00710 (*+25() (*$W5750+) ()+25*)
+00720 (*+25() (*$T-,P-+) ()+25*)
+00730 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+00740 (**)
+00750 (*-03()
+00760 (*+01() PROGRAM A68SCOM(SOURCDECS, OUTPUT+, LGO, LSTFILE, A68INIT ); ()+01*)
+00770 (*-01() (*-05() (*+71()
+00780 PROGRAM A68SCOM(SOURCDECS, LGO, LSTFILE, A68INIT, DUMPF, OUTPUT);
+00790 ()+71*) ()-05*) ()-01*)
+00800 (*+25() PROGRAM A68SCOM(SOURCDECS, OUTPUT, LGO, LSTFILE, A68INIT ); ()+25*)
+00810 ()-03*)
+00820 (*+04()
+00830 EXPORTS
+00840 IMPORTS HACKS FROM HACKS;
+00850 IMPORTS A68SIN FROM A68SIN;
+00860 IMPORTS A68S1 FROM A68S1;
+00870 ()+04*)
+00880 (**)
+00890 (*+70()
+00900 CONST (* CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST CONST*)
+00910 (**)
+00920 (*ENVIRONMENT*)
+00930 (*************)
+00940 (**)
+00950 VERSIONNUM='(VERSION 2.2)';
+00960 (*+01()
+00970 ALG68NUM='ALG68S 2.2';
+00980 NOSNUM='NOS 2.2';
+00990 ()+01*)
+01000 (*+11()
+01010 MAXINT=7777777777777777B;
+01040 MAXABSCHAR=63;
+01070 MAXSIZE=110B; (*MAX SIZE OF NONSTOWED OBJECT*)
+01080 TRUEVALUE=40000000000000000000B;
+01090 ()+11*)
+01100 (*+12()
+01110 MAXINT=32767;
+01120 (*+02() TRUEVALUE=1; ()+02*) (*SHOULD MATCH WITH RUN-TIME SYSTEM*)
+01130 (*-02() TRUEVALUE=-32768; ()-02*)
+01140 MAXSIZE=127;
+01200 MAXABSCHAR=127;
+01210 ()+12*)
+01220 (*+13()
+01230 MAXINT=2147483647;
+01270 MAXABSCHAR=127;
+01290 MAXSIZE=127;
+01300 (*+02() TRUEVALUE=1; ()+02*)
+01302 (*-02() TRUEVALUE=(*-2147483648*) -1; ()-02*)
+01310 ()+13*)
+01320 (*+01() RTNLENGTH=7; ()+01*) (*LENGTH OF PROCEDURE NAMES*)
+01330 (*+02() RTNLENGTH=8; ()+02*) (*SHOULD MATCH WHAT YOUR PASCAL*)
+01340 (*+03() RTNLENGTH=5; ()+03*) (*COMPILER PRODUCES*)
+01350 (*+05() RTNLENGTH=7; ()+05*)
+01370 (**)
+01380 (*LISTING*)
+01390 (*********)
+01400 (**)
+01410 CBUFSIZE=120; (*SIZE OF OUTPUT BUFFERS*)
+01420 HTSIZE=163; (*HASH TABLE SIZE*)
+01430 (*+01() LEX1SIZE=1; ()+01*)
+01440 (*+02() (*+12() (*-19() LEX1SIZE=10; ()-19*)
+01445 (*+19() LEX1SIZE=14; ()+19*) ()+12*)
+01446 (*+13() LEX1SIZE=16; ()+13*)
+01447 ()+02*)
+01450 (*+03() LEX1SIZE=4; ()+03*)
+01460 (*+04() LEX1SIZE=8; (*SIZE OF STATIC PART OF LEXEME*) ()+04*)
+01470 (*+05() LEX1SIZE=8; ()+05*)
+01480 (*+03() LINESPERPAGE=54; ()+03*)
+01490 (*-03() LINESPERPAGE=58; ()-03*)
+01500 (**)
+01510 (**)
+01520 (*MODE HANDLING*)
+01530 (***************)
+01540 (**)
+01550 (*+01() MODE1SIZE=1; ()+01*)
+01560 (*+02() MODE1SIZE=(*+12() (*-19() 14 ()-19*) (*+19() 18 ()+19*) ()+12*) (*+13() 20 ()+13*); ()+02*)
+01570 (*+03() MODE1SIZE=4; ()+03*)
+01580 (*+04() MODE1SIZE=8; ()+04*)
+01590 (*+05() MODE1SIZE=10; ()+05*)
+01600 (**)
+01610 (**)
+01620 (*LEXICAL ANALYSIS*)
+01630 (******************)
+01640 (*+11() TAXLEN=640; TAXLENWD=64; TAXLENWD2=128; CHARPERWORD=10; WORDSPERREAL=1; ()+11*)
+01650 (*+12() TAXLEN=510; TAXLENWD=255; CHARPERWORD=2; WORDSPERREAL=(*+03()3()+03*)(*-03()4()-03*); ()+12*)
+01660 (*+13() TAXLEN=508; TAXLENWD=127; CHARPERWORD=4; WORDSPERREAL=2; ()+13*)
+01670 (*-73() LXIODUMMY=0; LXIOVDEFL=28; ()-73*)
+01680 (**)
+01690 (*ERROR HANDLING*)
+01700 (****************)
+01710 ELX=0; ESY=10; ESE=60; DUMMY=0; FINISH=9;
+01720 ESY01=130; SR01=11;
+01730 (**)
+01740 (**)
+01750 (*CODE EMITTER*)
+01760 (**************)
+01761 (*+02() OUTPUTEFET=38;
+01762 (*+12() (*-19() FIRSTIBOFFSET=30; ()-19*) (*+19() FIRSTIBOFFSET=50; ()+19*) ()+12*)
+01763 (*+13() FIRSTIBOFFSET=52; ()+13*)
+01765 (*PARAMS SZREAL+SZWORD+(2*SZADDR)+LINKS (8*SZADDR) *)
+01767 (* IF YOU CHANGE THIS YOU HAVE TO CHANGE FIRSTIBOFFSET IN E.H *)
+01768 A68STAMP=13476; (* A HIGHLY IMPROBABLE NUMBER *)
+01769 ()+02*)
+01770 (*+77()
+01780 (*+01()
+01790 OUTPUTEFET=23B; (*OFFSET OF 'OUTPUT'*)
+01800 FIRSTVAR=510B; (*OFFSET OF FIRST PASCAL VAR; KNOWN TO A68SCOD*)
+01810 FIRSTIBOFFSET=531B; (*IF YOU ALTER THIS, THERE ARE SOME CORRESPONDING CHANGES TO THE CODETABLE*)
+01820 ()+01*)
+01840 (*+03() OUTPUTEFET=9999; FIRSTIBOFFSET=9999; (*NEED FIXING*) ()+03*)
+01850 (*+04() OUTPUTEFET=9999; FIRSTIBOFFSET=83; ()+04*)
+01860 (*+05() OUTPUTEFET=9999; FIRSTIBOFFSET=0; ()+05*)
+01870 ()+77*)
+01880 (*+02()
+01890 (**)
+01891 (* CONSTANTS FOR PRODUCING COMPACT EM-1 CODE *)
+01892 (*+24()
+01893 ADF= 2; ADI= 3; ADP= 4; CAND=7; ASP= 8; BEQ=10; BGE=11; BGT=12; BLE=13; BLT=16; BNE=17; BRA=18;
+01894 CAI=19; CAL=20; CFF=21; CIF=24; CIU=26; CMF=27; CMI=28; CMU=31; COM=32; CSA=33;
+01895 DUP=42; DVF=44; DVI=45; EXG=47; GTO=51; INC=52; INL=54; IOR=56;
+01896 LAE=57; LAL=58; LAR=59; LDC=60; LDE=61; LDF=62; LDL=63; LFR=64; LIL=65; LIN=67; LOC=69;
+01897 LOE=70; LOF=71; LOI=72; LOL=73; LOR=74; LOS=75; LPB=76; LPI=77; LXA=78; LXL=79;
+01899 MLF=80; MLI=81; NGF=84; NGI=85; NOP=86; RET=88; ROL=91;
+01900 SBF=95; SBI=96; SDE=99; SDF=100; SDL=101; CSET=102; SIL=104; STE=110; STF=111; STI=112; STL=113; STR=114;
+01901 TEQ=116; TGE=117; TGT=118; TLE=119; TLT=120; TNE=121;
+01902 XOR=123;
+01903 ZEQ=124; ZER=125; ZGE=126; ZGT=127; ZNE=130; ZRF=132; ZRL=133;
+01904 (*+78() BSS=150; CON=151; EEND=152; EXC=154; EXP=155; HOL=156; MES=159; PRO=160; ROM=161; ()+78*)
+01907 EOOPNDS=255;
+01908 ()+24*)
+01909 (*-24()
+01910 ADF='ADF';ADI='ADI';ADP='ADP';CAND='AND';ASP='ASP';BEQ='BEQ';BGE='BGE';BGT='BGT';BLE='BLE';BLT='BLT';BNE='BNE';BRA='BRA';
+01911 CAI='CAI';CAL='CAL';CFF='CFF';CIF='CIF';CIU='CIU';CMF='CMF';CMI='CMI';CMU='CMU';COM='COM';CSA='CSA';
+01912 DUP='DUP';DVF='DVF';DVI='DVI';EXG='EXG';GTO='GTO';INC='INC';INL='INL';IOR='IOR';
+01913 LAE='LAE';LAL='LAL';LAR='LAR';LDC='LDC';LDE='LDE';LDF='LDF';LDL='LDL';LFR='LFR';LIL='LIL';LIN='LIN';LOC='LOC';
+01914 LOE='LOE';LOF='LOF';LOI='LOI';LOL='LOL';LOR='LOR';LOS='LOS';LPB='LPB';LPI='LPI';LXA='LXA';LXL='LXL';
+01915 MLF='MLF';MLI='MLI';NGF='NGF';NGI='NGI';NOP='NOP';RET='RET';ROL='ROL';
+01916 SBF='SBF';SBI='SBI';SDE='SDE';SDF='SDF';SDL='SDL';CSET='SET';SIL='SIL';STE='STE';STR='STR';STF='STF';STI='STI';STL='STL';
+01917 TEQ='TEQ';TGE='TGE';TGT='TGT';TLE='TLE';TLT='TLT';TNE='TNE';
+01918 XOR='XOR';
+01919 ZEQ='ZEQ';ZER='ZER';ZGE='ZGE';ZGT='ZGT';ZNE='ZNE';ZRF='ZRF';ZRL='ZRL';
+01920 BSS='BSS';CON='CON';EEND='END';EXC='EXC';EXP='EXP';HOL='HOL';MES='MES';PRO='PRO';ROM='ROM';
+01922 EOOPNDS=' ';
+01923 ()-24*)
+01924 (**)
+01925 CPACTLCL=241; CPACTGBL=242; CPACTCONS=245; CPACTLBL=248; CPACTPNAM=249; CPACTSTRNG=250; CPACTINT=251; CPACTUNS=252; CPACTFLOAT=253;
+01931 (*-19()
+01932 LFC=LOC; LFL=LOL; LFE=LOE; LFF=LOF; SFL=STL; SFE=STE; SFF=STF;
+01933 ()-19*)
+01934 (*+19()
+01935 LFC=LDC; LFL=LDL; LFE=LDE; LFF=LDF; SFL=SDL; SFE=SDE; SFF=SDF;
+01936 ()+19*)
+01990 ()+02*)
+02000 PNOOP=0(*6*);
+02010 (*+75()
+02020 PADD(*6*)=-6; PSUB(*6*)=-12; PMUL(*6*)=-18; PDIV(*6*)=-24; POVER(*2*)=-30; PMOD(*2*)=-32;
+02030 PEXP(*6*)=-34; PEQ(*6*)=-40; PEQCS(*2*)=-46; PEQB(*3*)=-48; PNE(*6*)=-51; PNECS(*2*)=-57; PNEB(*3*)=-59;
+02040 PLT(*4*)=-62; PLTCS(*2*)=-66; PLTBY=-68; PLE(*4*)=-69; PLECS(*2*)=-73; PLEBT(*2*)=-75;
+02050 PGT(*4*)=-77; PGTCS(*2*)=-81; PGTBY=-83; PGE(*4*)=-84; PGECS(*2*)=-88; PGEBT(*2*)=-90;
+02060 PCAT(*2*)=-92; (*SEE LATER(2)=-94;*) PPLSAB(*6*)=-96; PPLSABS(*2*)=-102; PPLSTOCS(*2*)=-104;
+02070 PMINUSAB(*6*)=-106; PTIMSAB(*6*)=-112; PTIMSABS=-118; PDIVAB(*4*)=-119; POVERAB(*2*)=-123;
+02080 PMODAB(*2*)=-125; PANDB(*2*)=-127; PORB(*2*)=-129; PUPB=-131; PUPBM=-132; PUPBMSTR=-133;
+02090 PLWB=-134; PLWBM=-135; PLWBMSTR=-136; PSHL=-137; PSHR=-138;
+02100 PELMBT=-139; PELMBY=-140; PMULCI(*2*)=-141; PMULIC(*2*)=-143; PPLITM(*2*)=-145;
+02110 PNEGI(*6*)=-147; PABSI(*6*)=-153; (*SPARE=-159;*) PABSB(*2*)=-160; PABSCH=-162;
+02120 PNOTB(*2*)=-163; PARG(*2*)=-165; PCONJ(*2*)=-167; PENTI(*2*)=-169;
+02130 PROUN(*2*)=-171; PODD(*2*)=-173; PLENGI=-175; PLENGR=-176; PLENGC=-177;
+02140 PSHRTI=-178; PSHRTR=-179; PSHRTC=-180; PSGNI(*4*)=-181; PREPR=-185; PBIN=-186;
+02150 PRE=-187; PIM=-188;
+02160 ()+75*)
+02170 PNONE=-189;
+02180 (*+76()
+02182 PDUP1PILE=-94; PDUP2PILE=-95; (* THESE SHOULD BE MOVED AT NEXT OPPORTUNITY*)
+02190 PSELECT(*3*)=1; PSTRNGSLICE(*2*)=4; PSTARTSLICE=6; PSLICE1=7;
+02200 PSLICE2=8; PSLICEN=9; PCASE=10; PJMPF=11; PLPINIT(*4*)=12;
+02210 PRANGENT=16; PRANGEXT(*3*)=17;
+02220 PSCOPEEXT=20; PACTDRMULT=21; PACTDRSTRUCT=22;
+02230 PDCLINIT(*4*)=23; PCREATEREF(*4*)=27; PPARM=31; PCHECKDESC=32; PDCLSP(*4*)=33; PLOADRT=37;
+02240 PBOUNDS=38; PENVCHAIN(*2*)=39; PVARLISTEND(*2*)=41; PCASJMP(*2*)=43; PSCOPETT(*5, BUT 1ST 2 NOT USED*)=43;
+02250 PASSIGTT(*5*)=48; PSCOPETN=53; PASSIGTN=54; POUTJUMP=55; PSCOPENT(*5, BUT 1ST 2 NOT USED*)=55;
+02260 PASSIGNT(*4*)=60; PRECGEN=64; PSCOPENN=65; PASSIGNN=66; PSCOPEVAR(*3*)=67; PLOADVAR(*3*)=70;
+02270 PDUP1ST(*2*)=73; PDUP2ND(*4*)=75; PGETTOTAL(*5*)=79;
+02280 ()+76*)
+02290 PIDTYREL(*2*)=84; PDEREF(*5*)=86;
+02300 PVOIDNAKED=91; PSKIP(*3*)=92; PSKIPSTRUCT=95; PNIL=96;
+02310 PPUSH(*3*)=97; PVOIDNORMAL=100; PDATALIST=101; PWIDEN(*8*)=102;
+02320 PROWNONMULT=110; PROWMULT=111;
+02330 (*+76()
+02340 PCALL=112; PRETURN=113;
+02350 PRNSTART=114; PLPINCR(*2*)=115; PLPTEST=117; PGBSTK=118; PLEAPGEN(*6*)=119;
+02360 PGETTOTCMN(*3*)=125; PSELECTROW=128; PHOIST=129; PPREPSTRDISP=130; PPREPROWDISP(*2*)=131;
+02370 PCOLLTOTAL(*5*)=133; PCOLLNAKED=138; PCOLLCHECK=139; PPEND=140;
+02380 PLINE=141; PENDSLICE=142; PTRIM(*10*)=143; PJMP=153; PGETOUT=154;
+02390 PGETMULT(*2*)=155; PNAKEDPTR=157; PPBEGIN(*2*)=158; PCASCOUNT=160; PLOADRTP=161;
+02400 PASGVART(*9*)=162; PPASC(*4*)=171;
+02410 PPUSHIM(*4*)=175; PSETIB=179; PGETPROC(*2*)=180; PASP=182;
+02420 PFIXRG(*2*)=183;PDECM(*2*)=185;PCALLA(*3*)=187;
+02430 (*+02() PSWAP(*4*)=190; ()+02*)
+02440 (*+05() PSWAP=190; PHEAVE=191; PSTKTOE(*3*)=192; PALIGN=195; PDISCARD=196; ()+05*)
+02450 (*+01() PSWAP=190; PLOADX0IM(*2*)=191;PLOADX1IM(*2*)=193;PLOADX2IM(*2*)=195;PLOADX3IM(*2*)=197;PLOADX4IM(*2*)=199;
+02460 PSTATICLINK=201; PPOP=202;
+02470 ()+01*)
+02480 ()+76*)
+02490 (*+01() (*-61() PLAST=363; ()-61*) (*+61() PLAST=419; ()+61*) ()+01*)
+02500 (*+02() (*-61() PLAST=350; ()-61*) (*+61() PLAST=365; ()+61*) ()+02*)
+02504 (*+05() PLAST=400; ()+05*)
+02510 (**)
+02520 (*-76() PENVCHAIN=39; PSWAP=129; PPEND=140; PJMP=153; PPUSHIM=175; ()-76*)
+02530 (**)
+02540 (*+01()
+02550 LOADMARGIN=8; (*ALLOW ROOM ABOVE FIELDLENGTH NEEDED BY LOADER*)
+02560 ABSMARGIN=500B; (*ADDITIONAL FL NEEDED BY ABSOLUTE LOAD OVER & ABOVE FL NEEDED BY RELOCATEABLE
+02570 LOAD OF THE SAME PROGRAM. 500B IS NEEDED BECAUSE OF APPARENT BUG IN NOS1.4-531*)
+02580 ()+01*)
+02590 (*+25()
+02600 LOADMARGIN=8; (*ALLOW ROOM ABOVE FIELDLENGTH NEEDED BY LOADER*)
+02610 ABSMARGIN=320; (*ADDITIONAL FL NEEDED BY ABSOLUTE LOAD OVER & ABOVE FL NEEDED BY RELOCATEABLE
+02620 LOAD OF THE SAME PROGRAM. 500B IS NEEDED BECAUSE OF APPARENT BUG IN NOS1.4-531*)
+02630 ()+25*)
+02640 (*+05() LASTRNLEVEL=9; ()+05*)
+02650 (**)
+02660 (*SEMANTIC ROUTINES*)
+02670 (*******************)
+02680 (**)
+02690 SRSTKSIZE=40; (*SIZE OF SEMANTIC STACK*)
+02700 (*+01()
+02710 SZWORD=1; SZADDR=1; SZINT=1; SZREAL=1; SZLONG=2; SZNAKED=1; SZDL=1; SZPROC=1; SZTERM=2;
+02720 (*SIZES OF OBJECTS IN ADDRESSING UNITS*)
+02730 SIZIBTOP=0; (*SHOULD PROBABLY BE ABOLISHED*)
+02740 SIZIBBASE=10; (*SIZE OF INVBL BASE*)
+02750 SIZLEBBASE=4; (*SIZE OF LOCAL ENVIRONMENT BASE*)
+02760 PARAMOFFSET=0;
+02770 LOOPOFFSET=0; (*OFFSET OF LOOPCOUNT WITHIN CURRENT RGBLOCK*)
+02780 RGOFFSET=3; (*OFFSET OF RGLASTUSED WITHIN CURRENT RGBLOCK*)
+02790 ()+01*)
+02800 (*+03()
+02810 SZWORD=1; SZADDR=1; SZINT=1; SZREAL=3; (*SZLONG*) SZNAKED=3; SZDL=2; SZPROC=1; SZTERM=8;
+02820 (*SIZE OF OBJECTS IN ADDRESSING UNITS*)
+02830 SIZIBTOP=0;
+02840 SIZIBBASE=20;
+02850 SIZLEBBASE=6;
+02860 ()+03*)
+02870 (*+02() (*+12() (*-19()
+02880 SZWORD=2; SZADDR=2; SZINT=2; SZREAL=8; SZLONG=4; SZNAKED=4; SZDL=2; SZPROC=4; SZTERM=16;
+02890 (*SIZE OF OBJECTS IN ADDRESSING UNITS*)
+02900 SIZIBTOP=0;
+02910 SIZIBBASE=999;
+02920 SIZLEBBASE=888;
+02930 ()-19*)
+02931 (*+19()
+02932 SZWORD=2; SZADDR=4; SZINT=2; SZREAL=8; SZLONG=4; SZNAKED=8; SZDL=2; SZPROC=8; SZTERM=16;
+02933 SIZIBTOP=0;
+02934 SIZIBBASE=12; (* SAME AS RUN TIME IBCONST *)
+02935 SIZLEBBASE=20; (* SIZE OF A RANGEBLOCK, SAME AS RUN TIME RGCONST *)
+02936 RGOFFSET=4; (* OFFSET TO RG(LASTUSED/NEXTFREE) FROM CURLEB *)
+02937 LOOPOFFSET=20; (* OFFSET TO LOOPCOUNT FROM CURLEB *)
+02938 PARAMOFFSET=14; (* AMOUNT TO ADD TO GET AT ACTUAL PARAMS, AFTER BITPATTERN *)
+02939 ()+19*) ()+12*)
+02940 (*+13()
+02941 SZWORD=4; SZADDR=4; SZINT=4; SZREAL=8; SZLONG=4; SZNAKED=8; SZDL=4; SZPROC=8; SZTERM=16;
+02942 SIZIBTOP=0;
+02943 SIZIBBASE=20;
+02944 SIZLEBBASE=24;
+02945 RGOFFSET=4;
+02946 LOOPOFFSET=24;
+02947 PARAMOFFSET=16;
+02948 ()+13*) ()+02*)
+02949 (*+04()
+02950 SZWORD=1; SZADDR=2; SZINT=2; SZREAL=4; SZLONG=2; SZNAKED=4; SZDL=3; SZPROC=1; SZTERM=8;
+02960 (*SIZE OF OBJECTS IN ADDRESSING UNITS*)
+02970 SIZIBTOP=0;
+02980 SIZIBBASE=999;
+02990 SIZLEBBASE=888;
+03000 ()+04*)
+03010 (*+05()
+03020 SZWORD=2; SZADDR=2; SZINT=2; SZREAL=4; SZLONG=4; SZNAKED=4; SZDL=4; SZPROC=4; SZTERM=16;
+03030 SIZIBTOP=0;
+03040 SIZIBBASE=12;
+03050 PARAMOFFSET=12;
+03060 SIZLEBBASE=12;
+03062 LOOPOFFSET=12;
+03064 RGOFFSET=2;
+03070 ()+05*)
+03080 (*+76() DLACTION=4; DLUNITS=8; ()+76*) (*+74() DLVAREMPTY=1; DLSTRUCT=4; DLMULT=6; ()+74*)
+03090 DLASCR=12; (* DLBNDS=10; DLDESC=11; *)
+03100 (*STATES*)
+03110 (*+74()
+03120 XINT=0; XLINT=1; XREAL=2; XLREAL=3; XCOMPL=4; XLCOMPL=5;
+03130 XCHAR=6; XSTRNG=7;
+03140 XBOOL=8; XBITS=9; XBYTES=10;
+03150 ()+74*)
+03160 (**)
+03170 (**)
+03180 (*PARSING*)
+03190 (*********)
+03200 (**)
+03210 SRPLSTKSIZE=80; (*SIZE OF PARSER STACK*)
+03220 PRODLEN=407;
+03230 (**)
+03240 (**)
+03250 TYPE (*TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE*)
+03260 (**)
+03270 (*MISCELLANEOUS*)
+03280 (***************)
+03290 (**)
+03300 (*+01() A68INT=INTEGER; A68LONG = RECORD V1: INTEGER; V2: INTEGER END; ADDRINT=INTEGER; ()+01*)
+03310 (*+02() (*+12()
+03320 (*-19() A68INT=INTEGER; A68LONG=LONG; ADDRINT=INTEGER; ()-19*)
+03325 (*+19() A68INT=INTEGER; A68LONG=LONG; ADDRINT=LONG; ()+19*) ()+12*)
+03326 (*+13() A68INT=INTEGER; A68LONG=INTEGER; ADDRINT=INTEGER; ()+13*)
+03330 ()+02*)
+03340 (*+03() A68INT=INTEGER; A68LONG=REAL; ADDRINT=INTEGER; ()+03*)
+03350 (*+04() A68INT=LONG; A68LONG=LONG; ADDRINT=LONG; ()+04*)
+03360 (*+05() A68INT=INTEGER; A68LONG=REAL; ADDRINT=INTEGER; ()+05*)
+03370 (*+01() DUMPOBJ=RECORD INT,MASK: INTEGER END; (*FOR A68INIT FILE*) ()+01*)
+03380 (*+25() DUMPOBJ=RECORD INT,MASK: INTEGER END; (*FOR A68INIT FILE*) ()+25*)
+03390 PINTEGER=^INTEGER;
+03400 (*-03()
+03410 LOADFILE=(*+01() SEGMENTED ()+01*) (*+25() SEGMENTED ()+25*)FILE OF ADDRINT;
+03420 (*+01() FYL = SEGMENTED FILE OF CHAR; ()+01*)
+03430 (*-01() FYL = (*+25() SEGMENTED FILE OF CHAR ()+25*) (*-25() TEXT ()-25*); ()-01*)
+03440 ()-03*)
+03450 (*+03()
+03460 LOADFILE=BYTES;
+03470 ()+03*)
+03480 (**)
+03490 SEVERAL=1..10;
+03500 (*+11() BYTE=0..63; ()+11*)
+03510 (*-11() BYTE=0..255; ()-11*)
+03520 (**)
+03530 (*LISTING*)
+03540 (*********)
+03550 (**)
+03560 BUFFER=ARRAY[0..CBUFSIZE] OF CHAR;
+03570 (*+01()
+03580 W66=PACKED RECORD
+03590 FILL1: PACKED ARRAY [1..4] OF CHAR;
+03600 JOPR: 0..7777B;
+03610 FILL2: PACKED ARRAY [1..4] OF CHAR;
+03620 END;
+03630 PW66=^W66;
+03640 ()+01*)
+03650 (*+05() ARGSTRING=PACKED ARRAY [1..50] OF CHAR;
+03652 TIMSTRING=PACKED ARRAY [1..26] OF CHAR;
+03654 ()+05*)
+03660 (*MODE HANDLING*)
+03670 (***************)
+03680 (**)
+03690 (*+11() LABL=-177777B..177777B; ()+11*)
+03700 (*+12() LABL=-32767..32767; ()+12*)
+03710 (*+13() LABL=-32767..32767; ()+13*)
+03720 MDIDTYPE=(MDIDINT, MDIDLINT, MDIDREAL, MDIDLREAL, MDIDCHAR, MDIDBITS, MDIDBYTES, MDIDSTRNG,
+03730 (*ALL THE ABOVE ARE WIDENABLE*)
+03740 MDIDBOOL, MDIDCHAN, MDIDCOVER, MDIDVOID, MDIDSKIP, MDIDJUMP, MDIDNIL,
+03750 MDIDOUT, MDIDIN, MDIDOUTB, MDIDINB, MDIDNUMBER, MDIDROWS,
+03760 (*ALL THE ABOVE ARE UNITED*)
+03770 MDIDBNDS,
+03780 MDIDABSENT, MDIDERROR, MDIDPROC, MDIDREF, MDIDSTRUCT, MDIDROW, MDIDPASC);
+03790 CNTR=0..63; (*POSSIBLE NUMBER OF FIELDS OR PARAMETERS*)
+03800 MDM=PACKED RECORD
+03810 MDID: MDIDTYPE;
+03820 MDLEN: 0..127; (*THE LENGTH OCCUPIED BY THE MODE WHEN IT IS A FIELD OF A STRUCTURE
+03830 - IE ITS UNDRESSED LENGTH*)
+03840 MDDEPROC, MDRECUR, MDDRESSED, MDIO, MDPILE, MDSCOPE: BOOLEAN;
+03850 MDCNT: CNTR;
+03860 END;
+03870 MODE=^MD;
+03880 PLEX=^LEXEME;
+03890 PSB=^SEMBLK;
+03900 PSTB=^STBLOCK;
+03910 (**)
+03920 MD=PACKED RECORD (*MODE TABLE ENTRY*)
+03930 CASE SEVERAL OF
+03940 1:(MDLINK: MODE; (*CHAIN OF MODES OF SAME TYPE*)
+03950 MDV: MDM;
+03960 CASE SEVERAL OF
+03970 1,2,3,6,7,8,9,10: ();
+03980 4: (MDPRRMD: MODE; (*FOR RESULT, REFED TO, OR ROWED MODE*)
+03990 (*+11() (*SHOULD FIT INTO ONE WORD UP TO HERE*) ()+11*)
+04000 MDPRCPRMS: ARRAY[CNTR] OF MODE);
+04010 5: (MDSTRSDB: LABL; (*PTR TO DBLOCK*)
+04020 (*+11() (*SHOULD FIT INTO ONE WORD UP TO HERE*) ()+11*)
+04030 MDSTRFLDS: ARRAY[CNTR] OF PACKED RECORD
+04040 MDSTRFMD: MODE;
+04050 MDSTRFLEX: PLEX;
+04060 END) );
+04070 2:(MDWORDS: ARRAY[1..1] OF INTEGER);
+04080 (*FOR GETTING AT MDPRCPRMS AND MDSTRFLDS.
+04090 IT IS INTENDED THAT ONLY SUFFICIENT WORDS FOR THE PARTICULAR
+04100 MODE WILL BE ALLOCATED*)
+04110 3,4,5,6,7,8,9,10: ()
+04120 END;
+04130 (**)
+04140 STRTYP=(STRNONE, STREMPTY, STRSOFT, STRWEAK,STRMEEK,STRFIRM, STRSTRONG);
+04150 (*COERCION STRENGTHS*)
+04160 CODEPROC=(PROC, PASC); (*FOR PASCAL PROCEDURES OR OTHERWISE*)
+04170 (**)
+04180 (**)
+04190 (*CODES FOR SEMANTIC ROUTINES*)
+04200 (*****************************)
+04210 (**)
+04220 RTNTYPE = 0..245;
+04230 (* SEMANTICROUTINES 10..120,
+04240 ERRORTYPES
+04250 ELX 121..129,
+04260 ESY 130..172,
+04270 ESE 173..245 *)
+04280 (**)
+04290 (**)
+04300 (*LEXICAL ANALYSIS*)
+04310 (******************)
+04320 (**)
+04330 (*-01() ALFA=PACKED ARRAY [1..10] OF CHAR;()-01*)
+04331 BIGALFA = PACKED RECORD
+04332 (*+01() CASE SEVERAL OF 1: ( ()+01*)
+04335 ALF: ALFA; (*+01() ); 2: ( DUMMY: PACKED ARRAY[1..8] OF CHAR; ()+01*)
+04336 IDSIZE:BYTE;
+04337 XMODE:BYTE;
+04338 (*+01() ) ; 3,4,5,6,7,8,9,10 : (); ()+01*)
+04339 END;
+04340 CL0TYPE=0..1; CL1TYPE=0..4; CL2TYPE=0..15;
+04350 (*LEXEME CLASSES*)
+04360 (*+73()
+04370 LXIOTYPE=(LXIODUMMY,
+04380 (*NONTERMINALS*)
+04390 LXIOACTPL, LXIOACTRL,
+04400 LXIOBOUNDS, LXIOBRINPT, LXIOBRTHPT,
+04410 LXIOCSTICK,
+04420 LXIODCLL,
+04430 LXIOFLDSPL, LXIOFORDCL, LXIOFORRLB,
+04440 LXIOIDEFL,
+04450 LXIOLABSQ,
+04460 LXIOMOIDDR,
+04470 LXIONONRDR,
+04480 LXIOODEFL, LXIOOPRAND,
+04490 LXIOPRIM, LXIOPRMDRL,
+04500 LXIORIDEFL, LXIORODEFL, LXIORSPEC, LXIORVDEFL,
+04510 LXIOTERT, LXIOTRMSCL,
+04520 LXIOUNLC, LXIOUNLP, LXIOUNSR,
+04530 LXIOVDEFL,
+04540 (*TERMINALS*)
+04550 LXIOAGAIN, LXIOAT,
+04560 LXIOBECOM, LXIOBEGIN, LXIOBOOLDEN, LXIOBY,
+04570 LXIOCASE, LXIOCMMENT,
+04580 LXIODO,
+04590 LXIOELIF, LXIOELSE, LXIOEND, LXIOEQUAL, LXIOERROR, LXIOESAC, LXIOEXIT,
+04600 LXIOFI, LXIOFOR, LXIOFROM,
+04610 LXIOGO, LXIOGOTO,
+04620 LXIOHEAP,
+04630 LXIOIDTY, LXIOIF, LXIOIN,
+04640 LXIOLOC,
+04650 LXIOMODE,
+04660 LXIONIL,
+04670 LXIOOD, LXIOOF, LXIOOP, LXIOOPR, LXIOOUSE, LXIOOUT,
+04680 LXIOPRAGMAT, LXIOPRDEN, LXIOPRIO,
+04690 LXIOSEMIC, LXIOSKIP, LXIOSTART, LXIOSTOP, LXIOSTICK, LXIOSTRGDEN,
+04700 LXIOTHEN, LXIOTO,
+04710 LXIOWHILE,
+04720 LXIOBUS, LXIOCLOSE, LXIOCOLON, LXIOCOMMA, LXIOLONG, LXIOMDIND, LXIOOPEN, LXIOOTHDR, LXIOPRDR,
+04730 LXIOPROC, LXIOREF, LXIOSHORT, LXIOSTRUCT, LXIOSUB, LXIOTAB, LXIOTAG, LXIOVOID);
+04740 (*THOSE IN THE LAST TWO LINES ARE SPECIALLY SEGREGATED FOR AR2*)
+04750 ()+73*)
+04760 (*-73() LXIOTYPE=0..127; ()-73*)
+04770 LXM=PACKED RECORD (*SHOULD OCCUPY 1 WORD*)
+04780 LXIO: LXIOTYPE; (*LEXEME VALUE*)
+04790 LXCLASS0: CL0TYPE; LXCLASS1: CL1TYPE; LXCLASS2: CL2TYPE;
+04800 CASE SEVERAL OF
+04810 (*+11() 1:(LXP: 0..777777B); ()+11*)
+04820 (*+12() 1:(LXP: 0..32767); ()+12*)
+04830 (*+13() 1:(LXP: 0..32767); ()+13*)
+04840 2:(LXPSTB: PSTB);
+04850 3:(LXPSB: PSB);
+04860 4:(LXPMD: MODE);
+04870 5:(LXPYPTR: LABL);
+04880 6:(LXPRTN: RTNTYPE); (*FOR PARSER GENERATOR ONLY*)
+04890 7:(LXPIO: LXIOTYPE); (*FOR PARSER GENERATOR ONLY*)
+04900 8,9,10:();
+04910 END;
+04920 (**)
+04930 LEXEME=PACKED RECORD
+04940 CASE SEVERAL OF
+04950 1:(LXV: LXM; (*THE ONLY FIELD FOR SIMPLE LEXEMES*)
+04960 LXTOKEN: (TKTAG, TKBOLD, TKDENOT, TKSYMBOL);
+04970 (*MEANING OF STRING*)
+04980 LXCOUNT: 0..TAXLENWD; (*WORDS IN STRING*)
+04990 LINK: PLEX; (*HASH TABLE CHAINING*)
+05000 CASE SEVERAL OF
+05010 1:(WORD1: A68INT );
+05020 2:( S10,S20: ALFA );
+05030 4:(INTEGERS: ARRAY [1..TAXLENWD] OF A68INT);
+05040 (*+11() 6:(FUDGE1, FUDGE2: 0..1073741823);
+05050 7:(FUDGE: PACKED ARRAY [1..TAXLENWD2] OF 0..1073741823);
+05060 (*HALF WORDS FOR HASHING*)
+05070 ()+11*)
+05080 (*-11() 6,7: (); ()-11*)
+05090 8:(STRNG: PACKED ARRAY [1..TAXLEN] OF CHAR);
+05100 (*AS SINGLE CHARS*)
+05110 9:(LXDENMD: MODE; LXDENRP: A68INT);
+05120 (*ANOTHER VIEW OF S1, FOR DENOTATIONS*)
+05130 10:( INSTEADLXDENMD: MODE ; LXDENRPREAL: REAL) ;
+05140 3,5:() );
+05150 2:(LEXWORDS: ARRAY [1..1] OF A68INT); (*FOR COPYING WHOLE LEXEMES*)
+05160 3,4,5,6,7,8,9,10:()
+05170 END;
+05180 HASHTAB=ARRAY [0..HTSIZE] OF PLEX;
+05190 OPCHTABBOUND=0..46; (*BOUNDS OF OPCHTABLE*)
+05200 (*+72() INDEXTYPE=(CONTROL, EOL, SPACE, ERRCH, DIGIT, POINT, QUOTE,
+05210 PUNCT, PLSMIN, LETTER, STROP, EOFF, PRAG); ()+72*)
+05220 (*-72() INDEXTYPE=0..12; ()-72*)
+05230 TYPETYPE=SET OF (HEX, LOWC, UPC, DIG);
+05240 (**)
+05250 (**)
+05260 (*CODE EMITTER*)
+05270 (**************)
+05280 (**)
+05290 PMARKCHAIN=^MARKCHAIN;
+05300 STATE=0..32; (*USED AS OPCOD OFFSETS*)
+05310 (*+76()
+05320 MARKCHAIN=PACKED RECORD
+05330 MKXPTR: LABL;
+05340 LINK: PMARKCHAIN
+05350 END;
+05360 ()+76*)
+05370 (*-76() (*-02() MARKCHAIN = INTEGER; ()-02*)
+05375 (*+02() MARKCHAIN = PACKED RECORD A:INTEGER;B:ADDRINT END; ()+02*) ()-76*)
+05380 OLSTTYP=ARRAY[0..5] OF PACKED RECORD DP: BOOLEAN; OVAL: STATE END;
+05390 POP=PNONE..PLAST;
+05400 (**)
+05410 (*+01()
+05420 RELOCBASE=0..777B;
+05430 CBUFPTRS=0..127;
+05440 CODEBUF=RECORD
+05450 BUFFER: ARRAY [CBUFPTRS] OF RECORD CASE SEVERAL OF
+05460 1:(CODEWORD: INTEGER); 2:(ALFWORD: ALFA); 3,4,5,6,7,8,9,10:() END;
+05470 FIRST, LAST: CBUFPTRS;
+05480 RELOCATION: INTEGER;
+05490 SEGLOC: LABL;
+05500 FOUR: 1..5; FIFTEEN: 1..15;
+05510 HEADERWORD: PACKED RECORD
+05520 CASE INTEGER OF
+05530 1: (TN, WC: 0..7777B;
+05540 FILLER: 0..777B;
+05550 R: RELOCBASE;
+05560 S: 0..777777B);
+05570 2: (WORD: INTEGER)
+05580 END
+05590 END;
+05600 (**)
+05610 PFILLCHAIN=^FILLCHAIN;
+05620 FILLCHAIN=PACKED RECORD
+05630 FSEGLOC: LABL;
+05640 FFOUR: 1..4;
+05650 COUNT: 0..31;
+05660 LINK: PFILLCHAIN
+05670 END;
+05680 PFCHAIN=^FCHAIN;
+05690 FCHAIN=PACKED RECORD
+05700 FLAST: CBUFPTRS;
+05710 FFOUR: 1..4; FFIFTEEN: 1..15;
+05720 FSEGLOC, FLABL: LABL;
+05730 LINK: PFCHAIN
+05740 END;
+05750 (**)
+05760 SBTTYP=(SBTVOID,SBTID,SBTIDV,SBTLIT,SBTVAR,SBTDEN,SBTPROC,SBTRPROC,SBTSTK,(*+61()SBTSTK2,()+61*)SBTSTKN,SBTDL,
+05770 (*+61() SBTX12, SBTX45, ()+61*)
+05780 SBTX5,SBTX6,SBTX0,SBTX1,SBTXN);
+05790 (*SBTSTKN IS AN ARBITRARY STACK ITEM; STBXN IS AN ARBITRARY REGISTER(?) ITEM*)
+05800 (*SBTDL IS FOR DATA LISTS, WHICH ARE REALLY ON THE STACK BUT MAY START IN A REGISTER*)
+05810 SUBSBTTYP=SBTX5..SBTX1;
+05820 REGUSETYP=SET OF SUBSBTTYP;
+05830 ()+01*)
+05840 (*+02()
+05850 SBTTYP=(SBTVOID,SBTID,SBTIDV,SBTVAR,SBTLIT,SBTDEN,SBTPROC,SBTRPROC,SBTSTK,SBTSTK2,SBTSTK2A,SBTSTK4,SBTSTKN,SBTDL,
+05860 SBTPR1,SBTPR2,SBTPRR,SBTXN);
+05870 ()+02*)
+05880 (*+03()
+05890 SBTTYP=(SBTVOID,SBTID,SBTIDV,SBTVAR,SBTLIT,SBTDEN,SBTPROC,SBTRPROC,SBTSTK,SBTSTKN,SBTDL,SBTX0,SBTX1,SBTXN);
+05900 SUBSBTTYP=SBTX0..SBTX1;
+05910 REGUSETYP=SET OF SUBSBTTYP;
+05920 ()+03*)
+05930 (*+04()
+05940 SBTTYP=(SBTVOID,SBTID,SBTIDV,SBTVAR,SBTLIT,SBTDEN,SBTPROC,SBTRPROC,SBTSTK,SBTSTKN,SBTDL,SBTXN);
+05950 ()+04*)
+05960 (*+05()
+05970 SBTTYP=(SBTVOID,SBTID,SBTIDV,SBTVAR,SBTLIT,SBTDEN,SBTPROC,SBTRPROC,SBTSTK,SBTSTK4,SBTSTKR0,SBTSTKN,SBTDL,
+05980 SBTPR1,SBTPR2,SBTE,SBTER0,SBTFPR0,SBTFPR1,SBTFPR2,SBTFPR3,SBTXN);
+05990 SUBSBTTYP=SBTE..SBTFPR3;
+06000 REGUSETYP=PACKED RECORD
+06010 ECOUNT: 0..8;
+06020 EEXTRA: 0..8;
+06030 FPR: SET OF SUBSBTTYP
+06040 END;
+06050 ()+05*)
+06060 (*-23()
+06070 (*+01()
+06080 CODETYP=PACKED RECORD
+06090 P1, P2, PR : SBTTYP;
+06100 CASE INLINE: BOOLEAN OF
+06110 TRUE: (
+06120 LEN: (F0, F15, F30, F30K);
+06130 FMIJK: 0..7777777777B;
+06140 REL: -177777B..177777B; (*FOR RELATIVE JUMPS*)
+06150 NEXT: POP);
+06160 FALSE: (
+06170 ROUTINE: PACKED ARRAY [1..RTNLENGTH] OF CHAR;
+06180 LINKINS: PFILLCHAIN)
+06190 END;
+06200 ()+01*)
+06210 (*+02()
+06220 (*+24() COMPACT = 0..161; ()+24*)
+06230 (*-24() COMPACT = PACKED ARRAY [1..3] OF CHAR; ()-24*)
+06240 (*+78()PARAMTYPES = (OPX,ONX,OPL,ONL,LCX,GBX,WOP,WNP,WLB,NON,JMP,MOR,ACP,ANP,ACB,ACX,ANX,ACL,ANL);
+06250 CODETYP = PACKED RECORD
+06260 P1,P2,PR:SBTTYP;
+06270 CASE INLINE:BOOLEAN OF
+06280 TRUE : (EMCOD : COMPACT;
+06290 PARTYP:PARAMTYPES;
+06300 NEXT : POP;
+06310 PARM : -32767..32767 );
+06320 FALSE: (ROUTINE : PACKED ARRAY [1..RTNLENGTH] OF CHAR);
+06330 END; ()+78*)
+06340 (*-78() (*-24() CODETYP=PACKED ARRAY [1..14] OF CHAR ; ()-24*)
+06342 (*+24() CODETYP=PACKED ARRAY [1..12] OF CHAR ; ()+24*) ()-78*)
+06350 ()+02*)
+06360 (*+03()
+06370 ROUTNAME=PACKED ARRAY [1..RTNLENGTH] OF CHAR;
+06380 CODETYP=PACKED RECORD
+06390 P1, P2, PR: SBTTYP;
+06400 CASE INLINE: BOOLEAN OF
+06410 TRUE:(NEXT: POP;
+06420 CASE SEVERAL OF
+06430 1: (FUN:INTEGER);
+06440 2: (FDISP: 0..127;
+06450 FSIGN: 0..1;
+06460 FMODE: 0..7;
+06470 FCODE: 0..31);
+06480 3: (FILL1: 0..63;
+06490 FBITS: 0..3;
+06500 FILL2: 0..255);
+06510 4,5,6,7,8,9,10: ());
+06520 FALSE:(ROUTINE: ROUTNAME)
+06530 END;
+06540 ()+03*)
+06550 (*+05()
+06560 (*-24() MNEMONICS = PACKED ARRAY[1..8] OF CHAR; ()-24*)
+06570 (*+78() PARAMTYPES = (OPX,ONX,LCX,GBX,WOP,WNP,NON,JMP,MOR,ANP,ACP,ACX,ANX);
+06580 CODETYP = PACKED RECORD
+06590 P1,P2,PR:SBTTYP;
+06600 CASE INLINE:BOOLEAN OF
+06610 TRUE : (PERQCOD : MNEMONICS;
+06620 PARTYP:PARAMTYPES;
+06630 PARM : BYTE;
+06640 NEXT : POP; );
+06650 FALSE: (ROUTINE : PACKED ARRAY [1..RTNLENGTH] OF CHAR);
+06660 END; ()+78*)
+06670 (*-78() CODETYP = ARRAY[1..4] OF INTEGER; ()-78*)
+06680 ()+05*)
+06690 ()-23*)
+06700 (*+23()
+06710 CODETYP=PACKED RECORD
+06720 ROUTINE:ALFA;
+06730 PR:SBTTYP
+06740 END;
+06750 ()+23*)
+06760 SBTTYPSET=SET OF SBTTYP;
+06770 (**)
+06780 (**)
+06790 (*CODE GENERATOR*)
+06800 (****************)
+06810 (**)
+06820 (**)
+06830 OPDTYP=(OCVNONE, OCVIMMED, OCVIMMLONG, OCVIMMPTR, OCVLCLGBL,
+06835 OCVMEM, OCVEXT, OCVFREF, OCVLIT, OCVFIM, OCVRES, OCVSB, OCVSBP, OCVSBS);
+06840 (**)
+06850 (**)
+06860 (*SEMANTIC ROUTINES*)
+06870 (*******************)
+06880 (**)
+06890 (*+11()
+06900 DEPTHR=0..4095; (*DEPTH TO WHICH RANGES ETC. ARE NESTED*)
+06910 OFFSETR=-4095..4096; (*FOR OFFSETS WITHIN INVOCATION BLOCKS*)
+06920 ()+11*)
+06930 (*+12()
+06940 (*-02()
+06950 DEPTHR=0..127;
+06960 OFFSETR=-256..255;
+06970 ()-02*)
+06980 (*+02()
+06990 DEPTHR=0..255;
+07000 OFFSETR=INTEGER;
+07010 ()+02*)
+07020 ()+12*)
+07030 (*+13()
+07040 DEPTHR=0..255;
+07050 OFFSETR=-256..250;
+07060 ()+13*)
+07070 (*-61() STDOPTYP=0..70; ()-61*) (*FOR OPTABL*)
+07080 (*+61() STDOPTYP=0..76; ()+61*)
+07090 DEFTYP= (*PROPERTIES OF STBLOCK*)
+07100 SET OF (STINIT, STVAR, STCONST, STRCONST, STRECUR, STUSED (*+05(),DUM6,DUM7,DUM8()+05*) );
+07110 BLKTYP= (*TYPES OF STBLOCK*)
+07120 (STBDEFID, STBDEFLAB, STBDEFMI, STBDEFPRIO, STBDEFOP,
+07130 STBNONE,
+07140 STBAPPID, STBAPPLAB, STBAPPMI, STBAPPOP);
+07150 (**)
+07160 PROUTN=^ROUTN;
+07170 ROUTN=(*-04()PACKED()-04*) RECORD (*PROPERTIES OF CURRENT ROUTINE*)
+07180 RNLINK: PROUTN; (*TO PREVIOUS ROUTN*)
+07190 RNLOCRG, (*CURRENT DEPTH OF LOCAL RANGES WITHIN THIS ROUTINE*)
+07200 RNLEVEL: DEPTHR; (*DEPTH OF THIS ROUTINE*)
+07210 RNNECLOCRG: DEPTHR; (*LOCAL RANGE DEPTH WITHIN RNNECLEV OF NECESSARY ENVIRON*)
+07220 RNNECLEV: DEPTHR; (*ROUTINE DEPTH OF NECESSARY ENVIRON*)
+07230 RNSTKDEPTH: OFFSETR;
+07240 RNRTSTACK: PSB; (*RTSTACK ON ROUTINE ENTRY*)
+07250 RNCURID: OFFSETR; (*FOR PREVIOUS ROUTN*)
+07260 RNNONIC: DEPTHR; (*NO. OF ROUTNCHAINS REFERRING TO THIS ROUTN*)
+07270 RNLENSTK: OFFSETR; (*MAXIMUM STACK DEPTH*)
+07280 RNLENIDS: OFFSETR; (*MAXIMUM SPACE FOR LOCALS*)
+07290 RNMODE: MODE; (*RESULT MODE*)
+07300 RNPARAMS: OFFSETR; (*SPACE OCCUPIED BY PARAMETERS*)
+07302 RNIDBLK: LABL; (*IDBLOCK FOR PARAMETERS RANGE*)
+07304 RNLEX: PLEX; (*IDENTIFIER OF ROUTINE (NIL IF ANONYMOUS)*)
+07310 RNADDRESS: LABL; (*ENTRY POINT*)
+07320 RNPROCBLK: LABL; (*ADDRESS OF PROCBLOCK*)
+07330 (*-02()(*-04() RNREGSINUSE: REGUSETYP (*RESERVE STATE OF REGS BEFORE ROUTINE-TEXT*) ()-04*)()-02*)
+07340 END;
+07350 (**)
+07360 PROUTNCHAIN=^ROUTNCHAIN;
+07370 ROUTNCHAIN=PACKED(*PACKED*) RECORD (*CHAIN OF ROUTNS STARTING FROM STROUTN OF AN STBLOCK*)
+07380 DATA: PROUTN;
+07390 LINK: PROUTNCHAIN
+07400 END;
+07410 (**)
+07420 STBLOCK=(*-04()PACKED()-04*) RECORD (*SYMBOL TABLE BLOCK*)
+07430 STLINK: PSTB; (*TO PREVIOUS INCARNATION OF INDICATOR*)
+07440 STTHREAD: PSTB; (*CHAIN OF STBLOCKS IN SAME RANGE*)
+07450 STLEX: PLEX; (*LEXEME FOR INDICATOR*)
+07460 STDEFTYP: DEFTYP;
+07470 STRANGE: DEPTHR; (*DEPTH OF RANGE*)
+07480 STLEVEL: DEPTHR; (*DEPTH OF ROUTINE CONTAINING RANGE*)
+07490 STLOCRG: DEPTHR; (*DEPTH OF LOCAL RANGE WITHIN ROUTINE*)
+07500 CASE STBLKTYP: BLKTYP OF
+07510 STBNONE: ();
+07520 STBDEFID, STBDEFMI, STBDEFOP:
+07530 (STMODE: MODE;
+07540 CASE SEVERAL OF
+07550 1:(STPTR:LABL);
+07560 2:(STOFFSET: OFFSETR); (*OFFSET WITHIN INVBL*)
+07570 3:(STVALUE: PLEX); (*FOR CODE PROCS*)
+07580 4,5,6,7,8,9,10:() );
+07590 STBAPPID, STBAPPMI, STBAPPOP:
+07600 (STDEFPTR: PSTB); (*PTR TO DEFINING OCCURRENCE*)
+07610 STBDEFLAB, STBAPPLAB:
+07620 (STROUTN: PROUTNCHAIN;
+07630 STCURID: OFFSETR; (*FOR PREVENTING JUMPS OVER DECLARATIONS*)
+07640 STXPTR: PACKED ARRAY[0..1]OF LABL); (*0 FOR LABEL, 1 FOR JUMPS OUT OF ROUTINES TO IT*)
+07650 STBDEFPRIO:
+07660 (STDYPRIO: 1..11; (*PRIORITY - 10 IS FOR MONADICS, 11 FOR UNDECLARED OPS*)
+07670 STUSERLEX: PLEX;
+07680 STSTDOP: STDOPTYP ) (*POINTER INTO OPTABL, FOR STD OPERATORS*)
+07690 END;
+07700 (**)
+07710 DCLTYP= (*ATTRIBUTES OF RANGES*)
+07720 (DCLCOLL, DCLLOCRNG, DCLPARM, DCLLABEL, DCLPILEDECS,
+07730 DCLLOCGEN, DCLLOOP, DCLDELAY, DCLSAVEDESC, DCLACTDR, DCLPILE, DCLMODEDEF);
+07740 (**)
+07750 PRANGE=^RANGE;
+07760 RANGE=(*-04()PACKED()-04*) RECORD (*PRESERVES PROPERTIES OF PREVIOUS RANGE*)
+07770 RGLINK: PRANGE; (*TO PREVIOUS RANGE*)
+07780 RGINF: SET OF DCLTYP;
+07790 RGSTAT: STATE;
+07800 RGDCIL: PSTB; (*THREAD OF PREVIOUS RANGE*)
+07810 RGLEB: OFFSETR; (*LOCAL ENVIRONMENT BASE OF PREVIOUS LOCAL RANGE*)
+07820 RGDEFN: DEFTYP; (*FROM PREVIOUS LOCAL RANGE*)
+07830 RGMODE, RGPRVMODE: MODE;(*DITTO*)
+07840 RGTODOCOUNT, RGPSCOUNT: DEPTHR; (*DITTO*)
+07850 RGPSLABL: LABL; (*DITTO*)
+07860 RGRTSTACK: PSB; (*RTSTACK ON RANGE ENTRY*)
+07870 RGIDBLK: LABL;
+07880 END;
+07890 (**)
+07900 PTRIMCHAIN=^TRIMCHAIN;
+07910 TRIMCHAIN=PACKED(*PACKED*) RECORD
+07920 TRTYPE: 0..9;
+07930 LINK: PTRIMCHAIN
+07940 END;
+07950 SEMBLK=PACKED(*PACKED*) RECORD (*SEMANTIC BLOCK*)
+07960 SBTYP: SBTTYP;
+07970 SBLEN: DEPTHR; (*TO ACCOMODATE A REASONABLE DATA-LIST*)
+07980 SBMODE: MODE;
+07990 SBINF: SET OF (SBMORF, SBVOIDWARN, SBEMPTYBY, SBEMPTYTO, SBLEFTCOLL, SBPILEDECS,
+08000 SBWEAKREF, SBNOREF, SBSTKDELAY, SBNAKED, SBNAKROW, SBCOLL, SBUNION, SBSLN, SBLOCGEN);
+08010 SBDELAYS: DEPTHR;
+08020 SBRTSTK: PSB;
+08030 CASE SEVERAL OF
+08040 1:(SBXPTR: LABL;
+08050 SBCNT: CNTR; (*TO COUNT ACTUAL-PARAMETERS OF PROC*)
+08060 CASE SEVERAL OF
+08070 1:(SBLEX: PLEX);
+08080 2:(SBVALUE: (*+01()LABL()+01*) (*+02()LONG()+02*)
+08082 (*-01()(*-02()A68INT()-02*)()-01*));
+08090 3:(SBOFFSET: OFFSETR;
+08100 SBLOCRG: DEPTHR;
+08110 SBLEVEL: DEPTHR);
+08120 4:(SBBALSTR: STRTYP);
+08130 5,6,7,8,9,10:() );
+08140 2: (SBTRIMS: PTRIMCHAIN;
+08150 SBTRIMCNT,
+08160 SBSLICEDIM: -63..63;
+08170 SBPRIMDIM: 0..63;
+08180 SBUNITS: 0..189);
+08190 3,4,5,6,7,8,9,10:()
+08200 END;
+08210 (**)
+08220 PMODECHAIN=^MODECHAIN;
+08230 MODECHAIN=PACKED(*PACKED*) RECORD (*CHAIN OF MODES STARTING AT SCL*)
+08240 SCMODE: MODE;
+08250 LINK: PMODECHAIN
+08260 END;
+08270 (**)
+08280 XTYPE=-1..14;
+08290 (*+74()
+08300 OPIDNDXTYP=
+08310 (IDIBRM,IDMON,IDMONL, (*MONADIC OPERATORS*)
+08320 IDAA, (*BOTH OPERANDS IN SAME GROUP (EG ARITHMETIC*)
+08330 IDAAL, (*AS IDAA, BUT RESULTMODE MAY BE LENGTHENED*)
+08340 IDBB, (*BOTH OPERANDS TO BE THE SAME*)
+08350 IDBI,IDIB,(*ONE OPERAND IS .INT*)
+08360 IDIBR, (*.UPB AND .LWB*)
+08370 IDSI, (* *:= ON STRINGS*)
+08380 IDSC,IDCS,(* +:= AND +=: ON STRINGS*)
+08390 IDRA (*ASSIGNING OPERATORS*) );
+08400 OPIDBLK=PACKED RECORD
+08410 OPIDNDX: OPIDNDXTYP;
+08420 OPMORE: BOOLEAN; (*IF THERE ARE MORE DEFINITIONS OF THE SAME OPERATOR*)
+08430 OPOPCOD: POP;
+08440 OPMIN,OPMAX: XTYPE; (*RANGE OF ACCEPTABLE MODES*)
+08450 OPMODE: MODE; (*RESULT MODE (MDABSENT IMPLIES RESULT MODE DEDUCED FROM OPERANDS)*)
+08460 END;
+08470 ()+74*)
+08480 (*-74() (*+02() (*+12() (*-19() OPIDBLK=RECORD A,B:REAL (* FOUR WORDS *) END; ()-19*)
+08485 (*+19() OPIDBLK=PACKED RECORD A,B,C,D,E:INTEGER (*5 WORDS?*) END; ()+19*) ()+12*)
+08486 (*+13() OPIDBLK=PACKED RECORD A,B,C:INTEGER; (*THREE WORDS*) END; ()+13*) ()+02*)
+08490 (*+05() OPIDBLK=RECORD A,B,C: INTEGER (*THREE WORDS*) END; ()+05*) ()-74*)
+08500 (**)
+08510 (**)
+08520 (*RUNTIME OBJECTS*)
+08530 (*****************)
+08540 (**)
+08550 BITMAP = PACKED RECORD CASE SEVERAL OF
+08560 1: (
+08570 (*+11()
+08580 FILL: 0..77777777777777B;
+08590 MASK: 0..37777B;
+08600 COUNT: 0..15; );
+08610 ()+11*)
+08620 (*+12()
+08630 (*+03() MASK: 0..7777B; (*DIFFICULTIES ON NORD*)
+08640 COUNT: 0..15; ); ()+03*)
+08641 (*+02() MASK :INTEGER;
+08642 COUNT :INTEGER; ); ()+02*)
+08643 (*-03() (*-02() MASK: -127..127;
+08644 COUNT: 0..255; ); ()-02*) ()-03*)
+08650 ()+12*)
+08660 (*+13() MASK: -32768..32767;
+08670 COUNT: -32768..32767; );
+08680 ()+13*)
+08690 2: (INT: (*-02()A68INT()-02*)(*+02()LONG()+02*); );
+08700 3,4,5,6,7,8,9,10: ()
+08710 END;
+08720 (**)
+08730 (*+77()
+08731 (*+13() CCOUNTRANGE=0..32767; ()+13*)
+08740 OBJECTP=^OBJECT;
+08750 OBJECT=PACKED RECORD
+08760 CASE SEVERAL OF
+08770 1:(FIRSTWORD: INTEGER);
+08780 (*+11()
+08790 2:(PCOUNT: -1..4095;
+08800 SORT: 0..31;
+08820 OSCOPE: DEPTHR;
+08830 LENGTH: 0..4095;
+08832 FILLER: 0..1;
+08835 DBLOCK: OBJECTP);
+08840 ()+11*)
+08850 (*+12()
+08860 2:(PCOUNT: 0..2047;
+08870 SORT: 0..31;
+08880 OSCOPE: DEPTHR;
+08890 LENGTH: 0..511;
+08900 DBLOCK: OBJECTP);
+08910 ()+12*)
+08920 (*+13()
+08930 2:(PCOUNT: 0..32767;
+08940 SORT: 0..31;
+08950 OSCOPE: DEPTHR;
+08960 DBLOCK: OBJECTP
+08961 ANCESTOR: OBJECTP;
+08962 IHEAD: OBJECTP;
+08963 DUMMY: CCOUNTRANGE;
+08964 LENGTH: CCOUNTRANGE);
+08990 ()+13*)
+09000 3,4,5,6,7,8,9,10: ()
+09010 END;
+09020 (**)
+09030 ()+77*)
+09040 (**)
+09050 (*PARSING*)
+09060 (*********)
+09070 (*+72()
+09080 CONFIG=(S, C0, C1, C2, A, SSA);
+09090 (*METHODS OF MATCHING LXVS.
+09100 SSA IS A SPECIAL FRIG FOR MATCHING TWO STACK ITEMS*)
+09110 SYLXVTYP = PACKED RECORD
+09120 CASE BOOLEAN OF
+09130 TRUE: (CASE SEVERAL OF
+09140 1: (LX1IO: LXIOTYPE);
+09150 2: (LX1CL0: CL0TYPE);
+09160 3: (LX1CL1: CL1TYPE);
+09170 4: (LX1CL2: CL2TYPE);
+09180 5,6,7,8,9,10: () );
+09190 FALSE:(FILLER: 0..127;
+09200 CASE SEVERAL OF
+09210 1: (LX2IO: LXIOTYPE);
+09220 2: (LX2CL0: CL0TYPE);
+09230 3: (LX2CL1: CL1TYPE);
+09240 4: (LX2CL2: CL2TYPE);
+09250 5,6,7,8,9,10: () )
+09260 END;
+09270 PROD= PACKED RECORD
+09280 PRSTKA: 0..3;
+09290 PRSTKC: S..C2;
+09300 PRINPC: CONFIG;
+09310 RTN: RTNTYPE;
+09320 SYLXV: SYLXVTYP;
+09330 SEXIT: 0..PRODLEN;
+09340 PRPUSH: LXIODUMMY..LXIOVDEFL; (*A SUBRANGE OF LXIOTYPE*)
+09350 PRSKIP: BOOLEAN;
+09360 FEXIT: 0..PRODLEN;
+09370 PRPOP: 0..5;
+09380 PRSCAN: 0..2;
+09390 END;
+09400 PLEXQ=^LEXQ;
+09410 LEXQ=PACKED RECORD (*CHAIN OF LEXEMES STARTING AT PLINPQ*)
+09420 DATA1: PLEX;
+09430 LINK: PLEXQ
+09440 END;
+09450 ()+72*)
+09460 (**)
+09470 (*-72() (*+02() (*+12() PROD=RECORD A,B,C,D,E,F,G: INTEGER (*SEVEN WORDS*) END; ()+12*)
+09471 (*+13() PROD=RECORD A,B,C,D:INTEGER (*FOUR WORDS*) END; ()+13*) ()+02*)
+09480 (*+05() PROD=RECORD A,B,C,D: INTEGER (*FOUR WORDS*) END; ()+05*) ()-72*)
+09490 (*-72() PLEXQ=^INTEGER; ()-72*)
+09500 (**)
+09510 (*ERROR HANDLING*)
+09520 (****************)
+09530 (**)
+09540 ERRLEV=(ERRORR, WARNING);
+09550 (**)
+09560 (**)
+09570 (*+01() MESS=PACKED ARRAY [1..50] OF CHAR; (*FOR PASCPMD*) ()+01*)
+09580 (*+02() MESS=PACKED ARRAY [1..50] OF CHAR; (*FOR PASCPMD*) ()+02*)
+09590 VAR (*VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR VAR*)
+09600 (**)
+09610 (*FILES*)
+09620 (*******)
+09630 (**)
+09640 (*+01() (*THE FILES MUST BE THE FIRST THINGS DECLARED ON THE STACK,FOR THE BENEFIT OF DUMP*) ()+01*)
+09650 SOURCDECS: TEXT;
+09660 LSTFILE: FYL; (*FILE FOR PROGRAM LISTING, IF ANY*)
+09670 LGO: (*-05() (*-02()LOADFILE; ()-02*) ()-05*)
+09680 (*+02() (*+24() FILE OF BYTE; ()+24*)
+09681 (*-24() TEXT; ()-24*) ()+02*)
+09690 (*+05() ARRAY[0..LASTRNLEVEL] OF TEXT; ()+05*)
+09700 (*+01()
+09710 (*REMARKS: TEXT;*) (*FILE FOR TEMPORARY MONITORING*)
+09720 A68INIT: LOADFILE; (*FOR INITIALIZATION*)
+09730 ()+01*)
+09740 (*+02() A68INIT:LOADFILE ;
+09745 DUMPF : LOADFILE ; ()+02*)
+09750 (*+03()
+09760 OUTPUT: TEXT;
+09770 CPUCLK: INTEGER;
+09780 ()+03*)
+09790 (*+04() OUTPUT: TEXT; ()+04*)
+09800 (*+05() A68INIT: LOADFILE; ()+05*)
+09810 (**)
+09820 (**)
+09830 (*+01()
+09840 CPUCLK: INTEGER;
+09850 (*+22()
+09860 PARSCLK, LXCLOCK, SEMCLK, EMITCLK: INTEGER;
+09870 CPUCLKS, PARSCLKS, LXCLOCKS, SEMCLKS, EMITCLKS: INTEGER;
+09880 ()+22*)
+09890 DUMPED, HEAPSTART, FIELDLENGTH: INTEGER; (*USED BY INITINIT AND RESTORE*)
+09900 FIRSTSTACK: INTEGER; (*TO MARK THE START OF THE DUMPABLE STACK*)
+09910 (**)
+09920 (**)
+09930 ()+01*)
+09940 (*+25()
+09950 DUMPED, HEAPSTART, FIELDLENGTH: INTEGER; (*USED BY INITINIT AND RESTORE*)
+09960 FIRSTSTACK: INTEGER; (*TO MARK THE START OF THE DUMPABLE STACK*)
+09970 ()+25*)
+09980 (*+02() (*-25() FIRSTSTACK:INTEGER; ()-25*) ()+02*)
+09990 (*+05() (*-25() FIRSTSTACK:INTEGER; ()-25*) ()+05*)
+10000 (*LISTING*)
+10010 (*********)
+10020 (**)
+10030 LSTLINE, LEXLINE, PREVLINE: INTEGER; (*SOURCE LINE NUMBER*)
+10040 SRCBUF, ERRBUF: BUFFER;
+10050 (*BUFFERS FOR SOURCE LINE AND ERROR MARKER LINE*)
+10060 SRCPTR, ERRPTR: -1..CBUFSIZE;
+10070 (*POINTERS INTO SRCBUF AND ERRBUF*)
+10080 ONLINE: BOOLEAN;
+10090 LSTCNT: 0..101; (*LISTING LINE NUMBER*)
+10100 LSTPAGE: INTEGER; (*LISTING PAGE NUMBER*)
+10110 (*+01() DAT, TIM: ALFA; (*DATE AND TIME*) ()+01*)
+10112 (*+03() DAT, TIM: ALFA; (*DATE AND TIME*) ()+03*)
+10114 (*+05() TIM: TIMSTRING; (*DATE AND TIME*) ()+05*)
+10120 (*+23() NUMPARAMS:0..5; ()+23*)
+10130 (**)
+10140 (**)
+10150 (*MODE HANDLING*)
+10160 (***************)
+10170 (**)
+10180 REFL, ROWL, PROCL, PASCL, STRUCTL: MODE;
+10190 (*START OF CHAINS OF MODES OF EACH TYPE*)
+10200 MDVREF, MDVROW, MDVPROC, MDVPASC, MDVSTRUCT: MDM;
+10210 (*FOR OTHER MDVS SEE INITIALIZE*)
+10220 MDINT, MDLINT, MDBITS, MDBYTES, MDREAL, MDLREAL, MDBOOL, MDCHAN, MDCHAR,
+10230 MDSTRNG, MDFILE, MDVOID, MDSKIP, MDJUMP, MDNIL, MDCOMPL, MDLCOMPL, MDCOVER,
+10240 MDOUT, MDIN, MDOUTB, MDINB, MDNUMBER, MDROUT, MDROWS, MDBNDS, MDABSENT ,MDERROR, MDREFERROR: MODE;
+10250 (*+54() MDEXC: MODE; ()+54*)
+10260 MODEID: ARRAY[MDIDTYPE] OF -1..14;
+10270 PRCBNDS, PRCVF, PASCVF, PRCERROR: MODE;
+10280 (*PROC RETURNING BOUNDS, PROC(REF FILE) VOID, CODE(REF FILE) VOID, PROC MDERROR*)
+10290 LASTPREF, LASTPROC: MODE;
+10300 LHMODE, RHMODE, LHFIRM, RHFIRM: MODE; (*USED IN OPERATOR IDENTIFICATION*)
+10310 REFSTRNG, ROWBOOL, ROWCHAR, ROWIN, ROWINB: MODE;
+10320 COERCLEN: INTEGER;
+10330 BALSTR, M1COERC, M2COERC: STRTYP; (*USED IN BALANCING*)
+10340 (**)
+10350 (**)
+10360 (*LEXICAL ANALYSIS*)
+10370 (******************)
+10380 (**)
+10390 PRAGFLGS: SET OF (PRGPOINT, PRGUPPER, PRGLIST, PRGWARN,
+10400 PRGMACH, PRGGO, LINENUMBERS);
+10410 (*FLAGS SET BY PRAGMATS*)
+10420 CHA: CHAR; (*CURRENT INPUT CHARACTER*)
+10430 INDEX: INDEXTYPE; (*INDEX TYPE OF CHA*)
+10440 TYP, TTYPE: TYPETYPE; (*TYPE TYPE OF CHA*)
+10450 CHAC: LOWC..UPC; (*UPPER/LOWER CASE INDICATOR*)
+10460 SRCSTCH: CHAR; (*INDICATES WHETHER IN MIDDLE OF
+10470 PRAGMENT, STRING-DENOTATION, ETC*)
+10480 SRCSTAT: CHAR; (*VALUE OF SRCSTCH AT START OF LINE*)
+10490 HT: HASHTAB;
+10500 (*HASH TABLE*)
+10510 CURRENTLEX: LEXEME;
+10520 INPRAGMENT: BOOLEAN;
+10530 OPCHTABLE: ARRAY [OPCHTABBOUND] OF PACKED RECORD
+10540 OTCHAR: CHAR; OTNEXT, OTALT: OPCHTABBOUND; OTLEX: PLEX END;
+10550 (*TBALE USED BY GETOPR IN LX*)
+10560 LONGSCNT: INTEGER; (*NO OF SUCCESIVE LONGS OR SHORTS*)
+10570 LEXTRUE, LEXFALSE: PLEX;
+10580 LEXBEGIN, LEXOPEN, LEXIF, LEXCASE, LEXWHILE, LEXBRTHPT: PLEX;
+10590 LEXERROR, LEXSTART, LEXLSTOP, LEXSTOP: PLEX;
+10600 (*GLOBAL LEXEMES. FOR OTHER LEXEMES SEE INITIALIZE*)
+10610 LEXALEPH, LEXONE: PLEX;
+10620 LXVTAG, LXVTAB, LXVOPR, LXVMDIND, LXVPRDEN, LXVSTRGDEN: LXM;
+10630 (*GLOBAL LXVS. FOR OTHER LXVS SEE INITIALIZE*)
+10640 PUSHTBL: ARRAY [LXIODUMMY..LXIOVDEFL] OF PLEX;
+10650 (*TABLE OF LEXEMES STACKABLE BY PARSER*)
+10660 (**)
+10670 (**)
+10680 (*ERROR HANDLING*)
+10690 (****************)
+10700 (**)
+10710 ERRS, SEMERRS, WARNS: INTEGER; (*NUMBER OF ERRORS, ETC DETECTED*)
+10720 ERRCHAR: CHAR; (*CHAR TO BE WRITTEN TO ERRBUF,
+10730 USUALLY BLANK*)
+10740 ERRNONBLANK: BOOLEAN; (*TRUE IF ERRBUF CONTAINS ANY
+10750 NON-BLANKS*)
+10760 ERRDEV: BOOLEAN; (*TRUE IF LINE TO BE OUTPUT TO ERROR
+10770 DEVICE*)
+10780 ERRLXPTR: 0..CBUFSIZE; (* ??? *)
+10790 (**)
+10800 (**)
+10810 (*CODE EMITTER*)
+10820 (**************)
+10830 (**)
+10860 OPRAND: ADDRINT;
+10870 OCV: OPDTYP;
+10872 LCLGBL: INTEGER;
+10874 (*+01()
+10876 XSEG: CODEBUF;
+10880 TPFCHAIN: PFCHAIN;
+10890 TPFILLCHAIN: PFILLCHAIN;
+10900 ()+01*)
+10910 MARKPTR: PMARKCHAIN;
+10920 NEXTLABEL: LABL;
+10930 GENDPOCV: OPDTYP; GENDPVAL: INTEGER; (*GLOBAL OUTPUTS OF GENDP*)
+10940 NEEDDP: BOOLEAN;
+10950 OLIST1, OLIST2, OLIST3, OLIST4, OLIST5, OLIST6: OLSTTYP;
+10960 CODETABLE: ARRAY[POP] OF CODETYP;
+10970 LENARRAY : ARRAY [SBTTYP] OF 0..MAXSIZE;
+10980 (*WORDS: 0..777777B;*) (*STACK/HEAP SPACE FOR OBJECT PROGRAM*)
+10990 (*+01()
+11000 REGSINUSE : SET OF SUBSBTTYP;
+11010 REGISTERS:ARRAY [SBTTYP] OF SET OF SUBSBTTYP;
+11020 POPARRAY : ARRAY [SBTSTK..SBTX1,SBTVOID..SBTX1] OF POP;
+11030 ()+01*)
+11040 NEXTREG : INTEGER;
+11050 ADJUSTSP: INTEGER;
+11060 (*+02()
+11070 POPARRAY : ARRAY [SBTSTK..SBTDL,SBTVOID..SBTPRR] OF POP;
+11080 NUMBYTES : 0..31;
+11110 DATASTATE: (STARTDATA,INDATA,ENDDATA,OUTDATA);
+11111 HOLTOP,HOLBOTTOM: LABL;
+11120 ()+02*)
+11130 (*+03()
+11140 REGSINUSE: SET OF SUBSBTTYP;
+11150 REGISTERS: ARRAY [SBTTYP] OF SET OF SUBSBTTYP;
+11160 ()+03*)
+11170 (*+05()
+11180 POPARRAY : ARRAY [SBTSTK..SBTFPR3,SBTVOID..SBTFPR3] OF POP;
+11190 APARAMS: INTEGER;
+11220 DATASTATE : (STARTDATA,INDATA,ENDDATA,OUTDATA);
+11230 REGSINUSE: REGUSETYP;
+11240 ()+05*)
+11250 (**)
+11260 (**)
+11270 (*CODE GENERATOR*)
+11280 (****************)
+11290 (**)
+11300 RTSTACK: PSB;
+11310 RTSTKDEPTH: DEPTHR;
+11320 (**)
+11330 (*SEMANTIC ROUTINES*)
+11340 (*******************)
+11350 (**)
+11360 SRSTK: ARRAY [0..SRSTKSIZE] OF RECORD
+11370 CASE SEVERAL OF
+11380 1:(SB: PSB);
+11390 2:(STB: PSTB);
+11400 3:(MD: MODE);
+11410 4:(LEX: PLEX);
+11420 5:(SUBP: -1..SRSTKSIZE);
+11430 6,7,8,9,10: ()
+11440 END; (*SEMANTIC STACK*)
+11450 (**)
+11460 SRSEMP: -1..SRSTKSIZE; (*POINTS TO TOP ITEM OF SRSTK*)
+11470 SRSUBP: 0..SRSTKSIZE;
+11480 OPCOD: PSTB; (*USED IN OPIDUSER*)
+11490 (*CURRENT ROUTINE*)
+11500 ROUTNL: PROUTN;
+11510 (*PROPERTIES OF CURRENT RANGE*)
+11520 RANGEL: PRANGE;
+11530 RGINFO: SET OF DCLTYP;
+11540 RGSTATE: STATE;
+11550 DCIL: PSTB; (*START OF THREAD*)
+11560 RGLEV: DEPTHR; (*DEPTH OF RANGE*)
+11570 (*PROPERTIES OF CURRENT LOCAL RANGE*)
+11580 CURLEB: OFFSETR; (*BASE OF CURRENT LOCAL ENVIRONMENT*)
+11590 DCLDEFN: DEFTYP;
+11600 DCLMODE: MODE;
+11610 DCLPRVMODE: MODE;
+11620 TODOCOUNT, PSCOUNT: DEPTHR;
+11640 (**)
+11650 CURID: OFFSETR; (*CURRENT IDENTIFIER OFFSET*)
+11660 SCL: PMODECHAIN;
+11670 BALFLAG: BOOLEAN; (*INDICATES WHETHER THE SUBSTACK CONTAINS A SINGLE UNIT OR A BALANCE*)
+11680 (**)
+11690 OPTABL: ARRAY[STDOPTYP] OF OPIDBLK;
+11700 XMODES: ARRAY[XTYPE] OF MODE; (*TO CONVERT XTYPES INTP GENUINE MODES*)
+11710 COMMX: XTYPE; (*FOR COMMUNICATION BETWEEN OPIDSTD AND OPDOSTD*)
+11720 OPBLK: -1..70; (*LIKEWISE*)
+11730 (**)
+11740 MONADUMMY, DYADUMMY: PSTB; (*FOR UNDEFINED OPERATORS*)
+11750 BALANLEN: 0..MAXSIZE; (*COMMUNICATION BETWEEN UNITEDBALAND CGBALB*)
+11760 (**)
+11770 (*PARSING*)
+11780 (*********)
+11790 (**)
+11800 SRPLSTK: ARRAY [0..SRPLSTKSIZE] OF PLEX;
+11810 (*PARSER STACK*)
+11820 PLSTKP: 0..SRPLSTKSIZE; (*POINTS TO TOP ITEM OF PLSTK*)
+11830 PLINPQ: PLEXQ; (*START OF LOOKED-AHEAD LEXEME CHAIN*)
+11840 PRODTBL: ARRAY [1..PRODLEN] OF PROD;
+11850 (*TABLE OF PRODUCTION RULES*)
+11860 PLPTR: 1..PRODLEN; (*POINTER INTO PRODTBL*)
+11870 INP: PLEX; (*CURRENT LEXEME*)
+11880 ENDOFPROG: BOOLEAN;
+11890 (*+02() (*-25() LASTSTACK: INTEGER; ()-25*) ()+02*)
+11900 (*+05() LASTSTACK: INTEGER; ()+05*)
+11910 ()+70*)
+11920 (**)
+11930 (**)
--- /dev/null
+30000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+30010 (**)
+30020 (**)
+30030 (*+04()
+30040 MODULE A68SIN;
+30050 PROCEDURE DUMP;
+30060 PRIVATE
+30070 IMPORTS A68COM FROM A68DEC;
+30080 ()+04*)
+30090 (*+83() PROCEDURE INITIALIZE; FORWARD; ()+83*)
+30100 (*+85() PROCEDURE STANDARDPRELUDE; FORWARD; ()+85*)
+30110 (*+82() PROCEDURE PARSEPARSER; FORWARD; ()+82*)
+30120 (*+85() PROCEDURE INITSEMANTICS; FORWARD; ()+85*)
+30130 (*+01() PROCEDURE INITBEGIN; FORWARD; ()+01*)
+30140 (*+86() PROCEDURE INITCODES; FORWARD; ()+86*)
+30150 PROCEDURE SIN;
+30160 BEGIN
+30170 (*+83() INITIALIZE; ()+83*)
+30180 (*+82() PARSEPARSER; ()+82*)
+30190 (*+85() STANDARDPRELUDE; ()+85*)
+30200 (*+85() INITSEMANTICS; ()+85*)
+30210 (*+01() INITBEGIN; ()+01*)
+30220 (*+86() INITCODES; ()+86*)
+30230 END;
+30240 (**)
+30250 (**)
+30260 (**)
+30270 (**)
+30280 (*+01()
+30290 FUNCTION PFL: INTEGER;
+30300 (*OBTAIN FIELD LENGTH FROM GLOBAL P.FL*)
+30310 EXTERN;
+30320 (**)
+30330 (**)
+30340 FUNCTION PFREE: PINTEGER;
+30350 (*OBTAIN ADDRESS OF GLOBAL P.FREE*)
+30360 EXTERN;
+30370 (**)
+30380 (**)
+30390 (*$T-+)
+30400 PROCEDURE DUMP(VAR START: INTEGER);
+30410 (*DUMPS STACK AND HEAP ONTO FILE DUMPF.
+30420 START IS FIRST VARIABLE ON STACK TO BE DUMPED*)
+30430 CONST TWO30=10000000000B;
+30440 FREEINIT=40000000000000000000B; (*INITIAL VALUE OF P.FREE*)
+30450 VAR F1: FILE OF INTEGER;
+30460 STACKSTART, STACKLENGTH, HEAPSTART, HEAPLENGTH: INTEGER;
+30470 FRIG: RECORD CASE INTEGER OF
+30480 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
+30490 D: DUMPOBJ;
+30500 MASKM,MASKL: INTEGER;
+30510 I: INTEGER;
+30520 BEGIN
+30530 FRIG.INT := GETB(5)+3; STACKSTART := FRIG.POINT^;
+30540 STACKLENGTH := GETB(5)-STACKSTART;
+30550 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
+30560 BEGIN FRIG.INT := I; FRIG.POINT^ := 40000000000000000000B END; (*CLEAR STACK*)
+30570 FOR I := GETB(6) TO PFL-1 DO
+30580 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END; (*CLEAR SPACE BETWEEN STACK AND HEAPTOP*)
+30590 SIN;
+30600 HEAPSTART := GETB(4); HEAPLENGTH := PFL-HEAPSTART;
+30610 FRIG.POINT := PFREE; START := FRIG.POINT^; (*STORE P.FREE ON STACK FOR DUMPING*)
+30620 WRITELN(' STACK SIZE =', STACKLENGTH); WRITELN(' HEAP SIZE =', HEAPLENGTH);
+30630 REWRITE(F1);
+30640 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
+30650 BEGIN FRIG.INT := I; WRITE(F1, FRIG.POINT^) END;
+30660 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO
+30670 BEGIN FRIG.INT := I; WRITE(F1, FRIG.POINT^) END;
+30680 WRITELN(' F1 WRITTEN');
+30690 (**)
+30700 (*NOW CLEAR THE HEAP AND REINITIALIZE IT ONE WORD DOWN*)
+30710 SETB(4, PFL-1); FRIG.POINT := PFREE; FRIG.POINT^ := FREEINIT;
+30720 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
+30730 BEGIN FRIG.INT := I; FRIG.POINT^ := 40000000000000000000B END;
+30740 FOR I := GETB(6) TO PFL-1 DO
+30750 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END;
+30760 SIN;
+30770 FRIG.POINT := PFREE; START := FRIG.POINT^;
+30780 RESET(F1); REWRITE(A68INIT);
+30790 D.INT := STACKLENGTH; D.MASK := HEAPLENGTH; WRITE(A68INIT, D.INT, D.MASK);
+30800 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
+30810 BEGIN
+30820 READ(F1, D.INT);
+30830 FRIG.INT := I; D.MASK := D.INT-FRIG.POINT^;
+30840 (*D.MASK CONTAINS A 1 AT THE LS END OF EACH ^ FIELD OF D.INT*)
+30850 (*NOW WE HAVE TO MULTIPLE D.MASK BY HEAPSTART*)
+30860 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
+30870 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
+30880 D.INT := D.INT-MASKM*TWO30-MASKL;
+30890 WRITE(A68INIT, D.INT, D.MASK)
+30900 END;
+30910 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO
+30920 BEGIN
+30930 READ(F1, D.INT);
+30940 FRIG.INT := I-1; D.MASK := D.INT-FRIG.POINT^;
+30950 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
+30960 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
+30970 D.INT := D.INT-MASKM*TWO30-MASKL;
+30980 WRITE(A68INIT, D.INT, D.MASK)
+30990 END;
+31000 WRITELN(' A68INIT WRITTEN');
+31010 (**)
+31020 (*FINALLY, CLEAR THE HEAP AGAIN*)
+31030 SETB(4, PFL); FRIG.POINT := PFREE; FRIG.POINT^ := FREEINIT
+31040 END;
+31050 ()+01*)
+31060 (**)
+31070 (**)
+31080 (*-11()
+31090 PROCEDURE STASHLEX(A1: ALFA);
+31100 VAR I: INTEGER;
+31110 BEGIN
+31120 WITH CURRENTLEX DO
+31130 BEGIN S10 := A1;
+31140 I := 10; REPEAT I := I+1 ; STRNG[I] := ' ' UNTIL I MOD CHARPERWORD = 0;
+31150 WHILE STRNG[I]=' ' DO I := I-1;
+31160 LXCOUNT := (I+CHARPERWORD-1) DIV CHARPERWORD;
+31170 END
+31180 END;
+31190 (**)
+31200 (**)
+31210 PROCEDURE STASHLLEX(A1, A2: ALFA);
+31220 VAR I: INTEGER;
+31230 BEGIN
+31240 WITH CURRENTLEX DO
+31250 BEGIN S10 := A1;
+31251 FOR I := 11 TO 20 DO STRNG[I] := A2[I-10];
+31260 I := 20; REPEAT I := I+1; STRNG[I] := ' ' UNTIL I MOD CHARPERWORD = 0;
+31270 WHILE STRNG[I]=' ' DO I := I-1;
+31280 LXCOUNT := (I+CHARPERWORD-1) DIV CHARPERWORD;
+31290 END
+31300 END;
+31310 ()-11*)
+31320 (**)
+31330 (**)
+31340 (*-01() (*-03() (*-04()
+31350 FUNCTION GETADDRESS(VAR VARIABLE:INTEGER): ADDRINT; EXTERN;
+31360 (**)
+31370 PROCEDURE RESTORE(VAR START,FINISH: INTEGER);
+31380 VAR STACKSTART,STACKEND,GLOBALLENGTH,HEAPLENGTH,
+31390 HEAPSTART(*+19(),LENGTH,POINTER()+19*): ADDRINT;
+31395 I:INTEGER;
+31400 P: PINTEGER;
+31410 FRIG: RECORD CASE SEVERAL OF
+31420 1: (INT: ADDRINT);
+31421 2: (POINT: PINTEGER);
+31422 3: (PLEXP: PLEX);
+31423 (*+19() 4: (APOINT: ^ADDRINT); ()+19*)
+31424 (*-19()4,()-19*)5,6,7,8,9,10: ()
+31430 END;
+31440 D: RECORD INT,MASK: INTEGER END;
+31450 BEGIN
+31459 (*+05()
+31460 OPENLOADFILE(A68INIT, 4, FALSE);
+31461 ()+05*)
+31470 STACKSTART := GETADDRESS(START);
+31480 IF NOT EOF(A68INIT) THEN
+31490 BEGIN
+31500 READ(A68INIT,GLOBALLENGTH,HEAPLENGTH);
+31510 ENEW(FRIG.PLEXP, HEAPLENGTH);
+31520 HEAPSTART := FRIG.INT;
+31530 FRIG.INT := STACKSTART;
+31535 (*-19()
+31540 FOR I := 1 TO GLOBALLENGTH DIV SZWORD DO
+31550 BEGIN
+31560 READ(A68INIT,D.INT,D.MASK);
+31570 IF D.MASK=SZREAL THEN (*D.INT IS A POINTER OFFSET FROM HEAPSTART*)
+31580 D.INT := D.INT+HEAPSTART;
+31590 FRIG.POINT^ := D.INT;
+31600 FRIG.INT := FRIG.INT+SZWORD;
+31610 END;
+31620 FRIG.INT := HEAPSTART;
+31630 FOR I := 1 TO HEAPLENGTH DIV SZWORD DO
+31640 BEGIN
+31642 READ(A68INIT,D.INT,D.MASK);
+31644 IF D.MASK=SZREAL THEN
+31646 D.INT := D.INT+HEAPSTART;
+31648 FRIG.POINT^ := D.INT;
+31650 FRIG.INT := FRIG.INT+SZWORD
+31652 END
+31654 ()-19*)
+31659 (*+19()
+31660 LENGTH:=GLOBALLENGTH DIV SZWORD;
+31662 I:=1;
+31664 WHILE I<=LENGTH DO
+31666 BEGIN
+31668 READ(A68INIT,D.MASK);
+31670 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
+31672 BEGIN
+31674 READ(A68INIT,POINTER);
+31676 POINTER:=POINTER+HEAPSTART;
+31678 FRIG.APOINT^:=POINTER;
+31680 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
+31682 I:=I+2
+31684 END
+31686 ELSE
+31688 BEGIN
+31690 READ(A68INIT,D.INT);
+31691 FRIG.POINT^:=D.INT;
+31692 FRIG.INT:=FRIG.INT+SZWORD;
+31693 I:=I+1
+31694 END
+31695 END;
+31696 LENGTH:=HEAPLENGTH DIV SZWORD;
+31697 FRIG.INT:=HEAPSTART;
+31698 I:=1;
+31699 WHILE I<=LENGTH DO
+31700 BEGIN
+31701 READ(A68INIT,D.MASK);
+31702 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
+31703 BEGIN
+31704 READ(A68INIT,POINTER);
+31705 POINTER:=POINTER+HEAPSTART;
+31706 FRIG.APOINT^:=POINTER;
+31707 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
+31708 I:=I+2
+31709 END
+31710 ELSE
+31711 BEGIN
+31712 READ(A68INIT,D.INT);
+31713 FRIG.POINT^:=D.INT;
+31714 FRIG.INT:=FRIG.INT+SZWORD;
+31715 I:=I+1
+31716 END
+31717 END
+31718 ()+19*)
+31719 END
+31720 END;
+31730 PROCEDURE DUMP(VAR START,FINISH: INTEGER);
+31740 VAR STACKSTART,STACKEND,GLOBALLENGTH,
+31750 HEAPLENGTH,HEAPSTART: ADDRINT;
+31755 I:INTEGER;
+31760 P: PINTEGER;
+31770 FRIG: RECORD CASE SEVERAL OF
+31780 1: (INT:ADDRINT); 2: (POINT:PINTEGER);
+31790 3: (PLEXP: PLEX); 4,5,6,7,8,9,10: ()
+31800 END;
+31810 D: RECORD INT,MASK: INTEGER END;
+31830 (**)
+31840 BEGIN (* DUMP *)
+31850 REWRITE(LSTFILE);WRITELN(LSTFILE,' START DUMP');
+31860 (*+05()
+31870 OPENLOADFILE(DUMPF, 5, TRUE);
+31871 ()+05*)
+31880 IF EOF(LGO) THEN ENEW(FRIG.PLEXP,SZREAL)
+31890 ELSE ENEW(FRIG.PLEXP,2*SZREAL);
+31900 NEW(FRIG.POINT); (*-02() DISPOSE(FRIG.POINT); ()-02*)
+31910 HEAPSTART := FRIG.INT;
+31920 RESTORE(START,FINISH);
+31930 SIN;
+31935 (*-02()
+31940 NEW(FRIG.POINT); DISPOSE(FRIG.POINT);
+31941 ()-02*)
+31943 (*+02()
+31945 ENEW(FRIG.POINT,100); (* TO MAKE SURE IT GOES AT THE END *)
+31947 ()+02*)
+31950 HEAPLENGTH := FRIG.INT-HEAPSTART;
+31960 STACKSTART := GETADDRESS(START);
+31970 STACKEND := GETADDRESS(FINISH);
+31980 GLOBALLENGTH := STACKEND-STACKSTART;
+31990 WRITE(DUMPF,GLOBALLENGTH,HEAPLENGTH,HEAPSTART);
+32000 FRIG.INT := STACKSTART;
+32010 FOR I := 1 TO ABS(GLOBALLENGTH) DIV SZWORD DO
+32020 BEGIN
+32030 WRITE(DUMPF,FRIG.POINT^);
+32040 FRIG.INT := FRIG.INT+SZWORD*(ORD(GLOBALLENGTH>0)*2-1);
+32050 END;
+32060 FRIG.INT := HEAPSTART;
+32070 FOR I := 1 TO ABS(HEAPLENGTH) DIV SZWORD DO
+32080 BEGIN
+32090 WRITE(DUMPF,FRIG.POINT^);
+32100 FRIG.INT := FRIG.INT+SZWORD*(ORD(HEAPLENGTH>0)*2-1);
+32110 END;
+32120 WRITELN(LSTFILE,' DUMPF WRITTEN');
+32130 (**)
+32140 WRITELN(LSTFILE,' GLOBAL LENGTH',GLOBALLENGTH,' HEAP LENGTH',HEAPLENGTH);
+32150 END;
+32160 ()-04*) ()-03*) ()-01*)
+32170 (*-01() (*-02() (*-05()
+32180 PROCEDURE DUMP(VAR START, FINISH: INTEGER);
+32190 BEGIN SIN END;
+32200 ()-05*) ()-02*) ()-01*)
--- /dev/null
+33000 (*+01() (*$P+,T-+) ()+01*)
+33010 (*+25() (*$P+,T-+) ()+25*)
+33020 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+33030 (**)
+33040 (**)
+33050 (**)
+33060 (*+83()
+33070 (**)
+33080 (**)
+33090 PROCEDURE INITIALIZE;
+33100 (*FUNCTION: COMPILER INITIALIZATION TO SET UP LEXEMES, PARSER,
+33110 STANDARD-PRELUDE, ETC. ULTIMATELY, THE COMPILER WILL BE FROZEN
+33120 AFTER THE CALL OF INITIALIZE, AND HOPEFULLY THIS PROCEDURE CAN
+33130 THEN BE MADE TO VANISH AWAY.
+33140 *)
+33150 VAR I: INTEGER;
+33160 OTCOUNT: INTEGER;
+33170 (*+84()
+33180 (*MDMS*)
+33190 MDVINT, MDVLINT, MDVREAL, MDVLREAL, MDVCHAR, MDVBITS, MDVBYTES, MDVSTRNG, MDVBOOL,
+33200 MDVCHAN, MDVCOVER, MDVVOID, MDVSKIP, MDVJUMP, MDVNIL,
+33210 MDVOUT, MDVIN, MDVOUTB, MDVINB, MDVNUMBER,
+33220 MDVROWS, MDVBNDS, MDVABSENT, MDVERROR (*, MDVPROC, MDVREF, MDVSTRUCT, MDVROW*): MDM;
+33230 ()+84*)
+33240 (*+81()
+33250 (*LXMS - NONTERMINALS*)
+33260 LXVACTPL, LXVACTRL,
+33270 LXVBOUNDS, LXVBRINPT, LXVBRTHPT,
+33280 LXVCSTICK,
+33290 LXVDCLL,
+33300 LXVFLDSPL, LXVFORDCL, LXVFORRLB,
+33310 LXVIDEFL,
+33320 LXVLABSQ,
+33330 LXVMOIDDR,
+33340 LXVNONRDR,
+33350 LXVODEFL, LXVOPRAND,
+33360 LXVPRIM, LXVPRMDRL,
+33370 LXVRIDEFL, LXVRODEFL, LXVRSPEC, LXVRVDEFL,
+33380 LXVTERT, LXVTRMSCL,
+33390 LXVUNLC, LXVUNLP, LXVUNSR,
+33400 LXVVDEFL,
+33410 (*LXMS - TERMINALS*)
+33420 LXVAGAIN, LXVAT,
+33430 LXVBECOM, LXVBEGIN, LXVBOOLDEN, LXVBUS, LXVBY,
+33440 LXVCASE, LXVCLOSE, LXVCOLON, LXVCOMMA, LXVCMMENT,
+33450 LXVDO,
+33460 LXVELIF, LXVELSE, LXVEND, LXVEQUAL, LXVERROR, LXVESAC, LXVEXIT,
+33470 LXVFI, LXVFOR, LXVFROM,
+33480 LXVGO, LXVGOTO,
+33490 LXVHEAP,
+33500 LXVIDTY, LXVIF, LXVIN,
+33510 LXVLOC, LXVLONG,
+33520 (*LXVMDIND,*) LXVMODE,
+33530 LXVNIL,
+33540 LXVOD, LXVOF, LXVOP, LXVOPEN, (*LXVOPR,*) LXVOTHDR, LXVOUSE, LXVOUT,
+33550 LXVPRAGMAT, (*LXVPRDEN,*) LXVPRDR, LXVPRIO, LXVPROC,
+33560 LXVREF,
+33570 LXVSEMIC, LXVSHORT, LXVSKIP, LXVSTART, LXVSTICK, LXVSTOP, (*LXVSTRGDEN*) LXVSTRUCT, LXVSUB,
+33580 (*LXVTAB,*) (*LXVTAG,*) LXVTHEN, LXVTO,
+33590 LXVVOID,
+33600 LXVWHILE: LXM;
+33610 (*PLEXES - NONTERMINALS*)
+33620 LEXACTPL, LEXACTRL,
+33630 LEXBOUNDS, LEXBRINPT, (*LEXBRTHPT,*)
+33640 LEXCSTICK,
+33650 LEXDCLL,
+33660 LEXFLDSPL, LEXFORDCL, LEXFORRLB,
+33670 LEXIDEFL,
+33680 LEXLABSQ,
+33690 LEXMOIDDR,
+33700 LEXNONRDR,
+33710 LEXODEFL, LEXOPRAND,
+33720 LEXPRIM, LEXPRMDRL,
+33730 LEXRIDEFL, LEXRODEFL, LEXRSPEC, LEXRVDEFL,
+33740 LEXTERT, LEXTRMSCL,
+33750 LEXUNLC, LEXUNLP, LEXUNSR,
+33760 LEXVDEFL,
+33770 (*PLEXES - TERMINALS*)
+33780 LEXAGAIN, LEXAT, LEXATB,
+33790 LEXBECOM, (*LEXBEGIN,*) LEXBUSB, LEXBY,
+33800 (*LEXCASE,*) LEXCLOSE, LEXCOLON, LEXCOMMA, LEXCO, LEXCO2, LEXCMMENT,
+33810 LEXDIV, LEXDO, LEXDVAB,
+33820 LEXELIF, LEXELSE, LEXEMPTY, LEXEND, LEXEQUAL, (*LEXERROR,*) LEXESAC, LEXEXIT,
+33830 (*LEXFALSE,*) LEXFI, LEXFLEX, LEXFOR, LEXFROM,
+33840 LEXGE, LEXGO, LEXGOTO, LEXGT,
+33850 LEXHEAP,
+33860 (*LEXIF,*) LEXIN, LEXIS, LEXISB, LEXISNT, LEXISNTB,
+33870 LEXLE, LEXLOC, LEXLONG, LEXLT,
+33880 LEXMDAB, LEXMINUS, LEXMNAB, LEXMOD, LEXMODE,
+33890 LEXNE, LEXNIL,
+33900 LEXOD, LEXOF, LEXOP, (*LEXOPEN,*) LEXOUSE, LEXOUT, LEXOVAB, LEXOVER,
+33910 LEXPAR, LEXPLAB, LEXPLTO, LEXPLUS, LEXPLITM, LEXPR, LEXPRAGMAT, LEXPRIO, LEXPROC,
+33920 LEXREF,
+33930 LEXSEMA, LEXSEMIC, LEXSHORT, LEXSKIP, (*LEXSTART,*) LEXSTICK, (*LEXLSTOP, LEXSTOP,*) LEXSTRUCT, LEXSUBB,
+33940 LEXTHEN, LEXTIMES, LEXTMAB, LEXTO, (*LEXTRUE,*)
+33950 LEXUP1, LEXUP2, LEXUNION,
+33960 LEXVOID (*, LEXWHILE*)
+33970 : PLEX;
+33980 ()+81*)
+33990 PROCEDURE LXVVAL(VAR LXVVAR: LXM; IO: LXIOTYPE; CL0: CL0TYPE; CL1: CL1TYPE; CL2: CL2TYPE);
+34000 VAR WORD: RECORD CASE SEVERAL OF
+34010 (*-02() (*-05() 1:(LXV: LXM); 2:(INT: INTEGER) END; ()-05*) ()-02*)
+34020 (*+02() 1:(LXV:LXM); 2:(INT,INT2,INT3: INTEGER); 3,4,5,6,7,8,9,10:() END; ()+02*)
+34030 (*+05() 1:(LXV:LXM); 2:(INT,INT2: INTEGER); 3,4,5,6,7,8,9,10:() END; ()+05*)
+34040 BEGIN WORD.INT := 0; (*TO ENSURE THAT PARTS OF WORD NOT OCCUPIED BY THE LXM ARE CLEAR*)
+34050 (*+02() WORD.INT2 := 0; WORD.INT3 := 0; ()+02*)
+34060 (*+05() WORD.INT2 := 0; ()+05*)
+34070 WITH WORD.LXV DO
+34080 BEGIN LXIO := IO; LXCLASS0 := CL0; LXCLASS1 := CL1; LXCLASS2 := CL2; LXPSTB := NIL END;
+34090 LXVVAR := WORD.LXV
+34100 END;
+34110 (*+81()
+34120 PROCEDURE LOCNDEX(VAR LEX: PLEX; LXV: LXM);
+34130 BEGIN
+34140 ENEW(LEX, LEX1SIZE);
+34150 LEX^.LXV := LXV;
+34160 LEX^.LXCOUNT := 0;
+34170 END;
+34180 ()+81*)
+34190 (*+84()
+34200 FUNCTION DEFPRC0(YIELD: MODE; CP: CODEPROC): MODE;
+34210 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+34220 FINDPRC(YIELD,0,CP); DEFPRC0 := SRSTK[SRSEMP].MD
+34230 END;
+34240 FUNCTION DEFPRC1(P1, YIELD: MODE; CP: CODEPROC): MODE;
+34250 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+34260 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
+34270 FINDPRC(YIELD,1,CP); DEFPRC1 := SRSTK[SRSEMP].MD
+34280 END;
+34290 FUNCTION DEFPRC2(P1, P2, YIELD: MODE; CP: CODEPROC): MODE;
+34300 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+34310 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
+34320 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P2;
+34330 FINDPRC(YIELD,2,CP); DEFPRC2 := SRSTK[SRSEMP].MD
+34340 END;
+34350 ()+84*)
+34360 (*+81()
+34370 PROCEDURE DEFSYMB(VAR LEX: PLEX; TLXV: LXM; SYMB: ALFA);
+34380 VAR I: INTEGER;
+34390 BEGIN WITH CURRENTLEX DO
+34400 BEGIN
+34410 LXV := TLXV; LXTOKEN := TKSYMBOL;
+34420 (*+11() S10 := SYMB; LXCOUNT := 1; ()+11*)
+34430 (*-11() STASHLEX(SYMB); ()-11*)
+34440 ENEW(LEX, LEX1SIZE+LXCOUNT*SZWORD);
+34450 FOR I := 1 TO LEX1SIZE DIV SZWORD + LXCOUNT DO
+34460 LEX^.LEXWORDS[I] := LEXWORDS[I];
+34470 END
+34480 END;
+34490 (**)
+34500 ()+81*)
+34510 (**)
+34520 PROCEDURE INTAB(VAR LEX: PLEX; TAG: ALFA; LXVV: LXM);
+34530 VAR I: INTEGER;
+34540 BEGIN WITH CURRENTLEX DO
+34550 BEGIN
+34560 LXV := LXVV; LXTOKEN := TKBOLD;
+34570 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+34580 (*-11() STASHLEX(TAG); ()-11*)
+34590 END;
+34600 LEX := HASHIN
+34610 END;
+34620 (*+84()
+34630 FUNCTION DEFTAG(TAG: ALFA): PLEX;
+34640 BEGIN WITH CURRENTLEX DO
+34650 BEGIN
+34660 LXV := LXVTAG; LXTOKEN := TKTAG;
+34670 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+34680 (*-11() STASHLEX(TAG); ()-11*)
+34690 END;
+34700 DEFTAG := HASHIN
+34710 END;
+34720 ()+84*)
+34730 (*+81()
+34740 FUNCTION DEFLTAG(TAG1, TAG2: ALFA): PLEX;
+34750 BEGIN WITH CURRENTLEX DO
+34760 BEGIN
+34770 LXV := LXVTAG; LXTOKEN := TKTAG;
+34780 (*+11() S20 := TAG2; S10 := TAG1; LXCOUNT := 2; ()+11*)
+34790 (*-11() STASHLLEX(TAG1, TAG2); ()-11*)
+34800 DEFLTAG := HASHIN;
+34810 END
+34820 END;
+34830 PROCEDURE OTPAIR(OTCOUNT: OPCHTABBOUND; TCHAR: CHAR; TNEXT, TALT: OPCHTABBOUND; TLEX: PLEX);
+34840 BEGIN WITH OPCHTABLE[OTCOUNT] DO
+34850 BEGIN OTCHAR := TCHAR; OTNEXT := TNEXT; OTALT := TALT; OTLEX := TLEX;
+34860 END
+34870 END;
+34880 PROCEDURE INITLEXES;
+34890 BEGIN
+34900 (*SET UP LXV VALUES - NONTERMINALS*)
+34910 LXVVAL(LXVACTPL , LXIOACTPL , 0, 0, 00); (*ACTUAL PARAMETER LIST*)
+34920 LXVVAL(LXVACTRL , LXIOACTRL , 0, 0, 00); (*ACTUAL ROWER LIST*)
+34930 LXVVAL(LXVBOUNDS , LXIOBOUNDS , 0, 0, 00); (*BOUNDS*)
+34940 LXVVAL(LXVBRINPT , LXIOBRINPT , 0, 0, 02); (*BRIEF IN PART*)
+34950 LXVVAL(LXVBRTHPT , LXIOBRTHPT , 0, 0, 02); (*BRIEF THEN PART*)
+34960 LXVVAL(LXVCSTICK , LXIOCSTICK , 0, 3, 09); (*STICK IN CASE-CLAUSE*)
+34970 LXVVAL(LXVDCLL , LXIODCLL , 0, 0, 00); (*DECLARATION LIST*)
+34980 LXVVAL(LXVFLDSPL , LXIOFLDSPL , 0, 0, 07); (*FIELD SPECIFICATION LIST*)
+34990 LXVVAL(LXVFORDCL , LXIOFORDCL , 0, 0, 00); (*FORMAL DECLARATIVE LIST*)
+35000 LXVVAL(LXVFORRLB , LXIOFORRLB , 0, 0, 00); (*FORMAL ROWER LIST BRACKET*)
+35010 LXVVAL(LXVIDEFL , LXIOIDEFL , 0, 0, 00); (*IDENTITY DEFINITION LIST*)
+35020 LXVVAL(LXVLABSQ , LXIOLABSQ , 0, 0, 00); (*LABEL SEQUENCE*)
+35030 LXVVAL(LXVMOIDDR , LXIOMOIDDR , 0, 0, 00); (*MOID DECLARER*)
+35040 LXVVAL(LXVNONRDR , LXIONONRDR , 0, 0, 00); (*NONROWED DECLARER*)
+35050 LXVVAL(LXVODEFL , LXIOODEFL , 0, 0, 00); (*OPERATION DEFINITION LIST*)
+35060 LXVVAL(LXVOPRAND , LXIOOPRAND , 0, 0, 00); (*OPERAND*)
+35070 LXVVAL(LXVPRIM , LXIOPRIM , 0, 0, 00); (*PRIMARY*)
+35080 LXVVAL(LXVPRMDRL , LXIOPRMDRL , 0, 0, 00); (*PARAMETER DECLARER LIST*)
+35090 LXVVAL(LXVRIDEFL , LXIORIDEFL , 0, 0, 00); (*ROUTINE IDENTITY DEFINITION LIST*)
+35100 LXVVAL(LXVRODEFL , LXIORODEFL , 0, 0, 00); (*ROUTINE OPERATION DEFINITION LIST*)
+35110 LXVVAL(LXVRSPEC , LXIORSPEC , 0, 0, 00); (*ROUTINE SPECIFICATION*)
+35120 LXVVAL(LXVRVDEFL , LXIORVDEFL , 0, 0, 00); (*ROUTINE VARIABLE DEFINITION LIST*)
+35130 LXVVAL(LXVTERT , LXIOTERT , 0, 0, 00); (*TERTIARY*)
+35140 LXVVAL(LXVTRMSCL , LXIOTRMSCL , 0, 0, 00); (*TRIMSCRIPT LIST*)
+35150 LXVVAL(LXVUNLC , LXIOUNLC , 0, 0, 00); (*UNIT LIST PROPER IN COLLATERAL*)
+35160 LXVVAL(LXVUNLP , LXIOUNLP , 0, 0, 00); (*UNIT LIST PROPER*)
+35170 LXVVAL(LXVUNSR , LXIOUNSR , 0, 3, 00); (*UNIT SERIES*)
+35180 LXVVAL(LXVVDEFL , LXIOVDEFL , 0, 0, 00); (*VARIABLE DEFINITION LIST*)
+35190 (*SET UP LXV VALUES - TERMINALS*)
+35200 LXVVAL(LXVAGAIN , LXIOAGAIN , 1, 3, 09);
+35210 LXVVAL(LXVAT , LXIOAT , 1, 1, 05);
+35220 LXVVAL(LXVBECOM , LXIOBECOM , 1, 0, 00);
+35230 LXVVAL(LXVBEGIN , LXIOBEGIN , 0, 3, 02);
+35240 LXVVAL(LXVBOOLDEN, LXIOBOOLDEN, 0, 0, 10);
+35250 LXVBOOLDEN.LXPYPTR := 0;
+35260 LXVVAL(LXVBUS , LXIOBUS , 1, 1, 00);
+35270 LXVVAL(LXVBY , LXIOBY , 0, 0, 01);
+35280 LXVVAL(LXVCASE , LXIOCASE , 0, 3, 02);
+35290 LXVVAL(LXVCLOSE , LXIOCLOSE , 1, 1, 15);
+35300 LXVVAL(LXVCOLON , LXIOCOLON , 1, 0, 05);
+35310 LXVVAL(LXVCOMMA , LXIOCOMMA , 1, 1, 13);
+35320 LXVVAL(LXVCMMENT , LXIOCMMENT , 0, 0, 00);
+35330 LXVVAL(LXVDO , LXIODO , 0, 3, 01);
+35340 LXVVAL(LXVELIF , LXIOELIF , 1, 3, 04);
+35350 LXVVAL(LXVELSE , LXIOELSE , 1, 3, 04);
+35360 LXVVAL(LXVEND , LXIOEND , 1, 0, 15);
+35370 LXVVAL(LXVEQUAL , LXIOEQUAL , 0, 4, 00);
+35380 LXVVAL(LXVERROR , LXIOERROR , 0, 0, 00);
+35390 LXVVAL(LXVESAC , LXIOESAC , 1, 0, 15);
+35400 LXVVAL(LXVEXIT , LXIOEXIT , 1, 0, 00);
+35410 LXVVAL(LXVFI , LXIOFI , 1, 0, 15);
+35420 LXVVAL(LXVFOR , LXIOFOR , 0, 0, 01);
+35430 LXVVAL(LXVFROM , LXIOFROM , 0, 0, 01);
+35440 LXVVAL(LXVGO , LXIOGO , 0, 0, 00);
+35450 LXVVAL(LXVGOTO , LXIOGOTO , 0, 0, 00);
+35460 LXVVAL(LXVHEAP , LXIOHEAP , 0, 0, 14);
+35470 LXVVAL(LXVIDTY , LXIOIDTY , 1, 0, 00);
+35480 LXVVAL(LXVIF , LXIOIF , 0, 3, 02);
+35490 LXVVAL(LXVIN , LXIOIN , 1, 3, 00);
+35500 LXVVAL(LXVLOC , LXIOLOC , 0, 0, 14);
+35510 LXVVAL(LXVLONG , LXIOLONG , 0, 2, 00);
+35520 LXVVAL(LXVMDIND , LXIOMDIND , 0, 2, 11);
+35530 LXVVAL(LXVMODE , LXIOMODE , 0, 0, 00);
+35540 LXVVAL(LXVNIL , LXIONIL , 0, 0, 00);
+35550 LXVVAL(LXVOD , LXIOOD , 1, 0, 15);
+35560 LXVVAL(LXVOF , LXIOOF , 1, 0, 00);
+35570 LXVVAL(LXVOP , LXIOOP , 0, 0, 12);
+35580 LXVVAL(LXVOPEN , LXIOOPEN , 0, 3, 06);
+35590 LXVVAL(LXVOPR , LXIOOPR , 0, 4, 00);
+35600 LXVVAL(LXVOTHDR , LXIOOTHDR , 0, 2, 08); (*DOESN'T SEEM TO BE USED ANYWHERE*)
+35610 LXVVAL(LXVOUSE , LXIOOUSE , 1, 3, 03);
+35620 LXVVAL(LXVOUT , LXIOOUT , 1, 3, 03);
+35630 LXVVAL(LXVPRAGMAT, LXIOPRAGMAT, 0, 0, 00);
+35640 LXVVAL(LXVPRDEN , LXIOPRDEN , 0, 0, 10);
+35650 LXVPRDEN.LXPYPTR := 0;
+35660 LXVVAL(LXVPRDR , LXIOPRDR , 0, 2, 08);
+35670 LXVVAL(LXVPRIO , LXIOPRIO , 0, 0, 00);
+35680 LXVVAL(LXVPROC , LXIOPROC , 0, 2, 12);
+35690 LXVVAL(LXVREF , LXIOREF , 0, 2, 00);
+35700 LXVVAL(LXVSEMIC , LXIOSEMIC , 1, 0, 13);
+35710 LXVVAL(LXVSHORT , LXIOSHORT , 0, 2, 00);
+35720 LXVVAL(LXVSKIP , LXIOSKIP , 0, 0, 00);
+35730 LXVVAL(LXVSTART , LXIOSTART , 0, 0, 00);
+35740 LXVVAL(LXVSTICK , LXIOSTICK , 1, 3, 09);
+35750 LXVVAL(LXVSTOP , LXIOSTOP , 1, 0, 00);
+35760 LXVVAL(LXVSTRGDEN, LXIOSTRGDEN, 0, 0, 10);
+35770 LXVSTRGDEN.LXPYPTR := 0;
+35780 LXVVAL(LXVSTRUCT , LXIOSTRUCT , 0, 2, 07);
+35790 LXVVAL(LXVSUB , LXIOSUB , 0, 2, 06);
+35800 LXVVAL(LXVTAB , LXIOTAB , 0, 4, 11);
+35810 LXVVAL(LXVTAG , LXIOTAG , 0, 0, 00);
+35820 LXVVAL(LXVTHEN , LXIOTHEN , 1, 3, 00);
+35830 LXVVAL(LXVTO , LXIOTO , 0, 0, 01);
+35840 LXVVAL(LXVVOID , LXIOVOID , 0, 0, 00);
+35850 LXVVAL(LXVWHILE , LXIOWHILE , 0, 3, 01);
+35860 (*SET UP LEX VALUES - NONTERMINALS*)
+35870 LOCNDEX(LEXACTPL, LXVACTPL);
+35880 LOCNDEX(LEXACTRL, LXVACTRL);
+35890 LOCNDEX(LEXBOUNDS, LXVBOUNDS);
+35900 LOCNDEX(LEXBRINPT, LXVBRINPT);
+35910 LOCNDEX(LEXBRTHPT, LXVBRTHPT);
+35920 LOCNDEX(LEXCSTICK, LXVCSTICK);
+35930 LOCNDEX(LEXDCLL, LXVDCLL);
+35940 LOCNDEX(LEXFLDSPL, LXVFLDSPL);
+35950 LOCNDEX(LEXFORDCL, LXVFORDCL);
+35960 LOCNDEX(LEXFORRLB, LXVFORRLB);
+35970 LOCNDEX(LEXIDEFL, LXVIDEFL);
+35980 LOCNDEX(LEXLABSQ, LXVLABSQ);
+35990 LOCNDEX(LEXMOIDDR, LXVMOIDDR);
+36000 LOCNDEX(LEXNONRDR, LXVNONRDR);
+36010 LOCNDEX(LEXODEFL, LXVODEFL);
+36020 LOCNDEX(LEXOPRAND, LXVOPRAND);
+36030 LOCNDEX(LEXPRIM, LXVPRIM);
+36040 LOCNDEX(LEXPRMDRL, LXVPRMDRL);
+36050 LOCNDEX(LEXRIDEFL, LXVRIDEFL);
+36060 LOCNDEX(LEXRODEFL, LXVRODEFL);
+36070 LOCNDEX(LEXRSPEC, LXVRSPEC);
+36080 LOCNDEX(LEXRVDEFL, LXVRVDEFL);
+36090 LOCNDEX(LEXTERT, LXVTERT);
+36100 LOCNDEX(LEXTRMSCL, LXVTRMSCL);
+36110 LOCNDEX(LEXUNLC, LXVUNLC);
+36120 LOCNDEX(LEXUNLP, LXVUNLP);
+36130 LOCNDEX(LEXUNSR, LXVUNSR);
+36140 LOCNDEX(LEXVDEFL, LXVVDEFL);
+36150 (*SET UP LEX VALUES - BRIEF TERMINALS*)
+36160 LOCNDEX(LEXAGAIN, LXVAGAIN);
+36170 LOCNDEX(LEXAT, LXVAT);
+36180 LOCNDEX(LEXBECOM, LXVBECOM);
+36190 LOCNDEX(LEXBUSB, LXVBUS);
+36200 LOCNDEX(LEXCLOSE, LXVCLOSE);
+36210 LOCNDEX(LEXCOLON, LXVCOLON);
+36220 LOCNDEX(LEXCOMMA, LXVCOMMA);
+36230 DEFSYMB(LEXCO2, LXVCMMENT, '# ');
+36240 DEFSYMB(LEXDIV, LXVOPR, '/ ');
+36250 DEFSYMB(LEXDVAB, LXVOPR, '/:= ');
+36260 DEFSYMB(LEXEQUAL, LXVEQUAL, '= ');
+36270 LOCNDEX(LEXERROR, LXVERROR);
+36280 DEFSYMB(LEXGE, LXVOPR, '>= ');
+36290 DEFSYMB(LEXGT, LXVOPR, '> ');
+36300 LOCNDEX(LEXIS, LXVIDTY);
+36310 LEXIS^.LXV.LXP := 0;
+36320 LOCNDEX(LEXISNT, LXVIDTY);
+36330 LEXISNT^.LXV.LXP := 1;
+36340 DEFSYMB(LEXLE, LXVOPR, '<= ');
+36350 DEFSYMB(LEXLT, LXVOPR, '< ');
+36360 DEFSYMB(LEXMDAB, LXVOPR, '%*:= ');
+36370 DEFSYMB(LEXMINUS, LXVOPR, '- ');
+36380 DEFSYMB(LEXMNAB, LXVOPR, '-:= ');
+36390 DEFSYMB(LEXMOD, LXVOPR, '%* ');
+36400 DEFSYMB(LEXNE, LXVOPR, '/= ');
+36410 LOCNDEX(LEXOPEN, LXVOPEN);
+36420 DEFSYMB(LEXOVAB, LXVOPR, '%:= ');
+36430 DEFSYMB(LEXOVER, LXVOPR, '% ');
+36440 DEFSYMB(LEXPLAB, LXVOPR, '+:= ');
+36450 DEFSYMB(LEXPLTO, LXVOPR, '+=: ');
+36460 DEFSYMB(LEXPLUS, LXVOPR, '+ ');
+36470 DEFSYMB(LEXPLITM, LXVOPR, '+* ');
+36480 (*LEXPR2 OMITTED*)
+36490 LOCNDEX(LEXSEMIC, LXVSEMIC);
+36500 LOCNDEX(LEXSTART, LXVSTART);
+36510 LOCNDEX(LEXSTICK, LXVSTICK);
+36520 LOCNDEX(LEXSTOP, LXVSTOP);
+36530 LOCNDEX(LEXSUBB, LXVSUB);
+36540 DEFSYMB(LEXTIMES, LXVOPR, '* ');
+36550 DEFSYMB(LEXTMAB, LXVOPR, '*:= ');
+36560 DEFSYMB(LEXUP1, LXVOPR, '^ ');
+36570 DEFSYMB(LEXUP2, LXVOPR, '** ');
+36580 END;
+36590 (**)
+36600 PROCEDURE MAKEPUSHTBL;
+36610 (*SET UP PUSHTBL*)
+36620 BEGIN
+36630 PUSHTBL[LXIOACTPL] := LEXACTPL;
+36640 PUSHTBL[LXIOACTRL] := LEXACTRL;
+36650 PUSHTBL[LXIOBOUNDS] := LEXBOUNDS;
+36660 PUSHTBL[LXIOBRINPT] := LEXBRINPT;
+36670 PUSHTBL[LXIOBRTHPT] := LEXBRTHPT;
+36680 PUSHTBL[LXIOCSTICK] := LEXCSTICK;
+36690 PUSHTBL[LXIODCLL] := LEXDCLL;
+36700 PUSHTBL[LXIOFLDSPL] := LEXFLDSPL;
+36710 PUSHTBL[LXIOFORDCL] := LEXFORDCL;
+36720 PUSHTBL[LXIOFORRLB] := LEXFORRLB;
+36730 PUSHTBL[LXIOIDEFL] := LEXIDEFL;
+36740 PUSHTBL[LXIOLABSQ] := LEXLABSQ;
+36750 PUSHTBL[LXIOMOIDDR] := LEXMOIDDR;
+36760 PUSHTBL[LXIONONRDR] := LEXNONRDR;
+36770 PUSHTBL[LXIOODEFL] := LEXODEFL;
+36780 PUSHTBL[LXIOOPRAND] := LEXOPRAND;
+36790 PUSHTBL[LXIOPRIM] := LEXPRIM;
+36800 PUSHTBL[LXIOPRMDRL] := LEXPRMDRL;
+36810 PUSHTBL[LXIORIDEFL] := LEXRIDEFL;
+36820 PUSHTBL[LXIORODEFL] := LEXRODEFL;
+36830 PUSHTBL[LXIORSPEC] := LEXRSPEC;
+36840 PUSHTBL[LXIORVDEFL] := LEXRVDEFL;
+36850 PUSHTBL[LXIOTERT] := LEXTERT;
+36860 PUSHTBL[LXIOTRMSCL] := LEXTRMSCL;
+36870 PUSHTBL[LXIOUNLC] := LEXUNLC;
+36880 PUSHTBL[LXIOUNLP] := LEXUNLP;
+36890 PUSHTBL[LXIOUNSR] := LEXUNSR;
+36900 PUSHTBL[LXIOVDEFL] := LEXVDEFL;
+36910 END;
+36920 PROCEDURE OTPAIRS;
+36930 (*SET UP OPCHTABLE*)
+36940 BEGIN
+36950 (*THE INITIAL ENTRIES TO THIS TABLE (THE ONES LESS INDENTED) DEPEND UPON
+36960 THE POSITION OF THE CHARACTER CONCERNED IN THE CHARACTER CODE*)
+36970 (*+01() (*BUT ':' OCCUPIES THE POSITION OF '$'*) ()+01*)
+36980 (*-01() (*BUT '[', ']' AND '^' OCCUPY THE POSITIONS OF '$', '&' AND ''''*) ()-01*)
+36990 (*+01() (*CDC CODE*)
+37000 OTPAIR( 0, '+', 37, 0, LEXPLUS);
+37010 OTPAIR( 1, '-', 15, 0, LEXMINUS);
+37020 OTPAIR( 2, '*', 45, 0, LEXTIMES);
+37030 OTPAIR( 3, '/', 42, 0, LEXDIV);
+37040 OTPAIR( 4, '(', 0, 0, LEXOPEN);
+37050 OTPAIR( 5, ')', 0, 0, LEXCLOSE);
+37060 OTPAIR( 6, ':', 27, 0, LEXCOLON);
+37070 OTPAIR( 7, '=', 0, 0, LEXEQUAL);
+37080 OTPAIR( 8, ':', 0, 0, LEXAGAIN);
+37090 OTPAIR( 9, ',', 0, 0, LEXCOMMA);
+37100 OTPAIR(10, '=', 0, 0, LEXLE);
+37110 OTPAIR(11, '#', 0, 0, LEXCO2);
+37120 OTPAIR(12, '[', 0, 0, LEXSUBB);
+37130 OTPAIR(13, ']', 0, 0, LEXBUSB);
+37140 OTPAIR(14, '%', 32, 0, LEXOVER);
+37150 OTPAIR(15, ':', 16, 0, LEXERROR);
+37160 OTPAIR(16, '=', 0, 0, LEXMNAB);
+37170 (*-51()
+37180 OTPAIR(17, '!', 8, 0, LEXSTICK);
+37190 ()-51*)
+37200 (*+51()
+37210 OTPAIR(18, '&', 8, 0, LEXSTICK);
+37220 OTPAIR(19, '''', 0, 0, LEXUP1);
+37230 ()+51*)
+37240 OTPAIR(20, '=', 0, 0, LEXTMAB);
+37250 OTPAIR(21, '<', 10, 0, LEXLT);
+37260 OTPAIR(22, '>', 24, 0, LEXGT);
+37270 OTPAIR(23, '@', 0, 0, LEXAT);
+37280 OTPAIR(24, '=', 0, 0, LEXGE);
+37290 (*-51()
+37300 OTPAIR(25, '^', 0, 0, LEXUP1);
+37310 ()-51*)
+37320 OTPAIR(26, ';', 0, 0, LEXSEMIC);
+37330 OTPAIR(27, '=', 28, 29, LEXBECOM);
+37340 OTPAIR(28, ':', 0, 0, LEXIS);
+37350 OTPAIR(29, '/', 30, 0, LEXERROR);
+37360 OTPAIR(30, '=', 31, 0, LEXERROR);
+37370 OTPAIR(31, ':', 0, 0, LEXISNT);
+37380 ()+01*)
+37390 (*+25() (*CDC CODE*)
+37400 OTPAIR( 0, '+', 37, 0, LEXPLUS);
+37410 OTPAIR( 1, '-', 15, 0, LEXMINUS);
+37420 OTPAIR( 2, '*', 45, 0, LEXTIMES);
+37430 OTPAIR( 3, '/', 42, 0, LEXDIV);
+37440 OTPAIR( 4, '(', 0, 0, LEXOPEN);
+37450 OTPAIR( 5, ')', 0, 0, LEXCLOSE);
+37460 OTPAIR( 6, ':', 27, 0, LEXCOLON);
+37470 OTPAIR( 7, '=', 0, 0, LEXEQUAL);
+37480 OTPAIR( 8, ':', 0, 0, LEXAGAIN);
+37490 OTPAIR( 9, ',', 0, 0, LEXCOMMA);
+37500 OTPAIR(10, '=', 0, 0, LEXLE);
+37510 OTPAIR(11, '#', 0, 0, LEXCO2);
+37520 OTPAIR(12, '[', 0, 0, LEXSUBB);
+37530 OTPAIR(13, ']', 0, 0, LEXBUSB);
+37540 OTPAIR(14, '%', 32, 0, LEXOVER);
+37550 OTPAIR(15, ':', 16, 0, LEXERROR);
+37560 OTPAIR(16, '=', 0, 0, LEXMNAB);
+37570 (*-51()
+37580 OTPAIR(17, '!', 8, 0, LEXSTICK);
+37590 ()-51*)
+37600 (*+51()
+37610 OTPAIR(18, '&', 8, 0, LEXSTICK);
+37620 OTPAIR(19, '''', 0, 0, LEXUP1);
+37630 ()+51*)
+37640 OTPAIR(20, '=', 0, 0, LEXTMAB);
+37650 OTPAIR(21, '<', 10, 0, LEXLT);
+37660 OTPAIR(22, '>', 24, 0, LEXGT);
+37670 OTPAIR(23, '@', 0, 0, LEXAT);
+37680 OTPAIR(24, '=', 0, 0, LEXGE);
+37690 (*-51()
+37700 OTPAIR(25, '^', 0, 0, LEXUP1);
+37710 ()-51*)
+37720 OTPAIR(26, ';', 0, 0, LEXSEMIC);
+37730 OTPAIR(27, '=', 28, 29, LEXBECOM);
+37740 OTPAIR(28, ':', 0, 0, LEXIS);
+37750 OTPAIR(29, '/', 30, 0, LEXERROR);
+37760 OTPAIR(30, '=', 31, 0, LEXERROR);
+37770 OTPAIR(31, ':', 0, 0, LEXISNT);
+37780 ()+25*)
+37790 (*-01() (*ASCII*)
+37800 (*-25()
+37810 OTPAIR( 0, '!', 1, 0, LEXSTICK); (*!*)
+37820 OTPAIR( 1, ':', 0, 0, LEXAGAIN); (*!:*)
+37830 OTPAIR( 2, '#', 0, 0, LEXCO2 ); (*#*)
+37840 OTPAIR( 3, '[', 0, 0, LEXSUBB ); (*[*)
+37850 OTPAIR( 4, '\', 0, 0, LEXSTICK); (*STICK*)
+37860 OTPAIR( 5, ']', 0, 0, LEXBUSB ); (*]*)
+37870 OTPAIR( 6, '^', 0, 0, LEXUP1 ); (*^*)
+37880 OTPAIR( 7, '(', 0, 0, LEXOPEN ); (*(*)
+37890 OTPAIR( 8, ')', 0, 0, LEXCLOSE); (*)*)
+37900 OTPAIR( 9, '*', 45, 0, LEXTIMES); (***)
+37910 OTPAIR(10, '+', 37, 0, LEXPLUS ); (*+*)
+37920 OTPAIR(11, ',', 0, 0, LEXCOMMA); (*,*)
+37930 OTPAIR(12, '-', 21, 0, LEXMINUS); (*-*)
+37940 OTPAIR(13, '=', 0, 0, LEXLE ); (*<=*)
+37950 OTPAIR(14, '/', 42, 0, LEXDIV ); (* / *)
+37960 OTPAIR(15, '=', 16, 17, LEXBECOM);(*:=*)
+37970 OTPAIR(16, ':', 0, 0, LEXIS ); (*:=:*)
+37980 OTPAIR(17, '/', 18, 0, LEXERROR);
+37990 OTPAIR(18, '=', 19, 0, LEXERROR);
+38000 OTPAIR(19, ':', 0, 0, LEXISNT ); (*:/=:*)
+38010 OTPAIR(20, '=', 0, 0, LEXTMAB ); (**:=*)
+38020 OTPAIR(21, ':', 22, 0, LEXERROR);
+38030 OTPAIR(22, '=', 0, 0, LEXMNAB ); (*-:=*)
+38040 OTPAIR(23, '%', 32, 0, LEXOVER ); (*%*)
+38050 (*SPARE 24*)
+38060 OTPAIR(25, ':', 15, 0, LEXCOLON); (*:*)
+38070 OTPAIR(26, ';', 0, 0, LEXSEMIC); (*;*)
+38080 OTPAIR(27, '<', 13, 0, LEXLT ); (*<*)
+38090 OTPAIR(28, '=', 0, 0, LEXEQUAL); (*=*)
+38100 OTPAIR(29, '>', 30, 0, LEXGT ); (*>*)
+38110 OTPAIR(30, '=', 0, 0, LEXGE ); (*>=*)
+38120 OTPAIR(31, '@', 0, 0, LEXAT ); (*@*)
+38130 ()-25*)
+38140 ()-01*)
+38150 OTPAIR(32, '*', 33, 35, LEXMOD) ; (*%**)
+38160 OTPAIR(33, ':', 34, 0, LEXERROR);
+38170 OTPAIR(34, '=', 0, 0, LEXMDAB ); (*%*:=*)
+38180 OTPAIR(35, ':', 36, 0, LEXERROR);
+38190 OTPAIR(36, '=', 0, 0, LEXOVAB ); (*%:=*)
+38200 OTPAIR(37, '=', 38, 39, LEXERROR);
+38210 OTPAIR(38, ':', 0, 0, LEXPLTO ); (*+=:*)
+38220 OTPAIR(39, ':', 40, 41, LEXERROR);
+38230 OTPAIR(40, '=', 0, 0, LEXPLAB ); (*+:=*)
+38240 OTPAIR(41, '*', 0, 0, LEXPLITM); (*+**)
+38250 OTPAIR(42, '=', 0, 43, LEXNE ); (*/=*)
+38260 OTPAIR(43, ':', 44, 0, LEXERROR);
+38270 OTPAIR(44, '=', 0, 0, LEXDVAB ); (*/:=*)
+38280 OTPAIR(45, '*', 0, 46, LEXUP2 ); (****)
+38290 OTPAIR(46, ':', 20, 0, LEXERROR);
+38300 END;
+38310 PROCEDURE BOLDWORDS;
+38320 BEGIN
+38330 INTAB(LEXATB , 'AT ', LXVAT);
+38340 INTAB(LEXBEGIN , 'BEGIN ', LXVBEGIN);
+38350 INTAB(LEXBY , 'BY ', LXVBY);
+38360 INTAB(LEXCASE , 'CASE ', LXVCASE);
+38370 INTAB(LEXCO , 'CO ', LXVCMMENT);
+38380 INTAB(LEXCMMENT, 'COMMENT ', LXVCMMENT);
+38390 INTAB(LEXDO , 'DO ', LXVDO);
+38400 INTAB(LEXELIF , 'ELIF ', LXVELIF);
+38410 INTAB(LEXELSE , 'ELSE ', LXVELSE);
+38420 INTAB(LEXEMPTY , 'EMPTY ', LXVERROR);
+38430 INTAB(LEXEND , 'END ', LXVEND);
+38440 INTAB(LEXESAC , 'ESAC ', LXVESAC);
+38450 INTAB(LEXEXIT , 'EXIT ', LXVEXIT);
+38460 INTAB(LEXFALSE , 'FALSE ', LXVBOOLDEN);
+38470 INTAB(LEXFI , 'FI ', LXVFI);
+38480 INTAB(LEXFLEX , 'FLEX ', LXVERROR);
+38490 INTAB(LEXFOR , 'FOR ', LXVFOR);
+38500 INTAB(LEXFROM , 'FROM ', LXVFROM);
+38510 INTAB(LEXGO , 'GO ', LXVGO);
+38520 INTAB(LEXGOTO , 'GOTO ', LXVGOTO);
+38530 INTAB(LEXHEAP , 'HEAP ', LXVHEAP);
+38540 INTAB(LEXIF , 'IF ', LXVIF);
+38550 INTAB(LEXIN , 'IN ', LXVIN);
+38560 INTAB(LEXISB , 'IS ', LXVIDTY);
+38570 INTAB(LEXISNTB , 'ISNT ', LXVIDTY);
+38580 INTAB(LEXLOC , 'LOC ', LXVLOC);
+38590 INTAB(LEXLONG , 'LONG ', LXVLONG);
+38600 INTAB(LEXMODE , 'MODE ', LXVMODE);
+38610 INTAB(LEXNIL , 'NIL ', LXVNIL);
+38620 INTAB(LEXOD , 'OD ', LXVOD);
+38630 INTAB(LEXOF , 'OF ', LXVOF);
+38640 INTAB(LEXOP , 'OP ', LXVOP);
+38650 INTAB(LEXOUSE , 'OUSE ', LXVOUSE);
+38660 INTAB(LEXOUT , 'OUT ', LXVOUT);
+38670 INTAB(LEXPAR , 'PAR ', LXVERROR);
+38680 INTAB(LEXPR , 'PR ', LXVPRAGMAT);
+38690 INTAB(LEXPRAGMAT, 'PRAGMAT ', LXVPRAGMAT);
+38700 INTAB(LEXPRIO , 'PRIO ', LXVPRIO);
+38710 INTAB(LEXPROC , 'PROC ', LXVPROC);
+38720 INTAB(LEXREF , 'REF ', LXVREF);
+38730 INTAB(LEXSEMA , 'SEMA ', LXVERROR);
+38740 INTAB(LEXSHORT , 'SHORT ', LXVSHORT);
+38750 INTAB(LEXSKIP , 'SKIP ', LXVSKIP);
+38760 INTAB(LEXSTRUCT , 'STRUCT ', LXVSTRUCT);
+38770 INTAB(LEXTHEN , 'THEN ', LXVTHEN);
+38780 INTAB(LEXTO , 'TO ', LXVTO);
+38790 INTAB(LEXTRUE , 'TRUE ', LXVBOOLDEN);
+38800 INTAB(LEXUNION , 'UNION ', LXVERROR);
+38810 INTAB(LEXVOID , 'VOID ', LXVVOID);
+38820 INTAB(LEXWHILE , 'WHILE ', LXVWHILE);
+38830 END;
+38840 ()+81*)
+38850 (*+84()
+38860 PROCEDURE INITMODES;
+38870 CONST SIMPLE=FALSE; PILE=TRUE; UNDRESSED=FALSE; DRESSED=TRUE; IO=TRUE;
+38880 NOIO=FALSE; O=FALSE; SCOPE=TRUE;
+38890 VAR I: INTEGER;
+38900 PRFB: MODE;
+38910 PLX: PLEX; LXEM: LXM; LX: LXM;
+38920 PROCEDURE MDVVAL(VAR V: MDM; ID: MDIDTYPE; PILE, DRESSED, IO, SCOPE: BOOLEAN; LENGTH: INTEGER);
+38930 (*+02() (*-25() VAR CLEAR: RECORD CASE BOOLEAN OF
+38940 TRUE: (V:MDM); FALSE: (A: ARRAY[1..MODE1SIZE] OF INTEGER) END
+38950 I: INTEGER; ()-25*) ()+02*)
+38960 BEGIN
+38970 (*+02() (*-25() WITH CLEAR DO FOR I:= 1 TO MODE1SIZE DIV SZWORD DO A[I] := 0;
+38980 V := CLEAR.V;
+38990 ()-25*) ()+02*)
+39000 WITH V DO
+39010 BEGIN MDID := ID; MDLEN := LENGTH;
+39020 MDDEPROC := FALSE; MDRECUR := FALSE;
+39030 MDDRESSED := DRESSED; MDIO := IO; MDPILE := PILE; MDSCOPE := SCOPE; MDCNT := 0
+39040 END
+39050 END;
+39060 PROCEDURE MDVAR(VAR V: MODE; MDV: MDM);
+39070 BEGIN ENEW(V, MODE1SIZE); V^.MDV := MDV END;
+39080 PROCEDURE MDIND(TAG: ALFA; M: MODE);
+39090 VAR LEX: PLEX; STB: PSTB;
+39100 BEGIN
+39110 INTAB(LEX,TAG,LX);
+39120 LEX^.LXV.LXPMD := M
+39130 END;
+39140 PROCEDURE PUTFIELD(M: MODE; L: PLEX);
+39150 BEGIN
+39152 SRSEMP := SRSEMP+2;
+39154 SRSTK[SRSEMP-1].MD := M;
+39156 SRSTK[SRSEMP].LEX := L ;
+39158 END;
+39160 (**)
+39170 BEGIN
+39180 REFL := NIL; ROWL := NIL; PROCL := NIL; PASCL := NIL; STRUCTL := NIL;
+39190 MDVVAL(MDVINT , MDIDINT , SIMPLE, O , IO , O , SZINT);
+39200 MDVVAL(MDVLINT , MDIDLINT , SIMPLE, UNDRESSED, IO , O , SZLONG);
+39210 MDVVAL(MDVREAL , MDIDREAL , SIMPLE, O , IO , O , SZREAL);
+39220 MDVVAL(MDVLREAL , MDIDLREAL , SIMPLE, UNDRESSED, IO , O , 2*SZREAL);
+39230 MDVVAL(MDVCHAR , MDIDCHAR , SIMPLE, O , IO , O , SZWORD);
+39240 MDVVAL(MDVBITS , MDIDBITS , SIMPLE, O , IO , O , SZINT);
+39250 MDVVAL(MDVBYTES , MDIDBYTES , SIMPLE, O , IO ,O , SZINT);
+39260 MDVVAL(MDVSTRNG , MDIDSTRNG , PILE , DRESSED , IO , O , SZADDR);
+39270 MDVVAL(MDVBOOL , MDIDBOOL , SIMPLE, O , IO , O , SZWORD);
+39280 MDVVAL(MDVCHAN , MDIDCHAN , SIMPLE, O , NOIO, O , SZPROC);
+39290 MDVVAL(MDVCOVER , MDIDCOVER , PILE , DRESSED , NOIO, O , SZADDR);
+39300 MDVVAL(MDVVOID , MDIDVOID , O , O , NOIO, O , 0);
+39310 MDVVAL(MDVSKIP , MDIDSKIP , O , O , NOIO, O , 0);
+39320 MDVVAL(MDVJUMP , MDIDJUMP , O , O , NOIO, O , 0);
+39330 MDVVAL(MDVNIL , MDIDNIL , O , O , NOIO, O , 0);
+39340 MDVVAL(MDVOUT , MDIDOUT , O , O , O , O , SZWORD+SZINT);
+39350 MDVVAL(MDVIN , MDIDIN , O , O , O , SCOPE, 2*SZWORD+SZADDR);
+39360 MDVVAL(MDVOUTB , MDIDOUTB , O , O , O , O , SZWORD+SZINT);
+39370 MDVVAL(MDVINB , MDIDINB , O , O , O , SCOPE, SZWORD+SZADDR);
+39380 MDVVAL(MDVNUMBER, MDIDNUMBER, O , O , O , O , SZWORD+SZINT);
+39390 MDVVAL(MDVROWS , MDIDROWS , PILE , DRESSED , O , O , SZADDR);
+39400 MDVVAL(MDVBNDS , MDIDBNDS , PILE , O , NOIO, O , SZADDR);
+39410 MDVVAL(MDVABSENT, MDIDABSENT, SIMPLE, O , O , O , SZWORD);
+39420 (*CAN BE USED TO MANUFACTURE UN-USER-FORGEABLE STRUCTURES*)
+39430 MDVVAL(MDVERROR , MDIDERROR , SIMPLE, O , O , O , SZWORD);
+39440 MDVVAL(MDVPROC , MDIDPROC , PILE , DRESSED , NOIO, SCOPE, SZADDR);
+39450 MDVVAL(MDVREF , MDIDREF , PILE , DRESSED , NOIO, SCOPE, SZADDR);
+39460 MDVVAL(MDVSTRUCT, MDIDSTRUCT, PILE , UNDRESSED, NOIO, SCOPE, 0);
+39470 MDVVAL(MDVROW , MDIDROW , PILE , O , NOIO, SCOPE, 0);
+39480 MDVVAL(MDVPASC , MDIDPASC , SIMPLE, O , NOIO, O , SZPROC);
+39500 (*SET UP MD VALUES*)
+39510 MDVAR(MDINT , MDVINT);
+39520 MDVAR(MDLINT , MDVLINT);
+39530 MDVAR(MDBITS , MDVBITS);
+39540 MDVAR(MDBYTES , MDVBYTES);
+39550 MDVAR(MDREAL , MDVREAL);
+39560 MDVAR(MDLREAL , MDVLREAL);
+39570 MDVAR(MDBOOL , MDVBOOL);
+39580 MDVAR(MDCHAN , MDVCHAN);
+39590 MDVAR(MDCHAR , MDVCHAR);
+39600 MDVAR(MDSTRNG, MDVSTRNG);
+39610 MDVAR(MDCOVER , MDVCOVER);
+39620 MDVAR(MDVOID , MDVVOID);
+39630 MDVAR(MDSKIP , MDVSKIP);
+39640 MDVAR(MDJUMP , MDVJUMP);
+39650 MDVAR(MDNIL , MDVNIL);
+39660 MDVAR(MDOUT , MDVOUT);
+39670 MDVAR(MDIN , MDVIN);
+39680 MDVAR(MDOUTB , MDVOUTB);
+39690 MDVAR(MDINB , MDVINB);
+39700 MDVAR(MDNUMBER, MDVNUMBER);
+39710 MDVAR(MDROWS , MDVROWS);
+39720 MDVAR(MDBNDS , MDVBNDS);
+39730 MDVAR(MDABSENT, MDVABSENT);
+39740 MDVAR(MDROUT , MDVPROC);
+39750 MDVAR(MDERROR , MDVERROR);
+39760 INTAB(PLX,'GO ',LXEM);
+39770 PLX^.LXV.LXPMD := MDJUMP;
+39780 INTAB(PLX,'GOTO ',LXEM);
+39790 PLX^.LXV.LXPMD := MDJUMP;
+39800 INTAB(PLX,'IS ',LXEM);
+39810 PLX^.LXV.LXP := 0;
+39820 INTAB(PLX,'ISNT ',LXEM);
+39830 PLX^.LXV.LXP := 1;
+39840 INTAB(PLX,'NIL ',LXEM);
+39850 PLX^.LXV.LXPMD := MDNIL;
+39860 INTAB(PLX,'SKIP ',LXEM);
+39870 PLX^.LXV.LXPMD := MDSKIP;
+39880 INTAB(PLX,'VOID ',LXEM);
+39890 PLX^.LXV.LXPMD := MDVOID;
+39900 MDREFERROR := FINDREF(MDERROR);
+39910 PRCBNDS := DEFPRC0(MDBNDS, PROC);
+39920 PRCERROR := DEFPRC0(MDERROR, PROC);
+39930 SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+39940 PUTFIELD(MDREAL, DEFTAG('RE '));
+39950 PUTFIELD(MDREAL, DEFTAG('IM '));
+39960 FINSTRUCT(2); MDCOMPL := SRSTK[SRSEMP].MD;
+39970 (*MDLCOMPL OUGHT TO BE DONE ONE OF THESE DAYS, TOO*)
+39980 MDFILE := NIL; (*BECAUSE IT IS TO BE A RECURSIVE MODE*)
+39990 PRFB := DEFPRC1(FINDREF(MDFILE), MDBOOL, PROC);
+40000 SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+40010 FOR I := 1 TO 4 DO
+40020 PUTFIELD(PRFB, LEXALEPH);
+40030 PUTFIELD(MDCOVER, LEXALEPH);
+40040 FOR I := 1 TO SZTERM DIV SZINT DO
+40050 PUTFIELD(MDINT, LEXALEPH);
+40060 FINSTRUCT(5+SZTERM DIV SZINT); MDFILE := SRSTK[SRSEMP].MD;
+40070 PRCVF := DEFPRC1(FINDREF(MDFILE), MDVOID, PROC);
+40080 PASCVF := DEFPRC1(FINDREF(MDFILE), MDVOID, PASC);
+40090 ROWBOOL := FINDROW(MDBOOL,1);
+40100 ROWCHAR := FINDROW(MDCHAR,1);
+40110 ROWIN := FINDROW(MDIN,1);
+40120 ROWINB := FINDROW(MDINB,1);
+40130 REFSTRNG := FINDREF(MDSTRNG);
+40140 (*+54()
+40150 SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+40160 PUTFIELD(MDINT, DEFTAG('ALEPH '));
+40170 PUTFIELD(MDABSENT, LEXALEPH);
+40180 FINSTRUCT(2); MDEXC := SRSTK[SRSEMP].MD;
+40190 ()+54*)
+40200 (*SET UP STANDARD-PRELUDE MODE-INDICATIONS*)
+40210 LXVVAL(LX,LXIOPRDR,0,2,08);
+40220 MDIND('INT ', MDINT);
+40230 MDIND('BITS ', MDBITS);
+40240 MDIND('BYTES ', MDBYTES);
+40250 MDIND('REAL ', MDREAL);
+40260 MDIND('BOOL ', MDBOOL);
+40270 MDIND('CHANNEL ', MDCHAN);
+40280 MDIND('CHAR ', MDCHAR);
+40290 MDIND('STRING ', MDSTRNG);
+40300 MDIND('FILE ', MDFILE);
+40310 MDIND('COMPL ', MDCOMPL);
+40320 (*+54() MDIND('EXCEPTION ', MDEXC); ()+54*)
+40330 MODEID[MDIDINT]:=0;
+40340 MODEID[MDIDLINT]:=1;
+40350 MODEID[MDIDREAL]:=2;
+40360 MODEID[MDIDLREAL]:=3;
+40370 MODEID[MDIDCHAR]:=6;
+40380 MODEID[MDIDBITS]:=9;
+40390 MODEID[MDIDBYTES]:=10;
+40400 MODEID[MDIDSTRNG]:=7;
+40410 MODEID[MDIDBOOL]:=8;
+40420 MODEID[MDIDCHAN]:=-1;
+40430 MODEID[MDIDCOVER]:=-1;
+40440 MODEID[MDIDVOID]:=-1;
+40450 MODEID[MDIDSKIP]:=-1;
+40460 MODEID[MDIDJUMP]:=-1;
+40470 MODEID[MDIDNIL]:=-1;
+40480 MODEID[MDIDOUT]:=-1;
+40490 MODEID[MDIDIN]:=-1;
+40500 MODEID[MDIDOUTB]:=-1;
+40510 MODEID[MDIDINB]:=-1;
+40520 MODEID[MDIDNUMBER]:=-1;
+40530 MODEID[MDIDROWS]:=-1;
+40540 MODEID[MDIDBNDS]:=-1;
+40550 MODEID[MDIDABSENT]:=-1;
+40560 MODEID[MDIDPROC]:=11;
+40570 MODEID[MDIDREF]:=-1;
+40580 MODEID[MDIDSTRUCT]:=12; (*BUT NOT COMPL*)
+40590 MODEID[MDIDROW]:=13;
+40600 MODEID[MDIDPASC]:=14;
+40620 XMODES[XINT] := MDINT;
+40630 XMODES[XLINT] := MDLINT;
+40640 XMODES[XREAL] := MDREAL;
+40650 XMODES[XLREAL] := MDLREAL;
+40660 XMODES[XCOMPL] := MDCOMPL;
+40670 (*+61()
+40680 XMODES[XLCOMPL] := MDLCOMPL;
+40690 ()+61*)
+40700 XMODES[XCHAR] := MDCHAR;
+40710 XMODES[XSTRNG] := MDSTRNG;
+40720 XMODES[XBOOL] := MDBOOL;
+40730 XMODES[XBITS] := MDBITS;
+40740 XMODES[XBYTES] := MDBYTES;
+40750 END;
+40760 (**)
+40770 ()+84*)
+40780 (**)
+40790 BEGIN (*INITIALIZE*)
+40800 (*+81()
+40810 INITLEXES;
+40820 MAKEPUSHTBL;
+40830 (**)
+40840 OTPAIRS;
+40850 FOR I := 0 TO HTSIZE DO
+40860 HT[I] := NIL;
+40870 INPRAGMENT := FALSE;
+40880 ENEW(LEXALEPH, LEX1SIZE); WITH LEXALEPH^ DO
+40890 BEGIN LXV:=LXVTAG; LXCOUNT:=0; LXTOKEN:=TKTAG END;
+40900 BOLDWORDS;
+40910 ()+81*)
+40920 (*+84() INITMODES; ()+84*)
+40930 (*+84()
+40940 ENEW(LEXONE, SZADDR+SZINT+LEX1SIZE); WITH LEXONE^ DO
+40950 BEGIN LXV:=LXVPRDEN; LXCOUNT:= (SZADDR+SZINT) DIV SZWORD; LXTOKEN:=TKDENOT; LXDENRP:=1; LXDENMD:=MDINT END;
+40960 ()+84*)
+40970 END;
+40980 (**)
+40990 ()+83*)
--- /dev/null
+12000 (*+84()
+12002 PROCEDURE FIND(VAR SEARCHLIST: MODE; RECURSIVE: BOOLEAN; LENGTH: CNTR); EXTERN;
+12010 PROCEDURE FINDPRC(RESMD: MODE; CNT: CNTR; CP:CODEPROC); EXTERN;
+12020 PROCEDURE FINSTRUCT(CNT: CNTR); EXTERN;
+12030 FUNCTION FINDREF(M: MODE): MODE; EXTERN;
+12040 FUNCTION FINDROW(M: MODE; CNT:CNTR): MODE; EXTERN;
+12050 PROCEDURE NEWFIELD(LEX: PLEX); EXTERN;
+12060 PROCEDURE RECURFIX(VAR BASEM: MODE); EXTERN;
+12070 ()+84*)
+12090 (*+05() PROCEDURE OPENLOADFILE(VAR F: LOADFILE; PARAM: INTEGER; WRITING: BOOLEAN); EXTERN;
+12100 PROCEDURE OPENTEXT(VAR F: TEXT; PARAM: INTEGER; WRITING: BOOLEAN); EXTERN;
+12110 ()+05*)
+12120 PROCEDURE CHECKPAGE; EXTERN;
+12130 PROCEDURE OUTLST(LINE: INTEGER; VAR BUF: BUFFER; PTR: INTEGER); EXTERN;
+12140 PROCEDURE OUTERR(N: INTEGER; LEV: ERRLEV; LEX: PLEX); EXTERN;
+12150 PROCEDURE SEMERR(N: INTEGER); EXTERN;
+12160 PROCEDURE INITIO; EXTERN;
+12170 PROCEDURE SEMERRP(N: INTEGER; LEX: PLEX); EXTERN;
+12180 PROCEDURE SUBREST; EXTERN;
+12190 PROCEDURE SUBSAVE; EXTERN;
+12200 PROCEDURE SCPUSH(M: MODE); EXTERN;
+12210 FUNCTION SCPOP: MODE; EXTERN;
+12220 FUNCTION SRPOPMD: MODE; EXTERN;
+12230 PROCEDURE MODERR(M: MODE; N: INTEGER); EXTERN;
+12240 FUNCTION HASHIN: PLEX; EXTERN;
+12260 (*+82()
+12270 PROCEDURE INITLX; EXTERN;
+12280 PROCEDURE NEXTCH(LEVEL: INDEXTYPE); EXTERN;
+12290 PROCEDURE LXERR(N: INTEGER); EXTERN;
+12300 PROCEDURE LEXALF(LEX: PLEX; VAR ALF: ALFA); EXTERN;
+12310 FUNCTION PARSIN: PLEX; EXTERN;
+12320 ()+82*)
--- /dev/null
+50000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+50010 (**)
+50020 (**)
+50030 (*+82()
+50040 (**)
+50050 (*+01() (*+31() (*$P+,T+*) ()+31*) ()+01*)
+50060 (*+25() (*+31() (*$P+,T+*) ()+31*) ()+25*)
+50070 (**)
+50080 PROCEDURE PARSEPARSER;
+50090 VAR ACOUNT, BCOUNT: INTEGER; CCOUNT: 0..10000;
+50100 HTCOPY: HASHTAB;
+50110 THIS, THAT: PLEX;
+50120 BPRODTBL: ARRAY [1..40] OF PROD;
+50130 SEXFR,FEXFR:ARRAY[0..PRODLEN] OF 0..PRODLEN;
+50140 TEMP:INTEGER;
+50150 I: INTEGER;
+50160 J: INTEGER;
+50165 (* MAP: RECORD CASE BOOLEAN OF
+50166 TRUE : (INT:ADDRINT);
+50167 FALSE : (POINT:^INTEGER);
+50168 END; *)
+50170 (*+01()
+50180 FRED: PLEX;
+50190 FRIG: RECORD CASE SEVERAL OF
+50200 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
+50210 ()+01*)
+50220 (*+25()
+50230 FRIG: RECORD CASE SEVERAL OF
+50240 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
+50250 ()+25*)
+50260 (*+04()
+50270 PROCEDURE INITIO;
+50280 (*+01() VAR AW66: PW66; ()+01*)
+50290 BEGIN
+50300 ERRDEV := FALSE;
+50310 (*+23() NUMPARAMS:=0; (* TO COUNT NO OF P-OP PARAMETERS OUTPUT TO LSTFILE *) ()+23*)
+50320 LSTLINE := -1; (*FOR FIRST TIME OF OUTSRC*)
+50330 LSTCNT := 100; (*TO FORCE NEWPAGE*)
+50340 LSTPAGE := 0;
+50350 (*-03() (*-04()
+50360 RESET(INPUT);
+50370 REWRITE(LSTFILE);
+50380 ()-04*) ()-03*)
+50390 (*+03()
+50400 WRITE('SOURCE-FILE: ');
+50410 OPEN(INPUT,'','SYMB',SEQRD);
+50420 WRITE('LIST-FILE: ');
+50430 OPEN(LSTFILE,'','DATA',SEQWR);
+50440 OPEN(OUTPUT,'TERMINAL','SYMB',SEQWR);
+50450 ()+03*)
+50460 RESET(INPUT, 'INPUT');
+50470 REWRITE(OUTPUT, 'CONSOLE');
+50480 REWRITE(LSTFILE, 'LSTFILE');
+50490 SRCBUF[0] := ' '; (*IT WILL NEVER BE WRITTEN TO AGAIN*)
+50500 (*+01()
+50510 LINELIMIT(OUTPUT, 100000);
+50520 AW66 := ASPTR(66B);
+50530 ONLINE := AW66^.JOPR=3;
+50540 ()+01*)
+50550 (*+02() ONLINE := TRUE; ()+02*)
+50560 (*+03() ONLINE := FILENR(LSTFILE)<>1; ()+03*)
+50570 ONLINE := TRUE;
+50580 (*-04() (*-02() DATE(DAT); TIME(TIM); ()-02*) ()-04*)
+50590 END;
+50600 ()+04*)
+50610 PROCEDURE CLASS(TAG: ALFA);
+50620 VAR DUMMY: PLEX;
+50630 I: INTEGER;
+50640 BEGIN WITH CURRENTLEX DO
+50650 BEGIN
+50660 LXV := LXVTAB; LXTOKEN := TKTAG;
+50670 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+50680 (*-11() STASHLEX(TAG); ()-11*)
+50690 DUMMY := HASHIN
+50700 END
+50710 END;
+50720 PROCEDURE TLEX(TAG: ALFA; SLEX: LXIOTYPE);
+50730 VAR DUMMY: PLEX;
+50740 I: INTEGER;
+50750 BEGIN WITH CURRENTLEX DO
+50760 BEGIN
+50770 LXV := LXVTAG; LXTOKEN := TKTAG; LXV.LXPIO := SLEX;
+50780 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+50790 (*-11() STASHLEX(TAG); ()-11*)
+50800 DUMMY := HASHIN;
+50810 END
+50820 END;
+50830 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
+50840 VAR C: INTEGER;
+50850 SAE: CHAR;
+50860 PROCEDURE LABL(SEX, FEX, VALUE: INTEGER);
+50870 VAR TEMP: INTEGER;
+50880 BEGIN
+50890 WHILE SEX<>0 DO
+50900 BEGIN TEMP := PRODTBL[SEX].SEXIT; PRODTBL[SEX].SEXIT := VALUE; SEX := TEMP END;
+50910 WHILE FEX<>0 DO
+50920 BEGIN TEMP := PRODTBL[FEX].FEXIT; PRODTBL[FEX].FEXIT := VALUE; FEX := TEMP END
+50930 END;
+50940 BEGIN WITH SRPLSTK[PLSTKP]^ DO WITH PRODTBL[(BCOUNT-1) MOD PRODLEN + 1] DO CASE SRTN OF
+50950 10: (*SR01*) (*START OF EACH RULE*)
+50960 ACOUNT := 0;
+50970 11: (*SR02*) (*TAG*)
+50980 IF ACOUNT=0 THEN BEGIN PRSTKC := S; SYLXV.LX1IO := LXV.LXPIO END
+50990 ELSE IF ACOUNT=1 THEN BEGIN PRSTKA := 2; PRINPC := SSA; SYLXV.LX2IO := LXV.LXPIO; ACOUNT := -99 END
+51000 ELSE (*ACOUNT<0*) BEGIN PRINPC := S; SYLXV.LX2IO := LXV.LXPIO END;
+51010 12: (*SR03A*) (*TAB*)
+51020 BEGIN C := ORD(S10[4])-ORD('0');
+51030 IF (C<0) OR (C>9) THEN C := ORD(S10[4])-ORD('A')+10;
+51040 IF S10[1]='C' THEN WITH SYLXV DO
+51050 IF ACOUNT=0 THEN CASE S10[3] OF
+51060 '0': BEGIN PRSTKC:=C0; LX1CL0:=C END; '1': BEGIN PRSTKC:=C1; LX1CL1:=C END;
+51070 '2': BEGIN PRSTKC:=C2; LX1CL2:=C END; END
+51080 ELSE CASE S10[3] OF
+51090 '0': BEGIN PRINPC:=C0; LX2CL0:=C END; '1': BEGIN PRINPC:=C1; LX2CL1:=C END;
+51100 '2': BEGIN PRINPC:=C2; LX2CL2:=C END; END END;
+51110 35: (*SR20B)* (*NO 2ND TAG OR TAB*)
+51120 IF ACOUNT=-1 THEN BEGIN PRINPC := A; SYLXV.LX2IO := LXIODUMMY END;
+51130 13: (*SR03B*) (*NO 1ST TAG OR TAB*)
+51140 BEGIN ACOUNT := -1; PRSTKC := S; SYLXV.LX1IO := LXIODUMMY; PRSTKA := 3 END;
+51150 14: (*SR04A*) (*AFTER COMMA*)
+51160 ACOUNT := ACOUNT+1;
+51170 15: (*SR04B*) (*AFTER STICK*)
+51180 IF ACOUNT>=0 THEN
+51190 BEGIN PRSTKA := ACOUNT; ACOUNT := -1 END;
+51200 16: (*SR05*) (*RTN PRESENT*)
+51210 BEGIN
+51220 SAE := SRPLSTK[PLSTKP]^.S10[1];
+51230 IF (SAE = 'S') OR (SAE = 'A') THEN C := 0
+51240 ELSE IF SAE = 'E' THEN C := ESY01-1
+51250 ELSE SEMERR(ESE+16);
+51260 RTN := C + (*-04() INP^.LXDENRP ()-04*)(*+04() SHRINK(INP^.LXDENRP) ()+04*)
+51270 END;
+51280 17: (*SR06*) (*RTN ABSENT*)
+51290 RTN := DUMMY;
+51300 18: (*SR07A*) (*POP PRESENT*)
+51310 PRPOP := (*-04() INP^.LXDENRP ()-04*)(*+04() SHRINK(INP^.LXDENRP) ()+04*);
+51320 19: (*SR07B*) (*POP ABSENT*)
+51330 BEGIN PRPOP := 0; PRPUSH := LXIODUMMY END;
+51340 20: (*SR08A*) (*PUSH PRESENT*)
+51350 PRPUSH := INP^.LXV.LXPIO;
+51360 21: (*SR08B*) (*PUSH ABSENT*)
+51370 PRPUSH := LXIODUMMY;
+51380 22: (*SR10*) (*SKIP PRESENT*)
+51390 PRSKIP := TRUE;
+51400 23: (*SR11*) (*SKIP ABSENT*)
+51410 PRSKIP := FALSE;
+51420 24: (*SR12*) (*SCAN=++*)
+51430 PRSCAN := 2;
+51440 25: (*SR14A)* (*SCAN=+*)
+51450 PRSCAN := 1;
+51460 26: (*SR14B*) (*SCAN ABSENT*)
+51470 PRSCAN := 0;
+51480 28: (*SR15*) (*SEX*)
+51490 IF (LXV.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
+51500 SEXIT := LXV.LXP
+51510 ELSE
+51520 BEGIN
+51530 IF LXV.LXPSTB=NIL THEN
+51540 BEGIN
+51550 CCOUNT:=CCOUNT+1; LXV.LXP:=PRODLEN+CCOUNT;
+51560 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
+51570 END;
+51580 TEMP:=LXV.LXP-PRODLEN;
+51590 SEXIT:=SEXFR[TEMP]; SEXFR[TEMP]:=BCOUNT
+51600 END;
+51610 29: (*SR16A*) (*FEX*)
+51620 IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
+51630 FEXIT := INP^.LXV.LXP
+51640 ELSE
+51650 BEGIN
+51660 IF INP^.LXV.LXPSTB=NIL THEN
+51670 BEGIN
+51680 CCOUNT:=CCOUNT+1; INP^.LXV.LXP:=PRODLEN+CCOUNT;
+51690 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
+51700 END;
+51710 TEMP:=INP^.LXV.LXP-PRODLEN;
+51720 FEXIT:=FEXFR[TEMP];FEXFR[TEMP]:=BCOUNT
+51730 END;
+51740 30: (*SR16B*) (*FEX ABSENT*)
+51750 FEXIT := BCOUNT+1;
+51760 31: (*SR16C*) (*END OF RULE*)
+51770 BCOUNT := BCOUNT+1;
+51780 32: (*SR16D*) (*ERROR*)
+51790 OUTERR(ELX+7, ERRORR, NIL);
+51800 34: (*SR20A*) (*AT LABEL*)
+51810 BEGIN
+51820 IF LXV.LXPSTB<>NIL THEN
+51830 BEGIN
+51840 TEMP:=LXV.LXP-PRODLEN;
+51850 LABL(SEXFR[TEMP],FEXFR[TEMP],BCOUNT);
+51860 SEXFR[TEMP]:=0; FEXFR[TEMP]:=0;
+51870 WHILE (CCOUNT>0) AND (SEXFR[CCOUNT]=0) AND (FEXFR[CCOUNT]=0)
+51880 DO CCOUNT:=CCOUNT-1
+51890 END;
+51900 LXV.LXP := BCOUNT END;
+51910 36: (*SR20C*) (*END OF FILE*)
+51920 ENDOFPROG := TRUE;
+51930 END
+51940 END;
+51950 ()+82*)
+51960 (*OLD VERSION OF SEMANTICROUTINE WHICH WAS USED TO PRODUCE THE CALLS OF MPROD AND BLABL WHICH FOLLOW*)
+51970 (*
+51980 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
+51990 VAR C: INTEGER;
+52000 SAR: CHAR;
+52010 BEGIN WITH SRPLSTK[PLSTKP]^ DO CASE SRTN OF
+52020 10: (*SR01+) BEGIN WRITE(LSTFILE, ' BMPROD(', BCOUNT:3, ', '); ACOUNT:=0; END;
+52030 11: (*SR02+): IF ACOUNT<>1 THEN WRITE(LSTFILE, 'S , LXIO', S1, ', 0, ')
+52040 ELSE BEGIN WRITE(LSTFILE, '2, SSA,LXIO', S1, ', 0, '); ACOUNT:=-99 END;
+52050 12: (*SR03A+) BEGIN C := ORD(S1[4])-ORD('0');
+52060 IF (C<0) OR (C>9) THEN C := ORD(S1[4])-ORD('A')+10;
+52070 IF S1[1]='C' THEN WRITE(LSTFILE, 'C', S1[3], ', LXIODUMMY , ', C:2, ', ') END;
+52080 35: (*SR20B+) IF ACOUNT=-1 THEN WRITE(LSTFILE, 'A , LXIODUMMY , 0, ');
+52090 13: (*SR03B+) BEGIN ACOUNT:=-1; WRITE(LSTFILE, 'S , LXIODUMMY , 0, 3, ') END;
+52100 14: (*SR04A+) ACOUNT := ACOUNT+1;
+52110 15: (*SR04B+) IF ACOUNT>=0 THEN
+52120 BEGIN WRITE(LSTFILE, ACOUNT:1, ', '); ACOUNT:=-1 END;
+52130 16: (*SR05+) BEGIN SAE := SRPLSTK[PLSTKP].S1[1];
+52140 IF (SAE='S') OR (SAE = 'A') THEN C:=0
+52150 ELSE IF SAE='E' THEN C:=ESY01-1
+52160 ELSE SEMERR(ESE+16);
+52170 WRITE(LSTFILE,C+INP^.LXDENRP:4)
+52180 END;
+52190 17: (*SR06+) WRITE(LSTFILE, 'DUMMY , ');
+52200 18: (*SR07A+) WRITE(LSTFILE, INP^.LXDENRP:1, ', ');
+52210 19: (*SR07B+) WRITE(LSTFILE, '0, LXIODUMMY , ');
+52220 20: (*SR08A+) WRITE(LSTFILE, 'LXIO', INP^.S1, ', ');
+52230 21: (*SR08B+) WRITE(LSTFILE, 'LXIODUMMY , ');
+52240 22: (*SR10+) WRITE(LSTFILE, 'TRUE , ');
+52250 23: (*SR11+) WRITE(LSTFILE, 'FALSE, ');
+52260 24: (*SR12+) WRITE(LSTFILE, '2, ');
+52270 25: (*SR14A+) WRITE(LSTFILE, '1, ');:
+52280 26: (*SR14B+) WRITE(LSTFILE, '0, ');:
+52290 28: (*SR15+) IF (LXV.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
+52300 WRITE(LSTFILE, LXV.LXP:4, ', ')
+52310 ELSE BEGIN
+52320 IF LXV.LXPSTB=NIL THEN BEGIN LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
+52330 WRITE(LSTFILE, -(LXV.LXP DIV PRODLEN-1):4, ', ');
+52340 LXV.LXP := LXV.LXP MOD PRODLEN + (BCOUNT+1)*PRODLEN END;
+52350 29: (*SR16A+) IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
+52360 WRITE(LSTFILE, INP^.LXV.LXP:4)
+52370 ELSE BEGIN
+52380 IF INP^.LXV.LXPSTB=NIL THEN BEGIN INP^.LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
+52390 WRITE(LSTFILE, -(INP^.LXV.LXP MOD PRODLEN):4);
+52400 INP^.LXV.LXP := INP^.LXV.LXP DIV PRODLEN * PRODLEN + BCOUNT END;
+52410 30: (*SR16B+) WRITE(LSTFILE, BCOUNT+1:4);
+52420 31: (*SR16C+) BEGIN WRITELN(LSTFILE,');'); BCOUNT := BCOUNT+1; END;
+52430 32: (*SR16D+) OUTERR(ELX+7, ERRORR, NIL);
+52440 34: (*SR20A+) BEGIN
+52450 IF LXV.LXPSTB<>NIL THEN BEGIN
+52460 WRITELN(LSTFILE, ' BLABL(', LXV.LXP DIV PRODLEN - 1:3, ', ',
+52470 LXV.LXP MOD PRODLEN:3, ', ', BCOUNT:3, ');');
+52480 CCOUNT := CCOUNT-1;
+52490 END;
+52500 LXV.LXP := BCOUNT END;
+52510 36: (*SR20C+) ENDOFPROG := TRUE;
+52520 END
+52530 END;
+52540 *)
+52550 (*+82()
+52560 PROCEDURE INITPR;
+52570 BEGIN
+52580 PLINPQ := NIL;
+52590 PLPTR := 1;
+52600 SRPLSTK[SRPLSTKSIZE] := LEXSTOP;
+52610 SRPLSTK[SRPLSTKSIZE-1] := LEXSTOP;
+52620 PLSTKP := SRPLSTKSIZE-1;
+52630 ENDOFPROG := FALSE;
+52640 INP := LEXSTART
+52650 END;
+52660 PROCEDURE BMPROD(PTR: INTEGER;
+52670 CONFIG1: CONFIG; IO1: LXIOTYPE; CLA1: CL2TYPE; STKA: INTEGER;
+52680 CONFIG2: CONFIG; IO2: LXIOTYPE; CLA2: CL2TYPE;
+52690 SRTN: RTNTYPE; POP: INTEGER; PUSH: LXIOTYPE; SKIP: BOOLEAN; SCAN: INTEGER; SEX, FEX: INTEGER);
+52700 BEGIN WITH BPRODTBL[PTR] DO
+52710 BEGIN
+52720 PRSTKA := STKA; PRSTKC := CONFIG1; PRINPC := CONFIG2;
+52730 CASE CONFIG1 OF S: SYLXV.LX1IO := IO1;
+52740 C0: SYLXV.LX1CL0 := CLA1; C1: SYLXV.LX1CL1 := CLA1; C2: SYLXV.LX1CL2 := CLA1 END;
+52750 CASE CONFIG2 OF S, A, SSA: SYLXV.LX2IO := IO2;
+52760 C0: SYLXV.LX2CL0 := CLA2; C1: SYLXV.LX2CL1 := CLA2; C2: SYLXV.LX2CL2 := CLA2 END;
+52770 RTN := SRTN; PRPOP := POP; PRPUSH := PUSH; PRSKIP := SKIP; PRSCAN := SCAN;
+52780 SEXIT := ABS(SEX); FEXIT := ABS(FEX);
+52790 END
+52800 END;
+52810 PROCEDURE BLABL(SEX, FEX, VALUE: INTEGER);
+52820 VAR TEMP: INTEGER;
+52830 BEGIN
+52840 WHILE SEX<>0 DO
+52850 BEGIN TEMP := BPRODTBL[SEX].SEXIT; BPRODTBL[SEX].SEXIT := VALUE; SEX := TEMP END;
+52860 WHILE FEX<>0 DO
+52870 BEGIN TEMP := BPRODTBL[FEX].FEXIT; BPRODTBL[FEX].FEXIT := VALUE; FEX := TEMP END
+52880 END;
+52890 PROCEDURE PARSER;
+52900 VAR MATCH: BOOLEAN;
+52910 STK: PLEX;
+52920 I: INTEGER;
+52930 BEGIN
+52940 WHILE NOT ENDOFPROG DO
+52950 WITH BPRODTBL[PLPTR] DO
+52960 BEGIN
+52970 MATCH := TRUE;
+52980 IF PRSTKA<3 THEN
+52990 BEGIN
+53000 STK := SRPLSTK[PLSTKP+PRSTKA];
+53010 CASE PRSTKC OF
+53020 S: MATCH := SYLXV.LX1IO = STK^.LXV.LXIO;
+53030 C0: MATCH := SYLXV.LX1CL0 = STK^.LXV.LXCLASS0;
+53040 C1: MATCH := SYLXV.LX1CL1 = STK^.LXV.LXCLASS1;
+53050 C2: MATCH := SYLXV.LX1CL2 = STK^.LXV.LXCLASS2
+53060 END
+53070 END;
+53080 IF MATCH THEN
+53090 CASE PRINPC OF
+53100 A: ;
+53110 S: MATCH := SYLXV.LX2IO = INP^.LXV.LXIO;
+53120 C0: MATCH := SYLXV.LX2CL0 = INP^.LXV.LXCLASS0;
+53130 C1: MATCH := SYLXV.LX2CL1 = INP^.LXV.LXCLASS1;
+53140 C2: MATCH := SYLXV.LX2CL2 = INP^.LXV.LXCLASS2;
+53150 SSA: MATCH := SYLXV.LX2IO = SRPLSTK[PLSTKP+1]^.LXV.LXIO
+53160 END;
+53170 IF MATCH THEN
+53180 IF RTN>FINISH THEN
+53190 SEMANTICROUTINE(RTN);
+53200 IF MATCH THEN
+53210 BEGIN
+53220 PLSTKP := PLSTKP+PRPOP;
+53230 IF PRPUSH<>LXIODUMMY THEN
+53240 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := PUSHTBL[PRPUSH] END;
+53250 IF PRSKIP THEN
+53260 INP := PARSIN;
+53270 FOR I := 1 TO PRSCAN DO
+53280 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := INP; INP := PARSIN END;
+53290 PLPTR := SEXIT
+53300 END
+53310 ELSE
+53320 PLPTR := FEXIT
+53330 END
+53340 END;
+53350 (*+01() (*$T-+) ()+01*)
+53360 (*+25() (*$T-+) ()+25*)
+53370 PROCEDURE CLASSES;
+53380 BEGIN
+53390 HTCOPY := HT;
+53400 (*+01() ENEW(FRED, SZWORD); (*TO MARK THE PRESENT HEAP LIMIT*) ()+01*)
+53410 CLASS('CL00 '); CLASS('CL01 ');
+53420 CLASS('CL10 '); CLASS('CL11 ');
+53430 CLASS('CL12 '); CLASS('CL13 ');
+53440 CLASS('CL14 ');
+53450 CLASS('CL20 '); CLASS('CL21 ');
+53460 CLASS('CL22 '); CLASS('CL23 ');
+53470 CLASS('CL24 '); CLASS('CL25 ');
+53480 CLASS('CL26 '); CLASS('CL27 ');
+53490 CLASS('CL28 '); CLASS('CL29 ');
+53500 CLASS('CL2A '); CLASS('CL2B ');
+53510 CLASS('CL2C '); CLASS('CL2D ');
+53520 CLASS('CL2E '); CLASS('CL2F ');
+53530 CLASS('ANY ');
+53540 END;
+53550 PROCEDURE TLEXS;
+53560 BEGIN
+53570 TLEX('ACTPL ', LXIOACTPL);
+53580 TLEX('ACTRL ', LXIOACTRL);
+53590 TLEX('BOUNDS ', LXIOBOUNDS);
+53600 TLEX('BRINPT ', LXIOBRINPT);
+53610 TLEX('BRTHPT ', LXIOBRTHPT);
+53620 TLEX('CSTICK ', LXIOCSTICK);
+53630 TLEX('DCLL ', LXIODCLL);
+53640 TLEX('FLDSPL ', LXIOFLDSPL);
+53650 TLEX('FORDCL ', LXIOFORDCL);
+53660 TLEX('FORRLB ', LXIOFORRLB);
+53670 TLEX('IDEFL ', LXIOIDEFL);
+53680 TLEX('LABSQ ', LXIOLABSQ);
+53690 TLEX('MOIDDR ', LXIOMOIDDR);
+53700 TLEX('NONRDR ', LXIONONRDR);
+53710 TLEX('ODEFL ', LXIOODEFL);
+53720 TLEX('OPRAND ', LXIOOPRAND);
+53730 TLEX('PRIM ', LXIOPRIM);
+53740 TLEX('PRMDRL ', LXIOPRMDRL);
+53750 TLEX('RIDEFL ', LXIORIDEFL);
+53760 TLEX('RODEFL ', LXIORODEFL);
+53770 TLEX('RSPEC ', LXIORSPEC);
+53780 TLEX('RVDEFL ', LXIORVDEFL);
+53790 TLEX('TERT ', LXIOTERT);
+53800 TLEX('TRMSCL ', LXIOTRMSCL);
+53810 TLEX('UNITLC ', LXIOUNLC);
+53820 TLEX('UNITLP ', LXIOUNLP);
+53830 TLEX('UNITSR ', LXIOUNSR);
+53840 TLEX('VDEFL ', LXIOVDEFL);
+53850 TLEX('AGAIN ', LXIOAGAIN);
+53860 TLEX('AT ', LXIOAT);
+53870 TLEX('BEGIN ', LXIOBEGIN);
+53880 TLEX('BOOLDEN ', LXIOBOOLDEN);
+53890 TLEX('BUS ', LXIOBUS);
+53900 TLEX('BY ', LXIOBY);
+53910 TLEX('CASE ', LXIOCASE);
+53920 TLEX('COMMA ', LXIOCOMMA);
+53930 TLEX('COMMENT ', LXIOCMMENT);
+53940 TLEX('DO ', LXIODO);
+53950 TLEX('ELIF ', LXIOELIF);
+53960 TLEX('ELSE ', LXIOELSE);
+53970 TLEX('END ', LXIOEND);
+53980 TLEX('ERROR ', LXIOERROR);
+53990 TLEX('ESAC ', LXIOESAC);
+54000 TLEX('EXIT ', LXIOEXIT);
+54010 TLEX('FI ', LXIOFI);
+54020 TLEX('FOR ', LXIOFOR);
+54030 TLEX('FROM ', LXIOFROM);
+54040 TLEX('GO ', LXIOGO);
+54050 TLEX('GOTO ', LXIOGOTO);
+54060 TLEX('HEAP ', LXIOHEAP);
+54070 TLEX('IDTY ', LXIOIDTY);
+54080 TLEX('IF ', LXIOIF);
+54090 TLEX('IN ', LXIOIN);
+54100 TLEX('LOC ', LXIOLOC);
+54110 TLEX('LONG ', LXIOLONG);
+54120 TLEX('MDIND ', LXIOMDIND);
+54130 TLEX('MODE ', LXIOMODE);
+54140 TLEX('NIL ', LXIONIL);
+54150 TLEX('OD ', LXIOOD);
+54160 TLEX('OF ', LXIOOF);
+54170 TLEX('OP ', LXIOOP);
+54180 TLEX('OPR ', LXIOOPR);
+54190 TLEX('OTHDR ', LXIOOTHDR);
+54200 TLEX('OUSE ', LXIOOUSE);
+54210 TLEX('OUT ', LXIOOUT);
+54220 TLEX('PRAGMAT ', LXIOPRAGMAT);
+54230 TLEX('PRIMDR ', LXIOPRDR);
+54240 TLEX('PRIO ', LXIOPRIO);
+54250 TLEX('PROC ', LXIOPROC);
+54260 TLEX('REF ', LXIOREF);
+54270 TLEX('SHORT ', LXIOSHORT);
+54280 TLEX('SKIP ', LXIOSKIP);
+54290 TLEX('START ', LXIOSTART);
+54300 TLEX('STICK ', LXIOSTICK);
+54310 TLEX('STRGDEN ', LXIOSTRGDEN);
+54320 TLEX('STRUCT ', LXIOSTRUCT);
+54330 TLEX('SUB ', LXIOSUB);
+54340 TLEX('TAB ', LXIOTAB);
+54350 TLEX('TAG ', LXIOTAG);
+54360 TLEX('THEN ', LXIOTHEN);
+54370 TLEX('TO ', LXIOTO);
+54380 TLEX('VOID ', LXIOVOID);
+54390 TLEX('WHILE ', LXIOWHILE);
+54400 TLEX('BECOM ', LXIOBECOM);
+54410 TLEX('CLOSE ', LXIOCLOSE);
+54420 TLEX('COLON ', LXIOCOLON);
+54430 TLEX('EQUAL ', LXIOEQUAL);
+54440 TLEX('OPEN ', LXIOOPEN);
+54450 TLEX('PRIMDEN ', LXIOPRDEN);
+54460 TLEX('SEMIC ', LXIOSEMIC);
+54470 TLEX('STOP ', LXIOSTOP);
+54480 END;
+54490 (*+01() (*+31() (*$T++) ()+31+) ()+01*)
+54500 (*+25() (*+31() (*$T++) ()+31+) ()+25*)
+54510 BEGIN (*PARSEPARSER*)
+54520 CLASSES;
+54530 TLEXS;
+54540 (*FLOYD PRODUCTION RULES WHICH WERE USED WITH THE OLD VERSION OF SEMANTICROUTINE GIVEN ABOVE
+54550 TO PRODUCE THE CALLS OF BMPROD AND BLABL WHICH FOLLOW*)
+54560 (*
+54570 BEGIN: ! => , ! + INIT;
+54580 INIT: ! => , ! + PRODRL;
+54590 PRODRL: STOP@! => 36 ,1-> ! APRODRL;
+54600 APRODRL: TAG@!COLON@ => 34 ,1-> ! (1) + ALABEL;
+54610 ALABEL: ! => 10 , ! BLABEL;
+54620 BLABEL: TAG@!AT@ => 11 ,1-> ! (1) COMMA;
+54630 TAB@! => 12 ,1-> ! COMMA;
+54640 TAG@! => 11 ,1-> ! COMMA;
+54650 STICK@! => 13 ,1-> ! + ASTICK,ERROR;
+54660 COMMA: !COMMA@ => 14 , ! (1) + BLABEL;
+54670 STICK: !STICK@ => 15 , ! (1) + ASTICK,ERROR;
+54680 ASTICK: TAG@!AT@ => 11 ,1-> ! (1) + EQUAL;
+54690 TAB@! => 12 ,1-> ! + EQUAL;
+54700 TAG@! => 11 ,1-> ! + EQUAL;
+54710 EQUAL@! => 35 , ! EQUAL;
+54720 EQUAL: EQUAL@!OPR@ => ,1-> ! (1) + AEQUAL,ERROR;
+54730 AEQUAL: TAG@!OPR@ => 16 , ! (1) FSEM;
+54740 ! => 17 , ! ASEM;
+54750 ASEM: OPR@! => ,1-> ! + ASEM2;
+54760 ASEM2: COMMA@!PRIMDEN@ => 18 ,1-> ! (1) ++ PUSH;
+54770 STICK2: COMMA@!STICK@ => 19 ,1-> ! ++ ASTICK2,ERROR;
+54780 PUSH: OPR@,ANY!TAG@ => 20 ,2-> ! (1) ++ ASTICK2;
+54790 OPR@,ANY!STICK@ => 21 ,2-> ! ++ ASTICK2,ERROR;
+54800 ASTICK2: OPEN@!PRIMDEN@ => 22 ,2-> ! (1) ++ STAR;
+54810 ! => 23 , ! STAR;
+54820 STAR: OPR@!OPR@ => 24 ,1-> ! (1) + SEX;
+54830 OPR@! => 25 ,1-> ! + SEX;
+54840 ! => 26 , ! SEX;
+54850 SEX: TAG@! => 28 ,2-> ! + FEX,ERROR;
+54860 FEX: COMMA@!TAG@ => 29 ,1-> ! (1) + SEMI;
+54870 ! => 30 , ! SEMI;
+54880 SEMI: SEMIC@! => 31 ,1-> ! INIT;
+54890 ERROR: START@! => 32 , ! ERR;
+54900 ! => ,1-> ! ERROR;
+54910 ERR: !SEMIC@ => 31 , ! (1) INIT;
+54920 !STOP@ => 36 ,1-> ! ERROR;
+54930 ! => , ! (1) ERR;
+54940 FSEM: TAG@!PRSMDEN@ => 16 ,1-> ! (1) + ASEM,ERROR;
+54950 *)
+54960 BMPROD( 1, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 2);
+54970 BLABL( 1, 0, 2);
+54980 BMPROD( 2, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 3);
+54990 BLABL( 2, 0, 3);
+55000 BMPROD( 3, S , LXIOSTOP , 0, 0, A , LXIODUMMY , 0, 36 , 1, LXIODUMMY , FALSE, 0, 0, 4);
+55010 BLABL( 3, 0, 4);
+55020 BMPROD( 4, S , LXIOTAG , 0, 0, S , LXIOCOLON , 0, 34 , 1, LXIODUMMY , TRUE , 1, 0, 5);
+55030 BLABL( 4, 0, 5);
+55040 BMPROD( 5, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 10 , 0, LXIODUMMY , FALSE, 0, 0, 6);
+55050 BLABL( 5, 0, 6);
+55060 BMPROD( 6, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 0, 0, 7);
+55070 BMPROD( 7, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 0, -6, 8);
+55080 BMPROD( 8, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 0, -7, 9);
+55090 BMPROD( 9, S , LXIOSTICK , 0, 0, A , LXIODUMMY , 0, 13 , 1, LXIODUMMY , FALSE, 1, 0, 0);
+55100 BLABL( 8, 0, 10);
+55110 BMPROD( 10, S , LXIODUMMY , 0, 3, S , LXIOCOMMA , 0, 14 , 0, LXIODUMMY , TRUE , 1, 6, 11);
+55120 BMPROD( 11, S , LXIODUMMY , 0, 3, S , LXIOSTICK , 0, 15 , 0, LXIODUMMY , TRUE , 1, -9, -9);
+55130 BLABL( 11, 0, 12);
+55140 BMPROD( 12, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 1, 0, 13);
+55150 BMPROD( 13, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 1, -12, 14);
+55160 BMPROD( 14, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 1, -13, 15);
+55170 BMPROD( 15, S , LXIOEQUAL , 0, 0, A , LXIODUMMY , 0, 35 , 0, LXIODUMMY , FALSE, 0, -14, 16);
+55180 BLABL( 15, 0, 16);
+55190 BMPROD( 16, S , LXIOEQUAL , 0, 0, S , LXIOOPR , 0, 00 , 1, LXIODUMMY , TRUE , 1, 0, -11);
+55200 BLABL( 16, 0, 17);
+55210 BMPROD( 17, S , LXIOTAG , 0, 0, S , LXIOOPR , 0, 00 , 0, LXIODUMMY , TRUE , 0, 0, 18);
+55220 BMPROD( 18, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 17 , 0, LXIODUMMY , FALSE, 0, 0, 19);
+55230 BLABL( 18, 0, 19);
+55240 BMPROD( 19, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 1, 0, 20);
+55250 BLABL( 19, 0, 20);
+55260 BMPROD( 20, S , LXIOCOMMA , 0, 0, S , LXIOPRDEN , 0, 18 , 1, LXIODUMMY , TRUE , 2, 0, 21);
+55270 BMPROD( 21, S , LXIOCOMMA , 0, 0, S , LXIOSTICK , 0, 19 , 1, LXIODUMMY , FALSE, 2, 0, -16);
+55280 BLABL( 20, 0, 22);
+55290 BMPROD( 22, S , LXIOOPR , 0, 1, S , LXIOTAG , 0, 20 , 2, LXIODUMMY , TRUE , 2, -21, 23);
+55300 BMPROD( 23, S , LXIOOPR , 0, 1, S , LXIOSTICK , 0, 21 , 2, LXIODUMMY , FALSE, 2, -22, -21);
+55310 BLABL( 23, 0, 24);
+55320 BMPROD( 24, S , LXIOOPEN , 0, 0, S , LXIOPRDEN , 0, 22 , 2, LXIODUMMY , TRUE , 2, 0, 25);
+55330 BMPROD( 25, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 23 , 0, LXIODUMMY , FALSE, 0, -24, 26);
+55340 BLABL( 25, 0, 26);
+55350 BMPROD( 26, S , LXIOOPR , 0, 0, S , LXIOOPR , 0, 24 , 1, LXIODUMMY , TRUE , 1, 0, 27);
+55360 BMPROD( 27, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 25 , 1, LXIODUMMY , FALSE, 1, -26, 28);
+55370 BMPROD( 28, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 26 , 0, LXIODUMMY , FALSE, 0, -27, 29);
+55380 BLABL( 28, 0, 29);
+55390 BMPROD( 29, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 28 , 2, LXIODUMMY , FALSE, 1, 0, -23);
+55400 BLABL( 29, 0, 30);
+55410 BMPROD( 30, S , LXIOCOMMA , 0, 0, S , LXIOTAG , 0, 29 , 1, LXIODUMMY , TRUE , 1, 0, 31);
+55420 BMPROD( 31, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 30 , 0, LXIODUMMY , FALSE, 0, -30, 32);
+55430 BLABL( 31, 0, 32);
+55440 BMPROD( 32, S , LXIOSEMIC , 0, 0, A , LXIODUMMY , 0, 31 , 1, LXIODUMMY , FALSE, 0, 2, 33);
+55450 BLABL( 0, 29, 33);
+55460 BMPROD( 33, S , LXIOSTART , 0, 0, A , LXIODUMMY , 0, 32 , 0, LXIODUMMY , FALSE, 0, 0, 34);
+55470 BMPROD( 34, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 0, 33, 35);
+55480 BLABL( 33, 0, 35);
+55490 BMPROD( 35, S , LXIODUMMY , 0, 3, S , LXIOSEMIC , 0, 31 , 0, LXIODUMMY , TRUE , 0, 2, 36);
+55500 BMPROD( 36, S , LXIODUMMY , 0, 3, S , LXIOSTOP , 0, 36 , 1, LXIODUMMY , FALSE, 0, 33, 37);
+55510 BMPROD( 37, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , TRUE , 0, 35, 38);
+55520 BLABL( 17, 0, 38);
+55530 BMPROD( 38, S , LXIOTAG , 0, 0, S , LXIOPRDEN , 0, 16 , 1, LXIODUMMY , TRUE , 1, 19, 33);
+55540 ERRS := 0; INITIO; INITLX; INITPR;
+55550 PRAGFLGS := PRAGFLGS + [PRGPOINT] - [PRGUPPER];
+55560 BCOUNT := 1;
+55570 CCOUNT := 0;
+55580 PARSER;
+55590 IF CCOUNT<>0 THEN WRITELN(LSTFILE,'CCOUNT ERROR', CCOUNT);
+55600 WRITELN(LSTFILE,'LAST PROD', BCOUNT-1);
+55610 (*+01() J := GETB(4); ()+01*)
+55620 FOR I := 0 TO HTSIZE DO (*GET RID OF ALL UNWANTED LEXEMES*)
+55630 BEGIN THIS := HT[I];
+55640 WHILE THIS<>HTCOPY[I] DO
+55650 BEGIN
+55660 THAT := THIS^.LINK;
+55670 EDISPOSE(THIS, THIS^.LXCOUNT*SZWORD+LEX1SIZE);
+55680 THIS := THAT;
+55690 END;
+55700 END;
+55710 HT := HTCOPY; (*RESTORE HT TO STATE BEFORE FRED*)
+55720 (*+01()
+55730 FOR I := J TO ORD(FRED) DO
+55740 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END;
+55750 ()+01*)
+55760 END;
+55770 (**)
+55780 ()+82*)
--- /dev/null
+42000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+42010 (**)
+42020 (**)
+42030 (*+85()
+42040 (**)
+42050 PROCEDURE STANDARDPRELUDE;
+42060 FUNCTION DEFPRC0(YIELD: MODE; CP: CODEPROC): MODE;
+42070 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+42080 FINDPRC(YIELD,0,CP); DEFPRC0 := SRSTK[SRSEMP].MD
+42090 END;
+42100 FUNCTION DEFPRC1(P1, YIELD: MODE; CP: CODEPROC): MODE;
+42110 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+42120 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
+42130 FINDPRC(YIELD,1,CP); DEFPRC1 := SRSTK[SRSEMP].MD
+42140 END;
+42150 FUNCTION DEFPRC2(P1, P2, YIELD: MODE; CP: CODEPROC): MODE;
+42160 BEGIN SRSEMP := -1; SRSUBP := 0; SUBSAVE;
+42170 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P1;
+42180 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := P2;
+42190 FINDPRC(YIELD,2,CP); DEFPRC2 := SRSTK[SRSEMP].MD
+42200 END;
+42210 PROCEDURE INTAB(VAR LEX: PLEX; TAG: ALFA; LXVV: LXM);
+42220 VAR I: INTEGER;
+42230 BEGIN WITH CURRENTLEX DO
+42240 BEGIN
+42250 LXV := LXVV; LXTOKEN := TKBOLD;
+42260 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+42270 (*-11() STASHLEX(TAG); ()-11*)
+42280 END;
+42290 LEX := HASHIN
+42300 END;
+42310 FUNCTION DEFTAG(TAG: ALFA): PLEX;
+42320 VAR I: INTEGER;
+42330 BEGIN WITH CURRENTLEX DO
+42340 BEGIN
+42350 LXV := LXVTAG; LXTOKEN := TKTAG;
+42360 (*+11() S10:=TAG; LXCOUNT:=1; ()+11*)
+42370 (*-11() STASHLEX(TAG); ()-11*)
+42380 END;
+42390 DEFTAG := HASHIN
+42400 END;
+42410 FUNCTION DEFLTAG(TAG1, TAG2: ALFA): PLEX;
+42420 VAR I: INTEGER;
+42430 BEGIN WITH CURRENTLEX DO
+42440 BEGIN
+42450 LXV := LXVTAG; LXTOKEN := TKTAG;
+42460 (*+11() S20 := TAG2; S10 := TAG1; LXCOUNT := 2; ()+11*)
+42470 (*-11() STASHLLEX(TAG1, TAG2); ()-11*)
+42480 DEFLTAG := HASHIN
+42490 END
+42500 END;
+42510 FUNCTION GETSTB(LEX: PLEX; DEF: DEFTYP; BLK: BLKTYP): PSTB;
+42520 (*FUNCTION: CREATE A NEW STBLOCK FOR LEX*)
+42530 VAR STB: PSTB;
+42540 BEGIN
+42550 NEW(STB); WITH STB^, LEX^.LXV DO
+42560 BEGIN
+42570 STLINK := LXPSTB; LXPSTB := STB;
+42580 STLEX := LEX;
+42590 STTHREAD := DCIL; DCIL := STB;
+42600 STDEFTYP := DEF; STBLKTYP := BLK;
+42610 STRANGE := 0;
+42620 STLEVEL := 0; STLOCRG := 0;
+42630 GETSTB := STB
+42640 END
+42650 END;
+42660 (**)
+42670 (**)
+42680 PROCEDURE INITSTDIDS;
+42690 (*CREATE STBLOCKS FOR STANDARD-PRELUDE IDENTIFIERS*)
+42700 VAR PRCRR,PRCON, REFFILE: MODE;
+42710 PROCEDURE DEFSTID(MD: MODE; LX: PLEX);
+42720 VAR STB: PSTB; THIS:MODE; LENGTH:INTEGER;
+42722 (*+05() LEX: PLEX; I: INTEGER; ()+05*)
+42730 BEGIN STB := GETSTB(LX, [STVAR], STBDEFID);
+42740 WITH STB^ DO
+42750 BEGIN STMODE := MD;
+42760 IF NOT(STMODE^.MDV.MDID IN [MDIDCHAN,MDIDPASC]) THEN
+42762 BEGIN
+42764 THIS:=MD;
+42766 IF THIS^.MDV.MDID=MDIDREF THEN THIS:=THIS^.MDPRRMD;
+42767 IF THIS^.MDV.MDPILE THEN LENGTH:=SZADDR
+42768 ELSE LENGTH:=THIS^.MDV.MDLEN;
+42770 (*-41() STOFFSET := CURID; CURID := CURID+LENGTH ()-41*)
+42780 (*+41() CURID := CURID+LENGTH; STOFFSET := CURID ()+41*)
+42782 IF MD^.MDV.MDID<>MDIDREF THEN STDEFTYP := [STINIT];
+42785 END
+42790 ELSE
+42800 (*-05() BEGIN STVALUE := LX; STDEFTYP := [STCONST] END; ()-05*)
+42801 (*+05() BEGIN
+42802 ENEW(LEX, LEX1SIZE + LX^.LXCOUNT*SZWORD);
+42803 FOR I := 1 TO LEX1SIZE DIV SZWORD + LX^.LXCOUNT DO
+42804 LEX^.LEXWORDS[I] := LX^.LEXWORDS[I];
+42805 STVALUE := LEX;
+42806 STDEFTYP := [STCONST];
+42807 END;
+42808 ()+05*)
+42810 END
+42820 END;
+42830 PROCEDURE DEFSTID1(TAG: ALFA; MD: MODE);
+42840 BEGIN DEFSTID(MD, DEFTAG(TAG)) END;
+42850 PROCEDURE DEFSTID2(TAG1, TAG2: ALFA; MD: MODE);
+42860 BEGIN DEFSTID(MD, DEFLTAG(TAG1, TAG2)) END;
+42870 PROCEDURE DEFCONST(TAG: ALFA; MD: MODE; VALUE: A68INT);
+42880 VAR STB: PSTB;
+42890 LX: PLEX;
+42900 BEGIN STB := GETSTB(DEFTAG(TAG), [STCONST], STBDEFID);
+42910 WITH STB^ DO
+42920 BEGIN
+42930 STMODE := MD;
+42940 ENEW(LX, SZADDR+SZINT+LEX1SIZE); WITH LX^ DO
+42950 BEGIN LXV := LXVPRDEN; LXCOUNT := (SZADDR+SZINT) DIV SZWORD;
+42960 LXTOKEN := TKDENOT; LXDENRP := VALUE; LXDENMD := MD END;
+42970 STVALUE := LX
+42980 END
+42990 END;
+43000 PROCEDURE DEFREAL(TAG:ALFA;MD:MODE;VALUE1(*-01(), VALUE2(*+03(), VALUE3()+03*)()-01*): INTEGER);
+43010 VAR STB:PSTB;
+43020 LX:PLEX;
+43021 TEMP: RECORD CASE SEVERAL OF
+43022 1: (REA: REAL);
+43023 2: (INT1: INTEGER;
+43024 (*-01() INT2: INTEGER;
+43025 (*+03() INT3: INTEGER; ()+03*)
+43026 ()-01*) ) ;
+43027 3,4,5,6,7,8,9,10: ();
+43028 END;
+43030 BEGIN
+43040 STB:=GETSTB(DEFTAG(TAG),[STCONST],STBDEFID);
+43050 WITH STB^ DO
+43060 BEGIN
+43070 STMODE:=MD;
+43080 ENEW(LX,SZADDR+SZREAL+LEX1SIZE);
+43090 WITH LX^ DO
+43100 BEGIN
+43110 LXV:=LXVPRDEN; LXCOUNT:=(SZADDR+SZREAL) DIV SZWORD; LXTOKEN:=TKDENOT;
+43112 TEMP.INT1 := VALUE1;
+43114 (*-01() TEMP.INT2 := VALUE2;
+43116 (*+03() TEMP.INT3 := VALUE3; ()+03*)
+43118 ()-01*)
+43120 LXDENRPREAL := TEMP.REA; LXDENMD:=MD
+43130 END;
+43140 STVALUE:=LX
+43150 END
+43160 END;
+43170 BEGIN
+43180 (**)
+43190 DEFCONST('MAXINT ', MDINT, MAXINT);
+43200 (*+01()
+43210 DEFREAL('MAXREAL ', MDREAL, 37767777777777777777B);
+43220 DEFREAL('SMALLREAL ', MDREAL, 16414000000000000000B);
+43222 DEFREAL('PI ', MDREAL, 17216220773250420551B);
+43230 ()+01*)
+43240 (*+05()
+43250 DEFREAL('MAXREAL ', MDREAL, 2147483647, -1);
+43260 DEFREAL('SMALLREAL ', MDREAL, 1017118720, 0);
+43270 DEFREAL('PI ', MDREAL, 1074340347, 1413754136);
+43280 ()+05*)
+43290 DEFCONST('MAXABSCHAR', MDINT, MAXABSCHAR);
+43300 DEFSTID1('BITSPACK ', DEFPRC1(FINDROW(MDBOOL,1),MDBITS, PASC));
+43310 DEFSTID1('BYTESPACK ', DEFPRC1(MDSTRNG,MDBYTES, PASC));
+43407 PRCRR := DEFPRC1(MDREAL,MDREAL, PASC);
+43410 DEFSTID1('SQRT ', PRCRR);
+43420 DEFSTID1('EXP ', PRCRR);
+43430 DEFSTID1('LN ', PRCRR);
+43440 DEFSTID1('COS ', PRCRR);
+43450 DEFSTID1('ARCCOS ', PRCRR);
+43460 DEFSTID1('SIN ', PRCRR);
+43470 DEFSTID1('ARCSIN ', PRCRR);
+43480 DEFSTID1('TAN ', PRCRR);
+43490 DEFSTID1('ARCTAN ', PRCRR);
+43500 DEFSTID1('NEXTRANDOM', DEFPRC1(FINDREF(MDINT),MDREAL, PASC));
+43510 DEFSTID2('STANDINCHA','NNEL ', MDCHAN);
+43520 DEFSTID2('STANDOUTCH','ANNEL ', MDCHAN);
+43530 DEFSTID2('STANDBACKC','HANNEL ', MDCHAN);
+43540 REFFILE := FINDREF(MDFILE);
+43550 DEFSTID1('CHAN ', DEFPRC1(REFFILE,MDCHAN, PASC));
+43560 DEFSTID1('MAKETERM ', DEFPRC2(REFFILE,MDSTRNG,MDVOID, PASC));
+43570 PRCON := DEFPRC2(REFFILE,DEFPRC1(REFFILE,MDBOOL,PROC),MDVOID,PASC);
+43580 DEFSTID2('ONLOGICALF','ILEEND ', PRCON);
+43590 DEFSTID2('ONPHYSICAL','FILEEND ', PRCON);
+43600 DEFSTID1('ONPAGEEND ', PRCON);
+43610 DEFSTID1('ONLINEEND ', PRCON);
+43620 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+6;
+43630 SRSTK[SRSEMP-5].MD := REFFILE; SRSTK[SRSEMP-4].MD := MDSTRNG;
+43640 SRSTK[SRSEMP-3].MD := MDCHAN; SRSTK[SRSEMP-2].MD := MDINT;
+43650 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
+43660 FINDPRC(MDINT,6,PASC);
+43670 DEFSTID1('ESTABLISH ', SRSTK[SRSEMP].MD);
+43680 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+3;
+43690 SRSTK[SRSEMP-2].MD := REFFILE; SRSTK[SRSEMP-1].MD := MDSTRNG;
+43700 SRSTK[SRSEMP].MD := MDCHAN;
+43710 FINDPRC(MDINT,3,PASC);
+43720 DEFSTID1('OPEN ', SRSTK[SRSEMP].MD);
+43730 DEFSTID1('ASSOCIATE ', DEFPRC2(REFFILE,FINDREF(FINDROW(MDCHAR,1)),MDVOID, PASC));
+43740 DEFSTID1('CLOSE ', PASCVF);
+43750 DEFSTID1('CHARNUMBER', DEFPRC1(REFFILE,MDINT, PASC));
+43760 DEFSTID1('LINENUMBER', DEFPRC1(REFFILE,MDINT, PASC));
+43770 DEFSTID1('PAGENUMBER', DEFPRC1(REFFILE,MDINT, PASC));
+43780 DEFSTID1('SPACE ', PASCVF);
+43790 DEFSTID1('NEWLINE ', PASCVF);
+43800 DEFSTID1('NEWPAGE ', PASCVF);
+43810 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+4;
+43820 SRSTK[SRSEMP-3].MD := REFFILE; SRSTK[SRSEMP-2].MD := MDINT;
+43830 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
+43840 FINDPRC(MDVOID,4,PASC);
+43850 DEFSTID1('SET ', SRSTK[SRSEMP].MD);
+43860 DEFSTID1('RESET ', PASCVF);
+43870 DEFSTID1('WHOLE ', DEFPRC2(MDNUMBER,MDINT,MDSTRNG, PASC));
+43880 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+3;
+43890 SRSTK[SRSEMP-2].MD := MDNUMBER; SRSTK[SRSEMP-1].MD := MDINT;
+43900 SRSTK[SRSEMP].MD := MDINT;
+43910 FINDPRC(MDSTRNG,3,PASC);
+43920 DEFSTID1('FIXED ', SRSTK[SRSEMP].MD);
+43930 SRSEMP := -1; SRSUBP := 0; SUBSAVE; SRSEMP := SRSEMP+4;
+43940 SRSTK[SRSEMP-3].MD := MDNUMBER; SRSTK[SRSEMP-2].MD := MDINT;
+43950 SRSTK[SRSEMP-1].MD := MDINT; SRSTK[SRSEMP].MD := MDINT;
+43960 FINDPRC(MDSTRNG,4,PASC);
+43970 DEFSTID1('FLOAT ', SRSTK[SRSEMP].MD);
+43980 DEFSTID1('PUT ', DEFPRC2(REFFILE,FINDROW(MDOUT,1),MDVOID, PASC));
+43990 DEFSTID1('GET ', DEFPRC2(REFFILE,FINDROW(MDIN,1),MDVOID, PASC));
+44000 DEFSTID1('PUTBIN ', DEFPRC2(REFFILE,FINDROW(MDOUTB,1),MDVOID, PASC));
+44010 DEFSTID1('GETBIN ', DEFPRC2(REFFILE,FINDROW(MDINB,1),MDVOID, PASC));
+44020 DEFSTID1('LASTRANDOM', FINDREF(MDINT));
+44030 DEFSTID1('RANDOM ', DEFPRC0(MDREAL, PASC));
+44040 DEFSTID1('STANDIN ', REFFILE);
+44050 DEFSTID1('STANDOUT ', REFFILE);
+44060 DEFSTID1('STANDBACK ', REFFILE);
+44070 DEFSTID1('PRINT ', DEFPRC1(FINDROW(MDOUT,1),MDVOID, PASC));
+44080 DEFSTID1('WRITE ', DEFPRC1(FINDROW(MDOUT,1),MDVOID, PASC));
+44090 DEFSTID1('READ ', DEFPRC1(FINDROW(MDIN,1),MDVOID, PASC));
+44100 DEFSTID1('WRITEBIN ', DEFPRC1(FINDROW(MDOUTB,1),MDVOID, PASC));
+44110 DEFSTID1('READBIN ', DEFPRC1(FINDROW(MDINB,1),MDVOID,PASC));
+44120 LEXLSTOP := DEFTAG('STOP ');
+44121 (*-01() (*-05()
+44122 DEFSTID1('MAXREAL ', MDREAL);
+44124 DEFSTID1('SMALLREAL ', MDREAL);
+44126 DEFSTID1('PI ', MDREAL);
+44128 ()-05*) ()-01*)
+44130 (*+54()
+44140 DEFSTID1('ONERROR ', DEFPRC1(DEFPRC1(MDEXC,MDVOID,PROC),MDVOID,PASC));
+44150 DEFSTID2('MAKEXCEPTI','ON ', DEFPRC1(MDINT,MDEXC,PASC));
+44160 DEFSTID1('ERROR ', DEFPRC1(MDINT,MDVOID,PASC));
+44170 DEFSTID1('OFFERROR ', DEFPRC0(MDVOID,PASC));
+44180 ()+54*)
+44190 (**)
+44200 (**)
+44210 (**)
+44220 END;
+44230 (**)
+44240 (**)
+44250 PROCEDURE INITOPS;
+44260 VAR OBABS, OBAND, OBARG, OBBIN, OBCONJ, OBDIV, OBDVAB, OBELEM, OBENTI, OBEQ,
+44270 OBGE, OBGT, OBLE, OBLENG, OBLT, OBLWB, OBMDAB, OBMNAB, OBMINUS, OBMOD, OBNE, OBNOT,
+44280 OBODD, OBOR, OBOVAB, OBOVER, OBPLAB, OBPLTO, OBPLITM, OBPLUS, OBREPR, OBROUN, OBSHL,
+44290 OBSHR, OBSHRT, OBSIGN, OBTIMES, OBTMAB, OBUP, OBUPB, OBRE, OBIM: INTEGER;
+44300 CURROB, THISOB, PREVOB: INTEGER;
+44310 PROCEDURE NOB(VAR OB: INTEGER);
+44320 BEGIN OB := CURROB; THISOB := OB END;
+44330 PROCEDURE OPTAB(IDNDX: OPIDNDXTYP; OPCOD: POP; MIN,MAX: XTYPE; RESMD: MODE);
+44340 BEGIN
+44350 IF THISOB=PREVOB THEN OPTABL[CURROB-1].OPMORE := TRUE;
+44360 PREVOB := THISOB;
+44370 WITH OPTABL[CURROB] DO
+44380 BEGIN OPIDNDX := IDNDX; OPOPCOD := OPCOD; OPMIN := MIN; OPMAX := MAX;
+44390 OPMODE := RESMD; OPMORE := FALSE END;
+44400 CURROB := CURROB+1
+44410 END;
+44420 PROCEDURE DEFSTOP(LX: PLEX; PRIO: INTEGER; OB: INTEGER);
+44430 VAR STB: PSTB;
+44440 BEGIN STB := GETSTB(LX, [], STBDEFPRIO); WITH STB^ DO
+44450 BEGIN STDYPRIO := PRIO; STUSERLEX := NIL; STSTDOP := OB END
+44460 END;
+44470 PROCEDURE DEFSTOP1(TAB: ALFA; PRIO: INTEGER; OB: INTEGER);
+44480 VAR LX: PLEX;
+44490 BEGIN INTAB(LX, TAB, LXVOPR); DEFSTOP(LX, PRIO, OB) END;
+44500 PROCEDURE DEFSTOP2(PUNCT: ALFA; PRIO: INTEGER; OB: INTEGER);
+44510 VAR S, I: INTEGER;
+44520 CHA: CHAR;
+44530 LEX: PLEX;
+44540 PROCEDURE NEXTCH; BEGIN CHA := PUNCT[I]; I := I+1 END;
+44550 BEGIN
+44560 I := 1; NEXTCH;
+44570 (*+01() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+01*)
+44580 (*+25() IF CHA=':' THEN S := ORD('$')-ORD('+') ELSE S := ORD(CHA)-ORD('+'); ()+25*)
+44590 (*-01() (*-25() S := ORD(CHA)-ORD('!'); (*ASCII VERSION*)
+44592 IF CHA='%' THEN S := 23
+44600 ELSE IF CHA IN ['[', ']', '^','\'] THEN S := S-55; ()-25*) ()-01*)
+44610 NEXTCH;
+44620 WITH OPCHTABLE[S] DO
+44630 BEGIN
+44640 LEX := OTLEX;
+44650 S := OTNEXT
+44660 END;
+44670 WHILE S<>0 DO
+44680 WITH OPCHTABLE[S] DO
+44690 IF CHA=OTCHAR THEN
+44700 BEGIN
+44710 NEXTCH;
+44720 LEX := OTLEX;
+44730 S := OTNEXT
+44740 END
+44750 ELSE S := OTALT;
+44760 DEFSTOP(LEX, PRIO, OB)
+44770 END;
+44780 BEGIN
+44790 CURROB := 1; PREVOB := 0;
+44800 (**)
+44810 NOB(OBABS);
+44820 OPTAB(IDMON , PABSI , XINT,XLREAL , MDABSENT);
+44830 OPTAB(IDMONL, PABSI-4 , XCOMPL,XLCOMPL, MDREAL);
+44840 OPTAB(IDMON , PABSB , XBOOL,XBITS , MDINT);
+44850 OPTAB(IDMON , PABSCH , XCHAR,XCHAR , MDINT);
+44860 NOB(OBAND);
+44870 OPTAB(IDBB , PANDB , XBOOL,XBITS , MDABSENT);
+44880 NOB(OBARG);
+44890 OPTAB(IDMONL, PARG , XCOMPL,XLCOMPL, MDREAL);
+44900 NOB(OBBIN);
+44910 OPTAB(IDMON , PBIN , XINT,XINT , MDBITS);
+44920 NOB(OBCONJ);
+44930 OPTAB(IDMON , PCONJ , XCOMPL,XLCOMPL, MDABSENT);
+44940 NOB(OBDIV);
+44950 OPTAB(IDAAL , PDIV , XINT,XLINT , MDREAL);
+44960 OPTAB(IDAA , PDIV , XINT,XLCOMPL , MDABSENT);
+44970 NOB(OBDVAB);
+44980 OPTAB(IDRA , PDIVAB , XREAL,XLCOMPL , MDABSENT);
+44990 NOB(OBELEM);
+45000 OPTAB(IDIB , PELMBT , XBITS,XBITS , MDBOOL);
+45010 OPTAB(IDIB , PELMBY , XBYTES,XBYTES , MDCHAR);
+45020 NOB(OBENTI);
+45030 OPTAB(IDMONL, PENTI , XREAL,XLREAL , MDINT);
+45040 NOB(OBEQ);
+45050 OPTAB(IDAA , PEQ , XINT,XLCOMPL , MDBOOL);
+45060 OPTAB(IDAA , PEQCS , XCHAR,XSTRNG , MDBOOL);
+45070 OPTAB(IDBB , PEQB , XBOOL,XBYTES , MDBOOL);
+45080 NOB(OBGE);
+45090 OPTAB(IDAA , PGE , XINT,XLREAL , MDBOOL);
+45100 OPTAB(IDAA , PGECS , XCHAR,XSTRNG , MDBOOL);
+45110 OPTAB(IDBB , PGEBT , XBITS,XBYTES , MDBOOL);
+45120 NOB(OBGT);
+45130 OPTAB(IDAA , PGT , XINT,XLREAL , MDBOOL);
+45140 OPTAB(IDAA , PGTCS , XCHAR,XSTRNG , MDBOOL);
+45150 OPTAB(IDBB , PGTBY , XBYTES,XBYTES , MDBOOL);
+45160 NOB(OBIM);
+45170 OPTAB(IDMONL, PIM , XCOMPL,XLCOMPL,MDREAL);
+45180 NOB(OBLE);
+45190 OPTAB(IDAA , PLE , XINT,XLREAL , MDBOOL);
+45200 OPTAB(IDAA , PLECS , XCHAR,XSTRNG , MDBOOL);
+45210 OPTAB(IDBB , PLEBT , XBITS,XBYTES , MDBOOL);
+45220 (*+61()
+45230 NOB(OBLENG);
+45240 OPTAB(IDMON , PLENGI , XINT,XINT , MDLINT);
+45250 OPTAB(IDMON , PLENGR , XREAL,XREAL , MDLREAL);
+45260 OPTAB(IDMON , PLENGC , XCOMPL,XCOMPL , MDLCOMPL);
+45270 ()+61*)
+45280 NOB(OBLT);
+45290 OPTAB(IDAA , PLT , XINT,XLREAL , MDBOOL);
+45300 OPTAB(IDAA , PLTCS , XCHAR,XSTRNG , MDBOOL);
+45310 OPTAB(IDBB , PLTBY , XBYTES,XBYTES , MDBOOL);
+45320 NOB(OBLWB);
+45330 OPTAB(IDIBRM, PLWBM , -1,-1 , MDINT);
+45340 OPTAB(IDIBR , PLWB , XINT,XINT , MDINT);
+45350 OPTAB(IDMON , PLWBMSTR, XSTRNG,XSTRNG, MDINT);
+45360 NOB(OBMDAB);
+45370 OPTAB(IDRA , PMODAB , XINT,XLINT , MDABSENT);
+45380 NOB(OBMNAB);
+45390 OPTAB(IDRA , PMINUSAB, XINT,XLCOMPL , MDABSENT);
+45400 NOB(OBMINUS);
+45410 OPTAB(IDAA , PSUB , XINT,XLCOMPL , MDABSENT);
+45420 OPTAB(IDMON , PNEGI , XINT,XLCOMPL , MDABSENT);
+45430 NOB(OBMOD);
+45440 OPTAB(IDAAL , PMOD , XINT,XLINT , MDINT);
+45450 NOB(OBNE);
+45460 OPTAB(IDAA , PNE , XINT,XLCOMPL , MDBOOL);
+45470 OPTAB(IDAA , PNECS , XCHAR,XSTRNG , MDBOOL);
+45480 OPTAB(IDBB , PNEB , XBOOL,XBYTES , MDBOOL);
+45490 NOB(OBNOT);
+45500 OPTAB(IDMON , PNOTB , XBOOL,XBITS , MDABSENT);
+45510 NOB(OBODD);
+45520 OPTAB(IDMON , PODD , XINT,XLINT , MDBOOL);
+45530 NOB(OBOR);
+45540 OPTAB(IDBB , PORB , XBOOL,XBITS , MDABSENT);
+45550 NOB(OBOVAB);
+45560 OPTAB(IDRA , POVERAB , XINT,XLINT , MDABSENT);
+45570 NOB(OBOVER);
+45580 OPTAB(IDAAL , POVER , XINT,XLINT , MDINT);
+45590 NOB(OBPLAB);
+45600 OPTAB(IDRA , PPLSAB , XINT,XLCOMPL , MDABSENT);
+45610 OPTAB(IDSC , PPLSABS,XCHAR,XSTRNG, REFSTRNG);
+45620 NOB(OBPLITM);
+45630 OPTAB(IDAAL , PPLITM+2, XINT,XLREAL , MDCOMPL);
+45640 (*BECAUSE THERE ARE NO POPS FOR XINT AND XLINT*)
+45650 NOB(OBPLTO);
+45660 OPTAB(IDCS , PPLSTOCS,XCHAR,XSTRNG, REFSTRNG);
+45670 NOB(OBPLUS);
+45680 OPTAB(IDAA , PADD , XINT,XLCOMPL , MDABSENT);
+45690 OPTAB(IDAA , PCAT , XCHAR,XSTRNG, MDSTRNG);
+45700 OPTAB(IDMON , PNOOP , XINT,XLCOMPL , MDABSENT);
+45710 NOB(OBRE);
+45720 OPTAB(IDMONL, PRE , XCOMPL,XLCOMPL,MDREAL);
+45730 NOB(OBREPR);
+45740 OPTAB(IDMON , PREPR , XINT,XINT , MDCHAR);
+45750 NOB(OBROUN);
+45760 OPTAB(IDMONL, PROUN , XREAL,XLREAL , MDINT);
+45770 NOB(OBSHL);
+45780 OPTAB(IDBI , PSHL , XBITS,XBITS , MDABSENT);
+45790 NOB(OBSHR);
+45800 OPTAB(IDBI , PSHR , XBITS,XBITS , MDABSENT);
+45810 (*+61()
+45820 NOB(OBSHRT);
+45830 OPTAB(IDMON , PSHRTI , XLINT,XLINT , MDINT);
+45840 OPTAB(IDMON , PSHRTR , XLREAL,XLREAL, MDREAL);
+45850 OPTAB(IDMON , PSHRTC , XLCOMPL,XLCOMPL, MDCOMPL);
+45860 ()+61*)
+45870 NOB(OBSIGN);
+45880 OPTAB(IDMON , PSGNI , XINT,XLREAL , MDINT);
+45890 NOB(OBTIMES);
+45900 OPTAB(IDAA , PMUL , XINT,XLCOMPL , MDABSENT);
+45910 OPTAB(IDIB , PMULIC , XCHAR,XSTRNG, MDSTRNG);
+45920 OPTAB(IDBI , PMULCI , XCHAR,XSTRNG, MDSTRNG);
+45930 NOB(OBTMAB);
+45940 OPTAB(IDRA , PTIMSAB, XINT,XLCOMPL , MDABSENT);
+45950 OPTAB(IDSI , PTIMSABS,XSTRNG,XSTRNG,REFSTRNG);
+45960 NOB(OBUP);
+45970 OPTAB(IDBI , PEXP , XINT,XLCOMPL , MDABSENT);
+45980 NOB(OBUPB);
+45990 OPTAB(IDIBRM, PUPBM , -1,-1 , MDINT);
+46000 OPTAB(IDIBR , PUPB , XINT,XINT , MDINT);
+46010 OPTAB(IDMON , PUPBMSTR, XSTRNG,XSTRNG, MDINT);
+46020 DEFSTOP1('ABS ',10, OBABS);
+46030 DEFSTOP1('ARG ',10, OBARG);
+46040 DEFSTOP1('BIN ',10, OBBIN);
+46050 DEFSTOP1('CONJ ',10, OBCONJ);
+46060 DEFSTOP1('ENTIER ',10, OBENTI);
+46070 (*+61()
+46080 DEFSTOP1('LENG ',10, OBLENG);
+46090 ()+61*)
+46100 DEFSTOP1('NOT ',10, OBNOT);
+46110 DEFSTOP1('ODD ',10, OBODD);
+46120 DEFSTOP1('REPR ',10, OBREPR);
+46130 DEFSTOP1('ROUND ',10, OBROUN);
+46140 (*+61()
+46150 DEFSTOP1('SHORTEN ',10, OBSHRT);
+46160 ()+61*)
+46170 DEFSTOP1('SIGN ',10, OBSIGN);
+46180 DEFSTOP1('RE ',10, OBRE);
+46190 DEFSTOP1('IM ',10, OBIM);
+46200 DEFSTOP1('DIVAB ', 1, OBDVAB);
+46210 DEFSTOP2('/:= ', 1, OBDVAB);
+46220 DEFSTOP1('MINUSAB ', 1, OBMNAB);
+46230 DEFSTOP2('-:= ', 1, OBMNAB);
+46240 DEFSTOP1('MODAB ', 1, OBMDAB);
+46250 DEFSTOP2('%*:= ', 1, OBMDAB);
+46260 DEFSTOP1('OVERAB ', 1, OBOVAB);
+46270 DEFSTOP2('%:= ', 1, OBOVAB);
+46280 DEFSTOP1('PLUSAB ', 1, OBPLAB);
+46290 DEFSTOP2('+:= ', 1, OBPLAB);
+46300 DEFSTOP1('PLUSTO ', 1, OBPLTO);
+46310 DEFSTOP2('+=: ', 1, OBPLTO);
+46320 DEFSTOP1('TIMESAB ', 1, OBTMAB);
+46330 DEFSTOP2('*:= ', 1, OBTMAB);
+46340 DEFSTOP1('OR ', 2, OBOR);
+46350 DEFSTOP1('AND ', 3, OBAND);
+46360 DEFSTOP1('EQ ', 4, OBEQ);
+46370 DEFSTOP2('= ', 4, OBEQ);
+46380 DEFSTOP1('NE ', 4, OBNE);
+46390 DEFSTOP2('/= ', 4, OBNE);
+46400 DEFSTOP1('GE ', 5, OBGE);
+46410 DEFSTOP2('>= ', 5, OBGE);
+46420 DEFSTOP1('GT ', 5, OBGT);
+46430 DEFSTOP2('> ', 5, OBGT);
+46440 DEFSTOP1('LE ', 5, OBLE);
+46450 DEFSTOP2('<= ', 5, OBLE);
+46460 DEFSTOP1('LT ', 5, OBLT);
+46470 DEFSTOP2('< ', 5, OBLT);
+46480 DEFSTOP2('+ ', 6, OBPLUS);
+46490 DEFSTOP2('- ', 6, OBMINUS);
+46500 DEFSTOP1('ELEM ', 7, OBELEM);
+46510 DEFSTOP2('* ', 7, OBTIMES);
+46520 DEFSTOP2('/ ', 7, OBDIV);
+46530 DEFSTOP1('MOD ', 7, OBMOD);
+46540 DEFSTOP2('%* ', 7, OBMOD);
+46550 DEFSTOP1('OVER ', 7, OBOVER);
+46560 DEFSTOP2('% ', 7, OBOVER);
+46570 (*-51()
+46580 DEFSTOP2('^ ', 8, OBUP);
+46590 ()-51*)
+46600 (*+51()
+46610 DEFSTOP2(''' ', 8, OBUP);
+46620 ()+51*)
+46630 DEFSTOP2('** ', 8, OBUP);
+46640 DEFSTOP1('LWB ', 8, OBLWB);
+46650 DEFSTOP1('UPB ', 8, OBUPB);
+46660 DEFSTOP1('SHL ', 8, OBSHL);
+46670 DEFSTOP1('SHR ', 8, OBSHR);
+46680 DEFSTOP1('I ', 9, OBPLITM);
+46690 DEFSTOP2('+* ', 9, OBPLITM);
+46700 END;
+46710 BEGIN (*STANDARDPRELUDE*)
+46720 DCIL := NIL; SRSUBP := 0; SRSEMP := -1;
+46730 CURID := SIZIBBASE+SIZLEBBASE;
+46740 INITSTDIDS;
+46750 INITOPS;
+46760 NEW(MONADUMMY); WITH MONADUMMY^ DO
+46770 BEGIN STLINK := NIL; STLEX := NIL; STTHREAD := NIL; STDEFTYP := [STINIT]; STBLKTYP := STBDEFOP;
+46780 STRANGE := 0; STOFFSET := 0; STLEVEL := 0; STLOCRG := 0;
+46790 STMODE := DEFPRC1(MDERROR, MDERROR, PROC) END;
+46800 NEW(DYADUMMY); DYADUMMY^ := MONADUMMY^; DYADUMMY^.STMODE := DEFPRC2(MDERROR, MDERROR, MDERROR, PROC);
+46810 END;
+46820 (**)
+46830 ()+85*)
+46840 (**)
+46850 (*+01()
+46860 PROCEDURE INITBEGIN;
+46870 (*FILLS XSEG.BUFFER WITH WORDS TO BE OUTPUT BY EMITBEG*)
+46880 VAR COUNT: INTEGER;
+46890 PROCEDURE INTWD(INT: INTEGER);
+46900 BEGIN
+46910 XSEG.BUFFER[COUNT].CODEWORD := INT;
+46920 COUNT := COUNT+1
+46930 END;
+46940 PROCEDURE ALFWD(ALF: ALFA);
+46950 VAR X: RECORD CASE INTEGER OF
+46960 1: (I: INTEGER);
+46970 2: (A: ALFA)
+46980 END;
+46990 BEGIN WITH X DO
+47000 BEGIN
+47010 A := ALF;
+47020 XSEG.BUFFER[COUNT].CODEWORD := I;
+47030 COUNT := COUNT+1
+47040 END;
+47050 END;
+47060 BEGIN
+47070 COUNT := 1;
+47080 INTWD(77000007000000000000B); (*PRFX TABLE*)
+47090 ALFWD('A68PROG:::');
+47100 INTWD(0); (*FOR DAT*)
+47110 INTWD(0); (*FOR TIM*)
+47120 ALFWD(NOSNUM);
+47130 ALFWD(ALG68NUM);
+47140 ALFWD(' ');
+47150 ALFWD(' I ');
+47160 (*LDSET TABLE - LIB, MAP, ERR*)
+47170 (*-52()
+47180 INTWD(70000004000000000000B);
+47190 INTWD(00100001000000000000B);
+47200 ALFWD('A68SLIB:::');
+47210 INTWD(00110000000000000002B);
+47220 INTWD(00130000000000000000B);
+47230 ()-52*)
+47240 (*+52()
+47250 INTWD(70000002000000000000B);
+47260 INTWD(00100001000000000000B);
+47270 ALFWD('A68SLIB:::');
+47280 ()+52*)
+47290 INTWD(34000002000000000000B); (*PIDL TABLE*)
+47300 ALFWD('A68PROG:::');
+47310 INTWD(55555555555555003400B); (*3400B WORDS OF STACK/HEAP SPACE*)
+47320 INTWD(36000002000000000000B); (*ENTR TABLE*)
+47330 ALFWD('P.MAIN::::');
+47340 INTWD(00000000000001000003B);
+47350 INTWD(46000001000000000000B); (*XFER TABLE*)
+47360 ALFWD('P.MAIN::::');
+47370 XSEG.BUFFER[0].CODEWORD := COUNT-1;
+47380 END;
+47390 ()+01*)
+47400 (**)
+47410 (**)
+47420 (**)
+47430 (**)
+47440 (**)
+47450 (**)
+47460 (*+85()
+47470 (**)
+47480 PROCEDURE INITSEMANTICS;
+47490 VAR I : INTEGER;
+47500 PROCEDURE SETOLIST(VAR OLIST: OLSTTYP; A,B,C,D,E,F: STATE);
+47510 VAR I: INTEGER;
+47520 BEGIN FOR I:=0 TO 5 DO OLIST[I].DP:=FALSE;
+47530 OLIST[0].OVAL:=A; OLIST[1].OVAL:=B;OLIST[2].OVAL:=C;
+47540 OLIST[3].OVAL:=D; OLIST[4].OVAL:=E; OLIST[5].OVAL:=F;
+47550 END;
+47560 (**)
+47570 (**)
+47580 BEGIN (*INITSEMANTICS*)
+47590 (*SIMPLE,SPECIAL,WEAKREF,ROWED,DRESSED,UNDRESSED*)
+47600 SETOLIST(OLIST1, 0 ,1 ,4 ,2 ,2 ,3);OLIST1[2].DP:=TRUE;OLIST1[5].DP:=TRUE;
+47610 SETOLIST(OLIST2, 0 ,3 ,6 ,6 ,6 ,6);
+47620 SETOLIST(OLIST3, 0 ,1 ,2 ,4 ,2 ,3);
+47630 SETOLIST(OLIST4, 4 ,1 ,11 ,4 ,4 ,3);
+47640 FOR I := 0 TO 5 DO OLIST4[I].DP:=TRUE; OLIST4[1].DP:=FALSE;
+47650 SETOLIST(OLIST5, 11 ,11 ,11 ,11 ,11 ,0);OLIST5[5].DP:=TRUE;
+47660 SETOLIST(OLIST6, 0 ,1 ,2 ,4 ,2 ,3);OLIST6[5].DP:=TRUE;
+47670 (**)
+47680 END;
+47690 ()+85*)
--- /dev/null
+00100 (*+02() (*$T-*) (*$D+*) (*$W-*) (*$L-*) ()+02*)
+00105 PROGRAM COMPARE(F1,F2,INIT(*+02(),OUTPUT()+02*));
+00110 CONST SZWORD = (*+12() 2 ()+12*) (*+13() 4 ()+13*);
+00112 HOFFSET = (*-02() 4 ()-02*) (*+02() (*+19() 6 ()+19*) (*-19() 8 ()-19*) ()+02*)
+00113 (* HOFFSET IS THE AMOUNT THE HEAP HAS BEEN MOVED UP *)
+00120 TYPE ADDRINT = (*-02()INTEGER()-02*)(*+02()LONG()+02*);
+00130 LOADFILE = FILE OF ADDRINT;
+00140 VAR F1,F2 : LOADFILE;
+00150 INIT : LOADFILE;
+00160 GLOBALLENGTH,HEAPSTART,HEAPLENGTH,DUMMY : ADDRINT;
+00169 (*-19()
+00170 PROCEDURE COPY(LENGTH : ADDRINT);
+00180 VAR I,VALUE : INTEGER;
+00190 D : RECORD INT,MASK : INTEGER END;
+00200 BEGIN
+00210 FOR I := 1 TO LENGTH DO
+00220 BEGIN
+00230 READ(F1,D.INT);
+00240 READ(F2,VALUE);
+00250 D.MASK := VALUE-D.INT;
+00260 IF NOT (D.MASK IN [0,HOFFSET]) THEN (*VALUE IS PART OF A PACKED RECORD AND TOP BYTE IS NOT USED*)
+00270 D.MASK := 0;
+00280 IF D.MASK=HOFFSET THEN (* D.INT IS A POINTER *)
+00290 D.INT := D.INT-HEAPSTART;
+00300 WRITE(INIT,D.INT,D.MASK)
+00310 END
+00320 END;
+00330 ()-19*)
+00350 (*+19()
+00360 PROCEDURE COPY(LENGTH : ADDRINT);
+00370 VAR
+00380 POINTER : ADDRINT;
+00390 LAST1,THIS1,THIS2 : ADDRINT; (*BECAUSE UNINTIALISED HEAP IS -32768*)
+00400 DIFF : INTEGER;
+00410 LSW,MSW : ADDRINT;
+00425 COUNT : ADDRINT;
+00000 FUNCTION WORDSREVERSED:BOOLEAN;
+00000 TYPE R = RECORD
+00000 CASE BOOLEAN OF
+00000 TRUE: (X: ADDRINT);
+00000 FALSE: (Y: INTEGER;
+00000 Z: INTEGER);
+00000 END;
+00000 VAR V: R;
+00000 BEGIN
+00000 V.X := 1;
+00000 WORDSREVERSED := V.Y<>1
+00000 END;
+00430 BEGIN
+00000 IF NOT WORDSREVERSED THEN
+00000 BEGIN
+00435 COUNT := 1;
+00440 WHILE COUNT<=LENGTH DO
+00450 BEGIN
+00460 READ(F1,THIS1);
+00470 READ(F2,THIS2);
+00475 COUNT := COUNT+1;
+00480 DIFF := ABS(ABS(THIS1)-ABS(THIS2));
+00490 IF DIFF IN [2,HOFFSET] THEN (* LSW OF POINTER *)
+00500 BEGIN
+00510 LSW := THIS1; (*CONVERT TO 32 BIT NO *)
+00520 IF THIS1<0 THEN
+00530 LSW := LSW+65536; (*CONVERT FROM 2'S COMP TO UNSIGNED *)
+00540 READ(F1,MSW);
+00550 READ(F2,DUMMY);
+00555 COUNT := COUNT+1;
+00560 POINTER := (MSW*65536)+LSW;
+00570 POINTER := POINTER-HEAPSTART; (*MAKE POINTER RELATIVE*)
+00580 WRITE(INIT,HOFFSET,POINTER);
+00583 IF POINTER>HEAPLENGTH THEN
+00585 WRITELN('WARNING: POINTER OUT OF RANGE',POINTER);
+00590 END
+00600 ELSE IF DIFF<>0 THEN
+00610 BEGIN
+00620 WRITELN('WARNING: UNKNOWN CHANGE IN VALUE',DIFF,' FROM',THIS1,' TO',THIS2);
+00630 WRITE(INIT,0,THIS1)
+00640 END
+00650 ELSE
+00660 WRITE(INIT,0,THIS1);
+00670 END
+00680 END
+00000 ELSE
+00000 BEGIN
+00000 COUNT := 0;
+00000 READ(F1,THIS1);
+00000 READ(F2,THIS2);
+00000 COUNT := COUNT+1;
+00000 WHILE COUNT<=LENGTH DO
+00000 BEGIN
+00000 LAST1 := THIS1;
+00000 IF COUNT<LENGTH THEN
+00000 BEGIN
+00000 READ(F1,THIS1);
+00000 READ(F2,THIS2);
+00000 END;
+00000 COUNT := COUNT+1;
+00000 IF THIS1=THIS2 THEN
+00000 WRITE(INIT,0,LAST1)
+00000 ELSE
+00000 BEGIN
+00000 DIFF := ABS(ABS(THIS1)-ABS(THIS2));
+00000 IF DIFF IN [2,HOFFSET] THEN
+00000 BEGIN
+00000 LSW := THIS1;
+00000 IF THIS1<0 THEN
+00000 LSW := LSW+65536;
+00000 POINTER := LAST1*65536+LSW-HEAPSTART;
+00000 WRITE(INIT,HOFFSET,POINTER);
+00000 IF POINTER>HEAPLENGTH THEN
+00000 WRITELN('WARNING: POINTER OUT OF RANGE',POINTER);
+00000 IF COUNT<=LENGTH THEN
+00000 BEGIN
+00000 READ(F1,THIS1);
+00000 READ(F2,THIS2);
+00000 END;
+00000 COUNT := COUNT+1;
+00000 END
+00000 ELSE
+00000 BEGIN
+00000 WRITELN('WARNING: UNKNOWN CHANGE IN VALUE',DIFF,' FROM',THIS1,' TO',THIS2);
+00000 WRITE(INIT,0,LAST1)
+00000 END
+00000 END
+00000 END
+00000 END;
+00675 WRITELN('COPY OF LENGTH',(COUNT-1)*SZWORD); (*IN BYTES*)
+00000 END;
+00690 ()+19*)
+00710 BEGIN(*OF COMPARE*)
+00720 RESET(F1); RESET(F2); REWRITE(INIT);
+00730 READ(F1,GLOBALLENGTH);WRITE(INIT,GLOBALLENGTH);
+00740 READ(F1,HEAPLENGTH);WRITE(INIT,HEAPLENGTH);
+00750 READ(F1,HEAPSTART);
+00760 READ(F2,DUMMY);READ(F2,DUMMY);READ(F2,DUMMY);
+00770 COPY(GLOBALLENGTH DIV SZWORD);
+00780 COPY(HEAPLENGTH DIV SZWORD);
+00790 END.
--- /dev/null
+60000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+60010 (**)
+60020 (**)
+60030 (*$T-*)
+60040 (*+23()
+60050 PROCEDURE OCODE(OPCOD:POP;ROUTINE:ALFA);
+60060 BEGIN
+60070 CODETABLE[OPCOD].ROUTINE:=ROUTINE;
+60080 END;
+60090 PROCEDURE INITCODES;
+60100 VAR I: INTEGER;
+60110 BEGIN
+60120 FOR I := PNONE TO PLAST DO
+60130 BEGIN CODETABLE[I].ROUTINE := ' '; CODETABLE[I].PR := SBTSTK END;
+60140 OCODE (PNONE , 'PNONE ');
+60150 OCODE (PIM , 'PIM ');
+60160 OCODE (PRE , 'PRE ');
+60170 OCODE (PBIN , 'PBIN ');
+60180 OCODE (PREPR , 'PREPR ');
+60190 OCODE (PSGNI , 'PSGNI ');
+60200 OCODE (PSHRTC , 'PSHRTC ');
+60210 OCODE (PSHRTR , 'PSHRTR ');
+60220 OCODE (PSHRTI , 'PSHRTI ');
+60230 OCODE (PLENGC , 'PLENGC ');
+60240 OCODE (PLENGR , 'PLENGR ');
+60250 OCODE (PLENGI , 'PLENGI ');
+60260 OCODE (PODD , 'PODD ');
+60270 OCODE (PROUNL , 'PROUNL ');
+60280 OCODE (PROUN , 'PROUN ');
+60290 OCODE (PENTIL , 'PENTIL ');
+60300 OCODE (PENTI , 'PENTI ');
+60310 OCODE (PCONJ , 'PCONJ ');
+60320 OCODE (PARGL , 'PARGL ');
+60330 OCODE (PARG , 'PARG ');
+60340 OCODE (PNOTB , 'PNOTB ');
+60350 OCODE (PABSCH , 'PABSCH ');
+60360 OCODE (PABSB , 'PABSB ');
+60370 OCODE (PABSC , 'PABSC ');
+60380 OCODE (PABSI , 'PABSI ');
+60390 OCODE (PNEGI , 'PNEGI ');
+60400 OCODE (PPLITM , 'PPLITM ');
+60410 OCODE (PMULIC , 'PMULIC ');
+60420 OCODE (PMULCI , 'PMULCI ');
+60430 OCODE (PELMBY , 'PELMBY ');
+60440 OCODE (PELMBT , 'PELMBT ');
+60450 OCODE (PSHR , 'PSHR ');
+60460 OCODE (PSHL , 'PSHL ');
+60470 OCODE (PLWBMSTR , 'PLWBMSTR ');
+60480 OCODE (PLWBM , 'PLWBM ');
+60490 OCODE (PLWB , 'PLWB ');
+60500 OCODE (PUPBMSTR , 'PUPBMSTR ');
+60510 OCODE (PUPBM , 'PUPBM ');
+60520 OCODE (PUPB , 'PUPB ');
+60530 OCODE (PORB , 'PORB ');
+60540 OCODE (PANDB , 'PANDB ');
+60550 OCODE (PMODAB , 'PMODAB ');
+60560 OCODE (POVERAB , 'POVERAB ');
+60570 OCODE (PDIVAB , 'PDIVAB ');
+60580 OCODE (PTIMSABS , 'PTIMSABS ');
+60590 OCODE (PTIMSAB , 'PTIMSAB ');
+60600 OCODE (PMINUSAB , 'PMINUSAB ');
+60610 OCODE (PPLSTOCS , 'PPLSTOCS ');
+60620 OCODE (PPLSABCH , 'PPLSABCH ');
+60630 OCODE (PPLSABS , 'PPLSABS ');
+60640 OCODE (PPLSAB , 'PPLSAB ');
+60650 OCODE (PCAT , 'PCAT ');
+60660 OCODE (PGEBT , 'PGEBT ');
+60670 OCODE (PGECS , 'PGECS ');
+60680 OCODE (PGE , 'PGE ');
+60690 OCODE (PGTBY , 'PGTBY ');
+60700 OCODE (PGTCS , 'PGTCS ');
+60710 OCODE (PGT , 'PGT ');
+60720 OCODE (PLEBT , 'PLABT ');
+60730 OCODE (PLECS , 'PLECS ');
+60740 OCODE (PLE , 'PLE ');
+60750 OCODE (PLTBY , 'PLTBY ');
+60760 OCODE (PLTCS , 'PLTCS ');
+60770 OCODE (PLT , 'PLT ');
+60780 OCODE (PNEB , 'PNEB ');
+60790 OCODE (PNECS , 'PNECS ');
+60800 OCODE (PNE , 'PNE ');
+60810 OCODE (PEQB , 'PEQB ');
+60820 OCODE (PEQCS , 'PEQCS ');
+60830 OCODE (PEQ , 'PEQ ');
+60840 OCODE (PEXP , 'PEXP ');
+60850 OCODE (PMOD , 'PMOD ');
+60860 OCODE (POVER , 'POVER ');
+60870 OCODE (PDIV , 'PDIV ');
+60880 OCODE (PMUL , 'PMUL ');
+60890 OCODE (PSUB , 'PSUB ');
+60900 OCODE (PADD , 'PADD ');
+60910 OCODE (PNOOP , 'PNOOP ');
+60920 OCODE (PASP , 'PASP ');
+60930 OCODE (PHOIST , 'PHOIST ');
+60940 OCODE (PSELECT , 'PSELECT ');
+60950 OCODE (PSELECTROW, 'PSELECTROW');
+60960 OCODE (PSTRNGSLICE , 'PSTRNGSLIC');
+60970 OCODE (PSTARTSLICE , 'PSTARTSLIC');
+60980 OCODE (PSLICE1 , 'PSLICE1 ');
+60990 OCODE (PSLICE2 , 'PSLICE2 ');
+61000 OCODE (PSLICEN , 'PSLICEN ');
+61010 OCODE (PCASE , 'PCASE ');
+61020 OCODE (PJMPF , 'PJMPF ');
+61030 OCODE (PLPINIT , 'PLPINIT ');
+61040 OCODE (PRANGENT , 'PRANGENT ');
+61050 OCODE (PRANGEXT , 'PRANGEXT ');
+61060 OCODE (PROUTNENT , 'PROUTNENT ');
+61070 OCODE (PACTDRMULT, 'PACTDRMULT');
+61080 OCODE (PACTDRSTRUCT, 'PACTDRSTRU');
+61090 OCODE (PVARLISTEND , 'PVARLISTEN');
+61100 OCODE (PDCLINIT , 'PDCLINIT ');
+61110 OCODE (PCREATEREF, 'PCREATEREF');
+61120 OCODE (PCHECKDESC, 'PCHECKDESC');
+61130 OCODE (PDCLSP , 'PDCLSP ');
+61140 OCODE (PDECM , 'PDECM ');
+61150 OCODE (PBOUNDS , 'PBOUNDS ');
+61160 OCODE (PLOADRT , 'PLOADRT ');
+61170 OCODE (PLOADRTP , 'PLOADRTP ');
+61180 OCODE (PSCOPETT , 'PSCOPETT ');
+61190 OCODE (PASSIGTT , 'PASSIGTT ');
+61200 OCODE (PSCOPETN , 'PSCOPETN ');
+61210 OCODE (PASSIGTN , 'PASSIGTN ');
+61220 OCODE (PSCOPENT , 'PSCOPENT ');
+61230 OCODE (PASSIGNT , 'PASSIGNT ');
+61240 OCODE (PSCOPENN , 'PSCOPENN ');
+61250 OCODE (PASSIGNN , 'PASSIGNN ');
+61260 OCODE (PSCOPEVAR , 'PSCOPEVAR ');
+61270 OCODE (PSCOPEEXT , 'PSCOPEEXT ');
+61280 OCODE (PLOADVAR , 'PLOADVAR ');
+61290 OCODE (PASGVART , 'PASGVART ');
+61300 OCODE (PGETPROC , 'PGETPROC ');
+61310 OCODE (PIDTYREL , 'PIDTYREL ');
+61320 OCODE (PDEREF , 'PDEREF ');
+61330 OCODE (PGETTOTAL , 'PGETTOTAL ');
+61332 OCODE (PGETMULT , 'PGETMULT ');
+61340 OCODE (PGETTOTCMN, 'PGETTOTCMN');
+61350 OCODE (PVOIDNAKED, 'PVOIDNAKED');
+61360 OCODE (PSKIP , 'PSKIP ');
+61370 OCODE (PSKIPSTRUCT , 'PSKIPSTRUC');
+61380 OCODE (PNIL , 'PNIL ');
+61390 OCODE (PVOIDNORMAL , 'PVOIDNORMA');
+61400 OCODE (PVOIDSPECIAL, 'PVOIDSPECI');
+61410 OCODE (PWIDEN , 'PWIDEN ');
+61420 OCODE (PROWNONMULT , 'PROWNONMUL');
+61430 OCODE (PROWMULT , 'PROWMULT ');
+61440 OCODE (PCALL , 'PCALL ');
+61450 OCODE (PRETURN , 'PRETURN ');
+61460 OCODE (PPARBEGIN , 'PPARBEGIN ');
+61470 OCODE (PLPINCR , 'PLPINCR ');
+61480 OCODE (PLPTEST , 'PLPTEST ');
+61490 OCODE (PGBSTK , 'PGBSTK ');
+61500 OCODE (PLEAPGEN , 'PLEAPGEN ');
+61510 OCODE (PSWAP , 'PSWAP ');
+61520 OCODE (PPREPSTRDISP, 'PPREPSTRDI');
+61530 OCODE (PPREPROWDISP, 'PPREPROWDI');
+61540 OCODE (PCOLLTOTAL, 'PCOLLTOTAL');
+61550 OCODE (PCOLLNAKED, 'PCOLLNAKED');
+61560 OCODE (PCOLLCHECK, 'PCOLLCHECK');
+61570 OCODE (PLINE , 'PLINE ');
+61580 OCODE (PENDSLICE , 'PENDSLICE ');
+61590 OCODE (PTRIM , 'PTRIM ');
+61600 OCODE (PJMP , 'PJMP ');
+61610 OCODE (PPUSH , 'PPUSH ');
+61620 OCODE (PPUSHIM , 'PPUSHIM ');
+61630 OCODE (PGETOUT , 'PGETOUT ');
+61640 OCODE (PSETIB , 'PSETIB ');
+61650 OCODE (PRNSTART , 'PRNSTART ');
+61660 OCODE (PPARM , 'PPARM ');
+61670 OCODE (PNAKEDPTR , 'PNAKEDPTR ');
+61680 OCODE (PPBEGIN , 'PPBEGIN ');
+61690 OCODE (PPEND , 'PPEND ');
+61710 OCODE (PLAST , 'PLAST ');
+61720 OCODE (PPASC , 'PPASC ');
+61730 OCODE (PENVCHAIN , 'PENVCHAIN ');
+61740 OCODE (PDUP1ST , 'PDUP1ST ');
+61750 OCODE (PDUP2ND , 'PDUP2ND ');
+61760 OCODE (PDATALIST , 'PDATALIST ');
+61770 END;
+61780 ()+23*)
+61790 (************************************)
+61800 (* CYBER VERSION *)
+61810 (************************************)
+61820 PROCEDURE INITCODES;
+61830 (*INITIALIZES CODETABLE*)
+61840 CONST
+61850 (*+61() X12 = SBTX12; X45 = SBTX45; ST2 = SBTSTK2; ()+61*)
+61860 X5 = SBTX5; X5S = SBTX5; ST = SBTSTK; O = SBTVOID;
+61870 SN = SBTSTKN; SNS = SBTSTKN; SNP = SBTSTKN; SDL = SBTDL; XN = SBTXN;
+61880 X5P = SBTX5; STP = SBTSTK; X0S = SBTX0; STS = SBTSTK; X6 = SBTX6;
+61890 X0 = SBTX0; X0P = SBTX0; X1 = SBTX1; X1S = SBTX1; X1P = SBTX1;
+61910 PPOPTOX0(*2*)=203; PPOPTOX1(*2*)=205; PPUSHX6=207;
+61920 PLOADX5IM(*2*)=208; PX5TOX0=210; PX5TOX1=211;
+61930 PX6TOX5=212; PX6TOX0=213; PX6TOX1=214; PX1TOX0=215; PLOADX6(*3*)=216;
+61940 QELMBT=219; QNORM=220; QNEGI=221; QABSB=222; QABSB1=223;
+61950 QNAKEDPTR=224; QDIV=225; QDIV1=226; QDIV2=227; QSWAP=228; QSWAP1=229; QCFSTRNG=230;
+61960 QGEBT=231; QRANGENT=232; QWIDEN=233; QLPINIT(*4*)=234; QDCLINIT(*1*)=238;
+61970 PPUSHX0=239; QGETPROC=240; QPARAM1A=241;
+61980 QPBEGIN(*5*)=242;
+61990 QLOADRTA=247; QCHECKDESC=248; QABSI=249; QABSI1=250; QLOADX6=251; QPOPTOX6=252;
+62000 QMUL=253; QMUL1=254; QCAS=255; QVOIDNM=256; QVOIDNM1=257; QVOIDNM2=258; QVOIDNM3=259;
+62010 QASSIGNT(*2*)=260;QCOLLTOTAL(*5*)=262;QSCOPEVAR(*3*)=267;QLOADVAR(*4*)=270;
+62020 QLOADX0=274;QPOPX0=275;QPOPX1=276;
+62030 QDCLSP(*4*)=277; QLOOPINCR(*6*)=281;
+62040 QSETIB(*2*)=287; QPOP1=289; QPASC(*2*)=290;
+62050 QPUSH(*3*)=292; QVASSTX(*4*)=295;
+62060 QRANGEXT(*3*)=299; QLINK=302; QENTER=303; QLINE=304;
+62070 QNOTB=305; QEQ=306; QEQ1=307; QNE=308; QNE1=309; QCALL(*5*)=310; PPOPTOX5=315; QRNSTART(*3*)=316;
+62080 PPUSHX5=319; PLOADX6IM(*2*)=320;PPOPTOX6=322;PX5TOX6=323;
+62090 PLOADX5(*3*)=324;
+62100 PLOADX0(*4*)=327; PLOADX1(*3*)=331;
+62110 QGETTOTCMN(*2*)=334; QGETTOTAL(*6*)=336; QPARM(*5*)=342; QCALLA(*4*)=347;
+62120 QSELECT(*5*)=351; QDECM(*5*)=356; PLOADRTA(*3*)=361;
+62124 PPUSHX1=364; PX1TOX5=365; PX1TOX6=366;
+62130 (*+61()
+62140 QASGVART(*5+)=367; PPUSH2(*3+)=372; QPUSH2(*6+)=375;
+62150 PLOADX12(*3+)=381; QLOADX12=384; PLOADX45(*3+)=385; QLOADX45=388;
+62160 PPUSHX12=389; QPUSHX12(*2+)=390; PPUSHX45=392; QPUSHX45(*2+)=393;
+62170 PPOPTOX12=395; QPOPTOX12(*2+)=396; PPOPTOX45=398; QPOPTOX45(*2+)=399;
+62180 PX12TOX45=401; QX12TOX45=402; PX45TOX12=400;5QX45TOX12=401; 6 3
+62190 QLENGR=402; QMULL(*7+)=403; QADD(*10+)=410;
+62200 ()+61*)
+62210 VAR I: INTEGER;
+62220 PROCEDURE ICODE(OPCOD: POP; COMPASS: ALFA; PNEXT: POP;VP1,VP2,VPR:SBTTYP);
+62230 (*WARNING: THIS PROCEDURE WILL NOT COPE WITH ERRONEOUS COMPASS*)
+62240 LABEL 99;
+62250 CONST SHIFT1=100000B;
+62260 VAR CHA: CHAR;
+62270 II: INTEGER;
+62280 L: PACKED RECORD
+62290 CASE INTEGER OF
+62300 1: (FM: PACKED ARRAY [1..2] OF CHAR;
+62310 LJT, LKT: (B, A, X, KK, STAR);
+62320 LI, LJ, LK: 0..7;
+62330 LOP1, LOP2: (PLUS, MINUS, TIMES, OVER, COMMA, MISSING);
+62340 LKP: BOOLEAN;
+62350 LKK: -400000B..377777B);
+62360 2: (LW: INTEGER)
+62370 (*NOTE THAT LW:=0 SETS LI,LJ,LK TO 0, LOP1,LOP2 TO PLUS AND LJT,LKT TO B*)
+62380 END;
+62390 M: PACKED RECORD
+62400 CASE INTEGER OF
+62410 1: (F: 0..7; M: 0..7; I: 0..7; J: 0..7; K: 0..7);
+62420 2: (MW: 0..77777B)
+62430 END;
+62440 BEGIN WITH L, M DO
+62450 BEGIN
+62460 LW := 0; MW := 0; LKP := FALSE; LKK := 0;
+62470 FM[1] := COMPASS[1]; FM[2] := COMPASS[2];
+62480 CHA := COMPASS[3];
+62490 IF CHA IN ['0'..'9'] THEN BEGIN LI := ORD(CHA)-ORD('0'); II := 4 END
+62500 ELSE II := 3;
+62510 WHILE COMPASS[II]=' ' DO
+62520 IF II=10 THEN GOTO 99 ELSE II := II+1;
+62530 CHA := COMPASS[II];
+62540 IF (CHA='-') AND NOT(COMPASS[II+1] IN ['0'..'9']) THEN
+62550 BEGIN LOP1 := MINUS; II := II+1; CHA := COMPASS[II] END;
+62560 IF CHA IN ['B', 'A', 'X'] THEN
+62570 BEGIN
+62580 IF CHA='B' THEN LJT := B
+62590 ELSE IF CHA='A' THEN LJT := A
+62600 ELSE IF CHA='X' THEN LJT := X;
+62610 LJ := ORD(COMPASS[II+1])-ORD('0');
+62620 II := II+2; CHA := COMPASS[II]
+62630 END
+62640 ELSE LJT := KK;
+62650 LKT := KK;
+62660 IF CHA='+' THEN LOP2 := PLUS
+62670 ELSE IF CHA='-' THEN LOP2 := MINUS
+62680 ELSE IF CHA='*' THEN LOP2 := TIMES
+62690 ELSE IF CHA='/' THEN LOP2 := OVER
+62700 ELSE IF CHA=',' THEN LOP2 := COMMA
+62710 ELSE IF CHA IN ['0'..'9'] THEN
+62720 BEGIN LKK := ORD(CHA)-ORD('0'); LKP := TRUE END
+62730 ELSE BEGIN LKT := B; LOP2 := MISSING END;
+62740 II := II+1; CHA := COMPASS[II];
+62750 IF CHA IN ['B', 'A', 'X'] THEN
+62760 BEGIN
+62770 IF CHA='B' THEN LKT := B
+62780 ELSE IF CHA='A' THEN LKT := A
+62790 ELSE IF CHA='X' THEN LKT := X;
+62800 LK := ORD(COMPASS[II+1])-ORD('0');
+62810 II := II+2
+62820 END
+62830 ELSE LK := 0;
+62840 (*READ K*)
+62850 WHILE II<=10 DO
+62860 BEGIN CHA := COMPASS[II];
+62870 IF CHA IN ['0'..'9'] THEN
+62880 BEGIN LKK := LKK*10+ORD(CHA)-ORD('0'); LKP := TRUE END
+62890 ELSE IF CHA='*' THEN LKT := STAR;
+62900 II := II+1
+62910 END;
+62920 IF LOP2=MINUS THEN
+62930 IF LKP THEN
+62940 BEGIN LKK := -LKK; LOP2 := PLUS END
+62950 ELSE LKK := 1; (*OR ANY ODD NUMBER*)
+62960 99: WITH CODETABLE[OPCOD] DO
+62970 BEGIN
+62980 P1 := VP1;
+62990 P2 := VP2;
+63000 PR := VPR;
+63010 IF (P1=O)AND(P2<>O) THEN WRITELN(OUTPUT,'FAILED ICODE-A');
+63020 IF (P2=ST) THEN WRITELN(OUTPUT,'FAILED ICODE-B');
+63030 IF FM='LB' THEN
+63040 LEN := F0
+63050 ELSE IF FM[1]='S' THEN
+63060 BEGIN
+63070 CASE FM[2] OF
+63080 'A': F := 5;
+63090 'B': F := 6;
+63100 'X': F := 7
+63110 END;
+63120 I := LI; J := LJ;
+63130 CASE LKT OF
+63140 STAR,KK: BEGIN
+63150 LEN := F30;
+63160 CASE LJT OF
+63170 A: M := 0;
+63180 KK,B: M := 1;
+63190 X: M := 2
+63200 END
+63210 END;
+63220 B: BEGIN
+63230 LEN := F15;
+63240 CASE LJT OF
+63250 X: M := 3;
+63260 A: M := 4;
+63270 B: M := 6;
+63280 END;
+63290 IF LOP2=MINUS THEN M := M+1;
+63300 K := LK
+63310 END
+63320 END
+63330 END
+63340 ELSE IF FM='BX' THEN
+63350 BEGIN
+63360 F := 1; LEN := F15;
+63370 I := LI; K := LJ;
+63380 IF LKT=B (*I.E. ABSENT*) THEN
+63390 BEGIN M := 0; J := LJ END
+63400 ELSE
+63410 BEGIN
+63420 CASE LOP2 OF
+63430 TIMES: M := 1;
+63440 PLUS: M := 2;
+63450 MINUS: M := 3
+63460 END;
+63470 J := LK
+63480 END;
+63490 IF LOP1=MINUS THEN M := M+4
+63500 END
+63510 ELSE IF (FM[1] IN ['F', 'D', 'R', 'I', 'C']) AND (FM[2]='X') THEN
+63520 BEGIN
+63530 LEN := F15;
+63540 I := LI; J := LJ; K := LK;
+63550 IF LOP2 IN [PLUS, MINUS] THEN
+63560 BEGIN
+63570 F := 3;
+63580 CASE FM[1] OF
+63590 'F': M := 0;
+63600 'D': M := 2;
+63610 'R': M := 4;
+63620 'I': M := 6
+63630 END;
+63640 IF LOP2=MINUS THEN M := M+1
+63650 END
+63660 ELSE
+63670 BEGIN F := 4;
+63680 CASE FM[1] OF
+63690 'F': M := 0;
+63700 'R': M := 1;
+63710 'D': M := 2;
+63720 'C': BEGIN M := 7; K := LJ END
+63730 END;
+63740 IF LOP2=OVER THEN M := M+4
+63750 END
+63760 END
+63770 ELSE IF (FM[1] IN ['M','L','A','N','Z','U','P']) AND (FM[2]='X') THEN
+63780 BEGIN
+63790 IF LKP THEN
+63800 BEGIN
+63810 MW := LKK; (*SET JK*)
+63820 CASE FM[1] OF
+63830 'M': BEGIN F := 4; M := 3 END;
+63840 'L': BEGIN F := 2; M := 0 END;
+63850 'A': BEGIN F := 2; M := 1 END
+63860 END
+63870 END
+63880 ELSE
+63890 BEGIN F := 2;
+63900 IF LKT=X THEN BEGIN J := LJ; K := LK END
+63910 ELSE BEGIN J := LK; K := LJ END;
+63920 CASE FM[1] OF
+63930 'L': M := 2;
+63940 'A': M := 3;
+63950 'N': M := 4;
+63960 'Z': M := 5;
+63970 'U': M := 6;
+63980 'P': M := 7
+63990 END
+64000 END;
+64010 LEN := F15; I := LI
+64020 END
+64030 ELSE (*JUMP*)
+64040 BEGIN F := 0;
+64050 LEN := F30;
+64060 IF LJT=X THEN
+64070 BEGIN M := 3; J := LJ;
+64080 IF FM='ZR' THEN I := 0
+64090 ELSE IF FM='NZ' THEN I := 1
+64100 ELSE IF FM='PL' THEN I := 2
+64110 ELSE IF FM='NG' THEN I := 3
+64120 ELSE IF FM='IR' THEN I := 4
+64130 ELSE IF FM='OR' THEN I := 5
+64140 ELSE IF FM='DF' THEN I := 6
+64150 ELSE IF FM='ID' THEN I := 7
+64160 ELSE HALT
+64170 END
+64180 ELSE
+64190 BEGIN I := LJ; J := LK;
+64200 IF FM='PS' THEN M := 0
+64210 ELSE IF FM='RJ' THEN M := 1
+64220 ELSE IF FM='JP' THEN M := 2
+64230 ELSE IF FM='EQ' THEN M := 4
+64240 ELSE IF FM='NE' THEN M := 5
+64250 ELSE IF FM='GE' THEN M := 6
+64260 ELSE IF FM='LE' THEN BEGIN M := 6; I := LJ; J := LI END
+64270 ELSE IF FM='LT' THEN M := 7
+64280 ELSE IF FM='GT' THEN BEGIN M := 7; I := LJ; J := LI END
+64290 ELSE IF FM='NO' THEN BEGIN F := 4; M := 6; LEN := F15 END
+64300 ELSE HALT
+64310 END
+64320 END;
+64330 REL := 0;
+64340 IF LEN=F15 THEN FMIJK := MW
+64350 ELSE IF (LKP) AND (LKT<>STAR) THEN
+64360 IF LKK>=0 THEN FMIJK := MW*SHIFT1+LKK
+64370 ELSE FMIJK := MW*SHIFT1+LKK+1000000B
+64380 ELSE IF LEN=F30 THEN
+64390 IF (LKT <> STAR) AND (LOP2<>MISSING) THEN
+64400 BEGIN LEN := F30K; FMIJK := MW*SHIFT1+LKK END
+64410 ELSE BEGIN FMIJK := MW*SHIFT1; REL := LKK END;
+64420 INLINE := TRUE;
+64430 NEXT := PNEXT
+64440 END
+64450 END
+64460 END;
+64470 PROCEDURE OCODE(OPCOD: POP; PROUTINE: ALFA;VP1,VP2,VPR:SBTTYP);
+64480 VAR I: INTEGER;
+64490 BEGIN
+64500 WITH CODETABLE[OPCOD] DO
+64510 BEGIN
+64520 P1 := VP1;
+64530 P2 := VP2;
+64540 PR := VPR;
+64550 IF (P1=O)AND(P2<>O) THEN WRITELN(OUTPUT,'FAILED OCODE-A');
+64560 IF P2=ST THEN WRITELN(OUTPUT,'FAILED OCODE-B');
+64570 INLINE := FALSE;
+64580 LINKINS := NIL;
+64590 FOR I := 1 TO 7 DO ROUTINE[I] := PROUTINE[I]
+64600 END
+64610 END;
+64620 (**)
+64630 PROCEDURE QCODE (OPCOD:POP; COMPASS:ALFA; PNEXT:POP );
+64640 BEGIN ICODE(OPCOD, COMPASS, PNEXT, O, O ,O ) END;
+64650 (**)
+64660 PROCEDURE FIRSTPART;
+64670 VAR I: INTEGER;
+64680 BEGIN FOR I := PNONE TO PLAST DO OCODE(I, 'DUMMY ', O , O , O );
+64690 (**)
+64700 ICODE(PPBEGIN , 'SB7 2 ', QPBEGIN ,O ,O ,O );
+64710 QCODE(QPBEGIN , 'RJ B0+ ', 0);
+64720 ICODE(PPBEGIN+1 , 'SB6 B2+ ', QPBEGIN+1 ,O ,O ,O );
+64730 QCODE(QPBEGIN+1 , 'SB7 B6+100', QPBEGIN+2);
+64740 QCODE(QPBEGIN+2 , 'SA0 5 ', QPBEGIN+3);
+64750 QCODE(QPBEGIN+3 , 'GEB7,B4,41', QPBEGIN+4);
+64760 OCODE(QPBEGIN+4 , 'START68 ' ,O ,O ,O );
+64770 OCODE(PPEND , 'STOP68 ' ,O ,O ,O );
+64780 OCODE(PPOP , ' ' ,O ,O ,O );
+64790 ICODE(PABSI , 'BX3 X1 ', QABSI ,X1 ,O ,X1 );
+64800 QCODE(QABSI , 'AX3 59 ', QABSI1);
+64810 QCODE(QABSI1 , 'BX1 X1-X3 ', 0);
+64820 ICODE(PABSI-2 , 'BX3 X1 ', QABSI ,X1 ,O ,X1 );
+64830 OCODE(PABSI-4 , 'CABSI ' ,X0 ,O ,X6 );
+64840 ICODE(PABSB , 'MX3 1 ', QABSB ,X1 ,O ,X1 );
+64850 QCODE(QABSB , 'BX1 X1*X3 ', QABSB1);
+64860 QCODE(QABSB1 , 'LX1 1 ', 0);
+64870 ICODE(PABSB-1 , 'NO ', 0 ,X1 ,O ,X1 );
+64880 ICODE(PABSCH , 'NO ', 0 ,X1 ,O ,X1 );
+64890 ICODE(PADD , 'IX1 X5+X1 ', 0 ,X5 ,X1 ,X1 );
+64900 ICODE(PADD-2 , 'RX1 X5+X1 ', QNORM ,X5 ,X1 ,X1 );
+64910 (*+61()
+64920 ICODE(PADD-3 , 'FX3 X1+X4 ', QADD ,X45,X12,X12);
+64930 QCODE(QADD , 'DX4 X1+X4 ', QADD+1);
+64940 QCODE(QADD+1 , 'NX3 X3 ', QADD+2);
+64950 QCODE(QADD+2 , 'RX5 X2+X5 ', QADD+3);
+64960 QCODE(QADD+3 , 'RX5 X4+X5 ', QADD+4);
+64970 QCODE(QADD+4 , 'FX4 X3+X5 ', QADD+5);
+64980 QCODE(QADD+5 , 'NX4 X4 ', QADD+6);
+64990 QCODE(QADD+6 , 'DX5 X3+X5 ', QADD+7);
+65000 QCODE(QADD+7 , 'NX5 X5 ', QADD+8);
+65010 QCODE(QADD+8 , 'FX1 X4+X5 ', QADD+9);
+65020 QCODE(QADD+9 , 'DX2 X4+X5 ', 0);
+65030 ()+61*)
+65040 OCODE(PADD-4 , 'CPLUS ' ,X0 ,X1 ,X6 );
+65050 ICODE(PANDB , 'BX1 X1*X5 ', 0 ,X5 ,X1 ,X1 );
+65060 ICODE(PANDB-1 , 'BX1 X1*X5 ', 0 ,X5 ,X1 ,X1 );
+65070 OCODE(PARG , 'CARG ' ,X0 ,O ,X6 );
+65080 ICODE(PBIN , 'NO ', 0 ,X1 ,O ,X1 );
+65090 OCODE(PCAT , 'CATCC ' ,X0 ,X1 ,X6 );
+65100 OCODE(PCAT-1 , 'CATSS ' ,X0 ,X1 ,X6 );
+65110 OCODE(PCONJ , 'CCONJ ' ,X0 ,O ,X6 );
+65120 ICODE(PDIV , 'PX5 X5 ', QDIV ,X5 ,X1 ,X1 );
+65130 QCODE(QDIV , 'NX5 X5 ', QDIV1);
+65140 QCODE(QDIV1 , 'PX1 X1 ', QDIV2);
+65150 QCODE(QDIV2 , 'NX1 X1 ', PDIV-2);
+65160 ICODE(PDIV-2 , 'RX1 X5/X1 ', 0 ,X5 ,X1 ,X1 );
+65170 OCODE(PDIV-4 , 'CDIV ' ,X0 ,X1 ,X6 );
+65180 ICODE(PDIVAB , 'RX1 X5/X1 ', 0 ,X5 ,X1 ,X1 );
+65190 OCODE(PDIVAB-2 , 'CDIVAB ' ,X0 ,X1 ,X6 );
+65200 ICODE(PELMBT , 'SB3 X5-1 ', QELMBT ,X5 ,X1 ,X1 );
+65210 QCODE(QELMBT , 'LX1 B3,X1 ', 0);
+65220 OCODE(PELMBY , 'ELEMBY ' ,X5 ,X1 ,X1 );
+65230 OCODE(PENTI , 'ENTIER ' ,X1 ,O ,X1 );
+65240 ICODE(PEQ , 'IX3 X1-X5 ', QEQ ,X5 ,X1 ,X1 );
+65250 QCODE(QEQ , 'IX1 X5-X1 ', QEQ1);
+65260 QCODE(QEQ1 , 'BX1 -X1-X3', 0);
+65270 ICODE(PEQ-2 , 'IX3 X1-X5 ', QEQ ,X5 ,X1 ,X1 );
+65280 OCODE(PEQ-4 , 'CEQ ' ,X0 ,X1 ,X6 );
+65290 ICODE(PEQB , 'BX1 -X1-X5', 0 ,X5 ,X1 ,X1 );
+65300 ICODE(PEQB-1 , 'IX3 X1-X5 ', QEQ ,X5 ,X1 ,X1 );
+65310 ICODE(PEQB-2 , 'IX3 X1-X5 ', QEQ ,X5 ,X1 ,X1 );
+65320 ICODE(PEQCS , 'IX3 X1-X5 ', QEQ ,X5 ,X1 ,X1 );
+65330 ICODE(PEQCS-1 , 'SX2 2 ', QCFSTRNG ,X0 ,X1 ,X6 );
+65340 OCODE(PEXP , 'POWI ' ,X5 ,X1 ,X1 );
+65350 OCODE(PEXP-2 , 'POWR ' ,X5 ,X1 ,X1 );
+65360 OCODE(PEXP-4 , 'CPOW ' ,X0 ,X1 ,X6 );
+65370 ICODE(PPASC , 'SX6 B5 ', QPASC ,SDL,O ,X6 );
+65380 ICODE(PPASC+1 , 'SX6 B5 ', QPASC ,X0S,O ,X6 );
+65390 ICODE(PPASC+2 , 'SX6 B5 ', QPASC ,X0S,X1 ,X6 );
+65400 OCODE(PPASC+3 , 'PASC ' ,STS,O ,X6 );
+65410 QCODE(QPASC , 'SX7 2* ', QPASC+1);
+65420 QCODE(QPASC+1 , 'EQ B0+ ', 0);
+65430 ICODE(PENVCHAIN , 'SA3 B5 ', 0 ,O ,O ,O );
+65440 ICODE(PENVCHAIN+1 , 'SA3 X3 ', 0 ,O ,O ,O );
+65450 ICODE(PGE , 'IX1 X5-X1 ', PNOTB ,X5 ,X1 ,X1 );
+65460 ICODE(PGE-2 , 'IX1 X5-X1 ', PNOTB ,X5 ,X1 ,X1 );
+65470 ICODE(PGEBT , 'BX1 -X5*X1', QGEBT ,X5 ,X1 ,X1 );
+65480 QCODE(QGEBT , 'BX5 X5-X5 ', PEQ);
+65490 ICODE(PGEBT-1 , 'IX1 X5-X1 ', PNOTB ,X5 ,X1 ,X1 );
+65500 ICODE(PGECS , 'IX1 X5-X1 ', PNOTB ,X5 ,X1 ,X1 );
+65510 ICODE(PGECS-1 , 'SX2 4 ', QCFSTRNG ,X0 ,X1 ,X6 );
+65520 ICODE(PGT , 'IX1 X1-X5 ', 0 ,X5 ,X1 ,X1 );
+65530 ICODE(PGT-2 , 'IX1 X1-X5 ', 0 ,X5 ,X1 ,X1 );
+65540 ICODE(PGTBY , 'IX1 X1-X5 ', 0 ,X5 ,X1 ,X1 );
+65550 ICODE(PGTCS , 'IX1 X1-X5 ', 0 ,X5 ,X1 ,X1 );
+65560 ICODE(PGTCS-1 , 'SX2 5 ', QCFSTRNG ,X0 ,X1 ,X6 );
+65570 OCODE(PIM , 'CIM ' ,X0 ,O ,X6 );
+65580 ICODE(PLE , 'IX1 X1-X5 ', PNOTB ,X5 ,X1 ,X1 );
+65590 ICODE(PLE-2 , 'IX1 X1-X5 ', PNOTB ,X5 ,X1 ,X1 );
+65600 ICODE(PLEBT , 'BX1 -X1*X5', QGEBT ,X5 ,X1 ,X1 );
+65610 ICODE(PLEBT-1 , 'IX1 X1-X5 ', PNOTB ,X5 ,X1 ,X1 );
+65620 ICODE(PLECS , 'IX1 X1-X5 ', PNOTB ,X5 ,X1 ,X1 );
+65630 ICODE(PLECS-1 , 'SX2 B1 ', QCFSTRNG ,X0 ,X1 ,X6 );
+65640 (*+61()
+65650 ICODE(PLENGR , 'BX2 X2-X2 ', QLENGR ,X1 ,O ,X12);
+65660 QCODE(QLENGR , 'DX2 X1+X2 ', 0);
+65670 ()+61*)
+65680 ICODE(PLT , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+65690 ICODE(PLT-2 , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+65700 ICODE(PLTBY , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+65710 ICODE(PLTCS , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+65720 ICODE(PLTCS-1 , 'SX2 B0 ', QCFSTRNG ,X0 ,X1 ,X6 );
+65730 OCODE(PLWBMSTR , 'LWBMSTR ' ,X0 ,O ,X6 );
+65740 OCODE(PLWBM , 'LWBM ' ,X0 ,O ,X6 );
+65750 OCODE(PLWB , 'LWB ' ,X0 ,X1 ,X6 );
+65760 ICODE(PMINUSAB , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+65770 ICODE(PMINUSAB-2 , 'RX1 X5-X1 ', QNORM ,X5 ,X1 ,X1 );
+65780 OCODE(PMINUSAB-4 , 'CMINAB ' ,X0 ,X1 ,X6 );
+65790 OCODE(PMOD , 'MOD ' ,X5 ,X1 ,X1 );
+65800 OCODE(PMODAB , 'MOD ' ,X5 ,X1 ,X1 );
+65810 ICODE(PMUL , 'DX1 X1*X5 ', QMUL ,X5 ,X1 ,X1 );
+65820 QCODE(QMUL , 'BX3 X3-X3 ', QMUL1);
+65830 QCODE(QMUL1 , 'IX1 X1+X3 ', 0);
+65840 ICODE(PMUL-2 , 'RX1 X1*X5 ', 0 ,X5 ,X1 ,X1 );
+65850 (*+61()
+65860 ICODE(PMUL-3 , 'RX2 X2*X4 ', QMULL ,X45,X12,X12);
+65870 QCODE(QMULL , 'RX5 X1*X5 ', QMULL+1);
+65880 QCODE(QMULL+1 , 'RX2 X2+X5 ', QMULL+2);
+65890 QCODE(QMULL+2 , 'FX3 X1*X4 ', QMULL+3);
+65900 QCODE(QMULL+3 , 'DX4 X1*X4 ', QMULL+4);
+65910 QCODE(QMULL+4 , 'RX4 X4+X2 ', QMULL+5);
+65920 QCODE(QMULL+5 , 'FX1 X3+X4 ', QMULL+6);
+65930 QCODE(QMULL+6 , 'DX2 X3+X4 ', 0);
+65940 ()+61*)
+65950 OCODE(PMUL-4 , 'CTIMS ' ,X0 ,X1 ,X6 );
+65960 OCODE(PMULCI , 'MULCI ' ,X0 ,X1 ,X6 );
+65970 OCODE(PMULCI-1 , 'MULSI ' ,X0 ,X1 ,X6 );
+65980 OCODE(PMULIC , 'MULIC ' ,X0 ,X1 ,X6 );
+65990 OCODE(PMULIC-1 , 'MULIS ' ,X0 ,X1 ,X6 );
+66000 ICODE(PNE , 'IX3 X1-X5 ', QNE ,X5 ,X1 ,X1 );
+66010 QCODE(QNE , 'IX1 X5-X1 ', QNE1);
+66020 QCODE(QNE1 , 'BX1 X1-X3 ', 0);
+66030 ICODE(PNE-2 , 'IX3 X1-X5 ', QNE ,X5 ,X1 ,X1 );
+66040 OCODE(PNE-4 , 'CNE ' ,X0 ,X1 ,X6 );
+66050 ICODE(PNEB , 'BX1 X1-X5 ', 0 ,X5 ,X1 ,X1 );
+66060 ICODE(PNEB-1 , 'IX3 X1-X5 ', QNE ,X5 ,X1 ,X1 );
+66070 ICODE(PNEB-2 , 'IX3 X1-X5 ', QNE ,X5 ,X1 ,X1 );
+66080 ICODE(PNECS , 'IX3 X1-X5 ', QNE ,X5 ,X1 ,X1 );
+66090 ICODE(PNECS-1 , 'SX2 3 ', QCFSTRNG ,X0 ,X1 ,X6 );
+66100 ICODE(PNEGI , 'BX3 X3-X3 ', QNEGI ,X1 ,O ,X1 );
+66110 QCODE(QNEGI , 'IX1 X3-X1 ', 0);
+66120 ICODE(PNEGI-2 , 'BX3 X3-X3 ', QNEGI ,X1 ,O ,X1 );
+66130 OCODE(PNEGI-4 , 'CNEGI ' ,X0 ,O ,X6 );
+66140 ICODE(PNOTB , 'MX3 1 ', QNOTB ,X1 ,O ,X1 );
+66150 QCODE(QNOTB , 'BX1 X3-X1 ', 0);
+66160 ICODE(PNOTB-1 , 'BX3 X3-X3 ', QEQ1 ,X1 ,O ,X1 );
+66170 ICODE(PNOOP , 'NO ', 0 ,X1 ,O ,X1 );
+66180 ICODE(PNOOP-2 , 'NO ', 0 ,X1 ,O ,X1 );
+66190 ICODE(PNOOP-4 , 'NO ', 0 ,X1 ,O ,X1 );
+66200 ICODE(PODD , 'LX1 59 ', 0 ,X1 ,O ,X1 );
+66210 ICODE(PORB , 'BX1 X1+X5 ', 0 ,X5 ,X1 ,X1 );
+66220 ICODE(PORB-1 , 'BX1 X1+X5 ', 0 ,X5 ,X1 ,X1 );
+66230 OCODE(POVER , 'OVER ' ,X5 ,X1 ,X1 );
+66240 OCODE(POVERAB , 'OVER ' ,X5 ,X1 ,X1 );
+66250 OCODE(PPLITM , 'CRCOMPLEX ' ,X0 ,X1 ,X6 );
+66260 ICODE(PPLSAB , 'IX1 X5+X1 ', 0 ,X5 ,X1 ,X1 );
+66270 ICODE(PPLSAB-2 , 'RX1 X5+X1 ', QNORM ,X5 ,X1 ,X1 );
+66280 (*+61()
+66290 ICODE(PPLSAB-3 , 'FX3 X1+X4 ', QADD ,X45,X12,X12);
+66300 ()+61*)
+66310 OCODE(PPLSAB-4 , 'CPLUSAB ' ,X0 ,X1 ,X6 );
+66320 OCODE(PPLSABS , 'PLABSS ' ,X0 ,X1 ,X6 );
+66330 OCODE(PPLSABS-1 , 'PLABSS ' ,X0 ,X1 ,X6 );
+66340 OCODE(PPLSTOCS , 'PLTOSS ' ,X0 ,X1 ,X6 );
+66350 OCODE(PPLSTOCS-1 , 'PLTOSS ' ,X0 ,X1 ,X6 );
+66360 OCODE(PRE , 'CRE ' ,X0 ,O ,X6 );
+66370 ICODE(PREPR , 'NO ', 0 ,X1 ,O ,X1 );
+66380 OCODE(PROUN , 'ROUN ' ,X1 ,O ,X1 );
+66390 OCODE(PSGNI , 'SIGN ' ,X1 ,O ,X1 );
+66400 OCODE(PSGNI-2 , 'SIGN ' ,X1 ,O ,X1 );
+66410 OCODE(PSHL , 'SHL ' ,X5 ,X1 ,X1 );
+66420 (*+61()
+66430 ICODE(PSHRTR , 'RX1 X1+X2 ', QNORM ,X12,O ,X1 );
+66440 ()+61*)
+66450 OCODE(PSHR , 'SHR ' ,X5 ,X1 ,X1 );
+66460 ICODE(PSUB , 'IX1 X5-X1 ', 0 ,X5 ,X1 ,X1 );
+66470 ICODE(PSUB-2 , 'RX1 X5-X1 ', QNORM ,X5 ,X1 ,X1 );
+66480 OCODE(PSUB-4 , 'CMINUS ' ,X0 ,X1 ,X6 );
+66490 ICODE(PTIMSAB , 'DX1 X5*X1 ', 0 ,X5 ,X1 ,X1 );
+66500 ICODE(PTIMSAB-2 , 'RX1 X1*X5 ', 0 ,X5 ,X1 ,X1 );
+66510 (*+61()
+66520 ICODE(PTIMSAB-3 , 'RX2 X2*X4 ', QMULL ,X45,X12,X12);
+66530 ()+61*)
+66540 OCODE(PTIMSAB-4 , 'CTIMSAB ' ,X0 ,X1 ,X6 );
+66550 OCODE(PTIMSABS , 'MULABSI ' ,X0 ,X1 ,X6 );
+66560 OCODE(PUPBMSTR , 'UPBMSTR ' ,X0 ,O ,X6 );
+66570 OCODE(PUPBM , 'UPBM ' ,X0 ,O ,X6 );
+66580 OCODE(PUPB , 'UPB ' ,X0 ,X1 ,X6 );
+66590 OCODE(QCFSTRNG , 'CFSTR ' ,O ,O ,O );
+66600 QCODE(QNORM , 'NX1 B0,X1 ', 0);
+66610 END;
+66620 PROCEDURE SECONDPART;
+66630 BEGIN
+66640 ICODE(PGETPROC , 'SA3 B6+ ', QGETPROC ,O ,O ,O );
+66650 QCODE(QGETPROC , 'BX0 X3 ', PGETPROC+1);
+66660 OCODE(PGETPROC+1 , 'GETPROC ' ,X0 ,O ,O );
+66670 ICODE(PSELECT , 'SA3 X1+B1 ', QSELECT+1 ,X1 ,O ,X1 );
+66672 QCODE(QSELECT+1 , 'AX3 25 ', QSELECT+2);
+66673 QCODE(QSELECT+2 , 'SX3 X3+ ', QSELECT+3);
+66674 QCODE(QSELECT+3 , 'LX1 42 ', QSELECT+4);
+66676 QCODE(QSELECT+4 , 'BX1 X1+X3 ', 0);
+66678 ICODE(PSELECT+1 , 'SX3 B1+ ', QSELECT+3 ,X1 ,O ,X1 );
+66680 ICODE(PSELECT+2 , 'SX3 B0+ ', QSELECT ,X0 ,O ,X0 );
+66690 QCODE(QSELECT , 'IX0 X0+X3 ', 0);
+66700 OCODE(PSELECTROW , 'SELECTR ' ,X0 ,O ,X6 );
+66710 OCODE(PSTRNGSLICE , 'STRSUB ' ,X0 ,X1 ,X6 );
+66720 OCODE(PSTRNGSLICE+1,'STRTRIM ' ,X0S,O ,X6 );
+66730 OCODE(PSTARTSLICE , 'STARTSL ' ,STP,O ,O );
+66740 OCODE(PSLICE1 , 'SLICE1 ' ,X0 ,X1 ,X0 );
+66750 OCODE(PSLICE2 , 'SLICE2 ' ,X0S,X1 ,X0 );
+66760 OCODE(PSLICEN , 'SLICEN ' ,X0S,O ,X6 );
+66770 ICODE(PCASE , 'SA3 + ', QCAS ,X1 ,O ,O );
+66780 OCODE(QCAS , 'CASE ' ,O ,O ,O );
+66785 ICODE(PCASJMP , 'EQ B0, ', 0 ,O ,O ,O );
+66787 ICODE(PCASJMP+1 , 'EQ B0, ', 0 ,O ,O ,O );
+66790 ICODE(PJMPF , 'PL X1, ', 0 ,X1 ,O ,O );
+66800 ICODE(PLPINIT , 'SX1 B5+ ', QLPINIT ,X0S,O ,X6 );
+66810 OCODE(QLPINIT , 'LINIT1 ' ,O ,O ,O );
+66820 ICODE(PLPINIT+1 , 'SX1 B5+ ', QLPINIT+1 ,X0S,O ,X6 );
+66830 OCODE(QLPINIT+1 , 'LINIT2 ' ,O ,O ,O );
+66840 ICODE(PLPINIT+2 , 'SX1 B5+ ', QLPINIT+2 ,X0S,O ,O );
+66850 OCODE(QLPINIT+2 , 'LINIT3 ' ,O ,O ,O );
+66860 ICODE(PLPINIT+3 , 'SX1 B5+ ', QLPINIT+3 ,X0S,O ,O );
+66870 OCODE(QLPINIT+3 , 'LINIT4 ' ,O ,O ,O );
+66880 ICODE(PLPTEST , 'ZR X6, ', 0 ,X6 ,O ,O );
+66888 ICODE(PLPINCR , 'SX0 B5+ ', QLOOPINCR+5 ,O ,O ,X6 );
+66890 OCODE(QLOOPINCR+5 , 'LOOPINC ' ,O ,O ,O );
+66900 ICODE(PLPINCR+1 , 'SA4 B5+ ', QLOOPINCR ,O ,O ,X6 );
+66910 QCODE(QLOOPINCR , 'SX3 B1 ', QLOOPINCR+1);
+66920 QCODE(QLOOPINCR+1 , 'IX7 X4+X3 ', QLOOPINCR+2);
+66930 QCODE(QLOOPINCR+2 , 'SA7 A4 ', QLOOPINCR+3);
+66940 QCODE(QLOOPINCR+3 , 'SA3 A4+B1 ', QLOOPINCR+4);
+66950 QCODE(QLOOPINCR+4 , 'IX6 X3-X4 ', 0);
+66960 ICODE(PRANGENT , 'SX2 B5+ ', QRANGENT ,O ,O ,O );
+66970 OCODE(QRANGENT , 'RANGENT ' ,O ,O ,O );
+66980 OCODE(PRANGEXT , 'RANGEXT ' ,O ,O ,O );
+66990 ICODE(PRANGEXT+1 , 'SA3 B5+12 ', QRANGEXT ,O ,O ,O );
+67000 QCODE(QRANGEXT , 'SA2 X3+2 ', QRANGEXT+1);
+67010 QCODE(QRANGEXT+1 , 'BX7 X2 ', QRANGEXT+2);
+67020 QCODE(QRANGEXT+2 , 'SA7 A3 ', 0);
+67030 OCODE(PRANGEXT+2 , 'RANGXTP ' ,X0 ,O ,X6 );
+67032 OCODE(PRECGEN , 'DORECGE ' ,O ,O ,O );
+67040 OCODE(PACTDRMULT , 'CRMULT ' ,X0 ,O ,X6 );
+67050 OCODE(PACTDRSTRUCT, 'CRSTRUC ' ,O ,O ,X6 );
+67060 OCODE(PCHECKDESC , 'CHKDESC ' ,X0 ,X1 ,X6 );
+67070 OCODE(PVARLISTEND , 'GARBAGE ' ,X0 ,O ,O );
+67080 ICODE(PVARLISTEND+1,'SB6 B6-B1 ', 0 ,ST ,O ,O );
+67090 ICODE(PDCLINIT , 'SA3 B2+328', QDCLINIT ,O ,O ,O ); (*FIRSTVAR*)
+67100 QCODE(QDCLINIT , 'BX7 X3 ',0);
+67110 ICODE(PDCLINIT+1 , 'SA3 B2+329', QDCLINIT ,O ,O ,O ); (*FIRSTVAR+1*)
+67120 ICODE(PDCLINIT+2 , 'SA7 B5+ ',0 ,O ,O ,O );
+67130 ICODE(PPARM , 'SA3 B5+ ', QPARM ,O ,O ,O );
+67140 QCODE(QPARM , 'SA2 X3 ', QPARM+1);
+67150 QCODE(QPARM+1 , 'SX7 B1 ', QPARM+2);
+67160 QCODE(QPARM+2 , 'LX7 47 ', QPARM+3);
+67170 QCODE(QPARM+3 , 'IX7 X2+X7 ', QPARM+4);
+67180 QCODE(QPARM+4 , 'SA7 A2 ', 0);
+67210 OCODE(PCREATEREF , 'CRREFN ' ,X0 ,O ,X6 );
+67220 OCODE(PCREATEREF+1, 'CRRECN ' ,X0 ,O ,X6 );
+67230 OCODE(PCREATEREF+2, 'CRREFR ' ,X0 ,O ,X6 );
+67240 OCODE(PCREATEREF+3, 'CRRECR ' ,X0 ,O ,X6 );
+67260 ICODE(PDCLSP , 'SA6 B5+ ', 0 ,X6 ,O ,O );
+67270 ICODE(PDCLSP+1 , 'SA3 X6 ', QDCLSP ,X6 ,O ,O );
+67280 QCODE(QDCLSP , 'SX7 B1 ', QDCLSP+1);
+67290 QCODE(QDCLSP+1 , 'LX7 47 ', QDCLSP+2);
+67300 QCODE(QDCLSP+2 , 'IX7 X3+X7 ', QDCLSP+3);
+67310 QCODE(QDCLSP+3 , 'SA7 A3 ', PDCLSP);
+67320 OCODE(PDCLSP+2 , 'DCLSN ' ,SNS,O ,O );
+67330 OCODE(PDCLSP+3 , 'DCLPN ' ,SNS,O ,O );
+67340 ICODE(PFIXRG , 'SX7 B5+ ', 0 , O ,O ,O );
+67350 ICODE(PFIXRG+1 , 'SA7 B5+ ', 0 , O ,O ,O );
+67360 OCODE(PBOUNDS , 'BOUND ' ,STS,O ,X6 );
+67370 ICODE(PLOADVAR , 'SX1 B5+ ', QLOADVAR ,O ,O ,X6 );
+67380 QCODE(QLOADVAR , 'SX2 B5 ', QLOADVAR+1);
+67390 OCODE(QLOADVAR+1 , 'GLDVAR ' ,O ,O ,O );
+67400 ICODE(PLOADVAR+1 , 'SX1 B2+ ', QLOADVAR+2 ,O ,O ,X6 );
+67410 QCODE(QLOADVAR+2 , 'SX2 B2+345', QLOADVAR+1); (*FIRSTIBOFFSET*)
+67420 ICODE(PLOADVAR+2 , 'SX1 X3+ ', QLOADVAR+3 ,O ,O ,X6 );
+67430 QCODE(QLOADVAR+3 , 'SX2 X3 ', QLOADVAR+1);
+67440 OCODE(PLOADRT , 'ROUTN ' ,O ,O ,X6 );
+67450 ICODE(PLOADRTA , 'SX1 B5+ ', QLOADRTA ,O ,O ,X6 );
+67460 ICODE(PLOADRTA+1 , 'SX1 B2+ ', QLOADRTA ,O ,O ,X6 );
+67470 ICODE(PLOADRTA+2 , 'SX1 X3+ ', QLOADRTA ,O ,O ,X6 );
+67480 OCODE(QLOADRTA , 'ROUTNA ' ,O ,O ,O );
+67490 OCODE(PLOADRTP , 'ROUTNP ' ,X0 ,O ,X6 );
+67500 OCODE(PSCOPETT+2 , 'TASSTPT ' ,X0 ,X1 ,X6 );
+67510 OCODE(PSCOPETT+3 , 'SCPTTP ' ,X0 ,X1 ,X6 );
+67520 OCODE(PSCOPETT+4 , 'SCPTTM ' ,X0 ,X1 ,X6 );
+67530 OCODE(PASSIGTT , 'TASSTS ' ,X0 ,X1 ,X6 );
+67540 (*+61()
+67550 OCODE(PASSIGTT+1 , 'TASSTS2 ' ,X0 ,X12,X6 );
+67560 ()+61*)
+67570 OCODE(PASSIGTT+2 , 'TASSTPT ' ,X0 ,X1 ,X6 );
+67580 OCODE(PASSIGTT+3 , 'TASSTP ' ,X0 ,X1 ,X6 );
+67590 OCODE(PASSIGTT+4 , 'TASSTM ' ,X0 ,X1 ,X6 );
+67600 OCODE(PSCOPETN , 'SCPTNP ' ,X0 ,X1 ,X6 );
+67610 OCODE(PASSIGTN , 'TASSNP ' ,X0 ,X1 ,X6 );
+67620 OCODE(PSCOPENT+2 , 'SCPNTPT ' ,X0 ,X1 ,X6 );
+67630 OCODE(PSCOPENT+3 , 'SCPNTP ' ,X0 ,X1 ,X6 );
+67640 OCODE(PASSIGNT , 'NASSTS ' ,X0 ,X1 ,X6 );
+67650 OCODE(PASSIGNT+1 , 'NASSTS2 ' ,X0 ,X1 ,X6 );
+67660 OCODE(PASSIGNT+2 , 'NASSTPT ' ,X0 ,X1 ,X6 );
+67670 OCODE(PASSIGNT+3 , 'NASSTP ' ,X0 ,X1 ,X6 );
+67690 OCODE(PSCOPENN , 'SCPNNP ' ,X0 ,X1 ,X6 );
+67700 OCODE(PASSIGNN , 'NASSNP ' ,X0 ,X1 ,X6 );
+67710 ICODE(PSCOPEVAR , 'SX2 B5+ ', QSCOPEVAR ,X0 ,O ,O );
+67720 QCODE(QSCOPEVAR , 'SX3 B5 ', QSCOPEVAR+1);
+67730 OCODE(QSCOPEVAR+1 , 'GVSCOPE ' ,O ,O ,O );
+67740 ICODE(PSCOPEVAR+1 , 'SX2 B2+ ', QSCOPEVAR+2 ,X0 ,O ,O );
+67750 QCODE(QSCOPEVAR+2 , 'SX3 B2+345', QSCOPEVAR+1);
+67760 ICODE(PSCOPEVAR+2 , 'SX2 X3+ ', QSCOPEVAR+1 ,X0 ,O ,O );
+67770 OCODE(PSCOPEEXT , 'SCOPEXT ' ,X0 ,O ,X6 );
+67780 ICODE(PASGVART , 'SA6 B5+ ', 0 ,X6 ,O ,O );
+67790 ICODE(PASGVART+1 , 'SA6 B2+ ', 0 ,X6 ,O ,O );
+67800 ICODE(PASGVART+2 , 'SA6 X3+ ', 0 ,X6 ,O ,O );
+67810 (*+61()
+67820 ICODE(PASGVART+3 , 'BX7 X1 ', QASGVART ,X12,O ,O );
+67830 QCODE(QASGVART , 'SA7 B5+ ', QASGVART+1);
+67840 QCODE(QASGVART+1 , 'BX7 X2 ', QASGVART+2);
+67850 QCODE(QASGVART+2 , 'SA7 A7+B1 ', 0);
+67860 ICODE(PASGVART+4 , 'BX7 X1 ', QASGVART+3 ,X12,O ,O );
+67870 QCODE(QASGVART+3 , 'SA7 B2+ ', QASGVART+1);
+67880 ICODE(PASGVART+5 , 'BX7 X1 ', QASGVART+4 ,X12,O ,O );
+67890 QCODE(QASGVART+4 , 'SA7 X3+ ', QASGVART+1);
+67900 ()+61*)
+67910 ICODE(PASGVART+6 , 'SX1 B5+ ', QVASSTX ,X0 ,O ,O );
+67920 OCODE(QVASSTX , 'GVASSTX ' ,O ,O ,O );
+67930 ICODE(PASGVART+7 , 'SX1 B2+ ', QVASSTX ,X0 ,O ,O );
+67940 ICODE(PASGVART+8 , 'SX1 X3+ ', QVASSTX ,X0 ,O ,O );
+67950 OCODE(PIDTYREL , 'IS ' ,X0 ,X1 ,X6 );
+67960 OCODE(PIDTYREL+1 , 'ISNT ' ,X0 ,X1 ,X6 );
+67980 ICODE(PGETTOTCMN , 'BX1 X0 ', QGETTOTCMN ,X0 ,O ,X1 );
+67990 QCODE(QGETTOTCMN , 'AX0 42 ', QGETTOTCMN+1);
+68000 QCODE(QGETTOTCMN+1, 'IX1 X1+X0 ', 0);
+68005 OCODE(PGETTOTCMN+1, 'GTOTMUL ' ,X0 ,O ,X1 );
+68010 OCODE(PGETTOTCMN+2, 'GTOTRFR ' ,X0 ,O ,X1 );
+68030 ICODE(PGETTOTAL , 'SA5 X1 ', QGETTOTAL ,X1 ,O ,X5 );
+68040 QCODE(QGETTOTAL , 'AX1 42 ', QGETTOTAL+1);
+68050 QCODE(QGETTOTAL+1 , 'SA3 X1 ', QGETTOTAL+2);
+68060 QCODE(QGETTOTAL+2 , 'AX3 47 ', QGETTOTAL+3);
+68070 QCODE(QGETTOTAL+3 , 'NZ X3,2* ', QGETTOTAL+4);
+68080 OCODE(QGETTOTAL+4 , 'SAVGARB ' ,O ,O ,O );
+68090 (*+61()
+68100 ICODE(PGETTOTAL+1 , 'SA4 X1 ', QGETTOTAL+5 ,X1 ,O ,X45);
+68110 QCODE(QGETTOTAL+5 , 'SA5 A4+B1 ', QGETTOTAL+1);
+68120 ()+61*)
+68130 OCODE(PGETTOTAL+2 , 'GTOTP ' ,X0 ,O ,X6 );
+68140 OCODE(PGETTOTAL+3 , 'GTOTN ' ,X0 ,O ,X6 );
+68150 OCODE(PGETTOTAL+4 , 'GTOTREF ' ,X0 ,O ,X6 );
+68152 OCODE(PGETMULT , 'GETMULT ' ,X0 ,O ,X6 );
+68154 OCODE(PGETMULT+1 , 'GETSLN ' ,X0 ,O ,X6 );
+68160 OCODE(PDEREF , 'DREFS ' ,X0 ,O ,X6 );
+68170 OCODE(PDEREF+2 , 'DREFPTR ' ,X0 ,O ,X6 );
+68180 OCODE(PDEREF+3 , 'DREFN ' ,X0 ,O ,X6 );
+68190 OCODE(PDEREF+4 , 'DREFM ' ,X0 ,O ,X6 );
+68200 OCODE(PSKIP , 'SKIPS ' ,O ,O ,X6 );
+68210 OCODE(PSKIP+1 , 'SKIPPIL ' ,O ,O ,X6 );
+68220 OCODE(PSKIPSTRUCT , 'SKIPSTR ' ,O ,O ,X6 );
+68230 OCODE(PNIL , 'NILP ' ,O ,O ,X6 );
+68240 ICODE(PVOIDNORMAL , 'SA3 X1 ', QVOIDNM ,X1 ,O ,O );
+68250 QCODE(QVOIDNM , 'AX3 47 ', QVOIDNM1);
+68260 QCODE(QVOIDNM1 , 'NZ X3,3* ', QVOIDNM2);
+68270 QCODE(QVOIDNM2 , 'SX0 A3 ', QVOIDNM3);
+68280 OCODE(QVOIDNM3 , 'GARBAGE ' ,O ,O ,O );
+68290 ICODE(PVOIDNAKED , 'LX1 18 ', PVOIDNORMAL ,X1 ,O ,O );
+68300 ICODE(PWIDEN , 'PX1 X1 ', QWIDEN ,X1 ,O ,X1 );
+68310 QCODE(QWIDEN , 'NX1 X1 ', 0);
+68320 OCODE(PWIDEN+2 , 'WIDREAL ' ,X0 ,O ,X6 );
+68330 OCODE(PWIDEN+4 , 'WIDCHAR ' ,X0 ,O ,X6 );
+68340 OCODE(PWIDEN+5 , 'WIDBITS ' ,X0 ,O ,X6 );
+68350 OCODE(PWIDEN+6 , 'WIDBYTS ' ,X0 ,O ,X6 );
+68360 OCODE(PWIDEN+7 , 'WIDSTR ' ,X0 ,O ,X6 );
+68370 OCODE(PROWNONMULT , 'ROWNM ' ,X0 ,O ,X6 );
+68380 OCODE(PROWMULT , 'ROWM ' ,X0 ,O ,X6 );
+68390 ICODE(PCALL , 'SX1 B0+ ', QCALL ,SNS,O ,O );
+68400 QCODE(QCALL , 'SA5 X6 ', QCALL+1);
+68410 QCODE(QCALL+1 , 'AX6 42 ', QCALL+2);
+68420 QCODE(QCALL+2 , 'SB7 X5 ', QCALL+3);
+68430 QCODE(QCALL+3 , 'SX7 2* ', QCALL+4);
+68440 QCODE(QCALL+4 , 'JP B7 ', 0);
+68450 ICODE(PCALLA , 'SX6 B5+ ', QCALLA ,SNS,O ,O );
+68460 ICODE(PCALLA+1 , 'SX6 B2+ ', QCALLA ,SNS,O ,O );
+68470 ICODE(PCALLA+2 , 'SX6 X3+ ', QCALLA ,SNS,O ,O );
+68480 QCODE(QCALLA , 'SA5 X2 ', QCALLA+1);
+68490 QCODE(QCALLA+1 , 'SB7 X5 ', QCALLA+2);
+68500 QCODE(QCALLA+2 , 'SX7 2* ', QCALLA+3);
+68510 QCODE(QCALLA+3 , 'JP B7 ', 0);
+68520 ICODE(PRNSTART , 'SA6 B6 ', QRNSTART ,O ,O ,O );
+68530 QCODE(QRNSTART , 'BX3 X7 ', QRNSTART+1);
+68540 QCODE(QRNSTART+1 , 'SX4 B0+ ', QRNSTART+2);
+68550 OCODE(QRNSTART+2 , 'RNSTART ' ,O ,O ,O );
+68560 OCODE(PRETURN , 'RETURN ' ,XN ,O ,O );
+68570 OCODE(PGBSTK , 'GBSTK ' ,O ,O ,O );
+68580 OCODE(PGETOUT , 'GETOUT ' ,O ,O ,O );
+68590 ICODE(PSETIB , 'SB5 X6 ', QSETIB ,O ,O ,O );
+68600 QCODE(QSETIB , 'LX6 18 ', QSETIB+1);
+68610 QCODE(QSETIB+1 , 'SB6 X6 ', 0);
+68620 OCODE(PLEAPGEN , 'GENSTR ' ,O ,O ,X6 );
+68630 OCODE(PLEAPGEN+1 , 'HEAPSTR ' ,O ,O ,X6 );
+68640 OCODE(PLEAPGEN+2 , 'GENRSTR ' ,O ,O ,X6 );
+68650 OCODE(PLEAPGEN+3 , 'GENMUL ' ,X0 ,O ,X6 );
+68660 OCODE(PLEAPGEN+4 , 'HEAPMUL ' ,X0 ,O ,X6 );
+68670 OCODE(PLEAPGEN+5 , 'GENRMUL ' ,X0 ,O ,X6 );
+68680 OCODE(PPREPSTRDISP, 'PCOLLST ' ,O ,O ,X6 );
+68690 OCODE(PPREPROWDISP, 'PCOLLR ' ,STS,O ,X6 );
+68700 OCODE(PPREPROWDISP+1,'PCOLLRM ' ,STS,O ,X6 );
+68710 OCODE(PCOLLCHECK , 'PCOLLCK ' ,X0 ,O ,X6 );
+68720 (**)
+68730 END;
+68740 PROCEDURE THIRDPART;
+68750 BEGIN
+68760 ICODE(PCOLLTOTAL , 'SA4 B6-B1 ', QCOLLTOTAL ,ST ,X6 ,ST );
+68770 QCODE(QCOLLTOTAL , 'SA6 X4+ ', 0);
+68780 ICODE(PCOLLTOTAL+2, 'SA4 X6 ', QCOLLTOTAL+1 ,ST ,X6 ,ST );
+68790 QCODE(QCOLLTOTAL+1, 'SX7 B1 ', QCOLLTOTAL+2);
+68800 QCODE(QCOLLTOTAL+2, 'LX7 47 ', QCOLLTOTAL+3);
+68810 QCODE(QCOLLTOTAL+3, 'IX7 X4+X7 ', QCOLLTOTAL+4);
+68820 QCODE(QCOLLTOTAL+4, 'SA7 A4 ', PCOLLTOTAL);
+68830 OCODE(PCOLLTOTAL+3, 'COLLTP ' ,X0 ,X1 ,X6 );
+68840 OCODE(PCOLLTOTAL+4, 'COLLTM ' ,X0 ,X1 ,X6 );
+68850 OCODE(PCOLLNAKED , 'COLLNP ' ,X0 ,X1 ,X6 );
+68860 ICODE(PNAKEDPTR , 'LX1 18 ', QNAKEDPTR ,X1 ,O ,X6 );
+68862 QCODE(QNAKEDPTR , 'SX6 X1 ', 0);
+68870 ICODE(PLINE , 'SX7 B0+ ', QLINE ,O ,O ,O );
+68880 QCODE(QLINE , 'SA7 B5+9 ', 0);
+68890 OCODE(PENDSLICE , 'ENDSL ' ,X0 ,O ,X0 );
+68900 OCODE(PTRIM , 'SLICEA ' ,STP,O ,O );
+68910 OCODE(PTRIM+1 , 'SLICEB ' ,STP,O ,O );
+68920 OCODE(PTRIM+2 , 'SLICEC ' ,STP,O ,O );
+68930 OCODE(PTRIM+3 , 'SLICED ' ,STP,O ,O );
+68940 OCODE(PTRIM+4 , 'SLICEE ' ,STP,O ,O );
+68950 OCODE(PTRIM+5 , 'SLICEF ' ,STP,O ,O );
+68960 OCODE(PTRIM+6 , 'SLICEG ' ,STP,O ,O );
+68970 OCODE(PTRIM+7 , 'SLICEH ' ,STP,O ,O );
+68980 OCODE(PTRIM+8 , 'SLICEI ' ,STP,O ,O );
+68990 OCODE(PTRIM+9 , 'SLICEJ ' ,STP,O ,O );
+69000 ICODE(PJMP , 'EQ B0, ', 0 ,O ,O ,O );
+69010 ICODE(PDUP1ST , 'SA1 B6-B1 ', 0 ,STP,O ,X1 );
+69010 ICODE(PDUP1PILE , 'SA1 B6-B1 ', 0 ,STP,O ,X1 );
+69020 ICODE(PDUP2ND , 'SA1 B6-B1 ', 0 ,STP,X5P,X1 );
+69020 ICODE(PDUP2PILE , 'SA1 B6-B1 ', 0 ,STP,X5P,X1 );
+69030 (*+61() ICODE(PDUP2ND+1 , 'SA1 B6-B1 ', 0 ,STP,X45,X1 ); ()+61*)
+69040 ICODE(PDATALIST , 'SX7 B0+ ', QPUSH+1 ,SNS,O ,SDL);
+69050 OCODE(PHOIST , 'HOIST ' ,O ,O ,O );
+69060 ICODE(PSTATICLINK , 'SX6 B5 ', 0 ,O ,O ,O );
+69070 ICODE(PASP , 'SB6 B6- ', 0 ,O ,O ,O );
+69080 ICODE(PLOADX5 , 'SA5 B5+ ', 0 ,O ,O ,O );
+69090 ICODE(PLOADX5+1 , 'SA5 B2+ ', 0 ,O ,O ,O );
+69100 ICODE(PLOADX5+2 , 'SA5 X3+ ', 0 ,O ,O ,O );
+69110 ICODE(PLOADX5IM , 'SX5 B0+ ', 0 ,O ,O ,X5 );
+69120 ICODE(PLOADX5IM+1 , 'SA5 B0+ ', 0 ,O ,O ,O );
+69130 ICODE(PPUSH , 'SA4 B5+ ', QPUSH ,O ,O ,O );
+69140 QCODE(QPUSH , 'BX7 X4 ', QPUSH+1);
+69150 QCODE(QPUSH+1 , 'SA7 B6 ', QPUSH+2);
+69160 QCODE(QPUSH+2 , 'SB6 B6+B1 ', 0);
+69170 ICODE(PPUSH+1 , 'SA4 B2+ ', QPUSH ,O ,O ,O );
+69180 ICODE(PPUSH+2 , 'SA4 X3+ ', QPUSH ,O ,O ,O );
+69190 ICODE(PPUSHIM , 'SX7 B0+ ', QPUSH+1 ,O ,O ,ST );
+69200 ICODE(PPUSHIM+1 , 'SA4 B0+ ', QPUSH ,O ,O ,O );
+69210 ICODE(PLOADX0 , 'SA4 B5+ ', QLOADX0 ,O ,O ,O );
+69220 QCODE(QLOADX0 , 'BX0 X4 ', 0);
+69230 ICODE(PLOADX0+1 , 'SA4 B2+ ', QLOADX0 ,O ,O ,O );
+69240 ICODE(PLOADX0+2 , 'SA4 X3+ ', QLOADX0 ,O ,O ,O );
+69250 ICODE(PLOADX1 , 'SA1 B5+ ', 0 ,O ,O ,O );
+69260 ICODE(PLOADX1+1 , 'SA1 B2+ ', 0 ,O ,O ,O );
+69270 ICODE(PLOADX1+2 , 'SA1 X3+ ', 0 ,O ,O ,O );
+69280 ICODE(PLOADX6 , 'SA4 B5+ ', QLOADX6 ,O ,O ,O );
+69290 QCODE(QLOADX6 , 'BX6 X4 ', 0);
+69300 ICODE(PLOADX6+1 , 'SA4 B2+ ', QLOADX6 ,O ,O ,O );
+69310 ICODE(PLOADX6+2 , 'SA4 X3+ ', QLOADX6 ,O ,O ,O );
+69320 ICODE(PLOADX0IM , 'SX0 B0+ ', 0 ,O ,O ,X0 );
+69330 ICODE(PLOADX0IM+1 , 'SA4 B0+ ', QLOADX0 ,O ,O ,O );
+69340 ICODE(PLOADX1IM , 'SX1 B0+ ', 0 ,O ,O ,X1 );
+69350 ICODE(PLOADX1IM+1 , 'SA1 B0+ ', 0 ,O ,O ,O );
+69360 ICODE(PLOADX2IM , 'SX2 B0+ ', 0 ,O ,O ,O );
+69370 ICODE(PLOADX2IM+1 , 'SA2 B0+ ', 0 ,O ,O ,O );
+69380 ICODE(PLOADX3IM , 'SX3 B0+ ', 0 ,O ,O ,O );
+69390 ICODE(PLOADX3IM+1 , 'SA3 B0+ ', 0 ,O ,O ,O );
+69400 ICODE(PLOADX4IM , 'SX4 B0+ ', 0 ,O ,O ,O );
+69410 ICODE(PLOADX4IM+1 , 'SA4 B0+ ', 0 ,O ,O ,O );
+69420 ICODE(PLOADX6IM , 'SX6 B0+ ', 0 ,O ,O ,X6 );
+69430 ICODE(PLOADX6IM+1 , 'SA4 B0+ ', QLOADX6 ,O ,O ,O );
+69440 ICODE(PPOPTOX0 , 'SB6 B6-B1 ', QPOPX0 ,O ,O ,O );
+69450 QCODE(QPOPX0 , 'SA4 B6 ', QLOADX0);
+69460 ICODE(PPOPTOX1 , 'SB6 B6-B1 ', QPOPX1 ,O ,O ,O );
+69470 QCODE(QPOPX1 , 'SA1 B6 ', 0);
+69480 ICODE(PPOPTOX6 , 'SB6 B6-B1 ', QPOPTOX6 ,O ,O ,O );
+69490 QCODE(QPOPTOX6 , 'SA4 B6 ', QLOADX6);
+69500 ICODE(PX5TOX0 , 'BX0 X5 ', 0 ,X5 ,O ,X0 );
+69510 ICODE(PX5TOX1 , 'BX1 X5 ', 0 ,X5 ,O ,X1 );
+69520 ICODE(PX5TOX6 , 'BX6 X5 ', 0 ,X5 ,O ,X6 );
+69530 ICODE(PPUSHX6 , 'SA6 B6 ', QPUSH+2 ,X6 ,O ,O );
+69540 ICODE(PX6TOX5 , 'BX5 X6 ', 0 ,X6 ,O ,X5 );
+69550 ICODE(PX6TOX0 , 'BX0 X6 ', 0 ,X6 ,O ,X0 );
+69560 ICODE(PX6TOX1 , 'BX1 X6 ', 0 ,X6 ,O ,X1 );
+69570 ICODE(PPUSHX5 , 'BX7 X5 ', QPUSH+1 ,X5 ,O ,O );
+69580 ICODE(PPOPTOX5 , 'SB6 B6-B1 ', QPOP1 ,O ,O ,O );
+69590 QCODE(QPOP1 , 'SA5 B6 ', 0);
+69600 ICODE(PPUSHX0 , 'BX7 X0 ', QPUSH+1 ,X0 ,O ,O );
+69610 ICODE(PPUSHX1 , 'BX7 X1 ', QPUSH+1 ,X1 ,O ,O );
+69620 ICODE(PX1TOX5 , 'BX5 X1 ', 0 ,X1 ,O ,X5 );
+69630 ICODE(PX1TOX6 , 'BX6 X1 ', 0 ,X1 ,O ,X6 );
+69640 ICODE(PX1TOX0 , 'BX0 X1 ', 0 ,X1 ,O ,X0 );
+69650 ICODE(PSWAP , 'BX3 X1 ', QSWAP ,O ,O ,O );
+69660 QCODE(QSWAP , 'BX1 X5 ', QSWAP1);
+69670 QCODE(QSWAP1 , 'BX5 X3 ', 0);
+69680 (*+61()
+69690 ICODE(PPUSH2 , 'SA3 B5+ ', QPUSH2 ,O ,O ,O );
+69700 QCODE(QPUSH2 , 'BX7 X3 ', QPUSH2+1);
+69710 QCODE(QPUSH2+1 , 'SA7 B6 ', QPUSH2+2);
+69720 QCODE(QPUSH2+2 , 'SA3 A3+B1 ', QPUSH2+3);
+69730 QCODE(QPUSH2+3 , 'BX7 X3 ', QPUSH2+4);
+69740 QCODE(QPUSH2+4 , 'SA7 A7+B1 ', QPUSH2+5);
+69750 QCODE(QPUSH2+5 , 'SB6 A7+B1 ', 0);
+69760 ICODE(PPUSH2+1 , 'SA3 B2+ ', QPUSH2 ,O ,O ,O );
+69770 ICODE(PPUSH2+2 , 'SA3 X3+ ', QPUSH2 ,O ,O ,O );
+69780 ICODE(PLOADX12 , 'SA1 B5+ ', QLOADX12 ,O ,O ,O );
+69790 QCODE(QLOADX12 , 'SA2 A1+B1 ', 0);
+69800 ICODE(PLOADX12+1 , 'SA1 B2+ ', QLOADX12 ,O ,O ,O );
+69810 ICODE(PLOADX12+2 , 'SA1 X3+ ', QLOADX12 ,O ,O ,O );
+69820 ICODE(PLOADX45 , 'SA4 B5+ ', QLOADX45 ,O ,O ,O );
+69830 QCODE(QLOADX45 , 'SA5 A4+B1 ', 0);
+69840 ICODE(PLOADX45+1 , 'SA4 B2+ ', QLOADX45 ,O ,O ,O );
+69850 ICODE(PLOADX45+2 , 'SA4 X3+ ', QLOADX45 ,O ,O ,O );
+69860 ICODE(PPUSHX12 , 'BX7 X1 ', QPUSHX12 ,O ,O ,O );
+69870 QCODE(QPUSHX12 , 'SA7 B6 ', QPUSHX12+1);
+69880 QCODE(QPUSHX12+1 , 'BX7 X2 ', QPUSH2+4);
+69890 ICODE(PPUSHX45 , 'BX7 X4 ', QPUSHX45 ,O ,O ,O );
+69900 QCODE(QPUSHX45 , 'SA7 B6 ', QPUSHX45+1);
+69910 QCODE(QPUSHX45+1 , 'BX7 X5 ', QPUSH2+4);
+69920 ICODE(PPOPTOX12 , 'SA2 B6-B1 ', QPOPTOX12 ,O ,O ,O );
+69930 QCODE(QPOPTOX12 , 'SA1 A2-B1 ', QPOPTOX12+1);
+69940 QCODE(QPOPTOX12+1 , 'SB6 A1 ', 0);
+69950 ICODE(PPOPTOX45 , 'SA5 B6-B1 ', QPOPTOX45 ,O ,O ,O );
+69960 QCODE(QPOPTOX45 , 'SA4 A5-B1 ', QPOPTOX45+1);
+69970 QCODE(QPOPTOX45+1 , 'SB6 A4 ', 0);
+69980 ICODE(PX12TOX45 , 'BX4 X1 ', QX12TOX45 ,O ,O ,O );
+69990 QCODE(QX12TOX45 , 'BX5 X2 ', 0);
+70000 ICODE(PX45TOX12 , 'BX1 X4 ', QX45TOX12 ,O ,O ,O );
+70010 QCODE(QX45TOX12 , 'BX2 X5 ', 0);
+70020 ()+61*)
+70030 ICODE(PDECM , 'SX7 B0+ ', 0 ,O ,O ,O );
+70040 ICODE(PDECM+1 , 'SA3 B5+ ', QDECM ,O ,O ,O );
+70050 QCODE(QDECM , 'MX4 25 ', QDECM+1);
+70060 QCODE(QDECM+1 , 'BX3 -X4*X3', QDECM+2);
+70070 QCODE(QDECM+2 , 'LX7 35 ', QDECM+3);
+70080 QCODE(QDECM+3 , 'BX7 X3+X7 ', QDECM+4);
+70090 QCODE(QDECM+4 , 'SA7 A3 ', 0);
+70100 END;
+70110 (* *** CHANGES TO BE MADE ON PERQ *** *)
+70120 (* PPARM , PPARM+1, PLOADRTA, PDECM *)
+70130 (* PCALLA, PRANGENT, PDCLINIT *)
+70140 PROCEDURE INITPOPARRAY;
+70150 VAR I, J:SBTTYP;
+70160 BEGIN
+70170 FOR I := SBTSTK TO SBTX1 DO
+70180 FOR J:= SBTVOID TO SBTX1 DO POPARRAY [I, J] := PNONE;
+70190 FOR I := SBTSTK TO SBTX1 DO
+70200 BEGIN
+70210 POPARRAY [I,I] := PNOOP;
+70220 POPARRAY [I,SBTVOID] := PNOOP;
+70230 POPARRAY [I,SBTVAR] := PLOADVAR;
+70240 POPARRAY [I,SBTPROC] := PLOADRTA;
+70250 POPARRAY [I,SBTRPROC]:= PLOADRTA;
+70260 END;
+70270 (*+61()
+70280 POPARRAY [SBTSTK , SBTSTK2 ] := PVARLISTEND+1;
+70290 POPARRAY [SBTX12 , SBTX1 ] := PNOOP;
+70300 POPARRAY [SBTSTK , SBTX12 ] := PPUSHX1;
+70310 POPARRAY [SBTSTK , SBTX45 ] := PPUSHX5;
+70320 POPARRAY [SBTSTK2 , SBTID ] := PPUSH2;
+70330 POPARRAY [SBTSTK2 , SBTIDV ] := PPUSH2;
+70340 POPARRAY [SBTSTK2 , SBTX12 ] := PPUSHX12;
+70350 POPARRAY [SBTSTK2 , SBTX45 ] := PPUSHX45;
+70360 POPARRAY [SBTX12 , SBTID ] := PLOADX12;
+70370 POPARRAY [SBTX12 , SBTIDV ] := PLOADX12;
+70380 POPARRAY [SBTX12 , SBTSTK2 ] := PPOPTOX12;
+70390 POPARRAY [SBTX12 , SBTX45 ] := PX45TOX12;
+70400 POPARRAY [SBTX45 , SBTID ] := PLOADX45;
+70410 POPARRAY [SBTX45 , SBTIDV ] := PLOADX45;
+70420 POPARRAY [SBTX45 , SBTSTK2 ] := PPOPTOX45;
+70430 POPARRAY [SBTX45 , SBTX12 ] := PX12TOX45;
+70440 ()+61*)
+70450 POPARRAY [SBTSTK , SBTID ] := PPUSH;
+70460 POPARRAY [SBTSTK , SBTIDV ] := PPUSH;
+70470 POPARRAY [SBTSTK , SBTLIT ] := PPUSHIM;
+70480 POPARRAY [SBTSTK , SBTDEN ] := PPUSHIM;
+70490 POPARRAY [SBTSTK , SBTX5 ] := PPUSHX5;
+70500 POPARRAY [SBTSTK , SBTX6 ] := PPUSHX6;
+70510 POPARRAY [SBTSTK , SBTX0 ] := PPUSHX0;
+70520 POPARRAY [SBTSTK , SBTX1 ] := PPUSHX1;
+70530 POPARRAY [SBTX5 , SBTID ] := PLOADX5;
+70540 POPARRAY [SBTX5 , SBTIDV ] := PLOADX5;
+70550 POPARRAY [SBTX5 , SBTLIT ] := PLOADX5IM;
+70560 POPARRAY [SBTX5 , SBTDEN ] := PLOADX5IM;
+70570 POPARRAY [SBTX5 , SBTSTK ] := PPOPTOX5;
+70580 POPARRAY [SBTX5 , SBTX6 ] := PX6TOX5;
+70590 POPARRAY [SBTX5 , SBTX1 ] := PX1TOX5;
+70600 POPARRAY [SBTX6 , SBTID ] := PLOADX6;
+70610 POPARRAY [SBTX6 , SBTIDV ] := PLOADX6;
+70620 POPARRAY [SBTX6 , SBTLIT ] := PLOADX6IM;
+70630 POPARRAY [SBTX6 , SBTDEN ] := PLOADX6IM;
+70640 POPARRAY [SBTX6 , SBTSTK ] := PPOPTOX6;
+70650 POPARRAY [SBTX6 , SBTX5 ] := PX5TOX6;
+70660 POPARRAY [SBTX6 , SBTX1 ] := PX1TOX6;
+70670 POPARRAY [SBTX0 , SBTID ] := PLOADX0;
+70680 POPARRAY [SBTX0 , SBTIDV ] := PLOADX0;
+70690 POPARRAY [SBTX0 , SBTLIT ] := PLOADX0IM;
+70700 POPARRAY [SBTX0 , SBTDEN ] := PLOADX0IM;
+70710 POPARRAY [SBTX0 , SBTSTK ] := PPOPTOX0;
+70720 POPARRAY [SBTX0 , SBTX5 ] := PX5TOX0;
+70730 POPARRAY [SBTX0 , SBTX6 ] := PX6TOX0;
+70740 POPARRAY [SBTX0 , SBTX1 ] := PX1TOX0;
+70750 POPARRAY [SBTX1 , SBTID ] := PLOADX1;
+70760 POPARRAY [SBTX1 , SBTIDV ] := PLOADX1;
+70770 POPARRAY [SBTX1 , SBTLIT ] := PLOADX1IM;
+70780 POPARRAY [SBTX1 , SBTDEN ] := PLOADX1IM;
+70790 POPARRAY [SBTX1 , SBTSTK ] := PPOPTOX1;
+70800 POPARRAY [SBTX1 , SBTX5 ] := PX5TOX1;
+70810 POPARRAY [SBTX1 , SBTX6 ] := PX6TOX1;
+70820 END;
+70830 PROCEDURE INITLENARRAY;
+70840 VAR I: SBTTYP;
+70850 BEGIN
+70860 FOR I := SBTSTK TO SBTX1 DO LENARRAY[I] := 0;
+70870 LENARRAY[SBTSTK ] := SZWORD;
+70880 (*+61()
+70890 LENARRAY[SBTSTK2] := 2*SZWORD;
+70900 LENARRAY[SBTX12 ] := 2*SZWORD;
+70910 LENARRAY[SBTX45 ] := 2*SZWORD;
+70920 ()+61*)
+70930 LENARRAY[SBTX5 ] := SZWORD;
+70940 LENARRAY[SBTX6 ] := SZWORD;
+70950 LENARRAY[SBTX0 ] := SZWORD;
+70960 LENARRAY[SBTX1 ] := SZWORD;
+70970 END;
+70980 PROCEDURE INITREGISTERS;
+70990 VAR I: SBTTYP;
+71000 BEGIN
+71010 FOR I := SBTVOID TO SBTX1 DO REGISTERS[I] := [];
+71020 REGISTERS[SBTDL ] := [SBTX1];
+71030 REGISTERS[SBTX5 ] := [SBTX5];
+71040 REGISTERS[SBTX6 ] := [SBTX6];
+71050 REGISTERS[SBTX0 ] := [SBTX0];
+71060 REGISTERS[SBTX1 ] := [SBTX1];
+71070 (*+61()
+71080 REGISTERS[SBTX12 ] := [SBTX1]; (*THERE IS NO SBTX2+)
+71090 REGISTERS[SBTX45 ] := [SBTX5]; (*THERE IS NO SBTX4+)
+71100 ()+61*)
+71110 END;
+71120 BEGIN (*INITCODES*)
+71130 FIRSTPART; SECONDPART; THIRDPART; INITPOPARRAY; INITLENARRAY; INITREGISTERS;
+71140 END;
+71150 (**)
+71160 (**)
+71170 (**)
+71180 (**)
+71190 (**)
+71200 BEGIN
+71210 LINELIMIT(OUTPUT,10000); LINELIMIT(LSTFILE,10000);
+71220 DUMP(FIRSTSTACK);
+71230 (*-01() DUMP(FIRSTSTACK,LASTSTACK); ()-01*)
+71240 END (*$G-*) .
+####S
--- /dev/null
+PROCEDURE dbug (number : INTEGER);
+BEGIN
+ writeln('dbug value',number)
+END;
+
+PROCEDURE dump (VAR start,finish : INTEGER); EXTERN;
+
+BEGIN
+ reset(A68INIT);
+ reset(LGO);
+ reset(SOURCDECS);
+ rewrite(LSTFILE);
+ rewrite(DUMPF);
+ dump(firststack, laststack);
+END.
--- /dev/null
+PROCEDURE dbug (number : INTEGER);
+BEGIN
+ writeln('dbug value ',number)
+END;
+
+PROCEDURE dbugl (number : LONG);
+BEGIN
+ writeln('long dbug value ',number);
+END;
+
+PROCEDURE algol68; EXTERN;
+PROCEDURE encaps(PROCEDURE p;PROCEDURE q(n:integer));EXTERN;
+PROCEDURE trap(err: integer); EXTERN;
+PROCEDURE abort; EXTERN;
+
+PROCEDURE traphandler (n:INTEGER);
+BEGIN
+ writeln('***Trap ',n:0,' has occured');
+ trap(n);
+ abort;
+END;
+
+PROCEDURE mainprog;
+BEGIN
+ algol68
+END;
+
+BEGIN
+ encaps(mainprog,traphandler)
+END.
+
--- /dev/null
+#define SZWORD EM_WSIZE
+#define SZADDR EM_PSIZE
+
+#if SZWORD==SZADDR
+#define LOAD lol
+#define STORE stl
+#else
+#define LOAD ldl
+#define STORE sdl
+#endif
+
+ mes 2,SZWORD,SZADDR
+
+ exp $GETADDRE
+ pro $GETADDRE,0
+ LOAD 0 ; load param (adress of variable)
+ ret SZADDR ; return address
+ end 0
--- /dev/null
+EMROOT=../../..
+case `$EMROOT/bin/ack_sys` in
+pdp_v7) ACM=pdp ; BM=0 ;;
+vax_bsd4_1a) ACM=vax4 ;;
+vax_bsd4_2) ACM=vax4 ;;
+vax_sysV_2) ACM=vax4 ;;
+pc_ix) ACM=i86 ; BM=0;;
+sun3) ACM=sun3 ;;
+sun2) ACM=sun2 ;;
+m68_unisoft) ACM=m68k2 ;;
+m68_sysV_0) ACM=mantra ;;
+*) ;;
+esac
+
+MACH=${MACH-$ACM}
+ case $MACH in \
+ pdp) w=2; p=2; NOFLOAT=0; RECIPE='12 13 119' ;; \
+ m68k2) w=2; p=4; NOFLOAT=1; RECIPE='12 113 19 43 44' ;; \
+ moon3) w=2; p=4; NOFLOAT=1; RECIPE='12 113 19 43 44'; BSD4=-DBSD4 ;; \
+ m68020|m68000) w=4; p=4; NOFLOAT=1; RECIPE='112 13 119 43 44' ;; \
+ sun3) w=4; p=4; NOFLOAT=1; RECIPE='112 13 119 43 44'; BSD4=-DBSD4 ;; \
+ vax4) w=4; p=4; NOFLOAT=0; RECIPE='112 13 119'; BSD4=-DBSD4 ;; \
+ *) echo machine $MACH not known to a68s; exit 1 ;; \
+ esac
+ /bin/make -f Makefile MACH=$MACH w=$w p=$p NOFLOAT=$NOFLOAT \
+ RECIPE="$RECIPE" BSD4=$BSD4 $*
+
+# sun3) w=4; p=4; NOFLOAT=0; RECIPE='112 13 119'; BSD4=-DBSD4 ;; \
--- /dev/null
+#define SZWORD EM_WSIZE
+#define SZADDR EM_PSIZE
+
+#if SZADDR==SZWORD
+#define LOAD lol
+#define STORE stl
+#else
+#define LOAD ldl
+#define STORE sdl
+#endif
+
+ mes 2,SZWORD,SZADDR
+
+ exp $PROCENTR
+ exp $PROCEXIT
+ exp $ENCAPS
+ exp $ABORT
+ exp $TRAP
+
+ pro $ABORT,0
+ loc 1
+ cal $_hlt
+ asp SZWORD
+ ret 0
+ end 0
+
+ pro $ENCAPS,0
+ LOAD SZADDR
+ LOAD 0
+ LOAD SZADDR+SZADDR+SZADDR
+ LOAD SZADDR+SZADDR
+ cal $encaps
+ asp SZADDR+SZADDR+SZADDR+SZADDR
+ ret 0
+ end 0
+
+ pro $TRAP,0
+ lol 0
+ cal $trap
+ asp SZWORD
+ ret 0
+ end 0
+
+ pro $PROCENTR,0
+ LOAD 0
+ cal $procentry
+ asp SZADDR
+ ret 0
+ end 0
+
+ pro $PROCEXIT,0
+ LOAD 0
+ cal $procexit
+ asp SZADDR
+ ret 0
+ end 0
--- /dev/null
+~>|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
--- /dev/null
+40000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+40001 THINGS NEEDING ATTENTION
+40002 CHECK THE START OF THE LOCAL POPS
+40003 ATTEND TO PDUP1PILE AND P2DUP2PILE
+40010 (**)
+40020 (**)
+40040 (*+05()
+40050 (*+86()
+40100 (*************************)
+40110 (* MEANING OF PARAMTYPES *)
+40120 (*************************)
+40130 (**)
+40140 (* OPX - OPERAND SUPPLIED BY CODE GENERATOR
+40150 ONX - NEGATIVE OF OPERAND SUPPLIED BY CODE GENERATOR
+40160 LCX - LOCAL INSTRUCTION LABEL
+40170 GBX - GLOBAL INSTRUCTION LABEL
+40180 WOP - OPERAND SUPPLIED BY CODETABLE
+40190 WNP - NEGATIVE OF OPERAND SUPPLIED BY CODETABLE
+40200 NON - NO OPERAND
+40210 JMP - FORWARD JUMP WITHIN CODETABLE
+40220 ANP - AS WNP, BUT PROVIDES LAST OPERAND FOR AN OCODE
+40230 ACP - AS WOP, BUT DITTO
+40240 ACX - AS OPX, BUT DITTO
+40250 ANX - AS ONX, BUT DITTO
+40252 MOR - LONG OPERAND TO BE FOUND IN THE NEXT OPCOD
+40260 *)
+40270 (**)
+46726 (**)
+46728 PROCEDURE INITCODES;
+46730 (*INITIALISES CODETABLE+)
+46732 CONST
+46734 (**)
+46736 PLOADRTA(*3*)=194; PDEPROC=197;
+46737 PLOADE(*3*)=198; PLOADEIM(*2*)=201; PETOSTK(*3*)=203; PS4TOS2=206; PPUSHIM2(*2*)=207;
+46738 PPUSHFSTK=209; PPUSHFSTK1=210; PLOADF=211; PLOADF1=212; QPUSHIM2(*2*)=213;
+46739 PLOADFIM=215; PLOADFIM1=216; PLOADFSTK=217; PLOADFSTK1=218; PSTOS4=219; PPUSHF=220; PPUSHF1=221;
+46740 PF0TOF1=222; PF1TOF0=223; PPUSH2(*3*)=224; PSTOS2=227; PPUSHER0=228; PLOADER0F0=229; PLOADER0F1=230;
+46741 PLOADER0STK=231; QPUSHER0(*2*)=232; QLPINIT(*8*)=234; QDIV(*2*)=242; QCALL(*8*)=244;
+46742 QABSI(*7*)=252;
+46743 QRNSTART=259; QHOIST(*3*)=260; QSCOPEVAR(*6*)=263; QENVCHAIN=269;
+46744 QIPUSH=270; QODD=271; QLEBT(*2*)=272; QLINE=274; QDATALIST=275; QGETPROC(*4*)=276;
+46745 QNOTB=280; QPUSH1=281; QCAS(*3*)=282;
+46746 QLOOPINCR(*6*)=285; QDCLSP(*4*)=291; QDCLINIT(*2*)=295;
+46747 QELMBT(*5*)=297; QDUP1ST=302; QDUP2ND=303;
+46748 QASGVART(*3*)=304; QRANGENT(*2*)=307;
+46749 QNAKEDPTR=309; QLOADI=310; QADJSP2=311; QSTKTOE(*3+)=312; QADJSP4=315;
+46750 QLOADF=316; QLOADF1=317; QLOADVAR(*6*)=318; QPUSH2(*4*)=324;
+46751 QLOADRTA(*2*)=328; QCFSTRNG(*2*)=330; QRANGEXT(*3*)=332; QCALLA(*4*)=335;
+46752 QSETIB=339; QSELECT(*3*)=340; (*SPARE(3)=343;*) QCOLLTOTAL(*11*)=346;
+46753 QETOSTK(*6*)=357; QGETTOTAL(*5*)=363; (*SPARE(7)=368;*) QHEAVE(*6*)=375; QLOADER0STK(*6*)=381;
+46754 QGETTOTCMN(*4*)=387; (*SPARE=391..400*)
+46755 ST=SBTSTK; STP=SBTSTK; STS=SBTSTK;
+46756 ST4=SBTSTK4; S4P=SBTSTK4; S4S=SBTSTK4;
+46758 STN=SBTSTKN; SNP=SBTSTKN; SNS=SBTSTKN;
+46760 PR1=SBTPR1; PR2=SBTPR2;
+46761 FP0=SBTFPR0; FP1=SBTFPR1; FP2=SBTFPR2; FP3=SBTFPR3; F0P=SBTFPR0;
+46764 XN=SBTXN;
+46770 O=SBTVOID; SDL=SBTDL; E=SBTE; ER0=SBTER0;
+46780 (*+)
+46790 PROCEDURE ICODE(OPCOD:POP;PERQCODE:MNEMONICS;TYP:PARAMTYPES;PM:INTEGER;PNXT:POP;VP1,VP2,VPR: SBTTYP);
+46800 BEGIN
+46810 WITH CODETABLE[OPCOD] DO
+46820 BEGIN
+46830 INLINE := TRUE;
+46840 PERQCOD := PERQCODE;
+46850 P1 := VP1;
+46860 P2 := VP2;
+46870 PR := VPR;
+46880 NEXT := PNXT;
+46890 PARTYP := TYP;
+46900 PARM := PM;
+46930 END;
+46950 END;
+46960 (*+)
+46970 PROCEDURE QCODE(OPCOD:POP;PERQCODE:MNEMONICS;TYP:PARAMTYPES;PM:INTEGER;PNXT:POP);
+46980 BEGIN
+46990 ICODE(OPCOD,PERQCODE,TYP,PM,PNXT,O,O,O);
+47000 END;
+47010 (*+)
+47020 PROCEDURE OCODE(OPCOD:POP;PROUTINE:ALFA;VP1,VP2,VPR:SBTTYP);
+47030 VAR I:INTEGER;
+47040 BEGIN
+47050 WITH CODETABLE[OPCOD] DO
+47060 BEGIN
+47070 INLINE := FALSE;
+47080 P1 := VP1;
+47090 P2 := VP2;
+47100 PR := VPR;
+47110 IF (P1=O) AND (P2 <> O) THEN WRITELN(OUTPUT,'FAILED OCODE-A');
+47120 FOR I := 1 TO 7 DO
+47124 ROUTINE[I] := PROUTINE[I];
+47130 END;
+47140 END;
+47150 PROCEDURE FIRSTPART;
+47160 VAR I:INTEGER;
+47170 BEGIN
+47180 FOR I := PNONE TO PLAST DO OCODE(I,'DUMMY ',O,O,O);
+47182 OCODE(PPBEGIN+1 , 'ESTART_ ' , O , O , O );
+47185 OCODE(PPBEGIN , 'START68 ' , O , O , O );
+47190 OCODE(PPEND , 'STOP68 ' , O , O , O );
+47210 ICODE(PABSI , 'DUPL ' , NON , 0 ,QABSI , E , O , E );
+47215 QCODE(QABSI , 'CI ' , WOP , 0 ,QABSI+1 );
+47220 QCODE(QABSI+1 , 'IJGE ' , JMP , 2 ,QABSI+2 );
+47230 QCODE(QABSI+2 , 'INEG ' , NON , 0 ,0 );
+47240 ICODE(PABSI-2 , 'CI ' , WOP , 0 ,QABSI+3 ,FP0, O ,FP0);
+47250 QCODE(QABSI+3 , 'FLOAT ' , WOP , 3 ,QABSI+4);
+47260 QCODE(QABSI+4 , 'RGE 0,3 ' , NON , 0 ,QABSI+5);
+47270 QCODE(QABSI+5 , 'JTRUE ' , JMP , 2 ,QABSI+6);
+47272 QCODE(QABSI+6 , 'RNEG ' , WOP , 0 ,0);
+47274 OCODE(PABSI-4 , 'CABSI ' ,PR1,O ,E );
+47280 ICODE(PABSB , 'NULL ' , NON , 0 ,0 , E , O , E );
+47290 ICODE(PABSB-1 , 'NULL ' , NON , 0 ,0 , E , O , E );
+47300 ICODE(PABSCH , 'NULL ' , NON , 0 ,0 ,ST , O ,ST );
+47310 ICODE(PADD , 'IADD ' , NON , 0 ,0 , E , E , E );
+47320 ICODE(PADD-2 , 'RADD 0,1' , NON , 0 ,0 ,FP0,FP1,FP0);
+47325 OCODE(PADD-4 , 'CPLUS ' ,PR1,PR2, E );
+47330 (*+61()
+47340 ICODE(PADD-3 , '?ADD-3 ' , WOP , 8 ,0 ,ST4,ST4,ST4);
+47350 ()+61+)
+47360 ICODE(PANDB , 'ILAND ' , NON , 0 ,0 , E , E , E );
+47370 ICODE(PANDB-1 , 'ILAND ' , NON , 0 ,0 , E , E , E );
+47375 OCODE(PARG , 'CARG ' ,PR1, O , E );
+47380 ICODE(PBIN , 'NULL ' , NON , 0 ,0 , E , O , E );
+47390 OCODE(PCAT , 'CATCC ' ,PR1,PR2, E );
+47400 OCODE(PCAT-1 , 'CATSS ' ,PR1,PR2, E );
+47405 OCODE(PCONJ , 'CCONJ ' ,PR1, O , E );
+47410 ICODE(PDIV , 'FLOAT ' , WOP , 3 ,QDIV , E , E ,FP0);
+47412 QCODE(QDIV , 'FLOAT ' , WOP , 0 ,QDIV+1);
+47414 QCODE(QDIV+1 , 'RDIV 0,3' , NON , 0 ,0);
+47420 ICODE(PDIV-2 , 'RDIV 0,1' , NON , 0 ,0 ,FP0,FP1,FP0);
+47425 OCODE(PDIV-4 , 'CDIV ' ,PR1,PR2, E );
+47430 ICODE(PDIVAB , 'RDIV 0,1' , NON , 0 ,0 ,FP0,FP1,FP0);
+47435 OCODE(PDIVAB-2 , 'CDIVAB ' ,PR1,PR2, E );
+47440 ICODE(PELMBT , 'EXCH ' , NON , 0 ,QELMBT , E , E , E );
+47450 QCODE(QELMBT , 'CI ' , WOP , 1 ,QELMBT+1);
+47452 QCODE(QELMBT+1 , 'ISUB ' , NON , 0 ,QELMBT+2);
+47460 QCODE(QELMBT+2 , 'ISLLT ' , NON , 0 ,QELMBT+3);
+47470 QCODE(QELMBT+3 , 'CI ' , WOP , 0 ,QELMBT+4);
+47472 QCODE(QELMBT+4 , 'IGT ' , NON , 0 ,0);
+47480 OCODE(PELMBY , 'ELMBY ' ,PR1,PR2, E );
+47490 OCODE(PENTI , 'ENTIER ' ,PR1, O , E );
+47500 ICODE(PEQ , 'IEQ ' , NON , 0 ,0 , E , E , E );
+47520 ICODE(PEQ-2 , 'REQ 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+47525 OCODE(PEQ-4 , 'CEQ ' ,PR1,PR2, E );
+47530 ICODE(PEQB , 'IEQ ' , NON , 0 ,0 , E , E , E );
+47540 ICODE(PEQB-1 , 'IEQ ' , NON , 0 ,0 , E , E , E );
+47550 ICODE(PEQB-2 , 'IEQ ' , NON , 0 ,0 , E , E , E );
+47560 ICODE(PEQCS , 'IEQ ' , NON , 0 ,0 , E , E , E );
+47570 ICODE(PEQCS-1 , 'CI ' , ACP , 2 ,QCFSTRNG ,PR1,PR2, E );
+47590 OCODE(PEXP , 'POWI ' ,PR1,PR2, E );
+47600 OCODE(PEXP-2 , 'POWR ' ,PR1,PR2,FP0);
+47605 OCODE(PEXP-4 , 'CPOW ' ,PR1,PR2, E );
+47610 ICODE(PPASC , 'CALL ' , OPX , 0 ,0 ,SDL, O , E );
+47620 ICODE(PPASC+1 , 'CALL ' , OPX , 0 ,0 ,PR1, O , E );
+47670 ICODE(PGE , 'ILE ' , NON , 0 ,0 , E , E , E );
+47680 ICODE(PGE-2 , 'RGE 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+47690 ICODE(PGEBT , 'EXCH ' , NON , 0 ,PLEBT , E , E , E );
+47700 ICODE(PGEBT-1 , 'ILE ' , NON , 0 ,0 , E , E , E );
+47710 ICODE(PGECS , 'ILE ' , NON , 0 ,0 , E , E , E );
+47720 ICODE(PGECS-1 , 'CI ' , ACP , 4 ,QCFSTRNG ,PR1,PR2, E );
+47740 ICODE(PGT , 'ILT ' , NON , 0 ,0 , E , E , E );
+47760 ICODE(PGT-2 , 'RGT 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+47770 ICODE(PGTBY , 'ILT ' , NON , 0 ,0 , E , E , E );
+47780 ICODE(PGTCS , 'ILT ' , NON , 0 ,0 , E , E , E );
+47790 ICODE(PGTCS-1 , 'CI ' , ACP , 5 ,QCFSTRNG ,PR1,PR2, E );
+47795 OCODE(PIM , 'CIM ' ,PR1, O , E );
+47800 ICODE(PLE , 'IGE ' , NON , 0 ,0 , E , E , E );
+47820 ICODE(PLE-2 , 'RLE 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+47830 ICODE(PLEBT , 'ILNOT ' , NON , 0 ,QLEBT , E , E , E );
+47832 QCODE(QLEBT , 'ILAND ' , NON , 0 ,QLEBT+1);
+47834 QCODE(QLEBT+1 , 'INOT ' , NON , 0 ,0);
+47840 ICODE(PLEBT-1 , 'ILE ' , NON , 0 ,0 , E , E , E );
+47850 ICODE(PLECS , 'IGE ' , NON , 0 ,0 , E , E , E );
+47860 ICODE(PLECS-1 , 'CI ' , ACP , 1 ,QCFSTRNG ,PR1,PR2, E );
+47920 ICODE(PLT , 'IGT ' , NON , 0 ,0 , E , E , E );
+47940 ICODE(PLT-2 , 'RLT 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+47950 ICODE(PLTBY , 'IGT ' , NON , 0 ,0 , E , E , E );
+47960 ICODE(PLTCS , 'IGT ' , NON , 0 ,0 , E , E , E );
+47970 ICODE(PLTCS-1 , 'CI ' , ACP , 0 ,QCFSTRNG ,PR1,PR2, E );
+47980 OCODE(PLWBMSTR , 'LWBMSTR ' ,PR1, O , E );
+47990 OCODE(PLWBM , 'LWBM ' ,PR1, O , E );
+48000 OCODE(PLWB , 'LWB ' ,PR1,PR2, E );
+48010 ICODE(PMINUSAB , 'ISUB ' , NON , 0 ,0 , E , E , E );
+48020 ICODE(PMINUSAB-2 , 'RSUB 0,1' , NON , 0 ,0 ,FP0,FP1,FP0);
+48025 OCODE(PMINUSAB-4 , 'CMINAB ' ,PR1,PR2, E );
+48030 OCODE(PMOD , 'MOD ' ,PR1,PR2, E );
+48040 OCODE(PMODAB , 'MOD ' ,PR1,PR2, E );
+48050 ICODE(PMUL , 'IMULT ' , NON , 0 ,0 , E , E , E );
+48060 ICODE(PMUL-2 , 'RMULT 0,' , WOP , 1 ,0 ,FP0,FP1,FP0);
+48070 (*+61()
+48080 ICODE(PMUL-3 , '?MUL-3 ' , WOP , 8 ,0 ,ST4,ST4,ST4);
+48090 ()+61+)
+48095 OCODE(PMUL-4 , 'CTIMS ' ,PR1,PR2, E );
+48100 OCODE(PMULCI , 'MULCI ' ,PR1,PR2, E );
+48110 OCODE(PMULCI-1 , 'MULSI ' ,PR1,PR2, E );
+48120 OCODE(PMULIC , 'MULIC ' ,PR1,PR2, E );
+48130 OCODE(PMULIC-1 , 'MULIS ' ,PR1,PR2, E );
+48140 END;
+48150 PROCEDURE SECONDPART;
+48160 BEGIN
+48170 ICODE(PNE , 'INE ' , NON , 0 ,0 , E , E , E );
+48190 ICODE(PNE-2 , 'RNE 0,1 ' , NON , 0 ,0 ,FP0,FP1, E );
+48195 OCODE(PNE-4 , 'CNE ' ,PR1,PR2, E );
+48210 ICODE(PNEB , 'INE ' , NON , 0 ,0 , E , E , E );
+48220 ICODE(PNEB-1 , 'INE ' , NON , 0 ,0 , E , E , E );
+48230 ICODE(PNEB-2 , 'INE ' , NON , 0 ,0 , E , E , E );
+48240 ICODE(PNECS , 'INE ' , NON , 0 ,0 , E , E , E );
+48250 ICODE(PNECS-1 , 'CI ' , ACP , 3 ,QCFSTRNG ,PR1,PR2, E );
+48252 ICODE(PNEGI , 'INEG ' , NON , 0 ,0 , E , O , E );
+48260 ICODE(PNEGI-2 , 'RNEG ' , WOP , 0 ,0 ,FP0, O ,FP0);
+48265 OCODE(PNEGI-4 , 'CNEGI ' ,PR1,PR2, E );
+48270 ICODE(PNOTB , 'INOT ' , NON , 0 ,0 , E , O , E );
+48290 ICODE(PNOTB-1 , 'ILNOT ' , NON , 0 ,0 , E , O , E );
+48300 ICODE(PNOOP , 'NULL ' , NON , 0 ,0 , E , O ,ST );
+48310 ICODE(PNOOP-2 , 'NULL ' , NON , 0 ,0 ,FP0, O ,ST );
+48320 ICODE(PNOOP-4 , 'NULL ' , NON , 0 ,0 , E , O ,ST );
+48330 ICODE(PODD , 'CI ' , WOP , 1 ,QODD , E , O , E );
+48340 QCODE(QODD , 'ILAND ' , NON , 0 ,0 );
+48350 ICODE(PORB , 'ILOR ' , NON , 0 ,0 , E , E , E );
+48360 ICODE(PORB-1 , 'ILOR ' , NON , 0 ,0 , E , E , E );
+48370 ICODE(POVER , 'IDIV ' , NON , 0 ,0 , E , E , E );
+48380 ICODE(POVERAB , 'IDIV ' , NON , 0 ,0 , E , E , E );
+48385 OCODE(PPLITM , 'CRCOMPLEX ' ,PR1,PR2, E );
+48390 ICODE(PPLSAB , 'IADD ' , NON , 0 ,0 , E , E , E );
+48400 ICODE(PPLSAB-2 , 'RADD 0,1' , NON , 0 ,0 ,FP0,FP1,FP0);
+48410 (*+61()
+48420 ICODE(PPLSAB-3 , '?PLSAB-3' , WOP , 8 ,0 ,ST4,ST4,ST4);
+48430 ()+61+)
+48435 OCODE(PPLSAB-4 , 'CPLUSAB ' ,PR1,PR2, E );
+48440 OCODE(PPLSABS , 'PLABSS ' ,PR1,PR2, E );
+48450 OCODE(PPLSABS-1 , 'PLABSS ' ,PR1,PR2, E );
+48460 OCODE(PPLSTOCS , 'PLTOSS ' ,PR1,PR2, E );
+48470 OCODE(PPLSTOCS-1 , 'PLTOSS ' ,PR1,PR2, E );
+48475 OCODE(PRE , 'CRE ' ,PR1,O , E );
+48480 ICODE(PREPR , 'NULL ' , NON , 0 ,0 , E , E , E );
+48490 ICODE(PROUN , 'ROUND ' , WOP , 0 ,0 ,FP0, O , E );
+48500 OCODE(PSGNI , 'SIGNI ' ,PR1, O , E );
+48510 OCODE(PSGNI-2 , 'SIGNR ' ,PR1, O , E );
+48520 OCODE(PSHL , 'SHL ' ,PR1,PR2, E );
+48530 (*+61()
+48540 ICODE(PSHRTR , '?SHRTR ' , WOP , 8 ,QSHRTR ,ST4, O ,ST2);
+48550 QCODE(QSHRTR , 'RUBBISH ' , WOP , 4 ,QSHRTR+1 );
+48560 QCODE(QSHRTR+1 , 'RUBBISH ' , NON , 0 ,0 );
+48570 ()+61+)
+48580 OCODE(PSHR , 'SHR ' ,PR1,PR2, E );
+48590 ICODE(PSUB , 'ISUB ' , NON , 0 ,0 , E , E , E );
+48600 ICODE(PSUB-2 , 'RSUB 0,1' , NON , 0 ,0 ,FP0,FP1, FP0);
+48605 OCODE(PSUB-4 , 'CMINUS ' ,PR1,PR2, E );
+48610 ICODE(PTIMSAB , 'IMULT ' , NON , 0 ,0 , E , E , E );
+48620 ICODE(PTIMSAB-2 , 'RMULT 0,' , WOP , 1 ,0 ,FP0,FP1,FP0);
+48630 (*+61()
+48640 ICODE(PTIMSAB-3 , '?TIMSAB-' , WOP , 8 ,0 ,ST4,ST4,ST4);
+48650 ()+61+)
+48655 OCODE(PTIMSAB-4 , 'CTIMSAB ' ,PR1,PR2, E );
+48660 OCODE(PTIMSABS , 'MULABSI ' ,PR1,PR2, E );
+48670 OCODE(PUPBMSTR , 'UPBMSTR ' ,PR1, O , E );
+48680 OCODE(PUPBM , 'UPBM ' ,PR1, O , E );
+48690 OCODE(PUPB , 'UPB ' ,PR1,PR2, E );
+48696 QCODE(QCFSTRNG , 'IPUSH ' , NON , 0 ,QCFSTRNG+1);
+48700 OCODE(QCFSTRNG+1 , 'CFSTR ' , O , O , O );
+48730 ICODE(PSELECT , ' SR0 ' , NON , 0 ,QSELECT , E , O ,ER0);
+48731 QCODE(QSELECT , 'LRO0 ' , WOP , 6 ,PSELECT+2);
+48734 ICODE(PSELECT+1 , ' SR0 ' , NON , 0 ,QSELECT+1 , E , O ,ER0);
+48736 QCODE(QSELECT+1 , 'CI ' , OPX , 6 ,0);
+48740 ICODE(PSELECT+2 , 'CI ' , OPX , 0 ,QSELECT+2 ,ER0, O ,ER0);
+48742 QCODE(QSELECT+2 , 'IADD ' , NON , 0 ,0);
+48760 OCODE(PSELECTROW , 'SELECTR ' ,PR1, O , E );
+48770 OCODE(PSTRNGSLICE, 'STRSUB ' ,PR1,PR2, E );
+48780 OCODE(PSTRNGSLICE+1, 'STRTRIM ' ,PR1, O , E );
+48790 OCODE(PSTARTSLICE, 'STARTSL ' , O , O , O );
+48800 OCODE(PSLICE1 , 'SLICE1 ' , E , E ,ER0);
+48810 OCODE(PSLICE2 , 'SLICE2 ' , E , E ,ER0);
+48820 OCODE(PSLICEN , 'SLICEN ' ,PR1, O ,FP0);
+48822 ICODE(PCASE , 'JUMP ' , LCX , 0 ,0 , E , O , O );
+48830 ICODE(PCASCOUNT , 'CI ' , WOP , 1 ,QCAS , O , O , O );
+48840 QCODE(QCAS , 'ISUB ' , NON , 0 ,QCAS+1);
+48842 QCODE(QCAS+1 , 'INDXJUMP' , NON , 0 ,QCAS+2);
+48844 QCODE(QCAS+2 , 'ARG ' , OPX , 0 ,0);
+48846 ICODE(PCASJMP , 'LAB ' , LCX , 0 ,0 , O , O , O );
+48848 ICODE(PCASJMP+1 , 'JUMP ' , LCX , 0 ,0 , O , O , O );
+48850 ICODE(PJMPF , 'JFALSE ' , LCX , 0 ,0 , E , O , O );
+48860 ICODE(PLPINIT , 'LAS ' , ANX , 0 ,QLPINIT ,PR1, O , E );
+48862 QCODE(QLPINIT , 'IPUSH ' , NON , 0 ,QLPINIT+1);
+48864 OCODE(QLPINIT+1 , 'LINIT1 ' , O , O , O );
+48870 ICODE(PLPINIT+1 , 'LAS ' , ANX , 0 ,QLPINIT+2 ,PR1, O , E );
+48872 QCODE(QLPINIT+2 , 'IPUSH ' , NON , 0 ,QLPINIT+3);
+48874 OCODE(QLPINIT+3 , 'LINIT2 ' , O , O , O );
+48880 ICODE(PLPINIT+2 , 'LAS ' , ANX , 0 ,QLPINIT+4 ,PR1, O , O );
+48882 QCODE(QLPINIT+4 , 'IPUSH ' , NON , 0 ,QLPINIT+5);
+48884 OCODE(QLPINIT+5 , 'LINIT3 ' , O , O , O );
+48890 ICODE(PLPINIT+3 , 'LAS ' , ANX , 0 ,QLPINIT+6 ,PR1, O , O );
+48892 QCODE(QLPINIT+6 , 'IPUSH ' , NON , 0 ,QLPINIT+7);
+48894 OCODE(QLPINIT+7 , 'LINIT4 ' , O , O , O );
+48900 ICODE(PLPTEST , 'JFALSE ' , LCX , 0 ,0 , E , O , O );
+48902 ICODE(PLPINCR , 'LAS ' , ANX , 0 ,QLOOPINCR+4 , O , O , E );
+48904 QCODE(QLOOPINCR+4, 'IPUSH ' , NON , 0 ,QLOOPINCR+5);
+48910 OCODE(QLOOPINCR+5, 'LOOPINC ' , O , O , O );
+48920 ICODE(PLPINCR+1 , 'CI ' , WOP , 1 ,QLOOPINCR , O , O , E );
+48930 QCODE(QLOOPINCR , 'LAS ' , ONX , 0 ,QLOOPINCR+1);
+48940 QCODE(QLOOPINCR+1, 'OAADD ' , NON , 0 ,QLOOPINCR+2);
+48950
+48960 QCODE(QLOOPINCR+2, 'IL ' , ONX , 2 ,QLOOPINCR+3);
+48964 QCODE(QLOOPINCR+3, 'IGE ' , NON , 0 ,0);
+48966 ICODE(PRANGENT , 'LAS ' , ANX , 0 ,QRANGENT , O , O , O );
+48968 QCODE(QRANGENT , 'IPUSH ' , NON , 0 ,QRANGENT+1);
+48970 OCODE(QRANGENT+1 , 'RANGENT ' , O , O , O );
+48980 OCODE(PRANGEXT , 'RANGEXT ' , O , O , O );
+48990 ICODE(PRANGEXT+1 , 'IL ' , WNP ,(SIZIBBASE+SIZLEBBASE-8),QRANGEXT, O , O , O );
+48992 QCODE(QRANGEXT , ' SR2 ' , NON , 0 ,QRANGEXT+1);
+48994 QCODE(QRANGEXT+1 , 'LRO2 ' , WOP , 8 ,QRANGEXT+2);
+49000 QCODE(QRANGEXT+2 , ' IS ' , WNP ,(SIZIBBASE+SIZLEBBASE-8),0 );
+49020 OCODE(PRANGEXT+2 , 'RANGXTP ' ,STP, O , E );
+49022 OCODE(PRECGEN , 'DORECGE ' , O , O , O );
+49030 OCODE(PACTDRSTRUCT,'CRSTRUC ' , O , O , E );
+49040 OCODE(PACTDRMULT , 'CRMULT ' ,PR1, O , E );
+49050 OCODE(PCHECKDESC , 'CHKDESC ' ,PR1,PR2, E );
+49080 OCODE(PVARLISTEND, 'GARBAGE ' ,PR1, O , O );
+49090 ICODE(PVARLISTEND+1,'ASFW ' , WOP , 2 ,0 ,ST , O , O );
+49096 ICODE(PDCLINIT , 'LGI ' , MOR , 0 ,QDCLINIT , O , O , O );
+49097 QCODE(QDCLINIT , '_UNINT ' , NON , 0 ,0);
+49098 ICODE(PDCLINIT+1 , 'LGI ' , MOR , 0 ,QDCLINIT+1 , O , O , O );
+49099 QCODE(QDCLINIT+1 , '_UNDEFIN' , NON , 0 ,0);
+49100 ICODE(PDCLINIT+2 , 'IS ' , ONX , 2 ,0 , O , O , O );
+49106 ICODE(PPARM , 'IL ' , ONX , 0 ,QDCLSP , O , O , O );
+49108
+49110
+49120 OCODE(PCREATEREF , 'CRREFN ' ,PR1, O , E );
+49130 OCODE(PCREATEREF+1,'CRRECN ' ,PR1, O , E );
+49140 OCODE(PCREATEREF+2,'CRREFR ' ,PR1, O , E );
+49150 OCODE(PCREATEREF+3,'CRRECR ' ,PR1, O , E );
+49160
+49170 ICODE(PDCLSP , ' IS ' , ONX , 2 ,0 , E , O , O );
+49180 ICODE(PDCLSP+1 , ' IS ' , ONX , 2 ,QDCLSP , E , O , O );
+49190 QCODE(QDCLSP , 'CI ' , MOR , 0 ,QDCLSP+1 );
+49200 QCODE(QDCLSP+1 , '65536 ' , NON , 0 ,QDCLSP+2 );
+49230 QCODE(QDCLSP+2 , 'EXCH ' , NON , 0 ,QDCLSP+3 );
+49232 QCODE(QDCLSP+3 , ' OAADD ' , NON , 0 ,0);
+49240 OCODE(PDCLSP+2 , 'DCLSN ' ,SNS, O , O );
+49250 OCODE(PDCLSP+3 , 'DCLPN ' ,SNS, O , O );
+49252 ICODE(PFIXRG , 'LAS ' , ONX , 0 ,0 , O , O , O );
+49254 ICODE(PFIXRG+1 , 'IS ' , ONX , 0 ,0 , O , O , O );
+49260 END;
+49270 PROCEDURE THIRDPART;
+49280 BEGIN
+49290 OCODE(PBOUNDS , 'BOUND ' ,STS, O , E );
+49300 ICODE(PLOADVAR , 'LAS ' , ACP , 0 ,QLOADVAR , O , O , E );
+49304 QCODE(QLOADVAR , 'LAS ' , ACX , 0 ,QLOADVAR+3);
+49310 ICODE(PLOADVAR+1 , 'LROA3 ' , ACP ,250,QLOADVAR+1 , O , O , E );
+49312 QCODE(QLOADVAR+1 , 'LROA3 ' , ACX ,250,QLOADVAR+3);
+49320 ICODE(PLOADVAR+2 , 'LROA2 ' , ACP ,192,QLOADVAR+2 , O , O , E );
+49322 QCODE(QLOADVAR+2 , 'LROA2 ' , ACX ,192,QLOADVAR+3);
+49324 QCODE(QLOADVAR+3 , 'IPUSH ' , NON , 0 ,QLOADVAR+4);
+49326 QCODE(QLOADVAR+4 , 'IPUSH ' , NON , 0 ,QLOADVAR+5);
+49328 OCODE(QLOADVAR+5 , 'GLDVAR ' , O , O , O );
+49330 OCODE(PLOADRT , 'ROUTN ' , O , O , E );
+49331 ICODE(PLOADRTA , 'LAS ' , ACX , 0 ,QLOADRTA , O , O , E );
+49332 ICODE(PLOADRTA+1 , 'LROA3 ' , ACX ,250,QLOADRTA , O , O , E );
+49333 ICODE(PLOADRTA+2 , 'LROA2 ' , ACX ,192,QLOADRTA , O , O , E );
+49334 QCODE(QLOADRTA , 'IPUSH ' , NON , 0 ,QLOADRTA+1);
+49335 OCODE(QLOADRTA+1 , 'ROUTNA ' , O , O , O );
+49336 OCODE(PLOADRTP , 'ROUTNP ' ,PR1, O , E );
+49340 OCODE(PSCOPETT+2 , 'TASSTPT ' ,PR1,PR2, E );
+49350 OCODE(PSCOPETT+3 , 'SCPTTP ' ,PR1,PR2, E );
+49360 OCODE(PSCOPETT+4 , 'SCPTTM ' ,PR1,PR2, E );
+49370 OCODE(PASSIGTT , 'TASSTS ' , E , E , E );
+49372 OCODE(PASSIGTT+1 , 'TASSTS2 ' , E ,FP0, E );
+49380 OCODE(PASSIGTT+2 , 'TASSTPT ' ,PR1,PR2, E );
+49390 OCODE(PASSIGTT+3 , 'TASSTP ' ,PR1,PR2, E );
+49400 OCODE(PASSIGTT+4 , 'TASSTM ' ,PR1,PR2, E );
+49410 OCODE(PSCOPETN , 'SCPTNP ' ,PR1,PR2, E );
+49420 OCODE(PASSIGTN , 'TASSNP ' ,PR1,PR2, E );
+49430 OCODE(PSCOPENT+2 , 'SCPNTPT ' ,PR1,PR2,FP0);
+49440 OCODE(PSCOPENT+3 , 'SCPNTP ' ,PR1,PR2,FP0);
+49480 OCODE(PASSIGNT , 'NASSTS ' ,ER0, E ,ER0);
+49490 OCODE(PASSIGNT+1 , 'NASSTS2 ' ,ER0,FP0,ER0);
+49500 OCODE(PASSIGNT+2 , 'NASSTPP ' ,ER0, E ,ER0);
+49520 OCODE(PASSIGNT+3 , 'NASSTP ' ,PR1,PR2,FP0);
+49530
+49540 OCODE(PSCOPENN , 'SCPNNP ' ,PR1,PR2,FP0);
+49560 OCODE(PASSIGNN , 'NASSNP ' ,PR1,PR2,FP0);
+49580 ICODE(PSCOPEVAR , 'LAS ' , ACP , 0 ,QSCOPEVAR ,PR1, O , O );
+49584 QCODE(QSCOPEVAR , 'LAS ' , ACX , 0 ,QSCOPEVAR+3);
+49590 ICODE(PSCOPEVAR+1, 'LROA3 ' , ACP ,250,QSCOPEVAR+1 ,PR1, O , O );
+49591 QCODE(QSCOPEVAR+1, 'LROA3 ' , ACX ,250,QSCOPEVAR+3);
+49592 ICODE(PSCOPEVAR+2, 'LROA2 ' , ACP ,192,QSCOPEVAR+2 ,PR1, O , O );
+49594 QCODE(QSCOPEVAR+2, 'LROA2 ' , ACX ,192,QSCOPEVAR+3);
+49596 QCODE(QSCOPEVAR+3, 'IPUSH ' , NON , 0 ,QSCOPEVAR+4);
+49598 QCODE(QSCOPEVAR+4, 'IPUSH ' , NON , 0 ,QSCOPEVAR+5);
+49600 OCODE(QSCOPEVAR+5, 'GVSCOPE ' , O , O , O );
+49610 OCODE(PSCOPEEXT , 'SCOPEXT ' ,PR1, O , E );
+49620 ICODE(PASGVART , ' IS ' , OPX , 0 ,0 ,E , O , O );
+49630 ICODE(PASGVART+1 , ' SRO3 ' , OPX ,250,0 ,E , O , O );
+49640 ICODE(PASGVART+2 , ' SRO2 ' , OPX ,192,0 ,E , O , O );
+49660 ICODE(PASGVART+3 , 'LAS ' , OPX , 0 ,QASGVART ,FP0, O , O );
+49671 QCODE(QASGVART , ' ASSD ' , WOP , 0 ,0 );
+49680 ICODE(PASGVART+4 , 'LROA3 ' , OPX ,250,QASGVART ,FP0, O , O );
+49690 ICODE(PASGVART+5 , 'LROA2 ' , OPX ,192,QASGVART ,FP0, O , O );
+49710 ICODE(PASGVART+6 , 'LAS ' , ACX , 0 ,QASGVART+1 ,PR1, O , O );
+49712 QCODE(QASGVART+1 , 'IPUSH ' , NON , 0 ,QASGVART+2);
+49714 OCODE(QASGVART+2 , 'GVASSTX ' , O , O , O );
+49720 ICODE(PASGVART+7 , 'LROA3 ' , ACX ,250,QASGVART+1 ,PR1, O , O );
+49730 ICODE(PASGVART+8 , 'LROA2 ' , ACX ,192,QASGVART+1 ,PR1, O , O );
+49740 OCODE(PIDTYREL , 'IS ' ,PR1,PR2, E );
+49750 OCODE(PIDTYREL+1 , 'ISNT ' ,PR1,PR2, E );
+49752 ICODE(PGETTOTCMN , 'LR0 ' , NON , 0 ,QGETTOTCMN ,ER0, O ,ER0);
+49753 QCODE(QGETTOTCMN , 'IADD ' , NON , 0 ,0);
+49754 ICODE(PGETTOTCMN+1, 'LRO0 ' , WOP , 2 ,QGETTOTCMN ,ER0, O ,ER0);
+49755 ICODE(PGETTOTCMN+2, 'LRO0 ' , WOP , 4 ,QGETTOTCMN+1 ,ER0, O ,ER0);
+49756 QCODE(QGETTOTCMN+1, 'SR1 ' , NON , 0 ,QGETTOTCMN+2);
+49757 QCODE(QGETTOTCMN+2, 'JFALSE ' , JMP , 1 ,QGETTOTCMN+3);
+49758 QCODE(QGETTOTCMN+3, 'LRO1 ' , WOP , 2 ,QGETTOTCMN);
+49760 ICODE(PGETTOTAL , 'LI ' , NON , 0 ,QGETTOTAL ,ER0, O , E );
+49761
+49762
+49763
+49764 ICODE(PGETTOTAL+1, 'LDI ' , WOP , 0 ,QGETTOTAL ,ER0, O ,FP0);
+49765
+49766
+49767
+49768 QCODE(QGETTOTAL , 'LRO0 ' , WOP , 0 ,QGETTOTAL+1);
+49769
+49770 QCODE(QGETTOTAL+1, 'CI ' , MOR , 0 ,QGETTOTAL+2);
+49771 QCODE(QGETTOTAL+2, '65536 ' , NON , 0 ,QGETTOTAL+3);
+49772 QCODE(QGETTOTAL+3, 'IJGE ' , JMP , 2 ,QGETTOTAL+4);
+49773 OCODE(QGETTOTAL+4, 'SAVGARB ' , O , O , O );
+49774 OCODE(PGETTOTAL+2, 'GTOTP ' ,PR1, O , E );
+49775 OCODE(PGETTOTAL+3, 'GTOTN ' ,PR1, O , E );
+49776 OCODE(PGETTOTAL+4, 'GTOTREF ' ,PR1, O , E );
+49778 OCODE(PGETMULT , 'GETMULT ' ,PR1, O , E );
+49780 OCODE(PGETMULT+1 , 'GETSLN ' ,PR1, O , E );
+49782 OCODE(PDEREF , 'DREFS ' ,PR1, O , E );
+49784 OCODE(PDEREF+1 , 'DREFS2 ' ,PR1, O , E );
+49786 OCODE(PDEREF+2 , 'DREFPTR ' ,PR1, O , E );
+49788 OCODE(PDEREF+3 , 'DREFN ' ,PR1, O , E );
+49790 OCODE(PDEREF+4 , 'DREFM ' ,PR1, O , E );
+49800 OCODE(PSKIP , 'SKIPS ' , O , O , E );
+49810 OCODE(PSKIP+1 , 'SKIPPIL ' , O , O , E );
+49812 OCODE(PSKIP+2 , 'SKIPS2 ' , O , O ,FP0);
+49820 OCODE(PSKIPSTRUCT, 'SKIPSTR ' , O , O , E );
+49830 OCODE(PNIL , 'NILP ' , O , O , E );
+49840 ICODE(PVOIDNORMAL, 'SR0 ' , NON , 0 ,PVOIDNAKED , E , O , O );
+49843 ICODE(PVOIDNAKED , 'LRO0 ' , WOP , 0 ,QGETTOTAL+1 ,ER0, O , O );
+49844
+49845
+49846
+49847
+49848
+49900
+49910 ICODE(PWIDEN , 'FLOAT ' , WOP , 0 ,0 ,E , O ,FP0);
+49940 OCODE(PWIDEN+2 , 'WIDREAL ' ,PR1, O , E );
+49950 OCODE(PWIDEN+4 , 'WIDCHAR ' ,PR1, O , E );
+49960 OCODE(PWIDEN+5 , 'WIDBITS ' ,PR1, O , E );
+49970 OCODE(PWIDEN+6 , 'WIDBYTS ' ,PR1, O , E );
+49980 OCODE(PWIDEN+7 , 'WIDSTR ' ,PR1, O , E );
+49990 OCODE(PROWNONMULT, 'ROWNM ' ,PR1, O , E );
+50000 OCODE(PROWMULT , 'ROWM ' ,PR1, O , E );
+50001 ICODE(PGETPROC , 'SFA ' , NON , 0 ,QGETPROC , O , O , O );
+50002 QCODE(QGETPROC , 'CI ' , ANX , 0 ,QGETPROC+1);
+50003 QCODE(QGETPROC+1 , 'IADD ' , NON , 0 ,QGETPROC+2);
+50004 QCODE(QGETPROC+2 , 'LI ' , NON , 0 ,QGETPROC+3);
+50005 QCODE(QGETPROC+3 , 'IPUSH ' , NON , 0 ,PGETPROC+1);
+50006 OCODE(PGETPROC+1 , 'GETPROC ' ,PR1, O , O );
+50010 ICODE(PCALL , 'CI ' , ACX , 0 ,QCALL ,SNS, O , O );
+50011 QCODE(QCALL , 'IPUSH ' , NON , 0 ,QCALL+1);
+50012 QCODE(QCALL+1 , 'RPUSH ' , WOP , 0 ,QCALL+2);
+50013 QCODE(QCALL+2 , 'SFA ' , NON , 0 ,QCALL+3);
+50014 QCODE(QCALL+3 , 'CI ' , WOP , 2 ,QCALL+4);
+50015 QCODE(QCALL+4 , 'IADD ' , NON , 0 ,QCALL+5);
+50016 QCODE(QCALL+5 , 'LI ' , NON , 0 ,QCALL+6);
+50017 QCODE(QCALL+6 , 'LI ' , NON , 0 ,QCALL+7);
+50018 QCODE(QCALL+7 , 'CALLT ' , NON , 0 ,0);
+50019 ICODE(PCALLA , 'SFA ' , NON , 0 ,QCALLA ,SNS, O , O );
+50020 QCODE(QCALLA , 'LAS ' , ACX , 0 ,QCALLA+3);
+50021 ICODE(PCALLA+1 , 'SFA ' , NON , 0 ,QCALLA+1 ,SNS, O , O );
+50022 QCODE(QCALLA+1 , 'LROA3 ' , ACX ,250,QCALLA+3);
+50023 ICODE(PCALLA+2 , 'SFA ' , NON , 0 ,QCALLA+2 ,SNS, O , O );
+50024 QCODE(QCALLA+2 , 'LROA2 ' , ACX ,192,QCALLA+3);
+50025 QCODE(QCALLA+3 , 'IPUSH ' , NON , 0 ,QCALL+5);
+50026 ICODE(PRNSTART , 'ASFW ' , OPX , 0 ,QRNSTART , O , O , O );
+50028 OCODE(QRNSTART , 'RNSTART ' , O , O , O );
+50029 ICODE(PRETURN , 'RETURN ' , NON , 0 ,0 ,XN , O , O );
+50030 OCODE(PGBSTK , 'GBSTK ' , O , O , O );
+50034 OCODE(POUTJUMP , 'OUTJUMP ' , O , O , O );
+50040 OCODE(PGETOUT , 'GETOUT ' , O , O , O );
+50042 ICODE(PSETIB , 'RPUSH ' , WOP , 0 ,QSETIB , O , O , O );
+50044 OCODE(QSETIB , 'SETIB ' , O , O , O );
+50050 OCODE(PLEAPGEN , 'GENSTR ' , O , O , E );
+50060 OCODE(PLEAPGEN+1 , 'HEAPSTR ' , O , O , E );
+50070 OCODE(PLEAPGEN+2 , 'GENRSTR ' , O , O , E );
+50080 OCODE(PLEAPGEN+3 , 'GENMUL ' ,PR1, O , E );
+50090 OCODE(PLEAPGEN+4 , 'HEAPMUL ' ,PR1, O , E );
+50100 OCODE(PLEAPGEN+5 , 'GENRMUL ' ,PR1, O , E );
+50110 OCODE(PPREPSTRDISP , 'PCOLLST ' , O , O ,FP0);
+50120 OCODE(PPREPROWDISP , 'PCOLLR ' ,STS, O ,FP0);
+50130 OCODE(PPREPROWDISP+1, 'PCOLLRM ' ,STS, O ,FP0);
+50140 OCODE(PCOLLCHECK , 'PCOLLCK ' ,S4P, O ,FP0);
+50150 ICODE(PCOLLTOTAL , 'EXCH ' , NON , 0 ,QCOLLTOTAL ,ER0, E ,ER0);
+50151 QCODE(QCOLLTOTAL , 'SR1 ' , NON , 0 ,QCOLLTOTAL+1);
+50152 QCODE(QCOLLTOTAL+1, 'EXCH ' , NON , 0 ,QCOLLTOTAL+2);
+50153
+50154 QCODE(QCOLLTOTAL+2, 'SRO1 ' , OPX , 0 ,QCOLLTOTAL+3);
+50155 QCODE(QCOLLTOTAL+3, 'JFALSE ' , JMP , 1 ,0);
+50156
+50170 ICODE(PCOLLTOTAL+1, 'SR1 ' , NON , 0 ,QCOLLTOTAL+4 ,ER0,FP0,ER0);
+50171
+50172
+50173 QCODE(QCOLLTOTAL+4, 'LROA1 ' , OPX , 0 ,QCOLLTOTAL+5);
+50174 QCODE(QCOLLTOTAL+5, 'ASSD ' , WOP , 0 ,0);
+50175
+50200 ICODE(PCOLLTOTAL+2, 'DUPL ' , NON , 0 ,QCOLLTOTAL+6 ,ER0, E ,ER0);
+50210 QCODE(QCOLLTOTAL+6, 'CI ' , MOR , 0 ,QCOLLTOTAL+7);
+50220 QCODE(QCOLLTOTAL+7, '65536 ' , NON , 0 ,QCOLLTOTAL+8);
+50222 QCODE(QCOLLTOTAL+8, 'EXCH ' , NON , 0 ,QCOLLTOTAL+9);
+50230 QCODE(QCOLLTOTAL+9, 'OAADD ' , NON , 0 ,QCOLLTOTAL+10);
+50240 QCODE(QCOLLTOTAL+10,'JFALSE ' , JMP , 1 ,PCOLLTOTAL);
+50250 OCODE(PCOLLTOTAL+3,'COLLTP ' ,PR1,PR2,FP0);
+50260 OCODE(PCOLLTOTAL+4,'COLLTM ' ,PR1,PR2,FP0);
+50270 OCODE(PCOLLNAKED , 'COLLNP ' ,PR1,PR2,FP0);
+50280 ICODE(PNAKEDPTR , 'JFALSE ' , JMP , 1 ,QNAKEDPTR ,ER0, O , E );
+50282 QCODE(QNAKEDPTR , 'LR0 ' , NON , 0 ,0);
+50290 ICODE(PLINE , 'CI ' , OPX , 0 ,QLINE , O , O , O );
+50300 QCODE(QLINE , ' IS ' , WNP ,12 ,0);
+50320 OCODE(PENDSLICE , 'ENDSL ' ,PR1, O , E );
+50330 OCODE(PTRIM , 'SLICEA ' , O , O , O );
+50340 OCODE(PTRIM+1 , 'SLICEB ' , O , O , O );
+50350 OCODE(PTRIM+2 , 'SLICEC ' , O , O , O );
+50360 OCODE(PTRIM+3 , 'SLICED ' , O , O , O );
+50370 OCODE(PTRIM+4 , 'SLICEE ' , O , O , O );
+50380 OCODE(PTRIM+5 , 'SLICEF ' , O , O , O );
+50390 OCODE(PTRIM+6 , 'SLICEG ' , O , O , O );
+50400 OCODE(PTRIM+7 , 'SLICEH ' , O , O , O );
+50410 OCODE(PTRIM+8 , 'SLICEI ' , O , O , O );
+50420 OCODE(PTRIM+9 , 'SLICEJ ' , O , O , O );
+50430 ICODE(PJMP , 'JUMP ' , LCX , 0 ,0 , O , O , O );
+50432 ICODE(PENVCHAIN , 'IL ' , WOP , 4 ,QENVCHAIN , O , O , O );
+50434 QCODE(QENVCHAIN , ' SR2 ' , NON , 0 ,0);
+50436 ICODE(PENVCHAIN+1, 'LRO2 ' , WOP ,196,QENVCHAIN , O , O , O );
+50438 ICODE(PDISCARD , 'JFALSE ' , JMP , 1 ,0 , O , O , O );
+50440 ICODE(PDUP1ST , 'SFA ' , NON , 0 ,QDUP1ST ,STP, O , E );
+50441 ICODE(PDUP1ST+1 , 'SFA ' , NON , 0 ,QDUP2ND ,ST4, O ,FP1);
+50442 QCODE(QDUP1ST , 'LI ' , NON , 0 ,0);
+50450 ICODE(PDUP2ND , 'SFA ' , NON , 0 ,QDUP1ST ,STP, E , E );
+50460 ICODE(PDUP2ND+1 , 'SFA ' , NON , 0 ,QDUP2ND ,ST4, E ,FP1);
+50464 ICODE(PDUP2ND+2 , 'SFA ' , NON , 0 ,QDUP1ST ,STP,F0P, E );
+50466 ICODE(PDUP2ND+3 , 'SFA ' , NON , 0 ,QDUP2ND ,ST4,F0P,FP1);
+50468 QCODE(QDUP2ND , 'LDI ' , WOP , 1 ,0);
+50470 ICODE(PDATALIST , 'CI ' , OPX , 0 ,QDATALIST ,SNS, O ,SDL);
+50471 QCODE(QDATALIST , 'IPUSH ' , NON , 0 ,PALIGN);
+50472 ICODE(PASP , 'ASFW ' , OPX , 0 , 0 , O , O , O );
+50474 ICODE(PALIGN , 'ALIGN ' , NON , 0 , 0 , O , O , O );
+50476 ICODE(PHEAVE , 'SFA ' , NON , 0 ,QHEAVE , O , O , O );
+50478 QCODE(QHEAVE , 'SFA ' , NON , 0 ,QHEAVE+1);
+50480 QCODE(QHEAVE+1 , 'CI ' , WOP , 2 ,QHEAVE+2);
+50482 QCODE(QHEAVE+2 , 'ISUB ' , NON , 0 ,QHEAVE+3);
+50484 QCODE(QHEAVE+3 , 'CI ' , OPX , 0 ,QHEAVE+4);
+50486 QCODE(QHEAVE+4 , ' MVW ' , NON , 0 ,QHEAVE+5);
+50487 QCODE(QHEAVE+5 , 'ASFW ' , WNP , 2 ,0);
+50490 ICODE(PHOIST , 'ASFW ' , ONX , 0 ,QHOIST , O , O , O );
+50492 QCODE(QHOIST , 'CI ' , ACX , 0 ,QHOIST+1);
+50493 QCODE(QHOIST+1 , 'IPUSH ' , NON , 0 ,QHOIST+2);
+50494 OCODE(QHOIST+2 , 'HOIST ' , O , O , O );
+50496 ICODE(PPUSH , 'IL ' , OPX , 0 ,QIPUSH , O , O , O );
+50498 QCODE(QIPUSH , 'IPUSH ' , NON , 0 , 0 );
+50510 ICODE(PPUSH+1 , 'LRO3 ' , OPX ,250,QIPUSH , O , O ,ST );
+50512 ICODE(PPUSH+2 , 'LRO2 ' , OPX ,192,QIPUSH , O , O , O );
+50520 ICODE(PPUSHIM , 'CI ' , OPX , 0 ,QIPUSH , O , O ,ST );
+50530 ICODE(PPUSHIM+1 , 'LGA ' , GBX , 0 ,QIPUSH , O , O , O );
+50531 ICODE(PLOADEIM , 'CI ' , OPX , 0 ,0 , O , O , E );
+50532 ICODE(PLOADEIM+1 , 'LGA ' , GBX , 0 ,0 , O , O , O );
+50533 ICODE(PLOADE , 'IL ' , OPX , 0 ,0 , O , O , O );
+50534 ICODE(PLOADE+1 , 'LRO3 ' , OPX ,250,0 , O , O , O );
+50535 ICODE(PLOADE+2 , 'LRO2 ' , OPX ,192,0 , O , O , O );
+50550 ICODE(PPUSHIM2 , 'LGA ' , OPX , 0 ,QPUSHIM2 , O , O , O ); (*SPECIAL FOR*)
+50552 QCODE(QPUSHIM2 , 'IPUSH ' , NON , 0 ,QPUSHIM2+1); (*MDCHAN AND *)
+50554 QCODE(QPUSHIM2+1 , 'IL ' , WNP , 2 ,QIPUSH); (*MDCODE *)
+50560 ICODE(PPUSHIM2+1 , 'LGA ' , GBX , 0 ,QPUSH2 , O , O , O );
+50570 ICODE(PPUSHER0 , 'IPUSH ' , NON , 0 ,QPUSHER0 , O , O , O );
+50572 QCODE(QPUSHER0 , 'LR0 ' , NON , 0 ,QPUSHER0+1);
+50574 QCODE(QPUSHER0+1 , 'IPUSH ' , NON , 0 ,0);
+50580 ICODE(PLOADER0F0 , 'RPUSH ' , WOP , 0 ,PLOADER0STK , O , O , O );
+50582 ICODE(PLOADER0F1 , 'RPUSH ' , WOP , 1 ,PLOADER0STK , O , O , O );
+50590 ICODE(PLOADER0STK, 'SFA ' , NON , 0 ,QLOADER0STK , O , O , O );
+50592 QCODE(QLOADER0STK, ' SR1 ' , NON , 0 ,QLOADER0STK+1);
+50594 QCODE(QLOADER0STK+1,'LRO1 ' , WOP , 0 ,QLOADER0STK+2);
+50596 QCODE(QLOADER0STK+2,' SR0 ' , NON , 0 ,QLOADER0STK+3);
+50598 QCODE(QLOADER0STK+3,'LRO1 ' , WOP , 2 ,QLOADER0STK+4);
+50600 QCODE(QLOADER0STK+4,'ASFW ' , WOP , 4 ,0);
+50640 ICODE(PPUSH2 , 'LAS ' , OPX , 0 ,QPUSH2 , O , O , O );
+50650 QCODE(QPUSH2 , 'LDI ' , WOP , 3 ,QPUSH2+1);
+50652 QCODE(QPUSH2+1 , 'RPUSH ' , WOP , 3 ,0);
+50660 ICODE(PPUSH2+1 , 'LRO3 ' , OPX ,252,QPUSH2+2 , O , O , O );
+50662 QCODE(QPUSH2+2 , 'IPUSH ' , NON , 0 ,PPUSH+1);
+50670 ICODE(PPUSH2+2 , 'LRO2 ' , OPX ,194,QPUSH2+3 , O , O , O );
+50672 QCODE(QPUSH2+3 , 'IPUSH ' , NON , 0 ,PPUSH+2);
+50690 ICODE(PDECM , 'CI ' , OPX , 0 ,0 , O , O , O );
+50694 QCODE(PDECM+1 , ' IS ' , ONX , 0 ,0);
+50696 ICODE(PETOSTK , 'IPUSH ' , NON , 0 ,0 , O , O , O );
+50700 ICODE(PETOSTK+1 , 'ASFW ' , WNP , 4 ,QETOSTK , O , O , O );
+50701 QCODE(QETOSTK , 'SFA ' , NON , 0 ,QETOSTK+1);
+50702 QCODE(QETOSTK+1 , 'SR1 ' , NON , 0 ,QETOSTK+2);
+50703 QCODE(QETOSTK+2 , 'JFALSE ' , JMP , 1 ,QETOSTK+3);
+50704 QCODE(QETOSTK+3 , 'SRO1 ' , WOP , 0 ,QETOSTK+4);
+50705 QCODE(QETOSTK+4 , 'JFALSE ' , JMP , 1 ,QETOSTK+5);
+50706 QCODE(QETOSTK+5 , 'SRO1 ' , WOP , 2 ,0);
+50714 OCODE(PETOSTK+2 , 'ETOSTK ' , O , O , O );
+50715 ICODE(PSTKTOE , 'SFA ' , NON , 0 ,QLOADI , O , O , O );
+50716 QCODE(QLOADI , 'LI ' , NON , 0 ,QADJSP2 );
+50717 QCODE(QADJSP2 , 'ASFW ' , WOP , 2 ,0 );
+50718 ICODE(PSTKTOE+1 , 'SFA ' , NON , 0 ,QSTKTOE , O , O , O );
+50719 QCODE(QSTKTOE , ' SR1 ' , NON , 0 ,QSTKTOE+1 );
+50720 QCODE(QSTKTOE+1 , 'LRO1 ' , WOP , 2 ,QSTKTOE+2 );
+50721 QCODE(QSTKTOE+2 , 'LRO1 ' , WOP , 0 ,QADJSP4 );
+50722 QCODE(QADJSP4 , 'ASFW ' , WOP , 4 ,0 );
+50723 OCODE(PSTKTOE+2 , 'STKTOE ' , O , O , O );
+50724 ICODE(PSWAP , 'EXCH ' , NON , 0 ,0 , O , O , O );
+50725 ICODE(PPUSHFSTK , 'RPUSH ' , WOP , 0 ,0 , O , O , O );
+50726 ICODE(PPUSHFSTK1 , 'RPUSH ' , WOP , 1 ,0 , O , O , O );
+50727 ICODE(PLOADF , 'LAS ' , OPX , 0 ,QLOADF , O , O , O );
+50728 QCODE(QLOADF , 'LDI ' , WOP , 0 ,0);
+50732 ICODE(PLOADFIM , 'LGA ' , GBX , 0 ,QLOADF , O , O , O );
+50734 ICODE(PLOADF1 , 'LAS ' , OPX , 0 ,QLOADF1 , O , O , E );
+50735 QCODE(QLOADF1 , 'LDI ' , WOP , 1 ,0 );
+50739 ICODE(PLOADFIM1 , 'LGA ' , GBX , 0 ,QLOADF1 , O , O ,FP1);
+50742 ICODE(PLOADFSTK , 'RPOP ' , WOP , 0 ,0 , O , O , O );
+50743 ICODE(PLOADFSTK1 , 'RPOP ' , WOP , 1 ,0 , O , O , O );
+50744 ICODE(PF0TOF1 , 'RPUSH ' , WOP , 0 ,PLOADFSTK1 , O , O ,FP1);
+50745 ICODE(PF1TOF0 , 'RPUSH ' , WOP , 1 ,PLOADFSTK , O , O ,FP0);
+50750 END;
+50755 PROCEDURE INITPOPARRAY;
+50757 VAR I,J:SBTTYP;
+50760 BEGIN
+50761 FOR I := SBTSTK TO SBTFPR3 DO
+50770 FOR J := SBTVOID TO SBTFPR3 DO
+50780 BEGIN
+50790 POPARRAY [I,J] := PNONE;
+50800 POPARRAY [I,I] := PNOOP;
+50810 POPARRAY [I,SBTVOID] :=PNOOP;
+50820 POPARRAY [I,SBTVAR ] := PLOADVAR;
+50822 POPARRAY [I,SBTPROC] := PLOADRTA;
+50824 POPARRAY [I,SBTRPROC]:= PLOADRTA;
+50830 END;
+50910 POPARRAY[ SBTSTK , SBTSTK4 ] := PVARLISTEND+1;
+50920 POPARRAY[ SBTSTK , SBTID ] := PPUSH;
+50930 POPARRAY[ SBTSTK , SBTIDV ] := PPUSH;
+50940 POPARRAY[ SBTSTK , SBTLIT ] := PPUSHIM;
+50950 POPARRAY[ SBTSTK , SBTDEN ] := PPUSHIM;
+50951 POPARRAY[ SBTE , SBTID ] := PLOADE;
+50952 POPARRAY[ SBTE , SBTIDV ] := PLOADE;
+50954 POPARRAY[ SBTE , SBTVAR ] := PLOADVAR;
+50956 POPARRAY[ SBTE , SBTLIT ] := PLOADEIM;
+50958 POPARRAY[ SBTE , SBTDEN ] := PLOADEIM;
+50960 POPARRAY[ SBTSTK , SBTDL ] := PNOOP;
+50970 POPARRAY[ SBTSTK4 , SBTID ] := PPUSH2;
+50980 POPARRAY[ SBTSTK4 , SBTIDV ] := PPUSH2;
+51000 POPARRAY[ SBTSTK4 , SBTDEN ] := PPUSHIM2;
+51030 POPARRAY[ SBTSTK , SBTPR1 ] := PNOOP;
+51040 POPARRAY[ SBTSTK , SBTPR2 ] := PNOOP;
+51050 POPARRAY[ SBTSTK4 , SBTPR1 ] := PNOOP;
+51060 POPARRAY[ SBTSTK4 , SBTPR2 ] := PNOOP;
+51070 POPARRAY[ SBTSTK4 , SBTSTK ] := PSTOS4;
+51071 POPARRAY[ SBTSTK , SBTE ] := PETOSTK;
+51072 POPARRAY[ SBTE , SBTSTK ] := PSTKTOE;
+51073 POPARRAY[ SBTSTK4 , SBTFPR0 ] := PPUSHFSTK;
+51074 POPARRAY[ SBTSTK4 , SBTFPR1 ] := PPUSHFSTK1;
+51075 POPARRAY[ SBTFPR0 , SBTID ] := PLOADF;
+51076 POPARRAY[ SBTFPR0 , SBTIDV ] := PLOADF;
+51077 POPARRAY[ SBTFPR0 , SBTLIT ] := PLOADFIM;
+51078 POPARRAY[ SBTFPR0 , SBTDEN ] := PLOADFIM-1;
+51079 POPARRAY[ SBTFPR1 , SBTID ] := PLOADF1;
+51080 POPARRAY[ SBTFPR1 , SBTIDV ] := PLOADF1;
+51082 POPARRAY[ SBTFPR1 , SBTLIT ] := PLOADFIM1;
+51083 POPARRAY[ SBTFPR1 , SBTDEN ] := PLOADFIM1-1;
+51084 POPARRAY[ SBTFPR0 , SBTSTK4 ] := PLOADFSTK;
+51085 POPARRAY[ SBTFPR1 , SBTSTK4 ] := PLOADFSTK1;
+51086 POPARRAY[ SBTFPR1 , SBTFPR0 ] := PF0TOF1;
+51087 POPARRAY[ SBTFPR0 , SBTFPR1 ] := PF1TOF0;
+51090 POPARRAY[ SBTSTK4 , SBTER0 ] := PPUSHER0;
+51092 POPARRAY[ SBTSTK4 , SBTSTKR0] := PPUSHER0; (*ACTUALLY, LOAD PUTS IT INTO SBTER0 FIRST*)
+51094 POPARRAY[ SBTER0 , SBTSTKR0] := PNOOP; (*ACTUALLY, LOAD PUTS IT INTO SBTER0 FIRST*)
+51100 POPARRAY[ SBTER0 , SBTSTK4 ] := PLOADER0STK;
+51110 POPARRAY[ SBTER0 , SBTFPR0 ] := PLOADER0F0;
+51120 POPARRAY[ SBTER0 , SBTFPR1 ] := PLOADER0F1;
+51130 END;
+51140 PROCEDURE INITLENARRAY;
+51150 VAR I:SBTTYP;
+51160 BEGIN
+51170 FOR I := SBTSTK TO SBTXN DO LENARRAY[I] := 0;
+51180 LENARRAY[SBTSTK ] := SZWORD;
+51184 LENARRAY[SBTSTK4] := 2*SZWORD;
+51186 LENARRAY[SBTSTKR0]:= SZWORD; (*FOR NAKES VALUES*)
+51190 LENARRAY[SBTE ] := SZWORD;
+51191 LENARRAY[SBTER0 ] := 2*SZWORD; (*FOR NAKED VALUES*)
+51192 LENARRAY[SBTFPR0] := 2*SZWORD;
+51193 LENARRAY[SBTFPR1] := 2*SZWORD;
+51194 LENARRAY[SBTFPR2] := 2*SZWORD;
+51195 LENARRAY[SBTFPR3] := 2*SZWORD;
+51210 END;
+51220 BEGIN (* INITCODES +)
+51230 FIRSTPART; SECONDPART; THIRDPART; INITPOPARRAY; INITLENARRAY;
+51240 END;
+51250 (*+)
+51260 ()+86+)
+51270 ()+05*)
+59771
+59772
+59773
+60280 (**)
+60290 (**)
+60300 (**)
+60310 (**)
+60320 (**)
+60340 BEGIN
+60360 (*+25() LINELIMIT(OUTPUT,10000); LINELIMIT(LSTFILE,10000); ()+25*)
+60375 DUMP(FIRSTSTACK,LASTSTACK);
+60380 END (*+25() (*$G-+) ()+25*).
+####S
--- /dev/null
+00100 .PR NOLIST .PR
+00110 .PR POINT .PR
+00120 # COPYRIGHT 1982 C.H.LINDSEY, UNIVERSITY OF MANCHESTER #
+00140 .COMMENT
+00160 ##
+00180 FLOYD PRODUCTIONS FOR ALGOL68S.
+00200 ##
+00220 ##
+00240 PRODUCTION SYNTAX.
+00260 ##
+00280 LABEL: STACK!INPUT => X-ROUTN ,N->NOTION ! (M) SCAN SUCCESS,FAIL;
+00300 ##
+00320 LABEL: - PRODUCTION LABEL (DEFAULT: NONE)
+00340 STACK - STACK CONFIQUATION TO LOOK FOR (ANY)
+00360 INPUT - INPUT LEXEME TO LOOK FOR (ANY)
+00380 X- - TYPE OF ROUTN
+00400 ROUTN - SEMANTIC ROUTINE TO CALL (NONE)
+00420 N-> - NUMBER OF LEXEMES TO POP FROM THE STACK (0)
+00440 NOTION - LEXEME TO PUSH ON THE STACK (NONE)
+00460 (M) - NUMBER OF INPUT LEXEMES TO SKIP (0)
+00480 SCAN - NUMBER OF INPUT LEXEMES TO PUSH ON STACK (NONE)
+00500 SUCCESS - SUCCESS LABEL
+00520 ,FAIL - FAILURE LABEL (FOLLOWING PRODUCTION)
+00540 ##
+00560 PRODUCTION SEMANTICS.
+00580 ##
+00600 IF STACK AND INPUT MATCH THE CURRENT STACK AND INPUT STATES THEN
+00620 THE ACTIONS SPECIFIED TO THE RIGHT OF THE "=>" ARE OBEYED;
+00640 OTHERWISE CONTROL PASSES TO THE PRODUCTION SPECIFIED BY FAIL.
+00660 ##
+00680 THE RIGHT SIDE IS INTERPRETED AS FOLLOWS.
+00700 IF THE X OF X-ROUTN IS AN 'S' THEN ROUTN SPECIFIES THE SEMANTIC ROUTINE
+00720 TO BE CALLED (ONLY IF NO SYNTACTIC ERRORS HAVE OCCURRED).
+00740 IF X IS AN 'A' THEN AN ACTION ROUTINE IS INDICATED.
+00760 AN 'E' INDICATES AN ERROR MESSAGE TO BE OUTPUT.
+00780 ACTION ROUTINES ARE INVOKED REGARDLESS OF
+00800 PREVIOUS ERRORS AND HELP MAKE PARSING DECISIONS BY RETURNING A
+00820 BOOLEAN VALUE. IF THE VALUE IS FALSE, THE PRODUCTION FAILS AND
+00840 THE FAIL EXIT IS TAKEN IMMEDIATELY.
+00860 ##
+00880 NEXT, N LEXEMES ARE POPPED FROM THE STACK. IF NOTION IS NOT
+00900 BLANK THEN A LEXEME FOR THE NOTION IS PUSHED ON THE STACK. (NOTE
+00920 THAT IF NOTION IS NON-BLANK, N-> MUST BE NON-BLANK ALSO.) M INPUT
+00940 LEXEMES ARE THEN SKIPPED. THE FIRST ONE SKIPPED IS THE CURRENT
+00960 INPUT LEXEME. THE NUMBER OF PLUSSES IN SCAN INDICATES THE
+00980 NUMBER OF INPUT LEXEMES TO BE PUSHED ON THE STACK. WHEN AN INPUT
+01000 LEXEME IS DISCARDED OR PUSHED, A NEW LEXEME IS READ IN TO REPLACE
+01020 IT. FINALLY, CONTROL IS TRANSFERED TO THE PRODUCTION INDICATED
+01040 BY SUCCESS.
+01060 ##
+01080 CONVENTIONS USED IN CONSTRUCTION OF PRODUCTION LABELS.
+01100 ##
+01120 NOTIONH - HEAD SECTION FOR NOTION
+01140 NOTIONT - TAIL SECTION FOR NOTION
+01160 NOTIONHN - MULTIPLE HEAD SECTIONS FOR NOTION
+01180 NOTIONTN - MULTIPLE TAIL SECTIONS FOR NOTION
+01200 LN - LOCAL LABEL USED ONLY AS DESTINATION OF PRECEDING PRODUCTION
+01220 (NECESSARY ONLY BECAUSE EVERY PRODUCTION MUST SPECIFY A SUCCESS LABEL)
+01240 TMN - TERMINAL SECTION
+01260 CMX - COMBINED SECTION
+01280 OTHERS - OTHER SELF-EXPLANATORY(?) LABELS
+01300 ##
+01320 SYLLABLES USED IN NOTION ABBREVIATIONS.
+01340 ##
+01360 PREFIX POSTFIX
+01380 ACT - ACTUAL CL - CLAUSE
+01400 BR - BRIEF DR - DECLARER
+01420 FOR - FORMAL L - LIST
+01440 PL - PARAMETER LIST
+01460 SOME OTHERS PT - PART
+01480 RL - ROWER LIST SR - SERIES
+01500 DEF - DEFINITION SQ - SEQUENCE
+01520 ##
+01540 SYMBOL CLASSES.
+01560 ##
+01580 CL00 # ALL THE THINGS THAT CAN START A UNIT OR A DECLARATION #
+01600 BEGIN@, BOOLDEN@, BY@, CASE@, DO@, EQUAL@, FOR@, FROM@,
+01620 GO@, GOTO@, HEAP@, IF@, LOC@, LONG@, MDIND@, MODE@, NIL@,
+01640 OP@, OPEN@, OPR@, OTHDR@, PRDEN@, PRDR@, PRIO@, PROC@, REF@, SHORT@,
+01660 SKIP@, START@, STRGDEN@, STRUCT@, SUB@, TAB@, TAG@, TO@, VOID@, WHILE@
+01680 ##
+01700 CL01 # ALL THE THINGS THAT CANNOT START A UNIT OR DECLARATION #
+01720 AGAIN@, AT@, BUS@, CLOSE@, COLON@, COMMA@, ELIF@, ELSE@, END@, ESAC@, EXIT@,
+01740 FI@, IDTY@, IN@, OD@, OUSE@, OUT@, SEMIC@, STICK@, STOP@, THEN@
+01760 ##
+01780 CL11 AT@, BUS@, CLOSE@, COMMA@
+01800 CL12 LONG@, MDIND@, OTHDR@, PRDR@,
+01820 PROC@, REF@, SHORT@, STRUCT@,
+01840 SUB@
+01860 CL13 UNITSR@, AGAIN@, BEGIN@, CASE@,
+01880 DO@, ELIF@, ELSE@, IF@, IN@,
+01900 OPEN@, OUSE@, OUT@, STICK@, CSTICK@,
+01920 THEN@, WHILE@
+01940 CL14 EQUAL@, OPR@, TAB@
+01960 ##
+01980 CL21 FOR@, BY@, FROM@, TO@, WHILE@, DO@
+02000 CL22 BEGIN@, CASE@, IF@, BRTHPT@, BRINPT@
+02020 CL23 OUSE@, OUT@
+02040 CL24 ELIF@, ELSE@
+02060 CL25 AT@, COLON@
+02080 CL26 OPEN@, SUB@
+02100 CL27 FLDSPL@, STRUCT@
+02120 CL28 OTHDR@, PRDR@
+02140 CL29 CSTICK@, AGAIN@, STICK@
+02160 CL2A BOOLDEN@, PRDEN@, STRGDEN@
+02180 CL2B MDIND@, TAB@
+02200 CL2C OP@, PROC@
+02220 CL2D COMMA@, SEMIC@
+02240 CL2E HEAP@ LOC@
+02260 CL2F CLOSE@, END@, ESAC@, F1@, OD@.
+02280 ##
+02300 .COMMENT
+02320 ##
+02340 #INITIAL STACK CONFIGURATION STOP@,STOP@!START@#
+02360 ##
+02380 INIT: ! => S-120 , ! ++ PROGH;
+02400 PROGH: TAG@!COLON@ => S-74 ,1-> ! (1) + PROGH,ENCLCLH;
+02420 ##
+02440 SERCLH: TAG@!COLON@ => S-74 , ! (1) LABT;
+02460 TAG@! => , ! SECDH;
+02480 CL2A! => S-65 ,1->PRIM ! PRIMT;
+02500 PROC@!TAG@ => S-31 , ! + CM3;
+02520 SUB@!CL00 => S-24 ,0->ACTRL ! + UNITH;
+02540 LOC@! => , ! + CM1;
+02560 OP@! => , ! + CM2;
+02580 PRIO@! => , ! + PDEFH;
+02600 MODE@! => S-32 , ! + MDEFH,UNITH1;
+02620 ##
+02640 UNITH: TAG@! => , ! SECDH;
+02660 CL2A! => S-65 ,1->PRIM ! PRIMT;
+02680 UNITH1: SKIP@! => S-67 , ! UNITT;
+02700 GOTO@! => S-67 , ! + TM2;
+02720 GO@!TO@ => S-67 , ! (1) + TM2;
+02740 GO@! => , ! ERROR01;
+02760 OPEN@!CL12 => A-2+ , ! RTEXTH;
+02770 OPEN@!OPEN@ => A-2+ , ! RTEXTH;
+02780 ##
+02800 TERTH: NIL@! => S-67 ,1->TERT ! TERTT;
+02820 ##
+02840 OPRANDH: CL14! => , ! + OPRANDH;
+02860 ##
+02880 SECDH: TAG@!OF@ => , ! ++ SECDH;
+02900 TAG@! => S-64 ,1->PRIM ! PRIMT;
+02920 CL2A! => S-65 ,1->PRIM ! PRIMT;
+02940 CL2E! => , ! + ACTDRH1;
+02960 VOID@! => S-10 ,1->MOIDDR ! MOIDDRT;
+02980 SUB@! => S-12 ,0->FORRLB ! FORRLT;
+03000 CL28! => S-10 , ! NONRDRT;
+03020 LONG@! => S-12 , ! LONGST2;
+03040 SHORT@! => S-13 , ! SHORTST2;
+03060 REF@! => , ! + FORDRH;
+03080 STRUCT@! => , ! + TM3;
+03100 CL2B! => , ! MDINDDRT;
+03120 PROC@! => , ! + PROCPH;
+03140 ##
+03160 ENCLCLH: FOR@! => , ! TM1;
+03180 WHILE@! => S-55 , ! + SERCLH;
+03200 DO@! => S-59 , ! + SERCLH;
+03220 CL21! => S-48 , ! FROMPTH;
+03222 OPEN@!CL01 => , ! FORDRH;
+03240 CL22! => S-34 , ! + SERCLH;
+03250 OPEN@! => S-34 , ! + SERCLH;
+03260 CL00! => E-33 , ! UNITH,ERROR01;
+03280 ##
+03300 PROCPH: ! => S-22 , ! L1;
+03320 L1: OPEN@! => , ! + FORDRH;
+03340 ##
+03360 MOIDDRH: VOID@! => S-10 ,1->MOIDDR ! MOIDDRT;
+03380 ##
+03400 FORDRH: CL26! => S-12 ,0->FORRLB ! FORRLT;
+03420 ##
+03440 NONRDRH: CL26!CL00 => E-35 , ! + UNITH;
+03460 CL26! => E-35 ,0->FORRLB ! FORRLT;
+03480 CL28! => S-10 , ! NONRDRT;
+03500 LONG@! => S-12 , ! LONGST1;
+03520 SHORT@! => S-13 , ! SHORTST1;
+03540 REF@! => , ! + FORDRH;
+03560 STRUCT@! => , ! + TM3;
+03580 CL2B! => , ! MDINDDRT;
+03600 PROC@! => , ! + PROCPH,ERROR02;
+03620 #ACTUAL-DECLARER IN GENERATOR#
+03640 ACTDRH1: CL26!CL00 => S-40 ,0->ACTRL ! + UNITH,ACTDRH3;
+03660 #ACTUAL-DECLARER IN MODE-DEFINITION#
+03680 ACTDRH2: VOID@! => S-10 ,1->MOIDDR ! MOIDDRT;
+03700 CL26!CL00 => S-69 ,0->ACTRL ! + UNITH;
+03720 ACTDRH3: CL26! => E-39 ,0->ACTRL ! FORRLT,NONRDRH;
+03740 ##
+03760 DCLH: PROC@!TAG@ => S-31 , ! + CM3;
+03780 SUB@!CL00 => S-24 , ! + UNITH;
+03800 LOC@! => , ! + CM1;
+03820 OP@! => , ! + CM2;
+03840 PRIO@! => , ! + PDEFH;
+03860 MODE@! => S-32 , ! + MDEFH,FORDRH;
+03880 ##
+03882 TRMSCH: CL26! => ,0->TRMSCL ! SECTL;
+03884 SECTL: !CL00 => , ! + UNITH;
+03886 !CL25 => , ! + SECTM,TRMSCLT;
+03893 ##
+03900 SECTM: COLON@!AT@ => ,1->BOUNDS ! ++ UNITH;
+03920 COLON@!CL11 => S-91 , ! TRMSCT;
+03940 ! => , ! + UNITH;
+04120 ##
+04130 #ACTUAL-DECLARER IN VARIABLE-DECLARATION WITH .LOC#
+04140 CM1: PROC@!TAG@ => S-31 ,1-> ! + RVDEFH;
+04160 CL26!CL00 => S-24 ,0->ACTRL ! + UNITH,ACTDRH3;
+04180 ##
+04200 FROMPTH: FROM@! => , ! + UNITH;
+04220 ! => S-50 , ! BYPTH;
+04240 BYPTH: BY@! => , ! + UNITH;
+04260 ! => S-53 , ! TOPTH;
+04280 TOPTH: TO@! => , ! + UNITH;
+04300 ! => S-52 , ! WHILEPTH;
+04320 WHILEPTH: WHILE@! => S-54 , ! + SERCLH;
+04340 DO@! => S-58 , ! + SERCLH,ERROR04;
+04360 ##
+04380 RTEXTH: OPEN@! => S-99 ,0->FORDCL ! + FORDRH,MOIDDRH;
+04400 ##
+04420 FLDSELLH: TAG@! => S-18 , ! FLDSELLT,ERROR05;
+04440 ##
+04460 FORPLH: TAG@! => S-20 , ! FORPLT,ERROR18;
+04480 ##
+04500 ACTPLH: ! => ,0->ACTPL ! + UNITH;
+04520 ##
+04540 BRALTH: ! => A-5+ , ! BRTHENPTH;
+04560 ##
+04580 BRINPTH: ! => S-38 ,1->CSTICK ! + UNITH;
+04600 ##
+04620 BRTHENPTH: ! => S-37 , ! + SERCLH;
+04640 ##
+04660 LABH: TAG@!COLON@ => S-74 , ! (1) LABT,ERROR09;
+04680 ##
+04700 IDEFH2: ! => S-29 , ! IDEFH1;
+04720 IDEFH1: !EQUAL@ => S-108 ,1->IDEFL ! (1) + UNITH,ERROR10;
+04740 ##
+04760 VDEFH2: ! => S-30 , ! VDEFH1;
+04780 VDEFH1: !BECOM@ => S-108 ,1->VDEFL ! (1) + UNITH;
+04800 !CL2D => S-107 , ! VDEFT,ERROR11;
+04820 ##
+04840 ODEFH2: ! => S-29 , ! ODEFH1;
+04860 ODEFH1: CL14!EQUAL@ => S-109 ,1->ODEFL ! (1) + UNITH,ERROR38;
+04880 ##
+04900 CM2: CL14! => S-31 , ! RODEFH,PROCPH;
+04920 RODEFH: !EQUAL@ => S-104 ,1->RODEFL ! (1) + RTEXTH,ERROR38;
+04940 ##
+04960 PDEFH: CL14!EQUAL@ => , ! (1) + TM4,ERROR40;
+04980 ##
+05000 MDEFH: CL2B!EQUAL@ => S-68 , ! (1) + ACTDRH2,ERROR12;
+05020 ##
+05040 CM3: !BECOM@ => S-33 , ! RVDEFH;
+05060 RIDEFH: !EQUAL@ => S-102 ,1->RIDEFL ! (1) + RTEXTH,ERROR41;
+05080 ##
+05100 RVDEFH: !BECOM@ => S-103 ,1->RVDEFL ! (1) + RTEXTH,ERROR11;
+05120 #TERMINAL SECTIONS#
+05140 TM1: !TAG@ => S-47 , ! (1) + FROMPTH,ERROR36;
+05160 ##
+05180 TM2: TAG@! => S-63 ,1-> ! UNITT,ERROR13;
+05200 ##
+05220 TM3: OPEN@! => S-22 ,1-> ! + NONRDRH,ERROR14;
+05240 ##
+05260 TM4: PRIMDEN@! => S-117 ,1-> ! PDEFT,ERROR43;
+05280 #TAIL SECTIONS#
+05300 SHORTST1: !SHORT@ => S-15 , ! (1) SHORTST1,LSCM1;
+05320 LONGST1: !LONG@ => S-14 , ! (1) LONGST1,LSCM1;
+05340 ##
+05360 SHORTST2: !SHORT@ => S-15 , ! (1) SHORTST2,LSCM2;
+05380 LONGST2: !LONG@ => S-14 , ! (1) LONGST2;
+05400 LSCM2: !PRIMDEN@ => S-66 ,1->PRIM ! (1) PRIMT;
+05420 LSCM1: !PRIMDR@ => S-11 , ! (1) NONRDRT,ERROR16;
+05440 ##
+05460 FORRLT: !COLON@ => , ! (1) FORROWT;
+05480 FORROWT: !COMMA@ => S-14 , ! (1) FORRLT;
+05500 SUB@,ANY!BUS@ => , ! (1) + NONRDRH;
+05510 OPEN@,ANY!CLOSE@ => , ! (1) + NONRDRH;
+05520 !CL00 => E-17 ,1->FORRLB ! + UNITH,MISMATCH;
+05540 ##
+05560 FLDSELLT: !COMMA@ => , ! (1) CM4;
+05580 !CLOSE@ => ,1-> ! FLDSPT,ERROR05;
+05600 ##
+05620 CM4: !TAG@ => S-19 , ! (1) FLDSELLT;
+05640 !CL12 => ,1-> ! FLDSPT;
+05650 !OPEN@ => ,1-> ! FLDSPT,ERROR05;
+05660 ##
+05680 FLDSPT: FLDSPL,ANY! => ,1-> ! FLDSPLT;
+05700 ! => ,1->FLDSPL ! FLDSPLT;
+05720 ##
+05740 FLDSPLT: STRUCT@,ANY!CLOSE@ => S-23 ,1-> ! (1) NONRDRT;
+05760 ! => , ! + NONRDRH;
+05780 ##
+05800 FORPLT: !COMMA@ => , ! (1) CM5;
+05820 !CLOSE@ => ,1-> ! FORDCT,ERROR18;
+05840 ##
+05860 CM5: !TAG@ => S-21 , ! (1) FORPLT;
+05880 !CL12 => ,1-> ! FORDCT;
+05890 !OPEN@ => ,1-> ! FORDCT,ERROR18;
+05900 ##
+05920 FORDCT: FORDCL,ANY! => ,1-> ! FORDCLT;
+05940 ! => ,1->FORDCL ! FORDCLT;
+05960 ##
+05980 FORDCLT: OPEN@,ANY!CLOSE@ => , ! ++ MOIDDRH;
+06000 ! => , ! + FORDRH;
+06020 ##
+06040 PRMDRLT: !COMMA@ => , ! (1) + FORDRH;
+06060 !CLOSE@ => , ! ++ MOIDDRH,ERROR19;
+06080 ##
+06100 MOIDDRT: CL2C,ANY! => , ! PROCPT;
+06120 MODE@,CL2B,ANY! => S-73 ,1-> ! MDEFT;
+06140 PRMDRL,ANY,ANY! => ,3-> ! PROCPT;
+06160 FORDCL,ANY,ANY! => ,4->RSPEC ! RSPECT1,CM7;
+06180 ##
+06200 NONRDRT: CL2E,ANY! => , ! ACTDRT;
+06220 CL27,ANY! => , ! + FLDSELLH;
+06240 REF@,ANY! => S-16 ,1-> ! NONRDRT;
+06260 ACTRL,ANY! => S-27 ,2-> ! NONRDRT;
+06280 CL26! => , ! ACTDRT;
+06300 FORRLB,ANY! => S-25 ,2-> ! FORDRT;
+06320 MODE@,CL2B,ANY! => S-73 ,1-> ! MDEFT;
+06340 CL2C,ANY! => , ! PROCPT;
+06360 CLOSE@,ANY! => ,1->MOIDDR ! MOIDDRT;
+06380 FORDCL,ANY! => , ! + FORPLH;
+06400 CL13,ANY!TAG@ => , ! + CM6,FORDRT;
+06420 ##
+06440 CM6: !EQUAL@ => , ! IDEFH2,CM8A;
+06460 ##
+06480 FORDRT: REF@,ANY! => S-16 ,1-> ! NONRDRT;
+06500 PRMDRL,ANY! => ,1-> ! PRMDRLT;
+06520 FORDCL,ANY! => , ! + FORPLH;
+06540 CL2C,ANY! => , ! PROCPT;
+06560 PRMDRL,ANY,ANY! => ,3-> ! PROCPT;
+06580 FORDCL,ANY,ANY! => ,4->RSPEC ! RSPECT1;
+06600 CL2C,OPEN@,ANY! => ,1->PRMDRL ! PRMDRLT;
+06620 CL13,ANY!TAG@ => , ! + IDEFH2;
+06640 ##
+06660 CM7: !TAG@ => , ! ERROR31,CM7A;
+06680 ##
+06700 CM7A: !COLON@ => S-17 ,1->RSPEC ! (1) RSPECT2;
+06720 ! => S-116 ,1->MOIDDR ! + ENCLCLH; #CAST#
+06740 ##
+06760 MDINDDRT: ! => A-3+ , ! NONRDRT;
+06780 ! => A-4+ ,1->MOIDDR ! MOIDDRT;
+06800 FORRLB,ANY! => E-35 , ! NONRDRT;
+06820 ACTRL,ANY! => E-35 , ! NONRDRT;
+06840 CL27,ANY! => E-35 , ! NONRDRT;
+06860 REF@,ANY! => S-16 ,1-> ! NONRDRT;
+06880 PRMDRL,ANY! => ,1-> ! PRMDRLT;
+06900 FORDCL,ANY! => , ! + FORPLH;
+06920 CL2C,ANY! => , ! PROCPT;
+06940 LOC@,ANY!TAG@ => S-71 ,1-> ! VDEFH3;
+06960 CL2E,ANY! => S-70 , ! ACTDRT;
+06980 MODE@,CL2B,ANY! => S-72 ,1-> ! MDEFT;
+07000 PRMDRL,ANY,ANY! => ,3-> ! PROCPT;
+07020 FORDCL,ANY,ANY! => ,4->RSPEC ! RSPECT1;
+07040 CL2C,ANY,ANY! => ,1->PRMDRL ! PRMDRLT;
+07060 CL13,ANY!TAG@ => , ! + CM8,CM7;
+07080 ##
+07100 CM8: !EQUAL@ => , ! IDEFH2;
+07120 ! => S-71 , ! CM8A;
+07140 CM8A: ! => S-33 , ! VDEFH2;
+07160 ##
+07180 ACTDRT: LOC@,ANY!TAG@ => ,1-> ! VDEFH3;
+07200 CL2E,ANY! => S-98 ,1-> ! SECDT;
+07220 MODE@,CL2B,ANY! => S-73 ,1-> ! MDEFT;
+07240 CL13,ANY!TAG@ => S-33 , ! VDEFH3;
+07260 ##
+07280 VDEFH3: CL13,ANY!TAG@ => , ! + VDEFH2,ERROR31;
+07300 ##
+07320 RSPECT1: !COLON@ => S-28 , ! (1) RSPECT2,ERROR23;
+07340 RSPECT2: RIDEFL,ANY! => S-105 , ! + UNITH;
+07360 RVDEFL,ANY! => S-105 , ! + UNITH;
+07380 RODEFL,ANY! => S-106 , ! + UNITH;
+07400 ! => S-100 , ! + UNITH;
+07420 ##
+07440 RTEXTT: RIDEFL,ANY! => S-111 ,1-> ! RIDEFT;
+07460 RVDEFL,ANY! => S-111 ,1-> ! RVDEFT;
+07480 RODEFL,ANY! => S-111 ,1-> ! RODEFT;
+07500 ! => , ! UNITT;
+07520 ##
+07540 PROCPT: PROC@,ANY! => S-28 ,2->NONRDR ! NONRDRT;
+07560 OP@,ANY! => S-28 ,1-> ! + ODEFH2,ERROR15;
+07580 ##
+07600 PRIMT: !SUB@ => S-85 , ! + TRMSCH;
+07620 !OPEN@ => A-9+ , ! + ACTPLH;
+07630 !OPEN@ => S-85 , ! + TRMSCH;
+07640 ##
+07660 SECDT: OF@,ANY! => S-75 ,2-> ! SECDT;
+07680 CL14,ANY! => ,1->OPRAND ! MONOPDT;
+07700 !CL14 => S-77 ,1->OPRAND ! CM9A,TERTT;
+07720 ##
+07740 MONOPDT: OPRAND,ANY,ANY! => , ! DYOPDT;
+07760 OP@,ANY,ANY! => , ! DYOPDT;
+07780 CL14,ANY! => S-78 ,2->OPRAND ! MONOPDT;
+07800 ##
+07820 DYOPDT: !CL14 => S-77 , ! CM9;
+07840 OPRAND,CL14,ANY! => S-79 ,2-> ! DYOPDT,TERTT;
+07860 ##
+07880 CM9: OPRAND,CL14,ANY! => A-1+ ,2-> ! DYOPDT;
+07900 CM9A: ! => S-80 , ! ++ UNITH;
+07920 ##
+07940 TERTT: IDTY@,ANY! => S-82 ,2-> ! TERTT; #RATHER THAN UNITT#
+07960 !BECOM@ => S-83 ,1->TERT ! ++ UNITH;
+07980 !IDTY@ => S-81 ,1->TERT ! ++ TERTH;
+08000 ##
+08020 UNITT: UNITSR,ANY! => ,1-> ! UNITSRT;
+08040 CL13,ANY! => , ! UNITCOM;
+08060 TERT,BECOM@,ANY! => S-84 ,2-> ! UNITT;
+08080 VDEFL,ANY! => S-110 ,1-> ! VDEFT;
+08100 IDEFL,ANY! => S-110 ,1-> ! IDEFT;
+08120 ACTPL,ANY! => ,1-> ! ACTPLT;
+08140 FROM@,ANY! => S-49 ,1-> ! + BYPTH;
+08160 BY@,ANY! => S-49 ,1-> ! + TOPTH;
+08180 TO@,ANY! => S-49 ,1-> ! + WHILEPTH;
+08200 UNITLC,ANY! => ,1-> ! UNITLCT;
+08220 UNITLP,ANY! => ,1-> ! UNITLPT;
+08240 RSPEC,ANY! => S-101 ,1-> ! RTEXTT;
+08260 LABSQ,ANY! => ,1-> ! LABUNITT;
+08280 ODEFL,ANY! => S-111 ,1-> ! ODEFT;
+08300 COLON@,ANY! => S-95 ,2-> ! CMB;
+08320 AT@,ANY! => S-90 ,1-> ! REVLBT;
+08340 !COLON@ => S-94 ,1->TERT ! LOWBNDT;
+08380 TRMSCL,ANY! => S-92 ,1-> ! TRMSCLT;
+08400 UNITCOM: !COMMA@ => ,1->TERT ! UNITLT;
+08420 ! => , ! UNITSRT;
+08440 ##
+08460 UNITLT: OPEN@,ANY! => S-113 ,1->UNITLC ! (1) + UNITH;
+08480 BEGIN@,ANY! => S-113 ,1->UNITLC ! (1) + UNITH;
+08500 ! => S-41 ,1->UNITLP ! (1) + UNITH;
+08520 ##
+08540 LOWBNDT: ACTRL,ANY! => , ! ++ UNITH;
+08600 ! => S-87 , ! + CMA;
+08620 # LOWER-BOUND IN TRIMMER#
+08640 CMA: !CL11 => ,2->BOUNDS ! BOUNDST;
+08660 ! => , ! + UNITH;
+08680 #COMBINED ACTRLT AND BOUNDST, AFTER COLON#
+08700 CMB: ACTRL,ANY! => ,1-> ! ACTRLT;
+08720 TRMSCL,ANY! => S-88 ,1->BOUNDS ! BOUNDST;
+08760 FORRLB,ANY! => ,1-> ! ACTRLT; #ERROR PATH FROM E-17#
+08770 ! => S-88 ,0->BOUNDS ! BOUNDST; #NO UNIT BEFORE THE COLON#
+08820 ##
+08840 ACTRLT: !COMMA@ => , ! (1) + UNITH;
+08860 SUB@,ANY!BUS@ => S-26 , ! ACTRLT2;
+08862 OPEN@,ANY!CLOSE@ => S-26 , ! ACTRLT2;
+08866 !CL00 => , ! ERROR20,MISMATCH;
+08873 ##
+08880 ACTRLT2: CL2B,ANY,ANY! => S-101 , ! (1) + NONRDRH; #MODE-DECLARATION#
+08900 ! => , ! (1) + NONRDRH;
+08920 ##
+08940 BOUNDST: !AT@ => S-89 , ! ++ UNITH,TRMSCT;
+08960 ##
+08980 REVLBT: BOUNDS,ANY! => ,1-> ! TRMSCT;
+09000 TRMSCT: TRMSCL,ANY! => ,1-> ! TRMSCLT;
+09020 ! => ,1->TRMSCL ! TRMSCLT;
+09040 ##
+09060 TRMSCLT: !COMMA@ => S-86 , ! (1) TRMSCH;
+09070 SUB@,ANY!BUS@ => S-93 ,2-> ! (1) PRIMT;
+09072 OPEN@,ANY!CLOSE@ => S-93 ,2-> ! (1) PRIMT;
+09080 !CL00 => , ! ERROR03,MISMATCH;
+09090 ##
+09120 UNITLCT: !COMMA@ => S-114 , ! (1) + UNITH;
+09140 OPEN@,ANY!CLOSE@ => S-115 ,1-> ! (1) UNITLCT1;
+09160 BEGIN@,ANY!END@ => S-115 ,1-> ! (1) UNITLCT1,ERROR37;
+09180 ##
+09200 UNITLCT1: OPEN@,ANY! => ,1->PRIM ! UNITLCT2;
+09220 BEGIN@,ANY! => ,1->PRIM ! UNITLCT2,ENCLCLT;
+09240 ##
+09260 UNITLCT2: !COMMA@ => , ! ENCLCLT,ERROR34;
+09280 ##
+09300 UNITLPT: ! => S-41 , ! UNITLPT1;
+09320 UNITLPT1: !COMMA@ => , ! (1) + UNITH;
+09340 CSTICK@,ANY! => S-34 ,2->BRINPT ! BRINPTT;
+09360 STICK@,ANY! => A-7+ ,2->BRINPT ! BRINPTT;
+09380 IN@,ANY! => S-34 ,2-> ! INPTT,ERROR25;
+09400 ##
+09420 ACTPLT: !COMMA@ => S-96 , ! (1) + UNITH;
+09440 OPEN@,ANY!CLOSE@ => S-97 ,2-> ! (1) PRIMT,ERROR22;
+09460 ##
+09480 LABUNITT: UNITSR,ANY! => ,1-> ! UNITSRT;
+09500 ##
+09520 UNITSRT: CL13,ANY!SEMIC@ => S-62 ,1->UNITSR ! (1) + SERCLH;
+09540 CL13,ANY!EXIT@ => S-46 ,1->UNITSR ! ++ LABH;
+09560 ##
+09580 SERCLT: CL13,ANY! => S-43 ,1->UNITSR ! L2,ERROR33;
+09600 L2: OPEN@,ANY!CLOSE@ => ,1-> ! (1) ENCLCLT;
+09620 BEGIN@,ANY!END@ => ,1-> ! (1) ENCLCLT;
+09640 IF@,ANY!THEN@ => S-37 ,1-> ! ++ SERCLH;
+09660 THEN@,ANY! => S-39 ,2-> ! THENPTT;
+09680 ELSE@,ANY! => ,2-> ! CONDALTT;
+09700 ELIF@,ANY!THEN@ => S-37 ,1-> ! ++ SERCLH;
+09720 OPEN@,ANY!STICK@ => ,1-> ! + BRALTH;
+09740 CASE@,ANY!IN@ => S-38 ,1-> ! ++ SERCLH;
+09760 OUT@,ANY! => ,2-> ! CASEALTT;
+09780 OUSE@,ANY!IN@ => S-38 ,1-> ! ++ SERCLH;
+09800 DO@,ANY!OD@ => S-60 ,1-> ! (1) DOPTT;
+09820 WHILE@,ANY!DO@ => S-57 ,1-> ! ++ SERCLH;
+09840 BRTHPT,STICK@,ANY! => ,2-> ! BRCONDALTT;
+09860 BRINPT,STICK@,ANY! => ,2-> ! BRCASEALTT;
+09880 CSTICK@,ANY! => E-42 ,1->UNITLP ! UNITLPT;
+09900 IN@,ANY! => E-42 ,1->UNITLP ! UNITLPT;
+09920 STICK@,ANY! => S-39 ,2->BRTHPT ! BRTHENPTT;
+09940 BRTHPT,AGAIN@,ANY! => ,1-> ! + BRTHENPTH;
+09960 BRINPT,AGAIN@,ANY! => ,1-> ! + BRINPTH,ERROR24;
+09980 ##
+10000 BRCONDALTT:OPEN@,ANY!CLOSE@ => S-35 ,1-> ! (1) ENCLCLT;
+10020 AGAIN@,ANY! => S-35 ,2-> ! BRCONDALTT,ERROR24;
+10040 ##
+10060 CONDALTT: IF@!FI@ => S-35 , ! (1) ENCLCLT;
+10080 ELIF@! => S-35 ,1-> ! CONDALTT,ERROR24;
+10100 ##
+10120 BRCASEALTT:OPEN@,ANY!CLOSE@ => S-42 ,1-> ! (1) ENCLCLT;
+10140 AGAIN@,ANY! => S-42 ,2-> ! BRCASEALTT,ERROR24;
+10160 ##
+10180 CASEALTT: CASE@!ESAC@ => S-42 , ! (1) ENCLCLT;
+10200 OUSE@! => S-42 ,1-> ! CASEALTT,ERROR24;
+10220 ##
+10240 BRTHENPTT: !CL29 => , ! ++ SERCLH;
+10260 ! => S-36 , ! BRCONDALTT;
+10280 ##
+10300 THENPTT: !CL24 => , ! ++ SERCLH;
+10320 ! => S-36 , ! CONDALTT;
+10340 ##
+10360 BRINPTT: !CL29 => , ! ++ SERCLH;
+10380 ! => S-36 , ! BRCASEALTT;
+10400 ##
+10420 INPTT: !CL23 => , ! ++ SERCLH;
+10440 ! => S-36 , ! CASEALTT;
+10460 ##
+10480 DOPTT: WHILE@,ANY! => S-56 ,1-> ! WHILEPTT;
+10500 WHILEPTT: TO@,ANY! => ,1-> ! TOPTT;
+10520 TOPTT: BY@,ANY! => ,1-> ! BYPTT;
+10540 BYPTT: FROM@,ANY! => ,1-> ! FROMPTT;
+10560 FROMPTT: FOR@,ANY! => ,1-> ! LOOPCLT;
+10580 LOOPCLT: ! => S-61 , ! ENCLCLT;
+10600 ##
+10620 ENCLCLT: START@,ANY! => S-44 , ! CMC;
+10640 MOIDDR,ANY! => S-45 ,2->PRIM ! PRIMT;
+10660 ! => S-44 ,1->PRIM ! PRIMT;
+10680 ##
+10700 CMC: !STOP@ => S-118 , ! QUIT,ERROR21;
+10720 ##
+10740 QUIT: ! => S-121 , ! QUIT;
+10760 #DCL WAS FOLLOWED BY COMMAS#
+10780 DCLT1: ! => ,2-> ! + DCLH;
+10800 #DCL WAS FOLLOWED BY NON-COMMAS#
+10820 DCLT2: ! => S-112 ,2-> ! DCLPT;
+10840 ##
+10860 DCLPT: UNITSR!SEMIC@ => , ! (1) + SERCLH;
+10880 !SEMIC@ => ,0->UNITSR ! (1) + SERCLH,ERROR30;
+10900 ##
+10920 LABT: LABSQ,ANY! => ,1-> ! LABSQT;
+10940 EXIT@,ANY! => ,2-> ! + SERCLH;
+10960 ! => ,1->LABSQ ! LABSQT;
+10980 ##
+11000 LABSQT: !TAG@ => , ! + CMD;
+11020 ! => , ! + UNITH;
+11040 ##
+11060 CMD: !COLON@ => S-74 , ! (1) LABT,UNITH;
+11080 ##
+11100 IDEFT: !COMMA@ => , ! (1) CME,DCLT2;
+11120 ##
+11140 CME: !TAG@ => ,1-> ! + IDEFH1,DCLT1;
+11160 ##
+11180 RIDEFT: !COMMA@ => , ! (1) CMF,DCLT2;
+11200 ##
+11220 CMF: !TAG@ => ,1-> ! + RIDEFH,DCLT1;
+11240 ##
+11260 VDEFT: PROC@,ANY! => , ! ERROR32;
+11280 # CAN THIS REALLY HAPPEN? #
+11300 !COMMA@ => , ! (1) CMG,DCLT2;
+11320 ##
+11340 CMG: !TAG@ => ,1-> ! + VDEFH1,DCLT1;
+11360 ##
+11380 RVDEFT: !COMMA@ => , ! (1) CMH,DCLT2;
+11400 ##
+11420 CMH: !TAG@ => ,1-> ! + RVDEFH,DCLT1;
+11440 ##
+11460 ODEFT: !COMMA@ => , ! (1) CMI,DCLT2;
+11480 ##
+11500 CMI: !CL14 => ,1-> ! + ODEFH1,DCLT1;
+11520 ##
+11540 RODEFT: !COMMA@ => , ! (1) CMJ,DCLT2;
+11560 ##
+11580 CMJ: !CL14 => ,1-> ! + RODEFH,DCLT1;
+11600 ##
+11620 PDEFT: !COMMA@ => , ! (1) CMK,DCLT2;
+11640 ##
+11660 CMK: !CL14 => ,1-> ! + PDEFH,DCLT1;
+11680 ##
+11700 MDEFT: !COMMA@ => , ! (1) CML,DCLT2;
+11720 ##
+11740 CML: !CL2B => A-6+ ,1-> ! + MDEFH,DCLT1;
+11760 #SYNTAX ERROR PROCESSING; ACTIVATED AFTER BRANCH TO ERRORNN #
+11780 PERROR: CL13! => S-119 , ! PEA1;
+11800 START@! => S-119 , ! PEA2;
+11820 ! => ,1-> ! PERROR;
+11840 ##
+11860 PEA1: !SEMIC@ => A-8+ , ! (1) + SERCLH;
+11880 !CL23 => A-8+ , ! INPTT;
+11900 !CL24 => A-8+ , ! THENPTT;
+11920 !CL29 => A-8+ , ! BRTHENPTT;
+11940 !CL2F => A-8+ , ! (1) ENCLCLT;
+11960 !STOP@ => E-08 , ! QUIT;
+11980 !CL21 => , ! + PEA1;
+12000 !CL22 => , ! + PEA1;
+12010 !CL26 => , ! + PEA1;
+12020 ! => , ! (1) PEA1;
+12040 ##
+12060 PEA2: !STOP@ => E-08 , ! QUIT;
+12080 ! => , ! (1) PEA2;
+12100 ##
+12120 ERROR01: ! => E-01 , ! PERROR;
+12140 ERROR02: ! => E-02 , ! PERROR;
+12160 ERROR03: ! => E-03 , ! PERROR;
+12180 ERROR04: ! => E-04 , ! PERROR;
+12200 ERROR05: ! => E-05 , ! PERROR;
+12220 ERROR09: ! => E-09 , ! PERROR;
+12240 ERROR10: ! => E-10 , ! PERROR;
+12260 ERROR11: ! => E-11 , ! PERROR;
+12280 ERROR12: ! => E-12 , ! PERROR;
+12300 ERROR13: ! => E-13 , ! PERROR;
+12320 ERROR14: ! => E-14 , ! PERROR;
+12340 ERROR15: ! => E-15 , ! PERROR;
+12360 ERROR16: ! => E-16 , ! PERROR;
+12380 ERROR18: ! => E-18 , ! PERROR;
+12400 ERROR19: ! => E-19 , ! PERROR;
+12420 ERROR20: ! => E-20 , ! PERROR;
+12440 ERROR21: ! => E-21 , ! PERROR;
+12460 ERROR22: ! => E-22 , ! PERROR;
+12480 ERROR23: ! => E-23 , ! PERROR;
+12500 ERROR24: !CL00 => E-24 , ! PERROR;
+12520 MISMATCH: CL21! => E-26 , ! PEA3;
+12540 BEGIN@! => E-27 , ! PEA3;
+12560 CASE@! => E-28 , ! PEA3;
+12580 IF@! => E-29 , ! PEA3;
+12600 CL22! => E-7 , ! PEA3;
+12606 OPEN@! => E-7 , ! PEA3;
+12613 SUB@! => E-6 , ! PEA3;
+12620 ! => ,1-> ! MISMATCH;
+12640 PEA3: ! => S-119 , ! PEA1;
+12660 ERROR25: ! => E-25 , ! PERROR;
+12680 ERROR30: ! => E-30 , ! PERROR;
+12700 ERROR31: ! => E-31 , ! PERROR;
+12720 ERROR32: ! => E-32 , ! PERROR;
+12740 ERROR33: ! => E-33 , ! PERROR;
+12760 ERROR34: ! => E-34 , ! PERROR;
+12780 ERROR36: ! => E-36 , ! PERROR;
+12800 ERROR37: ! => E-37 , ! PERROR;
+12820 ERROR38: ! => E-38 , ! PERROR;
+12840 ERROR40: ! => E-40 , ! PERROR;
+12860 ERROR41: ! => E-41 , ! PERROR;
+12880 ERROR43: ! => E-43 , ! PERROR,PERROR;
public / ack.git / commitdiff