summaryrefslogtreecommitdiffstats
path: root/generic/tclIndexObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r--generic/tclIndexObj.c144
1 files changed, 83 insertions, 61 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 48ebb69..b564add 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -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,
@@ -73,7 +73,7 @@ typedef struct {
#define NEXT_ENTRY(table, offset) \
(&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
- STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
+ (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "")
/*
*----------------------------------------------------------------------
@@ -106,7 +106,7 @@ int
Tcl_GetIndexFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
- const char *const*tablePtr, /* Array of strings to compare against the
+ const char *const *tablePtr, /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
const char *msg, /* Identifying word to use in error
@@ -122,7 +122,7 @@ Tcl_GetIndexFromObj(
* the common case where the result is cached).
*/
- const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
@@ -132,7 +132,7 @@ Tcl_GetIndexFromObj(
* on odd platforms like a Cray PVP...
*/
- if (indexRep->tablePtr == (void *) tablePtr
+ if (indexRep->tablePtr == (void *)tablePtr
&& indexRep->offset == sizeof(char *)) {
*indexPtr = indexRep->index;
return TCL_OK;
@@ -190,7 +190,7 @@ GetIndexFromObjList(
* of the code there. This is a bit ineffiecient but simpler.
*/
- result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv);
+ result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv);
if (result != TCL_OK) {
return result;
}
@@ -235,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:
@@ -249,6 +250,7 @@ GetIndexFromObjList(
*----------------------------------------------------------------------
*/
+#undef Tcl_GetIndexFromObjStruct
int
Tcl_GetIndexFromObjStruct(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -261,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;
@@ -270,7 +272,7 @@ Tcl_GetIndexFromObjStruct(
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
- const Tcl_ObjIntRep *irPtr;
+ const Tcl_ObjInternalRep *irPtr;
/* Protect against invalid values, like -1 or 0. */
if (offset < (int)sizeof(char *)) {
@@ -280,13 +282,15 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (!(flags & TCL_INDEX_TEMP_TABLE)) {
- irPtr = TclFetchIntRep(objPtr, &indexType);
+ 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) {
- *indexPtr = indexRep->index;
- return TCL_OK;
+ if ((indexRep->tablePtr == tablePtr)
+ && (indexRep->offset == offset)
+ && (indexRep->index >= 0)) {
+ index = indexRep->index;
+ goto uncachedDone;
}
}
}
@@ -296,10 +300,13 @@ Tcl_GetIndexFromObjStruct(
* abbreviations unless TCL_EXACT is set in flags.
*/
- key = TclGetString(objPtr);
+ key = objPtr ? TclGetString(objPtr) : "";
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)
@@ -307,7 +314,7 @@ Tcl_GetIndexFromObjStruct(
* - Several abbreviations (never allowed, but overridden by exact match)
*/
- for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL;
+ for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL;
entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == '\0') {
@@ -344,23 +351,42 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (!(flags & TCL_INDEX_TEMP_TABLE)) {
- irPtr = TclFetchIntRep(objPtr, &indexType);
+ if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) {
+ irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
- Tcl_ObjIntRep ir;
+ Tcl_ObjInternalRep ir;
indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
- Tcl_StoreIntRep(objPtr, &indexType, &ir);
+ Tcl_StoreInternalRep(objPtr, &indexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
}
- *indexPtr = index;
+ uncachedDone:
+ if (indexPtr != NULL) {
+ flags &= (30-(int)(sizeof(int)<<1));
+ if (flags) {
+ if (flags == sizeof(uint16_t)<<1) {
+ *(uint16_t *)indexPtr = index;
+ return TCL_OK;
+ } else if (flags == (int)(sizeof(uint8_t)<<1)) {
+ *(uint8_t *)indexPtr = index;
+ return TCL_OK;
+ } else if (flags == (int)(sizeof(int64_t)<<1)) {
+ *(int64_t *)indexPtr = index;
+ return TCL_OK;
+ } else if (flags == (int)(sizeof(int32_t)<<1)) {
+ *(int32_t *)indexPtr = index;
+ return TCL_OK;
+ }
+ }
+ *(int *)indexPtr = index;
+ }
return TCL_OK;
error:
@@ -372,7 +398,7 @@ Tcl_GetIndexFromObjStruct(
int count = 0;
TclNewObj(resultPtr);
- entryPtr = (const char* const *)tablePtr;
+ entryPtr = (const char *const *)tablePtr;
while ((*entryPtr != NULL) && !**entryPtr) {
entryPtr = NEXT_ENTRY(entryPtr, offset);
}
@@ -386,7 +412,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) {
@@ -395,6 +421,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);
@@ -423,7 +452,7 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
- IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
+ IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
@@ -452,14 +481,14 @@ DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- Tcl_ObjIntRep ir;
+ Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));
- memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+ memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
ir.twoPtrValue.ptr1 = dupIndexRep;
- Tcl_StoreIntRep(dupPtr, &indexType, &ir);
+ Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
}
/*
@@ -483,7 +512,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
+ ckfree(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -540,7 +569,7 @@ TclInitPrefixCmd(
static int
PrefixMatchObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -589,7 +618,7 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
i++;
- result = Tcl_ListObjLength(interp, objv[i], &errorLength);
+ result = TclListObjLengthM(interp, objv[i], &errorLength);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -613,7 +642,7 @@ PrefixMatchObjCmd(
* error case regardless of level.
*/
- result = Tcl_ListObjLength(interp, tablePtr, &dummyLength);
+ result = TclListObjLengthM(interp, tablePtr, &dummyLength);
if (result != TCL_OK) {
return result;
}
@@ -664,7 +693,7 @@ PrefixMatchObjCmd(
static int
PrefixAllObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -678,7 +707,7 @@ PrefixAllObjCmd(
return TCL_ERROR;
}
- result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
@@ -721,7 +750,7 @@ PrefixAllObjCmd(
static int
PrefixLongestObjCmd(
- TCL_UNUSED(ClientData),
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -735,7 +764,7 @@ PrefixLongestObjCmd(
return TCL_ERROR;
}
- result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
@@ -851,7 +880,7 @@ Tcl_WrongNumArgs(
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
- Interp *iPtr = (Interp *) interp;
+ Interp *iPtr = (Interp *)interp;
const char *elementStr;
/*
@@ -887,27 +916,19 @@ Tcl_WrongNumArgs(
}
/*
- * Check to see if we are processing an ensemble implementation, and if so
- * rewrite the results in terms of how the ensemble was invoked.
+ * If processing an an ensemble implementation, rewrite the results in
+ * terms of how the ensemble was invoked.
*/
if (iPtr->ensembleRewrite.sourceObjs != NULL) {
int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
- Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
-
- /*
- * Check for spelling fixes, and substitute the fixed values.
- */
-
- if (origObjv[0] == NULL) {
- origObjv = (Tcl_Obj *const *)origObjv[2];
- }
+ Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp);
/*
- * We only know how to do rewriting if all the replaced objects are
+ * Only do rewrite the command if all the replaced objects are
* actually arguments (in objv) to this function. Otherwise it just
- * gets too complicated and we'd be better off just giving a slightly
+ * gets too complicated and it's to just give a slightly
* confusing error message...
*/
@@ -930,9 +951,9 @@ Tcl_WrongNumArgs(
/*
* Add the element, quoting it if necessary.
*/
- const Tcl_ObjIntRep *irPtr;
+ const Tcl_ObjInternalRep *irPtr;
- if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
+ if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
@@ -979,9 +1000,9 @@ Tcl_WrongNumArgs(
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
- const Tcl_ObjIntRep *irPtr;
+ const Tcl_ObjInternalRep *irPtr;
- if ((irPtr = TclFetchIntRep(objv[i], &indexType))) {
+ if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
@@ -1057,6 +1078,7 @@ Tcl_WrongNumArgs(
*----------------------------------------------------------------------
*/
+#undef Tcl_ParseArgsObjv
int
Tcl_ParseArgsObjv(
Tcl_Interp *interp, /* Place to store error message. */
@@ -1426,7 +1448,7 @@ TclGetCompletionCodeFromObj(
"ok", "error", "return", "break", "continue", NULL
};
- if (!TclHasIntRep(value, &indexType)
+ if (!TclHasInternalRep(value, &indexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
generated by cgit v0.12 at 2025-12-09 13:48:23 (GMT)