From feecaeed595038dd0a71bd4004d9a7c9441a1fdd Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Sat, 15 Mar 2025 06:21:59 +0000
Subject: [PATCH] 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.

(cherry picked from commit da34f0aa2082d1c5a306cc8356abba15f3d59aad)
---
 .../ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs   | 9 ++-------
 rts/wasm/JSFFI.c                                         | 3 ++-
 2 files changed, 4 insertions(+), 8 deletions(-)

diff --git a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs b/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
index b5b8a66688e..fb763d984e2 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
+++ b/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,
@@ -94,13 +95,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 #)
diff --git a/rts/wasm/JSFFI.c b/rts/wasm/JSFFI.c
index cbc90ce554b..0c298b064a1 100644
--- a/rts/wasm/JSFFI.c
+++ b/rts/wasm/JSFFI.c
@@ -7,6 +7,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 +21,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 +147,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
-- 
GitLab