Move wORD_SIZE_IN_BITS to DynFlags

This frees wORD_SIZE up to be moved out of HaskellConstants

10 files changed, 119 insertions, 110 deletions

diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs
index 642ae40fdb..f4cfe3f401 100644
--- a/compiler/cmm/Bitmap.hs
+++ b/compiler/cmm/Bitmap.hs
@@ -25,6 +25,7 @@ module Bitmap (
 
 import SMRep
 import Constants
+import DynFlags
 import Util
 
 import Data.Bits
@@ -37,10 +38,10 @@ generated code which need to be emitted as sequences of StgWords.
 type Bitmap = [StgWord]
 
 -- | Make a bitmap from a sequence of bits
-mkBitmap :: [Bool] -> Bitmap
-mkBitmap [] = []
-mkBitmap stuff = chunkToBitmap chunk : mkBitmap rest
-  where (chunk, rest) = splitAt wORD_SIZE_IN_BITS stuff
+mkBitmap :: DynFlags -> [Bool] -> Bitmap
+mkBitmap _ [] = []
+mkBitmap dflags stuff = chunkToBitmap chunk : mkBitmap dflags rest
+  where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
 
 chunkToBitmap :: [Bool] -> StgWord
 chunkToBitmap chunk = 
@@ -50,31 +51,31 @@ chunkToBitmap chunk =
 -- eg. @[0,1,3], size 4 ==> 0xb@.
 --
 -- The list of @Int@s /must/ be already sorted.
-intsToBitmap :: Int -> [Int] -> Bitmap
-intsToBitmap size slots{- must be sorted -}
+intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
+intsToBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
   | otherwise = 
     (foldr (.|.) 0 (map (1 `shiftL`) these)) : 
-	intsToBitmap (size - wORD_SIZE_IN_BITS) 
-	     (map (\x -> x - wORD_SIZE_IN_BITS) rest)
-   where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
+        intsToBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
+             (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
+   where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
 
 -- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
 -- eg. @[0,1,3], size 4 ==> 0x4@  (we leave any bits outside the size as zero,
 -- just to make the bitmap easier to read).
 --
 -- The list of @Int@s /must/ be already sorted and duplicate-free.
-intsToReverseBitmap :: Int -> [Int] -> Bitmap
-intsToReverseBitmap size slots{- must be sorted -}
+intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
+intsToReverseBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
   | otherwise = 
-    (foldr xor init (map (1 `shiftL`) these)) : 
-	intsToReverseBitmap (size - wORD_SIZE_IN_BITS) 
-	     (map (\x -> x - wORD_SIZE_IN_BITS) rest)
-   where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
-	 init
-	   | size >= wORD_SIZE_IN_BITS = complement 0
-	   | otherwise                 = (1 `shiftL` size) - 1
+    (foldr xor init (map (1 `shiftL`) these)) :
+        intsToReverseBitmap dflags (size - wORD_SIZE_IN_BITS dflags)
+             (map (\x -> x - wORD_SIZE_IN_BITS dflags) rest)
+   where (these,rest) = span (< wORD_SIZE_IN_BITS dflags) slots
+         init
+           | size >= wORD_SIZE_IN_BITS dflags = complement 0
+           | otherwise                        = (1 `shiftL` size) - 1
 
 {- |
 Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 7d243615fe..37354193f8 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -220,7 +220,7 @@ procpointSRT dflags top_srt top_table entries =
     offset = head sorted_ints
     bitmap_entries = map (subtract offset) sorted_ints
     len = P.last bitmap_entries + 1
-    bitmap = intsToBitmap len bitmap_entries
+    bitmap = intsToBitmap dflags len bitmap_entries
 
 maxBmpSize :: DynFlags -> Int
 maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3bbbb5e1d8..10e37bb095 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -315,7 +315,7 @@ mkLivenessBits dflags liveness
     n_bits = length liveness
 
     bitmap :: Bitmap
-    bitmap = mkBitmap liveness
+    bitmap = mkBitmap dflags liveness
 
     small_bitmap = case bitmap of 
 		     []  -> 0
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index d77784dcf4..854a81a101 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -91,7 +91,7 @@ emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb] _
                     CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
                     CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                 ],
-                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
           ]
      ]
 
@@ -114,7 +114,7 @@ emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb] _
                     CmmMachOp (mo_wordXor dflags) [aa,bb],
                     CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
                 ],
