diff --git a/ghc/includes/stgdefs.h b/ghc/includes/stgdefs.h index 7170d42490524ffde46e6a85b1f391b89d3c81bc..f07689c4814386950431c1defaca437d381186e9 100644 --- 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 index 0000000000000000000000000000000000000000..0e89bc67aab559cc8af180ef11df5e57cef1a719 --- /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 44ce07b006e305813cb69d6548ee1b26f6fc7b95..6b6b77ad0751c5f912a5c14ee59dd14fc0a63b16 100644 --- 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 e4889eb5b92207a5b812c67971d4067fc16f30a6..1eee1ff0d1c115ebf98d730eaa2bca926cc4b16a 100644 --- 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