Tcl Source Code

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface.  The
	* generic/tclDictObj.c:	final argument had been bracePtr, the address
	* generic/tclListObj.c:	of a boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers
	really care about that.  What the callers really want to know is 
	whether the list element value exists as a literal substring of the
	string being parsed, or whether a call to TclCopyAndCollpase() is
	needed to produce the list element value.  Now the final argument
	is changed to do what callers actually need.  This is a better fit
	for the calls in tclParse.c, where now a good deal of post-processing
	checking for "naked backslashes" is no longer necessary.
	***POTENTIAL INCOMPATIBILITY***
	For any callers calling in via the internal stubs table who really
	do use the final argument explicitly to check for the enclosing brace
	scenario.  Simply looking for the braces where they must be is the
	revision available to those callers, and it will backport cleanly.

	* tests/parse.test:	Tests for expanded literals quoting detection.

	* generic/tclCompCmdsSZ.c:	New TclFindElement() is also a better
	fit for the [switch] compiler.

	* generic/tclInt.h:	Replace TclCountSpaceRuns() with
	* generic/tclListObj.c:	TclMaxListLength() which is the function we
	* generic/tclUtil.c:	actually want.
	* generic/tclCompCmdsSZ.c:

	* generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to
	better use the powers of TclFindElement() and do less parsing on
	its own.

2011-04-28  Don Porter  <[email protected]>

	* generic/tclInt.h:	New utility routines:
	* generic/tclParse.c:	TclIsSpaceProc() and
	* generic/tclUtil.c:	TclCountSpaceRuns()

	* generic/tclCmdMZ.c:	Use new routines to replace calls to
	* generic/tclListObj.c:	isspace() and their /* INTL */ risk.
	* generic/tclStrToD.c:
	* generic/tclUtf.c:
	* unix/tclUnixFile.c:
	
	* generic/tclStringObj.c:	Improved reaction to out of memory.

2011-04-27  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	TclFreeIntRep() correction & cleanup.
	* generic/tclExecute.c:
	* generic/tclIndexObj.c:
	* generic/tclInt.h:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclResult.c:
	* generic/tclStringObj.c:
	* generic/tclVar.c:

	* generic/tclListObj.c:	FreeListInternalRep() cleanup.

2011-04-21  Don Porter  <[email protected]>

	* generic/tclInt.h:	Use macro to set List intreps.
	* generic/tclListObj.c:

	* generic/tclCmdIL.c:	Limits on list length were too strict.
	* generic/tclInt.h:	Revised panics to errors where possible.

