101 lines
2.8 KiB
OpenEdge ABL
101 lines
2.8 KiB
OpenEdge ABL
|
38900 #include "rundecs.h"
|
||
|
|
38910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
38920 (**)
|
||
|
|
38930 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
|
||
|
|
38940 PROCEDURE ERRORR(N :INTEGER); EXTERN;
|
||
|
|
38950 PROCEDURE TESTCC(TARGET: OBJECTP); EXTERN ;
|
||
|
|
38960 PROCEDURE TESTSS (REFSTRUCT: OBJECTP); EXTERN ;
|
||
|
|
38970 (**)
|
||
|
|
38980 (**)
|
||
|
|
38990 PROCEDURE NASSTCMN(ANOBJECT: OBJECTP);
|
||
|
|
39000 BEGIN
|
||
|
|
39010 WITH ANOBJECT^ DO
|
||
|
|
39020 CASE ANCESTOR^.SORT OF
|
||
|
|
39030 REFR, RECR:
|
||
|
|
39040 TESTCC(ANOBJECT);
|
||
|
|
39050 RECN, REFN:
|
||
|
|
39060 TESTSS(ANCESTOR);
|
||
|
|
39070 UNDEF:
|
||
|
|
39080 ERRORR(RSEL);
|
||
|
|
39090 NILL:
|
||
|
|
39100 ERRORR(RSELNIL)
|
||
|
|
39110 END
|
||
|
|
39120 END;
|
||
|
|
39130 (**)
|
||
|
|
39140 (**)
|
||
|
|
39150 (*-01() (*-05()
|
||
|
|
39160 FUNCTION NASSTS(TEMP: NAKEGER; SOURCE: A68INT): ASNAKED;
|
||
|
|
39170 (*PASSIGNNT*)
|
||
|
|
39180 VAR DEST: UNDRESSP;
|
||
|
|
39190 BEGIN
|
||
|
|
39200 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
|
||
|
|
39210 BEGIN
|
||
|
|
39220 IF FPTWO(PVALUE^) THEN
|
||
|
|
39230 NASSTCMN(STOWEDVAL);
|
||
|
|
39240 PVALUE^.OSCOPE := 0;
|
||
|
|
39250 DEST := INCPTR(PVALUE, POSITION)
|
||
|
|
39260 END;
|
||
|
|
39270 DEST^.FIRSTINT := SOURCE;
|
||
|
|
39280 NASSTS := TEMP.ASNAK;
|
||
|
|
39290 END;
|
||
|
|
39300 (**)
|
||
|
|
39310 (**)
|
||
|
|
39320 FUNCTION NASSTS2(TEMP: NAKEGER; SOURCE: A68LONG): ASNAKED;
|
||
|
|
39330 (*PASSIGNNT+1*)
|
||
|
|
39340 VAR DEST: UNDRESSP;
|
||
|
|
39350 BEGIN
|
||
|
|
39360 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
|
||
|
|
39370 BEGIN
|
||
|
|
39380 IF FPTWO(PVALUE^) THEN
|
||
|
|
39390 NASSTCMN(STOWEDVAL);
|
||
|
|
39400 PVALUE^.OSCOPE := 0;
|
||
|
|
39410 DEST := INCPTR(PVALUE, POSITION)
|
||
|
|
39420 END;
|
||
|
|
39430 DEST^.FIRSTLONG := SOURCE;
|
||
|
|
39440 NASSTS2 := TEMP.ASNAK;
|
||
|
|
39450 END;
|
||
|
|
39460 ()-05*) ()-01*)
|
||
|
|
39470 (**)
|
||
|
|
39480 (**)
|
||
|
|
39490 FUNCTION NASSTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
|
||
|
|
39500 (*+01() EXTERN ; ()+01*)
|
||
|
|
39510 (*-01()
|
||
|
|
39520 (*PASSIGNNT+2*)
|
||
|
|
39530 VAR DEST: UNDRESSP;
|
||
|
|
39540 BEGIN
|
||
|
|
39550 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
|
||
|
|
39560 BEGIN
|
||
|
|
39570 IF FPTWO(PVALUE^) THEN
|
||
|
|
39580 NASSTCMN(STOWEDVAL);
|
||
|
|
39590 PVALUE^.OSCOPE := 0;
|
||
|
|
39600 DEST := INCPTR(PVALUE, POSITION)
|
||
|
|
39610 END;
|
||
|
|
39620 WITH DEST^ DO
|
||
|
|
39630 BEGIN
|
||
|
|
39640 FPINC(SOURCE^);
|
||
|
|
39650 FPDEC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
|
||
|
|
39660 FIRSTPTR := SOURCE;
|
||
|
|
39670 END;
|
||
|
|
39680 NASSTPT := TEMP.ASNAK;
|
||
|
|
39690 END;
|
||
|
|
39700 ()-01*)
|
||
|
|
39710 FUNCTION SCPNTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
|
||
|
|
39720 (*PSCOPENT+2*)
|
||
|
|
39730 BEGIN
|
||
|
|
39740 WITH SOURCE^ DO
|
||
|
|
39750 BEGIN
|
||
|
|
39760 IF TEMP.NAK.STOWEDVAL^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
|
||
|
|
39770 END;
|
||
|
|
39780 SCPNTPT := NASSTPT(TEMP, SOURCE);
|
||
|
|
39790 END;
|
||
|
|
39800 (**)
|
||
|
|
39810 (**)
|
||
|
|
39820 (*-02()
|
||
|
|
39830 BEGIN
|
||
|
|
39840 END;
|
||
|
|
39850 ()-02*)
|
||
|
|
39860 (*+01()
|
||
|
|
39870 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
39880 END (*OF EVERYTHING*).
|
||
|
|
39890 ()+01*)
|