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