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.

4 files changed, 22 insertions, 24 deletions

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 7bdaf5aaca..29affaef0b 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/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
 
 
 -------------------------------------------------------------------------
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 09cbf5045d..5f208244f8 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/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
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index f14aa9c987..cd8dc6c711 100644
--- a/compiler/cmm/CmmParse.y
+++ b/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
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index f53135384c..e86374b264 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/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