diff options
| -rw-r--r-- | ChangeLog | 52 | ||||
| -rw-r--r-- | generic/tclBasic.c | 95 |
2 files changed, 97 insertions, 50 deletions
@@ -1,22 +1,29 @@ +2006-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * generic/tclBasic.c (TclEvalObjvInternal): Rewrote so that comments + are relevant and informative once more. Also made the unknown handler + processing use the Tcl execution stack for working space, and not the + general heap. + 2006-11-01 Daniel Steffen <das@users.sourceforge.net> * unix/tclUnixPort.h: ensure MODULE_SCOPE is defined before use, so that tclPort.h can once again be included without tclInt.h. - * generic/tclEnv.c (Darwin): mark _environ symbol as unexported - even when MODULE_SCOPE != __private_extern__. + * generic/tclEnv.c (Darwin): mark _environ symbol as unexported even + when MODULE_SCOPE != __private_extern__. 2006-10-31 Don Porter <dgp@users.sourceforge.net> * generic/tclBasic.c: Refactored and renamed the routines * generic/tclCkalloc.c: TclObjPrintf, TclFormatObj, and - * generic/tclCmdAH.c: TclFormatToErrorInfo to a new set of - * generic/tclCmdIL.c: routines TclAppendPrintfToObj, - * generic/tclCmdMZ.c: TclAppendFormatToObj, TclObjPrintf, and - * generic/tclDictObj.c: TclObjFormat, with the intent of making - * generic/tclExecute.c: the latter list, plus TclAppendLimitedToObj - * generic/tclIORChan.c: and TclAppendObjToErrorInfo, public via - * generic/tclIOUtil.c: a revised TIP 270. + * generic/tclCmdAH.c: TclFormatToErrorInfo to a new set of routines + * generic/tclCmdIL.c: TclAppendPrintfToObj, TclAppendFormatToObj, + * generic/tclCmdMZ.c: TclObjPrintf, and TclObjFormat, with the + * generic/tclDictObj.c: intent of making the latter list, plus + * generic/tclExecute.c: TclAppendLimitedToObj and + * generic/tclIORChan.c: TclAppendObjToErrorInfo, public via a revised + * generic/tclIOUtil.c: TIP 270. * generic/tclInt.h: * generic/tclMain.c: * generic/tclNamesp.c: @@ -30,13 +37,11 @@ 2006-10-31 Miguel Sofer <msofer@users.sf.net> - * generic/tclBasic.c: - * generic/tcl.h: - * generic/tclInterp.c: - * generic/tclNamesp.c: removing the flag bit TCL_EVAL_NOREWRITE, - the last remnant of the callObjc/v fiasco. It is not needed, as it - is now always set and checked or'ed with TCL_EVAL_INVOKE. - + * generic/tclBasic.c, generic/tcl.h, generic/tclInterp.c: + * generic/tclNamesp.c: removing the flag bit TCL_EVAL_NOREWRITE, the + last remnant of the callObjc/v fiasco. It is not needed, as it is now + always set and checked or'ed with TCL_EVAL_INVOKE. + 2006-10-31 Pat Thoyts <patthoyts@users.sourceforge.net> * win/rules.vc: Fix for bug #1582769 - options conflict with VC2003. @@ -67,7 +72,7 @@ * generic/tclBasic.c (TEOVI): insured that the interp's callObjc/v fields are restored after traces run, as they be spoiled. This was causing a segfault in tcllib's profiler tests. - + 2006-10-30 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c (INST_MOD): Corrected improper testing of the @@ -177,7 +182,7 @@ * README: Bump version number to 8.5a6 * generic/tcl.h: - * library init.tcl: + * library/init.tcl: * tools/tcl.wse.in: * unix/configure.in: * unix/tcl.spec: @@ -189,12 +194,11 @@ 2006-10-21 Miguel Sofer <msofer@users.sf.net> - * generic/tcl.h: - * generic/tclHash.c: Tcl_FindHashEntry now calls Tcl_CreateHashEntry - with a newPtr set to NULL: this would have caused a segfault - previously and eliminates duplicated code. A macro has been added to - tcl.h (only used when TCL_PRESERVE_BINARY_COMPATABALITY is not set - - ie, not by default). + * generic/tcl.h, generic/tclHash.c: Tcl_FindHashEntry now calls + Tcl_CreateHashEntry with a newPtr set to NULL: this would have caused + a segfault previously and eliminates duplicated code. A macro has been + added to tcl.h (only used when TCL_PRESERVE_BINARY_COMPATABALITY is + not set - i.e., not by default). 2006-10-20 Reinhard Max <max@tclers.tk> diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2ef6a8d..0518d72 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.209 2006/10/31 20:19:44 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.210 2006/11/02 09:42:07 dkf Exp $ */ #include "tclInt.h" @@ -3271,9 +3271,8 @@ TclEvalObjvInternal( CallFrame *savedVarFramePtr = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; int code = TCL_OK; - int traceCode = TCL_OK; + int traceCode = TCL_OK; int checkTraces = 1; - int cmdEpoch; Namespace *savedNsPtr = NULL; if (TclInterpReady(interp) == TCL_ERROR) { @@ -3291,7 +3290,7 @@ TclEvalObjvInternal( if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)) { varFramePtr = iPtr->rootFramePtr; savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = varFramePtr; + iPtr->varFramePtr = varFramePtr; } else if (flags & TCL_EVAL_INVOKE) { savedNsPtr = varFramePtr->nsPtr; if (iPtr->lookupNsPtr) { @@ -3329,25 +3328,49 @@ TclEvalObjvInternal( Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer"); } } + + /* + * Check to see if the resolution namespace has lost its unknown + * handler. If so, reset it to "::unknown". + */ + if (currNsPtr->unknownHandlerPtr == NULL) { - /* Global namespace has lost unknown handler, reset. */ currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1); Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr); } + + /* + * Get the list of words for the unknown handler and allocate enough + * space to hold both the handler prefix and all words of the command + * invokation itself. + */ + Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = (Tcl_Obj **) ckalloc((unsigned) - (newObjc * sizeof(Tcl_Obj *))); - /* Copy command prefix from unknown handler. */ + newObjv = (Tcl_Obj **) TclStackAlloc(interp, + sizeof(Tcl_Obj *) * (unsigned)newObjc); + + /* + * Copy command prefix from unknown handler and add on the real + * command's full argument list. Note that we only use memcpy() once + * because we have to increment the reference count of all the handler + * arguments anyway. + */ + for (i = 0; i < handlerObjc; ++i) { newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - /* Add in command name and arguments. */ - for (i = objc-1; i >= 0; --i) { - newObjv[i+handlerObjc] = objv[i]; - } + memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc); + + /* + * Look up and invoke the handler (by recursive call to this + * function). If there is no handler at all, instead of doing the + * recursive call we just generate a generic error message; it would + * be an infinite-recursion nightmare otherwise. + */ + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); if (cmdPtr == NULL) { Tcl_AppendResult(interp, "invalid command name \"", @@ -3356,13 +3379,19 @@ TclEvalObjvInternal( } else { iPtr->numLevels++; code = TclEvalObjvInternal(interp, newObjc, newObjv, command, - length, 0); + length, 0); iPtr->numLevels--; } + + /* + * Release any resources we locked and allocated during the handler + * call. + */ + for (i = 0; i < handlerObjc; ++i) { Tcl_DecrRefCount(newObjv[i]); } - ckfree((char *) newObjv); + TclStackFree(interp); if (savedNsPtr) { varFramePtr->nsPtr = savedNsPtr; iPtr->lookupNsPtr = NULL; @@ -3373,21 +3402,21 @@ TclEvalObjvInternal( varFramePtr->nsPtr = savedNsPtr; iPtr->lookupNsPtr = NULL; } - + /* * Call trace functions if needed. */ - cmdEpoch = cmdPtr->cmdEpoch; if (checkTraces && (command != NULL)) { - cmdPtr->refCount++; + int cmdEpoch = cmdPtr->cmdEpoch; /* - * If the first set of traces modifies/deletes the command or any - * existing traces, then the set checkTraces to 0 and go through this - * while loop one more time. + * Execute any command or execution traces. Note that we bump up the + * command's reference count for the duration of the calling of the + * traces so that the structure doesn't go away underneath our feet. */ + cmdPtr->refCount++; if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); @@ -3397,11 +3426,19 @@ TclEvalObjvInternal( cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } cmdPtr->refCount--; - } - if (cmdEpoch != cmdPtr->cmdEpoch) { - /* The command has been modified in some way. */ - checkTraces = 0; - goto reparseBecauseOfTraces; + + /* + * If the traces modified/deleted the command or any existing traces, + * they will update the command's epoch. When that happens, set + * checkTraces is set to 0 to prevent the re-calling of traces (and + * any possible infinite loop) and we go back to re-find the command + * implementation. + */ + + if (cmdEpoch != cmdPtr->cmdEpoch) { + checkTraces = 0; + goto reparseBecauseOfTraces; + } } /* @@ -3438,6 +3475,12 @@ TclEvalObjvInternal( cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); } } + + /* + * Decrement the reference count of cmdPtr and deallocate it if it has + * dropped to zero. + */ + TclCleanupCommand(cmdPtr); /* @@ -3461,7 +3504,7 @@ TclEvalObjvInternal( (void) Tcl_GetObjResult(interp); } - done: + done: if (savedVarFramePtr) { iPtr->varFramePtr = savedVarFramePtr; } |