[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 24/41: Unbox u64 phi values
From: |
Andy Wingo |
Subject: |
[Guile-commits] 24/41: Unbox u64 phi values |
Date: |
Wed, 02 Dec 2015 08:06:53 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 2906d963ea5472c09fbec60f70e3aa6393fe3bae
Author: Andy Wingo <address@hidden>
Date: Fri Nov 20 10:41:31 2015 +0100
Unbox u64 phi values
* module/language/cps/specialize-numbers.scm
(compute-specializable-vars): Refactor to work on any kind of
unboxable value, not just f64 values.
(compute-specializable-f64-vars, compute-specializable-u64-vars): New
helpers.
(apply-specialization): Support for u64 values.
---
module/language/cps/specialize-numbers.scm | 137 +++++++++++++++++-----------
1 files changed, 83 insertions(+), 54 deletions(-)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index 7ab5186..61c2b74 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -151,88 +151,112 @@
(_ defs)))
labels empty-intmap))
-;; Placeholder until we add the real implementation.
-(define (compute-specializable-u64-vars cps body preds defs)
- empty-intset)
-
-;; Compute vars whose definitions are all inexact reals and whose uses
+;; Compute vars whose definitions are all unboxable and whose uses
;; include an unbox operation.
-(define (compute-specializable-f64-vars cps body preds defs)
+(define (compute-specializable-vars cps body preds defs
+ exp-result-unboxable?
+ unbox-op)
;; Compute a map of VAR->LABEL... indicating the set of labels that
- ;; define VAR with f64 values, given the set of vars F64-VARS which is
- ;; known already to be f64-valued.
- (define (collect-f64-def-labels f64-vars)
- (define (add-f64-def f64-defs var label)
- (intmap-add f64-defs var (intset label) intset-union))
- (intset-fold (lambda (label f64-defs)
+ ;; define VAR with unboxable values, given the set of vars
+ ;; UNBOXABLE-VARS which is known already to be unboxable.
+ (define (collect-unboxable-def-labels unboxable-vars)
+ (define (add-unboxable-def unboxable-defs var label)
+ (intmap-add unboxable-defs var (intset label) intset-union))
+ (intset-fold (lambda (label unboxable-defs)
(match (intmap-ref cps label)
(($ $kargs _ _ ($ $continue k _ exp))
(match exp
- ((or ($ $primcall 'f64->scm (_))
- ($ $const (and (? number?) (? inexact?) (?
real?))))
+ ((? exp-result-unboxable?)
(match (intmap-ref cps k)
(($ $kargs (_) (def))
- (add-f64-def f64-defs def label))))
+ (add-unboxable-def unboxable-defs def label))))
(($ $values vars)
(match (intmap-ref cps k)
(($ $kargs _ defs)
- (fold (lambda (var def f64-defs)
- (if (intset-ref f64-vars var)
- (add-f64-def f64-defs def label)
- f64-defs))
- f64-defs vars defs))
+ (fold
+ (lambda (var def unboxable-defs)
+ (if (intset-ref unboxable-vars var)
+ (add-unboxable-def unboxable-defs def label)
+ unboxable-defs))
+ unboxable-defs vars defs))
;; Could be $ktail for $values.
- (_ f64-defs)))
- (_ f64-defs)))
- (_ f64-defs)))
+ (_ unboxable-defs)))
+ (_ unboxable-defs)))
+ (_ unboxable-defs)))
body empty-intmap))
- ;; Compute the set of vars which are always f64-valued.
- (define (compute-f64-defs)
+ ;; Compute the set of vars which are always unboxable.
+ (define (compute-unboxable-defs)
(fixpoint
- (lambda (f64-vars)
+ (lambda (unboxable-vars)
(intmap-fold
- (lambda (def f64-pred-labels f64-vars)
- (if (and (not (intset-ref f64-vars def))
- ;; Are all defining expressions f64-valued?
+ (lambda (def unboxable-pred-labels unboxable-vars)
+ (if (and (not (intset-ref unboxable-vars def))
+ ;; Are all defining expressions unboxable?
(and-map (lambda (pred)
- (intset-ref f64-pred-labels pred))
+ (intset-ref unboxable-pred-labels pred))
(intmap-ref preds (intmap-ref defs def))))
- (intset-add f64-vars def)
- f64-vars))
- (collect-f64-def-labels f64-vars)
- f64-vars))
+ (intset-add unboxable-vars def)
+ unboxable-vars))
+ (collect-unboxable-def-labels unboxable-vars)
+ unboxable-vars))
empty-intset))
;; Compute the set of vars that may ever be unboxed.
- (define (compute-f64-uses f64-defs)
+ (define (compute-unbox-uses unboxable-defs)
(intset-fold
- (lambda (label f64-uses)
+ (lambda (label unbox-uses)
(match (intmap-ref cps label)
(($ $kargs _ _ ($ $continue k _ exp))
(match exp
- (($ $primcall 'scm->f64 (var))
- (intset-add f64-uses var))
+ (($ $primcall (? (lambda (op) (eq? op unbox-op))) (var))
+ (intset-add unbox-uses var))
(($ $values vars)
(match (intmap-ref cps k)
(($ $kargs _ defs)
- (fold (lambda (var def f64-uses)
- (if (intset-ref f64-defs def)
- (intset-add f64-uses var)
- f64-uses))
- f64-uses vars defs))
+ (fold (lambda (var def unbox-uses)
+ (if (intset-ref unboxable-defs def)
+ (intset-add unbox-uses var)
+ unbox-uses))
+ unbox-uses vars defs))
(($ $ktail)
- ;; Assume return is rare and that any f64-valued def can
+ ;; Assume return is rare and that any unboxable def can
;; be reboxed when leaving the procedure.
- (fold (lambda (var f64-uses)
- (intset-add f64-uses var))
- f64-uses vars))))
- (_ f64-uses)))
- (_ f64-uses)))
+ (fold (lambda (var unbox-uses)
+ (intset-add unbox-uses var))
+ unbox-uses vars))))
+ (_ unbox-uses)))
+ (_ unbox-uses)))
body empty-intset))
- (let ((f64-defs (compute-f64-defs)))
- (intset-intersect f64-defs (compute-f64-uses f64-defs))))
+ (let ((unboxable-defs (compute-unboxable-defs)))
+ (intset-intersect unboxable-defs (compute-unbox-uses unboxable-defs))))
+
+;; Compute vars whose definitions are all inexact reals and whose uses
+;; include an unbox operation.
+(define (compute-specializable-f64-vars cps body preds defs)
+ ;; Can the result of EXP definitely be unboxed as an f64?
+ (define (exp-result-f64? exp)
+ (match exp
+ ((or ($ $primcall 'f64->scm (_))
+ ($ $const (and (? number?) (? inexact?) (? real?))))
+ #t)
+ (_ #f)))
+ (compute-specializable-vars cps body preds defs exp-result-f64? 'scm->f64))
+
+;; Compute vars whose definitions are all exact integers in the u64
+;; range and whose uses include an unbox operation.
+(define (compute-specializable-u64-vars cps body preds defs)
+ ;; Can the result of EXP definitely be unboxed as a u64?
+ (define (exp-result-u64? exp)
+ (match exp
+ ((or ($ $primcall 'u64->scm (_))
+ ($ $const (and (? number?) (? exact-integer?)
+ (? (lambda (n) (<= 0 n #xffffffffffffffff))))))
+ #t)
+ (_ #f)))
+
+ (compute-specializable-vars cps body preds defs exp-result-u64? 'scm->u64))
(define (compute-phi-vars cps preds)
(intmap-fold (lambda (label preds phis)
@@ -278,6 +302,10 @@
(match (intmap-ref phis var)
('f64 'scm->f64)
('u64 'scm->u64)))
+ (define (box-op var)
+ (match (intmap-ref phis var)
+ ('f64 'f64->scm)
+ ('u64 'u64->scm)))
(define (unbox-operands)
(define (unbox-arg cps arg def-var have-arg)
(if (intmap-ref phis def-var (lambda (_) #f))
@@ -348,13 +376,14 @@
(intmap-ref boxed var (lambda (var) var)))
vars)))
(define (box-var cps name var done)
- (let ((f64 (intmap-ref boxed var (lambda (_) #f))))
- (if f64
+ (let ((unboxed (intmap-ref boxed var (lambda (_) #f))))
+ (if unboxed
(with-cps cps
(let$ term (done))
(letk kboxed ($kargs (name) (var) ,term))
(build-term
- ($continue kboxed #f ($primcall 'f64->scm (f64)))))
+ ($continue kboxed #f
+ ($primcall (box-op var) (unboxed)))))
(done cps))))
(define (box-vars cps names vars done)
(match vars
- [Guile-commits] 17/41: Remove frame->module, (continued)
- [Guile-commits] 17/41: Remove frame->module, Andy Wingo, 2015/12/02
- [Guile-commits] 19/41: Add bv-length instruction, Andy Wingo, 2015/12/02
- [Guile-commits] 18/41: Range inference over the full U64+S64 range, Andy Wingo, 2015/12/02
- [Guile-commits] 20/41: bv-f{32, 64}-{ref, set!} take unboxed u64 index, Andy Wingo, 2015/12/02
- [Guile-commits] 23/41: Beginning of u64 phi unboxing, Andy Wingo, 2015/12/02
- [Guile-commits] 16/41: Add low-level support for unboxed 64-bit unsigned ints, Andy Wingo, 2015/12/02
- [Guile-commits] 22/41: Specialize u64 comparisons, Andy Wingo, 2015/12/02
- [Guile-commits] 26/41: Slower range saturation in type inference, Andy Wingo, 2015/12/02
- [Guile-commits] 21/41: Add instructions to branch on u64 comparisons, Andy Wingo, 2015/12/02
- [Guile-commits] 25/41: Add unsigned 64-bit arithmetic operators: uadd, usub, umul, Andy Wingo, 2015/12/02
- [Guile-commits] 24/41: Unbox u64 phi values,
Andy Wingo <=
- [Guile-commits] 28/41: Specialize u64 arithmetic, Andy Wingo, 2015/12/02
- [Guile-commits] 37/41: Disable warnings on bootstrap build, Andy Wingo, 2015/12/02
- [Guile-commits] 35/41: Add current-thread VM op, Andy Wingo, 2015/12/02
- [Guile-commits] 27/41: Better range inference for indexes of vector-ref, string-ref et al, Andy Wingo, 2015/12/02
- [Guile-commits] 29/41: Remove add1 and sub1, Andy Wingo, 2015/12/02
- [Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immediate operands, Andy Wingo, 2015/12/02
- [Guile-commits] 32/41: Add support for unboxed s64 values, Andy Wingo, 2015/12/02
- [Guile-commits] 39/41: Specialize u64 bit operations, Andy Wingo, 2015/12/02
- [Guile-commits] 31/41: New instructions load-f64, load-u64, Andy Wingo, 2015/12/02
- [Guile-commits] 36/41: Add logsub op., Andy Wingo, 2015/12/02