Make StgWord a portable type too

StgWord is a newtyped Word64, as it needed to be something that
has a UArray instance.

17 files changed, 105 insertions, 70 deletions

diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs
index 93217d5192..d48ab93093 100644
--- a/compiler/cmm/Bitmap.hs
+++ b/compiler/cmm/Bitmap.hs
@@ -39,12 +39,12 @@ type Bitmap = [StgWord]
 -- | Make a bitmap from a sequence of bits
 mkBitmap :: DynFlags -> [Bool] -> Bitmap
 mkBitmap _ [] = []
-mkBitmap dflags stuff = chunkToBitmap chunk : mkBitmap dflags rest
+mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
   where (chunk, rest) = splitAt (wORD_SIZE_IN_BITS dflags) stuff
 
-chunkToBitmap :: [Bool] -> StgWord
-chunkToBitmap chunk = 
-  foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
+chunkToBitmap :: DynFlags -> [Bool] -> StgWord
+chunkToBitmap dflags chunk =
+  foldr (.|.) (toStgWord dflags 0) [ toStgWord dflags 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
 
 -- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
 -- eg. @[0,1,3], size 4 ==> 0xb@.
@@ -54,7 +54,7 @@ intsToBitmap :: DynFlags -> Int -> [Int] -> Bitmap
 intsToBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
   | otherwise = 
-    (foldr (.|.) 0 (map (1 `shiftL`) these)) : 
+    (foldr (.|.) (toStgWord dflags 0) (map (toStgWord dflags 1 `shiftL`) these)) : 
         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
@@ -68,12 +68,12 @@ intsToReverseBitmap :: DynFlags -> Int -> [Int] -> Bitmap
 intsToReverseBitmap dflags size slots{- must be sorted -}
   | size <= 0 = []
   | otherwise = 
-    (foldr xor init (map (1 `shiftL`) these)) :
+    (foldr xor (toStgWord dflags init) (map (toStgWord dflags 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
+           | size >= wORD_SIZE_IN_BITS dflags = -1
            | otherwise                        = (1 `shiftL` size) - 1
 
 {- |
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index fe8c599ef6..d587d60f95 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -228,17 +228,17 @@ maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
 to_SRT :: DynFlags -> CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
 to_SRT dflags top_srt off len bmp
-  | len > maxBmpSize dflags || bmp == [fromInteger (fromStgHalfWord (srt_escape dflags))]
+  | len > maxBmpSize dflags || bmp == [toStgWord dflags (fromStgHalfWord (srt_escape dflags))]
   = do id <- getUniqueM
        let srt_desc_lbl = mkLargeSRTLabel id
            tbl = CmmData RelocatableReadOnlyData $
                    Statics srt_desc_lbl $ map CmmStaticLit
                      ( cmmLabelOffW dflags top_srt off
-                     : mkWordCLit dflags (fromIntegral len)
+                     : mkWordCLit dflags (toStgWord dflags (fromIntegral len))
                      : map (mkWordCLit dflags) bmp)
        return (Just tbl, C_SRT srt_desc_lbl 0 (srt_escape dflags))
   | otherwise
-  = return (Nothing, C_SRT top_srt off (toStgHalfWord dflags (toInteger (head bmp))))
+  = return (Nothing, C_SRT top_srt off (toStgHalfWord dflags (fromStgWord (head bmp))))
 	-- The fromIntegral converts to StgHalfWord
 
 -- Gather CAF info for a procedure, but only if the procedure
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 4dd74438ac..9d335c6f7b 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -321,13 +321,13 @@ mkLivenessBits dflags liveness
     bitmap = mkBitmap dflags liveness
 
     small_bitmap = case bitmap of 
-		     []  -> 0
+                     []  -> toStgWord dflags 0
                      [b] -> b
 		     _   -> panic "mkLiveness"
-    bitmap_word = fromIntegral n_bits
+    bitmap_word = toStgWord dflags (fromIntegral n_bits)
               .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags)
 
-    lits = mkWordCLit dflags (fromIntegral n_bits) : map (mkWordCLit dflags) bitmap
+    lits = mkWordCLit dflags (toStgWord dflags (fromIntegral n_bits)) : map (mkWordCLit dflags) bitmap
       -- The first word is the size.  The structure must match
       -- StgLargeBitmap in includes/rts/storage/InfoTable.h
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index e064149630..8c3559b774 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -312,12 +312,12 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
                      -- If profiling is on, this string gets duplicated,
                      -- but that's the way the old code did it we can fix it some other time.
 
-        | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' stgHalfWord ',' STRING ',' STRING ')'
+        | 'INFO_TABLE_SELECTOR' '(' NAME ',' stgWord ',' stgHalfWord ',' STRING ',' STRING ')'
                 -- selector, closure type, description, type
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $9 $11
-                          ty  = ThunkSelector (fromIntegral $5)
+                          ty  = ThunkSelector $5
                           rep = mkRTSRep $7 $
                                    mkHeapRep dflags False 0 0 ty
                       return (mkCmmEntryLabel pkg $3,
@@ -614,6 +614,9 @@ typenot8 :: { CmmType }
         | 'float64'             { f64 }
         | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
 
+stgWord :: { StgWord }
+        : INT                   {% do dflags <- getDynFlags; return $ toStgWord dflags $1 }
+
 stgHalfWord :: { StgHalfWord }
         : INT                   {% do dflags <- getDynFlags; return $ toStgHalfWord dflags $1 }
 
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index fab384cd3c..cde5bd1d20 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -156,7 +156,7 @@ mkRODataLits lbl lits
     needsRelocation _                 = False
 
 mkWordCLit :: DynFlags -> StgWord -> CmmLit
-mkWordCLit dflags wd = CmmInt (fromIntegral wd) (wordWidth dflags)
+mkWordCLit dflags wd = CmmInt (fromStgWord wd) (wordWidth dflags)
 
 packHalfWordsCLit :: DynFlags -> StgHalfWord -> StgHalfWord -> CmmLit
 -- Make a single word literal in which the lower_half_word is
@@ -168,8 +168,8 @@ packHalfWordsCLit dflags lower_half_word upper_half_word
    = if wORDS_BIGENDIAN dflags
      then mkWordCLit dflags ((l `shiftL` hALF_WORD_SIZE_IN_BITS) .|. u)
      else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS))
-    where l = fromInteger (fromStgHalfWord lower_half_word)
-          u = fromInteger (fromStgHalfWord upper_half_word)
+    where l = toStgWord dflags (fromStgHalfWord lower_half_word)
+          u = toStgWord dflags (fromStgHalfWord upper_half_word)
 
 ---------------------------------------------------
 --
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 4443158f89..bf30374092 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -9,9 +9,11 @@ This is here, rather than in ClosureInfo, just to keep nhc happy.
 Other modules should access this info through ClosureInfo.
 
 \begin{code}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module SMRep (
         -- * Words and bytes
-        StgWord,
+        StgWord, fromStgWord, toStgWord,
         StgHalfWord, fromStgHalfWord, toStgHalfWord,
         hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
         WordOff, ByteOff,
@@ -50,6 +52,7 @@ import Outputable
 import Platform
 import FastString
 
+import Data.Array.Base
 import Data.Char( ord )
 import Data.Word
 import Data.Bits
@@ -73,6 +76,30 @@ roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZ
 StgWord is a type representing an StgWord on the target platform.
 
 \begin{code}
+newtype StgWord = StgWord Word64
+    deriving (Eq,
+#if __GLASGOW_HASKELL__ < 706
+              Num,
+#endif
+              Bits, IArray UArray)
+
+fromStgWord :: StgWord -> Integer
+fromStgWord (StgWord i) = toInteger i
+
+toStgWord :: DynFlags -> Integer -> StgWord
+toStgWord dflags i
+    = case platformWordSize (targetPlatform dflags) of
+      -- These conversions mean that things like toStgWord (-1)
+      -- do the right thing
+      4 -> StgWord (fromIntegral (fromInteger i :: Word32))
+      8 -> StgWord (fromInteger i :: Word64)
+      w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)
+
+instance Outputable StgWord where
+    ppr (StgWord i) = integer (toInteger i)
+
+--
+
 newtype StgHalfWord = StgHalfWord Integer
     deriving Eq
 
@@ -92,13 +119,11 @@ instance Outputable StgHalfWord where
     ppr (StgHalfWord i) = integer i
 
 #if SIZEOF_HSWORD == 4
-type StgWord     = Word32
 hALF_WORD_SIZE :: ByteOff
 hALF_WORD_SIZE = 2
 hALF_WORD_SIZE_IN_BITS :: Int
 hALF_WORD_SIZE_IN_BITS = 16
 #elif SIZEOF_HSWORD == 8
-type StgWord     = Word64
 hALF_WORD_SIZE :: ByteOff
 hALF_WORD_SIZE = 4
 hALF_WORD_SIZE_IN_BITS :: Int
@@ -396,7 +421,7 @@ pprTypeInfo (Fun arity args)
                 , ptext (sLit ("fun_type:")) <+> ppr args ])
 
 pprTypeInfo (ThunkSelector offset)
