Skip to content
Snippets Groups Projects
Commit 3a079187 authored by Cheng Shao's avatar Cheng Shao :beach:
Browse files

wasm: fix foreign import javascript "wrapper" in TH/ghci

This patch fixes foreign import javascript "wrapper" in wasm backend's
TH/ghci by fixing the handling of dyld/finalization_registry magic
variables. Fixes T25473 and closes #25473.

(cherry picked from commit bd0a8b7e)
(cherry picked from commit 610b0f77)
parent 17ec5735
No related branches found
No related tags found
No related merge requests found
...@@ -76,7 +76,7 @@ loadDLL f = ...@@ -76,7 +76,7 @@ loadDLL f =
evaluate =<< js_loadDLL (toJSString f) evaluate =<< js_loadDLL (toJSString f)
pure $ Right nullPtr pure $ Right nullPtr
foreign import javascript safe "__exports.__dyld.loadDLL($1)" foreign import javascript safe "__ghc_wasm_jsffi_dyld.loadDLL($1)"
js_loadDLL :: JSString -> IO () js_loadDLL :: JSString -> IO ()
loadArchive :: String -> IO () loadArchive :: String -> IO ()
...@@ -96,7 +96,7 @@ lookupSymbol sym = do ...@@ -96,7 +96,7 @@ lookupSymbol sym = do
r <- js_lookupSymbol $ toJSString sym r <- js_lookupSymbol $ toJSString sym
evaluate $ if r == nullPtr then Nothing else Just r evaluate $ if r == nullPtr then Nothing else Just r
foreign import javascript unsafe "__exports.__dyld.lookupSymbol($1)" foreign import javascript unsafe "__ghc_wasm_jsffi_dyld.lookupSymbol($1)"
js_lookupSymbol :: JSString -> IO (Ptr a) js_lookupSymbol :: JSString -> IO (Ptr a)
lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a)) lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a))
...@@ -114,7 +114,7 @@ addLibrarySearchPath p = do ...@@ -114,7 +114,7 @@ addLibrarySearchPath p = do
evaluate =<< js_addLibrarySearchPath (toJSString p) evaluate =<< js_addLibrarySearchPath (toJSString p)
pure nullPtr pure nullPtr
foreign import javascript safe "__exports.__dyld.addLibrarySearchPath($1)" foreign import javascript safe "__ghc_wasm_jsffi_dyld.addLibrarySearchPath($1)"
js_addLibrarySearchPath :: JSString -> IO () js_addLibrarySearchPath :: JSString -> IO ()
removeLibrarySearchPath :: Ptr () -> IO Bool removeLibrarySearchPath :: Ptr () -> IO Bool
...@@ -128,7 +128,7 @@ findSystemLibrary f = m `catch` \(_ :: JSException) -> pure Nothing ...@@ -128,7 +128,7 @@ findSystemLibrary f = m `catch` \(_ :: JSException) -> pure Nothing
p <- evaluate $ fromJSString p' p <- evaluate $ fromJSString p'
pure $ Just p pure $ Just p
foreign import javascript safe "__exports.__dyld.findSystemLibrary($1)" foreign import javascript safe "__ghc_wasm_jsffi_dyld.findSystemLibrary($1)"
js_findSystemLibrary :: JSString -> IO JSString js_findSystemLibrary :: JSString -> IO JSString
#else #else
......
...@@ -2,4 +2,4 @@ setTestOpts([ ...@@ -2,4 +2,4 @@ setTestOpts([
unless(arch('wasm32'), skip) unless(arch('wasm32'), skip)
]) ])
test('T25473', [expect_broken(25473)], multimod_compile, ['T25473B', '-v0']) test('T25473', [], multimod_compile, ['T25473B', '-v0'])
...@@ -291,9 +291,13 @@ class DyLD { ...@@ -291,9 +291,13 @@ class DyLD {
#loadedSos = new Set(); #loadedSos = new Set();
// Mapping from export names to export funcs. It's also passed as // Mapping from export names to export funcs. It's also passed as
// __exports in JSFFI code, hence the "memory" special field. __dyld // __exports in JSFFI code, hence the "memory" special field.
// is used by ghci to call into here. exportFuncs = { memory: this.#memory };
exportFuncs = { memory: this.#memory, __dyld: this };
// The FinalizationRegistry used by JSFFI.
#finalizationRegistry = new FinalizationRegistry((sp) =>
this.exportFuncs.rts_freeStablePtr(sp)
);
// The GOT.func table. // The GOT.func table.
#gotFunc = {}; #gotFunc = {};
...@@ -621,17 +625,22 @@ class DyLD { ...@@ -621,17 +625,22 @@ class DyLD {
const mod = await modp; const mod = await modp;
// Fulfill the ghc_wasm_jsffi imports // Fulfill the ghc_wasm_jsffi imports. Use new Function()
// instead of eval() to prevent bindings in this local scope to
// be accessed by JSFFI code snippets.
Object.assign( Object.assign(
import_obj.ghc_wasm_jsffi, import_obj.ghc_wasm_jsffi,
new Function( new Function(
"return (__exports) => ({".concat( "__exports",
"__ghc_wasm_jsffi_dyld",
"__ghc_wasm_jsffi_finalization_registry",
"return {".concat(
...parseSections(mod).map( ...parseSections(mod).map(
(rec) => `${rec[0]}: ${parseRecord(rec)}, ` (rec) => `${rec[0]}: ${parseRecord(rec)}, `
), ),
"});" "};"
) )
)()(this.exportFuncs) )(this.exportFuncs, this, this.#finalizationRegistry)
); );
// Fulfill the rest of the imports // Fulfill the rest of the imports
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment