trying to lexically scope MACHINE for modularity and performance

assemble.rkt

@@ -10,11 +10,16 @@
          assemble-statement)
 
 
+;; Parameter that controls the generation of a trace.
+(define current-emit-debug-trace? (make-parameter #f))
+
+
+
 (: assemble/write-invoke ((Listof Statement) Output-Port -> Void))
 ;; Writes out the JavaScript code that represents the anonymous invocation expression.
 (define (assemble/write-invoke stmts op)
   (let ([basic-blocks (fracture stmts)])
-    (fprintf op "(function(success, fail, params) {\n")
+    (fprintf op "(function(MACHINE, success, fail, params) {\n")
     (fprintf op "var param;\n")
     (for-each (lambda: ([basic-block : BasicBlock])
                        (displayln (assemble-basic-block basic-block) op)
@@ -29,7 +34,7 @@ for (param in params) {
 }
 EOF
              )
-    (fprintf op "trampoline(~a, function() {success(MACHINE.val)}, fail); })"
+    (fprintf op "trampoline(MACHINE, ~a, function() {success(MACHINE.val)}, fail); })"
              (BasicBlock-name (first basic-blocks)))))
 
 
@@ -197,7 +202,7 @@ EOF
 ;; assemble-basic-block: basic-block -> string
 (: assemble-basic-block (BasicBlock -> String))
 (define (assemble-basic-block a-basic-block)
-  (format "var ~a=function(){\nif(--MACHINE.callsBeforeTrampoline < 0) { throw ~a; }\n~a};"
+  (format "var ~a=function(MACHINE){\nif(--MACHINE.callsBeforeTrampoline < 0) { throw function() { return ~a(MACHINE); }; }\n~a};"
           (BasicBlock-name a-basic-block)
           (BasicBlock-name a-basic-block)
           (string-join (map assemble-statement (BasicBlock-stmts a-basic-block))
@@ -223,6 +228,11 @@ EOF
 (: assemble-statement (UnlabeledStatement -> String))
 ;; Generates the code to assemble a statement.
 (define (assemble-statement stmt)
+  (string-append 
+   (if (current-emit-debug-trace?)
+       (format "if (typeof(window.console) !== 'undefined' && typeof(console.log) === 'function') { console.log(~s);\n}"
+               (format "~a" stmt))
+       "")
    (cond
      [(AssignImmediateStatement? stmt)
       (let ([t (assemble-target (AssignImmediateStatement-target stmt))]
@@ -241,16 +251,17 @@ EOF
       (let*: ([test : PrimitiveTest (TestAndBranchStatement-op stmt)])
              (cond
                [(eq? test 'false?)
-               (format "if (! ~a) { return ~a(); }"
+                (format "if (! ~a) { ~a }"
                         (assemble-reg (make-Reg (TestAndBranchStatement-register stmt)))
-                       (assemble-label (make-Label (TestAndBranchStatement-label stmt))))]
+                        (assemble-jump (make-Label (TestAndBranchStatement-label stmt))))]
                [(eq? test 'primitive-procedure?)
-               (format "if (typeof(~a) === 'function') { return ~a(); };"
+                (format "if (typeof(~a) === 'function') { ~a };"
                         (assemble-reg (make-Reg (TestAndBranchStatement-register stmt)))
-                       (assemble-label (make-Label (TestAndBranchStatement-label stmt))))]))]
+                        (assemble-jump (make-Label (TestAndBranchStatement-label stmt))))]))]
      
      [(GotoStatement? stmt)
-     (format "return ~a();" (assemble-location (GotoStatement-target stmt)))]
+      (assemble-jump (GotoStatement-target stmt))]
+
      [(PushControlFrame? stmt)
       (format "MACHINE.control.push(new Frame(~a, MACHINE.proc));" (PushControlFrame-label stmt))]
      [(PopControlFrame? stmt)
@@ -267,7 +278,13 @@ EOF
       (format "MACHINE.env.splice(MACHINE.env.length-(~a),~a);"
               (+ (PopEnvironment-skip stmt)
                  (PopEnvironment-n stmt))
-             (PopEnvironment-n stmt))]))
+              (PopEnvironment-n stmt))])))
+
+
+
+(: assemble-jump ((U Label Reg) -> String))
+(define (assemble-jump target)
+  (format "return (~a)(MACHINE);" (assemble-location target)))
 
 
 

package.rkt

@@ -13,18 +13,8 @@
 
 ;; Packager: produce single .js files to be included.
 
-(define-runtime-path runtime.js "runtime.js")
-
 ;; package: s-expression output-port -> void
 (define (package source-code op)  
-
-  ;; The runtime code
-  (call-with-input-file* runtime.js
-    (lambda (ip)
-      (copy-port ip op)))
-  
-  (newline op)
-  
   (fprintf op "var invoke = ")
   (assemble/write-invoke (append (get-bootstrapping-code)
 				 (compile (parse source-code)

runtime.js

@@ -293,65 +293,11 @@ var Primitives = (function() {
 	    }
 	    return true;
 	}
-
-// 	, 
-//  	'call/cc': new Closure(callCCEntry,
-//  			       1,
-//  			       [],
-//  			       "call/cc"),
-// 	'call-with-current-continuation': new Closure(callCCEntry,
-//  						      1,
-//  						      [],
-//  						      "call-with-current-continuation")
-
     };
 })();
 
 
 
-
-// // 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);
-// 		};
-		
-// 		proc.label();
-//             },
-//             function() {
-//             },
-//             function(e) {
-// 		return fail(e);
-// 	    });
-//     }
-// };
-
-
-
 var MACHINE = { callsBeforeTrampoline: 100, 
 		val:undefined,
 		proc:undefined, 
@@ -398,7 +344,7 @@ var recomputeMaxNumBouncesBeforeYield = function(observedDelay) {
 };
 
 
-var trampoline = function(initialJump, success, fail) {
+var trampoline = function(MACHINE, initialJump, success, fail) {
     var thunk = initialJump;
     var startTime = (new Date()).valueOf();
     MACHINE.callsBeforeTrampoline = 100;
@@ -408,7 +354,7 @@ var trampoline = function(initialJump, success, fail) {
 
     while(thunk) {
         try {
-            thunk();
+            thunk(MACHINE);
 	    break;
         } catch (e) {
             if (typeof(e) === 'function') {
@@ -420,7 +366,7 @@ var trampoline = function(initialJump, success, fail) {
 			(new Date()).valueOf() - startTime);
 		    setTimeout(
 			function() {
-			    trampoline(thunk, success, fail);
+			    trampoline(MACHINE, thunk, success, fail);
 			},
 			0);
 		    return;

test-assemble.rkt

@@ -69,7 +69,7 @@
                             (display ";" op)
                             
                             (fprintf op 
-                                     "return function(succ, fail, params) { myInvoke(function(v) { succ(String(~a));}, fail, params); }"
+                                     "return function(succ, fail, params) { myInvoke(MACHINE, function(v) { succ(String(~a));}, fail, params); }"
                                      inspector)
                             (display "})" op))))))
 (define (E-many stmts (inspector "MACHINE.val"))

test-browser-evaluate.rkt

@@ -1,8 +1,36 @@
 #lang racket
 (require "browser-evaluate.rkt"
-         "package.rkt")
+         "package.rkt"
+         racket/runtime-path)
 
-(define evaluate (make-evaluate package-anonymous))
+
+(define-runtime-path runtime.js "runtime.js")
+
+(define evaluate (make-evaluate 
+                  (lambda (program op)
+
+                    (fprintf op "(function () {")
+                    
+                    ;; The runtime code
+                    (call-with-input-file* runtime.js
+                      (lambda (ip)
+                        (copy-port ip op)))
+                    
+                    (newline op)
+                    
+                    (fprintf op "var innerInvoke = ")
+                    (package-anonymous program op)
+                    (fprintf op "();\n")
+                    
+                    (fprintf op #<<EOF
+return (function(succ, fail, params) {
+            return innerInvoke(MACHINE, succ, fail, params);
+        });
+});
+EOF
+                             )
+                    
+                    )))
 
 ;; test-find-toplevel-variables
 (define-syntax (test stx)