Tcl Source Code

Artifact [5f43148e26]
Login

Artifact 5f43148e26005a726e7ec5ac14246d80b0f337a9:

Attachment "fsspeed2.patch" to ticket [682500ffff] added by vincentdarley 2003-02-10 06:36:24.
? generic/newTclCmdMZ.c
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.30
diff -u -r1.30 FileSystem.3
--- doc/FileSystem.3	22 Jul 2002 16:51:47 -0000	1.30
+++ doc/FileSystem.3	9 Feb 2003 23:26:27 -0000
@@ -997,15 +997,17 @@
 	Tcl_GlobTypeData * \fItypes\fR);
 .CE
 .PP
-The function should return all files or directories (or other
-filesystem objects) which match the given pattern and accord with the
-\fItypes\fR specification given.  There are two ways in which this 
-function may be called.  If \fIpattern\fR is NULL, then \fIpathPtr\fR
-is a full path specification of a single file or directory which
-should be checked for existence and correct type.  Otherwise, \fIpathPtr\fR
-is a directory, the contents of which the function should search for 
-files or directories which have the correct type.  In either case,
-\fIpathPtr\fR can be assumed to be both non-NULL and non-empty.  
+The function should return all files or directories (or other filesystem
+objects) which match the given pattern and accord with the \fItypes\fR
+specification given.  There are two ways in which this function may be
+called.  If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
+specification of a single file or directory which should be checked for
+existence and correct type.  Otherwise, \fIpathPtr\fR is a directory, the
+contents of which the function should search for files or directories
+which have the correct type.  In either case, \fIpathPtr\fR can be
+assumed to be both non-NULL and non-empty.  It is not currently
+documented whether \fIpathPtr\fR will have a file separator at its end of
+not, so code should be flexible to both possibilities.
 .PP
 The return value is a standard Tcl result indicating whether an error
 occurred in the matching process.  Error messages are placed in interp, 
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.71
diff -u -r1.71 tclIOUtil.c
--- generic/tclIOUtil.c	4 Feb 2003 17:06:50 -0000	1.71
+++ generic/tclIOUtil.c	9 Feb 2003 23:26:43 -0000
@@ -37,12 +37,16 @@
 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 Tcl_Obj*         MakeFsPathFromRelative _ANSI_ARGS_((Tcl_Interp *interp, 
+			    Tcl_Obj *objPtr, Tcl_Obj *cwdPtr));
 static Tcl_Obj*         FSNormalizeAbsolutePath 
                             _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));
 static int              TclNormalizeToUniquePath 
-                            _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr));
+                            _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr,
+					 int startAt));
 static int		SetFsPathFromAbsoluteNormalized 
                             _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
 static int 		FindSplitPos _ANSI_ARGS_((char *path, char *separator));
@@ -61,7 +65,7 @@
     "path",				/* name */
     FreeFsPathInternalRep,		/* freeIntRepProc */
     DupFsPathInternalRep,	        /* dupIntRepProc */
-    NULL,				/* updateStringProc */
+    UpdateStringOfFsPath,		/* updateStringProc */
     SetFsPathFromAny			/* setFromAnyProc */
 };
 
@@ -495,7 +499,8 @@
     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. */ 
+				 * 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
@@ -507,6 +512,8 @@
                                  * entry to use for this path. */
 } FsPath;
 
+#define TCLPATH_APPENDED 1
+#define TCLPATH_RELATIVE 2
 /* 
  * Used to implement Tcl_FSGetCwd in a file-system independent way.
  * This is protected by the cwdMutex below.
@@ -1040,7 +1047,7 @@
 	 * other criteria for normalizing a path.
 	 */
 	Tcl_IncrRefCount(retVal);
-	TclNormalizeToUniquePath(interp, retVal);
+	TclNormalizeToUniquePath(interp, retVal, 0);
 	/* 
 	 * Since we know it is a normalized path, we can
 	 * actually convert this object into an FsPath for
@@ -1082,29 +1089,32 @@
  *	us a unique, case-dependent path).
  *
  * 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.
+ *	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 note:
- *	This is only used by the above function.  Also if the
- *	filesystem-specific normalizePathProcs can re-introduce
+ * 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).
  *---------------------------------------------------------------------------
  */
 static int
