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