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.

compiler/cmm/CmmInfo.hs

@@ -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
 
 
 -------------------------------------------------------------------------

compiler/cmm/CmmOpt.hs

@@ -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

compiler/cmm/CmmParse.y

@@ -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

compiler/cmm/CmmPipeline.hs

@@ -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

compiler/codeGen/CgClosure.lhs

@@ -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 }

compiler/codeGen/CgCon.lhs

@@ -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

compiler/codeGen/CgInfoTbls.hs

@@ -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)

compiler/codeGen/CgTailCall.lhs

@@ -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]))
                    }
 {-

compiler/codeGen/ClosureInfo.lhs

@@ -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}
 
 

compiler/codeGen/StgCmmBind.hs

@@ -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 }

compiler/codeGen/StgCmmClosure.hs

@@ -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
 
 
 --------------------------------------

compiler/codeGen/StgCmmExpr.hs

@@ -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 <*>

compiler/codeGen/StgCmmLayout.hs

@@ -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)

compiler/main/DynFlags.hs

@@ -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

compiler/main/StaticFlagParser.hs

@@ -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]

compiler/main/StaticFlags.hs

@@ -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