Initial revision
This commit is contained in:
ceriel
parent
7bac6eb164
commit
a66faf4100
26
lang/a68s/aem/.distr
Normal file
26
lang/a68s/aem/.distr
Normal file
|
|
@ -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
|
||||
261
lang/a68s/aem/Makefile
Normal file
261
lang/a68s/aem/Makefile
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
2127
lang/a68s/aem/a68s1ce.p
Normal file
2127
lang/a68s/aem/a68s1ce.p
Normal file
File diff suppressed because it is too large
Load diff
1348
lang/a68s/aem/a68s1cg.p
Normal file
1348
lang/a68s/aem/a68s1cg.p
Normal file
File diff suppressed because it is too large
Load diff
228
lang/a68s/aem/a68s1int.p
Normal file
228
lang/a68s/aem/a68s1int.p
Normal file
|
|
@ -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 (**)
|
||||
1473
lang/a68s/aem/a68s1lx.p
Normal file
1473
lang/a68s/aem/a68s1lx.p
Normal file
File diff suppressed because it is too large
Load diff
690
lang/a68s/aem/a68s1md.p
Normal file
690
lang/a68s/aem/a68s1md.p
Normal file
|
|
@ -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 LEN1<LEN2 THEN (*STRONG COERCION, IF ANY, IS FROM M1 TO FIRMM2*)
|
||||
65860 BEGIN
|
||||
65870 M1COERC := STRSTRONG; M2COERC := TSTRENGTH(M2, FIRMM2);
|
||||
65880 BALMOIDS := FIRMM2;
|
||||
65890 END
|
||||
65900 ELSE
|
||||
65910 BEGIN
|
||||
65920 M1COERC := TSTRENGTH(M1, FIRMM1); M2COERC := STRSTRONG;
|
||||
65930 BALMOIDS := FIRMM1;
|
||||
65940 END;
|
||||
65950 END;
|
||||
65960 END
|
||||
65970 END;
|
||||
65980 (**)
|
||||
65990 (**)
|
||||
66000 PROCEDURE CGCOERCE(SB: PSB (*CONTAINING SOURCE MODE*); M: MODE (*DESTINATION MODE*));
|
||||
66010 VAR FIRMM, MM: MODE;
|
||||
66020 SB1, SB2: PSB;
|
||||
66030 MODENO: -1..31;
|
||||
66040 SPACE: 0..MAXSIZE;
|
||||
66050 I:0..MAXINT;
|
||||
66052 OPCOD: POP;
|
||||
66060 BEGIN WITH SB^ DO
|
||||
66070 IF SBMODE<>M THEN
|
||||
66080 BEGIN
|
||||
66090 FIRMM := COFIRM(SBMODE,M);
|
||||
66100 IF M=MDVOID THEN (*VOIDING COERCION NEEDED*)
|
||||
66110 BEGIN
|
||||
66120 IF (SBMORF IN SBINF) AND (LASTPROC<>NIL) THEN
|
||||
66130 CGCSUPP(SB, LASTPROC^.MDPRRMD, 0);
|
||||
66140 IF SBTYP>SBTDEN THEN (*THE VALUE IS ALREADY STORED SOMEWHERE*)
|
||||
66150 BEGIN
|
||||
66160 IF SBNAKED IN SBINF THEN BEGIN EMITX1(PVOIDNAKED,OCVSB,ORD(SB)); STACKSB(SB) END
|
||||
66180 ELSE IF SBMODE^.MDV.MDPILE THEN BEGIN EMITX1(PVOIDNORMAL,OCVSB,ORD(SB)); STACKSB(SB) END
|
||||
66182 ELSE IF SBTYP IN [SBTSTK..SBTSTKN] THEN EMITX1(PASP, OCVIMMED, SBMODE^.MDV.MDLEN);
|
||||
66190 END;
|
||||
66200 IF (SBVOIDWARN IN SBINF) AND (SBMODE<>MDVOID) THEN
|
||||
66210 OUTERR(ESE+10, WARNING, NIL);
|
||||
66220 SBINF := SBINF-[SBNAKED]; FILL(SBTVOID,SB);
|
||||
66230 END
|
||||
66240 ELSE IF TUNITED(M) THEN (*TRANSPUT COERCION*)
|
||||
66250 BEGIN
|
||||
66260 FIRMM := COMEEK(SBMODE);
|
||||
66270 IF (FIRMM<>PRCVF) AND (FIRMM<>PASCVF) AND
|
||||
66280 ((M=MDIN) OR (M=MDINB) OR (M=ROWIN) OR (M=ROWINB) OR (M=MDROWS)) THEN
|
||||
66290 MM := COWEAK(SBMODE)
|
||||
66300 ELSE IF FIRMM=MDSKIP THEN
|
||||
66310 BEGIN MM := MDCHAR; FIRMM := MM END (*TO FORCE A RUN-TIME ERROR*)
|
||||
66320 ELSE MM := FIRMM;
|
||||
66330 CGCOERCE(SB, MM);
|
||||
66340 IF M<>MDROWS THEN
|
||||
66350 BEGIN
|
||||
66360 IF FIRMM^.MDV.MDID=MDIDROW THEN
|
||||
66370 MODENO := TX(FIRMM^.MDPRRMD)+16
|
||||
66380 ELSE MODENO := TX(FIRMM);
|
||||
66390 SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := MODENO; TWIST; LOADSTK(SB1);
|
||||
66400 (*-01() IF (M^.MDV.MDID=MDIDNUMBER) AND (MODENO=0(*INT*)) THEN
|
||||
66410 BEGIN
|
||||
66420 SB2 := PUSHSB(MDINT); SB2^.SBLEN := SZREAL-SZINT; SB2^.SBINF := SB2^.SBINF+[SBUNION]; SB2^.SBTYP := SBTLIT; SB1^.SBVALUE := 0; TWIST; LOADSTK(SB2);
|
||||
66430 GETTOTAL(SB); LOADSTK(SB);
|
||||
66440 COMBINE; SBTYP := SBTSTKN;
|
||||
66450 END;
|
||||
66460 ()-01*)
|
||||
66470 GETTOTAL(SB);
|
||||
66480 FOR I:= SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);(*DEAL WITH DELAYS*)
|
||||
66490 SBDELAYS:=0;LOADSTK(SB);
|
||||
66500 COMBINE; SBTYP := SBTSTKN; SBINF := SBINF+[SBUNION];
|
||||
66530 IF M^.MDV.MDID=MDIDROW THEN (*SINGLE UNIT TO BE ROWED TO A DATA LIST*)
|
||||
66540 BEGIN
|
||||
66550 (*+05() IF (RTSTKDEPTH MOD 4)<>0 THEN
|
||||
66560 BEGIN SB1 := PUSHSB(MDINT); SB1^.SBTYP := SBTLIT; SB1^.SBVALUE := TX(MDVOID);
|
||||
66570 LOADSTK(SB1); COMBINE; SB^.SBTYP := SBTSTKN END;
|
||||
66580 ()+05*)
|
||||
66590 SPACE := SBLEN;
|
||||
66600 SB1 := PUSHSB(MDVOID); UNSTACKSB; SB1^.SBLEN := SPACE+SZDL;
|
||||
66610 EMITX3(PDATALIST, OCVSB, ORD(SB), OCVIMMED, SPACE, OCVRES, ORD(SB1));
|
||||
66620 SBLEN := SB1^.SBLEN; SBINF := SBINF-[SBUNION]; SBTYP := SB1^.SBTYP;
|
||||
66630 UNSTACKSB; DISPOSE(SRSTK[SRSEMP].SB); SRSEMP := SRSEMP-1; STACKSB(SB);
|
||||
66640 END
|
||||
66650 ELSE M := MM; (*SBMODE WILL BE MM, FOR BENEFIT OF STKMAP*)
|
||||
66660 END
|
||||
66670 ELSE GETTOTAL(SB)
|
||||
66680 END
|
||||
66690 ELSE WITH SBMODE^ DO
|
||||
66700 IF (MDV.MDID<MDIDSKIP) OR (MDV.MDID>MDIDNIL) THEN (*NOT HIP*)
|
||||
66710 WITH M^ DO
|
||||
66720 IF MDV.MDID<>MDIDROW THEN
|
||||
66730 CGCSUPP(SB, M, 0)
|
||||
66740 ELSE IF COFIRM(SBMODE, MDPRRMD)=MDPRRMD THEN
|
||||
66750 CGCSUPP(SB, MDPRRMD, MDV.MDCNT)
|
||||
66760 ELSE IF FIRMM^.MDV.MDID=MDIDROW THEN
|
||||
66770 CGCSUPP(SB, FIRMM, MDV.MDCNT-FIRMM^.MDV.MDCNT)
|
||||
66780 ELSE
|
||||
66790 CGCSUPP(SB, MDPRRMD, MDV.MDCNT)
|
||||
66800 ELSE CASE MDV.MDID OF
|
||||
66810 MDIDSKIP:
|
||||
66820 BEGIN UNSTACKSB;
|
||||
66830 IF M^.MDV.MDID=MDIDSTRUCT THEN
|
||||
66840 BEGIN GENDP(M); EMITX2(PSKIPSTRUCT, GENDPOCV, GENDPVAL,OCVRES,ORD(SB)) END
|
||||
66850 ELSE
|
||||
66852 BEGIN
|
||||
66854 IF M^.MDV.MDPILE THEN OPCOD := PSKIP+1
|
||||
66856 ELSE IF M^.MDV.MDLEN>SZINT THEN OPCOD := PSKIP+2
|
||||
66857 ELSE OPCOD := PSKIP;
|
||||
66858 EMITX1(OPCOD, OCVRES, ORD(SB));
|
||||
66859 END;
|
||||
66860 END;
|
||||
66870 MDIDJUMP: (*NO ACTION*);
|
||||
66880 MDIDNIL: BEGIN UNSTACKSB; EMITX1(PNIL, OCVRES, ORD(SB)) END
|
||||
66890 END;
|
||||
66900 SBMODE := M
|
||||
66910 END
|
||||
66920 END;
|
||||
66930 (**)
|
||||
66940 (**)
|
||||
66950 PROCEDURE CGBALB(SB: PSB; M: MODE);
|
||||
66960 (*EACH UNIT TO BE BALANCED*)
|
||||
66970 VAR I: INTEGER;
|
||||
66980 SB1: PSB;
|
||||
66990 BEGIN WITH SB^ DO
|
||||
67000 IF SBMODE<>MDJUMP THEN
|
||||
67010 BEGIN
|
||||
67012 (*+42() SETTEXTSTATE; ()+42*)
|
||||
67020 FIXUPF(SBXPTR); (*SBXPTR WAS SET IN CGIBAL*)
|
||||
67030 STACKSB(SB);
|
||||
67040 CGCOERCE(SB, M);
|
||||
67050 FOR I := SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);
|
||||
67060 SBDELAYS := 0;
|
||||
67070 LOADTOTAL(SB);
|
||||
67080 IF SBUNION IN SBINF THEN
|
||||
67090 WHILE SBLEN<BALANLEN+SZWORD DO (*TO MAKE STKMAP HAPPY*)
|
||||
67100 BEGIN SB1 := PUSHSB(MDVOID); CGCOERCE(RTSTACK, M); COMBINE END;
|
||||
67110 IF (SBTYP=SBTDL) AND (SBLEN<BALANLEN) THEN
|
||||
67120 BEGIN
|
||||
67130 EMITX1(PHOIST, OCVIMMED, BALANLEN-SBLEN);
|
||||
67140 RTSTKDEPTH := RTSTKDEPTH+BALANLEN-SBLEN;
|
||||
67150 SBLEN := BALANLEN;
|
||||
67160 END;
|
||||
67170 UNSTACKSB;
|
||||
67180 IF SB<>SRSTK[SRSEMP].SB THEN
|
||||
67190 GENFLAD
|
||||
67200 END
|
||||
67210 END;
|
||||
67220 (**)
|
||||
67230 (**)
|
||||
67240 FUNCTION COERCE (*-01() (M: MODE): MODE ()-01*);
|
||||
67250 (*FUNCTION: GENERATE CODE TO PERFORM THE APPROPRIATE COERCIONS FOR THE UNIT ON THE STACK.
|
||||
67260 REDUCES THE STACK TO CONTAIN A SINGLE BLOCK REPRESENTING THE RESULTING UNIT.
|
||||
67270 RETURNS M UNALTERED ???
|
||||
67280 *)
|
||||
67290 VAR SEMP: -1..SRSTKSIZE;
|
||||
67300 NOTJUMP: BOOLEAN;
|
||||
67310 I: INTEGER;
|
||||
67320 BEGIN
|
||||
67330 IF BALFLAG THEN
|
||||
67340 BEGIN
|
||||
67350 STARTCHAIN;
|
||||
67360 SEMP := SRSUBP+1;
|
||||
67370 WHILE SEMP<=SRSEMP DO WITH SRSTK[SEMP] DO
|
||||
67380 BEGIN
|
||||
67390 THIPMD(SB^.SBMODE, M);
|
||||
67400 CGBALB(SB, M);
|
||||
67410 IF SEMP<>SRSEMP THEN DISPOSE(SB);
|
||||
67420 SEMP := SEMP+1
|
||||
67430 END;
|
||||
67440 SUBREST;
|
||||
67450 SRSEMP := SRSEMP+1; SRSTK[SRSEMP] := SRSTK[SEMP-1]; (*AS KEPT*)
|
||||
67460 STACKSB(SRSTK[SRSEMP].SB);
|
||||
67470 CGBALC;
|
||||
67480 BALFLAG := FALSE;
|
||||
67490 END
|
||||
67500 ELSE WITH SRSTK[SRSEMP] DO WITH SB^ DO
|
||||
67510 BEGIN
|
||||
67520 THIPMD(SBMODE, M);
|
||||
67530 NOTJUMP := SBMODE<>MDJUMP;
|
||||
67540 CGCOERCE(SB, M);
|
||||
67550 IF NOTJUMP THEN WITH SB^ DO
|
||||
67560 FOR I := SBDELAYS-1 DOWNTO 0 DO CGRGXB(SB);
|
||||
67570 SBDELAYS := 0
|
||||
67580 END;
|
||||
67590 WITH SRSTK[SRSEMP].SB^ DO SBINF := SBINF-[SBMORF];
|
||||
67600 COERCE := M
|
||||
67610 END;
|
||||
67620 (**)
|
||||
67630 (**)
|
||||
67640 FUNCTION BALANCE(STRENGTH: STRTYP): MODE;
|
||||
67650 (*FUNCTION: DEDUCES THE MODE OF THE BALANCE ON THE SUBSTACK.
|
||||
67660 COMPLAINS IF STRENGTH IS INSUFFICIENT.
|
||||
67670 RETURNS THE MODE OF THE BALANCE.
|
||||
67680 *)
|
||||
67690 VAR COMM, M: MODE;
|
||||
67700 SEMP: -1..SRSTKSIZE;
|
||||
67710 BEGIN
|
||||
67720 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
|
||||
67730 COMM := SRSTK[SEMP].SB^.SBMODE;
|
||||
67740 WITH COMM^.MDV DO
|
||||
67750 IF (MDID<MDIDSKIP) OR (MDID>MDIDNIL) (*NOT HIPMODE*) THEN BALSTR := STREMPTY
|
||||
67760 ELSE BALSTR := STRSTRONG;
|
||||
67770 WHILE SEMP<SRSEMP DO
|
||||
67780 BEGIN
|
||||
67790 SEMP := SEMP+1;
|
||||
67800 COMM := BALMOIDS(COMM, SRSTK[SEMP].SB^.SBMODE);
|
||||
67810 IF BALSTR<M1COERC THEN BALSTR := M1COERC;
|
||||
67820 IF BALSTR>M2COERC THEN BALSTR := M2COERC;
|
||||
67830 END;
|
||||
67840 IF BALSTR>STRENGTH THEN
|
||||
67850 IF (STRENGTH=STRFIRM) AND (COMM^.MDV.MDID=MDIDROW) THEN
|
||||
67860 COMM := MDROWS
|
||||
67870 ELSE BEGIN
|
||||
67880 CASE STRENGTH OF
|
||||
67890 STRSOFT: SEMERR(ESE+26);
|
||||
67900 STRWEAK: SEMERR(ESE+27);
|
||||
67910 STRMEEK: SEMERR(ESE+28);
|
||||
67920 STRFIRM: SEMERR(ESE+29);
|
||||
67930 END;
|
||||
67940 COMM := MDERROR;
|
||||
67950 END;
|
||||
67960 BALANCE := COMM
|
||||
67970 END;
|
||||
67980 (**)
|
||||
67990 (**)
|
||||
68000 FUNCTION SOFT: MODE;
|
||||
68010 (*FUNCTION: PERFORMS SOFTEST COERCION ON UNIT OR BALANCE ON THE STACK*)
|
||||
68020 BEGIN
|
||||
68030 TCOLL;
|
||||
68040 SOFT := COERCE(COSOFT(BALANCE(STRSOFT)))
|
||||
68050 END;
|
||||
68060 (**)
|
||||
68070 (**)
|
||||
68080 FUNCTION WEAK: MODE;
|
||||
68090 (*FUNCTION: PERFORMS WEAKEST COERCION ON UNIT OR BALANCE ON THE STACK*)
|
||||
68100 BEGIN
|
||||
68110 TCOLL;
|
||||
68120 WEAK := COERCE(COWEAK(BALANCE(STRWEAK)))
|
||||
68130 END;
|
||||
68140 (**)
|
||||
68150 (**)
|
||||
68160 FUNCTION FIRMBAL: MODE;
|
||||
68170 (*FUNCTION: PERFORMS FIRM BALANCE (BUT DOES NOT COERCE)*)
|
||||
68180 BEGIN
|
||||
68190 TCOLL;
|
||||
68200 FIRMBAL := COFIRM(BALANCE(STRFIRM), NIL);
|
||||
68210 END;
|
||||
68220 (**)
|
||||
68230 (**)
|
||||
68240 FUNCTION MEEK: MODE;
|
||||
68250 (*FUNCTION: PERFORMS FIRMEST COERCION ON UNIT OR BALANCE ON THE STACK*)
|
||||
68260 BEGIN
|
||||
68270 TCOLL;
|
||||
68280 MEEK := COERCE(COMEEK(BALANCE(STRMEEK)));
|
||||
68290 END;
|
||||
68300 (**)
|
||||
68310 (**)
|
||||
68320 FUNCTION UNITESTO(SRCM, DSTM: MODE): BOOLEAN;
|
||||
68330 (*DSTM MUST BE ONE OF THE TRANSPUT MODES OUT, IN, OUT, INB OR NUMBER.
|
||||
68340 FUNCTION: DETERMINES WHETHER SRCM CAN BE UNITED TO DSTM.
|
||||
68350 *)
|
||||
68360 LABEL 9;
|
||||
68370 VAR WEAKM, MEEKM: MODE;
|
||||
68380 BEGIN
|
||||
68390 IF SRCM=MDERROR THEN
|
||||
68400 BEGIN UNITESTO := TRUE; GOTO 9 END;
|
||||
68410 IF DSTM^.MDV.MDID=MDIDROW THEN
|
||||
68420 IF SRCM=DSTM THEN
|
||||
68430 BEGIN UNITESTO := TRUE; GOTO 9 END
|
||||
68440 ELSE DSTM := DSTM^.MDPRRMD;
|
||||
68450 WEAKM := COWEAK(SRCM); MEEKM := COMEEK(WEAKM);
|
||||
68460 UNITESTO := FALSE;
|
||||
68470 WITH DSTM^.MDV DO
|
||||
68480 IF (MDID>=MDIDOUT) AND (MDID<=MDIDNUMBER) (*A UNITED MODE*) THEN
|
||||
68490 CASE MDID OF
|
||||
68500 MDIDOUT:
|
||||
68510 IF (MEEKM=PRCVF) OR (MEEKM=PASCVF) OR (MEEKM^.MDV.MDIO) THEN UNITESTO := TRUE;
|
||||
68520 MDIDIN:
|
||||
68530 IF (MEEKM=PRCVF) OR (MEEKM=PASCVF) THEN UNITESTO := TRUE
|
||||
68540 ELSE IF WEAKM^.MDV.MDID=MDIDREF THEN
|
||||
68550 UNITESTO := MEEKM^.MDV.MDIO;
|
||||
68560 MDIDOUTB:
|
||||
68570 UNITESTO := MEEKM^.MDV.MDIO;
|
||||
68580 MDIDINB:
|
||||
68590 IF WEAKM^.MDV.MDID=MDIDREF THEN
|
||||
68600 UNITESTO := MEEKM^.MDV.MDIO;
|
||||
68610 MDIDNUMBER:
|
||||
68620 IF MEEKM^.MDV.MDID<=MDIDLREAL THEN UNITESTO := TRUE
|
||||
68630 END;
|
||||
68640 9: END;
|
||||
68650 (**)
|
||||
68660 (**)
|
||||
68670 FUNCTION UNITEDBAL(M: MODE): BOOLEAN;
|
||||
68680 (*FUNCTION: DETERMINES WHETHER THE UNIT OR BALANCE ON THE STACK CAN BE
|
||||
68690 UNITED TO THE TRANSPUT MODE M.
|
||||
68700 *)
|
||||
68710 VAR SEMP: -1..SRSTKSIZE;
|
||||
68720 BALCOUNT: INTEGER;
|
||||
68730 BEGIN
|
||||
68740 BALCOUNT := 0;
|
||||
68750 BALANLEN := 0;
|
||||
68760 IF BALFLAG THEN SEMP := SRSUBP+1 ELSE SEMP := SRSEMP;
|
||||
68770 WHILE SEMP<=SRSEMP DO WITH SRSTK[SEMP] DO WITH SB^ DO
|
||||
68780 BEGIN
|
||||
68790 IF UNITESTO(SBMODE, M) THEN BALCOUNT := BALCOUNT+1
|
||||
68800 ELSE IF (SBMODE^.MDV.MDID<MDIDSKIP) OR (SBMODE^.MDV.MDID>MDIDNIL) THEN BALCOUNT := -MAXINT;
|
||||
68810 IF SBLEN>BALANLEN THEN BALANLEN := SBLEN;
|
||||
68820 SEMP := SEMP+1
|
||||
68830 END;
|
||||
68840 UNITEDBAL := BALCOUNT>0
|
||||
68850 END;
|
||||
68860 (**)
|
||||
68870 (**)
|
||||
68880 PROCEDURE STRONG;
|
||||
68890 (*FUNCTION: STRONGLY COERCES THE UNIT OR BALANCE ON THE STACK AS FAR AS THE
|
||||
68900 MODE ON THE SC CHAIN.
|
||||
68910 WHEN THE A POSTERIORI MODE IS VOID IT IS POSSIBLE TO GENERATE DIRECTLY THE COERCION CODE
|
||||
68920 WITHOUT CALLING A BALANCING ROUTINE. THIS IS DUE TO THE FACT THAT ALL MODES CAN BE STRONGLY
|
||||
68930 COERCED TO VOID. HOWEVER, COLLATERAL-CLAUSES MAY NOT APPEAR IN STRONG VOID CONTEXTS.
|
||||
68940 *)
|
||||
68950 VAR M, M1: MODE;
|
||||
68960 BEGIN
|
||||
68970 M := SCPOP;
|
||||
68980 IF M=MDVOID THEN
|
||||
68990 TCOLL
|
||||
69000 ELSE WITH M^ DO
|
||||
69010 BEGIN
|
||||
69020 IF MDV.MDID=MDIDROW THEN M1 := MDPRRMD ELSE M1 := M;
|
||||
69030 WITH M1^.MDV DO IF (MDID>=MDIDOUT) AND (MDID<=MDIDNUMBER) (*UNITEDMODE*) THEN
|
||||
69040 IF NOT UNITEDBAL(M) THEN
|
||||
69050 BEGIN
|
||||
69060 SEMERR(ESE+31);
|
||||
69070 M := MDERROR
|
||||
69080 END
|
||||
69090 END;
|
||||
69100 M := COERCE(M)
|
||||
69110 END;
|
||||
69120 (**)
|
||||
69130 (**)
|
||||
69140 PROCEDURE SETBALFLAG;
|
||||
69150 (*FUNCTION: SETS THE BALANCE FLAG (BALFLAG) FOR THE VALUE OF A RANGE.
|
||||
69160 IF THE RANGE VALUE MAY BE ANY OF A NUMBER (>1) UNITS THEN THE FLAG IS SET AND THE STACK HOLDS
|
||||
69170 A MARK PLUS THE BLOCKS FOR THE UNITS. F THE RANGE VALUE IS A SINGLE UNIT,
|
||||
69180 THE FLAG IS CLEARED AND THE STACK HOLDS ONLY THE SINGLE BLOCK.
|
||||
69190 *)
|
||||
69200 VAR T: PSB;
|
||||
69210 BEGIN
|
||||
69220 IF SRSEMP<>SRSUBP+1 (*NOT ONE UNIT*) THEN
|
||||
69230 BALFLAG := TRUE
|
||||
69240 ELSE BEGIN
|
||||
69250 T := SRSTK[SRSEMP].SB; SRSEMP := SRSEMP-1;
|
||||
69260 SUBREST;
|
||||
69270 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].SB := T
|
||||
69280 END
|
||||
69290 END;
|
||||
69300 (**)
|
||||
69310 (**)
|
||||
69320 PROCEDURE INNERBAL;
|
||||
69330 (*FUNCTION: EXECUTED AFTER PROCESSING AN "INNER UNIT" OF A BALANCE.
|
||||
69340 EVERY BALANCE CONSISTS OF ONE OR MORE UNITS WHICH ARE EVENTUALLY BALANCED.
|
||||
69350 EACH UNIT EXCEPT THE LAST IS CALLED AN INNER UNIT. NOTE THAT EACH UNIT IN A BALANCE MAY IN FACT
|
||||
69360 BE A SINGLE BASIC (NON-BALANCE) UNIT OR A SEQUENCE OF BASIC UNITS WHICH RESULTED FROM SOME BALANCE.
|
||||
69370 *)
|
||||
69380 VAR I: INTEGER; T: -1..SRSTKSIZE;
|
||||
69390 BEGIN
|
||||
69400 IF NOT BALFLAG THEN CGIBAL
|
||||
69410 ELSE BEGIN
|
||||
69420 BALFLAG := FALSE;
|
||||
69430 T := SRSTK[SRSUBP].SUBP;
|
||||
69440 FOR I := SRSUBP TO SRSEMP-1 DO
|
||||
69450 SRSTK[I] := SRSTK[I+1];
|
||||
69460 SRSEMP := SRSEMP-1;
|
||||
69470 SRSUBP := T
|
||||
69480 END
|
||||
69490 END;
|
||||
69500 (**)
|
||||
69510 (**)
|
||||
69520 PROCEDURE LASTIBAL;
|
||||
69530 (*FUNCTION: CALLS INNERBAL IF NECESSARY*)
|
||||
69540 BEGIN
|
||||
69550 IF (BALFLAG) OR (SRSEMP<>SRSUBP+1) THEN INNERBAL
|
||||
69560 END;
|
||||
69570 (**)
|
||||
69580 (**)
|
||||
69590 PROCEDURE MEEKLOAD(M: MODE; ERR: INTEGER);
|
||||
69600 (*EXPECTS THE MAXIMUM COERCION OF THE STACKED UNIT OR BALANCE TO BE M*)
|
||||
69610 VAR M1: MODE;
|
||||
69620 BEGIN
|
||||
69630 M1 := MEEK;
|
||||
69640 IF M1<>M THEN MODERR(M1, ERR);
|
||||
69650 CGFIRM
|
||||
69660 END;
|
||||
69670 (**)
|
||||
69680 (**)
|
||||
69690 PROCEDURE GETOPDM(PROCM: MODE);
|
||||
69700 (*FUNCTION: PROCM IS THE MODE OF SOME OPERATOR.
|
||||
69710 SETS LHMODE AND RHMODE.*)
|
||||
69720 BEGIN WITH PROCM^ DO
|
||||
69730 IF MDV.MDCNT=1 THEN
|
||||
69740 BEGIN LHMODE := MDABSENT; RHMODE := MDPRCPRMS[0] END
|
||||
69750 ELSE
|
||||
69760 BEGIN LHMODE := MDPRCPRMS[0]; RHMODE := MDPRCPRMS[1] END
|
||||
69770 END;
|
||||
69780 (**)
|
||||
69790 ()+84*)
|
||||
601
lang/a68s/aem/a68s1pa.p
Normal file
601
lang/a68s/aem/a68s1pa.p
Normal file
|
|
@ -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 LXIO<LXIOBUS THEN (*NOT TAG OR PART OF A FORMAL-DECLARER*)
|
||||
93640 BEGIN ACTIONROUTINE := FALSE; GOTO 9 END
|
||||
93650 ELSE IF LXIO=LXIOOPEN THEN
|
||||
93670 LEV := LEV+1
|
||||
93700 ELSE IF LXIO=LXIOCLOSE THEN
|
||||
93710 IF LEV<>0 THEN LEV := LEV-1
|
||||
93720 ELSE
|
||||
93730 BEGIN ACTIONROUTINE := TRUE; GOTO 9 END;
|
||||
93740 PREVLX := INPT^.LXV.LXIO;
|
||||
93750 NEW(PTR1); PTR^.LINK := PTR1; PTR := PTR1;
|
||||
93760 END;
|
||||
93770 9: PTR^.LINK := PLINPQ;
|
||||
93780 PLINPQ := HEAD
|
||||
93790 END;
|
||||
93800 (**)
|
||||
93810 (**)
|
||||
93820 (**)
|
||||
93830 3: (*AR3A*)
|
||||
93840 (*FUNCTION: INVOKED AFTER APPLIED-MODE-INDICATION.
|
||||
93850 DETERMINES IF ASCRIBED MODE IS NON-ROWED NON-VOID MODE.
|
||||
93860 TRUE IFF MODE IS NON-ROWED NON-VOID.
|
||||
93870 *)
|
||||
93880 BEGIN
|
||||
93890 STB := APPMI(SRPLSTK[PLSTKP]);
|
||||
93900 WITH STB^ DO IF STBLKTYP>STBDEFOP THEN STB := STDEFPTR;
|
||||
93910 SRSEMP := SRSEMP+1; SRSTK[SRSEMP].MD := STB^.STMODE;
|
||||
93920 IF STB^.STMODE=MDVOID THEN ACTIONROUTINE := FALSE
|
||||
93930 ELSE IF STB^.STOFFSET=0 THEN ACTIONROUTINE := TRUE
|
||||
93940 ELSE ACTIONROUTINE := FALSE
|
||||
93950 END;
|
||||
93960 (**)
|
||||
93970 4: (*AR3B*)
|
||||
93980 (*FUNCTION: INVOKED AFTER ROWED OR VOID APPLIED-MODE-INDICATION.
|
||||
93990 DETERMINES IF ASCRIBED MODE IS VOID.
|
||||
94000 TRUE IFF MODE IS VOID.
|
||||
94010 *)
|
||||
94020 IF SRSTK[SRSEMP].MD=MDVOID THEN ACTIONROUTINE := TRUE
|
||||
94030 ELSE ACTIONROUTINE := FALSE;
|
||||
94040 (**)
|
||||
94050 5: (*AR5*)
|
||||
94060 (*INVOKED: AFTER ENQUIRY-CLAUSE OF BRIEF-CHOICE-CLAUSE.
|
||||
94070 FUNCTION: DECIDE MORE SPECIFICALLY WHAT KIND OF CLAUSE THE BRIEF CLAUSE REPRESENTS.
|
||||
94080 THE LEGAL POSSIBILITIES ARE CONDITIONAL-CLAUSE AND CASE-CLAUSE.
|
||||
94090 A THIRD POSSIBILITY IS THAT THE SERIAL-CLAUSE PRESUMED TO BE AN ENQUIRY-CLAUSE
|
||||
94100 IN FACT DOES NOT YIELD THE REQUIRED MODE AND HENCE IS IN ERROR.
|
||||
94110 VALUE: TRUE IFF CONDITIONAL-CLAUSE OR ERROR.
|
||||
94120 *)
|
||||
94130 BEGIN
|
||||
94140 IF (ERRS-SEMERRS)=0 THEN M := MEEK ELSE M := MDERROR;
|
||||
94150 IF M=MDINT THEN ACTIONROUTINE := FALSE
|
||||
94160 ELSE IF M=MDBOOL THEN ACTIONROUTINE := TRUE
|
||||
94170 ELSE BEGIN MODERR(M, ESE+37); ACTIONROUTINE := TRUE END
|
||||
94180 END;
|
||||
94190 (**)
|
||||
94200 6: (*AR6*)
|
||||
94210 (*INVOKED: AFTER MODE-DEFINITION AND COMMA FOLLOWED BY MODE-INDICATION.
|
||||
94220 FUNCTION: DETERMINE IF TAB IS START OF ANOTHER MODE-DEFINITION OR START OF
|
||||
94230 VARIABLE- OR IDENTITY-DEFINITION-LIST.
|
||||
94240 VALUE: TRUE IFF TAB IS START OF MODE-DEFINITION.
|
||||
94250 *)
|
||||
94260 BEGIN
|
||||
94270 INPT := PARSIN;
|
||||
94280 PTR := PLINPQ; NEW(PLINPQ);
|
||||
94290 WITH PLINPQ^ DO
|
||||
94300 BEGIN LINK := PTR; DATA1 := INPT END;
|
||||
94310 ACTIONROUTINE := INPT^.LXV.LXIO = LXIOEQUAL
|
||||
94320 END;
|
||||
94330 (**)
|
||||
94340 7: (*AR7*)
|
||||
94350 (*TRUE IFF SEMANTIC CHECKING IS OFF*)
|
||||
94360 ACTIONROUTINE := ERRS>SEMERRS;
|
||||
94370 (**)
|
||||
94380 8: (*ERRX*)
|
||||
94390 (*INVOKED AFTER ERROR CORRECTING PRODUCTIONS HAVE FLUSHED THE SYNTAX STACK AND
|
||||
94400 INPUT STREAM TO A POINT WHERE IT IS DEEMED POSSIBLE TO CONTINUE NORMAL PARSING.
|
||||
94410 *)
|
||||
94420 BEGIN
|
||||
94430 FOR I := ERRPTR+1 TO ERRLXPTR DO ERRBUF[I] := ERRCHAR;
|
||||
94440 ERRPTR := ERRLXPTR;
|
||||
94450 ERRCHAR := ' ';
|
||||
94460 (*FIXUP BRACKET MISMATCHES*)
|
||||
94470 WITH INP^.LXV DO
|
||||
94480 IF (LXIO=LXIOOUSE) OR (LXIO=LXIOOUT) OR (LXIO=LXIOESAC) THEN FORCEMATCH(LEXCASE)
|
||||
94490 ELSE IF LXIO IN [LXIOELIF,LXIOELSE,LXIOFI] THEN FORCEMATCH(LEXIF)
|
||||
94500 ELSE IF (LXIO IN [LXIOCSTICK,LXIOAGAIN]) OR (LXIO=LXIOCSTICK) THEN
|
||||
94510 (*LXIONIL AND ABOVE ARE NOT ACCEPTABLE SET ELEMENTS IN CDC PASCAL*)
|
||||
94520 IF SRPLSTK[PLSTKP]^.LXV.LXIO<>LXIOBRINPT THEN FORCEMATCH(LEXBRTHPT)
|
||||
94530 ELSE (*NO ACTION*)
|
||||
94540 ELSE IF LXIO=LXIOCLOSE THEN FORCEMATCH(LEXOPEN)
|
||||
94550 ELSE IF LXIO=LXIOEND THEN FORCEMATCH(LEXBEGIN)
|
||||
94560 ELSE IF LXIO=LXIOOD THEN FORCEMATCH(LEXWHILE);
|
||||
94570 ACTIONROUTINE := TRUE
|
||||
94580 END;
|
||||
94590 (**)
|
||||
94622 9: (*INVOKED: AFTER A PRIMARY FOLLOWED BY OPEN.
|
||||
94624 FUNCTION: DETERMINES WHETHER IT IS START OF CALL OR SLICE.
|
||||
94626 VALUE: TRUE IFF CALL*)
|
||||
94628 IF (ERRS-SEMERRS)=0 THEN
|
||||
94630 BEGIN
|
||||
94632 M := COMEEK(BALANCE(STRMEEK));
|
||||
94634 IF M^.MDV.MDID IN [MDIDPASC,MDIDPROC] THEN
|
||||
94635 BEGIN SEMANTICROUTINE(76); ACTIONROUTINE := TRUE END
|
||||
94636 ELSE ACTIONROUTINE := FALSE;
|
||||
94637 END
|
||||
94638 ELSE ACTIONROUTINE := FALSE;
|
||||
94640 END;
|
||||
94642 END;
|
||||
94650 (**)
|
||||
94660 (**)
|
||||
94670 PROCEDURE INITPR;
|
||||
94680 (*FUNCTION: PERFORMS PER-COMPILATION INITIALIZATION REQUIRED BY
|
||||
94690 THE PARSING ROUTINES.
|
||||
94700 *)
|
||||
94710 BEGIN
|
||||
94720 PLINPQ := NIL;
|
||||
94730 PLPTR := 1;
|
||||
94740 SRPLSTK[SRPLSTKSIZE] := LEXSTOP;
|
||||
94750 SRPLSTK[SRPLSTKSIZE-1] := LEXSTOP;
|
||||
94760 PLSTKP := SRPLSTKSIZE-1;
|
||||
94770 ENDOFPROG := FALSE;
|
||||
94780 INP := LEXSTART
|
||||
94790 END;
|
||||
94800 (**)
|
||||
94810 (**)
|
||||
94820 PROCEDURE PARSER;
|
||||
94830 (*FUNCTION: THIS IS THE PRODUCTION LANGUAGE PARSER. IT PERFORMS THE
|
||||
94840 SYNTAX ANALYSIS BY INTERPRETING PRODUCTION RULES FOR THE ALGOL 68 SUBLANGUAGE.
|
||||
94850 *)
|
||||
94860 VAR MATCH: BOOLEAN;
|
||||
94870 STK: PLEX;
|
||||
94880 I: INTEGER;
|
||||
94890 MATCHES, UNMATCHES: INTEGER;
|
||||
94900 (*HISTO: ARRAY [1..PRODLEN] OF INTEGER;*)
|
||||
94910 BEGIN
|
||||
94920 (*+22() PARSCLK := PARSCLK-CLOCK; ()+22*)
|
||||
94930 MATCHES := 0; UNMATCHES := 0;
|
||||
94940 WHILE NOT ENDOFPROG DO
|
||||
94950 BEGIN
|
||||
94960 WITH PRODTBL[PLPTR] DO
|
||||
94970 BEGIN
|
||||
94980 (*HISTO[PLPTR] := HISTO[PLPTR]+1;*)
|
||||
94990 MATCH := TRUE;
|
||||
95000 IF PRSTKA<3 THEN (*I.E. NOT ANY*)
|
||||
95010 BEGIN
|
||||
95020 STK := SRPLSTK[PLSTKP+PRSTKA];
|
||||
95030 CASE PRSTKC OF
|
||||
95040 S: MATCH := SYLXV.LX1IO = STK^.LXV.LXIO;
|
||||
95050 C0: MATCH := SYLXV.LX1CL0 = STK^.LXV.LXCLASS0;
|
||||
95060 C1: MATCH := SYLXV.LX1CL1 = STK^.LXV.LXCLASS1;
|
||||
95070 C2: MATCH := SYLXV.LX1CL2 = STK^.LXV.LXCLASS2
|
||||
95080 END
|
||||
95090 END;
|
||||
95100 IF MATCH THEN
|
||||
95110 CASE PRINPC OF
|
||||
95120 A: (*NO ACTION*);
|
||||
95130 S: MATCH := SYLXV.LX2IO = INP^.LXV.LXIO;
|
||||
95140 C0: MATCH := SYLXV.LX2CL0 = INP^.LXV.LXCLASS0;
|
||||
95150 C1: MATCH := SYLXV.LX2CL1 = INP^.LXV.LXCLASS1;
|
||||
95160 C2: MATCH := SYLXV.LX2CL2 = INP^.LXV.LXCLASS2;
|
||||
95170 SSA: MATCH := SYLXV.LX2IO = SRPLSTK[PLSTKP+1]^.LXV.LXIO
|
||||
95180 END;
|
||||
95190 IF MATCH THEN
|
||||
95200 IF RTN>FINISH THEN
|
||||
95210 IF ((ERRS-SEMERRS)=0) OR (RTN>=119 (*SR81*) ) THEN
|
||||
95220 BEGIN
|
||||
95230 (*PARSCLKS := PARSCLKS+1; SEMCLK := SEMCLK-CLOCK;*)
|
||||
95240 SEMANTICROUTINE(RTN);
|
||||
95250 (*SEMCLK := SEMCLK+CLOCK; SEMCLKS := SEMCLKS+1*)
|
||||
95260 END
|
||||
95270 ELSE (*NOTHING*)
|
||||
95280 ELSE IF RTN<>DUMMY THEN
|
||||
95290 MATCH := ACTIONROUTINE(RTN);
|
||||
95300 IF MATCH THEN
|
||||
95310 BEGIN
|
||||
95320 MATCHES := MATCHES+1;
|
||||
95330 (*
|
||||
95340 WRITELN(PLPTR:3, PLSTKP:3, ERRLXPTR:3);
|
||||
95350 *)
|
||||
95360 PLSTKP := PLSTKP+PRPOP;
|
||||
95370 IF PRPUSH<>LXIODUMMY THEN
|
||||
95380 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := PUSHTBL[PRPUSH] END;
|
||||
95390 IF PRSKIP THEN
|
||||
95400 BEGIN IF LEXLINE <> PREVLINE THEN CGFLINE;
|
||||
95410 INP := PARSIN END;
|
||||
95420 FOR I := 1 TO PRSCAN DO
|
||||
95430 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := INP;
|
||||
95440 IF LEXLINE <> PREVLINE THEN CGFLINE;
|
||||
95450 INP := PARSIN END;
|
||||
95460 PLPTR := SEXIT
|
||||
95470 END
|
||||
95480 ELSE
|
||||
95490 BEGIN PLPTR := FEXIT; UNMATCHES := UNMATCHES+1 END
|
||||
95500 END
|
||||
95510 END
|
||||
95520 (*+22() ; PARSCLK := PARSCLK+CLOCK; PARSCLKS := PARSCLKS+1; ()+22*)
|
||||
95530 (*WRITELN('MATCHES', MATCHES, ' UNMATCHES', UNMATCHES);*)
|
||||
95540 (*FOR I := 1 TO PRODLEN DO WRITELN(REMARKS, I, HISTO[I]);*)
|
||||
95550 END;
|
||||
95560 (**)
|
||||
95570 ()+82*)
|
||||
95580 (**)
|
||||
95590 (**)
|
||||
95592 PROCEDURE ABORT; EXTERN;
|
||||
95600 (**)
|
||||
95610 (*+80()
|
||||
95620 (**)
|
||||
95630 (*+01()
|
||||
95640 FUNCTION PFL: INTEGER;
|
||||
95650 (*OBTAIN FIELD LENGTH FROM GLOBAL P.FL*)
|
||||
95660 EXTERN;
|
||||
95670 (**)
|
||||
95680 (**)
|
||||
95690 FUNCTION PFREE: PINTEGER;
|
||||
95700 (*OBTAIN ADDRESS OF GLOBAL P.FREE*)
|
||||
95710 EXTERN;
|
||||
95720 (**)
|
||||
95730 (**)
|
||||
95740 (*$T-+)
|
||||
95750 (*+25() (*$T-+) ()+25*)
|
||||
95760 FUNCTION RESTORE(VAR START: INTEGER): INTEGER;
|
||||
95770 (*RESTORES STACK AND HEAP FROM FILE A68INIT.
|
||||
95780 START IS FIRST VARIABLE ON STACK TO BE RESTORED*)
|
||||
95790 CONST TWO30=10000000000B;
|
||||
95800 VAR STACKSTART, STACKLENGTH, HEAPLENGTH: INTEGER;
|
||||
95810 FRIG: RECORD CASE INTEGER OF
|
||||
95820 1:(INT: INTEGER); 2:(POINT: PINTEGER) END;
|
||||
95830 D: DUMPOBJ;
|
||||
95840 MASKM,MASKL: INTEGER;
|
||||
95850 I: INTEGER;
|
||||
95860 BEGIN
|
||||
95870 STACKSTART := GETX(0);
|
||||
95880 RESET(A68INIT);
|
||||
95890 IF EOF(A68INIT) THEN BEGIN WRITELN(' A68INIT NOT AVAILABLE, OR WRONG RFL'); RESTORE := 1 END
|
||||
95900 ELSE
|
||||
95910 BEGIN
|
||||
95920 READ(A68INIT, D.INT, D.MASK); STACKLENGTH := D.INT; HEAPLENGTH := D.MASK;
|
||||
95930 FIELDLENGTH := PFL-LOADMARGIN; (*BECAUSE THE LOADER CANNOT LOAD RIGHT UP TO THE FIELDLENGTH*)
|
||||
95940 HEAPSTART := FIELDLENGTH-HEAPLENGTH;
|
||||
95950 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO
|
||||
95960 BEGIN
|
||||
95970 READ(A68INIT, D.INT, D.MASK);
|
||||
95980 (*NOW WE HAVE TO MULTIPLY D.MASK BY HEAPSTART*)
|
||||
95990 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
|
||||
96000 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
|
||||
96010 D.INT := D.INT+MASKM*TWO30+MASKL;
|
||||
96020 FRIG.INT := I; FRIG.POINT^ := D.INT
|
||||
96030 END;
|
||||
96040 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO
|
||||
96050 BEGIN
|
||||
96060 READ(A68INIT, D.INT, D.MASK);
|
||||
96070 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30;
|
||||
96080 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART;
|
||||
96090 D.INT := D.INT+MASKM*TWO30+MASKL;
|
||||
96100 FRIG.INT := I; FRIG.POINT^ := D.INT
|
||||
96110 END;
|
||||
96120 FRIG.POINT := PFREE; FRIG.POINT^ := START;
|
||||
96130 RESTORE := 0
|
||||
96140 END
|
||||
96150 END;
|
||||
96160 (**)
|
||||
96170 (**)
|
||||
96190 PROCEDURE ACLOSE(VAR F: FYL); EXTERN;
|
||||
96200 (**)
|
||||
96210 (**)
|
||||
96220 FUNCTION INITINIT: INTEGER;
|
||||
96230 VAR WORD101: RECORD CASE INTEGER OF
|
||||
96240 1: (INT: INTEGER);
|
||||
96250 2: (REC: PACKED RECORD
|
||||
96260 WCS: 0..777777B;
|
||||
96270 FILLER: 0..77777777777777B
|
||||
96280 END)
|
||||
96290 END;
|
||||
96300 HWORD: RECORD CASE INTEGER OF
|
||||
96310 1: (INT: INTEGER);
|
||||
96320 2: (REC: PACKED RECORD
|
||||
96330 TABLE: 0..7777B; WC: 0..7777B;
|
||||
96340 FILLER: 0..777777777777B
|
||||
96350 END)
|
||||
96360 END;
|
||||
96370 I, J: INTEGER;
|
||||
96380 P: PINTEGER;
|
||||
96390 BEGIN
|
||||
96400 IF DUMPED=43 THEN (*WE ARE OBEYING THE DUMPED VERSION OF THE COMPILER*)
|
||||
96410 BEGIN
|
||||
96420 IF PFL-LOADMARGIN-ABSMARGIN>FIELDLENGTH THEN (*FIELDLENGTH HAS CHANGED SINCE DUMP*)
|
||||
96430 INITINIT := RESTORE(FIRSTSTACK)
|
||||
96440 ELSE INITINIT := 0;
|
||||
96450 SETB(4, HEAPSTART)
|
||||
96460 END
|
||||
96470 ELSE
|
||||
96480 BEGIN (*A DUMP MUST BE MADE*)
|
||||
96490 DUMPED := 43;
|
||||
96500 INITINIT := RESTORE(FIRSTSTACK);
|
||||
96510 REWRITE(LGO);
|
||||
96520 GETSEG(A68INIT); (*START OF A68SB*)
|
||||
96530 HWORD.INT := A68INIT^;
|
||||
96540 WHILE HWORD.REC.TABLE<>5400B DO
|
||||
96550 BEGIN GET(A68INIT);
|
||||
96560 WRITE(LGO, HWORD.INT);
|
||||
96570 FOR I := 1 TO HWORD.REC.WC DO (*COPY PRFX/LDSET TABLE*)
|
||||
96580 BEGIN READ(A68INIT, J); WRITE(LGO, J) END;
|
||||
96590 HWORD.INT := A68INIT^;
|
||||
96600 END;
|
||||
96610 WITH WORD101 DO (*MODIFY WORD 1 OF EACPM TABLE*)
|
||||
96620 BEGIN
|
||||
96630 P := ASPTR(101B);
|
||||
96640 INT := FIELDLENGTH;
|
||||
96650 REC.WCS := FIELDLENGTH-101B-LOADMARGIN;
|
||||
96660 P^ := INT;
|
||||
96670 P := ASPTR(104B);
|
||||
96680 P^ := FIELDLENGTH
|
||||
96690 END;
|
||||
96700 P := ASPTR(100B);
|
||||
96710 FOR I := 0 TO 8 DO (*WRITE EACPM TABLE FROM CORE*)
|
||||
96720 BEGIN
|
||||
96730 WRITE(LGO, P^);
|
||||
96740 P := ASPTR(ORD(P)+1);
|
||||
96750 GET(A68INIT)
|
||||
96760 END;
|
||||
96770 WHILE NOT EOS(A68INIT) DO (*COPY PROGRAM*)
|
||||
96780 BEGIN
|
||||
96790 READ(A68INIT, J); WRITE(LGO, J);
|
||||
96800 P := ASPTR(ORD(P)+1)
|
||||
96810 END;
|
||||
96820 WHILE ORD(P)<FIELDLENGTH DO (*WRITE STACK-HEAP*)
|
||||
96830 BEGIN
|
||||
96840 WRITE(LGO, P^);
|
||||
96850 P := ASPTR(ORD(P)+1)
|
||||
96860 END;
|
||||
96870 ABORT
|
||||
96880 END
|
||||
96890 END;
|
||||
96900 (**)
|
||||
96910 (**)
|
||||
96920 PROCEDURE LOADGO(VAR LGO: LOADFILE); EXTERN;
|
||||
96930 (**)
|
||||
96940 (**)
|
||||
96950 (*$E++)
|
||||
96960 PROCEDURE PASCPMD(VAR A: INTEGER; J,K,L,M: INTEGER; N: BOOLEAN;
|
||||
96970 VAR F: TEXT; VAR MSG: MESS);
|
||||
96980 (*TO CATCH NOS- AND PASCAL-DETECTED ERRORS*)
|
||||
96990 VAR I: INTEGER;
|
||||
97000 BEGIN
|
||||
97010 WRITELN(F);
|
||||
97020 I := 1;
|
||||
97030 REPEAT
|
||||
97040 WRITE(F, MSG[I]); I := I+1
|
||||
97050 UNTIL ORD(MSG[I])=0;
|
||||
97060 WRITELN(F);
|
||||
97070 ABORT
|
||||
97080 END;
|
||||
97090 ()+01*)
|
||||
97100 (**)
|
||||
97110 (**)
|
||||
97120 (**)
|
||||
97130 ()+80*)
|
||||
97140 (**)
|
||||
97150 (*-01() (*-03() (*-04()
|
||||
97160 FUNCTION GETADDRESS(VAR VARIABLE:INTEGER): ADDRINT; EXTERN;
|
||||
97170 (**)
|
||||
97180 PROCEDURE RESTORE(VAR START,FINISH: INTEGER);
|
||||
97190 VAR STACKSTART,STACKEND,GLOBALLENGTH,HEAPLENGTH,
|
||||
97191 HEAPSTART(*+19(),LENGTH,POINTER()+19*): ADDRINT;
|
||||
97195 I:INTEGER;
|
||||
97200 P: PINTEGER;
|
||||
97210 FRIG: RECORD CASE SEVERAL OF
|
||||
97220 1: (INT: ADDRINT);
|
||||
97221 2: (POINT: PINTEGER);
|
||||
97222 3: (PLEXP: PLEX);
|
||||
97223 (*+19() 4: (APOINT: ^ADDRINT); ()+19*)
|
||||
97230 (*-19()4,()-19*)5,6,7,8,9,10: ()
|
||||
97240 END;
|
||||
97250 D: RECORD INT,MASK: INTEGER END;
|
||||
97270 BEGIN
|
||||
97280 (*+05() OPENLOADFILE(A68INIT, 4, FALSE); ()+05*)
|
||||
97285 (*+02() RESET(A68INIT); ()+02*)
|
||||
97290 STACKSTART := GETADDRESS(START);
|
||||
97300 IF NOT EOF(A68INIT) THEN
|
||||
97310 BEGIN
|
||||
97320 READ(A68INIT,GLOBALLENGTH,HEAPLENGTH);
|
||||
97330 ENEW(FRIG.PLEXP, HEAPLENGTH);
|
||||
97340 HEAPSTART := FRIG.INT;
|
||||
97350 FRIG.INT := STACKSTART;
|
||||
97355 (*-19()
|
||||
97360 FOR I := 1 TO GLOBALLENGTH DIV SZWORD DO
|
||||
97370 BEGIN
|
||||
97380 READ(A68INIT,D.INT,D.MASK);
|
||||
97390 IF D.MASK=SZREAL THEN (*D.INT IS A POINTER OFFSET FROM HEAPSTART*)
|
||||
97400 D.INT := D.INT+HEAPSTART;
|
||||
97410 FRIG.POINT^ := D.INT;
|
||||
97420 FRIG.INT := FRIG.INT+SZWORD;
|
||||
97430 END;
|
||||
97440 FRIG.INT := HEAPSTART;
|
||||
97450 FOR I := 1 TO HEAPLENGTH DIV SZWORD DO
|
||||
97460 BEGIN
|
||||
97462 READ(A68INIT,D.INT,D.MASK);
|
||||
97464 IF D.MASK=SZREAL THEN
|
||||
97466 D.INT := D.INT+HEAPSTART;
|
||||
97468 FRIG.POINT^ := D.INT;
|
||||
97470 FRIG.INT := FRIG.INT+SZWORD
|
||||
97472 END
|
||||
97474 ()-19*)
|
||||
97479 (*+19()
|
||||
97480 LENGTH:=GLOBALLENGTH DIV SZWORD;
|
||||
97482 I:=1;
|
||||
97484 WHILE I<=LENGTH DO
|
||||
97486 BEGIN
|
||||
97488 READ(A68INIT,D.MASK);
|
||||
97490 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
|
||||
97492 BEGIN
|
||||
97494 READ(A68INIT,POINTER);
|
||||
97496 POINTER:=POINTER+HEAPSTART;
|
||||
97498 FRIG.APOINT^:=POINTER;
|
||||
97500 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
|
||||
97502 I:=I+2
|
||||
97504 END
|
||||
97506 ELSE
|
||||
97508 BEGIN
|
||||
97510 READ(A68INIT,D.INT);
|
||||
97511 FRIG.POINT^:=D.INT;
|
||||
97512 FRIG.INT:=FRIG.INT+SZWORD;
|
||||
97513 I:=I+1
|
||||
97514 END
|
||||
97515 END;
|
||||
97516 LENGTH:=HEAPLENGTH DIV SZWORD;
|
||||
97517 FRIG.INT:=HEAPSTART;
|
||||
97518 I:=1;
|
||||
97519 WHILE I<=LENGTH DO
|
||||
97520 BEGIN
|
||||
97521 READ(A68INIT,D.MASK);
|
||||
97522 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*)
|
||||
97523 BEGIN
|
||||
97524 READ(A68INIT,POINTER);
|
||||
97525 POINTER:=POINTER+HEAPSTART;
|
||||
97526 FRIG.APOINT^:=POINTER;
|
||||
97527 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *)
|
||||
97528 I:=I+2
|
||||
97529 END
|
||||
97530 ELSE
|
||||
97531 BEGIN
|
||||
97532 READ(A68INIT,D.INT);
|
||||
97533 FRIG.POINT^:=D.INT;
|
||||
97534 FRIG.INT:=FRIG.INT+SZWORD;
|
||||
97535 I:=I+1
|
||||
97536 END
|
||||
97537 END
|
||||
97538 ()+19*)
|
||||
97539 END
|
||||
97540 END;
|
||||
97550 ()-04*) ()-03*) ()-01*)
|
||||
97560 (**)
|
||||
97570 (*+82()
|
||||
97580 (**)
|
||||
97590 (*THE COMPILER*)
|
||||
97600 (**************)
|
||||
97610 (**)
|
||||
97630 PROCEDURE ALGOL68;
|
||||
97640 BEGIN
|
||||
97650 (*+01()
|
||||
97660 CPUCLK := -CLOCK;
|
||||
97670 (*+22() CPUCLK := -CLOCK; PARSCLK := 0; LXCLOCK := 0; SEMCLK := 0; EMITCLK := 0;
|
||||
97680 CPUCLKS := 0; PARSCLKS := 0; LXCLOCKS := 0; SEMCLKS := 0; EMITCLKS := 0; ()+22*)
|
||||
97690 WARNS := INITINIT;
|
||||
97700 ()+01*)
|
||||
97710 (*+25() WARNS := INITINIT; ()+25*)
|
||||
97720 ERRS := 0; SEMERRS := 0;
|
||||
97730 (*+03()
|
||||
97740 CLOSE(SOURCDECS);
|
||||
97750 CLOSE(LSTFILE);
|
||||
97760 CLOSE(OUTPUT);
|
||||
97770 RESTARTHERE;
|
||||
97780 CPUTIME(CPUCLK);
|
||||
97790 ()+03*)
|
||||
97800 (*-01() (*-03() (*-04() (*-25() RESTORE(FIRSTSTACK,LASTSTACK); ()-25*) ()-04*) ()-03*) ()-01*)
|
||||
97810 INITIO;
|
||||
97820 INITLX;
|
||||
97830 INITPR;
|
||||
97840 INITSR;
|
||||
97850 (*+01()
|
||||
97860 SETPARAM(' ', 0); (*FOR DEFAULT GO*)
|
||||
97870 ()+01*)
|
||||
97880 PARSER;
|
||||
97890 (*+01() (*+22() EMITCLK := EMITCLK-EMITCLKS DIV 6;
|
||||
97900 SEMCLK := SEMCLK-(SEMCLKS+EMITCLKS) DIV 6;
|
||||
97910 LXCLOCK := LXCLOCK-LXCLOCKS DIV 6;
|
||||
97920 PARSCLK := PARSCLK-(PARSCLKS+LXCLOCKS+SEMCLKS+EMITCLKS) DIV 6;
|
||||
97930 CPUCLK := CPUCLK-(PARSCLKS+LXCLOCKS+SEMCLKS+EMITCLKS) DIV 6;
|
||||
97940 WRITELN(' CPU', (CPUCLK+CLOCK)/1000:6:3,
|
||||
97950 ' PAR', (PARSCLK-LXCLOCK-SEMCLK)/1000:6:3,
|
||||
97960 ' LEX', LXCLOCK/1000:6:3,
|
||||
97970 ' SEM', (SEMCLK-EMITCLK)/1000:6:3,
|
||||
97980 ' EMIT', EMITCLK/1000:6:3); ()+22*) ()+01*)
|
||||
97990 (*+01()
|
||||
98000 IF LSTPAGE<>0 THEN
|
||||
98010 IF ONLINE THEN WRITELN(LSTFILE, ' ', 'CPU', (CPUCLK+CLOCK)/1000:6:3)
|
||||
98020 ELSE WRITELN(' ', 'CPU', (CPUCLK+CLOCK)/1000:6:3);
|
||||
98030 IF ERRS<>0 THEN BEGIN MESSAGE('BAD PROGRAM - ABORTED'); ACLOSE(OUTPUT); ABORT END
|
||||
98040 ELSE IF PRGGO IN PRAGFLGS THEN
|
||||
98050 BEGIN
|
||||
98060 PUTSEG(LGO);
|
||||
98070 IF ONLINE AND (LSTPAGE<>0) THEN ACLOSE(LSTFILE);
|
||||
98080 IF (WARNS<>0) OR NOT ONLINE AND (LSTPAGE<>0) THEN ACLOSE(OUTPUT);
|
||||
98090 LOADGO(LGO)
|
||||
98100 END
|
||||
98110 ELSE MESSAGE('NO ERRORS');
|
||||
98120 ()+01*)
|
||||
98130 (*+03()
|
||||
98140 CPUTIME(CPUCLK);
|
||||
98150 IF LSTPAGE<>0 THEN
|
||||
98160 IF ONLINE THEN WRITELN(LSTFILE, ' ', 'CPU', CPUCLK:4, 'SECS')
|
||||
98170 ELSE WRITELN(' ', 'CPU', CPUCLK:4, ' SECS');
|
||||
98180 IF ERRS<>0 THEN WRITELN(' ', 'ERRORS DETECTED')
|
||||
98190 ELSE WRITELN(' ', 'NO ERRORS');
|
||||
98200 CLOSE(SOURCDECS);
|
||||
98210 CLOSE(LSTFILE);
|
||||
98220 CLOSE(OUTPUT);
|
||||
98230 ()+03*)
|
||||
98232 (*+05()
|
||||
98234 IF ERRS<>0 THEN BEGIN WRITELN(ERROR); WRITELN(ERROR, 'BAD PROGRAM - ABORTED'); ABORT END;
|
||||
98236 ()+05*)
|
||||
98237 (*+02()
|
||||
98238 IF ERRS<>0 THEN BEGIN WRITELN; WRITELN('BAD PROGRAM - ABORTED'); ABORT END;
|
||||
98239 ()+02*)
|
||||
98240 END;
|
||||
98260 (**)
|
||||
98270 (**)
|
||||
98280 (*+01() (*$P++) (*SO THAT IT KNOWS ABOUT PASCPMD*) ()+01*)
|
||||
98290 (*+04() PROCEDURE S1; ()+04*)
|
||||
98300 (*+25() (*$P++) ()+25*)
|
||||
98310 (*-03()(*+71()
|
||||
98320 BEGIN
|
||||
98330 ALGOL68
|
||||
98340 (*+01() (*-31() (*$P-+) ()-31*) ()+01*)
|
||||
98350 (*+25() (*-31() (*$P-+) ()-31*) ()+25*)
|
||||
98360 END (*+01() (*$G-+) ()+01*)(*+25() (*$G-+) ()+25*).
|
||||
98370 ()+71*)()-03*)
|
||||
98380 ()+82*)
|
||||
1220
lang/a68s/aem/a68s1s1.p
Normal file
1220
lang/a68s/aem/a68s1s1.p
Normal file
File diff suppressed because it is too large
Load diff
1060
lang/a68s/aem/a68s1s2.p
Normal file
1060
lang/a68s/aem/a68s1s2.p
Normal file
File diff suppressed because it is too large
Load diff
600
lang/a68s/aem/a68scod.p
Normal file
600
lang/a68s/aem/a68scod.p
Normal file
|
|
@ -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*)
|
||||
1262
lang/a68s/aem/a68sdec.p
Normal file
1262
lang/a68s/aem/a68sdec.p
Normal file
File diff suppressed because it is too large
Load diff
282
lang/a68s/aem/a68sdum.p
Normal file
282
lang/a68s/aem/a68sdum.p
Normal file
|
|
@ -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*)
|
||||
802
lang/a68s/aem/a68sin.p
Normal file
802
lang/a68s/aem/a68sin.p
Normal file
|
|
@ -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*)
|
||||
32
lang/a68s/aem/a68sint.p
Normal file
32
lang/a68s/aem/a68sint.p
Normal file
|
|
@ -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*)
|
||||
583
lang/a68s/aem/a68spar.p
Normal file
583
lang/a68s/aem/a68spar.p
Normal file
|
|
@ -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.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
|
||||
51500 SEXIT := LXV.LXP
|
||||
51510 ELSE
|
||||
51520 BEGIN
|
||||
51530 IF LXV.LXPSTB=NIL THEN
|
||||
51540 BEGIN
|
||||
51550 CCOUNT:=CCOUNT+1; LXV.LXP:=PRODLEN+CCOUNT;
|
||||
51560 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
|
||||
51570 END;
|
||||
51580 TEMP:=LXV.LXP-PRODLEN;
|
||||
51590 SEXIT:=SEXFR[TEMP]; SEXFR[TEMP]:=BCOUNT
|
||||
51600 END;
|
||||
51610 29: (*SR16A*) (*FEX*)
|
||||
51620 IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
|
||||
51630 FEXIT := INP^.LXV.LXP
|
||||
51640 ELSE
|
||||
51650 BEGIN
|
||||
51660 IF INP^.LXV.LXPSTB=NIL THEN
|
||||
51670 BEGIN
|
||||
51680 CCOUNT:=CCOUNT+1; INP^.LXV.LXP:=PRODLEN+CCOUNT;
|
||||
51690 SEXFR[CCOUNT]:=0; FEXFR[CCOUNT]:=0
|
||||
51700 END;
|
||||
51710 TEMP:=INP^.LXV.LXP-PRODLEN;
|
||||
51720 FEXIT:=FEXFR[TEMP];FEXFR[TEMP]:=BCOUNT
|
||||
51730 END;
|
||||
51740 30: (*SR16B*) (*FEX ABSENT*)
|
||||
51750 FEXIT := BCOUNT+1;
|
||||
51760 31: (*SR16C*) (*END OF RULE*)
|
||||
51770 BCOUNT := BCOUNT+1;
|
||||
51780 32: (*SR16D*) (*ERROR*)
|
||||
51790 OUTERR(ELX+7, ERRORR, NIL);
|
||||
51800 34: (*SR20A*) (*AT LABEL*)
|
||||
51810 BEGIN
|
||||
51820 IF LXV.LXPSTB<>NIL THEN
|
||||
51830 BEGIN
|
||||
51840 TEMP:=LXV.LXP-PRODLEN;
|
||||
51850 LABL(SEXFR[TEMP],FEXFR[TEMP],BCOUNT);
|
||||
51860 SEXFR[TEMP]:=0; FEXFR[TEMP]:=0;
|
||||
51870 WHILE (CCOUNT>0) AND (SEXFR[CCOUNT]=0) AND (FEXFR[CCOUNT]=0)
|
||||
51880 DO CCOUNT:=CCOUNT-1
|
||||
51890 END;
|
||||
51900 LXV.LXP := BCOUNT END;
|
||||
51910 36: (*SR20C*) (*END OF FILE*)
|
||||
51920 ENDOFPROG := TRUE;
|
||||
51930 END
|
||||
51940 END;
|
||||
51950 ()+82*)
|
||||
51960 (*OLD VERSION OF SEMANTICROUTINE WHICH WAS USED TO PRODUCE THE CALLS OF MPROD AND BLABL WHICH FOLLOW*)
|
||||
51970 (*
|
||||
51980 PROCEDURE SEMANTICROUTINE(SRTN: RTNTYPE);
|
||||
51990 VAR C: INTEGER;
|
||||
52000 SAR: CHAR;
|
||||
52010 BEGIN WITH SRPLSTK[PLSTKP]^ DO CASE SRTN OF
|
||||
52020 10: (*SR01+) BEGIN WRITE(LSTFILE, ' BMPROD(', BCOUNT:3, ', '); ACOUNT:=0; END;
|
||||
52030 11: (*SR02+): IF ACOUNT<>1 THEN WRITE(LSTFILE, 'S , LXIO', S1, ', 0, ')
|
||||
52040 ELSE BEGIN WRITE(LSTFILE, '2, SSA,LXIO', S1, ', 0, '); ACOUNT:=-99 END;
|
||||
52050 12: (*SR03A+) BEGIN C := ORD(S1[4])-ORD('0');
|
||||
52060 IF (C<0) OR (C>9) THEN C := ORD(S1[4])-ORD('A')+10;
|
||||
52070 IF S1[1]='C' THEN WRITE(LSTFILE, 'C', S1[3], ', LXIODUMMY , ', C:2, ', ') END;
|
||||
52080 35: (*SR20B+) IF ACOUNT=-1 THEN WRITE(LSTFILE, 'A , LXIODUMMY , 0, ');
|
||||
52090 13: (*SR03B+) BEGIN ACOUNT:=-1; WRITE(LSTFILE, 'S , LXIODUMMY , 0, 3, ') END;
|
||||
52100 14: (*SR04A+) ACOUNT := ACOUNT+1;
|
||||
52110 15: (*SR04B+) IF ACOUNT>=0 THEN
|
||||
52120 BEGIN WRITE(LSTFILE, ACOUNT:1, ', '); ACOUNT:=-1 END;
|
||||
52130 16: (*SR05+) BEGIN SAE := SRPLSTK[PLSTKP].S1[1];
|
||||
52140 IF (SAE='S') OR (SAE = 'A') THEN C:=0
|
||||
52150 ELSE IF SAE='E' THEN C:=ESY01-1
|
||||
52160 ELSE SEMERR(ESE+16);
|
||||
52170 WRITE(LSTFILE,C+INP^.LXDENRP:4)
|
||||
52180 END;
|
||||
52190 17: (*SR06+) WRITE(LSTFILE, 'DUMMY , ');
|
||||
52200 18: (*SR07A+) WRITE(LSTFILE, INP^.LXDENRP:1, ', ');
|
||||
52210 19: (*SR07B+) WRITE(LSTFILE, '0, LXIODUMMY , ');
|
||||
52220 20: (*SR08A+) WRITE(LSTFILE, 'LXIO', INP^.S1, ', ');
|
||||
52230 21: (*SR08B+) WRITE(LSTFILE, 'LXIODUMMY , ');
|
||||
52240 22: (*SR10+) WRITE(LSTFILE, 'TRUE , ');
|
||||
52250 23: (*SR11+) WRITE(LSTFILE, 'FALSE, ');
|
||||
52260 24: (*SR12+) WRITE(LSTFILE, '2, ');
|
||||
52270 25: (*SR14A+) WRITE(LSTFILE, '1, ');:
|
||||
52280 26: (*SR14B+) WRITE(LSTFILE, '0, ');:
|
||||
52290 28: (*SR15+) IF (LXV.LXP<PRODLEN) AND (LXV.LXPSTB<>NIL) THEN
|
||||
52300 WRITE(LSTFILE, LXV.LXP:4, ', ')
|
||||
52310 ELSE BEGIN
|
||||
52320 IF LXV.LXPSTB=NIL THEN BEGIN LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
|
||||
52330 WRITE(LSTFILE, -(LXV.LXP DIV PRODLEN-1):4, ', ');
|
||||
52340 LXV.LXP := LXV.LXP MOD PRODLEN + (BCOUNT+1)*PRODLEN END;
|
||||
52350 29: (*SR16A+) IF (INP^.LXV.LXP<PRODLEN) AND (INP^.LXV.LXPSTB<>NIL) THEN
|
||||
52360 WRITE(LSTFILE, INP^.LXV.LXP:4)
|
||||
52370 ELSE BEGIN
|
||||
52380 IF INP^.LXV.LXPSTB=NIL THEN BEGIN INP^.LXV.LXP := PRODLEN; CCOUNT := CCOUNT+1 END;
|
||||
52390 WRITE(LSTFILE, -(INP^.LXV.LXP MOD PRODLEN):4);
|
||||
52400 INP^.LXV.LXP := INP^.LXV.LXP DIV PRODLEN * PRODLEN + BCOUNT END;
|
||||
52410 30: (*SR16B+) WRITE(LSTFILE, BCOUNT+1:4);
|
||||
52420 31: (*SR16C+) BEGIN WRITELN(LSTFILE,');'); BCOUNT := BCOUNT+1; END;
|
||||
52430 32: (*SR16D+) OUTERR(ELX+7, ERRORR, NIL);
|
||||
52440 34: (*SR20A+) BEGIN
|
||||
52450 IF LXV.LXPSTB<>NIL THEN BEGIN
|
||||
52460 WRITELN(LSTFILE, ' BLABL(', LXV.LXP DIV PRODLEN - 1:3, ', ',
|
||||
52470 LXV.LXP MOD PRODLEN:3, ', ', BCOUNT:3, ');');
|
||||
52480 CCOUNT := CCOUNT-1;
|
||||
52490 END;
|
||||
52500 LXV.LXP := BCOUNT END;
|
||||
52510 36: (*SR20C+) ENDOFPROG := TRUE;
|
||||
52520 END
|
||||
52530 END;
|
||||
52540 *)
|
||||
52550 (*+82()
|
||||
52560 PROCEDURE INITPR;
|
||||
52570 BEGIN
|
||||
52580 PLINPQ := NIL;
|
||||
52590 PLPTR := 1;
|
||||
52600 SRPLSTK[SRPLSTKSIZE] := LEXSTOP;
|
||||
52610 SRPLSTK[SRPLSTKSIZE-1] := LEXSTOP;
|
||||
52620 PLSTKP := SRPLSTKSIZE-1;
|
||||
52630 ENDOFPROG := FALSE;
|
||||
52640 INP := LEXSTART
|
||||
52650 END;
|
||||
52660 PROCEDURE BMPROD(PTR: INTEGER;
|
||||
52670 CONFIG1: CONFIG; IO1: LXIOTYPE; CLA1: CL2TYPE; STKA: INTEGER;
|
||||
52680 CONFIG2: CONFIG; IO2: LXIOTYPE; CLA2: CL2TYPE;
|
||||
52690 SRTN: RTNTYPE; POP: INTEGER; PUSH: LXIOTYPE; SKIP: BOOLEAN; SCAN: INTEGER; SEX, FEX: INTEGER);
|
||||
52700 BEGIN WITH BPRODTBL[PTR] DO
|
||||
52710 BEGIN
|
||||
52720 PRSTKA := STKA; PRSTKC := CONFIG1; PRINPC := CONFIG2;
|
||||
52730 CASE CONFIG1 OF S: SYLXV.LX1IO := IO1;
|
||||
52740 C0: SYLXV.LX1CL0 := CLA1; C1: SYLXV.LX1CL1 := CLA1; C2: SYLXV.LX1CL2 := CLA1 END;
|
||||
52750 CASE CONFIG2 OF S, A, SSA: SYLXV.LX2IO := IO2;
|
||||
52760 C0: SYLXV.LX2CL0 := CLA2; C1: SYLXV.LX2CL1 := CLA2; C2: SYLXV.LX2CL2 := CLA2 END;
|
||||
52770 RTN := SRTN; PRPOP := POP; PRPUSH := PUSH; PRSKIP := SKIP; PRSCAN := SCAN;
|
||||
52780 SEXIT := ABS(SEX); FEXIT := ABS(FEX);
|
||||
52790 END
|
||||
52800 END;
|
||||
52810 PROCEDURE BLABL(SEX, FEX, VALUE: INTEGER);
|
||||
52820 VAR TEMP: INTEGER;
|
||||
52830 BEGIN
|
||||
52840 WHILE SEX<>0 DO
|
||||
52850 BEGIN TEMP := BPRODTBL[SEX].SEXIT; BPRODTBL[SEX].SEXIT := VALUE; SEX := TEMP END;
|
||||
52860 WHILE FEX<>0 DO
|
||||
52870 BEGIN TEMP := BPRODTBL[FEX].FEXIT; BPRODTBL[FEX].FEXIT := VALUE; FEX := TEMP END
|
||||
52880 END;
|
||||
52890 PROCEDURE PARSER;
|
||||
52900 VAR MATCH: BOOLEAN;
|
||||
52910 STK: PLEX;
|
||||
52920 I: INTEGER;
|
||||
52930 BEGIN
|
||||
52940 WHILE NOT ENDOFPROG DO
|
||||
52950 WITH BPRODTBL[PLPTR] DO
|
||||
52960 BEGIN
|
||||
52970 MATCH := TRUE;
|
||||
52980 IF PRSTKA<3 THEN
|
||||
52990 BEGIN
|
||||
53000 STK := SRPLSTK[PLSTKP+PRSTKA];
|
||||
53010 CASE PRSTKC OF
|
||||
53020 S: MATCH := SYLXV.LX1IO = STK^.LXV.LXIO;
|
||||
53030 C0: MATCH := SYLXV.LX1CL0 = STK^.LXV.LXCLASS0;
|
||||
53040 C1: MATCH := SYLXV.LX1CL1 = STK^.LXV.LXCLASS1;
|
||||
53050 C2: MATCH := SYLXV.LX1CL2 = STK^.LXV.LXCLASS2
|
||||
53060 END
|
||||
53070 END;
|
||||
53080 IF MATCH THEN
|
||||
53090 CASE PRINPC OF
|
||||
53100 A: ;
|
||||
53110 S: MATCH := SYLXV.LX2IO = INP^.LXV.LXIO;
|
||||
53120 C0: MATCH := SYLXV.LX2CL0 = INP^.LXV.LXCLASS0;
|
||||
53130 C1: MATCH := SYLXV.LX2CL1 = INP^.LXV.LXCLASS1;
|
||||
53140 C2: MATCH := SYLXV.LX2CL2 = INP^.LXV.LXCLASS2;
|
||||
53150 SSA: MATCH := SYLXV.LX2IO = SRPLSTK[PLSTKP+1]^.LXV.LXIO
|
||||
53160 END;
|
||||
53170 IF MATCH THEN
|
||||
53180 IF RTN>FINISH THEN
|
||||
53190 SEMANTICROUTINE(RTN);
|
||||
53200 IF MATCH THEN
|
||||
53210 BEGIN
|
||||
53220 PLSTKP := PLSTKP+PRPOP;
|
||||
53230 IF PRPUSH<>LXIODUMMY THEN
|
||||
53240 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := PUSHTBL[PRPUSH] END;
|
||||
53250 IF PRSKIP THEN
|
||||
53260 INP := PARSIN;
|
||||
53270 FOR I := 1 TO PRSCAN DO
|
||||
53280 BEGIN PLSTKP := PLSTKP-1; SRPLSTK[PLSTKP] := INP; INP := PARSIN END;
|
||||
53290 PLPTR := SEXIT
|
||||
53300 END
|
||||
53310 ELSE
|
||||
53320 PLPTR := FEXIT
|
||||
53330 END
|
||||
53340 END;
|
||||
53350 (*+01() (*$T-+) ()+01*)
|
||||
53360 (*+25() (*$T-+) ()+25*)
|
||||
53370 PROCEDURE CLASSES;
|
||||
53380 BEGIN
|
||||
53390 HTCOPY := HT;
|
||||
53400 (*+01() ENEW(FRED, SZWORD); (*TO MARK THE PRESENT HEAP LIMIT*) ()+01*)
|
||||
53410 CLASS('CL00 '); CLASS('CL01 ');
|
||||
53420 CLASS('CL10 '); CLASS('CL11 ');
|
||||
53430 CLASS('CL12 '); CLASS('CL13 ');
|
||||
53440 CLASS('CL14 ');
|
||||
53450 CLASS('CL20 '); CLASS('CL21 ');
|
||||
53460 CLASS('CL22 '); CLASS('CL23 ');
|
||||
53470 CLASS('CL24 '); CLASS('CL25 ');
|
||||
53480 CLASS('CL26 '); CLASS('CL27 ');
|
||||
53490 CLASS('CL28 '); CLASS('CL29 ');
|
||||
53500 CLASS('CL2A '); CLASS('CL2B ');
|
||||
53510 CLASS('CL2C '); CLASS('CL2D ');
|
||||
53520 CLASS('CL2E '); CLASS('CL2F ');
|
||||
53530 CLASS('ANY ');
|
||||
53540 END;
|
||||
53550 PROCEDURE TLEXS;
|
||||
53560 BEGIN
|
||||
53570 TLEX('ACTPL ', LXIOACTPL);
|
||||
53580 TLEX('ACTRL ', LXIOACTRL);
|
||||
53590 TLEX('BOUNDS ', LXIOBOUNDS);
|
||||
53600 TLEX('BRINPT ', LXIOBRINPT);
|
||||
53610 TLEX('BRTHPT ', LXIOBRTHPT);
|
||||
53620 TLEX('CSTICK ', LXIOCSTICK);
|
||||
53630 TLEX('DCLL ', LXIODCLL);
|
||||
53640 TLEX('FLDSPL ', LXIOFLDSPL);
|
||||
53650 TLEX('FORDCL ', LXIOFORDCL);
|
||||
53660 TLEX('FORRLB ', LXIOFORRLB);
|
||||
53670 TLEX('IDEFL ', LXIOIDEFL);
|
||||
53680 TLEX('LABSQ ', LXIOLABSQ);
|
||||
53690 TLEX('MOIDDR ', LXIOMOIDDR);
|
||||
53700 TLEX('NONRDR ', LXIONONRDR);
|
||||
53710 TLEX('ODEFL ', LXIOODEFL);
|
||||
53720 TLEX('OPRAND ', LXIOOPRAND);
|
||||
53730 TLEX('PRIM ', LXIOPRIM);
|
||||
53740 TLEX('PRMDRL ', LXIOPRMDRL);
|
||||
53750 TLEX('RIDEFL ', LXIORIDEFL);
|
||||
53760 TLEX('RODEFL ', LXIORODEFL);
|
||||
53770 TLEX('RSPEC ', LXIORSPEC);
|
||||
53780 TLEX('RVDEFL ', LXIORVDEFL);
|
||||
53790 TLEX('TERT ', LXIOTERT);
|
||||
53800 TLEX('TRMSCL ', LXIOTRMSCL);
|
||||
53810 TLEX('UNITLC ', LXIOUNLC);
|
||||
53820 TLEX('UNITLP ', LXIOUNLP);
|
||||
53830 TLEX('UNITSR ', LXIOUNSR);
|
||||
53840 TLEX('VDEFL ', LXIOVDEFL);
|
||||
53850 TLEX('AGAIN ', LXIOAGAIN);
|
||||
53860 TLEX('AT ', LXIOAT);
|
||||
53870 TLEX('BEGIN ', LXIOBEGIN);
|
||||
53880 TLEX('BOOLDEN ', LXIOBOOLDEN);
|
||||
53890 TLEX('BUS ', LXIOBUS);
|
||||
53900 TLEX('BY ', LXIOBY);
|
||||
53910 TLEX('CASE ', LXIOCASE);
|
||||
53920 TLEX('COMMA ', LXIOCOMMA);
|
||||
53930 TLEX('COMMENT ', LXIOCMMENT);
|
||||
53940 TLEX('DO ', LXIODO);
|
||||
53950 TLEX('ELIF ', LXIOELIF);
|
||||
53960 TLEX('ELSE ', LXIOELSE);
|
||||
53970 TLEX('END ', LXIOEND);
|
||||
53980 TLEX('ERROR ', LXIOERROR);
|
||||
53990 TLEX('ESAC ', LXIOESAC);
|
||||
54000 TLEX('EXIT ', LXIOEXIT);
|
||||
54010 TLEX('FI ', LXIOFI);
|
||||
54020 TLEX('FOR ', LXIOFOR);
|
||||
54030 TLEX('FROM ', LXIOFROM);
|
||||
54040 TLEX('GO ', LXIOGO);
|
||||
54050 TLEX('GOTO ', LXIOGOTO);
|
||||
54060 TLEX('HEAP ', LXIOHEAP);
|
||||
54070 TLEX('IDTY ', LXIOIDTY);
|
||||
54080 TLEX('IF ', LXIOIF);
|
||||
54090 TLEX('IN ', LXIOIN);
|
||||
54100 TLEX('LOC ', LXIOLOC);
|
||||
54110 TLEX('LONG ', LXIOLONG);
|
||||
54120 TLEX('MDIND ', LXIOMDIND);
|
||||
54130 TLEX('MODE ', LXIOMODE);
|
||||
54140 TLEX('NIL ', LXIONIL);
|
||||
54150 TLEX('OD ', LXIOOD);
|
||||
54160 TLEX('OF ', LXIOOF);
|
||||
54170 TLEX('OP ', LXIOOP);
|
||||
54180 TLEX('OPR ', LXIOOPR);
|
||||
54190 TLEX('OTHDR ', LXIOOTHDR);
|
||||
54200 TLEX('OUSE ', LXIOOUSE);
|
||||
54210 TLEX('OUT ', LXIOOUT);
|
||||
54220 TLEX('PRAGMAT ', LXIOPRAGMAT);
|
||||
54230 TLEX('PRIMDR ', LXIOPRDR);
|
||||
54240 TLEX('PRIO ', LXIOPRIO);
|
||||
54250 TLEX('PROC ', LXIOPROC);
|
||||
54260 TLEX('REF ', LXIOREF);
|
||||
54270 TLEX('SHORT ', LXIOSHORT);
|
||||
54280 TLEX('SKIP ', LXIOSKIP);
|
||||
54290 TLEX('START ', LXIOSTART);
|
||||
54300 TLEX('STICK ', LXIOSTICK);
|
||||
54310 TLEX('STRGDEN ', LXIOSTRGDEN);
|
||||
54320 TLEX('STRUCT ', LXIOSTRUCT);
|
||||
54330 TLEX('SUB ', LXIOSUB);
|
||||
54340 TLEX('TAB ', LXIOTAB);
|
||||
54350 TLEX('TAG ', LXIOTAG);
|
||||
54360 TLEX('THEN ', LXIOTHEN);
|
||||
54370 TLEX('TO ', LXIOTO);
|
||||
54380 TLEX('VOID ', LXIOVOID);
|
||||
54390 TLEX('WHILE ', LXIOWHILE);
|
||||
54400 TLEX('BECOM ', LXIOBECOM);
|
||||
54410 TLEX('CLOSE ', LXIOCLOSE);
|
||||
54420 TLEX('COLON ', LXIOCOLON);
|
||||
54430 TLEX('EQUAL ', LXIOEQUAL);
|
||||
54440 TLEX('OPEN ', LXIOOPEN);
|
||||
54450 TLEX('PRIMDEN ', LXIOPRDEN);
|
||||
54460 TLEX('SEMIC ', LXIOSEMIC);
|
||||
54470 TLEX('STOP ', LXIOSTOP);
|
||||
54480 END;
|
||||
54490 (*+01() (*+31() (*$T++) ()+31+) ()+01*)
|
||||
54500 (*+25() (*+31() (*$T++) ()+31+) ()+25*)
|
||||
54510 BEGIN (*PARSEPARSER*)
|
||||
54520 CLASSES;
|
||||
54530 TLEXS;
|
||||
54540 (*FLOYD PRODUCTION RULES WHICH WERE USED WITH THE OLD VERSION OF SEMANTICROUTINE GIVEN ABOVE
|
||||
54550 TO PRODUCE THE CALLS OF BMPROD AND BLABL WHICH FOLLOW*)
|
||||
54560 (*
|
||||
54570 BEGIN: ! => , ! + INIT;
|
||||
54580 INIT: ! => , ! + PRODRL;
|
||||
54590 PRODRL: STOP@! => 36 ,1-> ! APRODRL;
|
||||
54600 APRODRL: TAG@!COLON@ => 34 ,1-> ! (1) + ALABEL;
|
||||
54610 ALABEL: ! => 10 , ! BLABEL;
|
||||
54620 BLABEL: TAG@!AT@ => 11 ,1-> ! (1) COMMA;
|
||||
54630 TAB@! => 12 ,1-> ! COMMA;
|
||||
54640 TAG@! => 11 ,1-> ! COMMA;
|
||||
54650 STICK@! => 13 ,1-> ! + ASTICK,ERROR;
|
||||
54660 COMMA: !COMMA@ => 14 , ! (1) + BLABEL;
|
||||
54670 STICK: !STICK@ => 15 , ! (1) + ASTICK,ERROR;
|
||||
54680 ASTICK: TAG@!AT@ => 11 ,1-> ! (1) + EQUAL;
|
||||
54690 TAB@! => 12 ,1-> ! + EQUAL;
|
||||
54700 TAG@! => 11 ,1-> ! + EQUAL;
|
||||
54710 EQUAL@! => 35 , ! EQUAL;
|
||||
54720 EQUAL: EQUAL@!OPR@ => ,1-> ! (1) + AEQUAL,ERROR;
|
||||
54730 AEQUAL: TAG@!OPR@ => 16 , ! (1) FSEM;
|
||||
54740 ! => 17 , ! ASEM;
|
||||
54750 ASEM: OPR@! => ,1-> ! + ASEM2;
|
||||
54760 ASEM2: COMMA@!PRIMDEN@ => 18 ,1-> ! (1) ++ PUSH;
|
||||
54770 STICK2: COMMA@!STICK@ => 19 ,1-> ! ++ ASTICK2,ERROR;
|
||||
54780 PUSH: OPR@,ANY!TAG@ => 20 ,2-> ! (1) ++ ASTICK2;
|
||||
54790 OPR@,ANY!STICK@ => 21 ,2-> ! ++ ASTICK2,ERROR;
|
||||
54800 ASTICK2: OPEN@!PRIMDEN@ => 22 ,2-> ! (1) ++ STAR;
|
||||
54810 ! => 23 , ! STAR;
|
||||
54820 STAR: OPR@!OPR@ => 24 ,1-> ! (1) + SEX;
|
||||
54830 OPR@! => 25 ,1-> ! + SEX;
|
||||
54840 ! => 26 , ! SEX;
|
||||
54850 SEX: TAG@! => 28 ,2-> ! + FEX,ERROR;
|
||||
54860 FEX: COMMA@!TAG@ => 29 ,1-> ! (1) + SEMI;
|
||||
54870 ! => 30 , ! SEMI;
|
||||
54880 SEMI: SEMIC@! => 31 ,1-> ! INIT;
|
||||
54890 ERROR: START@! => 32 , ! ERR;
|
||||
54900 ! => ,1-> ! ERROR;
|
||||
54910 ERR: !SEMIC@ => 31 , ! (1) INIT;
|
||||
54920 !STOP@ => 36 ,1-> ! ERROR;
|
||||
54930 ! => , ! (1) ERR;
|
||||
54940 FSEM: TAG@!PRSMDEN@ => 16 ,1-> ! (1) + ASEM,ERROR;
|
||||
54950 *)
|
||||
54960 BMPROD( 1, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 2);
|
||||
54970 BLABL( 1, 0, 2);
|
||||
54980 BMPROD( 2, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , FALSE, 1, 0, 3);
|
||||
54990 BLABL( 2, 0, 3);
|
||||
55000 BMPROD( 3, S , LXIOSTOP , 0, 0, A , LXIODUMMY , 0, 36 , 1, LXIODUMMY , FALSE, 0, 0, 4);
|
||||
55010 BLABL( 3, 0, 4);
|
||||
55020 BMPROD( 4, S , LXIOTAG , 0, 0, S , LXIOCOLON , 0, 34 , 1, LXIODUMMY , TRUE , 1, 0, 5);
|
||||
55030 BLABL( 4, 0, 5);
|
||||
55040 BMPROD( 5, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 10 , 0, LXIODUMMY , FALSE, 0, 0, 6);
|
||||
55050 BLABL( 5, 0, 6);
|
||||
55060 BMPROD( 6, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 0, 0, 7);
|
||||
55070 BMPROD( 7, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 0, -6, 8);
|
||||
55080 BMPROD( 8, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 0, -7, 9);
|
||||
55090 BMPROD( 9, S , LXIOSTICK , 0, 0, A , LXIODUMMY , 0, 13 , 1, LXIODUMMY , FALSE, 1, 0, 0);
|
||||
55100 BLABL( 8, 0, 10);
|
||||
55110 BMPROD( 10, S , LXIODUMMY , 0, 3, S , LXIOCOMMA , 0, 14 , 0, LXIODUMMY , TRUE , 1, 6, 11);
|
||||
55120 BMPROD( 11, S , LXIODUMMY , 0, 3, S , LXIOSTICK , 0, 15 , 0, LXIODUMMY , TRUE , 1, -9, -9);
|
||||
55130 BLABL( 11, 0, 12);
|
||||
55140 BMPROD( 12, S , LXIOTAG , 0, 0, S , LXIOAT , 0, 11 , 1, LXIODUMMY , TRUE , 1, 0, 13);
|
||||
55150 BMPROD( 13, S , LXIOTAB , 0, 0, A , LXIODUMMY , 0, 12 , 1, LXIODUMMY , FALSE, 1, -12, 14);
|
||||
55160 BMPROD( 14, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 11 , 1, LXIODUMMY , FALSE, 1, -13, 15);
|
||||
55170 BMPROD( 15, S , LXIOEQUAL , 0, 0, A , LXIODUMMY , 0, 35 , 0, LXIODUMMY , FALSE, 0, -14, 16);
|
||||
55180 BLABL( 15, 0, 16);
|
||||
55190 BMPROD( 16, S , LXIOEQUAL , 0, 0, S , LXIOOPR , 0, 00 , 1, LXIODUMMY , TRUE , 1, 0, -11);
|
||||
55200 BLABL( 16, 0, 17);
|
||||
55210 BMPROD( 17, S , LXIOTAG , 0, 0, S , LXIOOPR , 0, 00 , 0, LXIODUMMY , TRUE , 0, 0, 18);
|
||||
55220 BMPROD( 18, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 17 , 0, LXIODUMMY , FALSE, 0, 0, 19);
|
||||
55230 BLABL( 18, 0, 19);
|
||||
55240 BMPROD( 19, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 1, 0, 20);
|
||||
55250 BLABL( 19, 0, 20);
|
||||
55260 BMPROD( 20, S , LXIOCOMMA , 0, 0, S , LXIOPRDEN , 0, 18 , 1, LXIODUMMY , TRUE , 2, 0, 21);
|
||||
55270 BMPROD( 21, S , LXIOCOMMA , 0, 0, S , LXIOSTICK , 0, 19 , 1, LXIODUMMY , FALSE, 2, 0, -16);
|
||||
55280 BLABL( 20, 0, 22);
|
||||
55290 BMPROD( 22, S , LXIOOPR , 0, 1, S , LXIOTAG , 0, 20 , 2, LXIODUMMY , TRUE , 2, -21, 23);
|
||||
55300 BMPROD( 23, S , LXIOOPR , 0, 1, S , LXIOSTICK , 0, 21 , 2, LXIODUMMY , FALSE, 2, -22, -21);
|
||||
55310 BLABL( 23, 0, 24);
|
||||
55320 BMPROD( 24, S , LXIOOPEN , 0, 0, S , LXIOPRDEN , 0, 22 , 2, LXIODUMMY , TRUE , 2, 0, 25);
|
||||
55330 BMPROD( 25, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 23 , 0, LXIODUMMY , FALSE, 0, -24, 26);
|
||||
55340 BLABL( 25, 0, 26);
|
||||
55350 BMPROD( 26, S , LXIOOPR , 0, 0, S , LXIOOPR , 0, 24 , 1, LXIODUMMY , TRUE , 1, 0, 27);
|
||||
55360 BMPROD( 27, S , LXIOOPR , 0, 0, A , LXIODUMMY , 0, 25 , 1, LXIODUMMY , FALSE, 1, -26, 28);
|
||||
55370 BMPROD( 28, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 26 , 0, LXIODUMMY , FALSE, 0, -27, 29);
|
||||
55380 BLABL( 28, 0, 29);
|
||||
55390 BMPROD( 29, S , LXIOTAG , 0, 0, A , LXIODUMMY , 0, 28 , 2, LXIODUMMY , FALSE, 1, 0, -23);
|
||||
55400 BLABL( 29, 0, 30);
|
||||
55410 BMPROD( 30, S , LXIOCOMMA , 0, 0, S , LXIOTAG , 0, 29 , 1, LXIODUMMY , TRUE , 1, 0, 31);
|
||||
55420 BMPROD( 31, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 30 , 0, LXIODUMMY , FALSE, 0, -30, 32);
|
||||
55430 BLABL( 31, 0, 32);
|
||||
55440 BMPROD( 32, S , LXIOSEMIC , 0, 0, A , LXIODUMMY , 0, 31 , 1, LXIODUMMY , FALSE, 0, 2, 33);
|
||||
55450 BLABL( 0, 29, 33);
|
||||
55460 BMPROD( 33, S , LXIOSTART , 0, 0, A , LXIODUMMY , 0, 32 , 0, LXIODUMMY , FALSE, 0, 0, 34);
|
||||
55470 BMPROD( 34, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 1, LXIODUMMY , FALSE, 0, 33, 35);
|
||||
55480 BLABL( 33, 0, 35);
|
||||
55490 BMPROD( 35, S , LXIODUMMY , 0, 3, S , LXIOSEMIC , 0, 31 , 0, LXIODUMMY , TRUE , 0, 2, 36);
|
||||
55500 BMPROD( 36, S , LXIODUMMY , 0, 3, S , LXIOSTOP , 0, 36 , 1, LXIODUMMY , FALSE, 0, 33, 37);
|
||||
55510 BMPROD( 37, S , LXIODUMMY , 0, 3, A , LXIODUMMY , 0, 00 , 0, LXIODUMMY , TRUE , 0, 35, 38);
|
||||
55520 BLABL( 17, 0, 38);
|
||||
55530 BMPROD( 38, S , LXIOTAG , 0, 0, S , LXIOPRDEN , 0, 16 , 1, LXIODUMMY , TRUE , 1, 19, 33);
|
||||
55540 ERRS := 0; INITIO; INITLX; INITPR;
|
||||
55550 PRAGFLGS := PRAGFLGS + [PRGPOINT] - [PRGUPPER];
|
||||
55560 BCOUNT := 1;
|
||||
55570 CCOUNT := 0;
|
||||
55580 PARSER;
|
||||
55590 IF CCOUNT<>0 THEN WRITELN(LSTFILE,'CCOUNT ERROR', CCOUNT);
|
||||
55600 WRITELN(LSTFILE,'LAST PROD', BCOUNT-1);
|
||||
55610 (*+01() J := GETB(4); ()+01*)
|
||||
55620 FOR I := 0 TO HTSIZE DO (*GET RID OF ALL UNWANTED LEXEMES*)
|
||||
55630 BEGIN THIS := HT[I];
|
||||
55640 WHILE THIS<>HTCOPY[I] DO
|
||||
55650 BEGIN
|
||||
55660 THAT := THIS^.LINK;
|
||||
55670 EDISPOSE(THIS, THIS^.LXCOUNT*SZWORD+LEX1SIZE);
|
||||
55680 THIS := THAT;
|
||||
55690 END;
|
||||
55700 END;
|
||||
55710 HT := HTCOPY; (*RESTORE HT TO STATE BEFORE FRED*)
|
||||
55720 (*+01()
|
||||
55730 FOR I := J TO ORD(FRED) DO
|
||||
55740 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END;
|
||||
55750 ()+01*)
|
||||
55760 END;
|
||||
55770 (**)
|
||||
55780 ()+82*)
|
||||
597
lang/a68s/aem/a68ssp.p
Normal file
597
lang/a68s/aem/a68ssp.p
Normal file
|
|
@ -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*)
|
||||
137
lang/a68s/aem/cmpdum.p
Normal file
137
lang/a68s/aem/cmpdum.p
Normal file
|
|
@ -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 COUNT<LENGTH THEN
|
||||
00000 BEGIN
|
||||
00000 READ(F1,THIS1);
|
||||
00000 READ(F2,THIS2);
|
||||
00000 END;
|
||||
00000 COUNT := COUNT+1;
|
||||
00000 IF THIS1=THIS2 THEN
|
||||
00000 WRITE(INIT,0,LAST1)
|
||||
00000 ELSE
|
||||
00000 BEGIN
|
||||
00000 DIFF := ABS(ABS(THIS1)-ABS(THIS2));
|
||||
00000 IF DIFF IN [2,HOFFSET] THEN
|
||||
00000 BEGIN
|
||||
00000 LSW := THIS1;
|
||||
00000 IF THIS1<0 THEN
|
||||
00000 LSW := LSW+65536;
|
||||
00000 POINTER := LAST1*65536+LSW-HEAPSTART;
|
||||
00000 WRITE(INIT,HOFFSET,POINTER);
|
||||
00000 IF POINTER>HEAPLENGTH THEN
|
||||
00000 WRITELN('WARNING: POINTER OUT OF RANGE',POINTER);
|
||||
00000 IF COUNT<=LENGTH THEN
|
||||
00000 BEGIN
|
||||
00000 READ(F1,THIS1);
|
||||
00000 READ(F2,THIS2);
|
||||
00000 END;
|
||||
00000 COUNT := COUNT+1;
|
||||
00000 END
|
||||
00000 ELSE
|
||||
00000 BEGIN
|
||||
00000 WRITELN('WARNING: UNKNOWN CHANGE IN VALUE',DIFF,' FROM',THIS1,' TO',THIS2);
|
||||
00000 WRITE(INIT,0,LAST1)
|
||||
00000 END
|
||||
00000 END
|
||||
00000 END
|
||||
00000 END;
|
||||
00675 WRITELN('COPY OF LENGTH',(COUNT-1)*SZWORD); (*IN BYTES*)
|
||||
00000 END;
|
||||
00690 ()+19*)
|
||||
00710 BEGIN(*OF COMPARE*)
|
||||
00720 RESET(F1); RESET(F2); REWRITE(INIT);
|
||||
00730 READ(F1,GLOBALLENGTH);WRITE(INIT,GLOBALLENGTH);
|
||||
00740 READ(F1,HEAPLENGTH);WRITE(INIT,HEAPLENGTH);
|
||||
00750 READ(F1,HEAPSTART);
|
||||
00760 READ(F2,DUMMY);READ(F2,DUMMY);READ(F2,DUMMY);
|
||||
00770 COPY(GLOBALLENGTH DIV SZWORD);
|
||||
00780 COPY(HEAPLENGTH DIV SZWORD);
|
||||
00790 END.
|
||||
1135
lang/a68s/aem/cybcod.p
Normal file
1135
lang/a68s/aem/cybcod.p
Normal file
File diff suppressed because it is too large
Load diff
15
lang/a68s/aem/dec_main.p
Normal file
15
lang/a68s/aem/dec_main.p
Normal file
|
|
@ -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.
|
||||
31
lang/a68s/aem/dec_main_s1.p
Normal file
31
lang/a68s/aem/dec_main_s1.p
Normal file
|
|
@ -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.
|
||||
|
||||
18
lang/a68s/aem/getaddr.e
Normal file
18
lang/a68s/aem/getaddr.e
Normal file
|
|
@ -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
|
||||
28
lang/a68s/aem/make
Executable file
28
lang/a68s/aem/make
Executable file
|
|
@ -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 ;; \
|
||||
56
lang/a68s/aem/pcalls.e
Normal file
56
lang/a68s/aem/pcalls.e
Normal file
|
|
@ -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
|
||||
1078
lang/a68s/aem/perqce.p
Normal file
1078
lang/a68s/aem/perqce.p
Normal file
File diff suppressed because it is too large
Load diff
716
lang/a68s/aem/perqcod.p
Normal file
716
lang/a68s/aem/perqcod.p
Normal file
|
|
@ -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
|
||||
648
lang/a68s/aem/syntax
Normal file
648
lang/a68s/aem/syntax
Normal file
|
|
@ -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;
|
||||
Loading…
Reference in a new issue