-TclNormalizeToUniquePath(interp, pathPtr)
+TclNormalizeToUniquePath(interp, pathPtr, startAt)
     Tcl_Interp *interp;
     Tcl_Obj *pathPtr;
+    int startAt;
 {
     FilesystemRecord *fsRecPtr;
-    int retVal = 0;
 
     /*
      * Call each of the "normalise path" functions in succession. This is
@@ -1118,7 +1128,7 @@
         if (fsRecPtr == &nativeFilesystemRecord) {
 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
 	    if (proc != NULL) {
-		retVal = (*proc)(interp, pathPtr, retVal);
+		startAt = (*proc)(interp, pathPtr, startAt);
 	    }
 	    break;
         }
@@ -1132,7 +1142,7 @@
 	if (fsRecPtr != &nativeFilesystemRecord) {
 	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
 	    if (proc != NULL) {
-		retVal = (*proc)(interp, pathPtr, retVal);
+		startAt = (*proc)(interp, pathPtr, startAt);
 	    }
 	    /* 
 	     * We could add an efficiency check like this:
@@ -1146,7 +1156,7 @@
     }
     FsReleaseIterator();
 
-    return (retVal);
+    return (startAt);
 }
 
 /*
@@ -1540,16 +1550,8 @@
 {
     Tcl_Filesystem *fsPtr;
 #ifdef USE_OBSOLETE_FS_HOOKS
-    StatProc *statProcPtr;
     struct stat oldStyleStatBuffer;
     int retVal = -1;
-    char *path;
-    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
-    if (transPtr == NULL) {
-        path = NULL;
-    } else {
-	path = Tcl_GetString(transPtr);
-    }
 
     /*
      * Call each of the "stat" function in succession.  A non-return
@@ -1557,11 +1559,24 @@
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
-    statProcPtr = statProcList;
-    while ((retVal == -1) && (statProcPtr != NULL)) {
-	retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
-	statProcPtr = statProcPtr->nextPtr;
+    
+    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;
+	}
     }
+    
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
     if (retVal != -1) {
 	/*
@@ -1663,15 +1678,7 @@
 {
     Tcl_Filesystem *fsPtr;
 #ifdef USE_OBSOLETE_FS_HOOKS
-    AccessProc *accessProcPtr;
     int retVal = -1;
-    char *path;
-    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
-    if (transPtr == NULL) {
-	path = NULL;
-    } else {
-	path = Tcl_GetString(transPtr);
-    }
 
     /*
      * Call each of the "access" function in succession.  A non-return
@@ -1679,11 +1686,24 @@
      */
 
     Tcl_MutexLock(&obsoleteFsHookMutex);
-    accessProcPtr = accessProcList;
-    while ((retVal == -1) && (accessProcPtr != NULL)) {
-	retVal = (*accessProcPtr->proc)(path, mode);
-	accessProcPtr = accessProcPtr->nextPtr;
+
+    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;
+	}
     }
