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

traced that the external module invokation was introducting one more call-back into the success continuation of the trampoline. Ugh.

Browse Source
This commit is contained in:
Danny Yoo 2011-08-08 13:59:38 -04:00
parent deb6c235ce
commit 0ff8fd1a61
4 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler/optimize-il.rkt
View File

@ -54,6 +54,7 @@
(define goto-target (GotoStatement-target next-stmt))
(cond
[(Label? goto-target)
(log-debug (format "merging label ~a and ~a" last-stmt (Label-name goto-target)))
(ufind:union-set a-forest last-stmt (Label-name goto-target))
(loop (rest stmts) next-stmt)]
[else

24
js-assembler/assemble.rkt
View File

@ -179,19 +179,25 @@ EOF
};"
(assemble-label (make-Label (BasicBlock-name a-basic-block)))
(assemble-label (make-Label (BasicBlock-name a-basic-block)))
(string-join (assemble-block-statements (BasicBlock-stmts a-basic-block)
(string-join (assemble-block-statements (BasicBlock-name a-basic-block)
(BasicBlock-stmts a-basic-block)
blockht
entry-points)
"\n")))
(: assemble-block-statements ((Listof UnlabeledStatement) Blockht (Setof Symbol) -> (Listof String)))
(define (assemble-block-statements stmts blockht entry-points)
(: assemble-block-statements (Symbol (Listof UnlabeledStatement) Blockht (Setof Symbol) -> (Listof String)))
(define (assemble-block-statements name stmts blockht entry-points)
(: default (UnlabeledStatement -> (Listof String)))
(define (default stmt)
(when (and (empty? (rest stmts))
(not (GotoStatement? stmt)))
(log-debug (format "Last statement of the block ~a is not a goto" name)))
(cons (assemble-statement stmt)
(assemble-block-statements (rest stmts)
(assemble-block-statements name
(rest stmts)
blockht
entry-points)))
@ -244,12 +250,14 @@ EOF
[(set-contains? entry-points (TestAndJumpStatement-label stmt))
(list (assemble-jump (make-Label (TestAndJumpStatement-label stmt))))]
[else
(assemble-block-statements (BasicBlock-stmts
(assemble-block-statements (BasicBlock-name
(hash-ref blockht (TestAndJumpStatement-label stmt)))
(BasicBlock-stmts
(hash-ref blockht (TestAndJumpStatement-label stmt)))
blockht
entry-points)])
"} else {"
,@(assemble-block-statements (rest stmts) blockht entry-points)
,@(assemble-block-statements name (rest stmts) blockht entry-points)
"}")]
[(GotoStatement? stmt)
@ -261,7 +269,9 @@ EOF
(default stmt)]
[else
(log-debug (format "Assembling inlined jump into ~a" (Label-name target)) )
(assemble-block-statements (BasicBlock-stmts
(assemble-block-statements (BasicBlock-name
(hash-ref blockht (Label-name target)))
(BasicBlock-stmts
(hash-ref blockht (Label-name target)))
blockht
entry-points)])]

5
js-assembler/runtime-src/baselib-modules.js
View File

@ -53,7 +53,10 @@
var oldErrorHandler = MACHINE.params['currentErrorHandler'];
var afterGoodInvoke = function (MACHINE) {
MACHINE.params['currentErrorHandler'] = oldErrorHandler;
succ();
if (isInternal) { succ(); }
else {
throw new plt.runtime.HaltError(succ)
}
};
if (this.isInvoked) {

2
js-assembler/runtime-src/runtime.js
View File

@ -562,7 +562,7 @@
// Executes all programs that have been labeled as a main module
var invokeMains = function(machine, succ, fail) {
runtime.ready(function() {
runtime.ready(function invokeMain() {
setReadyFalse();
machine = machine || runtime.currentMachine;
succ = succ || function() {};