summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclNotify.c95
-rw-r--r--generic/tclObj.c892
-rw-r--r--generic/tclPkg.c198
-rw-r--r--generic/tclProc.c253
-rw-r--r--generic/tclRegexp.c176
-rw-r--r--generic/tclResolve.c80
-rw-r--r--generic/tclResult.c173
-rw-r--r--generic/tclTrace.c449
8 files changed, 1165 insertions, 1151 deletions
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index cb777af..d8de8d8 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNotify.c,v 1.19 2005/07/21 14:38:50 dkf Exp $
+ * RCS: @(#) $Id: tclNotify.c,v 1.20 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -89,8 +89,8 @@ TCL_DECLARE_MUTEX(listLock)
* Declarations for routines used only in this file.
*/
-static void QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
- Tcl_Event* evPtr, Tcl_QueuePosition position));
+static void QueueEvent(ThreadSpecificData *tsdPtr,
+ Tcl_Event* evPtr, Tcl_QueuePosition position);
/*
*----------------------------------------------------------------------
@@ -110,7 +110,7 @@ static void QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
*/
void
-TclInitNotifier()
+TclInitNotifier(void)
{
ThreadSpecificData *tsdPtr;
Tcl_ThreadId threadId = Tcl_GetCurrentThread();
@@ -162,7 +162,7 @@ TclInitNotifier()
*/
void
-TclFinalizeNotifier()
+TclFinalizeNotifier(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData **prevPtrPtr;
@@ -173,7 +173,7 @@ TclFinalizeNotifier()
}
Tcl_MutexLock(&(tsdPtr->queueMutex));
- for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
+ for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
hold = evPtr;
evPtr = evPtr->nextPtr;
ckfree((char *) hold);
@@ -221,8 +221,8 @@ TclFinalizeNotifier()
*/
void
-Tcl_SetNotifier(notifierProcPtr)
- Tcl_NotifierProcs *notifierProcPtr;
+Tcl_SetNotifier(
+ Tcl_NotifierProcs *notifierProcPtr)
{
#if !defined(__WIN32__) /* UNIX */
tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
@@ -272,14 +272,14 @@ Tcl_SetNotifier(notifierProcPtr)
*/
void
-Tcl_CreateEventSource(setupProc, checkProc, clientData)
- Tcl_EventSetupProc *setupProc;
+Tcl_CreateEventSource(
+ Tcl_EventSetupProc *setupProc,
/* Function to invoke to figure out what to
* wait for. */
- Tcl_EventCheckProc *checkProc;
+ Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
- ClientData clientData; /* One-word argument to pass to setupProc and
+ ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -311,14 +311,14 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
*/
void
-Tcl_DeleteEventSource(setupProc, checkProc, clientData)
- Tcl_EventSetupProc *setupProc;
+Tcl_DeleteEventSource(
+ Tcl_EventSetupProc *setupProc,
/* Function to invoke to figure out what to
* wait for. */
- Tcl_EventCheckProc *checkProc;
+ Tcl_EventCheckProc *checkProc,
/* Function to call after waiting to see what
* happened. */
- ClientData clientData; /* One-word argument to pass to setupProc and
+ ClientData clientData) /* One-word argument to pass to setupProc and
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -359,13 +359,13 @@ Tcl_DeleteEventSource(setupProc, checkProc, clientData)
*/
void
-Tcl_QueueEvent(evPtr, position)
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+Tcl_QueueEvent(
+ Tcl_Event* evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -389,14 +389,14 @@ Tcl_QueueEvent(evPtr, position)
*/
void
-Tcl_ThreadQueueEvent(threadId, evPtr, position)
- Tcl_ThreadId threadId; /* Identifier for thread to use. */
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+Tcl_ThreadQueueEvent(
+ Tcl_ThreadId threadId, /* Identifier for thread to use. */
+ Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
ThreadSpecificData *tsdPtr;
@@ -443,15 +443,15 @@ Tcl_ThreadQueueEvent(threadId, evPtr, position)
*/
static void
-QueueEvent(tsdPtr, evPtr, position)
- ThreadSpecificData *tsdPtr; /* Handle to thread local data that indicates
+QueueEvent(
+ ThreadSpecificData *tsdPtr, /* Handle to thread local data that indicates
* which event queue to use. */
- Tcl_Event* evPtr; /* Event to add to queue. The storage space
+ Tcl_Event *evPtr, /* Event to add to queue. The storage space
* must have been allocated the caller with
* malloc (ckalloc), and it becomes the
* property of the event queue. It will be
* freed after the event has been handled. */
- Tcl_QueuePosition position; /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ Tcl_QueuePosition position) /* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
* TCL_QUEUE_MARK. */
{
Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -518,23 +518,22 @@ QueueEvent(tsdPtr, evPtr, position)
*/
void
-Tcl_DeleteEvents(proc, clientData)
- Tcl_EventDeleteProc *proc; /* The function to call. */
- ClientData clientData; /* The type-specific data. */
+Tcl_DeleteEvents(
+ Tcl_EventDeleteProc *proc, /* The function to call. */
+ ClientData clientData) /* The type-specific data. */
{
Tcl_Event *evPtr, *prevPtr, *hold;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_MutexLock(&(tsdPtr->queueMutex));
- for (prevPtr = (Tcl_Event *) NULL, evPtr = tsdPtr->firstEventPtr;
- evPtr != (Tcl_Event *) NULL; /*EMPTY STEP*/) {
+ for (prevPtr=NULL, evPtr=tsdPtr->firstEventPtr; evPtr!=NULL; ) {
if ((*proc) (evPtr, clientData) == 1) {
if (tsdPtr->firstEventPtr == evPtr) {
tsdPtr->firstEventPtr = evPtr->nextPtr;
} else {
prevPtr->nextPtr = evPtr->nextPtr;
}
- if (evPtr->nextPtr == (Tcl_Event *) NULL) {
+ if (evPtr->nextPtr == NULL) {
tsdPtr->lastEventPtr = prevPtr;
}
if (tsdPtr->markerEventPtr == evPtr) {
@@ -572,8 +571,8 @@ Tcl_DeleteEvents(proc, clientData)
*/
int
-Tcl_ServiceEvent(flags)
- int flags; /* Indicates what events should be processed.
+Tcl_ServiceEvent(
+ int flags) /* Indicates what events should be processed.
* May be any combination of TCL_WINDOW_EVENTS
* TCL_FILE_EVENTS, TCL_TIMER_EVENTS, or other
* flags defined elsewhere. Events not
@@ -592,7 +591,7 @@ Tcl_ServiceEvent(flags)
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
return 1;
}
@@ -711,7 +710,7 @@ Tcl_ServiceEvent(flags)
*/
int
-Tcl_GetServiceMode()
+Tcl_GetServiceMode(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -735,8 +734,8 @@ Tcl_GetServiceMode()
*/
int
-Tcl_SetServiceMode(mode)
- int mode; /* New service mode: TCL_SERVICE_ALL or
+Tcl_SetServiceMode(
+ int mode) /* New service mode: TCL_SERVICE_ALL or
* TCL_SERVICE_NONE */
{
int oldMode;
@@ -770,8 +769,8 @@ Tcl_SetServiceMode(mode)
*/
void
-Tcl_SetMaxBlockTime(timePtr)
- Tcl_Time *timePtr; /* Specifies a maximum elapsed time for the
+Tcl_SetMaxBlockTime(
+ Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the
* next blocking operation in the event
* tsdPtr-> */
{
@@ -822,8 +821,8 @@ Tcl_SetMaxBlockTime(timePtr)
*/
int
-Tcl_DoOneEvent(flags)
- int flags; /* Miscellaneous flag values: may be any
+Tcl_DoOneEvent(
+ int flags) /* Miscellaneous flag values: may be any
* combination of TCL_DONT_WAIT,
* TCL_WINDOW_EVENTS, TCL_FILE_EVENTS,
* TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, or
@@ -839,7 +838,7 @@ Tcl_DoOneEvent(flags)
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
return 1;
}
@@ -1010,7 +1009,7 @@ Tcl_DoOneEvent(flags)
*/
int
-Tcl_ServiceAll()
+Tcl_ServiceAll(void)
{
int result = 0;
EventSource *sourcePtr;
@@ -1032,7 +1031,7 @@ Tcl_ServiceAll()
*/
if (Tcl_AsyncReady()) {
- (void) Tcl_AsyncInvoke((Tcl_Interp *) NULL, 0);
+ (void) Tcl_AsyncInvoke(NULL, 0);
}
/*
@@ -1092,8 +1091,8 @@ Tcl_ServiceAll()
*/
void
-Tcl_ThreadAlert(threadId)
- Tcl_ThreadId threadId; /* Identifier for thread to use. */
+Tcl_ThreadAlert(
+ Tcl_ThreadId threadId) /* Identifier for thread to use. */
{
ThreadSpecificData *tsdPtr;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index b76055f..f5bee03 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,7 +1,7 @@
/*
* tclObj.c --
*
- * This file contains Tcl object-related procedures that are used by many
+ * This file contains Tcl object-related functions that are used by many
* Tcl commands.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
@@ -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: tclObj.c,v 1.96 2005/10/08 14:42:45 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.97 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -36,7 +36,7 @@ TCL_DECLARE_MUTEX(tableMutex)
Tcl_Obj *tclFreeObjList = NULL;
/*
- * The object allocator is single threaded. This mutex is referenced by the
+ * The object allocator is single threaded. This mutex is referenced by the
* TclNewObj macro, however, so must be visible.
*/
@@ -65,12 +65,11 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
-
/*
* Nested Tcl_Obj deletion management support
*
* All context references used in the object freeing code are pointers to this
- * structure; every thread will have its own structure instance. The purpose
+ * structure; every thread will have its own structure instance. The purpose
* of this structure is to allow deeply nested collections of Tcl_Objs to be
* freed without taking a vast depth of C stack (which could cause all sorts
* of breakage.)
@@ -139,7 +138,6 @@ static Tcl_ThreadDataKey pendingObjDataKey;
Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
-
/*
* Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
*/
@@ -171,97 +169,79 @@ static Tcl_ThreadDataKey pendingObjDataKey;
}
/*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
*/
-static int ParseBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static int SetIntFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfDouble _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
-
+static int ParseBoolean(Tcl_Obj *objPtr);
+static int SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfDouble(Tcl_Obj *objPtr);
+static void UpdateStringOfInt(Tcl_Obj *objPtr);
#ifndef NO_WIDE_TYPE
-static void UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
#endif
-
-static void FreeBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void DupBignum _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static void UpdateStringOfBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int GetBignumFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr, int copy, mp_int *bignumValue));
+static void FreeBignum(Tcl_Obj *objPtr);
+static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
+static void UpdateStringOfBignum(Tcl_Obj *objPtr);
+static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int copy, mp_int *bignumValue);
/*
* Prototypes for the array hash key methods.
*/
-static Tcl_HashEntry * AllocObjEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
-static int CompareObjKeys _ANSI_ARGS_((
- VOID *keyPtr, Tcl_HashEntry *hPtr));
-static void FreeObjEntry _ANSI_ARGS_((
- Tcl_HashEntry *hPtr));
-static unsigned int HashObjKey _ANSI_ARGS_((
- Tcl_HashTable *tablePtr, VOID *keyPtr));
+static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
+static int CompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+static void FreeObjEntry(Tcl_HashEntry *hPtr);
+static unsigned int HashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the CommandName object type.
*/
-static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
- Tcl_Obj *copyPtr));
-static void FreeCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-
+static void DupCmdNameInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static void FreeCmdNameInternalRep(Tcl_Obj *objPtr);
+static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
* The structures below defines the Tcl object types defined in this file by
- * means of procedures that can be invoked by generic object code. See also
+ * means of functions that can be invoked by generic object code. See also
* tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
* implementations.
*/
Tcl_ObjType tclBooleanType = {
"boolean", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
SetBooleanFromAny /* setFromAnyProc */
};
-
Tcl_ObjType tclDoubleType = {
"double", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny /* setFromAnyProc */
};
-
Tcl_ObjType tclIntType = {
"int", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-
#ifndef NO_WIDE_TYPE
Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
- (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
UpdateStringOfWideInt, /* updateStringProc */
NULL /* setFromAnyProc */
};
#endif
-
-
-
Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
@@ -273,6 +253,7 @@ Tcl_ObjType tclBignumType = {
/*
* The structure below defines the Tcl obj hash key type.
*/
+
Tcl_HashKeyType tclObjHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
0, /* flags */
@@ -284,7 +265,7 @@ Tcl_HashKeyType tclObjHashKeyType = {
/*
* The structure below defines the command name Tcl object type by means of
- * procedures that can be invoked by generic object code. Objects of this type
+ * functions that can be invoked by generic object code. Objects of this type
* cache the Command pointer that results from looking up command names in the
* command hashtable. Such objects appear as the zeroth ("command name")
* argument in a Tcl command.
@@ -301,11 +282,10 @@ static Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
- (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ NULL, /* updateStringProc */
SetCmdNameFromAny /* setFromAnyProc */
};
-
/*
* Structure containing a cached pointer to a command that is the result of
* resolving the command's name in some namespace. It is the internal
@@ -340,14 +320,13 @@ typedef struct ResolvedCmdName {
* structure can be freed when refCount
* becomes zero. */
} ResolvedCmdName;
-
/*
*-------------------------------------------------------------------------
*
* TclInitObjectSubsystem --
*
- * This procedure is invoked to perform once-only initialization of the
+ * This function is invoked to perform once-only initialization of the
* type table. It also registers the object types defined in this file.
*
* Results:
@@ -361,7 +340,7 @@ typedef struct ResolvedCmdName {
*/
void
-TclInitObjSubsystem()
+TclInitObjSubsystem(void)
{
Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
@@ -400,8 +379,8 @@ TclInitObjSubsystem()
*
* TclFinalizeObjects --
*
- * This procedure is called by Tcl_Finalize to clean up all
- * registered Tcl_ObjType's and to reset the tclFreeObjList.
+ * This function is called by Tcl_Finalize to clean up all registered
+ * Tcl_ObjType's and to reset the tclFreeObjList.
*
* Results:
* None.
@@ -413,7 +392,7 @@ TclInitObjSubsystem()
*/
void
-TclFinalizeObjects()
+TclFinalizeObjects(void)
{
Tcl_MutexLock(&tableMutex);
if (typeTableInitialized) {
@@ -423,9 +402,9 @@ TclFinalizeObjects()
Tcl_MutexUnlock(&tableMutex);
/*
- * All we do here is reset the head pointer of the linked list of
- * free Tcl_Obj's to NULL; the memory finalization will take care
- * of releasing memory for us.
+ * All we do here is reset the head pointer of the linked list of free
+ * Tcl_Obj's to NULL; the memory finalization will take care of releasing
+ * memory for us.
*/
Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
@@ -437,8 +416,8 @@ TclFinalizeObjects()
*
* Tcl_RegisterObjType --
*
- * This procedure is called to register a new Tcl object type in the
- * table of all object types supported by Tcl.
+ * This function is called to register a new Tcl object type in the table
+ * of all object types supported by Tcl.
*
* Results:
* None.
@@ -452,8 +431,8 @@ TclFinalizeObjects()
*/
void
-Tcl_RegisterObjType(typePtr)
- Tcl_ObjType *typePtr; /* Information about object type; storage must
+Tcl_RegisterObjType(
+ Tcl_ObjType *typePtr) /* Information about object type; storage must
* be statically allocated (must live
* forever). */
{
@@ -469,10 +448,10 @@ Tcl_RegisterObjType(typePtr)
*
* Tcl_AppendAllObjTypes --
*
- * This procedure appends onto the argument object the name of each
- * object type as a list element. This includes the builtin object types
- * (e.g. int, list) as well as those added using Tcl_NewObj. These names
- * can be used, for example, with Tcl_GetObjType to get pointers to the
+ * This function appends onto the argument object the name of each object
+ * type as a list element. This includes the builtin object types (e.g.
+ * int, list) as well as those added using Tcl_NewObj. These names can be
+ * used, for example, with Tcl_GetObjType to get pointers to the
* corresponding Tcl_ObjType structures.
*
* Results:
@@ -489,9 +468,9 @@ Tcl_RegisterObjType(typePtr)
*/
int
-Tcl_AppendAllObjTypes(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- Tcl_Obj *objPtr; /* Points to the Tcl object onto which the
+Tcl_AppendAllObjTypes(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the
* name of each registered type is appended as
* a list element. */
{
@@ -500,7 +479,7 @@ Tcl_AppendAllObjTypes(interp, objPtr)
int objc;
Tcl_Obj **objv;
- /*
+ /*
* Get the test for a valid list out of the way first.
*/
@@ -509,13 +488,13 @@ Tcl_AppendAllObjTypes(interp, objPtr)
}
/*
- * Type names are NUL-terminated, not counted strings.
- * This code relies on that.
+ * Type names are NUL-terminated, not counted strings. This code relies on
+ * that.
*/
Tcl_MutexLock(&tableMutex);
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
}
@@ -528,7 +507,7 @@ Tcl_AppendAllObjTypes(interp, objPtr)
*
* Tcl_GetObjType --
*
- * This procedure looks up an object type by name.
+ * This function looks up an object type by name.
*
* Results:
* If an object type with name matching "typeName" is found, a pointer to
@@ -541,15 +520,15 @@ Tcl_AppendAllObjTypes(interp, objPtr)
*/
Tcl_ObjType *
-Tcl_GetObjType(typeName)
- CONST char *typeName; /* Name of Tcl object type to look up. */
+Tcl_GetObjType(
+ CONST char *typeName) /* Name of Tcl object type to look up. */
{
register Tcl_HashEntry *hPtr;
Tcl_ObjType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
- if (hPtr != (Tcl_HashEntry *) NULL) {
+ if (hPtr != NULL) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
}
Tcl_MutexUnlock(&tableMutex);
@@ -567,7 +546,7 @@ Tcl_GetObjType(typeName)
* The return value is TCL_OK on success and TCL_ERROR on failure. If
* TCL_ERROR is returned, then the interpreter's result contains an error
* message unless "interp" is NULL. Passing a NULL "interp" allows this
- * procedure to be used as a test whether the conversion could be done
+ * function to be used as a test whether the conversion could be done
* (and in fact was done).
*
* Side effects:
@@ -577,10 +556,10 @@ Tcl_GetObjType(typeName)
*/
int
-Tcl_ConvertToType(interp, objPtr, typePtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
- Tcl_ObjType *typePtr; /* The target type. */
+Tcl_ConvertToType(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* The object to convert. */
+ Tcl_ObjType *typePtr) /* The target type. */
{
if (objPtr->typePtr == typePtr) {
return TCL_OK;
@@ -618,8 +597,9 @@ Tcl_ConvertToType(interp, objPtr, typePtr)
*/
#ifdef TCL_MEM_DEBUG
-void TclDbInitNewObj(objPtr)
- register Tcl_Obj *objPtr;
+void
+TclDbInitNewObj(
+ register Tcl_Obj *objPtr)
{
objPtr->refCount = 0;
objPtr->bytes = tclEmptyStringRep;
@@ -659,13 +639,13 @@ void TclDbInitNewObj(objPtr)
*
* Tcl_NewObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
* the empty string. These objects have a NULL object type and NULL
* string representation byte pointer. Type managers call this routine to
* allocate new objects that they further initialize.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewObj.
*
* Results:
@@ -674,7 +654,7 @@ void TclDbInitNewObj(objPtr)
* to 0.
*
* Side effects:
- * If compiling with TCL_COMPILE_STATS, this procedure increments the
+ * If compiling with TCL_COMPILE_STATS, this function increments the
* global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
@@ -684,7 +664,7 @@ void TclDbInitNewObj(objPtr)
#undef Tcl_NewObj
Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
{
return Tcl_DbNewObj("unknown", 0);
}
@@ -692,7 +672,7 @@ Tcl_NewObj()
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewObj()
+Tcl_NewObj(void)
{
register Tcl_Obj *objPtr;
@@ -710,15 +690,15 @@ Tcl_NewObj()
*
* Tcl_DbNewObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
- * empty string. It is the same as the Tcl_NewObj procedure above except
+ * empty string. It is the same as the Tcl_NewObj function above except
* that it calls Tcl_DbCkalloc directly with the file name and line
* number from its caller. This simplifies debugging since then the
* [memory active] command will report the correct file name and line
* number when reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewObj.
*
* Results:
@@ -726,7 +706,7 @@ Tcl_NewObj()
* new object's typePtr is set NULL and its ref count is set to 0.
*
* Side effects:
- * If compiling with TCL_COMPILE_STATS, this procedure increments the
+ * If compiling with TCL_COMPILE_STATS, this function increments the
* global count of allocated objects (tclObjsAlloced).
*
*----------------------------------------------------------------------
@@ -735,10 +715,10 @@ Tcl_NewObj()
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewObj(file, line)
- register CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- register int line; /* Line number in the source file; used for
+Tcl_DbNewObj(
+ register CONST char *file, /* The name of the source file calling this
+ * function; used for debugging. */
+ register int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -753,10 +733,10 @@ Tcl_DbNewObj(file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewObj(file, line)
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewObj(
+ 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
* debugging. */
{
return Tcl_NewObj();
@@ -768,7 +748,7 @@ Tcl_DbNewObj(file, line)
*
* TclAllocateFreeObjects --
*
- * Procedure to allocate a number of free Tcl_Objs. This is done using a
+ * Function to allocate a number of free Tcl_Objs. This is done using a
* single ckalloc to reduce the overhead for Tcl_Obj allocation.
*
* Assumes mutex is held.
@@ -787,7 +767,7 @@ Tcl_DbNewObj(file, line)
#define OBJS_TO_ALLOC_EACH_TIME 100
void
-TclAllocateFreeObjects()
+TclAllocateFreeObjects(void)
{
size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
char *basePtr;
@@ -795,10 +775,10 @@ TclAllocateFreeObjects()
register int i;
/*
- * This has been noted by Purify to be a potential leak. The problem is
+ * This has been noted by Purify to be a potential leak. The problem is
* that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
* Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
- * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
+ * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
* but leaves it to Tcl's memory subsystem finalization to release it.
* Purify apparently can't figure that out, and fires a false alarm.
*/
@@ -809,7 +789,7 @@ TclAllocateFreeObjects()
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
- objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
+ objPtr->internalRep.otherValuePtr = (void *) prevPtr;
prevPtr = objPtr;
objPtr++;
}
@@ -822,7 +802,7 @@ TclAllocateFreeObjects()
*
* TclFreeObj --
*
- * This procedure frees the memory associated with the argument object.
+ * This function frees the memory associated with the argument object.
* It is called by the tcl.h macro Tcl_DecrRefCount when an object's ref
* count is zero. It is only "public" since it must be callable by that
* macro wherever the macro is used. It should not be directly called by
@@ -835,7 +815,7 @@ TclAllocateFreeObjects()
* Deallocates the storage for the object's Tcl_Obj structure after
* deallocating the string representation and calling the type-specific
* Tcl_FreeInternalRepProc to deallocate the object's internal
- * representation. If compiling with TCL_COMPILE_STATS, this procedure
+ * representation. If compiling with TCL_COMPILE_STATS, this function
* increments the global count of freed objects (tclObjsFreed).
*
*----------------------------------------------------------------------
@@ -843,8 +823,8 @@ TclAllocateFreeObjects()
#ifdef TCL_MEM_DEBUG
void
-TclFreeObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to be freed. */
+TclFreeObj(
+ register Tcl_Obj *objPtr) /* The object to be freed. */
{
register Tcl_ObjType *typePtr = objPtr->typePtr;
@@ -894,8 +874,8 @@ TclFreeObj(objPtr)
#else /* TCL_MEM_DEBUG */
void
-TclFreeObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to be freed. */
+TclFreeObj(
+ register Tcl_Obj *objPtr) /* The object to be freed. */
{
if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
/*
@@ -984,8 +964,8 @@ TclFreeObj(objPtr)
*/
Tcl_Obj *
-Tcl_DuplicateObj(objPtr)
- register Tcl_Obj *objPtr; /* The object to duplicate. */
+Tcl_DuplicateObj(
+ register Tcl_Obj *objPtr) /* The object to duplicate. */
{
register Tcl_ObjType *typePtr = objPtr->typePtr;
register Tcl_Obj *dupPtr;
@@ -1031,8 +1011,8 @@ Tcl_DuplicateObj(objPtr)
*/
char *
-Tcl_GetString(objPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_GetString(
+ register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be returned. */
{
if (objPtr->bytes != NULL) {
@@ -1071,10 +1051,10 @@ Tcl_GetString(objPtr)
*/
char *
-Tcl_GetStringFromObj(objPtr, lengthPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_GetStringFromObj(
+ register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
* be returned. */
- register int *lengthPtr; /* If non-NULL, the location where the string
+ register int *lengthPtr) /* If non-NULL, the location where the string
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
@@ -1097,7 +1077,7 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
*
* Tcl_InvalidateStringRep --
*
- * This procedure is called to invalidate an object's string
+ * This function is called to invalidate an object's string
* representation.
*
* Results:
@@ -1111,8 +1091,8 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
*/
void
-Tcl_InvalidateStringRep(objPtr)
- register Tcl_Obj *objPtr; /* Object whose string rep byte pointer should
+Tcl_InvalidateStringRep(
+ register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be freed. */
{
TclInvalidateStringRep(objPtr);
@@ -1124,12 +1104,12 @@ Tcl_InvalidateStringRep(objPtr)
*
* Tcl_NewBooleanObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
* initializes it from the argument boolean value. A nonzero "boolValue"
* is coerced to 1.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewBooleanObj.
*
* Results:
@@ -1146,8 +1126,8 @@ Tcl_InvalidateStringRep(objPtr)
#undef Tcl_NewBooleanObj
Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
- register int boolValue; /* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+ register int boolValue) /* Boolean used to initialize new object. */
{
return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
}
@@ -1155,8 +1135,8 @@ Tcl_NewBooleanObj(boolValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
- register int boolValue; /* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(
+ register int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
@@ -1170,15 +1150,15 @@ Tcl_NewBooleanObj(boolValue)
*
* Tcl_DbNewBooleanObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- * same as the Tcl_NewBooleanObj procedure above except that it calls
+ * same as the Tcl_NewBooleanObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewBooleanObj.
*
* Results:
@@ -1194,11 +1174,11 @@ Tcl_NewBooleanObj(boolValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
- register int boolValue; /* Boolean used to initialize new object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewBooleanObj(
+ register int boolValue, /* Boolean used to initialize new object. */
+ 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
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -1214,11 +1194,11 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
- register int boolValue; /* Boolean used to initialize new object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewBooleanObj(
+ register int boolValue, /* Boolean used to initialize new object. */
+ 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
* debugging. */
{
return Tcl_NewBooleanObj(boolValue);
@@ -1244,9 +1224,9 @@ Tcl_DbNewBooleanObj(boolValue, file, line)
*/
void
-Tcl_SetBooleanObj(objPtr, boolValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register int boolValue; /* Boolean used to set object's value. */
+Tcl_SetBooleanObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetBooleanObj called with shared object");
@@ -1275,10 +1255,10 @@ Tcl_SetBooleanObj(objPtr, boolValue)
*/
int
-Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get boolean. */
- register int *boolPtr; /* Place to store resulting boolean. */
+Tcl_GetBooleanFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get boolean. */
+ register int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
@@ -1297,7 +1277,9 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
* Use the API Tcl_GetDoubleFromObj, which does the checking and
* sets the proper error message for us.
*/
+
double d;
+
if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
return TCL_ERROR;
}
@@ -1319,8 +1301,7 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
}
#endif
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
- TclParseNumber(interp, objPtr, "boolean value",
- NULL, -1, NULL, 0)));
+ TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
}
@@ -1345,9 +1326,9 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
*/
static int
-SetBooleanFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetBooleanFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
/*
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
@@ -1363,18 +1344,25 @@ SetBooleanFromAny(interp, objPtr)
}
goto badBoolean;
}
+
#ifdef BIGNUM_AUTO_NARROW
if (objPtr->typePtr == &tclBignumType) {
goto badBoolean;
}
#else
- /* TODO: Consider tests to discover values 0 and 1 while preserving
- * pure bignum. For now, pass through string rep. */
+ /*
+ * TODO: Consider tests to discover values 0 and 1 while preserving
+ * pure bignum. For now, pass through string rep.
+ */
#endif
+
#ifndef NO_WIDE_TYPE
- /* TODO: Consider tests to discover values 0 and 1 while preserving
- * pure wide. For now, pass through string rep. */
+ /*
+ * TODO: Consider tests to discover values 0 and 1 while preserving
+ * pure wide. For now, pass through string rep.
+ */
#endif
+
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
@@ -1396,10 +1384,10 @@ SetBooleanFromAny(interp, objPtr)
}
return TCL_ERROR;
}
-
+
static int
-ParseBoolean(objPtr)
- register Tcl_Obj *objPtr; /* The object to parse/convert. */
+ParseBoolean(
+ register Tcl_Obj *objPtr) /* The object to parse/convert. */
{
int i, length, newBool;
char lowerCase[6], *str = Tcl_GetStringFromObj(objPtr, &length);
@@ -1425,7 +1413,7 @@ ParseBoolean(objPtr)
}
/*
- * Force to lower case for case-insensitive detection. Filter out known
+ * Force to lower case for case-insensitive detection. Filter out known
* invalid characters at the same time.
*/
@@ -1513,11 +1501,11 @@ ParseBoolean(objPtr)
*
* Tcl_NewDoubleObj --
*
- * This procedure is normally called when not debugging: i.e., when
+ * This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new double object and
* initializes it from the argument double value.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the result
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewDoubleObj.
*
* Results:
@@ -1534,8 +1522,8 @@ ParseBoolean(objPtr)
#undef Tcl_NewDoubleObj
Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
- register double dblValue; /* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+ register double dblValue) /* Double used to initialize the object. */
{
return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
}
@@ -1543,8 +1531,8 @@ Tcl_NewDoubleObj(dblValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
- register double dblValue; /* Double used to initialize the object. */
+Tcl_NewDoubleObj(
+ register double dblValue) /* Double used to initialize the object. */
{
register Tcl_Obj *objPtr;
@@ -1558,15 +1546,15 @@ Tcl_NewDoubleObj(dblValue)
*
* Tcl_DbNewDoubleObj --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new double objects. It is the
- * same as the Tcl_NewDoubleObj procedure above except that it calls
+ * same as the Tcl_NewDoubleObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewDoubleObj.
*
* Results:
@@ -1582,11 +1570,11 @@ Tcl_NewDoubleObj(dblValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
- register double dblValue; /* Double used to initialize the object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewDoubleObj(
+ register double dblValue, /* Double used to initialize the object. */
+ 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
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -1602,11 +1590,11 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
- register double dblValue; /* Double used to initialize the object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbNewDoubleObj(
+ register double dblValue, /* Double used to initialize the object. */
+ 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
* debugging. */
{
return Tcl_NewDoubleObj(dblValue);
@@ -1632,9 +1620,9 @@ Tcl_DbNewDoubleObj(dblValue, file, line)
*/
void
-Tcl_SetDoubleObj(objPtr, dblValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register double dblValue; /* Double used to set the object's value. */
+Tcl_SetDoubleObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register double dblValue) /* Double used to set the object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetDoubleObj called with shared object");
@@ -1664,10 +1652,10 @@ Tcl_SetDoubleObj(objPtr, dblValue)
*/
int
-Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a double. */
- register double *dblPtr; /* Place to store resulting double. */
+Tcl_GetDoubleFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a double. */
+ register double *dblPtr) /* Place to store resulting double. */
{
do {
if (objPtr->typePtr == &tclDoubleType) {
@@ -1722,12 +1710,12 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
*/
static int
-SetDoubleFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetDoubleFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
- return TclParseNumber( interp, objPtr, "floating-point number",
- NULL, -1, NULL, 0);
+ return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
+ NULL, 0);
}
/*
@@ -1737,7 +1725,7 @@ SetDoubleFromAny(interp, objPtr)
*
* Update the string representation for a double-precision floating point
* object. This must obey the current tcl_precision value for
- * double-to-string conversions. Note: This procedure does not free an
+ * double-to-string conversions. Note: This function does not free an
* existing old string rep so storage will be lost if this has not
* already been done.
*
@@ -1752,14 +1740,13 @@ SetDoubleFromAny(interp, objPtr)
*/
static void
-UpdateStringOfDouble(objPtr)
- register Tcl_Obj *objPtr; /* Double obj with string rep to update. */
+UpdateStringOfDouble(
+ register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
{
char buffer[TCL_DOUBLE_SPACE];
register int len;
- Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
- buffer);
+ Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
len = strlen(buffer);
objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
@@ -1774,7 +1761,7 @@ UpdateStringOfDouble(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj to create a new integer object end up calling the
- * debugging procedure Tcl_DbNewLongObj instead.
+ * debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewIntObj result in a call to one of the two
@@ -1801,8 +1788,8 @@ UpdateStringOfDouble(objPtr)
#undef Tcl_NewIntObj
Tcl_Obj *
-Tcl_NewIntObj(intValue)
- register int intValue; /* Int used to initialize the new object. */
+Tcl_NewIntObj(
+ register int intValue) /* Int used to initialize the new object. */
{
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}
@@ -1810,8 +1797,8 @@ Tcl_NewIntObj(intValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewIntObj(intValue)
- register int intValue; /* Int used to initialize the new object. */
+Tcl_NewIntObj(
+ register int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
@@ -1839,9 +1826,9 @@ Tcl_NewIntObj(intValue)
*/
void
-Tcl_SetIntObj(objPtr, intValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register int intValue; /* Integer used to set object's value. */
+Tcl_SetIntObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetIntObj called with shared object");
@@ -1877,10 +1864,10 @@ Tcl_SetIntObj(objPtr, intValue)
*/
int
-Tcl_GetIntFromObj(interp, objPtr, intPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a int. */
- register int *intPtr; /* Place to store resulting int. */
+Tcl_GetIntFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a int. */
+ register int *intPtr) /* Place to store resulting int. */
{
long l;
@@ -1889,14 +1876,14 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
}
if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
if (interp != NULL) {
- CONST char *s
- = "integer value too large to represent as non-long integer";
+ CONST char *s =
+ "integer value too large to represent as non-long integer";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
- *intPtr = (int)l;
+ *intPtr = (int) l;
return TCL_OK;
}
@@ -1909,7 +1896,7 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
* tclIntType, specifically.
*
* Results:
- * The return value is a standard object Tcl result. If an error occurs
+ * The return value is a standard object Tcl result. If an error occurs
* during conversion, an error message is left in the interpreter's
* result unless "interp" is NULL.
*
@@ -1917,9 +1904,9 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
*/
static int
-SetIntFromAny(interp, objPtr)
- Tcl_Interp* interp; /* Tcl interpreter */
- Tcl_Obj* objPtr; /* Pointer to the object to convert */
+SetIntFromAny(
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
long l;
return Tcl_GetLongFromObj(interp, objPtr, &l);
@@ -1930,8 +1917,8 @@ SetIntFromAny(interp, objPtr)
*
* UpdateStringOfInt --
*
- * Update the string representation for an integer object. Note: This
- * procedure does not free an existing old string rep so storage will be
+ * Update the string representation for an integer object. Note: This
+ * function does not free an existing old string rep so storage will be
* lost if this has not already been done.
*
* Results:
@@ -1945,8 +1932,8 @@ SetIntFromAny(interp, objPtr)
*/
static void
-UpdateStringOfInt(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
+UpdateStringOfInt(
+ register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
@@ -1965,7 +1952,7 @@ UpdateStringOfInt(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewLongObj to create a new long integer object end up calling the
- * debugging procedure Tcl_DbNewLongObj instead.
+ * debugging function Tcl_DbNewLongObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewLongObj result in a call to one of the two
@@ -1992,8 +1979,8 @@ UpdateStringOfInt(objPtr)
#undef Tcl_NewLongObj
Tcl_Obj *
-Tcl_NewLongObj(longValue)
- register long longValue; /* Long integer used to initialize the
+Tcl_NewLongObj(
+ register long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
@@ -2002,8 +1989,8 @@ Tcl_NewLongObj(longValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewLongObj(longValue)
- register long longValue; /* Long integer used to initialize the
+Tcl_NewLongObj(
+ register long longValue) /* Long integer used to initialize the
* new object. */
{
register Tcl_Obj *objPtr;
@@ -2020,7 +2007,7 @@ Tcl_NewLongObj(longValue)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
- * objects end up calling the debugging procedure Tcl_DbNewLongObj
+ * objects end up calling the debugging function Tcl_DbNewLongObj
* instead. We provide two implementations of Tcl_DbNewLongObj so that
* whether the Tcl core is compiled to do memory debugging of the core is
* independent of whether a client requests debugging for itself.
@@ -2032,7 +2019,7 @@ Tcl_NewLongObj(longValue)
* reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- * this procedure just returns the result of calling Tcl_NewLongObj.
+ * this function just returns the result of calling Tcl_NewLongObj.
*
* Results:
* The newly created long integer object is returned. This object will
@@ -2048,12 +2035,12 @@ Tcl_NewLongObj(longValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
- register long longValue; /* Long integer used to initialize the new
+Tcl_DbNewLongObj(
+ register long longValue, /* Long integer used to initialize the new
* object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ 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
* debugging. */
{
register Tcl_Obj *objPtr;
@@ -2069,12 +2056,12 @@ Tcl_DbNewLongObj(longValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
- register long longValue; /* Long integer used to initialize the new
+Tcl_DbNewLongObj(
+ register long longValue, /* Long integer used to initialize the new
* object. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ 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
* debugging. */
{
return Tcl_NewLongObj(longValue);
@@ -2100,9 +2087,9 @@ Tcl_DbNewLongObj(longValue, file, line)
*/
void
-Tcl_SetLongObj(objPtr, longValue)
- register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
- register long longValue; /* Long integer used to initialize the
+Tcl_SetLongObj(
+ register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
+ register long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
@@ -2134,10 +2121,10 @@ Tcl_SetLongObj(objPtr, longValue)
*/
int
-Tcl_GetLongFromObj(interp, objPtr, longPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object from which to get a long. */
- register long *longPtr; /* Place to store resulting long. */
+Tcl_GetLongFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* The object from which to get a long. */
+ register long *longPtr) /* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
@@ -2148,10 +2135,10 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
if (objPtr->typePtr == &tclWideIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
- * converted to a long, ignoring overflow. The rule preserves
+ * converted to a long, ignoring overflow. The rule preserves
* existing semantics for conversion of integers on input, but
- * avoids inadvertent demotion of wide integers to 32-bit ones
- * in the internal rep.
+ * avoids inadvertent demotion of wide integers to 32-bit ones in
+ * the internal rep.
*/
Tcl_WideInt w = objPtr->internalRep.wideValue;
@@ -2165,8 +2152,9 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj* msg =
+ Tcl_Obj *msg =
Tcl_NewStringObj("expected integer but got \"", -1);
+
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
@@ -2174,12 +2162,15 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
- /* Must check for those bignum values that can fit in
- * a long, even when auto-narrowing is enabled. Only those
- * values in the signed long range get auto-narrowed to
- * tclIntType, while all the values in the unsigned long
- * range will fit in a long. */
+ /*
+ * Must check for those bignum values that can fit in a long, even
+ * when auto-narrowing is enabled. Only those values in the signed
+ * long range get auto-narrowed to tclIntType, while all the
+ * values in the unsigned long range will fit in a long.
+ */
+
mp_int big;
+
UNPACK_BIGNUM(objPtr, big);
if (big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
/ DIGIT_BIT) {
@@ -2203,9 +2194,10 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
#endif
if (interp != NULL) {
char *s = "integer value too large to represent";
- Tcl_Obj* msg = Tcl_NewStringObj(s, -1);
+ Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
@@ -2220,9 +2212,9 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
*
* UpdateStringOfWideInt --
*
- * Update the string representation for a wide integer object. Note:
- * This procedure does not free an existing old string rep so storage
- * will be lost if this has not already been done.
+ * Update the string representation for a wide integer object. Note: this
+ * function does not free an existing old string rep so storage will be
+ * lost if this has not already been done.
*
* Results:
* None.
@@ -2235,8 +2227,8 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
*/
static void
-UpdateStringOfWideInt(objPtr)
- register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
+UpdateStringOfWideInt(
+ register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE+2];
register unsigned len;
@@ -2264,7 +2256,7 @@ UpdateStringOfWideInt(objPtr)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewWideIntObj to create a new 64-bit integer object end up calling
- * the debugging procedure Tcl_DbNewWideIntObj instead.
+ * the debugging function Tcl_DbNewWideIntObj instead.
*
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
* calls to Tcl_NewWideIntObj result in a call to one of the two
@@ -2286,9 +2278,10 @@ UpdateStringOfWideInt(objPtr)
#undef Tcl_NewWideIntObj
Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the new object. */
+Tcl_NewWideIntObj(
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the new
+ * object. */
{
return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
}
@@ -2296,9 +2289,10 @@ Tcl_NewWideIntObj(wideValue)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_NewWideIntObj(wideValue)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the new object. */
+Tcl_NewWideIntObj(
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the new
+ * object. */
{
register Tcl_Obj *objPtr;
@@ -2315,7 +2309,7 @@ Tcl_NewWideIntObj(wideValue)
*
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
* Tcl_NewWideIntObj to create new wide integer end up calling the
- * debugging procedure Tcl_DbNewWideIntObj instead. We provide two
+ * debugging function Tcl_DbNewWideIntObj instead. We provide two
* implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is
* compiled to do memory debugging of the core is independent of whether
* a client requests debugging for itself.
@@ -2327,7 +2321,7 @@ Tcl_NewWideIntObj(wideValue)
* number when reporting objects that haven't been freed.
*
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- * this procedure just returns the result of calling Tcl_NewWideIntObj.
+ * this function just returns the result of calling Tcl_NewWideIntObj.
*
* Results:
* The newly created wide integer object is returned. This object will
@@ -2343,14 +2337,14 @@ Tcl_NewWideIntObj(wideValue)
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
- register Tcl_WideInt wideValue; /* Wide integer used to initialize the
- * new object. */
- CONST char *file; /* The name of the source file calling
- * this procedure; used for
- * debugging. */
- int line; /* Line number in the source file;
- * used for debugging. */
+Tcl_DbNewWideIntObj(
+ register Tcl_WideInt wideValue,
+ /* Wide integer used to initialize the new
+ * object. */
+ 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
+ * debugging. */
{
register Tcl_Obj *objPtr;
@@ -2362,14 +2356,14 @@ Tcl_DbNewWideIntObj(wideValue, file, line)
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
-Tcl_DbNewWideIntObj(wideValue, file, line)
- register Tcl_WideInt wideValue; /* Long integer used to initialize the
- * new object. */
- CONST char *file; /* The name of the source file calling
- * this procedure; used for
- * debugging. */
- int line; /* Line number in the source file;
- * used for debugging. */
+Tcl_DbNewWideIntObj(
+ register Tcl_WideInt wideValue,
+ /* Long integer used to initialize the new
+ * object. */
+ 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
+ * debugging. */
{
return Tcl_NewWideIntObj(wideValue);
}
@@ -2394,10 +2388,11 @@ Tcl_DbNewWideIntObj(wideValue, file, line)
*/
void
-Tcl_SetWideIntObj(objPtr, wideValue)
- register Tcl_Obj *objPtr; /* Object w. internal rep to init. */
- register Tcl_WideInt wideValue; /* Wide integer used to initialize
- * the object's value. */
+Tcl_SetWideIntObj(
+ register Tcl_Obj *objPtr, /* Object w. internal rep to init. */
+ register Tcl_WideInt wideValue)
+ /* Wide integer used to initialize the
+ * object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetWideIntObj called with shared object");
@@ -2411,6 +2406,7 @@ Tcl_SetWideIntObj(objPtr, wideValue)
TclSetWideIntObj(objPtr, wideValue);
#else
mp_int big;
+
TclBNInitBignumFromWideInt(&big, wideValue);
Tcl_SetBignumObj(objPtr, &big);
#endif
@@ -2439,10 +2435,11 @@ Tcl_SetWideIntObj(objPtr, wideValue)
*/
int
-Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* Object from which to get a wide int. */
- register Tcl_WideInt *wideIntPtr; /* Place to store resulting long. */
+Tcl_GetWideIntFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
+ register Tcl_WideInt *wideIntPtr)
+ /* Place to store resulting long. */
{
do {
#ifndef NO_WIDE_TYPE
@@ -2457,7 +2454,7 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj* msg =
+ Tcl_Obj *msg =
Tcl_NewStringObj("expected integer but got \"", -1);
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
@@ -2466,16 +2463,21 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType) {
- /* Must check for those bignum values that can fit in
- * a Tcl_WideInt, even when auto-narrowing is enabled. */
+ /*
+ * Must check for those bignum values that can fit in a
+ * Tcl_WideInt, even when auto-narrowing is enabled.
+ */
+
mp_int big;
+
UNPACK_BIGNUM(objPtr, big);
if (big.used <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1)
/ DIGIT_BIT) {
Tcl_WideUInt value = 0;
unsigned long numBytes = sizeof(Tcl_WideInt);
Tcl_WideInt scratch;
- unsigned char *bytes = (unsigned char *)&scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
+
if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
@@ -2491,8 +2493,9 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
if (interp != NULL) {
char *s = "integer value too large to represent";
Tcl_Obj* msg = Tcl_NewStringObj(s, -1);
+
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
}
return TCL_ERROR;
}
@@ -2506,7 +2509,7 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
*
* FreeBignum --
*
- * This procedure frees the internal rep of a bignum.
+ * This function frees the internal rep of a bignum.
*
* Results:
* None.
@@ -2515,7 +2518,8 @@ Tcl_GetWideIntFromObj(interp, objPtr, wideIntPtr)
*/
static void
-FreeBignum(Tcl_Obj *objPtr)
+FreeBignum(
+ Tcl_Obj *objPtr)
{
mp_int toFree; /* Bignum to free */
@@ -2531,7 +2535,7 @@ FreeBignum(Tcl_Obj *objPtr)
*
* DupBignum --
*
- * This procedure duplicates the internal rep of a bignum.
+ * This function duplicates the internal rep of a bignum.
*
* Results:
* None.
@@ -2543,9 +2547,9 @@ FreeBignum(Tcl_Obj *objPtr)
*/
static void
-DupBignum(srcPtr, copyPtr)
- Tcl_Obj* srcPtr;
- Tcl_Obj* copyPtr;
+DupBignum(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
{
mp_int bignumVal;
mp_int bignumCopy;
@@ -2563,7 +2567,7 @@ DupBignum(srcPtr, copyPtr)
*
* UpdateStringOfBignum --
*
- * This procedure updates the string representation of a bignum object.
+ * This function updates the string representation of a bignum object.
*
* Results:
* None.
@@ -2573,11 +2577,12 @@ DupBignum(srcPtr, copyPtr)
* to-string conversion.
*
* The object's existing string representation is NOT freed; memory will leak
- * if the string rep is still valid at the time this procedure is called.
+ * if the string rep is still valid at the time this function is called.
*/
static void
-UpdateStringOfBignum(Tcl_Obj* objPtr)
+UpdateStringOfBignum(
+ Tcl_Obj *objPtr)
{
mp_int bignumVal;
int size;
@@ -2595,15 +2600,16 @@ UpdateStringOfBignum(Tcl_Obj* objPtr)
#endif
) {
/*
- * mp_radix_size() returns 3 when more than INT_MAX bytes would
- * be needed to hold the string rep (because mp_radix_size
- * ignores integer overflow issues). When we know the string
- * rep will be more than 3, we can conclude the string rep would
- * overflow our string length limits.
+ * mp_radix_size() returns 3 when more than INT_MAX bytes would be
+ * needed to hold the string rep (because mp_radix_size ignores
+ * integer overflow issues). When we know the string rep will be more
+ * than 3, we can conclude the string rep would overflow our string
+ * length limits.
*
- * Note that so long as we enforce our bignums to the size that
- * fits in a packed bignum, this branch will never be taken.
+ * Note that so long as we enforce our bignums to the size that fits
+ * in a packed bignum, this branch will never be taken.
*/
+
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
stringVal = Tcl_Alloc((size_t) size);
@@ -2633,16 +2639,20 @@ UpdateStringOfBignum(Tcl_Obj* objPtr)
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBignumObj
-Tcl_Obj*
-Tcl_NewBignumObj(mp_int* bignumValue)
+
+Tcl_Obj *
+Tcl_NewBignumObj(
+ mp_int *bignumValue)
{
return Tcl_DbNewBignumObj(bignumValue, "unknown", 0);
}
#else
Tcl_Obj *
-Tcl_NewBignumObj(mp_int* bignumValue)
+Tcl_NewBignumObj(
+ mp_int *bignumValue)
{
Tcl_Obj* objPtr;
+
TclNewObj(objPtr);
Tcl_SetBignumObj(objPtr, bignumValue);
return objPtr;
@@ -2654,9 +2664,9 @@ Tcl_NewBignumObj(mp_int* bignumValue)
*
* Tcl_DbNewBignumObj --
*
- * This procedure is normally called when debugging: that is, when
- * TCL_MEM_DEBUG is defined. It constructs a bignum object, recording
- * the creation point so that [memory active] can report it.
+ * This function is normally called when debugging: that is, when
+ * TCL_MEM_DEBUG is defined. It constructs a bignum object, recording the
+ * creation point so that [memory active] can report it.
*
* Results:
* Returns the newly created object.
@@ -2668,18 +2678,24 @@ Tcl_NewBignumObj(mp_int* bignumValue)
*/
#ifdef TCL_MEM_DEBUG
-Tcl_Obj*
-Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+ mp_int *bignumValue,
+ CONST char *file,
+ int line)
{
- Tcl_Obj* objPtr;
+ Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetBignumObj(objPtr, bignumValue);
return objPtr;
}
#else
-Tcl_Obj*
-Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
+Tcl_Obj *
+Tcl_DbNewBignumObj(
+ mp_int *bignumValue,
+ CONST char *file,
+ int line)
{
return Tcl_NewBignumObj(bignumValue);
}
@@ -2690,16 +2706,16 @@ Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
*
* GetBignumFromObj --
*
- * This procedure retrieves a 'bignum' value from a Tcl object,
- * converting the object if necessary. Either copies or transfers
- * the mp_int value depending on the copy flag value passed in.
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary. Either copies or transfers the mp_int value
+ * depending on the copy flag value passed in.
*
* Results:
* Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
*
* Side effects:
* A copy of bignum is stored in *bignumValue, which is expected to be
- * uninitialized or cleared. If conversion fails, and the 'interp'
+ * uninitialized or cleared. If conversion fails, and the 'interp'
* argument is not NULL, an error message is stored in the interpreter
* result.
*
@@ -2708,10 +2724,10 @@ Tcl_DbNewBignumObj(mp_int* bignumValue, CONST char* file, int line)
int
GetBignumFromObj(
- Tcl_Interp* interp, /* Tcl interpreter for error reporting */
- Tcl_Obj* objPtr, /* Object to read */
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
int copy, /* Whether to copy the returned bignum value */
- mp_int* bignumValue) /* Returned bignum value. */
+ mp_int *bignumValue) /* Returned bignum value. */
{
do {
if (objPtr->typePtr == &tclBignumType) {
@@ -2739,15 +2755,16 @@ GetBignumFromObj(
}
#ifndef NO_WIDE_TYPE
if (objPtr->typePtr == &tclWideIntType) {
- TclBNInitBignumFromWideInt(bignumValue,
+ TclBNInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
return TCL_OK;
}
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj* msg =
+ Tcl_Obj *msg =
Tcl_NewStringObj("expected integer but got \"", -1);
+
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
@@ -2764,32 +2781,31 @@ GetBignumFromObj(
*
* Tcl_GetBignumFromObj --
*
- * This procedure retrieves a 'bignum' value from a Tcl object,
- * converting the object if necessary.
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary.
*
* Results:
* Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
*
* Side effects:
* A copy of bignum is stored in *bignumValue, which is expected to be
- * uninitialized or cleared. If conversion fails, an the 'interp'
+ * uninitialized or cleared. If conversion fails, an the 'interp'
* argument is not NULL, an error message is stored in the interpreter
* result.
*
* It is expected that the caller will NOT have invoked mp_init on the
- * bignum value before passing it in. Tcl will initialize the mp_int
- * as it sets the value. The value is a copy of the value in objPtr,
- * so it becomes the responsibility of the caller to call mp_clear on
- * it.
+ * bignum value before passing it in. Tcl will initialize the mp_int as
+ * it sets the value. The value is a copy of the value in objPtr, so it
+ * becomes the responsibility of the caller to call mp_clear on it.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetBignumFromObj(
- Tcl_Interp* interp, /* Tcl interpreter for error reporting */
- Tcl_Obj* objPtr, /* Object to read */
- mp_int* bignumValue) /* Returned bignum value. */
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
+ mp_int *bignumValue) /* Returned bignum value. */
{
return GetBignumFromObj(interp, objPtr, 1, bignumValue);
}
@@ -2799,32 +2815,32 @@ Tcl_GetBignumFromObj(
*
* Tcl_GetBignumAndClearObj --
*
- * This procedure retrieves a 'bignum' value from a Tcl object,
- * converting the object if necessary.
+ * This function retrieves a 'bignum' value from a Tcl object, converting
+ * the object if necessary.
*
* Results:
* Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
*
* Side effects:
* A copy of bignum is stored in *bignumValue, which is expected to be
- * uninitialized or cleared. If conversion fails, an the 'interp'
+ * uninitialized or cleared. If conversion fails, an the 'interp'
* argument is not NULL, an error message is stored in the interpreter
* result.
*
* It is expected that the caller will NOT have invoked mp_init on the
- * bignum value before passing it in. Tcl will initialize the mp_int
- * as it sets the value. The value is transferred from the internals
- * of objPtr to the caller, passing responsibility of the caller to
- * call mp_clear on it. The objPtr is cleared to hold an empty value.
+ * bignum value before passing it in. Tcl will initialize the mp_int as
+ * it sets the value. The value is transferred from the internals of
+ * objPtr to the caller, passing responsibility of the caller to call
+ * mp_clear on it. The objPtr is cleared to hold an empty value.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetBignumAndClearObj(
- Tcl_Interp* interp, /* Tcl interpreter for error reporting */
- Tcl_Obj* objPtr, /* Object to read */
- mp_int* bignumValue) /* Returned bignum value. */
+ Tcl_Interp *interp, /* Tcl interpreter for error reporting */
+ Tcl_Obj *objPtr, /* Object to read */
+ mp_int *bignumValue) /* Returned bignum value. */
{
return GetBignumFromObj(interp, objPtr, 0, bignumValue);
}
@@ -2834,13 +2850,13 @@ Tcl_GetBignumAndClearObj(
*
* Tcl_SetBignumObj --
*
- * This procedure sets the value of a Tcl_Obj to a large integer.
+ * This function sets the value of a Tcl_Obj to a large integer.
*
* Results:
* None.
*
* Side effects:
- * Object value is stored. The bignum value is cleared, since ownership
+ * Object value is stored. The bignum value is cleared, since ownership
* has transferred to Tcl.
*
*----------------------------------------------------------------------
@@ -2848,8 +2864,8 @@ Tcl_GetBignumAndClearObj(
void
Tcl_SetBignumObj(
- Tcl_Obj* objPtr, /* Object to set */
- mp_int* bignumValue) /* Value to store */
+ Tcl_Obj *objPtr, /* Object to set */
+ mp_int *bignumValue) /* Value to store */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("Tcl_SetBignumObj called with shared object");
@@ -2909,11 +2925,11 @@ Tcl_SetBignumObj(
TclFreeIntRep(objPtr);
TclSetBignumIntRep(objPtr, bignumValue);
}
-
+
void
-TclSetBignumIntRep(objPtr, bignumValue)
- Tcl_Obj *objPtr;
- mp_int *bignumValue;
+TclSetBignumIntRep(
+ Tcl_Obj *objPtr,
+ mp_int *bignumValue)
{
objPtr->typePtr = &tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
@@ -2941,11 +2957,11 @@ TclSetBignumIntRep(objPtr, bignumValue)
*----------------------------------------------------------------------
*/
-int TclGetNumberFromObj(interp, objPtr, clientDataPtr, typePtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
- ClientData *clientDataPtr;
- int *typePtr;
+int TclGetNumberFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ ClientData *clientDataPtr,
+ int *typePtr)
{
do {
if (objPtr->typePtr == &tclDoubleType) {
@@ -2971,7 +2987,8 @@ int TclGetNumberFromObj(interp, objPtr, clientDataPtr, typePtr)
#endif
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
- mp_int *bigPtr = Tcl_GetThreadData(&bignumKey, (int)sizeof(mp_int));
+ mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
+ (int) sizeof(mp_int));
UNPACK_BIGNUM( objPtr, *bigPtr );
*typePtr = TCL_NUMBER_BIG;
*clientDataPtr = bigPtr;
@@ -2987,11 +3004,11 @@ int TclGetNumberFromObj(interp, objPtr, clientDataPtr, typePtr)
*
* Tcl_DbIncrRefCount --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
* has been freed before incrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just increments the
+ * When TCL_MEM_DEBUG is not defined, this function just increments the
* reference count of the object.
*
* Results:
@@ -3004,12 +3021,12 @@ int TclGetNumberFromObj(interp, objPtr, clientDataPtr, typePtr)
*/
void
-Tcl_DbIncrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are registering a reference
+Tcl_DbIncrRefCount(
+ register Tcl_Obj *objPtr, /* The object we are registering a reference
* to. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ 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
* debugging. */
{
#ifdef TCL_MEM_DEBUG
@@ -3052,11 +3069,11 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*
* Tcl_DbDecrRefCount --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not the memory
* has been freed before decrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just decrements the
+ * When TCL_MEM_DEBUG is not defined, this function just decrements the
* reference count of the object.
*
* Results:
@@ -3069,12 +3086,12 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*/
void
-Tcl_DbDecrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are releasing a reference
+Tcl_DbDecrRefCount(
+ register Tcl_Obj *objPtr, /* The object we are releasing a reference
* to. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+ 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
* debugging. */
{
#ifdef TCL_MEM_DEBUG
@@ -3124,11 +3141,11 @@ Tcl_DbDecrRefCount(objPtr, file, line)
*
* Tcl_DbIsShared --
*
- * This procedure is normally called when debugging: i.e., when
+ * This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It tests whether the object has a ref count
* greater than one.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just tests if the
+ * When TCL_MEM_DEBUG is not defined, this function just tests if the
* object has a ref count greater than one.
*
* Results:
@@ -3141,11 +3158,11 @@ Tcl_DbDecrRefCount(objPtr, file, line)
*/
int
-Tcl_DbIsShared(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object to test for being shared. */
- CONST char *file; /* The name of the source file calling this
- * procedure; used for debugging. */
- int line; /* Line number in the source file; used for
+Tcl_DbIsShared(
+ register Tcl_Obj *objPtr, /* The object to test for being shared. */
+ 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
* debugging. */
{
#ifdef TCL_MEM_DEBUG
@@ -3214,8 +3231,8 @@ Tcl_DbIsShared(objPtr, file, line)
*/
void
-Tcl_InitObjHashTable(tablePtr)
- register Tcl_HashTable *tablePtr;
+Tcl_InitObjHashTable(
+ register Tcl_HashTable *tablePtr)
/* Pointer to table record, which is supplied
* by the caller. */
{
@@ -3240,9 +3257,9 @@ Tcl_InitObjHashTable(tablePtr)
*/
static Tcl_HashEntry *
-AllocObjEntry(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key to store in the hash table entry. */
+AllocObjEntry(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
Tcl_HashEntry *hPtr;
@@ -3272,9 +3289,9 @@ AllocObjEntry(tablePtr, keyPtr)
*/
static int
-CompareObjKeys(keyPtr, hPtr)
- VOID *keyPtr; /* New key to compare. */
- Tcl_HashEntry *hPtr; /* Existing key to compare. */
+CompareObjKeys(
+ void *keyPtr, /* New key to compare. */
+ Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
@@ -3334,8 +3351,8 @@ CompareObjKeys(keyPtr, hPtr)
*/
static void
-FreeObjEntry(hPtr)
- Tcl_HashEntry *hPtr; /* Hash entry to free. */
+FreeObjEntry(
+ Tcl_HashEntry *hPtr) /* Hash entry to free. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
@@ -3362,9 +3379,9 @@ FreeObjEntry(hPtr)
*/
static unsigned int
-HashObjKey(tablePtr, keyPtr)
- Tcl_HashTable *tablePtr; /* Hash table. */
- VOID *keyPtr; /* Key from which to compute hash value. */
+HashObjKey(
+ Tcl_HashTable *tablePtr, /* Hash table. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
CONST char *string = TclGetString(objPtr);
@@ -3374,17 +3391,17 @@ HashObjKey(tablePtr, keyPtr)
/*
* I tried a zillion different hash functions and asked many other people
- * for advice. Many people had their own favorite functions, all
- * different, but no-one had much idea why they were good ones. I chose
+ * for advice. Many people had their own favorite functions, all
+ * different, but no-one had much idea why they were good ones. I chose
* the one below (multiply by 9 and add new character) because of the
* following reasons:
*
* 1. Multiplying by 10 is perfect for keys that are decimal strings, and
* multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
* character's bits hang around in the low-order bits of the hash value
* for ever, plus they spread fairly rapidly up to the high-order bits
- * to fill out the hash value. This seems works well both for decimal
+ * to fill out the hash value. This seems works well both for decimal
* and *non-decimal strings.
*/
@@ -3407,17 +3424,17 @@ HashObjKey(tablePtr, keyPtr)
*
* Side effects:
* May update the internal representation for the object, caching the
- * command reference so that the next time this procedure is called with
+ * command reference so that the next time this function is called with
* the same object, the command can be found quickly.
*
*----------------------------------------------------------------------
*/
Tcl_Command
-Tcl_GetCommandFromObj(interp, objPtr)
- Tcl_Interp *interp; /* The interpreter in which to resolve the
+Tcl_GetCommandFromObj(
+ Tcl_Interp *interp, /* The interpreter in which to resolve the
* command and to report errors. */
- register Tcl_Obj *objPtr; /* The object containing the command's name.
+ register Tcl_Obj *objPtr) /* The object containing the command's name.
* If the name starts with "::", will be
* looked up in global namespace. Else, looked
* up first in the current namespace, then in
@@ -3527,12 +3544,12 @@ Tcl_GetCommandFromObj(interp, objPtr)
*/
void
-TclSetCmdNameObj(interp, objPtr, cmdPtr)
- Tcl_Interp *interp; /* Points to interpreter containing command
+TclSetCmdNameObj(
+ Tcl_Interp *interp, /* Points to interpreter containing command
* that should be cached in objPtr. */
- register Tcl_Obj *objPtr; /* Points to Tcl object to be changed to a
+ register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
* CmdName object. */
- Command *cmdPtr; /* Points to Command structure that the
+ Command *cmdPtr) /* Points to Command structure that the
* CmdName object should refer to. */
{
Interp *iPtr = (Interp *) interp;
@@ -3579,7 +3596,7 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
resPtr->refCount = 1;
TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
@@ -3608,8 +3625,8 @@ TclSetCmdNameObj(interp, objPtr, cmdPtr)
*/
static void
-FreeCmdNameInternalRep(objPtr)
- register Tcl_Obj *objPtr; /* CmdName object with internal
+FreeCmdNameInternalRep(
+ register Tcl_Obj *objPtr) /* CmdName object with internal
* representation to free. */
{
register ResolvedCmdName *resPtr =
@@ -3617,7 +3634,7 @@ FreeCmdNameInternalRep(objPtr)
if (resPtr != NULL) {
/*
- * Decrement the reference count of the ResolvedCmdName structure. If
+ * Decrement the reference count of the ResolvedCmdName structure. If
* there are no more uses, free the ResolvedCmdName structure.
*/
@@ -3657,14 +3674,14 @@ FreeCmdNameInternalRep(objPtr)
*/
static void
-DupCmdNameInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupCmdNameInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
register ResolvedCmdName *resPtr = (ResolvedCmdName *)
srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
if (resPtr != NULL) {
resPtr->refCount++;
@@ -3694,9 +3711,9 @@ DupCmdNameInternalRep(srcPtr, copyPtr)
*/
static int
-SetCmdNameFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetCmdNameFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
char *name;
@@ -3722,8 +3739,7 @@ SetCmdNameFromAny(interp, objPtr)
* referenced from a CmdName object.
*/
- cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
- /*flags*/ 0);
+ cmd = Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
cmdPtr = (Command *) cmd;
if (cmdPtr != NULL) {
/*
@@ -3756,7 +3772,7 @@ SetCmdNameFromAny(interp, objPtr)
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclCmdNameType;
return TCL_OK;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 397acd9..20f3be6 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -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: tclPkg.c,v 1.12 2005/07/19 22:45:35 dkf Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.13 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -23,7 +23,7 @@
typedef struct PkgAvail {
char *version; /* Version string; malloc'ed. */
char *script; /* Script to invoke to provide this version of
- * the package. Malloc'ed and protected by
+ * the package. Malloc'ed and protected by
* Tcl_Preserve and Tcl_Release. */
struct PkgAvail *nextPtr; /* Next in list of available versions of the
* same package. */
@@ -31,7 +31,7 @@ typedef struct PkgAvail {
/*
* For each package that is known in any way to an interpreter, there is one
- * record of the following type. These records are stored in the
+ * record of the following type. These records are stored in the
* "packageTable" hash table in the interpreter, keyed by package name such as
* "Tk" (no version number).
*/
@@ -39,7 +39,7 @@ typedef struct PkgAvail {
typedef struct Package {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
- * (malloc'ed). NULL means the package
+ * (malloc'ed). NULL means the package
* doesn't exist in this interpreter yet. */
PkgAvail *availPtr; /* First in list of all available versions of
* this package. */
@@ -47,22 +47,20 @@ typedef struct Package {
} Package;
/*
- * Prototypes for procedures defined in this file:
+ * Prototypes for functions defined in this file:
*/
-static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *string));
-static int ComparePkgVersions _ANSI_ARGS_((CONST char *v1,
- CONST char *v2, int *satPtr));
-static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *name));
+static int CheckVersion(Tcl_Interp *interp, CONST char *string);
+static int ComparePkgVersions(CONST char *v1, CONST char *v2,
+ int *satPtr);
+static Package * FindPackage(Tcl_Interp *interp, CONST char *name);
/*
*----------------------------------------------------------------------
*
* Tcl_PkgProvide / Tcl_PkgProvideEx --
*
- * This procedure is invoked to declare that a particular version of a
+ * This function is invoked to declare that a particular version of a
* particular package is now present in an interpreter. There must not be
* any other version of this package already provided in the interpreter.
*
@@ -79,22 +77,22 @@ static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
*/
int
-Tcl_PkgProvide(interp, name, version)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgProvide(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of package. */
- CONST char *version; /* Version string for package. */
+ CONST char *name, /* Name of package. */
+ CONST char *version) /* Version string for package. */
{
return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
}
int
-Tcl_PkgProvideEx(interp, name, version, clientData)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgProvideEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of package. */
- CONST char *version; /* Version string for package. */
- ClientData clientData; /* clientdata for this package (normally used
+ CONST char *name, /* Name of package. */
+ CONST char *version, /* Version string for package. */
+ ClientData clientData) /* clientdata for this package (normally used
* for C callback function table) */
{
Package *pkgPtr;
@@ -106,14 +104,14 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
pkgPtr->clientData = clientData;
return TCL_OK;
}
- if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
+ if (ComparePkgVersions(pkgPtr->version, version, NULL) == 0) {
if (clientData != NULL) {
pkgPtr->clientData = clientData;
}
return TCL_OK;
}
Tcl_AppendResult(interp, "conflicting versions provided for package \"",
- name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
+ name, "\": ", pkgPtr->version, ", then ", version, NULL);
return TCL_ERROR;
}
@@ -122,10 +120,10 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
*
* Tcl_PkgRequire / Tcl_PkgRequireEx --
*
- * This procedure is called by code that depends on a particular version
+ * This function is called by code that depends on a particular version
* of a particular package. If the package is not already provided in the
- * interpreter, this procedure invokes a Tcl script to provide it. If the
- * package is already provided, this procedure makes sure that the
+ * interpreter, this function invokes a Tcl script to provide it. If the
+ * package is already provided, this function makes sure that the
* caller's needs don't conflict with the version that is present.
*
* Results:
@@ -145,30 +143,30 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
*/
CONST char *
-Tcl_PkgRequire(interp, name, version, exact)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgRequire(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ CONST char *name, /* Name of desired package. */
+ CONST char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact) /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
{
- return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
+ return Tcl_PkgRequireEx(interp, name, version, exact, NULL);
}
CONST char *
-Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgRequireEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ CONST char *name, /* Name of desired package. */
+ CONST char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- ClientData *clientDataPtr; /* Used to return the client data for this
+ ClientData *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
@@ -189,7 +187,6 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*/
if (tclEmptyStringRep == NULL) {
-
/*
* OK, so what's going on here?
*
@@ -265,7 +262,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
}
/*
- * The package isn't yet present. Search the list of available
+ * The package isn't yet present. Search the list of available
* versions and invoke the script for the best available version.
*/
@@ -273,7 +270,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version,
- bestPtr->version, (int *) NULL) <= 0)) {
+ bestPtr->version, NULL) <= 0)) {
continue;
}
if (version != NULL) {
@@ -290,7 +287,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
}
if (bestPtr != NULL) {
/*
- * We found an ifneeded script for the package. Be careful while
+ * We found an ifneeded script for the package. Be careful while
* executing it: this could cause reentrancy, so (a) protect the
* script itself from deletion and (b) don't assume that bestPtr
* will still exist when the script completes.
@@ -313,7 +310,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
}
/*
- * Package not in the database. If there is a "package unknown"
+ * Package not in the database. If there is a "package unknown"
* command, invoke it (but only on the first pass; after that, we
* should not get here in the first place).
*/
@@ -346,16 +343,15 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
}
if (pkgPtr->version == NULL) {
- Tcl_AppendResult(interp, "can't find package ", name,
- (char *) NULL);
+ Tcl_AppendResult(interp, "can't find package ", name, NULL);
if (version != NULL) {
- Tcl_AppendResult(interp, " ", version, (char *) NULL);
+ Tcl_AppendResult(interp, " ", version, NULL);
}
return NULL;
}
/*
- * At this point we know that the package is present. Make sure that the
+ * At this point we know that the package is present. Make sure that the
* provided version meets the current requirement.
*/
@@ -373,8 +369,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
return pkgPtr->version;
}
Tcl_AppendResult(interp, "version conflict for package \"",
- name, "\": have ", pkgPtr->version, ", need ", version,
- (char *) NULL);
+ name, "\": have ", pkgPtr->version, ", need ", version, NULL);
return NULL;
}
@@ -400,30 +395,30 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*/
CONST char *
-Tcl_PkgPresent(interp, name, version, exact)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgPresent(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ CONST char *name, /* Name of desired package. */
+ CONST char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact) /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
{
- return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
+ return Tcl_PkgPresentEx(interp, name, version, exact, NULL);
}
CONST char *
-Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
- Tcl_Interp *interp; /* Interpreter in which package is now
+Tcl_PkgPresentEx(
+ Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
- CONST char *name; /* Name of desired package. */
- CONST char *version; /* Version string for desired version; NULL
+ CONST char *name, /* Name of desired package. */
+ CONST char *version, /* Version string for desired version; NULL
* means use the latest version available. */
- int exact; /* Non-zero means that only the particular
+ int exact, /* Non-zero means that only the particular
* version given is acceptable. Zero means use
* the latest compatible version. */
- ClientData *clientDataPtr; /* Used to return the client data for this
+ ClientData *clientDataPtr) /* Used to return the client data for this
* package. If it is NULL then the client data
* is not returned. This is unchanged if this
* call fails for any reason. */
@@ -458,18 +453,16 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
return pkgPtr->version;
}
Tcl_AppendResult(interp, "version conflict for package \"", name,
- "\": have ", pkgPtr->version, ", need ", version,
- (char *) NULL);
+ "\": have ", pkgPtr->version, ", need ", version, NULL);
return NULL;
}
}
if (version != NULL) {
Tcl_AppendResult(interp, "package ", name, " ", version,
- " is not present", (char *) NULL);
+ " is not present", NULL);
} else {
- Tcl_AppendResult(interp, "package ", name, " is not present",
- (char *) NULL);
+ Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
}
return NULL;
}
@@ -479,8 +472,8 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
*
* Tcl_PackageObjCmd --
*
- * This procedure is invoked to process the "package" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "package" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -493,15 +486,15 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
/* ARGSUSED */
int
-Tcl_PackageObjCmd(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_PackageObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
static CONST char *pkgOptions[] = {
"forget", "ifneeded", "names", "present", "provide", "require",
- "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL
+ "unknown", "vcompare", "versions", "vsatisfies", NULL
};
enum pkgOptions {
PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT,
@@ -577,7 +570,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
argv3 = Tcl_GetStringFromObj(objv[3], &length);
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
prevPtr = availPtr, availPtr = availPtr->nextPtr) {
- if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL)==0){
+ if (ComparePkgVersions(availPtr->version, argv3, NULL) == 0){
if (objc == 4) {
Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
return TCL_OK;
@@ -634,7 +627,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
}
version = NULL;
if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
+ version = Tcl_GetString(objv[3 + exact]);
if (CheckVersion(interp, version) != TCL_OK) {
return TCL_ERROR;
}
@@ -642,7 +635,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
goto presentSyntax;
}
if (exact) {
- argv3 = Tcl_GetString(objv[3]);
+ argv3 = Tcl_GetString(objv[3]);
version = Tcl_PkgPresent(interp, argv3, version, exact);
} else {
version = Tcl_PkgPresent(interp, argv2, version, exact);
@@ -687,7 +680,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
}
version = NULL;
if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
+ version = Tcl_GetString(objv[3 + exact]);
if (CheckVersion(interp, version) != TCL_OK) {
return TCL_ERROR;
}
@@ -695,7 +688,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
goto requireSyntax;
}
if (exact) {
- argv3 = Tcl_GetString(objv[3]);
+ argv3 = Tcl_GetString(objv[3]);
version = Tcl_PkgRequire(interp, argv3, version, exact);
} else {
version = Tcl_PkgRequire(interp, argv2, version, exact);
@@ -740,8 +733,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
|| (CheckVersion(interp, argv3) != TCL_OK)) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- ComparePkgVersions(argv2, argv3, (int *) NULL)));
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(ComparePkgVersions(argv2, argv3, NULL)));
break;
case PKG_VERSIONS:
if (objc != 3) {
@@ -783,7 +776,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
*
* FindPackage --
*
- * This procedure finds the Package record for a particular package in a
+ * This function finds the Package record for a particular package in a
* particular interpreter, creating a record if one doesn't already
* exist.
*
@@ -797,9 +790,9 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
*/
static Package *
-FindPackage(interp, name)
- Tcl_Interp *interp; /* Interpreter to use for package lookup. */
- CONST char *name; /* Name of package to fine. */
+FindPackage(
+ Tcl_Interp *interp, /* Interpreter to use for package lookup. */
+ CONST char *name) /* Name of package to fine. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
@@ -824,8 +817,8 @@ FindPackage(interp, name)
*
* TclFreePackageInfo --
*
- * This procedure is called during interpreter deletion to free all of
- * the package-related information for the interpreter.
+ * This function is called during interpreter deletion to free all of the
+ * package-related information for the interpreter.
*
* Results:
* None.
@@ -837,8 +830,8 @@ FindPackage(interp, name)
*/
void
-TclFreePackageInfo(iPtr)
- Interp *iPtr; /* Interpereter that is being deleted. */
+TclFreePackageInfo(
+ Interp *iPtr) /* Interpereter that is being deleted. */
{
Package *pkgPtr;
Tcl_HashSearch search;
@@ -846,7 +839,7 @@ TclFreePackageInfo(iPtr)
PkgAvail *availPtr;
for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
ckfree(pkgPtr->version);
@@ -871,8 +864,7 @@ TclFreePackageInfo(iPtr)
*
* CheckVersion --
*
- * This procedure checks to see whether a version number has valid
- * syntax.
+ * This function checks to see whether a version number has valid syntax.
*
* Results:
* If string is a properly formed version number the TCL_OK is returned.
@@ -886,9 +878,9 @@ TclFreePackageInfo(iPtr)
*/
static int
-CheckVersion(interp, string)
- Tcl_Interp *interp; /* Used for error reporting. */
- CONST char *string; /* Supposedly a version number, which is
+CheckVersion(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ CONST char *string) /* Supposedly a version number, which is
* groups of decimal digits separated by
* dots. */
{
@@ -911,7 +903,7 @@ CheckVersion(interp, string)
error:
Tcl_AppendResult(interp, "expected version number but got \"", string,
- "\"", (char *) NULL);
+ "\"", NULL);
return TCL_ERROR;
}
@@ -920,11 +912,11 @@ CheckVersion(interp, string)
*
* ComparePkgVersions --
*
- * This procedure compares two version numbers.
+ * This function compares two version numbers.
*
* Results:
* The return value is -1 if v1 is less than v2, 0 if the two version
- * numbers are the same, and 1 if v1 is greater than v2. If *satPtr is
+ * numbers are the same, and 1 if v1 is greater than v2. If *satPtr is
* non-NULL, the word it points to is filled in with 1 if v2 >= v1 and
* both numbers have the same major number or 0 otherwise.
*
@@ -935,11 +927,11 @@ CheckVersion(interp, string)
*/
static int
-ComparePkgVersions(v1, v2, satPtr)
- CONST char *v1;
- CONST char *v2; /* Versions strings, of form 2.1.3 (any number
+ComparePkgVersions(
+ CONST char *v1,
+ CONST char *v2, /* Versions strings, of form 2.1.3 (any number
* of version numbers). */
- int *satPtr; /* If non-null, the word pointed to is filled
+ int *satPtr) /* If non-null, the word pointed to is filled
* in with a 0/1 value. 1 means v1 "satisfies"
* v2: v1 is greater than or equal to v2 and
* both version numbers have the same major
@@ -949,7 +941,7 @@ ComparePkgVersions(v1, v2, satPtr)
/*
* Each iteration of the following loop processes one number from each
- * string, terminated by a ".". If those numbers don't match then the
+ * string, terminated by a ".". If those numbers don't match then the
* comparison is over; otherwise, we loop back for the next number.
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index b6f73e7..126d73b 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.81 2005/10/08 14:42:45 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.82 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -20,16 +20,15 @@
* Prototypes for static functions in this file
*/
-static void ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
-static void ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
- char *procName, int nameLen, int returnCode));
-static int TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-
-static void InitCompiledLocals _ANSI_ARGS_((Tcl_Interp *interp,
- ByteCode *codePtr, CompiledLocal *localPtr,
- Var *varPtr, Namespace *nsPtr));
+static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void ProcBodyFree(Tcl_Obj *objPtr);
+static int ProcessProcResultCode(Tcl_Interp *interp,
+ char *procName, int nameLen, int returnCode);
+static int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr,
+ struct CompileEnv *envPtr);
+static void InitCompiledLocals(Tcl_Interp *interp,
+ ByteCode *codePtr, CompiledLocal *localPtr,
+ Var *varPtr, Namespace *nsPtr);
/*
* The ProcBodyObjType type
@@ -79,11 +78,11 @@ static Tcl_ObjType levelReferenceType = {
/* ARGSUSED */
int
-Tcl_ProcObjCmd(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_ProcObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
Proc *procPtr;
@@ -105,24 +104,24 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
*/
fullName = TclGetString(objv[1]);
- TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL, 0,
+ TclGetNamespaceForQualName(interp, fullName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", (char *) NULL);
+ "\": unknown namespace", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", (char *) NULL);
+ "\": bad procedure name", NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
Tcl_AppendResult(interp, "can't create procedure \"", procName,
"\" in non-global namespace with name starting with \":\"",
- (char *) NULL);
+ NULL);
return TCL_ERROR;
}
@@ -246,13 +245,13 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
*/
int
-TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
- Tcl_Interp *interp; /* interpreter containing proc */
- Namespace *nsPtr; /* namespace containing this proc */
- CONST char *procName; /* unqualified name of this proc */
- Tcl_Obj *argsPtr; /* description of arguments */
- Tcl_Obj *bodyPtr; /* command body */
- Proc **procPtrPtr; /* returns: pointer to proc data */
+TclCreateProc(
+ Tcl_Interp *interp, /* interpreter containing proc */
+ Namespace *nsPtr, /* namespace containing this proc */
+ CONST char *procName, /* unqualified name of this proc */
+ Tcl_Obj *argsPtr, /* description of arguments */
+ Tcl_Obj *bodyPtr, /* command body */
+ Proc **procPtrPtr) /* returns: pointer to proc data */
{
Interp *iPtr = (Interp*)interp;
CONST char **argArray = NULL;
@@ -322,11 +321,11 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
/*
* Break up the argument list into argument specifiers, then process each
- * argument specifier. If the body is precompiled, processing is limited
+ * argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*
- * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
+ * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
*/
args = Tcl_GetStringFromObj(argsPtr, &length);
@@ -368,13 +367,13 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
ckfree((char *) fieldValues);
Tcl_AppendResult(interp,
"too many fields in argument specifier \"",
- argArray[i], "\"", (char *) NULL);
+ argArray[i], "\"", NULL);
goto procError;
}
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
ckfree((char *) fieldValues);
Tcl_AppendResult(interp, "procedure \"", procName,
- "\" has argument with no name", (char *) NULL);
+ "\" has argument with no name", NULL);
goto procError;
}
@@ -400,14 +399,14 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (*q == ')') { /* we have an array element */
Tcl_AppendResult(interp, "procedure \"", procName,
"\" has formal parameter \"", fieldValues[0],
- "\" that is an array element", (char *) NULL);
+ "\" that is an array element", NULL);
ckfree((char *) fieldValues);
goto procError;
}
} else if ((*p == ':') && (*(p+1) == ':')) {
Tcl_AppendResult(interp, "procedure \"", procName,
"\" has formal parameter \"", fieldValues[0],
- "\" that is not a simple name", (char *) NULL);
+ "\" that is not a simple name", NULL);
ckfree((char *) fieldValues);
goto procError;
}
@@ -548,7 +547,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* The return value is -1 if an error occurred in finding the frame (in
* this case an error message is left in the interp's result). 1 is
* returned if string was either a number or a number preceded by "#" and
- * it specified a valid frame. 0 is returned if string isn't one of the
+ * it specified a valid frame. 0 is returned if string isn't one of the
* two things above (in this case, the lookup acts as if string were
* "1"). The variable pointed to by framePtrPtr is filled in with the
* address of the desired frame (unless an error occurs, in which case it
@@ -561,10 +560,10 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
*/
int
-TclGetFrame(interp, name, framePtrPtr)
- Tcl_Interp *interp; /* Interpreter in which to find frame. */
- CONST char *name; /* String describing frame. */
- CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL if
+TclGetFrame(
+ Tcl_Interp *interp, /* Interpreter in which to find frame. */
+ CONST char *name, /* String describing frame. */
+ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
@@ -613,7 +612,7 @@ TclGetFrame(interp, name, framePtrPtr)
levelError:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
return -1;
}
@@ -643,10 +642,10 @@ TclGetFrame(interp, name, framePtrPtr)
*/
int
-TclObjGetFrame(interp, objPtr, framePtrPtr)
- Tcl_Interp *interp; /* Interpreter in which to find frame. */
- Tcl_Obj *objPtr; /* Object describing frame. */
- CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL if
+TclObjGetFrame(
+ Tcl_Interp *interp, /* Interpreter in which to find frame. */
+ Tcl_Obj *objPtr, /* Object describing frame. */
+ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
@@ -693,8 +692,8 @@ TclObjGetFrame(interp, objPtr, framePtrPtr)
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 0;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
+ objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
+ objPtr->internalRep.twoPtrValue.ptr2 = (void *) level;
} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
return -1;
@@ -708,8 +707,8 @@ TclObjGetFrame(interp, objPtr, framePtrPtr)
TclFreeIntRep(objPtr);
objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 1;
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
+ objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
+ objPtr->internalRep.twoPtrValue.ptr2 = (void *) level;
level = curLevel - level;
} else {
/*
@@ -743,7 +742,7 @@ TclObjGetFrame(interp, objPtr, framePtrPtr)
levelError:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
return -1;
}
@@ -766,11 +765,11 @@ TclObjGetFrame(interp, objPtr, framePtrPtr)
/* ARGSUSED */
int
-Tcl_UplevelObjCmd(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_UplevelObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
int result;
@@ -812,7 +811,7 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
} else {
/*
* More than one argument: concatenate them together with spaces
- * between, then evaluate the result. Tcl_EvalObjEx will delete the
+ * between, then evaluate the result. Tcl_EvalObjEx will delete the
* object when it decrements its refcount after eval'ing it.
*/
@@ -858,16 +857,15 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
*/
Proc *
-TclFindProc(iPtr, procName)
- Interp *iPtr; /* Interpreter in which to look. */
- CONST char *procName; /* Name of desired procedure. */
+TclFindProc(
+ Interp *iPtr, /* Interpreter in which to look. */
+ CONST char *procName) /* Name of desired procedure. */
{
Tcl_Command cmd;
Tcl_Command origCmd;
Command *cmdPtr;
- cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
- (Tcl_Namespace *) NULL, /*flags*/ 0);
+ cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0);
if (cmd == (Tcl_Command) NULL) {
return NULL;
}
@@ -902,8 +900,8 @@ TclFindProc(iPtr, procName)
*/
Proc *
-TclIsProc(cmdPtr)
- Command *cmdPtr; /* Command to test. */
+TclIsProc(
+ Command *cmdPtr) /* Command to test. */
{
Tcl_Command origCmd;
@@ -936,12 +934,12 @@ TclIsProc(cmdPtr)
*/
static void
-InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- ByteCode *codePtr;
- CompiledLocal *localPtr;
- Var *varPtr;
- Namespace *nsPtr; /* Pointer to current namespace. */
+InitCompiledLocals(
+ Tcl_Interp *interp, /* Current interpreter. */
+ ByteCode *codePtr,
+ CompiledLocal *localPtr,
+ Var *varPtr,
+ Namespace *nsPtr) /* Pointer to current namespace. */
{
Interp *iPtr = (Interp*) interp;
int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
@@ -1069,10 +1067,10 @@ InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
*/
void
-TclInitCompiledLocals(interp, framePtr, nsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- CallFrame *framePtr; /* Call frame to initialize. */
- Namespace *nsPtr; /* Pointer to current namespace. */
+TclInitCompiledLocals(
+ Tcl_Interp *interp, /* Current interpreter. */
+ CallFrame *framePtr, /* Call frame to initialize. */
+ Namespace *nsPtr) /* Pointer to current namespace. */
{
Var *varPtr = framePtr->compiledLocals;
Tcl_Obj *bodyPtr;
@@ -1106,14 +1104,14 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
*/
int
-TclObjInterpProc(clientData, interp, objc, objv)
- ClientData clientData; /* Record describing procedure to be
- * interpreted. */
- register Tcl_Interp *interp; /* Interpreter in which procedure was
- * invoked. */
- int objc; /* Count of number of arguments to this
- * procedure. */
- Tcl_Obj *CONST objv[]; /* Argument value objects. */
+TclObjInterpProc(
+ ClientData clientData, /* Record describing procedure to be
+ * interpreted. */
+ register Tcl_Interp *interp,/* Interpreter in which procedure was
+ * invoked. */
+ int objc, /* Count of number of arguments to this
+ * procedure. */
+ Tcl_Obj *CONST objv[]) /* Argument value objects. */
{
register Proc *procPtr = (Proc *) clientData;
Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
@@ -1163,7 +1161,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
framePtr->objc = objc;
- framePtr->objv = objv; /* ref counts for args are incremented below */
+ framePtr->objv = objv; /* ref counts for args are incremented below */
framePtr->procPtr = procPtr;
/*
@@ -1205,7 +1203,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
Tcl_Obj *objPtr = objv[i];
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
varPtr->name = localPtr->name;
varPtr->nsPtr = NULL;
varPtr->hPtr = NULL;
@@ -1218,7 +1216,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
}
for (; i < numArgs; i++) {
/*
- * This loop is entered if argCt < (numArgs-1). Set default values;
+ * This loop is entered if argCt < (numArgs-1). Set default values;
* last formal is special.
*/
@@ -1226,7 +1224,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
Tcl_Obj *objPtr = localPtr->defValuePtr;
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
varPtr->name = localPtr->name;
varPtr->nsPtr = NULL;
varPtr->hPtr = NULL;
@@ -1249,15 +1247,15 @@ TclObjInterpProc(clientData, interp, objc, objv)
if (localPtr->flags & VAR_IS_ARGS) {
Tcl_Obj *listPtr = Tcl_NewListObj(objc-numArgs, &(objv[numArgs]));
varPtr->value.objPtr = listPtr;
- Tcl_IncrRefCount(listPtr); /* local var is a reference */
+ Tcl_IncrRefCount(listPtr); /* local var is a reference */
} else if (argCt == numArgs) {
Tcl_Obj *objPtr = objv[numArgs];
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
} else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) {
Tcl_Obj *objPtr = localPtr->defValuePtr;
varPtr->value.objPtr = objPtr;
- Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
} else {
Tcl_Obj **desiredObjs, *argObj;
ByteCode *codePtr;
@@ -1288,12 +1286,11 @@ TclObjInterpProc(clientData, interp, objc, objv)
for (i=1 ; i<=numArgs ; i++) {
TclNewObj(argObj);
if (localPtr->defValuePtr != NULL) {
- Tcl_AppendStringsToObj(argObj,
- "?", localPtr->name, "?", (char *) NULL);
+ Tcl_AppendStringsToObj(argObj, "?", localPtr->name, "?", NULL);
} else if ((i==numArgs) && !strcmp(localPtr->name, "args")) {
- Tcl_AppendStringsToObj(argObj, "...", (char *) NULL);
+ Tcl_AppendStringsToObj(argObj, "...", NULL);
} else {
- Tcl_AppendStringsToObj(argObj, localPtr->name, (char *) NULL);
+ Tcl_AppendStringsToObj(argObj, localPtr->name, NULL);
}
desiredObjs[i] = argObj;
localPtr = localPtr->nextPtr;
@@ -1395,7 +1392,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
* Called just before a procedure is executed to compile the body to byte
* codes. If the type of the body is not "byte code" or if the compile
* conditions have changed (namespace context, epoch counters, etc.) then
- * the body is recompiled. Otherwise, this function does nothing.
+ * the body is recompiled. Otherwise, this function does nothing.
*
* Results:
* None.
@@ -1408,15 +1405,15 @@ TclObjInterpProc(clientData, interp, objc, objv)
*/
int
-TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
- Tcl_Interp *interp; /* Interpreter containing procedure. */
- Proc *procPtr; /* Data associated with procedure. */
- Tcl_Obj *bodyPtr; /* Body of proc. (Usually procPtr->bodyPtr,
+TclProcCompileProc(
+ Tcl_Interp *interp, /* Interpreter containing procedure. */
+ Proc *procPtr, /* Data associated with procedure. */
+ Tcl_Obj *bodyPtr, /* Body of proc. (Usually procPtr->bodyPtr,
* but could be any code fragment compiled in
* the context of this procedure.) */
- Namespace *nsPtr; /* Namespace containing procedure. */
- CONST char *description; /* string describing this body of code. */
- CONST char *procName; /* Name of this procedure. */
+ Namespace *nsPtr, /* Namespace containing procedure. */
+ CONST char *description, /* string describing this body of code. */
+ CONST char *procName) /* Name of this procedure. */
{
Interp *iPtr = (Interp*)interp;
int result;
@@ -1452,7 +1449,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
codePtr->nsPtr = nsPtr;
} else {
bodyPtr->typePtr->freeIntRepProc(bodyPtr);
- bodyPtr->typePtr = (Tcl_ObjType *) NULL;
+ bodyPtr->typePtr = NULL;
}
}
}
@@ -1543,13 +1540,13 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
*/
static int
-ProcessProcResultCode(interp, procName, nameLen, returnCode)
- Tcl_Interp *interp; /* The interpreter in which the procedure was
+ProcessProcResultCode(
+ Tcl_Interp *interp, /* The interpreter in which the procedure was
* called and returned returnCode. */
- char *procName; /* Name of the procedure. Used for error
+ char *procName, /* Name of the procedure. Used for error
* messages and trace information. */
- int nameLen; /* Number of bytes in procedure's name. */
- int returnCode; /* The unexpected result code. */
+ int nameLen, /* Number of bytes in procedure's name. */
+ int returnCode) /* The unexpected result code. */
{
Interp *iPtr = (Interp *) interp;
int overflow, limit = 60;
@@ -1597,8 +1594,8 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
*/
void
-TclProcDeleteProc(clientData)
- ClientData clientData; /* Procedure to be deleted. */
+TclProcDeleteProc(
+ ClientData clientData) /* Procedure to be deleted. */
{
Proc *procPtr = (Proc *) clientData;
@@ -1626,8 +1623,8 @@ TclProcDeleteProc(clientData)
*/
void
-TclProcCleanupProc(procPtr)
- register Proc *procPtr; /* Procedure to be deleted. */
+TclProcCleanupProc(
+ register Proc *procPtr) /* Procedure to be deleted. */
{
register CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
@@ -1665,7 +1662,7 @@ TclProcCleanupProc(procPtr)
* TclUpdateReturnInfo --
*
* This function is called when procedures return, and at other points
- * where the TCL_RETURN code is used. It examines the returnLevel and
+ * where the TCL_RETURN code is used. It examines the returnLevel and
* returnCode to determine the real return status.
*
* Results:
@@ -1679,8 +1676,8 @@ TclProcCleanupProc(procPtr)
*/
int
-TclUpdateReturnInfo(iPtr)
- Interp *iPtr; /* Interpreter for which TCL_RETURN exception
+TclUpdateReturnInfo(
+ Interp *iPtr) /* Interpreter for which TCL_RETURN exception
* is being processed. */
{
int code = TCL_RETURN;
@@ -1719,7 +1716,7 @@ TclUpdateReturnInfo(iPtr)
*/
TclObjCmdProcType
-TclGetObjInterpProc()
+TclGetObjInterpProc(void)
{
return (TclObjCmdProcType) TclObjInterpProc;
}
@@ -1730,7 +1727,7 @@ TclGetObjInterpProc()
* TclNewProcBodyObj --
*
* Creates a new object, of type "procbody", whose internal
- * representation is the given Proc struct. The newly created object's
+ * representation is the given Proc struct. The newly created object's
* reference count is 0.
*
* Results:
@@ -1744,21 +1741,21 @@ TclGetObjInterpProc()
*/
Tcl_Obj *
-TclNewProcBodyObj(procPtr)
- Proc *procPtr; /* the Proc struct to store as the internal
+TclNewProcBodyObj(
+ Proc *procPtr) /* the Proc struct to store as the internal
* representation. */
{
Tcl_Obj *objPtr;
if (!procPtr) {
- return (Tcl_Obj *) NULL;
+ return NULL;
}
objPtr = Tcl_NewStringObj("", 0);
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+ objPtr->internalRep.otherValuePtr = (void *) procPtr;
procPtr->refCount++;
}
@@ -1771,7 +1768,7 @@ TclNewProcBodyObj(procPtr)
*
* ProcBodyDup --
*
- * Tcl_ObjType's Dup function for the proc body object. Bumps the
+ * Tcl_ObjType's Dup function for the proc body object. Bumps the
* reference count on the Proc stored in the internal representation.
*
* Results:
@@ -1784,14 +1781,14 @@ TclNewProcBodyObj(procPtr)
*/
static void
-ProcBodyDup(srcPtr, dupPtr)
- Tcl_Obj *srcPtr; /* object to copy */
- Tcl_Obj *dupPtr; /* target object for the duplication */
+ProcBodyDup(
+ Tcl_Obj *srcPtr, /* object to copy */
+ Tcl_Obj *dupPtr) /* target object for the duplication */
{
Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
dupPtr->typePtr = &tclProcBodyType;
- dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
+ dupPtr->internalRep.otherValuePtr = (void *) procPtr;
procPtr->refCount++;
}
@@ -1815,8 +1812,8 @@ ProcBodyDup(srcPtr, dupPtr)
*/
static void
-ProcBodyFree(objPtr)
- Tcl_Obj *objPtr; /* the object to clean up */
+ProcBodyFree(
+ Tcl_Obj *objPtr) /* the object to clean up */
{
Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
procPtr->refCount--;
@@ -1842,11 +1839,11 @@ ProcBodyFree(objPtr)
*/
static int
-TclCompileNoOp(interp, parsePtr, envPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Parse *parsePtr; /* Points to a parse structure for the command
+TclCompileNoOp(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
- CompileEnv *envPtr; /* Holds resulting instructions. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int i;
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 98458a6..b5e3bec 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclRegexp.c,v 1.20 2005/07/21 14:38:51 dkf Exp $
+ * RCS: @(#) $Id: tclRegexp.c,v 1.21 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -85,18 +85,17 @@ static Tcl_ThreadDataKey dataKey;
* Declarations for functions used only in this file.
*/
-static TclRegexp * CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *pattern, int length, int flags));
-static void DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FinalizeRegexp _ANSI_ARGS_((ClientData clientData));
-static void FreeRegexp _ANSI_ARGS_((TclRegexp *regexpPtr));
-static void FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int RegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_RegExp re, CONST Tcl_UniChar *uniString,
- int numChars, int nmatches, int flags));
-static int SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
+static TclRegexp * CompileRegexp(Tcl_Interp *interp, CONST char *pattern,
+ int length, int flags);
+static void DupRegexpInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
+static void FinalizeRegexp(ClientData clientData);
+static void FreeRegexp(TclRegexp *regexpPtr);
+static void FreeRegexpInternalRep(Tcl_Obj *objPtr);
+static int RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
+ CONST Tcl_UniChar *uniString, int numChars,
+ int nmatches, int flags);
+static int SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
* The regular expression Tcl object type. This serves as a cache of the
@@ -134,10 +133,10 @@ Tcl_ObjType tclRegexpType = {
*/
Tcl_RegExp
-Tcl_RegExpCompile(interp, pattern)
- Tcl_Interp *interp; /* For use in error reporting and to access
+Tcl_RegExpCompile(
+ Tcl_Interp *interp, /* For use in error reporting and to access
* the interp regexp cache. */
- CONST char *pattern; /* String for which to produce compiled
+ CONST char *pattern) /* String for which to produce compiled
* regular expression. */
{
return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern),
@@ -165,13 +164,13 @@ Tcl_RegExpCompile(interp, pattern)
*/
int
-Tcl_RegExpExec(interp, re, text, start)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; must have been
+Tcl_RegExpExec(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
- CONST char *text; /* Text against which to match re. */
- CONST char *start; /* If text is part of a larger string, this
+ CONST char *text, /* Text against which to match re. */
+ CONST char *start) /* If text is part of a larger string, this
* identifies beginning of larger string, so
* that "^" won't match. */
{
@@ -232,15 +231,15 @@ Tcl_RegExpExec(interp, re, text, start)
*/
void
-Tcl_RegExpRange(re, index, startPtr, endPtr)
- Tcl_RegExp re; /* Compiled regular expression that has been
+Tcl_RegExpRange(
+ Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
- int index; /* 0 means give the range of the entire match,
+ int index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange. */
- CONST char **startPtr; /* Store address of first character in
+ CONST char **startPtr, /* Store address of first character in
* (sub-)range here. */
- CONST char **endPtr; /* Store address of character just after last
+ CONST char **endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -282,17 +281,17 @@ Tcl_RegExpRange(re, index, startPtr, endPtr)
*/
static int
-RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; returned by a
+RegExpExecUniChar(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; returned by a
* previous call to Tcl_GetRegExpFromObj */
- CONST Tcl_UniChar *wString; /* String against which to match re. */
- int numChars; /* Length of Tcl_UniChar string (must be
+ CONST Tcl_UniChar *wString, /* String against which to match re. */
+ int numChars, /* Length of Tcl_UniChar string (must be
* >=0). */
- int nmatches; /* How many subexpression matches (counting
+ int nmatches, /* How many subexpression matches (counting
* the whole match as subexpression 0) are of
* interest. -1 means "don't know". */
- int flags; /* Regular expression flags. */
+ int flags) /* Regular expression flags. */
{
int status;
TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -344,16 +343,16 @@ RegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
*/
void
-TclRegExpRangeUniChar(re, index, startPtr, endPtr)
- Tcl_RegExp re; /* Compiled regular expression that has been
+TclRegExpRangeUniChar(
+ Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
- int index; /* 0 means give the range of the entire match,
+ int index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange, -1 means the range of the
* rm_extend field. */
- int *startPtr; /* Store address of first character in
+ int *startPtr, /* Store address of first character in
* (sub-)range here. */
- int *endPtr; /* Store address of character just after last
+ int *endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -389,10 +388,10 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr)
*/
int
-Tcl_RegExpMatch(interp, text, pattern)
- Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
- CONST char *text; /* Text to search for pattern matches. */
- CONST char *pattern; /* Regular expression to match against text. */
+Tcl_RegExpMatch(
+ Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
+ CONST char *text, /* Text to search for pattern matches. */
+ CONST char *pattern) /* Regular expression to match against text. */
{
Tcl_RegExp re;
@@ -422,18 +421,18 @@ Tcl_RegExpMatch(interp, text, pattern)
*/
int
-Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tcl_RegExp re; /* Compiled regular expression; must have been
+Tcl_RegExpExecObj(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
- Tcl_Obj *textObj; /* Text against which to match re. */
- int offset; /* Character index that marks where matching
+ Tcl_Obj *textObj, /* Text against which to match re. */
+ int offset, /* Character index that marks where matching
* should begin. */
- int nmatches; /* How many subexpression matches (counting
+ int nmatches, /* How many subexpression matches (counting
* the whole match as subexpression 0) are of
* interest. -1 means all of them. */
- int flags; /* Regular expression execution flags. */
+ int flags) /* Regular expression execution flags. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
Tcl_UniChar *udata;
@@ -476,10 +475,10 @@ Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags)
*/
int
-Tcl_RegExpMatchObj(interp, textObj, patternObj)
- Tcl_Interp *interp; /* Used for error reporting. May be NULL. */
- Tcl_Obj *textObj; /* Object containing the String to search. */
- Tcl_Obj *patternObj; /* Regular expression to match against
+Tcl_RegExpMatchObj(
+ Tcl_Interp *interp, /* Used for error reporting. May be NULL. */
+ Tcl_Obj *textObj, /* Object containing the String to search. */
+ Tcl_Obj *patternObj) /* Regular expression to match against
* string. */
{
Tcl_RegExp re;
@@ -510,9 +509,9 @@ Tcl_RegExpMatchObj(interp, textObj, patternObj)
*/
void
-Tcl_RegExpGetInfo(regexp, infoPtr)
- Tcl_RegExp regexp; /* Pattern from which to get subexpressions. */
- Tcl_RegExpInfo *infoPtr; /* Match information is stored here. */
+Tcl_RegExpGetInfo(
+ Tcl_RegExp regexp, /* Pattern from which to get subexpressions. */
+ Tcl_RegExpInfo *infoPtr) /* Match information is stored here. */
{
TclRegexp *regexpPtr = (TclRegexp *) regexp;
@@ -542,14 +541,14 @@ Tcl_RegExpGetInfo(regexp, infoPtr)
*/
Tcl_RegExp
-Tcl_GetRegExpFromObj(interp, objPtr, flags)
- Tcl_Interp *interp; /* For use in error reporting, and to access
+Tcl_GetRegExpFromObj(
+ Tcl_Interp *interp, /* For use in error reporting, and to access
* the interp regexp cache. */
- Tcl_Obj *objPtr; /* Object whose string rep contains regular
+ Tcl_Obj *objPtr, /* Object whose string rep contains regular
* expression pattern. Internal rep will be
* changed to compiled form of this regular
* expression. */
- int flags; /* Regular expression compilation flags. */
+ int flags) /* Regular expression compilation flags. */
{
int length;
TclRegexp *regexpPtr;
@@ -583,7 +582,7 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
*/
TclFreeIntRep(objPtr);
- objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
+ objPtr->internalRep.otherValuePtr = (void *) regexpPtr;
objPtr->typePtr = &tclRegexpType;
}
return (Tcl_RegExp) regexpPtr;
@@ -609,9 +608,9 @@ Tcl_GetRegExpFromObj(interp, objPtr, flags)
*/
int
-TclRegAbout(interp, re)
- Tcl_Interp *interp; /* For use in variable assignment. */
- Tcl_RegExp re; /* The compiled regular expression. */
+TclRegAbout(
+ Tcl_Interp *interp, /* For use in variable assignment. */
+ Tcl_RegExp re) /* The compiled regular expression. */
{
TclRegexp *regexpPtr = (TclRegexp *)re;
char buf[TCL_INTEGER_SPACE];
@@ -686,10 +685,10 @@ TclRegAbout(interp, re)
*/
void
-TclRegError(interp, msg, status)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- CONST char *msg; /* Message to prepend to error. */
- int status; /* Status code to report. */
+TclRegError(
+ Tcl_Interp *interp, /* Interpreter for error reporting. */
+ CONST char *msg, /* Message to prepend to error. */
+ int status) /* Status code to report. */
{
char buf[100]; /* ample in practice */
char cbuf[100]; /* lots in practice */
@@ -697,12 +696,12 @@ TclRegError(interp, msg, status)
char *p;
Tcl_ResetResult(interp);
- n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
+ n = TclReError(status, NULL, buf, sizeof(buf));
p = (n > sizeof(buf)) ? "..." : "";
Tcl_AppendResult(interp, msg, buf, p, NULL);
sprintf(cbuf, "%d", status);
- (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));
+ (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
}
@@ -724,8 +723,8 @@ TclRegError(interp, msg, status)
*/
static void
-FreeRegexpInternalRep(objPtr)
- Tcl_Obj *objPtr; /* Regexp object with internal rep to free. */
+FreeRegexpInternalRep(
+ Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
@@ -756,9 +755,9 @@ FreeRegexpInternalRep(objPtr)
*/
static void
-DupRegexpInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+DupRegexpInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
@@ -788,9 +787,9 @@ DupRegexpInternalRep(srcPtr, copyPtr)
*/
static int
-SetRegexpFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* The object to convert. */
+SetRegexpFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
return TCL_ERROR;
@@ -821,11 +820,11 @@ SetRegexpFromAny(interp, objPtr)
*/
static TclRegexp *
-CompileRegexp(interp, string, length, flags)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- CONST char *string; /* The regexp to compile (UTF-8). */
- int length; /* The length of the string in bytes. */
- int flags; /* Compilation flags. */
+CompileRegexp(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ CONST char *string, /* The regexp to compile (UTF-8). */
+ int length, /* The length of the string in bytes. */
+ int flags) /* Compilation flags. */
{
TclRegexp *regexpPtr;
CONST Tcl_UniChar *uniString;
@@ -975,8 +974,8 @@ CompileRegexp(interp, string, length, flags)
*/
static void
-FreeRegexp(regexpPtr)
- TclRegexp *regexpPtr; /* Compiled regular expression to free. */
+FreeRegexp(
+ TclRegexp *regexpPtr) /* Compiled regular expression to free. */
{
TclReFree(&regexpPtr->re);
if (regexpPtr->matches) {
@@ -990,8 +989,7 @@ FreeRegexp(regexpPtr)
*
* FinalizeRegexp --
*
- * Release the storage associated with the per-thread regexp
- * cache.
+ * Release the storage associated with the per-thread regexp cache.
*
* Results:
* None.
@@ -1003,8 +1001,8 @@ FreeRegexp(regexpPtr)
*/
static void
-FinalizeRegexp(clientData)
- ClientData clientData; /* Not used. */
+FinalizeRegexp(
+ ClientData clientData) /* Not used. */
{
int i;
TclRegexp *regexpPtr;
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index e9c7cc5..c0d83bf 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.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: tclResolve.c,v 1.7 2005/07/23 00:04:31 dkf Exp $
+ * RCS: @(#) $Id: tclResolve.c,v 1.8 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -20,7 +20,7 @@
* Declarations for functions local to this file:
*/
-static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
+static void BumpCmdRefEpochs(Namespace *nsPtr);
/*
*----------------------------------------------------------------------
@@ -54,17 +54,16 @@ static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
*/
void
-Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being modified. */
- CONST char *name; /* Name of this resolution scheme. */
- Tcl_ResolveCmdProc *cmdProc; /* New function for command
- * resolution. */
- Tcl_ResolveVarProc *varProc; /* Function for variable resolution at
- * runtime. */
- Tcl_ResolveCompiledVarProc *compiledVarProc;
- /* Function for variable resolution at
- * compile time. */
+Tcl_AddInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being modified. */
+ CONST char *name, /* Name of this resolution scheme. */
+ Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */
+ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+ * runtime. */
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+ /* Function for variable resolution at compile
+ * time. */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme *resPtr;
@@ -134,12 +133,13 @@ Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
*/
int
-Tcl_GetInterpResolvers(interp, name, resInfoPtr)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being queried. */
- CONST char *name; /* Look for a scheme with this name. */
- Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the functions,
- * if found */
+Tcl_GetInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being queried. */
+ CONST char *name, /* Look for a scheme with this name. */
+ Tcl_ResolverInfo *resInfoPtr)
+ /* Returns pointers to the functions, if
+ * found */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme *resPtr;
@@ -185,10 +185,10 @@ Tcl_GetInterpResolvers(interp, name, resInfoPtr)
*/
int
-Tcl_RemoveInterpResolvers(interp, name)
- Tcl_Interp *interp; /* Interpreter whose name resolution
- * rules are being modified. */
- CONST char *name; /* Name of the scheme to be removed. */
+Tcl_RemoveInterpResolvers(
+ Tcl_Interp *interp, /* Interpreter whose name resolution rules are
+ * being modified. */
+ CONST char *name) /* Name of the scheme to be removed. */
{
Interp *iPtr = (Interp *) interp;
ResolverScheme **prevPtrPtr, *resPtr;
@@ -254,8 +254,8 @@ Tcl_RemoveInterpResolvers(interp, name)
*/
static void
-BumpCmdRefEpochs(nsPtr)
- Namespace *nsPtr; /* Namespace being modified. */
+BumpCmdRefEpochs(
+ Namespace *nsPtr) /* Namespace being modified. */
{
Tcl_HashEntry *entry;
Tcl_HashSearch search;
@@ -335,15 +335,15 @@ BumpCmdRefEpochs(nsPtr)
*/
void
-Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
- Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
- * are being modified. */
- Tcl_ResolveCmdProc *cmdProc; /* Function for command resolution */
- Tcl_ResolveVarProc *varProc; /* Function for variable resolution at
- * run-time */
- Tcl_ResolveCompiledVarProc *compiledVarProc;
- /* Function for variable resolution at
- * compile time. */
+Tcl_SetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+ * modified. */
+ Tcl_ResolveCmdProc *cmdProc,/* Function for command resolution */
+ Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
+ * run-time */
+ Tcl_ResolveCompiledVarProc *compiledVarProc)
+ /* Function for variable resolution at compile
+ * time. */
{
Namespace *nsPtr = (Namespace *) namespacePtr;
@@ -384,12 +384,12 @@ Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
*/
int
-Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
- Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
- * are being modified. */
- Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all name
- * resolution functions assigned to
- * this namespace. */
+Tcl_GetNamespaceResolvers(
+ Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being
+ * modified. */
+ Tcl_ResolverInfo *resInfoPtr)
+ /* Returns: pointers for all name resolution
+ * functions assigned to this namespace. */
{
Namespace *nsPtr = (Namespace *) namespacePtr;
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 53b45a0..37f037b 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.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: tclResult.c,v 1.31 2005/09/13 21:23:51 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.32 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -26,11 +26,10 @@ enum returnKeys {
* Function prototypes for local functions in this file:
*/
-static Tcl_Obj ** GetKeys _ANSI_ARGS_((void));
-static void ReleaseKeys _ANSI_ARGS_((ClientData clientData));
-static void ResetObjResult _ANSI_ARGS_((Interp *iPtr));
-static void SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
- int newSpace));
+static Tcl_Obj ** GetKeys(void);
+static void ReleaseKeys(ClientData clientData);
+static void ResetObjResult(Interp *iPtr);
+static void SetupAppendBuffer(Interp *iPtr, int newSpace);
/*
* This structure is used to take a snapshot of the interpreter state in
@@ -71,9 +70,9 @@ typedef struct InterpState {
*/
Tcl_InterpState
-Tcl_SaveInterpState(interp, status)
- Tcl_Interp* interp; /* Interpreter's state to be saved */
- int status; /* status code for current operation */
+Tcl_SaveInterpState(
+ Tcl_Interp *interp, /* Interpreter's state to be saved */
+ int status) /* status code for current operation */
{
Interp *iPtr = (Interp *)interp;
InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));
@@ -118,9 +117,9 @@ Tcl_SaveInterpState(interp, status)
*/
int
-Tcl_RestoreInterpState(interp, state)
- Tcl_Interp* interp; /* Interpreter's state to be restored*/
- Tcl_InterpState state; /* saved interpreter state */
+Tcl_RestoreInterpState(
+ Tcl_Interp *interp, /* Interpreter's state to be restored*/
+ Tcl_InterpState state) /* saved interpreter state */
{
Interp *iPtr = (Interp *)interp;
InterpState *statePtr = (InterpState *)state;
@@ -175,8 +174,8 @@ Tcl_RestoreInterpState(interp, state)
*/
void
-Tcl_DiscardInterpState(state)
- Tcl_InterpState state; /* saved interpreter state */
+Tcl_DiscardInterpState(
+ Tcl_InterpState state) /* saved interpreter state */
{
InterpState *statePtr = (InterpState *)state;
@@ -216,9 +215,9 @@ Tcl_DiscardInterpState(state)
*/
void
-Tcl_SaveResult(interp, statePtr)
- Tcl_Interp *interp; /* Interpreter to save. */
- Tcl_SavedResult *statePtr; /* Pointer to state structure. */
+Tcl_SaveResult(
+ Tcl_Interp *interp, /* Interpreter to save. */
+ Tcl_SavedResult *statePtr) /* Pointer to state structure. */
{
Interp *iPtr = (Interp *) interp;
@@ -290,9 +289,9 @@ Tcl_SaveResult(interp, statePtr)
*/
void
-Tcl_RestoreResult(interp, statePtr)
- Tcl_Interp* interp; /* Interpreter being restored. */
- Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+Tcl_RestoreResult(
+ Tcl_Interp *interp, /* Interpreter being restored. */
+ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
Interp *iPtr = (Interp *) interp;
@@ -358,8 +357,8 @@ Tcl_RestoreResult(interp, statePtr)
*/
void
-Tcl_DiscardResult(statePtr)
- Tcl_SavedResult *statePtr; /* State returned by Tcl_SaveResult. */
+Tcl_DiscardResult(
+ Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
TclDecrRefCount(statePtr->objResultPtr);
@@ -392,12 +391,12 @@ Tcl_DiscardResult(statePtr)
*/
void
-Tcl_SetResult(interp, result, freeProc)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_SetResult(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
- register char *result; /* Value to be returned. If NULL, the result
+ register char *result, /* Value to be returned. If NULL, the result
* is set to an empty string. */
- Tcl_FreeProc *freeProc; /* Gives information about the string:
+ Tcl_FreeProc *freeProc) /* Gives information about the string:
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
@@ -464,8 +463,8 @@ Tcl_SetResult(interp, result, freeProc)
*/
CONST char *
-Tcl_GetStringResult(interp)
- register Tcl_Interp *interp;/* Interpreter whose result to return. */
+Tcl_GetStringResult(
+ register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
/*
* If the string result is empty, move the object result to the string
@@ -499,10 +498,10 @@ Tcl_GetStringResult(interp)
*/
void
-Tcl_SetObjResult(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_SetObjResult(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return object value. */
- register Tcl_Obj *objPtr; /* Tcl object to be returned. If NULL, the obj
+ register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
* result is made an empty string object. */
{
register Interp *iPtr = (Interp *) interp;
@@ -556,8 +555,8 @@ Tcl_SetObjResult(interp, objPtr)
*/
Tcl_Obj *
-Tcl_GetObjResult(interp)
- Tcl_Interp *interp; /* Interpreter whose result to return. */
+Tcl_GetObjResult(
+ Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
Tcl_Obj *objResultPtr;
@@ -610,10 +609,10 @@ Tcl_GetObjResult(interp)
*/
void
-Tcl_AppendResultVA(interp, argList)
- Tcl_Interp *interp; /* Interpreter with which to associate the
+Tcl_AppendResultVA(
+ Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
- va_list argList; /* Variable argument list. */
+ va_list argList) /* Variable argument list. */
{
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
@@ -663,7 +662,8 @@ Tcl_AppendResultVA(interp, argList)
*/
void
-Tcl_AppendResult(Tcl_Interp *interp, ...)
+Tcl_AppendResult(
+ Tcl_Interp *interp, ...)
{
va_list argList;
@@ -696,10 +696,10 @@ Tcl_AppendResult(Tcl_Interp *interp, ...)
*/
void
-Tcl_AppendElement(interp, element)
- Tcl_Interp *interp; /* Interpreter whose result is to be
+Tcl_AppendElement(
+ Tcl_Interp *interp, /* Interpreter whose result is to be
* extended. */
- CONST char *element; /* String to convert to list element and add
+ CONST char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
@@ -768,9 +768,9 @@ Tcl_AppendElement(interp, element)
*/
static void
-SetupAppendBuffer(iPtr, newSpace)
- Interp *iPtr; /* Interpreter whose result is being set up. */
- int newSpace; /* Make sure that at least this many bytes of
+SetupAppendBuffer(
+ Interp *iPtr, /* Interpreter whose result is being set up. */
+ int newSpace) /* Make sure that at least this many bytes of
* new information may be added. */
{
int totalSpace;
@@ -851,8 +851,8 @@ SetupAppendBuffer(iPtr, newSpace)
*/
void
-Tcl_FreeResult(interp)
- register Tcl_Interp *interp; /* Interpreter for which to free result. */
+Tcl_FreeResult(
+ register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
register Interp *iPtr = (Interp *) interp;
@@ -888,8 +888,8 @@ Tcl_FreeResult(interp)
*/
void
-Tcl_ResetResult(interp)
- register Tcl_Interp *interp; /* Interpreter for which to clear result. */
+Tcl_ResetResult(
+ register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
register Interp *iPtr = (Interp *) interp;
@@ -946,8 +946,8 @@ Tcl_ResetResult(interp)
*/
static void
-ResetObjResult(iPtr)
- register Interp *iPtr; /* Points to the interpreter whose result
+ResetObjResult(
+ register Interp *iPtr) /* Points to the interpreter whose result
* object should be reset. */
{
register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
@@ -965,7 +965,7 @@ ResetObjResult(iPtr)
objResultPtr->bytes = tclEmptyStringRep;
objResultPtr->length = 0;
TclFreeIntRep(objResultPtr);
- objResultPtr->typePtr = (Tcl_ObjType *) NULL;
+ objResultPtr->typePtr = NULL;
}
}
@@ -989,9 +989,9 @@ ResetObjResult(iPtr)
*/
void
-Tcl_SetErrorCodeVA(interp, argList)
- Tcl_Interp *interp; /* Interpreter in which to set errorCode */
- va_list argList; /* Variable argument list. */
+Tcl_SetErrorCodeVA(
+ Tcl_Interp *interp, /* Interpreter in which to set errorCode */
+ va_list argList) /* Variable argument list. */
{
Tcl_Obj *errorObj = Tcl_NewObj();
@@ -1030,7 +1030,8 @@ Tcl_SetErrorCodeVA(interp, argList)
*/
void
-Tcl_SetErrorCode(Tcl_Interp *interp, ...)
+Tcl_SetErrorCode(
+ Tcl_Interp *interp, ...)
{
va_list argList;
@@ -1063,9 +1064,9 @@ Tcl_SetErrorCode(Tcl_Interp *interp, ...)
*/
void
-Tcl_SetObjErrorCode(interp, errorObjPtr)
- Tcl_Interp *interp;
- Tcl_Obj *errorObjPtr;
+Tcl_SetObjErrorCode(
+ Tcl_Interp *interp,
+ Tcl_Obj *errorObjPtr)
{
Interp *iPtr = (Interp *) interp;
@@ -1098,7 +1099,7 @@ Tcl_SetObjErrorCode(interp, errorObjPtr)
*/
static Tcl_Obj **
-GetKeys()
+GetKeys(void)
{
static Tcl_ThreadDataKey returnKeysKey;
Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey,
@@ -1149,8 +1150,8 @@ GetKeys()
*/
static void
-ReleaseKeys(clientData)
- ClientData clientData;
+ReleaseKeys(
+ ClientData clientData)
{
Tcl_Obj **keys = (Tcl_Obj **)clientData;
int i;
@@ -1181,11 +1182,11 @@ ReleaseKeys(clientData)
*/
int
-TclProcessReturn(interp, code, level, returnOpts)
- Tcl_Interp *interp;
- int code;
- int level;
- Tcl_Obj *returnOpts;
+TclProcessReturn(
+ Tcl_Interp *interp,
+ int code,
+ int level,
+ Tcl_Obj *returnOpts)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *valuePtr;
@@ -1258,16 +1259,16 @@ TclProcessReturn(interp, code, level, returnOpts)
*/
int
-TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
- Tcl_Obj **optionsPtrPtr; /* If not NULL, points to space for a (Tcl_Obj
+TclMergeReturnOptions(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[], /* Argument objects. */
+ Tcl_Obj **optionsPtrPtr, /* If not NULL, points to space for a (Tcl_Obj
* *) where the pointer to the merged return
* options dictionary should be written */
- int *codePtr; /* If not NULL, points to space where the
+ int *codePtr, /* If not NULL, points to space where the
* -code value should be written */
- int *levelPtr; /* If not NULL, points to space where the
+ int *levelPtr) /* If not NULL, points to space where the
* -level value should be written */
{
int code=TCL_OK;
@@ -1299,7 +1300,7 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad ", compare,
" value: expected dictionary but got \"",
- TclGetString(objv[1]), "\"", (char *) NULL);
+ TclGetString(objv[1]), "\"", NULL);
goto error;
}
@@ -1338,7 +1339,7 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
Tcl_AppendResult(interp, "bad completion code \"",
TclGetString(valuePtr),
"\": must be ok, error, return, break, ",
- "continue, or an integer", (char *) NULL);
+ "continue, or an integer", NULL);
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
@@ -1359,7 +1360,7 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad -level value: ",
"expected non-negative integer but got \"",
- TclGetString(valuePtr), "\"", (char *) NULL);
+ TclGetString(valuePtr), "\"", NULL);
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
@@ -1414,9 +1415,9 @@ TclMergeReturnOptions(interp, objc, objv, optionsPtrPtr, codePtr, levelPtr)
*/
Tcl_Obj *
-Tcl_GetReturnOptions(interp, result)
- Tcl_Interp *interp;
- int result;
+Tcl_GetReturnOptions(
+ Tcl_Interp *interp,
+ int result)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *options;
@@ -1476,9 +1477,9 @@ Tcl_GetReturnOptions(interp, result)
*/
int
-Tcl_SetReturnOptions(interp, options)
- Tcl_Interp *interp;
- Tcl_Obj *options;
+Tcl_SetReturnOptions(
+ Tcl_Interp *interp,
+ Tcl_Obj *options)
{
int objc, level, code;
Tcl_Obj **objv, *mergedOpts;
@@ -1487,7 +1488,7 @@ Tcl_SetReturnOptions(interp, options)
|| (objc % 2)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected dict but got \"",
- Tcl_GetString(options), "\"", NULL);
+ TclGetString(options), "\"", NULL);
code = TCL_ERROR;
} else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
&mergedOpts, &code, &level)) {
@@ -1529,15 +1530,15 @@ Tcl_SetReturnOptions(interp, options)
*/
void
-TclTransferResult(sourceInterp, result, targetInterp)
- Tcl_Interp *sourceInterp; /* Interp whose result and error information
+TclTransferResult(
+ Tcl_Interp *sourceInterp, /* Interp whose result and error information
* should be moved to the target interp.
* After moving result, this interp's result
* is reset. */
- int result; /* TCL_OK if just the result should be copied,
+ int result, /* TCL_OK if just the result should be copied,
* TCL_ERROR if both the result and error
* information should be copied. */
- Tcl_Interp *targetInterp; /* Interp where result and error information
+ Tcl_Interp *targetInterp) /* Interp where result and error information
* should be stored. If source and target are
* the same, nothing is done. */
{
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index db9f892..6b7275a 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.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: tclTrace.c,v 1.28 2005/11/01 20:17:10 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.29 2005/11/02 00:55:06 dkf Exp $
*/
#include "tclInt.h"
@@ -23,7 +23,7 @@
typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
- size_t length; /* Number of non-NULL chars. in command. */
+ size_t length; /* Number of non-NUL chars. in command. */
char command[4]; /* Space for Tcl command to invoke. Actual
* size will be as large as necessary to hold
* command. This field must be the last in the
@@ -38,7 +38,7 @@ typedef struct {
typedef struct {
int flags; /* Operations for which Tcl command is to be
* invoked. */
- size_t length; /* Number of non-NULL chars. in command. */
+ size_t length; /* Number of non-NUL chars. in command. */
Tcl_Trace stepTrace; /* Used for execution traces, when tracing
* inside the given command */
int startLevel; /* Used for bookkeeping with step execution
@@ -90,8 +90,8 @@ typedef struct {
* Forward declarations for functions defined in this file:
*/
-typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
- int optionIndex, int objc, Tcl_Obj *CONST objv[]));
+typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
+ int objc, Tcl_Obj *CONST objv[]);
Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
@@ -105,9 +105,9 @@ Tcl_TraceTypeObjCmd TclTraceExecutionObjCmd;
*/
static CONST char *traceTypeOptions[] = {
- "execution", "command", "variable", (char*) NULL
+ "execution", "command", "variable", NULL
};
-static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
+static Tcl_TraceTypeObjCmd *traceSubCmds[] = {
TclTraceExecutionObjCmd,
TclTraceCommandObjCmd,
TclTraceVariableObjCmd,
@@ -117,25 +117,21 @@ static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
* Declarations for local functions to this file:
*/
-static int CallTraceFunction _ANSI_ARGS_((Tcl_Interp *interp,
- Trace *tracePtr, Command *cmdPtr,
- CONST char *command, int numChars,
- int objc, Tcl_Obj *CONST objv[]));
-static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
-static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
+static int CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
+ Command *cmdPtr, CONST char *command, int numChars,
+ int objc, Tcl_Obj *CONST objv[]);
+static char * TraceVarProc(ClientData clientData, Tcl_Interp *interp,
+ CONST char *name1, CONST char *name2, int flags);
+static void TraceCommandProc(ClientData clientData,
Tcl_Interp *interp, CONST char *oldName,
- CONST char *newName, int flags));
+ CONST char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
-static int StringTraceProc _ANSI_ARGS_((ClientData clientData,
+static int StringTraceProc(ClientData clientData,
Tcl_Interp* interp, int level,
CONST char* command, Tcl_Command commandInfo,
- int objc, Tcl_Obj *CONST objv[]));
-static void StringTraceDeleteProc _ANSI_ARGS_((
- ClientData clientData));
-static void DisposeTraceResult _ANSI_ARGS_((int flags,
- char *result));
+ int objc, Tcl_Obj *CONST objv[]);
+static void StringTraceDeleteProc(ClientData clientData);
+static void DisposeTraceResult(int flags, char *result);
/*
* The following structure holds the client data for string-based
@@ -168,11 +164,11 @@ typedef struct StringTraceData {
/* ARGSUSED */
int
-Tcl_TraceObjCmd(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_TraceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int optionIndex;
char *name, *flagOps, *p;
@@ -182,7 +178,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
#ifndef TCL_REMOVE_OBSOLETE_TRACES
"variable", "vdelete", "vinfo",
#endif
- (char *) NULL
+ NULL
};
/* 'OLD' options are pre-Tcl-8.4 style */
enum traceOptions {
@@ -312,7 +308,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
- pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ pairObjPtr = Tcl_NewListObj(0, NULL);
p = ops;
if (tvarPtr->flags & TCL_TRACE_READS) {
*p = 'r';
@@ -354,7 +350,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
badVarOps:
Tcl_AppendResult(interp, "bad operations \"", flagOps,
- "\": should be one or more of rwua", (char *) NULL);
+ "\": should be one or more of rwua", NULL);
return TCL_ERROR;
}
@@ -378,11 +374,11 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
*/
int
-TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclTraceExecutionObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
@@ -391,7 +387,7 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
TRACE_ADD, TRACE_INFO, TRACE_REMOVE
};
static CONST char *opStrings[] = {
- "enter", "leave", "enterstep", "leavestep", (char *) NULL
+ "enter", "leave", "enterstep", "leavestep", NULL
};
enum operations {
TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
@@ -482,9 +478,11 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
ClientData clientData = NULL;
name = Tcl_GetString(objv[3]);
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ /*
+ * First ensure the name given is valid.
+ */
+
+ if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
@@ -523,7 +521,10 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
}
}
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
- /* Postpone deletion */
+ /*
+ * Postpone deletion.
+ */
+
tcmdPtr->flags = 0;
}
if ((--tcmdPtr->refCount) <= 0) {
@@ -547,12 +548,15 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
clientData = NULL;
name = Tcl_GetString(objv[3]);
- /* First ensure the name given is valid */
+ /*
+ * First ensure the name given is valid.
+ */
+
if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ resultListPtr = Tcl_NewListObj(0, NULL);
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
int numOps = 0;
@@ -565,7 +569,7 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_ENTER_EXEC) {
Tcl_ListObjAppendElement(NULL, elemObjPtr,
@@ -588,7 +592,7 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
Tcl_DecrRefCount(elemObjPtr);
continue;
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
elemObjPtr = NULL;
@@ -625,17 +629,17 @@ TclTraceExecutionObjCmd(interp, optionIndex, objc, objv)
*/
int
-TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclTraceCommandObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
- static CONST char *opStrings[] = { "delete", "rename", (char *) NULL };
+ static CONST char *opStrings[] = { "delete", "rename", NULL };
enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
switch ((enum traceOptions) optionIndex) {
@@ -713,9 +717,11 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
ClientData clientData = NULL;
name = Tcl_GetString(objv[3]);
- /* First ensure the name given is valid */
- if (Tcl_FindCommand(interp, name, NULL,
- TCL_LEAVE_ERR_MSG) == NULL) {
+ /*
+ * First ensure the name given is valid.
+ */
+
+ if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
@@ -750,12 +756,15 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
clientData = NULL;
name = Tcl_GetString(objv[3]);
- /* First ensure the name given is valid */
+ /*
+ * First ensure the name given is valid.
+ */
+
if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
- resultListPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ resultListPtr = Tcl_NewListObj(0, NULL);
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
TraceCommandProc, clientData)) != NULL) {
int numOps = 0;
@@ -768,7 +777,7 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(elemObjPtr);
if (tcmdPtr->flags & TCL_TRACE_RENAME) {
Tcl_ListObjAppendElement(NULL, elemObjPtr,
@@ -783,7 +792,7 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
Tcl_DecrRefCount(elemObjPtr);
continue;
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
Tcl_DecrRefCount(elemObjPtr);
@@ -818,18 +827,18 @@ TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
*/
int
-TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
- Tcl_Interp *interp; /* Current interpreter. */
- int optionIndex; /* Add, info or remove */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclTraceVariableObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int optionIndex, /* Add, info or remove */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int commandLength, index;
char *name, *command;
size_t length;
enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
static CONST char *opStrings[] = {
- "array", "read", "unset", "write", (char *) NULL
+ "array", "read", "unset", "write", NULL
};
enum operations {
TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
@@ -951,7 +960,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
* list (as an element) to the end of the result object list.
*/
- elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ elemObjPtr = Tcl_NewListObj(0, NULL);
if (tvarPtr->flags & TCL_TRACE_ARRAY) {
Tcl_ListObjAppendElement(NULL, elemObjPtr,
Tcl_NewStringObj("array", 5));
@@ -968,7 +977,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
Tcl_ListObjAppendElement(NULL, elemObjPtr,
Tcl_NewStringObj("unset", 5));
}
- eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ eachTraceObjPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
@@ -1009,13 +1018,13 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
*/
ClientData
-Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
+Tcl_CommandTraceInfo(
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ CONST char *cmdName, /* Name of command. */
+ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_CommandTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
@@ -1074,16 +1083,16 @@ Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
*/
int
-Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which command is to be
+Tcl_TraceCommand(
+ Tcl_Interp *interp, /* Interpreter in which command is to be
* traced. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed collection of bits, including any of
+ CONST char *cmdName, /* Name of command. */
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
- Tcl_CommandTraceProc *proc; /* Function to call when specified ops are
+ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are
* invoked upon cmdName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
@@ -1130,14 +1139,14 @@ Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
*/
void
-Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *cmdName; /* Name of command. */
- int flags; /* OR-ed collection of bits, including any of
+Tcl_UntraceCommand(
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ CONST char *cmdName, /* Name of command. */
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
* of the TRACE_*_EXEC flags */
- Tcl_CommandTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register CommandTrace *tracePtr;
CommandTrace *prevPtr;
@@ -1154,7 +1163,7 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
- for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
+ for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; ;
prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
if (tracePtr == NULL) {
return;
@@ -1234,14 +1243,14 @@ Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
/* ARGSUSED */
static void
-TraceCommandProc(clientData, interp, oldName, newName, flags)
- ClientData clientData; /* Information about the command trace. */
- Tcl_Interp *interp; /* Interpreter containing command. */
- CONST char *oldName; /* Name of command being changed. */
- CONST char *newName; /* New name of command. Empty string or NULL
+TraceCommandProc(
+ ClientData clientData, /* Information about the command trace. */
+ Tcl_Interp *interp, /* Interpreter containing command. */
+ CONST char *oldName, /* Name of command being changed. */
+ CONST char *newName, /* New name of command. Empty string or NULL
* means command is being deleted (renamed to
* ""). */
- int flags; /* OR-ed bits giving operation and other
+ int flags) /* OR-ed bits giving operation and other
* information. */
{
TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
@@ -1346,7 +1355,6 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
if ((--tcmdPtr->refCount) <= 0) {
ckfree((char*)tcmdPtr);
}
- return;
}
/*
@@ -1375,18 +1383,17 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
*/
int
-TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
- objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- CONST char *command; /* Pointer to beginning of the current command
+TclCheckExecutionTraces(
+ Tcl_Interp *interp, /* The current interpreter. */
+ CONST char *command, /* Pointer to beginning of the current command
* string. */
- int numChars; /* The number of characters in 'command' which
+ int numChars, /* The number of characters in 'command' which
* are part of the command string. */
- Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
- int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ int code, /* The current result code. */
+ int traceFlags, /* Current tracing situation. */
+ int objc, /* Number of arguments for the command. */
+ Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
CommandTrace *tracePtr, *lastTracePtr;
@@ -1477,18 +1484,17 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags,
*/
int
-TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
- objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- CONST char *command; /* Pointer to beginning of the current command
+TclCheckInterpTraces(
+ Tcl_Interp *interp, /* The current interpreter. */
+ CONST char *command, /* Pointer to beginning of the current command
* string. */
- int numChars; /* The number of characters in 'command' which
+ int numChars, /* The number of characters in 'command' which
* are part of the command string. */
- Command *cmdPtr; /* Points to command's Command struct. */
- int code; /* The current result code. */
- int traceFlags; /* Current tracing situation. */
- int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ int code, /* The current result code. */
+ int traceFlags, /* Current tracing situation. */
+ int objc, /* Number of arguments for the command. */
+ Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
Trace *tracePtr, *lastTracePtr;
@@ -1622,16 +1628,16 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags,
*/
static int
-CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
- Tcl_Interp *interp; /* The current interpreter. */
- register Trace *tracePtr; /* Describes the trace function to call. */
- Command *cmdPtr; /* Points to command's Command struct. */
- CONST char *command; /* Points to the first character of the
+CallTraceFunction(
+ Tcl_Interp *interp, /* The current interpreter. */
+ register Trace *tracePtr, /* Describes the trace function to call. */
+ Command *cmdPtr, /* Points to command's Command struct. */
+ CONST char *command, /* Points to the first character of the
* command's source before substitutions. */
- int numChars; /* The number of characters in the command's
+ int numChars, /* The number of characters in the command's
* source. */
- register int objc; /* Number of arguments for the command. */
- Tcl_Obj *CONST objv[]; /* Pointers to Tcl_Obj of each argument. */
+ register int objc, /* Number of arguments for the command. */
+ Tcl_Obj *CONST objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
char *commandCopy;
@@ -1642,7 +1648,7 @@ CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
*/
commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
- memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
+ memcpy((void *) commandCopy, (void *) command, (size_t) numChars);
commandCopy[numChars] = '\0';
/*
@@ -1674,7 +1680,9 @@ CallTraceFunction(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
*/
static void
-CommandObjTraceDeleted(ClientData clientData) {
+CommandObjTraceDeleted(
+ ClientData clientData)
+{
TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
if ((--tcmdPtr->refCount) <= 0) {
ckfree((char*)tcmdPtr);
@@ -1707,9 +1715,15 @@ CommandObjTraceDeleted(ClientData clientData) {
*/
static int
-TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
- CONST char* command, Tcl_Command cmdInfo, int objc,
- struct Tcl_Obj *CONST objv[]) {
+TraceExecutionProc(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int level,
+ CONST char *command,
+ Tcl_Command cmdInfo,
+ int objc,
+ struct Tcl_Obj *CONST objv[])
+{
int call = 0;
Interp *iPtr = (Interp *) interp;
TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
@@ -1906,13 +1920,13 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, int level,
/* ARGSUSED */
static char *
-TraceVarProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Information about the variable trace. */
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *name1; /* Name of variable or array. */
- CONST char *name2; /* Name of element within array; NULL means
+TraceVarProc(
+ ClientData clientData, /* Information about the variable trace. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *name1, /* Name of variable or array. */
+ CONST char *name2, /* Name of element within array; NULL means
* scalar variable is being referenced. */
- int flags; /* OR-ed bits giving operation and other
+ int flags) /* OR-ed bits giving operation and other
* information. */
{
TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
@@ -2065,13 +2079,13 @@ TraceVarProc(clientData, interp, name1, name2, flags)
*/
Tcl_Trace
-Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
- Tcl_Interp* interp; /* Tcl interpreter */
- int level; /* Maximum nesting level */
- int flags; /* Flags, see above */
- Tcl_CmdObjTraceProc* proc; /* Trace callback */
- ClientData clientData; /* Client data for the callback */
- Tcl_CmdObjTraceDeleteProc* delProc;
+Tcl_CreateObjTrace(
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int level, /* Maximum nesting level */
+ int flags, /* Flags, see above */
+ Tcl_CmdObjTraceProc* proc, /* Trace callback */
+ ClientData clientData, /* Client data for the callback */
+ Tcl_CmdObjTraceDeleteProc* delProc)
/* Function to call when trace is deleted */
{
register Trace *tracePtr;
@@ -2154,13 +2168,13 @@ Tcl_CreateObjTrace(interp, level, flags, proc, clientData, delProc)
*/
Tcl_Trace
-Tcl_CreateTrace(interp, level, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which to create trace. */
- int level; /* Only call proc for commands at nesting
+Tcl_CreateTrace(
+ Tcl_Interp *interp, /* Interpreter in which to create trace. */
+ int level, /* Only call proc for commands at nesting
* level<=argument level (1=>top level). */
- Tcl_CmdTraceProc *proc; /* Function to call before executing each
+ Tcl_CmdTraceProc *proc, /* Function to call before executing each
* command. */
- ClientData clientData; /* Arbitrary value word to pass to proc. */
+ ClientData clientData) /* Arbitrary value word to pass to proc. */
{
StringTraceData* data;
data = (StringTraceData *) ckalloc(sizeof(*data));
@@ -2187,14 +2201,14 @@ Tcl_CreateTrace(interp, level, proc, clientData)
*/
static int
-StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int level;
- CONST char* command;
- Tcl_Command commandInfo;
- int objc;
- Tcl_Obj *CONST *objv;
+StringTraceProc(
+ ClientData clientData,
+ Tcl_Interp* interp,
+ int level,
+ CONST char* command,
+ Tcl_Command commandInfo,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
StringTraceData* data = (StringTraceData*) clientData;
Command* cmdPtr = (Command*) commandInfo;
@@ -2243,8 +2257,8 @@ StringTraceProc(clientData, interp, level, command, commandInfo, objc, objv)
*/
static void
-StringTraceDeleteProc(clientData)
- ClientData clientData;
+StringTraceDeleteProc(
+ ClientData clientData)
{
ckfree((char *) clientData);
}
@@ -2267,9 +2281,9 @@ StringTraceDeleteProc(clientData)
*/
void
-Tcl_DeleteTrace(interp, trace)
- Tcl_Interp *interp; /* Interpreter that contains trace. */
- Tcl_Trace trace; /* Token for trace (returned previously by
+Tcl_DeleteTrace(
+ Tcl_Interp *interp, /* Interpreter that contains trace. */
+ Tcl_Trace trace) /* Token for trace (returned previously by
* Tcl_CreateTrace). */
{
Interp *iPtr = (Interp *) interp;
@@ -2358,9 +2372,9 @@ Tcl_DeleteTrace(interp, trace)
*/
Var *
-TclVarTraceExists(interp, varName)
- Tcl_Interp *interp; /* The interpreter */
- CONST char *varName; /* The variable name */
+TclVarTraceExists(
+ Tcl_Interp *interp, /* The interpreter */
+ CONST char *varName) /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
@@ -2374,7 +2388,7 @@ TclVarTraceExists(interp, varName)
* is triggered. This matches Tcl 7.6 semantics.
*/
- varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, "access",
+ varPtr = TclLookupVar(interp, varName, NULL, 0, "access",
/*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
if (varPtr == NULL) {
@@ -2424,20 +2438,20 @@ TclVarTraceExists(interp, varName)
*/
int
-TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
- Interp *iPtr; /* Interpreter containing variable. */
- register Var *arrayPtr; /* Pointer to array variable that contains the
+TclCallVarTraces(
+ Interp *iPtr, /* Interpreter containing variable. */
+ register Var *arrayPtr, /* Pointer to array variable that contains the
* variable, or NULL if the variable isn't an
* element of an array. */
- Var *varPtr; /* Variable whose traces are to be invoked. */
- CONST char *part1;
- CONST char *part2; /* Variable's two-part name. */
- int flags; /* Flags passed to trace functions: indicates
+ Var *varPtr, /* Variable whose traces are to be invoked. */
+ CONST char *part1,
+ CONST char *part2, /* Variable's two-part name. */
+ int flags, /* Flags passed to trace functions: indicates
* what's happening to variable, plus other
* stuff like TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY, and
* TCL_INTERP_DESTROYED. */
- int leaveErrMsg; /* If true, and one of the traces indicates an
+ int leaveErrMsg) /* If true, and one of the traces indicates an
* error, then leave an error message and
* stack trace information in *iPTr. */
{
@@ -2679,10 +2693,10 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
*/
static void
-DisposeTraceResult(flags, result)
- int flags; /* Indicates type of result to determine
+DisposeTraceResult(
+ int flags, /* Indicates type of result to determine
* proper disposal method. */
- char *result; /* The result returned from a trace function
+ char *result) /* The result returned from a trace function
* to be disposed. */
{
if (flags & TCL_TRACE_RESULT_DYNAMIC) {
@@ -2710,18 +2724,18 @@ DisposeTraceResult(flags, result)
*/
void
-Tcl_UntraceVar(interp, varName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+Tcl_UntraceVar(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed collection of bits describing current
+ int flags, /* OR-ed collection of bits describing current
* trace, including any of TCL_TRACE_READS,
* TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
* TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
+ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
}
/*
@@ -2742,18 +2756,18 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
*/
void
-Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *part1; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+Tcl_UntraceVar2(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *part1, /* Name of variable or array. */
+ CONST char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed collection of bits describing current
+ int flags, /* OR-ed collection of bits describing current
* trace, including any of TCL_TRACE_READS,
* TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
* TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register VarTrace *tracePtr;
VarTrace *prevPtr;
@@ -2768,8 +2782,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*/
flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
- varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
- /*msg*/ (char *) NULL,
+ varPtr = TclLookupVar(interp, part1, part2, flags & flagMask, /*msg*/ NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return;
@@ -2822,7 +2835,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*/
if (TclIsVarUndefined(varPtr)) {
- TclCleanupVar(varPtr, (Var *) NULL);
+ TclCleanupVar(varPtr, NULL);
}
}
@@ -2850,20 +2863,20 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
*/
ClientData
-Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+Tcl_VarTraceInfo(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
+ int flags, /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
{
- return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
- flags, proc, prevClientData);
+ return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
+ prevClientData);
}
/*
@@ -2884,16 +2897,16 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
*/
ClientData
-Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *part1; /* Name of variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+Tcl_VarTraceInfo2(
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *part1, /* Name of variable or array. */
+ CONST char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
+ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function assocated with trace. */
- ClientData prevClientData; /* If non-NULL, gives last value returned by
+ Tcl_VarTraceProc *proc, /* Function assocated with trace. */
+ ClientData prevClientData) /* If non-NULL, gives last value returned by
* this function, so this call will return the
* next trace after that one. If NULL, this
* call will return the first trace. */
@@ -2902,8 +2915,7 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Var *varPtr, *arrayPtr;
varPtr = TclLookupVar(interp, part1, part2,
- flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
- /*msg*/ (char *) NULL,
+ flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if (varPtr == NULL) {
return NULL;
@@ -2952,21 +2964,20 @@ Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
*/
int
-Tcl_TraceVar(interp, varName, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is to be
+Tcl_TraceVar(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *varName; /* Name of variable; may end with "(index)" to
+ CONST char *varName, /* Name of variable; may end with "(index)" to
* signify an array reference. */
- int flags; /* OR-ed collection of bits, including any of
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function to call when specified ops are
+ Tcl_VarTraceProc *proc, /* Function to call when specified ops are
* invoked upon varName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
- return Tcl_TraceVar2(interp, varName, (char *) NULL,
- flags, proc, clientData);
+ return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
}
/*
@@ -2991,20 +3002,20 @@ Tcl_TraceVar(interp, varName, flags, proc, clientData)
*/
int
-Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
- Tcl_Interp *interp; /* Interpreter in which variable is to be
+Tcl_TraceVar2(
+ Tcl_Interp *interp, /* Interpreter in which variable is to be
* traced. */
- CONST char *part1; /* Name of scalar variable or array. */
- CONST char *part2; /* Name of element within array; NULL means
+ CONST char *part1, /* Name of scalar variable or array. */
+ CONST char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
- int flags; /* OR-ed collection of bits, including any of
+ int flags, /* OR-ed collection of bits, including any of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
* TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
* TCL_NAMESPACE_ONLY. */
- Tcl_VarTraceProc *proc; /* Function to call when specified ops are
+ Tcl_VarTraceProc *proc, /* Function to call when specified ops are
* invoked upon varName. */
- ClientData clientData; /* Arbitrary argument to pass to proc. */
+ ClientData clientData) /* Arbitrary argument to pass to proc. */
{
Var *varPtr, *arrayPtr;
register VarTrace *tracePtr;