89 lines
		
	
	
	
		
			3.5 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			89 lines
		
	
	
	
		
			3.5 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
70000 #include "rundecs.h"
 | 
						|
70010     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
 | 
						|
70020  (**)
 | 
						|
70030 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
 | 
						|
70040 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
 | 
						|
70050 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
 | 
						|
70060 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
 | 
						|
70070 (**)
 | 
						|
70080 (**)
 | 
						|
70090 (*+01() (*$X6*) ()+01*)
 | 
						|
70100 FUNCTION PROC( PROCEDURE P (*-01() ( COV: OBJECTP ; EFET: FETROOMP ) ()-01*) ): ASPROC ; EXTERN ;
 | 
						|
70110 (*-01()
 | 
						|
70120 FUNCTION PROC1(
 | 
						|
70130   PROCEDURE P( COV: OBJECTP ; CHARS: GETBUFTYPE ; TERM: TERMSET ; I: INTEGER ; EFET: FETROOMP )
 | 
						|
70140               ): ASPROC ; EXTERN ;
 | 
						|
70150 FUNCTION PROC2( PROCEDURE P( COV, STRNG: OBJECTP ; LB, UB: INTEGER ; EFET: FETROOMP ) ): ASPROC ; EXTERN ;
 | 
						|
70160 FUNCTION PROC3( PROCEDURE P( COV: OBJECTP ; P, L, C: INTEGER ; EFET: FETROOMP ) ): ASPROC ; EXTERN ;
 | 
						|
70170 FUNCTION PROCH( PROCEDURE P( COV: OBJECTP ; L: LFNTYPE ) ): ASPROC ; EXTERN ;
 | 
						|
70180 ()-01*)
 | 
						|
70190 PROCEDURE ASSWRSTR(COV, PUTSTRING: OBJECTP; LB, UB: INTEGER; EFET: FETROOMP); EXTERN;
 | 
						|
70200 PROCEDURE ASSRDSTR(COV:OBJECTP; CHARS:GETBUFTYPE; TERM(*+01(),TERM1()+01*): TERMSET; I: INTEGER; EFET: FETROOMP);
 | 
						|
70210     EXTERN;
 | 
						|
70220 PROCEDURE ASSNEWLINE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
 | 
						|
70230 PROCEDURE ASSNEWPAGE(COV: OBJECTP; EFET: FETROOMP); EXTERN;
 | 
						|
70240 PROCEDURE ASSRESET(COV: OBJECTP; EFET: FETROOMP); EXTERN;
 | 
						|
70250 PROCEDURE ASSSET(COV: OBJECTP; P, L, C: INTEGER; EFET: FETROOMP); EXTERN;
 | 
						|
70260 (**)
 | 
						|
70270 (**)
 | 
						|
70280 FUNCTION ASSOCIATE(RF,CHARFILE:OBJECTP): INTEGER;
 | 
						|
70290   VAR CB,OFF,CPS:INTEGER;
 | 
						|
70300       F,PCOV:OBJECTP;
 | 
						|
70310     BEGIN
 | 
						|
70320     F := INCPTR(SAFEACCESS(RF), -STRUCTCONST);
 | 
						|
70330     PCINCR(INCPTR(F, STRUCTCONST),FILEBLOCK,-INCRF);
 | 
						|
70340     ENEW(PCOV, COVERSIZE);
 | 
						|
70350 (*-02() PCOV^.FIRSTWORD := SORTSHIFT * ORD(COVER) + INCRF; ()-02*)
 | 
						|
70360 (*+02() PCOV^.PCOUNT:=1; PCOV^.SORT:=COVER; ()+02*)
 | 
						|
70370     F^.PCOVER:=PCOV;
 | 
						|
70380     WITH CHARFILE^ DO
 | 
						|
70390       WITH DESCVEC[0] DO
 | 
						|
70400         BEGIN CPS:=DI-LBADJ;
 | 
						|
70410         CB:=UI;
 | 
						|
70420         OFF:=DI;
 | 
						|
70430         IF LI<>1 THEN ERRORR(WRONGMULT);
 | 
						|
70440         END;
 | 
						|
70450     WITH PCOV^ DO
 | 
						|
70460       BEGIN COFCPOS:=1; LOFCPOS:=1; POFCPOS:=1;
 | 
						|
70470       CHARBOUND:=CB; LINEBOUND:=1; PAGEBOUND:=1;
 | 
						|
70480       STATUS:=[OPENED,CHARMOOD];
 | 
						|
70490       POSSIBLES:=[GETPOSS,PUTPOSS,RESETPOSS,SETPOSS,ASSPOSS];
 | 
						|
70500       DOPUTS := PROC(*-01()2()-01*)(ASSWRSTR);
 | 
						|
70510       DOGETS := PROC(*-01()1()-01*)(ASSRDSTR);
 | 
						|
70520       DONEWLINE := PROC(ASSNEWLINE);
 | 
						|
70530       DONEWPAGE := PROC(ASSNEWPAGE);
 | 
						|
70540       DORESET := PROC(ASSRESET);
 | 
						|
70550       DOSET := PROC(*-01()3()-01*)(ASSSET);
 | 
						|
70560       ASSOC := TRUE;
 | 
						|
70570       ASSREF:=CHARFILE;
 | 
						|
70580       CPOSELS:=CPS;
 | 
						|
70590       OFFSETDI:=OFF;
 | 
						|
70600       FPINC(CHARFILE^);
 | 
						|
70610       OSCOPE := CHARFILE^.OSCOPE;
 | 
						|
70620       END;
 | 
						|
70630     WITH F^ DO
 | 
						|
70640       BEGIN
 | 
						|
70650       IF RF^.OSCOPE<PCOV^.OSCOPE THEN ERRORR(RSCOPE);
 | 
						|
70660       LOGICALFILEMENDED:=UNDEFIN;
 | 
						|
70670       PHYSICALFILEMENDED:=UNDEFIN;
 | 
						|
70680       PAGEMENDED:=UNDEFIN;
 | 
						|
70690       LINEMENDED:=UNDEFIN;
 | 
						|
70700       TERM:=[];
 | 
						|
70710       (*+01() TERM1:=[] ; ()+01*)
 | 
						|
70720       END;
 | 
						|
70730     IF FPTST(RF^) THEN GARBAGE(RF);
 | 
						|
70740     ASSOCIATE := ORD(NOT(OPENED IN PCOV^.STATUS));
 | 
						|
70750     END;   (*ASSOCIATE*)
 | 
						|
70760 (**)
 | 
						|
70770 (**)
 | 
						|
70780 (*+01() (*$X4*) ()+01*)
 | 
						|
70790 (**)
 | 
						|
70800 (**)
 | 
						|
70810 (*-02()
 | 
						|
70820 BEGIN (*OF A68*)
 | 
						|
70830 END; (*OF A68*)
 | 
						|
70840 ()-02*)
 | 
						|
70850 (*+01()
 | 
						|
70860 BEGIN (*OF MAIN PROGRAM*)
 | 
						|
70870 END (* OF EVERYTHING *).
 | 
						|
70880 ()+01*)
 |