diff options
-rw-r--r-- | ChangeLog | 19 | ||||
-rw-r--r-- | generic/tclBasic.c | 4 | ||||
-rw-r--r-- | generic/tclBinary.c | 4 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 6 | ||||
-rw-r--r-- | generic/tclCompile.c | 7 | ||||
-rw-r--r-- | generic/tclExecute.c | 4 | ||||
-rw-r--r-- | generic/tclHash.c | 14 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 5 | ||||
-rw-r--r-- | generic/tclProc.c | 4 | ||||
-rw-r--r-- | generic/tclScan.c | 4 | ||||
-rwxr-xr-x | generic/tclStrToD.c | 18 | ||||
-rw-r--r-- | generic/tclVar.c | 6 |
12 files changed, 55 insertions, 40 deletions
@@ -1,3 +1,22 @@ +2009-07-16 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBinary.c: Removed unused variables. + * generic/tclCmdIL.c: + * generic/tclCompile.c: + * generic/tclExecute.c: + * generic/tclHash.c: + * generic/tclIOUtil.c: + * generic/tclVar.c: + + * generic/tclBasic.c: Silence compiler warnings about ClientData. + * generic/tclProc.c: + + * generic/tclScan.c: Typo in ACCEPT_NAN configuration. + + * generic/tclStrToD.c: Set floating point control register on + MIPS systems so that the gradual underflow expected by Tcl is + in effect. [Bug 2819200] + 2009-07-15 Donal K. Fellows <dkf@users.sf.net> * generic/tclInt.h (Namespace): Added machinery to allow diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b6a87d7..3b5bad1 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.397 2009/07/14 21:47:42 das Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.398 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -4302,7 +4302,7 @@ NRRunObjProc( { /* OPT: do not call? */ - Tcl_ObjCmdProc *objProc = data[0]; + Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; ClientData objClientData = data[1]; int objc = PTR2INT(data[2]); Tcl_Obj **objv = data[3]; diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 68409d1..8a3aeac 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -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: tclBinary.c,v 1.54 2009/02/03 23:34:32 nijtmans Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.55 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -1159,7 +1159,6 @@ BinaryScanCmd( * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ - unsigned char *cursor; /* Current position within result buffer. */ const char *errorString; const char *str; int offset, size, length; @@ -1178,7 +1177,6 @@ BinaryScanCmd( Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); buffer = Tcl_GetByteArrayFromObj(objv[1], &length); format = TclGetString(objv[2]); - cursor = buffer; arg = 3; offset = 0; while (*format != '\0') { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index cbc2b60..0049b18 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.167 2009/07/11 13:34:24 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.168 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -3521,7 +3521,7 @@ Tcl_LsortObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int i, j, index, unique, indices, length, nocase = 0, sortMode, indexc; + int i, j, index, indices, length, nocase = 0, sortMode, indexc; int group, groupSize, groupOffset, idx; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; SortElement *elementArray, *elementPtr; @@ -3562,7 +3562,6 @@ Tcl_LsortObjCmd( sortInfo.interp = interp; sortInfo.resultCode = TCL_OK; cmdPtr = NULL; - unique = 0; indices = 0; group = 0; groupSize = 1; @@ -3661,7 +3660,6 @@ Tcl_LsortObjCmd( sortInfo.sortMode = SORTMODE_REAL; break; case LSORT_UNIQUE: - unique = 1; sortInfo.unique = 1; break; case LSORT_INDICES: diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6168133..6b8b7a5 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.169 2009/07/14 21:47:42 das Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.170 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -1190,7 +1190,7 @@ TclCompileScript( Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; - int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex; + int bytesLeft, isFirstCmd, wordIdx, currCmdIndex; int commandLength, objIndex; Tcl_DString ds; /* TIP #280 */ @@ -1220,7 +1220,6 @@ TclCompileScript( p = script; bytesLeft = numBytes; - gotParse = 0; cmdLine = envPtr->line; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { @@ -1236,7 +1235,6 @@ TclCompileScript( TclCompileSyntaxError(interp, envPtr); break; } - gotParse = 1; if (parsePtr->numWords > 0) { int expand = 0; /* Set if there are dynamic expansions to * handle */ @@ -1578,7 +1576,6 @@ TclCompileScript( TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); Tcl_FreeParse(parsePtr); - gotParse = 0; } while (bytesLeft > 0); /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 5139dad..8ccdbe1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,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.441 2009/07/14 16:34:08 andreas_kupries Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.442 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -4708,10 +4708,8 @@ TclExecuteByteCode( */ int index, length; - char *bytes; Tcl_Obj *valuePtr, *value2Ptr; - bytes = NULL; /* lint */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; diff --git a/generic/tclHash.c b/generic/tclHash.c index 218d8e1..9ed941e 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -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: tclHash.c,v 1.38 2009/01/09 11:21:45 dkf Exp $ + * RCS: @(#) $Id: tclHash.c,v 1.39 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -624,18 +624,6 @@ Tcl_HashStats( double average, tmp; register Tcl_HashEntry *hPtr; char *result, *p; - const Tcl_HashKeyType *typePtr; - - if (tablePtr->keyType == TCL_STRING_KEYS) { - typePtr = &tclStringHashKeyType; - } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { - typePtr = &tclOneWordHashKeyType; - } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS - || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { - typePtr = tablePtr->typePtr; - } else { - typePtr = &tclArrayHashKeyType; - } /* * Compute a histogram of bucket usage. diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 44df324..f77e737 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.163 2009/02/10 22:50:05 nijtmans Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.164 2009/07/16 21:24:39 dgp Exp $ */ #include "tclInt.h" @@ -1793,11 +1793,9 @@ TclNREvalFile( const char *encodingName) /* If non-NULL, then use this encoding for the * file. NULL means use the system encoding. */ { - int length; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile, *objPtr; Interp *iPtr; - const char *string; Tcl_Channel chan; if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { @@ -1857,7 +1855,6 @@ TclNREvalFile( oldScriptFile = iPtr->scriptFile; iPtr->scriptFile = pathPtr; Tcl_IncrRefCount(iPtr->scriptFile); - string = Tcl_GetStringFromObj(objPtr, &length); /* * TIP #280: Force the evaluator to open a frame for a sourced file. diff --git a/generic/tclProc.c b/generic/tclProc.c index 7696015..98784c3 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.172 2009/06/13 14:31:54 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.173 2009/07/16 21:24:40 dgp Exp $ */ #include "tclInt.h" @@ -1814,7 +1814,7 @@ InterpProcNR2( Proc *procPtr = iPtr->varFramePtr->procPtr; CallFrame *freePtr; Tcl_Obj *procNameObj = data[0]; - ProcErrorProc *errorProc = data[1]; + ProcErrorProc *errorProc = (ProcErrorProc *)data[1]; if (TCL_DTRACE_PROC_RETURN_ENABLED()) { int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; diff --git a/generic/tclScan.c b/generic/tclScan.c index 07bbedd..47fa025 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclScan.c,v 1.31 2009/02/10 23:09:04 nijtmans Exp $ + * RCS: @(#) $Id: tclScan.c,v 1.32 2009/07/16 21:24:40 dgp Exp $ */ #include "tclInt.h" @@ -964,7 +964,7 @@ Tcl_ScanObjCmd( if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN if (objPtr->typePtr == &tclDoubleType) { - dValue = objPtr->internalRep.doubleValue; + dvalue = objPtr->internalRep.doubleValue; } else #endif { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 5db3d66..fbe4105 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.37 2009/01/09 11:21:46 dkf Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.38 2009/07/16 21:24:40 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -68,6 +68,14 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); #if defined(__sun) && defined(__i386) && !defined(__GNUC__) #include <sunmath.h> #endif + +/* + * MIPS floating-point units need special settings in control registers + * to use gradual underflow as we expect. + */ +#if defined(__mips) +#include <sys/fpu.h> +#endif /* * HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN. * Everyone else uses 7ff8000000000000. (Why, HP, why?) @@ -2166,6 +2174,14 @@ TclInitDoubleConversion(void) } bitwhack; #endif +#if defined(__mips) + union fpc_csr mipsCR; + + mipsCR.fc_word = get_fpc_csr(); + mipsCR.fc_struct.flush = 0; + set_fpc_csr(mipsCR.fc_word); +#endif + /* * Initialize table of powers of 10 expressed as wide integers. */ diff --git a/generic/tclVar.c b/generic/tclVar.c index d87cdf9..eb7cf53 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.178 2009/03/24 09:30:07 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.179 2009/07/16 21:24:40 dgp Exp $ */ #include "tclInt.h" @@ -516,12 +516,15 @@ TclObjLookupVarEx( const Tcl_ObjType *typePtr = part1Ptr->typePtr; const char *errMsg = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; +#if ENABLE_NS_VARNAME_CACHING Namespace *nsPtr; +#endif const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; char *newPart2 = NULL; *arrayPtrPtr = NULL; +#if ENABLE_NS_VARNAME_CACHING if (varFramePtr) { nsPtr = varFramePtr->nsPtr; } else { @@ -532,6 +535,7 @@ TclObjLookupVarEx( nsPtr = NULL; } +#endif if (typePtr == &localVarNameType) { int localIndex; |