[commit: ghc] ghc-7.8: Fix #8754 again. (55b332b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.8
Link       : http://ghc.haskell.org/trac/ghc/changeset/55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5/ghc

>---------------------------------------------------------------

commit 55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5
Author: Austin Seipp <austin at well-typed.com>
Date:   Thu Feb 20 06:41:02 2014 -0600

    Fix #8754 again.
    
    This time, we carefully initialize the GC stats only if they're not
    already initialized - this way the user can override them (e.g. `+RTS -t
    --machine-readable`).
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>
    
    (cherry picked from commit c72e8898447b2a8e55f2d16594b5944c2ae13e24)


>---------------------------------------------------------------

55b332bc4cd5c0d18a106bff0f7979f4bbcdddf5
 ghc/Main.hs    |   25 +++++++++++++++++++++++++
 ghc/hschooks.c |   15 ++++++++++++++-
 2 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/ghc/Main.hs b/ghc/Main.hs
index 868042b..481e7df 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
 
 -----------------------------------------------------------------------------
 --
@@ -76,6 +77,7 @@ import Data.Maybe
 
 main :: IO ()
 main = do
+   initGCStatistics -- See Note [-Bsymbolic and hooks]
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
    GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
@@ -818,3 +820,26 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
         (case fuzzyMatch f (nub allFlags) of
             [] -> ""
             suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs)) 
+
+{- Note [-Bsymbolic and hooks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-Bsymbolic is a flag that prevents the binding of references to global
+symbols to symbols outside the shared library being compiled (see `man
+ld`). When dynamically linking, we don't use -Bsymbolic on the RTS
+package: that is because we want hooks to be overridden by the user,
+we don't want to constrain them to the RTS package.
+
+Unfortunately this seems to have broken somehow on OS X: as a result,
+defaultHooks (in hschooks.c) is not called, which does not initialize
+the GC stats. As a result, this breaks things like `:set +s` in GHCi
+(#8754). As a hacky workaround, we instead call 'defaultHooks'
+directly to initalize the flags in the RTS.
+
+A biproduct of this, I believe, is that hooks are likely broken on OS
+X when dynamically linking. But this probably doesn't affect most
+people since we're linking GHC dynamically, but most things themselves
+link statically.
+-}
+
+foreign import ccall safe "initGCStatistics"
+  initGCStatistics :: IO ()
diff --git a/ghc/hschooks.c b/ghc/hschooks.c
index 4e6e66d..4c588d0 100644
--- a/ghc/hschooks.c
+++ b/ghc/hschooks.c
@@ -16,6 +16,18 @@ in instead of the defaults.
 #endif
 
 void
+initGCStatistics(void)
+{
+  /* Workaround for #8754: if the GC stats aren't enabled because the
+   compiler couldn't use -Bsymbolic to link the default hooks, then
+   initialize them sensibly. See Note [-Bsymbolic and hooks] in
+   Main.hs. */
+  if (RtsFlags.GcFlags.giveStats == NO_GC_STATS) {
+    RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
+  }
+}
+
+void
 defaultsHook (void)
 {
 #if __GLASGOW_HASKELL__ >= 707
@@ -28,7 +40,8 @@ defaultsHook (void)
 #endif
 
     RtsFlags.GcFlags.maxStkSize         = 512*1024*1024 / sizeof(W_);
-    RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
+
+    initGCStatistics();
 
     // See #3408: the default idle GC time of 0.3s is too short on
     // Windows where we receive console events once per second or so.