[Git][ghc/ghc][wip/wasm-jsffi-interruptible] 2 commits: WIP pin raiseJSException

[Cheng Shao (@TerrorJack)]

Cheng Shao pushed to branch wip/wasm-jsffi-interruptible at Glasgow Haskell Compiler / GHC


Commits:
e7f3c404 by Cheng Shao at 2025-03-15T06:21:59+00:00
WIP pin raiseJSException

- - - - -
7d7fbff1 by Cheng Shao at 2025-03-15T06:29:17+00:00
WIP

- - - - -


3 changed files:

- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- rts/wasm/JSFFI.c


Changes:

=====================================
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,
@@ -98,13 +99,7 @@ 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 $
-                  readMVar# mv#
+                readMVar# mv# s5
 
 foreign import prim "stg_jsffi_check"
   stg_jsffi_check :: Any -> State# RealWorld -> (# State# RealWorld #)


=====================================
rts/wasm/JSFFI.c
=====================================
@@ -1,5 +1,6 @@
 #include "Rts.h"
 #include "Prelude.h"
+#include "RaiseAsync.h"
 #include "Schedule.h"
 #include "sm/Sanity.h"
 
@@ -7,6 +8,7 @@
 
 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 +22,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;
 }
@@ -145,7 +148,6 @@ INLINE_HEADER void pushClosure   (StgTSO *tso, StgWord c) {
 }
 
 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
@@ -211,6 +213,25 @@ 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)));
+}
+
 __attribute__((export_name("rts_freeStablePtr")))
 void rts_freeStablePtr(HsStablePtr);
 void rts_freeStablePtr(HsStablePtr sp) {



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b9e7a2738bc89c1781e26d369f1ea6b06b32711...7d7fbff193288da5621bc8a2933ee7b35cfaf818

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b9e7a2738bc89c1781e26d369f1ea6b06b32711...7d7fbff193288da5621bc8a2933ee7b35cfaf818
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/20250315/fd88a4bb/attachment-0001.html>