[commit: ghc] ghc-8.0: Revert "Install toplevel handler inside fork." (d864200)

git at git.haskell.org git at git.haskell.org
Wed Dec 14 18:09:47 UTC 2016


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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/d86420021ffd35e8f09216364d65bd1d18581731/ghc

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

commit d86420021ffd35e8f09216364d65bd1d18581731
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Dec 13 15:56:44 2016 -0500

    Revert "Install toplevel handler inside fork."
    
    The test associated with this has given us too much trouble. It's not
    worth the pain for a minor release.
    
    This reverts commit fb0f4cf66f3fc7590821e6688440bf86c25aced1.


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

d86420021ffd35e8f09216364d65bd1d18581731
 includes/RtsAPI.h                 |  4 ----
 rts/Prelude.h                     |  2 --
 rts/RtsAPI.c                      | 29 -----------------------------
 rts/RtsSymbols.c                  |  1 -
 rts/Schedule.c                    |  5 +----
 rts/package.conf.in               |  2 --
 testsuite/tests/rts/T12903.hs     | 10 ----------
 testsuite/tests/rts/T12903.stdout |  1 -
 testsuite/tests/rts/all.T         |  2 --
 9 files changed, 1 insertion(+), 55 deletions(-)

diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 0e29c63..4748060 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -245,10 +245,6 @@ void rts_evalIO (/* inout */ Capability **,
                  /* in    */ HaskellObj p,
                  /* out */   HaskellObj *ret);
 
-void rts_evalStableIOMain (/* inout */ Capability **,
-                           /* in    */ HsStablePtr s,
-                           /* out */   HsStablePtr *ret);
-
 void rts_evalStableIO (/* inout */ Capability **,
                        /* in    */ HsStablePtr s,
                        /* out */   HsStablePtr *ret);
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 444aa46..ae1e9cb 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -51,7 +51,6 @@ PRELUDE_CLOSURE(base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure);
 PRELUDE_CLOSURE(base_GHCziConcziSignal_runHandlersPtr_closure);
 
 PRELUDE_CLOSURE(base_GHCziTopHandler_flushStdHandles_closure);
-PRELUDE_CLOSURE(base_GHCziTopHandler_runMainIO_closure);
 
 PRELUDE_INFO(ghczmprim_GHCziTypes_Czh_static_info);
 PRELUDE_INFO(ghczmprim_GHCziTypes_Izh_static_info);
@@ -100,7 +99,6 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define runHandlersPtr_closure       DLL_IMPORT_DATA_REF(base_GHCziConcziSignal_runHandlersPtr_closure)
 
 #define flushStdHandles_closure   DLL_IMPORT_DATA_REF(base_GHCziTopHandler_flushStdHandles_closure)
