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*)