trying again to get with-cont-mark to behave

This commit is contained in:
Danny Yoo 2012-02-15 14:42:19 -05:00
parent 67fef12672
commit 694785c555
2 changed files with 17 additions and 10 deletions

View File

@ -2013,23 +2013,30 @@
(: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence)) (: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence))
(define (in-other-context linkage) (define (in-other-context linkage)
(let ([body-next-linkage (cond [(NextLinkage? linkage) (let* ([on-return/multiple: (make-label 'procReturnMultiple)]
linkage] [on-return: (make-LinkedLabel (make-label 'procReturn) on-return/multiple:)]
[(LabelLinkage? linkage) [check-values-context-on-procedure-return
(make-NextLinkage (LabelLinkage-context linkage))])]) (emit-values-context-check-on-procedure-return (linkage-context linkage)
on-return/multiple: on-return:)]
[maybe-migrate-val-to-target
(cond
[(eq? target 'val)
empty-instruction-sequence]
[else
(make-AssignImmediateStatement target (make-Reg 'val))])])
(end-with-linkage (end-with-linkage
linkage cenv linkage cenv
(append-instruction-sequences (append-instruction-sequences
;; Making a continuation frame; isn't really used for anything (make-PushControlFrame/Call on-return:)
;; but recording the key/value data.
(make-PushControlFrame/Generic)
(compile (WithContMark-key exp) cenv 'val next-linkage/expects-single) (compile (WithContMark-key exp) cenv 'val next-linkage/expects-single)
(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingContinuationMarkKey) (make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingContinuationMarkKey)
(make-Reg 'val)) (make-Reg 'val))
(compile (WithContMark-value exp) cenv 'val next-linkage/expects-single) (compile (WithContMark-value exp) cenv 'val next-linkage/expects-single)
(make-PerformStatement (make-InstallContinuationMarkEntry!)) (make-PerformStatement (make-InstallContinuationMarkEntry!))
(compile (WithContMark-body exp) cenv target body-next-linkage) (compile (WithContMark-body exp) cenv 'val return-linkage/nontail)
(make-PopControlFrame))))) check-values-context-on-procedure-return
maybe-migrate-val-to-target
))))
(cond (cond
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)

View File

@ -7,4 +7,4 @@
(provide version) (provide version)
(: version String) (: version String)
(define version "1.121") (define version "1.124")