From unknown Thu Sep 11 16:22:17 2025 X-Loop: help-debbugs@gnu.org Subject: bug#31474: logxor+ash trigger compilation bug? Resent-From: Jan Nieuwenhuizen Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Wed, 16 May 2018 18:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 31474 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: 31474@debbugs.gnu.org X-Debbugs-Original-To: bug-guile@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.152649461214310 (code B ref -1); Wed, 16 May 2018 18:17:01 +0000 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 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-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 unknown Thu Sep 11 16:22:17 2025 X-Loop: help-debbugs@gnu.org Subject: bug#31474: logxor+ash trigger compilation bug? Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 28 May 2018 02:15:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31474 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: Jan Nieuwenhuizen Cc: 31474@debbugs.gnu.org Received: via spool by 31474-submit@debbugs.gnu.org id=B31474.152747366023471 (code B ref 31474); Mon, 28 May 2018 02:15:02 +0000 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 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-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 unknown Thu Sep 11 16:22:17 2025 X-Loop: help-debbugs@gnu.org Subject: bug#31474: logxor+ash trigger compilation bug? Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 28 May 2018 12:05:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31474 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: Jan Nieuwenhuizen Cc: Andy Wingo , 31474@debbugs.gnu.org Received: via spool by 31474-submit@debbugs.gnu.org id=B31474.152750906220969 (code B ref 31474); Mon, 28 May 2018 12:05:02 +0000 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 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-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 unknown Thu Sep 11 16:22:17 2025 X-Loop: help-debbugs@gnu.org Subject: bug#31474: logxor+ash trigger compilation bug? Resent-From: Jan Nieuwenhuizen Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 28 May 2018 21:18:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 31474 X-GNU-PR-Package: guile X-GNU-PR-Keywords: To: Mark H Weaver Cc: Andy Wingo , 31474@debbugs.gnu.org Received: via spool by 31474-submit@debbugs.gnu.org id=B31474.15275422407194 (code B ref 31474); Mon, 28 May 2018 21:18:02 +0000 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 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-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 unknown Thu Sep 11 16:22:17 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Jan Nieuwenhuizen Subject: bug#31474: closed (Re: bug#31474: logxor+ash trigger compilation bug?) Message-ID: References: <87po0x75yr.fsf@netris.org> <87y3gj8o00.fsf@gnu.org> X-Gnu-PR-Message: they-closed 31474 X-Gnu-PR-Package: guile Reply-To: 31474@debbugs.gnu.org Date: Mon, 11 Jun 2018 14:30:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1528727402-1463-1" This is a multi-part message in MIME format... ------------=_1528727402-1463-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #31474: logxor+ash trigger compilation bug? which was filed against the guile package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 31474@debbugs.gnu.org. --=20 31474: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D31474 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1528727402-1463-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit 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 ------------=_1528727402-1463-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit 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 ------------=_1528727402-1463-1--