/* 
 * 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.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) Id
 */

#include "tclInt.h"
#include "tclPort.h"
#ifdef MAC_TCL
#include "tclMacInt.h"
#endif
#ifdef __WIN32__
/* for tclWinProcs->useWide */
#include "tclWinInt.h"
#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
 */
Tcl_PathType     FSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
          Tcl_Filesystem **filesystemPtrPtr, 
          int *driveNameLengthPtr));
Tcl_PathType     GetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
          Tcl_Filesystem **filesystemPtrPtr, 
          int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
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 */
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 */
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 */
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 */
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 */
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 */
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;
Tcl_FSDupInternalRepProc NativeDupInternalRep;
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,
    &NativeDupInternalRep,
    &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)

/* 
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 */
static Tcl_Obj* cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
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;

static Tcl_ThreadDataKey dataKey;

/* 
 * 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);
    }
    /* Trash the filesystems cache */
    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
  tmpFsRecPtr = fsRecPtr->nextPtr;
  if (--fsRecPtr->fileRefCount <= 0) {
      ckfree((char *)fsRecPtr);
  }
  fsRecPtr = tmpFsRecPtr;
    }
}

int 
TclFSCwdPointerEquals(objPtr)
    Tcl_Obj* objPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_MutexLock(&cwdMutex);
    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);
  }
    }
    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 (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;
    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 (cwdPathPtr != NULL) {
  Tcl_DecrRefCount(cwdPathPtr);
  cwdPathPtr = NULL;
        cwdPathEpoch = 0;
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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; 
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSChdir --
 *
 *  This function replaces the library version of chdir().
 *  
 *  The path is normalized and then passed to the filesystem
 *  which claims it.
 *
 * Results:
 *  See chdir() documentation.  If successful, we keep a 
 *  record of the successful path in cwdPathPtr for subsequent 
 *  calls to getcwd.
 *
 * Side effects:
 *  See chdir() documentation.  The global cwdPathPtr may 
 *  change value.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_FSChdir(pathPtr)
    Tcl_Obj *pathPtr;
{
    Tcl_Filesystem *fsPtr;
    int retVal = -1;
    
#ifdef WIN32
    /*
     * This complete hack addresses the bug tested in winFCmd-16.12,
     * where having your HOME as "C:" (IOW, a seemingly path relative
     * dir) would cause a crash when you cd'd to it and requested 'pwd'.
     * The work-around is to force such a dir into an absolute path by
     * tacking on '/'.
     *
     * We check for '~' specifically because that's what Tcl_CdObjCmd
     * passes in that triggers the bug.  A direct 'cd C:' call will not
     * because that gets the volumerelative pwd.
     *
     * This is not an issue for 8.5 as that has a more elaborate change
     * that requires the use of TCL_FILESYSTEM_VERSION_2.
     */
    Tcl_Obj *objPtr = NULL;
    if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') {
  int len;
  char *str;

  objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
  if (objPtr == NULL) {
      Tcl_SetErrno(ENOENT);
      return -1;
  }
  Tcl_IncrRefCount(objPtr);
  str = Tcl_GetStringFromObj(objPtr, &len);
  if (len == 2 && str[1] == ':') {
      pathPtr = Tcl_NewStringObj(str, len);
      Tcl_AppendToObj(pathPtr, "/", 1);
      Tcl_IncrRefCount(pathPtr);
      Tcl_DecrRefCount(objPtr);
      objPtr = pathPtr;
  } else {
      Tcl_DecrRefCount(objPtr);
      objPtr = NULL;
  }
    }
#endif
    if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
#ifdef WIN32
  if (objPtr) { Tcl_DecrRefCount(objPtr); }
#endif
  Tcl_SetErrno(ENOENT);
        return -1;
    }
    
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSChdirProc *proc = fsPtr->chdirProc;
  if (proc != NULL) {
      retVal = (*proc)(pathPtr);
  } else {
      /* Fallback on stat-based implementation */
      Tcl_StatBuf buf;
      /* If the file can be stat'ed and is a directory and
       * is readable, then we can chdir. */
      if ((Tcl_FSStat(pathPtr, &buf) == 0) 
        && (S_ISDIR(buf.st_mode))
        && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
    /* We allow the chdir */
    retVal = 0;
      }
  }
    }

    if (retVal != -1) {
  /* 
   * The cwd changed, or an error was thrown.  If an error was
   * thrown, we can just continue (and that will report the error
   * to the user).  If there was no error we must assume that the
   * cwd was actually changed to the normalized value we
   * calculated above, and we must therefore cache that
   * information.
   */
  if (retVal == 0) {
      /* 
       * Note that this normalized path may be different to what
       * we found above (or at least a different object), if the
       * filesystem epoch changed recently.  This can actually
       * happen with scripted documents very easily.  Therefore
       * we ask for the normalized path again (the correct value
       * will have been cached as a result of the
       * Tcl_FSGetFileSystemForPath call above anyway).
       */
      Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
      if (normDirName == NULL) {
#ifdef WIN32
    if (objPtr) { Tcl_DecrRefCount(objPtr); }
#endif
    Tcl_SetErrno(ENOENT);
          return -1;
      }
      FsUpdateCwd(normDirName);
  }
    } else {
  Tcl_SetErrno(ENOENT);
    }
    
#ifdef WIN32
    if (objPtr) { Tcl_DecrRefCount(objPtr); }
#endif
    return (retVal);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLoadFile --
 *
 *  Dynamically loads a binary code file into memory and returns
 *  the addresses of two procedures within that file, if they are
 *  defined.  The appropriate function for the filesystem to which
 *  pathPtr belongs will be called.
 *  
 *  Note that the native filesystem doesn't actually assume
 *  'pathPtr' is a path.  Rather it assumes filename is either
 *  a path or just the name of a file which can be found somewhere
 *  in the environment's loadable path.  This behaviour is not
 *  very compatible with virtual filesystems (and has other problems
 *  documented in the load man-page), so it is advised that full
 *  paths are always used.
 *
 * Results:
 *  A standard Tcl completion code.  If an error occurs, an error
 *  message is left in the interp's result.
 *
 * Side effects:
 *  New code suddenly appears in memory.  This may later be
 *  unloaded by passing the clientData to the unloadProc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
         handlePtr, unloadProcPtr)
    Tcl_Interp *interp;    /* Used for error reporting. */
    Tcl_Obj *pathPtr;    /* Name of the file containing the desired
         * code. */
    CONST char *sym1, *sym2;  /* Names of two procedures to look up in
         * the file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
        /* Where to return the addresses corresponding
         * to sym1 and sym2. */
    Tcl_LoadHandle *handlePtr;  /* Filled with token for dynamically loaded
         * file which will be passed back to 
         * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr;  
                                /* Filled with address of Tcl_FSUnloadFileProc
                                 * function which should be used for
                                 * this file. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
  if (proc != NULL) {
      int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
      if (retVal != TCL_OK) {
    return retVal;
      }
      if (*handlePtr == NULL) {
    return TCL_ERROR;
      }
      if (sym1 != NULL) {
          *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
      }
      if (sym2 != NULL) {
          *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
      }
      return retVal;
  } else {
      Tcl_Filesystem *copyFsPtr;
      Tcl_Obj *copyToPtr;
      
      /* First check if it is readable -- and exists! */
      if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
    Tcl_AppendResult(interp, "couldn't load library \"",
         Tcl_GetString(pathPtr), "\": ", 
         Tcl_PosixError(interp), (char *) NULL);
    return TCL_ERROR;
      }
      
#ifdef TCL_LOAD_FROM_MEMORY
  /* 
   * The platform supports loading code from memory, so ask for a
   * buffer of the appropriate size, read the file into it and 
   * load the code from the buffer:
   */
  do {
            int ret, size;
            void *buffer;
            Tcl_StatBuf statBuf;
            Tcl_Channel data;
            
            ret = Tcl_FSStat(pathPtr, &statBuf);
            if (ret < 0) {
                break;
            }
            size = (int) statBuf.st_size;
            /* Tcl_Read takes an int: check that file size isn't wide */
            if (size != (Tcl_WideInt)statBuf.st_size) {
                break;
            }
      data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
            if (!data) {
                break;
            }
            buffer = TclpLoadMemoryGetBuffer(interp, size);
            if (!buffer) {
                Tcl_Close(interp, data);
                break;
            }
            Tcl_SetChannelOption(interp, data, "-translation", "binary");
            ret = Tcl_Read(data, buffer, size);
            Tcl_Close(interp, data);
            ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr);
            if (ret == TCL_OK) {
    if (*handlePtr == NULL) {
        break;
    }
                if (sym1 != NULL) {
                    *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
                }
                if (sym2 != NULL) {
                    *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
                }
    return TCL_OK;
      }
  } while (0); 
  Tcl_ResetResult(interp);
#endif

      /* 
       * Get a temporary filename to use, first to
       * copy the file into, and then to load. 
       */
      copyToPtr = TclpTempFileName();
      if (copyToPtr == NULL) {
          return -1;
      }
      Tcl_IncrRefCount(copyToPtr);
      
      copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
      if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
    /* 
     * We already know we can't use Tcl_FSLoadFile from 
     * this filesystem, and we must avoid a possible
     * infinite loop.  Try to delete the file we
     * probably created, and then exit.
     */
    Tcl_FSDeleteFile(copyToPtr);
    Tcl_DecrRefCount(copyToPtr);
    return -1;
      }
      
      if (TclCrossFilesystemCopy(interp, pathPtr, 
               copyToPtr) == TCL_OK) {
    Tcl_LoadHandle newLoadHandle = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;

#if !defined(__WIN32__) && !defined(MAC_TCL)
    /* 
     * Do we need to set appropriate permissions 
     * on the file?  This may be required on some
     * systems.  On Unix we could loop over
     * the file attributes, and set any that are
     * called "-permissions" to 0700.  However,
     * we just do this directly, like this:
     */
    
    Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
    Tcl_IncrRefCount(perm);
    Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
    Tcl_DecrRefCount(perm);
#endif
    
    /* 
     * We need to reset the result now, because the cross-
     * filesystem copy may have stored the number of bytes
     * in the result
     */
    Tcl_ResetResult(interp);
    
    retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2,
          proc1Ptr, proc2Ptr, 
          &newLoadHandle,
          &newUnloadProcPtr);
          if (retVal != TCL_OK) {
        /* The file didn't load successfully */
        Tcl_FSDeleteFile(copyToPtr);
        Tcl_DecrRefCount(copyToPtr);
        return retVal;
    }
    /* 
     * Try to delete the file immediately -- this is
     * possible in some OSes, and avoids any worries
     * about leaving the copy laying around on exit. 
     */
    if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
        Tcl_DecrRefCount(copyToPtr);
        /* 
         * We tell our caller about the real shared
         * library which was loaded.  Note that this
         * does mean that the package list maintained
         * by 'load' will store the original (vfs)
         * path alongside the temporary load handle
         * and unload proc ptr.
         */
        (*handlePtr) = newLoadHandle;
        (*unloadProcPtr) = newUnloadProcPtr;
        return TCL_OK;
    }
    /* 
     * When we unload this file, we need to divert the 
     * unloading so we can unload and cleanup the 
     * temporary file correctly.
     */
    tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));

    /* 
     * Remember three pieces of information.  This allows
     * us to cleanup the diverted load completely, on
     * platforms which allow proper unloading of code.
     */
    tvdlPtr->loadHandle = newLoadHandle;
    tvdlPtr->unloadProcPtr = newUnloadProcPtr;

    if (copyFsPtr != &tclNativeFilesystem) {
        /* copyToPtr is already incremented for this reference */
        tvdlPtr->divertedFile = copyToPtr;

        /* 
         * This is the filesystem we loaded it into.  Since
         * we have a reference to 'copyToPtr', we already
         * have a refCount on this filesystem, so we don't
         * need to worry about it disappearing on us.
         */
        tvdlPtr->divertedFilesystem = copyFsPtr;
        tvdlPtr->divertedFileNativeRep = NULL;
    } else {
        /* We need the native rep */
        tvdlPtr->divertedFileNativeRep = 
          NativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr, 
                copyFsPtr));
        /* 
         * We don't need or want references to the copied
         * Tcl_Obj or the filesystem if it is the native
         * one.
         */
        tvdlPtr->divertedFile = NULL;
        tvdlPtr->divertedFilesystem = NULL;
        Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;
    (*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
    (*unloadProcPtr) = &FSUnloadTempFile;
    return retVal;
      } else {
    /* Cross-platform copy failed */
    Tcl_FSDeleteFile(copyToPtr);
    Tcl_DecrRefCount(copyToPtr);
    return TCL_ERROR;
      }
  }
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}
/* 
 * This function used to be in the platform specific directories, but it
 * has now been made to work cross-platform
 */