+    
     Tcl_MutexUnlock(&obsoleteFsHookMutex);
     if (retVal != -1) {
 	return retVal;
@@ -1812,12 +1832,12 @@
  *	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, and then remove it
- *	from the results returned.  This makes filesystems easy to
- *	write, since they can assume the pathPtr passed to them
+ *	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.
  *	
@@ -1837,7 +1857,8 @@
  *	   
  *	which must recurse through each directory matching '*' are
  *	handled internally by Tcl, by passing specific flags in a 
- *	modified 'types' parameter.
+ *	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.
@@ -1899,9 +1920,7 @@
 	    Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
 	    if (proc != NULL) {
 		int cwdLen;
-		Tcl_Obj *cwdDir;
 		char *cwdStr;
-		char sep = 0;
 		Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
 		/* 
 		 * We know the cwd is a normalised object which does
@@ -1915,9 +1934,7 @@
 		 * either too much or too little below, leading to
 		 * wrong answers returned by glob.
 		 */
-		cwdDir = Tcl_DuplicateObj(cwd);
-		Tcl_IncrRefCount(cwdDir);
-		cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen);
+		cwdStr = Tcl_GetStringFromObj(cwd, &cwdLen);
 		/* 
 		 * Should we perhaps use 'Tcl_FSPathSeparator'?
 		 * But then what about the Windows special case?
@@ -1927,38 +1944,48 @@
 		switch (tclPlatform) {
 		    case TCL_PLATFORM_UNIX:
 			if (cwdStr[cwdLen-1] != '/') {
-			    sep = '/';
+			    cwdLen++;
 			}
 			break;
 		    case TCL_PLATFORM_WINDOWS:
-			if (cwdStr[cwdLen-1] != '/' && cwdStr[cwdLen-1] != '\\') {
-			    sep = '/';
+			if (cwdStr[cwdLen-1] != '/' 
+			  && cwdStr[cwdLen-1] != '\\') {
+			    cwdLen++;
 			}
 			break;
 		    case TCL_PLATFORM_MAC:
 			if (cwdStr[cwdLen-1] != ':') {
-			    sep = ':';
+			    cwdLen++;
 			}
 			break;
 		}
-		if (sep != 0) {
-		    Tcl_AppendToObj(cwdDir, &sep, 1);
-		    cwdLen++;
-		    /* Note: cwdStr may no longer be a valid pointer now */
-		}
-		ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types);
-		Tcl_DecrRefCount(cwdDir);
+		ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
 		if (ret == TCL_OK) {
 		    int resLength;
 
 		    ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
 		    if (ret == TCL_OK) {
-			Tcl_Obj *elt, *cutElt;
-			char *eltStr;
-			int eltLen, i;
+			int i;
 
 			for (i = 0; i < resLength; i++) {
+			    Tcl_Obj *cutElt, *elt;
+			    char *eltStr;
+			    int eltLen;
+			    
 			    Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
+			    
+			    if (elt->typePtr == &tclFsPathType) {
+				FsPath* fsPathPtr = (FsPath*) 
+				                elt->internalRep.otherValuePtr;
+				if (fsPathPtr->flags != 0 
+				    && fsPathPtr->cwdPtr == cwd) {
+				    Tcl_ListObjAppendElement(interp, result, 
+					MakeFsPathFromRelative(interp, 
+						fsPathPtr->normPathPtr, cwd));
+				    continue;
+				}
+			    }
+				
 			    eltStr = Tcl_GetStringFromObj(elt,&eltLen);
 			    cutElt = Tcl_NewStringObj(eltStr + cwdLen,
 				    eltLen - cwdLen);
@@ -3031,7 +3058,11 @@
     } else {
 	FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
 	if (fsPathPtr->cwdPtr != NULL) {
-	    return TCL_PATH_RELATIVE;
+	    if (fsPathPtr->flags == 0) {
+	        return TCL_PATH_RELATIVE;
+	    }
+	    return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, 
+				 driveNameLengthPtr);
 	} else {
 	    return GetPathType(pathObjPtr, filesystemPtrPtr, 
 			       driveNameLengthPtr, NULL);
@@ -3147,7 +3178,9 @@
  *      we use the entire list.
  *      
  * Results:
- *      Returns object with refCount of zero.
+ *      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.
@@ -3175,13 +3208,58 @@
 	}
 	/* 
 	 * Correct this if it is too large, otherwise we will
-	 * waste our timing joining null elements to the path 
+	 * waste our time joining null elements to the path 
 	 */
 	if (elements > listTest) {
 	    elements = listTest;
 	}
     }
     
+    if (elements == 2) {
+	/* 
+	 * This is a special case where we can be much more
+	 * efficient
+	 */
+	Tcl_Obj *base;
+	
+	Tcl_ListObjIndex(NULL, listObj, 0, &base);
+	/* 
+	 * There is only any value in doing this if the first object is
+	 * of path type, otherwise we'll never actually get any
+	 * efficiency benefit elsewhere in the code (from re-using the
+	 * normalized representation of the base object).
+	 */
+	if (base->typePtr == &tclFsPathType) {
+	    Tcl_Obj *tail;
+	    Tcl_PathType type;
+	    Tcl_ListObjIndex(NULL, listObj, 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!
+		     */
+		    return base;
+		}
+		if (str[0] != '.') {
+		    return TclNewFSPathObj(base, str, len);
+		}
+		/* 
+		 * Otherwise we don't have an easy join, and
+		 * we must let the more general code below handle
+		 * things
+		 */
+	    } else {
+		return tail;
+	    }
+	}
+    }
+    
     res = Tcl_NewObj();
     
     for (i = 0; i < elements; i++) {
@@ -3746,7 +3824,6 @@
  *
  *---------------------------------------------------------------------------
  */
-
 int 
 Tcl_FSConvertToPathType(interp, objPtr)
     Tcl_Interp *interp;		/* Interpreter in which to store error
@@ -3766,10 +3843,14 @@
     if (objPtr->typePtr == &tclFsPathType) {
 	FsPath *fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
 	if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+	    if (objPtr->bytes == NULL) {
+		UpdateStringOfFsPath(objPtr);
+	    }
 	    FreeFsPathInternalRep(objPtr);
 	    objPtr->typePtr = NULL;
 	    return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
 	}
+	return TCL_OK;
 	if (fsPathPtr->cwdPtr == NULL) {
 	    return TCL_OK;
 	} else {
@@ -3823,6 +3904,198 @@
 /*
  *---------------------------------------------------------------------------
  *
+ * 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. */
+{
+    register FsPath* fsPathPtr = 
+      (FsPath*) objPtr->internalRep.otherValuePtr;
+    CONST char *cwdStr;
+    int cwdLen;
+    Tcl_Obj *copy;
+    
+    if (fsPathPtr->flags == 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.
+     */
+    switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	    if (cwdStr[cwdLen-1] != '/') {
+		Tcl_AppendToObj(copy, "/", 1);
+		cwdLen++;
+	    }
+	    break;
+	case TCL_PLATFORM_WINDOWS:
+	    /* 
+	     * We need the cwdLen > 2 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);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * 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;
+    
+    objPtr = Tcl_NewObj();
+    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+    
+    /* Setup the path */
+    fsPathPtr->translatedPathPtr = NULL;
+    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
+    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
+    fsPathPtr->cwdPtr = dirPtr;
+    Tcl_IncrRefCount(dirPtr);
+    fsPathPtr->flags = TCLPATH_RELATIVE | TCLPATH_APPENDED;
+    fsPathPtr->nativePathPtr = NULL;
+    fsPathPtr->fsRecPtr = NULL;
+    fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+    objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+    objPtr->typePtr = &tclFsPathType;
+    objPtr->bytes = NULL;
+    objPtr->length = 0;
+    return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MakeFsPathFromRelative --
+ *
+ *      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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+MakeFsPathFromRelative(interp, objPtr, cwdPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+    Tcl_Obj *cwdPtr;		/* The object to convert. */
+{
+    FsPath *fsPathPtr;
+    
+    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 NULL;
+	    }
+	    objPtr->typePtr->updateStringProc(objPtr);
+	}
+	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+	    (*objPtr->typePtr->freeIntRepProc)(objPtr);
+	}
+    }
+
+    fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
+
+    /* Circular reference, by design */
+    fsPathPtr->translatedPathPtr = objPtr;
+    fsPathPtr->normPathPtr = NULL;
+    fsPathPtr->flags = 0;
+    fsPathPtr->cwdPtr = cwdPtr;
+    Tcl_IncrRefCount(cwdPtr);
+    fsPathPtr->nativePathPtr = NULL;
+    fsPathPtr->fsRecPtr = NULL;
+    fsPathPtr->filesystemEpoch = theFilesystemEpoch;
+
+    objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr;
+    objPtr->typePtr = &tclFsPathType;
+
+    return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
  * SetFsPathFromAbsoluteNormalized --
  *
  *      Like SetFsPathFromAny, but assumes the given object is an
@@ -3870,6 +4143,7 @@
     /* It's a pure normalized absolute path */
     fsPathPtr->translatedPathPtr = NULL;
     fsPathPtr->normPathPtr = objPtr;
+    fsPathPtr->flags = 0;
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = NULL;
     fsPathPtr->fsRecPtr = NULL;
@@ -4031,6 +4305,7 @@
     fsPathPtr->translatedPathPtr = transPtr;
     Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
     fsPathPtr->normPathPtr = NULL;
+    fsPathPtr->flags = 0;
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = NULL;
     fsPathPtr->fsRecPtr = NULL;
@@ -4122,6 +4397,7 @@
     fsPathPtr->translatedPathPtr = NULL;
     /* Circular reference, by design */
     fsPathPtr->normPathPtr = objPtr;
+    fsPathPtr->flags = 0;
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = clientData;
     fsPathPtr->fsRecPtr = fsFromPtr;
@@ -4142,7 +4418,9 @@
       (FsPath*) pathObjPtr->internalRep.otherValuePtr;
 
     if (fsPathPtr->translatedPathPtr != NULL) {
-	Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
+	if (fsPathPtr->translatedPathPtr != pathObjPtr) {
+	    Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
+	}
     }
     if (fsPathPtr->normPathPtr != NULL) {
 	if (fsPathPtr->normPathPtr != pathObjPtr) {
@@ -4188,7 +4466,9 @@
 
     if (srcFsPathPtr->translatedPathPtr != NULL) {
 	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
-	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+	if (copyFsPathPtr->translatedPathPtr != copyPtr) {
+	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
+	}
     } else {
 	copyFsPathPtr->translatedPathPtr = NULL;
     }
@@ -4209,6 +4489,8 @@
 	copyFsPathPtr->cwdPtr = NULL;
     }
 
+    copyFsPathPtr->flags = srcFsPathPtr->flags;
+    
     if (srcFsPathPtr->fsRecPtr != NULL 
       && srcFsPathPtr->nativePathPtr != NULL) {
 	dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
@@ -4295,8 +4577,8 @@
  */
 CONST char*
 Tcl_FSGetTranslatedStringPath(interp, pathPtr)
-Tcl_Interp *interp;
-Tcl_Obj* pathPtr;
+    Tcl_Interp *interp;
+    Tcl_Obj* pathPtr;
 {
     Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
     if (transPtr == NULL) {
@@ -4330,18 +4612,156 @@
     Tcl_Interp *interp;
     Tcl_Obj* pathObjPtr;
 {
-    register FsPath* srcFsPathPtr;
+    register FsPath* fsPathPtr;
     if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
 	return NULL;
     }
-    srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
-    if (srcFsPathPtr->normPathPtr == NULL) {
+    fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+
+    /* Ensure cwd hasn't changed */
+    if (fsPathPtr->flags != 0) {
+	Tcl_Obj *dir, *copy;
+	int dirLen;
+	int pathType;
+	CONST char *cwdStr;
+	
+	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,&dirLen);
+	/* 
+	 * 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 (cwdStr[dirLen-1] != '/') {
+		    Tcl_AppendToObj(copy, "/", 1);
+		    dirLen++;
+		}
+		break;
+	    case TCL_PLATFORM_WINDOWS:
+		if (cwdStr[dirLen-1] != '/' 
+		  && cwdStr[dirLen-1] != '\\') {
+		    Tcl_AppendToObj(copy, "/", 1);
+		    dirLen++;
+		}
+		break;
+	    case TCL_PLATFORM_MAC:
+		if (cwdStr[dirLen-1] != ':') {
+		    Tcl_AppendToObj(copy, ":", 1);
+		    dirLen++;
+		}
+		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 'dirLen-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.
+	 */
+	TclNormalizeToUniquePath(interp, copy, dirLen-1);
+	/* Now we need to construct the new path object */
+	
+	if (pathType == TCL_PATH_RELATIVE) {
+	    register FsPath* origDirFsPathPtr;
+	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;
+	    origDirFsPathPtr = (FsPath*) origDir->internalRep.otherValuePtr;
+	    
+	    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);
+	}
+	fsPathPtr->flags = 0;
+    }
+    if (fsPathPtr->cwdPtr != NULL) {
+	if (!FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
+	    FreeFsPathInternalRep(pathObjPtr);
+	    pathObjPtr->typePtr = NULL;
+	    if (Tcl_ConvertToType(interp, pathObjPtr, 
+				  &tclFsPathType) != TCL_OK) {
+	        return NULL;
+	    }
+	    fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr;
+	} else if (fsPathPtr->normPathPtr == NULL) {
+	    int dirLen;
+	    Tcl_Obj *copy;
+	    CONST char *cwdStr;
+	    
+	    copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
+	    Tcl_IncrRefCount(copy);
+	    cwdStr = Tcl_GetStringFromObj(copy,&dirLen);
+	    /* 
+	     * 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 (cwdStr[dirLen-1] != '/') {
+			Tcl_AppendToObj(copy, "/", 1);
+			dirLen++;
+		    }
+		    break;
+		case TCL_PLATFORM_WINDOWS:
+		    if (cwdStr[dirLen-1] != '/' 
+		      && cwdStr[dirLen-1] != '\\') {
+			Tcl_AppendToObj(copy, "/", 1);
+			dirLen++;
+		    }
+		    break;
+		case TCL_PLATFORM_MAC:
+		    if (cwdStr[dirLen-1] != ':') {
+			Tcl_AppendToObj(copy, ":", 1);
+			dirLen++;
+		    }
+		    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!
+	     */
+	    TclNormalizeToUniquePath(interp, copy, dirLen-1);
+	    fsPathPtr->normPathPtr = copy;
+	}
+    }
+    if (fsPathPtr->normPathPtr == NULL) {
 	int relative = 0;
 	/* 
 	 * Since normPathPtr is NULL, but this is a valid path
 	 * object, we know that the translatedPathPtr cannot be NULL.
 	 */
-	Tcl_Obj *absolutePath = srcFsPathPtr->translatedPathPtr;
+	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
 	char *path = Tcl_GetString(absolutePath);
 	
 	/* 
@@ -4365,19 +4785,19 @@
 	    relative = 1;
 	}
 	/* Already has refCount incremented */
-	srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
-	if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr),
+	fsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath);
+	if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
 		    Tcl_GetString(pathObjPtr))) {
 	    /* 
 	     * The path was already normalized.  
 	     * Get rid of the duplicate.
 	     */
-	    Tcl_DecrRefCount(srcFsPathPtr->normPathPtr);
+	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
 	    /* 
 	     * We do *not* increment the refCount for 
 	     * this circular reference 
 	     */
-	    srcFsPathPtr->normPathPtr = pathObjPtr;
+	    fsPathPtr->normPathPtr = pathObjPtr;
 	}
 	if (relative) {
 	    /* This was returned by Tcl_FSJoinToPath above */
@@ -4385,12 +4805,12 @@
 
 	    /* Get a quick, temporary lock on the cwd while we copy it */
 	    Tcl_MutexLock(&cwdMutex);
-	    srcFsPathPtr->cwdPtr = cwdPathPtr;
-	    Tcl_IncrRefCount(srcFsPathPtr->cwdPtr);
+	    fsPathPtr->cwdPtr = cwdPathPtr;
+	    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
 	    Tcl_MutexUnlock(&cwdMutex);
 	}
     }
