From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 19 Apr 2004 13:46:27 +0000 (+0000)
Subject: 0.8.9.52:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1b8bf3eb32049318ac5024e84cdf8925ec4aabae;p=sbcl.git

0.8.9.52:
	Fixes fixes fixes
	... restore build on linux/unithread;
	... workaround apparent OpenMCL bug in the reader (#1#-related)
	... fix for (funcall #'cddr ...)
---

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 178f6b4..d843d1c 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -444,29 +444,20 @@
 (define-good-modular-fun logior)
 ;;; FIXME: XOR? ANDC1, ANDC2?  -- CSR, 2003-09-16
 
-#!-alpha
-(progn
-  (defknown #1=sb!vm::ash-left-mod32 (integer (integer 0)) (unsigned-byte 32)
-            (foldable flushable movable))
-  (define-modular-fun-optimizer ash ((integer count) :width width)
-    (when (and (<= width 32)
-               (constant-lvar-p count)  ; ?
-               (plusp (lvar-value count)))
-      (cut-to-width integer width)
-      '#1#))
-  (setf (gethash '#1# *modular-versions*) '(ash 32)))
-#!+alpha
-(progn
-  (defknown #1=sb!vm::ash-left-mod64 (integer (integer 0)) (unsigned-byte 64)
-            (foldable flushable movable))
-  (define-modular-fun-optimizer ash ((integer count) :width width)
-    (when (and (<= width 64)
-               (constant-lvar-p count)  ; ?
-               (plusp (lvar-value count)))
-      (cut-to-width integer width)
-      '#1#))
-  (setf (gethash '#1# *modular-versions*) '(ash 64)))
-
+(macrolet
+    ((def (name width)
+	 `(progn
+	    (defknown ,name (integer (integer 0)) (unsigned-byte ,width)
+		      (foldable flushable movable))
+	    (define-modular-fun-optimizer ash ((integer count) :width width)
+	      (when (and (<= width 32)
+			 (constant-lvar-p count) ;?
+			 (plusp (lvar-value count)))
+		(cut-to-width integer width)
+		',name))
+	    (setf (gethash ',name *modular-versions*) `(ash ,',width)))))
+  #!-alpha (def sb!vm::ash-left-mod32 32)
+  #!+alpha (def sb!vm::ash-left-mod64 64))
 
 ;;; There are two different ways the multiplier can be recoded. The
 ;;; more obvious is to shift X by the correct amount for each bit set
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 83fcba2..46cbfa8 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -65,10 +65,14 @@
 (defun source-transform-cxr (form)
   (if (/= (length form) 2)
       (values nil t)
-      (let ((name (symbol-name (car form))))
-	(do ((i (- (length name) 2) (1- i))
+      (let* ((name (car form))
+	     (string (symbol-name
+		      (etypecase name
+			(symbol name)
+			(leaf (leaf-source-name name))))))
+	(do ((i (- (length string) 2) (1- i))
 	     (res (cadr form)
-		  `(,(ecase (char name i)
+		  `(,(ecase (char string i)
 		       (#\A 'car)
 		       (#\D 'cdr))
 		    ,res)))
diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index e099012..42a8b07 100644
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -215,7 +215,7 @@ void create_initial_thread(lispobj initial_function) {
     } else lose("can't create initial thread");
 }
 
-#ifdef LISP_FEATURE_LINUX
+#ifdef LISP_FEATURE_SB_THREAD
 pid_t create_thread(lispobj initial_function) {
     struct thread *th=create_thread_struct(initial_function);
     pid_t kid_pid=clone(new_thread_trampoline,
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 09457e9..4413058 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1171,3 +1171,5 @@
 		   (declare (notinline identity))
 		   (1+ (identity x))))
   (compiler-note () (error "IDENTITY derive-type not applied.")))
+
+(assert (null (funcall (compile nil '(lambda (x) (funcall #'cddr x))) nil)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 184de63..609be37 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.9.51"
+"0.8.9.52"