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

begin0 not quite done yet, but I need to get other things working first.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-12 17:36:33 -04:00
parent 01f2bc7566
commit cfa1874f0a
2 changed files with 67 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
compiler.rkt
View File

@ -527,24 +527,15 @@
(compile (first seq) cenv target linkage)]
[else
(let ([after-first-seq (make-label 'afterFirstSeqEvaluated)]
[after-values-reinstated (make-label 'afterValuesReinstated)])
(end-with-linkage
linkage
cenv
(let ([evaluate-and-save-first-expression
(let ([after-first-seq (make-label 'afterFirstSeqEvaluated)])
(append-instruction-sequences
;; Evaluate the first expression in a multiple-value context, and get the values on the stack.
(compile (first seq)
cenv
'val
next-linkage/keep-multiple-on-stack)
(compile (first seq) cenv 'val next-linkage/keep-multiple-on-stack)
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-first-seq)
,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)))
after-first-seq
;; At this time, the argcount values are on the stack.
;; Next, we save those values temporarily in a throwaway control frame.
(make-instruction-sequence
@ -554,11 +545,10 @@
,(make-PerformStatement (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
,(make-AssignImmediateStatement (make-ControlFrameTemporary 'pendingBegin0Values)
(make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))))
;; Evaluate the rest of the sequence, dropping their values.
(compile-sequence (rest seq) cenv target next-linkage/drop-multiple)
,(make-PopEnvironment (make-Const 1) (make-Const 0))))))]
[reinstate-values-on-stack
(let ([after-values-reinstated (make-label 'afterValuesReinstated)])
(make-instruction-sequence
`(;; Reinstate the values of the first expression, and drop the throwaway control frame.
,(make-PushImmediateOntoEnvironment (make-ControlFrameTemporary 'pendingBegin0Values) #f)
@ -568,35 +558,41 @@
,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))
,after-values-reinstated))
,after-values-reinstated)))])
(let ([context (linkage-context linkage)])
(cond
[(eq? context 'tail)
empty-instruction-sequence]
(append-instruction-sequences
evaluate-and-save-first-expression
[(eq? context 'drop-multiple)
(make-instruction-sequence
`(,(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount) (make-Const 1))
(make-Const 0))))]
[(eq? context 'keep-multiple)
empty-instruction-sequence]
[(natural? context)
;; Check that the context can accept the argcount values.
(let ([after-check (make-label 'afterCheck)])
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestZero (make-SubtractArg
(make-Reg 'argcount)
(make-Const context)))
after-check)
,(make-PerformStatement (make-RaiseContextExpectedValuesError! context))
,after-check)))]))
(compile-sequence (rest seq) cenv target next-linkage/drop-multiple)
reinstate-values-on-stack
(make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val))))
)))]))
;; TODO: context needs check for arguments.
(cond
[(ReturnLinkage? linkage)
(cond
[(ReturnLinkage-tail? linkage)
(make-instruction-sequence
`(,(make-PopEnvironment (make-Const (length cenv))
(make-SubtractArg (make-Reg 'argcount)
(make-Const 1)))
,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))]
[else
(make-instruction-sequence
`(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel/MultipleValueReturn))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))])]
[(NextLinkage? linkage)
empty-instruction-sequence]
[(LabelLinkage? linkage)
(make-instruction-sequence
`(,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))])))]))