58 lines
2 KiB
OpenEdge ABL
58 lines
2 KiB
OpenEdge ABL
|
45400 #include "rundecs.h"
|
||
|
|
45410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
45420 (**)
|
||
|
|
45430 (**)
|
||
|
|
45440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
||
|
|
45450 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
|
||
|
|
45460 FUNCTION CRMULT( NEWMULT: OBJECTP ; TEMPLATE: DPOINT ) : OBJECTP ; EXTERN ;
|
||
|
|
45470 (**)
|
||
|
|
45480 (**)
|
||
|
|
45490 FUNCTION ROWNM(PVAL: OBJECTP; ROWCOUNT: INTEGER; TEMPLATE: DPOINT): OBJECTP;
|
||
|
|
45500 (*PROWNONMULT*)
|
||
|
|
45510 (*WARNING: PVAL CAN ALSO BE AN A68INT; TROUBLE WILL ENSUE IF SZINT>SZADDR*)
|
||
|
|
45520 VAR NEWMULT: OBJECTP;
|
||
|
|
45530 DESCDEX: INTEGER;
|
||
|
|
45540 PTR: UNDRESSP;
|
||
|
|
45550 BEGIN
|
||
|
|
45560 ENEW(NEWMULT, MULTCONST+ROWCOUNT*SZPDS);
|
||
|
|
45570 WITH NEWMULT^ DO
|
||
|
|
45580 BEGIN
|
||
|
|
45590 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
|
||
|
|
45600 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
|
||
|
|
45610 (*+01() SECONDWORD := 0; ()+01*)
|
||
|
|
45620 ROWS := ROWCOUNT-1;
|
||
|
|
45630 FOR DESCDEX := 0 TO ROWCOUNT-1 DO
|
||
|
|
45640 WITH DESCVEC[DESCDEX] DO
|
||
|
|
45650 BEGIN LI := 1; UI := 1 END;
|
||
|
|
45660 IHEAD := NIL; FPTR := NIL; BPTR := NIL
|
||
|
|
45670 END;
|
||
|
|
45680 NEWMULT := CRMULT(NEWMULT, TEMPLATE);
|
||
|
|
45690 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
|
||
|
|
45700 IF ORD(TEMPLATE)=0 THEN (*DRESSED*)
|
||
|
|
45710 BEGIN
|
||
|
|
45720 PTR^.FIRSTPTR := PVAL;
|
||
|
|
45730 WITH PVAL^ DO FINC
|
||
|
|
45740 END
|
||
|
|
45750 ELSE IF ORD(TEMPLATE)=1 THEN (*SIMPLE*)
|
||
|
|
45760 PTR^.FIRSTINT := ORD(PVAL)
|
||
|
|
45770 ELSE IF PVAL^.SORT<>UNDEF THEN
|
||
|
|
45780 BEGIN
|
||
|
|
45790 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
|
||
|
|
45800 MOVELEFT(PVAL, PTR, ORD(TEMPLATE))
|
||
|
|
45810 ELSE (*STRUCT*)
|
||
|
|
45820 BEGIN
|
||
|
|
45830 MOVELEFT(INCPTR(PVAL, STRUCTCONST), PTR, TEMPLATE^[0]);
|
||
|
|
45840 PCINCR(INCPTR(PVAL, STRUCTCONST), TEMPLATE, +INCRF)
|
||
|
|
45850 END;
|
||
|
|
45860 IF FPTST(PVAL^) THEN GARBAGE(PVAL)
|
||
|
|
45870 END;
|
||
|
|
45880 ROWNM := NEWMULT;
|
||
|
|
45890 END;
|
||
|
|
45900 (**)
|
||
|
|
45910 (**)
|
||
|
|
45920 (*-02() BEGIN END ; ()-02*)
|
||
|
|
45930 (*+01()
|
||
|
|
45940 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
45950 END (*OF EVERYTHING*).
|
||
|
|
45960 ()+01*)
|