Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9294/src/compiler/x86-64

Modified Files:
	c-call.lisp 
Log Message:
1.0.12.9: don't limit TOUCH-OBJECT to descriptor-regs

* Allows objects known to be FIXNUM to be pinned. Question:
  why is a FIXNUM not acceptable to a DESCRIPTOR-REG?


Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/c-call.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- c-call.lisp	9 Nov 2007 17:38:16 -0000	1.21
+++ c-call.lisp	30 Nov 2007 17:46:10 -0000	1.22
@@ -340,7 +340,7 @@
 ;;; that GC won't move them while foreign functions go to work.
 (define-vop (touch-object)
   (:translate touch-object)
-  (:args (object :scs (descriptor-reg)))
+  (:args (object))
   (:ignore object)
   (:policy :fast-safe)
   (:arg-types t)

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9294/src/compiler/x86

Modified Files:
	c-call.lisp 
Log Message:
1.0.12.9: don't limit TOUCH-OBJECT to descriptor-regs

* Allows objects known to be FIXNUM to be pinned. Question:
  why is a FIXNUM not acceptable to a DESCRIPTOR-REG?


Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- c-call.lisp	9 Nov 2007 17:38:16 -0000	1.39
+++ c-call.lisp	30 Nov 2007 17:46:10 -0000	1.40
@@ -333,7 +333,7 @@
 ;;; that GC won't move them while foreign functions go to work.
 (define-vop (touch-object)
   (:translate touch-object)
-  (:args (object :scs (descriptor-reg)))
+  (:args (object))
   (:ignore object)
   (:policy :fast-safe)
   (:arg-types t)

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9294/tests

Modified Files:
	compiler.pure.lisp 
Log Message:
1.0.12.9: don't limit TOUCH-OBJECT to descriptor-regs

* Allows objects known to be FIXNUM to be pinned. Question:
  why is a FIXNUM not acceptable to a DESCRIPTOR-REG?


Index: compiler.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v
retrieving revision 1.169
retrieving revision 1.170
diff -u -d -r1.169 -r1.170
--- compiler.pure.lisp	12 Sep 2007 15:37:06 -0000	1.169
+++ compiler.pure.lisp	30 Nov 2007 17:46:10 -0000	1.170
@@ -2316,3 +2316,10 @@
                      t)
                    t
                    (error "~a" y)))))
+
+;;; Compiling W-P-O when the pinned objects are known to be fixnums
+;;; or characters.
+(compile nil '(lambda (x y)
+               (declare (fixnum y) (character x))
+               (sb-sys:with-pinned-objects (x y)
+                 (some-random-function))))

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9294

Modified Files:
	version.lisp-expr 
Log Message:
1.0.12.9: don't limit TOUCH-OBJECT to descriptor-regs

* Allows objects known to be FIXNUM to be pinned. Question:
  why is a FIXNUM not acceptable to a DESCRIPTOR-REG?


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3739
retrieving revision 1.3740
diff -u -d -r1.3739 -r1.3740
--- version.lisp-expr	30 Nov 2007 14:18:32 -0000	1.3739
+++ version.lisp-expr	30 Nov 2007 17:46:09 -0000	1.3740
@@ -17,4 +17,4 @@
 ;;; 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.12.8"
+"1.0.12.9"

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12801/src/compiler

Modified Files:
	array-tran.lisp fndb.lisp seqtran.lisp 
Log Message:
1.0.12.8: refactor bounding index error signalling functions

* We need two variants: one that uses ARRAY-TOTAL-SIZE for
  the limit, other othat uses LENGTH. Call them ARRAY- and
  SEQUENCE-BOUNDING-INDICES-BAD-ERROR. 


Index: array-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/array-tran.lisp,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- array-tran.lisp	29 Nov 2007 17:30:20 -0000	1.79
+++ array-tran.lisp	30 Nov 2007 14:18:33 -0000	1.80
@@ -569,22 +569,6 @@
 
 ;;;; WITH-ARRAY-DATA
 
-(defun bounding-index-error (array start end)
-  (let ((size (array-total-size array)))
-    (error 'bounding-indices-bad-error
-           :datum (cons start end)
-           :expected-type `(cons (integer 0 ,size)
-                                 (integer ,start ,size))
-           :object array)))
-
-(defun bounding-index-error/fp (array start end)
-  (let ((size (length array)))
-    (error 'bounding-indices-bad-error
-           :datum (cons start end)
-           :expected-type `(cons (integer 0 ,size)
-                                 (integer ,start ,size))
-           :object array)))
-
 ;;; This checks to see whether the array is simple and the start and
 ;;; end are in bounds. If so, it proceeds with those values.
 ;;; Otherwise, it calls %WITH-ARRAY-DATA. Note that %WITH-ARRAY-DATA
@@ -633,8 +617,8 @@
                                  `(if (<= ,n-svalue ,n-end ,n-len)
                                       (values ,n-array ,n-svalue ,n-end 0)
                                       ,(if check-fill-pointer
-                                           `(bounding-index-error/fp ,n-array ,n-svalue ,n-evalue)
-                                           `(bounding-index-error ,n-array ,n-svalue ,n-evalue))))))
+                                           `(sequence-bounding-indices-bad-error ,n-array ,n-svalue ,n-evalue)
+                                           `(array-bounding-indices-bad-error ,n-array ,n-svalue ,n-evalue))))))
                ,(if force-inline
                     `(%with-array-data-macro ,n-array ,n-svalue ,n-evalue
                                              :check-bounds ,check-bounds
@@ -661,8 +645,8 @@
        ,@(when check-bounds
                `((unless (<= ,start ,defaulted-end ,size)
                    ,(if check-fill-pointer
-                        `(bounding-index-error/fp ,array ,start ,end)
-                        `(bounding-index-error ,array ,start ,end)))))
+                        `(sequence-bounding-indices-bad-error ,array ,start ,end)
+                        `(array-bounding-indices-bad-error ,array ,start ,end)))))
        (do ((,data ,array (%array-data-vector ,data))
             (,cumulative-offset 0
                                 (+ ,cumulative-offset

Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.140
retrieving revision 1.141
diff -u -d -r1.140 -r1.141
--- fndb.lisp	29 Nov 2007 17:30:20 -0000	1.140
+++ fndb.lisp	30 Nov 2007 14:18:33 -0000	1.141
@@ -1459,8 +1459,8 @@
 (defknown %set-symbol-package (symbol t) t (unsafe))
 (defknown %coerce-name-to-fun ((or symbol cons)) function (flushable))
 (defknown %coerce-callable-to-fun (callable) function (flushable))
-(defknown bounding-index-error (t t t) nil)
-(defknown bounding-index-error/fp (t t t) nil)
+(defknown array-bounding-indices-bad-error (t t t) nil)
+(defknown sequence-bounding-indices-bad-error (t t t) nil)
 (defknown %find-position
   (t sequence t index sequence-end function function)
   (values t (or index null))

Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- seqtran.lisp	30 Nov 2007 13:12:23 -0000	1.82
+++ seqtran.lisp	30 Nov 2007 14:18:33 -0000	1.83
@@ -289,7 +289,7 @@
       '(let ((length (length vector)))
          (if (<= 0 start (or end length) length)
              (or end length)
-             (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+             (sequence-bounding-indices-bad-error vector start end)))))
 
 (defun specialized-list-seek-function-name (function-name key-functions)
   (or (find-symbol (with-output-to-string (s)
@@ -617,9 +617,9 @@
           ,(unless (policy node (= safety 0))
              `(progn
                  (unless (<= 0 start1 end1 len1)
-                   (sb!impl::signal-bounding-indices-bad-error seq1 start1 end1))
+                   (sequence-bounding-indices-bad-error seq1 start1 end1))
                  (unless (<= 0 start2 end2 len2)
-                   (sb!impl::signal-bounding-indices-bad-error seq2 start2 end2))))
+                   (sequence-bounding-indices-bad-error seq2 start2 end2))))
           ,',(cond
               ((and saetp (valid-bit-bash-saetp-p saetp))
                (let* ((n-element-bits (sb!vm:saetp-n-bits saetp))
@@ -793,7 +793,7 @@
          ,(unless (policy node (= safety 0))
                   '(progn
                     (unless (<= 0 start end length)
-                      (sb!impl::signal-bounding-indices-bad-error seq start end))))
+                      (sequence-bounding-indices-bad-error seq start end))))
          (let* ((size (- end start))
                 (result (make-array size :element-type ',element-type)))
            ,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start)
@@ -837,7 +837,7 @@
         (check-bounds-p (policy node (plusp insert-array-bounds-checks))))
     `(block search
        (flet ((oops (vector start end)
-                (bounding-index-error vector start end)))
+                (sequence-bounding-indices-bad-error vector start end)))
          (let* ((len1 (length pattern))
                 (len2 (length text))
                 (end1 (or end1 len1))
@@ -997,7 +997,7 @@
                    (declare (type index index))
                    (dolist (i sequence
                             (if (and end (> end index))
-                                (sb!impl::signal-bounding-indices-bad-error
+                                (sequence-bounding-indices-bad-error
                                  sequence start end)
                                 (values find position)))
                      (let ((key-i (funcall key i)))

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12801/src/code

Modified Files:
	fd-stream.lisp seq.lisp 
Log Message:
1.0.12.8: refactor bounding index error signalling functions

* We need two variants: one that uses ARRAY-TOTAL-SIZE for
  the limit, other othat uses LENGTH. Call them ARRAY- and
  SEQUENCE-BOUNDING-INDICES-BAD-ERROR. 


Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -d -r1.120 -r1.121
--- fd-stream.lisp	11 Oct 2007 13:13:08 -0000	1.120
+++ fd-stream.lisp	30 Nov 2007 14:18:32 -0000	1.121
@@ -1234,7 +1234,7 @@
           (declare (type index start end))
           (synchronize-stream-output stream)
           (unless (<= 0 start end (length string))
-            (signal-bounding-indices-bad-error string start end))
+            (sequence-bounding-indices-bad-error string start end))
           (do ()
               ((= end start))
             (let ((obuf (fd-stream-obuf stream)))
@@ -1411,7 +1411,7 @@
           (declare (type index start end))
           (synchronize-stream-output stream)
           (unless (<= 0 start end (length string))
-            (signal-bounding-indices-bad-error string start end))
+            (sequence-bounding-indices-bad string start end))
           (do ()
               ((= end start))
             (let ((obuf (fd-stream-obuf stream)))

Index: seq.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/seq.lisp,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -d -r1.76 -r1.77
--- seq.lisp	29 Nov 2007 17:30:18 -0000	1.76
+++ seq.lisp	30 Nov 2007 14:18:32 -0000	1.77
@@ -41,8 +41,7 @@
                      nil
                      (if (<= 0 ,start ,length)
                          ,start
-                         (signal-bounding-indices-bad-error ,sequence
-                                                            ,start ,end))
+                         (sequence-bounding-indices-bad-error ,sequence ,start ,end))
                      index)
                   `(,end
                     nil
@@ -55,8 +54,7 @@
                         ;; FIXME: defend against non-number non-NIL
                         ;; stuff?
                         ,end
-                        (signal-bounding-indices-bad-error ,sequence
-                                                           ,start ,end))
+                        (sequence-bounding-indices-bad-error ,sequence ,start ,end))
                     (or null index)))))
               '((start end length sequence)
                 (start1 end1 length1 sequence1)
