ack/lang/a68s/liba68s/openclose.p

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