* generic/tclProc.c (TclCloneProc): Helper for Tcl_CloneInterp.

	* generic/tclBasic.c: Line 3843ff: New Tcl_CloneInterp public API.

	* generic/tclProc.c (TclCloneProc): See below. New function.

	* generic/tclBasic.c: Tcl_Clone... functions. New. Tcl_CloneInterp
	  is main entry into this.

	* Part of work on more sharing of bytecode information between
	  structurally equivalent interpreters.

	* generic/tclCompile.c (EncodeCmdLocMap): Operate on ByteCodeData
	  instead of ByteCode.
	  (TclCleanupByteCode): Deref to ByteCodeData in numerous places.
	  (TclInitByteCodeObj): s.a.
	  (TclPrintByteCodeObj): s.a.
	  (TclPrintInstruction): s.a.
	  (RecordByteCodeStats): s.a.

	* generic/tclLiteral.c (TclReleaseLiteral): s.a.

	* generic/tclCompile.h: Split struct ByteCode into two
	  structures. The new structure carries the shareable bytrecode
	  information and is named 'ByteCodeData'.

	* generic/tclExecute.c (GetExceptRangeForPc): s.a.
	  (TclExecuteByteCode): s.a.
	  (PrintByteCodeInfo): s.a.
	  (ValidatePcAndStackTop): s.a.
	  (GetSrcInfoForPc): s.a.

14 files changed, 1829 insertions, 247 deletions

diff --git a/ChangeLog b/ChangeLog
index 9ef6053..c97709d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,41 @@
+2002-11-08  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclProc.c (TclCloneProc): Helper for Tcl_CloneInterp. 
+
+	* generic/tclBasic.c: Line 3843ff: New Tcl_CloneInterp public API.
+
+2002-11-07  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclProc.c (TclCloneProc): See below. New function.
+
+	* generic/tclBasic.c: Tcl_Clone... functions. New. Tcl_CloneInterp
+	  is main entry into this.
+
+2002-11-07  Andreas Kupries  <andreask@activestate.com>
+
+	* Part of work on more sharing of bytecode information between
+	  structurally equivalent interpreters.
+
+	* generic/tclCompile.c (EncodeCmdLocMap): Operate on ByteCodeData
+	  instead of ByteCode.
+	  (TclCleanupByteCode): Deref to ByteCodeData in numerous places.
+	  (TclInitByteCodeObj): s.a.
+	  (TclPrintByteCodeObj): s.a.
+	  (TclPrintInstruction): s.a.
+	  (RecordByteCodeStats): s.a.
+
+	* generic/tclLiteral.c (TclReleaseLiteral): s.a.
+
+	* generic/tclCompile.h: Split struct ByteCode into two
+	  structures. The new structure carries the shareable bytrecode
+	  information and is named 'ByteCodeData'.
+
+	* generic/tclExecute.c (GetExceptRangeForPc): s.a.
+	  (TclExecuteByteCode): s.a.
+	  (PrintByteCodeInfo): s.a.
+	  (ValidatePcAndStackTop): s.a.
+	  (GetSrcInfoForPc): s.a.
+
 2002-11-07  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* generic/tclExecute.c (EvalStatsCmd): obj-ify evalstats command,
diff --git a/generic/tcl.decls b/generic/tcl.decls
index de18321..785b403 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.33.2.2.2.1 2001/11/28 17:58:35 andreas_kupries Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.33.2.2.2.2 2002/11/26 19:48:48 andreas_kupries Exp $
 
 library tcl
 
@@ -1652,6 +1652,11 @@ declare 411 generic {
 #    char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj* pathPtr)
 #}
 
+declare 500 generic {
+    Tcl_Interp * Tcl_CloneInterp (Tcl_Interp* srcInterp)
+}
+
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 4636970..00bfb15 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,9 +12,9 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.27.6.4 2002/11/07 19:04:59 hobbs Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.27.6.5 2002/11/26 19:48:49 andreas_kupries Exp $
  */
-
+#include <assert.h>
 #include "tclInt.h"
 #include "tclCompile.h"
 #ifndef TCL_GENERIC_ONLY
@@ -3835,4 +3835,803 @@ void Tcl_GetVersion(majorV, minorV, patchLevelV, type)
         *type = TCL_RELEASE_LEVEL;
     }
 }
