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

in the middle of supporting the multiple value return with labels

Browse Source
This commit is contained in:
Danny Yoo 2011-04-12 15:16:53 -04:00
parent 18b3a474ef
commit 0d441be1cf
7 changed files with 94 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
NOTES
View File

@ -17,6 +17,9 @@ Some possible optimizations with application:
----------------------------------------------------------------------
Multiple values
There's interplay between compile-proc-appl and the linkage compiling
@ -28,6 +31,36 @@ in Scheme" that I'll need to read.
http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.39.1668&rep=rep1&type=pdf
Basic idea: each return address is actually a pair, where the
secondary address lies at a fixed offset of the first and handles
multiple value return. Multiple values are returned back by keeping
them on the stack, and assigning argcount to the number of the
returned values.
In the context of my compiler: the compiler implicitly defines a
singleton, statement context by using next-linkage. But some uses of
next-linkage ignore the number of values that come back, and others
should raise an error. Here are the contexts that care:
app
let1
install-value
toplevel-set (define-values, assign)
For the contexts that don't care, we need to set up a return address
that just pops those values off.
----------------------------------------------------------------------

7
assemble.rkt
View File

@ -143,6 +143,8 @@ EOF
empty]
[(GetControlStackLabel? op)
empty]
[(GetControlStackLabel/MultipleValueReturn? op)
empty]
[(CaptureEnvironment? op)
empty]
[(CaptureControl? op)
@ -377,7 +379,10 @@ EOF
[(GetControlStackLabel? op)
(format "MACHINE.control[MACHINE.control.length-1].label")]
[(GetControlStackLabel/MultipleValueReturn? op)
(format "MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")]
[(CaptureEnvironment? op)
(format "MACHINE.env.slice(0, MACHINE.env.length - ~a)"
(CaptureEnvironment-skip op))]

23
bootstrapped-primitives.rkt
View File

@ -143,6 +143,9 @@
;; The call/cc code is special:
(let ([after-call/cc-code (make-label 'afterCallCCImplementation)])
(append
@ -157,6 +160,26 @@
;; values
(let ([after-values (make-label 'afterValues)]
[values-entry (make-label 'valuesEntry)])
`(,(make-GotoStatement (make-Label after-values))
,values-entry
;; values simply keeps the values on the stack, preserves the argcount, and does a return
;; to the multiple-value-return address.
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel/MultipleValueReturn))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))
,after-values
,(make-AssignPrimOpStatement (make-PrimitivesReference 'values)
(make-MakeCompiledProcedure values-entry
(make-ArityAtLeast 0)
'()
'values))))
;; As is apply:
(let ([after-apply-code (make-label 'afterApplyCode)]
[apply-entry (make-label 'applyEntry)])

20
il-structs.rkt
View File

@ -81,9 +81,16 @@
PopControlFrame/Prompt))
(define-type Statement (U UnlabeledStatement
Symbol ;; label
Symbol ;; label
LinkedLabel ;; Label with a reference to a multiple-return-value label
))
(define-struct: LinkedLabel ([label : Symbol]
[linked-to : Symbol])
#:transparent)
(define-struct: AssignImmediateStatement ([target : Target]
[value : OpArg])
#:transparent)
@ -115,11 +122,11 @@
;; Adding a frame for getting back after procedure application.
;; The 'proc register must hold either #f or a closure at the time of
;; this call, as the control frame will hold onto the called procedure record.
(define-struct: PushControlFrame ([label : Symbol])
(define-struct: PushControlFrame ([label : (U Symbol LinkedLabel)])
#:transparent)
(define-struct: PushControlFrame/Prompt ([tag : (U OpArg DefaultContinuationPromptTag)]
[label : Symbol]
[label : (U Symbol LinkedLabel)]
;; TODO: add handler and arguments
)
#:transparent)
@ -155,7 +162,11 @@
MakeCompiledProcedureShell
ApplyPrimitiveProcedure
;; Gets at the single-value-return address.
GetControlStackLabel
;; Gets at the multiple-value-return address.
GetControlStackLabel/MultipleValueReturn
MakeBoxedEnvironmentValue
CaptureEnvironment
@ -209,6 +220,9 @@
;; Gets the return address embedded at the top of the control stack.
(define-struct: GetControlStackLabel ()
#:transparent)
(define-struct: GetControlStackLabel/MultipleValueReturn ()
#:transparent)
(define-struct: MakeBoxedEnvironmentValue ([depth : Natural])
#:transparent)

4
simulator-structs.rkt
View File

@ -58,7 +58,7 @@
(define-type frame (U CallFrame PromptFrame))
(define-struct: CallFrame ([return : Symbol]
(define-struct: CallFrame ([return : (U Symbol LinkedLabel)]
;; The procedure being called. Used to optimize self-application
[proc : (U closure #f)]
;; TODO: add continuation marks
@ -67,7 +67,7 @@
#:mutable)
(define-struct: PromptFrame ([tag : ContinuationPromptTagValue]
[return : Symbol]
[return : (U Symbol LinkedLabel)]
[env-depth : Natural])
#:transparent)

9
simulator.rkt
View File

@ -89,6 +89,8 @@
(cond
[(symbol? i)
'ok]
[(LinkedLabel? i)
'ok]
[(AssignImmediateStatement? i)
(step-assign-immediate! m i)]
[(AssignPrimOpStatement? i)
@ -479,6 +481,13 @@
(PromptFrame-return frame)]
[(CallFrame? frame)
(CallFrame-return frame)])))]
[(GetControlStackLabel/MultipleValueReturn? op)
(target-updater! m (let ([frame (ensure-frame (first (machine-control m)))])
(cond
[(PromptFrame? frame)
(PromptFrame-return frame)]
[(CallFrame? frame)
(CallFrame-return frame)])))]
[(CaptureEnvironment? op)
(target-updater! m (make-CapturedEnvironment (drop (machine-env m)

4
test-compiler.rkt
View File

@ -1075,6 +1075,10 @@
#:control-limit 3
#:with-bootstrapping? #t)
#;(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))