{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}

module GHC.Runtime.Interpreter.Init
  ( initInterpreter
  , InterpOpts (..)
  )
where


import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
import GHC.Settings
import GHC.Unit.Finder
import GHC.Unit.Env
import GHC.Utils.TmpFs
import GHC.SysTools.Tasks

import GHC.Linker.Executable
import qualified GHC.Linker.Loader as Loader
import GHC.Runtime.Interpreter
import GHC.Runtime.Interpreter.C
import GHC.StgToJS.Types (StgToJSConfig)

import GHC.Utils.Monad
import GHC.Utils.Outputable
import GHC.Utils.Logger
import GHC.Utils.Error
import Control.Concurrent
import System.Process

data InterpOpts = InterpOpts
  { InterpOpts -> Bool
interpExternal :: !Bool
  , InterpOpts -> String
interpProg :: String
  , InterpOpts -> [String]
interpOpts :: [String]
  , InterpOpts -> Ways
interpWays :: Ways
  , InterpOpts -> GhcNameVersion
interpNameVer :: GhcNameVersion
  , InterpOpts -> LdConfig
interpLdConfig :: LdConfig
  , InterpOpts -> CcConfig
interpCcConfig :: CcConfig
  , InterpOpts -> String
interpJsInterp :: FilePath
  , InterpOpts -> TempDir
interpTmpDir :: TempDir
  , InterpOpts -> FinderOpts
interpFinderOpts :: FinderOpts
  , InterpOpts -> StgToJSConfig
interpJsCodegenCfg :: StgToJSConfig
  , InterpOpts -> Int
interpVerbosity :: Int
  , InterpOpts -> Maybe (CreateProcess -> IO ProcessHandle)
interpCreateProcess :: Maybe (CreateProcess -> IO ProcessHandle) -- create iserv process hook
  , InterpOpts -> String
interpWasmDyld :: FilePath
  , InterpOpts -> Bool
interpBrowser :: Bool
  , InterpOpts -> String
interpBrowserHost :: String
  , InterpOpts -> Int
interpBrowserPort :: Int
  , InterpOpts -> Bool
interpBrowserRedirectWasiConsole :: Bool
  , InterpOpts -> Maybe String
interpBrowserPuppeteerLaunchOpts :: Maybe String
  , InterpOpts -> Maybe String
interpBrowserPlaywrightBrowserType :: Maybe String
  , InterpOpts -> Maybe String
interpBrowserPlaywrightLaunchOpts :: Maybe String
  , InterpOpts -> ExecutableLinkOpts
interpExecutableLinkOpts :: ExecutableLinkOpts
  }

-- | Initialize code interpreter
initInterpreter
  :: TmpFs
  -> Logger
  -> Platform
  -> FinderCache
  -> UnitEnv
  -> InterpOpts
  -> IO (Maybe Interp)
initInterpreter :: TmpFs
-> Logger
-> Platform
-> FinderCache
-> UnitEnv
-> InterpOpts
-> IO (Maybe Interp)
initInterpreter TmpFs
tmpfs Logger
logger Platform
platform FinderCache
finder_cache UnitEnv
unit_env InterpOpts
opts = do

  lookup_cache  <- IO InterpSymbolCache -> IO InterpSymbolCache
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InterpSymbolCache -> IO InterpSymbolCache)
-> IO InterpSymbolCache -> IO InterpSymbolCache
forall a b. (a -> b) -> a -> b
$ IO InterpSymbolCache
mkInterpSymbolCache

  -- see Note [Target code interpreter]
  if
#if !defined(wasm32_HOST_ARCH)
    -- Wasm dynamic linker
    | ArchWasm32 <- platformArch platform
    -> do
        s <- liftIO $ newMVar InterpPending
        loader <- liftIO Loader.uninitializedLoader
        libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger (interpLdConfig opts) "libraries"
        let profiled = InterpOpts -> Ways
interpWays InterpOpts
opts Ways -> Way -> Bool
`hasWay` Way
WayProf
            way_tag = if Bool
profiled then String
"_p" else String
""
        let cfg =
              WasmInterpConfig
                { wasmInterpDyLD :: String
wasmInterpDyLD = InterpOpts -> String
interpWasmDyld InterpOpts
opts
                , wasmInterpLibDir :: String
wasmInterpLibDir = String
libdir
                , wasmInterpOpts :: [String]
wasmInterpOpts = InterpOpts -> [String]
interpOpts InterpOpts
opts
                , wasmInterpBrowser :: Bool
wasmInterpBrowser = InterpOpts -> Bool
interpBrowser InterpOpts
opts
                , wasmInterpBrowserHost :: String
wasmInterpBrowserHost = InterpOpts -> String
interpBrowserHost InterpOpts
opts
                , wasmInterpBrowserPort :: Int
wasmInterpBrowserPort = InterpOpts -> Int
interpBrowserPort InterpOpts
opts
                , wasmInterpBrowserRedirectWasiConsole :: Bool
wasmInterpBrowserRedirectWasiConsole = InterpOpts -> Bool
interpBrowserRedirectWasiConsole InterpOpts
opts
                , wasmInterpBrowserPuppeteerLaunchOpts :: Maybe String
wasmInterpBrowserPuppeteerLaunchOpts = InterpOpts -> Maybe String
interpBrowserPuppeteerLaunchOpts InterpOpts
opts
                , wasmInterpBrowserPlaywrightBrowserType :: Maybe String
wasmInterpBrowserPlaywrightBrowserType = InterpOpts -> Maybe String
interpBrowserPlaywrightBrowserType InterpOpts
opts
                , wasmInterpBrowserPlaywrightLaunchOpts :: Maybe String
wasmInterpBrowserPlaywrightLaunchOpts = InterpOpts -> Maybe String
interpBrowserPlaywrightLaunchOpts InterpOpts
opts
                , wasmInterpTargetPlatform :: Platform
wasmInterpTargetPlatform = Platform
platform
                , wasmInterpProfiled :: Bool
wasmInterpProfiled = Bool
profiled
                , wasmInterpHsSoSuffix :: String
wasmInterpHsSoSuffix = String
way_tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ GhcNameVersion -> String
dynLibSuffix (InterpOpts -> GhcNameVersion
interpNameVer InterpOpts
opts)
                , wasmInterpUnitState :: UnitState
wasmInterpUnitState = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_homeUnitState UnitEnv
unit_env
                }
        pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache
#endif

    -- JavaScript interpreter
    | ArchJavaScript <- platformArch platform
    -> do
         s <- liftIO $ newMVar InterpPending
         loader <- liftIO Loader.uninitializedLoader
         let cfg = JSInterpConfig
              { jsInterpNodeConfig :: NodeJsSettings
jsInterpNodeConfig  = NodeJsSettings
defaultNodeJsSettings
              , jsInterpScript :: String
jsInterpScript      = InterpOpts -> String
interpJsInterp InterpOpts
opts
              , jsInterpTmpFs :: TmpFs
jsInterpTmpFs       = TmpFs
tmpfs
              , jsInterpTmpDir :: TempDir
jsInterpTmpDir      = InterpOpts -> TempDir
interpTmpDir InterpOpts
opts
              , jsInterpLogger :: Logger
jsInterpLogger      = Logger
logger
              , jsInterpCodegenCfg :: StgToJSConfig
jsInterpCodegenCfg  = InterpOpts -> StgToJSConfig
interpJsCodegenCfg InterpOpts
opts
              , jsInterpUnitEnv :: UnitEnv
jsInterpUnitEnv     = UnitEnv
unit_env
              , jsInterpFinderOpts :: FinderOpts
jsInterpFinderOpts  = InterpOpts -> FinderOpts
interpFinderOpts InterpOpts
opts
              , jsInterpFinderCache :: FinderCache
jsInterpFinderCache = FinderCache
finder_cache
              }
         return (Just (Interp (ExternalInterp (ExtJS (ExtInterpState cfg s))) loader lookup_cache))

    -- external interpreter
    | interpExternal opts
    -> do
        let
          profiled = InterpOpts -> Ways
interpWays InterpOpts
opts Ways -> Way -> Bool
`hasWay` Way
WayProf
          dynamic  = InterpOpts -> Ways
interpWays InterpOpts
opts Ways -> Way -> Bool
`hasWay` Way
WayDyn
        prog <- case interpProg opts of
          -- build iserv program if none specified
          String
"" -> Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO String
generateIservC Logger
logger TmpFs
tmpfs (InterpOpts -> ExecutableLinkOpts
interpExecutableLinkOpts InterpOpts
opts) UnitEnv
unit_env
          String
_ -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InterpOpts -> String
interpProg InterpOpts
opts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flavour)
            where
              flavour :: String
flavour
                | Bool
profiled Bool -> Bool -> Bool
&& Bool
dynamic = String
"-prof-dyn"
                | Bool
profiled  = String
"-prof"
                | Bool
dynamic   = String
"-dyn"
                | Bool
otherwise = String
""
        let msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Starting " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
prog
        tr <- if interpVerbosity opts >= 3
               then return (logInfo logger $ withPprStyle defaultDumpStyle msg)
               else return (pure ())
        let
         conf = IServConfig
           { iservConfProgram :: String
iservConfProgram  = String
prog
           , iservConfOpts :: [String]
iservConfOpts     = InterpOpts -> [String]
interpOpts InterpOpts
opts
           , iservConfProfiled :: Bool
iservConfProfiled = Bool
profiled
           , iservConfDynamic :: Bool
iservConfDynamic  = Bool
dynamic
           , iservConfHook :: Maybe (CreateProcess -> IO ProcessHandle)
iservConfHook     = InterpOpts -> Maybe (CreateProcess -> IO ProcessHandle)
interpCreateProcess InterpOpts
opts
           , iservConfTrace :: IO ()
iservConfTrace    = IO ()
tr
           }
        s <- liftIO $ newMVar InterpPending
        loader <- liftIO Loader.uninitializedLoader
        return (Just (Interp (ExternalInterp (ExtIServ (ExtInterpState conf s))) loader lookup_cache))

    -- Internal interpreter
    | otherwise
    ->
#if defined(HAVE_INTERNAL_INTERPRETER)
     do
      loader <- liftIO Loader.uninitializedLoader
      return (Just (Interp InternalInterp loader lookup_cache))
#else
      return Nothing
#endif