{-# LANGUAGE MultiWayIf #-}

-- | External interpreter program
module GHC.Runtime.Interpreter.C
  ( generateIservC
  )
where

import GHC.Prelude
import GHC.Platform
import GHC.Data.FastString
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Unit.Types
import GHC.Unit.Env
import GHC.Unit.Info
import GHC.Unit.State
import GHC.Utils.Panic.Plain
import GHC.Linker.Executable
import GHC.Linker.Config
import GHC.Utils.CliOption

-- | Generate iserv program for the target
generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
generateIservC :: Logger -> TmpFs -> ExecutableLinkOpts -> UnitEnv -> IO FilePath
generateIservC Logger
logger TmpFs
tmpfs ExecutableLinkOpts
opts UnitEnv
unit_env = do
  -- get the unit-id of the ghci package. We need this to load the
  -- interpreter code.
  let unit_state :: UnitState
unit_state = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_homeUnitState UnitEnv
unit_env
  ghci_unit_id <- case UnitState -> PackageName -> Maybe UnitId
lookupPackageName UnitState
unit_state (FastString -> PackageName
PackageName (FilePath -> FastString
fsLit FilePath
"ghci")) of
    Maybe UnitId
Nothing -> FilePath -> IO UnitId
forall a. FilePath -> IO a
cmdLineErrorIO FilePath
"C interpreter: couldn't find \"ghci\" package"
    Just UnitId
i  -> UnitId -> IO UnitId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitId
i

  -- generate a temporary name for the iserv program
  let tmpdir = ExecutableLinkOpts -> TempDir
leTempDir ExecutableLinkOpts
opts
  exe_file <- newTempName logger tmpfs tmpdir TFL_GhcSession "iserv"

  let platform = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
  let os       = Platform -> OS
platformOS Platform
platform

  -- we inherit ExecutableLinkOpts for the target code (i.e. derived from
  -- DynFlags specified by the user and from settings). We need to adjust these
  -- options to generate the iserv program we want. Some settings are to be
  -- shared (e.g. ways, platform, etc.) but some other must be set specifically
  -- for iserv.
  let opts' = ExecutableLinkOpts
opts
        { -- write iserv program in some temporary directory
          leOutputFile = Just exe_file

          -- we need GHC to generate a main entry point...
        , leNoHsMain = False

          -- ...however the main symbol must be the iserv server
        , leMainSymbol = zString (zEncodeFS (unitIdFS ghci_unit_id)) ++ "_GHCiziServer_defaultServer"

          -- we need to reset inputs, otherwise one of them may be defining
          -- `main` too (with -no-hs-main).
        , leInputs = []

          -- we never know what symbols GHC will look up in the future, so we
          -- must retain CAFs for running interpreted code.
        , leKeepCafs = True

          -- enable all rts options
        , leRtsOptsEnabled = RtsOptsAll

          -- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
          -- refer to the RTS.  This is harmless if you don't use it (adds a bit
          -- of overhead to startup and increases the binary sizes) but if you
          -- need it there's no alternative.
          --
          -- The Solaris linker does not support --export-dynamic option. It also
          -- does not need it since it exports all dynamic symbols by default
        , leLinkerConfig = if
            | osElfTarget os
            , os /= OSFreeBSD
            , os /= OSSolaris2
            -> (leLinkerConfig opts)
                { linkerOptionsPost = linkerOptionsPost (leLinkerConfig opts) ++ [Option "-Wl,--export-dynamic"]
                }
            | otherwise
            -> leLinkerConfig opts
        }
  linkExecutable logger tmpfs opts' unit_env [] [ghci_unit_id]

  pure exe_file