-    return srcFsPathPtr->normPathPtr;
+    return fsPathPtr->normPathPtr;
 }
 
 /*
@@ -4532,6 +4952,43 @@
     return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
 }
 
+static Tcl_Obj*
+FsGetValidObjRep(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. */
+{
+    FsPath *fsPathPtr;
+    if (objPtr->typePtr != &tclFsPathType) {
+	if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
+	    return NULL;
+	}
+    }
+    fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
+    
+    if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
+	if (objPtr->bytes == NULL) {
+	    UpdateStringOfFsPath(objPtr);
+	}
+	FreeFsPathInternalRep(objPtr);
+	objPtr->typePtr = NULL;
+	if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
+	    return NULL;
+	}
+	fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
+    }
+    
+    if (fsPathPtr->cwdPtr != NULL) {
+	if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
+          /* This causes a few minor test failures with links */
+          /* Once these are resolved, this would improve efficiency */
+	  /* return objPtr; */
+	}
+    }
+    return Tcl_FSGetNormalizedPath(interp, objPtr);
+}
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -4553,14 +5010,14 @@
 {
     char *nativePathPtr;
     Tcl_DString ds;
-    Tcl_Obj* normPtr;
+    Tcl_Obj* validPathObjPtr;
     int len;
     char *str;
 
     /* Make sure the normalized path is set */
-    normPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+    validPathObjPtr = FsGetValidObjRep(NULL, pathObjPtr);
 
-    str = Tcl_GetStringFromObj(normPtr,&len);
+    str = Tcl_GetStringFromObj(validPathObjPtr,&len);
 #ifdef __WIN32__
     Tcl_WinUtfToTChar(str, len, &ds);
     if (tclWinProcs->useWide) {
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.117
diff -u -r1.117 tclInt.h
--- generic/tclInt.h	4 Feb 2003 17:06:50 -0000	1.117
+++ generic/tclInt.h	9 Feb 2003 23:26:51 -0000
@@ -1717,6 +1717,8 @@
 			    Tcl_StatBuf *buf));
 EXTERN int		TclpCheckStackSpace _ANSI_ARGS_((void));
 EXTERN Tcl_Obj*         TclpTempFileName _ANSI_ARGS_((void));
