From e691fce6b050292abd74b38b28886b6e5bcea55b Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Apr 2005 20:28:37 +0000 Subject: * 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] --- ChangeLog | 18 ++++ generic/tclEncoding.c | 233 ++++++++++++++++++++++++-------------------------- generic/tclInterp.c | 6 +- generic/tclUtil.c | 16 ++-- 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 + + * 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 * 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; irefCount++; - } - 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 */ -- cgit v0.12