diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclIndexObj.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclIndexObj.c	Fri Jun 15 03:10:57 2012 +0200
@@ -0,0 +1,479 @@
+/* 
+ * tclIndexObj.c --
+ *
+ *	This file implements objects of type "index".  This object type
+ *	is used to lookup a keyword in a table of valid values and cache
+ *	the index of the matching entry.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
+ *
+ * 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.16.2.5 2006/04/06 18:57:24 dgp Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int		SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
+static void		UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *dupPtr));
+static void		FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines the index Tcl object type by means of
+ * procedures that can be invoked by generic object code.
+ */
+
+Tcl_ObjType tclIndexType = {
+    "index",				/* name */
+    FreeIndex,				/* freeIntRepProc */
+    DupIndex,				/* dupIntRepProc */
+    UpdateStringOfIndex,		/* updateStringProc */
+    SetIndexFromAny			/* setFromAnyProc */
+};
+
+/*
+ * The definition of the internal representation of the "index"
+ * object; The internalRep.otherValuePtr field of an object of "index"
+ * type will be a pointer to one of these structures.
+ *
+ * Keep this structure declaration in sync with tclTestObj.c
+ */
+
+typedef struct {
+    VOID *tablePtr;			/* Pointer to the table of strings */
+    int offset;				/* Offset between table entries */
+    int index;				/* Selected index into table. */
+} IndexRep;
+
+/*
+ * The following macros greatly simplify moving through a table...
+ */
+#define STRING_AT(table, offset, index) \
+	(*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
+#define NEXT_ENTRY(table, offset) \
+	(&(STRING_AT(table, offset, 1)))
+#define EXPAND_OF(indexRep) \
+	STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetIndexFromObj --
+ *
+ *	This procedure looks up an object's value in a table of strings
+ *	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
+ *	*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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+EXPORT_C int
+Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
+    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* Object containing the string to lookup. */
+    CONST char **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 messages. */
+    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) {
+	IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+	/*
+	 * Here's hoping we don't get hit by unfortunate packing
+	 * constraints on odd platforms like a Cray PVP...
+	 */
+	if (indexRep->tablePtr == (VOID *)tablePtr &&
+		indexRep->offset == sizeof(char *)) {
+	    *indexPtr = indexRep->index;
+	    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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+EXPORT_C 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. */
+    CONST VOID *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 */
+    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 index, i, numAbbrev;
+    char *key, *p1;
+    CONST char *p2;
+    CONST char * CONST *entryPtr;
+    Tcl_Obj *resultPtr;
+    IndexRep *indexRep;
+
+    /*
+     * See if there is a valid cached result from a previous lookup.
+     */
+
+    if (objPtr->typePtr == &tclIndexType) {
+	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
+	    *indexPtr = indexRep->index;
+	    return TCL_OK;
+	}
+    }
+
+    /*
+     * Lookup the value of the object in the table.  Accept unique
+     * abbreviations unless TCL_EXACT is set in flags.
+     */
+
+    key = TclGetString(objPtr);
+    index = -1;
+    numAbbrev = 0;
+
+    /*
+     * Scan the table looking for one of:
+     *  - An exact match (always preferred)
+     *  - A single abbreviation (allowed depending on flags)
+     *  - Several abbreviations (never allowed, but overridden by exact match)
+     */
+    for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; 
+	    entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
+	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
+	    if (*p1 == '\0') {
+		index = i;
+		goto done;
+	    }
+	}
+	if (*p1 == '\0') {
+	    /*
+	     * The value is an abbreviation for this entry.  Continue
+	     * checking other entries to make sure it's unique.  If we
+	     * get more than one unique abbreviation, keep searching to
+	     * see if there is an exact match, but remember the number
+	     * of unique abbreviations and don't allow either.
+	     */
+
+	    numAbbrev++;
+	    index = i;
+	}
+    }
+    /*
+     * Check if we were instructed to disallow abbreviations. 
+     */
+    if ((flags & TCL_EXACT) || (key[0] == '\0') || (numAbbrev != 1)) {
+	goto error;
+    }
+
+    done:
+    /*
+     * Cache the found representation.  Note that we want to avoid
+     * allocating a new internal-rep if at all possible since that is
+     * potentially a slow operation.
+     */
+    if (objPtr->typePtr == &tclIndexType) {
+ 	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+    } else {
+ 	if ((objPtr->typePtr != NULL)
+		&& (objPtr->typePtr->freeIntRepProc != NULL)) {
+ 	    objPtr->typePtr->freeIntRepProc(objPtr);
+ 	}
+ 	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ 	objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
+ 	objPtr->typePtr = &tclIndexType;
+    }
+    indexRep->tablePtr = (VOID*) tablePtr;
+    indexRep->offset = offset;
+    indexRep->index = index;
+
+    *indexPtr = index;
+    return TCL_OK;
+
+    error:
+    if (interp != NULL) {
+	/*
+	 * Produce a fancy error message.
+	 */
+	int count;
+
+	TclNewObj(resultPtr);
+	Tcl_SetObjResult(interp, resultPtr);
+	Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
+		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"",
+		key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL);
+	for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
+		*entryPtr != NULL;
+		entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
+	    if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
+		Tcl_AppendStringsToObj(resultPtr,
+			(count > 0) ? ", or " : " or ", *entryPtr,
+			(char *) NULL);
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
+			(char *) NULL);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetIndexFromAny --
+ *
+ *	This procedure is called to convert a Tcl object to index
+ *	internal form. However, this doesn't make sense (need to have a
+ *	table of keywords in order to do the conversion) so the
+ *	procedure always generates an error.
+ *
+ * Results:
+ *	The return value is always TCL_ERROR, and an error message is
+ *	left in interp's result if interp isn't NULL. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetIndexFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
+{
+    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	    "can't convert value to index except via Tcl_GetIndexFromObj API",
+	    -1);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfIndex --
+ *
+ *	This procedure is called to convert a Tcl object from index
+ *	internal form to its string form.  No abbreviation is ever
+ *	generated.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The string representation of the object is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfIndex(objPtr)
+    Tcl_Obj *objPtr;
+{
+    IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
+    register char *buf;
+    register unsigned len;
+    register CONST char *indexStr = EXPAND_OF(indexRep);
+
+    len = strlen(indexStr);
+    buf = (char *) ckalloc(len + 1);
+    memcpy(buf, indexStr, len+1);
+    objPtr->bytes = buf;
+    objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupIndex --
+ *
+ *	This procedure is called to copy the internal rep of an index
+ *	Tcl object from to another object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The internal representation of the target object is updated
+ *	and the type is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupIndex(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr, *dupPtr;
+{
+    IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
+    IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+
+    memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
+    dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
+    dupPtr->typePtr = &tclIndexType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeIndex --
+ *
+ *	This procedure is called to delete the internal rep of an index
+ *	Tcl object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The internal representation of the target object is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeIndex(objPtr)
+    Tcl_Obj *objPtr;
+{
+    ckfree((char *) objPtr->internalRep.otherValuePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WrongNumArgs --
+ *
+ *	This procedure generates a "wrong # args" error message in an
+ *	interpreter.  It is used as a utility function by many command
+ *	procedures.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An error message is generated in interp's result object to
+ *	indicate that a command was invoked with the wrong number of
+ *	arguments.  The message has the form
+ *		wrong # args: should be "foo bar additional stuff"
+ *	where "foo" and "bar" are the initial objects in objv (objc
+ *	determines how many of these are printed) and "additional stuff"
+ *	is the contents of the message argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+EXPORT_C void
+Tcl_WrongNumArgs(interp, objc, objv, message)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments to print
+					 * from objv. */
+    Tcl_Obj *CONST objv[];		/* Initial argument objects, which
+					 * should be included in the error
+					 * message. */
+    CONST char *message;		/* Error message to print after the
+					 * leading objects in objv. The
+					 * message may be NULL. */
+{
+    Tcl_Obj *objPtr;
+    int i;
+    register IndexRep *indexRep;
+
+    TclNewObj(objPtr);
+    Tcl_SetObjResult(interp, objPtr);
+    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+    for (i = 0; i < objc; i++) {
+	/*
+	 * If the object is an index type use the index table which allows
+	 * for the correct error message even if the subcommand was
+	 * abbreviated.  Otherwise, just use the string rep.
+	 */
+	
+	if (objv[i]->typePtr == &tclIndexType) {
+	    indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
+	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
+	} else {
+	    Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
+		    (char *) NULL);
+	}
+
+	/*
+	 * Append a space character (" ") if there is more text to follow
+	 * (either another element from objv, or the message string).
+	 */
+	if ((i < (objc - 1)) || message) {
+	    Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+	}
+    }
+
+    if (message) {
+	Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
+    }
+    Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+}