-                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
           ]
      ]
 
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index cae14f30c5..0d5e3778bf 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -187,7 +187,7 @@ emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
 		    CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
 		    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
 		], 
-                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
 	  ]
      ]
 
@@ -210,7 +210,7 @@ emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
 		    CmmMachOp (mo_wordXor dflags) [aa,bb],
 		    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
 		], 
-                mkIntExpr dflags (wORD_SIZE_IN_BITS - 1)
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
 	  ]
      ]
 
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 73724c007e..e9dc7d1b21 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -133,7 +133,7 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
       -- Remember that the first insn starts at offset
       --     sizeOf Word / sizeOf Word16
       -- since offset 0 (eventually) will hold the total # of insns.
-      initial_offset = largeArg16s
+      initial_offset = largeArg16s dflags
 
       -- Jump instructions are variable-sized, there are long and short variants
       -- depending on the magnitude of the offset.  However, we can't tell what
@@ -143,9 +143,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
       -- and if the final size is indeed small enough for short jumps, we are
       -- done.  Otherwise, we repeat the calculation, and we force all jumps in
       -- this BCO to be long.
-      (n_insns0, lbl_map0) = inspectAsm False initial_offset asm
+      (n_insns0, lbl_map0) = inspectAsm dflags False initial_offset asm
       ((n_insns, lbl_map), long_jumps)
-        | isLarge n_insns0 = (inspectAsm True initial_offset asm, True)
+        | isLarge n_insns0 = (inspectAsm dflags True initial_offset asm, True)
         | otherwise = ((n_insns0, lbl_map0), False)
 
       env :: Word16 -> Word
@@ -154,9 +154,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
         (Map.lookup lbl lbl_map)
 
   -- pass 2: run assembler and generate instructions, literals and pointers
-  let initial_insns = addListToSS emptySS $ largeArg n_insns
+  let initial_insns = addListToSS emptySS $ largeArg dflags n_insns
   let initial_state = (initial_insns, emptySS, emptySS)
-  (final_insns, final_lits, final_ptrs) <- execState initial_state $ runAsm long_jumps env asm
+  (final_insns, final_lits, final_ptrs) <- execState initial_state $ runAsm dflags long_jumps env asm
 
   -- precomputed size should be equal to final size
   ASSERT (n_insns == sizeSS final_insns) return ()
@@ -250,8 +250,8 @@ largeOp long_jumps op = case op of
   Op w      -> isLarge w
   LabelOp _ -> long_jumps
 
-runAsm :: Bool -> LabelEnv -> Assembler a -> State AsmState IO a
-runAsm long_jumps e = go
+runAsm :: DynFlags -> Bool -> LabelEnv -> Assembler a -> State AsmState IO a
+runAsm dflags long_jumps e = go
   where
     go (NullAsm x) = return x
     go (AllocPtr p_io k) = do
@@ -273,9 +273,9 @@ runAsm long_jumps e = go
             | otherwise = w
           words = concatMap expand ops
           expand (SmallOp w) = [w]
-          expand (LargeOp w) = largeArg w
+          expand (LargeOp w) = largeArg dflags w
           expand (LabelOp w) = expand (Op (e w))
-          expand (Op w) = if largeOps then largeArg w else [fromIntegral w]
+          expand (Op w) = if largeOps then largeArg dflags w else [fromIntegral w]
       State $ \(st_i0,st_l0,st_p0) -> do
         let st_i1 = addListToSS st_i0 (opcode : words)
         return ((st_i1,st_l0,st_p0), ())
@@ -290,8 +290,8 @@ data InspectState = InspectState
   , lblEnv :: LabelEnvMap
   }
 
-inspectAsm :: Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
-inspectAsm long_jumps initial_offset
+inspectAsm :: DynFlags -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap)
+inspectAsm dflags long_jumps initial_offset
   = go (InspectState initial_offset 0 0 Map.empty)
   where
     go s (NullAsm _) = (instrCount s, lblEnv s)
@@ -307,9 +307,9 @@ inspectAsm long_jumps initial_offset
         size = sum (map count ops) + 1
         largeOps = any (largeOp long_jumps) ops
         count (SmallOp _) = 1
-        count (LargeOp _) = largeArg16s
+        count (LargeOp _) = largeArg16s dflags
         count (LabelOp _) = count (Op 0)
