summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAlloc.c225
-rw-r--r--generic/tclAsync.c177
-rw-r--r--generic/tclCkalloc.c478
-rw-r--r--generic/tclIOSock.c33
-rw-r--r--generic/tclPanic.c40
-rw-r--r--generic/tclPkg.c836
-rw-r--r--generic/tclPosixStr.c758
-rw-r--r--generic/tclThreadJoin.c301
-rw-r--r--generic/tclThreadStorage.c286
9 files changed, 1599 insertions, 1535 deletions
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 8c1218d..fcdd75d 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -1,10 +1,10 @@
-/*
+/*
* tclAlloc.c --
*
- * This is a very fast storage allocator. It allocates blocks of a
- * small number of different sizes, and keeps free lists of each size.
- * Blocks that don't exactly fit are passed up to the next larger size.
- * Blocks over a certain size are directly allocated from the system.
+ * This is a very fast storage allocator. It allocates blocks of a small
+ * number of different sizes, and keeps free lists of each size. Blocks
+ * that don't exactly fit are passed up to the next larger size. Blocks
+ * over a certain size are directly allocated from the system.
*
* Copyright (c) 1983 Regents of the University of California.
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
@@ -12,10 +12,10 @@
*
* Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAlloc.c,v 1.21 2004/10/06 12:44:52 dkf Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.22 2005/07/19 22:45:18 dkf Exp $
*/
/*
@@ -35,36 +35,37 @@
#endif
/*
- * We should really make use of AC_CHECK_TYPE(caddr_t)
- * here, but it can wait until Tcl uses config.h properly.
+ * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
+ * until Tcl uses config.h properly.
*/
+
#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
#endif
/*
- * The overhead on a block is at least 8 bytes. When free, this space
- * contains a pointer to the next free block, and the bottom two bits must * be zero. When in use, the first byte is set to MAGIC, and the second
- * byte is the size index. The remaining bytes are for alignment.
- * If range checking is enabled then a second word holds the size of the
- * requested block, less 1, rounded up to a multiple of sizeof(RMAGIC).
- * The order of elements is critical: ov.magic must overlay the low order
- * bits of ov.next, and ov.magic can not be a valid ov.next bit pattern.
+ * The overhead on a block is at least 8 bytes. When free, this space contains
+ * a pointer to the next free block, and the bottom two bits must be zero.
+ * When in use, the first byte is set to MAGIC, and the second byte is the
+ * size index. The remaining bytes are for alignment. If range checking is
+ * enabled then a second word holds the size of the requested block, less 1,
+ * rounded up to a multiple of sizeof(RMAGIC). The order of elements is
+ * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic
+ * can not be a valid ov.next bit pattern.
*/
union overhead {
- union overhead *next; /* when free */
- unsigned char padding[8]; /* Ensure the structure is 8-byte
- * aligned. */
+ union overhead *next; /* when free */
+ unsigned char padding[8]; /* Ensure the structure is 8-byte aligned. */
struct {
- unsigned char magic0; /* magic number */
- unsigned char index; /* bucket # */
- unsigned char unused; /* unused */
- unsigned char magic1; /* other magic number */
+ unsigned char magic0; /* magic number */
+ unsigned char index; /* bucket # */
+ unsigned char unused; /* unused */
+ unsigned char magic1; /* other magic number */
#ifdef RCHECK
- unsigned short rmagic; /* range magic number */
- unsigned long size; /* actual block size */
- unsigned short unused2; /* padding to 8-byte align */
+ unsigned short rmagic; /* range magic number */
+ unsigned long size; /* actual block size */
+ unsigned short unused2; /* padding to 8-byte align */
#endif
} ovu;
#define overMagic0 ovu.magic0
@@ -75,8 +76,8 @@ union overhead {
};
-#define MAGIC 0xef /* magic # on accounting info */
-#define RMAGIC 0x5555 /* magic # on range info */
+#define MAGIC 0xef /* magic # on accounting info */
+#define RMAGIC 0x5555 /* magic # on range info */
#ifdef RCHECK
#define RSLOP sizeof (unsigned short)
@@ -94,37 +95,37 @@ union overhead {
(*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize))
/*
- * nextf[i] is the pointer to the next free block of size 2^(i+3). The
- * smallest allocatable block is 8 bytes. The overhead information
- * precedes the data area returned to the user.
+ * nextf[i] is the pointer to the next free block of size 2^(i+3). The
+ * smallest allocatable block is 8 bytes. The overhead information precedes
+ * the data area returned to the user.
*/
#define NBUCKETS 13
#define MAXMALLOC (1<<(NBUCKETS+2))
-static union overhead *nextf[NBUCKETS];
+static union overhead *nextf[NBUCKETS];
-/*
- * The following structure is used to keep track of all system memory
- * currently owned by Tcl. When finalizing, all this memory will
- * be returned to the system.
+/*
+ * The following structure is used to keep track of all system memory
+ * currently owned by Tcl. When finalizing, all this memory will be returned
+ * to the system.
*/
struct block {
struct block *nextPtr; /* Linked list. */
- struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte
+ struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte
* alignment for suballocated blocks. */
};
-static struct block *blockList; /* Tracks the suballocated blocks. */
-static struct block bigBlocks = { /* Big blocks aren't suballocated. */
+static struct block *blockList; /* Tracks the suballocated blocks. */
+static struct block bigBlocks={ /* Big blocks aren't suballocated. */
&bigBlocks, &bigBlocks
};
/*
- * The allocator is protected by a special mutex that must be
- * explicitly initialized. Futhermore, because Tcl_Alloc may be
- * used before anything else in Tcl, we make this module self-initializing
- * after all with the allocInit variable.
+ * The allocator is protected by a special mutex that must be explicitly
+ * initialized. Futhermore, because Tcl_Alloc may be used before anything else
+ * in Tcl, we make this module self-initializing after all with the allocInit
+ * variable.
*/
#ifdef TCL_THREADS
@@ -132,12 +133,11 @@ static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;
-
#ifdef MSTATS
/*
- * numMallocs[i] is the difference between the number of mallocs and frees
- * for a given block size.
+ * numMallocs[i] is the difference between the number of mallocs and frees for
+ * a given block size.
*/
static unsigned int numMallocs[NBUCKETS+1];
@@ -145,7 +145,7 @@ static unsigned int numMallocs[NBUCKETS+1];
#endif
#if defined(DEBUG) || defined(RCHECK)
-#define ASSERT(p) if (!(p)) Tcl_Panic(# p)
+#define ASSERT(p) if (!(p)) Tcl_Panic(# p)
#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
#else
#define ASSERT(p)
@@ -157,7 +157,6 @@ static unsigned int numMallocs[NBUCKETS+1];
*/
static void MoreCore _ANSI_ARGS_((int bucket));
-
/*
*-------------------------------------------------------------------------
@@ -191,21 +190,20 @@ TclInitAlloc()
*
* TclFinalizeAllocSubsystem --
*
- * Release all resources being used by this subsystem, including
- * aggressively freeing all memory allocated by TclpAlloc() that
- * has not yet been released with TclpFree().
- *
- * After this function is called, all memory allocated with
- * TclpAlloc() should be considered unusable.
+ * Release all resources being used by this subsystem, including
+ * aggressively freeing all memory allocated by TclpAlloc() that has not
+ * yet been released with TclpFree().
+ *
+ * After this function is called, all memory allocated with TclpAlloc()
+ * should be considered unusable.
*
* Results:
* None.
*
* Side effects:
- * This subsystem is self-initializing, since memory can be
- * allocated before Tcl is formally initialized. After this call,
- * this subsystem has been reset to its initial state and is
- * usable again.
+ * This subsystem is self-initializing, since memory can be allocated
+ * before Tcl is formally initialized. After this call, this subsystem
+ * has been reset to its initial state and is usable again.
*
*-------------------------------------------------------------------------
*/
@@ -231,7 +229,7 @@ TclFinalizeAllocSubsystem()
bigBlocks.nextPtr = &bigBlocks;
bigBlocks.prevPtr = &bigBlocks;
- for (i = 0; i < NBUCKETS; i++) {
+ for (i=0 ; i<NBUCKETS ; i++) {
nextf[i] = NULL;
#ifdef MSTATS
numMallocs[i] = 0;
@@ -270,18 +268,20 @@ TclpAlloc(numBytes)
if (!allocInit) {
/*
- * We have to make the "self initializing" because Tcl_Alloc
- * may be used before any other part of Tcl. E.g., see
- * main() for tclsh!
+ * We have to make the "self initializing" because Tcl_Alloc may be
+ * used before any other part of Tcl. E.g., see main() for tclsh!
*/
+
TclInitAlloc();
}
Tcl_MutexLock(allocMutexPtr);
+
/*
- * First the simple case: we simple allocate big blocks directly
+ * First the simple case: we simple allocate big blocks directly.
*/
+
if (numBytes + OVERHEAD >= MAXMALLOC) {
- bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
+ bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
(sizeof(struct block) + OVERHEAD + numBytes), 0);
if (bigBlockPtr == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
@@ -298,23 +298,27 @@ TclpAlloc(numBytes)
#ifdef MSTATS
numMallocs[NBUCKETS]++;
#endif
+
#ifdef RCHECK
/*
- * Record allocated size of block and
- * bound space with magic numbers.
+ * Record allocated size of block and bound space with magic numbers.
*/
+
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
overPtr->rangeCheckMagic = RMAGIC;
BLOCK_END(overPtr) = RMAGIC;
#endif
+
Tcl_MutexUnlock(allocMutexPtr);
return (void *)(overPtr+1);
}
+
/*
- * Convert amount of memory requested into closest block size
- * stored in hash buckets which satisfies request.
- * Account for space used per block for accounting.
+ * Convert amount of memory requested into closest block size stored in
+ * hash buckets which satisfies request. Account for space used per block
+ * for accounting.
*/
+
#ifndef RCHECK
amount = 8; /* size of first bucket */
bucket = 0;
@@ -322,45 +326,52 @@ TclpAlloc(numBytes)
amount = 16; /* size of first bucket */
bucket = 1;
#endif
+
while (numBytes + OVERHEAD > amount) {
amount <<= 1;
if (amount == 0) {
Tcl_MutexUnlock(allocMutexPtr);
- return (NULL);
+ return NULL;
}
bucket++;
}
ASSERT(bucket < NBUCKETS);
/*
- * If nothing in hash bucket right now,
- * request more memory from the system.
+ * If nothing in hash bucket right now, request more memory from the
+ * system.
*/
+
if ((overPtr = nextf[bucket]) == NULL) {
MoreCore(bucket);
if ((overPtr = nextf[bucket]) == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
- return (NULL);
+ return NULL;
}
}
+
/*
* Remove from linked list
*/
+
nextf[bucket] = overPtr->next;
overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
overPtr->bucketIndex = (unsigned char) bucket;
+
#ifdef MSTATS
numMallocs[bucket]++;
#endif
+
#ifdef RCHECK
/*
- * Record allocated size of block and
- * bound space with magic numbers.
+ * Record allocated size of block and bound space with magic numbers.
*/
+
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
overPtr->rangeCheckMagic = RMAGIC;
BLOCK_END(overPtr) = RMAGIC;
#endif
+
Tcl_MutexUnlock(allocMutexPtr);
return ((char *)(overPtr + 1));
}
@@ -394,9 +405,10 @@ MoreCore(bucket)
struct block *blockPtr;
/*
- * sbrk_size <= 0 only for big, FLUFFY, requests (about
- * 2^30 bytes on a VAX, I think) or for a negative arg.
+ * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
+ * VAX, I think) or for a negative arg.
*/
+
size = 1 << (bucket + 3);
ASSERT(size > 0);
@@ -404,7 +416,7 @@ MoreCore(bucket)
numBlocks = amount / size;
ASSERT(numBlocks*size == amount);
- blockPtr = (struct block *) TclpSysAlloc((unsigned)
+ blockPtr = (struct block *) TclpSysAlloc((unsigned)
(sizeof(struct block) + amount), 1);
/* no more room! */
if (blockPtr == NULL) {
@@ -414,11 +426,11 @@ MoreCore(bucket)
blockList = blockPtr;
overPtr = (union overhead *) (blockPtr + 1);
-
+
/*
- * Add new memory allocated to that on
- * free list for this hash bucket.
+ * Add new memory allocated to that on free list for this hash bucket.
*/
+
nextf[bucket] = overPtr;
while (--numBlocks > 0) {
overPtr->next = (union overhead *)((caddr_t)overPtr + size);
@@ -446,7 +458,7 @@ MoreCore(bucket)
void
TclpFree(oldPtr)
char *oldPtr; /* Pointer to memory to free. */
-{
+{
register long size;
register union overhead *overPtr;
struct block *bigBlockPtr;
@@ -472,19 +484,23 @@ TclpFree(oldPtr)
#ifdef MSTATS
numMallocs[NBUCKETS]--;
#endif
+
bigBlockPtr = (struct block *) overPtr - 1;
bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
TclpSysFree(bigBlockPtr);
+
Tcl_MutexUnlock(allocMutexPtr);
return;
}
ASSERT(size < NBUCKETS);
overPtr->next = nextf[size]; /* also clobbers overMagic */
nextf[size] = overPtr;
+
#ifdef MSTATS
numMallocs[size]--;
#endif
+
Tcl_MutexUnlock(allocMutexPtr);
}
@@ -508,7 +524,7 @@ char *
TclpRealloc(oldPtr, numBytes)
char *oldPtr; /* Pointer to alloced block. */
unsigned int numBytes; /* New size of memory. */
-{
+{
int i;
union overhead *overPtr;
struct block *bigBlockPtr;
@@ -516,7 +532,7 @@ TclpRealloc(oldPtr, numBytes)
unsigned long maxSize;
if (oldPtr == NULL) {
- return (TclpAlloc(numBytes));
+ return TclpAlloc(numBytes);
}
Tcl_MutexLock(allocMutexPtr);
@@ -543,7 +559,7 @@ TclpRealloc(oldPtr, numBytes)
bigBlockPtr = (struct block *) overPtr - 1;
prevPtr = bigBlockPtr->prevPtr;
nextPtr = bigBlockPtr->nextPtr;
- bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
+ bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
sizeof(struct block) + OVERHEAD + numBytes);
if (bigBlockPtr == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
@@ -552,8 +568,8 @@ TclpRealloc(oldPtr, numBytes)
if (prevPtr->nextPtr != bigBlockPtr) {
/*
- * If the block has moved, splice the new block into the list where
- * the old block used to be.
+ * If the block has moved, splice the new block into the list
+ * where the old block used to be.
*/
prevPtr->nextPtr = bigBlockPtr;
@@ -561,9 +577,11 @@ TclpRealloc(oldPtr, numBytes)
}
overPtr = (union overhead *) (bigBlockPtr + 1);
+
#ifdef MSTATS
numMallocs[NBUCKETS]++;
#endif
+
#ifdef RCHECK
/*
* Record allocated size of block and update magic number bounds.
@@ -572,6 +590,7 @@ TclpRealloc(oldPtr, numBytes)
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
BLOCK_END(overPtr) = RMAGIC;
#endif
+
Tcl_MutexUnlock(allocMutexPtr);
return (char *)(overPtr+1);
}
@@ -600,14 +619,16 @@ TclpRealloc(oldPtr, numBytes)
TclpFree(oldPtr);
return newPtr;
}
-
+
/*
* Ok, we don't have to copy, it fits as-is
*/
+
#ifdef RCHECK
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
BLOCK_END(overPtr) = RMAGIC;
#endif
+
Tcl_MutexUnlock(allocMutexPtr);
return(oldPtr);
}
@@ -617,9 +638,9 @@ TclpRealloc(oldPtr, numBytes)
*
* mstats --
*
- * Prints two lines of numbers, one showing the length of the
- * free list for each size category, the second showing the
- * number of mallocs - frees for each size category.
+ * Prints two lines of numbers, one showing the length of the free list
+ * for each size category, the second showing the number of mallocs -
+ * frees for each size category.
*
* Results:
* None.
@@ -633,13 +654,14 @@ TclpRealloc(oldPtr, numBytes)
#ifdef MSTATS
void
mstats(s)
- char *s; /* Where to write info. */
+ char *s; /* Where to write info. */
{
register int i, j;
register union overhead *overPtr;
int totalFree = 0, totalUsed = 0;
Tcl_MutexLock(allocMutexPtr);
+
fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
for (i = 0; i < NBUCKETS; i++) {
for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
@@ -647,15 +669,18 @@ mstats(s)
}
totalFree += j * (1 << (i + 3));
}
+
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
fprintf(stderr, " %d", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
}
+
fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
totalUsed, totalFree);
- fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
+ fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
MAXMALLOC, numMallocs[NBUCKETS]);
+
Tcl_MutexUnlock(allocMutexPtr);
}
#endif
@@ -704,7 +729,7 @@ TclpAlloc(numBytes)
void
TclpFree(oldPtr)
char *oldPtr; /* Pointer to memory to free. */
-{
+{
free(oldPtr);
return;
}
@@ -729,9 +754,17 @@ char *
TclpRealloc(oldPtr, numBytes)
char *oldPtr; /* Pointer to alloced block. */
unsigned int numBytes; /* New size of memory. */
-{
+{
return (char*) realloc(oldPtr, numBytes);
}
#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index 49bebfb..ce29235 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -1,18 +1,17 @@
-/*
+/*
* tclAsync.c --
*
- * This file provides low-level support needed to invoke signal
- * handlers in a safe way. The code here doesn't actually handle
- * signals, though. This code is based on proposals made by
- * Mark Diekhans and Don Libes.
+ * This file provides low-level support needed to invoke signal handlers
+ * in a safe way. The code here doesn't actually handle signals, though.
+ * This code is based on proposals made by Mark Diekhans and Don Libes.
*
* Copyright (c) 1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAsync.c,v 1.7 2004/04/06 22:25:48 dgp Exp $
+ * RCS: @(#) $Id: tclAsync.c,v 1.8 2005/07/19 22:45:19 dkf Exp $
*/
#include "tclInt.h"
@@ -21,72 +20,61 @@
struct ThreadSpecificData;
/*
- * One of the following structures exists for each asynchronous
- * handler:
+ * One of the following structures exists for each asynchronous handler:
*/
typedef struct AsyncHandler {
- int ready; /* Non-zero means this handler should
- * be invoked in the next call to
- * Tcl_AsyncInvoke. */
- struct AsyncHandler *nextPtr; /* Next in list of all handlers for
- * the process. */
- Tcl_AsyncProc *proc; /* Procedure to call when handler
- * is invoked. */
- ClientData clientData; /* Value to pass to handler when it
- * is invoked. */
+ int ready; /* Non-zero means this handler should be
+ * invoked in the next call to
+ * Tcl_AsyncInvoke. */
+ struct AsyncHandler *nextPtr;
+ /* Next in list of all handlers for the
+ * process. */
+ Tcl_AsyncProc *proc; /* Procedure to call when handler is
+ * invoked. */
+ ClientData clientData; /* Value to pass to handler when it is
+ * invoked. */
struct ThreadSpecificData *originTsd;
- /* Used in Tcl_AsyncMark to modify thread-
- * specific data from outside the thread
- * it is associated to. */
- Tcl_ThreadId originThrdId; /* Origin thread where this token was
- * created and where it will be
- * yielded. */
+ /* Used in Tcl_AsyncMark to modify thread-
+ * specific data from outside the thread it is
+ * associated to. */
+ Tcl_ThreadId originThrdId; /* Origin thread where this token was created
+ * and where it will be yielded. */
} AsyncHandler;
-
typedef struct ThreadSpecificData {
/*
- * The variables below maintain a list of all existing handlers
- * specific to the calling thread.
- */
- AsyncHandler *firstHandler; /* First handler defined for process,
- * or NULL if none. */
- AsyncHandler *lastHandler; /* Last handler or NULL. */
-
- /*
- * The variable below is set to 1 whenever a handler becomes ready and
- * it is cleared to zero whenever Tcl_AsyncInvoke is called. It can be
- * checked elsewhere in the application by calling Tcl_AsyncReady to see
- * if Tcl_AsyncInvoke should be invoked.
- */
-
- int asyncReady;
-
- /*
- * The variable below indicates whether Tcl_AsyncInvoke is currently
- * working. If so then we won't set asyncReady again until
- * Tcl_AsyncInvoke returns.
+ * The variables below maintain a list of all existing handlers specific
+ * to the calling thread.
*/
-
- int asyncActive;
-
- Tcl_Mutex asyncMutex; /* Thread-specific AsyncHandler linked-list lock */
-
+ AsyncHandler *firstHandler; /* First handler defined for process, or NULL
+ * if none. */
+ AsyncHandler *lastHandler; /* Last handler or NULL. */
+ int asyncReady; /* This is set to 1 whenever a handler becomes
+ * ready and it is cleared to zero whenever
+ * Tcl_AsyncInvoke is called. It can be
+ * checked elsewhere in the application by
+ * calling Tcl_AsyncReady to see if
+ * Tcl_AsyncInvoke should be invoked. */
+ int asyncActive; /* Indicates whether Tcl_AsyncInvoke is
+ * currently working. If so then we won't set
+ * asyncReady again until Tcl_AsyncInvoke
+ * returns. */
+ Tcl_Mutex asyncMutex; /* Thread-specific AsyncHandler linked-list
+ * lock */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-
/*
*----------------------------------------------------------------------
*
* TclFinalizeAsync --
*
- * Finalizes the mutex in the thread local data structure for the
- * async subsystem.
+ * Finalizes the mutex in the thread local data structure for the async
+ * subsystem.
*
* Results:
- * None.
+ * None.
*
* Side effects:
* Forgets knowledge of the mutex should it have been created.
@@ -110,12 +98,12 @@ TclFinalizeAsync()
* Tcl_AsyncCreate --
*
* This procedure creates the data structures for an asynchronous
- * handler, so that no memory has to be allocated when the handler
- * is activated.
+ * handler, so that no memory has to be allocated when the handler is
+ * activated.
*
* Results:
- * The return value is a token for the handler, which can be used
- * to activate it later on.
+ * The return value is a token for the handler, which can be used to
+ * activate it later on.
*
* Side effects:
* Information about the handler is recorded.
@@ -125,9 +113,9 @@ TclFinalizeAsync()
Tcl_AsyncHandler
Tcl_AsyncCreate(proc, clientData)
- Tcl_AsyncProc *proc; /* Procedure to call when handler
- * is invoked. */
- ClientData clientData; /* Argument to pass to handler. */
+ Tcl_AsyncProc *proc; /* Procedure to call when handler is
+ * invoked. */
+ ClientData clientData; /* Argument to pass to handler. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -156,10 +144,10 @@ Tcl_AsyncCreate(proc, clientData)
*
* Tcl_AsyncMark --
*
- * This procedure is called to request that an asynchronous handler
- * be invoked as soon as possible. It's typically called from
- * an interrupt handler, where it isn't safe to do anything that
- * depends on or modifies application state.
+ * This procedure is called to request that an asynchronous handler be
+ * invoked as soon as possible. It's typically called from an interrupt
+ * handler, where it isn't safe to do anything that depends on or
+ * modifies application state.
*
* Results:
* None.
@@ -190,13 +178,12 @@ Tcl_AsyncMark(async)
*
* Tcl_AsyncInvoke --
*
- * This procedure is called at a "safe" time at background level
- * to invoke any active asynchronous handlers.
+ * This procedure is called at a "safe" time at background level to
+ * invoke any active asynchronous handlers.
*
* Results:
- * The return value is a normal Tcl result, which is intended to
- * replace the code argument as the current completion code for
- * interp.
+ * The return value is a normal Tcl result, which is intended to replace
+ * the code argument as the current completion code for interp.
*
* Side effects:
* Depends on the handlers that are active.
@@ -206,13 +193,12 @@ Tcl_AsyncMark(async)
int
Tcl_AsyncInvoke(interp, code)
- Tcl_Interp *interp; /* If invoked from Tcl_Eval just after
- * completing a command, points to
- * interpreter. Otherwise it is
- * NULL. */
- int code; /* If interp is non-NULL, this gives
- * completion code from command that
- * just completed. */
+ Tcl_Interp *interp; /* If invoked from Tcl_Eval just after
+ * completing a command, points to
+ * interpreter. Otherwise it is NULL. */
+ int code; /* If interp is non-NULL, this gives
+ * completion code from command that just
+ * completed. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -230,13 +216,12 @@ Tcl_AsyncInvoke(interp, code)
}
/*
- * Make one or more passes over the list of handlers, invoking
- * at most one handler in each pass. After invoking a handler,
- * go back to the start of the list again so that (a) if a new
- * higher-priority handler gets marked while executing a lower
- * priority handler, we execute the higher-priority handler
- * next, and (b) if a handler gets deleted during the execution
- * of a handler, then the list structure may change so it isn't
+ * Make one or more passes over the list of handlers, invoking at most one
+ * handler in each pass. After invoking a handler, go back to the start of
+ * the list again so that (a) if a new higher-priority handler gets marked
+ * while executing a lower priority handler, we execute the higher-
+ * priority handler next, and (b) if a handler gets deleted during the
+ * execution of a handler, then the list structure may change so it isn't
* safe to continue down the list anyway.
*/
@@ -265,8 +250,8 @@ Tcl_AsyncInvoke(interp, code)
*
* Tcl_AsyncDelete --
*
- * Frees up all the state for an asynchronous handler. The handler
- * should never be used again.
+ * Frees up all the state for an asynchronous handler. The handler should
+ * never be used again.
*
* Results:
* None.
@@ -310,13 +295,13 @@ Tcl_AsyncDelete(async)
*
* Tcl_AsyncReady --
*
- * This procedure can be used to tell whether Tcl_AsyncInvoke
- * needs to be called. This procedure is the external interface
- * for checking the thread-specific asyncReady variable.
+ * This procedure can be used to tell whether Tcl_AsyncInvoke needs to be
+ * called. This procedure is the external interface for checking the
+ * thread-specific asyncReady variable.
*
* Results:
- * The return value is 1 whenever a handler is ready and is 0
- * when no handlers are ready.
+ * The return value is 1 whenever a handler is ready and is 0 when no
+ * handlers are ready.
*
* Side effects:
* None.
@@ -330,3 +315,11 @@ Tcl_AsyncReady()
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
return tsdPtr->asyncReady;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index dbae0fd..595c24a 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -1,19 +1,20 @@
-/*
+/*
* tclCkalloc.c --
*
- * Interface to malloc and free that provides support for debugging problems
- * involving overwritten, double freeing memory and loss of memory.
+ * Interface to malloc and free that provides support for debugging
+ * problems involving overwritten, double freeing memory and loss of
+ * memory.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.22 2004/10/06 13:05:02 dkf Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.23 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -29,29 +30,29 @@
*/
typedef struct MemTag {
- int refCount; /* Number of mem_headers referencing
- * this tag. */
- char string[4]; /* Actual size of string will be as
- * large as needed for actual tag. This
- * must be the last field in the structure. */
+ int refCount; /* Number of mem_headers referencing this
+ * tag. */
+ char string[4]; /* Actual size of string will be as large as
+ * needed for actual tag. This must be the
+ * last field in the structure. */
} MemTag;
#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
-static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers
- * (set by "memory tag" command). */
+static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
+ * by "memory tag" command). */
/*
- * One of the following structures is allocated just before each
- * dynamically allocated chunk of memory, both to record information
- * about the chunk and to help detect chunk under-runs.
+ * One of the following structures is allocated just before each dynamically
+ * allocated chunk of memory, both to record information about the chunk and
+ * to help detect chunk under-runs.
*/
#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
struct mem_header {
struct mem_header *flink;
struct mem_header *blink;
- MemTag *tagPtr; /* Tag from "memory tag" command; may be
+ MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
CONST char *file;
long length;
@@ -60,9 +61,8 @@ struct mem_header {
/* Aligns body on 8-byte boundary, plus
* provides at least 8 additional guard bytes
* to detect underruns. */
- char body[1]; /* First byte of client's space. Actual
- * size of this field will be larger than
- * one. */
+ char body[1]; /* First byte of client's space. Actual size
+ * of this field will be larger than one. */
};
static struct mem_header *allocHead = NULL; /* List of allocated structures */
@@ -70,16 +70,16 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
#define GUARD_VALUE 0141
/*
- * The following macro determines the amount of guard space *above* each
- * chunk of memory.
+ * The following macro determines the amount of guard space *above* each chunk
+ * of memory.
*/
#define HIGH_GUARD_SIZE 8
/*
* The following macro computes the offset of the "body" field within
- * mem_header. It is used to get back to the header pointer from the
- * body pointer that's used by clients.
+ * mem_header. It is used to get back to the header pointer from the body
+ * pointer that's used by clients.
*/
#define BODY_OFFSET \
@@ -102,10 +102,10 @@ static int init_malloced_bodies = TRUE;
#endif
/*
- * The following variable indicates to TclFinalizeMemorySubsystem()
- * that it should dump out the state of memory before exiting. If the
- * value is non-NULL, it gives the name of the file in which to
- * dump memory usage information.
+ * The following variable indicates to TclFinalizeMemorySubsystem() that it
+ * should dump out the state of memory before exiting. If the value is
+ * non-NULL, it gives the name of the file in which to dump memory usage
+ * information.
*/
char *tclMemDumpFileName = NULL;
@@ -115,10 +115,11 @@ static char dumpFile[100]; /* Records where to dump memory allocation
* information. */
/*
- * Mutex to serialize allocations. This is a low-level mutex that must
- * be explicitly initialized. This is necessary because the self
- * initializing mutexes use ckalloc...
+ * Mutex to serialize allocations. This is a low-level mutex that must be
+ * explicitly initialized. This is necessary because the self initializing
+ * mutexes use ckalloc...
*/
+
static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;
@@ -138,15 +139,16 @@ static void ValidateMemory _ANSI_ARGS_((
*----------------------------------------------------------------------
*
* TclInitDbCkalloc --
- * Initialize the locks used by the allocator.
- * This is only appropriate to call in a single threaded environment,
- * such as during TclInitSubsystems.
+ *
+ * Initialize the locks used by the allocator. This is only appropriate
+ * to call in a single threaded environment, such as during
+ * TclInitSubsystems.
*
*----------------------------------------------------------------------
*/
void
-TclInitDbCkalloc()
+TclInitDbCkalloc()
{
if (!ckallocInit) {
ckallocInit = 1;
@@ -158,26 +160,27 @@ TclInitDbCkalloc()
*----------------------------------------------------------------------
*
* TclDumpMemoryInfo --
- * Display the global memory management statistics.
+ *
+ * Display the global memory management statistics.
*
*----------------------------------------------------------------------
*/
void
-TclDumpMemoryInfo(outFile)
+TclDumpMemoryInfo(outFile)
FILE *outFile;
{
- fprintf(outFile,"total mallocs %10d\n",
+ fprintf(outFile,"total mallocs %10d\n",
total_mallocs);
- fprintf(outFile,"total frees %10d\n",
+ fprintf(outFile,"total frees %10d\n",
total_frees);
- fprintf(outFile,"current packets allocated %10d\n",
+ fprintf(outFile,"current packets allocated %10d\n",
current_malloc_packets);
- fprintf(outFile,"current bytes allocated %10d\n",
+ fprintf(outFile,"current bytes allocated %10d\n",
current_bytes_malloced);
- fprintf(outFile,"maximum packets allocated %10d\n",
+ fprintf(outFile,"maximum packets allocated %10d\n",
maximum_malloc_packets);
- fprintf(outFile,"maximum bytes allocated %10d\n",
+ fprintf(outFile,"maximum bytes allocated %10d\n",
maximum_bytes_malloced);
}
@@ -213,53 +216,53 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
int idx;
int guard_failed = FALSE;
int byte;
-
+
for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
- byte = *(memHeaderP->low_guard + idx);
- if (byte != GUARD_VALUE) {
- guard_failed = TRUE;
- fflush(stdout);
+ byte = *(memHeaderP->low_guard + idx);
+ if (byte != GUARD_VALUE) {
+ guard_failed = TRUE;
+ fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte,
+ fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
- }
+ }
}
if (guard_failed) {
- TclDumpMemoryInfo (stderr);
- fprintf(stderr, "low guard failed at %lx, %s %d\n",
- (long unsigned int) memHeaderP->body, file, line);
- fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+ TclDumpMemoryInfo (stderr);
+ fprintf(stderr, "low guard failed at %lx, %s %d\n",
+ (long unsigned int) memHeaderP->body, file, line);
+ fflush(stderr); /* In case name pointer is bad. */
+ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
- Tcl_Panic("Memory validation failure");
+ Tcl_Panic("Memory validation failure");
}
hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
- byte = *(hiPtr + idx);
- if (byte != GUARD_VALUE) {
- guard_failed = TRUE;
- fflush(stdout);
+ byte = *(hiPtr + idx);
+ if (byte != GUARD_VALUE) {
+ guard_failed = TRUE;
+ fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte,
+ fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
- }
+ }
}
if (guard_failed) {
- TclDumpMemoryInfo(stderr);
- fprintf(stderr, "high guard failed at %lx, %s %d\n",
- (long unsigned int) memHeaderP->body, file, line);
- fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
+ TclDumpMemoryInfo(stderr);
+ fprintf(stderr, "high guard failed at %lx, %s %d\n",
+ (long unsigned int) memHeaderP->body, file, line);
+ fflush(stderr); /* In case name pointer is bad. */
+ fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
- Tcl_Panic("Memory validation failure");
+ Tcl_Panic("Memory validation failure");
}
if (nukeGuards) {
- memset((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
- memset((char *) hiPtr, 0, HIGH_GUARD_SIZE);
+ memset((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+ memset((char *) hiPtr, 0, HIGH_GUARD_SIZE);
}
}
@@ -282,8 +285,10 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
void
Tcl_ValidateAllMemory(file, line)
- CONST char *file; /* File from which Tcl_ValidateAllMemory was called */
- int line; /* Line number of call to Tcl_ValidateAllMemory */
+ CONST char *file; /* File from which Tcl_ValidateAllMemory was
+ * called. */
+ int line; /* Line number of call to
+ * Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
@@ -292,7 +297,7 @@ Tcl_ValidateAllMemory(file, line)
}
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
- ValidateMemory(memScanP, file, line, FALSE);
+ ValidateMemory(memScanP, file, line, FALSE);
}
Tcl_MutexUnlock(ckallocMutexPtr);
}
@@ -306,14 +311,15 @@ Tcl_ValidateAllMemory(file, line)
* information will be written to stderr.
*
* Results:
- * Return TCL_ERROR if an error accessing the file occurs, `errno'
- * will have the file error number left in it.
+ * Return TCL_ERROR if an error accessing the file occurs, `errno' will
+ * have the file error number left in it.
+ *
*----------------------------------------------------------------------
*/
int
Tcl_DumpActiveMemory (fileName)
- CONST char *fileName; /* Name of the file to write info to */
+ CONST char *fileName; /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
@@ -330,8 +336,8 @@ Tcl_DumpActiveMemory (fileName)
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
- address = &memScanP->body [0];
- fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
+ address = &memScanP->body [0];
+ fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
(long unsigned int) address,
(long unsigned int) address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
@@ -351,16 +357,15 @@ Tcl_DumpActiveMemory (fileName)
*
* Tcl_DbCkalloc - debugging ckalloc
*
- * Allocate the requested amount of space plus some extra for
- * guard bands at both ends of the request, plus a size, panicing
- * if there isn't enough space, then write in the guard bands
- * and return the address of the space in the middle that the
- * user asked for.
+ * Allocate the requested amount of space plus some extra for guard bands
+ * at both ends of the request, plus a size, panicing if there isn't
+ * enough space, then write in the guard bands and return the address of
+ * the space in the middle that the user asked for.
*
- * The second and third arguments are file and line, these contain
- * the filename and line number corresponding to the caller.
- * These are sent by the ckalloc macro; it uses the preprocessor
- * autodefines __FILE__ and __LINE__.
+ * The second and third arguments are file and line, these contain the
+ * filename and line number corresponding to the caller. These are sent
+ * by the ckalloc macro; it uses the preprocessor autodefines __FILE__
+ * and __LINE__.
*
*----------------------------------------------------------------------
*/
@@ -374,24 +379,25 @@ Tcl_DbCkalloc(size, file, line)
struct mem_header *result;
if (validate_memory) {
- Tcl_ValidateAllMemory(file, line);
+ Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
if (result == NULL) {
- fflush(stdout);
- TclDumpMemoryInfo(stderr);
- Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
+ fflush(stdout);
+ TclDumpMemoryInfo(stderr);
+ Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
/*
- * Fill in guard zones and size. Also initialize the contents of
- * the block with bogus bytes to detect uses of initialized data.
- * Link into allocated list.
+ * Fill in guard zones and size. Also initialize the contents of the block
+ * with bogus bytes to detect uses of initialized data. Link into
+ * allocated list.
*/
+
if (init_malloced_bodies) {
- memset((VOID *) result, GUARD_VALUE,
+ memset((VOID *) result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
@@ -412,42 +418,42 @@ Tcl_DbCkalloc(size, file, line)
result->blink = NULL;
if (allocHead != NULL) {
- allocHead->blink = result;
+ allocHead->blink = result;
}
allocHead = result;
total_mallocs++;
if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
(void) fflush(stdout);
- fprintf(stderr, "reached malloc trace enable point (%d)\n",
- total_mallocs);
- fflush(stderr);
- alloc_tracing = TRUE;
- trace_on_at_malloc = 0;
+ fprintf(stderr, "reached malloc trace enable point (%d)\n",
+ total_mallocs);
+ fflush(stderr);
+ alloc_tracing = TRUE;
+ trace_on_at_malloc = 0;
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %lx %u %s %d\n",
+ fprintf(stderr,"ckalloc %lx %u %s %d\n",
(long unsigned int) result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
- break_on_malloc = 0;
+ break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
+ fprintf(stderr,"reached malloc break limit (%d)\n",
+ total_mallocs);
+ fprintf(stderr, "program will now enter C debugger\n");
(void) fflush(stderr);
abort();
}
current_malloc_packets++;
if (current_malloc_packets > maximum_malloc_packets) {
- maximum_malloc_packets = current_malloc_packets;
+ maximum_malloc_packets = current_malloc_packets;
}
current_bytes_malloced += size;
if (current_bytes_malloced > maximum_bytes_malloced) {
- maximum_bytes_malloced = current_bytes_malloced;
+ maximum_bytes_malloced = current_bytes_malloced;
}
Tcl_MutexUnlock(ckallocMutexPtr);
@@ -464,24 +470,24 @@ Tcl_AttemptDbCkalloc(size, file, line)
struct mem_header *result;
if (validate_memory) {
- Tcl_ValidateAllMemory(file, line);
+ Tcl_ValidateAllMemory(file, line);
}
- result = (struct mem_header *) TclpAlloc((unsigned)size +
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
if (result == NULL) {
- fflush(stdout);
- TclDumpMemoryInfo(stderr);
+ fflush(stdout);
+ TclDumpMemoryInfo(stderr);
return NULL;
}
/*
- * Fill in guard zones and size. Also initialize the contents of
- * the block with bogus bytes to detect uses of initialized data.
- * Link into allocated list.
+ * Fill in guard zones and size. Also initialize the contents of the block
+ * with bogus bytes to detect uses of initialized data. Link into
+ * allocated list.
*/
if (init_malloced_bodies) {
- memset((VOID *) result, GUARD_VALUE,
+ memset((VOID *) result, GUARD_VALUE,
size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
} else {
memset((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
@@ -502,42 +508,42 @@ Tcl_AttemptDbCkalloc(size, file, line)
result->blink = NULL;
if (allocHead != NULL) {
- allocHead->blink = result;
+ allocHead->blink = result;
}
allocHead = result;
total_mallocs++;
if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
(void) fflush(stdout);
- fprintf(stderr, "reached malloc trace enable point (%d)\n",
- total_mallocs);
- fflush(stderr);
- alloc_tracing = TRUE;
- trace_on_at_malloc = 0;
+ fprintf(stderr, "reached malloc trace enable point (%d)\n",
+ total_mallocs);
+ fflush(stderr);
+ alloc_tracing = TRUE;
+ trace_on_at_malloc = 0;
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %lx %u %s %d\n",
+ fprintf(stderr,"ckalloc %lx %u %s %d\n",
(long unsigned int) result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
- break_on_malloc = 0;
+ break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
- total_mallocs);
- fprintf(stderr, "program will now enter C debugger\n");
+ fprintf(stderr,"reached malloc break limit (%d)\n",
+ total_mallocs);
+ fprintf(stderr, "program will now enter C debugger\n");
(void) fflush(stderr);
abort();
}
current_malloc_packets++;
if (current_malloc_packets > maximum_malloc_packets) {
- maximum_malloc_packets = current_malloc_packets;
+ maximum_malloc_packets = current_malloc_packets;
}
current_bytes_malloced += size;
if (current_bytes_malloced > maximum_bytes_malloced) {
- maximum_bytes_malloced = current_bytes_malloced;
+ maximum_bytes_malloced = current_bytes_malloced;
}
Tcl_MutexUnlock(ckallocMutexPtr);
@@ -550,16 +556,15 @@ Tcl_AttemptDbCkalloc(size, file, line)
*
* Tcl_DbCkfree - debugging ckfree
*
- * Verify that the low and high guards are intact, and if so
- * then free the buffer else Tcl_Panic.
+ * Verify that the low and high guards are intact, and if so then free
+ * the buffer else Tcl_Panic.
*
- * The guards are erased after being checked to catch duplicate
- * frees.
+ * The guards are erased after being checked to catch duplicate frees.
*
- * The second and third arguments are file and line, these contain
- * the filename and line number corresponding to the caller.
- * These are sent by the ckfree macro; it uses the preprocessor
- * autodefines __FILE__ and __LINE__.
+ * The second and third arguments are file and line, these contain the
+ * filename and line number corresponding to the caller. These are sent
+ * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and
+ * __LINE__.
*
*----------------------------------------------------------------------
*/
@@ -577,22 +582,22 @@ Tcl_DbCkfree(ptr, file, line)
}
/*
- * The following cast is *very* tricky. Must convert the pointer
- * to an integer before doing arithmetic on it, because otherwise
- * the arithmetic will be done differently (and incorrectly) on
- * word-addressed machines such as Crays (will subtract only bytes,
- * even though BODY_OFFSET is in words on these machines).
+ * The following cast is *very* tricky. Must convert the pointer to an
+ * integer before doing arithmetic on it, because otherwise the arithmetic
+ * will be done differently (and incorrectly) on word-addressed machines
+ * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
+ * words on these machines).
*/
memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
if (alloc_tracing) {
- fprintf(stderr, "ckfree %lx %ld %s %d\n",
+ fprintf(stderr, "ckfree %lx %ld %s %d\n",
(long unsigned int) memp->body, memp->length, file, line);
}
if (validate_memory) {
- Tcl_ValidateAllMemory(file, line);
+ Tcl_ValidateAllMemory(file, line);
}
Tcl_MutexLock(ckallocMutexPtr);
@@ -615,14 +620,15 @@ Tcl_DbCkfree(ptr, file, line)
/*
* Delink from allocated list
*/
+
if (memp->flink != NULL) {
- memp->flink->blink = memp->blink;
+ memp->flink->blink = memp->blink;
}
if (memp->blink != NULL) {
- memp->blink->flink = memp->flink;
+ memp->blink->flink = memp->flink;
}
if (allocHead == memp) {
- allocHead = memp->flink;
+ allocHead = memp->flink;
}
TclpFree((char *) memp);
Tcl_MutexUnlock(ckallocMutexPtr);
@@ -635,10 +641,10 @@ Tcl_DbCkfree(ptr, file, line)
*
* Tcl_DbCkrealloc - debugging ckrealloc
*
- * Reallocate a chunk of memory by allocating a new one of the
- * right size, copying the old data to the new location, and then
- * freeing the old memory space, using all the memory checking
- * features of this package.
+ * Reallocate a chunk of memory by allocating a new one of the right
+ * size, copying the old data to the new location, and then freeing the
+ * old memory space, using all the memory checking features of this
+ * package.
*
*--------------------------------------------------------------------
*/
@@ -659,8 +665,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
}
/*
- * See comment from Tcl_DbCkfree before you change the following
- * line.
+ * See comment from Tcl_DbCkfree before you change the following line.
*/
memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
@@ -691,8 +696,7 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
}
/*
- * See comment from Tcl_DbCkfree before you change the following
- * line.
+ * See comment from Tcl_DbCkfree before you change the following line.
*/
memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);
@@ -716,8 +720,8 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*
* Tcl_Alloc, et al. --
*
- * These functions are defined in terms of the debugging versions
- * when TCL_MEM_DEBUG is set.
+ * These functions are defined in terms of the debugging versions when
+ * TCL_MEM_DEBUG is set.
*
* Results:
* Same as the debug versions.
@@ -774,8 +778,9 @@ Tcl_AttemptRealloc(ptr, size)
*----------------------------------------------------------------------
*
* MemoryCmd --
- * Implements the Tcl "memory" command, which provides Tcl-level
- * control of Tcl memory debugging information.
+ *
+ * Implements the Tcl "memory" command, which provides Tcl-level control
+ * of Tcl memory debugging information.
* memory active $file
* memory break_on_malloc $count
* memory info
@@ -787,7 +792,7 @@ Tcl_AttemptRealloc(ptr, size)
* memory validate on|off
*
* Results:
- * Standard TCL results.
+ * Standard TCL results.
*
*----------------------------------------------------------------------
*/
@@ -810,7 +815,7 @@ MemoryCmd(clientData, interp, argc, argv)
}
if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
- if (argc != 3) {
+ if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ", argv[1], " file\"", (char *) NULL);
return TCL_ERROR;
@@ -822,41 +827,41 @@ MemoryCmd(clientData, interp, argc, argv)
result = Tcl_DumpActiveMemory (fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
+ Tcl_AppendResult(interp, "error accessing ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
if (strcmp(argv[1],"break_on_malloc") == 0) {
- if (argc != 3) {
- goto argError;
+ if (argc != 3) {
+ goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
return TCL_ERROR;
}
- return TCL_OK;
+ return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
char buf[400];
sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
- "total mallocs", total_mallocs, "total frees", total_frees,
- "current packets allocated", current_malloc_packets,
- "current bytes allocated", current_bytes_malloced,
- "maximum packets allocated", maximum_malloc_packets,
- "maximum bytes allocated", maximum_bytes_malloced);
+ "total mallocs", total_mallocs, "total frees", total_frees,
+ "current packets allocated", current_malloc_packets,
+ "current bytes allocated", current_bytes_malloced,
+ "maximum packets allocated", maximum_malloc_packets,
+ "maximum bytes allocated", maximum_bytes_malloced);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
- return TCL_OK;
+ return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
- if (argc != 3) {
- goto bad_suboption;
+ if (argc != 3) {
+ goto bad_suboption;
}
- init_malloced_bodies = (strcmp(argv[2],"on") == 0);
- return TCL_OK;
+ init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+ return TCL_OK;
}
if (strcmp(argv[1],"onexit") == 0) {
- if (argc != 3) {
+ if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " onexit file\"", (char *) NULL);
return TCL_ERROR;
@@ -885,28 +890,28 @@ MemoryCmd(clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"trace") == 0) {
- if (argc != 3) {
- goto bad_suboption;
+ if (argc != 3) {
+ goto bad_suboption;
}
- alloc_tracing = (strcmp(argv[2],"on") == 0);
- return TCL_OK;
+ alloc_tracing = (strcmp(argv[2],"on") == 0);
+ return TCL_OK;
}
if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
- if (argc != 3) {
- goto argError;
+ if (argc != 3) {
+ goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
}
if (strcmp(argv[1],"validate") == 0) {
- if (argc != 3) {
+ if (argc != 3) {
goto bad_suboption;
}
- validate_memory = (strcmp(argv[2],"on") == 0);
- return TCL_OK;
+ validate_memory = (strcmp(argv[2],"on") == 0);
+ return TCL_OK;
}
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -914,12 +919,12 @@ MemoryCmd(clientData, interp, argc, argv)
"tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
return TCL_ERROR;
-argError:
+ argError:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " count\"", (char *) NULL);
return TCL_ERROR;
-bad_suboption:
+ bad_suboption:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " on|off\"", (char *) NULL);
return TCL_ERROR;
@@ -930,10 +935,9 @@ bad_suboption:
*
* CheckmemCmd --
*
- * This is the command procedure for the "checkmem" command, which
- * causes the application to exit after printing information about
- * memory usage to the file passed to this command as its first
- * argument.
+ * This is the command procedure for the "checkmem" command, which causes
+ * the application to exit after printing information about memory usage
+ * to the file passed to this command as its first argument.
*
* Results:
* Returns a standard Tcl completion code.
@@ -966,8 +970,7 @@ CheckmemCmd(clientData, interp, argc, argv)
*
* Tcl_InitMemory --
*
- * Create the "memory" and "checkmem" commands in the given
- * interpreter.
+ * Create the "memory" and "checkmem" commands in the given interpreter.
*
* Results:
* None.
@@ -983,7 +986,7 @@ Tcl_InitMemory(interp)
Tcl_Interp *interp; /* Interpreter in which commands should be added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL,
+ Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
@@ -1003,8 +1006,9 @@ Tcl_InitMemory(interp)
*----------------------------------------------------------------------
*
* Tcl_Alloc --
- * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
- * that memory was actually allocated.
+ *
+ * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
+ * that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
@@ -1016,15 +1020,17 @@ Tcl_Alloc(size)
char *result;
result = TclpAlloc(size);
+
/*
- * Most systems will not alloc(0), instead bumping it to one so
- * that NULL isn't returned. Some systems (AIX, Tru64) will alloc(0)
- * by returning NULL, so we have to check that the NULL we get is
- * not in response to alloc(0).
+ * Most systems will not alloc(0), instead bumping it to one so that NULL
+ * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
+ * NULL, so we have to check that the NULL we get is not in response to
+ * alloc(0).
*
- * The ANSI spec actually says that systems either return NULL *or*
- * a special pointer on failure, but we only check for NULL
+ * The ANSI spec actually says that systems either return NULL *or* a
+ * special pointer on failure, but we only check for NULL
*/
+
if ((result == NULL) && size) {
Tcl_Panic("unable to alloc %u bytes", size);
}
@@ -1042,8 +1048,8 @@ Tcl_DbCkalloc(size, file, line)
result = (char *) TclpAlloc(size);
if ((result == NULL) && size) {
- fflush(stdout);
- Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
+ fflush(stdout);
+ Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
}
return result;
}
@@ -1052,8 +1058,9 @@ Tcl_DbCkalloc(size, file, line)
*----------------------------------------------------------------------
*
* Tcl_AttemptAlloc --
- * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
- * check that memory was actually allocated.
+ *
+ * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
+ * check that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
@@ -1079,14 +1086,14 @@ Tcl_AttemptDbCkalloc(size, file, line)
result = (char *) TclpAlloc(size);
return result;
}
-
/*
*----------------------------------------------------------------------
*
* Tcl_Realloc --
- * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
- * check that memory was actually allocated.
+ *
+ * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
+ * that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
@@ -1118,8 +1125,8 @@ Tcl_DbCkrealloc(ptr, size, file, line)
result = (char *) TclpRealloc(ptr, size);
if ((result == NULL) && size) {
- fflush(stdout);
- Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
+ fflush(stdout);
+ Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
}
return result;
}
@@ -1128,8 +1135,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)
*----------------------------------------------------------------------
*
* Tcl_AttemptRealloc --
- * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
- * not check that memory was actually allocated.
+ *
+ * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not
+ * check that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
@@ -1162,9 +1170,10 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*----------------------------------------------------------------------
*
* Tcl_Free --
- * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here
- * rather in the macro to keep some modules from being compiled with
- * TCL_MEM_DEBUG enabled and some with it disabled.
+ *
+ * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather
+ * in the macro to keep some modules from being compiled with
+ * TCL_MEM_DEBUG enabled and some with it disabled.
*
*----------------------------------------------------------------------
*/
@@ -1190,8 +1199,9 @@ Tcl_DbCkfree(ptr, file, line)
*----------------------------------------------------------------------
*
* Tcl_InitMemory --
- * Dummy initialization for memory command, which is only available
- * if TCL_MEM_DEBUG is on.
+ *
+ * Dummy initialization for memory command, which is only available if
+ * TCL_MEM_DEBUG is on.
*
*----------------------------------------------------------------------
*/
@@ -1217,7 +1227,7 @@ Tcl_ValidateAllMemory(file, line)
}
void
-TclDumpMemoryInfo(outFile)
+TclDumpMemoryInfo(outFile)
FILE *outFile;
{
}
@@ -1229,17 +1239,16 @@ TclDumpMemoryInfo(outFile)
*
* TclFinalizeMemorySubsystem --
*
- * This procedure is called to finalize all the structures that
- * are used by the memory allocator on a per-process basis.
+ * This procedure is called to finalize all the structures that are used
+ * by the memory allocator on a per-process basis.
*
* Results:
* None.
*
* Side effects:
- * This subsystem is self-initializing, since memory can be
- * allocated before Tcl is formally initialized. After this call,
- * this subsystem has been reset to its initial state and is
- * usable again.
+ * This subsystem is self-initializing, since memory can be allocated
+ * before Tcl is formally initialized. After this call, this subsystem
+ * has been reset to its initial state and is usable again.
*
*---------------------------------------------------------------------------
*/
@@ -1253,16 +1262,27 @@ TclFinalizeMemorySubsystem()
} else if (onExitMemDumpFileName != NULL) {
Tcl_DumpActiveMemory(onExitMemDumpFileName);
}
+
Tcl_MutexLock(ckallocMutexPtr);
+
if (curTagPtr != NULL) {
TclpFree((char *) curTagPtr);
curTagPtr = NULL;
}
allocHead = NULL;
+
Tcl_MutexUnlock(ckallocMutexPtr);
#endif
#if USE_TCLALLOC
- TclFinalizeAllocSubsystem();
+ TclFinalizeAllocSubsystem();
#endif
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 8a1a94c..366d0ab 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -1,14 +1,14 @@
-/*
+/*
* tclIOSock.c --
*
* Common routines used by all socket based channel types.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOSock.c,v 1.8 2004/04/06 22:25:53 dgp Exp $
+ * RCS: @(#) $Id: tclIOSock.c,v 1.9 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -18,14 +18,13 @@
*
* TclSockGetPort --
*
- * Maps from a string, which could be a service name, to a port.
- * Used by socket creation code to get port numbers and resolve
- * registered service names to port numbers.
+ * Maps from a string, which could be a service name, to a port. Used by
+ * socket creation code to get port numbers and resolve registered
+ * service names to port numbers.
*
* Results:
- * A standard Tcl result. On success, the port number is returned
- * in portPtr. On failure, an error message is left in the interp's
- * result.
+ * A standard Tcl result. On success, the port number is returned in
+ * portPtr. On failure, an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -48,7 +47,7 @@ TclSockGetPort(interp, string, proto, portPtr)
/*
* Don't bother translating 'proto' to native.
*/
-
+
native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
sp = getservbyname(native, proto); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -61,8 +60,8 @@ TclSockGetPort(interp, string, proto, portPtr)
return TCL_ERROR;
}
if (*portPtr > 0xFFFF) {
- Tcl_AppendResult(interp, "couldn't open socket: port number too high",
- (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open socket: port number too high",
+ (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -106,3 +105,11 @@ TclSockMinimumBuffers(sock, size)
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index e20d0e4..9b1c36f 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -1,44 +1,42 @@
-/*
+/*
* tclPanic.c --
*
- * Source code for the "Tcl_Panic" library procedure for Tcl;
- * individual applications will probably call Tcl_SetPanicProc()
- * to set an application-specific panic procedure.
+ * Source code for the "Tcl_Panic" library procedure for Tcl; individual
+ * applications will probably call Tcl_SetPanicProc() to set an
+ * application-specific panic procedure.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPanic.c,v 1.5 2004/04/06 22:25:54 dgp Exp $
+ * RCS: @(#) $Id: tclPanic.c,v 1.6 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
/*
- * The panicProc variable contains a pointer to an application
- * specific panic procedure.
+ * The panicProc variable contains a pointer to an application specific panic
+ * procedure.
*/
static Tcl_PanicProc *panicProc = NULL;
/*
- * The platformPanicProc variable contains a pointer to a platform
- * specific panic procedure, if any. ( TclpPanic may be NULL via
- * a macro. )
+ * The platformPanicProc variable contains a pointer to a platform specific
+ * panic procedure, if any. (TclpPanic may be NULL via a macro.)
*/
-static Tcl_PanicProc * CONST platformPanicProc = TclpPanic;
-
+static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
/*
*----------------------------------------------------------------------
*
* Tcl_SetPanicProc --
*
- * Replace the default panic behavior with the specified functiion.
+ * Replace the default panic behavior with the specified function.
*
* Results:
* None.
@@ -73,7 +71,7 @@ Tcl_SetPanicProc(proc)
*/
void
-Tcl_PanicVA (format, argList)
+Tcl_PanicVA(format, argList)
CONST char *format; /* Format string, suitable for passing to
* fprintf. */
va_list argList; /* Variable argument list. */
@@ -90,7 +88,7 @@ Tcl_PanicVA (format, argList)
arg6 = va_arg(argList, char *);
arg7 = va_arg(argList, char *);
arg8 = va_arg(argList, char *);
-
+
if (panicProc != NULL) {
(void) (*panicProc)(format, arg1, arg2, arg3, arg4,
arg5, arg6, arg7, arg8);
@@ -133,3 +131,11 @@ Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
Tcl_PanicVA(format, argList);
va_end (argList);
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index a58feb4..397acd9 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1,48 +1,48 @@
-/*
+/*
* tclPkg.c --
*
- * This file implements package and version control for Tcl via
- * the "package" command and a few C APIs.
+ * This file implements package and version control for Tcl via the
+ * "package" command and a few C APIs.
*
* Copyright (c) 1996 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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.11 2004/10/06 15:59:25 dgp Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.12 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
/*
- * Each invocation of the "package ifneeded" command creates a structure
- * of the following type, which is used to load the package into the
- * interpreter if it is requested with a "package require" command.
+ * Each invocation of the "package ifneeded" command creates a structure of
+ * the following type, which is used to load the package into the interpreter
+ * if it is requested with a "package require" command.
*/
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 Tcl_Preserve and Tcl_Release. */
- struct PkgAvail *nextPtr; /* Next in list of available versions of
- * the same package. */
+ char *script; /* Script to invoke to provide this version of
+ * 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. */
} 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 "packageTable" hash table in the interpreter, keyed by
- * package name such as "Tk" (no version number).
+ * 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
+ * "packageTable" hash table in the interpreter, keyed by package name such as
+ * "Tk" (no version number).
*/
typedef struct Package {
char *version; /* Version that has been supplied in this
* interpreter via "package provide"
- * (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. */
+ * (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. */
ClientData clientData; /* Client data. */
} Package;
@@ -52,9 +52,8 @@ typedef struct Package {
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 int ComparePkgVersions _ANSI_ARGS_((CONST char *v1,
+ CONST char *v2, int *satPtr));
static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *name));
@@ -63,20 +62,18 @@ static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp,
*
* Tcl_PkgProvide / Tcl_PkgProvideEx --
*
- * This procedure 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.
+ * This procedure 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.
*
* Results:
- * Normally returns TCL_OK; if there is already another version
- * of the package loaded then TCL_ERROR is returned and an error
- * message is left in the interp's result.
+ * Normally returns TCL_OK; if there is already another version of the
+ * package loaded then TCL_ERROR is returned and an error message is left
+ * in the interp's result.
*
* Side effects:
- * The interpreter remembers that this package is available,
- * so that no other version of the package may be provided for
- * the interpreter.
+ * The interpreter remembers that this package is available, so that no
+ * other version of the package may be provided for the interpreter.
*
*----------------------------------------------------------------------
*/
@@ -97,8 +94,8 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
* available. */
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) */
+ ClientData clientData; /* clientdata for this package (normally used
+ * for C callback function table) */
{
Package *pkgPtr;
@@ -125,26 +122,24 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
*
* Tcl_PkgRequire / Tcl_PkgRequireEx --
*
- * This procedure 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 caller's needs don't conflict with
- * the version that is present.
+ * This procedure 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
+ * caller's needs don't conflict with the version that is present.
*
* Results:
- * If successful, returns the version string for the currently
- * provided version of the package, which may be different from
- * the "version" argument. If the caller's requirements
- * cannot be met (e.g. the version requested conflicts with
- * a currently provided version, or the required version cannot
- * be found, or the script to provide the required version
- * generates an error), NULL is returned and an error
- * message is left in the interp's result.
+ * If successful, returns the version string for the currently provided
+ * version of the package, which may be different from the "version"
+ * argument. If the caller's requirements cannot be met (e.g. the version
+ * requested conflicts with a currently provided version, or the required
+ * version cannot be found, or the script to provide the required version
+ * generates an error), NULL is returned and an error message is left in
+ * the interp's result.
*
* Side effects:
- * The script from some previous "package ifneeded" command may
- * be invoked to provide the package.
+ * The script from some previous "package ifneeded" command may be
+ * invoked to provide the package.
*
*----------------------------------------------------------------------
*/
@@ -154,12 +149,11 @@ Tcl_PkgRequire(interp, name, version, exact)
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 means use the latest version
- * available. */
+ CONST char *version; /* Version string for desired version; NULL
+ * means use the latest version available. */
int exact; /* Non-zero means that only the particular
- * version given is acceptable. Zero means
- * use the latest compatible version. */
+ * version given is acceptable. Zero means use
+ * the latest compatible version. */
{
return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) NULL);
}
@@ -169,16 +163,15 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
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 means use the latest version
- * available. */
+ CONST char *version; /* Version string for desired version; NULL
+ * means use the latest version available. */
int exact; /* Non-zero means that only the particular
- * version given is acceptable. Zero means
- * use the latest compatible version. */
+ * version given is acceptable. Zero means use
+ * the latest compatible version. */
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. */
+ * package. If it is NULL then the client data
+ * is not returned. This is unchanged if this
+ * call fails for any reason. */
{
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr;
@@ -188,85 +181,81 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
/*
* If an attempt is being made to load this into a standalone executable
- * on a platform where backlinking is not supported then this must be
- * a shared version of Tcl (Otherwise the load would have failed).
- * Detect this situation by checking that this library has been correctly
+ * on a platform where backlinking is not supported then this must be a
+ * shared version of Tcl (Otherwise the load would have failed). Detect
+ * this situation by checking that this library has been correctly
* initialised. If it has not been then return immediately as nothing will
* work.
*/
-
+
if (tclEmptyStringRep == NULL) {
/*
* OK, so what's going on here?
*
- * First, what are we doing? We are performing a check on behalf of
- * one particular caller, Tcl_InitStubs(). When a package is
- * stub-enabled, it is statically linked to libtclstub.a, which
- * contains a copy of Tcl_InitStubs(). When a stub-enabled package
- * is loaded, its *_Init() function is supposed to call
- * Tcl_InitStubs() before calling any other functions in the Tcl
- * library. The first Tcl function called by Tcl_InitStubs() through
- * the stub table is Tcl_PkgRequireEx(), so this code right here is
- * the first code that is part of the original Tcl library in the
- * executable that gets executed on behalf of a newly loaded
- * stub-enabled package.
+ * First, what are we doing? We are performing a check on behalf of
+ * one particular caller, Tcl_InitStubs(). When a package is stub-
+ * enabled, it is statically linked to libtclstub.a, which contains a
+ * copy of Tcl_InitStubs(). When a stub-enabled package is loaded, its
+ * *_Init() function is supposed to call Tcl_InitStubs() before
+ * calling any other functions in the Tcl library. The first Tcl
+ * function called by Tcl_InitStubs() through the stub table is
+ * Tcl_PkgRequireEx(), so this code right here is the first code that
+ * is part of the original Tcl library in the executable that gets
+ * executed on behalf of a newly loaded stub-enabled package.
*
* One easy error for the developer/builder of a stub-enabled package
* to make is to forget to define USE_TCL_STUBS when compiling the
- * package. When that happens, the package will contain symbols
- * that are references to the Tcl library, rather than function
- * pointers referencing the stub table. On platforms that lack
- * backlinking, those unresolved references may cause the loading
- * of the package to also load a second copy of the Tcl library,
- * leading to all kinds of trouble. We would like to catch that
- * error and report a useful message back to the user. That's
- * what we're doing.
+ * package. When that happens, the package will contain symbols that
+ * are references to the Tcl library, rather than function pointers
+ * referencing the stub table. On platforms that lack backlinking,
+ * those unresolved references may cause the loading of the package to
+ * also load a second copy of the Tcl library, leading to all kinds of
+ * trouble. We would like to catch that error and report a useful
+ * message back to the user. That's what we're doing.
*
- * Second, how does this work? If we reach this point, then the
- * global variable tclEmptyStringRep has the value NULL. Compare
- * that with the definition of tclEmptyStringRep near the top of
- * the file generic/tclObj.c. It clearly should not have the value
- * NULL; it should point to the char tclEmptyString. If we see it
- * having the value NULL, then somehow we are seeing a Tcl library
- * that isn't completely initialized, and that's an indicator for the
- * error condition described above. (Further explanation is welcome.)
+ * Second, how does this work? If we reach this point, then the global
+ * variable tclEmptyStringRep has the value NULL. Compare that with
+ * the definition of tclEmptyStringRep near the top of the file
+ * generic/tclObj.c. It clearly should not have the value NULL; it
+ * should point to the char tclEmptyString. If we see it having the
+ * value NULL, then somehow we are seeing a Tcl library that isn't
+ * completely initialized, and that's an indicator for the error
+ * condition described above. (Further explanation is welcome.)
*
- * Third, so what do we do about it? This situation indicates
- * the package we just loaded wasn't properly compiled to be
- * stub-enabled, yet it thinks it is stub-enabled (it called
- * Tcl_InitStubs()). We want to report that the package just
- * loaded is broken, so we want to place an error message in
- * the interpreter result and return NULL to indicate failure
- * to Tcl_InitStubs() so that it will also fail. (Further
- * explanation why we don't want to Tcl_Panic() is welcome.
+ * Third, so what do we do about it? This situation indicates the
+ * package we just loaded wasn't properly compiled to be stub-enabled,
+ * yet it thinks it is stub-enabled (it called Tcl_InitStubs()). We
+ * want to report that the package just loaded is broken, so we want
+ * to place an error message in the interpreter result and return NULL
+ * to indicate failure to Tcl_InitStubs() so that it will also fail.
+ * (Further explanation why we don't want to Tcl_Panic() is welcome.
* After all, two Tcl libraries can't be a good thing!)
*
- * Trouble is that's going to be tricky. We're now using a Tcl
- * library that's not fully initialized. In particular, it
- * doesn't have a proper value for tclEmptyStringRep. The
- * Tcl_Obj system heavily depends on the value of tclEmptyStringRep
- * and all of Tcl depends (increasingly) on the Tcl_Obj system, we
- * need to correct that flaw before making the calls to set the
- * interpreter result to the error message. That's the only flaw
- * corrected; other problems with initialization of the Tcl library
- * are not remedied, so be very careful about adding any other calls
- * here without checking how they behave when initialization is
- * incomplete.
+ * Trouble is that's going to be tricky. We're now using a Tcl library
+ * that's not fully initialized. In particular, it doesn't have a
+ * proper value for tclEmptyStringRep. The Tcl_Obj system heavily
+ * depends on the value of tclEmptyStringRep and all of Tcl depends
+ * (increasingly) on the Tcl_Obj system, we need to correct that flaw
+ * before making the calls to set the interpreter result to the error
+ * message. That's the only flaw corrected; other problems with
+ * initialization of the Tcl library are not remedied, so be very
+ * careful about adding any other calls here without checking how they
+ * behave when initialization is incomplete.
*/
tclEmptyStringRep = &tclEmptyString;
- Tcl_AppendResult(interp, "Cannot load package \"", name,
- "\" in standalone executable: This package is not ",
- "compiled with stub support", NULL);
- return NULL;
+ Tcl_AppendResult(interp, "Cannot load package \"", name,
+ "\" in standalone executable: This package is not ",
+ "compiled with stub support", NULL);
+ return NULL;
}
/*
- * It can take up to three passes to find the package: one pass to
- * run the "package unknown" script, one to run the "package ifneeded"
- * script for a specific version, and a final pass to lookup the
- * package loaded by the "package ifneeded" script.
+ * It can take up to three passes to find the package: one pass to run the
+ * "package unknown" script, one to run the "package ifneeded" script for
+ * a specific version, and a final pass to lookup the package loaded by
+ * the "package ifneeded" script.
*/
for (pass = 1; ; pass++) {
@@ -279,7 +268,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
* The package isn't yet present. Search the list of available
* versions and invoke the script for the best available version.
*/
-
+
bestPtr = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
@@ -302,11 +291,11 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
if (bestPtr != NULL) {
/*
* We found an ifneeded script for the package. Be careful while
- * executing it: this could cause reentrancy, so (a) protect the
+ * 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.
*/
-
+
script = bestPtr->script;
Tcl_Preserve((ClientData) script);
code = Tcl_GlobalEval(interp, script);
@@ -325,8 +314,8 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
/*
* 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).
+ * command, invoke it (but only on the first pass; after that, we
+ * should not get here in the first place).
*/
if (pass > 1) {
@@ -371,7 +360,7 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
*/
if (version == NULL) {
- if (clientDataPtr) {
+ if (clientDataPtr) {
*clientDataPtr = pkgPtr->clientData;
}
return pkgPtr->version;
@@ -391,19 +380,18 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
/*
*----------------------------------------------------------------------
- *
+ *q
* Tcl_PkgPresent / Tcl_PkgPresentEx --
*
- * Checks to see whether the specified package is present. If it
- * is not then no additional action is taken.
+ * Checks to see whether the specified package is present. If it is not
+ * then no additional action is taken.
*
* Results:
- * If successful, returns the version string for the currently
- * provided version of the package, which may be different from
- * the "version" argument. If the caller's requirements
- * cannot be met (e.g. the version requested conflicts with
- * a currently provided version), NULL is returned and an error
- * message is left in interp->result.
+ * If successful, returns the version string for the currently provided
+ * version of the package, which may be different from the "version"
+ * argument. If the caller's requirements cannot be met (e.g. the version
+ * requested conflicts with a currently provided version), NULL is
+ * returned and an error message is left in interp->result.
*
* Side effects:
* None.
@@ -416,12 +404,11 @@ Tcl_PkgPresent(interp, name, version, exact)
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 means use the latest version
- * available. */
+ CONST char *version; /* Version string for desired version; NULL
+ * means use the latest version available. */
int exact; /* Non-zero means that only the particular
- * version given is acceptable. Zero means
- * use the latest compatible version. */
+ * version given is acceptable. Zero means use
+ * the latest compatible version. */
{
return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
}
@@ -431,16 +418,15 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
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 means use the latest version
- * available. */
+ CONST char *version; /* Version string for desired version; NULL
+ * means use the latest version available. */
int exact; /* Non-zero means that only the particular
- * version given is acceptable. Zero means
- * use the latest compatible version. */
+ * version given is acceptable. Zero means use
+ * the latest compatible version. */
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. */
+ * package. If it is NULL then the client data
+ * is not returned. This is unchanged if this
+ * call fails for any reason. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
@@ -451,9 +437,8 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
if (hPtr) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
-
/*
- * At this point we know that the package is present. Make sure
+ * At this point we know that the package is present. Make sure
* that the provided version meets the current requirement.
*/
@@ -461,7 +446,7 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
if (clientDataPtr) {
*clientDataPtr = pkgPtr->clientData;
}
-
+
return pkgPtr->version;
}
result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
@@ -469,22 +454,22 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
if (clientDataPtr) {
*clientDataPtr = pkgPtr->clientData;
}
-
+
return pkgPtr->version;
}
- Tcl_AppendResult(interp, "version conflict for package \"",
- name, "\": have ", pkgPtr->version,
- ", need ", version, (char *) NULL);
+ Tcl_AppendResult(interp, "version conflict for package \"", name,
+ "\": have ", pkgPtr->version, ", need ", version,
+ (char *) NULL);
return NULL;
}
}
if (version != NULL) {
Tcl_AppendResult(interp, "package ", name, " ", version,
- " is not present", (char *) NULL);
+ " is not present", (char *) NULL);
} else {
Tcl_AppendResult(interp, "package ", name, " is not present",
- (char *) NULL);
+ (char *) NULL);
}
return NULL;
}
@@ -494,8 +479,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 procedure is invoked to process the "package" Tcl command. See
+ * the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -509,9 +494,9 @@ 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. */
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
static CONST char *pkgOptions[] = {
@@ -534,7 +519,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
char *argv2, *argv3, *argv4;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
@@ -543,259 +528,252 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
switch ((enum pkgOptions) optionIndex) {
- case PKG_FORGET: {
- char *keyString;
- for (i = 2; i < objc; i++) {
- keyString = Tcl_GetString(objv[i]);
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
- if (hPtr == NULL) {
- continue;
- }
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- Tcl_DeleteHashEntry(hPtr);
- if (pkgPtr->version != NULL) {
- ckfree(pkgPtr->version);
- }
- while (pkgPtr->availPtr != NULL) {
- availPtr = pkgPtr->availPtr;
- pkgPtr->availPtr = availPtr->nextPtr;
- ckfree(availPtr->version);
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- ckfree((char *) availPtr);
- }
- ckfree((char *) pkgPtr);
- }
- break;
- }
- case PKG_IFNEEDED: {
- int length;
- if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
- return TCL_ERROR;
- }
- argv3 = Tcl_GetString(objv[3]);
- if (CheckVersion(interp, argv3) != TCL_OK) {
- return TCL_ERROR;
- }
- argv2 = Tcl_GetString(objv[2]);
- if (objc == 4) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr == NULL) {
- return TCL_OK;
- }
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- } else {
- pkgPtr = FindPackage(interp, argv2);
- }
- 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 (objc == 4) {
- Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
- return TCL_OK;
- }
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- break;
- }
+ case PKG_FORGET: {
+ char *keyString;
+
+ for (i = 2; i < objc; i++) {
+ keyString = Tcl_GetString(objv[i]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
+ if (hPtr == NULL) {
+ continue;
}
- if (objc == 4) {
- return TCL_OK;
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ if (pkgPtr->version != NULL) {
+ ckfree(pkgPtr->version);
}
- if (availPtr == NULL) {
- availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
- availPtr->version = ckalloc((unsigned) (length + 1));
- strcpy(availPtr->version, argv3);
- if (prevPtr == NULL) {
- availPtr->nextPtr = pkgPtr->availPtr;
- pkgPtr->availPtr = availPtr;
- } else {
- availPtr->nextPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = availPtr;
- }
+ while (pkgPtr->availPtr != NULL) {
+ availPtr = pkgPtr->availPtr;
+ pkgPtr->availPtr = availPtr->nextPtr;
+ ckfree(availPtr->version);
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ ckfree((char *) availPtr);
}
- argv4 = Tcl_GetStringFromObj(objv[4], &length);
- availPtr->script = ckalloc((unsigned) (length + 1));
- strcpy(availPtr->script, argv4);
- break;
+ ckfree((char *) pkgPtr);
}
- case PKG_NAMES: {
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
- tablePtr = &iPtr->packageTable;
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
- }
- }
- break;
+ break;
+ }
+ case PKG_IFNEEDED: {
+ int length;
+
+ if ((objc != 4) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
+ return TCL_ERROR;
}
- case PKG_PRESENT: {
- if (objc < 3) {
- presentSyntax:
- Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
- return TCL_ERROR;
- }
- argv2 = Tcl_GetString(objv[2]);
- if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
- exact = 1;
- } else {
- exact = 0;
- }
- version = NULL;
- if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
- if (CheckVersion(interp, version) != TCL_OK) {
- return TCL_ERROR;
- }
- } else if ((objc != 3) || exact) {
- goto presentSyntax;
- }
- if (exact) {
- argv3 = Tcl_GetString(objv[3]);
- version = Tcl_PkgPresent(interp, argv3, version, exact);
- } else {
- version = Tcl_PkgPresent(interp, argv2, version, exact);
- }
- if (version == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
- break;
+ argv3 = Tcl_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
}
- case PKG_PROVIDE: {
- if ((objc != 3) && (objc != 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
- return TCL_ERROR;
- }
- argv2 = Tcl_GetString(objv[2]);
- if (objc == 3) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr != NULL) {
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- if (pkgPtr->version != NULL) {
- Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
- }
- }
+ argv2 = Tcl_GetString(objv[2]);
+ if (objc == 4) {
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr == NULL) {
return TCL_OK;
}
- argv3 = Tcl_GetString(objv[3]);
- if (CheckVersion(interp, argv3) != TCL_OK) {
- return TCL_ERROR;
- }
- return Tcl_PkgProvide(interp, argv2, argv3);
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ } else {
+ pkgPtr = FindPackage(interp, argv2);
}
- case PKG_REQUIRE: {
- if (objc < 3) {
- requireSyntax:
- Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
- return TCL_ERROR;
- }
- argv2 = Tcl_GetString(objv[2]);
- if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
- exact = 1;
- } else {
- exact = 0;
- }
- version = NULL;
- if (objc == (4 + exact)) {
- version = Tcl_GetString(objv[3 + exact]);
- if (CheckVersion(interp, version) != TCL_OK) {
- return TCL_ERROR;
+ 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 (objc == 4) {
+ Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+ return TCL_OK;
}
- } else if ((objc != 3) || exact) {
- goto requireSyntax;
+ Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+ break;
}
- if (exact) {
- argv3 = Tcl_GetString(objv[3]);
- version = Tcl_PkgRequire(interp, argv3, version, exact);
- } else {
- version = Tcl_PkgRequire(interp, argv2, version, exact);
- }
- if (version == NULL) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
- break;
}
- case PKG_UNKNOWN: {
- int length;
- if (objc == 2) {
- if (iPtr->packageUnknown != NULL) {
- Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
- }
- } else if (objc == 3) {
- if (iPtr->packageUnknown != NULL) {
- ckfree(iPtr->packageUnknown);
- }
- argv2 = Tcl_GetStringFromObj(objv[2], &length);
- if (argv2[0] == 0) {
- iPtr->packageUnknown = NULL;
- } else {
- iPtr->packageUnknown = (char *) ckalloc((unsigned)
- (length + 1));
- strcpy(iPtr->packageUnknown, argv2);
- }
+ if (objc == 4) {
+ return TCL_OK;
+ }
+ if (availPtr == NULL) {
+ availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
+ availPtr->version = ckalloc((unsigned) (length + 1));
+ strcpy(availPtr->version, argv3);
+ if (prevPtr == NULL) {
+ availPtr->nextPtr = pkgPtr->availPtr;
+ pkgPtr->availPtr = availPtr;
} else {
- Tcl_WrongNumArgs(interp, 2, objv, "?command?");
- return TCL_ERROR;
+ availPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = availPtr;
}
- break;
}
- case PKG_VCOMPARE: {
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
- return TCL_ERROR;
- }
- argv3 = Tcl_GetString(objv[3]);
- argv2 = Tcl_GetString(objv[2]);
- if ((CheckVersion(interp, argv2) != TCL_OK)
- || (CheckVersion(interp, argv3) != TCL_OK)) {
- return TCL_ERROR;
+ argv4 = Tcl_GetStringFromObj(objv[4], &length);
+ availPtr->script = ckalloc((unsigned) (length + 1));
+ strcpy(availPtr->script, argv4);
+ break;
+ }
+ case PKG_NAMES:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ tablePtr = &iPtr->packageTable;
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
- ComparePkgVersions(argv2, argv3, (int *) NULL)));
- break;
}
- case PKG_VERSIONS: {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "package");
+ break;
+ case PKG_PRESENT:
+ if (objc < 3) {
+ presentSyntax:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ exact = 1;
+ } else {
+ exact = 0;
+ }
+ version = NULL;
+ if (objc == (4 + exact)) {
+ version = Tcl_GetString(objv[3 + exact]);
+ if (CheckVersion(interp, version) != TCL_OK) {
return TCL_ERROR;
}
- argv2 = Tcl_GetString(objv[2]);
+ } else if ((objc != 3) || exact) {
+ goto presentSyntax;
+ }
+ if (exact) {
+ argv3 = Tcl_GetString(objv[3]);
+ version = Tcl_PkgPresent(interp, argv3, version, exact);
+ } else {
+ version = Tcl_PkgPresent(interp, argv2, version, exact);
+ }
+ if (version == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
+ break;
+ case PKG_PROVIDE:
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if (objc == 3) {
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
if (hPtr != NULL) {
pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- for (availPtr = pkgPtr->availPtr; availPtr != NULL;
- availPtr = availPtr->nextPtr) {
- Tcl_AppendElement(interp, availPtr->version);
+ if (pkgPtr->version != NULL) {
+ Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
}
}
- break;
+ return TCL_OK;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_PkgProvide(interp, argv2, argv3);
+ case PKG_REQUIRE:
+ if (objc < 3) {
+ requireSyntax:
+ Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
+ return TCL_ERROR;
+ }
+ argv2 = Tcl_GetString(objv[2]);
+ if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ exact = 1;
+ } else {
+ exact = 0;
}
- case PKG_VSATISFIES: {
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
+ version = NULL;
+ if (objc == (4 + exact)) {
+ version = Tcl_GetString(objv[3 + exact]);
+ if (CheckVersion(interp, version) != TCL_OK) {
return TCL_ERROR;
}
- argv3 = Tcl_GetString(objv[3]);
- argv2 = Tcl_GetString(objv[2]);
- if ((CheckVersion(interp, argv2) != TCL_OK)
- || (CheckVersion(interp, argv3) != TCL_OK)) {
- return TCL_ERROR;
+ } else if ((objc != 3) || exact) {
+ goto requireSyntax;
+ }
+ if (exact) {
+ argv3 = Tcl_GetString(objv[3]);
+ version = Tcl_PkgRequire(interp, argv3, version, exact);
+ } else {
+ version = Tcl_PkgRequire(interp, argv2, version, exact);
+ }
+ if (version == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(version, -1));
+ break;
+ case PKG_UNKNOWN: {
+ int length;
+
+ if (objc == 2) {
+ if (iPtr->packageUnknown != NULL) {
+ Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+ }
+ } else if (objc == 3) {
+ if (iPtr->packageUnknown != NULL) {
+ ckfree(iPtr->packageUnknown);
+ }
+ argv2 = Tcl_GetStringFromObj(objv[2], &length);
+ if (argv2[0] == 0) {
+ iPtr->packageUnknown = NULL;
+ } else {
+ iPtr->packageUnknown = (char *) ckalloc((unsigned) (length+1));
+ strcpy(iPtr->packageUnknown, argv2);
}
- ComparePkgVersions(argv2, argv3, &satisfies);
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
- break;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?command?");
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case PKG_VCOMPARE:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
+ return TCL_ERROR;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ argv2 = Tcl_GetString(objv[2]);
+ if ((CheckVersion(interp, argv2) != TCL_OK)
+ || (CheckVersion(interp, argv3) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ ComparePkgVersions(argv2, argv3, (int *) NULL)));
+ break;
+ case PKG_VERSIONS:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package");
+ return TCL_ERROR;
}
- default: {
- Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
+ argv2 = Tcl_GetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr != NULL) {
+ pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+ for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+ availPtr = availPtr->nextPtr) {
+ Tcl_AppendElement(interp, availPtr->version);
+ }
+ }
+ break;
+ case PKG_VSATISFIES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
+ return TCL_ERROR;
}
+ argv3 = Tcl_GetString(objv[3]);
+ argv2 = Tcl_GetString(objv[2]);
+ if ((CheckVersion(interp, argv2) != TCL_OK)
+ || (CheckVersion(interp, argv3) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ ComparePkgVersions(argv2, argv3, &satisfies);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
+ break;
+ default:
+ Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
}
return TCL_OK;
}
@@ -805,13 +783,12 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
*
* FindPackage --
*
- * This procedure finds the Package record for a particular package
- * in a particular interpreter, creating a record if one doesn't
- * already exist.
+ * This procedure finds the Package record for a particular package in a
+ * particular interpreter, creating a record if one doesn't already
+ * exist.
*
* Results:
- * The return value is a pointer to the Package record for the
- * package.
+ * The return value is a pointer to the Package record for the package.
*
* Side effects:
* A new Package record may be created.
@@ -847,9 +824,8 @@ FindPackage(interp, name)
*
* TclFreePackageInfo --
*
- * This procedure is called during interpreter deletion to
- * free all of the package-related information for the
- * interpreter.
+ * This procedure is called during interpreter deletion to free all of
+ * the package-related information for the interpreter.
*
* Results:
* None.
@@ -895,13 +871,13 @@ TclFreePackageInfo(iPtr)
*
* CheckVersion --
*
- * This procedure checks to see whether a version number has
- * valid syntax.
+ * This procedure checks to see whether a version number has valid
+ * syntax.
*
* Results:
- * If string is a properly formed version number the TCL_OK
- * is returned. Otherwise TCL_ERROR is returned and an error
- * message is left in the interp's result.
+ * If string is a properly formed version number the TCL_OK is returned.
+ * Otherwise TCL_ERROR is returned and an error message is left in the
+ * interp's result.
*
* Side effects:
* None.
@@ -913,12 +889,12 @@ static int
CheckVersion(interp, string)
Tcl_Interp *interp; /* Used for error reporting. */
CONST char *string; /* Supposedly a version number, which is
- * groups of decimal digits separated
- * by dots. */
+ * groups of decimal digits separated by
+ * dots. */
{
CONST char *p = string;
char prevChar;
-
+
if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
@@ -933,9 +909,9 @@ CheckVersion(interp, string)
return TCL_OK;
}
- error:
- Tcl_AppendResult(interp, "expected version number but got \"",
- string, "\"", (char *) NULL);
+ error:
+ Tcl_AppendResult(interp, "expected version number but got \"", string,
+ "\"", (char *) NULL);
return TCL_ERROR;
}
@@ -947,11 +923,10 @@ CheckVersion(interp, string)
* This procedure 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 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.
+ * 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
+ * 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.
*
* Side effects:
* None.
@@ -962,21 +937,20 @@ CheckVersion(interp, string)
static int
ComparePkgVersions(v1, v2, satPtr)
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 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 number. */
+ 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
+ * 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
+ * number. */
{
int thisIsMajor, n1, n2;
/*
- * Each iteration of the following loop processes one number from
- * each string, terminated by a ".". If those numbers don't match
- * then the comparison is over; otherwise, we loop back for the
- * next number.
+ * Each iteration of the following loop processes one number from each
+ * string, terminated by a ".". If those numbers don't match then the
+ * comparison is over; otherwise, we loop back for the next number.
*/
thisIsMajor = 1;
@@ -996,8 +970,8 @@ ComparePkgVersions(v1, v2, satPtr)
}
/*
- * Compare and go on to the next version number if the
- * current numbers match.
+ * Compare and go on to the next version number if the current numbers
+ * match.
*/
if (n1 != n2) {
@@ -1024,3 +998,11 @@ ComparePkgVersions(v1, v2, satPtr)
return -1;
}
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index a3aedf5..7cb2bdb 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -1,9 +1,8 @@
/*
* tclPosixStr.c --
*
- * This file contains procedures that generate strings
- * corresponding to various POSIX-related codes, such
- * as errno and signals.
+ * This file contains procedures that generate strings corresponding to
+ * various POSIX-related codes, such as errno and signals.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -11,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: tclPosixStr.c,v 1.10 2004/04/06 22:25:54 dgp Exp $
+ * RCS: @(#) $Id: tclPosixStr.c,v 1.11 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -24,9 +23,9 @@
* Return a textual identifier for the current errno value.
*
* Results:
- * This procedure returns a machine-readable textual identifier
- * that corresponds to the current errno value (e.g. "EPERM").
- * The identifier is the same as the #define name in errno.h.
+ * This procedure returns a machine-readable textual identifier that
+ * corresponds to the current errno value (e.g. "EPERM"). The identifier
+ * is the same as the #define name in errno.h.
*
* Side effects:
* None.
@@ -39,421 +38,421 @@ Tcl_ErrnoId()
{
switch (errno) {
#ifdef E2BIG
- case E2BIG: return "E2BIG";
+ case E2BIG: return "E2BIG";
#endif
#ifdef EACCES
- case EACCES: return "EACCES";
+ case EACCES: return "EACCES";
#endif
#ifdef EADDRINUSE
- case EADDRINUSE: return "EADDRINUSE";
+ case EADDRINUSE: return "EADDRINUSE";
#endif
#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
+ case EADDRNOTAVAIL: return "EADDRNOTAVAIL";
#endif
#ifdef EADV
- case EADV: return "EADV";
+ case EADV: return "EADV";
#endif
#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT: return "EAFNOSUPPORT";
+ case EAFNOSUPPORT: return "EAFNOSUPPORT";
#endif
#ifdef EAGAIN
- case EAGAIN: return "EAGAIN";
+ case EAGAIN: return "EAGAIN";
#endif
#ifdef EALIGN
- case EALIGN: return "EALIGN";
+ case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
- case EALREADY: return "EALREADY";
+ case EALREADY: return "EALREADY";
#endif
#ifdef EBADE
- case EBADE: return "EBADE";
+ case EBADE: return "EBADE";
#endif
#ifdef EBADF
- case EBADF: return "EBADF";
+ case EBADF: return "EBADF";
#endif
#ifdef EBADFD
- case EBADFD: return "EBADFD";
+ case EBADFD: return "EBADFD";
#endif
#ifdef EBADMSG
- case EBADMSG: return "EBADMSG";
+ case EBADMSG: return "EBADMSG";
#endif
#ifdef EBADR
- case EBADR: return "EBADR";
+ case EBADR: return "EBADR";
#endif
#ifdef EBADRPC
- case EBADRPC: return "EBADRPC";
+ case EBADRPC: return "EBADRPC";
#endif
#ifdef EBADRQC
- case EBADRQC: return "EBADRQC";
+ case EBADRQC: return "EBADRQC";
#endif
#ifdef EBADSLT
- case EBADSLT: return "EBADSLT";
+ case EBADSLT: return "EBADSLT";
#endif
#ifdef EBFONT
- case EBFONT: return "EBFONT";
+ case EBFONT: return "EBFONT";
#endif
#ifdef EBUSY
- case EBUSY: return "EBUSY";
+ case EBUSY: return "EBUSY";
#endif
#ifdef ECHILD
- case ECHILD: return "ECHILD";
+ case ECHILD: return "ECHILD";
#endif
#ifdef ECHRNG
- case ECHRNG: return "ECHRNG";
+ case ECHRNG: return "ECHRNG";
#endif
#ifdef ECOMM
- case ECOMM: return "ECOMM";
+ case ECOMM: return "ECOMM";
#endif
#ifdef ECONNABORTED
- case ECONNABORTED: return "ECONNABORTED";
+ case ECONNABORTED: return "ECONNABORTED";
#endif
#ifdef ECONNREFUSED
- case ECONNREFUSED: return "ECONNREFUSED";
+ case ECONNREFUSED: return "ECONNREFUSED";
#endif
#ifdef ECONNRESET
- case ECONNRESET: return "ECONNRESET";
+ case ECONNRESET: return "ECONNRESET";
#endif
#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
- case EDEADLK: return "EDEADLK";
+ case EDEADLK: return "EDEADLK";
#endif
#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
- case EDEADLOCK: return "EDEADLOCK";
+ case EDEADLOCK: return "EDEADLOCK";
#endif
#ifdef EDESTADDRREQ
- case EDESTADDRREQ: return "EDESTADDRREQ";
+ case EDESTADDRREQ: return "EDESTADDRREQ";
#endif
#ifdef EDIRTY
- case EDIRTY: return "EDIRTY";
+ case EDIRTY: return "EDIRTY";
#endif
#ifdef EDOM
- case EDOM: return "EDOM";
+ case EDOM: return "EDOM";
#endif
#ifdef EDOTDOT
- case EDOTDOT: return "EDOTDOT";
+ case EDOTDOT: return "EDOTDOT";
#endif
#ifdef EDQUOT
- case EDQUOT: return "EDQUOT";
+ case EDQUOT: return "EDQUOT";
#endif
#ifdef EDUPPKG
- case EDUPPKG: return "EDUPPKG";
+ case EDUPPKG: return "EDUPPKG";
#endif
#ifdef EEXIST
- case EEXIST: return "EEXIST";
+ case EEXIST: return "EEXIST";
#endif
#ifdef EFAULT
- case EFAULT: return "EFAULT";
+ case EFAULT: return "EFAULT";
#endif
#ifdef EFBIG
- case EFBIG: return "EFBIG";
+ case EFBIG: return "EFBIG";
#endif
#ifdef EHOSTDOWN
- case EHOSTDOWN: return "EHOSTDOWN";
+ case EHOSTDOWN: return "EHOSTDOWN";
#endif
#ifdef EHOSTUNREACH
- case EHOSTUNREACH: return "EHOSTUNREACH";
+ case EHOSTUNREACH: return "EHOSTUNREACH";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
- case EIDRM: return "EIDRM";
+ case EIDRM: return "EIDRM";
#endif
#ifdef EINIT
- case EINIT: return "EINIT";
+ case EINIT: return "EINIT";
#endif
#ifdef EINPROGRESS
- case EINPROGRESS: return "EINPROGRESS";
+ case EINPROGRESS: return "EINPROGRESS";
#endif
#ifdef EINTR
- case EINTR: return "EINTR";
+ case EINTR: return "EINTR";
#endif
#ifdef EINVAL
- case EINVAL: return "EINVAL";
+ case EINVAL: return "EINVAL";
#endif
#ifdef EIO
- case EIO: return "EIO";
+ case EIO: return "EIO";
#endif
#ifdef EISCONN
- case EISCONN: return "EISCONN";
+ case EISCONN: return "EISCONN";
#endif
#ifdef EISDIR
- case EISDIR: return "EISDIR";
+ case EISDIR: return "EISDIR";
#endif
#ifdef EISNAME
- case EISNAM: return "EISNAM";
+ case EISNAM: return "EISNAM";
#endif
#ifdef ELBIN
- case ELBIN: return "ELBIN";
+ case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
- case EL2HLT: return "EL2HLT";
+ case EL2HLT: return "EL2HLT";
#endif
#ifdef EL2NSYNC
- case EL2NSYNC: return "EL2NSYNC";
+ case EL2NSYNC: return "EL2NSYNC";
#endif
#ifdef EL3HLT
- case EL3HLT: return "EL3HLT";
+ case EL3HLT: return "EL3HLT";
#endif
#ifdef EL3RST
- case EL3RST: return "EL3RST";
+ case EL3RST: return "EL3RST";
#endif
#ifdef ELIBACC
- case ELIBACC: return "ELIBACC";
+ case ELIBACC: return "ELIBACC";
#endif
#ifdef ELIBBAD
- case ELIBBAD: return "ELIBBAD";
+ case ELIBBAD: return "ELIBBAD";
#endif
#ifdef ELIBEXEC
- case ELIBEXEC: return "ELIBEXEC";
+ case ELIBEXEC: return "ELIBEXEC";
#endif
#ifdef ELIBMAX
- case ELIBMAX: return "ELIBMAX";
+ case ELIBMAX: return "ELIBMAX";
#endif
#ifdef ELIBSCN
- case ELIBSCN: return "ELIBSCN";
+ case ELIBSCN: return "ELIBSCN";
#endif
#ifdef ELNRNG
- case ELNRNG: return "ELNRNG";
+ case ELNRNG: return "ELNRNG";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
- case ELOOP: return "ELOOP";
+ case ELOOP: return "ELOOP";
#endif
#ifdef EMFILE
- case EMFILE: return "EMFILE";
+ case EMFILE: return "EMFILE";
#endif
#ifdef EMLINK
- case EMLINK: return "EMLINK";
+ case EMLINK: return "EMLINK";
#endif
#ifdef EMSGSIZE
- case EMSGSIZE: return "EMSGSIZE";
+ case EMSGSIZE: return "EMSGSIZE";
#endif
#ifdef EMULTIHOP
- case EMULTIHOP: return "EMULTIHOP";
+ case EMULTIHOP: return "EMULTIHOP";
#endif
#ifdef ENAMETOOLONG
- case ENAMETOOLONG: return "ENAMETOOLONG";
+ case ENAMETOOLONG: return "ENAMETOOLONG";
#endif
#ifdef ENAVAIL
- case ENAVAIL: return "ENAVAIL";
+ case ENAVAIL: return "ENAVAIL";
#endif
#ifdef ENET
- case ENET: return "ENET";
+ case ENET: return "ENET";
#endif
#ifdef ENETDOWN
- case ENETDOWN: return "ENETDOWN";
+ case ENETDOWN: return "ENETDOWN";
#endif
#ifdef ENETRESET
- case ENETRESET: return "ENETRESET";
+ case ENETRESET: return "ENETRESET";
#endif
#ifdef ENETUNREACH
- case ENETUNREACH: return "ENETUNREACH";
+ case ENETUNREACH: return "ENETUNREACH";
#endif
#ifdef ENFILE
- case ENFILE: return "ENFILE";
+ case ENFILE: return "ENFILE";
#endif
#ifdef ENOANO
- case ENOANO: return "ENOANO";
+ case ENOANO: return "ENOANO";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
- case ENOBUFS: return "ENOBUFS";
+ case ENOBUFS: return "ENOBUFS";
#endif
#ifdef ENOCSI
- case ENOCSI: return "ENOCSI";
+ case ENOCSI: return "ENOCSI";
#endif
#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
- case ENODATA: return "ENODATA";
+ case ENODATA: return "ENODATA";
#endif
#ifdef ENODEV
- case ENODEV: return "ENODEV";
+ case ENODEV: return "ENODEV";
#endif
#ifdef ENOENT
- case ENOENT: return "ENOENT";
+ case ENOENT: return "ENOENT";
#endif
#ifdef ENOEXEC
- case ENOEXEC: return "ENOEXEC";
+ case ENOEXEC: return "ENOEXEC";
#endif
#ifdef ENOLCK
- case ENOLCK: return "ENOLCK";
+ case ENOLCK: return "ENOLCK";
#endif
#ifdef ENOLINK
- case ENOLINK: return "ENOLINK";
+ case ENOLINK: return "ENOLINK";
#endif
#ifdef ENOMEM
- case ENOMEM: return "ENOMEM";
+ case ENOMEM: return "ENOMEM";
#endif
#ifdef ENOMSG
- case ENOMSG: return "ENOMSG";
+ case ENOMSG: return "ENOMSG";
#endif
#ifdef ENONET
- case ENONET: return "ENONET";
+ case ENONET: return "ENONET";
#endif
#ifdef ENOPKG
- case ENOPKG: return "ENOPKG";
+ case ENOPKG: return "ENOPKG";
#endif
#ifdef ENOPROTOOPT
- case ENOPROTOOPT: return "ENOPROTOOPT";
+ case ENOPROTOOPT: return "ENOPROTOOPT";
#endif
#ifdef ENOSPC
- case ENOSPC: return "ENOSPC";
+ case ENOSPC: return "ENOSPC";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
- case ENOSR: return "ENOSR";
+ case ENOSR: return "ENOSR";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
- case ENOSTR: return "ENOSTR";
+ case ENOSTR: return "ENOSTR";
#endif
#ifdef ENOSYM
- case ENOSYM: return "ENOSYM";
+ case ENOSYM: return "ENOSYM";
#endif
#ifdef ENOSYS
- case ENOSYS: return "ENOSYS";
+ case ENOSYS: return "ENOSYS";
#endif
#ifdef ENOTBLK
- case ENOTBLK: return "ENOTBLK";
+ case ENOTBLK: return "ENOTBLK";
#endif
#ifdef ENOTCONN
- case ENOTCONN: return "ENOTCONN";
+ case ENOTCONN: return "ENOTCONN";
#endif
#ifdef ENOTDIR
- case ENOTDIR: return "ENOTDIR";
+ case ENOTDIR: return "ENOTDIR";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
- case ENOTEMPTY: return "ENOTEMPTY";
+ case ENOTEMPTY: return "ENOTEMPTY";
#endif
#ifdef ENOTNAM
- case ENOTNAM: return "ENOTNAM";
+ case ENOTNAM: return "ENOTNAM";
#endif
#ifdef ENOTSOCK
- case ENOTSOCK: return "ENOTSOCK";
+ case ENOTSOCK: return "ENOTSOCK";
#endif
#ifdef ENOTSUP
- case ENOTSUP: return "ENOTSUP";
+ case ENOTSUP: return "ENOTSUP";
#endif
#ifdef ENOTTY
- case ENOTTY: return "ENOTTY";
+ case ENOTTY: return "ENOTTY";
#endif
#ifdef ENOTUNIQ
- case ENOTUNIQ: return "ENOTUNIQ";
+ case ENOTUNIQ: return "ENOTUNIQ";
#endif
#ifdef ENXIO
- case ENXIO: return "ENXIO";
+ case ENXIO: return "ENXIO";
#endif
#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
- case EOPNOTSUPP: return "EOPNOTSUPP";
+ case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
- case EOVERFLOW: return "EOVERFLOW";
+ case EOVERFLOW: return "EOVERFLOW";
#endif
#ifdef EPERM
- case EPERM: return "EPERM";
+ case EPERM: return "EPERM";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
- case EPFNOSUPPORT: return "EPFNOSUPPORT";
+ case EPFNOSUPPORT: return "EPFNOSUPPORT";
#endif
#ifdef EPIPE
- case EPIPE: return "EPIPE";
+ case EPIPE: return "EPIPE";
#endif
#ifdef EPROCLIM
- case EPROCLIM: return "EPROCLIM";
+ case EPROCLIM: return "EPROCLIM";
#endif
#ifdef EPROCUNAVAIL
- case EPROCUNAVAIL: return "EPROCUNAVAIL";
+ case EPROCUNAVAIL: return "EPROCUNAVAIL";
#endif
#ifdef EPROGMISMATCH
- case EPROGMISMATCH: return "EPROGMISMATCH";
+ case EPROGMISMATCH: return "EPROGMISMATCH";
#endif
#ifdef EPROGUNAVAIL
- case EPROGUNAVAIL: return "EPROGUNAVAIL";
+ case EPROGUNAVAIL: return "EPROGUNAVAIL";
#endif
#ifdef EPROTO
- case EPROTO: return "EPROTO";
+ case EPROTO: return "EPROTO";
#endif
#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
+ case EPROTONOSUPPORT: return "EPROTONOSUPPORT";
#endif
#ifdef EPROTOTYPE
- case EPROTOTYPE: return "EPROTOTYPE";
+ case EPROTOTYPE: return "EPROTOTYPE";
#endif
#ifdef ERANGE
- case ERANGE: return "ERANGE";
+ case ERANGE: return "ERANGE";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
- case EREFUSED: return "EREFUSED";
+ case EREFUSED: return "EREFUSED";
#endif
#ifdef EREMCHG
- case EREMCHG: return "EREMCHG";
+ case EREMCHG: return "EREMCHG";
#endif
#ifdef EREMDEV
- case EREMDEV: return "EREMDEV";
+ case EREMDEV: return "EREMDEV";
#endif
#ifdef EREMOTE
- case EREMOTE: return "EREMOTE";
+ case EREMOTE: return "EREMOTE";
#endif
#ifdef EREMOTEIO
- case EREMOTEIO: return "EREMOTEIO";
+ case EREMOTEIO: return "EREMOTEIO";
#endif
#ifdef EREMOTERELEASE
- case EREMOTERELEASE: return "EREMOTERELEASE";
+ case EREMOTERELEASE: return "EREMOTERELEASE";
#endif
#ifdef EROFS
- case EROFS: return "EROFS";
+ case EROFS: return "EROFS";
#endif
#ifdef ERPCMISMATCH
- case ERPCMISMATCH: return "ERPCMISMATCH";
+ case ERPCMISMATCH: return "ERPCMISMATCH";
#endif
#ifdef ERREMOTE
- case ERREMOTE: return "ERREMOTE";
+ case ERREMOTE: return "ERREMOTE";
#endif
#ifdef ESHUTDOWN
- case ESHUTDOWN: return "ESHUTDOWN";
+ case ESHUTDOWN: return "ESHUTDOWN";
#endif
#ifdef ESOCKTNOSUPPORT
- case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
+ case ESOCKTNOSUPPORT: return "ESOCKTNOSUPPORT";
#endif
#ifdef ESPIPE
- case ESPIPE: return "ESPIPE";
+ case ESPIPE: return "ESPIPE";
#endif
#ifdef ESRCH
- case ESRCH: return "ESRCH";
+ case ESRCH: return "ESRCH";
#endif
#ifdef ESRMNT
- case ESRMNT: return "ESRMNT";
+ case ESRMNT: return "ESRMNT";
#endif
#ifdef ESTALE
- case ESTALE: return "ESTALE";
+ case ESTALE: return "ESTALE";
#endif
#ifdef ESUCCESS
- case ESUCCESS: return "ESUCCESS";
+ case ESUCCESS: return "ESUCCESS";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
- case ETIME: return "ETIME";
+ case ETIME: return "ETIME";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
- case ETIMEDOUT: return "ETIMEDOUT";
+ case ETIMEDOUT: return "ETIMEDOUT";
#endif
#ifdef ETOOMANYREFS
- case ETOOMANYREFS: return "ETOOMANYREFS";
+ case ETOOMANYREFS: return "ETOOMANYREFS";
#endif
#ifdef ETXTBSY
- case ETXTBSY: return "ETXTBSY";
+ case ETXTBSY: return "ETXTBSY";
#endif
#ifdef EUCLEAN
- case EUCLEAN: return "EUCLEAN";
+ case EUCLEAN: return "EUCLEAN";
#endif
#ifdef EUNATCH
- case EUNATCH: return "EUNATCH";
+ case EUNATCH: return "EUNATCH";
#endif
#ifdef EUSERS
- case EUSERS: return "EUSERS";
+ case EUSERS: return "EUSERS";
#endif
#ifdef EVERSION
- case EVERSION: return "EVERSION";
+ case EVERSION: return "EVERSION";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
- case EWOULDBLOCK: return "EWOULDBLOCK";
+ case EWOULDBLOCK: return "EWOULDBLOCK";
#endif
#ifdef EXDEV
- case EXDEV: return "EXDEV";
+ case EXDEV: return "EXDEV";
#endif
#ifdef EXFULL
- case EXFULL: return "EXFULL";
+ case EXFULL: return "EXFULL";
#endif
}
return "unknown error";
@@ -464,17 +463,15 @@ Tcl_ErrnoId()
*
* Tcl_ErrnoMsg --
*
- * Return a human-readable message corresponding to a given
- * errno value.
+ * Return a human-readable message corresponding to a given errno value.
*
* Results:
- * The return value is the standard POSIX error message for
- * errno. This procedure is used instead of strerror because
- * strerror returns slightly different values on different
- * machines (e.g. different capitalizations), which cause
- * problems for things such as regression tests. This procedure
- * provides messages for most standard errors, then it calls
- * strerror for things it doesn't understand.
+ * The return value is the standard POSIX error message for errno. This
+ * procedure is used instead of strerror because strerror returns
+ * slightly different values on different machines (e.g. different
+ * capitalizations), which cause problems for things such as regression
+ * tests. This procedure provides messages for most standard errors, then
+ * it calls strerror for things it doesn't understand.
*
* Side effects:
* None.
@@ -484,432 +481,432 @@ Tcl_ErrnoId()
CONST char *
Tcl_ErrnoMsg(err)
- int err; /* Error number (such as in errno variable). */
+ int err; /* Error number (such as in errno variable). */
{
switch (err) {
#ifdef E2BIG
- case E2BIG: return "argument list too long";
+ case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
- case EACCES: return "permission denied";
+ case EACCES: return "permission denied";
#endif
#ifdef EADDRINUSE
- case EADDRINUSE: return "address already in use";
+ case EADDRINUSE: return "address already in use";
#endif
#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL: return "can't assign requested address";
+ case EADDRNOTAVAIL: return "can't assign requested address";
#endif
#ifdef EADV
- case EADV: return "advertise error";
+ case EADV: return "advertise error";
#endif
#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT: return "address family not supported by protocol family";
+ case EAFNOSUPPORT: return "address family not supported by protocol family";
#endif
#ifdef EAGAIN
- case EAGAIN: return "resource temporarily unavailable";
+ case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
- case EALIGN: return "EALIGN";
+ case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
- case EALREADY: return "operation already in progress";
+ case EALREADY: return "operation already in progress";
#endif
#ifdef EBADE
- case EBADE: return "bad exchange descriptor";
+ case EBADE: return "bad exchange descriptor";
#endif
#ifdef EBADF
- case EBADF: return "bad file number";
+ case EBADF: return "bad file number";
#endif
#ifdef EBADFD
- case EBADFD: return "file descriptor in bad state";
+ case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
- case EBADMSG: return "not a data message";
+ case EBADMSG: return "not a data message";
#endif
#ifdef EBADR
- case EBADR: return "bad request descriptor";
+ case EBADR: return "bad request descriptor";
#endif
#ifdef EBADRPC
- case EBADRPC: return "RPC structure is bad";
+ case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
- case EBADRQC: return "bad request code";
+ case EBADRQC: return "bad request code";
#endif
#ifdef EBADSLT
- case EBADSLT: return "invalid slot";
+ case EBADSLT: return "invalid slot";
#endif
#ifdef EBFONT
- case EBFONT: return "bad font file format";
+ case EBFONT: return "bad font file format";
#endif
#ifdef EBUSY
- case EBUSY: return "file busy";
+ case EBUSY: return "file busy";
#endif
#ifdef ECHILD
- case ECHILD: return "no children";
+ case ECHILD: return "no children";
#endif
#ifdef ECHRNG
- case ECHRNG: return "channel number out of range";
+ case ECHRNG: return "channel number out of range";
#endif
#ifdef ECOMM
- case ECOMM: return "communication error on send";
+ case ECOMM: return "communication error on send";
#endif
#ifdef ECONNABORTED
- case ECONNABORTED: return "software caused connection abort";
+ case ECONNABORTED: return "software caused connection abort";
#endif
#ifdef ECONNREFUSED
- case ECONNREFUSED: return "connection refused";
+ case ECONNREFUSED: return "connection refused";
#endif
#ifdef ECONNRESET
- case ECONNRESET: return "connection reset by peer";
+ case ECONNRESET: return "connection reset by peer";
#endif
#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
- case EDEADLK: return "resource deadlock avoided";
+ case EDEADLK: return "resource deadlock avoided";
#endif
#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
- case EDEADLOCK: return "resource deadlock avoided";
+ case EDEADLOCK: return "resource deadlock avoided";
#endif
#ifdef EDESTADDRREQ
- case EDESTADDRREQ: return "destination address required";
+ case EDESTADDRREQ: return "destination address required";
#endif
#ifdef EDIRTY
- case EDIRTY: return "mounting a dirty fs w/o force";
+ case EDIRTY: return "mounting a dirty fs w/o force";
#endif
#ifdef EDOM
- case EDOM: return "math argument out of range";
+ case EDOM: return "math argument out of range";
#endif
#ifdef EDOTDOT
- case EDOTDOT: return "cross mount point";
+ case EDOTDOT: return "cross mount point";
#endif
#ifdef EDQUOT
- case EDQUOT: return "disk quota exceeded";
+ case EDQUOT: return "disk quota exceeded";
#endif
#ifdef EDUPPKG
- case EDUPPKG: return "duplicate package name";
+ case EDUPPKG: return "duplicate package name";
#endif
#ifdef EEXIST
- case EEXIST: return "file already exists";
+ case EEXIST: return "file already exists";
#endif
#ifdef EFAULT
- case EFAULT: return "bad address in system call argument";
+ case EFAULT: return "bad address in system call argument";
#endif
#ifdef EFBIG
- case EFBIG: return "file too large";
+ case EFBIG: return "file too large";
#endif
#ifdef EHOSTDOWN
- case EHOSTDOWN: return "host is down";
+ case EHOSTDOWN: return "host is down";
#endif
#ifdef EHOSTUNREACH
- case EHOSTUNREACH: return "host is unreachable";
+ case EHOSTUNREACH: return "host is unreachable";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
- case EIDRM: return "identifier removed";
+ case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
- case EINIT: return "initialization error";
+ case EINIT: return "initialization error";
#endif
#ifdef EINPROGRESS
- case EINPROGRESS: return "operation now in progress";
+ case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
- case EINTR: return "interrupted system call";
+ case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
- case EINVAL: return "invalid argument";
+ case EINVAL: return "invalid argument";
#endif
#ifdef EIO
- case EIO: return "I/O error";
+ case EIO: return "I/O error";
#endif
#ifdef EISCONN
- case EISCONN: return "socket is already connected";
+ case EISCONN: return "socket is already connected";
#endif
#ifdef EISDIR
- case EISDIR: return "illegal operation on a directory";
+ case EISDIR: return "illegal operation on a directory";
#endif
#ifdef EISNAME
- case EISNAM: return "is a name file";
+ case EISNAM: return "is a name file";
#endif
#ifdef ELBIN
- case ELBIN: return "ELBIN";
+ case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
- case EL2HLT: return "level 2 halted";
+ case EL2HLT: return "level 2 halted";
#endif
#ifdef EL2NSYNC
- case EL2NSYNC: return "level 2 not synchronized";
+ case EL2NSYNC: return "level 2 not synchronized";
#endif
#ifdef EL3HLT
- case EL3HLT: return "level 3 halted";
+ case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
- case EL3RST: return "level 3 reset";
+ case EL3RST: return "level 3 reset";
#endif
#ifdef ELIBACC
- case ELIBACC: return "can not access a needed shared library";
+ case ELIBACC: return "can not access a needed shared library";
#endif
#ifdef ELIBBAD
- case ELIBBAD: return "accessing a corrupted shared library";
+ case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
- case ELIBEXEC: return "can not exec a shared library directly";
+ case ELIBEXEC: return "can not exec a shared library directly";
#endif
#ifdef ELIBMAX
- case ELIBMAX: return
- "attempting to link in more shared libraries than system limit";
+ case ELIBMAX: return
+ "attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
- case ELIBSCN: return ".lib section in a.out corrupted";
+ case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
- case ELNRNG: return "link number out of range";
+ case ELNRNG: return "link number out of range";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
- case ELOOP: return "too many levels of symbolic links";
+ case ELOOP: return "too many levels of symbolic links";
#endif
#ifdef EMFILE
- case EMFILE: return "too many open files";
+ case EMFILE: return "too many open files";
#endif
#ifdef EMLINK
- case EMLINK: return "too many links";
+ case EMLINK: return "too many links";
#endif
#ifdef EMSGSIZE
- case EMSGSIZE: return "message too long";
+ case EMSGSIZE: return "message too long";
#endif
#ifdef EMULTIHOP
- case EMULTIHOP: return "multihop attempted";
+ case EMULTIHOP: return "multihop attempted";
#endif
#ifdef ENAMETOOLONG
- case ENAMETOOLONG: return "file name too long";
+ case ENAMETOOLONG: return "file name too long";
#endif
#ifdef ENAVAIL
- case ENAVAIL: return "not available";
+ case ENAVAIL: return "not available";
#endif
#ifdef ENET
- case ENET: return "ENET";
+ case ENET: return "ENET";
#endif
#ifdef ENETDOWN
- case ENETDOWN: return "network is down";
+ case ENETDOWN: return "network is down";
#endif
#ifdef ENETRESET
- case ENETRESET: return "network dropped connection on reset";
+ case ENETRESET: return "network dropped connection on reset";
#endif
#ifdef ENETUNREACH
- case ENETUNREACH: return "network is unreachable";
+ case ENETUNREACH: return "network is unreachable";
#endif
#ifdef ENFILE
- case ENFILE: return "file table overflow";
+ case ENFILE: return "file table overflow";
#endif
#ifdef ENOANO
- case ENOANO: return "anode table overflow";
+ case ENOANO: return "anode table overflow";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
- case ENOBUFS: return "no buffer space available";
+ case ENOBUFS: return "no buffer space available";
#endif
#ifdef ENOCSI
- case ENOCSI: return "no CSI structure available";
+ case ENOCSI: return "no CSI structure available";
#endif
#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
- case ENODATA: return "no data available";
+ case ENODATA: return "no data available";
#endif
#ifdef ENODEV
- case ENODEV: return "no such device";
+ case ENODEV: return "no such device";
#endif
#ifdef ENOENT
- case ENOENT: return "no such file or directory";
+ case ENOENT: return "no such file or directory";
#endif
#ifdef ENOEXEC
- case ENOEXEC: return "exec format error";
+ case ENOEXEC: return "exec format error";
#endif
#ifdef ENOLCK
- case ENOLCK: return "no locks available";
+ case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
- case ENOLINK: return "link has be severed";
+ case ENOLINK: return "link has be severed";
#endif
#ifdef ENOMEM
- case ENOMEM: return "not enough memory";
+ case ENOMEM: return "not enough memory";
#endif
#ifdef ENOMSG
- case ENOMSG: return "no message of desired type";
+ case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
- case ENONET: return "machine is not on the network";
+ case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
- case ENOPKG: return "package not installed";
+ case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
- case ENOPROTOOPT: return "bad protocol option";
+ case ENOPROTOOPT: return "bad protocol option";
#endif
#ifdef ENOSPC
- case ENOSPC: return "no space left on device";
+ case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
- case ENOSR: return "out of stream resources";
+ case ENOSR: return "out of stream resources";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
- case ENOSTR: return "not a stream device";
+ case ENOSTR: return "not a stream device";
#endif
#ifdef ENOSYM
- case ENOSYM: return "unresolved symbol name";
+ case ENOSYM: return "unresolved symbol name";
#endif
#ifdef ENOSYS
- case ENOSYS: return "function not implemented";
+ case ENOSYS: return "function not implemented";
#endif
#ifdef ENOTBLK
- case ENOTBLK: return "block device required";
+ case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
- case ENOTCONN: return "socket is not connected";
+ case ENOTCONN: return "socket is not connected";
#endif
#ifdef ENOTDIR
- case ENOTDIR: return "not a directory";
+ case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
- case ENOTEMPTY: return "directory not empty";
+ case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
- case ENOTNAM: return "not a name file";
+ case ENOTNAM: return "not a name file";
#endif
#ifdef ENOTSOCK
- case ENOTSOCK: return "socket operation on non-socket";
+ case ENOTSOCK: return "socket operation on non-socket";
#endif
#ifdef ENOTSUP
- case ENOTSUP: return "operation not supported";
+ case ENOTSUP: return "operation not supported";
#endif
#ifdef ENOTTY
- case ENOTTY: return "inappropriate device for ioctl";
+ case ENOTTY: return "inappropriate device for ioctl";
#endif
#ifdef ENOTUNIQ
- case ENOTUNIQ: return "name not unique on network";
+ case ENOTUNIQ: return "name not unique on network";
#endif
#ifdef ENXIO
- case ENXIO: return "no such device or address";
+ case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
- case EOPNOTSUPP: return "operation not supported on socket";
+ case EOPNOTSUPP: return "operation not supported on socket";
#endif
#if defined(EOVERFLOW) && ( !defined(EFBIG) || (EOVERFLOW != EFBIG) ) && ( !defined(EINVAL) || (EOVERFLOW != EINVAL) )
- case EOVERFLOW: return "file too big";
+ case EOVERFLOW: return "file too big";
#endif
#ifdef EPERM
- case EPERM: return "not owner";
+ case EPERM: return "not owner";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
- case EPFNOSUPPORT: return "protocol family not supported";
+ case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
- case EPIPE: return "broken pipe";
+ case EPIPE: return "broken pipe";
#endif
#ifdef EPROCLIM
- case EPROCLIM: return "too many processes";
+ case EPROCLIM: return "too many processes";
#endif
#ifdef EPROCUNAVAIL
- case EPROCUNAVAIL: return "bad procedure for program";
+ case EPROCUNAVAIL: return "bad procedure for program";
#endif
#ifdef EPROGMISMATCH
- case EPROGMISMATCH: return "program version wrong";
+ case EPROGMISMATCH: return "program version wrong";
#endif
#ifdef EPROGUNAVAIL
- case EPROGUNAVAIL: return "RPC program not available";
+ case EPROGUNAVAIL: return "RPC program not available";
#endif
#ifdef EPROTO
- case EPROTO: return "protocol error";
+ case EPROTO: return "protocol error";
#endif
#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT: return "protocol not suppored";
+ case EPROTONOSUPPORT: return "protocol not suppored";
#endif
#ifdef EPROTOTYPE
- case EPROTOTYPE: return "protocol wrong type for socket";
+ case EPROTOTYPE: return "protocol wrong type for socket";
#endif
#ifdef ERANGE
- case ERANGE: return "math result unrepresentable";
+ case ERANGE: return "math result unrepresentable";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
- case EREFUSED: return "EREFUSED";
+ case EREFUSED: return "EREFUSED";
#endif
#ifdef EREMCHG
- case EREMCHG: return "remote address changed";
+ case EREMCHG: return "remote address changed";
#endif
#ifdef EREMDEV
- case EREMDEV: return "remote device";
+ case EREMDEV: return "remote device";
#endif
#ifdef EREMOTE
- case EREMOTE: return "pathname hit remote file system";
+ case EREMOTE: return "pathname hit remote file system";
#endif
#ifdef EREMOTEIO
- case EREMOTEIO: return "remote i/o error";
+ case EREMOTEIO: return "remote i/o error";
#endif
#ifdef EREMOTERELEASE
- case EREMOTERELEASE: return "EREMOTERELEASE";
+ case EREMOTERELEASE: return "EREMOTERELEASE";
#endif
#ifdef EROFS
- case EROFS: return "read-only file system";
+ case EROFS: return "read-only file system";
#endif
#ifdef ERPCMISMATCH
- case ERPCMISMATCH: return "RPC version is wrong";
+ case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
- case ERREMOTE: return "object is remote";
+ case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
- case ESHUTDOWN: return "can't send afer socket shutdown";
+ case ESHUTDOWN: return "can't send afer socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
- case ESOCKTNOSUPPORT: return "socket type not supported";
+ case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
- case ESPIPE: return "invalid seek";
+ case ESPIPE: return "invalid seek";
#endif
#ifdef ESRCH
- case ESRCH: return "no such process";
+ case ESRCH: return "no such process";
#endif
#ifdef ESRMNT
- case ESRMNT: return "srmount error";
+ case ESRMNT: return "srmount error";
#endif
#ifdef ESTALE
- case ESTALE: return "stale remote file handle";
+ case ESTALE: return "stale remote file handle";
#endif
#ifdef ESUCCESS
- case ESUCCESS: return "Error 0";
+ case ESUCCESS: return "Error 0";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
- case ETIME: return "timer expired";
+ case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
- case ETIMEDOUT: return "connection timed out";
+ case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
- case ETOOMANYREFS: return "too many references: can't splice";
+ case ETOOMANYREFS: return "too many references: can't splice";
#endif
#ifdef ETXTBSY
- case ETXTBSY: return "text file or pseudo-device busy";
+ case ETXTBSY: return "text file or pseudo-device busy";
#endif
#ifdef EUCLEAN
- case EUCLEAN: return "structure needs cleaning";
+ case EUCLEAN: return "structure needs cleaning";
#endif
#ifdef EUNATCH
- case EUNATCH: return "protocol driver not attached";
+ case EUNATCH: return "protocol driver not attached";
#endif
#ifdef EUSERS
- case EUSERS: return "too many users";
+ case EUSERS: return "too many users";
#endif
#ifdef EVERSION
- case EVERSION: return "version mismatch";
+ case EVERSION: return "version mismatch";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
- case EWOULDBLOCK: return "operation would block";
+ case EWOULDBLOCK: return "operation would block";
#endif
#ifdef EXDEV
- case EXDEV: return "cross-domain link";
+ case EXDEV: return "cross-domain link";
#endif
#ifdef EXFULL
- case EXFULL: return "message tables full";
+ case EXFULL: return "message tables full";
#endif
- default:
+ default:
#ifdef NO_STRERROR
- return "unknown POSIX error";
+ return "unknown POSIX error";
#else
- return strerror(errno);
+ return strerror(errno);
#endif
}
}
@@ -922,9 +919,9 @@ Tcl_ErrnoMsg(err)
* Return a textual identifier for a signal number.
*
* Results:
- * This procedure returns a machine-readable textual identifier
- * that corresponds to sig. The identifier is the same as the
- * #define name in signal.h.
+ * This procedure returns a machine-readable textual identifier that
+ * corresponds to sig. The identifier is the same as the #define name in
+ * signal.h.
*
* Side effects:
* None.
@@ -934,113 +931,113 @@ Tcl_ErrnoMsg(err)
CONST char *
Tcl_SignalId(sig)
- int sig; /* Number of signal. */
+ int sig; /* Number of signal. */
{
switch (sig) {
#ifdef SIGABRT
- case SIGABRT: return "SIGABRT";
+ case SIGABRT: return "SIGABRT";
#endif
#ifdef SIGALRM
- case SIGALRM: return "SIGALRM";
+ case SIGALRM: return "SIGALRM";
#endif
#ifdef SIGBUS
- case SIGBUS: return "SIGBUS";
+ case SIGBUS: return "SIGBUS";
#endif
#ifdef SIGCHLD
- case SIGCHLD: return "SIGCHLD";
+ case SIGCHLD: return "SIGCHLD";
#endif
#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
- case SIGCLD: return "SIGCLD";
+ case SIGCLD: return "SIGCLD";
#endif
#ifdef SIGCONT
- case SIGCONT: return "SIGCONT";
+ case SIGCONT: return "SIGCONT";
#endif
#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
- case SIGEMT: return "SIGEMT";
+ case SIGEMT: return "SIGEMT";
#endif
#ifdef SIGFPE
- case SIGFPE: return "SIGFPE";
+ case SIGFPE: return "SIGFPE";
#endif
#ifdef SIGHUP
- case SIGHUP: return "SIGHUP";
+ case SIGHUP: return "SIGHUP";
#endif
#ifdef SIGILL
- case SIGILL: return "SIGILL";
+ case SIGILL: return "SIGILL";
#endif
#ifdef SIGINT
- case SIGINT: return "SIGINT";
+ case SIGINT: return "SIGINT";
#endif
#ifdef SIGIO
- case SIGIO: return "SIGIO";
+ case SIGIO: return "SIGIO";
#endif
#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGIOT != SIGABRT))
- case SIGIOT: return "SIGIOT";
+ case SIGIOT: return "SIGIOT";
#endif
#ifdef SIGKILL
- case SIGKILL: return "SIGKILL";
+ case SIGKILL: return "SIGKILL";
#endif
#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
- case SIGLOST: return "SIGLOST";
+ case SIGLOST: return "SIGLOST";
#endif
#ifdef SIGPIPE
- case SIGPIPE: return "SIGPIPE";
+ case SIGPIPE: return "SIGPIPE";
#endif
#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
- case SIGPOLL: return "SIGPOLL";
+ case SIGPOLL: return "SIGPOLL";
#endif
#ifdef SIGPROF
- case SIGPROF: return "SIGPROF";
+ case SIGPROF: return "SIGPROF";
#endif
#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
- case SIGPWR: return "SIGPWR";
+ case SIGPWR: return "SIGPWR";
#endif
#ifdef SIGQUIT
- case SIGQUIT: return "SIGQUIT";
+ case SIGQUIT: return "SIGQUIT";
#endif
#ifdef SIGSEGV
- case SIGSEGV: return "SIGSEGV";
+ case SIGSEGV: return "SIGSEGV";
#endif
#ifdef SIGSTOP
- case SIGSTOP: return "SIGSTOP";
+ case SIGSTOP: return "SIGSTOP";
#endif
#ifdef SIGSYS
- case SIGSYS: return "SIGSYS";
+ case SIGSYS: return "SIGSYS";
#endif
#ifdef SIGTERM
- case SIGTERM: return "SIGTERM";
+ case SIGTERM: return "SIGTERM";
#endif
#ifdef SIGTRAP
- case SIGTRAP: return "SIGTRAP";
+ case SIGTRAP: return "SIGTRAP";
#endif
#ifdef SIGTSTP
- case SIGTSTP: return "SIGTSTP";
+ case SIGTSTP: return "SIGTSTP";
#endif
#ifdef SIGTTIN
- case SIGTTIN: return "SIGTTIN";
+ case SIGTTIN: return "SIGTTIN";
#endif
#ifdef SIGTTOU
- case SIGTTOU: return "SIGTTOU";
+ case SIGTTOU: return "SIGTTOU";
#endif
#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
- case SIGURG: return "SIGURG";
+ case SIGURG: return "SIGURG";
#endif
#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
- case SIGUSR1: return "SIGUSR1";
+ case SIGUSR1: return "SIGUSR1";
#endif
#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
- case SIGUSR2: return "SIGUSR2";
+ case SIGUSR2: return "SIGUSR2";
#endif
#ifdef SIGVTALRM
- case SIGVTALRM: return "SIGVTALRM";
+ case SIGVTALRM: return "SIGVTALRM";
#endif
#ifdef SIGWINCH
- case SIGWINCH: return "SIGWINCH";
+ case SIGWINCH: return "SIGWINCH";
#endif
#ifdef SIGXCPU
- case SIGXCPU: return "SIGXCPU";
+ case SIGXCPU: return "SIGXCPU";
#endif
#ifdef SIGXFSZ
- case SIGXFSZ: return "SIGXFSZ";
+ case SIGXFSZ: return "SIGXFSZ";
#endif
}
return "unknown signal";
@@ -1054,9 +1051,8 @@ Tcl_SignalId(sig)
* Return a human-readable message describing a signal.
*
* Results:
- * This procedure returns a string describing sig that should
- * make sense to a human. It may not be easy for a machine
- * to parse.
+ * This procedure returns a string describing sig that should make sense
+ * to a human. It may not be easy for a machine to parse.
*
* Side effects:
* None.
@@ -1066,114 +1062,122 @@ Tcl_SignalId(sig)
CONST char *
Tcl_SignalMsg(sig)
- int sig; /* Number of signal. */
+ int sig; /* Number of signal. */
{
switch (sig) {
#ifdef SIGABRT
- case SIGABRT: return "SIGABRT";
+ case SIGABRT: return "SIGABRT";
#endif
#ifdef SIGALRM
- case SIGALRM: return "alarm clock";
+ case SIGALRM: return "alarm clock";
#endif
#ifdef SIGBUS
- case SIGBUS: return "bus error";
+ case SIGBUS: return "bus error";
#endif
#ifdef SIGCHLD
- case SIGCHLD: return "child status changed";
+ case SIGCHLD: return "child status changed";
#endif
#if defined(SIGCLD) && (!defined(SIGCHLD) || (SIGCLD != SIGCHLD))
- case SIGCLD: return "child status changed";
+ case SIGCLD: return "child status changed";
#endif
#ifdef SIGCONT
- case SIGCONT: return "continue after stop";
+ case SIGCONT: return "continue after stop";
#endif
#if defined(SIGEMT) && (!defined(SIGXCPU) || (SIGEMT != SIGXCPU))
- case SIGEMT: return "EMT instruction";
+ case SIGEMT: return "EMT instruction";
#endif
#ifdef SIGFPE
- case SIGFPE: return "floating-point exception";
+ case SIGFPE: return "floating-point exception";
#endif
#ifdef SIGHUP
- case SIGHUP: return "hangup";
+ case SIGHUP: return "hangup";
#endif
#ifdef SIGILL
- case SIGILL: return "illegal instruction";
+ case SIGILL: return "illegal instruction";
#endif
#ifdef SIGINT
- case SIGINT: return "interrupt";
+ case SIGINT: return "interrupt";
#endif
#ifdef SIGIO
- case SIGIO: return "input/output possible on file";
+ case SIGIO: return "input/output possible on file";
#endif
#if defined(SIGIOT) && (!defined(SIGABRT) || (SIGABRT != SIGIOT))
- case SIGIOT: return "IOT instruction";
+ case SIGIOT: return "IOT instruction";
#endif
#ifdef SIGKILL
- case SIGKILL: return "kill signal";
+ case SIGKILL: return "kill signal";
#endif
#if defined(SIGLOST) && (!defined(SIGIOT) || (SIGLOST != SIGIOT)) && (!defined(SIGURG) || (SIGLOST != SIGURG)) && (!defined(SIGPROF) || (SIGLOST != SIGPROF)) && (!defined(SIGIO) || (SIGLOST != SIGIO))
- case SIGLOST: return "resource lost";
+ case SIGLOST: return "resource lost";
#endif
#ifdef SIGPIPE
- case SIGPIPE: return "write on pipe with no readers";
+ case SIGPIPE: return "write on pipe with no readers";
#endif
#if defined(SIGPOLL) && (!defined(SIGIO) || (SIGPOLL != SIGIO))
- case SIGPOLL: return "input/output possible on file";
+ case SIGPOLL: return "input/output possible on file";
#endif
#ifdef SIGPROF
- case SIGPROF: return "profiling alarm";
+ case SIGPROF: return "profiling alarm";
#endif
#if defined(SIGPWR) && (!defined(SIGXFSZ) || (SIGPWR != SIGXFSZ)) && (!defined(SIGLOST) || (SIGPWR != SIGLOST))
- case SIGPWR: return "power-fail restart";
+ case SIGPWR: return "power-fail restart";
#endif
#ifdef SIGQUIT
- case SIGQUIT: return "quit signal";
+ case SIGQUIT: return "quit signal";
#endif
#ifdef SIGSEGV
- case SIGSEGV: return "segmentation violation";
+ case SIGSEGV: return "segmentation violation";
#endif
#ifdef SIGSTOP
- case SIGSTOP: return "stop";
+ case SIGSTOP: return "stop";
#endif
#ifdef SIGSYS
- case SIGSYS: return "bad argument to system call";
+ case SIGSYS: return "bad argument to system call";
#endif
#ifdef SIGTERM
- case SIGTERM: return "software termination signal";
+ case SIGTERM: return "software termination signal";
#endif
#ifdef SIGTRAP
- case SIGTRAP: return "trace trap";
+ case SIGTRAP: return "trace trap";
#endif
#ifdef SIGTSTP
- case SIGTSTP: return "stop signal from tty";
+ case SIGTSTP: return "stop signal from tty";
#endif
#ifdef SIGTTIN
- case SIGTTIN: return "background tty read";
+ case SIGTTIN: return "background tty read";
#endif
#ifdef SIGTTOU
- case SIGTTOU: return "background tty write";
+ case SIGTTOU: return "background tty write";
#endif
#if defined(SIGURG) && (!defined(SIGIO) || (SIGURG != SIGIO))
- case SIGURG: return "urgent I/O condition";
+ case SIGURG: return "urgent I/O condition";
#endif
#if defined(SIGUSR1) && (!defined(SIGIO) || (SIGUSR1 != SIGIO))
- case SIGUSR1: return "user-defined signal 1";
+ case SIGUSR1: return "user-defined signal 1";
#endif
#if defined(SIGUSR2) && (!defined(SIGURG) || (SIGUSR2 != SIGURG))
- case SIGUSR2: return "user-defined signal 2";
+ case SIGUSR2: return "user-defined signal 2";
#endif
#ifdef SIGVTALRM
- case SIGVTALRM: return "virtual time alarm";
+ case SIGVTALRM: return "virtual time alarm";
#endif
#ifdef SIGWINCH
- case SIGWINCH: return "window changed";
+ case SIGWINCH: return "window changed";
#endif
#ifdef SIGXCPU
- case SIGXCPU: return "exceeded CPU time limit";
+ case SIGXCPU: return "exceeded CPU time limit";
#endif
#ifdef SIGXFSZ
- case SIGXFSZ: return "exceeded file size limit";
+ case SIGXFSZ: return "exceeded file size limit";
#endif
}
return "unknown signal";
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 51d320f..7abcfcc 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -1,71 +1,68 @@
-/*
+/*
* tclThreadJoin.c --
*
- * This file implements a platform independent emulation layer for
- * the handling of joinable threads. The Windows platform
- * uses this code to provide the functionality of joining threads.
- * This code is currently not necessary on Unix.
+ * This file implements a platform independent emulation layer for the
+ * handling of joinable threads. The Windows platform uses this code to
+ * provide the functionality of joining threads. This code is currently
+ * not necessary on Unix.
*
* Copyright (c) 2000 by Scriptics Corporation
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclThreadJoin.c,v 1.5 2004/03/17 18:14:14 das Exp $
+ * RCS: @(#) $Id: tclThreadJoin.c,v 1.6 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
-#if defined(WIN32)
+#ifdef WIN32
-/* The information about each joinable thread is remembered in a
- * structure as defined below.
+/*
+ * The information about each joinable thread is remembered in a structure as
+ * defined below.
*/
typedef struct JoinableThread {
- Tcl_ThreadId id; /* The id of the joinable thread */
- int result; /* A place for the result after the
- * demise of the thread */
- int done; /* Boolean flag. Initialized to 0
- * and set to 1 after the exit of
- * the thread. This allows a thread
- * requesting a join to detect when
- * waiting is not necessary. */
- int waitedUpon; /* Boolean flag. Initialized to 0
- * and set to 1 by the thread waiting
- * for this one via Tcl_JoinThread.
- * Used to lock any other thread
- * trying to wait on this one.
- */
- Tcl_Mutex threadMutex; /* The mutex used to serialize access
- * to this structure. */
- Tcl_Condition cond; /* This is the condition a thread has
- * to wait upon to get notified of the
- * end of the described thread. It is
- * signaled indirectly by
- * Tcl_ExitThread. */
- struct JoinableThread* nextThreadPtr; /* Reference to the next thread in the
- * list of joinable threads */
+ Tcl_ThreadId id; /* The id of the joinable thread. */
+ int result; /* A place for the result after the demise of
+ * the thread. */
+ int done; /* Boolean flag. Initialized to 0 and set to 1
+ * after the exit of the thread. This allows a
+ * thread requesting a join to detect when
+ * waiting is not necessary. */
+ int waitedUpon; /* Boolean flag. Initialized to 0 and set to 1
+ * by the thread waiting for this one via
+ * Tcl_JoinThread. Used to lock any other
+ * thread trying to wait on this one. */
+ Tcl_Mutex threadMutex; /* The mutex used to serialize access to this
+ * structure. */
+ Tcl_Condition cond; /* This is the condition a thread has to wait
+ * upon to get notified of the end of the
+ * described thread. It is signaled indirectly
+ * by Tcl_ExitThread. */
+ struct JoinableThread *nextThreadPtr;
+ /* Reference to the next thread in the list of
+ * joinable threads. */
} JoinableThread;
-/* The following variable is used to maintain the global list of all
- * joinable threads. Usage by a thread is allowed only if the
- * thread acquired the 'joinMutex'.
+/*
+ * The following variable is used to maintain the global list of all joinable
+ * threads. Usage by a thread is allowed only if the thread acquired the
+ * 'joinMutex'.
*/
TCL_DECLARE_MUTEX(joinMutex)
static JoinableThread* firstThreadPtr;
-
-
/*
*----------------------------------------------------------------------
*
* TclJoinThread --
*
- * This procedure waits for the exit of the thread with the specified
- * id and returns its result.
+ * This procedure waits for the exit of the thread with the specified id
+ * and returns its result.
*
* Results:
* A standard tcl result signaling the overall success/failure of the
@@ -74,135 +71,139 @@ static JoinableThread* firstThreadPtr;
*
* Side effects:
* Deallocates the memory allocated by TclRememberJoinableThread.
- * Removes the data associated to the thread waited upon from the
- * list of joinable threads.
+ * Removes the data associated to the thread waited upon from the list of
+ * joinable threads.
*
*----------------------------------------------------------------------
*/
int
TclJoinThread(id, result)
- Tcl_ThreadId id; /* The id of the thread to wait upon. */
- int* result; /* Reference to a location for the result
- * of the thread we are waiting upon. */
+ Tcl_ThreadId id; /* The id of the thread to wait upon. */
+ int *result; /* Reference to a location for the result of
+ * the thread we are waiting upon. */
{
- /* Steps done here:
+ JoinableThread *threadPtr;
+
+ /*
+ * Steps done here:
* i. Acquire the joinMutex and search for the thread.
* ii. Error out if it could not be found.
* iii. If found, switch from exclusive access to the list to exclusive
- * access to the thread structure.
+ * access to the thread structure.
* iv. Error out if some other is already waiting.
* v. Skip the waiting part of the thread is already done.
* vi. Wait for the thread to exit, mark it as waited upon too.
- * vii. Get the result form the structure,
+ * vii. Get the result form the structure,
* viii. switch to exclusive access of the list,
* ix. remove the structure from the list,
* x. then switch back to exclusive access to the structure
* xi. and delete it.
*/
- JoinableThread* threadPtr;
+ Tcl_MutexLock(&joinMutex);
- Tcl_MutexLock (&joinMutex);
-
- for (threadPtr = firstThreadPtr;
- (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
- threadPtr = threadPtr->nextThreadPtr)
- /* empty body */
- ;
+ threadPtr = firstThreadPtr;
+ while (threadPtr!=NULL && threadPtr->id!=id) {
+ threadPtr = threadPtr->nextThreadPtr;
+ }
- if (threadPtr == (JoinableThread*) NULL) {
- /* Thread not found. Either not joinable, or already waited
- * upon and exited. Whatever, an error is in order.
+ if (threadPtr == NULL) {
+ /*
+ * Thread not found. Either not joinable, or already waited upon and
+ * exited. Whatever, an error is in order.
*/
- Tcl_MutexUnlock (&joinMutex);
- return TCL_ERROR;
+ Tcl_MutexUnlock(&joinMutex);
+ return TCL_ERROR;
}
- /* [1] If we don't lock the structure before giving up exclusive access
- * to the list some other thread just completing its wait on the same
- * thread can delete the structure from under us, leaving us with a
- * dangling pointer.
+ /*
+ * [1] If we don't lock the structure before giving up exclusive access to
+ * the list some other thread just completing its wait on the same thread
+ * can delete the structure from under us, leaving us with a dangling
+ * pointer.
*/
- Tcl_MutexLock (&threadPtr->threadMutex);
- Tcl_MutexUnlock (&joinMutex);
+ Tcl_MutexLock(&threadPtr->threadMutex);
+ Tcl_MutexUnlock(&joinMutex);
- /* [2] Now that we have the structure mutex any other thread that just
- * tries to delete structure will wait at location [3] until we are
- * done with the structure. And in that case we are done with it
- * rather quickly as 'waitedUpon' will be set and we will have to
- * error out.
+ /*
+ * [2] Now that we have the structure mutex any other thread that just
+ * tries to delete structure will wait at location [3] until we are done
+ * with the structure. And in that case we are done with it rather quickly
+ * as 'waitedUpon' will be set and we will have to error out.
*/
if (threadPtr->waitedUpon) {
- Tcl_MutexUnlock (&threadPtr->threadMutex);
+ Tcl_MutexUnlock(&threadPtr->threadMutex);
return TCL_ERROR;
}
- /* We are waiting now, let other threads recognize this
+ /*
+ * We are waiting now, let other threads recognize this.
*/
threadPtr->waitedUpon = 1;
while (!threadPtr->done) {
- Tcl_ConditionWait (&threadPtr->cond, &threadPtr->threadMutex, NULL);
+ Tcl_ConditionWait(&threadPtr->cond, &threadPtr->threadMutex, NULL);
}
- /* We have to release the structure before trying to access the list
- * again or we can run into deadlock with a thread at [1] (see above)
- * because of us holding the structure and the other holding the list.
- * There is no problem with dangling pointers here as 'waitedUpon == 1'
- * is still valid and any other thread will error out and not come to
- * this place. IOW, the fact that we are here also means that no other
- * thread came here before us and is able to delete the structure.
+ /*
+ * We have to release the structure before trying to access the list again
+ * or we can run into deadlock with a thread at [1] (see above) because of
+ * us holding the structure and the other holding the list. There is no
+ * problem with dangling pointers here as 'waitedUpon == 1' is still valid
+ * and any other thread will error out and not come to this place. IOW,
+ * the fact that we are here also means that no other thread came here
+ * before us and is able to delete the structure.
*/
- Tcl_MutexUnlock (&threadPtr->threadMutex);
- Tcl_MutexLock (&joinMutex);
+ Tcl_MutexUnlock(&threadPtr->threadMutex);
+ Tcl_MutexLock(&joinMutex);
- /* We have to search the list again as its structure may (may, almost
+ /*
+ * We have to search the list again as its structure may (may, almost
* certainly) have changed while we were waiting. Especially now is the
- * time to compute the predecessor in the list. Any earlier result can
- * be dangling by now.
+ * time to compute the predecessor in the list. Any earlier result can be
+ * dangling by now.
*/
if (firstThreadPtr == threadPtr) {
- firstThreadPtr = threadPtr->nextThreadPtr;
+ firstThreadPtr = threadPtr->nextThreadPtr;
} else {
- JoinableThread* prevThreadPtr;
-
- for (prevThreadPtr = firstThreadPtr;
- prevThreadPtr->nextThreadPtr != threadPtr;
- prevThreadPtr = prevThreadPtr->nextThreadPtr)
- /* empty body */
- ;
+ JoinableThread *prevThreadPtr = firstThreadPtr;
+ while (prevThreadPtr->nextThreadPtr != threadPtr) {
+ prevThreadPtr = prevThreadPtr->nextThreadPtr;
+ }
prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
}
- Tcl_MutexUnlock (&joinMutex);
+ Tcl_MutexUnlock(&joinMutex);
- /* [3] Now that the structure is not part of the list anymore no other
+ /*
+ * [3] Now that the structure is not part of the list anymore no other
* thread can acquire its mutex from now on. But it is possible that
- * another thread is still holding the mutex though, see location [2].
- * So we have to acquire the mutex one more time to wait for that thread
- * to finish. We can (and have to) release the mutex immediately.
+ * another thread is still holding the mutex though, see location [2]. So
+ * we have to acquire the mutex one more time to wait for that thread to
+ * finish. We can (and have to) release the mutex immediately.
*/
- Tcl_MutexLock (&threadPtr->threadMutex);
- Tcl_MutexUnlock (&threadPtr->threadMutex);
+ Tcl_MutexLock(&threadPtr->threadMutex);
+ Tcl_MutexUnlock(&threadPtr->threadMutex);
- /* Copy the result to us, finalize the synchronisation objects, then
- * free the structure and return.
+ /*
+ * Copy the result to us, finalize the synchronisation objects, then free
+ * the structure and return.
*/
*result = threadPtr->result;
- Tcl_ConditionFinalize (&threadPtr->cond);
- Tcl_MutexFinalize (&threadPtr->threadMutex);
- ckfree ((VOID*) threadPtr);
+ Tcl_ConditionFinalize(&threadPtr->cond);
+ Tcl_MutexFinalize(&threadPtr->threadMutex);
+ ckfree((char *) threadPtr);
return TCL_OK;
}
@@ -213,16 +214,14 @@ TclJoinThread(id, result)
* TclRememberJoinableThread --
*
* This procedure remebers a thread as joinable. Only a call to
- * TclJoinThread will remove the structre created (and initialized)
- * here. IOW, not waiting upon a joinable thread will cause memory
- * leaks.
+ * TclJoinThread will remove the structre created (and initialized) here.
+ * IOW, not waiting upon a joinable thread will cause memory leaks.
*
* Results:
* None.
*
* Side effects:
- * Allocates memory, adds it to the global list of all joinable
- * threads.
+ * Allocates memory, adds it to the global list of all joinable threads.
*
*----------------------------------------------------------------------
*/
@@ -231,21 +230,21 @@ VOID
TclRememberJoinableThread(id)
Tcl_ThreadId id; /* The thread to remember as joinable */
{
- JoinableThread* threadPtr;
+ JoinableThread *threadPtr;
- threadPtr = (JoinableThread*) ckalloc (sizeof (JoinableThread));
- threadPtr->id = id;
- threadPtr->done = 0;
- threadPtr->waitedUpon = 0;
+ threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
+ threadPtr->id = id;
+ threadPtr->done = 0;
+ threadPtr->waitedUpon = 0;
threadPtr->threadMutex = (Tcl_Mutex) NULL;
- threadPtr->cond = (Tcl_Condition) NULL;
+ threadPtr->cond = (Tcl_Condition) NULL;
- Tcl_MutexLock (&joinMutex);
+ Tcl_MutexLock(&joinMutex);
threadPtr->nextThreadPtr = firstThreadPtr;
- firstThreadPtr = threadPtr;
+ firstThreadPtr = threadPtr;
- Tcl_MutexUnlock (&joinMutex);
+ Tcl_MutexUnlock(&joinMutex);
}
/*
@@ -253,9 +252,9 @@ TclRememberJoinableThread(id)
*
* TclSignalExitThread --
*
- * This procedure signals that the specified thread is done with
- * its work. If the thread is joinable this signal is propagated
- * to the thread waiting upon it.
+ * This procedure signals that the specified thread is done with its
+ * work. If the thread is joinable this signal is propagated to the
+ * thread waiting upon it.
*
* Results:
* None.
@@ -268,44 +267,52 @@ TclRememberJoinableThread(id)
VOID
TclSignalExitThread(id,result)
- Tcl_ThreadId id; /* Id of the thread signaling its exit */
- int result; /* The result from the thread */
+ Tcl_ThreadId id; /* Id of the thread signaling its exit. */
+ int result; /* The result from the thread. */
{
- JoinableThread* threadPtr;
+ JoinableThread *threadPtr;
- Tcl_MutexLock (&joinMutex);
+ Tcl_MutexLock(&joinMutex);
- for (threadPtr = firstThreadPtr;
- (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
- threadPtr = threadPtr->nextThreadPtr)
- /* empty body */
- ;
+ threadPtr = firstThreadPtr;
+ while ((threadPtr != NULL) && (threadPtr->id != id)) {
+ threadPtr = threadPtr->nextThreadPtr;
+ }
- if (threadPtr == (JoinableThread*) NULL) {
- /* Thread not found. Not joinable. No problem, nothing to do.
+ if (threadPtr == NULL) {
+ /*
+ * Thread not found. Not joinable. No problem, nothing to do.
*/
- Tcl_MutexUnlock (&joinMutex);
+ Tcl_MutexUnlock(&joinMutex);
return;
}
- /* Switch over the exclusive access from the list to the structure,
- * then store the result, set the flag and notify the waiting thread,
- * provided that it exists. The order of lock/unlock ensures that a
- * thread entering 'TclJoinThread' will not interfere with us.
+ /*
+ * Switch over the exclusive access from the list to the structure, then
+ * store the result, set the flag and notify the waiting thread, provided
+ * that it exists. The order of lock/unlock ensures that a thread entering
+ * 'TclJoinThread' will not interfere with us.
*/
- Tcl_MutexLock (&threadPtr->threadMutex);
- Tcl_MutexUnlock (&joinMutex);
+ Tcl_MutexLock(&threadPtr->threadMutex);
+ Tcl_MutexUnlock(&joinMutex);
- threadPtr->done = 1;
+ threadPtr->done = 1;
threadPtr->result = result;
if (threadPtr->waitedUpon) {
- Tcl_ConditionNotify (&threadPtr->cond);
+ Tcl_ConditionNotify(&threadPtr->cond);
}
- Tcl_MutexUnlock (&threadPtr->threadMutex);
+ Tcl_MutexUnlock(&threadPtr->threadMutex);
}
-
#endif /* WIN32 */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 7eb66be..09aa125 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -5,10 +5,10 @@
*
* Copyright (c) 2003-2004 by Joe Mistachkin
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclThreadStorage.c,v 1.4 2004/06/24 09:05:46 dkf Exp $
+ * RCS: @(#) $Id: tclThreadStorage.c,v 1.5 2005/07/19 22:45:35 dkf Exp $
*/
#include "tclInt.h"
@@ -16,29 +16,28 @@
#if defined(TCL_THREADS) && defined(USE_THREAD_STORAGE)
/*
- * This is the thread storage cache array and it's accompanying mutex.
- * The elements are pairs of thread Id and an associated hash table
- * pointer; the hash table being pointed to contains the thread storage
- * for it's associated thread. The purpose of this cache is to minimize
- * the number of hash table lookups in the master thread storage hash
- * table.
+ * This is the thread storage cache array and it's accompanying mutex. The
+ * elements are pairs of thread Id and an associated hash table pointer; the
+ * hash table being pointed to contains the thread storage for it's associated
+ * thread. The purpose of this cache is to minimize the number of hash table
+ * lookups in the master thread storage hash table.
*/
static Tcl_Mutex threadStorageLock;
/*
- * This is the struct used for a thread storage cache slot. It contains
- * the owning thread Id and the associated hash table pointer.
+ * This is the struct used for a thread storage cache slot. It contains the
+ * owning thread Id and the associated hash table pointer.
*/
typedef struct ThreadStorage {
- Tcl_ThreadId id; /* the owning thread id */
- Tcl_HashTable *hashTablePtr; /* the hash table for the thread */
+ Tcl_ThreadId id; /* the owning thread id */
+ Tcl_HashTable *hashTablePtr;/* the hash table for the thread */
} ThreadStorage;
/*
- * These are the prototypes for the custom hash table allocation
- * functions used by the thread storage subsystem.
+ * These are the prototypes for the custom hash table allocation functions
+ * used by the thread storage subsystem.
*/
static Tcl_HashEntry * AllocThreadStorageEntry _ANSI_ARGS_((
@@ -51,6 +50,7 @@ static void FreeThreadStorageEntry _ANSI_ARGS_((
* combination with the new hash key type flag TCL_HASH_KEY_SYSTEM_HASH
* because these hash tables MAY be used by the threaded memory allocator.
*/
+
Tcl_HashKeyType tclThreadStorageHashKeyType = {
TCL_HASH_KEY_TYPE_VERSION, /* version */
TCL_HASH_KEY_SYSTEM_HASH, /* flags */
@@ -73,31 +73,30 @@ Tcl_HashKeyType tclThreadStorageHashKeyType = {
#define STORAGE_INVALID_KEY 0
/*
- * This is the first valid key for use by external callers.
- * All the values below this are RESERVED for future use.
+ * This is the first valid key for use by external callers. All the values
+ * below this are RESERVED for future use.
*/
#define STORAGE_FIRST_KEY 101
/*
- * This is the default number of thread storage cache slots.
- * This define may need to be fine tuned for maximum performance.
+ * This is the default number of thread storage cache slots. This define may
+ * need to be fine tuned for maximum performance.
*/
#define STORAGE_CACHE_SLOTS 97
/*
- * This is the master thread storage hash table. It is keyed on
- * thread Id and contains values that are hash tables for each thread.
- * The thread specific hash tables contain the actual thread storage.
+ * This is the master thread storage hash table. It is keyed on thread Id and
+ * contains values that are hash tables for each thread. The thread specific
+ * hash tables contain the actual thread storage.
*/
static Tcl_HashTable *threadStorageHashTablePtr = NULL;
/*
- * This is the next thread data key value to use. We increment this
- * everytime we "allocate" one. It is initially set to 1 in
- * TclThreadStorageInit.
+ * This is the next thread data key value to use. We increment this everytime
+ * we "allocate" one. It is initially set to 1 in TclThreadStorageInit.
*/
static int nextThreadStorageKey = STORAGE_INVALID_KEY;
@@ -109,9 +108,8 @@ static int nextThreadStorageKey = STORAGE_INVALID_KEY;
static int initThreadStorage = 0;
/*
- * This is the master thread storage cache. Per kennykb's idea, this
- * prevents unnecessary lookups for threads that use a lot of thread
- * storage.
+ * This is the master thread storage cache. Per Kevin Kenny's idea, this
+ * prevents unnecessary lookups for threads that use a lot of thread storage.
*/
static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
@@ -121,15 +119,15 @@ static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];
*
* TclThreadStorageLockInit
*
- * This procedure is used to initialize the lock that serializes
- * creation of thread storage.
+ * This procedure is used to initialize the lock that serializes creation
+ * of thread storage.
*
* Results:
* None.
*
* Side effects:
- * The master lock is acquired and possibly initialized for the
- * first time.
+ * The master lock is acquired and possibly initialized for the first
+ * time.
*
*----------------------------------------------------------------------
*/
@@ -139,10 +137,11 @@ TclThreadStorageLockInit()
{
if (!initThreadStorage) {
/*
- * Mutexes in Tcl are self initializing, and we are taking
- * advantage of that fact since this file cannot contain
- * platform specific calls.
+ * Mutexes in Tcl are self initializing, and we are taking advantage
+ * of that fact since this file cannot contain platform specific
+ * calls.
*/
+
initThreadStorage = 1;
}
}
@@ -152,11 +151,11 @@ TclThreadStorageLockInit()
*
* TclThreadStorageLock
*
- * This procedure is used to grab a lock that serializes creation
- * of thread storage.
+ * This procedure is used to grab a lock that serializes creation of
+ * thread storage.
*
- * This lock must be different than the initLock because the
- * initLock is held during creation of syncronization objects.
+ * This lock must be different than the initLock because the initLock is
+ * held during creation of syncronization objects.
*
* Results:
* None.
@@ -179,8 +178,8 @@ TclThreadStorageLock()
*
* TclThreadStorageUnlock
*
- * This procedure is used to release a lock that serializes creation
- * of thread storage.
+ * This procedure is used to release a lock that serializes creation of
+ * thread storage.
*
* Results:
* None.
@@ -202,9 +201,9 @@ TclThreadStorageUnlock()
*
* AllocThreadStorageEntry --
*
- * Allocate space for a Tcl_HashEntry using TclpSysAlloc (not
- * ckalloc). We do this because the threaded memory allocator MAY
- * use the thread storage hash tables.
+ * Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
+ * We do this because the threaded memory allocator MAY use the thread
+ * storage hash tables.
*
* Results:
* The return value is a pointer to the created entry.
@@ -233,9 +232,9 @@ AllocThreadStorageEntry(tablePtr, keyPtr)
*
* FreeThreadStorageEntry --
*
- * Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree).
- * We do this because the threaded memory allocator MAY use the
- * thread storage hash tables.
+ * Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree). We do
+ * this because the threaded memory allocator MAY use the thread storage
+ * hash tables.
*
* Results:
* None.
@@ -258,9 +257,9 @@ FreeThreadStorageEntry(hPtr)
*
* TclThreadStoragePrint --
*
- * This procedure prints out the contents of the master thread
- * storage hash table, the thread storage cache, and the next key
- * value to the specified file.
+ * This procedure prints out the contents of the master thread storage
+ * hash table, the thread storage cache, and the next key value to the
+ * specified file.
*
* This assumes that thread storage lock is held.
*
@@ -303,7 +302,7 @@ TclThreadStoragePrint(outFile, flags)
}
header = 0; /* we have not output the header yet. */
- for (index = 0; index < STORAGE_CACHE_SLOTS; index++) {
+ for (index=0 ; index<STORAGE_CACHE_SLOTS ; index++) {
if (threadStorageCache[index].id != STORAGE_INVALID_THREAD) {
if (!header) {
fprintf(outFile, "thread storage cache (%d total slots):\n",
@@ -314,12 +313,14 @@ TclThreadStoragePrint(outFile, flags)
fprintf(outFile, "slot %d, thread %p, thread table ptr %p\n",
index, threadStorageCache[index].id,
threadStorageCache[index].hashTablePtr);
+
#ifdef VERBOSE_THREAD_STORAGE_DEBUGGING
/*
- * Currently not enabled by default due to Tcl_HashStats
- * use of ckalloc and ckfree. Please note that this can
- * produce a LOT of output.
+ * Currently not enabled by default due to Tcl_HashStats use of
+ * ckalloc and ckfree. Please note that this can produce a LOT of
+ * output.
*/
+
if (threadStorageCache[index].hashTablePtr != NULL) {
CONST char *stats =
Tcl_HashStats(threadStorageCache[index].hashTablePtr);
@@ -333,6 +334,7 @@ TclThreadStoragePrint(outFile, flags)
}
}
#endif
+
} else {
/* fprintf(outFile, "cache slot %d not used\n", index); */
}
@@ -362,12 +364,12 @@ TclThreadStoragePrint(outFile, flags)
* This assumes that thread storage lock is held.
*
* Results:
- * A hash table pointer for the specified thread, or NULL
- * if the hash table has not been created yet.
+ * A hash table pointer for the specified thread, or NULL if the hash
+ * table has not been created yet.
*
* Side effects:
- * May change an entry in the master thread storage cache to point
- * to the specified thread and it's associated hash table.
+ * May change an entry in the master thread storage cache to point to the
+ * specified thread and it's associated hash table.
*
*----------------------------------------------------------------------
*/
@@ -381,9 +383,9 @@ TclThreadStorageGetHashTable(id)
int new;
/*
- * It's important that we pick up the hash table pointer BEFORE
- * comparing thread Id in case another thread is in the critical
- * region changing things out from under you.
+ * It's important that we pick up the hash table pointer BEFORE comparing
+ * thread Id in case another thread is in the critical region changing
+ * things out from under you.
*/
Tcl_HashTable *hashTablePtr = threadStorageCache[index].hashTablePtr;
@@ -408,11 +410,13 @@ TclThreadStorageGetHashTable(id)
/*
* We found it, extract the hash table pointer.
*/
+
hashTablePtr = Tcl_GetHashValue(hPtr);
} else {
/*
* The thread specific hash table is not found.
*/
+
hashTablePtr = NULL;
}
@@ -429,8 +433,7 @@ TclThreadStorageGetHashTable(id)
&tclThreadStorageHashKeyType);
/*
- * Add new thread storage hash table to the master
- * hash table.
+ * Add new thread storage hash table to the master hash table.
*/
hPtr = Tcl_CreateHashEntry(threadStorageHashTablePtr,
@@ -444,17 +447,18 @@ TclThreadStorageGetHashTable(id)
}
/*
- * Now, we put it in the cache since it is highly likely
- * it will be needed again shortly.
+ * Now, we put it in the cache since it is highly likely it will
+ * be needed again shortly.
*/
threadStorageCache[index].id = id;
threadStorageCache[index].hashTablePtr = hashTablePtr;
} else {
/*
- * We cannot look it up, the master hash table has not
- * been initialized.
+ * We cannot look it up, the master hash table has not been
+ * initialized.
*/
+
hashTablePtr = NULL;
}
TclThreadStorageUnlock();
@@ -475,8 +479,8 @@ TclThreadStorageGetHashTable(id)
* This assumes that thread storage lock is held.
*
* Results:
- * A hash table pointer for the specified thread, or NULL if we are
- * be called to initialize the master hash table only.
+ * A hash table pointer for the specified thread, or NULL if we are be
+ * called to initialize the master hash table only.
*
* Side effects:
* The thread specific hash table may be initialized and added to the
@@ -496,8 +500,8 @@ TclThreadStorageInit(id, reserved)
if (threadStorageHashTablePtr == NULL) {
/*
- * Looks like we haven't created the outer hash table yet we
- * can just do that now.
+ * Looks like we haven't created the outer hash table yet we can just
+ * do that now.
*/
threadStorageHashTablePtr = (Tcl_HashTable *)
@@ -531,30 +535,29 @@ TclThreadStorageInit(id, reserved)
*
* TclThreadStorageDataKeyInit --
*
- * This procedure initializes a thread specific data block key.
- * Each thread has table of pointers to thread specific data.
- * all threads agree on which table entry is used by each module.
- * this is remembered in a "data key", that is just an index into
- * this table. To allow self initialization, the interface
- * passes a pointer to this key and the first thread to use
- * the key fills in the pointer to the key. The key should be
- * a process-wide static.
+ * This procedure initializes a thread specific data block key. Each
+ * thread has table of pointers to thread specific data. all threads
+ * agree on which table entry is used by each module. this is remembered
+ * in a "data key", that is just an index into this table. To allow self
+ * initialization, the interface passes a pointer to this key and the
+ * first thread to use the key fills in the pointer to the key. The key
+ * should be a process-wide static.
*
* Results:
* None.
*
* Side effects:
- * Will allocate memory the first time this process calls for
- * this key. In this case it modifies its argument
- * to hold the pointer to information about the key.
+ * Will allocate memory the first time this process calls for this key.
+ * In this case it modifies its argument to hold the pointer to
+ * information about the key.
*
*----------------------------------------------------------------------
*/
void
TclThreadStorageDataKeyInit(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (int **) */
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
+ * (int**) */
{
int *indexPtr;
int newKey;
@@ -566,8 +569,8 @@ TclThreadStorageDataKeyInit(keyPtr)
}
/*
- * We must call this now to make sure that
- * nextThreadStorageKey has a well defined value.
+ * We must call this now to make sure that nextThreadStorageKey has a
+ * well defined value.
*/
TclThreadStorageLock();
@@ -579,11 +582,11 @@ TclThreadStorageDataKeyInit(keyPtr)
TclThreadStorageInit(STORAGE_INVALID_THREAD, NULL);
/*
- * These data key values are sequentially assigned and we must
- * use the storage lock to prevent serious problems here.
- * Also note that the caller should NOT make any assumptions
- * about the provided values. In particular, we may need to
- * reserve some values in the future.
+ * These data key values are sequentially assigned and we must use the
+ * storage lock to prevent serious problems here. Also note that the
+ * caller should NOT make any assumptions about the provided
+ * values. In particular, we may need to reserve some values in the
+ * future.
*/
newKey = nextThreadStorageKey++;
@@ -603,8 +606,8 @@ TclThreadStorageDataKeyInit(keyPtr)
* This procedure returns a pointer to a block of thread local storage.
*
* Results:
- * A thread-specific pointer to the data structure, or NULL
- * if the memory has not been assigned to this key for this thread.
+ * A thread-specific pointer to the data structure, or NULL if the memory
+ * has not been assigned to this key for this thread.
*
* Side effects:
* None.
@@ -614,8 +617,8 @@ TclThreadStorageDataKeyInit(keyPtr)
void *
TclThreadStorageDataKeyGet(keyPtr)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (int **) */
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
+ * (int**) */
{
int *indexPtr = *(int **)keyPtr;
@@ -631,12 +634,12 @@ TclThreadStorageDataKeyGet(keyPtr)
"TclThreadStorageDataKeyGet!");
}
- hPtr = Tcl_FindHashEntry(hashTablePtr, (char *)*indexPtr);
+ hPtr = Tcl_FindHashEntry(hashTablePtr, (char *) *indexPtr);
if (hPtr == NULL) {
return NULL;
}
- return (void *)Tcl_GetHashValue(hPtr);
+ return (void *) Tcl_GetHashValue(hPtr);
}
}
@@ -651,16 +654,16 @@ TclThreadStorageDataKeyGet(keyPtr)
* None.
*
* Side effects:
- * Sets up the thread so future calls to TclThreadStorageDataKeyGet
- * with this key will return the data pointer.
+ * Sets up the thread so future calls to TclThreadStorageDataKeyGet with
+ * this key will return the data pointer.
*
*----------------------------------------------------------------------
*/
void
TclThreadStorageDataKeySet(keyPtr, data)
- Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
- * really (pthread_key_t **) */
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk, really
+ * (pthread_key_t **) */
void *data; /* Thread local storage */
{
int *indexPtr = *(int **)keyPtr;
@@ -678,8 +681,10 @@ TclThreadStorageDataKeySet(keyPtr, data)
/*
* Does the item need to be created?
*/
+
if (hPtr == NULL) {
int new;
+
hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)*indexPtr, &new);
if (hPtr == NULL) {
Tcl_Panic("could not create hash entry value from "
@@ -709,12 +714,12 @@ TclThreadStorageDataKeySet(keyPtr, data)
void
TclFinalizeThreadStorageThread(id)
- Tcl_ThreadId id; /* Id of the thread to finalize */
+ Tcl_ThreadId id; /* Id of the thread to finalize. */
{
int index = (unsigned int)id % STORAGE_CACHE_SLOTS;
- Tcl_HashTable *hashTablePtr; /* Hash table for current thread */
+ Tcl_HashTable *hashTablePtr;/* Hash table for current thread. */
Tcl_HashEntry *hPtr; /* Hash entry for current thread in master
- * table */
+ * table. */
TclThreadStorageLock();
@@ -730,8 +735,7 @@ TclFinalizeThreadStorageThread(id)
if (hashTablePtr != NULL) {
/*
- * Delete thread specific hash table and free the
- * struct.
+ * Delete thread specific hash table and free the struct.
*/
Tcl_DeleteHashTable(hashTablePtr);
@@ -752,9 +756,8 @@ TclFinalizeThreadStorageThread(id)
if (threadStorageCache[index].id == id) {
/*
- * We do not step on another thread's cache entry. This is
- * especially important if we are creating and exiting a lot
- * of threads.
+ * We do not step on another thread's cache entry. This is especially
+ * important if we are creating and exiting a lot of threads.
*/
threadStorageCache[index].id = STORAGE_INVALID_THREAD;
@@ -769,8 +772,8 @@ TclFinalizeThreadStorageThread(id)
*
* TclFinalizeThreadStorage --
*
- * This procedure cleans up the master thread storage hash table,
- * all thread specific hash tables, and the thread storage cache.
+ * This procedure cleans up the master thread storage hash table, all
+ * thread specific hash tables, and the thread storage cache.
*
* Results:
* None.
@@ -794,9 +797,9 @@ TclFinalizeThreadStorage()
* master table. */
/*
- * We are going to delete the hash table for every thread now.
- * This hash table should be empty at this point, except for
- * one entry for the current thread.
+ * We are going to delete the hash table for every thread now. This
+ * hash table should be empty at this point, except for one entry for
+ * the current thread.
*/
for (hPtr = Tcl_FirstHashEntry(threadStorageHashTablePtr, &search);
@@ -838,8 +841,8 @@ TclFinalizeThreadStorage()
sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
/*
- * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the
- * thread storage subsystem gets reinitialized
+ * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
+ * storage subsystem gets reinitialized
*/
nextThreadStorageKey = STORAGE_INVALID_KEY;
@@ -852,8 +855,8 @@ TclFinalizeThreadStorage()
*
* TclFinalizeThreadStorageData --
*
- * This procedure cleans up the thread-local storage. This is
- * called once for each thread.
+ * This procedure cleans up the thread-local storage. This is called
+ * once for each thread.
*
* Results:
* None.
@@ -870,7 +873,7 @@ TclFinalizeThreadStorageData(keyPtr)
{
if (*keyPtr != NULL) {
Tcl_ThreadId id = Tcl_GetCurrentThread();
- Tcl_HashTable *hashTablePtr; /* Hash table for current thread */
+ Tcl_HashTable *hashTablePtr; /* Hash table for current thread. */
Tcl_HashEntry *hPtr; /* Hash entry for data key in current
* thread. */
int *indexPtr = *(int **)keyPtr;
@@ -887,9 +890,10 @@ TclFinalizeThreadStorageData(keyPtr)
if (result != NULL) {
/*
- * This must be ckfree because tclThread.c allocates
- * these using ckalloc.
+ * This must be ckfree because tclThread.c allocates these
+ * using ckalloc.
*/
+
ckfree((char *)result);
}
@@ -903,9 +907,9 @@ TclFinalizeThreadStorageData(keyPtr)
*
* TclFinalizeThreadStorageDataKey --
*
- * This procedure is invoked to clean up one key. This is a
- * process-wide storage identifier. The thread finalization code
- * cleans up the thread local storage itself.
+ * This procedure is invoked to clean up one key. This is a process-wide
+ * storage identifier. The thread finalization code cleans up the thread
+ * local storage itself.
*
* This assumes the master lock is held.
*
@@ -923,7 +927,7 @@ TclFinalizeThreadStorageDataKey(keyPtr)
Tcl_ThreadDataKey *keyPtr;
{
int *indexPtr;
- Tcl_HashTable *hashTablePtr;/* Hash table for current thread */
+ Tcl_HashTable *hashTablePtr;/* Hash table for current thread. */
Tcl_HashSearch search; /* Need to hit every thread with this search */
Tcl_HashEntry *hPtr; /* Hash entry for current thread in master
* table. */
@@ -936,22 +940,23 @@ TclFinalizeThreadStorageDataKey(keyPtr)
if (threadStorageHashTablePtr != NULL) {
/*
- * We are going to delete the specified data key entry
- * from every thread.
+ * We are going to delete the specified data key entry from every
+ * thread.
*/
for (hPtr = Tcl_FirstHashEntry(threadStorageHashTablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-
/*
* Get the hash table corresponding to the thread in question.
*/
+
hashTablePtr = Tcl_GetHashValue(hPtr);
if (hashTablePtr != NULL) {
/*
* Now find the entry for the specified data key.
*/
+
hDataPtr = Tcl_FindHashEntry(hashTablePtr,
(char *)*indexPtr);
@@ -959,6 +964,7 @@ TclFinalizeThreadStorageDataKey(keyPtr)
/*
* Delete the data key for this thread.
*/
+
Tcl_DeleteHashEntry(hDataPtr);
}
}
@@ -981,15 +987,14 @@ static void ThreadStoragePanic _ANSI_ARGS_((CONST char *message));
*
* ThreadStoragePanic --
*
- * Panic if Tcl was compiled without TCL_THREADS or without
- * USE_THREAD_STORAGE and a thread storage function has been
- * called.
+ * Panic if Tcl was compiled without TCL_THREADS or without
+ * USE_THREAD_STORAGE and a thread storage function has been called.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -999,10 +1004,9 @@ static void ThreadStoragePanic(message)
#ifdef TCL_THREADS
# ifdef USE_THREAD_STORAGE
/*
- * Do nothing, everything is OK. However, this should never happen
- * because this function only gets called by the dummy thread
- * storage functions (used when one or both of these DEFINES are
- * not present).
+ * Do nothing, everything is OK. However, this should never happen because
+ * this function only gets called by the dummy thread storage functions
+ * (used when one or both of these DEFINES are not present).
*/
# else
Tcl_Panic("Tcl was not compiled with thread storage enabled.");
@@ -1110,3 +1114,11 @@ TclFinalizeThreadStorageDataKey(keyPtr)
}
#endif /* defined(TCL_THREADS) && defined(USE_THREAD_STORAGE) */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */