42 lines
		
	
	
	
		
			1.3 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			42 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*)
 |