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

continuing to work on multiple value stuff

Browse Source
This commit is contained in:
Danny Yoo 2011-04-16 15:51:42 -04:00
parent 3cb40ab499
commit a9b3ee7bb9
5 changed files with 84 additions and 1 deletions

7
assemble.rkt
View File

@ -230,6 +230,8 @@ EOF
[(FixClosureShellMap!? op)
empty]
[(InstallContinuationMarkEntry!? op)
empty]
[(RaiseContextExpectedValuesError!? op)
empty]))
(unique/eq?
@ -594,7 +596,10 @@ EOF
[(InstallContinuationMarkEntry!? op)
(string-append "RUNTIME.installContinuationMarkEntry(MACHINE,"
"MACHINE.control[MACHINE.control.length-1].pendingContinuationMarkKey,"
"MACHINE.val);")]))
"MACHINE.val);")]
[(RaiseContextExpectedValuesError!? op)
(format "RUNTIME.raiseContextExpectedValuesError(MACHINE, ~a);"
(RaiseContextExpectedValuesError!-expected op))]))

49
compiler.rkt
View File

@ -216,6 +216,8 @@
,(make-GotoStatement (make-Reg 'proc))))]
[(NextLinkage? linkage)
empty-instruction-sequence]
[(NextLinkage/Expects? linkage)
empty-instruction-sequence]
[(LabelLinkage? linkage)
(make-instruction-sequence `(,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))]))
@ -1038,6 +1040,46 @@
proc-return
(make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(NextLinkage/Expects? linkage)
(cond [(eq? target 'val)
;; This case happens for a function call that isn't in
;; tail position.
(let* ([proc-return-multiple (make-label 'procReturnMultiple)]
[proc-return (make-LinkedLabel (make-label 'procReturn)
proc-return-multiple)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)))
proc-return-multiple
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0))))
proc-return))]
[else
;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space.
(let* ([proc-return-multiple (make-label 'procReturnMultiple)]
[proc-return (make-LinkedLabel (make-label 'procReturn)
proc-return-multiple)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)))
proc-return-multiple
;; FIMXE: this needs to raise a runtime error!
(make-instruction-sequence `(,(make-PopEnvironment (make-Reg 'argcount)
(make-Const 0))))
proc-return
(make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(LabelLinkage? linkage)
(cond [(eq? target 'val)
@ -1131,6 +1173,8 @@
(cond
[(NextLinkage? linkage)
linkage]
[(NextLinkage/Expects? linkage)
linkage]
[(ReturnLinkage? linkage)
linkage]
[(ReturnLinkage/NonTail? linkage)
@ -1165,6 +1209,8 @@
(cond
[(NextLinkage? linkage)
linkage]
[(NextLinkage/Expects? linkage)
linkage]
[(ReturnLinkage? linkage)
linkage]
[(ReturnLinkage/NonTail? linkage)
@ -1207,6 +1253,8 @@
[letrec-linkage : Linkage (cond
[(NextLinkage? linkage)
linkage]
[(NextLinkage/Expects? linkage)
linkage]
[(ReturnLinkage? linkage)
linkage]
[(ReturnLinkage/NonTail? linkage)
@ -1287,6 +1335,7 @@
(compile (WithContMark-body exp) cenv target linkage))]
[(or (NextLinkage? linkage)
(NextLinkage/Expects? linkage)
(LabelLinkage? linkage))
(end-with-linkage
linkage cenv

16
il-structs.rkt
View File

@ -314,6 +314,11 @@
[closed-vals : (Listof Natural)])
#:transparent)
;; Raises an exception that says that we expected a number of values.
;; Assume that argcount is not equal to expected.
(define-struct: RaiseContextExpectedValuesError! ([expected : Natural])
#:transparent)
;; Changes over the control located at the given argument from the structure in env[1]
(define-struct: RestoreControl! ([tag : (U DefaultContinuationPromptTag OpArg)]) #:transparent)
@ -338,6 +343,8 @@
SetFrameCallee!
SpliceListIntoStack!
UnspliceRestFromStack!
RaiseContextExpectedValuesError!
RestoreEnvironment!
RestoreControl!))
@ -376,6 +383,12 @@
(define-struct: NextLinkage ())
(define next-linkage (make-NextLinkage))
;; NextLinkage/Expects works like NextLinkage, but should check that
;; it is returning 'expects' values back.
(define-struct: NextLinkage/Expects ([expects : Natural]))
(define next-linkage-expects-single (make-NextLinkage/Expects 1))
(define-struct: ReturnLinkage ())
(define return-linkage (make-ReturnLinkage))
@ -385,8 +398,11 @@
(define-struct: LabelLinkage ([label : Symbol]))
(define-type Linkage (U NextLinkage
NextLinkage/Expects
ReturnLinkage
ReturnLinkage/NonTail
LabelLinkage))

8
runtime.js
View File

@ -254,6 +254,12 @@
}
};
var raiseContextExpectedValuesError = function(MACHINE, expected) {
raise(MACHINE,
new Error("expected " + expected +
" values, received " +
MACHINE.argcount + " values"));
};
// captureControl implements the continuation-capturing part of
@ -1069,6 +1075,8 @@
exports['testArgument'] = testArgument;
exports['testArity'] = testArity;
exports['raise'] = raise;
exports['raiseContextExpectedValuesError'] = raiseContextExpectedValuesError;
exports['captureControl'] = captureControl;
exports['restoreControl'] = restoreControl;

5
simulator.rkt
View File

@ -383,6 +383,11 @@
(ensure-primitive-value key)
(ensure-primitive-value val))
'ok)]
[(RaiseContextExpectedValuesError!? op)
(error "context expected ~a values, received ~a values."
(RaiseContextExpectedValuesError!-expected op)
(machine-argcount m))]
)))