From 3c82f32973a705098c58504e8c9d999dc7fe0723 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 24 Jun 2019 20:36:41 +0000 Subject: Better implementation of fpclassify() equivalent. --- generic/tclBasic.c | 81 ++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 73 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a23bfc1..4f64427 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -24,7 +24,11 @@ #include #include #ifndef fpclassify /* Older MSVC */ +#ifdef _M_IX86 +#define REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK +#else /* !_M_IX86 */ #include +#endif /* _M_IX86 */ #endif /* !fpclassify */ #define INTERP_STACK_INITIAL_SIZE 2000 @@ -8329,10 +8333,13 @@ ExprSrandFunc( /* * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course. - * But it does have _fpclass() which does almost the same job. + * But it does sometimes have _fpclass() which does almost the same job; if + * even that is absent, we grobble around directly in the platform's binary + * representation of double. * - * This makes it conform to the C99 standard API, and just delegates to the - * standard macro on platforms that do it correctly. + * This function makes all that conform to a common API (effectively the C99 + * standard API renamed), and just delegates to the standard macro on + * platforms that do it correctly. */ static inline int @@ -8342,12 +8349,69 @@ ClassifyDouble( #ifdef fpclassify return fpclassify(d); #else /* !fpclassify */ -#define FP_ZERO 0 -#define FP_NORMAL 1 -#define FP_SUBNORMAL 2 -#define FP_INFINITE 3 -#define FP_NAN 4 +#define FP_NAN 1 +#define FP_INFINITE 2 +#define FP_ZERO 3 +#define FP_NORMAL 4 +#define FP_SUBNORMAL 5 +#ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK + /* + * We assume this hack is only needed on little-endian systems. + * Specifically, x86 running Windows. It's fairly easy to enable for + * others if they need it (because their libc/libm is broken) but we'll + * jump that hurdle when requred. We can solve the word ordering then. + */ + + union { + double d; + struct { + unsigned int low; + unsigned int high; + } w; + } doubleMeaning; + unsigned int exponent, mantissaLow, mantissaHigh; + int zeroMantissa; +#define EXPONENT_MASK 0x7ff; +#define EXPONENT_SHIFT 20 +#define MANTISSA_MASK 0xfffff + + /* + * Extract the exponent (11 bits) and mantissa (52 bits). Note that we + * totally ignore the sign bit. + */ + + doubleMeaning.d = d; + exponent = (doubleMeaning.w.high >> EXPONENT_SHIFT) & EXPONENT_MASK; + mantissaLow = doubleMeaning.w.low; + mantissaHigh = doubleMeaning.w.high & MANTISSA_MASK; + zeroMantissa = (mantissaHigh == 0 && mantissaLow == 0); + + /* + * Look for the special cases of exponent. + */ + + switch (exponent) { + case 0: + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ + + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + case EXPONENT_MASK: + /* + * When the exponent is all ones, it's an INF or a NAN. + */ + + return zeroMantissa ? FP_INF : FP_NAN; + default: + /* + * Everything else is a NORMAL double precision float. + */ + + return FP_NORMAL; + } +#else /* !REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: @@ -8367,6 +8431,7 @@ ClassifyDouble( case _FPCLASS_SNAN: return FP_NAN; } +#endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ #endif /* fpclassify */ } -- cgit v0.12 From 9489b8b506999d9ec543ed3e626cb32ea3a8394a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 06:56:26 +0000 Subject: Squelch C4244 warning on any MSVC compiler. --- win/tclWinPort.h | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 29b1447..20b2fe0 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -480,10 +480,12 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if defined(_MSC_VER) && (_MSC_VER >= 1400) +#if defined(_MSC_VER) # pragma warning(disable:4244) -# pragma warning(disable:4267) -# pragma warning(disable:4996) +# if _MSC_VER >= 1400 +# pragma warning(disable:4267) +# pragma warning(disable:4996) +# endif #endif /* -- cgit v0.12 From f310332a6ba0427e38582673f4d3fbe4b3d9eb5c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 07:36:28 +0000 Subject: use __builtin_fpclassify for mingw x86 (tested up to gcc 8.1, it seems to have a bug in fpclassify, so [fpclassify 1e-314], x86 => normal, x64 => subnormal) --- generic/tclBasic.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a23bfc1..ea96108 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8340,7 +8340,13 @@ ClassifyDouble( double d) { #ifdef fpclassify +/* MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, + * [fpclassify 1e-314], x86 => normal, x64 => subnormal */ +# if defined(__MINGW32__) && defined(_X86_) + return __builtin_fpclassify(FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); +# else return fpclassify(d); +# endif #else /* !fpclassify */ #define FP_ZERO 0 #define FP_NORMAL 1 -- cgit v0.12 From 940b2183da62b66bebfd28cfed0a1dfb80b92a0d Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 25 Jun 2019 08:48:27 +0000 Subject: Where did that stray semicolon come from? Also improve the comments... --- generic/tclBasic.c | 53 +++++++++++++++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 20 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4f64427..de39236 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -8329,17 +8329,15 @@ ExprSrandFunc( * None. * *---------------------------------------------------------------------- - */ - -/* + * * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course. * But it does sometimes have _fpclass() which does almost the same job; if * even that is absent, we grobble around directly in the platform's binary * representation of double. * - * This function makes all that conform to a common API (effectively the C99 - * standard API renamed), and just delegates to the standard macro on - * platforms that do it correctly. + * The ClassifyDouble() function makes all that conform to a common API + * (effectively the C99 standard API renamed), and just delegates to the + * standard macro on platforms that do it correctly. */ static inline int @@ -8349,11 +8347,16 @@ ClassifyDouble( #ifdef fpclassify return fpclassify(d); #else /* !fpclassify */ -#define FP_NAN 1 -#define FP_INFINITE 2 -#define FP_ZERO 3 -#define FP_NORMAL 4 -#define FP_SUBNORMAL 5 + /* + * If we don't have fpclassify(), we also don't have the values it returns. + * Hence we define those here. + */ + +#define FP_NAN 1 /* Value is NaN */ +#define FP_INFINITE 2 /* Value is an infinity */ +#define FP_ZERO 3 /* Value is a zero */ +#define FP_NORMAL 4 /* Value is a normal float */ +#define FP_SUBNORMAL 5 /* Value has lost accuracy */ #ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK /* @@ -8364,17 +8367,27 @@ ClassifyDouble( */ union { - double d; + double d; /* Interpret as double */ struct { - unsigned int low; - unsigned int high; - } w; - } doubleMeaning; + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - int zeroMantissa; -#define EXPONENT_MASK 0x7ff; -#define EXPONENT_SHIFT 20 -#define MANTISSA_MASK 0xfffff + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ + + /* + * Shifts and masks to use with the doubleMeaning variable above. + */ + +#define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we -- cgit v0.12 From 9fb98b2d11c075c66b5cb297bcd700cf26c81eac Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 10:40:18 +0000 Subject: fixed several fpclassify modes (better recognition and control via TCL_FPCLASSIFY_MODE), typos fixed (FP_INF -> FP_INFINITE), no redefine warnings if FP_* already specified, etc --- generic/tclBasic.c | 50 +++++++++++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index de39236..41df33c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -23,13 +23,20 @@ #include "tommath.h" #include #include -#ifndef fpclassify /* Older MSVC */ -#ifdef _M_IX86 -#define REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK -#else /* !_M_IX86 */ -#include -#endif /* _M_IX86 */ -#endif /* !fpclassify */ + +#ifndef TCL_FPCLASSIFY_MODE +# if ( defined(__MINGW32__) && defined(_X86_) ) /* mingw 32-bit */ +# define TCL_FPCLASSIFY_MODE 1 +# elif defined(fpclassify) /* fpclassify */ +# include +# define TCL_FPCLASSIFY_MODE 0 +# elif defined(_FPCLASS_NN) /* _fpclass */ +# define TCL_FPCLASSIFY_MODE 1 +# else /* !fpclassify && !_fpclass (older MSVC), simulate */ +# define TCL_FPCLASSIFY_MODE 2 +# endif /* !fpclassify */ +#endif /* !TCL_FPCLASSIFY_MODE */ + #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 @@ -8344,21 +8351,22 @@ static inline int ClassifyDouble( double d) { -#ifdef fpclassify +#if TCL_FPCLASSIFY_MODE == 0 return fpclassify(d); #else /* !fpclassify */ /* * If we don't have fpclassify(), we also don't have the values it returns. * Hence we define those here. */ +# ifndef FP_NAN +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +#endif -#define FP_NAN 1 /* Value is NaN */ -#define FP_INFINITE 2 /* Value is an infinity */ -#define FP_ZERO 3 /* Value is a zero */ -#define FP_NORMAL 4 /* Value is a normal float */ -#define FP_SUBNORMAL 5 /* Value has lost accuracy */ - -#ifdef REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK +# if TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. * Specifically, x86 running Windows. It's fairly easy to enable for @@ -8385,9 +8393,9 @@ ClassifyDouble( * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ +# define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */ +# define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +# define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -8416,7 +8424,7 @@ ClassifyDouble( * When the exponent is all ones, it's an INF or a NAN. */ - return zeroMantissa ? FP_INF : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: /* * Everything else is a NORMAL double precision float. @@ -8424,7 +8432,7 @@ ClassifyDouble( return FP_NORMAL; } -#else /* !REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ +# elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: @@ -8444,7 +8452,7 @@ ClassifyDouble( case _FPCLASS_SNAN: return FP_NAN; } -#endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ +# endif /* REQUIRE_ANCIENT_WIN32_FPCLASSIFY_HACK */ #endif /* fpclassify */ } -- cgit v0.12 From da06343b0b1801e88d0f0ebaa60d1559d75e063b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 11:01:27 +0000 Subject: amend (remove test define) --- generic/tclBasic.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b67648c..2c26202 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -32,9 +32,6 @@ * 3 - __builtin_fpclassify */ -#define TCL_FPCLASSIFY_MODE 3 -#warning mode: TCL_FPCLASSIFY_MODE - #ifndef TCL_FPCLASSIFY_MODE /* * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify, -- cgit v0.12 From d1b95c26242ba247ebd5656c430b01943b24a728 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 25 Jun 2019 15:50:31 +0000 Subject: Change int constants into char constants. Hopefully this eliminates C4305 warnings on MSVC 6.0 --- generic/tclZipfs.c | 7 +++---- win/tclWinPanic.c | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 3d1941c..6a568fe 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -283,10 +283,9 @@ static struct { * For password rotation. */ -static const char pwrot[16] = { - 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, - 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 -}; +static const char pwrot[16] = + "\x00\x80\x40\xC0\x20\xA0\x60\xE0" + "\x10\x90\x50\xD0\x30\xB0\x70\xF0"; /* * Table to compute CRC32. diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c index a71f506..5c6e02d 100644 --- a/win/tclWinPanic.c +++ b/win/tclWinPanic.c @@ -58,7 +58,7 @@ Tcl_ConsolePanic( } else if (_isatty(2)) { WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); } else { - buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ + buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */ WriteFile(handle, buf, strlen(buf), &dummy, 0); WriteFile(handle, "\n", 1, &dummy, 0); FlushFileBuffers(handle); -- cgit v0.12 From be26adf83b00a077251c7242792c50c23fa0baa7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 16:09:33 +0000 Subject: fixed build with MSVC 6.0 --- generic/tclCmdMZ.c | 14 +++++++------- generic/tclExecute.c | 9 +++------ generic/tclInt.h | 7 +++++++ win/tclWinFile.c | 1 - 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bc03d73..d36b0f0 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3986,14 +3986,14 @@ Tcl_TimeRateObjCmd( register Tcl_Obj *objPtr; register int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; - Tcl_WideUInt count = 0; /* Holds repetition count */ + TclWideMUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ - Tcl_WideUInt maxcnt = WIDE_MAX; + TclWideMUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ - Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster + TclWideMUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ - Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max + TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid @@ -4363,13 +4363,13 @@ Tcl_TimeRateObjCmd( { Tcl_Obj *objarr[8], **objs = objarr; - Tcl_WideUInt usec, val; + TclWideMUInt usec, val; int digits; /* * Absolute execution time in microseconds or in wide clicks. */ - usec = (Tcl_WideUInt)(middle - start); + usec = (TclWideMUInt)(middle - start); #ifdef TCL_WIDE_CLICKS /* @@ -4398,7 +4398,7 @@ Tcl_TimeRateObjCmd( * Estimate the time of overhead (microsecs). */ - Tcl_WideUInt curOverhead = overhead * count; + TclWideMUInt curOverhead = overhead * count; if (usec > curOverhead) { usec -= curOverhead; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 265b82f..0c2baab 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4938,7 +4938,7 @@ TclExecuteByteCode( } #endif { - mp_int big2; + mp_int big1, big2; Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); @@ -4956,8 +4956,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromLong(&big1, l1); mp_add(&big2, &big1, &big2); mp_clear(&big1); @@ -4994,7 +4992,8 @@ TclExecuteByteCode( NEXT_INST_F(1, 2, 1); } { - mp_int big2; + mp_int big1, big2; + Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); /* TODO: internals intrusion */ @@ -5011,8 +5010,6 @@ TclExecuteByteCode( * Arguments are opposite sign; remainder is sum. */ - mp_int big1; - TclBNInitBignumFromWideInt(&big1, w1); mp_add(&big2, &big1, &big2); mp_clear(&big1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 8b4ccc5..974dd0d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2773,6 +2773,13 @@ MODULE_SCOPE void TclInitThreadStorage(void); MODULE_SCOPE void TclpFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); +/* TclWideMUInt -- wide integer used for measurement calculations: */ +#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400)) +# define TclWideMUInt Tcl_WideUInt +#else +/* older MSVS may not allow conversions between unsigned __int64 and double) */ +# define TclWideMUInt Tcl_WideInt +#endif #ifdef TCL_WIDE_CLICKS MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8ee4bce..d582664 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,7 +17,6 @@ #include #include #include /* For TclpGetUserHome(). */ -#include /* For TclpGetUserHome(). */ /* * The number of 100-ns intervals between the Windows system epoch (1601-01-01 -- cgit v0.12 From 334b8029eddb4e6df592c5f540ade0fd957a72c1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 17:45:23 +0000 Subject: nmakehlp: fixed const qualifier --- win/nmakehlp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index 0439d1c..6532f8a 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -74,7 +74,7 @@ main( char msg[300]; DWORD dwWritten; int chars; - char *s; + const char *s; /* * Make sure children (cl.exe and link.exe) are kept quiet. -- cgit v0.12 From 9392d9001aff32b293b587f531e08a54f534b2c2 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 25 Jun 2019 18:59:09 +0000 Subject: restore userenv, used in 8.6 --- win/tclWinFile.c | 1 + 1 file changed, 1 insertion(+) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 49f85cb..2f35d4a 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -17,6 +17,7 @@ #include #include #include /* For TclpGetUserHome(). */ +#include /* For TclpGetUserHome(). */ #include /* For GetNamedSecurityInfo */ #ifdef _MSC_VER -- cgit v0.12