image: nixos/nix:2.25.2

   dependencies: null

   tags:

     - x86_64-linux

   variables:

     BUILD_FLAVOUR: default

       --We try to arrange blocks such that the likely branch is the fallthrough

       --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here.

       CmmCondBranch arg true false _ -> genCondBranch bid true false arg

       CmmCall { cml_target = arg

               , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs)

       _ ->

   where i64 = fromIntegral i :: Int64

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

 -- General things for putting together code sequences

     indexExpr    = UU_Conv(indexOffset); // == 1::I64

 See #21186.

   config <- getConfig

   let platform = ncgPlatform config

       expr_w = cmmExprWidth platform expr

       indexExpr = CmmMachOp

         (MO_UU_Conv expr_w (platformWordWidth platform))

         [indexExpr0]

             -- See Note [%rip-relative addressing on x86-64].

 generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr)

 extractUnwindPoints :: [Instr] -> [UnwindPoint]

 extractUnwindPoints instrs =

                       [Maybe JumpDest] -- Targets of the jump table

                       Section   -- Data section jump table should be put in

                       CLabel    -- Label of jump table

         -- | X86 call instruction

         | CALL        (Either Imm Reg) -- ^ Jump target

                       [RegWithFormat]  -- ^ Arguments (required for register allocation)

     JXX    _ _          -> mkRU [] []

     JXX_GBL _ _         -> mkRU [] []

     JMP     op regs     -> mkRU (use_R addrFmt op regs) []

     CALL (Left _)  params   -> mkRU params (map mkFmt $ callClobberedRegs platform)

     CALL (Right reg) params -> mkRU (mk addrFmt reg:params) (map mkFmt $ callClobberedRegs platform)

     CLTD   fmt          -> mkRU [mk fmt eax] [mk fmt edx]

     POP  fmt op          -> patch1 (POP  fmt) op

     SETCC cond op        -> patch1 (SETCC cond) op

     JMP op regs          -> JMP (patchOp op) regs

     FMA3 fmt perm var x1 x2 x3 -> patch3 (FMA3 fmt perm var) x1 x2 x3

 canFallthroughTo :: Instr -> BlockId -> Bool

 canFallthroughTo insn bid

   = case insn of

   where

     isTargetBid target = case target of

       Nothing                      -> True

 jumpDestsOfInstr insn

   = case insn of

 patchJumpInstr

 patchJumpInstr insn patchF

   = case insn of

         JXX cc id       -> JXX cc (patchF id)

         _               -> insn

     where

         patchJumpDest f (DestBlockId id) = DestBlockId (f id)

             Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')

             Just (DestImm imm)     -> shortcutJump' fn seen' (JXX_GBL cc imm)

         where seen' = setInsert id seen

         let updateBlock (Just (DestBlockId bid))  =

                 case fn bid of

                     Nothing   -> Just (DestBlockId bid )

                     Just dest -> Just dest

             updateBlock dest = dest

             blocks' = map updateBlock blocks

     shortcutJump' _ _ other = other

 -- Here because it knows about JumpDest

    JMP op _

       -> line $ text "\tjmp *" <> pprOperand platform (archWordFormat (target32Bit platform)) op

       -> pprInstr platform (JMP op [])

    CALL (Left imm) _

   -- * Common utility functions

   , (</>)

   , (<.>)

   )

   where

 import GHC.Utils.Panic (panic)

 import System.OsPath

 import System.Directory.Internal (os)

 -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed.

         Nothing  -> panic "addUnit: called too early"

         Just dbs ->

          let newdb = UnitDatabase

                , unitDatabaseUnits = [u]

                }

          in return (dbs ++ [newdb]) -- added at the end because ordering matters

     env <- getBkpEnv

     src_hash <- liftIO $ getFileHash (bkp_filename env)

     let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1)

     let fc = hsc_FC hsc_env

                                 HsSrcFile  -> os "hs")

                              hsc_src

     -- This duplicates a pile of logic in GHC.Driver.Make

     -- Also copied from 'getImports'

     let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps

 import GHC.Driver.Ppr

 import GHC.Driver.Backend

 import qualified GHC.Data.ShortText as ST

 import GHC.Data.Stream           ( liftIO )

 import qualified GHC.Data.Stream as Stream

 import GHC.Types.Unique.DSM

 import GHC.Types.Unique.Supply ( UniqueTag(..) )

 import System.IO

 import Data.Set (Set)

 import qualified Data.Set as Set

         stub_h_file_exists <-

           case mkStubPaths (initFinderOpts dflags) (moduleName mod) location of

             Nothing -> pure False

                     ("#include <HsFFI.h>\n" ++ cplusplus_hdr) cplusplus_ftr

         putDumpFileMaybe logger Opt_D_dump_foreign

   | ms_hs_hash old_summary == src_hash &&

       not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do

            -- update the object-file timestamp

            -- We have to repopulate the Finder's cache for file targets

            -- because the file might not even be on the regular search path

                hsc_src = ms_hsc_src old_summary

            addModuleToFinder fc mod location hsc_src

            return $ Right

              ( old_summary

 makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary

 makeNewModSummary hsc_env MakeNewModSummary{..} = do

   let PreprocessedImports{..} = nms_preimps

   extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name

   (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps

 import GHC.Data.Bool

 import GHC.Data.EnumSet (EnumSet)

 import GHC.Data.Maybe

 import GHC.Builtin.Names ( mAIN_NAME )

 import GHC.Driver.Backend

 import GHC.Driver.Flags

 data PkgDbRef

   = GlobalPkgDb

   | UserPkgDb

   deriving Eq

       linkable $ pure $ DotGBC bco

     linkable parts = do

       time <- maybe getCurrentTime pure if_time

       return $! Linkable time (mi_module iface) parts

       linkable $ NE.singleton (DotGBC bco)

     linkable parts = do

       time <- maybe getCurrentTime pure if_time

       return $!Linkable time (mi_module iface) parts

   -- Either, get the same time as the .gbc file if it exists, or just the current time.

   -- It's important the time of the linkable matches the time of the .gbc file for recompilation

   -- checking.

   return $ mkModuleByteCodeLinkable bco_time bco_object

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

   -- the object file for one module.)

   -- Note the nasty duplication with the same computation in compileFile above

   location <- mkOneShotModLocation pipe_env dflags src_flavour mod_name

   src_hash <- getFileHash (basename <.> suff)

   hi_date <- modificationTimeIfExists hi_file

   hie_date <- modificationTimeIfExists hie_file

   o_mod <- modificationTimeIfExists o_file

   dyn_o_mod <- modificationTimeIfExists dyn_o_file

   -- Tell the finder cache about this module

   mod <- do

 import GHC.Types.Unique.Set

 import Data.Word

 import System.FilePath

 import Text.ParserCombinators.ReadP hiding (char)

 import Text.ParserCombinators.ReadP as R

 package_flags_deps = [

         ------- Packages ----------------------------------------------------

     make_ord_flag defFlag "package-db"

   , make_ord_flag defFlag "clear-package-db"      (NoArg clearPkgDb)

   , make_ord_flag defFlag "no-global-package-db"  (NoArg removeGlobalPkgDb)

   , make_ord_flag defFlag "no-user-package-db"    (NoArg removeUserPkgDb)

       (NoArg (addPkgDbRef UserPkgDb))

     -- backwards compat with GHC<=7.4 :

   , make_dep_flag defFlag "package-conf"

   , make_dep_flag defFlag "no-user-package-conf"

       (NoArg removeUserPkgDb)              "Use -no-user-package-db instead"

   , make_ord_flag defGhcFlag "package-name"       (HasArg $ \name ->

 parseEnvFile envfile = mapM_ parseEntry . lines

   where

     parseEntry str = case words str of

         -- relative package dbs are interpreted relative to the env file

         where envdir = takeDirectory envfile

               db     = drop 11 str

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

 findBytecodeLinkableMaybe hsc_env mod locn = do

   case maybe_bytecode_time of

     Nothing -> return Nothing

     Just bytecode_time -> do

 import GHC.Fingerprint

 import Data.IORef

 import Control.Applicative ((<|>))

 import Control.Monad

 import Data.Time

 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)

 findObjectLinkableMaybe mod locn

    = do let obj_fn = ml_obj_file locn

         case maybe_obj_time of

           Nothing -> return Nothing

           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)

 import System.Environment ( getEnv )

 import GHC.Data.FastString

 import qualified GHC.Data.ShortText as ST

 import GHC.Utils.Logger

 import GHC.Utils.Error

 import Control.Monad

 import Data.Graph (stronglyConnComp, SCC(..))

 import Data.Char ( toUpper )

 import Data.Set (Set)

 import Data.Monoid (First(..))

 import qualified Data.Semigroup as Semigroup

   where

     offsetPackageDb :: Maybe FilePath -> PackageDBFlag -> PackageDBFlag

     offsetPackageDb _ p = p

 -- | Unit database

 data UnitDatabase unit = UnitDatabase

    , unitDatabaseUnits :: [GenUnitInfo unit]

    }

 instance Outputable u => Outputable (UnitDatabase u) where

 type UnitInfoMap = UniqMap UnitId UnitInfo

         Left _ -> system_conf_refs

         Right path

          | Just (xs, x) <- snocView path, isSearchPathSeparator x

          | otherwise

   -- Apply the package DB-related flags from the command line to get the

   -- final list of package DBs.

 -- NB: This logic is reimplemented in Cabal, so if you change it,

 -- make sure you update Cabal. (Or, better yet, dump it in the

 -- compiler info so Cabal can use the info.)

 resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do

   dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOS cfg)

   let pkgconf = dir </> unitConfigDBName cfg

   exist <- tryMaybeT $ doesDirectoryExist pkgconf

 resolveUnitDatabase _ (PkgDbPath name) = return $ Just name