57 lines
1.7 KiB
OpenEdge ABL
57 lines
1.7 KiB
OpenEdge ABL
28500 #include "rundecs.h"
|
|
28510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
28520 (**)
|
|
28530 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
|
|
28540 PROCEDURE ERRORR(N :INTEGER); EXTERN;
|
|
28550 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
|
|
28560 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
|
|
28570 (**)
|
|
28580 (**)
|
|
28590 FUNCTION DREFM(REFER: OBJECTP): OBJECTP;
|
|
28600 (*PDEREF+4*)
|
|
28610 VAR NEWMULT:OBJECTP;
|
|
28620 BEGIN WITH REFER^ DO
|
|
28630 CASE SORT OF
|
|
28640 REFR, RECR:
|
|
28650 BEGIN
|
|
28660 IF FTST THEN
|
|
28670 BEGIN
|
|
28680 DREFM := REFER;
|
|
28690 OSCOPE := PVALUE^.OSCOPE;
|
|
28700 SORT := MULT
|
|
28710 END
|
|
28720 ELSE
|
|
28730 BEGIN
|
|
28740 NEWMULT := COPYDESC(REFER, MULT);
|
|
28750 NEWMULT^.OSCOPE := PVALUE^.OSCOPE;
|
|
28760 DREFM := NEWMULT;
|
|
28770 FPINC(PVALUE^)
|
|
28780 END
|
|
28790 END;
|
|
28800 REFSLN:
|
|
28810 BEGIN
|
|
28820 PVALUE := ANCESTOR;
|
|
28830 IF FTST THEN
|
|
28840 BEGIN
|
|
28850 SORT := MULT;
|
|
28860 DREFM := GETMULT(REFER);
|
|
28870 FPDEC(ANCESTOR^);
|
|
28880 IF FPTST(ANCESTOR^) THEN GARBAGE(ANCESTOR);
|
|
28890 END
|
|
28900 ELSE
|
|
28910 DREFM := GETMULT(COPYDESC(REFER, MULT))
|
|
28920 END;
|
|
28930 UNDEF: ERRORR(RDEREF);
|
|
28940 NILL: ERRORR(RDEREFNIL)
|
|
28950 END
|
|
28960 END;
|
|
28970 (**)
|
|
28980 (**)
|
|
28990 (*-02()
|
|
29000 BEGIN
|
|
29010 END;
|
|
29020 ()-02*)
|
|
29030 (*+01()
|
|
29040 BEGIN (*OF MAIN PROGRAM*)
|
|
29050 END (*OF EVERYTHING*).
|
|
29060 ()+01*)
|