+EXTERN Tcl_Obj*         TclNewFSPathObj _ANSI_ARGS_((Tcl_Obj *dirPtr, 
+			    CONST char *addStrRep, int len));
 EXTERN int              TclpDeleteFile _ANSI_ARGS_((CONST char *path));
 EXTERN void		TclpFinalizeCondition _ANSI_ARGS_((
 			    Tcl_Condition *condPtr));
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.19
diff -u -r1.19 fileSystem.test
--- tests/fileSystem.test	7 Feb 2003 15:29:32 -0000	1.19
+++ tests/fileSystem.test	9 Feb 2003 23:26:53 -0000
@@ -423,7 +423,6 @@
 test filesystem-8.1 {relative path objects and caching of pwd} {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
-    # We created this file several tests ago.
     makeDirectory abc
     makeDirectory def
     makeFile "contents" [file join abc foo]
@@ -444,6 +443,22 @@
     cd $dir
     set res
 } {1 1 0 0}
+
+test filesystem-8.2 {relative path objects and use of pwd} {
+    set origdir [pwd]
+    cd [tcltest::temporaryDirectory]
+    set dir "abc"
+    makeDirectory $dir
+    makeFile "contents" [file join abc foo]
+    cd $dir
+    set res [file exists [lindex [glob *] 0]]
+    cd ..
+    removeFile [file join abc foo]
+    removeDirectory abc
+    removeDirectory def
+    cd $origdir
+    set res
+} {1}
 
 cleanupTests
 }
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.26
diff -u -r1.26 tclUnixFCmd.c
--- unix/tclUnixFCmd.c	4 Feb 2003 17:06:52 -0000	1.26
+++ unix/tclUnixFCmd.c	9 Feb 2003 23:26:57 -0000
@@ -1652,7 +1652,6 @@
  *
  *---------------------------------------------------------------------------
  */
