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