Tcl Source Code

2009-07-15  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (Namespace):		   Added machinery to allow
	* generic/tclNamesp.c (many functions):	   reduction of memory used
	* generic/tclResolve.c (BumpCmdRefEpochs): by namespaces. Currently
	#ifdef'ed out because of compatibility concerns.

	* generic/tclInt.decls: Added four functions for better integration
	with itcl-ng.

2009-07-14  Kevin B. Kenny  <[email protected]>

	* generic/tclInt.h (TclNRSwitchObjCmd):
	* generic/tclBasic.c (builtInCmds):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
	* tests/switch.test (switch-15.1):
	[Bug 2821401]: Make non-bytecoded [switch] command aware of NRE.
	
2009-07-13  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex)
	(TclCleanupByteCode, TclCompileScript):
	* generic/tclExecute.c (TclCompileObj, TclExecuteByteCode): 
	* tclCompile.h (ExtCmdLoc): 
	* tclInt.h (ExtIndex, CFWordBC, CmdFrame):
	* tclBasic.c (DeleteInterpProc, TclArgumentBCEnter)
	(TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT)
	(RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd):
	* generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback,
	(ForNextCallback):
	* generic/tclCmdMZ.c (TclNRWhileObjCmd):

	Extended the bytecode compiler initialization to recognize the
	compilation of whole files (NRE enabled 'source' command) and switch
	to the counting of absolute lines in that case.

	Further extended the bytecode compiler to track the start line in the
	generated information, and modified the bytecode execution to
	recompile an object if the location as per the calling context doesn't
	match the location saved in the bytecode. This part could be optimized
	more by using more memory to keep all possibilities which occur
	around, or by just adjusting the location information instead of a
	total recompile.

	Reworked the handling of literal command arguments in bytecode to be
	saved (compiler) and used (execution) per command (See the
	TCL_INVOKE_STK* instructions), and not per the whole bytecode. This,
	and the previous change remove the problems with location data caused
	by literal sharing (across whole files, but also proc bodies).
	Simplified the associated datastructures (ExtIndex is gone, as is the
	function EnterCmdWordIndex).

	The last change causes the hashtable 'lineLABCPtr' to be state which
	has to be kept per coroutine, like the CmdFrame stack. Reworked the
	coroutine support code to create, delete and switch the information as
	needed. Further reworked the tailcall command as well, it has to pop
	its own arguments when run in a bytecode context to keep a proper
	stack in 'lineLABCPtr'.

	Fixed the mishandling of line information in the NRE-enabled 'for' and
	'while' commands introduced when both were made to share their
	iteration callbacks without taking into account that the loop body is
	found in different words of the command. Introduced a separate data
	structure to hold all the callback information, as we went over the
	limit of 4 direct client-data values for NRE callbacks.

	The above fixes [Bug 1605269].

2009-07-12  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd):
	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out

# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tclInt.decls,v 1.140 2009/07/15 13:17:18 dkf Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not

}

# Tcl_Obj leak detection support.
declare 243 generic {
    void TclDbDumpActiveObjects(FILE *outFile)
}

