From debbugs-submit-bounces@debbugs.gnu.org Wed May 16 14:16:52 2018 Received: (at submit) by debbugs.gnu.org; 16 May 2018 18:16:52 +0000 Received: from localhost ([127.0.0.1]:37600 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fJ0yp-0003ik-Pi for submit@debbugs.gnu.org; Wed, 16 May 2018 14:16:52 -0400 Received: from eggs.gnu.org ([208.118.235.92]:55535) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fJ0yo-0003iW-Ae for submit@debbugs.gnu.org; Wed, 16 May 2018 14:16:50 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fJ0yi-00082h-5v for submit@debbugs.gnu.org; Wed, 16 May 2018 14:16:45 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:35771) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1fJ0yi-00082d-24 for submit@debbugs.gnu.org; Wed, 16 May 2018 14:16:44 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:46506) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fJ0yg-0004Zm-SX for bug-guile@gnu.org; Wed, 16 May 2018 14:16:43 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fJ0yf-00081y-MN for bug-guile@gnu.org; Wed, 16 May 2018 14:16:42 -0400 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:59789) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fJ0yX-0007zI-Lb; Wed, 16 May 2018 14:16:33 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=53332 helo=dundal.peder.onsbrabantnet.nl) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fJ0yX-0003As-7l; Wed, 16 May 2018 14:16:33 -0400 From: Jan Nieuwenhuizen To: bug-guile@gnu.org Subject: logxor+ash trigger compilation bug? Date: Wed, 16 May 2018 20:16:31 +0200 Message-ID: <87y3gj8o00.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) 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=20 $ 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=20 $ guile foo.scm ;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=3D0 ;;; 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/sr= c/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 --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com From debbugs-submit-bounces@debbugs.gnu.org Sun May 27 22:14:20 2018 Received: (at 31474) by debbugs.gnu.org; 28 May 2018 02:14:20 +0000 Received: from localhost ([127.0.0.1]:51400 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fN7fw-00066U-7m for submit@debbugs.gnu.org; Sun, 27 May 2018 22:14:20 -0400 Received: from world.peace.net ([64.112.178.59]:37798) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fN7fu-00066H-LV for 31474@debbugs.gnu.org; Sun, 27 May 2018 22:14:19 -0400 Received: from mhw by world.peace.net with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1fN7fo-0001Go-7k; Sun, 27 May 2018 22:14:12 -0400 From: Mark H Weaver To: Jan Nieuwenhuizen Subject: Re: bug#31474: logxor+ash trigger compilation bug? References: <87y3gj8o00.fsf@gnu.org> Date: Sun, 27 May 2018 22:13:00 -0400 In-Reply-To: <87y3gj8o00.fsf@gnu.org> (Jan Nieuwenhuizen's message of "Wed, 16 May 2018 20:16:31 +0200") Message-ID: <87wovoy1cj.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 31474 Cc: 31474@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Hi Jan, Jan Nieuwenhuizen 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Fix-type-inference-for-bitwise-logical-operators.patch Content-Description: [PATCH] Fix type inference for bitwise logical operators >From 25eee7be61f4e467a5ce83856fbf8a7770cf5dca Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 27 May 2018 21:58:48 -0400 Subject: [PATCH] Fix type inference for bitwise logical operators. Fixes and related bugs. Reported by Jan Nieuwenhuizen . * 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 08:04:22 2018 Received: (at 31474) by debbugs.gnu.org; 28 May 2018 12:04:22 +0000 Received: from localhost ([127.0.0.1]:51735 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNGsw-0005S9-7J for submit@debbugs.gnu.org; Mon, 28 May 2018 08:04:22 -0400 Received: from world.peace.net ([64.112.178.59]:38382) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNGsu-0005Rr-N8 for 31474@debbugs.gnu.org; Mon, 28 May 2018 08:04:21 -0400 Received: from mhw by world.peace.net with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1fNGsn-0003Ke-Vl; Mon, 28 May 2018 08:04:14 -0400 From: Mark H Weaver To: Jan Nieuwenhuizen Subject: Re: bug#31474: logxor+ash trigger compilation bug? References: <87y3gj8o00.fsf@gnu.org> <87wovoy1cj.fsf@netris.org> Date: Mon, 28 May 2018 08:03:01 -0400 In-Reply-To: <87wovoy1cj.fsf@netris.org> (Mark H. Weaver's message of "Sun, 27 May 2018 22:13:00 -0400") Message-ID: <87h8msxa16.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 31474 Cc: Andy Wingo , 31474@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Fix-type-inference-for-bitwise-logical-operators.patch Content-Description: [PATCH] Fix type inference for bitwise logical operators (v2) >From aefb4c3627596335a2ef2cf6f721f9e04b49ae7e Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 27 May 2018 21:58:48 -0400 Subject: [PATCH] Fix type inference for bitwise logical operators. Fixes and related bugs. Reported by Jan Nieuwenhuizen . * 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon May 28 17:17:20 2018 Received: (at 31474) by debbugs.gnu.org; 28 May 2018 21:17:20 +0000 Received: from localhost ([127.0.0.1]:52798 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNPW4-0001rx-GV for submit@debbugs.gnu.org; Mon, 28 May 2018 17:17:20 -0400 Received: from eggs.gnu.org ([208.118.235.92]:50879) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fNPW2-0001rh-Sg for 31474@debbugs.gnu.org; Mon, 28 May 2018 17:17:19 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fNPVw-00087g-Mm for 31474@debbugs.gnu.org; Mon, 28 May 2018 17:17:13 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=disabled version=3.3.2 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:46604) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fNPVr-000842-Py; Mon, 28 May 2018 17:17:07 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=43972 helo=dundal.peder.onsbrabantnet.nl) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1fNPVr-0004EN-9P; Mon, 28 May 2018 17:17:07 -0400 From: Jan Nieuwenhuizen To: Mark H Weaver Subject: Re: bug#31474: logxor+ash trigger compilation bug? Organization: AvatarAcademy.nl References: <87y3gj8o00.fsf@gnu.org> <87wovoy1cj.fsf@netris.org> <87h8msxa16.fsf@netris.org> X-Url: http://AvatarAcademy.nl Date: Mon, 28 May 2018 23:17:04 +0200 In-Reply-To: <87h8msxa16.fsf@netris.org> (Mark H. Weaver's message of "Mon, 28 May 2018 08:03:01 -0400") Message-ID: <87bmczbhv3.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2001:4830:134:3::e X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: 31474 Cc: Andy Wingo , 31474@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -6.0 (------) 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 --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 11 10:29:53 2018 Received: (at 31474-done) by debbugs.gnu.org; 11 Jun 2018 14:29:53 +0000 Received: from localhost ([127.0.0.1]:43528 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fSNpQ-0000Mz-U1 for submit@debbugs.gnu.org; Mon, 11 Jun 2018 10:29:53 -0400 Received: from world.peace.net ([64.112.178.59]:42542) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fSNpP-0000Ml-5v for 31474-done@debbugs.gnu.org; Mon, 11 Jun 2018 10:29:51 -0400 Received: from mhw by world.peace.net with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1fSNpJ-0004EL-K8; Mon, 11 Jun 2018 10:29:45 -0400 From: Mark H Weaver To: Jan Nieuwenhuizen Subject: Re: bug#31474: logxor+ash trigger compilation bug? References: <87y3gj8o00.fsf@gnu.org> <87wovoy1cj.fsf@netris.org> <87h8msxa16.fsf@netris.org> <87bmczbhv3.fsf@gnu.org> Date: Mon, 11 Jun 2018 10:28:28 -0400 In-Reply-To: <87bmczbhv3.fsf@gnu.org> (Jan Nieuwenhuizen's message of "Mon, 28 May 2018 23:17:04 +0200") Message-ID: <87po0x75yr.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 31474-done Cc: Andy Wingo , 31474-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Jan Nieuwenhuizen 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 From unknown Thu Sep 11 16:22:20 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Tue, 10 Jul 2018 11:24:07 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator