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