int
TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
       clientDataPtr, unloadProcPtr)
    Tcl_Interp *interp;    /* Used for error reporting. */
    Tcl_Obj *pathPtr;    /* Name of the file containing the desired
         * code (UTF-8). */
    CONST char *sym1, *sym2;  /* Names of two procedures to look up in
         * the file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
        /* Where to return the addresses corresponding
         * to sym1 and sym2. */
    ClientData *clientDataPtr;  /* Filled with token for dynamically loaded
         * file which will be passed back to 
         * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr;  
        /* Filled with address of Tcl_FSUnloadFileProc
         * function which should be used for
         * this file. */
{
    Tcl_LoadHandle handle = NULL;
    int res;
    
    res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
    
    if (res != TCL_OK) {
        return res;
    }

    if (handle == NULL) {
  return TCL_ERROR;
    }
    
    *clientDataPtr = (ClientData)handle;
    
    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * FSUnloadTempFile --
 *
 *  This function is called when we loaded a library of code via
 *  an intermediate temporary file.  This function ensures
 *  the library is correctly unloaded and the temporary file
 *  is correctly deleted.
 *
 * Results:
 *  None.
 *
 * Side effects:
 *  The effects of the 'unload' function called, and of course
 *  the temporary file will be deleted.
 *
 *---------------------------------------------------------------------------
 */
static void 
FSUnloadTempFile(loadHandle)
    Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
             * to Tcl_FSLoadFile().  The loadHandle is 
             * a token that represents the loaded 
             * file. */
{
    FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
    /* 
     * This test should never trigger, since we give
     * the client data in the function above.
     */
    if (tvdlPtr == NULL) { return; }
    
    /* 
     * Call the real 'unloadfile' proc we actually used. It is very
     * important that we call this first, so that the shared library
     * is actually unloaded by the OS.  Otherwise, the following
     * 'delete' may well fail because the shared library is still in
     * use.
     */
    if (tvdlPtr->unloadProcPtr != NULL) {
  (*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
    }
    
    if (tvdlPtr->divertedFilesystem == NULL) {
  /* 
   * It was the native filesystem, and we have a special
   * function available just for this purpose, which we 
   * know works even at this late stage.
   */
  TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
  NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
    } else {
  /* 
   * Remove the temporary file we created.  Note, we may crash
   * here because encodings have been taken down already.
   */
  if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
      != TCL_OK) {
      /* 
       * The above may have failed because the filesystem, or something
       * it depends upon (e.g. encodings) have been taken down because
       * Tcl is exiting.
       * 
       * We may need to work out how to delete this file more
       * robustly (or give the filesystem the information it needs
       * to delete the file more robustly).
       * 
       * In particular, one problem might be that the filesystem
       * cannot extract the information it needs from the above
       * path object because Tcl's entire filesystem apparatus
       * (the code in this file) has been finalized, and it
       * refuses to pass the internal representation to the
       * filesystem.
       */
  }
  
  /* 
   * And free up the allocations.  This will also of course remove
   * a refCount from the Tcl_Filesystem to which this file belongs,
   * which could then free up the filesystem if we are exiting.
   */
  Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree((char*)tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
 *  This function replaces the library version of readlink() and
 *  can also be used to make links.  The appropriate function for
 *  the filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *      If toPtr is NULL, then the result is a Tcl_Obj specifying the 
 *      contents of the symbolic link given by 'pathPtr', or NULL if
 *      the symbolic link could not be read.  The result is owned by
 *      the caller, which should call Tcl_DecrRefCount when the result
 *      is no longer needed.
 *      
 *      If toPtr is non-NULL, then the result is toPtr if the link action
 *      was successful, or NULL if not.  In this case the result has no
 *      additional reference count, and need not be freed.  The actual
 *      action to perform is given by the 'linkAction' flags, which is
 *      an or'd combination of:
 *      
 *        TCL_CREATE_SYMBOLIC_LINK
 *        TCL_CREATE_HARD_LINK
 *      
 *      Note that most filesystems will not support linking across
 *      to different filesystems, so this function will usually
 *      fail unless toPtr is in the same FS as pathPtr.
 *      
 * Side effects:
 *  See readlink() documentation.  A new filesystem link 
 *  object may appear
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSLink(pathPtr, toPtr, linkAction)
    Tcl_Obj *pathPtr;    /* Path of file to readlink or link */
    Tcl_Obj *toPtr;    /* NULL or path to be linked to */
    int linkAction;             /* Action to perform */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSLinkProc *proc = fsPtr->linkProc;
  if (proc != NULL) {
      return (*proc)(pathPtr, toPtr, linkAction);
  }
    }
    /*
     * If S_IFLNK isn't defined it means that the machine doesn't
     * support symbolic links, so the file can't possibly be a
     * symbolic link.  Generate an EINVAL error, which is what
     * happens on machines that do support symbolic links when
     * you invoke readlink on a file that isn't a symbolic link.
     */
#ifndef S_IFLNK
    errno = EINVAL;
#else
    Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSListVolumes --
 *
 *  Lists the currently mounted volumes.  The chain of functions
 *  that have been "inserted" into the filesystem will be called in
 *  succession; each may return a list of volumes, all of which are
 *  added to the result until all mounted file systems are listed.
 *  
 *  Notice that we assume the lists returned by each filesystem
 *  (if non NULL) have been given a refCount for us already.
 *  However, we are NOT allowed to hang on to the list itself
 *  (it belongs to the filesystem we called).  Therefore we
 *  quite naturally add its contents to the result we are
 *  building, and then decrement the refCount.
 *
 * Results:
 *  The list of volumes, in an object which has refCount 0.
 *
 * Side effects:
 *  None
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
Tcl_FSListVolumes(void)
{
    FilesystemRecord *fsRecPtr;
    Tcl_Obj *resultPtr = Tcl_NewObj();
    
    /*
     * Call each of the "listVolumes" function in succession.
     * A non-NULL return value indicates the particular function has
     * succeeded.  We call all the functions registered, since we want
     * a list of all drives from all filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
  Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
  if (proc != NULL) {
      Tcl_Obj *thisFsVolumes = (*proc)();
      if (thisFsVolumes != NULL) {
    Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
    Tcl_DecrRefCount(thisFsVolumes);
      }
  }
  fsRecPtr = fsRecPtr->nextPtr;
    }
    
    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * FsListMounts --
 *
 *  List all mounts within the given directory, which match the
 *  given pattern.
 *
 * Results:
 *  The list of mounts, in a list object which has refCount 0, or
 *  NULL if we didn't even find any filesystems to try to list
 *  mounts.
 *
 * Side effects:
 *  None
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Obj*
FsListMounts(pathPtr, pattern)
    Tcl_Obj *pathPtr;          /* Contains path to directory to search. */
    CONST char *pattern;  /* Pattern to match against. */
{
    FilesystemRecord *fsRecPtr;
    Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
    Tcl_Obj *resultPtr = NULL;
    
    /*
     * Call each of the "listMounts" functions in succession.
     * A non-NULL return value indicates the particular function has
     * succeeded.  We call all the functions registered, since we want
     * a list from each filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
  if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
      Tcl_FSMatchInDirectoryProc *proc = 
          fsRecPtr->fsPtr->matchInDirectoryProc;
      if (proc != NULL) {
    if (resultPtr == NULL) {
        resultPtr = Tcl_NewObj();
    }
    (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
      }
  }
  fsRecPtr = fsRecPtr->nextPtr;
    }
    
    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSSplitPath --
 *
 *      This function takes the given Tcl_Obj, which should be a valid
 *      path, and returns a Tcl List object containing each segment of
 *      that path as an element.
 *
 * Results:
 *      Returns list object with refCount of zero.  If the passed in
 *      lenPtr is non-NULL, we use it to return the number of elements
 *      in the returned list.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSSplitPath(pathPtr, lenPtr)
    Tcl_Obj *pathPtr;    /* Path to split. */
    int *lenPtr;    /* int to store number of path elements. */
{
    Tcl_Obj *result = NULL;  /* Needed only to prevent gcc warnings. */
    Tcl_Filesystem *fsPtr;
    char separator = '/';
    int driveNameLength;
    char *p;
    
    /*
     * Perform platform specific splitting. 
     */

    if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength) 
  == TCL_PATH_ABSOLUTE) {
  if (fsPtr == &tclNativeFilesystem) {
      return TclpNativeSplitPath(pathPtr, lenPtr);
  }
    } else {
  return TclpNativeSplitPath(pathPtr, lenPtr);
    }

    /* We assume separators are single characters */
    if (fsPtr->filesystemSeparatorProc != NULL) {
  Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
  if (sep != NULL) {
      separator = Tcl_GetString(sep)[0];
  }
    }
    
    /* 
     * Place the drive name as first element of the
     * result list.  The drive name may contain strange
     * characters, like colons and multiple forward slashes
     * (for example 'ftp://' is a valid vfs drive name)
     */
    result = Tcl_NewObj();
    p = Tcl_GetString(pathPtr);
    Tcl_ListObjAppendElement(NULL, result, 
           Tcl_NewStringObj(p, driveNameLength));
    p+= driveNameLength;
          
    /* Add the remaining path elements to the list */
    for (;;) {
  char *elementStart = p;
  int length;
  while ((*p != '\0') && (*p != separator)) {
      p++;
  }
  length = p - elementStart;
  if (length > 0) {
      Tcl_Obj *nextElt;
      if (elementStart[0] == '~') {
    nextElt = Tcl_NewStringObj("./",2);
    Tcl_AppendToObj(nextElt, elementStart, length);
      } else {
    nextElt = Tcl_NewStringObj(elementStart, length);
      }
      Tcl_ListObjAppendElement(NULL, result, nextElt);
  }
  if (*p++ == '\0') {
      break;
  }
    }
           
    /*
     * Compute the number of elements in the result.
     */

    if (lenPtr != NULL) {
  Tcl_ListObjLength(NULL, result, lenPtr);
    }
    return result;
}

/* Simple helper function */
Tcl_Obj* 
TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
    Tcl_Filesystem *fromFilesystem;
    ClientData clientData;
    FilesystemRecord **fsRecPtrPtr;
{
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
  if (fsRecPtr->fsPtr == fromFilesystem) {
      *fsRecPtrPtr = fsRecPtr;
      break;
  }
  fsRecPtr = fsRecPtr->nextPtr;
    }
    
    if ((fsRecPtr != NULL) 
      && (fromFilesystem->internalToNormalizedProc != NULL)) {
  return (*fromFilesystem->internalToNormalizedProc)(clientData);
    } else {
  return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetPathType --
 *
 *  Helper function used by FSGetPathType.
 *
 * Results:
 *  Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *  TCL_PATH_VOLUME_RELATIVE.  The filesystem reference will
 *  be set if and only if it is non-NULL and the function's 
 *  return value is TCL_PATH_ABSOLUTE.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
    Tcl_Obj *pathObjPtr;
    Tcl_Filesystem **filesystemPtrPtr;
    int *driveNameLengthPtr;
    Tcl_Obj **driveNameRef;
{
    FilesystemRecord *fsRecPtr;
    int pathLen;
    char *path;
    Tcl_PathType type = TCL_PATH_RELATIVE;
    
    path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);

    /*
     * Call each of the "listVolumes" function in succession, checking
     * whether the given path is an absolute path on any of the volumes
     * returned (this is done by checking whether the path's prefix
     * matches).
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
  Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
  /* 
   * We want to skip the native filesystem in this loop because
   * otherwise we won't necessarily pass all the Tcl testsuite --
   * this is because some of the tests artificially change the
   * current platform (between mac, win, unix) but the list
   * of volumes we get by calling (*proc) will reflect the current
   * (real) platform only and this may cause some tests to fail.
   * In particular, on unix '/' will match the beginning of 
   * certain absolute Windows paths starting '//' and those tests
   * will go wrong.
   * 
   * Besides these test-suite issues, there is one other reason
   * to skip the native filesystem --- since the tclFilename.c
   * code has nice fast 'absolute path' checkers, we don't want
   * to waste time repeating that effort here, and this 
   * function is actually called quite often, so if we can
   * save the overhead of the native filesystem returning us
   * a list of volumes all the time, it is better.
   */
  if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
      int numVolumes;
      Tcl_Obj *thisFsVolumes = (*proc)();
      if (thisFsVolumes != NULL) {
    if (Tcl_ListObjLength(NULL, thisFsVolumes, 
              &numVolumes) != TCL_OK) {
        /* 
         * This is VERY bad; the Tcl_FSListVolumesProc
         * didn't return a valid list.  Set numVolumes to
         * -1 so that we skip the while loop below and just
         * return with the current value of 'type'.
         * 
         * It would be better if we could signal an error
         * here (but panic seems a bit excessive).
         */
        numVolumes = -1;
    }
    while (numVolumes > 0) {
        Tcl_Obj *vol;
        int len;
        char *strVol;

        numVolumes--;
        Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
        strVol = Tcl_GetStringFromObj(vol,&len);
        if (pathLen < len) {
      continue;
        }
        if (strncmp(strVol, path, (size_t) len) == 0) {
      type = TCL_PATH_ABSOLUTE;
      if (filesystemPtrPtr != NULL) {
          *filesystemPtrPtr = fsRecPtr->fsPtr;
      }
      if (driveNameLengthPtr != NULL) {
          *driveNameLengthPtr = len;
      }
      if (driveNameRef != NULL) {
          *driveNameRef = vol;
          Tcl_IncrRefCount(vol);
      }
      break;
        }
    }
    Tcl_DecrRefCount(thisFsVolumes);
    if (type == TCL_PATH_ABSOLUTE) {
        /* We don't need to examine any more filesystems */
        break;
    }
      }
  }
  fsRecPtr = fsRecPtr->nextPtr;
    }
    
    if (type != TCL_PATH_ABSOLUTE) {
  type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, 
             driveNameRef);
  if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
      *filesystemPtrPtr = &tclNativeFilesystem;
  }
    }
    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *  If the two paths given belong to the same filesystem, we call
 *  that filesystems rename function.  Otherwise we simply
 *  return the posix error 'EXDEV', and -1.
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *  A file may be renamed.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRenameFile(srcPathPtr, destPathPtr)
    Tcl_Obj* srcPathPtr;  /* Pathname of file or dir to be renamed
         * (UTF-8). */
    Tcl_Obj *destPathPtr;  /* New pathname of file or directory
         * (UTF-8). */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
  Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
  if (proc != NULL) {
      retVal =  (*proc)(srcPathPtr, destPathPtr);
  }
    }
    if (retVal == -1) {
  Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyFile --
 *
 *  If the two paths given belong to the same filesystem, we call
 *  that filesystem's copy function.  Otherwise we simply
 *  return the posix error 'EXDEV', and -1.
 *  
 *  Note that in the native filesystems, 'copyFileProc' is defined
 *  to copy soft links (i.e. it copies the links themselves, not
 *  the things they point to).
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *  A file may be copied.
 *
 *---------------------------------------------------------------------------
 */

int 
Tcl_FSCopyFile(srcPathPtr, destPathPtr)
    Tcl_Obj* srcPathPtr;  /* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *destPathPtr;  /* Pathname of file to copy to (UTF-8). */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
  Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
  if (proc != NULL) {
      retVal = (*proc)(srcPathPtr, destPathPtr);
  }
    }
    if (retVal == -1) {
  Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclCrossFilesystemCopy --
 *
 *  Helper for above function, and for Tcl_FSLoadFile, to copy
 *  files from one filesystem to another.  This function will
 *  overwrite the target file if it already exists.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  A file may be created.
 *
 *---------------------------------------------------------------------------
 */
int 
TclCrossFilesystemCopy(interp, source, target) 
    Tcl_Interp *interp; /* For error messages */
    Tcl_Obj *source;  /* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *target;  /* Pathname of file to copy to (UTF-8). */
{
    int result = TCL_ERROR;
    int prot = 0666;
    
    Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
    if (out != NULL) {
  /* It looks like we can copy it over */
  Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
                 "r", prot);
  if (in == NULL) {
      /* This is very strange, we checked this above */
      Tcl_Close(interp, out);
  } else {
      Tcl_StatBuf sourceStatBuf;
      struct utimbuf tval;
      /* 
       * Copy it synchronously.  We might wish to add an
       * asynchronous option to support vfs's which are
       * slow (e.g. network sockets).
       */
      Tcl_SetChannelOption(interp, in, "-translation", "binary");
      Tcl_SetChannelOption(interp, out, "-translation", "binary");
      
      if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
    result = TCL_OK;
      }
      /* 
       * If the copy failed, assume that copy channel left
       * a good error message.
       */
      Tcl_Close(interp, in);
      Tcl_Close(interp, out);
      
      /* Set modification date of copied file */
      if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
    tval.actime = sourceStatBuf.st_atime;
    tval.modtime = sourceStatBuf.st_mtime;
    Tcl_FSUtime(target, &tval);
      }
  }
    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSDeleteFile --
 *
 *  The appropriate function for the filesystem to which pathPtr
 *  belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  A file may be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSDeleteFile(pathPtr)
    Tcl_Obj *pathPtr;    /* Pathname of file to be removed (UTF-8). */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
  if (proc != NULL) {
      return (*proc)(pathPtr);
  }
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCreateDirectory --
 *
 *  The appropriate function for the filesystem to which pathPtr
 *  belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  A directory may be created.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCreateDirectory(pathPtr)
    Tcl_Obj *pathPtr;    /* Pathname of directory to create (UTF-8). */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
  if (proc != NULL) {
      return (*proc)(pathPtr);
  }
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyDirectory --
 *
 *  If the two paths given belong to the same filesystem, we call
 *  that filesystems copy-directory function.  Otherwise we simply
 *  return the posix error 'EXDEV', and -1.
 *
 * Results:
 *      Standard Tcl error code if a function was called.
 *
 * Side effects:
 *  A directory may be copied.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
    Tcl_Obj* srcPathPtr;  /* Pathname of directory to be copied
         * (UTF-8). */
    Tcl_Obj *destPathPtr;  /* Pathname of target directory (UTF-8). */
    Tcl_Obj **errorPtr;          /* If non-NULL, then will be set to a
                                  * new object containing name of file
                                  * causing error, with refCount 1. */
{
    int retVal = -1;
    Tcl_Filesystem *fsPtr, *fsPtr2;
    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
  Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
  if (proc != NULL) {
      retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
  }
    }
    if (retVal == -1) {
  Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRemoveDirectory --
 *
 *  The appropriate function for the filesystem to which pathPtr
 *  belongs will be called.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  A directory may be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
    Tcl_Obj *pathPtr;    /* Pathname of directory to be removed
         * (UTF-8). */
    int recursive;    /* If non-zero, removes directories that
         * are nonempty.  Otherwise, will only remove
         * empty directories. */
    Tcl_Obj **errorPtr;          /* If non-NULL, then will be set to a
         * new object containing name of file
         * causing error, with refCount 1. */
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
  Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
  if (proc != NULL) {
      if (recursive) {
          /* 
           * We check whether the cwd lies inside this directory
           * and move it if it does.
           */
    Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
    if (cwdPtr != NULL) {
        char *cwdStr, *normPathStr;
        int cwdLen, normLen;
        Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
        if (normPath != NULL) {
            normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
      cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
      if ((cwdLen >= normLen) && (strncmp(normPathStr, 
          cwdStr, (size_t) normLen) == 0)) {
          /* 
           * the cwd is inside the directory, so we
           * perform a 'cd [file dirname $path]'
           */
          Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr);
          Tcl_FSChdir(dirPtr);
          Tcl_DecrRefCount(dirPtr);
      }
        }
        Tcl_DecrRefCount(cwdPtr);
    }
      }
      return (*proc)(pathPtr, recursive, errorPtr);
  }
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetFileSystemForPath --
 *
 *      This function determines which filesystem to use for a
 *      particular path object, and returns the filesystem which
 *      accepts this file.  If no filesystem will accept this object
 *      as a valid file path, then NULL is returned.
 *
 * Results:
.*      NULL or a filesystem which will accept this path.
 *
 * Side effects:
 *  The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Filesystem*
Tcl_FSGetFileSystemForPath(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    FilesystemRecord *fsRecPtr;
    Tcl_Filesystem* retVal = NULL;
    
    /* 
     * If the object has a refCount of zero, we reject it.  This
     * is to avoid possible segfaults or nondeterministic memory
     * leaks (i.e. the user doesn't know if they should decrement
     * the ref count on return or not).
     */
    
    if (pathObjPtr->refCount == 0) {
  panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
  return NULL;
    }
    
    /* 
     * Check if the filesystem has changed in some way since
     * this object's internal representation was calculated.
     * Before doing that, assure we have the most up-to-date
     * copy of the master filesystem. This is accomplished
     * by the FsGetFirstFilesystem() call.
     */

    fsRecPtr = FsGetFirstFilesystem();

    if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) {
  return NULL;
    }

    /*
     * Call each of the "pathInFilesystem" functions in succession.  A
     * non-return value of -1 indicates the particular function has
     * succeeded.
     */

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
  Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
  if (proc != NULL) {
      ClientData clientData = NULL;
      int ret = (*proc)(pathObjPtr, &clientData);
      if (ret != -1) {
    /* 
     * We assume the type of pathObjPtr hasn't been changed 
     * by the above call to the pathInFilesystemProc.
     */
    TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData);
    retVal = fsRecPtr->fsPtr;
      }
  }
  fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *      This function is for use by the Win/Unix/MacOS native filesystems,
 *      so that they can easily retrieve the native (char* or TCHAR*)
 *      representation of a path.  Other filesystems will probably
 *      want to implement similar functions.  They basically act as a 
 *      safety net around Tcl_FSGetInternalRep.  Normally your file-
 *      system procedures will always be called with path objects
 *      already converted to the correct filesystem, but if for 
 *      some reason they are called directly (i.e. by procedures 
 *      not in this file), then one cannot necessarily guarantee that
 *      the path object pointer is from the correct filesystem.
 *      
 *      Note: in the future it might be desireable to have separate
 *      versions of this function with different signatures, for
 *      example Tcl_FSGetNativeMacPath, Tcl_FSGetNativeUnixPath etc.
 *      Right now, since native paths are all string based, we use just
 *      one function.  On MacOS we could possibly use an FSSpec or
 *      FSRef as the native representation.
 *
 * Results:
 *      NULL or a valid native path.
 *
 * Side effects:
 *  See Tcl_FSGetInternalRep.
 *
 *---------------------------------------------------------------------------
 */

CONST char *
Tcl_FSGetNativePath(pathObjPtr)
    Tcl_Obj *pathObjPtr;
{
    return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeCreateNativeRep --
 *
 *      Create a native representation for the given path.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
static ClientData 
NativeCreateNativeRep(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    char *nativePathPtr;
    Tcl_DString ds;
    Tcl_Obj* validPathObjPtr;
    int len;
    char *str;

    /* Make sure the normalized path is set */
    validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);

    str = Tcl_GetStringFromObj(validPathObjPtr, &len);
#ifdef __WIN32__
    Tcl_WinUtfToTChar(str, len, &ds);
    if (tclWinProcs->useWide) {
  len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
    } else {
  len = Tcl_DStringLength(&ds) + sizeof(char);
    }
#else
    Tcl_UtfToExternalDString(NULL, str, len, &ds);
    len = Tcl_DStringLength(&ds) + sizeof(char);
#endif
    nativePathPtr = ckalloc((unsigned) len);
    memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
    
    Tcl_DStringFree(&ds);
    return (ClientData)nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpNativeToNormalized --
 *
 *      Convert native format to a normalized path object, with refCount
 *      of zero.
 *
 * Results:
 *      A valid normalized path.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj* 
TclpNativeToNormalized(clientData)
    ClientData clientData;
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    CONST char *copy;
    int len;
    
#ifdef __WIN32__
    Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
#else
    Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
#endif
    
    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

#ifdef __WIN32__
    /* 
     * Certain native path representations on Windows have this special
     * prefix to indicate that they are to be treated specially.  For
     * example extremely long paths, or symlinks 
     */
    if (*copy == '\\') {
        if (0 == strncmp(copy,"\\??\\",4)) {
      copy += 4;
      len -= 4;
  } else if (0 == strncmp(copy,"\\\\?\\",4)) {
      copy += 4;
      len -= 4;
  }
    }
#endif

    objPtr = Tcl_NewStringObj(copy,len);
    Tcl_DStringFree(&ds);
    
    return objPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * NativeDupInternalRep --
 *
 *      Duplicate the native representation.
 *
 * Results:
 *      The copied native representation, or NULL if it is not possible
 *      to copy the representation.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
ClientData 
NativeDupInternalRep(clientData)
    ClientData clientData;
{
    ClientData copy;
    size_t len;

    if (clientData == NULL) {
  return NULL;
    }

#ifdef __WIN32__
    if (tclWinProcs->useWide) {
  /* unicode representation when running on NT/2K/XP */
  len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
    } else {
  /* ansi representation when running on 95/98/ME */
  len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
    }
#else
    /* ansi representation when running on Unix/MacOS */
    len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
#endif
    
    copy = (ClientData) ckalloc(len);
    memcpy((VOID*)copy, (VOID*)clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFreeInternalRep --
 *
 *      Free a native internal representation, which will be non-NULL.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *  Memory is released.
 *
 *---------------------------------------------------------------------------
 */
static void 
NativeFreeInternalRep(clientData)
    ClientData clientData;
{
    ckfree((char*)clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *
 *      This function returns a list of two elements.  The first
 *      element is the name of the filesystem (e.g. "native" or "vfs"),
 *      and the second is the particular type of the given path within
 *      that filesystem.
 *
 * Results:
 *      A list of two elements.
 *
 * Side effects:
 *  The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSFileSystemInfo(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    Tcl_Obj *resPtr;
    Tcl_FSFilesystemPathTypeProc *proc;
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
    
    if (fsPtr == NULL) {
  return NULL;
    }
    
    resPtr = Tcl_NewListObj(0,NULL);
    
    Tcl_ListObjAppendElement(NULL, resPtr, 
           Tcl_NewStringObj(fsPtr->typeName,-1));

    proc = fsPtr->filesystemPathTypeProc;
    if (proc != NULL) {
  Tcl_Obj *typePtr = (*proc)(pathObjPtr);
  if (typePtr != NULL) {
      Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
  }
    }
    
    return resPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSPathSeparator --
 *
 *      This function returns the separator to be used for a given
 *      path.  The object returned should have a refCount of zero
 *
 * Results:
 *      A Tcl object, with a refCount of zero.  If the caller
 *      needs to retain a reference to the object, it should
 *      call Tcl_IncrRefCount.
 *
 * Side effects:
 *  The path object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj*
Tcl_FSPathSeparator(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
    
    if (fsPtr == NULL) {
  return NULL;
    }
    if (fsPtr->filesystemSeparatorProc != NULL) {
  return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
    }
    
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemSeparator --
 *
 *      This function is part of the native filesystem support, and
 *      returns the separator for the given path.
 *
 * Results:
 *      String object containing the separator character.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj*
NativeFilesystemSeparator(pathObjPtr)
    Tcl_Obj* pathObjPtr;
{
    char *separator = NULL; /* lint */
    switch (tclPlatform) {
  case TCL_PLATFORM_UNIX:
      separator = "/";
      break;
  case TCL_PLATFORM_WINDOWS:
      separator = "\\";
      break;
  case TCL_PLATFORM_MAC:
      separator = ":";
      break;
    }
    return Tcl_NewStringObj(separator,1);
}

/* Everything from here on is contained in this obsolete ifdef */
#ifdef USE_OBSOLETE_FS_HOOKS

/*
 *----------------------------------------------------------------------
 *
 * TclStatInsertProc --
 *
 *  Insert the passed procedure pointer at the head of the list of
 *  functions which are used during a call to 'TclStat(...)'. The
 *  passed function should behave exactly like 'TclStat' when called
 *  during that time (see 'TclStat(...)' for more information).
 *  The function will be added even if it already in the list.
 *
 * 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 'TclStat'
 *  functions.
 *
 *----------------------------------------------------------------------
 */

int
TclStatInsertProc (proc)
    TclStatProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
  StatProc *newStatProcPtr;

  newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));

  if (newStatProcPtr != NULL) {
      newStatProcPtr->proc = proc;
      Tcl_MutexLock(&obsoleteFsHookMutex);
      newStatProcPtr->nextPtr = statProcList;
      statProcList = newStatProcPtr;
      Tcl_MutexUnlock(&obsoleteFsHookMutex);

      retVal = TCL_OK;
  }
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclStatDeleteProc --
 *
 *  Removed the passed function pointer from the list of 'TclStat'
 *  functions.  Ensures that the built-in stat function is not
 *  removvable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *  TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclStatDeleteProc (proc)
    TclStatProc_ *proc;
{
    int retVal = TCL_ERROR;
    StatProc *tmpStatProcPtr;
    StatProc *prevStatProcPtr = NULL;

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpStatProcPtr = statProcList;
    /*
     * Traverse the 'statProcList' looking for the particular node
     * whose 'proc' member matches 'proc' and remove that one from
     * the list.  Ensure that the "default" node cannot be removed.
     */

    while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
  if (tmpStatProcPtr->proc == proc) {
      if (prevStatProcPtr == NULL) {
    statProcList = tmpStatProcPtr->nextPtr;
      } else {
    prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
      }

      ckfree((char *)tmpStatProcPtr);

      retVal = TCL_OK;
  } else {
      prevStatProcPtr = tmpStatProcPtr;
      tmpStatProcPtr = tmpStatProcPtr->nextPtr;
  }
    }

    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAccessInsertProc --
 *
 *  Insert the passed procedure pointer at the head of the list of
 *  functions which are used during a call to 'TclAccess(...)'.
 *  The passed function should behave exactly like 'TclAccess' when
 *  called during that time (see 'TclAccess(...)' for more
 *  information).  The function will be added even if it already in
 *  the list.
 *
 * 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 'TclAccess'
 *  functions.
 *
 *----------------------------------------------------------------------
 */

int
TclAccessInsertProc(proc)
    TclAccessProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
  AccessProc *newAccessProcPtr;

  newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));

  if (newAccessProcPtr != NULL) {
      newAccessProcPtr->proc = proc;
      Tcl_MutexLock(&obsoleteFsHookMutex);
      newAccessProcPtr->nextPtr = accessProcList;
      accessProcList = newAccessProcPtr;
      Tcl_MutexUnlock(&obsoleteFsHookMutex);

      retVal = TCL_OK;
  }
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAccessDeleteProc --
 *
 *  Removed the passed function pointer from the list of 'TclAccess'
 *  functions.  Ensures that the built-in access function is not
 *  removvable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *  TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclAccessDeleteProc(proc)
    TclAccessProc_ *proc;
{
    int retVal = TCL_ERROR;
    AccessProc *tmpAccessProcPtr;
    AccessProc *prevAccessProcPtr = NULL;

    /*
     * Traverse the 'accessProcList' looking for the particular node
     * whose 'proc' member matches 'proc' and remove that one from
     * the list.  Ensure that the "default" node cannot be removed.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpAccessProcPtr = accessProcList;
    while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
  if (tmpAccessProcPtr->proc == proc) {
      if (prevAccessProcPtr == NULL) {
    accessProcList = tmpAccessProcPtr->nextPtr;
      } else {
    prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
      }

      ckfree((char *)tmpAccessProcPtr);

      retVal = TCL_OK;
  } else {
      prevAccessProcPtr = tmpAccessProcPtr;
      tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
  }
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelInsertProc --
 *
 *  Insert the passed procedure pointer at the head of the list of
 *  functions which are used during a call to
 *  'Tcl_OpenFileChannel(...)'. The passed function should behave
 *  exactly like 'Tcl_OpenFileChannel' when called during that time
 *  (see 'Tcl_OpenFileChannel(...)' for more information). The
 *  function will be added even if it already in the list.
 *
 * 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
 *  'Tcl_OpenFileChannel' functions.
 *
 *----------------------------------------------------------------------
 */

int
TclOpenFileChannelInsertProc(proc)
    TclOpenFileChannelProc_ *proc;
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
  OpenFileChannelProc *newOpenFileChannelProcPtr;

  newOpenFileChannelProcPtr =
    (OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));

  if (newOpenFileChannelProcPtr != NULL) {
      newOpenFileChannelProcPtr->proc = proc;
      Tcl_MutexLock(&obsoleteFsHookMutex);
      newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
      openFileChannelProcList = newOpenFileChannelProcPtr;
      Tcl_MutexUnlock(&obsoleteFsHookMutex);

      retVal = TCL_OK;
  }
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelDeleteProc --
 *
 *  Removed the passed function pointer from the list of
 *  'Tcl_OpenFileChannel' functions.  Ensures that the built-in
 *  open file channel function is not removable.
 *
 * Results:
 *      TCL_OK if the procedure pointer was successfully removed,
 *  TCL_ERROR otherwise.
 *
 * Side effects:
 *      Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclOpenFileChannelDeleteProc(proc)
    TclOpenFileChannelProc_ *proc;
{
    int retVal = TCL_ERROR;
    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;

    /*
     * Traverse the 'openFileChannelProcList' looking for the particular
     * node whose 'proc' member matches 'proc' and remove that one from
     * the list.  
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpOpenFileChannelProcPtr = openFileChannelProcList;
    while ((retVal == TCL_ERROR) &&
      (tmpOpenFileChannelProcPtr != NULL)) {
  if (tmpOpenFileChannelProcPtr->proc == proc) {
      if (prevOpenFileChannelProcPtr == NULL) {
    openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
      } else {
    prevOpenFileChannelProcPtr->nextPtr =
      tmpOpenFileChannelProcPtr->nextPtr;
      }

      ckfree((char *)tmpOpenFileChannelProcPtr);

      retVal = TCL_OK;
  } else {
      prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
      tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
  }
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */


/*
 * Prototypes for procedures defined later in this file.
 */

static void    DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
          Tcl_Obj *copyPtr));
static void    FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
static void             UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr));
static int    SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
          Tcl_Obj *objPtr));
static int     FindSplitPos _ANSI_ARGS_((char *path, char *separator));



/*
 * Define the 'path' object type, which Tcl uses to represent
 * file paths internally.
 */
static Tcl_ObjType tclFsPathType = {
    "path",        /* name */
    FreeFsPathInternalRep,    /* freeIntRepProc */
    DupFsPathInternalRep,          /* dupIntRepProc */
    UpdateStringOfFsPath,    /* updateStringProc */
    SetFsPathFromAny      /* setFromAnyProc */
};

/* 
 * struct FsPath --
 * 
 * Internal representation of a Tcl_Obj of "path" type.  This
 * can be used to represent relative or absolute paths, and has
 * certain optimisations when used to represent paths which are
 * already normalized and absolute.
 * 
 * Note that 'normPathPtr' can be a circular reference to the
 * container Tcl_Obj of this FsPath.
 */
typedef struct FsPath {
    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences.
         * If this is NULL, then this is a 
         * pure normalized, absolute path
         * object, in which the parent Tcl_Obj's
         * string rep is already both translated
         * and normalized. */
    Tcl_Obj *normPathPtr;       /* Normalized absolute path, without 
         * ., .. or ~user sequences. If the 
         * Tcl_Obj containing 
         * this FsPath is already normalized, 
         * this may be a circular reference back
         * to the container.  If that is NOT the
         * case, we have a refCount on the object. */
    Tcl_Obj *cwdPtr;            /* If null, path is absolute, else
         * this points to the cwd object used
         * for this path.  We have a refCount
         * on the object. */
    int flags;                  /* Flags to describe interpretation */
    ClientData nativePathPtr;   /* Native representation of this path,
         * which is filesystem dependent. */
    int filesystemEpoch;        /* Used to ensure the path representation
         * was generated during the correct
         * filesystem epoch.  The epoch changes
         * when filesystem-mounts are changed. */ 
    struct FilesystemRecord *fsRecPtr;
        /* Pointer to the filesystem record 
         * entry to use for this path. */
} FsPath;

/* 
 * Define some macros to give us convenient access to path-object
 * specific fields.
 */
#define PATHOBJ(objPtr) (objPtr->internalRep.otherValuePtr)
#define PATHFLAGS(objPtr) \
 (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags)

#define TCLPATH_APPENDED 1
#define TCLPATH_RELATIVE 2

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSGetPathType --
 *
 *  Determines whether a given path is relative to the current
 *  directory, relative to the current volume, or absolute.  
 *
 * Results:
 *  Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *  TCL_PATH_VOLUME_RELATIVE.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
Tcl_FSGetPathType(pathObjPtr)
    Tcl_Obj *pathObjPtr;
{
    return FSGetPathType(pathObjPtr, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * FSGetPathType --
 *
 *  Determines whether a given path is relative to the current
 *  directory, relative to the current volume, or absolute.  If the
 *  caller wishes to know which filesystem claimed the path (in the
 *  case for which the path is absolute), then a reference to a
 *  filesystem pointer can be passed in (but passing NULL is
 *  acceptable).
 *
 * Results:
 *  Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *  TCL_PATH_VOLUME_RELATIVE.  The filesystem reference will
 *  be set if and only if it is non-NULL and the function's 
 *  return value is TCL_PATH_ABSOLUTE.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr)
    Tcl_Obj *pathObjPtr;
    Tcl_Filesystem **filesystemPtrPtr;
    int *driveNameLengthPtr;
{
    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
  return GetPathType(pathObjPtr, filesystemPtrPtr, 
         driveNameLengthPtr, NULL);
    } else {
  FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
  if (fsPathPtr->cwdPtr != NULL) {
      if (PATHFLAGS(pathObjPtr) == 0) {
    return TCL_PATH_RELATIVE;
      }
      return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 
         driveNameLengthPtr);
  } else {
      return GetPathType(pathObjPtr, filesystemPtrPtr, 
             driveNameLengthPtr, NULL);
  }
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSJoinPath --
 *
 *      This function takes the given Tcl_Obj, which should be a valid
 *      list, and returns the path object given by considering the
 *      first 'elements' elements as valid path segments.  If elements < 0,
 *      we use the entire list.
 *      
 * Results:
 *      Returns object with refCount of zero, (or if non-zero, it has
 *      references elsewhere in Tcl).  Either way, the caller must
 *      increment its refCount before use.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
Tcl_Obj* 
Tcl_FSJoinPath(listObj, elements)
    Tcl_Obj *listObj;
    int elements;
{
    Tcl_Obj *res;
    int i;
    Tcl_Filesystem *fsPtr = NULL;
    
    if (elements < 0) {
  if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
      return NULL;
  }
    } else {
  /* Just make sure it is a valid list */
  int listTest;
  if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
      return NULL;
  }
  /* 
   * Correct this if it is too large, otherwise we will
   * waste our time joining null elements to the path 
   */
  if (elements > listTest) {
      elements = listTest;
  }
    }
    
    res = Tcl_NewObj();
    
    for (i = 0; i < elements; i++) {
  Tcl_Obj *elt;
  int driveNameLength;
  Tcl_PathType type;
  char *strElt;
  int strEltLen;
  int length;
  char *ptr;
  Tcl_Obj *driveName = NULL;
  
  Tcl_ListObjIndex(NULL, listObj, i, &elt);
  
  /* 
   * This is a special case where we can be much more
   * efficient, where we are joining a single relative path
   * onto an object that is already of path type.  The 
   * 'TclNewFSPathObj' call below creates an object which
   * can be normalized more efficiently.  Currently we only
   * use the special case when we have exactly two elements,
   * but we could expand that in the future.
   */
  if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
    && !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
      Tcl_Obj *tail;
      Tcl_PathType type;
      Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
      type = GetPathType(tail, NULL, NULL, NULL);
      if (type == TCL_PATH_RELATIVE) {
    CONST char *str;
    int len;
    str = Tcl_GetStringFromObj(tail,&len);
    if (len == 0) {
        /* 
         * This happens if we try to handle the root volume
         * '/'.  There's no need to return a special path
         * object, when the base itself is just fine!
         */
        Tcl_DecrRefCount(res);
        return elt;
    }
    /* 
     * If it doesn't begin with '.'  and is a mac or unix
     * path or it a windows path without backslashes, then we
     * can be very efficient here.  (In fact even a windows
     * path with backslashes can be joined efficiently, but
     * the path object would not have forward slashes only,
     * and this would therefore contradict our 'file join'
     * documentation).
     */
    if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) 
              || (strchr(str, '\\') == NULL))) {
        /* 
         * Finally, on Windows, 'file join' is defined to 
         * convert all backslashes to forward slashes,
         * so the base part cannot have backslashes either.
         */
        if ((tclPlatform != TCL_PLATFORM_WINDOWS)
      || (strchr(Tcl_GetString(elt), '\\') == NULL)) {
      if (res != NULL) {
          TclDecrRefCount(res);
      }
      return TclNewFSPathObj(elt, str, len);
        }
    }
    /* 
     * Otherwise we don't have an easy join, and
     * we must let the more general code below handle
     * things
     */
      } else {
    if (tclPlatform == TCL_PLATFORM_UNIX) {
        Tcl_DecrRefCount(res);
        return tail;
    } else {
        CONST char *str;
        int len;
        str = Tcl_GetStringFromObj(tail,&len);
        if (tclPlatform == TCL_PLATFORM_WINDOWS) {
      if (strchr(str, '\\') == NULL) {
          Tcl_DecrRefCount(res);
          return tail;
      }
        } else if (tclPlatform == TCL_PLATFORM_MAC) {
      if (strchr(str, '/') == NULL) {
          Tcl_DecrRefCount(res);
          return tail;
      }
        }
    }
      }
  }
  strElt = Tcl_GetStringFromObj(elt, &strEltLen);
  type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
  if (type != TCL_PATH_RELATIVE) {
      /* Zero out the current result */
      Tcl_DecrRefCount(res);
      if (driveName != NULL) {
    res = Tcl_DuplicateObj(driveName);
    Tcl_DecrRefCount(driveName);
      } else {
    res = Tcl_NewStringObj(strElt, driveNameLength);
      }
      strElt += driveNameLength;
  }
  
  ptr = Tcl_GetStringFromObj(res, &length);
  
  /* 
   * Strip off any './' before a tilde, unless this is the
   * beginning of the path.
   */
  if (length > 0 && strEltLen > 0) {
      if ((strElt[0] == '.') && (strElt[1] == '/') 
        && (strElt[2] == '~')) {
    strElt += 2;
      }
  }

  /* 
   * A NULL value for fsPtr at this stage basically means
   * we're trying to join a relative path onto something
   * which is also relative (or empty).  There's nothing
   * particularly wrong with that.
   */
  if (*strElt == '\0') continue;
  
  if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
      TclpNativeJoinPath(res, strElt);
  } else {
      char separator = '/';
      int needsSep = 0;
      
      if (fsPtr->filesystemSeparatorProc != NULL) {
    Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
    if (sep != NULL) {
        separator = Tcl_GetString(sep)[0];
    }
      }

      if (length > 0 && ptr[length -1] != '/') {
    Tcl_AppendToObj(res, &separator, 1);
    length++;
      }
      Tcl_SetObjLength(res, length + (int) strlen(strElt));
      
      ptr = Tcl_GetString(res) + length;
      for (; *strElt != '\0'; strElt++) {
    if (*strElt == separator) {
        while (strElt[1] == separator) {
      strElt++;
        }
        if (strElt[1] != '\0') {
      if (needsSep) {
          *ptr++ = separator;
      }
        }
    } else {
        *ptr++ = *strElt;
        needsSep = 1;
    }
      }
      length = ptr - Tcl_GetString(res);
      Tcl_SetObjLength(res, length);
  }
    }
    return res;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSConvertToPathType --
 *
 *      This function tries to convert the given Tcl_Obj to a valid
 *      Tcl path type, taking account of the fact that the cwd may
 *      have changed even if this object is already supposedly of
 *      the correct type.
 *      
 *      The filename may begin with "~" (to indicate current user's
 *      home directory) or "~<user>" (to indicate any user's home
 *      directory).
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */
int 
Tcl_FSConvertToPathType(interp, objPtr)
    Tcl_Interp *interp;    /* Interpreter in which to store error
         * message (if necessary). */
    Tcl_Obj *objPtr;    /* Object to convert to a valid, current
         * path type. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /* 
     * While it is bad practice to examine an object's type directly,
     * this is actually the best thing to do here.  The reason is that
     * if we are converting this object to FsPath type for the first
     * time, we don't need to worry whether the 'cwd' has changed.
     * On the other hand, if this object is already of FsPath type,
     * and is a relative path, we do have to worry about the cwd.
     * If the cwd has changed, we must recompute the path.
     */
    if (objPtr->typePtr == &tclFsPathType) {
  FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
  if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
      if (objPtr->bytes == NULL) {
    UpdateStringOfFsPath(objPtr);
      }
      FreeFsPathInternalRep(objPtr);
      objPtr->typePtr = NULL;
      return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
  }
  return TCL_OK;
    } else {
  return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
    }
}

/* 
 * Helper function for SetFsPathFromAny.  Returns position of first
 * directory delimiter in the path.
 */
static int
FindSplitPos(path, separator)
    char *path;
    char *separator;
{
    int count = 0;
    switch (tclPlatform) {
  case TCL_PLATFORM_UNIX:
  case TCL_PLATFORM_MAC:
      while (path[count] != 0) {
    if (path[count] == *separator) {
        return count;
    }
    count++;
      }
      break;

  case TCL_PLATFORM_WINDOWS:
      while (path[count] != 0) {
    if (path[count] == *separator || path[count] == '\\') {
        return count;
    }
    count++;
      }
      break;
    }
    return count;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNewFSPathObj --
 *
 *      Creates a path object whose string representation is 
 *      '[file join dirPtr addStrRep]', but does so in a way that
 *      allows for more efficient caching of normalized paths.
 *      
 * Assumptions:
 *      'dirPtr' must be an absolute path.  
 *      'len' may not be zero.
 *      
 * Results:
 *      The new Tcl object, with refCount zero.
 *
 * Side effects:
 *  Memory is allocated.  'dirPtr' gets an additional refCount.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *objPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    
    objPtr = Tcl_NewObj();
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    
    if (tclPlatform == TCL_PLATFORM_MAC) { 
  /* 
   * Mac relative paths may begin with a directory separator ':'. 
   * If present, we need to skip this ':' because we assume that 
   * we can join dirPtr and addStrRep by concatenating them as 
   * strings (and we ensure that dirPtr is terminated by a ':'). 
   */ 
  if (addStrRep[0] == ':') { 
      addStrRep++; 
      len--; 
  } 
    } 
    /* Setup the path */
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
    fsPathPtr->cwdPtr = dirPtr;
    Tcl_IncrRefCount(dirPtr);
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(objPtr) = TCLPATH_RELATIVE | TCLPATH_APPENDED;
    objPtr->typePtr = &tclFsPathType;
    objPtr->bytes = NULL;
    objPtr->length = 0;

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathRelative --
 *
 *      Only for internal use.
 *      
 *      Takes a path and a directory, where we _assume_ both path and
 *      directory are absolute, normalized and that the path lies
 *      inside the directory.  Returns a Tcl_Obj representing filename 
 *      of the path relative to the directory.
 *      
 *      In the case where the resulting path would start with a '~', we
 *      take special care to return an ordinary string.  This means to
 *      use that path (and not have it interpreted as a user name),
 *      one must prepend './'.  This may seem strange, but that is how
 *      'glob' is currently defined.
 *      
 * Results:
 *      NULL on error, otherwise a valid object, typically with
 *      refCount of zero, which it is assumed the caller will
 *      increment.
 *
 * Side effects:
 *  The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclFSMakePathRelative(interp, objPtr, cwdPtr)
    Tcl_Interp *interp;    /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;    /* The object we have. */
    Tcl_Obj *cwdPtr;    /* Make it relative to this. */
{
    int cwdLen, len;
    CONST char *tempStr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    
    if (objPtr->typePtr == &tclFsPathType) {
  FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
  if (PATHFLAGS(objPtr) != 0 
    && fsPathPtr->cwdPtr == cwdPtr) {
      objPtr = fsPathPtr->normPathPtr;
      /* Free old representation */
      if (objPtr->typePtr != NULL) {
    if (objPtr->bytes == NULL) {
        if (objPtr->typePtr->updateStringProc == NULL) {
      if (interp != NULL) {
          Tcl_ResetResult(interp);
          Tcl_AppendResult(interp, "can't find object",
               "string representation", (char *) NULL);
      }
      return NULL;
        }
        objPtr->typePtr->updateStringProc(objPtr);
    }
    if ((objPtr->typePtr->freeIntRepProc) != NULL) {
        (*objPtr->typePtr->freeIntRepProc)(objPtr);
    }
      }
      /* Now objPtr is a string object */
      
      if (Tcl_GetString(objPtr)[0] == '~') {
    /* 
     * If the first character of the path is a tilde,
     * we must just return the path as is, to agree
     * with the defined behaviour of 'glob'.
     */
    return objPtr;
      }

      fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

      /* Circular reference, by design */
      fsPathPtr->translatedPathPtr = objPtr;
      fsPathPtr->normPathPtr = NULL;
      fsPathPtr->cwdPtr = cwdPtr;
      Tcl_IncrRefCount(cwdPtr);
      fsPathPtr->nativePathPtr = NULL;
      fsPathPtr->fsRecPtr = NULL;
      fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

      PATHOBJ(objPtr) = (VOID *) fsPathPtr;
      PATHFLAGS(objPtr) = 0;
      objPtr->typePtr = &tclFsPathType;

      return objPtr;
  }
    }
    /* 
     * We know the cwd is a normalised object which does
     * not end in a directory delimiter, unless the cwd
     * is the name of a volume, in which case it will
     * end in a delimiter!  We handle this situation here.
     * A better test than the '!= sep' might be to simply
     * check if 'cwd' is a root volume.
     * 
     * Note that if we get this wrong, we will strip off
     * either too much or too little below, leading to
     * wrong answers returned by glob.
     */
    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
    /* 
     * Should we perhaps use 'Tcl_FSPathSeparator'?
     * But then what about the Windows special case?
     * Perhaps we should just check if cwd is a root
     * volume.
     */
    switch (tclPlatform) {
  case TCL_PLATFORM_UNIX:
      if (tempStr[cwdLen-1] != '/') {
    cwdLen++;
      }
      break;
  case TCL_PLATFORM_WINDOWS:
      if (tempStr[cwdLen-1] != '/' 
        && tempStr[cwdLen-1] != '\\') {
    cwdLen++;
      }
      break;
  case TCL_PLATFORM_MAC:
      if (tempStr[cwdLen-1] != ':') {
    cwdLen++;
      }
      break;
    }
    tempStr = Tcl_GetStringFromObj(objPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathFromNormalized --
 *
 *      Like SetFsPathFromAny, but assumes the given object is an
 *      absolute normalized path. Only for internal use.
 *      
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

int
TclFSMakePathFromNormalized(interp, objPtr, nativeRep)
    Tcl_Interp *interp;    /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;    /* The object to convert. */
    ClientData nativeRep;  /* The native rep for the object, if known
         * else NULL. */
{
    FsPath *fsPathPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (objPtr->typePtr == &tclFsPathType) {
  return TCL_OK;
    }
    
    /* Free old representation */
    if (objPtr->typePtr != NULL) {
  if (objPtr->bytes == NULL) {
      if (objPtr->typePtr->updateStringProc == NULL) {
    if (interp != NULL) {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "can't find object",
             "string representation", (char *) NULL);
    }
    return TCL_ERROR;
      }
      objPtr->typePtr->updateStringProc(objPtr);
  }
  if ((objPtr->typePtr->freeIntRepProc) != NULL) {
      (*objPtr->typePtr->freeIntRepProc)(objPtr);
  }
    }

    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
    /* It's a pure normalized absolute path */
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = objPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = nativeRep;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(objPtr) = 0;
    objPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSNewNativePath --
 *
 *      This function performs the something like that reverse of the 
 *      usual obj->path->nativerep conversions.  If some code retrieves
 *      a path in native form (from, e.g. readlink or a native dialog),
 *      and that path is to be used at the Tcl level, then calling
 *      this function is an efficient way of creating the appropriate
 *      path object type.
 *      
 *      Any memory which is allocated for 'clientData' should be retained
 *      until clientData is passed to the filesystem's freeInternalRepProc
 *      when it can be freed.  The built in platform-specific filesystems
 *      use 'ckalloc' to allocate clientData, and ckfree to free it.
 *
 * Results:
 *      NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *  New memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(fromFilesystem, clientData)
    Tcl_Filesystem* fromFilesystem;
    ClientData clientData;
{
    Tcl_Obj *objPtr;
    FsPath *fsPathPtr;

    FilesystemRecord *fsFromPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    
    objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr);
    if (objPtr == NULL) {
  return NULL;
    }
    
    /* 
     * Free old representation; shouldn't normally be any,
     * but best to be safe. 
     */
    if (objPtr->typePtr != NULL) {
  if (objPtr->bytes == NULL) {
      if (objPtr->typePtr->updateStringProc == NULL) {
    return NULL;
      }
      objPtr->typePtr->updateStringProc(objPtr);
  }
  if ((objPtr->typePtr->freeIntRepProc) != NULL) {
      (*objPtr->typePtr->freeIntRepProc)(objPtr);
  }
    }
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;
    /* Circular reference, by design */
    fsPathPtr->normPathPtr = objPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsRecPtr = fsFromPtr;
    fsPathPtr->fsRecPtr->fileRefCount++;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(objPtr) = 0;
    objPtr->typePtr = &tclFsPathType;

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetTranslatedPath --
 *
 *      This function attempts to extract the translated path
 *      from the given Tcl_Obj.  If the translation succeeds (i.e. the
 *      object is a valid path), then it is returned.  Otherwise NULL
 *      will be returned, and an error message may be left in the
 *      interpreter (if it is non-NULL)
 *
 * Results:
 *      NULL or a valid Tcl_Obj pointer.
 *
 * Side effects:
 *  Only those of 'Tcl_FSConvertToPathType'
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSGetTranslatedPath(interp, pathPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathPtr;
{
    Tcl_Obj *retObj = NULL;
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
  return NULL;
    }
    srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
    if (srcFsPathPtr->translatedPathPtr == NULL) {
  if (PATHFLAGS(pathPtr) != 0) {
      retObj = Tcl_FSGetNormalizedPath(interp, pathPtr);
  } else {
      /* 
       * It is a pure absolute, normalized path object.
       * This is something like being a 'pure list'.  The
       * object's string, translatedPath and normalizedPath
       * are all identical.
       */
      retObj = srcFsPathPtr->normPathPtr;
  }
    } else {
  /* It is an ordinary path object */
  retObj = srcFsPathPtr->translatedPathPtr;
    }

    Tcl_IncrRefCount(retObj);
    return retObj;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetTranslatedStringPath --
 *
 *      This function attempts to extract the translated path
 *      from the given Tcl_Obj.  If the translation succeeds (i.e. the
 *      object is a valid path), then the path is returned.  Otherwise NULL
 *      will be returned, and an error message may be left in the
 *      interpreter (if it is non-NULL)
 *
 * Results:
 *      NULL or a valid string.
 *
 * Side effects:
 *  Only those of 'Tcl_FSConvertToPathType'
 *
 *---------------------------------------------------------------------------
 */
CONST char*
Tcl_FSGetTranslatedStringPath(interp, pathPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathPtr;
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
  int len;
  CONST char *result, *orig;
  orig = Tcl_GetStringFromObj(transPtr, &len);
  result = (char*) ckalloc((unsigned)(len+1));
  memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1));
  Tcl_DecrRefCount(transPtr);
  return result;
    }

    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNormalizedPath --
 *
 *      This important function attempts to extract from the given Tcl_Obj
 *      a unique normalised path representation, whose string value can
 *      be used as a unique identifier for the file.
 *
 * Results:
 *      NULL or a valid path object pointer.
 *
 * Side effects:
 *  New memory may be allocated.  The Tcl 'errno' may be modified
 *      in the process of trying to examine various path possibilities.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj* 
Tcl_FSGetNormalizedPath(interp, pathObjPtr)
    Tcl_Interp *interp;
    Tcl_Obj* pathObjPtr;
{
    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
  return NULL;
    }
    fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);

    if (PATHFLAGS(pathObjPtr) != 0) {
  /* 
   * This is a special path object which is the result of
   * something like 'file join' 
   */
  Tcl_Obj *dir, *copy;
  int cwdLen;
  int pathType;
  CONST char *cwdStr;
  ClientData clientData = NULL;
  
  pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
  dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
  if (dir == NULL) {
      return NULL;
  }
  if (pathObjPtr->bytes == NULL) {
      UpdateStringOfFsPath(pathObjPtr);
  }
  copy = Tcl_DuplicateObj(dir);
  Tcl_IncrRefCount(copy);
  Tcl_IncrRefCount(dir);
  /* We now own a reference on both 'dir' and 'copy' */
  
  cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
  /* 
   * Should we perhaps use 'Tcl_FSPathSeparator'?
   * But then what about the Windows special case?
   * Perhaps we should just check if cwd is a root volume.
   * We should never get cwdLen == 0 in this code path.
   */
  switch (tclPlatform) {
      case TCL_PLATFORM_UNIX:
    if (cwdStr[cwdLen-1] != '/') {
        Tcl_AppendToObj(copy, "/", 1);
        cwdLen++;
    }
    break;
      case TCL_PLATFORM_WINDOWS:
    if (cwdStr[cwdLen-1] != '/' 
      && cwdStr[cwdLen-1] != '\\') {
        Tcl_AppendToObj(copy, "/", 1);
        cwdLen++;
    }
    break;
      case TCL_PLATFORM_MAC:
    if (cwdStr[cwdLen-1] != ':') {
        Tcl_AppendToObj(copy, ":", 1);
        cwdLen++;
    }
    break;
  }
  Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
  /* 
   * Normalize the combined string, but only starting after
   * the end of the previously normalized 'dir'.  This should
   * be much faster!  We use 'cwdLen-1' so that we are
   * already pointing at the dir-separator that we know about.
   * The normalization code will actually start off directly
   * after that separator.
   */
  TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 
    (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
  /* Now we need to construct the new path object */
  
  if (pathType == TCL_PATH_RELATIVE) {
      FsPath* origDirFsPathPtr;
      Tcl_Obj *origDir = fsPathPtr->cwdPtr;
      origDirFsPathPtr = (FsPath*) PATHOBJ(origDir);
      
      fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
      Tcl_IncrRefCount(fsPathPtr->cwdPtr);
      
      Tcl_DecrRefCount(fsPathPtr->normPathPtr);
      fsPathPtr->normPathPtr = copy;
      /* That's our reference to copy used */
      Tcl_DecrRefCount(dir);
      Tcl_DecrRefCount(origDir);
  } else {
      Tcl_DecrRefCount(fsPathPtr->cwdPtr);
      fsPathPtr->cwdPtr = NULL;
      Tcl_DecrRefCount(fsPathPtr->normPathPtr);
      fsPathPtr->normPathPtr = copy;
      /* That's our reference to copy used */
      Tcl_DecrRefCount(dir);
  }
  if (clientData != NULL) {
      fsPathPtr->nativePathPtr = clientData;
  }
  PATHFLAGS(pathObjPtr) = 0;
    }
    /* Ensure cwd hasn't changed */
    if (fsPathPtr->cwdPtr != NULL) {
  if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) {
      if (pathObjPtr->bytes == NULL) {
    UpdateStringOfFsPath(pathObjPtr);
      }
      FreeFsPathInternalRep(pathObjPtr);
      pathObjPtr->typePtr = NULL;
      if (Tcl_ConvertToType(interp, pathObjPtr, 
          &tclFsPathType) != TCL_OK) {
    return NULL;
      }
      fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
  } else if (fsPathPtr->normPathPtr == NULL) {
      int cwdLen;
      Tcl_Obj *copy;
      CONST char *cwdStr;
      ClientData clientData = NULL;
      
      copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
      Tcl_IncrRefCount(copy);
      cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
      /* 
       * Should we perhaps use 'Tcl_FSPathSeparator'?
       * But then what about the Windows special case?
       * Perhaps we should just check if cwd is a root volume.
       * We should never get cwdLen == 0 in this code path.
       */
      switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
        if (cwdStr[cwdLen-1] != '/') {
      Tcl_AppendToObj(copy, "/", 1);
      cwdLen++;
        }
        break;
    case TCL_PLATFORM_WINDOWS:
        if (cwdStr[cwdLen-1] != '/' 
          && cwdStr[cwdLen-1] != '\\') {
      Tcl_AppendToObj(copy, "/", 1);
      cwdLen++;
        }
        break;
    case TCL_PLATFORM_MAC:
        if (cwdStr[cwdLen-1] != ':') {
      Tcl_AppendToObj(copy, ":", 1);
      cwdLen++;
        }
        break;
      }
      Tcl_AppendObjToObj(copy, pathObjPtr);
      /* 
       * Normalize the combined string, but only starting after
       * the end of the previously normalized 'dir'.  This should
       * be much faster!
       */
      TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, 
        (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
      fsPathPtr->normPathPtr = copy;
      if (clientData != NULL) {
    fsPathPtr->nativePathPtr = clientData;
      }
  }
    }
    if (fsPathPtr->normPathPtr == NULL) {
  ClientData clientData = NULL;
  Tcl_Obj *useThisCwd = NULL;
  /* 
   * Since normPathPtr is NULL, but this is a valid path
   * object, we know that the translatedPathPtr cannot be NULL.
   */
  Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
  char *path = Tcl_GetString(absolutePath);
  
  /* 
   * We have to be a little bit careful here to avoid infinite loops
   * we're asking Tcl_FSGetPathType to return the path's type, but
   * that call can actually result in a lot of other filesystem
   * action, which might loop back through here.
   */
  if (path[0] != '\0') {
      Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr);
      if (type == TCL_PATH_RELATIVE) {
    useThisCwd = Tcl_FSGetCwd(interp);

    if (useThisCwd == NULL) return NULL;

    absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
    Tcl_IncrRefCount(absolutePath);
    /* We have a refCount on the cwd */
#ifdef __WIN32__
      } else if (type == TCL_PATH_VOLUME_RELATIVE) {
    /* 
     * Only Windows has volume-relative paths.  These
     * paths are rather rare, but is is nice if Tcl can
     * handle them.  It is much better if we can
     * handle them here, rather than in the native fs code,
     * because we really need to have a real absolute path
     * just below.
     * 
     * We do not let this block compile on non-Windows
     * platforms because the test suite's manual forcing
     * of tclPlatform can otherwise cause this code path
     * to be executed, causing various errors because
     * volume-relative paths really do not exist.
     */
    useThisCwd = Tcl_FSGetCwd(interp);
    if (useThisCwd == NULL) return NULL;
    
    if (path[0] == '/') {
        /* 
         * Path of form /foo/bar which is a path in the
         * root directory of the current volume.
         */
        CONST char *drive = Tcl_GetString(useThisCwd);
        absolutePath = Tcl_NewStringObj(drive,2);
        Tcl_AppendToObj(absolutePath, path, -1);
        Tcl_IncrRefCount(absolutePath);
        /* We have a refCount on the cwd */
    } else {
        /* 
         * Path of form C:foo/bar, but this only makes
         * sense if the cwd is also on drive C.
         */
        CONST char *drive = Tcl_GetString(useThisCwd);
        char drive_c = path[0];
        if (drive_c >= 'a') {
      drive_c -= ('a' - 'A');
        }
        if (drive[0] == drive_c) {
      absolutePath = Tcl_DuplicateObj(useThisCwd);
      /* We have a refCount on the cwd */
        } else {
      Tcl_DecrRefCount(useThisCwd);
      useThisCwd = NULL;
      /* 
       * The path is not in the current drive, but
       * is volume-relative.  The way Tcl 8.3 handles
       * this is that it treats such a path as
       * relative to the root of the drive.  We
       * therefore behave the same here.
       */
      absolutePath = Tcl_NewStringObj(path, 2);
        }
        Tcl_IncrRefCount(absolutePath);
        Tcl_AppendToObj(absolutePath, "/", 1);
        Tcl_AppendToObj(absolutePath, path+2, -1);
    }
#endif /* __WIN32__ */
      }
  }
  /* Already has refCount incremented */
  fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, 
           (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
  if (0 && (clientData != NULL)) {
      fsPathPtr->nativePathPtr = 
        (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
  }
  if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
        Tcl_GetString(pathObjPtr))) {
      /* 
       * The path was already normalized.  
       * Get rid of the duplicate.
       */
      Tcl_DecrRefCount(fsPathPtr->normPathPtr);
      /* 
       * We do *not* increment the refCount for 
       * this circular reference 
       */
      fsPathPtr->normPathPtr = pathObjPtr;
  }
  if (useThisCwd != NULL) {
      /* This was returned by Tcl_FSJoinToPath above */
      Tcl_DecrRefCount(absolutePath);
      fsPathPtr->cwdPtr = useThisCwd;
  }
    }

    return fsPathPtr->normPathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetInternalRep --
 *
 *      Extract the internal representation of a given path object,
 *      in the given filesystem.  If the path object belongs to a
 *      different filesystem, we return NULL.
 *      
 *      If the internal representation is currently NULL, we attempt
 *      to generate it, by calling the filesystem's 
 *      'Tcl_FSCreateInternalRepProc'.
 *
 * Results:
 *      NULL or a valid internal representation.
 *
 * Side effects:
 *  An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