-  = ptext (sLit "ThunkSel") <+> integer (toInteger offset)
+  = ptext (sLit "ThunkSel") <+> ppr offset
 
 pprTypeInfo Thunk     = ptext (sLit "Thunk")
 pprTypeInfo BlackHole = ptext (sLit "BlackHole")
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index e468936a7a..1f5b711d86 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -121,13 +121,13 @@ stdPattern dflags reps
 -- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
 -------------------------------------------------------------------------
 
-mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
-mkRegLiveness regs ptrs nptrs
-  = (fromIntegral nptrs `shiftL` 16) .|.
-    (fromIntegral ptrs  `shiftL` 24) .|.
-    all_non_ptrs `xor` reg_bits regs
+mkRegLiveness :: DynFlags -> [(Id, GlobalReg)] -> Int -> Int -> StgWord
+mkRegLiveness dflags regs ptrs nptrs
+  = (toStgWord dflags (toInteger nptrs) `shiftL` 16) .|.
+    (toStgWord dflags (toInteger ptrs)  `shiftL` 24) .|.
+    all_non_ptrs `xor` toStgWord dflags (reg_bits regs)
   where
-    all_non_ptrs = 0xff
+    all_non_ptrs = toStgWord dflags 0xff
 
     reg_bits [] = 0
     reg_bits ((id, VanillaReg i _) : regs) | isFollowableArg (idCgRep id)
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index c7f6f294ce..965abf0db8 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -416,7 +416,7 @@ unbxTupleHeapCheck regs ptrs nptrs fail_code code
         ; let full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
               assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9 VNonGcPtr))    -- Ho ho ho!
                                           (CmmLit (mkWordCLit dflags liveness))
