[Git][ghc/ghc][wip/wasm-jsffi-interruptible] 6 commits: rts: add hs_try_putmvar_with_value to RTS API
Cheng Shao (@TerrorJack)
gitlab at gitlab.haskell.org
Sun Mar 16 14:40:56 UTC 2025
Cheng Shao pushed to branch wip/wasm-jsffi-interruptible at Glasgow Haskell Compiler / GHC
Commits:
e2a4f6e2 by Cheng Shao at 2025-03-16T14:40:41+00:00
rts: add hs_try_putmvar_with_value to RTS API
This commit adds hs_try_putmvar_with_value to rts. It allows more
flexibility than hs_try_putmvar by taking an additional value argument
as a closure to be put into the MVar. This function is used & tested
by the wasm backend runtime, though it makes sense to expose it as a
public facing RTS API function as well.
- - - - -
17c23017 by Cheng Shao at 2025-03-16T14:40:45+00:00
wasm: use MVar as JSFFI import blocking mechanism
Previously, when blocking on a JSFFI import, we push a custom
stg_jsffi_block stack frame and arrange the `promise.then` callback to
write to that stack frame. It turns out we can simply use the good old
MVar to implement the blocking logic, with a few benefits:
- Less maintenance burden. We can drop the stg_jsffi_block related Cmm
code without loss of functionality.
- It interacts better with existing async exception mechanism. throwTo
would properly block the caller if the target thread is masking
async exceptions.
- - - - -
05abc48c by Cheng Shao at 2025-03-16T14:40:45+00:00
wasm: properly pin the raiseJSException closure
We used to use keepAlive# to pin the raiseJSException closure when
blocking on a JSFFI import thunk, since it can potentially be used by
RTS. But raiseJSException may be used in other places as well (e.g.
the promise.throwTo logic), and it's better to simply unconditionally
pin it in the JSFFI initialization logic.
- - - - -
1215cfb1 by Cheng Shao at 2025-03-16T14:40:45+00:00
wasm: implement promise.throwTo() for async JSFFI exports
This commit implements promise.throwTo() for wasm backend JSFFI
exports. This allows the JavaScript side to interrupt Haskell
computation by raising an async exception. See subsequent docs/test
commits for more details.
- - - - -
676498d0 by Cheng Shao at 2025-03-16T14:40:45+00:00
testsuite: add test for wasm promise.throwTo() logic
This commit adds a test case to test the wasm backend
promise.throwTo() logic.
- - - - -
d9e4701f by Cheng Shao at 2025-03-16T14:40:45+00:00
docs: document the wasm backend promise.throwTo() feature
- - - - -
15 changed files:
- docs/users_guide/exts/ffi.rst
- docs/users_guide/wasm.rst
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- rts/RtsAPI.c
- rts/RtsSymbols.c
- rts/include/HsFFI.h
- rts/wasm/JSFFI.c
- rts/wasm/blocker.cmm
- rts/wasm/scheduler.cmm
- testsuite/tests/jsffi/all.T
- + testsuite/tests/jsffi/cancel.hs
- + testsuite/tests/jsffi/cancel.mjs
- + testsuite/tests/jsffi/cancel.stdout
Changes:
=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -976,6 +976,8 @@ wake up a Haskell thread from C/C++.
void hs_try_putmvar (int capability, HsStablePtr sp);
+ void hs_try_putmvar_with_value (int capability, HsStablePtr sp, StgClosure *value);
+
The C call ``hs_try_putmvar(cap, mvar)`` is equivalent to the Haskell
call ``tryPutMVar mvar ()``, except that it is
@@ -988,6 +990,15 @@ call ``tryPutMVar mvar ()``, except that it is
the ``MVar`` is empty; if it is full, ``hs_try_putmvar()`` will have
no effect.
+The C call ``hs_try_putmvar_with_value(cap, mvar, value)`` takes an
+additional ``value`` argument, which is an RTS closure pointer of the
+value to be put into the MVar. It works the same way as
+``hs_try_putmvar`` while offering a bit more flexibility: for a C
+value to be passed to Haskell, you can directly call one of the
+``rts_mk`` functions to wrap the C value and put it into the MVar,
+instead of writing it to a heap location and peeking it from a pointer
+in Haskell.
+
**Example**. Suppose we have a C/C++ function to call that will return and then
invoke a callback at some point in the future, passing us some data.
We want to wait in Haskell for the callback to be called, and retrieve
=====================================
docs/users_guide/wasm.rst
=====================================
@@ -444,18 +444,11 @@ caveats:
registered on that ``Promise`` will no longer be invoked. For
simplicity of implementation, we aren’t using those for the time
being.
-- Normally, ``throwTo`` would block until the async exception has been
- delivered. In the case of JSFFI, ``throwTo`` would always return
- successfully immediately, while the target thread is still left in a
- suspended state. The target thread will only be waken up when the
- ``Promise`` actually resolves or rejects, though the ``Promise``
- result will be discarded at that point.
-
-The current way async exceptions are handled in JSFFI is subject to
-change though. Ideally, once the exception is delivered, the target
-thread can be waken up immediately and continue execution, and the
-pending ``Promise`` will drop reference to that thread and no longer
-invoke any continuations.
+- When a thread blocks for a ``Promise`` to settle while masking
+ async exceptions, ``throwTo`` would block the caller until the
+ ``Promise`` is settled. If the target thread isn't masking async
+ exceptions, ``throwTo`` would cancel its blocking on the
+ ``Promise`` and resume its execution.
.. _wasm-jsffi-cffi:
@@ -584,3 +577,14 @@ JavaScript.
Finally, in JavaScript, you can use ``await __exports.my_func()`` to
call your exported ``my_func`` function and get its result, pass
arguments, do error handling, etc etc.
+
+For each async export, the returned ``Promise`` value contains a
+``promise.throwTo()`` callback. The value passed to
+``promise.throwTo()`` will be wrapped as a ``JSException`` and raised
+as an async exception in that thread. This can be useful for
+interrupting Haskell computation in JavaScript. ``promise.throwTo()``
+doesn't block the JavaScript caller like Haskell ``throwTo``. It
+doesn't necessarily result in ``promise`` being rejected since the
+Haskell thread can handle the async exception, and it can be called
+multiple time. It has no effect when the respective Haskell thread has
+already run to completion.
=====================================
libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
=====================================
@@ -34,6 +34,7 @@ import GHC.Internal.Base
import GHC.Internal.Exception.Type
import GHC.Internal.Exts
import GHC.Internal.IO
+import GHC.Internal.IORef
import GHC.Internal.Int
import GHC.Internal.Stable
import GHC.Internal.TopHandler (flushStdHandles)
@@ -65,9 +66,14 @@ runIO res m = do
let tmp@(JSString tmp_v) = toJSString $ displayException err
js_promiseReject p tmp
freeJSVal tmp_v
- IO $ \s0 -> case fork# (unIO $ catch (res p =<< m) topHandler *> flushStdHandles) s0 of
- (# s1, _ #) -> case stg_scheduler_loop# s1 of
- (# s2, _ #) -> (# s2, p #)
+ post_action_ref <- newIORef $ pure ()
+ IO $ \s0 -> case fork# (unIO $ catch (res p =<< m) topHandler *> flushStdHandles *> join (readIORef post_action_ref)) s0 of
+ (# s1, tso# #) -> case mkWeakNoFinalizer# tso# () s1 of
+ (# s2, w# #) -> case makeStablePtr# w# s2 of
+ (# s3, sp# #) -> case unIO (writeIORef post_action_ref $ js_promiseDelThrowTo p *> freeStablePtr (StablePtr $ unsafeCoerce# sp#)) s3 of
+ (# s4, _ #) -> case unIO (js_promiseAddThrowTo p $ StablePtr $ unsafeCoerce# sp#) s4 of
+ (# s5, _ #) -> case stg_scheduler_loop# s5 of
+ (# s6, _ #) -> (# s6, p #)
runNonIO :: (JSVal -> a -> IO ()) -> a -> IO JSVal
runNonIO res a = runIO res $ pure a
@@ -75,6 +81,12 @@ runNonIO res a = runIO res $ pure a
foreign import javascript unsafe "let res, rej; const p = new Promise((resolve, reject) => { res = resolve; rej = reject; }); p.resolve = res; p.reject = rej; return p;"
js_promiseWithResolvers :: IO JSVal
+foreign import javascript unsafe "$1.throwTo = (err) => __exports.rts_promiseThrowTo($2, err);"
+ js_promiseAddThrowTo :: JSVal -> StablePtr Any -> IO ()
+
+foreign import javascript unsafe "$1.throwTo = () => {};"
+ js_promiseDelThrowTo :: JSVal -> IO ()
+
foreign import prim "stg_scheduler_loopzh"
stg_scheduler_loop# :: State# RealWorld -> (# State# RealWorld, () #)
=====================================
libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
=====================================
@@ -5,6 +5,7 @@
{-# LANGUAGE UnliftedFFITypes #-}
module GHC.Internal.Wasm.Prim.Imports (
+ raiseJSException,
stg_blockPromise,
stg_messagePromiseUnit,
stg_messagePromiseJSVal,
@@ -67,23 +68,19 @@ function. At this point, the Promise fulfill logic that resumes the
thread in the future has been set up, we can drop the Promise eagerly,
then arrange the current thread to block.
-Blocking is done by calling stg_jsffi_block: it pushes a
-stg_jsffi_block frame and suspends the thread. The payload of
-stg_jsffi_block frame is a single pointer field that holds the return
-value. When the Promise is resolved with the result, the RTS fetches
-the TSO indexed by the stable pointer passed earlier, checks for the
-top stack frame to see if it's still a stg_jsffi_block frame (could be
-stripped by an async exception), fills in the boxed result and
-restarts execution. In case of a Promise rejection, the closure being
-filled is generated via raiseJSException.
+Blocking is done by readMVar. stg_blockPromise allocates an empty MVar
+and pins it under a stable pointer, then finally blocks by readMVar.
+The stable pointer is captured in the promise.then callback. When the
+Promise is settled in the future, the promise.then callback writes the
+result (or exception) to the MVar and then resumes Haskell execution.
-}
stg_blockPromise :: String -> JSVal -> (JSVal -> StablePtr Any -> IO ()) -> r
stg_blockPromise err_msg p msg_p = unsafeDupablePerformIO $ IO $ \s0 ->
case stg_jsffi_check (unsafeCoerce# $ toException $ WouldBlockException err_msg) s0 of
- (# s1 #) -> case myThreadId# s1 of
- (# s2, tso #) -> case makeStablePtr# tso s2 of
+ (# s1 #) -> case newMVar# s1 of
+ (# s2, mv# #) -> case makeStablePtr# mv# s2 of
(# s3, sp #) ->
case unIO (msg_p p $ StablePtr $ unsafeCoerce# sp) s3 of
-- Since we eagerly free the Promise here, we must return
@@ -98,21 +95,11 @@ stg_blockPromise err_msg p msg_p = unsafeDupablePerformIO $ IO $ \s0 ->
-- and prevents dmdanal from being naughty
(# s4, _ #) -> case unIO (freeJSVal p) s4 of
(# s5, _ #) ->
- -- raiseJSException_closure is used by the RTS in case
- -- the Promise is rejected, and it is likely a CAF. So
- -- we need to keep it alive when we block waiting for
- -- the Promise to resolve or reject, and also mark it
- -- as OPAQUE just to be sure.
- keepAlive# raiseJSException s5 $
- stg_jsffi_block $
- throw PromisePendingException
+ readMVar# mv# s5
foreign import prim "stg_jsffi_check"
stg_jsffi_check :: Any -> State# RealWorld -> (# State# RealWorld #)
-foreign import prim "stg_jsffi_block"
- stg_jsffi_block :: Any -> State# RealWorld -> (# State# RealWorld, r #)
-
foreign import javascript unsafe "$1.then(() => __exports.rts_promiseResolveUnit($2), err => __exports.rts_promiseReject($2, err))"
stg_messagePromiseUnit :: JSVal -> StablePtr Any -> IO ()
=====================================
libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
=====================================
@@ -15,8 +15,7 @@ module GHC.Internal.Wasm.Prim.Types (
fromJSString,
toJSString,
JSException (..),
- WouldBlockException (..),
- PromisePendingException (..)
+ WouldBlockException (..)
) where
import GHC.Internal.Base
@@ -255,9 +254,3 @@ newtype WouldBlockException
deriving (Show)
instance Exception WouldBlockException
-
-data PromisePendingException
- = PromisePendingException
- deriving (Show)
-
-instance Exception PromisePendingException
=====================================
rts/RtsAPI.c
=====================================
@@ -942,12 +942,21 @@ void rts_done (void)
it would be very difficult for the caller to arrange to free the StablePtr
in all circumstances.
+ There's also hs_try_putmvar_with_value(cap, mvar, value) which
+ allows putting a custom value other than () in the MVar, typically
+ a closure created by one of rts_mk*() functions.
+
For more details, see the section "Waking up Haskell threads from C" in the
User's Guide.
-------------------------------------------------------------------------- */
-void hs_try_putmvar (/* in */ int capability,
- /* in */ HsStablePtr mvar)
+void hs_try_putmvar (int capability, HsStablePtr sp) {
+ hs_try_putmvar_with_value(capability, sp, TAG_CLOSURE(1, Unit_closure));
+}
+
+void hs_try_putmvar_with_value (/* in */ int capability,
+ /* in */ HsStablePtr mvar,
+ /* in */ StgClosure *value)
{
Task *task = getMyTask();
Capability *cap;
@@ -963,7 +972,7 @@ void hs_try_putmvar (/* in */ int capability,
#if !defined(THREADED_RTS)
- performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), Unit_closure);
+ performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), value);
freeStablePtr(mvar);
#else
@@ -976,7 +985,7 @@ void hs_try_putmvar (/* in */ int capability,
task->cap = cap;
RELEASE_LOCK(&cap->lock);
- performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), Unit_closure);
+ performTryPutMVar(cap, (StgMVar*)deRefStablePtr(mvar), value);
freeStablePtr(mvar);
=====================================
rts/RtsSymbols.c
=====================================
@@ -597,6 +597,7 @@ extern char **environ;
SymI_HasProto(hs_hpc_module) \
SymI_HasProto(hs_thread_done) \
SymI_HasProto(hs_try_putmvar) \
+ SymI_HasProto(hs_try_putmvar_with_value) \
SymI_HasProto(defaultRtsConfig) \
SymI_HasProto(initLinker) \
SymI_HasProto(initLinker_) \
=====================================
rts/include/HsFFI.h
=====================================
@@ -21,6 +21,7 @@ extern "C" {
/* get types from GHC's runtime system */
#include "ghcconfig.h"
+#include "rts/Types.h"
#include "stg/Types.h"
/* get limits for floating point types */
@@ -138,6 +139,7 @@ extern int hs_spt_keys(StgPtr keys[], int szKeys);
extern int hs_spt_key_count (void);
extern void hs_try_putmvar (int capability, HsStablePtr sp);
+extern void hs_try_putmvar_with_value (int capability, HsStablePtr sp, StgClosure *value);
/* -------------------------------------------------------------------------- */
=====================================
rts/wasm/JSFFI.c
=====================================
@@ -1,12 +1,15 @@
#include "Rts.h"
#include "Prelude.h"
+#include "RaiseAsync.h"
#include "Schedule.h"
+#include "Threads.h"
#include "sm/Sanity.h"
#if defined(__wasm_reference_types__)
extern HsBool rts_JSFFI_flag;
extern HsStablePtr rts_threadDelay_impl;
+extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure;
extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure;
int __main_void(void);
@@ -20,6 +23,7 @@ int __main_argc_argv(int argc, char *argv[]) {
hs_init_ghc(&argc, &argv, __conf);
// See Note [threadDelay on wasm] for details.
rts_JSFFI_flag = HS_BOOL_TRUE;
+ getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure);
rts_threadDelay_impl = getStablePtr((StgPtr)&ghczminternal_GHCziInternalziWasmziPrimziConcziInternal_threadDelay_closure);
return 0;
}
@@ -144,9 +148,7 @@ INLINE_HEADER void pushClosure (StgTSO *tso, StgWord c) {
tso->stackobj->sp[0] = (W_) c;
}
-extern const StgInfoTable stg_jsffi_block_info;
extern const StgInfoTable stg_scheduler_loop_info;
-extern StgClosure ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure;
// schedule a future round of RTS scheduler loop via setImmediate(),
// to avoid jamming the JavaScript main thread
@@ -173,19 +175,7 @@ void rts_schedulerLoop(void) {
#define mk_rtsPromiseCallback(obj) \
{ \
Capability *cap = &MainCapability; \
- StgTSO *tso = (StgTSO*)deRefStablePtr(sp); \
- IF_DEBUG(sanity, checkTSO(tso)); \
- hs_free_stable_ptr(sp); \
- \
- StgStack *stack = tso->stackobj; \
- IF_DEBUG(sanity, checkSTACK(stack)); \
- \
- if (stack->sp[0] == (StgWord)&stg_jsffi_block_info) { \
- dirty_TSO(cap, tso); \
- dirty_STACK(cap, stack); \
- stack->sp[1] = (StgWord)(obj); \
- } \
- scheduleThreadNow(cap, tso); \
+ hs_try_putmvar_with_value(cap->no, sp, obj); \
rts_schedulerLoop(); \
}
@@ -224,6 +214,27 @@ void rts_promiseReject(HsStablePtr, HsJSVal);
void rts_promiseReject(HsStablePtr sp, HsJSVal js_err)
mk_rtsPromiseCallback(rts_apply(cap, &ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure, rts_mkJSVal(cap, js_err)))
+__attribute__((export_name("rts_promiseThrowTo")))
+void rts_promiseThrowTo(HsStablePtr, HsJSVal);
+void rts_promiseThrowTo(HsStablePtr sp, HsJSVal js_err) {
+ Capability *cap = &MainCapability;
+ StgWeak *w = (StgWeak *)deRefStablePtr(sp);
+ if (w->header.info == &stg_DEAD_WEAK_info) {
+ return;
+ }
+ ASSERT(w->header.info == &stg_WEAK_info);
+ StgTSO *tso = (StgTSO *)w->key;
+ ASSERT(tso->header.info == &stg_TSO_info);
+ throwToSelf(
+ cap, tso,
+ rts_apply(
+ cap,
+ &ghczminternal_GHCziInternalziWasmziPrimziImports_raiseJSException_closure,
+ rts_mkJSVal(cap, js_err)));
+ tryWakeupThread(cap, tso);
+ rts_schedulerLoop();
+}
+
__attribute__((export_name("rts_freeStablePtr")))
void rts_freeStablePtr(HsStablePtr);
void rts_freeStablePtr(HsStablePtr sp) {
=====================================
rts/wasm/blocker.cmm
=====================================
@@ -1,35 +1,5 @@
#include "Cmm.h"
-#if !defined(UnregisterisedCompiler)
-import CLOSURE STK_CHK_ctr;
-import CLOSURE stg_jsffi_block_info;
-#endif
-
-// The ret field will be the boxed result that the JSFFI async import
-// actually returns. Or a bottom closure that throws JSException in
-// case of Promise rejection.
-INFO_TABLE_RET ( stg_jsffi_block, RET_SMALL, W_ info_ptr, P_ ret )
- return ()
-{
- jump %ENTRY_CODE(Sp(0)) (ret);
-}
-
-// Push a stg_jsffi_block frame and suspend the current thread. bottom
-// is a placeholder that throws PromisePendingException, though in
-// theory the user should never see PromisePendingException since that
-// indicates a thread blocked for async JSFFI is mistakenly resumed
-// somehow.
-stg_jsffi_block (P_ bottom)
-{
- Sp_adj(-2);
- Sp(0) = stg_jsffi_block_info;
- Sp(1) = bottom;
-
- ASSERT(SpLim - WDS(RESERVED_STACK_WORDS) <= Sp);
-
- jump stg_block_noregs ();
-}
-
// Check that we're in a forked thread at the moment, since main
// threads that are bound to an InCall frame cannot block waiting for
// a Promise to fulfill. err is the SomeException closure of
=====================================
rts/wasm/scheduler.cmm
=====================================
@@ -61,13 +61,13 @@
// 3. The main thread "scheduler loop" does one simple thing: check if
// the thread run queue is non-empty and if so, yield to other
// threads for execution, otherwise exit the loop.
-// 4. When a thread blocks for a JSFFI async import result, it pins
-// the current TSO via a stable pointer, and calls Promise.then()
-// on the particular Promise it's blocked on. When that Promise is
-// fulfilled in the future, it will call back into the RTS, fetches
-// the TSO indexed by that stable pointer, passes the result and
-// wakes up the TSO, then finally does another round of scheduler
-// loop. This is handled by stg_blockPromise.
+// 4. When a thread blocks for a JSFFI async import result, it pins an
+// MVar to a stable pointer, calls Promise.then() on the particular
+// Promise it's blocked on, then finally blocks by readMVar. When
+// that Promise is fulfilled in the future, the Promise.then()
+// callback writes the result to MVar and wakes up the TSO, then
+// finally does another round of scheduler loop. This is handled by
+// stg_blockPromise.
//
// The async JSFFI scheduler is idempotent, it's safe to run it
// multiple times, now or later, though it's not safe to forget to run
=====================================
testsuite/tests/jsffi/all.T
=====================================
@@ -11,6 +11,8 @@ setTestOpts([
extra_ways(['compacting_gc', 'nonmoving', 'sanity'])
])
+test('cancel', [], compile_and_run, ['-optl-Wl,--export=setTimeout'])
+
test('gameover', [], compile_and_run, ['-optl-Wl,--export=testJSException,--export=testHSException'])
test('http', [], compile_and_run, ['-optl-Wl,--export=main'])
=====================================
testsuite/tests/jsffi/cancel.hs
=====================================
@@ -0,0 +1,12 @@
+module Test where
+
+import Control.Exception
+
+foreign import javascript safe "new Promise(res => setTimeout(res, $1))"
+ js_setTimeout :: Int -> IO ()
+
+setTimeout :: Int -> IO ()
+setTimeout t = evaluate =<< js_setTimeout t
+
+foreign export javascript "setTimeout"
+ setTimeout :: Int -> IO ()
=====================================
testsuite/tests/jsffi/cancel.mjs
=====================================
@@ -0,0 +1,13 @@
+export default async (__exports) => {
+ const test = new Promise((res) => {
+ const p = __exports.setTimeout(114514);
+ p.throwTo("1919810");
+ p.catch((err) => {
+ console.log(`${err}`.split("\n")[0]);
+ res();
+ });
+ });
+
+ await test;
+ process.exit();
+};
=====================================
testsuite/tests/jsffi/cancel.stdout
=====================================
@@ -0,0 +1 @@
+RuntimeError: JSException "1919810"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0e17bd4af6f2ecfe9ed721886b290780b93b6f8...d9e4701f0da3c5e301e3967748f1c00755bba04a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0e17bd4af6f2ecfe9ed721886b290780b93b6f8...d9e4701f0da3c5e301e3967748f1c00755bba04a
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250316/29fcb450/attachment-0001.html>
More information about the ghc-commits
mailing list