From e256a4ba18fbb7916db2a22ead55cbcbf7cf920d Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 31 Oct 2019 10:45:54 -0700
Subject: [PATCH] math.intervals: workaround possible compiler bug by widening
 interval-bitor.

IN: scratchpad [
                   { byte-array } declare
                   [ 0 alien-unsigned-4 32 shift ]
                   [ 4 alien-unsigned-4 ] bi bitor
                   64 >signed
               ] optimized.

! working
[
    dup >R 0 alien-unsigned-4 32 fixnum-shift
    R> 4 alien-unsigned-4 over tag 0 eq?
    [ fixnum-bitor ] [ fixnum>bignum bignum-bitor ] if
    18446744073709551615 >R >bignum R> bignum-bitand
    dup 63 bignum-bit? [ 18446744073709551616 bignum- ] [ ] if
]

! broken
[
    dup >R 0 alien-unsigned-4 32 fixnum-shift
    R> 4 alien-unsigned-4 over tag 0 eq?
    [ fixnum-bitor ] [ fixnum>bignum bignum-bitor ] if
    dup 63 bignum-bit? [ 18446744073709551616 bignum- ] [ ] if
]

The second case correctly eliminates the bitand but incorrectly assumes
that the item on the stack (which is an integer -- either a fixnum or a
bignum), was converted to a bignum.
---
 basis/math/intervals/intervals-tests.factor | 4 ++--
 basis/math/intervals/intervals.factor       | 3 ++-
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor
index 73706da340..87028ea93f 100644
--- a/basis/math/intervals/intervals-tests.factor
+++ b/basis/math/intervals/intervals-tests.factor
@@ -413,8 +413,8 @@ ${ 0 0xff [a,b] } [ -0xff -1 [a,b] 0 0xff [a,b] interval-bitand ] unit-test
     [ 0 15 [a,b] interval-contains? ] all?
 ] unit-test
 
-${ 0 255 [a,b] } [ 0 255 [a,b] dup interval-bitor ] unit-test
-${ 0 511 [a,b] } [ 0 256 [a,b] dup interval-bitor ] unit-test
+${ 0 256 [a,b] } [ 0 255 [a,b] dup interval-bitor ] unit-test
+${ 0 512 [a,b] } [ 0 256 [a,b] dup interval-bitor ] unit-test
 
 ${ -128 127 [a,b] } [ -128 127 [a,b] dup interval-bitor ] unit-test
 ${ -256 255 [a,b] } [ -128 128 [a,b] dup interval-bitor ] unit-test
diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor
index 63fa4582fd..f36b659b3b 100644
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@@ -447,7 +447,8 @@ PRIVATE>
 : interval-bitor ( i1 i2 -- i3 )
     [
         { { [ 2dup [ interval-nonnegative? ] both? ]
-            [ [ max-lower-bound ] [ max-upper-bound ] 2bi bit-weight 1 - [a,b] ] }
+            ! FIXME: this should maybe be bitweight 1 -
+            [ [ max-lower-bound ] [ max-upper-bound ] 2bi bit-weight [a,b] ] }
           { [ 2dup [ interval-negative? ] both? ]
             [ max-lower-bound -1 [a,b] ] }
           [ interval-union interval-bit-weight [ neg ] [ 1 - ] bi [a,b] ]