[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#31474: logxor+ash trigger compilation bug?
From: |
Mark H Weaver |
Subject: |
bug#31474: logxor+ash trigger compilation bug? |
Date: |
Sun, 27 May 2018 22:13:00 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) |
Hi Jan,
Jan Nieuwenhuizen <address@hidden> writes:
> ;; foo.scm
> (let* ((set-mask (pk 'set-mask (ash 3 3)))
> (clear-mask (pk 'clear-mask (logxor set-mask -1))))
> (pk 'expected (logxor 24 -1))
> (display clear-mask)
> (newline)
> clear-mask)
>
>
> behaves as I expect when compilation is turned off
[...]
> but when (auto)compiled, look:
[...]
> ;;; (set-mask 24)
>
> ;;; (clear-mask -1)
>
> ;;; (expected -25)
> -1
Indeed, thanks for the report. Guile 2.2's type inference pass
contained several bugs in the range analysis of bitwise logical
operators. I've attached below a preliminary (not fully tested) patch
that hopefully fixes these problems, and also makes some improvements.
> Is this a bug, can you suggest a workaround?
The specific workaround here would be to use (lognot x) instead of
(logxor x -1), which is a bit nicer anyway. They are equivalent.
Another equivalent formulation is (- -1 x).
Mark
>From 25eee7be61f4e467a5ce83856fbf8a7770cf5dca Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Sun, 27 May 2018 21:58:48 -0400
Subject: [PATCH] Fix type inference for bitwise logical operators.
Fixes <https://bugs.gnu.org/31474> and related bugs.
Reported by Jan Nieuwenhuizen <address@hidden>.
* module/language/cps/types.scm (next-power-of-two): Remove procedure.
(non-negative?, saturate+, saturate-, lognot*, logand-bounds): New
procedures. Use them to improve and fix bugs in the range analysis of
the type inferrers for 'logand', 'logsub', 'logior', 'ulogior',
'logxor', 'ulogxor', and 'lognot'.
---
module/language/cps/types.scm | 158 +++++++++++++++++++++-------------
1 file changed, 97 insertions(+), 61 deletions(-)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index c24f9b99d..80073966d 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1,5 +1,5 @@
;;; Type analysis on CPS
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
@@ -1273,32 +1273,49 @@ minimum, and maximum."
(define! result &u64 0 &u64-max)))
(define-type-aliases ulsh ulsh/immediate)
-(define (next-power-of-two n)
- (let lp ((out 1))
- (if (< n out)
- out
- (lp (ash out 1)))))
+(define-inlinable (non-negative? n)
+ (not (negative? n)))
+
+(define (saturate+ n)
+ (if (inf? n)
+ +inf.0
+ (1- (ash 1 (integer-length n)))))
+
+(define (saturate- n)
+ (if (inf? n)
+ -inf.0
+ (ash -1 (integer-length n))))
+
+(define (lognot* n)
+ (- -1 n))
+
+(define (logand-bounds a0 a1 b0 b1)
+ ;; (a0 <= a <= a1) and (b0 <= b <= b1)
+ (cond ((and (non-negative? a0) (non-negative? b0))
+ (values 0 (min a1 b1)))
+ ((non-negative? a0)
+ (values 0 a1))
+ ((non-negative? b0)
+ (values 0 b1))
+ (else
+ (values (saturate- (min a0 b0))
+ (cond ((and (negative? a1) (negative? b1))
+ (min a1 b1))
+ ((negative? a1)
+ b1)
+ ((negative? b1)
+ a1)
+ (else
+ (saturate+ (max a1 b1))))))))
(define-simple-type-checker (logand &exact-integer &exact-integer))
(define-type-inferrer (logand a b result)
- (define (logand-min a b)
- (if (and (negative? a) (negative? b))
- (let ((min (min a b)))
- (if (inf? min)
- -inf.0
- (- 1 (next-power-of-two (- min)))))
- 0))
- (define (logand-max a b)
- (cond
- ((or (and (positive? a) (positive? b))
- (and (negative? a) (negative? b)))
- (min a b))
- (else (max a b))))
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
- (define! result &exact-integer
- (logand-min (&min a) (&min b))
- (logand-max (&max a) (&max b))))
+ (call-with-values (lambda ()
+ (logand-bounds (&min a) (&max a) (&min b) (&max b)))
+ (lambda (min max)
+ (define! result &exact-integer min max))))
(define-simple-type-checker (ulogand &u64 &u64))
(define-type-inferrer (ulogand a b result)
@@ -1308,22 +1325,8 @@ minimum, and maximum."
(define-simple-type-checker (logsub &exact-integer &exact-integer))
(define-type-inferrer (logsub a b result)
- (define (logsub-bounds min-a max-a min-b max-b)
- (cond
- ((negative? max-b)
- ;; Sign bit always set on B, so result will never be negative.
- ;; If A might be negative (all leftmost bits 1), we don't know
- ;; how positive the result might be.
- (values 0 (if (negative? min-a) +inf.0 max-a)))
- ((negative? min-b)
- ;; Sign bit might be set on B.
- (values min-a (if (negative? min-a) +inf.0 max-a)))
- ((negative? min-a)
- ;; Sign bit never set on B -- result will have the sign of A.
- (values -inf.0 max-a))
- (else
- ;; Sign bit never set on A and never set on B -- the nice case.
- (values 0 max-a))))
+ (define (logsub-bounds a0 a1 b0 b1)
+ (logand-bounds a0 a1 (lognot* b1) (lognot* b0)))
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
(call-with-values (lambda ()
@@ -1339,24 +1342,30 @@ minimum, and maximum."
(define-simple-type-checker (logior &exact-integer &exact-integer))
(define-type-inferrer (logior a b result)
- ;; Saturate all bits of val.
- (define (saturate val)
- (1- (next-power-of-two val)))
- (define (logior-min a b)
- (cond ((and (< a 0) (<= 0 b)) a)
- ((and (< b 0) (<= 0 a)) b)
- (else (max a b))))
- (define (logior-max a b)
- ;; If either operand is negative, just assume the max is -1.
- (cond
- ((or (< a 0) (< b 0)) -1)
- ((or (inf? a) (inf? b)) +inf.0)
- (else (saturate (logior a b)))))
+ (define (logior-bounds a0 a1 b0 b1)
+ ;; (a0 <= a <= a1) and (b0 <= b <= b1)
+ (cond ((and (negative? a1) (negative? b1))
+ (values (max a0 b0) -1))
+ ((negative? a1)
+ (values a0 -1))
+ ((negative? b1)
+ (values b0 -1))
+ (else
+ (values (cond ((and (non-negative? a0) (non-negative? b0))
+ (max a0 b0))
+ ((non-negative? a0)
+ b0)
+ ((non-negative? b0)
+ a0)
+ (else
+ (saturate- (min a0 b0))))
+ (saturate+ (max a1 b1))))))
(restrict! a &exact-integer -inf.0 +inf.0)
(restrict! b &exact-integer -inf.0 +inf.0)
- (define! result &exact-integer
- (logior-min (&min a) (&min b))
- (logior-max (&max a) (&max b))))
+ (call-with-values (lambda ()
+ (logior-bounds (&min a) (&max a) (&min b) (&max b)))
+ (lambda (min max)
+ (define! result &exact-integer min max))))
(define-simple-type-checker (ulogior &u64 &u64))
(define-type-inferrer (ulogior a b result)
@@ -1364,23 +1373,50 @@ minimum, and maximum."
(restrict! b &u64 0 &u64-max)
(define! result &u64
(max (&min/0 a) (&min/0 b))
- (1- (next-power-of-two (logior (&max/u64 a) (&max/u64 b))))))
-
-;; For our purposes, treat logxor the same as logior.
-(define-type-aliases logior logxor)
+ (saturate+ (max (&max/u64 a) (&max/u64 b)))))
+
+(define-simple-type-checker (logxor &exact-integer &exact-integer))
+(define-type-inferrer (logxor a b result)
+ (define (logxor-bounds a0 a1 b0 b1)
+ ;; (a0 <= a <= a1) and (b0 <= b <= b1)
+ (cond ((and (non-negative? a0) (non-negative? b0))
+ (values 0 (saturate+ (max a1 b1))))
+ ((and (negative? a1) (negative? b1))
+ (values 0 (saturate+ (min a0 b0))))
+ ((and (non-negative? a0) (negative? b1))
+ (values (saturate- (max a1 (lognot* b0))) -1))
+ ((and (negative? a1) (non-negative? b0))
+ (values (saturate- (max b1 (lognot* a0))) -1))
+ ((and (negative? a0) (non-negative? a1)
+ (negative? b0) (non-negative? b1))
+ (values (saturate- (max a1 b1 (lognot* a0) (lognot* b0)))
+ (saturate+ (max a1 b1 (lognot* a0) (lognot* b0)))))
+ (else
+ (values (if (and (non-negative? a1) (negative? b0))
+ (saturate- (max a1 (lognot* b0)))
+ (saturate- (max b1 (lognot* a0))))
+ (if (and (non-negative? a1) (non-negative? b1))
+ (saturate+ (max a1 b1))
+ (saturate+ (min a0 b0)))))))
+ (restrict! a &exact-integer -inf.0 +inf.0)
+ (restrict! b &exact-integer -inf.0 +inf.0)
+ (call-with-values (lambda ()
+ (logxor-bounds (&min a) (&max a) (&min b) (&max b)))
+ (lambda (min max)
+ (define! result &exact-integer min max))))
(define-simple-type-checker (ulogxor &u64 &u64))
(define-type-inferrer (ulogxor a b result)
(restrict! a &u64 0 &u64-max)
(restrict! b &u64 0 &u64-max)
- (define! result &u64 0 &u64-max))
+ (define! result &u64 0 (saturate+ (max (&max/u64 a) (&max/u64 b)))))
(define-simple-type-checker (lognot &exact-integer))
(define-type-inferrer (lognot a result)
(restrict! a &exact-integer -inf.0 +inf.0)
(define! result &exact-integer
- (- -1 (&max a))
- (- -1 (&min a))))
+ (lognot* (&max a))
+ (lognot* (&min a))))
(define-simple-type-checker (logtest &exact-integer &exact-integer))
(define-predicate-inferrer (logtest a b true?)
--
2.17.0