diff --git a/libraries/ghci/GHCi/Server.hs b/libraries/ghci/GHCi/Server.hs index 594d6d1f002381d2bc421cf9dd7414463107d02e..69ef87637b06875012a3d9d4e806bea1cbf75262 100644 --- a/libraries/ghci/GHCi/Server.hs +++ b/libraries/ghci/GHCi/Server.hs @@ -7,6 +7,7 @@ where import Prelude import GHCi.Run +import GHCi.Signals import GHCi.TH import GHCi.Message #if defined(wasm32_HOST_ARCH) @@ -19,7 +20,6 @@ import Foreign import Foreign.ForeignPtr.Unsafe import GHC.Wasm.Prim #else -import GHCi.Signals import GHCi.Utils #endif @@ -107,8 +107,8 @@ serv verbose hook pipe restore = loop -- | Default server #if defined(wasm32_HOST_ARCH) -defaultServer :: Callback (IO JSUint8Array) -> Callback (JSUint8Array -> IO ()) -> IO () -defaultServer cb_recv cb_send = do +defaultServer :: Callback (JSVal -> IO ()) -> Callback (IO JSUint8Array) -> Callback (JSUint8Array -> IO ()) -> IO () +defaultServer cb_sig cb_recv cb_send = do args <- getArgs let rest = args #else @@ -136,6 +136,8 @@ defaultServer = do dieWithUsage #if defined(wasm32_HOST_ARCH) + -- See Note [wasm ghci signal handlers] for details + installSignalHandlers $ js_register_signal_handler cb_sig pipe <- mkPipeFromContinuations (recv_buf cb_recv) (send_buf cb_send) #else when verbose $ @@ -186,6 +188,9 @@ send_buf cb b = do buf <- evaluate $ LB.toStrict $ B.toLazyByteString b B.unsafeUseAsCStringLen buf $ \(ptr, len) -> js_send_buf cb ptr len +foreign import javascript unsafe "dynamic" + js_register_signal_handler :: Callback (JSVal -> IO ()) -> JSVal -> IO () + foreign import javascript "dynamic" js_recv_buf :: Callback (IO JSUint8Array) -> IO JSUint8Array @@ -199,6 +204,6 @@ foreign import javascript unsafe "$1(new Uint8Array(__exports.memory.buffer, $2, js_send_buf :: Callback (JSUint8Array -> IO ()) -> Ptr a -> Int -> IO () foreign export javascript "defaultServer" - defaultServer :: Callback (IO JSUint8Array) -> Callback (JSUint8Array -> IO ()) -> IO () + defaultServer :: Callback (JSVal -> IO ()) -> Callback (IO JSUint8Array) -> Callback (JSUint8Array -> IO ()) -> IO () #endif diff --git a/libraries/ghci/GHCi/Signals.hs b/libraries/ghci/GHCi/Signals.hs index dc3b297dc5fb083e7b038ffd36488a7f2698d57c..7f364989d8bea7867f640afb17ccd40c63fffc8e 100644 --- a/libraries/ghci/GHCi/Signals.hs +++ b/libraries/ghci/GHCi/Signals.hs @@ -6,7 +6,9 @@ import Control.Concurrent import Control.Exception import System.Mem.Weak ( deRefWeak ) -#if !defined(mingw32_HOST_OS) +#if defined(wasm32_HOST_ARCH) +import GHC.Wasm.Prim +#elif !defined(mingw32_HOST_OS) import System.Posix.Signals #endif @@ -18,8 +20,13 @@ import GHC.ConsoleHandler -- exception in the target thread. The current target thread is the -- thread at the head of the list in the MVar passed to -- installSignalHandlers. +#if defined(wasm32_HOST_ARCH) +installSignalHandlers :: (JSVal -> IO ()) -> IO () +installSignalHandlers cb_sig = do +#else installSignalHandlers :: IO () installSignalHandlers = do +#endif main_thread <- myThreadId wtid <- mkWeakThreadId main_thread @@ -29,7 +36,9 @@ installSignalHandlers = do Nothing -> return () Just t -> throwTo t UserInterrupt -#if !defined(mingw32_HOST_OS) +#if defined(wasm32_HOST_ARCH) + cb_sig =<< js_export_signal_handler interrupt +#elif !defined(mingw32_HOST_OS) _ <- installHandler sigQUIT (Catch interrupt) Nothing _ <- installHandler sigINT (Catch interrupt) Nothing #else @@ -45,3 +54,34 @@ installSignalHandlers = do _ <- installHandler (Catch sig_handler) #endif return () + +#if defined(wasm32_HOST_ARCH) + +-- Note [wasm ghci signal handlers] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- For native ghc with -fexternal-interpreter, when you press ^C, +-- SIGINT is delivered to both ghc/iserv. iserv SIGINT handler raises +-- an async UserInterrupt exception in the main thread, which might +-- handle it right away, or later since it's doing I/O under +-- uninterruptibleMask. +-- +-- wasm is no different here. The node process needs to catch the same +-- signals. Instead of calling process.on('SIGINT', handler) in +-- Haskell via JSFFI, we pass a JS callback that registers the handler +-- from iserv main, export the Haskell handler to JS, then invoke the +-- callback to register the handler. This allows iserv to be run in +-- non-nodejs environments as well, and the dyld script can pass a +-- handler register callback other than process.on(). +-- +-- IMPORTANT: THE SIGNAL HANDLER MUST BE EXPORTED AS ASYNC!!!!!!! +-- Otherwise, throwTo may block the handler thread, so the handler +-- thread is removed from the run queue. Since the main thread may +-- also be absent from the run queue (e.g. blocked on waiting for +-- input message), the run queue is empty and then the RTS scheduler +-- panics. + +foreign import javascript "wrapper" + js_export_signal_handler :: IO () -> IO JSVal + +#endif diff --git a/utils/jsffi/dyld.mjs b/utils/jsffi/dyld.mjs index 3bd8c52b28daac58a2467b0ee82dbec275f8f4f0..a3cc7a5dcce170fbcc08626419afd7fcf4bc6c39 100755 --- a/utils/jsffi/dyld.mjs +++ b/utils/jsffi/dyld.mjs @@ -716,6 +716,11 @@ if (isMain()) { const reader = in_stream.getReader(); const writer = out_stream.getWriter(); + const cb_sig = (cb) => { + process.on("SIGINT", cb); + process.on("SIGQUIT", cb); + }; + const cb_recv = async () => { const { done, value } = await reader.read(); if (done) { @@ -727,5 +732,5 @@ if (isMain()) { writer.write(new Uint8Array(buf)); }; - await dyld.exportFuncs.defaultServer(cb_recv, cb_send); + await dyld.exportFuncs.defaultServer(cb_sig, cb_recv, cb_send); }