+
  
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CloneInterp --
+ *
+ *	Create a new TCL command interpreter as a clone of an existing
+ *	interpreter.
+ *
+ * Results:
+ *	The return value is a token for the interpreter, which may be
+ *	used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
+ *	Tcl_DeleteInterp.
+ *
+ * Side effects:
+ *	The command interpreter is initialized with structural equivalents
+ *	of the variables and commands of the source interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+/*
+ * Structures used for handling the fixup of ImportRef's across
+ * namespaces.  This operation is global acrosss all namespaces in the
+ * interp, and thus can be done only after all namespaces have been
+ * traversed.
+ */
+
+/*
+ * Associate original and clone for all commands which have an
+ * ImportRef list, i.e. commands which are imported somewhere.
+ */
+
+typedef struct IRFixupCmdAssoc {
+  struct IRFixupCmdAssoc* nextPtr;
+  Command*                original;
+  Command*                clone;
+} IRFixupCmdAssoc;
+
+typedef struct IRFixupVarAssoc {
+  struct IRFixupVarAssoc* nextPtr;
+  Var*                    original;
+  Var*                    clone;
+} IRFixupVarAssoc;
+
+/*
+ * Remember the commands which are imported.
+ */
+
+typedef struct IRFixupImported {
+  struct IRFixupImported* nextPtr;
+  ImportedCmdData*        icPtr;
+} IRFixupImported;
+
+typedef struct IRFixupVar {
+  struct IRFixupVar* nextPtr;
+  Var*               varPtr;
+} IRFixupVar;
+
+/*
+ * All data/context required for the fixup, recursively handed down to
+ * the namespace and command clone functions, for filling it out.
+ */
+
+typedef struct IRFixup {
+  IRFixupImported* imported;
+  IRFixupCmdAssoc* exported;
+  IRFixupVar*      varImported;
+  IRFixupVarAssoc* varExported;
+} IRFixup;
+
+
+static void CloneMathFunctions _ANSI_ARGS_((Interp* iPtr, Interp* srcIPtr));
+#if 0
+static void ListMathFunctions _ANSI_ARGS_ ((Interp* iPtr, CONST char* mark));
+#endif
+
+static void CloneNamespace _ANSI_ARGS_((Interp* interp, Namespace* ns,
+					Namespace* srcNs, IRFixup* fixup));
+	    
+static void CloneVariable _ANSI_ARGS_ ((Interp* interp, Namespace* ns,
+					Var* varSrcPtr, CONST char* varName,
+					IRFixup* fixup));
+
+static Tcl_HashTable* CloneArrayVariable _ANSI_ARGS_ ((Interp* interp,
+						       Var* varSrcPtr));
+
+static void CloneCommand _ANSI_ARGS_ ((Interp* interp, Namespace* ns,
+				       Command* cmdSrcPtr, CONST char* cmdName,
+				       IRFixup* fixup));
+
+static void CloneFixupImports _ANSI_ARGS_ ((IRFixup* fixup));
+static void CloneFixupVars    _ANSI_ARGS_ ((IRFixup* fixup));
+
+
+#define GetHashKeyString(hPtr) Tcl_GetHashKey ((hPtr->tablePtr),(hPtr))
+
+
+Tcl_Interp *
+Tcl_CloneInterp(srcInterp)
+     Tcl_Interp* srcInterp;
+{
+    Interp *srcIPtr = (Interp*) srcInterp;
+    Interp *iPtr;
+    Tcl_Interp *interp;
+    IRFixup fixup;
+
+#ifndef TCL_THREAD_LITERALS
+#ifdef TCL_COMPILE_STATS
+    ByteCodeStats *statsPtr;
+#endif /* TCL_COMPILE_STATS */
+#endif /* TCL_THREAD_LITERALS */
+
+    fixup.imported    = NULL;
+    fixup.exported    = NULL;
+    fixup.varImported = NULL;
+    fixup.varExported = NULL;
+
+    TclInitSubsystems(NULL);
+
+    /*
+     * Panic if someone updated the CallFrame structure without
+     * also updating the Tcl_CallFrame structure (or vice versa).
+     */  
+
+    if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
+	/*NOTREACHED*/
+        panic("Tcl_CallFrame and CallFrame are not the same size");
+    }
+
+    /*
+     * Initialize support for namespaces and create the global namespace
+     * (whose name is ""; an alias is "::"). This also initializes the
+     * Tcl object type table and other object management code.
+     */
+
+    iPtr = (Interp *) ckalloc(sizeof(Interp));
+    interp = (Tcl_Interp *) iPtr;
+
+    iPtr->result		= iPtr->resultSpace;
+    iPtr->freeProc		= NULL;
+    iPtr->errorLine		= 0;
+    iPtr->objResultPtr		= Tcl_NewObj();
+    Tcl_IncrRefCount(iPtr->objResultPtr);
+    iPtr->handle		= TclHandleCreate(iPtr);
+    iPtr->globalNsPtr		= NULL;
+    iPtr->hiddenCmdTablePtr	= NULL;
+    iPtr->interpInfo		= NULL;
+    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
+
+    iPtr->numLevels = 0;
+    iPtr->maxNestingDepth = 1000;
+    iPtr->framePtr = NULL;
+    iPtr->varFramePtr = NULL;
+    iPtr->activeTracePtr = NULL;
+    iPtr->returnCode = TCL_OK;
+    iPtr->errorInfo = NULL;
+    iPtr->errorCode = NULL;
+
+    iPtr->appendResult = NULL;
+    iPtr->appendAvl = 0;
+    iPtr->appendUsed = 0;
+
+    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
+
+    iPtr->packageUnknown = NULL;
+    if (srcIPtr->packageUnknown) {
+      unsigned int len = 1 + strlen(srcIPtr->packageUnknown);
+      iPtr->packageUnknown = (char*) ckalloc (len);
+      memcpy (iPtr->packageUnknown, srcIPtr->packageUnknown, len);
+    }
+
+
+    iPtr->cmdCount = 0;
+    iPtr->termOffset = 0;
+    iPtr->compileEpoch = 0;
+    iPtr->compiledProcPtr = NULL;
+    iPtr->resolverPtr = NULL;
+    iPtr->evalFlags = 0;
+    iPtr->scriptFile = NULL;
+    iPtr->flags = 0;
+    iPtr->tracePtr = NULL;
+    iPtr->assocData = (Tcl_HashTable *) NULL;
+    iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
+    iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
+    Tcl_IncrRefCount(iPtr->emptyObjPtr);
+    iPtr->resultSpace[0] = 0;
+
+    iPtr->globalNsPtr = NULL;	/* force creation of global ns below */
+    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
+	    (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
+    if (iPtr->globalNsPtr == NULL) {
+        panic("Tcl_CreateInterp: can't create global namespace");
+    }
+
+    /*
+     * Initialize support for code compilation and execution. We call
+     * TclCreateExecEnv after initializing namespaces since it tries to
+     * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
+     * variable).
+     */
+
+    iPtr->execEnvPtr = TclCreateExecEnv(interp);
+
+#ifndef TCL_THREAD_LITERALS
+    TclInitLiteralTable(&(iPtr->literalTable));
+
+    /*
+     * Initialize the compilation and execution statistics kept for this
+     * interpreter.
+     */
+
+#ifdef TCL_COMPILE_STATS
+    statsPtr = &(iPtr->stats);
+    (VOID *) memset(statsPtr, 0, sizeof(ByteCodeStats));
+#endif /* TCL_COMPILE_STATS */    
+#endif
+
+    /*
+     * Initialise the stub table pointer.
+     */
+
+    iPtr->stubTable = &tclStubs;
+
+    /*
+     * Clone all the commands and procedures in the source interpreter.
+     * Duplicate the namespace structure as we go. This also enforces
+     * the compilation of procedure bodies which are not yet compiled.
+     *
+     * Limitation: For C-based 'commands' with a non-NULL client data
+     * we do not know how to handle this. For the moment we simply
+     * copy the pointer. In the future commands may need a duplication
+     * method which is able to handle their client data.
+     *
+     * For proc's we know the structure of the client data and how to
+     * clone it. So we do. This is also at the heart of the issue of
+     * sharing bytecode information between interpreters.
+     */
+
+    CloneNamespace    (iPtr, iPtr->globalNsPtr, srcIPtr->globalNsPtr, &fixup);
+    CloneFixupImports (&fixup);
+    CloneFixupVars    (&fixup);
+
+    /*
+     * Clone the math functions registered in the source interp.
+     */
+
+    CloneMathFunctions (iPtr, srcIPtr);
+    iPtr->flags |= EXPR_INITIALIZED;
+
+#if !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES))
+    /*
+     * Do Multiple/Safe Interps Tcl init stuff
+     */
+
+    TclInterpInit(interp);
+#endif /* !(defined(TCL_NO_SLAVEINTERP) && defined(TCL_NO_CMDALIASES)) */
+
+    /*
+     * We used to create the "errorInfo" and "errorCode" global vars at this
+     * point because so much of the Tcl implementation assumes they already
+     * exist. This is not quite enough, however, since they can be unset
+     * at any time.
+     *
+     * There are 2 choices:
+     *    + Check every place where a GetVar of those is used 
+     *      and the NULL result is not checked (like in tclLoad.c)
+     *    + Make SetVar,... NULL friendly
+     * We choose the second option because :
+     *    + It is easy and low cost to check for NULL pointer before
+     *      calling strlen()
+     *    + It can be helpfull to other people using those API
+     *    + Passing a NULL value to those closest 'meaning' is empty string
+     *      (specially with the new objects where 0 bytes strings are ok)
+     * So the following init is commented out:              -- dl
+     *
+     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
+     *       "", TCL_GLOBAL_ONLY);
+     * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
+     *       "NONE", TCL_GLOBAL_ONLY);
+     */
+
+#ifndef TCL_GENERIC_ONLY
+    TclSetupEnv(interp);
+#endif
+
+    /*
+     * The variable 'tcl_platform', etc. already exist. They were
+     * created as part of the general cloning process in
+     * CloneNamespace. Only 'env' is special.
+     */
+
+    Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
+    Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    TclPrecTraceProc, (ClientData) NULL);
+    TclpSetVariables(interp);
+
+    /*
+     * Register Tcl's version number.
+     */
+
+    Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
+    
+#ifdef Tcl_InitStubs
+#undef Tcl_InitStubs
+#endif
+    Tcl_InitStubs(interp, TCL_VERSION, 1);
+    return interp;
+}
+
+
+static void
+CloneMathFunctions (iPtr, srcIPtr)
+     Interp* iPtr;
+     Interp* srcIPtr;
+{
+    Tcl_HashSearch math;
+    Tcl_HashEntry* hPtr;
+    Tcl_HashEntry* hPtrNew;
+    MathFunc *mathFuncPtr;
+    MathFunc *mathFuncPtrNew;
+    char* funcName;
+
+    for (hPtr = Tcl_FirstHashEntry (&srcIPtr->mathFuncTable, &math);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&math)) {
+
+        mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+	funcName    = GetHashKeyString (hPtr);
+
+	Tcl_CreateMathFunc((Tcl_Interp *) iPtr,
+			   funcName,
+			   mathFuncPtr->numArgs,
+			   mathFuncPtr->argTypes,
+			   mathFuncPtr->proc,
+			   mathFuncPtr->clientData);
+
+	hPtrNew = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
+
+	if (hPtrNew == NULL) {
+	    panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", funcName);
+	    return;
+	}
+	mathFuncPtrNew = (MathFunc *) Tcl_GetHashValue(hPtrNew);
+	mathFuncPtrNew->builtinFuncIndex = mathFuncPtr->builtinFuncIndex;
+    }
+}
+
+
+static void
+CloneNamespace (interp, ns, srcNs, fixup)
+     Interp* interp;
+     Namespace* ns;
+     Namespace* srcNs;
+     IRFixup* fixup;
+{
+    /*
+     * Assumes that 'ns' is an empty namespace, and makes it
+     * structurally identical to the source namespace. To this end it
+     * copies the variables, commands, procedures, and then recurses
+     * down to the children of the namespace.
+     */
+
+    Tcl_HashSearch children;
+    Tcl_HashEntry* hPtr;
+    Tcl_DString    childName;
+    Namespace*     childPtr;
+    Namespace*     childSrcPtr;
+
+    Tcl_HashSearch variables;
+    Var*           varSrcPtr;
+
+    Tcl_HashSearch commands;
+    Command*       cmdSrcPtr;
+
+    /*
+     * Phase I. Clone variables and their contents.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry (&srcNs->varTable, &variables);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&variables)) {
+
+        varSrcPtr = (Var *) Tcl_GetHashValue (hPtr);
+	/* assert varSrcPtr->hPtr  == hPtr */
+	/* assert varSrcPtr->nsPtr == srcNs */
+
+	CloneVariable (interp, ns, varSrcPtr,
+		       GetHashKeyString (hPtr),
+		       fixup);
+    }
+
+    /*
+     * Phase II. Clone commands, especially procedures.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry (&srcNs->cmdTable, &commands);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&commands)) {
+
+        cmdSrcPtr = (Command *) Tcl_GetHashValue (hPtr);
+
+	CloneCommand (interp, ns, cmdSrcPtr,
+		      GetHashKeyString (hPtr),
+		      fixup);
+    }
+
+    /*
+     * Phase III. Recurse down into the children.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry (&srcNs->childTable, &children);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&children)) {
+
+        childSrcPtr = (Namespace *) Tcl_GetHashValue (hPtr);
+
+	/* Create fully qualified name for cloned child */
+
+	Tcl_DStringInit   (&childName);
+	Tcl_DStringAppend (&childName, srcNs->fullName, -1);
+	if (srcNs->name [0] != '\0') {
+	  Tcl_DStringAppend (&childName, "::", -1);
+	}
+	Tcl_DStringAppend (&childName, childSrcPtr->name, -1);
+
+	childPtr = (Namespace *) Tcl_CreateNamespace((Tcl_Interp*) interp,
+			Tcl_DStringValue (&childName),
+			(ClientData) childSrcPtr->clientData,
+			(Tcl_NamespaceDeleteProc *) childSrcPtr->deleteProc);
+	CloneNamespace (interp, childPtr, childSrcPtr, fixup);
+    }
+}
+
+
+static void
+CloneVariable (interp, ns, varSrcPtr, varName, fixup)
+     Interp* interp;
+     Namespace* ns;
+     Var* varSrcPtr;
+     CONST char* varName;
+     IRFixup* fixup;
+{
+    int new;
+    Var* varNew = (Var*) ckalloc (sizeof (Var));
+
+    varNew->hPtr      = Tcl_CreateHashEntry(&ns->varTable, varName, &new);
+    Tcl_SetHashValue (varNew->hPtr, varNew);
+
+    varNew->nsPtr     = ns;
+    varNew->tracePtr  = NULL; /* Traces are not cloned */
+    varNew->searchPtr = NULL;
+    varNew->refCount  = 1;    /* Namespace variable */
+    varNew->name      = NULL; /* Variable contained in hashtable of namespace. */
+    varNew->flags     = varSrcPtr->flags;
+
+    if (varSrcPtr->flags & VAR_SCALAR) {
+        /*
+	 * We share the object used as the contents of the scalar
+	 * variable. Therefore we have one additional reference to
+	 * remember.
+	 *
+	 * FUTURE: Does not work for cloning across threads.
+	 */
+
+        varNew->value.objPtr = varSrcPtr->value.objPtr;
+	if (varNew->value.objPtr) {
+	  Tcl_IncrRefCount (varNew->value.objPtr);
+	}
+    } else if (varSrcPtr->flags & VAR_LINK) {
+
+        /* Remember variable for fixup later on */
+
+        IRFixupVar* fix = (IRFixupVar*) ckalloc (sizeof (IRFixupVar));
+
+        varNew->value.linkPtr = varSrcPtr->value.linkPtr;
+	fix->nextPtr = fixup->varImported;
+	fix->varPtr  = varNew;
+	fixup->varImported = fix;
+
+    } else if (varSrcPtr->flags & VAR_ARRAY) {
+        /*
+	 * We have to duplicate all elements of the array.
+	 */
+
+        varNew->value.tablePtr = CloneArrayVariable (interp, varSrcPtr);
+    } else {
+        panic ("CloneVariable: Unknown type of variable");
+    }
+
+    /*
+     * Possibly exported to other namespaces,
+     * remember for fixup. This can be off a
+     * bit because of active traces, but only
+     * overeach variables which are not
+     * exported, it will never miss exported
+     * ones.
+     */
+    if (varSrcPtr->refCount > 1) {
+        IRFixupVarAssoc* fix = (IRFixupVarAssoc*) ckalloc (sizeof (IRFixupVarAssoc));
+
+	fix->nextPtr  = fixup->varExported;
+	fix->original = varSrcPtr;
+	fix->clone    = varNew;
+	fixup->varExported = fix;
+    }
+}
+
+
+static Tcl_HashTable*
+CloneArrayVariable (interp, varSrcPtr)
+     Interp* interp;
+     Var* varSrcPtr;
+{
+    Tcl_HashTable* tablePtr = (Tcl_HashTable *) ckalloc (sizeof (Tcl_HashTable));
+    Tcl_HashSearch items;
+    Tcl_HashEntry* hPtr;
+    int new;
+    Var* varNew;
+    Var* itemVar;
+    char* varName;
+
+    Tcl_InitHashTable (tablePtr, TCL_STRING_KEYS);
+
+    for (hPtr = Tcl_FirstHashEntry (varSrcPtr->value.tablePtr, &items);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&items)) {
+
+        itemVar = (Var *) Tcl_GetHashValue (hPtr);
+	varNew = (Var*) ckalloc (sizeof (Var));
+
+	if (itemVar->flags & VAR_SCALAR) {
+	    /*
+	     * We share the object used as the contents of the scalar
+	     * variable. Therefore we have one additional reference to
+	     * remember.
+	     *
+	     * FUTURE: Does not work for cloning across threads.
+	     */
+
+	    varNew->value.objPtr = itemVar->value.objPtr;
+	    Tcl_IncrRefCount (varNew->value.objPtr);
+	} else if (itemVar->flags & VAR_LINK) {
+	    panic ("CloneArrayVariable: Unable to clone links");
+	} else if (itemVar->flags & VAR_ARRAY) {
+	    panic ("CloneArrayVariable: Illegal nesting of array in array");
+	} else {
+	    panic ("CloneArrayVariable: Unknown type of variable");
+	}
+
+	varName = GetHashKeyString (hPtr);
+
+	varNew->hPtr      = Tcl_CreateHashEntry(tablePtr, varName, &new);
+	Tcl_SetHashValue (varNew->hPtr, varNew);
+
+	varNew->nsPtr     = NULL; /* Array element */
+	varNew->tracePtr  = NULL; /* Traces are not cloned */
+	varNew->searchPtr = NULL;
+	varNew->refCount  = 0;    /* Array element */
+	varNew->name      = NULL; /* Variable contained in hashtable of array. */
+	varNew->flags     = itemVar->flags;
+    }
+
+    return tablePtr;
+}
+
+
+static void
+CloneCommand (interp, ns, cmdSrcPtr, cmdName, fixup)
+     Interp* interp;
+     Namespace* ns;
+     Command* cmdSrcPtr;
+     CONST char* cmdName;
+     IRFixup* fixup;
+{
+    int new;
+    Command* cmdNew = (Command *) ckalloc (sizeof (Command));
+
+    cmdNew->hPtr          = Tcl_CreateHashEntry(&ns->cmdTable, cmdName, &new);
+    Tcl_SetHashValue (cmdNew->hPtr, cmdNew);
+
+    cmdNew->nsPtr         = ns;
+    cmdNew->cmdEpoch      = cmdSrcPtr->cmdEpoch;
+    cmdNew->compileProc   = cmdSrcPtr->compileProc;
+    cmdNew->objProc       = cmdSrcPtr->objProc;
+    cmdNew->objClientData = cmdSrcPtr->objClientData; /* NOTE limitations */
+    cmdNew->proc          = cmdSrcPtr->proc;
+    cmdNew->clientData    = cmdSrcPtr->clientData; /* NOTE limitations */
+    cmdNew->deleteProc    = cmdSrcPtr->deleteProc;
+    cmdNew->deleteData    = cmdSrcPtr->deleteData; /* NOTE limitations */
+    cmdNew->deleted       = 0;
+    cmdNew->importRefPtr  = NULL;
+
+    if (cmdSrcPtr->importRefPtr) {
+        /*
+         * Remember commands imported somewhere else, ie. exported
+         * from their native namespace. After the base cloning is
+         * complete we have to create their import ref lists and use
+         * the 'fixup' information to do so.
+	 */
+
+        IRFixupCmdAssoc* irfa = (IRFixupCmdAssoc *) ckalloc (sizeof (IRFixupCmdAssoc));
+	irfa->nextPtr   = fixup->exported;
+	irfa->original  = cmdSrcPtr;
+	irfa->clone     = cmdNew;
+	fixup->exported = irfa;
+    }
+
+    /*
+     * Special cases where we know how to handle client data beyond simple copying.
+     */
+
+    if  (cmdNew->objProc == TclInvokeStringCommand) {
+        cmdNew->objClientData = (ClientData) cmdNew;
+    }
+    if  (cmdNew->proc == TclInvokeObjectCommand) {
+        cmdNew->clientData = (ClientData) cmdNew;
+    }
+    if (cmdNew->objProc == TclInvokeImportedCmd) {
+        /*
+	 * Clone the ImportedCmdData structure.
+	 *
+	 * Note that this means that we have to fix up the ImportRef's
+	 * in the real command too. To this end we remember these
+	 * commands in global fixup context given to us.
+	 */
+
+        IRFixupImported* irfi = (IRFixupImported *) ckalloc (sizeof (IRFixupImported));
+
+        ImportedCmdData* orig = (ImportedCmdData *) cmdNew->objClientData;
+	ImportedCmdData* new  = (ImportedCmdData *) ckalloc (sizeof (ImportedCmdData));
+
+	new->selfPtr = cmdNew;
+	new->realCmdPtr = orig->realCmdPtr;	/* FIXUP in second pass */
+	cmdNew->objClientData = (ClientData) new;
+	cmdNew->deleteData    = (ClientData) new;
+
+	irfi->nextPtr   = fixup->imported;
+	irfi->icPtr     = new;
+	fixup->imported = irfi;
+    }
+
+
+    if  (cmdNew->objProc == TclObjInterpProc) {
+        Proc *procPtr = TclCloneProc (interp, ns,
+				      (Proc *) cmdSrcPtr->objClientData);
+
+	/*assert (strcmp (cmdName, "foo") != 0);*/
+
+	cmdNew->objClientData = procPtr;
+	cmdNew->clientData    = procPtr;
+	cmdNew->deleteData    = procPtr;
+	procPtr->cmdPtr       = cmdNew;
+    }
+
+    /* The cloned command will be referenced by the hashtable, but not by CmdName objects. ...
+     * CmdName objects in the bytecode refer to the Command in the master and will switch
+     * during execution ...
+     */
+    cmdNew->refCount  = 1;
+}
+
+
+static Command*
+CloneFixupFindClone (exported, cmd)
+     IRFixupCmdAssoc* exported;
+     Command* cmd;
+{
+    while (exported) {
+        if (exported->original == cmd) {
+	    return exported->clone;
+	}
+	exported = exported->nextPtr;
+    }
+    panic ("Unable to find clone for command to fixup");
+    return NULL;
+}
+
+static Var*
+CloneFixupFindCloneVar (exported, var)
+     IRFixupVarAssoc* exported;
+     Var* var;
+{
+    while (exported) {
+        if (exported->original == var) {
+	    return exported->clone;
+	}
+	exported = exported->nextPtr;
+    }
+    panic ("Unable to find clone for variable to fixup");
+    return NULL;
+}
+
+static void
+CloneFixupImports  (fixup)
+     IRFixup* fixup;
+{
+    IRFixupImported* irfi;
+    IRFixupCmdAssoc* irfa;
+    ImportRef*       newref;
+    Command*         cloneReal;
+
+    /*
+     * Fixup ImportedCmdData structures and generate the associated
+     * ImportRef structures. Free the fixup data.
+     */
+
+    for (irfi = fixup->imported;
+	 irfi;
+	 fixup->imported = irfi->nextPtr,
+	   ckfree ((char*) irfi),
+	   irfi = fixup->imported) {
+
+        cloneReal = CloneFixupFindClone (fixup->exported,
+			 /* cloneOrig */ irfi->icPtr->realCmdPtr);
+
+	irfi->icPtr->realCmdPtr = cloneReal;
+
+	newref = (ImportRef *) ckalloc (sizeof (ImportRef));
+
+	newref->importedCmdPtr = irfi->icPtr->selfPtr;
+	newref->nextPtr        = NULL;
+
+	cloneReal->importRefPtr = newref;
+    }
+
+    /* Free transient data */
+
+    for (irfa = fixup->exported;
+	 irfa;
+	 fixup->exported = irfa->nextPtr,
+	   ckfree ((char*) irfa),
+	   irfa = fixup->exported) {
+    }
+}
+
+static void
+CloneFixupVars  (fixup)
+     IRFixup* fixup;
+{
+    IRFixupVar*      irfi;
+    IRFixupVarAssoc* irfa;
+    Var*            cloneReal;
+
+    /*
+     * Fixup Var structures and increment the
+     * refcount in the exported variables.
+     * Free the fixup data.
+     */
+
+    for (irfi = fixup->varImported;
+	 irfi;
+	 fixup->varImported = irfi->nextPtr,
+	   ckfree ((char*) irfi),
+	   irfi = fixup->varImported) {
+
+        cloneReal = CloneFixupFindCloneVar (fixup->varExported,
+					    /* cloneOrig */ irfi->varPtr->value.linkPtr);
+
+	cloneReal->refCount ++;
+	irfi->varPtr->value.linkPtr = cloneReal;
+    }
+
+    /* Free transient data */
+
+    for (irfa = fixup->varExported;
+	 irfa;
+	 fixup->varExported = irfa->nextPtr,
+	   ckfree ((char*) irfa),
+	   irfa = fixup->varExported) {
+    }
+}
+
+#if 0
+static void
+ListMathFunctions (iPtr,mark)
+     Interp* iPtr;
+     CONST char* mark;
+{
+    Tcl_HashSearch math;
+    Tcl_HashEntry* hPtr;
+    MathFunc *mathFuncPtr;
+    char* funcName;
+
+    printf ("--- %s --------------------\n", mark); fflush (stdout);
+    for (hPtr = Tcl_FirstHashEntry (&iPtr->mathFuncTable, &math);
+	 hPtr != NULL;
+	 hPtr = Tcl_NextHashEntry (&math)) {
+
+        mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+	funcName    = GetHashKeyString (hPtr);
+
+	printf("%p list/math %p (%s) @%d, %p\n", iPtr, mathFuncPtr, funcName, mathFuncPtr->builtinFuncIndex, mathFuncPtr->proc);fflush (stdout);
+    }
+}
+#endif
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index bfad3fb..0c20f91 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.20.2.1.2.5 2002/11/07 19:05:00 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.20.2.1.2.6 2002/11/26 19:48:50 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -220,7 +220,7 @@ InstructionDesc instructionTable[] = {
 static void		DupByteCodeInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
 static unsigned char *	EncodeCmdLocMap _ANSI_ARGS_((
-			    CompileEnv *envPtr, ByteCode *codePtr,
+			    CompileEnv *envPtr, ByteCodeData *bcDataPtr,
 			    unsigned char *startPtr));
 static void		EnterCmdExtentData _ANSI_ARGS_((
     			    CompileEnv *envPtr, int cmdNumber,
@@ -507,12 +507,8 @@ void
 TclCleanupByteCode(codePtr)
     register ByteCode *codePtr;	/* Points to the ByteCode to free. */
 {
-    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
-    int numLitObjects = codePtr->numLitObjects;
-    int numAuxDataItems = codePtr->numAuxDataItems;
-    register Tcl_Obj **objArrayPtr;
-    register AuxData *auxDataPtr;
-    int i;
+    Tcl_Interp *interp               = (Tcl_Interp *) *codePtr->interpHandle;
+    register ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
 
 #ifdef TCL_COMPILE_STATS
     if (interp != NULL) {
@@ -525,25 +521,25 @@ TclCleanupByteCode(codePtr)
 	int lifetimeSec, lifetimeMicroSec, log2;
 
 	statsPtr->numByteCodesFreed++;
-	statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
-	statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
+	statsPtr->currentSrcBytes -= (double) bcDataPtr->numSrcBytes;
+	statsPtr->currentByteCodeBytes -= (double) bcDataPtr->structureSize;
 
-	statsPtr->currentInstBytes   -= (double) codePtr->numCodeBytes;
+	statsPtr->currentInstBytes   -= (double) bcDataPtr->numCodeBytes;
 	statsPtr->currentLitBytes    -=
-		(double) (codePtr->numLitObjects * sizeof(Tcl_Obj *)); 
+		(double) (bcDataPtr->numLitObjects * sizeof(Tcl_Obj *)); 
 	statsPtr->currentExceptBytes -=
-		(double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
+		(double) (bcDataPtr->numExceptRanges * sizeof(ExceptionRange));
 	statsPtr->currentAuxBytes    -=
-		(double) (codePtr->numAuxDataItems * sizeof(AuxData));
-	statsPtr->currentCmdMapBytes -= (double) codePtr->numCmdLocBytes;
+		(double) (bcDataPtr->numAuxDataItems * sizeof(AuxData));
+	statsPtr->currentCmdMapBytes -= (double) bcDataPtr->numCmdLocBytes;
 
 	TclpGetTime(&destroyTime);
-	lifetimeSec = destroyTime.sec - codePtr->createTime.sec;
+	lifetimeSec = destroyTime.sec - bcDataPtr->createTime.sec;
 	if (lifetimeSec > 2000) {	/* avoid overflow */
 	    lifetimeSec = 2000;
 	}
 	lifetimeMicroSec =
-	    1000000*lifetimeSec + (destroyTime.usec - codePtr->createTime.usec);
+	    1000000*lifetimeSec + (destroyTime.usec - bcDataPtr->createTime.usec);
 	
 	log2 = TclLog2(lifetimeMicroSec);
 	if (log2 > 31) {
@@ -553,63 +549,82 @@ TclCleanupByteCode(codePtr)
     }
 #endif /* TCL_COMPILE_STATS */
 
-    /*
-     * A single heap object holds the ByteCode structure and its code,
-     * object, command location, and auxiliary data arrays. This means we
-     * only need to 1) decrement the ref counts of the LiteralEntry's in
-     * its literal array, 2) call the free procs for the auxiliary data
-     * items, and 3) free the ByteCode structure's heap object.
-     *
-     * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
-     * like those generated from tbcload) is special, as they doesn't
-     * make use of the global literal table.  They instead maintain
-     * private references to their literals which must be decremented.
-     */
+    bcDataPtr->refCount --;
+    if (bcDataPtr->refCount <= 0) {
+        int numLitObjects = bcDataPtr->numLitObjects;
+	int numAuxDataItems = bcDataPtr->numAuxDataItems;
+	register Tcl_Obj **objArrayPtr;
+	register AuxData *auxDataPtr;
+	int i;
+
+        /*
+	 * NEW: The auxiliary data and literal arrays can be shared. We
+	 * decr the refcount of that object, and do the following only if
+	 * that counter reached zero == bytecode data was not shared with
+	 * other interpreters.
+	 */
 
-    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-	register Tcl_Obj *objPtr;
- 
-	objArrayPtr = codePtr->objArrayPtr;
-	for (i = 0;  i < numLitObjects;  i++) {
-	    objPtr = *objArrayPtr;
-	    if (objPtr) {
-		Tcl_DecrRefCount(objPtr);
-	    }
-	    objArrayPtr++;
-	}
-	codePtr->numLitObjects = 0;
-    } else if (interp != NULL) {
 	/*
-	 * If the interp has already been freed, then Tcl will have already 
-	 * forcefully released all the literals used by ByteCodes compiled
-	 * with respect to that interp.
+	 * A single heap object holds the ByteCode structure and its code,
+	 * object, command location, and auxiliary data arrays. This means we
+	 * only need to 1) decrement the ref counts of the LiteralEntry's in
+	 * its literal array, 2) call the free procs for the auxiliary data
+	 * items, and 3) free the ByteCode structure's heap object.
+	 *
+	 * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
+	 * like those generated from tbcload) is special, as they doesn't
+	 * make use of the global literal table.  They instead maintain
+	 * private references to their literals which must be decremented.
 	 */
-	 
-	objArrayPtr = codePtr->objArrayPtr;
-	for (i = 0;  i < numLitObjects;  i++) {
+
+	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+	    register Tcl_Obj *objPtr;
+ 
+	    objArrayPtr = bcDataPtr->objArrayPtr;
+	    for (i = 0;  i < numLitObjects;  i++) {
+	        objPtr = *objArrayPtr;
+		if (objPtr) {
+		    Tcl_DecrRefCount(objPtr);
+		}
+		objArrayPtr++;
+	    }
+	    bcDataPtr->numLitObjects = 0;
+	} else if (interp != NULL) {
 	    /*
-	     * TclReleaseLiteral sets a ByteCode's object array entry NULL to
-	     * indicate that it has already freed the literal.
+	     * If the interp has already been freed, then Tcl will have already 
+	     * forcefully released all the literals used by ByteCodes compiled
+	     * with respect to that interp.
 	     */
+	 
+	    objArrayPtr = bcDataPtr->objArrayPtr;
+	    for (i = 0;  i < numLitObjects;  i++) {
+	        /*
+		 * TclReleaseLiteral sets a ByteCode's object array entry NULL to
+		 * indicate that it has already freed the literal.
+		 */
 	    
-	    if (*objArrayPtr != NULL) {
-		TclReleaseLiteral(interp, *objArrayPtr);
+	        if (*objArrayPtr != NULL) {
+		    TclReleaseLiteral(interp, *objArrayPtr);
+		}
+		objArrayPtr++;
 	    }
-	    objArrayPtr++;
 	}
-    }
     
-    auxDataPtr = codePtr->auxDataArrayPtr;
-    for (i = 0;  i < numAuxDataItems;  i++) {
-	if (auxDataPtr->type->freeProc != NULL) {
-	    (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
+	auxDataPtr = bcDataPtr->auxDataArrayPtr;
+	for (i = 0;  i < numAuxDataItems;  i++) {
+	    if (auxDataPtr->type->freeProc != NULL) {
+	        (*auxDataPtr->type->freeProc)(auxDataPtr->clientData);
+	    }
+	    auxDataPtr++;
 	}
-	auxDataPtr++;
+
+	ckfree ((char*) bcDataPtr);
     }
 
     TclHandleRelease(codePtr->interpHandle);
     ckfree((char *) codePtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1483,6 +1498,7 @@ TclInitByteCodeObj(objPtr, envPtr)
 				  * which to create a ByteCode structure. */
 {
     register ByteCode *codePtr;
+    register ByteCodeData *bcDataPtr;
     size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
     size_t auxDataArrayBytes, structureSize;
     register unsigned char *p;
@@ -1504,7 +1520,7 @@ TclInitByteCodeObj(objPtr, envPtr)
      * Compute the total number of bytes needed for this bytecode.
      */
 
-    structureSize = sizeof(ByteCode);
+    structureSize = sizeof(ByteCodeData);
     structureSize += TCL_ALIGN(codeBytes);        /* align object array */
     structureSize += TCL_ALIGN(objArrayBytes);    /* align exc range arr */
     structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
@@ -1516,9 +1532,13 @@ TclInitByteCodeObj(objPtr, envPtr)
     } else {
         namespacePtr = envPtr->iPtr->globalNsPtr;
     }
-    
+
+    codePtr = (ByteCode *) ckalloc(sizeof (ByteCode));;
+
     p = (unsigned char *) ckalloc((size_t) structureSize);
-    codePtr = (ByteCode *) p;
+    bcDataPtr = (ByteCodeData *) p;
+
+    codePtr->bcDataPtr = bcDataPtr;
     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
     codePtr->compileEpoch = iPtr->compileEpoch;
     codePtr->nsPtr = namespacePtr;
@@ -1528,46 +1548,47 @@ TclInitByteCodeObj(objPtr, envPtr)
     codePtr->source = envPtr->source;
     codePtr->procPtr = envPtr->procPtr;
 
-    codePtr->numCommands = envPtr->numCommands;
-    codePtr->numSrcBytes = envPtr->numSrcBytes;
-    codePtr->numCodeBytes = codeBytes;
-    codePtr->numLitObjects = numLitObjects;
-    codePtr->numExceptRanges = envPtr->exceptArrayNext;
-    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
-    codePtr->numCmdLocBytes = cmdLocBytes;
-    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
-    codePtr->maxStackDepth = envPtr->maxStackDepth;
+    bcDataPtr->refCount = 1;
+    bcDataPtr->numCommands = envPtr->numCommands;
+    bcDataPtr->numSrcBytes = envPtr->numSrcBytes;
+    bcDataPtr->numCodeBytes = codeBytes;
+    bcDataPtr->numLitObjects = numLitObjects;
+    bcDataPtr->numExceptRanges = envPtr->exceptArrayNext;
+    bcDataPtr->numAuxDataItems = envPtr->auxDataArrayNext;
+    bcDataPtr->numCmdLocBytes = cmdLocBytes;
+    bcDataPtr->maxExceptDepth = envPtr->maxExceptDepth;
+    bcDataPtr->maxStackDepth = envPtr->maxStackDepth;
     
-    p += sizeof(ByteCode);
-    codePtr->codeStart = p;
+    p += sizeof(ByteCodeData);
+    bcDataPtr->codeStart = p;
     memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
     
     p += TCL_ALIGN(codeBytes);	      /* align object array */
-    codePtr->objArrayPtr = (Tcl_Obj **) p;
+    bcDataPtr->objArrayPtr = (Tcl_Obj **) p;
     for (i = 0;  i < numLitObjects;  i++) {
-	codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
+	bcDataPtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
     }
 
     p += TCL_ALIGN(objArrayBytes);    /* align exception range array */
     if (exceptArrayBytes > 0) {
-	codePtr->exceptArrayPtr = (ExceptionRange *) p;
+	bcDataPtr->exceptArrayPtr = (ExceptionRange *) p;
 	memcpy((VOID *) p, (VOID *) envPtr->exceptArrayPtr,
 	        (size_t) exceptArrayBytes);
     } else {
-	codePtr->exceptArrayPtr = NULL;
+	bcDataPtr->exceptArrayPtr = NULL;
     }
     
     p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
     if (auxDataArrayBytes > 0) {
-	codePtr->auxDataArrayPtr = (AuxData *) p;
+	bcDataPtr->auxDataArrayPtr = (AuxData *) p;
 	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
 	        (size_t) auxDataArrayBytes);
     } else {
-	codePtr->auxDataArrayPtr = NULL;
+	bcDataPtr->auxDataArrayPtr = NULL;
     }
 
     p += auxDataArrayBytes;
-    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
+    nextPtr = EncodeCmdLocMap(envPtr, bcDataPtr, (unsigned char *) p);
 #ifdef TCL_COMPILE_DEBUG
     if (((size_t)(nextPtr - p)) != cmdLocBytes) {	
 	panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d\n", (nextPtr - p), cmdLocBytes);
@@ -1580,9 +1601,9 @@ TclInitByteCodeObj(objPtr, envPtr)
      */
 
 #ifdef TCL_COMPILE_STATS
-    codePtr->structureSize = structureSize
+    bcDataPtr->structureSize = structureSize
 	    - (sizeof(size_t) + sizeof(Tcl_Time));
-    TclpGetTime(&(codePtr->createTime));
+    TclpGetTime(&(bcDataPtr->createTime));
     
     RecordByteCodeStats(codePtr);
 #endif /* TCL_COMPILE_STATS */
@@ -2776,11 +2797,11 @@ GetCmdLocEncodingSize(envPtr)
  */
 
 static unsigned char *
-EncodeCmdLocMap(envPtr, codePtr, startPtr)
+EncodeCmdLocMap(envPtr, bcDataPtr, startPtr)
      CompileEnv *envPtr;	/* Points to compilation environment
 				 * structure containing the CmdLocation
 				 * structure to encode. */
-     ByteCode *codePtr;		/* ByteCode in which to encode envPtr's
+     ByteCodeData *bcDataPtr;		/* ByteCode in which to encode envPtr's
 				 * command location information. */
      unsigned char *startPtr;	/* Points to the first byte in codePtr's
 				 * memory block where the location
@@ -2796,7 +2817,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
      * Encode the code offset for each command as a sequence of deltas.
      */
 
-    codePtr->codeDeltaStart = p;
+    bcDataPtr->codeDeltaStart = p;
     prevOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
 	codeDelta = (mapPtr[i].codeOffset - prevOffset);
@@ -2818,7 +2839,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
      * Encode the code length for each command.
      */
 
-    codePtr->codeLengthStart = p;
+    bcDataPtr->codeLengthStart = p;
     for (i = 0;  i < numCmds;  i++) {
 	codeLen = mapPtr[i].numCodeBytes;
 	if (codeLen < 0) {
@@ -2838,7 +2859,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
      * Encode the source offset for each command as a sequence of deltas.
      */
 
-    codePtr->srcDeltaStart = p;
+    bcDataPtr->srcDeltaStart = p;
     prevOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
 	srcDelta = (mapPtr[i].srcOffset - prevOffset);
@@ -2858,7 +2879,7 @@ EncodeCmdLocMap(envPtr, codePtr, startPtr)
      * Encode the source length for each command.
      */
 
-    codePtr->srcLengthStart = p;
+    bcDataPtr->srcLengthStart = p;
     for (i = 0;  i < numCmds;  i++) {
 	srcLen = mapPtr[i].numSrcBytes;
 	if (srcLen < 0) {
@@ -2901,6 +2922,8 @@ TclPrintByteCodeObj(interp, objPtr)
     Tcl_Obj *objPtr;		/* The bytecode object to disassemble. */
 {
     ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+    ByteCodeData* bcDataPtr = codePtr->bcDataPtr;
+
     unsigned char *codeStart, *codeLimit, *pc;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
@@ -2911,9 +2934,9 @@ TclPrintByteCodeObj(interp, objPtr)
 	return;			/* already freed */
     }
 
-    codeStart = codePtr->codeStart;
-    codeLimit = (codeStart + codePtr->numCodeBytes);
-    numCmds = codePtr->numCommands;
+    codeStart = bcDataPtr->codeStart;
+    codeLimit = (codeStart + bcDataPtr->numCodeBytes);
+    numCmds = bcDataPtr->numCommands;
 
     /*
      * Print header lines describing the ByteCode.
@@ -2925,27 +2948,27 @@ TclPrintByteCodeObj(interp, objPtr)
 	    iPtr->compileEpoch);
     fprintf(stdout, "  Source ");
     TclPrintSource(stdout, codePtr->source,
-	    TclMin(codePtr->numSrcBytes, 55));
+	    TclMin(bcDataPtr->numSrcBytes, 55));
     fprintf(stdout, "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
-	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
-	    codePtr->numLitObjects, codePtr->numAuxDataItems,
-	    codePtr->maxStackDepth,
+	    numCmds, bcDataPtr->numSrcBytes, bcDataPtr->numCodeBytes,
+	    bcDataPtr->numLitObjects, bcDataPtr->numAuxDataItems,
+	    bcDataPtr->maxStackDepth,
 #ifdef TCL_COMPILE_STATS
-	    (codePtr->numSrcBytes?
-	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+	    (bcDataPtr->numSrcBytes?
+	            ((float)bcDataPtr->structureSize)/((float)bcDataPtr->numSrcBytes) : 0.0));
 #else
 	    0.0);
 #endif
 #ifdef TCL_COMPILE_STATS
     fprintf(stdout,
 	    "  Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
-	    codePtr->structureSize,
+	    bcDataPtr->structureSize,
 	    (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
-	    codePtr->numCodeBytes,
-	    (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
-	    (codePtr->numExceptRanges * sizeof(ExceptionRange)),
-	    (codePtr->numAuxDataItems * sizeof(AuxData)),
-	    codePtr->numCmdLocBytes);
+	    bcDataPtr->numCodeBytes,
+	    (bcDataPtr->numLitObjects * sizeof(Tcl_Obj *)),
+	    (bcDataPtr->numExceptRanges * sizeof(ExceptionRange)),
+	    (bcDataPtr->numAuxDataItems * sizeof(AuxData)),
+	    bcDataPtr->numCmdLocBytes);
 #endif /* TCL_COMPILE_STATS */
     
     /*
@@ -2985,11 +3008,11 @@ TclPrintByteCodeObj(interp, objPtr)
      * Print the ExceptionRange array.
      */
 
-    if (codePtr->numExceptRanges > 0) {
+    if (bcDataPtr->numExceptRanges > 0) {
 	fprintf(stdout, "  Exception ranges %d, depth %d:\n",
-	        codePtr->numExceptRanges, codePtr->maxExceptDepth);
-	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
-	    ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
+	        bcDataPtr->numExceptRanges, bcDataPtr->maxExceptDepth);
+	for (i = 0;  i < bcDataPtr->numExceptRanges;  i++) {
+	    ExceptionRange *rangePtr = &(bcDataPtr->exceptArrayPtr[i]);
 	    fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
 		    i, rangePtr->nestingLevel,
 		    ((rangePtr->type == LOOP_EXCEPTION_RANGE)
@@ -3031,10 +3054,10 @@ TclPrintByteCodeObj(interp, objPtr)
      */
 
     fprintf(stdout, "  Commands %d:", numCmds);
-    codeDeltaNext = codePtr->codeDeltaStart;
-    codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
+    codeDeltaNext = bcDataPtr->codeDeltaStart;
+    codeLengthNext = bcDataPtr->codeLengthStart;
+    srcDeltaNext  = bcDataPtr->srcDeltaStart;
+    srcLengthNext = bcDataPtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
 	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
@@ -3090,9 +3113,9 @@ TclPrintByteCodeObj(interp, objPtr)
      * the code length here.
      */
 
-    codeDeltaNext = codePtr->codeDeltaStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
+    codeDeltaNext = bcDataPtr->codeDeltaStart;
+    srcDeltaNext  = bcDataPtr->srcDeltaStart;
+    srcLengthNext = bcDataPtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     pc = codeStart;
     for (i = 0;  i < numCmds;  i++) {
@@ -3174,10 +3197,11 @@ TclPrintInstruction(codePtr, pc)
     ByteCode* codePtr;		/* Bytecode containing the instruction. */
     unsigned char *pc;		/* Points to first byte of instruction. */
 {
+    ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
     Proc *procPtr = codePtr->procPtr;
     unsigned char opCode = *pc;
     register InstructionDesc *instDesc = &instructionTable[opCode];
-    unsigned char *codeStart = codePtr->codeStart;
+    unsigned char *codeStart = bcDataPtr->codeStart;
     unsigned int pcOffset = (pc - codeStart);
     int opnd, i, j;
     
@@ -3208,7 +3232,7 @@ TclPrintInstruction(codePtr, pc)
 	    opnd = TclGetUInt1AtPtr(pc+1+i);
 	    if ((i == 0) && (opCode == INST_PUSH1)) {
 		fprintf(stdout, "%u  	# ", (unsigned int) opnd);
-		TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
+		TclPrintObject(stdout, bcDataPtr->objArrayPtr[opnd], 40);
 	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
 				    || (opCode == INST_LOAD_ARRAY1)
 				    || (opCode == INST_STORE_SCALAR1)
@@ -3238,7 +3262,7 @@ TclPrintInstruction(codePtr, pc)
 	    opnd = TclGetUInt4AtPtr(pc+1+i);
 	    if (opCode == INST_PUSH4) {
 		fprintf(stdout, "%u  	# ", opnd);
-		TclPrintObject(stdout, codePtr->objArrayPtr[opnd], 40);
+		TclPrintObject(stdout, bcDataPtr->objArrayPtr[opnd], 40);
 	    } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
 				    || (opCode == INST_LOAD_ARRAY4)
 				    || (opCode == INST_STORE_SCALAR4)
@@ -3398,6 +3422,7 @@ RecordByteCodeStats(codePtr)
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
     register ByteCodeStats *statsPtr = &(iPtr->stats);
 #endif
+    register ByteCodeData  *bcDataPtr = codePtr->bcDataPtr;
 
 #ifdef TCL_COMPILE_DEBUG_VERBOSE
     char *ell = "";
@@ -3411,21 +3436,21 @@ RecordByteCodeStats(codePtr)
 #endif
 
     statsPtr->numCompilations++;
-    statsPtr->totalSrcBytes        += (double) codePtr->numSrcBytes;
-    statsPtr->totalByteCodeBytes   += (double) codePtr->structureSize;
-    statsPtr->currentSrcBytes      += (double) codePtr->numSrcBytes;
-    statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;
+    statsPtr->totalSrcBytes        += (double) bcDataPtr->numSrcBytes;
+    statsPtr->totalByteCodeBytes   += (double) bcDataPtr->structureSize;
+    statsPtr->currentSrcBytes      += (double) bcDataPtr->numSrcBytes;
+    statsPtr->currentByteCodeBytes += (double) bcDataPtr->structureSize;
     
-    statsPtr->srcCount[TclLog2((int)codePtr->numSrcBytes)]++;
-    statsPtr->byteCodeCount[TclLog2((int)codePtr->structureSize)]++;
+    statsPtr->srcCount[TclLog2((int)bcDataPtr->numSrcBytes)]++;
+    statsPtr->byteCodeCount[TclLog2((int)bcDataPtr->structureSize)]++;
 
-    statsPtr->currentInstBytes   += (double) codePtr->numCodeBytes;
+    statsPtr->currentInstBytes   += (double) bcDataPtr->numCodeBytes;
     statsPtr->currentLitBytes    +=
-	    (double) (codePtr->numLitObjects * sizeof(Tcl_Obj *)); 
+	    (double) (bcDataPtr->numLitObjects * sizeof(Tcl_Obj *)); 
     statsPtr->currentExceptBytes +=
-	    (double) (codePtr->numExceptRanges * sizeof(ExceptionRange));
+	    (double) (bcDataPtr->numExceptRanges * sizeof(ExceptionRange));
     statsPtr->currentAuxBytes    +=
-            (double) (codePtr->numAuxDataItems * sizeof(AuxData));
-    statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
+            (double) (bcDataPtr->numAuxDataItems * sizeof(AuxData));
+    statsPtr->currentCmdMapBytes += (double) bcDataPtr->numCmdLocBytes;
 }
 #endif /* TCL_COMPILE_STATS */
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 79afccd..4985edc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -6,7 +6,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.11.10.1.2.2 2002/11/07 19:05:02 hobbs Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.11.10.1.2.3 2002/11/26 19:48:52 andreas_kupries Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -286,6 +286,14 @@ typedef struct CompileEnv {
  * object is allocated to hold the ByteCode structure immediately followed
  * by the code bytes, the literal object array, the ExceptionRange array,
  * the CmdLocation map, and the compilation AuxData array.
+ *
+ * This has changed here. ByteCode is now fixed-length, and all
+ * variable-length data now resides in the structure
+ * ByteCodeData. This new structure can be shared between
+ * interpreters, if the namespace context of the code is structurally
+ * equivalent. Current only the Tcl_InterpClone () API knows that
+ * context are equivalent. IOW, only this function will currently
+ * actually create shared structures.
  */
 
 /*
@@ -294,25 +302,9 @@ typedef struct CompileEnv {
  */
 #define TCL_BYTECODE_PRECOMPILED		0x0001
 
-typedef struct ByteCode {
-    TclHandle interpHandle;	/* Handle for interpreter containing the
-				 * compiled code.  Commands and their compile
-				 * procs are specific to an interpreter so the
-				 * code emitted will depend on the
-				 * interpreter. */
-    Namespace *nsPtr;		/* Namespace context in which this code
-				 * was compiled. If the code is executed
-				 * if a different namespace, it must be
-				 * recompiled. */
-    char *source;		/* The source string from which this
-				 * ByteCode was compiled. Note that this
-				 * pointer is not owned by the ByteCode and
-				 * must not be freed or modified by it. */
-    Proc *procPtr;		/* If the ByteCode was compiled from a
-				 * procedure body, this is a pointer to its
-				 * Proc structure; otherwise NULL. This
-				 * pointer is also not owned by the ByteCode
-				 * and must not be freed by it. */
+typedef struct ByteCodeData {
+    int refCount;               /* Number of ByteCode structures sharing
+				 * this information. */
     unsigned char *codeStart;	/* Points to the first byte of the code.
 				 * This is just after the final ByteCode
 				 * member cmdMapPtr. */
@@ -360,25 +352,10 @@ typedef struct ByteCode {
 				 * are always positive. This sequence is
 				 * just after the last byte in the source
 				 * delta sequence. */
-    size_t structureSize;	/* Number of bytes in the ByteCode structure
+    size_t structureSize;	/* Number of bytes in the ByteCodeData structure
 				 * itself. Does not include heap space for
 				 * literal Tcl objects or storage referenced
 				 * by AuxData entries. */
-    int compileEpoch;		/* Value of iPtr->compileEpoch when this
-				 * ByteCode was compiled. Used to invalidate
-				 * code when, e.g., commands with compile
-				 * procs are redefined. */
-    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
-				 * ByteCode was compiled. Used to invalidate
-				 * code when new namespace resolution rules
-				 * are put into effect. */
-    int refCount;		/* Reference count: set 1 when created
-				 * plus 1 for each execution of the code
-				 * currently active. This structure can be
-				 * freed when refCount becomes zero. */
-    unsigned int flags;		/* flags describing state for the codebyte.
-                                 * this variable holds ORed values from the
-                                 * TCL_BYTECODE_ masks defined above */
     int numCommands;		/* Number of commands compiled. */
     int numSrcBytes;		/* Number of source bytes compiled. */
     int numCodeBytes;		/* Number of code bytes. */
@@ -395,6 +372,51 @@ typedef struct ByteCode {
     Tcl_Time createTime;	/* Absolute time when the ByteCode was
 				 * created. */
 #endif /* TCL_COMPILE_STATS */
+
+    /* Behind the last field we will find the actual bytecode, table of
+     * literals, etc. See the pointers above for a complete enumeration
+     * of the data, and how to reach it. */
+} ByteCodeData;
+
+
+typedef struct ByteCode {
+    TclHandle interpHandle;	/* Handle for interpreter containing the
+				 * compiled code.  Commands and their compile
+				 * procs are specific to an interpreter so the
+				 * code emitted will depend on the
+				 * interpreter. */
+    Namespace *nsPtr;		/* Namespace context in which this code
+				 * was compiled. If the code is executed
+				 * if a different namespace, it must be
+				 * recompiled. */
+    char *source;		/* The source string from which this
+				 * ByteCode was compiled. Note that this
+				 * pointer is not owned by the ByteCode and
+				 * must not be freed or modified by it. */
+    Proc *procPtr;		/* If the ByteCode was compiled from a
+				 * procedure body, this is a pointer to its
+				 * Proc structure; otherwise NULL. This
+				 * pointer is also not owned by the ByteCode
+				 * and must not be freed by it. */
+    ByteCodeData *bcDataPtr;    /* The actual bytecode and meta-information
+				 * about it is reachable through this pointer.
+				 * This allows sharing of the structure in
+				 * cloned interpreters. */
+    int compileEpoch;		/* Value of iPtr->compileEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when, e.g., commands with compile
+				 * procs are redefined. */
+    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
+				 * ByteCode was compiled. Used to invalidate
+				 * code when new namespace resolution rules
+				 * are put into effect. */
+    int refCount;		/* Reference count: set 1 when created
+				 * plus 1 for each execution of the code
+				 * currently active. This structure can be
+				 * freed when refCount becomes zero. */
+    unsigned int flags;		/* flags describing state for the codebyte.
+                                 * this variable holds ORed values from the
+                                 * TCL_BYTECODE_ masks defined above */
 } ByteCode;
 
 /*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 88de244..8740f11 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.34.2.2 2001/08/28 00:12:43 hobbs Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.34.2.2.2.1 2002/11/26 19:48:52 andreas_kupries Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1281,6 +1281,96 @@ EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
 /* 411 */
 EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
 				Tcl_ChannelType * chanTypePtr));
+/* Slot 412 is reserved */
+/* Slot 413 is reserved */
+/* Slot 414 is reserved */
+/* Slot 415 is reserved */
+/* Slot 416 is reserved */
+/* Slot 417 is reserved */
+/* Slot 418 is reserved */
+/* Slot 419 is reserved */
+/* Slot 420 is reserved */
+/* Slot 421 is reserved */
+/* Slot 422 is reserved */
+/* Slot 423 is reserved */
+/* Slot 424 is reserved */
+/* Slot 425 is reserved */
+/* Slot 426 is reserved */
+/* Slot 427 is reserved */
+/* Slot 428 is reserved */
+/* Slot 429 is reserved */
+/* Slot 430 is reserved */
+/* Slot 431 is reserved */
+/* Slot 432 is reserved */
+/* Slot 433 is reserved */
+/* Slot 434 is reserved */
+/* Slot 435 is reserved */
+/* Slot 436 is reserved */
+/* Slot 437 is reserved */
+/* Slot 438 is reserved */
+/* Slot 439 is reserved */
+/* Slot 440 is reserved */
+/* Slot 441 is reserved */
+/* Slot 442 is reserved */
+/* Slot 443 is reserved */
+/* Slot 444 is reserved */
+/* Slot 445 is reserved */
+/* Slot 446 is reserved */
+/* Slot 447 is reserved */
+/* Slot 448 is reserved */
+/* Slot 449 is reserved */
+/* Slot 450 is reserved */
+/* Slot 451 is reserved */
+/* Slot 452 is reserved */
+/* Slot 453 is reserved */
+/* Slot 454 is reserved */
+/* Slot 455 is reserved */
+/* Slot 456 is reserved */
+/* Slot 457 is reserved */
+/* Slot 458 is reserved */
+/* Slot 459 is reserved */
+/* Slot 460 is reserved */
+/* Slot 461 is reserved */
+/* Slot 462 is reserved */
+/* Slot 463 is reserved */
+/* Slot 464 is reserved */
+/* Slot 465 is reserved */
+/* Slot 466 is reserved */
+/* Slot 467 is reserved */
+/* Slot 468 is reserved */
+/* Slot 469 is reserved */
+/* Slot 470 is reserved */
+/* Slot 471 is reserved */
+/* Slot 472 is reserved */
+/* Slot 473 is reserved */
+/* Slot 474 is reserved */
+/* Slot 475 is reserved */
+/* Slot 476 is reserved */
+/* Slot 477 is reserved */
+/* Slot 478 is reserved */
+/* Slot 479 is reserved */
+/* Slot 480 is reserved */
+/* Slot 481 is reserved */
+/* Slot 482 is reserved */
+/* Slot 483 is reserved */
+/* Slot 484 is reserved */
+/* Slot 485 is reserved */
+/* Slot 486 is reserved */
+/* Slot 487 is reserved */
+/* Slot 488 is reserved */
+/* Slot 489 is reserved */
+/* Slot 490 is reserved */
+/* Slot 491 is reserved */
+/* Slot 492 is reserved */
+/* Slot 493 is reserved */
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+/* 500 */
+EXTERN Tcl_Interp *	Tcl_CloneInterp _ANSI_ARGS_((Tcl_Interp* srcInterp));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1760,6 +1850,95 @@ typedef struct TclStubs {
     Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 409 */
     Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 410 */
     Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 411 */
+    void *reserved412;
+    void *reserved413;
+    void *reserved414;
+    void *reserved415;
+    void *reserved416;
+    void *reserved417;
+    void *reserved418;
+    void *reserved419;
+    void *reserved420;
+    void *reserved421;
+    void *reserved422;
+    void *reserved423;
+    void *reserved424;
+    void *reserved425;
+    void *reserved426;
+    void *reserved427;
+    void *reserved428;
+    void *reserved429;
+    void *reserved430;
+    void *reserved431;
+    void *reserved432;
+    void *reserved433;
+    void *reserved434;
+    void *reserved435;
+    void *reserved436;
+    void *reserved437;
+    void *reserved438;
+    void *reserved439;
+    void *reserved440;
+    void *reserved441;
+    void *reserved442;
+    void *reserved443;
+    void *reserved444;
+    void *reserved445;
+    void *reserved446;
+    void *reserved447;
+    void *reserved448;
+    void *reserved449;
+    void *reserved450;
+    void *reserved451;
+    void *reserved452;
+    void *reserved453;
+    void *reserved454;
+    void *reserved455;
+    void *reserved456;
+    void *reserved457;
+    void *reserved458;
+    void *reserved459;
+    void *reserved460;
+    void *reserved461;
+    void *reserved462;
+    void *reserved463;
+    void *reserved464;
+    void *reserved465;
+    void *reserved466;
+    void *reserved467;
+    void *reserved468;
+    void *reserved469;
+    void *reserved470;
+    void *reserved471;
+    void *reserved472;
+    void *reserved473;
+    void *reserved474;
+    void *reserved475;
+    void *reserved476;
+    void *reserved477;
+    void *reserved478;
+    void *reserved479;
+    void *reserved480;
+    void *reserved481;
+    void *reserved482;
+    void *reserved483;
+    void *reserved484;
+    void *reserved485;
+    void *reserved486;
+    void *reserved487;
+    void *reserved488;
+    void *reserved489;
+    void *reserved490;
+    void *reserved491;
+    void *reserved492;
+    void *reserved493;
+    void *reserved494;
+    void *reserved495;
+    void *reserved496;
+    void *reserved497;
+    void *reserved498;
+    void *reserved499;
+    Tcl_Interp * (*tcl_CloneInterp) _ANSI_ARGS_((Tcl_Interp* srcInterp)); /* 500 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3456,6 +3635,98 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_ChannelHandlerProc \
 	(tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
 #endif
+/* Slot 412 is reserved */
+/* Slot 413 is reserved */
+/* Slot 414 is reserved */
+/* Slot 415 is reserved */
+/* Slot 416 is reserved */
+/* Slot 417 is reserved */
+/* Slot 418 is reserved */
+/* Slot 419 is reserved */
+/* Slot 420 is reserved */
+/* Slot 421 is reserved */
+/* Slot 422 is reserved */
+/* Slot 423 is reserved */
+/* Slot 424 is reserved */
+/* Slot 425 is reserved */
+/* Slot 426 is reserved */
+/* Slot 427 is reserved */
+/* Slot 428 is reserved */
+/* Slot 429 is reserved */
+/* Slot 430 is reserved */
+/* Slot 431 is reserved */
+/* Slot 432 is reserved */
+/* Slot 433 is reserved */
+/* Slot 434 is reserved */
+/* Slot 435 is reserved */
+/* Slot 436 is reserved */
+/* Slot 437 is reserved */
+/* Slot 438 is reserved */
+/* Slot 439 is reserved */
+/* Slot 440 is reserved */
+/* Slot 441 is reserved */
+/* Slot 442 is reserved */
+/* Slot 443 is reserved */
+/* Slot 444 is reserved */
+/* Slot 445 is reserved */
+/* Slot 446 is reserved */
+/* Slot 447 is reserved */
+/* Slot 448 is reserved */
+/* Slot 449 is reserved */
+/* Slot 450 is reserved */
+/* Slot 451 is reserved */
+/* Slot 452 is reserved */
+/* Slot 453 is reserved */
+/* Slot 454 is reserved */
+/* Slot 455 is reserved */
+/* Slot 456 is reserved */
+/* Slot 457 is reserved */
+/* Slot 458 is reserved */
+/* Slot 459 is reserved */
+/* Slot 460 is reserved */
+/* Slot 461 is reserved */
+/* Slot 462 is reserved */
+/* Slot 463 is reserved */
+/* Slot 464 is reserved */
+/* Slot 465 is reserved */
+/* Slot 466 is reserved */
+/* Slot 467 is reserved */
+/* Slot 468 is reserved */
+/* Slot 469 is reserved */
+/* Slot 470 is reserved */
+/* Slot 471 is reserved */
+/* Slot 472 is reserved */
+/* Slot 473 is reserved */
+/* Slot 474 is reserved */
+/* Slot 475 is reserved */
+/* Slot 476 is reserved */
+/* Slot 477 is reserved */
+/* Slot 478 is reserved */
+/* Slot 479 is reserved */
+/* Slot 480 is reserved */
+/* Slot 481 is reserved */
+/* Slot 482 is reserved */
+/* Slot 483 is reserved */
+/* Slot 484 is reserved */
+/* Slot 485 is reserved */
+/* Slot 486 is reserved */
+/* Slot 487 is reserved */
+/* Slot 488 is reserved */
+/* Slot 489 is reserved */
+/* Slot 490 is reserved */
+/* Slot 491 is reserved */
+/* Slot 492 is reserved */
+/* Slot 493 is reserved */
+/* Slot 494 is reserved */
+/* Slot 495 is reserved */
+/* Slot 496 is reserved */
+/* Slot 497 is reserved */
+/* Slot 498 is reserved */
+/* Slot 499 is reserved */
+#ifndef Tcl_CloneInterp
+#define Tcl_CloneInterp \
+	(tclStubsPtr->tcl_CloneInterp) /* 500 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3497f12..603254d 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.10.2.2.2.6 2002/11/07 19:03:41 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.10.2.2.2.7 2002/11/26 19:48:53 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -193,14 +193,14 @@ long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #define TRACE(a) \
     if (traceInstructions) { \
         fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
-	       (unsigned int)(pc - codePtr->codeStart), \
+	       (unsigned int)(pc - bcDataPtr->codeStart), \
 	       GetOpcodeName(pc)); \
 	printf a; \
     }
 #define TRACE_WITH_OBJ(a, objPtr) \
     if (traceInstructions) { \
         fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
-	       (unsigned int)(pc - codePtr->codeStart), \
+	       (unsigned int)(pc - bcDataPtr->codeStart), \
 	       GetOpcodeName(pc)); \
 	printf a; \
         TclPrintObject(stdout, (objPtr), 30); \
@@ -253,7 +253,7 @@ static void		FreeCmdNameInternalRep _ANSI_ARGS_((
 static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
 #endif
 static ExceptionRange *	GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc,
-			    int catchOnly, ByteCode* codePtr));
+			    int catchOnly, ByteCodeData* bcDataPtr));
 static char *		GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc,
         		    ByteCode* codePtr, int *lengthPtr));
 static void		GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr));
@@ -577,11 +577,12 @@ typedef struct rsData {
         rsData *rsPtr = (rsData *) &stackPtr[stackTop + 1];\
         \
         codePtr = rsPtr->codePtr;\
+        bcDataPtr = codePtr->bcDataPtr;\
         objPtr = rsPtr->objPtr;\
         pc = rsPtr->pc;\
         initStackTop = rsPtr->initStackTop;\
         catchTop = rsPtr->catchTop;\
-        catchStackPtr = (int *) &stackPtr[initStackTop - (codePtr->maxExceptDepth) + 1];\
+        catchStackPtr = (int *) &stackPtr[initStackTop - (bcDataPtr->maxExceptDepth) + 1];\
     }
 #endif /* TCL_NO_RECURSE */
 
@@ -617,7 +618,8 @@ TclExecuteByteCode(interp, codePtr)
     				/* Cached evaluation stack base pointer. */
     register int stackTop = eePtr->stackTop;
     				/* Cached top index of evaluation stack. */
-    register unsigned char *pc = codePtr->codeStart;
+    register ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
+    register unsigned char *pc = bcDataPtr->codeStart;
 				/* The current program counter. */
     int opnd;			/* Current instruction's operand byte. */
     int pcAdjustment;		/* Hold pc adjustment after instruction. */
@@ -664,12 +666,12 @@ TclExecuteByteCode(interp, codePtr)
      */
 
  startInternalRecursionHere: 
-    pc = codePtr->codeStart;
+    pc = bcDataPtr->codeStart;
     result = TCL_OK;
     length = stackTop + sizeof(rsData) 
-	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth + 3)*sizeof(Tcl_Obj *);
+	    + (bcDataPtr->maxStackDepth + bcDataPtr->maxExceptDepth + 3)*sizeof(Tcl_Obj *);
 #else
-    length = stackTop + (codePtr->maxStackDepth + codePtr->maxExceptDepth)*sizeof(Tcl_Obj *);
+    length = stackTop + (bcDataPtr->maxStackDepth + bcDataPtr->maxExceptDepth)*sizeof(Tcl_Obj *);
 #endif
 
     while (length > eePtr->stackEnd) {
@@ -678,7 +680,7 @@ TclExecuteByteCode(interp, codePtr)
     }
     catchStackPtr = (int *) &stackPtr[stackTop + 1];
     catchTop = -1;
-    stackTop += (codePtr->maxExceptDepth);
+    stackTop += (bcDataPtr->maxExceptDepth);
     initStackTop = stackTop;
 
 
@@ -730,7 +732,7 @@ TclExecuteByteCode(interp, codePtr)
 		 */
 		if (stackTop > initStackTop) goto abnormalReturn;
 		fprintf(stderr, "\nTclExecuteByteCode: done instruction at pc %u: stack top %d < entry stack top %d\n",
-			(unsigned int)(pc - codePtr->codeStart),
+			(unsigned int)(pc - bcDataPtr->codeStart),
 			(unsigned int) stackTop,
 			(unsigned int) initStackTop);
 		panic("TclExecuteByteCode execution failure: end stack top < start stack top");
@@ -746,16 +748,16 @@ TclExecuteByteCode(interp, codePtr)
 	    
 	case INST_PUSH1:
 #ifdef TCL_COMPILE_DEBUG
-	    valuePtr = codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
+	    valuePtr = bcDataPtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)];
 	    PUSH_OBJECT(valuePtr);
 	    TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), valuePtr);
 #else
-	    PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
+	    PUSH_OBJECT(bcDataPtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]);
 #endif /* TCL_COMPILE_DEBUG */
 	    ADJUST_PC(2);
 	    
 	case INST_PUSH4:
-	    valuePtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
+	    valuePtr = bcDataPtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
 	    PUSH_OBJECT(valuePtr);
 	    TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), valuePtr);
 	    ADJUST_PC(5);
@@ -935,7 +937,7 @@ TclExecuteByteCode(interp, codePtr)
 		    } else {
 			fprintf(stdout, "%d: (%u) invoking ",
 			        iPtr->numLevels,
-				(unsigned int)(pc - codePtr->codeStart));
+				(unsigned int)(pc - bcDataPtr->codeStart));
 		    }
 		    for (i = 0;  i < objc;  i++) {
 			TclPrintObject(stdout, objv[i], 15);
@@ -946,7 +948,7 @@ TclExecuteByteCode(interp, codePtr)
 #else /* TCL_COMPILE_DEBUG */
 		    fprintf(stdout, "%d: (%u) invoking %s\n",
 			    iPtr->numLevels,
-		            (unsigned int)(pc - codePtr->codeStart),
+		            (unsigned int)(pc - bcDataPtr->codeStart),
 			    Tcl_GetString(objv[0]));
 #endif /*TCL_COMPILE_DEBUG*/
 		}
@@ -1023,10 +1025,11 @@ TclExecuteByteCode(interp, codePtr)
 
 		    oldCodePtr = codePtr;
 		    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+		    bcDataPtr = codePtr->bcDataPtr;
 		    
 		    stackPtr[++stackTop] = (Tcl_Obj *) preservedStack;
 		    stackPtr[++stackTop] = (Tcl_Obj *) pcAdjustment;
-		    stackPtr[++stackTop] = (Tcl_Obj *) codePtr->numSrcBytes;
+		    stackPtr[++stackTop] = (Tcl_Obj *) bcDataPtr->numSrcBytes;
 		    stackPtr[++stackTop] = (Tcl_Obj *) iPtr->evalFlags;
 		    iPtr->evalFlags = 0;
 		    codePtr->refCount++;
@@ -1199,7 +1202,7 @@ TclExecuteByteCode(interp, codePtr)
 		     * execution and return the TCL_BREAK or TCL_CONTINUE.
 		     */
 		    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
-			    codePtr);
+			    bcDataPtr);
 		    if (rangePtr == NULL) {
 		        TRACE(("%u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
 		                objc, cmdNameBuf,
@@ -1233,7 +1236,7 @@ TclExecuteByteCode(interp, codePtr)
 			panic("TclExecuteByteCode: bad ExceptionRange type\n");
 		    }
 		    result = TCL_OK;
-		    pc = (codePtr->codeStart + newPcOffset);
+		    pc = (bcDataPtr->codeStart + newPcOffset);
 		    continue;	/* restart outer instruction loop at pc */
 		    
 		case TCL_ERROR:
@@ -1276,8 +1279,9 @@ TclExecuteByteCode(interp, codePtr)
 	    }
 	    oldCodePtr = codePtr;
 	    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	    bcDataPtr = codePtr->bcDataPtr;
 
-	    stackPtr[++stackTop] = (Tcl_Obj *) codePtr->numSrcBytes;
+	    stackPtr[++stackTop] = (Tcl_Obj *) bcDataPtr->numSrcBytes;
 	    stackPtr[++stackTop] = (Tcl_Obj *) iPtr->evalFlags;
 	    iPtr->evalFlags = 0;
 	    stackPtr[++stackTop] = (Tcl_Obj *) iPtr->cmdCount;
@@ -1332,7 +1336,7 @@ TclExecuteByteCode(interp, codePtr)
 				      * to avoid compiler warning. */
 
 		rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0,
-			codePtr);
+			bcDataPtr);
 		if (rangePtr == NULL) {
 		    TRACE(("\"%.30s\" => no encl. loop or catch, returning %s\n",
 			    O2S(objPtr), StringForResultCode(result)));
@@ -1366,7 +1370,7 @@ TclExecuteByteCode(interp, codePtr)
 		    panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
 		}
 		Tcl_DecrRefCount(objPtr);
-		pc = (codePtr->codeStart + newPcOffset);
+		pc = (bcDataPtr->codeStart + newPcOffset);
 		continue;	/* restart outer instruction loop at pc */
 	    } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
 		TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)),
@@ -1393,6 +1397,7 @@ TclExecuteByteCode(interp, codePtr)
 		Tcl_ResetResult(interp);
 		oldCodePtr = codePtr;
 		codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+		bcDataPtr = codePtr->bcDataPtr;
 		codePtr->refCount++;
 		RS_PUSH(2);
 		goto startInternalRecursionHere;
@@ -1948,7 +1953,7 @@ TclExecuteByteCode(interp, codePtr)
 #ifdef TCL_COMPILE_DEBUG
 	    opnd = TclGetInt1AtPtr(pc+1);
 	    TRACE(("%d => new pc %u\n", opnd,
-		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+		   (unsigned int)(pc + opnd - bcDataPtr->codeStart)));
 	    pc += opnd;
 #else
 	    pc += TclGetInt1AtPtr(pc+1);
@@ -1958,7 +1963,7 @@ TclExecuteByteCode(interp, codePtr)
 	case INST_JUMP4:
 	    opnd = TclGetInt4AtPtr(pc+1);
 	    TRACE(("%d => new pc %u\n", opnd,
-		   (unsigned int)(pc + opnd - codePtr->codeStart)));
+		   (unsigned int)(pc + opnd - bcDataPtr->codeStart)));
 	    ADJUST_PC(opnd);
 
 	case INST_JUMP_TRUE4:
@@ -1991,7 +1996,7 @@ TclExecuteByteCode(interp, codePtr)
 		if (b) {
 		    TRACE(("%d => %.20s true, new pc %u\n",
 			    opnd, O2S(valuePtr),
-		            (unsigned int)(pc+opnd - codePtr->codeStart)));
+		            (unsigned int)(pc+opnd - bcDataPtr->codeStart)));
 		    TclDecrRefCount(valuePtr);
 		    ADJUST_PC(opnd);
 		} else {
@@ -2035,7 +2040,7 @@ TclExecuteByteCode(interp, codePtr)
 		} else {
 		    TRACE(("%d => %.20s false, new pc %u\n",
 			   opnd, O2S(valuePtr),
-			   (unsigned int)(pc + opnd - codePtr->codeStart)));
+			   (unsigned int)(pc + opnd - bcDataPtr->codeStart)));
 		    TclDecrRefCount(valuePtr);
 		    ADJUST_PC(opnd);
 		}