# Functions to make things better for itcl
declare 244 generic {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 generic {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 generic {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
	    int numInserted, Tcl_Obj *const *objv)
}
declare 247 generic {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tclIntPlat

    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}
declare 19 macosx {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}


# Local Variables:
# mode: tcl
# End:

 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 by Miguel Sofer. 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: tclInt.h,v 1.430 2009/07/15 13:17:18 dkf Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options.

/*
 * This is for itcl - it likes to search our varTables directly :(
 */

#define TclVarHashFindVar(tablePtr, key) \
    TclVarHashCreateVar((tablePtr), (key), NULL)

/*
 * Define this to reduce the amount of space that the average namespace
 * consumes by only allocating the table of child namespaces when necessary.
 * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which
 * reach directly into the Namespace structure.
 */

#undef BREAK_NAMESPACE_COMPAT

/*
 * The structure below defines a namespace.
 * Note: the first five fields must match exactly the fields in a
 * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change
 * the other.
 */

				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Procedure invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Namespace *parentPtr;/* Points to the namespace that contains this
				 * one. NULL if this is the global
				 * namespace. */
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */

/*
 * tclIntDecls.h --
 *
 *	This file contains the declarations for all unsupported
 *	functions that are exported by the Tcl library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIntDecls.h,v 1.134 2009/07/15 13:17:18 dkf Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

				Command * cmdPtr);
#endif
#ifndef TclDbDumpActiveObjects_TCL_DECLARED
#define TclDbDumpActiveObjects_TCL_DECLARED
/* 243 */
EXTERN void		TclDbDumpActiveObjects (FILE * outFile);
#endif
#ifndef TclGetNamespaceChildTable_TCL_DECLARED
#define TclGetNamespaceChildTable_TCL_DECLARED
/* 244 */
EXTERN Tcl_HashTable *	TclGetNamespaceChildTable (Tcl_Namespace * nsPtr);
#endif
#ifndef TclGetNamespaceCommandTable_TCL_DECLARED
#define TclGetNamespaceCommandTable_TCL_DECLARED
/* 245 */
EXTERN Tcl_HashTable *	TclGetNamespaceCommandTable (Tcl_Namespace * nsPtr);
#endif
#ifndef TclInitRewriteEnsemble_TCL_DECLARED
#define TclInitRewriteEnsemble_TCL_DECLARED
/* 246 */
EXTERN int		TclInitRewriteEnsemble (Tcl_Interp * interp,
				int numRemoved, int numInserted,
				Tcl_Obj *const * objv);
#endif
#ifndef TclResetRewriteEnsemble_TCL_DECLARED
#define TclResetRewriteEnsemble_TCL_DECLARED
/* 247 */
EXTERN void		TclResetRewriteEnsemble (Tcl_Interp * interp,
				int isRootEnsemble);
#endif

typedef struct TclIntStubs {
    int magic;
    const struct TclIntStubHooks *hooks;

    void *reserved0;
    void *reserved1;

    int (*tclResetCancellation) (Tcl_Interp * interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp * interp, Tcl_Obj * procNameObj, int skip, ProcErrorProc errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp * interp, int result, struct TEOV_callback * rootPtr, int tebcCall); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp * interp, int objc, Tcl_Obj *const objv[], int flags, Command * cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE * outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace * nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace * nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp * interp, int numRemoved, int numInserted, Tcl_Obj *const * objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp * interp, int isRootEnsemble); /* 247 */
} TclIntStubs;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
extern const TclIntStubs *tclIntStubsPtr;
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

#define TclNREvalObjv \
	(tclIntStubsPtr->tclNREvalObjv) /* 242 */
#endif
#ifndef TclDbDumpActiveObjects
#define TclDbDumpActiveObjects \
	(tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */
#endif
#ifndef TclGetNamespaceChildTable
#define TclGetNamespaceChildTable \
	(tclIntStubsPtr->tclGetNamespaceChildTable) /* 244 */
#endif
#ifndef TclGetNamespaceCommandTable
#define TclGetNamespaceCommandTable \
	(tclIntStubsPtr->tclGetNamespaceCommandTable) /* 245 */
#endif
#ifndef TclInitRewriteEnsemble
#define TclInitRewriteEnsemble \
	(tclIntStubsPtr->tclInitRewriteEnsemble) /* 246 */
#endif
#ifndef TclResetRewriteEnsemble
#define TclResetRewriteEnsemble \
	(tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.192 2009/07/15 13:17:18 dkf Exp $
 */

#include "tclInt.h"
#include "tclCompile.h" /* just for NRCommand */

/*
 * Thread-local storage used to avoid having a global lock on data that is not

	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	/*
	 * Find the splicing spot: right before the NRCommand of the thing
	 * being tailcalled. Note that we skip NRCommands marked in data[1]
	 * (used by command redirectors)
	 */

	TEOV_callback *tailcallPtr, *runPtr;
	
	for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
	    if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
		break;

	}

	/*
	 * Check for a bad namespace name and make sure that the name does not
	 * already exist in the parent namespace.
	 */

	if (
#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
#else
	    parentPtr->childTablePtr != NULL &&
	    Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
	) {
	    Tcl_AppendResult(interp, "can't create namespace \"", name,
		    "\": already exists", NULL);
	    return NULL;
	}
    }

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
    nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
    strcpy(nsPtr->name, simpleName);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
