From e2705d2a118030a03a4e333c7681ac3cf571a858 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Tue, 1 Oct 2024 19:24:49 +0000
Subject: [PATCH] driver: add wasm backend iserv logic
This commit adds wasm backend iserv logic to the driver, see added
comments for explanation.
(cherry picked from commit 2d6107dc0e461f6d339ea14712b6f0cb9a619680)
---
CODEOWNERS | 1 +
compiler/GHC.hs | 30 +++++++++
compiler/GHC/Runtime/Interpreter.hs | 15 +++++
compiler/GHC/Runtime/Interpreter/Types.hs | 19 ++++++
compiler/GHC/Runtime/Interpreter/Wasm.hs | 82 +++++++++++++++++++++++
compiler/ghc.cabal.in | 1 +
6 files changed, 148 insertions(+)
create mode 100644 compiler/GHC/Runtime/Interpreter/Wasm.hs
diff --git a/CODEOWNERS b/CODEOWNERS
index 872965b92b1..bcb37703f93 100644
--- a/CODEOWNERS
+++ b/CODEOWNERS
@@ -55,6 +55,7 @@
/compiler/GHC/Wasm/ @nrnrnr
/compiler/GHC/JS/ @luite @doyougnu @hsyl20 @JoshMeredith
/compiler/GHC/StgToJS/ @luite @doyougnu @hsyl20 @JoshMeredith
+/compiler/GHC/Runtime/Interpreter/Wasm.hs @TerrorJack
[Core libraries]
/libraries/base/ @hvr
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 83388c6718f..129f8ecb078 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -407,6 +407,7 @@ import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Graph
import GHC.Unit.Home.ModInfo
+import GHC.Settings
import Control.Applicative ((<|>))
import Control.Concurrent
@@ -679,6 +680,35 @@ setTopSessionDynFlags dflags = do
-- Interpreter
interp <- if
+ -- Wasm dynamic linker
+ | ArchWasm32 <- platformArch $ targetPlatform dflags
+ -> do
+ s <- liftIO $ newMVar InterpPending
+ loader <- liftIO Loader.uninitializedLoader
+ dyld <- liftIO $ makeAbsolute $ topDir dflags </> "dyld.mjs"
+#if defined(wasm32_HOST_ARCH)
+ let libdir = sorry "cannot spawn child process on wasm"
+#else
+ libdir <- liftIO $ do
+ libdirs <- Loader.getGccSearchDirectory logger dflags "libraries"
+ case libdirs of
+ [_, libdir] -> pure libdir
+ _ -> panic "corrupted wasi-sdk installation"
+#endif
+ let profiled = ways dflags `hasWay` WayProf
+ way_tag = if profiled then "_p" else ""
+ let cfg =
+ WasmInterpConfig
+ { wasmInterpDyLD = dyld,
+ wasmInterpLibDir = libdir,
+ wasmInterpOpts = getOpts dflags opt_i,
+ wasmInterpTargetPlatform = targetPlatform dflags,
+ wasmInterpProfiled = profiled,
+ wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags),
+ wasmInterpUnitState = ue_units $ hsc_unit_env hsc_env
+ }
+ pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
+
-- JavaScript interpreter
| ArchJavaScript <- platformArch (targetPlatform dflags)
-> do
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 7004a050cd0..13ab231e775 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -67,6 +67,7 @@ import GHC.Prelude
import GHC.Runtime.Interpreter.Types
import GHC.Runtime.Interpreter.JS
+import GHC.Runtime.Interpreter.Wasm
import GHC.Runtime.Interpreter.Process
import GHC.Runtime.Utils
import GHCi.Message
@@ -196,11 +197,13 @@ interpCmd interp msg = case interpInstance interp of
withExtInterp :: ExceptionMonad m => ExtInterp -> (forall d. ExtInterpInstance d -> m a) -> m a
withExtInterp ext action = case ext of
ExtJS i -> withJSInterp i action
+ ExtWasm i -> withWasmInterp i action
ExtIServ i -> withIServ i action
withExtInterpStatus :: ExtInterp -> (forall d. ExtInterpStatusVar d -> m a) -> m a
withExtInterpStatus ext action = case ext of
ExtJS i -> action (interpStatus i)
+ ExtWasm i -> action $ interpStatus i
ExtIServ i -> action (interpStatus i)
-- Note [uninterruptibleMask_ and interpCmd]
@@ -229,6 +232,11 @@ withJSInterp (ExtInterpState cfg mstate) action = do
inst <- spawnInterpMaybe cfg spawnJSInterp mstate
action inst
+withWasmInterp :: ExceptionMonad m => WasmInterp -> (ExtInterpInstance () -> m a) -> m a
+withWasmInterp (ExtInterpState cfg mstate) action = do
+ inst <- spawnInterpMaybe cfg spawnWasmInterp mstate
+ action inst
+
-- | Spawn an interpreter if not already running according to the status in the
-- MVar. Update the status, free pending heap references, and return the
-- interpreter instance.
@@ -452,6 +460,9 @@ lookupSymbol interp str = withSymbolCache interp str $
uninterruptibleMask_ $
sendMessage inst (LookupSymbol (unpackFS str))
ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str)
+ ExtWasm i -> withWasmInterp i $ \inst -> fmap fromRemotePtr <$> do
+ uninterruptibleMask_ $
+ sendMessage inst (LookupSymbol (unpackFS str))
lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ()))
lookupSymbolInDLL interp dll str = withSymbolCache interp str $
@@ -464,6 +475,8 @@ lookupSymbolInDLL interp dll str = withSymbolCache interp str $
uninterruptibleMask_ $
sendMessage inst (LookupSymbolInDLL dll (unpackFS str))
ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str)
+ -- wasm dyld doesn't track which symbol comes from which .so
+ ExtWasm {} -> lookupSymbol interp str
lookupClosure :: Interp -> String -> IO (Maybe HValueRef)
lookupClosure interp str =
@@ -704,6 +717,7 @@ interpreterProfiled interp = case interpInstance interp of
ExternalInterp ext -> case ext of
ExtIServ i -> iservConfProfiled (interpConfig i)
ExtJS {} -> False -- we don't support profiling yet in the JS backend
+ ExtWasm i -> wasmInterpProfiled $ interpConfig i
-- | Interpreter uses Dynamic way
interpreterDynamic :: Interp -> Bool
@@ -714,3 +728,4 @@ interpreterDynamic interp = case interpInstance interp of
ExternalInterp ext -> case ext of
ExtIServ i -> iservConfDynamic (interpConfig i)
ExtJS {} -> False -- dynamic doesn't make sense for JS
+ ExtWasm {} -> True -- wasm dyld can only load dynamic code
diff --git a/compiler/GHC/Runtime/Interpreter/Types.hs b/compiler/GHC/Runtime/Interpreter/Types.hs
index 53575f164d4..8c92d5ea16e 100644
--- a/compiler/GHC/Runtime/Interpreter/Types.hs
+++ b/compiler/GHC/Runtime/Interpreter/Types.hs
@@ -20,6 +20,8 @@ module GHC.Runtime.Interpreter.Types
, JSState (..)
, NodeJsSettings (..)
, defaultNodeJsSettings
+ , WasmInterp
+ , WasmInterpConfig (..)
)
where
@@ -32,9 +34,11 @@ import GHC.Types.Unique.FM
import GHC.Data.FastString ( FastString )
import Foreign
+import GHC.Platform
import GHC.Utils.TmpFs
import GHC.Utils.Logger
import GHC.Unit.Env
+import GHC.Unit.State
import GHC.Unit.Types
import GHC.StgToJS.Types
import GHC.StgToJS.Linker.Types
@@ -65,6 +69,7 @@ data InterpInstance
data ExtInterp
= ExtIServ !IServ
| ExtJS !JSInterp
+ | ExtWasm !WasmInterp
-- | External interpreter
--
@@ -80,6 +85,7 @@ type ExtInterpStatusVar d = MVar (InterpStatus (ExtInterpInstance d))
type IServ = ExtInterpState IServConfig ()
type JSInterp = ExtInterpState JSInterpConfig JSInterpExtra
+type WasmInterp = ExtInterpState WasmInterpConfig ()
data InterpProcess = InterpProcess
{ interpPipe :: !Pipe -- ^ Pipe to communicate with the server
@@ -161,3 +167,16 @@ data JSInterpConfig = JSInterpConfig
, jsInterpFinderCache :: !FinderCache
}
+------------------------
+-- Wasm Stuff
+------------------------
+
+data WasmInterpConfig = WasmInterpConfig
+ { wasmInterpDyLD :: !FilePath -- ^ Location of dyld.mjs script
+ , wasmInterpLibDir :: FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc
+ , wasmInterpOpts :: ![String] -- ^ Additional command line arguments for iserv
+ , wasmInterpTargetPlatform :: !Platform
+ , wasmInterpProfiled :: !Bool -- ^ Are we profiling yet?
+ , wasmInterpHsSoSuffix :: !String -- ^ Shared lib filename common suffix sans .so, e.g. p-ghc9.13.20241001
+ , wasmInterpUnitState :: !UnitState
+ }
diff --git a/compiler/GHC/Runtime/Interpreter/Wasm.hs b/compiler/GHC/Runtime/Interpreter/Wasm.hs
new file mode 100644
index 00000000000..12624da4fdf
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter/Wasm.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module GHC.Runtime.Interpreter.Wasm (spawnWasmInterp) where
+
+import GHC.Prelude
+import GHC.Runtime.Interpreter.Types
+
+#if !defined(mingw32_HOST_OS)
+
+import Control.Concurrent.MVar
+import Data.IORef
+import GHC.Data.FastString
+import qualified GHC.Data.ShortText as ST
+import GHC.Platform
+import GHC.Unit
+import GHCi.Message
+import System.Directory
+import System.IO
+import qualified System.Posix.IO as Posix
+import System.Process
+
+#else
+
+import GHC.Utils.Panic
+
+#endif
+
+spawnWasmInterp :: WasmInterpConfig -> IO (ExtInterpInstance ())
+
+#if !defined(mingw32_HOST_OS)
+
+-- See Note [The Wasm Dynamic Linker] for details
+spawnWasmInterp WasmInterpConfig {..} = do
+ let Just ghci_unit_id =
+ lookupPackageName
+ wasmInterpUnitState
+ (PackageName $ fsLit "ghci")
+ ghci_unit_info = unsafeLookupUnitId wasmInterpUnitState ghci_unit_id
+ ghci_so_dirs = map ST.unpack $ unitLibraryDynDirs ghci_unit_info
+ [ghci_lib_name] = map ST.unpack $ unitLibraries ghci_unit_info
+ ghci_so_name = ghci_lib_name ++ wasmInterpHsSoSuffix
+ ghci_so_file = platformHsSOName wasmInterpTargetPlatform ghci_so_name
+ Just ghci_so_path <- findFile ghci_so_dirs ghci_so_file
+ (rfd1, wfd1) <- Posix.createPipe
+ (rfd2, wfd2) <- Posix.createPipe
+ Posix.setFdOption rfd1 Posix.CloseOnExec True
+ Posix.setFdOption wfd2 Posix.CloseOnExec True
+ (_, _, _, ph) <-
+ createProcess
+ ( proc wasmInterpDyLD $
+ [wasmInterpLibDir, ghci_so_path, show wfd1, show rfd2]
+ ++ wasmInterpOpts
+ ++ ["+RTS", "-H64m", "-RTS"]
+ )
+ Posix.closeFd wfd1
+ Posix.closeFd rfd2
+ rh <- Posix.fdToHandle rfd1
+ wh <- Posix.fdToHandle wfd2
+ hSetBuffering wh NoBuffering
+ hSetBuffering rh NoBuffering
+ lo_ref <- newIORef Nothing
+ pending_frees <- newMVar []
+ pure
+ $ ExtInterpInstance
+ { instProcess =
+ InterpProcess
+ { interpHandle = ph,
+ interpPipe = Pipe {pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref}
+ },
+ instPendingFrees = pending_frees,
+ instExtra = ()
+ }
+
+#else
+
+-- Due to difficulty of using inherited pipe file descriptor in
+-- nodejs, unfortunately we don't support Win32 host yet
+spawnWasmInterp _ = sorry "Wasm iserv doesn't work on Win32 host yet"
+
+#endif
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 5d2dbb8084f..c9bc20e4957 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -676,6 +676,7 @@ Library
GHC.Runtime.Interpreter.JS
GHC.Runtime.Interpreter.Process
GHC.Runtime.Interpreter.Types
+ GHC.Runtime.Interpreter.Wasm
GHC.Runtime.Loader
GHC.Runtime.Utils
GHC.Settings
--
GitLab