PR modula2/114227 InstallTerminationProcedure does not work with -fiso

This patch moves the initial/termination user procedure functionality in
pim and iso versions of M2RTS into M2Dependent.  This ensures that
finalization/initialization procedures will always be invoked for both -fiso
and -fpim.  Prior to this patch M2Dependent called M2RTS for
termination procedure cleanup and always invoked the pim M2RTS.

gcc/m2/ChangeLog:

	PR modula2/114227
	* gm2-libs-iso/M2RTS.mod (ProcedureChain): Remove.
	(ProcedureList): Remove.
	(ExecuteReverse): Remove.
	(ExecuteTerminationProcedures): Rewrite.
	(ExecuteInitialProcedures): Rewrite.
	(AppendProc): Remove.
	(InstallTerminationProcedure): Rewrite.
	(InstallInitialProcedure): Rewrite.
	(InitProcList): Remove.
	* gm2-libs/M2Dependent.def (InstallTerminationProcedure):
	New procedure.
	(ExecuteTerminationProcedures): New procedure.
	(InstallInitialProcedure): New procedure.
	(ExecuteInitialProcedures): New procedure.
	* gm2-libs/M2Dependent.mod (ProcedureChain): New type.
	(ProcedureList): New type.
	(ExecuteReverse): New procedure.
	(ExecuteTerminationProcedures): New procedure.
	(ExecuteInitialProcedures): New procedure.
	(AppendProc): New procedure.
	(InstallTerminationProcedure): New procedure.
	(InstallInitialProcedure): New procedure.
	(InitProcList): New procedure.
	* gm2-libs/M2RTS.mod (ProcedureChain): Remove.
	(ProcedureList): Remove.
	(ExecuteReverse): Remove.
	(ExecuteTerminationProcedures): Rewrite.
	(ExecuteInitialProcedures): Rewrite.
	(AppendProc): Remove.
	(InstallTerminationProcedure): Rewrite.
	(InstallInitialProcedure): Rewrite.
	(InitProcList): Remove.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

diff --git a/gcc/m2/gm2-libs-iso/M2RTS.mod b/gcc/m2/gm2-libs-iso/M2RTS.mod
index 14a9e8170ec834ac176fe9ceb092a9121186f087..291b8e99b3cb02887d8cf419dce0cd36fd0c28e9 100644 (file)
--- a/gcc/m2/gm2-libs-iso/M2RTS.mod
+++ b/gcc/m2/gm2-libs-iso/M2RTS.mod
@@ -45,20 +45,7 @@ CONST
 TYPE
    PtrToChar = POINTER TO CHAR ;
 
-   ProcedureChain = POINTER TO RECORD
-                                  p   : PROC ;
-                                  prev,
-                                  next: ProcedureChain ;
-                                END ;
-
-   ProcedureList = RECORD
-                      head, tail: ProcedureChain
-                   END ;
-
-
 VAR
-   InitialProc,
-   TerminateProc      : ProcedureList ;
    ExitValue          : INTEGER ;
    isTerminating,
    isHalting,
@@ -121,21 +108,6 @@ BEGIN
 END RequestDependant ;
 
 
