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)] (let ([vars (for/list ([i (in-range num-params)]
[type (in-list arg-types)]) [type (in-list arg-types)])
(gensym (format "~a~a-" (gensym (format "~a~a-"
(if (eq? type 'ref) "argbox" "arg") (case type [(ref) "argbox"] [(flonum) "argfl"] [else "arg"])
i)))] i)))]
[rest-vars (if rest? (list (gensym 'rest)) null)] [rest-vars (if rest? (list (gensym 'rest)) null)]
[captures (map (lambda (v) [captures (map (lambda (v)
@ -351,6 +351,7 @@
(if (and (symbol? (car a)) (if (and (symbol? (car a))
(case (length a) (case (length a)
[(2) (memq (car a) '(unsafe-flabs [(2) (memq (car a) '(unsafe-flabs
unsafe-flsqrt
unsafe-fx->fl))] unsafe-fx->fl))]
[(3) (memq (car a) '(unsafe-fl+ unsafe-fl- unsafe-fl* unsafe-fl/ [(3) (memq (car a) '(unsafe-fl+ unsafe-fl- 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 (list->vector
(append (append
(vector->list closure-map) (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)] (for ([t (in-list param-types)]
[i (in-naturals)]) [i (in-naturals)])
(when (eq? t 'ref) (when (eq? t 'ref)
(let ([pos (quotient i BITS_PER_MZSHORT)]) (let ([pos (quotient (* 2 i) BITS_PER_MZSHORT)])
(vector-set! v pos (vector-set! v pos
(bitwise-ior (vector-ref 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)))) (vector->list v))))
closure-map)) closure-map))
l)] l)]

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

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