summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog18
-rw-r--r--generic/tclEncoding.c233
-rw-r--r--generic/tclInterp.c6
-rw-r--r--generic/tclUtil.c16
4 files changed, 143 insertions, 130 deletions
diff --git a/ChangeLog b/ChangeLog
index 721e107..f062bba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+2005-04-12 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInterp.c: Corrected bad syntax of Tcl_Panic() call.
+
+ * generic/tclUtil.c (TclGetProcessGlobalValue): More robust handling
+ of bad TclInitProcessGlobalValueProc behavior; an immediate panic
+ rather than a mysterious crash later.
+
+ * generic/tclEncoding.c: Several changes to the way the
+ encodingFileMap cache is maintained. Previously, it was attempted
+ to keep the file map filled and up to date with changes in the
+ encoding search path. This contributed to slow startup times since
+ it required an expensive "glob" operation to fill the cache. Now the
+ validity of items in the cache are checked at the time they are
+ used, so the cache is permitted to fall out of sync with the
+ encoding search path. Only [encoding names] and Tcl_GetEncodingNames()
+ now pay the full expense. [Bug 1177363]
+
2005-04-12 Kevin B. Kenny <kennykb@acm.org>
* compat/strstr.c: Added default definition of NULL to
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 0c23850..13c517b 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.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: tclEncoding.c,v 1.33 2005/04/08 20:04:04 dgp Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.34 2005/04/12 20:28:46 dgp Exp $
*/
#include "tclInt.h"
@@ -150,9 +150,8 @@ static ProcessGlobalValue encodingSearchPath =
* threads. Access to the shared string is governed by a mutex lock.
*/
-static TclInitProcessGlobalValueProc InitializeEncodingFileMap;
static ProcessGlobalValue encodingFileMap =
- {0, 0, NULL, NULL, InitializeEncodingFileMap, NULL, NULL};
+ {0, 0, NULL, NULL, NULL, NULL, NULL};
/*
* A list of directories making up the "library path". Historically
@@ -224,7 +223,8 @@ static Tcl_Encoding LoadTableEncoding _ANSI_ARGS_((CONST char *name,
int type, Tcl_Channel chan));
static Tcl_Encoding LoadEscapeEncoding _ANSI_ARGS_((CONST char *name,
Tcl_Channel chan));
-static Tcl_Obj * MakeFileMap ();
+static Tcl_Channel OpenEncodingFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *name));
static void TableFreeProc _ANSI_ARGS_((ClientData clientData));
static int TableFromUtfProc _ANSI_ARGS_((ClientData clientData,
CONST char *src, int srcLen, int flags,
@@ -388,7 +388,6 @@ TclSetEncodingSearchPath(searchPath)
return TCL_ERROR;
}
TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
- FillEncodingFileMap();
return TCL_OK;
}
@@ -441,7 +440,10 @@ TclSetLibraryPath(path)
/*
*---------------------------------------------------------------------------
*
- * MakeFileMap --
+ * FillEncodingFileMap --
+ *
+ * Called to bring the encoding file map in sync with the current
+ * value of the encoding search path.
*
* Scan the directories on the encoding search path, find the
* *.enc files, and store the found pathnames in a map associated
@@ -462,8 +464,8 @@ TclSetLibraryPath(path)
*---------------------------------------------------------------------------
*/
-static Tcl_Obj *
-MakeFileMap()
+void
+FillEncodingFileMap()
{
int i, numDirs = 0;
Tcl_Obj *map, *searchPath;
@@ -505,33 +507,6 @@ MakeFileMap()
Tcl_DecrRefCount(directory);
}
Tcl_DecrRefCount(searchPath);
- return map;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * FillEncodingFileMap --
- *
- * Called to bring the encoding file map in sync with the current
- * value of the encoding search path.
- *
- * TODO: Check the callers of this routine to see if it's called
- * too frequently.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Entries are added to the encoding file map.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-FillEncodingFileMap()
-{
- Tcl_Obj *map = MakeFileMap();
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
Tcl_DecrRefCount(map);
}
@@ -1395,67 +1370,134 @@ Tcl_FindExecutable(argv0)
/*
*---------------------------------------------------------------------------
*
- * LoadEncodingFile --
+ * OpenEncodingFileChannel --
*
- * Read a file that describes an encoding and create a new Encoding
- * from the data.
+ * Open the file believed to hold data for the encoding, "name".
*
* Results:
- * The return value is the newly loaded Encoding, or NULL if
- * the file didn't exist of was in the incorrect format. If NULL was
+ * Returns the readable Tcl_Channel from opening the file, or NULL
+ * if the file could not be successfully opened. If NULL was
* returned, an error message is left in interp's result object,
* unless interp was NULL.
*
* Side effects:
- * File read from disk.
+ * Channel may be opened. Information about the filesystem may be
+ * cached to speed later calls.
*
*---------------------------------------------------------------------------
*/
-static Tcl_Encoding
-LoadEncodingFile(interp, name)
+static Tcl_Channel
+OpenEncodingFileChannel(interp, name)
Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
CONST char *name; /* The name of the encoding file on disk
* and also the name for new encoding. */
{
- Tcl_Channel chan;
- Tcl_Encoding encoding;
- Tcl_Obj *map, *path, *directory = NULL;
Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
- int ch, scanned = 0;
+ Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
+ Tcl_Obj *searchPath = Tcl_DuplicateObj(TclGetEncodingSearchPath());
+ Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
+ Tcl_Obj **dir, *path, *directory = NULL;
+ Tcl_Channel chan = NULL;
+ int i, numDirs;
+
+ Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir);
+ Tcl_IncrRefCount(nameObj);
+ Tcl_AppendToObj(fileNameObj, ".enc", -1);
+ Tcl_IncrRefCount(fileNameObj);
+ Tcl_DictObjGet(NULL, map, nameObj, &directory);
+ /* Check that any cached directory is still on the encoding search path */
+ if (NULL != directory) {
+ int verified = 0;
- Tcl_IncrRefCount(nameObj);
- while (1) {
- map = TclGetProcessGlobalValue(&encodingFileMap);
- Tcl_DictObjGet(NULL, map, nameObj, &directory);
- if (scanned || (NULL != directory)) {
- break;
+ for (i=0; i<numDirs && !verified; i++) {
+ if (dir[i] == directory) {
+ verified = 1;
+ }
+ }
+ if (!verified) {
+ CONST char *dirString = Tcl_GetString(directory);
+ for (i=0; i<numDirs && !verified; i++) {
+ if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
+ verified = 1;
+ }
+ }
+ }
+ if (!verified) {
+ /* Directory no longer on the search path. Remove from cache */
+ map = Tcl_DuplicateObj(map);
+ Tcl_DictObjRemove(NULL, map, nameObj);
+ TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+ directory = NULL;
}
-scan:
- FillEncodingFileMap();
- scanned = 1;
}
- if (NULL == directory) {
- Tcl_DecrRefCount(nameObj);
- goto unknown;
+
+ if (NULL != directory) {
+ /* Got a directory from the cache. Try to use it first */
+ Tcl_IncrRefCount(directory);
+ path = Tcl_FSJoinToPath(directory, 1, &fileNameObj);
+ Tcl_IncrRefCount(path);
+ Tcl_DecrRefCount(directory);
+ chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+ Tcl_DecrRefCount(path);
}
- /* Construct $directory/$encoding.enc path name */
- Tcl_IncrRefCount(directory);
- Tcl_AppendToObj(nameObj, ".enc", -1);
- path = Tcl_FSJoinToPath(directory, 1, &nameObj);
- Tcl_DecrRefCount(directory);
+ /* Scan the search path until we find it. */
+ for (i=0; i<numDirs && (chan == NULL); i++) {
+ path = Tcl_FSJoinToPath(dir[i], 1, &fileNameObj);
+ Tcl_IncrRefCount(path);
+ chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
+ Tcl_DecrRefCount(path);
+ if (chan != NULL) {
+ /* Save directory in the cache */
+ map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
+ Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
+ TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
+ }
+ }
+ if ((NULL == chan) && (interp != NULL)) {
+ Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+ }
+ Tcl_DecrRefCount(fileNameObj);
Tcl_DecrRefCount(nameObj);
- Tcl_IncrRefCount(path);
- chan = Tcl_FSOpenFileChannel(NULL, path, "r", 0);
- Tcl_DecrRefCount(path);
+ Tcl_DecrRefCount(searchPath);
+ return chan;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * LoadEncodingFile --
+ *
+ * Read a file that describes an encoding and create a new Encoding
+ * from the data.
+ *
+ * Results:
+ * The return value is the newly loaded Encoding, or NULL if
+ * the file didn't exist of was in the incorrect format. If NULL was
+ * returned, an error message is left in interp's result object,
+ * unless interp was NULL.
+ *
+ * Side effects:
+ * File read from disk.
+ *
+ *---------------------------------------------------------------------------
+ */
- if (NULL == chan) {
- if (!scanned) {
- goto scan;
- }
- goto unknown;
+static Tcl_Encoding
+LoadEncodingFile(interp, name)
+ Tcl_Interp *interp; /* Interp for error reporting, if not NULL. */
+ CONST char *name; /* The name of the encoding file on disk
+ * and also the name for new encoding. */
+{
+ Tcl_Channel chan = NULL;
+ Tcl_Encoding encoding = NULL;
+ int ch;
+
+ chan = OpenEncodingFileChannel(interp, name);
+ if (chan == NULL) {
+ return NULL;
}
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
@@ -1472,7 +1514,6 @@ scan:
}
}
- encoding = NULL;
switch (ch) {
case 'S': {
encoding = LoadTableEncoding(name, ENCODING_SINGLEBYTE, chan);
@@ -1496,12 +1537,6 @@ scan:
}
Tcl_Close(NULL, chan);
return encoding;
-
- unknown:
- if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
- }
- return NULL;
}
/*
@@ -3185,43 +3220,3 @@ InitializeEncodingSearchPath(valuePtr, lengthPtr, encodingPtr)
memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1);
Tcl_DecrRefCount(searchPath);
}
-
-/*
- *-------------------------------------------------------------------------
- *
- * InitializeEncodingFileMap --
- *
- * This is the fallback routine that fills the encoding data
- * file map if the application has not set up an encoding
- * search path by the first time the file map is needed to
- * load encoding data.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Fills the encoding data file map.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-InitializeEncodingFileMap(valuePtr, lengthPtr, encodingPtr)
- char **valuePtr;
- int *lengthPtr;
- Tcl_Encoding *encodingPtr;
-{
- char *bytes;
- int numBytes;
- Tcl_Obj *map = MakeFileMap();
-
- *encodingPtr = encodingSearchPath.encoding;
- if (*encodingPtr) {
- ((Encoding *)(*encodingPtr))->refCount++;
- }
- bytes = Tcl_GetStringFromObj(map, &numBytes);
- *lengthPtr = numBytes;
- *valuePtr = ckalloc((unsigned int) numBytes + 1);
- memcpy((VOID *) *valuePtr, (VOID *) bytes, (size_t) numBytes + 1);
- Tcl_DecrRefCount(map);
-}
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 4521b50..d1e4a7f 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.55 2004/12/16 19:36:34 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.56 2005/04/12 20:28:47 dgp Exp $
*/
#include "tclInt.h"
@@ -466,8 +466,8 @@ done:
if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
code = Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
if (code == TCL_ERROR) {
- Tcl_Panic("system encoding \"", Tcl_DStringValue(&encodingName),
- "\" not available");
+ Tcl_Panic("system encoding \"%s\" not available",
+ Tcl_DStringValue(&encodingName));
}
}
Tcl_DStringFree(&encodingName);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 9b7d0ec..16cee4b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.54 2005/04/05 16:56:30 dgp Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.55 2005/04/12 20:28:48 dgp Exp $
*/
#include "tclInt.h"
@@ -2745,14 +2745,14 @@ TclGetProcessGlobalValue(pgvPtr)
/* If no thread has set the shared value, call the initializer */
Tcl_MutexLock(&pgvPtr->mutex);
- if (NULL == pgvPtr->value) {
- if (pgvPtr->proc) {
- pgvPtr->epoch++;
- (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
- &pgvPtr->encoding);
- Tcl_CreateExitHandler(FreeProcessGlobalValue,
- (ClientData) pgvPtr);
+ if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
+ pgvPtr->epoch++;
+ (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
+ &pgvPtr->encoding);
+ if (pgvPtr->value == NULL) {
+ Tcl_Panic("PGV Initializer did not initialize.");
}
+ Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
}
/* Store a copy of the shared value in our epoch-indexed cache */