154 lines
5.3 KiB
OpenEdge ABL
154 lines
5.3 KiB
OpenEdge ABL
26000 #include "rundecs.h"
|
|
26010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
26020 (**)
|
|
26030 (**)
|
|
26040 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN;
|
|
26050 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
|
|
26060 PROCEDURE ERRORR(N :INTEGER); EXTERN;
|
|
26070 (**)
|
|
26080 (**)
|
|
26090 FUNCTION BOUND(ROWCOUNT: INTEGER): OBJECTP;
|
|
26100 (*PBOUNDS*)
|
|
26110 VAR NEWMULT: OBJECTP;
|
|
26120 DESCDEX: INTEGER; BND: BOUNDSRANGE;
|
|
26130 BEGIN
|
|
26140 ENEW(NEWMULT, MULTCONST+ROWCOUNT*SZPDS);
|
|
26150 WITH NEWMULT^ DO
|
|
26160 BEGIN
|
|
26170 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
|
|
26180 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
|
|
26190 (*+01() SECONDWORD := 0; ()+01*)
|
|
26200 OSCOPE := 0 ;
|
|
26210 FOR DESCDEX := 0 TO ROWCOUNT-1 DO
|
|
26220 WITH DESCVEC[DESCDEX] DO
|
|
26230 BEGIN
|
|
26240 BND := GETSTKTOP(SZINT, DESCDEX*2*SZINT);
|
|
26250 IF BND=INTUNDEF THEN ERRORR(RCUPPER); UI := BND;
|
|
26260 BND := GETSTKTOP(SZINT, DESCDEX*2*SZINT+SZINT);
|
|
26270 IF BND=INTUNDEF THEN ERRORR(RCLOWER); LI := BND;
|
|
26280 END;
|
|
26290 ROWS := ROWCOUNT-1;
|
|
26300 PVALUE := NIL;
|
|
26310 IHEAD := NIL; FPTR := NIL; BPTR := NIL
|
|
26320 END;
|
|
26330 BOUND := NEWMULT;
|
|
26340 END;
|
|
26350 (**)
|
|
26360 (**)
|
|
26370 FUNCTION CRMULT(NEWMULT: OBJECTP; TEMPLATE: DPOINT): OBJECTP;
|
|
26380 (*PACTDRMULT*)
|
|
26390 VAR NEWELS: OBJECTP;
|
|
26400 SUM, ELSIZE, INDEX, DESCDEX, TEMPOS, STRUCTPOS, INC: INTEGER;
|
|
26410 PTR, LIMIT: UNDRESSP;
|
|
26420 BEGIN
|
|
26430 WITH NEWMULT^ DO
|
|
26440 BEGIN
|
|
26450 IF ORD(TEMPLATE)=0 THEN ELSIZE := SZADDR (*DRESSED*)
|
|
26460 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN ELSIZE := ORD(TEMPLATE) (*UNDRESSED*)
|
|
26470 ELSE ELSIZE := TEMPLATE^[0]; (*STRUCT*)
|
|
26480 SIZE:= ELSIZE;
|
|
26490 SUM:= 0;
|
|
26500 FOR DESCDEX := 0 TO ROWS DO
|
|
26510 WITH DESCVEC[DESCDEX] DO
|
|
26520 BEGIN
|
|
26530 DI:= ELSIZE;
|
|
26540 SUM := SUM+LI*ELSIZE;
|
|
26550 ELSIZE:= (UI-LI+1)*ELSIZE;
|
|
26560 IF ELSIZE <= 0 THEN
|
|
26570 ELSIZE:= 0
|
|
26580 END;
|
|
26590 LBADJ := SUM-ELSCONST;
|
|
26600 MDBLOCK := TEMPLATE;
|
|
26610 ENEW(NEWELS, ELSCONST+ELSIZE);
|
|
26620 WITH NEWELS^ DO
|
|
26630 BEGIN
|
|
26640 (*-02() FIRSTWORD := SORTSHIFT*ORD(IELS)+INCRF; ()-02*)
|
|
26650 (*+02() PCOUNT:=1; SORT:=IELS; ()+02*)
|
|
26660 OSCOPE := 0;
|
|
26670 DBLOCK:= TEMPLATE;
|
|
26680 D0:= ELSIZE;
|
|
26690 CCOUNT:= 1;
|
|
26700 PTR := INCPTR(NEWELS, ELSCONST);
|
|
26710 IHEAD := NIL;
|
|
26720 (*-02()
|
|
26730 IF ORD(TEMPLATE)=0 THEN BEGIN PTR^.FIRSTPTR := UNDEFIN; INC := SZADDR END (*DRESSED*)
|
|
26740 ELSE BEGIN PTR^.FIRSTWORD := INTUNDEF; INC := SZWORD END; (*UNDRESSED*)
|
|
26750 MOVELEFT(PTR, INCPTR(PTR, INC), ELSIZE-INC);
|
|
26760 ()-02*)
|
|
26770 (*+02()
|
|
26780 LIMIT := INCPTR(PTR, ELSIZE);
|
|
26790 IF ORD(TEMPLATE)=0 THEN WHILE PTR<>LIMIT DO
|
|
26800 BEGIN PTR^.FIRSTPTR := UNDEFIN; PTR := INCPTR(PTR, SZADDR) END
|
|
26810 ELSE WHILE PTR<>LIMIT DO
|
|
26820 BEGIN PTR^.FIRSTWORD := INTUNDEF; PTR := INCPTR(PTR, SZWORD) END;
|
|
26830 ()+02*)
|
|
26840 IF ORD(TEMPLATE)>MAXSIZE (*STRUCT*) THEN
|
|
26850 BEGIN
|
|
26860 ELSIZE:= TEMPLATE^[0];
|
|
26870 INDEX:= 0;
|
|
26880 WHILE INDEX < D0 DO
|
|
26890 BEGIN
|
|
26900 TEMPOS:= 1;
|
|
26910 STRUCTPOS:= TEMPLATE^[1];
|
|
26920 WHILE STRUCTPOS >= 0 DO
|
|
26930 BEGIN
|
|
26940 PTR := INCPTR(NEWELS, ELSCONST+INDEX+STRUCTPOS);
|
|
26950 PTR^.FIRSTPTR := UNDEFIN;
|
|
26960 TEMPOS:= TEMPOS+1;
|
|
26970 STRUCTPOS:= TEMPLATE^[TEMPOS]
|
|
26980 END;
|
|
26990 INDEX:= INDEX+ELSIZE
|
|
27000 END
|
|
27010 END
|
|
27020 END;
|
|
27030 PVALUE:= NEWELS
|
|
27040 END;
|
|
27050 CRMULT := NEWMULT
|
|
27060 END;
|
|
27070 (**)
|
|
27080 (**)
|
|
27090 FUNCTION CRREFR(ANOBJECT: OBJECTP): OBJECTP;
|
|
27100 (*PCREATEREF+2*)
|
|
27110 VAR NEWREFR: OBJECTP;
|
|
27120 BEGIN
|
|
27130 WITH ANOBJECT^ DO
|
|
27140 BEGIN
|
|
27150 IF (BPTR<>NIL) AND (SORT=MULT) THEN (*SOURCE IS A SLICE*)
|
|
27160 COPYSLICE(ANOBJECT);
|
|
27170 IF FTST THEN
|
|
27180 BEGIN NEWREFR := ANOBJECT; NEWREFR^.SORT := REFR END
|
|
27190 ELSE
|
|
27200 BEGIN
|
|
27210 NEWREFR := COPYDESC(ANOBJECT, REFR);
|
|
27220 WITH NEWREFR^.PVALUE^ DO FINC
|
|
27230 END
|
|
27240 END;
|
|
27250 WITH NEWREFR^ DO
|
|
27260 BEGIN
|
|
27270 OSCOPE := SCOPE+FIRSTRG.RIBOFFSET^.RGSCOPE;
|
|
27280 ANCESTOR:= NEWREFR;
|
|
27290 CCOUNT:= 1;
|
|
27300 END;
|
|
27310 CRREFR := NEWREFR;
|
|
27320 END;
|
|
27330 (**)
|
|
27340 (**)
|
|
27350 FUNCTION CHKDESC(SOURCEMULT, CDESC: OBJECTP): OBJECTP;
|
|
27360 (*PCHECKDESC*)
|
|
27370 VAR COUNT: INTEGER;
|
|
27380 BEGIN
|
|
27390 IF SOURCEMULT^.SORT=UNDEF THEN ERRORR(RMULASS);
|
|
27400 FOR COUNT:= 0 TO CDESC^.ROWS
|
|
27410 DO WITH CDESC^.DESCVEC[COUNT], SOURCEMULT^ DO
|
|
27420 IF (LI <> DESCVEC[COUNT].LI)
|
|
27430 OR (UI <> DESCVEC[COUNT].UI)
|
|
27440 THEN ERRORR(RMULASS);
|
|
27450 CHKDESC := SOURCEMULT;
|
|
27460 END;
|
|
27470 (**)
|
|
27480 (**)
|
|
27490 (*-02() BEGIN END ; ()-02*)
|
|
27500 (*+01()
|
|
27510 BEGIN (*OF MAIN PROGRAM*)
|
|
27520 END (*OF EVERYTHING*).
|
|
27530 ()+01*)
|