114 lines
3.4 KiB
OpenEdge ABL
114 lines
3.4 KiB
OpenEdge ABL
30100 #include "rundecs.h"
|
|
30110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
30120 (**)
|
|
30130 (**)
|
|
30140 FUNCTION CRSTRUCT(TEMPLATE: DPOINT): OBJECTP; EXTERN;
|
|
30150 FUNCTION HEAPMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP; EXTERN;
|
|
30160 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN;
|
|
30170 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
|
|
30180 (**)
|
|
30190 (**)
|
|
30200 FUNCTION RECCMN (THEREC: OBJECTP; LOCRG: DEPTHRANGE): OBJECTP;
|
|
30210 (*COMMON FOR CREATING RECURSIVE OBJECTS*)
|
|
30220 VAR TEMPREC: OBJECTP;
|
|
30230 CUTOP: PRANGE;
|
|
30240 BEGIN
|
|
30250 CUTOP := FIRSTRG.RIBOFFSET;
|
|
30260 WITH CUTOP^ DO WITH FIRSTW DO
|
|
30270 BEGIN
|
|
30280 TEMPREC := RECGEN;
|
|
30290 RECGEN := THEREC;
|
|
30300 END;
|
|
30310 WITH THEREC^ DO
|
|
30320 BEGIN
|
|
30330 OSCOPE := SCOPE+LOCRG;
|
|
30340 NEXT:= TEMPREC;
|
|
30350 PREV := INCPTR(CUTOP, RECOFFSET-NEXTOFFSET);
|
|
30360 END;
|
|
30370 IF TEMPREC <> NIL THEN TEMPREC^.PREV:= THEREC;
|
|
30380 RECCMN:= THEREC;
|
|
30390 END;
|
|
30400 (**)
|
|
30410 (**)
|
|
30420 FUNCTION CRRECN(ANOBJECT:OBJECTP):OBJECTP;
|
|
30430 (* PCREATEREF+1 *)
|
|
30440 VAR NEWRECN:OBJECTP;
|
|
30450 BEGIN
|
|
30460 ENEW(NEWRECN,RECNSIZE);
|
|
30470 WITH NEWRECN^ DO
|
|
30480 BEGIN
|
|
30490 (*-02() FIRSTWORD := SORTSHIFT * ORD(RECN); ()-02*)
|
|
30500 (*+02() PCOUNT:=0; SORT:=RECN; ()+02*)
|
|
30510 (*+01() SECONDWORD := 0; ()+01*)
|
|
30520 PVALUE:=ANOBJECT;
|
|
30530 WITH PVALUE^ DO FINC;
|
|
30540 ANCESTOR := NEWRECN;
|
|
30550 OFFSET := STRUCTCONST;
|
|
30560 CRRECN:=RECCMN(NEWRECN,FIRSTRG.RIBOFFSET^.RGSCOPE)
|
|
30570 END
|
|
30580 END;
|
|
30590 (**)
|
|
30600 (**)
|
|
30610 FUNCTION GENRMUL(NEWMULT: OBJECTP; TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
|
|
30620 (*PLEAPGEN+5*)
|
|
30630 VAR NEWRECR: OBJECTP;
|
|
30640 BEGIN
|
|
30650 NEWRECR := HEAPMUL(NEWMULT, TEMPLATE);
|
|
30660 NEWRECR^.SORT := RECR;
|
|
30670 GENRMUL := RECCMN(NEWRECR, LOCRG)
|
|
30680 END;
|
|
30690 (**)
|
|
30700 (**)
|
|
30710 FUNCTION GENRSTR (TEMPLATE: DPOINT; LOCRG: DEPTHRANGE): OBJECTP;
|
|
30720 (*PLEAPGEN+2*)
|
|
30730 VAR NEWRECN: OBJECTP;
|
|
30740 BEGIN
|
|
30750 ENEW(NEWRECN, RECNSIZE);
|
|
30760 WITH NEWRECN^ DO
|
|
30770 BEGIN
|
|
30780 (*-02() FIRSTWORD := SORTSHIFT * ORD(RECN); ()-02*)
|
|
30790 (*+02() PCOUNT:=0; SORT:=RECN; ()+02*)
|
|
30800 (*+01() SECONDWORD := 0; ()+01*)
|
|
30810 PVALUE := CRSTRUCT(TEMPLATE);
|
|
30820 ANCESTOR := NEWRECN;
|
|
30830 OFFSET := STRUCTCONST;
|
|
30840 WITH PVALUE^ DO FINC
|
|
30850 END;
|
|
30860 GENRSTR := RECCMN(NEWRECN, LOCRG)
|
|
30870 END;
|
|
30880 (**)
|
|
30890 (**)
|
|
30900 FUNCTION CRRECR(ANOBJECT: OBJECTP): OBJECTP;
|
|
30910 (*PCREATEREF+3*)
|
|
30920 VAR NEWREC: OBJECTP;
|
|
30930 BEGIN
|
|
30940 WITH ANOBJECT^ DO
|
|
30950 BEGIN
|
|
30960 IF (BPTR<>NIL) AND (SORT=MULT) THEN (*SOURCE IS A SLICE*)
|
|
30970 COPYSLICE(ANOBJECT);
|
|
30980 IF FTST THEN
|
|
30990 BEGIN
|
|
31000 NEWREC :=ANOBJECT;
|
|
31010 NEWREC^.SORT := RECR;
|
|
31020 END
|
|
31030 ELSE
|
|
31040 BEGIN
|
|
31050 NEWREC := COPYDESC(ANOBJECT,MULT);
|
|
31060 WITH NEWREC^.PVALUE^ DO FINC
|
|
31070 END
|
|
31080 END;
|
|
31090 WITH NEWREC^ DO
|
|
31100 BEGIN
|
|
31110 ANCESTOR := NEWREC;
|
|
31120 CCOUNT := 1;
|
|
31130 CRRECR := RECCMN(NEWREC, FIRSTRG.RIBOFFSET^.RGSCOPE);
|
|
31140 END
|
|
31150 END;
|
|
31160 (**)
|
|
31170 (**)
|
|
31180 (*-02() BEGIN END ; ()-02*)
|
|
31190 (*+01()
|
|
31200 BEGIN (*OF MAIN PROGRAM*)
|
|
31210 END (*OF EVERYTHING*).
|
|
31220 ()+01*)
|