#   if defined(__WIN32__) && !defined(__CYGWIN__)
#      define TCL_WIDE_INT_TYPE __int64
#      ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
#         define TCL_LL_MODIFIER	"L"
#      else /* __BORLANDC__ */
#         if defined(_WIN64)
typedef struct __stat64 Tcl_StatBuf;
#         elif (defined(_MSC_VER) && (_MSC_VER < 1400))
typedef struct _stati64	Tcl_StatBuf;
#         else
typedef struct _stat32i64 Tcl_StatBuf;
#         endif /* _MSC_VER < 1400 */
#         define TCL_LL_MODIFIER	"I64"
#      endif /* __BORLANDC__ */
#   elif defined(__GNUC__)
#      define TCL_WIDE_INT_TYPE long long
#      define TCL_LL_MODIFIER	"ll"
#      if defined(__WIN32__)
typedef struct _stat32i64 Tcl_StatBuf;
#      else
typedef struct stat	Tcl_StatBuf;
#      endif
#   else /* ! __WIN32__ && ! __GNUC__ */
/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#      ifdef NO_LIMITS_H
#	  error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
#      else /* !NO_LIMITS_H */

	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;
		TclFreeIntRep(objPtr);

	    }
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;

		 * so return failure index as the point where parsing stopped.
		 * Clear out the internal rep, since keeping it would leave
		 * *objPtr in an inconsistent state.
		 */

		failat = stop - string1;
		TclFreeIntRep(objPtr);

	    }
	} else {
	    /*
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    failat = 0;

	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain, elemSize;
	    register const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;

		    /*
		     * This is the simplest way of getting the number of
		     * characters parsed. Note that this is not the same as
		     * the number of bytes when parsing strings with non-ASCII
		     * characters in them.
		     *
		     * Skip leading spaces first. This is only really an issue
		     * if it is the first "element" that has the failure.
		     */

		    while (TclIsSpaceProc(*p)) {
			p++;
		    }
		    TclNewStringObj(tmpStr, string1, p-string1);
		    failat = Tcl_GetCharLength(tmpStr);
		    TclDecrRefCount(tmpStr);
		    break;
		}

				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
    int numWords;		/* Number of words in command. */

    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */
    enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
				/* What kind of switch are we doing? */

    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
    Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
    int *bodyLines;		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines;	/* Array of continuation line info. */
    int noCase;			/* Has the -nocase flag been given? */
    int foundMode = 0;		/* Have we seen a mode flag yet? */

    int i, valueIndex;
    int result = TCL_ERROR;
    DefineLineInformation;	/* TIP #280 */
    int *clNext = envPtr->clNext;

    /*
     * Only handle the following versions:

     * that in the case of the quoted bodies, this is tricky as we cannot use
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {

	const char *bytes;
	int maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */








	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;

	numBytes = tokenPtr[1].size;






	/* Allocate enough space to work in. */





	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {

	    return TCL_ERROR;
	}


	bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = ckalloc(sizeof(int) * maxLen);
	bodyContLines = ckalloc(sizeof(int*) * maxLen);





	bline = mapPtr->loc[eclIndex].line[valueIndex+1];








	numWords = 0;

	while (numBytes > 0) {

	    const char *prevBytes = bytes;
	    int literal;



	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
		    &(bodyTokenArray[numWords].start), &bytes,
		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
	    abort:
		ckfree((char *) bodyToken);
		ckfree((char *) bodyTokenArray);
		ckfree((char *) bodyLines);
		ckfree((char *) bodyContLines);
		return TCL_ERROR;






	    }






	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
	    bodyTokenArray[numWords].numComponents = 0;
	    bodyToken[numWords] = bodyTokenArray + numWords;

	    /*
	     * TIP #280: Now determine the line the list element starts on
	     * (there is no need to do it earlier, due to the possibility of
	     * aborting, see above).
	     */

	    TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
	    TclAdvanceContinuations(&bline, &clNext,
		    bodyTokenArray[numWords].start - envPtr->source);
	    bodyLines[numWords] = bline;
	    bodyContLines[numWords] = clNext;
	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);







	    numBytes -= (bytes - prevBytes);
	    numWords++;



	}


	if (numWords % 2) {





	    goto abort;


	}

    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
	 * should get caught earlier, but it's easy to check here again anyway
	 * because it'd cause a nasty crash otherwise.

	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {

		goto freeTemporaries;
	    }
	    bodyToken[i] = tokenPtr+1;

	    /*
	     * TIP #280: Copy line information from regular cmd info.
	     */

     * Now we commit to generating code; the parsing stage per se is done.
     * Check if we can generate a jump table, since if so that's faster than
     * doing an explicit compare with each body. Note that we're definitely
     * over-conservative with determining whether we can do the jump table,
     * but it handles the most common case well enough.
     */

    if (mode == Switch_Exact) {
	IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
		valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
    } else {
	IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase,
		valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines,
		bodyContLines);
    }

SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    const char *string;
    char *s;
    const char *elemStart, *nextElem;
    int lenRemain, length, elemSize, result, isNew;
    const char *limit;	/* Points just after string's last byte. */
    register const char *p;
    register Tcl_Obj *keyPtr, *valuePtr;
    Dict *dict;
    Tcl_HashEntry *hPtr;

    /*

     */

    dict = ckalloc(sizeof(Dict));
    InitChainTable(dict);
    for (p = string, lenRemain = length;
	    lenRemain > 0;
	    p = nextElem, lenRemain = (limit - nextElem)) {
	int literal;

	result = TclFindElement(interp, p, lenRemain,
		&elemStart, &nextElem, &elemSize, &literal);
	if (result != TCL_OK) {
	    if (interp != NULL) {
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
	    }
	    goto errorExit;
	}
	if (elemStart >= limit) {
	    break;
	}

	/*
	 * Allocate a Tcl object for the element and initialize it from the
	 * "elemSize" bytes starting at "elemStart".
	 */

	s = ckalloc(elemSize + 1);
	if (literal) {
	    memcpy(s, elemStart, (size_t) elemSize);
	    s[elemSize] = 0;
	} else {
	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
	}

	TclNewObj(keyPtr);
	keyPtr->bytes = s;
	keyPtr->length = elemSize;

	p = nextElem;
	lenRemain = (limit - nextElem);
	if (lenRemain <= 0) {
	    goto missingKey;
	}

	result = TclFindElement(interp, p, lenRemain,
		&elemStart, &nextElem, &elemSize, &literal);
	if (result != TCL_OK) {
	    if (interp != NULL) {
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
	    }
	    TclDecrRefCount(keyPtr);
	    goto errorExit;
	}
	if (elemStart >= limit) {
	    goto missingKey;
	}

	/*
	 * Allocate a Tcl object for the element and initialize it from the
	 * "elemSize" bytes starting at "elemStart".
	 */

	s = ckalloc(elemSize + 1);
	if (literal) {
	    memcpy(s, elemStart, (size_t) elemSize);
	    s[elemSize] = 0;
	} else {
	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
	}

	TclNewObj(valuePtr);

		/* TODO: convert panic to error ? */
		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
			INT_MAX);
	    }
