? 729692.patch
? unix/ERR
? unix/httpd_2680
? unix/httpd_32632
? unix/httpd_879
? unix/st7CigPj
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.59
diff -u -r1.59 tclCompile.c
--- generic/tclCompile.c	29 Mar 2004 02:09:46 -0000	1.59
+++ generic/tclCompile.c	30 Mar 2004 00:23:02 -0000
@@ -282,6 +282,9 @@
 	/* List Index:	push (lindex stktop op4) */
     {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
 	/* List Range:	push (lrange stktop op4 op4) */
+
+    {"startCommand",      5,    0,         1,   {OPERAND_UINT4}},
+        /* Start of bytecoded command: op is the length of the cmd's code */ 
     {0}
 };
 
@@ -1056,9 +1059,26 @@
 			    unsigned int savedCodeNext =
 				    envPtr->codeNext - envPtr->codeStart;
 
+			    /*
+			     * Mark the start of the command; the proper
+			     * bytecode length will be updated later.
+			     */
+			    
+			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+			    
 			    code = (*(cmdPtr->compileProc))(interp, &parse,
 			            envPtr);
+			    
 			    if (code == TCL_OK) {
+				/*
+				 * Fix the bytecode length.
+				 */
+				unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1;
+				unsigned int fixLen = envPtr->codeNext - envPtr->codeStart
+				        - savedCodeNext;
+				
+				TclStoreInt4AtPtr(fixLen, fixPtr);
+				
 				goto finishCommand;
 			    } else if (code == TCL_OUT_LINE_COMPILE) {
 				/*
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.42
diff -u -r1.42 tclCompile.h
--- generic/tclCompile.h	20 Jan 2004 15:49:54 -0000	1.42
+++ generic/tclCompile.h	30 Mar 2004 00:23:03 -0000
@@ -543,8 +543,10 @@
 #define INST_LIST_INDEX_IMM		102
 #define INST_LIST_RANGE_IMM		103
 
+#define INST_START_CMD                  104
+
 /* The last opcode */
-#define LAST_INST_OPCODE		103
+#define LAST_INST_OPCODE		104
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.121
diff -u -r1.121 tclExecute.c
--- generic/tclExecute.c	18 Jan 2004 16:19:05 -0000	1.121
+++ generic/tclExecute.c	30 Mar 2004 00:23:07 -0000
@@ -61,15 +61,6 @@
 #   endif /* MAXDOUBLE */
 #endif /* !DBL_MAX */
 
-/*
- * A mask (should be 2**n-1) that is used to work out when the
- * bytecode engine should call Tcl_AsyncReady() to see whether there
- * is a signal that needs handling.
- */
-
-#ifndef ASYNC_CHECK_COUNT_MASK
-#   define ASYNC_CHECK_COUNT_MASK	15
-#endif /* !ASYNC_CHECK_COUNT_MASK */
 
 /*
  * Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -1098,9 +1089,11 @@
     int traceInstructions = (tclTraceExec == 3);
     char cmdNameBuf[21];
 #endif
-    int instructionCount = 0;	/* Counter that is used to work out
-				 * when to call Tcl_AsyncReady() */
-
+    Namespace *namespacePtr;
+    int codeCompileEpoch = codePtr->compileEpoch;
+    int codeNsEpoch = codePtr->nsEpoch;
+    int codePrecompiled = (codePtr->flags & TCL_BYTECODE_PRECOMPILED);
+    
     /*
      * The execution uses a unified stack: first the catch stack, immediately
      * above it the execution stack.
@@ -1134,6 +1127,11 @@
     iPtr->stats.numExecutions++;
 #endif
 
+    if (iPtr->varFramePtr != NULL) {
+        namespacePtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = iPtr->globalNsPtr;
+    }
 
     /*
      * Loop executing instructions until a "done" instruction, a 
@@ -1220,16 +1218,39 @@
      * do the check every 16th instruction.
      */
 
-    if (!(instructionCount++ & ASYNC_CHECK_COUNT_MASK) && Tcl_AsyncReady()) {
-	DECACHE_STACK_INFO();
-	result = Tcl_AsyncInvoke(interp, result);
-	CACHE_STACK_INFO();
-	if (result == TCL_ERROR) {
-	    goto checkForCatch;
-	}
-    }
 
     switch (*pc) {
+    case INST_START_CMD:
+	if (Tcl_AsyncReady()) {
+	    DECACHE_STACK_INFO();
+	    result = Tcl_AsyncInvoke(interp, result);
+	    CACHE_STACK_INFO();
+	    if (result == TCL_ERROR) {
+		goto checkForCatch;
+	    }
+	}
+	if ((!(iPtr->flags & DELETED)
+		    && (codeCompileEpoch == iPtr->compileEpoch)
+		    && (codeNsEpoch == namespacePtr->resolverEpoch))
+		|| codePrecompiled) {
+	    NEXT_INST_F(5, 0, 0);
+	} else {
+	    bytes = GetSrcInfoForPc(pc, codePtr, &length);
+	    result = Tcl_EvalEx(interp, bytes, length, 0);
+	    if (result != TCL_OK) {
+		goto checkForCatch;
+	    }
+	    opnd = TclGetUInt4AtPtr(pc+1);
+	    objResultPtr = Tcl_GetObjResult(interp);
+	    {
+		Tcl_Obj *newObjResultPtr;
+		TclNewObj(newObjResultPtr);
+		Tcl_IncrRefCount(newObjResultPtr);
+		iPtr->objResultPtr = newObjResultPtr;
+	    }
+	    NEXT_INST_V(opnd, 0, -1);
+	}
+	
     case INST_RETURN:
 	{
 	    int code = TclGetInt4AtPtr(pc+1);
@@ -1532,14 +1553,6 @@
 	    ++*preservedStackRefCountPtr;
 
 	    /*
-	     * Reset the instructionCount variable, since we're about
-	     * to check for async stuff anyway while processing
-	     * TclEvalObjvInternal.
-	     */
-
-	    instructionCount = 1;
-
-	    /*
 	     * Finally, let TclEvalObjvInternal handle the command. 
 	     */
 
Index: tests/interp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/interp.test,v
retrieving revision 1.26
diff -u -r1.26 interp.test
--- tests/interp.test	17 Mar 2004 18:14:17 -0000	1.26
+++ tests/interp.test	30 Mar 2004 00:23:09 -0000
@@ -753,7 +753,7 @@
 	list [catch {a eval foo} msg] $msg
     } {1 {attempt to call eval in deleted interpreter}}
 }
-test interp-18.9 {eval in deleted interp, bug 495830} {knownBug} {
+test interp-18.9 {eval in deleted interp, bug 495830} {
     interp create tst
     interp alias tst suicide {} interp delete tst
     list [catch {tst eval {suicide; set a 5}} msg] $msg
Index: tests/proc.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/proc.test,v
retrieving revision 1.12
diff -u -r1.12 proc.test
--- tests/proc.test	14 Nov 2003 20:44:47 -0000	1.12
+++ tests/proc.test	30 Mar 2004 00:23:09 -0000
@@ -325,6 +325,15 @@
     set result
 } -5
 
+test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
+    proc bar args {}
+    proc foo {} {
+	proc bar args {return bar}
+	bar
+    }
+    foo
+} bar
+
 # cleanup
 catch {rename p ""}
 catch {rename t ""}
Index: tests/rename.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/rename.test,v
retrieving revision 1.10
diff -u -r1.10 rename.test
--- tests/rename.test	12 Sep 2001 20:28:50 -0000	1.10
+++ tests/rename.test	30 Mar 2004 00:23:09 -0000
@@ -160,7 +160,7 @@
 
 
 test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
-    proc x {} {
+     proc x {} {
         set a 123
         set b [incr a]
     }
@@ -168,6 +168,8 @@
     rename incr incr.old
     proc incr {} {puts "new incr called!"}
     catch {x} msg
+    rename incr {}
+    rename incr.old incr
     set msg
 } {wrong # args: should be "incr"}
 
