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*)