GitLab

677325ce
by Cheng Shao at 2025-10-14T20:40:17+02:00
```
WIP: more wasm fixes
```

@@ -664,7 +664,7 @@ dsWasmJSExport' sync m_fn_id co ext_name = do
          -- again here.
          Sync -> [finally_id, flushStdHandles_id]
          Async -> [top_handler_id, promiseRes_id]
 -      extern_closure_decls = vcat $ map mk_extern_closure_decl gc_root_closures
 +      extern_closure_decls = vcat $ map mk_extern_closure_decl $ top_handler_id : gc_root_closures
        cstub_attr =
          text "__attribute__"
            <> parens

@@ -109,6 +109,9 @@ __attribute__((constructor(102))) static void __ghc_wasm_jsffi_init(void) {
    RtsConfig __conf = defaultRtsConfig;
    __conf.rts_opts_enabled = RtsOptsAll;
    __conf.rts_hs_main = false;
 +#if defined(__PIC__)
 +  __conf.keep_cafs = 1;
 +#endif
    hs_init_ghc((int *)&argc, &argv, __conf);
    // See Note [threadDelay on wasm] for details.
    rts_JSFFI_flag = HS_BOOL_TRUE;

@@ -113,8 +113,8 @@
  // JavaScript main thread.
  #define BUSY_YIELD_NS 15000000
 -import CLOSURE ghczminternal_GHCziInternalziTuple_Z0T_closure;
  #if !defined(UnregisterisedCompiler)
 +import CLOSURE ghc_hs_iface;
  import CLOSURE stg_scheduler_loop_epoch;
  import CLOSURE stg_scheduler_loop_tid;
  #endif
@@ -139,7 +139,7 @@ stg_scheduler_loopzh ()
    // Only meant to be run from a "main thread" (aka bound to an InCall
    // frame), not from a forked thread!
    if (StgTSO_bound(CurrentTSO) == NULL) {
 -    return (ghczminternal_GHCziInternalziTuple_Z0T_closure);
 +    return (HsIface_Z0T_closure(W_[ghc_hs_iface]));
+   }
    // Entering the scheduler loop for the first time.
@@ -154,7 +154,7 @@ stg_scheduler_loopzh ()
    // Someone else is running the loop, not my business anymore.
    if (I64[stg_scheduler_loop_tid] != StgTSO_id(CurrentTSO)) {
 -    return (ghczminternal_GHCziInternalziTuple_Z0T_closure);
 +    return (HsIface_Z0T_closure(W_[ghc_hs_iface]));
+   }
  work:
@@ -180,7 +180,7 @@ work:
  cleanup:
    I64[stg_scheduler_loop_tid] = 0 :: I64;
 -  return (ghczminternal_GHCziInternalziTuple_Z0T_closure);
 +  return (HsIface_Z0T_closure(W_[ghc_hs_iface]));
+ }
  // After creating a new thread with only a stop frame on the stack,

@@ -1100,22 +1100,11 @@ class DyLD {
          continue;
+       }
        if (/libHSghc-internal-\d+(\.\d+)*/i.test(soname)) {
 +        init();
          this.rts_init();
          delete this.rts_init;
 -        // At this point the RTS symbols in linear memory are fixed
 -        // and constructors are run, especially the one in JSFFI.c
 -        // that does GHC RTS initialization for any code that links
 -        // JSFFI.o. Luckily no Haskell computation or gc has taken
 -        // place yet, so we must set keepCAFs=1 right now! Otherwise,
 -        // any BCO created by later TH splice or ghci expression may
 -        // refer to any CAF that's not reachable from GC roots (here
 -        // our only entry point is defaultServer) and the CAF could
 -        // have been GC'ed! (#26106)
 -        //
 -        // We call it here instead of in RTS C code, since we only
 -        // want keepCAFs=1 for ghci, not user code.
 -        this.exportFuncs.setKeepCAFs();
 +        continue;
+       }
        init();
+     }