summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-10-19 18:39:58 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-10-19 18:39:58 (GMT)
commit91a8a2453afae40f8b0ea245f5ad809cc58cb829 (patch)
tree16181e123a2aae36dc453accc1839aba7fa497d5
parentab736a53a85538ce60e2cdc6ec235ed0f5edc91f (diff)
downloadtcl-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:
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclClock.c10
-rw-r--r--generic/tclCmdIL.c56
-rw-r--r--generic/tclCompCmds.c51
-rw-r--r--generic/tclDictObj.c169
-rw-r--r--generic/tclExecute.c32
-rw-r--r--generic/tclLiteral.c21
-rw-r--r--generic/tclParseExpr.c64
-rw-r--r--generic/tclScan.c203
-rw-r--r--generic/tclUtil.c57
-rw-r--r--generic/tclVar.c326
11 files changed, 31 insertions, 971 deletions
diff --git a/ChangeLog b/ChangeLog
index eae470d..93f7912 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2005-10-19 Don Porter <dgp@users.sourceforge.net>
+
+ * 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:
+
2005-10-19 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
* generic/tclIORChan.c: General cleanup, removing checks that are
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
/*
*----------------------------------------------------------------------