Commit 53a82428 authored by Michael D. Adams's avatar Michael D. Adams

Refined the handling of stack frame headers

parent 46b28f7b
...@@ -118,11 +118,12 @@ data FinalStmt ...@@ -118,11 +118,12 @@ data FinalStmt
-- TODO: | ProcPointExit (needed?) -- TODO: | ProcPointExit (needed?)
-- Describes the layout of a stack frame for a continuation
data StackFormat data StackFormat
= StackFormat = StackFormat
BlockId {- block that is the start of the continuation. may or may not be the current block -} (Maybe CLabel) -- The label occupying the top slot
WordOff {- total frame size -} WordOff -- Total frame size in words
[(CmmReg, WordOff)] {- local reg offsets from stack top -} [(CmmReg, WordOff)] -- local reg offsets from stack top
-- A block can be a continuation of a call -- A block can be a continuation of a call
-- A block can be a continuation of another block (w/ or w/o joins) -- A block can be a continuation of another block (w/ or w/o joins)
...@@ -298,21 +299,23 @@ selectStackFormat2 live continuations = ...@@ -298,21 +299,23 @@ selectStackFormat2 live continuations =
map (\c -> (continuationLabel c, selectStackFormat' c)) continuations map (\c -> (continuationLabel c, selectStackFormat' c)) continuations
where where
selectStackFormat' (Continuation True info_table label formals blocks) = selectStackFormat' (Continuation True info_table label formals blocks) =
let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this --let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this
in StackFormat ident 0 [] --in
StackFormat (Just label) 0 []
selectStackFormat' (Continuation False info_table label formals blocks) = selectStackFormat' (Continuation False info_table label formals blocks) =
-- TODO: assumes the first block is the entry block
let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this let ident = brokenBlockId $ head blocks -- TODO: CLabel isn't a uniquable, but we need a better way than this
in live_to_format ident $ lookupWithDefaultUFM live unknown_block ident in live_to_format label formals $ lookupWithDefaultUFM live unknown_block ident
live_to_format :: BlockId -> CmmLive -> StackFormat live_to_format :: CLabel -> CmmFormals -> CmmLive -> StackFormat
live_to_format label live = live_to_format label formals live =
foldl extend_format foldl extend_format
(StackFormat label retAddrSizeW []) (StackFormat (Just label) retAddrSizeW [])
(uniqSetToList live) (uniqSetToList (live `minusUniqSet` mkUniqSet (cmmFormalsToLiveLocals formals)))
extend_format :: StackFormat -> LocalReg -> StackFormat extend_format :: StackFormat -> LocalReg -> StackFormat
extend_format (StackFormat block size offsets) reg = extend_format (StackFormat label size offsets) reg =
StackFormat block (slot_size reg + size) ((CmmLocal reg, size) : offsets) StackFormat label (slot_size reg + size) ((CmmLocal reg, size) : offsets)
unknown_block = panic "unknown BlockId in selectStackFormat" unknown_block = panic "unknown BlockId in selectStackFormat"
...@@ -361,9 +364,11 @@ constructContinuation2' curr_ident formats (BrokenBlock ident entry stmts _ exit ...@@ -361,9 +364,11 @@ constructContinuation2' curr_ident formats (BrokenBlock ident entry stmts _ exit
exit_function :: StackFormat -> CmmExpr -> CmmActuals -> [CmmStmt] exit_function :: StackFormat -> CmmExpr -> CmmActuals -> [CmmStmt]
exit_function (StackFormat curr_id curr_frame_size curr_offsets) target arguments exit_function (StackFormat curr_id curr_frame_size curr_offsets) target arguments
= adjust_spReg ++ jump where = adjust_spReg ++ jump where
adjust_spReg = [ adjust_spReg =
CmmAssign spReg if curr_frame_size == 0
(CmmRegOff spReg (curr_frame_size*wORD_SIZE))] then []
else [CmmAssign spReg
(CmmRegOff spReg (curr_frame_size*wORD_SIZE))]
jump = [CmmJump target arguments] jump = [CmmJump target arguments]
enter_function :: WordOff -> [CmmStmt] enter_function :: WordOff -> [CmmStmt]
...@@ -388,9 +393,15 @@ pack_continuation (StackFormat curr_id curr_frame_size curr_offsets) ...@@ -388,9 +393,15 @@ pack_continuation (StackFormat curr_id curr_frame_size curr_offsets)
spReg (wORD_SIZE*(curr_frame_size - cont_frame_size + offset))) spReg (wORD_SIZE*(curr_frame_size - cont_frame_size + offset)))
(CmmReg reg) (CmmReg reg)
| (reg, offset) <- cont_offsets] | (reg, offset) <- cont_offsets]
set_stack_header = -- TODO: only set when needed needs_header =
[CmmStore (CmmRegOff spReg (wORD_SIZE*(curr_frame_size - cont_frame_size))) continuation_function] case (curr_id, cont_id) of
continuation_function = CmmLit $ CmmLabel $ mkReturnPtLabel {-TODO: use the correct function -} $ getUnique cont_id (Just x, Just y) -> x /= y
_ -> isJust cont_id
set_stack_header =
if not needs_header
then []
else [CmmStore (CmmRegOff spReg (wORD_SIZE*(curr_frame_size - cont_frame_size))) continuation_function]
continuation_function = CmmLit $ CmmLabel $ fromJust cont_id
adjust_spReg = adjust_spReg =
if curr_frame_size == cont_frame_size if curr_frame_size == cont_frame_size
then [] then []
......
module CmmLive ( module CmmLive (
CmmLive, BlockEntryLiveness, CmmLive, BlockEntryLiveness,
cmmLiveness cmmLiveness,
cmmFormalsToLiveLocals
) where ) where
import Cmm import Cmm
...@@ -156,6 +157,11 @@ addKilled new_killed live = live `minusUniqSet` new_killed ...@@ -156,6 +157,11 @@ addKilled new_killed live = live `minusUniqSet` new_killed
-------------------------------- --------------------------------
-- Liveness of a CmmStmt -- Liveness of a CmmStmt
-------------------------------- --------------------------------
cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
cmmFormalsToLiveLocals [] = []
cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id cmmStmtLive _ (CmmNop) = id
cmmStmtLive _ (CmmComment _) = id cmmStmtLive _ (CmmComment _) = id
...@@ -170,10 +176,7 @@ cmmStmtLive _ (CmmStore expr1 expr2) = ...@@ -170,10 +176,7 @@ cmmStmtLive _ (CmmStore expr1 expr2) =
cmmStmtLive _ (CmmCall target results arguments _) = cmmStmtLive _ (CmmCall target results arguments _) =
target_liveness . target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) . foldr ((.) . cmmExprLive) id (map fst arguments) .
addKilled (mkUniqSet $ only_local_regs results) where addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
only_local_regs [] = []
only_local_regs ((CmmGlobal _,_):args) = only_local_regs args
only_local_regs ((CmmLocal r,_):args) = r:only_local_regs args
target_liveness = target_liveness =
case target of case target of
(CmmForeignCall target _) -> cmmExprLive target (CmmForeignCall target _) -> cmmExprLive target
......
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