177 lines
6.2 KiB
OpenEdge ABL
177 lines
6.2 KiB
OpenEdge ABL
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*)
|