-              liveness        = mkRegLiveness regs ptrs nptrs
+              liveness        = mkRegLiveness dflags regs ptrs nptrs
               live            = Just $ map snd regs
               rts_label       = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
         ; codeOnly $ do { do_checks 0 {- no stack check -} hpHw
diff --git a/compiler/codeGen/CgParallel.hs b/compiler/codeGen/CgParallel.hs
index c86ef9e34a..fdc9846694 100644
--- a/compiler/codeGen/CgParallel.hs
+++ b/compiler/codeGen/CgParallel.hs
@@ -51,12 +51,11 @@ granFetchAndReschedule :: [(Id,GlobalReg)]  -- Live registers
 -- Emit code for simulating a fetch and then reschedule.
 granFetchAndReschedule regs node_reqd
   = do dflags <- getDynFlags
+       let liveness = mkRegLiveness dflags regs 0 0
        when (dopt Opt_GranMacros dflags &&
              (node `elem` map snd regs || node_reqd)) $
            do fetch
               reschedule liveness node_reqd
-  where
-    liveness = mkRegLiveness regs 0 0
 
 fetch :: FCode ()
 fetch = panic "granFetch"
@@ -90,9 +89,8 @@ granYield :: [(Id,GlobalReg)]   -- Live registers
 
 granYield regs node_reqd
   = do dflags <- getDynFlags
+       let liveness = mkRegLiveness dflags regs 0 0
        when (dopt Opt_GranMacros dflags && node_reqd) $ yield liveness
-  where
-     liveness = mkRegLiveness regs 0 0
 
 yield :: StgWord -> Code
 yield _liveness = panic "granYield"
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 1c78dd8ec6..9848d345e9 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -266,7 +266,7 @@ dynLdvInit :: DynFlags -> CmmExpr
 dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
   CmmMachOp (mo_wordOr dflags) [
       CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
-      CmmLit (mkWordCLit dflags lDV_STATE_CREATE)
+      CmmLit (mkWordCLit dflags (lDV_STATE_CREATE dflags))
   ]
 
 --
@@ -297,8 +297,8 @@ ldvEnter cl_ptr = do
         -- don't forget to substract node's tag
     ldv_wd = ldvWord dflags cl_ptr
     new_ldv_wd = cmmOrWord dflags (cmmAndWord dflags (CmmLoad ldv_wd (bWord dflags))
-                                                     (CmmLit (mkWordCLit dflags lDV_CREATE_MASK)))
-                 (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags lDV_STATE_USE)))
+                                                     (CmmLit (mkWordCLit dflags (lDV_CREATE_MASK dflags))))
+                 (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags (lDV_STATE_USE dflags))))
   ifProfiling $
      -- if (era > 0) {
      --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
@@ -321,12 +321,12 @@ lDV_SHIFT :: Int
 lDV_SHIFT = LDV_SHIFT
 --lDV_STATE_MASK :: StgWord
 --lDV_STATE_MASK   = LDV_STATE_MASK
-lDV_CREATE_MASK :: StgWord
-lDV_CREATE_MASK  = LDV_CREATE_MASK
+lDV_CREATE_MASK :: DynFlags -> StgWord
+lDV_CREATE_MASK dflags = toStgWord dflags LDV_CREATE_MASK
 --lDV_LAST_MASK    :: StgWord
 --lDV_LAST_MASK    = LDV_LAST_MASK
-lDV_STATE_CREATE :: StgWord
-lDV_STATE_CREATE = LDV_STATE_CREATE
-lDV_STATE_USE    :: StgWord
-lDV_STATE_USE    = LDV_STATE_USE
+lDV_STATE_CREATE :: DynFlags -> StgWord
+lDV_STATE_CREATE dflags = toStgWord dflags LDV_STATE_CREATE
+lDV_STATE_USE :: DynFlags -> StgWord
+lDV_STATE_USE dflags = toStgWord dflags LDV_STATE_USE
 
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 2abdb0e589..aee4c7b5b3 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -795,17 +795,17 @@ getSRTInfo = do
     NoSRT -> return NoC_SRT
     SRTEntries {} -> panic "getSRTInfo: SRTEntries.  Perhaps you forgot to run SimplStg?"
     SRT off len bmp
-      | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromInteger (fromStgHalfWord (srt_escape dflags))]
+      | len > hALF_WORD_SIZE_IN_BITS || bmp == [toStgWord dflags (fromStgHalfWord (srt_escape dflags))]
       -> do id <- newUnique
             let srt_desc_lbl = mkLargeSRTLabel id
             emitRODataLits "getSRTInfo" srt_desc_lbl
              ( cmmLabelOffW dflags srt_lbl off
-               : mkWordCLit dflags (fromIntegral len)
+               : mkWordCLit dflags (toStgWord dflags (toInteger len))
                : map (mkWordCLit dflags) bmp)
             return (C_SRT srt_desc_lbl 0 (srt_escape dflags))
 
       | otherwise
