Updated core w/ Micheals latest changes.

6 files changed, 258 insertions, 147 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index fb5fc94..2742a6d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.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.
  *
- * SCCS: %Z% $Id: tcl.h,v 1.12 1998/07/21 15:25:42 escoffon Exp $ 
+ * SCCS: %Z% $Id: tcl.h,v 1.13 1998/07/24 13:49:40 surles Exp $ 
  */
 
 #ifndef _TCL
@@ -534,45 +534,6 @@ typedef struct Tcl_Namespace {
 } Tcl_Namespace;
 
 /*
- * The following procedures allow namespaces to be customized to
- * support special name resolution rules for commands/variables.
- * 
- */
-typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
-	Tcl_Interp* interp, ClientData identity));
-
-typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((ClientData identity));
-
-typedef struct Tcl_ResolvedVarInfo {
-    ClientData identity;
-    Tcl_ResolveRuntimeVarProc *fetchProc;
-    Tcl_ResolveVarDeleteProc *deleteProc;
-} Tcl_ResolvedVarInfo;
-
-typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
-	Tcl_Interp* interp, char* name, int length,
-        Tcl_Namespace *context, Tcl_ResolvedVarInfo *rPtr));
-
-typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
-	Tcl_Interp* interp, char* name, Tcl_Namespace *context,
-	int flags, Tcl_Var *rPtr));
-
-typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
-	char* name, Tcl_Namespace *context, int flags,
-	Tcl_Command *rPtr));
-
-typedef struct Tcl_ResolverInfo {
-    Tcl_ResolveCmdProc *cmdResProc;	/* Procedure handling command name
-					 * resolution. */
-    Tcl_ResolveVarProc *varResProc;	/* Procedure handling variable name
-					 * resolution for variables that
-					 * can only be handled at runtime. */
-    Tcl_ResolveCompiledVarProc *compiledVarResProc;
-					/* Procedure handling variable name
-					 * resolution at compile time. */
-} Tcl_ResolverInfo;
-
-/*
  * The following structure represents a call frame, or activation record.
  * A call frame defines a naming context for a procedure call: its local
  * scope (for local variables) and its namespace scope (used for non-local
@@ -1063,10 +1024,6 @@ typedef enum Tcl_PathType {
 
 EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *message));
-EXTERN void		Tcl_AddInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
-			    char *name, Tcl_ResolveCmdProc *cmdProc,
-			    Tcl_ResolveVarProc *varProc,
-			    Tcl_ResolveCompiledVarProc *compiledVarProc));
 EXTERN void		Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *message, int length));
 EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
@@ -1321,16 +1278,11 @@ EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *string, int *intPtr));
 EXTERN int		Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
 			    Tcl_Interp *slaveInterp));
-EXTERN int              Tcl_GetInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
-                            char *name, Tcl_ResolverInfo *resInfo));
 EXTERN int		Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, int *intPtr));
 EXTERN int		Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, long *longPtr));
 EXTERN Tcl_Interp *	Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int              Tcl_GetNamespaceResolvers _ANSI_ARGS_((
-			    Tcl_Namespace *namespacePtr,
-			    Tcl_ResolverInfo *resInfo));
 EXTERN CONST char *	Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
 EXTERN Tcl_Obj *	Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
 EXTERN Tcl_ObjType *	Tcl_GetObjType _ANSI_ARGS_((char *typeName));
@@ -1457,8 +1409,6 @@ EXTERN void		Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN void		Tcl_RegisterObjType _ANSI_ARGS_((
 			    Tcl_ObjType *typePtr));
 EXTERN void		Tcl_Release _ANSI_ARGS_((ClientData clientData));
-EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
-			    Tcl_Interp *interp, char *name));
 EXTERN void		Tcl_RestartIdleTimer _ANSI_ARGS_((void));
 EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
 #define Tcl_Return Tcl_SetResult
@@ -1494,11 +1444,6 @@ EXTERN void		Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr,
 EXTERN void		Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr, 
 			    long longValue));
 EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
-			    Tcl_Namespace *namespacePtr,
-			    Tcl_ResolveCmdProc *cmdProc,
-			    Tcl_ResolveVarProc *varProc,
-			    Tcl_ResolveCompiledVarProc *compiledVarProc));
 EXTERN void		Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *errorObjPtr));
 EXTERN void		Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7f07a27..c5bce05 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.
  *
- * SCCS: %Z% $Id: tclCompile.c,v 1.7 1998/07/06 14:54:30 welch Exp $ 
+ * SCCS: %Z% $Id: tclCompile.c,v 1.8 1998/07/24 13:49:13 surles Exp $ 
  */
 
 #include "tclInt.h"
