41 lines
1.1 KiB
OpenEdge ABL
41 lines
1.1 KiB
OpenEdge ABL
|
44100 #include "rundecs.h"
|
||
|
|
44110 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
||
|
|
44120 (**)
|
||
|
|
44130 (**)
|
||
|
|
44140 FUNCTION ROUTNA (PROC:PROCPOINT;ENV:IPOINT):OBJECTP;
|
||
|
|
44150 VAR NEWRT:OBJECTP;
|
||
|
|
44160 BEGIN
|
||
|
|
44170 ENEW(NEWRT, ROUTINESIZE);
|
||
|
|
44180 WITH NEWRT^ DO
|
||
|
|
44190 BEGIN
|
||
|
|
44200 (*-02() FIRSTWORD := SORTSHIFT * ORD(ROUTINE); ()-02*)
|
||
|
|
44210 (*+02() PCOUNT:=0; SORT:=ROUTINE; ()+02*)
|
||
|
|
44220 PROCBL:=PROC;
|
||
|
|
44230 ENVCHAIN:=ENV;
|
||
|
|
44240 SETMYSTATIC(ENV);
|
||
|
|
44250 OSCOPE:=SCOPE+PROC^.SCOFFSET;
|
||
|
|
44260 END;
|
||
|
|
44270 ROUTNA:= NEWRT
|
||
|
|
44280 END;
|
||
|
|
44290 (**)
|
||
|
|
44300 (**)
|
||
|
|
44310 FUNCTION ROUTN (PROC: PROCPOINT): OBJECTP;
|
||
|
|
44320 (* PLOADRT: CONSTRUCTS ROUTINE VALUE FOR GIVEN PROCBL;
|
||
|
|
44330 RETURNS POINTER TO NEW ROUTINEBLOCK; KK 13.5.1977 *)
|
||
|
|
44340 VAR I: INTEGER;
|
||
|
|
44350 BEGIN
|
||
|
|
44360 FOR I := LEVEL-1 DOWNTO PROC^.SCOPELEVEL DO
|
||
|
|
44370 SETMYSTATIC( (*-05()STATIC()-05*)(*+05()A68STATIC()+05*) ( STATIC( ME ) ) );
|
||
|
|
44380 ROUTN := ROUTNA(PROC,STATIC(ME));
|
||
|
|
44390 END;
|
||
|
|
44400 (**)
|
||
|
|
44410 (**)
|
||
|
|
44420 (*-02()
|
||
|
|
44430 BEGIN
|
||
|
|
44440 END ;
|
||
|
|
44450 ()-02*)
|
||
|
|
44460 (*+01()
|
||
|
|
44470 BEGIN (*OF MAIN PROGRAM*)
|
||
|
|
44480 END (*OF EVERYTHING*).
|
||
|
|
44490 ()+01*)
|