--- /dev/null
+LIST
+Makefile
+aclose.c
+aopen.c
+arctan.c
+associate.p
+bytespack.p
+calls.e
+catpl.p
+cfstr.p
+chains.e
+cleanup.c
+collp.p
+colltm.p
+collts.p
+complex.p
+cos.c
+crmult.p
+crrefn.p
+dclpsn.p
+div.e
+drefm.p
+drefs.p
+dumbacch.p
+duminch.p
+dummy.p
+dumoutch.p
+e.h
+ensure.p
+entier.c
+errorr.p
+exit.c
+exp.c
+fixed.p
+float.p
+genrec.p
+get.e
+getaddr.e
+getmult.p
+getout.p
+gett.p
+global.p
+globale.e
+gtot.p
+gtotref.p
+gvasstx.p
+gvscope.p
+heapmul.p
+heapstr.p
+hoist.e
+is.p
+linit2.p
+linit34.p
+linitinc.p
+ln.c
+lpb.s
+make
+maxr.c
+mod.c
+mulis.p
+nassp.p
+nassts.p
+newline.p
+onend.p
+openclose.p
+pcollmul.p
+pcollst.p
+posenq.p
+powi.c
+powneg.p
+powr.c
+put.e
+putt.p
+random.p
+rangent.p
+rangext.p
+reset.p
+rnstart.p
+routn.p
+routnp.p
+rowm.p
+rownm.p
+run68g.p
+rundecs.p
+safeaccess.p
+scopext.p
+selectr.p
+selecttsn.p
+setcc.p
+sett.p
+shl.c
+shr.c
+signi.c
+signr.c
+sin.c
+skip.p
+slice12.p
+slicen.p
+space.p
+sqrt.c
+standass.p
+standback.e
+standin.p
+standout.p
+stbacch.p
+stinch.p
+stopen.p
+stoutch.p
+strsubtrim.p
+structscope.p
+swap.e
+tassp.p
+tasstm.p
+tassts.p
+temp.c
+time.c
+timesten.c
+trace.e
+trig.p
+trim.p
+uplwb.p
+uplwbm.p
+uplwbmstr.p
+whole.p
+widchar.p
+widen.p
+wrs.e
--- /dev/null
+/user/t63/em/lib/sun3/tail_a68stail_a68s.a
+errorr.p
+global.p
+safeaccess.p
+collp.p
+colltm.p
+collts.p
+complex.p
+crmult.p
+crrefn.p
+dclpsn.p
+drefm.p
+drefs.p
+dummy.p
+genrec.p
+getmult.p
+getout.p
+gtot.p
+gtotref.p
+gvasstx.p
+gvscope.p
+heapmul.p
+heapstr.p
+is.p
+linit2.p
+linit34.p
+linitinc.p
+nassts.p
+nassp.p
+pcollmul.p
+pcollst.p
+rangent.p
+rangext.p
+rnstart.p
+routn.p
+routnp.p
+rowm.p
+rownm.p
+scopext.p
+selectr.p
+selecttsn.p
+setcc.p
+skip.p
+slice12.p
+slicen.p
+strsubtrim.p
+structscope.p
+tassp.p
+tasstm.p
+tassts.p
+trim.p
+widchar.p
+widen.p
+catpl.p
+cfstr.p
+mulis.p
+powneg.p
+uplwb.p
+uplwbm.p
+uplwbmstr.p
+bytespack.p
+random.p
+trig.p
+associate.p
+dumbacch.p
+duminch.p
+dumoutch.p
+ensure.p
+fixed.p
+float.p
+gett.p
+newline.p
+onend.p
+openclose.p
+posenq.p
+putt.p
+reset.p
+sett.p
+space.p
+standass.p
+standin.p
+standout.p
+stbacch.p
+stinch.p
+stopen.p
+stoutch.p
+whole.p
+calls.e
+chains.e
+div.e
+get.e
+getaddr.e
+globale.e
+hoist.e
+put.e
+standback.e
+swap.e
+trace.e
+wrs.e
+aclose.c
+aopen.c
+powi.c
+powr.c
+mod.c
+entier.c
+signi.c
+signr.c
+timesten.c
+shl.c
+shr.c
+time.c
+sin.c
+cos.c
+arctan.c
+sqrt.c
+exp.c
+ln.c
+maxr.c
+cleanup.c
--- /dev/null
+EMROOT=../../..
+ACK=$(EMROOT)/bin/$(MACH)
+PC=$(ACK) -.p -PR$(EMROOT)/lang/a68s/cpem/cpem
+PCFLAGS=-v -L -e -LIB -Oego -SR -CJ -BO -SP
+EPCFLAGS=-v -L -e -LIB $(BSD4) $(VAX4)
+UTIL=$(EMROOT)/lang/a68s/util
+TAILOR=$(UTIL)/tailor
+XREF=$(UTIL)/xref -i$(UTIL)/pascal.ign -p
+CHECKSEQ=$(UTIL)/checkseq
+TERRS=/dev/tty
+TNOS=101 2 103 104 105 111 21 122 123 124 125 32 41 150 151 152 153 154 155 161 $(RECIPE)
+CFILES=aclose.c aopen.c powi.c powr.c mod.c entier.c signi.c signr.c \
+ timesten.c shl.c shr.c time.c sin.c cos.c arctan.c sqrt.c exp.c \
+ ln.c maxr.c cleanup.c
+COFILES=aclose.o aopen.o powi.o powr.o mod.o entier.o signi.o signr.o \
+ timesten.o shl.o shr.o time.o sin.o cos.o arctan.o sqrt.o exp.o \
+ ln.o maxr.o cleanup.o
+FILES=run68g.p
+GFILES=errorr.p global.p safeaccess.p
+GOFILES=errorr.o global.o safeaccess.o
+PFILES=collp.p colltm.p collts.p complex.p crmult.p crrefn.p dclpsn.p drefm.p \
+ drefs.p dummy.p genrec.p getmult.p getout.p gtot.p gtotref.p \
+ gvasstx.p gvscope.p heapmul.p heapstr.p is.p linit2.p linit34.p \
+ linitinc.p nassts.p nassp.p pcollmul.p pcollst.p rangent.p rangext.p \
+ rnstart.p routn.p routnp.p rowm.p rownm.p scopext.p selectr.p \
+ selecttsn.p setcc.p skip.p slice12.p slicen.p strsubtrim.p \
+ structscope.p tassp.p tasstm.p tassts.p trim.p widchar.p widen.p
+POFILES=collp.o colltm.o collts.o complex.o crmult.o crrefn.o dclpsn.o drefm.o \
+ drefs.o dummy.o genrec.o getmult.o getout.o gtot.o gtotref.o gvasstx.o \
+ gvscope.o heapmul.o heapstr.o is.o linit2.o linit34.o linitinc.o \
+ nassts.o nassp.o pcollmul.o pcollst.o rangent.o rangext.o rnstart.o \
+ routn.o routnp.o rowm.o rownm.o scopext.o selectr.o selecttsn.o \
+ setcc.o skip.o slice12.o slicen.o strsubtrim.o structscope.o tassp.o \
+ tasstm.o tassts.o trim.o widchar.o widen.o
+OPFILES=catpl.p cfstr.p mulis.p powneg.p uplwb.p uplwbm.p uplwbmstr.p
+OPOFILES=catpl.o cfstr.o mulis.o powneg.o uplwb.o uplwbm.o uplwbmstr.o
+SPFILES=bytespack.p random.p trig.p
+SPOFILES=bytespack.o random.o trig.o
+TFILES=associate.p dumbacch.p duminch.p dumoutch.p ensure.p fixed.p float.p \
+ gett.p newline.p onend.p openclose.p posenq.p putt.p reset.p sett.p \
+ space.p standass.p standin.p standout.p stbacch.p stinch.p stopen.p \
+ stoutch.p whole.p
+TOFILES=associate.o dumbacch.o duminch.o dumoutch.o ensure.o fixed.o float.o \
+ gett.o newline.o onend.o openclose.o posenq.o putt.o reset.o sett.o \
+ space.o standass.o standin.o standout.o stbacch.o stinch.o stopen.o \
+ stoutch.o whole.o
+EFILES=calls.e chains.e div.e get.e getaddr.e globale.e hoist.e put.e \
+ standback.e swap.e trace.e wrs.e
+EOFILES=calls.o chains.o div.o get.o getaddr.o globale.o hoist.o put.o \
+ standback.o swap.o trace.o wrs.o
+LIBFILES=$(GFILES) $(PFILES) $(OPFILES) $(SPFILES) $(TFILES)
+LIBOFILES=$(GOFILES) $(POFILES) $(OPOFILES) $(SPOFILES) $(TOFILES)
+
+all: liba68s$(w)$(p)
+
+rundecs.h: check$(w)$(p) rundecs.p
+ echo $(TNOS) 300 | $(TAILOR) rundecs.p $(TERRS) \
+ >rundecs.h
+
+rundecsg.h: check$(w)$(p) rundecs.p
+ echo $(TNOS) 71 300 | $(TAILOR) rundecs.p $(TERRS) >rundecsg.h
+
+run68g.o: rundecsg.h run68g.p
+ (cat rundecsg.h; \
+ cat run68g.p ) \
+ >temp.p
+ $(PC) $(PCFLAGS) -c.s temp.p
+ sed -e '/^.define _m_a_i_n/d' -e '/^.extern _m_a_i_n/,$$d' -e '/^.globl _m_a_i_n/,$$d' temp.s > run68g.s
+ $(PC) $(PCFLAGS) -c.o run68g.s
+ rm temp.p run68g.s
+
+.p.o:
+ ( echo $(TNOS) 300 | $(TAILOR) $*.p $(TERRS) ) \
+ >temp.p
+ $(PC) $(PCFLAGS) -c.s temp.p
+ mv temp.s $*.s
+ $(PC) $(PCFLAGS) -c.o $*.s
+ rm temp.p $*.s
+
+$(LIBOFILES): rundecs.h
+
+.SUFFIXES: .e
+
+e.h: check$(w)$(p)
+
+.e.o:
+ $(PC) $(EPCFLAGS) -c.s -DEM_WSIZE=$(w) -DEM_PSIZE=$(p) $*.e
+ $(PC) $(EPCFLAGS) -c.o $*.s
+ rm $*.s
+
+$(EOFILES): e.h
+
+maxr.o: maxr.c
+ /lib/cpp <maxr.c >temp.c
+ $(PC) $(PCFLAGS) -I$(EMROOT)/h -c.s -o maxr.s temp.c
+ $(PC) $(PCFLAGS) -c.o maxr.s
+ rm maxr.s
+
+.c.o:
+ $(PC) $(PCFLAGS) -I$(EMROOT)/h -c.s $*.c
+ $(PC) $(PCFLAGS) -c.o $*.s
+ rm $*.s
+
+liba68s: liba68s$(w)$(p)
+
+liba68s$(w)$(p): $(EOFILES) $(COFILES) $(LIBOFILES) $(SOFILES) run68g.o
+ -rm liba68s$(w)$(p)
+ $(ASAR) crv liba68s$(w)$(p) $(EOFILES) $(COFILES) $(LIBOFILES) $(SOFILES) run68g.o
+ sh -c '$${RANLIB-:} liba68s$(w)$(p)'
+
+check$(w)$(p):
+ /bin/make clean
+ echo >> check$(w)$(p)
+
+checkseq:
+ $(CHECKSEQ) rundecs.p $(LIBFILES)
+
+pr:
+ pr rundecs.p $(LIBFILES) $(FILES) $(EFILES) $(CFILES)
+
+xref:
+ (/bin/make pr; \
+ echo 1000 | $(TAILOR) rundecs.p $(TERRS) | $(XREF) | pr -h rundecs.xref; \
+ for II in $(LIBFILES); do echo 1000 | $(TAILOR) $$II $(TERRS); done \
+ | $(XREF) | pr -h run68.xref \
+ ) | opr
+
+clean:
+ -rm liba68s$(w)$(p) check?? rundec*.h *.o
+
--- /dev/null
+#include <pc_file.h>
+
+extern _cls(); /* pc runtime routine to close a file */
+
+/* as the following routine is called from a pascal subroutine */
+/* and the pascal compiler has been fixed to alwayd supply static links */
+/* to non-global externals the parameter 'statlink' is a dummy to fill */
+/* the space occupied by the static link. The parameter is first instead */
+/* of last because of the C method of passing its parameters backwards */
+
+ACLS(statlink,f) int *statlink; struct file *f; {
+
+ _cls(f);
+}
+
--- /dev/null
+#include <pc_file.h>
+#include <pc_err.h>
+
+#define BUFFLENGTH 512 /* number of items in buffer */
+
+extern struct file *_curfil; /* for error mesages from trap */
+extern _trp(); /* pc runtime trap routine */
+extern creat(); /* unix open for write */
+extern open(); /* unix open for read */
+
+static int initfile (desc,f) int desc; struct file *f; {
+
+ _curfil=f;
+ if ( (desc & WRBIT) == 0) {
+ if ( (f->ufd = open(f->fname,0)) < 0 )
+ _trp(ERESET);
+ } else {
+ if ( (f->ufd = creat(f->fname,0644)) < 0 )
+ _trp(EREWR);
+ }
+ f->buflen = BUFFLENGTH;
+ f->size = 1;
+ f->ptr = f->bufadr;
+ f->flags = desc;
+ return(1);
+
+}
+
+/* as both the following routines are called from a pascal subroutine */
+/* and the pascal compiler has been fixed to alwayd supply static links */
+/* to non-global externals the parameter 'statlink' is a dummy to fill */
+/* the space occupied by the static link. The parameter is first instead */
+/* of last because of the C method of passing its parameters backwards */
+
+AOPN(statlink,f) int *statlink; struct file *f; {
+
+ if ( initfile ((int)(MAGIC|TXTBIT),f) )
+ f->count=0;
+}
+
+ACRE(statlink,f) int *statlink; struct file *f; {
+
+ if ( initfile ((int)(WRBIT|EOFBIT|ELNBIT|MAGIC|TXTBIT),f) )
+ f->count=f->buflen;
+}
+
--- /dev/null
+extern double _atn();
+double ARCTAN(statlink, x)
+ int *statlink; double x;
+ {return(_atn(x));}
--- /dev/null
+70000 #include "rundecs.h"
+70010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+70020 (**)
+70030 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+70040 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+70050 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+70060 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
+70070 (**)
+70080 (**)
+70090 (*+01() (*$X6*) ()+01*)
+70100 FUNCTION PROC( PROCEDURE P (*-01() ( COV: OBJECTP ; EFET: FETROOMP ) ()-01*) ): ASPROC ; EXTERN ;
+70110 (*-01()
+70120 FUNCTION PROC1(
+70130 PROCEDURE P( COV: OBJECTP ; CHARS: GETBUFTYPE ; TERM: TERMSET ; I: INTEGER ; EFET: FETROOMP )
+70140 ): ASPROC ; EXTERN ;
+70150 FUNCTION PROC2( PROCEDURE P( COV, STRNG: OBJECTP ; LB, UB: INTEGER ; EFET: FETROOMP ) ): ASPROC ; EXTERN ;
+70160 FUNCTION PROC3( PROCEDURE P( COV: OBJECTP ; P, L, C: INTEGER ; EFET: FETROOMP ) ): ASPROC ; EXTERN ;
+70170 FUNCTION PROCH( PROCEDURE P( COV: OBJECTP ; L: LFNTYPE ) ): ASPROC ; EXTERN ;
+70180 ()-01*)
+70190 PROCEDURE ASSWRSTR(COV, PUTSTRING: OBJECTP; LB, UB: INTEGER; EFET: FETROOMP); EXTERN;
+70200 PROCEDURE ASSRDSTR(COV:OBJECTP; CHARS:GETBUFTYPE; TERM(*+01(),TERM1()+01*): TERMSET; I: INTEGER; EFET: FETROOMP);
+70210 EXTERN;
+70220 PROCEDURE ASSNEWLINE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+70230 PROCEDURE ASSNEWPAGE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+70240 PROCEDURE ASSRESET(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+70250 PROCEDURE ASSSET(COV: OBJECTP; P, L, C: INTEGER; EFET: FETROOMP); EXTERN;
+70260 (**)
+70270 (**)
+70280 FUNCTION ASSOCIATE(RF,CHARFILE:OBJECTP): INTEGER;
+70290 VAR CB,OFF,CPS:INTEGER;
+70300 F,PCOV:OBJECTP;
+70310 BEGIN
+70320 F := INCPTR(SAFEACCESS(RF), -STRUCTCONST);
+70330 PCINCR(INCPTR(F, STRUCTCONST),FILEBLOCK,-INCRF);
+70340 ENEW(PCOV, COVERSIZE);
+70350 (*-02() PCOV^.FIRSTWORD := SORTSHIFT * ORD(COVER) + INCRF; ()-02*)
+70360 (*+02() PCOV^.PCOUNT:=1; PCOV^.SORT:=COVER; ()+02*)
+70370 F^.PCOVER:=PCOV;
+70380 WITH CHARFILE^ DO
+70390 WITH DESCVEC[0] DO
+70400 BEGIN CPS:=DI-LBADJ;
+70410 CB:=UI;
+70420 OFF:=DI;
+70430 IF LI<>1 THEN ERRORR(WRONGMULT);
+70440 END;
+70450 WITH PCOV^ DO
+70460 BEGIN COFCPOS:=1; LOFCPOS:=1; POFCPOS:=1;
+70470 CHARBOUND:=CB; LINEBOUND:=1; PAGEBOUND:=1;
+70480 STATUS:=[OPENED,CHARMOOD];
+70490 POSSIBLES:=[GETPOSS,PUTPOSS,RESETPOSS,SETPOSS,ASSPOSS];
+70500 DOPUTS := PROC(*-01()2()-01*)(ASSWRSTR);
+70510 DOGETS := PROC(*-01()1()-01*)(ASSRDSTR);
+70520 DONEWLINE := PROC(ASSNEWLINE);
+70530 DONEWPAGE := PROC(ASSNEWPAGE);
+70540 DORESET := PROC(ASSRESET);
+70550 DOSET := PROC(*-01()3()-01*)(ASSSET);
+70560 ASSOC := TRUE;
+70570 ASSREF:=CHARFILE;
+70580 CPOSELS:=CPS;
+70590 OFFSETDI:=OFF;
+70600 FPINC(CHARFILE^);
+70610 OSCOPE := CHARFILE^.OSCOPE;
+70620 END;
+70630 WITH F^ DO
+70640 BEGIN
+70650 IF RF^.OSCOPE<PCOV^.OSCOPE THEN ERRORR(RSCOPE);
+70660 LOGICALFILEMENDED:=UNDEFIN;
+70670 PHYSICALFILEMENDED:=UNDEFIN;
+70680 PAGEMENDED:=UNDEFIN;
+70690 LINEMENDED:=UNDEFIN;
+70700 TERM:=[];
+70710 (*+01() TERM1:=[] ; ()+01*)
+70720 END;
+70730 IF FPTST(RF^) THEN GARBAGE(RF);
+70740 ASSOCIATE := ORD(NOT(OPENED IN PCOV^.STATUS));
+70750 END; (*ASSOCIATE*)
+70760 (**)
+70770 (**)
+70780 (*+01() (*$X4*) ()+01*)
+70790 (**)
+70800 (**)
+70810 (*-02()
+70820 BEGIN (*OF A68*)
+70830 END; (*OF A68*)
+70840 ()-02*)
+70850 (*+01()
+70860 BEGIN (*OF MAIN PROGRAM*)
+70870 END (* OF EVERYTHING *).
+70880 ()+01*)
--- /dev/null
+65000 #include "rundecs.h"
+65010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+65020 (**)
+65030 (**)
+65040 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+65050 (**)
+65060 (**)
+65070 FUNCTION BYTESPACK(STRING :OBJECTP): A68INT;
+65080 (*BYTESPACK*)
+65090 VAR PTR: UNDRESSP;
+65100 BEGIN WITH STRING^ DO
+65110 IF STRLENGTH > CHARPERWORD THEN ERRORR(RBYTESPACK)
+65120 ELSE BEGIN
+65130 PTR := INCPTR(STRING, STRINGCONST);
+65140 BYTESPACK := PTR^.FIRSTINT;
+65150 END
+65160 END;
+65170 (**)
+65180 (**)
+65190 (*-02() BEGIN END ; ()-02*)
+65200 (*+01()
+65210 BEGIN (*OF MAIN PROGRAM*)
+65220 END (*OF EVERYTHING*).
+65230 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exa .1 ; global Pascal variables
+ exp $PROC
+ exp $PROC1
+ exp $PROC2
+ exp $PROC3
+ exp $PROCH
+ exp $CLPASC1
+ exp $CLPASC2
+ exp $CLPASC5
+ exp $CLRDSTR
+ exp $CL68
+ exp $FUNC68
+ exp $CALLPASC
+
+ pro $PROC,0
+ LFL SZADDR+SZADDR ; load environment, static link for procedure
+ LFL SZADDR ; load address of code
+ ret SZPROC
+ end 0
+
+ pro $PROC1,0
+ LFL SZADDR+SZADDR
+ LFL SZADDR
+ ret SZPROC
+ end 0
+
+ pro $PROC2,0
+ LFL SZADDR+SZADDR
+ LFL SZADDR
+ ret SZPROC
+ end 0
+
+ pro $PROC3,0
+ LFL SZADDR+SZADDR
+ LFL SZADDR
+ ret SZPROC
+ end 0
+
+ pro $PROCH,0
+ LFL SZADDR+SZADDR
+ LFL SZADDR
+ ret SZPROC
+ end 0
+
+ pro $CLPASC1,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ lal SZADDR ; load base address of params (source)
+ loc SZADDR+SZPROC
+ los SZWORD
+ cai
+ ret 0
+ end SZWORD
+
+ pro $CLPASC2,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD ; set frame stamp as pascal
+ lal SZADDR ; load base address of params (source)
+ loc SZADDR+SZADDR+SZPROC
+ los SZWORD
+ cai ; call proc, params & static link set
+ ret 0
+ end SZWORD
+
+#define P5PARAMSPACE SZADDR+SZADDR+SZWORD+SZWORD+SZADDR+SZPROC
+
+ pro $CLPASC5,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD ; set frame stamp as pascal
+ lal SZADDR ; load base address of params (source)
+ loc P5PARAMSPACE
+ los SZWORD
+ cai
+ ret 0
+ end SZWORD
+
+#define PRDSTRSPACE SZADDR+SZADDR+16+SZADDR+SZADDR+SZPROC
+
+ pro $CLRDSTR,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD ; set frame stamp as pascal
+ lal SZADDR ; load base address of params (source)
+ loc PRDSTRSPACE
+ los SZWORD
+ cai
+ ret 0
+ end SZWORD
+
+ pro $CL68,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR ; OBJECTP parameter
+ LLC 0 ; bitpattern
+ loc 1 ; locrg
+ LFL SZADDR+SZADDR+SZADDR ; procbl
+ dup SZADDR
+ LFL SZADDR+SZADDR ; env
+ exg SZADDR
+ loi SZADDR ; XBASE
+ cai
+ ret 0
+ end SZWORD
+
+ pro $FUNC68,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR ; OBJECTP parameter
+ LLC 0 ; bitpattern
+ loc 1 ; locrg
+ LFL SZADDR+SZADDR+SZADDR ; procbl
+ dup SZADDR
+ LFL SZADDR+SZADDR ; env
+ exg SZADDR
+ loi SZADDR ; XBASE
+ cai
+ ret SZWORD
+ end SZWORD
+
+
+ pro $CALLPASC,SZWORD ; +SZADDR+SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ lal SZADDR+SZADDR+SZWORD+SZLONG ; address of first (A68) parameter
+ loe .1+SZWORD+SZADDR ; PASCPARAMS
+ los SZWORD
+ lae .1+SZWORD+SZADDR+SZWORD ; address of PASCPROC
+ loi SZPROC ; PASCPROC
+ cai
+ ret 0
+ end SZWORD ; +SZADDR+SZWORD
--- /dev/null
+60000 #include "rundecs.h"
+60010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+60020 (**)
+60030 (**)
+60040 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+60050 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
+60060 FUNCTION SAFEACCESS (LOCATION: OBJECTP) : UNDRESSP; EXTERN;
+60070 (**)
+60080 (**)
+60090 FUNCTION CATCC(LCH, RCH: CHAR): OBJECTP;
+60100 (*PCAT*)
+60110 VAR POINT :OBJECTP;
+60120 BEGIN
+60130 POINT := CRSTRING(2);
+60140 WITH POINT^ DO
+60150 BEGIN CHARVEC[1] := LCH; CHARVEC[2] := RCH END;
+60160 CATCC := POINT;
+60170 END;
+60180 (**)
+60190 (**)
+60200 FUNCTION CATSS(LEFT, RIGHT: OBJECTP): OBJECTP;
+60210 (*PCAT-1*)
+60220 VAR POINT: OBJECTP;
+60230 I, D: INTEGER; C: CHAR;
+60240 BEGIN
+60250 WITH LEFT^ DO
+60260 BEGIN D := STRLENGTH;
+60270 IF
+60280 ( PCOUNT = 0 )
+60290 AND
+60300 ( STRLENGTH+RIGHT^.STRLENGTH <= (STRLENGTH + CHARPERWORD - 1) DIV CHARPERWORD * CHARPERWORD ) THEN
+60310 BEGIN POINT := LEFT; I := D+RIGHT^.STRLENGTH; POINT^.STRLENGTH := I END
+60320 ELSE
+60330 BEGIN POINT := CRSTRING(STRLENGTH+RIGHT^.STRLENGTH);
+60340 FOR I := 1 TO STRLENGTH DO
+60350 BEGIN C := CHARVEC[I]; POINT^.CHARVEC[I] := C END;
+60360 IF FPTST(LEFT^) THEN GARBAGE(LEFT)
+60370 END
+60380 END;
+60390 WITH RIGHT^ DO
+60400 FOR I := 1 TO RIGHT^.STRLENGTH DO
+60410 BEGIN C := CHARVEC[I]; POINT^.CHARVEC[I+D] := C END;
+60420 IF FPTST(RIGHT^) THEN GARBAGE(RIGHT);
+60430 CATSS := POINT;
+60440 END;
+60450 (**)
+60460 (**)
+60470 FUNCTION PLABSS(LEFT, RIGHT: OBJECTP): OBJECTP;
+60480 (*PPLUSABCH, PPLUSABCH-1*)
+60490 VAR TEMP: OBJECTP;
+60500 PILPTR: UNDRESSP;
+60510 BEGIN
+60520 WITH LEFT^ DO
+60530 IF SORT = REFN THEN
+60540 BEGIN
+60550 WITH PVALUE^ DO FDEC; (*SO THAT CATSS CAN POSSIBLY RE-USE IT*)
+60560 PVALUE := CATSS(PVALUE, RIGHT);
+60570 WITH PVALUE^ DO FINC
+60580 END
+60590 ELSE
+60600 BEGIN
+60610 PILPTR := SAFEACCESS(LEFT);
+60620 TEMP := PILPTR^.FIRSTPTR;
+60630 WITH TEMP^ DO FDEC; (*SO THAT CATSS CAN POSSIBLY RE-USE IT*)
+60640 PILPTR^.FIRSTPTR := CATSS(TEMP, RIGHT);
+60650 WITH PILPTR^.FIRSTPTR^ DO FINC
+60660 END;
+60670 PLABSS := LEFT;
+60680 END;
+60690 (**)
+60700 (**)
+60710 FUNCTION PLTOSS(LEFT, RIGHT: OBJECTP): OBJECTP;
+60720 (*PPLUSTOCS, PPLUSTOCS-1*)
+60730 VAR TEMP: OBJECTP;
+60740 PILPTR: UNDRESSP;
+60750 BEGIN
+60760 WITH RIGHT^ DO
+60770 IF SORT = REFN THEN
+60780 BEGIN
+60790 WITH PVALUE^ DO FDEC;
+60800 PVALUE := CATSS(LEFT, PVALUE);
+60810 WITH PVALUE^ DO FINC
+60820 END
+60830 ELSE
+60840 BEGIN
+60850 PILPTR := SAFEACCESS(RIGHT);
+60860 TEMP := PILPTR^.FIRSTPTR;
+60870 WITH TEMP^ DO FDEC;
+60880 PILPTR^.FIRSTPTR := CATSS(LEFT, TEMP);
+60890 WITH PILPTR^.FIRSTPTR^ DO FINC
+60900 END;
+60910 PLTOSS := RIGHT;
+60920 END;
+60930 (**)
+60940 (**)
+60950 (*-02() BEGIN END ; ()-02*)
+60960 (*+01()
+60970 BEGIN (*OF MAIN PROGRAM*)
+60980 END (*OF EVERYTHING*).
+60990 ()+01*)
--- /dev/null
+61000 #include "rundecs.h"
+61010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+61020 (**)
+61030 (**)
+61040 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+61050 (**)
+61060 (**)
+61070 FUNCTION CFSTR(LEFT, RIGHT: OBJECTP; JOB :INTEGER): INTEGER;
+61080 (*PLTCS-1, PLECS-1, PEQCS-1, PNECS-1, PGECS-1, PGTCS-1*)
+61090 LABEL 9;
+61100 VAR MINPTR, LSTRLENGTH, RSTRLENGTH: INTEGER;
+61110 LPTR, RPTR: UNDRESSP;
+61120 BEGIN
+61130 LSTRLENGTH := LEFT^.STRLENGTH; RSTRLENGTH := RIGHT^.STRLENGTH;
+61140 IF LSTRLENGTH < RSTRLENGTH THEN
+61150 MINPTR := (LSTRLENGTH+CHARPERWORD-1) DIV CHARPERWORD * SZWORD
+61160 ELSE
+61170 MINPTR := (RSTRLENGTH+CHARPERWORD-1) DIV CHARPERWORD * SZWORD;
+61180 LPTR := INCPTR(LEFT, STRINGCONST); RPTR := INCPTR(RIGHT, STRINGCONST);
+61190 WHILE ORD(LPTR)<ORD(LEFT)+STRINGCONST+MINPTR DO
+61200 BEGIN
+61210 IF LPTR^.FIRSTWORD<>RPTR^.FIRSTWORD THEN
+61220 BEGIN LSTRLENGTH := LPTR^.FIRSTWORD; RSTRLENGTH := RPTR^.FIRSTWORD; GOTO 9 END;
+61230 LPTR := INCPTR(LPTR, SZWORD); RPTR := INCPTR(RPTR, SZWORD);
+61240 END;
+61250 9: CASE JOB OF
+61260 0: CFSTR := -ORD(LSTRLENGTH<RSTRLENGTH);
+61270 1: CFSTR := -ORD(LSTRLENGTH<=RSTRLENGTH);
+61280 2: CFSTR := -ORD(LSTRLENGTH=RSTRLENGTH);
+61290 3: CFSTR := -ORD(LSTRLENGTH<>RSTRLENGTH);
+61300 4: CFSTR := -ORD(LSTRLENGTH>=RSTRLENGTH);
+61310 5: CFSTR := -ORD(LSTRLENGTH>RSTRLENGTH);
+61320 END;
+61330 IF FPTST(LEFT^) THEN GARBAGE(LEFT); IF FPTST(RIGHT^) THEN GARBAGE(RIGHT)
+61340 END;
+61350 (**)
+61360 (**)
+61370 (*-02() BEGIN END ; ()-02*)
+61380 (*+01()
+61390 BEGIN (*OF MAIN PROGRAM*)
+61400 END (*OF EVERYTHING*).
+61410 ()+01*)
--- /dev/null
+#include "e.h"
+ exp $GETLINEN
+ exp $ME
+ exp $STATIC
+ exp $DYNAMIC
+ exp $ARGBASE
+ exp $SETMYSTA
+ exp $SETNSTAT
+ exp $ISA68
+ exp $ISPUT
+ exp $ISGET
+ exp $GETCALLE
+
+ ; function getlineno :integer;
+ pro $GETLINEN,0 ; return line no from hol0
+ loe 0
+ ret SZWORD
+ end
+
+ pro $ME,0
+ lor 0 ; lb -> stack
+ dch ; caller's lb -> stack
+ ret SZADDR ; clb -> function result area
+ end 0
+
+ pro $STATIC,0
+ LFL SZADDR ; param (lb of caller) (after static link)
+ lpb ; ab of param
+ loi SZADDR ; static link of param
+ ret SZADDR
+ end 0
+
+ pro $DYNAMIC,0
+ LFL SZADDR ; param (lb of caller) (after static link)
+ dch ; follow dynamic chain, using lb of caller
+ ret SZADDR
+ end 0
+
+ pro $ARGBASE,0
+ LFL SZADDR ; param (somebody's lb)
+ lpb ; convert to somebody's ab
+ ret SZADDR
+ end 0
+
+ pro $SETMYSTA,0
+ LFL SZADDR ; place param on stack
+ lor 0 ; lb -> stack , for dch
+ dch ; caller's lb -> stack
+ lpb ; caller's ab
+ sti SZADDR ; store param in caller's static link
+ ret 0
+ end 0
+
+#ifndef VAX4
+ pro $SETNSTAT,0 ; called from RNSTART of insert n extra levels in
+ ; the static chain of A68 (i.e. RNSTART's caller);
+ ; there is guaranteed to be enough vacant space at
+ ; the top of the IB of A68
+ lor 0 ; my LB
+ dch ; RNSTART LB
+ adp SZADDR ; fictitious LB
+ ; BUT THIS MAY NOT BE LEGAL EM. REVIEW WHEN
+ ; RNSTART IS REWRITTEN.
+ dup SZADDR
+ lxa 2 ; A68 AB
+ loi SZADDR ; A68 static
+ exg SZADDR
+ lpb ; fictitious AB
+ sti SZADDR ; (fictitious AB) := A68 static
+ dup SZADDR
+ lxa 2 ; A68 AB
+ sti SZADDR ; (A68 AB) := fictitious LB
+2
+ lol SZADDR ; n
+ loc 1
+ sbi SZWORD
+ dup SZWORD
+ stl SZADDR ; n := n-1
+ zeq *3
+ dup SZADDR
+ lpb ; fictitious AB
+ dup SZADDR
+ loi SZADDR
+ exg SZADDR
+ SFF SZADDR ; (fictitious AB + 1) := (fictitious AB)
+ adp SZADDR ; new fictitious LB
+ dup SZADDR
+ dup SZADDR
+ lpb ; new fictitious AB
+ SFF -SZADDR ; (new fictitious AB -l = old fictitious AB) :=
+ ; new fictitious LB
+ bra *2 ; with the new fictitious LB on the stack
+3
+ ret 0
+ end 0
+#else
+ pro $SETNSTAT,SZWORD ; called from RNSTART of insert n extra levels in
+ ; the static chain of A68 (i.e. RNSTART's caller);
+ ; this version does not assume that the space between
+ ; LB and AB is a constant. It calls itself recursively
+ ; to create n activation records, whose static chains
+ ; are linked as required. The last activation then
+ ; copies the return status block of RNSTART over itself,
+ ; so exiting from RNSTART but leaving the extra chains
+ ; still within the stack.
+ lor 0 ; SLB
+ dch ; RLB
+ dup SZADDR ; RLB | RLB
+ dch ; RLB | ALB
+ lpb ; RLB | AAB
+ dup SZADDR ; RLB | AAB | AAB
+ loi SZADDR ; RLB | AAB | (AAB)
+ lor 0 ; RLB | AAB | (AAB) | SLB
+ dch ; RLB | AAB | (AAB) | RLB
+ lpb ; RLB | AAB | (AAB) | RAB
+ sti SZADDR ; RLB | AAB (RAB) := (AAB)
+ sti SZADDR ; (AAB) := RLB
+ ; now my caller (RNSTART the first time) has been linked
+ ; into the static chain of HIS caller.
+ lol SZADDR ; n
+ loc 1
+ sbi SZWORD ; n-1
+ dup SZWORD
+ zeq *4
+ lxl 1
+ cal $SETNSTAT
+ asp SZWORD+SZADDR ; but it should never return here
+ nop
+4 ; now we must move the return status block of RNSTART
+ ; on top of our own. We are still statically within RNSTART
+ LFL 0 ; RLB
+ dup SZADDR ; RLB | RLB
+ lpb ; RLB | RAB
+ exg SZADDR ; RAB | RLB
+ sbs SZWORD ; Amount to be moved
+ dup SZWORD ; A | A
+ stl -SZWORD ; A
+ lor 0 ; A | SLB
+ dup SZADDR ; A | SLB | SLB
+ lpb ; A | SLB | SAB
+ exg SZADDR ; A | SAB | SLB
+ sbs SZWORD ; A | SA (the size of our own return status block)
+ exg SZWORD ; SA | A
+ sbi SZWORD ; SA-A
+ lor 0 ; SLB
+ ads SZWORD ; new SLB to be
+ str 1 ; set SP there
+ lor 1 ; TO (=SP the destination of the move)
+ dup SZADDR ; TO | TO
+ LFL 0 ; TO | TO | RLB (the source of the move)
+ exg SZADDR ; TO | RLB | TO
+ lol -SZWORD ; TO | RLB | TO | A
+ bls SZWORD ; TO
+ str 0 ; set SLB to the moved copy of RNSTART's block
+ ret 0 ; return to RNSTART's caller, resetting his registers
+ end SZWORD ; one local to store A
+#endif
+
+ pro $GETCALLE,0 ; returns LB of nearest A68 frame on stack, A68 caller
+ LFL SZADDR ; param (lb of callee, routine) (after static link)
+1
+ dch ; follow dynamic chain
+ dup SZADDR ; duplicate either to return or follow next time
+ lof -SZWORD ; lb - SZWORD is addres of frame stamp
+ loc A68STAMP
+ bne *1 ; do again if not A68 frame
+ ret SZADDR ; return lb of frame
+ end 0
+
+ pro $ISA68,0
+ LFL SZADDR ; get param, lb of frame to test
+ adp -SZWORD
+ loi SZWORD ; load frame stamp
+ loc A68STAMP
+ cmi SZWORD ; compare it with 'a68stamp'
+ teq ; is it the same
+ ret SZWORD ; return answer, true=1 false=0
+ end 0
+
+ pro $ISPUT,0
+ LFL SZADDR ; get param, lb of frame to test
+ adp -SZWORD
+ loi SZWORD ; load frame stamp
+ loc PUTSTAMP
+ cmi SZWORD ; compare it with 'putstamp'
+ teq
+ ret SZWORD ; return answer, true=1 false=0
+ end 0
+
+ pro $ISGET,0
+ LFL SZADDR ; get param, lb of frame to test
+ adp -SZWORD
+ loi SZWORD ; load frame stamp
+ loc GETSTAMP
+ cmi SZWORD ; compare it with 'getstamp'
+ teq
+ ret SZWORD ; return answer, true=1 false=0
+ end 0
--- /dev/null
+/* $Header$ */
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ * This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ * Dr. Andrew S. Tanenbaum
+ * Wiskundig Seminarium
+ * Vrije Universiteit
+ * Postbox 7161
+ * 1007 MC Amsterdam
+ * The Netherlands
+ *
+ */
+
+/* Author: J.W. Stevenson */
+/* extracted from hlt.c by C.H. Lindsey */
+
+#include <pc_file.h>
+
+extern char *_hbase;
+extern int *_extfl;
+extern _cls();
+extern exit();
+
+_cleanup() {
+ int i;
+
+ for (i = 1; i <= _extfl[0]; i++)
+ if (_extfl[i] != -1)
+ _cls(EXTFL(i));
+ return;
+}
--- /dev/null
+20000 #include "rundecs.h"
+20010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+20020 (**)
+20030 (**)
+20040 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
+20050 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+20060 (**)
+20070 (**)
+20080 FUNCTION COLLTP(TEMP:NAKEGER; UNIT: OBJECTP; TEMPLATE: DPOINT; OFFSET: OFFSETRANGE): ASNAKED;
+20090 (*PCOLLTOTAL+3*)
+20100 VAR OBJECT, STRUCTPTR: OBJECTP;
+20110 COUNT: INTEGER;
+20120 BEGIN WITH TEMP DO WITH NAK DO
+20130 BEGIN
+20140 OBJECT := INCPTR(POINTER, OFFSET);
+20150 STRUCTPTR := UNIT;
+20160 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
+20170 MOVELEFT(STRUCTPTR, OBJECT, ORD(TEMPLATE))
+20180 ELSE (*STRUCT*)
+20190 BEGIN
+20200 PCINCR(INCPTR(STRUCTPTR, STRUCTCONST), TEMPLATE, +INCRF);
+20210 MOVELEFT(INCPTR(STRUCTPTR, STRUCTCONST), OBJECT, TEMPLATE^[0]);
+20220 IF FPTST(STRUCTPTR^) THEN GARBAGE(STRUCTPTR);
+20230 END;
+20240 COLLTP := ASNAK;
+20250 END
+20260 END;
+20270 (**)
+20280 (**)
+20290 FUNCTION COLLNP(TEMP: NAKEGER; NAKUNIT: NAKEGER; TEMPLATE: DPOINT; OFFSET: OFFSETRANGE): ASNAKED;
+20300 (*PCOLLNAKED+3*)
+20310 VAR OBJECT: UNDRESSP;
+20320 COUNT: INTEGER;
+20330 BEGIN WITH TEMP DO WITH NAK DO
+20340 BEGIN
+20350 OBJECT := INCPTR(POINTER, OFFSET);
+20360 WITH NAKUNIT.NAK DO
+20370 BEGIN
+20380 PCINCR(POINTER, TEMPLATE, +INCRF);
+20390 MOVELEFT(POINTER, OBJECT, TEMPLATE^[0]);
+20400 IF FPTST(STOWEDVAL^) THEN GARBAGE(STOWEDVAL);
+20410 END;
+20420 COLLNP := ASNAK;
+20430 END
+20440 END;
+20450 (**)
+20460 (**)
+20470 (*-02() BEGIN END ; ()-02*)
+20480 (*+01()
+20490 BEGIN (*OF MAIN PROGRAM*)
+20500 END (*OF EVERYTHING*).
+20510 ()+01*)
--- /dev/null
+20600 #include "rundecs.h"
+20610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+20620 (**)
+20630 (**)
+20640 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+20650 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+20660 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN;
+20670 PROCEDURE PCINCRSLICE(MULT: OBJECTP; VAR APDESC: PDESC; INCREMENT: INTEGER); EXTERN;
+20680 PROCEDURE PCINCRMULT(ELSPTR: OBJECTP; INCREMENT: INTEGER); EXTERN;
+20690 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN;
+20700 (**)
+20710 (**)
+20720 FUNCTION COLLTM(TEMP: NAKEGER; SOURCEMULT: OBJECTP; OFFSET: OFFSETRANGE): ASNAKED;
+20730 (*PCOLLTOTAL+4*)
+20740 VAR DESTMULT: OBJECTP;
+20750 SOURCELS: OBJECTP;
+20760 PDESC1: PDESC;
+20770 COUNT: INTEGER;
+20780 BEGIN
+20790 WITH TEMP DO WITH NAK DO
+20800 BEGIN
+20810 DESTMULT := STOWEDVAL;
+20820 WITH SOURCEMULT^ DO
+20830 FOR COUNT := 0 TO ROWS DO WITH DESCVEC[COUNT] DO
+20840 IF (LI<>DESTMULT^.DESCVEC[COUNT].LI)
+20850 OR (UI<>DESTMULT^.DESCVEC[COUNT].UI) THEN
+20860 ERRORR(RMULASS);
+20870 SOURCELS := SOURCEMULT^.PVALUE;
+20880 COUNT := OFFSET;
+20890 IF SOURCEMULT^.BPTR<>NIL THEN (*A SLICE*)
+20900 BEGIN
+20910 FORMPDESC(SOURCEMULT, PDESC1);
+20920 PCINCRSLICE(SOURCEMULT, PDESC1, +INCRF);
+20930 WITH POINTER^ DO
+20940 WHILE NEXTEL(0, PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
+20950 BEGIN
+20960 MOVELEFT(INCPTR(SOURCELS, PP), INCPTR(POINTER, COUNT), PSIZE);
+20970 COUNT := COUNT+PSIZE;
+20980 END;
+20990 END
+21000 ELSE (*NOT A SLICE*)
+21010 BEGIN
+21020 PCINCRMULT(SOURCELS, +INCRF);
+21030 MOVELEFT(INCPTR(SOURCELS, ELSCONST), INCPTR(POINTER, COUNT), SOURCELS^.D0);
+21040 END;
+21050 POINTER := INCPTR(POINTER, COUNT-OFFSET);
+21060 COLLTM := ASNAK;
+21070 END;
+21080 IF FPTST(SOURCEMULT^) THEN GARBAGE(SOURCEMULT)
+21090 END;
+21100 (**)
+21110 (**)
+21120 (*-02() BEGIN END ; ()-02*)
+21130 (*+01()
+21140 BEGIN (*OF MAIN PROGRAM*)
+21150 END (*OF EVERYTHING*).
+21160 ()+01*)
--- /dev/null
+21800 #include "rundecs.h"
+21810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+21820 (**)
+21830 (**)
+21840 (*-01() (*-05()
+21850 FUNCTION COLLTS(TEMP: NAKEGER; UNIT: A68INT; OFFSET: OFFSETRANGE): ASNAKED;
+21860 (*PCOLLTOTAL - USUALLY CODED INLINE*)
+21870 VAR OBJECT: UNDRESSP;
+21880 BEGIN WITH TEMP DO WITH NAK DO
+21890 BEGIN
+21900 OBJECT := INCPTR(POINTER, OFFSET);
+21910 OBJECT^.FIRSTINT := UNIT;
+21920 COLLTS := ASNAK;
+21930 END
+21940 END;
+21950 (**)
+21960 (**)
+21970 FUNCTION COLLTS2(TEMP: NAKEGER; UNIT: A68LONG; OFFSET: OFFSETRANGE): ASNAKED;
+21980 (*PCOLLTOTAL+1 - USUALLY CODED INLINE*)
+21990 VAR OBJECT: UNDRESSP;
+22000 BEGIN WITH TEMP DO WITH NAK DO
+22010 BEGIN
+22020 OBJECT := INCPTR(POINTER, OFFSET);
+22030 OBJECT^.FIRSTLONG := UNIT;
+22040 COLLTS2 := ASNAK;
+22050 END
+22060 END;
+22070 (**)
+22080 (**)
+22090 FUNCTION COLLTPT(TEMP: NAKEGER; UNIT: OBJECTP; OFFSET: OFFSETRANGE): ASNAKED;
+22100 (*PCOLLTOTAL+2 - USUALLY CODED INLINE*)
+22110 VAR OBJECT: UNDRESSP ;
+22120 BEGIN WITH TEMP DO WITH NAK DO
+22130 BEGIN
+22140 OBJECT := INCPTR(POINTER, OFFSET);
+22150 WITH OBJECT^ DO
+22160 BEGIN FIRSTPTR := UNIT; WITH FIRSTPTR^ DO FINC END;
+22170 COLLTPT := ASNAK;
+22180 END
+22190 END;
+22200 (**)
+22210 (**)
+22220 ()-05*) ()-01*)
+22230 (**)
+22240 (**)
+22250 (*-02() BEGIN END ; ()-02*)
+22260 (*+01()
+22270 BEGIN (*OF MAIN PROGRAM*)
+22280 END (*OF EVERYTHING*).
+22290 ()+01*)
--- /dev/null
+22300 #include "rundecs.h"
+22310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+22320 (**)
+22330 PROCEDURE ERRORR(N: INTEGER);EXTERN;
+22340 PROCEDURE GARBAGE(ANOBJECT: OBJECTP);EXTERN;
+22350 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+22360 (**)
+22370 (**)
+22380 FUNCTION CRCOMPLEX(REPART,IMAGPART: REAL): OBJECTP;
+22390 VAR NEWCOMPLEX: OBJECTP;
+22400 BEGIN
+22410 ENEW(NEWCOMPLEX, STRUCTCONST+2*SZREAL);
+22420 WITH NEWCOMPLEX^ DO
+22430 BEGIN
+22440 (*-02() FIRSTWORD := SORTSHIFT * ORD(STRUCT); ()-02*)
+22450 (*+02() PCOUNT:=0; SORT:=STRUCT; ()+02*)
+22460 LENGTH := STRUCTCONST+2*SZREAL;
+22470 DBLOCK := COMPLEX;
+22480 RE := REPART;
+22490 IM := IMAGPART
+22500 END;
+22510 CRCOMPLEX := NEWCOMPLEX
+22520 END;
+22530 (**)
+22540 (**)
+22550 FUNCTION WIDREAL(REA: REAL): OBJECTP;
+22560 (*PWIDEN+2*)
+22570 BEGIN
+22580 WIDREAL := CRCOMPLEX(REA,0.0)
+22590 END;
+22600 (**)
+22610 (**)
+22620 FUNCTION CPLUS(LEFT,RIGHT: OBJECTP): OBJECTP;
+22630 VAR NEWOBJ: OBJECTP;
+22640 BEGIN
+22650 IF FPTST(LEFT^) THEN NEWOBJ := LEFT
+22660 ELSE IF FPTST(RIGHT^) THEN NEWOBJ := RIGHT
+22670 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+22680 WITH NEWOBJ^ DO
+22690 BEGIN
+22700 RE := LEFT^.RE+RIGHT^.RE;
+22710 IM := LEFT^.IM+RIGHT^.IM
+22720 END;
+22730 IF (FPTST(LEFT^)) AND (FPTST(RIGHT^)) THEN GARBAGE(RIGHT);
+22740 CPLUS := NEWOBJ
+22750 END;
+22760 (**)
+22770 (**)
+22780 FUNCTION CMINUS(LEFT,RIGHT: OBJECTP): OBJECTP;
+22790 VAR NEWOBJ: OBJECTP;
+22800 BEGIN
+22810 IF FPTST(LEFT^) THEN NEWOBJ := LEFT
+22820 ELSE IF FPTST(RIGHT^) THEN NEWOBJ := RIGHT
+22830 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+22840 WITH NEWOBJ^ DO
+22850 BEGIN
+22860 RE := LEFT^.RE-RIGHT^.RE;
+22870 IM := LEFT^.IM-RIGHT^.IM
+22880 END;
+22890 IF (FPTST(LEFT^)) AND (FPTST(RIGHT^)) THEN GARBAGE(RIGHT);
+22900 CMINUS := NEWOBJ
+22910 END;
+22920 (**)
+22930 (**)
+22940 FUNCTION CTIMS(LEFT,RIGHT: OBJECTP): OBJECTP;
+22950 VAR NEWOBJ: OBJECTP;
+22960 TEMPREAL: REAL;
+22970 BEGIN
+22980 IF FPTST(LEFT^) THEN NEWOBJ := LEFT
+22990 ELSE IF FPTST(RIGHT^) THEN NEWOBJ := RIGHT
+23000 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+23010 TEMPREAL := LEFT^.RE*RIGHT^.RE-LEFT^.IM*RIGHT^.IM;
+23020 WITH NEWOBJ^ DO
+23030 BEGIN
+23040 IM := LEFT^.RE*RIGHT^.IM+LEFT^.IM*RIGHT^.RE;
+23050 RE := TEMPREAL
+23060 END;
+23070 IF (FPTST(LEFT^)) AND (FPTST(RIGHT^)) THEN GARBAGE(RIGHT);
+23080 CTIMS := NEWOBJ
+23090 END;
+23100 (**)
+23110 (**)
+23120 FUNCTION CDIV(LEFT,RIGHT: OBJECTP): OBJECTP;
+23130 VAR NEWOBJ: OBJECTP;
+23140 TEMPREAL,RIGHTSQR: REAL;
+23150 BEGIN
+23160 IF FPTST(LEFT^) THEN NEWOBJ := LEFT
+23170 ELSE IF FPTST(RIGHT^) THEN NEWOBJ := RIGHT
+23180 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+23190 RIGHTSQR := SQR(RIGHT^.RE)+SQR(RIGHT^.IM);
+23200 TEMPREAL := (LEFT^.RE*RIGHT^.RE+LEFT^.IM*RIGHT^.IM)/RIGHTSQR;
+23210 WITH NEWOBJ^ DO
+23220 BEGIN
+23230 IM := (LEFT^.IM*RIGHT^.RE-LEFT^.RE*RIGHT^.IM)/RIGHTSQR;
+23240 RE := TEMPREAL
+23250 END;
+23260 IF (FPTST(LEFT^)) AND (FPTST(RIGHT^)) THEN GARBAGE(RIGHT);
+23270 CDIV := NEWOBJ
+23280 END;
+23290 (**)
+23300 (**)
+23310 FUNCTION CNEGI(CNUMB: OBJECTP): OBJECTP;
+23320 VAR NEWOBJ: OBJECTP;
+23330 BEGIN
+23340 IF FPTST(CNUMB^) THEN NEWOBJ := CNUMB
+23350 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+23360 WITH NEWOBJ^ DO
+23370 BEGIN
+23380 RE := -CNUMB^.RE;
+23390 IM := -CNUMB^.IM
+23400 END;
+23410 CNEGI := NEWOBJ
+23420 END;
+23430 (**)
+23440 (**)
+23450 FUNCTION CCONJ(CNUMB: OBJECTP): OBJECTP;
+23460 VAR NEWOBJ: OBJECTP;
+23470 BEGIN
+23480 IF FPTST(CNUMB^) THEN NEWOBJ := CNUMB
+23490 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+23500 WITH NEWOBJ^ DO
+23510 BEGIN
+23520 RE := CNUMB^.RE;
+23530 IM := -CNUMB^.IM
+23540 END;
+23550 CCONJ := NEWOBJ
+23560 END;
+23570 (**)
+23580 (**)
+23590 FUNCTION CRE(CNUMB: OBJECTP): REAL;
+23600 BEGIN
+23610 CRE := CNUMB^.RE;
+23620 IF FPTST(CNUMB^) THEN GARBAGE(CNUMB)
+23630 END;
+23640 (**)
+23650 (**)
+23660 FUNCTION CIM(CNUMB: OBJECTP): REAL;
+23670 BEGIN
+23680 CIM := CNUMB^.IM;
+23690 IF FPTST(CNUMB^) THEN GARBAGE(CNUMB)
+23700 END;
+23710 (**)
+23720 (**)
+23730 FUNCTION CABSI(CNUMB: OBJECTP): REAL;
+23740 BEGIN
+23750 WITH CNUMB^ DO
+23760 CABSI := SQRT(SQR(RE)+SQR(IM));
+23770 IF FPTST(CNUMB^) THEN GARBAGE(CNUMB)
+23780 END;
+23790 (**)
+23800 (**)
+23810 FUNCTION ARG(CNUMB: OBJECTP): REAL;
+23820 VAR RESULT: REAL;
+23830 BEGIN
+23840 WITH CNUMB^ DO
+23850 IF (RE<>0.0) OR (IM<>0.0) THEN
+23860 IF ABS(RE)>ABS(IM) THEN
+23870 RESULT := ARCTAN(IM/RE)+HALFPI.ACTUALPI*(1-ORD(RE>0.0))*2*(1-2*ORD(IM<0.0))
+23880 ELSE RESULT := -ARCTAN(RE/IM)+HALFPI.ACTUALPI*(ORD(IM>0.0)-ORD(IM<0.0))
+23890 ELSE ERRORR(RARG);
+23900 ARG := RESULT
+23910 END;
+23920 (**)
+23930 (**)
+23940 FUNCTION CARG(CNUMB: OBJECTP): REAL;
+23950 BEGIN
+23960 CARG := ARG(CNUMB);
+23970 IF FPTST(CNUMB^) THEN GARBAGE(CNUMB)
+23980 END;
+23990 (**)
+24000 (**)
+24010 FUNCTION CPOW(CNUMB: OBJECTP;POW: INTEGER): OBJECTP;
+24020 VAR NEWOBJ: OBJECTP;
+24030 CMOD,CMODPOW,NTHETA: REAL;
+24040 NEGPOW: BOOLEAN;
+24050 BEGIN
+24060 IF FPTST(CNUMB^) THEN NEWOBJ := CNUMB
+24070 ELSE NEWOBJ := CRCOMPLEX(0.0,0.0);
+24080 WITH CNUMB^ DO
+24090 CMOD := SQRT(SQR(RE)+SQR(IM));
+24100 IF CMOD<>0.0 THEN
+24110 BEGIN
+24120 NEGPOW := POW<0;
+24130 POW := ABS(POW);
+24140 NTHETA := POW*ARG(CNUMB);
+24150 CMODPOW := 1;
+24160 WHILE POW<>0 DO
+24170 BEGIN
+24180 IF POW MOD 2=1 THEN CMODPOW := CMODPOW*CMOD;
+24190 CMOD := SQR(CMOD);
+24200 POW := POW DIV 2
+24210 END;
+24220 WITH NEWOBJ^ DO
+24230 BEGIN
+24240 RE := COS(NTHETA)*CMODPOW;
+24250 IM := SIN(NTHETA)*CMODPOW;
+24260 IF NEGPOW THEN
+24270 BEGIN
+24280 CMOD := SQR(RE)+SQR(IM);
+24290 RE := RE/CMOD;
+24300 IM := -IM/CMOD
+24310 END
+24320 END
+24330 END
+24340 ELSE WITH NEWOBJ^ DO
+24350 BEGIN
+24360 RE := 0.0;
+24370 IM := 0.0
+24380 END;
+24390 CPOW := NEWOBJ;
+24400 END;
+24410 (**)
+24420 (**)
+24430 FUNCTION CEQ(LEFT,RIGHT: OBJECTP): INTEGER;
+24440 VAR EQUALS: BOOLEAN;
+24450 BEGIN
+24460 EQUALS := (LEFT^.RE=RIGHT^.RE) AND (LEFT^.IM=RIGHT^.IM);
+24470 IF FPTST(LEFT^) THEN GARBAGE(LEFT);
+24480 IF FPTST(RIGHT^) THEN GARBAGE(RIGHT);
+24490 IF EQUALS THEN CEQ := TRUEVAL ELSE CEQ := 0
+24500 END;
+24510 (**)
+24520 (**)
+24530 FUNCTION CNE(LEFT,RIGHT: OBJECTP): INTEGER;
+24540 VAR NOTEQUAL: BOOLEAN;
+24550 BEGIN
+24560 NOTEQUAL := (LEFT^.RE<>RIGHT^.RE) OR (LEFT^.IM<>RIGHT^.IM);
+24570 IF FPTST(LEFT^) THEN GARBAGE(LEFT);
+24580 IF FPTST(RIGHT^) THEN GARBAGE(RIGHT);
+24590 IF NOTEQUAL THEN CNE := TRUEVAL ELSE CNE := 0
+24600 END;
+24610 (**)
+24620 (**)
+24630 FUNCTION CPLUSAB(DESTINATION,INCREMENT: OBJECTP): OBJECTP;
+24640 VAR REALPTR: UNDRESSP;
+24650 BEGIN
+24660 REALPTR := SAFEACCESS(DESTINATION);
+24670 REALPTR^.FIRSTREAL := REALPTR^.FIRSTREAL+INCREMENT^.RE;
+24680 REALPTR := INCPTR(REALPTR,SZREAL);
+24690 REALPTR^.FIRSTREAL := REALPTR^.FIRSTREAL+INCREMENT^.IM;
+24700 IF FPTST(INCREMENT^) THEN GARBAGE(INCREMENT);
+24710 CPLUSAB := DESTINATION
+24720 END;
+24730 (**)
+24740 (**)
+24750 FUNCTION CMINAB(DESTINATION,DECREMENT: OBJECTP): OBJECTP;
+24760 VAR REALPTR: UNDRESSP;
+24770 BEGIN
+24780 REALPTR := SAFEACCESS(DESTINATION);
+24790 REALPTR^.FIRSTREAL := REALPTR^.FIRSTREAL-DECREMENT^.RE;
+24800 REALPTR := INCPTR(REALPTR,SZREAL);
+24810 REALPTR^.FIRSTREAL := REALPTR^.FIRSTREAL-DECREMENT^.IM;
+24820 IF FPTST(DECREMENT^) THEN GARBAGE(DECREMENT);
+24830 CMINAB := DESTINATION
+24840 END;
+24850 (**)
+24860 (**)
+24870 FUNCTION CTIMSAB(DESTINATION,FACTOR: OBJECTP): OBJECTP;
+24880 VAR REALPTR,IMAGPTR: UNDRESSP;
+24890 TEMPREAL: REAL;
+24900 BEGIN
+24910 REALPTR := SAFEACCESS(DESTINATION);
+24920 IMAGPTR := INCPTR(REALPTR,SZREAL);
+24930 TEMPREAL := REALPTR^.FIRSTREAL*FACTOR^.RE-IMAGPTR^.FIRSTREAL*FACTOR^.IM;
+24940 IMAGPTR^.FIRSTREAL := REALPTR^.FIRSTREAL*FACTOR^.IM+IMAGPTR^.FIRSTREAL*FACTOR^.RE;
+24950 REALPTR^.FIRSTREAL := TEMPREAL;
+24960 IF FPTST(FACTOR^) THEN GARBAGE(FACTOR);
+24970 CTIMSAB := DESTINATION
+24980 END;
+24990 (**)
+25000 (**)
+25010 FUNCTION CDIVAB(DESTINATION,DIVISOR: OBJECTP): OBJECTP;
+25020 VAR REALPTR,IMAGPTR: UNDRESSP;
+25030 TEMPREAL,DIVISORSQR: REAL;
+25040 BEGIN
+25050 REALPTR := SAFEACCESS(DESTINATION);
+25060 IMAGPTR := INCPTR(REALPTR,SZREAL);
+25070 DIVISORSQR := SQR(DIVISOR^.RE)+SQR(DIVISOR^.IM);
+25080 TEMPREAL := (REALPTR^.FIRSTREAL*DIVISOR^.RE+IMAGPTR^.FIRSTREAL*DIVISOR^.IM)/DIVISORSQR;
+25090 IMAGPTR^.FIRSTREAL := (IMAGPTR^.FIRSTREAL*DIVISOR^.RE-REALPTR^.FIRSTREAL*DIVISOR^.IM)/DIVISORSQR;
+25100 REALPTR^.FIRSTREAL := TEMPREAL;
+25110 IF FPTST(DIVISOR^) THEN GARBAGE(DIVISOR);
+25120 CDIVAB := DESTINATION
+25130 END;
+25140 (**)
+25150 (**)
+25160 (*-02()
+25170 BEGIN (* OF A68 *)
+25180 END (* OF A68 *);
+25190 ()-02*)
+25200 (*+01()
+25210 BEGIN (* OF MAIN PROGRAM *)
+25220 END (* OF MAIN PROGRAM *).
+25230 ()+01*)
--- /dev/null
+extern double _cos();
+double COS(statlink, x)
+ int *statlink; double x;
+ {return(_cos(x));}
--- /dev/null
+26000 #include "rundecs.h"
+26010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+26020 (**)
+26030 (**)
+26040 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN;
+26050 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
+26060 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+26070 (**)
+26080 (**)
+26090 FUNCTION BOUND(ROWCOUNT: INTEGER): OBJECTP;
+26100 (*PBOUNDS*)
+26110 VAR NEWMULT: OBJECTP;
+26120 DESCDEX: INTEGER; BND: BOUNDSRANGE;
+26130 BEGIN
+26140 ENEW(NEWMULT, MULTCONST+ROWCOUNT*SZPDS);
+26150 WITH NEWMULT^ DO
+26160 BEGIN
+26170 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
+26180 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
+26190 (*+01() SECONDWORD := 0; ()+01*)
+26200 OSCOPE := 0 ;
+26210 FOR DESCDEX := 0 TO ROWCOUNT-1 DO
+26220 WITH DESCVEC[DESCDEX] DO
+26230 BEGIN
+26240 BND := GETSTKTOP(SZINT, DESCDEX*2*SZINT);
+26250 IF BND=INTUNDEF THEN ERRORR(RCUPPER); UI := BND;
+26260 BND := GETSTKTOP(SZINT, DESCDEX*2*SZINT+SZINT);
+26270 IF BND=INTUNDEF THEN ERRORR(RCLOWER); LI := BND;
+26280 END;
+26290 ROWS := ROWCOUNT-1;
+26300 PVALUE := NIL;
+26310 IHEAD := NIL; FPTR := NIL; BPTR := NIL
+26320 END;
+26330 BOUND := NEWMULT;
+26340 END;
+26350 (**)
+26360 (**)
+26370 FUNCTION CRMULT(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP;
+26380 (*PACTDRMULT*)
+26390 VAR NEWELS: OBJECTP;
+26400 SUM, ELSIZE, INDEX, DESCDEX, TEMPOS, STRUCTPOS, INC: INTEGER;
+26410 PTR, LIMIT: UNDRESSP;
+26420 BEGIN
+26430 WITH NEWMULT^ DO
+26440 BEGIN
+26450 IF ORD(TEMPLATE)=0 THEN ELSIZE := SZADDR (*DRESSED*)
+26460 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN ELSIZE := ORD(TEMPLATE) (*UNDRESSED*)
+26470 ELSE ELSIZE := TEMPLATE^[0]; (*STRUCT*)
+26480 SIZE:= ELSIZE;
+26490 SUM:= 0;
+26500 FOR DESCDEX := 0 TO ROWS DO
+26510 WITH DESCVEC[DESCDEX] DO
+26520 BEGIN
+26530 DI:= ELSIZE;
+26540 SUM := SUM+LI*ELSIZE;
+26550 ELSIZE:= (UI-LI+1)*ELSIZE;
+26560 IF ELSIZE <= 0 THEN
+26570 ELSIZE:= 0
+26580 END;
+26590 LBADJ := SUM-ELSCONST;
+26600 MDBLOCK := TEMPLATE;
+26610 ENEW(NEWELS, ELSCONST+ELSIZE);
+26620 WITH NEWELS^ DO
+26630 BEGIN
+26640 (*-02() FIRSTWORD := SORTSHIFT*ORD(IELS)+INCRF; ()-02*)
+26650 (*+02() PCOUNT:=1; SORT:=IELS; ()+02*)
+26660 OSCOPE := 0;
+26670 DBLOCK:= TEMPLATE;
+26680 D0:= ELSIZE;
+26690 CCOUNT:= 1;
+26700 PTR := INCPTR(NEWELS, ELSCONST);
+26710 IHEAD := NIL;
+26720 (*-02()
+26730 IF ORD(TEMPLATE)=0 THEN BEGIN PTR^.FIRSTPTR := UNDEFIN; INC := SZADDR END (*DRESSED*)
+26740 ELSE BEGIN PTR^.FIRSTWORD := INTUNDEF; INC := SZWORD END; (*UNDRESSED*)
+26750 MOVELEFT(PTR, INCPTR(PTR, INC), ELSIZE-INC);
+26760 ()-02*)
+26770 (*+02()
+26780 LIMIT := INCPTR(PTR, ELSIZE);
+26790 IF ORD(TEMPLATE)=0 THEN WHILE PTR<>LIMIT DO
+26800 BEGIN PTR^.FIRSTPTR := UNDEFIN; PTR := INCPTR(PTR, SZADDR) END
+26810 ELSE WHILE PTR<>LIMIT DO
+26820 BEGIN PTR^.FIRSTWORD := INTUNDEF; PTR := INCPTR(PTR, SZWORD) END;
+26830 ()+02*)
+26840 IF ORD(TEMPLATE)>MAXSIZE (*STRUCT*) THEN
+26850 BEGIN
+26860 ELSIZE:= TEMPLATE^[0];
+26870 INDEX:= 0;
+26880 WHILE INDEX < D0 DO
+26890 BEGIN
+26900 TEMPOS:= 1;
+26910 STRUCTPOS:= TEMPLATE^[1];
+26920 WHILE STRUCTPOS >= 0 DO
+26930 BEGIN
+26940 PTR := INCPTR(NEWELS, ELSCONST+INDEX+STRUCTPOS);
+26950 PTR^.FIRSTPTR := UNDEFIN;
+26960 TEMPOS:= TEMPOS+1;
+26970 STRUCTPOS:= TEMPLATE^[TEMPOS]
+26980 END;
+26990 INDEX:= INDEX+ELSIZE
+27000 END
+27010 END
+27020 END;
+27030 PVALUE:= NEWELS
+27040 END;
+27050 CRMULT := NEWMULT
+27060 END;
+27070 (**)
+27080 (**)
+27090 FUNCTION CRREFR(ANOBJECT: OBJECTP): OBJECTP;
+27100 (*PCREATEREF+2*)
+27110 VAR NEWREFR: OBJECTP;
+27120 BEGIN
+27130 WITH ANOBJECT^ DO
+27140 BEGIN
+27150 IF (BPTR<>NIL) AND (SORT=MULT) THEN (*SOURCE IS A SLICE*)
+27160 COPYSLICE(ANOBJECT);
+27170 IF FTST THEN
+27180 BEGIN NEWREFR := ANOBJECT; NEWREFR^.SORT := REFR END
+27190 ELSE
+27200 BEGIN
+27210 NEWREFR := COPYDESC(ANOBJECT, REFR);
+27220 WITH NEWREFR^.PVALUE^ DO FINC
+27230 END
+27240 END;
+27250 WITH NEWREFR^ DO
+27260 BEGIN
+27270 OSCOPE := SCOPE+FIRSTRG.RIBOFFSET^.RGSCOPE;
+27280 ANCESTOR:= NEWREFR;
+27290 CCOUNT:= 1;
+27300 END;
+27310 CRREFR := NEWREFR;
+27320 END;
+27330 (**)
+27340 (**)
+27350 FUNCTION CHKDESC(SOURCEMULT, CDESC: OBJECTP): OBJECTP;
+27360 (*PCHECKDESC*)
+27370 VAR COUNT: INTEGER;
+27380 BEGIN
+27390 IF SOURCEMULT^.SORT=UNDEF THEN ERRORR(RMULASS);
+27400 FOR COUNT:= 0 TO CDESC^.ROWS
+27410 DO WITH CDESC^.DESCVEC[COUNT], SOURCEMULT^ DO
+27420 IF (LI <> DESCVEC[COUNT].LI)
+27430 OR (UI <> DESCVEC[COUNT].UI)
+27440 THEN ERRORR(RMULASS);
+27450 CHKDESC := SOURCEMULT;
+27460 END;
+27470 (**)
+27480 (**)
+27490 (*-02() BEGIN END ; ()-02*)
+27500 (*+01()
+27510 BEGIN (*OF MAIN PROGRAM*)
+27520 END (*OF EVERYTHING*).
+27530 ()+01*)
--- /dev/null
+27600 #include "rundecs.h"
+27610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+27620 (**)
+27630 (**)
+27640 FUNCTION CRREFN(ANOBJECT: OBJECTP): OBJECTP;
+27650 (*PCREATEREF*)
+27660 VAR NEWREFN: OBJECTP;
+27670 BEGIN
+27680 ENEW(NEWREFN, REFNSIZE);
+27690 WITH NEWREFN^ DO
+27700 BEGIN
+27710 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFN); ()-02*)
+27720 (*+02() PCOUNT:=0; SORT:=REFN; ()+02*)
+27730 (*+01() SECONDWORD := 0; ()+01*)
+27740 ANCESTOR := NEWREFN;
+27750 OFFSET := STRUCTCONST;
+27760 PVALUE := ANOBJECT;
+27770 OSCOPE := SCOPE+FIRSTRG.RIBOFFSET^.RGSCOPE;
+27780 WITH ANOBJECT^ DO FINC;
+27790 END;
+27800 CRREFN := NEWREFN;
+27810 END;
+27820 (**)
+27830 (**)
+27840 (*-02() BEGIN END ; ()-02*)
+27850 (*+01()
+27860 BEGIN (*OF MAIN PROGRAM*)
+27870 END (*OF EVERYTHING*).
+27880 ()+01*)
--- /dev/null
+28000 #include "rundecs.h"
+28010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+28020 (**)
+28030 (**)
+28040 PROCEDURE DCLSN( COUNT: DEPTHRANGE ; OFFSET: OFFSETRANGE ) ;
+28050 VAR PTR: UNDRESSP ;
+28060 I : INTEGER ;
+28070 BEGIN
+28080 PTR := INCPTR( ASPTR(STATIC( ME )) , (*+41() - ()+41*) OFFSET ) ;
+28090 FOR I := COUNT DIV SZINT - 1 DOWNTO 0 DO
+28100 BEGIN
+28110 (*+41() PTR := INCPTR( PTR , - SZINT ) ; ()+41*)
+28120 PTR ^.FIRSTINT := GETSTKTOP( SZINT , SZINT * I ) ;
+28130 (*-41() PTR := INCPTR( PTR , SZINT ) ()-41*)
+28140 END
+28150 END ;
+28160 (**)
+28170 PROCEDURE DCLPN( COUNT: DEPTHRANGE ; OFFSET: OFFSETRANGE ) ;
+28180 VAR PTR: UNDRESSP ;
+28190 I: INTEGER ;
+28200 BEGIN
+28210 PTR := INCPTR( ASPTR(STATIC( ME )) , (*+41() - ()+41*) OFFSET ) ;
+28220 FOR I := COUNT DIV SZADDR - 1 DOWNTO 0 DO
+28230 BEGIN
+28240 (*+41() PTR := INCPTR( PTR , - SZADDR ) ; ()+41*)
+28250 PTR ^.FIRSTPTR := ASPTR(GETSTKTOP( SZADDR , SZADDR * I )) ;
+28260 WITH PTR ^ DO
+28270 WITH FIRSTPTR ^ DO
+28280 FINC;
+28290 (*-41() PTR := INCPTR( PTR , SZADDR ) ()-41*)
+28300 END
+28310 END ;
+28320 (**)
+28330 (**)
+28340 (*-02()
+28350 BEGIN
+28360 END ;
+28370 ()-02*)
+28380 (*+01()
+28390 BEGIN (*OF MAIN PROGRAM*)
+28400 END (*OF EVERYTHING*).
+28410 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exp $DIV
+
+ pro $DIV,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ lol SZADDR+SZWORD ; 1st param
+ loc SZWORD
+ loc SZREAL
+ cif
+ lol SZADDR ; 2nd param
+ loc SZWORD
+ loc SZREAL
+ cif
+ dvf SZREAL
+ ret SZREAL
+ end SZWORD
--- /dev/null
+28500 #include "rundecs.h"
+28510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+28520 (**)
+28530 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+28540 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+28550 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
+28560 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
+28570 (**)
+28580 (**)
+28590 FUNCTION DREFM(REFER: OBJECTP): OBJECTP;
+28600 (*PDEREF+4*)
+28610 VAR NEWMULT:OBJECTP;
+28620 BEGIN WITH REFER^ DO
+28630 CASE SORT OF
+28640 REFR, RECR:
+28650 BEGIN
+28660 IF FTST THEN
+28670 BEGIN
+28680 DREFM := REFER;
+28690 OSCOPE := PVALUE^.OSCOPE;
+28700 SORT := MULT
+28710 END
+28720 ELSE
+28730 BEGIN
+28740 NEWMULT := COPYDESC(REFER, MULT);
+28750 NEWMULT^.OSCOPE := PVALUE^.OSCOPE;
+28760 DREFM := NEWMULT;
+28770 FPINC(PVALUE^)
+28780 END
+28790 END;
+28800 REFSLN:
+28810 BEGIN
+28820 PVALUE := ANCESTOR;
+28830 IF FTST THEN
+28840 BEGIN
+28850 SORT := MULT;
+28860 DREFM := GETMULT(REFER);
+28870 FPDEC(ANCESTOR^);
+28880 IF FPTST(ANCESTOR^) THEN GARBAGE(ANCESTOR);
+28890 END
+28900 ELSE
+28910 DREFM := GETMULT(COPYDESC(REFER, MULT))
+28920 END;
+28930 UNDEF: ERRORR(RDEREF);
+28940 NILL: ERRORR(RDEREFNIL)
+28950 END
+28960 END;
+28970 (**)
+28980 (**)
+28990 (*-02()
+29000 BEGIN
+29010 END;
+29020 ()-02*)
+29030 (*+01()
+29040 BEGIN (*OF MAIN PROGRAM*)
+29050 END (*OF EVERYTHING*).
+29060 ()+01*)
--- /dev/null
+29100 #include "rundecs.h"
+29110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+29120 (**)
+29130 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+29140 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+29150 (**)
+29160 (**)
+29170 FUNCTION DREFS(REFER: OBJECTP): A68INT;
+29180 (*PDEREF*)
+29190 VAR PTR: UNDRESSP;
+29200 BEGIN WITH REFER^ DO
+29210 CASE SORT OF
+29220 REF1: DREFS := VALUE;
+29230 CREF: DREFS := IPTR^.FIRSTINT;
+29240 REFSL1: BEGIN PTR := INCPTR(ANCESTOR^.PVALUE, OFFSET); DREFS := PTR^.FIRSTINT END;
+29250 UNDEF: ERRORR(RDEREF);
+29260 NILL: ERRORR(RDEREFNIL);
+29270 END;
+29280 IF FPTST(REFER^) THEN GARBAGE(REFER)
+29290 END;
+29300 (**)
+29310 (**)
+29320 (*-01()
+29330 FUNCTION DREFS2(REFER: OBJECTP): A68LONG;
+29340 (*PDEREF+1*)
+29350 VAR PTR: UNDRESSP;
+29360 BEGIN WITH REFER^ DO
+29370 CASE SORT OF
+29380 REF2: DREFS2 := LONGVALUE;
+29390 CREF: DREFS2 := IPTR^.FIRSTLONG;
+29400 REFSL1: BEGIN PTR := INCPTR(ANCESTOR^.PVALUE, OFFSET); DREFS2 := PTR^.FIRSTLONG END;
+29410 UNDEF: ERRORR(RDEREF);
+29420 NILL: ERRORR(RDEREFNIL);
+29430 END;
+29440 IF FPTST(REFER^) THEN GARBAGE(REFER)
+29450 END;
+29460 (**)
+29470 (**)
+29480 ()-01*)
+29490 (**)
+29500 (**)
+29510 FUNCTION DREFPTR(REFER: OBJECTP): OBJECTP;
+29520 (*PDEREF+2*)
+29530 VAR RESULT: OBJECTP;
+29540 PTR: UNDRESSP;
+29550 BEGIN
+29560 WITH REFER^ DO
+29570 BEGIN
+29580 CASE SORT OF
+29590 RECN, REFN: RESULT := PVALUE;
+29600 CREF: RESULT := IPTR^.FIRSTPTR;
+29610 REFSL1: BEGIN PTR := INCPTR(ANCESTOR^.PVALUE, OFFSET); RESULT := PTR^.FIRSTPTR END;
+29620 UNDEF: ERRORR(RDEREF);
+29630 NILL: ERRORR(RDEREFNIL);
+29640 END;
+29650 IF SORT<>CREF THEN WITH RESULT^ DO
+29660 BEGIN
+29670 FINC;
+29680 IF FPTST(REFER^) THEN GARBAGE(REFER);
+29690 FDEC
+29700 END
+29710 ELSE IF FPTST(REFER^) THEN GARBAGE(REFER);
+29720 DREFPTR := RESULT;
+29730 END
+29740 END;
+29750 (**)
+29760 (**)
+29770 (*-02()
+29780 BEGIN
+29790 END;
+29800 ()-02*)
+29810 (*+01()
+29820 BEGIN (*OF MAIN PROGRAM*)
+29830 END (*OF EVERYTHING*).
+29840 ()+01*)
--- /dev/null
+70900 #include "rundecs.h"
+70910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+70920 (**)
+70930 (**)
+70940 (*+01() (*$X6*) ()+01*)
+70950 (**)
+70960 PROCEDURE DUMBACCH(PCOV: OBJECTP; LFN: LFNTYPE);
+70970 BEGIN PCOV^.POSSIBLES := [] END;
+70980 (**)
+70990 (**)
+71000 (*+01() (*$X4*) ()+01*)
+71010 (**)
+71020 (**)
+71030 (*-02()
+71040 BEGIN (*OF A68*)
+71050 END; (*OF A68*)
+71060 ()-02*)
+71070 (*+01()
+71080 BEGIN (*OF MAIN PROGRAM*)
+71090 END (* OF EVERYTHING *).
+71100 ()+01*)
--- /dev/null
+71200 #include "rundecs.h"
+71210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+71220 (**)
+71230 (*+01() (*$X6*) ()+01*)
+71240 (**)
+71250 (**)
+71260 PROCEDURE DUMINCH(PCOV: OBJECTP; LFN: LFNTYPE);
+71270 (*WHEN THERE ARE NOT 'GET'S IN THE PROGRAM*)
+71280 BEGIN PCOV^.POSSIBLES := [] ; (*+01() PCOV^.BOOK^.STATUS := 0 ()+01*) END;
+71290 (**)
+71300 (**)
+71310 (*+01() (*$X4*) ()+01*)
+71320 (**)
+71330 (**)
+71340 (*-02()
+71350 BEGIN (*OF A68*)
+71360 END; (*OF A68*)
+71370 ()-02*)
+71380 (*+01()
+71390 BEGIN (*OF MAIN PROGRAM*)
+71400 END (* OF EVERYTHING *).
+71410 ()+01*)
--- /dev/null
+29900 #include "rundecs.h"
+29910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+29920 (**)
+29930 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+29940 (**)
+29950 (**)
+29960 PROCEDURE DUMMY;
+29970 BEGIN
+29980 ERRORR(RDUMMY);
+29990 END;
+30000 (**)
+30010 (**)
+30020 (*-02()
+30030 BEGIN
+30040 END ;
+30050 ()-02*)
+30060 (*+01()
+30070 BEGIN (*OF MAIN PROGRAM*)
+30080 END (*OF EVERYTHING*).
+30090 ()+01*)
--- /dev/null
+71500 #include "rundecs.h"
+71510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+71520 (**)
+71530 (*+01() (*$X6*) ()+01*)
+71540 PROCEDURE AOPEN( EFET:FETROOMP; DISP:INTEGER; LFN:LFNTYPE; BUF:IPOINT ); EXTERN;
+71550 (**)
+71560 (**)
+71570 PROCEDURE DUMOUTCH(PCOV: OBJECTP; LFN: LFNTYPE);
+71580 BEGIN WITH PCOV^ DO
+71590 BEGIN
+71600 (**)
+71610 POSSIBLES := [];
+71620 AOPEN(BOOK, FORWRITE, LFN, ORD(BOOK)+BUFFOFFSET);
+71630 END
+71640 END;
+71650 (**)
+71660 (*+01() (*$X4*) ()+01*)
+71670 (**)
+71680 (**)
+71690 (*-02()
+71700 BEGIN (*OF A68*)
+71710 END; (*OF A68*)
+71720 ()-02*)
+71730 (*+01()
+71740 BEGIN (*OF MAIN PROGRAM*)
+71750 END (* OF EVERYTHING *).
+71760 ()+01*)
--- /dev/null
+#define SZADDR EM_PSIZE
+#define SZWORD EM_WSIZE
+#define SZLONG 4
+#define SZREAL 8
+#define SZPROC SZADDR+SZADDR
+
+#if SZWORD==2
+#if SZADDR==2
+#define FIRSTIBOFFSET 30 /* offset from .HTOP to main's LB */
+#else
+#define FIRSTIBOFFSET 50
+#endif
+#else
+#define FIRSTIBOFFSET 52
+#endif
+#define FSTAMPOFFSET FIRSTIBOFFSET+SZWORD
+/* the following four definitions are offsets to the file pointers */
+#define FILEOFFSET SZWORD+SZWORD+SZADDR+SZWORD+SZWORD+SZADDR+SZADDR+SZWORD+\
+ SZADDR+SZADDR+SZWORD+SZWORD+SZADDR
+#define STINOFFSET FIRSTIBOFFSET+FILEOFFSET
+#define STOUTOFFSET STINOFFSET+SZADDR
+#define STBACKOFFSET STOUTOFFSET+SZADDR
+#define ENTRYOFFSET SZADDR+SZWORD
+
+#if SZWORD==2
+#define PUTTVARSPACE 150 /* space, or greater used for locals in PUTT */
+#define GETTVARSPACE 350 /* space, or greater used for locals in GETT */
+#define LLC ldc /* for loading bit patterns */
+#else
+#define PUTTVARSPACE 300
+#define GETTVARSPACE 700
+#define LLC loc
+#endif
+#define HTOP 500 /* this must agree with what the compiler produces */
+#define A68STAMP 13476 /* this must agree with version in a68sdec.p */
+#define PASCALSTAMP 0 /* must match what the pascal compiler puts down */
+#define PUTSTAMP -1
+#define GETSTAMP -2
+
+/* this will only work if SZADDR = SWORD*2 or if SZADDR = SZWORD */
+
+#if SZADDR == SZWORD
+#define LFL lol
+#define SFL stl
+#define LFE loe
+#define SFE ste
+#define LFF lof
+#define SFF stf
+#else
+#define LFL ldl
+#define SFL sdl
+#define LFE lde
+#define SFE sde
+#define LFF ldf
+#define SFF sdf
+#endif
+
+ mes 2,SZWORD,SZADDR
+
--- /dev/null
+71800 #include "rundecs.h"
+71810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+71820 (**)
+71830 PROCEDURE GARBAGE(ANOBJECT: OBJECTP); EXTERN;
+71840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+71850 PROCEDURE CLPASC2(P1,P2: IPOINT; PROC: ASPROC); EXTERN;
+71860 (**)
+71870 (**)
+71880 (*+01() (*$X4*) ()+01*)
+71890 FUNCTION FUNC68(PB: ASNAKED; RF: OBJECTP): BOOLEAN; EXTERN;
+71900 (**)
+71910 (**)
+71920 PROCEDURE NEWLINE(RF:OBJECTP); EXTERN;
+71930 PROCEDURE NEWPAGE(RF:OBJECTP); EXTERN;
+71940 (**)
+71950 (**)
+71960 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP);
+71970 BEGIN WITH RF^ DO
+71980 CASE SORT OF
+71990 REFN: F:=PVALUE;
+72000 REFSL1: F := INCPTR(ANCESTOR^.PVALUE, OFFSET-STRUCTCONST);
+72010 UNDEF: ERRORR(RDEREF);
+72020 NILL: ERRORR(RDEREFNIL)
+72030 END (*CASE*)
+72040 END;
+72050 (**)
+72060 (**)
+72070 FUNCTION GETPROC(RN: OBJECTP): ASNAKED;
+72080 VAR TEMP: NAKEGER;
+72090 BEGIN
+72100 (*+01() TEMP.ASNAK := 0; ()+01*)
+72110 WITH RN^, TEMP.NAK DO
+72120 IF SORT=ROUTINE THEN
+72130 BEGIN
+72140 STOWEDVAL := ASPTR(ENVCHAIN); POINTER := ASPTR(ORD(PROCBL));
+72150 IF FTST THEN GARBAGE(RN);
+72160 END
+72170 ELSE IF SORT=PASCROUT THEN
+72180 BEGIN
+72190 (*-01() STOWEDVAL := NIL; ()-01*)
+72200 PASCPARAMS := PPARAMS; PASCPROC := PPROCBL ;
+72210 POINTER := ASPTR(ORD(PASCADDR));
+72220 IF FTST THEN GARBAGE(RN);
+72230 END
+72240 ELSE ERRORR(RROUTIN);
+72250 GETPROC := TEMP.ASNAK;
+72260 END;
+72270 (**)
+72280 (**)
+72290 PROCEDURE SETREADMOOD(PCOV:OBJECTP);
+72300 BEGIN WITH PCOV^ DO
+72310 IF NOT([READMOOD]<=STATUS) THEN
+72320 BEGIN IF NOT([GETPOSS]<=POSSIBLES)
+72330 THEN ERRORR(NOREAD)
+72340 ELSE IF [OPENED,WRITEMOOD,BINMOOD,NOTSET]<=STATUS THEN
+72350 ERRORR(NOALTER)
+72360 ELSE BEGIN (* BOOK NOT INITIALISED *)
+72370 STATUS:=STATUS+[READMOOD]-[WRITEMOOD];
+72380 IF NOTRESET IN STATUS THEN
+72390 CLPASC2(ORD(PCOV), ORD(BOOK), DORESET)
+72400 END;
+72410 IF PFE IN STATUS THEN STATUS := STATUS-[PFE]+[LFE]
+72420 (*ONLY APPLIES TO ASSOCIATED FILES FOR NOW*)
+72430 END (* WITH *)
+72440 END;
+72450 (**)
+72460 (**)
+72470 PROCEDURE SETWRITEMOOD(PCOV:OBJECTP);
+72480 BEGIN
+72490 WITH PCOV^ DO
+72500 IF NOT([WRITEMOOD]<=STATUS) THEN
+72510 BEGIN IF NOT([PUTPOSS]<=POSSIBLES)
+72520 THEN ERRORR(NOWRITE)
+72530 ELSE IF [OPENED,READMOOD,BINMOOD,NOTSET]<=STATUS THEN
+72540 ERRORR(NOALTER)
+72550 ELSE BEGIN STATUS:=STATUS+[WRITEMOOD]-[READMOOD,LFE];
+72560 IF NOTRESET IN STATUS THEN
+72570 CLPASC2(ORD(PCOV), ORD(BOOK), DORESET)
+72580 END;
+72590 IF POFCPOS>PAGEBOUND THEN STATUS := STATUS+[PFE];
+72600 END (* WITH *)
+72610 END;
+72620 (**)
+72630 (**)
+72640 PROCEDURE SETCHARMOOD(PCOV:OBJECTP);
+72650 BEGIN WITH PCOV^ DO
+72660 IF NOT([CHARMOOD]<=STATUS) THEN
+72670 IF [OPENED,BINMOOD,NOTSET]<=STATUS
+72680 THEN ERRORR(NOSHIFT)
+72690 ELSE STATUS:=STATUS+[CHARMOOD]-[BINMOOD]
+72700 END;
+72710 (**)
+72720 (**)
+72730 PROCEDURE SETBINMOOD(PCOV:OBJECTP);
+72740 BEGIN WITH PCOV^ DO
+72750 IF NOT([BINMOOD]<=STATUS) THEN
+72760 IF NOT([BINPOSS]<=POSSIBLES)
+72770 THEN ERRORR(NOBIN)
+72780 ELSE IF [OPENED,CHARMOOD,NOTSET]<=STATUS
+72790 THEN ERRORR(NOSHIFT)
+72800 ELSE STATUS:=STATUS+[BINMOOD]-[CHARMOOD]
+72810 END;
+72820 (**)
+72830 (**)
+72840 (*******ENSURE ROUTINES*******)
+72850 (**)
+72860 (**)
+72870 PROCEDURE ENSSTATE(RF:OBJECTP;VAR F:OBJECTP;READING:STATUSSET);
+72880 BEGIN TESTF(RF,F);
+72890 WITH F^ DO
+72900 IF NOT (READING<=PCOVER^.STATUS) THEN
+72910 IF [OPENED]<=PCOVER^.STATUS
+72920 THEN BEGIN
+72930 IF [READMOOD]<=READING
+72940 THEN SETREADMOOD(PCOVER)
+72950 ELSE SETWRITEMOOD(PCOVER);
+72960 IF [CHARMOOD]<=READING
+72970 THEN SETCHARMOOD(PCOVER)
+72980 ELSE SETBINMOOD(PCOVER)
+72990 END
+73000 ELSE ERRORR(NOTOPEN)
+73010 END;
+73020 (**)
+73030 (**)
+73040 FUNCTION ENSLOGICALFILE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN;
+73050 (*MOOD OK, LOG FILE GENERALLY NOT*)
+73060 VAR OLD: STATUSSET; MENDED: BOOLEAN;
+73070 COV: OBJECTP;
+73080 BEGIN WITH F^ DO
+73090 BEGIN
+73100 COV := PCOVER; WITH COV^ DO
+73110 BEGIN
+73120 IF NOTINITIALIZED IN STATUS THEN
+73130 BEGIN
+73140 CLPASC2(ORD(COV), ORD(BOOK), DONEWLINE);
+73150 LOFCPOS := LOFCPOS-1;
+73160 END;
+73170 OLD := STATUS;
+73180 END;
+73190 IF LFE IN OLD THEN
+73200 BEGIN
+73210 IF LOGICALFILEMENDED=UNDEFIN THEN MENDED := FALSE
+73220 ELSE MENDED:=FUNC68(GETPROC(LOGICALFILEMENDED),RF);
+73230 ENSSTATE(RF,F,OLD);
+73240 IF MENDED THEN
+73250 ENSLOGICALFILE:=ENSLOGICALFILE(RF,F)
+73260 ELSE ENSLOGICALFILE := FALSE
+73270 END
+73280 ELSE ENSLOGICALFILE:=TRUE;
+73290 END
+73300 END;
+73310 (**)
+73320 (**)
+73330 FUNCTION ENSPHYSICALFILE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN;
+73340 (* MOOD OK, FILE GENERALLY NOT *)
+73350 VAR OLD: STATUSSET; MENDED,LFOK: BOOLEAN;
+73360 BEGIN WITH F^ DO
+73370 IF [LFE]<=PCOVER^.STATUS
+73380 THEN LFOK:=ENSLOGICALFILE(RF,F)
+73390 ELSE LFOK:=TRUE;
+73400 IF LFOK THEN WITH F^ DO
+73410 BEGIN OLD:=PCOVER^.STATUS;
+73420 IF [PFE]<=OLD THEN
+73430 BEGIN
+73440 IF PHYSICALFILEMENDED=UNDEFIN THEN MENDED := FALSE
+73450 ELSE MENDED:=FUNC68(GETPROC(PHYSICALFILEMENDED),RF);
+73460 ENSSTATE(RF,F,OLD);
+73470 IF MENDED
+73480 THEN ENSPHYSICALFILE:=ENSPHYSICALFILE(RF,F)
+73490 ELSE ERRORR(NOPHYSICAL);
+73500 END
+73510 ELSE ENSPHYSICALFILE:=TRUE
+73520 END
+73530 ELSE ENSPHYSICALFILE:=FALSE;
+73540 END;
+73550 (**)
+73560 (**)
+73570 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN;
+73580 (* MOOD OK, PAGE GENERALLY NOT *)
+73590 VAR OLD: STATUSSET; PFOK,MENDED: BOOLEAN;
+73600 BEGIN WITH F^ DO
+73610 IF([PFE]<=PCOVER^.STATUS) OR ([LFE]<=PCOVER^.STATUS)
+73620 THEN PFOK:=ENSPHYSICALFILE(RF,F)
+73630 ELSE PFOK:=TRUE;
+73640 IF PFOK THEN WITH F^ DO
+73650 BEGIN OLD:=PCOVER^.STATUS;
+73660 IF [PAGEOVERFLOW]<=OLD THEN
+73670 BEGIN
+73680 IF PAGEMENDED=UNDEFIN THEN MENDED := FALSE
+73690 ELSE MENDED:=FUNC68(GETPROC(PAGEMENDED),RF);
+73700 ENSSTATE(RF,F,OLD);
+73710 IF NOT MENDED THEN NEWPAGE(RF);
+73720 ENSPAGE:=ENSPAGE(RF,F)
+73730 END
+73740 ELSE ENSPAGE:=TRUE
+73750 END
+73760 ELSE ENSPAGE:=FALSE;
+73770 END;
+73780 (**)
+73790 (**)
+73800 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN;
+73810 (* MOOD OK, LINE GENERALLY NOT *)
+73820 VAR PAGEOK,MENDED:BOOLEAN; OLD: STATUSSET;
+73830 BEGIN WITH F^ DO
+73840 IF [PAGEOVERFLOW]<=PCOVER^.STATUS
+73850 THEN PAGEOK:=ENSPAGE(RF,F)
+73860 ELSE PAGEOK:=TRUE;
+73870 IF PAGEOK THEN WITH F^ DO
+73880 BEGIN OLD:=PCOVER^.STATUS;
+73890 IF [LINEOVERFLOW]<=OLD THEN
+73900 BEGIN
+73910 IF LINEMENDED=UNDEFIN THEN MENDED := FALSE
+73920 ELSE MENDED:=FUNC68(GETPROC(LINEMENDED),RF);
+73930 ENSSTATE(RF,F,OLD);
+73940 IF NOT MENDED THEN NEWLINE(RF);
+73950 ENSLINE:=ENSLINE(RF,F)
+73960 END
+73970 ELSE ENSLINE:=TRUE
+73980 END
+73990 ELSE ENSLINE:=FALSE;
+74000 END;
+74010 (**)
+74020 (**)
+74030 (*-02()
+74040 BEGIN (*OF A68*)
+74050 END; (*OF A68*)
+74060 ()-02*)
+74070 (*+01()
+74080 BEGIN (*OF MAIN PROGRAM*)
+74090 END (* OF EVERYTHING *).
+74100 ()+01*)
--- /dev/null
+int ENTIER(statlink, a)
+ int *statlink ;
+ register double a ;
+ {
+ int n ;
+ n = ( int ) a ;
+ return( n < 0 && ( double ) n != a ? n - 1 : n ) ;
+ }
+int ROUN(statlink,a)
+ int *statlink ;
+ register double a ;
+ { return(ENTIER(statlink, a+0.5)) ;
+ }
--- /dev/null
+01000 #include "rundecs.h"
+01010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+01020 (**)
+01030 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN;
+01040 (*+05() FUNCTION TIME: REAL; EXTERN; ()+05*)
+01050 PROCEDURE ABORT; EXTERN;
+01060 PROCEDURE ACLOSE(EFET: FETROOMP); EXTERN;
+01070 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+01080 (**)
+01090 (**)
+01100 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP; EXTERN;
+01110 FUNCTION GETPROC(RN: OBJECTP): ASNAKED; EXTERN;
+01120 (*+02() FUNCTION GETLINENO :INTEGER; EXTERN; ()+02*)
+01130 (**)
+01140 (**)
+01150 PROCEDURE ERRORR(N :INTEGER); FORWARD;
+01160 (**)
+01170 (**)
+01180 FUNCTION RELSUP(REF: OBJECTP): UNDRESSP;
+01190 (*FINDS THE TRUE POINTER TO A REFERENCE VALUE*)
+01200 BEGIN
+01210 WITH REF^ DO
+01220 CASE SORT OF
+01230 REFSL1:
+01240 RELSUP := INCPTR(ANCESTOR, OFFSET);
+01250 REFSLN, UNDEF:
+01260 ERRORR(IDREL);
+01270 REF1, REF2, REFN, RECN, REFR, RECR, NILL:
+01280 RELSUP := ASPTR(ORD(REF));
+01290 CREF:
+01300 RELSUP := IPTR;
+01310 END;
+01320 IF FPTST(REF^) THEN GARBAGE(REF)
+01330 END;
+01340 (**)
+01350 (**)
+01360 PROCEDURE ERRORR (*N: INTEGER*);
+01370 TYPE BYTES = PACKED ARRAY [1..BYTESWIDTH] OF CHAR ;
+01380 VAR RANGE: PRANGE;
+01390 CURR: IPOINT;
+01400 XCASE: 0..15;
+01410 IDP: PIDBLK;
+01420 RP,RQ : RECORD CASE SEVERAL OF
+01430 1: ( PP : OBJECTPP ) ;
+01440 2: ( PI : ^ INTEGER ) ;
+01450 3: ( PR : ^ REAL ) ;
+01460 4: ( PB : ^ BYTES ) ;
+01470 5: ( PD : ^ INTEGER ) ;
+01480 0 , 6 , 7 , 8 , 9 , 10 : () ;
+01490 END ;
+01500 INT: INTEGER ;
+01510 POINT: OBJECTP ;
+01520 PI1: ^INTEGER ;
+01530 RANGECOUNT :INTEGER ; DECPOINT :OFFSETRANGE ; COUNT :INTEGER ;
+01540 LOOPTYP : INTEGER ;
+01550 THISWAS68: BOOLEAN ;
+01560 PFET: FETROOMP;
+01570 (*+02() LOCALRANGE :BOOLEAN ; ()+02*)
+01580 (*+54() EXCEPT: UNDRESSP; IB: IPOINT; RG: PRANGE; ()+54*)
+01590 PROCEDURE PRINTREAL(X: REAL);
+01600 VAR RTG: REALTEGER;
+01610 BEGIN WITH RTG DO
+01620 BEGIN
+01630 REA := X;
+01640 IF (INT=INTUNDEF) (*+05()OR (INT2=INTUNDEF)()+05*) THEN WRITE(OUTPUT, ' UNDEFINED')
+01650 ELSE WRITE(OUTPUT, X);
+01660 END
+01670 END;
+01680 PROCEDURE PRINTSINGLE(II :INTEGER);
+01690 (*+01()
+01700 VAR RTG: PACKED RECORD CASE SEVERAL OF
+01710 1: ( INT : INTEGER ) ;
+01720 2: ( REA : REAL ) ;
+01730 3: ( SIGN : BOOLEAN ; EXP : 0..3777B ; MANT : 0..7777777777777777B )
+01740 END ;
+01750 BEGIN WITH RTG DO
+01760 BEGIN
+01770 INT := II;
+01780 IF II=INTUNDEF THEN WRITE('UNDEFINED')
+01790 ELSE IF EXP=ORD(SIGN)*3777B THEN
+01800 BEGIN WRITE(II:1);
+01810 IF (II<64) AND (II>=0) THEN WRITE(' (', CHR(II), ')');
+01820 END
+01830 ELSE WRITE(REA)
+01840 END
+01850 END;
+01860 ()+01*)
+01870 (*+02()
+01880 BEGIN
+01890 IF II = INTUNDEF THEN WRITE( OUTPUT , 'UNDEFINED' )
+01900 ELSE
+01910 BEGIN
+01920 WRITE( OUTPUT , II : 1 ) ;
+01930 IF ( II >= 32 ) AND ( II < 128 ) THEN WRITE( OUTPUT , ' (' , CHR( II ) , ')' )
+01940 END
+01950 END ;
+01960 ()+02*)
+01970 (*+05()
+01980 BEGIN
+01990 IF II = INTUNDEF THEN WRITE( OUTPUT , 'UNDEFINED' )
+02000 ELSE
+02010 BEGIN
+02020 WRITE( OUTPUT , II : 1 ) ;
+02030 IF ( II >= 32 ) AND ( II < 128 ) THEN WRITE( OUTPUT , ' (' , CHR( II ) , ')' )
+02040 END
+02050 END ;
+02060 ()+05*)
+02070 PROCEDURE PRINTDOUBLE( LV : A68LONG ) ;
+02080 (*+01()
+02090 BEGIN
+02100 END ;
+02110 ()+01*)
+02120 (*+05()
+02130 BEGIN
+02140 PRINTREAL(LV);
+02150 END ;
+02160 ()+05*)
+02170 (*+02()
+02180 (*+12()
+02190 BEGIN
+02200 PRINTREAL(LV);
+02210 END ;
+02220 ()+12*)
+02230 (*+13()
+02240 BEGIN
+02250 PRINTREAL(LV);
+02260 END;
+02270 ()+13*)
+02280 ()+02*)
+02290 PROCEDURE PRINTVAL(ANOBJECT :OBJECTP);FORWARD;
+02300 PROCEDURE PRINTBIGD(ANOBJECT :OBJECTP; TEMPLATE :DPOINT; OFF :INTEGER);
+02310 VAR I, J :INTEGER;
+02320 PROCEDURE PRINTD(ANOBJECT :OBJECTP; TEMPLATE :DPOINT);
+02330 LABEL 9;
+02340 VAR TEMPOS, I :INTEGER;
+02350 BEGIN
+02360 RQ.PI := INCPTR(ANOBJECT, OFF) ;
+02370 WITH RQ DO
+02380 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
+02390 IF ORD(TEMPLATE)=0 THEN (*DRESSED*)
+02400 IF PP ^ ^.SORT IN [REF1,REF2,CREF,REFSL1] THEN
+02410 WRITE(OUTPUT , 'REF #', ORD( RELSUP(PP ^) ):(*-01()1()-01*)(*+01()6 OCT()+01*) )
+02420 ELSE PRINTVAL(PP ^)
+02430 (*-01() ELSE IF ORD(TEMPLATE)>SZINT THEN PRINTDOUBLE(PR^) ()-01*)
+02440 ELSE PRINTSINGLE( PI ^ )
+02450 ELSE (*PART OF STRUCT*)
+02460 BEGIN
+02470 TEMPOS := 1;
+02480 WHILE TEMPLATE^[TEMPOS]>=0 DO
+02490 BEGIN
+02500 IF TEMPLATE^[TEMPOS]=OFF THEN
+02510 BEGIN
+02520 IF PP ^ ^.SORT IN [REF1,CREF,REFSL1] THEN
+02530 WRITE(OUTPUT , 'REF #', ORD( RELSUP(PP ^) ):(*-01()1()-01*)(*+01()6 OCT()+01*) )
+02540 ELSE PRINTVAL(PP ^);
+02550 OFF := OFF+SZADDR;
+02560 GOTO 9
+02570 END;
+02580 TEMPOS := TEMPOS+1
+02590 END;
+02600 INT := ORD( PI^ ) ;
+02610 IF INT = INTUNDEF THEN
+02620 BEGIN
+02630 WRITE( OUTPUT , 'UNDEFINED' ) ;
+02640 OFF := OFF + SZINT
+02650 END
+02660 ELSE CASE TEMPLATE^[TEMPOS+1+J] OF
+02670 0: (*NO ACTION*);
+02680 1: BEGIN WRITE( OUTPUT , PI ^ : 1 ); OFF := OFF+SZINT END;
+02690 3: BEGIN WRITE( OUTPUT , PR ^ ); OFF := OFF+SZREAL END;
+02700 5: BEGIN
+02710 PRINTREAL(PR^); WRITE(OUTPUT, ' I'); OFF := OFF+SZREAL;
+02720 PR := INCPTR(ANOBJECT, OFF);
+02730 PRINTREAL(PR^);
+02740 OFF := OFF+SZREAL;
+02750 END;
+02760 7: BEGIN WRITE(OUTPUT , '"', CHR( PI ^ ) , '"'); OFF := OFF+SZINT END;
+02770 9: BEGIN
+02780 (*+01() IF PI^<0 THEN ()+01*)
+02790 (*-01() IF PI^<>0 THEN ()-01*)
+02800 WRITE(OUTPUT , '.TRUE') ELSE WRITE(OUTPUT , '.FALSE'); OFF := OFF+SZINT
+02810 END;
+02820 10: BEGIN WRITE( OUTPUT , PI ^ : (*-01()1()-01*)(*+01()20 OCT()+01*) ); OFF := OFF+SZINT END;
+02830 11: BEGIN
+02840 (*+05() RQ.PI := ASPTR( ORD( PI ) * 2 ) ; ()+05*)
+02850 WRITE( OUTPUT , '"', (*+05()RQ.()+05*)PB ^ , '"') ;
+02860 OFF := OFF + SZINT
+02870 END ;
+02880 12: BEGIN WRITE( OUTPUT , 'PROC'); OFF := OFF+1; OFF := OFF+SZADDR END;
+02890 END;
+02900 9: J := J+1;
+02910 END
+02920 END;
+02930 BEGIN (* OF PRINTBIGD *)
+02940 J := 0; I := OFF;
+02950 IF ORD(TEMPLATE)>MAXSIZE THEN (*COMPLETE STRUCT*)
+02960 BEGIN WRITE( OUTPUT , '(');
+02970 WHILE OFF-I<TEMPLATE^[0] DO
+02980 BEGIN IF J<>0 THEN WRITE( OUTPUT , ', '); PRINTD(ANOBJECT, TEMPLATE) END;
+02990 WRITE( OUTPUT , ')')
+03000 END
+03010 ELSE PRINTD(ANOBJECT, TEMPLATE)
+03020 END;
+03030 PROCEDURE PRINTVAL;
+03040 VAR I, K :INTEGER;
+03050 ELEMENTS :OBJECTP;
+03060 BEGIN (*OF PRINTVAL*)
+03070 WITH ANOBJECT^ DO
+03080 CASE SORT OF
+03090 STRING:
+03100 BEGIN
+03110 WRITE( OUTPUT , ' STRING "');
+03120 FOR I := 1 TO STRLENGTH DO WRITE( OUTPUT , CHARVEC[I]);
+03130 WRITE( OUTPUT , '"')
+03140 END;
+03150 ROUTINE:
+03160 BEGIN WRITE( OUTPUT , ' PROC ');
+03170 WRITE( OUTPUT , PROCBL^.ROUTNAME.ALF, ' ', ENVCHAIN:(*-01()1()-01*)(*+01()6 OCT()+01*) ) END;
+03180 STRUCT:
+03190 BEGIN WRITE( OUTPUT , ' STRUCT');
+03200 PRINTBIGD(INCPTR(ANOBJECT, STRUCTCONST), DBLOCK, 0)
+03210 END;
+03220 COVER:
+03230 BEGIN
+03240 IF (OPENED IN STATUS) AND NOT ASSOC THEN
+03250 BEGIN
+03260 ACLOSE(BOOK);
+03270 IF NOT(STARTUP IN STATUS) THEN BEGIN PFET := BOOK;
+03280 DISPOSE(PFET) END;
+03290 STATUS := STATUS-[OPENED];
+03300 END;
+03310 WRITE( OUTPUT , ' (', POFCPOS:1, ',', LOFCPOS:1, ',', COFCPOS:1, ')');
+03320 END;
+03330 REF1:
+03340 PRINTSINGLE(VALUE);
+03350 (*-01() REF2:
+03360 PRINTDOUBLE( LONGVALUE ) ; ()-01*)
+03370 REFSL1:
+03380 PRINTBIGD(ANCESTOR^.PVALUE, DBLOCK, OFFSET);
+03390 CREF:
+03400 PRINTSINGLE(IPTR^.FIRSTWORD);
+03410 RECN, REFN:
+03420 WRITE( OUTPUT , ' REF #', ORD(ANOBJECT):(*-01()1()-01*)(*+01()6 OCT()+01*) , ' TO STRUCT');
+03430 REFR, RECR:
+03440 WRITE( OUTPUT , ' REF #', ORD(ANOBJECT):(*-01()1()-01*)(*+01()6 OCT()+01*) , ' TO ARRAY');
+03450 REFSLN:
+03460 WRITE( OUTPUT , ' REF TO SLICE');
+03470 NILL:
+03480 WRITE( OUTPUT , ' NIL');
+03490 UNDEF:
+03500 WRITE( OUTPUT , ' UNDEFINED');
+03510 END;
+03520 END; (* OF PRINTVAL *)
+03530 PROCEDURE PRINTMULT(ANOBJECT:OBJECTP);
+03540 VAR I, K :INTEGER;
+03550 ELEMENTS:OBJECTP;
+03560 BEGIN
+03570 WITH ANOBJECT^ DO
+03580 BEGIN
+03590 IF SORT<>REFSLN THEN BEGIN WRITE( OUTPUT , ' ARRAY '); ELEMENTS := PVALUE END
+03600 ELSE BEGIN WRITE( OUTPUT , ' SLICE '); ELEMENTS := ANCESTOR^.PVALUE END;
+03610 WRITE( OUTPUT , '[');
+03620 FOR I := ROWS DOWNTO 0 DO WITH DESCVEC[I] DO
+03630 BEGIN WRITE( OUTPUT , LI:1, ':', UI:1); IF I>0 THEN WRITE( OUTPUT , ', ') END;
+03640 WRITE( OUTPUT , ']');
+03650 IF ROWS=0 THEN (*1 DIMENSION ONLY*) WITH DESCVEC[0] DO
+03660 BEGIN
+03670 FOR I := LI TO LI+2 DO IF I<=UI THEN
+03680 BEGIN WRITELN( OUTPUT ) ; WRITE( OUTPUT , ' ');
+03690 PRINTBIGD(INCPTR(ELEMENTS, DI*I-LBADJ), MDBLOCK, 0) END;
+03700 IF UI-LI>5 THEN
+03710 BEGIN WRITELN( OUTPUT ); WRITE( OUTPUT , ' ...'); K := UI-2 END
+03720 ELSE K := LI + 3 ;
+03730 FOR I := K TO UI DO
+03740 BEGIN WRITELN( OUTPUT ); WRITE( OUTPUT , ' ');
+03750 PRINTBIGD(INCPTR(ELEMENTS, DI*I-LBADJ), MDBLOCK, 0) END
+03760 END
+03770 END
+03780 END;
+03790 BEGIN (*OF ERROR*)
+03800 (*+02()LOCALRANGE := TRUE;()+02*)
+03810 CURR := DYNAMIC(ME);
+03820 (*+54()
+03830 IB := CURR;
+03840 REPEAT
+03850 SETMYSTATIC(IB);
+03860 IF ISA68(IB) THEN
+03870 BEGIN
+03880 RG := FIRSTRG.RIBOFFSET;
+03890 WHILE (RG^.FIRSTW.TRACESAVE=NIL) AND (RG^.RIBOFFSET<>FIRSTRG.RIBOFFSET) DO
+03900 RG := RG^.RIBOFFSET;
+03910 END;
+03920 IB := DYNAMIC(IB);
+03930 UNTIL (SCOPE=1) OR (RG^.FIRSTW.TRACESAVE<>NIL);
+03940 WITH RG^ DO
+03950 IF (FIRSTW.TRACESAVE<>NIL) AND (N<>0) THEN
+03960 BEGIN
+03970 SETMYSTATIC(CURR);
+03980 EXCEPT := INCPTR(CRSTRUCT(EXCEPTDB), STRUCTCONST);
+03990 EXCEPT^.FIRSTWORD := N;
+04000 CL68(GETPROC(FIRSTW.TRACESAVE), INCPTR(EXCEPT, -STRUCTCONST));
+04010 END;
+04020 ()+54*)
+04030 WRITELN( OUTPUT );
+04040 WRITELN( OUTPUT , ' RUN-TIME ERROR');
+04050 WRITE( OUTPUT , ' ');
+04060 IF (N>56) OR (N<0) THEN WRITE( OUTPUT , (*+54()'USER DEFINED ',()+54*) 'ERROR NO. ', N:1)
+04070 ELSE
+04080 CASE N OF
+04090 (*+05()
+04100 -16,-15,-14,-13,-12,-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1: (* SYSTEM INTERRUPTS *)
+04110 WRITE( OUTPUT , 'SIGNAL NUMBER ' , -N:1 ) ;
+04120 ()+05*)
+04130 0: (*NO FURTHER ACTION*);
+04140 1: (*RASSIG*)
+04150 WRITE( OUTPUT , 'ASSIGNATION TO UNDEFINED NAME');
+04160 2: (*RSEL*)
+04170 WRITE( OUTPUT , 'SELECTION FROM UNDEFINED STRUCTURE');
+04180 3: (*RDEREF*)
+04190 WRITE( OUTPUT , 'DEREFERENCING UNDEFINED NAME');
+04200 4: (*RASSIGNIL*)
+04210 WRITE( OUTPUT , 'ASSIGNATION TO .NIL');
+04220 5: (*RSELNIL*)
+04230 WRITE( OUTPUT , 'SELECTION FROM .NIL');
+04240 6: (*RDEREFNIL*)
+04250 WRITE( OUTPUT , 'DEREFERENCING .NIL');
+04260 7: (*IDREL*)
+04270 WRITE( OUTPUT , 'IDENTITY-RELATION INVOLVING UNDEFINED NAME, OR NAME OF SLICE');
+04280 8: (*RPOWNEG*)
+04290 WRITE( OUTPUT , 'RAISING AN .INT TO A -VE POWER');
+04300 9: (*RBYTESPACK*)
+04310 WRITE( OUTPUT , 'BYTESPACK ON .STRING LONGER THAN BYTES WIDTH');
+04320 13: (*RCLOWER*)
+04330 WRITE( OUTPUT , 'UNDEFINED LOWER-BOUND IN ACTUAL-DECLARER');
+04340 14: (*RCUPPER*)
+04350 WRITE( OUTPUT , 'UNDEFINED UPPER-BOUND IN ACTUAL-DECLARER');
+04360 15: (*RLWUPB*)
+04370 WRITE( OUTPUT , 'LEFT OPERAND OF .LWB OR .UPB OUT OF RANGE');
+04380 16: (*RSL1ERROR*)
+04390 WRITE( OUTPUT , 'SUBSCRIPT (OR LOWER-BOUND) TOO LOW');
+04400 17: (*RSL2ERROR*)
+04410 WRITE( OUTPUT , 'SUBSCRIPT (OR UPPER-BOUND) TOO HIGH');
+04420 18: (*RSLICE*)
+04430 WRITE( OUTPUT , 'SLICE FROM UNDEFINED ARRAY');
+04440 19: (*RSLICENIL*)
+04450 WRITE( OUTPUT , 'SLICE FROM .NIL');
+04460 20: (*RMULASS*)
+04470 WRITE( OUTPUT , 'BOUNDS MISMATCH IN ASSIGNATION OF ARRAY');
+04480 21: (*RROUTN*)
+04490 WRITE( OUTPUT , 'CALL OF UNDEFINED ROUTINE');
+04500 22: (*RCHARERROR*)
+04510 WRITE( OUTPUT , 'PRINTING NON-EXISTENT .CHAR');
+04520 23: (*RSCOPE*)
+04530 WRITE( OUTPUT , 'SCOPE VIOLATION');
+04540 24: (*RARG*)
+04550 WRITE( OUTPUT , 'ARGUMENT OF ZERO IS IMPOSSIBLE');
+04560 RDUMMY:
+04570 WRITE( OUTPUT , 'FEATURE NOT IMPLEMENTED YET');
+04580 NOREAD,NOWRITE,NOBIN,NORESET,NOSET,NOESTAB:
+04590 WRITE( OUTPUT , 'IMPOSSIBLE TRANSPUT OPERATION');
+04600 NOTOPEN:
+04610 WRITE( OUTPUT , 'FILE NOT OPEN');
+04620 NOPHYSICAL:
+04630 WRITE( OUTPUT , 'PHYSICAL END OF FILE REACHED');
+04640 NOLOGICAL:
+04650 WRITE( OUTPUT , 'LOGICAL END OF FILE REACHED');
+04660 NOMOOD:
+04670 WRITE( OUTPUT , 'NOT KNOWN WHETHER READING OR WRITING');
+04680 POSMIN:
+04690 WRITE( OUTPUT , '(P,L,C) < (1,1,1)');
+04700 POSMAX:
+04710 WRITE( OUTPUT , '(P,L,C) > PHYSICAL FILE SIZE');
+04720 SMALLLINE:
+04730 WRITE( OUTPUT , 'LINE TOO SHORT FOR VALUE');
+04740 WRONGCHAR:
+04750 WRITE( OUTPUT , 'UNACCEPTABLE CHARACTER READ');
+04760 NODIGIT:
+04770 WRITE( OUTPUT , 'DIGIT EXPECTED');
+04780 WRONGVAL:
+04790 WRITE( OUTPUT , 'VALUE OUT OF RANGE');
+04800 WRONGMULT:
+04810 WRITE( OUTPUT , 'LOWER BOUND OF ASSOCIATED ARRAY /= 1');
+04820 NOALTER,NOSHIFT:
+04830 WRITE( OUTPUT , 'ILLEGAL CHANGE TO/FROM BINARY TRANSPUT');
+04840 END;
+04850 WRITE( OUTPUT , ', DETECTED IN ');
+04860 THISWAS68 := FALSE ;
+04870 REPEAT
+04880 SETMYSTATIC(CURR);
+04890 IF ISA68(CURR) THEN
+04900 BEGIN
+04910 THISWAS68 := TRUE ;
+04920 (*+02()IF LOCALRANGE THEN
+04930 BEGIN
+04940 WRITE(OUTPUT, 'LINE ', GETLINENO:1);
+04950 LOCALRANGE := FALSE;
+04960 END
+04970 ELSE ()+02*)
+04980 WRITE( OUTPUT , 'LINE ', LINENO:1);
+04990 IF SCOPE<>1 THEN
+05000 WRITELN( OUTPUT ,' OF PROCEDURE ', PROCBL^.ROUTNAME.ALF)
+05010 ELSE WRITELN( OUTPUT , ' OF MAIN PROGRAM');
+05020 RANGE := FIRSTRG.RIBOFFSET; RANGECOUNT := 0;
+05030 REPEAT WITH RANGE^ DO
+05040 WITH FIRSTW , RP DO
+05050 BEGIN
+05060 WRITELN( OUTPUT );
+05070 IF RIBOFFSET<>FIRSTRG.RIBOFFSET THEN
+05080 BEGIN WRITE( OUTPUT , ' RANGE ', RANGECOUNT:2); IDP := RGIDBLK;
+05090 (*-41() PP := INCPTR ( RANGE , RGCONST ) ; ()-41*)
+05100 (*+41() PP := ASPTR ( ORD( RANGE ) ) ; ()+41*)
+05110 END
+05120 ELSE IF SCOPE<>1 THEN
+05130 BEGIN WRITE( OUTPUT , ' PARAMETERS'); IDP := RGIDBLK;
+05140 (*-41() PP :=ASPTR(CURR-PARAMOFFSET-PROCBL^.PARAMS) ()-41*)
+05150 (*+41() PP :=ASPTR((*+02()ARGBASE()+02*)(CURR)-PARAMOFFSET+PROCBL^.PARAMS) ()+41*)
+05160 END
+05170 ELSE IDP := NIL;
+05180 IF IDP<>NIL THEN
+05190 BEGIN
+05200 RANGECOUNT := RANGECOUNT-1;
+05210 (*-41() WHILE ORD ( PP ) < ORD ( RGNEXTFREE ) DO ()-41*)
+05220 (*+41() WHILE ORD ( PP ) > ORD ( RGLASTUSED ) DO ()+41*)
+05230 BEGIN
+05240 IDP := INCPTR(IDP, -SZIDBLOCK);
+05250 WITH IDP ^ DO
+05260 BEGIN
+05270 (*+41()
+05280 IF IDSIZE <> 0 THEN
+05290 PP := INCPTR( PP , - IDSIZE )
+05300 ELSE
+05310 PP := INCPTR( PP , - SZADDR ) ;
+05320 ()+41*)
+05330 WRITELN( OUTPUT ); WRITE( OUTPUT , ' ', ALF);
+05340 IF XMODE>=16 THEN
+05350 BEGIN WRITE( OUTPUT , ' LOC'); XCASE := XMODE-16 END
+05360 ELSE BEGIN WRITE( OUTPUT , ' '); XCASE := XMODE END;
+05370 INT := ORD (PI^) ;
+05380 IF INT=INTUNDEF THEN WRITE( OUTPUT , ' UNDEFINED')
+05390 ELSE CASE XCASE OF
+05400 0: (*REF*)
+05410 WITH PP ^ ^ DO
+05420 CASE SORT OF
+05430 REF1, REF2, CREF, REFSL1:
+05440 BEGIN
+05450 WRITE( OUTPUT , ' REF #', ORD(RELSUP(PP ^)):(*-01()1()-01*)(*+01()6 OCT()+01*) , ' TO ') ;
+05460 PRINTVAL(PP ^)
+05470 END;
+05480 RECN, REFN:
+05490 BEGIN
+05500 WRITE( OUTPUT , ' REF #', ORD(PP ^):(*-01()1()-01*)(*+01()6 OCT()+01*) , ' TO ') ;
+05510 PRINTVAL(PVALUE)
+05520 END;
+05530 RECR, REFR:
+05540 BEGIN
+05550 WRITE( OUTPUT , ' REF #', ORD(PP ^):(*-01()1()-01*)(*+01()6 OCT()+01*) , ' TO ') ;
+05560 PRINTMULT(PP ^)
+05570 END;
+05580 REFSLN:
+05590 BEGIN WRITE( OUTPUT , ' REF TO '); PRINTMULT(PP ^) END;
+05600 NILL:
+05610 WRITE( OUTPUT , ' REF NIL');
+05620 UNDEF:
+05630 WRITE( OUTPUT , ' REF UNDEFINED');
+05640 END;
+05650 1: (*INT*)
+05660 WRITE( OUTPUT , ' INT ', PI ^ :1);
+05670 3: (*REAL*)
+05680 WRITE( OUTPUT , ' REAL ', PR ^ );
+05690 5: (*COMPL*)
+05700 BEGIN
+05710 IF XMODE>=16 THEN POINT := PP ^ ^.PVALUE ELSE POINT := PP ^ ;
+05720 WITH POINT ^ DO
+05730 BEGIN WRITE(OUTPUT, ' COMPL '); PRINTREAL(RE); WRITE(OUTPUT, ' I'); PRINTREAL(IM); END
+05740 END;
+05750 7: (*CHAR*)
+05760 WRITE( OUTPUT , ' CHAR "', CHR( PI ^ ) , '"');
+05770 8: (*STRING*)
+05780 IF PP^=UNDEFIN THEN WRITE( OUTPUT , ' STRING ""')
+05790 ELSE PRINTVAL(PP^);
+05800 9: (*BOOL*)
+05810 (*+01() IF PI^<0 THEN ()+01*)
+05820 (*-01() IF PI^<>0 THEN ()-01*)
+05830 WRITE( OUTPUT , ' BOOL .TRUE') ELSE WRITE( OUTPUT , ' BOOL .FALSE');
+05840 10: (*BITS*)
+05850 WRITE( OUTPUT , ' BITS ', PI ^ : (*-01()1()-01*)(*+01()20 OCT()+01*) );
+05860 11: (*BYTES*)
+05870 BEGIN
+05880 (*+05() RQ.PI := ASPTR( ORD( PI ) * 2 ) ; ()+05*)
+05890 WRITE( OUTPUT , ' BYTES "', (*+05()RQ.()+05*)PB ^ , '"' )
+05900 END ;
+05910 12: (*PROC*)
+05920 PRINTVAL(PP ^);
+05930 13: (*STRUCT*)
+05940 BEGIN IF XMODE>=16 THEN POINT := PP ^ ^.PVALUE ELSE POINT := PP ^ ; PRINTVAL(POINT) END;
+05950 14: (*ROW*)
+05960 PRINTMULT(PP ^);
+05970 END ;
+05980 (*-41()
+05990 IF IDSIZE<>0 THEN
+06000 PP := INCPTR ( PP , IDSIZE )
+06010 ELSE
+06020 PP := INCPTR ( PP , SZADDR )
+06030 ()-41*)
+06040 END
+06050 END;
+06060 END;
+06070 IF (RIBOFFSET=FIRSTRG.RIBOFFSET) AND (SCOPE <> 1) THEN (*PARAMS*)
+06080 PP:=(*+41() ASPTR(ORD(RANGE)) ()+41*)
+06090 (*-41() INCPTR(RANGE,RGCONST) ()-41*)
+06100 ELSE
+06110 PP := (*+41() INCPTR(RGLASTUSED, -SZINT ); ()+41*)
+06120 (*-41() ASPTR(ORD(RGNEXTFREE)) ; ()-41*)
+06130 LOOPTYP := PD^ ;
+06140 FOR COUNT := 1 TO LOOPCOUNT DO
+06150 BEGIN
+06160 WRITELN( OUTPUT ) ;
+06170 CASE LOOPTYP OF
+06180 1: BEGIN
+06190 PI1 := INCPTR( PI , 2 * STACKSZINT ) ;
+06200 WRITELN( OUTPUT , '.FOR ', PI1 ^ :1);
+06210 PI1 := INCPTR( PI , STACKSZINT ) ;
+06220 WRITELN( OUTPUT , '.BY ', PI1 ^ :1);
+06230 PI1 := INCPTR( PI , 3 * STACKSZINT ) ;
+06240 WRITE ( OUTPUT , '.TO ', PI1 ^ :1);
+06250 PD := INCPTR( PD , 4 * STACKSZINT )
+06260 END;
+06270 2: BEGIN
+06280 PI1 := INCPTR( PI , STACKSZINT ) ;
+06290 WRITELN( OUTPUT , '.FOR ', PI1 ^ :1);
+06300 PI1 := INCPTR( PI , 2 * STACKSZINT ) ;
+06310 WRITE ( OUTPUT , '.TO ', PI1 ^ :1);
+06320 PD := INCPTR( PD , 3 * STACKSZINT )
+06330 END;
+06340 3: BEGIN
+06350 PI1 := INCPTR( PI , 2 * STACKSZINT ) ;
+06360 WRITELN( OUTPUT , '.FOR ', PI1 ^ :1);
+06370 PI1 := INCPTR( PI , STACKSZINT ) ;
+06380 WRITE ( OUTPUT , '.BY ', PI1 ^ :1);
+06390 PD := INCPTR( PD , 3 * STACKSZINT )
+06400 END;
+06410 4: BEGIN
+06420 PI1 := INCPTR( PI , STACKSZINT ) ;
+06430 WRITE ( OUTPUT , '.FOR ', PI1 ^ :1);
+06440 PD := INCPTR( PD , 2 * STACKSZINT )
+06450 END
+06460 END;
+06470 LOOPTYP := PD^
+06480 END;
+06490 RANGE := RIBOFFSET;
+06500 WRITELN( OUTPUT )
+06510 END
+06520 UNTIL RANGE=FIRSTRG.RIBOFFSET;
+06530 WRITELN( OUTPUT );
+06540 WRITE( OUTPUT , ' WHICH WAS CALLED FROM ')
+06550 END
+06560 ELSE THISWAS68 := FALSE ;
+06570 CURR := DYNAMIC(CURR);
+06580 UNTIL (SCOPE=1) AND THISWAS68 ;
+06590 WRITELN( OUTPUT , 'STANDARD-PRELUDE');
+06600 (*+01()
+06610 WRITELN(' CPU ', (CPUCLOCK+CLOCK)/1000:6:3);
+06620 MESSAGE(' RUN ABORTED');
+06630 ()+01*)
+06640 (*+05()
+06650 WRITELN(ERROR, ' RUN ABORTED');
+06660 WRITELN(ERROR, ' CPU ', TIME :5:2);
+06670 ()+05*)
+06680 ABORT
+06690 END;
+06700 (**)
+06710 (**)
+06720 (*+01()
+06730 PROCEDURE PDERR(VAR A: INTEGER; J,K,L,M: INTEGER; N: BOOLEAN;
+06740 VAR F: TEXT; VAR MSG: MESS);
+06750 (*TO CATCH NOS- AND PASCAL-DETECTED ERRORS*)
+06760 VAR I: INTEGER;
+06770 BEGIN
+06780 SETMYSTATIC(DYNAMIC(ME));
+06790 WRITELN(F);
+06800 I := 1;
+06810 REPEAT
+06820 WRITE(F, MSG[I]); I := I+1
+06830 UNTIL ORD(MSG[I])=0;
+06840 WRITELN(F);
+06850 ERRORR(0);
+06860 END;
+06870 ()+01*)
+06880 (**)
+06890 (**)
+06900 (*+54()
+06910 PROCEDURE OFFERROR;
+06920 VAR CURR, IB: IPOINT; RG: PRANGE;
+06930 BEGIN
+06940 CURR := STATIC(ME);
+06950 IB := CURR;
+06960 REPEAT
+06970 SETMYSTATIC(IB);
+06980 IF ISA68(IB) THEN
+06990 BEGIN
+07000 RG := FIRSTRG.RIBOFFSET;
+07010 WHILE (RG^.FIRSTW.TRACESAVE=NIL) AND (RG^.RIBOFFSET<>FIRSTRG.RIBOFFSET) DO
+07020 RG := RG^.RIBOFFSET;
+07030 END;
+07040 IB := DYNAMIC(IB);
+07050 UNTIL (SCOPE=1) OR (RG^.FIRSTW.TRACESAVE<>NIL);
+07060 WITH RG^.FIRSTW DO WITH TRACESAVE ^ DO
+07070 IF TRACESAVE<>NIL THEN
+07080 BEGIN
+07090 FDEC; IF FTST THEN GARBAGE(TRACESAVE);
+07100 TRACESAVE := NIL;
+07110 END;
+07120 SETMYSTATIC(CURR);
+07130 END;
+07140 (**)
+07150 (**)
+07160 PROCEDURE ONERROR(R: OBJECTP);
+07170 VAR LOCRG: DEPTHRANGE;
+07180 RG: PRANGE;
+07190 BEGIN
+07200 LOCRG := 0;
+07210 RG := FIRSTRG.RIBOFFSET;
+07220 WHILE RG^.RIBOFFSET<>FIRSTRG.RIBOFFSET DO
+07230 BEGIN RG := RG^.RIBOFFSET; LOCRG := LOCRG+1 END;
+07240 IF SCOPE+LOCRG<R^.OSCOPE THEN ERRORR(RSCOPE);
+07250 WITH FIRSTRG.RIBOFFSET^ DO
+07260 BEGIN
+07270 IF FIRSTW.TRACESAVE<>NIL THEN WITH FIRSTW.TRACESAVE^ DO
+07280 BEGIN FDEC; IF FTST THEN GARBAGE(FIRSTW.TRACESAVE) END;
+07290 FIRSTW.TRACESAVE := R;
+07300 FPINC(R^);
+07310 END;
+07320 END;
+07330 (**)
+07340 (**)
+07350 FUNCTION MAKEXCE(N: INTEGER): OBJECTP;
+07360 VAR NEWSTRUCT: UNDRESSP;
+07370 BEGIN
+07380 NEWSTRUCT := INCPTR(CRSTRUCT(EXCEPTDB), STRUCTCONST);
+07390 NEWSTRUCT^.FIRSTWORD := N;
+07400 MAKEXCE := INCPTR(NEWSTRUCT, -STRUCTCONST);
+07410 END;
+07420 (**)
+07430 (**)
+07440 ()+54*)
+07450 (*-02() BEGIN END ; ()-02*)
+07460 (*+01()
+07470 BEGIN (*OF MAIN PROGRAM*)
+07480 END (*OF EVERYTHING*).
+07490 ()+01*)
--- /dev/null
+#include <stdio.h>
+
+cleenup()
+ {
+ register FILE *iop ;
+ extern FILE *_lastbuf ;
+
+ for ( iop = _iob ; iop < _lastbuf ; iop ++ )
+ fclose( iop ) ;
+ }
+
+exit(n)
+int n;
+ { cleenup() ; _exit(n) ; }
--- /dev/null
+extern double _exp();
+double EXP(statlink, x)
+ int *statlink; double x;
+ {return(_exp(x));}
--- /dev/null
+74200 #include "rundecs.h"
+74210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+74220 (**)
+74230 (**)
+74240 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
+74250 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
+74260 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
+74270 (**)
+74280 (**)
+74290 FUNCTION FIXED(XMODE: INTEGER; VAL: REALTEGER; WIDTH, AFTER: INTEGER): OBJECTP;
+74300 VAR
+74310 S: OBJECTP;
+74320 SIGN, ABSWIDTH, BEFORE, POINT, E: INTEGER;
+74330 OK: BOOLEAN;
+74340 BEGIN
+74350 ABSWIDTH := ABS(WIDTH);
+74360 SIGN := ORD((WIDTH>0) OR (VAL.INT<0));
+74370 IF ABSWIDTH-AFTER=1 THEN
+74380 IF (WIDTH<0) AND (VAL.INT<0) THEN AFTER := AFTER-1;
+74390 S := NIL;
+74400 REPEAT
+74410 POINT := ORD(AFTER>0);
+74420 BEFORE := ABSWIDTH-SIGN-POINT-AFTER-ORD(WIDTH=0); (*-VE FOR WIDTH=0*)
+74430 IF (WIDTH<>0) AND (BEFORE<0) THEN AFTER := -1; (*WILL CAUSE SUBFIXED TO FAIL*)
+74440 OK := SUBFIXED(SIGN, BEFORE, POINT, AFTER, E, FALSE, VAL, XMODE=2, S, 1);
+74450 AFTER := AFTER-1
+74460 UNTIL OK OR (AFTER<0);
+74470 IF NOT OK THEN ERRORFILL(S, ABSWIDTH+ORD(WIDTH=0));
+74480 FIXED := S;
+74490 END;
+74500 (**)
+74510 (**)
+74520 (*-02()
+74530 BEGIN (*OF A68*)
+74540 END; (*OF A68*)
+74550 ()-02*)
+74560 (*+01()
+74570 BEGIN (*OF MAIN PROGRAM*)
+74580 END (* OF EVERYTHING *).
+74590 ()+01*)
--- /dev/null
+74700 #include "rundecs.h"
+74710 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+74720 (**)
+74730 (**)
+74740 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
+74750 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
+74760 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
+74770 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
+74780 (**)
+74790 (**)
+74800 FUNCTION FLOAT(XMODE: INTEGER; VAL: REALTEGER; WIDTH, AFTER, EXP: INTEGER): OBJECTP;
+74810 VAR E: REALTEGER;
+74820 S: OBJECTP;
+74830 ABSWIDTH, BEFORE, POINT, ABSEXP, EXPSIGN: INTEGER;
+74840 OK, OK1: BOOLEAN;
+74850 BEGIN
+74860 ABSWIDTH := ABS(WIDTH)+ORD(WIDTH=0);
+74870 ABSEXP := ABS(EXP)+ORD(EXP=0);
+74880 S := CRSTRING(ABSWIDTH);
+74890 REPEAT
+74900 POINT := ORD(AFTER>0);
+74910 BEFORE := ABSWIDTH-1-POINT-AFTER-1-ABSEXP;
+74920 IF BEFORE<0 THEN AFTER := -1; (*WILL CAUSE SUBFIXED TO FAIL*)
+74930 OK := SUBFIXED(ORD((WIDTH>0) OR (VAL.INT<0))-ORD((WIDTH<0) AND (VAL.INT>=0)),
+74940 BEFORE, POINT, AFTER, E.INT, TRUE, VAL, XMODE=2, S, 1)
+74950 AND (BEFORE+AFTER>0);
+74960 S^.CHARVEC[1+BEFORE+POINT+AFTER+1] := 'E';
+74970 EXPSIGN := ORD((EXP>0) OR (E.INT<0));
+74980 OK1 := SUBFIXED(EXPSIGN, ABSEXP-EXPSIGN, 0, 0, E.INT, FALSE, E, FALSE,
+74990 S, 1+BEFORE+POINT+AFTER+2);
+75000 AFTER := AFTER-ORD(AFTER<>0); ABSEXP := ABSEXP+1
+75010 UNTIL NOT OK OR OK1;
+75020 IF NOT OK THEN ERRORFILL(S, ABSWIDTH);
+75030 FLOAT := S;
+75040 END;
+75050 (**)
+75060 (**)
+75070 (*+01() (*$X4*) ()+01*)
+75080 (**)
+75090 (**)
+75100 (*-02()
+75110 BEGIN (*OF A68*)
+75120 END; (*OF A68*)
+75130 ()-02*)
+75140 (*+01()
+75150 BEGIN (*OF MAIN PROGRAM*)
+75160 END (* OF EVERYTHING *).
+75170 ()+01*)
--- /dev/null
+30100 #include "rundecs.h"
+30110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+30120 (**)
+30130 (**)
+30140 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP; EXTERN;
+30150 FUNCTION HEAPMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP; EXTERN;
+30160 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN;
+30170 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
+30180 (**)
+30190 (**)
+30200 FUNCTION RECCMN (THEREC: OBJECTP; LOCRG: DEPTHRANGE): OBJECTP;
+30210 (*COMMON FOR CREATING RECURSIVE OBJECTS*)
+30220 VAR TEMPREC: OBJECTP;
+30230 CUTOP: PRANGE;
+30240 BEGIN
+30250 CUTOP := FIRSTRG.RIBOFFSET;
+30260 WITH CUTOP^ DO WITH FIRSTW DO
+30270 BEGIN
+30280 TEMPREC := RECGEN;
+30290 RECGEN := THEREC;
+30300 END;
+30310 WITH THEREC^ DO
+30320 BEGIN
+30330 OSCOPE := SCOPE+LOCRG;
+30340 NEXT:= TEMPREC;
+30350 PREV := INCPTR(CUTOP, RECOFFSET-NEXTOFFSET);
+30360 END;
+30370 IF TEMPREC <> NIL THEN TEMPREC^.PREV:= THEREC;
+30380 RECCMN:= THEREC;
+30390 END;
+30400 (**)
+30410 (**)
+30420 FUNCTION CRRECN(ANOBJECT:OBJECTP):OBJECTP;
+30430 (* PCREATEREF+1 *)
+30440 VAR NEWRECN:OBJECTP;
+30450 BEGIN
+30460 ENEW(NEWRECN,RECNSIZE);
+30470 WITH NEWRECN^ DO
+30480 BEGIN
+30490 (*-02() FIRSTWORD := SORTSHIFT * ORD(RECN); ()-02*)
+30500 (*+02() PCOUNT:=0; SORT:=RECN; ()+02*)
+30510 (*+01() SECONDWORD := 0; ()+01*)
+30520 PVALUE:=ANOBJECT;
+30530 WITH PVALUE^ DO FINC;
+30540 ANCESTOR := NEWRECN;
+30550 OFFSET := STRUCTCONST;
+30560 CRRECN:=RECCMN(NEWRECN,FIRSTRG.RIBOFFSET^.RGSCOPE)
+30570 END
+30580 END;
+30590 (**)
+30600 (**)
+30610 FUNCTION GENRMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
+30620 (*PLEAPGEN+5*)
+30630 VAR NEWRECR: OBJECTP;
+30640 BEGIN
+30650 NEWRECR := HEAPMUL(NEWMULT, TEMPLATE);
+30660 NEWRECR^.SORT := RECR;
+30670 GENRMUL := RECCMN(NEWRECR, LOCRG)
+30680 END;
+30690 (**)
+30700 (**)
+30710 FUNCTION GENRSTR (TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
+30720 (*PLEAPGEN+2*)
+30730 VAR NEWRECN: OBJECTP;
+30740 BEGIN
+30750 ENEW(NEWRECN, RECNSIZE);
+30760 WITH NEWRECN^ DO
+30770 BEGIN
+30780 (*-02() FIRSTWORD := SORTSHIFT * ORD(RECN); ()-02*)
+30790 (*+02() PCOUNT:=0; SORT:=RECN; ()+02*)
+30800 (*+01() SECONDWORD := 0; ()+01*)
+30810 PVALUE := CRSTRUCT(TEMPLATE);
+30820 ANCESTOR := NEWRECN;
+30830 OFFSET := STRUCTCONST;
+30840 WITH PVALUE^ DO FINC
+30850 END;
+30860 GENRSTR := RECCMN(NEWRECN, LOCRG)
+30870 END;
+30880 (**)
+30890 (**)
+30900 FUNCTION CRRECR(ANOBJECT: OBJECTP): OBJECTP;
+30910 (*PCREATEREF+3*)
+30920 VAR NEWREC: OBJECTP;
+30930 BEGIN
+30940 WITH ANOBJECT^ DO
+30950 BEGIN
+30960 IF (BPTR<>NIL) AND (SORT=MULT) THEN (*SOURCE IS A SLICE*)
+30970 COPYSLICE(ANOBJECT);
+30980 IF FTST THEN
+30990 BEGIN
+31000 NEWREC :=ANOBJECT;
+31010 NEWREC^.SORT := RECR;
+31020 END
+31030 ELSE
+31040 BEGIN
+31050 NEWREC := COPYDESC(ANOBJECT,MULT);
+31060 WITH NEWREC^.PVALUE^ DO FINC
+31070 END
+31080 END;
+31090 WITH NEWREC^ DO
+31100 BEGIN
+31110 ANCESTOR := NEWREC;
+31120 CCOUNT := 1;
+31130 CRRECR := RECCMN(NEWREC, FIRSTRG.RIBOFFSET^.RGSCOPE);
+31140 END
+31150 END;
+31160 (**)
+31170 (**)
+31180 (*-02() BEGIN END ; ()-02*)
+31190 (*+01()
+31200 BEGIN (*OF MAIN PROGRAM*)
+31210 END (*OF EVERYTHING*).
+31220 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exa _1GETT ; 1st label in GETT (run68d)
+ exp $GET
+ exp $READ
+ exp $GETT
+ exp $STANDINC
+
+ ina jumpdesc
+jumpdesc
+ con 0I SZADDR,0I SZADDR,0I SZADDR ; enough space for 3 pointers
+
+ pro $GET,GETTVARSPACE
+ mes 11
+ loc GETSTAMP
+ stl -SZWORD ; set up frame stamp
+ lxa 0 ; load argument base
+ lol SZADDR+SZADDR ; load length of data lost, skip static link & space
+ loc SZADDR+SZADDR+SZWORD
+ adu SZWORD ; add on space for static link & file pointer & count
+ ads SZWORD ; add argument base and offset
+ loi SZADDR ; load file address, objectp
+ SFL SZADDR ; store in space, left for this reason
+ lor 1 ; fill in jump info with SP
+ SFE jumpdesc+SZADDR
+ lxl 0 ; and LB
+ SFE jumpdesc+SZADDR+SZADDR
+ LFE _1GETT-ENTRYOFFSET ; and code entry point
+ SFE jumpdesc
+ gto jumpdesc ; jump to GETT, in run68d
+ end GETTVARSPACE
+
+ pro $READ,GETTVARSPACE
+ mes 11
+ loc GETSTAMP
+ stl -SZWORD ; set up frame stamp
+ LFE .HTOP-STINOFFSET ; address of stout in global frame
+ SFL SZADDR ; store in first param after static link
+ lor 1 ; fill in jump info with SP
+ SFE jumpdesc+SZADDR
+ lxl 0 ; and LB
+ SFE jumpdesc+SZADDR+SZADDR
+ LFE _1GETT-ENTRYOFFSET ; and code entry point
+ SFE jumpdesc
+ gto jumpdesc ; jump to GETT, in run68d
+ end GETTVARSPACE
+
+ pro $STANDINC,SZWORD ; call to stinch (run68d)
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR+SZADDR ; param 1, pcov
+ LFL SZADDR ; param 2, lfn
+ LFL 0 ; static link
+ cal $STINCH
+ asp SZADDR+SZADDR+SZADDR
+ ret 0
+ end SZWORD
+
--- /dev/null
+#define SZWORD EM_WSIZE
+#define SZADDR EM_PSIZE
+
+#if SZWORD==SZADDR
+#define LOAD lol
+#define STORE stl
+#else
+#define LOAD ldl
+#define STORE sdl
+#endif
+
+ mes 2,SZWORD,SZADDR
+
+ exp $GETADDRE
+ pro $GETADDRE,0
+ LOAD SZADDR ; load param (adress of variable) (1st after static link)
+ ret SZADDR ; return address
+ end 0
--- /dev/null
+31300 #include "rundecs.h"
+31310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+31320 (**)
+31330 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+31340 (**)
+31350 (**)
+31360 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP;
+31370 VAR OLDMULT:OBJECTP;
+31380 BEGIN
+31390 WITH NEWMULT^ DO
+31400 BEGIN
+31410 OLDMULT := PVALUE;
+31420 SORT := MULT;
+31430 OSCOPE := 0;
+31440 PVALUE := OLDMULT^.PVALUE;
+31450 IF ( OLDMULT^.SORT <> MULT ) OR ( OLDMULT^.BPTR = NIL ) THEN
+31460 BEGIN
+31470 WITH PVALUE^ DO
+31480 IF CCOUNT<>0 THEN CCOUNT := CCOUNT+1;
+31490 (*CCOUNT=0 TREATED AS INFINITY*)
+31500 OLDMULT := PVALUE;
+31510 END;
+31520 BPTR := OLDMULT;
+31530 FPTR := OLDMULT^.IHEAD;
+31540 IHEAD := NIL;
+31550 IF FPTR <> NIL THEN FPTR^.BPTR := NEWMULT
+31560 ELSE FPINC(OLDMULT^);
+31570 OLDMULT^.IHEAD := NEWMULT;
+31580 FPINC(PVALUE^);
+31590 END;
+31600 IF FPTST(OLDMULT^) THEN GARBAGE(OLDMULT);
+31610 GETMULT := NEWMULT;
+31620 END;
+31630 (**)
+31640 (**)
+31650 (*-02() BEGIN END ; ()-02*)
+31660 (*+01()
+31670 BEGIN (*OF MAIN PROGRAM*)
+31680 END (*OF EVERYTHING*).
+31690 ()+01*)
--- /dev/null
+31800 #include "rundecs.h"
+31810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+31820 (**)
+31830 (**)
+31840 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+31850 PROCEDURE RANGEXT; EXTERN;
+31860 (**)
+31870 (**)
+31880 PROCEDURE DORECGEN;
+31890 VAR RECGEN, RECPOINT: OBJECTP;
+31900 BEGIN
+31910 RECGEN := FIRSTRG.RIBOFFSET^.FIRSTW.RECGEN;
+31920 WHILE RECGEN<>NIL DO WITH RECGEN^ DO
+31930 BEGIN
+31940 FINC;
+31950 WITH PVALUE^ DO FDEC;
+31960 IF FPTST(PVALUE^) THEN GARBAGE(PVALUE);
+31970 PVALUE := UNDEFIN;
+31980 RECPOINT := RECGEN; RECGEN := NEXT;
+31990 WITH RECPOINT^ DO BEGIN FDEC; IF FTST THEN GARBAGE(RECPOINT) END
+32000 END
+32010 END;
+32020 (**)
+32030 (**)
+32040 FUNCTION GETOUT(TARGETRN: DEPTHRANGE; TARGETLEB: OFFSETRANGE; MAP: BITMAP; LOOPS: INTEGER): ASNAKED;
+32050 (*PGETOUT - EXIT FROM ROUTINES UNTIL TARGET IS REACHED.
+32060 MAP IS THE STACK TO BE LEFT STANDING*)
+32070 VAR CURR, NECLEV, IB: IPOINT;
+32080 BITP: BITMAP;
+32090 PTR: OBJECTPP;
+32100 I: INTEGER;
+32110 XMODE: INTEGER; IBTYPE: (A68, PUT, GET, OTHER);
+32120 PVAL: OBJECTP;
+32130 TEMPOINT: RECORD CASE SEVERAL OF
+32140 0: (POINT: INTPOINT);
+32150 1: (PPOINT: OBJECTPP);
+32160 2,3,4,5,6,7,8,9,10: ();
+32170 END;
+32180 TEMP: NAKEGER;
+32190 BEGIN
+32200 CURR := STATIC(ME);
+32210 REPEAT
+32220 NECLEV := (*-05()STATIC( CURR )()-05*)(*+05()STATICP+192()+05*) ;
+32230 WHILE (*-41()(NECLEV>CURR) AND (NECLEV<ME)()-41*)(*+41()(NECLEV<CURR) AND (NECLEV>ME)()+41*) DO
+32240 (*BYPASS ANY STATIC LEVELS CREATED BY SETNSTATIC*)
+32250 (*-05() NECLEV:=STATIC(NECLEV) ; ()-05*)
+32260 (*+05() BEGIN SETMYSTATIC( NECLEV ) ; NECLEV := STATICP+192 END ; ()+05*)
+32270 REPEAT
+32280 REPEAT
+32290 IF ISA68(CURR) THEN
+32300 BEGIN
+32310 IBTYPE := A68;
+32320 BITP := BITPATTERN;
+32330 END
+32340 ELSE
+32350 BEGIN BITP.COUNT := 0; BITP.MASK := 0;
+32360 IF ISPUT(CURR) THEN IBTYPE := PUT
+32370 ELSE IF ISGET(CURR) THEN IBTYPE := GET
+32380 ELSE IBTYPE := OTHER;
+32390 END;
+32400 (*-02() IB := CURR; ()-02*)
+32410 (*+02() IB := ARGBASE(CURR); ()+02*)
+32420 PTR := ASPTR(IB);
+32430 CURR := DYNAMIC(CURR);
+32440 SETMYSTATIC(CURR);
+32450 WITH BITP DO
+32460 BEGIN
+32470 IF (CURR=NECLEV) AND (LEVEL=TARGETRN) THEN (*THIS IS TARGET ROUTINE*)
+32480 BEGIN
+32490 COUNT := COUNT-MAP.COUNT;
+32500 FOR I := 1 TO MAP.COUNT DIV SZWORD DO MASK := MASK*2
+32510 END;
+32520 IF MASK<>0 THEN
+32530 BEGIN
+32540 PTR := INCPTR( PTR, (*-41()- ()-41*)COUNT - PARAMOFFSET ) ;
+32550 FOR I := 1 TO COUNT DIV SZWORD DO
+32560 BEGIN
+32570 (*+41() PTR := INCPTR(PTR, -SZWORD); ()+41*)
+32580 IF MASK<0 THEN IF FPTST(PTR^^) THEN GARBAGE(PTR^);
+32590 (*-41() PTR := INCPTR(PTR, SZWORD); ()-41*)
+32600 MASK := MASK*2
+32610 END
+32620 END
+32630 ELSE IF IBTYPE IN [PUT, GET] THEN WITH TEMPOINT DO (*DESTROY DATA LIST OF PUT OR GET*)
+32640 BEGIN
+32650 POINT := ASPTR(IB-DLOFFSET); BITP.COUNT := POINT^;
+32660 POINT := INCPTR(POINT, (*-41()-()-41*) BITP.COUNT);
+32670 WHILE ORD(POINT) (*-41()<()-41*)(*+41()>()+41*) IB-DLOFFSET DO
+32680 BEGIN
+32690 XMODE := POINT^;
+32700 (*-41() POINT := INCPTR(POINT, SZWORD); ()-41*)
+32710 IF IBTYPE=PUT THEN
+32720 BEGIN
+32730 CASE XMODE OF
+32740 4,7,11,12,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
+32750 BEGIN
+32760 (*+41() POINT := INCPTR(POINT, -SZADDR); ()+41*)
+32770 PVAL := PPOINT^;
+32780 (*-41() POINT := INCPTR(POINT, SZADDR); ()-41*)
+32790 WITH PVAL^ DO
+32800 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
+32810 END;
+32820 (*+61() 1,3,5: POINT := INCPTR(POINT, (*+41()-()+41*) SZLONG); ()+61*)
+32830 14: POINT := INCPTR(POINT, (*+41()-()+41*) SZPROC);
+32840 2: POINT := INCPTR(POINT, (*+41()-()+41*) SZREAL);
+32850 0,6,8,9,10: POINT := INCPTR(POINT, (*+41()-()+41*) SZINT);
+32860 -1: (*NO ACTION*);
+32870 END;
+32880 END
+32890 ELSE
+32900 IF XMODE IN [0..13,15..31] THEN
+32910 BEGIN
+32920 (*+41() POINT := INCPTR(POINT, -SZADDR); ()+41*)
+32930 PVAL := PPOINT^;
+32940 (*-41() POINT := INCPTR(POINT, SZADDR); ()-41*)
+32950 WITH PVAL^ DO
+32960 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
+32970 END
+32980 ELSE IF XMODE=14 THEN POINT := INCPTR(POINT, (*+41()-()+41*) SZPROC);
+32990 (*+41() POINT := INCPTR(POINT, -SZWORD); ()+41*)
+33000 END;
+33010 (*-01()
+33020 POINT := INCPTR(POINT, (*-41()+SZWORD()-41*)(*+41()-SZADDR()+41*));
+33030 PVAL := PPOINT^; (*PVAL = THE .REF.FILE PARAMETER OF PUT/GET*)
+33040 WITH PVAL^ DO
+33050 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
+33060 ()-01*)
+33070 END
+33080 END
+33090 UNTIL ISA68(CURR);
+33100 IF (CURR=NECLEV) AND (LEVEL=TARGETRN) THEN (*THIS IS TARGET ROUTINE*)
+33110 WHILE ORD(FIRSTRG.RIBOFFSET)-CURR (*-41()>()-41*)(*+41()< -()+41*) TARGETLEB DO
+33120 BEGIN RANGEXT; IF FIRSTRG.RIBOFFSET^.FIRSTW.RECGEN<>NIL THEN DORECGEN END
+33130 ELSE BEGIN
+33140 WHILE FIRSTRG.RIBOFFSET^.RIBOFFSET<>FIRSTRG.RIBOFFSET DO
+33150 BEGIN RANGEXT; IF FIRSTRG.RIBOFFSET^.FIRSTW.RECGEN<>NIL THEN DORECGEN END;
+33160 RANGEXT; (*FOR PARAMETERS RANGE*)
+33170 END;
+33180 UNTIL CURR=NECLEV
+33190 UNTIL LEVEL=TARGETRN;
+33200 FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT := LOOPS;
+33210 (*+01() TEMP.ASNAK := 0; ()+01*)
+33220 IF IBTYPE IN [PUT, GET] THEN
+33230 TEMP.NAK.STOWEDVAL :=
+33240 ASPTR(IB (*-41()(*-01()-SZADDR()-01*)-()-41*)(*+41()+SZWORD+SZADDR+()+41*) BITP.COUNT-DLOFFSET)
+33250 ELSE
+33260 TEMP.NAK.STOWEDVAL := ASPTR(IB (*-41()-()-41*)(*+41()+()+41*) BITP.COUNT-PARAMOFFSET);
+33270 TEMP.NAK.POINTER := ASPTR(CURR);
+33280 GETOUT := TEMP.ASNAK;
+33290 END;
+33300 (**)
+33310 (**)
+33320 PROCEDURE GBSTK(BITP: BITMAP);
+33330 (*PGBSTK*)
+33340 VAR PTR: OBJECTP;
+33350 I: INTEGER;
+33360 BEGIN WITH BITP DO
+33370 BEGIN
+33380 IF MASK<>0 THEN
+33390 BEGIN
+33400 I := COUNT;
+33410 WHILE I>0 DO
+33420 BEGIN
+33430 I := I-SZWORD;
+33440 IF MASK<0 THEN
+33450 BEGIN PTR := ASPTR(GETSTKTOP(SZADDR, I)); IF FPTST(PTR^) THEN GARBAGE(PTR) END;
+33460 MASK := MASK*2
+33470 END
+33480 END;
+33490 END
+33500 END;
+33510 (**)
+33520 (**)
+33530 (*-02()
+33540 BEGIN
+33550 END ;
+33560 ()-02*)
+33570 (*+01()
+33580 BEGIN (*OF MAIN PROGRAM*)
+33590 END (*OF EVERYTHING*).
+33600 ()+01*)
--- /dev/null
+75200 #include "rundecs.h"
+75210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+75220 (**)
+75230 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN ;
+75240 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+75250 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN ;
+75260 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN ;
+75270 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+75280 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+75290 PROCEDURE TESTCC (TARGET: OBJECTP); EXTERN ;
+75300 PROCEDURE TESTSS (REFSTRUCT: OBJECTP); EXTERN ;
+75310 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
+75320 FUNCTION GETPROC(RN: OBJECTP): ASNAKED; EXTERN ;
+75330 PROCEDURE CLPASC1(P1: IPOINT; PROC: ASPROC); EXTERN;
+75340 PROCEDURE CLRDSTR(PCOV: OBJECTP; VAR CHARS: GETBUFTYPE; TERM (*+01() , TERM1 ()+01*) : TERMSET;
+75350 VAR I: INTEGER; BOOK: FETROOMP; PROC: ASPROC); EXTERN;
+75360 FUNCTION FUNC68(PB: ASNAKED; RF: OBJECTP): BOOLEAN; EXTERN;
+75370 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+75380 PROCEDURE ENSSTATE(RF:OBJECTP;VAR F:OBJECTP;READING:STATUSSET); EXTERN;
+75390 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+75400 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+75410 (**)
+75420 (**)
+75430 PROCEDURE GETT(RF: OBJECTP);
+75440 (*+02() LABEL 1; ()+02*)
+75450 VAR COUNT, XMODE, XSIZE, SIZE, I, J: INTEGER;
+75460 Q:INTPOINT;
+75470 PVAL,F:OBJECTP;
+75480 P: UNDRESSP;
+75490 TEMP: REALTEGER;
+75500 TEMPLATE:DPOINT;
+75510 WASSTRING:BOOLEAN;
+75520 BUFFER:RECORD CASE SEVERAL OF
+75530 1: (CHARS: GETBUFTYPE);
+75540 2: (INTS :ARRAY [1..20] OF INTEGER);
+75550 0, 3, 4, 5, 6, 7, 8, 9, 10: () ;
+75560 END;
+75570 PDESC1: PDESC;
+75580 (**)
+75590 (*+02() PROCEDURE DUMMYG; (*JUST HERE TO MAKE 1 GLOBAL, NOT CALLED*)
+75600 BEGIN GOTO 1 END; ()+02*)
+75610 (**)
+75620 PROCEDURE SKIPSPACES(RF:OBJECTP;VAR F:OBJECTP);
+75630 (*SKIP INITIAL SPACES,++ENSSPOSN OF NEXT NON SPACE CHAR++*)
+75640 VAR CA:CHAR;
+75650 I: INTEGER;
+75660 BEGIN
+75670 REPEAT
+75680 IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+75690 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
+75700 I := 0;
+75710 WITH F^ DO
+75720 CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS)
+75730 UNTIL NOT(LINEOVERFLOW IN F^.PCOVER^.STATUS)
+75740 END; (*SKIPSPACES*)
+75750 (**)
+75760 PROCEDURE VALUEREAD(RF:OBJECTP;VAR F:OBJECTP);
+75770 (*+01() LABEL 111,222,77; ()+01*)
+75780 VAR PTR: UNDRESSP;
+75790 C,CC:CHAR;
+75800 CARRYON, ISEEN: BOOLEAN;
+75810 I,J,K:INTEGER;
+75820 OLD:STATUSSET;
+75830 PROCEDURE READNUM;
+75840 CONST MAXINTDIV10 = (*+11() 28147497671065 ()+11*) (*+12() 3276 ()+12*) (*+13() 214748364 ()+13*) ;
+75850 MAXINTMOD10 = (*+11() 5 ()+11*) (*+12() 7 ()+12*) (*+13() 7 ()+13*) ;
+75860 VAR PM, DIGITS, I, VALDIG: INTEGER;
+75870 NEG: BOOLEAN;
+75880 BEGIN WITH F^, TEMP, BUFFER DO
+75890 BEGIN
+75900 PM := 0;
+75910 CLRDSTR(PCOVER,CHARS,ALLCHAR-['+','-'] (*+01() , ALLCHAR1 ()+01*) ,PM,PCOVER^.BOOK,PCOVER^.DOGETS);
+75920 NEG := (PM=1) AND (CHARS[0]='-');
+75930 I := 0;
+75940 CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
+75950 DIGITS := 0;
+75960 CLRDSTR(PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,DIGITS,PCOVER^.BOOK,PCOVER^.DOGETS);
+75970 IF (PM>1) OR (DIGITS=0) THEN ERRORR(NODIGIT);
+75980 INT := 0;
+75990 FOR I := 0 TO DIGITS-1 DO
+76000 BEGIN
+76010 VALDIG := ORD( CHARS[I] ) - ORD( '0' ) ;
+76020 IF ( INT > MAXINTDIV10 ) OR ( ( INT = MAXINTDIV10 ) AND ( VALDIG > MAXINTMOD10 ) ) THEN
+76030 ERRORR( WRONGVAL ) ;
+76040 INT := INT * 10 + VALDIG
+76050 END;
+76060 IF NEG THEN INT := - INT
+76070 END
+76080 END;
+76090 (**)
+76100 PROCEDURE READREAL;
+76110 (*+01()
+76120 CONST TML=10000000000000000B;
+76130 LIMIT=14631463146314631B; (*16*TML/10*)
+76140 ()+01*)
+76150 VAR RINT: MINT ;
+76160 PM, BEFORE, AFTER, E, I, RINTEXP: INTEGER;
+76170 NEG: BOOLEAN;
+76180 BEGIN WITH F^, TEMP, BUFFER DO
+76190 BEGIN
+76200 PM := 0;
+76210 CLRDSTR(PCOVER,CHARS,ALLCHAR-['+','-'] (*+01() , ALLCHAR1 ()+01*) ,PM,PCOVER^.BOOK,PCOVER^.DOGETS);
+76220 NEG := (PM=1) AND (CHARS[0]='-');
+76230 I := 0;
+76240 CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
+76250 BEFORE := 0; AFTER := 0; E := 0;
+76260 CLRDSTR(PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,BEFORE,PCOVER^.BOOK,PCOVER^.DOGETS);
+76270 RINT := 0;
+76280 FOR I := 0 TO BEFORE-1 DO
+76290 (*+01() IF RINT<LIMIT THEN ()+01*)
+76300 RINT := RINT*10+(ORD(CHARS[I])-ORD('0'))
+76310 (*+01() ELSE E := E+1 ()+01*) ;
+76320 I := 0;
+76330 CLRDSTR(PCOVER,CHARS,ALLCHAR-['.','E'(*-50(),CHR(ORD('E')+32)()-50*)](*+01(),ALLCHAR1()+01*),
+76340 I,PCOVER^.BOOK,PCOVER^.DOGETS);
+76350 IF (I>0) AND (CHARS[0]='.') THEN
+76360 BEGIN
+76370 CLRDSTR (
+76380 PCOVER,CHARS,ALLCHAR-['0'..'9'] (*+01() , ALLCHAR1 ()+01*) ,AFTER,PCOVER^.BOOK,PCOVER^.DOGETS
+76390 ) ;
+76400 FOR I := 0 TO AFTER-1 DO
+76410 (*+01() IF RINT<LIMIT THEN ()+01*)
+76420 RINT := RINT*10+(ORD(CHARS[I])-ORD('0'))
+76430 (*+01() ELSE E := E+1 ()+01*) ;
+76440 RINTEXP := BEFORE + AFTER - E ;
+76450 I := 0;
+76460 CLRDSTR(PCOVER,CHARS,ALLCHAR-['E'(*-50(),CHR(ORD('E')+32)()-50*)](*+01(),ALLCHAR1()+01*),
+76470 I,PCOVER^.BOOK,PCOVER^.DOGETS);
+76480 IF (PM>1) OR (AFTER=0) THEN ERRORR(NODIGIT);
+76490 E := E-AFTER;
+76500 END
+76510 ELSE IF (PM>1) OR (BEFORE=0) THEN ERRORR(NODIGIT);
+76520 IF (I>0) AND ((CHARS[0]='E') (*-50()OR (CHARS[0]=CHR(ORD('E')+32))()-50*)) THEN
+76530 BEGIN
+76540 I := 0;
+76550 CLRDSTR(PCOVER,CHARS,ALLCHAR-[' '] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS);
+76560 READNUM;
+76570 E := E+INT;
+76580 END;
+76590 IF ( E + RINTEXP <= MINREALEXP ) OR ( RINT = 0 ) THEN REA := 0.0
+76600 ELSE IF E>=323 THEN ERRORR(WRONGVAL)
+76610 ELSE
+76620 BEGIN
+76630 (*-02() REA := TIMESTEN(RINT, E); ()-02*)
+76640 (*+02() REA := TIMESTE(RINT, E); ()+02*)
+76650 IF INT=INTUNDEF THEN ERRORR(WRONGVAL);
+76660 END;
+76670 IF NEG THEN REA := -REA;
+76680 END
+76690 END;
+76700 (**)
+76710 BEGIN WITH TEMP DO
+76720 BEGIN
+76730 IF NOT([OPENED,READMOOD,CHARMOOD]<=F^.PCOVER^.STATUS) THEN
+76740 ENSSTATE(RF, F, [OPENED,READMOOD,CHARMOOD]);
+76750 XSIZE := SZINT;
+76760 CASE XMODE OF
+76770 -1: (*FILLER*) XSIZE := 0;
+76780 (*+61() 1,3,5: (*LONG MODES*)
+76790 BEGIN XSIZE := SZLONG; DUMMY END; ()+61*)
+76800 0: (*INT*)
+76810 BEGIN SKIPSPACES(RF,F); READNUM; P^.FIRSTINT := INT END;
+76820 2: (*REAL*)
+76830 BEGIN XSIZE := SZREAL; SKIPSPACES(RF,F); READREAL; P^.FIRSTREAL := REA END;
+76840 4: (*COMPL*)
+76850 BEGIN
+76860 XSIZE := SZADDR;
+76870 SKIPSPACES(RF,F);
+76880 READREAL;
+76890 P^.FIRSTREAL := REA;
+76900 I := 0;
+76910 WITH F^ DO
+76920 CLRDSTR (
+76930 PCOVER,BUFFER.CHARS,ALLCHAR-[' ','I'] (*+01() , ALLCHAR1 ()+01*) ,I,PCOVER^.BOOK,PCOVER^.DOGETS
+76940 ) ;
+76950 ISEEN := FALSE;
+76960 FOR K := 0 TO I-1 DO
+76970 ISEEN := ISEEN OR (BUFFER.CHARS[K]='I');
+76980 IF NOT ISEEN THEN ERRORR(WRONGCHAR);
+76990 READREAL;
+77000 P := INCPTR(P, SZREAL);
+77010 P^.FIRSTREAL := REA;
+77020 END;
+77030 6: (*CHAR*)
+77040 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+77050 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
+77060 I := -1;
+77070 WITH F^ DO
+77080 CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
+77090 P^.FIRSTWORD := I
+77100 END;
+77110 7: (*STRING*)
+77120 WITH BUFFER DO
+77130 BEGIN
+77140 XSIZE := SZADDR;
+77150 I:=0;
+77160 REPEAT
+77170 IF [PAGEOVERFLOW]<=F^.PCOVER^.STATUS
+77180 THEN CARRYON:=ENSPAGE(RF,F)
+77190 ELSE CARRYON:=TRUE;
+77200 IF CARRYON THEN
+77210 IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+77220 THEN BEGIN OLD:=F^.PCOVER^.STATUS;
+77230 IF F^.LINEMENDED=UNDEFIN THEN CARRYON := FALSE
+77240 ELSE CARRYON:=FUNC68(GETPROC(F^.LINEMENDED),RF);
+77250 ENSSTATE(RF,F,OLD)
+77260 END
+77270 ELSE
+77280 WITH F^ DO
+77290 BEGIN
+77300 CLRDSTR(PCOVER, CHARS, TERM (*+01() , TERM1 ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
+77310 CARRYON := LINEOVERFLOW IN PCOVER^.STATUS
+77320 END
+77330 UNTIL NOT CARRYON;
+77340 WITH P^ DO
+77350 BEGIN FPDEC(FIRSTPTR^);
+77360 IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+77370 FIRSTPTR:=CRSTRING(I);
+77380 FPINC(FIRSTPTR^);
+77390 PTR := INCPTR(FIRSTPTR, STRINGCONST);
+77400 END;
+77410 WHILE I <> (I DIV CHARPERWORD) * CHARPERWORD DO
+77420 BEGIN CHARS[I]:=CHR(0);
+77430 I:=I+1
+77440 END;
+77450 J:=I DIV CHARPERWORD ;
+77460 FOR I:=1 TO J DO
+77470 BEGIN PTR^.FIRSTWORD := INTS[I]; PTR := INCPTR(PTR, SZWORD) END;
+77480 END; (*STRING*)
+77490 8: (*BOOL*)
+77500 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+77510 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
+77520 I := -1;
+77530 WITH F^ DO
+77540 CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
+77550 IF CHR(I)='T' THEN INT := TRUEVAL
+77560 ELSE IF CHR(I)='F' THEN INT := 0
+77570 ELSE ERRORR(WRONGCHAR) ;
+77580 P^.FIRSTWORD := INT
+77590 END; (*BOOL*)
+77600 9: (*BITS*)
+77610 BEGIN K:=0;
+77620 FOR J:=1 TO BITSWIDTH DO
+77630 BEGIN SKIPSPACES(RF,F);
+77640 I := -1;
+77650 WITH F^ DO
+77660 CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
+77670 IF CHR(I) IN ['T','F'] THEN K := K*2+ORD(CHR(I)='T')
+77680 ELSE ERRORR(WRONGCHAR)
+77690 END;
+77700 P^.FIRSTWORD := K
+77710 END;
+77720 10: (*BYTES*)
+77730 FOR J:=1 TO BYTESWIDTH DO
+77740 BEGIN
+77750 IF LINEOVERFLOW IN F^.PCOVER^.STATUS THEN
+77760 IF NOT ENSLINE(RF, F) THEN ERRORR(NOLOGICAL);
+77770 I := -1;
+77780 WITH F^ DO
+77790 CLRDSTR(PCOVER, BUFFER.CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, PCOVER^.BOOK, PCOVER^.DOGETS);
+77800 ALF[J] := CHR(I);
+77810 P^.FIRSTWORD := INT
+77820 END;
+77830 11: (*PROC*)
+77840 CL68(GETPROC(PVAL), RF);
+77850 12: (*STRUCT*)
+77860 BEGIN J:=0;
+77870 REPEAT J:=J+1 UNTIL TEMPLATE^[J]<0;
+77880 I:=ORD(P);
+77890 WHILE ORD(P)-I<TEMPLATE^[0] DO
+77900 BEGIN J:=J+1;
+77910 XMODE:=TEMPLATE^[J]-1;
+77920 VALUEREAD(RF,F);
+77930 P:=INCPTR(P, XSIZE)
+77940 END;
+77950 XMODE:=12;
+77960 END; (*STRUCT*)
+77970 14: (*CODE(REF FILE)VOID*)
+77980 CLPASC1( ORD(RF), PROCC );
+77990 END; (*CASE*)
+78000 END (*WITH*)
+78010 END; (*VALUEREAD*)
+78020 (**)
+78030 BEGIN (*GET*)
+78040 (*+02() 1: ()+02*) COUNT := GETSTKTOP(SZWORD, 0);
+78050 FPINC(RF^);
+78060 J := COUNT+SZWORD; WHILE J>SZWORD DO
+78070 BEGIN
+78080 J := J-SZWORD;
+78090 XMODE := GETSTKTOP(SZWORD, J);
+78100 IF XMODE IN [0..13,15..31] THEN
+78110 BEGIN
+78120 J := J - SZADDR;
+78130 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
+78140 FPINC(PVAL^);
+78150 END
+78160 ELSE IF XMODE=14 THEN J := J-SZPROC
+78170 END;
+78180 TESTF(RF,F);
+78190 J := COUNT+SZWORD; WHILE J>SZWORD DO
+78200 BEGIN
+78210 J := J-SZWORD;
+78220 XMODE:=GETSTKTOP(SZWORD, J);
+78230 IF XMODE>=16 THEN (*ROW*)
+78240 BEGIN XMODE:=XMODE-16;
+78250 J := J-SZADDR;
+78260 PVAL:=ASPTR(GETSTKTOP(SZADDR, J));
+78270 WITH PVAL^ DO
+78280 BEGIN
+78290 IF FPTWO(ANCESTOR^.PVALUE^) THEN
+78300 TESTCC(PVAL);
+78310 FORMPDESC(PVAL,PDESC1);
+78320 TEMPLATE:=MDBLOCK;
+78330 WITH ANCESTOR^ DO
+78340 BEGIN
+78350 IF ORD(TEMPLATE)=0 THEN SIZE:=1
+78360 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN SIZE:=ORD(TEMPLATE)
+78370 ELSE SIZE:=TEMPLATE^[0];
+78380 WHILE NEXTEL(0,PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
+78390 BEGIN I:=PP;
+78400 WHILE I<PP+PSIZE DO
+78410 BEGIN
+78420 P:=INCPTR(PVALUE, I);
+78430 VALUEREAD(RF,F); I:=I+SIZE
+78440 END
+78450 END
+78460 END
+78470 END
+78480 END
+78490 ELSE IF XMODE>=0 THEN
+78500 BEGIN WASSTRING:=FALSE;
+78510 IF XMODE = 14 THEN
+78520 BEGIN
+78530 J := J - SZPROC ;
+78540 TEMP.PROCC := GETSTKTOP( SZPROC , J )
+78550 END
+78560 ELSE
+78570 BEGIN
+78580 J := J - SZADDR ;
+78590 PVAL:=ASPTR(GETSTKTOP(SZADDR, J));
+78600 IF XMODE <> 11 THEN WITH PVAL^ DO
+78610 IF SORT IN [RECN, REFN] THEN
+78620 IF XMODE<>7 THEN (*NOT STRING*)
+78630 BEGIN
+78640 TEMPLATE:=PVALUE^.DBLOCK;
+78650 IF FPTWO(PVALUE^) THEN
+78660 TESTSS(PVAL);
+78670 P := INCPTR(PVALUE, STRUCTCONST)
+78680 END
+78690 ELSE
+78700 BEGIN ENEW(P,1); P^.FIRSTPTR:=PVALUE;WASSTRING:=TRUE END
+78710 ELSE
+78720 BEGIN
+78730 TEMPLATE := DBLOCK;
+78740 WITH ANCESTOR^ DO
+78750 IF FPTWO(PVALUE^) THEN
+78760 P := SAFEACCESS(PVAL)
+78770 ELSE
+78780 BEGIN
+78790 PVALUE^.OSCOPE := 0;
+78800 P := INCPTR(PVALUE,PVAL^.OFFSET)
+78810 END
+78820 END
+78830 END;
+78840 VALUEREAD(RF,F);
+78850 IF WASSTRING THEN
+78860 BEGIN PVAL^.PVALUE := P^.FIRSTPTR; EDISPOSE(P, 1) END;
+78870 END;
+78880 END;
+78890 J := COUNT+SZWORD; WHILE J>SZWORD DO
+78900 BEGIN
+78910 J := J-SZWORD;
+78920 XMODE := GETSTKTOP(SZWORD, J);
+78930 IF XMODE IN [0..13,15..31] THEN
+78940 BEGIN
+78950 J := J - SZADDR;
+78960 PVAL := ASPTR(GETSTKTOP(SZADDR, J)); WITH PVAL^ DO
+78970 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
+78980 END
+78990 ELSE IF XMODE = 14 THEN J := J - SZPROC
+79000 END;
+79010 WITH RF^ DO
+79020 BEGIN FDEC; IF FTST THEN GARBAGE(RF) END;
+79030 END; (*GET*)
+79040 (**)
+79050 (**)
+79060 (*+01() (*$X4*) ()+01*)
+79070 (**)
+79080 (**)
+79090 (*-02()
+79100 BEGIN (*OF A68*)
+79110 END; (*OF A68*)
+79120 ()-02*)
+79130 (*+01()
+79140 BEGIN (*OF MAIN PROGRAM*)
+79150 END (* OF EVERYTHING *).
+79160 ()+01*)
--- /dev/null
+08000 #include "rundecs.h"
+08010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+08020 (**)
+08030 (*+01() (*$X6*) ()+01*)
+08040 PROCEDURE STANDINC(PCOV: OBJECTP; LFN: LFNTYPE); EXTERN;
+08050 PROCEDURE STANDOUT(PCOV: OBJECTP; LFN: LFNTYPE); EXTERN;
+08060 PROCEDURE STANDBAC(PCOV: OBJECTP; LFN: LFNTYPE); EXTERN;
+08070 (*+01() (*$X4*) ()+01*)
+08080 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN;
+08090 PROCEDURE ERRORR(N: INTEGER); EXTERN;
+08100 (*+05() FUNCTION TIME: REAL; EXTERN; ()+05*)
+08110 PROCEDURE CALLPASC ; EXTERN;
+08120 PROCEDURE ABORT; EXTERN;
+08130 (*+02()
+08140 PROCEDURE ACLS(FIL: FETROOMP); EXTERN;
+08150 PROCEDURE STOPEN (VAR PF: FYL; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH(COV:OBJECTP;L:LFNTYPE) ); EXTERN;
+08160 ()+02*)
+08170 (*+01() (*$X6*) ()+01*)
+08180 FUNCTION PROC(PROCEDURE P):ASPROC;EXTERN;
+08190 (*-01()
+08200 FUNCTION PROCH( PROCEDURE P( COV: OBJECTP ; L: LFNTYPE ) ): ASPROC ; EXTERN ;
+08210 ()-01*)
+08220 (*+01() (*$X4*) ()+01*)
+08230 (**)
+08240 (*+24()
+08250 PROCEDURE FINDSORT(POINT: OBJECTP; VAR GETSORT: ALFA);
+08260 BEGIN
+08270 (*+01() (*$T-*) ()+01*)
+08280 CASE POINT^.SORT OF
+08290 STRUCT: GETSORT:='STRUCT ';
+08300 MULT: GETSORT:='MULT ';
+08310 IELS: GETSORT:='IELS ';
+08320 ROUTINE:GETSORT:='ROUTINE ';
+08330 REF1: GETSORT:='REF1 ';
+08340 REF2: GETSORT:='REF2 ';
+08350 REFN: GETSORT:='REFN ';
+08360 CREF: GETSORT:='CREF ';
+08370 REFR: GETSORT:='REFR ';
+08380 REFSL1: GETSORT:='REFSL1 ';
+08390 REFSLN: GETSORT:='REFSLN ';
+08400 RECR: GETSORT:='RECR ';
+08410 RECN: GETSORT:='RECN ';
+08420 UNDEF: GETSORT:='UNDEF ';
+08430 NILL: GETSORT:='NILL ';
+08440 STRING: GETSORT:='STRING ';
+08450 END
+08460 END;
+08470 (**)
+08480 (**)
+08490 PROCEDURE PRINTSORT(POINT: OBJECTP);
+08500 BEGIN
+08510 CASE POINT^.SORT OF
+08520 STRUCT: WRITE('STRUCT');
+08530 MULT: WRITE('MULT');
+08540 IELS: WRITE('IELS');
+08550 ROUTINE:WRITE('ROUTINE');
+08560 REF1: WRITE('REF1');
+08570 REF2: WRITE('REF2');
+08580 REFN: WRITE('REFN');
+08590 CREF: WRITE('CREF');
+08600 REFR: WRITE('REFR');
+08610 REFSL1: WRITE('REFSL1');
+08620 REFSLN: WRITE('REFSLN');
+08630 RECR: WRITE('RECR');
+08640 RECN: WRITE('RECN');
+08650 UNDEF: WRITE('UNDEF');
+08660 NILL: WRITE('NILL');
+08670 END;
+08680 WRITELN(' SORT');
+08690 (* ( $T+ ) *)
+08700 END;
+08710 (**)
+08720 (**)
+08730 PROCEDURE PRINTDESC(ADESC: OBJECTP);
+08740 VAR I:INTEGER;
+08750 BEGIN
+08760 WITH ADESC^ DO
+08770 BEGIN
+08780 WRITE('SIZ',SIZE:2,' D0',D0:2,' LBJ',LBADJ:2);
+08790 WRITE(' LIUIDI');
+08800 FOR I := 0 TO ROWS DO WITH DESCVEC[I] DO
+08810 WRITE(LI:2, UI:2, DI:2);
+08820 WRITELN
+08830 END;
+08840 END;
+08850 ()+24*)
+08860 (**)
+08870 (**)
+08880 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP;
+08890 VAR POINT :OBJECTP;
+08900 PTR: UNDRESSP;
+08910 BEGIN
+08920 IF LENGTH<0 THEN LENGTH := 0;
+08930 ENEW(POINT, STRINGCONST+((LENGTH + CHARPERWORD - 1) DIV CHARPERWORD)*SZWORD);
+08940 (*-02() POINT^.FIRSTWORD := SORTSHIFT * ORD(STRING); ()-02*)
+08950 (*+02() POINT^.PCOUNT:=0; POINT^.SORT:=STRING; ()+02*)
+08960 POINT^.STRLENGTH := LENGTH;
+08970 PTR := INCPTR(POINT, STRINGCONST+((LENGTH-1) DIV CHARPERWORD)*SZWORD);
+08980 IF LENGTH<>0 THEN PTR^.FIRSTWORD := 0;
+08990 CRSTRING := POINT
+09000 END;
+09010 (**)
+09020 (**)
+09030 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP;
+09040 VAR NEWSTRUCT: OBJECTP;
+09050 TEMPOS, STRUCTPOS, STRUCTSIZE, COUNT: INTEGER;
+09060 PTR, PTR1: UNDRESSP;
+09070 BEGIN
+09080 STRUCTSIZE:= TEMPLATE^[0];
+09090 ENEW(NEWSTRUCT, STRUCTSIZE+STRUCTCONST);
+09100 WITH NEWSTRUCT^ DO
+09110 BEGIN
+09120 (*-02() FIRSTWORD := SORTSHIFT * ORD(STRUCT); ()-02*)
+09130 (*+02() PCOUNT:=0; SORT:=STRUCT; ()+02*)
+09140 (*+01() SECONDWORD := 0; ()+01*)
+09150 OSCOPE := 0 ;
+09160 LENGTH := STRUCTSIZE+STRUCTCONST;
+09170 DBLOCK:= TEMPLATE;
+09180 PTR := INCPTR(NEWSTRUCT, STRUCTCONST);
+09190 PTR^.FIRSTWORD := INTUNDEF;
+09200 PTR1 := INCPTR(PTR, SZWORD);
+09210 MOVELEFT(PTR, PTR1, STRUCTSIZE-SZWORD);
+09220 TEMPOS:= 1;
+09230 STRUCTPOS := TEMPLATE^[1];
+09240 WHILE STRUCTPOS >= 0
+09250 DO BEGIN
+09260 PTR := INCPTR(NEWSTRUCT, STRUCTCONST+STRUCTPOS);
+09270 PTR^.FIRSTPTR := UNDEFIN;
+09280 TEMPOS:= TEMPOS+1;
+09290 STRUCTPOS := TEMPLATE^[TEMPOS];
+09300 END;
+09310 END;
+09320 CRSTRUCT := NEWSTRUCT
+09330 END;
+09340 (**)
+09350 (**)
+09360 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); FORWARD;
+09370 (**)
+09380 (**)
+09390 (*+02()
+09400 PROCEDURE ACLOSE(EFET: FETROOMP);
+09410 VAR NAME:OBJECTP;
+09420 BEGIN
+09430 WITH EFET^ DO
+09440 IF UFD>2 THEN (*USER'S FILE*)
+09450 BEGIN NAME := INCPTR(FNAME, -STRINGCONST);
+09460 FPDEC(NAME^); IF FPTST(NAME^) THEN GARBAGE(NAME);
+09470 END;
+09480 ACLS(EFET);
+09490 END;
+09500 ()+02*)
+09510 PROCEDURE GARBAGE(* (ANOBJECT: OBJECTP) *) ;
+09520 LABEL 1;
+09530 VAR ASINT: INTEGER;
+09540 BACK, HEAD: OBJECTP; TEMPLATE: DPOINT;
+09550 TEMP: OBJECTP;
+09560 PTR: UNDRESSP;
+09570 ELSIZE, SIZEACC, COUNT, STRUCTPOS, TEMPOS: INTEGER;
+09580 ISHEAD: BOOLEAN;
+09590 GETSORT: ALFA;
+09600 PFET: FETROOMP;
+09610 BEGIN
+09620 (*+24()(*BUGFILE
+09630 FINDSORT(ANOBJECT, GETSORT);
+09640 WRITELN(BUGFILE, 'GARBGE', GETSORT, 'AT', ORD(ANOBJECT):(*-01()1()-01*)(*+01()6 OCT()+01*) ,
+09650 'C=', ANOBJECT^.PCOUNT:4);
+09660 BUGFILE*)()+24*)
+09670 1: WITH ANOBJECT^ DO
+09680 BEGIN
+09690 (*+01() IF ORD(ANOBJECT)=0 THEN HALT; (*FOR CATCHING BUGS - SHOULDN'T HAPPEN*) ()+01*)
+09700 CASE SORT OF
+09710 STRUCT:
+09720 BEGIN
+09730 TEMPLATE:= DBLOCK;
+09740 TEMPOS:= 1;
+09750 STRUCTPOS:= TEMPLATE^[1];
+09760 WHILE STRUCTPOS>=0 DO
+09770 BEGIN
+09780 PTR := INCPTR(ANOBJECT, STRUCTCONST+STRUCTPOS);
+09790 WITH PTR^.FIRSTPTR^ DO
+09800 BEGIN FDEC; IF FTST THEN GARBAGE(PTR^.FIRSTPTR) END;
+09810 TEMPOS:= TEMPOS+1;
+09820 STRUCTPOS:= TEMPLATE^[TEMPOS]
+09830 END;
+09840 EDISPOSE(ANOBJECT, LENGTH)
+09850 END;
+09860 IELS:
+09870 BEGIN
+09880 TEMPLATE := DBLOCK;
+09890 IF ORD(TEMPLATE)<=MAXSIZE (*NOT STRUCT*) THEN
+09900 BEGIN
+09910 IF ORD(TEMPLATE)=0 (*DRESSED*) THEN
+09920 BEGIN
+09930 PTR := INCPTR(ANOBJECT, ELSCONST);
+09940 WHILE ORD(PTR)<ORD(ANOBJECT)+ELSCONST+D0 DO
+09950 BEGIN
+09960 WITH PTR^.FIRSTPTR^ DO
+09970 BEGIN
+09980 FDEC;
+09990 IF FTST THEN GARBAGE(PTR^.FIRSTPTR)
+10000 END;
+10010 PTR := INCPTR(PTR, SZADDR)
+10020 END
+10030 END
+10040 END
+10050 ELSE BEGIN (*UNDRESSED STRUCTURES*)
+10060 ELSIZE:= TEMPLATE^[0];
+10070 IF TEMPLATE^[1] >= 0 THEN
+10080 BEGIN
+10090 COUNT:= D0;
+10100 ASINT:= ELSCONST;
+10110 WHILE COUNT>0 DO
+10120 BEGIN
+10130 TEMPOS := 1;
+10140 STRUCTPOS := TEMPLATE^[1];
+10150 WHILE STRUCTPOS>=0 DO
+10160 BEGIN
+10170 PTR := INCPTR(ANOBJECT, ASINT+STRUCTPOS);
+10180 WITH PTR^.FIRSTPTR^ DO
+10190 BEGIN FDEC;
+10200 IF FTST THEN GARBAGE(PTR^.FIRSTPTR)
+10210 END;
+10220 TEMPOS := TEMPOS+1;
+10230 STRUCTPOS := TEMPLATE^[TEMPOS]
+10240 END;
+10250 ASINT:= ASINT+ELSIZE;
+10260 COUNT:= COUNT-ELSIZE
+10270 END
+10280 END
+10290 END;
+10300 EDISPOSE(ANOBJECT, ELSCONST+D0)
+10310 END;
+10320 MULT:
+10330 (*ASSERT: THIS MULTIPLE IS NOT SLICED*)
+10340 IF PVALUE=NIL (* A BOUNDS BLOCK *) THEN
+10350 EDISPOSE(ANOBJECT, MULTCONST+(ROWS+1)*SZPDS)
+10360 ELSE
+10370 BEGIN
+10380 BACK := BPTR;
+10390 IF BACK<>NIL THEN
+10400 BEGIN (*NOT SLICED BUT A SLICE*)
+10410 HEAD:= FPTR;
+10420 IF ANOBJECT<>BACK^.IHEAD THEN
+10430 BEGIN (*NOT FIRST SLICE*)
+10440 BACK^.FPTR:= HEAD;
+10450 IF HEAD<>NIL THEN
+10460 HEAD^.BPTR:= BACK
+10470 END
+10480 ELSE
+10490 IF HEAD<>NIL (* THE FIRST SLICE AND NOT THE LAST SLICE *) THEN
+10500 BEGIN
+10510 BACK^.IHEAD:= HEAD;
+10520 HEAD^.BPTR := BACK
+10530 END
+10540 ELSE
+10550 BEGIN (*THE ONLY SLICE*)
+10560 BACK^.IHEAD := NIL;
+10570 FPDEC(BACK^);
+10580 IF FPTST(BACK^) THEN GARBAGE(BACK)
+10590 END
+10600 END;
+10610 FPDEC(PVALUE^); TEMP := PVALUE;
+10620 EDISPOSE(ANOBJECT, MULTCONST+(ROWS+1)*SZPDS);
+10630 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+10640 END;
+10650 REFN:
+10660 BEGIN
+10670 FPDEC(PVALUE^); TEMP := PVALUE;
+10680 EDISPOSE(ANOBJECT, REFNSIZE);
+10690 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+10700 END;
+10710 REFSLN:
+10720 BEGIN
+10730 FPDEC(ANCESTOR^);
+10740 TEMP := ANCESTOR;
+10750 EDISPOSE(ANOBJECT, REFSLNCONST+(ROWS+1)*SZPDS);
+10760 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+10770 END;
+10780 REFSL1:
+10790 BEGIN
+10800 FPDEC(ANCESTOR^);
+10810 TEMP := ANCESTOR;
+10820 EDISPOSE(ANOBJECT, REFSL1SIZE);
+10830 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+10840 END;
+10850 REFR:
+10860 BEGIN
+10870 FPDEC(PVALUE^); TEMP := PVALUE;
+10880 EDISPOSE(ANOBJECT, REFRCONST+(ROWS+1)*SZPDS);
+10890 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+10900 END;
+10910 RECR:
+10920 BEGIN
+10930 BACK:= PREV;
+10940 HEAD:= NEXT;
+10950 BACK^.NEXT:= HEAD;
+10960 IF HEAD <> NIL THEN
+10970 HEAD^.PREV:= BACK;
+10980 FPDEC(PVALUE^); TEMP := PVALUE;
+10990 EDISPOSE(ANOBJECT, RECRCONST+(ROWS+1)*SZPDS);
+11000 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+11010 END;
+11020 RECN:
+11030 BEGIN
+11040 BACK := PREV;
+11050 HEAD := NEXT;
+11060 BACK^.NEXT := HEAD;
+11070 IF HEAD<>NIL THEN
+11080 HEAD^.PREV:= BACK;
+11090 FPDEC(PVALUE^); TEMP := PVALUE;
+11100 EDISPOSE(ANOBJECT, RECNSIZE);
+11110 IF FPTST(TEMP^) THEN BEGIN ANOBJECT := TEMP; GOTO 1 END
+11120 END;
+11130 CREF:
+11140 EDISPOSE(ANOBJECT, CREFSIZE);
+11150 REF1:
+11160 EDISPOSE(ANOBJECT, REF1SIZE);
+11170 (*-01() REF2:
+11180 EDISPOSE(ANOBJECT, REF2SIZE); ()-01*)
+11190 ROUTINE:
+11200 EDISPOSE(ANOBJECT, ROUTINESIZE);
+11210 PASCROUT:
+11220 EDISPOSE(ANOBJECT, PROUTINESIZE);
+11230 STRING:
+11240 EDISPOSE(ANOBJECT, STRINGCONST+((STRLENGTH+CHARPERWORD-1) DIV CHARPERWORD)*SZWORD);
+11250 UNDEF, NILL:
+11260 PCOUNT := 255; (*MUSTN'T BE COLLECTED, OF COURSE*)
+11270 COVER:
+11280 BEGIN
+11290 IF ASSOC THEN
+11300 BEGIN FPDEC(ASSREF^); IF FPTST(ASSREF^) THEN GARBAGE(ASSREF) END
+11310 ELSE BEGIN
+11320 IF OPENED IN STATUS THEN ACLOSE(BOOK);
+11330 PFET := BOOK;
+11340 IF NOT(STARTUP IN STATUS) THEN DISPOSE(PFET)
+11350 END;
+11360 EDISPOSE(ANOBJECT, COVERSIZE)
+11370 END
+11380 END (*ESAC*)
+11390 END (*OF WITH*)
+11400 END; (*OF GARBAGE*)
+11410 (**)
+11420 (**)
+11430 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP;
+11440 (*PRODUCES EITHER A MULT,RECR,REFR OR A REFSLN FROM A MULT OR A REFSLN
+11450 N.B. NO PCOUNTS ARE UPDATED*)
+11460 VAR NEWDESC: OBJECTP;
+11470 COUNT: INTEGER;
+11480 BEGIN
+11490 COUNT := MULTCONST (*REFSLNCONST*) + (ORIGINAL^.ROWS + 1)*SZPDS;
+11500 ENEW(NEWDESC, COUNT);
+11510 WITH NEWDESC^ DO
+11520 BEGIN
+11530 MOVELEFT(ORIGINAL, NEWDESC, COUNT);
+11540 SORT := NEWSORT;
+11550 PCOUNT := 0;
+11560 END;
+11570 COPYDESC := NEWDESC
+11580 END;
+11590 (**)
+11600 (**)
+11610 (*+01() (*$X6*) ()+01*)
+11620 PROCEDURE OPENCOVER(
+11630 PFET: FETROOMP; VAR PCOV: OBJECTP; LFN: LFNTYPE; PROCEDURE CH (*-01() ( COV: OBJECTP; L: LFNTYPE) ()-01*)
+11640 );
+11650 BEGIN
+11660 ENEW(PCOV, COVERSIZE);
+11670 WITH PCOV^ DO
+11680 BEGIN
+11690 (*-02() FIRSTWORD := SORTSHIFT * ORD(COVER) + INCRF; ()-02*)
+11700 (*+02() PCOUNT:=1; SORT:=COVER; ()+02*)
+11710 BOOK := PFET;
+11720 ASSOC := FALSE;
+11730 OSCOPE := 1;
+11740 CHANNEL := PROC(*-01()H()-01*)(CH);
+11750 COFCPOS := 1; LOFCPOS := 1; POFCPOS := 1;
+11760 CH(PCOV, LFN);
+11770 END
+11780 END;
+11790 (**)
+11800 (**)
+11810 PROCEDURE START68;
+11820 (*INITIALIZATION OF RUN68*)
+11830 VAR PINT: INTPOINT;
+11840 CURR: IPOINT;
+11850 TEMP: PACKED RECORD CASE SEVERAL OF
+11860 1: (INT: INTEGER);
+11870 2: (ALF: LFNTYPE);
+11880 3: (LFN: PACKED ARRAY [1..7] OF CHAR;
+11890 (*+01() EFET1: 0..777777B ()+01*) );
+11900 0 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+11910 END;
+11920 (*+01() AW66: ^W66 ; ()+01*)
+11930 TEMP1: REALTEGER;
+11940 I: INTEGER;
+11950 EFET: INTEGER;
+11960 (*+01() PROCEDURE ESTART(CURR: IPOINT); EXTERN; ()+01*)
+11970 (*+02() PROCEDURE ESTART_(VAR INF,OUTF : TEXT); EXTERN;
+11980 FUNCTION MAXR REAL; EXTERN; ()+02*)
+11990 (*-02() PROCEDURE STOPEN(
+12000 VAR PF: FYL; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH (*-01() ( COV: OBJECTP ; L: LFNTYPE ) ()-01*)
+12010 ); EXTERN; ()-02*)
+12020 BEGIN
+12030 (*+01() CPUCLOCK := -CLOCK; ()+01*)
+12040 (*-02() CURR := STATIC(ME)+FIRSTIBOFFSET;
+12050 SETMYSTATIC(CURR); ()-02*)
+12060 (*+01() ESTART(CURR); (*TO DO ALL THE MACHINE-DEPENDENT INITIALIZATIONS*) ()+01*)
+12070 (*+02() ESTART_(INPUT,OUTPUT); (*THIS ALSO SETS UP THE FILES*)
+12080 CURR := STATIC(ME);(*ESTART SET UP START68'S STATIC LINK*) ()+02*)
+12090 SCOPE := 1;
+12100 BITPATTERN.MASK := 0; BITPATTERN.COUNT := 0;
+12110 TRACE := NIL;
+12120 LEVEL := 0; PROCBL := NIL;
+12130 LINENO := 0;
+12140 (*+02()INTUNDEF := -32000 -768; ()+02*)
+12150 WITH FIRSTRG DO WITH FIRSTW DO
+12160 BEGIN
+12170 LOOPCOUNT := 0; RGIDBLK := NIL; RECGEN := NIL;
+12180 RGSCOPE := 1;
+12190 (*-41()
+12200 RIBOFFSET := INCPTR( ASPTR( CURR ) , IBCONST ) ;
+12210 RGNEXTFREE := INCPTR(RIBOFFSET, RGCONST+SZINT+3*SZADDR (*+02()+3*SZREAL()+02*)) ;
+12220 ()-41*)
+12230 (*+41()
+12240 RIBOFFSET := INCPTR( ASPTR( CURR ) , IBCONST + RGCONST ) ;
+12250 RGLASTUSED := INCPTR(RIBOFFSET, -SZINT-3*SZADDR (*+02()-3*SZREAL()+02*)) ;
+12260 ()+41*)
+12270 END;
+12280 ENEW(UNDEFIN, MULTCONST+8*SZPDS);
+12290 (*SHOULD BE, INTER ALIA, THE EMPTY STRING AND THE FLATTEST MULT AND AN UNOPENED COVER*)
+12300 WITH UNDEFIN^ DO
+12310 BEGIN
+12320 (*-02() FIRSTWORD := SORTSHIFT * ORD(UNDEF); ()-02*)
+12330 (*+02() PCOUNT:=0; SORT:=UNDEF; ()+02*)
+12340 (*+01() SECONDWORD := 0; ()+01*)
+12350 PCOUNT := 255;
+12360 ANCESTOR := UNDEFIN;
+12370 OSCOPE := 1;
+12380 ENEW(HIGHPCOUNT,MULTCONST+8*SZPDS);
+12390 PVALUE := HIGHPCOUNT;
+12400 WITH PVALUE^ DO
+12410 BEGIN
+12420 (*-02() FIRSTWORD := SORTSHIFT * ORD(UNDEF); ()-02*)
+12430 (*+02() PCOUNT:=0; SORT:=UNDEF; ()+02*)
+12440 (*+01() SECONDWORD := 0; ()+01*)
+12450 ANCESTOR := UNDEFIN;
+12460 PCOUNT := 255;
+12470 PVALUE := UNDEFIN^.PVALUE;
+12480 OSCOPE := 1;
+12490 OFFSET := HIOFFSET;
+12500 ROWS := 7;
+12510 STRLENGTH := 0;
+12520 STATUS := [];
+12530 WITH DESCVEC[0] DO BEGIN LI := MAXBOUND; UI := MINBOUND END;
+12540 FOR I := 1 TO 7 DO DESCVEC[I] := DESCVEC[1]
+12550 END;
+12560 OFFSET := HIOFFSET;
+12570 ROWS := 7;
+12580 STRLENGTH := 0;
+12590 STATUS := [];
+12600 WITH DESCVEC[0] DO BEGIN LI := MAXBOUND; UI := MINBOUND END;
+12610 FOR I := 1 TO 7 DO DESCVEC[I] := DESCVEC[1]
+12620 END;
+12630 NILPTR := COPYDESC(UNDEFIN, NILL);
+12640 NILPTR^.PCOUNT := 255;
+12650 PUTSTRING := CRSTRING(2*REALWIDTH+2*EXPWIDTH+9);
+12660 PUTSTRING^.PCOUNT := 255;
+12670 ALLCHAR := []; FOR I := 0 TO (*+01()58()+01*) (*-01()MAXABSCHAR()-01*) DO ALLCHAR := ALLCHAR+[CHR(I)];
+12680 (*+01() ALLCHAR1 := []; FOR I := 59 TO 63 DO ALLCHAR1 := ALLCHAR1+[CHR(I-59)]; ()+01*)
+12690 ENEW(COMPLEX, 2*SZWORD);
+12700 COMPLEX^[0] := 2*SZREAL; COMPLEX^[1] := -1; (*DBLOCK FOR .COMPL*)
+12710 ENEW(FILEBLOCK, 12*SZWORD+SZTERMSET); (*DBLOCK FOR FILE*)
+12720 FILEBLOCK^[0] := 5*SZADDR+SZTERMSET; FILEBLOCK^[1] := 0; FILEBLOCK^[2] := SZADDR; FILEBLOCK^[3] := 2*SZADDR;
+12730 FILEBLOCK^[4] := 3*SZADDR; FILEBLOCK^[5] := 4*SZADDR; FILEBLOCK^[6] := -1;
+12740 FILEBLOCK^[7] := 12; FILEBLOCK^[8] := 12; FILEBLOCK^[9] := 12; FILEBLOCK^[10] := 12;
+12750 FILEBLOCK^[11] := 0; FOR I := 1 TO SZTERMSET DIV SZWORD DO FILEBLOCK^[11+I] := 1;
+12760 NEW(PASCADDR); TEMP1.PROCC := PROC(CALLPASC); PASCADDR^.XBASE := TEMP1.PROCVAL.PROCADD;
+12770 (*+54()
+12780 ENEW(EXCEPTDB, 4*SZWORD);
+12790 EXCEPTDB^[0] := 2*SZINT; EXCEPTDB^[1] := -1;
+12800 EXCEPTDB^[2] := 1; EXCEPTDB^[3] := 0;
+12810 ()+54*)
+12820 (*-44()
+12830 LASTRANDOM := ROUND(MAXINT/2);
+12840 (*-01() (*-05() HALFPI.ACTUALPI := 2*ARCTAN(1.0); ()-05*) ()-01*)
+12850 (*+01() HALFPI.FAKEPI := FAKEPI; ()+01*)
+12860 (*+02() PI := 2.0*HALFPI.ACTUALPI;
+12870 SMALLREAL := 1.0;
+12880 WHILE (1.0+SMALLREAL*2.0>1.0) AND (1.0-SMALLREAL*2.0<1.0) DO SMALLREAL := SMALLREAL/2.0;
+12890 MAXREAL := MAXR;
+12900 ()+02*)
+12910 (*+05() HALFPI.FAKEPI := FAKEPI ; HALFPI.FAKEPI1 := FAKEPI1 ; ()+05*)
+12920 ()-44*)
+12930 UNINT := INTUNDEF;
+12940 (*+02() UNINTCOPY := UNINT; UNDEFINCOPY := UNDEFIN; ()+02*)
+12950 (*+01()
+12960 WITH TEMP DO
+12970 BEGIN
+12980 PINT := ASPTR(2); (*1ST PROGRAM PARAMETER*)
+12990 INT := PINT^;
+13000 IF INT = 0 THEN LFN := 'INPUT::' ;
+13010 STOPEN(INPUT, STIN, ALF , STANDINC);
+13020 EFET := CURR-FIRSTIBOFFSET+INPUTEFET;
+13030 LFN := 'INPUT::'; EFET1 := EFET+1;
+13040 PINT^ := INT;
+13050 PINT := ASPTR(3); (*2ND PROGRAM PARAMETER*)
+13060 INT := PINT^;
+13070 IF INT = 0 THEN LFN := 'OUTPUT:' ;
+13080 STOPEN(OUTPUT, STOUT, ALF , STANDOUT);
+13090 EFET := CURR-FIRSTIBOFFSET+OUTPUTEFET;
+13100 AW66 := ASPTR(66B);
+13110 IF (AW66^.JOPR=3) AND (LFN='OUTPUT:') THEN WRITELN(OUTPUT, 'STARTING ...');
+13120 LFN := 'OUTPUT:'; EFET1 := EFET+1;
+13130 PINT^ := INT;
+13140 PINT := ASPTR(4);
+13150 PINT^ := INT; (*IN CASE USER OPENS ANOTHER FILE ON OUTPUT*)
+13160 STBACK := UNDEFIN;
+13170 END;
+13180 ()+01*)
+13190 (*+02()
+13200 STOPEN(INPUT, STIN, NIL, STANDINC);
+13210 STOPEN(OUTPUT, STOUT, NIL, STANDOUT);
+13220 WRITELN(OUTPUT, 'STARTING ...');
+13230 ()+02*)
+13240 (*+05()
+13250 STOPEN(INPUT, STIN, NIL , STANDINC);
+13260 STOPEN(OUTPUT, STOUT, NIL , STANDOUT);
+13270 WRITELN(ERROR, 'STARTING ...');
+13280 ()+05*)
+13290 END;
+13300 (*+01() (*$X4*) ()+01*)
+13310 (**)
+13320 (**)
+13330 (**)
+13340 (**)
+13350 PROCEDURE STOP68;
+13360 (*+01() PROCEDURE PEND(EFET: INTEGER); EXTERN; ()+01*)
+13370 (*+02() PROCEDURE ESTOP_; EXTERN; ()+02*)
+13380 BEGIN
+13390 (*+05() FLSBUF(STOUT^.PVALUE^.PCOVER^.BOOK^.XFILE, CHR(10)); ()+05*)
+13400 WRITELN((*-05()OUTPUT()-05*)(*+05()ERROR()+05*));
+13410 WRITELN((*-05()OUTPUT()-05*)(*+05()ERROR()+05*), ' ... AND YET ANOTHER ALGOL68 PROGRAM RUNS TO COMPLETION');
+13420 (*+01() WRITELN(OUTPUT, ' CPU ', (CPUCLOCK+CLOCK)/1000:6:3); ()+01*)
+13430 (*+05() WRITELN(ERROR, ' CPU ', TIME :5:2); ()+05*)
+13440 (*+01() PEND(STATIC(ME)-FIRSTIBOFFSET+OUTPUTEFET) ()+01*)
+13450 (*+02() ESTOP_; ()+02*)
+13460 END;
+13470 (**)
+13480 (**)
+13490 (**)
+13500 (**)
+13510 (*-02() BEGIN END ; ()-02*)
+13520 (*+01()
+13530 BEGIN (*OF MAIN PROGRAM*)
+13540 END (*OF EVERYTHING*).
+13550 ()+01*)
--- /dev/null
+#include "e.h"
+ exa .HTOP ; the label holtop
+ exa .1 ; the Pascal global area
+ exa _extfl ; the routine '_ini' puts 'input' & 'output' here
+ exp $ESTART0
+ exp $ESTART_
+ exp $ESTOP_
+ exp $ABORT
+
+
+ ; PROCEDURE ESTART0
+ pro $ESTART0,0
+ lor 0 ; my LB
+ dup SZADDR
+ dch ; m_a_i_n's LB
+ dup SZADDR
+ str 0 ; pretend I am in m_a_i_n
+ lae .HTOP-FIRSTIBOFFSET; destination address (holtop-firstiboffset)
+ ; now calc how much to move
+ lal 0
+ lor 0
+ sbs SZWORD ; subtract address of param from lb to get link space
+ loc SZWORD+SZADDR+SZADDR
+ ads SZWORD ; allow for one parameter of m_a_i_n
+ bls SZWORD ; block move
+ ; now the global area contains an exact copy of
+ ; m_a_i_n's stack frame, and main will subsequently
+ ; adjust its LB to point to this global copy, thus
+ ; making it a part of the official stack.
+ str 0 ; get my LB back
+ ret 0
+ end 0
+
+ ; PROCEDURE ESTART_ (INPUT,OUTPUT);
+ pro $ESTART_,0
+.2
+ con 2,0,0 ; array that is to be _extfl
+.3
+ con 0I SZADDR ; PASCAL trap routine
+.4
+ con 0 ; trapn
+ con 0 ; signaln
+ LFL SZADDR+SZADDR ; base address for input (2nd param)
+ lae .1
+ sbs SZWORD ; subtract address from hol1 to get offset
+ ste .2+SZWORD ; store in array of offsets
+ LFL SZADDR ; and again for output (1st param after static link)
+ lae .1
+ sbs SZWORD
+ ste .2+SZWORD+SZWORD ; store in array
+ lxl 2 ; params for _ini
+ lae .2
+ lae .1
+ lxa 2
+ cal $_ini
+ asp SZADDR+SZADDR+SZADDR+SZADDR
+ loc A68STAMP ; m_a_i_n's frame stamp, for isa68, any positive number
+ ste .HTOP-FSTAMPOFFSET ; it is in a SZWORD integer, 1st local var
+ inp $_usigs
+ cal $_usigs ; catch UNIX interrupts as EM trap 15
+ inp $_acatch
+ lpi $_acatch ; A68 trap routine
+ sig
+ lae .3
+ sti SZWORD ; preserve PASCAL trap routine
+ zre .4 ; trapn
+ ret 0
+ end 0
+
+ ; procedure usigs;
+ ; var i: integer;
+ ; begin
+ ; for i := 1 to 16 do signal(i, ucatch);
+ ; end;
+ pro $_usigs,SZWORD
+ mes 9,0
+ loc 1
+ loc 16
+ bgt *2
+ loc 1
+ stl -SZWORD
+1
+ zer SZWORD
+ inp $_ucatch
+ lpi $_ucatch
+ lol -SZWORD
+ cal $signal
+ asp SZWORD+SZWORD+SZWORD
+ lol -SZWORD
+ loc 16
+ beq *2
+ lol -SZWORD
+ inc
+ stl -SZWORD
+ bra *1
+2
+ mes 3,-SZWORD,4,1
+ ret 0
+ end SZWORD
+
+ ; procedure ucatch(signo: integer);
+ ; begin
+ ; trap(15);
+ ; end;
+ pro $_ucatch,0
+ mes 9,4
+ lol 0
+ ste .4+SZWORD ; signaln
+#ifdef BSD4
+ loc 0
+ cal $sigsetmask ; unblock all signals
+ asp SZWORD
+ LLC 0 ; SIG_DFL
+ lol 0
+ cal $signal ; because 4.2 Inices do not reset caught signals
+ asp SZADDR+SZWORD
+#endif
+ loc 15
+ cal $trap
+ asp SZWORD
+ mes 3,0,4,0
+ ret 0
+ end 0
+
+ pro $_acatch,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ lol 0 ; EM trap number
+ dup SZWORD
+ ste .4 ; trapn
+ ngi SZWORD
+ lxl 0
+ cal $ERRORR ; should never return
+ end SZWORD
+
+ pro $ESTOP_,0
+ loc 0
+ cal $_hlt
+ end 0
+
+ pro $ABORT,0
+ loe .4 ; trapn
+ zne *1
+ loc 1 ; if abort is called then presumably some error has
+ ; occured, thus exit code 1
+ cal $_hlt
+1
+ loe .4 ; trapn
+ loc 15
+ bne *2 ; if not a UNIX signal
+ cal $_cleanup
+ loe .4+SZWORD ; signaln
+ cal $getpid
+ lfr SZWORD
+ cal $kill
+2
+ lae .3 ; PASCAL trap routine
+ loi SZWORD
+ dup SZWORD
+ zeq *3 ; no PASCAL trap routine
+ sig
+ asp SZWORD
+ loe .4
+ trp ; now let PASCAL handle the same trap
+3
+ loe .4 ; trapn
+ cal $_catch
+ end 0
+
--- /dev/null
+33700 #include "rundecs.h"
+33710 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+33720 (**)
+33730 (**)
+33740 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+33750 FUNCTION DRESSN (CONTENTS: UNDRESSP; TEMPLATE: DPOINT): OBJECTP; EXTERN ;
+33760 (**)
+33770 (**)
+33780 (*-01() (*-05()
+33790 FUNCTION GTOTS(NAK: NAKED): A68INT;
+33800 (*PGETTOTAL*)
+33810 BEGIN
+33820 GTOTS := NAK.POINTER^.FIRSTINT;
+33830 IF FPTST(NAK.STOWEDVAL^) THEN GARBAGE(NAK.STOWEDVAL)
+33840 END;
+33850 (**)
+33860 (**)
+33870 FUNCTION GTOTS2(NAK: NAKED): A68LONG;
+33880 (*PGETTOTAL+1*)
+33890 BEGIN
+33900 GTOTS2 := NAK.POINTER^.FIRSTLONG;
+33910 IF FPTST(NAK.STOWEDVAL^) THEN GARBAGE(NAK.STOWEDVAL)
+33920 END;
+33930 ()-05*) ()-01*)
+33940 (**)
+33950 (**)
+33960 FUNCTION GTOTP(NAK: NAKED): OBJECTP;
+33970 (*PGETTOTAL+2*)
+33980 VAR RESULT: OBJECTP;
+33990 BEGIN WITH NAK DO
+34000 BEGIN
+34010 RESULT := POINTER^.FIRSTPTR;
+34020 IF FPTST(STOWEDVAL^) THEN
+34030 BEGIN
+34040 FPINC(RESULT^);
+34050 GARBAGE(STOWEDVAL);
+34060 FPDEC(RESULT^);
+34070 END;
+34080 GTOTP := RESULT;
+34090 END
+34100 END;
+34110 (**)
+34120 (**)
+34130 (*-01() (*-05()
+34140 FUNCTION GTOTSTR(TEMP: NAKEGER): ASNAKED;
+34150 (*PGETTOTCMN+1*)
+34160 BEGIN WITH TEMP DO WITH NAK DO
+34170 BEGIN
+34180 POINTER := INCPTR(STOWEDVAL, POSITION);
+34190 GTOTSTR := ASNAK;
+34200 END
+34210 END;
+34220 (**)
+34230 (**)
+34240 FUNCTION GTOTRFR(TEMP: NAKEGER): ASNAKED;
+34250 (*PGETTOTCMN+2*)
+34260 BEGIN WITH TEMP DO WITH NAK DO
+34270 BEGIN
+34280 POINTER := INCPTR(STOWEDVAL^.ANCESTOR^.PVALUE, POSITION);
+34290 GTOTRFR := ASNAK;
+34300 END
+34310 END;
+34320 (**)
+34330 (**)
+34340 FUNCTION GTOTMUL(TEMP: NAKEGER): ASNAKED;
+34350 (*PGETTOTCMN+3*)
+34360 BEGIN WITH TEMP DO WITH NAK DO
+34370 BEGIN
+34380 POINTER := INCPTR(STOWEDVAL^.PVALUE, POSITION);
+34390 GTOTMUL := ASNAK;
+34400 END
+34410 END;
+34420 ()-05*) ()-01*)
+34430 (**)
+34440 (**)
+34450 (*-02() BEGIN END ; ()-02*)
+34460 (*+01()
+34470 BEGIN (*OF MAIN PROGRAM*)
+34480 END (*OF EVERYTHING*).
+34490 ()+01*)
--- /dev/null
+34600 #include "rundecs.h"
+34610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+34620 (**)
+34630 (**)
+34640 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+34650 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+34660 (**)
+34670 (**)
+34680 FUNCTION GTOTREF (NAK: NAKED; TEMPLATE: DPOINT): OBJECTP;
+34690 (*PGETTOTAL+4*)
+34700 VAR OFFSPRING: OBJECTP;
+34710 BEGIN
+34720 WITH NAK, STOWEDVAL^ DO
+34730 BEGIN
+34740 CASE SORT OF
+34750 UNDEF:ERRORR(RSEL);
+34760 NILL:ERRORR(RSELNIL);
+34770 REFSL1, REFSLN, REFR, RECR, RECN, REFN:
+34780 END;
+34790 ENEW(OFFSPRING, REFSL1SIZE);
+34800 WITH ANCESTOR^ DO FINC;
+34810 WITH OFFSPRING^ DO
+34820 BEGIN
+34830 (*-02() FIRSTWORD := SORTSHIFT*ORD(REFSL1); ()-02*)
+34840 (*+02() PCOUNT:=0; SORT:=REFSL1; ()+02*)
+34850 (*+01() SECONDWORD := 0; ()+01*)
+34860 ANCESTOR := STOWEDVAL^.ANCESTOR;
+34870 OFFSET := POSITION;
+34880 DBLOCK := TEMPLATE;
+34890 OSCOPE := STOWEDVAL^.OSCOPE
+34900 END;
+34910 IF FTST THEN GARBAGE(STOWEDVAL)
+34920 END; (*WITH*)
+34930 GTOTREF := OFFSPRING
+34940 END;
+34950 (**)
+34960 (**)
+34970 (*-02() BEGIN END ; ()-02*)
+34980 (*+01()
+34990 BEGIN (*OF MAIN PROGRAM*)
+35000 END (*OF EVERYTHING*).
+35010 ()+01*)
--- /dev/null
+35100 #include "rundecs.h"
+35110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+35120 (**)
+35130 (**)
+35140 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+35150 (**)
+35160 (**)
+35170 PROCEDURE GVASSTX(SOURCE: OBJECTP; DEST: UNDRESSP);
+35180 (*PASGVART+6,7,8: ASSIGNS PILE VALUE TO GLOBAL VARIABLE*)
+35190 BEGIN
+35200 FPINC(SOURCE^);
+35210 WITH DEST^ DO
+35220 BEGIN
+35230 FPDEC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+35240 FIRSTPTR := SOURCE;
+35250 END;
+35260 END;
+35270 (**)
+35280 (**)
+35290 (*-02() BEGIN END ; ()-02*)
+35300 (*+01()
+35310 BEGIN (*OF MAIN PROGRAM*)
+35320 END (*OF EVERYTHING*).
+35330 ()+01*)
--- /dev/null
+35400 #include "rundecs.h"
+35410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+35420 (**)
+35430 (**)
+35440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+35450 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+35460 (**)
+35470 (**)
+35480 FUNCTION GLDVAR (LOCRG: DEPTHRANGE; PTR: UNDRESSP; IBPT: IPOINT): OBJECTP;
+35490 (*PLOADVAR+0,1,2*)
+35500 VAR NEWCREFX: OBJECTP;
+35510 CURR: IPOINT;
+35520 BEGIN
+35530 ENEW(NEWCREFX, CREFSIZE);
+35540 WITH NEWCREFX^ DO
+35550 BEGIN
+35560 (*-02() FIRSTWORD := SORTSHIFT * ORD(CREF); ()-02*)
+35570 (*+02() PCOUNT:=0; SORT:=CREF; ()+02*)
+35580 (*+01() SECONDWORD := 0; ()+01*)
+35590 ANCESTOR := NEWCREFX;
+35600 PVALUE := HIGHPCOUNT;
+35610 IPTR := PTR;
+35620 CURR := STATIC(ME);
+35630 SETMYSTATIC(IBPT);
+35640 OSCOPE := SCOPE+LOCRG;
+35650 SETMYSTATIC(CURR)
+35660 END;
+35670 GLDVAR := NEWCREFX;
+35680 END;
+35690 (**)
+35700 (**)
+35710 PROCEDURE GVSCOPE(SOURCE: OBJECTP; LOCRG: DEPTHRANGE; DEST: UNDRESSP; GLOBIB: IPOINT);
+35720 (*PSCOPEVAR+1*)
+35730 VAR CURR: IPOINT;
+35740 BEGIN
+35750 CURR := STATIC(ME);
+35760 SETMYSTATIC(GLOBIB);
+35770 IF SCOPE+LOCRG<SOURCE^.OSCOPE THEN ERRORR(RSCOPE);
+35780 SETMYSTATIC(CURR);
+35790 FPINC(SOURCE^);
+35800 WITH DEST^ DO
+35810 BEGIN
+35820 FPINC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+35830 FIRSTPTR := SOURCE;
+35840 END;
+35850 END;
+35860 (**)
+35870 (**)
+35880 (*-02() BEGIN END ; ()-02*)
+35890 (*+01()
+35900 BEGIN (*OF MAIN PROGRAM*)
+35910 END (*OF EVERYTHING*).
+35920 ()+01*)
--- /dev/null
+36000 #include "rundecs.h"
+36010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+36020 (**)
+36030 (**)
+36040 FUNCTION CRMULT(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP; EXTERN;
+36050 (**)
+36060 (**)
+36070 FUNCTION HEAPMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP;
+36080 (*PLEAPGEN+4*)
+36090 VAR NEWREF: OBJECTP;
+36100 BEGIN
+36110 NEWREF := CRMULT(NEWMULT, TEMPLATE);
+36120 WITH NEWREF^ DO
+36130 BEGIN
+36140 SORT := REFR;
+36150 OSCOPE := 3;
+36160 ANCESTOR := NEWREF; CCOUNT := 1;
+36170 END;
+36180 HEAPMUL := NEWREF;
+36190 END;
+36200 (**)
+36210 (**)
+36220 FUNCTION GENMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
+36230 (*PLEAPGEN+3*)
+36240 VAR NEWREFR: OBJECTP;
+36250 BEGIN
+36260 NEWREFR := HEAPMUL(NEWMULT, TEMPLATE);
+36270 NEWREFR^.OSCOPE := SCOPE+LOCRG;
+36280 GENMUL := NEWREFR;
+36290 END;
+36300 (**)
+36310 (**)
+36320 (*-02() BEGIN END ; ()-02*)
+36330 (*+01()
+36340 BEGIN (*OF MAIN PROGRAM*)
+36350 END (*OF EVERYTHING*).
+36360 ()+01*)
--- /dev/null
+36400 #include "rundecs.h"
+36410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+36420 (**)
+36430 (**)
+36440 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP; EXTERN;
+36450 (**)
+36460 (**)
+36470 FUNCTION HEAPSTR(TEMPLATE: DPOINT): OBJECTP;
+36480 (*PLEAPGEN+1*)
+36490 VAR NEWREF: OBJECTP;
+36500 BEGIN
+36510 IF ORD(TEMPLATE)=SZINT THEN
+36520 BEGIN
+36530 ENEW(NEWREF, REF1SIZE);
+36540 WITH NEWREF^ DO BEGIN
+36550 (*-02() FIRSTWORD := SORTSHIFT * ORD(REF1); ()-02*)
+36560 (*+02() PCOUNT:=0; SORT:=REF1; ()+02*)
+36570 (*+01() SECONDWORD := 0; ()+01*)
+36580 ANCESTOR := NEWREF;
+36590 PVALUE := HIGHPCOUNT;
+36600 OFFSET := REF1SIZE-SZINT;
+36610 VALUE := INTUNDEF
+36620 END
+36630 END
+36640 (*-01()
+36650 ELSE IF ORD(TEMPLATE)=SZLONG THEN
+36660 BEGIN
+36670 ENEW(NEWREF, REF2SIZE);
+36680 WITH NEWREF^ DO BEGIN
+36690 (*-02() FIRSTWORD := SORTSHIFT * ORD(REF2); ()-02*)
+36700 (*+02() PCOUNT:=0; SORT:=REF2; ()+02*)
+36710 ANCESTOR := NEWREF;
+36720 PVALUE := HIGHPCOUNT;
+36730 OFFSET := REF2SIZE-SZINT;
+36740 LONGVALUE := LONGUNDEF
+36750 END
+36760 END
+36770 ()-01*)
+36780 ELSE
+36790 BEGIN
+36800 ENEW(NEWREF, REFNSIZE);
+36810 WITH NEWREF^ DO
+36820 BEGIN
+36830 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFN); ()-02*)
+36840 (*+02() PCOUNT:=0; SORT:=REFN; ()+02*)
+36850 (*+01() SECONDWORD := 0; ()+01*)
+36860 IF ORD(TEMPLATE)=0 THEN PVALUE := UNDEFIN
+36870 ELSE
+36880 BEGIN
+36890 PVALUE := CRSTRUCT(TEMPLATE);
+36900 FPINC(PVALUE^);
+36910 ANCESTOR := NEWREF;
+36920 OFFSET := STRUCTCONST;
+36930 END;
+36940 END
+36950 END;
+36960 NEWREF^.OSCOPE := 3;
+36970 HEAPSTR := NEWREF;
+36980 END;
+36990 (**)
+37000 (**)
+37010 FUNCTION GENSTR(TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
+37020 (*PLEAPGEN*)
+37030 VAR NEWREF: OBJECTP;
+37040 BEGIN
+37050 NEWREF := HEAPSTR(TEMPLATE);
+37060 NEWREF^.OSCOPE := SCOPE+LOCRG;
+37070 GENSTR := NEWREF;
+37080 END;
+37090 (**)
+37100 (**)
+37110 (*-02() BEGIN END ; ()-02*)
+37120 (*+01()
+37130 BEGIN (*OF MAIN PROGRAM*)
+37140 END (*OF EVERYTHING*).
+37150 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exp $HOIST
+
+ pro $HOIST,SZADDR ; used to balance the amount of space on the stack
+ ; for a call to PUT or PRINT. This is done by
+ ; loading an amount of dummy data (-1).
+ ; The parameter is the amount of dummy space needed.
+
+ lxa 0 ; base address of params
+ lol SZADDR ; param, after static link, the difference
+ loc SZADDR+SZWORD ; diff calculated from after param and static link
+ adu SZWORD ; add last two
+ ads SZWORD ; add total to arg base
+ dup SZADDR ; this is the address of 'count'
+ SFL -SZADDR ; save for later use
+ loi SZWORD ; load count
+ lol SZADDR ; load difference
+ adu SZWORD ; new count
+ stl SZADDR+SZWORD ; store in new place, at bottom of dummy data
+1
+ loc -1 ; dummy data to PRINT
+ LFL -SZADDR ; address to place data, initialy where count was
+ dup SZADDR
+ adp -SZWORD ; reduce pointer by SZWORD ready for next time
+ SFL -SZADDR ; re-save
+ sti SZWORD ; place -1 in target address
+ lol SZADDR ; use difference as a loop counter now
+ loc SZWORD
+ sbi SZWORD ; reduce loop counter by SZWORD
+ dup SZWORD ; need one to store and one to test
+ stl SZADDR ; re-save
+ zgt *1 ; do next SZWORD block
+ ret 0
+ end SZADDR
--- /dev/null
+37200 #include "rundecs.h"
+37210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+37220 (**)
+37230 (**)
+37240 FUNCTION RELSUP(REF: OBJECTP): UNDRESSP; EXTERN;
+37250 (**)
+37260 (**)
+37270 FUNCTION IS(LEFT, RIGHT: OBJECTP): INTEGER;
+37280 (*PIDTYREL*)
+37290 BEGIN
+37300 IF RELSUP(LEFT)=RELSUP(RIGHT) THEN
+37310 IS := -1
+37320 ELSE IS := 0
+37330 END;
+37340 (**)
+37350 (**)
+37360 FUNCTION ISNT(LEFT, RIGHT: OBJECTP): INTEGER;
+37370 (*PIDTYREL+1*)
+37380 BEGIN
+37390 IF RELSUP(LEFT)<>RELSUP(RIGHT) THEN
+37400 ISNT := -1
+37410 ELSE ISNT := 0
+37420 END;
+37430 (**)
+37440 (**)
+37450 (*-02() BEGIN END ; ()-02*)
+37460 (*+01()
+37470 BEGIN (*OF MAIN PROGRAM*)
+37480 END (*OF EVERYTHING*).
+37490 ()+01*)
--- /dev/null
+37600 #include "rundecs.h"
+37610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+37620 (**)
+37630 (**)
+37640 (*-01()
+37650 FUNCTION LINIT2(TOO: INTEGER; PTR: NOBYLPP): BOOLEAN ;
+37660 (*PLOOPINIT+1*)
+37670 BEGIN
+37680 FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT := FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT+1;
+37690 WITH PTR^ DO
+37700 BEGIN
+37710 LOOPTYP := 2;
+37720 FROMPART := GETSTKTOP(SZINT, 0);
+37730 TOPART := TOO;
+37740 LINIT2 := TOPART>=FROMPART;
+37750 END;
+37760 END;
+37770 ()-01*)
+37780 (**)
+37790 (**)
+37800 (*-02()
+37810 BEGIN
+37820 END ;
+37830 ()-02*)
+37840 (*+01()
+37850 BEGIN (*OF MAIN PROGRAM*)
+37860 END (*OF EVERYTHING*).
+37870 ()+01*)
--- /dev/null
+37900 #include "rundecs.h"
+37910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+37920 (**)
+37930 (**)
+37940 PROCEDURE LINIT3(BY: INTEGER; PTR: BYLPP) ;
+37950 BEGIN
+37960 FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT := FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT+1;
+37970 WITH PTR^ DO
+37980 BEGIN
+37990 LOOPTYP := 3;
+38000 BYPART := BY;
+38010 FROMPART := GETSTKTOP(SZINT, 0);
+38020 END;
+38030 END;
+38040 (**)
+38050 PROCEDURE LINIT4(FROM: INTEGER; PTR: NOBYLPP) ;
+38060 BEGIN
+38070 FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT := FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT+1;
+38080 WITH PTR^ DO
+38090 BEGIN
+38100 LOOPTYP := 4;
+38110 FROMPART := FROM;
+38120 END;
+38130 END;
+38140 (**)
+38150 (**)
+38160 (*-02()
+38170 BEGIN
+38180 END ;
+38190 ()-02*)
+38200 (*+01()
+38210 BEGIN (*OF MAIN PROGRAM*)
+38220 END (*OF EVERYTHING*).
+38230 ()+01*)
--- /dev/null
+38300 #include "rundecs.h"
+38310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+38320 (**)
+38330 (**)
+38340 FUNCTION LINIT1(TOO: INTEGER; PTR: BYLPP): BOOLEAN ;
+38350 (*PLOOPINIT*)
+38360 BEGIN
+38370 FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT := FIRSTRG.RIBOFFSET^.FIRSTW.LOOPCOUNT +1 ;
+38380 WITH PTR^ DO
+38390 BEGIN
+38400 LOOPTYP := 1;
+38410 BYPART := GETSTKTOP(SZINT, 0);
+38420 FROMPART := GETSTKTOP(SZINT, SZINT);
+38430 TOPART := TOO;
+38440 IF BYPART>0 THEN LINIT1 := TOPART>=FROMPART
+38450 ELSE IF BYPART<0 THEN LINIT1 := TOPART<=FROMPART
+38460 ELSE LINIT1 := TRUE;
+38470 END;
+38480 END;
+38490 (**)
+38500 (**)
+38510 (*-01()
+38520 FUNCTION LOOPINC(PTR: BYLPP): BOOLEAN ;
+38530 BEGIN
+38540 WITH PTR^ DO
+38550 BEGIN
+38560 FROMPART := FROMPART+BYPART;
+38570 IF BYPART>0 THEN LOOPINC := TOPART>=FROMPART
+38580 ELSE IF BYPART<0 THEN LOOPINC := TOPART<=FROMPART
+38590 ELSE LOOPINC := TRUE;
+38600 END;
+38610 END ;
+38620 ()-01*)
+38630 (**)
+38640 (**)
+38650 (*-02()
+38660 BEGIN
+38670 END ;
+38680 ()-02*)
+38690 (*+01()
+38700 BEGIN (*OF MAIN PROGRAM*)
+38710 END (*OF EVERYTHING*).
+38720 ()+01*)
--- /dev/null
+extern double _ln();
+
+double LN(statlink, x)
+ int *statlink; double x;
+ {return(_ln(x));}
--- /dev/null
+EMROOT=../../..
+case `$EMROOT/bin/ack_sys` in
+pdp_v7) ACM=pdp ; BM=0 ;;
+vax_bsd4_1a) ACM=vax4 ;;
+vax_bsd4_2) ACM=vax4 ;;
+vax_sysV_2) ACM=vax4 ;;
+pc_ix) ACM=i86 ; BM=0;;
+sun3) ACM=sun3 ;;
+sun2) ACM=sun2 ;;
+m68_unisoft) ACM=m68k2 ;;
+m68_sysV_0) ACM=mantra ;;
+*) ;;
+esac
+
+MACH=${MACH-$ACM}
+ case $MACH in \
+ pdp) w=2; p=2; NOFLOAT=0; RECIPE='12 13 119'; ASAR=ar ;; \
+ m68k2) w=2; p=4; NOFLOAT=1; RECIPE='12 113 19 43 44'; ASAR=aal ;; \
+ moon3) w=2; p=4; NOFLOAT=1; RECIPE='12 113 19 43 44'; BSD4=-DBSD4; ASAR=aal ;; \
+ m68020|m68000) w=4; p=4; NOFLOAT=1; RECIPE='112 13 119 43 44'; ASAR=aal ;; \
+ sun3) w=4; p=4; NOFLOAT=1; RECIPE='112 13 119 43 44'; BSD4=-DBSD4; ASAR=aal ;; \
+ vax4) w=4; p=4; NOFLOAT=0; RECIPE='112 13 119'; BSD4=-DBSD4; \
+ ASAR=ar; VAX4=-DVAX4; SOFILES='lpb.o'; RANLIB=ranlib; export RANLIB ;; \
+ *) 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 ASAR=$ASAR \
+ VAX4=$VAX4 SOFILES=$SOFILES $*
+
+# sun3) w=4; p=4; NOFLOAT=0; RECIPE='112 13 119'; BSD4=-DBSD4 ;; \
--- /dev/null
+#include <math.h>
+
+double MAXR(staticlink)
+ int *staticlink;
+#ifdef MAXFLOAT
+ { return(MAXFLOAT); }
+#else
+#ifdef HUGE
+ { return(HUGE); }
+#else
+ { return(0.0); /* obviously wrong*/ }
+#endif
+#endif
+
--- /dev/null
+MOD(statlink, b , a)
+ int *statlink ;
+ int a , b ;
+ {
+ int r ;
+ r = a % b ;
+ return( r < 0 ? r + ( b < 0 ? - b : b ) : r ) ;
+ }
--- /dev/null
+61500 #include "rundecs.h"
+61510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+61520 (**)
+61530 (**)
+61540 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+61550 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
+61560 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+61570 (**)
+61580 (**)
+61590 FUNCTION MULCI(CH: CHAR; N: INTEGER): OBJECTP;
+61600 (*PMULCI*)
+61610 VAR POINT: OBJECTP;
+61620 I: INTEGER;
+61630 BEGIN
+61640 POINT := CRSTRING(N);
+61650 WITH POINT^ DO
+61660 FOR I := 1 TO N DO
+61670 CHARVEC[I] := CH;
+61680 MULCI := POINT;
+61690 END;
+61700 (**)
+61710 (**)
+61720 FUNCTION MULSI(S: OBJECTP; N: INTEGER): OBJECTP;
+61730 (*PMULCI-1*)
+61740 VAR POINT: OBJECTP;
+61750 I, J: INTEGER;
+61760 C: CHAR;
+61770 BEGIN
+61780 WITH S^ DO
+61790 BEGIN
+61800 POINT := CRSTRING(STRLENGTH*N);
+61810 FOR I := 0 TO N-1 DO
+61820 FOR J := 1 TO STRLENGTH DO
+61830 BEGIN C := CHARVEC[J]; POINT^.CHARVEC[I*STRLENGTH+J] := C END
+61840 END;
+61850 IF FPTST(S^) THEN GARBAGE(S);
+61860 MULSI := POINT;
+61870 END;
+61880 (**)
+61890 (**)
+61900 FUNCTION MULIC(N: INTEGER; CH: CHAR): OBJECTP;
+61910 (*PMULIC*)
+61920 VAR POINT :OBJECTP;
+61930 I :INTEGER;
+61940 BEGIN
+61950 POINT := CRSTRING(N);
+61960 WITH POINT^ DO
+61970 FOR I := 1 TO N DO
+61980 CHARVEC[I] := CH;
+61990 MULIC := POINT;
+62000 END;
+62010 (**)
+62020 (**)
+62030 FUNCTION MULIS(N: INTEGER; S: OBJECTP): OBJECTP;
+62040 (*PMULIC-1*)
+62050 VAR POINT: OBJECTP;
+62060 I, J: INTEGER;
+62070 C: CHAR;
+62080 BEGIN
+62090 WITH S^ DO
+62100 BEGIN
+62110 POINT := CRSTRING(STRLENGTH*N);
+62120 FOR I := 0 TO N-1 DO
+62130 FOR J := 1 TO STRLENGTH DO
+62140 BEGIN C := CHARVEC[J]; POINT^.CHARVEC[I*STRLENGTH+J] := C END
+62150 END;
+62160 IF FPTST(S^) THEN GARBAGE(S);
+62170 MULIS := POINT;
+62180 END;
+62190 (**)
+62200 (**)
+62210 FUNCTION MULABSI(LEFT: OBJECTP; N: INTEGER): OBJECTP;
+62220 (*PTIMESABS*)
+62230 VAR PIL: OBJECTP;
+62240 BEGIN
+62250 WITH LEFT^ DO
+62260 CASE SORT OF
+62270 REFN:
+62280 BEGIN
+62290 WITH PVALUE^ DO FDEC;
+62300 PVALUE := MULSI(PVALUE, N);
+62310 WITH PVALUE^ DO FINC
+62320 END;
+62330 CREF:
+62340 BEGIN PIL := IPTR^.FIRSTPTR;
+62350 WITH PIL^ DO FDEC;
+62360 PIL := MULSI(PIL, N); IPTR^.FIRSTPTR := PIL;
+62370 WITH PIL^ DO FINC
+62380 END;
+62390 UNDEF: ERRORR(RASSIG);
+62400 NILL: ERRORR(RASSIGNIL);
+62410 END;
+62420 MULABSI := LEFT;
+62430 END;
+62440 (**)
+62450 (**)
+62460 (*-02() BEGIN END ; ()-02*)
+62470 (*+01()
+62480 BEGIN (*OF MAIN PROGRAM*)
+62490 END (*OF EVERYTHING*).
+62500 ()+01*)
--- /dev/null
+40000 #include "rundecs.h"
+40010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+40020 (**)
+40030 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+40040 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+40050 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN;
+40060 PROCEDURE UNDRESSN (COLLECTOR, STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; SOURCEP: OBJECTP); EXTERN ;
+40070 PROCEDURE NASSTCMN(ANOBJECT: OBJECTP); EXTERN;
+40080 (**)
+40090 (**)
+40100 FUNCTION NASSTP(TEMP: NAKEGER; SOURCE: OBJECTP; TEMPLATE: DPOINT): ASNAKED;
+40110 (*+01() EXTERN ; ()+01*)
+40120 (*PASSIGNNT+3*)
+40130 (*-01()
+40140 BEGIN
+40150 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
+40160 BEGIN
+40170 IF FPTWO(PVALUE^) THEN
+40180 NASSTCMN(STOWEDVAL);
+40190 PVALUE^.OSCOPE := 0;
+40200 UNDRESSN(INCPTR(PVALUE, POSITION), INCPTR(SOURCE, STRUCTCONST), TEMPLATE, SOURCE);
+40210 END;
+40220 NASSTP := TEMP.ASNAK;
+40230 END;
+40240 (**)
+40250 (**)
+40260 ()-01*)
+40270 FUNCTION NASSNP(TEMP: NAKEGER; TEMP2: NAKEGER; TEMPLATE: DPOINT): ASNAKED;
+40280 (*PASSIGNNN*)
+40290 VAR DEST: UNDRESSP;
+40300 BEGIN
+40310 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
+40320 BEGIN
+40330 IF FPTWO(PVALUE^) THEN
+40340 NASSTCMN(STOWEDVAL);
+40350 PVALUE^.OSCOPE := 0;
+40360 DEST := INCPTR(PVALUE, POSITION)
+40370 END;
+40380 WITH TEMP2.NAK DO
+40390 UNDRESSN(DEST, POINTER, TEMPLATE, STOWEDVAL);
+40400 NASSNP := TEMP.ASNAK;
+40410 END;
+40420 (**)
+40430 (**)
+40440 FUNCTION SCPNTP(TEMP: NAKEGER; SOURCE: OBJECTP; TEMPLATE: DPOINT): ASNAKED;
+40450 (*PSCOPENT+3*)
+40460 BEGIN
+40470 WITH SOURCE^ DO
+40480 BEGIN
+40490 IF OSCOPE=0 THEN OSCOPE := STRUCTSCOPE(INCPTR(SOURCE, STRUCTCONST), DBLOCK);
+40500 IF TEMP.NAK.STOWEDVAL^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
+40510 END;
+40520 SCPNTP := NASSTP(TEMP, SOURCE, TEMPLATE);
+40530 END;
+40540 (**)
+40550 (**)
+40560 FUNCTION SCPNNP(TEMP: NAKEGER; TEMP2: NAKEGER; TEMPLATE: DPOINT): ASNAKED;
+40570 (*PSCOPENN+0,1*)
+40580 BEGIN
+40590 IF TEMP.NAK.STOWEDVAL^.OSCOPE<STRUCTSCOPE(TEMP2.NAK.POINTER, TEMPLATE) THEN ERRORR(RSCOPE);
+40600 SCPNNP := NASSNP(TEMP, TEMP2, TEMPLATE);
+40610 END;
+40620 (**)
+40630 (**)
+40640 (*-02()
+40650 BEGIN
+40660 END;
+40670 ()-02*)
+40680 (*+01()
+40690 BEGIN (*OF MAIN PROGRAM*)
+40700 END (*OF EVERYTHING*).
+40710 ()+01*)
--- /dev/null
+38900 #include "rundecs.h"
+38910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+38920 (**)
+38930 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+38940 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+38950 PROCEDURE TESTCC(TARGET: OBJECTP); EXTERN ;
+38960 PROCEDURE TESTSS (REFSTRUCT: OBJECTP); EXTERN ;
+38970 (**)
+38980 (**)
+38990 PROCEDURE NASSTCMN(ANOBJECT: OBJECTP);
+39000 BEGIN
+39010 WITH ANOBJECT^ DO
+39020 CASE ANCESTOR^.SORT OF
+39030 REFR, RECR:
+39040 TESTCC(ANOBJECT);
+39050 RECN, REFN:
+39060 TESTSS(ANCESTOR);
+39070 UNDEF:
+39080 ERRORR(RSEL);
+39090 NILL:
+39100 ERRORR(RSELNIL)
+39110 END
+39120 END;
+39130 (**)
+39140 (**)
+39150 (*-01() (*-05()
+39160 FUNCTION NASSTS(TEMP: NAKEGER; SOURCE: A68INT): ASNAKED;
+39170 (*PASSIGNNT*)
+39180 VAR DEST: UNDRESSP;
+39190 BEGIN
+39200 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
+39210 BEGIN
+39220 IF FPTWO(PVALUE^) THEN
+39230 NASSTCMN(STOWEDVAL);
+39240 PVALUE^.OSCOPE := 0;
+39250 DEST := INCPTR(PVALUE, POSITION)
+39260 END;
+39270 DEST^.FIRSTINT := SOURCE;
+39280 NASSTS := TEMP.ASNAK;
+39290 END;
+39300 (**)
+39310 (**)
+39320 FUNCTION NASSTS2(TEMP: NAKEGER; SOURCE: A68LONG): ASNAKED;
+39330 (*PASSIGNNT+1*)
+39340 VAR DEST: UNDRESSP;
+39350 BEGIN
+39360 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
+39370 BEGIN
+39380 IF FPTWO(PVALUE^) THEN
+39390 NASSTCMN(STOWEDVAL);
+39400 PVALUE^.OSCOPE := 0;
+39410 DEST := INCPTR(PVALUE, POSITION)
+39420 END;
+39430 DEST^.FIRSTLONG := SOURCE;
+39440 NASSTS2 := TEMP.ASNAK;
+39450 END;
+39460 ()-05*) ()-01*)
+39470 (**)
+39480 (**)
+39490 FUNCTION NASSTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
+39500 (*+01() EXTERN ; ()+01*)
+39510 (*-01()
+39520 (*PASSIGNNT+2*)
+39530 VAR DEST: UNDRESSP;
+39540 BEGIN
+39550 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
+39560 BEGIN
+39570 IF FPTWO(PVALUE^) THEN
+39580 NASSTCMN(STOWEDVAL);
+39590 PVALUE^.OSCOPE := 0;
+39600 DEST := INCPTR(PVALUE, POSITION)
+39610 END;
+39620 WITH DEST^ DO
+39630 BEGIN
+39640 FPINC(SOURCE^);
+39650 FPDEC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+39660 FIRSTPTR := SOURCE;
+39670 END;
+39680 NASSTPT := TEMP.ASNAK;
+39690 END;
+39700 ()-01*)
+39710 FUNCTION SCPNTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
+39720 (*PSCOPENT+2*)
+39730 BEGIN
+39740 WITH SOURCE^ DO
+39750 BEGIN
+39760 IF TEMP.NAK.STOWEDVAL^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
+39770 END;
+39780 SCPNTPT := NASSTPT(TEMP, SOURCE);
+39790 END;
+39800 (**)
+39810 (**)
+39820 (*-02()
+39830 BEGIN
+39840 END;
+39850 ()-02*)
+39860 (*+01()
+39870 BEGIN (*OF MAIN PROGRAM*)
+39880 END (*OF EVERYTHING*).
+39890 ()+01*)
--- /dev/null
+79200 #include "rundecs.h"
+79210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+79220 (**)
+79230 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+79240 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+79250 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+79260 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+79270 FUNCTION ENSPHYSICALFILE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+79280 (**)
+79290 PROCEDURE CLPASC2(P1,P2: IPOINT; PROC: ASPROC); EXTERN;
+79300 (**)
+79310 (**)
+79320 PROCEDURE ERRORSTATE(F:OBJECTP);
+79330 (*NOT OPENED OR NOMOOD-ABORT*)
+79340 VAR STAT:STATUSSET;
+79350 BEGIN STAT:=F^.PCOVER^.STATUS;
+79360 IF NOT([OPENED]<=STAT) THEN ERRORR(NOTOPEN)
+79370 ELSE IF NOT(([READMOOD]<=STAT) OR ([WRITEMOOD]<=STAT))
+79380 THEN ERRORR(NOMOOD);
+79390 END;
+79400 (**)
+79410 (**)
+79420 PROCEDURE NEWLINE(RF:OBJECTP);
+79430 VAR NSTATUS :STATUSSET; F:OBJECTP;
+79440 BEGIN FPINC(RF^);
+79450 TESTF(RF,F); NSTATUS:=F^.PCOVER^.STATUS;
+79460 IF NOT (([OPENED,READMOOD]<=NSTATUS) OR ([OPENED,WRITEMOOD]<=NSTATUS))
+79470 THEN ERRORSTATE(F);
+79480 IF [PAGEOVERFLOW]<=NSTATUS
+79490 THEN IF NOT ENSPAGE(RF,F) THEN ERRORR(NOLOGICAL);
+79500 (* OPENED,LINEOK,MOODOK *)
+79510 WITH F^ DO
+79520 IF LAZY IN PCOVER^.STATUS THEN WITH PCOVER^ DO
+79530 BEGIN
+79540 STATUS := STATUS+[NOTINITIALIZED,LFE,PAGEOVERFLOW,LINEOVERFLOW];
+79550 LOFCPOS := LOFCPOS+1;
+79560 END
+79570 ELSE
+79580 CLPASC2(ORD(PCOVER), ORD(PCOVER^.BOOK), PCOVER^.DONEWLINE);
+79590 WITH RF^ DO BEGIN FDEC; IF FTST THEN GARBAGE(RF) END
+79600 END; (* NEWLINE *)
+79610 (**)
+79620 (**)
+79630 PROCEDURE NEWPAGE(RF:OBJECTP);
+79640 VAR NSTATUS :STATUSSET; F:OBJECTP;
+79650 BEGIN FPINC(RF^);
+79660 TESTF(RF,F); NSTATUS:=F^.PCOVER^.STATUS;
+79670 IF NOT(([OPENED,READMOOD]<=NSTATUS) OR ([OPENED,WRITEMOOD]<=NSTATUS))
+79680 THEN ERRORSTATE(F);
+79690 IF (([PFE]<=NSTATUS) OR ([LFE]<=NSTATUS))
+79700 THEN IF NOT ENSPHYSICALFILE(RF,F) THEN ERRORR(NOLOGICAL);
+79710 WITH F^ DO
+79720 CLPASC2(ORD(PCOVER), ORD(PCOVER^.BOOK), PCOVER^.DONEWPAGE);
+79730 WITH RF^ DO BEGIN FDEC; IF FTST THEN GARBAGE(RF) END
+79740 END; (* NEWPAGE *)
+79750 (**)
+79760 (**)
+79770 (*-02()
+79780 BEGIN (*OF A68*)
+79790 END; (*OF A68*)
+79800 ()-02*)
+79810 (*+01()
+79820 BEGIN (*OF MAIN PROGRAM*)
+79830 END (* OF EVERYTHING *).
+79840 ()+01*)
--- /dev/null
+79900 #include "rundecs.h"
+79910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+79920 (**)
+79930 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+79940 PROCEDURE NASSTCMN(ANOBJECT:OBJECTP); EXTERN;
+79950 FUNCTION SCPNTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED; EXTERN ;
+79960 (**)
+79970 (**)
+79980 PROCEDURE ONLINEEND(RF, ROUTINE: OBJECTP);
+79990 VAR TEMP: NAKEGER;
+80000 BEGIN
+80010 WITH TEMP, NAK DO
+80020 BEGIN
+80030 (*+11() ASNAK := 0; ()+11*)
+80040 STOWEDVAL := RF;
+80050 POSITION := RF^.OFFSET+LMOFFSET;
+80060 ASNAK := SCPNTPT(TEMP, ROUTINE);
+80070 END;
+80080 IF FPTST(RF^) THEN GARBAGE(RF)
+80090 END;
+80100 (**)
+80110 (**)
+80120 PROCEDURE ONPAGEEND(RF, ROUTINE: OBJECTP);
+80130 VAR TEMP: NAKEGER;
+80140 BEGIN
+80150 WITH TEMP, NAK DO
+80160 BEGIN
+80170 (*+11() ASNAK := 0; ()+11*)
+80180 STOWEDVAL := RF;
+80190 POSITION := RF^.OFFSET+PMOFFSET;
+80200 ASNAK := SCPNTPT(TEMP, ROUTINE);
+80210 END;
+80220 IF FPTST(RF^) THEN GARBAGE(RF)
+80230 END;
+80240 (**)
+80250 (**)
+80260 PROCEDURE ONPHYSICALFILEEND(RF, ROUTINE: OBJECTP);
+80270 VAR TEMP: NAKEGER;
+80280 BEGIN
+80290 WITH TEMP, NAK DO
+80300 BEGIN
+80310 (*+11() ASNAK := 0; ()+11*)
+80320 STOWEDVAL := RF;
+80330 POSITION := RF^.OFFSET+PFMOFFSET;
+80340 ASNAK := SCPNTPT(TEMP, ROUTINE);
+80350 END;
+80360 IF FPTST(RF^) THEN GARBAGE(RF)
+80370 END;
+80380 (**)
+80390 (**)
+80400 PROCEDURE ONLOGICALFILEEND(RF, ROUTINE: OBJECTP);
+80410 VAR TEMP: NAKEGER;
+80420 BEGIN
+80430 WITH TEMP, NAK DO
+80440 BEGIN
+80450 (*+11() ASNAK := 0; ()+11*)
+80460 STOWEDVAL := RF;
+80470 POSITION := RF^.OFFSET+LFMOFFSET;
+80480 ASNAK := SCPNTPT(TEMP, ROUTINE);
+80490 END;
+80500 IF FPTST(RF^) THEN GARBAGE(RF)
+80510 END;
+80520 (**)
+80530 (**)
+80540 PROCEDURE MAKETERM(RF, S: OBJECTP);
+80550 VAR T1 (*+01(), T2 ()+01*): TERMSET;
+80560 CH: CHAR;
+80570 I: INTEGER;
+80580 TEMP: NAKEGER;
+80590 P: UNDRESSP;
+80600 BEGIN T1 := []; (*+01() T2 := []; ()+01*)
+80610 WITH S^ DO
+80620 FOR I := 1 TO STRLENGTH DO
+80630 BEGIN CH := CHARVEC[I];
+80640 (*+01() IF ORD(CH) < 59 THEN T1 := T1 + [CH] ELSE T2 := T2 + [ CHR( ORD(CH)-59 ) ] ()+01*)
+80650 (*-01() T1 := T1 + [CH] ()-01*)
+80660 END;
+80670 (*+11() TEMP.ASNAK := 0; ()+11*)
+80680 TEMP.NAK.STOWEDVAL := RF;
+80690 WITH TEMP, NAK, STOWEDVAL^.ANCESTOR^ DO
+80700 BEGIN
+80710 POSITION := RF^.OFFSET+TERMOFFSET;
+80720 IF FPTWO(PVALUE^) THEN
+80730 NASSTCMN(STOWEDVAL);
+80740 PVALUE^.OSCOPE := 0;
+80750 P := INCPTR(PVALUE, POSITION)
+80760 END;
+80770 P^.FIRSTTERMSET := T1 ;
+80780 (*+01()
+80790 P := INCPTR(P, SZWORD);
+80800 P^.FIRSTTERMSET := T2;
+80810 ()+01*)
+80820 IF FPTST(RF^) THEN GARBAGE(RF)
+80830 END;
+80840 (**)
+80850 (**)
+80860 (*-02()
+80870 BEGIN (*OF A68*)
+80880 END; (*OF A68*)
+80890 ()-02*)
+80900 (*+01()
+80910 BEGIN (*OF MAIN PROGRAM*)
+80920 END (* OF EVERYTHING *).
+80930 ()+01*)
--- /dev/null
+81000 #include "rundecs.h"
+81010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+81020 (**)
+81030 PROCEDURE ACLOSE(EFET: FETROOMP); EXTERN;
+81040 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+81050 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+81060 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+81070 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
+81080 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
+81090 PROCEDURE SETWRITEMOOD(PCOV: OBJECTP); EXTERN;
+81100 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+81110 (*+02()
+81120 PROCEDURE AOPN(FIL: FETROOMP); EXTERN;
+81130 PROCEDURE ACRE(FIL: FETROOMP); EXTERN;
+81140 ()+02*)
+81150 (**)
+81160 (*+01() (*$X6*) ()+01*)
+81170 PROCEDURE OPENCOVER(
+81180 PFET: FETROOMP; VAR PCOV: OBJECTP; LFN: LFNTYPE; PROCEDURE CH (*-01() ( COV: OBJECTP; L: LFNTYPE) ()-01*)
+81190 ); EXTERN;
+81200 (*+01() (*$X4*) ()+01*)
+81210 (**)
+81220 (**)
+81230 FUNCTION FUNC68(PB: ASNAKED; RF: OBJECTP): BOOLEAN; EXTERN;
+81240 (**)
+81250 (**)
+81260 (*+02()
+81270 PROCEDURE AOPEN (FIL:FETROOMP; DIRECTION:INTEGER; LFN:LFNTYPE; BUF:IPOINT);
+81280 VAR NAME: OBJECTP;
+81290 BEGIN
+81300 IF LFN<>NIL THEN (*NIL FOR STANDOUT/STANDIN, DON'T NEED TO OPEN*)
+81310 BEGIN
+81320 IF LFN^.STRLENGTH MOD CHARPERWORD = 0 THEN (*NULL CHAR AT END NEEDED*)
+81330 BEGIN NAME := CRSTRING(LFN^.STRLENGTH+1);
+81340 MOVELEFT(INCPTR(LFN, STRINGCONST), INCPTR(NAME, STRINGCONST), LFN^.STRLENGTH) END
+81350 ELSE NAME := LFN;
+81360 FPINC(NAME^);
+81370 FIL^.FNAME := INCPTR(NAME, STRINGCONST );
+81380 IF DIRECTION=FORWRITE THEN ACRE(FIL) ELSE AOPN(FIL);
+81390 END;
+81400 END;
+81410 ()+02*)
+81420 (*+05()
+81430 PROCEDURE AOPEN( VAR FIL: FYL; DISP:INTEGER; LFN:LFNTYPE; BUF:IPOINT );
+81440 PROCEDURE NAMEFILE(CHARVEC: VECCHARS; SU, SL: INTEGER; VAR FIL: ANYFILE); EXTERN;
+81450 BEGIN
+81460 IF LFN <> NIL THEN
+81470 WITH LFN^ DO NAMEFILE(CHARVEC, STRLENGTH, 1, FIL);
+81480 IF ODD( DISP DIV FORWRITE ) THEN REWRITE( FIL ) ELSE RESET( FIL )
+81490 END ;
+81500 ()+05*)
+81510 (**)
+81520 (**)
+81530 (*+01()
+81540 PROCEDURE SETLIMIT(VAR FYLE: FYL; LIMIT: INTEGER);
+81550 BEGIN LINELIMIT(FYLE, LIMIT) END;
+81560 ()+01*)
+81570 (**)
+81580 (**)
+81590 (*+01() (*$X6*) ()+01*)
+81600 FUNCTION OPEN(RF,IDF:OBJECTP;PROCEDURE CH (*-01() ( COV: OBJECTP; L: LFNTYPE) ()-01*) ): INTEGER;
+81610 VAR I,J,ERRNO: INTEGER;
+81620 LFN:LFNTYPE; PFET:FETROOMP;
+81630 F, PCOV: OBJECTP;
+81640 BEGIN
+81650 F := INCPTR(SAFEACCESS(RF), -STRUCTCONST);
+81660 PCINCR(INCPTR(F, STRUCTCONST), FILEBLOCK, -INCRF);
+81670 (* REMOVE SPACES FROM STRING *)
+81680 (*+01()
+81690 WITH IDF^ DO
+81700 BEGIN FOR I:=1 TO 10 DO
+81710 IF CHARVEC[I]=' '
+81720 THEN LFN[I]:=':' ELSE LFN[I]:=CHARVEC[I];
+81730 IF LFN[8]<>':' THEN
+81740 WRITELN('WARNING-FILE NAME MORE THAN 7 CHARS',LFN);
+81750 END;
+81760 ()+01*)
+81770 (*-01() LFN := IDF; ()-01*)
+81780 NEW(PFET);
+81790 OPENCOVER(PFET, PCOV, LFN, CH);
+81800 F^.PCOVER := PCOV;
+81810 WITH F^ DO
+81820 BEGIN
+81830 LOGICALFILEMENDED:=UNDEFIN;
+81840 PHYSICALFILEMENDED:=UNDEFIN;
+81850 PAGEMENDED:=UNDEFIN;
+81860 LINEMENDED:=UNDEFIN;
+81870 TERM:=[];
+81880 (*+01() TERM1:=[] ; ()+01*)
+81890 OPEN := ORD(NOT(OPENED IN PCOVER^.STATUS));
+81900 END;
+81910 IF FPTST(RF^) THEN GARBAGE(RF);
+81920 END; (*OPEN*)
+81930 (**)
+81940 (**)
+81950 (*+01() (*$X6*) ()+01*)
+81960 FUNCTION ESTABLISH(
+81970 RF,IDF:OBJECTP;PROCEDURE CH (*-01() (COV: OBJECTP; L: LFNTYPE) ()-01*); MP,ML,MC:INTEGER
+81980 ): INTEGER;
+81990 VAR F:OBJECTP;
+82000 BEGIN
+82010 IF (MP<1) OR (ML<1) OR (MC<1) THEN ERRORR(POSMIN);
+82020 ESTABLISH := OPEN(RF,IDF,CH);
+82030 TESTF(RF,F);
+82040 WITH F^.PCOVER^ DO
+82050 BEGIN
+82060 IF NOT([PUTPOSS]<=POSSIBLES) THEN ERRORR(NOWRITE);
+82070 IF NOT([ESTABPOSS]<=POSSIBLES) THEN ERRORR(NOESTAB);
+82080 IF [GETPOSS]<=POSSIBLES THEN
+82090 SETWRITEMOOD(F^.PCOVER);
+82100 CHARBOUND:=MC; LINEBOUND:=ML; PAGEBOUND:=MP;
+82110 (*+01() SETLIMIT(BOOK, ML*MP); ()+01*)
+82120 END
+82130 END; (*ESTABLISH*)
+82140 (*+01() (*$X4*) ()+01*)
+82150 (**)
+82160 (**)
+82170 PROCEDURE CLOSE(RF:OBJECTP);
+82180 VAR F:OBJECTP;
+82190 PFET: FETROOMP;
+82200 BEGIN TESTF(RF,F);
+82210 WITH F^.PCOVER^ DO
+82220 BEGIN STATUS:=STATUS-[OPENED];
+82230 IF NOT ASSOC THEN
+82240 BEGIN
+82250 ACLOSE(BOOK);
+82260 IF NOT(STARTUP IN STATUS) THEN BEGIN PFET := BOOK; DISPOSE(PFET) END;
+82270 END;
+82280 END;
+82290 IF FPTST(RF^) THEN GARBAGE(RF);
+82300 END; (*CLOSE*)
+82310 (**)
+82320 (**)
+82330 (*+24()
+82340 PROCEDURE PNTSTAT(COV:OBJECTP);
+82350 BEGIN WITH COV^ DO
+82360 BEGIN WRITE('STATUS-');
+82370 IF [OPENED]<=STATUS THEN WRITE('OPENED ');
+82380 IF [LINEOVERFLOW]<=STATUS THEN WRITE('LINEOFLO ');
+82390 IF [PAGEOVERFLOW]<=STATUS THEN WRITE('PAGEOFLO ');
+82400 IF [PFE]<=STATUS THEN WRITE('PFE ');
+82410 IF [LFE]<=STATUS THEN WRITE('LFE ');
+82420 IF [READMOOD]<=STATUS THEN WRITE('READMOOD ');
+82430 IF [WRITEMOOD]<=STATUS THEN WRITE('WRITEMOOD ');
+82440 IF [CHARMOOD]<=STATUS THEN WRITE('CHARMOOD ');
+82450 IF [BINMOOD]<=STATUS THEN WRITE('BINMOOD ');
+82460 IF [NOTSET]<=STATUS THEN WRITE('NOTSET ');
+82470 END;
+82480 WRITELN;
+82490 END;
+82500 (**)
+82510 (**)
+82520 PROCEDURE PNTPOSS(F:OBJECTP);
+82530 BEGIN WRITE('POSSIBLES - ');
+82540 WITH F^.PCOVER^ DO
+82550 BEGIN IF [RESETPOSS]<=POSSIBLES THEN WRITE('RESETPOSS ');
+82560 IF [SETPOSS]<=POSSIBLES THEN WRITE('SETPOSS ');
+82570 IF [GETPOSS]<=POSSIBLES THEN WRITE('GETPOSS ');
+82580 IF [PUTPOSS]<=POSSIBLES THEN WRITE('PUTPOSS ');
+82590 IF [BINPOSS]<=POSSIBLES THEN WRITE('BINPOSS ');
+82600 IF [ESTABPOSS]<=POSSIBLES THEN WRITE('ESTABPOSS ');
+82610 IF [ASSPOSS]<=POSSIBLES THEN WRITE('ASSPOSS');
+82620 END;
+82630 WRITELN;
+82640 END;
+82650 ()+24*)
+82660 (**)
+82670 (**)
+82680 (*-02()
+82690 BEGIN (*OF A68*)
+82700 END; (*OF A68*)
+82710 ()-02*)
+82720 (*+01()
+82730 BEGIN (*OF MAIN PROGRAM*)
+82740 END (* OF EVERYTHING *).
+82750 ()+01*)
--- /dev/null
+40800 #include "rundecs.h"
+40810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+40820 (**)
+40830 (**)
+40840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+40850 (**)
+40860 (**)
+40870 (*+01() (*$X3*) ()+01*)
+40880 FUNCTION PCCMN(NEWMULT: OBJECTP; TEMPLATE: DPOINT; ELSIZE: INTEGER): ASNAKED;
+40890 VAR TEMP: NAKEGER;
+40900 DESCDEX: INTEGER;
+40910 NEWELS: OBJECTP;
+40920 BEGIN WITH NEWMULT^, TEMP DO WITH NAK DO
+40930 BEGIN
+40940 MDBLOCK := TEMPLATE;
+40950 ENEW(NEWELS, ELSCONST+ELSIZE);
+40960 PVALUE := NEWELS;
+40970 WITH PVALUE^ DO
+40980 BEGIN IHEAD := NIL ;
+40990 (*-02() FIRSTWORD := SORTSHIFT * ORD(IELS); PCOUNT := 1; ()-02*)
+41000 (*+02() PCOUNT:=1; SORT:=IELS; ()+02*)
+41010 OSCOPE := 0; DBLOCK := TEMPLATE; D0 := ELSIZE; CCOUNT := 1 END;
+41020 IHEAD := NIL; FPTR := NIL; BPTR := NIL;
+41030 (*+11() ASNAK := 0; ()+11*)
+41040 STOWEDVAL := NEWMULT; POINTER := INCPTR(PVALUE, ELSCONST);
+41050 PCCMN := ASNAK;
+41060 END
+41070 END;
+41080 (**)
+41090 (**)
+41100 FUNCTION PCOLLR(NOROWS: INTEGER; TEMPLATE: DPOINT): ASNAKED;
+41110 (*PPREPROWDISP*)
+41120 VAR NEWMULT: OBJECTP;
+41130 DESCDEX: INTEGER; ELSIZE, SUM: BOUNDSRANGE;
+41140 BEGIN
+41150 IF ORD(TEMPLATE)=0 THEN ELSIZE := 1 (*DRESSED*)
+41160 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN ELSIZE := ORD(TEMPLATE) (*UNDRESSED*)
+41170 ELSE ELSIZE := TEMPLATE^[0];
+41180 ENEW(NEWMULT, MULTCONST+NOROWS*SZPDS);
+41190 SUM := -ELSCONST;
+41200 WITH NEWMULT^ DO
+41210 BEGIN
+41220 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
+41230 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
+41240 (*+01() SECONDWORD := 0; ()+01*)
+41250 SIZE := ELSIZE;
+41260 FOR DESCDEX := 0 TO NOROWS-1 DO WITH DESCVEC[DESCDEX] DO
+41270 BEGIN
+41280 UI := GETSTKTOP(SZINT, DESCDEX*SZINT); LI := 1; DI := ELSIZE;
+41290 SUM := SUM+ELSIZE; ELSIZE := UI*ELSIZE
+41300 END;
+41310 LBADJ := SUM;
+41320 ROWS := NOROWS-1;
+41330 END;
+41340 PCOLLR := PCCMN(NEWMULT, TEMPLATE, ELSIZE);
+41350 (*THIS WILL NOT WORK THUS ON 16-BITS*)
+41360 END;
+41370 (**)
+41380 (**)
+41390 FUNCTION PCOLLRM(NOROWS: INTEGER; TEMPLATE: DPOINT): ASNAKED;
+41400 (*PPREPROWDISP+1*)
+41410 VAR OLDMULT, NEWMULT: OBJECTP;
+41420 DESCDEX, FIRSTROW: INTEGER; ELSIZE, SUM: BOUNDSRANGE;
+41430 BEGIN
+41440 OLDMULT := ASPTR(GETSTKTOP(SZADDR, NOROWS*SZINT));
+41450 WITH OLDMULT^ DO
+41460 BEGIN ELSIZE := SIZE;
+41470 ENEW(NEWMULT, MULTCONST+(NOROWS+ROWS+1)*SZPDS);
+41480 SUM := -ELSCONST;
+41490 (*-02() NEWMULT^.FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
+41500 (*+02() NEWMULT^.PCOUNT:=0; NEWMULT^.SORT:=MULT; ()+02*)
+41510 (*+01() NEWMULT^.SECONDWORD := 0; ()+01*)
+41520 NEWMULT^.SIZE := ELSIZE;
+41530 FOR DESCDEX := 0 TO ROWS DO WITH DESCVEC[DESCDEX] DO
+41540 BEGIN
+41550 NEWMULT^.DESCVEC[DESCDEX] := DESCVEC[DESCDEX];
+41560 NEWMULT^.DESCVEC[DESCDEX].DI := ELSIZE;
+41570 SUM := SUM+LI*ELSIZE; ELSIZE := (UI-LI+1)*ELSIZE;
+41580 IF ELSIZE<0 THEN ELSIZE := 0
+41590 END
+41600 END;
+41610 FIRSTROW := OLDMULT^.ROWS+1;
+41620 WITH NEWMULT^ DO
+41630 BEGIN
+41640 FOR DESCDEX := FIRSTROW TO FIRSTROW+NOROWS-1 DO WITH DESCVEC[DESCDEX] DO
+41650 BEGIN
+41660 UI := GETSTKTOP(SZINT, (DESCDEX-FIRSTROW)*SZINT); LI := 1; DI := ELSIZE;
+41670 SUM := SUM+ELSIZE; ELSIZE := UI*ELSIZE
+41680 END;
+41690 LBADJ := SUM;
+41700 ROWS := FIRSTROW+NOROWS-1;
+41710 END;
+41720 PCOLLRM := PCCMN(NEWMULT, TEMPLATE, ELSIZE);
+41730 END;
+41740 (*+01() (*$X4*) ()+01*)
+41750 (**)
+41760 (**)
+41770 FUNCTION PCOLLCK(TEMP: NAKEGER; DEPTH, COUNT: INTEGER): ASNAKED;
+41780 (*PCOLLCHECK*)
+41790 BEGIN
+41800 WITH TEMP.NAK.STOWEDVAL^ DO WITH DESCVEC[ROWS-DEPTH] DO
+41810 IF (LI<>1) OR (UI<>COUNT) THEN ERRORR(RMULASS);
+41820 PCOLLCK := TEMP.ASNAK;
+41830 END;
+41840 (**)
+41850 (**)
+41860 (*-02() BEGIN END ; ()-02*)
+41870 (*+01()
+41880 BEGIN (*OF MAIN PROGRAM*)
+41890 END (*OF EVERYTHING*).
+41900 ()+01*)
--- /dev/null
+42000 #include "rundecs.h"
+42010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+42020 (**)
+42030 (**)
+42040 FUNCTION PCOLLST(TEMPLATE: DPOINT): ASNAKED;
+42050 (*PPREPSTRDISP*)
+42060 VAR TEMP: NAKEGER;
+42070 STRUCTSIZE: INTEGER;
+42080 NEWSTRUCT: OBJECTP;
+42090 BEGIN WITH TEMP.NAK DO
+42100 BEGIN
+42110 STRUCTSIZE := TEMPLATE^[0]+STRUCTCONST;
+42120 (*+11() TEMP.ASNAK := 0; ()+11*)
+42130 ENEW(NEWSTRUCT, STRUCTSIZE); POINTER := INCPTR(NEWSTRUCT, STRUCTCONST);
+42140 STOWEDVAL := NEWSTRUCT;
+42150 WITH NEWSTRUCT^ DO
+42160 BEGIN
+42170 (*-02() FIRSTWORD := SORTSHIFT * ORD(STRUCT); ()-02*)
+42180 (*+02() PCOUNT:=0; SORT:=STRUCT; ()+02*)
+42190 LENGTH := STRUCTSIZE; DBLOCK := TEMPLATE
+42200 END;
+42210 END;
+42220 PCOLLST := TEMP.ASNAK;
+42230 END;
+42240 (*-05()
+42250 FUNCTION NAKPTR(NAK: NAKED): OBJECTP;
+42260 (*PNAKEDPTR*)
+42270 VAR TEMP: NAKEGER;
+42280 BEGIN NAKPTR := NAK.STOWEDVAL END;
+42290 ()-05*)
+42300 (**)
+42310 (**)
+42320 (*-02() BEGIN END ; ()-02*)
+42330 (*+01()
+42340 BEGIN (*OF MAIN PROGRAM*)
+42350 END (*OF EVERYTHING*).
+42360 ()+01*)
--- /dev/null
+82800 #include "rundecs.h"
+82810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+82820 (**)
+82830 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+82840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+82850 (*+01() (*$X4*) ()+01*)
+82860 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+82870 (**)
+82880 (*******POSITION ENQUIRIES*******)
+82890 (**)
+82900 FUNCTION CHARNUMBER(RF:OBJECTP): INTEGER;
+82910 VAR F:OBJECTP;
+82920 BEGIN TESTF(RF,F);
+82930 WITH F^.PCOVER^ DO
+82940 IF [OPENED]<=STATUS THEN CHARNUMBER := COFCPOS
+82950 ELSE ERRORR(NOTOPEN);
+82960 IF FPTST(RF^) THEN GARBAGE(RF);
+82970 END;
+82980 (**)
+82990 (**)
+83000 FUNCTION LINENUMBER(RF:OBJECTP): INTEGER;
+83010 VAR F:OBJECTP;
+83020 BEGIN TESTF(RF,F);
+83030 WITH F^.PCOVER^ DO
+83040 IF [OPENED]<=STATUS THEN LINENUMBER := LOFCPOS
+83050 ELSE ERRORR(NOTOPEN);
+83060 IF FPTST(RF^) THEN GARBAGE(RF);
+83070 END;
+83080 (**)
+83090 (**)
+83100 FUNCTION PAGENUMBER(RF:OBJECTP): INTEGER;
+83110 VAR F:OBJECTP;
+83120 BEGIN TESTF(RF,F);
+83130 WITH F^.PCOVER^ DO
+83140 IF [OPENED]<=STATUS THEN PAGENUMBER := POFCPOS
+83150 ELSE ERRORR(NOTOPEN);
+83160 IF FPTST(RF^) THEN GARBAGE(RF);
+83170 END;
+83180 (**)
+83190 (*-02()
+83200 BEGIN (*OF A68*)
+83210 END; (*OF A68*)
+83220 ()-02*)
+83230 (*+01()
+83240 BEGIN (*OF MAIN PROGRAM*)
+83250 END (* OF EVERYTHING *).
+83260 ()+01*)
--- /dev/null
+POWI(statlink, pow , num)
+ int *statlink ;
+ int pow , num ;
+ {
+ if ( pow < 0 )
+ POWNEG() ;
+ else
+ {
+ int n , p , r ;
+ n = num ; p = pow ;
+ if ( ( p & 1 ) != 0 ) { r = n; } else { r = 1; }
+ p >>= 1 ;
+ while ( p != 0 ) {
+ n *= n ;
+ if ( ( p & 1 ) != 0 ) r *= n ;
+ p >>= 1 ;
+ }
+ return( r ) ;
+ }
+ }
--- /dev/null
+62600 #include "rundecs.h"
+62610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+62620 (**)
+62630 (**)
+62640 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+62650 (**)
+62660 (**)
+62670 PROCEDURE POWNEG;
+62680 (*CALLED FROM POWE WHEN RAISING INTEGER TO A -VE POWER*)
+62690 BEGIN ERRORR(RPOWNEG) END;
+62700 (**)
+62710 (**)
+62720 (*-02() BEGIN END ; ()-02*)
+62730 (*+01()
+62740 BEGIN (*OF MAIN PROGRAM*)
+62750 END (*OF EVERYTHING*).
+62760 ()+01*)
--- /dev/null
+double POWR(statlink, pow, num)
+ int *statlink ;
+ int pow ;
+ double num ;
+ {
+ int p ;
+ register double n, r;
+ if (pow < 0) {
+ p = -pow;
+ n = 1.0/num;
+ } else {
+ p = pow;
+ n = num;
+ }
+ if ( (p & 1) != 0 ) { r = n; } else { r = 1.0; }
+ p >>= 1;
+ while ( p != 0 ) {
+ n *= n;
+ if ( (p & 1) != 0 ) r *= n;
+ p >>= 1;
+ }
+ return(r) ;
+ }
--- /dev/null
+#include "e.h"
+ exa _1PUTT ; 1st label in PUTT (run68d)
+ exp $PUT
+ exp $PRINT
+ exp $WRITE
+ exp $PUTT
+ exp $NXTBIT
+ exp $STANDOUT
+
+ ina jumpdesc
+jumpdesc
+ con 0I SZADDR,0I SZADDR,0I SZADDR ; enough space for 3 pointers
+
+ pro $PUT,PUTTVARSPACE
+ mes 11
+ loc PUTSTAMP
+ stl -SZWORD ; set up frame stamp
+ lxa 0 ; load argument base
+ lol SZADDR+SZADDR ; load length of data lost, skip static link & space
+ loc SZADDR+SZADDR+SZWORD
+ adu SZWORD ; add on space for static link & file pointer & count
+ ads SZWORD ; add argument base and offset
+ loi SZADDR ; load file address, objectp
+ SFL SZADDR ; store in space, left for this reason
+ lor 1 ; fill in jump info with SP
+ SFE jumpdesc+SZADDR
+ lxl 0 ; and LB
+ SFE jumpdesc+SZADDR+SZADDR
+ LFE _1PUTT-ENTRYOFFSET ; and code entry point
+ SFE jumpdesc
+ gto jumpdesc ; jump to PUTT, in run68d
+ end PUTTVARSPACE
+
+ pro $PRINT,PUTTVARSPACE
+ mes 11
+ loc PUTSTAMP
+ stl -SZWORD ; set up frame stamp
+ LFE .HTOP-STOUTOFFSET; address of stout in global frame
+ SFL SZADDR ; store in first param after static link
+ lor 1 ; fill in jump info with SP
+ SFE jumpdesc+SZADDR
+ lxl 0 ; and LB
+ SFE jumpdesc+SZADDR+SZADDR
+ LFE _1PUTT-ENTRYOFFSET ; and code entry point
+ SFE jumpdesc
+ gto jumpdesc ; jump to PUTT, in run68d
+ end PUTTVARSPACE
+
+ pro $WRITE,PUTTVARSPACE
+ mes 11
+ loc PUTSTAMP
+ stl -SZWORD ; set up frame stamp
+ LFE .HTOP-STOUTOFFSET; address of stout in global frame
+ SFL SZADDR ; store in first param after static link
+ lor 1 ; fill in jump info with SP
+ SFE jumpdesc+SZADDR
+ lxl 0 ; and LB
+ SFE jumpdesc+SZADDR+SZADDR
+ LFE _1PUTT-ENTRYOFFSET ; and code entry point
+ SFE jumpdesc
+ gto jumpdesc ; jump to PUTT, in run68d
+ end PUTTVARSPACE
+
+ pro $NXTBIT,SZWORD ; FUNCTION(VAR N: INTEGER): INTEGER;
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR ; address of N
+ loi SZWORD
+ dup SZWORD
+ loc 1
+ slu SZWORD ; shift left
+ LFL SZADDR
+ sti SZWORD ; replace shifted N
+ tlt ; test original N
+ ret SZWORD ; return old top bit of N
+ end SZWORD
+
+ pro $STANDOUT,SZWORD ; call to stoutch (run68d)
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR+SZADDR ; param 1, pcov
+ LFL SZADDR ; param 2, lfn
+ LFL 0 ; static link
+ cal $STOUTCH
+ asp SZADDR+SZADDR+SZADDR
+ ret 0
+ end SZWORD
+
--- /dev/null
+83300 #include "rundecs.h"
+83310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+83320 (**)
+83330 PROCEDURE CL68(PB: ASNAKED; RF: OBJECTP); EXTERN ;
+83340 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+83350 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN ;
+83360 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN ;
+83370 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+83380 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN ;
+83390 FUNCTION GETPROC(RN: OBJECTP): ASNAKED; EXTERN ;
+83400 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+83410 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+83420 PROCEDURE ENSSTATE(RF:OBJECTP;VAR F:OBJECTP;READING:STATUSSET); EXTERN;
+83430 FUNCTION ENSPAGE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+83440 (**)
+83450 PROCEDURE CLPASC1(P1: IPOINT; PROC: ASPROC); EXTERN;
+83460 PROCEDURE CLPASC5(P1,P2 :IPOINT; P3,P4 :INTEGER; P5 :IPOINT; PROC: ASPROC); EXTERN;
+83470 FUNCTION NXTBIT(VAR N: INTEGER): INTEGER; EXTERN;
+83480 (**)
+83490 (**)
+83500 (*+01() (*$X6*) ()+01*) (*ONLY USED WITH PROC*)
+83510 (*+01() FUNCTION TIMESTEN(T, E: INTEGER): REAL ; EXTERN ; ()+01*)
+83520 (*+05() FUNCTION TIMESTEN( T: REAL; E: INTEGER ): REAL ; EXTERN ; ()+05*)
+83530 (*+01() (*$X4*) ()+01*)
+83540 (**)
+83550 (**)
+83560 FUNCTION SUBFIXED(SIGN, (*0 OR 1 OR -1 FOR SPACE TO BE PROVIDED FOR SIGN*)
+83570 BEFORE, (*DIGITS (POSSIBLY SUPPRESSED) REQUIRED BEFORE DECIMAL POINT;
+83580 -VE MEANS AS MANY AS NECESSARY*)
+83590 POINT, (*0 OR 1 FOR SPACE TO BE PROVIDED FOR DECIMAL POINT*)
+83600 AFTER (*DIGITS AFTER DECIMAL POINT*)
+83610 : INTEGER;
+83620 VAR EXP: INTEGER; (*TO RECEIVE DECIMAL EXPONENT IF EXPNEEDED*)
+83630 EXPNEEDED: BOOLEAN;
+83640 X: REALTEGER;
+83650 R: BOOLEAN; (*TRUE IF X IS REALLY .REAL*)
+83660 VAR S: OBJECTP; (*NIL IF A NEW STRING IS TO BE CREATED;
+83670 OTHERWISE, A STRING WHOSE CHARVEC IS TO RECEIVE THE RESULT
+83680 (AND WHICH MUST BE LONG ENOUGH)*)
+83690 START: INTEGER (*FIRST INDEX OF S TO BE USED*)
+83700 ): BOOLEAN;
+83710 LABEL 999;
+83720 CONST POWOF2 = (*+01() 2000000000000000000B; (* 2^55 = 36028797018963968.0 *) ()+01*)
+83730 (*TWO TO THE POWER (NO. OF DIGITS IN MANTISSA)+7*)
+83740 (*+02() 1.0; ()+02*)
+83750 (*+05() 1.0; ()+05*)
+83760 POWOF2OVER10 = (*+01() 146314631463146315B; (* ROUND( 2^55 / 10 ) = 3602879701896397.0 *) ()+01*)
+83770 (*CAREFULLY ROUNDED UP*)
+83780 (*+02() 0.1; ()+02*)
+83790 (*+05() 0.1; ()+05*)
+83800 (*+44() TYPE MINT = INTEGER; ()+44*)
+83810 VAR L, M, BLANKS, PT, FIRSTDIG, INDEX: INTEGER;
+83820 A, B, ROUNDD: MINT;
+83830 PROCEDURE CONVR(Y(*>=0.0*): REAL; VAR L: INTEGER; VAR A: MINT);
+83840 (*COMPUTES L = THE LARGEST NUMBER OF DIGITS BEFORE THE DECIMAL POINT (POSSIBLY NEGATIVE) WHICH MIGHT BE NEEDED;
+83850 A = (Y*POWOF2)/10**L (ROUNDED TO NEAREST INTEGER?) *)
+83860 (*+01() EXTERN; ()+01*)
+83870 (*+05()
+83880 CONST LOG10E = 0.43429; (*DELIBERATELY UNDERESTIMATED*)
+83890 VAR LL: REAL;
+83900 BEGIN
+83910 LL :=LN(Y)*LOG10E;
+83920 IF LL>0.0 THEN L := 1+TRUNC(LL)
+83930 ELSE L := TRUNC(LL);
+83940 A := TIMESTEN(Y (* *POWOF2 *), -L);
+83950 IF A >= 1.0 THEN
+83960 BEGIN L := L+1; A := TIMESTEN(Y (* *POWOF2 *), -L) END;
+83970 END ;
+83980 ()+05*)
+83990 (*+02()
+84000 CONST LOG10E = 0.43429; (*DELIBERATELY UNDERESTIMATED*)
+84010 VAR LL: REAL;
+84020 BEGIN
+84030 LL :=LN(Y)*LOG10E;
+84040 IF LL>0.0 THEN L := 1+TRUNC(LL)
+84050 ELSE L := TRUNC(LL);
+84060 A := (*-44() TIMESTE(Y (* *POWOF2 *), -L) ()-44*) (*+44() L ()+44*);
+84070 IF A >= 1.0 THEN
+84080 BEGIN L := L+1; A := (*-44() TIMESTE(Y (* *POWOF2 *), -L) ()-44*) (*+44() L ()+44*) END;
+84090 END ;
+84100 ()+02*)
+84110 PROCEDURE CONVI(Y(*>=0*): INTEGER; VAR L: INTEGER; VAR A: MINT);
+84120 (*AS CONVR, BUT FOR INTEGERS*)
+84130 (*+01() EXTERN; ()+01*)
+84140 (*+05()
+84150 VAR I: INTEGER ; YY: INTEGER ;
+84160 BEGIN
+84170 YY := Y ;
+84180 L := 0 ;
+84190 WHILE YY >= 1 DO
+84200 BEGIN L := L + 1 ; YY := YY DIV 10 END ;
+84210 A := TIMESTEN(Y (* *POWOF2 *), -L)
+84220 END ;
+84230 ()+05*)
+84240 (*+02()
+84250 VAR I: INTEGER ; YY: INTEGER ;
+84260 BEGIN
+84270 YY := Y ;
+84280 L := 0 ;
+84290 WHILE YY >= 1 DO
+84300 BEGIN L := L + 1 ; YY := YY DIV 10 END ;
+84310 (*-44() A := TIMESTE(Y (* *POWOF2 *), -L) ()-44*)
+84320 (*+44() A := Y; ()+44*)
+84330 END ;
+84340 ()+02*)
+84350 (*-44()
+84360 PROCEDURE ROUNDER(DIGITS: INTEGER; VAR ROUNDD: MINT);
+84370 (* COMPUTES ROUNDD = 0.5 X ( 10 TO THE POWER OF - DIGITS ) X POWOF2 *)
+84380 (*+01() EXTERN; ()+01*)
+84390 (*+05()
+84400 VAR I : INTEGER ;
+84410 BEGIN
+84420 IF DIGITS < 0 THEN DIGITS := 0 ELSE IF DIGITS > REALWIDTH THEN DIGITS := REALWIDTH ;
+84430 ROUNDD := 1 ;
+84440 FOR I := 1 TO DIGITS DO
+84450 ROUNDD := ROUNDD / 10 ;
+84460 (* ROUNDD = 10 TO THE POWER OF - DIGITS *)
+84470 ROUNDD := 0.5 * ROUNDD (* *POWOF2 *);
+84480 END ;
+84490 ()+05*)
+84500 (*+02()
+84510 VAR I : INTEGER ;
+84520 BEGIN
+84530 IF DIGITS < 0 THEN DIGITS := 0 ELSE IF DIGITS > REALWIDTH THEN DIGITS := REALWIDTH ;
+84540 ROUNDD := 1 ;
+84550 FOR I := 1 TO DIGITS DO
+84560 ROUNDD := ROUNDD / 10 ;
+84570 (* ROUNDD = 10 TO THE POWER OF - DIGITS *)
+84580 ROUNDD := 0.5 * ROUNDD (* *POWOF2 *);
+84590 END ;
+84600 ()+02*)
+84610 ()-44*)
+84620 BEGIN (* OF SUBFIXED *)
+84630 WITH X DO
+84640 BEGIN
+84650 IF R THEN IF REA <> 0.0 THEN CONVR(ABS(REA), L, A) ELSE CONVI(ABS(INT), L, A)
+84660 ELSE CONVI(ABS(INT), L, A);
+84670 (*-44()
+84680 IF EXPNEEDED THEN
+84690 IF REA<>0.0 THEN
+84700 BEGIN
+84710 ROUNDER(BEFORE+AFTER, ROUNDD);
+84720 B := A; A := A*10;
+84730 IF A+ROUNDD<POWOF2 THEN
+84740 BEGIN B := A; L := L-1 END;
+84750 A := B+ROUNDD;
+84760 EXP := L-BEFORE; L := BEFORE
+84770 END
+84780 ELSE
+84790 BEGIN A := 0; EXP := 0 END
+84800 ELSE
+84810 BEGIN
+84820 ROUNDER(L+AFTER, ROUNDD);
+84830 A := A+ROUNDD (*+01()+ORD(ROUNDD=0)()+01*);
+84840 IF A<POWOF2OVER10 THEN
+84850 BEGIN A := A*10; L := L-1 END
+84860 END
+84870 ()-44*)
+84880 END ;
+84890 IF L>0 THEN
+84900 BEGIN IF BEFORE<0 THEN BEFORE := L; M := L END
+84910 ELSE
+84920 IF BEFORE<=0 THEN BEGIN BEFORE := ORD(POINT=0); M := BEFORE END ELSE M := 1;
+84930 IF (L>BEFORE) OR (AFTER<0) THEN BEGIN SUBFIXED := FALSE; GOTO 999 END;
+84940 IF S=NIL THEN S := CRSTRING(SIGN+BEFORE+POINT+AFTER);
+84950 BLANKS := START-1+BEFORE-M+ORD(SIGN<0);
+84960 WITH S^ DO
+84970 BEGIN
+84980 FOR INDEX := START TO BLANKS DO
+84990 CHARVEC[INDEX] := ' ';
+85000 IF SIGN=1 THEN
+85010 BEGIN BLANKS := BLANKS+SIGN;
+85020 IF (*-44() ( R AND ( X.REA < 0.0 ) ) OR ()-44*)
+85030 ( NOT R AND ( X.INT < 0 ) ) THEN
+85040 CHARVEC[BLANKS] := '-' ELSE CHARVEC[BLANKS] := '+'
+85050 END;
+85060 PT := BLANKS+M+1; FIRSTDIG := START+BEFORE+SIGN-L+ORD(L<0);
+85070 (*-44()
+85080 FOR INDEX := BLANKS+1 TO BLANKS+M+POINT+AFTER DO
+85090 IF INDEX=PT THEN CHARVEC[INDEX] := '.'
+85100 ELSE IF INDEX<FIRSTDIG THEN CHARVEC[INDEX] := '0'
+85110 ELSE
+85120 BEGIN
+85130 A := A*10;
+85140 (*+01()
+85150 CHARVEC[INDEX] := CHR( ORD( '0' ) + A DIV POWOF2 ) ;
+85160 A := A MOD POWOF2
+85170 ()+01*)
+85180 (*-01()
+85190 L := TRUNC( A (* / POWOF2 *));
+85200 CHARVEC[INDEX] := CHR( ORD( '0' ) + L );
+85210 A := A - L (* *POWOF2 *);
+85220 ()-01*)
+85230 END
+85240 ()-44*)
+85250 (*+44()
+85260 FOR INDEX := BLANKS+M+POINT+AFTER DOWNTO BLANKS+1 DO
+85270 IF INDEX=PT THEN CHARVEC[INDEX] := '.'
+85280 ELSE IF INDEX<FIRSTDIG THEN CHARVEC[INDEX] := '0'
+85290 ELSE
+85300 BEGIN
+85310 B := A MOD 10;
+85320 A := A DIV 10;
+85330 CHARVEC[INDEX] := CHR( ORD( '0' ) + B );
+85340 END;
+85350 ()+44*)
+85360 END;
+85370 SUBFIXED := TRUE;
+85380 999:
+85390 END;
+85400 (**)
+85410 (**)
+85420 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER);
+85430 VAR I: INTEGER;
+85440 BEGIN
+85450 IF S=NIL THEN S := CRSTRING(LENGTH);
+85460 WITH S^ DO
+85470 FOR I := 1 TO STRLENGTH DO CHARVEC[I] := ERRORCHAR
+85480 END;
+85490 (**)
+85500 (**)
+85510 PROCEDURE PUTT(RF: OBJECTP);
+85520 (*+02() LABEL 1; ()+02*)
+85530 VAR P: ^REALTEGER;
+85540 TEMP: REALTEGER;
+85550 PDESC1:PDESC;
+85560 TEMPLATE:DPOINT;
+85570 COUNT, XMODE, XSIZE, SIZE, I, J: INTEGER;
+85580 F,PVAL:OBJECTP;
+85590 (**)
+85600 (*+02() PROCEDURE DUMMYP; (*JUST HERE TO MAKE 1 GLOBAL, NOT CALLED*)
+85610 BEGIN GOTO 1 END; ()+02*)
+85620 (**)
+85630 PROCEDURE ENSROOM(RF:OBJECTP;VAR F:OBJECTP;UPB:INTEGER);
+85640 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+85650 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
+85660 WITH F^.PCOVER^ DO
+85670 BEGIN IF COFCPOS+UPB-ORD(COFCPOS<=1)>CHARBOUND
+85680 THEN BEGIN IF UPB>=CHARBOUND THEN ERRORR(SMALLLINE);
+85690 STATUS:=STATUS+[LINEOVERFLOW];
+85700 ENSROOM(RF,F,UPB)
+85710 END
+85720 ELSE IF COFCPOS<>1 THEN
+85730 CLPASC5(ORD(F^.PCOVER), ORD(F), -1, ORD(' '), ORD(BOOK), DOPUTS);
+85740 END (*WITH*);
+85750 END; (*ENSROOM*)
+85760 (**)
+85770 PROCEDURE CRREALSTR(R:REAL;VAR S:OBJECTP;START:INTEGER);
+85780 VAR E, F: REALTEGER;
+85790 NOOK: BOOLEAN;
+85800 BEGIN
+85810 F.REA := R ;
+85820 NOOK:=SUBFIXED(1,1,1,REALWIDTH-1,E.INT,TRUE,F,TRUE,S,START);
+85830 S^.CHARVEC[START+REALWIDTH+2]:='E';
+85840 NOOK:=SUBFIXED(1,EXPWIDTH,0,0,E.INT,FALSE,E,FALSE,S,START+REALWIDTH+3)
+85850 END;
+85860 (**)
+85870 PROCEDURE VALUEPRINT(RF:OBJECTP;VAR F:OBJECTP);
+85880 VAR D,I,J,EXP,UPB,LWB:INTEGER;
+85890 S,STR :OBJECTP;
+85900 NOOK:BOOLEAN;
+85910 BEGIN WITH TEMP DO
+85920 BEGIN
+85930 UPB:=1;
+85940 IF NOT([OPENED,WRITEMOOD,CHARMOOD]<=F^.PCOVER^.STATUS) THEN
+85950 ENSSTATE(RF, F, [OPENED,WRITEMOOD,CHARMOOD]);
+85960 XSIZE := SZINT;
+85970 CASE XMODE OF
+85980 -1: (*FILLER*) XSIZE := 0;
+85990 (*+61() 1,3,5: (*LONG MODES*)
+86000 BEGIN XSIZE := SZLONG; DUMMY END; ()+61*)
+86010 0: (*INTEGER*)
+86020 BEGIN UPB:=INTSPACE;
+86030 ENSROOM(RF,F,UPB);
+86040 NOOK:=SUBFIXED(1,INTWIDTH,0,0,EXP,FALSE,TEMP,FALSE,PUTSTRING,1);
+86050 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, INTSPACE, ORD(BOOK), DOPUTS)
+86060 END;
+86070 2: (*REAL*)
+86080 BEGIN XSIZE := SZREAL; UPB:=REALSPACE;
+86090 ENSROOM(RF,F,UPB);
+86100 CRREALSTR(REA,PUTSTRING,1);
+86110 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, UPB, ORD(BOOK), DOPUTS);
+86120 END;
+86130 4: (*COMPL*)
+86140 BEGIN UPB:=COMPLSPACE;
+86150 ENSROOM(RF,F,UPB);
+86160 REA := P^.REA;
+86170 CRREALSTR(REA,PUTSTRING,1);
+86180 PUTSTRING^.CHARVEC[REALSPACE+1]:=' ';
+86190 PUTSTRING^.CHARVEC[REALSPACE+2]:='I';
+86200 P:=INCPTR(P, SZREAL); REA := P^.REA;
+86210 CRREALSTR(REA,PUTSTRING,REALSPACE+3);
+86220 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(PUTSTRING), 1, UPB, ORD(BOOK), DOPUTS);
+86230 END;
+86240 7,9,10: BEGIN LWB:=1; (*STRING,BITS,BYTES*)
+86250 IF XMODE=7 THEN
+86260 BEGIN XSIZE := SZADDR; STR:=PTR; D:=STR^.STRLENGTH;
+86270 IF [PAGEOVERFLOW]<=F^.PCOVER^.STATUS
+86280 THEN IF NOT ENSPAGE(RF,F) THEN ERRORR(9999)
+86290 END
+86300 ELSE IF XMODE=9 THEN
+86310 BEGIN J:=INT; (*BITS*)
+86320 STR := CRSTRING(BITSWIDTH);
+86330 WITH STR^ DO
+86340 FOR I:=1 TO BITSWIDTH DO
+86350 IF NXTBIT(J)=1 THEN CHARVEC[I]:='T' ELSE CHARVEC[I]:='F';
+86360 D:=BITSWIDTH
+86370 END
+86380 ELSE IF XMODE=10 THEN (*BYTES*)
+86390 BEGIN STR := CRSTRING(BYTESWIDTH);
+86400 WITH STR^ DO
+86410 FOR I:=1 TO BYTESWIDTH DO CHARVEC[I]:=ALF[I];
+86420 D:=BYTESWIDTH
+86430 END;
+86440 WHILE LWB<=D DO
+86450 BEGIN IF [LINEOVERFLOW]<=F^.PCOVER^.STATUS
+86460 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(9999);
+86470 WITH F^.PCOVER^ DO
+86480 BEGIN UPB:=LWB+CHARBOUND-COFCPOS; (*ROOM LEFT ON LINE*)
+86490 IF UPB>D THEN UPB:=D;
+86500 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(STR), LWB, UPB, ORD(BOOK), DOPUTS);
+86510 LWB:=UPB+1;
+86520 END (*WITH*)
+86530 END; (*OD*)
+86540 IF XMODE IN [9,10] THEN GARBAGE(STR)
+86550 END; (*STRING*)
+86560 6,8: (*CHAR, BOOL*)
+86570 BEGIN
+86580 IF LINEOVERFLOW IN F^.PCOVER^.STATUS THEN
+86590 IF NOT ENSLINE(RF, F) THEN ERRORR(9999);
+86600 IF XMODE=8 THEN (*BOOL*)
+86610 IF (*+01()INT<0()+01*) (*-01()INT<>0()-01*) THEN
+86620 INT := ORD('T') ELSE INT := ORD('F');
+86630 IF (INT>=0) AND (INT<=MAXABSCHAR) THEN
+86640 WITH F^.PCOVER^ DO CLPASC5(ORD(F^.PCOVER), ORD(S), -1, INT, ORD(BOOK), DOPUTS)
+86650 ELSE ERRORR(RCHARERROR)
+86660 END;
+86670 11: (*PROC*) CL68(GETPROC(PTR), RF);
+86680 12: (*STRUCT*)
+86690 BEGIN J:=0;
+86700 REPEAT J:=J+1 UNTIL TEMPLATE^[J]<0;
+86710 I:=ORD(P);
+86720 WHILE ORD(P)-I<TEMPLATE^[0] DO
+86730 BEGIN J:=J+1;
+86740 XMODE:=TEMPLATE^[J]-1;
+86750 TEMP := P^ ;
+86760 VALUEPRINT(RF,F);
+86770 P:=INCPTR(P, XSIZE)
+86780 END;
+86790 XMODE:=12
+86800 END;
+86810 14: (*CODE(REF FILE)VOID*)
+86820 BEGIN
+86830 XSIZE := SZPROC;
+86840 CLPASC1(ORD(RF), PROCC);
+86850 END;
+86860 END; (*CASE*)
+86870 END (*WITH TEMP*);
+86880 END; (*VALUEPRINT*)
+86890 (**)
+86900 BEGIN (*PUT*)
+86910 (*PUTT IS CALLED FROM EITHER PUT OR PRINT, WHICH ARE WRITTEN
+86920 IN ASSEMBLER. AT THIS POINT, STKTOP(0) CONTAINS COUNT, THE
+86930 SPACE OCCUPIED BY DATA LIST ITEMS, BELOW THAT ARE PAIRS
+86940 ON THE STACK, EACH CONSISTING OF AN XMODE AND A VALUE
+86950 *)
+86960 (*+02() 1: ()+02*) COUNT := GETSTKTOP(SZWORD, 0);
+86970 FPINC(RF^);
+86980 J := COUNT+SZWORD;
+86990 WHILE J>SZWORD DO
+87000 BEGIN
+87010 J := J-SZWORD;
+87020 XMODE := GETSTKTOP(SZWORD, J);
+87030 CASE XMODE OF
+87040 4,7,11,12,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
+87050 BEGIN
+87060 J := J-SZADDR;
+87070 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
+87080 FPINC(PVAL^);
+87090 END;
+87100 (*+61() 1,3,5: J := J-SZLONG; ()+61*)
+87110 14: J := J-SZPROC;
+87120 2: J := J-SZREAL;
+87130 0,6,8,9,10: J := J-SZINT;
+87140 -1: (*NO ACTION*);
+87150 END;
+87160 END;
+87170 TESTF(RF,F);
+87180 J := COUNT+SZWORD;
+87190 WHILE J>SZWORD DO
+87200 BEGIN
+87210 J := J-SZWORD;
+87220 XMODE := GETSTKTOP(SZWORD, J);
+87230 IF XMODE>=16 THEN (*ROW*)
+87240 BEGIN
+87250 J := J-SZADDR;
+87260 XMODE:=XMODE-16;
+87270 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
+87280 WITH PVAL^ DO
+87290 BEGIN
+87300 FORMPDESC(PVAL,PDESC1);
+87310 TEMPLATE:=MDBLOCK;
+87320 IF ORD(TEMPLATE)=0 THEN SIZE := SZADDR
+87330 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN SIZE:=ORD(TEMPLATE)
+87340 ELSE SIZE:=TEMPLATE^[0];
+87350 WHILE NEXTEL(0,PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
+87360 BEGIN I:=PP;
+87370 WHILE I<PP+PSIZE DO
+87380 BEGIN P:=INCPTR(PVALUE, I);
+87390 TEMP := P^;
+87400 VALUEPRINT(RF,F);
+87410 I:=I+SIZE
+87420 END
+87430 END
+87440 END
+87450 END
+87460 ELSE
+87470 BEGIN
+87480 CASE XMODE OF
+87490 4,5,12: (*STRUCT, INCLUDING COMPL*)
+87500 BEGIN
+87510 J := J-SZADDR;
+87520 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
+87530 TEMPLATE := PVAL^.DBLOCK;
+87540 P := INCPTR(PVAL, STRUCTCONST);
+87550 END;
+87560 0,6,8,9,10:
+87570 BEGIN J := J-SZINT; TEMP.INT := GETSTKTOP(SZINT, J) END;
+87580 (*+61()
+87590 1,3:
+87600 BEGIN J := J-SZLONG; TEMP.LONG := GETSTKTOP(SZLONG, J) END;
+87610 ()+61*)
+87620 2:
+87630 BEGIN J := J-SZREAL; (*-01()TEMP.REA()-01*)(*+01()TEMP.INT()+01*) := GETSTKTOP(SZREAL, J) END;
+87640 7,11:
+87650 BEGIN J := J-SZADDR; TEMP.PTR := ASPTR(GETSTKTOP(SZADDR, J)) END;
+87660 14:
+87670 BEGIN J := J-SZPROC; TEMP.PROCC := GETSTKTOP(SZPROC, J) END;
+87680 -1: (*NO ACTION*);
+87690 END;
+87700 VALUEPRINT(RF, F);
+87710 END;
+87720 END; (*OD*)
+87730 J := COUNT+SZWORD;
+87740 WHILE J>SZWORD DO
+87750 BEGIN
+87760 J := J-SZWORD;
+87770 XMODE := GETSTKTOP(SZWORD, J);
+87780 CASE XMODE OF
+87790 4,7,11,12,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
+87800 BEGIN
+87810 J := J-SZADDR;
+87820 PVAL := ASPTR(GETSTKTOP(SZADDR, J));
+87830 WITH PVAL^ DO
+87840 BEGIN FDEC; IF FTST THEN GARBAGE(PVAL) END;
+87850 END;
+87860 (*+61() 1,3,5: J := J-SZLONG; ()+61*)
+87870 14: J := J-SZPROC;
+87880 2: J := J-SZREAL;
+87890 0,6,8,9,10: J := J-SZINT;
+87900 -1: (*NO ACTION*);
+87910 END;
+87920 END;
+87930 WITH RF^ DO
+87940 BEGIN FDEC; IF FTST THEN GARBAGE(RF) END;
+87950 END; (* PUT *)
+87960 (**)
+87970 (**)
+87980 (*-02()
+87990 BEGIN (*OF A68*)
+88000 END; (*OF A68*)
+88010 ()-02*)
+88020 (*+01()
+88030 BEGIN (*OF MAIN PROGRAM*)
+88040 END (* OF EVERYTHING *).
+88050 ()+01*)
--- /dev/null
+65300 #include "rundecs.h"
+65310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+65320 (**)
+65330 PROCEDURE ERRORR(N: INTEGER);EXTERN;
+65340 PROCEDURE GARBAGE(ANOBJECT: OBJECTP);EXTERN;
+65350 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+65360 (**)
+65370 (**)
+65380 FUNCTION RAND(VAR SEED: INTEGER): REAL;
+65390 CONST
+65400 (*+11()
+65410 MULTIPLIER=16777215;
+65420 PRIMEMODULUS=281474976710597;
+65430 (*N=48, L=24, M=24*)
+65440 TWOL=16777216;
+65450 TWOM=16777216;
+65460 PRIMEDIFF=59; (*2^N - PRIMEMODULUS*)
+65470 SHRINKER=4614343880501.61;
+65480 STRETCHER=4614343880502.55;
+65490 ()+11*)
+65500 (*+12()
+65510 MULTIPLIER=176;
+65520 PRIMEMODULUS=32749;
+65530 (*N=15, L=7, M=8*)
+65540 TWOL=128;
+65550 TWOM=256;
+65560 PRIMEDIFF=19; (*2^N - PRIMEMODULUS*)
+65570 SHRINKER=1560.381;
+65580 STRETCHER=1559.381;
+65590 ()+12*)
+65600 (*+13()
+65610 MULTIPLIER=46340;
+65620 PRIMEMODULUS=2147483647;
+65630 (*N=31, L=15, M=16*)
+65640 TWOL=32768;
+65650 TWOM=65536;
+65660 PRIMEDIFF=1; (*2^N - PRIMEMODULUS*)
+65670 SHRINKER=715827882.334;
+65680 STRETCHER=715827881.667;
+65690 ()+13*)
+65700 VAR HIBITS,MIDBITS,LOBITS: INTEGER;
+65710 LSHALFOFRAND: REAL;
+65720 BEGIN
+65730 SEED := SEED+(1-TRUNC(SEED/SHRINKER));
+65740 LSHALFOFRAND := SEED/PRIMEMODULUS;
+65750 LSHALFOFRAND := LSHALFOFRAND/PRIMEMODULUS;
+65760 LOBITS := SEED MOD TWOL * MULTIPLIER;
+65770 MIDBITS := (SEED DIV TWOL - TWOL)*MULTIPLIER + LOBITS DIV TWOL;
+65780 IF MIDBITS>=0 THEN
+65790 BEGIN
+65800 HIBITS := MIDBITS DIV TWOM;
+65810 MIDBITS := MIDBITS MOD TWOM + MULTIPLIER*TWOL;
+65820 END
+65830 ELSE
+65840 BEGIN
+65850 HIBITS := (MIDBITS+1) DIV TWOM -1;
+65860 MIDBITS := MIDBITS MOD TWOM;
+65870 MIDBITS := MIDBITS + ORD(MIDBITS<0)*TWOM + MULTIPLIER*TWOL;
+65880 (*IN CASE PASCAL COMPILER DOES NOT IMPLEMENT MOD CORRECTLY*)
+65890 END;
+65900 HIBITS := HIBITS + MIDBITS DIV TWOM;
+65910 MIDBITS := MIDBITS MOD TWOM;
+65920 LOBITS := LOBITS MOD TWOL + MIDBITS*TWOL;
+65930 SEED := LOBITS - PRIMEMODULUS + HIBITS*PRIMEDIFF;
+65940 IF SEED<0 THEN SEED := SEED + PRIMEMODULUS;
+65950 RAND := SEED/PRIMEMODULUS+LSHALFOFRAND;
+65960 SEED := SEED+TRUNC((SEED-1)/STRETCHER)-1
+65970 END;
+65980 (**)
+65990 (**)
+66000 FUNCTION RANDOM: REAL;
+66010 BEGIN
+66020 RANDOM := RAND(LASTRANDOM)
+66030 END;
+66040 (**)
+66050 (**)
+66060 FUNCTION NEXTRAN(SEEDP: OBJECTP): REAL;
+66070 VAR PTR: UNDRESSP;
+66080 BEGIN
+66090 PTR := SAFEACCESS(SEEDP);
+66100 NEXTRAN := RAND(PTR^.FIRSTWORD);
+66110 IF FPTST(SEEDP^) THEN GARBAGE(SEEDP);
+66120 END;
+66130 (**)
+66140 (**)
+66150 (*-02()
+66160 BEGIN (* OF A68 *)
+66170 END (* OF A68 *);
+66180 ()-02*)
+66190 (*+01()
+66200 BEGIN (* OF MAIN PROGRAM *)
+66210 END (* OF MAIN PROGRAM *).
+66220 ()+01*)
--- /dev/null
+42400 #include "rundecs.h"
+42410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+42420 (**)
+42430 (**)
+42440 (*-01() (*-05()
+42450 PROCEDURE RANGENT (IDB: PIDBLK; LOCRG: DEPTHRANGE; NEWRG: PRANGE);
+42460 (*PRANGENT*)
+42470 BEGIN
+42480 WITH NEWRG^ DO WITH FIRSTW DO
+42490 BEGIN
+42500 LOOPCOUNT := 0;
+42510 RGIDBLK := IDB;
+42520 RECGEN := NIL;
+42530 RGSCOPE := LOCRG;
+42540 RIBOFFSET:= FIRSTRG.RIBOFFSET;
+42550 (*-41() RGNEXTFREE := INCPTR(NEWRG, RGCONST); ()-41*)
+42560 (*+41() RGLASTUSED := ASPTR(ORD(NEWRG)); ()+41*)
+42570 END;
+42580 FIRSTRG.RIBOFFSET:= NEWRG
+42590 END;
+42600 ()-05*) ()-01*)
+42610 (**)
+42620 (**)
+42630 (*-02()
+42640 BEGIN
+42650 END ;
+42660 ()-02*)
+42670 (*+01()
+42680 BEGIN (*OF MAIN PROGRAM*)
+42690 END (*OF EVERYTHING*).
+42700 ()+01*)
--- /dev/null
+42800 #include "rundecs.h"
+42810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+42820 (**)
+42830 (**)
+42840 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+42850 (**)
+42860 (**)
+42870 PROCEDURE RANGEXT;
+42880 (*PRANGEXT*)
+42890 (*+01() EXTERN; ()+01*)
+42900 (*+05() EXTERN; ()+05*)
+42910 (*-01() (*-05()
+42920 VAR LASTRG: PRANGE;
+42930 IDP: PIDBLK ;
+42940 PP: OBJECTPP ;
+42950 I, J: INTEGER;
+42960 BEGIN
+42970 WITH FIRSTRG.RIBOFFSET^ DO
+42980 WITH FIRSTW DO
+42990 BEGIN
+43000 IDP := RGIDBLK ;
+43010 IF FIRSTRG.RIBOFFSET^.RIBOFFSET = FIRSTRG.RIBOFFSET THEN (*PARAMS*)
+43020 (*-41() PP := INCPTR(RGNEXTFREE, -PROCBL^.PARAMS) ()-41*)
+43030 (*+41() PP := INCPTR(RGLASTUSED, +PROCBL^.PARAMS) ()+41*)
+43040 ELSE
+43050 (*-41() PP := INCPTR ( FIRSTRG.RIBOFFSET , RGCONST ) ; ()-41*)
+43060 (*+41() PP := ASPTR ( ORD( FIRSTRG.RIBOFFSET ) ) ; ()+41*)
+43070 FIRSTRG.RIBOFFSET := RIBOFFSET ;
+43080 (*-41() WHILE ORD (PP) < ORD (RGNEXTFREE) DO ()-41*)
+43090 (*+41() WHILE ORD (PP) > ORD (RGLASTUSED) DO ()+41*)
+43100 BEGIN
+43110 IDP := INCPTR (IDP , -SZIDBLOCK) ;
+43120 WITH IDP^ DO
+43130 BEGIN
+43140 IF IDSIZE = 0 THEN
+43150 BEGIN
+43160 (*+41() PP := INCPTR( PP , - SZADDR ) ; ()+41*)
+43170 WITH PP^^ DO
+43180 BEGIN
+43190 FDEC;
+43200 IF FTST THEN GARBAGE (PP^)
+43210 END ;
+43220 (*-41() PP := INCPTR( PP , SZADDR ) ()-41*)
+43230 END
+43240 ELSE PP := INCPTR( PP , (*+41() - ()+41*) IDSIZE )
+43250 END
+43260 END
+43270 END
+43280 END;
+43290 (**)
+43300 (**)
+43310 FUNCTION RANGXTP(ANOBJECT: OBJECTP): OBJECTP;
+43320 (*PRANGEXT+2*)
+43330 BEGIN
+43340 WITH ANOBJECT^ DO FINC;
+43350 RANGEXT;
+43360 WITH ANOBJECT^ DO FDEC;
+43370 RANGXTP := ANOBJECT;
+43380 END;
+43390 ()-05*) ()-01*)
+43400 (**)
+43410 (**)
+43420 (*-02()
+43430 BEGIN
+43440 END ;
+43450 ()-02*)
+43460 (*+01()
+43470 BEGIN (*OF MAIN PROGRAM*)
+43480 END (*OF EVERYTHING*).
+43490 ()+01*)
--- /dev/null
+88100 #include "rundecs.h"
+88110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+88120 (**)
+88130 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+88140 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+88150 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+88160 PROCEDURE SETREADMOOD(PCOV:OBJECTP); EXTERN;
+88170 PROCEDURE SETWRITEMOOD(PCOV:OBJECTP); EXTERN;
+88180 PROCEDURE SETCHARMOOD(PCOV:OBJECTP); EXTERN;
+88190 (**)
+88200 (**)
+88210 PROCEDURE RESET(RF: OBJECTP);
+88220 VAR F: OBJECTP;
+88230 BEGIN
+88240 TESTF(RF, F);
+88250 WITH F^.PCOVER^ DO
+88260 IF OPENED IN STATUS THEN
+88270 IF RESETPOSS IN POSSIBLES THEN
+88280 BEGIN
+88290 STATUS := STATUS-[READMOOD,WRITEMOOD,LFE,PFE,PAGEOVERFLOW,LINEOVERFLOW]+[NOTRESET];
+88300 COFCPOS := 1; LOFCPOS := 1; POFCPOS := 1;
+88310 IF NOT (GETPOSS IN POSSIBLES) THEN SETWRITEMOOD(F^.PCOVER)
+88320 ELSE IF NOT (PUTPOSS IN POSSIBLES) THEN SETREADMOOD(F^.PCOVER);
+88330 IF NOT (BINPOSS IN POSSIBLES) THEN SETCHARMOOD(F^.PCOVER)
+88340 END
+88350 ELSE ERRORR(NORESET)
+88360 ELSE ERRORR(NOTOPEN);
+88370 IF FPTST(RF^) THEN GARBAGE(RF)
+88380 END;
+88390 (**)
+88400 (**)
+88410 (*-02()
+88420 BEGIN (*OF A68*)
+88430 END; (*OF A68*)
+88440 ()-02*)
+88450 (*+01()
+88460 BEGIN (*OF MAIN PROGRAM*)
+88470 END (* OF EVERYTHING *).
+88480 ()+01*)
--- /dev/null
+43600 #include "rundecs.h"
+43610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+43620 (**)
+43630 (**)
+43670 (*RNSTART HAD BETTER BE WRITTEN IN ASSEMBLER ON MOST SYSTEMS*)
+43680 (**)
+43690 (*-01() (*-05()
+43700 FUNCTION GETADDRESS (VAR VARIABLE :IPOINT) :IPOINT; EXTERN;
+43710 FUNCTION GETCALLER (CALLEE :IPOINT) :IPOINT; EXTERN;
+43720 FUNCTION GETLINENO :INTEGER; EXTERN;
+43730 PROCEDURE RNSTART;
+43740 VAR TSCOPE: DEPTHRANGE;
+43750 RNIB: IPOINT;
+43760 CURR : INTPOINT ;
+43764 PROCEDURE SETNSTATIC( N: INTEGER ) ; EXTERN ;
+43770 BEGIN
+43780 RNIB := DYNAMIC(ME);
+43790 (*+05()SETMYSTATIC(STATIC(DYNAMIC(RNIB)));(*TO ALGOL 68 CALLER*) ()+05*)
+43800 (*-05()SETMYSTATIC(GETCALLER(RNIB); ()-05*)
+43810 TSCOPE := SCOPE ;
+43820 (*+02()LINENO:=GETLINENO;()+02*)
+43830 SETMYSTATIC(RNIB); (* TO ALGOL 68 CALLEE *)
+43840 (*+05()CURR := ASPTR(RNIB-SZWORD*2);(*CURR IS NOW POINTING TO ALGOL 68 CALLEE'S STATIC LINK*)
+43850 CURR ^ := RNIB ; (* SET ALGOL 68 CALLEE'S STATIC LINK TO ITSELF *)
+43860 STATICP:=STATICP-192; (*ENABLING ACCESS BY OFFSET FROM PNX R2*)()+05*)
+43870 SCOPE := TSCOPE+LOCRG;
+43880 LEVEL := PROCBL^.LEVEL;
+43890 (*-02()LINENO := 0;()-02*)
+43900 WITH FIRSTRG DO WITH FIRSTW DO
+43910 BEGIN LOOPCOUNT := 0; RECGEN := NIL; RGIDBLK := PROCBL ^ . IDBLOCK ; RGSCOPE := 1;
+43920 RIBOFFSET := INCPTR( ASPTR( RNIB ) , IBCONST + RGCONST );
+43930 (*+05()RGLASTUSED :=ASPTR(RNIB-PARAMOFFSET);()+05*)
+43940 (*-05()RGLASTUSED:=INCPTR(ASPTR(GETADDRESS(STATICP)),-PARAMOFFSET);()-05*)
+43950 END;
+43960 IF LEVEL > PROCBL^.SCOPELEVEL + 1 THEN SETNSTATIC( LEVEL - ( PROCBL^.SCOPELEVEL + 1 ) ) ;
+43970 END;
+43980 ()-05*) ()-01*)
+43990 (**)
+44000 (**)
+44010 (*-02()
+44020 BEGIN
+44030 END ;
+44040 ()-02*)
+44050 (*+01()
+44060 BEGIN (*OF MAIN PROGRAM*)
+44070 END (*OF EVERYTHING*).
+44080 ()+01*)
--- /dev/null
+44100 #include "rundecs.h"
+44110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+44120 (**)
+44130 (**)
+44140 FUNCTION ROUTNA (PROC:PROCPOINT;ENV:IPOINT):OBJECTP;
+44150 VAR NEWRT:OBJECTP;
+44160 BEGIN
+44170 ENEW(NEWRT, ROUTINESIZE);
+44180 WITH NEWRT^ DO
+44190 BEGIN
+44200 (*-02() FIRSTWORD := SORTSHIFT * ORD(ROUTINE); ()-02*)
+44210 (*+02() PCOUNT:=0; SORT:=ROUTINE; ()+02*)
+44220 PROCBL:=PROC;
+44230 ENVCHAIN:=ENV;
+44240 SETMYSTATIC(ENV);
+44250 OSCOPE:=SCOPE+PROC^.SCOFFSET;
+44260 END;
+44270 ROUTNA:= NEWRT
+44280 END;
+44290 (**)
+44300 (**)
+44310 FUNCTION ROUTN (PROC: PROCPOINT): OBJECTP;
+44320 (* PLOADRT: CONSTRUCTS ROUTINE VALUE FOR GIVEN PROCBL;
+44330 RETURNS POINTER TO NEW ROUTINEBLOCK; KK 13.5.1977 *)
+44340 VAR I: INTEGER;
+44350 BEGIN
+44360 FOR I := LEVEL-1 DOWNTO PROC^.SCOPELEVEL DO
+44370 SETMYSTATIC( (*-05()STATIC()-05*)(*+05()A68STATIC()+05*) ( STATIC( ME ) ) );
+44380 ROUTN := ROUTNA(PROC,STATIC(ME));
+44390 END;
+44400 (**)
+44410 (**)
+44420 (*-02()
+44430 BEGIN
+44440 END ;
+44450 ()-02*)
+44460 (*+01()
+44470 BEGIN (*OF MAIN PROGRAM*)
+44480 END (*OF EVERYTHING*).
+44490 ()+01*)
--- /dev/null
+44600 #include "rundecs.h"
+44610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+44620 (**)
+44630 (**)
+44640 FUNCTION ROUTNP(PROC: ASPROC; NPARAMS: SIZERANGE):OBJECTP;
+44650 VAR NEWRT: OBJECTP;
+44660 BEGIN
+44670 ENEW(NEWRT, PROUTINESIZE);
+44680 WITH NEWRT^ DO
+44690 BEGIN
+44700 (*-02() FIRSTWORD := SORTSHIFT * ORD(PASCROUT); ()-02*)
+44710 (*+02() PCOUNT:=0; SORT:=PASCROUT; ()+02*)
+44720 PPROCBL := PROC;
+44730 PPARAMS := NPARAMS;
+44740 OSCOPE := 1; (*GLOBAL*)
+44750 END;
+44760 ROUTNP := NEWRT
+44770 END;
+44780 (**)
+44790 (**)
+44800 (*-02()
+44810 BEGIN
+44820 END ;
+44830 ()-02*)
+44840 (*+01()
+44850 BEGIN (*OF MAIN PROGRAM*)
+44860 END (*OF EVERYTHING*).
+44870 ()+01*)
--- /dev/null
+44900 #include "rundecs.h"
+44910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+44920 (**)
+44930 (**)
+44940 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
+44950 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+44960 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN ;
+44970 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN ;
+44980 (**)
+44990 (**)
+45000 FUNCTION ROWM(AMULT: OBJECTP; ROWCOUNT: INTEGER): OBJECTP;
+45010 (*PROWMULT*)
+45020 VAR NEWMULT, OLDESC, NEWDESC: OBJECTP;
+45030 I: INTEGER; OLDROWS: 0..7;
+45040 BEGIN
+45050 WITH AMULT^ DO
+45060 BEGIN
+45070 IF BPTR<>NIL THEN (*A SLICE*)
+45080 COPYSLICE(AMULT);
+45090 OLDROWS := ROWS;
+45100 ROWS := ROWCOUNT-1;
+45110 NEWMULT := COPYDESC(AMULT, MULT);
+45120 NEWMULT^.PVALUE := AMULT;
+45130 NEWMULT := GETMULT(NEWMULT);
+45140 ROWS := OLDROWS;
+45150 WITH NEWMULT^ DO
+45160 BEGIN
+45170 ROWS := ROWCOUNT-1;
+45180 FOR I := OLDROWS+1 TO ROWS DO WITH DESCVEC[I] DO
+45190 BEGIN LI := 1; UI := 1; DI := PVALUE^.D0 END;
+45200 LBADJ := LBADJ+DESCVEC[ROWS].DI*(ROWS-OLDROWS);
+45210 FPINC(PVALUE^);
+45220 END;
+45230 IF FTST THEN GARBAGE(AMULT)
+45240 END;
+45250 ROWM := NEWMULT;
+45260 END;
+45270 (**)
+45280 (**)
+45290 (*-02() BEGIN END ; ()-02*)
+45300 (*+01()
+45310 BEGIN (*OF MAIN PROGRAM*)
+45320 END (*OF EVERYTHING*).
+45330 ()+01*)
--- /dev/null
+45400 #include "rundecs.h"
+45410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+45420 (**)
+45430 (**)
+45440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+45450 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
+45460 FUNCTION CRMULT( NEWMULT: OBJECTP ; TEMPLATE: DPOINT ) : OBJECTP ; EXTERN ;
+45470 (**)
+45480 (**)
+45490 FUNCTION ROWNM(PVAL: OBJECTP; ROWCOUNT: INTEGER; TEMPLATE: DPOINT): OBJECTP;
+45500 (*PROWNONMULT*)
+45510 (*WARNING: PVAL CAN ALSO BE AN A68INT; TROUBLE WILL ENSUE IF SZINT>SZADDR*)
+45520 VAR NEWMULT: OBJECTP;
+45530 DESCDEX: INTEGER;
+45540 PTR: UNDRESSP;
+45550 BEGIN
+45560 ENEW(NEWMULT, MULTCONST+ROWCOUNT*SZPDS);
+45570 WITH NEWMULT^ DO
+45580 BEGIN
+45590 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
+45600 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
+45610 (*+01() SECONDWORD := 0; ()+01*)
+45620 ROWS := ROWCOUNT-1;
+45630 FOR DESCDEX := 0 TO ROWCOUNT-1 DO
+45640 WITH DESCVEC[DESCDEX] DO
+45650 BEGIN LI := 1; UI := 1 END;
+45660 IHEAD := NIL; FPTR := NIL; BPTR := NIL
+45670 END;
+45680 NEWMULT := CRMULT(NEWMULT, TEMPLATE);
+45690 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
+45700 IF ORD(TEMPLATE)=0 THEN (*DRESSED*)
+45710 BEGIN
+45720 PTR^.FIRSTPTR := PVAL;
+45730 WITH PVAL^ DO FINC
+45740 END
+45750 ELSE IF ORD(TEMPLATE)=1 THEN (*SIMPLE*)
+45760 PTR^.FIRSTINT := ORD(PVAL)
+45770 ELSE IF PVAL^.SORT<>UNDEF THEN
+45780 BEGIN
+45790 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
+45800 MOVELEFT(PVAL, PTR, ORD(TEMPLATE))
+45810 ELSE (*STRUCT*)
+45820 BEGIN
+45830 MOVELEFT(INCPTR(PVAL, STRUCTCONST), PTR, TEMPLATE^[0]);
+45840 PCINCR(INCPTR(PVAL, STRUCTCONST), TEMPLATE, +INCRF)
+45850 END;
+45860 IF FPTST(PVAL^) THEN GARBAGE(PVAL)
+45870 END;
+45880 ROWNM := NEWMULT;
+45890 END;
+45900 (**)
+45910 (**)
+45920 (*-02() BEGIN END ; ()-02*)
+45930 (*+01()
+45940 BEGIN (*OF MAIN PROGRAM*)
+45950 END (*OF EVERYTHING*).
+45960 ()+01*)
--- /dev/null
+BEGIN (*of a68*)
+END; (*of a68*)
+
+BEGIN (*of m_a_i_n*)
+END. (*of everything*)
--- /dev/null
+0000 #
+0001 (*+02()
+0002 #define FINC PCOUNT := PCOUNT+1
+0003 #define FDEC PCOUNT := PCOUNT-1
+0004 #define FTST PCOUNT<1
+0006 #define FPINC(THISP)THISP.PCOUNT := THISP.PCOUNT+1
+0007 #define FPDEC(THISP)THISP.PCOUNT := THISP.PCOUNT-1
+0008 #define FPTST(THISP)THISP.PCOUNT<1
+0009 #define FPTWO(THISP)THISP.PCOUNT>=2
+0010 #define FINCD(THISP,I)THISP.PCOUNT := THISP.PCOUNT+I
+0011 ()+02*)
+0012 (*+01()
+0013 #define FINC FIRSTWORD := FIRSTWORD+INCRF
+0014 #define FDEC FIRSTWORD := FIRSTWORD-INCRF;
+0015 #define FTST FIRSTWORD<ONEF
+0016 #define FPINC(THISP)THISP.FIRSTWORD := THISP.FIRSTWORD+INCRF
+0017 #define FPDEC(THISP)THISP.FIRSTWORD := THISP.FIRSTWORD-INCRF
+0018 #define FPTST(THISP)THISP.FIRSTWORD<ONEF
+0019 #define FPTWO(THISP)THISP.FIRSTWORD>TWOF
+0020 #define FINCD(THISP,I))THISP.FIRSTWORD := THISP.FIRSTWORD+I
+0021 ()+01*)
+0022 (*+05()
+0023 #define FINC FIRSTWORD := FIRSTWORD+INCRF
+0024 #define FDEC FIRSTWORD := FIRSTWORD-INCRF;
+0025 #define FTST FIRSTWORD<ONEF
+0026 #define FPINC(THISP)THISP.FIRSTWORD := THISP.FIRSTWORD+INCRF
+0027 #define FPDEC(THISP)THISP.FIRSTWORD := THISP.FIRSTWORD-INCRF
+0028 #define FPTST(THISP)THISP.FIRSTWORD<ONEF
+0029 #define FPTWO(THISP)THISP.FIRSTWORD>TWOF
+0030 #define FINCD(THISP,I))THISP.FIRSTWORD := THISP.FIRSTWORD+I
+0031 ()+05*)
+00100 (*+01() (*$L-*) ()+01*)
+00110 (*+02() (*$U+*)(*$W-*)(*$G-*)(*$D+*)(*$R-*)(*$L+*)(*$E+*) ()+02*)
+00120 (*+02() (*$I32*) (* MAKE SETS ABLE TO HOLD 32 BITS *) ()+02*)
+00150 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+00200 (**)
+00250 (*+01()
+00300 (*-52() PROGRAM RA68 (INPUT/+,OUTPUT+/); ()-52*)
+00350 (*+52() PROGRAM RA68 (INPUT+,OUTPUT+/); ()+52*)
+00400 (*$G-,P-,T-,W2000 OPTIONS: COMPILE ONLY, NO IMMEDIATE GO,
+00450 SET SIZE OF STACK/HEAP
+00500 NO POINTER CHECK; ^'S TAKE UP 17 BITS *)
+00550 ()+01*)
+00555 (*+02()
+00560 (*+71() PROGRAM RUN68 (INPUT,OUTPUT); ()+71*)
+00565 ()+02*)
+00600 (*+03()
+00650 (*$E+;D-;NL*)
+00700 PROGRAM RUN68;
+00750 ()+03*)
+00800 (**)
+00850 (**)
+00900 CONST (* CONST CONST CONST CONST CONST CONST CONST*)
+00950 (**)
+01000 (**************)
+01050 (* WORD SIZES *)
+01100 (**************)
+01150 (**)
+01200 (*+01()
+01250 SZWORD=1; SZADDR=1; SZINT=1; SZREAL=1; SZLONG=2; SZNAK=1; SZPDS=1; SZPROC=1; SZTERMSET=2;
+01300 CHARPERWORD=10 ; SZIDBLOCK=1 ;
+01350 (*-41() STACKSZWORD = 1 ; STACKSZADDR = 1 ; STACKSZINT = 1 ; ()-41*)
+01400 ()+01*)
+01450 (*+02()
+01500 (*+12() (*-19()
+01550 SZWORD=2; SZADDR=2; SZINT=2; SZREAL=4; SZLONG=4; SZNAK=4; SZPDS=6; SZPROC=2; SZTERMSET=16;
+01600 CHARPERWORD=2 ; SZIDBLOCK=12;
+01650 (*-41() STACKSZWORD = 2 ; STACKSZADDR = 2 ; STACKSZINT = 2 ; ()-41*)
+01700 ()-19*)
+01705 (*+19()
+01710 SZWORD=2; SZADDR=4; SZINT=2; SZREAL=8; SZLONG=4; SZNAK=4; SZPDS=6; SZPROC=8; SZTERMSET=16;
+01720 CHARPERWORD=2 ; SZIDBLOCK=12;
+01730 (*-41() STACKSZWORD = 2 ; STACKSZADDR = 4 ; STACKSZINT = 2 ; ()-41*)
+01735 (*+41() STACKSZWORD =-2 ; STACKSZADDR =-4 ; STACKSZINT =-2 ; ()+41*)
+01740 ()+19*) ()+12*)
+01741 (*+13()
+01742 SZWORD=4; SZADDR=4; SZINT=4; SZREAL=8; SZLONG=4; SZNAK=8; SZPDS=12; SZPROC=8; SZTERMSET=16;
+01743 CHARPERWORD=4; SZIDBLOCK=12;
+01744 (*-41() STACKSZWORD = 4 ; STACKSZADDR = 4 ; STACKSZINT = 4 ; ()-41*)
+01745 (*+41() STACKSZWORD = -4 ; STACKSZADDR = -4 ; STACKSZINT = -4 ; ()+41*)
+01746 ()+13*)
+01750 ()+02*)
+01800 (*+03()
+01850 SZWORD=1; SZADDR=1; SZINT=1; SZREAL=3; SZNAK=3; SZPDS=3; (*??*) (*SZLONG??*) SZPROC=1; SZTERMSET=1;
+01900 CHARPERWORD=2 ;
+01950 (*-41() STACKSZWORD = 1 ; STACKSZADDR = 1 ; STACKSZINT = 1 ; ()-41*)
+02000 ()+03*)
+02050 (*+04()
+02100 SZWORD=2; SZADDR=4; SZINT=4; SZREAL=4; SZLONG=4; SZNAK=6; (*SZPDS??*) SZPROC=4; SZTERMSET=1;
+02150 CHARPERWORD=2 ;
+02200 (*-41() STACKSZWORD = 2 ; STACKSZADDR = 4 ; STACKSZINT = 4 ; ()-41*)
+02250 ()+04*)
+02300 (*+05()
+02350 SZWORD=2; SZADDR=2; SZINT=2; SZREAL=4; SZLONG=4; SZNAK=4; SZPDS=6; SZPROC=4; SZTERMSET=16;
+02400 CHARPERWORD=4 ; SZIDBLOCK=5 ;
+02450 (*-41() STACKSZWORD = 2 ; STACKSZADDR = 2 ; STACKSZINT = 2 ; ()-41*)
+02500 (*+41() STACKSZWORD = -2 ; STACKSZADDR = -2 ; STACKSZINT = -2 ; ()+41*)
+02550 ()+05*)
+02600 (*+11() CHARSPACE = 64 ; ()+11*)
+02700 (**)
+02750 (***************************************)
+02800 (* INCREASING AND DECREASING PCOUNTS *)
+02850 (***************************************)
+02900 (**)
+02950 (*+11()
+03000 INCRF=00004000000000000000B; (*INCREMENT FOR PCOUNTS WHEN USING FIRSTWORD*)
+03050 INCRF2=00010000000000000000B;
+03100 ONEF=00004000000000000000B; (*FOR TESTING PCOUNTS*)
+03150 TWOF=00010000000000000000B;
+03200 ()+11*)
+03250 (*+12() (*+03()
+03300 INCRF=32; (*INCREMENT FOR PCOUNTS WHEN USING FIRSTWORD*)
+03350 INCRF2=64;
+03400 ONEF=32; (*FOR TESTING PCOUNTS*)
+03450 TWOF=64;
+03500 ()+03*)
+03510 (*+02()
+03520 INCRF=1;
+03525 INCRF2=2;
+03530 ONEF=1;
+03535 TWOF=2;
+03540 ()+02*)()+12*)
+03550 (*+13() (*+05()
+03600 INCRF = 65536 ; (* INCREMENT FOR PCOUNTS WHEN USING FIRST WORD *)
+03650 INCRF2 = 131072 ;
+03700 ONEF = 65536 ; (* FOR TESTING PCOUNTS *)
+03750 TWOF = 131072 ;
+03760 ()+05*)
+03765 (*+02()
+03766 INCRF = 1;
+03767 INCRF2 = 2;
+03768 ONEF = 1;
+03769 TWOF = 2;
+03770 ()+02*)
+03800 ()+13*)
+03850 (**)
+03855 (*************************************)
+03900 (* SIZE OF OBJECTS * VARIABLE SIZE * *)
+03950 (*************************************)
+04000 (**)
+04050 (*+11()
+04100 STRUCTCONST=1;
+04150 ELSCONST=2;
+04200 STRINGCONST=1;
+04250 NEXTOFFSET=2; (*OFFSET OF NEXT WITHIN OBJECT*)
+04300 MULTCONST=4;
+04310 REFRCONST=MULTCONST;
+04320 RECRCONST=MULTCONST;
+04350 REFSLNCONST=MULTCONST;
+04400 SORTSHIFT=4398046511104;
+04450 ()+11*)
+04500 (*+12() (*+03()
+04550 STRUCTCONST=3;
+04600 ELSCONST=4;
+04650 STRINGCONST=4;
+04700 NEXTOFFSET=7; (*OFFSET OF NEXT WITHIN OBJECT*)
+04750 MULTCONST=11;
+04800 REFSLNCONST=11;
+04805 ()+03*)
+04807 (*+02()
+04810 STRUCTCONST=10;
+04815 ELSCONST=20;
+04820 STRINGCONST=6;
+04825 NEXTOFFSET=20; (*OFFSET OF NEXT WITHIN OBJECT*)
+04830 MULTCONST=38;
+04831 REFRCONST=MULTCONST;
+04832 RECRCONST=MULTCONST;
+04835 REFSLNCONST=MULTCONST;
+04840 (* SORTSHIFT IS NOT USET IN THE EM MACHINE AS THERE IS NO DEFINITION OF THE UNDERLYING HARDWARE *)
+04845 ()+02*)
+04850 ()+12*)
+04900 (*+13()
+04901 (*+05()
+04950 STRUCTCONST = 6 ;
+05000 ELSCONST = 10;
+05050 STRINGCONST = 10;
+05100 NEXTOFFSET = 12 ; (* OFFSET OF NEXT WITHIN OBJECT *)
+05150 MULTCONST = 18 ;
+05160 REFSLNCONST = MULTCONST ;
+05170 REFRCONST = MULTCONST ;
+05180 RECRCONST = MULTCONST ;
+05210 SORTSHIFT = 1;
+05211 ()+05*)
+05212 (*-05()
+05213 STRUCTCONST = 12;
+05214 ELSCONST = 20;
+05215 STRINGCONST = 20;
+05216 NEXTOFFSET = 24;
+05217 MULTCONST = 36;
+05218 REFSLNCONST = MULTCONST;
+05219 REFRCONST = MULTCONST;
+05220 RECRCONST = MULTCONST;
+05221 (*-02() SORTSHIFT = 1; ()-02*)
+05222 ()-05*)
+05250 ()+13*)
+05300 (**)
+05350 (*************************************)
+05400 (* * FIXED SIZE * *)
+05450 (*************************************)
+05500 (**)
+05550 (*+11()
+05600 ROUTINESIZE=2;
+05650 PROUTINESIZE=2;
+05700 REF1SIZE=3;
+05750 REF2SIZE=4;
+05800 CREFSIZE=2;
+05850 REFNSIZE=2;
+05950 REFSL1SIZE=2;
+06100 RECNSIZE=3;
+06150 UNSSIZE=2;
+06200 UNPSIZE=1;
+06250 AFILESIZE=8;
+06300 COVERSIZE=15;
+06350 ()+11*)
+06400 (*+12() (*+03()
+06450 ROUTINESIZE=4;
+06500 PROUTINESIZE=3;
+06550 REF1SIZE=3;
+06600 REF2SIZE=5;
+06650 CREFSIZE=4;
+06700 REFNSIZE=3;
+06800 REFSL1SIZE=6;
+06950 RECNSIZE=8;
+07000 UNSSIZE=4;
+07050 UNPSIZE=4;
+07100 AFILESIZE=24;
+07150 COVERSIZE=20;
+07155 ()+03*)
+07157 (*+02() (*SIZE OF FIELDS OF OBJECT IN BYTES*)
+07160 ROUTINESIZE=14;
+07162 PROUTINESIZE=14;
+07164 REF1SIZE=18;
+07166 REF2SIZE=24;
+07168 CREFSIZE=18;
+07170 REFNSIZE=16;
+07174 REFSL1SIZE=16;
+07178 RECNSIZE=24;
+07180 AFILESIZE=46;
+07182 COVERSIZE=88;
+07198 ()+02*)
+07200 ()+12*)
+07250 (*+13()
+07251 (*-05()
+07252 ROUTINESIZE = 12;
+07253 PROUTINESIZE = 16;
+07254 REF1SIZE = 20;
+07255 REF2SIZE = 24;
+07256 CREFSIZE = 16;
+07257 REFNSIZE = 16;
+07258 REFSL1SIZE = 20;
+07259 RECNSIZE = 28;
+07260 UNSSIZE = 12;
+07261 UNPSIZE = 12;
+07262 AFILESIZE = 64;
+07263 COVERSIZE = 104;
+07264 ()-05*)
+07265 (*+05()
+07300 ROUTINESIZE = 6 ;
+07350 PROUTINESIZE = 8;
+07400 REF1SIZE = 10;
+07450 REF2SIZE = 12;
+07500 CREFSIZE = 8 ;
+07550 REFNSIZE = 8 ;
+07650 REFSL1SIZE=10;
+07800 RECNSIZE = 14 ;
+07850 UNSSIZE = 6 ;
+07900 UNPSIZE = 6 ;
+07950 AFILESIZE = 32 ;
+08000 COVERSIZE = 52 ;
+08001 ()+05*)
+08050 ()+13*)
+08100 (**)
+08150 (*+11()
+08200 LFMOFFSET=0; (*OFFSETS WITHIN AFILE*)
+08250 PFMOFFSET=1;
+08300 PMOFFSET=2;
+08350 LMOFFSET=3;
+08400 TERMOFFSET=5;
+08450 ()+11*)
+08500 (*+12() (*+03()
+08550 LFMOFFSET=2; (*OFFSETS WITHIN AFILE*)
+08600 PFMOFFSET=3;
+08650 PMOFFSET=4;
+08700 LMOFFSET=5;
+08750 TERMOFFSET=7;
+08755 ()+03*)
+08757 (*+02()
+08760 LFMOFFSET=0; (*OFFSETS WITHIN AFILE*)
+08765 PFMOFFSET=4;
+08770 PMOFFSET=8;
+08775 LMOFFSET=12;
+08780 TERMOFFSET=20;
+08800 ()+02*) ()+12*)
+08850 (*+13()
+08851 (*-05()
+08852 LFMOFFSET = 0;
+08853 PFMOFFSET = 4;
+08854 PMOFFSET = 8;
+08855 LMOFFSET = 12;
+08856 TERMOFFSET = 20;
+08857 ()-05*)
+08858 (*+05()
+08900 LFMOFFSET = 0 ; (* OFFSETS WITHIN A FILE *)
+08950 PFMOFFSET = 2 ;
+09000 PMOFFSET = 4 ;
+09050 LMOFFSET = 6 ;
+09100 TERMOFFSET = 10 ;
+09101 ()+05*)
+09150 ()+13*)
+09155 (*+01() BUFFOFFSET=32; ()+01*) (*OFFSET OF THE ACTUAL BUFFER WITHIN A FETROOM *)
+09160 (*+02() BUFFOFFSET=18; ()+02*)
+09200 (**)
+09250 (*************************)
+09300 (* ENVIRONMENT ENQUIRIES *)
+09350 (*************************)
+09400 (**)
+09450 ERRORCHAR='*';
+09500 (*-50() MAXABSCHAR=127; ()-50*)
+09550 (*+50() MAXABSCHAR=63; ()+50*)
+09600 (*+11()
+09650 BITSWIDTH=60;
+09700 BYTESWIDTH=10;
+09750 MINBOUND=-4194303;
+09800 MAXBOUND=+4194303;
+09810 HIOFFSET=377377B;
+09850 INTWIDTH=16;
+09900 REALWIDTH=16;
+09950 EXPWIDTH=3;
+10000 INTSPACE=17; (*INTWIDTH+1*)
+10050 REALSPACE=23; (*REALWIDTH+EXPWIDTH+4*)
+10100 COMPLSPACE=48; (*2*REALWIDTH+2*EXPWIDTH+10*)
+10150 MAXINT=7777777777777777B;
+10200 FAKEPI=17206220773250420551B;
+10250 ()+11*)
+10300 (*+12()
+10350 BITSWIDTH=16;
+10400 BYTESWIDTH=2;
+10450 MINBOUND=-32767;
+10500 MAXBOUND=+32767;
+10550 INTWIDTH=5;
+10600 REALWIDTH=16; (*NEEDS ATTENTION*)
+10650 EXPWIDTH=3;
+10700 INTSPACE=6; (*INTWIDTH+1*)
+10750 REALSPACE=23; (*REALWIDTH+EXPWIDTH+4*)
+10800 COMPLSPACE=48; (*2*REALWIDTH+2*EXPWIDTH+10*)
+10850 MAXINT = 32767;
+10860 HIOFFSET=32511;
+10900 ()+12*)
+10950 (*+13()
+11000 BITSWIDTH = 32 ;
+11050 BYTESWIDTH = 4 ;
+11100 MINBOUND = -2147483647 ;
+11150 MAXBOUND = +2147483647 ;
+11200 INTWIDTH = 10 ;
+11250 REALWIDTH = 16 ;
+11300 EXPWIDTH = 3 ;
+11350 INTSPACE = 11 ;
+11400 REALSPACE = 23 ;
+11450 COMPLSPACE = 48 ;
+11500 MAXINT = 2147483647;
+11505 HIOFFSET=2147483391;
+11510 (*+05() FAKEPI = 1073291771 ; FAKEPI1 = 1413754136 ; ()+05*)
+11550 ()+13*)
+11600 (*+01()
+11650 INTUNDEF=60000000000200400000B;
+11700 MINREALEXP = -294 ;
+11750 MAXREALEXP = 324 ;
+11800 TRUEVAL = -1;
+11850 ()+01*)
+11860 (*+02() MINREALEXP = -10000 ; MAXREALEXP = 10000; TRUEVAL=1; LONGUNDEF=0.0;()+02*)
+11865 (* INTUNDEF IS A VARIABLE IN THE 02 MACHINE (-32768) *)
+11900 (*+03() INTUNDEF=100000B; ()+03*)
+11950 (*+05()
+12000 INTUNDEF= - 2147483647 - 1 ;
+12050 LONGUNDEF = 0.0 ;
+12100 MINREALEXP = -10000 ;
+12150 MAXREALEXP = 10000 ;
+12200 TRUEVAL=1;
+12250 ()+05*)
+12300 (**)
+12350 (**************************************)
+12400 (* ERROR NUMBERS (PROBABLY TEMPORARY) *)
+12450 (**************************************)
+12500 (**)
+12550 RASSIG=1;
+12600 RSEL=2;
+12650 RDEREF=3;
+12700 RASSIGNIL=4;
+12750 RSELNIL=5;
+12800 RDEREFNIL=6;
+12850 IDREL=7;
+12900 RPOWNEG=8;
+12950 RBYTESPACK=9;
+13000 RCLOWER=13; RCUPPER=14; RLWUPB=15;
+13050 RSL1ERROR=16; RSL2ERROR=17; RSLICE=18; RSLICENIL=19;
+13100 RMULASS=20; RROUTIN=21;
+13150 RCHARERROR=22;
+13200 RSCOPE=23; (*THE COMPASS FOR TASSTPT KNOWS THIS*)
+13250 RARG=24;
+13300 RDUMMY=25;
+13350 BADIDF=32;
+13400 NOWRITE=33; NOESTAB=34; POSMIN=35; POSMAX=36;
+13450 NOTOPEN=38; NOREAD=39; NOSET=40;
+13500 NORESET=41; NOSHIFT=43; NOBIN=44;
+13550 NOALTER=45; NOMOOD=46; WRONGMULT=47;
+13600 NODIGIT=49;NOLOGICAL=50;
+13650 NOPHYSICAL=51; WRONGCHAR=52; WRONGVAL=53; SMALLLINE=56;
+13700 (**)
+13750 (*******************)
+13800 (* VARIOUS OFFSETS *)
+13850 (*******************)
+13900 (**)
+13950 (*+01()
+14000 FIRSTIBOFFSET=531B; (*OFFSET OF GLOBAL VARIABLE FIRSTIB*)
+14050 INPUTEFET=264B; (*OFFSET OF FETROOM FOR INPUT*)
+14100 OUTPUTEFET=23B; (*OFFSET OF FETROOM FOR OUTPUT*)
+14150 ()+01*)
+14200 (*+03()
+14250 (*THESE NEED ATTENTION ------------------------------------------------*)
+14300 FIRSTIBOFFSET=531B; (*OFFSET OF GLOBAL VARIABLE FIRSTIB*)
+14350 INPUTEFET=264B; (*OFFSET OF FETROOM FOR INPUT*)
+14400 OUTPUTEFET=23B; (*OFFSET OF FETROOM FOR OUTPUT*)
+14450 ()+03*)
+14500 (*+05()
+14550 (* THESE NEED ATTENTION ----------------------------------------------*)
+14600 FIRSTIBOFFSET = 0 ; (* OFFSET OF GLOBAL VARIABLE FIRSTIB *)
+14750 ()+05*)
+14800 (*-05() (*-02() MAXSIZE=110B; (*MAXIMUM SIZE OF NONSTOWED OBJECT - MUST BE < 1ST PROGRAM ADDRESS*) ()-02*) ()-05*)
+14810 (*+02() MAXSIZE = 16; (* MAXIMUM SIZE OF NONSTOWED OBJECT - MUST BE < FIRST DATA ADDRESS *) ()+02*)
+14850 (*+05() MAXSIZE = 8 ; (* MAXIMUM SIZE OF NONSTOWED OBJECT - MUST BE < FIRST DATA ADDRESS *) ()+05*)
+14900 (*+11()
+14950 RECOFFSET=0; (*OFFSET OF RECGEN WITHIN RANGEBLOCK*)
+15000 (*-41()
+15050 IBCONST = 10;
+15100 RGCONST = 4 ;
+15150 ()-41*)
+15200 ()+11*)
+15250 (*+12() (*-02()
+15300 RECOFFSET=2; (*OFFSET OF RECGEN WITHIN RANGEBLOCK*)
+15350 (*-41()
+15400 IBCONST = 18;
+15450 RGCONST = 6 ;
+15500 ()-41*) ()-02*)
+15505 (*+02() (*+19()
+15510 RECOFFSET=6; (*OFFSET OF RECGEN WITHIN A RANGEBLOCK*)
+15515 (*+41()
+15520 IBCONST = -12;
+15525 RGCONST = -20;
+15527 ()+41*)
+15529 (*-41() (*EDUCATED GUESSES*)
+15530 IBCONST = 12;
+15533 RGCONST = 20;
+15535 ()-41*) ()+19*)
+15537 (*-19() (*LESS EDUCATED GUESSES*)
+15539 RECOFFSET=4;
+15541 (*+41()
+15542 IBCONST = -8;
+15543 RGCONST = -12;
+15544 ()+41*)
+15546 (*-41()
+15547 IBCONST = 8;
+15548 RGCONST = 12;
+15549 ()-41*) ()-19*)
+15550 ()+02*)
+15560 ()+12*)
+15600 (*+13()
+15700 (*-41()
+15750 IBCONST = 20 ;
+15800 RGCONST = 24 ;
+15850 ()-41*)
+15900 (*+41()
+15901 (*+05()
+15650 RECOFFSET = 4 ; (* OFFSET OF RECGEN WITHIN RANGEBLOCK *)
+15950 IBCONST = -12 ;
+16000 RGCONST = -12 ;
+16001 ()+05*)
+16002 (*-05()
+16003 RECOFFSET = 8;
+16005 IBCONST=-20;
+16006 RGCONST=-24;
+16007 ()-05*)
+16050 ()+41*)
+16100 ()+13*)
+16150 (*+01() PARAMOFFSET = 0 ; DLOFFSET = +1 ; ()+01*)
+16160 (*+02() PARAMOFFSET = (*+12() -14 ()+12*) (*+13() -16 ()+13*);
+16170 DLOFFSET = (*+12() (*+19() -8 ()+19*) (*-19() -4 ()-19*) ()+12*) (*+13() -8 ()+13*) ; ()+02*)
+16200 (*+05() PARAMOFFSET = -12 ; DLOFFSET = -6 ; ()+05*)
+16250 (**)
+16300 (**********************)
+16350 (* TRANSPUT CONSTANTS *)
+16400 (**********************)
+16450 (*+01()
+16500 FORREAD = 123B ; FORWRITE = 123B ; ONLINE = 10B ;
+16550 ()+01*)
+16560 (*+02()
+16570 FORREAD = 1 ; FORWRITE = 2 ; ONLINE = 0 ;
+16580 DATAINBUF = 4 ; EOLINTEXTFIL = 8 ; EXTERNFIL = 32 ; STATICNAME = 64 ;
+16590 ()+02*)
+16600 (*+05()
+16650 FORREAD = 1 ; FORWRITE = 2 ; ONLINE = 0 ;
+16700 DATAINBUF = 4 ; EOLINTEXTFIL = 8 ; EXTERNFIL = 32 ; STATICNAME = 64 ;
+16750 ()+05*)
+16800 (**)
+16850 TYPE (* TYPE TYPE TYPE TYPE TYPE TYPE TYPE TYPE *)
+16900 (**)
+16950 SEVERAL = 0..10;
+17000 (*-01() ALFA = PACKED ARRAY [ 1..10 ] OF CHAR ; ()-01*)
+17050 (**)
+17100 ACCURATEPI = RECORD
+17150 CASE SEVERAL OF
+17160 (*-01() (*-05() 0: (); ()-05*) ()-01*)
+17200 (*+01() 0: (FAKEPI:INTEGER); ()+01*)
+17210 (*+05() 0: ( FAKEPI, FAKEPI1: INTEGER ) ; ()+05*)
+17250 1: (ACTUALPI:REAL);
+17260 2,3,4,5,6,7,8,9,10: ();
+17300 END;
+17350 (**)
+17400 (******************)
+17450 (* ALGOL 68 MODES *)
+17500 (******************)
+17550 (*+01() A68INT=INTEGER; A68LONG = RECORD V1: INTEGER; V2: INTEGER END; ()+01*)
+17600 (*+02()
+17650 (*+12() A68INT=INTEGER; A68LONG=REAL; ()+12*)
+17655 (*+13() A68INT=INTEGER; A68LONG=REAL; ()+13*)
+17700 ()+02*)
+17750 (*+03() A68INT=INTEGER; A68LONG=REAL; ()+03*)
+17800 (*+04() A68INT=LONG; A68LONG=LONG; ()+04*)
+17850 (*+05() A68INT = INTEGER ; A68LONG = REAL ; ()+05*)
+17900 (**)
+17950 (*+01() ASPROC = INTEGER; (*SCALAR TYPE TO ENCOMPASS A PASCAL PROCEDURE PARAMETER*) ()+01*)
+18000 (*+02() (*+12() (*-19() ASPROC = LONG; ()-19*)
+18005 (*+19() ASPROC = REAL; ()+19*) ()+12*)
+18010 (*+13() ASPROC = REAL; ()+13*) ()+02*)
+18050 (*+03() ASPROC = INTEGER; ()+03*)
+18100 (*+04() ASPROC = INTEGER; ()+04*)
+18150 (*+05() ASPROC = REAL ; ()+05*)
+18200 (**)
+18250 (**************************************)
+18300 (* SIZE OF FIELDS IN OBJECTS *)
+18350 (**************************************)
+18400 (**)
+18450 (*+11()
+18500 PCOUNTRANGE=0..8191;
+18550 CCOUNTRANGE=0..4095;
+18600 OFFSETRANGE=-4095..4095;
+18650 SIZERANGE=0..4095;
+18700 DEPTHRANGE=0..4095;
+18750 ELSRANGE=0..377777B;
+18800 OFFSETPCOUNT=0..33554431;
+18850 CHAN=0..377777B;
+18900 BYTE=0..63;
+18950 ()+11*)
+19000 (*+12() (*+03()
+19050 PCOUNTRANGE=0..2047;
+19100 CCOUNTRANGE=0..511;
+19150 OFFSETRANGE=-255..255;
+19200 SIZERANGE=0..511;
+19250 DEPTHRANGE=0..127;
+19300 ELSRANGE=INTEGER;
+19350 OFFSETPCOUNT=INTEGER;
+19400 CHAN=ASPROC; (*MUST BE A GOOD IMITATION OF A PROCEDURE*)
+19440 BYTE=0..255;
+19450 ()+03*)
+19460 (*+02()
+19465 PCOUNTRANGE=0..2047;
+19467 CCOUNTRANGE=0..511;
+19469 OFFSETRANGE=INTEGER;
+19471 SIZERANGE=0..511;
+19475 DEPTHRANGE=0..255;
+19477 ELSRANGE=INTEGER;
+19479 OFFSETPCOUNT=INTEGER;
+19481 CHAN=ASPROC; (*MUST BE A GOOD IMITATION OF A PROCEDURE*)
+19483 BYTE=0..255;
+19499 ()+02*)
+19500 ()+12*)
+19550 (*+13()
+19600 PCOUNTRANGE = 0..32767 ;
+19650 CCOUNTRANGE = 0..32767 ;
+19700 OFFSETRANGE =-127..127;
+19750 SIZERANGE = 0..255;
+19800 DEPTHRANGE = 0..255 ;
+19850 ELSRANGE = INTEGER ;
+19900 OFFSETPCOUNT = INTEGER ;
+19950 CHAN = ASPROC ; (* MUST BE A GOOD IMITATION OF A PROCEDURE *)
+20000 BYTE = 0..255 ;
+20050 ()+13*)
+20100 BOUNDSRANGE=MINBOUND..MAXBOUND;
+20150 VECCHARS = PACKED ARRAY [1..1000] OF CHAR ;
+20200 (**)
+20250 (**********************)
+20300 (* POINTERS *)
+20350 (**********************)
+20400 (**)
+20445 (*FOR MANIPULATING INVOCATION BLOCK POINTERS*)
+20450 IPOINT = (*+12() (*-19()INTEGER()-19*) (*+19()LONG()+19*) ()+12*) (*+13() INTEGER ()+13*) ;
+20500 PROCPOINT = ^PROCBLOCK;
+20550 DPOINT = ^DEEBLOCK;
+20600 UNDRESSP = ^UNDRESS;
+20650 OBJECTP = ^OBJECT;
+20700 OBJECTPP = ^OBJECTP;
+20750 INTPOINT = ^INTEGER;
+20800 CHARPOINT = ^CHAR;
+20850 (**)
+20900 (**********************)
+20950 (* TRANSPUT *)
+21000 (**********************)
+21050 (**)
+21100 (*+05()
+21150 CFILE = PACKED RECORD
+21200 PTR : ^ CHAR ;
+21250 CNT : INTEGER ;
+21300 BASE : ^ CHAR ;
+21350 FLAG : 0..32767 ;
+21400 FILEDES : BYTE
+21450 END ;
+21460 PCFILE = ^CFILE;
+21500 ()+05*)
+21550 (**)
+21600 STATUSFIELD=(OPENED, LINEOVERFLOW, PAGEOVERFLOW, PFE, LFE, NOTINITIALIZED, NOTRESET,
+21650 READMOOD, WRITEMOOD, CHARMOOD, BINMOOD, LAZY, NOTSET, CARRIAGE, STARTUP);
+21700 POSSFIELD=(RESETPOSS, SETPOSS, GETPOSS, PUTPOSS, BINPOSS, ESTABPOSS, ASSPOSS);
+21750 FETROOM = PACKED RECORD (*THE OBJECT CREATED BY THE PASCAL SYSTEM FOR A PASCAL FILE*)
+21800 (*+01()
+21850 LINECOUNTER: INTEGER;
+21900 CHARBUFFER: ARRAY [1..10] OF INTEGER;
+21950 SENTINEL: INTEGER;
+22000 BUFELPTR: INTEGER;
+22050 EOFB: 0..3B; DISP: 0..177B; RMSTUFF: 0..77777777777B; LRL: 0..777777B;
+22100 (*-52()
+22150 LFN: PACKED ARRAY [1..7] OF CHAR; STATUS: 0..777B;
+22200 DT: PACKED ARRAY [1..2] OF CHAR; FILL1: 0..17777777777B; FIRST: ^INTEGER;
+22250 FILL2: 0..177777777777777B; INN: ^INTEGER;
+22300 FILL3: 0..177777777777777B; OUT: ^INTEGER;
+22350 FILL4: 0..177777777777777B; LIMIT: ^INTEGER;
+22400 RESTOFFET: ARRAY [1..13] OF INTEGER;
+22450 ()-52*)
+22500 (*+52()
+22550 FILL1: 0..37B; BUFLGT: 0..1777777B; BUFADR: 0..777777B; BUFEND: 0..777777B;
+22600 OUT: INTEGER;
+22650 LFN: PACKED ARRAY [1..7] OF CHAR; STATUS: 0..777B;
+22700 RESTOFFIT: ARRAY [1..15] OF INTEGER;
+22750 ()+52*)
+22800 BUFFER: ARRAY [0..128] OF INTEGER;
+22850 ()+01*)
+22855 (*+02()
+22860 PTR: ^CHAR; (* THE POINTER F^ ,POINTS INTO BUFADR *)
+22862 FLAGS: INTEGER; (* VARIOUS FLAGS USED BY PC RUNTIME SYSTEM *)
+22864 FNAME: ^CHAR; (* THE FILE NAME, SHOULD REALLY BE STRING *)
+22866 UFD: INTEGER; (* UNIX FILE DESCRIPTOR *)
+22868 SIZE: INTEGER; (* THE ELEMENT SIZE *)
+22870 COUNT: INTEGER; (* NUMBER OF BYTES LEFT IN BUFFER *)
+22872 BUFLEN: INTEGER;(* EFFECTIVE LENGTH OF BUFFER *)
+22874 BUFADR: PACKED ARRAY [1..512] OF CHAR; (* THE I/O BUFFER *)
+22876 (* THE LAST LINE PRESUMES ONLY FILE OF CHAR ALLOWED IN ALGOL68S *)
+22878 (* THUS SIZE WILL ALWAYS BE 1, THESE NEED CHANGING IF THIS IS NOT TRUE *)
+22880 ()+02*)
+22900 (*+03()
+22950 FILENUMBER: INTEGER;
+23000 EOFFLAG: INTEGER;
+23050 BUFFERSIZE: INTEGER;
+23100 BLOCKNUMBER: INTEGER;
+23150 BLOCKSLEFT: INTEGER;
+23200 FILESTATUS: INTEGER;
+23250 EOLFLAG: INTEGER;
+23300 CURRBYTE: INTEGER;
+23350 CURRLIMIT: INTEGER;
+23400 PASBUFVAR: INTEGER;
+23450 BUFFER: ARRAY [0..255] OF INTEGER;
+23500 ()+03*)
+23550 (*+05()
+23600 XOBJ: CHARPOINT ;
+23650 XFILE: PCFILE ;
+23700 XFLAG: INTEGER ;
+23750 XOBJSIZE: INTEGER ;
+23800 XBUF: CHAR ;
+23850 ()+05*)
+23900 END ;
+23950 FETROOMP=^FETROOM;
+24000 STATUSSET=SET OF STATUSFIELD;
+24050 POSSSET=SET OF POSSFIELD;
+24100 (*+01() LFNTYPE = ALFA ; ()+01*)
+24150 (*-01() LFNTYPE = OBJECTP ; (* ACTUALLY A STRING *) ()-01*)
+24200 (*-01() TERMSET=SET OF CHAR; ()-01*)
+24250 (*+01() TERMSET=SET OF ':'..'<'; ()+01*)
+24300 (*-01() FYL = TEXT; ()-01*)
+24350 (*+01() FYL = SEGMENTED FILE OF CHAR; ()+01*)
+24400 INTSTR = PACKED ARRAY [1..INTSPACE] OF CHAR;
+24450 REASTR = PACKED ARRAY [1..REALSPACE] OF CHAR;
+24500 CMPXSTR= PACKED ARRAY [1..COMPLSPACE] OF CHAR;
+24550 GETBUFTYPE=PACKED ARRAY [0..199] OF CHAR; (*FOR INPUTTING STRINGS - SEE GETT*)
+24600 MINT = (*+01()INTEGER()+01*) (*+02()REAL()+02*) (*+05()REAL()+05*) ;
+24650 (*A MODE WHOSE VALUES ARE THE NON-NEGATIVE INTEGERS UP TO 10*POWOF2.
+24700 THE OPERATIONS OF ADDITION, SUBTRACTION, AND MULTIPLICATION BY
+24750 10 AND BY INTEGRAL POWERS OF 2 ARE ASSUMED TO WORK*)
+24800 (**)
+24850 (**********************)
+24900 (* SORTS *)
+24950 (**********************)
+25000 (**)
+25050 STRUCTYPE=(
+25100 STRING, (*MUST BE FIRST BECAUSE THE COMPILER KNOWS ABOUT IT*)
+25150 ROUTINE, (*THE COMPASS CODE FOR CALL KNOWS ABOUT THIS*)
+25200 REFSLN, (*THE COMPASS CODE FOR TRIMS KNOWS ABOUT THIS*)
+25250 REFN, (*THE COMPASS FOR NASSTPT KNOWS ABOUT THIS *)
+25300 RECN,
+25400 REF1,
+25450 REF2,
+25500 CREF,
+25550 STRUCT,
+25600 IELS,
+25650 MULT,
+25700 REFSL1,
+25750 REFR,
+25800 RECR,
+25850 UNDEF,
+25900 NILL,
+25950 PASCROUT,
+26000 AFILE,
+26050 COVER);
+26100 (**)
+26150 (*********************************)
+26200 (* THE THING *)
+26250 (*********************************)
+26300 (**)
+26350 PDS = PACKED RECORD
+26400 UI, LI: BOUNDSRANGE;
+26450 (*+01() FILL: 0..3B; ()+01*)
+26500 DI: SIZERANGE
+26550 END;
+26600 (**)
+26650 UNDRESS = RECORD
+26700 CASE SEVERAL OF
+26750 0: (FIRSTPTR: OBJECTP; FILL0: INTEGER);
+26800 1: (FIRSTWORD: INTEGER);
+26850 2: (FIRSTINT: A68INT);
+26900 3: (FIRSTLONG: A68LONG);
+26950 4: (FIRSTREAL: REAL);
+27000 5: (FIRSTTERMSET: TERMSET) ;
+27050 6 , 7 , 8 , 9 , 10 : () ;
+27100 END;
+27150 (**)
+27200 (*+11()
+27250 OBJECT = PACKED RECORD
+27300 CASE SEVERAL OF
+27350 0: (FIRSTPTR: OBJECTP; FILL0: INTEGER);
+27400 1: (FIRSTWORD: INTEGER;
+27410 SECONDWORD: INTEGER);
+27450 2: (PCOUNT: PCOUNTRANGE;
+27500 CASE SORT: STRUCTYPE OF
+27550 STRUCT:
+27650 ( OSCOPE: DEPTHRANGE;
+27700 LENGTH: SIZERANGE;
+27725 DBLOCK: DPOINT;
+27750 RE: REAL;
+27800 IM: REAL);
+27850 MULT:
+27950 (OSCOPEM: DEPTHRANGE;
+28000 FILLM1: SIZERANGE;
+28025 PVALUE: OBJECTP;
+28037 IHEAD: OBJECTP; (*1*)
+28040 FILLM5: 0..1;
+28050 FILLM2: ELSRANGE;
+28150 FILLM3:OBJECTP;
+28200 FILLM4: OBJECTP; (*2*)
+28250 BPTR: OBJECTP;
+28300 FPTR: OBJECTP; (*AT BOTTOM OF WORD TO MATCH RECEGN*)
+28350 LBADJ: BOUNDSRANGE; (*3*) (*(DIST FROM EL[0,...,0] TO 1ST REAL EL) - ELSCONST*)
+28400 MDBLOCK: DPOINT;
+28450 SIZE: DEPTHRANGE;
+28500 ROWS: 0..7;
+28550 DESCVEC: ARRAY [0..7] OF PDS); (*4*)
+28600 IELS:
+28700 (OSCOPEE: DEPTHRANGE;
+28750 CCOUNT: CCOUNTRANGE;
+28775 DBLOCKE: DPOINT;
+28850 IHEADE: OBJECTP; (*1*)
+28860 FILLE2: 0..1;
+28900 D0: ELSRANGE;
+28925 FILLE1: OBJECTP (*BOTTOM OF 1*) );
+28950 ROUTINE:
+29050 (OSCOPER: DEPTHRANGE;
+29100 FILLR: SIZERANGE;
+29125 PROCBL: PROCPOINT;
+29150 ENVCHAIN: IPOINT; (*1*)
+29200 FILLR1: INTEGER (*2*) );
+29250 PASCROUT:
+29350 ( OSCOPEP: DEPTHRANGE;
+29400 PPARAMS: SIZERANGE ;
+29405 FILLPR: OBJECTP ;
+29410 PPROCBL: ASPROC (*1*) );
+29450 REF1:
+29550 ( OSCOPERF1: DEPTHRANGE;
+29600 FILLRF11: SIZERANGE;
+29605 PVALUEF1: DPOINT;
+29610 FILLRF12: OBJECTP; (*1*)
+29615 FILLRF13: 0..1;
+29620 OFFSETRF1: ELSRANGE;
+29630 ANCESTORF1: OBJECTP;
+29650 VALUE: A68INT (*2*) );
+29700 REF2:
+29800 ( OSCOPERF2: DEPTHRANGE;
+29850 FILLRF21: SIZERANGE;
+29855 PVALUEF2: DPOINT;
+29860 FILLRF22: OBJECTP; (*1*)
+29865 FILLRF23: 0..1;
+29870 OFFSETRF2: ELSRANGE;
+29880 ANCESTORF2: OBJECTP;
+29900 LONGVALUE: A68LONG ); (*2*)
+29950 REFN:
+30050 (OSCOPEFN: DEPTHRANGE;
+30100 FILLFN: SIZERANGE;
+30125 PVALUEFN: OBJECTP;
+30130 FILLFN1:OBJECTP; (*1*)
+30132 FILLFN2: 0..1;
+30135 OFFSETFN:ELSRANGE;
+30140 ANCESTORFN:OBJECTP);
+30150 CREF:
+30250 (OSCOPECF: DEPTHRANGE;
+30300 FILLCREF: SIZERANGE ;
+30325 PVALUECF : DPOINT ;
+30330 IPTR :UNDRESSP; (*1*)
+30332 FILLCF1: 0..1;
+30335 OFFSETCF:ELSRANGE;
+30350 ANCESTORCF: OBJECTP ) ;
+30400 REFR:
+30500 ( OSCOPERR: DEPTHRANGE;
+30550 CCOUNTR: CCOUNTRANGE;
+30575 PVALUERR: OBJECTP;
+30650 FILLRR0: OBJECTP; (*1*)
+30660 FILLRR4: 0..1;
+30700 FILLRR1: ELSRANGE;
+30705 ANCESTOR: OBJECTP;
+30710 FILLRR2: OBJECTP; (*2*)
+30750 FILLRR3: OBJECTP;
+30760 LBADJRR: BOUNDSRANGE; (*3*)
+30768 MDBLOCKRR: DPOINT;
+30776 SIZERR: DEPTHRANGE;
+30784 ROWSNRR:0..7;
+30792 DESCVECRR:ARRAY [0..7] OF PDS); (*4*)
+30800 REFSL1:
+30900 (OSCOPEL: DEPTHRANGE;
+30950 CCOUNTL: CCOUNTRANGE;
+30975 DBLOCKL: DPOINT;
+31050 FILLL2: OBJECTP; (*1*)
+31060 FILLL1: 0..1;
+31100 OFFSET: ELSRANGE;
+31125 ANCSTRL: OBJECTP;
+31150 FILLL3: INTEGER (*2*) );
+31200 REFSLN:
+31300 (OSCOPEN: DEPTHRANGE;
+31350 CCOUNTN: CCOUNTRANGE;
+31375 FILLN4: OBJECTP;
+31450 FILLN: OBJECTP; (*1*)
+31460 FILLN5: 0..1;
+31500 FILLN0: ELSRANGE;
+31525 ANCSTRN: OBJECTP;
+31550 FILLN1: OBJECTP; (*2*)
+31600 FILLN2: OBJECTP;
+31650 FILLN3: OBJECTP;
+31700 LBADJN: BOUNDSRANGE; (*3*)
+31750 MDBLOCKN: DPOINT;
+31800 SIZEN: DEPTHRANGE;
+31850 ROWSN: 0..7;
+31900 DESCVECN: ARRAY [0..7] OF PDS); (*4*)
+32300 RECR:
+32400 ( OSCOPECR: DEPTHRANGE;
+32450 CCOUNTCR: CCOUNTRANGE;
+32475 PVALUECR: OBJECTP;
+32550 FILLCR0: OBJECTP; (*1*)
+32560 FILLCR3: 0..1;
+32600 FILLCR1: ELSRANGE;
+32625 ANCSTRCR: OBJECTP;
+32650 FILLCR2: OBJECTP; (*2*)
+32700 PREV: OBJECTP;
+32750 NEXT: OBJECTP;
+32800 LBADJCR: BOUNDSRANGE; (*3*)
+32810 MDBLOCKCR: DPOINT;
+32820 SIZECR: DEPTHRANGE;
+32830 ROWSNCR:0..7;
+32840 DESCVECCR:ARRAY [0..7] OF PDS); (*4*)
+32850 RECN:
+32950 ( OSCOPECN: DEPTHRANGE;
+33000 FILLCN: SIZERANGE;
+33025 PVALUECN :OBJECTP;
+33050 FILLCN1: OBJECTP; (*1*)
+33070 FILLCN4: 0..1;
+33080 OFFSETCN:ELSRANGE;
+33090 ANCESTORCN:OBJECTP;
+33100 FILLCN2: OBJECTP; (*2*)
+33150 PREVCN: OBJECTP;
+33200 NEXTCN: OBJECTP;
+33250 FILLCN3: INTEGER); (*3*)
+33300 STRING:
+33400 ( FILLST1: DEPTHRANGE;
+33450 STRLENGTH: SIZERANGE;
+33475 FILLST: DPOINT;
+33500 CHARVEC: VECCHARS (*1*) );
+33550 UNDEF, NILL:
+33650 ( OSCOPEUN: DEPTHRANGE;
+33700 STRLNGUN: SIZERANGE;
+33705 PVALUEUN: OBJECTP;
+33710 FILLUN1: OBJECTP; (*1*)
+33715 FILLUN2: 0..1;
+33725 OFFSETUN: ELSRANGE;
+33750 ANCESTORUN: OBJECTP;
+33800 FILLUN3: OBJECTP; (*2*)
+33850 FILLUN4: OBJECTP;
+33860 FILLUN5: OBJECTP;
+33870 FILLUN6: BOUNDSRANGE; (*3*)
+33880 FILLUN7: DPOINT;
+33890 FILLUN8: DEPTHRANGE;
+33895 ROWSUN: 0..7;
+33900 DESCVECUN: ARRAY [0..7] OF PDS); (*4*)
+33950 AFILE: (*ACTUALLY, AFILES WILL BE STORED AS STRUCTS, BUT THESE FIELD SELECTORS SHOULD WORK*)
+34050 ( OSCOPEF: DEPTHRANGE;
+34100 LENGTHF: SIZERANGE;
+34125 DBLOCKF: DPOINT;
+34150 FILLF1: 0..77777777777777B; (*1*)
+34200 LOGICALFILEMENDED: OBJECTP;
+34250 FILLF2: 0..77777777777777B; (*2*)
+34300 PHYSICALFILEMENDED: OBJECTP;
+34350 FILLF3: 0..77777777777777B; (*3*)
+34400 PAGEMENDED: OBJECTP;
+34450 FILLF4: 0..77777777777777B; (*4*)
+34500 LINEMENDED: OBJECTP;
+34550 FILLF5: 0..77777777777777B; (*5*)
+34600 PCOVER: OBJECTP;
+34650 TERM: TERMSET; (*6*)
+34700 TERM1: TERMSET); (*7*)
+34750 COVER:
+34850 ( OSCOPEV: DEPTHRANGE;
+34900 FILLV: SIZERANGE;
+34925 CHANNEL: CHAN;
+34950 STATUS: STATUSSET;
+35000 POSSIBLES: POSSSET;
+35050 COFCPOS, LOFCPOS, POFCPOS: INTEGER;
+35100 CHARBOUND, LINEBOUND, PAGEBOUND: INTEGER;
+35150 DOPUTS,DOGETS,DONEWLINE,DONEWPAGE,DOSET,DORESET: ASPROC;
+35200 CASE ASSOC: BOOLEAN OF
+35250 FALSE: (FILLC: 0..77777777777777B;
+35300 BOOK:FETROOMP);
+35350 TRUE: (ASSREF:OBJECTP;
+35400 CPOSELS:ELSRANGE;
+35450 OFFSETDI:SIZERANGE));
+35500 );
+35550 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+35600 END;
+35650 ()+11*)
+35700 (*+12()
+35720 (*+03()
+35750 OBJECT = PACKED RECORD
+35800 CASE SEVERAL OF
+35850 0: (FIRSTPTR: OBJECTP; FILL0: INTEGER);
+35900 1: (FIRSTWORD: INTEGER);
+35950 2: (PCOUNT: PCOUNTRANGE;
+36000 SORT: STRUCTYPE;
+36050 CASE STRUCTYPE OF
+36100 STRUCT:
+36150 (OSCOPE: DEPTHRANGE;
+36200 LENGTH: SIZERANGE;
+36250 DBLOCK: DPOINT;
+36300 RE: REAL;
+36350 IM: REAL);
+36400 MULT:
+36450 (SCOPEM: DEPTHRANGE;
+36500 FILLM1: CCOUNTRANGE;
+36550 PVALUEM: OBJECTP;
+36600 D0: ELSRANGE;
+36650 ELS: OBJECTP;
+36700 IHEAD: OBJECTP;
+36750 BPTR: OBJECTP;
+36800 FPTR: OBJECTP;
+36850 LBADJ: BOUNDSRANGE; (*(DIST FROM EL[0,...,0] TO 1ST REAL EL) - ELSCONST*)
+36900 MDBLOCK: DPOINT;
+36950 SIZE: SIZERANGE;
+37000 ROWS: 0..7;
+37050 DESCVEC: ARRAY [0..7] OF PDS);
+37100 IELS:
+37150 (OSCOPEE: DEPTHRANGE;
+37200 CCOUNT: CCOUNTRANGE;
+37250 DBLOCKE: DPOINT;
+37300 FILLE2: OBJECTP;
+37350 D0E: ELSRANGE; );
+37400 ROUTINE:
+37450 (SCOPER: DEPTHRANGE;
+37500 FILLR: SIZERANGE;
+37550 PROCBL: PROCPOINT;
+37600 ENVCHAIN: IPOINT);
+37650 PASCROUT:
+37700 (SCOPEP: DEPTHRANGE;
+37750 PPARAMS: SIZERANGE;
+37800 PPROCBL: ASPROC );
+37850 REF1:
+37900 (SCOPERF1: DEPTHRANGE;
+37950 FILLRF11: SIZERANGE;
+37955 PVALUERF1: OBJECTP;
+37957 FILLRF12: ELSRANGE;
+37960 ANCESTRF1: OBJECTP;
+38000 VALUE: A68INT);
+38050 REF2:
+38100 (SCOPERF2: DEPTHRANGE;
+38150 FILLRF21: SIZERANGE;
+38160 PVALUERF2: OBJECTP;
+38170 FILLRF22: ELSRANGE;
+38180 ANCESTRF2: OBJECTP;
+38200 LONGVALUE: A68LONG);
+38250 REFN:
+38300 (SCOPEFN: DEPTHRANGE;
+38350 FILLFN: SIZERANGE;
+38400 PVALUE: OBJECTP;
+38410 OFFSETFN: ELSRANGE;
+38420 ANCESTFN: OBJECTP);
+38450 CREF:
+38500 (SCOPEC: DEPTHRANGE;
+38550 FILLCREF: SIZERANGE;
+38600 PVALUEC : OBJECTP ;
+38605 FILLC2: ELSRANGE;
+38610 ANCESTCREF: OBJECTP ;
+38650 IPTR: UNDRESSP);
+38700 REFR:
+38750 (SCOPERR: DEPTHRANGE;
+38800 CCOUNTR: CCOUNTRANGE;
+38850 PVALUER: OBJECTP;
+38900 FILLRR1: ELSRANGE;
+38950 ANCESTOR: OBJECTP;
+39000 FILLRR2: OBJECTP;
+39005 FILLRR3: OBJECTP;
+39010 FILLRR4: OBJECTP;
+39015 LBADJR: BOUNDSRANGE;
+39020 MDBLOCKR: DPOINT;
+39025 SIZER: SIZERANGE;
+39030 ROWSR: 0..7;
+39035 DESCVECR: ARRAY [0..7] OF PDS);
+39050 REFSL1:
+39100 (SCOPEL: DEPTHRANGE;
+39150 CCOUNTL: CCOUNTRANGE;
+39200 DBLOCKL: DPOINT;
+39250 OFFSET: ELSRANGE;
+39300 ANCSTRL: OBJECTP);
+39400 REFSLN:
+39450 (SCOPEN: DEPTHRANGE;
+39500 CCOUNTN: CCOUNTRANGE;
+39550 FILLN0: OBJECTP;
+39600 FILLN1: ELSRANGE;
+39650 ANCSTRN: OBJECTP;
+39700 FILLN15: OBJECTP;
+39750 FILLN2: OBJECTP;
+39800 FILLN3: OBJECTP;
+39850 LBADJN: BOUNDSRANGE;
+39900 MDBLOCKN: DPOINT;
+39950 SIZEN: SIZERANGE;
+40000 ROWSN: 0..7;
+40050 DESCVECN: ARRAY [0..7] OF PDS);
+40400 RECR:
+40450 (SCOPECR: DEPTHRANGE;
+40500 CCOUNTCR: CCOUNTRANGE;
+40550 PVALUECR: OBJECTP;
+40600 FILLCR1: ELSRANGE;
+40650 ANCSTRCR: OBJECTP;
+40700 FILLCR2: OBJECTP;
+40750 PREV: OBJECTP;
+40800 NEXT: OBJECTP;
+40810 LBADJCR: BOUNDSRANGE;
+40820 MDBLOCKCR: DPOINT;
+40830 SIZECR: SIZERANGE;
+40840 ROWSCR: 0..7;
+40845 DESCVECCR: ARRAY [0..7] OF PDS);
+40850 RECN:
+40900 (SCOPECN: DEPTHRANGE;
+40950 FILLCN: SIZERANGE;
+41000 PVALUECN :OBJECTP;
+41050 OFFSETCN: ELSRANGE;
+41100 ANCESTCN: OBJECTP;
+41150 FILLCN3: OBJECTP;
+41200 PREVCN: OBJECTP;
+41250 NEXTCN: OBJECTP);
+41300 STRING:
+41350 (FILLST1: DEPTHRANGE;
+41400 STRLENGTH: ELSRANGE;
+41550 CHARVEC: VECCHARS);
+41600 UNDEF, NILL:
+41650 (SCOPEUN: DEPTHRANGE;
+41700 STRLNGUN: ELSRANGE;
+41750 PVALUEUN: OBJECTP;
+41800 OFFSETUN: ELSRANGE;
+41810 ANCESTUN: OBJECTP;
+41850 FILLUN1: OBJECTP;
+41860 FILLUN2: OBJECTP;
+41870 FILLUN3:OBJECTP;
+41880 FILLUN4: BOUNDRANGE;
+41885 FILLUN5: DPOINT;
+41890 FILLUN6: SIZERANGE;
+41895 ROWSUN: 0..7;
+41900 DESCVECUN: ARRAY [0..7] OF PDS);
+41950 AFILE: (*ACTUALLY, AFILES WILL BE STORED AS STRUCTS, BUT THESE FIELD SELECTORS SHOULD WORK*)
+42000 (SCOPEF: DEPTHRANGE;
+42050 LENGTHF: SIZERANGE;
+42100 DBLOCKF: DPOINT;
+42150 LOGICALFILEMENDED: OBJECTP;
+42200 PHYSICALFILEMENDED: OBJECTP;
+42250 PAGEMENDED: OBJECTP;
+42300 LINEMENDED: OBJECTP;
+42350 PCOVER: OBJECTP;
+42400 TERM: TERMSET);
+42450 COVER:
+42500 (SCOPEV: DEPTHRANGE;
+42550 FILLV: SIZERANGE;
+42600 CHANNEL: CHAN;
+42650 STATUS: STATUSSET;
+42700 POSSIBLES: POSSSET;
+42750 COFCPOS, LOFCPOS, POFCPOS: INTEGER;
+42800 CHARBOUND, LINEBOUND, PAGEBOUND: INTEGER;
+42850 DOPUTS,DOGETS,DONEWLINE,DONEWPAGE,DOSET,DORESET: ASPROC;
+42900 CASE ASSOC: BOOLEAN OF
+42950 FALSE: (FILLC: SIZERANGE;
+42955 BOOK:FETROOMP);
+42960 TRUE: (OFFSETDI:SIZERANGE;
+42965 ASSREF:OBJECTP;
+42970 CPOSELS:ELSRANGE) );
+42975 );
+42980 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+42985 END;
+42990 ()+03*)
+43000 (*+02()
+43002 OBJECT = PACKED RECORD
+43004 CASE SEVERAL OF
+43006 0: (FIRSTPTR: OBJECTP; FILL0: INTEGER);
+43008 1: (FIRSTWORD: INTEGER);
+43010 2: (PCOUNT: PCOUNTRANGE;
+43012 SORT: STRUCTYPE;
+43014 CASE STRUCTYPE OF
+43016 STRUCT:
+43018 (OSCOPE: DEPTHRANGE;
+43020 LENGTH: SIZERANGE;
+43022 DBLOCK: DPOINT;
+43024 RE: REAL;
+43026 IM: REAL);
+43028 MULT:
+43030 (SCOPEM: DEPTHRANGE;
+43032 FILLM1: CCOUNTRANGE;
+43034 PVALUEM: OBJECTP;
+43036 D0: ELSRANGE;
+43038 ELS: OBJECTP;
+43040 IHEAD: OBJECTP;
+43042 BPTR: OBJECTP;
+43044 FPTR: OBJECTP;
+43046 LBADJ: BOUNDSRANGE; (*(DIST FROM EL[0,...,0] TO 1ST REAL EL) - ELSCONST*)
+43048 MDBLOCK: DPOINT;
+43050 SIZE: SIZERANGE;
+43052 ROWS: 0..7;
+43054 DESCVEC: ARRAY [0..7] OF PDS);
+43056 IELS:
+43058 (OSCOPEE: DEPTHRANGE;
+43060 CCOUNT: CCOUNTRANGE;
+43062 DBLOCKE: DPOINT;
+43066 D0E: ELSRANGE;
+43067 FILLE: OBJECTP;
+43068 IHEADE: OBJECTP);
+43069 ROUTINE:
+43070 (SCOPER: DEPTHRANGE;
+43072 FILLR: SIZERANGE;
+43074 PROCBL: PROCPOINT;
+43076 ENVCHAIN: IPOINT);
+43078 PASCROUT:
+43080 (SCOPEP: DEPTHRANGE;
+43082 PPARAMS: SIZERANGE;
+43084 PPROCBL: ASPROC );
+43086 REF1:
+43088 (SCOPERF1: DEPTHRANGE;
+43090 FILLRF1: SIZERANGE;
+43091 PVALUER1: OBJECTP;
+43092 ANCESTR1: OBJECTP;
+43093 OFFSETR1: ELSRANGE;
+43094 VALUE: A68INT);
+43095 REF2:
+43096 (SCOPERF2: DEPTHRANGE;
+43098 FILLRF2: SIZERANGE;
+43099 PVALUER2: OBJECTP;
+43100 ANCESTR2: OBJECTP;
+43101 OFFSETR2: ELSRANGE;
+43102 LONGVALUE: A68LONG);
+43103 REFN:
+43104 (SCOPEFN: DEPTHRANGE;
+43106 FILLFN: SIZERANGE;
+43108 PVALUE: OBJECTP;
+43109 ANCESTRN: OBJECTP;
+43110 OFFSETRN: ELSRANGE);
+43111 CREF:
+43112 (SCOPEC: DEPTHRANGE;
+43114 FILLCREF: SIZERANGE;
+43116 PVALUEC : OBJECTP ;
+43117 ANCESTC : OBJECTP ;
+43118 IPTR: UNDRESSP);
+43120 REFR:
+43122 (SCOPERR: DEPTHRANGE;
+43124 CCOUNTR: CCOUNTRANGE;
+43126 PVALUER: OBJECTP;
+43127 ANCESTOR: OBJECTP;
+43128 FILLRR1: ELSRANGE;
+43129 FILLRR2: OBJECTP;
+43130 FILLRR3: OBJECTP;
+43131 FILLRR4: OBJECTP;
+43132 LBADJRR: BOUNDSRANGE;
+43133 MDBLOCKRR: DPOINT;
+43134 SIZERR: SIZERANGE;
+43135 ROWSRR: 0..7;
+43136 DESCVECRR: ARRAY [0..7] OF PDS);
+43137 REFSL1:
+43138 (SCOPEL: DEPTHRANGE;
+43139 CCOUNTL: CCOUNTRANGE;
+43140 DBLOCKL: DPOINT;
+43142 ANCSTRL: OBJECTP;
+43144 OFFSET: ELSRANGE);
+43148 REFSLN:
+43150 (SCOPEN: DEPTHRANGE;
+43152 CCOUNTN: CCOUNTRANGE;
+43154 FILLN1: OBJECTP;
+43156 ANCSTRN: OBJECTP;
+43158 FILLN2: ELSRANGE;
+43160 FILLN3: OBJECTP;
+43162 FILLN4: OBJECTP;
+43164 FILLN5: OBJECTP;
+43166 LBADJN: BOUNDSRANGE;
+43168 MDBLOCKN: DPOINT;
+43170 SIZEN: SIZERANGE;
+43172 ROWSN: 0..7;
+43174 DESCVECN: ARRAY [0..7] OF PDS);
+43176 RECR:
+43178 (SCOPECR: DEPTHRANGE;
+43180 CCOUNTCR: CCOUNTRANGE;
+43182 PVALUECR: OBJECTP;
+43184 ANCSTRCR: OBJECTP;
+43185 FILLCR1: ELSRANGE;
+43186 PREV: OBJECTP;
+43187 NEXT: OBJECTP;
+43188 FILLCR2: OBJECTP;
+43189 LBADJCR: BOUNDSRANGE;
+43190 MDBLOCKCR: DPOINT;
+43191 SIZECR: SIZERANGE;
+43192 ROWSCR: 0..7;
+43193 DESCVECCR: ARRAY [0..7] OF PDS);
+43194 RECN:
+43196 (SCOPECN: DEPTHRANGE;
+43198 FILLCN: SIZERANGE;
+43200 PVALUECN :OBJECTP;
+43202 ANCESTCN: OBJECTP;
+43204 OFFSETCN: ELSRANGE;
+43208 PREVCN: OBJECTP;
+43210 NEXTCN: OBJECTP);
+43212 STRING:
+43214 (FILLST1: DEPTHRANGE;
+43216 STRLENGTH: ELSRANGE;
+43222 CHARVEC: VECCHARS);
+43226 UNDEF, NILL:
+43228 (SCOPEUN: DEPTHRANGE;
+43230 STRLNGUN: ELSRANGE;
+43232 PVALUEUN: OBJECTP;
+43234 ANCESTUN: OBJECTP;
+43236 OFFSETUN: ELSRANGE;
+43238 FILLUN2: OBJECTP;
+43240 FILLUN3: OBJECTP;
+43242 FILLUN4: OBJECTP;
+43244 FILLUN5: BOUNDSRANGE;
+43246 FILLUN6: DPOINT;
+43248 FILLUN7: SIZERANGE;
+43250 ROWSUN: 0..7;
+43252 DESCVECUN: ARRAY [0..7] OF PDS);
+43260 AFILE: (*ACTUALLY, AFILES WILL BE STORED AS STRUCTS, BUT THESE FIELD SELECTORS SHOULD WORK*)
+43262 (SCOPEF: DEPTHRANGE;
+43264 LENGTHF: SIZERANGE;
+43266 DBLOCKF: DPOINT;
+43268 LOGICALFILEMENDED: OBJECTP;
+43270 PHYSICALFILEMENDED: OBJECTP;
+43272 PAGEMENDED: OBJECTP;
+43274 LINEMENDED: OBJECTP;
+43276 PCOVER: OBJECTP;
+43278 TERM: TERMSET);
+43300 COVER:
+43302 (SCOPEV: DEPTHRANGE;
+43304 FILLV: SIZERANGE;
+43306 CHANNEL: CHAN;
+43308 STATUS: STATUSSET;
+43310 POSSIBLES: POSSSET;
+43312 COFCPOS, LOFCPOS, POFCPOS: INTEGER;
+43314 CHARBOUND, LINEBOUND, PAGEBOUND: INTEGER;
+43316 DOPUTS,DOGETS,DONEWLINE,DONEWPAGE,DOSET,DORESET: ASPROC;
+43318 CASE ASSOC: BOOLEAN OF
+43320 FALSE: (FILLC: SIZERANGE;
+43322 BOOK:FETROOMP);
+43324 TRUE: (OFFSETDI:SIZERANGE;
+43326 ASSREF:OBJECTP;
+43328 CPOSELS:ELSRANGE) );
+43330 );
+43350 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+43360 END;
+43370 ()+02*)
+43400 ()+12*)
+43410 (*+13()
+43450 OBJECT = PACKED RECORD
+43500 CASE SEVERAL OF
+43550 0: (FIRSTPTR: OBJECTP; FILL0: INTEGER);
+43600 1: (FIRSTWORD: INTEGER);
+43650 2: (PCOUNT: PCOUNTRANGE;
+43700 SORT: STRUCTYPE;
+43750 CASE STRUCTYPE OF
+43800 STRUCT:
+43850 (OSCOPE: DEPTHRANGE;
+43900 DBLOCK: DPOINT ; (*1*)
+44050 LENGTH: CCOUNTRANGE; (*2*)
+44100 RE: REAL;
+44150 IM: REAL);
+44200 MULT:
+44250 (OSCOPEM: DEPTHRANGE;
+44300 PVALUEM: OBJECTP; (*1*)
+44325 FILLM: ELSRANGE; (*2*)
+44337 IHEAD: OBJECTP; (*3*)
+44350 ROWS: 0..7 ; (*4*)
+44400 SIZE: SIZERANGE ;
+44450 FILLM1: CCOUNTRANGE ;
+44650 BPTR: OBJECTP; (*5*)
+44700 FPTR: OBJECTP; (*6*)
+44750 LBADJ: BOUNDSRANGE; (*7*) (*(DIST FROM EL[0,...,0] TO 1ST REAL EL) - ELSCONST*)
+44800 MDBLOCK: DPOINT; (*8*)
+44850 DESCVEC: ARRAY [0..7] OF PDS);
+44900 IELS:
+44950 (OSCOPEE: DEPTHRANGE;
+45000 DBLOCKE: DPOINT; (*1*)
+45050 D0: ELSRANGE; (*2*)
+45075 IHEADE: OBJECTP; (*3*)
+45100 FILLE: CCOUNTRANGE; (*4*)
+45150 CCOUNT: CCOUNTRANGE ) ;
+45250 ROUTINE:
+45300 (OSCOPER: DEPTHRANGE;
+45350 PROCBL: PROCPOINT; (*1*)
+45400 ENVCHAIN: IPOINT); (*2*)
+45450 PASCROUT:
+45500 (OSCOPEP: DEPTHRANGE;
+45600 PPARAMS: SIZERANGE; (*1*)
+45625 PPROCBL: ASPROC ) ; (*2*)
+45650 REF1:
+45700 (OSCOPERF1: DEPTHRANGE;
+45710 PVALUEF1: OBJECTP; (*1*)
+45720 ANCSTRF1: OBJECTP; (*2*)
+45730 OFFSETF1: ELSRANGE; (*3*)
+45750 VALUE: A68INT); (*4*)
+45800 REF2:
+45850 (SCOPERF2: DEPTHRANGE;
+45866 PVALUEF2: OBJECTP; (*1*)
+45882 ANCSTRF2: OBJECTP; (*2*)
+45890 OFFSETF2: ELSRANGE; (*3*)
+45900 LONGVALUE: A68LONG); (*4*)
+45950 REFN:
+46000 (OSCOPEFN: DEPTHRANGE;
+46050 PVALUE: OBJECTP; (*1*)
+46060 ANCSTRFN: OBJECTP; (*2*)
+46070 OFFSETN: ELSRANGE ) ; (*3*)
+46100 CREF:
+46150 (SCOPEC: DEPTHRANGE;
+46200 PVALUEC : DPOINT ; (*1*)
+46210 ANCSTRC: OBJECTP; (*2*)
+46250 IPTR: UNDRESSP); (*3*)
+46300 REFR:
+46350 (OSCOPERR: DEPTHRANGE;
+46400 PVALUER: OBJECTP; (*1*)
+46410 ANCESTOR: OBJECTP; (*2*)
+46420 FILLRR: INTEGER; (*3*)
+46450 ROWSRR: 0..7 ; (*4*)
+46500 SIZERR: SIZERANGE ;
+46550 CCOUNTR: CCOUNTRANGE ;
+46600 FILLRR2: OBJECTP ; (*5*)
+46700 FILLRR1: OBJECTP ; (*6*)
+46710 LBADJRR: BOUNDSRANGE; (*7*)
+46720 MDBLOCKRR: DPOINT; (*8*)
+46730 DESCVECRR: ARRAY[0..7] OF PDS ) ;
+46750 REFSL1:
+46800 (OSCOPEL: DEPTHRANGE;
+46850 DBLOCKL: DPOINT; (*1*)
+46875 ANCSTRL: OBJECTP; (*2*)
+46885 OFFSET: ELSRANGE; (*3*)
+46900 FILLL: 0..7 ; (*4*)
+46950 FILLL1: SIZERANGE ;
+47000 CCOUNTL: CCOUNTRANGE);
+47200 REFSLN:
+47250 (OSCOPEN: DEPTHRANGE;
+47300 FILLN: OBJECTP; (*1*)
+47325 ANCSTRN: OBJECTP; (*2*)
+47340 FILLN1: INTEGER; (*3*)
+47350 ROWSN: 0..7 ; (*4*)
+47400 SIZEN: SIZERANGE ;
+47450 CCOUNTN: CCOUNTRANGE ;
+47650 FILLN2: OBJECTP; (*5*)
+47700 FILLN3: OBJECTP; (*6*)
+47750 LBADJN: BOUNDSRANGE; (*7*)
+47800 MDBLOCKN: DPOINT; (*8*)
+47850 DESCVECN: ARRAY [0..7] OF PDS);
+48200 RECR:
+48250 (OSCOPECR: DEPTHRANGE;
+48300 PVALUECR: OBJECTP; (*1*)
+48325 ANCSTRCR: OBJECTP; (*2*)
+48340 FILLCR0: INTEGER; (*3*)
+48350 ROWSCR: 0..7 ; (*4*)
+48400 SIZECR: SIZERANGE ;
+48450 CCOUNTCR: CCOUNTRANGE ;
+48650 PREV: OBJECTP; (*5*)
+48700 NEXT: OBJECTP; (*6*)
+48712 LBADJCR: BOUNDSRANGE; (*7*)
+48724 MDBLOCKCR: DPOINT; (*8*)
+48736 DESCVECCR: ARRAY [0..7] OF PDS);
+48750 RECN:
+48800 (OSCOPECN: DEPTHRANGE;
+48850 PVALUECN :OBJECTP; (*1*)
+48860 ANCSTRCN: OBJECTP; (*2*)
+48950 OFFSETCN: ELSRANGE; (*3*)
+49000 FILLCN2: INTEGER; (*4*)
+49100 PREVCN: OBJECTP; (*5*)
+49150 NEXTCN: OBJECTP); (*6*)
+49200 STRING:
+49250 (FILLSTG: DEPTHRANGE;
+49275 FILLSTG1: ARRAY [1..3] OF INTEGER; (*1*)
+49325 FILLSTG2: CCOUNTRANGE; (*4*)
+49350 STRLENGTH: CCOUNTRANGE;
+49400 CHARVEC: VECCHARS); (*5*)
+49450 UNDEF, NILL:
+49500 (OSCOPEUN: DEPTHRANGE;
+49550 PVALUEUN: OBJECTP;
+49560 ANCSTRUN: OBJECTP;
+49570 OFFSETUN: ELSRANGE;
+49580 ROWSUN: 0..7;
+49600 STRLNGUN: CCOUNTRANGE;
+49650 FILLUN: ARRAY [1..4] OF INTEGER;
+49700 DESCVECUN: ARRAY [0..7] OF PDS);
+49750 AFILE: (*ACTUALLY, AFILES WILL BE STORED AS STRUCTS, BUT THESE FIELD SELECTORS SHOULD WORK*)
+49800 (SCOPEF: DEPTHRANGE;
+49850 DBLOCKF: DPOINT;
+49900 FILLAF: 0..7 ;
+49950 FILLAF1: SIZERANGE ;
+50000 LENGTHF: CCOUNTRANGE ;
+50050 LOGICALFILEMENDED: OBJECTP;
+50100 PHYSICALFILEMENDED: OBJECTP;
+50150 PAGEMENDED: OBJECTP;
+50200 LINEMENDED: OBJECTP;
+50250 PCOVER: OBJECTP;
+50300 TERM: TERMSET);
+50350 COVER:
+50400 (SCOPEV: DEPTHRANGE;
+50450 CHANNEL: CHAN;
+50500 STATUS: STATUSSET;
+50550 POSSIBLES: POSSSET;
+50600 COFCPOS, LOFCPOS, POFCPOS: INTEGER;
+50650 CHARBOUND, LINEBOUND, PAGEBOUND: INTEGER;
+50700 DOPUTS,DOGETS,DONEWLINE,DONEWPAGE,DOSET,DORESET: ASPROC;
+50750 CASE ASSOC: BOOLEAN OF
+50800 FALSE: (FILLC: SIZERANGE;
+50850 BOOK:FETROOMP);
+50900 TRUE: (OFFSETDI:SIZERANGE;
+50950 ASSREF:OBJECTP;
+51000 CPOSELS:ELSRANGE) );
+51050 );
+51100 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+51150 END;
+51200 ()+13*)
+51250 (**)
+51300 (**)
+51350 (**)
+51400 (**)
+51450 (**)
+51500 (**)
+51550 (**)
+51600 (**)
+51650 (**)
+51700 (**)
+51750 (**)
+51800 (**)
+51850 (**)
+51900 (**)
+51950 (**)
+52000 (**)
+52050 (**)
+52100 (**)
+52150 (**)
+52200 (**)
+52250 (**)
+52300 (**)
+52350 (**)
+52400 (**)
+52450 (**)
+52500 (**)
+52550 (**)
+52600 (**)
+52650 (**)
+52700 (**)
+52750 (**)
+52800 (**)
+52850 (**)
+52900 (**)
+52950 (**)
+53000 (*********************)
+53050 (* INVOCATION BLOCKS *)
+53100 (*********************)
+53150 (**)
+53200 (*+11() ADDRESS = 0..777777B; ()+11*)
+53250 (*+12() ADDRESS = (*-19()INTEGER;()-19*) (*+19()LONG;()+19*) ()+12*)
+53300 (*+13() ADDRESS = INTEGER ; ()+13*)
+53350 CONVBLE = (POINT, INT);
+53400 SIMPILE =
+53450 RECORD CASE CONVBLE OF
+53500 INT: (SIM: IPOINT);
+53550 POINT: (PIL: OBJECTP)
+53600 END;
+53650 (**)
+53700 (**)
+53750 BITMAP = PACKED RECORD
+53800 (*+11()
+53850 FILL: 0..77777777777777B;
+53900 MASK: -17777B..+17777B;
+53950 ()+11*)
+54000 (*+12() (*+03()
+54050 MASK: -3777B..+3777B; (*DIFFICULTIES ON NORD*)
+54055 ()+03*)
+54060 (*+02()
+54070 MASK: INTEGER;
+54075 COUNT: INTEGER;
+54080 ()+02*)
+54100 ()+12*)
+54150 (*+13() (*+02()
+54200 MASK: -32768..+32767 ;
+54210 COUNT: -32768..32767;
+54250 ()+02*)
+54300 (*-02() COUNT: 0..15 ;
+54301 ()-02*) ()+13*)
+54350 END;
+54400 PIDBLK = ^IDBLK;
+54450 IDBLK=PACKED RECORD
+54451 CASE SEVERAL OF
+54500 1: (ALF: (*+01() ALFA; ()+01*) (*-01() PACKED ARRAY [1..10] OF CHAR; ()-01*) );
+54550 2: (A,B,C,D,E,F,G,H,I,J:BYTE;
+54551 IDSIZE: BYTE;
+54600 XMODE: BYTE);
+54601 3,4,5,6,7,8,9,10: ();
+54650 END;
+54700 PRANGE = ^RANGEBLOCK;
+54750 RANGEBLOCK =
+54800 RECORD
+54850 FIRSTW: PACKED RECORD
+54860 (*+11() FILL: 0..177B;
+54870 LOOPCOUNT: 0..377777B;
+54880 FILL1: 0..1;
+54890 ()+11*)
+55000 (*-11() LOOPCOUNT: INTEGER; ()-11*)
+55050 RGIDBLK: PIDBLK;
+55100 (*+11() FILL2: 0..1; ()+11*)
+55150 RECGEN: OBJECTP
+55200 END;
+55250 RGSCOPE: DEPTHRANGE;
+55300 RIBOFFSET: PRANGE;
+55350 (*-41() RGNEXTFREE: INTPOINT ; ()-41*)
+55400 (*+41() RGLASTUSED: INTPOINT ; ()+41*)
+55450 END;
+55500 INVBLOCK = (*THIS RECORD IS FOR INFORMATION ONLY. IT IS NOT USED BY THE RUN-TIME SYSTEM*)
+55550 RECORD
+55600 (*+01()
+55650 PASCAL: PACKED RECORD
+55700 STATICCHAIN: IPOINT;
+55750 A68BIT: BOOLEAN;PUTBIT: BOOLEAN;GETBIT: BOOLEAN; FILL2: 0..17777777B; DYN: ^INVBLOCK; RETURN: ADDRESS
+55800 END;
+55850 ()+01*)
+55900 (*+03()
+55950 PASCAL: PACKED RECORD
+56000 WORD1,WORD2,WORD3: INTEGER;
+56050 OLDB,OLDPC,OLDEP: INTEGER;
+56100 STATICCHAIN, DYN: IPOINT;
+56150 OLDLNR: INTEGER;
+56200 (* WE NEED A68BIT AT LEAST - HOPEFULLY PUTBIT AND GETBIT ALSO ----------*)
+56250 END;
+56300 ()+03*)
+56350 SPARE: INTEGER;
+56400 SCOPE: DEPTHRANGE;
+56450 NPARAMS: INTEGER;
+56500 BITPATTERN: BITMAP;
+56550 TRACE: OBJECTP;
+56600 LEVEL: INTEGER;
+56650 PROCBL: PROCPOINT;
+56700 LINENO: INTEGER;
+56750 FIRSTRG: RANGEBLOCK;
+56800 END;
+56850 (**)
+56900 (*********************)
+56950 (* OTHER BLOCKS *)
+57000 (*********************)
+57050 (**)
+57100 PROCBLOCK =
+57150 RECORD
+57200 XBASE: ADDRESS;
+57250 LEVEL: INTEGER;
+57300 SCOFFSET: INTEGER;
+57350 SCOPELEVEL: INTEGER;
+57400 IBSIZE: INTEGER;
+57450 PARAMS:INTEGER;
+57500 ROUTNAME: IDBLK;
+57550 IDBLOCK: PIDBLK;
+57600 END;
+57650 (* *)
+57700 DEEBLOCK =
+57750 ARRAY[0..999] OF INTEGER;
+57800 (**)
+57850 PDESC=
+57900 RECORD
+57950 PSIZE: OFFSETRANGE;
+58000 ACCOFFS: BOUNDSRANGE;
+58050 PROWS: 0..7;
+58100 PDESCVEC: ARRAY [0..7] OF RECORD
+58150 PP, PD, PL, PND: INTEGER;
+58200 END
+58250 END;
+58300 (**)
+58350 NAKED =
+58400 PACKED RECORD
+58450 (*+11() BIT0: BOOLEAN; (*THIS BIT MUST ALWAYS BE ZERO, FOR BENEFIT OF COMPILED CODE*) ()+11*)
+58500 STOWEDVAL: OBJECTP;
+58550 (*+11() FILL: 0..177777777B; ()+11*)
+58600 CASE SEVERAL OF
+58650 0: (POSITION: ELSRANGE);
+58700 1: (POINTER: UNDRESSP); (*SPECIAL FORM, AS USED IN DISPLAYS*)
+58750 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+58800 END;
+58850 (*+01() ASNAKED = INTEGER; ()+01*) (*OR WHATEVER SCALAR TYPE CAN ENCOMPASS A NAKED*)
+58900 (*-01() ASNAKED = REAL; (*MOST MACHINES REQUIRE TWO WORDS FOR THIS*) ()-01*)
+58950 NAKEGER =
+59000 RECORD CASE CONVBLE OF
+59050 INT: (ASNAK: ASNAKED);
+59100 POINT: (NAK: NAKED);
+59150 END;
+59152 (**)
+59160 PPROC = (*REPRESENTATION OF PASCAL PROCEDURE/FUNCTION VALUE*)
+59162 PACKED RECORD
+59163 (*+01() FILLER:0..77777777B; ()+01*)
+59164 (*-02() ENV: ADDRESS;
+59165 PROCADD: ADDRESS; ()-02*)
+59166 (*+02() PROCADD: ADDRESS;
+59167 ENV: ADDRESS; ()+02*)
+59168 END;
+59170 (**)
+59200 REALTEGER =
+59250 RECORD CASE SEVERAL OF
+59300 0: (INT: INTEGER (*-01(); INT2: INTEGER ()-01*));
+59350 (*-01() 1: (LONG: A68LONG); ()-01*)
+59400 2: (REA: REAL);
+59450 3: (ALF: PACKED ARRAY [ 1..BYTESWIDTH ] OF CHAR);
+59500 4: (CH: CHAR);
+59550 5: (PTR: OBJECTP);
+59600 6: (PROCC: ASPROC);
+59610 7: (PROCVAL: PPROC);
+59650 8 , 9 , 10 : () ;
+59700 END;
+59750 (*+01()
+59800 MESS = PACKED ARRAY [1..50] OF CHAR; (*FOR PASCPMD*)
+59850 W66 = PACKED RECORD
+59900 FILL1: 0..77777777B; JOPR: 0..7777B; FILL2: 0..77777777B;
+59950 END;
+60000 ()+01*)
+60040 (**)
+60050 BYLPP = ^BYLP;
+60051 NOBYLPP = ^NOBYLP;
+60052 BYLP = RECORD
+60054 (*-41()
+60056 LOOPTYP: INTEGER;
+60058 BYPART: A68INT;
+60060 FROMPART: A68INT;
+60062 TOPART: A68INT;
+60064 ()-41*)
+60066 (*+41()
+60068 TOPART: A68INT;
+60070 FROMPART: A68INT;
+60072 BYPART: A68INT;
+60074 LOOPTYP: INTEGER;
+60076 ()+41*)
+60078 END;
+60080 NOBYLP = RECORD
+60082 (*-41()
+60084 LOOPTYP: INTEGER;
+60086 FROMPART: A68INT;
+60088 TOPART: A68INT;
+60090 ()-41*)
+60092 (*+41()
+60094 TOPART: A68INT;
+60096 FROMPART: A68INT;
+60097 LOOPTYP: INTEGER;
+60098 ()+41*)
+60099 END;
+60100 (**)
+60150 VAR (* VAR VAR VAR VAR VAR VAR VAR VAR VAR *)
+60200 (**)
+60250 UNINT: INTEGER;
+60300 UNDEFIN: OBJECTP;
+60350 PASCPARAMS: SIZERANGE ;
+60400 PASCPROC: ASPROC;
+60450 (*-02() (*THE ABOVE VARIABLES MUST BE DECLARED FIRST BECAUSE THE COMPILED CODE
+60500 AND/OR MACHINE CODE ROUTINES KNOW ABOUT THEM*) ()-02*)
+60550 PASCADDR: PROCPOINT; (*A68-STYLE PROCBLOCK REPRESENTING PASCAL ROUTINE*)
+60600 ALLCHAR (*+01() , ALLCHAR1 ()+01*): TERMSET;
+60650 HALFPI: ACCURATEPI;
+60700 COMPLEX: DPOINT; (*FOR WIDENING TO .COMPL*)
+60750 FILEBLOCK: DPOINT;
+60800 (*-01()
+60850 SOURDESC, SLICDESC: OBJECTP; (*GLOBAL VARIABLES FOR SLICING*)
+60900 SOURDEX, SLICDEX: 0..7; (*DITTO*)
+60950 ADJACC: BOUNDSRANGE; (*DITTO*)
+61000 REVISEDLB: BOUNDSRANGE; (*DITTO*)
+61050 SLICEPDS: PDS; (*DITTO*)
+61150 ()-01*)
+61200 PUTSTRING, HIGHPCOUNT: OBJECTP;
+61250 SPARE2, NILPTR: OBJECTP;
+61300 BITP: BITMAP;
+61350 (*-54() SPARE1: IPOINT; ()-54*)
+61400 (*+54() EXCEPTDB: DPOINT; ()+54*)
+61410 (*+02() INTUNDEF: INTEGER; ()+02*)
+61450 CPUCLOCK: INTEGER;
+61500 (*THIS IS MERELY TO MAP OUT ENOUGH SPACE BEFORE THE NEXT VARIABLES, WHICH ARE ALSO KNOWN TO THE A68 PROGRAM*)
+61550 FIRSTIB: INVBLOCK; (*FIRSTIBOFFSET MUST ACCESS THIS VARIABLE*)
+61600 (*+01()
+61650 LASTRANDOM: INTEGER; (*START OF STANDARD-PRELUDE*)
+61700 STIN: OBJECTP;
+61750 STOUT: OBJECTP;
+61800 STBACK: OBJECTP;
+61850 ()+01*)
+61900 (**)
+61905 (*+02()
+61910 FUNCTION TIMESTE (T:REAL; E:INTEGER) :REAL; EXTERN;
+61945 ()+02*)
+61950 (**)
+62000 (*+01() (*$E+*) ()+01*)
+62050 (**)
+62100 (**)
+62150 (*+01() (*$X4*) ()+01*)
+62200 (**)
+62400 (*+01() PROCEDURE A68 ; ()+01*)
+62450 (*+05()
+62500 PROCEDURE A68( BITPATTERN: BITMAP ; LOCRG: DEPTHRANGE; PROCBL: PROCPOINT; STATICP: IPOINT);
+62550 ()+05*)
+62560 (*+02()
+62570 PROCEDURE A68(UNINTCOPY: INTEGER; UNDEFINCOPY: OBJECTP; BITPATTERN: BITMAP;
+62575 LOCRG: DEPTHRANGE; PROCBL: PROCPOINT; STATICP: IPOINT);
+62580 ()+02*)
+62600 (*THIS REPRESENTS THE A68 PROCEDURE (OR MAIN PROGRAM) FROM WHICH RUN-TIME ROUTINES (OCODES)
+62650 GET CALLED. ALL RUN-TIME ROUTINES ARE DECLARED WITHIN A68, AND THE COMPILER ARRANGES THAT
+62700 THEIR STATIC LINKS WILL ALWAYS POINT TO THE CALLING A68 ROUTINE. THUS THE VARIABLES ABOUT
+62750 TO BE DECLARED ARE ALL ACCESSIBLE, AND WILL ACTUALLY BE PART OF THE INVOCATION BLOCK OF
+62800 THE CALLING A68 PROCEDURE.
+62850 *)
+62900 (*+01()
+62950 VAR SCOPE: DEPTHRANGE;
+63000 SPARE: INTEGER;
+63050 BITPATTERN: BITMAP;
+63100 TRACE: OBJECTP;
+63150 LEVEL: INTEGER;
+63200 PROCBL: PROCPOINT;
+63250 LINENO: INTEGER;
+63300 FIRSTRG: RANGEBLOCK;
+63350 ()+01*)
+63400 (*+05()
+63450 VAR
+63500 SCOPE: INTEGER ;
+63550 TRACE: OBJECTP ;
+63600 LEVEL: INTEGER ;
+63650 LINENO: INTEGER ;
+63700 FIRSTRG: RANGEBLOCK ;
+63750 (*THIS IS MERELY TO MAP OUT ENOUGH SPACE BEFORE THE NEXT VARIABLES, WHICH ARE ALSO KNOWN TO THE A68 PROGRAM*)
+63800 LASTRANDOM: INTEGER; (*START OF STANDARD-PRELUDE*)
+63850 STIN: OBJECTP;
+63900 STOUT: OBJECTP;
+63950 STBACK: OBJECTP;
+64000 ()+05*)
+64002 (*+02()
+64004 VAR
+64006 SCOPE: INTEGER ;
+64008 TRACE: OBJECTP ;
+64010 LEVEL: INTEGER ;
+64012 LINENO: INTEGER ;
+64014 FIRSTRG: RANGEBLOCK ;
+64016 (*THIS IS MERELY TO MAP OUT ENOUGH SPACE BEFORE THE NEXT VARIABLES, WHICH ARE ALSO KNOWN TO THE A68 PROGRAM*)
+64018 LASTRANDOM: INTEGER; (*START OF STANDARD-PRELUDE*)
+64020 STIN: OBJECTP;
+64021 STOUT: OBJECTP;
+64022 STBACK: OBJECTP;
+64024 MAXREAL: REAL
+64025 SMALLREAL: REAL;
+64026 PI: REAL;
+64026 ()+02*)
+64050 (**)
+64100 (*ALL THE PROCEDURES AND FUNCTIONS WHICH FOLLOW ARE WITHIN A68*)
+64150 (**)
+64200 (**)
+64300 FUNCTION ME: IPOINT; EXTERN; (*STACK FRAME POINTER OF CALLER*)
+64350 FUNCTION STATIC(IB: IPOINT): IPOINT; EXTERN; (*FOLLOW STATIC CHAIN*)
+64400 (*+05() FUNCTION A68STATIC(IB: IPOINT): IPOINT; EXTERN; (*FOLLOW ALGOL 68S STATIC CHAIN*) ()+05*)
+64450 FUNCTION DYNAMIC(IB: IPOINT): IPOINT; EXTERN; (*FOLLOW DYNAMIC CHAIN*)
+64452 (*+02() FUNCTION ARGBASE(IB: IPOINT): IPOINT; EXTERN; ()+02*)
+64500 FUNCTION ISA68(IB: IPOINT): BOOLEAN; EXTERN; (*IB IS FRAME FOR A68 PROC*)
+64550 FUNCTION ISPUT(IB: IPOINT): BOOLEAN; EXTERN; (*IB IS FRAME FOR CALL OF PUTT*)
+64600 FUNCTION ISGET(IB: IPOINT): BOOLEAN; EXTERN; (*IB IS FRAME FOR CALL OF GETT*)
+64650 PROCEDURE SETMYSTATIC(IB: IPOINT); EXTERN; (*SETS STATIC CHAIN OF CALLER*)
--- /dev/null
+15000 #include "rundecs.h"
+15010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+15020 (**)
+15030 (**)
+15040 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+15050 PROCEDURE ERRORR(N: INTEGER); EXTERN;
+15060 (**)
+15070 (**)
+15080 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC);
+15090 VAR N: OFFSETRANGE; I, J, K: INTEGER;
+15100 BEGIN WITH OLDESC^, PDESC1 DO
+15110 BEGIN
+15120 PSIZE := SIZE;
+15130 ACCOFFS := -ELSCONST;
+15140 J := 0;
+15150 FOR I := 0 TO ROWS DO WITH DESCVEC[I], PDESCVEC[J] DO
+15160 BEGIN
+15170 N := UI-LI+1; IF N<0 THEN N := 0;
+15180 ACCOFFS := ACCOFFS+LI*DI;
+15190 PND := DI*N;
+15200 PROWS := J;
+15210 IF PSIZE=DI THEN
+15220 BEGIN PSIZE := PND; PD := PSIZE END
+15230 ELSE
+15240 BEGIN J := J+1; PD := DI END;
+15250 PL := ELSCONST-LBADJ+ACCOFFS+PND;
+15260 PP := PL;
+15270 FOR K := PROWS-1 DOWNTO 0 DO WITH PDESCVEC[K] DO
+15280 BEGIN PL := PL+LI*DI; PP := PL END;
+15290 END;
+15300 WITH PDESCVEC[PROWS] DO PP := PL-PND-PD
+15310 END
+15320 END;
+15330 (**)
+15340 (**)
+15350 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN;
+15360 BEGIN WITH PDESC1 DO WITH PDESCVEC[I] DO
+15370 BEGIN
+15380 PP := PP+PD;
+15390 IF PP<PL THEN
+15400 BEGIN
+15410 NEXTEL := TRUE
+15420 END
+15430 ELSE IF I<PROWS THEN
+15440 IF NEXTEL(I+1, PDESC1) THEN
+15450 BEGIN
+15460 PP := PDESCVEC[I+1].PP;
+15470 PL := PP+PND;
+15480 NEXTEL := TRUE
+15490 END
+15500 ELSE NEXTEL := FALSE
+15510 ELSE
+15520 BEGIN
+15530 NEXTEL := FALSE;
+15540 PP := PL-PND-PD
+15550 END
+15560 END
+15570 END;
+15580 (**)
+15590 (**)
+15600 PROCEDURE PCINCR(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER);
+15610 VAR TEMPOS, STRUCTPOS: INTEGER;
+15620 PTR: UNDRESSP;
+15630 BEGIN
+15640 TEMPOS:= 1;
+15650 STRUCTPOS:= TEMPLATE^[1];
+15660 WHILE STRUCTPOS >= 0
+15670 DO BEGIN
+15680 PTR := INCPTR(STRUCTPTR, STRUCTPOS);
+15690 WITH PTR^ DO
+15700 BEGIN
+15710 FINCD(FIRSTPTR^,INCREMENT);
+15720 IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+15730 END;
+15740 TEMPOS:= TEMPOS+1;
+15750 STRUCTPOS:= TEMPLATE^[TEMPOS];
+15760 END;
+15770 END;
+15780 (**)
+15790 (**)
+15800 PROCEDURE PCINCRMULT(ELSPTR:OBJECTP; INCREMENT: INTEGER);
+15810 VAR TEMPLATE: DPOINT;
+15820 COUNT, ELSIZE: INTEGER;
+15830 PTR: UNDRESSP;
+15840 BEGIN
+15850 TEMPLATE:= ELSPTR^.DBLOCK;
+15860 IF ORD(TEMPLATE)<=MAXSIZE (*NOT STRUCT*)
+15870 THEN
+15880 IF ORD(TEMPLATE)=0 (*DRESSED*)
+15890 THEN
+15900 BEGIN
+15910 PTR := INCPTR(ELSPTR, ELSCONST);
+15920 WHILE ORD(PTR)<ORD(ELSPTR)+ELSCONST+ELSPTR^.D0 DO WITH PTR^ DO
+15930 BEGIN
+15940 FINCD(FIRSTPTR^,INCREMENT);
+15950 IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+15960 PTR := INCPTR(PTR, SZADDR);
+15970 END
+15980 END
+15990 ELSE (*NO ACTION*)
+16000 ELSE BEGIN (*STRUCT*)
+16010 ELSIZE:= TEMPLATE^[0];
+16020 IF TEMPLATE^[1]>0
+16030 THEN BEGIN
+16040 COUNT := ELSPTR^.D0-ELSIZE;
+16050 PTR := INCPTR(ELSPTR, ELSCONST);
+16060 WHILE COUNT >= 0
+16070 DO BEGIN
+16080 PCINCR(PTR, TEMPLATE, INCREMENT);
+16090 PTR := INCPTR(PTR, ELSIZE);
+16100 COUNT:= COUNT-ELSIZE
+16110 END;
+16120 END;
+16130 END;
+16140 END;
+16150 (**)
+16160 (**)
+16170 PROCEDURE COPYSLICE(ASLICE: OBJECTP);
+16180 VAR NEWSLICE, OLDELS, NEWELS: OBJECTP;
+16190 COUNT, SIZEACC, OFFACC: INTEGER;
+16200 PDESC1: PDESC;
+16210 OLDESCVEC: ARRAY [0..7] OF PDS;
+16220 OLDLBADJ: BOUNDSRANGE;
+16230 OLDROWS: 0..7;
+16240 PROCEDURE CSSUPP(ASLICE: OBJECTP);
+16250 VAR LSLICEADJ, COUNT, NCOUNT, NEWDI, ACCOFFS, ACCADJ: INTEGER;
+16260 BEGIN
+16270 WITH ASLICE^ DO
+16280 BEGIN
+16290 FPDEC(PVALUE^);
+16300 IF FPTST(PVALUE^) THEN GARBAGE(PVALUE);
+16310 PVALUE := NEWELS;
+16320 FPINC(NEWELS^);
+16330 ASLICE := IHEAD;
+16340 END;
+16350 WHILE ASLICE<>NIL DO WITH ASLICE^ DO
+16360 BEGIN
+16370 ACCOFFS := -ELSCONST;
+16380 FOR COUNT := 0 TO ROWS DO WITH DESCVEC[COUNT] DO
+16390 ACCOFFS := ACCOFFS+LI*DI;
+16400 LSLICEADJ := ACCOFFS-LBADJ-PDESC1.ACCOFFS+OLDLBADJ;
+16410 ACCADJ := 0;
+16420 NCOUNT := ROWS;
+16430 FOR COUNT := OLDROWS DOWNTO 0 DO WITH OLDESCVEC[COUNT] DO
+16440 BEGIN
+16450 NEWDI := NEWSLICE^.DESCVEC[COUNT].DI;
+16460 ACCADJ := ACCADJ+(LSLICEADJ DIV DI)*NEWDI;
+16470 LSLICEADJ := LSLICEADJ MOD DI;
+16480 IF NCOUNT>=0 THEN
+16490 IF DESCVEC[NCOUNT].DI=DI THEN WITH DESCVEC[NCOUNT] DO
+16500 BEGIN
+16510 ACCOFFS := ACCOFFS+LI*(NEWDI-DI);
+16520 DI := NEWDI;
+16530 NCOUNT := NCOUNT-1
+16540 END;
+16550 END;
+16560 LBADJ := ACCOFFS-ACCADJ;
+16570 CSSUPP(ASLICE);
+16580 ASLICE := FPTR;
+16590 END
+16600 END;
+16610 (**)
+16620 BEGIN (*COPYSLICE*)
+16630 FORMPDESC(ASLICE, PDESC1);
+16640 WITH ASLICE^ DO
+16650 BEGIN
+16660 OLDELS := PVALUE;
+16670 OLDLBADJ := LBADJ;
+16680 OLDROWS := ROWS;
+16690 SIZEACC:= SIZE;
+16700 OFFACC:= -ELSCONST;
+16710 FOR COUNT := 0 TO ROWS DO
+16720 BEGIN
+16730 OLDESCVEC[COUNT] := DESCVEC[COUNT];
+16740 WITH DESCVEC[COUNT] DO
+16750 BEGIN
+16760 DI:= SIZEACC;
+16770 SIZEACC := OFFACC+SIZEACC*LI;
+16780 OFFACC:= SIZEACC;
+16790 SIZEACC:= UI-LI;
+16800 IF SIZEACC < 0
+16810 THEN SIZEACC:= 0
+16820 ELSE SIZEACC:= SIZEACC+1;
+16830 SIZEACC:= SIZEACC*DI;
+16840 END;
+16850 END;
+16860 LBADJ := OFFACC;
+16870 ENEW(NEWELS, SIZEACC+ELSCONST);
+16880 WITH NEWELS^ DO
+16890 BEGIN
+16900 (*-02() FIRSTWORD := SORTSHIFT*ORD(IELS); ()-02*)
+16910 (*+02() PCOUNT:=0; SORT:=IELS; ()+02*)
+16920 OSCOPE := 0;
+16930 D0 := SIZEACC;
+16940 CCOUNT:= 1;
+16950 DBLOCK:= OLDELS^.DBLOCK;
+16960 IHEAD := NIL;
+16970 END;
+16980 IF ASLICE=BPTR^.IHEAD THEN
+16990 BEGIN
+17000 BPTR^.IHEAD:= FPTR;
+17010 IF FPTR=NIL THEN
+17020 BEGIN FPDEC(BPTR^); IF FPTST(BPTR^) THEN GARBAGE(BPTR) END
+17030 END
+17040 ELSE BPTR^.FPTR := FPTR;
+17050 IF FPTR<>NIL THEN
+17060 BEGIN FPTR^.BPTR := BPTR; FPTR := NIL END;
+17070 BPTR:= NIL;
+17080 END;
+17090 COUNT := ELSCONST;
+17100 WHILE NEXTEL(0, PDESC1) DO WITH PDESC1 DO WITH PDESCVEC[0] DO
+17110 BEGIN
+17120 MOVELEFT(INCPTR(OLDELS, PP), INCPTR(NEWELS, COUNT), PSIZE);
+17130 COUNT := COUNT+PSIZE;
+17140 END;
+17150 PCINCRMULT(NEWELS, +INCRF);
+17160 NEWSLICE := ASLICE;
+17170 CSSUPP(ASLICE);
+17180 END;
+17190 (**)
+17200 (**)
+17210 PROCEDURE TESTCC(TARGET: OBJECTP);
+17220 LABEL 0000;
+17230 VAR DESTREF, LDESC, HEAD, NEWMULT, NEWELS: OBJECTP;
+17240 I, CREATIONC, ELSIZE, ACCOFF, LACOFFSET, LACOFF2: INTEGER;
+17250 BEGIN
+17260 WITH TARGET^.ANCESTOR^ DO
+17270 IF PVALUE^.PCOUNT-ORD(PVALUE^.IHEAD<>NIL)>1 THEN
+17280 BEGIN
+17290 (* PCOUNT > 1 FOR OTHERS BESIDES IHEAD *)
+17300 WITH PVALUE^ DO BEGIN
+17310 FDEC;
+17320 ENEW(NEWELS, D0+ELSCONST)
+17330 END;
+17340 MOVELEFT(PVALUE, NEWELS, PVALUE^.D0+ELSCONST);
+17350 PCINCRMULT(PVALUE, +INCRF);
+17360 PVALUE:= NEWELS;
+17370 NEWELS^.PCOUNT := 1; (* SORT ALREADY SET*)
+17380 NEWELS^.IHEAD := NIL;
+17390 CCOUNT := NEWELS^.CCOUNT
+17400 END
+17410 ELSE
+17420 BEGIN
+17430 NEWELS := PVALUE;
+17440 CREATIONC := NEWELS^.CCOUNT;
+17450 DESTREF := TARGET;
+17460 IF CREATIONC=TARGET^.CCOUNT THEN GOTO 0000; (*EXIT*)
+17470 WITH DESTREF^ DO
+17480 IF SORT=REFSL1 THEN
+17490 BEGIN
+17500 ELSIZE := TARGET^.ANCESTOR^.SIZE; ACCOFF := ELSIZE+OFFSET;
+17510 END
+17520 ELSE
+17530 BEGIN
+17540 ELSIZE := PVALUE^.D0;
+17550 ACCOFF := ELSIZE-LBADJ;
+17560 FOR I := 0 TO ROWS DO WITH DESCVEC[I] DO
+17570 ACCOFF := ACCOFF+LI*DI;
+17580 (*ACCOFF = DIST FROM START OF ELEMENTS TO 1ST EL BEYOND THIS SLICE*)
+17590 END;
+17600 (*SLCOPY*)
+17610 HEAD := NEWELS^.IHEAD;
+17620 WHILE HEAD <> NIL DO WITH HEAD^ DO
+17630 BEGIN
+17640 LACOFFSET := -LBADJ-ACCOFF;
+17650 FOR I := 0 TO ROWS DO WITH DESCVEC[I] DO
+17660 LACOFFSET := LACOFFSET+LI*DI;
+17670 (*DIST FROM BEYOND LAST EL OF DESTREF TO 1ST EL OF HEAD*)
+17680 WITH DESCVEC[ROWS] DO
+17690 IF UI < LI THEN
+17700 I:= 0
+17710 ELSE I := (UI-LI+1)*DI;
+17720 LACOFF2 := I+LACOFFSET+ELSIZE;
+17730 (*DIST FROM 1ST EL OF DESTREF TO BEYOND LAST EL OF HEAD*)
+17740 IF (LACOFFSET>=0) OR (LACOFF2<=0) THEN
+17750 HEAD := FPTR
+17760 ELSE BEGIN
+17770 COPYSLICE(HEAD);
+17780 HEAD := NEWELS^.IHEAD;
+17790 END;
+17800 END;
+17810 0000:IF CREATIONC<>0 THEN DESTREF^.CCOUNT := CREATIONC
+17820 END
+17830 END;
+17840 (**)
+17850 (**)
+17860 PROCEDURE TESTSS (REFSTRUCT: OBJECTP);
+17870 (*ASSERT ITS PCOUNT > 1*)
+17880 VAR OBJSIZE: INTEGER;
+17890 TEMPLATE: DPOINT;
+17900 NEWSTRUCT: OBJECTP;
+17910 BEGIN
+17920 WITH REFSTRUCT^ DO
+17930 BEGIN
+17940 FPDEC(PVALUE^);
+17950 TEMPLATE := PVALUE^.DBLOCK;
+17960 OBJSIZE := TEMPLATE^[0];
+17970 ENEW(NEWSTRUCT, OBJSIZE+STRUCTCONST);
+17980 MOVELEFT(INCPTR(PVALUE, STRUCTCONST), INCPTR(NEWSTRUCT, STRUCTCONST), OBJSIZE);
+17990 PCINCR(INCPTR(PVALUE, STRUCTCONST), TEMPLATE, +INCRF);
+18000 WITH NEWSTRUCT^ DO
+18010 BEGIN
+18020 (*-02() FIRSTWORD := SORTSHIFT*ORD(STRUCT); ()-02*)
+18030 (*+02() SORT:=STRUCT; ()+02*)
+18040 PCOUNT := 1;
+18050 LENGTH := REFSTRUCT^.PVALUE^.LENGTH;
+18060 DBLOCK:= TEMPLATE
+18070 END;
+18080 PVALUE:= NEWSTRUCT
+18090 END
+18100 END;
+18110 (**)
+18120 (**)
+18130 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP;
+18140 (* RETURNS A POINTER TO THE REAL PART OF THE STRUCTURE *)
+18150 BEGIN
+18160 WITH LOCATION^.ANCESTOR^ DO
+18170 IF FPTWO(PVALUE^) THEN
+18180 CASE SORT OF
+18190 REF1: SAFEACCESS := INCPTR(LOCATION,REF1SIZE-SZINT);
+18200 (*-01() REF2: SAFEACCESS := INCPTR(LOCATION,REF2SIZE-SZLONG); ()-01*)
+18210 CREF: SAFEACCESS := IPTR;
+18220 REFR, RECR, RECN, REFN:
+18230 BEGIN
+18240 IF SORT IN [REFR, RECR] THEN
+18250 TESTCC(LOCATION)
+18260 ELSE
+18270 TESTSS(ANCESTOR);
+18280 PVALUE^.OSCOPE := 0;
+18290 SAFEACCESS := INCPTR(PVALUE, LOCATION^.OFFSET)
+18300 END;
+18310 UNDEF: ERRORR(RASSIG);
+18320 NILL: ERRORR(RASSIGNIL)
+18330 END
+18340 ELSE BEGIN
+18350 PVALUE^.OSCOPE := 0;
+18360 SAFEACCESS := INCPTR(PVALUE,LOCATION^.OFFSET)
+18370 END
+18380 END;
+18390 (**)
+18400 (**)
+18410 (*-02() BEGIN END ; ()-02*)
+18420 (*+01()
+18430 BEGIN (*OF MAIN PROGRAM*)
+18440 END (*OF EVERYTHING*).
+18450 ()+01*)
--- /dev/null
+46000 #include "rundecs.h"
+46010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+46020 (**)
+46030 (**)
+46040 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN;
+46050 FUNCTION MULTSCOPE(MULT: OBJECTP):DEPTHRANGE; EXTERN;
+46060 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+46070 (**)
+46080 (**)
+46090 FUNCTION SCOPEXT(SOURCE: OBJECTP): OBJECTP;
+46100 (*PSCOPEEXT*)
+46110 VAR SOURCESCOPE: DEPTHRANGE;
+46120 BEGIN
+46130 WITH SOURCE^ DO
+46140 IF OSCOPE=0 THEN
+46150 IF SORT=STRUCT THEN
+46160 BEGIN
+46170 SOURCESCOPE := STRUCTSCOPE(INCPTR(SOURCE, STRUCTCONST), DBLOCK);
+46180 OSCOPE := SOURCESCOPE
+46190 END
+46200 ELSE SOURCESCOPE := MULTSCOPE(SOURCE)
+46210 ELSE SOURCESCOPE := OSCOPE;
+46220 IF SCOPE+FIRSTRG.RIBOFFSET^.RGSCOPE<=SOURCESCOPE THEN ERRORR(RSCOPE);
+46230 SCOPEXT := SOURCE;
+46240 END;
+46250 (**)
+46260 (**)
+46270 (*-02() BEGIN END ; ()-02*)
+46280 (*+01()
+46290 BEGIN (*OF MAIN PROGRAM*)
+46300 END (*OF EVERYTHING*).
+46310 ()+01*)
--- /dev/null
+46400 #include "rundecs.h"
+46410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+46420 (**)
+46430 (**)
+46440 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
+46450 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
+46460 FUNCTION GETSLN(NEWREFSLN:OBJECTP): OBJECTP; EXTERN;
+46470 (**)
+46480 (**)
+46490 FUNCTION SELECTR(AROWED: OBJECTP; TEMPLATE: DPOINT; ROFFSET: INTEGER): OBJECTP;
+46500 (*PSELECTROW*)
+46510 VAR ADESC: OBJECTP;
+46520 BEGIN
+46530 WITH AROWED^ DO
+46540 IF SORT=MULT THEN
+46550 BEGIN
+46560 ADESC := COPYDESC(AROWED, MULT);
+46570 ADESC^.PVALUE := AROWED;
+46580 SELECTR := GETMULT(ADESC);
+46590 END
+46600 ELSE
+46610 BEGIN
+46620 ADESC := COPYDESC(AROWED, REFSLN);
+46630 ADESC^.PVALUE := AROWED;
+46640 SELECTR := GETSLN(ADESC);
+46650 END;
+46660 WITH ADESC^ DO
+46670 BEGIN
+46680 MDBLOCK := TEMPLATE;
+46690 IF ORD(TEMPLATE)=0 (*DRESSED*) THEN SIZE := 1
+46700 ELSE IF ORD(TEMPLATE)<=MAXSIZE (*UNDRESSED*) THEN SIZE := ORD(TEMPLATE)
+46710 ELSE (*STRUCT*) SIZE := TEMPLATE^[0];
+46720 LBADJ := LBADJ-ROFFSET;
+46730 END
+46740 END;
+46750 (**)
+46760 (**)
+46770 (*-02() BEGIN END ; ()-02*)
+46780 (*+01()
+46790 BEGIN (*OF MAIN PROGRAM*)
+46800 END (*OF EVERYTHING*).
+46810 ()+01*)
--- /dev/null
+46900 #include "rundecs.h"
+46910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+46920 (**)
+46930 (**)
+46940 (*-01() (*-05()
+46950 FUNCTION SELECTT(PRIMARY: OBJECTP; STRUCTOFF: INTEGER): ASNAKED;
+46960 (*PSELECT*)
+46970 VAR TEMP: NAKEGER;
+46980 BEGIN
+46990 WITH TEMP, NAK DO
+47000 BEGIN
+47010 (*+11() ASNAK := 0; (*TO ENSURE THAT BIT IS CLEAR*) ()+11*)
+47020 STOWEDVAL := PRIMARY;
+47030 POSITION := STRUCTOFF+PRIMARY^.OFFSET;
+47040 SELECTT := ASNAK
+47050 END
+47060 END;
+47070 (**)
+47080 (**)
+47090 FUNCTION SELECTS(PRIMARY: OBJECTP; STRUCTOFF: INTEGER): ASNAKED;
+47100 VAR TEMP: NAKEGER;
+47110 BEGIN
+47120 WITH TEMP, NAK DO
+47130 BEGIN
+47140 (*+11() ASNAK := 0; ()+11*) (* TO ENSURE THAT BIT IS CLEAR *)
+47150 STOWEDVAL := PRIMARY;
+47160 POSITION := STRUCTOFF+STRUCTCONST;
+47170 SELECTS := ASNAK
+47180 END
+47190 END;
+47200 (**)
+47210 (**)
+47220 FUNCTION SELECTN(TEMP: NAKEGER; STRUCTOFF: INTEGER): ASNAKED;
+47230 BEGIN WITH TEMP DO
+47240 BEGIN NAK.POSITION := NAK.POSITION+STRUCTOFF; SELECTN := ASNAK END;
+47250 END;
+47260 ()-05*) ()-01*)
+47270 (**)
+47280 (**)
+47290 (*-02() BEGIN END ; ()-02*)
+47300 (*+01()
+47310 BEGIN (*OF MAIN PROGRAM*)
+47320 END (*OF EVERYTHING*).
+47330 ()+01*)
--- /dev/null
+47400 #include "rundecs.h"
+47410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+47420 (**)
+47430 (**)
+47440 FUNCTION SETCC(POINT: OBJECTP): OBJECTP;
+47450 (*PCREATEREF+4*)
+47460 (*A POSSIBLE PROCESS PARAMETER FOR DCL*)
+47470 BEGIN
+47480 WITH POINT^ DO
+47490 IF (SORT=REFSL1) OR (SORT=REFSLN) THEN
+47500 CCOUNT := 1; (*SET CCOUNT FOR OVERLAP SEARCH*)
+47510 SETCC := POINT;
+47520 END;
+47530 (**)
+47540 (**)
+47550 (*-02()
+47560 BEGIN
+47570 END ;
+47580 ()-02*)
+47590 (*+01()
+47600 BEGIN (*OF MAIN PROGRAM*)
+47610 END (*OF EVERYTHING*).
+47620 ()+01*)
--- /dev/null
+88500 #include "rundecs.h"
+88510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+88520 (**)
+88530 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+88540 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+88550 PROCEDURE CLPASC5(P1,P2 :IPOINT; P3,P4 :INTEGER; P5 :IPOINT; PROC: ASPROC); EXTERN;
+88560 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+88570 (**)
+88580 (**)
+88590 (*+01() (*$X6*) ()+01*)
+88600 PROCEDURE SETT(RF: OBJECTP; P, L, C: INTEGER);
+88610 VAR F: OBJECTP;
+88620 BEGIN
+88630 TESTF(RF, F);
+88640 WITH F^.PCOVER^ DO
+88650 IF OPENED IN STATUS THEN
+88660 IF (P<1) OR (L<1) OR (C<1) THEN ERRORR(POSMIN)
+88670 ELSE IF (P>PAGEBOUND+1) OR (L>LINEBOUND+1) OR (C>CHARBOUND+1) THEN ERRORR(POSMAX)
+88680 ELSE IF SETPOSS IN POSSIBLES THEN
+88690 CLPASC5(ORD(F^.PCOVER), P, L, C, ORD(BOOK), DOSET)
+88700 ELSE ERRORR(NOSET)
+88710 ELSE ERRORR(NOTOPEN);
+88720 IF FPTST(RF^) THEN GARBAGE(RF);
+88730 END;
+88740 (**)
+88750 (**)
+88760 (*+01() (*$X4*) ()+01*)
+88770 (**)
+88780 (**)
+88790 (*-02()
+88800 BEGIN (*OF A68*)
+88810 END; (*OF A68*)
+88820 ()-02*)
+88830 (*+01()
+88840 BEGIN (*OF MAIN PROGRAM*)
+88850 END (* OF EVERYTHING *).
+88860 ()+01*)
--- /dev/null
+SHL(statlink, n , a)
+ int *statlink ;
+ unsigned a ;
+ { return( n < 0 ? ( - n >= 32 ? 0 : a >> - n ) : n >= 32 ? 0 : a << n ) ; }
--- /dev/null
+SHR(statlink, n , a)
+ int *statlink ;
+ unsigned a ;
+ { return( n < 0 ? ( - n >= 32 ? 0 : a << - n ) : n >= 32 ? 0 : a >> n ) ; }
--- /dev/null
+SIGNI(statlink, n)
+ int *statlink ;
+ int n ;
+ { return( n < 0 ? - 1 : n == 0 ? 0 : 1 ) ; }
--- /dev/null
+SIGNR(statlink, n)
+ int *statlink ;
+ register double n ;
+ { return( n < 0.0 ? - 1 : n == 0.0 ? 0 : 1 ) ; }
--- /dev/null
+extern double _sin();
+double SIN(statlink, x)
+ int *statlink; double x;
+ {return(_sin(x));}
--- /dev/null
+47700 #include "rundecs.h"
+47710 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+47720 (**)
+47730 (**)
+47740 PROCEDURE GARBAGE(ANOBJECT: OBJECTP); EXTERN ;
+47750 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP; EXTERN;
+47760 (**)
+47770 (**)
+47780 FUNCTION SKIPS: INTEGER;
+47790 (*PSKIP*)
+47800 BEGIN SKIPS := INTUNDEF END;
+47810 (**)
+47820 (*-01()
+47830 FUNCTION SKIPS2: A68LONG ;
+47840 VAR TEMP: REALTEGER ;
+47850 BEGIN
+47860 WITH TEMP DO
+47870 BEGIN
+47880 INT := INTUNDEF ;
+47890 INT2 := INTUNDEF ;
+47900 SKIPS2 := LONG
+47910 END
+47920 END ;
+47930 ()-01*)
+47940 (**)
+47950 FUNCTION SKIPPIL: OBJECTP;
+47960 (*PSKIP+1*)
+47970 BEGIN SKIPPIL := UNDEFIN END;
+47980 (**)
+47990 (**)
+48000 FUNCTION SKIPSTR (TEMPLATE: DPOINT):OBJECTP;
+48010 (*PSKIPSTRUCT*)
+48020 BEGIN SKIPSTR := CRSTRUCT(TEMPLATE) END;
+48030 (**)
+48040 (**)
+48050 FUNCTION NILP: OBJECTP;
+48060 (*PNIL*)
+48070 BEGIN NILP := NILPTR END;
+48080 (**)
+48090 (**)
+48100 (*-01() (*-05()
+48110 PROCEDURE VOID(POINT: OBJECTP);
+48120 (*PVOIDNORMAL - USUALLY CODED INLINE*)
+48130 BEGIN IF FPTST(POINT^) THEN GARBAGE(POINT) END;
+48140 (**)
+48150 (**)
+48160 PROCEDURE VOIDN(NAK: NAKED);
+48170 (*PVOIDNAKED - USUALLY CODED INLINE*)
+48180 BEGIN IF FPTST(NAK.STOWEDVAL^) THEN GARBAGE(NAK.STOWEDVAL) END;
+48190 ()-05*) ()-01*)
+48200 (**)
+48210 (**)
+48220 (*-02() BEGIN END ; ()-02*)
+48230 (*+01()
+48240 BEGIN (*OF MAIN PROGRAM*)
+48250 END (*OF EVERYTHING*).
+48260 ()+01*)
--- /dev/null
+48300 #include "rundecs.h"
+48310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+48320 (**)
+48330 (**)
+48340 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+48350 (**)
+48360 (**)
+48370 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER);
+48380 BEGIN
+48390 WITH STOWEDVAL^ DO CASE SORT OF
+48400 MULT, REFSLN, REFR, RECR:
+48410 WITH DESCVEC[SLICDEX] DO
+48420 BEGIN
+48430 IF INDEX<LI THEN ERRORR(RSL1ERROR);
+48440 IF INDEX>UI THEN ERRORR(RSL2ERROR);
+48450 END;
+48460 UNDEF: ERRORR(RSLICE);
+48470 NILL: ERRORR(RSLICENIL);
+48480 END
+48490 END;
+48500 (**)
+48510 (**)
+48520 (*-01() (*-05()
+48530 FUNCTION SLICE1(PRIMARY: OBJECTP; INDEX: BOUNDSRANGE): ASNAKED;
+48540 (*PSLICE1*)
+48550 VAR TEMP: NAKEGER;
+48560 BEGIN
+48570 WITH TEMP DO WITH NAK DO
+48580 BEGIN
+48590 STOWEDVAL := PRIMARY;
+48600 WITH PRIMARY^ DO WITH DESCVEC[0] DO
+48610 IF (INDEX<LI) OR (INDEX>UI) THEN SLCMN(STOWEDVAL, INDEX, 0)
+48620 ELSE POSITION := DI*INDEX-LBADJ;
+48630 SLICE1 := ASNAK;
+48640 END;
+48650 END;
+48660 (**)
+48670 (**)
+48680 FUNCTION SLICE2(INDEX1, INDEX2: BOUNDSRANGE): ASNAKED;
+48690 (*PSLICE2*)
+48700 VAR TEMP: NAKEGER;
+48710 OFFS: INTEGER;
+48720 BEGIN
+48730 WITH TEMP DO WITH NAK DO
+48740 BEGIN
+48750 (*+11() ASNAK := 0; ()+11*)
+48760 STOWEDVAL := ASPTR(GETSTKTOP(SZADDR, 0));
+48770 WITH STOWEDVAL^ DO
+48780 BEGIN
+48790 WITH DESCVEC[0] DO
+48800 IF (INDEX2<LI) OR (INDEX2>UI) THEN SLCMN(STOWEDVAL, INDEX2, 0)
+48810 ELSE OFFS := -LBADJ+DI*INDEX2;
+48820 WITH DESCVEC[1] DO
+48830 IF (INDEX1<LI) OR (INDEX1>UI) THEN SLCMN(STOWEDVAL, INDEX1, 1)
+48840 ELSE POSITION := OFFS+DI*INDEX1
+48850 END;
+48860 SLICE2 := ASNAK;
+48870 END;
+48880 END;
+48890 ()-05*) ()-01*)
+48900 (**)
+48910 (**)
+48920 (*-02() BEGIN END ; ()-02*)
+48930 (*+01()
+48940 BEGIN (*OF MAIN PROGRAM*)
+48950 END (*OF EVERYTHING*).
+48960 ()+01*)
--- /dev/null
+49000 #include "rundecs.h"
+49010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+49020 (**)
+49030 (**)
+49040 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER); EXTERN;
+49050 (**)
+49060 (**)
+49070 FUNCTION SLICEN(INDEX: BOUNDSRANGE; NOROWS: INTEGER): ASNAKED;
+49080 (*PSLICEN*)
+49090 VAR TEMP: NAKEGER;
+49100 OFFS, I: INTEGER;
+49110 BEGIN
+49120 WITH TEMP DO WITH NAK DO
+49130 BEGIN
+49140 (*+11() ASNAK := 0; ()+11*)
+49150 STOWEDVAL := ASPTR(GETSTKTOP(SZADDR, (NOROWS-1)*SZINT));
+49160 WITH STOWEDVAL^ DO
+49170 BEGIN
+49180 OFFS := -LBADJ;
+49190 FOR I := 0 TO NOROWS-1 DO WITH DESCVEC[I] DO
+49200 BEGIN
+49210 IF (INDEX<LI) OR (INDEX>UI) THEN SLCMN(STOWEDVAL, INDEX, I)
+49220 ELSE OFFS := OFFS+DI*INDEX;
+49230 INDEX := GETSTKTOP(SZINT, I*SZINT);
+49240 END
+49250 END;
+49260 POSITION := OFFS;
+49270 SLICEN := ASNAK;
+49280 END;
+49290 END;
+49300 (**)
+49310 (**)
+49320 (*-02() BEGIN END ; ()-02*)
+49330 (*+01()
+49340 BEGIN (*OF MAIN PROGRAM*)
+49350 END (*OF EVERYTHING*).
+49360 ()+01*)
--- /dev/null
+88800 #include "rundecs.h"
+88810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+88820 (**)
+88830 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+88840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+88850 PROCEDURE CLPASC5(P1,P2 :IPOINT; P3,P4 :INTEGER; P5 :IPOINT; PROC: ASPROC); EXTERN;
+88860 PROCEDURE CLRDSTR(PCOV: OBJECTP; VAR CHARS: GETBUFTYPE; TERM (*+01() , TERM1 ()+01*) : TERMSET;
+88870 VAR I: INTEGER; BOOK: FETROOMP; PROC: ASPROC); EXTERN;
+88880 PROCEDURE TESTF(RF:OBJECTP;VAR F:OBJECTP); EXTERN;
+88890 FUNCTION ENSLINE(RF:OBJECTP;VAR F:OBJECTP):BOOLEAN; EXTERN;
+88900 PROCEDURE ERRORSTATE(F:OBJECTP); EXTERN;
+88910 (**)
+88920 (**)
+88930 PROCEDURE SPACE(RF:OBJECTP);
+88940 VAR NSTATUS :STATUSSET; F,COV:OBJECTP;
+88950 CHARS: GETBUFTYPE; I: INTEGER;
+88960 BEGIN FPINC(RF^);
+88970 TESTF(RF,F); NSTATUS:=F^.PCOVER^.STATUS;
+88980 IF NOT(([OPENED,READMOOD]<=NSTATUS) OR ([OPENED,WRITEMOOD]<=NSTATUS))
+88990 THEN ERRORSTATE(F)
+89000 ELSE IF [LINEOVERFLOW]<=NSTATUS
+89010 THEN IF NOT ENSLINE(RF,F) THEN ERRORR(NOLOGICAL);
+89020 (* OPENED,LINEOK,MOODOK *)
+89030 COV:=F^.PCOVER;
+89040 IF COV^.ASSOC THEN WITH COV^ DO
+89050 BEGIN
+89060 COFCPOS := COFCPOS+1; CPOSELS := CPOSELS+OFFSETDI;
+89070 IF COFCPOS>CHARBOUND THEN STATUS := STATUS+[LINEOVERFLOW];
+89080 END
+89090 ELSE IF [READMOOD,CHARMOOD]<=F^.PCOVER^.STATUS THEN
+89100 BEGIN I := -1; CLRDSTR(COV, CHARS, ALLCHAR (*+01() , ALLCHAR ()+01*) , I, COV^.BOOK, COV^.DOGETS) END
+89110 ELSE WITH F^.PCOVER^ DO
+89120 CLPASC5(ORD(COV), ORD(F), -1, ORD(' '), ORD(BOOK), DOPUTS);
+89130 WITH RF^ DO BEGIN FDEC; IF FTST THEN GARBAGE(RF) END;
+89140 END;
+89150 (**)
+89160 (**)
+89170 (*-02()
+89180 BEGIN (*OF A68*)
+89190 END; (*OF A68*)
+89200 ()-02*)
+89210 (*+01()
+89220 BEGIN (*OF MAIN PROGRAM*)
+89230 END (* OF EVERYTHING *).
+89240 ()+01*)
--- /dev/null
+extern double _sqrt();
+double SQRT(statlink, x)
+ int *statlink; double x;
+ {return(_sqt(x));}
--- /dev/null
+89300 #include "rundecs.h"
+89310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+89320 (**)
+89330 PROCEDURE TESTCC(TARGET:OBJECTP); EXTERN;
+89340 (**)
+89350 (**)
+89360 PROCEDURE ASSWRSTR(COV,PUTSTRING:OBJECTP;LB,UB:INTEGER; VAR FYLE :FYL);
+89370 VAR PTR: UNDRESSP;
+89380 I,CP,OFS,WIDTH:INTEGER;
+89390 BEGIN WITH COV^ DO
+89400 BEGIN
+89410 CP:=CPOSELS;
+89420 OFS:=OFFSETDI;
+89430 IF FPTWO(ASSREF^.ANCESTOR^) THEN
+89440 TESTCC(ASSREF);
+89450 PTR := INCPTR(ASSREF^.ANCESTOR^.PVALUE, CP);
+89460 IF LB<0 THEN
+89470 BEGIN PTR^.FIRSTWORD:=UB; CP:=CP+OFS; WIDTH:=1 END
+89480 ELSE BEGIN WIDTH:=UB-LB+1;
+89490 WITH PUTSTRING^ DO
+89500 FOR I := LB TO UB DO
+89510 BEGIN PTR^.FIRSTWORD:=ORD(CHARVEC[I]);
+89520 PTR := INCPTR(PTR, OFS);
+89530 CP:=CP+OFS
+89540 END;
+89550 END;
+89560 COFCPOS:=COFCPOS+WIDTH;
+89570 CPOSELS:=CP;
+89580 IF COFCPOS>CHARBOUND THEN
+89590 STATUS:=STATUS+[LINEOVERFLOW];
+89600 END;
+89610 END;
+89620 (**)
+89630 (**)
+89640 PROCEDURE ASSRDSTR(
+89650 PCOV: OBJECTP; VAR CHARS: GETBUFTYPE; T (*+01(), T1()+01*): TERMSET; VAR I: INTEGER; VAR FYLE: FYL
+89660 );
+89670 VAR PTR: UNDRESSP;
+89680 CH: CHAR;
+89690 (*LINEOK*)
+89700 BEGIN
+89710 WITH PCOV^ DO
+89720 BEGIN
+89730 PTR := INCPTR(ASSREF^.ANCESTOR^.PVALUE, CPOSELS);
+89740 IF I<0 THEN
+89750 BEGIN I := PTR^.FIRSTWORD; CPOSELS := CPOSELS+OFFSETDI; COFCPOS := COFCPOS+1 END
+89760 ELSE
+89770 BEGIN
+89780 CH := CHR(PTR^.FIRSTWORD);
+89790 WHILE (COFCPOS<=CHARBOUND) AND NOT(CH IN T)
+89800 (*+01() AND ((ORD(CH)<=59) OR NOT(CHR(ORD(CH)-59) IN T1)) ()+01*) DO
+89810 BEGIN
+89820 CHARS[I] := CH; I := I+1;
+89830 CPOSELS := CPOSELS+OFFSETDI;
+89840 PTR := INCPTR(PTR, OFFSETDI);
+89850 CH := CHR(PTR^.FIRSTWORD);
+89860 COFCPOS := COFCPOS+1;
+89870 END
+89880 END;
+89890 IF COFCPOS>CHARBOUND THEN
+89900 STATUS := STATUS+[LINEOVERFLOW];
+89910 END
+89920 END;
+89930 (**)
+89940 (**)
+89950 PROCEDURE ASSNEWLINE(COV: OBJECTP; VAR FYLE: FYL);
+89960 BEGIN WITH COV^ DO
+89970 BEGIN
+89980 LOFCPOS := 2; COFCPOS := 1;
+89990 STATUS := STATUS+[PAGEOVERFLOW,LINEOVERFLOW];
+90000 END
+90010 END;
+90020 (**)
+90030 (**)
+90040 PROCEDURE ASSNEWPAGE(COV: OBJECTP; VAR FYLE: FYL);
+90050 BEGIN WITH COV^ DO
+90060 BEGIN
+90070 POFCPOS := 2; LOFCPOS := 1; COFCPOS := 1;
+90080 IF READMOOD IN STATUS THEN STATUS := STATUS+[LFE,PAGEOVERFLOW,LINEOVERFLOW]
+90090 ELSE STATUS := STATUS+[PFE,PAGEOVERFLOW,LINEOVERFLOW];
+90100 END
+90110 END;
+90120 (**)
+90130 (**)
+90140 PROCEDURE ASSRESET(COV: OBJECTP; VAR FYLE: FYL);
+90150 BEGIN WITH COV^.ASSREF^ DO
+90160 COV^.CPOSELS := DESCVEC[0].DI-LBADJ;
+90170 END;
+90180 (**)
+90190 (**)
+90200 PROCEDURE ASSSET(COV: OBJECTP; P, L, C: INTEGER; VAR FYLE: FYL);
+90210 BEGIN WITH COV^ DO
+90220 BEGIN
+90230 COFCPOS := C; LOFCPOS := L; POFCPOS := P;
+90240 STATUS := STATUS-[LFE,PFE,PAGEOVERFLOW,LINEOVERFLOW];
+90250 IF POFCPOS>PAGEBOUND THEN ASSNEWPAGE(COV, FYLE)
+90260 ELSE IF LOFCPOS>LINEBOUND THEN ASSNEWLINE(COV, FYLE)
+90270 ELSE IF COFCPOS>CHARBOUND THEN STATUS := STATUS+[LINEOVERFLOW]
+90280 ELSE WITH ASSREF^ DO
+90290 COV^.CPOSELS := C*DESCVEC[0].DI-LBADJ;
+90300 END
+90310 END;
+90320 (**)
+90330 (**)
+90340 (*-02()
+90350 BEGIN (*OF A68*)
+90360 END; (*OF A68*)
+90370 ()-02*)
+90380 (*+01()
+90390 BEGIN (*OF MAIN PROGRAM*)
+90400 END (*OF EVERYTHING*).
+90410 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exp $STANDBAC
+
+ pro $STANDBAC,0
+ ret 0
+ end 0
--- /dev/null
+90500 #include "rundecs.h"
+90510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+90520 (**)
+90530 (**)
+90540 PROCEDURE SETSTATUS(COV:OBJECTP; VAR FYLE: FYL);
+90550 VAR STAT:STATUSSET;
+90560 BEGIN
+90570 IF NOTINITIALIZED IN COV^.STATUS THEN STAT := [NOTINITIALIZED,LFE,PAGEOVERFLOW,LINEOVERFLOW]
+90580 ELSE IF EOF(FYLE) THEN STAT := [LFE,PAGEOVERFLOW,LINEOVERFLOW]
+90590 ELSE IF (*-50()FYLE^=CHR(12)()-50*) (*+50()EOS(FYLE)()+50*) THEN
+90600 STAT := [PAGEOVERFLOW,LINEOVERFLOW]
+90610 ELSE IF EOLN(FYLE) THEN STAT := [LINEOVERFLOW]
+90620 ELSE STAT := [];
+90630 COV^.STATUS:=COV^.STATUS-[NOTINITIALIZED,LFE,PAGEOVERFLOW,LINEOVERFLOW]+STAT;
+90640 END;
+90650 (**)
+90660 (**)
+90670 (*******STAND IN PRIMITVES*******)
+90680 (**)
+90690 (**)
+90700 PROCEDURE SIRDSTR(
+90710 PCOV: OBJECTP ; VAR CHARS: GETBUFTYPE ; T (*+01() , T1 ()+01*): TERMSET ; VAR I: INTEGER ; VAR FYLE: FYL
+90720 ) ;
+90730 (*LINEOK*)
+90740 BEGIN WITH PCOV^ DO
+90750 IF I<0 THEN
+90760 BEGIN I := ORD(FYLE^); GET(FYLE); COFCPOS := COFCPOS+1 END
+90770 ELSE
+90780 WHILE NOT EOLN(FYLE) AND NOT (FYLE^ IN T)
+90790 (*+01() AND ((ORD(FYLE^)<=59) OR NOT (CHR(ORD(FYLE^)-59) IN T1)) ()+01*) DO
+90800 BEGIN CHARS[I] := FYLE^; I := I+1; GET(FYLE); COFCPOS := COFCPOS+1 END;
+90810 SETSTATUS(PCOV, FYLE)
+90820 END;
+90830 (**)
+90840 (**)
+90850 PROCEDURE SINEWLINE(COV:OBJECTP; VAR FYLE :FYL);
+90860 BEGIN WITH COV^ DO
+90870 BEGIN READLN(FYLE);
+90880 LOFCPOS:=LOFCPOS+1;
+90890 COFCPOS:=1;
+90900 STATUS := STATUS-[NOTINITIALIZED];
+90910 END;
+90920 SETSTATUS(COV, FYLE)
+90930 END;
+90940 (**)
+90950 (**)
+90960 PROCEDURE SINEWPAGE(COV:OBJECTP; VAR FYLE :FYL);
+90970 BEGIN WITH COV^ DO
+90980 BEGIN
+90990 (*-50() WHILE FYLE^<>CHR(12) DO GET(FYLE); GET(FYLE); ()-50*)
+91000 (*+50() GETSEG(FYLE) ; ()+50*)
+91010 COFCPOS:=1; LOFCPOS:=1; POFCPOS:=POFCPOS+1;
+91020 END;
+91030 SETSTATUS(COV, FYLE)
+91040 END;
+91050 (**)
+91060 (**)
+91070 PROCEDURE SIRESET(COV: OBJECTP; VAR FYLE: FYL);
+91080 (*OPENED,MOODOK*)
+91090 BEGIN WITH COV^ DO
+91100 IF RESETPOSS IN POSSIBLES THEN
+91110 BEGIN RESET(FYLE); SETSTATUS(COV, FYLE) END
+91120 END;
+91130 (**)
+91140 (**)
+91150 (*-02()
+91160 BEGIN (*OF A68*)
+91170 END; (*OF A68*)
+91180 ()-02*)
+91190 (*+01()
+91200 BEGIN (*OF MAIN PROGRAM*)
+91210 END (*OF EVERYTHING*).
+91220 ()+01*)
--- /dev/null
+91300 #include "rundecs.h"
+91310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+91320 (**)
+91330 (*+05() PROCEDURE FLSBUF(P: PCFILE; CH: CHAR); EXTERN; ()+05*)
+91340 (*+02()
+91350 PROCEDURE STOPEN (VAR PF: FYL; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH(COV:OBJECTP;L:LFNTYPE) ); EXTERN;
+91360 ()+02*)
+91370 (**)
+91380 (**)
+91390 (**)
+91400 (*******STAND OUT PRIMITIVES*******)
+91410 PROCEDURE SONEWLINE(COV:OBJECTP; VAR FYLE :FYL);
+91420 (*+05()
+91430 PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
+91440 ()+05*)
+91450 BEGIN WITH COV^ DO
+91460 BEGIN LOFCPOS:=LOFCPOS+1;
+91470 COFCPOS:=1;
+91480 (*+05()
+91490 WITH BOOK^ DO
+91500 IF (*ISTTY*) (XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
+91510 FLSBUF(XFILE, CHR(10))
+91520 ELSE WRC(XFILE, CHR(10));
+91530 ()+05*)
+91540 (*-05() WRITELN(FYLE); ()-05*)
+91550 IF LOFCPOS>LINEBOUND THEN STATUS:=STATUS+[PAGEOVERFLOW,LINEOVERFLOW]
+91560 ELSE BEGIN STATUS:=STATUS-[LINEOVERFLOW];
+91570 IF CARRIAGE IN STATUS THEN WRITE(FYLE, ' ')
+91580 END
+91590 END
+91600 END;
+91610 (**)
+91620 (**)
+91630 PROCEDURE SONEWPAGE(COV:OBJECTP; VAR FYLE :FYL);
+91640 VAR I: INTEGER;
+91650 BEGIN WITH COV^ DO
+91660 BEGIN
+91670 IF COFCPOS<>1 THEN SONEWLINE(COV, FYLE);
+91680 (*+05()
+91690 IF (*ISTTY*) (BOOK^.XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
+91700 FOR I := LOFCPOS TO LINEBOUND DO SONEWLINE(COV, FYLE)
+91710 ELSE
+91720 ()+05*)
+91730 (*-50() PAGE(FYLE); ()-50*)
+91740 (*+50() PUTSEG(FYLE); ()+50*)
+91750 COFCPOS:=1; LOFCPOS:=1; POFCPOS:=POFCPOS+1;
+91760 STATUS:=STATUS-[PAGEOVERFLOW,LINEOVERFLOW];
+91770 IF POFCPOS>PAGEBOUND THEN
+91780 STATUS:=STATUS+[PFE,PAGEOVERFLOW,LINEOVERFLOW]
+91790 ELSE IF CARRIAGE IN STATUS THEN WRITE(FYLE, '1')
+91800 END
+91810 END;
+91820 (**)
+91830 (**)
+91840 PROCEDURE SORESET(COV: OBJECTP; VAR FYLE: FYL);
+91850 (*OPENED,MOODOK*)
+91860 BEGIN WITH COV^ DO
+91870 BEGIN
+91880 IF RESETPOSS IN POSSIBLES THEN
+91890 BEGIN (*+01()(*-52()BOOK^.STATUS := 15B; (*TO FIX A BUG IN PASCAL MK 2*) ()-52*)()+01*)
+91900 REWRITE(FYLE)
+91910 END;
+91920 IF CARRIAGE IN STATUS THEN
+91930 WRITE(FYLE, '1');
+91940 STATUS := STATUS-[NOTRESET]
+91950 END
+91960 END;
+91970 (**)
+91980 (**)
+91990 (*+01() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; VAR FYLE: FYL); ()+01*)
+92000 (*+02() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+02*)
+92010 (*+05() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+05*)
+92020 (*POSN OF NEXT WIDTH CHARS ENSURED*)
+92030 VAR I, WIDTH, J, WORD: INTEGER;
+92040 PTR: UNDRESSP;
+92050 (*+01()
+92060 (*$X0*)
+92070 PROCEDURE WRS(VAR FYLE: FYL; ADDR: UNDRESSP; FLDLGTH, STRLGTH: INTEGER); EXTERN;
+92080 PROCEDURE WRSN(VAR FYLE: FYL; SHORTSTR: INTEGER; FLDLGTH, STRLGTH: INTEGER); EXTERN;
+92090 (*$X4*)
+92100 ()+01*)
+92110 (*+02()
+92120 CPTR: IPOINT;
+92130 PROCEDURE WRC(CH :CHAR; FIL :FETROOMP); EXTERN;
+92140 PROCEDURE WRS(LEN :INTEGER; CP :IPOINT; FIL :FETROOMP); EXTERN;
+92150 ()+02*)
+92160 (*+05()
+92170 CPTR: CHARPOINT ;
+92180 PROCEDURE WRS(P: PCFILE; CP: CHARPOINT; LEN: INTEGER ); EXTERN;
+92190 PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
+92200 ()+05*)
+92210 BEGIN
+92220 (*+01()
+92230 WIDTH := 1;
+92240 IF LB<0 THEN WRITE(FYLE,CHR(UB))
+92250 ELSE BEGIN
+92260 LB := LB-1;
+92270 PTR := INCPTR(STRNG, STRINGCONST + LB DIV CHARPERWORD);
+92280 WIDTH := UB-LB;
+92290 IF LB MOD CHARPERWORD <> 0 THEN
+92300 BEGIN
+92310 IF WIDTH <= CHARPERWORD - LB MOD CHARPERWORD THEN I := WIDTH ELSE I := CHARPERWORD - LB MOD CHARPERWORD;
+92320 WORD := PTR^.FIRSTWORD;
+92330 FOR J := 1 TO LB MOD CHARPERWORD DO WORD := WORD * CHARSPACE ;
+92340 WRSN(FYLE, WORD, I, I);
+92350 PTR := INCPTR(PTR, SZWORD);
+92360 END
+92370 ELSE I := 0;
+92380 WRS(FYLE, PTR, WIDTH-I, WIDTH-I)
+92390 END;
+92400 ()+01*)
+92410 (*+02()
+92420 IF LB<0 THEN (*CHAR*)
+92430 BEGIN
+92440 WIDTH := 1;
+92450 WRC(CHR(UB),EFET);
+92460 END
+92470 ELSE (*STRING*)
+92480 BEGIN
+92490 WIDTH:=UB-LB+1;
+92500 CPTR:= ORD(STRNG) + STRINGCONST + (LB *(SZWORD DIV CHARPERWORD)-1);
+92510 WRS(WIDTH,CPTR,EFET);
+92520 END;
+92530 ()+02*)
+92540 (*+05()
+92550 IF LB<0 THEN
+92560 BEGIN
+92570 WIDTH := 1;
+92580 WRC(EFET^.XFILE, CHR(UB))
+92590 END
+92600 ELSE BEGIN
+92610 WIDTH := UB - LB + 1;
+92620 CPTR := ASPTR(( ORD( STRNG ) + STRINGCONST )*2 + LB - 1) ;
+92630 WRS( EFET^.XFILE , CPTR , WIDTH ) ;
+92640 END;
+92650 ()+05*)
+92660 WITH COV^ DO
+92670 BEGIN COFCPOS:=COFCPOS+WIDTH;
+92680 IF COFCPOS>CHARBOUND THEN
+92690 STATUS:=STATUS+[LINEOVERFLOW];
+92700 END;
+92710 END;
+92720 (**)
+92730 (**)
+92740 (*-02()
+92750 BEGIN (*OF A68*)
+92760 END; (*OF A68*)
+92770 ()-02*)
+92780 (*+01()
+92790 BEGIN (*OF MAIN PROGRAM*)
+92800 END (*OF EVERYTHING*).
+92810 ()+01*)
--- /dev/null
+92900 #include "rundecs.h"
+92910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+92920 (**)
+92930 (*+01() (*$X6*) ()+01*)
+92940 PROCEDURE STBACCH(PCOV: OBJECTP; LFN: LFNTYPE);
+92950 BEGIN WITH PCOV^ DO
+92960 BEGIN CHARBOUND:=MAXINT;
+92970 LINEBOUND:=MAXINT;
+92980 PAGEBOUND:=MAXINT;
+92990 POSSIBLES:=[GETPOSS,PUTPOSS,RESETPOSS,SETPOSS,BINPOSS,ESTABPOSS];
+93000 STATUS := [OPENED,CHARMOOD];
+93010 (*+01() BOOK^.DISP:=123B; ()+01*)
+93020 END
+93030 END;
+93040 (**)
+93050 (**)
+93060 (*+01() (*$X4*) ()+01*)
+93070 (**)
+93080 (**)
+93090 (*-02()
+93100 BEGIN (*OF A68*)
+93110 END; (*OF A68*)
+93120 ()-02*)
+93130 (*+01()
+93140 BEGIN (*OF MAIN PROGRAM*)
+93150 END (* OF EVERYTHING *).
+93160 ()+01*)
--- /dev/null
+93200 #include "rundecs.h"
+93210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+93220 (**)
+93230 PROCEDURE SETREADMOOD(PCOV:OBJECTP); EXTERN;
+93240 (**)
+93250 (*+01() (*$X6*) ()+01*)
+93260 FUNCTION PROC( PROCEDURE P (*-01() ( COV: OBJECTP ; EFET: FETROOMP ) ()-01*) ): ASPROC ; EXTERN ;
+93270 (*-01()
+93280 FUNCTION PROC1(
+93290 PROCEDURE P( COV: OBJECTP ; CHARS: GETBUFTYPE ; TERM: TERMSET ; I: INTEGER ; EFET: FETROOMP )
+93300 ): ASPROC ; EXTERN ;
+93310 ()-01*)
+93320 PROCEDURE AOPEN( EFET:FETROOMP; DISP:INTEGER; LFN:LFNTYPE; BUF:IPOINT ); EXTERN;
+93330 PROCEDURE SIRDSTR(COV: OBJECTP; CHARS: GETBUFTYPE; TERM (*+01(),TERM1()+01*): TERMSET; I: INTEGER; EFET: FETROOMP);
+93340 EXTERN;
+93350 PROCEDURE SINEWLINE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+93360 PROCEDURE SINEWPAGE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+93370 PROCEDURE SIRESET(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+93380 (**)
+93390 (**)
+93400 PROCEDURE STINCH(PCOV: OBJECTP; LFN: LFNTYPE);
+93410 (*+01() VAR AW66: ^W66; ()+01*)
+93420 BEGIN WITH PCOV^ DO
+93430 BEGIN CHARBOUND:=MAXINT;
+93440 LINEBOUND:=MAXINT;
+93450 PAGEBOUND:=MAXINT;
+93460 POSSIBLES:=[GETPOSS];
+93470 (*+01()
+93480 AW66 := ASPTR(66B);
+93490 IF (LFN= 'INPUT:::::') AND (AW66^.JOPR=3) THEN (*INPUT AND ONLINE*)
+93500 BEGIN
+93510 AOPEN( BOOK, FORREAD + ONLINE, LFN, ORD(BOOK)+BUFFOFFSET ) ;
+93520 STATUS := [OPENED,NOTINITIALIZED,NOTRESET,LFE,PAGEOVERFLOW,LINEOVERFLOW,CHARMOOD,LAZY,NOTSET]
+93530 END
+93540 ELSE
+93550 ()+01*)
+93560 BEGIN
+93570 AOPEN( BOOK, FORREAD, LFN, ORD(BOOK)+BUFFOFFSET ) ;
+93580 STATUS := [OPENED,NOTRESET,CHARMOOD,NOTSET(*-01(),LAZY()-01*)]
+93590 END;
+93600 (*+01()
+93610 IF BOOK^.LFN<>'INPUT::' THEN POSSIBLES := POSSIBLES+[RESETPOSS];
+93620 ()+01*)
+93630 DOGETS := PROC(*-01()1()-01*)(SIRDSTR);
+93640 DONEWLINE := PROC(SINEWLINE);
+93650 DONEWPAGE := PROC(SINEWPAGE);
+93660 DORESET := PROC(SIRESET);
+93670 SETREADMOOD(PCOV)
+93680 END
+93690 END;
+93700 (*+01() (*$X4*) ()+01*)
+93710 (**)
+93720 (**)
+93730 (*-02()
+93740 BEGIN (*OF A68*)
+93750 END; (*OF A68*)
+93760 ()-02*)
+93770 (*+01()
+93780 BEGIN (*OF MAIN PROGRAM*)
+93790 END (* OF EVERYTHING *).
+93800 ()+01*)
--- /dev/null
+93900 #include "rundecs.h"
+93910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+93920 (**)
+93930 FUNCTION CRSTRUCT(TEMPLATE: DPOINT ) : OBJECTP ; EXTERN ;
+93940 (*+01() (*$X6*) ()+01*)
+93950 PROCEDURE OPENCOVER(
+93960 PFET: FETROOMP; VAR PCOV: OBJECTP; LFN: LFNTYPE; PROCEDURE CH (*-01() ( COV: OBJECTP; L: LFNTYPE) ()-01*)
+93970 ); EXTERN;
+93980 (**)
+93990 (**)
+94000 PROCEDURE STOPEN(
+94010 PFET: FETROOMP; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH (*-01() (COV: OBJECTP; L: LFNTYPE) ()-01*)
+94020 );
+94030 VAR F, PCOV: OBJECTP;
+94040 BEGIN
+94050 OPENCOVER(PFET, PCOV, LFN, CH);
+94060 PCOV^.STATUS := PCOV^.STATUS+[STARTUP];
+94070 F := CRSTRUCT(FILEBLOCK);
+94080 WITH F^ DO
+94090 BEGIN
+94100 FINC;
+94110 OSCOPE := 1;
+94120 PCOVER := PCOV;
+94130 TERM := [] ; (*+01() TERM1 := [] ; ()+01*)
+94140 END;
+94150 ENEW(RF, REFNSIZE);
+94160 WITH RF^ DO
+94170 BEGIN
+94180 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFN) + INCRF; ()-02*)
+94190 (*+02() PCOUNT:=1; SORT:=REFN; ()+02*)
+94200 (*+01() SECONDWORD := 0; ()+01*)
+94210 ANCESTOR := RF;
+94220 OFFSET := STRUCTCONST;
+94230 PVALUE := F;
+94240 OSCOPE := 3;
+94250 END
+94260 END;
+94270 (*+01() (*$X4*) ()+01*)
+94280 (**)
+94290 (**)
+94300 (*-02()
+94310 BEGIN (*OF A68*)
+94320 END; (*OF A68*)
+94330 ()-02*)
+94340 (*+01()
+94350 BEGIN (*OF MAIN PROGRAM*)
+94360 END (* OF EVERYTHING *).
+94370 ()+01*)
--- /dev/null
+98400 #include "rundecs.h"
+98410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+98420 (**)
+98430 PROCEDURE SETWRITEMOOD(PCOV:OBJECTP); EXTERN;
+98440 (*+01() (*$X6*) ()+01*)
+98450 PROCEDURE AOPEN( EFET:FETROOMP; DISP:INTEGER; LFN:LFNTYPE; BUF:IPOINT ); EXTERN;
+98460 FUNCTION PROC( PROCEDURE P (*-01() ( COV: OBJECTP ; EFET: FETROOMP ) ()-01*) ): ASPROC ; EXTERN ;
+98470 (*-01()
+98480 FUNCTION PROC2( PROCEDURE P( COV, STRNG: OBJECTP ; LB, UB: INTEGER ; EFET: FETROOMP ) ): ASPROC ; EXTERN ;
+98490 ()-01*)
+98500 PROCEDURE SONEWLINE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+98510 PROCEDURE SONEWPAGE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+98520 PROCEDURE SORESET(COV: OBJECTP; EFET: FETROOMP); EXTERN;
+98530 PROCEDURE SOWRSTR(COV, STRNG: OBJECTP; LB, UB: INTEGER; EFET: FETROOMP); EXTERN;
+98540 (**)
+98550 (**)
+98560 PROCEDURE STOUTCH(PCOV: OBJECTP; LFN: LFNTYPE);
+98570 VAR
+98580 (*+01() AW66: ^W66 ; ()+01*)
+98590 PINT: INTPOINT;
+98600 (*+01()
+98610 TEMP: PACKED RECORD CASE SEVERAL OF
+98620 1: (INT: INTEGER);
+98630 2: (LFN: PACKED ARRAY [1..7] OF CHAR;
+98640 EFET1: 0..777777B);
+98650 0, 3, 4, 5, 6, 7, 8, 9, 10: ();
+98660 END;
+98670 ()+01*)
+98680 (*+05() HEIGHT, WIDTH: INTEGER; ()+05*)
+98690 BEGIN WITH PCOV^ DO
+98700 BEGIN
+98710 CHARBOUND := 120;
+98720 LINEBOUND := 60;
+98730 PAGEBOUND := 16;
+98740 POSSIBLES:=[PUTPOSS,ESTABPOSS];
+98750 AOPEN(BOOK, FORWRITE, LFN, ORD(BOOK)+BUFFOFFSET);
+98760 STATUS := [OPENED,NOTRESET,CHARMOOD,NOTSET];
+98770 (*+01()
+98780 AW66 := ASPTR(66B);
+98790 IF (BOOK^.LFN='OUTPUT:') AND (AW66^.JOPR<>3) (*OUTPUT AND NOT ONLINE*)
+98800 OR (BOOK^.LFN='LSTFILE') (*SPECIAL CASE*) THEN
+98810 STATUS := STATUS+[CARRIAGE];
+98820 IF (BOOK^.LFN<>'OUTPUT:') AND (BOOK^.LFN<>'LSTFILE') THEN POSSIBLES := POSSIBLES+[RESETPOSS];
+98830 IF (BOOK^.LFN='OUTPUT:') AND (AW66^.JOPR=3) (*OUTPUT AND ONLINE*) THEN
+98840 BEGIN
+98850 PINT := ASPTR(3);
+98860 TEMP.LFN := 'OUTPUT:'; TEMP.EFET1 := ORD(BOOK)+14;
+98870 PINT^ := TEMP.INT; (*TO ENSURE THAT OUTPUT GETS FLUSHED*)
+98880 CHARBOUND := 79;
+98890 END;
+98900 ()+01*)
+98910 (*+05()
+98920 IF WINDOW( BOOK^.XFILE^.FILEDES , HEIGHT , WIDTH ) <> 0 THEN
+98930 BEGIN
+98940 LINEBOUND := HEIGHT;
+98950 CHARBOUND := WIDTH
+98960 END ;
+98970 ()+05*)
+98980 DOPUTS:=PROC(*-01()2()-01*)(SOWRSTR);
+98990 DONEWLINE := PROC(SONEWLINE);
+99000 DONEWPAGE := PROC(SONEWPAGE);
+99010 DORESET := PROC(SORESET);
+99020 SETWRITEMOOD(PCOV)
+99030 END
+99040 END;
+99050 (*+01() (*$X4*) ()+01*)
+99060 (**)
+99070 (**)
+99080 (*-02()
+99090 BEGIN (*OF A68*)
+99100 END; (*OF A68*)
+99110 ()-02*)
+99120 (*+01()
+99130 BEGIN (*OF MAIN PROGRAM*)
+99140 END (* OF EVERYTHING *).
+99150 ()+01*)
--- /dev/null
+49400 #include "rundecs.h"
+49410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+49420 (**)
+49430 (**)
+49440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+49450 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
+49460 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+49470 (**)
+49480 (**)
+49490 FUNCTION STRSUB(OBJECT: OBJECTP; INDEX: BOUNDSRANGE): CHAR;
+49500 (*PSTRINGSLICE*)
+49510 BEGIN
+49520 WITH OBJECT^ DO
+49530 BEGIN
+49540 IF INDEX<1 THEN ERRORR(RSL1ERROR)
+49550 ELSE IF INDEX>STRLENGTH THEN ERRORR(RSL2ERROR)
+49560 ELSE STRSUB := CHARVEC[INDEX];
+49570 END;
+49580 IF FPTST(OBJECT^) THEN GARBAGE(OBJECT);
+49590 END;
+49600 (**)
+49610 (**)
+49620 FUNCTION STRTRIM(INDEX: BOUNDSRANGE; TRTYPE: INTEGER): OBJECTP;
+49630 (*PSTRINGSLICE+1*)
+49640 VAR OLD, NEW :OBJECTP;
+49650 LI, UI: BOUNDSRANGE;
+49660 I :INTEGER;
+49670 BEGIN
+49680 CASE TRTYPE OF
+49690 0,8: BEGIN OLD := ASPTR(INDEX); LI := 1; UI := OLD^.STRLENGTH END;
+49700 2: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, 0)); LI := 1; UI := INDEX END;
+49710 4: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, 0)); LI := INDEX; UI := OLD^.STRLENGTH END;
+49720 6: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, SZINT)); LI := GETSTKTOP(SZINT, 0); UI := INDEX END;
+49730 END;
+49740 IF LI<1 THEN ERRORR(RSL1ERROR)
+49750 ELSE IF UI>OLD^.STRLENGTH THEN ERRORR(RSL2ERROR)
+49760 ELSE
+49770 BEGIN
+49780 LI := LI-1;
+49790 NEW := CRSTRING(UI-LI);
+49800 FOR I := LI+1 TO UI DO
+49810 NEW^.CHARVEC[I-LI] := OLD^.CHARVEC[I];
+49820 IF FPTST(OLD^) THEN GARBAGE(OLD);
+49830 STRTRIM := NEW;
+49840 END;
+49850 END;
+49860 (**)
+49870 (**)
+49880 (*-02() BEGIN END ; ()-02*)
+49890 (*+01()
+49900 BEGIN (*OF MAIN PROGRAM*)
+49910 END (*OF EVERYTHING*).
+49920 ()+01*)
--- /dev/null
+50000 #include "rundecs.h"
+50010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+50020 (**)
+50030 (**)
+50040 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE;
+50050 VAR TEMPOS, STRUCTPOS: INTEGER;
+50060 NEWEST: DEPTHRANGE;
+50070 PTR: UNDRESSP;
+50080 BEGIN
+50090 NEWEST := 0;
+50100 TEMPOS := 1;
+50110 STRUCTPOS := TEMPLATE^[1];
+50120 WHILE STRUCTPOS>=0 DO
+50130 BEGIN
+50140 PTR := INCPTR(STRUCTPTR, STRUCTPOS);
+50150 WITH PTR^.FIRSTPTR^ DO
+50160 IF NEWEST<OSCOPE THEN NEWEST := OSCOPE;
+50170 TEMPOS := TEMPOS+1;
+50180 STRUCTPOS := TEMPLATE^[TEMPOS]
+50190 END;
+50200 STRUCTSCOPE := NEWEST
+50210 END;
+50220 (**)
+50230 (**)
+50240 (*-02() BEGIN END ; ()-02*)
+50250 (*+01()
+50260 BEGIN (*OF MAIN PROGRAM*)
+50270 END (*OF EVERYTHING*).
+50280 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exp $SWAP
+
+ pro $SWAP,0 ; used by twist is A68S1CE to swap two items
+ ; of any length on the stack. the lengths of
+ ; the two items to be swapped are passed as two
+ ; SZWORD byte parameters
+
+ ; first copy what was the top item on the stack before the call
+ ; to the procedural working stack
+ lal SZADDR+SZWORD+SZWORD ; address of top of stack before call
+ lol SZADDR+SZWORD ; 2nd param is the length of top item
+ los SZWORD ; load top item to procedural stack
+
+ ; now copy what was the second stack item to the top
+ lal SZADDR+SZWORD+SZWORD ; address of top for source of copy
+ dup SZADDR ; dup for destination
+ dup SZADDR ; and dup to copy top item back
+ lol SZADDR+SZWORD ; length of top item
+ ads SZWORD ; add length to address of top of stack to get
+ ; the address of the 2nd param. (source address)
+ exg SZADDR ; exchange source and destination address
+ lol SZADDR ; 1st param is the length of the 2nd stack item
+ bls SZWORD ; copy 2nd item to the top of the pre-call stack
+
+ ; now copy the what was the top item from the procedural stack to
+ ; the second position of the stack before the call
+ lol SZADDR ; length of 2nd stack item, now on the top
+ ads SZWORD ; add length to address of the top of the stack to
+ ; get place for 2nd item, the old top item
+ lol SZADDR+SZWORD ; length of old top, now to be copied to 2nd position
+ sts SZWORD ; move the item that was top
+ ret 0
+ end 0
--- /dev/null
+50300 #include "rundecs.h"
+50310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+50320 (**)
+50330 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN;
+50340 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+50350 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+50360 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN;
+50370 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+50380 (**)
+50390 (**)
+50400 FUNCTION DRESSN(CONTENTS: UNDRESSP; TEMPLATE: DPOINT): OBJECTP;
+50410 (*CRS A DRESSED VALUE FROM THE UNDRESSED CONTENTS*)
+50420 VAR NEWSTRUCT: OBJECTP;
+50430 SIZEOF: INTEGER;
+50440 BEGIN
+50450 SIZEOF:= TEMPLATE^[0];
+50460 ENEW(NEWSTRUCT, SIZEOF+STRUCTCONST);
+50470 WITH NEWSTRUCT^ DO
+50480 BEGIN
+50490 (*-02()FIRSTWORD := SORTSHIFT*ORD(STRUCT);()-02*)
+50500 (*+02() PCOUNT:=0; SORT:=STRUCT; ()+02*)
+50510 LENGTH := SIZEOF+STRUCTCONST;
+50520 DBLOCK:= TEMPLATE;
+50530 END;
+50540 MOVELEFT(CONTENTS, INCPTR(NEWSTRUCT, STRUCTCONST), SIZEOF);
+50550 PCINCR(INCPTR(NEWSTRUCT, STRUCTCONST), TEMPLATE, +INCRF);
+50560 DRESSN:= NEWSTRUCT;
+50570 END;
+50580 (**)
+50590 (**)
+50600 FUNCTION GTOTN(NAK: NAKED; TEMPLATE: DPOINT): OBJECTP;
+50610 (*PGETTOTAL+3*)
+50620 BEGIN WITH NAK DO
+50630 BEGIN
+50640 GTOTN := DRESSN(POINTER, TEMPLATE);
+50650 IF FPTST(STOWEDVAL^) THEN GARBAGE(STOWEDVAL);
+50660 END
+50670 END;
+50680 (**)
+50690 (**)
+50700 PROCEDURE UNDRESSN (COLLECTOR, STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; SOURCEP: OBJECTP);
+50710 (*ASSIGNS THE (UN)DRESSED STRUCTPTR TO THE UNDRESSED COLLECTOR; SOURCEP MAY BE GARBAGE*)
+50720 BEGIN
+50730 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
+50740 MOVELEFT(STRUCTPTR, COLLECTOR, ORD(TEMPLATE))
+50750 ELSE (*STRUCT*)
+50760 BEGIN
+50770 PCINCR(STRUCTPTR, TEMPLATE, +INCRF);
+50780 PCINCR(COLLECTOR, TEMPLATE, -INCRF);
+50790 MOVELEFT(STRUCTPTR, COLLECTOR, TEMPLATE^[0]);
+50800 IF FPTST(SOURCEP^) THEN GARBAGE(SOURCEP);
+50810 END
+50820 END;
+50830 (**)
+50840 (**)
+50850 FUNCTION TASSNP(DESTINATION: OBJECTP; TEMP: NAKEGER; TEMPLATE: DPOINT): OBJECTP;
+50860 (*PASSIGNTN*)
+50870 VAR LSOURCE, PIL: OBJECTP;
+50880 PTR: OBJECTP;
+50890 BEGIN
+50900 WITH TEMP, DESTINATION^ DO
+50910 IF SORT IN [RECN, REFN] THEN
+50920 BEGIN LSOURCE := GTOTN(NAK, TEMPLATE); LSOURCE^.PCOUNT := 1;
+50930 FPDEC(PVALUE^); IF FPTST(PVALUE^) THEN GARBAGE(PVALUE);
+50940 PVALUE := LSOURCE END
+50950 (*CASE CAN'T HAPPEN ??
+50960 CREF:
+50970 BEGIN PIL := IPTR^.FIRSTPTR;
+50980 FPDEC(PIL^); IF FPTST(PIL^) THEN GARBAGE(PIL);
+50990 LSOURCE := GTOTN(NAK, PTR, TEMPLATE);
+51000 LSOURCE^.PCOUNT := 1; IPTR^.FIRSTPTR := LSOURCE END;
+51010 *)
+51020 ELSE
+51030 WITH ANCESTOR^ DO
+51040 IF FPTWO(PVALUE^) THEN
+51050 UNDRESSN(SAFEACCESS(DESTINATION), NAK.POINTER, TEMPLATE, NAK.STOWEDVAL)
+51060 ELSE
+51070 BEGIN
+51080 PVALUE^.OSCOPE := 0;
+51090 UNDRESSN(INCPTR(PVALUE, DESTINATION^.OFFSET), NAK.POINTER, TEMPLATE, NAK.STOWEDVAL)
+51100 END;
+51110 TASSNP := DESTINATION;
+51120 END;
+51130 (**)
+51140 (**)
+51150 FUNCTION TASSTP(DESTINATION, SOURCE: OBJECTP): OBJECTP;
+51160 (*PASSIGNTT+3*)
+51170 VAR PIL: OBJECTP;
+51180 BEGIN
+51190 WITH DESTINATION^ DO
+51200 IF SORT IN [RECN, REFN] THEN
+51210 BEGIN WITH SOURCE^ DO FINC;
+51220 FPDEC(PVALUE^); IF FPTST(PVALUE^) THEN GARBAGE(PVALUE);
+51230 PVALUE := SOURCE;
+51240 END
+51250 (*CASE CAN'T HAPPEN ??
+51260 ELSE IF SORT = CREF THEN
+51270 BEGIN PIL := IPTR^.FIRSTPTR;
+51280 FPDEC(PIL^); IF FPTST(PIL^) THEN GARBAGE(PIL);
+51290 IPTR^.FIRSTPTR := SOURCE; WITH SOURCE^ DO FINC END
+51300 *)
+51310 ELSE
+51320 WITH ANCESTOR^ DO
+51330 IF FPTWO(PVALUE^) THEN
+51340 UNDRESSN(SAFEACCESS(DESTINATION), INCPTR(SOURCE, STRUCTCONST), SOURCE^.DBLOCK, SOURCE)
+51350 ELSE
+51360 BEGIN
+51370 PVALUE^.OSCOPE := 0;
+51380 UNDRESSN(INCPTR(PVALUE, DESTINATION^.OFFSET), INCPTR(SOURCE, STRUCTCONST), SOURCE^.DBLOCK, SOURCE)
+51390 END;
+51400 TASSTP := DESTINATION;
+51410 END;
+51420 (**)
+51430 (**)
+51440 FUNCTION SCPTNP(DESTINATION: OBJECTP; TEMP: NAKEGER; TEMPLATE: DPOINT): OBJECTP;
+51450 (*PSCOPETN*)
+51460 BEGIN
+51470 IF DESTINATION^.OSCOPE<STRUCTSCOPE(TEMP.NAK.POINTER, TEMPLATE) THEN ERRORR(RSCOPE);
+51480 SCPTNP := TASSNP(DESTINATION, TEMP, TEMPLATE);
+51490 END;
+51500 (**)
+51510 (**)
+51520 FUNCTION SCPTTP(DESTINATION, SOURCE: OBJECTP): OBJECTP;
+51530 (*PSCOPETT+3*)
+51540 BEGIN
+51550 WITH SOURCE^ DO
+51560 BEGIN
+51570 IF OSCOPE=0 THEN OSCOPE := STRUCTSCOPE(INCPTR(SOURCE, STRUCTCONST), DBLOCK);
+51580 IF DESTINATION^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
+51590 END;
+51600 SCPTTP := TASSTP(DESTINATION, SOURCE);
+51610 END;
+51620 (**)
+51630 (**)
+51640 FUNCTION DREFN(REFER: OBJECTP): OBJECTP;
+51650 (*PDEREF+3*)
+51660 BEGIN
+51670 WITH REFER^ DO
+51680 BEGIN
+51690 CASE SORT OF
+51700 RECN, REFN:
+51710 BEGIN DREFN :=PVALUE; WITH PVALUE^ DO FINC END;
+51720 CREF: DREFN := IPTR^.FIRSTPTR;
+51730 REFSL1: DREFN :=DRESSN(INCPTR(ANCESTOR^.PVALUE, OFFSET), DBLOCK);
+51740 UNDEF: ERRORR(RDEREF);
+51750 NILL: ERRORR(RDEREFNIL);
+51760 END;
+51770 IF FPTST(REFER^) THEN GARBAGE(REFER);
+51780 IF SORT IN [RECN,REFN] THEN WITH PVALUE^ DO FDEC
+51790 END
+51800 END;
+51810 (**)
+51820 (**)
+51830 (*-02()
+51840 BEGIN
+51850 END;
+51860 ()-02*)
+51870 (*+01()
+51880 BEGIN (*OF MAIN PROGRAM*)
+51890 END (*OF EVERYTHING*).
+51900 ()+01*)
--- /dev/null
+52000 #include "rundecs.h"
+52010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+52020 (**)
+52030 (**)
+52040 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN;
+52050 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
+52060 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN;
+52070 PROCEDURE PCINCR(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN;
+52080 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN;
+52090 PROCEDURE PCINCRMULT(ELSPTR: OBJECTP; INCREMENT: INTEGER); EXTERN;
+52100 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
+52110 PROCEDURE TESTCC (TARGET: OBJECTP); EXTERN;
+52120 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+52130 FUNCTION CHKDESC(SOURCEMULT, CDESC: OBJECTP): OBJECTP; EXTERN;
+52140 (**)
+52150 (**)
+52160 PROCEDURE PCINCRSLICE(MULT: OBJECTP; VAR APDESC: PDESC; INCREMENT: INTEGER);
+52170 VAR I, ELSIZE: INTEGER;
+52180 TEMPLATE: DPOINT;
+52190 PTR: UNDRESSP;
+52200 BEGIN WITH APDESC, MULT^ DO
+52210 BEGIN
+52220 TEMPLATE := MDBLOCK;
+52230 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
+52240 IF ORD(TEMPLATE)=0 THEN (*DRESSED*)
+52250 WHILE NEXTEL(0, APDESC) DO WITH PDESCVEC[0] DO
+52260 BEGIN
+52270 PTR := INCPTR(PVALUE, PP);
+52280 WHILE ORD(PTR)<ORD(PVALUE)+PP+PSIZE DO WITH PTR^ DO
+52290 BEGIN
+52300 FINCD(FIRSTPTR^,INCREMENT);
+52310 IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
+52320 PTR := INCPTR(PTR, SZADDR);
+52330 END
+52340 END
+52350 ELSE (*NO ACTION*)
+52360 ELSE
+52370 BEGIN
+52380 ELSIZE := TEMPLATE^[0];
+52390 IF TEMPLATE^[1]>0 THEN
+52400 WHILE NEXTEL(0, APDESC) DO WITH PDESCVEC[0] DO
+52410 BEGIN
+52420 I := PP;
+52430 WHILE I<PP+PSIZE DO
+52440 BEGIN PCINCR(INCPTR(PVALUE, I), TEMPLATE, INCREMENT); I := I+ELSIZE END
+52450 END
+52460 END
+52470 END
+52480 END;
+52490 (**)
+52500 (**)
+52510 FUNCTION MULTSCOPE(MULT: OBJECTP):DEPTHRANGE;
+52520 VAR TEMPLATE: DPOINT;
+52530 NEWEST, CURRENT: DEPTHRANGE;
+52540 DRESSED: BOOLEAN;
+52550 APDESC: PDESC;
+52560 ELSIZE: INTEGER;
+52570 PTR: UNDRESSP;
+52580 BEGIN
+52590 TEMPLATE := MULT^.MDBLOCK;
+52600 DRESSED := ORD(TEMPLATE)=0;
+52610 IF DRESSED THEN ELSIZE := 1 ELSE ELSIZE := TEMPLATE^[0];
+52620 NEWEST := 0;
+52630 WITH MULT^ DO
+52640 IF BPTR=NIL THEN (*NOT A SLICE*)
+52650 BEGIN
+52660 PTR := INCPTR(PVALUE, ELSCONST);
+52670 WHILE ORD(PTR)<ORD(PVALUE)+ELSCONST+PVALUE^.D0 DO
+52680 BEGIN
+52690 IF DRESSED THEN WITH PTR^.FIRSTPTR^ DO
+52700 IF NEWEST<OSCOPE THEN NEWEST := OSCOPE
+52710 ELSE (*NO ACTION*)
+52720 ELSE BEGIN
+52730 CURRENT := STRUCTSCOPE(PTR, TEMPLATE);
+52740 IF NEWEST<CURRENT THEN NEWEST := CURRENT
+52750 END;
+52760 PTR := INCPTR(PTR, ELSIZE);
+52770 END;
+52780 PVALUE^.OSCOPE := NEWEST;
+52790 END
+52800 ELSE (*A SLICE*)
+52810 BEGIN
+52820 FORMPDESC(MULT, APDESC);
+52830 WHILE NEXTEL(0, APDESC) DO WITH APDESC DO WITH PDESCVEC[0] DO
+52840 BEGIN
+52850 PTR := INCPTR(PVALUE, PP);
+52860 WHILE ORD(PTR)<ORD(PVALUE)+PP+PSIZE DO
+52870 BEGIN
+52880 IF DRESSED THEN WITH PTR^.FIRSTPTR^ DO
+52890 IF NEWEST<OSCOPE THEN NEWEST := OSCOPE
+52900 ELSE (*NO ACTION*)
+52910 ELSE BEGIN
+52920 CURRENT := STRUCTSCOPE(PTR, TEMPLATE);
+52930 IF NEWEST<CURRENT THEN NEWEST := CURRENT
+52940 END;
+52950 PTR := INCPTR(PTR, ELSIZE);
+52960 END
+52970 END
+52980 END;
+52990 MULT^.OSCOPE := NEWEST;
+53000 MULTSCOPE := NEWEST
+53010 END;
+53020 (**)
+53030 (**)
+53040 FUNCTION TASSTM(DESTINATION, SOURCE: OBJECTP): OBJECTP;
+53050 (*PASSIGNTT+4*)
+53060 VAR DESTELS, SOURCELS, NEWSOURCE: OBJECTP;
+53070 VECPOS, ELSIZE: INTEGER;
+53080 PDESC1, PDESC2: PDESC;
+53090 DUMMY: BOOLEAN;
+53100 BEGIN
+53110 SOURCE := CHKDESC(SOURCE, DESTINATION);
+53120 SOURCELS := SOURCE^.PVALUE;
+53130 WITH DESTINATION^ DO
+53140 IF SORT = REFSLN THEN
+53150 BEGIN
+53160 IF FPTWO(ANCESTOR^.PVALUE^) THEN
+53170 TESTCC(DESTINATION);
+53180 DESTELS := ANCESTOR^.PVALUE;
+53190 FORMPDESC(DESTINATION, PDESC2);
+53200 PCINCRSLICE(ANCESTOR, PDESC2, -INCRF);
+53210 IF SOURCE^.BPTR=NIL THEN
+53220 WITH PDESC2 DO
+53230 BEGIN (*SOURCE IS NOT A SLICE*)
+53240 PCINCRMULT(SOURCELS, +INCRF);
+53250 VECPOS := ELSCONST;
+53260 WHILE NEXTEL(0, PDESC2) DO WITH PDESCVEC[0] DO
+53270 BEGIN
+53280 MOVELEFT(INCPTR(SOURCELS, VECPOS), INCPTR(DESTELS, PP), PSIZE);
+53290 VECPOS:= VECPOS+PSIZE;
+53300 END;
+53310 END
+53320 ELSE
+53330 BEGIN (*SOURCE IS A SLICE*)
+53340 FORMPDESC(SOURCE, PDESC1);
+53350 PCINCRSLICE(SOURCE, PDESC1, +INCRF);
+53360 IF PDESC1.PSIZE>PDESC2.PSIZE THEN
+53370 WHILE NEXTEL(0, PDESC1) DO
+53380 WITH PDESC1, PDESCVEC[0] DO
+53390 BEGIN
+53400 VECPOS := PP;
+53410 WHILE VECPOS<PP+PSIZE DO
+53420 BEGIN
+53430 DUMMY := NEXTEL(0, PDESC2);
+53440 WITH PDESC2 DO WITH PDESCVEC[0] DO
+53450 BEGIN
+53460 MOVELEFT(INCPTR(SOURCELS, VECPOS), INCPTR(DESTELS, PP), PSIZE);
+53470 VECPOS := VECPOS+PSIZE
+53480 END
+53490 END
+53500 END
+53510 ELSE
+53520 WHILE NEXTEL(0, PDESC2) DO WITH PDESC2, PDESCVEC[0] DO
+53530 BEGIN
+53540 VECPOS := PP;
+53550 WHILE VECPOS<PP+PSIZE DO BEGIN
+53560 DUMMY := NEXTEL(0, PDESC1);
+53570 WITH PDESC1 DO WITH PDESCVEC[0] DO
+53580 BEGIN
+53590 MOVELEFT(INCPTR(SOURCELS, PP), INCPTR(DESTELS, VECPOS), PSIZE);
+53600 VECPOS := VECPOS+PSIZE
+53610 END
+53620 END
+53630 END
+53640 END
+53650 END
+53660 ELSE (* SORT IS REFR OR RECR *)
+53670 IF SOURCE^.BPTR=NIL THEN (*SOURCE IS NOT A SLICE*)
+53680 BEGIN
+53690 DESTELS := PVALUE;
+53700 WITH SOURCELS^ DO
+53710 IF DESTELS^.CCOUNT>=CCOUNT THEN
+53720 IF CCOUNT<>0 THEN CCOUNT := CCOUNT+1 ELSE (*NA*)
+53730 ELSE IF DESTELS^.CCOUNT=0 THEN CCOUNT := 0;
+53740 (*CCOUNT=0 TREATED AS INFINITY*)
+53750 (*CCOUNT(SOURCELS) = MAX(CCOUNT(SOURCELS), CCOUNT(DESTELS)+1)*)
+53760 NEWSOURCE:=COPYDESC(SOURCE,MULT);
+53770 FPINC(SOURCELS^);
+53780 FPINC(NEWSOURCE^);
+53790 IF FPTST(PVALUE^) THEN GARBAGE(PVALUE);
+53800 PVALUE:= SOURCELS
+53810 END
+53820 ELSE
+53830 BEGIN
+53840 IF FPTWO(PVALUE^) THEN
+53850 TESTCC(DESTINATION);
+53860 DESTELS := PVALUE;
+53870 FORMPDESC(SOURCE, PDESC1);
+53880 PCINCRSLICE(SOURCE, PDESC1, +INCRF);
+53890 PCINCRMULT(DESTELS, -INCRF);
+53900 VECPOS := ELSCONST;
+53910 WHILE NEXTEL(0, PDESC1) DO WITH PDESC1, PDESCVEC[0] DO
+53920 BEGIN
+53930 MOVELEFT(INCPTR(SOURCELS, PP), INCPTR(DESTELS, VECPOS), PSIZE);
+53940 VECPOS:= VECPOS+PSIZE
+53950 END
+53960 END;
+53970 IF FPTST(SOURCE^) THEN GARBAGE(SOURCE);
+53980 TASSTM := DESTINATION;
+53990 END;
+54000 (**)
+54010 (**)
+54020 FUNCTION SCPTTM(DESTINATION, SOURCE: OBJECTP): OBJECTP;
+54030 (*PSCOPETT+4*)
+54040 BEGIN
+54050 WITH SOURCE^ DO
+54060 BEGIN
+54070 IF OSCOPE=0 THEN OSCOPE := MULTSCOPE(SOURCE);
+54080 IF DESTINATION^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
+54090 END;
+54100 SCPTTM := TASSTM(DESTINATION, SOURCE);
+54110 END;
+54120 (**)
+54130 (**)
+54140 (*-02() BEGIN END ; ()-02*)
+54150 (*+01()
+54160 BEGIN (*OF MAIN PROGRAM*)
+54170 END (*OF EVERYTHING*).
+54180 ()+01*)
--- /dev/null
+54200 #include "rundecs.h"
+54210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+54220 (**)
+54230 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
+54240 PROCEDURE ERRORR(N :INTEGER); EXTERN;
+54250 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
+54260 (**)
+54270 (**)
+54280 (*-01() (*-05()
+54290 FUNCTION TASSTS(DESTINATION: OBJECTP; SOURCE: A68INT): OBJECTP;
+54300 (*PASSIGNTT*)
+54310 VAR POINT: UNDRESSP;
+54320 BEGIN
+54330 WITH DESTINATION^.ANCESTOR^ DO
+54340 IF FPTWO(PVALUE^) THEN
+54350 POINT := SAFEACCESS(DESTINATION)
+54360 ELSE
+54370 BEGIN
+54380 PVALUE^.OSCOPE := 0;
+54390 POINT := INCPTR(PVALUE, DESTINATION^.OFFSET)
+54400 END;
+54410 POINT^.FIRSTINT := SOURCE;
+54420 TASSTS := DESTINATION
+54430 END;
+54440 (**)
+54450 (**)
+54460 FUNCTION TASSTS2(DESTINATION: OBJECTP; SOURCE: A68LONG): OBJECTP;
+54470 (*PASSIGNTT+1*)
+54480 VAR POINT: UNDRESSP;
+54490 BEGIN
+54500 WITH DESTINATION^.ANCESTOR^ DO
+54510 IF FPTWO(PVALUE^) THEN
+54520 POINT := SAFEACCESS(DESTINATION)
+54530 ELSE
+54540 BEGIN
+54550 PVALUE^.OSCOPE := 0;
+54560 POINT := INCPTR(PVALUE, DESTINATION^.OFFSET)
+54570 END;
+54580 POINT^.FIRSTLONG := SOURCE;
+54590 TASSTS2 := DESTINATION
+54600 END;
+54610 ()-05*) ()-01*)
+54620 (**)
+54630 (**)
+54640 (*-01()
+54650 FUNCTION TASSTPT(DESTINATION, SOURCE: OBJECTP): OBJECTP;
+54660 (*PASSIGNTT+2*)
+54670 VAR DESTPTR: OBJECTP;
+54680 DESTPTR2: UNDRESSP;
+54690 BEGIN
+54700 WITH SOURCE^ DO FINC;
+54710 IF DESTINATION^.OSCOPE<SOURCE^.OSCOPE THEN ERRORR(RSCOPE);
+54720 WITH DESTINATION^ DO
+54730 IF SORT=REFN THEN
+54740 BEGIN DESTPTR := PVALUE; PVALUE := SOURCE END
+54750 ELSE
+54760 BEGIN
+54770 WITH ANCESTOR^ DO
+54780 IF FPTWO(PVALUE^) THEN
+54790 DESTPTR2 := SAFEACCESS(DESTINATION)
+54800 ELSE
+54810 BEGIN
+54820 PVALUE^.OSCOPE := 0;
+54830 DESTPTR2 := INCPTR(PVALUE, DESTINATION^.OFFSET)
+54840 END;
+54850 DESTPTR := DESTPTR2^.FIRSTPTR;
+54860 DESTPTR2^.FIRSTPTR := SOURCE
+54870 END;
+54880 WITH DESTPTR^ DO BEGIN FDEC; IF FTST THEN GARBAGE(DESTPTR) END;
+54890 TASSTPT := DESTINATION
+54900 END;
+54910 (**)
+54920 (**)
+54930 ()-01*)
+54940 (*-02()
+54950 BEGIN
+54960 END;
+54970 ()-02*)
+54980 (*+01()
+54990 BEGIN (*OF MAIN PROGRAM*)
+55000 END (*OF EVERYTHING*).
+55010 ()+01*)
--- /dev/null
+double TIME()
+{
+
+struct tbuffer { long proc_user_time ; long proc_system_time ; long child_user_time ; long child_system_time ; } ;
+struct tbuffer tb ;
+
+times( &tb ) ;
+return( (double)( tb.proc_user_time + tb.proc_system_time + tb.child_user_time + tb.child_system_time ) / 60 ) ;
+
+}
--- /dev/null
+extern double POWR();
+double TIMESTE(pow, a)
+ double a;
+ int pow;
+ { int p ;
+ register double n, t, r, s;
+ p = pow < 0 ? -pow : pow;
+ n = 5.0;
+ t = 2.0;
+ if ( (p & 1) == 0 ) {r = 1.0; s = 1.0; }
+ else {r = 5.0; s = 2.0; }
+ p >>= 1;
+ while ( p != 0 ) {
+ n *= n; t *= t;
+ if ( (p & 1) != 0 ) {r *= n; s *= t; }
+ p >>= 1;
+ }
+ if (pow<0) {
+ return((a/r)/s);
+ } else {
+ return((a*r)*s);
+ }
+ }
--- /dev/null
+#include "e.h"
+
+ exp $PROCENTR ; calls through to the (lower case) pascal RT system
+ exp $PROCEXIT
+
+ ; these are calls through to the (lower case) pascal run-time system
+
+ pro $PROCENTR,0
+ LFL 0
+ cal $procentry
+ asp SZADDR
+ ret 0
+ end 0
+
+ pro $PROCEXIT,0
+ LFL 0
+ cal $procexit
+ asp SZADDR
+ ret 0
+ end 0
--- /dev/null
+66300 #include "rundecs.h"
+66310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+66320 (**)
+66330 (**)
+66340 FUNCTION TAN(X: REAL): REAL;
+66350 BEGIN TAN := SIN(X)/COS(X) END;
+66360 (**)
+66370 (**)
+66380 FUNCTION ARCCOS(X: REAL): REAL;
+66390 BEGIN
+66400 IF ABS(X)>0.5 THEN
+66410 ARCCOS := ARCTAN(SQRT(1-SQR(X))/X)+ORD(X<0)*(HALFPI.ACTUALPI+HALFPI.ACTUALPI)
+66420 ELSE
+66430 ARCCOS := HALFPI.ACTUALPI-ARCTAN(X/SQRT(1-SQR(X)));
+66440 END;
+66450 (**)
+66460 (**)
+66470 FUNCTION ARCSIN(X: REAL): REAL;
+66480 BEGIN
+66490 IF ABS(X)<0.5 THEN
+66500 ARCSIN := ARCTAN(X/SQRT(1-SQR(X)))
+66510 ELSE
+66520 ARCSIN := (1-2*ORD(X<0))*HALFPI.ACTUALPI-ARCTAN(SQRT(1-SQR(X))/X);
+66530 END;
+66540 (**)
+66550 (**)
+66560 (*-02()
+66570 BEGIN (* OF A68 *)
+66580 END (* OF A68 *);
+66590 ()-02*)
+66600 (*+01()
+66610 BEGIN (* OF MAIN PROGRAM *)
+66620 END (* OF MAIN PROGRAM *).
+66630 ()+01*)
--- /dev/null
+55100 #include "rundecs.h"
+55110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+55120 (**)
+55130 (**)
+55140 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+55150 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER); EXTERN;
+55160 (**)
+55170 (**)
+55180 FUNCTION GETSLN(NEWREFSLN:OBJECTP): OBJECTP;
+55190 VAR OLDREF:OBJECTP;
+55200 BEGIN
+55210 WITH NEWREFSLN^ DO
+55220 BEGIN
+55230 OLDREF := PVALUE;
+55240 ANCESTOR := OLDREF^.ANCESTOR;
+55250 WITH ANCESTOR^ DO FINC;
+55260 OSCOPE := OLDREF^.OSCOPE;
+55270 CCOUNT := 1;
+55280 END;
+55290 IF FPTST(OLDREF^) THEN GARBAGE(OLDREF);
+55300 GETSLN := NEWREFSLN;
+55310 END;
+55320 (**)
+55330 (**)
+55340 (*THE FOLLOWING PROCEDURES ARE USUALLY WRITTEN IN ASSEMBLER*)
+55350 (**)
+55360 (*-01()
+55370 PROCEDURE STARTSL(NOROWS, DEPTH: INTEGER);
+55380 (*PSTARTSLICE*)
+55390 (* SOURDESC, SLICDESC, SOURDEX, SLICDEX, ADJACC *)
+55400 BEGIN
+55410 SOURDEX:= 0;
+55420 SLICDEX:= 0;
+55430 SOURDESC := ASPTR(GETSTKTOP(SZADDR, DEPTH));
+55440 ENEW(SLICDESC, REFSLNCONST+NOROWS*SZPDS);
+55450 ADJACC := SOURDESC^.LBADJ;
+55460 WITH SLICDESC^ DO
+55470 BEGIN
+55480 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFSLN); ()-02*)
+55490 (*+02() PCOUNT:=0; SORT:=REFSLN; ()+02*)
+55500 ROWS := NOROWS-1;
+55510 MDBLOCK := SOURDESC^.MDBLOCK;
+55520 SIZE := SOURDESC^.SIZE
+55530 END;
+55540 END;
+55550 (**)
+55560 (**)
+55570 PROCEDURE TRIMS (* SOURDESC, SLICDESC, SOURDEX, SLICDEX, ADJACC,
+55580 REVISEDLB, SLICEPDS *);
+55590 (* ALL PARAMETERS ARE GLOBAL SINCE THERE ARE TOO MANY TO BE PASSED IN *)
+55600 (* THE X REGISTERS AND THE PROCEDURES ARE NON RECURSIVE *)
+55610 BEGIN
+55620 WITH SLICEPDS DO
+55630 BEGIN
+55640 ADJACC := ADJACC+(REVISEDLB-LI)*DI;
+55650 UI:= UI+REVISEDLB-LI;
+55660 LI := REVISEDLB;
+55670 SLICDESC^.DESCVEC[SLICDEX] := SLICEPDS;
+55680 END;
+55690 SOURDEX:= SOURDEX+1;
+55700 SLICDEX:= SLICDEX+1;
+55710 END;
+55720 (* *)
+55730 PROCEDURE SLICEA(DEPTH: INTEGER) (* SOURDESC, SOURDEX, SLICEPDS*);
+55740 (*PTRIM - [ ]*)
+55750 BEGIN
+55760 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+55770 SLICDESC^.DESCVEC[SLICDEX] := SLICEPDS;
+55780 SOURDEX := SOURDEX+1;
+55790 SLICDEX := SLICDEX+1;
+55800 END;
+55810 (* *)
+55820 PROCEDURE SLICEB(DEPTH: INTEGER) (*SOURDESC, SLICDESC, SOURDEX, SLICDEX, STACKPOS *);
+55830 (*PTRIM+1 - [@N]*)
+55840 BEGIN
+55850 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+55860 REVISEDLB := GETSTKTOP(SZINT, DEPTH);
+55870 TRIMS;
+55880 END;
+55890 (* *)
+55900 PROCEDURE SLICEC(DEPTH: INTEGER) (* ARGUEMENTS AS ABOVE *);
+55910 (*PTRIM+2 - [ :U]*)
+55920 BEGIN
+55930 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+55940 REVISEDLB := 1;
+55950 IF GETSTKTOP(SZINT, DEPTH)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
+55960 SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH);
+55970 TRIMS;
+55980 END;
+55990 (* *)
+56000 PROCEDURE SLICED(DEPTH: INTEGER) (* AS ABOVE *);
+56010 (*PTRIM+3 - [:U@N]*)
+56020 BEGIN
+56030 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56040 REVISEDLB := GETSTKTOP(SZINT, DEPTH);
+56050 IF GETSTKTOP(SZINT, DEPTH+SZINT)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, SZINT), SOURDEX);
+56060 SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH+SZINT);
+56070 TRIMS;
+56080 END;
+56090 (* *)
+56100 PROCEDURE SLICEE(DEPTH: INTEGER) (* AS ABOVE *);
+56110 (*PTRIM+4 - [L: ]*)
+56120 BEGIN
+56130 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56140 REVISEDLB:= 1;
+56150 IF GETSTKTOP(SZINT, DEPTH)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
+56160 SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH);
+56170 TRIMS;
+56180 END;
+56190 (* *)
+56200 PROCEDURE SLICEF(DEPTH: INTEGER) (* AS ABOVE *);
+56210 (*PTRIM+5 - [L: @N]*)
+56220 BEGIN
+56230 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56240 REVISEDLB := GETSTKTOP(SZINT, DEPTH);
+56250 IF GETSTKTOP(SZINT, DEPTH+SZINT)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
+56260 SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+SZINT);
+56270 TRIMS;
+56280 END;
+56290 (* *)
+56300 PROCEDURE SLICEG(DEPTH: INTEGER) (* AS ABOVE *);
+56310 (*PTRIM+6 - [L:U]*)
+56320 BEGIN
+56330 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56340 REVISEDLB:= 1;
+56350 IF GETSTKTOP(SZINT, DEPTH)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH), SOURDEX);
+56360 SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH);
+56370 IF GETSTKTOP(SZINT, DEPTH+SZINT)<SLICEPDS.LI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
+56380 SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+SZINT);
+56390 TRIMS;
+56400 END;
+56410 (* *)
+56420 PROCEDURE SLICEH(DEPTH: INTEGER) (* AS ABOVE *);
+56430 (*PTRIM+7 - [L:U@N]*)
+56440 BEGIN
+56450 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56460 REVISEDLB := GETSTKTOP(SZINT, DEPTH);
+56470 IF GETSTKTOP(SZINT, DEPTH+SZINT)>SLICEPDS.UI THEN SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+SZINT), SOURDEX);
+56480 SLICEPDS.UI := GETSTKTOP(SZINT, DEPTH+SZINT);
+56490 IF GETSTKTOP(SZINT, DEPTH+2*SZINT)<SLICEPDS.LI THEN
+56500 SLCMN(SOURDESC, GETSTKTOP(SZINT, DEPTH+2*SZINT), SOURDEX);
+56510 SLICEPDS.LI := GETSTKTOP(SZINT, DEPTH+2*SZINT);
+56520 TRIMS;
+56530 END;
+56540 (* *)
+56550 PROCEDURE SLICEI(DEPTH: INTEGER) (* AS ABOVE *);
+56560 (*PTRIM+8 - [:]*)
+56570 BEGIN
+56580 SLICEPDS := SOURDESC^.DESCVEC[SOURDEX];
+56590 REVISEDLB:= 1;
+56600 TRIMS;
+56610 END;
+56620 (* *)
+56630 PROCEDURE SLICEJ(DEPTH: INTEGER) (* NOW INCLUDING ADJACC *);
+56640 (*PTRIM+9 - [K]*)
+56650 BEGIN
+56660 WITH SOURDESC^.DESCVEC[SOURDEX] DO
+56670 BEGIN
+56680 IF (GETSTKTOP(SZINT, DEPTH)<LI) OR (GETSTKTOP(SZINT, DEPTH)>UI) THEN
+56690 SLCMN (SOURDESC , GETSTKTOP (SZINT , DEPTH) , SOURDEX ) ;
+56700 ADJACC := ADJACC-GETSTKTOP(SZINT, DEPTH)*DI;
+56710 END;
+56720 SOURDEX:= SOURDEX+1;
+56730 END;
+56740 (**)
+56750 (**)
+56760 FUNCTION ENDSL(PRIMARY: OBJECTP) (* SLICDESC, ADJACC +) : OBJECTP;
+56770 (*PENDSLICE*)
+56780 BEGIN
+56790 SLICDESC^.LBADJ := ADJACC;
+56800 SLICDESC^.PVALUE := PRIMARY;
+56810 ENDSL := SLICDESC
+56820 END;
+56830 ()-01*)
+56840 (**)
+56850 (**)
+56860 (*-02() BEGIN END ; ()-02*)
+56870 (*+01()
+56880 BEGIN (*OF MAIN PROGRAM*)
+56890 END (*OF EVERYTHING*).
+56900 ()+01*)
--- /dev/null
+62800 #include "rundecs.h"
+62810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+62820 (**)
+62830 (**)
+62840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
+62850 (**)
+62860 (**)
+62870 FUNCTION LWB(D: INTEGER; MULT: OBJECTP): INTEGER;
+62880 (*PLWB*)
+62890 BEGIN
+62900 WITH MULT^ DO
+62910 BEGIN
+62920 D := D-1;
+62930 IF (D<0) OR (D>ROWS) THEN ERRORR(RLWUPB);
+62940 LWB := DESCVEC[ROWS-D].LI;
+62950 END
+62960 END;
+62970 (**)
+62980 (**)
+62990 FUNCTION UPB(D: INTEGER; MULT: OBJECTP): INTEGER;
+63000 (*PUPB*)
+63010 BEGIN
+63020 WITH MULT^ DO
+63030 BEGIN
+63040 D := D-1;
+63050 IF (D<0) OR (D>ROWS) THEN ERRORR(RLWUPB);
+63060 UPB := DESCVEC[ROWS-D].UI;
+63070 END
+63080 END;
+63090 (**)
+63100 (**)
+63110 (*-02() BEGIN END ; ()-02*)
+63120 (*+01()
+63130 BEGIN (*OF MAIN PROGRAM*)
+63140 END (*OF EVERYTHING*).
+63150 ()+01*)
--- /dev/null
+63200 #include "rundecs.h"
+63210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+63220 (**)
+63230 (**)
+63240 FUNCTION LWBM(MULT: OBJECTP): INTEGER;
+63250 (*PLWBM*)
+63260 BEGIN
+63270 WITH MULT^ DO
+63280 LWBM := DESCVEC[ROWS].LI;
+63290 END;
+63300 (**)
+63310 (**)
+63320 FUNCTION UPBM(MULT: OBJECTP): INTEGER;
+63330 (*PUPBM*)
+63340 BEGIN
+63350 WITH MULT^ DO
+63360 UPBM := DESCVEC[ROWS].UI;
+63370 END;
+63380 (**)
+63390 (**)
+63400 (*-02() BEGIN END ; ()-02*)
+63410 (*+01()
+63420 BEGIN (*OF MAIN PROGRAM*)
+63430 END (*OF EVERYTHING*).
+63440 ()+01*)
--- /dev/null
+63500 #include "rundecs.h"
+63510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+63520 (**)
+63530 (**)
+63540 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+63550 (**)
+63560 (**)
+63570 FUNCTION UPBMSTR(POINT: OBJECTP): INTEGER;
+63580 (*PUPBMSTR*)
+63590 BEGIN
+63600 UPBMSTR := POINT^.STRLENGTH;
+63610 IF FPTST(POINT^) THEN GARBAGE(POINT)
+63620 END;
+63630 (**)
+63640 (**)
+63650 FUNCTION LWBMSTR(POINT: OBJECTP): INTEGER;
+63660 (*PLWBMSTR*)
+63670 BEGIN
+63680 IF FPTST(POINT^) THEN GARBAGE(POINT);
+63690 LWBMSTR := 1;
+63700 END;
+63710 (**)
+63720 (**)
+63730 (*-02() BEGIN END ; ()-02*)
+63740 (*+01()
+63750 BEGIN (*OF MAIN PROGRAM*)
+63760 END (*OF EVERYTHING*).
+63770 ()+01*)
--- /dev/null
+99200 #include "rundecs.h"
+99210 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+99220 (**)
+99230 (**)
+99240 FUNCTION SUBFIXED(SIGN, BEFORE, POINT, AFTER : INTEGER; VAR EXP: INTEGER; EXPNEEDED: BOOLEAN;
+99250 X: REALTEGER; R: BOOLEAN; VAR S: OBJECTP; START: INTEGER): BOOLEAN; EXTERN;
+99260 PROCEDURE ERRORFILL(VAR S: OBJECTP; LENGTH: INTEGER); EXTERN;
+99270 (**)
+99280 (**)
+99290 FUNCTION WHOLE(XMODE: INTEGER; VAL: REALTEGER; WIDTH: INTEGER): OBJECTP;
+99300 VAR
+99310 S: OBJECTP;
+99320 SIGN, E: INTEGER;
+99330 BEGIN
+99340 SIGN := ORD((WIDTH>0) OR (VAL.INT<0));
+99350 S := NIL;
+99360 IF NOT SUBFIXED(SIGN,
+99370 ABS(WIDTH)-SIGN-ORD(WIDTH=0), (*-VE FOR WIDTH=0*)
+99380 0, 0, E, FALSE,
+99390 VAL, XMODE=2,
+99400 S, 1) THEN
+99410 ERRORFILL(S, ABS(WIDTH)+ORD(WIDTH=0));
+99420 WHOLE := S;
+99430 END;
+99440 (**)
+99450 (**)
+99460 (*-02()
+99470 BEGIN (*OF A68*)
+99480 END; (*OF A68*)
+99490 ()-02*)
+99500 (*+01()
+99510 BEGIN (*OF MAIN PROGRAM*)
+99520 END (* OF EVERYTHING *).
+99530 ()+01*)
--- /dev/null
+57000 #include "rundecs.h"
+57010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+57020 (**)
+57030 (**)
+57040 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
+57050 (**)
+57060 (**)
+57070 FUNCTION WIDCHAR(CH: CHAR): OBJECTP;
+57080 (*PWIDEN+4*)
+57090 VAR POINT :OBJECTP;
+57100 BEGIN
+57110 POINT := CRSTRING(1);
+57120 POINT^.CHARVEC[1] := CH;
+57130 WIDCHAR := POINT;
+57140 END;
+57150 (**)
+57160 (**)
+57170 (*-02() BEGIN END ; ()-02*)
+57180 (*+01()
+57190 BEGIN (*OF MAIN PROGRAM*)
+57200 END (*OF EVERYTHING*).
+57210 ()+01*)
--- /dev/null
+57300 #include "rundecs.h"
+57310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
+57320 (**)
+57330 (**)
+57340 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
+57350 (**)
+57360 (**)
+57370 FUNCTION WIDENM(COUNT: INTEGER): OBJECTP;
+57380 VAR NEWELS, NEWMULT: OBJECTP;
+57390 BEGIN
+57400 ENEW(NEWMULT, MULTCONST+SZPDS);
+57410 WITH NEWMULT^ DO
+57420 BEGIN
+57430 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
+57440 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
+57450 (*+01() SECONDWORD := 0; ()+01*)
+57460 SIZE := 1;
+57470 WITH DESCVEC[0] DO
+57480 BEGIN LI := 1; UI := COUNT; DI := SZINT END;
+57490 ROWS := 0; LBADJ := SZINT-ELSCONST; PCOUNT := 1;
+57500 MDBLOCK := ASPTR(SZINT);
+57510 ENEW(NEWELS, ELSCONST+COUNT*SZINT);
+57520 WITH NEWELS^ DO
+57530 BEGIN
+57540 (*-02() FIRSTWORD := SORTSHIFT * ORD(IELS); ()-02*)
+57550 (*+02() PCOUNT:=0; SORT:=IELS; ()+02*)
+57560 OSCOPE := 0;
+57570 IHEAD := NIL;
+57580 DBLOCK := ASPTR(SZINT); D0 := COUNT*SZINT; CCOUNT := 1; PCOUNT := 1;
+57590 END;
+57600 PVALUE := NEWELS; IHEAD := NIL; FPTR := NIL; BPTR := NIL
+57610 END;
+57620 WIDENM := NEWMULT;
+57630 END;
+57640 (**)
+57650 (**)
+57660 FUNCTION WIDBITS(BITS: INTEGER): OBJECTP;
+57670 (*PWIDEN+5*)
+57680 VAR NEWMULT: OBJECTP;
+57690 PTR: UNDRESSP;
+57700 BEGIN
+57710 NEWMULT := WIDENM(BITSWIDTH);
+57720 WITH NEWMULT^ DO
+57730 BEGIN
+57740 PTR := INCPTR(PVALUE, ELSCONST);
+57750 WHILE ORD(PTR)<ORD(PVALUE)+ELSCONST+BITSWIDTH DO
+57760 BEGIN PTR^.FIRSTWORD := BITS; BITS := BITS*2; PTR := INCPTR(PTR, SZINT) END;
+57770 END;
+57780 WIDBITS := NEWMULT;
+57790 END;
+57800 (**)
+57810 (**)
+57820 FUNCTION WIDBYTS(BYTES: INTEGER): OBJECTP;
+57830 (*PWIDEN+6*)
+57840 VAR NEWMULT: OBJECTP;
+57850 BBB: RECORD CASE SEVERAL OF
+57860 1: (B1: INTEGER);
+57870 2: (B2: PACKED ARRAY [1..BYTESWIDTH] OF CHAR);
+57880 0 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
+57890 END;
+57900 PTR: UNDRESSP; I: INTEGER;
+57910 BEGIN
+57920 NEWMULT := WIDENM(BYTESWIDTH);
+57930 BBB.B1 := BYTES;
+57940 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
+57950 FOR I := 1 TO BYTESWIDTH DO
+57960 BEGIN PTR^.FIRSTINT := ORD(BBB.B2[I]); PTR := INCPTR(PTR, SZINT) END;
+57970 WIDBYTS := NEWMULT;
+57980 END;
+57990 (**)
+58000 (**)
+58010 FUNCTION WIDSTR(STR: OBJECTP): OBJECTP;
+58020 (*PWIDEN+7*)
+58030 VAR NEWMULT: OBJECTP;
+58040 PTR: UNDRESSP; I: INTEGER;
+58050 BEGIN
+58060 NEWMULT := WIDENM(STR^.STRLENGTH);
+58070 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
+58080 FOR I := 1 TO STR^.STRLENGTH DO
+58090 BEGIN PTR^.FIRSTINT := ORD(STR^.CHARVEC[I]); PTR := INCPTR(PTR, SZINT) END;
+58100 IF FPTST(STR^) THEN GARBAGE(STR);
+58110 WIDSTR := NEWMULT;
+58120 END;
+58130 (**)
+58140 (**)
+58150 (*-02() BEGIN END ; ()-02*)
+58160 (*+01()
+58170 BEGIN (*OF MAIN PROGRAM*)
+58180 END (*OF EVERYTHING*).
+58190 ()+01*)
--- /dev/null
+#include "e.h"
+
+ exp $WRC
+ exp $WRS
+
+ pro $WRC,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR ; first param after static link, fil
+ lol SZADDR+SZADDR ; second param ,ch
+ cal $_wrc ; call to PC run time system
+ asp SZADDR+SZWORD
+ ret 0
+ end SZWORD
+
+ pro $WRS,SZWORD
+ loc PASCALSTAMP
+ stl -SZWORD
+ LFL SZADDR ; first param after static link ,fil
+ LFL SZADDR+SZADDR ; second param ,cp
+ lol SZADDR+SZADDR+SZADDR ; third param ,len
+ cal $_wrs
+ asp SZADDR+SZADDR+SZWORD
+ ret 0
+ end SZWORD
public / ack.git / commitdiff