Commit e6ef5ab6 authored by ian@well-typed.com's avatar ian@well-typed.com

Make tablesNextToCode "dynamic"

This is a bit odd by itself, but it's a stepping stone on the way to
putting "target unregisterised" into the settings file.
parent 8e7fb28f
......@@ -27,7 +27,6 @@ import Maybes
import Constants
import DynFlags
import Panic
import StaticFlags
import UniqSupply
import MonadUtils
import Util
......@@ -88,7 +87,7 @@ cmmToRawCmm dflags cmms
-- * The SRT slot is only there if there is SRT info to record
mkInfoTable :: DynFlags -> CmmDecl -> UniqSM [RawCmmDecl]
mkInfoTable _ (CmmData sec dat)
mkInfoTable _ (CmmData sec dat)
= return [CmmData sec dat]
mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
......@@ -96,7 +95,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl 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
| not (tablesNextToCode dflags)
= case topInfoTable proc of -- must be at most one
-- no info table
Nothing ->
......@@ -106,8 +105,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
(top_decls, (std_info, extra_bits)) <-
mkInfoTableContents dflags info Nothing
let
rel_std_info = map (makeRelativeRefTo info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo info_lbl) extra_bits
rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
--
case blocks of
ListGraph [] ->
......@@ -143,8 +142,8 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl blocks)
mkInfoTableContents dflags itbl Nothing
let
info_lbl = cit_lbl itbl
rel_std_info = map (makeRelativeRefTo info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo info_lbl) extra_bits
rel_std_info = map (makeRelativeRefTo dflags info_lbl) std_info
rel_extra_bits = map (makeRelativeRefTo dflags info_lbl) extra_bits
--
return (top_decls, (lbl, Statics info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info))
......@@ -267,15 +266,15 @@ mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap)
-- 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 :: CLabel -> CmmLit -> CmmLit
makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo info_lbl (CmmLabel lbl)
| tablesNextToCode
makeRelativeRefTo dflags info_lbl (CmmLabel lbl)
| tablesNextToCode dflags
= CmmLabelDiffOff lbl info_lbl 0
makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
| tablesNextToCode
makeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off)
| tablesNextToCode dflags
= CmmLabelDiffOff lbl info_lbl off
makeRelativeRefTo _ lit = lit
makeRelativeRefTo _ _ lit = lit
-------------------------------------------------------------------------
......
......@@ -21,7 +21,6 @@ import OldPprCmm
import CmmNode (wrapRecExp)
import CmmUtils
import DynFlags
import StaticFlags
import CLabel
import UniqFM
......@@ -672,10 +671,10 @@ exactLog2 x_
except factorial, but what the hell.
-}
cmmLoopifyForC :: RawCmmDecl -> RawCmmDecl
cmmLoopifyForC :: DynFlags -> RawCmmDecl -> RawCmmDecl
-- XXX: revisit if we actually want to do this
-- cmmLoopifyForC p@(CmmProc Nothing _ _) = p -- only if there's an info table, ignore case alts
cmmLoopifyForC (CmmProc infos entry_lbl
cmmLoopifyForC dflags (CmmProc infos entry_lbl
(ListGraph blocks@(BasicBlock top_id _ : _))) =
-- pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
CmmProc infos entry_lbl (ListGraph blocks')
......@@ -686,10 +685,10 @@ cmmLoopifyForC (CmmProc infos entry_lbl
= CmmBranch top_id
do_stmt stmt = stmt
jump_lbl | tablesNextToCode = toInfoLbl entry_lbl
| otherwise = entry_lbl
jump_lbl | tablesNextToCode dflags = toInfoLbl entry_lbl
| otherwise = entry_lbl
cmmLoopifyForC top = top
cmmLoopifyForC _ top = top
-- -----------------------------------------------------------------------------
-- Utils
......
......@@ -656,11 +656,11 @@ exprOp name args_code = do
exprMacros :: DynFlags -> UniqFM ([CmmExpr] -> CmmExpr)
exprMacros dflags = listToUFM [
( fsLit "ENTRY_CODE", \ [x] -> entryCode x ),
( fsLit "ENTRY_CODE", \ [x] -> entryCode dflags x ),
( fsLit "INFO_PTR", \ [x] -> closureInfoPtr x ),
( fsLit "STD_INFO", \ [x] -> infoTable dflags x ),
( fsLit "FUN_INFO", \ [x] -> funInfoTable dflags x ),
( fsLit "GET_ENTRY", \ [x] -> entryCode (closureInfoPtr x) ),
( fsLit "GET_ENTRY", \ [x] -> entryCode dflags (closureInfoPtr x) ),
( fsLit "GET_STD_INFO", \ [x] -> infoTable dflags (closureInfoPtr x) ),
( fsLit "GET_FUN_INFO", \ [x] -> funInfoTable dflags (closureInfoPtr x) ),
( fsLit "INFO_TYPE", \ [x] -> infoTableClosureType dflags x ),
......@@ -932,13 +932,14 @@ doStore rep addr_code val_code
-- Return an unboxed tuple.
emitRetUT :: [(CgRep,CmmExpr)] -> Code
emitRetUT args = do
dflags <- getDynFlags
tickyUnboxedTupleReturn (length args) -- TICK
(sp, stmts, live) <- pushUnboxedTuple 0 args
emitSimultaneously stmts -- NB. the args might overlap with the stack slots
-- or regs that we assign to, so better use
-- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
stmtC $ CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) (Just live)
stmtC $ CmmJump (entryCode dflags (CmmLoad (cmmRegOffW spReg sp) bWord)) (Just live)
-- -----------------------------------------------------------------------------
-- If-then-else and boolean expressions
......
......@@ -25,7 +25,6 @@ import ErrUtils
import HscTypes
import Control.Monad
import Outputable
import StaticFlags
-----------------------------------------------------------------------------
-- | Top level driver for C-- pipeline
......@@ -161,7 +160,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
-- label to put on info tables for basic blocks that are not
-- the entry point.
splitting_proc_points = hscTarget dflags /= HscAsm
|| not tablesNextToCode
|| not (tablesNextToCode dflags)
runUniqSM :: UniqSM a -> IO a
runUniqSM m = do
......
......@@ -288,7 +288,8 @@ closureCodeBody _binder_info cl_info cc args body
; setTickyCtrLabel ticky_ctr_lbl $ do
-- Emit the slow-entry code
{ reg_save_code <- mkSlowEntryCode cl_info reg_args
{ dflags <- getDynFlags
; reg_save_code <- mkSlowEntryCode dflags cl_info reg_args
-- Emit the main entry code
; blks <- forkProc $
......@@ -339,13 +340,13 @@ The slow entry point is used in two places:
(b) returning from a heap-check failure
\begin{code}
mkSlowEntryCode :: ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
mkSlowEntryCode :: DynFlags -> ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
-- If this function doesn't have a specialised ArgDescr, we need
-- to generate the function's arg bitmap, slow-entry code, and
-- register-save code for the heap-check failure
-- Here, we emit the slow-entry code, and
-- return the register-save assignments
mkSlowEntryCode cl_info reg_args
mkSlowEntryCode dflags cl_info reg_args
| Just (_, ArgGen _) <- closureFunInfo cl_info
= do { emitSimpleProc slow_lbl (emitStmts load_stmts)
; return save_stmts }
......@@ -378,7 +379,7 @@ mkSlowEntryCode cl_info reg_args
stk_adj_pop = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
stk_adj_push = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
live_regs = Just $ map snd reps_w_regs
jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI cl_info)) live_regs
jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI dflags cl_info)) live_regs
\end{code}
......@@ -599,7 +600,7 @@ link_caf cl_info _is_upd = do
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
let target = entryCode dflags (closureInfoPtr (CmmReg nodeReg)) in
stmtC (CmmJump target $ Just [node])
; returnFC hp_rel }
......
......@@ -323,7 +323,7 @@ cgReturnDataCon con amodes = do
if isUnboxedTupleCon con then returnUnboxedTuple amodes
-- when profiling we can't shortcut here, we have to enter the closure
-- for it to be marked as "used" for LDV profiling.
else if dopt Opt_SccProfilingOn dflags then build_it_then enter_it
else if dopt Opt_SccProfilingOn dflags then build_it_then (enter_it dflags)
else ASSERT( amodes `lengthIs` dataConRepRepArity con )
do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
; case sequel of
......@@ -352,8 +352,9 @@ cgReturnDataCon con amodes = do
}
where
node_live = Just [node]
enter_it = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
CmmJump (entryCode $ closureInfoPtr $ CmmReg nodeReg)
enter_it dflags
= stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
CmmJump (entryCode dflags $ closureInfoPtr $ CmmReg nodeReg)
node_live
]
jump_to lbl = stmtC $ CmmJump (CmmLit lbl) node_live
......
......@@ -42,7 +42,6 @@ import OldCmm
import CLabel
import Name
import Unique
import StaticFlags
import Constants
import DynFlags
......@@ -61,9 +60,10 @@ import Outputable
emitClosureCodeAndInfoTable :: ClosureInfo -> [CmmFormal] -> CgStmts -> Code
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
= do { dflags <- getDynFlags
; blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
; emitInfoTableAndCode (entryLabelFromCI cl_info) info args blks }
; emitInfoTableAndCode (entryLabelFromCI dflags cl_info) info args blks }
-- Convert from 'ClosureInfo' to 'CmmInfo'.
-- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
......@@ -234,8 +234,9 @@ emitAlgReturnTarget name branches mb_deflt fam_sz
--------------------------------
emitReturnInstr :: Maybe [GlobalReg] -> Code
emitReturnInstr live
= do { info_amode <- getSequelAmode
; stmtC (CmmJump (entryCode info_amode) live) }
= do { dflags <- getDynFlags
; info_amode <- getSequelAmode
; stmtC (CmmJump (entryCode dflags info_amode) live) }
-----------------------------------------------------------------------------
--
......@@ -280,11 +281,12 @@ closureInfoPtr :: CmmExpr -> CmmExpr
-- Takes a closure pointer and returns the info table pointer
closureInfoPtr e = CmmLoad e bWord
entryCode :: CmmExpr -> CmmExpr
entryCode :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
-- and returns its entry code
entryCode e | tablesNextToCode = e
| otherwise = CmmLoad e bWord
entryCode dflags e
| tablesNextToCode dflags = e
| otherwise = CmmLoad e bWord
getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the *zero-indexed*
......@@ -309,8 +311,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 = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags)
| otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
| tablesNextToCode dflags = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags)
| otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the constr tag
......@@ -342,7 +344,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
| tablesNextToCode dflags
= cmmOffsetB info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev)
| otherwise
= cmmOffsetW info_ptr (1 + stdInfoTableSizeW dflags)
......
......@@ -105,9 +105,10 @@ performTailCall fun_info arg_amodes pending_assts
-- to make the heap check easier. The tail-call sequence
-- is very similar to returning an unboxed tuple, so we
-- share some code.
do { (final_sp, arg_assts, live) <- pushUnboxedTuple join_sp arg_amodes
do { dflags <- getDynFlags
; (final_sp, arg_assts, live) <- pushUnboxedTuple join_sp arg_amodes
; emitSimultaneously (pending_assts `plusStmts` arg_assts)
; let lbl = enterReturnPtLabel (idUnique (cgIdInfoId fun_info))
; let lbl = enterReturnPtLabel dflags (idUnique (cgIdInfoId fun_info))
; doFinalJump final_sp True $ jumpToLbl lbl (Just live) }
| otherwise
......@@ -126,7 +127,7 @@ performTailCall fun_info arg_amodes pending_assts
-- Node must always point to things we enter
EnterIt -> do
{ emitSimultaneously (node_asst `plusStmts` pending_assts)
; let target = entryCode (closureInfoPtr (CmmReg nodeReg))
; let target = entryCode dflags (closureInfoPtr (CmmReg nodeReg))
enterClosure = stmtC (CmmJump target node_live)
-- If this is a scrutinee
-- let's check if the closure is a constructor
......@@ -207,7 +208,7 @@ performTailCall fun_info arg_amodes pending_assts
-- No, enter the closure.
; enterClosure
; labelC is_constr
; stmtC (CmmJump (entryCode $
; stmtC (CmmJump (entryCode dflags $
CmmLit (CmmLabel lbl)) (Just [node]))
}
{-
......
......@@ -83,7 +83,6 @@ import SMRep
import CLabel
import Cmm
import Unique
import StaticFlags
import Var
import Id
import IdInfo
......@@ -658,11 +657,11 @@ getCallMethod dflags _ _ lf_info _
-- fetched since we allocated it.
EnterIt
getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
getCallMethod dflags name caf (LFReEntrant _ arity _ _) n_args
| n_args == 0 = ASSERT( arity /= 0 )
ReturnIt -- No args at all
| n_args < arity = SlowCall -- Not enough args
| otherwise = DirectEntry (enterIdLabel name caf) arity
| otherwise = DirectEntry (enterIdLabel dflags name caf) arity
getCallMethod dflags _ _ (LFCon con) n_args
-- when profiling, we must always enter a closure when we use it, so
......@@ -716,11 +715,11 @@ getCallMethod _ _ _ LFBlackHole _
-- been updated, but we don't know with
-- what, so we slow call it
getCallMethod _ name _ (LFLetNoEscape 0) _
= JumpToIt (enterReturnPtLabel (nameUnique name))
getCallMethod dflags name _ (LFLetNoEscape 0) _
= JumpToIt (enterReturnPtLabel dflags (nameUnique name))
getCallMethod _ name _ (LFLetNoEscape arity) n_args
| n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
getCallMethod dflags name _ (LFLetNoEscape arity) n_args
| n_args == arity = DirectEntry (enterReturnPtLabel dflags (nameUnique name)) arity
| otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
......@@ -971,10 +970,10 @@ Label generation.
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI = fst . labelsFromCI
entryLabelFromCI :: ClosureInfo -> CLabel
entryLabelFromCI ci
| tablesNextToCode = info_lbl
| otherwise = entry_lbl
entryLabelFromCI :: DynFlags -> ClosureInfo -> CLabel
entryLabelFromCI dflags ci
| tablesNextToCode dflags = info_lbl
| otherwise = entry_lbl
where (info_lbl, entry_lbl) = labelsFromCI ci
labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
......@@ -1039,15 +1038,15 @@ enterSelectorLabel upd_flag offset
| otherwise = mkSelectorEntryLabel upd_flag offset
-}
enterIdLabel :: Name -> CafInfo -> CLabel
enterIdLabel id
| tablesNextToCode = mkInfoTableLabel id
| otherwise = mkEntryLabel id
enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
enterIdLabel dflags id
| tablesNextToCode dflags = mkInfoTableLabel id
| otherwise = mkEntryLabel id
enterReturnPtLabel :: Unique -> CLabel
enterReturnPtLabel name
| tablesNextToCode = mkReturnInfoLabel name
| otherwise = mkReturnPtLabel name
enterReturnPtLabel :: DynFlags -> Unique -> CLabel
enterReturnPtLabel dflags name
| tablesNextToCode dflags = mkReturnInfoLabel name
| otherwise = mkReturnPtLabel name
\end{code}
......
......@@ -466,8 +466,9 @@ mkSlowEntryCode :: ClosureInfo -> [LocalReg] -> FCode ()
mkSlowEntryCode _ [] = panic "entering a closure with no arguments?"
mkSlowEntryCode cl_info arg_regs -- function closure is already in `Node'
| Just (_, ArgGen _) <- closureFunInfo cl_info
= do let slow_lbl = closureSlowEntryLabel cl_info
fast_lbl = closureLocalEntryLabel cl_info
= do dflags <- getDynFlags
let slow_lbl = closureSlowEntryLabel cl_info
fast_lbl = closureLocalEntryLabel dflags cl_info
-- mkDirectJump does not clobber `Node' containing function closure
jump = mkDirectJump (mkLblExpr fast_lbl)
(map (CmmReg . CmmLocal) arg_regs)
......@@ -678,7 +679,7 @@ link_caf _is_upd = do
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
(let target = entryCode (closureInfoPtr (CmmReg nodeReg)) in
(let target = entryCode dflags (closureInfoPtr (CmmReg nodeReg)) in
mkJump target [] updfr)
; return hp_rel }
......
......@@ -76,7 +76,6 @@ import SMRep
import Cmm
import CLabel
import StaticFlags
import Id
import IdInfo
import DataCon
......@@ -481,11 +480,11 @@ getCallMethod dflags _name _ lf_info _n_args
-- fetched since we allocated it.
EnterIt
getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
getCallMethod dflags name caf (LFReEntrant _ arity _ _) n_args
| n_args == 0 = ASSERT( arity /= 0 )
ReturnIt -- No args at all
| n_args < arity = SlowCall -- Not enough args
| otherwise = DirectEntry (enterIdLabel name caf) arity
| otherwise = DirectEntry (enterIdLabel dflags name caf) arity
getCallMethod _ _name _ LFUnLifted n_args
= ASSERT( n_args == 0 ) ReturnIt
......@@ -515,7 +514,7 @@ getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_arg
| otherwise -- Jump direct to code for single-entry thunks
= ASSERT( n_args == 0 )
DirectEntry (thunkEntryLabel name caf std_form_info updatable) 0
DirectEntry (thunkEntryLabel dflags name caf std_form_info updatable) 0
getCallMethod _ _name _ (LFUnknown True) _n_args
= SlowCall -- might be a function
......@@ -779,10 +778,10 @@ closureRednCountsLabel = toRednCountsLbl . closureInfoLabel
closureSlowEntryLabel :: ClosureInfo -> CLabel
closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
closureLocalEntryLabel :: ClosureInfo -> CLabel
closureLocalEntryLabel
| tablesNextToCode = toInfoLbl . closureInfoLabel
| otherwise = toEntryLbl . closureInfoLabel
closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel
closureLocalEntryLabel dflags
| tablesNextToCode dflags = toInfoLbl . closureInfoLabel
| otherwise = toEntryLbl . closureInfoLabel
mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel id lf_info
......@@ -813,30 +812,30 @@ mkClosureInfoTableLabel id lf_info
-- invariants in CorePrep anything else gets eta expanded.
thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
thunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
-- thunkEntryLabel is a local help function, not exported. It's used from
-- getCallMethod.
thunkEntryLabel _thunk_id _ (ApThunk arity) upd_flag
= enterApLabel upd_flag arity
thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
= enterSelectorLabel upd_flag offset
thunkEntryLabel thunk_id c _ _
= enterIdLabel thunk_id c
enterApLabel :: Bool -> Arity -> CLabel
enterApLabel is_updatable arity
| tablesNextToCode = mkApInfoTableLabel is_updatable arity
| otherwise = mkApEntryLabel is_updatable arity
enterSelectorLabel :: Bool -> WordOff -> CLabel
enterSelectorLabel upd_flag offset
| tablesNextToCode = mkSelectorInfoLabel upd_flag offset
| otherwise = mkSelectorEntryLabel upd_flag offset
enterIdLabel :: Name -> CafInfo -> CLabel
enterIdLabel id c
| tablesNextToCode = mkInfoTableLabel id c
| otherwise = mkEntryLabel id c
thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag
= enterApLabel dflags upd_flag arity
thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag
= enterSelectorLabel dflags upd_flag offset
thunkEntryLabel dflags thunk_id c _ _
= enterIdLabel dflags thunk_id c
enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
enterApLabel dflags is_updatable arity
| tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
| otherwise = mkApEntryLabel is_updatable arity
enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
enterSelectorLabel dflags upd_flag offset
| tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
| otherwise = mkSelectorEntryLabel upd_flag offset
enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
enterIdLabel dflags id c
| tablesNextToCode dflags = mkInfoTableLabel id c
| otherwise = mkEntryLabel id c
--------------------------------------
......
......@@ -659,7 +659,8 @@ cgTailCall fun_id fun_info args = do
emitEnter :: CmmExpr -> FCode ReturnKind
emitEnter fun = do
{ adjustHpBackwards
{ dflags <- getDynFlags
; adjustHpBackwards
; sequel <- getSequel
; updfr_off <- getUpdFrameOff
; case sequel of
......@@ -672,7 +673,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 $ closureInfoPtr $ CmmReg nodeReg
{ let entry = entryCode dflags $ closureInfoPtr $ CmmReg nodeReg
; emit $ mkForeignJump NativeNodeCall entry
[cmmUntag fun] updfr_off
; return AssignedDirectly
......@@ -714,7 +715,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 (closureInfoPtr (CmmReg nodeReg))
; let entry = entryCode dflags (closureInfoPtr (CmmReg nodeReg))
the_call = toCall entry (Just lret) updfr_off off outArgs regs
; emit $
copyout <*>
......
......@@ -54,7 +54,6 @@ import Name
import TyCon ( PrimRep(..) )
import BasicTypes ( RepArity )
import DynFlags
import StaticFlags
import Module
import Constants
......@@ -595,11 +594,12 @@ closureInfoPtr :: CmmExpr -> CmmExpr
-- Takes a closure pointer and returns the info table pointer
closureInfoPtr e = CmmLoad e bWord
entryCode :: CmmExpr -> CmmExpr
entryCode :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
-- and returns its entry code
entryCode e | tablesNextToCode = e
| otherwise = CmmLoad e bWord
entryCode dflags e
| tablesNextToCode dflags = e
| otherwise = CmmLoad e bWord
getConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer, and return the *zero-indexed*
......@@ -624,8 +624,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 = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags)
| otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
| tablesNextToCode dflags = cmmOffsetB info_ptr (- stdInfoTableSizeB dflags)
| otherwise = cmmOffsetW info_ptr 1 -- Past the entry code pointer
infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info table pointer (from infoTable) and returns the constr tag
......@@ -657,7 +657,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
| tablesNextToCode dflags
= cmmOffsetB info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev)
| otherwise
= cmmOffsetW info_ptr (1 + stdInfoTableSizeW dflags)
......
......@@ -46,6 +46,7 @@ module DynFlags (
DynLibLoader(..),
fFlags, fWarningFlags, fLangFlags, xFlags,
wayNames, dynFlagDependencies,
tablesNextToCode,
printOutputForUser, printInfoForUser,
......@@ -881,6 +882,15 @@ defaultObjectTarget
| cGhcWithNativeCodeGen == "YES" = HscAsm
| otherwise = HscLlvm
-- Derived, not a real option. 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.
tablesNextToCode :: DynFlags -> Bool
tablesNextToCode _ = not opt_Unregisterised
&& cGhcEnableTablesNextToCode == "YES"
data DynLibLoader
= Deployable
| SystemDependent
......
......@@ -18,7 +18,7 @@ module StaticFlagParser (
#include "HsVersions.h"
import qualified StaticFlags as SF
import StaticFlags ( v_opt_C_ready, getWayFlags, tablesNextToCode, WayName(..)
import StaticFlags ( v_opt_C_ready, getWayFlags, WayName(..)
, opt_SimplExcessPrecision )
import CmdLineParser
import Config
......@@ -81,14 +81,6 @@ parseStaticFlagsFull flagsAvailable args = do
-- see sanity code in staticOpts
writeIORef v_opt_C_ready True
-- TABLES_NEXT_TO_CODE affects the info table layout.
-- Be careful to do this *after* all processArgs,
-- because evaluating tablesNextToCode involves looking at the global
-- static flags. Those pesky global variables...
let cg_flags | tablesNextToCode = map (mkGeneralLocated "in cg_flags")
["-optc-DTABLES_NEXT_TO_CODE"]
| otherwise = []
-- HACK: -fexcess-precision is both a static and a dynamic flag. If
-- the static flag parser has slurped it, we must return it as a
-- leftover too. ToDo: make -fexcess-precision dynamic only.
......@@ -98,7 +90,7 @@ parseStaticFlagsFull flagsAvailable args = do
| otherwise = []
when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (excess_prec ++ cg_flags ++ more_leftover ++ leftover,
return (excess_prec ++ more_leftover ++ leftover,
warns1 ++ warns2)
flagsStatic :: [Flag IO]
......
......@@ -74,7 +74,6 @@ module StaticFlags (
opt_HistorySize,
opt_Unregisterised,
v_Ld_inputs,
tablesNextToCode,
opt_StubDeadValues,
opt_Ticky,
......@@ -87,7 +86,6 @@ module StaticFlags (
#include "HsVersions.h"
import Config
import FastString
import Util
import Maybes ( firstJusts )
......@@ -314,14 +312,6 @@ opt_Static = lookUp (fsLit "-static")
opt_Unregisterised :: Bool
opt_Unregisterised = lookUp (fsLit "-funregisterised")
-- Derived, not a real option. Determines whether we will be compiling