diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index f6d1ddde58cd3c56eff5c414edaa69b41fc6eacd..afba245fbc98af9d5582247bb09920681a929897 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -286,22 +286,23 @@ cmmOffsetLitB = cmmOffsetLit
-----------------------
-- The "W" variants take word offsets
+
cmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
-- The second arg is a *word* offset; need to change it to bytes
cmmOffsetExprW dflags e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n)
cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off
cmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW dflags e n = cmmOffsetB dflags e (wORD_SIZE dflags * n)
+cmmOffsetW dflags e n = cmmOffsetB dflags e (wordsToBytes dflags n)
cmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr
-cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE dflags)
+cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wordsToBytes dflags wd_off)
cmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit
-cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wORD_SIZE dflags * wd_off)
+cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wordsToBytes dflags wd_off)
cmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit
-cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wORD_SIZE dflags * wd_off)
+cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wordsToBytes dflags wd_off)
cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 0185ababe50fda2a99a8d2300d1f4bd3ed0f61b8..6c7b70015c5749f51ff3f89649ef72f566d58415 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -10,11 +10,13 @@ Storage manager representation of closures
module SMRep (
-- * Words and bytes
+ WordOff, ByteOff,
+ wordsToBytes, bytesToWordsRoundUp,
+ roundUpToWords,
+
StgWord, fromStgWord, toStgWord,
StgHalfWord, fromStgHalfWord, toStgHalfWord,
hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
- WordOff, ByteOff,
- roundUpToWords,
-- * Closure repesentation
SMRep(..), -- CmmInfo sees the rep; no one else does
@@ -67,7 +69,15 @@ type WordOff = Int -- Word offset, or word count
type ByteOff = Int -- Byte offset, or byte count
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
-roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
+roundUpToWords dflags n =
+ (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
+
+wordsToBytes :: DynFlags -> WordOff -> ByteOff
+wordsToBytes dflags n = wORD_SIZE dflags * n
+
+bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
+bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
+ where word_size = wORD_SIZE dflags
\end{code}
StgWord is a type representing an StgWord on the target platform.
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 45319032286e16bdc502c09650444dd453567bc0..c29f47c7f488ec80c1e0e375c9305925710717ea 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -286,7 +286,8 @@ mkRhsClosure dflags bndr _cc _bi
-- Just want the layout
maybe_offset = assocMaybe params_w_offsets (NonVoid selectee)
Just the_offset = maybe_offset
- offset_into_int = the_offset - fixedHdrSize dflags
+ offset_into_int = bytesToWordsRoundUp dflags the_offset
+ - fixedHdrSize dflags
---------- Note [Ap thunks] ------------------
mkRhsClosure dflags bndr _cc _bi
@@ -341,7 +342,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body
; dflags <- getDynFlags
; let name = idName bndr
descr = closureDescription dflags mod_name name
- fv_details :: [(NonVoid Id, VirtualHpOffset)]
+ fv_details :: [(NonVoid Id, ByteOff)]
(tot_wds, ptr_wds, fv_details)
= mkVirtHeapOffsets dflags (isLFThunk lf_info)
(addIdReps (map unsafe_stripNV reduced_fvs))
@@ -434,7 +435,7 @@ closureCodeBody :: Bool -- whether this is a top-level binding
-> [NonVoid Id] -- incoming args to the closure
-> Int -- arity, including void args
-> StgExpr
- -> [(NonVoid Id, VirtualHpOffset)] -- the closure's free vars
+ -> [(NonVoid Id, ByteOff)] -- the closure's free vars
-> FCode ()
{- There are two main cases for the code for closures.
@@ -514,10 +515,10 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
-- A function closure pointer may be tagged, so we
-- must take it into account when accessing the free variables.
-bind_fv :: (NonVoid Id, VirtualHpOffset) -> FCode (LocalReg, WordOff)
+bind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }
-load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, WordOff)] -> FCode ()
+load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
load_fvs node lf_info = mapM_ (\ (reg, off) ->
do dflags <- getDynFlags
let tag = lfDynTag dflags lf_info
@@ -551,7 +552,7 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
| otherwise = return ()
-----------------------------------------
-thunkCode :: ClosureInfo -> [(NonVoid Id, VirtualHpOffset)] -> CostCentreStack
+thunkCode :: ClosureInfo -> [(NonVoid Id, ByteOff)] -> CostCentreStack
-> LocalReg -> Int -> StgExpr -> FCode ()
thunkCode cl_info fv_details _cc node arity body
= do { dflags <- getDynFlags
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index eb00bbf0c0a2ad2b8cf564f6b5f5772f1e98f41d..b6bcf6912bb8e6c084d050b705952e4e78c394f0 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -21,6 +21,7 @@ import CoreSyn ( AltCon(..) )
import StgCmmMonad
import StgCmmEnv
import StgCmmHeap
+import StgCmmLayout
import StgCmmUtils
import StgCmmClosure
import StgCmmProf ( curCCS )
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 077b7809b53b9f68ee54913909c6594a672c9803..75ad8b40f4b1a6d538e2250c3912726bc3d740c0 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -14,7 +14,6 @@ module StgCmmHeap (
heapStackCheckGen,
entryHeapCheck',
- mkVirtHeapOffsets, mkVirtConstrOffsets,
mkStaticClosureFields, mkStaticClosure,
allocDynClosure, allocDynClosureCmm,
@@ -68,7 +67,7 @@ allocDynClosure
allocDynClosureCmm
:: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
- -> [(CmmExpr, VirtualHpOffset)]
+ -> [(CmmExpr, ByteOff)]
-> FCode CmmExpr -- returns Hp+n
-- allocDynClosure allocates the thing in the heap,
@@ -130,18 +129,18 @@ allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets
emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
emitSetDynHdr base info_ptr ccs
= do dflags <- getDynFlags
- hpStore base (header dflags) [0..]
+ hpStore base (header dflags) [0, wORD_SIZE dflags ..]
where
header :: DynFlags -> [CmmExpr]
header dflags = [info_ptr] ++ dynProfHdr dflags ccs
-- ToDof: Parallel stuff
-- No ticky header
-hpStore :: CmmExpr -> [CmmExpr] -> [VirtualHpOffset] -> FCode ()
+hpStore :: CmmExpr -> [CmmExpr] -> [ByteOff] -> FCode ()
-- Store the item (expr,off) in base[off]
hpStore base vals offs
= do dflags <- getDynFlags
- let mk_store val off = mkStore (cmmOffsetW dflags base off) val
+ let mk_store val off = mkStore (cmmOffsetB dflags base off) val
emit (catAGraphs (zipWith mk_store vals offs))
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 54e2e920f91fdff14422e38e47ecc60d721f54b4..7fbcbced81d4344f2be6a9d6ed5e565caffcdc34 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -384,7 +384,7 @@ mkVirtHeapOffsets
-> [(PrimRep,a)] -- Things to make offsets for
-> (WordOff, -- _Total_ number of words allocated
WordOff, -- Number of words allocated for *pointers*
- [(NonVoid a, VirtualHpOffset)])
+ [(NonVoid a, ByteOff)])
-- Things with their offsets from start of object in order of
-- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER
@@ -397,22 +397,31 @@ mkVirtHeapOffsets
-- than the unboxed things
mkVirtHeapOffsets dflags is_thunk things
- = let non_void_things = filterOut (isVoidRep . fst) things
- (ptrs, non_ptrs) = partition (isGcPtrRep . fst) non_void_things
- (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
- (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
- in
- (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
+ = ( bytesToWordsRoundUp dflags tot_bytes
+ , bytesToWordsRoundUp dflags bytes_of_ptrs
+ , ptrs_w_offsets ++ non_ptrs_w_offsets
+ )
where
- hdr_size | is_thunk = thunkHdrSize dflags
- | otherwise = fixedHdrSize dflags
-
- computeOffset wds_so_far (rep, thing)
- = (wds_so_far + argRepSizeW dflags (toArgRep rep),
- (NonVoid thing, hdr_size + wds_so_far))
-
-mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)])
--- Just like mkVirtHeapOffsets, but for constructors
+ hdr_words | is_thunk = thunkHdrSize dflags
+ | otherwise = fixedHdrSize dflags
+ hdr_bytes = wordsToBytes dflags hdr_words
+
+ non_void_things = filterOut (isVoidRep . fst) things
+ (ptrs, non_ptrs) = partition (isGcPtrRep . fst) non_void_things
+
+ (bytes_of_ptrs, ptrs_w_offsets) =
+ mapAccumL computeOffset 0 ptrs
+ (tot_bytes, non_ptrs_w_offsets) =
+ mapAccumL computeOffset bytes_of_ptrs non_ptrs
+
+ computeOffset bytes_so_far (rep, thing)
+ = (bytes_so_far + wordsToBytes dflags (argRepSizeW dflags (toArgRep rep)),
+ (NonVoid thing, hdr_bytes + bytes_so_far))
+
+-- | Just like mkVirtHeapOffsets, but for constructors
+mkVirtConstrOffsets
+ :: DynFlags -> [(PrimRep,a)]
+ -> (WordOff, WordOff, [(NonVoid a, ByteOff)])
mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 45b0f0c785f81aafa0406cef08fa32f2b7d4ef58..1c6c3f2eae986956025f4444c474c18b085fa7cd 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -142,7 +142,8 @@ addToMemE rep ptr n
--
-------------------------------------------------------------------------
-mkTaggedObjectLoad :: DynFlags -> LocalReg -> LocalReg -> WordOff -> DynTag -> CmmAGraph
+mkTaggedObjectLoad
+ :: DynFlags -> LocalReg -> LocalReg -> ByteOff -> DynTag -> CmmAGraph
-- (loadTaggedObjectField reg base off tag) generates assignment
-- reg = bitsK[ base + off - tag ]
-- where K is fixed by 'reg'
@@ -150,7 +151,7 @@ mkTaggedObjectLoad dflags reg base offset tag
= mkAssign (CmmLocal reg)
(CmmLoad (cmmOffsetB dflags
(CmmReg (CmmLocal base))
- (wORD_SIZE dflags * offset - tag))
+ (offset - tag))
(localRegType reg))
-------------------------------------------------------------------------