@@ -220,13 +218,21 @@
                               ;; This seems silly, is there something better?
                               '(integer 0 (0))))))
 
-(defun signal-bounding-indices-bad-error (sequence start end)
-  (let ((length (length sequence)))
+(defun sequence-bounding-indices-bad-error (sequence start end)
+  (let ((size (length sequence)))
     (error 'bounding-indices-bad-error
            :datum (cons start end)
-           :expected-type `(cons (integer 0 ,length)
-                                 (or null (integer ,start ,length)))
+           :expected-type `(cons (integer 0 ,size)
+                                 (integer ,start ,size))
            :object sequence)))
+
+(defun array-bounding-indices-bad-error (array start end)
+  (let ((size (array-total-size array)))
+    (error 'bounding-indices-bad-error
+           :datum (cons start end)
+           :expected-type `(cons (integer 0 ,size)
+                                 (integer ,start ,size))
+           :object array)))
 
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
@@ -359,7 +365,7 @@
   (when (null end)
     (setf end (length sequence)))
   (unless (<= 0 start end (length sequence))
-    (signal-bounding-indices-bad-error sequence start end))
+    (sequence-bounding-indices-bad-error sequence start end))
   (do ((old-index start (1+ old-index))
        (new-index 0 (1+ new-index))
        (copy (%make-sequence-like sequence (- end start))))
@@ -373,7 +379,7 @@
            (type unsigned-byte start)
            (type (or null unsigned-byte) end))
   (flet ((oops ()
-           (signal-bounding-indices-bad-error sequence start end)))
+           (sequence-bounding-indices-bad-error sequence start end)))
     (let ((pointer sequence))
       (unless (zerop start)
         ;; If START > 0 the list cannot be empty. So CDR down to

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12801

Modified Files:
	package-data-list.lisp-expr version.lisp-expr 
Log Message:
1.0.12.8: refactor bounding index error signalling functions

* We need two variants: one that uses ARRAY-TOTAL-SIZE for
  the limit, other othat uses LENGTH. Call them ARRAY- and
  SEQUENCE-BOUNDING-INDICES-BAD-ERROR. 


Index: package-data-list.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v
retrieving revision 1.428
retrieving revision 1.429
diff -u -d -r1.428 -r1.429
--- package-data-list.lisp-expr	29 Nov 2007 17:30:12 -0000	1.428
+++ package-data-list.lisp-expr	30 Nov 2007 14:18:31 -0000	1.429
@@ -837,6 +837,10 @@
                "SIMPLE-STYLE-WARNING"
                "TRY-RESTART"
 
+               ;; error-signalling facilities
+               "ARRAY-BOUNDING-INDICES-BAD-ERROR"
+               "SEQUENCE-BOUNDING-INDICES-BAD-ERROR"
+
                "SPECIAL-FORM-FUNCTION"
                "STYLE-WARN" "SIMPLE-COMPILER-NOTE"
 

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3738
retrieving revision 1.3739
diff -u -d -r1.3738 -r1.3739
--- version.lisp-expr	30 Nov 2007 13:12:21 -0000	1.3738
+++ version.lisp-expr	30 Nov 2007 14:18:32 -0000	1.3739
@@ -17,4 +17,4 @@
 ;;; 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.12.7"
+"1.0.12.8"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20915/tests

Modified Files:
	pathnames.impure.lisp 
Log Message:
1.0.12.7: oops, missed one SEARCH transform

* Check bounds properly before entry to the code, and
  elide checks in the inner loop.


Index: pathnames.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -d -r1.38 -r1.39
--- pathnames.impure.lisp	30 Nov 2007 02:16:27 -0000	1.38
+++ pathnames.impure.lisp	30 Nov 2007 13:12:24 -0000	1.39
@@ -452,7 +452,7 @@
 
          #+win32
             #|type  NIL           :UNSPECIFIC   ""            "a"     |#
-#|name       |#                   
+#|name       |#
 #|NIL        |#   '("C:\\tmp\\"   "C:\\tmp\\"   NIL           NIL
 #|:UNSPECIFIC|#     "C:\\tmp\\"   "C:\\tmp\\"   NIL           NIL
 #|""         |#     "C:\\tmp\\"   "C:\\tmp\\"   "C:\\tmp\\."  "C:\\tmp\\.a"

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20915/src/compiler

Modified Files:
	seqtran.lisp 
Log Message:
1.0.12.7: oops, missed one SEARCH transform

* Check bounds properly before entry to the code, and
  elide checks in the inner loop.


Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -d -r1.81 -r1.82
--- seqtran.lisp	29 Nov 2007 17:30:20 -0000	1.81
+++ seqtran.lisp	30 Nov 2007 13:12:23 -0000	1.82
@@ -287,9 +287,9 @@
   (if (policy node (= 0 insert-array-bounds-checks))
       '(or end (length vector))
       '(let ((length (length vector)))
-	 (if (<= 0 start (or end length) length)
-	     (or end length)
-	     (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+         (if (<= 0 start (or end length) length)
+             (or end length)
+             (sb!impl::signal-bounding-indices-bad-error vector start end)))))
 
 (defun specialized-list-seek-function-name (function-name key-functions)
   (or (find-symbol (with-output-to-string (s)
@@ -825,6 +825,7 @@
                                from-end)
                       (vector vector &rest t)
                       *
+                      :node node
                       :policy (> speed (max space safety)))
   "open code"
   (let ((from-end (when (lvar-p from-end)
@@ -832,44 +833,55 @@
                       (give-up-ir1-transform ":FROM-END is not constant."))
                     (lvar-value from-end)))
         (keyp (lvar-p key))
-        (testp (lvar-p test)))
+        (testp (lvar-p test))
+        (check-bounds-p (policy node (plusp insert-array-bounds-checks))))
     `(block search
-       (let ((end1 (or end1 (length pattern)))
-             (end2 (or end2 (length text)))
-             ,@(when keyp
-                     '((key (coerce key 'function))))
-             ,@(when testp
-                     '((test (coerce test 'function)))))
-         (declare (type index start1 start2 end1 end2))
-         (do (,(if from-end
-                   '(index2 (- end2 (- end1 start1)) (1- index2))
-                   '(index2 start2 (1+ index2))))
-             (,(if from-end
-                   '(< index2 start2)
-                   '(>= index2 end2))
-              nil)
-           ;; INDEX2 is FIXNUM, not an INDEX, as right before the loop
-           ;; terminates is hits -1 when :FROM-END is true and :START2
-           ;; is 0.
-           (declare (type fixnum index2))
-           (when (do ((index1 start1 (1+ index1))
-                      (index2 index2 (1+ index2)))
-                     ((>= index1 end1) t)
-                   (declare (type index index1 index2))
-                   ,@(unless from-end
-                             '((when (= index2 end2)
-                                 (return-from search nil))))
-                   (unless (,@(if testp
-                                  '(funcall test)
-                                  '(eql))
-                              ,(if keyp
-                                   '(funcall key (aref pattern index1))
-                                   '(aref pattern index1))
-                              ,(if keyp
-                                   '(funcall key (aref text index2))
-                                   '(aref text index2)))
-                     (return nil)))
-             (return index2)))))))
+       (flet ((oops (vector start end)
+                (bounding-index-error vector start end)))
+         (let* ((len1 (length pattern))
+                (len2 (length text))
+                (end1 (or end1 len1))
+                (end2 (or end2 len2))
+               ,@(when keyp
+                       '((key (coerce key 'function))))
+               ,@(when testp
+                       '((test (coerce test 'function)))))
+          (declare (type index start1 start2 end1 end2))
+          ,@(when check-bounds-p
+             `((unless (<= start1 end1 len1)
+                 (oops pattern start1 end1))
+               (unless (<= start2 end2 len2)
+                 (oops pattern start2 end2))))
+          (do (,(if from-end
+                    '(index2 (- end2 (- end1 start1)) (1- index2))
+                    '(index2 start2 (1+ index2))))
+              (,(if from-end
+                    '(< index2 start2)
+                    '(>= index2 end2))
+               nil)
+            ;; INDEX2 is FIXNUM, not an INDEX, as right before the loop
+            ;; terminates is hits -1 when :FROM-END is true and :START2
+            ;; is 0.
+            (declare (type fixnum index2))
+            (when (do ((index1 start1 (1+ index1))
+                       (index2 index2 (1+ index2)))
+                      ((>= index1 end1) t)
+                    (declare (type index index1 index2)
+                             (optimize (insert-array-bounds-checks 0)))
+                    ,@(unless from-end
+                              '((when (= index2 end2)
+                                  (return-from search nil))))
+                    (unless (,@(if testp
+                                   '(funcall test)
+                                   '(eql))
+                               ,(if keyp
+                                    '(funcall key (aref pattern index1))
+                                    '(aref pattern index1))
+                               ,(if keyp
+                                    '(funcall key (aref text index2))
+                                    '(aref text index2)))
+                      (return nil)))
+              (return index2))))))))
 
 
 ;;; Open-code CONCATENATE for strings. It would be possible to extend

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20915

Modified Files:
	version.lisp-expr 
Log Message:
1.0.12.7: oops, missed one SEARCH transform

* Check bounds properly before entry to the code, and
  elide checks in the inner loop.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3737
retrieving revision 1.3738
diff -u -d -r1.3737 -r1.3738
--- version.lisp-expr	30 Nov 2007 02:16:25 -0000	1.3737
+++ version.lisp-expr	30 Nov 2007 13:12:21 -0000	1.3738
@@ -17,4 +17,4 @@
 ;;; 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.12.6"
+"1.0.12.7"

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25628/src/code

Modified Files:
	target-pathname.lisp unix-pathname.lisp win32-pathname.lisp 
Log Message:
1.0.12.6: Removing UNIX-NAMESTRING, part 1

* Get NATIVE-NAMESTRING to do all and only the desired things for all
  accepted non-wild NAME and TYPE components.  Add a few tests for
  these cases.

* Add new user-visible features to PARSE-NATIVE-NAMESTRING and
  NATIVE-NAMESTRING for parsing/unparsing things "as files" or "as
  directories"; these are convenient for use with SB-POSIX, and will
  be handy in a few places in SBCL's internals, too.



Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- target-pathname.lisp	14 Nov 2007 18:30:15 -0000	1.58
+++ target-pathname.lisp	30 Nov 2007 02:16:27 -0000	1.59
@@ -843,7 +843,8 @@
                     thing))
            (values name nil)))))))
 
-(defun %parse-native-namestring (namestr host defaults start end junk-allowed)
+(defun %parse-native-namestring (namestr host defaults start end junk-allowed
+                                 as-directory)
   (declare (type (or host null) host)
            (type string namestr)
            (type index start)
@@ -859,12 +860,13 @@
        (multiple-value-bind (new-host device directory file type version)
            (cond
              (host
-              (funcall (host-parse-native host) namestr start end))
+              (funcall (host-parse-native host) namestr start end as-directory))
              ((pathname-host defaults)
               (funcall (host-parse-native (pathname-host defaults))
                        namestr
                        start
-                       end))
+                       end
+                       as-directory))
              ;; I don't think we should ever get here, as the default
              ;; host will always have a non-null HOST, given that we
              ;; can't create a new pathname without going through
@@ -888,13 +890,17 @@
                                 &optional
                                 host
                                 (defaults *default-pathname-defaults*)
-                                &key (start 0) end junk-allowed)
+                                &key (start 0) end junk-allowed
+                                as-directory)
   #!+sb-doc
   "Convert THING into a pathname, using the native conventions
-appropriate for the pathname host HOST, or if not specified the host
-of DEFAULTS.  If THING is a string, the parse is bounded by START and
-END, and error behaviour is controlled by JUNK-ALLOWED, as with
-PARSE-NAMESTRING."
+appropriate for the pathname host HOST, or if not specified the
+host of DEFAULTS.  If THING is a string, the parse is bounded by
+START and END, and error behaviour is controlled by JUNK-ALLOWED,
+as with PARSE-NAMESTRING.  For file systems whose native
+conventions allow directories to be indicated as files, if
+AS-DIRECTORY is true, return a pathname denoting THING as a
+directory."
   (declare (type pathname-designator thing defaults)
            (type (or list host string (member :unspecific)) host)
            (type index start)
@@ -914,10 +920,11 @@
       (etypecase thing
         (simple-string
          (%parse-native-namestring
-          thing found-host defaults start end junk-allowed))
+          thing found-host defaults start end junk-allowed as-directory))
         (string
          (%parse-native-namestring (coerce thing 'simple-string)
-                                   found-host defaults start end junk-allowed))
+                                   found-host defaults start end junk-allowed
+                                   as-directory))
         (pathname
          (let ((defaulted-host (or found-host (%pathname-host defaults))))
            (declare (type host defaulted-host))
@@ -946,9 +953,14 @@
                   host:~%  ~S" pathname))
         (funcall (host-unparse host) pathname)))))
 
-(defun native-namestring (pathname)
+(defun native-namestring (pathname &key as-file)
   #!+sb-doc
-  "Construct the full native (name)string form of PATHNAME."
+  "Construct the full native (name)string form of PATHNAME.  For
+file systems whose native conventions allow directories to be
+indicated as files, if AS-FILE is true and the name, type, and
+version components of PATHNAME are all NIL or :UNSPECIFIC,
+construct a string that names the directory according to the file
+system's syntax for files."
   (declare (type pathname-designator pathname))
   (with-native-pathname (pathname pathname)
     (when pathname
@@ -956,7 +968,7 @@
         (unless host
           (error "can't determine the native namestring for pathnames with no ~
                   host:~%  ~S" pathname))
-        (funcall (host-unparse-native host) pathname)))))
+        (funcall (host-unparse-native host) pathname as-file)))))
 
 (defun host-namestring (pathname)
   #!+sb-doc

Index: unix-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/unix-pathname.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- unix-pathname.lisp	3 Dec 2006 19:53:52 -0000	1.7
+++ unix-pathname.lisp	30 Nov 2007 02:16:27 -0000	1.8
@@ -85,7 +85,7 @@
               type
               version))))
 
-(defun parse-native-unix-namestring (namestring start end)
+(defun parse-native-unix-namestring (namestring start end as-directory)
   (declare (type simple-string namestring)
            (type index start end))
   (setf namestring (coerce namestring 'simple-string))
@@ -96,22 +96,27 @@
                              collect (if (and (string= piece "..") rest)
                                          :up
                                          piece)))
+           (directory (if (and as-directory
+                               (string/= "" (car (last components))))
+                          components
+                          (butlast components)))
            (name-and-type
-            (let* ((end (first (last components)))
-                   (dot (position #\. end :from-end t)))
-              ;; FIXME: can we get this dot-interpretation knowledge
-              ;; from existing code?  EXTRACT-NAME-TYPE-AND-VERSION
-              ;; does slightly more work than that.
-              (cond
-                ((string= end "")
-                 (list nil nil))
-                ((and dot (> dot 0))
-                 (list (subseq end 0 dot) (subseq end (1+ dot))))
-                (t
-                 (list end nil))))))
+            (unless as-directory
+              (let* ((end (first (last components)))
+                     (dot (position #\. end :from-end t)))
+                ;; FIXME: can we get this dot-interpretation knowledge
+                ;; from existing code?  EXTRACT-NAME-TYPE-AND-VERSION
+                ;; does slightly more work than that.
+                (cond
+                  ((string= end "")
+                   (list nil nil))
+                  ((and dot (> dot 0))
+                   (list (subseq end 0 dot) (subseq end (1+ dot))))
+                  (t
+                   (list end nil)))))))
       (values nil
               nil
-              (cons (if absolute :absolute :relative) (butlast components))
+              (cons (if absolute :absolute :relative) directory)
               (first name-and-type)
               (second name-and-type)
               nil))))
@@ -238,32 +243,48 @@
                (unparse-unix-directory pathname)
                (unparse-unix-file pathname)))
 
-(defun unparse-native-unix-namestring (pathname)
+(defun unparse-native-unix-namestring (pathname as-file)
   (declare (type pathname pathname))
-  (let ((directory (pathname-directory pathname))
-        (name (pathname-name pathname))
-        (type (pathname-type pathname)))
+  (let* ((directory (pathname-directory pathname))
+         (name (pathname-name pathname))
+         (name-present-p (typep name '(not (member nil :unspecific))))
+         (name-string (if name-present-p name ""))
+         (type (pathname-type pathname))
+         (type-present-p (typep type '(not (member nil :unspecific))))
+         (type-string (if type-present-p type "")))
+    (when name-present-p
+      (setf as-file nil))
     (coerce
      (with-output-to-string (s)
        (when directory
          (ecase (car directory)
            (:absolute (write-char #\/ s))
            (:relative)))
-       (dolist (piece (cdr directory))
-         (typecase piece
-           ((member :up) (write-string ".." s))
-           (string (write-string piece s))
-           (t (error "ungood piece in NATIVE-NAMESTRING: ~S" piece)))
-         (write-char #\/ s))
-       (when name
-         (unless (stringp name)
-           (error "non-STRING name in NATIVE-NAMESTRING: ~S" name))
-         (write-string name s)
-         (when type
-           (unless (stringp type)
-             (error "non-STRING type in NATIVE-NAMESTRING: ~S" name))
-           (write-char #\. s)
-           (write-string type s))))
+       (loop for (piece . subdirs) on (cdr directory)
+          do (typecase piece
+               ((member :up) (write-string ".." s))
+               (string (write-string piece s))
+               (t (error "ungood directory segment in NATIVE-NAMESTRING: ~S"
+                         piece)))
+          if (or subdirs (stringp name))
+          do (write-char #\/ s)
+          else
+          do (unless as-file
+               (write-char #\/ s)))
+       (if name-present-p
+           (progn
+             (unless (stringp name-string) ;some kind of wild field
+               (error "ungood name component in NATIVE-NAMESTRING: ~S" name))
+             (write-string name-string s)
+             (when type-present-p
+               (unless (stringp type-string) ;some kind of wild field
+                 (error "ungood type component in NATIVE-NAMESTRING: ~S" type))
+               (write-char #\. s)
+               (write-string type-string s)))
+           (when type-present-p ; type without a name
+             (error
+              "type component without a name component in NATIVE-NAMESTRING: ~S"
+              type))))
      'simple-string)))
 
 (defun unparse-unix-enough (pathname defaults)

Index: win32-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/win32-pathname.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- win32-pathname.lisp	3 Dec 2006 19:53:52 -0000	1.8
+++ win32-pathname.lisp	30 Nov 2007 02:16:27 -0000	1.9
@@ -97,7 +97,7 @@
                 type
                 version)))))
 
-(defun parse-native-win32-namestring (namestring start end)
+(defun parse-native-win32-namestring (namestring start end as-directory)
   (declare (type simple-string namestring)
            (type index start end))
   (setf namestring (coerce namestring 'simple-string))
@@ -110,22 +110,27 @@
                                collect (if (and (string= piece "..") rest)
                                            :up
                                            piece)))
+             (directory (if (and as-directory
+                                 (string/= "" (car (last components))))
+                            components
+                            (butlast components)))
              (name-and-type
-              (let* ((end (first (last components)))
-                     (dot (position #\. end :from-end t)))
-                ;; FIXME: can we get this dot-interpretation knowledge
-                ;; from existing code?  EXTRACT-NAME-TYPE-AND-VERSION
-                ;; does slightly more work than that.
-                (cond
-                  ((string= end "")
-                   (list nil nil))
-                  ((and dot (> dot 0))
-                   (list (subseq end 0 dot) (subseq end (1+ dot))))
-                  (t
-                   (list end nil))))))
+              (unless as-directory
+                (let* ((end (first (last components)))
+                       (dot (position #\. end :from-end t)))
+                  ;; FIXME: can we get this dot-interpretation knowledge
+                  ;; from existing code?  EXTRACT-NAME-TYPE-AND-VERSION
+                  ;; does slightly more work than that.
+                  (cond
+                    ((string= end "")
+                     (list nil nil))
+                    ((and dot (> dot 0))
+                     (list (subseq end 0 dot) (subseq end (1+ dot))))
+                    (t
+                     (list end nil)))))))
         (values nil
                 device
-                (cons (if absolute :absolute :relative) (butlast components))
+                (cons (if absolute :absolute :relative) directory)
                 (first name-and-type)
                 (second name-and-type)
                 nil)))))
@@ -255,12 +260,18 @@
                (unparse-win32-directory pathname)
                (unparse-win32-file pathname)))
 
-(defun unparse-native-win32-namestring (pathname)
+(defun unparse-native-win32-namestring (pathname as-file)
   (declare (type pathname pathname))
-  (let ((device (pathname-device pathname))
-        (directory (pathname-directory pathname))
-        (name (pathname-name pathname))
-        (type (pathname-type pathname)))
+  (let* ((device (pathname-device pathname))
+         (directory (pathname-directory pathname))
+         (name (pathname-name pathname))
+         (name-present-p (typep name '(not (member nil :unspecific))))
+         (name-string (if name-present-p name ""))
+         (type (pathname-type pathname))
+         (type-present-p (typep type '(not (member nil :unspecific))))
+         (type-string (if type-present-p type "")))
+    (when name-present-p
+      (setf as-file nil))
     (coerce
      (with-output-to-string (s)
        (when device
@@ -276,21 +287,27 @@
             (typecase piece
               ((member :up) (write-string ".." s))
               (string (write-string piece s))
-              (t (error "ungood piece in NATIVE-NAMESTRING: ~S" piece)))
-            (when (or directory name type)
+              (t (error "ungood directory segment in NATIVE-NAMESTRING: ~S"
+                        piece)))
+            (when (or directory (not as-file))
               (write-char #\\ s)))
           (when directory
             (go :subdir))
         :done)
-       (when name
-         (unless (stringp name)
-           (error "non-STRING name in NATIVE-NAMESTRING: ~S" name))
-         (write-string name s)
-         (when type
-           (unless (stringp type)
-             (error "non-STRING type in NATIVE-NAMESTRING: ~S" name))
-           (write-char #\. s)
-           (write-string type s))))
+       (if name-present-p
+           (progn
+             (unless (stringp name-string) ;some kind of wild field
+               (error "ungood name component in NATIVE-NAMESTRING: ~S" name))
+             (write-string name-string s)
+             (when type-present-p
+               (unless (stringp type-string) ;some kind of wild field
+                 (error "ungood type component in NATIVE-NAMESTRING: ~S" type))
+               (write-char #\. s)
+               (write-string type-string s)))
+           (when type-present-p ;
+             (error
+              "type component without a name component in NATIVE-NAMESTRING: ~S"
+              type))))
      'simple-string)))
 
 ;;; FIXME.

Update of /cvsroot/sbcl/sbcl/doc/manual
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25628/doc/manual

Modified Files:
	pathnames.texinfo 
Log Message:
1.0.12.6: Removing UNIX-NAMESTRING, part 1

* Get NATIVE-NAMESTRING to do all and only the desired things for all
  accepted non-wild NAME and TYPE components.  Add a few tests for
  these cases.

* Add new user-visible features to PARSE-NATIVE-NAMESTRING and
  NATIVE-NAMESTRING for parsing/unparsing things "as files" or "as
  directories"; these are convenient for use with SB-POSIX, and will
  be handy in a few places in SBCL's internals, too.



Index: pathnames.texinfo
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/manual/pathnames.texinfo,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- pathnames.texinfo	22 Dec 2005 10:10:47 -0000	1.2
+++ pathnames.texinfo	30 Nov 2007 02:16:27 -0000	1.3
@@ -107,7 +107,48 @@
 @code{:back} directory component) have no direct equivalents in most
 Operating Systems; the behaviour of @code{native-namestring} is
 unspecified if an inappropriate pathname designator is passed to it.
+Additionally, note that conversion from pathname to native filename
+and back to pathname should not be expected to preserve equivalence
+under @code{equal}.
 
 @include fun-sb-ext-parse-native-namestring.texinfo
 @include fun-sb-ext-native-pathname.texinfo
 @include fun-sb-ext-native-namestring.texinfo
+
+Because some file systems permit the names of directories to be
+expressed in multiple ways, it is occasionally necessary to parse a
+native file name ``as a directory name'' or to produce a native file
+name that names a directory ``as a file''.  For these cases,
+@code{parse-native-namestring} accepts the keyword argument
+@code{as-directory} to force a filename to parse as a directory, and
+@code{native-namestring} accepts the keyword argument @code{as-file}
+to force a pathname to unparse as a file.  For example,
+
+@lisp
+; On Unix, the directory "/tmp/" can be denoted by "/tmp/" or "/tmp".
+; Under the default rules for native filenames, these parse and
+; unparse differently.
+(defvar *p*)
+(setf *p* (parse-native-namestring "/tmp/")) @result{} #P"/tmp/"
+(pathname-name *p*) @result{} NIL
+(pathname-directory *p*) @result{} (:ABSOLUTE "tmp")
+(native-namestring *p*) @result{} "/tmp/"
+
+(setf *p* (parse-native-namestring "/tmp")) @result{} #P"/tmp"
+(pathname-name *p*) @result{} "tmp"
+(pathname-directory *p*) @result{} (:ABSOLUTE)
+(native-namestring *p*) @result{} "/tmp"
+
+; A non-NIL AS-DIRECTORY argument to PARSE-NATIVE-NAMESTRING forces
+; both the second string to parse the way the first does.
+(setf *p* (parse-native-namestring "/tmp"
+                                   nil *default-pathname-defaults*
+                                   :as-directory t)) @result{} #P"/tmp/"
+(pathname-name *p*) @result{} NIL
+(pathname-directory *p*) @result{} (:ABSOLUTE "tmp")
+
+; A non-NIL AS-FILE argument to NATIVE-NAMESTRING forces the pathname
+; parsed from the first string to unparse as the second string.
+(setf *p* (parse-native-namestring "/tmp/")) @result{} #P"/tmp/"
+(native-namestring *p* :as-file t) @result{} "/tmp"
+@end lisp

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25628/tests

Modified Files:
	pathnames.impure.lisp 
Log Message:
1.0.12.6: Removing UNIX-NAMESTRING, part 1

* Get NATIVE-NAMESTRING to do all and only the desired things for all
  accepted non-wild NAME and TYPE components.  Add a few tests for
  these cases.

* Add new user-visible features to PARSE-NATIVE-NAMESTRING and
  NATIVE-NAMESTRING for parsing/unparsing things "as files" or "as
  directories"; these are convenient for use with SB-POSIX, and will
  be handy in a few places in SBCL's internals, too.



Index: pathnames.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- pathnames.impure.lisp	3 Dec 2006 19:53:52 -0000	1.37
+++ pathnames.impure.lisp	30 Nov 2007 02:16:27 -0000	1.38
@@ -427,5 +427,34 @@
 
 ;;; enough-namestring relative to root
 (assert (equal "foo" (enough-namestring "/foo" "/")))
+
+;;; Check the handling of NIL, :UNSPECIFIC, the empty string, and
+;;; non-NIL strings in NATIVE-NAMESTRING implementations.  Revised by
+;;; RMK 2007-11-28, attempting to preserve the apparent intended
+;;; denotation of SBCL's then-current pathname implementation.
+(assert (equal
+         (loop with components = (list nil :unspecific "" "a")
+               for name in components
+               appending (loop for type in components
+                               as pathname = (make-pathname
+                                              #+win32 "C"
+                                              :directory '(:absolute "tmp")
+                                              :name name :type type)
+                               collect (ignore-errors
+                                         (sb-ext:native-namestring pathname))))
+         #-win32
+            #|type  NIL       :UNSPECIFIC   ""        "a"         |#
+#|name       |#
+#|NIL        |#   '("/tmp/"   "/tmp/"       NIL       NIL
+#|:UNSPECIFIC|#     "/tmp/"   "/tmp/"       NIL       NIL
+#|""         |#     "/tmp/"   "/tmp/"       "/tmp/."  "/tmp/.a"
+#|"a"        |#     "/tmp/a"  "/tmp/a"      "/tmp/a." "/tmp/a.a")
 
+         #+win32
+            #|type  NIL           :UNSPECIFIC   ""            "a"     |#
+#|name       |#                   
+#|NIL        |#   '("C:\\tmp\\"   "C:\\tmp\\"   NIL           NIL
+#|:UNSPECIFIC|#     "C:\\tmp\\"   "C:\\tmp\\"   NIL           NIL
+#|""         |#     "C:\\tmp\\"   "C:\\tmp\\"   "C:\\tmp\\."  "C:\\tmp\\.a"
+#|"a"        |#     "C:\\tmp\\a"  "C:\\tmp\\a"  "C:\\tmp\\a." "C:\\tmp\\a.a")))
 ;;;; success

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25628

Modified Files:
	NEWS version.lisp-expr 
Log Message:
1.0.12.6: Removing UNIX-NAMESTRING, part 1

* Get NATIVE-NAMESTRING to do all and only the desired things for all
  accepted non-wild NAME and TYPE components.  Add a few tests for
  these cases.

* Add new user-visible features to PARSE-NATIVE-NAMESTRING and
  NATIVE-NAMESTRING for parsing/unparsing things "as files" or "as
  directories"; these are convenient for use with SB-POSIX, and will
  be handy in a few places in SBCL's internals, too.



Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.1273
retrieving revision 1.1274
diff -u -d -r1.1273 -r1.1274
--- NEWS	29 Nov 2007 17:30:11 -0000	1.1273
+++ NEWS	30 Nov 2007 02:16:25 -0000	1.1274
@@ -1,5 +1,9 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-1.0.13 relative to sbcl-1.0.12:
+  * SB-EXT:NATIVE-NAMESTRING takes a new keyword AS-FILE, forcing
+    unparsing of directory pathnames as files. Analogously,
+    SB-EXT:PARSE-NATIVE-NAMESTRING takes an AS-DIRECTORY, forcing a
+    filename to parse into a directory pathname.
   * bug fix: some sequence functions elided bounds checking when
     SPEED > SAFETY.
   * bug fix: too liberal weakening of union-type checks when SPEED >

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3736
retrieving revision 1.3737
diff -u -d -r1.3736 -r1.3737
--- version.lisp-expr	29 Nov 2007 17:30:13 -0000	1.3736
+++ version.lisp-expr	30 Nov 2007 02:16:25 -0000	1.3737
@@ -17,4 +17,4 @@
 ;;; 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.12.5"
+"1.0.12.6"

Update of /cvsroot/sbcl/sbcl/contrib/sb-posix
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25628/contrib/sb-posix

Modified Files:
	sb-posix.texinfo 
Log Message:
1.0.12.6: Removing UNIX-NAMESTRING, part 1

* Get NATIVE-NAMESTRING to do all and only the desired things for all
  accepted non-wild NAME and TYPE components.  Add a few tests for
  these cases.

* Add new user-visible features to PARSE-NATIVE-NAMESTRING and
  NATIVE-NAMESTRING for parsing/unparsing things "as files" or "as
  directories"; these are convenient for use with SB-POSIX, and will
  be handy in a few places in SBCL's internals, too.



Index: sb-posix.texinfo
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-posix/sb-posix.texinfo,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- sb-posix.texinfo	5 Oct 2007 09:21:29 -0000	1.2
+++ sb-posix.texinfo	30 Nov 2007 02:16:27 -0000	1.3
@@ -110,9 +110,11 @@
 @end lisp
 
 @noindent
-returns a pathname that denotes a file in the directory, it's necessary
-to append a forward slash to the POSIX filename.  Otherwise, the last
-directory name will be parsed as a filename.
+returns a pathname that denotes a file in the directory, supply a true
+@code{AS-DIRECTORY} argument to @code{SB-EXT:PARSE-NATIVE-NAMESTRING}.
+Likewise, if it is necessary to supply the name of a directory to a
+POSIX function in non-directory syntax, supply a true @code{AS-FILE}
+argument to @code{SB-EXT:NATIVE-NAMESTRING}.
 
 @node Type conversion functions
 @subsubsection Type conversion functions