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

correcting pre-emption.

Browse Source
This commit is contained in:
Danny Yoo 2013-03-01 17:01:04 -07:00
parent 6642cdcff7
commit 920f7cf85f
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
whalesong/js-assembler/assemble.rkt
View File

@ -31,11 +31,11 @@
(: assemble/write-invoke ((Listof Statement) Boolean Output-Port -> Void))
(: assemble/write-invoke ((Listof Statement) Output-Port (U 'no-trampoline 'without-preemption 'with-preemption) -> 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 without-trampoline? op)
(define (assemble/write-invoke stmts op trampoline-option)
(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,14 +73,18 @@ for (param in params) {
}
EOF
op)
(cond [without-trampoline?
(cond [(eq? trampoline-option 'no-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)))))])))
(fprintf op "M.trampoline(~a, ~a); })"
(assemble-label (make-Label (BasicBlock-name (first basic-blocks))))
(cond [(eq? trampoline-option 'with-preemption)
"false"]
[(eq? trampoline-option 'without-preemption)
"true"]))])))

2
whalesong/repl-prototype/server.rkt
View File

@ -76,7 +76,7 @@
(define compiled-bytecode (compile-for-repl whalesong-bytecode))
(pretty-print compiled-bytecode)
(define assembled-op (open-output-string))
(define assembled (assemble/write-invoke compiled-bytecode #f assembled-op))
(define assembled (assemble/write-invoke compiled-bytecode assembled-op 'with-preemption))
(cons (get-output-string assembled-op) (loop))])))
(printf "assembled codes ~a\n" assembled-codes)
(write-json (hash 'compiledCodes assembled-codes)