diff options
author | mig <mig@noemail.net> | 2011-03-01 19:54:54 (GMT) |
---|---|---|
committer | mig <mig@noemail.net> | 2011-03-01 19:54:54 (GMT) |
commit | 028adb6a7c576043d323b1239bb9e4f9cf96a80f (patch) | |
tree | de9c73c4a60bfd332bded0a6a1e50acb0c703d96 /generic/tclInterp.c | |
parent | 5c15a95a0f760da1cce47d5a64d58cfa5ac7edb9 (diff) | |
download | tcl-028adb6a7c576043d323b1239bb9e4f9cf96a80f.zip tcl-028adb6a7c576043d323b1239bb9e4f9cf96a80f.tar.gz tcl-028adb6a7c576043d323b1239bb9e4f9cf96a80f.tar.bz2 |
This is [Patch 3168398], Joe Mistachkin's optimisation of Tip #285
FossilOrigin-Name: 40089e043b001a989b0496c8e787e66264141512
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r-- | generic/tclInterp.c | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 6ccde87..bfcc383 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2096,6 +2096,72 @@ Tcl_GetMaster( /* *---------------------------------------------------------------------- * + * TclSetSlaveCancelFlags -- + * + * This function marks all slave interpreters belonging to a given + * interpreter as being canceled or not canceled, depending on the + * provided flags. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclSetSlaveCancelFlags( + Tcl_Interp *interp, /* Set cancel flags of this interpreter. */ + int flags, /* Collection of OR-ed bits that control + * the cancellation of the script. Only + * TCL_CANCEL_UNWIND is currently + * supported. */ + int force) /* Non-zero to ignore numLevels for the purpose + * of resetting the cancellation flags. */ +{ + Master *masterPtr; /* Master record of given interpreter. */ + Tcl_HashEntry *hPtr; /* Search element. */ + Tcl_HashSearch hashSearch; /* Search variable. */ + Slave *slavePtr; /* Slave record of interpreter. */ + Interp *iPtr; + + if (interp == NULL) { + return; + } + + flags &= (CANCELED | TCL_CANCEL_UNWIND); + + masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master; + + hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch); + for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { + slavePtr = Tcl_GetHashValue(hPtr); + iPtr = (Interp *) slavePtr->slaveInterp; + + if (iPtr == NULL) { + continue; + } + + if (flags == 0) { + TclResetCancellation((Tcl_Interp *) iPtr, force); + } else { + TclSetCancelFlags(iPtr, flags); + } + + /* + * Now, recursively handle this for the slaves of this slave + * interpreter. + */ + + TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force); + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetInterpPath -- * * Sets the result of the asking interpreter to a proper Tcl list @@ -2717,6 +2783,16 @@ SlaveEval( { int result; + /* + * TIP #285: If necessary, reset the cancellation flags for the slave + * interpreter now; otherwise, canceling a script in a master interpreter + * can result in a situation where a slave interpreter can no longer + * evaluate any scripts unless somebody calls the TclResetCancellation + * function for that particular Tcl_Interp. + */ + + TclSetSlaveCancelFlags(slaveInterp, 0, 0); + Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); |