suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

removing separate returnlinkage-notail structure

Browse Source
This commit is contained in:
Danny Yoo 2011-04-24 18:23:51 -04:00
parent 1ad7796fdd
commit d805bca845
3 changed files with 344 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
NOTES
View File

@ -359,4 +359,62 @@ Both of these should be under some dynamic controller. We want to
optimize the efficiency of the runtime. I don't know what the optimize the efficiency of the runtime. I don't know what the
function is, but we want to optimize the parameters FN and TI such function is, but we want to optimize the parameters FN and TI such
that it maximizes FN and minimizes TI, and yet gives us the browser that it maximizes FN and minimizes TI, and yet gives us the browser
reactivity we want. reactivity we want.
April 24, 2011
The variables for linkage and target are doing double duty, which is
showing up in the defintion for compilation, since there are cases
that shouldn't exist in there.
They really should be part of the same datatype which describes,
essentially, what the code's continuation should be doing next.
Target's describing where the value needs to be installed at the end
of this, and linkage describes how to jump into the continuation.
Return --- write value to val, pop off and jump according to
dynamic value on control context. Return context may be in tail
position or not.
Next --- write value to a particular target and continue on.
Label --- write value to a particular target and jump
unconditionally to labeled location.
The continuation may or may not be expecting multiple values.
Ignore: doesn't care how many values come back. Throw away values
if multiple values are passed in.
Any: receives multiple values, and ensures those values are on the
stack. If a single value is received, pushes it on the stack and
sets up argcount to 1.
N: must receive exactly N values. If there's a mismatch, raises a
runtime error.
Return will allow Any number of values to come back. It doesn't need
a separate multiple-value context.
Next expects either exactly 1 value to come back, or ignores. So it
needs an multiple-value context.
Label, too, expects exactly 1 value to come back, or ignores. So it
needs a mulitple-value context.
When we use apply-values, it'll compile the producer expression in an
Any context.
I'm going to simplify values a bit.

553
compiler.rkt
View File

@ -205,23 +205,29 @@
(define (compile-linkage cenv linkage) (define (compile-linkage cenv linkage)
(cond (cond
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
(make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel)) (cond
,(make-PopEnvironment (make-Const (length cenv)) [(ReturnLinkage-tail? linkage)
(make-Const 0)) (make-instruction-sequence
,(make-PopControlFrame) `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
,(make-GotoStatement (make-Reg 'proc))))] ,(make-PopEnvironment (make-Const (length cenv))
[(ReturnLinkage/NonTail? linkage) (make-Const 0))
(make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel)) ,(make-PopControlFrame)
,(make-PopControlFrame) ,(make-GotoStatement (make-Reg 'proc))))]
,(make-GotoStatement (make-Reg 'proc))))] [else
(make-instruction-sequence
`(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))])]
[(NextLinkage? linkage) [(NextLinkage? linkage)
empty-instruction-sequence] empty-instruction-sequence]
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
empty-instruction-sequence] empty-instruction-sequence]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(make-instruction-sequence `(,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))] (make-instruction-sequence
`(,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))]
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
(make-instruction-sequence `(,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage)))))])) (make-instruction-sequence
`(,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage)))))]))
(: compile-singular-context-check (Linkage -> InstructionSequence)) (: compile-singular-context-check (Linkage -> InstructionSequence))
@ -234,8 +240,6 @@
empty-instruction-sequence] empty-instruction-sequence]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
empty-instruction-sequence] empty-instruction-sequence]
[(ReturnLinkage/NonTail? linkage)
empty-instruction-sequence]
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
(let ([n (NextLinkage/Expects-expects linkage)]) (let ([n (NextLinkage/Expects-expects linkage)])
(cond (cond
@ -339,8 +343,6 @@
(make-LabelLinkage/Expects after-if (NextLinkage/Expects-expects linkage))] (make-LabelLinkage/Expects after-if (NextLinkage/Expects-expects linkage))]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
linkage] linkage]
[(ReturnLinkage/NonTail? linkage)
linkage]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
linkage] linkage]
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
@ -930,7 +932,8 @@
(let: ([primitive-branch : LabelLinkage (make-LabelLinkage (make-label 'primitiveBranch))] (let: ([primitive-branch : LabelLinkage (make-LabelLinkage (make-label 'primitiveBranch))]
[compiled-branch : LabelLinkage (make-LabelLinkage (make-label 'compiledBranch))] [compiled-branch : LabelLinkage (make-LabelLinkage (make-label 'compiledBranch))]
[after-call : LabelLinkage (make-LabelLinkage (make-label 'afterCall))]) [after-call : LabelLinkage (make-LabelLinkage (make-label 'afterCall))])
(let: ([compiled-linkage : Linkage (if (ReturnLinkage? linkage) (let: ([compiled-linkage : Linkage (if (and (ReturnLinkage? linkage)
(ReturnLinkage-tail? linkage))
linkage linkage
after-call)]) after-call)])
(append-instruction-sequences (append-instruction-sequences
@ -970,7 +973,8 @@
(StaticallyKnownLam CompileTimeEnvironment CompileTimeEnvironment Natural Target Linkage -> InstructionSequence)) (StaticallyKnownLam CompileTimeEnvironment CompileTimeEnvironment Natural Target Linkage -> InstructionSequence))
(define (compile-procedure-call/statically-known-lam static-knowledge cenv extended-cenv n target linkage) (define (compile-procedure-call/statically-known-lam static-knowledge cenv extended-cenv n target linkage)
(let*: ([after-call : LabelLinkage (make-LabelLinkage (make-label 'afterCall))] (let*: ([after-call : LabelLinkage (make-LabelLinkage (make-label 'afterCall))]
[compiled-linkage : Linkage (if (ReturnLinkage? linkage) [compiled-linkage : Linkage (if (and (ReturnLinkage? linkage)
(ReturnLinkage-tail? linkage))
linkage linkage
after-call)]) after-call)])
(append-instruction-sequences (append-instruction-sequences
@ -1009,263 +1013,265 @@
;; 2. Non-tail calls (next/label linkage) that write to val ;; 2. Non-tail calls (next/label linkage) that write to val
;; 3. Calls in argument position (next/label linkage) that write to the stack. ;; 3. Calls in argument position (next/label linkage) that write to the stack.
(define (compile-compiled-procedure-application cenv-length-with-args entry-point target linkage) (define (compile-compiled-procedure-application cenv-length-with-args entry-point target linkage)
(let*-values ([(maybe-install-jump-address entry-point-target) (let*-values
;; Optimization: if the entry-point is supposed to be val, then it needs to hold ([(maybe-install-jump-address entry-point-target)
;; the procedure entry here. Otherwise, it doesn't. ;; Optimization: if the entry-point is supposed to be val, then it needs to hold
(cond [(Label? entry-point) ;; the procedure entry here. Otherwise, it doesn't.
(values empty-instruction-sequence (cond [(Label? entry-point)
entry-point)] (values empty-instruction-sequence
[(eq? entry-point 'val) entry-point)]
(values (make-instruction-sequence [(eq? entry-point 'val)
`(,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)))) (values (make-instruction-sequence
(make-Reg 'val))])] `(,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))))
(make-Reg 'val))])]
[(proc-return-multiple) (make-label 'procReturnMultiple)] [(proc-return-multiple) (make-label 'procReturnMultiple)]
[(proc-return) (make-LinkedLabel (make-label 'procReturn) [(proc-return) (make-LinkedLabel (make-label 'procReturn)
proc-return-multiple)]) proc-return-multiple)])
(cond [(ReturnLinkage? linkage) (cond [(ReturnLinkage? linkage)
(cond (cond
[(eq? target 'val) [(ReturnLinkage-tail? linkage)
;; This case happens when we're in tail position. (cond
;; We clean up the stack right before the jump, and do not add [(eq? target 'val)
;; to the control stack. ;; This case happens when we're in tail position.
(append-instruction-sequences ;; We clean up the stack right before the jump, and do not add
maybe-install-jump-address ;; to the control stack.
(cond [(equal? cenv-length-with-args (make-Reg 'argcount)) (append-instruction-sequences
empty-instruction-sequence] maybe-install-jump-address
[else (cond [(equal? cenv-length-with-args (make-Reg 'argcount))
(make-instruction-sequence empty-instruction-sequence]
[else
(make-instruction-sequence
`(,(make-PopEnvironment `(,(make-PopEnvironment
(make-SubtractArg cenv-length-with-args (make-SubtractArg cenv-length-with-args
(make-Reg 'argcount)) (make-Reg 'argcount))
(make-Reg 'argcount))))]) (make-Reg 'argcount))))])
(make-instruction-sequence (make-instruction-sequence
`(;; Assign the proc value of the existing call frame `(;; Assign the proc value of the existing call frame
,(make-PerformStatement ,(make-PerformStatement
(make-SetFrameCallee! (make-Reg 'proc))) (make-SetFrameCallee! (make-Reg 'proc)))
,(make-GotoStatement entry-point-target))))] ,(make-GotoStatement entry-point-target))))]
[else [else
;; This case should be impossible: return linkage should only ;; This case should be impossible: return linkage should only
;; occur when we're in tail position, and we should be in tail position ;; occur when we're in tail position, and we should be in tail position
;; only when the target is the val register. ;; only when the target is the val register.
(error 'compile "return linkage, target not val: ~s" target)])] (error 'compile "return linkage, target not val: ~s" target)])]
[else
[(ReturnLinkage/NonTail? linkage) (cond [(eq? target 'val)
(cond [(eq? target 'val) ;; This case happens for a function call that isn't in
;; This case happens for a function call that isn't in ;; tail position.
;; tail position. (append-instruction-sequences
(append-instruction-sequences (make-instruction-sequence
(make-instruction-sequence `(,(make-PushControlFrame/Call proc-return)))
`(,(make-PushControlFrame/Call proc-return))) maybe-install-jump-address
maybe-install-jump-address (make-instruction-sequence
(make-instruction-sequence `(,(make-GotoStatement entry-point-target)))
`(,(make-GotoStatement entry-point-target))) proc-return-multiple
proc-return-multiple (make-instruction-sequence
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
`(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
(make-Const 0)))) proc-return)]
proc-return)]
[else
[else ;; This case happens for evaluating arguments, since the
;; This case happens for evaluating arguments, since the ;; arguments are being installed into the scratch space.
;; arguments are being installed into the scratch space. (append-instruction-sequences
(append-instruction-sequences (make-instruction-sequence
(make-instruction-sequence `(,(make-PushControlFrame/Call proc-return)))
`(,(make-PushControlFrame/Call proc-return))) maybe-install-jump-address
maybe-install-jump-address (make-instruction-sequence
(make-instruction-sequence `(,(make-GotoStatement entry-point-target)))
`(,(make-GotoStatement entry-point-target))) proc-return-multiple
proc-return-multiple (make-instruction-sequence
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
`(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
(make-Const 0)))) proc-return
proc-return (make-instruction-sequence
(make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Reg 'val)))))])])]
`(,(make-AssignImmediateStatement target (make-Reg 'val)))))])]
[(NextLinkage? linkage)
[(NextLinkage? linkage) (cond [(eq? target 'val)
(cond [(eq? target 'val) ;; This case happens for a function call that isn't in
;; This case happens for a function call that isn't in ;; tail position.
;; tail position. (append-instruction-sequences
(append-instruction-sequences (make-instruction-sequence
(make-instruction-sequence `(,(make-PushControlFrame/Call proc-return)))
`(,(make-PushControlFrame/Call proc-return))) maybe-install-jump-address
maybe-install-jump-address (make-instruction-sequence
(make-instruction-sequence `(,(make-GotoStatement entry-point-target)))
`(,(make-GotoStatement entry-point-target))) proc-return-multiple
proc-return-multiple (make-instruction-sequence
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
`(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
(make-Const 0)))) proc-return)]
proc-return)]
[else
[else ;; This case happens for evaluating arguments, since the
;; This case happens for evaluating arguments, since the ;; arguments are being installed into the scratch space.
;; arguments are being installed into the scratch space. (append-instruction-sequences
(append-instruction-sequences (make-instruction-sequence
(make-instruction-sequence `(,(make-PushControlFrame/Call proc-return)))
`(,(make-PushControlFrame/Call proc-return))) maybe-install-jump-address
maybe-install-jump-address (make-instruction-sequence
(make-instruction-sequence `(,(make-GotoStatement entry-point-target)))
`(,(make-GotoStatement entry-point-target))) proc-return-multiple
proc-return-multiple (make-instruction-sequence
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
`(,(make-PopEnvironment (make-Reg 'argcount) (make-Const 0))))
(make-Const 0)))) proc-return
proc-return (make-instruction-sequence
(make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Reg 'val)))))])]
`(,(make-AssignImmediateStatement target (make-Reg 'val)))))])]
;; FIXME: this isn't doing the proper checks!!! ;; FIXME: this isn't doing the proper checks!!!
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(let* ([n (NextLinkage/Expects-expects linkage)] (let* ([n (NextLinkage/Expects-expects linkage)]
[after-value-check (make-label 'afterValueCheck)] [after-value-check (make-label 'afterValueCheck)]
[return-point-code [return-point-code
(cond (cond
[(eq? n '*) [(eq? n '*)
(let ([after-return (make-label 'afterReturn)]) (let ([after-return (make-label 'afterReturn)])
(append-instruction-sequences (append-instruction-sequences
proc-return-multiple proc-return-multiple
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement (make-Label after-return)))) `(,(make-GotoStatement (make-Label after-return))))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement 'argcount (make-Const 1)) `(,(make-AssignImmediateStatement 'argcount (make-Const 1))
,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f))) ,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)))
after-return))] after-return))]
[(natural? n) [(natural? n)
(cond (cond
[(= n 1) [(= n 1)
(append-instruction-sequences (append-instruction-sequences
proc-return-multiple proc-return-multiple
(make-instruction-sequence (make-instruction-sequence
`(,(make-PerformStatement `(,(make-PerformStatement
(make-RaiseContextExpectedValuesError! 1)))) (make-RaiseContextExpectedValuesError! 1))))
proc-return)] proc-return)]
[else [else
(append-instruction-sequences (append-instruction-sequences
proc-return-multiple proc-return-multiple
(make-instruction-sequence (make-instruction-sequence
`( `(
;; if the wrong number of arguments come in, die ;; if the wrong number of arguments come in, die
,(make-TestAndBranchStatement ,(make-TestAndBranchStatement
'zero? 'zero?
(make-SubtractArg (make-Reg 'argcount) (make-SubtractArg (make-Reg 'argcount)
(make-Const n)) (make-Const n))
after-value-check))) after-value-check)))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-PerformStatement `(,(make-PerformStatement
(make-RaiseContextExpectedValuesError! n)))) (make-RaiseContextExpectedValuesError! n))))
after-value-check)])])]) after-value-check)])])])
(cond [(eq? target 'val) (cond [(eq? target 'val)
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
return-point-code)] return-point-code)]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
return-point-code return-point-code
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val)))))]))] `(,(make-AssignImmediateStatement target (make-Reg 'val)))))]))]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(cond [(eq? target 'val) (cond [(eq? target 'val)
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
proc-return-multiple proc-return-multiple
(make-instruction-sequence (make-instruction-sequence
`(,(make-PopEnvironment (make-Reg 'argcount) `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0)))) (make-Const 0))))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))] `(,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
proc-return-multiple proc-return-multiple
(make-instruction-sequence (make-instruction-sequence
`(,(make-PopEnvironment (make-Reg 'argcount) `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0)))) (make-Const 0))))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val)) `(,(make-AssignImmediateStatement target (make-Reg 'val))
,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))])] ,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))])]
;; FIXME!!! this isn't doing the correct checks! ;; FIXME!!! this isn't doing the correct checks!
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
(cond [(eq? target 'val) (cond [(eq? target 'val)
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
proc-return-multiple proc-return-multiple
;; FIXME: this may need to raise a runtime error here! ;; FIXME: this may need to raise a runtime error here!
(make-instruction-sequence (make-instruction-sequence
`(,(make-PopEnvironment (make-Reg 'argcount) `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0)))) (make-Const 0))))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage))))))] `(,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage))))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
proc-return-multiple proc-return-multiple
;; FIXME: this may need to raise a runtime error here! ;; FIXME: this may need to raise a runtime error here!
(make-instruction-sequence (make-instruction-sequence
`(,(make-PopEnvironment (make-Reg 'argcount) `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0)))) (make-Const 0))))
proc-return proc-return
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val)) `(,(make-AssignImmediateStatement target (make-Reg 'val))
,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage))))))])]))) ,(make-GotoStatement (make-Label (LabelLinkage/Expects-label linkage))))))])])))
@ -1321,9 +1327,10 @@
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
linkage] linkage]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
linkage] (cond [(ReturnLinkage-tail? linkage)
[(ReturnLinkage/NonTail? linkage) linkage]
(make-LabelLinkage after-body-code)] [else
(make-LabelLinkage after-body-code)])]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(make-LabelLinkage after-body-code)] (make-LabelLinkage after-body-code)]
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
@ -1360,9 +1367,11 @@
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
linkage] linkage]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
linkage] (cond
[(ReturnLinkage/NonTail? linkage) [(ReturnLinkage-tail? linkage)
(make-LabelLinkage after-body-code)] linkage]
[else
(make-LabelLinkage after-body-code)])]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(make-LabelLinkage after-body-code)] (make-LabelLinkage after-body-code)]
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
@ -1407,9 +1416,11 @@
[(NextLinkage/Expects? linkage) [(NextLinkage/Expects? linkage)
linkage] linkage]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
linkage] (cond
[(ReturnLinkage/NonTail? linkage) [(ReturnLinkage-tail? linkage)
(make-LabelLinkage after-body-code)] linkage]
[else
(make-LabelLinkage after-body-code)])]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(make-LabelLinkage after-body-code)] (make-LabelLinkage after-body-code)]
[(LabelLinkage/Expects? linkage) [(LabelLinkage/Expects? linkage)
@ -1522,8 +1533,6 @@
`(,(make-PopControlFrame))))))) `(,(make-PopControlFrame)))))))
(cond (cond
[(ReturnLinkage/NonTail? linkage)
(in-return-context)]
[(ReturnLinkage? linkage) [(ReturnLinkage? linkage)
(in-return-context)] (in-return-context)]
[(NextLinkage? linkage) [(NextLinkage? linkage)

12
il-structs.rkt
View File

@ -425,12 +425,9 @@
;; Both ReturnLinkage and ReturnLinkage/NonTail deal with multiple ;; Both ReturnLinkage and ReturnLinkage/NonTail deal with multiple
;; values indirectly, through the alternative multiple-value-return ;; values indirectly, through the alternative multiple-value-return
;; address in the LinkedLabel of their call frame. ;; address in the LinkedLabel of their call frame.
(define-struct: ReturnLinkage ()) (define-struct: ReturnLinkage ([tail? : Boolean]))
(define return-linkage (make-ReturnLinkage)) (define return-linkage (make-ReturnLinkage #t))
(define return-linkage/nontail (make-ReturnLinkage #f))
(define-struct: ReturnLinkage/NonTail ())
(define return-linkage/nontail (make-ReturnLinkage/NonTail))
(define-type Linkage (U NextLinkage (define-type Linkage (U NextLinkage
NextLinkage/Expects NextLinkage/Expects
@ -438,8 +435,7 @@
LabelLinkage LabelLinkage
LabelLinkage/Expects LabelLinkage/Expects
ReturnLinkage ReturnLinkage))
ReturnLinkage/NonTail))