0.8.5.14:
authorChristophe Rhodes <csr21@cam.ac.uk>
Wed, 29 Oct 2003 12:54:50 +0000 (12:54 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Wed, 29 Oct 2003 12:54:50 +0000 (12:54 +0000)
Be less assertive about LRAs, since perfectly valid instructions
can have LRA widetags.  (Brian Downing sbcl-devel 2003-10-29)
... minimally-intrusive and minimally-DWIM patch
Define and use NATIVE-FILENAME for sb-posix
... also adjust the test not to run RUN-PROGRAM, since we
have problems with that :-/

NEWS
contrib/sb-posix/macros.lisp
contrib/sb-posix/posix-tests.lisp
src/compiler/target-disassem.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 278a163..b68f9ab 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2175,6 +2175,8 @@ changes in sbcl-0.8.6 relative to sbcl-0.8.5:
     SBCL binary built from CLISP)
   * fixed a compiler bug: MV-LET convertion did not check references
     to the "max args" entry point.  (reported by Brian Downing)
+  * tweaked disassembly notes to be less confident about proclaiming
+    some instruction as an LRA.  (thanks to Brian Downing)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** compiler failure in compiling LOGAND expressions including a
        constant 0.
index 9f79a69..959843b 100644 (file)
@@ -5,10 +5,29 @@
 ;;; Unix name is "[foo]", the appropriate CL namestring for it is
 ;;; "\\[foo]".  So, don't call NAMESTRING, instead call a function
 ;;; that gets us the Unix name
+(defun native-filename (pathname)
+  (let ((directory (pathname-directory pathname))
+       (name (pathname-name pathname))
+       (type (pathname-type pathname)))
+    (with-output-to-string (s nil :element-type 'base-char)
+      (etypecase directory
+       (string (write-string directory s))
+       (list
+        (when (eq (car directory) :absolute)
+          (write-char #\/ s))
+        (dolist (piece (cdr directory))
+          (etypecase piece
+            (string (write-string piece s) (write-char #\/ s))))))
+      (etypecase name
+       (null)
+        (string (write-string name s)))
+      (etypecase type
+       (null)
+       (string (write-char #\. s) (write-string type s))))))
 
 (define-designator filename c-string
   (pathname 
-   (sb-impl::unix-namestring (translate-logical-pathname filename) nil))
+   (native-filename (translate-logical-pathname filename)))
   (string filename))
 
 (define-designator file-descriptor (integer 32)
index f8e92b6..2b8ff6e 100644 (file)
 
 ;;; see comment in filename's designator definition, in macros.lisp
 (deftest filename-designator.1
-    (progn
-      ;; we use run-program to bypass the wildcard quoting in the 
-      ;; highlevel CL functions like OPEN
-      (sb-ext:run-program "touch"
-                         (list
-                          (format nil "~A/[foo].txt"
-                                  (namestring *test-directory*)))
-                         :search t :wait t )
-      ;; if this test fails, it will probably be with
-      ;; "System call error 2 (No such file or directory)"
-      (let ((*default-pathname-defaults* *test-directory*))
-       (sb-posix:unlink (car (directory "*.txt")))))
+  (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
+    ;; creat() with a string as argument
+    (sb-posix:creat file 0)
+    ;; if this test fails, it will probably be with
+    ;; "System call error 2 (No such file or directory)"
+    (let ((*default-pathname-defaults* *test-directory*))
+      (sb-posix:unlink (car (directory "*.txt")))))
   0)
                         
index 4b73b0b..6e07407 100644 (file)
                                         (1- lra-size))))
                sb!vm:return-pc-header-widetag))
     (unless (null stream)
-      (princ '.lra stream))
-    (incf (dstate-next-offs dstate) lra-size))
+      (note "possible LRA header" dstate)))
   nil)
 
 ;;; Print the fun-header (entry-point) pseudo-instruction at the
index 498224a..b370eaa 100644 (file)
@@ -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".)
-"0.8.5.13"
+"0.8.5.14"