never executed always true always false
    1 module GHC.Driver.Config.CmmToAsm
    2   ( initNCGConfig
    3   )
    4 where
    5 
    6 import GHC.Prelude
    7 
    8 import GHC.Driver.Session
    9 
   10 import GHC.Platform
   11 import GHC.Unit.Types (Module)
   12 import GHC.CmmToAsm.Config
   13 import GHC.Utils.Outputable
   14 import GHC.CmmToAsm.BlockLayout
   15 
   16 -- | Initialize the native code generator configuration from the DynFlags
   17 initNCGConfig :: DynFlags -> Module -> NCGConfig
   18 initNCGConfig dflags this_mod = NCGConfig
   19    { ncgPlatform              = targetPlatform dflags
   20    , ncgThisModule            = this_mod
   21    , ncgAsmContext            = initSDocContext dflags (PprCode AsmStyle)
   22    , ncgProcAlignment         = cmmProcAlignment dflags
   23    , ncgExternalDynamicRefs   = gopt Opt_ExternalDynamicRefs dflags
   24    , ncgPIC                   = positionIndependent dflags
   25    , ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags
   26    , ncgInlineThresholdMemset = fromIntegral $ maxInlineMemsetInsns dflags
   27    , ncgSplitSections         = gopt Opt_SplitSections dflags
   28    , ncgRegsIterative         = gopt Opt_RegsIterative dflags
   29    , ncgRegsGraph             = gopt Opt_RegsGraph dflags
   30    , ncgAsmLinting            = gopt Opt_DoAsmLinting dflags
   31    , ncgCfgWeights            = cfgWeights dflags
   32    , ncgCfgBlockLayout        = gopt Opt_CfgBlocklayout dflags
   33    , ncgCfgWeightlessLayout   = gopt Opt_WeightlessBlocklayout dflags
   34 
   35      -- With -O1 and greater, the cmmSink pass does constant-folding, so
   36      -- we don't need to do it again in the native code generator.
   37    , ncgDoConstantFolding     = optLevel dflags < 1
   38 
   39    , ncgDumpRegAllocStages    = dopt Opt_D_dump_asm_regalloc_stages dflags
   40    , ncgDumpAsmStats          = dopt Opt_D_dump_asm_stats dflags
   41    , ncgDumpAsmConflicts      = dopt Opt_D_dump_asm_conflicts dflags
   42    , ncgBmiVersion            = case platformArch (targetPlatform dflags) of
   43                                  ArchX86_64 -> bmiVersion dflags
   44                                  ArchX86    -> bmiVersion dflags
   45                                  _          -> Nothing
   46 
   47      -- We assume  SSE1 and SSE2 operations are available on both
   48      -- x86 and x86_64. Historically we didn't default to SSE2 and
   49      -- SSE1 on x86, which results in defacto nondeterminism for how
   50      -- rounding behaves in the associated x87 floating point instructions
   51      -- because variations in the spill/fpu stack placement of arguments for
   52      -- operations would change the precision and final result of what
   53      -- would otherwise be the same expressions with respect to single or
   54      -- double precision IEEE floating point computations.
   55    , ncgSseVersion =
   56       let v | sseVersion dflags < Just SSE2 = Just SSE2
   57             | otherwise                     = sseVersion dflags
   58       in case platformArch (targetPlatform dflags) of
   59             ArchX86_64 -> v
   60             ArchX86    -> v
   61             _          -> Nothing
   62 
   63    , ncgDwarfEnabled        = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0 && platformArch (targetPlatform dflags) /= ArchAArch64
   64    , ncgDwarfUnwindings     = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0
   65    , ncgDwarfStripBlockInfo = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1.
   66    , ncgDwarfSourceNotes    = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 2 -- We produce GHC-specific source-note DIEs only with -g3
   67    , ncgExposeInternalSymbols = gopt Opt_ExposeInternalSymbols dflags
   68    , ncgCmmStaticPred       = gopt Opt_CmmStaticPred dflags
   69    , ncgEnableShortcutting  = gopt Opt_AsmShortcutting dflags
   70    , ncgComputeUnwinding    = debugLevel dflags > 0
   71    , ncgEnableDeadCodeElimination = not (gopt Opt_InfoTableMap dflags)
   72                                      -- Disable when -finfo-table-map is on (#20428)
   73                                      && backendMaintainsCfg (targetPlatform dflags)
   74                                      -- Enable if the platform maintains the CFG
   75    }