#else
    nsPtr->childTablePtr = NULL;
#endif
    nsPtr->nsId = ++(tsdPtr->numNsCreated);
    nsPtr->interp = interp;
    nsPtr->flags = 0;
    nsPtr->activationCount = 0;
    nsPtr->refCount = 0;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    nsPtr->ensembles = NULL;
    nsPtr->unknownHandlerPtr = NULL;
    nsPtr->commandPathLength = 0;
    nsPtr->commandPathArray = NULL;
    nsPtr->commandPathSourceList = NULL;

    if (parentPtr != NULL) {
	entryPtr = Tcl_CreateHashEntry(
		TclGetNamespaceChildTable((Tcl_Namespace *)parentPtr),
		simpleName, &newEntry);
	Tcl_SetHashValue(entryPtr, nsPtr);
    } else {
	/*
	 * In the global namespace create traces to maintain the ::errorInfo
	 * and ::errorCode variables.
	 */

     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
	    }
	}
	nsPtr->parentPtr = NULL;
    } else if (!(nsPtr->flags & NS_KILLED)) {
	/*

	     * "errorInfo" and "errorCode" variables for errors that occurred
	     * while it was being torn down. Try to clear the variable list
	     * one last time.
	     */

	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree((char *) nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    /*
	     * If the reference count is 0, then discard the namespace.
	     * Otherwise, mark it as "dead" so that it can't be used.
	     */

    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Remove the namespace from its parent's child hashtable.
     */

    if (nsPtr->parentPtr != NULL) {
	entryPtr = Tcl_FindHashEntry(
		TclGetNamespaceChildTable((Tcl_Namespace *)
			nsPtr->parentPtr), nsPtr->name);
	if (entryPtr != NULL) {
	    Tcl_DeleteHashEntry(entryPtr);
	}
    }
    nsPtr->parentPtr = NULL;

    /*

     * BE CAREFUL: When each child is deleted, it will divorce itself from its
     * parent. You can't traverse a hash table properly if its elements are
     * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
     *
     * Don't optimize to Tcl_NextHashEntry() because of traces.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entryPtr != NULL;
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
	childNsPtr = Tcl_GetHashValue(entryPtr);
	Tcl_DeleteNamespace(childNsPtr);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		entryPtr != NULL;
		entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
	    childNsPtr = Tcl_GetHashValue(entryPtr);
	    Tcl_DeleteNamespace(childNsPtr);
	}
    }
#endif

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {

    /*
     * From the pattern, find the namespace from which we are importing and
     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
	return TCL_ERROR;
    }
    TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (importNsPtr == NULL) {

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

    while (!exported && (i < importNsPtr->numExportPatterns)) {
	exported |= Tcl_StringMatch(cmdName,
		importNsPtr->exportArrayPtr[i++]);
    }
    if (!exported) {
	return TCL_OK;
    }

    /*
     * Unless there is a name clash, create an imported command in the current

	    }
	    Tcl_GetCommandInfoFromToken(firstToken, &info);
	    if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
		continue;
	    }
	    origin = firstToken;
	}
	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){
	    Tcl_DeleteCommandFromToken(interp, token);
	}
    }
    return TCL_OK;
}

/*

	 * Look up the namespace qualifier nsName in the current namespace
	 * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set,
	 * create that qualifying namespace. This is needed for functions like
	 * Tcl_CreateCommand that cannot fail.
	 */

	if (nsPtr != NULL) {
#ifndef BREAK_NAMESPACE_COMPAT
	    entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
#else
	    if (nsPtr->childTablePtr == NULL) {
		entryPtr = NULL;
	    } else {
		entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
	    }
#endif
	    if (entryPtr != NULL) {
		nsPtr = Tcl_GetHashValue(entryPtr);
	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
		Tcl_CallFrame *framePtr;

		(void) TclPushStackFrame(interp, &framePtr,
			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);

		nsPtr = (Namespace *)
			Tcl_CreateNamespace(interp, nsName, NULL, NULL);
		TclPopStackFrame(interp);

		if (nsPtr == NULL) {
		    Tcl_Panic("Could not create namespace '%s'", nsName);
		}
	    } else {			/* Namespace not found and was not
					 * created. */
		nsPtr = NULL;
	    }
	}

	/*
	 * Look up the namespace qualifier in the alternate search path too.
	 */

	if (altNsPtr != NULL) {
#ifndef BREAK_NAMESPACE_COMPAT
	    entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
#else
	    if (altNsPtr->childTablePtr != NULL) {
		entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
	    } else {
		entryPtr = NULL;
	    }
#endif
	    if (entryPtr != NULL) {
		altNsPtr = Tcl_GetHashValue(entryPtr);
	    } else {
		altNsPtr = NULL;
	    }
	}

	 */

	found = 1;
	shadowNsPtr = globalNsPtr;

	for (i = trailFront;  i >= 0;  i--) {
	    trailNsPtr = trailPtr[i];
#ifndef BREAK_NAMESPACE_COMPAT
	    hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
		    trailNsPtr->name);
#else
	    if (shadowNsPtr->childTablePtr != NULL) {
		hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
			trailNsPtr->name);
	    } else {
		hPtr = NULL;
	    }
#endif
	    if (hPtr != NULL) {
		shadowNsPtr = Tcl_GetHashValue(hPtr);
	    } else {
		found = 0;
		break;
	    }
	}

    /*
     * Get a pointer to the specified namespace, or the current namespace.
     */

    if (objc == 2) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else if ((objc == 3) || (objc == 4)) {
	if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK){
	    return TCL_ERROR;
	}
	nsPtr = (Namespace *) namespacePtr;
    } else {
	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
	return TCL_ERROR;
    }

    listPtr = Tcl_NewListObj(0, NULL);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	unsigned int length = strlen(nsPtr->fullName);

	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
	    goto searchDone;
	}
	if (
#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL
#else
	    nsPtr->childTablePtr != NULL &&
	    Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL
#endif
	) {
	    Tcl_ListObjAppendElement(interp, listPtr,
		    Tcl_NewStringObj(pattern, -1));
	}
	goto searchDone;
    }
