[project @ 1998-06-29 17:49:05 by sof]

Added OnExitHook(); hook run after Haskell world has been properly shut down

diff --git a/ghc/includes/stgdefs.h b/ghc/includes/stgdefs.h
index 7170d42..f07689c 100644 (file)
--- a/ghc/includes/stgdefs.h
+++ b/ghc/includes/stgdefs.h
@@ -224,6 +224,7 @@ StgFunPtr impossible_jump_after_switch(STG_NO_ARGS);
 /* hooks: user might write some of their own */
 void ErrorHdrHook      PROTO((FILE *));
 void OutOfHeapHook     PROTO((W_, W_));
+void OnExitHook         (STG_NO_ARGS);
 void StackOverflowHook PROTO((I_));
 #ifdef CONCURRENT
 int NoRunnableThreadsHook (STG_NO_ARGS);

diff --git a/ghc/runtime/hooks/ExitHook.lc b/ghc/runtime/hooks/ExitHook.lc
new file mode 100644 (file)
index 0000000..0e89bc6
--- /dev/null
+++ b/ghc/runtime/hooks/ExitHook.lc
@@ -0,0 +1,16 @@
+
+Note: by the time this hook has been called, Haskell land
+will have been shut down completely.
+
+ToDo: feed the hook info on whether we're shutting down as a result
+of termination or run-time error ?
+
+\begin{code}
+#include "rtsdefs.h"
+
+void
+OnExitHook ()
+{
+ return;
+}
+\end{code}

diff --git a/ghc/runtime/main/StgStartup.lhc b/ghc/runtime/main/StgStartup.lhc
index 44ce07b..6b6b77a 100644 (file)
--- a/ghc/runtime/main/StgStartup.lhc
+++ b/ghc/runtime/main/StgStartup.lhc
@@ -204,7 +204,7 @@ P_ PrelGHC_ZcCReturnable_static_info = (P_) 0xbadbadbaL;
 /* the IoWorld token to start the whole thing off */
 /* Question: this is just an amusing hex code isn't it
    -- or does it mean something? ADR */
-P_ realWorldZh_closure = (P_) 0xbadbadbaL;
+P_ realWorldZh_closure = (P_)0xbadbadbaL;
 
 #ifndef CONCURRENT
 
@@ -229,7 +229,7 @@ STGFUN(startStgWorld)
 
     /* Put an IoWorld token on the A stack */
     SpB -= BREL(1);
-    *SpB = (P_) realWorldZh_closure;
+    (P_)*SpB = (P_) realWorldZh_closure;
 
     Node = (P_) TopClosure; /* Point to the closure for main/errorIO-arg */
     ENT_VIA_NODE();
@@ -501,6 +501,26 @@ STATIC_ITBL(STK_STUB_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,I
 SET_STATIC_HDR(STK_STUB_closure,STK_STUB_info,CC_SUBSUMED,,EXTDATA_RO)
   , (W_)0, (W_)0
 };
+
+
+ED_RO_(vtbl_seq);
+
+/*
+STGFUN(seqZhCode)
+{
+    FB_
+    __label__ cont;
+    SpB[BREL(0)] = (W_) RetReg;
+    SpB[BREL(1)] = (W_) &&cont;
+    RetReg = (StgRetAddr) vtbl_seq;
+    ENT_VIA_NODE();
+    InfoPtr = (D_)(INFO_PTR(Node));
+    JMP_(ENTRY_CODE(InfoPtr));
+cont:
+    FE_
+}
+*/
+
 \end{code}
 
 %/****************************************************************

diff --git a/ghc/runtime/main/main.lc b/ghc/runtime/main/main.lc
index e4889eb..1eee1ff 100644 (file)
--- a/ghc/runtime/main/main.lc
+++ b/ghc/runtime/main/main.lc
@@ -342,6 +342,11 @@ shutdownHaskell(STG_NO_ARGS)
     if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
 #endif
 
+    /* Give the application a chance to do something sensible
+       on-exit
+    */
+    OnExitHook();
+
     fflush(stdout);
     /* This fflush is important, because: if "main" just returns,
        then we will end up in pre-supplied exit code that will close