43 lines
1.3 KiB
OpenEdge ABL
43 lines
1.3 KiB
OpenEdge ABL
|
34600 #include "rundecs.h"
|
||
|
34610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
34620 (**)
|
||
|
34630 (**)
|
||
|
34640 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
||
|
34650 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
|
||
|
34660 (**)
|
||
|
34670 (**)
|
||
|
34680 FUNCTION GTOTREF (NAK: NAKED; TEMPLATE: DPOINT): OBJECTP;
|
||
|
34690 (*PGETTOTAL+4*)
|
||
|
34700 VAR OFFSPRING: OBJECTP;
|
||
|
34710 BEGIN
|
||
|
34720 WITH NAK, STOWEDVAL^ DO
|
||
|
34730 BEGIN
|
||
|
34740 CASE SORT OF
|
||
|
34750 UNDEF:ERRORR(RSEL);
|
||
|
34760 NILL:ERRORR(RSELNIL);
|
||
|
34770 REFSL1, REFSLN, REFR, RECR, RECN, REFN:
|
||
|
34780 END;
|
||
|
34790 ENEW(OFFSPRING, REFSL1SIZE);
|
||
|
34800 WITH ANCESTOR^ DO FINC;
|
||
|
34810 WITH OFFSPRING^ DO
|
||
|
34820 BEGIN
|
||
|
34830 (*-02() FIRSTWORD := SORTSHIFT*ORD(REFSL1); ()-02*)
|
||
|
34840 (*+02() PCOUNT:=0; SORT:=REFSL1; ()+02*)
|
||
|
34850 (*+01() SECONDWORD := 0; ()+01*)
|
||
|
34860 ANCESTOR := STOWEDVAL^.ANCESTOR;
|
||
|
34870 OFFSET := POSITION;
|
||
|
34880 DBLOCK := TEMPLATE;
|
||
|
34890 OSCOPE := STOWEDVAL^.OSCOPE
|
||
|
34900 END;
|
||
|
34910 IF FTST THEN GARBAGE(STOWEDVAL)
|
||
|
34920 END; (*WITH*)
|
||
|
34930 GTOTREF := OFFSPRING
|
||
|
34940 END;
|
||
|
34950 (**)
|
||
|
34960 (**)
|
||
|
34970 (*-02() BEGIN END ; ()-02*)
|
||
|
34980 (*+01()
|
||
|
34990 BEGIN (*OF MAIN PROGRAM*)
|
||
|
35000 END (*OF EVERYTHING*).
|
||
|
35010 ()+01*)
|