-#define runMainIO_closure   DLL_IMPORT_DATA_REF(base_GHCziTopHandler_runMainIO_closure)
 
 #define stackOverflow_closure     DLL_IMPORT_DATA_REF(base_GHCziIOziException_stackOverflow_closure)
 #define heapOverflow_closure      DLL_IMPORT_DATA_REF(base_GHCziIOziException_heapOverflow_closure)
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 47f6c93..c64d8af 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -460,35 +460,6 @@ void rts_evalIO (/* inout */ Capability **cap,
 }
 
 /*
- * rts_evalStableIOMain() is suitable for calling main Haskell thread
- * stored in (StablePtr (IO a)) it calls rts_evalStableIO but wraps
- * function in GHC.TopHandler.runMainIO that installs top_handlers.
- * See Trac #12903.
- */
-void rts_evalStableIOMain(/* inout */ Capability **cap,
-                          /* in    */ HsStablePtr s,
-                          /* out   */ HsStablePtr *ret)
-{
-    StgTSO* tso;
-    StgClosure *p, *r, *w;
-    SchedulerStatus stat;
-
-    p = (StgClosure *)deRefStablePtr(s);
-    w = rts_apply(*cap, &base_GHCziTopHandler_runMainIO_closure, p);
-    tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, w);
-    // async exceptions are always blocked by default in the created
-    // thread.  See #1048.
-    tso->flags |= TSO_BLOCKEX | TSO_INTERRUPTIBLE;
-    scheduleWaitThread(tso,&r,cap);
-    stat = rts_getSchedStatus(*cap);
-
-    if (stat == Success && ret != NULL) {
-        ASSERT(r != NULL);
-        *ret = getStablePtr((StgPtr)r);
-    }
-}
-
-/*
  * rts_evalStableIO() is suitable for calling from Haskell.  It
  * evaluates a value of the form (StablePtr (IO a)), forcing the
  * action's result to WHNF before returning.  The result is returned
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 44b6591..fec5cfc 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -647,7 +647,6 @@
       SymI_HasProto(rts_eval)                                           \
       SymI_HasProto(rts_evalIO)                                         \
       SymI_HasProto(rts_evalLazyIO)                                     \
-      SymI_HasProto(rts_evalStableIOMain)                               \
       SymI_HasProto(rts_evalStableIO)                                   \
       SymI_HasProto(rts_eval_)                                          \
       SymI_HasProto(rts_getBool)                                        \
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 33599d0..1f42e42 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -2078,10 +2078,7 @@ forkProcess(HsStablePtr *entry
         ioManagerStartCap(&cap);
 #endif
 
-        // Install toplevel exception handlers, so interruption
-        // signal will be sent to the main thread.
-        // See Trac #12903
-        rts_evalStableIOMain(&cap, entry, NULL);  // run the action
+        rts_evalStableIO(&cap, entry, NULL);  // run the action
         rts_checkSchedStatus("forkProcess",cap);
 
         rts_unlock(cap);
diff --git a/rts/package.conf.in b/rts/package.conf.in
index e328be7..c0256bb 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -106,7 +106,6 @@ ld-options:
          , "-Wl,-u,_base_GHCziTopHandler_flushStdHandles_closure"
          , "-Wl,-u,_base_GHCziTopHandler_runIO_closure"
          , "-Wl,-u,_base_GHCziTopHandler_runNonIO_closure"
-         , "-Wl,-u,_base_GHCziTopHandler_runMainIO_closure"
          , "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,_base_GHCziConcziSync_runSparks_closure"
@@ -149,7 +148,6 @@ ld-options:
          , "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure"
          , "-Wl,-u,base_GHCziTopHandler_runIO_closure"
          , "-Wl,-u,base_GHCziTopHandler_runNonIO_closure"
-         , "-Wl,-u,base_GHCziTopHandler_runMainIO_closure"
          , "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,base_GHCziConcziSync_runSparks_closure"
diff --git a/testsuite/tests/rts/T12903.hs b/testsuite/tests/rts/T12903.hs
deleted file mode 100644
index ddaf8b9..0000000
--- a/testsuite/tests/rts/T12903.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-import Control.Concurrent
-import Control.Exception
-import System.Posix
-
-main = do
-  pid <- forkProcess $ do
-           handle (\UserInterrupt{} -> putStrLn "caught")
-                  $ threadDelay 2000000
-  signalProcess sigINT pid
-  threadDelay 2000000
diff --git a/testsuite/tests/rts/T12903.stdout b/testsuite/tests/rts/T12903.stdout
deleted file mode 100644
index cad99e1..0000000
--- a/testsuite/tests/rts/T12903.stdout
+++ /dev/null
@@ -1 +0,0 @@
-caught
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index d889276..f7d518c 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -345,5 +345,3 @@ test('T10296b', [only_ways('threaded2')], compile_and_run, [''])
 test('T12497', [ unless(opsys('mingw32'), skip)
                ],
                run_command, ['$MAKE -s --no-print-directory T12497'])
-test('T12903', [ when(opsys('mingw32'), skip)], compile_and_run, [''])
-



More information about the ghc-commits mailing list