bug#31474: logxor+ash trigger compilation bug?

bug#31474: logxor+ash trigger compilation bug?

[Jan Nieuwenhuizen]

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@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@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@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#31474: logxor+ash trigger compilation bug?

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 947 bytes --]

Hi Jan,

Jan Nieuwenhuizen <janneke@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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Fix type inference for bitwise logical operators --]
[-- Type: text/x-patch, Size: 8832 bytes --]

From 25eee7be61f4e467a5ce83856fbf8a7770cf5dca Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@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@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

bug#31474: logxor+ash trigger compilation bug?

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 229 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Fix type inference for bitwise logical operators (v2) --]
[-- Type: text/x-patch, Size: 13480 bytes --]

From aefb4c3627596335a2ef2cf6f721f9e04b49ae7e Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@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@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

bug#31474: logxor+ash trigger compilation bug?

[Jan Nieuwenhuizen]

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@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#31474: logxor+ash trigger compilation bug?

[Mark H Weaver]

Jan Nieuwenhuizen <janneke@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