fix fixnum-shift overflow check

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>
+            <th> "Vocabularies" write </th>
-            <td> <b> "Words" write </b> </td>
+            <th> "Words" write </th>
-            <td> <b> "Documentation" write </b> </td>
+            <th> "Documentation" write </th>
         </tr>
         <tr>    
             <td "top" =valign "width: 200" =style td> over vocab-list </td> 

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." } ;

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: store-insn ( offset reg-class -- )
-
+! 
-GENERIC: load-insn ( elt parameter reg-class -- )
+! GENERIC: load-insn ( elt parameter reg-class -- )
-
+! 
-M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
+! M: int-regs store-insn drop >r 3 1 r> stack@ STW ;
-
+! 
-M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
+! M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
-
+! 
-M: %unbox generate-node ( vop -- )
+! M: %unbox generate-node ( vop -- )
-    drop
+!     drop
-    ! Call the unboxer
+!     ! Call the unboxer
-    1 input f compile-c-call
+!     1 input f compile-c-call
-    ! Store the return value on the C stack
+!     ! Store the return value on the C stack
-    0 input 2 input store-insn ;
+!     0 input 2 input store-insn ;
-
+! 
-M: %parameter generate-node ( vop -- )
+! M: %parameter generate-node ( vop -- )
-    ! Move a value from the C stack into the fastcall register
+!     ! Move a value from the C stack into the fastcall register
-    drop 0 input 1 input 2 input load-insn ;
+!     drop 0 input 1 input 2 input load-insn ;
-
+! 
-M: %box generate-node ( vop -- )
+! M: %box generate-node ( vop -- )
-    drop
+!     drop
-    ! Move return value of C function into input register
+!     ! Move return value of C function into input register
-    param-regs first RAX MOV
+!     param-regs first RAX MOV
-    0 input f compile-c-call ;
+!     0 input f compile-c-call ;
-
+! 
-M: %cleanup generate-node ( vop -- ) drop ;
+! M: %cleanup generate-node ( vop -- ) drop ;

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

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

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));
+		F_FIXNUM mask = -(1 << (WORD_SIZE - 1 - TAG_BITS - y));
-		if(x > 0)
+		if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
-			mask = -mask;
-
-		if((x & mask) == 0)
 		{
 			dpush(tag_fixnum(x << y));
 			return;