diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclBasic.c | 5 | ||||
| -rw-r--r-- | generic/tclExecute.c | 6 | ||||
| -rw-r--r-- | generic/tclInt.h | 36 | ||||
| -rw-r--r-- | generic/tclProc.c | 3 | ||||
| -rw-r--r-- | generic/tclResult.c | 59 | ||||
| -rw-r--r-- | generic/tclStubLib.c | 3 | ||||
| -rw-r--r-- | generic/tclUtil.c | 3 |
8 files changed, 37 insertions, 81 deletions
@@ -16,6 +16,9 @@ * generic/tclStubLib.c: [Patch 1830184] * generic/tclUtil.c: + THIS PATCH WAS REVERTED: initial (mis)measurements overstated the + perfomance wins, which turn out to be tiny. Not worth the + complication. 2007-11-11 Jeff Hobbs <jeffh@ActiveState.com> diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5b38f5f..09eecc1 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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. * - * RCS: @(#) $Id: tclBasic.c,v 1.280 2007/11/12 03:38:13 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.281 2007/11/12 22:12:05 msofer Exp $ */ #include "tclInt.h" @@ -3426,7 +3426,7 @@ TclInterpReady( * any previous error information. */ - TclResetResult(iPtr); + Tcl_ResetResult(interp); /* * If the interpreter has been deleted, return an error. @@ -5398,7 +5398,6 @@ Tcl_AddObjErrorInfo( } Tcl_AppendToObj(iPtr->errorInfo, message, length); } - ((Interp *) interp)->flags |= INTERP_RESULT_UNCLEAN; } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index db7a504..44cb8e8 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.347 2007/11/12 03:38:13 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.348 2007/11/12 22:12:06 msofer Exp $ */ #include "tclInt.h" @@ -1218,7 +1218,7 @@ Tcl_ExprObj( saveObjPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(saveObjPtr); - TclResetResult(interp); + Tcl_ResetResult(interp); /* * Increment the code's ref count while it is being executed. If @@ -6336,7 +6336,7 @@ TclExecuteByteCode( case INST_END_CATCH: catchTop--; - TclResetResult(interp); + Tcl_ResetResult(interp); result = TCL_OK; TRACE(("=> catchTop=%d\n", (catchTop - initCatchTop - 1))); NEXT_INST_F(1, 0, 0); diff --git a/generic/tclInt.h b/generic/tclInt.h index 57033fa..2874a74 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.343 2007/11/12 03:38:13 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.344 2007/11/12 22:12:07 msofer Exp $ */ #ifndef _TCLINT @@ -1973,39 +1973,6 @@ typedef struct InterpList { #define INTERP_TRACE_IN_PROGRESS 0x200 #define INTERP_ALTERNATE_WRONG_ARGS 0x400 #define ERR_LEGACY_COPY 0x800 -#define INTERP_RESULT_UNCLEAN 0x1000 - -/* - * The following macro resets the interp's obj result and returns 1 if a call - * to the full Tcl_ResetResult is needed. TclResetResult macro uses it. - */ - -#define ResetObjResultM(iPtr) \ - { \ - register Tcl_Obj *objResultPtr = (iPtr)->objResultPtr; \ - \ - if (Tcl_IsShared(objResultPtr)) {\ - TclDecrRefCount(objResultPtr);\ - TclNewObj(objResultPtr);\ - Tcl_IncrRefCount(objResultPtr);\ - (iPtr)->objResultPtr = objResultPtr; \ - } else if (objResultPtr->bytes != tclEmptyStringRep) { \ - if (objResultPtr->bytes != NULL) {\ - ckfree((char *) objResultPtr->bytes); \ - }\ - objResultPtr->bytes = tclEmptyStringRep;\ - objResultPtr->length = 0;\ - TclFreeIntRep(objResultPtr);\ - objResultPtr->typePtr = NULL;\ - }\ - } - -#define TclResetResult(iPtr) \ - {\ - ResetObjResultM((Interp *)(iPtr)); \ - if (((Interp *)(iPtr))->flags & INTERP_RESULT_UNCLEAN) \ - TclCleanResult((Interp *)(iPtr)); \ - }\ /* * Maximum number of levels of nesting permitted in Tcl commands (used to @@ -2449,7 +2416,6 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); -MODULE_SCOPE void TclCleanResult(Interp *iPtr); MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information */ diff --git a/generic/tclProc.c b/generic/tclProc.c index 22333dd..c7d7004 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.137 2007/11/12 03:38:14 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.138 2007/11/12 22:12:07 msofer Exp $ */ #include "tclInt.h" @@ -2218,7 +2218,6 @@ TclUpdateReturnInfo( iPtr->flags |= ERR_LEGACY_COPY; } } - iPtr->flags |= INTERP_RESULT_UNCLEAN; return code; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 6f92950..3db3f17 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.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: tclResult.c,v 1.43 2007/11/12 03:38:14 msofer Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.44 2007/11/12 22:12:07 msofer Exp $ */ #include "tclInt.h" @@ -336,7 +336,6 @@ Tcl_RestoreResult( Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = statePtr->objResultPtr; - iPtr->flags |= INTERP_RESULT_UNCLEAN; } /* @@ -444,7 +443,6 @@ Tcl_SetResult( */ ResetObjResult(iPtr); - iPtr->flags |= INTERP_RESULT_UNCLEAN; } /* @@ -477,7 +475,6 @@ Tcl_GetStringResult( Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), TCL_VOLATILE); } - ((Interp *)interp)->flags |= INTERP_RESULT_UNCLEAN; return interp->result; } @@ -587,7 +584,6 @@ Tcl_GetObjResult( } iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; - iPtr->flags &= ~INTERP_RESULT_UNCLEAN; } return iPtr->objResultPtr; } @@ -830,7 +826,6 @@ SetupAppendBuffer( Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->appendResult; - iPtr->flags |= INTERP_RESULT_UNCLEAN; } /* @@ -871,7 +866,6 @@ Tcl_FreeResult( } ResetObjResult(iPtr); - iPtr->flags &= ~INTERP_RESULT_UNCLEAN; } /* @@ -897,17 +891,9 @@ void Tcl_ResetResult( register Tcl_Interp *interp)/* Interpreter for which to clear result. */ { - /* - * This function is defined in a macro in tclInt.h - */ - - TclResetResult((Interp *) interp); -} + register Interp *iPtr = (Interp *) interp; -void -TclCleanResult( - Interp *iPtr) -{ + ResetObjResult(iPtr); if (iPtr->freeProc != NULL) { if (iPtr->freeProc == TCL_DYNAMIC) { ckfree(iPtr->result); @@ -921,8 +907,8 @@ TclCleanResult( if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { - Tcl_ObjSetVar2((Tcl_Interp *)iPtr, iPtr->ecVar, - NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, + iPtr->errorCode, TCL_GLOBAL_ONLY); } Tcl_DecrRefCount(iPtr->errorCode); iPtr->errorCode = NULL; @@ -930,8 +916,8 @@ TclCleanResult( if (iPtr->errorInfo) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { - Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->eiVar, - NULL, iPtr->errorInfo, TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, + iPtr->errorInfo, TCL_GLOBAL_ONLY); } Tcl_DecrRefCount(iPtr->errorInfo); iPtr->errorInfo = NULL; @@ -942,7 +928,7 @@ TclCleanResult( Tcl_DecrRefCount(iPtr->returnOpts); iPtr->returnOpts = NULL; } - iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY | INTERP_RESULT_UNCLEAN); + iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY); } /* @@ -968,11 +954,22 @@ ResetObjResult( register Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { - /* - * This function is defined in a macro in tclInt.h - */ - - ResetObjResultM(iPtr); + register Tcl_Obj *objResultPtr = iPtr->objResultPtr; + + if (Tcl_IsShared(objResultPtr)) { + TclDecrRefCount(objResultPtr); + TclNewObj(objResultPtr); + Tcl_IncrRefCount(objResultPtr); + iPtr->objResultPtr = objResultPtr; + } else if (objResultPtr->bytes != tclEmptyStringRep) { + if (objResultPtr->bytes != NULL) { + ckfree((char *) objResultPtr->bytes); + } + objResultPtr->bytes = tclEmptyStringRep; + objResultPtr->length = 0; + TclFreeIntRep(objResultPtr); + objResultPtr->typePtr = NULL; + } } /* @@ -1081,7 +1078,6 @@ Tcl_SetObjErrorCode( } iPtr->errorCode = errorObjPtr; Tcl_IncrRefCount(iPtr->errorCode); - iPtr->flags |= INTERP_RESULT_UNCLEAN; } /* @@ -1209,7 +1205,6 @@ TclProcessReturn( } iPtr->returnOpts = returnOpts; Tcl_IncrRefCount(iPtr->returnOpts); - iPtr->flags |= INTERP_RESULT_UNCLEAN; } if (code == TCL_ERROR) { @@ -1239,16 +1234,14 @@ TclProcessReturn( if (valuePtr != NULL) { TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine); } - iPtr->flags |= INTERP_RESULT_UNCLEAN; } if (level != 0) { iPtr->returnLevel = level; iPtr->returnCode = code; - iPtr->flags |= INTERP_RESULT_UNCLEAN; return TCL_RETURN; } if (code == TCL_ERROR) { - iPtr->flags |= (ERR_LEGACY_COPY | INTERP_RESULT_UNCLEAN); + iPtr->flags |= ERR_LEGACY_COPY; } return code; } @@ -1409,7 +1402,6 @@ TclMergeReturnOptions( } else { *optionsPtrPtr = returnOpts; } - ((Interp *)interp)->flags |= INTERP_RESULT_UNCLEAN; return TCL_OK; error: @@ -1516,7 +1508,6 @@ Tcl_SetReturnOptions( } Tcl_DecrRefCount(options); - ((Interp *)interp)->flags |= INTERP_RESULT_UNCLEAN; return code; } diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 0ee0d4a..1d65bc8 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.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: tclStubLib.c,v 1.19 2007/11/12 03:38:14 msofer Exp $ + * RCS: @(#) $Id: tclStubLib.c,v 1.20 2007/11/12 22:12:07 msofer Exp $ */ /* @@ -50,7 +50,6 @@ HasStubSupport( interp->result = "This interpreter does not support stubs-enabled extensions."; interp->freeProc = TCL_STATIC; - ((Interp *)interp)->flags |= INTERP_RESULT_UNCLEAN; return NULL; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 76dfd12..5a6004c 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -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: tclUtil.c,v 1.90 2007/11/12 22:01:42 hobbs Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.91 2007/11/12 22:12:08 msofer Exp $ */ #include "tclInt.h" @@ -2024,7 +2024,6 @@ Tcl_DStringResult( } else { Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE); } - ((Interp *) interp)->flags |= INTERP_RESULT_UNCLEAN; dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; |