diff options
Diffstat (limited to 'generic/tclInterp.c')
| -rw-r--r-- | generic/tclInterp.c | 846 |
1 files changed, 319 insertions, 527 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 424aafe..dbbf10a 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -19,7 +19,7 @@ * above. This variable can be modified by the function below. */ -static const char *tclPreInitScript = NULL; +static char *tclPreInitScript = NULL; /* Forward declaration */ struct Target; @@ -51,7 +51,7 @@ typedef struct Alias { * used in the master interpreter to map back * from the target command to aliases * redirecting to it. */ - size_t objc; /* Count of Tcl_Obj in the prefix of the + int objc; /* Count of Tcl_Obj in the prefix of the * target command to be invoked in the target * interpreter. Additional arguments specified * when calling the alias in the slave interp @@ -179,60 +179,93 @@ 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: */ static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp, - Tcl_Obj *namePtr, Tcl_Obj *targetPtr, size_t objc, + Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc, Tcl_Obj *const objv[]); static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *slaveInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static Tcl_ObjCmdProc AliasObjCmd; -static Tcl_ObjCmdProc AliasNRCmd; +static int AliasObjCmd(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, size_t objc, +static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void InterpInfoDeleteProc(ClientData clientData, Tcl_Interp *interp); static int SlaveBgerror(Tcl_Interp *interp, - Tcl_Interp *slaveInterp, size_t objc, + Tcl_Interp *slaveInterp, int objc, 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, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveExpose(Tcl_Interp *interp, - Tcl_Interp *slaveInterp, size_t objc, + Tcl_Interp *slaveInterp, int objc, Tcl_Obj *const objv[]); static int SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveHidden(Tcl_Interp *interp, Tcl_Interp *slaveInterp); static int SlaveInvokeHidden(Tcl_Interp *interp, Tcl_Interp *slaveInterp, const char *namespaceName, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int SlaveMarkTrusted(Tcl_Interp *interp, Tcl_Interp *slaveInterp); -static Tcl_ObjCmdProc SlaveObjCmd; +static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static void SlaveObjCmdDeleteProc(ClientData clientData); static int SlaveRecursionLimit(Tcl_Interp *interp, - Tcl_Interp *slaveInterp, size_t objc, + Tcl_Interp *slaveInterp, int objc, Tcl_Obj *const objv[]); static int SlaveCommandLimitCmd(Tcl_Interp *interp, - Tcl_Interp *slaveInterp, size_t consumedObjc, - size_t objc, Tcl_Obj *const objv[]); + Tcl_Interp *slaveInterp, int consumedObjc, + int objc, Tcl_Obj *const objv[]); static int SlaveTimeLimitCmd(Tcl_Interp *interp, - Tcl_Interp *slaveInterp, size_t consumedObjc, - size_t objc, Tcl_Obj *const objv[]); + Tcl_Interp *slaveInterp, int consumedObjc, + int objc, Tcl_Obj *const objv[]); static void InheritLimitsFromMaster(Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp); static void SetScriptLimitCallback(Tcl_Interp *interp, int type, @@ -261,11 +294,11 @@ static void TimeLimitCallback(ClientData clientData); *---------------------------------------------------------------------- */ -const char * +char * TclSetPreInitScript( - const char *string) /* Pointer to a script. */ + char *string) /* Pointer to a script. */ { - const char *prevString = tclPreInitScript; + char *prevString = tclPreInitScript; tclPreInitScript = string; return(prevString); } @@ -295,8 +328,8 @@ Tcl_Init( { if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { - return TCL_ERROR; - } + return (TCL_ERROR); + }; } /* @@ -431,7 +464,7 @@ TclInterpInit( Master *masterPtr; Slave *slavePtr; - interpInfoPtr = ckalloc(sizeof(InterpInfo)); + interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo)); ((Interp *) interp)->interpInfo = interpInfoPtr; masterPtr = &interpInfoPtr->master; @@ -527,7 +560,7 @@ InterpInfoDeleteProc( } Tcl_DeleteHashTable(&slavePtr->aliasTable); - ckfree(interpInfoPtr); + ckfree((char *) interpInfoPtr); } /* @@ -549,29 +582,26 @@ InterpInfoDeleteProc( /* ARGSUSED */ int Tcl_InterpObjCmd( - ClientData clientData, /* Unused. */ - Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + ClientData clientData, /* Unused. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Interp *slaveInterp; int index; - static const char *const options[] = { - "alias", "aliases", "bgerror", "cancel", - "create", "debug", "delete", - "eval", "exists", "expose", - "hide", "hidden", "issafe", - "invokehidden", "limit", "marktrusted", "recursionlimit", - "slaves", "share", "target", "transfer", + static const char *options[] = { + "alias", "aliases", "bgerror", "create", + "debug", "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_CANCEL, - 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_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 }; if (objc < 2) { @@ -584,12 +614,12 @@ Tcl_InterpObjCmd( } switch ((enum option) index) { case OPT_ALIAS: { - Tcl_Interp *masterInterp; + Tcl_Interp *slaveInterp, *masterInterp; if (objc < 4) { aliasArgs: Tcl_WrongNumArgs(interp, 2, objv, - "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?"); + "slavePath slaveCmd ?masterPath masterCmd? ?args ..?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); @@ -618,13 +648,18 @@ Tcl_InterpObjCmd( } goto aliasArgs; } - case OPT_ALIASES: + case OPT_ALIASES: { + Tcl_Interp *slaveInterp; + slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return AliasList(interp, slaveInterp); - case OPT_BGERROR: + } + case OPT_BGERROR: { + Tcl_Interp *slaveInterp; + if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?"); return TCL_ERROR; @@ -634,83 +669,12 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3); - case OPT_CANCEL: { - int i, flags; - Tcl_Obj *resultObjPtr; - static const char *const cancelOptions[] = { - "-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], cancelOptions, "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]); - if (slaveInterp == NULL) { - return TCL_ERROR; - } - i++; - } else { - slaveInterp = interp; - } - - if (i < objc) { - resultObjPtr = objv[i]; - - /* - * Tcl_CancelEval removes this reference. - */ - - Tcl_IncrRefCount(resultObjPtr); - i++; - } else { - resultObjPtr = NULL; - } - - return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { int i, last, safe; Tcl_Obj *slavePtr; char buf[16 + TCL_INTEGER_SPACE]; - static const char *const createOptions[] = { + static const char *options[] = { "-safe", "--", NULL }; enum option { @@ -727,8 +691,8 @@ Tcl_InterpObjCmd( last = 0; for (i = 2; i < objc; i++) { if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) { - if (Tcl_GetIndexFromObj(interp, objv[i], createOptions, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } if (index == OPT_SAFE) { @@ -763,7 +727,7 @@ Tcl_InterpObjCmd( break; } } - slavePtr = Tcl_NewStringObj(buf, TCL_STRLEN); + slavePtr = Tcl_NewStringObj(buf, -1); } if (SlaveCreate(interp, slavePtr, safe) == NULL) { if (buf[0] != '\0') { @@ -774,11 +738,13 @@ Tcl_InterpObjCmd( Tcl_SetObjResult(interp, slavePtr); return TCL_OK; } - case OPT_DEBUG: /* TIP #378 */ + 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; @@ -788,9 +754,11 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3); + } case OPT_DELETE: { int i; InterpInfo *iiPtr; + Tcl_Interp *slaveInterp; for (i = 2; i < objc; i++) { slaveInterp = GetInterp(interp, objv[i]); @@ -798,9 +766,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } else if (slaveInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot delete the current interpreter", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "DELETESELF", NULL); + "cannot delete the current interpreter", -1)); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; @@ -809,7 +775,9 @@ Tcl_InterpObjCmd( } return TCL_OK; } - case OPT_EVAL: + case OPT_EVAL: { + Tcl_Interp *slaveInterp; + if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?"); return TCL_ERROR; @@ -819,9 +787,12 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveEval(interp, slaveInterp, objc - 3, objv + 3); + } case OPT_EXISTS: { - int exists = 1; + int exists; + Tcl_Interp *slaveInterp; + exists = 1; slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { if (objc > 3) { @@ -833,7 +804,9 @@ Tcl_InterpObjCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists)); return TCL_OK; } - case OPT_EXPOSE: + case OPT_EXPOSE: { + Tcl_Interp *slaveInterp; + if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?"); return TCL_ERROR; @@ -843,7 +816,10 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3); - case OPT_HIDE: + } + case OPT_HIDE: { + Tcl_Interp *slaveInterp; /* A slave. */ + if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?"); return TCL_ERROR; @@ -853,23 +829,31 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveHide(interp, slaveInterp, objc - 3, objv + 3); - case OPT_HIDDEN: + } + case OPT_HIDDEN: { + Tcl_Interp *slaveInterp; /* A slave. */ + slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveHidden(interp, slaveInterp); - case OPT_ISSAFE: + } + case OPT_ISSAFE: { + Tcl_Interp *slaveInterp; + slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; + } case OPT_INVOKEHID: { - int i; + int i, index; const char *namespaceName; - static const char *const hiddenOptions[] = { + Tcl_Interp *slaveInterp; + static const char *hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { @@ -911,7 +895,8 @@ Tcl_InterpObjCmd( objv + i); } case OPT_LIMIT: { - static const char *const limitTypes[] = { + Tcl_Interp *slaveInterp; + static const char *limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { @@ -920,8 +905,7 @@ Tcl_InterpObjCmd( int limitType; if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "path limitType ?-option value ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?"); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[2]); @@ -939,7 +923,9 @@ Tcl_InterpObjCmd( return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv); } } - case OPT_MARKTRUSTED: + case OPT_MARKTRUSTED: { + Tcl_Interp *slaveInterp; + if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; @@ -949,7 +935,10 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveMarkTrusted(interp, slaveInterp); - case OPT_RECLIMIT: + } + case OPT_RECLIMIT: { + Tcl_Interp *slaveInterp; + if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?"); return TCL_ERROR; @@ -959,7 +948,9 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3); + } case OPT_SLAVES: { + Tcl_Interp *slaveInterp; InterpInfo *iiPtr; Tcl_Obj *resultPtr; Tcl_HashEntry *hPtr; @@ -976,14 +967,15 @@ Tcl_InterpObjCmd( for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr); Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewStringObj(string, TCL_STRLEN)); + Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } case OPT_TRANSFER: case OPT_SHARE: { - Tcl_Interp *masterInterp; /* The master of the slave. */ + Tcl_Interp *slaveInterp; /* A slave. */ + Tcl_Interp *masterInterp; /* Its master. */ Tcl_Channel chan; if (objc != 5) { @@ -996,7 +988,7 @@ Tcl_InterpObjCmd( } chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL); if (chan == NULL) { - Tcl_TransferResult(masterInterp, TCL_OK, interp); + TclTransferResult(masterInterp, TCL_OK, interp); return TCL_ERROR; } slaveInterp = GetInterp(interp, objv[4]); @@ -1011,17 +1003,18 @@ Tcl_InterpObjCmd( */ if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) { - Tcl_TransferResult(masterInterp, TCL_OK, interp); + TclTransferResult(masterInterp, TCL_OK, interp); return TCL_ERROR; } } return TCL_OK; } case OPT_TARGET: { + Tcl_Interp *slaveInterp; InterpInfo *iiPtr; Tcl_HashEntry *hPtr; Alias *aliasPtr; - const char *aliasName; + char *aliasName; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path alias"); @@ -1038,20 +1031,18 @@ Tcl_InterpObjCmd( iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" in path \"%s\" not found", - aliasName, Tcl_GetString(objv[2]))); + Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"", + Tcl_GetString(objv[2]), "\" not found", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } aliasPtr = Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "target interpreter for alias \"%s\" in path \"%s\" is " - "not my descendant", aliasName, Tcl_GetString(objv[2]))); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "TARGETSHROUDED", NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "target interpreter for alias \"", + aliasName, "\" in path \"", Tcl_GetString(objv[2]), + "\" is not my descendant", NULL); return TCL_ERROR; } return TCL_OK; @@ -1085,7 +1076,7 @@ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { @@ -1120,24 +1111,25 @@ Tcl_CreateAlias( const char *slaveCmd, /* Command to install in slave. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - size_t argc, /* How many additional arguments? */ + int argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; Tcl_Obj **objv; - size_t i; + int i; int result; - objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc); + objv = (Tcl_Obj **) + TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc); for (i = 0; i < argc; i++) { - objv[i] = Tcl_NewStringObj(argv[i], TCL_STRLEN); + objv[i] = Tcl_NewStringObj(argv[i], -1); Tcl_IncrRefCount(objv[i]); } - slaveObjPtr = Tcl_NewStringObj(slaveCmd, TCL_STRLEN); + slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1); Tcl_IncrRefCount(slaveObjPtr); - targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_STRLEN); + targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr, @@ -1175,16 +1167,16 @@ Tcl_CreateAliasObj( const char *slaveCmd, /* Command to install in slave. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - size_t objc, /* How many additional arguments? */ + int objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; int result; - slaveObjPtr = Tcl_NewStringObj(slaveCmd, TCL_STRLEN); + slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1); Tcl_IncrRefCount(slaveObjPtr); - targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_STRLEN); + targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr, @@ -1218,19 +1210,18 @@ Tcl_GetAlias( Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetNamePtr, /* (Return) name of target command. */ - size_t *argcPtr, /* (Return) count of addnl args. */ + int *argcPtr, /* (Return) count of addnl args. */ const char ***argvPtr) /* (Return) additional arguments. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; - size_t i, objc; + int i, objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", aliasName)); + Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } @@ -1249,7 +1240,7 @@ Tcl_GetAlias( } if (argvPtr != NULL) { *argvPtr = (const char **) - ckalloc(sizeof(const char *) * (objc - 1)); + ckalloc((unsigned) sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { (*argvPtr)[i - 1] = TclGetString(objv[i]); } @@ -1280,19 +1271,18 @@ Tcl_GetAliasObj( Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetNamePtr, /* (Return) name of target command. */ - size_t *objcPtr, /* (Return) count of addnl args. */ + int *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; - size_t objc; + int objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", aliasName)); + Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL); return TCL_ERROR; } @@ -1364,7 +1354,7 @@ TclPreventAliasLoop( * chain then we have a loop. */ - aliasPtr = cmdPtr->objClientData; + aliasPtr = (Alias *) cmdPtr->objClientData; nextAliasPtr = aliasPtr; while (1) { Tcl_Obj *cmdNamePtr; @@ -1380,9 +1370,9 @@ TclPreventAliasLoop( * [Bug #641195] */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot define or rename alias \"%s\": interpreter deleted", - Tcl_GetCommandName(cmdInterp, cmd))); + Tcl_AppendResult(interp, "cannot define or rename alias \"", + Tcl_GetCommandName(cmdInterp, cmd), + "\": interpreter deleted", NULL); return TCL_ERROR; } cmdNamePtr = nextAliasPtr->objPtr; @@ -1395,11 +1385,9 @@ TclPreventAliasLoop( } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot define or rename alias \"%s\": would create a loop", - Tcl_GetCommandName(cmdInterp, cmd))); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "ALIASLOOP", NULL); + Tcl_AppendResult(interp, "cannot define or rename alias \"", + Tcl_GetCommandName(cmdInterp, cmd), + "\": would create a loop", NULL); return TCL_ERROR; } @@ -1412,7 +1400,7 @@ TclPreventAliasLoop( if (aliasCmdPtr->objProc != AliasObjCmd) { return TCL_OK; } - nextAliasPtr = aliasCmdPtr->objClientData; + nextAliasPtr = (Alias *) aliasCmdPtr->objClientData; } /* NOTREACHED */ @@ -1444,7 +1432,7 @@ AliasCreate( * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetNamePtr, /* Name of target cmd. */ - size_t objc, /* Additional arguments to store */ + int objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; @@ -1455,7 +1443,8 @@ AliasCreate( Tcl_Obj **prefv; int isNew, i; - aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); + aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) + + objc * sizeof(Tcl_Obj *))); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = masterInterp; @@ -1473,15 +1462,9 @@ 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) { @@ -1506,7 +1489,7 @@ AliasCreate( cmdPtr->deleteData = NULL; Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd); - ckfree(aliasPtr); + ckfree((char *) aliasPtr); /* * The result was already set by TclPreventAliasLoop. @@ -1524,7 +1507,7 @@ AliasCreate( slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; while (1) { Tcl_Obj *newToken; - const char *string; + char *string; string = TclGetString(aliasPtr->token); hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew); @@ -1563,11 +1546,11 @@ AliasCreate( * interp alias {} foo {} zop # Now recreate "foo"... */ - targetPtr = ckalloc(sizeof(Target)); + targetPtr = (Target *) ckalloc((unsigned) sizeof(Target)); targetPtr->slaveCmd = aliasPtr->slaveCmd; targetPtr->slaveInterp = slaveInterp; - masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master; + masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master; targetPtr->nextPtr = masterPtr->targetsPtr; targetPtr->prevPtr = NULL; if (masterPtr->targetsPtr != NULL) { @@ -1618,8 +1601,8 @@ AliasDelete( slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", TclGetString(namePtr))); + Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr), + "\" not found", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", TclGetString(namePtr), NULL); return TCL_ERROR; @@ -1736,74 +1719,10 @@ AliasList( */ static int -AliasNRCmd( - ClientData clientData, /* Alias record. */ - Tcl_Interp *interp, /* Current interpreter. */ - size_t 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) { - TclNRDeferCallback(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. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 @@ -1826,10 +1745,9 @@ AliasObjCmd( if (cmdc <= ALIAS_CMDV_PREALLOC) { cmdv = cmdArr; } else { - cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); + cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*)); } - prefv = &aliasPtr->objPtr; memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *))); memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *))); @@ -1885,7 +1803,7 @@ AliasObjCmd( */ if (targetInterp != interp) { - Tcl_TransferResult(targetInterp, result, interp); + TclTransferResult(targetInterp, result, interp); Tcl_Release(targetInterp); } @@ -1950,8 +1868,8 @@ AliasObjCmdDeleteProc( targetPtr->nextPtr->prevPtr = targetPtr->prevPtr; } - ckfree(targetPtr); - ckfree(aliasPtr); + ckfree((char *) targetPtr); + ckfree((char *) aliasPtr); } /* @@ -1986,7 +1904,7 @@ Tcl_CreateSlave( Tcl_Obj *pathPtr; Tcl_Interp *slaveInterp; - pathPtr = Tcl_NewStringObj(slavePath, TCL_STRLEN); + pathPtr = Tcl_NewStringObj(slavePath, -1); slaveInterp = SlaveCreate(interp, pathPtr, isSafe); Tcl_DecrRefCount(pathPtr); @@ -2017,7 +1935,7 @@ Tcl_GetSlave( Tcl_Obj *pathPtr; Tcl_Interp *slaveInterp; - pathPtr = Tcl_NewStringObj(slavePath, TCL_STRLEN); + pathPtr = Tcl_NewStringObj(slavePath, -1); slaveInterp = GetInterp(interp, pathPtr); Tcl_DecrRefCount(pathPtr); @@ -2056,72 +1974,6 @@ 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 @@ -2151,19 +2003,17 @@ Tcl_GetInterpPath( InterpInfo *iiPtr; if (targetInterp == askingInterp) { - Tcl_SetObjResult(askingInterp, Tcl_NewObj()); return TCL_OK; } if (targetInterp == NULL) { return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo; - if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){ + if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) { return TCL_ERROR; } - Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp), - Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable, - iiPtr->slave.slaveEntryPtr), TCL_STRLEN)); + Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable, + iiPtr->slave.slaveEntryPtr)); return TCL_OK; } @@ -2193,7 +2043,7 @@ GetInterp( Tcl_HashEntry *hPtr; /* Search element. */ Slave *slavePtr; /* Interim slave record. */ Tcl_Obj **objv; - size_t objc, i; + int objc, i; Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *masterInfoPtr; @@ -2217,8 +2067,8 @@ GetInterp( } } if (searchInterp == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not find interpreter \"%s\"", TclGetString(pathPtr))); + Tcl_AppendResult(interp, "could not find interpreter \"", + TclGetString(pathPtr), "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP", TclGetString(pathPtr), NULL); } @@ -2247,18 +2097,16 @@ static int SlaveBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */ - size_t objc, /* Set or Query. */ + int objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { - size_t length; + int length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cmdPrefix must be list of length >= 1", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BGERRORFORMAT", NULL); + Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1", + NULL); return TCL_ERROR; } TclSetBgErrorHandler(slaveInterp, objv[0]); @@ -2296,9 +2144,8 @@ SlaveCreate( Slave *slavePtr; InterpInfo *masterInfoPtr; Tcl_HashEntry *hPtr; - const char *path; - int isNew; - size_t objc; + char *path; + int isNew, objc; Tcl_Obj **objv; if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { @@ -2326,9 +2173,8 @@ SlaveCreate( hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &isNew); if (isNew == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "interpreter named \"%s\" already exists, cannot create", - path)); + Tcl_AppendResult(interp, "interpreter named \"", path, + "\" already exists, cannot create", NULL); return NULL; } @@ -2396,7 +2242,7 @@ SlaveCreate( return slaveInterp; error: - Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); + TclTransferResult(slaveInterp, TCL_ERROR, interp); error2: Tcl_DeleteInterp(slaveInterp); @@ -2424,22 +2270,20 @@ static int SlaveObjCmd( ClientData clientData, /* Slave interpreter. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Interp *slaveInterp = clientData; int index; - static const char *const options[] = { - "alias", "aliases", "bgerror", "debug", - "eval", "expose", "hide", "hidden", - "issafe", "invokehidden", "limit", "marktrusted", - "recursionlimit", NULL + static const char *options[] = { + "alias", "aliases", "bgerror", "debug", "eval", + "expose", "hide", "hidden", "issafe", + "invokehidden", "limit", "marktrusted", "recursionlimit", NULL }; enum options { - OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, - OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, - OPT_ISSAFE, OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, - OPT_RECLIMIT + OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, OPT_EVAL, + OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, + OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT }; if (slaveInterp == NULL) { @@ -2470,7 +2314,7 @@ SlaveObjCmd( objv[3], objc - 4, objv + 4); } } - Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?"); return TCL_ERROR; case OPT_ALIASES: if (objc != 2) { @@ -2486,7 +2330,7 @@ SlaveObjCmd( return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2); case OPT_DEBUG: /* - * TIP #378 + * TIP #378 * * Currently only -frame supported, otherwise ?-option ?value? ...? */ if (objc > 4) { @@ -2526,9 +2370,9 @@ SlaveObjCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { - int i; + int i, index; const char *namespaceName; - static const char *const hiddenOptions[] = { + static const char *hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { @@ -2566,7 +2410,7 @@ SlaveObjCmd( objc - i, objv + i); } case OPT_LIMIT: { - static const char *const limitTypes[] = { + static const char *limitTypes[] = { "commands", "time", NULL }; enum LimitTypes { @@ -2575,7 +2419,7 @@ SlaveObjCmd( int limitType; if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?"); + Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0, @@ -2665,7 +2509,7 @@ SlaveObjCmdDeleteProc( * A standard Tcl result. * * Side effects: - * May modify INTERP_DEBUG_FRAME flag in the slave. + * May modify INTERP_DEBUG flag in the slave. * *---------------------------------------------------------------------- */ @@ -2675,10 +2519,10 @@ SlaveDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* The slave interpreter in which command * will be evaluated. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *const debugTypes[] = { + static const char *debugTypes[] = { "-frame", NULL }; enum DebugTypes { @@ -2692,13 +2536,13 @@ SlaveDebugCmd( if (objc == 0) { resultPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewStringObj("-frame", TCL_STRLEN)); + 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) { + if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, + "debug option", 0, &debugType) != TCL_OK) { return TCL_ERROR; } if (debugType == DEBUG_TYPE_FRAME) { @@ -2707,13 +2551,11 @@ SlaveDebugCmd( != 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. + * 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; } @@ -2746,20 +2588,11 @@ SlaveEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* The slave interpreter in which command * will be evaluated. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { 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_Obj *objPtr; Tcl_Preserve(slaveInterp); Tcl_AllowExceptions(slaveInterp); @@ -2769,20 +2602,19 @@ SlaveEval( * TIP #280: Make actual argument location available to eval'd script. */ - Interp *iPtr = (Interp *) interp; - CmdFrame *invoker = iPtr->cmdFramePtr; - int word = 0; - - TclArgumentGet(interp, objv[0], &invoker, &word); + Interp *iPtr = (Interp *) interp; + CmdFrame* invoker = iPtr->cmdFramePtr; + int word = 0; + TclArgumentGet (interp, objv[0], &invoker, &word); result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word); } else { - Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv); + objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); result = Tcl_EvalObjEx(slaveInterp, objPtr, 0); Tcl_DecrRefCount(objPtr); } - Tcl_TransferResult(slaveInterp, result, interp); + TclTransferResult(slaveInterp, result, interp); Tcl_Release(slaveInterp); return result; @@ -2809,24 +2641,22 @@ static int SlaveExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - const char *name; + char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", - NULL); + -1)); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { - Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); + TclTransferResult(slaveInterp, TCL_ERROR, interp); return TCL_ERROR; } return TCL_OK; @@ -2853,7 +2683,7 @@ static int SlaveRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which limit is set/queried. */ - size_t objc, /* Set or Query. */ + int objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; @@ -2861,11 +2691,8 @@ SlaveRecursionLimit( if (objc) { if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: " - "safe interpreters cannot change recursion limit", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", - NULL); + Tcl_AppendResult(interp, "permission denied: " + "safe interpreters cannot change recursion limit", NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { @@ -2873,17 +2700,14 @@ SlaveRecursionLimit( } if (limit <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "recursion limit must be > 0", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", - NULL); + "recursion limit must be > 0", -1)); return TCL_ERROR; } Tcl_SetRecursionLimit(slaveInterp, limit); iPtr = (Interp *) slaveInterp; if (interp == slaveInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "falling back due to new recursion limit", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); + "falling back due to new recursion limit", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); @@ -2916,23 +2740,21 @@ static int SlaveHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *slaveInterp, /* Interp in which command will be exposed. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { - const char *name; + char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", - NULL); + -1)); return TCL_ERROR; } name = TclGetString(objv[(objc == 1) ? 0 : 1]); if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) { - Tcl_TransferResult(slaveInterp, TCL_ERROR, interp); + TclTransferResult(slaveInterp, TCL_ERROR, interp); return TCL_ERROR; } return TCL_OK; @@ -2970,8 +2792,8 @@ SlaveHidden( for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { - Tcl_ListObjAppendElement(NULL, listObjPtr, Tcl_NewStringObj( - Tcl_GetHashKey(hTblPtr, hPtr), TCL_STRLEN)); + Tcl_ListObjAppendElement(NULL, listObjPtr, + Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1)); } } Tcl_SetObjResult(interp, listObjPtr); @@ -3000,7 +2822,7 @@ SlaveInvokeHidden( Tcl_Interp *slaveInterp, /* The slave interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -3008,9 +2830,7 @@ SlaveInvokeHidden( if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", - NULL); + -1)); return TCL_ERROR; } @@ -3028,11 +2848,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); } } - Tcl_TransferResult(slaveInterp, result, interp); + TclTransferResult(slaveInterp, result, interp); Tcl_Release(slaveInterp); return result; @@ -3064,9 +2884,7 @@ SlaveMarkTrusted( if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", - NULL); + -1)); return TCL_ERROR; } ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP; @@ -3322,9 +3140,8 @@ Tcl_LimitCheck( if (iPtr->limit.cmdCount >= iPtr->cmdCount) { iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command count limit exceeded", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "command count limit exceeded", NULL); Tcl_Release(interp); return TCL_ERROR; } @@ -3348,9 +3165,8 @@ Tcl_LimitCheck( iPtr->limit.time.usec >= now.usec)) { iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "time limit exceeded", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "time limit exceeded", NULL); Tcl_Release(interp); return TCL_ERROR; } @@ -3403,7 +3219,7 @@ RunLimitHandlers( */ handlerPtr->flags |= LIMIT_HANDLER_ACTIVE; - handlerPtr->handlerProc(handlerPtr->clientData, interp); + (handlerPtr->handlerProc)(handlerPtr->clientData, interp); handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE; /* @@ -3424,9 +3240,9 @@ RunLimitHandlers( if (handlerPtr->flags & LIMIT_HANDLER_DELETED) { if (handlerPtr->deleteProc != NULL) { - handlerPtr->deleteProc(handlerPtr->clientData); + (handlerPtr->deleteProc)(handlerPtr->clientData); } - ckfree(handlerPtr); + ckfree((char *) handlerPtr); } } } @@ -3473,7 +3289,7 @@ Tcl_LimitAddHandler( * Allocate a handler record. */ - handlerPtr = ckalloc(sizeof(LimitHandler)); + handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler)); handlerPtr->flags = 0; handlerPtr->handlerProc = handlerProc; handlerPtr->clientData = clientData; @@ -3590,9 +3406,9 @@ Tcl_LimitRemoveHandler( if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { - handlerPtr->deleteProc(handlerPtr->clientData); + (handlerPtr->deleteProc)(handlerPtr->clientData); } - ckfree(handlerPtr); + ckfree((char *) handlerPtr); } return; } @@ -3650,9 +3466,9 @@ TclLimitRemoveAllHandlers( if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { - handlerPtr->deleteProc(handlerPtr->clientData); + (handlerPtr->deleteProc)(handlerPtr->clientData); } - ckfree(handlerPtr); + ckfree((char *) handlerPtr); } } @@ -3683,9 +3499,9 @@ TclLimitRemoveAllHandlers( if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) { if (handlerPtr->deleteProc != NULL) { - handlerPtr->deleteProc(handlerPtr->clientData); + (handlerPtr->deleteProc)(handlerPtr->clientData); } - ckfree(handlerPtr); + ckfree((char *) handlerPtr); } } @@ -3948,7 +3764,7 @@ TimeLimitCallback( code = Tcl_LimitCheck(interp); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (while waiting for event)"); - Tcl_BackgroundException(interp, code); + TclBackgroundException(interp, code); } Tcl_Release(interp); } @@ -4080,7 +3896,7 @@ DeleteScriptLimitCallback( if (limitCBPtr->entryPtr != NULL) { Tcl_DeleteHashEntry(limitCBPtr->entryPtr); } - ckfree(limitCBPtr); + ckfree((char *) limitCBPtr); } /* @@ -4116,7 +3932,7 @@ CallScriptLimitCallback( code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj, TCL_EVAL_GLOBAL); if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) { - Tcl_BackgroundException(limitCBPtr->interp, code); + TclBackgroundException(limitCBPtr->interp, code); } Tcl_Release(limitCBPtr->interp); } @@ -4171,7 +3987,7 @@ SetScriptLimitCallback( return; } - hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key, + hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key, &isNew); if (!isNew) { limitCBPtr = Tcl_GetHashValue(hashPtr); @@ -4180,7 +3996,7 @@ SetScriptLimitCallback( limitCBPtr); } - limitCBPtr = ckalloc(sizeof(ScriptLimitCallback)); + limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback)); limitCBPtr->interp = interp; limitCBPtr->scriptObj = scriptObj; limitCBPtr->entryPtr = hashPtr; @@ -4331,11 +4147,11 @@ static int SlaveCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */ - size_t consumedObjc, /* Number of args already parsed. */ - size_t objc, /* Total number of arguments. */ + int consumedObjc, /* Number of args already parsed. */ + int objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *const options[] = { + static const char *options[] = { "-command", "-granularity", "-value", NULL }; enum Options { @@ -4355,9 +4171,8 @@ SlaveCommandLimitCmd( */ if (interp == slaveInterp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); + Tcl_AppendResult(interp, + "limits on current interpreter inaccessible", NULL); return TCL_ERROR; } @@ -4371,8 +4186,7 @@ SlaveCommandLimitCmd( if (hPtr != NULL) { limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4383,23 +4197,21 @@ SlaveCommandLimitCmd( putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_STRLEN), empty); + Tcl_NewStringObj(options[0], -1), empty); } - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[1], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp, - TCL_LIMIT_COMMANDS))); + TCL_LIMIT_COMMANDS))); if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) { - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp))); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_STRLEN), empty); + Tcl_NewStringObj(options[2], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -4433,10 +4245,11 @@ SlaveCommandLimitCmd( } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { - Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); + Tcl_WrongNumArgs(interp, consumedObjc, objv, + "?-option? ?value? ?-option value ...?"); return TCL_ERROR; } else { - size_t i, scriptLen = 0, limitLen = 0; + int i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; @@ -4456,10 +4269,8 @@ SlaveCommandLimitCmd( return TCL_ERROR; } if (gran < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADVALUE", NULL); + Tcl_AppendResult(interp, "granularity must be at " + "least 1", NULL); return TCL_ERROR; } break; @@ -4473,11 +4284,8 @@ SlaveCommandLimitCmd( return TCL_ERROR; } if (limit < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command limit value must be at least 0", - TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADVALUE", NULL); + Tcl_AppendResult(interp, "command limit value must be at " + "least 0", NULL); return TCL_ERROR; } break; @@ -4521,13 +4329,13 @@ SlaveCommandLimitCmd( static int SlaveTimeLimitCmd( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */ - size_t consumedObjc, /* Number of args already parsed. */ - size_t objc, /* Total number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Interp *slaveInterp, /* Interpreter being adjusted. */ + int consumedObjc, /* Number of args already parsed. */ + int objc, /* Total number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - static const char *const options[] = { + static const char *options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL }; enum Options { @@ -4547,9 +4355,8 @@ SlaveTimeLimitCmd( */ if (interp == slaveInterp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); + Tcl_AppendResult(interp, + "limits on current interpreter inaccessible", NULL); return TCL_ERROR; } @@ -4563,8 +4370,7 @@ SlaveTimeLimitCmd( if (hPtr != NULL) { limitCBPtr = Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4574,31 +4380,28 @@ SlaveTimeLimitCmd( putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_STRLEN), empty); + Tcl_NewStringObj(options[0], -1), empty); } - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[1], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp, - TCL_LIMIT_TIME))); + TCL_LIMIT_TIME))); if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) { Tcl_Time limitMoment; Tcl_LimitGetTime(slaveInterp, &limitMoment); - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewLongObj(limitMoment.usec/1000)); - Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[3], TCL_STRLEN), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1), Tcl_NewLongObj(limitMoment.sec)); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_STRLEN), empty); + Tcl_NewStringObj(options[2], -1), empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[3], TCL_STRLEN), empty); + Tcl_NewStringObj(options[3], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -4643,10 +4446,11 @@ SlaveTimeLimitCmd( } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { - Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); + Tcl_WrongNumArgs(interp, consumedObjc, objv, + "?-option? ?value? ?-option value ...?"); return TCL_ERROR; } else { - size_t i, scriptLen = 0, milliLen = 0, secLen = 0; + int i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; @@ -4670,10 +4474,8 @@ SlaveTimeLimitCmd( return TCL_ERROR; } if (gran < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADVALUE", NULL); + Tcl_AppendResult(interp, "granularity must be at " + "least 1", NULL); return TCL_ERROR; } break; @@ -4687,13 +4489,11 @@ SlaveTimeLimitCmd( return TCL_ERROR; } if (tmp < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "milliseconds must be at least 0", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADVALUE", NULL); + Tcl_AppendResult(interp, "milliseconds must be at least 0", + NULL); return TCL_ERROR; } - limitMoment.usec = ((long) tmp)*1000; + limitMoment.usec = ((long)tmp)*1000; break; case OPT_SEC: secObj = objv[i+1]; @@ -4705,10 +4505,8 @@ SlaveTimeLimitCmd( return TCL_ERROR; } if (tmp < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "seconds must be at least 0", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADVALUE", NULL); + Tcl_AppendResult(interp, "seconds must be at least 0", + NULL); return TCL_ERROR; } limitMoment.sec = tmp; @@ -4723,19 +4521,13 @@ SlaveTimeLimitCmd( */ if (secObj != NULL && secLen == 0 && milliLen > 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may only set -milliseconds if -seconds is not " - "also being reset", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADUSAGE", NULL); + Tcl_AppendResult(interp, "may only set -milliseconds " + "if -seconds is not also being reset", NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may only reset -milliseconds if -seconds is " - "also being reset", TCL_STRLEN)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", - "BADUSAGE", NULL); + Tcl_AppendResult(interp, "may only reset -milliseconds " + "if -seconds is also being reset", NULL); return TCL_ERROR; } } |