[Git][ghc/ghc][wip/wasm-jsffi-interruptible] woohoo mvar

[Cheng Shao (@TerrorJack)]

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


Commits:
b2239cb7 by Cheng Shao at 2025-03-15T01:01:44+00:00
woohoo mvar

- - - - -


3 changed files:

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


Changes:

=====================================
libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
=====================================
@@ -82,8 +82,8 @@ filled is generated via raiseJSException.
 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
@@ -104,15 +104,11 @@ stg_blockPromise err_msg p msg_p = unsafeDupablePerformIO $ IO $ \s0 ->
                 -- 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#
 
 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 ()
 


=====================================
rts/wasm/JSFFI.c
=====================================
@@ -144,7 +144,6 @@ 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;
 
@@ -173,19 +172,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();                                     \
   }
 


=====================================
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



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

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