import CmmLint
import PprCmm
-import Dataflow (fixedpoint)
+import Dataflow
import CmmLive
import CmmBrokenBlock
import CmmProcPoint
+import CmmCallConv
import MachOp
import ForeignCall
-- Describes the layout of a stack frame for a continuation
data StackFormat
- = StackFormat
- (Maybe CLabel) -- The label occupying the top slot
- WordOff -- Total frame size in words
- [(CmmReg, WordOff)] -- local reg offsets from stack top
+ = StackFormat {
+ stack_label :: Maybe CLabel, -- The label occupying the top slot
+ stack_frame_size :: WordOff, -- Total frame size in words (not including arguments)
+ stack_live :: [(LocalReg, WordOff)] -- local reg offsets from stack top
+ -- TODO: see if the above can be LocalReg
+ }
-- A block can be a continuation of a call
-- A block can be a continuation of another block (w/ or w/o joins)
_ -> mkReturnPtLabel $ getUnique start
params = case start_block_entry of
FunctionEntry _ args -> args
- ContinuationEntry args -> args
+ ContinuationEntry args _ -> args
ControlEntry -> [] -- TODO: it's a proc-point, we could pass lives in parameter registers
--------------------------------------------------------------------------------
map (\c -> (continuationLabel c, selectStackFormat' c)) continuations
where
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
- --in
StackFormat (Just label) 0 []
selectStackFormat' (Continuation False info_table label formals blocks) =
-- TODO: assumes the first block is the entry block
live_to_format label formals live =
foldl extend_format
(StackFormat (Just label) retAddrSizeW [])
- (uniqSetToList (live `minusUniqSet` mkUniqSet (cmmFormalsToLiveLocals formals)))
+ (uniqSetToList (live `minusUniqSet` mkUniqSet formals))
extend_format :: StackFormat -> LocalReg -> StackFormat
extend_format (StackFormat label size offsets) reg =
- StackFormat label (slot_size reg + size) ((CmmLocal reg, size) : offsets)
+ StackFormat label (slot_size reg + size) ((reg, size) : offsets)
slot_size :: LocalReg -> Int
slot_size reg = ((machRepByteWidth (localRegRep reg) - 1) `div` wORD_SIZE) + 1
unknown_block = panic "unknown BlockId in continuationToProc"
prefix = case entry of
ControlEntry -> []
- FunctionEntry _ _ -> []
- ContinuationEntry formals ->
- unpack_continuation curr_format
+ FunctionEntry _ formals -> -- TODO: gc_stack_check
+ function_entry formals curr_format
+ ContinuationEntry formals _ ->
+ function_entry formals curr_format
postfix = case exit of
FinalBranch next -> [CmmBranch next]
FinalSwitch expr targets -> [CmmSwitch expr targets]
FinalReturn arguments ->
- exit_function curr_format
+ tail_call (stack_frame_size curr_format)
(CmmLoad (CmmReg spReg) wordRep)
arguments
FinalJump target arguments ->
- exit_function curr_format target arguments
- -- TODO: do something about global saves
+ tail_call (stack_frame_size curr_format) target arguments
FinalCall next (CmmForeignCall target CmmCallConv)
- results arguments saves ->
+ results arguments ->
pack_continuation curr_format cont_format ++
- [CmmJump target arguments]
+ tail_call (stack_frame_size curr_format - stack_frame_size cont_format)
+ target arguments
where
cont_format = maybe unknown_block id $
lookup (mkReturnPtLabel $ getUnique next) formats
- FinalCall next _ results arguments saves -> panic "unimplemented CmmCall"
+ FinalCall next _ results arguments -> panic "unimplemented CmmCall"
--------------------------------------------------------------------------------
-- Functions that generate CmmStmt sequences
-- for packing/unpacking continuations
-- and entering/exiting functions
-exit_function :: StackFormat -> CmmExpr -> CmmActuals -> [CmmStmt]
-exit_function (StackFormat curr_id curr_frame_size curr_offsets) target arguments
- = adjust_spReg ++ jump where
+tail_call :: WordOff -> CmmExpr -> CmmActuals -> [CmmStmt]
+tail_call spRel target arguments
+ = store_arguments ++ adjust_spReg ++ jump where
+ store_arguments =
+ [stack_put spRel expr offset
+ | ((expr, _), StackParam offset) <- argument_formats] ++
+ [global_put expr global
+ | ((expr, _), RegisterParam global) <- argument_formats]
adjust_spReg =
- if curr_frame_size == 0
+ if spRel == 0
then []
- else [CmmAssign spReg
- (CmmRegOff spReg (curr_frame_size*wORD_SIZE))]
+ else [CmmAssign spReg (CmmRegOff spReg (spRel*wORD_SIZE))]
jump = [CmmJump target arguments]
-enter_function :: WordOff -> [CmmStmt]
-enter_function max_frame_size
+ argument_formats = assignArguments (cmmExprRep . fst) arguments
+
+gc_stack_check :: WordOff -> [CmmStmt]
+gc_stack_check max_frame_size
= check_stack_limit where
check_stack_limit = [
CmmCondBranch
(CmmMachOp (MO_U_Lt $ cmmRegRep spReg)
[CmmRegOff spReg max_frame_size, CmmReg spLimReg])
gc_block]
- gc_block = undefined -- TODO: get stack and heap checks to go to same
+ gc_block = panic "gc_check not implemented" -- TODO: get stack and heap checks to go to same
-- TODO: fix branches to proc point (we have to insert a new block to marshel the continuation)
pack_continuation :: StackFormat -> StackFormat -> [CmmStmt]
-pack_continuation (StackFormat curr_id curr_frame_size curr_offsets)
+pack_continuation (StackFormat curr_id curr_frame_size _)
(StackFormat cont_id cont_frame_size cont_offsets)
- = save_live_values ++ set_stack_header ++ adjust_spReg where
- -- TODO: only save variables when actually needed
- save_live_values =
- [CmmStore
- (CmmRegOff
- spReg (wORD_SIZE*(curr_frame_size - cont_frame_size + offset)))
- (CmmReg reg)
+ = store_live_values ++ set_stack_header where
+ -- TODO: only save variables when actually needed (may be handled by latter pass)
+ store_live_values =
+ [stack_put spRel (CmmReg (CmmLocal reg)) offset
| (reg, offset) <- cont_offsets]
- needs_header =
- case (curr_id, cont_id) of
- (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 =
- if curr_frame_size == cont_frame_size
+ if not needs_header
then []
- else [CmmAssign spReg (CmmRegOff spReg ((curr_frame_size - cont_frame_size)*wORD_SIZE))]
+ else [stack_put spRel continuation_function 0]
+
+ spRel = curr_frame_size - cont_frame_size
+ continuation_function = CmmLit $ CmmLabel $ fromJust cont_id
+ needs_header =
+ case (curr_id, cont_id) of
+ (Just x, Just y) -> x /= y
+ _ -> isJust cont_id
-- Lazy adjustment of stack headers assumes all blocks
-- that could branch to eachother (i.e. control blocks)
-- have the same stack format (this causes a problem
-- only for proc-point).
-unpack_continuation :: StackFormat -> [CmmStmt]
-unpack_continuation (StackFormat curr_id curr_frame_size curr_offsets)
- = load_live_values where
- -- TODO: only save variables when actually needed
+function_entry :: CmmFormals -> StackFormat -> [CmmStmt]
+function_entry formals (StackFormat _ _ curr_offsets)
+ = load_live_values ++ load_args where
+ -- TODO: only save variables when actually needed (may be handled by latter pass)
load_live_values =
- [CmmAssign
- reg
- (CmmLoad (CmmRegOff spReg (wORD_SIZE*offset)) (cmmRegRep reg))
+ [stack_get 0 reg offset
| (reg, offset) <- curr_offsets]
+ load_args =
+ [stack_get 0 reg offset
+ | (reg, StackParam offset) <- argument_formats] ++
+ [global_get reg global
+ | (reg, RegisterParam global) <- argument_formats]
+
+ argument_formats = assignArguments (localRegRep) formals
+
+-----------------------------------------------------------------------------
+-- Section: Stack and argument register puts and gets
+-----------------------------------------------------------------------------
+-- TODO: document
+
+-- |Construct a 'CmmStmt' that will save a value on the stack
+stack_put :: WordOff -- ^ Offset from the real 'Sp' that 'offset'
+ -- is relative to (added to offset)
+ -> CmmExpr -- ^ What to store onto the stack
+ -> WordOff -- ^ Where on the stack to store it
+ -- (positive <=> higher addresses)
+ -> CmmStmt
+stack_put spRel expr offset =
+ CmmStore (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) expr
+
+--------------------------------
+-- |Construct a
+stack_get :: WordOff
+ -> LocalReg
+ -> WordOff
+ -> CmmStmt
+stack_get spRel reg offset =
+ CmmAssign (CmmLocal reg) (CmmLoad (CmmRegOff spReg (wORD_SIZE*(spRel + offset))) (localRegRep reg))
+global_put :: CmmExpr -> GlobalReg -> CmmStmt
+global_put expr global = CmmAssign (CmmGlobal global) expr
+global_get :: LocalReg -> GlobalReg -> CmmStmt
+global_get reg global = CmmAssign (CmmLocal reg) (CmmReg (CmmGlobal global))