* generic/tclExecute.c: leak fix in INST_STORE_SCALAR

3 files changed, 84 insertions, 94 deletions

diff --git a/ChangeLog b/ChangeLog
index 37f3d93..1188407 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 2005-04-02  Miguel Sofer <msofer@users.sf.net>
 
+	* generic/tclExecute.c: leak fix in INST_STORE_SCALAR
+
 	*** FROM HEAD ***
 	* doc/ListObj.3:
 	* generic/tclBasic.c:
@@ -26,6 +28,7 @@
 	* generic/tclObj.c:
 	* generic/tclStringObj.c: opt in INST_*_SCALAR, sync with HEAD: 
 
+	*** FROM HEAD ***
 	- (INST_JUMP_TRUE/FALSE): replaced "test and branch" with "compute
 	index into table" 
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d143c04..ab28bc6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.81.2.17 2005/03/31 18:07:10 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.81.2.18 2005/04/02 21:04:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2990,8 +2990,8 @@ TclPrintInstruction(codePtr, pc)
 		    break;
 		}
 		if (!procPtr) {
-		    Tcl_Panic("TclPrintInstruction: local var index %u (%u locals) outside of a proc.\n",
-			     (unsigned int) opnd, localCt);
+		    Tcl_Panic("TclPrintInstruction: local var index %u outside of a proc.\n",
+			     (unsigned int) opnd);
 		}
 		localCt = procPtr->numCompiledLocals;
 		localPtr = procPtr->firstLocalPtr;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f8d09c7..f758584 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.171.2.17 2005/04/02 13:36:07 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.171.2.18 2005/04/02 21:04:35 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1921,7 +1921,7 @@ TclExecuteByteCode(interp, codePtr)
 
 	    if (index < HPUINT_MAX) {
 		/*
-		 * A local indexed variable
+		 * A local indexed variable. 
 		 */
 	    
 		varPtr = &(compiledLocals[index]);
@@ -1931,19 +1931,16 @@ TclExecuteByteCode(interp, codePtr)
 		}
 		TRACE(("%u => ", (unsigned) index));
 		if (!isArray) {
-		    if (TclIsVarDirectReadable(varPtr)) {
-			/*
-			 * No errors, no traces: just get the value.
-			 */
-			objResultPtr = varPtr->value.objPtr;
-			TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-			pc++;
-			NEXT_INST_F(0, 1);
-		    }
+		    /*
+		     * A local indexed scalar: With the optimiser, this branch
+		     * will never be followed.
+		     */
+		    
 		    cleanup = 0;
 		    arrayPtr = NULL;
-		    part2 = NULL;		    
+		    part2 = NULL;
 		} else {
+		    cleanup = 1;
 		    part2 = Tcl_GetString(*tosPtr);  /* element name */
 		    arrayPtr = varPtr;
 		    varPtr = TclLookupArrayElement(interp, part1, part2, 
@@ -1953,17 +1950,17 @@ TclExecuteByteCode(interp, codePtr)
 			result = TCL_ERROR;
 			goto checkForCatch;
 		    }
-		    if (TclIsVarDirectReadable(varPtr) && ((arrayPtr == NULL) 
-				|| TclIsVarUntraced(arrayPtr))) {
-			/*
-			 * No errors, no traces: just get the value.
-			 */
-			objResultPtr = varPtr->value.objPtr;
-			TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-			pc++;
-			NEXT_INST_F(1, 1);
-		    }
-		    cleanup = 1;
+		}
+		if (TclIsVarDirectReadable(varPtr) && ((arrayPtr == NULL) 
+			    || TclIsVarUntraced(arrayPtr))) {
+		    /*
+		     * No errors, no traces: just get the value.
+		     */
+		    objResultPtr = varPtr->value.objPtr;
+		    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		    pc++;
+		    NEXT_INST_F(cleanup, 1); /* using _F, insert branching
+					      * here */ 
 		}
 		    
 		/*
@@ -2026,15 +2023,21 @@ TclExecuteByteCode(interp, codePtr)
 		varPtr = varPtr->value.linkPtr;
 	    }
 	    TRACE(("%u => ", (unsigned) index));
-	    if ((flags == TCL_LEAVE_ERR_MSG)
-		    && TclIsVarDirectWritable(varPtr)) {
+
+	    /*
+	     * NOTE: this instruction is only generated by the optimiser when
+	     * a plain set is requested. There is no need to check the flags
+	     * again. 
+	     */
+	    
+	    if (TclIsVarDirectWritable(varPtr)) {
 		/*
 		 * No traces, no errors, plain 'set': we can safely inline.
 		 * The value *will* be set to what's requested, so that 
 		 * the stack top remains pointing to the same Tcl_Obj.
 		 */
-		valuePtr = varPtr->value.objPtr;
-		
+
+		valuePtr = varPtr->value.objPtr;		
 		objResultPtr = *tosPtr;
 		if (valuePtr != objResultPtr) {
 		    if (valuePtr != NULL) {
@@ -2044,14 +2047,24 @@ TclExecuteByteCode(interp, codePtr)
 			TclClearVarUndefined(varPtr);
 		    }
 		    varPtr->value.objPtr = objResultPtr;
-		}
-		if (pushRes) {
-		    /* Add the refCount for the variable value*/
-		    Tcl_IncrRefCount(objResultPtr);
+		    if (pushRes) {
+			/* Add the refCount for the variable value, stack remains
+			 * as is */
+			Tcl_IncrRefCount(objResultPtr);
+		    } else {
+			/* Remove from stacktop, hijack its refCount for the
+			 * variable value. */
+			tosPtr--;
+		    }
 		} else {
-		    /* Remove from stacktop, hijack its refCount for the
-		     * variable value. */
-		    tosPtr--;
+		    if (pushRes) {
+			/* Do nothing - stacktop remains as is, refCount is
+			 * correct */
+		    } else {
+			/* Remove from stacktop, reduce refCount*/
+			tosPtr--;
+			TclDecrRefCount(objResultPtr);
+		    }		    
 		}
 		pc++;
 		NEXT_INST_F(0,0);
@@ -2079,41 +2092,20 @@ TclExecuteByteCode(interp, codePtr)
 		    varPtr = varPtr->value.linkPtr;
 		}
 		TRACE(("%u => ", (unsigned) index));
