From a70e7b4762c75812254f7781bcd48139c4ec40dd Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Fri, 29 Nov 2013 10:32:26 +0000
Subject: [PATCH] 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 | 9 +++----
compiler/cmm/SMRep.lhs | 16 ++++++++++---
compiler/codeGen/StgCmmBind.hs | 13 +++++-----
compiler/codeGen/StgCmmCon.hs | 1 +
compiler/codeGen/StgCmmHeap.hs | 9 ++++---
compiler/codeGen/StgCmmLayout.hs | 41 +++++++++++++++++++-------------
compiler/codeGen/StgCmmUtils.hs | 5 ++--
7 files changed, 58 insertions(+), 36 deletions(-)
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index f6d1ddde58cd..afba245fbc98 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 0185ababe50f..6c7b70015c57 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 45319032286e..c29f47c7f488 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 eb00bbf0c0a2..b6bcf6912bb8 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 077b7809b53b..75ad8b40f4b1 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 54e2e920f91f..7fbcbced81d4 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 45b0f0c785f8..1c6c3f2eae98 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))
-------------------------------------------------------------------------
--
GitLab