Make StgWord a portable type too

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

8 files changed, 38 insertions, 40 deletions

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