[Git][ghc/ghc][wip/wasm-jsffi-interruptible] WIP

[Cheng Shao (@TerrorJack)]

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


Commits:
a01000cc by Cheng Shao at 2025-03-15T07:42:16+00:00
WIP

- - - - -


2 changed files:

- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.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, () #)
 


=====================================
rts/wasm/JSFFI.c
=====================================
@@ -1,6 +1,8 @@
 #include "Rts.h"
 #include "Prelude.h"
+#include "RaiseAsync.h"
 #include "Schedule.h"
+#include "Threads.h"
 #include "sm/Sanity.h"
 
 #if defined(__wasm_reference_types__)
@@ -212,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) {



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a01000cc2d785627f3e98d561e28ba35de202ea6

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a01000cc2d785627f3e98d561e28ba35de202ea6
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/e6af0e37/attachment-0001.html>