112 lines
4 KiB
OpenEdge ABL
112 lines
4 KiB
OpenEdge ABL
|
40800 #include "rundecs.h"
|
||
|
|
40810 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
40820 (**)
|
||
|
|
40830 (**)
|
||
|
|
40840 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
|
||
|
|
40850 (**)
|
||
|
|
40860 (**)
|
||
|
|
40870 (*+01() (*$X3*) ()+01*)
|
||
|
|
40880 FUNCTION PCCMN(NEWMULT: OBJECTP; TEMPLATE: DPOINT; ELSIZE: INTEGER): ASNAKED;
|
||
|
|
40890 VAR TEMP: NAKEGER;
|
||
|
|
40900 DESCDEX: INTEGER;
|
||
|
|
40910 NEWELS: OBJECTP;
|
||
|
|
40920 BEGIN WITH NEWMULT^, TEMP DO WITH NAK DO
|
||
|
|
40930 BEGIN
|
||
|
|
40940 MDBLOCK := TEMPLATE;
|
||
|
|
40950 ENEW(NEWELS, ELSCONST+ELSIZE);
|
||
|
|
40960 PVALUE := NEWELS;
|
||
|
|
40970 WITH PVALUE^ DO
|
||
|
|
40980 BEGIN IHEAD := NIL ;
|
||
|
|
40990 (*-02() FIRSTWORD := SORTSHIFT * ORD(IELS); PCOUNT := 1; ()-02*)
|
||
|
|
41000 (*+02() PCOUNT:=1; SORT:=IELS; ()+02*)
|
||
|
|
41010 OSCOPE := 0; DBLOCK := TEMPLATE; D0 := ELSIZE; CCOUNT := 1 END;
|
||
|
|
41020 IHEAD := NIL; FPTR := NIL; BPTR := NIL;
|
||
|
|
41030 (*+11() ASNAK := 0; ()+11*)
|
||
|
|
41040 STOWEDVAL := NEWMULT; POINTER := INCPTR(PVALUE, ELSCONST);
|
||
|
|
41050 PCCMN := ASNAK;
|
||
|
|
41060 END
|
||
|
|
41070 END;
|
||
|
|
41080 (**)
|
||
|
|
41090 (**)
|
||
|
|
41100 FUNCTION PCOLLR(NOROWS: INTEGER; TEMPLATE: DPOINT): ASNAKED;
|
||
|
|
41110 (*PPREPROWDISP*)
|
||
|
|
41120 VAR NEWMULT: OBJECTP;
|
||
|
|
41130 DESCDEX: INTEGER; ELSIZE, SUM: BOUNDSRANGE;
|
||
|
|
41140 BEGIN
|
||
|
|
41150 IF ORD(TEMPLATE)=0 THEN ELSIZE := 1 (*DRESSED*)
|
||
|
|
41160 ELSE IF ORD(TEMPLATE)<=MAXSIZE THEN ELSIZE := ORD(TEMPLATE) (*UNDRESSED*)
|
||
|
|
41170 ELSE ELSIZE := TEMPLATE^[0];
|
||
|
|
41180 ENEW(NEWMULT, MULTCONST+NOROWS*SZPDS);
|
||
|
|
41190 SUM := -ELSCONST;
|
||
|
|
41200 WITH NEWMULT^ DO
|
||
|
|
41210 BEGIN
|
||
|
|
41220 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
|
||
|
|
41230 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
|
||
|
|
41240 (*+01() SECONDWORD := 0; ()+01*)
|
||
|
|
41250 SIZE := ELSIZE;
|
||
|
|
41260 FOR DESCDEX := 0 TO NOROWS-1 DO WITH DESCVEC[DESCDEX] DO
|
||
|
|
41270 BEGIN
|
||
|
|
41280 UI := GETSTKTOP(SZINT, DESCDEX*SZINT); LI := 1; DI := ELSIZE;
|
||
|
|
41290 SUM := SUM+ELSIZE; ELSIZE := UI*ELSIZE
|
||
|
|
41300 END;
|
||
|
|
41310 LBADJ := SUM;
|
||
|
|
41320 ROWS := NOROWS-1;
|
||
|
|
41330 END;
|
||
|
|
41340 PCOLLR := PCCMN(NEWMULT, TEMPLATE, ELSIZE);
|
||
|
|
41350 (*THIS WILL NOT WORK THUS ON 16-BITS*)
|
||
|
|
41360 END;
|
||
|
|
41370 (**)
|
||
|
|
41380 (**)
|
||
|
|
41390 FUNCTION PCOLLRM(NOROWS: INTEGER; TEMPLATE: DPOINT): ASNAKED;
|
||
|
|
41400 (*PPREPROWDISP+1*)
|
||
|
|
41410 VAR OLDMULT, NEWMULT: OBJECTP;
|
||
|
|
41420 DESCDEX, FIRSTROW: INTEGER; ELSIZE, SUM: BOUNDSRANGE;
|
||
|
|
41430 BEGIN
|
||
|
|
41440 OLDMULT := ASPTR(GETSTKTOP(SZADDR, NOROWS*SZINT));
|
||
|
|
41450 WITH OLDMULT^ DO
|
||
|
|
41460 BEGIN ELSIZE := SIZE;
|
||
|
|
41470 ENEW(NEWMULT, MULTCONST+(NOROWS+ROWS+1)*SZPDS);
|
||
|
|
41480 SUM := -ELSCONST;
|
||
|
|
41490 (*-02() NEWMULT^.FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
|
||
|
|
41500 (*+02() NEWMULT^.PCOUNT:=0; NEWMULT^.SORT:=MULT; ()+02*)
|
||
|
|
41510 (*+01() NEWMULT^.SECONDWORD := 0; ()+01*)
|
||
|
|
41520 NEWMULT^.SIZE := ELSIZE;
|
||
|
|
41530 FOR DESCDEX := 0 TO ROWS DO WITH DESCVEC[DESCDEX] DO
|
||
|
|
41540 BEGIN
|
||
|
|
41550 NEWMULT^.DESCVEC[DESCDEX] := DESCVEC[DESCDEX];
|
||
|
|
41560 NEWMULT^.DESCVEC[DESCDEX].DI := ELSIZE;
|
||
|
|
41570 SUM := SUM+LI*ELSIZE; ELSIZE := (UI-LI+1)*ELSIZE;
|
||
|
|
41580 IF ELSIZE<0 THEN ELSIZE := 0
|
||
|
|
41590 END
|
||
|
|
41600 END;
|
||
|
|
41610 FIRSTROW := OLDMULT^.ROWS+1;
|
||
|
|
41620 WITH NEWMULT^ DO
|
||
|
|
41630 BEGIN
|
||
|
|
41640 FOR DESCDEX := FIRSTROW TO FIRSTROW+NOROWS-1 DO WITH DESCVEC[DESCDEX] DO
|
||
|
|
41650 BEGIN
|
||
|
|
41660 UI := GETSTKTOP(SZINT, (DESCDEX-FIRSTROW)*SZINT); LI := 1; DI := ELSIZE;
|
||
|
|
41670 SUM := SUM+ELSIZE; ELSIZE := UI*ELSIZE
|
||
|
|
41680 END;
|
||
|
|
41690 LBADJ := SUM;
|
||
|
|
41700 ROWS := FIRSTROW+NOROWS-1;
|
||
|
|
41710 END;
|
||
|
|
41720 PCOLLRM := PCCMN(NEWMULT, TEMPLATE, ELSIZE);
|
||
|
|
41730 END;
|
||
|
|
41740 (*+01() (*$X4*) ()+01*)
|
||
|
|
41750 (**)
|
||
|
|
41760 (**)
|
||
|
|
41770 FUNCTION PCOLLCK(TEMP: NAKEGER; DEPTH, COUNT: INTEGER): ASNAKED;
|
||
|
|
41780 (*PCOLLCHECK*)
|
||
|
|
41790 BEGIN
|
||
|
|
41800 WITH TEMP.NAK.STOWEDVAL^ DO WITH DESCVEC[ROWS-DEPTH] DO
|
||
|
|
41810 IF (LI<>1) OR (UI<>COUNT) THEN ERRORR(RMULASS);
|
||
|
|
41820 PCOLLCK := TEMP.ASNAK;
|
||
|
|
41830 END;
|
||
|
|
41840 (**)
|
||
|
|
41850 (**)
|
||
|
|
41860 (*-02() BEGIN END ; ()-02*)
|
||
|
|
41870 (*+01()
|
||
|
|
41880 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
41890 END (*OF EVERYTHING*).
|
||
|
|
41900 ()+01*)
|