From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 29 Oct 2003 12:54:50 +0000 (+0000)
Subject: 0.8.5.14:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=38da35e372a6e6f353fe5559edf6fca6459ef966;p=sbcl.git

0.8.5.14:
	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 :-/
---

diff --git a/NEWS b/NEWS
index 278a163..b68f9ab 100644
--- 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.
diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp
index 9f79a69..959843b 100644
--- a/contrib/sb-posix/macros.lisp
+++ b/contrib/sb-posix/macros.lisp
@@ -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)
diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index f8e92b6..2b8ff6e 100644
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -208,17 +208,12 @@
 
 ;;; 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)
 			 
diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 4b73b0b..6e07407 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -381,8 +381,7 @@
 					 (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
diff --git a/version.lisp-expr b/version.lisp-expr
index 498224a..b370eaa 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"