40 lines
1.2 KiB
OpenEdge ABL
40 lines
1.2 KiB
OpenEdge ABL
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*)
|