-        count (Op _) = if largeOps then largeArg16s else 1
+        count (Op _) = if largeOps then largeArg16s dflags else 1
 
 -- Bring in all the bci_ bytecode constants.
 #include "rts/Bytecodes.h"
@@ -317,21 +317,21 @@ inspectAsm long_jumps initial_offset
 largeArgInstr :: Word16 -> Word16
 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 
-largeArg :: Word -> [Word16]
-largeArg w
- | wORD_SIZE_IN_BITS == 64
+largeArg :: DynFlags -> Word -> [Word16]
+largeArg dflags w
+ | wORD_SIZE_IN_BITS dflags == 64
            = [fromIntegral (w `shiftR` 48),
               fromIntegral (w `shiftR` 32),
               fromIntegral (w `shiftR` 16),
               fromIntegral w]
- | wORD_SIZE_IN_BITS == 32
+ | wORD_SIZE_IN_BITS dflags == 32
            = [fromIntegral (w `shiftR` 16),
               fromIntegral w]
  | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
 
-largeArg16s :: Word
-largeArg16s | wORD_SIZE_IN_BITS == 64  = 4
-            | otherwise                = 2
+largeArg16s :: DynFlags -> Word
+largeArg16s dflags | wORD_SIZE_IN_BITS dflags == 64 = 4
+                   | otherwise                      = 2
 
 assembleI :: DynFlags
           -> BCInstr
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index b277a1ed30..59dfbc896e 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -49,7 +49,6 @@ import SMRep
 import ClosureInfo
 import Bitmap
 import OrdList
-import Constants
 
 import Data.List
 import Foreign
@@ -152,7 +151,8 @@ ppBCEnv p
 -- Create a BCO and do a spot of peephole optimisation on the insns
 -- at the same time.
 mkProtoBCO
-   :: name
+   :: DynFlags
+   -> name
    -> BCInstrList
    -> Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet)
    -> Int
@@ -161,10 +161,10 @@ mkProtoBCO
    -> Bool      -- True <=> is a return point, rather than a function
    -> [BcPtr]
    -> ProtoBCO name
-mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks
+mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_blocks
    = ProtoBCO {
         protoBCOName = nm,
-        protoBCOInstrs = maybe_with_stack_check,
+        protoBCOInstrs = maybe_with_stack_check dflags,
         protoBCOBitmap = bitmap,
         protoBCOBitmapSize = bitmap_size,
         protoBCOArity = arity,
@@ -179,8 +179,8 @@ mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_bloc
         -- BCO anyway, so we only need to add an explicit one in the
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
-        maybe_with_stack_check
-           | is_ret && stack_usage < fromIntegral aP_STACK_SPLIM = peep_d
+        maybe_with_stack_check dflags
+           | is_ret && stack_usage < fromIntegral (aP_STACK_SPLIM dflags) = peep_d
                 -- don't do stack checks at return points,
                 -- everything is aggregated up to the top BCO
                 -- (which must be a function).
@@ -223,6 +223,7 @@ schemeTopBind :: (Id, AnnExpr Id VarSet) -> BcM (ProtoBCO Name)
 schemeTopBind (id, rhs)
   | Just data_con <- isDataConWorkId_maybe id,
     isNullaryRepDataCon data_con = do
+    dflags <- getDynFlags
         -- Special case for the worker of a nullary data con.
         -- It'll look like this:        Nil = /\a -> Nil a
         -- If we feed it into schemeR, we'll get
@@ -231,7 +232,7 @@ schemeTopBind (id, rhs)
         -- by just re-using the single top-level definition.  So
         -- for the worker itself, we must allocate it directly.
     -- ioToBc (putStrLn $ "top level BCO")
-    emitBc (mkProtoBCO (getName id) (toOL [PACK data_con 0, ENTER])
+    emitBc (mkProtoBCO dflags (getName id) (toOL [PACK data_con 0, ENTER])
                        (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
 
   | otherwise
@@ -281,7 +282,9 @@ collect (_, e) = go [] e
 
 schemeR_wrk :: [Id] -> Id -> AnnExpr Id VarSet -> ([Var], AnnExpr' Var VarSet) -> BcM (ProtoBCO Name)
 schemeR_wrk fvs nm original_body (args, body)
-   = let
+   = do
+     dflags <- getDynFlags
+     let
          all_args  = reverse args ++ fvs
          arity     = length all_args
          -- all_args are the args in reverse order.  We're compiling a function
@@ -295,11 +298,10 @@ schemeR_wrk fvs nm original_body (args, body)
          -- make the arg bitmap
          bits = argBits (reverse (map idCgRep all_args))
          bitmap_size = genericLength bits
-         bitmap = mkBitmap bits
-     in do
+         bitmap = mkBitmap dflags bits
      body_code <- schemeER_wrk szw_args p_init body
 
-     emitBc (mkProtoBCO (getName nm) body_code (Right original_body)
+     emitBc (mkProtoBCO dflags (getName nm) body_code (Right original_body)
                  arity bitmap_size bitmap False{-not alts-})
 
 -- introduce break instructions for ticked expressions
@@ -772,7 +774,9 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
   | UbxTupleRep _ <- repType (idType bndr)
   = unboxedTupleException
   | otherwise
-  = let
+  = do
+     dflags <- getDynFlags
+     let
         -- Top of stack is the return itbl, as usual.
         -- underneath it is the pointer to the alt_code BCO.
         -- When an alt is entered, it assumes the returned value is
@@ -875,7 +879,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
         bitmap_size = trunc16 $ d-s
         bitmap_size' :: Int
         bitmap_size' = fromIntegral bitmap_size
-        bitmap = intsToReverseBitmap bitmap_size'{-size-}
+        bitmap = intsToReverseBitmap dflags bitmap_size'{-size-}
                         (sort (filter (< bitmap_size') rel_slots))
           where
           binds = Map.toList p
@@ -886,13 +890,12 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
                               | otherwise                      = []
                 where rel_offset = trunc16 $ d - fromIntegral offset - 1
 
-     in do
      alt_stuff <- mapM codeAlt alts
      alt_final <- mkMultiBranch maybe_ncons alt_stuff
 
      let
          alt_bco_name = getName bndr
-         alt_bco = mkProtoBCO alt_bco_name alt_final (Left alts)
+         alt_bco = mkProtoBCO dflags alt_bco_name alt_final (Left alts)
                        0{-no arity-} bitmap_size bitmap True{-is alts-}
 --     trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++
 --            "\n      bitmap = " ++ show bitmap) $ do
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 6cb99f87c7..d07977ceea 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -119,6 +119,7 @@ module DynFlags (
 
 #include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs"
         bLOCK_SIZE_W,
+        wORD_SIZE_IN_BITS,
   ) where
 
 #include "HsVersions.h"
@@ -3149,3 +3150,6 @@ compilerInfo dflags
 bLOCK_SIZE_W :: DynFlags -> Int
 bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE
 
+wORD_SIZE_IN_BITS :: DynFlags -> Int
+wORD_SIZE_IN_BITS _ = wORD_SIZE * 8
+
diff --git a/compiler/simplStg/SRT.lhs b/compiler/simplStg/SRT.lhs
index 0d474c5b63..92cfad3283 100644
--- a/compiler/simplStg/SRT.lhs
+++ b/compiler/simplStg/SRT.lhs
@@ -18,34 +18,35 @@ import VarEnv
 import Maybes           ( orElse, expectJust )
 import Bitmap
 
+import DynFlags
 import Outputable
 
 import Data.List
 \end{code}
 
 \begin{code}
-computeSRTs :: [StgBinding] -> [(StgBinding,[(Id,[Id])])]
+computeSRTs :: DynFlags -> [StgBinding] -> [(StgBinding,[(Id,[Id])])]
   -- The incoming bindingd are filled with SRTEntries in their SRT slots
   -- the outgoing ones have NoSRT/SRT values instead
 
-computeSRTs binds = srtTopBinds emptyVarEnv binds
+computeSRTs dflags binds = srtTopBinds dflags emptyVarEnv binds
 
 -- --------------------------------------------------------------------------
 -- Top-level Bindings
 
-srtTopBinds :: IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
+srtTopBinds :: DynFlags -> IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
 
-srtTopBinds _   [] = []
-srtTopBinds env (StgNonRec b rhs : binds) =
-  (StgNonRec b rhs', [(b,srt')]) : srtTopBinds env' binds
+srtTopBinds _ _   [] = []
+srtTopBinds dflags env (StgNonRec b rhs : binds) =
+  (StgNonRec b rhs', [(b,srt')]) : srtTopBinds dflags env' binds
   where
-    (rhs', srt) = srtTopRhs b rhs
+    (rhs', srt) = srtTopRhs dflags b rhs
     env' = maybeExtendEnv env b rhs
     srt' = applyEnvList env srt
-srtTopBinds env (StgRec bs : binds) =
-  (StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds env binds
+srtTopBinds dflags env (StgRec bs : binds) =
+  (StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds dflags env binds
   where
-    (rhss, srts) = unzip [ srtTopRhs b r | (b,r) <- bs ]
+    (rhss, srts) = unzip [ srtTopRhs dflags b r | (b,r) <- bs ]
     bndrs = map fst bs
     srts' = map (applyEnvList env) srts
 
@@ -74,75 +75,75 @@ applyEnv env id = lookupVarEnv env id `orElse` id
 
 -- ----  Top-level right hand sides:
 
-srtTopRhs :: Id -> StgRhs -> (StgRhs, [Id])
+srtTopRhs :: DynFlags -> Id -> StgRhs -> (StgRhs, [Id])
 
-srtTopRhs _ rhs@(StgRhsCon _ _ _) = (rhs, [])
-srtTopRhs _ rhs@(StgRhsClosure _ _ _ _  (SRTEntries cafs) _ _)
-  = (srtRhs table rhs, elems)
+srtTopRhs _ _ rhs@(StgRhsCon _ _ _) = (rhs, [])
+srtTopRhs dflags _ rhs@(StgRhsClosure _ _ _ _  (SRTEntries cafs) _ _)
+  = (srtRhs dflags table rhs, elems)
   where
         elems = varSetElems cafs
         table = mkVarEnv (zip elems [0..])
-srtTopRhs _ (StgRhsClosure _ _ _ _  NoSRT _ _) = panic "srtTopRhs NoSRT"
-srtTopRhs _ (StgRhsClosure _ _ _ _  (SRT _ _ _) _ _) = panic "srtTopRhs SRT"
+srtTopRhs _ _ (StgRhsClosure _ _ _ _  NoSRT _ _) = panic "srtTopRhs NoSRT"
+srtTopRhs _ _ (StgRhsClosure _ _ _ _  (SRT _ _ _) _ _) = panic "srtTopRhs SRT"
 
 -- ---- Binds:
 
-srtBind :: IdEnv Int -> StgBinding -> StgBinding
+srtBind :: DynFlags -> IdEnv Int -> StgBinding -> StgBinding
 
-srtBind table (StgNonRec binder rhs) = StgNonRec binder (srtRhs table rhs)
-srtBind table (StgRec pairs) = StgRec [ (b, srtRhs table r) | (b,r) <- pairs ]
+srtBind dflags table (StgNonRec binder rhs) = StgNonRec binder (srtRhs dflags table rhs)
+srtBind dflags table (StgRec pairs) = StgRec [ (b, srtRhs dflags table r) | (b,r) <- pairs ]
 
 -- ---- Right Hand Sides:
 
-srtRhs :: IdEnv Int -> StgRhs -> StgRhs
+srtRhs :: DynFlags -> IdEnv Int -> StgRhs -> StgRhs
 
-srtRhs _     e@(StgRhsCon _ _ _) = e
-srtRhs table (StgRhsClosure cc bi free_vars u srt args body)
-  = StgRhsClosure cc bi free_vars u (constructSRT table srt) args
-        $! (srtExpr table body)
+srtRhs _      _     e@(StgRhsCon _ _ _) = e
+srtRhs dflags table (StgRhsClosure cc bi free_vars u srt args body)
+  = StgRhsClosure cc bi free_vars u (constructSRT dflags table srt) args
+        $! (srtExpr dflags table body)
 
 -- ---------------------------------------------------------------------------
 -- Expressions
 
-srtExpr :: IdEnv Int -> StgExpr -> StgExpr
+srtExpr :: DynFlags -> IdEnv Int -> StgExpr -> StgExpr
 
-srtExpr _ e@(StgApp _ _)       = e
-srtExpr _ e@(StgLit _)         = e
-srtExpr _ e@(StgConApp _ _)    = e
-srtExpr _ e@(StgOpApp _ _ _)   = e
+srtExpr _ _ e@(StgApp _ _)       = e
+srtExpr _ _ e@(StgLit _)         = e
+srtExpr _ _ e@(StgConApp _ _)    = e
+srtExpr _ _ e@(StgOpApp _ _ _)   = e
 
-srtExpr table (StgSCC cc tick push expr) = StgSCC cc tick push $! srtExpr table expr
+srtExpr dflags table (StgSCC cc tick push expr) = StgSCC cc tick push $! srtExpr dflags table expr
 
-srtExpr table (StgTick m n expr) = StgTick m n $! srtExpr table expr
+srtExpr dflags table (StgTick m n expr) = StgTick m n $! srtExpr dflags table expr
 
-srtExpr table (StgCase scrut live1 live2 uniq srt alt_type alts)
+srtExpr dflags table (StgCase scrut live1 live2 uniq srt alt_type alts)
  = StgCase expr' live1 live2 uniq srt' alt_type alts'
  where
-   expr' = srtExpr table scrut
-   srt'  = constructSRT table srt
-   alts' = map (srtAlt table) alts
+   expr' = srtExpr dflags table scrut
+   srt'  = constructSRT dflags table srt
+   alts' = map (srtAlt dflags table) alts
 
-srtExpr table (StgLet bind body)
-  = srtBind table bind =: \ bind' ->
-    srtExpr table body             =: \ body' ->
+srtExpr dflags table (StgLet bind body)
+  = srtBind dflags table bind =: \ bind' ->
+    srtExpr dflags table body             =: \ body' ->
     StgLet bind' body'
 
-srtExpr table (StgLetNoEscape live1 live2 bind body)
-  = srtBind table bind =: \ bind' ->
-    srtExpr table body             =: \ body' ->
+srtExpr dflags table (StgLetNoEscape live1 live2 bind body)
+  = srtBind dflags table bind =: \ bind' ->
+    srtExpr dflags table body             =: \ body' ->
     StgLetNoEscape live1 live2 bind' body'
 
-srtExpr _table expr = pprPanic "srtExpr" (ppr expr)
+srtExpr _ _table expr = pprPanic "srtExpr" (ppr expr)
 
-srtAlt :: IdEnv Int -> StgAlt -> StgAlt
-srtAlt table (con,args,used,rhs)
-  = (,,,) con args used $! srtExpr table rhs
+srtAlt :: DynFlags -> IdEnv Int -> StgAlt -> StgAlt
+srtAlt dflags table (con,args,used,rhs)
+  = (,,,) con args used $! srtExpr dflags table rhs
 
 -----------------------------------------------------------------------------
 -- Construct an SRT bitmap.
 
-constructSRT :: IdEnv Int -> SRT -> SRT
-constructSRT table (SRTEntries entries)
+constructSRT :: DynFlags -> IdEnv Int -> SRT -> SRT
+constructSRT dflags table (SRTEntries entries)
  | isEmptyVarSet entries = NoSRT
  | otherwise  = seqBitmap bitmap $ SRT offset len bitmap
   where
@@ -152,9 +153,9 @@ constructSRT table (SRTEntries entries)
     offset = head sorted_ints
     bitmap_entries = map (subtract offset) sorted_ints
     len = last bitmap_entries + 1
-    bitmap = intsToBitmap len bitmap_entries
-constructSRT _ NoSRT = panic "constructSRT NoSRT"
-constructSRT _ (SRT {}) = panic "constructSRT SRT"
+    bitmap = intsToBitmap dflags len bitmap_entries
+constructSRT _ _ NoSRT = panic "constructSRT NoSRT"
+constructSRT _ _ (SRT {}) = panic "constructSRT SRT"
 
 -- ---------------------------------------------------------------------------
 -- Misc stuff
diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs
index 635df3ce41..129d8c6423 100644
--- a/compiler/simplStg/SimplStg.lhs
+++ b/compiler/simplStg/SimplStg.lhs
@@ -58,7 +58,7 @@ stg2stg dflags module_name binds
         ; let un_binds = unarise us1 processed_binds
         ; let srt_binds
                | dopt Opt_TryNewCodeGen dflags = zip un_binds (repeat [])
-               | otherwise = computeSRTs un_binds
+               | otherwise = computeSRTs dflags un_binds
 
 	; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
 	     		(pprStgBindingsWithSRTs srt_binds)