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

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
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
-- %************************************************************************
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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@)
--
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
--------------------------------------
......
......@@ -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 $
......
......@@ -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
......
......@@ -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
......
......@@ -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
}
-----------------------------------------------------------------------------
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment