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