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

unboxed known-flonum loop accumulators

Browse Source 
svn: r17338

original commit: bc47db42e4
This commit is contained in:
Matthew Flatt 2009-12-17 15:58:29 +00:00
parent 66b8a274d7
commit ab1cebd148
3 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/compiler/decompile.ss
View File

@ -292,7 +292,7 @@
(let ([vars (for/list ([i (in-range num-params)]
[type (in-list arg-types)])
(gensym (format "~a~a-"
(if (eq? type 'ref) "argbox" "arg")
(case type [(ref) "argbox"] [(flonum) "argfl"] [else "arg"])
i)))]
[rest-vars (if rest? (list (gensym 'rest)) null)]
[captures (map (lambda (v)
@ -351,6 +351,7 @@
(if (and (symbol? (car a))
(case (length a)
[(2) (memq (car a) '(unsafe-flabs
unsafe-flsqrt
unsafe-fx->fl))]
[(3) (memq (car a) '(unsafe-fl+ unsafe-fl- unsafe-fl* unsafe-fl/
unsafe-fl< unsafe-fl>

6
collects/compiler/zo-marshal.ss
View File

@ -664,14 +664,14 @@
(list->vector
(append
(vector->list closure-map)
(let ([v (make-vector (ceiling (/ num-params BITS_PER_MZSHORT)))])
(let ([v (make-vector (ceiling (/ (* 2 num-params) BITS_PER_MZSHORT)))])
(for ([t (in-list param-types)]
[i (in-naturals)])
(when (eq? t 'ref)
(let ([pos (quotient i BITS_PER_MZSHORT)])
(let ([pos (quotient (* 2 i) BITS_PER_MZSHORT)])
(vector-set! v pos
(bitwise-ior (vector-ref v pos)
(arithmetic-shift 1 (modulo i BITS_PER_MZSHORT)))))))
(arithmetic-shift 1 (modulo (* 2 i) BITS_PER_MZSHORT)))))))
(vector->list v))))
closure-map))
l)]

13
collects/compiler/zo-parse.ss
View File

@ -138,12 +138,13 @@
(if (zero? (bitwise-and flags CLOS_HAS_REF_ARGS))
(for/list ([i (in-range num-params)]) 'val)
(for/list ([i (in-range num-params)])
(if (bitwise-bit-set?
(vector-ref closed-over
(+ closure-size (quotient i BITS_PER_MZSHORT)))
(remainder i BITS_PER_MZSHORT))
'ref
'val))))])
(let ([byte (vector-ref closed-over
(+ closure-size (quotient (* 2 i) BITS_PER_MZSHORT)))])
(if (bitwise-bit-set? byte (remainder (* 2 i) BITS_PER_MZSHORT))
'ref
(if (bitwise-bit-set? byte (add1 (remainder (* 2 i) BITS_PER_MZSHORT)))
'flonum
'val))))))])
(make-lam name
(append
(if (zero? (bitwise-and flags flags CLOS_PRESERVES_MARKS)) null '(preserves-marks))