@@ -2985,7 +2990,7 @@ TclExecuteByteCode(interp, codePtr)
 	     */
 
 	    Tcl_ResetResult(interp);
-	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, bcDataPtr);
 	    if (rangePtr == NULL) {
 		TRACE(("=> no encl. loop or catch, returning TCL_BREAK\n"));
 		result = TCL_BREAK;
@@ -3004,7 +3009,7 @@ TclExecuteByteCode(interp, codePtr)
 	    default:
 		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
 	    }
-	    pc = (codePtr->codeStart + rangePtr->breakOffset);
+	    pc = (bcDataPtr->codeStart + rangePtr->breakOffset);
 	    continue;	/* restart outer instruction loop at pc */
 
 	case INST_CONTINUE:
@@ -3017,7 +3022,7 @@ TclExecuteByteCode(interp, codePtr)
 	     */
 
 	    Tcl_ResetResult(interp);
-	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+	    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, bcDataPtr);
 	    if (rangePtr == NULL) {
 		TRACE(("=> no encl. loop or catch, returning TCL_CONTINUE\n"));
 		result = TCL_CONTINUE;
@@ -3041,7 +3046,7 @@ TclExecuteByteCode(interp, codePtr)
 	    default:
 		panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
 	    }
-	    pc = (codePtr->codeStart + rangePtr->continueOffset);
+	    pc = (bcDataPtr->codeStart + rangePtr->continueOffset);
 	    continue;	/* restart outer instruction loop at pc */
 
 	case INST_FOREACH_START4:
@@ -3053,7 +3058,7 @@ TclExecuteByteCode(interp, codePtr)
 		 */
 
 		ForeachInfo *infoPtr = (ForeachInfo *)
-		    codePtr->auxDataArrayPtr[opnd].clientData;
+		    bcDataPtr->auxDataArrayPtr[opnd].clientData;
 		int iterTmpIndex = infoPtr->loopCtTemp;
 		Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
 		Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
@@ -3081,7 +3086,7 @@ TclExecuteByteCode(interp, codePtr)
 		 */
 
 		ForeachInfo *infoPtr = (ForeachInfo *)
-		        codePtr->auxDataArrayPtr[opnd].clientData;
+		        bcDataPtr->auxDataArrayPtr[opnd].clientData;
 		ForeachVarList *varListPtr;
 		int numLists = infoPtr->numLists;
 		Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
@@ -3246,7 +3251,7 @@ TclExecuteByteCode(interp, codePtr)
 		iPtr->flags |= ERR_ALREADY_LOGGED;
 	    }
         }
-	rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+	rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, bcDataPtr);
 	if (rangePtr == NULL) {
 #ifdef TCL_COMPILE_DEBUG
 	    if (traceInstructions) {
@@ -3278,7 +3283,7 @@ TclExecuteByteCode(interp, codePtr)
 	        (unsigned int)(rangePtr->catchOffset));
 	}
 #endif	