-      -> return (C_SRT srt_lbl off (toStgHalfWord dflags (toInteger (head bmp))))
+      -> return (C_SRT srt_lbl off (toStgHalfWord dflags (fromStgWord (head bmp))))
                 -- The fromIntegral converts to StgHalfWord
 
 srt_escape :: DynFlags -> StgHalfWord
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index f06ee7840c..740bfab845 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -530,12 +530,12 @@ lfClosureType :: DynFlags -> LambdaFormInfo -> ClosureTypeInfo
 lfClosureType dflags (LFReEntrant _ arity _ argd) = Fun (toStgHalfWord dflags (toInteger arity)) argd
 lfClosureType dflags (LFCon con)                  = Constr (toStgHalfWord dflags (toInteger (dataConTagZ con)))
                                                            (dataConIdentity con)
-lfClosureType _      (LFThunk _ _ _ is_sel _)     = thunkClosureType is_sel
+lfClosureType dflags (LFThunk _ _ _ is_sel _)     = thunkClosureType dflags is_sel
 lfClosureType _      _                            = panic "lfClosureType"
 
-thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
-thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
-thunkClosureType _                   = Thunk
+thunkClosureType :: DynFlags -> StandardFormInfo -> ClosureTypeInfo
+thunkClosureType dflags (SelectorThunk off) = ThunkSelector (toStgWord dflags (toInteger off))
+thunkClosureType _      _                   = Thunk
 
 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 -- gets compiled to a jump to g (if g has non-zero arity), instead of
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 2d767a6c6d..4be5bd3d0c 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -357,12 +357,12 @@ lfClosureType :: DynFlags -> LambdaFormInfo -> ClosureTypeInfo
 lfClosureType dflags (LFReEntrant _ arity _ argd) = Fun (toStgHalfWord dflags (toInteger arity)) argd
 lfClosureType dflags (LFCon con)                  = Constr (toStgHalfWord dflags (toInteger (dataConTagZ con)))
                                                            (dataConIdentity con)
