summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclExecute.c406
-rw-r--r--generic/tclScan.c92
-rw-r--r--generic/tclStringObj.c482
-rw-r--r--generic/tclThread.c137
-rwxr-xr-xgeneric/tclThreadAlloc.c94
-rw-r--r--generic/tclUtil.c359
-rw-r--r--generic/tclVar.c384
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 <float.h>
/*
- * 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<<shift));
TRACE(("%s\n", O2S(objResultPtr)));
@@ -3797,8 +3809,9 @@ TclExecuteByteCode(interp, codePtr)
if ((type1 != TCL_NUMBER_BIG)
&& (shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
Tcl_WideInt w;
+
TclGetWideIntFromObj(NULL, valuePtr, &w);
- if (!(((w>0) ? w : ~w)
+ if (!(((w>0) ? w : ~w)
& -(((Tcl_WideInt)1)
<<(CHAR_BIT*sizeof(Tcl_WideInt)-1-shift)))) {
objResultPtr = Tcl_NewWideIntObj(w<<shift);
@@ -3809,8 +3822,8 @@ TclExecuteByteCode(interp, codePtr)
/*
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<<shift));
TRACE(("%s\n", O2S(objResultPtr)));
@@ -3824,21 +3837,23 @@ TclExecuteByteCode(interp, codePtr)
/* Quickly force large right shifts to 0 or -1 */
TRACE(("%s %s => ", 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 ; i<length ; i++) {
Tcl_Obj *valPtr;
int varIdx;
@@ -6347,7 +6378,7 @@ TclExecuteByteCode(interp, codePtr)
*
* PrintByteCodeInfo --
*
- * This procedure prints a summary about a bytecode object to stdout. It
+ * This procedure prints a summary about a bytecode object to stdout. It
* is called by TclExecuteByteCode when starting to execute the bytecode
* object if tclTraceExec has the value 2 or more.
*
@@ -6361,8 +6392,8 @@ TclExecuteByteCode(interp, codePtr)
*/
static void
-PrintByteCodeInfo(codePtr)
- register ByteCode *codePtr; /* The bytecode whose summary is printed to
+PrintByteCodeInfo(
+ register ByteCode *codePtr) /* The bytecode whose summary is printed to
* stdout. */
{
Proc *procPtr = codePtr->procPtr;
@@ -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 (shift<CHAR_BIT*sizeof(Tcl_WideUInt)-DIGIT_BIT) {
bits |= (((Tcl_WideUInt)big.dp[index++]) << shift);
@@ -2187,7 +2220,11 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
p += sprintf(p, "%d", precision);
length += precision;
}
- /* Don't pass length modifiers ! */
+
+ /*
+ * Don't pass length modifiers!
+ */
+
*p++ = (char) ch;
*p = '\0';
@@ -2198,12 +2235,14 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
Tcl_SetObjLength(segment, sprintf(bytes, spec, d));
break;
}
- default: {
- char buf[40];
- sprintf(buf, "bad field specifier \"%c\"", ch);
- msg = buf;
- goto errorMsg;
- }
+ default:
+ if (interp != NULL) {
+ char buf[40];
+
+ sprintf(buf, "bad field specifier \"%c\"", ch);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ }
+ goto error;
}
switch (ch) {
@@ -2266,7 +2305,8 @@ TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
*/
static int
-FormatObjVA(Tcl_Interp *interp,
+FormatObjVA(
+ Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
va_list argList)
@@ -2301,7 +2341,11 @@ FormatObjVA(Tcl_Interp *interp,
*/
int
-TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
+TclFormatObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ CONST char *format,
+ ...)
{
va_list argList;
int result;
@@ -2368,12 +2412,15 @@ ObjPrintfVA(
}
Tcl_ListObjAppendElement(NULL, list,
Tcl_NewStringObj(bytes , numBytes));
- /* We took no more than numBytes bytes from the (char *).
- * In turn, [format] will take no more than numBytes
- * characters from the Tcl_Obj. Since numBytes characters
- * must be no less than numBytes bytes, the character limit
- * will have no effect and we can just pass it through.
+
+ /*
+ * We took no more than numBytes bytes from the (char *). In
+ * turn, [format] will take no more than numBytes characters
+ * from the Tcl_Obj. Since numBytes characters must be no less
+ * than numBytes bytes, the character limit will have no
+ * effect and we can just pass it through.
*/
+
break;
}
case 'c':
@@ -2452,7 +2499,11 @@ ObjPrintfVA(
*/
int
-TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
+TclObjPrintf(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ CONST char *format,
+ ...)
{
va_list argList;
int result;
@@ -2476,7 +2527,10 @@ TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
*/
int
-TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
+TclFormatToErrorInfo(
+ Tcl_Interp *interp,
+ CONST char *format,
+ ...)
{
int code;
va_list argList;
@@ -2511,8 +2565,8 @@ TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
*/
static void
-FillUnicodeRep(objPtr)
- Tcl_Obj *objPtr; /* The object in which to fill the unicode
+FillUnicodeRep(
+ Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
String *stringPtr;
@@ -2580,10 +2634,10 @@ FillUnicodeRep(objPtr)
*/
static void
-DupStringInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must have
+DupStringInternalRep(
+ register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
* an internal rep of type "String". */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must not
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
@@ -2604,8 +2658,8 @@ DupStringInternalRep(srcPtr, copyPtr)
STRING_SIZE(srcStringPtr->uallocated));
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 ; i<recPtr->num ; 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 ; i<keyRecord.num ; i++) {
- keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
- blockPtr = (void*) *keyPtr;
+ keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
+ blockPtr = (void *) *keyPtr;
ckfree(blockPtr);
}
if (keyRecord.list != NULL) {
- ckfree((char *)keyRecord.list);
+ ckfree((char *) keyRecord.list);
keyRecord.list = NULL;
}
keyRecord.max = 0;
@@ -398,20 +396,20 @@ TclFinalizeSynchronization()
}
}
if (mutexRecord.list != NULL) {
- ckfree((char *)mutexRecord.list);
+ ckfree((char *) mutexRecord.list);
mutexRecord.list = NULL;
}
mutexRecord.max = 0;
mutexRecord.num = 0;
for (i=0 ; i<condRecord.num ; i++) {
- condPtr = (Tcl_Condition *)condRecord.list[i];
+ condPtr = (Tcl_Condition *) condRecord.list[i];
if (condPtr != NULL) {
TclpFinalizeCondition(condPtr);
}
}
if (condRecord.list != NULL) {
- ckfree((char *)condRecord.list);
+ ckfree((char *) condRecord.list);
condRecord.list = NULL;
}
condRecord.max = 0;
@@ -420,14 +418,13 @@ TclFinalizeSynchronization()
TclpMasterUnlock();
#else /* TCL_THREADS */
if (keyRecord.list != NULL) {
- ckfree((char *)keyRecord.list);
+ ckfree((char *) keyRecord.list);
keyRecord.list = NULL;
}
keyRecord.max = 0;
keyRecord.num = 0;
#endif /* TCL_THREADS */
}
-
/*
*----------------------------------------------------------------------
@@ -448,8 +445,8 @@ TclFinalizeSynchronization()
*/
void
-Tcl_ExitThread(status)
- int status;
+Tcl_ExitThread(
+ int status)
{
Tcl_FinalizeThread();
#ifdef TCL_THREADS
@@ -479,31 +476,31 @@ Tcl_ExitThread(status)
#undef Tcl_ConditionWait
void
-Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
- Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
- Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
- Tcl_Time *timePtr; /* Timeout on waiting period */
+Tcl_ConditionWait(
+ Tcl_Condition *condPtr, /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr, /* Really (pthread_mutex_t **) */
+ Tcl_Time *timePtr) /* Timeout on waiting period */
{
}
#undef Tcl_ConditionNotify
void
-Tcl_ConditionNotify(condPtr)
- Tcl_Condition *condPtr;
+Tcl_ConditionNotify(
+ Tcl_Condition *condPtr)
{
}
#undef Tcl_MutexLock
void
-Tcl_MutexLock(mutexPtr)
- Tcl_Mutex *mutexPtr;
+Tcl_MutexLock(
+ Tcl_Mutex *mutexPtr)
{
}
#undef Tcl_MutexUnlock
void
-Tcl_MutexUnlock(mutexPtr)
- Tcl_Mutex *mutexPtr;
+Tcl_MutexUnlock(
+ Tcl_Mutex *mutexPtr)
{
}
#endif /* !TCL_THREADS */
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index f36d0d7..4ec3a1a 100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.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: tclThreadAlloc.c,v 1.17 2005/07/24 22:56:44 dkf Exp $
+ * RCS: @(#) $Id: tclThreadAlloc.c,v 1.18 2005/11/02 11:55:47 dkf Exp $
*/
#include "tclInt.h"
@@ -132,16 +132,14 @@ static struct {
* Static functions defined in this file.
*/
-static void LockBucket _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static void UnlockBucket _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static void PutBlocks _ANSI_ARGS_((Cache *cachePtr, int bucket,
- int numMove));
-static int GetBlocks _ANSI_ARGS_((Cache *cachePtr, int bucket));
-static Block * Ptr2Block _ANSI_ARGS_((char *ptr));
-static char * Block2Ptr _ANSI_ARGS_((Block *blockPtr, int bucket,
- unsigned int reqSize));
-static void MoveObjs _ANSI_ARGS_((Cache *fromPtr, Cache *toPtr,
- int numMove));
+static Cache * GetCache(void);
+static void LockBucket(Cache *cachePtr, int bucket);
+static void UnlockBucket(Cache *cachePtr, int bucket);
+static void PutBlocks(Cache *cachePtr, int bucket, int numMove);
+static int GetBlocks(Cache *cachePtr, int bucket);
+static Block * Ptr2Block(char *ptr);
+static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
+static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
/*
* Local variables defined in this file and initialized at startup.
@@ -231,8 +229,8 @@ GetCache(void)
*/
void
-TclFreeAllocCache(arg)
- void *arg;
+TclFreeAllocCache(
+ void *arg)
{
Cache *cachePtr = arg;
Cache **nextPtrPtr;
@@ -290,8 +288,8 @@ TclFreeAllocCache(arg)
*/
char *
-TclpAlloc(reqSize)
- unsigned int reqSize;
+TclpAlloc(
+ unsigned int reqSize)
{
Cache *cachePtr = TclpGetAllocCache();
Block *blockPtr;
@@ -356,8 +354,8 @@ TclpAlloc(reqSize)
*/
void
-TclpFree(ptr)
- char *ptr;
+TclpFree(
+ char *ptr)
{
Cache *cachePtr;
Block *blockPtr;
@@ -415,9 +413,9 @@ TclpFree(ptr)
*/
char *
-TclpRealloc(ptr, reqSize)
- char *ptr;
- unsigned int reqSize;
+TclpRealloc(
+ char *ptr,
+ unsigned int reqSize)
{
Cache *cachePtr = TclpGetAllocCache();
Block *blockPtr;
@@ -568,8 +566,8 @@ TclThreadAllocObj(void)
*/
void
-TclThreadFreeObj(objPtr)
- Tcl_Obj *objPtr;
+TclThreadFreeObj(
+ Tcl_Obj *objPtr)
{
Cache *cachePtr = TclpGetAllocCache();
@@ -614,8 +612,8 @@ TclThreadFreeObj(objPtr)
*/
void
-Tcl_GetMemoryInfo(dsPtr)
- Tcl_DString *dsPtr;
+Tcl_GetMemoryInfo(
+ Tcl_DString *dsPtr)
{
Cache *cachePtr;
char buf[200];
@@ -665,9 +663,10 @@ Tcl_GetMemoryInfo(dsPtr)
*/
static void
-MoveObjs(fromPtr, toPtr, numMove)
- Cache *fromPtr, *toPtr;
- int numMove;
+MoveObjs(
+ Cache *fromPtr,
+ Cache *toPtr,
+ int numMove)
{
register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
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;
generated by cgit v0.12 at 2024-11-11 05:59:13 (GMT)