X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffilesys.lisp;h=849d66ed4baaa9a4e7ca1b9699e18e0b9fd5a4a2;hb=f1407e424f1063203af07d2e61ceef58515a4797;hp=2e80dcb7c398f3991efd13e6712de11d1da62203;hpb=e1ba5a0d68ff8d4c8e688cd6a951aea1d56b1b61;p=sbcl.git

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 2e80dcb..849d66e 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -54,7 +54,7 @@
    checked for whatever they may have protected."
   (declare (type simple-base-string namestr)
 	   (type index start end))
-  (let* ((result (make-string (- end start)))
+  (let* ((result (make-string (- end start) :element-type 'base-char))
 	 (dst 0)
 	 (quoted nil))
     (do ((src start (1+ src)))
@@ -521,9 +521,9 @@
 	(let ((piece (car tail)))
 	  (etypecase piece
 	    (simple-string
-	     (let ((head (concatenate 'string head piece)))
+	     (let ((head (concatenate 'base-string head piece)))
 	       (with-directory-node-noted (head)
-		 (%enumerate-directories (concatenate 'string head "/")
+		 (%enumerate-directories (concatenate 'base-string head "/")
 					 (cdr tail) pathname
 					 verify-existence follow-links
 					 nodes function))))
@@ -532,7 +532,7 @@
 				     verify-existence follow-links
 				     nodes function)
 	     (dolist (name (ignore-errors (directory-lispy-filenames head)))
-	       (let ((subdir (concatenate 'string head name)))
+	       (let ((subdir (concatenate 'base-string head name)))
 		 (multiple-value-bind (res dev ino mode)
 		     (unix-xstat subdir)
 		   (declare (type (or fixnum null) mode))
@@ -543,14 +543,14 @@
 					  (eql (cdr dir) ino))
 				 (return t)))
 		       (let ((nodes (cons (cons dev ino) nodes))
-			     (subdir (concatenate 'string subdir "/")))
+			     (subdir (concatenate 'base-string subdir "/")))
 			 (%enumerate-directories subdir tail pathname
 						 verify-existence follow-links
 						 nodes function))))))))
 	    ((or pattern (member :wild))
 	     (dolist (name (directory-lispy-filenames head))
 	       (when (or (eq piece :wild) (pattern-matches piece name))
-		 (let ((subdir (concatenate 'string head name)))
+		 (let ((subdir (concatenate 'base-string head name)))
 		   (multiple-value-bind (res dev ino mode)
 		       (unix-xstat subdir)
 		     (declare (type (or fixnum null) mode))
@@ -558,15 +558,15 @@
 				(eql (logand mode sb!unix:s-ifmt)
 				     sb!unix:s-ifdir))
 		       (let ((nodes (cons (cons dev ino) nodes))
-			     (subdir (concatenate 'string subdir "/")))
+			     (subdir (concatenate 'base-string subdir "/")))
 			 (%enumerate-directories subdir (rest tail) pathname
 						 verify-existence follow-links
 						 nodes function))))))))
 	  ((member :up)
 	     (with-directory-node-removed (head)
-	     (let ((head (concatenate 'string head "..")))
+	     (let ((head (concatenate 'base-string head "..")))
 	       (with-directory-node-noted (head)
-		 (%enumerate-directories (concatenate 'string head "/")
+		 (%enumerate-directories (concatenate 'base-string head "/")
 					 (rest tail) pathname
 					 verify-existence follow-links
 					 nodes function)))))))
@@ -608,19 +608,19 @@
 			  (components-match file-type type)
 			  (components-match file-version version))
 		 (funcall function
-			  (concatenate 'string
+			  (concatenate 'base-string
 				       directory
 				       complete-filename))))))
 	  (t
 	   (/noshow0 "default case")
-	   (let ((file (concatenate 'string directory name)))
+	   (let ((file (concatenate 'base-string directory name)))
 	     (/noshow "computed basic FILE")
 	     (unless (or (null type) (eq type :unspecific))
 	       (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
-	       (setf file (concatenate 'string file "." type)))
+	       (setf file (concatenate 'base-string file "." type)))
 	     (unless (member version '(nil :newest :wild :unspecific))
 	       (/noshow0 "tweaking FILE for more-or-less-:WILD case")
-	       (setf file (concatenate 'string file "."
+	       (setf file (concatenate 'base-string file "."
 				       (quick-integer-to-string version))))
 	     (/noshow0 "finished possibly tweaking FILE")
 	     (when (or (not verify-existence)
@@ -638,11 +638,11 @@
 	((zerop n) "0")
 	((eql n 1) "1")
 	((minusp n)
-	 (concatenate 'simple-string "-"
-		      (the simple-string (quick-integer-to-string (- n)))))
+	 (concatenate 'simple-base-string "-"
+		      (the simple-base-string (quick-integer-to-string (- n)))))
 	(t
 	 (do* ((len (1+ (truncate (integer-length n) 3)))
-	       (res (make-string len))
+	       (res (make-string len :element-type 'base-char))
 	       (i (1- len) (1- i))
 	       (q n)
 	       (r 0))
@@ -725,8 +725,11 @@
     (when (and namestring (sb!unix:unix-file-kind namestring t))
       (let ((trueishname (sb!unix:unix-resolve-links namestring)))
 	(when trueishname
-	  (let ((*ignore-wildcards* t))
-	    (pathname (sb!unix:unix-simplify-pathname trueishname))))))))
+	  (let* ((*ignore-wildcards* t)
+		 (name (sb!unix:unix-simplify-pathname trueishname))) 
+	    (if (eq (sb!unix:unix-file-kind name) :directory)
+		(pathname (concatenate 'string name "/"))
+		(pathname name))))))))
 
 ;;;; miscellaneous other operations
 
@@ -824,14 +827,10 @@
 	;; (which can arise when e.g. multiple symlinks map to the
 	;; same truename).
 	(truenames (make-hash-table :test #'equal))
-        (merged-pathname (merge-pathnames pathname
-					  *default-pathname-defaults*)))
+        (merged-pathname (merge-pathnames pathname)))
     (!enumerate-matches (match merged-pathname)
       (let* ((*ignore-wildcards* t)
-	     (truename (truename (if (eq (sb!unix:unix-file-kind match)
-					 :directory)
-				     (concatenate 'string match "/")
-				     match))))
+	     (truename (truename match)))
         (setf (gethash (namestring truename) truenames)
 	      truename)))
     (mapcar #'cdr