-----------------------------------------------------------------------------
--
-- Types for the linkers and the loader
--
-- (c) The University of Glasgow 2019
--
-----------------------------------------------------------------------------

module GHC.Linker.Types
   ( Loader (..)
   , LoaderState (..)
   , uninitializedLoader
   , Linkable(..)
   , Unlinked(..)
   , SptEntry(..)
   , isObjectLinkable
   , linkableObjs
   , isObject
   , nameOfObject
   , isInterpretable
   , byteCodeOfObject
   )
where

import GHC.Prelude
import GHC.Unit                ( UnitId, Module )
import GHC.ByteCode.Types      ( ItblEnv, CompiledByteCode )
import GHC.Fingerprint.Type    ( Fingerprint )
import GHCi.RemoteTypes        ( ForeignHValue )

import GHC.Types.Var           ( Id )
import GHC.Types.Name.Env      ( NameEnv )
import GHC.Types.Name          ( Name )

import GHC.Utils.Outputable
import GHC.Utils.Panic

import Control.Concurrent.MVar
import Data.Time               ( UTCTime )


{- **********************************************************************

                        The Loader's state

  ********************************************************************* -}

{-
The loader state *must* match the actual state of the C dynamic linker at all
times.

The MVar used to hold the LoaderState contains a Maybe LoaderState. The MVar
serves to ensure mutual exclusion between multiple loaded copies of the GHC
library. The Maybe may be Nothing to indicate that the linker has not yet been
initialised.

The LoaderState maps Names to actual closures (for interpreted code only), for
use during linking.
-}

newtype Loader = Loader { Loader -> MVar (Maybe LoaderState)
loader_state :: MVar (Maybe LoaderState) }

data LoaderState = LoaderState
    { LoaderState -> ClosureEnv
closure_env :: ClosureEnv
        -- ^ Current global mapping from Names to their true values

    , LoaderState -> ItblEnv
itbl_env    :: !ItblEnv
        -- ^ The current global mapping from RdrNames of DataCons to
        -- info table addresses.
        -- When a new Unlinked is linked into the running image, or an existing
        -- module in the image is replaced, the itbl_env must be updated
        -- appropriately.

    , LoaderState -> [Linkable]
bcos_loaded :: ![Linkable]
        -- ^ The currently loaded interpreted modules (home package)

    , LoaderState -> [Linkable]
objs_loaded :: ![Linkable]
        -- ^ And the currently-loaded compiled modules (home package)

    , LoaderState -> [UnitId]
pkgs_loaded :: ![UnitId]
        -- ^ The currently-loaded packages; always object code
        -- Held, as usual, in dependency order; though I am not sure if
        -- that is really important

    , LoaderState -> [(FilePath, FilePath)]
temp_sos :: ![(FilePath, String)]
        -- ^ We need to remember the name of previous temporary DLL/.so
        -- libraries so we can link them (see #10322)
    }

uninitializedLoader :: IO Loader
uninitializedLoader :: IO Loader
uninitializedLoader = MVar (Maybe LoaderState) -> Loader
Loader (MVar (Maybe LoaderState) -> Loader)
-> IO (MVar (Maybe LoaderState)) -> IO Loader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LoaderState -> IO (MVar (Maybe LoaderState))
forall a. a -> IO (MVar a)
newMVar Maybe LoaderState
forall a. Maybe a
Nothing

type ClosureEnv = NameEnv (Name, ForeignHValue)

-- | Information we can use to dynamically link modules into the compiler
data Linkable = LM {
  Linkable -> UTCTime
linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built
                                        -- (i.e. when the bytecodes were produced,
                                        --       or the mod date on the files)
  Linkable -> Module
linkableModule   :: Module,           -- ^ The linkable module itself
  Linkable -> [Unlinked]
linkableUnlinked :: [Unlinked]
    -- ^ Those files and chunks of code we have yet to link.
    --
    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.
    -- If this list is empty, the Linkable represents a fake linkable, which
    -- is generated with no backend is used to avoid recompiling modules.
    --
    -- ToDo: Do items get removed from this list when they get linked?
 }

instance Outputable Linkable where
  ppr :: Linkable -> SDoc
ppr (LM UTCTime
when_made Module
mod [Unlinked]
unlinkeds)
     = (FilePath -> SDoc
text FilePath
"LinkableM" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (FilePath -> SDoc
text (UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
when_made)) SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
       SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
3 ([Unlinked] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Unlinked]
unlinkeds)

-- | Objects which have yet to be linked by the compiler
data Unlinked
  = DotO FilePath      -- ^ An object file (.o)
  | DotA FilePath      -- ^ Static archive file (.a)
  | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)
  | BCOs CompiledByteCode
         [SptEntry]    -- ^ A byte-code object, lives only in memory. Also
                       -- carries some static pointer table entries which
                       -- should be loaded along with the BCOs.
                       -- See Note [Grant plan for static forms] in
                       -- "GHC.Iface.Tidy.StaticPtrTable".