#if !TCL_COMPILE_DEBUG
	    if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
		TclFreeIntRep(objResultPtr);

		objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
		objResultPtr->length = length + appendLen;
		p = TclGetString(objResultPtr) + length;
		currPtr = &OBJ_AT_DEPTH(opnd - 2);
	    } else
#endif
	    {

     * Most commands are plugged directly together, but some are done via
     * alias-like rewriting; [chan configure] is this way for security reasons
     * (want overwriting of [fconfigure] to control that nicely), and [chan
     * names] because the functionality isn't available as a separate command
     * function at the moment.
     */
    static const EnsembleImplMap initMap[] = {
	{"blocked",	Tcl_FblockedObjCmd, NULL, NULL, NULL, 0},
	{"close",	Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
	{"copy",	Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
	{"create",	TclChanCreateObjCmd, NULL, NULL, NULL, 0},		/* TIP #219 */
	{"eof",		Tcl_EofObjCmd, NULL, NULL, NULL, 0},
	{"event",	Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
	{"flush",	Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
	{"gets",	Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
	{"names",	TclChannelNamesCmd, NULL, NULL, NULL, 0},
	{"pending",	ChanPendingObjCmd, NULL, NULL, NULL, 0},		/* TIP #287 */
	{"pop",		TclChanPopObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */
	{"postevent",	TclChanPostEventObjCmd, NULL, NULL, NULL, 0},	/* TIP #219 */
	{"push",	TclChanPushObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */
	{"puts",	Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
	{"read",	Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
	{"seek",	Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
	{"pipe",	ChanPipeObjCmd, NULL, NULL, NULL, 0},		/* TIP #304 */
	{"tell",	Tcl_TellObjCmd, NULL, NULL, NULL, 0},
	{"truncate",	ChanTruncateObjCmd, NULL, NULL, NULL, 0},		/* TIP #208 */
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char *const extras[] = {
	"configure",	"::fconfigure",
	NULL
    };
    Tcl_Command ensemble;

	    sizeof(char *), msg, flags, indexPtr);

    /*
     * The internal rep must be cleared since tablePtr will go away.
     */

    TclFreeIntRep(objPtr);

    ckfree(tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------

MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
MODULE_SCOPE void	TclInitNotifier(void);
MODULE_SCOPE void	TclInitObjSubsystem(void);
MODULE_SCOPE void	TclInitSubsystems(void);
MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int	TclIsSpaceProc(char byte);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(CONST char *bytes, int numBytes,
			    CONST char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,

 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclFreeIntRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclFreeIntRep(objPtr) \
    if ((objPtr)->typePtr != NULL) { \
	if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
	} \
	(objPtr)->typePtr = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's string representation.
 * The ANSI C "prototype" for this macro is:

	return NULL;
    }

    listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*)));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
    listRepPtr->maxElemCount = objc;

	if (objc > LIST_MAX) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "list creation failed: unable to alloc %u bytes",
		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
	}
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return listRepPtr;
}

/*

    }

    /*
     * Free any old string rep and any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);

    Tcl_InvalidateStringRep(objPtr);

    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type.
     */

 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    List *listRepPtr = ListRepPtr(listPtr);

    if (--listRepPtr->refCount <= 0) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;

	int i, numElems = listRepPtr->elemCount;



	for (i = 0;  i < numElems;  i++) {

	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	ckfree(listRepPtr);
    }

    listPtr->internalRep.twoPtrValue.ptr1 = NULL;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = NULL;

SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    const char *string;
    char *s;
    const char *elemStart, *nextElem;
    int lenRemain, length, estCount, elemSize, i, j, result;
    const char *limit;		/* Points just after string's last byte. */
    register const char *p;
    register Tcl_Obj **elemPtrs;
    register Tcl_Obj *elemPtr;
    List *listRepPtr;

    /*

     * Get the string representation. Make it up-to-date if necessary.
     */

    string = TclGetStringFromObj(objPtr, &length);

    /*
     * Parse the string into separate string objects, and create a List
     * structure that points to the element string objects. 




     *







     * First, allocate enough space to hold a (Tcl_Obj *) for each




     * (possible) list element.
     */

    estCount = TclMaxListLength(string, length, &limit);
    estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
    listRepPtr = AttemptNewList(interp, estCount, NULL);
    if (listRepPtr == NULL) {
	return TCL_ERROR;
    }
    elemPtrs = &listRepPtr->elements;

    /* Each iteration, parse and store a list element */
    for (p=string, lenRemain=length, i=0;
	    lenRemain > 0;
	    p=nextElem, lenRemain=limit-nextElem, i++) {
	int literal;

	result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem,
		&elemSize, &literal);
	if (result != TCL_OK) {
	    for (j = 0;  j < i;  j++) {
		elemPtr = elemPtrs[j];
		Tcl_DecrRefCount(elemPtr);
	    }
	    ckfree(listRepPtr);
	    if (interp != NULL) {

	/*
	 * Allocate a Tcl object for the element and initialize it from the
	 * "elemSize" bytes starting at "elemStart".
	 */

	s = ckalloc(elemSize + 1);
	if (literal) {
	    memcpy(s, elemStart, (size_t) elemSize);
	    s[elemSize] = 0;
	} else {
	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
	}

	TclNewObj(elemPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 */

static const EnsembleImplMap defaultNamespaceMap[] = {
    {"children",        NamespaceChildrenCmd, NULL, NULL, NULL, 0},
    {"code",            NamespaceCodeCmd, NULL, NULL, NULL, 0},
    {"current",         NamespaceCurrentCmd, NULL, NULL, NULL, 0},
    {"delete",          NamespaceDeleteCmd, NULL, NULL, NULL, 0},
    {"ensemble",        TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",            NamespaceEvalCmd,       NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",          NamespaceExistsCmd, NULL, NULL, NULL, 0},
    {"export",          NamespaceExportCmd, NULL, NULL, NULL, 0},
    {"forget",          NamespaceForgetCmd, NULL, NULL, NULL, 0},
    {"import",          NamespaceImportCmd, NULL, NULL, NULL, 0},
    {"inscope",         NamespaceInscopeCmd,    NULL, NULL, NRNamespaceInscopeCmd, 0},
    {"origin",          NamespaceOriginCmd, NULL, NULL, NULL, 0},
    {"parent",          NamespaceParentCmd, NULL, NULL, NULL, 0},
    {"path",            NamespacePathCmd, NULL, NULL, NULL, 0},
    {"qualifiers",      NamespaceQualifiersCmd, NULL, NULL, NULL, 0},
    {"tail",            NamespaceTailCmd, NULL, NULL, NULL, 0},
    {"unknown",         NamespaceUnknownCmd, NULL, NULL, NULL, 0},
    {"upvar",           NamespaceUpvarCmd,      TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
    {"which",           NamespaceWhichCmd, NULL, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *
 * TclInitNamespaceSubsystem --

	 * Our failed lookup proves any previously cached nsName intrep is no
	 * longer valid. Get rid of it so we no longer waste memory storing
	 * it, nor time determining its invalidity again and again.
	 */

	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);

	}
	return TCL_ERROR;
    }

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;

		if (tokenPtr[i].type != TCL_TOKEN_TEXT) {
		    isLiteral = 0;
		    break;
		}
	    }

	    if (isLiteral) {
		int elemCount = 0, code = TCL_OK, literal = 1;
		const char *nextElem, *listEnd, *elemStart;

		/*
		 * The word to be expanded is a literal, so determine the
		 * boundaries of the literal string to be treated as a list
		 * and expanded. That literal string starts at
		 * tokenPtr[1].start, and includes all bytes up to, but not

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    int size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;










		    }
		    if (elemStart < listEnd) {
			elemCount++;
		    }
		}

		if ((code != TCL_OK) || !literal) {
		    /*
		     * Some list element could not be parsed, or is not
		     * present as a literal substring of the script.  The
		     * compiler cannot handle list elements that get generated
		     * by a call to TclCopyAndCollapse(). Defer  the
		     * handling of  this to  compile/eval time, where  code is
		     * already  in place to  report the  "attempt to  expand a
		     * non-list" error or expand lists that require
		     * substitution.
		     */

		    tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
		} else if (elemCount == 0) {
		    /*

		    parsePtr->numTokens = wordIndex;
		} else {
		    /*
		     * Recalculate the number of Tcl_Tokens needed to store
		     * tokens representing the expanded list.
		     */

		    CONST char *listStart;
		    int growthNeeded = wordIndex + 2*elemCount
			    - parsePtr->numTokens;

		    parsePtr->numWords += elemCount - 1;
		    if (growthNeeded > 0) {
			TclGrowParseTokenArray(parsePtr, growthNeeded);
			tokenPtr = &parsePtr->tokenPtr[wordIndex];
		    }
		    parsePtr->numTokens = wordIndex + 2*elemCount;

		    /*
		     * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for
		     * each element of the literal list we are expanding in
		     * place. Take care with the start and size fields of each
		     * token so they point to the right literal characters in
		     * the original script to represent the right expanded
		     * word value.
		     */

		    listStart = nextElem = tokenPtr[1].start;
		    while (nextElem < listEnd) {
			int quoted;
	
			tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
			tokenPtr->numComponents = 1;

			tokenPtr++;
			tokenPtr->type = TCL_TOKEN_TEXT;
			tokenPtr->numComponents = 0;
			TclFindElement(NULL, nextElem, listEnd - nextElem,
				&(tokenPtr->start), &nextElem,
				&(tokenPtr->size), NULL);

			quoted = (tokenPtr->start[-1] == '{'
				|| tokenPtr->start[-1] == '"')
				&& tokenPtr->start > listStart;
			tokenPtr[-1].start = tokenPtr->start - quoted;
			tokenPtr[-1].size = tokenPtr->start + tokenPtr->size
				- tokenPtr[-1].start + quoted;

			tokenPtr++;
		    }
		}

    return TCL_OK;

  error:
    Tcl_FreeParse(parsePtr);
    parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIsSpaceProc --
 *
 *	Report whether byte is in the set of whitespace characters used by
 *	Tcl to separate words in scripts or elements in lists.
 *
 * Results:
 *	Returns 1, if byte is in the set, 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclIsSpaceProc(
    char byte)
{
    return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
}

/*
 *----------------------------------------------------------------------
 *
 * ParseWhiteSpace --
 *
 *	Scans up to numBytes bytes starting at src, consuming white space

	    case '{':
		openBrace = 1;
		break;
	    case '\n':
		openBrace = 0;
		break;
	    case '#' :
		if (openBrace && TclIsSpaceProc(src[-1])) {
		    Tcl_AppendResult(parsePtr->interp,
			    ": possible unbalanced brace in comment", NULL);
		    goto error;
		}
		break;
	    }
	}

	    return TCL_OK;
	}

	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}
	FreeFsPathInternalRep(pathPtr);

    }

    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);

    /*
     * We used to have more complex code here:
     *
     * FsPath *fsPathPtr = PATHOBJ(pathPtr);
     * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
     *     return TCL_OK;
     * } else {
     *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
     *         return TCL_OK;
     *     } else {
     *         if (pathPtr->bytes == NULL) {
     *             UpdateStringOfFsPath(pathPtr);
     *         }
     *         FreeFsPathInternalRep(pathPtr);

     *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
     *     }
     * }
     *
     * But we no longer believe this is necessary.
     */
}

    if (fsPathPtr->cwdPtr != NULL) {
	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
	    if (pathPtr->bytes == NULL) {
		UpdateStringOfFsPath(pathPtr);
	    }
	    FreeFsPathInternalRep(pathPtr);

	    if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;

	 * We have to discard the stale representation and recalculate it.
	 */

	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}
	FreeFsPathInternalRep(pathPtr);

	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	srcFsPathPtr = PATHOBJ(pathPtr);
    }

    /*

		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {

	    TclFreeIntRep(bodyPtr);
	}
    }

    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_HashEntry *hePtr;

#ifdef TCL_COMPILE_DEBUG

    /*
     * Free the list internalrep of objPtr - this will free argsPtr, but
     * bodyPtr retains a reference from the Proc structure. Then finish the
     * conversion to lambdaType.
     */

    TclFreeIntRep(objPtr);

    objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
    objPtr->typePtr = &lambdaType;
    return TCL_OK;
}


	    if (objResultPtr->bytes) {
		ckfree(objResultPtr->bytes);
	    }
	    objResultPtr->bytes = tclEmptyStringRep;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);

    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorCodeVA --

	case INITIAL:
	    /*
	     * Initial state. Acceptable characters are +, -, digits, period,
	     * I, N, and whitespace.
	     */

	    if (TclIsSpaceProc(c)) {
		if (flags & TCL_PARSE_NO_WHITESPACE) {
		    goto endgame;
		}
		break;
	    } else if (c == '+') {
		state = SIGNUM;
		break;

	case sNANHEX:
	    if (c == ')') {
		state = sNANFINISH;
		break;
	    }
	    /* FALLTHROUGH */
	case sNANPAREN:
	    if (TclIsSpaceProc(c)) {
		break;
	    }
	    if (numSigDigs < 13) {
		if (c >= '0' && c <= '9') {
		    d = c - '0';
		} else if (c >= 'a' && c <= 'f') {
		    d = 10 + c - 'a';

	p = acceptPoint;
	len = acceptLen;
	if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
	    /*
	     * Accept trailing whitespace.
	     */

	    while (len != 0 && TclIsSpaceProc(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
		status = TCL_ERROR;

#define STRING_SIZE(numChars) \
	(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		STRING_MAXCHARS); \
    }
#define stringAttemptAlloc(numChars) \
	(String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
#define stringAlloc(numChars) \
	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \

    }

    /*
     * Set the type to NULL and free any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);


    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    TclInvalidateStringRep(objPtr);

	int copyMaxChars;

	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
	    copyMaxChars = 2 * srcStringPtr->numChars;
	} else {
	    copyMaxChars = srcStringPtr->maxChars;
	}
	copyStringPtr = stringAttemptAlloc(copyMaxChars);
	if (copyStringPtr == NULL) {
	    copyMaxChars = srcStringPtr->numChars;
	    copyStringPtr = stringAlloc(copyMaxChars);
	}
	copyStringPtr->maxChars = copyMaxChars;
	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
		srcStringPtr->numChars * sizeof(Tcl_UniChar));
	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
    } else {
	copyStringPtr = stringAlloc(0);
	copyStringPtr->maxChars = 0;

     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = objv[3]->internalRep.otherValuePtr;
	if (indexRep->tablePtr == (void *) argv) {

	    TclFreeIntRep(objv[3]);
	}
    }

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
    ckfree(argv);
    if (result == TCL_OK) {

    /*
     * If the character is within the first 127 characters, just use the
     * standard C function, otherwise consult the Unicode table.
     */

    if (ch < 0x80) {
	return TclIsSpaceProc((char)ch);
    } else {
	category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
	return ((SPACE_BITS >> category) & 1);
    }
}

/*

    UpdateStringOfEndOffset,		/* updateStringProc */
    SetEndOffsetFromAny
};

/*
 *----------------------------------------------------------------------
 *
 * TclMaxListLength --
 *
 *	Given 'bytes' pointing to 'numBytes' bytes, scan through them and
 *	count the number of whitespace runs that could be list element
 *	separators.  If 'numBytes' is -1, scan to the terminating '\0'.
 *	Not a full list parser.  Typically used to get a quick and dirty
 *	overestimate of length size in order to allocate space for an
 *	actual list parser to operate with.
 *
 * Results:
 *	Returns the largest number of list elements that could possibly
 *	be in this string, interpreted as a Tcl list.  If 'endPtr' is not
 *	NULL, writes a pointer to the end of the string scanned there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    CONST char *bytes,
    int numBytes,
    CONST char **endPtr)
{
    int count = 0;

    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /* No list element before leading white space */
    count += 1 - TclIsSpaceProc(*bytes); 

    /* Count white space runs as potential element separators */
    while (numBytes) {
	if ((numBytes == -1) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProc(*bytes)) {
	    /* Space run started; bump count */
	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != -1);
	    } while (numBytes && TclIsSpaceProc(*bytes));
	    if (numBytes == 0) {
		break;
	    }
	    /* (*bytes) is non-space; return to counting state */
	}
	bytes++;
	numBytes -= (numBytes != -1);
    }

    /* No list element following trailing white space */
    count -= TclIsSpaceProc(bytes[-1]); 

    done:
    if (endPtr) {
	*endPtr = bytes;
    }
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindElement --
 *
 *	Given a pointer into a Tcl list, locate the first (or next) element in
 *	the list.
 *
 * Results:
 *	The return value is normally TCL_OK, which means that the element was

 *	then *nextPtr will point just after the last character in the list
 *	(i.e., at the character at list+listLength). If sizePtr is non-NULL,
 *	*sizePtr is filled in with the number of characters in the element. If
 *	the element is in braces, then *elementPtr will point to the character
 *	after the opening brace and *sizePtr will not include either of the
 *	braces. If there isn't an element in the list, *sizePtr will be zero,
 *	and both *elementPtr and *termPtr will point just after the last
 *	character in the list. If literalPtr is non-NULL, *literalPtr is set
 *	to a boolean value indicating whether the substring returned as
 *	the values of **elementPtr and *sizePtr is the literal value of
 *	a list element.  If not, a call to TclCopyAndCollapse() is needed
 *	to produce the actual value of the list element.  Note: this function
 *	does NOT collapse backslash sequences, but uses *literalPtr to tell
 * 	callers when it is required for them to do so.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    int *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to 
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = list;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list's last byte. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;		/* lint. */
    int numChars;
    int literal = 1;
    const char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list as bytes belonging to a list
     * element.
     */

    limit = (list + listLength);
    while ((p < limit) && (TclIsSpaceProc(*p))) {
	p++;
    }
    if (p == limit) {		/* no element found */
	elemStart = limit;
	goto done;
    }

    if (*p == '{') {
	openBraces = 1;
	p++;
    } else if (*p == '"') {
	inQuotes = 1;
	p++;
    }
    elemStart = p;




    /*
     * Find element's end (a space, close brace, or the end of the string).
     */

    while (p < limit) {
	switch (*p) {

	case '}':
	    if (openBraces > 1) {
		openBraces--;
	    } else if (openBraces == 1) {
		size = (p - elemStart);
		p++;
		if ((p >= limit) || TclIsSpaceProc(*p)) {

		    goto done;
		}

		/*
		 * Garbage after the closing brace; return an error.
		 */

		if (interp != NULL) {
		    p2 = p;
		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))

			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "list element in braces followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
			    NULL);
		}
		return TCL_ERROR;
	    }
	    break;

	    /*
	     * Backslash: skip over everything up to the end of the backslash
	     * sequence.
	     */

	case '\\':
	    if (openBraces == 0) {
		/*
		 * A backslash sequence not within a brace quoted element
		 * means the value of the element is different from the
		 * substring we are parsing.  A call to TclCopyAndCollapse()
		 * is needed to produce the element value.  Inform the caller.
		 */
		literal = 0;
	    }
	    TclParseBackslash(p, limit - p, &numChars, NULL);
	    p += (numChars - 1);
	    break;

	    /*
	     * Space: ignore if element is in braces or quotes; otherwise
	     * terminate element.

	     * Double-quote: if element is in quotes then terminate it.
	     */

	case '"':
	    if (inQuotes) {
		size = (p - elemStart);
		p++;
		if ((p >= limit) || TclIsSpaceProc(*p)) {

		    goto done;
		}

		/*
		 * Garbage after the closing quote; return an error.
		 */

		if (interp != NULL) {
		    p2 = p;
		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))

			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "list element in quotes followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",

	    }
	    return TCL_ERROR;
	}
	size = (p - elemStart);
    }

  done:
    while ((p < limit) && (TclIsSpaceProc(*p))) {
	p++;
    }
    *elementPtr = elemStart;
    *nextPtr = p;
    if (sizePtr != 0) {
	*sizePtr = size;
    }
    if (literalPtr != 0) {
	*literalPtr = literal;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

				 * NULL, no error message is left. */
    const char *list,		/* Pointer to string with list structure. */
    int *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int length, size, i, result, elSize;

    /*
     * Allocate enough space to work in. A (CONST char *) for each
     * (possible) list element plus one more for terminating NULL,



     * plus as many bytes as in the original string value, plus one



     * more for a terminating '\0'.  Space used to hold element separating

     * white space in the original string gets re-purposed to hold '\0'
     * characters in the argv array.
     */



    size = TclMaxListLength(list, -1, &end) + 1;











    length = end - list;
    argv = ckalloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &literal);
	length -= (list - prevList);
	if (result != TCL_OK) {
	    ckfree(argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    ckfree(argv);
	    if (interp != NULL) {
		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {
	    memcpy(p, element, (size_t) elSize);
	    p += elSize;
	    *p = 0;
	    p++;
	} else {
	    TclCopyAndCollapse(elSize, element, p);
	    p += elSize+1;

    bytes = TclGetStringFromObj(objPtr, &length);

    /*
     * Leading whitespace is acceptable in an index.
     */

    while (length && TclIsSpaceProc(*bytes)) {
	bytes++;
	length--;
    }

    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	int code, first, second;
	char savedOp = *opPtr;

	if ((savedOp != '+') && (savedOp != '-')) {
	    goto parseError;
	}
	if (TclIsSpaceProc(opPtr[1])) {
	    goto parseError;
	}
	*opPtr = '\0';
	code = Tcl_GetInt(interp, bytes, &first);
	*opPtr = savedOp;
	if (code == TCL_ERROR) {
	    goto parseError;

	offset = 0;
    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
	/*
	 * This is our limited string expression evaluator. Pass everything
	 * after "end-" to Tcl_GetInt, then reverse for offset.
	 */

	if (TclIsSpaceProc(bytes[4])) {
	    goto badIndexFormat;
	}
	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (bytes[3] == '-') {
	    offset = -offset;

    register const char *p = value;

    /*
     * A frequent mistake is invalid octal values due to an unwanted leading
     * zero. Try to generate a meaningful error message.
     */

    while (TclIsSpaceProc(*p)) {
	p++;
    }
    if (*p == '+' || *p == '-') {
	p++;
    }
    if (*p == '0') {
	if ((p[1] == 'o') || p[1] == 'O') {
	    p += 2;
	}
	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */
	    p++;
	}
	while (TclIsSpaceProc(*p)) {
	    p++;
	}
	if (*p == '\0') {
	    /*
	     * Reached end of string.
	     */

  doneParsing:
    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
     */

    TclFreeIntRep(part1Ptr);


    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",

     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
     * keeping a reference. This removes some additional exteriorisations of
     * [Bug 736729], but may be a good thing independently of the bug.
     */

    if (part1Ptr->typePtr == &tclNsVarNameType) {
	TclFreeIntRep(part1Ptr);

    }
#endif

    /*
     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of
     * its value object, if any, was decremented above.

} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
    testparser {{*}{a b}} 0
} {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
    testparser {{*}{a \n b}} 0
} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}}
test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
    testparser {{*}"a b"} 0
} {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
    testparser {{*}"a \n b"} 0
} {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}}

test parse-6.1 {ParseTokens procedure, empty word} testparser {
    testparser {""} 0
} {- {""} 1 simple {""} 1 text {} 0 {}}
test parse-6.2 {ParseTokens procedure, simple range} testparser {
    testparser {"abc$x.e"} 0
} {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}

#!/bin/sh
# install - install a program, script, or datafile

scriptversion=2011-04-20.01; # UTC

# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
# following copyright and license.
#
# Copyright (C) 1994 X Consortium
#

  -c            (ignored)
  -C            install only if different (preserve the last data modification time)
  -d            create directories instead of installing files.
  -g GROUP      $chgrpprog installed files to GROUP.
  -m MODE       $chmodprog installed files to MODE.
  -o USER       $chownprog installed files to USER.
  -s            $stripprog installed files.
  -S            $stripprog installed files.
  -t DIRECTORY  install into DIRECTORY.
  -T            report an error if DSTFILE is a directory.

Environment variables override the default commands:
  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
  RMPROG STRIPPROG
"

	esac
	shift;;

    -o) chowncmd="$chownprog $2"
	shift;;

    -s) stripcmd=$stripprog;;

      -S) stripcmd="$stripprog $2" 
         shift;; 

    -t) dst_arg=$2
	shift;;

    -T) no_target_directory=true;;

    --version) echo "$0 $scriptversion"; exit $?;;

    /*
     * Search through all the directories named in the PATH variable to see if
     * argv[0] is in one of them. If so, use that file name.
     */

    while (1) {
	while (TclIsSpaceProc(*p)) {
	    p++;
	}
	name = p;
	while ((*p != ':') && (*p != 0)) {
	    p++;
	}
	Tcl_DStringSetLength(&buffer, 0);

    }
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpReaddir, TclpInetNtoa --
 *
 *	These procedures replace core C versions to be used in a threaded
 *	environment.
 *
 * Results:
 *	See documentation of C functions.
 *

#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <limits.h>

#ifdef __CYGWIN__
#   include <unistd.h>
#   ifndef _vsnprintf
#	define _vsnprintf vsnprintf
#   endif
#   ifndef _wcsicmp
#	define _wcsicmp wcscasecmp
#   endif
#else
#   ifndef strncasecmp
#	define strncasecmp strnicmp
#   endif