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

adjusting control frames to hold the procedure in hand, just in case

Browse Source
This commit is contained in:
Danny Yoo 2011-03-10 14:31:31 -05:00
parent f365767023
commit 49a53c0864
6 changed files with 67 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
assemble.rkt
View File

@ -238,7 +238,7 @@ EOF
(format "return ~a();"
(assemble-location (GotoStatement-target stmt)))]
[(PushControlFrame? stmt)
(format "MACHINE.control.push(new Frame(~a));" (PushControlFrame-label stmt))]
(format "MACHINE.control.push(new Frame(~a, MACHINE.proc));" (PushControlFrame-label stmt))]
[(PopControlFrame? stmt)
"MACHINE.control.pop();"]
[(PushEnvironment? stmt)

2
il-structs.rkt
View File

@ -93,6 +93,8 @@
#:transparent)
;; 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])
#:transparent)

77
runtime.js
View File

@ -104,8 +104,9 @@ var Primitives = (function() {
})();
var Frame = function(label) {
var Frame = function(label, proc) {
this.label = label;
this.proc = proc;
};
@ -119,45 +120,45 @@ var Closure = function(label, arity, closedVals, displayName) {
};
// adaptToJs: closure -> (array (X -> void) -> void)
// Converts closures to functions that can be called from the
// JavaScript toplevel.
Closure.prototype.adaptToJs = function() {
var that = this;
return function(args, success, fail) {
var oldEnv = MACHINE.env;
var oldCont = MACHINE.cont;
var oldProc = MACHINE.proc;
var oldArgl = MACHINE.argl;
var oldVal = MACHINE.val;
trampoline(
function() {
var proc = that;
MACHINE.proc = proc;
MACHINE.argl = undefined;
for(var i = args.length - 1; i >= 0; i--) {
MACHINE.argl = [args[i], MACHINE.argl];
}
// // adaptToJs: closure -> (array (X -> void) -> void)
// // Converts closures to functions that can be called from the
// // JavaScript toplevel.
// Closure.prototype.adaptToJs = function() {
// var that = this;
// return function(args, success, fail) {
// var oldEnv = MACHINE.env;
// var oldCont = MACHINE.cont;
// var oldProc = MACHINE.proc;
// var oldArgl = MACHINE.argl;
// var oldVal = MACHINE.val;
// trampoline(
// function() {
// var proc = that;
// MACHINE.proc = proc;
// MACHINE.argl = undefined;
// for(var i = args.length - 1; i >= 0; i--) {
// MACHINE.argl = [args[i], MACHINE.argl];
// }
MACHINE.cont = function() {
var result = MACHINE.val;
MACHINE.env = oldEnv;
MACHINE.cont = oldCont;
MACHINE.proc = oldProc;
MACHINE.argl = oldArgl;
MACHINE.val = oldVal;
success(result);
};
// MACHINE.cont = function() {
// var result = MACHINE.val;
// MACHINE.env = oldEnv;
// MACHINE.cont = oldCont;
// MACHINE.proc = oldProc;
// MACHINE.argl = oldArgl;
// MACHINE.val = oldVal;
// success(result);
// };
proc.label();
},
function() {
},
function(e) {
return fail(e);
});
}
};
// proc.label();
// },
// function() {
// },
// function(e) {
// return fail(e);
// });
// }
// };

2
simulator-structs.rkt
View File

@ -32,6 +32,8 @@
(define-struct: frame ([return : Symbol]
;; The procedure being called. Used to optimize self-application
[proc : (U closure #f)]
;; TODO: add continuation marks
)
#:transparent)

16
simulator.rkt
View File

@ -119,7 +119,8 @@
(: step-push-control-frame (machine PushControlFrame -> machine))
(define (step-push-control-frame m stmt)
(control-push m (PushControlFrame-label stmt)))
(control-push m (make-frame (PushControlFrame-label stmt)
(ensure-closure-or-false (machine-proc m)))))
(: step-pop-control-frame (machine PopControlFrame -> machine))
(define (step-pop-control-frame m stmt)
@ -305,6 +306,13 @@
v]))]))
(: ensure-closure-or-false (SlotValue -> (U closure #f)))
(define (ensure-closure-or-false v)
(if (or (closure? v) (eq? v #f))
v
(error 'ensure-closure)))
(: ensure-primitive-value (Any -> PrimitiveValue))
;; Make sure the value is primitive.
(define (ensure-primitive-value val)
@ -426,11 +434,11 @@
(ensure-natural (- stack-size n)))]))
(: control-push (machine Symbol -> machine))
(define (control-push m l)
(: control-push (machine frame -> machine))
(define (control-push m a-frame)
(match m
[(struct machine (val proc env control pc text stack-size))
(make-machine val proc env (cons (make-frame l) control) pc text
(make-machine val proc env (cons a-frame control) pc text
stack-size)]))

18
test-simulator.rkt
View File

@ -122,20 +122,22 @@
;; PushControl
(let ([m (new-machine `(foo
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo
,(make-PushControlFrame 'foo)
bar
,(make-PushControlFrame 'bar)
baz
))])
(test (machine-control (run m))
(list (make-frame 'bar)
(make-frame 'foo))))
(list (make-frame 'bar #f)
(make-frame 'foo #f))))
;; PopControl
(let ([m (new-machine `(foo
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo
,(make-PushControlFrame 'foo)
bar
,(make-PushControlFrame 'bar)
@ -143,9 +145,10 @@
,(make-PopControlFrame)
))])
(test (machine-control (run m))
(list (make-frame 'foo))))
(list (make-frame 'foo #f))))
(let ([m (new-machine `(foo
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo
,(make-PushControlFrame 'foo)
bar
,(make-PushControlFrame 'bar)
@ -429,7 +432,8 @@
;; GetControlStackLabel
(let ([m (new-machine `(foo
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo
,(make-PushControlFrame 'foo)
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))))])
(test (machine-proc (run m))