instance Outputable Unlinked where
  ppr :: Unlinked -> SDoc
ppr (DotO FilePath
path)   = FilePath -> SDoc
text FilePath
"DotO" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
  ppr (DotA FilePath
path)   = FilePath -> SDoc
text FilePath
"DotA" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
  ppr (DotDLL FilePath
path) = FilePath -> SDoc
text FilePath
"DotDLL" SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
path
  ppr (BCOs CompiledByteCode
bcos [SptEntry]
spt) = FilePath -> SDoc
text FilePath
"BCOs" SDoc -> SDoc -> SDoc
<+> CompiledByteCode -> SDoc
forall a. Outputable a => a -> SDoc
ppr CompiledByteCode
bcos SDoc -> SDoc -> SDoc
<+> [SptEntry] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [SptEntry]
spt

-- | An entry to be inserted into a module's static pointer table.
-- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".
data SptEntry = SptEntry Id Fingerprint

instance Outputable SptEntry where
  ppr :: SptEntry -> SDoc
ppr (SptEntry Id
id Fingerprint
fpr) = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
fpr


isObjectLinkable :: Linkable -> Bool
isObjectLinkable :: Linkable -> Bool
isObjectLinkable Linkable
l = Bool -> Bool
not ([Unlinked] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unlinked]
unlinked) Bool -> Bool -> Bool
&& (Unlinked -> Bool) -> [Unlinked] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Unlinked -> Bool
isObject [Unlinked]
unlinked
  where unlinked :: [Unlinked]
unlinked = Linkable -> [Unlinked]
linkableUnlinked Linkable
l
        -- A linkable with no Unlinked's is treated as a BCO.  We can
        -- generate a linkable with no Unlinked's as a result of
        -- compiling a module in NoBackend mode, and this choice
        -- happens to work well with checkStability in module GHC.

linkableObjs :: Linkable -> [FilePath]
linkableObjs :: Linkable -> [FilePath]
linkableObjs Linkable
l = [ FilePath
f | DotO FilePath
f <- Linkable -> [Unlinked]
linkableUnlinked Linkable
l ]

-------------------------------------------

-- | Is this an actual file on disk we can link in somehow?
isObject :: Unlinked -> Bool
isObject :: Unlinked -> Bool
isObject (DotO FilePath
_)   = Bool
True
isObject (DotA FilePath
_)   = Bool
True
isObject (DotDLL FilePath
_) = Bool
True
isObject Unlinked
_          = Bool
False

-- | Is this a bytecode linkable with no file on disk?
isInterpretable :: Unlinked -> Bool
isInterpretable :: Unlinked -> Bool
isInterpretable = Bool -> Bool
not (Bool -> Bool) -> (Unlinked -> Bool) -> Unlinked -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unlinked -> Bool
isObject

-- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object
nameOfObject :: Unlinked -> FilePath
nameOfObject :: Unlinked -> FilePath
nameOfObject (DotO FilePath
fn)   = FilePath
fn
nameOfObject (DotA FilePath
fn)   = FilePath
fn
nameOfObject (DotDLL FilePath
fn) = FilePath
fn
nameOfObject Unlinked
other       = FilePath -> SDoc -> FilePath
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"nameOfObject" (Unlinked -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unlinked
other)

-- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject (BCOs CompiledByteCode
bc [SptEntry]
_) = CompiledByteCode
bc
byteCodeOfObject Unlinked
other       = FilePath -> SDoc -> CompiledByteCode
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"byteCodeOfObject" (Unlinked -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unlinked
other)