Make -fscc-profiling a dynamic flag

All the flags that 'ways' imply are now dynamic

1 files changed, 20 insertions, 19 deletions

diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 78c1934869..86e6ff8589 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -50,7 +50,6 @@ import Module
 import DynFlags
 import FastString
 import Platform
-import StaticFlags
 
 import Control.Monad
 \end{code}
@@ -82,8 +81,9 @@ cgTopRhsCon id con args
             lf_info       = mkConLFInfo con
             closure_label = mkClosureLabel name $ idCafInfo id
             caffy         = any stgArgHasCafRefs args
-            (closure_info, amodes_w_offsets) = layOutStaticConstr con amodes
+            (closure_info, amodes_w_offsets) = layOutStaticConstr dflags con amodes
             closure_rep = mkStaticClosureFields
+                             dflags
                              closure_info
                              dontCareCCS                -- Because it's static data
                              caffy                      -- Has CAF refs
@@ -191,7 +191,7 @@ buildDynCon' dflags platform binder _ con [arg_amode]
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
   = do  { let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
-              offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
+              offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize dflags + 1)
                 -- INTLIKE closures consist of a header and one word payload
               intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
         ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
@@ -203,7 +203,7 @@ buildDynCon' dflags platform binder _ con [arg_amode]
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
   = do  { let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
-              offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
+              offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize dflags + 1)
                 -- CHARLIKE closures consist of a header and one word payload
               charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
         ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
@@ -213,10 +213,10 @@ buildDynCon' dflags platform binder _ con [arg_amode]
 Now the general case.
 
 \begin{code}
-buildDynCon' _ _ binder ccs con args
+buildDynCon' dflags _ binder ccs con args
   = do  {
         ; let
-            (closure_info, amodes_w_offsets) = layOutDynConstr con args
+            (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
 
         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
         ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
@@ -246,12 +246,12 @@ found a $con$.
 \begin{code}
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
-  = do
+  = do dflags <- getDynFlags
        let
           -- The binding below forces the masking out of the tag bits
           -- when accessing the constructor field.
           bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
-          (_, args_w_offsets)    = layOutDynConstr con (addIdReps args)
+          (_, args_w_offsets)    = layOutDynConstr dflags con (addIdReps args)
         --
        ASSERT(not (isUnboxedTupleCon con)) return ()
        mapCs bind_arg args_w_offsets
@@ -318,14 +318,14 @@ sure the @amodes@ passed don't conflict with each other.
 \begin{code}
 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
 
-cgReturnDataCon con amodes
-  | isUnboxedTupleCon con = 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.
-  | opt_SccProfilingOn    = build_it_then enter_it
-  | otherwise
-  = ASSERT( amodes `lengthIs` dataConRepRepArity con )
-    do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
+cgReturnDataCon con amodes = do
+  dflags <- getDynFlags
+  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 ASSERT( amodes `lengthIs` dataConRepRepArity con )
+     do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
         ; case sequel of
             CaseAlts _ (Just (alts, deflt_lbl)) bndr
               ->    -- Ho! We know the constructor so we can
@@ -445,7 +445,8 @@ static closure, for a constructor.
 \begin{code}
 cgDataCon :: DataCon -> Code
 cgDataCon data_con
-  = do  {     -- Don't need any dynamic closure code for zero-arity constructors
+  = do  { dflags <- getDynFlags
+        -- Don't need any dynamic closure code for zero-arity constructors
 
         ; let
             -- To allow the debuggers, interpreters, etc to cope with
@@ -453,10 +454,10 @@ cgDataCon data_con
             -- time), we take care that info-table contains the
             -- information we need.
             (static_cl_info, _) =
-                layOutStaticConstr data_con arg_reps
+                layOutStaticConstr dflags data_con arg_reps
 
             (dyn_cl_info, arg_things) =
-                layOutDynConstr    data_con arg_reps
+                layOutDynConstr    dflags data_con arg_reps
 
             emit_info cl_info ticky_code
                 = do { code_blks <- getCgStmts the_code