-
 int
 TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
     Tcl_Interp *interp;
@@ -1668,9 +1667,29 @@
     Tcl_DString ds;
     CONST char *nativePath; 
 #endif
+    /* 
+     * We add '1' here because if nextCheckpoint is zero we know
+     * that '/' exists, and if it isn't zero, it must point at
+     * a directory separator which we also know exists.
+     */
+    currentPathEndPosition = path + nextCheckpoint + 1;
 
-    currentPathEndPosition = path + nextCheckpoint;
-
+#ifndef NO_REALPATH
+    /* For speed, try to get the entire path in one go */
+    if (nextCheckpoint == 0) {
+        char *lastDir = strrchr(currentPathEndPosition, '/');
+	if (lastDir != NULL) {
+	    nativePath = Tcl_UtfToExternalDString(NULL, path, 
+						  lastDir - path, &ds);
+	    if (Realpath(nativePath, normPath) != NULL) {
+		nextCheckpoint = lastDir - path;
+		goto wholeStringOk;
+	    }
+	}
+    }
+    /* Else do it the slow way */
+#endif
+    
     while (1) {
 	cur = *currentPathEndPosition;
 	if ((cur == '/') && (path != currentPathEndPosition)) {
@@ -1713,12 +1732,25 @@
     
     nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
     if (Realpath(nativePath, normPath) != NULL) {
+	int newNormLen;
+	wholeStringOk:
+	newNormLen = strlen(normPath);
+	if (newNormLen == Tcl_DStringLength(&ds) 
+	    && (strcmp(normPath, nativePath) == 0)) {
+	    /* String is unchanged */
+	    Tcl_DStringFree(&ds);
+	    if (path[nextCheckpoint] != '\0') {
+		nextCheckpoint++;
+	    }
+	    return nextCheckpoint;
+	}
+	
 	/* 
 	 * Free up the native path and put in its place the
 	 * converted, normalized path.
 	 */
 	Tcl_DStringFree(&ds);
-	Tcl_ExternalToUtfDString(NULL, normPath, (int) strlen(normPath), &ds);
+	Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);
 
 	if (path[nextCheckpoint] != '\0') {
 	    /* not at end, append remaining path */
@@ -1745,3 +1777,6 @@
 
     return nextCheckpoint;
 }
+
+
+
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.29
diff -u -r1.29 tclUnixFile.c
--- unix/tclUnixFile.c	9 Jan 2003 10:38:34 -0000	1.29
+++ unix/tclUnixFile.c	9 Feb 2003 23:26:59 -0000
@@ -353,7 +353,7 @@
 		}
 		if (typeOk) {
 		    Tcl_ListObjAppendElement(interp, resultPtr, 
-			    Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+		      TclNewFSPathObj(pathPtr, utf, Tcl_DStringLength(&utfDs)));
 		}
 	    }
 	    Tcl_DStringFree(&utfDs);
Index: win/tclWinFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFile.c,v
retrieving revision 1.42
diff -u -r1.42 tclWinFile.c
--- win/tclWinFile.c	7 Feb 2003 15:29:34 -0000	1.42
+++ win/tclWinFile.c	9 Feb 2003 23:27:06 -0000
@@ -860,11 +860,8 @@
 	     */
 
 	    Tcl_DStringAppend(&dsOrig, name, -1);
-	    Tcl_DStringFree(&ds);
 
 	    fullname = Tcl_DStringValue(&dsOrig);
-	    nativeName = Tcl_WinUtfToTChar(fullname, 
-					   Tcl_DStringLength(&dsOrig), &ds);
 	    
 	    if (checkDrive) {
 		isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
@@ -873,7 +870,7 @@
 	    }
 	    if (NativeMatchType(isDrive, attr, nativeName, types)) {
 		Tcl_ListObjAppendElement(interp, resultPtr, 
-		  Tcl_NewStringObj(fullname, Tcl_DStringLength(&dsOrig)));
+			TclNewFSPathObj(pathPtr, name, Tcl_DStringLength(&ds)));
 	    }
 	    /*
 	     * Free ds here to ensure that nativeName is valid above.