@@ -6690,8 +6690,9 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
 	    localPtr = procPtr->firstLocalPtr;
 	    for (i = 0;  i < localCt;  i++) {
 	        if (!localPtr->isTemp) {
-                    currInfo = &localPtr->resolveInfo;
-		    if ( (currInfo->fetchProc == vinfo.fetchProc) &&
+                    currInfo = localPtr->resolveInfo;
+		    if ( currInfo &&
+			    (currInfo->fetchProc == vinfo.fetchProc) &&
 	                 (currInfo->identity == vinfo.identity) ) {
 		        return i;
 		    }
@@ -6729,9 +6730,16 @@ createCompiledLocal:
 	localPtr->isTemp = (name == NULL);
 	localPtr->flags = flagsIfCreated;
 	localPtr->defValuePtr = NULL;
-	localPtr->resolveInfo.identity = vinfo.identity;
-	localPtr->resolveInfo.fetchProc = vinfo.fetchProc;
-	localPtr->resolveInfo.deleteProc = vinfo.deleteProc;
+ 	localPtr->resolveInfo = NULL;
+ 
+	if (vinfo.fetchProc) {
+	    localPtr->resolveInfo =
+		(Tcl_ResolvedVarInfo *) ckalloc( sizeof(Tcl_ResolvedVarInfo) );
+ 	    localPtr->resolveInfo->identity = vinfo.identity;
+ 	    localPtr->resolveInfo->fetchProc = vinfo.fetchProc;
+ 	    localPtr->resolveInfo->deleteProc = vinfo.deleteProc;
+	}
+	
 	if (name != NULL) {
 	    memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars);
 	}
diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
index 3c0e1e3..b8900cf 100644
--- a/generic/tclInitScript.h
+++ b/generic/tclInitScript.h
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: %Z% $Id: tclInitScript.h,v 1.2 1998/07/09 13:46:23 suresh Exp $ 
+ * SCCS: %Z% $Id: tclInitScript.h,v 1.3 1998/07/24 13:49:59 surles Exp $ 
  */
 
 /*
@@ -27,7 +27,7 @@
 static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
   proc tclInit {} {\n\
     global tcl_library tcl_version tcl_patchLevel errorInfo\n\
-    global tcl_pkgPath env\n\
+    global env tcl_pkgPath\n\
     rename tclInit {}\n\
     set errors {}\n\
     set dirs {}\n\
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 006f895..dbf6215 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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.
  *
- * SCCS: %Z% $Id: tclInt.h,v 1.9 1998/07/13 13:43:24 welch Exp $ 
+ * SCCS: %Z% $Id: tclInt.h,v 1.10 1998/07/24 13:49:46 surles Exp $ 
  */
 
 #ifndef _TCLINT
@@ -58,6 +58,45 @@
 #endif
 
 /*
+  * The following procedures allow namespaces to be customized to
+  * support special name resolution rules for commands/variables.
+  * 
+  */
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, ClientData identity));
+
+typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((ClientData identity));
+
+typedef struct Tcl_ResolvedVarInfo {
+    ClientData identity;
+    Tcl_ResolveRuntimeVarProc *fetchProc;
+    Tcl_ResolveVarDeleteProc *deleteProc;
+} Tcl_ResolvedVarInfo;
+
+typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, int length,
+    Tcl_Namespace *context, Tcl_ResolvedVarInfo *rPtr));
+
+typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, char* name, Tcl_Namespace *context,
+    int flags, Tcl_Var *rPtr));
+
+typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((Tcl_Interp* interp,
+ 	char* name, Tcl_Namespace *context, int flags,
+ 	Tcl_Command *rPtr));
+ 
+typedef struct Tcl_ResolverInfo {
+    Tcl_ResolveCmdProc *cmdResProc;	/* Procedure handling command name
+ 					 * resolution. */
+    Tcl_ResolveVarProc *varResProc;	/* Procedure handling variable name
+ 					 * resolution for variables that
+ 					 * can only be handled at runtime. */
+    Tcl_ResolveCompiledVarProc *compiledVarResProc;
+ 					/* Procedure handling variable name
+ 					 * resolution at compile time. */
+} Tcl_ResolverInfo;
+
+/*
  *----------------------------------------------------------------
  * Data structures related to namespaces.
  *----------------------------------------------------------------
@@ -480,7 +519,7 @@ typedef struct CompiledLocal {
     Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
 				 * argument, if any. NULL if not an argument
 				 * or, if an argument, no default value. */
