From a66faf410075eb5c5cbecf2abb1a29b7d83d3067 Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 4 Oct 1988 10:56:50 +0000 Subject: [PATCH] Initial revision --- lang/a68s/aem/.distr | 26 + lang/a68s/aem/Makefile | 261 +++++ lang/a68s/aem/a68s1ce.p | 2127 +++++++++++++++++++++++++++++++++++ lang/a68s/aem/a68s1cg.p | 1348 ++++++++++++++++++++++ lang/a68s/aem/a68s1int.p | 228 ++++ lang/a68s/aem/a68s1lx.p | 1473 ++++++++++++++++++++++++ lang/a68s/aem/a68s1md.p | 690 ++++++++++++ lang/a68s/aem/a68s1pa.p | 601 ++++++++++ lang/a68s/aem/a68s1s1.p | 1220 ++++++++++++++++++++ lang/a68s/aem/a68s1s2.p | 1060 +++++++++++++++++ lang/a68s/aem/a68scod.p | 600 ++++++++++ lang/a68s/aem/a68sdec.p | 1262 +++++++++++++++++++++ lang/a68s/aem/a68sdum.p | 282 +++++ lang/a68s/aem/a68sin.p | 802 +++++++++++++ lang/a68s/aem/a68sint.p | 32 + lang/a68s/aem/a68spar.p | 583 ++++++++++ lang/a68s/aem/a68ssp.p | 597 ++++++++++ lang/a68s/aem/cmpdum.p | 137 +++ lang/a68s/aem/cybcod.p | 1135 +++++++++++++++++++ lang/a68s/aem/dec_main.p | 15 + lang/a68s/aem/dec_main_s1.p | 31 + lang/a68s/aem/getaddr.e | 18 + lang/a68s/aem/make | 28 + lang/a68s/aem/pcalls.e | 56 + lang/a68s/aem/perqce.p | 1078 ++++++++++++++++++ lang/a68s/aem/perqcod.p | 716 ++++++++++++ lang/a68s/aem/syntax | 648 +++++++++++ 27 files changed, 17054 insertions(+) create mode 100644 lang/a68s/aem/.distr create mode 100644 lang/a68s/aem/Makefile create mode 100644 lang/a68s/aem/a68s1ce.p create mode 100644 lang/a68s/aem/a68s1cg.p create mode 100644 lang/a68s/aem/a68s1int.p create mode 100644 lang/a68s/aem/a68s1lx.p create mode 100644 lang/a68s/aem/a68s1md.p create mode 100644 lang/a68s/aem/a68s1pa.p create mode 100644 lang/a68s/aem/a68s1s1.p create mode 100644 lang/a68s/aem/a68s1s2.p create mode 100644 lang/a68s/aem/a68scod.p create mode 100644 lang/a68s/aem/a68sdec.p create mode 100644 lang/a68s/aem/a68sdum.p create mode 100644 lang/a68s/aem/a68sin.p create mode 100644 lang/a68s/aem/a68sint.p create mode 100644 lang/a68s/aem/a68spar.p create mode 100644 lang/a68s/aem/a68ssp.p create mode 100644 lang/a68s/aem/cmpdum.p create mode 100644 lang/a68s/aem/cybcod.p create mode 100644 lang/a68s/aem/dec_main.p create mode 100644 lang/a68s/aem/dec_main_s1.p create mode 100644 lang/a68s/aem/getaddr.e create mode 100755 lang/a68s/aem/make create mode 100644 lang/a68s/aem/pcalls.e create mode 100644 lang/a68s/aem/perqce.p create mode 100644 lang/a68s/aem/perqcod.p create mode 100644 lang/a68s/aem/syntax diff --git a/lang/a68s/aem/.distr b/lang/a68s/aem/.distr new file mode 100644 index 000000000..6a1ee1489 --- /dev/null +++ b/lang/a68s/aem/.distr @@ -0,0 +1,26 @@ +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 diff --git a/lang/a68s/aem/Makefile b/lang/a68s/aem/Makefile new file mode 100644 index 000000000..13407db87 --- /dev/null +++ b/lang/a68s/aem/Makefile @@ -0,0 +1,261 @@ +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 + + diff --git a/lang/a68s/aem/a68s1ce.p b/lang/a68s/aem/a68s1ce.p new file mode 100644 index 000000000..68b9dccef --- /dev/null +++ b/lang/a68s/aem/a68s1ce.p @@ -0,0 +1,2127 @@ +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 ' IS PRODUCED ON EACH LINE *) +33483 (* IN THE +24 MACHINE 'CON ...' 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 HI0 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^.SBTYPNIL 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*) diff --git a/lang/a68s/aem/a68s1cg.p b/lang/a68s/aem/a68s1cg.p new file mode 100644 index 000000000..763d250a5 --- /dev/null +++ b/lang/a68s/aem/a68s1cg.p @@ -0,0 +1,1348 @@ +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) 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 ISZADDR) 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=SBTSTK THEN (*IT MUST BE DUPLICATED*) +59170 BEGIN +59180 SBLH2^.SBTYP := SBTVOID; +59190 IF SBRH^.SBTYPSZINT), 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*) diff --git a/lang/a68s/aem/a68s1int.p b/lang/a68s/aem/a68s1int.p new file mode 100644 index 000000000..6cbc2ad62 --- /dev/null +++ b/lang/a68s/aem/a68s1int.p @@ -0,0 +1,228 @@ +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 (**) diff --git a/lang/a68s/aem/a68s1lx.p b/lang/a68s/aem/a68s1lx.p new file mode 100644 index 000000000..6229e3b1a --- /dev/null +++ b/lang/a68s/aem/a68s1lx.p @@ -0,0 +1,1473 @@ +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 ERRPTR4+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 SYMCNT0 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 DIGT1 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 DIGT1 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 SYMCNTQUOTE 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 SYMCNTNIL 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*) diff --git a/lang/a68s/aem/a68s1md.p b/lang/a68s/aem/a68s1md.p new file mode 100644 index 000000000..ebcafe7b9 --- /dev/null +++ b/lang/a68s/aem/a68s1md.p @@ -0,0 +1,690 @@ +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 LEN1M 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.MDIDMDIDNIL) 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 SBLENSRSTK[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 (MDIDMDIDNIL) (*NOT HIPMODE*) THEN BALSTR := STREMPTY +67760 ELSE BALSTR := STRSTRONG; +67770 WHILE SEMPM2COERC 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.MDIDMDIDNIL) 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*) diff --git a/lang/a68s/aem/a68s1pa.p b/lang/a68s/aem/a68s1pa.p new file mode 100644 index 000000000..a1f9fb630 --- /dev/null +++ b/lang/a68s/aem/a68s1pa.p @@ -0,0 +1,601 @@ +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 LXIO0 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)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*) diff --git a/lang/a68s/aem/a68s1s1.p b/lang/a68s/aem/a68s1s1.p new file mode 100644 index 000000000..4677c9aed --- /dev/null +++ b/lang/a68s/aem/a68s1s1.p @@ -0,0 +1,1220 @@ +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)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 STLEVELNIL 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^.STRANGE0 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 BLKSTBDEFID 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 STCURIDSTBNONE 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[YIN, YANG]) AND (INIL 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*) diff --git a/lang/a68s/aem/a68s1s2.p b/lang/a68s/aem/a68s1s2.p new file mode 100644 index 000000000..7c9505b3d --- /dev/null +++ b/lang/a68s/aem/a68s1s2.p @@ -0,0 +1,1060 @@ +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 ERRPTRNIL 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^.SBCNTNIL 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*) diff --git a/lang/a68s/aem/a68scod.p b/lang/a68s/aem/a68scod.p new file mode 100644 index 000000000..59640e016 --- /dev/null +++ b/lang/a68s/aem/a68scod.p @@ -0,0 +1,600 @@ +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*) diff --git a/lang/a68s/aem/a68sdec.p b/lang/a68s/aem/a68sdec.p new file mode 100644 index 000000000..56d76eb02 --- /dev/null +++ b/lang/a68s/aem/a68sdec.p @@ -0,0 +1,1262 @@ +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 (**) diff --git a/lang/a68s/aem/a68sdum.p b/lang/a68s/aem/a68sdum.p new file mode 100644 index 000000000..6c8f7d40a --- /dev/null +++ b/lang/a68s/aem/a68sdum.p @@ -0,0 +1,282 @@ +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*) diff --git a/lang/a68s/aem/a68sin.p b/lang/a68s/aem/a68sin.p new file mode 100644 index 000000000..e1782bd3f --- /dev/null +++ b/lang/a68s/aem/a68sin.p @@ -0,0 +1,802 @@ +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*) diff --git a/lang/a68s/aem/a68sint.p b/lang/a68s/aem/a68sint.p new file mode 100644 index 000000000..340ffe0f0 --- /dev/null +++ b/lang/a68s/aem/a68sint.p @@ -0,0 +1,32 @@ +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*) diff --git a/lang/a68s/aem/a68spar.p b/lang/a68s/aem/a68spar.p new file mode 100644 index 000000000..15788e8f3 --- /dev/null +++ b/lang/a68s/aem/a68spar.p @@ -0,0 +1,583 @@ +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.LXPNIL) 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.LXPNIL) 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.LXPNIL) 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.LXPNIL) 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*) diff --git a/lang/a68s/aem/a68ssp.p b/lang/a68s/aem/a68ssp.p new file mode 100644 index 000000000..05a35fcb6 --- /dev/null +++ b/lang/a68s/aem/a68ssp.p @@ -0,0 +1,597 @@ +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*) diff --git a/lang/a68s/aem/cmpdum.p b/lang/a68s/aem/cmpdum.p new file mode 100644 index 000000000..6388c4e2e --- /dev/null +++ b/lang/a68s/aem/cmpdum.p @@ -0,0 +1,137 @@ +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 COUNTHEAPLENGTH 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. diff --git a/lang/a68s/aem/cybcod.p b/lang/a68s/aem/cybcod.p new file mode 100644 index 000000000..1b5ccf6fe --- /dev/null +++ b/lang/a68s/aem/cybcod.p @@ -0,0 +1,1135 @@ +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 diff --git a/lang/a68s/aem/dec_main.p b/lang/a68s/aem/dec_main.p new file mode 100644 index 000000000..142ef5f66 --- /dev/null +++ b/lang/a68s/aem/dec_main.p @@ -0,0 +1,15 @@ +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. diff --git a/lang/a68s/aem/dec_main_s1.p b/lang/a68s/aem/dec_main_s1.p new file mode 100644 index 000000000..806d576c8 --- /dev/null +++ b/lang/a68s/aem/dec_main_s1.p @@ -0,0 +1,31 @@ +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. + diff --git a/lang/a68s/aem/getaddr.e b/lang/a68s/aem/getaddr.e new file mode 100644 index 000000000..df2364a98 --- /dev/null +++ b/lang/a68s/aem/getaddr.e @@ -0,0 +1,18 @@ +#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 diff --git a/lang/a68s/aem/make b/lang/a68s/aem/make new file mode 100755 index 000000000..cad271dc0 --- /dev/null +++ b/lang/a68s/aem/make @@ -0,0 +1,28 @@ +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 ;; \ diff --git a/lang/a68s/aem/pcalls.e b/lang/a68s/aem/pcalls.e new file mode 100644 index 000000000..3583b6a95 --- /dev/null +++ b/lang/a68s/aem/pcalls.e @@ -0,0 +1,56 @@ +#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 diff --git a/lang/a68s/aem/perqce.p b/lang/a68s/aem/perqce.p new file mode 100644 index 000000000..f7303a4f8 --- /dev/null +++ b/lang/a68s/aem/perqce.p @@ -0,0 +1,1078 @@ +~>|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 diff --git a/lang/a68s/aem/perqcod.p b/lang/a68s/aem/perqcod.p new file mode 100644 index 000000000..f29844d43 --- /dev/null +++ b/lang/a68s/aem/perqcod.p @@ -0,0 +1,716 @@ +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 diff --git a/lang/a68s/aem/syntax b/lang/a68s/aem/syntax new file mode 100644 index 000000000..2985f163d --- /dev/null +++ b/lang/a68s/aem/syntax @@ -0,0 +1,648 @@ +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;