diff options
author | dgp <dgp@users.sourceforge.net> | 2005-10-19 18:39:58 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-10-19 18:39:58 (GMT) |
commit | 91a8a2453afae40f8b0ea245f5ad809cc58cb829 (patch) | |
tree | 16181e123a2aae36dc453accc1839aba7fa497d5 /generic | |
parent | ab736a53a85538ce60e2cdc6ec235ed0f5edc91f (diff) | |
download | tcl-91a8a2453afae40f8b0ea245f5ad809cc58cb829.zip tcl-91a8a2453afae40f8b0ea245f5ad809cc58cb829.tar.gz tcl-91a8a2453afae40f8b0ea245f5ad809cc58cb829.tar.bz2 |
* generic/tclClock.c: Removed some dead code.
* generic/tclCmdIL.c:
* generic/tclCompCmds.c:
* generic/tclDictObj.c:
* generic/tclExecute.c:
* generic/tclLiteral.c:
* generic/tclParseExpr.c:
* generic/tclScan.c:
* generic/tclUtil.c:
* generic/tclVar.c:
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclClock.c | 10 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 56 | ||||
-rw-r--r-- | generic/tclCompCmds.c | 51 | ||||
-rw-r--r-- | generic/tclDictObj.c | 169 | ||||
-rw-r--r-- | generic/tclExecute.c | 32 | ||||
-rw-r--r-- | generic/tclLiteral.c | 21 | ||||
-rw-r--r-- | generic/tclParseExpr.c | 64 | ||||
-rw-r--r-- | generic/tclScan.c | 203 | ||||
-rw-r--r-- | generic/tclUtil.c | 57 | ||||
-rw-r--r-- | generic/tclVar.c | 326 |
10 files changed, 18 insertions, 971 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c index 9134ab4..c5a851e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.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: tclClock.c,v 1.40 2005/08/12 23:55:28 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.41 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -407,17 +407,9 @@ TclClockClicksObjCmd(clientData, interp, objc, objv) now.sec * 1000 + now.usec / 1000 ) ); break; case CLICKS_NATIVE: -#if 0 - /* - * The following code will be used once this is incorporated - * into Tcl. But TEA bugs prevent it for right now. :( - * So we fall through this case and return the microseconds - * instead. - */ Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) TclpGetClicks())); break; -#endif case CLICKS_MICROS: Tcl_GetTime(&now); Tcl_SetObjResult(interp, Tcl_NewWideIntObj( diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c7a9d83..464ac42 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.82 2005/10/08 14:42:44 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.83 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -301,11 +301,6 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { -#if 0 - long incrAmount = 1; - Tcl_WideInt wideIncrAmount; - int isWide = 0; -#endif Tcl_Obj *newValuePtr, *incrPtr; if ((objc != 2) && (objc != 3)) { @@ -313,54 +308,6 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } -#if 0 - /* - * Calculate the amount to increment by. - */ - - if (objc == 3) { - /* - * Need to be a bit cautious to ensure that [expr]-like rules are - * enforced for interpretation of wide integers, despite the fact that - * the underlying API itself is a 'long' only one. - */ - - if (objv[2]->typePtr == &tclIntType) { - incrAmount = objv[2]->internalRep.longValue; - isWide = 0; - } else if (objv[2]->typePtr == &tclWideIntType) { - wideIncrAmount = objv[2]->internalRep.wideValue; - isWide = 1; - } else { - if (Tcl_GetWideIntFromObj(interp, objv[2], - &wideIncrAmount) != TCL_OK) { - Tcl_AddErrorInfo(interp, "\n (reading increment)"); - return TCL_ERROR; - } - if ((wideIncrAmount <= Tcl_LongAsWide(LONG_MAX)) - && (wideIncrAmount >= Tcl_LongAsWide(LONG_MIN))) { - incrAmount = Tcl_WideAsLong(wideIncrAmount); - objv[2]->typePtr = &tclIntType; - objv[2]->internalRep.longValue = incrAmount; - isWide = 0; - } else { - isWide = 1; - } - } - } - - /* - * Increment the variable's value. - */ - - if (isWide) { - newValuePtr = TclIncrWideVar2(interp, objv[1], (Tcl_Obj *) NULL, - wideIncrAmount, TCL_LEAVE_ERR_MSG); - } else { - newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, - incrAmount, TCL_LEAVE_ERR_MSG); - } -#else if (objc == 3) { incrPtr = objv[2]; } else { @@ -371,7 +318,6 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) incrPtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(incrPtr); -#endif if (newValuePtr == NULL) { return TCL_ERROR; } diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 684d994..6ed09ca 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.79 2005/10/10 20:28:00 msofer Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.80 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -622,22 +622,6 @@ TclCompileDictCmd(interp, parsePtr, envPtr) word = incrTokenPtr[1].start; numBytes = incrTokenPtr[1].size; -#if 0 - /* - * Note there is a danger that modifying the string could have - * undesirable side effects. In this case, TclLooksLikeInt has no - * dependencies on shared strings so we should be safe. - */ - - if (!TclLooksLikeInt(word, numBytes)) { - return TCL_ERROR; - } -#endif - - /* - * Now try to really parse the number. - */ - intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = Tcl_GetIntFromObj(NULL, intObj, &incrAmount); @@ -1970,27 +1954,14 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { CONST char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; -#if 0 - /* - * Note there is a danger that modifying the string could have - * undesirable side effects. In this case, TclLooksLikeInt has - * no dependencies on shared strings so we should be safe. - */ - - if (TclLooksLikeInt(word, numBytes)) { -#endif - int code; - Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); - Tcl_IncrRefCount(intObj); - code = Tcl_GetIntFromObj(NULL, intObj, &immValue); - Tcl_DecrRefCount(intObj); - if ((code == TCL_OK) - && (-127 <= immValue) && (immValue <= 127)) { - haveImmValue = 1; - } -#if 0 + int code; + Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); + Tcl_IncrRefCount(intObj); + code = Tcl_GetIntFromObj(NULL, intObj, &immValue); + Tcl_DecrRefCount(intObj); + if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { + haveImmValue = 1; } -#endif if (!haveImmValue) { PushLiteral(envPtr, word, numBytes); } @@ -2293,11 +2264,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) varTokenPtr = TokenAfter(parsePtr->tokenPtr); - if ((numWords == 3) && (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) -#if 0 - && TclLooksLikeInt(varTokenPtr[1].start, varTokenPtr[1].size) -#endif - ) { + if ((numWords == 3) && (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) { Tcl_Obj *tmpObj; int idx, result; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index aa88d69..05008cb 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.36 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.37 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -1874,180 +1874,14 @@ DictIncrCmd(interp, objc, objv) int objc; Tcl_Obj *CONST *objv; { -#if 0 - Tcl_Obj *dictPtr, *resultPtr; - int result, isWide = 0; - long incrValue = 1; - Tcl_WideInt wideIncrValue = 0; - int allocatedDict = 0; -#else int code = TCL_OK; Tcl_Obj *dictPtr, *valuePtr = NULL; -#endif if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?"); return TCL_ERROR; } -#if 0 - if (objc == 5) { - if (objv[4]->typePtr == &tclIntType) { - incrValue = objv[4]->internalRep.longValue; - } else if (objv[4]->typePtr == &tclWideIntType) { - wideIncrValue = objv[4]->internalRep.wideValue; - isWide = 1; - } else { - result = Tcl_GetWideIntFromObj(interp, objv[4], &wideIncrValue); - if (result != TCL_OK) { - return result; - } - if (wideIncrValue <= Tcl_LongAsWide(LONG_MAX) - && wideIncrValue >= Tcl_LongAsWide(LONG_MIN)) { - incrValue = Tcl_WideAsLong(wideIncrValue); - objv[4]->typePtr = &tclIntType; - } else { - isWide = 1; - } - } - } - - dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); - if (dictPtr == NULL) { - allocatedDict = 1; - dictPtr = Tcl_NewDictObj(); - if (isWide) { - valuePtr = Tcl_NewWideIntObj(wideIncrValue); - } else { - valuePtr = Tcl_NewLongObj(incrValue); - } - Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); - } else { - long lValue; - Tcl_WideInt wValue; - - if (Tcl_IsShared(dictPtr)) { - allocatedDict = 1; - dictPtr = Tcl_DuplicateObj(dictPtr); - } - - if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { - if (allocatedDict) { - TclDecrRefCount(dictPtr); - } - return TCL_ERROR; - } - if (valuePtr == NULL) { - if (isWide) { - valuePtr = Tcl_NewWideIntObj(wideIncrValue); - } else { - valuePtr = Tcl_NewLongObj(incrValue); - } - } else if (valuePtr->typePtr == &tclWideIntType) { - Tcl_GetWideIntFromObj(NULL, valuePtr, &wValue); - if (Tcl_IsShared(valuePtr)) { - if (isWide) { - valuePtr = Tcl_NewWideIntObj(wValue + wideIncrValue); - } else { - valuePtr = Tcl_NewWideIntObj(wValue + incrValue); - } - } else { - if (isWide) { - Tcl_SetWideIntObj(valuePtr, wValue + wideIncrValue); - } else { - Tcl_SetWideIntObj(valuePtr, wValue + incrValue); - } - if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); - } - goto valueAlreadyInDictionary; - } - } else if (valuePtr->typePtr == &tclIntType) { - Tcl_GetLongFromObj(NULL, valuePtr, &lValue); - if (Tcl_IsShared(valuePtr)) { - if (isWide) { - valuePtr = Tcl_NewWideIntObj(lValue + wideIncrValue); - } else { - valuePtr = Tcl_NewLongObj(lValue + incrValue); - } - } else { - if (isWide) { - Tcl_SetWideIntObj(valuePtr, lValue + wideIncrValue); - } else { - Tcl_SetLongObj(valuePtr, lValue + incrValue); - } - if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); - } - goto valueAlreadyInDictionary; - } - } else { - /* - * Note that these operations on wide ints should work - * fine where they are the same as normal longs, though - * the compiler might complain about trivially satisifed - * tests. - */ - result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue); - if (result != TCL_OK) { - if (allocatedDict) { - TclDecrRefCount(dictPtr); - } - return result; - } - /* - * Determine if we should have got a standard long instead. - */ - if (Tcl_IsShared(valuePtr)) { - if (isWide) { - valuePtr = Tcl_NewWideIntObj(wValue + wideIncrValue); - } else if (wValue >= LONG_MIN && wValue <= LONG_MAX) { - /* - * Convert the type... - */ - Tcl_GetLongFromObj(NULL, valuePtr, &lValue); - valuePtr = Tcl_NewLongObj(lValue + incrValue); - } else { - valuePtr = Tcl_NewWideIntObj(wValue + incrValue); - } - } else { - if (isWide) { - Tcl_SetWideIntObj(valuePtr, wValue + wideIncrValue); - } else if (wValue >= LONG_MIN && wValue <= LONG_MAX) { - Tcl_SetLongObj(valuePtr, - Tcl_WideAsLong(wValue) + incrValue); - } else { - Tcl_SetWideIntObj(valuePtr, wValue + incrValue); - } - if (dictPtr->bytes != NULL) { - Tcl_InvalidateStringRep(dictPtr); - } - goto valueAlreadyInDictionary; - } - } - if (Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr) != TCL_OK) { - /* - * This shouldn't happen since dictPtr is known - * from above to be a valid dictionary. - */ - if (allocatedDict) { - TclDecrRefCount(dictPtr); - } - TclDecrRefCount(valuePtr); - return TCL_ERROR; - } - } - valueAlreadyInDictionary: - Tcl_IncrRefCount(dictPtr); - resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, - TCL_LEAVE_ERR_MSG); - TclDecrRefCount(dictPtr); - if (resultPtr == NULL) { - return TCL_ERROR; - } - Tcl_SetObjResult(interp, resultPtr); - return TCL_OK; -#else dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); if (dictPtr == NULL) { /* Variable didn't yet exist. Create new dictionary value */ @@ -2107,7 +1941,6 @@ DictIncrCmd(interp, objc, objv) Tcl_SetObjResult(interp, valuePtr); } return code; -#endif } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3f1971f..0287068 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.216 2005/10/19 13:15:14 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.217 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -286,41 +286,11 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from an obj. */ #if 0 -#define FORCE_LONG(objPtr, longVar, wideVar) \ - if ((objPtr)->typePtr == &tclWideIntType) { \ - (longVar) = Tcl_WideAsLong(wideVar); \ - } -#define IS_INTEGER_TYPE(typePtr) \ - ((typePtr) == &tclIntType || (typePtr) == &tclWideIntType || (typePtr) == &tclBignumType) -#define IS_NUMERIC_TYPE(typePtr) \ - (IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType) - #define W0 Tcl_LongAsWide(0) /* * For tracing that uses wide values. */ #define LLD "%" TCL_LL_MODIFIER "d" - -#ifndef TCL_WIDE_INT_IS_LONG -/* - * Extract a double value from a general numeric object. - */ -#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ - if ((typePtr) == &tclIntType) { \ - (doubleVar) = (double) (objPtr)->internalRep.longValue; \ - } else if ((typePtr) == &tclWideIntType) { \ - (doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\ - } else { \ - (doubleVar) = (objPtr)->internalRep.doubleValue; \ - } -#else /* TCL_WIDE_INT_IS_LONG */ -#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr) \ - if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \ - (doubleVar) = (double) (objPtr)->internalRep.longValue; \ - } else { \ - (doubleVar) = (objPtr)->internalRep.doubleValue; \ - } -#endif /* TCL_WIDE_INT_IS_LONG */ #endif /* diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index c4bf5ee..e1d108d 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLiteral.c,v 1.25 2005/07/19 00:09:07 dkf Exp $ + * RCS: @(#) $Id: tclLiteral.c,v 1.26 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -358,25 +358,6 @@ TclRegisterLiteral(envPtr, bytes, length, flags) TclInitStringRep(objPtr, bytes, length); } -#if 0 - if (TclLooksLikeInt(bytes, length)) { - /* - * From here we use the objPtr, because it is NULL terminated - */ - - long n; - char buf[TCL_INTEGER_SPACE]; - - if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) { - TclFormatInt(buf, n); - if (strcmp(objPtr->bytes, buf) == 0) { - objPtr->internalRep.longValue = n; - objPtr->typePtr = &tclIntType; - } - } - } -#endif - #ifdef TCL_COMPILE_DEBUG if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be", diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index d617300..589dd49 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.28 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.29 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -1871,68 +1871,6 @@ GetLexeme(infoPtr) } } -#if 0 -/* - *---------------------------------------------------------------------- - * - * TclParseInteger -- - * - * Scans up to numBytes bytes starting at src, and checks whether the - * leading bytes look like an integer's string representation. - * - * Results: - * Returns 0 if the leading bytes do not look like an integer. - * Otherwise, returns the number of bytes examined that look like an - * integer. This may be less than numBytes if the integer is only the - * leading part of the string. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclParseInteger(string, numBytes) - register CONST char *string;/* The string to examine. */ - register int numBytes; /* Max number of bytes to scan. */ -{ - register CONST char *p = string; - - /* - * Take care of introductory "0x". - */ - - if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) { - int scanned; - Tcl_UniChar ch; - - p += 2; - numBytes -= 2; - scanned = TclParseHex(p, numBytes, &ch); - if (scanned) { - return scanned+2; - } - - /* - * Recognize the 0 as valid integer, but x is left behind. - */ - - return 1; - } - while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */ - numBytes--; p++; - } - if (numBytes == 0) { - return (p - string); - } - if ((*p != '.') && (*p != 'e') && (*p != 'E')) { - return (p - string); - } - return 0; -} -#endif - /* *---------------------------------------------------------------------- * diff --git a/generic/tclScan.c b/generic/tclScan.c index eede9f3..327bc2f 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.19 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclScan.c,v 1.20 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -22,15 +22,6 @@ #define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ #define SCAN_WIDTH 0x8 /* A width value was supplied. */ -#if 0 -#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */ -#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */ -#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */ -#define SCAN_XOK 0x80 /* An 'x' is allowed. */ -#define SCAN_PTOK 0x100 /* Decimal point is allowed. */ -#define SCAN_EXPOK 0x200 /* An exponent is allowed. */ -#endif - #define SCAN_LONGER 0x400 /* Asked for a wide value. */ #define SCAN_BIG 0x800 /* Asked for a bignum value. */ @@ -600,13 +591,6 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) char buf[513]; /* Temporary buffer to hold scanned number * strings before they are passed to * strtoul. */ -#if 0 - int base = 0; - long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL; -#ifndef TCL_WIDE_INT_IS_LONG - Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL; -#endif -#endif if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, @@ -754,57 +738,22 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) case 'd': op = 'i'; parseFlag = TCL_PARSE_DECIMAL_ONLY; -#if 0 - base = 10; - fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; -#endif -#endif break; case 'i': op = 'i'; parseFlag = TCL_PARSE_SCAN_PREFIXES; -#if 0 - base = 0; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; -#endif -#endif break; case 'o': op = 'i'; parseFlag = TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; -#if 0 - base = 8; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif -#endif break; case 'x': op = 'i'; parseFlag = TCL_PARSE_HEXADECIMAL_ONLY; -#if 0 - base = 16; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif -#endif break; case 'u': op = 'i'; flags |= SCAN_UNSIGNED; -#if 0 - base = 10; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif -#endif break; case 'f': @@ -941,155 +890,6 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) /* * Scan an unsigned or signed integer. */ - -#if 0 - if ((width == 0) || (width > sizeof(buf) - 1)) { - width = sizeof(buf) - 1; - } - flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO; - for (end = buf; width > 0; width--) { - switch (*string) { - /* - * The 0 digit has special meaning at the beginning of a - * number. If we are unsure of the base, it indicates that - * we are in base 8 or base 16 (if it is followed by an - * 'x'). - * - * 8.1 - 8.3.4 incorrectly handled 0x... base-16 cases for - * %x by not reading the 0x as the auto-prelude for - * base-16. [Bug #495213] - */ - case '0': - if (base == 0) { - base = 8; - flags |= SCAN_XOK; - } - if (base == 16) { - flags |= SCAN_XOK; - } - if (flags & SCAN_NOZERO) { - flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO); - } else { - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - } - goto addToInt; - - case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - if (base == 0) { - base = 10; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case '8': case '9': - if (base == 0) { - base = 10; - } - if (base <= 8) { - break; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case 'A': case 'B': case 'C': - case 'D': case 'E': case 'F': - case 'a': case 'b': case 'c': - case 'd': case 'e': case 'f': - if (base <= 10) { - break; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case '+': case '-': - if (flags & SCAN_SIGNOK) { - flags &= ~SCAN_SIGNOK; - goto addToInt; - } - break; - - case 'x': case 'X': - if ((flags & SCAN_XOK) && (end == buf+1)) { - base = 16; - flags &= ~SCAN_XOK; - goto addToInt; - } - break; - } - - /* - * We got an illegal character so we are done accumulating. - */ - - break; - - addToInt: - /* - * Add the character to the temporary buffer. - */ - - *end++ = *string++; - if (*string == '\0') { - break; - } - } - - /* - * Check to see if we need to back up because we only got a sign - * or a trailing x after a 0. - */ - - if (flags & SCAN_NODIGITS) { - if (*string == '\0') { - underflow = 1; - } - goto done; - } else if (end[-1] == 'x' || end[-1] == 'X') { - end--; - string--; - } - - /* - * Scan the value from the temporary buffer. If we are returning a - * large unsigned value, we have to convert it back to a string - * since Tcl only supports signed values. - */ - - if (!(flags & SCAN_SUPPRESS)) { - *end = '\0'; -#ifndef TCL_WIDE_INT_IS_LONG - if (flags & SCAN_LONGER) { - wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base); - if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { - /* INTL: ISO digit */ - sprintf(buf, "%" TCL_LL_MODIFIER "u", - (Tcl_WideUInt)wideValue); - objPtr = Tcl_NewStringObj(buf, -1); - } else { - objPtr = Tcl_NewWideIntObj(wideValue); - } - } else { -#endif /* !TCL_WIDE_INT_IS_LONG */ - value = (long) (*fn)(buf, NULL, base); - if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ - objPtr = Tcl_NewStringObj(buf, -1); - } else if ((flags & SCAN_LONGER) - || (unsigned long) value > UINT_MAX) { - objPtr = Tcl_NewLongObj(value); - } else { - objPtr = Tcl_NewIntObj(value); - } -#ifndef TCL_WIDE_INT_IS_LONG - } -#endif - Tcl_IncrRefCount(objPtr); - objs[objIndex++] = objPtr; - } - - break; -#else objPtr = Tcl_NewLongObj(0); Tcl_IncrRefCount(objPtr); if (width == 0) { @@ -1137,7 +937,6 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) } objs[objIndex++] = objPtr; break; -#endif case 'f': /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 7e9e35a..f7aeaa5 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.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: tclUtil.c,v 1.66 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.67 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -2157,61 +2157,6 @@ TclNeedSpace(start, end) } return 1; } -#if 0 - -/* - *---------------------------------------------------------------------- - * - * TclLooksLikeInt -- - * - * This function decides whether the leading characters of a string look - * like an integer or something else (such as a floating-point number or - * string). - * - * Results: - * The return value is 1 if the leading characters of p look like a valid - * Tcl integer. If they look like a floating-point number (e.g. "e01" or - * "2.4"), or if they don't look like a number at all, then 0 is - * returned. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclLooksLikeInt(bytes, length) - register CONST char *bytes; /* Points to first byte of the string. */ - int length; /* Number of bytes in the string. If < 0 bytes - * up to the first null byte are considered - * (if they may appear in an integer). */ -{ - register CONST char *p; - - if ((bytes == NULL) && (length > 0)) { - Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length); - } - - if (length < 0) { - length = (bytes? strlen(bytes) : 0); - } - - p = bytes; - while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ - length--; p++; - } - if (length == 0) { - return 0; - } - if ((*p == '+') || (*p == '-')) { - p++; - length--; - } - - return (0 != TclParseInteger(p, length)); -} -#endif /* *---------------------------------------------------------------------- diff --git a/generic/tclVar.c b/generic/tclVar.c index eddeb42..306ecd1 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,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.110 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.111 2005/10/19 18:39:58 dgp Exp $ */ #include "tclInt.h" @@ -1718,171 +1718,6 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) } return resultPtr; } -#if 0 - -/* - *---------------------------------------------------------------------- - * - * TclIncrVar2 -- - * - * Given a two-part variable name, which may refer either to a scalar - * variable or an element of an array, increment the Tcl object value of - * the variable by a specified amount. - * - * Results: - * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a - * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in the - * interpreter's result. - * - * Side effects: - * The value of the given variable is incremented by the specified - * amount. If either the array or the entry didn't exist then a new - * variable is created. The ref count for the returned object is _not_ - * incremented to reflect the returned reference; if you want to keep a - * reference to the object you must increment its ref count yourself. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to - * be found. */ - Tcl_Obj *part1Ptr; /* Points to an object holding the name of an - * array (if part2 is non-NULL) or the name of - * a variable. */ - Tcl_Obj *part2Ptr; /* If non-null, points to an object holding - * the name of an element in the array - * part1Ptr. */ - long incrAmount; /* Amount to be added to variable. */ - int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Var *varPtr, *arrayPtr; - char *part1, *part2; - - part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); - - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", - 0, 1, &arrayPtr); - if (varPtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); - return NULL; - } - return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, - incrAmount, flags); -} - -/* - *---------------------------------------------------------------------- - * - * TclPtrIncrVar -- - * - * Given the pointers to a variable and possible containing array, - * increment the Tcl object value of the variable by a specified amount. - * - * Results: - * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a - * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in the - * interpreter's result. - * - * Side effects: - * The value of the given variable is incremented by the specified - * amount. If either the array or the entry didn't exist then a new - * variable is created. The ref count for the returned object is _not_ - * incremented to reflect the returned reference; if you want to keep a - * reference to the object you must increment its ref count yourself. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to - * be found. */ - Var *varPtr; - Var *arrayPtr; - CONST char *part1; /* Points to an object holding the name of an - * array (if part2 is non-NULL) or the name of - * a variable. */ - CONST char *part2; /* If non-null, points to an object holding - * the name of an element in the array - * part1Ptr. */ - CONST long incrAmount; /* Amount to be added to variable. */ - CONST int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - register Tcl_Obj *varValuePtr; - int createdNewObj; /* Set 1 if var's value object is shared so we - * must increment a copy (i.e. copy on - * write). */ - long i; - - varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); - - if (varValuePtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); - return NULL; - } - - /* - * Increment the variable's value. If the object is unshared we can modify - * it directly, otherwise we must create a new copy to modify: this is - * "copy on write". Then free the variable's old string representation, if - * any, since it will no longer be valid. - */ - - createdNewObj = 0; - if (Tcl_IsShared(varValuePtr)) { - varValuePtr = Tcl_DuplicateObj(varValuePtr); - createdNewObj = 1; - } - if (varValuePtr->typePtr == &tclWideIntType) { - Tcl_WideInt wide; - TclGetWide(wide,varValuePtr); - TclSetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); - } else if (varValuePtr->typePtr == &tclIntType) { - i = varValuePtr->internalRep.longValue; - TclSetIntObj(varValuePtr, i + incrAmount); - } else { - /* - * Not an integer or wide internal-rep... - */ - - Tcl_WideInt wide; - if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { - if (createdNewObj) { - TclDecrRefCount(varValuePtr); /* free unneeded copy */ - } - return NULL; - } - if (wide <= Tcl_LongAsWide(LONG_MAX) - && wide >= Tcl_LongAsWide(LONG_MIN)) { - TclSetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount); - } else { - TclSetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount)); - } - } - - /* - * Store the variable's new value and run any write traces. - */ - - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - varValuePtr, flags); -} -#endif /* *---------------------------------------------------------------------- @@ -2008,165 +1843,6 @@ TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1, part2, incrPtr, flags) Tcl_DecrRefCount(varValuePtr); return newValuePtr; } -#if 0 - -/* - *---------------------------------------------------------------------- - * - * TclIncrWideVar2 -- - * - * Given a two-part variable name, which may refer either to a scalar - * variable or an element of an array, increment the Tcl object value of - * the variable by a specified amount. - * - * Results: - * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a - * clash in array usage, or an error occurs while executing variable - * traces, then NULL is returned and a message will be left in the - * interpreter's result. - * - * Side effects: - * The value of the given variable is incremented by the specified - * amount. If either the array or the entry didn't exist then a new - * variable is created. The ref count for the returned object is _not_ - * incremented to reflect the returned reference; if you want to keep a - * reference to the object you must increment its ref count yourself. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to - * be found. */ - Tcl_Obj *part1Ptr; /* Points to an object holding the name of an - * array (if part2 is non-NULL) or the name of - * a variable. */ - Tcl_Obj *part2Ptr; /* If non-null, points to an object holding - * the name of an element in the array - * part1Ptr. */ - Tcl_WideInt incrAmount; /* Amount to be added to variable. */ - int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Var *varPtr, *arrayPtr; - char *part1, *part2; - - part1 = TclGetString(part1Ptr); - part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); - - varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", - 0, 1, &arrayPtr); - if (varPtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); - return NULL; - } - return TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, - incrAmount, flags); -} - -/* - *---------------------------------------------------------------------- - * - * TclPtrIncrWideVar -- - * - * Given the pointers to a variable and possible containing array, - * increment the Tcl object value of the variable by a specified amount. - * - * Results: - * Returns a pointer to the Tcl_Obj holding the new value of the - * variable. If the specified variable doesn't exist, or there is a clash - * in array usage, or an error occurs while executing variable traces, - * then NULL is returned and a message will be left in the interpreter's - * result. - * - * Side effects: - * The value of the given variable is incremented by the specified - * amount. If either the array or the entry didn't exist then a new - * variable is created. The ref count for the returned object is _not_ - * incremented to reflect the returned reference; if you want to keep a - * reference to the object you must increment its ref count yourself. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to - * be found. */ - Var *varPtr; - Var *arrayPtr; - CONST char *part1; /* Points to an object holding the name of an - * array (if part2 is non-NULL) or the name of - * a variable. */ - CONST char *part2; /* If non-null, points to an object holding - * the name of an element in the array - * part1Ptr. */ - CONST Tcl_WideInt incrAmount; - /* Amount to be added to variable. */ - CONST int flags; /* Various flags that tell how to incr value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - register Tcl_Obj *varValuePtr; - int createdNewObj; /* Set 1 if var's value object is shared so we - * must increment a copy (i.e. copy on - * write). */ - Tcl_WideInt wide; - - varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); - - if (varValuePtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); - return NULL; - } - - /* - * Increment the variable's value. If the object is unshared we can modify - * it directly, otherwise we must create a new copy to modify: this is - * "copy on write". Then free the variable's old string representation, if - * any, since it will no longer be valid. - */ - - createdNewObj = 0; - if (Tcl_IsShared(varValuePtr)) { - varValuePtr = Tcl_DuplicateObj(varValuePtr); - createdNewObj = 1; - } - if (varValuePtr->typePtr == &tclWideIntType) { - TclGetWide(wide, varValuePtr); - TclSetWideIntObj(varValuePtr, wide + incrAmount); - } else if (varValuePtr->typePtr == &tclIntType) { - long i = varValuePtr->internalRep.longValue; - TclSetWideIntObj(varValuePtr, Tcl_LongAsWide(i) + incrAmount); - } else { - /* - * Not an integer or wide internal-rep... - */ - - if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { - if (createdNewObj) { - TclDecrRefCount(varValuePtr); /* free unneeded copy */ - } - return NULL; - } - TclSetWideIntObj(varValuePtr, wide + incrAmount); - } - - /* - * Store the variable's new value and run any write traces. - */ - - return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, - varValuePtr, flags); -} -#endif /* *---------------------------------------------------------------------- |