summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-09-18 18:04:01 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-09-18 18:04:01 (GMT)
commit9a4d29bde94d4183ffa1066d4da062e4a2a4e7f2 (patch)
treef856c641275ae74cdc66a55b773dbdb3864eab63
parent1ad855e68849daccd5c7439bc910d5c694af4227 (diff)
downloadtcl-9a4d29bde94d4183ffa1066d4da062e4a2a4e7f2.zip
tcl-9a4d29bde94d4183ffa1066d4da062e4a2a4e7f2.tar.gz
tcl-9a4d29bde94d4183ffa1066d4da062e4a2a4e7f2.tar.bz2
Make sure large shifts shift for real. [Bug 868467]
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclExecute.c79
-rw-r--r--tests/expr.test12
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