[Git][ghc/ghc][master] Move tablesNextToCode field into Platform
Marge Bot
gitlab at gitlab.haskell.org
Fri Jun 19 03:08:50 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00
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.
- - - - -
17 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/LayoutStack.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/ProcPoint.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Layout.hs
- libraries/ghc-boot/GHC/Platform.hs
- libraries/ghc-boot/GHC/Settings/Platform.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -545,7 +545,7 @@ checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
checkBrokenTablesNextToCode' dflags
| not (isARM arch) = return False
| WayDyn `S.notMember` ways dflags = return False
- | not (tablesNextToCode dflags) = return False
+ | not tablesNextToCode = return False
| otherwise = do
linkerInfo <- liftIO $ getLinkerInfo dflags
case linkerInfo of
@@ -553,6 +553,7 @@ checkBrokenTablesNextToCode' dflags
_ -> return False
where platform = targetPlatform dflags
arch = platformArch platform
+ tablesNextToCode = platformTablesNextToCode platform
-- %************************************************************************
=====================================
compiler/GHC/ByteCode/InfoTable.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where
import GHC.Prelude
+import GHC.Platform
import GHC.ByteCode.Types
import GHC.Runtime.Interpreter
import GHC.Driver.Session
@@ -72,7 +73,8 @@ make_constr_itbls hsc_env cons =
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
conNo (tagForCon dflags dcon) descr)
=====================================
compiler/GHC/Cmm/Info.hs
=====================================
@@ -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
-- 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
-- no info table
Nothing ->
@@ -134,8 +134,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
(top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags info Nothing
let
- rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
- rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
+ rel_std_info = map (makeRelativeRefTo platform info_lbl) std_info
+ rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
--
-- Separately emit info table (with the function entry
-- point as first entry) and the entry code
@@ -159,13 +159,14 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
[CmmProc (mapFromList raw_infos) entry_lbl live blocks])
where
+ platform = targetPlatform dflags
do_one_info (lbl,itbl) = do
(top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags itbl Nothing
let
info_lbl = cit_lbl itbl
- rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
- rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
+ rel_std_info = map (makeRelativeRefTo platform info_lbl) std_info
+ rel_extra_bits = map (makeRelativeRefTo platform info_lbl) extra_bits
--
return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info))
@@ -195,7 +196,7 @@ mkInfoTableContents dflags
| StackRep frame <- smrep
= 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
; let
std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
@@ -208,7 +209,7 @@ mkInfoTableContents dflags
| HeapRep _ ptrs nonptrs closure_type <- smrep
= do { let layout = packIntsCLit platform ptrs nonptrs
; (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)
<- mk_pieces closure_type srt_label
; let std_info = mkStdInfoTable dflags prof_lits
@@ -246,7 +247,7 @@ mkInfoTableContents dflags
; let fun_type | null liveness_data = aRG_GEN
| otherwise = aRG_GEN_BIG
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 ]
; return (Nothing, Nothing, extra_bits, liveness_data) }
where
@@ -265,25 +266,25 @@ packIntsCLit platform a b = packHalfWordsCLit platform
(toStgHalfWord platform (fromIntegral b))
-mkSRTLit :: DynFlags
+mkSRTLit :: Platform
-> CLabel
-> Maybe CLabel
-> ([CmmLit], -- srt_label, if any
CmmLit) -- srt_bitmap
-mkSRTLit dflags info_lbl (Just lbl)
- | inlineSRT dflags
- = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth (targetPlatform dflags)))
-mkSRTLit dflags _ Nothing = ([], CmmInt 0 (halfWordWidth (targetPlatform dflags)))
-mkSRTLit dflags _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth (targetPlatform dflags)))
+mkSRTLit platform info_lbl (Just lbl)
+ | inlineSRT platform
+ = ([], CmmLabelDiffOff lbl info_lbl 0 (halfWordWidth platform))
+mkSRTLit platform _ Nothing = ([], CmmInt 0 (halfWordWidth platform))
+mkSRTLit platform _ (Just lbl) = ([CmmLabel lbl], CmmInt 1 (halfWordWidth 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
-- Note [SRTs] in GHC.Cmm.Info.Build
-inlineSRT :: DynFlags -> Bool
-inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64
- && tablesNextToCode dflags
+inlineSRT :: Platform -> Bool
+inlineSRT platform = platformArch platform == ArchX86_64
+ && platformTablesNextToCode platform
-------------------------------------------------------------------------
--
@@ -311,16 +312,14 @@ inlineSRT dflags = platformArch (targetPlatform dflags) == ArchX86_64
-- 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.
-makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit
-
-makeRelativeRefTo dflags info_lbl (CmmLabel lbl)
- | tablesNextToCode dflags
- = CmmLabelDiffOff lbl info_lbl 0 (wordWidth (targetPlatform dflags))
-makeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off)
- | tablesNextToCode dflags
- = CmmLabelDiffOff lbl info_lbl off (wordWidth (targetPlatform dflags))
-makeRelativeRefTo _ _ lit = lit
-
+makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
+makeRelativeRefTo platform info_lbl lit
+ = if platformTablesNextToCode platform
+ then case lit of
+ CmmLabel lbl -> CmmLabelDiffOff lbl info_lbl 0 (wordWidth platform)
+ CmmLabelOff lbl off -> CmmLabelDiffOff lbl info_lbl off (wordWidth platform)
+ _ -> lit
+ else lit
-------------------------------------------------------------------------
--
@@ -457,12 +456,13 @@ closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr
closureInfoPtr dflags e =
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 code
-entryCode dflags e
- | tablesNextToCode dflags = e
- | otherwise = CmmLoad e (bWord (targetPlatform dflags))
+-- | Takes an info pointer (the first word of a closure) and returns its entry
+-- code
+entryCode :: Platform -> CmmExpr -> CmmExpr
+entryCode platform e =
+ if platformTablesNextToCode platform
+ then e
+ else CmmLoad e (bWord platform)
getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the *zero-indexed*
@@ -489,8 +489,8 @@ infoTable :: DynFlags -> CmmExpr -> CmmExpr
-- and returns a pointer to the first word of the standard-form
-- info table, excluding the entry-code word (if present)
infoTable dflags info_ptr
- | tablesNextToCode dflags = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags)
- | otherwise = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer
+ | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags)
+ | otherwise = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer
where platform = targetPlatform dflags
infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr
@@ -527,7 +527,7 @@ funInfoTable :: DynFlags -> CmmExpr -> CmmExpr
-- and returns a pointer to the first word of the StgFunInfoExtra struct
-- in the info table.
funInfoTable dflags info_ptr
- | tablesNextToCode dflags
+ | platformTablesNextToCode platform
= cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags)
| otherwise
= cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW dflags)
@@ -543,12 +543,13 @@ funInfoArity dflags iptr
platform = targetPlatform dflags
fun_info = funInfoTable dflags iptr
rep = cmmBits (widthFromBytes rep_bytes)
+ tablesNextToCode = platformTablesNextToCode platform
(rep_bytes, offset)
- | tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraRev_arity pc
- , oFFSET_StgFunInfoExtraRev_arity dflags )
- | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
- , oFFSET_StgFunInfoExtraFwd_arity dflags )
+ | tablesNextToCode = ( pc_REP_StgFunInfoExtraRev_arity pc
+ , oFFSET_StgFunInfoExtraRev_arity dflags )
+ | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc
+ , oFFSET_StgFunInfoExtraFwd_arity dflags )
pc = platformConstants dflags
=====================================
compiler/GHC/Cmm/LayoutStack.hs
=====================================
@@ -1164,7 +1164,7 @@ lowerSafeForeignCall dflags block
-- received an exception during the call, then the stack might be
-- different. Hence we continue by jumping to the top stack frame,
-- not by jumping to succ.
- jump = CmmCall { cml_target = entryCode dflags $
+ jump = CmmCall { cml_target = entryCode platform $
CmmLoad spExpr (bWord platform)
, cml_cont = Just succ
, cml_args_regs = regs
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -909,17 +909,18 @@ exprOp name args_code = do
exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr)
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 "STD_INFO", \ [x] -> infoTable 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_FUN_INFO", \ [x] -> funInfoTable dflags (closureInfoPtr dflags x) ),
( fsLit "INFO_TYPE", \ [x] -> infoTableClosureType dflags x ),
( fsLit "INFO_PTRS", \ [x] -> infoTablePtrs dflags x ),
( fsLit "INFO_NPTRS", \ [x] -> infoTableNonPtrs dflags x )
]
+ where platform = targetPlatform dflags
-- we understand a subset of C-- primitives:
machOps = listToUFM $
@@ -1213,7 +1214,7 @@ doReturn exprs_code = do
mkReturnSimple :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturnSimple dflags 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))
platform = targetPlatform dflags
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -172,7 +172,7 @@ cpsTop hsc_env proc =
-- label to put on info tables for basic blocks that are not
-- the entry point.
splitting_proc_points = hscTarget dflags /= HscAsm
- || not (tablesNextToCode dflags)
+ || not (platformTablesNextToCode platform)
|| -- Note [inconsistent-pic-reg]
usingInconsistentPicReg
usingInconsistentPicReg
=====================================
compiler/GHC/Cmm/ProcPoint.hs
=====================================
@@ -315,10 +315,12 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
-- when jumping to a PP that has an info table, if
-- tablesNextToCode is off we must jump to the entry
-- label instead.
+ platform = targetPlatform dflags
+ tablesNextToCode = platformTablesNextToCode platform
jump_label (Just info_lbl) _
- | tablesNextToCode dflags = info_lbl
- | otherwise = toEntryLbl info_lbl
- jump_label Nothing block_lbl = block_lbl
+ | tablesNextToCode = info_lbl
+ | otherwise = toEntryLbl info_lbl
+ jump_label Nothing block_lbl = block_lbl
add_if_pp id rst = case mapLookup id procLabels of
Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -183,8 +183,8 @@ pprGloblDecl lbl
| not (externallyVisibleCLabel lbl) = empty
| otherwise = text ".globl " <> ppr lbl
-pprLabelType' :: DynFlags -> CLabel -> SDoc
-pprLabelType' dflags lbl =
+pprLabelType' :: Platform -> CLabel -> SDoc
+pprLabelType' platform lbl =
if isCFunctionLabel lbl || functionOkInfoTable then
text "@function"
else
@@ -237,16 +237,14 @@ pprLabelType' dflags lbl =
every code-like thing to give the needed information for to the tools
but mess up with the relocation. https://phabricator.haskell.org/D4730
-}
- functionOkInfoTable = tablesNextToCode dflags &&
+ functionOkInfoTable = platformTablesNextToCode platform &&
isInfoTableLabel lbl && not (isConInfoTableLabel lbl)
pprTypeDecl :: Platform -> CLabel -> SDoc
pprTypeDecl platform lbl
= if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
- then
- sdocWithDynFlags $ \df ->
- text ".type " <> ppr lbl <> ptext (sLit ", ") <> pprLabelType' df lbl
+ then text ".type " <> ppr lbl <> ptext (sLit ", ") <> pprLabelType' platform lbl
else empty
pprLabel :: Platform -> CLabel -> SDoc
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -132,7 +132,6 @@ module GHC.Driver.Session (
sGhcWithNativeCodeGen,
sGhcWithSMP,
sGhcRTSWays,
- sTablesNextToCode,
sLibFFI,
sGhcThreaded,
sGhcDebugged,
@@ -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_P_signature,
opt_windres, opt_lo, opt_lc, opt_lcc,
- tablesNextToCode,
-- ** Manipulating DynFlags
addPluginModuleName,
@@ -993,9 +991,6 @@ opt_lc dflags= toolSettings_opt_lc $ toolSettings dflags
opt_i :: DynFlags -> [String]
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
-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
--
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -59,7 +59,6 @@ module GHC.Settings
, sGhcWithNativeCodeGen
, sGhcWithSMP
, sGhcRTSWays
- , sTablesNextToCode
, sLibFFI
, sGhcThreaded
, sGhcDebugged
@@ -268,8 +267,6 @@ sGhcWithSMP :: Settings -> Bool
sGhcWithSMP = platformMisc_ghcWithSMP . sPlatformMisc
sGhcRTSWays :: Settings -> String
sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc
-sTablesNextToCode :: Settings -> Bool
-sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc
sLibFFI :: Settings -> Bool
sLibFFI = platformMisc_libFFI . sPlatformMisc
sGhcThreaded :: Settings -> Bool
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -78,7 +78,6 @@ initSettings top_dir = do
getBooleanSetting key = either pgmError pure $
getBooleanSetting0 settingsFile mySettings key
targetPlatformString <- getSetting "target platform string"
- tablesNextToCode <- getBooleanSetting "Tables next to code"
myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
-- On Windows, mingw is distributed with GHC,
-- so we look in TopDir/../mingw/bin,
@@ -220,7 +219,6 @@ initSettings top_dir = do
, platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
, platformMisc_ghcWithSMP = ghcWithSMP
, platformMisc_ghcRTSWays = ghcRTSWays
- , platformMisc_tablesNextToCode = tablesNextToCode
, platformMisc_libFFI = useLibFFI
, platformMisc_ghcThreaded = ghcThreaded
, platformMisc_ghcDebugged = ghcDebugged
=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -552,7 +552,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
platform <- getPlatform
let node = idToReg platform (NonVoid bndr)
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
jump = mkJump dflags NativeNodeCall
(mkLblExpr fast_lbl)
@@ -727,7 +727,7 @@ link_caf node = do
-- see Note [atomic CAF entry] in rts/sm/Storage.c
; updfr <- getUpdFrameOff
- ; let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node)))
+ ; let target = entryCode platform (closureInfoPtr dflags (CmmReg (CmmLocal node)))
; emit =<< mkCmmIfThen
(cmmEqWord platform (CmmReg (CmmLocal bh)) (zeroExpr platform))
-- re-enter the CAF
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -65,6 +65,7 @@ module GHC.StgToCmm.Closure (
#include "HsVersions.h"
import GHC.Prelude
+import GHC.Platform
import GHC.Stg.Syntax
import GHC.Runtime.Heap.Layout
@@ -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
= ASSERT( arity /= 0 ) ReturnIt
| 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
= ASSERT( n_args == 0 ) ReturnIt
@@ -781,10 +782,10 @@ staticClosureLabel = toClosureLbl . closureInfoLabel
closureSlowEntryLabel :: ClosureInfo -> CLabel
closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
-closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel
-closureLocalEntryLabel dflags
- | tablesNextToCode dflags = toInfoLbl . closureInfoLabel
- | otherwise = toEntryLbl . closureInfoLabel
+closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
+closureLocalEntryLabel platform
+ | platformTablesNextToCode platform = toInfoLbl . closureInfoLabel
+ | otherwise = toEntryLbl . closureInfoLabel
mkClosureInfoTableLabel :: DynFlags -> Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel dflags id lf_info
@@ -821,22 +822,26 @@ thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag
thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag
= enterSelectorLabel dflags upd_flag offset
thunkEntryLabel dflags thunk_id c _ _
- = enterIdLabel dflags thunk_id c
+ = enterIdLabel (targetPlatform dflags) thunk_id c
enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
enterApLabel dflags is_updatable arity
- | tablesNextToCode dflags = mkApInfoTableLabel dflags is_updatable arity
- | otherwise = mkApEntryLabel dflags is_updatable arity
+ | platformTablesNextToCode platform = mkApInfoTableLabel dflags is_updatable arity
+ | otherwise = mkApEntryLabel dflags is_updatable arity
+ where
+ platform = targetPlatform dflags
enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
enterSelectorLabel dflags upd_flag offset
- | tablesNextToCode dflags = mkSelectorInfoLabel dflags upd_flag offset
- | otherwise = mkSelectorEntryLabel dflags upd_flag offset
+ | platformTablesNextToCode platform = mkSelectorInfoLabel dflags upd_flag offset
+ | otherwise = mkSelectorEntryLabel dflags upd_flag offset
+ where
+ platform = targetPlatform dflags
-enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
-enterIdLabel dflags id c
- | tablesNextToCode dflags = mkInfoTableLabel id c
- | otherwise = mkEntryLabel id c
+enterIdLabel :: Platform -> Name -> CafInfo -> CLabel
+enterIdLabel platform id c
+ | platformTablesNextToCode platform = mkInfoTableLabel id c
+ | otherwise = mkEntryLabel id c
--------------------------------------
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -1007,6 +1007,7 @@ cgIdApp fun_id args = do
emitEnter :: CmmExpr -> FCode ReturnKind
emitEnter fun = do
{ dflags <- getDynFlags
+ ; platform <- getPlatform
; adjustHpBackwards
; sequel <- getSequel
; updfr_off <- getUpdFrameOff
@@ -1020,7 +1021,7 @@ emitEnter fun = do
-- Right now, we do what the old codegen did, and omit the tag
-- test, just generating an enter.
Return -> do
- { let entry = entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg
+ { let entry = entryCode platform $ closureInfoPtr dflags $ CmmReg nodeReg
; emit $ mkJump dflags NativeNodeCall entry
[cmmUntag dflags fun] updfr_off
; return AssignedDirectly
@@ -1062,7 +1063,7 @@ emitEnter fun = do
-- refer to fun via nodeReg after the copyout, to avoid having
-- both live simultaneously; this sometimes enables fun to be
-- inlined in the RHS of the R1 assignment.
- ; let entry = entryCode dflags (closureInfoPtr dflags (CmmReg nodeReg))
+ ; let entry = entryCode platform (closureInfoPtr dflags (CmmReg nodeReg))
the_call = toCall entry (Just lret) updfr_off off outArgs regs
; tscope <- getTickScope
; emit $
=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -86,7 +86,7 @@ emitReturn results
Return ->
do { adjustHpBackwards
; let e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord platform)
- ; emit (mkReturn dflags (entryCode dflags e) results updfr_off)
+ ; emit (mkReturn dflags (entryCode platform e) results updfr_off)
}
AssignTo regs adjust ->
do { when adjust adjustHpBackwards
@@ -222,7 +222,7 @@ slowCall fun stg_args
fast_code <- getCode $
emitCall (NativeNodeCall, NativeReturn)
- (entryCode dflags fun_iptr)
+ (entryCode platform fun_iptr)
(nonVArgs ((P,Just funv):argsreps))
slow_lbl <- newBlockId
=====================================
libraries/ghc-boot/GHC/Platform.hs
=====================================
@@ -64,6 +64,10 @@ data Platform = Platform
, platformHasSubsectionsViaSymbols :: !Bool
, platformIsCrossCompiling :: !Bool
, platformLeadingUnderscore :: !Bool -- ^ Symbols need underscore prefix
+ , platformTablesNextToCode :: !Bool
+ -- ^ Determines whether we will be compiling info tables that reside just
+ -- before the entry code, or with an indirection to the entry code. See
+ -- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
}
deriving (Read, Show, Eq)
@@ -294,10 +298,6 @@ data PlatformMisc = PlatformMisc
, platformMisc_ghcWithNativeCodeGen :: Bool
, platformMisc_ghcWithSMP :: Bool
, platformMisc_ghcRTSWays :: String
- -- | Determines whether we will be compiling info tables that reside just
- -- before the entry code, or with an indirection to the entry code. See
- -- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
- , platformMisc_tablesNextToCode :: Bool
, platformMisc_libFFI :: Bool
, platformMisc_ghcThreaded :: Bool
, platformMisc_ghcDebugged :: Bool
=====================================
libraries/ghc-boot/GHC/Settings/Platform.hs
=====================================
@@ -43,6 +43,7 @@ getTargetPlatform settingsFile mySettings = do
targetHasIdentDirective <- getBooleanSetting "target has .ident directive"
targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols"
crossCompiling <- getBooleanSetting "cross compiling"
+ tablesNextToCode <- getBooleanSetting "Tables next to code"
pure $ Platform
{ platformMini = PlatformMini
@@ -57,6 +58,7 @@ getTargetPlatform settingsFile mySettings = do
, platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols
, platformIsCrossCompiling = crossCompiling
, platformLeadingUnderscore = targetLeadingUnderscore
+ , platformTablesNextToCode = tablesNextToCode
}
-----------------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4a0be758003f32b9d9d89cfd14b9839ac002f4d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4a0be758003f32b9d9d89cfd14b9839ac002f4d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200618/6387a517/attachment-0001.html>
More information about the ghc-commits
mailing list