#ifndef BREAK_NAMESPACE_COMPAT
    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
#else
    if (nsPtr->childTablePtr == NULL) {
	goto searchDone;
    }
    entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
#endif
    while (entryPtr != NULL) {
	childNsPtr = Tcl_GetHashValue(entryPtr);
	if ((pattern == NULL)
		|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
	    elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
	    Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
	}

	cmdObjPtr = objv[3];
    } else {
	Tcl_Obj *concatObjv[2];
	register Tcl_Obj *listPtr;

	listPtr = Tcl_NewListObj(0, NULL);
	for (i = 4;  i < objc;  i++) {
	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
		Tcl_DecrRefCount(listPtr);	/* Free unneeded obj. */
		return TCL_ERROR;
	    }
	}

	concatObjv[0] = objv[3];
	concatObjv[1] = listPtr;

    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetNamespaceCommandTable --
 *
 *	Returns the hash table of commands.
 *
 * Results:
 *	Pointer to the hash table.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashTable *
TclGetNamespaceCommandTable(
    Tcl_Namespace *nsPtr)
{
    return &((Namespace *) nsPtr)->cmdTable;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetNamespaceChildTable --
 *
 *	Returns the hash table of child namespaces.
 *
 * Results:
 *	Pointer to the hash table.
 *
 * Side effects:
 *	Might allocate memory.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashTable *
TclGetNamespaceChildTable(
    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = (Tcl_HashTable*) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceEnsembleCmd --
 *
 *	Invoked to implement the "namespace ensemble" command that creates and

	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
			"\" is not an ensemble command", NULL);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
	    return NULL;

 *	Create an ensemble from a table of implementation commands. The
 *	ensemble will be subject to (limited) compilation if any of the
 *	implementation commands are compilable.
 *
 *	The 'name' parameter may be a single command name or a list if
 *	creating an ensemble subcommand (see the binary implementation).
 *
 *	Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on
 *	top-level ensemble commands.
 *
 * Results:
 *	Handle for the new ensemble, or NULL on failure.
 *
 * Side effects:
 *	May advance the bytecode compilation epoch.

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */

#if 0
	if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) {
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
	}
