summaryrefslogtreecommitdiffstats
path: root/generic/tclIndexObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r--generic/tclIndexObj.c160
1 files changed, 92 insertions, 68 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 2dc0d85..5acb6c5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIndexObj.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.3 1999/04/16 00:46:47 stanton Exp $
*/
#include "tclInt.h"
@@ -19,11 +19,8 @@
* Prototypes for procedures defined later in this file:
*/
-static void DupIndexInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
-static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
/*
* The structure below defines the index Tcl object type by means of
@@ -33,10 +30,17 @@ static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *listPtr));
Tcl_ObjType tclIndexType = {
"index", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupIndexInternalRep, /* dupIntRepProc */
- UpdateStringOfIndex, /* updateStringProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
SetIndexFromAny /* setFromAnyProc */
};
+
+/*
+ * Boolean flag indicating whether or not the tclIndexType object
+ * type has been registered with the Tcl compiler.
+ */
+
+static int indexTypeInitialized = 0;
/*
*----------------------------------------------------------------------
@@ -47,7 +51,7 @@ Tcl_ObjType tclIndexType = {
* and returns the index of the matching string, if any.
*
* Results:
-
+ *
* If the value of objPtr is identical to or a unique abbreviation
* for one of the entries in objPtr, then the return value is
* TCL_OK and the index of the matching entry is stored at
@@ -76,6 +80,67 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
int flags; /* 0 or TCL_EXACT */
int *indexPtr; /* Place to store resulting integer index. */
{
+
+ /*
+ * See if there is a valid cached result from a previous lookup
+ * (doing the check here saves the overhead of calling
+ * Tcl_GetIndexFromObjStruct in the common case where the result
+ * is cached).
+ */
+
+ if ((objPtr->typePtr == &tclIndexType)
+ && (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr)) {
+ *indexPtr = (int) objPtr->internalRep.twoPtrValue.ptr2;
+ return TCL_OK;
+ }
+ return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
+ msg, flags, indexPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIndexFromObjStruct --
+ *
+ * This procedure looks up an object's value given a starting
+ * string and an offset for the amount of space between strings.
+ * This is useful when the strings are embedded in some other
+ * kind of array.
+ *
+ * Results:
+ *
+ * If the value of objPtr is identical to or a unique abbreviation
+ * for one of the entries in objPtr, 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 flag 'bad option "foo": must be
+ * ...'
+ *
+ * Side effects:
+ * The result of the lookup is cached as the internal rep of
+ * objPtr, so that repeated lookups can be done quickly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
+ indexPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* Object containing the string to lookup. */
+ char **tablePtr; /* The first string in the table. The second
+ * string will be at this address plus the
+ * offset, the third plus the offset again,
+ * etc. The last entry must be NULL
+ * and there must not be duplicate entries. */
+ int offset; /* The number of bytes between entries */
+ char *msg; /* Identifying word to use in error messages. */
+ int flags; /* 0 or TCL_EXACT */
+ int *indexPtr; /* Place to store resulting integer index. */
+{
int index, length, i, numAbbrev;
char *key, *p1, *p2, **entryPtr;
Tcl_Obj *resultPtr;
@@ -95,10 +160,21 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
* abbreviations unless TCL_EXACT is set in flags.
*/
+ if (!indexTypeInitialized) {
+ /*
+ * This is the first time we've done a lookup. Register the
+ * tclIndexType.
+ */
+
+ Tcl_RegisterObjType(&tclIndexType);
+ indexTypeInitialized = 1;
+ }
+
key = Tcl_GetStringFromObj(objPtr, &length);
index = -1;
numAbbrev = 0;
- for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
+ for (entryPtr = tablePtr, i = 0; *entryPtr != NULL;
+ entryPtr = (char **) ((long) entryPtr + offset), i++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == 0) {
index = i;
@@ -135,13 +211,17 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
error:
if (interp != NULL) {
+ int count;
resultPtr = Tcl_GetObjResult(interp);
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"",
key, "\": must be ", *tablePtr, (char *) NULL);
- for (entryPtr = tablePtr+1; *entryPtr != NULL; entryPtr++) {
- if (entryPtr[1] == NULL) {
- Tcl_AppendStringsToObj(resultPtr, ", or ", *entryPtr,
+ for (entryPtr = (char **) ((long) tablePtr + offset), count = 0;
+ *entryPtr != NULL;
+ entryPtr = (char **) ((long) entryPtr + offset), count++) {
+ if ((*((char **) ((long) entryPtr + offset))) == NULL) {
+ Tcl_AppendStringsToObj(resultPtr,
+ (count > 0) ? ", or " : " or ", *entryPtr,
(char *) NULL);
} else {
Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
@@ -155,36 +235,6 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
/*
*----------------------------------------------------------------------
*
- * DupIndexInternalRep --
- *
- * Copy the internal representation of an index Tcl_Obj from one
- * object to another.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to same value as "srcPtr"s
- * internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupIndexInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.twoPtrValue.ptr1
- = srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->internalRep.twoPtrValue.ptr2
- = srcPtr->internalRep.twoPtrValue.ptr2;
- copyPtr->typePtr = &tclIndexType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetIndexFromAny --
*
* This procedure is called to convert a Tcl object to index
@@ -216,31 +266,6 @@ SetIndexFromAny(interp, objPtr)
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfIndex --
- *
- * This procedure is called to update the string representation for
- * an index object. It should never be called, because we never
- * invalidate the string representation for an index object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * A panic is added
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfIndex(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
-{
- panic("UpdateStringOfIndex should never be invoked");
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_WrongNumArgs --
*
* This procedure generates a "wrong # args" error message in an
@@ -293,8 +318,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
tablePtr[(int) objv[i]->internalRep.twoPtrValue.ptr2],
(char *) NULL);
} else {
- Tcl_AppendStringsToObj(objPtr,
- Tcl_GetStringFromObj(objv[i], (int *) NULL),
+ Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
(char *) NULL);
}
if (i < (objc - 1)) {