ack/lang/a68s/liba68s/drefm.p

58 lines
1.7 KiB
OpenEdge ABL
Raw Permalink Normal View History

1988-10-04 13:41:01 +00:00
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*)