[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 28/41: Specialize u64 arithmetic
From: |
Andy Wingo |
Subject: |
[Guile-commits] 28/41: Specialize u64 arithmetic |
Date: |
Wed, 02 Dec 2015 08:06:55 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit e003466039da31cec9f8d4d7ea9dcb3805a5d670
Author: Andy Wingo <address@hidden>
Date: Fri Nov 20 13:35:35 2015 +0100
Specialize u64 arithmetic
* module/language/cps/specialize-numbers.scm (specialize-operations):
(specialize-u64-binop): Specialize u64 addition, subtraction, and
multiplication.
---
module/language/cps/specialize-numbers.scm | 67 ++++++++++++++++++++--------
1 files changed, 48 insertions(+), 19 deletions(-)
diff --git a/module/language/cps/specialize-numbers.scm
b/module/language/cps/specialize-numbers.scm
index 61c2b74..8d6240f 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -81,8 +81,27 @@
($continue kunbox-b src
($primcall 'scm->f64 (a)))))))
+(define (specialize-u64-binop cps k src op a b)
+ (let ((uop (match op
+ ('add 'uadd)
+ ('sub 'usub)
+ ('mul 'umul))))
+ (with-cps cps
+ (letv u64-a u64-b result)
+ (letk kbox ($kargs ('result) (result)
+ ($continue k src
+ ($primcall 'u64->scm (result)))))
+ (letk kop ($kargs ('u64-b) (u64-b)
+ ($continue kbox src
+ ($primcall uop (u64-a u64-b)))))
+ (letk kunbox-b ($kargs ('u64-a) (u64-a)
+ ($continue kop src
+ ($primcall 'scm->u64 (b)))))
+ (build-term
+ ($continue kunbox-b src
+ ($primcall 'scm->u64 (a)))))))
+
(define (specialize-u64-comparison cps kf kt src op a b)
- (pk 'specialize cps kf kt src op a b)
(let ((op (symbol-append 'u64- op)))
(with-cps cps
(letv u64-a u64-b)
@@ -98,6 +117,13 @@
(define (specialize-operations cps)
(define (visit-cont label cont cps types)
+ (define (operand-in-range? var &type &min &max)
+ (call-with-values (lambda ()
+ (lookup-pre-type types label var))
+ (lambda (type min max)
+ (and (eqv? type &type) (<= &min min max &max)))))
+ (define (u64-operand? var)
+ (operand-in-range? var &exact-integer 0 #xffffffffffffffff))
(match cont
(($ $kfun)
(values cps (infer-types cps label)))
@@ -110,28 +136,31 @@
(lookup-post-type types label result 0))
(lambda (type min max)
(values
- (if (eqv? type &flonum)
- (with-cps cps
- (let$ body (specialize-f64-binop k src op a b))
- (setk label ($kargs names vars ,body)))
- cps)
+ (cond
+ ((eqv? type &flonum)
+ (with-cps cps
+ (let$ body (specialize-f64-binop k src op a b))
+ (setk label ($kargs names vars ,body))))
+ ((and (eqv? type &exact-integer)
+ (<= 0 min max #xffffffffffffffff)
+ (u64-operand? a) (u64-operand? b)
+ (not (eq? op 'div)))
+ (with-cps cps
+ (let$ body (specialize-u64-binop k src op a b))
+ (setk label ($kargs names vars ,body))))
+ (else
+ cps))
types))))))
(($ $kargs names vars
($ $continue k src
($ $branch kt ($ $primcall (and op (or '< '<= '= '>= '>)) (a
b)))))
- (call-with-values (lambda () (lookup-pre-type types label a))
- (lambda (a-type a-min a-max)
- (call-with-values (lambda () (lookup-pre-type types label b))
- (lambda (b-type b-min b-max)
- (values
- (if (and (eqv? a-type b-type &exact-integer)
- (<= 0 a-min a-max #xffffffffffffffff)
- (<= 0 b-min b-max #xffffffffffffffff))
- (with-cps cps
- (let$ body (specialize-u64-comparison k kt src op a b))
- (setk label ($kargs names vars ,body)))
- cps)
- types))))))
+ (values
+ (if (and (u64-operand? a) (u64-operand? b))
+ (with-cps cps
+ (let$ body (specialize-u64-comparison k kt src op a b))
+ (setk label ($kargs names vars ,body)))
+ cps)
+ types))
(_ (values cps types))))
(values (intmap-fold visit-cont cps cps #f)))
- [Guile-commits] 19/41: Add bv-length instruction, (continued)
- [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, 2015/12/02
- [Guile-commits] 28/41: Specialize u64 arithmetic,
Andy Wingo <=
- [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
- [Guile-commits] 40/41: More efficient assembler instructions, Andy Wingo, 2015/12/02