ClientData 
Tcl_FSGetInternalRep(pathObjPtr, fsPtr)
    Tcl_Obj* pathObjPtr;
    Tcl_Filesystem *fsPtr;
{
    FsPath *srcFsPathPtr;
    
    if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
  return NULL;
    }
    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
    
    /* 
     * We will only return the native representation for the caller's
     * filesystem.  Otherwise we will simply return NULL. This means
     * that there must be a unique bi-directional mapping between paths
     * and filesystems, and that this mapping will not allow 'remapped'
     * files -- files which are in one filesystem but mapped into
     * another.  Another way of putting this is that 'stacked'
     * filesystems are not allowed.  We recognise that this is a
     * potentially useful feature for the future.
     * 
     * Even something simple like a 'pass through' filesystem which
     * logs all activity and passes the calls onto the native system
     * would be nice, but not easily achievable with the current
     * implementation.
     */
    if (srcFsPathPtr->fsRecPtr == NULL) {
  /* 
   * This only usually happens in wrappers like TclpStat which
   * create a string object and pass it to TclpObjStat.  Code
   * which calls the Tcl_FS..  functions should always have a
   * filesystem already set.  Whether this code path is legal or
   * not depends on whether we decide to allow external code to
   * call the native filesystem directly.  It is at least safer
   * to allow this sub-optimal routing.
   */
  Tcl_FSGetFileSystemForPath(pathObjPtr);
  
  /* 
   * If we fail through here, then the path is probably not a
   * valid path in the filesystsem, and is most likely to be a
   * use of the empty path "" via a direct call to one of the
   * objectified interfaces (e.g. from the Tcl testsuite).
   */
  srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
  if (srcFsPathPtr->fsRecPtr == NULL) {
      return NULL;
  }
    }

    if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
  /* 
   * There is still one possibility we should consider; if the
   * file belongs to a different filesystem, perhaps it is
   * actually linked through to a file in our own filesystem
   * which we do care about.  The way we can check for this
   * is we ask what filesystem this path belongs to.
   */
  Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr);
  if (actualFs == fsPtr) {
      return Tcl_FSGetInternalRep(pathObjPtr, fsPtr);
  }
  return NULL;
    }

    if (srcFsPathPtr->nativePathPtr == NULL) {
  Tcl_FSCreateInternalRepProc *proc;
  char *nativePathPtr;

  proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
  if (proc == NULL) {
      return NULL;
  }

  nativePathPtr = (*proc)(pathObjPtr);
  srcFsPathPtr  = (FsPath*) PATHOBJ(pathObjPtr);
  srcFsPathPtr->nativePathPtr = nativePathPtr;
    }

    return srcFsPathPtr->nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSEnsureEpochOk --
 *
 *      This will ensure the pathObjPtr is up to date and can be
 *      converted into a "path" type, and that we are able to generate a
 *      complete normalized path which is used to determine the
 *      filesystem match.
 *
 * Results:
 *      Standard Tcl return code.
 *
 * Side effects:
 *  An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

int 
TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr)
    Tcl_Obj* pathObjPtr;
    Tcl_Filesystem **fsPtrPtr;
{
    FsPath *srcFsPathPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /* 
     * SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE.
     */

    if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
  return TCL_ERROR;
    }

    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);

    /* 
     * Check if the filesystem has changed in some way since
     * this object's internal representation was calculated.
     */
    if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
  /* 
   * We have to discard the stale representation and 
   * recalculate it 
   */
  if (pathObjPtr->bytes == NULL) {
      UpdateStringOfFsPath(pathObjPtr);
  }
  FreeFsPathInternalRep(pathObjPtr);
  pathObjPtr->typePtr = NULL;
  if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
      return TCL_ERROR;
  }
  srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
    }
    /* Check whether the object is already assigned to a fs */
    if (srcFsPathPtr->fsRecPtr != NULL) {
  *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
    }

    return TCL_OK;
}

void 
TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData) 
    Tcl_Obj *pathObjPtr;
    FilesystemRecord *fsRecPtr;
    ClientData clientData;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    /* We assume pathObjPtr is already of the correct type */
    FsPath *srcFsPathPtr;
    
    srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
    srcFsPathPtr->fsRecPtr = fsRecPtr;
    srcFsPathPtr->nativePathPtr = clientData;
    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
    fsRecPtr->fileRefCount++;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSEqualPaths --
 *
 *      This function tests whether the two paths given are equal path
 *      objects.  If either or both is NULL, 0 is always returned.
 *
 * Results:
 *      1 or 0.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */

int 
Tcl_FSEqualPaths(firstPtr, secondPtr)
    Tcl_Obj* firstPtr;
    Tcl_Obj* secondPtr;
{
    if (firstPtr == secondPtr) {
  return 1;
    } else {
  char *firstStr, *secondStr;
  int firstLen, secondLen, tempErrno;

  if (firstPtr == NULL || secondPtr == NULL) {
      return 0;
  }
  firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
  secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
  if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
      return 1;
  }
  /* 
   * Try the most thorough, correct method of comparing fully
   * normalized paths
   */

  tempErrno = Tcl_GetErrno();
  firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
  secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
  Tcl_SetErrno(tempErrno);

  if (firstPtr == NULL || secondPtr == NULL) {
      return 0;
  }
  firstStr  = Tcl_GetStringFromObj(firstPtr, &firstLen);
  secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
  if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
      return 1;
  }
    }

    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --
 *
 *      This function tries to convert the given Tcl_Obj to a valid
 *      Tcl path type.
 *      
 *      The filename may begin with "~" (to indicate current user's
 *      home directory) or "~<user>" (to indicate any user's home
 *      directory).
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *  The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
SetFsPathFromAny(interp, objPtr)
    Tcl_Interp *interp;    /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;    /* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    
    if (objPtr->typePtr == &tclFsPathType) {
  return TCL_OK;
    }
    
    /* 
     * First step is to translate the filename.  This is similar to
     * Tcl_TranslateFilename, but shouldn't convert everything to
     * windows backslashes on that platform.  The current
     * implementation of this piece is a slightly optimised version
     * of the various Tilde/Split/Join stuff to avoid multiple
     * split/join operations.
     * 
     * We remove any trailing directory separator.
     * 
     * However, the split/join routines are quite complex, and
     * one has to make sure not to break anything on Unix, Win
     * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
     * most of the code).
     */
    name = Tcl_GetStringFromObj(objPtr,&len);

    /*
     * Handle tilde substitutions, if needed.
     */
    if (name[0] == '~') {
  char *expandedUser;
  Tcl_DString temp;
  int split;
  char separator='/';
  
  if (tclPlatform==TCL_PLATFORM_MAC) {
      if (strchr(name, ':') != NULL) separator = ':';
  }
  
  split = FindSplitPos(name, &separator);
  if (split != len) {
      /* We have multiple pieces '~user/foo/bar...' */
      name[split] = '\0';
  }
  /* Do some tilde substitution */
  if (name[1] == '\0') {
      /* We have just '~' */
      CONST char *dir;
      Tcl_DString dirString;
      if (split != len) { name[split] = separator; }
      
      dir = TclGetEnv("HOME", &dirString);
      if (dir == NULL) {
    if (interp) {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "couldn't find HOME environment ",
          "variable to expand path", (char *) NULL);
    }
    return TCL_ERROR;
      }
      Tcl_DStringInit(&temp);
      Tcl_JoinPath(1, &dir, &temp);
      Tcl_DStringFree(&dirString);
  } else {
      /* We have a user name '~user' */
      Tcl_DStringInit(&temp);
      if (TclpGetUserHome(name+1, &temp) == NULL) {  
    if (interp != NULL) {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "user \"", (name+1), 
             "\" doesn't exist", (char *) NULL);
    }
    Tcl_DStringFree(&temp);
    if (split != len) { name[split] = separator; }
    return TCL_ERROR;
      }
      if (split != len) { name[split] = separator; }
  }
  
  expandedUser = Tcl_DStringValue(&temp);
  transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));

  if (split != len) {
      /* Join up the tilde substitution with the rest */
      if (name[split+1] == separator) {

    /*
     * Somewhat tricky case like ~//foo/bar.
     * Make use of Split/Join machinery to get it right.
     * Assumes all paths beginning with ~ are part of the
     * native filesystem.
     */

    int objc;
    Tcl_Obj **objv;
    Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
    Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
    /* Skip '~'.  It's replaced by its expansion */
    objc--; objv++;
    while (objc--) {
        TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
    }
    Tcl_DecrRefCount(parts);
      } else {
    /* Simple case. "rest" is relative path.  Just join it. */
    Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
    transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
      }
  }
  Tcl_DStringFree(&temp);
    } else {
  transPtr = Tcl_FSJoinToPath(objPtr,0,NULL);
    }

#if defined(__CYGWIN__) && defined(__WIN32__)
    {
    extern int cygwin_conv_to_win32_path 
  _ANSI_ARGS_((CONST char *, char *));
    char winbuf[MAX_PATH+1];

    /*
     * In the Cygwin world, call conv_to_win32_path in order to use the
     * mount table to translate the file name into something Windows will
     * understand.  Take care when converting empty strings!
     */
    name = Tcl_GetStringFromObj(transPtr, &len);
    if (len > 0) {
  cygwin_conv_to_win32_path(name, winbuf);
  TclWinNoBackslash(winbuf);
  Tcl_SetStringObj(transPtr, winbuf, -1);
    }
    }
#endif /* __CYGWIN__ && __WIN32__ */

    /* 
     * Now we have a translated filename in 'transPtr'.  This will have
     * forward slashes on Windows, and will not contain any ~user
     * sequences.
     */
    
    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsRecPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    /*
     * Free old representation before installing our new one.
     */
    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
  (objPtr->typePtr->freeIntRepProc)(objPtr);
    }
    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
    PATHFLAGS(objPtr) = 0;
    objPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

static void
FreeFsPathInternalRep(pathObjPtr)
    Tcl_Obj *pathObjPtr;  /* Path object with internal rep to free. */
{
    FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);

    if (fsPathPtr->translatedPathPtr != NULL) {
  if (fsPathPtr->translatedPathPtr != pathObjPtr) {
      Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
  }
    }
    if (fsPathPtr->normPathPtr != NULL) {
  if (fsPathPtr->normPathPtr != pathObjPtr) {
      Tcl_DecrRefCount(fsPathPtr->normPathPtr);
  }
  fsPathPtr->normPathPtr = NULL;
    }
    if (fsPathPtr->cwdPtr != NULL) {
  Tcl_DecrRefCount(fsPathPtr->cwdPtr);
    }
    if (fsPathPtr->nativePathPtr != NULL) {
  if (fsPathPtr->fsRecPtr != NULL) {
      if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
    (*fsPathPtr->fsRecPtr->fsPtr
       ->freeInternalRepProc)(fsPathPtr->nativePathPtr);
    fsPathPtr->nativePathPtr = NULL;
      }
  }
    }
    if (fsPathPtr->fsRecPtr != NULL) {
  fsPathPtr->fsRecPtr->fileRefCount--;
  if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
      /* It has been unregistered already, so simply free it */
      ckfree((char *)fsPathPtr->fsRecPtr);
  }
    }

    ckfree((char*) fsPathPtr);
}


static void
DupFsPathInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;    /* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr;    /* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = (FsPath*) PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = (FsPath*) ckalloc((unsigned)sizeof(FsPath));
      
    Tcl_FSDupInternalRepProc *dupProc;
    
    PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr;

    if (srcFsPathPtr->translatedPathPtr != NULL) {
  copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
  if (copyFsPathPtr->translatedPathPtr != copyPtr) {
      Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
  }
    } else {
  copyFsPathPtr->translatedPathPtr = NULL;
    }
    
    if (srcFsPathPtr->normPathPtr != NULL) {
  copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
  if (copyFsPathPtr->normPathPtr != copyPtr) {
      Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
  }
    } else {
  copyFsPathPtr->normPathPtr = NULL;
    }
    
    if (srcFsPathPtr->cwdPtr != NULL) {
  copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
  Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
    } else {
  copyFsPathPtr->cwdPtr = NULL;
    }

    copyFsPathPtr->flags = srcFsPathPtr->flags;
    
    if (srcFsPathPtr->fsRecPtr != NULL 
      && srcFsPathPtr->nativePathPtr != NULL) {
  dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
  if (dupProc != NULL) {
      copyFsPathPtr->nativePathPtr = 
        (*dupProc)(srcFsPathPtr->nativePathPtr);
  } else {
      copyFsPathPtr->nativePathPtr = NULL;
  }
    } else {
  copyFsPathPtr->nativePathPtr = NULL;
    }
    copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
    if (copyFsPathPtr->fsRecPtr != NULL) {
  copyFsPathPtr->fsRecPtr->fileRefCount++;
    }

    copyPtr->typePtr = &tclFsPathType;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateStringOfFsPath --
 *
 *      Gives an object a valid string rep.
 *      
 * Results:
 *      None.
 *
 * Side effects:
 *  Memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateStringOfFsPath(objPtr)
    register Tcl_Obj *objPtr;  /* path obj with string rep to update. */
{
    FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr);
    CONST char *cwdStr;
    int cwdLen;
    Tcl_Obj *copy;
    
    if (PATHFLAGS(objPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
  panic("Called UpdateStringOfFsPath with invalid object");
    }
    
    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
    Tcl_IncrRefCount(copy);
    
    cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
    /* 
     * Should we perhaps use 'Tcl_FSPathSeparator'?
     * But then what about the Windows special case?
     * Perhaps we should just check if cwd is a root volume.
     * We should never get cwdLen == 0 in this code path.
     */
    switch (tclPlatform) {
  case TCL_PLATFORM_UNIX:
      if (cwdStr[cwdLen-1] != '/') {
    Tcl_AppendToObj(copy, "/", 1);
    cwdLen++;
      }
      break;
  case TCL_PLATFORM_WINDOWS:
      /* 
       * We need the extra 'cwdLen != 2', and ':' checks because 
       * a volume relative path doesn't get a '/'.  For example 
       * 'glob C:*cat*.exe' will return 'C:cat32.exe'
       */
      if (cwdStr[cwdLen-1] != '/'
        && cwdStr[cwdLen-1] != '\\') {
    if (cwdLen != 2 || cwdStr[1] != ':') {
        Tcl_AppendToObj(copy, "/", 1);
        cwdLen++;
    }
      }
      break;
  case TCL_PLATFORM_MAC:
      if (cwdStr[cwdLen-1] != ':') {
    Tcl_AppendToObj(copy, ":", 1);
    cwdLen++;
      }
      break;
    }
    Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
    objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    objPtr->length = cwdLen;
    copy->bytes = tclEmptyStringRep;
    copy->length = 0;
    Tcl_DecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativePathInFilesystem --
 *
 *      Any path object is acceptable to the native filesystem, by
 *      default (we will throw errors when illegal paths are actually
 *      tried to be used).
 *      
 *      However, this behavior means the native filesystem must be
 *      the last filesystem in the lookup list (otherwise it will
 *      claim all files belong to it, and other filesystems will
 *      never get a look in).
 *
 * Results:
 *      TCL_OK, to indicate 'yes', -1 to indicate no.
 *
 * Side effects:
 *  None.
 *
 *---------------------------------------------------------------------------
 */
int 
NativePathInFilesystem(pathPtr, clientDataPtr)
    Tcl_Obj *pathPtr;
    ClientData *clientDataPtr;
{
    /* 
     * A special case is required to handle the empty path "". 
     * This is a valid path (i.e. the user should be able
     * to do 'file exists ""' without throwing an error), but
     * equally the path doesn't exist.  Those are the semantics
     * of Tcl (at present anyway), so we have to abide by them
     * here.
     */
    if (pathPtr->typePtr == &tclFsPathType) {
  if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
      /* We reject the empty path "" */
      return -1;
  }
  /* Otherwise there is no way this path can be empty */
    } else {
  /* 
   * It is somewhat unusual to reach this code path without
   * the object being of tclFsPathType.  However, we do
   * our best to deal with the situation.
   */
  int len;
  Tcl_GetStringFromObj(pathPtr,&len);
  if (len == 0) {
      /* We reject the empty path "" */
      return -1;
  }
    }
    /* 
     * Path is of correct type, or is of non-zero length, 
     * so we accept it.
     */
    return TCL_OK;
}
