Commit 747093b7 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

CmmToAsm DynFlags refactoring (#17957)

* Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used
  to test the global `ExternalDynamicRefs` flag. Now we test it outside of
  `isDynLinkName`

* Add new fields into `NCGConfig`: current unit id, sse/bmi versions,
  externalDynamicRefs, etc.

* Replace many uses of `DynFlags` by `NCGConfig`

* Moved `BMI/SSE` datatypes into `GHC.Platform`
parent f2a98996
Pipeline #18406 failed with stages
in 25 minutes and 29 seconds
......@@ -132,6 +132,7 @@ import GHC.Platform
import GHC.Types.Unique.Set
import Util
import GHC.Core.Ppr ( {- instances -} )
import GHC.CmmToAsm.Config
-- -----------------------------------------------------------------------------
-- The CLabel type
......@@ -1027,23 +1028,21 @@ isLocalCLabel this_mod lbl =
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
labelDynamic :: DynFlags -> Module -> CLabel -> Bool
labelDynamic dflags this_mod lbl =
labelDynamic :: NCGConfig -> Module -> CLabel -> Bool
labelDynamic config this_mod lbl =
case lbl of
-- is the RTS in a DLL or not?
RtsLabel _ ->
externalDynamicRefs && (this_pkg /= rtsUnitId)
IdLabel n _ _ ->
isDynLinkName dflags this_mod n
externalDynamicRefs && isDynLinkName platform this_mod n
-- When compiling in the "dyn" way, each package is to be linked into
-- its own shared library.
CmmLabel pkg _ _
| os == OSMinGW32 ->
externalDynamicRefs && (this_pkg /= pkg)
| otherwise ->
gopt Opt_ExternalDynamicRefs dflags
| os == OSMinGW32 -> externalDynamicRefs && (this_pkg /= pkg)
| otherwise -> externalDynamicRefs
LocalBlockLabel _ -> False
......@@ -1080,8 +1079,9 @@ labelDynamic dflags this_mod lbl =
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
where
externalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
os = platformOS (targetPlatform dflags)
externalDynamicRefs = ncgExternalDynamicRefs config
platform = ncgPlatform config
os = platformOS platform
this_pkg = moduleUnitId this_mod
......
......@@ -31,6 +31,8 @@ import GHC.Runtime.Heap.Layout
import GHC.Types.Unique.Supply
import GHC.Types.CostCentre
import GHC.StgToCmm.Heap
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Config
import Control.Monad
import Data.Map.Strict (Map)
......@@ -925,6 +927,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
topSRT <- get
let
config = initConfig dflags
srtMap = moduleSRTMap topSRT
blockids = getBlockLabels lbls
......@@ -1024,11 +1027,11 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
-- when dynamic linking is used we cannot guarantee that the offset
-- between the SRT and the info table will fit in the offset field.
-- Consequently we build a singleton SRT in in this case.
not (labelDynamic dflags this_mod lbl)
not (labelDynamic config this_mod lbl)
-- MachO relocations can't express offsets between compilation units at
-- all, so we are always forced to build a singleton SRT in this case.
&& (not (osMachOTarget $ platformOS $ targetPlatform dflags)
&& (not (osMachOTarget $ platformOS $ ncgPlatform config)
|| isLocalCLabel this_mod lbl) -> do
-- If we have a static function closure, then it becomes the
......
......@@ -162,35 +162,36 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
-> Stream IO RawCmmGroup a
-> IO a
nativeCodeGen dflags this_mod modLoc h us cmms
= let platform = targetPlatform dflags
= let config = initConfig dflags
platform = ncgPlatform config
nCG' :: ( Outputable statics, Outputable instr
, Outputable jumpDest, Instruction instr)
=> NcgImpl statics instr jumpDest -> IO a
nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
in case platformArch platform of
ArchX86 -> nCG' (x86NcgImpl dflags)
ArchX86_64 -> nCG' (x86_64NcgImpl dflags)
ArchPPC -> nCG' (ppcNcgImpl dflags)
ArchX86 -> nCG' (x86NcgImpl config)
ArchX86_64 -> nCG' (x86_64NcgImpl config)
ArchPPC -> nCG' (ppcNcgImpl config)
ArchS390X -> panic "nativeCodeGen: No NCG for S390X"
ArchSPARC -> nCG' (sparcNcgImpl dflags)
ArchSPARC -> nCG' (sparcNcgImpl config)
ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64"
ArchARM {} -> panic "nativeCodeGen: No NCG for ARM"
ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64"
ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags)
ArchPPC_64 _ -> nCG' (ppcNcgImpl config)
ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha"
ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb"
ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel"
ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch"
ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript"
x86NcgImpl :: DynFlags -> NcgImpl (Alignment, RawCmmStatics)
x86NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86NcgImpl dflags
= (x86_64NcgImpl dflags)
x86NcgImpl config
= (x86_64NcgImpl config)
x86_64NcgImpl :: DynFlags -> NcgImpl (Alignment, RawCmmStatics)
x86_64NcgImpl :: NCGConfig -> NcgImpl (Alignment, RawCmmStatics)
X86.Instr.Instr X86.Instr.JumpDest
x86_64NcgImpl dflags
x86_64NcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen
......@@ -209,11 +210,10 @@ x86_64NcgImpl dflags
,invertCondBranches = X86.CodeGen.invertCondBranches
}
where
config = initConfig dflags
platform = ncgPlatform config
ppcNcgImpl :: DynFlags -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
ppcNcgImpl dflags
ppcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics PPC.Instr.Instr PPC.RegInfo.JumpDest
ppcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen
......@@ -232,11 +232,10 @@ ppcNcgImpl dflags
,invertCondBranches = \_ _ -> id
}
where
config = initConfig dflags
platform = ncgPlatform config
sparcNcgImpl :: DynFlags -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
sparcNcgImpl dflags
sparcNcgImpl :: NCGConfig -> NcgImpl RawCmmStatics SPARC.Instr.Instr SPARC.ShortcutJump.JumpDest
sparcNcgImpl config
= NcgImpl {
ncgConfig = config
,cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen
......@@ -255,7 +254,6 @@ sparcNcgImpl dflags
,invertCondBranches = \_ _ -> id
}
where
config = initConfig dflags
platform = ncgPlatform config
--
......@@ -565,7 +563,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
-- cmm to cmm optimisations
let (opt_cmm, imports) =
{-# SCC "cmmToCmm" #-}
cmmToCmm dflags this_mod fixed_cmm
cmmToCmm config this_mod fixed_cmm
dumpIfSet_dyn dflags
Opt_D_dump_opt_cmm "Optimised Cmm" FormatCMM
......@@ -1067,10 +1065,10 @@ Ideas for other things we could do (put these in Hoopl please!):
temp assignments, and certain assigns to mem...)
-}
cmmToCmm :: DynFlags -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel])
cmmToCmm :: NCGConfig -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel])
cmmToCmm _ _ top@(CmmData _ _) = (top, [])
cmmToCmm dflags this_mod (CmmProc info lbl live graph)
= runCmmOpt dflags this_mod $
cmmToCmm config this_mod (CmmProc info lbl live graph)
= runCmmOpt config this_mod $
do blocks' <- mapM cmmBlockConFold (toBlockList graph)
return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks')
......@@ -1087,7 +1085,7 @@ pattern OptMResult x y = (# x, y #)
data OptMResult a = OptMResult !a ![CLabel] deriving (Functor)
#endif
newtype CmmOptM a = CmmOptM (DynFlags -> Module -> [CLabel] -> OptMResult a)
newtype CmmOptM a = CmmOptM (NCGConfig -> Module -> [CLabel] -> OptMResult a)
deriving (Functor)
instance Applicative CmmOptM where
......@@ -1096,11 +1094,11 @@ instance Applicative CmmOptM where
instance Monad CmmOptM where
(CmmOptM f) >>= g =
CmmOptM $ \dflags this_mod imports0 ->
case f dflags this_mod imports0 of
CmmOptM $ \config this_mod imports0 ->
case f config this_mod imports0 of
OptMResult x imports1 ->
case g x of
CmmOptM g' -> g' dflags this_mod imports1
CmmOptM g' -> g' config this_mod imports1
instance CmmMakeDynamicReferenceM CmmOptM where
addImport = addImportCmmOpt
......@@ -1109,12 +1107,12 @@ instance CmmMakeDynamicReferenceM CmmOptM where
addImportCmmOpt :: CLabel -> CmmOptM ()
addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports)
instance HasDynFlags CmmOptM where
getDynFlags = CmmOptM $ \dflags _ imports -> OptMResult dflags imports
getCmmOptConfig :: CmmOptM NCGConfig
getCmmOptConfig = CmmOptM $ \config _ imports -> OptMResult config imports
runCmmOpt :: DynFlags -> Module -> CmmOptM a -> (a, [CLabel])
runCmmOpt dflags this_mod (CmmOptM f) =
case f dflags this_mod [] of
runCmmOpt :: NCGConfig -> Module -> CmmOptM a -> (a, [CLabel])
runCmmOpt config this_mod (CmmOptM f) =
case f config this_mod [] of
OptMResult result imports -> (result, imports)
cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock
......@@ -1178,29 +1176,26 @@ cmmStmtConFold stmt
cmmExprConFold :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprConFold referenceKind expr = do
dflags <- getDynFlags
config <- getCmmOptConfig
-- With -O1 and greater, the cmmSink pass does constant-folding, so
-- we don't need to do it again here.
let expr' = if optLevel dflags >= 1
let expr' = if not (ncgDoConstantFolding config)
then expr
else cmmExprCon dflags expr
else cmmExprCon config expr
cmmExprNative referenceKind expr'
cmmExprCon :: DynFlags -> CmmExpr -> CmmExpr
cmmExprCon dflags (CmmLoad addr rep) = CmmLoad (cmmExprCon dflags addr) rep
cmmExprCon dflags (CmmMachOp mop args)
= cmmMachOpFold platform mop (map (cmmExprCon dflags) args)
where platform = targetPlatform dflags
cmmExprCon :: NCGConfig -> CmmExpr -> CmmExpr
cmmExprCon config (CmmLoad addr rep) = CmmLoad (cmmExprCon config addr) rep
cmmExprCon config (CmmMachOp mop args)
= cmmMachOpFold (ncgPlatform config) mop (map (cmmExprCon config) args)
cmmExprCon _ other = other
-- handles both PIC and non-PIC cases... a very strange mixture
-- of things to do.
cmmExprNative :: ReferenceKind -> CmmExpr -> CmmOptM CmmExpr
cmmExprNative referenceKind expr = do
dflags <- getDynFlags
let platform = targetPlatform dflags
config <- getCmmOptConfig
let platform = ncgPlatform config
arch = platformArch platform
case expr of
CmmLoad addr rep
......@@ -1219,10 +1214,10 @@ cmmExprNative referenceKind expr = do
CmmLit (CmmLabel lbl)
-> do
cmmMakeDynamicReference dflags referenceKind lbl
cmmMakeDynamicReference config referenceKind lbl
CmmLit (CmmLabelOff lbl off)
-> do
dynRef <- cmmMakeDynamicReference dflags referenceKind lbl
dynRef <- cmmMakeDynamicReference config referenceKind lbl
-- need to optimize here, since it's late
return $ cmmMachOpFold platform (MO_Add (wordWidth platform)) [
dynRef,
......@@ -1233,15 +1228,15 @@ cmmExprNative referenceKind expr = do
-- to use the register table, so we replace these registers
-- with the corresponding labels:
CmmReg (CmmGlobal EagerBlackholeInfo)
| arch == ArchPPC && not (positionIndependent dflags)
| arch == ArchPPC && not (ncgPIC config)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_EAGER_BLACKHOLE_info")))
CmmReg (CmmGlobal GCEnter1)
| arch == ArchPPC && not (positionIndependent dflags)
| arch == ArchPPC && not (ncgPIC config)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_enter_1")))
CmmReg (CmmGlobal GCFun)
| arch == ArchPPC && not (positionIndependent dflags)
| arch == ArchPPC && not (ncgPIC config)
-> cmmExprNative referenceKind $
CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_fun")))
......
......@@ -9,21 +9,28 @@ where
import GhcPrelude
import GHC.Platform
import GHC.Cmm.Type (Width(..))
import GHC.Types.Module
-- | Native code generator configuration
data NCGConfig = NCGConfig
{ ncgPlatform :: !Platform -- ^ Target platform
, ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment
, ncgDebugLevel :: !Int -- ^ Debug level
, ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries
, ncgPIC :: !Bool -- ^ Enable Position-Independent Code
, ncgSplitSections :: !Bool -- ^ Split sections
, ncgSpillPreallocSize :: !Int -- ^ Size in bytes of the pre-allocated spill space on the C stack
, ncgRegsIterative :: !Bool
, ncgAsmLinting :: !Bool -- ^ Perform ASM linting pass
, ncgDumpRegAllocStages :: !Bool
, ncgDumpAsmStats :: !Bool
, ncgDumpAsmConflicts :: !Bool
{ ncgPlatform :: !Platform -- ^ Target platform
, ncgUnitId :: UnitId -- ^ Target unit ID
, ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment
, ncgDebugLevel :: !Int -- ^ Debug level
, ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries
, ncgPIC :: !Bool -- ^ Enable Position-Independent Code
, ncgInlineThresholdMemcpy :: !Word -- ^ If inlining `memcpy` produces less than this threshold (in pseudo-instruction unit), do it
, ncgInlineThresholdMemset :: !Word -- ^ Ditto for `memset`
, ncgSplitSections :: !Bool -- ^ Split sections
, ncgSpillPreallocSize :: !Int -- ^ Size in bytes of the pre-allocated spill space on the C stack
, ncgRegsIterative :: !Bool
, ncgAsmLinting :: !Bool -- ^ Perform ASM linting pass
, ncgDoConstantFolding :: !Bool -- ^ Perform CMM constant folding
, ncgSseVersion :: Maybe SseVersion -- ^ (x86) SSE instructions
, ncgBmiVersion :: Maybe BmiVersion -- ^ (x86) BMI instructions
, ncgDumpRegAllocStages :: !Bool
, ncgDumpAsmStats :: !Bool
, ncgDumpAsmConflicts :: !Bool
}
-- | Return Word size
......
......@@ -148,18 +148,46 @@ mkNatM_State us delta dflags this_mod
-- | Initialize the native code generator configuration from the DynFlags
initConfig :: DynFlags -> NCGConfig
initConfig dflags = NCGConfig
{ ncgPlatform = targetPlatform dflags
, ncgProcAlignment = cmmProcAlignment dflags
, ncgDebugLevel = debugLevel dflags
, ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
, ncgPIC = positionIndependent dflags
, ncgSplitSections = gopt Opt_SplitSections dflags
, ncgSpillPreallocSize = rESERVED_C_STACK_BYTES dflags
, ncgRegsIterative = gopt Opt_RegsIterative dflags
, ncgAsmLinting = gopt Opt_DoAsmLinting dflags
, ncgDumpRegAllocStages = dopt Opt_D_dump_asm_regalloc_stages dflags
, ncgDumpAsmStats = dopt Opt_D_dump_asm_stats dflags
, ncgDumpAsmConflicts = dopt Opt_D_dump_asm_conflicts dflags
{ ncgPlatform = targetPlatform dflags
, ncgUnitId = thisPackage dflags
, ncgProcAlignment = cmmProcAlignment dflags
, ncgDebugLevel = debugLevel dflags
, ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
, ncgPIC = positionIndependent dflags
, ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags
, ncgInlineThresholdMemset = fromIntegral $ maxInlineMemsetInsns dflags
, ncgSplitSections = gopt Opt_SplitSections dflags
, ncgSpillPreallocSize = rESERVED_C_STACK_BYTES dflags
, ncgRegsIterative = gopt Opt_RegsIterative dflags
, ncgAsmLinting = gopt Opt_DoAsmLinting dflags
-- With -O1 and greater, the cmmSink pass does constant-folding, so
-- we don't need to do it again in the native code generator.
, ncgDoConstantFolding = optLevel dflags < 1
, ncgDumpRegAllocStages = dopt Opt_D_dump_asm_regalloc_stages dflags
, ncgDumpAsmStats = dopt Opt_D_dump_asm_stats dflags
, ncgDumpAsmConflicts = dopt Opt_D_dump_asm_conflicts dflags
, ncgBmiVersion = case platformArch (targetPlatform dflags) of
ArchX86_64 -> bmiVersion dflags
ArchX86 -> bmiVersion dflags
_ -> Nothing
-- We Assume SSE1 and SSE2 operations are available on both
-- x86 and x86_64. Historically we didn't default to SSE2 and
-- SSE1 on x86, which results in defacto nondeterminism for how
-- rounding behaves in the associated x87 floating point instructions
-- because variations in the spill/fpu stack placement of arguments for
-- operations would change the precision and final result of what
-- would otherwise be the same expressions with respect to single or
-- double precision IEEE floating point computations.
, ncgSseVersion =
let v | sseVersion dflags < Just SSE2 = Just SSE2
| otherwise = sseVersion dflags
in case platformArch (targetPlatform dflags) of
ArchX86_64 -> v
ArchX86 -> v
_ -> Nothing
}
......
......@@ -109,21 +109,20 @@ instance CmmMakeDynamicReferenceM NatM where
cmmMakeDynamicReference
:: CmmMakeDynamicReferenceM m
=> DynFlags
=> NCGConfig
-> ReferenceKind -- whether this is the target of a jump
-> CLabel -- the label
-> m CmmExpr
cmmMakeDynamicReference dflags referenceKind lbl
cmmMakeDynamicReference config referenceKind lbl
| Just _ <- dynamicLinkerLabelInfo lbl
= return $ CmmLit $ CmmLabel lbl -- already processed it, pass through
| otherwise
= do this_mod <- getThisModule
let config = initConfig dflags
platform = ncgPlatform config
let platform = ncgPlatform config
case howToAccessLabel
dflags
config
(platformArch platform)
(platformOS platform)
this_mod
......@@ -215,9 +214,7 @@ data LabelAccessStyle
| AccessViaSymbolPtr
| AccessDirectly
howToAccessLabel
:: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel :: NCGConfig -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
-- Windows
-- In Windows speak, a "module" is a set of objects linked into the
......@@ -240,15 +237,15 @@ howToAccessLabel
-- into the same .exe file. In this case we always access symbols directly,
-- and never use __imp_SYMBOL.
--
howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
howToAccessLabel config _ OSMinGW32 this_mod _ lbl
-- Assume all symbols will be in the same PE, so just access them directly.
| not (gopt Opt_ExternalDynamicRefs dflags)
| not (ncgExternalDynamicRefs config)
= AccessDirectly
-- If the target symbol is in another PE we need to access it via the
-- appropriate __imp_SYMBOL pointer.
| labelDynamic dflags this_mod lbl
| labelDynamic config this_mod lbl
= AccessViaSymbolPtr
-- Target symbol is in the same PE as the caller, so just access it directly.
......@@ -264,9 +261,9 @@ howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
-- It is always possible to access something indirectly,
-- even when it's not necessary.
--
howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
howToAccessLabel config arch OSDarwin this_mod DataReference lbl
-- data access to a dynamic library goes via a symbol pointer
| labelDynamic dflags this_mod lbl
| labelDynamic config this_mod lbl
= AccessViaSymbolPtr
-- when generating PIC code, all cross-module data references must
......@@ -279,27 +276,27 @@ howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
-- we'd need to pass the current Module all the way in to
-- this function.
| arch /= ArchX86_64
, positionIndependent dflags && externallyVisibleCLabel lbl
, ncgPIC config && externallyVisibleCLabel lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
howToAccessLabel config arch OSDarwin this_mod JumpReference lbl
-- dyld code stubs don't work for tailcalls because the
-- stack alignment is only right for regular calls.
-- Therefore, we have to go via a symbol pointer:
| arch == ArchX86 || arch == ArchX86_64
, labelDynamic dflags this_mod lbl
, labelDynamic config this_mod lbl
= AccessViaSymbolPtr
howToAccessLabel dflags arch OSDarwin this_mod _ lbl
howToAccessLabel config arch OSDarwin this_mod _ lbl
-- Code stubs are the usual method of choice for imported code;
-- not needed on x86_64 because Apple's new linker, ld64, generates
-- them automatically.
| arch /= ArchX86_64
, labelDynamic dflags this_mod lbl
, labelDynamic config this_mod lbl
= AccessViaStub
| otherwise
......@@ -310,7 +307,7 @@ howToAccessLabel dflags arch OSDarwin this_mod _ lbl
-- AIX
-- quite simple (for now)
howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl
howToAccessLabel _config _arch OSAIX _this_mod kind _lbl
= case kind of
DataReference -> AccessViaSymbolPtr
CallReference -> AccessDirectly
......@@ -339,27 +336,27 @@ howToAccessLabel _ (ArchPPC_64 _) os _ kind _
-- regular calls are handled by the runtime linker
_ -> AccessDirectly
howToAccessLabel dflags _ os _ _ _
howToAccessLabel config _ os _ _ _
-- no PIC -> the dynamic linker does everything for us;
-- if we don't dynamically link to Haskell code,
-- it actually manages to do so without messing things up.
| osElfTarget os
, not (positionIndependent dflags) &&
not (gopt Opt_ExternalDynamicRefs dflags)
, not (ncgPIC config) &&
not (ncgExternalDynamicRefs config)
= AccessDirectly
howToAccessLabel dflags arch os this_mod DataReference lbl
howToAccessLabel config arch os this_mod DataReference lbl
| osElfTarget os
= case () of
-- A dynamic label needs to be accessed via a symbol pointer.
_ | labelDynamic dflags this_mod lbl
_ | labelDynamic config this_mod lbl
-> AccessViaSymbolPtr
-- For PowerPC32 -fPIC, we have to access even static data
-- via a symbol pointer (see below for an explanation why
-- PowerPC32 Linux is especially broken).
| arch == ArchPPC
, positionIndependent dflags
, ncgPIC config
-> AccessViaSymbolPtr
| otherwise
......@@ -378,26 +375,26 @@ howToAccessLabel dflags arch os this_mod DataReference lbl
-- (AccessDirectly, because we get an implicit symbol stub)
-- and calling functions from PIC code on non-i386 platforms (via a symbol stub)
howToAccessLabel dflags arch os this_mod CallReference lbl
howToAccessLabel config arch os this_mod CallReference lbl
| osElfTarget os
, labelDynamic dflags this_mod lbl && not (positionIndependent dflags)
, labelDynamic config this_mod lbl && not (ncgPIC config)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
, labelDynamic dflags this_mod lbl
, positionIndependent dflags
, labelDynamic config this_mod lbl
, ncgPIC config
= AccessViaStub
howToAccessLabel dflags _ os this_mod _ lbl
howToAccessLabel config _ os this_mod _ lbl
| osElfTarget os
= if labelDynamic dflags this_mod lbl
= if labelDynamic config this_mod lbl
then AccessViaSymbolPtr
else AccessDirectly
-- all other platforms
howToAccessLabel dflags _ _ _ _ _
| not (positionIndependent dflags)
howToAccessLabel config _ _ _ _ _
| not (ncgPIC config)
= AccessDirectly
| otherwise
......
......@@ -33,7 +33,7 @@ import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat
, getBlockIdNat, getPicBaseNat, getNewRegPairNat
, getPicBaseMaybeNat, getPlatform, initConfig
, getPicBaseMaybeNat, getPlatform, getConfig
)
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
......@@ -57,7 +57,6 @@ import GHC.Cmm.Dataflow.Graph
-- The rest:
import OrdList
import Outputable
import GHC.Driver.Session
import Control.Monad ( mapAndUnzipM, when )
import Data.Bits
......@@ -149,7 +148,7 @@ stmtsToInstrs stmts
stmtToInstrs :: CmmNode e x -> NatM InstrBlock
stmtToInstrs stmt = do
dflags <- getDynFlags
config <- getConfig
platform <- getPlatform
case stmt of
CmmComment s -> return (unitOL (COMMENT s))
......@@ -180,7 +179,7 @@ stmtToInstrs stmt = do
b1 <- genCondJump true arg prediction
b2 <- genBranch false
return (b1 `appOL` b2)
CmmSwitch arg ids -> genSwitch dflags arg ids
CmmSwitch arg ids -> genSwitch config arg ids
CmmCall { cml_target = arg
, cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs)
_ ->
......@@ -404,10 +403,10 @@ iselExpr64 expr
getRegister :: CmmExpr -> NatM Register
getRegister e = do dflags <- getDynFlags
getRegister' dflags (targetPlatform dflags) e
getRegister e = do config <- getConfig
getRegister' config (ncgPlatform config) e
getRegister' :: DynFlags -> Platform -> CmmExpr -> NatM Register
getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg))
| OSAIX <- platformOS platform = do
......@@ -424,8 +423,8 @@ getRegister' _ platform (CmmReg reg)
= return (Fixed (cmmTypeFormat (cmmRegType platform reg))
(getRegisterReg platform reg) nilOL)
getRegister' dflags platform tree@(CmmRegOff _ _)
= getRegister' dflags platform (mangleIndexTree platform tree)
getRegister' config platform tree@(CmmRegOff _ _)