---------------------------------------------------------------------------------
--- 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
- adjust_spReg =
- if curr_frame_size == 0
- then []
- else [CmmAssign spReg
- (CmmRegOff spReg (curr_frame_size*wORD_SIZE))]
- jump = [CmmJump target arguments]
-
-enter_function :: WordOff -> [CmmStmt]
-enter_function 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
-
--- 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)
- (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)
- | (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
- then []
- else [CmmAssign spReg (CmmRegOff spReg ((curr_frame_size - cont_frame_size)*wORD_SIZE))]
-
--- 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
- load_live_values =
- [CmmAssign
- reg
- (CmmLoad (CmmRegOff spReg (wORD_SIZE*offset)) (cmmRegRep reg))
- | (reg, offset) <- curr_offsets]
+-----------------------------------------------------------------------------
+applyContinuationFormat :: [(CLabel, ContinuationFormat)]
+ -> Continuation (Either C_SRT CmmInfo)
+ -> Continuation CmmInfo
+
+-- User written continuations
+applyContinuationFormat formats (Continuation
+ (Right (CmmInfo gc update_frame (CmmInfoTable prof tag (ContInfo _ srt))))
+ label formals is_gc blocks) =
+ Continuation (CmmInfo gc update_frame (CmmInfoTable prof tag (ContInfo format srt)))
+ label formals is_gc blocks
+ where
+ format = continuation_stack $ maybe unknown_block id $ lookup label formats
+ unknown_block = panic "unknown BlockId in applyContinuationFormat"
+
+-- Either user written non-continuation code or CPS generated proc-point
+applyContinuationFormat formats (Continuation
+ (Right info) label formals is_gc blocks) =
+ Continuation info label formals is_gc blocks
+
+-- CPS generated continuations
+applyContinuationFormat formats (Continuation
+ (Left srt) label formals is_gc blocks) =
+ Continuation (CmmInfo gc Nothing (CmmInfoTable prof tag (ContInfo (continuation_stack $ format) srt)))
+ label formals is_gc blocks
+ where
+ gc = Nothing -- Generated continuations never need a stack check
+ -- TODO prof: this is the same as the current implementation
+ -- but I think it could be improved
+ prof = ProfilingInfo zeroCLit zeroCLit
+ tag = rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
+ format = maybe unknown_block id $ lookup label formats
+ unknown_block = panic "unknown BlockId in applyContinuationFormat"