-    Tcl_ResolvedVarInfo resolveInfo;
+    Tcl_ResolvedVarInfo *resolveInfo;
 				/* Customized variable resolution info
 				 * supplied by the Tcl_ResolveCompiledVarProc
 				 * associated with a namespace. Each variable
@@ -1552,6 +1591,9 @@ EXTERN int		TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
 		            Tcl_Obj *objPtr));
 EXTERN void		TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
+EXTERN int		TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr,
+ 			    CONST char *description, CONST char *procName));
 EXTERN void		TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
 EXTERN int		TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
 		    	    Tcl_Interp *interp, int argc, char **argv));
@@ -1982,6 +2024,10 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
  *----------------------------------------------------------------
  */
 
+EXTERN void		Tcl_AddInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+ 			    char *name, Tcl_ResolveCmdProc *cmdProc,
+ 			    Tcl_ResolveVarProc *varProc,
+ 			    Tcl_ResolveCompiledVarProc *compiledVarProc));
 EXTERN int		Tcl_AppendExportList _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Namespace *nsPtr,
 			    Tcl_Obj *objPtr));
@@ -1999,6 +2045,14 @@ EXTERN Tcl_Command	Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
 EXTERN Tcl_Namespace *	Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
 			    char *name, Tcl_Namespace *contextNsPtr,
 			    int flags));
+EXTERN int              Tcl_GetInterpResolvers _ANSI_ARGS_((Tcl_Interp *interp,
+                            char *name, Tcl_ResolverInfo *resInfo));
+EXTERN int              Tcl_GetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolverInfo *resInfo));
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Var variable,
+  			    Tcl_Obj *objPtr));
 EXTERN Tcl_Var		Tcl_FindNamespaceVar _ANSI_ARGS_((
 			    Tcl_Interp *interp, char *name,
 			    Tcl_Namespace *contextNsPtr, int flags));
@@ -2023,6 +2077,13 @@ EXTERN void		Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp* interp));
 EXTERN int		Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp* interp,
 			    Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr,
 			    int isProcCallFrame)); 
+EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
+			    Tcl_Interp *interp, char *name));
+EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
+			    Tcl_Namespace *namespacePtr,
+			    Tcl_ResolveCmdProc *cmdProc,
+			    Tcl_ResolveVarProc *varProc,
+			    Tcl_ResolveCompiledVarProc *compiledVarProc));
 
 #endif /* _TCLINT */
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d399426..45367c7 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1085,6 +1085,10 @@ Tcl_AppendExportList(interp, namespacePtr, objPtr)
  *	is NULL). This is done by creating a new command (the "imported
  *	command") that points to the real command in its original namespace.
  *
+ *      If matching commands are on the autoload path but haven't been
+ *	loaded yet, this command forces them to be loaded, then creates
+ *	the links to them.
+ *
  * Results:
  *	Returns TCL_OK if successful, or TCL_ERROR (along with an error
  *	message in the interpreter's result) if something goes wrong.
@@ -1120,7 +1124,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
     Tcl_HashSearch search;
     Command *cmdPtr;
     ImportRef *refPtr;
-    Tcl_Command importedCmd;
+    Tcl_Command autoCmd, importedCmd;
     ImportedCmdData *dataPtr;
     int wasExported, i, result;
 
@@ -1133,6 +1137,38 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
     } else {
         nsPtr = (Namespace *) namespacePtr;
     }
+ 
+    /*
+     * First, invoke the "auto_import" command with the pattern
+     * being imported.  This command is part of the Tcl library.
+     * It looks for imported commands in autoloaded libraries and
+     * loads them in.  That way, they will be found when we try
+     * to create links below.
+     */
+    
+    autoCmd = Tcl_FindCommand(interp, "auto_import",
+ 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+ 
+    if (autoCmd != NULL) {
+	Tcl_Obj *objv[2];
+ 
+	objv[0] = Tcl_NewStringObj("auto_import", -1);
+	Tcl_IncrRefCount(objv[0]);
+	objv[1] = Tcl_NewStringObj(pattern, -1);
+	Tcl_IncrRefCount(objv[1]);
+ 
+	cmdPtr = (Command *) autoCmd;
+	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+		2, objv);
+ 
+	Tcl_DecrRefCount(objv[0]);
+	Tcl_DecrRefCount(objv[1]);
+ 
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ResetResult(interp);
+    }
 
     /*
      * From the pattern, find the namespace from which we are importing
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 145db1c..5042279 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.
  *
- * SCCS: %Z% $Id: tclProc.c,v 1.9 1998/07/21 15:58:44 surles Exp $ 
+ * SCCS: %Z% $Id: tclProc.c,v 1.10 1998/07/24 13:49:29 surles Exp $ 
  */
 
 #include "tclInt.h"
@@ -45,7 +45,6 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
     char *fullName, *procName;
-    char **argArray = NULL;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
     Tcl_DString ds;
@@ -299,10 +298,8 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 	localPtr->isArg  = 1;
 	localPtr->isTemp = 0;
 	localPtr->flags = VAR_SCALAR;
-        localPtr->resolveInfo.identity   = NULL;
-        localPtr->resolveInfo.fetchProc  = NULL;
-        localPtr->resolveInfo.deleteProc = NULL;
-
+	localPtr->resolveInfo = NULL;
+	
 	if (fieldCount == 2) {
 	    localPtr->defValuePtr =
 		    Tcl_NewStringObj(fieldValues[1], valueLength);
@@ -718,14 +715,12 @@ TclObjInterpProc(clientData, interp, objc, objv)
 {
     Interp *iPtr = (Interp *) interp;
     Proc *procPtr = (Proc *) clientData;
-    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
     CallFrame frame;
     register CallFrame *framePtr = &frame;
     register Var *varPtr, *resolvedVarPtr;
     register CompiledLocal *localPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
-    Proc *saveProcPtr;
     char *procName, *bytes;
     int nameLen, localCt, numArgs, argCt, length, i, result;
 
@@ -749,75 +744,16 @@ TclObjInterpProc(clientData, interp, objc, objv)
     /*
      * If necessary, compile the procedure's body. The compiler will
      * allocate frame slots for the procedure's non-argument local
-     * variables. If the ByteCode already exists, make sure it hasn't been
-     * invalidated by someone redefining a core command (this might make the
-     * compiled code wrong). Also, if the code was compiled in/for a
-     * different interpreter, we recompile it. Note that compiling the body
-     * might increase procPtr->numCompiledLocals if new local variables are
-     * found while compiling.
-     *
-     * Precompiled procedure bodies, however, are immutable and therefore
-     * they are not recompiled, even if the epoch has changed.
+     * variables.  Note that compiling the body might increase
+     * procPtr->numCompiledLocals if new local variables are found
+     * while compiling.
      */
-
-    if (bodyPtr->typePtr == &tclByteCodeType) {
-	ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
-	
-	if ((codePtr->iPtr != iPtr)
-	        || (codePtr->compileEpoch != iPtr->compileEpoch)
-	        || (codePtr->nsPtr != nsPtr)
-	        || (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
-            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-                if (codePtr->iPtr != iPtr) {
-                    panic("TclObjInterpProc: compiled body jumped interps");
-                }
-	        codePtr->compileEpoch = iPtr->compileEpoch;
-            } else {
-                tclByteCodeType.freeIntRepProc(bodyPtr);
-                bodyPtr->typePtr = (Tcl_ObjType *) NULL;
-            }
-	}
-    }
-    if (bodyPtr->typePtr != &tclByteCodeType) {
-	char buf[100];
-	int numChars;
-	char *ellipsis;
-	
-	if (tclTraceCompile >= 1) {
-	    /*
-	     * Display a line summarizing the top level command we
-	     * are about to compile.
-	     */
-
-	    numChars = nameLen;
-	    ellipsis = "";
-	    if (numChars > 50) {
-		numChars = 50;
-		ellipsis = "...";
-	    }
-	    fprintf(stdout, "Compiling body of proc \"%.*s%s\"\n",
-		    numChars, procName, ellipsis);
-	}
-	
-	saveProcPtr = iPtr->compiledProcPtr;
-	iPtr->compiledProcPtr = procPtr;
-	result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
-	iPtr->compiledProcPtr = saveProcPtr;
-	
-	if (result != TCL_OK) {
-	    if (result == TCL_ERROR) {
-		numChars = nameLen;
-		ellipsis = "";
-		if (numChars > 50) {
-		    numChars = 50;
-		    ellipsis = "...";
-		}
-		sprintf(buf, "\n    (compiling body of proc \"%.*s%s\", line %d)",
-			numChars, procName, ellipsis, interp->errorLine);
-		Tcl_AddObjErrorInfo(interp, buf, -1);
-	    }
-	    return result;
-	}
+    
+    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	    "body of proc", procName);
+    
+    if (result != TCL_OK) {
+        return result;
     }
 
     /*
@@ -863,10 +799,10 @@ TclObjInterpProc(clientData, interp, objc, objv)
     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
 	    localPtr = localPtr->nextPtr) {
 
-        resVarInfo = &localPtr->resolveInfo;
+        resVarInfo = localPtr->resolveInfo;
         resolvedVarPtr = NULL;
 
-        if (resVarInfo->fetchProc != NULL) {
+        if (resVarInfo && resVarInfo->fetchProc) {
             resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
                 resVarInfo->identity);
         }
@@ -1030,6 +966,130 @@ TclObjInterpProc(clientData, interp, objc, objv)
 /*
  *----------------------------------------------------------------------
  *
+ * TclProcCompileProc --
+ *
+ *	Called just before a procedure is executed to compile the
+ *	body to byte codes.  If the type of the body is not
+ *	"byte code" or if the compile conditions have changed
+ *	(namespace context, epoch counters, etc.) then the body
+ *	is recompiled.  Otherwise, this procedure does nothing.
+  *
+  * Results:
+  *	None.
+  *
+  * Side effects:
+  *	May change the internal representation of the body object
+  *	to compiled code.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+int
+TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
+    Tcl_Interp *interp;		/* Interpreter containing procedure. */
+    Proc *procPtr;		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr;		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled
+ 				 * in the context of this procedure.) */
+    Namespace *nsPtr;		/* Namespace containing procedure. */
+    CONST char *description;	/* string describing this body of code. */
+    CONST char *procName;	/* Name of this procedure. */
+{
+    Interp *iPtr = (Interp*)interp;
+    int result;
+    Tcl_CallFrame frame;
+    Proc *saveProcPtr;
+ 
+    /*
+     * If necessary, compile the procedure's body. The compiler will
+     * allocate frame slots for the procedure's non-argument local
+     * variables. If the ByteCode already exists, make sure it hasn't been
+     * invalidated by someone redefining a core command (this might make the
+     * compiled code wrong). Also, if the code was compiled in/for a
+     * different interpreter, we recompile it. Note that compiling the body
+     * might increase procPtr->numCompiledLocals if new local variables are
+     * found while compiling.
+     */
+ 
+    if (bodyPtr->typePtr == &tclByteCodeType) {
+ 	ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+ 
+ 	if ((codePtr->iPtr != iPtr)
+ 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
+ 	        || (codePtr->nsPtr != nsPtr)
+ 	        || (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
+ 	    tclByteCodeType.freeIntRepProc(bodyPtr);
+ 	    bodyPtr->typePtr = (Tcl_ObjType *) NULL;
+ 	}
+    }
+    if (bodyPtr->typePtr != &tclByteCodeType) {
+ 	char buf[100];
+ 	int numChars;
+ 	char *ellipsis;
+ 	
+ 	if (tclTraceCompile >= 1) {
+ 	    /*
+ 	     * Display a line summarizing the top level command we
+ 	     * are about to compile.
+ 	     */
+ 
+ 	    numChars = strlen(procName);
+ 	    ellipsis = "";
+ 	    if (numChars > 50) {
+ 		numChars = 50;
+ 		ellipsis = "...";
+ 	    }
+ 	    fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
+ 		    description, numChars, procName, ellipsis);
+ 	}
+ 	
+ 	/*
+ 	 * Plug the current procPtr into the interpreter and coerce
+ 	 * the code body to byte codes.  The interpreter needs to
+ 	 * know which proc it's compiling so that it can access its
+ 	 * list of compiled locals.
+ 	 *
+ 	 * TRICKY NOTE:  Be careful to push a call frame with the
+ 	 *   proper namespace context, so that the byte codes are
+ 	 *   compiled in the appropriate class context.
+ 	 */
+ 
+ 	saveProcPtr = iPtr->compiledProcPtr;
+ 	iPtr->compiledProcPtr = procPtr;
+ 
+ 	result = Tcl_PushCallFrame(interp, &frame,
+		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
+ 
+ 	if (result == TCL_OK) {
+	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
+	    Tcl_PopCallFrame(interp);
+	}
+ 
+ 	iPtr->compiledProcPtr = saveProcPtr;
+ 	
+ 	if (result != TCL_OK) {
+ 	    if (result == TCL_ERROR) {
+ 		numChars = strlen(procName);
+ 		ellipsis = "";
+ 		if (numChars > 50) {
+ 		    numChars = 50;
+ 		    ellipsis = "...";
+ 		}
+ 		sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
+ 			description, numChars, procName, ellipsis,
+ 			interp->errorLine);
+ 		Tcl_AddObjErrorInfo(interp, buf, -1);
+ 	    }
+ 	    return result;
+ 	}
+    }
+    return TCL_OK;
+}
+ 
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclProcDeleteProc --
  *
  *	This procedure is invoked just before a command procedure is
@@ -1092,10 +1152,11 @@ TclProcCleanupProc(procPtr)
     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
 	CompiledLocal *nextPtr = localPtr->nextPtr;
 
-        resVarInfo = &localPtr->resolveInfo;
-	if (resVarInfo->deleteProc != NULL) {
+        resVarInfo = localPtr->resolveInfo;
+	if (resVarInfo && resVarInfo->deleteProc) {
             (*resVarInfo->deleteProc)(resVarInfo->identity);
             resVarInfo->identity = NULL;
+	    ckfree((char *) resVarInfo);
         }
 
 	if (localPtr->defValuePtr != NULL) {