diff options
| -rw-r--r-- | ChangeLog | 18 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 233 | ||||
| -rw-r--r-- | generic/tclInterp.c | 6 | ||||
| -rw-r--r-- | generic/tclUtil.c | 16 |
4 files changed, 143 insertions, 130 deletions
@@ -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 */ |