Commit d4a0be75 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Move tablesNextToCode field into Platform

tablesNextToCode is a platform setting and doesn't belong into DynFlags
(#17957). Doing this is also a prerequisite to fix #14335 where we deal
with two platforms (target and host) that may have different platform
settings.
parent 2af0ec90
Pipeline #21302 failed with stages
in 994 minutes and 28 seconds
...@@ -545,7 +545,7 @@ checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool ...@@ -545,7 +545,7 @@ checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
checkBrokenTablesNextToCode' dflags checkBrokenTablesNextToCode' dflags
| not (isARM arch) = return False | not (isARM arch) = return False
| WayDyn `S.notMember` ways dflags = return False | WayDyn `S.notMember` ways dflags = return False
| not (tablesNextToCode dflags) = return False | not tablesNextToCode = return False
| otherwise = do | otherwise = do
linkerInfo <- liftIO $ getLinkerInfo dflags linkerInfo <- liftIO $ getLinkerInfo dflags
case linkerInfo of case linkerInfo of
...@@ -553,6 +553,7 @@ checkBrokenTablesNextToCode' dflags ...@@ -553,6 +553,7 @@ checkBrokenTablesNextToCode' dflags
_ -> return False _ -> return False
where platform = targetPlatform dflags where platform = targetPlatform dflags
arch = platformArch platform arch = platformArch platform
tablesNextToCode = platformTablesNextToCode platform
-- %************************************************************************ -- %************************************************************************
......
...@@ -11,6 +11,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where ...@@ -11,6 +11,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where
import GHC.Prelude import GHC.Prelude
import GHC.Platform
import GHC.ByteCode.Types import GHC.ByteCode.Types
import GHC.Runtime.Interpreter import GHC.Runtime.Interpreter
import GHC.Driver.Session import GHC.Driver.Session
...@@ -72,7 +73,8 @@ make_constr_itbls hsc_env cons = ...@@ -72,7 +73,8 @@ make_constr_itbls hsc_env cons =
descr = dataConIdentity dcon descr = dataConIdentity dcon
tables_next_to_code = tablesNextToCode dflags platform = targetPlatform dflags
tables_next_to_code = platformTablesNextToCode platform
r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really
conNo (tagForCon dflags dcon) descr) conNo (tagForCon dflags dcon) descr)
......
...@@ -124,7 +124,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks) ...@@ -124,7 +124,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
-- in the non-tables-next-to-code case, procs can have at most a -- in the non-tables-next-to-code case, procs can have at most a
-- single info table associated with the entry label of the proc. -- single info table associated with the entry label of the proc.
-- --
| not (tablesNextToCode dflags) | not (platformTablesNextToCode (targetPlatform dflags))
= case topInfoTable proc of -- must be at most one = case topInfoTable proc of -- must be at most one
-- no info table -- no info table
Nothing -> Nothing ->
...@@ -134,8 +134,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks) ...@@ -134,8 +134,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
(top_decls, (std_info, extra_bits)) <- (top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags info Nothing mkInfoTableContents dflags info Nothing
let let
rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info rel_std_info = map (makeRelativeRefTo platform info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
-- --
-- Separately emit info table (with the function entry -- Separately emit info table (with the function entry
-- point as first entry) and the entry code -- point as first entry) and the entry code
...@@ -159,13 +159,14 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks) ...@@ -159,13 +159,14 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
[CmmProc (mapFromList raw_infos) entry_lbl live blocks]) [CmmProc (mapFromList raw_infos) entry_lbl live blocks])
where where
platform = targetPlatform dflags
do_one_info (lbl,itbl) = do do_one_info (lbl,itbl) = do
(top_decls, (std_info, extra_bits)) <- (top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags itbl Nothing mkInfoTableContents dflags itbl Nothing
let let
info_lbl = cit_lbl itbl info_lbl = cit_lbl itbl
rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info rel_std_info = map (makeRelativeRefTo platform info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
-- --
return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $ return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info)) reverse rel_extra_bits ++ rel_std_info))
...@@ -195,7 +196,7 @@ mkInfoTableContents dflags ...@@ -195,7 +196,7 @@ mkInfoTableContents dflags
| StackRep frame <- smrep | StackRep frame <- smrep
= do { (prof_lits, prof_data) <- mkProfLits platform prof = do { (prof_lits, prof_data) <- mkProfLits platform prof
; let (srt_label, srt_bitmap) = mkSRTLit dflags info_lbl srt ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame ; (liveness_lit, liveness_data) <- mkLivenessBits dflags frame
; let ; let
std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
...@@ -208,7 +209,7 @@ mkInfoTableContents dflags ...@@ -208,7 +209,7 @@ mkInfoTableContents dflags
| HeapRep _ ptrs nonptrs closure_type <- smrep | HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packIntsCLit platform ptrs nonptrs = do { let layout = packIntsCLit platform ptrs nonptrs
; (prof_lits, prof_data) <- mkProfLits platform prof ; (prof_lits, prof_data) <- mkProfLits platform prof
; let (srt_label, srt_bitmap) = mkSRTLit dflags info_lbl srt ; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
; (mb_srt_field, mb_layout, extra_bits, ct_data) ; (mb_srt_field, mb_layout, extra_bits, ct_data)
<- mk_pieces closure_type srt_label <- mk_pieces closure_type srt_label
; let std_info = mkStdInfoTable dflags prof_lits ; let std_info = mkStdInfoTable dflags prof_lits
...@@ -246,7 +247,7 @@ mkInfoTableContents dflags ...@@ -246,7 +247,7 @@ mkInfoTableContents dflags
; let fun_type | null liveness_data = aRG_GEN ; let fun_type | null liveness_data = aRG_GEN
| otherwise = aRG_GEN_BIG | otherwise = aRG_GEN_BIG
extra_bits = [ packIntsCLit platform fun_type arity ] extra_bits = [ packIntsCLit platform fun_type arity ]
++ (if inlineSRT dflags then [] else [ srt_lit ]) ++ (if inlineSRT platform then [] else [ srt_lit ])
++ [ liveness_lit, slow_entry ] ++ [ liveness_lit, slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) } ; return (Nothing, Nothing, extra_bits, liveness_data) }
where where
...@@ -265,25 +266,25 @@ packIntsCLit platform a b = packHalfWordsCLit platform ...@@ -265,25 +266,25 @@ packIntsCLit platform a b = packHalfWordsCLit platform
(toStgHalfWord platform (fromIntegral b)) (toStgHalfWord platform (fromIntegral b))
mkSRTLit :: DynFlags mkSRTLit :: Platform
-> CLabel -> CLabel
-> Maybe CLabel -> Maybe CLabel
-> ([CmmLit], -- srt_label, if any -> ([CmmLit], -- srt_label, if any
CmmLit) -- srt_bitmap CmmLit) -- srt_bitmap
mkSRTLit dflags info_lbl (Just lbl) mkSRTLit platform info_lbl (Just lbl)
| inlineSRT dflags | inlineSRT platform
= ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth (targetPlatform dflags))) = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth platform))
mkSRTLit dflags _ Nothing = ([], CmmInt 0 (halfWordWidth (targetPlatform dflags))) mkSRTLit platform _ Nothing = ([], CmmInt 0 (halfWordWidth platform))
mkSRTLit dflags _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth (targetPlatform dflags))) mkSRTLit platform _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth platform))
-- | Is the SRT offset field inline in the info table on this platform? -- | Is the SRT offset field inline in the info table on this platform?
-- --
-- See the section "Referring to an SRT from the info table" in -- See the section "Referring to an SRT from the info table" in
-- Note [SRTs] in GHC.Cmm.Info.Build -- Note [SRTs] in GHC.Cmm.Info.Build
inlineSRT :: DynFlags -> Bool inlineSRT :: Platform -> Bool
inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64 inlineSRT platform = platformArch platform == ArchX86_64
&& tablesNextToCode dflags && platformTablesNextToCode platform
------------------------------------------------------------------------- -------------------------------------------------------------------------
-- --
...@@ -311,16 +312,14 @@ inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64 ...@@ -311,16 +312,14 @@ inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64
-- Note that this is done even when the -fPIC flag is not specified, -- Note that this is done even when the -fPIC flag is not specified,
-- as we want to keep binary compatibility between PIC and non-PIC. -- as we want to keep binary compatibility between PIC and non-PIC.
makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo platform info_lbl lit
makeRelativeRefTo dflags info_lbl (CmmLabel lbl) = if platformTablesNextToCode platform
| tablesNextToCode dflags then case lit of
= CmmLabelDiffOff lbl info_lbl 0 (wordWidth (targetPlatform dflags)) CmmLabel lbl -> CmmLabelDiffOff lbl info_lbl 0 (wordWidth platform)
makeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off) CmmLabelOff lbl off -> CmmLabelDiffOff lbl info_lbl off (wordWidth platform)
| tablesNextToCode dflags _ -> lit
= CmmLabelDiffOff lbl info_lbl off (wordWidth (targetPlatform dflags)) else lit
makeRelativeRefTo _ _ lit = lit
------------------------------------------------------------------------- -------------------------------------------------------------------------
-- --
...@@ -457,12 +456,13 @@ closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr ...@@ -457,12 +456,13 @@ closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr
closureInfoPtr dflags e = closureInfoPtr dflags e =
CmmLoad (wordAligned dflags e) (bWord (targetPlatform dflags)) CmmLoad (wordAligned dflags e) (bWord (targetPlatform dflags))
entryCode :: DynFlags -> CmmExpr -> CmmExpr -- | Takes an info pointer (the first word of a closure) and returns its entry
-- Takes an info pointer (the first word of a closure) -- code
-- and returns its entry code entryCode :: Platform -> CmmExpr -> CmmExpr
entryCode dflags e entryCode platform e =
| tablesNextToCode dflags = e if platformTablesNextToCode platform
| otherwise = CmmLoad e (bWord (targetPlatform dflags)) then e
else CmmLoad e (bWord platform)
getConstrTag :: DynFlags -> CmmExpr -> CmmExpr getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the *zero-indexed* -- Takes a closure pointer, and return the *zero-indexed*
...@@ -489,8 +489,8 @@ infoTable :: DynFlags -> CmmExpr -> CmmExpr ...@@ -489,8 +489,8 @@ infoTable :: DynFlags -> CmmExpr -> CmmExpr
-- and returns a pointer to the first word of the standard-form -- and returns a pointer to the first word of the standard-form
-- info table, excluding the entry-code word (if present) -- info table, excluding the entry-code word (if present)
infoTable dflags info_ptr infoTable dflags info_ptr
| tablesNextToCode dflags = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags) | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags)
| otherwise = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer | otherwise = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer
where platform = targetPlatform dflags where platform = targetPlatform dflags
infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr
...@@ -527,7 +527,7 @@ funInfoTable :: DynFlags -> CmmExpr -> CmmExpr ...@@ -527,7 +527,7 @@ funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- and returns a pointer to the first word of the StgFunInfoExtra struct -- and returns a pointer to the first word of the StgFunInfoExtra struct
-- in the info table. -- in the info table.
funInfoTable dflags info_ptr funInfoTable dflags info_ptr
| tablesNextToCode dflags | platformTablesNextToCode platform
= cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags) = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags)
| otherwise | otherwise
= cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW dflags) = cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW dflags)
...@@ -543,12 +543,13 @@ funInfoArity dflags iptr ...@@ -543,12 +543,13 @@ funInfoArity dflags iptr
platform = targetPlatform dflags platform = targetPlatform dflags
fun_info = funInfoTable dflags iptr fun_info = funInfoTable dflags iptr
rep = cmmBits (widthFromBytes rep_bytes) rep = cmmBits (widthFromBytes rep_bytes)
tablesNextToCode = platformTablesNextToCode platform
(rep_bytes, offset) (rep_bytes, offset)
| tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraRev_arity pc | tablesNextToCode = ( pc_REP_StgFunInfoExtraRev_arity pc
, oFFSET_StgFunInfoExtraRev_arity dflags ) , oFFSET_StgFunInfoExtraRev_arity dflags )
| otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
, oFFSET_StgFunInfoExtraFwd_arity dflags ) , oFFSET_StgFunInfoExtraFwd_arity dflags )
pc = platformConstants dflags pc = platformConstants dflags
......
...@@ -1164,7 +1164,7 @@ lowerSafeForeignCall dflags block ...@@ -1164,7 +1164,7 @@ lowerSafeForeignCall dflags block
-- received an exception during the call, then the stack might be -- received an exception during the call, then the stack might be
-- different. Hence we continue by jumping to the top stack frame, -- different. Hence we continue by jumping to the top stack frame,
-- not by jumping to succ. -- not by jumping to succ.
jump = CmmCall { cml_target = entryCode dflags $ jump = CmmCall { cml_target = entryCode platform $
CmmLoad spExpr (bWord platform) CmmLoad spExpr (bWord platform)
, cml_cont = Just succ , cml_cont = Just succ
, cml_args_regs = regs , cml_args_regs = regs
......
...@@ -909,17 +909,18 @@ exprOp name args_code = do ...@@ -909,17 +909,18 @@ exprOp name args_code = do
exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr) exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr)
exprMacros dflags = listToUFM [ exprMacros dflags = listToUFM [
( fsLit "ENTRY_CODE", \ [x] -> entryCode dflags x ), ( fsLit "ENTRY_CODE", \ [x] -> entryCode platform x ),
( fsLit "INFO_PTR", \ [x] -> closureInfoPtr dflags x ), ( fsLit "INFO_PTR", \ [x] -> closureInfoPtr dflags x ),
( fsLit "STD_INFO", \ [x] -> infoTable dflags x ), ( fsLit "STD_INFO", \ [x] -> infoTable dflags x ),
( fsLit "FUN_INFO", \ [x] -> funInfoTable dflags x ), ( fsLit "FUN_INFO", \ [x] -> funInfoTable dflags x ),
( fsLit "GET_ENTRY", \ [x] -> entryCode dflags (closureInfoPtr dflags x) ), ( fsLit "GET_ENTRY", \ [x] -> entryCode platform (closureInfoPtr dflags x) ),
( fsLit "GET_STD_INFO", \ [x] -> infoTable dflags (closureInfoPtr dflags x) ), ( fsLit "GET_STD_INFO", \ [x] -> infoTable dflags (closureInfoPtr dflags x) ),
( fsLit "GET_FUN_INFO", \ [x] -> funInfoTable dflags (closureInfoPtr dflags x) ), ( fsLit "GET_FUN_INFO", \ [x] -> funInfoTable dflags (closureInfoPtr dflags x) ),
( fsLit "INFO_TYPE", \ [x] -> infoTableClosureType dflags x ), ( fsLit "INFO_TYPE", \ [x] -> infoTableClosureType dflags x ),
( fsLit "INFO_PTRS", \ [x] -> infoTablePtrs dflags x ), ( fsLit "INFO_PTRS", \ [x] -> infoTablePtrs dflags x ),
( fsLit "INFO_NPTRS", \ [x] -> infoTableNonPtrs dflags x ) ( fsLit "INFO_NPTRS", \ [x] -> infoTableNonPtrs dflags x )
] ]
where platform = targetPlatform dflags
-- we understand a subset of C-- primitives: -- we understand a subset of C-- primitives:
machOps = listToUFM $ machOps = listToUFM $
...@@ -1213,7 +1214,7 @@ doReturn exprs_code = do ...@@ -1213,7 +1214,7 @@ doReturn exprs_code = do
mkReturnSimple :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph mkReturnSimple :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturnSimple dflags actuals updfr_off = mkReturnSimple dflags actuals updfr_off =
mkReturn dflags e actuals updfr_off mkReturn dflags e actuals updfr_off
where e = entryCode dflags (CmmLoad (CmmStackSlot Old updfr_off) where e = entryCode platform (CmmLoad (CmmStackSlot Old updfr_off)
(gcWord platform)) (gcWord platform))
platform = targetPlatform dflags platform = targetPlatform dflags
......
...@@ -172,7 +172,7 @@ cpsTop hsc_env proc = ...@@ -172,7 +172,7 @@ cpsTop hsc_env proc =
-- label to put on info tables for basic blocks that are not -- label to put on info tables for basic blocks that are not
-- the entry point. -- the entry point.
splitting_proc_points = hscTarget dflags /= HscAsm splitting_proc_points = hscTarget dflags /= HscAsm
|| not (tablesNextToCode dflags) || not (platformTablesNextToCode platform)
|| -- Note [inconsistent-pic-reg] || -- Note [inconsistent-pic-reg]
usingInconsistentPicReg usingInconsistentPicReg
usingInconsistentPicReg usingInconsistentPicReg
......
...@@ -315,10 +315,12 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap ...@@ -315,10 +315,12 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
-- when jumping to a PP that has an info table, if -- when jumping to a PP that has an info table, if
-- tablesNextToCode is off we must jump to the entry -- tablesNextToCode is off we must jump to the entry
-- label instead. -- label instead.
platform = targetPlatform dflags
tablesNextToCode = platformTablesNextToCode platform
jump_label (Just info_lbl) _ jump_label (Just info_lbl) _
| tablesNextToCode dflags = info_lbl | tablesNextToCode = info_lbl
| otherwise = toEntryLbl info_lbl | otherwise = toEntryLbl info_lbl
jump_label Nothing block_lbl = block_lbl jump_label Nothing block_lbl = block_lbl
add_if_pp id rst = case mapLookup id procLabels of add_if_pp id rst = case mapLookup id procLabels of
Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst
......
...@@ -183,8 +183,8 @@ pprGloblDecl lbl ...@@ -183,8 +183,8 @@ pprGloblDecl lbl
| not (externallyVisibleCLabel lbl) = empty | not (externallyVisibleCLabel lbl) = empty
| otherwise = text ".globl " <> ppr lbl | otherwise = text ".globl " <> ppr lbl
pprLabelType' :: DynFlags -> CLabel -> SDoc pprLabelType' :: Platform -> CLabel -> SDoc
pprLabelType' dflags lbl = pprLabelType' platform lbl =
if isCFunctionLabel lbl || functionOkInfoTable then if isCFunctionLabel lbl || functionOkInfoTable then
text "@function" text "@function"
else else
...@@ -237,16 +237,14 @@ pprLabelType' dflags lbl = ...@@ -237,16 +237,14 @@ pprLabelType' dflags lbl =
every code-like thing to give the needed information for to the tools every code-like thing to give the needed information for to the tools
but mess up with the relocation. https://phabricator.haskell.org/D4730 but mess up with the relocation. https://phabricator.haskell.org/D4730
-} -}
functionOkInfoTable = tablesNextToCode dflags && functionOkInfoTable = platformTablesNextToCode platform &&
isInfoTableLabel lbl && not (isConInfoTableLabel lbl) isInfoTableLabel lbl && not (isConInfoTableLabel lbl)
pprTypeDecl :: Platform -> CLabel -> SDoc pprTypeDecl :: Platform -> CLabel -> SDoc
pprTypeDecl platform lbl pprTypeDecl platform lbl
= if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
then then text ".type " <> ppr lbl <> ptext (sLit ", ") <> pprLabelType' platform lbl
sdocWithDynFlags $ \df ->
text ".type " <> ppr lbl <> ptext (sLit ", ") <> pprLabelType' df lbl
else empty else empty
pprLabel :: Platform -> CLabel -> SDoc pprLabel :: Platform -> CLabel -> SDoc
......
...@@ -132,7 +132,6 @@ module GHC.Driver.Session ( ...@@ -132,7 +132,6 @@ module GHC.Driver.Session (
sGhcWithNativeCodeGen, sGhcWithNativeCodeGen,
sGhcWithSMP, sGhcWithSMP,
sGhcRTSWays, sGhcRTSWays,
sTablesNextToCode,
sLibFFI, sLibFFI,
sGhcThreaded, sGhcThreaded,
sGhcDebugged, sGhcDebugged,
...@@ -151,7 +150,6 @@ module GHC.Driver.Session ( ...@@ -151,7 +150,6 @@ module GHC.Driver.Session (
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_i,
opt_P_signature, opt_P_signature,
opt_windres, opt_lo, opt_lc, opt_lcc, opt_windres, opt_lo, opt_lc, opt_lcc,
tablesNextToCode,
-- ** Manipulating DynFlags -- ** Manipulating DynFlags
addPluginModuleName, addPluginModuleName,
...@@ -993,9 +991,6 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags ...@@ -993,9 +991,6 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
opt_i :: DynFlags -> [String] opt_i :: DynFlags -> [String]
opt_i dflags= toolSettings_opt_i $ toolSettings dflags opt_i dflags= toolSettings_opt_i $ toolSettings dflags
tablesNextToCode :: DynFlags -> Bool
tablesNextToCode = platformMisc_tablesNextToCode . platformMisc
-- | The directory for this version of ghc in the user's app directory -- | The directory for this version of ghc in the user's app directory
-- (typically something like @~/.ghc/x86_64-linux-7.6.3@) -- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
-- --
......
...@@ -59,7 +59,6 @@ module GHC.Settings ...@@ -59,7 +59,6 @@ module GHC.Settings
, sGhcWithNativeCodeGen , sGhcWithNativeCodeGen
, sGhcWithSMP , sGhcWithSMP
, sGhcRTSWays , sGhcRTSWays
, sTablesNextToCode
, sLibFFI , sLibFFI
, sGhcThreaded , sGhcThreaded
, sGhcDebugged , sGhcDebugged
...@@ -268,8 +267,6 @@ sGhcWithSMP :: Settings -> Bool ...@@ -268,8 +267,6 @@ sGhcWithSMP :: Settings -> Bool
sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc
sGhcRTSWays :: Settings -> String sGhcRTSWays :: Settings -> String
sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc
sTablesNextToCode :: Settings -> Bool
sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc
sLibFFI :: Settings -> Bool sLibFFI :: Settings -> Bool
sLibFFI = platformMisc_libFFI . sPlatformMisc sLibFFI = platformMisc_libFFI . sPlatformMisc
sGhcThreaded :: Settings -> Bool sGhcThreaded :: Settings -> Bool
......
...@@ -78,7 +78,6 @@ initSettings top_dir = do ...@@ -78,7 +78,6 @@ initSettings top_dir = do
getBooleanSetting key = either pgmError pure $ getBooleanSetting key = either pgmError pure $
getBooleanSetting0 settingsFile mySettings key getBooleanSetting0 settingsFile mySettings key
targetPlatformString <- getSetting "target platform string" targetPlatformString <- getSetting "target platform string"
tablesNextToCode <- getBooleanSetting "Tables next to code"
myExtraGccViaCFlags <- getSetting "GCC extra via C opts" myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
-- On Windows, mingw is distributed with GHC, -- On Windows, mingw is distributed with GHC,
-- so we look in TopDir/../mingw/bin, -- so we look in TopDir/../mingw/bin,
...@@ -220,7 +219,6 @@ initSettings top_dir = do ...@@ -220,7 +219,6 @@ initSettings top_dir = do
, platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
, platformMisc_ghcWithSMP = ghcWithSMP , platformMisc_ghcWithSMP = ghcWithSMP
, platformMisc_ghcRTSWays = ghcRTSWays , platformMisc_ghcRTSWays = ghcRTSWays
, platformMisc_tablesNextToCode = tablesNextToCode
, platformMisc_libFFI = useLibFFI , platformMisc_libFFI = useLibFFI
, platformMisc_ghcThreaded = ghcThreaded , platformMisc_ghcThreaded = ghcThreaded
, platformMisc_ghcDebugged = ghcDebugged , platformMisc_ghcDebugged = ghcDebugged
......
...@@ -552,7 +552,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node' ...@@ -552,7 +552,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
platform <- getPlatform platform <- getPlatform
let node = idToReg platform (NonVoid bndr) let node = idToReg platform (NonVoid bndr)
slow_lbl = closureSlowEntryLabel cl_info slow_lbl = closureSlowEntryLabel cl_info
fast_lbl = closureLocalEntryLabel dflags cl_info fast_lbl = closureLocalEntryLabel platform cl_info
-- mkDirectJump does not clobber `Node' containing function closure -- mkDirectJump does not clobber `Node' containing function closure
jump = mkJump dflags NativeNodeCall jump = mkJump dflags NativeNodeCall
(mkLblExpr fast_lbl) (mkLblExpr fast_lbl)
...@@ -727,7 +727,7 @@ link_caf node = do ...@@ -727,7 +727,7 @@ link_caf node = do
-- see Note [atomic CAF entry] in rts/sm/Storage.c -- see Note [atomic CAF entry] in rts/sm/Storage.c
; updfr <- getUpdFrameOff ; updfr <- getUpdFrameOff
; let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node))) ; let target = entryCode platform (closureInfoPtr dflags (CmmReg (CmmLocal node)))
; emit =<< mkCmmIfThen ; emit =<< mkCmmIfThen
(cmmEqWord platform (CmmReg (CmmLocal bh)) (zeroExpr platform)) (cmmEqWord platform (CmmReg (CmmLocal bh)) (zeroExpr platform))
-- re-enter the CAF -- re-enter the CAF
......
...@@ -65,6 +65,7 @@ module GHC.StgToCmm.Closure ( ...@@ -65,6 +65,7 @@ module GHC.StgToCmm.Closure (
#include "HsVersions.h" #include "HsVersions.h"
import GHC.Prelude import GHC.Prelude
import GHC.Platform
import GHC.Stg.Syntax import GHC.Stg.Syntax
import GHC.Runtime.Heap.Layout import GHC.Runtime.Heap.Layout
...@@ -511,7 +512,7 @@ getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc ...@@ -511,7 +512,7 @@ getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
-- See Note [Evaluating functions with profiling] in rts/Apply.cmm -- See Note [Evaluating functions with profiling] in rts/Apply.cmm
= ASSERT( arity /= 0 ) ReturnIt = ASSERT( arity /= 0 ) ReturnIt
| n_args < arity = SlowCall -- Not enough args | n_args < arity = SlowCall -- Not enough args
| otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity | otherwise = DirectEntry (enterIdLabel (targetPlatform dflags) name (idCafInfo id)) arity
getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info
= ASSERT( n_args == 0 ) ReturnIt = ASSERT( n_args == 0 ) ReturnIt
...@@ -781,10 +782,10 @@ staticClosureLabel = toClosureLbl . closureInfoLabel ...@@ -781,10 +782,10 @@ staticClosureLabel = toClosureLbl . closureInfoLabel
closureSlowEntryLabel :: ClosureInfo -> CLabel closureSlowEntryLabel :: ClosureInfo -> CLabel
closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
closureLocalEntryLabel dflags closureLocalEntryLabel platform
| tablesNextToCode dflags = toInfoLbl . closureInfoLabel | platformTablesNextToCode platform = toInfoLbl . closureInfoLabel