31300 #include "rundecs.h"
31310     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
31320 (**)
31330 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
31340 (**)
31350 (**)
31360 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP;
31370   VAR OLDMULT:OBJECTP;
31380     BEGIN
31390     WITH NEWMULT^ DO
31400       BEGIN
31410       OLDMULT := PVALUE;
31420       SORT := MULT;
31430       OSCOPE := 0;
31440       PVALUE := OLDMULT^.PVALUE;
31450       IF ( OLDMULT^.SORT <> MULT ) OR ( OLDMULT^.BPTR = NIL ) THEN
31460         BEGIN
31470         WITH PVALUE^ DO
31480           IF CCOUNT<>0 THEN CCOUNT := CCOUNT+1;
31490             (*CCOUNT=0 TREATED AS INFINITY*)
31500         OLDMULT := PVALUE;
31510         END;
31520       BPTR := OLDMULT;
31530       FPTR := OLDMULT^.IHEAD;
31540       IHEAD := NIL;
31550       IF FPTR <> NIL THEN FPTR^.BPTR := NEWMULT
31560       ELSE FPINC(OLDMULT^);
31570       OLDMULT^.IHEAD := NEWMULT;
31580       FPINC(PVALUE^);
31590       END;
31600     IF FPTST(OLDMULT^) THEN GARBAGE(OLDMULT);
31610     GETMULT := NEWMULT;
31620     END;
31630 (**)
31640 (**)
31650 (*-02() BEGIN END ; ()-02*)
31660 (*+01()
31670 BEGIN (*OF MAIN PROGRAM*)
31680 END (*OF EVERYTHING*).
31690 ()+01*)