#else
	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	    iPtr->ensembleRewrite.sourceObjs = objv;
	    iPtr->ensembleRewrite.numRemovedObjs =
		    2 + ensemblePtr->numParameters;
	    iPtr->ensembleRewrite.numInsertedObjs =
		    prefixObjc + ensemblePtr->numParameters;
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	} else {
	    register int ni = 2 + ensemblePtr->numParameters
		    - iPtr->ensembleRewrite.numInsertedObjs;
				/* Position in objv of new front of insertion
				 * relative to old one. */
	    if (ni > 0) {
		iPtr->ensembleRewrite.numRemovedObjs += ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}
#endif

	/*
	 * Hand off to the target command.
	 */

	iPtr->evalFlags |= TCL_EVAL_REDIRECT;	
	return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);

}

int
TclClearRootEnsemble(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    TclResetRewriteEnsemble(interp, 1);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitRewriteEnsemble --
 *
 *	Applies a rewrite of arguments so that an ensemble subcommand will
 *	report error messages correctly for the overall command.
 *
 * Results:
 *	Whether this is the first rewrite applied, a value which must be
 *	passed to TclResetRewriteEnsemble when undoing this command's
 *	behaviour.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    int numRemoved,
    int numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
        iPtr->ensembleRewrite.sourceObjs = objv;
        iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
        iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
        int numIns = iPtr->ensembleRewrite.numInsertedObjs;

        if (numIns < numRemoved) {
            iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
            iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
        } else {
            iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
        }
    }
    return isRootEnsemble;
}

/*
 *----------------------------------------------------------------------
 *
 * TclResetRewriteEnsemble --
 *
 *	Removes any rewrites applied to support proper reporting of error
 *	messages used in ensembles. Should be paired with
 *	TclInitRewriteEnsemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclResetRewriteEnsemble(
    Tcl_Interp *interp,
    int isRootEnsemble)
{
    Interp *iPtr = (Interp *) interp;

    if (isRootEnsemble) {
        iPtr->ensembleRewrite.sourceObjs = NULL;
        iPtr->ensembleRewrite.numRemovedObjs = 0;
        iPtr->ensembleRewrite.numInsertedObjs = 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * EnsmebleUnknownCallback --
 *

/*
 * tclResolve.c --
 *
 *	Contains hooks for customized command/variable name resolution
 *	schemes. These hooks allow extensions like [incr Tcl] to add their own
 *	name resolution rules to the Tcl language. Rules can be applied to a
 *	particular namespace, to the interpreter as a whole, or both.
 *
 * Copyright (c) 1998 Lucent Technologies, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclResolve.c,v 1.11 2009/07/15 13:17:19 dkf Exp $
 */

#include "tclInt.h"

/*
 * Declarations for functions local to this file:
 */

    Namespace *nsPtr)		/* Namespace being modified. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;

    nsPtr->cmdRefEpoch++;

#ifndef BREAK_NAMESPACE_COMPAT
    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	Namespace *childNsPtr = Tcl_GetHashValue(entry);

	BumpCmdRefEpochs(childNsPtr);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	    Namespace *childNsPtr = Tcl_GetHashValue(entry);

	    BumpCmdRefEpochs(childNsPtr);
	}
    }
#endif
    TclInvalidateNsPath(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetNamespaceResolvers --

/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.183 2009/07/15 13:17:19 dkf Exp $
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Remove macros that will interfere with the definitions below.

    TclResetCancellation, /* 237 */
    TclNRInterpProc, /* 238 */
    TclNRInterpProcCore, /* 239 */
    TclNRRunCallbacks, /* 240 */
    TclNREvalObjEx, /* 241 */
    TclNREvalObjv, /* 242 */
    TclDbDumpActiveObjects, /* 243 */
    TclGetNamespaceChildTable, /* 244 */
    TclGetNamespaceCommandTable, /* 245 */
    TclInitRewriteEnsemble, /* 246 */
    TclResetRewriteEnsemble, /* 247 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */