From 41aa65744a309bd290f9d3a764be958446340687 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 2 Nov 2005 11:55:47 +0000 Subject: ANSIfy (though only partially - function decls only - for tclExecute.c) --- generic/tclExecute.c | 406 +++++++++++++++++++++------------------ generic/tclScan.c | 92 ++++----- generic/tclStringObj.c | 482 ++++++++++++++++++++++++++--------------------- generic/tclThread.c | 137 +++++++------- generic/tclThreadAlloc.c | 94 ++++----- generic/tclUtil.c | 359 ++++++++++++++++++----------------- generic/tclVar.c | 384 ++++++++++++++++++------------------- 7 files changed, 1030 insertions(+), 924 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d77e51e..3f47527 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.218 2005/10/22 01:35:26 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.219 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" @@ -23,7 +23,7 @@ #include /* - * Hack to determine whether we may expect IEEE floating point. The hack is + * Hack to determine whether we may expect IEEE floating point. The hack is * formally incorrect in that non-IEEE platforms might have the same precision * and range, but VAX, IBM, and Cray do not; are there any other floating * point units that we might care about? @@ -262,8 +262,8 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; * * GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never * generates an error message. - * */ + #define REQUIRE_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar) \ (resultVar) = Tcl_GetWideIntFromObj(interp, (objPtr), &(wideVar)); \ if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN) \ @@ -282,9 +282,11 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; = Tcl_WideAsLong(wideVar); \ } #endif + /* * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from an obj. */ + #if 0 #define W0 Tcl_LongAsWide(0) /* @@ -295,7 +297,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; /* * Macro used in this file to save a function call for common uses of - * TclGetNumberFromObj(). The ANSI C "prototype" is: + * TclGetNumberFromObj(). The ANSI C "prototype" is: * * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, * ClientData *ptrPtr, int *tPtr); @@ -390,41 +392,36 @@ static Tcl_ObjType dictIteratorType = { * Declarations for local procedures to this file: */ -static int TclExecuteByteCode _ANSI_ARGS_((Tcl_Interp *interp, - ByteCode *codePtr)); +static int TclExecuteByteCode(Tcl_Interp *interp, + ByteCode *codePtr); #ifdef TCL_COMPILE_STATS -static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData, +static int EvalStatsCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Obj *CONST objv[]); #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG -static char * GetOpcodeName _ANSI_ARGS_((unsigned char *pc)); +static char * GetOpcodeName(unsigned char *pc); #endif /* TCL_COMPILE_DEBUG */ -static ExceptionRange * GetExceptRangeForPc _ANSI_ARGS_((unsigned char *pc, - int catchOnly, ByteCode* codePtr)); -static char * GetSrcInfoForPc _ANSI_ARGS_((unsigned char *pc, - ByteCode* codePtr, int *lengthPtr)); -static void GrowEvaluationStack _ANSI_ARGS_((ExecEnv *eePtr)); -static void IllegalExprOperandType _ANSI_ARGS_(( - Tcl_Interp *interp, unsigned char *pc, - Tcl_Obj *opndPtr)); -static void InitByteCodeExecution _ANSI_ARGS_(( - Tcl_Interp *interp)); +static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, + int catchOnly, ByteCode* codePtr); +static char * GetSrcInfoForPc(unsigned char *pc, + ByteCode* codePtr, int *lengthPtr); +static void GrowEvaluationStack(ExecEnv *eePtr); +static void IllegalExprOperandType(Tcl_Interp *interp, + unsigned char *pc, Tcl_Obj *opndPtr); +static void InitByteCodeExecution(Tcl_Interp *interp); #ifdef TCL_COMPILE_DEBUG -static void PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr)); -static char * StringForResultCode _ANSI_ARGS_((int result)); -static void ValidatePcAndStackTop _ANSI_ARGS_(( - ByteCode *codePtr, unsigned char *pc, - int stackTop, int stackLowerBound, - int checkStack)); +static void PrintByteCodeInfo(ByteCode *codePtr); +static char * StringForResultCode(int result); +static void ValidatePcAndStackTop(ByteCode *codePtr, + unsigned char *pc, int stackTop, + int stackLowerBound, int checkStack); #endif /* TCL_COMPILE_DEBUG */ #if 0 -static Tcl_WideInt ExponWide _ANSI_ARGS_((Tcl_WideInt w, Tcl_WideInt w2, - int *errExpon)); -static long ExponLong _ANSI_ARGS_((long i, long i2, - int *errExpon)); +static Tcl_WideInt ExponWide(Tcl_WideInt w, Tcl_WideInt w2, + int *errExpon); +static long ExponLong(long i, long i2, int *errExpon); #endif - /* *---------------------------------------------------------------------- @@ -448,8 +445,8 @@ static long ExponLong _ANSI_ARGS_((long i, long i2, */ static void -InitByteCodeExecution(interp) - Tcl_Interp *interp; /* Interpreter for which the Tcl variable +InitByteCodeExecution( + Tcl_Interp *interp) /* Interpreter for which the Tcl variable * "tcl_traceExec" is linked to control * instruction tracing. */ { @@ -490,8 +487,8 @@ InitByteCodeExecution(interp) #define TCL_STACK_INITIAL_SIZE 2000 ExecEnv * -TclCreateExecEnv(interp) - Tcl_Interp *interp; /* Interpreter for which the execution +TclCreateExecEnv( + Tcl_Interp *interp) /* Interpreter for which the execution * environment is being created. */ { ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv)); @@ -547,8 +544,8 @@ TclCreateExecEnv(interp) */ void -TclDeleteExecEnv(eePtr) - ExecEnv *eePtr; /* Execution environment to free. */ +TclDeleteExecEnv( + ExecEnv *eePtr) /* Execution environment to free. */ { if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) { ckfree((char *) (eePtr->stackPtr-1)); @@ -579,7 +576,7 @@ TclDeleteExecEnv(eePtr) */ void -TclFinalizeExecution() +TclFinalizeExecution(void) { Tcl_MutexLock(&execMutex); execInitialized = 0; @@ -604,8 +601,8 @@ TclFinalizeExecution() */ static void -GrowEvaluationStack(eePtr) - register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation +GrowEvaluationStack( + register ExecEnv *eePtr) /* Points to the ExecEnv with an evaluation * stack to enlarge. */ { /* @@ -672,9 +669,9 @@ GrowEvaluationStack(eePtr) */ char * -TclStackAlloc(interp, numBytes) - Tcl_Interp *interp; - int numBytes; +TclStackAlloc( + Tcl_Interp *interp, + int numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; @@ -716,8 +713,8 @@ TclStackAlloc(interp, numBytes) } void -TclStackFree(interp) - Tcl_Interp *interp; +TclStackFree( + Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr = iPtr->execEnvPtr; @@ -756,12 +753,12 @@ TclStackFree(interp) */ int -Tcl_ExprObj(interp, objPtr, resultPtrPtr) - Tcl_Interp *interp; /* Context in which to evaluate the +Tcl_ExprObj( + Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - register Tcl_Obj *objPtr; /* Points to Tcl object containing expression + register Tcl_Obj *objPtr, /* Points to Tcl object containing expression * to evaluate. */ - Tcl_Obj **resultPtrPtr; /* Where the Tcl_Obj* that is the expression + Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression * result is stored if no errors occur. */ { Interp *iPtr = (Interp *) interp; @@ -769,7 +766,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) * in frame. */ LiteralTable *localTablePtr = &(compEnv.localLitTable); register ByteCode *codePtr = NULL; - /* Tcl Internal type of bytecode. Initialized + /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ AuxData *auxDataPtr; LiteralEntry *entryPtr; @@ -926,7 +923,7 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) /* * If the expression evaluated successfully, store a pointer to its value - * object in resultPtrPtr then restore the old interpreter result. We + * object in resultPtrPtr then restore the old interpreter result. We * increment the object's ref count to reflect the reference that we are * returning to the caller. We also decrement the ref count of the * interpreter's result object after calling Tcl_SetResult since we next @@ -963,9 +960,9 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr) */ int -TclCompEvalObj(interp, objPtr) - Tcl_Interp *interp; - Tcl_Obj *objPtr; +TclCompEvalObj( + Tcl_Interp *interp, + Tcl_Obj *objPtr) { register Interp *iPtr = (Interp *) interp; register ByteCode* codePtr; /* Tcl Internal type of bytecode. */ @@ -991,7 +988,7 @@ TclCompEvalObj(interp, objPtr) /* * If the object is not already of tclByteCodeType, compile it (and reset * the compilation flags in the interpreter; this should be done after any - * compilation). Otherwise, check that it is "fresh" enough. + * compilation). Otherwise, check that it is "fresh" enough. */ if (objPtr->typePtr != &tclByteCodeType) { @@ -1007,19 +1004,20 @@ TclCompEvalObj(interp, objPtr) /* * Make sure the Bytecode hasn't been invalidated by, e.g., someone * redefining a command with a compile procedure (this might make the - * compiled code wrong). The object needs to be recompiled if it was + * compiled code wrong). The object needs to be recompiled if it was * compiled in/for a different interpreter, or for a different * namespace, or for the same namespace but with different name - * resolution rules. Precompiled objects, however, are immutable and + * resolution rules. Precompiled objects, however, are immutable and * therefore they are not recompiled, even if the epoch has changed. * * To be pedantically correct, we should also check that the * originating procPtr is the same as the current context procPtr - * (assuming one exists at all - none for global level). This code is + * (assuming one exists at all - none for global level). This code is * #def'ed out because [info body] was changed to never return a * bytecode type object, which should obviate us from the extra checks * here. */ + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) @@ -1064,9 +1062,9 @@ TclCompEvalObj(interp, objPtr) * * TclIncrObj -- * - * Increment an integeral value in a Tcl_Obj by an integeral value - * held in another Tcl_Obj. Caller is responsible for making sure - * we can update the first object. + * Increment an integeral value in a Tcl_Obj by an integeral value held + * in another Tcl_Obj. Caller is responsible for making sure we can + * update the first object. * * Results: * TCL_ERROR if either object is non-integer, and TCL_OK otherwise. On @@ -1080,10 +1078,10 @@ TclCompEvalObj(interp, objPtr) */ int -TclIncrObj(interp, valuePtr, incrPtr) - Tcl_Interp *interp; - Tcl_Obj *valuePtr; - Tcl_Obj *incrPtr; +TclIncrObj( + Tcl_Interp *interp, + Tcl_Obj *valuePtr, + Tcl_Obj *incrPtr) { ClientData ptr1, ptr2; int type1, type2; @@ -1124,7 +1122,7 @@ TclIncrObj(interp, valuePtr, incrPtr) return TCL_OK; } #endif - } + } if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) { /* Produce error message (reparse?!) */ @@ -1151,7 +1149,7 @@ TclIncrObj(interp, valuePtr, incrPtr) } } #endif - + Tcl_GetBignumAndClearObj(interp, valuePtr, &value); Tcl_GetBignumFromObj(interp, incrPtr, &incr); mp_add(&value, &incr, &value); @@ -1180,9 +1178,9 @@ TclIncrObj(interp, valuePtr, incrPtr) */ static int -TclExecuteByteCode(interp, codePtr) - Tcl_Interp *interp; /* Token for command interpreter. */ - ByteCode *codePtr; /* The bytecode sequence to interpret. */ +TclExecuteByteCode( + Tcl_Interp *interp, /* Token for command interpreter. */ + ByteCode *codePtr) /* The bytecode sequence to interpret. */ { /* * Compiler cast directive - not a real variable. @@ -1247,7 +1245,7 @@ TclExecuteByteCode(interp, codePtr) * * Make sure the catch stack is large enough to hold the maximum number of * catch commands that could ever be executing at the same time (this will - * be no more than the exception range array's depth). Make sure the + * be no more than the exception range array's depth). Make sure the * execution stack is large enough to execute this ByteCode. */ @@ -1376,6 +1374,7 @@ TclExecuteByteCode(interp, codePtr) if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) { if (Tcl_AsyncReady()) { int localResult; + DECACHE_STACK_INFO(); localResult = Tcl_AsyncInvoke(interp, result); CACHE_STACK_INFO(); @@ -1386,6 +1385,7 @@ TclExecuteByteCode(interp, codePtr) } if (Tcl_LimitReady(interp)) { int localResult; + DECACHE_STACK_INFO(); localResult = Tcl_LimitCheck(interp); CACHE_STACK_INFO(); @@ -1598,9 +1598,9 @@ TclExecuteByteCode(interp, codePtr) /* * If the first object is shared, we need a new obj for the result; - * otherwise, we can reuse the first object. In any case, make sure - * it has enough room to accomodate all the concatenated bytes. Note - * that if it is unshared its bytes are already copied by + * otherwise, we can reuse the first object. In any case, make sure it + * has enough room to accomodate all the concatenated bytes. Note that + * if it is unshared its bytes are already copied by * Tcl_SetObjectLength, so that we set the loop parameters to avoid * copying them again: p points to the end of the already copied * bytes, currPtr to the second object. @@ -2293,6 +2293,7 @@ TclExecuteByteCode(interp, codePtr) * value *will* be set to what's requested, so that the stack top * remains pointing to the same Tcl_Obj. */ + valuePtr = varPtr->value.objPtr; objResultPtr = *tosPtr; if (valuePtr != objResultPtr) { @@ -2574,8 +2575,7 @@ TclExecuteByteCode(interp, codePtr) } else { DECACHE_STACK_INFO(); objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr, - part1, part2, - incrPtr, TCL_LEAVE_ERR_MSG); + part1, part2, incrPtr, TCL_LEAVE_ERR_MSG); CACHE_STACK_INFO(); Tcl_DecrRefCount(incrPtr); if (objResultPtr == NULL) { @@ -3040,6 +3040,7 @@ TclExecuteByteCode(interp, codePtr) /* * Basic list containment operators. */ + int found, s1len, s2len, llen, i; Tcl_Obj *valuePtr, *value2Ptr, *o; char *s1, *s2; @@ -3113,6 +3114,7 @@ TclExecuteByteCode(interp, codePtr) * String (in)equality check * TODO: Consider merging into INST_STR_CMP */ + int iResult; Tcl_Obj *valuePtr, *value2Ptr; @@ -3124,6 +3126,7 @@ TclExecuteByteCode(interp, codePtr) * On the off-chance that the objects are the same, we don't * really have to think hard about equality. */ + iResult = (*pc == INST_STR_EQ); } else { char *s1, *s2; @@ -3136,6 +3139,7 @@ TclExecuteByteCode(interp, codePtr) * We only need to check (in)equality when we have equal * length strings. */ + if (*pc == INST_STR_NEQ) { iResult = (strcmp(s1, s2) != 0); } else { @@ -3174,6 +3178,7 @@ TclExecuteByteCode(interp, codePtr) /* * String compare */ + CONST char *s1, *s2; int s1len, s2len, iResult; Tcl_Obj *valuePtr, *value2Ptr; @@ -3186,11 +3191,13 @@ TclExecuteByteCode(interp, codePtr) * The comparison function should compare up to the minimum byte * length only. */ + if (valuePtr == value2Ptr) { /* * In the pure equality case, set lengths too for the checks below * (or we could goto beyond it). */ + iResult = s1len = s2len = 0; } else if ((valuePtr->typePtr == &tclByteArrayType) && (value2Ptr->typePtr == &tclByteArrayType)) { @@ -3202,8 +3209,8 @@ TclExecuteByteCode(interp, codePtr) && (value2Ptr->typePtr == &tclStringType))) { /* * Do a unicode-specific comparison if both of the args are of - * String type. If the char length == byte length, we can do a - * memcmp. In benchmark testing this proved the most efficient + * String type. If the char length == byte length, we can do a + * memcmp. In benchmark testing this proved the most efficient * check between the unicode and string comparison operations. */ @@ -3258,7 +3265,7 @@ TclExecuteByteCode(interp, codePtr) iResult = (iResult >= 0); break; } - } + } if (iResult < 0) { TclNewIntObj(objResultPtr, -1); TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), -1)); @@ -3331,11 +3338,13 @@ TclExecuteByteCode(interp, codePtr) Tcl_UniChar ch; ch = Tcl_GetUniChar(valuePtr, index); + /* * This could be: Tcl_NewUnicodeObj((CONST Tcl_UniChar *)&ch, * 1) but creating the object as a string seems to be faster * in practical use. */ + length = Tcl_UniCharToUtf(ch, buf); objResultPtr = Tcl_NewStringObj(buf, length); } @@ -3376,7 +3385,7 @@ TclExecuteByteCode(interp, codePtr) } /* - * Reuse value2Ptr object already on stack if possible. Adjustment is + * Reuse value2Ptr object already on stack if possible. Adjustment is * 2 due to the nocase byte * TODO: consider peephole opt. */ @@ -3444,27 +3453,29 @@ TclExecuteByteCode(interp, codePtr) d2 = *((CONST double *)ptr2); d1 = (double) l1; - /* - * If the double has a fractional part, or if the - * long can be converted to double without loss of - * precision, then compare as doubles. + /* + * If the double has a fractional part, or if the long can be + * converted to double without loss of precision, then compare + * as doubles. */ + if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) || (l1 == (long) d1) || (modf(d2, &tmp) != 0.0)) { goto doubleCompare; } + /* * Otherwise, to make comparision based on full precision, * need to convert the double to a suitably sized integer. * * Need this to get comparsions like - * expr 20000000000000003 < 20000000000000004.0 - * right. Converting the first argument to double - * will yield two double values that are equivalent - * within double precision. Converting the double to - * an integer gets done exactly, then integer comparison - * can tell the difference. + * expr 20000000000000003 < 20000000000000004.0 + * right. Converting the first argument to double will yield + * two double values that are equivalent within double + * precision. Converting the double to an integer gets done + * exactly, then integer comparison can tell the difference. */ + if (d2 < (double)LONG_MIN) { compare = MP_GT; break; @@ -3602,7 +3613,7 @@ TclExecuteByteCode(interp, codePtr) } if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) && (modf(d1, &tmp) != 0.0)) { - d2 = TclBignumToDouble( &big2); + d2 = TclBignumToDouble(&big2); mp_clear(&big2); goto doubleCompare; } @@ -3639,7 +3650,7 @@ TclExecuteByteCode(interp, codePtr) } if ((DBL_MANT_DIG > CHAR_BIT*sizeof(long)) && (modf(d2, &tmp) != 0.0)) { - d1 = TclBignumToDouble( &big1); + d1 = TclBignumToDouble(&big1); mp_clear(&big1); goto doubleCompare; } @@ -3772,11 +3783,12 @@ TclExecuteByteCode(interp, codePtr) result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift); if (result != TCL_OK) { /* - * Technically, we could hold the value (1 << (INT_MAX+1)) - * in an mp_int, but since we're using mp_mul_2d() to do the + * Technically, we could hold the value (1 << (INT_MAX+1)) in + * an mp_int, but since we're using mp_mul_2d() to do the * work, and it takes only an int argument, that's a good * place to draw the line. */ + Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); goto checkForCatch; @@ -3784,8 +3796,8 @@ TclExecuteByteCode(interp, codePtr) /* Handle shifts within the native long range */ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if ((type1 == TCL_NUMBER_LONG) && (shift < CHAR_BIT*sizeof(long)) - && (l = *((CONST long *)ptr1)) - && !(((l>0) ? l : ~l) + && (l = *((CONST long *)ptr1)) + && !(((l>0) ? l : ~l) & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) { TclNewLongObj(objResultPtr, (l<0) ? w : ~w) + if (!(((w>0) ? w : ~w) & -(((Tcl_WideInt)1) <<(CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) { objResultPtr = Tcl_NewWideIntObj(w<0) ? l : ~l) + && (l = *((CONST long *)ptr1)) + && !(((l>0) ? l : ~l) & -(1<<(CHAR_BIT*sizeof(long)-1-shift)))) { TclNewLongObj(objResultPtr, (l< ", O2S(valuePtr), O2S(value2Ptr))); if ((type2 != TCL_NUMBER_LONG) - || ( *((CONST long *)ptr2) > INT_MAX)) { + || (*((CONST long *)ptr2) > INT_MAX)) { /* - * Again, technically, the value to be shifted could - * be an mp_int so huge that a right shift by (INT_MAX+1) - * bits could not take us to the result of 0 or -1, but - * since we're using mp_div_2d to do the work, and it - * takes only an int argument, we draw the line there. + * Again, technically, the value to be shifted could be an + * mp_int so huge that a right shift by (INT_MAX+1) bits could + * not take us to the result of 0 or -1, but since we're using + * mp_div_2d to do the work, and it takes only an int + * argument, we draw the line there. */ + int zero; + switch (type1) { case TCL_NUMBER_LONG: zero = (*((CONST long *)ptr1) > (long)0); break; #ifndef NO_WIDE_TYPE - case TCL_NUMBER_WIDE: + case TCL_NUMBER_WIDE: zero = (*((CONST Tcl_WideInt *)ptr1) > (Tcl_WideInt)0); break; #endif @@ -3926,7 +3941,7 @@ TclExecuteByteCode(interp, codePtr) TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } - + case INST_BITOR: case INST_BITXOR: case INST_BITAND: { @@ -3973,10 +3988,10 @@ TclExecuteByteCode(interp, codePtr) } /* - * Count how many positive arguments we have. If only one of the - * arguments is negative, store it in 'Second'. + * Count how many positive arguments we have. If only one of the + * arguments is negative, store it in 'Second'. */ - + if (mp_cmp_d(&big1, 0) != MP_LT) { numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT); First = &big1; @@ -4004,7 +4019,7 @@ TclExecuteByteCode(interp, codePtr) mp_and(First, &bigResult, &bigResult); break; case 0: - /* Both arguments negative + /* Both arguments negative * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1 */ mp_neg(First, First); mp_sub_d(First, 1, First); @@ -4034,7 +4049,7 @@ TclExecuteByteCode(interp, codePtr) mp_sub_d(&bigResult, 1, &bigResult); break; case 0: - /* Both arguments negative + /* Both arguments negative * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1 */ mp_neg(First, First); mp_sub_d(First, 1, First); @@ -4064,7 +4079,7 @@ TclExecuteByteCode(interp, codePtr) mp_sub_d(&bigResult, 1, &bigResult); break; case 0: - /* Both arguments negative + /* Both arguments negative * a ^ b = (~a ^ ~b) = (-a-1^-b-1) */ mp_neg(First, First); mp_sub_d(First, 1, First); @@ -4075,7 +4090,7 @@ TclExecuteByteCode(interp, codePtr) } break; } - + mp_clear(&big1); mp_clear(&big2); TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -4109,7 +4124,7 @@ TclExecuteByteCode(interp, codePtr) /* Unused, here to silence compiler warning. */ wResult = 0; } - + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(wResult); @@ -4139,7 +4154,7 @@ TclExecuteByteCode(interp, codePtr) /* Unused, here to silence compiler warning. */ lResult = 0; } - + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, lResult); @@ -4205,6 +4220,7 @@ TclExecuteByteCode(interp, codePtr) * not specified. Tcl guarantees that the remainder will have the * same sign as the divisor and a smaller absolute value. */ + if (value2Ptr->typePtr == &tclWideIntType && w2 == W0) { if (valuePtr->typePtr == &tclIntType) { TRACE(("%ld "LLD" => DIVIDE BY ZERO\n", i, w2)); @@ -4232,19 +4248,23 @@ TclExecuteByteCode(interp, codePtr) } else if (value2Ptr->typePtr == &tclIntType) { w2 = Tcl_LongAsWide(i2); } - if ( w == LLONG_MIN && w2 == -1 ) { - /* Integer overflow could happen with (LLONG_MIN % -1) - * even though it is not possible in the code below. */ + if (w == LLONG_MIN && w2 == -1) { + /* + * Integer overflow could happen with (LLONG_MIN % -1) + * even though it is not possible in the code below. + */ + wRemainder = 0; - } else if ( w == LLONG_MIN && w2 == LLONG_MAX ) { + } else if (w == LLONG_MIN && w2 == LLONG_MAX) { wRemainder = LLONG_MAX - 1; - } else if ( w2 == LLONG_MIN ) { + } else if (w2 == LLONG_MIN) { /* * In C, a modulus operation is not well defined when the * divisor is a negative number. So w % LLONG_MIN is not * well defined in the code below because -LLONG_MIN is * still a negative number. */ + if (w == 0 || w == LLONG_MIN) { wRemainder = 0; } else if (w < 0) { @@ -4268,6 +4288,7 @@ TclExecuteByteCode(interp, codePtr) * the divisor in that case because the remainder should * not be negative. */ + if (wRemainder < 0 && !(neg_divisor && (w == LLONG_MIN))) { wRemainder += w2; } @@ -4281,21 +4302,23 @@ TclExecuteByteCode(interp, codePtr) break; } - if ( i == LONG_MIN && i2 == -1 ) { + if (i == LONG_MIN && i2 == -1) { /* * Integer overflow could happen with (LONG_MIN % -1) even * though it is not possible in the code below. */ + rem = 0; - } else if ( i == LONG_MIN && i2 == LONG_MAX ) { + } else if (i == LONG_MIN && i2 == LONG_MAX) { rem = LONG_MAX - 1; - } else if ( i2 == LONG_MIN ) { + } else if (i2 == LONG_MIN) { /* * In C, a modulus operation is not well defined when the * divisor is a negative number. So i % LONG_MIN is not well * defined in the code below because -LONG_MIN is still a * negative number. */ + if (i == 0 || i == LONG_MIN) { rem = 0; } else if (i < 0) { @@ -4318,6 +4341,7 @@ TclExecuteByteCode(interp, codePtr) * dividend and a negative divisor. Don't add the divisor in * that case because the remainder should not be negative. */ + if (rem < 0 && !(neg_divisor && (i == LONG_MIN))) { rem += i2; } @@ -4366,14 +4390,14 @@ TclExecuteByteCode(interp, codePtr) Tcl_Obj *valuePtr = *(tosPtr - 1); result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); - if ((result != TCL_OK) + if ((result != TCL_OK) #ifndef ACCEPT_NAN || (type1 == TCL_NUMBER_NAN) #endif ) { result = TCL_ERROR; TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", - O2S(value2Ptr), O2S(valuePtr), + O2S(value2Ptr), O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name: "null"))); IllegalExprOperandType(interp, pc, valuePtr); goto checkForCatch; @@ -4387,14 +4411,14 @@ TclExecuteByteCode(interp, codePtr) #endif result = GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2); - if ((result != TCL_OK) + if ((result != TCL_OK) #ifndef ACCEPT_NAN || (type2 == TCL_NUMBER_NAN) #endif ) { result = TCL_ERROR; TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", - O2S(value2Ptr), O2S(valuePtr), + O2S(value2Ptr), O2S(valuePtr), (value2Ptr->typePtr? value2Ptr->typePtr->name: "null"))); IllegalExprOperandType(interp, pc, value2Ptr); goto checkForCatch; @@ -4437,6 +4461,7 @@ TclExecuteByteCode(interp, codePtr) * we're on an IEEE box. Otherwise, this statement might cause * demons to fly out our noses. */ + dResult = d1 / d2; break; default: @@ -4488,7 +4513,7 @@ TclExecuteByteCode(interp, codePtr) } } - if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (*pc == INST_MULT) + if ((sizeof(Tcl_WideInt) >= 2*sizeof(long)) && (*pc == INST_MULT) && (type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { Tcl_WideInt w1, w2, wResult; TclGetWideIntFromObj(NULL, valuePtr, &w1); @@ -4505,9 +4530,9 @@ TclExecuteByteCode(interp, codePtr) Tcl_SetWideIntObj(valuePtr, wResult); TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); - } + } - if ((*pc != INST_MULT) + if ((*pc != INST_MULT) && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, wResult; TclGetWideIntFromObj(NULL, valuePtr, &w1); @@ -4615,7 +4640,7 @@ TclExecuteByteCode(interp, codePtr) mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); /* TODO: internals intrusion */ - if (!mp_iszero(&bigRemainder) + if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* Convert to Tcl's integer division rules */ mp_sub_d(&bigResult, 1, &bigResult); @@ -4672,7 +4697,7 @@ TclExecuteByteCode(interp, codePtr) } else if ((t1Ptr == &tclDoubleType) && (valuePtr->bytes == NULL)) { /* * We can only use the internal rep directly if there is no string - * rep. Otherwise the string rep might actually look like an + * rep. Otherwise the string rep might actually look like an * integer, which is preferred. */ @@ -4930,7 +4955,7 @@ TclExecuteByteCode(interp, codePtr) } #endif TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", - O2S(value2Ptr), O2S(valuePtr), + O2S(value2Ptr), O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name: "null"))); IllegalExprOperandType(interp, pc, valuePtr); goto checkForCatch; @@ -4946,7 +4971,7 @@ TclExecuteByteCode(interp, codePtr) } #endif TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", - O2S(value2Ptr), O2S(valuePtr), + O2S(value2Ptr), O2S(valuePtr), (value2Ptr->typePtr? value2Ptr->typePtr->name: "null"))); IllegalExprOperandType(interp, pc, value2Ptr); goto checkForCatch; @@ -5001,6 +5026,7 @@ TclExecuteByteCode(interp, codePtr) /* Both values are some kind of integer */ /* TODO: optimize use of narrower native integers */ mp_int big1, big2, bigResult, bigRemainder; + Tcl_GetBignumFromObj(NULL, valuePtr, &big1); Tcl_GetBignumFromObj(NULL, value2Ptr, &big2); mp_init(&bigResult); @@ -5015,7 +5041,7 @@ TclExecuteByteCode(interp, codePtr) } mp_init(&bigRemainder); mp_div(&big1, &big2, &bigResult, &bigRemainder); - if (!mp_iszero(&bigRemainder) + if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) { /* Convert to Tcl's integer division rules */ mp_sub_d(&bigResult, 1, &bigResult); @@ -5187,6 +5213,7 @@ TclExecuteByteCode(interp, codePtr) switch (type) { case TCL_NUMBER_DOUBLE: { double d; + if (Tcl_IsShared(valuePtr)) { TclNewDoubleObj(objResultPtr, -(*((CONST double *)ptr))); NEXT_INST_F(1, 1, 1); @@ -5317,7 +5344,7 @@ TclExecuteByteCode(interp, codePtr) * to make sure that "expr {0001}" yields "1", not "0001". * We implement this by _discarding_ the string rep since we * know it will be regenerated, if needed later, by formatting - * the internal rep's value. + * the internal rep's value. */ if (valuePtr->bytes == NULL) { TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr))); @@ -5477,6 +5504,7 @@ TclExecuteByteCode(interp, codePtr) valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { int setEmptyStr = 0; + if (valIndex >= listLen) { setEmptyStr = 1; TclNewObj(valuePtr); @@ -5796,6 +5824,7 @@ TclExecuteByteCode(interp, codePtr) /* * More complex because list-append can fail. */ + if (valPtr == NULL) { valPtr = Tcl_NewListObj(1, tosPtr); } else if (Tcl_IsShared(valPtr)) { @@ -5931,10 +5960,12 @@ TclExecuteByteCode(interp, codePtr) Tcl_DictObjDone(searchPtr); ckfree((char *) searchPtr); } + /* - * Set the internal variable to an empty object to signify - * that we don't hold an iterator. + * Set the internal variable to an empty object to signify that we + * don't hold an iterator. */ + Tcl_DecrRefCount(statePtr); TclNewObj(emptyPtr); compiledLocals[opnd].value.objPtr = emptyPtr; @@ -6035,7 +6066,7 @@ TclExecuteByteCode(interp, codePtr) allocdict = Tcl_IsShared(dictPtr); if (allocdict) { dictPtr = Tcl_DuplicateObj(dictPtr); - } + } for (i=0 ; iprocPtr; @@ -6426,16 +6457,16 @@ PrintByteCodeInfo(codePtr) #ifdef TCL_COMPILE_DEBUG static void -ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack) - register ByteCode *codePtr; /* The bytecode whose summary is printed to +ValidatePcAndStackTop( + register ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ - unsigned char *pc; /* Points to first byte of a bytecode + unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ - int stackTop; /* Current stack top. Must be between + int stackTop, /* Current stack top. Must be between * stackLowerBound and stackUpperBound * (inclusive). */ - int stackLowerBound; /* Smallest legal value for stackTop. */ - int checkStack; /* 0 if the stack depth check should be + int stackLowerBound, /* Smallest legal value for stackTop. */ + int checkStack) /* 0 if the stack depth check should be * skipped. */ { int stackUpperBound = stackLowerBound + codePtr->maxStackDepth; @@ -6496,12 +6527,12 @@ ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, checkStack) */ static void -IllegalExprOperandType(interp, pc, opndPtr) - Tcl_Interp *interp; /* Interpreter to which error information +IllegalExprOperandType( + Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - unsigned char *pc; /* Points to the instruction being executed + unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ - Tcl_Obj *opndPtr; /* Points to the operand holding the value + Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ { ClientData ptr; @@ -6563,14 +6594,14 @@ IllegalExprOperandType(interp, pc, opndPtr) */ static char * -GetSrcInfoForPc(pc, codePtr, lengthPtr) - unsigned char *pc; /* The program counter value for which to +GetSrcInfoForPc( + unsigned char *pc, /* The program counter value for which to * return the closest command's source info. * This points to a bytecode instruction in * codePtr's code. */ - ByteCode *codePtr; /* The bytecode sequence in which to look up + ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ - int *lengthPtr; /* If non-NULL, the location where the length + int *lengthPtr) /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ { @@ -6685,16 +6716,16 @@ GetSrcInfoForPc(pc, codePtr, lengthPtr) */ static ExceptionRange * -GetExceptRangeForPc(pc, catchOnly, codePtr) - unsigned char *pc; /* The program counter value for which to +GetExceptRangeForPc( + unsigned char *pc, /* The program counter value for which to * search for a closest enclosing exception * range. This points to a bytecode * instruction in codePtr's code. */ - int catchOnly; /* If 0, consider either loop or catch + int catchOnly, /* If 0, consider either loop or catch * ExceptionRanges in search. If nonzero * consider only catch ranges (and ignore any * closer loop ranges). */ - ByteCode* codePtr; /* Points to the ByteCode in which to search + ByteCode* codePtr) /* Points to the ByteCode in which to search * for the enclosing ExceptionRange. */ { ExceptionRange *rangeArrayPtr; @@ -6748,8 +6779,8 @@ GetExceptRangeForPc(pc, catchOnly, codePtr) #ifdef TCL_COMPILE_DEBUG static char * -GetOpcodeName(pc) - unsigned char *pc; /* Points to the instruction whose name should +GetOpcodeName( + unsigned char *pc) /* Points to the instruction whose name should * be returned. */ { unsigned char opCode = *pc; @@ -6758,7 +6789,6 @@ GetOpcodeName(pc) } #endif /* TCL_COMPILE_DEBUG */ - /* *---------------------------------------------------------------------- * @@ -6777,9 +6807,9 @@ GetOpcodeName(pc) */ void -TclExprFloatError(interp, value) - Tcl_Interp *interp; /* Where to store error message. */ - double value; /* Value returned after error; used to +TclExprFloatError( + Tcl_Interp *interp, /* Where to store error message. */ + double value) /* Value returned after error; used to * distinguish underflows from overflows. */ { CONST char *s; @@ -6802,7 +6832,7 @@ TclExprFloatError(interp, value) Tcl_Obj *objPtr = Tcl_NewObj(); TclObjPrintf(NULL, objPtr, "unknown floating-point error, errno = %d", errno); - Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", + Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", Tcl_GetString(objPtr), (char *) NULL); Tcl_SetObjResult(interp, objPtr); } @@ -6828,8 +6858,8 @@ TclExprFloatError(interp, value) */ int -TclLog2(value) - register int value; /* The integer for which to compute the log +TclLog2( + register int value) /* The integer for which to compute the log * base 2. */ { register int n = value; @@ -6860,11 +6890,11 @@ TclLog2(value) */ static int -EvalStatsCmd(unused, interp, objc, objv) - ClientData unused; /* Unused. */ - Tcl_Interp *interp; /* The current interpreter. */ - int objc; /* The number of arguments. */ - Tcl_Obj *CONST objv[]; /* The argument strings. */ +EvalStatsCmd( + ClientData unused, /* Unused. */ + Tcl_Interp *interp, /* The current interpreter. */ + int objc, /* The number of arguments. */ + Tcl_Obj *CONST objv[]) /* The argument strings. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &(iPtr->literalTable); @@ -7263,8 +7293,8 @@ EvalStatsCmd(unused, interp, objc, objv) */ static char * -StringForResultCode(result) - int result; /* The Tcl result code for which to generate a +StringForResultCode( + int result) /* The Tcl result code for which to generate a * string. */ { static char buf[TCL_INTEGER_SPACE]; @@ -7296,10 +7326,10 @@ StringForResultCode(result) */ static Tcl_WideInt -ExponWide(w, w2, errExpon) - Tcl_WideInt w; /* The value that must be exponentiated */ - Tcl_WideInt w2; /* The exponent */ - int *errExpon; /* Error code */ +ExponWide( + Tcl_WideInt w, /* The value that must be exponentiated */ + Tcl_WideInt w2, /* The exponent */ + int *errExpon) /* Error code */ { Tcl_WideInt result; @@ -7362,10 +7392,10 @@ ExponWide(w, w2, errExpon) */ static long -ExponLong(i, i2, errExpon) - long i; /* The value that must be exponentiated */ - long i2; /* The exponent */ - int *errExpon; /* Error code */ +ExponLong( + long i, /* The value that must be exponentiated */ + long i2, /* The exponent */ + int *errExpon) /* Error code */ { long result; @@ -7413,3 +7443,11 @@ ExponLong(i, i2, errExpon) return result * i; } #endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclScan.c b/generic/tclScan.c index 327bc2f..ff89fc4 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclScan.c,v 1.20 2005/10/19 18:39:58 dgp Exp $ + * RCS: @(#) $Id: tclScan.c,v 1.21 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" @@ -45,11 +45,11 @@ typedef struct CharSet { * Declarations for functions used only in this file. */ -static char * BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format)); -static int CharInSet _ANSI_ARGS_((CharSet *cset, int ch)); -static void ReleaseCharSet _ANSI_ARGS_((CharSet *cset)); -static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format, - int numVars, int *totalVars)); +static char * BuildCharSet(CharSet *cset, char *format); +static int CharInSet(CharSet *cset, int ch); +static void ReleaseCharSet(CharSet *cset); +static int ValidateFormat(Tcl_Interp *interp, char *format, + int numVars, int *totalVars); /* *---------------------------------------------------------------------- @@ -70,9 +70,9 @@ static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format, */ static char * -BuildCharSet(cset, format) - CharSet *cset; - char *format; /* Points to first char of set. */ +BuildCharSet( + CharSet *cset, + char *format) /* Points to first char of set. */ { Tcl_UniChar ch, start; int offset, nranges; @@ -103,8 +103,8 @@ BuildCharSet(cset, format) end += Tcl_UtfToUniChar(end, &ch); } - cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar) - * (end - format - 1)); + cset->chars = (Tcl_UniChar *) + ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges); } else { @@ -181,13 +181,14 @@ BuildCharSet(cset, format) */ static int -CharInSet(cset, c) - CharSet *cset; - int c; /* Character to test, passed as int because of +CharInSet( + CharSet *cset, + int c) /* Character to test, passed as int because of * non-ANSI prototypes. */ { Tcl_UniChar ch = (Tcl_UniChar) c; int i, match = 0; + for (i = 0; i < cset->nchars; i++) { if (cset->chars[i] == ch) { match = 1; @@ -196,8 +197,7 @@ CharInSet(cset, c) } if (!match) { for (i = 0; i < cset->nranges; i++) { - if ((cset->ranges[i].start <= ch) - && (ch <= cset->ranges[i].end)) { + if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) { match = 1; break; } @@ -223,8 +223,8 @@ CharInSet(cset, c) */ static void -ReleaseCharSet(cset) - CharSet *cset; +ReleaseCharSet( + CharSet *cset) { ckfree((char *)cset->chars); if (cset->ranges) { @@ -250,12 +250,12 @@ ReleaseCharSet(cset) */ static int -ValidateFormat(interp, format, numVars, totalSubs) - Tcl_Interp *interp; /* Current interpreter. */ - char *format; /* The format string. */ - int numVars; /* The number of variables passed to the scan +ValidateFormat( + Tcl_Interp *interp, /* Current interpreter. */ + char *format, /* The format string. */ + int numVars, /* The number of variables passed to the scan * command. */ - int *totalSubs; /* The number of variables that will be + int *totalSubs) /* The number of variables that will be * required. */ { #define STATIC_LIST_SIZE 16 @@ -301,14 +301,14 @@ ValidateFormat(interp, format, numVars, totalSubs) goto xpgCheckDone; } - if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ + if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ /* * Check for an XPG3-style %n$ specification. Note: there must * not be a mixture of XPG3 specs and non-XPG3 specs in the same * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } @@ -348,8 +348,8 @@ ValidateFormat(interp, format, numVars, totalSubs) * Parse any width specifier. */ - if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */ + if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ + value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */ flags |= SCAN_WIDTH; format += Tcl_UtfToUniChar(format, &ch); } @@ -478,12 +478,11 @@ ValidateFormat(interp, format, numVars, totalSubs) nspace += STATIC_LIST_SIZE; } if (nassign == staticAssign) { - nassign = (void *)ckalloc(nspace * sizeof(int)); - for (i = 0; i < STATIC_LIST_SIZE; ++i) { - nassign[i] = staticAssign[i]; - } + nassign = (void *) ckalloc(nspace * sizeof(int)); + memcpy((void *) nassign, (void *) staticAssign, + sizeof(staticAssign)); } else { - nassign = (void *)ckrealloc((void *)nassign, + nassign = (void *) ckrealloc((void *)nassign, nspace * sizeof(int)); } for (i = value; i < nspace; i++) { @@ -570,11 +569,11 @@ ValidateFormat(interp, format, numVars, totalSubs) /* ARGSUSED */ int -Tcl_ScanObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_ScanObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *format; int numVars, nconversions, totalVars = -1; @@ -898,7 +897,11 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (TclParseNumber(NULL, objPtr, NULL, string, width, &end, TCL_PARSE_INTEGER_ONLY | parseFlag) != TCL_OK) { Tcl_DecrRefCount(objPtr); - /* TODO: set underflow? test scan-4.44 */ + + /* + * TODO: set underflow? test scan-4.44 + */ + goto done; } string = end; @@ -949,8 +952,11 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) width = -1; } if (TclParseNumber(NULL, objPtr, NULL, string, width, &end, - TCL_PARSE_DECIMAL_ONLY) != TCL_OK) { - /* TODO: set underflow? test scan-4.55 */ + TCL_PARSE_DECIMAL_ONLY) != TCL_OK) { + /* + * TODO: set underflow? test scan-4.55 + */ + Tcl_DecrRefCount(objPtr); goto done; } else if (flags & SCAN_SUPPRESS) { @@ -965,8 +971,8 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) } else #endif { - Tcl_DecrRefCount(objPtr); - goto done; + Tcl_DecrRefCount(objPtr); + goto done; } } Tcl_SetDoubleObj(objPtr, dvalue); @@ -993,7 +999,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) result++; if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", - TclGetString(objv[i+3]), "\"", (char *) NULL); + TclGetString(objv[i+3]), "\"", NULL); code = TCL_ERROR; } Tcl_DecrRefCount(objs[i]); diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 5790237..fa8f949 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.50 2005/10/09 20:05:27 msofer Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.51 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -42,29 +42,24 @@ * Prototypes for functions defined later in this file: */ -static void AppendUnicodeToUnicodeRep _ANSI_ARGS_(( - Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, - int appendNumChars)); -static void AppendUnicodeToUtfRep _ANSI_ARGS_(( - Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, - int numChars)); -static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr, - CONST char *bytes, int numBytes)); -static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr, - CONST char *bytes, int numBytes)); -static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static int FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, CONST char *format, - va_list argList)); -static int ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, CONST char *format, - va_list argList)); -static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, - Tcl_Obj *copyPtr)); -static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); -static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, + CONST Tcl_UniChar *unicode, int appendNumChars); +static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, + CONST Tcl_UniChar *unicode, int numChars); +static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, + CONST char *bytes, int numBytes); +static void AppendUtfToUtfRep(Tcl_Obj *objPtr, + CONST char *bytes, int numBytes); +static void FillUnicodeRep(Tcl_Obj *objPtr); +static int FormatObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr, + CONST char *format, va_list argList); +static int ObjPrintfVA(Tcl_Interp *interp, Tcl_Obj *objPtr, + CONST char *format, va_list argList); +static void FreeStringInternalRep(Tcl_Obj *objPtr); +static void DupStringInternalRep(Tcl_Obj *objPtr, + Tcl_Obj *copyPtr); +static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfString(Tcl_Obj *objPtr); /* * The structure below defines the string Tcl object type by means of @@ -114,12 +109,12 @@ typedef struct String { #define STRING_UALLOC(numChars) \ (numChars * sizeof(Tcl_UniChar)) -#define STRING_SIZE(ualloc) \ +#define STRING_SIZE(ualloc) \ ((unsigned) (sizeof(String) - sizeof(Tcl_UniChar) + ualloc)) #define GET_STRING(objPtr) \ ((String *) (objPtr)->internalRep.otherValuePtr) #define SET_STRING(objPtr, stringPtr) \ - ((objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)) + ((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr)) /* * TCL STRING GROWTH ALGORITHM @@ -177,9 +172,9 @@ typedef struct String { * Side effects: * The new object's internal string representation will be set to a copy * of the length bytes starting at "bytes". If "length" is negative, use - * bytes up to the first NULL byte; i.e., assume "bytes" points to a - * C-style NULL-terminated string. The object's type is set to NULL. An - * extra NULL is added to the end of the new object's byte array. + * bytes up to the first NUL byte; i.e., assume "bytes" points to a + * C-style NUL-terminated string. The object's type is set to NULL. An + * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ @@ -187,24 +182,24 @@ typedef struct String { #ifdef TCL_MEM_DEBUG #undef Tcl_NewStringObj Tcl_Obj * -Tcl_NewStringObj(bytes, length) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_NewStringObj( + CONST char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" + int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NULL + * negative, use bytes up to the first NUL * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * -Tcl_NewStringObj(bytes, length) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_NewStringObj( + CONST char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" + int length) /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NULL + * negative, use bytes up to the first NUL * byte. */ { register Tcl_Obj *objPtr; @@ -239,25 +234,25 @@ Tcl_NewStringObj(bytes, length) * Side effects: * The new object's internal string representation will be set to a copy * of the length bytes starting at "bytes". If "length" is negative, use - * bytes up to the first NULL byte; i.e., assume "bytes" points to a - * C-style NULL-terminated string. The object's type is set to NULL. An - * extra NULL is added to the end of the new object's byte array. + * bytes up to the first NUL byte; i.e., assume "bytes" points to a + * C-style NUL-terminated string. The object's type is set to NULL. An + * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * -Tcl_DbNewStringObj(bytes, length, file, line) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_DbNewStringObj( + CONST char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" + int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NULL + * negative, use bytes up to the first NUL * byte. */ - CONST char *file; /* The name of the source file calling this + CONST char *file, /* The name of the source file calling this * function; used for debugging. */ - int line; /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { register Tcl_Obj *objPtr; @@ -271,16 +266,16 @@ Tcl_DbNewStringObj(bytes, length, file, line) } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * -Tcl_DbNewStringObj(bytes, length, file, line) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_DbNewStringObj( + CONST char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - register int length; /* The number of bytes to copy from "bytes" + register int length, /* The number of bytes to copy from "bytes" * when initializing the new object. If - * negative, use bytes up to the first NULL + * negative, use bytes up to the first NUL * byte. */ - CONST char *file; /* The name of the source file calling this + CONST char *file, /* The name of the source file calling this * function; used for debugging. */ - int line; /* Line number in the source file; used for + int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewStringObj(bytes, length); @@ -293,7 +288,7 @@ Tcl_DbNewStringObj(bytes, length, file, line) * Tcl_NewUnicodeObj -- * * This function is creates a new String object and initializes it from - * the given Unicode String. If the Utf String is the same size as the + * the given Unicode String. If the Utf String is the same size as the * Unicode string, don't duplicate the data. * * Results: @@ -307,10 +302,10 @@ Tcl_DbNewStringObj(bytes, length, file, line) */ Tcl_Obj * -Tcl_NewUnicodeObj(unicode, numChars) - CONST Tcl_UniChar *unicode; /* The unicode string used to initialize the +Tcl_NewUnicodeObj( + CONST Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ - int numChars; /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; @@ -340,7 +335,7 @@ Tcl_NewUnicodeObj(unicode, numChars) stringPtr->uallocated = uallocated; stringPtr->hasUnicode = (numChars > 0); stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); + memcpy((void *) stringPtr->unicode, (void *) unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); return objPtr; @@ -364,8 +359,8 @@ Tcl_NewUnicodeObj(unicode, numChars) */ int -Tcl_GetCharLength(objPtr) - Tcl_Obj *objPtr; /* The String object to get the num chars +Tcl_GetCharLength( + Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; @@ -447,10 +442,10 @@ Tcl_GetCharLength(objPtr) */ Tcl_UniChar -Tcl_GetUniChar(objPtr, index) - Tcl_Obj *objPtr; /* The object to get the Unicode charater +Tcl_GetUniChar( + Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - int index; /* Get the index'th Unicode character. */ + int index) /* Get the index'th Unicode character. */ { Tcl_UniChar unichar; String *stringPtr; @@ -507,8 +502,8 @@ Tcl_GetUniChar(objPtr, index) */ Tcl_UniChar * -Tcl_GetUnicode(objPtr) - Tcl_Obj *objPtr; /* The object to find the unicode string +Tcl_GetUnicode( + Tcl_Obj *objPtr) /* The object to find the unicode string * for. */ { String *stringPtr; @@ -557,10 +552,10 @@ Tcl_GetUnicode(objPtr) */ Tcl_UniChar * -Tcl_GetUnicodeFromObj(objPtr, lengthPtr) - Tcl_Obj *objPtr; /* The object to find the unicode string +Tcl_GetUnicodeFromObj( + Tcl_Obj *objPtr, /* The object to find the unicode string * for. */ - int *lengthPtr; /* If non-NULL, the location where the string + int *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { @@ -614,10 +609,10 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr) */ Tcl_Obj * -Tcl_GetRange(objPtr, first, last) - Tcl_Obj *objPtr; /* The Tcl object to find the range of. */ - int first; /* First index of the range. */ - int last; /* Last index of the range. */ +Tcl_GetRange( + Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ + int first, /* First index of the range. */ + int last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; @@ -681,21 +676,21 @@ Tcl_GetRange(objPtr, first, last) * Side effects: * The object's string representation will be set to a copy of the * "length" bytes starting at "bytes". If "length" is negative, use bytes - * up to the first NULL byte; i.e., assume "bytes" points to a C-style - * NULL-terminated string. The object's old string and internal + * up to the first NUL byte; i.e., assume "bytes" points to a C-style + * NUL-terminated string. The object's old string and internal * representations are freed and the object's type is set NULL. * *---------------------------------------------------------------------- */ void -Tcl_SetStringObj(objPtr, bytes, length) - register Tcl_Obj *objPtr; /* Object whose internal rep to init. */ - CONST char *bytes; /* Points to the first of the length bytes +Tcl_SetStringObj( + register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + CONST char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - register int length; /* The number of bytes to copy from "bytes" + register int length) /* The number of bytes to copy from "bytes" * when initializing the object. If negative, - * use bytes up to the first NULL byte.*/ + * use bytes up to the first NUL byte.*/ { /* * Free any old string rep, then set the string rep to a copy of the @@ -744,10 +739,10 @@ Tcl_SetStringObj(objPtr, bytes, length) */ void -Tcl_SetObjLength(objPtr, length) - register Tcl_Obj *objPtr; /* Pointer to object. This object must not +Tcl_SetObjLength( + register Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - register int length; /* Number of bytes desired for string + register int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -779,7 +774,7 @@ Tcl_SetObjLength(objPtr, length) } else { new = (char *) ckalloc((unsigned) (length+1)); if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((VOID *) new, (VOID *) objPtr->bytes, + memcpy((void *) new, (void *) objPtr->bytes, (size_t) objPtr->length); Tcl_InvalidateStringRep(objPtr); } @@ -798,7 +793,7 @@ Tcl_SetObjLength(objPtr, length) objPtr->length = length; if (objPtr->bytes != tclEmptyStringRep) { /* - * Ensure the string is NULL-terminated. + * Ensure the string is NUL-terminated. */ objPtr->bytes[length] = 0; @@ -827,7 +822,7 @@ Tcl_SetObjLength(objPtr, length) stringPtr->hasUnicode = (length > 0); /* - * Ensure the string is NULL-terminated. + * Ensure the string is NUL-terminated. */ stringPtr->unicode[length] = 0; @@ -860,10 +855,10 @@ Tcl_SetObjLength(objPtr, length) */ int -Tcl_AttemptSetObjLength(objPtr, length) - register Tcl_Obj *objPtr; /* Pointer to object. This object must not +Tcl_AttemptSetObjLength( + register Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - register int length; /* Number of bytes desired for string + register int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -901,7 +896,7 @@ Tcl_AttemptSetObjLength(objPtr, length) return 0; } if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((VOID *) new, (VOID *) objPtr->bytes, + memcpy((void *) new, (void *) objPtr->bytes, (size_t) objPtr->length); Tcl_InvalidateStringRep(objPtr); } @@ -952,7 +947,7 @@ Tcl_AttemptSetObjLength(objPtr, length) stringPtr->hasUnicode = (length > 0); /* - * Ensure the string is NULL-terminated. + * Ensure the string is NUL-terminated. */ stringPtr->unicode[length] = 0; @@ -979,11 +974,11 @@ Tcl_AttemptSetObjLength(objPtr, length) */ void -Tcl_SetUnicodeObj(objPtr, unicode, numChars) - Tcl_Obj *objPtr; /* The object to set the string of. */ - CONST Tcl_UniChar *unicode; /* The unicode string used to initialize the +Tcl_SetUnicodeObj( + Tcl_Obj *objPtr, /* The object to set the string of. */ + CONST Tcl_UniChar *unicode, /* The unicode string used to initialize the * object. */ - int numChars; /* Number of characters in the unicode + int numChars) /* Number of characters in the unicode * string. */ { String *stringPtr; @@ -1015,7 +1010,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars) stringPtr->uallocated = uallocated; stringPtr->hasUnicode = (numChars > 0); stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); + memcpy((void *) stringPtr->unicode, (void *) unicode, uallocated); stringPtr->unicode[numChars] = 0; SET_STRING(objPtr, stringPtr); @@ -1042,16 +1037,16 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars) */ void -TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis) - register Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* Points to the bytes to append to the +TclAppendLimitedToObj( + register Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST char *bytes, /* Points to the bytes to append to the * object. */ - register int length; /* The number of bytes available to be + register int length, /* The number of bytes available to be * appended from "bytes". If < 0, then all - * bytes up to a NULL byte are available. */ - register int limit; /* The maximum number of bytes to append to + * bytes up to a NUL byte are available. */ + register int limit, /* The maximum number of bytes to append to * the object. */ - CONST char *ellipsis; /* Ellipsis marker string, appended to the + CONST char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { @@ -1123,12 +1118,12 @@ TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis) */ void -Tcl_AppendToObj(objPtr, bytes, length) - register Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* Points to the bytes to append to the +Tcl_AppendToObj( + register Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST char *bytes, /* Points to the bytes to append to the * object. */ - register int length; /* The number of bytes to append from "bytes". - * If < 0, then append all bytes up to NULL + register int length) /* The number of bytes to append from "bytes". + * If < 0, then append all bytes up to NUL * byte. */ { TclAppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); @@ -1152,11 +1147,11 @@ Tcl_AppendToObj(objPtr, bytes, length) */ void -Tcl_AppendUnicodeToObj(objPtr, unicode, length) - register Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* The unicode string to append to the +Tcl_AppendUnicodeToObj( + register Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST Tcl_UniChar *unicode, /* The unicode string to append to the * object. */ - int length; /* Number of chars in "unicode". */ + int length) /* Number of chars in "unicode". */ { String *stringPtr; @@ -1203,9 +1198,9 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length) */ void -Tcl_AppendObjToObj(objPtr, appendObjPtr) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - Tcl_Obj *appendObjPtr; /* Object to append. */ +Tcl_AppendObjToObj( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; int length, numChars, allOneByteChars; @@ -1288,10 +1283,10 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr) */ static void -AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* String to append. */ - int appendNumChars; /* Number of chars of "unicode" to append. */ +AppendUnicodeToUnicodeRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST Tcl_UniChar *unicode, /* String to append. */ + int appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr, *tmpString; size_t numChars; @@ -1341,7 +1336,7 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) * trailing null. */ - memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode, + memcpy((void*) (stringPtr->unicode + stringPtr->numChars), unicode, appendNumChars * sizeof(Tcl_UniChar)); stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; @@ -1367,10 +1362,10 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) */ static void -AppendUnicodeToUtfRep(objPtr, unicode, numChars) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* String to convert to UTF. */ - int numChars; /* Number of chars of "unicode" to convert. */ +AppendUnicodeToUtfRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST Tcl_UniChar *unicode, /* String to convert to UTF. */ + int numChars) /* Number of chars of "unicode" to convert. */ { Tcl_DString dsPtr; CONST char *bytes; @@ -1412,10 +1407,10 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars) */ static void -AppendUtfToUnicodeRep(objPtr, bytes, numBytes) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* String to convert to Unicode. */ - int numBytes; /* Number of bytes of "bytes" to convert. */ +AppendUtfToUnicodeRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST char *bytes, /* String to convert to Unicode. */ + int numBytes) /* Number of bytes of "bytes" to convert. */ { Tcl_DString dsPtr; int numChars; @@ -1453,10 +1448,10 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes) */ static void -AppendUtfToUtfRep(objPtr, bytes, numBytes) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* String to append. */ - int numBytes; /* Number of bytes of "bytes" to append. */ +AppendUtfToUtfRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + CONST char *bytes, /* String to append. */ + int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; int newLength, oldLength; @@ -1499,7 +1494,7 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes) stringPtr->numChars = -1; stringPtr->hasUnicode = 0; - memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes, + memcpy((void *) (objPtr->bytes + oldLength), (void *) bytes, (size_t) numBytes); objPtr->bytes[newLength] = 0; objPtr->length = newLength; @@ -1524,9 +1519,9 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes) */ void -Tcl_AppendStringsToObjVA (objPtr, argList) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - va_list argList; /* Variable argument list. */ +Tcl_AppendStringsToObjVA( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + va_list argList) /* Variable argument list. */ { #define STATIC_LIST_SIZE 16 String *stringPtr; @@ -1667,7 +1662,9 @@ Tcl_AppendStringsToObjVA (objPtr, argList) */ void -Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) +Tcl_AppendStringsToObj( + Tcl_Obj *objPtr, + ...) { va_list argList; @@ -1681,10 +1678,10 @@ Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) * * TclAppendFormattedObjs -- * - * This function appends a list of Tcl_Obj's to a Tcl_Obj according - * to the formatting instructions embedded in the format string. The - * formatting instructions are inspired by sprintf(). Returns TCL_OK - * when successful. If there's an error in the arguments, TCL_ERROR is + * This function appends a list of Tcl_Obj's to a Tcl_Obj according to + * the formatting instructions embedded in the format string. The + * formatting instructions are inspired by sprintf(). Returns TCL_OK when + * successful. If there's an error in the arguments, TCL_ERROR is * returned, and an error message is written to the interp, if non-NULL. * * Results: @@ -1697,12 +1694,12 @@ Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...) */ int -TclAppendFormattedObjs(interp, appendObj, format, objc, objv) - Tcl_Interp *interp; - Tcl_Obj *appendObj; - CONST char *format; - int objc; - Tcl_Obj *CONST objv[]; +TclAppendFormattedObjs( + Tcl_Interp *interp, + Tcl_Obj *appendObj, + CONST char *format, + int objc, + Tcl_Obj *CONST objv[]) { CONST char *span = format; int numBytes = 0; @@ -1710,7 +1707,8 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) int gotXpg = 0, gotSequential = 0; int originalLength; CONST char *msg; - CONST char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; + CONST char *mixedXPG = + "cannot mix \"%\" and \"%n$\" conversion specifiers"; CONST char *badIndex[2] = { "not enough arguments for all format specifiers", "\"%n$\" argument index out of range" @@ -1721,7 +1719,10 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } Tcl_GetStringFromObj(appendObj, &originalLength); - /* format string is NUL-terminated */ + /* + * Format string is NUL-terminated. + */ + while (*format != '\0') { char *end; int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag; @@ -1741,8 +1742,11 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) numBytes = 0; } - /* Saw a % : process the format specifier */ - /* 0. %% : Escape format handling */ + /* + * Saw a % : process the format specifier. + * + * Step 0. Handle special case of escaped format marker (i.e., %%). + */ step = Tcl_UtfToUniChar(format, &ch); if (ch == '%') { @@ -1752,7 +1756,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) continue; } - /* 1. XPG3 position specifier */ + /* + * Step 1. XPG3 position specifier + */ newXpg = 0; if (isdigit(UCHAR(ch))) { @@ -1782,7 +1788,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) goto errorMsg; } - /* 2. Set of flags */ + /* + * Step 2. Set of flags. + */ gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0; sawFlag = 1; @@ -1812,7 +1820,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } } while (sawFlag); - /* 3. Minimum field width */ + /* + * Step 3. Minimum field width. + */ width = 0; if (isdigit(UCHAR(ch))) { @@ -1836,7 +1846,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) step = Tcl_UtfToUniChar(format, &ch); } - /* 4. Precision */ + /* + * Step 4. Precision. + */ gotPrecision = precision = 0; if (ch == '.') { @@ -1857,7 +1869,11 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) != TCL_OK) { goto error; } - /* TODO: Check this truncation logic */ + + /* + * TODO: Check this truncation logic. + */ + if (precision < 0) { precision = 0; } @@ -1866,7 +1882,9 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) step = Tcl_UtfToUniChar(format, &ch); } - /* 5. Length modifier */ + /* + * Step 5. Length modifier. + */ useShort = useWide = useBig = 0; if (ch == 'h') { @@ -1882,7 +1900,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) step = Tcl_UtfToUniChar(format, &ch); } else { #ifndef TCL_WIDE_INT_IS_LONG - useWide = 1; + useWide = 1; #endif } } @@ -1890,7 +1908,10 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) format += step; span = format; - /* 6. Conversion character */ + /* + * Step 6. The actual conversion character. + */ + segment = objv[objIndex]; if (ch == 'i') { ch = 'd'; @@ -1920,7 +1941,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) allocSegment = 1; break; } - + case 'u': if (useBig) { msg = "unsigned bignum format is invalid"; @@ -1930,8 +1951,8 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) case 'o': case 'x': case 'X': { - short int s = 0; /* Silence compiler warning; only defined and - * used when useShort is true. */ + short int s = 0; /* Silence compiler warning; only defined and + * used when useShort is true. */ long l; Tcl_WideInt w; mp_int big; @@ -1945,10 +1966,11 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } else if (useWide) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; - if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { + + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { goto error; } - mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big); + mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big); objPtr = Tcl_NewBignumObj(&big); Tcl_IncrRefCount(objPtr); Tcl_GetWideIntFromObj(NULL, objPtr, &w); @@ -1958,7 +1980,8 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } else if (Tcl_GetLongFromObj(NULL, segment, &l) != TCL_OK) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; - if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { + + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { goto error; } mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); @@ -1975,27 +1998,19 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } else { isNegative = (l < (long)0); } + } else if (useShort) { + s = (short int) l; + isNegative = (s < (short int)0); } else { - if (useShort) { - s = (short int) l; - isNegative = (s < (short int)0); - } else { - isNegative = (l < (long)0); - } + isNegative = (l < (long)0); } segment = Tcl_NewObj(); allocSegment = 1; Tcl_IncrRefCount(segment); - if (isNegative || gotPlus) { - if (useBig || (ch == 'd')) { - if (isNegative) { - Tcl_AppendToObj(segment, "-", 1); - } else { - Tcl_AppendToObj(segment, "+", 1); - } - } + if ((isNegative || gotPlus) && (useBig || (ch == 'd'))) { + Tcl_AppendToObj(segment, (isNegative ? "-" : "+"), 1); } if (gotHash) { @@ -2028,13 +2043,22 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } Tcl_IncrRefCount(pure); bytes = Tcl_GetStringFromObj(pure, &length); - /* Already did the sign above */ + + /* + * Already did the sign above. + */ + if (*bytes == '-') { - length--; bytes++; + length--; + bytes++; } - /* Canonical decimal string reps for integers are composed - * entirely of one-byte encoded characters, so "length" is - * the number of chars */ + + /* + * Canonical decimal string reps for integers are composed + * entirely of one-byte encoded characters, so "length" is the + * number of chars. + */ + if (gotPrecision) { while (length < precision) { Tcl_AppendToObj(segment, "0", 1); @@ -2053,7 +2077,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) Tcl_DecrRefCount(pure); break; } - + case 'u': case 'o': case 'x': @@ -2073,6 +2097,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } if (useShort) { unsigned short int us = (unsigned short int) s; + bits = (Tcl_WideUInt) us; while (us) { numDigits++; @@ -2080,6 +2105,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } } else if (useWide) { Tcl_WideUInt uw = (Tcl_WideUInt) w; + bits = uw; while (uw) { numDigits++; @@ -2088,6 +2114,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } else if (useBig) { int leftover = (big.used * DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); + numDigits = 1 + ((big.used * DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; @@ -2095,13 +2122,18 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) } } else { unsigned long int ul = (unsigned long int) l; + bits = (Tcl_WideUInt) ul; while (ul) { numDigits++; ul /= base; } } - /* Need to be sure zero becomes "0", not "" */ + + /* + * Need to be sure zero becomes "0", not "". + */ + if ((numDigits == 0) && !((ch == 'o') && gotHash)) { numDigits = 1; } @@ -2111,6 +2143,7 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv) length = numDigits; while (numDigits--) { int digitOffset; + if (useBig) { if (shiftuallocated)); copyStringPtr->uallocated = srcStringPtr->uallocated; - memcpy((VOID *) copyStringPtr->unicode, - (VOID *) srcStringPtr->unicode, + memcpy((void *) copyStringPtr->unicode, + (void *) srcStringPtr->unicode, (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; } @@ -2643,9 +2697,9 @@ DupStringInternalRep(srcPtr, copyPtr) */ static int -SetStringFromAny(interp, objPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr; /* The object to convert. */ +SetStringFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr) /* The object to convert. */ { /* * The Unicode object is optimized for the case where each UTF char in a @@ -2703,8 +2757,8 @@ SetStringFromAny(interp, objPtr) */ static void -UpdateStringOfString(objPtr) - Tcl_Obj *objPtr; /* Object with string rep to update. */ +UpdateStringOfString( + Tcl_Obj *objPtr) /* Object with string rep to update. */ { int i, size; Tcl_UniChar *unicode; @@ -2768,8 +2822,8 @@ UpdateStringOfString(objPtr) */ static void -FreeStringInternalRep(objPtr) - Tcl_Obj *objPtr; /* Object with internal rep to free. */ +FreeStringInternalRep( + Tcl_Obj *objPtr) /* Object with internal rep to free. */ { ckfree((char *) GET_STRING(objPtr)); } diff --git a/generic/tclThread.c b/generic/tclThread.c index 17dd0ad..c5def48 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -1,4 +1,4 @@ -/* +/* * tclThread.c -- * * This file implements Platform independent thread operations. Most of @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThread.c,v 1.13 2005/08/11 22:06:47 kennykb Exp $ + * RCS: @(#) $Id: tclThread.c,v 1.14 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" @@ -36,13 +36,12 @@ static SyncObjRecord condRecord = {0, 0, NULL}; /* * Prototypes of functions used only in this file. */ - -static void RememberSyncObject _ANSI_ARGS_((char *objPtr, - SyncObjRecord *recPtr)); -static void ForgetSyncObject _ANSI_ARGS_((char *objPtr, - SyncObjRecord *recPtr)); -/* +static void ForgetSyncObject(char *objPtr, SyncObjRecord *recPtr); +static void RememberSyncObject(char *objPtr, + SyncObjRecord *recPtr); + +/* * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not * specified. Here we undo that so the functions are defined in the stubs * table. @@ -56,7 +55,6 @@ static void ForgetSyncObject _ANSI_ARGS_((char *objPtr, #undef Tcl_ConditionWait #undef Tcl_ConditionFinalize #endif - /* *---------------------------------------------------------------------- @@ -76,12 +74,12 @@ static void ForgetSyncObject _ANSI_ARGS_((char *objPtr, *---------------------------------------------------------------------- */ -VOID * -Tcl_GetThreadData(keyPtr, size) - Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk */ - int size; /* Size of storage block */ +void * +Tcl_GetThreadData( + Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ + int size) /* Size of storage block */ { - VOID *result; + void *result; #ifdef TCL_THREADS /* * Initialize the key for this thread. @@ -89,18 +87,18 @@ Tcl_GetThreadData(keyPtr, size) result = TclpThreadDataKeyGet(keyPtr); if (result == NULL) { - result = (VOID *)ckalloc((size_t)size); - memset(result, 0, (size_t)size); + result = (void *) ckalloc((size_t) size); + memset(result, 0, (size_t) size); TclpThreadDataKeySet(keyPtr, result); } #else /* TCL_THREADS */ if (*keyPtr == NULL) { - result = (VOID *)ckalloc((size_t)size); - memset((char *)result, 0, (size_t)size); + result = (void *) ckalloc((size_t) size); + memset((char *) result, 0, (size_t) size); *keyPtr = (Tcl_ThreadDataKey)result; - RememberSyncObject((char *)keyPtr, &keyRecord); + RememberSyncObject((char *) keyPtr, &keyRecord); } - result = *(VOID **)keyPtr; + result = * (void **) keyPtr; #endif /* TCL_THREADS */ return result; } @@ -122,16 +120,16 @@ Tcl_GetThreadData(keyPtr, size) *---------------------------------------------------------------------- */ -VOID * -TclThreadDataKeyGet(keyPtr) - Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really +void * +TclThreadDataKeyGet( + Tcl_ThreadDataKey *keyPtr) /* Identifier for the data chunk, really * (pthread_key_t **) */ { #ifdef TCL_THREADS - return (VOID *)TclpThreadDataKeyGet(keyPtr); + return (void *) TclpThreadDataKeyGet(keyPtr); #else /* TCL_THREADS */ - char *result = *(char **)keyPtr; - return (VOID *)result; + char *result = *(char **) keyPtr; + return (void *) result; #endif /* TCL_THREADS */ } @@ -154,9 +152,9 @@ TclThreadDataKeyGet(keyPtr) */ static void -RememberSyncObject(objPtr, recPtr) - char *objPtr; /* Pointer to sync object */ - SyncObjRecord *recPtr; /* Record of sync objects */ +RememberSyncObject( + char *objPtr, /* Pointer to sync object */ + SyncObjRecord *recPtr) /* Record of sync objects */ { char **newList; int i, j; @@ -169,14 +167,14 @@ RememberSyncObject(objPtr, recPtr) if (recPtr->num >= recPtr->max) { recPtr->max += 8; - newList = (char **)ckalloc(recPtr->max * sizeof(char *)); + newList = (char **) ckalloc(recPtr->max * sizeof(char *)); for (i=0,j=0 ; inum ; i++) { if (recPtr->list[i] != NULL) { newList[j++] = recPtr->list[i]; } } if (recPtr->list != NULL) { - ckfree((char *)recPtr->list); + ckfree((char *) recPtr->list); } recPtr->list = newList; recPtr->num = j; @@ -202,9 +200,9 @@ RememberSyncObject(objPtr, recPtr) */ static void -ForgetSyncObject(objPtr, recPtr) - char *objPtr; /* Pointer to sync object */ - SyncObjRecord *recPtr; /* Record of sync objects */ +ForgetSyncObject( + char *objPtr, /* Pointer to sync object */ + SyncObjRecord *recPtr) /* Record of sync objects */ { int i; @@ -233,8 +231,8 @@ ForgetSyncObject(objPtr, recPtr) */ void -TclRememberMutex(mutexPtr) - Tcl_Mutex *mutexPtr; +TclRememberMutex( + Tcl_Mutex *mutexPtr) { RememberSyncObject((char *)mutexPtr, &mutexRecord); } @@ -257,13 +255,13 @@ TclRememberMutex(mutexPtr) */ void -Tcl_MutexFinalize(mutexPtr) - Tcl_Mutex *mutexPtr; +Tcl_MutexFinalize( + Tcl_Mutex *mutexPtr) { #ifdef TCL_THREADS TclpFinalizeMutex(mutexPtr); #endif - ForgetSyncObject((char *)mutexPtr, &mutexRecord); + ForgetSyncObject((char *) mutexPtr, &mutexRecord); } /* @@ -283,10 +281,10 @@ Tcl_MutexFinalize(mutexPtr) */ void -TclRememberCondition(condPtr) - Tcl_Condition *condPtr; +TclRememberCondition( + Tcl_Condition *condPtr) { - RememberSyncObject((char *)condPtr, &condRecord); + RememberSyncObject((char *) condPtr, &condRecord); } /* @@ -307,13 +305,13 @@ TclRememberCondition(condPtr) */ void -Tcl_ConditionFinalize(condPtr) - Tcl_Condition *condPtr; +Tcl_ConditionFinalize( + Tcl_Condition *condPtr) { #ifdef TCL_THREADS TclpFinalizeCondition(condPtr); #endif - ForgetSyncObject((char *)condPtr, &condRecord); + ForgetSyncObject((char *) condPtr, &condRecord); } /* @@ -334,7 +332,7 @@ Tcl_ConditionFinalize(condPtr) */ void -TclFinalizeThreadData() +TclFinalizeThreadData(void) { TclpFinalizeThreadDataThread(); } @@ -357,7 +355,7 @@ TclFinalizeThreadData() */ void -TclFinalizeSynchronization() +TclFinalizeSynchronization(void) { #ifdef TCL_THREADS void* blockPtr; @@ -368,18 +366,18 @@ TclFinalizeSynchronization() TclpMasterLock(); - /* - * If we're running unthreaded, the TSD blocks are simply stored - * inside their thread data keys. Free them here. + /* + * If we're running unthreaded, the TSD blocks are simply stored inside + * their thread data keys. Free them here. */ for (i=0 ; ifirstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; @@ -711,10 +710,10 @@ MoveObjs(fromPtr, toPtr, numMove) */ static char * -Block2Ptr(blockPtr, bucket, reqSize) - Block *blockPtr; - int bucket; - unsigned int reqSize; +Block2Ptr( + Block *blockPtr, + int bucket, + unsigned int reqSize) { register void *ptr; @@ -729,8 +728,8 @@ Block2Ptr(blockPtr, bucket, reqSize) } static Block * -Ptr2Block(ptr) - char *ptr; +Ptr2Block( + char *ptr) { register Block *blockPtr; @@ -767,9 +766,9 @@ Ptr2Block(ptr) */ static void -LockBucket(cachePtr, bucket) - Cache *cachePtr; - int bucket; +LockBucket( + Cache *cachePtr, + int bucket) { #if 0 if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) { @@ -785,9 +784,9 @@ LockBucket(cachePtr, bucket) } static void -UnlockBucket(cachePtr, bucket) - Cache *cachePtr; - int bucket; +UnlockBucket( + Cache *cachePtr, + int bucket) { Tcl_MutexUnlock(bucketInfo[bucket].lockPtr); } @@ -809,9 +808,10 @@ UnlockBucket(cachePtr, bucket) */ static void -PutBlocks(cachePtr, bucket, numMove) - Cache *cachePtr; - int bucket, numMove; +PutBlocks( + Cache *cachePtr, + int bucket, + int numMove) { register Block *lastPtr, *firstPtr; register int n = numMove; @@ -857,9 +857,9 @@ PutBlocks(cachePtr, bucket, numMove) */ static int -GetBlocks(cachePtr, bucket) - Cache *cachePtr; - int bucket; +GetBlocks( + Cache *cachePtr, + int bucket) { register Block *blockPtr; register int n; @@ -971,7 +971,7 @@ GetBlocks(cachePtr, bucket) */ void -TclFinalizeThreadAlloc() +TclFinalizeThreadAlloc(void) { int i; for (i = 0; i < NBUCKETS; ++i) { @@ -1007,7 +1007,7 @@ TclFinalizeThreadAlloc() */ void -TclFinalizeThreadAlloc() +TclFinalizeThreadAlloc(void) { Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use."); } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index f7aeaa5..da57e34 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.67 2005/10/19 18:39:58 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.68 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" @@ -22,7 +22,10 @@ * The absolute pathname of the executable in which this Tcl library * is running. */ -static ProcessGlobalValue executableName = {0, 0, NULL, NULL, NULL, NULL, NULL}; + +static ProcessGlobalValue executableName = { + 0, 0, NULL, NULL, NULL, NULL, NULL +}; /* * The following values are used in the flags returned by Tcl_ScanElement and @@ -62,16 +65,14 @@ static Tcl_ThreadDataKey precisionKey; * Prototypes for functions defined later in this file. */ -static void ClearHash _ANSI_ARGS_((Tcl_HashTable *tablePtr)); -static void FreeProcessGlobalValue _ANSI_ARGS_(( - ClientData clientData)); -static void FreeThreadHash _ANSI_ARGS_((ClientData clientData)); -static Tcl_HashTable * GetThreadHash _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr)); -static int ParseInteger _ANSI_ARGS_((CONST char *bytes, - int numBytes)); -static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_Obj* objPtr)); -static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr)); +static void ClearHash(Tcl_HashTable *tablePtr); +static void FreeProcessGlobalValue(ClientData clientData); +static void FreeThreadHash(ClientData clientData); +static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); +static int ParseInteger(CONST char *bytes, int numBytes); +static int SetEndOffsetFromAny(Tcl_Interp* interp, + Tcl_Obj* objPtr); +static void UpdateStringOfEndOffset(Tcl_Obj* objPtr); /* * The following is the Tcl object type definition for an object that @@ -82,12 +83,11 @@ static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr)); Tcl_ObjType tclEndOffsetType = { "end-offset", /* name */ - (Tcl_FreeInternalRepProc*) NULL, /* freeIntRepProc */ - (Tcl_DupInternalRepProc*) NULL, /* dupIntRepProc */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ UpdateStringOfEndOffset, /* updateStringProc */ SetEndOffsetFromAny }; - /* *---------------------------------------------------------------------- @@ -124,23 +124,22 @@ Tcl_ObjType tclEndOffsetType = { */ int -TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr, - bracePtr) - Tcl_Interp *interp; /* Interpreter to use for error reporting. If +TclFindElement( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - CONST char *list; /* Points to the first byte of a string + CONST char *list, /* Points to the first byte of a string * containing a Tcl list with zero or more * elements (possibly in braces). */ - int listLength; /* Number of bytes in the list's string. */ - CONST char **elementPtr; /* Where to put address of first significant + int listLength, /* Number of bytes in the list's string. */ + CONST char **elementPtr, /* Where to put address of first significant * character in first element of list. */ - CONST char **nextPtr; /* Fill in with location of character just + CONST char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - int *sizePtr; /* If non-zero, fill in with size of + int *sizePtr, /* If non-zero, fill in with size of * element. */ - int *bracePtr; /* If non-zero, fill in with non-zero/zero to + int *bracePtr) /* If non-zero, fill in with non-zero/zero to * indicate that arg was/wasn't in braces. */ { CONST char *p = list; @@ -351,10 +350,10 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr, */ int -TclCopyAndCollapse(count, src, dst) - int count; /* Number of characters to copy from src. */ - CONST char *src; /* Copy from here... */ - char *dst; /* ... to here. */ +TclCopyAndCollapse( + int count, /* Number of characters to copy from src. */ + CONST char *src, /* Copy from here... */ + char *dst) /* ... to here. */ { register char c; int numRead; @@ -407,13 +406,13 @@ TclCopyAndCollapse(count, src, dst) */ int -Tcl_SplitList(interp, list, argcPtr, argvPtr) - Tcl_Interp *interp; /* Interpreter to use for error reporting. If +Tcl_SplitList( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, no error message is left. */ - CONST char *list; /* Pointer to string with list structure. */ - int *argcPtr; /* Pointer to location to fill in with the + CONST char *list, /* Pointer to string with list structure. */ + int *argcPtr, /* Pointer to location to fill in with the * number of elements in the list. */ - CONST char ***argvPtr; /* Pointer to place to store pointer to array + CONST char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to list elements. */ { CONST char **argv; @@ -462,7 +461,7 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr) } argv[i] = p; if (brace) { - memcpy((VOID *) p, (VOID *) element, (size_t) elSize); + memcpy((void *) p, (void *) element, (size_t) elSize); p += elSize; *p = 0; p++; @@ -500,10 +499,10 @@ Tcl_SplitList(interp, list, argcPtr, argvPtr) */ int -Tcl_ScanElement(string, flagPtr) - register CONST char *string; /* String to convert to list element. */ - register int *flagPtr; /* Where to store information to guide - * Tcl_ConvertCountedElement. */ +Tcl_ScanElement( + register CONST char *string,/* String to convert to list element. */ + register int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(string, -1, flagPtr); } @@ -532,10 +531,10 @@ Tcl_ScanElement(string, flagPtr) */ int -Tcl_ScanCountedElement(string, length, flagPtr) - CONST char *string; /* String to convert to Tcl list element. */ - int length; /* Number of bytes in string, or -1. */ - int *flagPtr; /* Where to store information to guide +Tcl_ScanCountedElement( + CONST char *string, /* String to convert to Tcl list element. */ + int length, /* Number of bytes in string, or -1. */ + int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { int flags, nestingLevel; @@ -665,10 +664,10 @@ Tcl_ScanCountedElement(string, length, flagPtr) */ int -Tcl_ConvertElement(src, dst, flags) - register CONST char *src; /* Source information for list element. */ - register char *dst; /* Place to put list-ified element. */ - register int flags; /* Flags produced by Tcl_ScanElement. */ +Tcl_ConvertElement( + register CONST char *src, /* Source information for list element. */ + register char *dst, /* Place to put list-ified element. */ + register int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -695,11 +694,11 @@ Tcl_ConvertElement(src, dst, flags) */ int -Tcl_ConvertCountedElement(src, length, dst, flags) - register CONST char *src; /* Source information for list element. */ - int length; /* Number of bytes in src, or -1. */ - char *dst; /* Place to put list-ified element. */ - int flags; /* Flags produced by Tcl_ScanElement. */ +Tcl_ConvertCountedElement( + register CONST char *src, /* Source information for list element. */ + int length, /* Number of bytes in src, or -1. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { register char *p = dst; register CONST char *lastChar; @@ -843,9 +842,9 @@ Tcl_ConvertCountedElement(src, length, dst, flags) */ char * -Tcl_Merge(argc, argv) - int argc; /* How many strings to merge. */ - CONST char * CONST *argv; /* Array of string values. */ +Tcl_Merge( + int argc, /* How many strings to merge. */ + CONST char * CONST *argv) /* Array of string values. */ { # define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr; @@ -876,7 +875,7 @@ Tcl_Merge(argc, argv) dst = result; for (i = 0; i < argc; i++) { numChars = Tcl_ConvertElement(argv[i], dst, - flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH) ); + flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH)); dst += numChars; *dst = ' '; dst++; @@ -913,10 +912,10 @@ Tcl_Merge(argc, argv) */ char -Tcl_Backslash(src, readPtr) - CONST char *src; /* Points to the backslash character of a +Tcl_Backslash( + CONST char *src, /* Points to the backslash character of a * backslash sequence. */ - int *readPtr; /* Fill in with number of characters read from + int *readPtr) /* Fill in with number of characters read from * src, unless NULL. */ { char buf[TCL_UTF_MAX]; @@ -947,9 +946,9 @@ Tcl_Backslash(src, readPtr) */ char * -Tcl_Concat(argc, argv) - int argc; /* Number of strings to concatenate. */ - CONST char * CONST *argv; /* Array of strings to concatenate. */ +Tcl_Concat( + int argc, /* Number of strings to concatenate. */ + CONST char * CONST *argv) /* Array of strings to concatenate. */ { int totalSize, i; char *p; @@ -986,7 +985,7 @@ Tcl_Concat(argc, argv) if (length == 0) { continue; } - memcpy((VOID *) p, (VOID *) element, (size_t) length); + memcpy((void *) p, (void *) element, (size_t) length); p += length; *p = ' '; p++; @@ -1018,9 +1017,9 @@ Tcl_Concat(argc, argv) */ Tcl_Obj * -Tcl_ConcatObj(objc, objv) - int objc; /* Number of objects to concatenate. */ - Tcl_Obj *CONST objv[]; /* Array of objects to concatenate. */ +Tcl_ConcatObj( + int objc, /* Number of objects to concatenate. */ + Tcl_Obj *CONST objv[]) /* Array of objects to concatenate. */ { int allocSize, finalSize, length, elemLength, i; char *p; @@ -1119,14 +1118,15 @@ Tcl_ConcatObj(objc, objv) */ while ((elemLength > 0) && (UCHAR(element[elemLength-1]) < 127) - && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO C space. */ + && isspace(UCHAR(element[elemLength-1])) + /* INTL: ISO C space. */ && ((elemLength < 2) || (element[elemLength-2] != '\\'))) { elemLength--; } if (elemLength == 0) { continue; /* nothing left of this element */ } - memcpy((VOID *) p, (VOID *) element, (size_t) elemLength); + memcpy((void *) p, (void *) element, (size_t) elemLength); p += elemLength; *p = ' '; p++; @@ -1141,7 +1141,7 @@ Tcl_ConcatObj(objc, objv) } TclNewObj(objPtr); - objPtr->bytes = concatStr; + objPtr->bytes = concatStr; objPtr->length = finalSize; return objPtr; } @@ -1165,9 +1165,9 @@ Tcl_ConcatObj(objc, objv) */ int -Tcl_StringMatch(str, pattern) - CONST char *str; /* String. */ - CONST char *pattern; /* Pattern, which may contain special +Tcl_StringMatch( + CONST char *str, /* String. */ + CONST char *pattern) /* Pattern, which may contain special * characters. */ { return Tcl_StringCaseMatch(str, pattern, 0); @@ -1193,11 +1193,11 @@ Tcl_StringMatch(str, pattern) */ int -Tcl_StringCaseMatch(str, pattern, nocase) - CONST char *str; /* String. */ - CONST char *pattern; /* Pattern, which may contain special +Tcl_StringCaseMatch( + CONST char *str, /* String. */ + CONST char *pattern, /* Pattern, which may contain special * characters. */ - int nocase; /* 0 for case sensitive, 1 for insensitive */ + int nocase) /* 0 for case sensitive, 1 for insensitive */ { int p, charLen; CONST char *pstart = pattern; @@ -1394,7 +1394,7 @@ Tcl_StringCaseMatch(str, pattern, nocase) * each string match. */ - str += TclUtfToUniChar(str, &ch1); + str += TclUtfToUniChar(str, &ch1); pattern += TclUtfToUniChar(pattern, &ch2); if (nocase) { if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { @@ -1425,8 +1425,8 @@ Tcl_StringCaseMatch(str, pattern, nocase) */ void -Tcl_DStringInit(dsPtr) - Tcl_DString *dsPtr; /* Pointer to structure for dynamic string. */ +Tcl_DStringInit( + Tcl_DString *dsPtr) /* Pointer to structure for dynamic string. */ { dsPtr->string = dsPtr->staticSpace; dsPtr->length = 0; @@ -1453,11 +1453,11 @@ Tcl_DStringInit(dsPtr) */ char * -Tcl_DStringAppend(dsPtr, bytes, length) - Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *bytes; /* String to append. If length is -1 then this +Tcl_DStringAppend( + Tcl_DString *dsPtr, /* Structure describing dynamic string. */ + CONST char *bytes, /* String to append. If length is -1 then this * must be null-terminated. */ - int length; /* Number of bytes from "bytes" to append. If + int length) /* Number of bytes from "bytes" to append. If * < 0, then append all of bytes, up to null * at end. */ { @@ -1482,11 +1482,11 @@ Tcl_DStringAppend(dsPtr, bytes, length) char *newString; newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((VOID *) newString, (VOID *) dsPtr->string, + memcpy((void *) newString, (void *) dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string, + dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, (size_t) dsPtr->spaceAvl); } } @@ -1523,9 +1523,9 @@ Tcl_DStringAppend(dsPtr, bytes, length) */ char * -Tcl_DStringAppendElement(dsPtr, element) - Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *element; /* String to append. Must be +Tcl_DStringAppendElement( + Tcl_DString *dsPtr, /* Structure describing dynamic string. */ + CONST char *element) /* String to append. Must be * null-terminated. */ { int newSize, flags, strSize; @@ -1549,11 +1549,11 @@ Tcl_DStringAppendElement(dsPtr, element) char *newString; newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((VOID *) newString, (VOID *) dsPtr->string, + memcpy((void *) newString, (void *) dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string, + dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, (size_t) dsPtr->spaceAvl); } } @@ -1601,9 +1601,9 @@ Tcl_DStringAppendElement(dsPtr, element) */ void -Tcl_DStringSetLength(dsPtr, length) - Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - int length; /* New length for dynamic string. */ +Tcl_DStringSetLength( + Tcl_DString *dsPtr, /* Structure describing dynamic string. */ + int length) /* New length for dynamic string. */ { int newsize; @@ -1633,11 +1633,11 @@ Tcl_DStringSetLength(dsPtr, length) char *newString; newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl); - memcpy((VOID *) newString, (VOID *) dsPtr->string, + memcpy((void *) newString, (void *) dsPtr->string, (size_t) dsPtr->length); dsPtr->string = newString; } else { - dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string, + dsPtr->string = (char *) ckrealloc((void *) dsPtr->string, (size_t) dsPtr->spaceAvl); } } @@ -1664,8 +1664,8 @@ Tcl_DStringSetLength(dsPtr, length) */ void -Tcl_DStringFree(dsPtr) - Tcl_DString *dsPtr; /* Structure describing dynamic string. */ +Tcl_DStringFree( + Tcl_DString *dsPtr) /* Structure describing dynamic string. */ { if (dsPtr->string != dsPtr->staticSpace) { ckfree(dsPtr->string); @@ -1696,9 +1696,9 @@ Tcl_DStringFree(dsPtr) */ void -Tcl_DStringResult(interp, dsPtr) - Tcl_Interp *interp; /* Interpreter whose result is to be reset. */ - Tcl_DString *dsPtr; /* Dynamic string that is to become the +Tcl_DStringResult( + Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ + Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { Tcl_ResetResult(interp); @@ -1740,9 +1740,9 @@ Tcl_DStringResult(interp, dsPtr) */ void -Tcl_DStringGetResult(interp, dsPtr) - Tcl_Interp *interp; /* Interpreter whose result is to be reset. */ - Tcl_DString *dsPtr; /* Dynamic string that is to become the result +Tcl_DStringGetResult( + Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ + Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { Interp *iPtr = (Interp *) interp; @@ -1804,8 +1804,8 @@ Tcl_DStringGetResult(interp, dsPtr) */ void -Tcl_DStringStartSublist(dsPtr) - Tcl_DString *dsPtr; /* Dynamic string. */ +Tcl_DStringStartSublist( + Tcl_DString *dsPtr) /* Dynamic string. */ { if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) { Tcl_DStringAppend(dsPtr, " {", -1); @@ -1833,8 +1833,8 @@ Tcl_DStringStartSublist(dsPtr) */ void -Tcl_DStringEndSublist(dsPtr) - Tcl_DString *dsPtr; /* Dynamic string. */ +Tcl_DStringEndSublist( + Tcl_DString *dsPtr) /* Dynamic string. */ { Tcl_DStringAppend(dsPtr, "}", -1); } @@ -1860,12 +1860,12 @@ Tcl_DStringEndSublist(dsPtr) */ void -Tcl_PrintDouble(interp, value, dst) - Tcl_Interp *interp; /* Interpreter whose tcl_precision variable +Tcl_PrintDouble( + Tcl_Interp *interp, /* Interpreter whose tcl_precision variable * used to be used to control printing. It's * ignored now. */ - double value; /* Value to print as string. */ - char *dst; /* Where to store converted value; must have + double value, /* Value to print as string. */ + char *dst) /* Where to store converted value; must have * at least TCL_DOUBLE_SPACE characters. */ { char *p, c; @@ -1879,11 +1879,11 @@ Tcl_PrintDouble(interp, value, dst) /* * If *precisionPtr == 0, then use TclDoubleDigits to develop a decimal * significand and exponent, then format it in E or F format as - * appropriate. If *precisionPtr != 0, use the native sprintf and then - * add a trailing ".0" if there is no decimal point in the rep. + * appropriate. If *precisionPtr != 0, use the native sprintf and then add + * a trailing ".0" if there is no decimal point in the rep. */ - if ( *precisionPtr == 0 ) { + if (*precisionPtr == 0) { /* * Handle NaN. */ @@ -1961,7 +1961,6 @@ Tcl_PrintDouble(interp, value, dst) } *dst++ = '\0'; } - } else { /* * tcl_precision is supplied, pass it to the native sprintf. @@ -1972,11 +1971,11 @@ Tcl_PrintDouble(interp, value, dst) /* * If the ASCII result looks like an integer, add ".0" so that it * doesn't look like an integer anymore. This prevents floating-point - * values from being converted to integers unintentionally. Check for + * values from being converted to integers unintentionally. Check for * ASCII specifically to speed up the function. */ - for (p = dst; *p != 0; ) { + for (p = dst; *p != 0;) { if (UCHAR(*p) < 0x80) { c = *p++; } else { @@ -1990,7 +1989,6 @@ Tcl_PrintDouble(interp, value, dst) p[0] = '.'; p[1] = '0'; p[2] = 0; - } } @@ -2016,16 +2014,16 @@ Tcl_PrintDouble(interp, value, dst) /* ARGSUSED */ char * -TclPrecTraceProc(clientData, interp, name1, name2, flags) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Interpreter containing variable. */ - CONST char *name1; /* Name of variable. */ - CONST char *name2; /* Second part of variable name. */ - int flags; /* Information about what happened. */ +TclPrecTraceProc( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Interpreter containing variable. */ + CONST char *name1, /* Name of variable. */ + CONST char *name2, /* Second part of variable name. */ + int flags) /* Information about what happened. */ { Tcl_Obj* value; int prec; - int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int)); + int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int)); /* * If the variable is unset, then recreate the trace. @@ -2037,7 +2035,7 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags) TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData); } - return (char *) NULL; + return NULL; } /* @@ -2050,7 +2048,7 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_READS) { Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); - return (char *) NULL; + return NULL; } /* @@ -2069,7 +2067,7 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags) return "improper value for precision"; } *precisionPtr = prec; - return (char *) NULL; + return NULL; } /* @@ -2090,9 +2088,9 @@ TclPrecTraceProc(clientData, interp, name1, name2, flags) */ int -TclNeedSpace(start, end) - CONST char *start; /* First character in string. */ - CONST char *end; /* End of string (place where space will be +TclNeedSpace( + CONST char *start, /* First character in string. */ + CONST char *end) /* End of string (place where space will be * added, if appropriate). */ { /* @@ -2169,8 +2167,8 @@ TclNeedSpace(start, end) * Results: * Returns 0 if the leading bytes do not look like an integer. * Otherwise, returns the number of bytes examined that look like an - * integer. This may be less than numBytes if the integer is only the - * leading part of the string. + * integer. This may be less than numBytes if the integer is only the + * leading part of the string. * * Side effects: * None. @@ -2179,13 +2177,16 @@ TclNeedSpace(start, end) */ static int -ParseInteger(bytes, numBytes) - CONST char *bytes; /* The string to examine. */ - int numBytes; /* Max number of bytes to scan. */ +ParseInteger( + CONST char *bytes, /* The string to examine. */ + int numBytes) /* Max number of bytes to scan. */ { register CONST char *p = bytes; - /* Take care of introductory "0x". */ + /* + * Take care of introductory "0x". + */ + if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) { int scanned; Tcl_UniChar ch; @@ -2197,7 +2198,10 @@ ParseInteger(bytes, numBytes) return scanned+2; } - /* Recognize the 0 as valid integer, but x is left behind. */ + /* + * Recognize the 0 as valid integer, but x is left behind. + */ + return 1; } while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */ @@ -2237,15 +2241,15 @@ ParseInteger(bytes, numBytes) */ int -TclGetIntForIndex(interp, objPtr, endValue, indexPtr) - Tcl_Interp *interp; /* Interpreter to use for error reporting. If +TclGetIntForIndex( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - Tcl_Obj *objPtr; /* Points to an object containing either "end" + Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - int endValue; /* The value to be stored at "indexPtr" if + int endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ - int *indexPtr; /* Location filled in with an integer + int *indexPtr) /* Location filled in with an integer * representing an index. */ { if (Tcl_GetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) { @@ -2287,10 +2291,10 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) bytes[opIdx] = '\0'; code = Tcl_GetInt(interp, bytes, &first); bytes[opIdx] = savedOp; - if (code == TCL_ERROR) { + if (code == TCL_ERROR) { goto parseError; } - if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { + if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { goto parseError; } if (savedOp == '+') { @@ -2352,8 +2356,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) */ static void -UpdateStringOfEndOffset(objPtr) - register Tcl_Obj* objPtr; +UpdateStringOfEndOffset( + register Tcl_Obj* objPtr) { char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1]; register int len; @@ -2388,9 +2392,9 @@ UpdateStringOfEndOffset(objPtr) */ static int -SetEndOffsetFromAny(interp, objPtr) - Tcl_Interp *interp; /* Tcl interpreter or NULL */ - Tcl_Obj* objPtr; /* Pointer to the object to parse */ +SetEndOffsetFromAny( + Tcl_Interp *interp, /* Tcl interpreter or NULL */ + Tcl_Obj *objPtr) /* Pointer to the object to parse */ { int offset; /* Offset in the "end-offset" expression */ register char* bytes; /* String rep of the object */ @@ -2483,11 +2487,11 @@ SetEndOffsetFromAny(interp, objPtr) */ int -TclCheckBadOctal(interp, value) - Tcl_Interp *interp; /* Interpreter to use for error reporting. If +TclCheckBadOctal( + Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after * errors. */ - CONST char *value; /* String to check. */ + CONST char *value) /* String to check. */ { register CONST char *p = value; @@ -2539,8 +2543,8 @@ TclCheckBadOctal(interp, value) */ static void -ClearHash(tablePtr) - Tcl_HashTable *tablePtr; +ClearHash( + Tcl_HashTable *tablePtr) { Tcl_HashSearch search; Tcl_HashEntry *hPtr; @@ -2572,11 +2576,12 @@ ClearHash(tablePtr) */ static Tcl_HashTable * -GetThreadHash(keyPtr) - Tcl_ThreadDataKey *keyPtr; +GetThreadHash( + Tcl_ThreadDataKey *keyPtr) { Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **) - Tcl_GetThreadData(keyPtr, (int)sizeof(Tcl_HashTable *)); + Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *)); + if (NULL == *tablePtrPtr) { *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr); @@ -2600,10 +2605,11 @@ GetThreadHash(keyPtr) */ static void -FreeThreadHash(clientData) - ClientData clientData; +FreeThreadHash( + ClientData clientData) { Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData; + ClearHash(tablePtr); Tcl_DeleteHashTable(tablePtr); ckfree((char *) tablePtr); @@ -2621,10 +2627,11 @@ FreeThreadHash(clientData) */ static void -FreeProcessGlobalValue(clientData) - ClientData clientData; +FreeProcessGlobalValue( + ClientData clientData) { ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData; + pgvPtr->epoch++; pgvPtr->numBytes = 0; ckfree(pgvPtr->value); @@ -2648,10 +2655,10 @@ FreeProcessGlobalValue(clientData) */ void -TclSetProcessGlobalValue(pgvPtr, newValue, encoding) - ProcessGlobalValue *pgvPtr; - Tcl_Obj *newValue; - Tcl_Encoding encoding; +TclSetProcessGlobalValue( + ProcessGlobalValue *pgvPtr, + Tcl_Obj *newValue, + Tcl_Encoding encoding) { CONST char *bytes; Tcl_HashTable *cacheMap; @@ -2707,8 +2714,8 @@ TclSetProcessGlobalValue(pgvPtr, newValue, encoding) */ Tcl_Obj * -TclGetProcessGlobalValue(pgvPtr) - ProcessGlobalValue *pgvPtr; +TclGetProcessGlobalValue( + ProcessGlobalValue *pgvPtr) { Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; @@ -2738,7 +2745,7 @@ TclGetProcessGlobalValue(pgvPtr) ckfree(pgvPtr->value); pgvPtr->value = ckalloc((unsigned int) Tcl_DStringLength(&newValue) + 1); - memcpy((VOID*) pgvPtr->value, (VOID*) Tcl_DStringValue(&newValue), + memcpy((void*) pgvPtr->value, (void*) Tcl_DStringValue(&newValue), (size_t) Tcl_DStringLength(&newValue) + 1); Tcl_DStringFree(&newValue); Tcl_FreeEncoding(pgvPtr->encoding); @@ -2808,9 +2815,9 @@ TclGetProcessGlobalValue(pgvPtr) */ void -TclSetObjNameOfExecutable(name, encoding) - Tcl_Obj *name; - Tcl_Encoding encoding; +TclSetObjNameOfExecutable( + Tcl_Obj *name, + Tcl_Encoding encoding) { TclSetProcessGlobalValue(&executableName, name, encoding); } @@ -2836,7 +2843,7 @@ TclSetObjNameOfExecutable(name, encoding) */ Tcl_Obj * -TclGetObjNameOfExecutable() +TclGetObjNameOfExecutable(void) { return TclGetProcessGlobalValue(&executableName); } @@ -2863,7 +2870,7 @@ TclGetObjNameOfExecutable() */ CONST char * -Tcl_GetNameOfExecutable() +Tcl_GetNameOfExecutable(void) { int numBytes; CONST char * bytes = @@ -2893,8 +2900,8 @@ Tcl_GetNameOfExecutable() */ void -TclpGetTime(timePtr) - Tcl_Time* timePtr; +TclpGetTime( + Tcl_Time *timePtr) { Tcl_GetTime(timePtr); } @@ -2917,7 +2924,7 @@ TclpGetTime(timePtr) */ TclPlatformType * -TclGetPlatform() +TclGetPlatform(void) { return &tclPlatform; } diff --git a/generic/tclVar.c b/generic/tclVar.c index be81616..08b00aa 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.112 2005/11/02 00:59:11 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.113 2005/11/02 11:55:47 dkf Exp $ */ #include "tclInt.h" @@ -65,13 +65,13 @@ Var * TclLookupSimpleVar(Tcl_Interp *interp, int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags); -static Tcl_DupInternalRepProc DupLocalVarName; -static Tcl_FreeInternalRepProc FreeParsedVarName; -static Tcl_DupInternalRepProc DupParsedVarName; -static Tcl_UpdateStringProc UpdateParsedVarName; +static Tcl_DupInternalRepProc DupLocalVarName; +static Tcl_FreeInternalRepProc FreeParsedVarName; +static Tcl_DupInternalRepProc DupParsedVarName; +static Tcl_UpdateStringProc UpdateParsedVarName; -static Tcl_UpdateStringProc PanicOnUpdateVarName; -static Tcl_SetFromAnyProc PanicOnSetVarName; +static Tcl_UpdateStringProc PanicOnUpdateVarName; +static Tcl_SetFromAnyProc PanicOnSetVarName; /* * Types of Tcl_Objs used to cache variable lookups. @@ -1003,11 +1003,11 @@ TclLookupArrayElement( */ CONST char * -Tcl_GetVar(interp, varName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +Tcl_GetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - CONST char *varName; /* Name of a variable in interp. */ - int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, + CONST char *varName, /* Name of a variable in interp. */ + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG * bits. */ { @@ -1038,14 +1038,14 @@ Tcl_GetVar(interp, varName, flags) */ CONST char * -Tcl_GetVar2(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_GetVar2( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) or + CONST char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - CONST char *part2; /* If non-NULL, gives the name of an element + CONST char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG * * bits. */ { @@ -1082,14 +1082,14 @@ Tcl_GetVar2(interp, part1, part2, flags) */ Tcl_Obj * -Tcl_GetVar2Ex(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_GetVar2Ex( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) or + CONST char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - CONST char *part2; /* If non-NULL, gives the name of an element + CONST char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; @@ -1134,16 +1134,16 @@ Tcl_GetVar2Ex(interp, part1, part2, flags) */ Tcl_Obj * -Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_ObjGetVar2( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding + register Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ - int flags; /* OR-ed combination of TCL_GLOBAL_ONLY and + int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; @@ -1191,17 +1191,17 @@ Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) */ Tcl_Obj * -TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +TclPtrGetVar( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Var *varPtr; /* The variable to be read.*/ - Var *arrayPtr; /* NULL for scalar variables, pointer to the + register Var *varPtr, /* The variable to be read.*/ + Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) or + CONST char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - CONST char *part2; /* If non-NULL, gives the name of an element + CONST char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ - CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + CONST int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; @@ -1271,11 +1271,11 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) /* ARGSUSED */ int -Tcl_SetObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - register Tcl_Interp *interp;/* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_SetObjCmd( + ClientData dummy, /* Not used. */ + register Tcl_Interp *interp,/* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *varValueObj; @@ -1325,12 +1325,12 @@ Tcl_SetObjCmd(dummy, interp, objc, objv) */ CONST char * -Tcl_SetVar(interp, varName, newValue, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +Tcl_SetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - CONST char *varName; /* Name of a variable in interp. */ - CONST char *newValue; /* New value for varName. */ - int flags; /* Various flags that tell how to set value: + CONST char *varName, /* Name of a variable in interp. */ + CONST char *newValue, /* New value for varName. */ + int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ @@ -1365,16 +1365,16 @@ Tcl_SetVar(interp, varName, newValue, flags) */ CONST char * -Tcl_SetVar2(interp, part1, part2, newValue, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_SetVar2( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - CONST char *part1; /* If part2 is NULL, this is name of scalar + CONST char *part1, /* If part2 is NULL, this is name of scalar * variable. Otherwise it is the name of an * array. */ - CONST char *part2; /* Name of an element within an array, or + CONST char *part2, /* Name of an element within an array, or * NULL. */ - CONST char *newValue; /* New value for variable. */ - int flags; /* Various flags that tell how to set value: + CONST char *newValue, /* New value for variable. */ + int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG */ @@ -1438,15 +1438,15 @@ Tcl_SetVar2(interp, part1, part2, newValue, flags) */ Tcl_Obj * -Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_SetVar2Ex( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ - CONST char *part1; /* Name of an array (if part2 is non-NULL) or + CONST char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - CONST char *part2; /* If non-NULL, gives the name of an element + CONST char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ - Tcl_Obj *newValuePtr; /* New value for variable. */ - int flags; /* Various flags that tell how to set value: + Tcl_Obj *newValuePtr, /* New value for variable. */ + int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT or * TCL_LEAVE_ERR_MSG. */ @@ -1488,17 +1488,17 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) */ Tcl_Obj * -Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +Tcl_ObjSetVar2( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ - register Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ - register Tcl_Obj *part2Ptr; /* If non-null, points to an object holding + register Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ - Tcl_Obj *newValuePtr; /* New value for variable. */ - int flags; /* Various flags that tell how to set value: + Tcl_Obj *newValuePtr, /* New value for variable. */ + int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ @@ -1545,17 +1545,19 @@ Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) */ Tcl_Obj * -TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +TclPtrSetVar( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ - register Var *varPtr; - Var *arrayPtr; - CONST char *part1; /* Name of an array (if part2 is non-NULL) or + register Var *varPtr, /* Reference to the variable to set. */ + Var *arrayPtr, /* Reference to the array containing the + * variable, or NULL if the variable is a + * scalar. */ + CONST char *part1, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ - CONST char *part2; /* If non-NULL, gives the name of an element + CONST char *part2, /* If non-NULL, gives the name of an element * in the array part1. */ - Tcl_Obj *newValuePtr; /* New value for variable. */ - CONST int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, and + Tcl_Obj *newValuePtr, /* New value for variable. */ + CONST int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and * TCL_LEAVE_ERR_MSG bits. */ { Interp *iPtr = (Interp *) interp; @@ -1744,17 +1746,17 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) */ Tcl_Obj * -TclIncrObjVar2(interp, part1Ptr, part2Ptr, incrPtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +TclIncrObjVar2( + Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ - Tcl_Obj *part1Ptr; /* Points to an object holding the name of an + 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 + Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ - Tcl_Obj *incrPtr; /* Amount to be added to variable. */ - int flags; /* Various flags that tell how to incr value: + Tcl_Obj *incrPtr, /* 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. */ @@ -1802,20 +1804,22 @@ TclIncrObjVar2(interp, part1Ptr, part2Ptr, incrPtr, flags) */ Tcl_Obj * -TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1, part2, incrPtr, flags) - Tcl_Interp *interp; /* Command interpreter in which variable is to +TclPtrIncrObjVar( + 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 + Var *varPtr, /* Reference to the variable to set. */ + Var *arrayPtr, /* Reference to the array containing the + * variable, or NULL if the variable is a + * scalar. */ + 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 + CONST char *part2, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ - Tcl_Obj *incrPtr; /* Increment value */ + Tcl_Obj *incrPtr, /* Increment value */ /* TODO: Which of these flag values really make sense? */ - CONST int flags; /* Various flags that tell how to incr value: + 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. */ @@ -1863,13 +1867,13 @@ TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1, part2, incrPtr, flags) */ int -Tcl_UnsetVar(interp, varName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +Tcl_UnsetVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - CONST char *varName; /* Name of a variable in interp. May be either + CONST char *varName, /* Name of a variable in interp. May be either * a scalar name or an array name or an * element in an array. */ - int flags; /* OR-ed combination of any of + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or * TCL_LEAVE_ERR_MSG. */ { @@ -1898,12 +1902,12 @@ Tcl_UnsetVar(interp, varName, flags) */ int -Tcl_UnsetVar2(interp, part1, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +Tcl_UnsetVar2( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - CONST char *part1; /* Name of variable or array. */ - CONST char *part2; /* Name of element within array or NULL. */ - int flags; /* OR-ed combination of any of + CONST char *part1, /* Name of variable or array. */ + CONST char *part2, /* Name of element within array or NULL. */ + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { @@ -1940,12 +1944,12 @@ Tcl_UnsetVar2(interp, part1, part2, flags) */ int -TclObjUnsetVar2(interp, part1Ptr, part2, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +TclObjUnsetVar2( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - Tcl_Obj *part1Ptr; /* Name of variable or array. */ - CONST char *part2; /* Name of element within array or NULL. */ - int flags; /* OR-ed combination of any of + Tcl_Obj *part1Ptr, /* Name of variable or array. */ + CONST char *part2, /* Name of element within array or NULL. */ + int flags) /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ { @@ -2129,11 +2133,11 @@ TclObjUnsetVar2(interp, part1Ptr, part2, flags) /* ARGSUSED */ int -Tcl_UnsetObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_UnsetObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register int i, flags = TCL_LEAVE_ERR_MSG; register char *name; @@ -2201,11 +2205,11 @@ Tcl_UnsetObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_AppendObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_AppendObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; char *part1; @@ -2270,11 +2274,11 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_LappendObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_LappendObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *varValuePtr, *newValuePtr; int numElems, createdNewObj, createVar; @@ -2413,11 +2417,11 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ArrayObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_ArrayObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { /* * The list of constants below should match the arrayOptions string array @@ -2952,10 +2956,10 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) */ int -TclArraySet(interp, arrayNameObj, arrayElemObj) - Tcl_Interp *interp; /* Current interpreter. */ - Tcl_Obj *arrayNameObj; /* The array name. */ - Tcl_Obj *arrayElemObj; /* The array elements list or dict. If this is +TclArraySet( + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Obj *arrayNameObj, /* The array name. */ + Tcl_Obj *arrayElemObj) /* The array elements list or dict. If this is * NULL, create an empty array. */ { Var *varPtr, *arrayPtr; @@ -3097,8 +3101,8 @@ TclArraySet(interp, arrayNameObj, arrayElemObj) } TclSetVarArray(varPtr); TclClearVarUndefined(varPtr); - varPtr->value.tablePtr = - (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + varPtr->value.tablePtr = (Tcl_HashTable *) + ckalloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS); return TCL_OK; } @@ -3290,16 +3294,16 @@ ObjMakeUpvar( */ int -Tcl_UpVar(interp, frameName, varName, localName, flags) - Tcl_Interp *interp; /* Command interpreter in which varName is to +Tcl_UpVar( + Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - CONST char *frameName; /* Name of the frame containing the source + CONST char *frameName, /* Name of the frame containing the source * variable, such as "1" or "#0". */ - CONST char *varName; /* Name of a variable in interp to link to. + CONST char *varName, /* Name of a variable in interp to link to. * May be either a scalar name or an element * in an array. */ - CONST char *localName; /* Name of link variable. */ - int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + CONST char *localName, /* Name of link variable. */ + int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ { return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags); @@ -3326,16 +3330,16 @@ Tcl_UpVar(interp, frameName, varName, localName, flags) */ int -Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) - Tcl_Interp *interp; /* Interpreter containing variables. Used for +Tcl_UpVar2( + Tcl_Interp *interp, /* Interpreter containing variables. Used for * error messages too. */ - CONST char *frameName; /* Name of the frame containing the source + CONST char *frameName, /* Name of the frame containing the source * variable, such as "1" or "#0". */ - CONST char *part1; - CONST char *part2; /* Two parts of source variable name to link + CONST char *part1, + CONST char *part2, /* Two parts of source variable name to link * to. */ - CONST char *localName; /* Name of link variable. */ - int flags; /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: + CONST char *localName, /* Name of link variable. */ + int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: * indicates scope of localName. */ { int result; @@ -3375,11 +3379,11 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) */ void -Tcl_GetVariableFullName(interp, variable, objPtr) - Tcl_Interp *interp; /* Interpreter containing the variable. */ - Tcl_Var variable; /* Token for the variable returned by a +Tcl_GetVariableFullName( + Tcl_Interp *interp, /* Interpreter containing the variable. */ + Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ - Tcl_Obj *objPtr; /* Points to the object onto which the + Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; @@ -3427,11 +3431,11 @@ Tcl_GetVariableFullName(interp, variable, objPtr) */ int -Tcl_GlobalObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_GlobalObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; register Tcl_Obj *objPtr; @@ -3525,11 +3529,11 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv) */ int -Tcl_VariableObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_VariableObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; char *varName, *tail, *cp; @@ -3653,11 +3657,11 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_UpvarObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_UpvarObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { CallFrame *framePtr; char *localName; @@ -3943,9 +3947,9 @@ DeleteSearches( */ void -TclDeleteVars(iPtr, tablePtr) - Interp *iPtr; /* Interpreter to which variables belong. */ - Tcl_HashTable *tablePtr; /* Hash table containing variables to +TclDeleteVars( + Interp *iPtr, /* Interpreter to which variables belong. */ + Tcl_HashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; @@ -4091,9 +4095,9 @@ TclDeleteVars(iPtr, tablePtr) */ void -TclDeleteCompiledLocalVars(iPtr, framePtr) - Interp *iPtr; /* Interpreter to which variables belong. */ - CallFrame *framePtr; /* Procedure call frame containing compiler- +TclDeleteCompiledLocalVars( + Interp *iPtr, /* Interpreter to which variables belong. */ + CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { register Var *varPtr; @@ -4281,10 +4285,10 @@ DeleteArray( */ void -TclCleanupVar(varPtr, arrayPtr) - Var *varPtr; /* Pointer to variable that may be a candidate +TclCleanupVar( + Var *varPtr, /* Pointer to variable that may be a candidate * for being expunged. */ - Var *arrayPtr; /* Array that contains the variable, or NULL + Var *arrayPtr) /* Array that contains the variable, or NULL * if this variable isn't an array element. */ { if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0) @@ -4326,13 +4330,13 @@ TclCleanupVar(varPtr, arrayPtr) */ void -TclVarErrMsg(interp, part1, part2, operation, reason) - Tcl_Interp *interp; /* Interpreter in which to record message. */ - CONST char *part1; - CONST char *part2; /* Variable's two-part name. */ - CONST char *operation; /* String describing operation that failed, +TclVarErrMsg( + Tcl_Interp *interp, /* Interpreter in which to record message. */ + CONST char *part1, + CONST char *part2, /* Variable's two-part name. */ + CONST char *operation, /* String describing operation that failed, * e.g. "read", "set", or "unset". */ - CONST char *reason; /* String describing why operation failed. */ + CONST char *reason) /* String describing why operation failed. */ { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't ", operation, " \"", part1, NULL); @@ -4355,17 +4359,17 @@ TclVarErrMsg(interp, part1, part2, operation, reason) */ static void -PanicOnUpdateVarName(objPtr) - Tcl_Obj *objPtr; +PanicOnUpdateVarName( + Tcl_Obj *objPtr) { Tcl_Panic("ERROR: updateStringProc of type %s should not be called.", objPtr->typePtr->name); } static int -PanicOnSetVarName(interp, objPtr) - Tcl_Interp *interp; - Tcl_Obj *objPtr; +PanicOnSetVarName( + Tcl_Interp *interp, + Tcl_Obj *objPtr) { Tcl_Panic("ERROR: setFromAnyProc of type %s should not be called.", objPtr->typePtr->name); @@ -4380,9 +4384,9 @@ PanicOnSetVarName(interp, objPtr) */ static void -DupLocalVarName(srcPtr, dupPtr) - Tcl_Obj *srcPtr; - Tcl_Obj *dupPtr; +DupLocalVarName( + Tcl_Obj *srcPtr, + Tcl_Obj *dupPtr) { dupPtr->internalRep.longValue = srcPtr->internalRep.longValue; dupPtr->typePtr = &localVarNameType; @@ -4398,8 +4402,8 @@ DupLocalVarName(srcPtr, dupPtr) */ static void -FreeNsVarName(objPtr) - Tcl_Obj *objPtr; +FreeNsVarName( + Tcl_Obj *objPtr) { register Var *varPtr = (Var *) objPtr->internalRep.twoPtrValue.ptr2; @@ -4410,9 +4414,9 @@ FreeNsVarName(objPtr) } static void -DupNsVarName(srcPtr, dupPtr) - Tcl_Obj *srcPtr; - Tcl_Obj *dupPtr; +DupNsVarName( + Tcl_Obj *srcPtr, + Tcl_Obj *dupPtr) { Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1; register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2; @@ -4434,8 +4438,8 @@ DupNsVarName(srcPtr, dupPtr) */ static void -FreeParsedVarName(objPtr) - Tcl_Obj *objPtr; +FreeParsedVarName( + Tcl_Obj *objPtr) { register Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1; @@ -4448,9 +4452,9 @@ FreeParsedVarName(objPtr) } static void -DupParsedVarName(srcPtr, dupPtr) - Tcl_Obj *srcPtr; - Tcl_Obj *dupPtr; +DupParsedVarName( + Tcl_Obj *srcPtr, + Tcl_Obj *dupPtr) { register Tcl_Obj *arrayPtr = (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1; @@ -4473,8 +4477,8 @@ DupParsedVarName(srcPtr, dupPtr) } static void -UpdateParsedVarName(objPtr) - Tcl_Obj *objPtr; +UpdateParsedVarName( + Tcl_Obj *objPtr) { Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1; char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2; -- cgit v0.12