fix fixnum-shift overflow check

diff --git a/contrib/httpd/browser-responder.factor b/contrib/httpd/browser-responder.factor
index f0e75bfca992bd4b6b310f7bb5913d84f559f27d..36fd08c2c08c3f65a4ad80742c18fbd67f3c5177 100644 (file)
--- a/contrib/httpd/browser-responder.factor
+++ b/contrib/httpd/browser-responder.factor
@@ -62,9 +62,9 @@ memory namespaces prettyprint sequences words xml ;
     #! Write out the HTML for the body of the main browser page.
     <table "100%" =width table> 
         <tr>
-            <td> <b> "Vocabularies" write </b> </td>
-            <td> <b> "Words" write </b> </td>
-            <td> <b> "Documentation" write </b> </td>
+            <th> "Vocabularies" write </th>
+            <th> "Words" write </th>
+            <th> "Documentation" write </th>
         </tr>
         <tr>    
             <td "top" =valign "width: 200" =style td> over vocab-list </td> 

diff --git a/library/collections/sequences-epilogue.facts b/library/collections/sequences-epilogue.facts
index 73bf19a9c339ba2fc2dc6548ed5b789fcc9f89e3..7d9e56ee75228eece32195c43d07b55a1a8833cb 100644 (file)
--- a/library/collections/sequences-epilogue.facts
+++ b/library/collections/sequences-epilogue.facts
@@ -80,12 +80,6 @@ HELP: add "( seq elt -- newseq )"
 { $description "Outputs a new sequence consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "elt" } "." }
 { $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
 
-HELP: adjoin "( elt seq -- )"
-{ $values { "elt" "an object" } { "seq" "a resizable mutable sequence" } }
-{ $description "Adds the element at the end of the sequence if the sequence does not already contain an equal element." }
-{ $side-effects "seq" }
-{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } ;
-
 HELP: diff "( seq1 seq2 -- newseq )"
 { $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "newseq" "a sequence" } }
 { $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." } ;

diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor
index bd0df2d9bf783770c5a3a9ecd3211c1c561b2f46..e89c6f318a6f8e975b61bd0779b3711ba7d6d53b 100644 (file)
--- a/library/compiler/amd64/alien.factor
+++ b/library/compiler/amd64/alien.factor
@@ -3,29 +3,29 @@
 IN: compiler-backend
 USING: alien assembler kernel math sequences ;
 
-GENERIC: store-insn ( offset reg-class -- )
-
-GENERIC: load-insn ( elt parameter reg-class -- )
-
-M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
-
-M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
-
-M: %unbox generate-node ( vop -- )
-    drop
-    ! Call the unboxer
-    1 input f compile-c-call
-    ! Store the return value on the C stack
-    0 input 2 input store-insn ;
-
-M: %parameter generate-node ( vop -- )
-    ! Move a value from the C stack into the fastcall register
-    drop 0 input 1 input 2 input load-insn ;
-
-M: %box generate-node ( vop -- )
-    drop
-    ! Move return value of C function into input register
-    param-regs first RAX MOV
-    0 input f compile-c-call ;
-
-M: %cleanup generate-node ( vop -- ) drop ;
+! GENERIC: store-insn ( offset reg-class -- )
+! 
+! GENERIC: load-insn ( elt parameter reg-class -- )
+! 
+! M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
+! 
+! M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
+! 
+! M: %unbox generate-node ( vop -- )
+!     drop
+!     ! Call the unboxer
+!     1 input f compile-c-call
+!     ! Store the return value on the C stack
+!     0 input 2 input store-insn ;
+! 
+! M: %parameter generate-node ( vop -- )
+!     ! Move a value from the C stack into the fastcall register
+!     drop 0 input 1 input 2 input load-insn ;
+! 
+! M: %box generate-node ( vop -- )
+!     drop
+!     ! Move return value of C function into input register
+!     param-regs first RAX MOV
+!     0 input f compile-c-call ;
+! 
+! M: %cleanup generate-node ( vop -- ) drop ;

diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor
index 1a4646cf0021f56cd196f0abdf11df39bb9ebc77..bd35d2f89d12d4a555c2e7537f1ff9198d175262 100644 (file)
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -173,6 +173,7 @@ math-internals sequences strings test words ;
 [ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
 [ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
 [ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test
+[ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-1 ] unit-test
 
 [ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
 
@@ -199,7 +200,7 @@ cell 8 = [
     [ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
     [ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
     [ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
-    
+
     [ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-1 ] unit-test
     [ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-1 ] unit-test
     [ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test

diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor
index 31e0c5d2fb27923855e9f8e414b788c944443ef2..82fe2322f5d3e1ef6be7804dd9ba778de41e32fa 100644 (file)
--- a/library/test/math/integer.factor
+++ b/library/test/math/integer.factor
@@ -99,3 +99,5 @@ unit-test
 [ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
 
 [ { 0 1 1 0 } ] [ [ -10 [ , ] each-bit ] { } make ] unit-test
+
+[ -351382792 ] [ -43922849 3 shift ] unit-test

diff --git a/native/fixnum.c b/native/fixnum.c
index 2f60958781902752952ea4aaae36db84c81d1d74..b23db2b15f1f7899b31f19d19867f1bb7eb4b7ef 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -136,7 +136,12 @@ void primitive_fixnum_shift(void)
        F_FIXNUM y = untag_fixnum_fast(dpop());
        F_FIXNUM x = untag_fixnum_fast(dpop());
 
-       if(y < 0)
+       if(x == 0 || y == 0)
+       {
+               dpush(tag_fixnum(x));
+               return;
+       }
+       else if(y < 0)
        {
                if(y <= -WORD_SIZE)
                        dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
@@ -144,18 +149,10 @@ void primitive_fixnum_shift(void)
                        dpush(tag_fixnum(x >> -y));
                return;
        }
-       else if(y == 0)
-       {
-               dpush(tag_fixnum(x));
-               return;
-       }
        else if(y < WORD_SIZE - TAG_BITS)
        {
-               F_FIXNUM mask = (1 << (WORD_SIZE - 1 - TAG_BITS - y));
-               if(x > 0)
-                       mask = -mask;
-
-               if((x & mask) == 0)
+               F_FIXNUM mask = -(1 << (WORD_SIZE - 1 - TAG_BITS - y));
+               if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
                {
                        dpush(tag_fixnum(x << y));
                        return;