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*)