Make sure large shifts shift for real. [Bug 868467]

3 files changed, 86 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 58d5cce..71c5123 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2004-09-18  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclExecute.c (TEBC-INST_LSHIFT,INST_RSHIFT): Ensure that
+	large shifts end up shifting correctly. [Bug 868467]
+
 	* doc/FileSystem.3, doc/OpenFileChnl.3: More documentation fixes
 	from Mikhail Kolesnitchenko. [Patch 1022527]
 	* doc/*: Standardize highlighting of symbols defined in tcl.h
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b965944..a5dd499 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.147 2004/09/11 13:45:15 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.148 2004/09/18 18:04:04 dkf Exp $
  */
 
 #ifdef STDC_HEADERS
@@ -3600,11 +3600,42 @@ TclExecuteByteCode(interp, codePtr)
 #ifdef TCL_COMPILE_DEBUG
 		w2 = Tcl_LongAsWide(i2);
 #endif /* TCL_COMPILE_DEBUG */
-		wResult = w << i2;
+		wResult = w;
+		/*
+		 * Shift in steps when the shift gets large to prevent
+		 * annoying compiler/processor bugs. [Bug 868467]
+		 */
+		if (i2 >= 64) {
+		    wResult = Tcl_LongAsWide(0);
+		} else if (i2 > 60) {
+		    wResult = w << 30;
+		    wResult <<= 30;
+		    wResult <<= i2-60;
+		} else if (i2 > 30) {
+		    wResult = w << 30;
+		    wResult <<= i2-30;
+		} else {
+		    wResult = w << i2;
+		}
 		doWide = 1;
 		break;
 	    }
-	    iResult = i << i2;
+	    /*
+	     * Shift in steps when the shift gets large to prevent
+	     * annoying compiler/processor bugs. [Bug 868467]
+	     */
+	    if (i2 >= 64) {
+		iResult = 0;
+	    } else if (i2 > 60) {
+		iResult = i << 30;
+		iResult <<= 30;
+		iResult <<= i2-60;
+	    } else if (i2 > 30) {
+		iResult = i << 30;
+		iResult <<= i2-30;
+	    } else {
+		iResult = i << i2;
+	    }
 	    break;
 	case INST_RSHIFT:
 	    /*
@@ -3621,17 +3652,51 @@ TclExecuteByteCode(interp, codePtr)
 		w2 = Tcl_LongAsWide(i2);
 #endif /* TCL_COMPILE_DEBUG */
 		if (w < 0) {
-		    wResult = ~((~w) >> i2);
+		    wResult = ~w;
+		}
+		/*
+		 * Shift in steps when the shift gets large to prevent
+		 * annoying compiler/processor bugs. [Bug 868467]
+		 */
+		if (i2 >= 64) {
+		    wResult = Tcl_LongAsWide(0);
+		} else if (i2 > 60) {
+		    wResult <<= 30;
+		    wResult <<= 30;
+		    wResult <<= i2-60;
+		} else if (i2 > 30) {
+		    wResult <<= 30;
+		    wResult <<= i2-30;
 		} else {
-		    wResult = w >> i2;
+		    wResult <<= i2;
+		}
+		if (w < 0) {
+		    wResult = ~wResult;
 		}
 		doWide = 1;
 		break;
 	    }
 	    if (i < 0) {
-		iResult = ~((~i) >> i2);
+		iResult = ~i;
+	    }
+	    /*
+	     * Shift in steps when the shift gets large to prevent
+	     * annoying compiler/processor bugs. [Bug 868467]
+	     */
+	    if (i2 >= 64) {
+		iResult = 0;
+	    } else if (i2 > 60) {
+		iResult <<= 30;
+		iResult <<= 30;
+		iResult <<= i2-60;
+	    } else if (i2 > 30) {
+		iResult <<= 30;
+		iResult <<= i2-30;
 	    } else {
-		iResult = i >> i2;
+		iResult <<= i2;
+	    }
+	    if (i < 0) {
+		iResult = ~iResult;
 	    }
 	    break;
 	case INST_BITOR:
diff --git a/tests/expr.test b/tests/expr.test
index 059f7f3..028f56f 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: expr.test,v 1.22 2004/06/23 15:36:56 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.23 2004/09/18 18:04:06 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -860,6 +860,16 @@ test epxr-23.31 {INST_EXPON: special cases} {expr {wide(-1)**wide(-1)}} -1
 test epxr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1
 test epxr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0
 
+# Some compilers get this wrong; ensure that we work around it correctly
+test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
+test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
+test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
+test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
+test expr-24.5 {expr edge cases; shifting} {expr int(5)<<32} 0
+test expr-24.6 {expr edge cases; shifting} {expr int(5)<<63} 0
+test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 0
+test expr-24.8 {expr edge cases; shifting} {expr wide(5)<<63} 0
+
 # cleanup
 if {[info exists a]} {
     unset a