From 3030cf9f005b522583bf816e8a2f854fbd7eaa12 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 25 Feb 2013 18:29:32 -0700 Subject: [PATCH] still in the middle of tracing down weirdness with the module loading. --- whalesong/compiler/compiler.rkt | 10 +++++----- whalesong/compiler/il-structs.rkt | 5 ++++- .../js-assembler/assemble-perform-statement.rkt | 14 ++++++++++++++ whalesong/js-assembler/assemble.rkt | 16 ++++++++++++---- .../runtime-src/baselib-exceptions.js | 8 ++++++++ .../runtime-src/baselib-loadscript.js | 1 - whalesong/js-assembler/runtime-src/runtime.js | 4 +++- 7 files changed, 46 insertions(+), 12 deletions(-) diff --git a/whalesong/compiler/compiler.rkt b/whalesong/compiler/compiler.rkt index ef0e07b..7ce50d0 100644 --- a/whalesong/compiler/compiler.rkt +++ b/whalesong/compiler/compiler.rkt @@ -278,13 +278,13 @@ (make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'linked?)) linked) ;; TODO: try to link dynamically, using plt.runtime.currentModuleLoader. - (make-Perform (make-LinkModule! a-module-name)) + (make-Perform (make-LinkModule! a-module-name linked)) ;; If that fails, finally raise an exception here that says that the module hasn't been ;; linked yet. - #;(make-DebugPrint (make-Const - (format "DEBUG: the module ~a hasn't been linked in!!!" - (ModuleLocator-name a-module-name)))) - (make-Goto (make-Label (LinkedLabel-label on-return))) + ;(make-DebugPrint (make-Const + ; (format "DEBUG: the module ~a hasn't been linked in!!!" + ; (ModuleLocator-name a-module-name)))) + ;(make-Goto (make-Label (LinkedLabel-label on-return))) linked (make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'invoked?)) diff --git a/whalesong/compiler/il-structs.rkt b/whalesong/compiler/il-structs.rkt index 213459e..638163b 100644 --- a/whalesong/compiler/il-structs.rkt +++ b/whalesong/compiler/il-structs.rkt @@ -474,7 +474,10 @@ ;; Use the dynamic module loader to link the module into the runtime. -(define-struct: LinkModule! ([path : ModuleLocator])) +;; After successful linkage, jump into label. +(define-struct: LinkModule! ([path : ModuleLocator] + [label : Symbol])) + ;; Installs a module record into the machine (define-struct: InstallModuleEntry! ([name : Symbol] diff --git a/whalesong/js-assembler/assemble-perform-statement.rkt b/whalesong/js-assembler/assemble-perform-statement.rkt index 305b85c..c558aaf 100644 --- a/whalesong/js-assembler/assemble-perform-statement.rkt +++ b/whalesong/js-assembler/assemble-perform-statement.rkt @@ -151,6 +151,20 @@ (format "RT.raiseUnimplementedPrimitiveError(M,~s);" (symbol->string (RaiseUnimplementedPrimitiveError!-name op)))] + [(LinkModule!? op) + (format "RT.PAUSE( + function(restart){ + RT.currentModuleLoader(M,~s, + function(){ + restart(function(M){ ~a(M); }); + }, + function(){ + RT.raiseModuleLoadingError(M,~s); + }); + });" + (symbol->string (ModuleLocator-name (LinkModule!-path op))) + (assemble-label (make-Label (LinkModule!-label op))) + (symbol->string (ModuleLocator-name (LinkModule!-path op))))] [(InstallModuleEntry!? op) (format "M.modules[~s]=new RT.ModuleRecord(~s,~a);" diff --git a/whalesong/js-assembler/assemble.rkt b/whalesong/js-assembler/assemble.rkt index 7a30e3f..8dfadc3 100644 --- a/whalesong/js-assembler/assemble.rkt +++ b/whalesong/js-assembler/assemble.rkt @@ -31,11 +31,11 @@ -(: assemble/write-invoke ((Listof Statement) Output-Port -> Void)) +(: assemble/write-invoke ((Listof Statement) #;Boolean Output-Port -> Void)) ;; Writes out the JavaScript code that represents the anonymous invocation expression. ;; What's emitted is a function expression that, when invoked, runs the ;; statements. -(define (assemble/write-invoke stmts op) +(define (assemble/write-invoke stmts #;without-trampoline? op) (parameterize ([current-interned-symbol-table ((inst make-hash Symbol Symbol))] [current-interned-constant-closure-table ((inst make-hash Symbol MakeCompiledProcedure))]) (display "(function(M, success, fail, params) {\n" op) @@ -73,8 +73,16 @@ for (param in params) { } EOF op) - (fprintf op "M.trampoline(~a, true); })" - (assemble-label (make-Label (BasicBlock-name (first basic-blocks))))))) + (fprintf op "~a(M); })" + (assemble-label (make-Label (BasicBlock-name (first basic-blocks))))) + #;(cond [without-trampoline? + ;; If it's a module statement, we just want to call it directly, to get things loaded. + (fprintf op "~a(M); })" + (assemble-label (make-Label (BasicBlock-name (first basic-blocks)))))] + [else + ;; Otherwise, we want to run under a trampolining context. + (fprintf op "M.trampoline(~a, true); })" + (assemble-label (make-Label (BasicBlock-name (first basic-blocks)))))]))) diff --git a/whalesong/js-assembler/runtime-src/baselib-exceptions.js b/whalesong/js-assembler/runtime-src/baselib-exceptions.js index e446c61..ec1030b 100644 --- a/whalesong/js-assembler/runtime-src/baselib-exceptions.js +++ b/whalesong/js-assembler/runtime-src/baselib-exceptions.js @@ -178,6 +178,13 @@ }; + var raiseModuleLoadingError = function(MACHINE, name) { + var message = "unable to dynamically load module: " + name; + var contMarks = MACHINE.captureContinuationMarks(); + raise(MACHINE, + ExnFail.constructor([message, contMarks])); + }; + @@ -248,6 +255,7 @@ exceptions.raiseOperatorApplicationError = raiseOperatorApplicationError; exceptions.raiseOperatorIsNotPrimitiveProcedure = raiseOperatorIsNotPrimitiveProcedure; exceptions.raiseUnimplementedPrimitiveError = raiseUnimplementedPrimitiveError; + exceptions.raiseModuleLoadingError = raiseModuleLoadingError; }(this.plt.baselib)); \ No newline at end of file diff --git a/whalesong/js-assembler/runtime-src/baselib-loadscript.js b/whalesong/js-assembler/runtime-src/baselib-loadscript.js index 7d0b6e7..43f5497 100644 --- a/whalesong/js-assembler/runtime-src/baselib-loadscript.js +++ b/whalesong/js-assembler/runtime-src/baselib-loadscript.js @@ -2,7 +2,6 @@ // Frame structures. (function(baselib) { - 'use strict'; var exports = {}; baselib.loadscript = exports; diff --git a/whalesong/js-assembler/runtime-src/runtime.js b/whalesong/js-assembler/runtime-src/runtime.js index b8d8d3c..70622b9 100644 --- a/whalesong/js-assembler/runtime-src/runtime.js +++ b/whalesong/js-assembler/runtime-src/runtime.js @@ -113,6 +113,8 @@ var raiseOperatorApplicationError = baselib.exceptions.raiseOperatorApplicationError; var raiseOperatorIsNotPrimitiveProcedure = baselib.exceptions.raiseOperatorIsNotPrimitiveProcedure; var raiseUnimplementedPrimitiveError = baselib.exceptions.raiseUnimplementedPrimitiveError; + var raiseModuleLoadingError = baselib.exceptions.raiseModuleLoadingError; + var ArityAtLeast = baselib.arity.ArityAtLeast; @@ -1151,7 +1153,7 @@ // their files. if (moduleManifest[moduleName]) { var modulePath = moduleManifest[moduleName]; - return loadScript(modulePath, success, fail); + return loadScript(modulePath+"?gensym="+Math.random(), success, fail); } return fail(); }