-	pc = (codePtr->codeStart + rangePtr->catchOffset);
+	pc = (bcDataPtr->codeStart + rangePtr->catchOffset);
 	continue;		/* restart the execution loop at pc */
     } /* end of infinite loop dispatching on instructions */
 
@@ -3298,7 +3303,7 @@ TclExecuteByteCode(interp, codePtr)
      */
 
     done:
-    stackTop -= codePtr->maxExceptDepth;
+    stackTop -= bcDataPtr->maxExceptDepth;
 #if TCL_NO_RECURSE
     if (currentDepth--) {
 	/* 
@@ -3324,6 +3329,7 @@ TclExecuteByteCode(interp, codePtr)
     return result;
 }
 
+
 #ifdef TCL_COMPILE_DEBUG
 /*
  *----------------------------------------------------------------------
@@ -3348,6 +3354,7 @@ PrintByteCodeInfo(codePtr)
     register ByteCode *codePtr;	/* The bytecode whose summary is printed
 				 * to stdout. */
 {
+    register ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
     Proc *procPtr = codePtr->procPtr;
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
 
@@ -3360,24 +3367,24 @@ PrintByteCodeInfo(codePtr)
     TclPrintSource(stdout, codePtr->source, 60);
 
     fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
-            codePtr->numCommands, codePtr->numSrcBytes,
-	    codePtr->numCodeBytes, codePtr->numLitObjects,
-	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
+            bcDataPtr->numCommands, bcDataPtr->numSrcBytes,
+	    bcDataPtr->numCodeBytes, bcDataPtr->numLitObjects,
+	    bcDataPtr->numAuxDataItems, bcDataPtr->maxStackDepth,
 #ifdef TCL_COMPILE_STATS
-	    (codePtr->numSrcBytes?
-	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+	    (bcDataPtr->numSrcBytes?
+	            ((float)bcDataPtr->structureSize)/((float)bcDataPtr->numSrcBytes) : 0.0));
 #else
 	    0.0);
 #endif
 #ifdef TCL_COMPILE_STATS
     fprintf(stdout, "  Code %d = header %d+inst %d+litObj %d+exc %d+aux %d+cmdMap %d\n",
-	    codePtr->structureSize,
+	    bcDataPtr->structureSize,
 	    (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))),
-	    codePtr->numCodeBytes,
-	    (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
-	    (codePtr->numExceptRanges * sizeof(ExceptionRange)),
-	    (codePtr->numAuxDataItems * sizeof(AuxData)),
-	    codePtr->numCmdLocBytes);
+	    bcDataPtr->numCodeBytes,
+	    (bcDataPtr->numLitObjects * sizeof(Tcl_Obj *)),
+	    (bcDataPtr->numExceptRanges * sizeof(ExceptionRange)),
+	    (bcDataPtr->numAuxDataItems * sizeof(AuxData)),
+	    bcDataPtr->numCmdLocBytes);
 #endif /* TCL_COMPILE_STATS */
     if (procPtr != NULL) {
 	fprintf(stdout,
@@ -3421,10 +3428,11 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound,
     int stackLowerBound;	/* Smallest legal value for stackTop. */
     int stackUpperBound;	/* Greatest legal value for stackTop. */
 {
-    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
-    unsigned int codeStart = (unsigned int) codePtr->codeStart;
+    register ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
+    unsigned int relativePc = (unsigned int) (pc - bcDataPtr->codeStart);
+    unsigned int codeStart = (unsigned int) bcDataPtr->codeStart;
     unsigned int codeEnd = (unsigned int)
-	    (codePtr->codeStart + codePtr->numCodeBytes);
+	    (bcDataPtr->codeStart + bcDataPtr->numCodeBytes);
     unsigned char opCode = *pc;
 
     if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
@@ -3626,8 +3634,9 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
 				 * length of the command's source should be
 				 * stored. If NULL, no length is stored. */
 {
-    register int pcOffset = (pc - codePtr->codeStart);
-    int numCmds = codePtr->numCommands;
+    register ByteCodeData *bcDataPtr = codePtr->bcDataPtr;
+    register int pcOffset = (pc - bcDataPtr->codeStart);
+    int numCmds = bcDataPtr->numCommands;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
     int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
@@ -3635,7 +3644,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
     int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
     int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
 
-    if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+    if ((pcOffset < 0) || (pcOffset >= bcDataPtr->numCodeBytes)) {
 	return NULL;
     }
 
@@ -3645,10 +3654,10 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
      * pcOffset.
      */
 
-    codeDeltaNext = codePtr->codeDeltaStart;
-    codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
+    codeDeltaNext = bcDataPtr->codeDeltaStart;
+    codeLengthNext = bcDataPtr->codeLengthStart;
+    srcDeltaNext  = bcDataPtr->srcDeltaStart;
+    srcLengthNext = bcDataPtr->srcLengthStart;
     codeOffset = srcOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
 	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
@@ -3738,7 +3747,7 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr)
  */
 
 static ExceptionRange *
-GetExceptRangeForPc(pc, catchOnly, codePtr)
+GetExceptRangeForPc(pc, catchOnly, bcDataPtr)
     unsigned char *pc;		/* The program counter value for which to
 				 * search for a closest enclosing exception
 				 * range. This points to a bytecode
@@ -3747,21 +3756,21 @@ GetExceptRangeForPc(pc, catchOnly, codePtr)
 				 * ExceptionRanges in search. If nonzero
 				 * consider only catch ranges (and ignore
 				 * any closer loop ranges). */
-    ByteCode* codePtr;		/* Points to the ByteCode in which to search
+    ByteCodeData* bcDataPtr;		/* Points to the ByteCode in which to search
 				 * for the enclosing ExceptionRange. */
 {
     ExceptionRange *rangeArrayPtr;
-    int numRanges = codePtr->numExceptRanges;
+    int numRanges = bcDataPtr->numExceptRanges;
     register ExceptionRange *rangePtr;
-    int pcOffset = (pc - codePtr->codeStart);
+    int pcOffset = (pc - bcDataPtr->codeStart);
     register int i, level;
 
     if (numRanges == 0) {
 	return NULL;
     }
-    rangeArrayPtr = codePtr->exceptArrayPtr;
+    rangeArrayPtr = bcDataPtr->exceptArrayPtr;
 
-    for (level = codePtr->maxExceptDepth;  level >= 0;  level--) {
+    for (level = bcDataPtr->maxExceptDepth;  level >= 0;  level--) {
 	for (i = 0;  i < numRanges;  i++) {
 	    rangePtr = &(rangeArrayPtr[i]);
 	    if (rangePtr->nestingLevel == level) {
@@ -5998,7 +6007,7 @@ TclEvalByteCodeFromObj(interp, objPtr, flags)
      */
 
     iPtr->numLevels++;
-    numSrcBytes = codePtr->numSrcBytes;
+    numSrcBytes = codePtr->bcDataPtr->numSrcBytes;
 
     if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
 	/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 89d6ebb..eec1821 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * 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.42.2.3.2.5 2002/11/07 19:05:02 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.42.2.3.2.6 2002/11/26 19:48:56 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1618,6 +1618,8 @@ EXTERN int		TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
 			    Namespace *nsPtr, char *procName,
 			    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
 			    Proc **procPtrPtr));
+EXTERN Proc*		TclCloneProc _ANSI_ARGS_((Interp *interp,
+			    Namespace *nsPtr, Proc *procSrcPtr));
 EXTERN void		TclDeleteCompiledLocalVars _ANSI_ARGS_((
 			    Interp *iPtr, CallFrame *framePtr));
 EXTERN void		TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
@@ -1856,6 +1858,10 @@ EXTERN void		TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp,
 			    int result, Tcl_Interp *targetInterp));
 EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
 
+EXTERN int		TclInvokeImportedCmd _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]));
+
 /*
  *----------------------------------------------------------------
  * Command procedures in the generic core:
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 6e10479..4bb0930 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLiteral.c,v 1.8.2.3.2.2 2002/11/07 19:05:04 hobbs Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.8.2.3.2.3 2002/11/26 19:48:57 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -92,6 +92,7 @@ TclGlobalLiteralTable()
     return &(tsdPtr->literalTable);
 }
 
+#ifdef TCL_COMPILE_STATS
 ByteCodeStats *
 TclGlobalByteCodeStats()
 {
@@ -99,6 +100,7 @@ TclGlobalByteCodeStats()
     return &(tsdPtr->stats);
 }
 #endif
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -239,13 +241,13 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
 				 * bytes and ownership is passed to this
 				 * procedure. */
 {
-    Interp *iPtr = envPtr->iPtr;
 #ifdef TCL_THREAD_LITERALS
     LiteralTable *globalTablePtr = TclGlobalLiteralTable();
 #ifdef TCL_COMPILE_STATS
     ByteCodeStats *statsPtr = TclGlobalByteCodeStats();
 #endif
 #else
+    Interp *iPtr = envPtr->iPtr;
     LiteralTable *globalTablePtr = &(iPtr->literalTable);
 #ifdef TCL_COMPILE_STATS
     ByteCodeStats *statsPtr = &(iPtr->stats);
@@ -761,7 +763,7 @@ TclReleaseLiteral(interp, objPtr)
 #endif
 #endif
     register LiteralEntry *entryPtr, *prevPtr;
-    ByteCode* codePtr;
+    ByteCodeData* codePtr;
     char *bytes;
     int length, index;
 
@@ -807,7 +809,7 @@ TclReleaseLiteral(interp, objPtr)
 		 */
 	    
 		if (objPtr->typePtr == &tclByteCodeType) {
-		    codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+		    codePtr = ((ByteCode *) objPtr->internalRep.otherValuePtr)->bcDataPtr;
 		    if ((codePtr->numLitObjects == 1)
 		            && (codePtr->objArrayPtr[0] == objPtr)) {			
 			codePtr->objArrayPtr[0] = NULL;
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 74a7fbe..836f6a3 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
  * 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.17.2.1.2.2 2002/03/18 22:30:50 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.17.2.1.2.3 2002/11/26 19:48:57 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -86,9 +86,6 @@ static void		FreeNsNameInternalRep _ANSI_ARGS_((
 static int		GetNamespaceFromObj _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    Tcl_Namespace **nsPtrPtr));
-static int		InvokeImportedCmd _ANSI_ARGS_((
-			    ClientData clientData, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
 static int		NamespaceChildrenCmd _ANSI_ARGS_((
 			    ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]));
@@ -1273,7 +1270,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
 		dataPtr = (ImportedCmdData *)
 		        ckalloc(sizeof(ImportedCmdData));
                 importedCmd = Tcl_CreateObjCommand(interp, 
-                        Tcl_DStringValue(&ds), InvokeImportedCmd,
+                        Tcl_DStringValue(&ds), TclInvokeImportedCmd,
                         (ClientData) dataPtr, DeleteImportedCmd);
 		dataPtr->realCmdPtr = cmdPtr;
 		dataPtr->selfPtr = (Command *) importedCmd;
@@ -1438,7 +1435,7 @@ TclGetOriginalCommand(command)
 /*
  *----------------------------------------------------------------------
  *
- * InvokeImportedCmd --
+ * TclInvokeImportedCmd --
  *
  *	Invoked by Tcl whenever the user calls an imported command that
  *	was created by Tcl_Import. Finds the "real" command (in another
@@ -1454,8 +1451,8 @@ TclGetOriginalCommand(command)
  *----------------------------------------------------------------------
  */
 
-static int
-InvokeImportedCmd(clientData, interp, objc, objv)
+int
+TclInvokeImportedCmd(clientData, interp, objc, objv)
     ClientData clientData;	/* Points to the imported command's
 				 * ImportedCmdData structure. */
     Tcl_Interp *interp;		/* Current interpreter. */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 273a55e..953f9b2 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.23.6.2 2001/12/05 18:22:26 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.23.6.3 2002/11/26 19:48:57 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1298,3 +1298,119 @@ ProcBodyUpdateString(objPtr)
 {
     panic("called ProcBodyUpdateString");
 }
+
+
+
+Proc*
+TclCloneProc (interp, nsPtr, procSrcPtr)
+     Interp *interp;
+     Namespace *nsPtr;
+     Proc *procSrcPtr;
+{
+    /* Assume:
+     *
+     * interp = target interp, where to create the proc.
+     * nsPtr  = target namespace.
+     * cmdPtr field in new proc is set by caller.
+     */
+
+    CompiledLocal* src;
+    CompiledLocal* new;
+    CompiledLocal* last;
+
+    Tcl_Obj * newBody;
+    ByteCode* bcPtr;
+    int result;
+
+    Proc * procNew = (Proc *) ckalloc (sizeof (Proc));
+
+    procNew->iPtr = (Interp *) interp;
+    procNew->refCount = 1; /* Present in cmd table, not active */
+    procNew->numArgs = procSrcPtr->numArgs;
+
+    /*
+     * And now the complex operation: Share as much of the bytecode for
+     * the procedure as possible. Compile the procedure if necessary.
+     * Compile environment is the source interp, as this is the only one
+     * where we know that the environment is complete.
+     */
+
+    result = TclProcCompileProc((Tcl_Interp*) procSrcPtr->iPtr, procSrcPtr,
+				procSrcPtr->bodyPtr, procSrcPtr->cmdPtr->nsPtr,
+				"body of proc",
+				Tcl_GetHashKey (procSrcPtr->cmdPtr->hPtr->tablePtr,
+						procSrcPtr->cmdPtr->hPtr));
+    if (result != TCL_OK) {
+      return NULL;
+    }
+
+    procNew->numCompiledLocals = procSrcPtr->numCompiledLocals;
+
+    if (!procSrcPtr->firstLocalPtr) {
+        procNew->firstLocalPtr = NULL;
+        procNew->lastLocalPtr = NULL;
+    } else {
+        for (last = NULL, src = procSrcPtr->firstLocalPtr;
+	     src != NULL;
+	     src = src->nextPtr) {
+
+	    size_t size = sizeof (CompiledLocal) - sizeof(src->name) + src->nameLength+1;
+
+	    new = (CompiledLocal *) ckalloc (size);
+	    memcpy (new, src, size);
+
+	    new->nextPtr = NULL;
+	    if (new->defValuePtr) {
+	        Tcl_IncrRefCount (new->defValuePtr);
+	    }
+	    if (last != NULL) {
+	        last->nextPtr = new;
+	    }
+	    if (src->resolveInfo) {
+	        new->resolveInfo = (Tcl_ResolvedVarInfo *) ckalloc (sizeof (Tcl_ResolvedVarInfo));
+		memcpy (new->resolveInfo, src->resolveInfo, sizeof (Tcl_ResolvedVarInfo));
+	    } else {
+	        new->resolveInfo = src->resolveInfo;
+	    }
+
+	    if (src == procSrcPtr->firstLocalPtr) procNew->firstLocalPtr = new;
+	    if (src == procSrcPtr->lastLocalPtr)  procNew->lastLocalPtr = new;
+	    last = new;
+	}
+    }
+
+    /*
+     * Now that we have the bytecode we can create a Tcl_Obj,
+     * containing a duplicate of the unshareable part and
+     * referencing the shared part. This becomes the body for the
+     * cloned proc.
+     */
+
+    procNew->bodyPtr  = newBody = Tcl_NewObj ();
+
+    newBody->refCount = 1;
+    newBody->typePtr  = procSrcPtr->bodyPtr->typePtr;
+    newBody->length   = procSrcPtr->bodyPtr->length;
+    newBody->bytes    = (char*) ckalloc ((unsigned int) procSrcPtr->bodyPtr->length+1);
+
+    memcpy (newBody->bytes, procSrcPtr->bodyPtr->bytes,
+	    (unsigned int) procSrcPtr->bodyPtr->length+1);
+
+    bcPtr = newBody->internalRep.otherValuePtr = ckalloc (sizeof (ByteCode));
+
+    memcpy (newBody->internalRep.otherValuePtr,
+	    procSrcPtr->bodyPtr->internalRep.otherValuePtr,
+	    sizeof (ByteCode));
+
+    bcPtr->interpHandle = TclHandlePreserve (interp->handle);
+    bcPtr->nsPtr = nsPtr;
+    bcPtr->source = newBody->bytes;
+    bcPtr->procPtr = procNew;
+
+    bcPtr->bcDataPtr->refCount ++;
+    bcPtr->compileEpoch = interp->compileEpoch;
+    bcPtr->nsEpoch = nsPtr->resolverEpoch;
+    bcPtr->refCount = 1;
+
+    return procNew;
+}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2813da0..cbafee3 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * 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.35.2.7.2.1 2001/11/28 17:58:37 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.35.2.7.2.2 2002/11/26 19:48:58 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1170,6 +1170,95 @@ TclStubs tclStubs = {
     Tcl_ChannelGetHandleProc, /* 409 */
     Tcl_ChannelFlushProc, /* 410 */
     Tcl_ChannelHandlerProc, /* 411 */
+    NULL, /* 412 */
+    NULL, /* 413 */
+    NULL, /* 414 */
+    NULL, /* 415 */
+    NULL, /* 416 */
+    NULL, /* 417 */
+    NULL, /* 418 */
+    NULL, /* 419 */
+    NULL, /* 420 */
+    NULL, /* 421 */
+    NULL, /* 422 */
+    NULL, /* 423 */
+    NULL, /* 424 */
+    NULL, /* 425 */
+    NULL, /* 426 */
+    NULL, /* 427 */
+    NULL, /* 428 */
+    NULL, /* 429 */
+    NULL, /* 430 */
+    NULL, /* 431 */
+    NULL, /* 432 */
+    NULL, /* 433 */
+    NULL, /* 434 */
+    NULL, /* 435 */
+    NULL, /* 436 */
+    NULL, /* 437 */
+    NULL, /* 438 */
+    NULL, /* 439 */
+    NULL, /* 440 */
+    NULL, /* 441 */
+    NULL, /* 442 */
+    NULL, /* 443 */
+    NULL, /* 444 */
+    NULL, /* 445 */
+    NULL, /* 446 */
+    NULL, /* 447 */
+    NULL, /* 448 */
+    NULL, /* 449 */
+    NULL, /* 450 */
+    NULL, /* 451 */
+    NULL, /* 452 */
+    NULL, /* 453 */
+    NULL, /* 454 */
+    NULL, /* 455 */
+    NULL, /* 456 */
+    NULL, /* 457 */
+    NULL, /* 458 */
+    NULL, /* 459 */
+    NULL, /* 460 */
+    NULL, /* 461 */
+    NULL, /* 462 */
+    NULL, /* 463 */
+    NULL, /* 464 */
+    NULL, /* 465 */
+    NULL, /* 466 */
+    NULL, /* 467 */
+    NULL, /* 468 */
+    NULL, /* 469 */
+    NULL, /* 470 */
+    NULL, /* 471 */
+    NULL, /* 472 */
+    NULL, /* 473 */
+    NULL, /* 474 */
+    NULL, /* 475 */
+    NULL, /* 476 */
+    NULL, /* 477 */
+    NULL, /* 478 */
+    NULL, /* 479 */
+    NULL, /* 480 */
+    NULL, /* 481 */
+    NULL, /* 482 */
+    NULL, /* 483 */
+    NULL, /* 484 */
+    NULL, /* 485 */
+    NULL, /* 486 */
+    NULL, /* 487 */
+    NULL, /* 488 */
+    NULL, /* 489 */
+    NULL, /* 490 */
+    NULL, /* 491 */
+    NULL, /* 492 */
+    NULL, /* 493 */
+    NULL, /* 494 */
+    NULL, /* 495 */
+    NULL, /* 496 */
+    NULL, /* 497 */
+    NULL, /* 498 */
+    NULL, /* 499 */
+    Tcl_CloneInterp, /* 500 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 30373ab..29200f9 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.17.2.3 2001/09/20 01:13:03 hobbs Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.17.2.3.2.1 2002/11/26 19:48:58 andreas_kupries Exp $
  */
 
 #define TCL_TEST
@@ -282,6 +282,10 @@ static int		TestChannelCmd _ANSI_ARGS_((ClientData dummy,
 static int		TestChannelEventCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 
+static int		TestCloneCmd _ANSI_ARGS_((
+			    ClientData clientData, Tcl_Interp *interp,
+			    int argc, char **argv));
+
 /*
  * External (platform specific) initialization routine, these declarations
  * explicitly don't use EXTERN since this code does not get compiled
@@ -430,6 +434,11 @@ Tcltest_Init(interp)
 	    (ClientData) 345);
     Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateCommand(interp, "testclone", TestCloneCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+
+
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -4823,3 +4832,39 @@ TestChannelEventCmd(dummy, interp, argc, argv)
             "add, delete, list, set, or removeall", (char *) NULL);
     return TCL_ERROR;
 }
+
+
+static int
+TestCloneCmd (clientData, interp, argc, argv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int argc;
+     char **argv;
+{
+  static Tcl_Interp* clone; /* The clone to use.
+			     */
+  /* Syntax:
+   * testclone create
+   * testclone eval script
+   * testclone destroy
+   */
+
+  char* cmd = argv [1];
+  unsigned int length = strlen(cmd);
+
+  if (cmd [0] == 'c' && 0 == strncmp (argv [1], "create", length)) {
+      clone = Tcl_CloneInterp (interp);
+      return TCL_OK;
+  } else if (cmd [0] == 'd' && 0 == strncmp (argv [1], "destroy", length)) {
+      Tcl_DeleteInterp (clone);
+      clone = NULL;
+      return TCL_OK;
+  } else if (cmd [0] == 'e' && 0 == strncmp (argv [1], "eval", length)) {
+    int res = Tcl_Eval (clone, argv [2]);
+    TclTransferResult(clone, res, interp);
+    return res;
+  }
+  Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
+            "create, eval, or destroy", (char *) NULL);
+  return TCL_ERROR;
+}
diff --git a/tests/clone.test b/tests/clone.test
new file mode 100644
index 0000000..223acbb
--- /dev/null
+++ b/tests/clone.test
@@ -0,0 +1,158 @@
+# -*- tcl -*- Commands covered:  interpreter cloning ...
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2002 by ActiveState Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: clone.test,v 1.1.2.1 2002/11/26 19:49:00 andreas_kupries Exp $
+
+# Prevent execution of these tests when running in the cloned interpreter !!
+if {[info exists __clone__]} return
+
+memory validate on
+
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+
+proc foo {} {
+    # Have a compiled local variable.
+    set dummy 22
+}
+
+
+test clone-1.1 {simple creation and destruction} {
+    # This test checks that the basic creation of a clone, and its
+    # destruction do not crash. The continued execution of the regular
+    # testsuite in the main interpreter immediately after this test
+    # also checks that the desctruction of hte clone did not disrupt
+    # the original.
+
+    testclone create
+    testclone destroy
+    set a 0
+} {0}
+
+test clone-1.2 {linked variables} {
+    # Check that variables linked between namespaces are cloned
+    # correctly (need fixup similar to commands imported into
+    # namespaces), and that their values are ok. This essentially
+    # tests sharing of contents, and the inter-var references.
+
+    set a ""
+    namespace eval ::__foo__ {variable xx 1}
+    namespace eval ::__bar__ {upvar ::__foo__::xx xx}
+
+    append a m[set ::__foo__::xx][set ::__bar__::xx]
+
+    testclone create
+    append a -c[testclone eval {set ::__foo__::xx}][testclone eval {set ::__bar__::xx}]
+    append a  m[set ::__foo__::xx][set ::__bar__::xx]
+
+    testclone destroy
+    append a -m[set ::__foo__::xx][set ::__bar__::xx]
+
+    namespace delete ::__foo__
+    namespace delete ::__bar__
+    set a
+} {m11-c11m11-m11}
+
+test clone-1.3 {cloned variables} {
+    # Check that variables linked between namespaces are cloned
+    # correctly (need fixup similar to commands imported into
+    # namespaces). Tests sharing of contents.
+
+    set    a ""
+    append a "m[set tcl_patchLevel]"
+
+    testclone create
+    append a -c[testclone eval {set tcl_patchLevel}]
+    append a  m[set tcl_patchLevel]
+
+    testclone destroy
+    append a -m[set tcl_patchLevel]
+
+    set a
+} {m8.3.4-c8.3.4m8.3.4-m8.3.4}
+
+test clone-1.4 {cloned variables, arrays} {
+    # Check that variables linked between namespaces are cloned
+    # correctly (need fixup similar to commands imported into
+    # namespaces). Tests that sharing of arrays is ok.
+
+    array set x {x _}
+
+    set    a ""
+    append a "m[array get x]"
+
+    testclone create
+    append a -c[testclone eval {array get x}]
+    append a  m[array get x]
+
+    testclone destroy
+    append a -m[array get x]
+
+    set a
+} {mx _-cx _mx _-mx _}
+
+
+proc act_Setup { } {
+    global dest
+    global beep
+          
+    set beep 11
+}
+
+test clone-1.5 {eval proc} {
+    # This test checks that the basic creation of a clone, and its
+    # destruction do not crash. The continued execution of the regular
+    # testsuite in the main interpreter immediately after this test
+    # also checks that the desctruction of hte clone did not disrupt
+    # the original.
+
+    testclone create
+    set res [testclone eval {act_Setup}]
+    testclone destroy
+    set res
+} {11}
+
+
+
+test clone-2.0 {sub testsuite} {
+    # Now we run the entire testsuite in the cloned interpreter.
+    # This should stress test the data structures, especially
+    # the execution of shared bytecode.
+
+    puts  ___
+    puts "___ Running the entire testsuite inside of the cloned interpreter"
+    puts  ___
+    puts  ___
+
+    testclone create
+    testclone eval {set __clone__ 1}
+    set res [testclone eval [list source [file join $tcltest::testsDirectory all.tcl]]]
+    testclone destroy
+    set res
+} {}
+
+#exit
+
+puts  ___
+puts "___ Proceeding to run the entire testsuite in the main interpreter."
+puts  ___
+puts  ___
+
+# cleanup
+::tcltest::cleanupTests
+return