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

reducing cost of fracture by using hashtable

Browse Source
This commit is contained in:
Danny Yoo 2011-09-03 19:29:32 -04:00
parent 086f6c283f
commit 27e3a444b1
4 changed files with 69 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
js-assembler/collect-jump-targets.rkt
View File

@ -128,40 +128,13 @@
[(InstallModuleEntry!? op)
(list (InstallModuleEntry!-entry-point op))]
[else
empty]
;; currently written this way because I'm hitting some bad type-checking behavior.
#;([(CheckToplevelBound!? op)
empty]
[(CheckClosureArity!? op)
empty]
[(CheckPrimitiveArity!? op)
empty]
[(ExtendEnvironment/Prefix!? op)
empty]
[(InstallClosureValues!? op)
empty]
[(RestoreEnvironment!? op)
empty]
[(RestoreControl!? op)
empty]
[(SetFrameCallee!? op)
empty]
[(SpliceListIntoStack!? op)
empty]
[(UnspliceRestFromStack!? op)
empty]
[(FixClosureShellMap!? op)
empty]
[(InstallContinuationMarkEntry!? op)
empty]
[(RaiseContextExpectedValuesError!? op)
empty]
[(RaiseArityMismatchError!? op)
empty]
[(RaiseOperatorApplicationError!? op)
empty])))
empty]))
(: start-time Real)
(define start-time (current-inexact-milliseconds))
(: result (Listof Symbol))
(define result
(unique/eq?
(let: loop : (Listof Symbol) ([stmts : (Listof Statement) stmts])
(cond [(empty? stmts)
@ -171,6 +144,12 @@
(append (collect-statement stmt)
(loop (rest stmts))))]))))
(: end-time Real)
(define end-time (current-inexact-milliseconds))
(printf " collect-general-jump-targets: ~a milliseconds\n" (- end-time start-time))
result)

20
js-assembler/fracture.rkt
View File

@ -22,10 +22,15 @@
;; fracture: (listof stmt) -> (listof basic-block)
(: fracture ((Listof Statement) -> (values (Listof BasicBlock)
(Listof Symbol))))
(define (fracture stmts)
(define start-time (current-inexact-milliseconds))
(define-values (blocks entries)
(let*: ([first-block-label : Symbol (if (and (not (empty? stmts))
(symbol? (first stmts)))
(first stmts)
@ -38,6 +43,12 @@
(cons first-block-label (collect-general-jump-targets stmts))]
[entry-points : (Listof Symbol)
(cons first-block-label (collect-entry-points stmts))])
(define jump-targets-ht ((inst make-hasheq Symbol Boolean)))
(for ([name jump-targets])
(hash-set! jump-targets-ht name #t))
(set! start-time (current-inexact-milliseconds))
(let: loop : (values (Listof BasicBlock) (Listof Symbol))
([name : Symbol first-block-label]
[acc : (Listof UnlabeledStatement) '()]
@ -54,14 +65,14 @@
(: do-on-label (Symbol -> (values (Listof BasicBlock) (Listof Symbol))))
(define (do-on-label label-name)
(cond
[(member label-name jump-targets)
[(hash-has-key? jump-targets-ht label-name)
(loop label-name
'()
(cons (make-BasicBlock
name
(if last-stmt-goto?
(reverse acc)
(reverse (append `(,(make-GotoStatement (make-Label label-name)))
(reverse (cons (make-GotoStatement (make-Label label-name))
acc))))
basic-blocks)
(cdr stmts)
@ -83,3 +94,8 @@
basic-blocks
(cdr stmts)
(GotoStatement? (car stmts)))]))]))))
(define end-time (current-inexact-milliseconds))
(printf " assemble fracture: ~a milliseconds\n" (- end-time start-time))
(values blocks entries))

1
js-assembler/package.rkt
View File

@ -253,7 +253,6 @@ MACHINE.modules[~s] =
(fprintf temporary-output-port "(MACHINE, function() { ")])
(define stop-time (current-inexact-milliseconds))
(printf " assembly: ~s milliseconds\n" (- stop-time start-time))
(displayln (bytes-length (get-output-bytes temporary-output-port)))
(write-bytes (get-output-bytes temporary-output-port) op)
(void))

2
make/make.rkt
View File

@ -66,7 +66,7 @@
(define start-time (current-inexact-milliseconds))
(define compiled-code (compile ast 'val next-linkage/drop-multiple))
(define stop-time (current-inexact-milliseconds))
(printf " compile ast: ~a milliseconds\n" (- stop-time start-time))
;(printf " compile ast: ~a milliseconds\n" (- stop-time start-time))
(values ast compiled-code))]))