From b3fc99501ec94bdc4c05736825c08a050cf8046d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 19 Aug 2018 09:13:16 +0000 Subject: Still WIP. All test-cases pass now in 32-bit --- generic/tclInt.h | 7 ++-- generic/tclScan.c | 27 ++++----------- generic/tclStringObj.c | 91 +++++++++++--------------------------------------- tests/get.test | 12 +++---- tests/platform.test | 2 +- 5 files changed, 38 insertions(+), 101 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index c1e24f5..3fb042e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2705,8 +2705,11 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_NUMBER_LONG 1 -#define TCL_NUMBER_WIDE 2 +#define TCL_NUMBER_INT 2 +#if TCL_MAJOR_VERSION < 9 +# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */ +# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */ +#endif #define TCL_NUMBER_BIG 3 #define TCL_NUMBER_DOUBLE 4 #define TCL_NUMBER_NAN 5 diff --git a/generic/tclScan.c b/generic/tclScan.c index 0e3da17..458dbd8 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -571,11 +571,10 @@ Tcl_ScanObjCmd( const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; - long value; + Tcl_WideInt value; const char *string, *end, *baseString; char op = 0; int width, underflow = 0; - Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; @@ -924,21 +923,7 @@ Tcl_ScanObjCmd( Tcl_DecrRefCount(objPtr); break; } - if (flags & SCAN_LONGER) { - if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { - wideValue = LLONG_MAX; - if (TclGetString(objPtr)[0] == '-') { - wideValue = LLONG_MIN; - } - } - if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { - sprintf(buf, "%" TCL_LL_MODIFIER "u", - (Tcl_WideUInt)wideValue); - Tcl_SetStringObj(objPtr, buf, -1); - } else { - TclSetIntObj(objPtr, wideValue); - } - } else if (flags & SCAN_BIG) { + if (flags & SCAN_BIG) { if (flags & SCAN_UNSIGNED) { mp_int big; int code = Tcl_GetBignumFromObj(interp, objPtr, &big); @@ -963,15 +948,15 @@ Tcl_ScanObjCmd( } } } else { - if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { - value = LONG_MIN; + value = LLONG_MIN; } else { - value = LONG_MAX; + value = LLONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ + sprintf(buf, "%" TCL_LL_MODIFIER "u", value); /* INTL: ISO digit */ Tcl_SetStringObj(objPtr, buf, -1); } else { TclSetIntObj(objPtr, value); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c103bea..9eaabea 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1817,9 +1817,6 @@ Tcl_AppendFormatToObj( char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; -#ifndef TCL_WIDE_INT_IS_LONG - int useWide = 0; -#endif int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -2010,18 +2007,11 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG - } else { - useWide = 1; -#endif } } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG - useWide = 1; -#endif } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); @@ -2091,16 +2081,10 @@ Tcl_AppendFormatToObj( case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ - long l; Tcl_WideInt w; mp_int big; int toAppend, isNegative = 0; -#ifndef TCL_WIDE_INT_IS_LONG - if (ch == 'p') { - useWide = 1; - } -#endif if (useBig) { int cmpResult; if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { @@ -2119,53 +2103,32 @@ Tcl_AppendFormatToObj( ch = 'd'; } } -#ifndef TCL_WIDE_INT_IS_LONG - } else if (useWide) { - if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { - Tcl_Obj *objPtr; + } else if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { + Tcl_Obj *objPtr; - if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { - goto error; - } - mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetWideIntFromObj(NULL, objPtr, &w); - Tcl_DecrRefCount(objPtr); - } - isNegative = (w < (Tcl_WideInt) 0); - if (w == (Tcl_WideInt) 0) gotHash = 0; -#endif - } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { - if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) { - Tcl_Obj *objPtr; - - if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { - goto error; - } - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); - objPtr = Tcl_NewBignumObj(&big); - Tcl_IncrRefCount(objPtr); - TclGetLongFromObj(NULL, objPtr, &l); - Tcl_DecrRefCount(objPtr); - } else { - l = Tcl_WideAsLong(w); + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { + goto error; } + mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); + objPtr = Tcl_NewBignumObj(&big); + Tcl_IncrRefCount(objPtr); + TclGetWideIntFromObj(NULL, objPtr, &w); + Tcl_DecrRefCount(objPtr); if (useShort) { - s = (short) l; + s = (short) w; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + isNegative = (w < (long) 0); + if (w == (long) 0) gotHash = 0; } } else if (useShort) { - s = (short) l; + s = (short) w; isNegative = (s < (short) 0); if (s == (short) 0) gotHash = 0; } else { - isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + isNegative = (w < (Tcl_WideInt) 0); + if (w == (Tcl_WideInt) 0) gotHash = 0; } segment = Tcl_NewObj(); @@ -2214,14 +2177,10 @@ Tcl_AppendFormatToObj( if (useShort) { pure = Tcl_NewIntObj((int) s); -#ifndef TCL_WIDE_INT_IS_LONG - } else if (useWide) { - pure = Tcl_NewWideIntObj(w); -#endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { - pure = Tcl_NewLongObj(l); + pure = Tcl_NewWideIntObj(w); } Tcl_IncrRefCount(pure); bytes = TclGetStringFromObj(pure, &length); @@ -2301,16 +2260,6 @@ Tcl_AppendFormatToObj( numDigits++; us /= base; } -#ifndef TCL_WIDE_INT_IS_LONG - } else if (useWide) { - Tcl_WideUInt uw = (Tcl_WideUInt) w; - - bits = uw; - while (uw) { - numDigits++; - uw /= base; - } -#endif } else if (useBig && big.used) { int leftover = (big.used * DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); @@ -2327,12 +2276,12 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - unsigned long ul = (unsigned long) l; + Tcl_WideUInt uw = (Tcl_WideUInt) w; - bits = (Tcl_WideUInt) ul; - while (ul) { + bits = (Tcl_WideUInt) uw; + while (uw) { numDigits++; - ul /= base; + uw /= base; } } diff --git a/tests/get.test b/tests/get.test index d6a7206..b02b686 100644 --- a/tests/get.test +++ b/tests/get.test @@ -45,14 +45,14 @@ test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} { list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} { - list [catch {testgetint 18446744073709551614} msg] $msg -} {0 -2} + list [catch {testgetint 18446744073709551614} msg] $msg $errorCode +} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} { - list [catch {testgetint +18446744073709551614} msg] $msg -} {0 -2} + list [catch {testgetint +18446744073709551614} msg] $msg $errorCode +} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} { - list [catch {testgetint -18446744073709551614} msg] $msg -} {0 2} + list [catch {testgetint -18446744073709551614} msg] $msg $errorCode +} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} { list [catch {testgetint 44 4294967296} msg] $msg $errorCode } {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}} diff --git a/tests/platform.test b/tests/platform.test index fa533e8..83848e8 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -43,7 +43,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { # everything these days. Note that this does *not* use wide(), and # this is intentional since that could make Tcl's numbers wider than # the machine-integer on some platforms... -test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { +test platform-2.1 {tcl_platform(wordSize) indicates size of native word} nonPortable { set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] # Result must be the largest bit in a machine word, which this checks # without assuming how wide the word really is -- cgit v0.12