summaryrefslogtreecommitdiffstats
path: root/generic/tclIndexObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r--generic/tclIndexObj.c168
1 files changed, 99 insertions, 69 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index b17b224..1f600c5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -5,9 +5,9 @@
* to lookup a keyword in a table of valid values and cache the index of
* the matching entry. Also provides table-based argv/argc processing.
*
- * Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 2006 Sam Bromley.
+ * Copyright © 1990-1994 The Regents of the University of California.
+ * Copyright © 1997 Sun Microsystems, Inc.
+ * Copyright © 2006 Sam Bromley.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -25,13 +25,13 @@ static int GetIndexFromObjList(Tcl_Interp *interp,
static void UpdateStringOfIndex(Tcl_Obj *objPtr);
static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void FreeIndex(Tcl_Obj *objPtr);
-static int PrefixAllObjCmd(ClientData clientData,
+static int PrefixAllObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int PrefixLongestObjCmd(ClientData clientData,
+static int PrefixLongestObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int PrefixMatchObjCmd(ClientData clientData,
+static int PrefixMatchObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void PrintUsage(Tcl_Interp *interp,
@@ -100,6 +100,7 @@ typedef struct {
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetIndexFromObj
int
Tcl_GetIndexFromObj(
@@ -113,6 +114,7 @@ Tcl_GetIndexFromObj(
int flags, /* 0 or TCL_EXACT */
int *indexPtr) /* Place to store resulting integer index. */
{
+ if (!(flags & TCL_INDEX_TEMP_TABLE)) {
/*
* See if there is a valid cached result from a previous lookup (doing the
@@ -120,8 +122,10 @@ Tcl_GetIndexFromObj(
* the common case where the result is cached).
*/
- if (objPtr->typePtr == &indexType) {
- IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &indexType);
+
+ if (irPtr) {
+ IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
/*
* Here's hoping we don't get hit by unfortunate packing constraints
@@ -134,9 +138,11 @@ Tcl_GetIndexFromObj(
return TCL_OK;
}
}
+ }
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
msg, flags, indexPtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -210,13 +216,8 @@ GetIndexFromObjList(
tablePtr[objc] = NULL;
result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
- sizeof(char *), msg, flags, indexPtr);
+ sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);
- /*
- * The internal rep must be cleared since tablePtr will go away.
- */
-
- TclFreeIntRep(objPtr);
ckfree(tablePtr);
return result;
@@ -234,11 +235,12 @@ GetIndexFromObjList(
* Results:
* If the value of objPtr is identical to or a unique abbreviation for
* one of the entries in tablePtr, then the return value is TCL_OK and
- * the index of the matching entry is stored at *indexPtr. If there isn't
- * a proper match, then TCL_ERROR is returned and an error message is
- * left in interp's result (unless interp is NULL). The msg argument is
- * used in the error message; for example, if msg has the value "option"
- * then the error message will say something like 'bad option "foo": must
+ * the index of the matching entry is stored at *indexPtr
+ * (unless indexPtr is NULL). If there isn't a proper match, then
+ * TCL_ERROR is returned and an error message is left in interp's
+ * result (unless interp is NULL). The msg argument is used in the
+ * error message; for example, if msg has the value "option" then
+ * the error message will say something like 'bad option "foo": must
* be ...'
*
* Side effects:
@@ -248,6 +250,7 @@ GetIndexFromObjList(
*----------------------------------------------------------------------
*/
+#undef Tcl_GetIndexFromObjStruct
int
Tcl_GetIndexFromObjStruct(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -260,8 +263,8 @@ Tcl_GetIndexFromObjStruct(
int offset, /* The number of bytes between entries */
const char *msg, /* Identifying word to use in error
* messages. */
- int flags, /* 0 or TCL_EXACT */
- int *indexPtr) /* Place to store resulting integer index. */
+ int flags, /* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_INDEX_NULL_OK */
+ void *indexPtr) /* Place to store resulting index. */
{
int index, idx, numAbbrev;
const char *key, *p1;
@@ -269,6 +272,7 @@ Tcl_GetIndexFromObjStruct(
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
+ const Tcl_ObjInternalRep *irPtr;
/* Protect against invalid values, like -1 or 0. */
if (offset < (int)sizeof(char *)) {
@@ -278,15 +282,18 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (objPtr && (objPtr->typePtr == &indexType)) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
+ irPtr = TclFetchInternalRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if ((indexRep->tablePtr == tablePtr)
&& (indexRep->offset == offset)
&& (indexRep->index >= 0)) {
- *indexPtr = indexRep->index;
- return TCL_OK;
+ index = indexRep->index;
+ goto uncachedDone;
}
}
+ }
/*
* Lookup the value of the object in the table. Accept unique
@@ -297,6 +304,9 @@ Tcl_GetIndexFromObjStruct(
index = -1;
numAbbrev = 0;
+ if (!*key && (flags & TCL_INDEX_NULL_OK)) {
+ goto uncachedDone;
+ }
/*
* Scan the table looking for one of:
* - An exact match (always preferred)
@@ -341,21 +351,41 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (objPtr && (index >= 0)) {
- if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
- } else {
- TclFreeIntRep(objPtr);
- indexRep = ckalloc(sizeof(IndexRep));
- objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- objPtr->typePtr = &indexType;
- }
- indexRep->tablePtr = (void *) tablePtr;
- indexRep->offset = offset;
- indexRep->index = index;
+ if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) {
+ irPtr = TclFetchInternalRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
+ } else {
+ Tcl_ObjInternalRep ir;
+
+ indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
+ ir.twoPtrValue.ptr1 = indexRep;
+ Tcl_StoreInternalRep(objPtr, &indexType, &ir);
+ }
+ indexRep->tablePtr = (void *) tablePtr;
+ indexRep->offset = offset;
+ indexRep->index = index;
}
- *indexPtr = index;
+ uncachedDone:
+ if (indexPtr != NULL) {
+ if ((flags>>8) & (int)~sizeof(int)) {
+ if ((flags>>8) == sizeof(uint64_t)) {
+ *(uint64_t *)indexPtr = index;
+ return TCL_OK;
+ } else if ((flags>>8) == sizeof(uint32_t)) {
+ *(uint32_t *)indexPtr = index;
+ return TCL_OK;
+ } else if ((flags>>8) == sizeof(uint16_t)) {
+ *(uint16_t *)indexPtr = index;
+ return TCL_OK;
+ } else if ((flags>>8) == sizeof(uint8_t)) {
+ *(uint8_t *)indexPtr = index;
+ return TCL_OK;
+ }
+ }
+ *(int *)indexPtr = index;
+ }
return TCL_OK;
error:
@@ -381,7 +411,7 @@ Tcl_GetIndexFromObjStruct(
*entryPtr, NULL);
entryPtr = NEXT_ENTRY(entryPtr, offset);
while (*entryPtr != NULL) {
- if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
+ if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_INDEX_NULL_OK)) {
Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
" or ", *entryPtr, NULL);
} else if (**entryPtr) {
@@ -390,6 +420,9 @@ Tcl_GetIndexFromObjStruct(
}
entryPtr = NEXT_ENTRY(entryPtr, offset);
}
+ if ((flags & TCL_INDEX_NULL_OK)) {
+ Tcl_AppendStringsToObj(resultPtr, ", or \"\"", NULL);
+ }
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
@@ -418,16 +451,10 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
- IndexRep *indexRep = (IndexRep *)objPtr->internalRep.twoPtrValue.ptr1;
- char *buf;
- unsigned len;
+ IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
- len = strlen(indexStr);
- buf = ckalloc(len + 1);
- memcpy(buf, indexStr, len+1);
- objPtr->bytes = buf;
- objPtr->length = len;
+ Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
}
/*
@@ -453,12 +480,14 @@ DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- IndexRep *srcIndexRep = (IndexRep *)srcPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));
- memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
- dupPtr->typePtr = &indexType;
+ memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+ sizeof(IndexRep));
+
+ ir.twoPtrValue.ptr1 = dupIndexRep;
+ Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
}
/*
@@ -482,7 +511,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ ckfree(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -539,7 +568,7 @@ TclInitPrefixCmd(
static int
PrefixMatchObjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -632,7 +661,7 @@ PrefixMatchObjCmd(
}
Tcl_ListObjAppendElement(interp, errorPtr,
Tcl_NewStringObj("-code", 5));
- Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewWideIntObj(result));
return Tcl_SetReturnOptions(interp, errorPtr);
}
@@ -663,7 +692,7 @@ PrefixMatchObjCmd(
static int
PrefixAllObjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -682,10 +711,10 @@ PrefixAllObjCmd(
return result;
}
resultPtr = Tcl_NewListObj(0, NULL);
- string = Tcl_GetStringFromObj(objv[2], &length);
+ string = TclGetStringFromObj(objv[2], &length);
for (t = 0; t < tableObjc; t++) {
- elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+ elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
/*
* A prefix cannot match if it is longest.
@@ -720,7 +749,7 @@ PrefixAllObjCmd(
static int
PrefixLongestObjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -738,13 +767,13 @@ PrefixLongestObjCmd(
if (result != TCL_OK) {
return result;
}
- string = Tcl_GetStringFromObj(objv[2], &length);
+ string = TclGetStringFromObj(objv[2], &length);
resultString = NULL;
resultLength = 0;
for (t = 0; t < tableObjc; t++) {
- elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+ elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
/*
* First check if the prefix string matches the element. A prefix
@@ -784,7 +813,7 @@ PrefixLongestObjCmd(
* Adjust in case we stopped in the middle of a UTF char.
*/
- resultLength = TclUtfPrev(&resultString[i+1],
+ resultLength = Tcl_UtfPrev(&resultString[i+1],
resultString) - resultString;
break;
}
@@ -850,7 +879,7 @@ Tcl_WrongNumArgs(
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
- Interp *iPtr = (Interp *) interp;
+ Interp *iPtr = (Interp *)interp;
const char *elementStr;
/*
@@ -921,10 +950,10 @@ Tcl_WrongNumArgs(
/*
* Add the element, quoting it if necessary.
*/
+ const Tcl_ObjInternalRep *irPtr;
- if (origObjv[i]->typePtr == &indexType) {
- IndexRep *indexRep =
- origObjv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
+ IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
@@ -970,9 +999,10 @@ Tcl_WrongNumArgs(
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
+ const Tcl_ObjInternalRep *irPtr;
- if (objv[i]->typePtr == &indexType) {
- IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
+ IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
} else {
@@ -1109,7 +1139,7 @@ Tcl_ParseArgsObjv(
curArg = objv[srcIndex];
srcIndex++;
objc--;
- str = Tcl_GetStringFromObj(curArg, &length);
+ str = TclGetStringFromObj(curArg, &length);
if (length > 0) {
c = str[1];
} else {
@@ -1416,7 +1446,7 @@ TclGetCompletionCodeFromObj(
"ok", "error", "return", "break", "continue", NULL
};
- if ((value->typePtr != &indexType)
+ if (!TclHasInternalRep(value, &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-16 03:47:22 (GMT)