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

working on reducing cost of assembly

Browse Source
This commit is contained in:
Danny Yoo 2011-09-03 19:59:11 -04:00
parent 4dde2929f4
commit df20eb4ee5
2 changed files with 57 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
js-assembler/assemble-perform-statement.rkt
View File

@ -115,7 +115,7 @@ EOF
(assemble-oparg tag)])))] (assemble-oparg tag)])))]
[(FixClosureShellMap!? op) [(FixClosureShellMap!? op)
(format "MACHINE.env[MACHINE.env.length - 1 - ~a].closedVals = [~a]" (format "MACHINE.env[MACHINE.env.length - 1 - ~a].closedVals = [~a];"
(FixClosureShellMap!-depth op) (FixClosureShellMap!-depth op)
(string-join (map (string-join (map
assemble-env-reference/closure-capture assemble-env-reference/closure-capture

76
js-assembler/assemble.rkt
View File

@ -39,9 +39,9 @@
;; What's emitted is a function expression that, when invoked, runs the ;; What's emitted is a function expression that, when invoked, runs the
;; statements. ;; statements.
(define (assemble/write-invoke stmts op) (define (assemble/write-invoke stmts op)
(fprintf op "(function(MACHINE, success, fail, params) {\n") (display "(function(MACHINE, success, fail, params) {\n" op)
(fprintf op "var param;\n") (display "var param;\n" op)
(fprintf op "var RUNTIME = plt.runtime;\n") (display "var RUNTIME = plt.runtime;\n" op)
(define-values (basic-blocks entry-points) (fracture stmts)) (define-values (basic-blocks entry-points) (fracture stmts))
@ -49,16 +49,16 @@
(write-linked-label-attributes stmts op) (write-linked-label-attributes stmts op)
(fprintf op "MACHINE.params.currentErrorHandler = fail;\n") (display "MACHINE.params.currentErrorHandler = fail;\n" op)
(fprintf op "MACHINE.params.currentSuccessHandler = success;\n") (display "MACHINE.params.currentSuccessHandler = success;\n" op)
(fprintf op #<<EOF (display #<<EOF
for (param in params) { for (param in params) {
if (params.hasOwnProperty(param)) { if (params.hasOwnProperty(param)) {
MACHINE.params[param] = params[param]; MACHINE.params[param] = params[param];
} }
} }
EOF EOF
) op)
(fprintf op "MACHINE.trampoline(~a); })" (fprintf op "MACHINE.trampoline(~a); })"
(assemble-label (make-Label (BasicBlock-name (first basic-blocks)))))) (assemble-label (make-Label (BasicBlock-name (first basic-blocks))))))
@ -79,9 +79,9 @@ EOF
(set-for-each (lambda: ([s : Symbol]) (set-for-each (lambda: ([s : Symbol])
(log-debug (format "Emitting code for basic block ~s" s)) (log-debug (format "Emitting code for basic block ~s" s))
(displayln (assemble-basic-block (hash-ref blockht s) (assemble-basic-block (hash-ref blockht s)
blockht blockht
entry-points) entry-points
op) op)
(newline op)) (newline op))
entry-points)) entry-points))
@ -168,41 +168,44 @@ EOF
;; assemble-basic-block: basic-block -> string
(: assemble-basic-block (BasicBlock Blockht (Setof Symbol) -> String)) (: assemble-basic-block (BasicBlock Blockht (Setof Symbol) Output-Port -> 'ok))
(define (assemble-basic-block a-basic-block blockht entry-points) (define (assemble-basic-block a-basic-block blockht entry-points op)
(format "var ~a = function(MACHINE){ (fprintf op "var ~a = function(MACHINE) {
if(--MACHINE.callsBeforeTrampoline < 0) { if(--MACHINE.callsBeforeTrampoline < 0) {
throw ~a; throw ~a;
} }"
~a
};"
(assemble-label (make-Label (BasicBlock-name a-basic-block))) (assemble-label (make-Label (BasicBlock-name a-basic-block)))
(assemble-label (make-Label (BasicBlock-name a-basic-block))) (assemble-label (make-Label (BasicBlock-name a-basic-block))))
(string-join (assemble-block-statements (BasicBlock-name a-basic-block) (assemble-block-statements (BasicBlock-name a-basic-block)
(BasicBlock-stmts a-basic-block) (BasicBlock-stmts a-basic-block)
blockht blockht
entry-points) entry-points
"\n"))) op)
(display "};\n" op)
'ok)
(: assemble-block-statements (Symbol (Listof UnlabeledStatement) Blockht (Setof Symbol) -> (Listof String)))
(define (assemble-block-statements name stmts blockht entry-points)
(: default (UnlabeledStatement -> (Listof String))) (: assemble-block-statements (Symbol (Listof UnlabeledStatement) Blockht (Setof Symbol) Output-Port -> 'ok))
(define (assemble-block-statements name stmts blockht entry-points op)
(: default (UnlabeledStatement -> 'ok))
(define (default stmt) (define (default stmt)
(when (and (empty? (rest stmts)) (when (and (empty? (rest stmts))
(not (GotoStatement? stmt))) (not (GotoStatement? stmt)))
(log-debug (format "Last statement of the block ~a is not a goto" name))) (log-debug (format "Last statement of the block ~a is not a goto" name)))
(cons (assemble-statement stmt) (display (assemble-statement stmt) op)
(newline op)
(assemble-block-statements name (assemble-block-statements name
(rest stmts) (rest stmts)
blockht blockht
entry-points))) entry-points
op))
(cond [(empty? stmts) (cond [(empty? stmts)
empty] 'ok]
[else [else
(define stmt (first stmts)) (define stmt (first stmts))
(cond (cond
@ -244,21 +247,23 @@ EOF
(format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a))" (format "if (! RUNTIME.isArityMatching((~a).racketArity, ~a))"
(assemble-oparg (TestClosureArityMismatch-closure test)) (assemble-oparg (TestClosureArityMismatch-closure test))
(assemble-oparg (TestClosureArityMismatch-n test)))])) (assemble-oparg (TestClosureArityMismatch-n test)))]))
`(, test-code (display test-code op)
"{" (display "{" op)
,@(cond (cond
[(set-contains? entry-points (TestAndJumpStatement-label stmt)) [(set-contains? entry-points (TestAndJumpStatement-label stmt))
(list (assemble-jump (make-Label (TestAndJumpStatement-label stmt))))] (display (assemble-jump (make-Label (TestAndJumpStatement-label stmt))) op)]
[else [else
(assemble-block-statements (BasicBlock-name (assemble-block-statements (BasicBlock-name
(hash-ref blockht (TestAndJumpStatement-label stmt))) (hash-ref blockht (TestAndJumpStatement-label stmt)))
(BasicBlock-stmts (BasicBlock-stmts
(hash-ref blockht (TestAndJumpStatement-label stmt))) (hash-ref blockht (TestAndJumpStatement-label stmt)))
blockht blockht
entry-points)]) entry-points
"} else {" op)])
,@(assemble-block-statements name (rest stmts) blockht entry-points) (display "} else {" op)
"}")] (assemble-block-statements name (rest stmts) blockht entry-points op)
(display "}" op)
'ok]
[(GotoStatement? stmt) [(GotoStatement? stmt)
(define target (GotoStatement-target stmt)) (define target (GotoStatement-target stmt))
@ -274,7 +279,8 @@ EOF
(BasicBlock-stmts (BasicBlock-stmts
(hash-ref blockht (Label-name target))) (hash-ref blockht (Label-name target)))
blockht blockht
entry-points)])] entry-points
op)])]
[(Reg? target) [(Reg? target)
(default stmt)] (default stmt)]
[(ModuleEntry? target) [(ModuleEntry? target)