+		cleanup = isArray + 1;
+		
 		if (!isArray) {
-		    if ((flags == TCL_LEAVE_ERR_MSG)
-			    && TclIsVarDirectWritable(varPtr)) {
-			/*
-			 * No traces, no errors, plain 'set': we can safely inline.
-			 * The value *will* be set to what's requested, so that 
-			 * the stack top remains pointing to the same Tcl_Obj.
-			 */
-			valuePtr = varPtr->value.objPtr;
-			
-			objResultPtr = *tosPtr;
-			if (valuePtr != objResultPtr) {
-			    if (valuePtr != NULL) {
-				TclDecrRefCount(valuePtr);
-			    } else {
-				TclSetVarScalar(varPtr);
-				TclClearVarUndefined(varPtr);
-			    }
-			    varPtr->value.objPtr = objResultPtr;
-			}
-			if (pushRes) {
-			    /* Add the refCount for the variable value*/
-			    Tcl_IncrRefCount(objResultPtr);
-			} else {
-			    /* Remove from stacktop, hijack its refCount for the
-			     * variable value. */
-			    tosPtr--;
-			}
-			pc++;
-			NEXT_INST_F(0,0);
-		    }
+		    /*
+		     * A local indexed scalar: With the optimiser, this branch
+		     * will only be followed for append and lappend, not for
+		     * plain set. 
+		     */
+
 		    part2 = NULL;
 		    arrayPtr = NULL;
 		    cleanup = 1;
 		} else {
+		    cleanup = 2;
 		    part2 = Tcl_GetString(*(tosPtr-1));  /* element name */
 		    arrayPtr = varPtr;
 		    varPtr = TclLookupArrayElement(interp, part1, part2, 
@@ -2123,36 +2115,31 @@ TclExecuteByteCode(interp, codePtr)
 			result = TCL_ERROR;
 			goto checkForCatch;
 		    }
-		    if ((flags == TCL_LEAVE_ERR_MSG)
-			    && TclIsVarDirectWritable(varPtr)
-			    && ((arrayPtr == NULL) 
-				    || TclIsVarUntraced(arrayPtr))) {
-			/*
-			 * No traces, no errors, plain 'set': we can safely inline.
-			 * The value *will* be set to what's requested, so that 
-			 * the stack top remains pointing to the same Tcl_Obj.
-			 */
-			valuePtr = varPtr->value.objPtr;
-			
-			objResultPtr = *tosPtr;
-			if (valuePtr != objResultPtr) {
-			    if (valuePtr != NULL) {
-				TclDecrRefCount(valuePtr);
-			    } else {
-				TclSetVarScalar(varPtr);
-				TclClearVarUndefined(varPtr);
-			    }
-			    varPtr->value.objPtr = objResultPtr;
-			    Tcl_IncrRefCount(objResultPtr);
-			}
-			pc++;
-			if (pushRes) {
-			    NEXT_INST_F(2, 1);
+		}
+		if ((flags == TCL_LEAVE_ERR_MSG)
+			&& TclIsVarDirectWritable(varPtr)
+			&& ((arrayPtr == NULL) 
+				|| TclIsVarUntraced(arrayPtr))) {
+		    /*
+		     * No traces, no errors, plain 'set': we can safely inline.
+		     * The value *will* be set to what's requested, so that 
+		     * the stack top remains pointing to the same Tcl_Obj.
+		     */
+
+		    valuePtr = varPtr->value.objPtr;		    
+		    objResultPtr = *tosPtr;
+		    if (valuePtr != objResultPtr) {
+			if (valuePtr != NULL) {
+			    TclDecrRefCount(valuePtr);
 			} else {
-			    NEXT_INST_F(2, 0);
+			    TclSetVarScalar(varPtr);
+			    TclClearVarUndefined(varPtr);
 			}
+			varPtr->value.objPtr = objResultPtr;
+			Tcl_IncrRefCount(objResultPtr);
 		    }
-		    cleanup = 2;
+		    pc++;
+		    NEXT_INST_F(cleanup, pushRes);
 		}
 
 		doCallPtrSetVar: