73 lines
2.4 KiB
OpenEdge ABL
73 lines
2.4 KiB
OpenEdge ABL
40000 #include "rundecs.h"
|
|
40010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
40020 (**)
|
|
40030 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
|
|
40040 PROCEDURE ERRORR(N :INTEGER); EXTERN;
|
|
40050 FUNCTION STRUCTSCOPE(STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT):DEPTHRANGE; EXTERN;
|
|
40060 PROCEDURE UNDRESSN (COLLECTOR, STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; SOURCEP: OBJECTP); EXTERN ;
|
|
40070 PROCEDURE NASSTCMN(ANOBJECT: OBJECTP); EXTERN;
|
|
40080 (**)
|
|
40090 (**)
|
|
40100 FUNCTION NASSTP(TEMP: NAKEGER; SOURCE: OBJECTP; TEMPLATE: DPOINT): ASNAKED;
|
|
40110 (*+01() EXTERN ; ()+01*)
|
|
40120 (*PASSIGNNT+3*)
|
|
40130 (*-01()
|
|
40140 BEGIN
|
|
40150 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
|
|
40160 BEGIN
|
|
40170 IF FPTWO(PVALUE^) THEN
|
|
40180 NASSTCMN(STOWEDVAL);
|
|
40190 PVALUE^.OSCOPE := 0;
|
|
40200 UNDRESSN(INCPTR(PVALUE, POSITION), INCPTR(SOURCE, STRUCTCONST), TEMPLATE, SOURCE);
|
|
40210 END;
|
|
40220 NASSTP := TEMP.ASNAK;
|
|
40230 END;
|
|
40240 (**)
|
|
40250 (**)
|
|
40260 ()-01*)
|
|
40270 FUNCTION NASSNP(TEMP: NAKEGER; TEMP2: NAKEGER; TEMPLATE: DPOINT): ASNAKED;
|
|
40280 (*PASSIGNNN*)
|
|
40290 VAR DEST: UNDRESSP;
|
|
40300 BEGIN
|
|
40310 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
|
|
40320 BEGIN
|
|
40330 IF FPTWO(PVALUE^) THEN
|
|
40340 NASSTCMN(STOWEDVAL);
|
|
40350 PVALUE^.OSCOPE := 0;
|
|
40360 DEST := INCPTR(PVALUE, POSITION)
|
|
40370 END;
|
|
40380 WITH TEMP2.NAK DO
|
|
40390 UNDRESSN(DEST, POINTER, TEMPLATE, STOWEDVAL);
|
|
40400 NASSNP := TEMP.ASNAK;
|
|
40410 END;
|
|
40420 (**)
|
|
40430 (**)
|
|
40440 FUNCTION SCPNTP(TEMP: NAKEGER; SOURCE: OBJECTP; TEMPLATE: DPOINT): ASNAKED;
|
|
40450 (*PSCOPENT+3*)
|
|
40460 BEGIN
|
|
40470 WITH SOURCE^ DO
|
|
40480 BEGIN
|
|
40490 IF OSCOPE=0 THEN OSCOPE := STRUCTSCOPE(INCPTR(SOURCE, STRUCTCONST), DBLOCK);
|
|
40500 IF TEMP.NAK.STOWEDVAL^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
|
|
40510 END;
|
|
40520 SCPNTP := NASSTP(TEMP, SOURCE, TEMPLATE);
|
|
40530 END;
|
|
40540 (**)
|
|
40550 (**)
|
|
40560 FUNCTION SCPNNP(TEMP: NAKEGER; TEMP2: NAKEGER; TEMPLATE: DPOINT): ASNAKED;
|
|
40570 (*PSCOPENN+0,1*)
|
|
40580 BEGIN
|
|
40590 IF TEMP.NAK.STOWEDVAL^.OSCOPE<STRUCTSCOPE(TEMP2.NAK.POINTER, TEMPLATE) THEN ERRORR(RSCOPE);
|
|
40600 SCPNNP := NASSNP(TEMP, TEMP2, TEMPLATE);
|
|
40610 END;
|
|
40620 (**)
|
|
40630 (**)
|
|
40640 (*-02()
|
|
40650 BEGIN
|
|
40660 END;
|
|
40670 ()-02*)
|
|
40680 (*+01()
|
|
40690 BEGIN (*OF MAIN PROGRAM*)
|
|
40700 END (*OF EVERYTHING*).
|
|
40710 ()+01*)
|