* 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]

3 files changed, 125 insertions, 130 deletions

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 */