{- | This module implements the serialization of bytecode objects to and from disk.

 -}

 module GHC.ByteCode.Serialize

   , ModuleByteCode(..)

   , BytecodeLibX(..)

   , BytecodeLib

   , InterpreterLibraryContents(..)

   , writeBytecodeLib

   , readBytecodeLib

   , mkModuleByteCode

   , fingerprintModuleByteCodeContents

   , decodeOnDiskModuleByteCode

 See Note [-fwrite-byte-code is not the default]

 See Note [Recompilation avoidance with bytecode objects]

 See Note [Persistent bytecode file headers]

 Note [Persistent bytecode file headers]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 the current `hiVersion` ahead of the binary payload. Readers validate this

 header before setting up the normal `Name`/`FastString` deserialisation

 machinery. This follows the same approach as normal interface files.

 -}

   odbco <- encodeBytecodeLib lib

   createDirectoryIfMissing True (takeDirectory path)

   bh' <- openBinMem initBinMemSize

   bh <- addBinNameWriter bh'

   writePersistentBytecodeHeader BytecodeLibraryFile bh

   putWithUserData QuietBinIFace NormalCompression bh odbco

   writeBinMem bh path

 readBytecodeLib hsc_env path = do

   bh' <- readBinMem path

   readPersistentBytecodeHeader BytecodeLibraryFile path bh'

   bh <- addBinNameReader (hsc_NC hsc_env) bh'

   res <- getWithUserData (hsc_NC hsc_env) bh

   pure res

 -- | Convert an 'OnDiskModuleByteCode' to an 'ModuleByteCode'.

 -- 'OnDiskModuleByteCode' is the representation which we read from a file,

 -- the 'ModuleByteCode' is the representation which is manipulated by program logic.

   odbco <- readOnDiskModuleByteCode hsc_env f

   decodeOnDiskModuleByteCode hsc_env odbco

 readOnDiskModuleByteCode :: HscEnv -> FilePath -> IO OnDiskModuleByteCode

 readOnDiskModuleByteCode hsc_env f = do

   bh' <- readBinMem f

 import qualified GHC.Data.Stream as Stream

 import Control.Monad

 import Data.IORef

 import System.Directory

 import qualified Data.Set as S

 import GHC.Unit.Module.WholeCoreBindings

 import GHC.Types.TypeEnv

 import System.IO.Unsafe ( unsafeInterleaveIO )

 import GHC.Iface.Env ( trace_if )

   where

     compile decls = do

       bco <- compileWholeCoreBindings hsc_env type_env decls

 loadIfaceByteCodeLazy ::

   HscEnv ->

     compile decls = do

       bco <- unsafeInterleaveIO $ do

           compileWholeCoreBindings hsc_env type_env decls

 -- | If the 'Linkable' contains Core bindings loaded from an interface, replace

 -- them with a lazy IO thunk that compiles them to bytecode and foreign objects,

     go :: RecompBytecodeLinkable -> IO (Maybe (LinkableWith ModuleByteCode))

     go (NormalLinkable l) = pure l

 -- | Hydrate interface Core bindings and compile them to bytecode.

 --

 generateAndWriteByteCodeLinkable :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO (LinkableWith ModuleByteCode)

 generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do

   bco_object <- generateAndWriteByteCode hsc_env cgguts mod_location

 mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode

 mkModuleByteCode hsc_env mod mod_location cgguts = do

   -> ModLocation

   -> IO Linkable

 generateFreshByteCodeLinkable hsc_env mod_name cgguts mod_location = do

   bco_object <- mkModuleByteCode hsc_env (mkHomeModule (hsc_home_unit hsc_env) mod_name) mod_location cgguts

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

 hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> FilePath -> IO (Maybe FilePath)

 import GHC.Types.Var.Env       ( mkEmptyTidyEnv )

 import GHC.Types.Var.Set

 import GHC.Utils.Panic

 import GHC.Utils.Error

 import GHC.Utils.Outputable

 import qualified GHC.Data.Strict as Strict

 import qualified Data.Array as A

 import qualified Data.List.NonEmpty as NE

 import Control.Monad

 import Data.IORef

 import System.FilePath as FilePath

 import Control.DeepSeq (force)

 import Control.Exception as E (mask_, finally)

 import Data.List.NonEmpty (NonEmpty ((:|)))

 import System.IO.Unsafe ( unsafeInterleaveIO )

 import GHC.Iface.Env ( trace_if )

       -- Not in dynamic-too mode

       else k

   checkDynamicObj $

     case (,) <$> mb_obj_date <*> mb_if_date of

       Just (obj_date, if_date)

             case mb_old_linkable of

               Just old_linkable

                 -> return $ UpToDateItem old_linkable

       _ -> return $ outOfDateItemBecause MissingObjectFile Nothing

 -- | Check to see if we can reuse the old linkable, by this point we will

 checkByteCodeInMemory :: HscEnv -> ModSummary -> Maybe (LinkableWith ModuleByteCode) -> IO (MaybeValidated (LinkableWith ModuleByteCode))

 checkByteCodeInMemory hsc_env mod_sum mb_old_linkable =

   case mb_old_linkable of

       -- If `-fwrite-byte-code` is enabled, then check that the .gbc file is

       -- up-to-date with the linkable we have in our hand.

       -- If ms_bytecode_date is Nothing, then the .gbc file does not exist yet.

     _ -> return $ outOfDateItemBecause MissingBytecode Nothing

 -- | Load bytecode from a ".gbc" object file if it exists and is up-to-date

           -- that the one we have on disk would be suitable as well.

           linkable <- unsafeInterleaveIO $ do

             bco <- ByteCode.readBinByteCode hsc_env obj_fn

           return $ UpToDateItem linkable

     _ -> return $ outOfDateItemBecause MissingBytecode Nothing

 checkByteCodeFromIfaceCoreBindings _hsc_env iface mod_sum = do

     let

       this_mod   = ms_mod mod_sum

     case iface_core_bindings iface (ms_location mod_sum) of

       _ -> return $ outOfDateItemBecause MissingBytecode Nothing

                 Strict.Nothing -- no hpc info

       {- load it -}

       mbc <- ByteCode.mkModuleByteCode this_mod bcos []

       (mods_needed, units_needed) <- loadDecls interp hsc_env srcspan $

       -- Get the foreign reference to the name we should have just loaded.

       mhvs <- lookupFromLoadedEnv interp (idName binding_id)

       {- Get the HValue for the root -}

     -- state independently to load new objects here.

     let objs = mapMaybe linkableFilterNative (ldNeededLinkables deps)

     -- Compute LoadedPkgInfo metadata for recompilation avoidance.

     -- We don't call loadPackages' because the JS interpreter doesn't load

 import Data.Maybe

 import qualified Data.Set as Set

 import qualified Data.List.NonEmpty as NE

 import Data.List.NonEmpty (NonEmpty(..))

 import GHC.Tc.Utils.Monad (shutdownTcMPluginsIO, FrontendResult (..), tcg_plugins)

   e_bytecode_lib_time <- modificationTimeIfExists exe_file_os

   case e_bytecode_lib_time of

     Nothing  -> return $ NeedsRecompile MustCompile

 checkNativeLibraryLinkingNeeded :: Bool -> Logger -> DynFlags -> UnitEnv -> [Linkable] -> [UnitId] -> IO RecompileRequired

 checkNativeLibraryLinkingNeeded staticLink _ dflags unit_env linkables pkg_deps = do

     Just t -> do

         -- first check object files and extra_ld_inputs

         let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]

         if not (null errs) || any (t <) obj_times

             then return $ needsRecompileBecause ObjectsChanged

             else do

       -- No object file produced, bytecode or NoBackend

       Nothing -> return mlinkable

       Just o_fp -> do

         final_object <- use (T_MergeForeign pipe_env hsc_env o_fp fos)

         -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend.

         return (mlinkable { homeMod_object = Just linkable })

 import GHC.Driver.Env

 import GHC.Utils.Outputable

 import GHC.Linker.Loader

 import GHC.Driver.Phases (isBytecodeFilename)

 import GHC.Runtime.Interpreter (interpreterDynamic)

 import Data.Maybe

     bytecodeLibFiles = all_cbcs,

     bytecodeLibForeign = interpreter_foreign_lib

   }

   let output_fn = fromMaybe "a.out" (outputFile dflags)

   return ()

 import GHC.Data.Maybe

 import Control.Applicative

 data LinkDepsOpts = LinkDepsOpts

   { ldObjSuffix   :: !String                        -- ^ Suffix of .o files

       -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.

       -- So here we check the build tag: if we're building a non-standard way

       -- then we need to find & link object files built the "normal" way.

 get_link_deps

   :: LinkDepsOpts

   -> LoaderState

   -> SrcSpan

   -> [Module]

   -> IO LinkDeps

       -- Three step process:

         -- 3.  For each dependent module, find its linkable

         --     This will either be in the HPT or (in the case of one-shot

         --     compilation) we may need to use maybe_getFileLinkable

       let

         new_link_deps lnks = LinkDeps

           { ldNeededLinkables = lnks_needed

           , ldAllLinkables    = lnks

         then homeModInfoByteCode hmi <|> homeModInfoObject hmi

         else homeModInfoObject hmi   <|> homeModInfoByteCode hmi

       = HUG.lookupHugByModule mod (ue_home_unit_graph unit_env) >>= \case

           Nothing -> do

            -- It's not in the HPT because we are in one shot mode,

            -- so use the Finder to get a ModLocation...

                   mb_lnk <- findObjectLinkableMaybe mod loc

                   case mb_lnk of

                     Nothing  -> no_obj mod

                 _ -> no_obj (moduleName mod)

 {-

 throwProgramError :: LinkDepsOpts -> SDoc -> IO a

 throwProgramError opts doc = throwGhcExceptionIO (ProgramError (renderWithContext (ldPprOpts opts) doc))

 checkNonStdWay _opts interp _srcspan

     -- with -fexternal-interpreter we load the .o files, whatever way

     -- they were built.  If they were built for a non-std way, then

     -- we will use the appropriate variant of the iserv binary to load them.

 -- complain that they are redundant.

 #if defined(HAVE_INTERNAL_INTERPRETER)

 checkNonStdWay opts _interp srcspan

     -- Only if we are compiling with the same ways as GHC is built

     -- with, can we dynamically load those object files. (see #3604)

   | ldObjSuffix opts == normalObjectSuffix && not (null targetFullWays)

   = failNonStd opts srcspan

   where

     targetFullWays = fullWays (ldWays opts)

     normalObjectSuffix :: String

     normalObjectSuffix = "o"

 data Way' = Normal | Prof | Dyn | ProfDyn

 failNonStd opts srcspan = dieWith opts srcspan $

   text "Cannot load" <+> pprWay' compWay <+>

      text "objects when GHC is built" <+> pprWay' ghciWay $$

 import GHC.Prelude

 import GHC.Settings

 import GHC.Platform

 import GHC.Platform.Ways

 findBytecodeLinkableMaybe :: HscEnv -> ModLocation -> IO (Maybe Linkable)

 findBytecodeLinkableMaybe hsc_env locn = do

       bco <- readBinByteCode hsc_env bytecode_fn

 get_reachable_nodes :: HscEnv -> [Module] -> IO ([Module], UniqDSet UnitId)

 get_reachable_nodes hsc_env mods

 linkableInSet l objs_loaded =

   case lookupModuleEnv objs_loaded (linkableModule l) of

         Nothing -> False

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

   -> [Linkable]

   -> IO (LoaderState, SuccessFlag)

 loadObjects interp hsc_env pls objs = do

             pls1                     = pls { objs_loaded = objs_loaded' }

         if interpreterDynamic interp

             then do pls2 <- dynLoadObjs interp hsc_env pls1 wanted_objs

                             return (pls2, Failed)

 -- | Create a shared library containing the given object files

 mkDynLoadLib :: HscEnv -> (Ways -> Ways) -> [(FilePath, String)] ->[UnitId] -> [FilePath] -> IO (Maybe (FilePath, FilePath, String))

 mkDynLoadLib      _  _  _ _  []   = return Nothing

                         then addWay WayProf

                         else id

                -> [Linkable]    -- ^ New linkables

                -> (LinkableSet LinkableUsage,  -- New loaded set (including new ones)

                    [Linkable])  -- New linkables (excluding dups)

   = go already [] ls

   where

     go !already extras [] = (already, extras)

     go !already extras (l:ls)

         | linkableInSet l already = go already     extras     ls

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

 dynLinkBCOs :: Interp -> LoaderState -> KeepModuleLinkableDefinitions -> [Linkable] -> IO LoaderState

 dynLinkBCOs interp pls keep_spec bcos =

             pls1                     = pls { bcos_loaded = bcos_loaded' }

             cbcs :: [CompiledByteCode]

    , LinkedBreaks(..)

    , emptyLinkedBreaks

    , LinkableSet

    , ObjFile

    , SptEntry(..)

    , LibrarySpec(..)

    , linkableBCOs

    , linkablePartBCOs

    , linkableModuleByteCodes

    , linkablePartPath

    , isNativeCode

    , linkableFilterByteCode

    , linkableFilterNative

    , linkableUsageObjs

    , mkLinkablesUsage

    , mkLinkableUsage

    , ModuleByteCode(..)

    )

 import GHC.Unit.Module.Env

 import GHC.Unit.Module.WholeCoreBindings

 import GHC.Utils.Misc (seqNonEmpty)

 import GHC.Utils.Outputable

 import Control.Concurrent.MVar

 import Data.Array

 import Data.Functor.Identity

 import Data.Maybe (mapMaybe)

 import Data.List.NonEmpty (NonEmpty, nonEmpty)

 import qualified Data.List.NonEmpty as NE

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

 -- | Information we can use to dynamically link modules into the compiler

 data LinkableWith parts = Linkable

   , linkableModule   :: !Module

       -- ^ The linkable module itself

 type LinkableSet = ModuleEnv

 instance Outputable a => Outputable (LinkableWith a) where

        $$ nest 3 (ppr parts)

 type ObjFile = FilePath

                                       , gbc_hash :: !Fingerprint

                                       }

 instance Outputable ModuleByteCode where

   ppr (ModuleByteCode mod _cbc _fos _) = text "ModuleByteCode" <+> ppr mod

 linkableModuleByteCodes :: Linkable -> [ModuleByteCode]

 linkableModuleByteCodes l = [ mbc | DotGBC mbc <- NE.toList (linkableParts l) ]

 -- | List the native objects (.o) of a linkable

 linkableObjs :: Linkable -> [FilePath]

 linkableObjs l = concatMap linkablePartObjectPaths (linkableParts l)

 -- | List the paths of the native objects (.o)