231 lines
7.6 KiB
OpenEdge ABL
231 lines
7.6 KiB
OpenEdge ABL
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*)
|