ack/lang/a68s/liba68s/genrec.p

114 lines
3.4 KiB
OpenEdge ABL
Raw Normal View History

1988-10-04 13:41:01 +00:00
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*)