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