/* 

  * tclIOUtil.c --

  *

  *	This file contains the implementation of Tcl's generic

  *	filesystem 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.

  *

  *	Parts of this file are based on code contributed by Karl

  *	Lehenbauer, Mark Diekhans and Peter da Silva.

  *

  * Copyright (c) 1991-1994 The Regents of the University of California.

  * Copyright (c) 1994-1997 Sun Microsystems, Inc.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * 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.77.2.34 2007/02/19 23:49:05 hobbs Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #ifdef MAC_TCL

 #include "tclMacInt.h"

 #endif

 #ifdef __WIN32__

 /* for tclWinProcs->useWide */

 #include "tclWinInt.h"

 #endif

 #if defined(__SYMBIAN32__) && defined(__WINSCW__)

 #include "tclSymbianGlobals.h"

 #define dataKey getdataKey(4)

 #endif 

 /* 

  * struct FilesystemRecord --

  * 

  * A filesystem record is used to keep track of each

  * filesystem currently registered with the core,

  * in a linked list.  Pointers to these structures

  * are also kept by each "path" Tcl_Obj, and we must

  * retain a refCount on the number of such references.

  */

 typedef struct FilesystemRecord {

     ClientData	     clientData;  /* Client specific data for the new

 				   * filesystem (can be NULL) */

     Tcl_Filesystem *fsPtr;        /* Pointer to filesystem dispatch

 				   * table. */

     int fileRefCount;             /* How many Tcl_Obj's use this

 				   * filesystem. */

     struct FilesystemRecord *nextPtr;  

 				  /* The next filesystem registered

 				   * to Tcl, or NULL if no more. */

     struct FilesystemRecord *prevPtr;  

 				  /* The previous filesystem registered

 				   * to Tcl, or NULL if no more. */

 } FilesystemRecord;

 /* 

  * The internal TclFS API provides routines for handling and

  * manipulating paths efficiently, taking direct advantage of

  * the "path" Tcl_Obj type.

  * 

  * These functions are not exported at all at present.

  */

 int      TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr));

 int	 TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, 

 		Tcl_Obj *objPtr, ClientData clientData));

 int      TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, 

 		Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr));

 Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, 

 		Tcl_Obj *objPtr, Tcl_Obj *cwdPtr));

 Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_((

 		Tcl_Filesystem *fromFilesystem, ClientData clientData,

 		FilesystemRecord **fsRecPtrPtr));

 int      TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathObjPtr,

 		Tcl_Filesystem **fsPtrPtr));

 void     TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 

 		FilesystemRecord *fsRecPtr, ClientData clientData)); 

 /* 

  * Private variables for use in this file

  */

 extern Tcl_Filesystem tclNativeFilesystem;

 extern int theFilesystemEpoch;

 /* 

  * Private functions for use in this file

  */

 static Tcl_PathType     FSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 

 			    Tcl_Filesystem **filesystemPtrPtr, 

 			    int *driveNameLengthPtr));

 static Tcl_PathType     GetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 

 			    Tcl_Filesystem **filesystemPtrPtr, 

 			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));

 static Tcl_FSPathInFilesystemProc NativePathInFilesystem;

 static Tcl_Obj*  TclFSNormalizeAbsolutePath 

 			    _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr,

 					 ClientData *clientDataPtr));

 /*

  * Prototypes for procedures defined later in this file.

  */

 static FilesystemRecord* FsGetFirstFilesystem(void);

 static void FsThrExitProc(ClientData cd);

 static Tcl_Obj* FsListMounts          _ANSI_ARGS_((Tcl_Obj *pathPtr, 

 						   CONST char *pattern));

 static Tcl_Obj* FsAddMountsToGlobResult  _ANSI_ARGS_((Tcl_Obj *result, 

 	   Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types));

 #ifdef TCL_THREADS

 static void FsRecacheFilesystemList(void);

 #endif

 /* 

  * 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 mac/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[];

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

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

 {

     int ret;

     Tcl_StatBuf buf;

     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

     Tcl_IncrRefCount(pathPtr);

     ret = Tcl_FSStat(pathPtr, &buf);

     Tcl_DecrRefCount(pathPtr);

     if (ret != -1) {

 #ifndef TCL_WIDE_INT_IS_LONG

 #   define OUT_OF_RANGE(x) \

 	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \

 	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))

 #if defined(__GNUC__) && __GNUC__ >= 2

 /*

  * Workaround gcc warning of "comparison is always false due to limited range of

  * data type" in this macro by checking max type size, and when necessary ANDing

  * with the complement of ULONG_MAX instead of the comparison:

  */

 #   define OUT_OF_URANGE(x) \

 	((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \

 	 (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))

 #else

 #   define OUT_OF_URANGE(x) \

 	(((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)

 #endif

 	/*

 	 * Perform the result-buffer overflow check manually.

 	 *

 	 * Note that ino_t/ino64_t is unsigned...

 	 */

         if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)

 #ifdef HAVE_ST_BLOCKS

 		|| OUT_OF_RANGE(buf.st_blocks)

 #endif

 	    ) {

 #ifdef EFBIG

 	    errno = EFBIG;

 #else

 #  ifdef EOVERFLOW

 	    errno = EOVERFLOW;

 #  else

 #    error  "What status should be returned for file size out of range?"

 #  endif

 #endif

 	    return -1;

 	}

 #   undef OUT_OF_RANGE

 #   undef OUT_OF_URANGE

 #endif /* !TCL_WIDE_INT_IS_LONG */

 	/*

 	 * 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 structure sizes coincide,

 	 * but that's what you get for using an obsolete interface.

 	 */

 	oldStyleBuf->st_mode    = buf.st_mode;

 	oldStyleBuf->st_ino     = (ino_t) buf.st_ino;

 	oldStyleBuf->st_dev     = buf.st_dev;

 	oldStyleBuf->st_rdev    = buf.st_rdev;

 	oldStyleBuf->st_nlink   = buf.st_nlink;

 	oldStyleBuf->st_uid     = buf.st_uid;

 	oldStyleBuf->st_gid     = buf.st_gid;

 	oldStyleBuf->st_size    = (off_t) buf.st_size;

 	oldStyleBuf->st_atime   = buf.st_atime;

 	oldStyleBuf->st_mtime   = buf.st_mtime;

 	oldStyleBuf->st_ctime   = buf.st_ctime;

 #ifdef HAVE_ST_BLOCKS

 	oldStyleBuf->st_blksize = buf.st_blksize;

 	oldStyleBuf->st_blocks  = (blkcnt_t) buf.st_blocks;

 #endif

     }

     return ret;

 }

 /* Obsolete */

 EXPORT_C int

 Tcl_Access(path, mode)

     CONST char *path;		/* Path of file to access (in current CP). */

     int mode;                   /* Permission setting. */

 {

     int ret;

     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

     Tcl_IncrRefCount(pathPtr);

     ret = Tcl_FSAccess(pathPtr,mode);

     Tcl_DecrRefCount(pathPtr);

     return ret;

 }

 /* Obsolete */

 EXPORT_C Tcl_Channel

 Tcl_OpenFileChannel(interp, path, modeString, permissions)

     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 as "rw". */

     int permissions;                    /* If the open involves creating a

 					 * file, with what modes to create

 					 * it? */

 {

     Tcl_Channel ret;

     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

     Tcl_IncrRefCount(pathPtr);

     ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);

     Tcl_DecrRefCount(pathPtr);

     return ret;

 }

 /* Obsolete */

 EXPORT_C int

 Tcl_Chdir(dirName)

     CONST char *dirName;

 {

     int ret;

     Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);

     Tcl_IncrRefCount(pathPtr);

     ret = Tcl_FSChdir(pathPtr);

     Tcl_DecrRefCount(pathPtr);

     return ret;

 }

 /* Obsolete */

 EXPORT_C char *

 Tcl_GetCwd(interp, cwdPtr)

     Tcl_Interp *interp;

     Tcl_DString *cwdPtr;

 {

     Tcl_Obj *cwd;

     cwd = Tcl_FSGetCwd(interp);

     if (cwd == NULL) {

 	return NULL;

     } else {

 	Tcl_DStringInit(cwdPtr);

 	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);

 	Tcl_DecrRefCount(cwd);

 	return Tcl_DStringValue(cwdPtr);

     }

 }

 /* Obsolete */

 EXPORT_C int

 Tcl_EvalFile(interp, fileName)

     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;

     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

     Tcl_IncrRefCount(pathPtr);

     ret = Tcl_FSEvalFile(interp, pathPtr);

     Tcl_DecrRefCount(pathPtr);

     return ret;

 }

 /* 

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

  * 

  * As soon as prowrap and mktclapp are updated to use the full

  * filesystem support, I suggest all these hooks are removed.

  */

 #define USE_OBSOLETE_FS_HOOKS

 #ifdef USE_OBSOLETE_FS_HOOKS

 /*

  * 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 list is defined.

  */

 typedef struct StatProc {

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

 } AccessProc;

 typedef struct OpenFileChannelProc {

     TclOpenFileChannelProc_ *proc;  /* Function to process a

 				     * 'Tcl_OpenFileChannel()' call */

     struct OpenFileChannelProc *nextPtr;

 				    /* The next 'Tcl_OpenFileChannel()'

 				     * function to call */

 } OpenFileChannelProc;

 /*

  * For each type of (obsolete) hookable function, a static node is

  * declared to hold the function pointer for the "built-in" routine

  * (e.g. 'TclpStat(...)') and the respective list is initialized as a

  * pointer to that node.

  * 

  * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that

  * these statically declared list entry cannot be inadvertently removed.

  *

  * This method avoids the need to call any sort of "initialization"

  * function.

  *

  * All three lists are protected by a global obsoleteFsHookMutex.

  */

 static StatProc *statProcList = NULL;

 static AccessProc *accessProcList = NULL;

 static OpenFileChannelProc *openFileChannelProcList = NULL;

 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.

  * 

  * The correct API to use now is the Tcl_FS... set of functions,

  * which ensure correct and complete virtual filesystem support.

  * 

  * We cannot make all of these static, since some of them

  * are implemented in the platform-specific directories.

  */

 static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;

 static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;

 static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;

 static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;

 static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;

 static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;

 /* 

  * The only reason these functions are not static is that they

  * are either called by code in the native (win/unix/mac) directories

  * or they are actually implemented in those directories.  They

  * should simply not be called by code outside Tcl's native

  * filesystem core.  i.e. they should be considered 'static' to

  * Tcl's filesystem code (if we ever built the native filesystem

  * 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_FSGetCwdProc TclpObjGetCwd;     

 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!

  */

 Tcl_Filesystem tclNativeFilesystem = {

     "native",

     sizeof(Tcl_Filesystem),

     TCL_FILESYSTEM_VERSION_1,

     &NativePathInFilesystem,

     &TclNativeDupInternalRep,

     &NativeFreeInternalRep,

     &TclpNativeToNormalized,

     &NativeCreateNativeRep,

     &TclpObjNormalizePath,

     &TclpFilesystemPathType,

     &NativeFilesystemSeparator,

     &TclpObjStat,

     &TclpObjAccess,

     &TclpOpenFileChannel,

     &TclpMatchInDirectory,

     &TclpUtime,

 #ifndef S_IFLNK

     NULL,

 #else

     &TclpObjLink,

 #endif /* S_IFLNK */

     &TclpObjListVolumes,

     &NativeFileAttrStrings,

     &NativeFileAttrsGet,

     &NativeFileAttrsSet,

     &TclpObjCreateDirectory,

     &TclpObjRemoveDirectory, 

     &TclpObjDeleteFile,

     &TclpObjCopyFile,

     &TclpObjRenameFile,

     &TclpObjCopyDirectory, 

     &TclpObjLstat,

     &TclpDlopen,

     &TclpObjGetCwd,

     &TclpObjChdir

 };

 /* 

  * 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 will never be freed.

  */

 static FilesystemRecord nativeFilesystemRecord = {

     NULL,

     &tclNativeFilesystem,

     1,

     NULL

 };

 /* 

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

  */

 int theFilesystemEpoch = 0;

 /*

  * Stores the linked list of filesystems. A 1:1 copy of this

  * list is also maintained in the TSD for each thread. This

  * is to avoid synchronization issues.

  */

 static FilesystemRecord *filesystemList = &nativeFilesystemRecord;

 TCL_DECLARE_MUTEX(filesystemMutex)

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 /* 

  * Used to implement Tcl_FSGetCwd in a file-system independent way.

  */

 static Tcl_Obj* cwdPathPtr = NULL;

 static int cwdPathEpoch = 0;

 #endif

 TCL_DECLARE_MUTEX(cwdMutex)

 /*

  * This structure holds per-thread private copies of

  * some global data. This way we avoid most of the

  * synchronization calls which boosts performance, at

  * cost of having to update this information each

  * time the corresponding epoch counter changes.

  * 

  */

 typedef struct ThreadSpecificData {

     int initialized;

     int cwdPathEpoch;

     int filesystemEpoch; 

     Tcl_Obj *cwdPathPtr;

     FilesystemRecord *filesystemList;

 } ThreadSpecificData;

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 static Tcl_ThreadDataKey dataKey;

 #endif

 /* 

  * Declare fallback support function and 

  * information for Tcl_FSLoadFile 

  */

 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 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.

  */

 typedef struct FsDivertLoad {

     Tcl_LoadHandle loadHandle;

     Tcl_FSUnloadFileProc *unloadProcPtr;	

     Tcl_Obj *divertedFile;

     Tcl_Filesystem *divertedFilesystem;

     ClientData divertedFileNativeRep;

 } FsDivertLoad;

 /* Now move on to the basic filesystem implementation */

 static void

 FsThrExitProc(cd)

     ClientData cd;

 {

     ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd;

     FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;

     /* Trash the cwd copy */

     if (tsdPtr->cwdPathPtr != NULL) {

 	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);

 	tsdPtr->cwdPathPtr = NULL;

     }

     /* Trash the filesystems cache */

     fsRecPtr = tsdPtr->filesystemList;

     while (fsRecPtr != NULL) {

 	tmpFsRecPtr = fsRecPtr->nextPtr;

 	if (--fsRecPtr->fileRefCount <= 0) {

 	    ckfree((char *)fsRecPtr);

 	}

 	fsRecPtr = tmpFsRecPtr;

     }

     tsdPtr->initialized = 0;

 }

 int 

 TclFSCwdPointerEquals(objPtr)

     Tcl_Obj* objPtr;

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     Tcl_MutexLock(&cwdMutex);

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)    

     if (tsdPtr->cwdPathPtr == NULL) {

     if (cwdPathPtr == NULL) {

 	    tsdPtr->cwdPathPtr = NULL;

 	} else {

 		tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);	

 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

 	}

 	tsdPtr->cwdPathEpoch = cwdPathEpoch;

     } else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) { 	

 	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);

 	if (cwdPathPtr == NULL) {

 	    tsdPtr->cwdPathPtr = NULL;

 	} else {

 	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);

 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

 	}

     }

 #else

     if (tsdPtr->cwdPathPtr == NULL) {

     if (glcwdPathPtr == NULL) {    

 	    tsdPtr->cwdPathPtr = NULL;

 	} else {

 		tsdPtr->cwdPathPtr = Tcl_DuplicateObj(glcwdPathPtr);	

 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

 	}

 	tsdPtr->cwdPathEpoch = glcwdPathEpoch;	

     } else if (tsdPtr->cwdPathEpoch != glcwdPathEpoch) { 	

 	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);

 	if (glcwdPathPtr == NULL) {

 	    tsdPtr->cwdPathPtr = NULL;

 	} else {

 	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(glcwdPathPtr);

 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

 	}

     }

 #endif

     Tcl_MutexUnlock(&cwdMutex);

     if (tsdPtr->initialized == 0) {

 	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);

 	tsdPtr->initialized = 1;

     }

     return (tsdPtr->cwdPathPtr == objPtr); 

 }

 #ifdef TCL_THREADS

 static void

 FsRecacheFilesystemList(void)

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;

     /* Trash the current cache */

     fsRecPtr = tsdPtr->filesystemList;

     while (fsRecPtr != NULL) {

 	tmpFsRecPtr = fsRecPtr->nextPtr;

 	if (--fsRecPtr->fileRefCount <= 0) {

 	    ckfree((char *)fsRecPtr);

 	}

 	fsRecPtr = tmpFsRecPtr;

     }

     tsdPtr->filesystemList = NULL;

     /*

      * Code below operates on shared data. We

      * are already called under mutex lock so   

      * we can safely proceed.

      */

     /* Locate tail of the global filesystem list */

     fsRecPtr = filesystemList;

     while (fsRecPtr != NULL) {

 	tmpFsRecPtr = fsRecPtr;

 	fsRecPtr = fsRecPtr->nextPtr;

     }

     /* Refill the cache honouring the order */

     fsRecPtr = tmpFsRecPtr;

     while (fsRecPtr != NULL) {

 	tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));

 	*tmpFsRecPtr = *fsRecPtr;

 	tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;

 	tmpFsRecPtr->prevPtr = NULL;

 	if (tsdPtr->filesystemList) {

 	    tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;

 	}

 	tsdPtr->filesystemList = tmpFsRecPtr;

         fsRecPtr = fsRecPtr->prevPtr;

     }

     /* Make sure the above gets released on thread exit */

     if (tsdPtr->initialized == 0) {

 	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);

 	tsdPtr->initialized = 1;

     }

 }

 #endif

 static FilesystemRecord *

 FsGetFirstFilesystem(void) {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     FilesystemRecord *fsRecPtr;

 #ifndef TCL_THREADS

     tsdPtr->filesystemEpoch = theFilesystemEpoch;

     fsRecPtr = filesystemList;

 #else

     Tcl_MutexLock(&filesystemMutex);

     if (tsdPtr->filesystemList == NULL

 	    || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {

  	FsRecacheFilesystemList();

 	tsdPtr->filesystemEpoch = theFilesystemEpoch;

     }

     Tcl_MutexUnlock(&filesystemMutex);

     fsRecPtr = tsdPtr->filesystemList;

 #endif

     return fsRecPtr;

 }

 static void

 FsUpdateCwd(cwdObj)

     Tcl_Obj *cwdObj;

 {

     int len;

     char *str = NULL;

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if (cwdObj != NULL) {

 	str = Tcl_GetStringFromObj(cwdObj, &len);

     }

     Tcl_MutexLock(&cwdMutex);

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)        

     if (cwdPathPtr != NULL) {

         Tcl_DecrRefCount(cwdPathPtr);

     }

     if (cwdObj == NULL) {

 	cwdPathPtr = NULL;

     } else {

 	/* This MUST be stored as string object! */

 	cwdPathPtr = Tcl_NewStringObj(str, len); 

     	Tcl_IncrRefCount(cwdPathPtr);

     }

     cwdPathEpoch++;

     tsdPtr->cwdPathEpoch = cwdPathEpoch;

 #else

     if (glcwdPathPtr != NULL) {

     Tcl_DecrRefCount(glcwdPathPtr);

     }

 	if (cwdObj == NULL) {

 	glcwdPathPtr = NULL;

 	} else {

 	/* This MUST be stored as string object! */

 	glcwdPathPtr = Tcl_NewStringObj(str, len); 

 		Tcl_IncrRefCount(glcwdPathPtr);

 	}

 	glcwdPathEpoch++;

 	tsdPtr->cwdPathEpoch = glcwdPathEpoch;

 #endif

     Tcl_MutexUnlock(&cwdMutex);

     if (tsdPtr->cwdPathPtr) {

         Tcl_DecrRefCount(tsdPtr->cwdPathPtr);

     }

     if (cwdObj == NULL) {

 	tsdPtr->cwdPathPtr = NULL;

     } else {

 	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); 

 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclFinalizeFilesystem --

  *

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

  *	

  * Results:

  *	None.

  *

  * Side effects:

  *	Frees any memory allocated by the filesystem.

  *

  *----------------------------------------------------------------------

  */

 void

 TclFinalizeFilesystem()

 {

     FilesystemRecord *fsRecPtr;

     /* 

      * Assumption that only one thread is active now.  Otherwise

      * we would need to put various mutexes around this code.

      */

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)    	

     if (cwdPathPtr != NULL) {

 	Tcl_DecrRefCount(cwdPathPtr);

 	cwdPathPtr = NULL;

     cwdPathEpoch = 0;

 #else

     if (glcwdPathPtr != NULL) {

 	Tcl_DecrRefCount(glcwdPathPtr);

 	glcwdPathPtr = NULL;

     glcwdPathEpoch = 0;

 #endif

     }

     /* 

      * Remove all filesystems, freeing any allocated memory

      * that is no longer needed

      */

     fsRecPtr = filesystemList;

     while (fsRecPtr != NULL) {

 	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

 	if (fsRecPtr->fileRefCount <= 0) {

 	    /* The native filesystem is static, so we don't free it */

 	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {

 		ckfree((char *)fsRecPtr);

 	    }

 	}

 	fsRecPtr = tmpFsRecPtr;

     }

     filesystemList = NULL;

     /*

      * Now filesystemList is NULL.  This means that any attempt

      * to use the filesystem is likely to fail.

      */

     statProcList = NULL;

     accessProcList = NULL;

     openFileChannelProcList = NULL;

 #ifdef __WIN32__

     TclWinEncodingsCleanup();

 #endif

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclResetFilesystem --

  *

  *	Restore the filesystem to a pristine state.

  *	

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 void

 TclResetFilesystem()

 {

     filesystemList = &nativeFilesystemRecord;

     /* 

      * Note, at this point, I believe nativeFilesystemRecord ->

      * fileRefCount should equal 1 and if not, we should try to track

      * down the cause.

      */

 #ifdef __WIN32__

     /* 

      * Cleans up the win32 API filesystem proc lookup table. This must

      * happen very late in finalization so that deleting of copied

      * dlls can occur.

      */

     TclWinResetInterfaces();

 #endif

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSRegister --

  *

  *    Insert the filesystem function table at the head of the list of

  *    functions which are used during calls to all file-system

  *    operations.  The filesystem will be added even if it is 

  *    already in the list.  (You 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 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.

  *    

  *    In particular this means if you want to add a diagnostic

  *    filesystem (which simply reports all fs activity), it must be 

  *    at the head of the list: i.e. it must be the last registered.

  *

  * Results:

  *    Normally TCL_OK; TCL_ERROR if memory for a new node in the list

  *    could not be allocated.

  *

  * Side effects:

  *    Memory allocated and modifies the link list for filesystems.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_FSRegister(clientData, fsPtr)

     ClientData clientData;    /* Client specific data for this fs */

     Tcl_Filesystem  *fsPtr;   /* The filesystem record for the new fs. */

 {

     FilesystemRecord *newFilesystemPtr;

     if (fsPtr == NULL) {

 	return TCL_ERROR;

     }

     newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));

     newFilesystemPtr->clientData = clientData;

     newFilesystemPtr->fsPtr = fsPtr;

     /* 

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

      * 

      * However, since registering and unregistering filesystems is

      * a very rare action, this is not a very important point.

      */

     Tcl_MutexLock(&filesystemMutex);

     newFilesystemPtr->nextPtr = filesystemList;

     newFilesystemPtr->prevPtr = NULL;

     if (filesystemList) {

 	filesystemList->prevPtr = newFilesystemPtr;

     }

     filesystemList = newFilesystemPtr;

     /* 

      * Increment the filesystem epoch counter, since existing paths

      * might conceivably now belong to different filesystems.

      */

     theFilesystemEpoch++;

     Tcl_MutexUnlock(&filesystemMutex);

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSUnregister --

  *

  *    Remove the passed filesystem from the list of filesystem

  *    function 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 otherwise.

  *

  * Side effects:

  *    Memory may be deallocated (or will be later, once no "path" 

  *    objects refer to this filesystem), but the list of registered

  *    filesystems is updated immediately.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_FSUnregister(fsPtr)

     Tcl_Filesystem  *fsPtr;   /* The filesystem record to remove. */

 {

     int retVal = TCL_ERROR;

     FilesystemRecord *fsRecPtr;

     Tcl_MutexLock(&filesystemMutex);

     /*

      * Traverse the 'filesystemList' looking for the particular node

      * whose 'fsPtr' member matches 'fsPtr' and remove that one from

      * the list.  Ensure that the "default" node cannot be removed.

      */

     fsRecPtr = filesystemList;

     while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {

 	if (fsRecPtr->fsPtr == fsPtr) {

 	    if (fsRecPtr->prevPtr) {

 		fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;

 	    } else {

 		filesystemList = fsRecPtr->nextPtr;

 	    }

 	    if (fsRecPtr->nextPtr) {

 		fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;

 	    }

 	    /* 

 	     * Increment the filesystem epoch counter, since existing

 	     * paths 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).

 	     */

 	    theFilesystemEpoch++;

 	    fsRecPtr->fileRefCount--;

 	    if (fsRecPtr->fileRefCount <= 0) {

 	        ckfree((char *)fsRecPtr);

 	    }

 	    retVal = TCL_OK;

 	} else {

 	    fsRecPtr = fsRecPtr->nextPtr;

 	}

     }

     Tcl_MutexUnlock(&filesystemMutex);

     return (retVal);

 }

 /*

  *----------------------------------------------------------------------

  *

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

  *	filesystem's Tcl_FSMatchInDirectoryProc 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.

  *	

  *	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 and correct type.

  *

  * Results: 

  *	

  *	The return value is a standard Tcl result indicating whether an

  *	error 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 which match in a single directory.

  *

  * Side effects:

  *	The interpreter may have an error message inserted into it.

  *

  *---------------------------------------------------------------------- 

  */

 EXPORT_C int

 Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)

     Tcl_Interp *interp;		/* Interpreter to receive error messages. */

     Tcl_Obj *result;		/* 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. */

 {

     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;

 	if (proc != NULL) {

 	    int ret = (*proc)(interp, result, pathPtr, pattern, types);

 	    if (ret == TCL_OK && pattern != NULL) {

 		result = FsAddMountsToGlobResult(result, pathPtr, 

 						 pattern, types);

 	    }

 	    return ret;

 	}

     } else {

 	Tcl_Obj* cwd;

 	int ret = -1;

 	if (pathPtr != NULL) {

 	    int len;

 	    Tcl_GetStringFromObj(pathPtr,&len);

 	    if (len != 0) {

 		/* 

 		 * We have no idea how to match files in a directory

 		 * which belongs to no known filesystem

 		 */

 		Tcl_SetErrno(ENOENT);

 		return -1;

 	    }

 	}

 	/* 

 	 * We have an empty or NULL path.  This is defined to mean we

 	 * must search for files within the current 'cwd'.  We

 	 * therefore use that, but then since the proc we call will

 	 * return results which include the cwd we must then trim it

 	 * off the front of each path in the result.  We choose to deal

 	 * with this here (in the generic code), since if we don't,

 	 * every single filesystem's implementation of

 	 * Tcl_FSMatchInDirectory will have to deal with it for us.

 	 */

 	cwd = Tcl_FSGetCwd(NULL);

 	if (cwd == NULL) {

 	    if (interp != NULL) {

 		Tcl_SetResult(interp, "glob couldn't determine "

 			  "the current working directory", TCL_STATIC);

 	    }

 	    return TCL_ERROR;

 	}

 	fsPtr = Tcl_FSGetFileSystemForPath(cwd);

 	if (fsPtr != NULL) {

 	    Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;

 	    if (proc != NULL) {

 		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);

 		Tcl_IncrRefCount(tmpResultPtr);

 		ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);

 		if (ret == TCL_OK) {

 		    int resLength;

 		    tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,

 							   pattern, types);

 		    ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);

 		    if (ret == TCL_OK) {

 			int i;

 			for (i = 0; i < resLength; i++) {

 			    Tcl_Obj *elt;

 			    Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);

 			    Tcl_ListObjAppendElement(interp, result, 

 				TclFSMakePathRelative(interp, elt, cwd));

 			}

 		    }

 		}

 		Tcl_DecrRefCount(tmpResultPtr);

 	    }

 	}

 	Tcl_DecrRefCount(cwd);

 	return ret;

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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 required so that simple things like 

  *	'glob *' merge mounts and listings correctly.

  *	

  * Results: 

  *	

  *	The passed in 'result' may be modified (in place, if

  *	necessary), and the correct list is returned.

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------- 

  */

 static Tcl_Obj*

 FsAddMountsToGlobResult(result, pathPtr, pattern, types)

     Tcl_Obj *result;    /* The current list of matching paths */

     Tcl_Obj *pathPtr;   /* The directory in question */

     CONST char *pattern;

     Tcl_GlobTypeData *types;

 {

     int mLength, gLength, i;

     int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));

     Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);

     if (mounts == NULL) return result; 

     if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {

 	goto endOfMounts;

     }

     if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {

 	goto endOfMounts;

     }

     for (i = 0; i < mLength; i++) {

 	Tcl_Obj *mElt;

 	int j;

 	int found = 0;

 	Tcl_ListObjIndex(NULL, mounts, i, &mElt);

 	for (j = 0; j < gLength; j++) {

 	    Tcl_Obj *gElt;

 	    Tcl_ListObjIndex(NULL, result, j, &gElt);

 	    if (Tcl_FSEqualPaths(mElt, gElt)) {

 		found = 1;

 		if (!dir) {

 		    /* We don't want to list this */

 		    if (Tcl_IsShared(result)) {

 			Tcl_Obj *newList;

 			newList = Tcl_DuplicateObj(result);

 			Tcl_DecrRefCount(result);

 			result = newList;

 		    }

 		    Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);

 		    gLength--;

 		}

 		/* Break out of for loop */

 		break;

 	    }

 	}

 	if (!found && dir) {

 	    if (Tcl_IsShared(result)) {

 		Tcl_Obj *newList;

 		newList = Tcl_DuplicateObj(result);

 		Tcl_DecrRefCount(result);

 		result = newList;

 	    }

 	    Tcl_ListObjAppendElement(NULL, result, mElt);

 	    /* 

 	     * No need to increment gLength, since we

 	     * don't want to compare mounts against

 	     * mounts.

 	     */

 	}

     }

   endOfMounts:

     Tcl_DecrRefCount(mounts);

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSMountsChanged --

  *

  *    Notify the filesystem that the available mounted filesystems

  *    (or within any one filesystem type, the number or location of

  *    mount points) have changed.

  *

  * Results:

  *    None.

  *

  * Side effects:

  *    The global filesystem variable 'theFilesystemEpoch' is

  *    incremented.  The effect of this is to make all cached

  *    path representations invalid.  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 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 'pathInFilesystem' proc will always fail).  However,

  *    for safety, Tcl always calls this for you in these circumstances.

  * 

  *    (2) when additional mount points are established inside any

  *    existing filesystem (except the native fs)

  *    

  *    (3) when any filesystem (except the native fs) changes the list

  *    of available volumes.

  *    

  *    (4) when the mapping from a string representation of a file to

  *    a full, normalized path changes.  For example, if 'env(HOME)' 

  *    is modified, then any path containing '~' will map to a different

  *    filesystem location.  Therefore all such paths need to have

  *    their internal representation invalidated.

  *    

  *    Tcl has no control over (2) and (3), so any registered filesystem

  *    must make sure it calls this function when those situations

  *    occur.

  *    

  *    (Note: the reason for the exception in 2,3 for the native

  *    filesystem is that the native filesystem by default claims all

  *    unknown files even if it really doesn't understand them or if

  *    they don't exist).

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_FSMountsChanged(fsPtr)

     Tcl_Filesystem *fsPtr;

 {

     /* 

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

      */

     (void)fsPtr;

     /* 

      * Increment the filesystem epoch counter, since existing paths

      * might now belong to different filesystems.

      */

     Tcl_MutexLock(&filesystemMutex);

     theFilesystemEpoch++;

     Tcl_MutexUnlock(&filesystemMutex);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSData --

  *

  *    Retrieve the clientData field for the filesystem given,

  *    or NULL if that filesystem is not registered.

  *

  * Results:

  *    A clientData value, or NULL.  Note that if the filesystem

  *    was registered with a NULL clientData field, this function

  *    will return that NULL value.

  *

  * Side effects:

  *    None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C ClientData

 Tcl_FSData(fsPtr)

     Tcl_Filesystem  *fsPtr;   /* The filesystem record to query. */

 {

     ClientData retVal = NULL;

     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

     /*

      * Traverse the 'filesystemList' looking for the particular node

      * whose 'fsPtr' member matches 'fsPtr' and remove that one from

      * the list.  Ensure that the "default" node cannot be removed.

      */

     while ((retVal == NULL) && (fsRecPtr != NULL)) {

 	if (fsRecPtr->fsPtr == fsPtr) {

 	    retVal = fsRecPtr->clientData;

 	}

 	fsRecPtr = fsRecPtr->nextPtr;

     }

     return retVal;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * TclFSNormalizeAbsolutePath --

  *

  * Description:

  *	Takes an absolute path specification and computes a 'normalized'

  *	path from it.

  *	

  *	A normalized path is one which has all '../', './' removed.

  *	Also it is one which is in the 'standard' format for the native

  *	platform.  On MacOS, 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).

  *	

  *	The behaviour of this function if passed a non-absolute path

  *	is NOT defined.

  *

  * Results:

  *	The result is returned in a Tcl_Obj with a refCount of 1,

  *	which is therefore owned by the caller.  It must be

  *	freed (with Tcl_DecrRefCount) by the caller when no longer needed.

  *

  * Side effects:

  *	None (beyond the memory allocation for the result).

  *

  * Special note:

  *	This code is based on code from Matt Newman and Jean-Claude

  *	Wippler, with additions from Vince Darley and is copyright 

  *	those respective authors.

  *

  *---------------------------------------------------------------------------

  */

 static Tcl_Obj *

 TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)

     Tcl_Interp* interp;    /* Interpreter to use */

     Tcl_Obj *pathPtr;      /* Absolute path to normalize */

     ClientData *clientDataPtr;

 {

     int splen = 0, nplen, eltLen, i;

     char *eltName;

     Tcl_Obj *retVal;

     Tcl_Obj *split;

     Tcl_Obj *elt;

     /* Split has refCount zero */

     split = Tcl_FSSplitPath(pathPtr, &splen);

     /* 

      * Modify the list of entries in place, by removing '.', and

      * removing '..' and the entry before -- unless that entry before

      * is the top-level entry, i.e. the name of a volume.

      */

     nplen = 0;

     for (i = 0; i < splen; i++) {

 	Tcl_ListObjIndex(NULL, split, nplen, &elt);

 	eltName = Tcl_GetStringFromObj(elt, &eltLen);

 	if ((eltLen == 1) && (eltName[0] == '.')) {

 	    Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);

 	} else if ((eltLen == 2)

 		&& (eltName[0] == '.') && (eltName[1] == '.')) {

 	    if (nplen > 1) {

 	        nplen--;

 		Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);

 	    } else {

 		Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);

 	    }

 	} else {

 	    nplen++;

 	}

     }

     if (nplen > 0) {

 	ClientData clientData = NULL;

 	retVal = Tcl_FSJoinPath(split, nplen);

 	/* 

 	 * Now we have an absolute path, with no '..', '.' sequences,

 	 * but it still may not be in 'unique' form, depending on the

 	 * platform.  For instance, Unix is case-sensitive, so the

 	 * path is ok.  Windows is case-insensitive, and also has the

 	 * weird 'longname/shortname' thing (e.g. C:/Program Files/ and

 	 * C:/Progra~1/ are equivalent).  MacOS is case-insensitive.

 	 * 

 	 * Virtual file systems which may be registered may have

 	 * other criteria for normalizing a path.

 	 */

 	Tcl_IncrRefCount(retVal);

 	TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);

 	/* 

 	 * Since we know it is a normalized path, we can

 	 * actually convert this object into an "path" object for

 	 * greater efficiency 

 	 */

 	TclFSMakePathFromNormalized(interp, retVal, clientData);

 	if (clientDataPtr != NULL) {

 	    *clientDataPtr = clientData;

 	}

     } else {

 	/* Init to an empty string */

 	retVal = Tcl_NewStringObj("",0);

 	Tcl_IncrRefCount(retVal);

     }

     /* 

      * We increment and then decrement the refCount of split to free

      * it.  We do this right at the end, in case there are

      * optimisations in Tcl_FSJoinPath(split, nplen) above which would

      * let it make use of split more effectively if it has a refCount

      * of zero.  Also we can't just decrement the ref count, in case

      * 'split' was actually returned by the join call above, in a

      * single-element optimisation when nplen == 1.

      */

     Tcl_IncrRefCount(split);

     Tcl_DecrRefCount(split);

     /* This has a refCount of 1 for the caller */

     return retVal;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * TclFSNormalizeToUniquePath --

  *

  * Description:

  *	Takes a path specification containing no ../, ./ sequences,

  *	and converts it into a unique path for the given platform.

  *      On MacOS, 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 offset which was recognised in the path

  *	string.

  *

  * Side effects:

  *	None (beyond the memory allocation for the result).

  *

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

  *

  *      Important assumption: if startAt is non-zero, it must point

  *      to a directory separator that we know exists and is already

  *      normalized (so it is important not to point to the char just

  *      after the separator).

  *---------------------------------------------------------------------------

  */

 int

 TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)

     Tcl_Interp *interp;

     Tcl_Obj *pathPtr;

     int startAt;

     ClientData *clientDataPtr;

 {

     FilesystemRecord *fsRecPtr, *firstFsRecPtr;

     /* Ignore this variable */

     (void)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 native filesystem (i.e. '/' on unix is native).

      */

     firstFsRecPtr = FsGetFirstFilesystem();

     fsRecPtr = firstFsRecPtr;

     while (fsRecPtr != NULL) {

         if (fsRecPtr->fsPtr == &tclNativeFilesystem) {

 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;

 	    if (proc != NULL) {

 		startAt = (*proc)(interp, pathPtr, startAt);

 	    }

 	    break;

         }

 	fsRecPtr = fsRecPtr->nextPtr;

     }

     fsRecPtr = firstFsRecPtr; 

     while (fsRecPtr != NULL) {

 	/* Skip the native system next time through */

 	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {

 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;

 	    if (proc != NULL) {

 		startAt = (*proc)(interp, pathPtr, startAt);

 	    }

 	    /* 

 	     * We could add an efficiency check like this:

 	     * 

 	     *   if (retVal == length-of(pathPtr)) {break;}

 	     * 

 	     * but there's not much benefit.

 	     */

 	}

 	fsRecPtr = fsRecPtr->nextPtr;

     }

     return startAt;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * TclGetOpenMode --

  *

  * Description:

  *	Computes a POSIX mode mask for opening a file, from a given string,

  *	and also sets a flag to indicate whether the caller should seek to

  *	EOF after opening the file.

  *

  * Results:

  *	On success, returns mode to pass to "open". If an error occurs, the

  *	return value is -1 and if interp is not NULL, sets interp's result

  *	object to an error message.

  *

  * Side effects:

  *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller

  *	to seek to EOF after opening the file.

  *

  * Special note:

  *	This code is based on a prototype implementation contributed

  *	by Mark Diekhans.

  *

  *---------------------------------------------------------------------------

  */

 int

 TclGetOpenMode(interp, string, seekFlagPtr)

     Tcl_Interp *interp;			/* Interpreter to use for error

 					 * reporting - may be NULL. */

     CONST char *string;			/* 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 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 distinguished from the POSIX access modes by the presence

      * of a lower-case first letter.

      */

     *seekFlagPtr = 0;

     mode = 0;

     /*

      * Guard against international characters before using byte oriented

      * routines.

      */

     if (!(string[0] & 0x80)

 	    && islower(UCHAR(string[0]))) { /* INTL: ISO only. */

 	switch (string[0]) {

 	    case 'r':

 		mode = O_RDONLY;

 		break;

 	    case 'w':

 		mode = O_WRONLY|O_CREAT|O_TRUNC;

 		break;

 	    case 'a':

 	        /* [Bug 680143].

 		 * Added O_APPEND for proper automatic

 		 * seek-to-end-on-write by the OS.

 		 */

 	        mode = O_WRONLY|O_CREAT|O_APPEND;

                 *seekFlagPtr = 1;

 		break;

 	    default:

 		error:

                 if (interp != (Tcl_Interp *) NULL) {

                     Tcl_AppendResult(interp,

                             "illegal access mode \"", string, "\"",

                             (char *) NULL);

                 }

 		return -1;

 	}

 	if (string[1] == '+') {

 	    mode &= ~(O_RDONLY|O_WRONLY);

 	    mode |= O_RDWR;

 	    if (string[2] != 0) {

 		goto error;

 	    }

 	} else if (string[1] != 0) {

 	    goto error;

 	}

         return mode;

     }

     /*

      * The access modes are specified using a list of POSIX modes

      * such as O_CREAT.

      *

      * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when

      * a NULL interpreter is passed in.

      */

     if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {

         if (interp != (Tcl_Interp *) NULL) {

             Tcl_AddErrorInfo(interp,

                     "\n    while processing open access modes \"");

             Tcl_AddErrorInfo(interp, string);

             Tcl_AddErrorInfo(interp, "\"");

         }

         return -1;

     }

     gotRW = 0;

     for (i = 0; i < modeArgc; i++) {

 	flag = modeArgv[i];

 	c = flag[0];

 	if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {

 	    mode = (mode & ~RW_MODES) | O_RDONLY;

 	    gotRW = 1;

 	} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {

 	    mode = (mode & ~RW_MODES) | O_WRONLY;

 	    gotRW = 1;

 	} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {

 	    mode = (mode & ~RW_MODES) | O_RDWR;

 	    gotRW = 1;

 	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {

 	    mode |= O_APPEND;

             *seekFlagPtr = 1;

 	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {

 	    mode |= O_CREAT;

 	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {

 	    mode |= O_EXCL;

 	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {

 #ifdef O_NOCTTY

 	    mode |= O_NOCTTY;

 #else

 	    if (interp != (Tcl_Interp *) NULL) {

                 Tcl_AppendResult(interp, "access mode \"", flag,

                         "\" not supported by this system", (char *) NULL);

             }

             ckfree((char *) modeArgv);

 	    return -1;

 #endif

 	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {

 #if defined(O_NDELAY) || defined(O_NONBLOCK)

 #   ifdef O_NONBLOCK

 	    mode |= O_NONBLOCK;

 #   else

 	    mode |= O_NDELAY;

 #   endif

 #else

             if (interp != (Tcl_Interp *) NULL) {

                 Tcl_AppendResult(interp, "access mode \"", flag,

                         "\" not supported by this system", (char *) NULL);

             }

             ckfree((char *) modeArgv);

 	    return -1;

 #endif

 	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {

 	    mode |= O_TRUNC;

 	} else {

             if (interp != (Tcl_Interp *) NULL) {

                 Tcl_AppendResult(interp, "invalid access mode \"", flag,

                         "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",

                         " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);

             }

 	    ckfree((char *) modeArgv);

 	    return -1;

 	}

     }

     ckfree((char *) modeArgv);

     if (!gotRW) {

         if (interp != (Tcl_Interp *) NULL) {

             Tcl_AppendResult(interp, "access mode must include either",

                     " RDONLY, WRONLY, or RDWR", (char *) NULL);

         }

 	return -1;

     }

     return mode;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSEvalFile --

  *

  *	Read in a file and process the entire file as one gigantic

  *	Tcl command.

  *

  * Results:

  *	A standard Tcl result, which is either the result of executing

  *	the 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 contents of the file, iPtr->scriptFile is made to

  *	point to pathPtr (the old value is cached and replaced when

  *	this function returns).

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_FSEvalFile(interp, pathPtr)

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

 {

     int result, length;

     Tcl_StatBuf statBuf;

     Tcl_Obj *oldScriptFile;

     Interp *iPtr;

     char *string;

     Tcl_Channel chan;

     Tcl_Obj *objPtr;

     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {

 	return TCL_ERROR;

     }

     result = TCL_ERROR;

     objPtr = Tcl_NewObj();

     Tcl_IncrRefCount(objPtr);

     if (Tcl_FSStat(pathPtr, &statBuf) == -1) {

         Tcl_SetErrno(errno);

 	Tcl_AppendResult(interp, "couldn't read file \"", 

 		Tcl_GetString(pathPtr),

 		"\": ", Tcl_PosixError(interp), (char *) 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);

 	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]

      */

     Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");

     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);

 	goto end;

     }

     if (Tcl_Close(interp, chan) != TCL_OK) {

         goto end;

     }

     iPtr = (Interp *) interp;

     oldScriptFile = iPtr->scriptFile;

     iPtr->scriptFile = pathPtr;

     Tcl_IncrRefCount(iPtr->scriptFile);

     string = Tcl_GetStringFromObj(objPtr, &length);

 #ifdef TCL_TIP280

     /* TIP #280 Force the evaluator to open a frame for a sourced

      * file. */

     iPtr->evalFlags |= TCL_EVAL_FILE;

 #endif

     result = Tcl_EvalEx(interp, string, length, 0);

     /* 

      * Now we have to be careful; the script may have changed the

      * iPtr->scriptFile value, so we must reset it without

      * assuming it still points to 'pathPtr'.

      */

     if (iPtr->scriptFile != NULL) {

 	Tcl_DecrRefCount(iPtr->scriptFile);

     }

     iPtr->scriptFile = oldScriptFile;

     if (result == TCL_RETURN) {

 	result = TclUpdateReturnInfo(iPtr);

     } else if (result == TCL_ERROR) {

 	char msg[200 + TCL_INTEGER_SPACE];

 	/*

 	 * Record information telling where the error occurred.

 	 */

 	sprintf(msg, "\n    (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),

 		interp->errorLine);

 	Tcl_AddErrorInfo(interp, msg);

     }

     end:

     Tcl_DecrRefCount(objPtr);

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetErrno --

  *

  *	Gets the current value of the Tcl error code variable. This is

  *	currently the global variable "errno" but could in the future

  *	change to something else.

  *

  * Results:

  *	The value of the Tcl error code variable.

  *

  * Side effects:

  *	None. Note that the value of the Tcl error code variable is

  *	UNDEFINED if a call to Tcl_SetErrno did not precede this call.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_GetErrno()

 {

     return errno;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetErrno --

  *

  *	Sets the Tcl error code variable to the supplied value.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Modifies the value of the Tcl error code variable.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetErrno(err)

     int err;			/* The new value. */

 {

     errno = err;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_PosixError --

  *

  *	This procedure is typically called after UNIX kernel calls

  *	return errors.  It stores machine-readable information about

  *	the error in $errorCode returns an information string for

  *	the caller's use.

  *

  * Results:

  *	The return value is a human-readable string describing the

  *	error.

  *

  * Side effects:

  *	The global variable $errorCode is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_PosixError(interp)

     Tcl_Interp *interp;		/* Interpreter whose $errorCode variable

 				 * is to be changed. */

 {

     CONST char *id, *msg;

     msg = Tcl_ErrnoMsg(errno);

     id = Tcl_ErrnoId();

     if (interp) {

 	Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);

     }

     return msg;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSStat --

  *

  *	This procedure replaces the library version of stat and lsat.

  *	

  *	The appropriate function for the filesystem to which pathPtr

  *	belongs will be called.

  *

  * Results:

  *      See stat documentation.

  *

  * Side effects:

  *      See stat documentation.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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_Filesystem *fsPtr;

 #ifdef USE_OBSOLETE_FS_HOOKS

     struct stat oldStyleStatBuffer;

     int retVal = -1;

     /*

      * Call each of the "stat" function in succession.  A non-return

      * value of -1 indicates the particular function has succeeded.

      */

     Tcl_MutexLock(&obsoleteFsHookMutex);

     if (statProcList != NULL) {

 	StatProc *statProcPtr;

 	char *path;

 	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

 	if (transPtr == NULL) {

 	    path = NULL;

 	} else {

 	    path = Tcl_GetString(transPtr);

 	}

 	statProcPtr = statProcList;

 	while ((retVal == -1) && (statProcPtr != NULL)) {

 	    retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);

 	    statProcPtr = statProcPtr->nextPtr;

 	}

 	if (transPtr != NULL) {

 	    Tcl_DecrRefCount(transPtr);

 	}

     }

     Tcl_MutexUnlock(&obsoleteFsHookMutex);

     if (retVal != -1) {

 	/*

 	 * Note that EOVERFLOW is not a problem here, and these

 	 * assignments should all be widening (if not identity.)

 	 */

 	buf->st_mode = oldStyleStatBuffer.st_mode;

 	buf->st_ino = oldStyleStatBuffer.st_ino;

 	buf->st_dev = oldStyleStatBuffer.st_dev;

 	buf->st_rdev = oldStyleStatBuffer.st_rdev;

 	buf->st_nlink = oldStyleStatBuffer.st_nlink;

 	buf->st_uid = oldStyleStatBuffer.st_uid;

 	buf->st_gid = oldStyleStatBuffer.st_gid;

 	buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);

 	buf->st_atime = oldStyleStatBuffer.st_atime;

 	buf->st_mtime = oldStyleStatBuffer.st_mtime;

 	buf->st_ctime = oldStyleStatBuffer.st_ctime;

 #ifdef HAVE_ST_BLOCKS

 	buf->st_blksize = oldStyleStatBuffer.st_blksize;

 	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);

 #endif

         return retVal;

     }

 #endif /* USE_OBSOLETE_FS_HOOKS */

     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSStatProc *proc = fsPtr->statProc;

 	if (proc != NULL) {

 	    return (*proc)(pathPtr, buf);

 	}

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSLstat --

  *

  *	This procedure 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.

  *

  * Results:

  *      See lstat documentation.

  *

  * Side effects:

  *      See lstat documentation.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSLstatProc *proc = fsPtr->lstatProc;

 	if (proc != NULL) {

 	    return (*proc)(pathPtr, buf);

 	} else {

 	    Tcl_FSStatProc *sproc = fsPtr->statProc;

 	    if (sproc != NULL) {

 		return (*sproc)(pathPtr, buf);

 	    }

 	}

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSAccess --

  *

  *	This procedure replaces the library version of access.

  *	The appropriate function for the filesystem to which pathPtr

  *	belongs will be called.

  *

  * Results:

  *      See access documentation.

  *

  * Side effects:

  *      See access documentation.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_FSAccess(pathPtr, mode)

     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.

      */

     Tcl_MutexLock(&obsoleteFsHookMutex);

     if (accessProcList != NULL) {

 	AccessProc *accessProcPtr;

 	char *path;

 	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

 	if (transPtr == NULL) {

 	    path = NULL;

 	} else {

 	    path = Tcl_GetString(transPtr);

 	}

 	accessProcPtr = accessProcList;

 	while ((retVal == -1) && (accessProcPtr != NULL)) {

 	    retVal = (*accessProcPtr->proc)(path, mode);

 	    accessProcPtr = accessProcPtr->nextPtr;

 	}

 	if (transPtr != NULL) {

 	    Tcl_DecrRefCount(transPtr);

 	}

     }

     Tcl_MutexUnlock(&obsoleteFsHookMutex);

     if (retVal != -1) {

 	return retVal;

     }

 #endif /* USE_OBSOLETE_FS_HOOKS */

     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSAccessProc *proc = fsPtr->accessProc;

 	if (proc != NULL) {

 	    return (*proc)(pathPtr, mode);

 	}

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSOpenFileChannel --

  *

  *	The appropriate function for the filesystem to which pathPtr

  *	belongs will be called.

  *

  * Results:

  *	The new channel or NULL, if the named file could not be opened.

  *

  * Side effects:

  *	May open the channel and may cause creation of a file on the

  *	file system.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)

     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 as "rw". */

     int permissions;                    /* If the open involves creating a

                                          * file, with what modes to create

                                          * it? */

 {

     Tcl_Filesystem *fsPtr;

 #ifdef USE_OBSOLETE_FS_HOOKS

     Tcl_Channel retVal = NULL;

     /*

      * Call each of the "Tcl_OpenFileChannel" functions in succession.

      * A non-NULL return value indicates the particular function has

      * succeeded.

      */

     Tcl_MutexLock(&obsoleteFsHookMutex);

     if (openFileChannelProcList != NULL) {

 	OpenFileChannelProc *openFileChannelProcPtr;

 	char *path;

 	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

 	if (transPtr == NULL) {

 	    path = NULL;

 	} else {

 	    path = Tcl_GetString(transPtr);

 	}

 	openFileChannelProcPtr = openFileChannelProcList;

 	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {

 	    retVal = (*openFileChannelProcPtr->proc)(interp, path,

 						     modeString, permissions);

 	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;

 	}

 	if (transPtr != NULL) {

 	    Tcl_DecrRefCount(transPtr);

 	}

     }

     Tcl_MutexUnlock(&obsoleteFsHookMutex);

     if (retVal != NULL) {

 	return retVal;

     }

 #endif /* USE_OBSOLETE_FS_HOOKS */

     /* 

      * We need this just to ensure we return the correct error messages

      * under some circumstances.

      */

     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {

         return NULL;

     }

     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;

 	if (proc != NULL) {

 	    int mode, seekFlag;

 	    mode = TclGetOpenMode(interp, modeString, &seekFlag);

 	    if (mode == -1) {

 	        return NULL;

 	    }

 	    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;

 		    }

 		}

 	    }

 	    return retVal;

 	}

     }

     /* File doesn't belong to any filesystem that can open it */

     Tcl_SetErrno(ENOENT);

     if (interp != NULL) {

 	Tcl_AppendResult(interp, "couldn't open \"", 

 			 Tcl_GetString(pathPtr), "\": ",

 			 Tcl_PosixError(interp), (char *) NULL);

     }

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSUtime --

  *

  *	This procedure replaces the library version of utime.

  *	The appropriate function for the filesystem to which pathPtr

  *	belongs will be called.

  *

  * Results:

  *      See utime documentation.

  *

  * Side effects:

  *      See utime documentation.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;

 	if (proc != NULL) {

 	    return (*proc)(pathPtr, tval);

 	}

     }

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * NativeFileAttrStrings --

  *

  *	This procedure 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 support, and is placed here because

  *	it is shared by Unix, MacOS and Windows code.

  *

  * Results:

  *      An array of strings

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 static CONST char**

 NativeFileAttrStrings(pathPtr, objPtrRef)

     Tcl_Obj *pathPtr;

     Tcl_Obj** objPtrRef;

 {

     return tclpFileAttrStrings;

 }

 /*

  *----------------------------------------------------------------------

  *

  * NativeFileAttrsGet --

  *

  *	This procedure 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, MacOS 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 refCount to ensure it is properly

  *      freed.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

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

 {

     return (*tclpFileAttrProcs[index].getProc)(interp, index, 

 					       pathPtr, objPtrRef);

 }

 /*

  *----------------------------------------------------------------------

  *

  * NativeFileAttrsSet --

  *

  *	This procedure 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, MacOS and Windows code.

  *

  * Results:

  *      Standard Tcl return code.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

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

 {

     return (*tclpFileAttrProcs[index].setProc)(interp, index,

 					       pathPtr, objPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSFileAttrStrings --

  *

  *	This procedure 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 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 if the list should be

  *      disposed of by Tcl when done, it should have a refCount of zero,

  *      and if the list should not be disposed of, the filesystem

  *      should ensure it retains a refCount on the object.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char **

 Tcl_FSFileAttrStrings(pathPtr, objPtrRef)

     Tcl_Obj* pathPtr;

     Tcl_Obj** objPtrRef;

 {

     Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;

 	if (proc != NULL) {

 	    return (*proc)(pathPtr, objPtrRef);

 	}

     }

     Tcl_SetErrno(ENOENT);

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

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

  *

  * 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 refCount to ensure it is properly

  *      freed.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;

 	if (proc != NULL) {

 	    return (*proc)(interp, index, pathPtr, objPtrRef);

 	}

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

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

  *

  * Results:

  *      Standard Tcl return code.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

     if (fsPtr != NULL) {

 	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;

 	if (proc != NULL) {

 	    return (*proc)(interp, index, pathPtr, objPtr);

 	}

     }

     Tcl_SetErrno(ENOENT);

     return -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FSGetCwd --

  *

  *	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).

  *	

  *	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 therefore ensure they only access the cwd through this

  *	function to avoid confusion.

  *	

  *	If a global cwdPathPtr already exists, it is cached in the thread's

  *	private data structures and reference to the cached copy is returned,

  *	subject to a synchronisation attempt in that cwdPathPtr's fs.

  *	

  *	Otherwise, the chain of functions that have been "inserted"

  *	into the filesystem will be called in succession until either a

  *	value other than NULL is returned, or the entire list is

  *	visited.

  *

  * 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 returned, an error message is left in the

  *	interp's result.  

  *	

  *	The result already has its refCount incremented for the caller.

  *	When it is no longer needed, that refCount should be decremented.

  *

  * Side effects:

  *	Various objects may be freed and allocated.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj*

 Tcl_FSGetCwd(interp)

     Tcl_Interp *interp;

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if (TclFSCwdPointerEquals(NULL)) {

 	FilesystemRecord *fsRecPtr;

 	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 indicates the particular function has

 	 * succeeded.

 	 */

 	fsRecPtr = FsGetFirstFilesystem();

 	while ((retVal == NULL) && (fsRecPtr != NULL)) {

 	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;

 	    if (proc != NULL) {

 		retVal = (*proc)(interp);

 	    }

 	    fsRecPtr = fsRecPtr->nextPtr;

 	}

 	/* 

 	 * Now the 'cwd' may NOT be normalized, at least on some

 	 * platforms.  For the sake of efficiency, we want a completely

 	 * normalized cwd at all times.

 	 * 

 	 * Finally, if retVal is NULL, we do not have a cwd, which

 	 * could be problematic.

 	 */

 	if (retVal != NULL) {

 	    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.

 		 * 

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

 		 */

 		FsUpdateCwd(norm);

 		Tcl_DecrRefCount(norm);

 	    }

 	    Tcl_DecrRefCount(retVal);

 	}

     } else {

 	/* 

 	 * 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, the permissions on

 	 * that directory have changed.

 	 */

 	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);

 	/* 

 	 * 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 cwd change, 'pwd' does actually

 	 * throw the correct error in Tcl.  (This is tested for in the

 	 * test suite on unix).

 	 */

 	if (fsPtr != NULL) {

 	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;

 	    if (proc != NULL) {

 		Tcl_Obj *retVal = (*proc)(interp);

 		if (retVal != NULL) {

 		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);

 		    /* 

 		     * Check whether cwd has changed from the value

 		     * previously stored in cwdPathPtr.  Really 'norm'

 		     * shouldn't be null, but we are careful.

 		     */

 		    if (norm == NULL) {

 			/* Do nothing */

 		    } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {

 			/* 

 			 * 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 we can simply free the normalized

 			 * path we just calculated.

 			 */

 			Tcl_DecrRefCount(norm);

 		    } else {

 			FsUpdateCwd(norm);

 			Tcl_DecrRefCount(norm);

 		    }

 		    Tcl_DecrRefCount(retVal);

 		} else {

 		    /* The 'cwd' function returned an error; reset the cwd */

 		    FsUpdateCwd(NULL);

 		}

 	    }

 	}

     }

     if (tsdPtr->cwdPathPtr != NULL) {

 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);

     }

     return tsdPtr->cwdPathPtr; 

 }

 /*

  *----------------------------------------------------------------------