Use PROBE-FILE and NATIVE-NAMESTRING instead as appropriate.
(let ((pathname (getf options :filename)))
(with-stream-class (probe-simple-stream stream)
(add-stream-instance-flags stream :simple)
- (when (sb-unix:unix-access (sb-int:unix-namestring pathname nil) sb-unix:f_ok)
+ (when (sb-unix:unix-access (file-namestring pathname) sb-unix:f_ok)
(setf (sm pathname stream) pathname)
t))))
(if (typep stream 'file-simple-stream)
(with-stream-class (file-simple-stream stream)
(setf (sm pathname stream) new-name)
- (setf (sm filename stream) (sb-int:unix-namestring new-name nil))
+ (setf (sm filename stream) (file-namestring new-name))
t)
nil))
(cond (new-name
(setf (sb-impl::fd-stream-pathname stream) new-name)
(setf (sb-impl::fd-stream-file stream)
- (sb-int:unix-namestring new-name nil))
+ (file-namestring new-name))
t)
(t
(sb-impl::fd-stream-pathname stream))))))
(:io (values t t sb-unix:o_rdwr))
(:probe (values t nil sb-unix:o_rdonly)))
(declare (type sb-int:index mask))
- (let ((name (cond ((sb-int:unix-namestring pathname input))
- ((and input (eq if-does-not-exist :create))
- (sb-int:unix-namestring pathname nil))
- ((and (eq direction :io) (not if-does-not-exist-given))
- (sb-int:unix-namestring pathname nil)))))
+ (let* ((phys (sb-int:physicalize-pathname (merge-pathnames pathname)))
+ (true (probe-file phys))
+ (name (cond (true
+ (sb-ext:native-namestring true :as-file t))
+ ((or (not input)
+ (and input (eq if-does-not-exist :create))
+ (and (eq direction :io) (not if-does-not-exist-given)))
+ (sb-ext:native-namestring phys :as-file t)))))
;; Process if-exists argument if we are doing any output.
(cond (output
(unless if-exists-given
(in-package "SB-SIMPLE-STREAMS")
+(defun file-namestring (pathname)
+ (sb-ext:native-namestring (sb-int:physicalize-pathname pathnane) :as-file t))
+
(defmacro def-stream-class (name superclasses slots &rest options)
`(defclass ,name ,superclasses ,slots ,@options))
"READ-SEQUENCE-OR-DIE"
"RENAME-KEY-ARGS"
"MISSING-ARG"
- "UNIX-NAMESTRING" ; FIXME: perhaps belongs in package SB!UNIX
"FEATUREP"
"FLUSH-STANDARD-OUTPUT-STREAMS"
"WITH-UNIQUE-NAMES" "MAKE-GENSYM-LIST"
(:io (values t t sb!unix:o_rdwr))
(:probe (values t nil sb!unix:o_rdonly)))
(declare (type index mask))
- (let* ((pathname (merge-pathnames filename))
- (namestring
- (cond ((unix-namestring pathname input))
- ((and input (eq if-does-not-exist :create))
- (unix-namestring pathname nil))
- ((and (eq direction :io) (not if-does-not-exist-given))
- (unix-namestring pathname nil)))))
+ (let* ((pathname (physicalize-pathname (merge-pathnames filename)))
+ (truename (probe-file pathname))
+ (namestring (cond (truename
+ (native-namestring truename :as-file t))
+ ((or (not input)
+ (and input (eq if-does-not-exist :create))
+ (and (eq direction :io) (not if-does-not-exist-given)))
+ (native-namestring pathname :as-file t)))))
;; Process if-exists argument if we are doing any output.
(cond (output
(unless if-exists-given
(cond (new-name
(setf (fd-stream-pathname stream) new-name)
(setf (fd-stream-file stream)
- (unix-namestring new-name nil))
+ (native-namestring (physicalize-pathname new-name)
+ :as-file t))
t)
(t
(fd-stream-pathname stream)))))
(multiple-value-setq (q r) (truncate q 10))
(setf (schar res i) (schar "0123456789" r))))))
\f
-;;;; UNIX-NAMESTRING
-
-(defun empty-relative-pathname-spec-p (x)
- (or (equal x "")
- (and (pathnamep x)
- (or (equal (pathname-directory x) '(:relative))
- ;; KLUDGE: I'm not sure this second check should really
- ;; have to be here. But on sbcl-0.6.12.7,
- ;; (PATHNAME-DIRECTORY (PATHNAME "")) is NIL, and
- ;; (PATHNAME "") seems to act like an empty relative
- ;; pathname, so in order to work with that, I test
- ;; for NIL here. -- WHN 2001-05-18
- (null (pathname-directory x)))
- (null (pathname-name x))
- (null (pathname-type x)))
- ;; (The ANSI definition of "pathname specifier" has
- ;; other cases, but none of them seem to admit the possibility
- ;; of being empty and relative.)
- ))
-
-;;; Convert PATHNAME into a string that can be used with UNIX system
-;;; calls, or return NIL if no match is found. Wild-cards are expanded.
-;;;
-;;; FIXME: apart from the error checking (for wildness and for
-;;; existence) and conversion to physical pathanme, this is redundant
-;;; with UNPARSE-NATIVE-UNIX-NAMESTRING; one should probably be
-;;; written in terms of the other.
-;;;
-;;; FIXME: actually this (I think) works not just for Unix.
-(defun unix-namestring (pathname-spec &optional (for-input t))
- (let* ((namestring (physicalize-pathname (merge-pathnames pathname-spec)))
- (matches nil)) ; an accumulator for actual matches
- (when (wild-pathname-p namestring)
- (error 'simple-file-error
- :pathname namestring
- :format-control "bad place for a wild pathname"))
- (!enumerate-matches (match namestring nil :verify-existence for-input)
- (push match matches))
- (case (length matches)
- (0 nil)
- (1 (first matches))
- (t (bug "!ENUMERATE-MATCHES returned more than one match on a non-wild pathname")))))
-\f
;;;; TRUENAME, PROBE-FILE, FILE-AUTHOR, FILE-WRITE-DATE.
;;; Rewritten in 12/2007 by RMK, replacing 13+ year old CMU code that
"Rename FILE to have the specified NEW-NAME. If FILE is a stream open to a
file, then the associated file is renamed."
(let* ((original (truename file))
- (original-namestring (unix-namestring original t))
+ (original-namestring (native-namestring original :as-file t))
(new-name (merge-pathnames new-name original))
- (new-namestring (unix-namestring new-name nil)))
+ (new-namestring (native-namestring new-name :as-file t)))
(unless new-namestring
(error 'simple-file-error
:pathname new-name
(defun delete-file (file)
#!+sb-doc
"Delete the specified FILE."
- (let ((namestring (unix-namestring file t)))
+ (let* ((truename (probe-file file))
+ (namestring (when truename
+ (native-namestring truename :as-file t))))
(when (streamp file)
(close file :abort t))
(unless namestring
(foreign-bool (value)
(if value 1 0))
(save-core (gc)
- (when gc
- #!-gencgc (gc)
- ;; Do a destructive non-conservative GC, and then save a core.
- ;; A normal GC will leave huge amounts of storage unreclaimed
- ;; (over 50% on x86). This needs to be done by a single function
- ;; since the GC will invalidate the stack.
- #!+gencgc (gc-and-save (unix-namestring core-file-name nil)
- (foreign-bool executable)
- (foreign-bool save-runtime-options)))
- (without-gcing
- (save (unix-namestring core-file-name nil)
- (get-lisp-obj-address #'restart-lisp)
- (foreign-bool executable)
- (foreign-bool save-runtime-options)))))
+ (let ((name (native-namestring
+ (physicalize-pathname core-file-name)
+ :as-file t)))
+ (when gc
+ #!-gencgc (gc)
+ ;; Do a destructive non-conservative GC, and then save a core.
+ ;; A normal GC will leave huge amounts of storage unreclaimed
+ ;; (over 50% on x86). This needs to be done by a single function
+ ;; since the GC will invalidate the stack.
+ #!+gencgc (gc-and-save name
+ (foreign-bool executable)
+ (foreign-bool save-runtime-options)))
+ (without-gcing
+ (save name
+ (get-lisp-obj-address #'restart-lisp)
+ (foreign-bool executable)
+ (foreign-bool save-runtime-options))))))
;; Save the restart function into a static symbol, to allow GC-AND-SAVE
;; access to it even after the GC has moved it.
#!+gencgc
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.58"
+"1.0.28.59"
projects / sbcl.git / commitdiff