30 lines
860 B
OpenEdge ABL
30 lines
860 B
OpenEdge ABL
|
27600 #include "rundecs.h"
|
||
|
|
27610 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
27620 (**)
|
||
|
|
27630 (**)
|
||
|
|
27640 FUNCTION CRREFN(ANOBJECT: OBJECTP): OBJECTP;
|
||
|
|
27650 (*PCREATEREF*)
|
||
|
|
27660 VAR NEWREFN: OBJECTP;
|
||
|
|
27670 BEGIN
|
||
|
|
27680 ENEW(NEWREFN, REFNSIZE);
|
||
|
|
27690 WITH NEWREFN^ DO
|
||
|
|
27700 BEGIN
|
||
|
|
27710 (*-02() FIRSTWORD := SORTSHIFT * ORD(REFN); ()-02*)
|
||
|
|
27720 (*+02() PCOUNT:=0; SORT:=REFN; ()+02*)
|
||
|
|
27730 (*+01() SECONDWORD := 0; ()+01*)
|
||
|
|
27740 ANCESTOR := NEWREFN;
|
||
|
|
27750 OFFSET := STRUCTCONST;
|
||
|
|
27760 PVALUE := ANOBJECT;
|
||
|
|
27770 OSCOPE := SCOPE+FIRSTRG.RIBOFFSET^.RGSCOPE;
|
||
|
|
27780 WITH ANOBJECT^ DO FINC;
|
||
|
|
27790 END;
|
||
|
|
27800 CRREFN := NEWREFN;
|
||
|
|
27810 END;
|
||
|
|
27820 (**)
|
||
|
|
27830 (**)
|
||
|
|
27840 (*-02() BEGIN END ; ()-02*)
|
||
|
|
27850 (*+01()
|
||
|
|
27860 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
27870 END (*OF EVERYTHING*).
|
||
|
|
27880 ()+01*)
|