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

bytecode-compiler changes to help enable flonum unboxing

Browse Source 
svn: r17283

original commit: 5772fa0a9f
This commit is contained in:
Matthew Flatt 2009-12-13 04:39:46 +00:00
parent 06aeb59448
commit b1aeeac4a9
1 changed files with 30 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/compiler/decompile.ss
View File

@ -246,11 +246,13 @@
[(struct application (rator rands))
(let ([stack (append (for/list ([i (in-list rands)]) (gensym 'rand))
stack)])
(annotate-inline
`(,(decompile-expr rator globs stack closed)
,@(map (lambda (rand)
(decompile-expr rand globs stack closed))
rands))))]
(annotate-unboxed
rands
(annotate-inline
`(,(decompile-expr rator globs stack closed)
,@(map (lambda (rand)
(decompile-expr rand globs stack closed))
rands)))))]
[(struct apply-values (proc args-expr))
`(#%apply-values ,(decompile-expr proc globs stack closed)
,(decompile-expr args-expr globs stack closed))]
@ -333,6 +335,29 @@
(cons '#%in a)
a))
(define (annotate-unboxed args a)
(define (unboxable? e s)
(cond
[(localref? e) #t]
[(toplevel? e) #t]
[(eq? '#%flonum (car s)) #t]
[(not (expr? e)) #t]
[else #f]))
(if (and (symbol? (car a))
(case (length a)
[(2) (memq (car a) '(unsafe-flabs
unsafe-fx->fl))]
[(3) (memq (car a) '(unsafe-fl+ unsafe-fl- unsafe-fl* unsafe-fl/
unsafe-fl< unsafe-fl>
unsafe-fl=
unsafe-fl<= unsafe-fl>=))]
[(4) (memq (car a) '(unsafe-flvector-set!))]
[else #f])
(andmap unboxable? args (cdr a)))
(cons '#%flonum a)
a))
;; ----------------------------------------
#;