52000 #include "rundecs.h" 52010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *) 52020 (**) 52030 (**) 52040 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN; 52050 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN; 52060 FUNCTION NEXTEL(I: INTEGER; VAR PDESC1: PDESC): BOOLEAN; EXTERN; 52070 PROCEDURE PCINCR(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN; 52080 PROCEDURE FORMPDESC(OLDESC: OBJECTP; VAR PDESC1: PDESC); EXTERN; 52090 PROCEDURE PCINCRMULT(ELSPTR: OBJECTP; INCREMENT: INTEGER); EXTERN; 52100 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN; 52110 PROCEDURE TESTCC (TARGET: OBJECTP); EXTERN; 52120 PROCEDURE ERRORR(N :INTEGER); EXTERN; 52130 FUNCTION CHKDESC(SOURCEMULT, CDESC: OBJECTP): OBJECTP; EXTERN; 52140 (**) 52150 (**) 52160 PROCEDURE PCINCRSLICE(MULT: OBJECTP; VAR APDESC: PDESC; INCREMENT: INTEGER); 52170 VAR I, ELSIZE: INTEGER; 52180 TEMPLATE: DPOINT; 52190 PTR: UNDRESSP; 52200 BEGIN WITH APDESC, MULT^ DO 52210 BEGIN 52220 TEMPLATE := MDBLOCK; 52230 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*) 52240 IF ORD(TEMPLATE)=0 THEN (*DRESSED*) 52250 WHILE NEXTEL(0, APDESC) DO WITH PDESCVEC[0] DO 52260 BEGIN 52270 PTR := INCPTR(PVALUE, PP); 52280 WHILE ORD(PTR)<ORD(PVALUE)+PP+PSIZE DO WITH PTR^ DO 52290 BEGIN 52300 FINCD(FIRSTPTR^,INCREMENT); 52310 IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR); 52320 PTR := INCPTR(PTR, SZADDR); 52330 END 52340 END 52350 ELSE (*NO ACTION*) 52360 ELSE 52370 BEGIN 52380 ELSIZE := TEMPLATE^[0]; 52390 IF TEMPLATE^[1]>0 THEN 52400 WHILE NEXTEL(0, APDESC) DO WITH PDESCVEC[0] DO 52410 BEGIN 52420 I := PP; 52430 WHILE I<PP+PSIZE DO 52440 BEGIN PCINCR(INCPTR(PVALUE, I), TEMPLATE, INCREMENT); I := I+ELSIZE END 52450 END 52460 END 52470 END 52480 END; 52490 (**) 52500 (**) 52510 FUNCTION MULTSCOPE(MULT: OBJECTP):DEPTHRANGE; 52520 VAR TEMPLATE: DPOINT; 52530 NEWEST, CURRENT: DEPTHRANGE; 52540 DRESSED: BOOLEAN; 52550 APDESC: PDESC; 52560 ELSIZE: INTEGER; 52570 PTR: UNDRESSP; 52580 BEGIN 52590 TEMPLATE := MULT^.MDBLOCK; 52600 DRESSED := ORD(TEMPLATE)=0; 52610 IF DRESSED THEN ELSIZE := 1 ELSE ELSIZE := TEMPLATE^[0]; 52620 NEWEST := 0; 52630 WITH MULT^ DO 52640 IF BPTR=NIL THEN (*NOT A SLICE*) 52650 BEGIN 52660 PTR := INCPTR(PVALUE, ELSCONST); 52670 WHILE ORD(PTR)<ORD(PVALUE)+ELSCONST+PVALUE^.D0 DO 52680 BEGIN 52690 IF DRESSED THEN WITH PTR^.FIRSTPTR^ DO 52700 IF NEWEST<OSCOPE THEN NEWEST := OSCOPE 52710 ELSE (*NO ACTION*) 52720 ELSE BEGIN 52730 CURRENT := STRUCTSCOPE(PTR, TEMPLATE); 52740 IF NEWEST<CURRENT THEN NEWEST := CURRENT 52750 END; 52760 PTR := INCPTR(PTR, ELSIZE); 52770 END; 52780 PVALUE^.OSCOPE := NEWEST; 52790 END 52800 ELSE (*A SLICE*) 52810 BEGIN 52820 FORMPDESC(MULT, APDESC); 52830 WHILE NEXTEL(0, APDESC) DO WITH APDESC DO WITH PDESCVEC[0] DO 52840 BEGIN 52850 PTR := INCPTR(PVALUE, PP); 52860 WHILE ORD(PTR)<ORD(PVALUE)+PP+PSIZE DO 52870 BEGIN 52880 IF DRESSED THEN WITH PTR^.FIRSTPTR^ DO 52890 IF NEWEST<OSCOPE THEN NEWEST := OSCOPE 52900 ELSE (*NO ACTION*) 52910 ELSE BEGIN 52920 CURRENT := STRUCTSCOPE(PTR, TEMPLATE); 52930 IF NEWEST<CURRENT THEN NEWEST := CURRENT 52940 END; 52950 PTR := INCPTR(PTR, ELSIZE); 52960 END 52970 END 52980 END; 52990 MULT^.OSCOPE := NEWEST; 53000 MULTSCOPE := NEWEST 53010 END; 53020 (**) 53030 (**) 53040 FUNCTION TASSTM(DESTINATION, SOURCE: OBJECTP): OBJECTP; 53050 (*PASSIGNTT+4*) 53060 VAR DESTELS, SOURCELS, NEWSOURCE: OBJECTP; 53070 VECPOS, ELSIZE: INTEGER; 53080 PDESC1, PDESC2: PDESC; 53090 DUMMY: BOOLEAN; 53100 BEGIN 53110 SOURCE := CHKDESC(SOURCE, DESTINATION); 53120 SOURCELS := SOURCE^.PVALUE; 53130 WITH DESTINATION^ DO 53140 IF SORT = REFSLN THEN 53150 BEGIN 53160 IF FPTWO(ANCESTOR^.PVALUE^) THEN 53170 TESTCC(DESTINATION); 53180 DESTELS := ANCESTOR^.PVALUE; 53190 FORMPDESC(DESTINATION, PDESC2); 53200 PCINCRSLICE(ANCESTOR, PDESC2, -INCRF); 53210 IF SOURCE^.BPTR=NIL THEN 53220 WITH PDESC2 DO 53230 BEGIN (*SOURCE IS NOT A SLICE*) 53240 PCINCRMULT(SOURCELS, +INCRF); 53250 VECPOS := ELSCONST; 53260 WHILE NEXTEL(0, PDESC2) DO WITH PDESCVEC[0] DO 53270 BEGIN 53280 MOVELEFT(INCPTR(SOURCELS, VECPOS), INCPTR(DESTELS, PP), PSIZE); 53290 VECPOS:= VECPOS+PSIZE; 53300 END; 53310 END 53320 ELSE 53330 BEGIN (*SOURCE IS A SLICE*) 53340 FORMPDESC(SOURCE, PDESC1); 53350 PCINCRSLICE(SOURCE, PDESC1, +INCRF); 53360 IF PDESC1.PSIZE>PDESC2.PSIZE THEN 53370 WHILE NEXTEL(0, PDESC1) DO 53380 WITH PDESC1, PDESCVEC[0] DO 53390 BEGIN 53400 VECPOS := PP; 53410 WHILE VECPOS<PP+PSIZE DO 53420 BEGIN 53430 DUMMY := NEXTEL(0, PDESC2); 53440 WITH PDESC2 DO WITH PDESCVEC[0] DO 53450 BEGIN 53460 MOVELEFT(INCPTR(SOURCELS, VECPOS), INCPTR(DESTELS, PP), PSIZE); 53470 VECPOS := VECPOS+PSIZE 53480 END 53490 END 53500 END 53510 ELSE 53520 WHILE NEXTEL(0, PDESC2) DO WITH PDESC2, PDESCVEC[0] DO 53530 BEGIN 53540 VECPOS := PP; 53550 WHILE VECPOS<PP+PSIZE DO BEGIN 53560 DUMMY := NEXTEL(0, PDESC1); 53570 WITH PDESC1 DO WITH PDESCVEC[0] DO 53580 BEGIN 53590 MOVELEFT(INCPTR(SOURCELS, PP), INCPTR(DESTELS, VECPOS), PSIZE); 53600 VECPOS := VECPOS+PSIZE 53610 END 53620 END 53630 END 53640 END 53650 END 53660 ELSE (* SORT IS REFR OR RECR *) 53670 IF SOURCE^.BPTR=NIL THEN (*SOURCE IS NOT A SLICE*) 53680 BEGIN 53690 DESTELS := PVALUE; 53700 WITH SOURCELS^ DO 53710 IF DESTELS^.CCOUNT>=CCOUNT THEN 53720 IF CCOUNT<>0 THEN CCOUNT := CCOUNT+1 ELSE (*NA*) 53730 ELSE IF DESTELS^.CCOUNT=0 THEN CCOUNT := 0; 53740 (*CCOUNT=0 TREATED AS INFINITY*) 53750 (*CCOUNT(SOURCELS) = MAX(CCOUNT(SOURCELS), CCOUNT(DESTELS)+1)*) 53760 NEWSOURCE:=COPYDESC(SOURCE,MULT); 53770 FPINC(SOURCELS^); 53780 FPINC(NEWSOURCE^); 53790 IF FPTST(PVALUE^) THEN GARBAGE(PVALUE); 53800 PVALUE:= SOURCELS 53810 END 53820 ELSE 53830 BEGIN 53840 IF FPTWO(PVALUE^) THEN 53850 TESTCC(DESTINATION); 53860 DESTELS := PVALUE; 53870 FORMPDESC(SOURCE, PDESC1); 53880 PCINCRSLICE(SOURCE, PDESC1, +INCRF); 53890 PCINCRMULT(DESTELS, -INCRF); 53900 VECPOS := ELSCONST; 53910 WHILE NEXTEL(0, PDESC1) DO WITH PDESC1, PDESCVEC[0] DO 53920 BEGIN 53930 MOVELEFT(INCPTR(SOURCELS, PP), INCPTR(DESTELS, VECPOS), PSIZE); 53940 VECPOS:= VECPOS+PSIZE 53950 END 53960 END; 53970 IF FPTST(SOURCE^) THEN GARBAGE(SOURCE); 53980 TASSTM := DESTINATION; 53990 END; 54000 (**) 54010 (**) 54020 FUNCTION SCPTTM(DESTINATION, SOURCE: OBJECTP): OBJECTP; 54030 (*PSCOPETT+4*) 54040 BEGIN 54050 WITH SOURCE^ DO 54060 BEGIN 54070 IF OSCOPE=0 THEN OSCOPE := MULTSCOPE(SOURCE); 54080 IF DESTINATION^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE); 54090 END; 54100 SCPTTM := TASSTM(DESTINATION, SOURCE); 54110 END; 54120 (**) 54130 (**) 54140 (*-02() BEGIN END ; ()-02*) 54150 (*+01() 54160 BEGIN (*OF MAIN PROGRAM*) 54170 END (*OF EVERYTHING*). 54180 ()+01*)