-lfClosureType _      (LFThunk _ _ _ is_sel _)     = thunkClosureType is_sel
+lfClosureType dflags (LFThunk _ _ _ is_sel _)     = thunkClosureType dflags is_sel
 lfClosureType _      _                            = panic "lfClosureType"
 
-thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
-thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
-thunkClosureType _                   = Thunk
+thunkClosureType :: DynFlags -> StandardFormInfo -> ClosureTypeInfo
+thunkClosureType dflags (SelectorThunk off) = ThunkSelector (toStgWord dflags (toInteger off))
+thunkClosureType _      _                   = Thunk
 
 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 -- gets compiled to a jump to g (if g has non-zero arity), instead of
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index d2f4984538..30ced9a1ff 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -329,7 +329,7 @@ dynLdvInit :: DynFlags -> CmmExpr
 dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE  
   CmmMachOp (mo_wordOr dflags) [
       CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
-      CmmLit (mkWordCLit dflags lDV_STATE_CREATE)
+      CmmLit (mkWordCLit dflags (lDV_STATE_CREATE dflags))
   ]
         
 --
@@ -358,8 +358,8 @@ ldvEnter cl_ptr = do
     let -- don't forget to substract node's tag
         ldv_wd = ldvWord dflags cl_ptr
         new_ldv_wd = cmmOrWord dflags (cmmAndWord dflags (CmmLoad ldv_wd (bWord dflags))
-                                                         (CmmLit (mkWordCLit dflags lDV_CREATE_MASK)))
-                                      (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags lDV_STATE_USE)))
+                                                         (CmmLit (mkWordCLit dflags (lDV_CREATE_MASK dflags))))
+                                      (cmmOrWord dflags (loadEra dflags) (CmmLit (mkWordCLit dflags (lDV_STATE_USE dflags))))
     ifProfiling $
          -- if (era > 0) {
          --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
@@ -384,12 +384,12 @@ lDV_SHIFT :: Int
 lDV_SHIFT = LDV_SHIFT
 --lDV_STATE_MASK :: StgWord
 --lDV_STATE_MASK   = LDV_STATE_MASK
-lDV_CREATE_MASK :: StgWord
-lDV_CREATE_MASK  = LDV_CREATE_MASK
+lDV_CREATE_MASK :: DynFlags -> StgWord
+lDV_CREATE_MASK dflags = toStgWord dflags LDV_CREATE_MASK
 --lDV_LAST_MASK :: StgWord
 --lDV_LAST_MASK    = LDV_LAST_MASK
-lDV_STATE_CREATE :: StgWord
-lDV_STATE_CREATE = LDV_STATE_CREATE
-lDV_STATE_USE :: StgWord
-lDV_STATE_USE    = LDV_STATE_USE
+lDV_STATE_CREATE :: DynFlags -> StgWord
+lDV_STATE_CREATE dflags = toStgWord dflags LDV_STATE_CREATE
+lDV_STATE_USE :: DynFlags -> StgWord
+lDV_STATE_USE dflags = toStgWord dflags LDV_STATE_USE
 
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 15c41d044e..f00e45c6b6 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -166,7 +166,7 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
       insns_arr = listArray (0, n_insns - 1) asm_insns
       !insns_barr = barr insns_arr
 
-      bitmap_arr = mkBitmapArray bsize bitmap
+      bitmap_arr = mkBitmapArray dflags bsize bitmap
       !bitmap_barr = barr bitmap_arr
 
       ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
@@ -178,9 +178,9 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d
 
   return ul_bco
 
-mkBitmapArray :: Word16 -> [StgWord] -> UArray Int StgWord
-mkBitmapArray bsize bitmap
-  = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
+mkBitmapArray :: DynFlags -> Word16 -> [StgWord] -> UArray Int StgWord
+mkBitmapArray dflags bsize bitmap
+  = listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap)
 
 -- instrs nonptrs ptrs
 type AsmState = (SizedSeq Word16,
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index ada0be6f0f..ed49960709 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -178,7 +178,7 @@ instance Outputable a => Outputable (ProtoBCO a) where
                       Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';'))
                                                        (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}'
                       Right rhs -> pprCoreExprShort (deAnnotate rhs))
