Represent offsets into heap objects with byte, not word, offsets

I'd like to be able to pack together non-pointer fields that are less
than a word in size, and this is a necessary prerequisite.

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

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.

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

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 )

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))
 
 

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
 
 

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))
 
 -------------------------------------------------------------------------