summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c452
1 files changed, 213 insertions, 239 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 0231909..0972602 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,6 +9,8 @@
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclInterp.c,v 1.105 2009/03/21 12:24:49 msofer Exp $
*/
#include "tclInt.h"
@@ -179,37 +181,6 @@ typedef struct ScriptLimitCallbackKey {
} ScriptLimitCallbackKey;
/*
- * TIP#143 limit handler internal representation.
- */
-
-struct LimitHandler {
- int flags; /* The state of this particular handler. */
- Tcl_LimitHandlerProc *handlerProc;
- /* The handler callback. */
- ClientData clientData; /* Opaque argument to the handler callback. */
- Tcl_LimitHandlerDeleteProc *deleteProc;
- /* How to delete the clientData. */
- LimitHandler *prevPtr; /* Previous item in linked list of
- * handlers. */
- LimitHandler *nextPtr; /* Next item in linked list of handlers. */
-};
-
-/*
- * Values for the LimitHandler flags field.
- * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
- * processed; handlers are never to be entered reentrantly.
- * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
- * should not normally be observed because when a handler is
- * deleted it is also spliced out of the list of handlers, but
- * even so we will be careful.
- */
-
-#define LIMIT_HANDLER_ACTIVE 0x01
-#define LIMIT_HANDLER_DELETED 0x02
-
-
-
-/*
* Prototypes for local static functions:
*/
@@ -225,6 +196,9 @@ static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
static int AliasObjCmd(ClientData dummy,
Tcl_Interp *currentInterp, int objc,
Tcl_Obj *const objv[]);
+static int AliasNRCmd(ClientData dummy,
+ Tcl_Interp *currentInterp, int objc,
+ Tcl_Obj *const objv[]);
static void AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc,
@@ -236,9 +210,6 @@ static int SlaveBgerror(Tcl_Interp *interp,
Tcl_Obj *const objv[]);
static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int safe);
-static int SlaveDebugCmd(Tcl_Interp *interp,
- Tcl_Interp *slaveInterp,
- int objc, Tcl_Obj *const objv[]);
static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
int objc, Tcl_Obj *const objv[]);
static int SlaveExpose(Tcl_Interp *interp,
@@ -588,20 +559,20 @@ Tcl_InterpObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int index;
- static const char *options[] = {
- "alias", "aliases", "bgerror", "create",
- "debug", "delete", "eval", "exists", "expose",
- "hide", "hidden", "issafe", "invokehidden",
- "limit", "marktrusted", "recursionlimit","slaves",
- "share", "target", "transfer",
+ static const char *const options[] = {
+ "alias", "aliases", "bgerror", "cancel",
+ "create", "delete", "eval", "exists",
+ "expose", "hide", "hidden", "issafe",
+ "invokehidden", "limit", "marktrusted", "recursionlimit",
+ "slaves", "share", "target", "transfer",
NULL
};
enum option {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CREATE,
- OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
- OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
- OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT, OPT_SLAVES,
- OPT_SHARE, OPT_TARGET, OPT_TRANSFER
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
+ OPT_CREATE, OPT_DELETE, OPT_EVAL, OPT_EXISTS,
+ OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
+ OPT_INVOKEHID, OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT,
+ OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER
};
if (objc < 2) {
@@ -619,7 +590,7 @@ Tcl_InterpObjCmd(
if (objc < 4) {
aliasArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
+ "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
@@ -670,11 +641,80 @@ Tcl_InterpObjCmd(
}
return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
}
+ case OPT_CANCEL: {
+ int i, flags;
+ Tcl_Interp *slaveInterp;
+ Tcl_Obj *resultObjPtr;
+ static const char *const options[] = {
+ "-unwind", "--", NULL
+ };
+ enum option {
+ OPT_UNWIND, OPT_LAST
+ };
+
+ flags = 0;
+
+ for (i = 2; i < objc; i++) {
+ if (TclGetString(objv[i])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum option) index) {
+ case OPT_UNWIND:
+ /*
+ * The evaluation stack in the target interp is to be
+ * unwound.
+ */
+ flags |= TCL_CANCEL_UNWIND;
+ break;
+ case OPT_LAST:
+ i++;
+ goto endOfForLoop;
+ }
+ }
+
+ endOfForLoop:
+
+ if ((i + 2) < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? ?--? ?path? ?result?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Did they specify a slave interp to cancel the script in
+ * progress in? If not, use the current interp.
+ */
+
+ if (i < objc) {
+ slaveInterp = GetInterp(interp, objv[i]);
+ i++;
+ } else {
+ slaveInterp = interp;
+ }
+
+ if (slaveInterp != NULL) {
+ if (i < objc) {
+ resultObjPtr = objv[i];
+ Tcl_IncrRefCount(resultObjPtr); /* Tcl_CancelEval removes this ref. */
+ i++;
+ } else {
+ resultObjPtr = NULL;
+ }
+
+ return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
+ } else {
+ return TCL_ERROR;
+ }
+ }
case OPT_CREATE: {
int i, last, safe;
Tcl_Obj *slavePtr;
char buf[16 + TCL_INTEGER_SPACE];
- static const char *options[] = {
+ static const char *const options[] = {
"-safe", "--", NULL
};
enum option {
@@ -738,23 +778,6 @@ Tcl_InterpObjCmd(
Tcl_SetObjResult(interp, slavePtr);
return TCL_OK;
}
- case OPT_DEBUG: {
- /* TIP #378 */
- Tcl_Interp *slaveInterp;
-
- /*
- * Currently only -frame supported, otherwise ?-option ?value??
- */
- if (objc < 3 || objc > 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
- return TCL_ERROR;
- }
- slaveInterp = GetInterp(interp, objv[2]);
- if (slaveInterp == NULL) {
- return TCL_ERROR;
- }
- return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
- }
case OPT_DELETE: {
int i;
InterpInfo *iiPtr;
@@ -853,7 +876,7 @@ Tcl_InterpObjCmd(
int i, index;
const char *namespaceName;
Tcl_Interp *slaveInterp;
- static const char *hiddenOptions[] = {
+ static const char *const hiddenOptions[] = {
"-global", "-namespace", "--", NULL
};
enum hiddenOption {
@@ -896,7 +919,7 @@ Tcl_InterpObjCmd(
}
case OPT_LIMIT: {
Tcl_Interp *slaveInterp;
- static const char *limitTypes[] = {
+ static const char *const limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -905,7 +928,7 @@ Tcl_InterpObjCmd(
int limitType;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
+ Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?-option value ...?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
@@ -988,7 +1011,7 @@ Tcl_InterpObjCmd(
}
chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
if (chan == NULL) {
- TclTransferResult(masterInterp, TCL_OK, interp);
+ Tcl_TransferResult(masterInterp, TCL_OK, interp);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[4]);
@@ -1003,7 +1026,7 @@ Tcl_InterpObjCmd(
*/
if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
- TclTransferResult(masterInterp, TCL_OK, interp);
+ Tcl_TransferResult(masterInterp, TCL_OK, interp);
return TCL_ERROR;
}
}
@@ -1014,7 +1037,7 @@ Tcl_InterpObjCmd(
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
- char *aliasName;
+ const char *aliasName;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path alias");
@@ -1354,7 +1377,7 @@ TclPreventAliasLoop(
* chain then we have a loop.
*/
- aliasPtr = (Alias *) cmdPtr->objClientData;
+ aliasPtr = cmdPtr->objClientData;
nextAliasPtr = aliasPtr;
while (1) {
Tcl_Obj *cmdNamePtr;
@@ -1400,7 +1423,7 @@ TclPreventAliasLoop(
if (aliasCmdPtr->objProc != AliasObjCmd) {
return TCL_OK;
}
- nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
+ nextAliasPtr = aliasCmdPtr->objClientData;
}
/* NOTREACHED */
@@ -1462,9 +1485,15 @@ AliasCreate(
Tcl_Preserve(slaveInterp);
Tcl_Preserve(masterInterp);
+ if (slaveInterp == masterInterp) {
+ aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
+ TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
+ AliasObjCmdDeleteProc);
+ } else {
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
TclGetString(namePtr), AliasObjCmd, aliasPtr,
AliasObjCmdDeleteProc);
+ }
if (TclPreventAliasLoop(interp, slaveInterp,
aliasPtr->slaveCmd) != TCL_OK) {
@@ -1507,7 +1536,7 @@ AliasCreate(
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
while (1) {
Tcl_Obj *newToken;
- char *string;
+ const char *string;
string = TclGetString(aliasPtr->token);
hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
@@ -1719,6 +1748,70 @@ AliasList(
*/
static int
+AliasNRCmd(
+ ClientData clientData, /* Alias record. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument vector. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Alias *aliasPtr = clientData;
+ int prefc, cmdc, i;
+ Tcl_Obj **prefv, **cmdv;
+ int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+ Tcl_Obj *listPtr;
+ List *listRep;
+ int flags = TCL_EVAL_INVOKE;
+
+ /*
+ * Append the arguments to the command prefix and invoke the command in
+ * the target interp's global namespace.
+ */
+
+ prefc = aliasPtr->objc;
+ prefv = &aliasPtr->objPtr;
+ cmdc = prefc + objc - 1;
+
+ listPtr = Tcl_NewListObj(cmdc, NULL);
+ listRep = listPtr->internalRep.twoPtrValue.ptr1;
+ listRep->elemCount = cmdc;
+ cmdv = &listRep->elements;
+
+ prefv = &aliasPtr->objPtr;
+ memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+ memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+
+ for (i=0; i<cmdc; i++) {
+ Tcl_IncrRefCount(cmdv[i]);
+ }
+
+ /*
+ * Use the ensemble rewriting machinery to ensure correct error messages:
+ * only the source command should show, not the full target prefix.
+ */
+
+ if (isRootEnsemble) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 1;
+ iPtr->ensembleRewrite.numInsertedObjs = prefc;
+ } else {
+ iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
+ }
+
+ /*
+ * We are sending a 0-refCount obj, do not need a callback: it will be
+ * cleaned up automatically. But we may need to clear the rootEnsemble
+ * stuff ...
+ */
+
+ if (isRootEnsemble) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ }
+ iPtr->evalFlags |= TCL_EVAL_REDIRECT;
+ return Tcl_NREvalObj(interp, listPtr, flags);
+}
+
+static int
AliasObjCmd(
ClientData clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -1804,7 +1897,7 @@ AliasObjCmd(
*/
if (targetInterp != interp) {
- TclTransferResult(targetInterp, result, interp);
+ Tcl_TransferResult(targetInterp, result, interp);
Tcl_Release(targetInterp);
}
@@ -2145,7 +2238,7 @@ SlaveCreate(
Slave *slavePtr;
InterpInfo *masterInfoPtr;
Tcl_HashEntry *hPtr;
- char *path;
+ const char *path;
int isNew, objc;
Tcl_Obj **objv;
@@ -2243,7 +2336,7 @@ SlaveCreate(
return slaveInterp;
error:
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
error2:
Tcl_DeleteInterp(slaveInterp);
@@ -2276,13 +2369,13 @@ SlaveObjCmd(
{
Tcl_Interp *slaveInterp = clientData;
int index;
- static const char *options[] = {
- "alias", "aliases", "bgerror", "debug", "eval",
+ static const char *const options[] = {
+ "alias", "aliases", "bgerror", "eval",
"expose", "hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit", NULL
};
enum options {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, OPT_EVAL,
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_EVAL,
OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT
};
@@ -2315,7 +2408,7 @@ SlaveObjCmd(
objv[3], objc - 4, objv + 4);
}
}
- Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
+ Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
return TCL_ERROR;
case OPT_ALIASES:
if (objc != 2) {
@@ -2329,16 +2422,6 @@ SlaveObjCmd(
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
- case OPT_DEBUG:
- /*
- * TIP #378 *
- * Currently only -frame supported, otherwise ?-option ?value? ...?
- */
- if (objc > 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
- return TCL_ERROR;
- }
- return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
case OPT_EVAL:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
@@ -2373,7 +2456,7 @@ SlaveObjCmd(
case OPT_INVOKEHIDDEN: {
int i, index;
const char *namespaceName;
- static const char *hiddenOptions[] = {
+ static const char *const hiddenOptions[] = {
"-global", "-namespace", "--", NULL
};
enum hiddenOption {
@@ -2411,7 +2494,7 @@ SlaveObjCmd(
objc - i, objv + i);
}
case OPT_LIMIT: {
- static const char *limitTypes[] = {
+ static const char *const limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -2420,7 +2503,7 @@ SlaveObjCmd(
int limitType;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
+ Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
@@ -2502,75 +2585,6 @@ SlaveObjCmdDeleteProc(
/*
*----------------------------------------------------------------------
*
- * SlaveDebugCmd -- TIP #378
- *
- * Helper function to handle 'debug' command in a slave interpreter.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * May modify INTERP_DEBUG flag in the slave.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SlaveDebugCmd(
- Tcl_Interp *interp, /* Interp for error return. */
- Tcl_Interp *slaveInterp, /* The slave interpreter in which command
- * will be evaluated. */
- int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
-{
- static const char *debugTypes[] = {
- "-frame", NULL
- };
- enum DebugTypes {
- DEBUG_TYPE_FRAME
- };
- int debugType;
- Interp *iPtr;
- Tcl_Obj *resultPtr;
-
- iPtr = (Interp *) slaveInterp;
- if (objc == 0) {
- resultPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewStringObj("-frame", -1));
- Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
- Tcl_SetObjResult(interp, resultPtr);
- } else {
- if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
- "debug option", 0, &debugType) != TCL_OK) {
- return TCL_ERROR;
- }
- if (debugType == DEBUG_TYPE_FRAME) {
- if (objc == 2) { /* set */
- if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
- != TCL_OK) {
- return TCL_ERROR;
- }
- /*
- * Quietly ignore attempts to disable interp debugging.
- * This is a one-way switch as frame debug info is maintained
- * in a stack that must be consistent once turned on.
- */
- if (debugType) {
- iPtr->flags |= INTERP_DEBUG_FRAME;
- }
- }
- Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
- }
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SlaveEval --
*
* Helper function to evaluate a command in a slave interpreter.
@@ -2601,21 +2615,34 @@ SlaveEval(
if (objc == 1) {
/*
* TIP #280: Make actual argument location available to eval'd script.
+ *
+ * Do not let any intReps accross, with the exception of
+ * bytecodes. The intrep spoiling is due to happen anyway when
+ * compiling.
*/
- Interp *iPtr = (Interp *) interp;
- CmdFrame* invoker = iPtr->cmdFramePtr;
- int word = 0;
+ Interp *iPtr = (Interp *) interp;
+ CmdFrame *invoker = iPtr->cmdFramePtr;
+ int word = 0;
+
+ objPtr = objv[0];
+ if (objPtr->typePtr && (objPtr->typePtr != &tclByteCodeType)
+ && objPtr->typePtr->freeIntRepProc) {
+ (void) TclGetString(objPtr);
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = NULL;
+ }
- TclArgumentGet (interp, objv[0], &invoker, &word);
- result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
+ TclArgumentGet(interp, objPtr, &invoker, &word);
+
+ result = TclEvalObjEx(slaveInterp, objPtr, 0, invoker, word);
} else {
objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
Tcl_DecrRefCount(objPtr);
}
- TclTransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(slaveInterp, result, interp);
Tcl_Release(slaveInterp);
return result;
@@ -2645,7 +2672,7 @@ SlaveExpose(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
- char *name;
+ const char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2657,7 +2684,7 @@ SlaveExpose(
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
name) != TCL_OK) {
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2744,7 +2771,7 @@ SlaveHide(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
- char *name;
+ const char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2755,7 +2782,7 @@ SlaveHide(
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
- TclTransferResult(slaveInterp, TCL_ERROR, interp);
+ Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2849,11 +2876,11 @@ SlaveInvokeHidden(
| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if (result == TCL_OK) {
result = TclObjInvokeNamespace(slaveInterp, objc, objv,
- (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
+ (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
}
}
- TclTransferResult(slaveInterp, result, interp);
+ Tcl_TransferResult(slaveInterp, result, interp);
Tcl_Release(slaveInterp);
return result;
@@ -2945,26 +2972,9 @@ Tcl_MakeSafe(
{
Tcl_Channel chan; /* Channel to remove from safe interpreter. */
Interp *iPtr = (Interp *) interp;
- Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;
TclHideUnsafeCommands(interp);
- if (master != NULL) {
- /*
- * Alias these function implementations in the slave to those in the
- * master; the overall implementations are safe, but they're normally
- * defined by init.tcl which is not sourced by safe interpreters.
- * Assume these functions all work. [Bug 2895741]
- */
-
- (void) Tcl_Eval(interp,
- "namespace eval ::tcl {namespace eval mathfunc {}}");
- (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
- "::tcl::mathfunc::min", 0, NULL);
- (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
- "::tcl::mathfunc::max", 0, NULL);
- }
-
iPtr->flags |= SAFE_INTERP;
/*
@@ -3220,7 +3230,7 @@ RunLimitHandlers(
*/
handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
- (handlerPtr->handlerProc)(handlerPtr->clientData, interp);
+ handlerPtr->handlerProc(handlerPtr->clientData, interp);
handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;
/*
@@ -3241,7 +3251,7 @@ RunLimitHandlers(
if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
ckfree((char *) handlerPtr);
}
@@ -3407,7 +3417,7 @@ Tcl_LimitRemoveHandler(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
ckfree((char *) handlerPtr);
}
@@ -3467,7 +3477,7 @@ TclLimitRemoveAllHandlers(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
ckfree((char *) handlerPtr);
}
@@ -3500,7 +3510,7 @@ TclLimitRemoveAllHandlers(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- (handlerPtr->deleteProc)(handlerPtr->clientData);
+ handlerPtr->deleteProc(handlerPtr->clientData);
}
ckfree((char *) handlerPtr);
}
@@ -3748,24 +3758,14 @@ TimeLimitCallback(
ClientData clientData)
{
Tcl_Interp *interp = clientData;
- Interp *iPtr = clientData;
int code;
Tcl_Preserve(interp);
- iPtr->limit.timeEvent = NULL;
-
- /*
- * Must reset the granularity ticker here to force an immediate full
- * check. This is OK because we're swallowing the cost in the overall cost
- * of the event loop. [Bug 2891362]
- */
-
- iPtr->limit.granularityTicker = 0;
-
+ ((Interp *) interp)->limit.timeEvent = NULL;
code = Tcl_LimitCheck(interp);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (while waiting for event)");
- TclBackgroundException(interp, code);
+ Tcl_BackgroundException(interp, code);
}
Tcl_Release(interp);
}
@@ -3933,7 +3933,7 @@ CallScriptLimitCallback(
code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
TCL_EVAL_GLOBAL);
if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
- TclBackgroundException(limitCBPtr->interp, code);
+ Tcl_BackgroundException(limitCBPtr->interp, code);
}
Tcl_Release(limitCBPtr->interp);
}
@@ -4152,7 +4152,7 @@ SlaveCommandLimitCmd(
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *options[] = {
+ static const char *const options[] = {
"-command", "-granularity", "-value", NULL
};
enum Options {
@@ -4164,19 +4164,6 @@ SlaveCommandLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
- /*
- * First, ensure that we are not reading or writing the calling
- * interpreter's limits; it may only manipulate its children. Note that
- * the low level API enforces this with Tcl_Panic, which we want to
- * avoid. [Bug 3398794]
- */
-
- if (interp == slaveInterp) {
- Tcl_AppendResult(interp,
- "limits on current interpreter inaccessible", NULL);
- return TCL_ERROR;
- }
-
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4247,7 +4234,7 @@ SlaveCommandLimitCmd(
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option? ?value? ?-option value ...?");
+ "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, limitLen = 0;
@@ -4336,7 +4323,7 @@ SlaveTimeLimitCmd(
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *options[] = {
+ static const char *const options[] = {
"-command", "-granularity", "-milliseconds", "-seconds", NULL
};
enum Options {
@@ -4348,19 +4335,6 @@ SlaveTimeLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
- /*
- * First, ensure that we are not reading or writing the calling
- * interpreter's limits; it may only manipulate its children. Note that
- * the low level API enforces this with Tcl_Panic, which we want to
- * avoid. [Bug 3398794]
- */
-
- if (interp == slaveInterp) {
- Tcl_AppendResult(interp,
- "limits on current interpreter inaccessible", NULL);
- return TCL_ERROR;
- }
-
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4448,7 +4422,7 @@ SlaveTimeLimitCmd(
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
Tcl_WrongNumArgs(interp, consumedObjc, objv,
- "?-option? ?value? ?-option value ...?");
+ "?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, milliLen = 0, secLen = 0;
generated by cgit v0.12 at 2025-05-01 08:09:25 (GMT)