-(*
-   ExecuteReverse - execute the procedure associated with procptr
-                    and then proceed to try and execute all previous
-                    procedures in the chain.
-*)
-
-PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
-BEGIN
-   WHILE procptr # NIL DO
-      procptr^.p ;  (* Invoke the procedure.  *)
-      procptr := procptr^.prev
-   END
-END ExecuteReverse ;
-
-
 (*
    ExecuteTerminationProcedures - calls each installed termination procedure
                                   in reverse order.
@@ -143,7 +115,7 @@ END ExecuteReverse ;
 
 PROCEDURE ExecuteTerminationProcedures ;
 BEGIN
-   ExecuteReverse (TerminateProc.tail)
+   M2Dependent.ExecuteTerminationProcedures
 END ExecuteTerminationProcedures ;
 
 
@@ -154,34 +126,10 @@ END ExecuteTerminationProcedures ;
 
 PROCEDURE ExecuteInitialProcedures ;
 BEGIN
-   ExecuteReverse (InitialProc.tail)
+   M2Dependent.ExecuteInitialProcedures
 END ExecuteInitialProcedures ;
 
 
-(*
-   AppendProc - append proc to the end of the procedure list
-                defined by proclist.
-*)
-
-PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
-VAR
-   pdes: ProcedureChain ;
-BEGIN
-   NEW (pdes) ;
-   WITH pdes^ DO
-      p := proc ;
-      prev := proclist.tail ;
-      next := NIL
-   END ;
-   IF proclist.head = NIL
-   THEN
-      proclist.head := pdes
-   END ;
-   proclist.tail := pdes ;
-   RETURN TRUE
-END AppendProc ;
-
-
 (*
    InstallTerminationProcedure - installs a procedure, p, which will
                                  be called when the procedure
@@ -192,7 +140,7 @@ END AppendProc ;
 
 PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
 BEGIN
-   RETURN AppendProc (TerminateProc, p)
+   RETURN M2Dependent.InstallTerminationProcedure (p)
 END InstallTerminationProcedure ;
 
 
@@ -204,7 +152,7 @@ END InstallTerminationProcedure ;
 
 PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
 BEGIN
-   RETURN AppendProc (InitialProc, p)
+   RETURN M2Dependent.InstallInitialProcedure (p)
 END InstallInitialProcedure ;
 
 
@@ -625,25 +573,12 @@ BEGIN
 END NoException ;
 
 
-(*
-   InitProcList - initialize the head and tail pointers to NIL.
-*)
-
-PROCEDURE InitProcList (VAR p: ProcedureList) ;
-BEGIN
-   p.head := NIL ;
-   p.tail := NIL
-END InitProcList ;
-
-
 (*
    Init -
 *)
 
 PROCEDURE Init ;
 BEGIN
-   InitProcList (InitialProc) ;
-   InitProcList (TerminateProc) ;
    ExitValue := 0 ;
    isHalting := FALSE ;
    CallExit := FALSE ;  (* default by calling abort *)

diff --git a/gcc/m2/gm2-libs/M2Dependent.def b/gcc/m2/gm2-libs/M2Dependent.def
index 9e31d57285b9a43a7700241d1eb69cfdb50f1638..b37c0048948445f4c8943eed5c46bfdf23e2be98 100644 (file)
--- a/gcc/m2/gm2-libs/M2Dependent.def
+++ b/gcc/m2/gm2-libs/M2Dependent.def
@@ -62,4 +62,40 @@ PROCEDURE RequestDependant (modulename, libname,
                             dependantmodule, dependantlibname: ADDRESS) ;
 
 
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE is the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed
+                              by InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the main
+                             program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+
+
 END M2Dependent.

diff --git a/gcc/m2/gm2-libs/M2Dependent.mod b/gcc/m2/gm2-libs/M2Dependent.mod
index e7b502e29d77331be6effadefc90f9e33d8bc620..d6dfa636e26365681bd286115c9d2d025baf6dd4 100644 (file)
--- a/gcc/m2/gm2-libs/M2Dependent.mod
+++ b/gcc/m2/gm2-libs/M2Dependent.mod
@@ -33,8 +33,6 @@ FROM SYSTEM IMPORT ADR ;
 FROM Storage IMPORT ALLOCATE ;
 FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
 
-IMPORT M2RTS ;
-
 
 TYPE
    PtrToChar = POINTER TO CHAR ;
@@ -61,6 +59,16 @@ TYPE
                                next      : ModuleChain ;
                             END ;
 
+   ProcedureList = RECORD
+                      head, tail: ProcedureChain
+                   END ;
+
+   ProcedureChain = POINTER TO RECORD
+                                  p   : PROC ;
+                                  prev,
+                                  next: ProcedureChain ;
+                                END ;
+
 VAR
    Modules              : ARRAY DependencyState OF ModuleChain ;
    DynamicInitialization,
@@ -72,6 +80,8 @@ VAR
    PreTrace,
    PostTrace,
    ForceTrace           : BOOLEAN ;
+   InitialProc,
+   TerminateProc        : ProcedureList ;
 
 
 (*
@@ -816,8 +826,8 @@ BEGIN
          IF mptr^.dependency.appl
          THEN
             traceprintf3 (ModuleTrace, "application module: %s [%s]\n", mptr^.name, mptr^.libname);
-            traceprintf (ModuleTrace, "  calling M2RTS_ExecuteInitialProcedures\n");
-            M2RTS.ExecuteInitialProcedures ;
+            traceprintf (ModuleTrace, "  calling ExecuteInitialProcedures\n");
+            ExecuteInitialProcedures ;
             traceprintf (ModuleTrace, "  calling application module\n");
          END ;
          mptr^.init (argc, argv, envp) ;
@@ -844,7 +854,7 @@ BEGIN
       traceprintf (ModuleTrace, "  no ordered modules found during finishing\n")
    ELSE
       traceprintf (ModuleTrace, "ExecuteTerminationProcedures\n") ;
-      M2RTS.ExecuteTerminationProcedures ;
+      ExecuteTerminationProcedures ;
       traceprintf (ModuleTrace, "terminating modules in sequence\n") ;
       mptr := Modules[ordered]^.prev ;
       REPEAT
@@ -1005,6 +1015,8 @@ PROCEDURE Init ;
 VAR
    state: DependencyState ;
 BEGIN
+   InitProcList (InitialProc) ;
+   InitProcList (TerminateProc) ;
    SetupDebugFlags ;
    FOR state := MIN (DependencyState) TO MAX (DependencyState) DO
       Modules[state] := NIL
@@ -1030,6 +1042,104 @@ BEGIN
 END CheckInitialized ;
 
 
+(*
+   ExecuteReverse - execute the procedure associated with procptr
+                    and then proceed to try and execute all previous
+                    procedures in the chain.
+*)
+
+PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
+BEGIN
+   WHILE procptr # NIL DO
+      procptr^.p ;  (* Invoke the procedure.  *)
+      procptr := procptr^.prev
+   END
+END ExecuteReverse ;
+
+
+(*
+   ExecuteTerminationProcedures - calls each installed termination procedure
+                                  in reverse order.
+*)
+
+PROCEDURE ExecuteTerminationProcedures ;
+BEGIN
+   ExecuteReverse (TerminateProc.tail)
+END ExecuteTerminationProcedures ;
+
+
+(*
+   ExecuteInitialProcedures - executes the initial procedures installed by
+                              InstallInitialProcedure.
+*)
+
+PROCEDURE ExecuteInitialProcedures ;
+BEGIN
+   ExecuteReverse (InitialProc.tail)
+END ExecuteInitialProcedures ;
+
+
+(*
+   AppendProc - append proc to the end of the procedure list
+                defined by proclist.
+*)
+
+PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
+VAR
+   pdes: ProcedureChain ;
+BEGIN
+   NEW (pdes) ;
+   WITH pdes^ DO
+      p := proc ;
+      prev := proclist.tail ;
+      next := NIL
+   END ;
+   IF proclist.head = NIL
+   THEN
+      proclist.head := pdes
+   END ;
+   proclist.tail := pdes ;
+   RETURN TRUE
+END AppendProc ;
+
+
+(*
+   InstallTerminationProcedure - installs a procedure, p, which will
+                                 be called when the procedure
+                                 ExecuteTerminationProcedures
+                                 is invoked.  It returns TRUE if the
+                                 procedure is installed.
+*)
+
+PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (TerminateProc, p)
+END InstallTerminationProcedure ;
+
+
+(*
+   InstallInitialProcedure - installs a procedure to be executed just
+                             before the BEGIN code section of the
+                             main program module.
+*)
+
+PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
+BEGIN
+   RETURN AppendProc (InitialProc, p)
+END InstallInitialProcedure ;
+
+
+(*
+   InitProcList - initialize the head and tail pointers to NIL.
+*)
+
+PROCEDURE InitProcList (VAR p: ProcedureList) ;
+BEGIN
+   p.head := NIL ;
+   p.tail := NIL
+END InitProcList ;
+
+
 BEGIN
    CheckInitialized
 END M2Dependent.

diff --git a/gcc/m2/gm2-libs/M2RTS.mod b/gcc/m2/gm2-libs/M2RTS.mod
index 765e6e53cd4cfa4ddb6b440f013853e51f26db71..41add830766e80dac205b9857a1c4140fa1783f9 100644 (file)
--- a/gcc/m2/gm2-libs/M2RTS.mod
+++ b/gcc/m2/gm2-libs/M2RTS.mod
@@ -45,20 +45,7 @@ CONST
 TYPE
    PtrToChar = POINTER TO CHAR ;
 
-   ProcedureList = RECORD
-                      head, tail: ProcedureChain
-                   END ;
-
-   ProcedureChain = POINTER TO RECORD
-                                  p   : PROC ;
-                                  prev,
-                                  next: ProcedureChain ;
-                                END ;
-
-
 VAR
-   InitialProc,
-   TerminateProc: ProcedureList ;
    ExitValue    : INTEGER ;
    isHalting,
    CallExit     : BOOLEAN ;
@@ -120,21 +107,6 @@ BEGIN
 END RequestDependant ;
 
 
-(*
-   ExecuteReverse - execute the procedure associated with procptr
-                    and then proceed to try and execute all previous
-                    procedures in the chain.
-*)
-
-PROCEDURE ExecuteReverse (procptr: ProcedureChain) ;
-BEGIN
-   WHILE procptr # NIL DO
-      procptr^.p ;  (* Invoke the procedure.  *)
-      procptr := procptr^.prev
-   END
-END ExecuteReverse ;
-
-
 (*
    ExecuteTerminationProcedures - calls each installed termination procedure
                                   in reverse order.
@@ -142,7 +114,7 @@ END ExecuteReverse ;
 
 PROCEDURE ExecuteTerminationProcedures ;
 BEGIN
-   ExecuteReverse (TerminateProc.tail)
+   M2Dependent.ExecuteTerminationProcedures
 END ExecuteTerminationProcedures ;
 
 
@@ -153,34 +125,10 @@ END ExecuteTerminationProcedures ;
 
 PROCEDURE ExecuteInitialProcedures ;
 BEGIN
-   ExecuteReverse (InitialProc.tail)
+   M2Dependent.ExecuteInitialProcedures
 END ExecuteInitialProcedures ;
 
 
-(*
-   AppendProc - append proc to the end of the procedure list
-                defined by proclist.
-*)
-
-PROCEDURE AppendProc (VAR proclist: ProcedureList; proc: PROC) : BOOLEAN ;
-VAR
-   pdes: ProcedureChain ;
-BEGIN
-   NEW (pdes) ;
-   WITH pdes^ DO
-      p := proc ;
-      prev := proclist.tail ;
-      next := NIL
-   END ;
-   IF proclist.head = NIL
-   THEN
-      proclist.head := pdes
-   END ;
-   proclist.tail := pdes ;
-   RETURN TRUE
-END AppendProc ;
-
-
 (*
    InstallTerminationProcedure - installs a procedure, p, which will
                                  be called when the procedure
@@ -191,7 +139,7 @@ END AppendProc ;
 
 PROCEDURE InstallTerminationProcedure (p: PROC) : BOOLEAN ;
 BEGIN
-   RETURN AppendProc (TerminateProc, p)
+   RETURN M2Dependent.InstallTerminationProcedure (p)
 END InstallTerminationProcedure ;
 
 
@@ -203,7 +151,7 @@ END InstallTerminationProcedure ;
 
 PROCEDURE InstallInitialProcedure (p: PROC) : BOOLEAN ;
 BEGIN
-   RETURN AppendProc (InitialProc, p)
+   RETURN M2Dependent.InstallInitialProcedure (p)
 END InstallInitialProcedure ;
 
 
@@ -558,25 +506,12 @@ BEGIN
 END Length ;
 
 
-(*
-   InitProcList - initialize the head and tail pointers to NIL.
-*)
-
-PROCEDURE InitProcList (VAR p: ProcedureList) ;
-BEGIN
-   p.head := NIL ;
-   p.tail := NIL
-END InitProcList ;
-
-
 (*
    Init - initialize the initial, terminate procedure lists and booleans.
 *)
 
 PROCEDURE Init ;
 BEGIN
-   InitProcList (InitialProc) ;
-   InitProcList (TerminateProc) ;
    ExitValue := 0 ;
    isHalting := FALSE ;
    CallExit := FALSE   (* default by calling abort *)