45 lines
1.4 KiB
OpenEdge ABL
45 lines
1.4 KiB
OpenEdge ABL
|
44900 #include "rundecs.h"
|
||
|
|
44910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
44920 (**)
|
||
|
|
44930 (**)
|
||
|
|
44940 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
|
||
|
|
44950 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
||
|
|
44960 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN ;
|
||
|
|
44970 PROCEDURE COPYSLICE(ASLICE: OBJECTP); EXTERN ;
|
||
|
|
44980 (**)
|
||
|
|
44990 (**)
|
||
|
|
45000 FUNCTION ROWM(AMULT: OBJECTP; ROWCOUNT: INTEGER): OBJECTP;
|
||
|
|
45010 (*PROWMULT*)
|
||
|
|
45020 VAR NEWMULT, OLDESC, NEWDESC: OBJECTP;
|
||
|
|
45030 I: INTEGER; OLDROWS: 0..7;
|
||
|
|
45040 BEGIN
|
||
|
|
45050 WITH AMULT^ DO
|
||
|
|
45060 BEGIN
|
||
|
|
45070 IF BPTR<>NIL THEN (*A SLICE*)
|
||
|
|
45080 COPYSLICE(AMULT);
|
||
|
|
45090 OLDROWS := ROWS;
|
||
|
|
45100 ROWS := ROWCOUNT-1;
|
||
|
|
45110 NEWMULT := COPYDESC(AMULT, MULT);
|
||
|
|
45120 NEWMULT^.PVALUE := AMULT;
|
||
|
|
45130 NEWMULT := GETMULT(NEWMULT);
|
||
|
|
45140 ROWS := OLDROWS;
|
||
|
|
45150 WITH NEWMULT^ DO
|
||
|
|
45160 BEGIN
|
||
|
|
45170 ROWS := ROWCOUNT-1;
|
||
|
|
45180 FOR I := OLDROWS+1 TO ROWS DO WITH DESCVEC[I] DO
|
||
|
|
45190 BEGIN LI := 1; UI := 1; DI := PVALUE^.D0 END;
|
||
|
|
45200 LBADJ := LBADJ+DESCVEC[ROWS].DI*(ROWS-OLDROWS);
|
||
|
|
45210 FPINC(PVALUE^);
|
||
|
|
45220 END;
|
||
|
|
45230 IF FTST THEN GARBAGE(AMULT)
|
||
|
|
45240 END;
|
||
|
|
45250 ROWM := NEWMULT;
|
||
|
|
45260 END;
|
||
|
|
45270 (**)
|
||
|
|
45280 (**)
|
||
|
|
45290 (*-02() BEGIN END ; ()-02*)
|
||
|
|
45300 (*+01()
|
||
|
|
45310 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
45320 END (*OF EVERYTHING*).
|
||
|
|
45330 ()+01*)
|