Commit 05b8ee21 authored by Simon Marlow's avatar Simon Marlow

Build info tables with the new stack layout code

parent b9d3e608
......@@ -14,7 +14,7 @@
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module CmmBuildInfoTables
( CAFSet, CAFEnv, cafAnal, localCAFInfo, mkTopCAFInfo
, setInfoTableSRT, setInfoTableStackMap
, setInfoTableSRT
, TopSRT, emptySRT, srtToData
, bundleCAFs
, lowerSafeForeignCalls
......@@ -73,121 +73,6 @@ foldSet = Set.foldr
-- Building InfoTables
-----------------------------------------------------------------------
-- Stack Maps
-- Given a block ID, we return a representation of the layout of the stack,
-- as suspended before entering that block.
-- (For a return site to a function call, the layout does not include the
-- parameter passing area (or the "return address" on the stack)).
-- If the element is `Nothing`, then it represents a word of the stack that
-- does not contain a live pointer.
-- If the element is `Just` a register, then it represents a live spill slot
-- for a pointer; we assume that a pointer is the size of a word.
-- The head of the list represents the young end of the stack where the infotable
-- pointer for the block `Bid` is stored.
-- The infotable pointer itself is not included in the list.
-- Call areas are also excluded from the list: besides the stuff in the update
-- frame (and the return infotable), call areas should never be live across
-- function calls.
-- RTS Invariant: All pointers must be word-aligned because each bit in the bitmap
-- represents a word. Consequently, we have to be careful when we see a live slot
-- on the stack: if we have packed multiple sub-word values into a word,
-- we have to make sure that we only mark the entire word as a non-pointer.
-- Also, don't forget to stop at the old end of the stack (oldByte),
-- which may differ depending on whether there is an update frame.
{-
type RegSlotInfo
= ( Int -- Offset from oldest byte of Old area
, LocalReg -- The register
, Int) -- Width of the register
live_ptrs :: ByteOff -> BlockEnv SubAreaSet -> AreaMap -> BlockId -> StackLayout
live_ptrs oldByte slotEnv areaMap bid =
-- pprTrace "live_ptrs for" (ppr bid <+> text (show oldByte ++ "-" ++ show youngByte) <+>
-- ppr liveSlots) $
-- pprTrace ("stack layout for " ++ show bid ++ ": ") (ppr res) $ res
res
where
res = mkLiveness (reverse $ slotsToList youngByte liveSlots [])
slotsToList :: Int -> [RegSlotInfo] -> [Maybe LocalReg] -> [Maybe LocalReg]
-- n starts at youngByte and is decremented down to oldByte
-- Returns a list, one element per word, with
-- (Just r) meaning 'pointer register r is saved here',
-- Nothing meaning 'non-pointer or empty'
slotsToList n [] results | n == oldByte = results -- at old end of stack frame
slotsToList n (s : _) _ | n == oldByte =
pprPanic "slot left off live_ptrs" (ppr s <+> ppr oldByte <+>
ppr n <+> ppr liveSlots <+> ppr youngByte)
slotsToList n _ _ | n < oldByte =
panic "stack slots not allocated on word boundaries?"
slotsToList n l@((n', r, w) : rst) results =
if n == (n' + w) then -- slot's young byte is at n
ASSERT (not (isPtr r) ||
(n `mod` wORD_SIZE == 0 && w == wORD_SIZE)) -- ptrs must be aligned
slotsToList next (dropWhile (non_ptr_younger_than next) rst)
(stack_rep : results)
else slotsToList next (dropWhile (non_ptr_younger_than next) l)
(Nothing : results)
where next = n - wORD_SIZE
stack_rep = if isPtr r then Just r else Nothing
slotsToList n [] results = slotsToList (n - wORD_SIZE) [] (Nothing : results)
non_ptr_younger_than next (n', r, w) =
n' + w > next &&
ASSERT (not (isPtr r))
True
isPtr = isGcPtrType . localRegType
liveSlots :: [RegSlotInfo]
liveSlots = sortBy (\ (off,_,_) (off',_,_) -> compare off' off)
(Map.foldRightWithKey (\_ -> flip $ foldl add_slot) [] slots)
add_slot :: [RegSlotInfo] -> SubArea -> [RegSlotInfo]
add_slot rst (a@(RegSlot r@(LocalReg _ ty)), off, w) =
if off == w && widthInBytes (typeWidth ty) == w then
(expectJust "add_slot" (Map.lookup a areaMap), r, w) : rst
else panic "live_ptrs: only part of a variable live at a proc point"
add_slot rst (CallArea Old, _, _) =
rst -- the update frame (or return infotable) should be live
-- would be nice to check that only that part of the callarea is live...
add_slot rst ((CallArea _), _, _) =
rst
-- JD: THIS ISN'T CURRENTLY A CORRECTNESS PROBLEM, BUT WE SHOULD REALLY
-- MAKE LIVENESS INFO AROUND CALLS MORE PRECISE -- FOR NOW, A 32-BIT
-- FLOAT PADS OUT TO 64 BITS, BUT WE ASSUME THE WHOLE PARAMETER-PASSING
-- AREA IS LIVE (WHICH IT ISN'T...). WE SHOULD JUST PUT THE LIVE AREAS
-- IN THE CALL NODES, WHICH SHOULD EVENTUALLY HAVE LIVE REGISTER AS WELL,
-- SO IT'S ALL GOING IN THE SAME DIRECTION.
-- pprPanic "CallAreas must not be live across function calls" (ppr bid <+> ppr c)
slots :: SubAreaSet -- The SubAreaSet for 'bid'
slots = expectJust "live_ptrs slots" $ mapLookup bid slotEnv
youngByte = expectJust "live_ptrs bid_pos" $ Map.lookup (CallArea (Young bid)) areaMap
-}
-- Construct the stack maps for a procedure _if_ it needs an infotable.
-- When wouldn't a procedure need an infotable? If it is a procpoint that
-- is not the successor of a call.
{-
setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmDecl -> CmmDecl
setInfoTableStackMap slotEnv areaMap
t@(CmmProc (TopInfo {stack_info=StackInfo {updfr_space = Just updfr_off}}) _
(CmmGraph {g_entry = eid}))
= updInfo (const (live_ptrs updfr_off slotEnv areaMap eid)) id t
-}
setInfoTableStackMap _ _ t = t
-----------------------------------------------------------------------
-- SRTs
......
{-# LANGUAGE RecordWildCards, GADTs #-}
module CmmLayoutStack (
cmmLayoutStack
cmmLayoutStack, setInfoTableStackMap
) where
import Cmm
......@@ -39,26 +39,49 @@ instance Outputable StackSlot where
-- "base", which is defined to be the address above the return address
-- on the stack on entry to this CmmProc.
--
-- | | <- base
-- |-----------|
-- | ret | <- base + 8
-- |-----------|
-- . .
-- . .
--
-- Lower addresses have higher StackLocs.
--
type StackLoc = ByteOff
{-
A StackMap describes the stack at any given point. At a continuation
it has a particular layout, like this:
| | <- base
|-------------|
| ret0 | <- base + 8
|-------------|
. upd frame . <- base + sm_ret_off
|-------------|
| |
. vars .
. (live/dead) .
| | <- base + sm_sp - sm_args
|-------------|
| ret1 |
. ret vals . <- base + sm_sp (<--- Sp points here)
|-------------|
Why do we include the final return address (ret0) in our stack map? I
have absolutely no idea, but it seems to be done that way consistently
in the rest of the code generator, so I played along here. --SDM
Note that we will be constructing an info table for the continuation
(ret1), which needs to describe the stack down to, but not including,
the update frame (or ret0, if there is no update frame).
-}
data StackMap = StackMap
{ sm_sp :: StackLoc
-- ^ the offset of Sp relative to the base on entry
-- to this block.
, sm_args :: ByteOff
, sm_ret_off :: ByteOff
-- ^ the number of bytes of arguments in the area for this block
-- Defn: the offset of young(L) relative to the base is given by
-- (sm_sp - sm_args) of the StackMap for block L.
, sm_ret_off :: ByteOff
-- ^ Number of words of stack that we do not describe with an info
-- table, because it contains an update frame.
, sm_regs :: UniqFM (LocalReg,StackLoc)
-- ^ regs on the stack
}
......@@ -71,7 +94,8 @@ instance Outputable StackMap where
text "sm_regs = " <> ppr (eltsUFM sm_regs)
cmmLayoutStack :: ProcPointSet -> ByteOff -> CmmGraph -> FuelUniqSM CmmGraph
cmmLayoutStack :: ProcPointSet -> ByteOff -> CmmGraph
-> FuelUniqSM (CmmGraph, BlockEnv StackMap)
cmmLayoutStack procpoints entry_args
graph@(CmmGraph { g_entry = entry })
= do
......@@ -80,13 +104,13 @@ cmmLayoutStack procpoints entry_args
pprTrace "liveness" (ppr liveness) $ return ()
let blocks = postorderDfs graph
(_rec_stackmaps, rec_high_sp, new_blocks) <- liftUniq $
(final_stackmaps, final_high_sp, new_blocks) <- liftUniq $
mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) ->
layout procpoints liveness entry entry_args
rec_stackmaps rec_high_sp blocks
pprTrace ("Sp HWM") (ppr rec_high_sp) $
return (ofBlockList entry new_blocks)
pprTrace ("Sp HWM") (ppr final_high_sp) $
return (ofBlockList entry new_blocks, final_stackmaps)
......@@ -131,22 +155,27 @@ layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks
= do
let (entry0@(CmmEntry entry_lbl), middle0, last0) = blockSplit b0
pprTrace "layout" (ppr entry_lbl <+> ppr acc_stackmaps) $ return ()
let stack0@StackMap { sm_sp = sp0 }
= mapFindWithDefault
(pprPanic "no stack map for" (ppr entry_lbl))
entry_lbl acc_stackmaps
-- update the stack map to include the effects of assignments
pprTrace "layout" (ppr entry_lbl <+> ppr stack0) $ return ()
-- Update the stack map to include the effects of assignments
-- in this block
let stack1 = foldBlockNodesF (procMiddle acc_stackmaps) middle0 stack0
-- insert reloads if necessary
-- Insert assignments to reload all the live variables if this
-- is a proc point
let middle1 = if entry_lbl `setMember` procpoints
then foldr blockCons middle0 (insertReloads stack0)
else middle0
-- Look at the last node and if we are making a call or jumping to
-- a proc point, we must save the live variables, adjust Sp, and
-- construct the StackMaps for each of the successor blocks.
-- See handleLastNode for details.
(saves, out, sp_off, last1, fixup_blocks)
<- handleLastNode procpoints liveness cont_info
acc_stackmaps stack1 last0
......@@ -154,6 +183,7 @@ layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks
let hwm' = maximum (acc_hwm : map sm_sp (mapElems out))
middle2 = maybeAddSpAdj sp_off $ foldl blockSnoc middle1 saves
-- manifest Sp: turn all CmmStackSlots into actual loads
fiddle_middle = mapExpDeep (areaToSp sp0 sp_high final_stackmaps)
fiddle_last = mapExpDeep (areaToSp (sp0 - sp_off) sp_high
final_stackmaps)
......@@ -164,7 +194,7 @@ layout procpoints liveness entry entry_args final_stackmaps final_hwm blocks
fixup_blocks' = map (blockMapNodes3 (id, fiddle_middle, id))
fixup_blocks
pprTrace "layout2" (ppr out) $ return ()
pprTrace "layout(out)" (ppr out) $ return ()
go bs stackmaps' hwm' (newblock' : fixup_blocks' ++ acc_blocks)
......@@ -506,6 +536,35 @@ allocate ret_off live stackmap@StackMap{ sm_sp = sp0
, push_assigs ++ save_assigs )
-- -----------------------------------------------------------------------------
-- Update info tables to include stack liveness
setInfoTableStackMap :: BlockEnv StackMap -> CmmDecl -> CmmDecl
setInfoTableStackMap stackmaps
(CmmProc top_info@TopInfo{..} l g@CmmGraph{g_entry = eid})
= CmmProc top_info{ info_tbl = fix_info info_tbl } l g
where
fix_info info_tbl@CmmInfoTable{ cit_rep = StackRep _ } =
info_tbl { cit_rep = StackRep (get_liveness eid) }
fix_info other = other
get_liveness :: BlockId -> Liveness
get_liveness lbl
= case mapLookup lbl stackmaps of
Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl)
Just sm -> stackMapToLiveness sm
stackMapToLiveness :: StackMap -> Liveness
stackMapToLiveness StackMap{..} =
reverse $ Array.elems $
accumArray (\_ x -> x) True (toWords sm_ret_off + 1,
toWords (sm_sp - sm_args)) live_words
where
live_words = [ (toWords off, False)
| (r,off) <- eltsUFM sm_regs, isGcPtrType (localRegType r) ]
-- -----------------------------------------------------------------------------
plusW :: ByteOff -> WordOff -> ByteOff
......
......@@ -112,7 +112,8 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
let callPPs = {-# SCC "callProcPoints" #-} callProcPoints g
procPoints <- {-# SCC "minimalProcPointSet" #-} run $ minimalProcPointSet (targetPlatform dflags) callPPs g
g <- {-# SCC "layoutStack" #-} run $ cmmLayoutStack procPoints entry_off g
(g, stackmaps) <- {-# SCC "layoutStack" #-}
run $ cmmLayoutStack procPoints entry_off g
dump Opt_D_dump_cmmz_sp "Layout Stack" g
-- g <- {-# SCC "addProcPointProtocols" #-} run $ addProcPointProtocols callPPs procPoints g
......@@ -167,8 +168,9 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}})
-- dumps Opt_D_dump_cmmz_lower "Post lowerSafeForeignCalls" gs
-- NO MORE GRAPH TRANSFORMATION AFTER HERE -- JUST MAKING INFOTABLES
-- gs <- {-# SCC "setInfoTableStackMap" #-} return $ map (setInfoTableStackMap slotEnv areaMap) gs
-- dumps Opt_D_dump_cmmz_info "after setInfoTableStackMap" gs
gs <- {-# SCC "setInfoTableStackMap" #-}
return $ map (setInfoTableStackMap stackmaps) gs
dumps Opt_D_dump_cmmz_info "after setInfoTableStackMap" gs
----------- Control-flow optimisations ---------------
gs <- {-# SCC "cmmCfgOpts(2)" #-} return $ map cmmCfgOptsProc gs
......
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