90 lines
3.5 KiB
OpenEdge ABL
90 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*)
|