diff options
Diffstat (limited to 'generic/tclVar.c')
| -rw-r--r-- | generic/tclVar.c | 159 |
1 files changed, 158 insertions, 1 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 2d36e3a..aab35cc 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.71 2003/04/16 23:33:44 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.72 2003/04/28 12:34:31 dkf Exp $ */ #include "tclInt.h" @@ -1876,6 +1876,163 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) /* *---------------------------------------------------------------------- * + * TclIncrWideVar2 -- + * + * Given a two-part variable name, which may refer either to a scalar + * variable or an element of an array, increment the Tcl object value + * of the variable by a specified amount. + * + * Results: + * Returns a pointer to the Tcl_Obj holding the new value of the + * variable. If the specified variable doesn't exist, or there is a + * clash in array usage, or an error occurs while executing variable + * traces, then NULL is returned and a message will be left in + * the interpreter's result. + * + * Side effects: + * The value of the given variable is incremented by the specified + * amount. If either the array or the entry didn't exist then a new + * variable is created. The ref count for the returned object is _not_ + * incremented to reflect the returned reference; if you want to keep a + * reference to the object you must increment its ref count yourself. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclIncrWideVar2(interp, part1Ptr, part2Ptr, incrAmount, flags) + Tcl_Interp *interp; /* Command interpreter in which variable is + * to be found. */ + Tcl_Obj *part1Ptr; /* Points to an object holding the name of + * an array (if part2 is non-NULL) or the + * name of a variable. */ + Tcl_Obj *part2Ptr; /* If non-null, points to an object holding + * the name of an element in the array + * part1Ptr. */ + Tcl_WideInt incrAmount; /* Amount to be added to variable. */ + int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, + * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ +{ + Var *varPtr, *arrayPtr; + char *part1, *part2; + + part1 = TclGetString(part1Ptr); + part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr)); + + varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read", + 0, 1, &arrayPtr); + if (varPtr == NULL) { + Tcl_AddObjErrorInfo(interp, + "\n (reading value of variable to increment)", -1); + return NULL; + } + return TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, + incrAmount, flags); +} + +/* + *---------------------------------------------------------------------- + * + * TclPtrIncrWideVar -- + * + * Given the pointers to a variable and possible containing array, + * increment the Tcl object value of the variable by a specified + * amount. + * + * Results: + * Returns a pointer to the Tcl_Obj holding the new value of the + * variable. If the specified variable doesn't exist, or there is a + * clash in array usage, or an error occurs while executing variable + * traces, then NULL is returned and a message will be left in + * the interpreter's result. + * + * Side effects: + * The value of the given variable is incremented by the specified + * amount. If either the array or the entry didn't exist then a new + * variable is created. The ref count for the returned object is _not_ + * incremented to reflect the returned reference; if you want to keep a + * reference to the object you must increment its ref count yourself. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) + Tcl_Interp *interp; /* Command interpreter in which variable is + * to be found. */ + Var *varPtr; + Var *arrayPtr; + CONST char *part1; /* Points to an object holding the name of + * an array (if part2 is non-NULL) or the + * name of a variable. */ + CONST char *part2; /* If non-null, points to an object holding + * the name of an element in the array + * part1Ptr. */ + CONST Tcl_WideInt incrAmount; + /* Amount to be added to variable. */ + CONST int flags; /* Various flags that tell how to incr value: + * any of TCL_GLOBAL_ONLY, + * TCL_NAMESPACE_ONLY, TCL_APPEND_VALUE, + * TCL_LIST_ELEMENT, TCL_LEAVE_ERR_MSG. */ +{ + register Tcl_Obj *varValuePtr; + int createdNewObj; /* Set 1 if var's value object is shared + * so we must increment a copy (i.e. copy + * on write). */ + Tcl_WideInt wide; + + varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags); + + if (varValuePtr == NULL) { + Tcl_AddObjErrorInfo(interp, + "\n (reading value of variable to increment)", -1); + return NULL; + } + + /* + * Increment the variable's value. If the object is unshared we can + * modify it directly, otherwise we must create a new copy to modify: + * this is "copy on write". Then free the variable's old string + * representation, if any, since it will no longer be valid. + */ + + createdNewObj = 0; + if (Tcl_IsShared(varValuePtr)) { + varValuePtr = Tcl_DuplicateObj(varValuePtr); + createdNewObj = 1; + } + if (varValuePtr->typePtr == &tclWideIntType) { + TclGetWide(wide, varValuePtr); + Tcl_SetWideIntObj(varValuePtr, wide + incrAmount); + } else if (varValuePtr->typePtr == &tclIntType) { + long i = varValuePtr->internalRep.longValue; + Tcl_SetWideIntObj(varValuePtr, Tcl_LongAsWide(i) + incrAmount); + } else { + /* + * Not an integer or wide internal-rep... + */ + if (Tcl_GetWideIntFromObj(interp, varValuePtr, &wide) != TCL_OK) { + if (createdNewObj) { + Tcl_DecrRefCount(varValuePtr); /* free unneeded copy */ + } + return NULL; + } + Tcl_SetWideIntObj(varValuePtr, wide + incrAmount); + } + + /* + * Store the variable's new value and run any write traces. + */ + + return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, + varValuePtr, flags); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_UnsetVar -- * * Delete a variable, so that it may not be accessed anymore. |