From d74e3b012d3b59d8954b2a050b89230bc1863278 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sat, 2 Apr 2005 21:04:13 +0000 Subject: * generic/tclExecute.c: leak fix in INST_STORE_SCALAR --- ChangeLog | 3 + generic/tclCompile.c | 6 +- generic/tclExecute.c | 169 ++++++++++++++++++++++++--------------------------- 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 + * 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: -- cgit v0.12