91 lines
3 KiB
OpenEdge ABL
91 lines
3 KiB
OpenEdge ABL
|
57300 #include "rundecs.h"
|
||
|
|
57310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
57320 (**)
|
||
|
|
57330 (**)
|
||
|
|
57340 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
||
|
|
57350 (**)
|
||
|
|
57360 (**)
|
||
|
|
57370 FUNCTION WIDENM(COUNT: INTEGER): OBJECTP;
|
||
|
|
57380 VAR NEWELS, NEWMULT: OBJECTP;
|
||
|
|
57390 BEGIN
|
||
|
|
57400 ENEW(NEWMULT, MULTCONST+SZPDS);
|
||
|
|
57410 WITH NEWMULT^ DO
|
||
|
|
57420 BEGIN
|
||
|
|
57430 (*-02() FIRSTWORD := SORTSHIFT * ORD(MULT); ()-02*)
|
||
|
|
57440 (*+02() PCOUNT:=0; SORT:=MULT; ()+02*)
|
||
|
|
57450 (*+01() SECONDWORD := 0; ()+01*)
|
||
|
|
57460 SIZE := 1;
|
||
|
|
57470 WITH DESCVEC[0] DO
|
||
|
|
57480 BEGIN LI := 1; UI := COUNT; DI := SZINT END;
|
||
|
|
57490 ROWS := 0; LBADJ := SZINT-ELSCONST; PCOUNT := 1;
|
||
|
|
57500 MDBLOCK := ASPTR(SZINT);
|
||
|
|
57510 ENEW(NEWELS, ELSCONST+COUNT*SZINT);
|
||
|
|
57520 WITH NEWELS^ DO
|
||
|
|
57530 BEGIN
|
||
|
|
57540 (*-02() FIRSTWORD := SORTSHIFT * ORD(IELS); ()-02*)
|
||
|
|
57550 (*+02() PCOUNT:=0; SORT:=IELS; ()+02*)
|
||
|
|
57560 OSCOPE := 0;
|
||
|
|
57570 IHEAD := NIL;
|
||
|
|
57580 DBLOCK := ASPTR(SZINT); D0 := COUNT*SZINT; CCOUNT := 1; PCOUNT := 1;
|
||
|
|
57590 END;
|
||
|
|
57600 PVALUE := NEWELS; IHEAD := NIL; FPTR := NIL; BPTR := NIL
|
||
|
|
57610 END;
|
||
|
|
57620 WIDENM := NEWMULT;
|
||
|
|
57630 END;
|
||
|
|
57640 (**)
|
||
|
|
57650 (**)
|
||
|
|
57660 FUNCTION WIDBITS(BITS: INTEGER): OBJECTP;
|
||
|
|
57670 (*PWIDEN+5*)
|
||
|
|
57680 VAR NEWMULT: OBJECTP;
|
||
|
|
57690 PTR: UNDRESSP;
|
||
|
|
57700 BEGIN
|
||
|
|
57710 NEWMULT := WIDENM(BITSWIDTH);
|
||
|
|
57720 WITH NEWMULT^ DO
|
||
|
|
57730 BEGIN
|
||
|
|
57740 PTR := INCPTR(PVALUE, ELSCONST);
|
||
|
|
57750 WHILE ORD(PTR)<ORD(PVALUE)+ELSCONST+BITSWIDTH DO
|
||
|
|
57760 BEGIN PTR^.FIRSTWORD := BITS; BITS := BITS*2; PTR := INCPTR(PTR, SZINT) END;
|
||
|
|
57770 END;
|
||
|
|
57780 WIDBITS := NEWMULT;
|
||
|
|
57790 END;
|
||
|
|
57800 (**)
|
||
|
|
57810 (**)
|
||
|
|
57820 FUNCTION WIDBYTS(BYTES: INTEGER): OBJECTP;
|
||
|
|
57830 (*PWIDEN+6*)
|
||
|
|
57840 VAR NEWMULT: OBJECTP;
|
||
|
|
57850 BBB: RECORD CASE SEVERAL OF
|
||
|
|
57860 1: (B1: INTEGER);
|
||
|
|
57870 2: (B2: PACKED ARRAY [1..BYTESWIDTH] OF CHAR);
|
||
|
|
57880 0 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 : () ;
|
||
|
|
57890 END;
|
||
|
|
57900 PTR: UNDRESSP; I: INTEGER;
|
||
|
|
57910 BEGIN
|
||
|
|
57920 NEWMULT := WIDENM(BYTESWIDTH);
|
||
|
|
57930 BBB.B1 := BYTES;
|
||
|
|
57940 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
|
||
|
|
57950 FOR I := 1 TO BYTESWIDTH DO
|
||
|
|
57960 BEGIN PTR^.FIRSTINT := ORD(BBB.B2[I]); PTR := INCPTR(PTR, SZINT) END;
|
||
|
|
57970 WIDBYTS := NEWMULT;
|
||
|
|
57980 END;
|
||
|
|
57990 (**)
|
||
|
|
58000 (**)
|
||
|
|
58010 FUNCTION WIDSTR(STR: OBJECTP): OBJECTP;
|
||
|
|
58020 (*PWIDEN+7*)
|
||
|
|
58030 VAR NEWMULT: OBJECTP;
|
||
|
|
58040 PTR: UNDRESSP; I: INTEGER;
|
||
|
|
58050 BEGIN
|
||
|
|
58060 NEWMULT := WIDENM(STR^.STRLENGTH);
|
||
|
|
58070 PTR := INCPTR(NEWMULT^.PVALUE, ELSCONST);
|
||
|
|
58080 FOR I := 1 TO STR^.STRLENGTH DO
|
||
|
|
58090 BEGIN PTR^.FIRSTINT := ORD(STR^.CHARVEC[I]); PTR := INCPTR(PTR, SZINT) END;
|
||
|
|
58100 IF FPTST(STR^) THEN GARBAGE(STR);
|
||
|
|
58110 WIDSTR := NEWMULT;
|
||
|
|
58120 END;
|
||
|
|
58130 (**)
|
||
|
|
58140 (**)
|
||
|
|
58150 (*-02() BEGIN END ; ()-02*)
|
||
|
|
58160 (*+01()
|
||
|
|
58170 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
58180 END (*OF EVERYTHING*).
|
||
|
|
58190 ()+01*)
|