ack/lang/a68s/liba68s/gvscope.p
1988-10-04 13:41:01 +00:00

54 lines
1.6 KiB
OpenEdge ABL

35400 #include "rundecs.h"
35410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
35420 (**)
35430 (**)
35440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
35450 PROCEDURE ERRORR(N :INTEGER); EXTERN;
35460 (**)
35470 (**)
35480 FUNCTION GLDVAR (LOCRG: DEPTHRANGE; PTR: UNDRESSP; IBPT: IPOINT): OBJECTP;
35490 (*PLOADVAR+0,1,2*)
35500 VAR NEWCREFX: OBJECTP;
35510 CURR: IPOINT;
35520 BEGIN
35530 ENEW(NEWCREFX, CREFSIZE);
35540 WITH NEWCREFX^ DO
35550 BEGIN
35560 (*-02() FIRSTWORD := SORTSHIFT * ORD(CREF); ()-02*)
35570 (*+02() PCOUNT:=0; SORT:=CREF; ()+02*)
35580 (*+01() SECONDWORD := 0; ()+01*)
35590 ANCESTOR := NEWCREFX;
35600 PVALUE := HIGHPCOUNT;
35610 IPTR := PTR;
35620 CURR := STATIC(ME);
35630 SETMYSTATIC(IBPT);
35640 OSCOPE := SCOPE+LOCRG;
35650 SETMYSTATIC(CURR)
35660 END;
35670 GLDVAR := NEWCREFX;
35680 END;
35690 (**)
35700 (**)
35710 PROCEDURE GVSCOPE(SOURCE: OBJECTP; LOCRG: DEPTHRANGE; DEST: UNDRESSP; GLOBIB: IPOINT);
35720 (*PSCOPEVAR+1*)
35730 VAR CURR: IPOINT;
35740 BEGIN
35750 CURR := STATIC(ME);
35760 SETMYSTATIC(GLOBIB);
35770 IF SCOPE+LOCRG<SOURCE^.OSCOPE THEN ERRORR(RSCOPE);
35780 SETMYSTATIC(CURR);
35790 FPINC(SOURCE^);
35800 WITH DEST^ DO
35810 BEGIN
35820 FPINC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
35830 FIRSTPTR := SOURCE;
35840 END;
35850 END;
35860 (**)
35870 (**)
35880 (*-02() BEGIN END ; ()-02*)
35890 (*+01()
35900 BEGIN (*OF MAIN PROGRAM*)
35910 END (*OF EVERYTHING*).
35920 ()+01*)