diff options
| -rw-r--r-- | generic/tclNotify.c | 95 | ||||
| -rw-r--r-- | generic/tclObj.c | 892 | ||||
| -rw-r--r-- | generic/tclPkg.c | 198 | ||||
| -rw-r--r-- | generic/tclProc.c | 253 | ||||
| -rw-r--r-- | generic/tclRegexp.c | 176 | ||||
| -rw-r--r-- | generic/tclResolve.c | 80 | ||||
| -rw-r--r-- | generic/tclResult.c | 173 | ||||
| -rw-r--r-- | generic/tclTrace.c | 449 |
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(®expPtr->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; |