Commit a70e7b47 authored by Simon Marlow's avatar Simon Marlow Committed by tibbe

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.
parent 22f010e0
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -21,6 +21,7 @@ import CoreSyn ( AltCon(..) )
import StgCmmMonad
import StgCmmEnv
import StgCmmHeap
import StgCmmLayout
import StgCmmUtils
import StgCmmClosure
import StgCmmProf ( curCCS )
......
......@@ -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))
......
......@@ -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
......
......@@ -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))
-------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment