summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclAlloc.c52
-rw-r--r--generic/tclCkalloc.c292
-rw-r--r--generic/tclClock.c299
-rw-r--r--generic/tclConfig.c54
-rw-r--r--generic/tclDictObj.c1049
-rw-r--r--generic/tclEnv.c148
-rw-r--r--generic/tclEvent.c497
-rw-r--r--generic/tclFCmd.c157
-rw-r--r--generic/tclIOCmd.c415
-rw-r--r--generic/tclIOGT.c359
-rw-r--r--generic/tclIOUtil.c1749
-rw-r--r--generic/tclIndexObj.c105
-rw-r--r--generic/tclLiteral.c190
-rw-r--r--generic/tclMain.c89
14 files changed, 2761 insertions, 2694 deletions
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index fcdd75d..b51084d 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAlloc.c,v 1.22 2005/07/19 22:45:18 dkf Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.23 2005/11/01 15:30:52 dkf Exp $
*/
/*
@@ -67,7 +67,7 @@ union overhead {
unsigned long size; /* actual block size */
unsigned short unused2; /* padding to 8-byte align */
#endif
- } ovu;
+ } ovu;
#define overMagic0 ovu.magic0
#define overMagic1 ovu.magic1
#define bucketIndex ovu.index
@@ -156,7 +156,7 @@ static unsigned int numMallocs[NBUCKETS+1];
* Prototypes for functions used only in this file.
*/
-static void MoreCore _ANSI_ARGS_((int bucket));
+static void MoreCore(int bucket);
/*
*-------------------------------------------------------------------------
@@ -175,7 +175,7 @@ static void MoreCore _ANSI_ARGS_((int bucket));
*/
void
-TclInitAlloc()
+TclInitAlloc(void)
{
if (!allocInit) {
allocInit = 1;
@@ -209,7 +209,7 @@ TclInitAlloc()
*/
void
-TclFinalizeAllocSubsystem()
+TclFinalizeAllocSubsystem(void)
{
int i;
struct block *blockPtr, *nextPtr;
@@ -258,8 +258,8 @@ TclFinalizeAllocSubsystem()
*/
char *
-TclpAlloc(numBytes)
- unsigned int numBytes; /* Number of bytes to allocate. */
+TclpAlloc(
+ unsigned int numBytes) /* Number of bytes to allocate. */
{
register union overhead *overPtr;
register long bucket;
@@ -269,7 +269,7 @@ 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!
+ * used before any other part of Tcl. E.g., see main() for tclsh!
*/
TclInitAlloc();
@@ -395,8 +395,8 @@ TclpAlloc(numBytes)
*/
static void
-MoreCore(bucket)
- int bucket; /* What bucket to allocat to. */
+MoreCore(
+ int bucket) /* What bucket to allocat to. */
{
register union overhead *overPtr;
register long size; /* size of desired block */
@@ -436,7 +436,7 @@ MoreCore(bucket)
overPtr->next = (union overhead *)((caddr_t)overPtr + size);
overPtr = (union overhead *)((caddr_t)overPtr + size);
}
- overPtr->next = (union overhead *)NULL;
+ overPtr->next = NULL;
}
/*
@@ -456,8 +456,8 @@ MoreCore(bucket)
*/
void
-TclpFree(oldPtr)
- char *oldPtr; /* Pointer to memory to free. */
+TclpFree(
+ char *oldPtr) /* Pointer to memory to free. */
{
register long size;
register union overhead *overPtr;
@@ -521,9 +521,9 @@ TclpFree(oldPtr)
*/
char *
-TclpRealloc(oldPtr, numBytes)
- char *oldPtr; /* Pointer to alloced block. */
- unsigned int numBytes; /* New size of memory. */
+TclpRealloc(
+ char *oldPtr, /* Pointer to alloced block. */
+ unsigned int numBytes) /* New size of memory. */
{
int i;
union overhead *overPtr;
@@ -653,8 +653,8 @@ TclpRealloc(oldPtr, numBytes)
#ifdef MSTATS
void
-mstats(s)
- char *s; /* Where to write info. */
+mstats(
+ char *s) /* Where to write info. */
{
register int i, j;
register union overhead *overPtr;
@@ -685,7 +685,7 @@ mstats(s)
}
#endif
-#else /* !USE_TCLALLOC */
+#else /* !USE_TCLALLOC */
/*
*----------------------------------------------------------------------
@@ -704,8 +704,8 @@ mstats(s)
*/
char *
-TclpAlloc(numBytes)
- unsigned int numBytes; /* Number of bytes to allocate. */
+TclpAlloc(
+ unsigned int numBytes) /* Number of bytes to allocate. */
{
return (char*) malloc(numBytes);
}
@@ -727,8 +727,8 @@ TclpAlloc(numBytes)
*/
void
-TclpFree(oldPtr)
- char *oldPtr; /* Pointer to memory to free. */
+TclpFree(
+ char *oldPtr) /* Pointer to memory to free. */
{
free(oldPtr);
return;
@@ -751,9 +751,9 @@ TclpFree(oldPtr)
*/
char *
-TclpRealloc(oldPtr, numBytes)
- char *oldPtr; /* Pointer to alloced block. */
- unsigned int numBytes; /* New size of memory. */
+TclpRealloc(
+ char *oldPtr, /* Pointer to alloced block. */
+ unsigned int numBytes) /* New size of memory. */
{
return (char*) realloc(oldPtr, numBytes);
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index e3eea4e..d04b45a 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -14,7 +14,7 @@
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.25 2005/09/15 16:40:02 dgp Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.26 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -33,7 +33,7 @@ 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
+ * needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
@@ -78,7 +78,7 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
/*
* 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
+ * mem_header. It is used to get back to the header pointer from the body
* pointer that's used by clients.
*/
@@ -93,17 +93,17 @@ static int current_malloc_packets = 0;
static int maximum_malloc_packets = 0;
static int break_on_malloc = 0;
static int trace_on_at_malloc = 0;
-static int alloc_tracing = FALSE;
-static int init_malloced_bodies = TRUE;
+static int alloc_tracing = FALSE;
+static int init_malloced_bodies = TRUE;
#ifdef MEM_VALIDATE
- static int validate_memory = TRUE;
+static int validate_memory = TRUE;
#else
- static int validate_memory = FALSE;
+static int validate_memory = FALSE;
#endif
/*
* The following variable indicates to TclFinalizeMemorySubsystem() that it
- * should dump out the state of memory before exiting. If the value is
+ * 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.
*/
@@ -115,8 +115,8 @@ 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
+ * 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...
*/
@@ -127,20 +127,19 @@ static int ckallocInit = 0;
* Prototypes for procedures defined in this file:
*/
-static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char *argv[]));
-static int MemoryCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv));
-static void ValidateMemory _ANSI_ARGS_((
- struct mem_header *memHeaderP, CONST char *file,
- int line, int nukeGuards));
+static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST char *argv[]);
+static int MemoryCmd(ClientData clientData, Tcl_Interp *interp,
+ int argc, CONST char *argv[]);
+static void ValidateMemory(struct mem_header *memHeaderP,
+ CONST char *file, int line, int nukeGuards);
/*
*----------------------------------------------------------------------
*
* TclInitDbCkalloc --
*
- * Initialize the locks used by the allocator. This is only appropriate
+ * Initialize the locks used by the allocator. This is only appropriate
* to call in a single threaded environment, such as during
* TclInitSubsystems.
*
@@ -148,7 +147,7 @@ static void ValidateMemory _ANSI_ARGS_((
*/
void
-TclInitDbCkalloc()
+TclInitDbCkalloc(void)
{
if (!ckallocInit) {
ckallocInit = 1;
@@ -167,8 +166,8 @@ TclInitDbCkalloc()
*/
void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+TclDumpMemoryInfo(
+ FILE *outFile)
{
fprintf(outFile,"total mallocs %10d\n",
total_mallocs);
@@ -202,15 +201,16 @@ TclDumpMemoryInfo(outFile)
*/
static void
-ValidateMemory(memHeaderP, file, line, nukeGuards)
- struct mem_header *memHeaderP; /* Memory chunk to validate */
- CONST char *file; /* File containing the call to
- * Tcl_ValidateAllMemory */
- int line; /* Line number of call to
- * Tcl_ValidateAllMemory */
- int nukeGuards; /* If non-zero, indicates that the
- * memory guards are to be reset to 0
- * after they have been printed */
+ValidateMemory(
+ struct mem_header *memHeaderP,
+ /* Memory chunk to validate */
+ CONST char *file, /* File containing the call to
+ * Tcl_ValidateAllMemory */
+ int line, /* Line number of call to
+ * Tcl_ValidateAllMemory */
+ int nukeGuards) /* If non-zero, indicates that the memory
+ * guards are to be reset to 0 after they have
+ * been printed */
{
unsigned char *hiPtr;
int idx;
@@ -231,7 +231,7 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
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. */
+ 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");
@@ -253,7 +253,7 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
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. */
+ fflush(stderr); /* In case name pointer is bad. */
fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
@@ -284,10 +284,10 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
*/
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file; /* File from which Tcl_ValidateAllMemory was
+Tcl_ValidateAllMemory(
+ CONST char *file, /* File from which Tcl_ValidateAllMemory was
* called. */
- int line; /* Line number of call to
+ int line) /* Line number of call to
* Tcl_ValidateAllMemory */
{
struct mem_header *memScanP;
@@ -318,8 +318,8 @@ Tcl_ValidateAllMemory(file, line)
*/
int
-Tcl_DumpActiveMemory (fileName)
- CONST char *fileName; /* Name of the file to write info to */
+Tcl_DumpActiveMemory(
+ CONST char *fileName) /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
@@ -371,10 +371,10 @@ Tcl_DumpActiveMemory (fileName)
*/
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ unsigned int size,
+ CONST char *file,
+ int line)
{
struct mem_header *result;
@@ -460,12 +460,12 @@ Tcl_DbCkalloc(size, file, line)
return result->body;
}
-
+
char *
-Tcl_AttemptDbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ unsigned int size,
+ CONST char *file,
+ int line)
{
struct mem_header *result;
@@ -570,10 +570,10 @@ Tcl_AttemptDbCkalloc(size, file, line)
*/
int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+Tcl_DbCkfree(
+ char *ptr,
+ CONST char *file,
+ int line)
{
struct mem_header *memp;
@@ -650,11 +650,11 @@ Tcl_DbCkfree(ptr, file, line)
*/
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *new;
unsigned int copySize;
@@ -679,13 +679,13 @@ Tcl_DbCkrealloc(ptr, size, file, line)
Tcl_DbCkfree(ptr, file, line);
return new;
}
-
+
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *new;
unsigned int copySize;
@@ -739,37 +739,37 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
#undef Tcl_AttemptRealloc
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
return Tcl_DbCkalloc(size, "unknown", 0);
}
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}
void
-Tcl_Free(ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
Tcl_DbCkfree(ptr, "unknown", 0);
}
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}
@@ -798,26 +798,26 @@ Tcl_AttemptRealloc(ptr, size)
*/
/* ARGSUSED */
static int
-MemoryCmd(clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- CONST char **argv;
+MemoryCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int argc,
+ CONST char *argv[])
{
CONST char *fileName;
Tcl_DString buffer;
int result;
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option [args..]\"", (char *) NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option [args..]\"", NULL);
return TCL_ERROR;
}
if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " ", argv[1], " file\"", (char *) NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " file\"", NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -827,8 +827,7 @@ MemoryCmd(clientData, interp, argc, argv)
result = Tcl_DumpActiveMemory (fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
- (char *) NULL);
+ Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -862,8 +861,8 @@ MemoryCmd(clientData, interp, argc, argv)
}
if (strcmp(argv[1],"onexit") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " onexit file\"", (char *) NULL);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " onexit file\"", NULL);
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -878,7 +877,7 @@ MemoryCmd(clientData, interp, argc, argv)
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " tag string\"", (char *) NULL);
+ " tag string\"", NULL);
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -916,17 +915,17 @@ MemoryCmd(clientData, interp, argc, argv)
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": should be active, break_on_malloc, info, init, onexit, ",
- "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
+ "tag, trace, trace_on_at_malloc, or validate", NULL);
return TCL_ERROR;
argError:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " count\"", (char *) NULL);
+ " ", argv[1], " count\"", NULL);
return TCL_ERROR;
bad_suboption:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " on|off\"", (char *) NULL);
+ " ", argv[1], " on|off\"", NULL);
return TCL_ERROR;
}
@@ -949,15 +948,15 @@ MemoryCmd(clientData, interp, argc, argv)
*/
static int
-CheckmemCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter for evaluation. */
- int argc; /* Number of arguments. */
- CONST char *argv[]; /* String values of arguments. */
+CheckmemCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter for evaluation. */
+ int argc, /* Number of arguments. */
+ CONST char *argv[]) /* String values of arguments. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", (char *) NULL);
+ " fileName\"", NULL);
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
@@ -982,14 +981,13 @@ CheckmemCmd(clientData, interp, argc, argv)
*/
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp; /* Interpreter in which commands should be added */
+Tcl_InitMemory(
+ Tcl_Interp *interp) /* Interpreter in which commands should be
+ * added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
- (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
}
@@ -1014,8 +1012,8 @@ Tcl_InitMemory(interp)
*/
char *
-Tcl_Alloc(size)
- unsigned int size;
+Tcl_Alloc(
+ unsigned int size)
{
char *result;
@@ -1023,7 +1021,7 @@ Tcl_Alloc(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
+ * 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).
*
@@ -1038,10 +1036,10 @@ Tcl_Alloc(size)
}
char *
-Tcl_DbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkalloc(
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
@@ -1066,8 +1064,8 @@ Tcl_DbCkalloc(size, file, line)
*/
char *
-Tcl_AttemptAlloc(size)
- unsigned int size;
+Tcl_AttemptAlloc(
+ unsigned int size)
{
char *result;
@@ -1076,10 +1074,10 @@ Tcl_AttemptAlloc(size)
}
char *
-Tcl_AttemptDbCkalloc(size, file, line)
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkalloc(
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
@@ -1099,9 +1097,9 @@ Tcl_AttemptDbCkalloc(size, file, line)
*/
char *
-Tcl_Realloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_Realloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1114,11 +1112,11 @@ Tcl_Realloc(ptr, size)
}
char *
-Tcl_DbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_DbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
@@ -1143,9 +1141,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)
*/
char *
-Tcl_AttemptRealloc(ptr, size)
- char *ptr;
- unsigned int size;
+Tcl_AttemptRealloc(
+ char *ptr,
+ unsigned int size)
{
char *result;
@@ -1154,11 +1152,11 @@ Tcl_AttemptRealloc(ptr, size)
}
char *
-Tcl_AttemptDbCkrealloc(ptr, size, file, line)
- char *ptr;
- unsigned int size;
- CONST char *file;
- int line;
+Tcl_AttemptDbCkrealloc(
+ char *ptr,
+ unsigned int size,
+ CONST char *file,
+ int line)
{
char *result;
@@ -1179,17 +1177,17 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*/
void
-Tcl_Free(ptr)
- char *ptr;
+Tcl_Free(
+ char *ptr)
{
TclpFree(ptr);
}
int
-Tcl_DbCkfree(ptr, file, line)
- char *ptr;
- CONST char *file;
- int line;
+Tcl_DbCkfree(
+ char *ptr,
+ CONST char *file,
+ int line)
{
TclpFree(ptr);
return 0;
@@ -1207,28 +1205,28 @@ Tcl_DbCkfree(ptr, file, line)
*/
/* ARGSUSED */
void
-Tcl_InitMemory(interp)
- Tcl_Interp *interp;
+Tcl_InitMemory(
+ Tcl_Interp *interp)
{
}
int
-Tcl_DumpActiveMemory(fileName)
- CONST char *fileName;
+Tcl_DumpActiveMemory(
+ CONST char *fileName)
{
return TCL_OK;
}
void
-Tcl_ValidateAllMemory(file, line)
- CONST char *file;
- int line;
+Tcl_ValidateAllMemory(
+ CONST char *file,
+ int line)
{
}
void
-TclDumpMemoryInfo(outFile)
- FILE *outFile;
+TclDumpMemoryInfo(
+ FILE *outFile)
{
}
@@ -1254,7 +1252,7 @@ TclDumpMemoryInfo(outFile)
*/
void
-TclFinalizeMemorySubsystem()
+TclFinalizeMemorySubsystem(void)
{
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
diff --git a/generic/tclClock.c b/generic/tclClock.c
index c5a851e..71dec02 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1,24 +1,24 @@
-/*
+/*
* tclClock.c --
*
- * Contains the time and date related commands. This code
- * is derived from the time and date facilities of TclX,
- * by Mark Diekhans and Karl Lehenbauer.
+ * Contains the time and date related commands. This code is derived from
+ * the time and date facilities of TclX, by Mark Diekhans and Karl
+ * Lehenbauer.
*
* Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995 Sun Microsystems, Inc.
* Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
*
- * 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: tclClock.c,v 1.41 2005/10/19 18:39:58 dgp Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.42 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
/*
- * Windows has mktime. The configurators do not check.
+ * Windows has mktime. The configurators do not check.
*/
#ifdef __WIN32__
@@ -26,15 +26,15 @@
#endif
/*
- * Thread specific data block holding a 'struct tm' for the 'gmtime'
- * and 'localtime' library calls.
+ * Thread specific data block holding a 'struct tm' for the 'gmtime' and
+ * 'localtime' library calls.
*/
static Tcl_ThreadDataKey tmKey;
/*
- * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls
- * and the statics in the date parsing code.
+ * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
+ * in the date parsing code.
*/
TCL_DECLARE_MUTEX(clockMutex)
@@ -43,8 +43,8 @@ TCL_DECLARE_MUTEX(clockMutex)
* Function prototypes for local procedures in this file:
*/
-static struct tm* ThreadSafeLocalTime _ANSI_ARGS_(( CONST time_t* ));
-static void TzsetIfNecessary _ANSI_ARGS_(( void ));
+static struct tm * ThreadSafeLocalTime(CONST time_t *);
+static void TzsetIfNecessary(void);
/*
*----------------------------------------------------------------------
@@ -69,26 +69,28 @@ static void TzsetIfNecessary _ANSI_ARGS_(( void ));
*/
int
-TclClockGetenvObjCmd( ClientData clientData,
- Tcl_Interp* interp,
- int objc,
- Tcl_Obj *CONST objv[] )
+TclClockGetenvObjCmd(
+ ClientData clientData,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[])
{
CONST char* varName;
CONST char* varValue;
- if ( objc != 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "name" );
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- varName = Tcl_GetStringFromObj( objv[1], NULL );
- varValue = getenv( varName );
- if ( varValue == NULL ) {
- Tcl_SetObjResult( interp,
- Tcl_NewStringObj( "variable not found", -1 ) );
+ varName = Tcl_GetStringFromObj(objv[1], NULL);
+ varValue = getenv(varName);
+ if (varValue == NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("variable not found", -1));
return TCL_ERROR;
} else {
- Tcl_SetObjResult( interp, Tcl_NewStringObj( varValue, -1 ) );
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
return TCL_OK;
}
}
@@ -108,6 +110,7 @@ TclClockGetenvObjCmd( ClientData clientData,
* <tick> -- A count of seconds from the Posix epoch.
*
* Results:
+
* Returns a standard Tcl result. The object result is a Tcl
* list containing the year, month, day, hour, minute, and second
* fields of the local time. It may return an error if the
@@ -128,14 +131,11 @@ TclClockGetenvObjCmd( ClientData clientData,
*/
int
-TclClockLocaltimeObjCmd( ClientData clientData,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Parameter count */
- Tcl_Obj* CONST* objv )
- /* Parameter vector */
+TclClockLocaltimeObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj* CONST* objv) /* Parameter vector */
{
Tcl_WideInt tick; /* Time to convert */
time_t tock;
@@ -143,49 +143,50 @@ TclClockLocaltimeObjCmd( ClientData clientData,
Tcl_Obj* returnVec[ 6 ];
- /* Check args */
+ /*
+ * Check args
+ */
- if ( objc != 2 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "seconds" );
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "seconds");
return TCL_ERROR;
}
- if ( Tcl_GetWideIntFromObj( interp, objv[1], &tick ) != TCL_OK ) {
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &tick) != TCL_OK) {
return TCL_ERROR;
}
- /* Convert the time, checking for overflow */
+ /*
+ * Convert the time, checking for overflow
+ */
tock = (time_t) tick;
- if ( (Tcl_WideInt) tock != tick ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj("number too large to represent as a Posix time",
- -1) );
- Tcl_SetErrorCode( interp, "CLOCK", "argTooLarge", (char*) NULL );
+ if ((Tcl_WideInt) tock != tick) {
+ Tcl_AppendResult(interp,
+ "number too large to represent as a Posix time", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
return TCL_ERROR;
}
TzsetIfNecessary();
- timeVal = ThreadSafeLocalTime( &tock );
- if ( timeVal == NULL ) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("localtime failed (clock "
- "value may be too large/"
- "small to represent)", -1));
- Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char*) NULL);
+ timeVal = ThreadSafeLocalTime(&tock);
+ if (timeVal == NULL) {
+ Tcl_AppendResult(interp, "localtime failed (clock value may be too ",
+ "large/small to represent)", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
return TCL_ERROR;
}
- /* Package the results */
+ /*
+ * Package the results.
+ */
- returnVec[0] = Tcl_NewIntObj( timeVal->tm_year + 1900 );
- returnVec[1] = Tcl_NewIntObj( timeVal->tm_mon + 1);
- returnVec[2] = Tcl_NewIntObj( timeVal->tm_mday );
- returnVec[3] = Tcl_NewIntObj( timeVal->tm_hour );
- returnVec[4] = Tcl_NewIntObj( timeVal->tm_min );
- returnVec[5] = Tcl_NewIntObj( timeVal->tm_sec );
- Tcl_SetObjResult( interp, Tcl_NewListObj( 6, returnVec ) );
+ returnVec[0] = Tcl_NewIntObj(timeVal->tm_year + 1900);
+ returnVec[1] = Tcl_NewIntObj(timeVal->tm_mon + 1);
+ returnVec[2] = Tcl_NewIntObj(timeVal->tm_mday);
+ returnVec[3] = Tcl_NewIntObj(timeVal->tm_hour);
+ returnVec[4] = Tcl_NewIntObj(timeVal->tm_min);
+ returnVec[5] = Tcl_NewIntObj(timeVal->tm_sec);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(6, returnVec));
return TCL_OK;
-
}
/*
@@ -206,8 +207,8 @@ TclClockLocaltimeObjCmd( ClientData clientData,
*/
static struct tm *
-ThreadSafeLocalTime(timePtr)
- CONST time_t *timePtr; /* Pointer to the number of seconds since the
+ThreadSafeLocalTime(
+ CONST time_t *timePtr) /* Pointer to the number of seconds since the
* local system's epoch */
{
/*
@@ -239,8 +240,7 @@ ThreadSafeLocalTime(timePtr)
*
* TclClockMktimeObjCmd --
*
- * Determine seconds from the epoch, given the fields of a local
- * time.
+ * Determine seconds from the epoch, given the fields of a local time.
*
* Usage:
* mktime <year> <month> <day> <hour> <minute> <second>
@@ -257,8 +257,8 @@ ThreadSafeLocalTime(timePtr)
* Returns the given local time.
*
* Errors:
- * Returns an error if the 'mktime' function does not exist in the
- * C library, or if the given time cannot be converted.
+ * Returns an error if the 'mktime' function does not exist in the C
+ * library, or if the given time cannot be converted.
*
* Side effects:
* None.
@@ -267,18 +267,14 @@ ThreadSafeLocalTime(timePtr)
*/
int
-TclClockMktimeObjCmd( ClientData clientData,
- /* Unused */
- Tcl_Interp* interp,
- /* Tcl interpreter */
- int objc,
- /* Parameter count */
- Tcl_Obj* CONST* objv )
- /* Parameter vector */
+TclClockMktimeObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *CONST *objv) /* Parameter vector */
{
#ifndef HAVE_MKTIME
- Tcl_SetObjResult( interp,
- Tcl_NewStringObj( "cannot determine local time", -1 ) );
+ Tcl_AppendResult(interp, "cannot determine local time", NULL);
return TCL_ERROR;
#else
@@ -287,34 +283,35 @@ TclClockMktimeObjCmd( ClientData clientData,
time_t convertedTime; /* Time converted from mktime */
int localErrno;
- /* Convert parameters */
+ /*
+ * Convert parameters
+ */
- if ( objc != 7 ) {
- Tcl_WrongNumArgs( interp, 1, objv,
- "year month day hour minute second" );
+ if (objc != 7) {
+ Tcl_WrongNumArgs(interp, 1, objv, "year month day hour minute second");
return TCL_ERROR;
}
- if ( Tcl_GetIntFromObj( interp, objv[1], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_year = i - 1900;
- if ( Tcl_GetIntFromObj( interp, objv[2], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_mon = i - 1;
- if ( Tcl_GetIntFromObj( interp, objv[3], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_mday = i;
- if ( Tcl_GetIntFromObj( interp, objv[4], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[4], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_hour = i;
- if ( Tcl_GetIntFromObj( interp, objv[5], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[5], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_min = i;
- if ( Tcl_GetIntFromObj( interp, objv[6], &i ) != TCL_OK ) {
+ if (Tcl_GetIntFromObj(interp, objv[6], &i) != TCL_OK) {
return TCL_ERROR;
}
toConvert.tm_sec = i;
@@ -322,34 +319,31 @@ TclClockMktimeObjCmd( ClientData clientData,
toConvert.tm_wday = -1;
toConvert.tm_yday = -1;
- /* Convert the time. It is rumored that mktime is not thread
- * safe on some platforms. */
+ /*
+ * Convert the time. It is rumored that mktime is not thread safe on some
+ * platforms.
+ */
TzsetIfNecessary();
- Tcl_MutexLock( &clockMutex );
+ Tcl_MutexLock(&clockMutex);
errno = 0;
- convertedTime = mktime( &toConvert );
+ convertedTime = mktime(&toConvert);
localErrno = errno;
- Tcl_MutexUnlock( &clockMutex );
+ Tcl_MutexUnlock(&clockMutex);
- /* Return the converted time, or an error if conversion fails */
+ /*
+ * Return the converted time, or an error if conversion fails.
+ */
- if ( localErrno != 0
- || ( convertedTime == -1
- && toConvert.tm_yday == -1 ) ) {
- Tcl_SetObjResult
- ( interp,
- Tcl_NewStringObj( "time value too large/small to represent",
- -1 ) );
+ if (localErrno != 0 || (convertedTime == -1 && toConvert.tm_yday == -1)) {
+ Tcl_AppendResult(interp, "time value too large/small to represent",
+ NULL);
return TCL_ERROR;
- } else {
- Tcl_SetObjResult( interp,
- Tcl_NewWideIntObj( (Tcl_WideInt) convertedTime ) );
- return TCL_OK;
}
-#endif
-
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) convertedTime));
+ return TCL_OK;
+#endif /* HAVE_MKTIME */
}
/*----------------------------------------------------------------------
@@ -364,21 +358,21 @@ TclClockMktimeObjCmd( ClientData clientData,
* Side effects:
* None.
*
- * This function implements the 'clock clicks' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock clicks' Tcl command. Refer to the user
+ * documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockClicksObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+TclClockClicksObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj* CONST* objv) /* Parameter values */
{
static CONST char *clicksSwitches[] = {
- "-milliseconds", "-microseconds", (char*) NULL
+ "-milliseconds", "-microseconds", NULL
};
enum ClicksSwitch {
CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
@@ -432,20 +426,21 @@ TclClockClicksObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock milliseconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock milliseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockMillisecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+TclClockMillisecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj* CONST* objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -468,20 +463,21 @@ TclClockMillisecondsObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock microseconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock microseconds' Tcl command. Refer to the
+ * user documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+TclClockMicrosecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj* CONST* objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -504,20 +500,21 @@ TclClockMicrosecondsObjCmd(clientData, interp, objc, objv)
* Side effects:
* None.
*
- * This function implements the 'clock seconds' Tcl command. Refer
- * to the user documentation for details on what it does.
+ * This function implements the 'clock seconds' Tcl command. Refer to the user
+ * documentation for details on what it does.
*
*----------------------------------------------------------------------
*/
int
-TclClockSecondsObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Client data is unused */
- Tcl_Interp* interp; /* Tcl interpreter */
- int objc; /* Parameter count */
- Tcl_Obj* CONST* objv; /* Parameter values */
+TclClockSecondsObjCmd(
+ ClientData clientData, /* Client data is unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj* CONST* objv) /* Parameter values */
{
Tcl_Time now;
+
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -545,27 +542,33 @@ TclClockSecondsObjCmd(clientData, interp, objc, objv)
*/
static void
-TzsetIfNecessary()
+TzsetIfNecessary(void)
{
static char* tzWas = NULL; /* Previous value of TZ, protected by
* clockMutex. */
CONST char* tzIsNow; /* Current value of TZ */
- Tcl_MutexLock( &clockMutex );
- tzIsNow = getenv( "TZ" );
- if ( tzIsNow != NULL
- && ( tzWas == NULL || strcmp( tzIsNow, tzWas ) != 0 ) ) {
+ Tcl_MutexLock(&clockMutex);
+ tzIsNow = getenv("TZ");
+ if (tzIsNow != NULL && (tzWas == NULL || strcmp(tzIsNow, tzWas) != 0)) {
tzset();
- if ( tzWas != NULL ) {
- ckfree( tzWas );
+ if (tzWas != NULL) {
+ ckfree(tzWas);
}
- tzWas = ckalloc( strlen( tzIsNow ) + 1 );
- strcpy( tzWas, tzIsNow );
- } else if ( tzIsNow == NULL && tzWas != NULL ) {
+ tzWas = ckalloc(strlen(tzIsNow) + 1);
+ strcpy(tzWas, tzIsNow);
+ } else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
- ckfree( tzWas );
+ ckfree(tzWas);
tzWas = NULL;
}
- Tcl_MutexUnlock( &clockMutex );
+ Tcl_MutexUnlock(&clockMutex);
}
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 49eb04b..756b396 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclConfig.c,v 1.9 2005/07/24 22:56:43 dkf Exp $
+ * RCS: @(#) $Id: tclConfig.c,v 1.10 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -33,13 +33,13 @@
* Static functions in this file:
*/
-static int QueryConfigObjCmd _ANSI_ARGS_((ClientData clientData,
+static int QueryConfigObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- struct Tcl_Obj * CONST * objv));
-static void QueryConfigDelete _ANSI_ARGS_((ClientData clientData));
-static Tcl_Obj * GetConfigDict _ANSI_ARGS_((Tcl_Interp* interp));
-static void ConfigDictDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
+ struct Tcl_Obj * CONST * objv);
+static void QueryConfigDelete(ClientData clientData);
+static Tcl_Obj * GetConfigDict(Tcl_Interp* interp);
+static void ConfigDictDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -58,19 +58,19 @@ static void ConfigDictDeleteProc _ANSI_ARGS_((
*/
void
-Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
- Tcl_Interp *interp; /* Interpreter the configuration command is
+Tcl_RegisterConfig(
+ Tcl_Interp *interp, /* Interpreter the configuration command is
* registered in. */
- CONST char *pkgName; /* Name of the package registering the
+ CONST char *pkgName, /* Name of the package registering the
* embedded configuration. ASCII, thus in
* UTF-8 too. */
- Tcl_Config *configuration; /* Embedded configuration. */
- CONST char *valEncoding; /* Name of the encoding used to store the
+ Tcl_Config *configuration, /* Embedded configuration. */
+ CONST char *valEncoding) /* Name of the encoding used to store the
* configuration values, ASCII, thus UTF-8. */
{
Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
- Tcl_Obj *pDB = GetConfigDict(interp);
- Tcl_Obj *pkg = Tcl_NewStringObj(pkgName, -1);
+ Tcl_Obj *pDB = GetConfigDict(interp);
+ Tcl_Obj *pkg = Tcl_NewStringObj(pkgName, -1);
Tcl_Obj *pkgDict;
Tcl_DString cmdName;
Tcl_Config *cfg;
@@ -180,11 +180,11 @@ Tcl_RegisterConfig(interp, pkgName, configuration, valEncoding)
*/
static int
-QueryConfigObjCmd(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- struct Tcl_Obj * CONST *objv;
+QueryConfigObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ struct Tcl_Obj * CONST *objv)
{
Tcl_Obj *pkgName = (Tcl_Obj *) clientData;
Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
@@ -294,8 +294,8 @@ QueryConfigObjCmd(clientData, interp, objc, objv)
*/
static void
-QueryConfigDelete(clientData)
- ClientData clientData;
+QueryConfigDelete(
+ ClientData clientData)
{
Tcl_Obj *pkgName = (Tcl_Obj *) clientData;
Tcl_DecrRefCount(pkgName);
@@ -319,12 +319,12 @@ QueryConfigDelete(clientData)
*/
static Tcl_Obj *
-GetConfigDict(interp)
- Tcl_Interp *interp;
+GetConfigDict(
+ Tcl_Interp *interp)
{
Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
- if (pDB == (Tcl_Obj *) NULL) {
+ if (pDB == NULL) {
pDB = Tcl_NewDictObj();
Tcl_IncrRefCount(pDB);
Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
@@ -353,9 +353,9 @@ GetConfigDict(interp)
*/
static void
-ConfigDictDeleteProc(clientData, interp)
- ClientData clientData; /* Pointer to Tcl_Obj. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+ConfigDictDeleteProc(
+ ClientData clientData, /* Pointer to Tcl_Obj. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
Tcl_Obj *pDB = (Tcl_Obj *) clientData;
Tcl_DecrRefCount(pDB);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 05008cb..be0a2ef 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1,15 +1,15 @@
-/*
+/*
* tclDictObj.c --
*
- * This file contains procedures that implement the Tcl dict object
- * type and its accessor command.
+ * This file contains functions that implement the Tcl dict object type
+ * and its accessor command.
*
* Copyright (c) 2002 by Donal K. Fellows.
*
- * 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: tclDictObj.c,v 1.37 2005/10/19 18:39:58 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.38 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -21,82 +21,81 @@
struct Dict;
/*
- * Prototypes for procedures defined later in this file:
+ * Prototypes for functions defined later in this file:
*/
-static void DeleteDict _ANSI_ARGS_((struct Dict *dict));
-static int DictAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictCreateCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictExistsCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictFilterCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictForCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictGetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictKeysCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictMergeCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictRemoveCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictReplaceCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictSizeCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictUnsetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictValuesCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictUpdateCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static int DictWithCmd _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv));
-static void DupDictInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FreeDictInternalRep _ANSI_ARGS_((Tcl_Obj *dictPtr));
-static void InvalidateDictChain _ANSI_ARGS_((Tcl_Obj *dictObj));
-static int SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr));
+static void DeleteDict(struct Dict *dict);
+static int DictAppendCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictCreateCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictExistsCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictFilterCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictForCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictGetCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictIncrCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictInfoCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictKeysCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictLappendCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictMergeCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictRemoveCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictReplaceCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictSetCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictSizeCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictUnsetCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictValuesCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictUpdateCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static int DictWithCmd(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv);
+static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeDictInternalRep(Tcl_Obj *dictPtr);
+static void InvalidateDictChain(Tcl_Obj *dictObj);
+static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfDict(Tcl_Obj *dictPtr);
/*
* Internal representation of a dictionary.
*
- * The internal representation of a dictionary object is a hash table
- * (with Tcl_Objs for both keys and values), a reference count and
- * epoch number for detecting concurrent modifications of the
- * dictionary, and a pointer to the parent object (used when
- * invalidating string reps of pathed dictionary trees) which is NULL
- * in normal use. The fact that hash tables know (with appropriate
- * initialisation) already about objects makes key management /so/
+ * The internal representation of a dictionary object is a hash table (with
+ * Tcl_Objs for both keys and values), a reference count and epoch number for
+ * detecting concurrent modifications of the dictionary, and a pointer to the
+ * parent object (used when invalidating string reps of pathed dictionary
+ * trees) which is NULL in normal use. The fact that hash tables know (with
+ * appropriate initialisation) already about objects makes key management /so/
* much easier!
*
- * Reference counts are used to enable safe iteration across hashes
- * while allowing the type of the containing object to be modified.
+ * Reference counts are used to enable safe iteration across hashes while
+ * allowing the type of the containing object to be modified.
*/
typedef struct Dict {
- Tcl_HashTable table;
- int epoch;
- int refcount;
- Tcl_Obj *chain;
+ Tcl_HashTable table; /* Object hash table to store mapping in. */
+ int epoch; /* Epoch counter */
+ int refcount; /* Reference counter (see above) */
+ Tcl_Obj *chain; /* Linked list used for invalidating the
+ * string representations of updated nested
+ * dictionaries. */
} Dict;
/*
* The structure below defines the dictionary object type by means of
- * procedures that can be invoked by generic object code.
+ * functions that can be invoked by generic object code.
*/
Tcl_ObjType tclDictType = {
@@ -112,27 +111,27 @@ Tcl_ObjType tclDictType = {
*
* DupDictInternalRep --
*
- * Initialize the internal representation of a dictionary Tcl_Obj
- * to a copy of the internal representation of an existing
- * dictionary object.
+ * Initialize the internal representation of a dictionary Tcl_Obj to a
+ * copy of the internal representation of an existing dictionary object.
*
* Results:
* None.
*
* Side effects:
- * "srcPtr"s dictionary internal rep pointer should not be NULL and
- * we assume it is not NULL. We set "copyPtr"s internal rep to a
- * pointer to a newly allocated dictionary rep that, in turn, points
- * to "srcPtr"s key and value objects. Those objects are not
- * actually copied but are shared between "srcPtr" and "copyPtr".
- * The ref count of each key and value object is incremented.
+ * "srcPtr"s dictionary internal rep pointer should not be NULL and we
+ * assume it is not NULL. We set "copyPtr"s internal rep to a pointer to
+ * a newly allocated dictionary rep that, in turn, points to "srcPtr"s
+ * key and value objects. Those objects are not actually copied but are
+ * shared between "srcPtr" and "copyPtr". The ref count of each key and
+ * value object is incremented.
*
*----------------------------------------------------------------------
*/
static void
-DupDictInternalRep(srcPtr, copyPtr)
- Tcl_Obj *srcPtr, *copyPtr;
+DupDictInternalRep(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr)
{
Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr;
Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
@@ -164,7 +163,7 @@ DupDictInternalRep(srcPtr, copyPtr)
/*
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = (VOID *) newDict;
+ copyPtr->internalRep.otherValuePtr = (void *) newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -173,23 +172,22 @@ DupDictInternalRep(srcPtr, copyPtr)
*
* FreeDictInternalRep --
*
- * Deallocate the storage associated with a dictionary object's
- * internal representation.
+ * Deallocate the storage associated with a dictionary object's internal
+ * representation.
*
* Results:
* None
*
* Side effects:
- * Frees the memory holding the dictionary's internal hash table
- * unless it is locked by an iteration going over it.
+ * Frees the memory holding the dictionary's internal hash table unless
+ * it is locked by an iteration going over it.
*
*----------------------------------------------------------------------
-
*/
static void
-FreeDictInternalRep(dictPtr)
- Tcl_Obj *dictPtr;
+FreeDictInternalRep(
+ Tcl_Obj *dictPtr)
{
Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
@@ -206,34 +204,35 @@ FreeDictInternalRep(dictPtr)
*
* DeleteDict --
*
- * Delete the structure that is used to implement a dictionary's
- * internal representation. Called when either the dictionary
- * object loses its internal representation or when the last
- * iteration over the dictionary completes.
+ * Delete the structure that is used to implement a dictionary's internal
+ * representation. Called when either the dictionary object loses its
+ * internal representation or when the last iteration over the dictionary
+ * completes.
*
* Results:
* None
*
* Side effects:
- * Decrements the reference count of all key and value objects in
- * the dictionary, which may free them.
+ * Decrements the reference count of all key and value objects in the
+ * dictionary, which may free them.
*
*----------------------------------------------------------------------
*/
static void
-DeleteDict(dict)
- Dict *dict;
+DeleteDict(
+ Dict *dict)
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_Obj *valuePtr;
/*
- * Delete the values ourselves, because hashes know nothing about
- * their contents (but do know about the key type, so that doesn't
- * need explicit attention.)
+ * Delete the values ourselves, because hashes know nothing about their
+ * contents (but do know about the key type, so that doesn't need explicit
+ * attention.)
*/
+
for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL;
hPtr=Tcl_NextHashEntry(&search)) {
valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
@@ -248,26 +247,26 @@ DeleteDict(dict)
*
* UpdateStringOfDict --
*
- * Update the string representation for a dictionary object.
- * Note: This procedure does not invalidate an existing old string
- * rep so storage will be lost if this has not already been done.
- * This code is based on UpdateStringOfList in tclListObj.c
+ * Update the string representation for a dictionary object. Note: This
+ * function does not invalidate an existing old string rep so storage
+ * will be lost if this has not already been done. This code is based on
+ * UpdateStringOfList in tclListObj.c
*
* Results:
* None.
*
* Side effects:
- * The object's string is set to a valid string that results from
- * the dict-to-string conversion. This string will be empty if the
- * dictionary has no key/value pairs. The dictionary internal
- * representation should not be NULL and we assume it is not NULL.
+ * The object's string is set to a valid string that results from the
+ * dict-to-string conversion. This string will be empty if the dictionary
+ * has no key/value pairs. The dictionary internal representation should
+ * not be NULL and we assume it is not NULL.
*
*----------------------------------------------------------------------
*/
static void
-UpdateStringOfDict(dictPtr)
- Tcl_Obj *dictPtr;
+UpdateStringOfDict(
+ Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
@@ -279,9 +278,10 @@ UpdateStringOfDict(dictPtr)
char *elem, *dst;
/*
- * This field is the most useful one in the whole hash structure,
- * and it is not exposed by any API function...
+ * This field is the most useful one in the whole hash structure, and it
+ * is not exposed by any API function...
*/
+
numElems = dict->table.numEntries * 2;
/*
@@ -297,8 +297,8 @@ UpdateStringOfDict(dictPtr)
for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
i+=2,hPtr=Tcl_NextHashEntry(&search)) {
/*
- * Assume that hPtr is never NULL since we know the number of
- * array elements already.
+ * Assume that hPtr is never NULL since we know the number of array
+ * elements already.
*/
keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
@@ -348,11 +348,10 @@ UpdateStringOfDict(dictPtr)
*
* SetDictFromAny --
*
- * Convert a non-dictionary object into a dictionary object. This
- * code is very closely related to SetListFromAny in tclListObj.c
- * but does not actually guarantee that a dictionary object will
- * have a string rep (as conversions from lists are handled with a
- * special case.)
+ * Convert a non-dictionary object into a dictionary object. This code is
+ * very closely related to SetListFromAny in tclListObj.c but does not
+ * actually guarantee that a dictionary object will have a string rep (as
+ * conversions from lists are handled with a special case.)
*
* Results:
* A standard Tcl result.
@@ -365,9 +364,9 @@ UpdateStringOfDict(dictPtr)
*/
static int
-SetDictFromAny(interp, objPtr)
- Tcl_Interp *interp;
- Tcl_Obj *objPtr;
+SetDictFromAny(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr)
{
char *string, *s;
CONST char *elemStart, *nextElem;
@@ -381,8 +380,8 @@ SetDictFromAny(interp, objPtr)
/*
* Since lists and dictionaries have very closely-related string
- * representations (i.e. the same parsing code) we can safely
- * special-case the conversion from lists to dictionaries.
+ * representations (i.e. the same parsing code) we can safely special-case
+ * the conversion from lists to dictionaries.
*/
if (objPtr->typePtr == &tclListType) {
@@ -401,8 +400,8 @@ SetDictFromAny(interp, objPtr)
}
/*
- * If the list is shared its string rep must not be lost so it
- * still is the same list.
+ * If the list is shared its string rep must not be lost so it still
+ * is the same list.
*/
if (Tcl_IsShared(objPtr)) {
@@ -431,6 +430,7 @@ SetDictFromAny(interp, objPtr)
/*
* Share type-setting code with the string-conversion case.
*/
+
goto installHash;
}
@@ -442,8 +442,8 @@ SetDictFromAny(interp, objPtr)
limit = (string + length);
/*
- * Allocate a new HashTable that has objects for keys and objects
- * for values.
+ * Allocate a new HashTable that has objects for keys and objects for
+ * values.
*/
dict = (Dict *) ckalloc(sizeof(Dict));
@@ -467,14 +467,14 @@ SetDictFromAny(interp, objPtr)
s = ckalloc((unsigned) elemSize + 1);
if (hasBrace) {
- memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
+ memcpy((void *) s, (void *) elemStart, (size_t) elemSize);
s[elemSize] = 0;
} else {
elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
}
-
+
TclNewObj(keyPtr);
- keyPtr->bytes = s;
+ keyPtr->bytes = s;
keyPtr->length = elemSize;
p = nextElem;
@@ -500,19 +500,20 @@ SetDictFromAny(interp, objPtr)
s = ckalloc((unsigned) elemSize + 1);
if (hasBrace) {
- memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize);
+ memcpy((void *) s, (void *) elemStart, (size_t) elemSize);
s[elemSize] = 0;
} else {
elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
}
TclNewObj(valuePtr);
- valuePtr->bytes = s;
+ valuePtr->bytes = s;
valuePtr->length = elemSize;
/*
* Store key and value in the hash table we're building.
*/
+
hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
if (!isNew) {
Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
@@ -525,8 +526,8 @@ SetDictFromAny(interp, objPtr)
installHash:
/*
- * Free the old internalRep before setting the new one. We do this as
- * late as possible to allow the conversion code, in particular
+ * Free the old internalRep before setting the new one. We do this as late
+ * as possible to allow the conversion code, in particular
* Tcl_GetStringFromObj, to use that old internalRep.
*/
@@ -534,7 +535,7 @@ SetDictFromAny(interp, objPtr)
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = (VOID *) dict;
+ objPtr->internalRep.otherValuePtr = (void *) dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
@@ -547,7 +548,7 @@ SetDictFromAny(interp, objPtr)
result = TCL_ERROR;
errorExit:
for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
+ hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
TclDecrRefCount(valuePtr);
}
@@ -561,29 +562,27 @@ SetDictFromAny(interp, objPtr)
*
* TclTraceDictPath --
*
- * Trace through a tree of dictionaries using the array of keys
- * given. If the flags argument has the DICT_PATH_UPDATE flag is
- * set, a backward-pointing chain of dictionaries is also built
- * (in the Dict's chain field) and the chained dictionaries are
- * made into unshared dictionaries (if they aren't already.)
+ * Trace through a tree of dictionaries using the array of keys given. If
+ * the flags argument has the DICT_PATH_UPDATE flag is set, a
+ * backward-pointing chain of dictionaries is also built (in the Dict's
+ * chain field) and the chained dictionaries are made into unshared
+ * dictionaries (if they aren't already.)
*
* Results:
- * The object at the end of the path, or NULL if there was an
- * error. Note that this it is an error for an intermediate
- * dictionary on the path to not exist. If the flags argument
- * has the DICT_PATH_EXISTS set, a non-existent path gives a
- * DICT_PATH_NON_EXISTENT result.
+ * The object at the end of the path, or NULL if there was an error. Note
+ * that this it is an error for an intermediate dictionary on the path to
+ * not exist. If the flags argument has the DICT_PATH_EXISTS set, a
+ * non-existent path gives a DICT_PATH_NON_EXISTENT result.
*
* Side effects:
- * If the flags argument is zero or DICT_PATH_EXISTS, there are
- * no side effects (other than potential conversion of objects to
- * dictionaries.) If the flags argument is DICT_PATH_UPDATE, the
- * following additional side effects occur. Shared dictionaries
- * along the path are converted into unshared objects, and a
- * backward-pointing chain is built using the chain fields of the
- * dictionaries (for easy invalidation of string representations
- * using InvalidateDictChain.) If the flags argument has the
- * DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
+ * If the flags argument is zero or DICT_PATH_EXISTS, there are no side
+ * effects (other than potential conversion of objects to dictionaries.)
+ * If the flags argument is DICT_PATH_UPDATE, the following additional
+ * side effects occur. Shared dictionaries along the path are converted
+ * into unshared objects, and a backward-pointing chain is built using
+ * the chain fields of the dictionaries (for easy invalidation of string
+ * representations using InvalidateDictChain). If the flags argument has
+ * the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit),
* non-existant keys will be inserted with a value of an empty
* dictionary, resulting in the path being built.
*
@@ -591,10 +590,12 @@ SetDictFromAny(interp, objPtr)
*/
Tcl_Obj *
-TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *CONST keyv[];
- int keyc, flags;
+TclTraceDictPath(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *CONST keyv[],
+ int flags)
{
Dict *dict, *newDict;
int i;
@@ -667,24 +668,24 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags)
*
* InvalidateDictChain --
*
- * Go through a dictionary chain (built by an updating invokation
- * of TclTraceDictPath) and invalidate the string representations
- * of all the dictionaries on the chain.
+ * Go through a dictionary chain (built by an updating invokation of
+ * TclTraceDictPath) and invalidate the string representations of all the
+ * dictionaries on the chain.
*
* Results:
* None
*
* Side effects:
- * String reps are invalidated and epoch counters (for detecting
- * illegal concurrent modifications) are updated through the
- * chain of updated dictionaries.
+ * String reps are invalidated and epoch counters (for detecting illegal
+ * concurrent modifications) are updated through the chain of updated
+ * dictionaries.
*
*----------------------------------------------------------------------
*/
static void
-InvalidateDictChain(dictObj)
- Tcl_Obj *dictObj;
+InvalidateDictChain(
+ Tcl_Obj *dictObj)
{
Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr;
@@ -705,24 +706,26 @@ InvalidateDictChain(dictObj)
*
* Tcl_DictObjPut --
*
- * Add a key,value pair to a dictionary, or update the value for a
- * key if that key already has a mapping in the dictionary.
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one, and any string representation that it has
- * is invalidated.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr, *valuePtr;
+Tcl_DictObjPut(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr,
+ Tcl_Obj *valuePtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -759,25 +762,27 @@ Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr)
*
* Tcl_DictObjGet --
*
- * Given a key, get its value from the dictionary (or NULL if key
- * is not found in dictionary.)
+ * Given a key, get its value from the dictionary (or NULL if key is not
+ * found in dictionary.)
*
* Results:
- * A standard Tcl result. The variable pointed to by valuePtrPtr
- * is updated with the value for the key. Note that it is not an
- * error for the key to have no mapping in the dictionary.
+ * A standard Tcl result. The variable pointed to by valuePtrPtr is
+ * updated with the value for the key. Note that it is not an error for
+ * the key to have no mapping in the dictionary.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr, **valuePtrPtr;
+Tcl_DictObjGet(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr,
+ Tcl_Obj **valuePtrPtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -804,24 +809,25 @@ Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)
*
* Tcl_DictObjRemove --
*
- * Remove the key,value pair with the given key from the dictionary;
- * the key does not need to be present in the dictionary.
+ * Remove the key,value pair with the given key from the dictionary; the
+ * key does not need to be present in the dictionary.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * The object pointed to by dictPtr is converted to a dictionary if
- * it is not already one, and any string representation that it has
- * is invalidated.
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjRemove(interp, dictPtr, keyPtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr, *keyPtr;
+Tcl_DictObjRemove(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ Tcl_Obj *keyPtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -860,21 +866,21 @@ Tcl_DictObjRemove(interp, dictPtr, keyPtr)
* How many key,value pairs are there in the dictionary?
*
* Results:
- * A standard Tcl result. Updates the variable pointed to by
- * sizePtr with the number of key,value pairs in the dictionary.
+ * A standard Tcl result. Updates the variable pointed to by sizePtr with
+ * the number of key,value pairs in the dictionary.
*
* Side effects:
- * The dictPtr object is converted to a dictionary type if it is
- * not a dictionary already.
+ * The dictPtr object is converted to a dictionary type if it is not a
+ * dictionary already.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjSize(interp, dictPtr, sizePtr)
- Tcl_Interp *interp;
- Tcl_Obj *dictPtr;
- int *sizePtr;
+Tcl_DictObjSize(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int *sizePtr)
{
Dict *dict;
@@ -895,41 +901,39 @@ Tcl_DictObjSize(interp, dictPtr, sizePtr)
*
* Tcl_DictObjFirst --
*
- * Start a traversal of the dictionary. Caller must supply the
- * search context, pointers for returning key and value, and a
- * pointer to allow indication of whether the dictionary has been
- * traversed (i.e. the dictionary is empty.) The order of traversal
- * is undefined.
+ * Start a traversal of the dictionary. Caller must supply the search
+ * context, pointers for returning key and value, and a pointer to allow
+ * indication of whether the dictionary has been traversed (i.e. the
+ * dictionary is empty). The order of traversal is undefined.
*
* Results:
- * A standard Tcl result. Updates the variables pointed to by
- * keyPtrPtr, valuePtrPtr and donePtr. Either of keyPtrPtr and
- * valuePtrPtr may be NULL, in which case the key/value is not made
- * available to the caller.
+ * A standard Tcl result. Updates the variables pointed to by keyPtrPtr,
+ * valuePtrPtr and donePtr. Either of keyPtrPtr and valuePtrPtr may be
+ * NULL, in which case the key/value is not made available to the caller.
*
* Side effects:
- * The dictPtr object is converted to a dictionary type if it is
- * not a dictionary already. The search context is initialised if
- * the search has not finished. The dictionary's internal rep is
- * Tcl_Preserve()d if the dictionary has at least one element.
+ * The dictPtr object is converted to a dictionary type if it is not a
+ * dictionary already. The search context is initialised if the search
+ * has not finished. The dictionary's internal rep is Tcl_Preserve()d if
+ * the dictionary has at least one element.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
- Tcl_Interp *interp; /* For error messages, or NULL if no
- * error messages desired. */
- Tcl_Obj *dictPtr; /* Dictionary to traverse. */
- Tcl_DictSearch *searchPtr; /* Pointer to a dict search context. */
- Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the
- * first key written into, or NULL. */
- Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the
- * first value written into, or NULL.*/
- int *donePtr; /* Pointer to a variable which will
- * have a 1 written into when there
- * are no further values in the
- * dictionary, or a 0 otherwise. */
+Tcl_DictObjFirst(
+ Tcl_Interp *interp, /* For error messages, or NULL if no error
+ * messages desired. */
+ Tcl_Obj *dictPtr, /* Dictionary to traverse. */
+ Tcl_DictSearch *searchPtr, /* Pointer to a dict search context. */
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first
+ * value written into, or NULL.*/
+ int *donePtr) /* Pointer to a variable which will have a 1
+ * written into when there are no further
+ * values in the dictionary, or a 0
+ * otherwise. */
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -967,51 +971,53 @@ Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
* Tcl_DictObjNext --
*
* Continue a traversal of a dictionary previously started with
- * Tcl_DictObjFirst. This function is safe against concurrent
- * modification of the underlying object (including type
- * shimmering), treating such situations as if the search has
- * terminated, though it is up to the caller to ensure that the
- * object itself is not disposed until the search has finished.
- * It is _not_ safe against modifications from other threads.
+ * Tcl_DictObjFirst. This function is safe against concurrent
+ * modification of the underlying object (including type shimmering),
+ * treating such situations as if the search has terminated, though it is
+ * up to the caller to ensure that the object itself is not disposed
+ * until the search has finished. It is _not_ safe against modifications
+ * from other threads.
*
* Results:
* Updates the variables pointed to by keyPtrPtr, valuePtrPtr and
- * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in
- * which case the key/value is not made available to the caller.
+ * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in which
+ * case the key/value is not made available to the caller.
*
* Side effects:
- * Removes a reference to the dictionary's internal rep if the
- * search terminates.
+ * Removes a reference to the dictionary's internal rep if the search
+ * terminates.
*
*----------------------------------------------------------------------
*/
void
-Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
- Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */
- Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the
- * first key written into, or NULL. */
- Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the
- * first value written into, or NULL.*/
- int *donePtr; /* Pointer to a variable which will
- * have a 1 written into when there
- * are no further values in the
- * dictionary, or a 0 otherwise. */
+Tcl_DictObjNext(
+ Tcl_DictSearch *searchPtr, /* Pointer to a hash search context. */
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first
+ * value written into, or NULL.*/
+ int *donePtr) /* Pointer to a variable which will have a 1
+ * written into when there are no further
+ * values in the dictionary, or a 0
+ * otherwise. */
{
Tcl_HashEntry *hPtr;
/*
* If the searh is done; we do no work.
*/
+
if (searchPtr->epoch == -1) {
*donePtr = 1;
return;
}
/*
- * Bail out if the dictionary has had any elements added, modified
- * or removed. This *shouldn't* happen, but...
+ * Bail out if the dictionary has had any elements added, modified or
+ * removed. This *shouldn't* happen, but...
*/
+
if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
Tcl_Panic("concurrent dictionary modification and search");
}
@@ -1038,11 +1044,10 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
*
* Tcl_DictObjDone --
*
- * Call this if you want to stop a search before you reach the
- * end of the dictionary (e.g. because of abnormal termination of
- * the search.) It should not be used if the search reaches its
- * natural end (i.e. if either Tcl_DictObjFirst or Tcl_DictObjNext
- * sets its donePtr variable to 1.)
+ * Call this if you want to stop a search before you reach the end of the
+ * dictionary (e.g. because of abnormal termination of the search). It
+ * need not be used if the search reaches its natural end (i.e. if either
+ * Tcl_DictObjFirst or Tcl_DictObjNext sets its donePtr variable to 1).
*
* Results:
* None.
@@ -1054,8 +1059,8 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)
*/
void
-Tcl_DictObjDone(searchPtr)
- Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */
+Tcl_DictObjDone(
+ Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */
{
Dict *dict;
@@ -1074,26 +1079,28 @@ Tcl_DictObjDone(searchPtr)
*
* Tcl_DictObjPutKeyList --
*
- * Add a key...key,value pair to a dictionary tree. The main
- * dictionary value must not be shared, though sub-dictionaries may
- * be. All intermediate dictionaries on the path must exist.
+ * Add a key...key,value pair to a dictionary tree. The main dictionary
+ * value must not be shared, though sub-dictionaries may be. All
+ * intermediate dictionaries on the path must exist.
*
* Results:
- * A standard Tcl result. Note that in the error case, a message
- * is left in interp unless that is NULL.
+ * A standard Tcl result. Note that in the error case, a message is left
+ * in interp unless that is NULL.
*
* Side effects:
- * If the dictionary and any of its sub-dictionaries on the
- * path have string representations, these are invalidated.
+ * If the dictionary and any of its sub-dictionaries on the path have
+ * string representations, these are invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
- Tcl_Interp *interp;
- int keyc;
- Tcl_Obj *dictPtr, *CONST keyv[], *valuePtr;
+Tcl_DictObjPutKeyList(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *CONST keyv[],
+ Tcl_Obj *valuePtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -1130,27 +1137,28 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
* Tcl_DictObjRemoveKeyList --
*
* Remove a key...key,value pair from a dictionary tree (the value
- * removed is implicit in the key path.) The main dictionary value
- * must not be shared, though sub-dictionaries may be. It is not
- * an error if there is no value associated with the given key list,
- * but all intermediate dictionaries on the key path must exist.
+ * removed is implicit in the key path). The main dictionary value must
+ * not be shared, though sub-dictionaries may be. It is not an error if
+ * there is no value associated with the given key list, but all
+ * intermediate dictionaries on the key path must exist.
*
* Results:
- * A standard Tcl result. Note that in the error case, a message
- * is left in interp unless that is NULL.
+ * A standard Tcl result. Note that in the error case, a message is left
+ * in interp unless that is NULL.
*
* Side effects:
- * If the dictionary and any of its sub-dictionaries on the key
- * path have string representations, these are invalidated.
+ * If the dictionary and any of its sub-dictionaries on the key path have
+ * string representations, these are invalidated.
*
*----------------------------------------------------------------------
*/
int
-Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
- Tcl_Interp *interp;
- int keyc;
- Tcl_Obj *dictPtr, *CONST keyv[];
+Tcl_DictObjRemoveKeyList(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ int keyc,
+ Tcl_Obj *CONST keyv[])
{
Dict *dict;
Tcl_HashEntry *hPtr;
@@ -1183,17 +1191,17 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
*
* Tcl_NewDictObj --
*
- * This procedure is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new dict object
- * without any content.
+ * This function is normally called when not debugging: i.e., when
+ * TCL_MEM_DEBUG is not defined. It creates a new dict object without any
+ * content.
*
- * When TCL_MEM_DEBUG is defined, this procedure just returns the
- * result of calling the debugging version Tcl_DbNewDictObj.
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
+ * of calling the debugging version Tcl_DbNewDictObj.
*
* Results:
- * A new dict object is returned; it has no keys defined in it.
- * The new object's string representation is left NULL, and the
- * ref count of the object is 0.
+ * A new dict object is returned; it has no keys defined in it. The new
+ * object's string representation is left NULL, and the ref count of the
+ * object is 0.
*
* Side Effects:
* None.
@@ -1202,11 +1210,12 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
*/
Tcl_Obj *
-Tcl_NewDictObj()
+Tcl_NewDictObj(void)
{
#ifdef TCL_MEM_DEBUG
return Tcl_DbNewDictObj("unknown", 0);
#else /* !TCL_MEM_DEBUG */
+
Tcl_Obj *dictPtr;
Dict *dict;
@@ -1217,7 +1226,7 @@ Tcl_NewDictObj()
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (VOID *) dict;
+ dictPtr->internalRep.otherValuePtr = (void *) dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1228,21 +1237,21 @@ Tcl_NewDictObj()
*
* Tcl_DbNewDictObj --
*
- * This procedure is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the
- * same as the Tcl_NewDictObj procedure above except that it calls
+ * This function is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the same
+ * as the Tcl_NewDictObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
- * command will report the correct file name and line number when
+ * command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just returns the
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewDictObj.
*
* Results:
- * A new dict object is returned; it has no keys defined in it.
- * The new object's string representation is left NULL, and the
- * ref count of the object is 0.
+ * A new dict object is returned; it has no keys defined in it. The new
+ * object's string representation is left NULL, and the ref count of the
+ * object is 0.
*
* Side Effects:
* None.
@@ -1251,9 +1260,9 @@ Tcl_NewDictObj()
*/
Tcl_Obj *
-Tcl_DbNewDictObj(file, line)
- CONST char *file;
- int line;
+Tcl_DbNewDictObj(
+ CONST char *file,
+ int line)
{
#ifdef TCL_MEM_DEBUG
Tcl_Obj *dictPtr;
@@ -1266,7 +1275,7 @@ Tcl_DbNewDictObj(file, line)
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (VOID *) dict;
+ dictPtr->internalRep.otherValuePtr = (void *) dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1281,9 +1290,9 @@ Tcl_DbNewDictObj(file, line)
*
* DictCreateCmd --
*
- * This function implements the "dict create" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict create" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1295,19 +1304,20 @@ Tcl_DbNewDictObj(file, line)
*/
static int
-DictCreateCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictCreateCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictObj;
int i;
/*
- * Must have an even number of arguments; note that number of
- * preceding arguments (i.e. "dict create" is also even, which
- * makes this much easier.)
+ * Must have an even number of arguments; note that number of preceding
+ * arguments (i.e. "dict create" is also even, which makes this much
+ * easier.)
*/
+
if (objc & 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?key value ...?");
return TCL_ERROR;
@@ -1329,9 +1339,9 @@ DictCreateCmd(interp, objc, objv)
*
* DictGetCmd --
*
- * This function implements the "dict get" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict get" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1343,10 +1353,10 @@ DictCreateCmd(interp, objc, objv)
*/
static int
-DictGetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictGetCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
@@ -1357,9 +1367,9 @@ DictGetCmd(interp, objc, objv)
}
/*
- * Test for the special case of no keys, which returns a *list* of
- * all key,value pairs. We produce a copy here because that makes
- * subsequent list handling more efficient.
+ * Test for the special case of no keys, which returns a *list* of all
+ * key,value pairs. We produce a copy here because that makes subsequent
+ * list handling more efficient.
*/
if (objc == 3) {
@@ -1375,8 +1385,8 @@ DictGetCmd(interp, objc, objv)
listPtr = Tcl_NewListObj(0, NULL);
while (!done) {
/*
- * Assume these won't fail as we have complete control
- * over the types of things here.
+ * Assume these won't fail as we have complete control over the
+ * types of things here.
*/
Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
@@ -1389,12 +1399,11 @@ DictGetCmd(interp, objc, objv)
}
/*
- * Loop through the list of keys, looking up the key at the
- * current index in the current dictionary each time. Once we've
- * done the lookup, we set the current dictionary to be the value
- * we looked up (in case the value was not the last one and we are
- * going through a chain of searches.) Note that this loop always
- * executes at least once.
+ * Loop through the list of keys, looking up the key at the current index
+ * in the current dictionary each time. Once we've done the lookup, we set
+ * the current dictionary to be the value we looked up (in case the value
+ * was not the last one and we are going through a chain of searches.)
+ * Note that this loop always executes at least once.
*/
dictPtr = TclTraceDictPath(interp, objv[2], objc-4,objv+3, DICT_PATH_READ);
@@ -1420,9 +1429,9 @@ DictGetCmd(interp, objc, objv)
*
* DictReplaceCmd --
*
- * This function implements the "dict replace" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict replace" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1434,10 +1443,10 @@ DictGetCmd(interp, objc, objv)
*/
static int
-DictReplaceCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictReplaceCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1471,9 +1480,9 @@ DictReplaceCmd(interp, objc, objv)
*
* DictRemoveCmd --
*
- * This function implements the "dict remove" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict remove" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1485,10 +1494,10 @@ DictReplaceCmd(interp, objc, objv)
*/
static int
-DictRemoveCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictRemoveCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1522,9 +1531,9 @@ DictRemoveCmd(interp, objc, objv)
*
* DictMergeCmd --
*
- * This function implements the "dict merge" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#163 for the formal specification.
+ * This function implements the "dict merge" Tcl command. See the user
+ * documentation for details on what it does, and TIP#163 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1536,10 +1545,10 @@ DictRemoveCmd(interp, objc, objv)
*/
static int
-DictMergeCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictMergeCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *targetObj, *keyObj, *valueObj;
int allocatedDict = 0;
@@ -1550,14 +1559,16 @@ DictMergeCmd(interp, objc, objv)
/*
* No dictionary arguments; return default (empty value).
*/
+
return TCL_OK;
}
if (objc == 3) {
/*
- * Single argument, make sure it is a dictionary, but
- * otherwise return it.
+ * Single argument, make sure it is a dictionary, but otherwise return
+ * it.
*/
+
if (objv[2]->typePtr != &tclDictType) {
if (SetDictFromAny(interp, objv[2]) != TCL_OK) {
return TCL_ERROR;
@@ -1605,9 +1616,9 @@ DictMergeCmd(interp, objc, objv)
*
* DictKeysCmd --
*
- * This function implements the "dict keys" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict keys" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1619,10 +1630,10 @@ DictMergeCmd(interp, objc, objv)
*/
static int
-DictKeysCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictKeysCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *keyPtr, *listPtr;
Tcl_DictSearch search;
@@ -1655,10 +1666,12 @@ DictKeysCmd(interp, objc, objv)
/*
* Assume this operation always succeeds.
*/
+
Tcl_ListObjAppendElement(interp, listPtr, keyPtr);
}
}
-searchDone:
+
+ searchDone:
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1668,9 +1681,9 @@ searchDone:
*
* DictValuesCmd --
*
- * This function implements the "dict values" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict values" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1682,10 +1695,10 @@ searchDone:
*/
static int
-DictValuesCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictValuesCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *valuePtr, *listPtr;
Tcl_DictSearch search;
@@ -1710,9 +1723,11 @@ DictValuesCmd(interp, objc, objv)
/*
* Assume this operation always succeeds.
*/
+
Tcl_ListObjAppendElement(interp, listPtr, valuePtr);
}
}
+
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
@@ -1722,9 +1737,9 @@ DictValuesCmd(interp, objc, objv)
*
* DictSizeCmd --
*
- * This function implements the "dict size" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict size" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1736,10 +1751,10 @@ DictValuesCmd(interp, objc, objv)
*/
static int
-DictSizeCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictSizeCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
int result, size;
@@ -1759,9 +1774,9 @@ DictSizeCmd(interp, objc, objv)
*
* DictExistsCmd --
*
- * This function implements the "dict exists" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict exists" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1773,10 +1788,10 @@ DictSizeCmd(interp, objc, objv)
*/
static int
-DictExistsCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictExistsCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
int result;
@@ -1808,9 +1823,9 @@ DictExistsCmd(interp, objc, objv)
*
* DictInfoCmd --
*
- * This function implements the "dict info" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict info" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1822,10 +1837,10 @@ DictExistsCmd(interp, objc, objv)
*/
static int
-DictInfoCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictInfoCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr;
Dict *dict;
@@ -1846,6 +1861,7 @@ DictInfoCmd(interp, objc, objv)
/*
* This next cast is actually OK.
*/
+
Tcl_SetResult(interp, (char *)Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -1855,9 +1871,9 @@ DictInfoCmd(interp, objc, objv)
*
* DictIncrCmd --
*
- * This function implements the "dict incr" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict incr" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1869,10 +1885,10 @@ DictInfoCmd(interp, objc, objv)
*/
static int
-DictIncrCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictIncrCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
int code = TCL_OK;
Tcl_Obj *dictPtr, *valuePtr = NULL;
@@ -1884,25 +1900,42 @@ DictIncrCmd(interp, objc, objv)
dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
if (dictPtr == NULL) {
- /* Variable didn't yet exist. Create new dictionary value */
+ /*
+ * Variable didn't yet exist. Create new dictionary value.
+ */
+
dictPtr = Tcl_NewDictObj();
} else if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {
- /* Variable contents are not a dict, report error */
+ /*
+ * Variable contents are not a dict, report error.
+ */
+
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
- /* A little internals surgery to avoid copying a string rep
- * that will soon be no good */
+ /*
+ * A little internals surgery to avoid copying a string rep that will
+ * soon be no good.
+ */
+
char *saved = dictPtr->bytes;
+
dictPtr->bytes = NULL;
dictPtr = Tcl_DuplicateObj(dictPtr);
dictPtr->bytes = saved;
}
if (valuePtr == NULL) {
- /* Key not in dictionary. Create new key with increment as value */
+ /*
+ * Key not in dictionary. Create new key with increment as value.
+ */
+
if (objc == 5) {
- /* Verify increment is an integer */
+ /*
+ * Verify increment is an integer.
+ */
+
mp_int increment;
+
code = Tcl_GetBignumFromObj(interp, objv[4], &increment);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (reading increment)");
@@ -1913,7 +1946,10 @@ DictIncrCmd(interp, objc, objv)
Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewIntObj(1));
}
} else {
- /* Key in dictionary. Increment its value with minimum dup. */
+ /*
+ * Key in dictionary. Increment its value with minimum dup.
+ */
+
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
@@ -1948,9 +1984,9 @@ DictIncrCmd(interp, objc, objv)
*
* DictLappendCmd --
*
- * This function implements the "dict lappend" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict lappend" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -1962,10 +1998,10 @@ DictIncrCmd(interp, objc, objv)
*/
static int
-DictLappendCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictLappendCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0, allocatedValue = 0;
@@ -2036,9 +2072,9 @@ DictLappendCmd(interp, objc, objv)
*
* DictAppendCmd --
*
- * This function implements the "dict append" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict append" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2050,10 +2086,10 @@ DictLappendCmd(interp, objc, objv)
*/
static int
-DictAppendCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictAppendCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0;
@@ -2109,9 +2145,9 @@ DictAppendCmd(interp, objc, objv)
*
* DictForCmd --
*
- * This function implements the "dict for" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict for" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2123,10 +2159,10 @@ DictAppendCmd(interp, objc, objv)
*/
static int
-DictForCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictForCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
@@ -2150,11 +2186,13 @@ DictForCmd(interp, objc, objv)
keyVarObj = varv[0];
valueVarObj = varv[1];
scriptObj = objv[4];
+
/*
* Make sure that these objects (which we need throughout the body of the
- * loop) don't vanish. Note that the dictionary internal rep is locked
+ * loop) don't vanish. Note that the dictionary internal rep is locked
* internally so that updates, shimmering, etc are not a problem.
*/
+
Tcl_IncrRefCount(keyVarObj);
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
@@ -2167,14 +2205,15 @@ DictForCmd(interp, objc, objv)
while (!done) {
/*
- * Stop the value from getting hit in any way by any traces on
- * the key variable.
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
*/
+
Tcl_IncrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", (char *) NULL);
+ TclGetString(keyVarObj), "\"", NULL);
TclDecrRefCount(valueObj);
result = TCL_ERROR;
goto doneFor;
@@ -2183,7 +2222,7 @@ DictForCmd(interp, objc, objv)
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", (char *) NULL);
+ TclGetString(valueVarObj), "\"", NULL);
result = TCL_ERROR;
goto doneFor;
}
@@ -2208,6 +2247,7 @@ DictForCmd(interp, objc, objv)
/*
* Stop holding a reference to these objects.
*/
+
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
@@ -2224,9 +2264,9 @@ DictForCmd(interp, objc, objv)
*
* DictSetCmd --
*
- * This function implements the "dict set" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict set" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2238,10 +2278,10 @@ DictForCmd(interp, objc, objv)
*/
static int
-DictSetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictSetCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2285,9 +2325,9 @@ DictSetCmd(interp, objc, objv)
*
* DictUnsetCmd --
*
- * This function implements the "dict unset" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict unset" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2299,10 +2339,10 @@ DictSetCmd(interp, objc, objv)
*/
static int
-DictUnsetCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictUnsetCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2345,9 +2385,9 @@ DictUnsetCmd(interp, objc, objv)
*
* DictFilterCmd --
*
- * This function implements the "dict filter" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function implements the "dict filter" Tcl command. See the user
+ * documentation for details on what it does, and TIP#111 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2359,10 +2399,10 @@ DictUnsetCmd(interp, objc, objv)
*/
static int
-DictFilterCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictFilterCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
static CONST char *filters[] = {
"key", "script", "value", NULL
@@ -2395,6 +2435,7 @@ DictFilterCmd(interp, objc, objv)
/*
* Create a dictionary whose keys all match a certain pattern.
*/
+
if (Tcl_DictObjFirst(interp, objv[2], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
@@ -2426,6 +2467,7 @@ DictFilterCmd(interp, objc, objv)
/*
* Create a dictionary whose values all match a certain pattern.
*/
+
if (Tcl_DictObjFirst(interp, objv[2], &search,
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
@@ -2449,10 +2491,9 @@ DictFilterCmd(interp, objc, objv)
}
/*
- * Create a dictionary whose key,value pairs all satisfy a
- * script (i.e. get a true boolean result from its
- * evaluation.) Massive copying from the "dict for"
- * implementation has occurred!
+ * Create a dictionary whose key,value pairs all satisfy a script
+ * (i.e. get a true boolean result from its evaluation). Massive
+ * copying from the "dict for" implementation has occurred!
*/
if (Tcl_ListObjGetElements(interp, objv[4], &varc, &varv) != TCL_OK) {
@@ -2466,12 +2507,14 @@ DictFilterCmd(interp, objc, objv)
keyVarObj = varv[0];
valueVarObj = varv[1];
scriptObj = objv[5];
+
/*
* Make sure that these objects (which we need throughout the body of
- * the loop) don't vanish. Note that the dictionary internal rep is
+ * the loop) don't vanish. Note that the dictionary internal rep is
* locked internally so that updates, shimmering, etc are not a
* problem.
*/
+
Tcl_IncrRefCount(keyVarObj);
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
@@ -2489,16 +2532,17 @@ DictFilterCmd(interp, objc, objv)
while (!done) {
/*
- * Stop the value from getting hit in any way by any
- * traces on the key variable.
+ * Stop the value from getting hit in any way by any traces on the
+ * key variable.
*/
+
Tcl_IncrRefCount(keyObj);
Tcl_IncrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", (char *) NULL);
+ TclGetString(keyVarObj), "\"", NULL);
result = TCL_ERROR;
goto abnormalResult;
}
@@ -2506,7 +2550,7 @@ DictFilterCmd(interp, objc, objv)
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", (char *) NULL);
+ TclGetString(valueVarObj), "\"", NULL);
goto abnormalResult;
}
@@ -2533,6 +2577,7 @@ DictFilterCmd(interp, objc, objv)
* makes the next Tcl_DictObjNext say there is nothing more to
* do.
*/
+
Tcl_ResetResult(interp);
Tcl_DictObjDone(&search);
case TCL_CONTINUE:
@@ -2555,6 +2600,7 @@ DictFilterCmd(interp, objc, objv)
/*
* Stop holding a reference to these objects.
*/
+
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
@@ -2566,6 +2612,7 @@ DictFilterCmd(interp, objc, objv)
TclDecrRefCount(resultObj);
}
return result;
+
abnormalResult:
Tcl_DictObjDone(&search);
TclDecrRefCount(keyObj);
@@ -2586,9 +2633,9 @@ DictFilterCmd(interp, objc, objv)
*
* DictUpdateCmd --
*
- * This function implements the "dict update" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#212 for the formal specification.
+ * This function implements the "dict update" Tcl command. See the user
+ * documentation for details on what it does, and TIP#212 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2600,10 +2647,10 @@ DictFilterCmd(interp, objc, objv)
*/
static int
-DictUpdateCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictUpdateCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *objPtr;
int i, result, dummy, allocdict = 0;
@@ -2649,8 +2696,7 @@ DictUpdateCmd(interp, objc, objv)
}
/*
- * If the dictionary variable doesn't exist, drop everything
- * silently.
+ * If the dictionary variable doesn't exist, drop everything silently.
*/
dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
@@ -2674,8 +2720,8 @@ DictUpdateCmd(interp, objc, objv)
}
/*
- * Write back the values from the variables, treating failure to
- * read as an instruction to remove the key.
+ * Write back the values from the variables, treating failure to read as
+ * an instruction to remove the key.
*/
for (i=3 ; i+2<objc ; i+=2) {
@@ -2709,9 +2755,9 @@ DictUpdateCmd(interp, objc, objv)
*
* DictWithCmd --
*
- * This function implements the "dict with" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#212 for the formal specification.
+ * This function implements the "dict with" Tcl command. See the user
+ * documentation for details on what it does, and TIP#212 for the formal
+ * specification.
*
* Results:
* A standard Tcl result.
@@ -2723,10 +2769,10 @@ DictUpdateCmd(interp, objc, objv)
*/
static int
-DictWithCmd(interp, objc, objv)
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+DictWithCmd(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
Tcl_DictSearch s;
@@ -2755,10 +2801,10 @@ DictWithCmd(interp, objc, objv)
}
/*
- * Go over the list of keys and write each corresponding value to
- * a variable in the current context with the same name. Also
- * keep a copy of the keys so we can write back properly later on
- * even if the dictionary has been structurally modified.
+ * Go over the list of keys and write each corresponding value to a
+ * variable in the current context with the same name. Also keep a copy of
+ * the keys so we can write back properly later on even if the dictionary
+ * has been structurally modified.
*/
if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
@@ -2789,8 +2835,7 @@ DictWithCmd(interp, objc, objv)
}
/*
- * If the dictionary variable doesn't exist, drop everything
- * silently.
+ * If the dictionary variable doesn't exist, drop everything silently.
*/
dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
@@ -2817,14 +2862,14 @@ DictWithCmd(interp, objc, objv)
if (objc > 4) {
/*
- * Want to get to the dictionary which we will update; need to
- * do prepare-for-update de-sharing along the path *but* avoid
- * generating an error on a non-existant path (we'll treat
- * that the same as a non-existant variable. Luckily, the
- * de-sharing operation isn't deeply damaging if we don't go
- * on to update; it's just less than perfectly efficient (but
- * no memory should be leaked).
+ * Want to get to the dictionary which we will update; need to do
+ * prepare-for-update de-sharing along the path *but* avoid generating
+ * an error on a non-existant path (we'll treat that the same as a
+ * non-existant variable. Luckily, the de-sharing operation isn't
+ * deeply damaging if we don't go on to update; it's just less than
+ * perfectly efficient (but no memory should be leaked).
*/
+
leafPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
if (leafPtr == NULL) {
@@ -2862,8 +2907,8 @@ DictWithCmd(interp, objc, objv)
TclDecrRefCount(keysPtr);
/*
- * Ensure that none of the dictionaries in the chain still have a
- * string rep.
+ * Ensure that none of the dictionaries in the chain still have a string
+ * rep.
*/
if (objc > 4) {
@@ -2890,9 +2935,9 @@ DictWithCmd(interp, objc, objv)
*
* Tcl_DictObjCmd --
*
- * This function is invoked to process the "dict" Tcl command.
- * See the user documentation for details on what it does, and
- * TIP#111 for the formal specification.
+ * This function is invoked to process the "dict" Tcl command. See the
+ * user documentation for details on what it does, and TIP#111 for the
+ * formal specification.
*
* Results:
* A standard Tcl result.
@@ -2904,11 +2949,11 @@ DictWithCmd(interp, objc, objv)
*/
int
-Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST *objv;
+Tcl_DictObjCmd(
+ /*ignored*/ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
static CONST char *subcommands[] = {
"append", "create", "exists", "filter", "for",
@@ -2954,8 +2999,18 @@ Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)
case DICT_WITH: return DictWithCmd(interp, objc, objv);
}
Tcl_Panic("unexpected fallthrough!");
+
/*
* Next line is NOT REACHED - stops compliler complaint though...
*/
+
return TCL_ERROR;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 2aa927b..9417f1a 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEnv.c,v 1.26 2005/10/05 08:03:35 hobbs Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.27 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -25,21 +25,22 @@ static char **environCache = NULL;
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
-static char **ourEnviron = NULL;/* Cache of the array that we allocate.
- * We need to track this in case another
+static char **ourEnviron = NULL;/* Cache of the array that we allocate. We
+ * need to track this in case another
* subsystem swaps around the environ array
* like we do.
*/
static int environSize = 0; /* Non-zero means that the environ array was
* malloced and has this many total entries
* allocated to it (not all may be in use at
- * once). Zero means that the environment
+ * once). Zero means that the environment
* array is in its original static state. */
#endif
/*
* For MacOS X
*/
+
#if defined(__APPLE__) && defined(__DYNAMIC__)
#include <crt_externs.h>
char **environ = NULL;
@@ -49,17 +50,13 @@ char **environ = NULL;
* Declarations for local functions defined in this file:
*/
-static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
-static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
- char *newStr));
-void TclSetEnv _ANSI_ARGS_((CONST char *name,
- CONST char *value));
-void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
-
-#if defined (__CYGWIN__) && defined(__WIN32__)
-static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
+static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
+ CONST char *name1, CONST char *name2, int flags);
+static void ReplaceString(CONST char *oldStr, char *newStr);
+void TclSetEnv(CONST char *name, CONST char *value);
+void TclUnsetEnv(CONST char *name);
+#if defined(__CYGWIN__) && defined(__WIN32__)
+static void TclCygwinPutenv(CONST char *string);
#endif
/*
@@ -77,7 +74,7 @@ static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
* Side effects:
* The interpreter is added to a list of interpreters managed by us, so
* that its view of envariables can be kept consistent with the view in
- * other interpreters. If this is the first call to TclSetupEnv, then
+ * other interpreters. If this is the first call to TclSetupEnv, then
* additional initialization happens, such as copying the environment to
* dynamically-allocated space for ease of management.
*
@@ -85,8 +82,8 @@ static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
*/
void
-TclSetupEnv(interp)
- Tcl_Interp *interp; /* Interpreter whose "env" array is to be
+TclSetupEnv(
+ Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
Tcl_DString envString;
@@ -94,15 +91,16 @@ TclSetupEnv(interp)
int i;
/*
- * For MacOS X
+ * For MacOS X, need to get the real system environment.
*/
+
#if defined(__APPLE__) && defined(__DYNAMIC__)
environ = *_NSGetEnviron();
#endif
/*
* Synchronize the values in the environ array with the contents of the
- * Tcl "env" variable. To do this:
+ * Tcl "env" variable. To do this:
* 1) Remove the trace that fires when the "env" var is unset.
* 2) Unset the "env" variable.
* 3) If there are no environ variables, create an empty "env" array.
@@ -110,12 +108,12 @@ TclSetupEnv(interp)
* 4) Add a trace that synchronizes the "env" array.
*/
- Tcl_UntraceVar2(interp, "env", (char *) NULL,
+ Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
(ClientData) NULL);
- Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
if (environ[0] == NULL) {
Tcl_Obj *varNamePtr;
@@ -145,9 +143,9 @@ TclSetupEnv(interp)
Tcl_MutexUnlock(&envMutex);
}
- Tcl_TraceVar2(interp, "env", (char *) NULL,
+ Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
- TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
(ClientData) NULL);
}
@@ -157,11 +155,11 @@ TclSetupEnv(interp)
* TclSetEnv --
*
* Set an environment variable, replacing an existing value or creating a
- * new variable if there doesn't exist a variable by the given name.
- * This function is intended to be a stand-in for the UNIX "setenv"
- * function so that applications using that function will interface
- * properly to Tcl. To make it a stand-in, the Makefile must define
- * "TclSetEnv" to "setenv".
+ * new variable if there doesn't exist a variable by the given name. This
+ * function is intended to be a stand-in for the UNIX "setenv" function
+ * so that applications using that function will interface properly to
+ * Tcl. To make it a stand-in, the Makefile must define "TclSetEnv" to
+ * "setenv".
*
* Results:
* None.
@@ -173,10 +171,10 @@ TclSetupEnv(interp)
*/
void
-TclSetEnv(name, value)
- CONST char *name; /* Name of variable whose value is to be set
+TclSetEnv(
+ CONST char *name, /* Name of variable whose value is to be set
* (UTF-8). */
- CONST char *value; /* New value for variable (UTF-8). */
+ CONST char *value) /* New value for variable (UTF-8). */
{
Tcl_DString envString;
int index, length, nameLength;
@@ -196,22 +194,29 @@ TclSetEnv(name, value)
#ifndef USE_PUTENV
/*
* We need to handle the case where the environment may be changed
- * outside our control. environSize is only valid if the current
+ * outside our control. environSize is only valid if the current
* environment is the one we allocated. [Bug 979640]
*/
+
if ((ourEnviron != environ) || ((length + 2) > environSize)) {
char **newEnviron;
- newEnviron = (char **) ckalloc((unsigned)
- ((length + 5) * sizeof(char *)));
- memcpy((VOID *) newEnviron, (VOID *) environ,
- length*sizeof(char *));
+ newEnviron = (char **)
+ ckalloc((unsigned) ((length + 5) * sizeof(char *)));
+ memcpy((void *) newEnviron, (void *) environ,
+ length * sizeof(char *));
if ((environSize != 0) && (ourEnviron != NULL)) {
ckfree((char *) ourEnviron);
}
environ = ourEnviron = newEnviron;
environSize = length + 5;
+
#if defined(__APPLE__) && defined(__DYNAMIC__)
+ /*
+ * Install the new environment array where the system routines can
+ * see it.
+ */
+
{
char ***e = _NSGetEnviron();
*e = environ;
@@ -330,8 +335,8 @@ TclSetEnv(name, value)
*/
int
-Tcl_PutEnv(assignment)
- CONST char *assignment; /* Info about environment variable in the form
+Tcl_PutEnv(
+ CONST char *assignment) /* Info about environment variable in the form
* NAME=value. (native) */
{
Tcl_DString nameString;
@@ -379,8 +384,8 @@ Tcl_PutEnv(assignment)
*/
void
-TclUnsetEnv(name)
- CONST char *name; /* Name of variable to remove (UTF-8). */
+TclUnsetEnv(
+ CONST char *name) /* Name of variable to remove (UTF-8). */
{
char *oldValue;
int length;
@@ -404,6 +409,7 @@ TclUnsetEnv(name)
Tcl_MutexUnlock(&envMutex);
return;
}
+
/*
* Remember the old value so we can free it if Tcl created the string.
*/
@@ -411,7 +417,7 @@ TclUnsetEnv(name)
oldValue = environ[index];
/*
- * Update the system environment. This must be done before we update the
+ * Update the system environment. This must be done before we update the
* interpreters or we will recurse.
*/
@@ -420,16 +426,17 @@ TclUnsetEnv(name)
* For those platforms that support putenv to unset, Linux indicates
* that no = should be included, and Windows requires it.
*/
+
#ifdef WIN32
string = ckalloc((unsigned int) length+2);
- memcpy((VOID *) string, (VOID *) name, (size_t) length);
+ memcpy((void *) string, (void *) name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
#else
string = ckalloc((unsigned int) length+1);
- memcpy((VOID *) string, (VOID *) name, (size_t) length);
+ memcpy((void *) string, (void *) name, (size_t) length);
string[length] = '\0';
-#endif
+#endif /* WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
@@ -453,9 +460,9 @@ TclUnsetEnv(name)
*/
ckfree(string);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
}
-#else
+#else /* !USE_PUTENV_FOR_UNSET */
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
@@ -463,7 +470,7 @@ TclUnsetEnv(name)
}
}
ReplaceString(oldValue, NULL);
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
Tcl_MutexUnlock(&envMutex);
}
@@ -489,10 +496,10 @@ TclUnsetEnv(name)
*/
CONST char *
-TclGetEnv(name, valuePtr)
- CONST char *name; /* Name of environment variable to find
+TclGetEnv(
+ CONST char *name, /* Name of environment variable to find
* (UTF-8). */
- Tcl_DString *valuePtr; /* Uninitialized or free DString in which the
+ Tcl_DString *valuePtr) /* Uninitialized or free DString in which the
* value of the environment variable is
* stored. */
{
@@ -543,14 +550,14 @@ TclGetEnv(name, valuePtr)
/* ARGSUSED */
static char *
-EnvTraceProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Interpreter whose "env" variable is being
+EnvTraceProc(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter whose "env" variable is being
* modified. */
- CONST char *name1; /* Better be "env". */
- CONST char *name2; /* Name of variable being modified, or NULL if
+ CONST char *name1, /* Better be "env". */
+ CONST char *name2, /* Name of variable being modified, or NULL if
* whole array is being deleted (UTF-8). */
- int flags; /* Indicates what's happening. */
+ int flags) /* Indicates what's happening. */
{
/*
* For array traces, let TclSetupEnv do all the work.
@@ -611,8 +618,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*
* ReplaceString --
*
- * Replace one string with another in the environment variable cache.
- * The cache keeps track of all of the environment variables that Tcl has
+ * Replace one string with another in the environment variable cache. The
+ * cache keeps track of all of the environment variables that Tcl has
* modified so they can be freed later.
*
* Results:
@@ -625,9 +632,9 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
*/
static void
-ReplaceString(oldStr, newStr)
- CONST char *oldStr; /* Old environment string. */
- char *newStr; /* New environment string. */
+ReplaceString(
+ CONST char *oldStr, /* Old environment string. */
+ char *newStr) /* New environment string. */
{
int i;
char **newCache;
@@ -669,10 +676,10 @@ ReplaceString(oldStr, newStr)
*/
newCache = (char **) ckalloc((unsigned) allocatedSize);
- (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
+ (void) memset(newCache, (int) 0, (size_t) allocatedSize);
if (environCache) {
- memcpy((VOID *) newCache, (VOID *) environCache,
+ memcpy((void *) newCache, (void *) environCache,
(size_t) (cacheSize * sizeof(char*)));
ckfree((char *) environCache);
}
@@ -702,7 +709,7 @@ ReplaceString(oldStr, newStr)
*/
void
-TclFinalizeEnvironment()
+TclFinalizeEnvironment(void)
{
/*
* For now we just deallocate the cache array and none of the environment
@@ -734,8 +741,8 @@ TclFinalizeEnvironment()
*/
static void
-TclCygwinPutenv(str)
- const char *str;
+TclCygwinPutenv(
+ const char *str)
{
char *name, *value;
@@ -786,7 +793,7 @@ TclCygwinPutenv(str)
*/
if (strcmp(name, "Path") == 0) {
- SetEnvironmentVariable("PATH", (char *) NULL);
+ SetEnvironmentVariable("PATH", NULL);
unsetenv("PATH");
}
@@ -798,7 +805,7 @@ TclCygwinPutenv(str)
* Eliminate any Path variable, to prevent any confusion.
*/
- SetEnvironmentVariable("Path", (char *) NULL);
+ SetEnvironmentVariable("Path", NULL);
unsetenv("Path");
if (value == NULL) {
@@ -814,7 +821,6 @@ TclCygwinPutenv(str)
SetEnvironmentVariable(name, buf);
}
}
-
#endif /* __CYGWIN__ && __WIN32__ */
/*
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index cea3a15..c36d875 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1,9 +1,9 @@
-/*
+/*
* tclEvent.c --
*
* This file implements some general event related interfaces including
* background errors, exit handlers, and the "vwait" and "update" command
- * procedures.
+ * functions.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -12,13 +12,13 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEvent.c,v 1.64 2005/08/17 21:27:41 kennykb Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.65 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
/*
- * The data structure below is used to report background errors. One such
+ * The data structure below is used to report background errors. One such
* structure is allocated for each error; it holds information about the
* interpreter and the error until an idle handler command can be invoked.
*/
@@ -35,7 +35,7 @@ typedef struct BgError {
/*
* One of the structures below is associated with the "tclBgError" assoc data
- * for each interpreter. It keeps track of the head and tail of the list of
+ * for each interpreter. It keeps track of the head and tail of the list of
* pending background errors for the interpreter.
*/
@@ -51,20 +51,20 @@ typedef struct ErrAssocData {
} ErrAssocData;
/*
- * For each exit handler created with a call to Tcl_CreateExitHandler
- * there is a structure of the following type:
+ * For each exit handler created with a call to Tcl_CreateExitHandler there is
+ * a structure of the following type:
*/
typedef struct ExitHandler {
- Tcl_ExitProc *proc; /* Procedure to call when process exits. */
+ Tcl_ExitProc *proc; /* Function to call when process exits. */
ClientData clientData; /* One word of information to pass to proc. */
struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
* application, or NULL for end of list. */
} ExitHandler;
/*
- * There is both per-process and per-thread exit handlers. The first list is
- * controlled by a mutex. The other is in thread local storage.
+ * There is both per-process and per-thread exit handlers. The first list is
+ * controlled by a mutex. The other is in thread local storage.
*/
static ExitHandler *firstExitPtr = NULL;
@@ -83,7 +83,7 @@ static int inFinalize = 0;
static int subsystemsInitialized = 0;
/*
- * This variable contains the application wide exit handler. It will be
+ * This variable contains the application wide exit handler. It will be
* called by Tcl_Exit instead of the C-runtime exit if this variable is set
* to a non-NULL value.
*/
@@ -91,7 +91,7 @@ static int subsystemsInitialized = 0;
static Tcl_ExitProc *appExitPtr = NULL;
typedef struct ThreadSpecificData {
- ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
+ ExitHandler *firstExitPtr; /* First in list of all exit handlers for this
* thread. */
int inExit; /* True when this thread is exiting. This is
* used as a hack to decide to close the
@@ -100,32 +100,29 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
#ifdef TCL_THREADS
-
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
} ThreadClientData;
-static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
- ClientData clientData));
-#endif
+static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
+#endif /* TCL_THREADS */
/*
- * Prototypes for procedures referenced only in this file:
+ * Prototypes for functions referenced only in this file:
*/
-static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-static void HandleBgErrors _ANSI_ARGS_((ClientData clientData));
-static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, CONST char *name1,
- CONST char *name2, int flags));
+static void BgErrorDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static void HandleBgErrors(ClientData clientData);
+static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp,
+ CONST char *name1, CONST char *name2, int flags);
/*
*----------------------------------------------------------------------
*
* Tcl_BackgroundError --
*
- * This procedure is invoked to handle errors that occur in Tcl commands
+ * This function is invoked to handle errors that occur in Tcl commands
* that are invoked in "background" (e.g. from event or timer bindings).
*
* Results:
@@ -139,8 +136,8 @@ static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData,
*/
void
-Tcl_BackgroundError(interp)
- Tcl_Interp *interp; /* Interpreter in which an error has
+Tcl_BackgroundError(
+ Tcl_Interp *interp) /* Interpreter in which an error has
* occurred. */
{
BgError *errPtr;
@@ -154,8 +151,7 @@ Tcl_BackgroundError(interp)
errPtr->nextPtr = NULL;
(void) TclGetBgErrorHandler(interp);
- assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError",
- (Tcl_InterpDeleteProc **) NULL);
+ assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr->firstBgPtr == NULL) {
assocPtr->firstBgPtr = errPtr;
Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
@@ -171,7 +167,7 @@ Tcl_BackgroundError(interp)
*
* HandleBgErrors --
*
- * This procedure is invoked as an idle handler to process all of the
+ * This function is invoked as an idle handler to process all of the
* accumulated background errors.
*
* Results:
@@ -184,15 +180,15 @@ Tcl_BackgroundError(interp)
*/
static void
-HandleBgErrors(clientData)
- ClientData clientData; /* Pointer to ErrAssocData structure. */
+HandleBgErrors(
+ ClientData clientData) /* Pointer to ErrAssocData structure. */
{
ErrAssocData *assocPtr = (ErrAssocData *) clientData;
Tcl_Interp *interp = assocPtr->interp;
BgError *errPtr;
/*
- * Not bothering to save/restore the interp state. Assume that any code
+ * Not bothering to save/restore the interp state. Assume that any code
* that has interp state it needs to keep will make its own
* Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent()
* that could lead us here.
@@ -231,6 +227,7 @@ HandleBgErrors(clientData)
* Break means cancel any remaining error reports for this
* interpreter.
*/
+
while (assocPtr->firstBgPtr != NULL) {
errPtr = assocPtr->firstBgPtr;
assocPtr->firstBgPtr = errPtr->nextPtr;
@@ -240,6 +237,7 @@ HandleBgErrors(clientData)
}
} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+
if (errChannel != (Tcl_Channel) NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
Tcl_Obj *keyPtr = Tcl_NewStringObj("-errorinfo", -1);
@@ -271,7 +269,7 @@ HandleBgErrors(clientData)
*
* TclDefaultBgErrorHandlerObjCmd --
*
- * This procedure is invoked to process the "::tcl::Bgerror" Tcl command.
+ * This function is invoked to process the "::tcl::Bgerror" Tcl command.
* It is the default handler command registered with [interp bgerror] for
* the sake of compatibility with older Tcl releases.
*
@@ -285,11 +283,11 @@ HandleBgErrors(clientData)
*/
int
-TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclDefaultBgErrorHandlerObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Obj *keyPtr, *valuePtr;
Tcl_Obj *tempObjv[2];
@@ -362,7 +360,7 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
}
} else {
Tcl_WriteChars(errChannel,
- "bgerror failed to handle background error.\n", -1);
+ "bgerror failed to handle background error.\n",-1);
Tcl_WriteChars(errChannel, " Original error: ", -1);
Tcl_WriteObj(errChannel, objv[1]);
Tcl_WriteChars(errChannel, "\n", -1);
@@ -386,7 +384,7 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
*
* TclSetBgErrorHandler --
*
- * This procedure sets the command prefix to be used to handle background
+ * This function sets the command prefix to be used to handle background
* errors in interp.
*
* Results:
@@ -399,18 +397,21 @@ TclDefaultBgErrorHandlerObjCmd(dummy, interp, objc, objv)
*/
void
-TclSetBgErrorHandler(interp, cmdPrefix)
- Tcl_Interp *interp;
- Tcl_Obj *cmdPrefix;
+TclSetBgErrorHandler(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdPrefix)
{
- ErrAssocData *assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ ErrAssocData *assocPtr = (ErrAssocData *)
+ Tcl_GetAssocData(interp, "tclBgError", NULL);
if (cmdPrefix == NULL) {
Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
}
if (assocPtr == NULL) {
- /* First access: initialize */
+ /*
+ * First access: initialize.
+ */
+
assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
assocPtr->interp = interp;
assocPtr->cmdPrefix = NULL;
@@ -431,7 +432,7 @@ TclSetBgErrorHandler(interp, cmdPrefix)
*
* TclGetBgErrorHandler --
*
- * This procedure retrieves the command prefix currently used to handle
+ * This function retrieves the command prefix currently used to handle
* background errors in interp.
*
* Results:
@@ -444,16 +445,16 @@ TclSetBgErrorHandler(interp, cmdPrefix)
*/
Tcl_Obj *
-TclGetBgErrorHandler(interp)
- Tcl_Interp *interp;
+TclGetBgErrorHandler(
+ Tcl_Interp *interp)
{
- ErrAssocData *assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ ErrAssocData *assocPtr = (ErrAssocData *)
+ Tcl_GetAssocData(interp, "tclBgError", NULL);
if (assocPtr == NULL) {
TclSetBgErrorHandler(interp, Tcl_NewStringObj("::tcl::Bgerror", -1));
- assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp,
- "tclBgError", (Tcl_InterpDeleteProc **) NULL);
+ assocPtr = (ErrAssocData *)
+ Tcl_GetAssocData(interp, "tclBgError", NULL);
}
return assocPtr->cmdPrefix;
}
@@ -463,7 +464,7 @@ TclGetBgErrorHandler(interp)
*
* BgErrorDeleteProc --
*
- * This procedure is associated with the "tclBgError" assoc data for an
+ * This function is associated with the "tclBgError" assoc data for an
* interpreter; it is invoked when the interpreter is deleted in order to
* free the information assoicated with any pending error reports.
*
@@ -478,9 +479,9 @@ TclGetBgErrorHandler(interp)
*/
static void
-BgErrorDeleteProc(clientData, interp)
- ClientData clientData; /* Pointer to ErrAssocData structure. */
- Tcl_Interp *interp; /* Interpreter being deleted. */
+BgErrorDeleteProc(
+ ClientData clientData, /* Pointer to ErrAssocData structure. */
+ Tcl_Interp *interp) /* Interpreter being deleted. */
{
ErrAssocData *assocPtr = (ErrAssocData *) clientData;
BgError *errPtr;
@@ -502,8 +503,8 @@ BgErrorDeleteProc(clientData, interp)
*
* Tcl_CreateExitHandler --
*
- * Arrange for a given procedure to be invoked just before the
- * application exits.
+ * Arrange for a given function to be invoked just before the application
+ * exits.
*
* Results:
* None.
@@ -516,9 +517,9 @@ BgErrorDeleteProc(clientData, interp)
*/
void
-Tcl_CreateExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure to invoke. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_CreateExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr;
@@ -536,7 +537,7 @@ Tcl_CreateExitHandler(proc, clientData)
*
* Tcl_DeleteExitHandler --
*
- * This procedure cancels an existing exit handler matching proc and
+ * This function cancels an existing exit handler matching proc and
* clientData, if such a handler exits.
*
* Results:
@@ -550,9 +551,9 @@ Tcl_CreateExitHandler(proc, clientData)
*/
void
-Tcl_DeleteExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure that was previously registered. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_DeleteExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
@@ -579,7 +580,7 @@ Tcl_DeleteExitHandler(proc, clientData)
*
* Tcl_CreateThreadExitHandler --
*
- * Arrange for a given procedure to be invoked just before the current
+ * Arrange for a given function to be invoked just before the current
* thread exits.
*
* Results:
@@ -593,9 +594,9 @@ Tcl_DeleteExitHandler(proc, clientData)
*/
void
-Tcl_CreateThreadExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure to invoke. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_CreateThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function to invoke. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -612,7 +613,7 @@ Tcl_CreateThreadExitHandler(proc, clientData)
*
* Tcl_DeleteThreadExitHandler --
*
- * This procedure cancels an existing exit handler matching proc and
+ * This function cancels an existing exit handler matching proc and
* clientData, if such a handler exits.
*
* Results:
@@ -626,9 +627,9 @@ Tcl_CreateThreadExitHandler(proc, clientData)
*/
void
-Tcl_DeleteThreadExitHandler(proc, clientData)
- Tcl_ExitProc *proc; /* Procedure that was previously registered. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+Tcl_DeleteThreadExitHandler(
+ Tcl_ExitProc *proc, /* Function that was previously registered. */
+ ClientData clientData) /* Arbitrary value to pass to proc. */
{
ExitHandler *exitPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -653,8 +654,8 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
*
* Tcl_SetExitProc --
*
- * This procedure sets the application wide exit handler that will be
- * called by Tcl_Exit in place of the C-runtime exit. If the application
+ * This function sets the application wide exit handler that will be
+ * called by Tcl_Exit in place of the C-runtime exit. If the application
* wide exit handler is NULL, the C-runtime exit will be used instead.
*
* Results:
@@ -667,8 +668,8 @@ Tcl_DeleteThreadExitHandler(proc, clientData)
*/
Tcl_ExitProc *
-Tcl_SetExitProc(proc)
- Tcl_ExitProc *proc; /* new exit handler for app or NULL */
+Tcl_SetExitProc(
+ Tcl_ExitProc *proc) /* New exit handler for app or NULL */
{
Tcl_ExitProc *prevExitProc;
@@ -690,7 +691,7 @@ Tcl_SetExitProc(proc)
*
* Tcl_Exit --
*
- * This procedure is called to terminate the application.
+ * This function is called to terminate the application.
*
* Results:
* None.
@@ -702,9 +703,9 @@ Tcl_SetExitProc(proc)
*/
void
-Tcl_Exit(status)
- int status; /* Exit status for application; typically
- * 0 for normal return, 1 for error return. */
+Tcl_Exit(
+ int status) /* Exit status for application; typically 0
+ * for normal return, 1 for error return. */
{
Tcl_ExitProc *currentAppExitPtr;
@@ -715,14 +716,17 @@ Tcl_Exit(status)
if (currentAppExitPtr) {
/*
* Warning: this code SHOULD NOT return, as there is code that depends
- * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
+ * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
* returns, so critical is this dependcy.
*/
currentAppExitPtr((ClientData) status);
Tcl_Panic("AppExitProc returned unexpectedly");
} else {
- /* use default handling */
+ /*
+ * Use default handling.
+ */
+
Tcl_Finalize();
TclpExit(status);
Tcl_Panic("OS exit failed!");
@@ -734,7 +738,7 @@ Tcl_Exit(status)
*
* TclInitSubsystems --
*
- * Initialize various subsytems in Tcl. This should be called the first
+ * Initialize various subsytems in Tcl. This should be called the first
* time an interp is created, or before any of the subsystems are used.
* This function ensures an order for the initialization of subsystems:
*
@@ -755,16 +759,16 @@ Tcl_Exit(status)
*/
void
-TclInitSubsystems()
+TclInitSubsystems(void)
{
if (inFinalize != 0) {
Tcl_Panic("TclInitSubsystems called while finalizing");
}
if (subsystemsInitialized == 0) {
- /*
- * Double check inside the mutex. There are definitly calls back into
- * this routine from some of the procedures below.
+ /*
+ * Double check inside the mutex. There are definitly calls back into
+ * this routine from some of the functions below.
*/
TclpInitLock();
@@ -811,8 +815,8 @@ TclInitSubsystems()
*
* Tcl_Finalize --
*
- * Shut down Tcl. First calls registered exit handlers, then carefully
- * shuts down various subsystems. Called by Tcl_Exit or when the Tcl
+ * Shut down Tcl. First calls registered exit handlers, then carefully
+ * shuts down various subsystems. Called by Tcl_Exit or when the Tcl
* shared library is being unloaded.
*
* Results:
@@ -825,10 +829,10 @@ TclInitSubsystems()
*/
void
-Tcl_Finalize()
+Tcl_Finalize(void)
{
ExitHandler *exitPtr;
-
+
/*
* Invoke exit handlers first.
*/
@@ -838,7 +842,7 @@ Tcl_Finalize()
for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
/*
* Be careful to remove the handler from the list before invoking its
- * callback. This protects us against double-freeing if the callback
+ * callback. This protects us against double-freeing if the callback
* should call Tcl_DeleteExitHandler on itself.
*/
@@ -847,138 +851,146 @@ Tcl_Finalize()
(*exitPtr->proc)(exitPtr->clientData);
ckfree((char *) exitPtr);
Tcl_MutexLock(&exitMutex);
- }
+ }
firstExitPtr = NULL;
Tcl_MutexUnlock(&exitMutex);
TclpInitLock();
- if (subsystemsInitialized != 0) {
- subsystemsInitialized = 0;
+ if (subsystemsInitialized == 0) {
+ goto alreadyFinalized;
+ }
+ subsystemsInitialized = 0;
- /*
- * Ensure the thread-specific data is initialised as it is used in
- * Tcl_FinalizeThread()
- */
+ /*
+ * Ensure the thread-specific data is initialised as it is used in
+ * Tcl_FinalizeThread()
+ */
- (void) TCL_TSD_INIT(&dataKey);
+ (void) TCL_TSD_INIT(&dataKey);
- /*
- * Clean up after the current thread now, after exit handlers. In
- * particular, the testexithandler command sets up something that
- * writes to standard output, which gets closed. Note that there is
- * no thread-local storage after this call.
- */
+ /*
+ * Clean up after the current thread now, after exit handlers. In
+ * particular, the testexithandler command sets up something that writes
+ * to standard output, which gets closed. Note that there is no
+ * thread-local storage or IO subsystem after this call.
+ */
- Tcl_FinalizeThread();
+ Tcl_FinalizeThread();
- /*
- * Now finalize the Tcl execution environment. Note that this must be
- * done after the exit handlers, because there are order dependencies.
- */
+ /*
+ * Now finalize the Tcl execution environment. Note that this must be done
+ * after the exit handlers, because there are order dependencies.
+ */
- TclFinalizeCompilation();
- TclFinalizeExecution();
- TclFinalizeEnvironment();
+ TclFinalizeCompilation();
+ TclFinalizeExecution();
+ TclFinalizeEnvironment();
- /*
- * Finalizing the filesystem must come after anything which might
- * conceivably interact with the 'Tcl_FS' API.
- */
+ /*
+ * Finalizing the filesystem must come after anything which might
+ * conceivably interact with the 'Tcl_FS' API.
+ */
- TclFinalizeFilesystem();
+ TclFinalizeFilesystem();
- /*
- * Undo all Tcl_ObjType registrations, and reset the master list
- * of free Tcl_Obj's. After this returns, no more Tcl_Obj's should
- * be allocated or freed.
- *
- * Note in particular that TclFinalizeObjects() must follow
- * TclFinalizeFilesystem() because TclFinalizeFilesystem free's
- * the Tcl_Obj that holds the path of the current working directory.
- */
+ /*
+ * Undo all Tcl_ObjType registrations, and reset the master list of free
+ * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
+ * freed.
+ *
+ * Note in particular that TclFinalizeObjects() must follow
+ * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the
+ * Tcl_Obj that holds the path of the current working directory.
+ */
- TclFinalizeObjects();
+ TclFinalizeObjects();
- /*
- * We must be sure the encoding finalization doesn't need to examine
- * the filesystem in any way. Since it only needs to clean up
- * internal data structures, this is fine.
- */
+ /*
+ * We must be sure the encoding finalization doesn't need to examine the
+ * filesystem in any way. Since it only needs to clean up internal data
+ * structures, this is fine.
+ */
- TclFinalizeEncodingSubsystem();
+ TclFinalizeEncodingSubsystem();
- Tcl_SetPanicProc(NULL);
+ Tcl_SetPanicProc(NULL);
- /*
- * Repeat finalization of the thread local storage once more. Although
- * this step is already done by the Tcl_FinalizeThread call above,
- * series of events happening afterwards may re-initialize TSD slots.
- * Those need to be finalized again, otherwise we're leaking memory
- * chunks. Very important to note is that things happening afterwards
- * should not reference anything which may re-initialize TSD's. This
- * includes freeing Tcl_Objs's, among other things.
- *
- * This fixes the Tcl Bug #990552.
- */
+ /*
+ * Repeat finalization of the thread local storage once more. Although
+ * this step is already done by the Tcl_FinalizeThread call above, series
+ * of events happening afterwards may re-initialize TSD slots. Those need
+ * to be finalized again, otherwise we're leaking memory chunks. Very
+ * important to note is that things happening afterwards should not
+ * reference anything which may re-initialize TSD's. This includes freeing
+ * Tcl_Objs's, among other things.
+ *
+ * This fixes the Tcl Bug #990552.
+ */
- TclFinalizeThreadData();
+ TclFinalizeThreadData();
- /*
- * Now we can free constants for conversions to/from double.
- */
+ /*
+ * Now we can free constants for conversions to/from double.
+ */
- TclFinalizeDoubleConversion();
-
- /*
- * There have been several bugs in the past that cause exit handlers
- * to be established during Tcl_Finalize processing. Such exit
- * handlers leave malloc'ed memory, and Tcl_FinalizeThreadAlloc or
- * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The
- * result can be a mysterious crash on process exit. Check here that
- * nobody's done this.
- */
+ TclFinalizeDoubleConversion();
- if (firstExitPtr != NULL) {
- Tcl_Panic("exit handlers were created during Tcl_Finalize");
- }
+ /*
+ * There have been several bugs in the past that cause exit handlers to be
+ * established during Tcl_Finalize processing. Such exit handlers leave
+ * malloc'ed memory, and Tcl_FinalizeThreadAlloc or
+ * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The result
+ * can be a mysterious crash on process exit. Check here that nobody's
+ * done this.
+ */
- TclFinalizePreserve();
+ if (firstExitPtr != NULL) {
+ Tcl_Panic("exit handlers were created during Tcl_Finalize");
+ }
- /*
- * Free synchronization objects. There really should only be one
- * thread alive at this moment.
- */
+ TclFinalizePreserve();
+
+ /*
+ * Free synchronization objects. There really should only be one thread
+ * alive at this moment.
+ */
+
+ TclFinalizeSynchronization();
- TclFinalizeSynchronization();
+ /*
+ * Close down the thread-specific object allocator.
+ */
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
- TclFinalizeThreadAlloc();
+ TclFinalizeThreadAlloc();
#endif
- /*
- * We defer unloading of packages until very late to avoid memory
- * access issues. Both exit callbacks and synchronization variables
- * may be stored in packages.
- *
- * Note that TclFinalizeLoad unloads packages in the reverse of the
- * order they were loaded in (i.e. last to be loaded is the first to
- * be unloaded). This can be important for correct unloading when
- * dependencies exist.
- *
- * Once load has been finalized, we will have deleted any temporary
- * copies of shared libraries and can therefore reset the filesystem
- * to its original state.
- */
- TclFinalizeLoad();
- TclResetFilesystem();
+ /*
+ * We defer unloading of packages until very late to avoid memory access
+ * issues. Both exit callbacks and synchronization variables may be stored
+ * in packages.
+ *
+ * Note that TclFinalizeLoad unloads packages in the reverse of the order
+ * they were loaded in (i.e. last to be loaded is the first to be
+ * unloaded). This can be important for correct unloading when
+ * dependencies exist.
+ *
+ * Once load has been finalized, we will have deleted any temporary copies
+ * of shared libraries and can therefore reset the filesystem to its
+ * original state.
+ */
- /*
- * At this point, there should no longer be any ckalloc'ed memory.
- */
+ TclFinalizeLoad();
+ TclResetFilesystem();
- TclFinalizeMemorySubsystem();
- inFinalize = 0;
- }
+ /*
+ * At this point, there should no longer be any ckalloc'ed memory.
+ */
+
+ TclFinalizeMemorySubsystem();
+ inFinalize = 0;
+
+ alreadyFinalized:
TclFinalizeLock();
}
@@ -1000,18 +1012,18 @@ Tcl_Finalize()
*/
void
-Tcl_FinalizeThread()
+Tcl_FinalizeThread(void)
{
ExitHandler *exitPtr;
- /*
- * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData,
- * because we don't want to initialize the data block if it hasn't
- * been initialized already.
+ /*
+ * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
+ * we don't want to initialize the data block if it hasn't been
+ * initialized already.
*/
- ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ TclThreadDataKeyGet(&dataKey);
if (tsdPtr != NULL) {
tsdPtr->inExit = 1;
@@ -1020,7 +1032,7 @@ Tcl_FinalizeThread()
exitPtr = tsdPtr->firstExitPtr) {
/*
* Be careful to remove the handler from the list before invoking
- * its callback. This protects us against double-freeing if the
+ * its callback. This protects us against double-freeing if the
* callback should call Tcl_DeleteThreadExitHandler on itself.
*/
@@ -1063,7 +1075,7 @@ Tcl_FinalizeThread()
*/
int
-TclInExit()
+TclInExit(void)
{
return inFinalize;
}
@@ -1085,7 +1097,7 @@ TclInExit()
*/
int
-TclInThreadExit()
+TclInThreadExit(void)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
TclThreadDataKeyGet(&dataKey);
@@ -1101,7 +1113,7 @@ TclInThreadExit()
*
* Tcl_VwaitObjCmd --
*
- * This procedure is invoked to process the "vwait" Tcl command. See the
+ * This function is invoked to process the "vwait" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1115,11 +1127,11 @@ TclInThreadExit()
/* ARGSUSED */
int
-Tcl_VwaitObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_VwaitObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int done, foundEvent;
char *nameString;
@@ -1156,7 +1168,7 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
if (!foundEvent) {
Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
- "\": would wait forever", (char *) NULL);
+ "\": would wait forever", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1164,17 +1176,17 @@ Tcl_VwaitObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
static char *
-VwaitVarProc(clientData, interp, name1, name2, flags)
- ClientData clientData; /* Pointer to integer to set to 1. */
- Tcl_Interp *interp; /* Interpreter containing variable. */
- CONST char *name1; /* Name of variable. */
- CONST char *name2; /* Second part of variable name. */
- int flags; /* Information about what happened. */
+VwaitVarProc(
+ ClientData clientData, /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp, /* Interpreter containing variable. */
+ CONST char *name1, /* Name of variable. */
+ CONST char *name2, /* Second part of variable name. */
+ int flags) /* Information about what happened. */
{
int *donePtr = (int *) clientData;
*donePtr = 1;
- return (char *) NULL;
+ return NULL;
}
/*
@@ -1182,8 +1194,8 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
*
* Tcl_UpdateObjCmd --
*
- * This procedure is invoked to process the "update" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "update" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1196,15 +1208,15 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
/* ARGSUSED */
int
-Tcl_UpdateObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_UpdateObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int optionIndex;
int flags = 0; /* Initialized to avoid compiler warning. */
- static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+ static CONST char *updateOptions[] = {"idletasks", NULL};
enum updateOptions {REGEXP_IDLETASKS};
if (objc == 1) {
@@ -1225,7 +1237,7 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
return TCL_ERROR;
}
-
+
while (Tcl_DoOneEvent(flags) != 0) {
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
@@ -1247,7 +1259,7 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
/*
*-----------------------------------------------------------------------------
*
- * NewThreadProc --
+ * NewThreadProc --
*
* Bootstrap function of a new Tcl thread.
*
@@ -1261,16 +1273,17 @@ Tcl_UpdateObjCmd(clientData, interp, objc, objv)
*/
static Tcl_ThreadCreateType
-NewThreadProc(ClientData clientData)
+NewThreadProc(
+ ClientData clientData)
{
ThreadClientData *cdPtr;
ClientData threadClientData;
Tcl_ThreadCreateProc *threadProc;
- cdPtr = (ThreadClientData *)clientData;
+ cdPtr = (ThreadClientData *) clientData;
threadProc = cdPtr->proc;
threadClientData = cdPtr->clientData;
- Tcl_Free((char*)clientData); /* Allocated in Tcl_CreateThread() */
+ Tcl_Free((char *) clientData); /* Allocated in Tcl_CreateThread() */
(*threadProc)(threadClientData);
@@ -1283,12 +1296,12 @@ NewThreadProc(ClientData clientData)
*
* Tcl_CreateThread --
*
- * This procedure creates a new thread. This actually belongs to the
+ * This function creates a new thread. This actually belongs to the
* tclThread.c file but since we use some private data structures local
* to this file, it is placed here.
*
* Results:
- * TCL_OK if the thread could be created. The thread ID is returned in a
+ * TCL_OK if the thread could be created. The thread ID is returned in a
* parameter.
*
* Side effects:
@@ -1298,13 +1311,13 @@ NewThreadProc(ClientData clientData)
*/
int
-Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
- Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
- Tcl_ThreadCreateProc proc; /* Main() function of the thread */
- ClientData clientData; /* The one argument to Main() */
- int stackSize; /* Size of stack for the new thread */
- int flags; /* Flags controlling behaviour of the
- * new thread. */
+Tcl_CreateThread(
+ Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc, /* Main() function of the thread */
+ ClientData clientData, /* The one argument to Main() */
+ int stackSize, /* Size of stack for the new thread */
+ int flags) /* Flags controlling behaviour of the new
+ * thread. */
{
#ifdef TCL_THREADS
ThreadClientData *cdPtr;
@@ -1313,7 +1326,7 @@ Tcl_CreateThread(idPtr, proc, clientData, stackSize, flags)
cdPtr->proc = proc;
cdPtr->clientData = clientData;
- return TclpThreadCreate(idPtr, NewThreadProc, (ClientData)cdPtr,
+ return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr,
stackSize, flags);
#else
return TCL_ERROR;
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 3c79e85..516ffcf 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFCmd.c,v 1.35 2005/07/24 22:56:43 dkf Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.36 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -18,15 +18,14 @@
* Declarations for local functions defined in this file:
*/
-static int CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,
+static int CopyRenameOneFile(Tcl_Interp *interp,
Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
- int copyFlag, int force));
-static Tcl_Obj * FileBasename _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr));
-static int FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int copyFlag));
-static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[], int *forcePtr));
+ int copyFlag, int force);
+static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr);
+static int FileCopyRename(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], int copyFlag);
+static int FileForceOption(Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], int *forcePtr);
/*
*---------------------------------------------------------------------------
@@ -48,10 +47,11 @@ static int FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,
*/
int
-TclFileRenameCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Interp for error reporting. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+TclFileRenameCmd(
+ Tcl_Interp *interp, /* Interp for error reporting or recursive
+ * calls in the case of a tricky rename. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 0);
}
@@ -75,10 +75,11 @@ TclFileRenameCmd(interp, objc, objv)
*/
int
-TclFileCopyCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+TclFileCopyCmd(
+ Tcl_Interp *interp, /* Used for error reporting or recursive calls
+ * in the case of a tricky copy. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 1);
}
@@ -101,11 +102,11 @@ TclFileCopyCmd(interp, objc, objv)
*/
static int
-FileCopyRename(interp, objc, objv, copyFlag)
- Tcl_Interp *interp; /* Used for error reporting. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
- int copyFlag; /* If non-zero, copy source(s). Otherwise,
+FileCopyRename(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[], /* Argument strings passed to Tcl_FileCmd. */
+ int copyFlag) /* If non-zero, copy source(s). Otherwise,
* rename them. */
{
int i, result, force;
@@ -120,8 +121,7 @@ FileCopyRename(interp, objc, objv, copyFlag)
if ((objc - i) < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
TclGetString(objv[0]), " ", TclGetString(objv[1]),
- " ?options? source ?source ...? target\"",
- (char *) NULL);
+ " ?options? source ?source ...? target\"", NULL);
return TCL_ERROR;
}
@@ -149,9 +149,8 @@ FileCopyRename(interp, objc, objv, copyFlag)
errno = ENOTDIR;
Tcl_PosixError(interp);
Tcl_AppendResult(interp, "error ",
- ((copyFlag) ? "copying" : "renaming"), ": target \"",
- TclGetString(target), "\" is not a directory",
- (char *) NULL);
+ (copyFlag ? "copying" : "renaming"), ": target \"",
+ TclGetString(target), "\" is not a directory", NULL);
result = TCL_ERROR;
} else {
/*
@@ -216,11 +215,12 @@ FileCopyRename(interp, objc, objv, copyFlag)
*
*----------------------------------------------------------------------
*/
+
int
-TclFileMakeDirsCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting. */
- int objc; /* Number of arguments */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+TclFileMakeDirsCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
Tcl_Obj *errfile;
int result, i, j, pobjc;
@@ -307,8 +307,7 @@ TclFileMakeDirsCmd(interp, objc, objv)
done:
if (errfile != NULL) {
Tcl_AppendResult(interp, "can't create directory \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
result = TCL_ERROR;
}
if (split != NULL) {
@@ -338,10 +337,10 @@ TclFileMakeDirsCmd(interp, objc, objv)
*/
int
-TclFileDeleteCmd(interp, objc, objv)
- Tcl_Interp *interp; /* Used for error reporting */
- int objc; /* Number of arguments */
- Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+TclFileDeleteCmd(
+ Tcl_Interp *interp, /* Used for error reporting */
+ int objc, /* Number of arguments */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
int i, force, result;
Tcl_Obj *errfile;
@@ -355,7 +354,7 @@ TclFileDeleteCmd(interp, objc, objv)
if ((objc - i) < 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
TclGetString(objv[0]), " ", TclGetString(objv[1]),
- " ?options? file ?file ...?\"", (char *) NULL);
+ " ?options? file ?file ...?\"", NULL);
return TCL_ERROR;
}
@@ -395,7 +394,7 @@ TclFileDeleteCmd(interp, objc, objv)
if ((force == 0) && (errno == EEXIST)) {
Tcl_AppendResult(interp, "error deleting \"",
TclGetString(objv[i]), "\": directory not empty",
- (char *) NULL);
+ NULL);
Tcl_PosixError(interp);
goto done;
}
@@ -436,11 +435,11 @@ TclFileDeleteCmd(interp, objc, objv)
*/
Tcl_AppendResult(interp, "error deleting unknown file: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
} else {
Tcl_AppendResult(interp, "error deleting \"",
TclGetString(errfile), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ NULL);
}
}
@@ -471,15 +470,15 @@ TclFileDeleteCmd(interp, objc, objv)
*/
static int
-CopyRenameOneFile(interp, source, target, copyFlag, force)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *source; /* Pathname of file to copy. May need to be
+CopyRenameOneFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *source, /* Pathname of file to copy. May need to be
* translated. */
- Tcl_Obj *target; /* Pathname of file to create/overwrite. May
+ Tcl_Obj *target, /* Pathname of file to create/overwrite. May
* need to be translated. */
- int copyFlag; /* If non-zero, copy files. Otherwise, rename
+ int copyFlag, /* If non-zero, copy files. Otherwise, rename
* them. */
- int force; /* If non-zero, overwrite target file if it
+ int force) /* If non-zero, overwrite target file if it
* exists. Otherwise, error if target already
* exists. */
{
@@ -549,7 +548,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
errno = EISDIR;
Tcl_AppendResult(interp, "can't overwrite file \"",
TclGetString(target), "\" with directory \"",
- TclGetString(source), "\"", (char *) NULL);
+ TclGetString(source), "\"", NULL);
goto done;
}
if (!S_ISDIR(sourceStatBuf.st_mode)
@@ -557,7 +556,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
errno = EISDIR;
Tcl_AppendResult(interp, "can't overwrite directory \"",
TclGetString(target), "\" with file \"",
- TclGetString(source), "\"", (char *) NULL);
+ TclGetString(source), "\"", NULL);
goto done;
}
@@ -589,7 +588,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
Tcl_AppendResult(interp, "error renaming \"",
TclGetString(source), "\" to \"", TclGetString(target),
"\": trying to rename a volume or ",
- "move a directory into itself", (char *) NULL);
+ "move a directory into itself", NULL);
goto done;
} else if (errno != EXDEV) {
errfile = target;
@@ -634,8 +633,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
- "\": the target of this link doesn't exist",
- (char *) NULL);
+ "\": the target of this link doesn't exist", NULL);
goto done;
} else {
int counter = 0;
@@ -682,7 +680,7 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
/* Now 'actualSource' is the correct file */
}
}
-#endif
+#endif /* S_ISLNK */
#endif
if (S_ISDIR(sourceStatBuf.st_mode)) {
@@ -694,7 +692,8 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
* cross-filesystem copy. We do this through our Tcl library.
*/
- Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
+ Tcl_Obj *copyCommand = Tcl_NewListObj(0, NULL);
+
Tcl_IncrRefCount(copyCommand);
Tcl_ListObjAppendElement(interp, copyCommand,
Tcl_NewStringObj("::tcl::CopyDirectory",-1));
@@ -769,26 +768,22 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
}
if (result != TCL_OK) {
Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ "\": ", Tcl_PosixError(interp), NULL);
errfile = NULL;
}
}
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp,
- ((copyFlag) ? "error copying \"" : "error renaming \""),
- TclGetString(source), (char *) NULL);
+ Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
+ " \"", TclGetString(source), NULL);
if (errfile != source) {
- Tcl_AppendResult(interp, "\" to \"", TclGetString(target),
- (char *) NULL);
+ Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
if (errfile != target) {
- Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),
- (char *) NULL);
+ Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
}
}
- Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
}
if (errorBuffer != NULL) {
Tcl_DecrRefCount(errorBuffer);
@@ -819,12 +814,12 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
static int
-FileForceOption(interp, objc, objv, forcePtr)
- Tcl_Interp *interp; /* Interp, for error return. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument strings. First command line
+FileForceOption(
+ Tcl_Interp *interp, /* Interp, for error return. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[], /* Argument strings. First command line
* option, if it exists, begins at 0. */
- int *forcePtr; /* If the "-force" was specified, *forcePtr is
+ int *forcePtr) /* If the "-force" was specified, *forcePtr is
* filled with 1, otherwise with 0. */
{
int force, i;
@@ -841,7 +836,7 @@ FileForceOption(interp, objc, objv, forcePtr)
break;
} else {
Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
- "\": should be -force or --", (char *)NULL);
+ "\": should be -force or --", NULL);
return -1;
}
}
@@ -869,9 +864,9 @@ FileForceOption(interp, objc, objv, forcePtr)
*/
static Tcl_Obj *
-FileBasename(interp, pathPtr)
- Tcl_Interp *interp; /* Interp, for error return. */
- Tcl_Obj *pathPtr; /* Path whose basename to extract. */
+FileBasename(
+ Tcl_Interp *interp, /* Interp, for error return. */
+ Tcl_Obj *pathPtr) /* Path whose basename to extract. */
{
int objc;
Tcl_Obj *splitPtr;
@@ -945,10 +940,10 @@ FileBasename(interp, pathPtr)
*/
int
-TclFileAttrsCmd(interp, objc, objv)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int objc; /* Number of command line arguments. */
- Tcl_Obj *CONST objv[]; /* The command line objects. */
+TclFileAttrsCmd(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int objc, /* Number of command line arguments. */
+ Tcl_Obj *CONST objv[]) /* The command line objects. */
{
int result;
CONST char ** attributeStrings;
@@ -985,7 +980,7 @@ TclFileAttrsCmd(interp, objc, objv)
*/
Tcl_AppendResult(interp, "could not read \"",
TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ NULL);
return TCL_ERROR;
}
goto end;
@@ -1064,7 +1059,7 @@ TclFileAttrsCmd(interp, objc, objv)
if (numObjStrings == 0) {
Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
"\", there are no file attributes in this filesystem.",
- (char *) NULL);
+ NULL);
goto end;
}
@@ -1087,7 +1082,7 @@ TclFileAttrsCmd(interp, objc, objv)
if (numObjStrings == 0) {
Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
"\", there are no file attributes in this filesystem.",
- (char *) NULL);
+ NULL);
goto end;
}
@@ -1098,7 +1093,7 @@ TclFileAttrsCmd(interp, objc, objv)
}
if (i + 1 == objc) {
Tcl_AppendResult(interp, "value for \"",
- TclGetString(objv[i]), "\" missing", (char *) NULL);
+ TclGetString(objv[i]), "\" missing", NULL);
goto end;
}
if (Tcl_FSFileAttrsSet(interp, index, filePtr,
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 9a7d308..b6232ac 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.31 2005/08/24 17:56:23 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.32 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -26,22 +26,23 @@ typedef struct AcceptCallback {
* Static functions for this file:
*/
-static void AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
- Tcl_Channel chan, char *address, int port));
-static void RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
- AcceptCallback *acceptCallbackPtr));
-static void TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
-static void TcpServerCloseProc _ANSI_ARGS_((ClientData callbackData));
-static void UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
- Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
+static void AcceptCallbackProc(ClientData callbackData,
+ Tcl_Channel chan, char *address, int port);
+static void RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
+ AcceptCallback *acceptCallbackPtr);
+static void TcpAcceptCallbacksDeleteProc(ClientData clientData,
+ Tcl_Interp *interp);
+static void TcpServerCloseProc(ClientData callbackData);
+static void UnregisterTcpServerInterpCleanupProc(
+ Tcl_Interp *interp,
+ AcceptCallback *acceptCallbackPtr);
/*
*----------------------------------------------------------------------
*
* Tcl_PutsObjCmd --
*
- * This procedure is invoked to process the "puts" Tcl command. See the
+ * This function is invoked to process the "puts" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -55,11 +56,11 @@ static void UnregisterTcpServerInterpCleanupProc _ANSI_ARGS_((
/* ARGSUSED */
int
-Tcl_PutsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_PutsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
Tcl_Obj *string; /* String to write. */
@@ -101,9 +102,10 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
int length;
arg = Tcl_GetStringFromObj(objv[3], &length);
- if ((length != 9) || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
+ if ((length != 9)
+ || (strncmp(arg, "nonewline", (size_t) length) != 0)) {
Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", (char *) NULL);
+ "\": should be \"nonewline\"", NULL);
return TCL_ERROR;
}
channelId = Tcl_GetString(objv[1]);
@@ -124,7 +126,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", channelId,
- "\" wasn't opened for writing", (char *) NULL);
+ "\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
@@ -140,15 +142,17 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
}
return TCL_OK;
- error:
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result. Fall back to the regular
* message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
+
+ error:
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -158,7 +162,7 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
*
* Tcl_FlushObjCmd --
*
- * This procedure is called to process the Tcl "flush" command. See the
+ * This function is called to process the Tcl "flush" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -172,11 +176,11 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FlushObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FlushObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to flush on. */
char *channelId;
@@ -193,19 +197,21 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", channelId,
- "\" wasn't opened for writing", (char *) NULL);
+ "\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
if (Tcl_Flush(chan) != TCL_OK) {
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -217,7 +223,7 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
*
* Tcl_GetsObjCmd --
*
- * This procedure is called to process the Tcl "gets" command. See the
+ * This function is called to process the Tcl "gets" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -231,11 +237,11 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_GetsObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_GetsObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int lineLen; /* Length of line just read. */
@@ -254,7 +260,7 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", name,
- "\" wasn't opened for reading", (char *) NULL);
+ "\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
@@ -265,15 +271,16 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area
* and put them into the regular interpreter result. Fall back to
* the regular message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -298,7 +305,7 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
*
* Tcl_ReadObjCmd --
*
- * This procedure is invoked to process the Tcl "read" command. See the
+ * This function is invoked to process the Tcl "read" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -312,11 +319,11 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ReadObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ReadObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int newline, i; /* Discard newline at end? */
@@ -362,7 +369,7 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", name,
- "\" wasn't opened for reading", (char *) NULL);
+ "\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
i++; /* Consumed channel name. */
@@ -385,7 +392,7 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
newline = 1;
} else {
Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": should be \"nonewline\"", (char *) NULL);
+ "\": should be \"nonewline\"", NULL);
return TCL_ERROR;
}
}
@@ -394,15 +401,17 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
Tcl_IncrRefCount(resultPtr);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
+
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"", name, "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
Tcl_DecrRefCount(resultPtr);
}
return TCL_ERROR;
@@ -431,7 +440,7 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
*
* Tcl_SeekObjCmd --
*
- * This procedure is invoked to process the Tcl "seek" command. See the
+ * This function is invoked to process the Tcl "seek" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -446,20 +455,20 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_SeekObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SeekObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to tell on. */
- Tcl_WideInt offset; /* Where to seek? */
- int mode; /* How to seek? */
- Tcl_WideInt result; /* Of calling Tcl_Seek. */
+ Tcl_Channel chan; /* The channel to tell on. */
+ Tcl_WideInt offset; /* Where to seek? */
+ int mode; /* How to seek? */
+ Tcl_WideInt result; /* Of calling Tcl_Seek. */
char *chanName;
int optionIndex;
static CONST char *originOptions[] = {
- "start", "current", "end", (char *) NULL
+ "start", "current", "end", NULL
};
static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
@@ -486,15 +495,15 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and
* put them into the regular interpreter result. Fall back to the
* regular message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
- Tcl_AppendResult(interp, "error during seek on \"",
- chanName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
+ Tcl_AppendResult(interp, "error during seek on \"", chanName,
+ "\": ", Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
@@ -506,7 +515,7 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
*
* Tcl_TellObjCmd --
*
- * This procedure is invoked to process the Tcl "tell" command. See the
+ * This function is invoked to process the Tcl "tell" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -520,13 +529,13 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_TellObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_TellObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to tell on. */
+ Tcl_Channel chan; /* The channel to tell on. */
char *chanName;
Tcl_WideInt newLoc;
@@ -548,11 +557,13 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
newLoc = Tcl_Tell(chan);
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area and put
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass (interp, chan)) {
+
+ if (TclChanCaughtErrorBypass(interp, chan)) {
return TCL_ERROR;
}
@@ -565,7 +576,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
*
* Tcl_CloseObjCmd --
*
- * This procedure is invoked to process the Tcl "close" command. See the
+ * This function is invoked to process the Tcl "close" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -579,13 +590,13 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_CloseObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_CloseObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Channel chan; /* The channel to close. */
+ Tcl_Channel chan; /* The channel to close. */
char *arg;
if (objc != 2) {
@@ -635,8 +646,8 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
*
* Tcl_FconfigureObjCmd --
*
- * This procedure is invoked to process the Tcl "fconfigure" command.
- * See the user documentation for details on what it does.
+ * This function is invoked to process the Tcl "fconfigure" command. See
+ * the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -649,17 +660,15 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
- ClientData clientData; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FconfigureObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
char *chanName, *optionName, *valueName;
- Tcl_Channel chan; /* The channel to set a mode on. */
- int i; /* Iterate over arg-value pairs. */
- Tcl_DString ds; /* DString to hold result of calling
- * Tcl_GetChannelOption. */
+ Tcl_Channel chan; /* The channel to set a mode on. */
+ int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -674,14 +683,20 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
}
if (objc == 2) {
+ Tcl_DString ds; /* DString to hold result of calling
+ * Tcl_GetChannelOption. */
+
Tcl_DStringInit(&ds);
- if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
+ if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
} else if (objc == 3) {
+ Tcl_DString ds; /* DString to hold result of calling
+ * Tcl_GetChannelOption. */
+
Tcl_DStringInit(&ds);
optionName = Tcl_GetString(objv[2]);
if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
@@ -709,7 +724,7 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
*
* Tcl_EofObjCmd --
*
- * This procedure is invoked to process the Tcl "eof" command. See the
+ * This function is invoked to process the Tcl "eof" command. See the
* user documentation for details on what it does.
*
* Results:
@@ -724,11 +739,11 @@ Tcl_FconfigureObjCmd(clientData, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_EofObjCmd(unused, interp, objc, objv)
- ClientData unused; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_EofObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan;
int dummy;
@@ -754,7 +769,7 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
*
* Tcl_ExecObjCmd --
*
- * This procedure is invoked to process the "exec" Tcl command. See the
+ * This function is invoked to process the "exec" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -768,14 +783,14 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_ExecObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_ExecObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
/*
- * This procedure generates an argv array for the string arguments. It
+ * This function generates an argv array for the string arguments. It
* starts out with stack-allocated space but uses dynamically-allocated
* storage if needed.
*/
@@ -788,7 +803,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
CONST char *argStorage[NUM_ARGS];
int argc, background, i, index, keepNewline, result, skip, length;
static CONST char *options[] = {
- "-keepnewline", "--", NULL
+ "-keepnewline", "--", NULL
};
enum options {
EXEC_KEEPNEWLINE, EXEC_LAST
@@ -882,15 +897,17 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
- /* TIP #219.
+ /*
+ * TIP #219.
* Capture error messages put by the driver into the bypass area
* and put them into the regular interpreter result. Fall back to
* the regular message if nothing was found in the bypass.
*/
+
if (!TclChanCaughtErrorBypass (interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading output from command: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
Tcl_DecrRefCount(resultPtr);
}
return TCL_ERROR;
@@ -899,7 +916,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
/*
* If the process produced anything on stderr, it will have been returned
- * in the interpreter result. It needs to be appended to the result
+ * in the interpreter result. It needs to be appended to the result
* string.
*/
@@ -927,7 +944,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*
* Tcl_FblockedObjCmd --
*
- * This procedure is invoked to process the Tcl "fblocked" command. See
+ * This function is invoked to process the Tcl "fblocked" command. See
* the user documentation for details on what it does.
*
* Results:
@@ -942,11 +959,11 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_FblockedObjCmd(unused, interp, objc, objv)
- ClientData unused; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FblockedObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan;
int mode;
@@ -964,7 +981,7 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for reading", (char *) NULL);
+ "\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
@@ -977,7 +994,7 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
*
* Tcl_OpenObjCmd --
*
- * This procedure is invoked to process the "open" Tcl command. See the
+ * This function is invoked to process the "open" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -991,11 +1008,11 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_OpenObjCmd(notUsed, interp, objc, objv)
- ClientData notUsed; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_OpenObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
int pipeline, prot;
char *modeString, *what;
@@ -1068,7 +1085,7 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+ Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
return TCL_OK;
}
@@ -1095,10 +1112,10 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
/* ARGSUSED */
static void
-TcpAcceptCallbacksDeleteProc(clientData, interp)
- ClientData clientData; /* Data which was passed when the assocdata
+TcpAcceptCallbacksDeleteProc(
+ ClientData clientData, /* Data which was passed when the assocdata
* was registered. */
- Tcl_Interp *interp; /* Interpreter being deleted - not used. */
+ Tcl_Interp *interp) /* Interpreter being deleted - not used. */
{
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
@@ -1107,10 +1124,9 @@ TcpAcceptCallbacksDeleteProc(clientData, interp)
hTblPtr = (Tcl_HashTable *) clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
- acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
+ acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
ckfree((char *) hTblPtr);
@@ -1136,10 +1152,10 @@ TcpAcceptCallbacksDeleteProc(clientData, interp)
*/
static void
-RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
- Tcl_Interp *interp; /* Interpreter for which we want to be
+RegisterTcpServerInterpCleanup(
+ Tcl_Interp *interp, /* Interpreter for which we want to be
* informed of deletion. */
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr)
/* The accept callback record whose interp
* field we want set to NULL when the
* interpreter is deleted. */
@@ -1150,14 +1166,16 @@ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
Tcl_HashEntry *hPtr; /* Entry for this record. */
int new; /* Is the entry new? */
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
- "tclTCPAcceptCallbacks", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
+ hTblPtr = (Tcl_HashTable *)
+ Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+
+ if (hTblPtr == NULL) {
hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
}
+
hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
if (!new) {
Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
@@ -1185,10 +1203,10 @@ RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
*/
static void
-UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
- Tcl_Interp *interp; /* Interpreter in which the accept callback
+UnregisterTcpServerInterpCleanupProc(
+ Tcl_Interp *interp, /* Interpreter in which the accept callback
* record was registered. */
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr)
/* The record for which to delete the
* registration. */
{
@@ -1197,14 +1215,14 @@ UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
"tclTCPAcceptCallbacks", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
+ if (hTblPtr == NULL) {
return;
}
+
hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return;
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
}
- Tcl_DeleteHashEntry(hPtr);
}
/*
@@ -1225,15 +1243,14 @@ UnregisterTcpServerInterpCleanupProc(interp, acceptCallbackPtr)
*/
static void
-AcceptCallbackProc(callbackData, chan, address, port)
- ClientData callbackData; /* The data stored when the callback
- * was created in the call to
- * Tcl_OpenTcpServer. */
- Tcl_Channel chan; /* Channel for the newly accepted
- * connection. */
- char *address; /* Address of client that was
- * accepted. */
- int port; /* Port of client that was accepted. */
+AcceptCallbackProc(
+ ClientData callbackData, /* The data stored when the callback was
+ * created in the call to
+ * Tcl_OpenTcpServer. */
+ Tcl_Channel chan, /* Channel for the newly accepted
+ * connection. */
+ char *address, /* Address of client that was accepted. */
+ int port) /* Port of client that was accepted. */
{
AcceptCallback *acceptCallbackPtr;
Tcl_Interp *interp;
@@ -1249,7 +1266,7 @@ AcceptCallbackProc(callbackData, chan, address, port)
* data to NULL.
*/
- if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+ if (acceptCallbackPtr->interp != NULL) {
script = acceptCallbackPtr->script;
interp = acceptCallbackPtr->interp;
@@ -1265,10 +1282,10 @@ AcceptCallbackProc(callbackData, chan, address, port)
* deleted while the script is being evaluated.
*/
- Tcl_RegisterChannel((Tcl_Interp *) NULL, chan);
+ Tcl_RegisterChannel(NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
- " ", address, " ", portBuf, (char *) NULL);
+ " ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
Tcl_BackgroundError(interp);
Tcl_UnregisterChannel(interp, chan);
@@ -1279,18 +1296,18 @@ AcceptCallbackProc(callbackData, chan, address, port)
* safe anymore to use "chan", because it may now be deleted.
*/
- Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
+ Tcl_UnregisterChannel(NULL, chan);
Tcl_Release((ClientData) interp);
Tcl_Release((ClientData) script);
- } else {
+ } else {
/*
* The interpreter has been deleted, so there is no useful way to
* utilize the client socket - just close it.
*/
- Tcl_Close((Tcl_Interp *) NULL, chan);
+ Tcl_Close(NULL, chan);
}
}
@@ -1316,15 +1333,15 @@ AcceptCallbackProc(callbackData, chan, address, port)
*/
static void
-TcpServerCloseProc(callbackData)
- ClientData callbackData; /* The data passed in the call to
+TcpServerCloseProc(
+ ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
AcceptCallback *acceptCallbackPtr;
/* The actual data. */
acceptCallbackPtr = (AcceptCallback *) callbackData;
- if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+ if (acceptCallbackPtr->interp != NULL) {
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
@@ -1337,8 +1354,8 @@ TcpServerCloseProc(callbackData)
*
* Tcl_SocketObjCmd --
*
- * This procedure is invoked to process the "socket" Tcl command. See
- * the user documentation for details on what it does.
+ * This function is invoked to process the "socket" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1350,14 +1367,14 @@ TcpServerCloseProc(callbackData)
*/
int
-Tcl_SocketObjCmd(notUsed, interp, objc, objv)
- ClientData notUsed; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_SocketObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
static CONST char *socketOptions[] = {
- "-async", "-myaddr", "-myport","-server", (char *) NULL
+ "-async", "-myaddr", "-myport","-server", NULL
};
enum socketOptions {
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
@@ -1382,16 +1399,15 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
if (arg[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions,
- "option", TCL_EXACT, &optionIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option",
+ TCL_EXACT, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum socketOptions) optionIndex) {
case SKT_ASYNC:
if (server == 1) {
Tcl_AppendResult(interp,
- "cannot set -async option for server sockets",
- (char *) NULL);
+ "cannot set -async option for server sockets", NULL);
return TCL_ERROR;
}
async = 1;
@@ -1400,7 +1416,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
- "no argument given for -myaddr option", (char *) NULL);
+ "no argument given for -myaddr option", NULL);
return TCL_ERROR;
}
myaddr = Tcl_GetString(objv[a]);
@@ -1411,7 +1427,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
- "no argument given for -myport option", (char *) NULL);
+ "no argument given for -myport option", NULL);
return TCL_ERROR;
}
myPortName = Tcl_GetString(objv[a]);
@@ -1423,15 +1439,14 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
case SKT_SERVER:
if (async == 1) {
Tcl_AppendResult(interp,
- "cannot set -async option for server sockets",
- (char *) NULL);
+ "cannot set -async option for server sockets", NULL);
return TCL_ERROR;
}
server = 1;
a++;
if (a >= objc) {
Tcl_AppendResult(interp,
- "no argument given for -server option", (char *) NULL);
+ "no argument given for -server option", NULL);
return TCL_ERROR;
}
script = Tcl_GetString(objv[a]);
@@ -1443,7 +1458,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
if (server) {
host = myaddr; /* NULL implies INADDR_ANY */
if (myport != 0) {
- Tcl_AppendResult(interp, "Option -myport is not valid for servers",
+ Tcl_AppendResult(interp, "option -myport is not valid for servers",
NULL);
return TCL_ERROR;
}
@@ -1512,7 +1527,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
}
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
+ Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
return TCL_OK;
}
@@ -1522,7 +1537,7 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
*
* Tcl_FcopyObjCmd --
*
- * This procedure is invoked to process the "fcopy" Tcl command. See the
+ * This function is invoked to process the "fcopy" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1536,11 +1551,11 @@ Tcl_SocketObjCmd(notUsed, interp, objc, objv)
*/
int
-Tcl_FcopyObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+Tcl_FcopyObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel inChan, outChan;
char *arg;
@@ -1568,7 +1583,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for reading", (char *) NULL);
+ "\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
arg = Tcl_GetString(objv[2]);
@@ -1578,7 +1593,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
}
if ((mode & TCL_WRITABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", arg,
- "\" wasn't opened for writing", (char *) NULL);
+ "\" wasn't opened for writing", NULL);
return TCL_ERROR;
}
@@ -1609,7 +1624,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
*
* Tcl_ChanTruncateObjCmd --
*
- * This procedure is invoked to process the "chan truncate" Tcl command.
+ * This function is invoked to process the "chan truncate" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
@@ -1622,11 +1637,11 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
*/
int
-TclChanTruncateObjCmd(dummy, interp, objc, objv)
- ClientData dummy; /* Not used. */
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments. */
- Tcl_Obj *CONST objv[]; /* Argument objects. */
+TclChanTruncateObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Tcl_Channel chan;
int mode;
@@ -1672,7 +1687,7 @@ TclChanTruncateObjCmd(dummy, interp, objc, objv)
if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
Tcl_AppendResult(interp, "error during truncate on \"", chanName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ "\": ", Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 48419da..c708bb1 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -1,75 +1,67 @@
/*
* tclIOGT.c --
*
- * Implements a generic transformation exposing the underlying API
- * at the script level. Contributed by Andreas Kupries.
+ * Implements a generic transformation exposing the underlying API at the
+ * script level. Contributed by Andreas Kupries.
*
* Copyright (c) 2000 Ajuba Solutions
* Copyright (c) 1999-2000 Andreas Kupries (a.kupries@westend.com)
*
- * 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.
*
- * CVS: $Id: tclIOGT.c,v 1.13 2005/07/17 21:17:41 dkf Exp $
+ * CVS: $Id: tclIOGT.c,v 1.14 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
#include "tclIO.h"
/*
- * Forward declarations of internal procedures. First the driver procedures
- * of the transformation.
+ * Forward declarations of internal procedures. First the driver procedures of
+ * the transformation.
*/
-static int TransformBlockModeProc _ANSI_ARGS_((
- ClientData instanceData, int mode));
-static int TransformCloseProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp* interp));
-static int TransformInputProc _ANSI_ARGS_((
- ClientData instanceData, char *buf, int toRead,
- int *errorCodePtr));
-static int TransformOutputProc _ANSI_ARGS_((
- ClientData instanceData, CONST char *buf,
- int toWrite, int *errorCodePtr));
-static int TransformSeekProc _ANSI_ARGS_((
- ClientData instanceData, long offset, int mode,
- int *errorCodePtr));
-static int TransformSetOptionProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST char *optionName, CONST char *value));
-static int TransformGetOptionProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_Interp *interp,
- CONST char *optionName, Tcl_DString *dsPtr));
-static void TransformWatchProc _ANSI_ARGS_((
- ClientData instanceData, int mask));
-static int TransformGetFileHandleProc _ANSI_ARGS_((
- ClientData instanceData, int direction,
- ClientData *handlePtr));
-static int TransformNotifyProc _ANSI_ARGS_((
- ClientData instanceData, int mask));
-static Tcl_WideInt TransformWideSeekProc _ANSI_ARGS_((
- ClientData instanceData, Tcl_WideInt offset,
- int mode, int *errorCodePtr));
+static int TransformBlockModeProc(ClientData instanceData,
+ int mode);
+static int TransformCloseProc(ClientData instanceData,
+ Tcl_Interp* interp);
+static int TransformInputProc(ClientData instanceData, char *buf,
+ int toRead, int *errorCodePtr);
+static int TransformOutputProc(ClientData instanceData,
+ CONST char *buf, int toWrite, int *errorCodePtr);
+static int TransformSeekProc(ClientData instanceData, long offset,
+ int mode, int *errorCodePtr);
+static int TransformSetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, CONST char *optionName,
+ CONST char *value);
+static int TransformGetOptionProc(ClientData instanceData,
+ Tcl_Interp *interp, CONST char *optionName,
+ Tcl_DString *dsPtr);
+static void TransformWatchProc(ClientData instanceData, int mask);
+static int TransformGetFileHandleProc(ClientData instanceData,
+ int direction, ClientData *handlePtr);
+static int TransformNotifyProc(ClientData instanceData, int mask);
+static Tcl_WideInt TransformWideSeekProc(ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
- * Forward declarations of internal procedures. Secondly the procedures for
+ * Forward declarations of internal procedures. Secondly the procedures for
* handling and generating fileeevents.
*/
-static void TransformChannelHandlerTimer _ANSI_ARGS_((
- ClientData clientData));
+static void TransformChannelHandlerTimer(ClientData clientData);
/*
- * Forward declarations of internal procedures. Third, helper procedures
+ * Forward declarations of internal procedures. Third, helper procedures
* encapsulating essential tasks.
*/
typedef struct TransformChannelData TransformChannelData;
-static int ExecuteCallback _ANSI_ARGS_((
- TransformChannelData *ctrl, Tcl_Interp *interp,
- unsigned char *op, unsigned char *buf, int bufLen,
- int transmit, int preserve));
+static int ExecuteCallback(TransformChannelData *ctrl,
+ Tcl_Interp *interp, unsigned char *op,
+ unsigned char *buf, int bufLen, int transmit,
+ int preserve);
/*
* Action codes to give to 'ExecuteCallback' (argument 'transmit') confering
@@ -113,13 +105,13 @@ static int ExecuteCallback _ANSI_ARGS_((
typedef struct ResultBuffer ResultBuffer;
-static void ResultClear _ANSI_ARGS_((ResultBuffer *r));
-static void ResultInit _ANSI_ARGS_((ResultBuffer *r));
-static int ResultLength _ANSI_ARGS_((ResultBuffer *r));
-static int ResultCopy _ANSI_ARGS_((ResultBuffer *r,
- unsigned char *buf, int toRead));
-static void ResultAdd _ANSI_ARGS_((ResultBuffer *r,
- unsigned char *buf, int toWrite));
+static void ResultClear(ResultBuffer *r);
+static void ResultInit(ResultBuffer *r);
+static int ResultLength(ResultBuffer *r);
+static int ResultCopy(ResultBuffer *r, unsigned char *buf,
+ int toRead);
+static void ResultAdd(ResultBuffer *r, unsigned char *buf,
+ int toWrite);
/*
* This structure describes the channel type structure for Tcl based
@@ -180,7 +172,6 @@ struct ResultBuffer {
*/
#define UCHARP(x) ((unsigned char *) (x))
-#define NO_INTERP ((Tcl_Interp *) NULL)
/*
* Definition of a structure used by all transformations generated here to
@@ -226,7 +217,7 @@ struct TransformChannelData {
*
* TclChannelTransform --
*
- * Implements the Tcl "testchannel transform" debugging command. This is
+ * Implements the Tcl "testchannel transform" debugging command. This is
* part of the testing environment. This sets up a tcl script (cmdObjPtr)
* to be used as a transform on the channel.
*
@@ -241,10 +232,10 @@ struct TransformChannelData {
/* ARGSUSED */
int
-TclChannelTransform(interp, chan, cmdObjPtr)
- Tcl_Interp *interp; /* Interpreter for result. */
- Tcl_Channel chan; /* Channel to transform. */
- Tcl_Obj *cmdObjPtr; /* Script to use for transform. */
+TclChannelTransform(
+ Tcl_Interp *interp, /* Interpreter for result. */
+ Tcl_Channel chan, /* Channel to transform. */
+ Tcl_Obj *cmdObjPtr) /* Script to use for transform. */
{
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* state info for channel */
@@ -298,7 +289,7 @@ TclChannelTransform(interp, chan, cmdObjPtr)
(ClientData) dataPtr, mode, chan);
if (dataPtr->self == (Tcl_Channel) NULL) {
Tcl_AppendResult(interp, "\nfailed to stack channel \"",
- Tcl_GetChannelName(chan), "\"", (char *) NULL);
+ Tcl_GetChannelName(chan), "\"", NULL);
Tcl_DecrRefCount(dataPtr->command);
ResultClear(&dataPtr->result);
@@ -311,7 +302,7 @@ TclChannelTransform(interp, chan, cmdObjPtr)
*/
if (dataPtr->mode & TCL_WRITABLE) {
- res = ExecuteCallback(dataPtr, NO_INTERP, A_CREATE_WRITE, NULL, 0,
+ res = ExecuteCallback(dataPtr, NULL, A_CREATE_WRITE, NULL, 0,
TRANSMIT_DONT, P_NO_PRESERVE);
if (res != TCL_OK) {
@@ -321,11 +312,11 @@ TclChannelTransform(interp, chan, cmdObjPtr)
}
if (dataPtr->mode & TCL_READABLE) {
- res = ExecuteCallback(dataPtr, NO_INTERP, A_CREATE_READ, NULL, 0,
+ res = ExecuteCallback(dataPtr, NULL, A_CREATE_READ, NULL, 0,
TRANSMIT_DONT, P_NO_PRESERVE);
if (res != TCL_OK) {
- ExecuteCallback(dataPtr, NO_INTERP, A_DELETE_WRITE, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0,
TRANSMIT_DONT, P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
@@ -354,19 +345,19 @@ TclChannelTransform(interp, chan, cmdObjPtr)
*/
static int
-ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
- TransformChannelData *dataPtr; /* Transformation with the callback */
- Tcl_Interp *interp; /* Current interpreter, possibly
- * NULL. */
- unsigned char *op; /* Operation invoking the callback */
- unsigned char *buf; /* Buffer to give to the script. */
- int bufLen; /* And its length */
- int transmit; /* Flag, determines whether the result
- * of the callback is sent to the
- * underlying channel or not. */
- int preserve; /* Flag. If true the procedure will
- * preserver the result state of all
- * accessed interpreters. */
+ExecuteCallback(
+ TransformChannelData *dataPtr,
+ /* Transformation with the callback */
+ Tcl_Interp *interp, /* Current interpreter, possibly NULL. */
+ unsigned char *op, /* Operation invoking the callback */
+ unsigned char *buf, /* Buffer to give to the script. */
+ int bufLen, /* And its length */
+ int transmit, /* Flag, determines whether the result of the
+ * callback is sent to the underlying channel
+ * or not. */
+ int preserve) /* Flag. If true the procedure will preserver
+ * the result state of all accessed
+ * interpreters. */
{
/*
* Step 1, create the complete command to execute. Do this by appending
@@ -376,35 +367,20 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
* arguments. Feather's curried commands would come in handy here.
*/
- Tcl_Obj *resObj; /* See below, switch (transmit) */
+ Tcl_Obj *resObj; /* See below, switch (transmit) */
int resLen;
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
- Tcl_Obj *temp;
if (preserve) {
state = Tcl_SaveInterpState(dataPtr->interp, res);
}
- if (command == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
- }
-
Tcl_IncrRefCount(command);
-
- temp = Tcl_NewStringObj((char*) op, -1);
-
- if (temp == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
- }
-
- res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
+ res = Tcl_ListObjAppendElement(dataPtr->interp, command,
+ Tcl_NewStringObj((char*) op, -1));
if (res != TCL_OK) {
goto cleanup;
}
@@ -414,15 +390,8 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
* through as UTF while at the tcl level.
*/
- temp = Tcl_NewByteArrayObj(buf, bufLen);
-
- if (temp == (Tcl_Obj*) NULL) {
- /* Memory allocation problem */
- res = TCL_ERROR;
- goto cleanup;
- }
-
- res = Tcl_ListObjAppendElement(dataPtr->interp, command, temp);
+ res = Tcl_ListObjAppendElement(dataPtr->interp, command,
+ Tcl_NewByteArrayObj(buf, bufLen));
if (res != TCL_OK) {
goto cleanup;
}
@@ -437,9 +406,9 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
res = Tcl_GlobalEvalObj(dataPtr->interp, command);
Tcl_DecrRefCount(command);
- command = (Tcl_Obj*) NULL;
+ command = NULL;
- if ((res != TCL_OK) && (interp != NO_INTERP) &&
+ if ((res != TCL_OK) && (interp != NULL) &&
(dataPtr->interp != interp) && !preserve) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
return res;
@@ -475,7 +444,10 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
break;
case TRANSMIT_NUM:
- /* Interpret result as integer number */
+ /*
+ * Interpret result as integer number.
+ */
+
resObj = Tcl_GetObjResult(dataPtr->interp);
Tcl_GetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
break;
@@ -494,7 +466,7 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
(void) Tcl_RestoreInterpState(dataPtr->interp, state);
}
- if (command != (Tcl_Obj*) NULL) {
+ if (command != NULL) {
Tcl_DecrRefCount(command);
}
@@ -519,9 +491,9 @@ ExecuteCallback(dataPtr, interp, op, buf, bufLen, transmit, preserve)
*/
static int
-TransformBlockModeProc(instanceData, mode)
- ClientData instanceData; /* State of transformation */
- int mode; /* New blocking mode */
+TransformBlockModeProc(
+ ClientData instanceData, /* State of transformation */
+ int mode) /* New blocking mode */
{
TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
@@ -551,9 +523,9 @@ TransformBlockModeProc(instanceData, mode)
*/
static int
-TransformCloseProc(instanceData, interp)
- ClientData instanceData;
- Tcl_Interp *interp;
+TransformCloseProc(
+ ClientData instanceData,
+ Tcl_Interp *interp)
{
TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
@@ -632,11 +604,11 @@ TransformCloseProc(instanceData, interp)
*/
static int
-TransformInputProc(instanceData, buf, toRead, errorCodePtr)
- ClientData instanceData;
- char *buf;
- int toRead;
- int *errorCodePtr;
+TransformInputProc(
+ ClientData instanceData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
{
TransformChannelData* dataPtr = (TransformChannelData *) instanceData;
int gotBytes, read, res, copied;
@@ -668,7 +640,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
if (toRead == 0) {
/*
- * The request was completely satisfied from our buffers. We can
+ * The request was completely satisfied from our buffers. We can
* break out of the loop and return to the caller.
*/
return gotBytes;
@@ -686,7 +658,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
* matching.
*/
- ExecuteCallback(dataPtr, NO_INTERP, A_QUERY_MAXREAD, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
TRANSMIT_NUM /* -> maxRead */, 1);
if (dataPtr->maxRead >= 0) {
@@ -703,7 +675,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
if (read < 0) {
/*
- * Report errors to caller. EAGAIN is a special situation. If we
+ * Report errors to caller. EAGAIN is a special situation. If we
* had some data before we report that instead of the request to
* re-try.
*/
@@ -713,7 +685,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
}
*errorCodePtr = Tcl_GetErrno();
- return -1;
+ return -1;
}
if (read == 0) {
@@ -744,7 +716,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
dataPtr->readIsFlushed = 1;
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_READ, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
if (ResultLength(&dataPtr->result) == 0) {
@@ -761,7 +733,7 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
* (dataPtr->result)
*/
- res = ExecuteCallback(dataPtr, NO_INTERP, A_READ, UCHARP(buf), read,
+ res = ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE);
if (res != TCL_OK) {
@@ -790,11 +762,11 @@ TransformInputProc(instanceData, buf, toRead, errorCodePtr)
*/
static int
-TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
- ClientData instanceData;
- CONST char *buf;
- int toWrite;
- int *errorCodePtr;
+TransformOutputProc(
+ ClientData instanceData,
+ CONST char *buf,
+ int toWrite,
+ int *errorCodePtr)
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
int res;
@@ -808,7 +780,7 @@ TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
return 0;
}
- res = ExecuteCallback(dataPtr, NO_INTERP, A_WRITE, UCHARP(buf), toWrite,
+ res = ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
TRANSMIT_DOWN, P_NO_PRESERVE);
if (res != TCL_OK) {
@@ -829,7 +801,7 @@ TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
*
* Side effects:
* Moves the location at which the channel will be accessed in future
- * operations. Flushes all transformation buffers, then forwards it to
+ * operations. Flushes all transformation buffers, then forwards it to
* the underlying channel.
*
* Result:
@@ -840,11 +812,11 @@ TransformOutputProc(instanceData, buf, toWrite, errorCodePtr)
*/
static int
-TransformSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* The channel to manipulate */
- long offset; /* Size of movement. */
- int mode; /* How to move */
- int *errorCodePtr; /* Location of error flag. */
+TransformSeekProc(
+ ClientData instanceData, /* The channel to manipulate */
+ long offset, /* Size of movement. */
+ int mode, /* How to move */
+ int *errorCodePtr) /* Location of error flag. */
{
TransformChannelData *dataPtr = (TransformChannelData *) instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
@@ -868,12 +840,12 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
*/
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_WRITE, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_NO_PRESERVE);
}
if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_CLEAR_READ, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0,
TRANSMIT_DONT, P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
@@ -893,7 +865,7 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
*
* Side effects:
* Moves the location at which the channel will be accessed in future
- * operations. Flushes all transformation buffers, then forwards it to
+ * operations. Flushes all transformation buffers, then forwards it to
* the underlying channel.
*
* Result:
@@ -904,11 +876,11 @@ TransformSeekProc(instanceData, offset, mode, errorCodePtr)
*/
static Tcl_WideInt
-TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
- ClientData instanceData; /* The channel to manipulate */
- Tcl_WideInt offset; /* Size of movement. */
- int mode; /* How to move */
- int *errorCodePtr; /* Location of error flag. */
+TransformWideSeekProc(
+ ClientData instanceData, /* The channel to manipulate */
+ Tcl_WideInt offset, /* Size of movement. */
+ int mode, /* How to move */
+ int *errorCodePtr) /* Location of error flag. */
{
TransformChannelData * dataPtr = (TransformChannelData *) instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
@@ -940,12 +912,12 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
*/
if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_FLUSH_WRITE, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_NO_PRESERVE);
}
if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, NO_INTERP, A_CLEAR_READ, NULL, 0,
+ ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0,
TRANSMIT_DONT, P_NO_PRESERVE);
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
@@ -963,7 +935,7 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
* We're transferring to narrow seeks at this point; this is a bit complex
* because we have to check whether the seek is possible first (i.e.
* whether we are losing information in truncating the bits of the
- * offset.) Luckily, there's a defined error for what happens when trying
+ * offset). Luckily, there's a defined error for what happens when trying
* to go out of the representable range.
*/
@@ -995,11 +967,11 @@ TransformWideSeekProc(instanceData, offset, mode, errorCodePtr)
*/
static int
-TransformSetOptionProc(instanceData, interp, optionName, value)
- ClientData instanceData;
- Tcl_Interp *interp;
- CONST char *optionName;
- CONST char *value;
+TransformSetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ CONST char *optionName,
+ CONST char *value)
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
@@ -1032,11 +1004,11 @@ TransformSetOptionProc(instanceData, interp, optionName, value)
*/
static int
-TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
- ClientData instanceData;
- Tcl_Interp *interp;
- CONST char *optionName;
- Tcl_DString *dsPtr;
+TransformGetOptionProc(
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ CONST char *optionName,
+ Tcl_DString *dsPtr)
{
TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
@@ -1046,7 +1018,7 @@ TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
if (getOptionProc != NULL) {
return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
interp, optionName, dsPtr);
- } else if (optionName == (CONST char*) NULL) {
+ } else if (optionName == NULL) {
/*
* Request is query for all options, this is ok.
*/
@@ -1080,9 +1052,9 @@ TransformGetOptionProc(instanceData, interp, optionName, dsPtr)
/* ARGSUSED */
static void
-TransformWatchProc(instanceData, mask)
- ClientData instanceData; /* Channel to watch */
- int mask; /* Events of interest */
+TransformWatchProc(
+ ClientData instanceData, /* Channel to watch */
+ int mask) /* Events of interest */
{
/*
* The caller expressed interest in events occuring for this channel. We
@@ -1097,7 +1069,7 @@ TransformWatchProc(instanceData, mask)
/*
* No channel handlers any more. We will be notified automatically about
* events on the channel below via a call to our 'TransformNotifyProc'.
- * But we have to pass the interest down now. We are allowed to add
+ * But we have to pass the interest down now. We are allowed to add
* additional 'interest' to the mask if we want to. But this
* transformation has no such interest. It just passes the request down,
* unchanged.
@@ -1149,19 +1121,19 @@ TransformWatchProc(instanceData, mask)
* None.
*
* Result:
- * The appropriate Tcl_File or NULL if not present.
+ * The appropriate Tcl_File or NULL if not present.
*
*----------------------------------------------------------------------
*/
static int
-TransformGetFileHandleProc(instanceData, direction, handlePtr)
- ClientData instanceData; /* Channel to query */
- int direction; /* Direction of interest */
- ClientData *handlePtr; /* Place to store the handle into */
+TransformGetFileHandleProc(
+ ClientData instanceData, /* Channel to query */
+ int direction, /* Direction of interest */
+ ClientData *handlePtr) /* Place to store the handle into */
{
/*
- * Return the handle belonging to parent channel. IOW, pass the request
+ * Return the handle belonging to parent channel. IOW, pass the request
* down and the result up.
*/
@@ -1189,15 +1161,15 @@ TransformGetFileHandleProc(instanceData, direction, handlePtr)
*/
static int
-TransformNotifyProc(clientData, mask)
- ClientData clientData; /* The state of the notified transformation */
- int mask; /* The mask of occuring events */
+TransformNotifyProc(
+ ClientData clientData, /* The state of the notified transformation */
+ int mask) /* The mask of occuring events */
{
TransformChannelData *dataPtr = (TransformChannelData *) clientData;
/*
- * An event occured in the underlying channel. This transformation
- * doesn't process such events thus returns the incoming mask unchanged.
+ * An event occured in the underlying channel. This transformation doesn't
+ * process such events thus returns the incoming mask unchanged.
*/
if (dataPtr->timer != (Tcl_TimerToken) NULL) {
@@ -1234,8 +1206,8 @@ TransformNotifyProc(clientData, mask)
*/
static void
-TransformChannelHandlerTimer(clientData)
- ClientData clientData; /* Transformation to query */
+TransformChannelHandlerTimer(
+ ClientData clientData) /* Transformation to query */
{
TransformChannelData *dataPtr = (TransformChannelData *) clientData;
@@ -1272,14 +1244,14 @@ TransformChannelHandlerTimer(clientData)
*/
static void
-ResultClear(r)
- ResultBuffer *r; /* Reference to the buffer to clear out. */
+ResultClear(
+ ResultBuffer *r) /* Reference to the buffer to clear out. */
{
r->used = 0;
if (r->allocated) {
ckfree((char *) r->buf);
- r->buf = UCHARP(NULL);
+ r->buf = NULL;
r->allocated = 0;
}
}
@@ -1302,12 +1274,12 @@ ResultClear(r)
*/
static void
-ResultInit(r)
- ResultBuffer *r; /* Reference to the structure to initialize */
+ResultInit(
+ ResultBuffer *r) /* Reference to the structure to initialize */
{
r->used = 0;
r->allocated = 0;
- r->buf = UCHARP(NULL);
+ r->buf = NULL;
}
/*
@@ -1327,8 +1299,8 @@ ResultInit(r)
*/
static int
-ResultLength(r)
- ResultBuffer *r; /* The structure to query */
+ResultLength(
+ ResultBuffer *r) /* The structure to query */
{
return r->used;
}
@@ -1352,10 +1324,10 @@ ResultLength(r)
*/
static int
-ResultCopy(r, buf, toRead)
- ResultBuffer *r; /* The buffer to read from. */
- unsigned char *buf; /* The buffer to copy into. */
- int toRead; /* Number of requested bytes. */
+ResultCopy(
+ ResultBuffer *r, /* The buffer to read from. */
+ unsigned char *buf, /* The buffer to copy into. */
+ int toRead) /* Number of requested bytes. */
{
if (r->used == 0) {
/*
@@ -1377,7 +1349,7 @@ ResultCopy(r, buf, toRead)
if (r->used > toRead) {
/*
- * The internal buffer contains more than requested. Copy the
+ * The internal buffer contains more than requested. Copy the
* requested subset to the caller, and shift the remaining bytes down.
*/
@@ -1395,7 +1367,7 @@ ResultCopy(r, buf, toRead)
*/
memcpy((VOID *) buf, (VOID *) r->buf, (size_t) r->used);
- toRead = r->used;
+ toRead = r->used;
r->used = 0;
return toRead;
}
@@ -1417,10 +1389,10 @@ ResultCopy(r, buf, toRead)
*/
static void
-ResultAdd(r, buf, toWrite)
- ResultBuffer *r; /* The buffer to extend */
- unsigned char *buf; /* The buffer to read from */
- int toWrite; /* The number of bytes in 'buf' */
+ResultAdd(
+ ResultBuffer *r, /* The buffer to extend */
+ unsigned char *buf, /* The buffer to read from */
+ int toWrite) /* The number of bytes in 'buf' */
{
if ((r->used + toWrite) > r->allocated) {
/*
@@ -1437,7 +1409,10 @@ ResultAdd(r, buf, toWrite)
}
}
- /* now copy data */
+ /*
+ * Now we may copy the data.
+ */
+
memcpy(r->buf + r->used, buf, (size_t) toWrite);
r->used += toWrite;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 124da3a..78cc0ff 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -5,7 +5,7 @@
* code, which supports a pluggable filesystem architecture allowing both
* platform specific filesystems and 'virtual filesystems'. All
* filesystem access should go through the functions defined in this
- * file. Most of this code was contributed by Vince Darley.
+ * file. Most of this code was contributed by Vince Darley.
*
* Parts of this file are based on code contributed by Karl Lehenbauer,
* Mark Diekhans and Peter da Silva.
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.123 2005/09/14 17:13:18 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.124 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -27,29 +27,26 @@
#include "tclFileSystem.h"
/*
- * Prototypes for procedures defined later in this file.
+ * Prototypes for functions defined later in this file.
*/
-static FilesystemRecord * FsGetFirstFilesystem _ANSI_ARGS_((void));
-static void FsThrExitProc _ANSI_ARGS_((ClientData cd));
-static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
- CONST char *pattern));
-static void FsAddMountsToGlobResult _ANSI_ARGS_((
- Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
- CONST char *pattern,
- Tcl_GlobTypeData *types));
-static void FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj,
- ClientData clientData));
+static FilesystemRecord*FsGetFirstFilesystem(void);
+static void FsThrExitProc(ClientData cd);
+static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, CONST char *pattern);
+static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
+ Tcl_Obj *pathPtr, CONST char *pattern,
+ Tcl_GlobTypeData *types);
+static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
#ifdef TCL_THREADS
-static void FsRecacheFilesystemList(void);
+static void FsRecacheFilesystemList(void);
#endif
/*
- * These form part of the native filesystem support. They are needed here
+ * These form part of the native filesystem support. They are needed here
* because we have a few native filesystem functions (which are the same for
- * win/unix) in this file. There is no need to place them in tclInt.h,
- * because they are not (and should not be) used anywhere else.
+ * win/unix) in this file. There is no need to place them in tclInt.h, because
+ * they are not (and should not be) used anywhere else.
*/
extern CONST char * tclpFileAttrStrings[];
@@ -59,12 +56,13 @@ extern CONST TclFileAttrProcs tclpFileAttrProcs[];
* The following functions are obsolete string based APIs, and should be
* removed in a future release (Tcl 9 would be a good time).
*/
+
/* Obsolete */
int
-Tcl_Stat(path, oldStyleBuf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *oldStyleBuf; /* Filled with results of stat call. */
+Tcl_Stat(
+ CONST char *path, /* Path of file to stat (in current CP). */
+ struct stat *oldStyleBuf) /* Filled with results of stat call. */
{
int ret;
Tcl_StatBuf buf;
@@ -98,7 +96,7 @@ Tcl_Stat(path, oldStyleBuf)
# ifdef EOVERFLOW
errno = EOVERFLOW;
# else
-# error "What status should be returned for file size out of range?"
+# error "What status should be returned for file size out of range?"
# endif
#endif
return -1;
@@ -111,7 +109,7 @@ Tcl_Stat(path, oldStyleBuf)
/*
* Copy across all supported fields, with possible type coercions on
* those fields that change between the normal and lf64 versions of
- * the stat structure (on Solaris at least.) This is slow when the
+ * the stat structure (on Solaris at least). This is slow when the
* structure sizes coincide, but that's what you get for using an
* obsolete interface.
*/
@@ -137,9 +135,9 @@ Tcl_Stat(path, oldStyleBuf)
/* Obsolete */
int
-Tcl_Access(path, mode)
- CONST char *path; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+Tcl_Access(
+ CONST char *path, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
@@ -153,13 +151,13 @@ Tcl_Access(path, mode)
/* Obsolete */
Tcl_Channel
-Tcl_OpenFileChannel(interp, path, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting; can be
+Tcl_OpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
* NULL. */
- CONST char *path; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or a string such
+ CONST char *path, /* Name of file to open. */
+ CONST char *modeString, /* A list of POSIX open modes or a string such
* as "rw". */
- int permissions; /* If the open involves creating a file, with
+ int permissions) /* If the open involves creating a file, with
* what modes to create it? */
{
Tcl_Channel ret;
@@ -174,8 +172,8 @@ Tcl_OpenFileChannel(interp, path, modeString, permissions)
/* Obsolete */
int
-Tcl_Chdir(dirName)
- CONST char *dirName;
+Tcl_Chdir(
+ CONST char *dirName)
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
@@ -187,9 +185,9 @@ Tcl_Chdir(dirName)
/* Obsolete */
char *
-Tcl_GetCwd(interp, cwdPtr)
- Tcl_Interp *interp;
- Tcl_DString *cwdPtr;
+Tcl_GetCwd(
+ Tcl_Interp *interp,
+ Tcl_DString *cwdPtr)
{
Tcl_Obj *cwd;
cwd = Tcl_FSGetCwd(interp);
@@ -205,9 +203,9 @@ Tcl_GetCwd(interp, cwdPtr)
/* Obsolete */
int
-Tcl_EvalFile(interp, fileName)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- CONST char *fileName; /* Name of file to process. Tilde-substitution
+Tcl_EvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ CONST char *fileName) /* Name of file to process. Tilde-substitution
* will be performed on this name. */
{
int ret;
@@ -219,11 +217,11 @@ Tcl_EvalFile(interp, fileName)
}
/*
- * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
- * complete, general hooked filesystem APIs should be used instead. This
- * define decides whether to include the obsolete hooks and related code. If
- * these are removed, we'll also want to remove them from stubs/tclInt. The
- * only known users of these APIs are prowrap and mktclapp. New
+ * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
+ * complete, general hooked filesystem APIs should be used instead. This
+ * define decides whether to include the obsolete hooks and related code. If
+ * these are removed, we'll also want to remove them from stubs/tclInt. The
+ * only known users of these APIs are prowrap and mktclapp. New
* code/extensions should not use them, since they do not provide as full
* support as the full filesystem API.
*
@@ -238,26 +236,27 @@ Tcl_EvalFile(interp, fileName)
/*
* The following typedef declarations allow for hooking into the chain of
* functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
- * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
+ * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
* list is defined.
*/
typedef struct StatProc {
- TclStatProc_ *proc; /* Function to process a 'stat()' call */
- struct StatProc *nextPtr; /* The next 'stat()' function to call */
+ TclStatProc_ *proc; /* Function to process a 'stat()' call */
+ struct StatProc *nextPtr; /* The next 'stat()' function to call */
} StatProc;
typedef struct AccessProc {
- TclAccessProc_ *proc; /* Function to process a 'access()' call */
- struct AccessProc *nextPtr; /* The next 'access()' function to call */
+ TclAccessProc_ *proc; /* Function to process a 'access()' call */
+ struct AccessProc *nextPtr; /* The next 'access()' function to call */
} AccessProc;
typedef struct OpenFileChannelProc {
- TclOpenFileChannelProc_ *proc; /* Function to process a
- * 'Tcl_OpenFileChannel()' call */
+ TclOpenFileChannelProc_ *proc;
+ /* Function to process a
+ * 'Tcl_OpenFileChannel()' call */
struct OpenFileChannelProc *nextPtr;
- /* The next 'Tcl_OpenFileChannel()'
- * function to call */
+ /* The next 'Tcl_OpenFileChannel()' function
+ * to call */
} OpenFileChannelProc;
/*
@@ -282,11 +281,11 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
#endif /* USE_OBSOLETE_FS_HOOKS */
/*
- * Declare the native filesystem support. These functions should be
- * considered private to Tcl, and should really not be called directly by any
- * code other than this file (i.e. neither by Tcl's core nor by extensions).
- * Similarly, the old string-based Tclp... native filesystem functions should
- * not be called.
+ * Declare the native filesystem support. These functions should be considered
+ * private to Tcl, and should really not be called directly by any code other
+ * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
+ * the old string-based Tclp... native filesystem functions should not be
+ * called.
*
* The correct API to use now is the Tcl_FS... set of functions, which ensure
* correct and complete virtual filesystem support.
@@ -298,8 +297,8 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
-static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
-static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
+static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
+static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
/*
* The only reason these functions are not static is that they are either
@@ -310,29 +309,29 @@ static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
* support into a separate code library, this could actually be enforced).
*/
-Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
-Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
-Tcl_FSStatProc TclpObjStat;
-Tcl_FSAccessProc TclpObjAccess;
-Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
-Tcl_FSChdirProc TclpObjChdir;
-Tcl_FSLstatProc TclpObjLstat;
-Tcl_FSCopyFileProc TclpObjCopyFile;
-Tcl_FSDeleteFileProc TclpObjDeleteFile;
-Tcl_FSRenameFileProc TclpObjRenameFile;
-Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
-Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
-Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
-Tcl_FSUnloadFileProc TclpUnloadFile;
-Tcl_FSLinkProc TclpObjLink;
-Tcl_FSListVolumesProc TclpObjListVolumes;
+Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
+Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
+Tcl_FSStatProc TclpObjStat;
+Tcl_FSAccessProc TclpObjAccess;
+Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
+Tcl_FSChdirProc TclpObjChdir;
+Tcl_FSLstatProc TclpObjLstat;
+Tcl_FSCopyFileProc TclpObjCopyFile;
+Tcl_FSDeleteFileProc TclpObjDeleteFile;
+Tcl_FSRenameFileProc TclpObjRenameFile;
+Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
+Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
+Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
+Tcl_FSUnloadFileProc TclpUnloadFile;
+Tcl_FSLinkProc TclpObjLink;
+Tcl_FSListVolumesProc TclpObjListVolumes;
/*
- * Define the native filesystem dispatch table. If necessary, it is ok to
- * make this non-static, but it should only be accessed by the functions
- * actually listed within it (or perhaps other helper functions of them).
- * Anything which is not part of this 'native filesystem implementation'
- * should not be delving inside here!
+ * Define the native filesystem dispatch table. If necessary, it is ok to make
+ * this non-static, but it should only be accessed by the functions actually
+ * listed within it (or perhaps other helper functions of them). Anything
+ * which is not part of this 'native filesystem implementation' should not be
+ * delving inside here!
*/
Tcl_Filesystem tclNativeFilesystem = {
@@ -370,17 +369,17 @@ Tcl_Filesystem tclNativeFilesystem = {
&TclpObjLstat,
&TclpDlopen,
/* Needs a cast since we're using version_2 */
- (Tcl_FSGetCwdProc*)&TclpGetNativeCwd,
+ (Tcl_FSGetCwdProc *) &TclpGetNativeCwd,
&TclpObjChdir
};
/*
- * Define the tail of the linked list. Note that for unconventional uses of
+ * Define the tail of the linked list. Note that for unconventional uses of
* Tcl without a native filesystem, we may in the future wish to modify the
* current approach of hard-coding the native filesystem in the lookup list
* 'filesystemList' below.
*
- * We initialize the record so that it thinks one file uses it. This means it
+ * We initialize the record so that it thinks one file uses it. This means it
* will never be freed.
*/
@@ -392,10 +391,10 @@ static FilesystemRecord nativeFilesystemRecord = {
};
/*
- * This is incremented each time we modify the linked list of filesystems.
- * Any time it changes, all cached filesystem representations are suspect and
- * must be freed. For multithreading builds, change of the filesystem epoch
- * will trigger cache cleanup in all threads.
+ * This is incremented each time we modify the linked list of filesystems. Any
+ * time it changes, all cached filesystem representations are suspect and must
+ * be freed. For multithreading builds, change of the filesystem epoch will
+ * trigger cache cleanup in all threads.
*/
static int theFilesystemEpoch = 0;
@@ -424,12 +423,12 @@ Tcl_ThreadDataKey tclFsDataKey;
* Declare fallback support function and information for Tcl_FSLoadFile
*/
-static Tcl_FSUnloadFileProc FSUnloadTempFile;
+static Tcl_FSUnloadFileProc FSUnloadTempFile;
/*
* One of these structures is used each time we successfully load a file from
* a file system by way of making a temporary copy of the file on the native
- * filesystem. We need to store both the actual unloadProc/clientData
+ * filesystem. We need to store both the actual unloadProc/clientData
* combination which was used, and the original and modified filenames, so
* that we can correctly undo the entire operation when we want to unload the
* code.
@@ -448,8 +447,8 @@ typedef struct FsDivertLoad {
*/
static void
-FsThrExitProc(cd)
- ClientData cd;
+FsThrExitProc(
+ ClientData cd)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
@@ -480,7 +479,7 @@ FsThrExitProc(cd)
}
int
-TclFSCwdIsNative()
+TclFSCwdIsNative(void)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -504,7 +503,7 @@ TclFSCwdIsNative()
*
* Side effects:
* If the paths are equal, but are not the same object, this method will
- * modify the given pathPtrPtr to refer to the same object. In this case
+ * modify the given pathPtrPtr to refer to the same object. In this case
* the object pointed to by pathPtrPtr will have its refCount
* decremented, and it will be adjusted to point to the cwd (with a new
* refCount).
@@ -513,8 +512,8 @@ TclFSCwdIsNative()
*/
int
-TclFSCwdPointerEquals(pathPtrPtr)
- Tcl_Obj** pathPtrPtr;
+TclFSCwdPointerEquals(
+ Tcl_Obj** pathPtrPtr)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -561,7 +560,7 @@ TclFSCwdPointerEquals(pathPtrPtr)
str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
if (len1 == len2 && !strcmp(str1,str2)) {
/*
- * They are equal, but different objects. Update so they will be
+ * They are equal, but different objects. Update so they will be
* the same object in the future.
*/
@@ -638,7 +637,8 @@ FsRecacheFilesystemList(void)
#endif /* TCL_THREADS */
static FilesystemRecord *
-FsGetFirstFilesystem(void) {
+FsGetFirstFilesystem(void)
+{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FilesystemRecord *fsRecPtr;
#ifndef TCL_THREADS
@@ -663,8 +663,8 @@ FsGetFirstFilesystem(void) {
*/
int
-TclFSEpochOk(filesystemEpoch)
- int filesystemEpoch;
+TclFSEpochOk(
+ int filesystemEpoch)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
(void) FsGetFirstFilesystem();
@@ -676,9 +676,9 @@ TclFSEpochOk(filesystemEpoch)
*/
static void
-FsUpdateCwd(cwdObj, clientData)
- Tcl_Obj *cwdObj;
- ClientData clientData;
+FsUpdateCwd(
+ Tcl_Obj *cwdObj,
+ ClientData clientData)
{
int len;
char *str = NULL;
@@ -735,8 +735,8 @@ FsUpdateCwd(cwdObj, clientData)
*
* TclFinalizeFilesystem --
*
- * Clean up the filesystem. After this, calls to all Tcl_FS...
- * functions will fail.
+ * Clean up the filesystem. After this, calls to all Tcl_FS... functions
+ * will fail.
*
* We will later call TclResetFilesystem to restore the FS to a pristine
* state.
@@ -751,12 +751,12 @@ FsUpdateCwd(cwdObj, clientData)
*/
void
-TclFinalizeFilesystem()
+TclFinalizeFilesystem(void)
{
FilesystemRecord *fsRecPtr;
/*
- * Assumption that only one thread is active now. Otherwise we would need
+ * Assumption that only one thread is active now. Otherwise we would need
* to put various mutexes around this code.
*/
@@ -821,7 +821,7 @@ TclFinalizeFilesystem()
*/
void
-TclResetFilesystem()
+TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
@@ -851,7 +851,7 @@ TclResetFilesystem()
* can use Tcl_FSData to check if it is in the list, provided the
* ClientData used was not NULL).
*
- * Note that the filesystem handling is head-to-tail of the list. Each
+ * Note that the filesystem handling is head-to-tail of the list. Each
* filesystem is asked in turn whether it can handle a particular
* request, until one of them says 'yes'. At that point no further
* filesystems are asked.
@@ -871,9 +871,9 @@ TclResetFilesystem()
*/
int
-Tcl_FSRegister(clientData, fsPtr)
- ClientData clientData; /* Client specific data for this fs */
- Tcl_Filesystem *fsPtr; /* The filesystem record for the new fs. */
+Tcl_FSRegister(
+ ClientData clientData, /* Client specific data for this fs */
+ Tcl_Filesystem *fsPtr) /* The filesystem record for the new fs. */
{
FilesystemRecord *newFilesystemPtr;
@@ -887,17 +887,17 @@ Tcl_FSRegister(clientData, fsPtr)
newFilesystemPtr->fsPtr = fsPtr;
/*
- * We start with a refCount of 1. If this drops to zero, then anyone is
+ * We start with a refCount of 1. If this drops to zero, then anyone is
* welcome to ckfree us.
*/
newFilesystemPtr->fileRefCount = 1;
/*
- * Is this lock and wait strictly speaking necessary? Since any iterators
+ * Is this lock and wait strictly speaking necessary? Since any iterators
* out there will have grabbed a copy of the head of the list and be
* iterating away from that, if we add a new element to the head of the
- * list, it can't possibly have any effect on any of their loops. In fact
+ * list, it can't possibly have any effect on any of their loops. In fact
* it could be better not to wait, since we are adjusting the filesystem
* epoch, any cached representations calculated by existing iterators are
* going to have to be thrown away anyway.
@@ -932,14 +932,14 @@ Tcl_FSRegister(clientData, fsPtr)
* Tcl_FSUnregister --
*
* Remove the passed filesystem from the list of filesystem function
- * tables. It also ensures that the built-in (native) filesystem is not
+ * tables. It also ensures that the built-in (native) filesystem is not
* removable, although we may wish to change that decision in the future
* to allow a smaller Tcl core, in which the native filesystem is not
* used at all (we could, say, initialise Tcl completely over a network
* connection).
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * TCL_OK if the function pointer was successfully removed, TCL_ERROR
* otherwise.
*
* Side effects:
@@ -951,8 +951,8 @@ Tcl_FSRegister(clientData, fsPtr)
*/
int
-Tcl_FSUnregister(fsPtr)
- Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */
+Tcl_FSUnregister(
+ Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */
{
int retVal = TCL_ERROR;
FilesystemRecord *fsRecPtr;
@@ -979,7 +979,7 @@ Tcl_FSUnregister(fsPtr)
/*
* Increment the filesystem epoch counter, since existing paths
- * might conceivably now belong to different filesystems. This
+ * might conceivably now belong to different filesystems. This
* should also ensure that paths which have cached the filesystem
* which is about to be deleted do not reference that filesystem
* (which would of course lead to memory exceptions).
@@ -1008,17 +1008,17 @@ Tcl_FSUnregister(fsPtr)
* Tcl_FSMatchInDirectory --
*
* This routine is used by the globbing code to search a directory for
- * all files which match a given pattern. The appropriate function for
- * the filesystem to which pathPtr belongs will be called. If pathPtr
+ * all files which match a given pattern. The appropriate function for
+ * the filesystem to which pathPtr belongs will be called. If pathPtr
* does not belong to any filesystem and if it is NULL or the empty
* string, then we assume the pattern is to be matched in the current
- * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
+ * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
* each filesystem from having to deal with this issue, we create a
* pathPtr on the fly (equal to the cwd), and then remove it from the
- * results returned. This makes filesystems easy to write, since they
- * can assume the pathPtr passed to them is an ordinary path. In fact
- * this means we could remove such special case handling from Tcl's
- * native filesystems.
+ * results returned. This makes filesystems easy to write, since they can
+ * assume the pathPtr passed to them is an ordinary path. In fact this
+ * means we could remove such special case handling from Tcl's native
+ * filesystems.
*
* If 'pattern' is NULL, then pathPtr is assumed to be a fully specified
* path of a single file/directory which must be checked for existence
@@ -1027,14 +1027,14 @@ Tcl_FSUnregister(fsPtr)
* Results:
*
* The return value is a standard Tcl result indicating whether an error
- * occurred in globbing. Error messages are placed in interp, but good
+ * occurred in globbing. Error messages are placed in interp, but good
* results are placed in the resultPtr given.
*
* Recursive searches, e.g.
* glob -dir $dir -join * pkgIndex.tcl
* which must recurse through each directory matching '*' are handled
* internally by Tcl, by passing specific flags in a modified 'types'
- * parameter. This means the actual filesystem only ever sees patterns
+ * parameter. This means the actual filesystem only ever sees patterns
* which match in a single directory.
*
* Side effects:
@@ -1044,13 +1044,13 @@ Tcl_FSUnregister(fsPtr)
*/
int
-Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
- Tcl_Interp *interp; /* Interpreter to receive error
- * messages, but may be NULL. */
- Tcl_Obj *resultPtr; /* List object to receive results. */
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+Tcl_FSMatchInDirectory(
+ Tcl_Interp *interp, /* Interpreter to receive error messages, but
+ * may be NULL. */
+ Tcl_Obj *resultPtr, /* List object to receive results. */
+ Tcl_Obj *pathPtr, /* Contains path to directory to search. */
+ CONST char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
@@ -1063,7 +1063,7 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
* We don't currently allow querying of mounts by external code (a
* valuable future step), so since we're the only function that
* actually knows about mounts, this means we're being called
- * recursively by ourself. Return no matches.
+ * recursively by ourself. Return no matches.
*/
return TCL_OK;
@@ -1154,7 +1154,7 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
* FsAddMountsToGlobResult --
*
* This routine is used by the globbing code to take the results of a
- * directory listing and add any mounted paths to that listing. This is
+ * directory listing and add any mounted paths to that listing. This is
* required so that simple things like 'glob *' merge mounts and listings
* correctly.
*
@@ -1168,12 +1168,12 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
*/
static void
-FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
- Tcl_Obj *resultPtr; /* The current list of matching paths; must
+FsAddMountsToGlobResult(
+ Tcl_Obj *resultPtr, /* The current list of matching paths; must
* not be shared! */
- Tcl_Obj *pathPtr; /* The directory in question */
- CONST char *pattern; /* Pattern to match against. */
- Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ Tcl_Obj *pathPtr, /* The directory in question */
+ CONST char *pattern, /* Pattern to match against. */
+ Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
@@ -1268,7 +1268,7 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
* Clearly it should only therefore be called when it is really required!
* There are a few circumstances when it should be called:
*
- * (1) when a new filesystem is registered or unregistered. Strictly
+ * (1) when a new filesystem is registered or unregistered. Strictly
* speaking this is only necessary if the new filesystem accepts file
* paths as is (normally the filesystem itself is really a shell which
* hasn't yet had any mount points established and so its
@@ -1298,11 +1298,11 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
*/
void
-Tcl_FSMountsChanged(fsPtr)
- Tcl_Filesystem *fsPtr;
+Tcl_FSMountsChanged(
+ Tcl_Filesystem *fsPtr)
{
/*
- * We currently don't do anything with this parameter. We could in the
+ * We currently don't do anything with this parameter. We could in the
* future only invalidate files for this filesystem or otherwise take more
* advanced action.
*/
@@ -1328,7 +1328,7 @@ Tcl_FSMountsChanged(fsPtr)
* that filesystem is not registered.
*
* Results:
- * A clientData value, or NULL. Note that if the filesystem was
+ * A clientData value, or NULL. Note that if the filesystem was
* registered with a NULL clientData field, this function will return
* that NULL value.
*
@@ -1339,14 +1339,14 @@ Tcl_FSMountsChanged(fsPtr)
*/
ClientData
-Tcl_FSData(fsPtr)
- Tcl_Filesystem *fsPtr; /* The filesystem record to query. */
+Tcl_FSData(
+ Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
{
ClientData retVal = NULL;
FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
/*
- * Traverse the list of filesystems look for a particular one. If found,
+ * Traverse the list of filesystems look for a particular one. If found,
* return that filesystem's clientData (originally provided when calling
* Tcl_FSRegister).
*/
@@ -1367,13 +1367,13 @@ Tcl_FSData(fsPtr)
* TclFSNormalizeToUniquePath --
*
* Takes a path specification containing no ../, ./ sequences, and
- * converts it into a unique path for the given platform. On Unix, this
+ * converts it into a unique path for the given platform. On Unix, this
* means the path must be free of symbolic links/aliases, and on Windows
* it means we want the long form, with that long form's case-dependence
* (which gives us a unique, case-dependent path).
*
* Results:
- * The pathPtr is modified in place. The return value is the last byte
+ * The pathPtr is modified in place. The return value is the last byte
* offset which was recognised in the path string.
*
* Side effects:
@@ -1382,7 +1382,7 @@ Tcl_FSData(fsPtr)
* Special notes:
* If the filesystem-specific normalizePathProcs can re-introduce ../, ./
* sequences into the path, then this function will not return the
- * correct result. This may be possible with symbolic links on unix.
+ * correct result. This may be possible with symbolic links on unix.
*
* Important assumption: if startAt is non-zero, it must point to a
* directory separator that we know exists and is already normalized (so
@@ -1392,11 +1392,11 @@ Tcl_FSData(fsPtr)
*/
int
-TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
- Tcl_Interp *interp; /* Used for error messages. */
- Tcl_Obj *pathPtr; /* The path to normalize in place */
- int startAt; /* Start at this char-offset */
- ClientData *clientDataPtr; /* If we generated a complete normalized path
+TclFSNormalizeToUniquePath(
+ Tcl_Interp *interp, /* Used for error messages. */
+ Tcl_Obj *pathPtr, /* The path to normalize in place */
+ int startAt, /* Start at this char-offset */
+ ClientData *clientDataPtr) /* If we generated a complete normalized path
* for a given filesystem, we can optionally
* return an fs-specific clientdata here. */
{
@@ -1407,7 +1407,7 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
/*
* Call each of the "normalise path" functions in succession. This is a
* special case, in which if we have a native filesystem handler, we call
- * it first. This is because the root of Tcl's filesystem is always a
+ * it first. This is because the root of Tcl's filesystem is always a
* native filesystem (i.e. '/' on unix is native).
*/
@@ -1455,7 +1455,7 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
* TclGetOpenMode --
*
* This routine is an obsolete, limited version of TclGetOpenModeEx()
- * below. It exists only to satisfy any extensions imprudently using it
+ * below. It exists only to satisfy any extensions imprudently using it
* via Tcl's internal stubs table.
*
* Results:
@@ -1468,14 +1468,12 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
*/
int
-TclGetOpenMode(interp, modeString, seekFlagPtr)
- Tcl_Interp *interp; /* Interpreter to use for error
- * reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
- * CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller should
- * seek to EOF during the opening of
- * the file. */
+TclGetOpenMode(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting -
+ * may be NULL. */
+ CONST char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */
+ int *seekFlagPtr) /* Set this to 1 if the caller should seek to
+ * EOF during the opening of the file. */
{
int binary = 0;
return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
@@ -1498,7 +1496,7 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller to
- * seek to EOF after opening the file, or to 0 otherwise. Sets the
+ * seek to EOF after opening the file, or to 0 otherwise. Sets the
* integer referenced by binaryPtr to 1 to tell the caller to seek to
* configure the channel for binary data, or to 0 otherwise.
*
@@ -1510,24 +1508,22 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
*/
int
-TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
- Tcl_Interp *interp; /* Interpreter to use for error
- * reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
- * CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller should
- * seek to EOF during the opening of
- * the file. */
- int *binaryPtr; /* Set this to 1 if the caller should
- * configure the opened channel for
- * binary operations */
+TclGetOpenModeEx(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting -
+ * may be NULL. */
+ CONST char *modeString, /* Mode string, e.g. "r+" or "RDONLY CREAT" */
+ int *seekFlagPtr, /* Set this to 1 if the caller should seek to
+ * EOF during the opening of the file. */
+ int *binaryPtr) /* Set this to 1 if the caller should
+ * configure the opened channel for binary
+ * operations */
{
int mode, modeArgc, c, i, gotRW;
CONST char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
- * Check for the simpler fopen-like access modes (e.g. "r"). They are
+ * Check for the simpler fopen-like access modes (e.g. "r"). They are
* distinguished from the POSIX access modes by the presence of a
* lower-case first letter.
*/
@@ -1558,9 +1554,9 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
error:
*seekFlagPtr = 0;
*binaryPtr = 0;
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AppendResult(interp, "illegal access mode \"", modeString,
- "\"", (char *) NULL);
+ "\"", NULL);
}
return -1;
}
@@ -1596,7 +1592,7 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
*/
if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
Tcl_AddErrorInfo(interp, modeString);
@@ -1630,9 +1626,9 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
#ifdef O_NOCTTY
mode |= O_NOCTTY;
#else
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
+ "\" not supported by this system", NULL);
}
ckfree((char *) modeArgv);
return -1;
@@ -1647,9 +1643,9 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
# endif
#else
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
+ "\" not supported by this system", NULL);
}
ckfree((char *) modeArgv);
return -1;
@@ -1661,11 +1657,10 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
*binaryPtr = 1;
} else {
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AppendResult(interp, "invalid access mode \"", flag,
"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
- "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
- (char *) NULL);
+ "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
}
ckfree((char *) modeArgv);
return -1;
@@ -1675,9 +1670,9 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
ckfree((char *) modeArgv);
if (!gotRW) {
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp != NULL) {
Tcl_AppendResult(interp, "access mode must include either",
- " RDONLY, WRONLY, or RDWR", (char *) NULL);
+ " RDONLY, WRONLY, or RDWR", NULL);
}
return -1;
}
@@ -1689,9 +1684,9 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
*/
int
-Tcl_FSEvalFile(interp, pathPtr)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
+Tcl_FSEvalFile(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr) /* Path of file to process. Tilde-substitution
* will be performed on this name. */
{
return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
@@ -1710,7 +1705,7 @@ Tcl_FSEvalFile(interp, pathPtr)
* file or an error indicating why the file couldn't be read.
*
* Side effects:
- * Depends on the commands in the file. During the evaluation of the
+ * Depends on the commands in the file. During the evaluation of the
* contents of the file, iPtr->scriptFile is made to point to pathPtr
* (the old value is cached and replaced when this function returns).
*
@@ -1718,12 +1713,12 @@ Tcl_FSEvalFile(interp, pathPtr)
*/
int
-Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
- Tcl_Interp *interp; /* Interpreter in which to process file. */
- Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
+Tcl_FSEvalFileEx(
+ Tcl_Interp *interp, /* Interpreter in which to process file. */
+ Tcl_Obj *pathPtr, /* Path of file to process. Tilde-substitution
* will be performed on this name. */
- CONST char *encodingName; /* If non-NULL, then use this encoding for the
- * file. */
+ CONST char *encodingName) /* If non-NULL, then use this encoding for the
+ * file. NULL means use the system encoding. */
{
int result, length;
Tcl_StatBuf statBuf;
@@ -1743,28 +1738,26 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
goto end;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == (Tcl_Channel) NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
goto end;
}
/*
- * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
- * this cross-platform to allow for scripted documents. [Bug: 2040]
+ * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
+ * this cross-platform to allow for scripted documents. [Bug: 2040]
*/
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
/*
- * If the encoding is specified, set it for the channel. Else don't touch
+ * If the encoding is specified, set it for the channel. Else don't touch
* it (and use the system encoding) Report error on unknown encoding.
*/
@@ -1779,8 +1772,7 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
Tcl_Close(interp, chan);
Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
goto end;
}
@@ -1812,6 +1804,7 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
/*
* Record information telling where the error occurred.
*/
+
CONST char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
int limit = 150;
int overflow = (length > limit);
@@ -1846,7 +1839,7 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
*/
int
-Tcl_GetErrno()
+Tcl_GetErrno(void)
{
return errno;
}
@@ -1868,8 +1861,8 @@ Tcl_GetErrno()
*/
void
-Tcl_SetErrno(err)
- int err; /* The new value. */
+Tcl_SetErrno(
+ int err) /* The new value. */
{
errno = err;
}
@@ -1879,8 +1872,8 @@ Tcl_SetErrno(err)
*
* Tcl_PosixError --
*
- * This procedure is typically called after UNIX kernel calls return
- * errors. It stores machine-readable information about the error in
+ * This function is typically called after UNIX kernel calls return
+ * errors. It stores machine-readable information about the error in
* errorCode field of interp and returns an information string for the
* caller's use.
*
@@ -1894,15 +1887,15 @@ Tcl_SetErrno(err)
*/
CONST char *
-Tcl_PosixError(interp)
- Tcl_Interp *interp; /* Interpreter whose errorCode field
- * is to be set. */
+Tcl_PosixError(
+ Tcl_Interp *interp) /* Interpreter whose errorCode field is to be
+ * set. */
{
CONST char *id, *msg;
msg = Tcl_ErrnoMsg(errno);
id = Tcl_ErrnoId();
- Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
+ Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
return msg;
}
@@ -1911,7 +1904,7 @@ Tcl_PosixError(interp)
*
* Tcl_FSStat --
*
- * This procedure replaces the library version of stat and lsat.
+ * This function replaces the library version of stat and lsat.
*
* The appropriate function for the filesystem to which pathPtr belongs
* will be called.
@@ -1926,9 +1919,9 @@ Tcl_PosixError(interp)
*/
int
-Tcl_FSStat(pathPtr, buf)
- Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+Tcl_FSStat(
+ Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
@@ -1936,7 +1929,7 @@ Tcl_FSStat(pathPtr, buf)
int retVal = -1;
/*
- * Call each of the "stat" function in succession. A non-return value of
+ * Call each of the "stat" function in succession. A non-return value of
* -1 indicates the particular function has succeeded.
*/
@@ -2004,7 +1997,7 @@ Tcl_FSStat(pathPtr, buf)
*
* Tcl_FSLstat --
*
- * This procedure replaces the library version of lstat. The appropriate
+ * This function replaces the library version of lstat. The appropriate
* function for the filesystem to which pathPtr belongs will be called.
* If no 'lstat' function is listed, but a 'stat' function is, then Tcl
* will fall back on the stat function.
@@ -2019,9 +2012,9 @@ Tcl_FSStat(pathPtr, buf)
*/
int
-Tcl_FSLstat(pathPtr, buf)
- Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */
- Tcl_StatBuf *buf; /* Filled with results of stat call. */
+Tcl_FSLstat(
+ Tcl_Obj *pathPtr, /* Path of file to stat (in current CP). */
+ Tcl_StatBuf *buf) /* Filled with results of stat call. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -2044,9 +2037,8 @@ Tcl_FSLstat(pathPtr, buf)
*
* Tcl_FSAccess --
*
- * This procedure replaces the library version of access. The
- * appropriate function for the filesystem to which pathPtr belongs will
- * be called.
+ * This function replaces the library version of access. The appropriate
+ * function for the filesystem to which pathPtr belongs will be called.
*
* Results:
* See access documentation.
@@ -2058,17 +2050,17 @@ Tcl_FSLstat(pathPtr, buf)
*/
int
-Tcl_FSAccess(pathPtr, mode)
- Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+Tcl_FSAccess(
+ Tcl_Obj *pathPtr, /* Path of file to access (in current CP). */
+ int mode) /* Permission setting. */
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
int retVal = -1;
/*
- * Call each of the "access" function in succession. A non-return value
- * of -1 indicates the particular function has succeeded.
+ * Call each of the "access" function in succession. A non-return value of
+ * -1 indicates the particular function has succeeded.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -2130,13 +2122,13 @@ Tcl_FSAccess(pathPtr, mode)
*/
Tcl_Channel
-Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting; can be
+Tcl_FSOpenFileChannel(
+ Tcl_Interp *interp, /* Interpreter for error reporting; can be
* NULL. */
- Tcl_Obj *pathPtr; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or a string such
+ Tcl_Obj *pathPtr, /* Name of file to open. */
+ CONST char *modeString, /* A list of POSIX open modes or a string such
* as "rw". */
- int permissions; /* If the open involves creating a file, with
+ int permissions) /* If the open involves creating a file, with
* what modes to create it? */
{
Tcl_Filesystem *fsPtr;
@@ -2144,7 +2136,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
Tcl_Channel retVal = NULL;
/*
- * Call each of the "Tcl_OpenFileChannel" functions in succession. A
+ * Call each of the "Tcl_OpenFileChannel" functions in succession. A
* non-NULL return value indicates the particular function has succeeded.
*/
@@ -2192,30 +2184,41 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
if (proc != NULL) {
int mode, seekFlag, binary;
+ /*
+ * Parse the mode, picking up whether we want to seek to start
+ * with and/or set the channel automatically into binary mode.
+ */
+
mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
return NULL;
}
+ /*
+ * Do the actual open() call.
+ */
+
retVal = (*proc)(interp, pathPtr, mode, permissions);
- if (retVal != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(retVal, (Tcl_WideInt)0,
- SEEK_END) < (Tcl_WideInt)0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file while opening \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- Tcl_Close(NULL, retVal);
- return NULL;
- }
- }
- if (binary) {
- Tcl_SetChannelOption(interp, retVal,
- "-translation", "binary");
+ if (retVal == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Apply appropriate flags parsed out above.
+ */
+
+ if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
+ SEEK_END) < (Tcl_WideInt)0) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "could not seek to end ",
+ "of file while opening \"", Tcl_GetString(pathPtr),
+ "\": ", Tcl_PosixError(interp), NULL);
}
+ Tcl_Close(NULL, retVal);
+ return NULL;
+ }
+ if (binary) {
+ Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
}
return retVal;
}
@@ -2228,7 +2231,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
Tcl_SetErrno(ENOENT);
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ "\": ", Tcl_PosixError(interp), NULL);
}
return NULL;
}
@@ -2238,7 +2241,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*
* Tcl_FSUtime --
*
- * This procedure replaces the library version of utime. The appropriate
+ * This function replaces the library version of utime. The appropriate
* function for the filesystem to which pathPtr belongs will be called.
*
* Results:
@@ -2251,10 +2254,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*/
int
-Tcl_FSUtime(pathPtr, tval)
- Tcl_Obj *pathPtr; /* File to change access/modification times */
- struct utimbuf *tval; /* Structure containing access/modification
- * times to use. Should not be modified. */
+Tcl_FSUtime(
+ Tcl_Obj *pathPtr, /* File to change access/modification times */
+ struct utimbuf *tval) /* Structure containing access/modification
+ * times to use. Should not be modified. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -2271,9 +2274,9 @@ Tcl_FSUtime(pathPtr, tval)
*
* NativeFileAttrStrings --
*
- * This procedure implements the platform dependent 'file attributes'
+ * This function implements the platform dependent 'file attributes'
* subcommand, for the native filesystem, for listing the set of possible
- * attribute strings. This function is part of Tcl's native filesystem
+ * attribute strings. This function is part of Tcl's native filesystem
* support, and is placed here because it is shared by Unix and Windows
* code.
*
@@ -2286,10 +2289,10 @@ Tcl_FSUtime(pathPtr, tval)
*----------------------------------------------------------------------
*/
-static CONST char**
-NativeFileAttrStrings(pathPtr, objPtrRef)
- Tcl_Obj *pathPtr;
- Tcl_Obj** objPtrRef;
+static CONST char **
+NativeFileAttrStrings(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
{
return tclpFileAttrStrings;
}
@@ -2299,15 +2302,15 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
*
* NativeFileAttrsGet --
*
- * This procedure implements the platform dependent 'file attributes'
- * subcommand, for the native filesystem, for 'get' operations. This
+ * This function implements the platform dependent 'file attributes'
+ * subcommand, for the native filesystem, for 'get' operations. This
* function is part of Tcl's native filesystem support, and is placed
* here because it is shared by Unix and Windows code.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
- * was returned) is likely to have a refCount of zero. Either way we
- * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we must
+ * either store it somewhere (e.g. the Tcl result), or Incr/Decr its
* refCount to ensure it is properly freed.
*
* Side effects:
@@ -2317,13 +2320,13 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
*/
static int
-NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* path of file we are operating on. */
- Tcl_Obj **objPtrRef; /* for output. */
+NativeFileAttrsGet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* path of file we are operating on. */
+ Tcl_Obj **objPtrRef) /* for output. */
{
- return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
+ return (tclpFileAttrProcs[index]->getProc)(interp, index, pathPtr,
objPtrRef);
}
@@ -2332,7 +2335,7 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
*
* NativeFileAttrsSet --
*
- * This procedure implements the platform dependent 'file attributes'
+ * This function implements the platform dependent 'file attributes'
* subcommand, for the native filesystem, for 'set' operations. This
* function is part of Tcl's native filesystem support, and is placed
* here because it is shared by Unix and Windows code.
@@ -2347,13 +2350,13 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
*/
static int
-NativeFileAttrsSet(interp, index, pathPtr, objPtr)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* path of file we are operating on. */
- Tcl_Obj *objPtr; /* set to this value. */
+NativeFileAttrsSet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* path of file we are operating on. */
+ Tcl_Obj *objPtr) /* set to this value. */
{
- return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
+ return (tclpFileAttrProcs[index]->setProc)(interp, index, pathPtr, objPtr);
}
/*
@@ -2361,12 +2364,12 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
*
* Tcl_FSFileAttrStrings --
*
- * This procedure implements part of the hookable 'file attributes'
- * subcommand. The appropriate function for the filesystem to which
+ * This function implements part of the hookable 'file attributes'
+ * subcommand. The appropriate function for the filesystem to which
* pathPtr belongs will be called.
*
* Results:
- * The called procedure may either return an array of strings, or may
+ * The called function may either return an array of strings, or may
* instead return NULL and place a Tcl list into the given objPtrRef.
* Tcl will take that list and first increment its refCount before using
* it. On completion of that use, Tcl will decrement its refCount. Hence
@@ -2381,11 +2384,12 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
*/
CONST char **
-Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
- Tcl_Obj *pathPtr;
- Tcl_Obj **objPtrRef;
+Tcl_FSFileAttrStrings(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
if (proc != NULL) {
@@ -2414,11 +2418,11 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
*/
int
-TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
- Tcl_Obj *pathPtr; /* File whose attributes are to be
- * indexed into. */
- CONST char *attributeName; /* The attribute being looked for. */
- int *indexPtr; /* Where to write the found index. */
+TclFSFileAttrIndex(
+ Tcl_Obj *pathPtr, /* File whose attributes are to be indexed
+ * into. */
+ CONST char *attributeName, /* The attribute being looked for. */
+ int *indexPtr) /* Where to write the found index. */
{
Tcl_Obj *listObj = NULL;
CONST char **attrTable;
@@ -2478,14 +2482,14 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
*
* Tcl_FSFileAttrsGet --
*
- * This procedure implements read access for the hookable 'file
- * attributes' subcommand. The appropriate function for the filesystem
- * to which pathPtr belongs will be called.
+ * This function implements read access for the hookable 'file
+ * attributes' subcommand. The appropriate function for the filesystem to
+ * which pathPtr belongs will be called.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
- * was returned) is likely to have a refCount of zero. Either way we
- * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we must
+ * either store it somewhere (e.g. the Tcl result), or Incr/Decr its
* refCount to ensure it is properly freed.
*
* Side effects:
@@ -2495,13 +2499,14 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
*/
int
-Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* filename we are operating on. */
- Tcl_Obj **objPtrRef; /* for output. */
+Tcl_FSFileAttrsGet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* filename we are operating on. */
+ Tcl_Obj **objPtrRef) /* for output. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
if (proc != NULL) {
@@ -2517,9 +2522,9 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
*
* Tcl_FSFileAttrsSet --
*
- * This procedure implements write access for the hookable 'file
- * attributes' subcommand. The appropriate function for the filesystem
- * to which pathPtr belongs will be called.
+ * This function implements write access for the hookable 'file
+ * attributes' subcommand. The appropriate function for the filesystem to
+ * which pathPtr belongs will be called.
*
* Results:
* Standard Tcl return code.
@@ -2531,13 +2536,14 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
*/
int
-Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
- Tcl_Interp *interp; /* The interpreter for error reporting. */
- int index; /* index of the attribute command. */
- Tcl_Obj *pathPtr; /* filename we are operating on. */
- Tcl_Obj *objPtr; /* Input value. */
+Tcl_FSFileAttrsSet(
+ Tcl_Interp *interp, /* The interpreter for error reporting. */
+ int index, /* index of the attribute command. */
+ Tcl_Obj *pathPtr, /* filename we are operating on. */
+ Tcl_Obj *objPtr) /* Input value. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
if (proc != NULL) {
@@ -2555,10 +2561,10 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*
* This function replaces the library version of getcwd().
*
- * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its
- * own record (in a Tcl_Obj) of the cwd, and an attempt is made to
- * synchronise this with the cwd's containing filesystem, if that
- * filesystem provides a cwdProc (e.g. the native filesystem).
+ * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own
+ * record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this
+ * with the cwd's containing filesystem, if that filesystem provides a
+ * cwdProc (e.g. the native filesystem).
*
* Note that if Tcl's cwd is not in the native filesystem, then of course
* Tcl's cwd and the native cwd are different: extensions should
@@ -2575,10 +2581,10 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*
* Results:
* The result is a pointer to a Tcl_Obj specifying the current directory,
- * or NULL if the current directory could not be determined. If NULL is
+ * or NULL if the current directory could not be determined. If NULL is
* returned, an error message is left in the interp's result.
*
- * The result already has its refCount incremented for the caller. When
+ * The result already has its refCount incremented for the caller. When
* it is no longer needed, that refCount should be decremented.
*
* Side effects:
@@ -2587,9 +2593,9 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
*----------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSGetCwd(interp)
- Tcl_Interp *interp;
+Tcl_Obj *
+Tcl_FSGetCwd(
+ Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -2598,8 +2604,8 @@ Tcl_FSGetCwd(interp)
Tcl_Obj *retVal = NULL;
/*
- * We've never been called before, try to find a cwd. Call each of
- * the "Tcl_GetCwd" function in succession. A non-NULL return value
+ * We've never been called before, try to find a cwd. Call each of the
+ * "Tcl_GetCwd" function in succession. A non-NULL return value
* indicates the particular function has succeeded.
*/
@@ -2622,15 +2628,15 @@ Tcl_FSGetCwd(interp)
if (norm != NULL) {
/*
* We found a cwd, which is now in our global
- * storage. We must make a copy. Norm already has
+ * storage. We must make a copy. Norm already has
* a refCount of 1.
*
* Threading issue: note that multiple threads at
* system startup could in principle call this
- * procedure simultaneously. They will therefore
- * each set the cwdPathPtr independently. That
+ * function simultaneously. They will therefore
+ * each set the cwdPathPtr independently. That
* behaviour is a bit peculiar, but should be
- * fine. Once we have a cwd, we'll always be in
+ * fine. Once we have a cwd, we'll always be in
* the 'else' branch below which is simpler.
*/
@@ -2642,12 +2648,10 @@ Tcl_FSGetCwd(interp)
Tcl_DecrRefCount(retVal);
retVal = NULL;
goto cdDidNotChange;
- } else {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
+ } else if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), NULL);
}
} else {
retVal = (*proc)(interp);
@@ -2669,15 +2673,15 @@ Tcl_FSGetCwd(interp)
Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
if (norm != NULL) {
/*
- * We found a cwd, which is now in our global storage. We
- * must make a copy. Norm already has a refCount of 1.
+ * We found a cwd, which is now in our global storage. We must
+ * make a copy. Norm already has a refCount of 1.
*
* Threading issue: note that multiple threads at system
- * startup could in principle call this procedure
- * simultaneously. They will therefore each set the
- * cwdPathPtr independently. That behaviour is a bit
- * peculiar, but should be fine. Once we have a cwd, we'll
- * always be in the 'else' branch below which is simpler.
+ * startup could in principle call this function
+ * simultaneously. They will therefore each set the cwdPathPtr
+ * independently. That behaviour is a bit peculiar, but should
+ * be fine. Once we have a cwd, we'll always be in the 'else'
+ * branch below which is simpler.
*/
ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
@@ -2690,7 +2694,7 @@ Tcl_FSGetCwd(interp)
/*
* We already have a cwd cached, but we want to give the filesystem it
* is in a chance to check whether that cwd has changed, or is perhaps
- * no longer accessible. This allows an error to be thrown if, say,
+ * no longer accessible. This allows an error to be thrown if, say,
* the permissions on that directory have changed.
*/
@@ -2700,7 +2704,7 @@ Tcl_FSGetCwd(interp)
* If the filesystem couldn't be found, or if no cwd function exists
* for this filesystem, then we simply assume the cached cwd is ok.
* If we do call a cwd, we must watch for errors (if the cwd returns
- * NULL). This ensures that, say, on Unix if the permissions of the
+ * NULL). This ensures that, say, on Unix if the permissions of the
* cwd change, 'pwd' does actually throw the correct error in Tcl.
* (This is tested for in the test suite on unix).
*/
@@ -2717,7 +2721,7 @@ Tcl_FSGetCwd(interp)
if (retCd == NULL && interp != NULL) {
Tcl_AppendResult(interp,
"error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
if (retCd == tsdPtr->cwdClientData) {
@@ -2739,7 +2743,7 @@ Tcl_FSGetCwd(interp)
/*
* Check whether cwd has changed from the value previously
- * stored in cwdPathPtr. Really 'norm' shouldn't be null,
+ * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
* but we are careful.
*/
@@ -2753,7 +2757,7 @@ Tcl_FSGetCwd(interp)
} else {
/*
* Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
- * normalized paths. Therefore we can be more
+ * normalized paths. Therefore we can be more
* efficient than calling 'Tcl_FSEqualPaths', and in
* addition avoid a nasty infinite loop bug when
* trying to normalize tsdPtr->cwdPathPtr.
@@ -2768,7 +2772,7 @@ Tcl_FSGetCwd(interp)
/*
* If the paths were equal, we can be more
* efficient and retain the old path object which
- * will probably already be shared. In this case
+ * will probably already be shared. In this case
* we can simply free the normalized path we just
* calculated.
*/
@@ -2785,7 +2789,10 @@ Tcl_FSGetCwd(interp)
}
Tcl_DecrRefCount(retVal);
} else {
- /* The 'cwd' function returned an error; reset the cwd */
+ /*
+ * The 'cwd' function returned an error; reset the cwd.
+ */
+
FsUpdateCwd(NULL, NULL);
}
}
@@ -2811,18 +2818,18 @@ Tcl_FSGetCwd(interp)
* it.
*
* Results:
- * See chdir() documentation. If successful, we keep a record of the
+ * See chdir() documentation. If successful, we keep a record of the
* successful path in cwdPathPtr for subsequent calls to getcwd.
*
* Side effects:
- * See chdir() documentation. The global cwdPathPtr may change value.
+ * See chdir() documentation. The global cwdPathPtr may change value.
*
*----------------------------------------------------------------------
*/
int
-Tcl_FSChdir(pathPtr)
- Tcl_Obj *pathPtr;
+Tcl_FSChdir(
+ Tcl_Obj *pathPtr)
{
Tcl_Filesystem *fsPtr;
int retVal = -1;
@@ -2851,7 +2858,7 @@ Tcl_FSChdir(pathPtr)
/*
* If the file can be stat'ed and is a directory and is readable,
- * then we can chdir. If any of these actions fail, then
+ * then we can chdir. If any of these actions fail, then
* 'Tcl_SetErrno()' should automatically have been called to set
* an appropriate error code
*/
@@ -2870,22 +2877,22 @@ Tcl_FSChdir(pathPtr)
}
/*
- * The cwd changed, or an error was thrown. If an error was thrown, we
- * can just continue (and that will report the error to the user). If
- * there was no error we must assume that the cwd was actually changed to
- * the normalized value we calculated above, and we must therefore cache
- * that information.
+ * The cwd changed, or an error was thrown. If an error was thrown, we can
+ * just continue (and that will report the error to the user). If there
+ * was no error we must assume that the cwd was actually changed to the
+ * normalized value we calculated above, and we must therefore cache that
+ * information.
*/
/*
* If the filesystem in question has a getCwdProc, then the correct logic
* which performs the part below is already part of the Tcl_FSGetCwd()
- * call, so no need to replicate it again. This will have a side effect
- * though. The private authoritative representation of the current
- * working directory stored in cwdPathPtr in static memory will be
- * out-of-sync with the real OS-maintained value. The first call to
- * Tcl_FSGetCwd will however recalculate the private copy to match the
- * OS-value so everything will work right.
+ * call, so no need to replicate it again. This will have a side effect
+ * though. The private authoritative representation of the current working
+ * directory stored in cwdPathPtr in static memory will be out-of-sync
+ * with the real OS-maintained value. The first call to Tcl_FSGetCwd will
+ * however recalculate the private copy to match the OS-value so
+ * everything will work right.
*
* However, if there is no getCwdProc, then we _must_ update our private
* storage of the cwd, since this is the only opportunity to do that!
@@ -2899,8 +2906,8 @@ Tcl_FSChdir(pathPtr)
/*
* Note that this normalized path may be different to what we found
* above (or at least a different object), if the filesystem epoch
- * changed recently. This can actually happen with scripted documents
- * very easily. Therefore we ask for the normalized path again (the
+ * changed recently. This can actually happen with scripted documents
+ * very easily. Therefore we ask for the normalized path again (the
* correct value will have been cached as a result of the
* Tcl_FSGetFileSystemForPath call above anyway).
*/
@@ -2916,17 +2923,17 @@ Tcl_FSChdir(pathPtr)
if (fsPtr == &tclNativeFilesystem) {
/*
* For the native filesystem, we keep a cache of the native
- * representation of the cwd. But, we want to do that for the
+ * representation of the cwd. But, we want to do that for the
* exact format that is returned by 'getcwd' (so that we can later
* compare the two representations for equality), which might not
* be exactly the same char-string as the native representation of
* the fully normalized path (e.g. on Windows there's a
- * forward-slash vs backslash difference). Hence we ask for this
- * again here. On Unix it might actually be true that we always
+ * forward-slash vs backslash difference). Hence we ask for this
+ * again here. On Unix it might actually be true that we always
* have the correct form in the native rep in which case we could
* simply use:
* cd = Tcl_FSGetNativePath(pathPtr);
- * instead. This should be examined by someone on Unix.
+ * instead. This should be examined by someone on Unix.
*/
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -2953,43 +2960,43 @@ Tcl_FSChdir(pathPtr)
* Tcl_FSLoadFile --
*
* Dynamically loads a binary code file into memory and returns the
- * addresses of two procedures within that file, if they are defined.
- * The appropriate function for the filesystem to which pathPtr belongs
- * will be called.
+ * addresses of two functions within that file, if they are defined. The
+ * appropriate function for the filesystem to which pathPtr belongs will
+ * be called.
*
* Note that the native filesystem doesn't actually assume 'pathPtr' is a
- * path. Rather it assumes pathPtr is either a path or just the name
+ * path. Rather it assumes pathPtr is either a path or just the name
* (tail) of a file which can be found somewhere in the environment's
- * loadable path. This behaviour is not very compatible with virtual
+ * loadable path. This behaviour is not very compatible with virtual
* filesystems (and has other problems documented in the load man-page),
* so it is advised that full paths are always used.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be unloaded by
+ * New code suddenly appears in memory. This may later be unloaded by
* passing the clientData to the unloadProc.
*
*----------------------------------------------------------------------
*/
int
-Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- handlePtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+Tcl_FSLoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code. */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in the
+ CONST char *sym1, CONST char *sym2,
+ /* Names of two functions to look up in the
* file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for dynamically loaded
+ Tcl_LoadHandle *handlePtr, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
@@ -2999,21 +3006,27 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
ClientData clientData;
int res;
- /* Initialize the arrays */
+ /*
+ * Initialize the arrays.
+ */
+
symbols[0] = sym1;
symbols[1] = sym2;
procPtrs[0] = proc1Ptr;
procPtrs[1] = proc2Ptr;
- /* Perform the load */
- res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs,
- handlePtr, &clientData, unloadProcPtr);
+ /*
+ * Perform the load.
+ */
+
+ res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr,
+ &clientData, unloadProcPtr);
/*
* Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
* library, we don't keep the loadHandle (for TclpFindSymbol) and the
- * clientData (for the unloadProc) separately. In fact we effectively
- * throw away the loadHandle and only use the clientData. It just so
+ * clientData (for the unloadProc) separately. In fact we effectively
+ * throw away the loadHandle and only use the clientData. It just so
* happens, for the native filesystem only, that these two are identical.
*
* This also means that the signatures Tcl_FSUnloadFileProc and
@@ -3030,318 +3043,321 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
* TclLoadFile --
*
* Dynamically loads a binary code file into memory and returns the
- * addresses of a number of given procedures within that file, if they
- * are defined. The appropriate function for the filesystem to which
- * pathPtr belongs will be called.
+ * addresses of a number of given functions within that file, if they are
+ * defined. The appropriate function for the filesystem to which pathPtr
+ * belongs will be called.
*
* Note that the native filesystem doesn't actually assume 'pathPtr' is a
- * path. Rather it assumes pathPtr is either a path or just the name
+ * path. Rather it assumes pathPtr is either a path or just the name
* (tail) of a file which can be found somewhere in the environment's
- * loadable path. This behaviour is not very compatible with virtual
+ * loadable path. This behaviour is not very compatible with virtual
* filesystems (and has other problems documented in the load man-page),
* so it is advised that full paths are always used.
*
- * This function is currently private to Tcl. It may be exported in the
+ * This function is currently private to Tcl. It may be exported in the
* future and its interface fixed (but we should clean up the
* loadHandle/clientData confusion at that time -- see the above comments
- * in Tcl_FSLoadFile for details). For a public function, see
+ * in Tcl_FSLoadFile for details). For a public function, see
* Tcl_FSLoadFile.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error message
+ * A standard Tcl completion code. If an error occurs, an error message
* is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be unloaded by
+ * New code suddenly appears in memory. This may later be unloaded by
* passing the clientData to the unloadProc.
*
*----------------------------------------------------------------------
*/
int
-TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
- handlePtr, clientDataPtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+TclLoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code. */
- int symc; /* Number of symbols/procPtrs in the next two
+ int symc, /* Number of symbols/procPtrs in the next two
* arrays. */
- CONST char *symbols[]; /* Names of procedures to look up in the
- * file's symbol table. */
- Tcl_PackageInitProc **procPtrs[];
+ CONST char *symbols[], /* Names of functions to look up in the file's
+ * symbol table. */
+ Tcl_PackageInitProc **procPtrs[],
/* Where to return the addresses corresponding
- * to symbols[]. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for shared library
+ * to symbols[]. */
+ Tcl_LoadHandle *handlePtr, /* Filled with token for shared library
* information which can be used in
* TclpFindSymbol. */
- ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ ClientData *clientDataPtr, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
- Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
- Tcl_Filesystem *copyFsPtr;
- Tcl_Obj *copyToPtr;
+ Tcl_FSLoadFileProc *proc;
+ Tcl_Filesystem *copyFsPtr;
+ Tcl_Obj *copyToPtr;
+ Tcl_LoadHandle newLoadHandle = NULL;
+ ClientData newClientData = NULL;
+ Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
+ FsDivertLoad *tvdlPtr;
+ int retVal;
- if (proc != NULL) {
- int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
- if (retVal == TCL_OK) {
- int i;
- if (*handlePtr == NULL) {
- return TCL_ERROR;
- }
- for (i=0 ; i<symc ; i++) {
- if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
- }
- }
-
- /*
- * Copy this across, since both are equal for the native fs.
- */
+ if (fsPtr == NULL) {
+ Tcl_SetErrno(ENOENT);
+ return TCL_ERROR;
+ }
- *clientDataPtr = (ClientData)*handlePtr;
- Tcl_ResetResult(interp);
- return TCL_OK;
- }
- if (Tcl_GetErrno() != EXDEV) {
- return retVal;
+ proc = fsPtr->loadFileProc;
+ if (proc != NULL) {
+ int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
+ if (retVal == TCL_OK) {
+ if (*handlePtr == NULL) {
+ return TCL_ERROR;
}
- }
- /*
- * The filesystem doesn't support 'load', so we fall back on the
- * following technique:
- *
- * First check if it is readable -- and exists!
- */
+ /*
+ * Copy this across, since both are equal for the native fs.
+ */
- if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ *clientDataPtr = (ClientData)*handlePtr;
+ Tcl_ResetResult(interp);
+ goto resolveSymbols;
+ }
+ if (Tcl_GetErrno() != EXDEV) {
+ return retVal;
}
+ }
+
+ /*
+ * The filesystem doesn't support 'load', so we fall back on the following
+ * technique:
+ *
+ * First check if it is readable -- and exists!
+ */
+
+ if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
+ Tcl_AppendResult(interp, "couldn't load library \"",
+ Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
#ifdef TCL_LOAD_FROM_MEMORY
- /*
- * The platform supports loading code from memory, so ask for a buffer
- * of the appropriate size, read the file into it and load the code
- * from the buffer:
- */
+ /*
+ * The platform supports loading code from memory, so ask for a buffer of
+ * the appropriate size, read the file into it and load the code from the
+ * buffer:
+ */
- do {
- int ret, size;
- void *buffer;
- Tcl_StatBuf statBuf;
- Tcl_Channel data;
+ {
+ int ret, size;
+ void *buffer;
+ Tcl_StatBuf statBuf;
+ Tcl_Channel data;
- ret = Tcl_FSStat(pathPtr, &statBuf);
- if (ret < 0) {
- break;
- }
- size = (int) statBuf.st_size;
+ ret = Tcl_FSStat(pathPtr, &statBuf);
+ if (ret < 0) {
+ goto mustCopyToTempAnyway;
+ }
+ size = (int) statBuf.st_size;
- /*
- * Tcl_Read takes an int: check that file size isn't wide.
- */
+ /*
+ * Tcl_Read takes an int: check that file size isn't wide.
+ */
- if (size != (Tcl_WideInt) statBuf.st_size) {
- break;
- }
- data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
- if (!data) {
- break;
- }
- buffer = TclpLoadMemoryGetBuffer(interp, size);
- if (!buffer) {
- Tcl_Close(interp, data);
- break;
- }
- Tcl_SetChannelOption(interp, data, "-translation", "binary");
- ret = Tcl_Read(data, buffer, size);
+ if (size != (Tcl_WideInt) statBuf.st_size) {
+ goto mustCopyToTempAnyway;
+ }
+ data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
+ if (!data) {
+ goto mustCopyToTempAnyway;
+ }
+ buffer = TclpLoadMemoryGetBuffer(interp, size);
+ if (!buffer) {
Tcl_Close(interp, data);
- ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
- unloadProcPtr);
- if (ret == TCL_OK) {
- int i;
- if (*handlePtr == NULL) {
- break;
- }
- for (i = 0;i < symc;i++) {
- if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
- }
- }
- *clientDataPtr = (ClientData) *handlePtr;
- return TCL_OK;
- }
- } while (0);
- Tcl_ResetResult(interp);
+ goto mustCopyToTempAnyway;
+ }
+ ret = Tcl_Read(data, buffer, size);
+ Tcl_Close(interp, data);
+ ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
+ unloadProcPtr);
+ if (ret == TCL_OK && *handlePtr != NULL) {
+ *clientDataPtr = (ClientData) *handlePtr;
+ goto resolveSymbols;
+ }
+ }
+
+ mustCopyToTempAnyway:
+ Tcl_ResetResult(interp);
#endif
+ /*
+ * Get a temporary filename to use, first to copy the file into, and then
+ * to load.
+ */
+
+ copyToPtr = TclpTempFileName();
+ if (copyToPtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't create temporary file: ",
+ Tcl_PosixError(interp), NULL);
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(copyToPtr);
+
+ copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
+ if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
/*
- * Get a temporary filename to use, first to copy the file into, and
- * then to load.
+ * We already know we can't use Tcl_FSLoadFile from this filesystem,
+ * and we must avoid a possible infinite loop. Try to delete the file
+ * we probably created, and then exit.
*/
- copyToPtr = TclpTempFileName();
- if (copyToPtr == NULL) {
- Tcl_AppendResult(interp, "couldn't create temporary file: ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
- }
- Tcl_IncrRefCount(copyToPtr);
-
- copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
- if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
- /*
- * We already know we can't use Tcl_FSLoadFile from this
- * filesystem, and we must avoid a possible infinite loop. Try to
- * delete the file we probably created, and then exit.
- */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ Tcl_AppendResult(interp, "couldn't load from current filesystem",NULL);
+ return TCL_ERROR;
+ }
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- Tcl_AppendResult(interp, "couldn't load from current filesystem",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) {
+ /*
+ * Cross-platform copy failed.
+ */
- if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
- Tcl_LoadHandle newLoadHandle = NULL;
- ClientData newClientData = NULL;
- Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
- FsDivertLoad *tvdlPtr;
- int retVal;
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return TCL_ERROR;
+ }
#if !defined(__WIN32__)
- /*
- * Do we need to set appropriate permissions on the file? This
- * may be required on some systems. On Unix we could loop over
- * the file attributes, and set any that are called "-permissions"
- * to 0700. However, we just do this directly, like this:
- */
+ /*
+ * Do we need to set appropriate permissions on the file? This may be
+ * required on some systems. On Unix we could loop over the file
+ * attributes, and set any that are called "-permissions" to 0700. However
+ * we just do this directly, like this:
+ */
- int index;
- Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
- Tcl_IncrRefCount(perm);
- if (TclFSFileAttrIndex(copyToPtr, "-permissions",
- &index) == TCL_OK) {
- Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
- }
- Tcl_DecrRefCount(perm);
+ {
+ int index;
+ Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
+
+ Tcl_IncrRefCount(perm);
+ if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
+ Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
+ }
+ Tcl_DecrRefCount(perm);
+ }
#endif
- /*
- * We need to reset the result now, because the cross- filesystem
- * copy may have stored the number of bytes in the result.
- */
+ /*
+ * We need to reset the result now, because the cross-filesystem copy may
+ * have stored the number of bytes in the result.
+ */
- Tcl_ResetResult(interp);
+ Tcl_ResetResult(interp);
- retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
- &newLoadHandle, &newClientData, &newUnloadProcPtr);
- if (retVal != TCL_OK) {
- /* The file didn't load successfully */
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- return retVal;
- }
+ retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
+ &newLoadHandle, &newClientData, &newUnloadProcPtr);
+ if (retVal != TCL_OK) {
+ /*
+ * The file didn't load successfully.
+ */
- /*
- * Try to delete the file immediately - this is possible in some
- * OSes, and avoids any worries about leaving the copy laying
- * around on exit.
- */
+ Tcl_FSDeleteFile(copyToPtr);
+ Tcl_DecrRefCount(copyToPtr);
+ return retVal;
+ }
- if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
- Tcl_DecrRefCount(copyToPtr);
+ /*
+ * Try to delete the file immediately - this is possible in some OSes, and
+ * avoids any worries about leaving the copy laying around on exit.
+ */
- /*
- * We tell our caller about the real shared library which was
- * loaded. Note that this does mean that the package list
- * maintained by 'load' will store the original (vfs) path
- * alongside the temporary load handle and unload proc ptr.
- */
+ if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ Tcl_DecrRefCount(copyToPtr);
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = newClientData;
- (*unloadProcPtr) = newUnloadProcPtr;
- Tcl_ResetResult(interp);
- return TCL_OK;
- }
+ /*
+ * We tell our caller about the real shared library which was loaded.
+ * Note that this does mean that the package list maintained by 'load'
+ * will store the original (vfs) path alongside the temporary load
+ * handle and unload proc ptr.
+ */
- /*
- * When we unload this file, we need to divert the unloading so we
- * can unload and cleanup the temporary file correctly.
- */
+ (*handlePtr) = newLoadHandle;
+ (*clientDataPtr) = newClientData;
+ (*unloadProcPtr) = newUnloadProcPtr;
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
- tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+ /*
+ * When we unload this file, we need to divert the unloading so we can
+ * unload and cleanup the temporary file correctly.
+ */
- /*
- * Remember three pieces of information. This allows us to
- * cleanup the diverted load completely, on platforms which allow
- * proper unloading of code.
- */
+ tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
- tvdlPtr->loadHandle = newLoadHandle;
- tvdlPtr->unloadProcPtr = newUnloadProcPtr;
+ /*
+ * Remember three pieces of information. This allows us to cleanup the
+ * diverted load completely, on platforms which allow proper unloading of
+ * code.
+ */
- if (copyFsPtr != &tclNativeFilesystem) {
- /* copyToPtr is already incremented for this reference */
- tvdlPtr->divertedFile = copyToPtr;
+ tvdlPtr->loadHandle = newLoadHandle;
+ tvdlPtr->unloadProcPtr = newUnloadProcPtr;
- /*
- * This is the filesystem we loaded it into. Since we have a
- * reference to 'copyToPtr', we already have a refCount on
- * this filesystem, so we don't need to worry about it
- * disappearing on us.
- */
+ if (copyFsPtr != &tclNativeFilesystem) {
+ /*
+ * copyToPtr is already incremented for this reference.
+ */
- tvdlPtr->divertedFilesystem = copyFsPtr;
- tvdlPtr->divertedFileNativeRep = NULL;
- } else {
- /* We need the native rep */
- tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
- Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
+ tvdlPtr->divertedFile = copyToPtr;
- /*
- * We don't need or want references to the copied Tcl_Obj or
- * the filesystem if it is the native one.
- */
+ /*
+ * This is the filesystem we loaded it into. Since we have a reference
+ * to 'copyToPtr', we already have a refCount on this filesystem, so
+ * we don't need to worry about it disappearing on us.
+ */
- tvdlPtr->divertedFile = NULL;
- tvdlPtr->divertedFilesystem = NULL;
- Tcl_DecrRefCount(copyToPtr);
- }
+ tvdlPtr->divertedFilesystem = copyFsPtr;
+ tvdlPtr->divertedFileNativeRep = NULL;
+ } else {
+ /*
+ * We need the native rep.
+ */
- copyToPtr = NULL;
- (*handlePtr) = newLoadHandle;
- (*clientDataPtr) = (ClientData) tvdlPtr;
- (*unloadProcPtr) = &FSUnloadTempFile;
- Tcl_ResetResult(interp);
- return retVal;
+ tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
+ Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
- } else {
- /*
- * Cross-platform copy failed.
- */
+ /*
+ * We don't need or want references to the copied Tcl_Obj or the
+ * filesystem if it is the native one.
+ */
- Tcl_FSDeleteFile(copyToPtr);
- Tcl_DecrRefCount(copyToPtr);
- return TCL_ERROR;
+ tvdlPtr->divertedFile = NULL;
+ tvdlPtr->divertedFilesystem = NULL;
+ Tcl_DecrRefCount(copyToPtr);
+ }
+
+ copyToPtr = NULL;
+ (*handlePtr) = newLoadHandle;
+ (*clientDataPtr) = (ClientData) tvdlPtr;
+ (*unloadProcPtr) = &FSUnloadTempFile;
+
+ Tcl_ResetResult(interp);
+ return retVal;
+
+ resolveSymbols:
+ {
+ int i;
+
+ for (i=0 ; i<symc ; i++) {
+ if (symbols[i] != NULL) {
+ *procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]);
+ }
}
}
- Tcl_SetErrno(ENOENT);
- return TCL_ERROR;
+ return TCL_OK;
}
/*
* This function used to be in the platform specific directories, but it has
@@ -3349,20 +3365,20 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
*/
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- clientDataPtr, unloadProcPtr)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tcl_Obj *pathPtr; /* Name of the file containing the desired
+TclpLoadFile(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in the
+ CONST char *sym1, CONST char *sym2,
+ /* Names of two functions to look up in the
* file's symbol table. */
- Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+ Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
- ClientData *clientDataPtr; /* Filled with token for dynamically loaded
+ ClientData *clientDataPtr, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
@@ -3380,7 +3396,7 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
return TCL_ERROR;
}
- *clientDataPtr = (ClientData)handle;
+ *clientDataPtr = (ClientData) handle;
*proc1Ptr = TclpFindSymbol(interp, handle, sym1);
*proc2Ptr = TclpFindSymbol(interp, handle, sym2);
@@ -3393,7 +3409,7 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
* FSUnloadTempFile --
*
* This function is called when we loaded a library of code via an
- * intermediate temporary file. This function ensures the library is
+ * intermediate temporary file. This function ensures the library is
* correctly unloaded and the temporary file is correctly deleted.
*
* Results:
@@ -3405,25 +3421,28 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
*
*---------------------------------------------------------------------------
*/
+
static void
-FSUnloadTempFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to
- * Tcl_FSLoadFile(). The loadHandle is a token
- * that represents the loaded file. */
+FSUnloadTempFile(
+ Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
+ * Tcl_FSLoadFile(). The loadHandle is a token
+ * that represents the loaded file. */
{
- FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
+ FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle;
/*
* This test should never trigger, since we give the client data in the
* function above.
*/
- if (tvdlPtr == NULL) { return; }
+ if (tvdlPtr == NULL) {
+ return;
+ }
/*
* Call the real 'unloadfile' proc we actually used. It is very important
* that we call this first, so that the shared library is actually
- * unloaded by the OS. Otherwise, the following 'delete' may well fail
+ * unloaded by the OS. Otherwise, the following 'delete' may well fail
* because the shared library is still in use.
*/
@@ -3443,7 +3462,7 @@ FSUnloadTempFile(loadHandle)
} else {
/*
- * Remove the temporary file we created. Note, we may crash here
+ * Remove the temporary file we created. Note, we may crash here
* because encodings have been taken down already.
*/
@@ -3467,7 +3486,7 @@ FSUnloadTempFile(loadHandle)
}
/*
- * And free up the allocations. This will also of course remove a
+ * And free up the allocations. This will also of course remove a
* refCount from the Tcl_Filesystem to which this file belongs, which
* could then free up the filesystem if we are exiting.
*/
@@ -3484,18 +3503,18 @@ FSUnloadTempFile(loadHandle)
* Tcl_FSLink --
*
* This function replaces the library version of readlink() and can also
- * be used to make links. The appropriate function for the filesystem to
+ * be used to make links. The appropriate function for the filesystem to
* which pathPtr belongs will be called.
*
* Results:
* If toPtr is NULL, then the result is a Tcl_Obj specifying the contents
* of the symbolic link given by 'pathPtr', or NULL if the symbolic link
- * could not be read. The result is owned by the caller, which should
+ * could not be read. The result is owned by the caller, which should
* call Tcl_DecrRefCount when the result is no longer needed.
*
* If toPtr is non-NULL, then the result is toPtr if the link action was
- * successful, or NULL if not. In this case the result has no additional
- * reference count, and need not be freed. The actual action to perform
+ * successful, or NULL if not. In this case the result has no additional
+ * reference count, and need not be freed. The actual action to perform
* is given by the 'linkAction' flags, which is an or'd combination of:
*
* TCL_CREATE_SYMBOLIC_LINK
@@ -3506,20 +3525,22 @@ FSUnloadTempFile(loadHandle)
* is in the same FS as pathPtr.
*
* Side effects:
- * See readlink() documentation. A new filesystem link object may appear
+ * See readlink() documentation. A new filesystem link object may appear.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
-Tcl_FSLink(pathPtr, toPtr, linkAction)
- Tcl_Obj *pathPtr; /* Path of file to readlink or link */
- Tcl_Obj *toPtr; /* NULL or path to be linked to */
- int linkAction; /* Action to perform */
+Tcl_FSLink(
+ Tcl_Obj *pathPtr, /* Path of file to readlink or link */
+ Tcl_Obj *toPtr, /* NULL or path to be linked to */
+ int linkAction) /* Action to perform */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
if (fsPtr != NULL) {
Tcl_FSLinkProc *proc = fsPtr->linkProc;
+
if (proc != NULL) {
return (*proc)(pathPtr, toPtr, linkAction);
}
@@ -3527,10 +3548,10 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
/*
* If S_IFLNK isn't defined it means that the machine doesn't support
- * symbolic links, so the file can't possibly be a symbolic link.
- * Generate an EINVAL error, which is what happens on machines that do
- * support symbolic links when you invoke readlink on a file that isn't a
- * symbolic link.
+ * symbolic links, so the file can't possibly be a symbolic link. Generate
+ * an EINVAL error, which is what happens on machines that do support
+ * symbolic links when you invoke readlink on a file that isn't a symbolic
+ * link.
*/
#ifndef S_IFLNK
@@ -3546,15 +3567,15 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
*
* Tcl_FSListVolumes --
*
- * Lists the currently mounted volumes. The chain of functions that have
+ * Lists the currently mounted volumes. The chain of functions that have
* been "inserted" into the filesystem will be called in succession; each
* may return a list of volumes, all of which are added to the result
* until all mounted file systems are listed.
*
* Notice that we assume the lists returned by each filesystem (if non
- * NULL) have been given a refCount for us already. However, we are NOT
+ * NULL) have been given a refCount for us already. However, we are NOT
* allowed to hang on to the list itself (it belongs to the filesystem we
- * called). Therefore we quite naturally add its contents to the result
+ * called). Therefore we quite naturally add its contents to the result
* we are building, and then decrement the refCount.
*
* Results:
@@ -3573,8 +3594,8 @@ Tcl_FSListVolumes(void)
Tcl_Obj *resultPtr = Tcl_NewObj();
/*
- * Call each of the "listVolumes" function in succession. A non-NULL
- * return value indicates the particular function has succeeded. We call
+ * Call each of the "listVolumes" function in succession. A non-NULL
+ * return value indicates the particular function has succeeded. We call
* all the functions registered, since we want a list of all drives from
* all filesystems.
*/
@@ -3613,10 +3634,10 @@ Tcl_FSListVolumes(void)
*---------------------------------------------------------------------------
*/
-static Tcl_Obj*
-FsListMounts(pathPtr, pattern)
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
- CONST char *pattern; /* Pattern to match against. */
+static Tcl_Obj *
+FsListMounts(
+ Tcl_Obj *pathPtr, /* Contains path to directory to search. */
+ CONST char *pattern) /* Pattern to match against. */
{
FilesystemRecord *fsRecPtr;
Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
@@ -3624,8 +3645,8 @@ FsListMounts(pathPtr, pattern)
/*
* Call each of the "matchInDirectory" functions in succession, with the
- * specific type information 'mountsOnly'. A non-NULL return value
- * indicates the particular function has succeeded. We call all the
+ * specific type information 'mountsOnly'. A non-NULL return value
+ * indicates the particular function has succeeded. We call all the
* functions registered, since we want a list from each filesystems.
*/
@@ -3657,7 +3678,7 @@ FsListMounts(pathPtr, pattern)
* an element.
*
* Results:
- * Returns list object with refCount of zero. If the passed in lenPtr is
+ * Returns list object with refCount of zero. If the passed in lenPtr is
* non-NULL, we use it to return the number of elements in the returned
* list.
*
@@ -3667,10 +3688,10 @@ FsListMounts(pathPtr, pattern)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSSplitPath(pathPtr, lenPtr)
- Tcl_Obj *pathPtr; /* Path to split. */
- int *lenPtr; /* int to store number of path elements. */
+Tcl_Obj *
+Tcl_FSSplitPath(
+ Tcl_Obj *pathPtr, /* Path to split. */
+ int *lenPtr) /* int to store number of path elements. */
{
Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */
Tcl_Filesystem *fsPtr;
@@ -3705,7 +3726,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
}
/*
- * Place the drive name as first element of the result list. The drive
+ * Place the drive name as first element of the result list. The drive
* name may contain strange characters, like colons and multiple forward
* slashes (for example 'ftp://' is a valid vfs drive name)
*/
@@ -3753,11 +3774,11 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
}
/* Simple helper function */
-Tcl_Obj*
-TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
- Tcl_Filesystem *fromFilesystem;
- ClientData clientData;
- FilesystemRecord **fsRecPtrPtr;
+Tcl_Obj *
+TclFSInternalToNormalized(
+ Tcl_Filesystem *fromFilesystem,
+ ClientData clientData,
+ FilesystemRecord **fsRecPtrPtr)
{
FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
@@ -3786,7 +3807,7 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
*
* Results:
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
+ * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
* only if it is non-NULL and the function's return value is
* TCL_PATH_ABSOLUTE.
*
@@ -3797,19 +3818,20 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
*/
Tcl_PathType
-TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
- Tcl_Obj *pathPtr; /* Path to determine type for */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
- * NULL, then set to the filesystem
- * which claims this path. */
- int *driveNameLengthPtr; /* If the path is absolute, and this
- * is non-NULL, then set to the length
- * of the driveName. */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and this
- * is non-NULL, then set to the name
- * of the drive, network-volume which
- * contains the path, already with a
- * refCount for the caller. */
+TclGetPathType(
+ Tcl_Obj *pathPtr, /* Path to determine type for */
+ Tcl_Filesystem **filesystemPtrPtr,
+ /* If absolute path and this is not NULL, then
+ * set to the filesystem which claims this
+ * path. */
+ int *driveNameLengthPtr, /* If the path is absolute, and this is
+ * non-NULL, then set to the length of the
+ * driveName. */
+ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is
+ * non-NULL, then set to the name of the
+ * drive, network-volume which contains the
+ * path, already with a refCount for the
+ * caller. */
{
int pathLen;
char *path;
@@ -3835,14 +3857,14 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*
* TclFSNonnativePathType --
*
- * Helper function used by TclGetPathType. Its purpose is to check
+ * Helper function used by TclGetPathType. Its purpose is to check
* whether the given path starts with a string which corresponds to a
- * file volume in any registered filesystem except the native one. For
+ * file volume in any registered filesystem except the native one. For
* speed and historical reasons the native filesystem has special
* hard-coded checks dotted here and there in the filesystem code.
*
* Results:
- * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
+ * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
* reference will be set if and only if it is non-NULL and the function's
* return value is TCL_PATH_ABSOLUTE.
*
@@ -3853,21 +3875,21 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*/
Tcl_PathType
-TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
- driveNameRef)
- CONST char *path; /* Path to determine type for */
- int pathLen; /* Length of the path */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
- * NULL, then set to the filesystem
- * which claims this path. */
- int *driveNameLengthPtr; /* If the path is absolute, and this
- * is non-NULL, then set to the length
- * of the driveName. */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and this
- * is non-NULL, then set to the name
- * of the drive, network-volume which
- * contains the path, already with a
- * refCount for the caller. */
+TclFSNonnativePathType(
+ CONST char *path, /* Path to determine type for */
+ int pathLen, /* Length of the path */
+ Tcl_Filesystem **filesystemPtrPtr,
+ /* If absolute path and this is not NULL, then
+ * set to the filesystem which claims this
+ * path. */
+ int *driveNameLengthPtr, /* If the path is absolute, and this is
+ * non-NULL, then set to the length of the
+ * driveName. */
+ Tcl_Obj **driveNameRef) /* If the path is absolute, and this is
+ * non-NULL, then set to the name of the
+ * drive, network-volume which contains the
+ * path, already with a refCount for the
+ * caller. */
{
FilesystemRecord *fsRecPtr;
Tcl_PathType type = TCL_PATH_RELATIVE;
@@ -3888,7 +3910,7 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
* is because some of the tests artificially change the current
* platform (between win, unix) but the list of volumes we get by
* calling (*proc) will reflect the current (real) platform only and
- * this may cause some tests to fail. In particular, on unix '/' will
+ * this may cause some tests to fail. In particular, on unix '/' will
* match the beginning of certain absolute Windows paths starting '//'
* and those tests will go wrong.
*
@@ -3904,12 +3926,13 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
int numVolumes;
Tcl_Obj *thisFsVolumes = (*proc)();
+
if (thisFsVolumes != NULL) {
- if (Tcl_ListObjLength(NULL, thisFsVolumes,
- &numVolumes) != TCL_OK) {
+ if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
+ != TCL_OK) {
/*
* This is VERY bad; the Tcl_FSListVolumesProc didn't
- * return a valid list. Set numVolumes to -1 so that we
+ * return a valid list. Set numVolumes to -1 so that we
* skip the while loop below and just return with the
* current value of 'type'.
*
@@ -3947,7 +3970,9 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
}
Tcl_DecrRefCount(thisFsVolumes);
if (type == TCL_PATH_ABSOLUTE) {
- /* We don't need to examine any more filesystems */
+ /*
+ * We don't need to examine any more filesystems.
+ */
break;
}
}
@@ -3963,7 +3988,7 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
* Tcl_FSRenameFile --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystems rename function. Otherwise we simply return the posix
+ * filesystems rename function. Otherwise we simply return the POSIX
* error 'EXDEV', and -1.
*
* Results:
@@ -3976,10 +4001,10 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
*/
int
-Tcl_FSRenameFile(srcPathPtr, destPathPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of file or dir to be renamed
+Tcl_FSRenameFile(
+ Tcl_Obj* srcPathPtr, /* Pathname of file or dir to be renamed
* (UTF-8). */
- Tcl_Obj *destPathPtr; /* New pathname of file or directory
+ Tcl_Obj *destPathPtr) /* New pathname of file or directory
* (UTF-8). */
{
int retVal = -1;
@@ -3987,10 +4012,10 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
- if (fsPtr == fsPtr2 && fsPtr != NULL) {
+ if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
if (proc != NULL) {
- retVal = (*proc)(srcPathPtr, destPathPtr);
+ retVal = (*proc)(srcPathPtr, destPathPtr);
}
}
if (retVal == -1) {
@@ -4005,8 +4030,8 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
* Tcl_FSCopyFile --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystem's copy function. Otherwise we simply return the posix
- * error 'EXDEV', and -1.
+ * filesystem's copy function. Otherwise we simply return the POSIX error
+ * 'EXDEV', and -1.
*
* Note that in the native filesystems, 'copyFileProc' is defined to copy
* soft links (i.e. it copies the links themselves, not the things they
@@ -4022,9 +4047,9 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
*/
int
-Tcl_FSCopyFile(srcPathPtr, destPathPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of file to be copied (UTF-8). */
- Tcl_Obj *destPathPtr; /* Pathname of file to copy to (UTF-8). */
+Tcl_FSCopyFile(
+ Tcl_Obj *srcPathPtr, /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *destPathPtr) /* Pathname of file to copy to (UTF-8). */
{
int retVal = -1;
Tcl_Filesystem *fsPtr, *fsPtr2;
@@ -4049,7 +4074,7 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
* TclCrossFilesystemCopy --
*
* Helper for above function, and for Tcl_FSLoadFile, to copy files from
- * one filesystem to another. This function will overwrite the target
+ * one filesystem to another. This function will overwrite the target
* file if it already exists.
*
* Results:
@@ -4061,64 +4086,62 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
*---------------------------------------------------------------------------
*/
int
-TclCrossFilesystemCopy(interp, source, target)
- Tcl_Interp *interp; /* For error messages */
- Tcl_Obj *source; /* Pathname of file to be copied (UTF-8). */
- Tcl_Obj *target; /* Pathname of file to copy to (UTF-8). */
+TclCrossFilesystemCopy(
+ Tcl_Interp *interp, /* For error messages */
+ Tcl_Obj *source, /* Pathname of file to be copied (UTF-8). */
+ Tcl_Obj *target) /* Pathname of file to copy to (UTF-8). */
{
int result = TCL_ERROR;
int prot = 0666;
+ Tcl_Channel in, out;
+ Tcl_StatBuf sourceStatBuf;
+ struct utimbuf tval;
- Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
- if (out != NULL) {
+ out = Tcl_FSOpenFileChannel(interp, target, "wb", prot);
+ if (out == NULL) {
/*
- * It looks like we can copy it over.
+ * It looks like we cannot copy it over. Bail out...
*/
+ goto done;
+ }
- Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, "r", prot);
-
- if (in == NULL) {
- /*
- * This is very strange, we checked this above
- */
-
- Tcl_Close(interp, out);
-
- } else {
- Tcl_StatBuf sourceStatBuf;
- struct utimbuf tval;
+ in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
+ if (in == NULL) {
+ /*
+ * This is very strange, caller should have checked this...
+ */
- /*
- * Copy it synchronously. We might wish to add an asynchronous
- * option to support vfs's which are slow (e.g. network sockets).
- */
+ Tcl_Close(interp, out);
+ goto done;
+ }
- Tcl_SetChannelOption(interp, in, "-translation", "binary");
- Tcl_SetChannelOption(interp, out, "-translation", "binary");
+ /*
+ * Copy it synchronously. We might wish to add an asynchronous option to
+ * support vfs's which are slow (e.g. network sockets).
+ */
- if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
- result = TCL_OK;
- }
+ if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
+ result = TCL_OK;
+ }
- /*
- * If the copy failed, assume that copy channel left a good error
- * message.
- */
+ /*
+ * If the copy failed, assume that copy channel left a good error message.
+ */
- Tcl_Close(interp, in);
- Tcl_Close(interp, out);
+ Tcl_Close(interp, in);
+ Tcl_Close(interp, out);
- /*
- * Set modification date of copied file.
- */
+ /*
+ * Set modification date of copied file.
+ */
- if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
- tval.actime = sourceStatBuf.st_atime;
- tval.modtime = sourceStatBuf.st_mtime;
- Tcl_FSUtime(target, &tval);
- }
- }
+ if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
+ tval.actime = sourceStatBuf.st_atime;
+ tval.modtime = sourceStatBuf.st_mtime;
+ Tcl_FSUtime(target, &tval);
}
+
+ done:
return result;
}
@@ -4140,8 +4163,8 @@ TclCrossFilesystemCopy(interp, source, target)
*/
int
-Tcl_FSDeleteFile(pathPtr)
- Tcl_Obj *pathPtr; /* Pathname of file to be removed (UTF-8). */
+Tcl_FSDeleteFile(
+ Tcl_Obj *pathPtr) /* Pathname of file to be removed (UTF-8). */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -4172,8 +4195,8 @@ Tcl_FSDeleteFile(pathPtr)
*/
int
-Tcl_FSCreateDirectory(pathPtr)
- Tcl_Obj *pathPtr; /* Pathname of directory to create (UTF-8). */
+Tcl_FSCreateDirectory(
+ Tcl_Obj *pathPtr) /* Pathname of directory to create (UTF-8). */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -4192,8 +4215,8 @@ Tcl_FSCreateDirectory(pathPtr)
* Tcl_FSCopyDirectory --
*
* If the two paths given belong to the same filesystem, we call that
- * filesystems copy-directory function. Otherwise we simply return the
- * posix error 'EXDEV', and -1.
+ * filesystems copy-directory function. Otherwise we simply return the
+ * POSIX error 'EXDEV', and -1.
*
* Results:
* Standard Tcl error code if a function was called.
@@ -4205,11 +4228,11 @@ Tcl_FSCreateDirectory(pathPtr)
*/
int
-Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
- Tcl_Obj* srcPathPtr; /* Pathname of directory to be copied
+Tcl_FSCopyDirectory(
+ Tcl_Obj* srcPathPtr, /* Pathname of directory to be copied
* (UTF-8). */
- Tcl_Obj *destPathPtr; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ Tcl_Obj *destPathPtr, /* Pathname of target directory (UTF-8). */
+ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new
* object containing name of file causing
* error, with refCount 1. */
{
@@ -4248,13 +4271,13 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
*/
int
-Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
- Tcl_Obj *pathPtr; /* Pathname of directory to be removed
+Tcl_FSRemoveDirectory(
+ Tcl_Obj *pathPtr, /* Pathname of directory to be removed
* (UTF-8). */
- int recursive; /* If non-zero, removes directories that are
- * nonempty. Otherwise, will only remove
- * empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ int recursive, /* If non-zero, removes directories that are
+ * nonempty. Otherwise, will only remove empty
+ * directories. */
+ Tcl_Obj **errorPtr) /* If non-NULL, then will be set to a new
* object containing name of file causing
* error, with refCount 1. */
{
@@ -4306,7 +4329,7 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
* Tcl_FSGetFileSystemForPath --
*
* This function determines which filesystem to use for a particular path
- * object, and returns the filesystem which accepts this file. If no
+ * object, and returns the filesystem which accepts this file. If no
* filesystem will accept this object as a valid file path, then NULL is
* returned.
*
@@ -4319,9 +4342,9 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Filesystem*
-Tcl_FSGetFileSystemForPath(pathPtr)
- Tcl_Obj* pathPtr;
+Tcl_Filesystem *
+Tcl_FSGetFileSystemForPath(
+ Tcl_Obj* pathPtr)
{
FilesystemRecord *fsRecPtr;
Tcl_Filesystem* retVal = NULL;
@@ -4332,7 +4355,7 @@ Tcl_FSGetFileSystemForPath(pathPtr)
}
/*
- * If the object has a refCount of zero, we reject it. This is to avoid
+ * If the object has a refCount of zero, we reject it. This is to avoid
* possible segfaults or nondeterministic memory leaks (i.e. the user
* doesn't know if they should decrement the ref count on return or not).
*/
@@ -4344,7 +4367,7 @@ Tcl_FSGetFileSystemForPath(pathPtr)
/*
* Check if the filesystem has changed in some way since this object's
- * internal representation was calculated. Before doing that, assure we
+ * internal representation was calculated. Before doing that, assure we
* have the most up-to-date copy of the master filesystem. This is
* accomplished by the FsGetFirstFilesystem() call.
*/
@@ -4356,7 +4379,7 @@ Tcl_FSGetFileSystemForPath(pathPtr)
}
/*
- * Call each of the "pathInFilesystem" functions in succession. A
+ * Call each of the "pathInFilesystem" functions in succession. A
* non-return value of -1 indicates the particular function has succeeded.
*/
@@ -4366,8 +4389,7 @@ Tcl_FSGetFileSystemForPath(pathPtr)
if (proc != NULL) {
ClientData clientData = NULL;
- int ret = (*proc)(pathPtr, &clientData);
- if (ret != -1) {
+ if ((*proc)(pathPtr, &clientData) != -1) {
/*
* We assume the type of pathPtr hasn't been changed by the
* above call to the pathInFilesystemProc.
@@ -4390,17 +4412,17 @@ Tcl_FSGetFileSystemForPath(pathPtr)
*
* This function is for use by the Win/Unix native filesystems, so that
* they can easily retrieve the native (char* or TCHAR*) representation
- * of a path. Other filesystems will probably want to implement similar
- * functions. They basically act as a safety net around
- * Tcl_FSGetInternalRep. Normally your file- system procedures will
- * always be called with path objects already converted to the correct
+ * of a path. Other filesystems will probably want to implement similar
+ * functions. They basically act as a safety net around
+ * Tcl_FSGetInternalRep. Normally your file-system functions will always
+ * be called with path objects already converted to the correct
* filesystem, but if for some reason they are called directly (i.e. by
- * procedures not in this file), then one cannot necessarily guarantee
+ * functions not in this file), then one cannot necessarily guarantee
* that the path object pointer is from the correct filesystem.
*
* Note: in the future it might be desireable to have separate versions
* of this function with different signatures, for example
- * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
+ * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
* native paths are all string based, we use just one function.
*
* Results:
@@ -4413,8 +4435,8 @@ Tcl_FSGetFileSystemForPath(pathPtr)
*/
CONST char *
-Tcl_FSGetNativePath(pathPtr)
- Tcl_Obj *pathPtr;
+Tcl_FSGetNativePath(
+ Tcl_Obj *pathPtr)
{
return (CONST char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}
@@ -4436,8 +4458,8 @@ Tcl_FSGetNativePath(pathPtr)
*/
static void
-NativeFreeInternalRep(clientData)
- ClientData clientData;
+NativeFreeInternalRep(
+ ClientData clientData)
{
ckfree((char *) clientData);
}
@@ -4447,9 +4469,9 @@ NativeFreeInternalRep(clientData)
*
* Tcl_FSFileSystemInfo --
*
- * This function returns a list of two elements. The first element is
- * the name of the filesystem (e.g. "native" or "vfs"), and the second is
- * the particular type of the given path within that filesystem.
+ * This function returns a list of two elements. The first element is the
+ * name of the filesystem (e.g. "native" or "vfs"), and the second is the
+ * particular type of the given path within that filesystem.
*
* Results:
* A list of two elements.
@@ -4460,9 +4482,9 @@ NativeFreeInternalRep(clientData)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSFileSystemInfo(pathPtr)
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSFileSystemInfo(
+ Tcl_Obj *pathPtr)
{
Tcl_Obj *resPtr;
Tcl_FSFilesystemPathTypeProc *proc;
@@ -4472,10 +4494,8 @@ Tcl_FSFileSystemInfo(pathPtr)
return NULL;
}
- resPtr = Tcl_NewListObj(0,NULL);
-
- Tcl_ListObjAppendElement(NULL, resPtr,
- Tcl_NewStringObj(fsPtr->typeName,-1));
+ resPtr = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));
proc = fsPtr->filesystemPathTypeProc;
if (proc != NULL) {
@@ -4493,7 +4513,7 @@ Tcl_FSFileSystemInfo(pathPtr)
*
* Tcl_FSPathSeparator --
*
- * This function returns the separator to be used for a given path. The
+ * This function returns the separator to be used for a given path. The
* object returned should have a refCount of zero
*
* Results:
@@ -4507,9 +4527,9 @@ Tcl_FSFileSystemInfo(pathPtr)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
-Tcl_FSPathSeparator(pathPtr)
- Tcl_Obj* pathPtr;
+Tcl_Obj *
+Tcl_FSPathSeparator(
+ Tcl_Obj *pathPtr)
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
@@ -4545,9 +4565,9 @@ Tcl_FSPathSeparator(pathPtr)
*---------------------------------------------------------------------------
*/
-static Tcl_Obj*
-NativeFilesystemSeparator(pathPtr)
- Tcl_Obj* pathPtr;
+static Tcl_Obj *
+NativeFilesystemSeparator(
+ Tcl_Obj *pathPtr)
{
char *separator = NULL; /* lint */
switch (tclPlatform) {
@@ -4569,10 +4589,10 @@ NativeFilesystemSeparator(pathPtr)
*
* TclStatInsertProc --
*
- * Insert the passed procedure pointer at the head of the list of
+ * Insert the passed function pointer at the head of the list of
* functions which are used during a call to 'TclStat(...)'. The passed
* function should behave exactly like 'TclStat' when called during that
- * time (see 'TclStat(...)' for more information). The function will be
+ * time (see 'TclStat(...)' for more information). The function will be
* added even if it already in the list.
*
* Results:
@@ -4586,8 +4606,8 @@ NativeFilesystemSeparator(pathPtr)
*/
int
-TclStatInsertProc (proc)
- TclStatProc_ *proc;
+TclStatInsertProc(
+ TclStatProc_ *proc)
{
int retVal = TCL_ERROR;
@@ -4616,10 +4636,10 @@ TclStatInsertProc (proc)
* TclStatDeleteProc --
*
* Removed the passed function pointer from the list of 'TclStat'
- * functions. Ensures that the built-in stat function is not removvable.
+ * functions. Ensures that the built-in stat function is not removable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * TCL_OK if the function pointer was successfully removed, TCL_ERROR
* otherwise.
*
* Side effects:
@@ -4629,8 +4649,8 @@ TclStatInsertProc (proc)
*/
int
-TclStatDeleteProc (proc)
- TclStatProc_ *proc;
+TclStatDeleteProc(
+ TclStatProc_ *proc)
{
int retVal = TCL_ERROR;
StatProc *tmpStatProcPtr;
@@ -4641,7 +4661,7 @@ TclStatDeleteProc (proc)
/*
* Traverse the 'statProcList' looking for the particular node whose
- * 'proc' member matches 'proc' and remove that one from the list. Ensure
+ * 'proc' member matches 'proc' and remove that one from the list. Ensure
* that the "default" node cannot be removed.
*/
@@ -4672,11 +4692,11 @@ TclStatDeleteProc (proc)
*
* TclAccessInsertProc --
*
- * Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to 'TclAccess(...)'. The
- * passed function should behave exactly like 'TclAccess' when called
- * during that time (see 'TclAccess(...)' for more information). The
- * function will be added even if it already in the list.
+ * Insert the passed function pointer at the head of the list of
+ * functions which are used during a call to 'TclAccess(...)'. The passed
+ * function should behave exactly like 'TclAccess' when called during
+ * that time (see 'TclAccess(...)' for more information). The function
+ * will be added even if it already in the list.
*
* Results:
* Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
@@ -4689,8 +4709,8 @@ TclStatDeleteProc (proc)
*/
int
-TclAccessInsertProc(proc)
- TclAccessProc_ *proc;
+TclAccessInsertProc(
+ TclAccessProc_ *proc)
{
int retVal = TCL_ERROR;
@@ -4719,11 +4739,10 @@ TclAccessInsertProc(proc)
* TclAccessDeleteProc --
*
* Removed the passed function pointer from the list of 'TclAccess'
- * functions. Ensures that the built-in access function is not
- * removvable.
+ * functions. Ensures that the built-in access function is not removable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * TCL_OK if the function pointer was successfully removed, TCL_ERROR
* otherwise.
*
* Side effects:
@@ -4733,8 +4752,8 @@ TclAccessInsertProc(proc)
*/
int
-TclAccessDeleteProc(proc)
- TclAccessProc_ *proc;
+TclAccessDeleteProc(
+ TclAccessProc_ *proc)
{
int retVal = TCL_ERROR;
AccessProc *tmpAccessProcPtr;
@@ -4742,7 +4761,7 @@ TclAccessDeleteProc(proc)
/*
* Traverse the 'accessProcList' looking for the particular node whose
- * 'proc' member matches 'proc' and remove that one from the list. Ensure
+ * 'proc' member matches 'proc' and remove that one from the list. Ensure
* that the "default" node cannot be removed.
*/
@@ -4774,12 +4793,12 @@ TclAccessDeleteProc(proc)
*
* TclOpenFileChannelInsertProc --
*
- * Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to
- * 'Tcl_OpenFileChannel(...)'. The passed function should behave exactly
- * like 'Tcl_OpenFileChannel' when called during that time (see
- * 'Tcl_OpenFileChannel(...)' for more information). The function will be
- * added even if it already in the list.
+ * Insert the passed function pointer at the head of the list of
+ * functions which are used during a call to 'Tcl_OpenFileChannel(...)'.
+ * The passed function should behave exactly like 'Tcl_OpenFileChannel'
+ * when called during that time (see 'Tcl_OpenFileChannel(...)' for more
+ * information). The function will be added even if it already in the
+ * list.
*
* Results:
* Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
@@ -4793,8 +4812,8 @@ TclAccessDeleteProc(proc)
*/
int
-TclOpenFileChannelInsertProc(proc)
- TclOpenFileChannelProc_ *proc;
+TclOpenFileChannelInsertProc(
+ TclOpenFileChannelProc_ *proc)
{
int retVal = TCL_ERROR;
@@ -4822,11 +4841,11 @@ TclOpenFileChannelInsertProc(proc)
* TclOpenFileChannelDeleteProc --
*
* Removed the passed function pointer from the list of
- * 'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
+ * 'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
* channel function is not removable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * TCL_OK if the function pointer was successfully removed, TCL_ERROR
* otherwise.
*
* Side effects:
@@ -4836,8 +4855,8 @@ TclOpenFileChannelInsertProc(proc)
*/
int
-TclOpenFileChannelDeleteProc(proc)
- TclOpenFileChannelProc_ *proc;
+TclOpenFileChannelDeleteProc(
+ TclOpenFileChannelProc_ *proc)
{
int retVal = TCL_ERROR;
OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 794f1c9..0b5401d 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIndexObj.c,v 1.26 2005/07/21 16:58:09 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.27 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -19,12 +19,10 @@
* Prototypes for functions defined later in this file:
*/
-static int SetIndexFromAny _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *objPtr));
-static void UpdateStringOfIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
-static void DupIndex _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *dupPtr));
-static void FreeIndex _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfIndex(Tcl_Obj *objPtr);
+static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
+static void FreeIndex(Tcl_Obj *objPtr);
/*
* The structure below defines the index Tcl object type by means of functions
@@ -48,7 +46,7 @@ static Tcl_ObjType indexType = {
*/
typedef struct {
- VOID *tablePtr; /* Pointer to the table of strings */
+ void *tablePtr; /* Pointer to the table of strings */
int offset; /* Offset between table entries */
int index; /* Selected index into table. */
} IndexRep;
@@ -56,6 +54,7 @@ typedef struct {
/*
* The following macros greatly simplify moving through a table...
*/
+
#define STRING_AT(table, offset, index) \
(*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
#define NEXT_ENTRY(table, offset) \
@@ -89,16 +88,16 @@ typedef struct {
*/
int
-Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* Object containing the string to lookup. */
- CONST char **tablePtr; /* Array of strings to compare against the
+Tcl_GetIndexFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object containing the string to lookup. */
+ CONST char **tablePtr, /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
- CONST char *msg; /* Identifying word to use in error
+ CONST char *msg, /* Identifying word to use in error
* messages. */
- int flags; /* 0 or TCL_EXACT */
- int *indexPtr; /* Place to store resulting integer index. */
+ int flags, /* 0 or TCL_EXACT */
+ int *indexPtr) /* Place to store resulting integer index. */
{
/*
@@ -115,8 +114,8 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
* on odd platforms like a Cray PVP...
*/
- if (indexRep->tablePtr == (VOID *)tablePtr &&
- indexRep->offset == sizeof(char *)) {
+ if (indexRep->tablePtr == (void *) tablePtr
+ && indexRep->offset == sizeof(char *)) {
*indexPtr = indexRep->index;
return TCL_OK;
}
@@ -152,20 +151,19 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
*/
int
-Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
- indexPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *objPtr; /* Object containing the string to lookup. */
- CONST VOID *tablePtr; /* The first string in the table. The second
+Tcl_GetIndexFromObjStruct(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object containing the string to lookup. */
+ CONST VOID *tablePtr, /* The first string in the table. The second
* string will be at this address plus the
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
- int offset; /* The number of bytes between entries */
- CONST char *msg; /* Identifying word to use in error
+ int offset, /* The number of bytes between entries */
+ CONST char *msg, /* Identifying word to use in error
* messages. */
- int flags; /* 0 or TCL_EXACT */
- int *indexPtr; /* Place to store resulting integer index. */
+ int flags, /* 0 or TCL_EXACT */
+ int *indexPtr) /* Place to store resulting integer index. */
{
int index, length, i, numAbbrev;
char *key, *p1;
@@ -252,10 +250,10 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
} else {
TclFreeIntRep(objPtr);
indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
+ objPtr->internalRep.otherValuePtr = (void *) indexRep;
objPtr->typePtr = &indexType;
}
- indexRep->tablePtr = (VOID*) tablePtr;
+ indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
@@ -274,17 +272,15 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
Tcl_SetObjResult(interp, resultPtr);
Tcl_AppendStringsToObj(resultPtr,
(numAbbrev > 1) ? "ambiguous " : "bad ", msg, " \"", key,
- "\": must be ", STRING_AT(tablePtr,offset,0), (char*) NULL);
+ "\": must be ", STRING_AT(tablePtr, offset, 0), NULL);
for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
*entryPtr != NULL;
entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
- Tcl_AppendStringsToObj(resultPtr,
- (count > 0) ? ", or " : " or ", *entryPtr,
- (char *) NULL);
+ Tcl_AppendStringsToObj(resultPtr, ((count > 0) ? "," : ""),
+ " or ", *entryPtr, NULL);
} else {
- Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
- (char *) NULL);
+ Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
}
}
}
@@ -312,9 +308,9 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags,
*/
static int
-SetIndexFromAny(interp, objPtr)
- Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr; /* The object to convert. */
+SetIndexFromAny(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr) /* The object to convert. */
{
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can't convert value to index except via Tcl_GetIndexFromObj API",
@@ -340,8 +336,8 @@ SetIndexFromAny(interp, objPtr)
*/
static void
-UpdateStringOfIndex(objPtr)
- Tcl_Obj *objPtr;
+UpdateStringOfIndex(
+ Tcl_Obj *objPtr)
{
IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
register char *buf;
@@ -374,14 +370,15 @@ UpdateStringOfIndex(objPtr)
*/
static void
-DupIndex(srcPtr, dupPtr)
- Tcl_Obj *srcPtr, *dupPtr;
+DupIndex(
+ Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr)
{
IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
+ dupPtr->internalRep.otherValuePtr = (void *) dupIndexRep;
dupPtr->typePtr = &indexType;
}
@@ -403,8 +400,8 @@ DupIndex(srcPtr, dupPtr)
*/
static void
-FreeIndex(objPtr)
- Tcl_Obj *objPtr;
+FreeIndex(
+ Tcl_Obj *objPtr)
{
ckfree((char *) objPtr->internalRep.otherValuePtr);
}
@@ -449,12 +446,12 @@ FreeIndex(objPtr)
*/
void
-Tcl_WrongNumArgs(interp, objc, objv, message)
- Tcl_Interp *interp; /* Current interpreter. */
- int objc; /* Number of arguments to print from objv. */
- Tcl_Obj *CONST objv[]; /* Initial argument objects, which should be
+Tcl_WrongNumArgs(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments to print from objv. */
+ Tcl_Obj *CONST objv[], /* Initial argument objects, which should be
* included in the error message. */
- CONST char *message; /* Error message to print after the leading
+ CONST char *message) /* Error message to print after the leading
* objects in objv. The message may be
* NULL. */
{
@@ -554,7 +551,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (i<toPrint-1 || objc!=0 || message!=NULL) {
- Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, " ", NULL);
}
}
}
@@ -574,7 +571,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
if (objv[i]->typePtr == &indexType) {
indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
- Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
@@ -603,7 +600,7 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (i<objc-1 || message!=NULL) {
- Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, " ", NULL);
}
}
@@ -614,9 +611,9 @@ Tcl_WrongNumArgs(interp, objc, objv, message)
*/
if (message != NULL) {
- Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, message, NULL);
}
- Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
+ Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetObjResult(interp, objPtr);
#undef MAY_QUOTE_WORD
#undef AFTER_FIRST_WORD
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index e1d108d..a9ee861 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -13,11 +13,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclLiteral.c,v 1.26 2005/10/19 18:39:58 dgp Exp $
+ * RCS: @(#) $Id: tclLiteral.c,v 1.27 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
+
/*
* When there are this many entries per bucket, on average, rebuild a
* literal's hash table to make it larger.
@@ -26,25 +27,21 @@
#define REBUILD_MULTIPLIER 3
/*
- * Procedure prototypes for static procedures in this file:
+ * Function prototypes for static functions in this file:
*/
-static int AddLocalLiteralEntry _ANSI_ARGS_((
- CompileEnv *envPtr, LiteralEntry *globalPtr,
- int localHash));
-static void ExpandLocalLiteralArray _ANSI_ARGS_((
- CompileEnv *envPtr));
-static unsigned int HashString _ANSI_ARGS_((CONST char *bytes,
- int length));
-static void RebuildLiteralTable _ANSI_ARGS_((
- LiteralTable *tablePtr));
+static int AddLocalLiteralEntry(CompileEnv *envPtr,
+ LiteralEntry *globalPtr, int localHash);
+static void ExpandLocalLiteralArray(CompileEnv *envPtr);
+static unsigned int HashString(CONST char *bytes, int length);
+static void RebuildLiteralTable(LiteralTable *tablePtr);
/*
*----------------------------------------------------------------------
*
* TclInitLiteralTable --
*
- * This procedure is called to initialize the fields of a literal table
+ * This function is called to initialize the fields of a literal table
* structure for either an interpreter or a compilation's CompileEnv
* structure.
*
@@ -58,8 +55,8 @@ static void RebuildLiteralTable _ANSI_ARGS_((
*/
void
-TclInitLiteralTable(tablePtr)
- register LiteralTable *tablePtr;
+TclInitLiteralTable(
+ register LiteralTable *tablePtr)
/* Pointer to table structure, which is
* supplied by the caller. */
{
@@ -73,7 +70,7 @@ TclInitLiteralTable(tablePtr)
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
tablePtr->numEntries = 0;
- tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+ tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE * REBUILD_MULTIPLIER;
tablePtr->mask = 3;
}
@@ -82,8 +79,8 @@ TclInitLiteralTable(tablePtr)
*
* TclCleanupLiteralTable --
*
- * This procedure frees the internal representation of every literal in a
- * literal table. It is called prior to deleting an interp, so that
+ * This function frees the internal representation of every literal in a
+ * literal table. It is called prior to deleting an interp, so that
* variable refs will be cleaned up properly.
*
* Results:
@@ -96,10 +93,9 @@ TclInitLiteralTable(tablePtr)
*/
void
-TclCleanupLiteralTable( interp, tablePtr )
- Tcl_Interp* interp; /* Interpreter containing literals to
- * purge. */
- LiteralTable* tablePtr; /* Points to the literal table being
+TclCleanupLiteralTable(
+ Tcl_Interp *interp, /* Interpreter containing literals to purge */
+ LiteralTable *tablePtr) /* Points to the literal table being
* cleaned. */
{
int i;
@@ -113,7 +109,7 @@ TclCleanupLiteralTable( interp, tablePtr )
* the current bucket. */
#ifdef TCL_COMPILE_DEBUG
- TclVerifyGlobalLiteralTable( (Interp*) interp );
+ TclVerifyGlobalLiteralTable((Interp *) interp);
#endif /* TCL_COMPILE_DEBUG */
for (i=0 ; i<tablePtr->numBuckets ; i++) {
@@ -153,7 +149,7 @@ TclCleanupLiteralTable( interp, tablePtr )
*
* TclDeleteLiteralTable --
*
- * This procedure frees up everything associated with a literal table
+ * This function frees up everything associated with a literal table
* except for the table's structure itself. It is called when the
* interpreter is deleted.
*
@@ -169,10 +165,10 @@ TclCleanupLiteralTable( interp, tablePtr )
*/
void
-TclDeleteLiteralTable(interp, tablePtr)
- Tcl_Interp *interp; /* Interpreter containing shared literals
+TclDeleteLiteralTable(
+ Tcl_Interp *interp, /* Interpreter containing shared literals
* referenced by the table to delete. */
- LiteralTable *tablePtr; /* Points to the literal table to delete. */
+ LiteralTable *tablePtr) /* Points to the literal table to delete. */
{
LiteralEntry *entryPtr, *nextPtr;
Tcl_Obj *objPtr;
@@ -191,13 +187,13 @@ TclDeleteLiteralTable(interp, tablePtr)
/*
* We used to call TclReleaseLiteral for each literal in the table, which
* is rather inefficient as it causes one lookup-by-hash for each
- * reference to the literal. We now rely at interp-deletion on each
+ * reference to the literal. We now rely at interp-deletion on each
* bytecode object to release its references to the literal Tcl_Obj
* without requiring that it updates the global table itself, and deal
* here only with the table.
*/
- for (i = 0; i < tablePtr->numBuckets; i++) {
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
entryPtr = tablePtr->buckets[i];
while (entryPtr != NULL) {
objPtr = entryPtr->objPtr;
@@ -235,7 +231,7 @@ TclDeleteLiteralTable(interp, tablePtr)
* global table. We then add a reference to the shared literal in the
* CompileEnv's literal array.
*
- * If LITERAL_ON_HEAP is set in flags, this procedure is given ownership
+ * If LITERAL_ON_HEAP is set in flags, this function is given ownership
* of the string: if an object is created then its string representation
* is set directly from string, otherwise the string is freed. Typically,
* a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
@@ -245,18 +241,18 @@ TclDeleteLiteralTable(interp, tablePtr)
*/
int
-TclRegisterLiteral(envPtr, bytes, length, flags)
- CompileEnv *envPtr; /* Points to the CompileEnv in whose object
+TclRegisterLiteral(
+ CompileEnv *envPtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
- register char *bytes; /* Points to string for which to find or
+ register char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
* array. */
- int length; /* Number of bytes in the string. If < 0, the
+ int length, /* Number of bytes in the string. If < 0, the
* string consists of all bytes up to the
* first null character. */
- int flags; /* If LITERAL_ON_HEAP then the caller already
+ int flags) /* If LITERAL_ON_HEAP then the caller already
* malloc'd bytes and ownership is passed to
- * this procedure. If LITERAL_NS_SCOPE then
+ * this function. If LITERAL_NS_SCOPE then
* the literal shouldnot be shared accross
* namespaces. */
{
@@ -275,13 +271,13 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
hash = HashString(bytes, length);
/*
- * Is the literal already in the CompileEnv's local literal array? If so,
+ * Is the literal already in the CompileEnv's local literal array? If so,
* just return its index.
*/
localHash = (hash & localTablePtr->mask);
- for (localPtr = localTablePtr->buckets[localHash];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
+ for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+ localPtr = localPtr->nextPtr) {
objPtr = localPtr->objPtr;
if ((objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
@@ -316,8 +312,8 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
*/
globalHash = (hash & globalTablePtr->mask);
- for (globalPtr = globalTablePtr->buckets[globalHash];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
+ globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
if ((globalPtr->nsPtr == nsPtr)
&& (objPtr->length == length) && ((length == 0)
@@ -434,10 +430,10 @@ TclRegisterLiteral(envPtr, bytes, length, flags)
*/
LiteralEntry *
-TclLookupLiteralEntry(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+TclLookupLiteralEntry(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a Tcl object holding a literal
+ register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
* that was previously created by a call to
* TclRegisterLiteral. */
{
@@ -449,8 +445,8 @@ TclLookupLiteralEntry(interp, objPtr)
bytes = Tcl_GetStringFromObj(objPtr, &length);
globalHash = (HashString(bytes, length) & globalTablePtr->mask);
- for (entryPtr = globalTablePtr->buckets[globalHash];
- entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
+ for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
return entryPtr;
}
@@ -479,12 +475,12 @@ TclLookupLiteralEntry(interp, objPtr)
*/
void
-TclHideLiteral(interp, envPtr, index)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+TclHideLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register CompileEnv *envPtr;/* Points to CompileEnv whose literal array
+ register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
* contains the entry being hidden. */
- int index; /* The index of the entry in the literal
+ int index) /* The index of the entry in the literal
* array. */
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
@@ -497,9 +493,9 @@ TclHideLiteral(interp, envPtr, index)
/*
* To avoid unwanted sharing we need to copy the object and remove it from
- * the local and global literal tables. It still has a slot in the
- * literal array so it can be referred to by byte codes, but it will not
- * be matched by literal searches.
+ * the local and global literal tables. It still has a slot in the literal
+ * array so it can be referred to by byte codes, but it will not be
+ * matched by literal searches.
*/
newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
@@ -544,11 +540,11 @@ TclHideLiteral(interp, envPtr, index)
*/
int
-TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
- register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array
+TclAddLiteralObj(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
- Tcl_Obj *objPtr; /* The object to insert into the array. */
- LiteralEntry **litPtrPtr; /* The location where the pointer to the new
+ Tcl_Obj *objPtr, /* The object to insert into the array. */
+ LiteralEntry **litPtrPtr) /* The location where the pointer to the new
* literal entry should be stored. May be
* NULL. */
{
@@ -595,12 +591,12 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
*/
static int
-AddLocalLiteralEntry(envPtr, globalPtr, localHash)
- register CompileEnv *envPtr;/* Points to CompileEnv in whose literal array
+AddLocalLiteralEntry(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
- LiteralEntry *globalPtr; /* Points to the global LiteralEntry for the
+ LiteralEntry *globalPtr, /* Points to the global LiteralEntry for the
* literal to add to the CompileEnv. */
- int localHash; /* Hash value for the literal's string. */
+ int localHash) /* Hash value for the literal's string. */
{
register LiteralTable *localTablePtr = &(envPtr->localLitTable);
LiteralEntry *localPtr;
@@ -659,7 +655,7 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
*
* ExpandLocalLiteralArray --
*
- * Procedure that uses malloc to allocate more storage for a CompileEnv's
+ * Function that uses malloc to allocate more storage for a CompileEnv's
* local literal array.
*
* Results:
@@ -675,8 +671,8 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
*/
static void
-ExpandLocalLiteralArray(envPtr)
- register CompileEnv *envPtr;/* Points to the CompileEnv whose object array
+ExpandLocalLiteralArray(
+ register CompileEnv *envPtr)/* Points to the CompileEnv whose object array
* must be enlarged. */
{
/*
@@ -697,7 +693,7 @@ ExpandLocalLiteralArray(envPtr)
* literal table's bucket array.
*/
- memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
+ memcpy((void *) newArrayPtr, (void *) currArrayPtr, currBytes);
for (i=0 ; i<currElems ; i++) {
if (currArrayPtr[i].nextPtr == NULL) {
newArrayPtr[i].nextPtr = NULL;
@@ -731,7 +727,7 @@ ExpandLocalLiteralArray(envPtr)
*
* TclReleaseLiteral --
*
- * This procedure releases a reference to one of the shared Tcl objects
+ * This function releases a reference to one of the shared Tcl objects
* that hold literals. It is called to release the literals referenced by
* a ByteCode that is being destroyed, and it is also called by
* TclDeleteLiteralTable.
@@ -748,10 +744,10 @@ ExpandLocalLiteralArray(envPtr)
*/
void
-TclReleaseLiteral(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created to
+TclReleaseLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a literal object that was
+ register Tcl_Obj *objPtr) /* Points to a literal object that was
* previously created by a call to
* TclRegisterLiteral. */
{
@@ -770,9 +766,8 @@ TclReleaseLiteral(interp, objPtr)
* local literal.
*/
- for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
- entryPtr != NULL;
- prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+ for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
+ entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
entryPtr->refCount--;
@@ -826,9 +821,9 @@ TclReleaseLiteral(interp, objPtr)
*/
static unsigned int
-HashString(bytes, length)
- register CONST char *bytes; /* String for which to compute hash value. */
- int length; /* Number of bytes in the string. */
+HashString(
+ register CONST char *bytes, /* String for which to compute hash value. */
+ int length) /* Number of bytes in the string. */
{
register unsigned int result;
register int i;
@@ -842,7 +837,7 @@ HashString(bytes, length)
*
* 1. Multiplying by 10 is perfect for keys that are decimal strings, and
* multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
* character's bits hang around in the low-order bits of the hash value
* for ever, plus they spread fairly rapidly up to the high-order bits
* to fill out the hash value. This seems works well both for decimal
@@ -861,7 +856,7 @@ HashString(bytes, length)
*
* RebuildLiteralTable --
*
- * This procedure is invoked when the ratio of entries to hash buckets
+ * This function is invoked when the ratio of entries to hash buckets
* becomes too large in a local or global literal table. It allocates a
* larger bucket array and moves the entries into the new buckets.
*
@@ -875,8 +870,8 @@ HashString(bytes, length)
*/
static void
-RebuildLiteralTable(tablePtr)
- register LiteralTable *tablePtr;
+RebuildLiteralTable(
+ register LiteralTable *tablePtr)
/* Local or global table to enlarge. */
{
LiteralEntry **oldBuckets;
@@ -897,9 +892,8 @@ RebuildLiteralTable(tablePtr)
tablePtr->numBuckets *= 4;
tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(LiteralEntry *)));
- for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
- count > 0;
- count--, newChainPtr++) {
+ for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
+ count>0 ; count--, newChainPtr++) {
*newChainPtr = NULL;
}
tablePtr->rebuildSize *= 4;
@@ -950,8 +944,8 @@ RebuildLiteralTable(tablePtr)
*/
char *
-TclLiteralStats(tablePtr)
- LiteralTable *tablePtr; /* Table for which to produce stats. */
+TclLiteralStats(
+ LiteralTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
int count[NUM_COUNTERS], overflow, i, j;
@@ -964,15 +958,15 @@ TclLiteralStats(tablePtr)
* number of entries in the chain.
*/
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
count[i] = 0;
}
overflow = 0;
average = 0.0;
- for (i = 0; i < tablePtr->numBuckets; i++) {
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
j = 0;
- for (entryPtr = tablePtr->buckets[i]; entryPtr != NULL;
- entryPtr = entryPtr->nextPtr) {
+ for (entryPtr=tablePtr->buckets[i] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
j++;
}
if (j < NUM_COUNTERS) {
@@ -992,7 +986,7 @@ TclLiteralStats(tablePtr)
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
sprintf(p, "number of buckets with %d entries: %d\n",
i, count[i]);
p += strlen(p);
@@ -1023,8 +1017,8 @@ TclLiteralStats(tablePtr)
*/
void
-TclVerifyLocalLiteralTable(envPtr)
- CompileEnv *envPtr; /* Points to CompileEnv whose literal table is
+TclVerifyLocalLiteralTable(
+ CompileEnv *envPtr) /* Points to CompileEnv whose literal table is
* to be validated. */
{
register LiteralTable *localTablePtr = &(envPtr->localLitTable);
@@ -1034,9 +1028,9 @@ TclVerifyLocalLiteralTable(envPtr)
int length, count;
count = 0;
- for (i = 0; i < localTablePtr->numBuckets; i++) {
- for (localPtr = localTablePtr->buckets[i];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
count++;
if (localPtr->refCount != -1) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
@@ -1077,8 +1071,8 @@ TclVerifyLocalLiteralTable(envPtr)
*/
void
-TclVerifyGlobalLiteralTable(iPtr)
- Interp *iPtr; /* Points to interpreter whose global literal
+TclVerifyGlobalLiteralTable(
+ Interp *iPtr) /* Points to interpreter whose global literal
* table is to be validated. */
{
register LiteralTable *globalTablePtr = &(iPtr->literalTable);
@@ -1088,9 +1082,9 @@ TclVerifyGlobalLiteralTable(iPtr)
int length, count;
count = 0;
- for (i = 0; i < globalTablePtr->numBuckets; i++) {
- for (globalPtr = globalTablePtr->buckets[i];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+ for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
+ globalPtr=globalPtr->nextPtr) {
count++;
if (globalPtr->refCount < 1) {
bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
diff --git a/generic/tclMain.c b/generic/tclMain.c
index ae7f3b9..7961d0f 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMain.c,v 1.34 2005/10/14 11:14:31 patthoyts Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.35 2005/11/01 15:30:52 dkf Exp $
*/
#include "tclInt.h"
@@ -25,16 +25,15 @@
#define DEFAULT_PRIMARY_PROMPT "% "
/*
- * Declarations for various library procedures and variables (don't want to
+ * Declarations for various library functions and variables (don't want to
* include tclPort.h here, because people might copy this file out of the Tcl
* source directory to make their own modified versions).
*/
-extern CRTIMPORT int isatty _ANSI_ARGS_((int fd));
+extern CRTIMPORT int isatty(int fd);
static Tcl_Obj *tclStartupScriptPath = NULL;
static Tcl_Obj *tclStartupScriptEncoding = NULL;
-
static Tcl_MainLoopProc *mainLoopProc = NULL;
/*
@@ -63,13 +62,11 @@ typedef struct InteractiveState {
} InteractiveState;
/*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
*/
-static void Prompt _ANSI_ARGS_((Tcl_Interp *interp,
- PromptType *promptPtr));
-static void StdinProc _ANSI_ARGS_((ClientData clientData,
- int mask));
+static void Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+static void StdinProc(ClientData clientData, int mask);
/*
*----------------------------------------------------------------------
@@ -88,9 +85,9 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
*/
void
-Tcl_SetStartupScript(path, encoding)
- Tcl_Obj *path; /* Filesystem path of startup script file */
- CONST char *encoding; /* Encoding of the data in that file */
+Tcl_SetStartupScript(
+ Tcl_Obj *path, /* Filesystem path of startup script file */
+ CONST char *encoding) /* Encoding of the data in that file */
{
Tcl_Obj *newEncoding = NULL;
if (encoding != NULL) {
@@ -135,8 +132,8 @@ Tcl_SetStartupScript(path, encoding)
*/
Tcl_Obj *
-Tcl_GetStartupScript(encodingPtr)
- CONST char **encodingPtr; /* When not NULL, points to storage for the
+Tcl_GetStartupScript(
+ CONST char **encodingPtr) /* When not NULL, points to storage for the
* (CONST char *) that points to the
* registered encoding name for the startup
* script */
@@ -163,15 +160,15 @@ Tcl_GetStartupScript(encodingPtr)
* None.
*
* Side effects:
- * This procedure initializes the VFS path of the Tcl script to run at
+ * This function initializes the VFS path of the Tcl script to run at
* startup.
*
*----------------------------------------------------------------------
*/
void
-TclSetStartupScriptPath(path)
- Tcl_Obj *path;
+TclSetStartupScriptPath(
+ Tcl_Obj *path)
{
Tcl_SetStartupScript(path, NULL);
}
@@ -194,7 +191,7 @@ TclSetStartupScriptPath(path)
*/
Tcl_Obj *
-TclGetStartupScriptPath()
+TclGetStartupScriptPath(void)
{
return Tcl_GetStartupScript(NULL);
}
@@ -211,15 +208,15 @@ TclGetStartupScriptPath()
* None.
*
* Side effects:
- * This procedure initializes the file name of the Tcl script to run at
+ * This function initializes the file name of the Tcl script to run at
* startup.
*
*----------------------------------------------------------------------
*/
void
-TclSetStartupScriptFileName(fileName)
- CONST char *fileName;
+TclSetStartupScriptFileName(
+ CONST char *fileName)
{
Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
Tcl_SetStartupScript(path, NULL);
@@ -243,7 +240,7 @@ TclSetStartupScriptFileName(fileName)
*/
CONST char *
-TclGetStartupScriptFileName()
+TclGetStartupScriptFileName(void)
{
Tcl_Obj *path = Tcl_GetStartupScript(NULL);
@@ -257,9 +254,9 @@ TclGetStartupScriptFileName()
*
* Tcl_SourceRCFile --
*
- * This procedure is typically invoked by Tcl_Main of Tk_Main procedure
- * to source an application specific rc file into the interpreter at
- * startup time.
+ * This function is typically invoked by Tcl_Main of Tk_Main function to
+ * source an application specific rc file into the interpreter at startup
+ * time.
*
* Results:
* None.
@@ -271,8 +268,8 @@ TclGetStartupScriptFileName()
*/
void
-Tcl_SourceRCFile(interp)
- Tcl_Interp *interp; /* Interpreter to source rc file into. */
+Tcl_SourceRCFile(
+ Tcl_Interp *interp) /* Interpreter to source rc file into. */
{
Tcl_DString temp;
CONST char *fileName;
@@ -319,11 +316,11 @@ Tcl_SourceRCFile(interp)
* Main program for tclsh and most other Tcl-based applications.
*
* Results:
- * None. This procedure never returns (it exits the process when it's
+ * None. This function never returns (it exits the process when it's
* done).
*
* Side effects:
- * This procedure initializes the Tcl world and then starts interpreting
+ * This function initializes the Tcl world and then starts interpreting
* commands; almost anything could happen, depending on the script being
* interpreted.
*
@@ -331,12 +328,12 @@ Tcl_SourceRCFile(interp)
*/
void
-Tcl_Main(argc, argv, appInitProc)
- int argc; /* Number of arguments. */
- char **argv; /* Array of argument strings. */
- Tcl_AppInitProc *appInitProc;
+Tcl_Main(
+ int argc, /* Number of arguments. */
+ char **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc)
/* Application-specific initialization
- * procedure to call after most initialization
+ * function to call after most initialization
* but before starting to execute commands. */
{
Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
@@ -689,21 +686,21 @@ Tcl_Main(argc, argv, appInitProc)
*
* Tcl_SetMainLoop --
*
- * Sets an alternative main loop procedure.
+ * Sets an alternative main loop function.
*
* Results:
- * Returns the previously defined main loop procedure.
+ * Returns the previously defined main loop function.
*
* Side effects:
- * This procedure will be called before Tcl exits, allowing for the
+ * This function will be called before Tcl exits, allowing for the
* creation of an event loop.
*
*---------------------------------------------------------------
*/
void
-Tcl_SetMainLoop(proc)
- Tcl_MainLoopProc *proc;
+Tcl_SetMainLoop(
+ Tcl_MainLoopProc *proc)
{
mainLoopProc = proc;
}
@@ -713,7 +710,7 @@ Tcl_SetMainLoop(proc)
*
* StdinProc --
*
- * This procedure is invoked by the event dispatcher whenever standard
+ * This function is invoked by the event dispatcher whenever standard
* input becomes readable. It grabs the next line of input characters,
* adds them to a command being assembled, and executes the command if
* it's complete.
@@ -729,9 +726,9 @@ Tcl_SetMainLoop(proc)
/* ARGSUSED */
static void
-StdinProc(clientData, mask)
- ClientData clientData; /* The state of interactive cmd line */
- int mask; /* Not used. */
+StdinProc(
+ ClientData clientData, /* The state of interactive cmd line */
+ int mask) /* Not used. */
{
InteractiveState *isPtr = (InteractiveState *) clientData;
Tcl_Channel chan = isPtr->input;
@@ -838,9 +835,9 @@ StdinProc(clientData, mask)
*/
static void
-Prompt(interp, promptPtr)
- Tcl_Interp *interp; /* Interpreter to use for prompting. */
- PromptType *promptPtr; /* Points to type of prompt to print. Filled
+Prompt(
+ Tcl_Interp *interp, /* Interpreter to use for prompting. */
+ PromptType *promptPtr) /* Points to type of prompt to print. Filled
* with PROMPT_NONE after a prompt is
* printed. */
{