GNU bug report logs - #31474
logxor+ash trigger compilation bug?

Previous Next

Package: guile;

Reported by: Jan Nieuwenhuizen <janneke <at> gnu.org>

Date: Wed, 16 May 2018 18:17:01 UTC

Severity: normal

Done: Mark H Weaver <mhw <at> netris.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 31474 in the body.
You can then email your comments to 31474 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-guile <at> gnu.org:
bug#31474; Package guile. (Wed, 16 May 2018 18:17:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Jan Nieuwenhuizen <janneke <at> gnu.org>:
New bug report received and forwarded. Copy sent to bug-guile <at> gnu.org. (Wed, 16 May 2018 18:17:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Jan Nieuwenhuizen <janneke <at> gnu.org>
To: bug-guile <at> gnu.org
Subject: logxor+ash trigger compilation bug?
Date: Wed, 16 May 2018 20:16:31 +0200
Hi!

Trying to implement bit-fields for MesCC, I stumble upon this.  I was
looking for a bitwise left shift that introduces 1's instead of zeros.

This code

--8<---------------cut here---------------start------------->8---
;; 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)
--8<---------------cut here---------------end--------------->8---

behaves as I expect when compilation is turned off (compile or
auto-compile behave alike for me)

--8<---------------cut here---------------start------------->8---
19:50:43 janneke <at> dundal:~/src/mes 
$ guile --no-auto-compile foo.scm

;;; (set-mask 24)

;;; (clear-mask -25)

;;; (expected -25)
-25
--8<---------------cut here---------------end--------------->8---

but when (auto)compiled, look:

--8<---------------cut here---------------start------------->8---
19:50:47 janneke <at> dundal:~/src/mes 
$ guile foo.scm
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /home/janneke/src/mes/foo.scm
;;; compiled /home/janneke/.cache/guile/ccache/2.2-LE-8-3.A/home/janneke/src/mes/foo.scm.go

;;; (set-mask 24)

;;; (clear-mask -1)

;;; (expected -25)
-1
--8<---------------cut here---------------end--------------->8---

I'm using guile-2.2.3 from Guix master.

Is this a bug, can you suggest a workaround?

Greetings,
janneke

-- 
Jan Nieuwenhuizen <janneke <at> gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | AvatarĀ® http://AvatarAcademy.com




Information forwarded to bug-guile <at> gnu.org:
bug#31474; Package guile. (Mon, 28 May 2018 02:15:02 GMT) Full text and rfc822 format available.

Message #8 received at 31474 <at> debbugs.gnu.org (full text, mbox):

From: Mark H Weaver <mhw <at> netris.org>
To: Jan Nieuwenhuizen <janneke <at> gnu.org>
Cc: 31474 <at> debbugs.gnu.org
Subject: Re: bug#31474: logxor+ash trigger compilation bug?
Date: Sun, 27 May 2018 22:13:00 -0400
[Message part 1 (text/plain, inline)]
Hi Jan,

Jan Nieuwenhuizen <janneke <at> gnu.org> 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


[0001-Fix-type-inference-for-bitwise-logical-operators.patch (text/x-patch, inline)]
From 25eee7be61f4e467a5ce83856fbf8a7770cf5dca Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw <at> netris.org>
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 <janneke <at> gnu.org>.

* 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


Information forwarded to bug-guile <at> gnu.org:
bug#31474; Package guile. (Mon, 28 May 2018 12:05:02 GMT) Full text and rfc822 format available.

Message #11 received at 31474 <at> debbugs.gnu.org (full text, mbox):

From: Mark H Weaver <mhw <at> netris.org>
To: Jan Nieuwenhuizen <janneke <at> gnu.org>
Cc: Andy Wingo <wingo <at> pobox.com>, 31474 <at> debbugs.gnu.org
Subject: Re: bug#31474: logxor+ash trigger compilation bug?
Date: Mon, 28 May 2018 08:03:01 -0400
[Message part 1 (text/plain, inline)]
Here's an improved version of my patch.  It's functionally equivalent
but with more comprehensible code and more comments.  I think this is
ready to push to the stable-2.2 branch.  Comments and suggestions
welcome.

       Mark

[0001-Fix-type-inference-for-bitwise-logical-operators.patch (text/x-patch, inline)]
From aefb4c3627596335a2ef2cf6f721f9e04b49ae7e Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw <at> netris.org>
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 <janneke <at> gnu.org>.

* module/language/cps/types.scm (next-power-of-two): Remove procedure.
(non-negative?, lognot*, saturate+, saturate-, logand-bounds)
(logsub-bounds, logior-bounds, logxor-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 | 230 +++++++++++++++++++++++++---------
 1 file changed, 169 insertions(+), 61 deletions(-)

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index c24f9b99d..4326a8d37 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,79 @@ 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)
+  "Return true if N is non-negative, otherwise return false."
+  (not (negative? n)))
+
+;; Like 'lognot', but handles infinities.
+(define-inlinable (lognot* n)
+  "Return the bitwise complement of N.  If N is infinite, return -N."
+  (- -1 n))
+
+(define saturate+
+  (case-lambda
+    "Let N be the least upper bound of the integer lengths of the
+arguments.  Return the greatest integer whose integer length is N.
+If any of the arguments are infinite, return positive infinity."
+    ((a b)
+     (if (or (inf? a) (inf? b))
+         +inf.0
+         (1- (ash 1 (max (integer-length a)
+                         (integer-length b))))))
+    ((a b c)
+     (saturate+ (saturate+ a b) c))
+    ((a b c d)
+     (saturate+ (saturate+ a b) c d))))
+
+(define saturate-
+  (case-lambda
+    "Let N be the least upper bound of the integer lengths of the
+arguments.  Return the least integer whose integer length is N.
+If any of the arguments are infinite, return negative infinity."
+    ((a b)     (lognot* (saturate+ a b)))
+    ((a b c)   (lognot* (saturate+ a b c)))
+    ((a b c d) (lognot* (saturate+ a b c d)))))
+
+(define (logand-bounds a0 a1 b0 b1)
+  "Return two values: lower and upper bounds for (logand A B)
+where (A0 <= A <= A1) and (B0 <= B <= B1)."
+  ;; For each argument, we consider three cases: (1) the argument is
+  ;; non-negative, (2) its sign is unknown, or (3) it is negative.
+  ;; To handle both arguments, we must consider a total of 9 cases:
+  ;;
+  ;; -----------------------------------------------------------------------
+  ;;    LOGAND      | non-negative B   | unknown-sign B | negative B
+  ;; -----------------------------------------------------------------------
+  ;; non-negative A | 0 .. (min A1 B1) | 0 .. A1        | 0 .. A1
+  ;; -----------------------------------------------------------------------
+  ;; unknown-sign A | 0 .. B1          | (sat- A0 B0)   | (sat- A0 B0)
+  ;;                |                  |      ..        |    .. A1
+  ;;                |                  | (sat+ A1 B1)   |
+  ;; -----------------------------------------------------------------------
+  ;;     negative A | 0 .. B1          | (sat- A0 B0)   | (sat- A0 B0)
+  ;;                |                  |    .. B1       |    .. (min A1 B1)
+  ;; -----------------------------------------------------------------------
+  (values (if (or (non-negative? a0) (non-negative? b0))
+              0
+              (saturate- a0 b0))
+          (cond ((or (and (non-negative? a0) (non-negative? b0))
+                     (and (negative? a1) (negative? b1)))
+                 (min a1 b1))
+                ((or (non-negative? a0) (negative? b1))
+                 a1)
+                ((or (non-negative? b0) (negative? a1))
+                 b1)
+                (else
+                 (saturate+ 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)
@@ -1306,24 +1353,17 @@ minimum, and maximum."
   (restrict! b &u64 0 &u64-max)
   (define! result &u64 0 (min (&max/u64 a) (&max/u64 b))))
 
+(define (logsub-bounds a0 a1 b0 b1)
+  "Return two values: lower and upper bounds for (logsub A B),
+i.e. (logand A (lognot B)), where (A0 <= A <= A1) and (B0 <= B <= B1)."
+  ;; Here we use 'logand-bounds' to compute the bounds, after
+  ;; computing the bounds of (lognot B) from the bounds of B.
+  ;; From (B0 <= B <= B1) it follows that (~B1 <= ~B <= ~B0),
+  ;; where ~X means (lognot X).
+  (logand-bounds a0 a1 (lognot* b1) (lognot* b0)))
+
 (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))))
   (restrict! a &exact-integer -inf.0 +inf.0)
   (restrict! b &exact-integer -inf.0 +inf.0)
   (call-with-values (lambda ()
@@ -1337,26 +1377,47 @@ minimum, and maximum."
   (restrict! b &u64 0 &u64-max)
   (define! result &u64 0 (&max/u64 a)))
 
+(define (logior-bounds a0 a1 b0 b1)
+  "Return two values: lower and upper bounds for (logior A B)
+where (A0 <= A <= A1) and (B0 <= B <= B1)."
+  ;; For each argument, we consider three cases: (1) the argument is
+  ;; non-negative, (2) its sign is unknown, or (3) it is negative.
+  ;; To handle both arguments, we must consider a total of 9 cases.
+  ;;
+  ;; ---------------------------------------------------------------------
+  ;;    LOGIOR      | non-negative B | unknown-sign B | negative B
+  ;; ---------------------------------------------------------------------
+  ;; non-negative A | (max A0 B0)    | B0             | B0 .. -1
+  ;;                |   ..           |   ..           |
+  ;;                | (sat+ A1 B1)   | (sat+ A1 B1)   |
+  ;; ---------------------------------------------------------------------
+  ;; unknown-sign A | A0             | (sat- A0 B0)   | B0 .. -1
+  ;;                |   ..           |        ..      |
+  ;;                | (sat+ A1 B1)   | (sat+ A1 B1)   |
+  ;; ---------------------------------------------------------------------
+  ;;     negative A | A0 .. -1       | A0 .. -1       | (max A0 B0) .. -1
+  ;; ---------------------------------------------------------------------
+  (values (cond ((or (and (non-negative? a0) (non-negative? b0))
+                     (and (negative? a1) (negative? b1)))
+                 (max a0 b0))
+                ((or (non-negative? a0) (negative? b1))
+                 b0)
+                ((or (non-negative? b0) (negative? a1))
+                 a0)
+                (else
+                 (saturate- a0 b0)))
+          (if (or (negative? a1) (negative? b1))
+              -1
+              (saturate+ a1 b1))))
+
 (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)))))
   (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 +1425,70 @@ 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/u64 a) (&max/u64 b))))
+
+(define (logxor-bounds a0 a1 b0 b1)
+  "Return two values: lower and upper bounds for (logxor A B)
+where (A0 <= A <= A1) and (B0 <= B <= B1)."
+  ;; For each argument, we consider three cases: (1) the argument is
+  ;; non-negative, (2) its sign is unknown, or (3) it is negative.
+  ;; To handle both arguments, we must consider a total of 9 cases.
+  ;;
+  ;; --------------------------------------------------------------------
+  ;;    LOGXOR      | non-negative B | unknown-sign B     | negative B
+  ;; --------------------------------------------------------------------
+  ;; non-negative A | 0              |       (sat- A1 B0) | (sat- A1 B0)
+  ;;                |   ..           |         ..         |   ..
+  ;;                | (sat+ A1 B1)   | (sat+ A1 B1)       |     -1
+  ;; --------------------------------------------------------------------
+  ;; unknown-sign A | (sat- A0 B1)   | (sat- A0 B1 A1 B0) | (sat- A1 B0)
+  ;;                |   ..           |   ..               |   ..
+  ;;                | (sat+ A1 B1)   | (sat+ A1 B1 A0 B0) | (sat+ A0 B0)
+  ;; --------------------------------------------------------------------
+  ;;     negative A | (sat- A0 B1)   | (sat- A0 B1)       | 0
+  ;;                |   ..           |    ..              |   ..
+  ;;                |     -1         |       (sat+ A0 B0) | (sat+ A0 B0)
+  ;; --------------------------------------------------------------------
+  (values (cond ((or (and (non-negative? a0) (non-negative? b0))
+                     (and (negative? a1) (negative? b1)))
+                 0)
+                ((or (non-negative? a0) (negative? b1))
+                 (saturate- a1 b0))
+                ((or (non-negative? b0) (negative? a1))
+                 (saturate- a0 b1))
+                (else
+                 (saturate- a0 b1 a1 b0)))
+          (cond ((or (and (non-negative? a0) (negative? b1))
+                     (and (non-negative? b0) (negative? a1)))
+                 -1)
+                ((or (non-negative? a0) (non-negative? b0))
+                 (saturate+ a1 b1))
+                ((or (negative? a1) (negative? b1))
+                 (saturate+ a0 b0))
+                (else
+                 (saturate+ a1 b1 a0 b0)))))
+
+(define-simple-type-checker (logxor &exact-integer &exact-integer))
+(define-type-inferrer (logxor a b result)
+  (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/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


Information forwarded to bug-guile <at> gnu.org:
bug#31474; Package guile. (Mon, 28 May 2018 21:18:02 GMT) Full text and rfc822 format available.

Message #14 received at 31474 <at> debbugs.gnu.org (full text, mbox):

From: Jan Nieuwenhuizen <janneke <at> gnu.org>
To: Mark H Weaver <mhw <at> netris.org>
Cc: Andy Wingo <wingo <at> pobox.com>, 31474 <at> debbugs.gnu.org
Subject: Re: bug#31474: logxor+ash trigger compilation bug?
Date: Mon, 28 May 2018 23:17:04 +0200
Mark H Weaver writes:

> Here's an improved version of my patch.  It's functionally equivalent
> but with more comprehensible code and more comments.  I think this is
> ready to push to the stable-2.2 branch.  Comments and suggestions
> welcome.

I tried it and it works for me.  Thanks a lot!

Also, thanks for the workarounds you suggested, they indeed work without
this patch.

Greetings,
janneke

-- 
Jan Nieuwenhuizen <janneke <at> gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | AvatarĀ® http://AvatarAcademy.com




Reply sent to Mark H Weaver <mhw <at> netris.org>:
You have taken responsibility. (Mon, 11 Jun 2018 14:30:02 GMT) Full text and rfc822 format available.

Notification sent to Jan Nieuwenhuizen <janneke <at> gnu.org>:
bug acknowledged by developer. (Mon, 11 Jun 2018 14:30:02 GMT) Full text and rfc822 format available.

Message #19 received at 31474-done <at> debbugs.gnu.org (full text, mbox):

From: Mark H Weaver <mhw <at> netris.org>
To: Jan Nieuwenhuizen <janneke <at> gnu.org>
Cc: Andy Wingo <wingo <at> pobox.com>, 31474-done <at> debbugs.gnu.org
Subject: Re: bug#31474: logxor+ash trigger compilation bug?
Date: Mon, 11 Jun 2018 10:28:28 -0400
Jan Nieuwenhuizen <janneke <at> gnu.org> writes:

> Mark H Weaver writes:
>
>> Here's an improved version of my patch.  It's functionally equivalent
>> but with more comprehensible code and more comments.  I think this is
>> ready to push to the stable-2.2 branch.  Comments and suggestions
>> welcome.
>
> I tried it and it works for me.  Thanks a lot!
>
> Also, thanks for the workarounds you suggested, they indeed work without
> this patch.

I pushed the patch as commit 2733e97395db30c6233f79f341959e722b4bd4ff to
the stable-2.2 branch.  I'm closing this bug now, but feel free to
reopen if needed.

     Thanks,
       Mark




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Tue, 10 Jul 2018 11:24:07 GMT) Full text and rfc822 format available.

This bug report was last modified 5 years and 263 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.