220 lines
8.3 KiB
OpenEdge ABL
220 lines
8.3 KiB
OpenEdge ABL
|
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*)
|