-        $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
+        $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> ppr bitmap)
         $$ nest 3 (vcat (map ppr instrs))
 
 -- Print enough of the Core expression to enable the reader to find
diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs
index ab7fcd1764..b1688d85f8 100644
--- a/compiler/ghci/DebuggerUtils.hs
+++ b/compiler/ghci/DebuggerUtils.hs
@@ -9,11 +9,11 @@ import TcRnTypes
 import TcRnMonad
 import IfaceEnv
 import CgInfoTbls
-import SMRep
 import Module
 import OccName
 import Name
 import Outputable
+import Platform
 import Util
 
 import Data.Char
@@ -93,8 +93,17 @@ dataConInfoPtrToName x = do
    getConDescAddress :: DynFlags -> Ptr StgInfoTable -> IO (Ptr Word8)
    getConDescAddress dflags ptr
     | ghciTablesNextToCode = do
-       offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE dflags)
-       return $ (ptr `plusPtr` stdInfoTableSizeB dflags) `plusPtr` (fromIntegral (offsetToString :: StgWord))
+       let ptr' = ptr `plusPtr` (- wORD_SIZE dflags)
+       -- offsetToString is really an StgWord, but we have to jump
+       -- through some hoops due to the way that our StgWord Haskell
+       -- type is the same on 32 and 64bit platforms
+       offsetToString <- case platformWordSize (targetPlatform dflags) of
+                         4 -> do w <- peek ptr'
+                                 return (fromIntegral (w :: Word32))
+                         8 -> do w <- peek ptr'
+                                 return (fromIntegral (w :: Word64))
+                         w -> panic ("getConDescAddress: Unknown platformWordSize: " ++ show w)
+       return $ (ptr `plusPtr` stdInfoTableSizeB dflags) `plusPtr` offsetToString
     | otherwise =
        peek $ intPtrToPtr $ ptrToIntPtr ptr + fromIntegral (stdInfoTableSizeB dflags)
    -- parsing names is a little bit fiddly because we have a string in the form: