Steel Bank Common Lisp

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

Modified Files:
	float-tran.lisp srctran.lisp 
Log Message:
0.8.21.2:
	Merge mainly MISC fixes held over from pre-freeze


Index: float-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/float-tran.lisp,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- float-tran.lisp	7 Mar 2005 06:53:17 -0000	1.35
+++ float-tran.lisp	27 Mar 2005 18:34:45 -0000	1.36
@@ -238,10 +238,18 @@
 	    (ex-hi (numeric-type-high ex))
 	    (new-lo nil)
 	    (new-hi nil))
-	(when (and f-hi ex-hi)
-	  (setf new-hi (scale-bound f-hi ex-hi)))
-	(when (and f-lo ex-lo)
-	  (setf new-lo (scale-bound f-lo ex-lo)))
+	(when f-hi
+	  (if (< (float-sign (type-bound-number f-hi)) 0.0)
+	      (when ex-lo
+		(setf new-hi (scale-bound f-hi ex-lo)))
+	      (when ex-hi
+		(setf new-hi (scale-bound f-hi ex-hi)))))
+	(when f-lo
+	  (if (< (float-sign (type-bound-number f-lo)) 0.0)
+	      (when ex-hi
+		(setf new-lo (scale-bound f-lo ex-hi)))
+	      (when ex-lo
+		(setf new-lo (scale-bound f-lo ex-lo)))))
 	(make-numeric-type :class (numeric-type-class f)
 			   :format (numeric-type-format f)
 			   :complexp :real
@@ -624,9 +632,7 @@
   (etypecase arg
     (numeric-type
      (cond ((eq (numeric-type-complexp arg) :complex)
-	    (make-numeric-type :class (numeric-type-class arg)
-			       :format (numeric-type-format arg)
-			       :complexp :complex))
+	    (complex-float-type arg))
 	   ((numeric-type-real-p arg)
 	    ;; The argument is real, so let's find the intersection
 	    ;; between the argument and the domain of the function.
@@ -1297,20 +1303,34 @@
 			   nil nil))
    #'tan))
 
-;;; CONJUGATE always returns the same type as the input type.
-;;;
-;;; FIXME: ANSI allows any subtype of REAL for the components of COMPLEX.
-;;; So what if the input type is (COMPLEX (SINGLE-FLOAT 0 1))?
-;;; Or (EQL #C(1 2))?
 (defoptimizer (conjugate derive-type) ((num))
-  (lvar-type num))
+  (one-arg-derive-type num
+    (lambda (arg)
+      (flet ((most-negative-bound (l h)
+	       (and l h
+		    (if (< (type-bound-number l) (- (type-bound-number h)))
+			l
+			(set-bound (- (type-bound-number h)) (consp h)))))
+	     (most-positive-bound (l h)
+	       (and l h
+		    (if (> (type-bound-number h) (- (type-bound-number l)))
+			h
+			(set-bound (- (type-bound-number l)) (consp l))))))
+	(if (numeric-type-real-p arg)
+	    (lvar-type num)
+	    (let ((low (numeric-type-low arg))
+		  (high (numeric-type-high arg)))
+	      (let ((new-low (most-negative-bound low high))
+		    (new-high (most-positive-bound low high)))
+	      (modified-numeric-type arg :low new-low :high new-high))))))
+    #'conjugate))
 
 (defoptimizer (cis derive-type) ((num))
   (one-arg-derive-type num
-     (lambda (arg)
-       (sb!c::specifier-type
-	`(complex ,(or (numeric-type-format arg) 'float))))
-     #'cis))
+    (lambda (arg)
+      (sb!c::specifier-type
+       `(complex ,(or (numeric-type-format arg) 'float))))
+    #'cis))
 
 ) ; PROGN
 

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -d -r1.116 -r1.117
--- srctran.lisp	19 Dec 2004 07:01:08 -0000	1.116
+++ srctran.lisp	27 Mar 2005 18:34:46 -0000	1.117
@@ -3105,19 +3105,27 @@
 
 ;;; similarly to the EQL transform above, we attempt to constant-fold
 ;;; or convert to a simpler predicate: mostly we have to be careful
-;;; with strings.
+;;; with strings and bit-vectors.
 (deftransform equal ((x y) * *)
   "convert to simpler equality predicate"
   (let ((x-type (lvar-type x))
 	(y-type (lvar-type y))
-	(string-type (specifier-type 'string)))
+	(string-type (specifier-type 'string))
+	(bit-vector-type (specifier-type 'bit-vector)))
     (cond
       ((same-leaf-ref-p x y) t)
       ((and (csubtypep x-type string-type)
 	    (csubtypep y-type string-type))
        '(string= x y))
-      ((and (or (not (types-equal-or-intersect x-type string-type))
-		(not (types-equal-or-intersect y-type string-type)))
+      ((and (csubtypep x-type bit-vector-type)
+	    (csubtypep y-type bit-vector-type))
+       '(bit-vector-= x y))
+      ;; if at least one is not a string, and at least one is not a
+      ;; bit-vector, then we can reason from types.
+      ((and (not (and (types-equal-or-intersect x-type string-type)
+		      (types-equal-or-intersect y-type string-type)))
+	    (not (and (types-equal-or-intersect x-type bit-vector-type)
+		      (types-equal-or-intersect y-type bit-vector-type)))
 	    (not (types-equal-or-intersect x-type y-type)))
        nil)
       (t (give-up-ir1-transform)))))

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

Modified Files:
	pred.lisp 
Log Message:
0.8.21.2:
	Merge mainly MISC fixes held over from pre-freeze


Index: pred.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/pred.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- pred.lisp	30 Oct 2004 14:36:06 -0000	1.15
+++ pred.lisp	27 Mar 2005 18:34:45 -0000	1.16
@@ -48,6 +48,7 @@
   (def-type-predicate-wrapper atom)
   (def-type-predicate-wrapper base-char-p)
   (def-type-predicate-wrapper base-string-p)
+  #!+sb-unicode (def-type-predicate-wrapper character-string-p)
   (def-type-predicate-wrapper bignump)
   (def-type-predicate-wrapper bit-vector-p)
   (def-type-predicate-wrapper characterp)
@@ -82,6 +83,7 @@
   (def-type-predicate-wrapper simple-array-p)
   (def-type-predicate-wrapper simple-bit-vector-p)
   (def-type-predicate-wrapper simple-base-string-p)
+  #!+sb-unicode (def-type-predicate-wrapper simple-character-string-p)
   (def-type-predicate-wrapper simple-string-p)
   (def-type-predicate-wrapper simple-vector-p)
   (def-type-predicate-wrapper single-float-p)

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

Modified Files:
	BUGS NEWS version.lisp-expr 
Log Message:
0.8.21.2:
	Merge mainly MISC fixes held over from pre-freeze


Index: BUGS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/BUGS,v
retrieving revision 1.449
retrieving revision 1.450
diff -u -d -r1.449 -r1.450
--- BUGS	15 Mar 2005 18:21:35 -0000	1.449
+++ BUGS	27 Mar 2005 18:34:42 -0000	1.450
@@ -2079,11 +2079,6 @@
      argument type new CAST to KEYWORD is generated. The compiler
      loops forever.
 
-376: MISC.563
-  Type deriver for CONJUGATE thinks that it returns an object of the
-  same type as its argument, which is wrong for such types as (EQL
-  #C(1 2)).
-
 377: Memory fault error reporting
   On those architectures where :C-STACK-IS-CONTROL-STACK is in
   *FEATURES*, we handle SIG_MEMORY_FAULT (SEGV or BUS) on an altstack,

Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.744
retrieving revision 1.745
diff -u -d -r1.744 -r1.745
--- NEWS	27 Mar 2005 17:44:04 -0000	1.744
+++ NEWS	27 Mar 2005 18:34:42 -0000	1.745
@@ -1,10 +1,19 @@
 changes in sbcl-0.8.22 relative to sbcl-0.8.21:
   * fixed inference of the upper bound of an iteration variable.
     (reported by Rajat Datta).
+  * fixed bug 376: CONJUGATE type deriver.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.549 and similar: late transformation of unsafe type
        assertions into derived types caused unexpected code
        transformations.
+    ** SCALE-FLOAT type deriver is less wrong.
+    ** type derivers for EXP, LOG and similar functions compute result
+       types for complex arguments better.
+    ** (MISC.563) CONJUGATE type deriver works for very restricted
+       complex types.
+    ** out-of-line type testers for character strings are available.
+    ** EQUAL compiler transform understands specialness of objects
+       of type BIT-VECTOR.
 
 changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20:
   * incompatible change: thread support for non-NPTL systems has

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2053
retrieving revision 1.2054
diff -u -d -r1.2053 -r1.2054
--- version.lisp-expr	27 Mar 2005 17:44:06 -0000	1.2053
+++ version.lisp-expr	27 Mar 2005 18:34:43 -0000	1.2054
@@ -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.21.1"
+"0.8.21.2"

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

Modified Files:
	compiler.impure-cload.lisp compiler.pure.lisp 
Log Message:
0.8.21.1:
        * Fix inference of the upper bound of an iteration variable.
          (reported by Rajat Datta).
        * Fix MISC.549 and similar: in cast merging in IR1
          finalization set the node derived type directly, not through
          DERIVE-NODE-TYPE, which could try to optimize code.


Index: compiler.impure-cload.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure-cload.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- compiler.impure-cload.lisp	16 Nov 2004 18:47:48 -0000	1.21
+++ compiler.impure-cload.lisp	27 Mar 2005 17:44:08 -0000	1.22
@@ -391,5 +391,22 @@
            (foo-b (z) (foo-a z)))
     (declare (inline foo-a))
     (foo-a x)))
+
+;;; broken inference of an upper bound of an iteration variable,
+;;; reported by Rajat Datta.
+(defun isieve (num)
+  (let ((vec (make-array num :initial-element 0))
+        (acc 0))
+    (do ((i 2 (+ i 1)))
+        ((>= i num) 'done)
+      (when (= (svref vec i) 0)
+        (do ((j (* i i) (+ j i)))
+            ((>= j num) 'done)
+          (setf (svref vec j) 1))
+        (incf acc)))
+    acc))
+
+(assert (= (isieve 46349) 4792))
+
 
 (sb-ext:quit :unix-status 104)

Index: compiler.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -d -r1.118 -r1.119
--- compiler.pure.lisp	1 Mar 2005 10:54:38 -0000	1.118
+++ compiler.pure.lisp	27 Mar 2005 17:44:08 -0000	1.119
@@ -1739,3 +1739,16 @@
   (compile nil '(lambda (x y)
 		 (declare (type simple-bit-vector x y))
 		 (equal x y))))
+
+;;; MISC.550: CAST merging in IR1 finalization caused unexpected
+;;; code transformations.
+(assert (eql (funcall
+  (compile
+   nil
+   '(lambda (p1 p2)
+     (declare (optimize (speed 3) (safety 2) (debug 3) (space 3))
+      (type atom p1)
+      (type symbol p2))
+     (or p1 (the (eql t) p2))))
+   nil t)
+  t))

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

Modified Files:
	ir1final.lisp ir1opt.lisp 
Log Message:
0.8.21.1:
        * Fix inference of the upper bound of an iteration variable.
          (reported by Rajat Datta).
        * Fix MISC.549 and similar: in cast merging in IR1
          finalization set the node derived type directly, not through
          DERIVE-NODE-TYPE, which could try to optimize code.


Index: ir1final.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1final.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- ir1final.lisp	26 Oct 2004 17:51:17 -0000	1.26
+++ ir1final.lisp	27 Mar 2005 17:44:07 -0000	1.27
@@ -117,14 +117,19 @@
         (cond ((and (cast-p dest)
                     (not (cast-type-check dest))
                     (immediately-used-p lvar node))
-               (when (values-types-equal-or-intersect
-                      (node-derived-type node)
-                      (cast-asserted-type dest))
-                 ;; FIXME: We do not perform pathwise CAST->type-error
-                 ;; conversion, and type errors can later cause
-                 ;; backend failures. On the other hand, this version
-                 ;; produces less efficient code.
-                 (derive-node-type node (cast-asserted-type dest))))
+               (let ((dtype (node-derived-type node))
+                     (atype (node-derived-type dest)))
+                 (when (values-types-equal-or-intersect
+                        dtype atype)
+                   ;; FIXME: We do not perform pathwise CAST->type-error
+                   ;; conversion, and type errors can later cause
+                   ;; backend failures. On the other hand, this version
+                   ;; produces less efficient code.
+                   ;;
+                   ;; This is sorta DERIVE-NODE-TYPE, but does not try
+                   ;; to optimize the node.
+                   (setf (node-derived-type node)
+                         (values-type-intersection dtype atype)))))
               ((and (cast-p node)
                     (eq (cast-type-check node) :external))
                (aver (basic-combination-p dest))

Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -d -r1.105 -r1.106
--- ir1opt.lisp	1 Mar 2005 10:21:32 -0000	1.105
+++ ir1opt.lisp	27 Mar 2005 17:44:08 -0000	1.106
@@ -1221,11 +1221,21 @@
                  (values (numeric-type-low initial-type)
                          (when (and (numeric-type-p set-type)
                                     (numeric-type-equal set-type initial-type))
-                           (numeric-type-high set-type))))
+                           (flet ((max* (i j)
+                                    (cond ((eq i nil) nil)
+                                          ((eq j nil) nil)
+                                          (t (max i j)))))
+                             (max* (numeric-type-high initial-type)
+                                   (numeric-type-high set-type))))))
                 ((csubtypep step-type (specifier-type '(real * 0)))
                  (values (when (and (numeric-type-p set-type)
                                     (numeric-type-equal set-type initial-type))
-                           (numeric-type-low set-type))
+                           (flet ((min* (i j)
+                                    (cond ((eq i nil) nil)
+                                          ((eq j nil) nil)
+                                          (t (min i j)))))
+                           (min* (numeric-type-low initial-type)
+                                 (numeric-type-low set-type))))
                          (numeric-type-high initial-type)))
                 (t
                  (values nil nil)))

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.21.1:
        * Fix inference of the upper bound of an iteration variable.
          (reported by Rajat Datta).
        * Fix MISC.549 and similar: in cast merging in IR1
          finalization set the node derived type directly, not through
          DERIVE-NODE-TYPE, which could try to optimize code.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.743
retrieving revision 1.744
diff -u -d -r1.743 -r1.744
--- NEWS	27 Mar 2005 13:55:59 -0000	1.743
+++ NEWS	27 Mar 2005 17:44:04 -0000	1.744
@@ -1,3 +1,11 @@
+changes in sbcl-0.8.22 relative to sbcl-0.8.21:
+  * fixed inference of the upper bound of an iteration variable.
+    (reported by Rajat Datta).
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** MISC.549 and similar: late transformation of unsafe type
+       assertions into derived types caused unexpected code
+       transformations.
+
 changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20:
   * incompatible change: thread support for non-NPTL systems has
     been removed - locking is buggy and unreliable.  A threaded 

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2052
retrieving revision 1.2053
diff -u -d -r1.2052 -r1.2053
--- version.lisp-expr	27 Mar 2005 13:56:00 -0000	1.2052
+++ version.lisp-expr	27 Mar 2005 17:44:06 -0000	1.2053
@@ -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.21"
+"0.8.21.1"

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.21:
	release, tagged as sbcl_0_8_21


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.742
retrieving revision 1.743
diff -u -d -r1.742 -r1.743
--- NEWS	22 Mar 2005 19:32:26 -0000	1.742
+++ NEWS	27 Mar 2005 13:55:59 -0000	1.743
@@ -13,6 +13,8 @@
     no longer processed with LOAD, but by READ and EVAL; hence the
     global optimization policy, startup package, readtable, etc, 
     can be set by them.
+  * The .fasl file format number has been incremented because of 
+    various incompatible changes.
   * internal entry point details and argument counts no longer appear
     in backtraces unless explicitly requested by setting
     SB-DEBUG:*SHOW-ENTRY-POINT-DETAILS*.

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2051
retrieving revision 1.2052
diff -u -d -r1.2051 -r1.2052
--- version.lisp-expr	22 Mar 2005 22:09:18 -0000	1.2051
+++ version.lisp-expr	27 Mar 2005 13:56:00 -0000	1.2052
@@ -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.20.31"
+"0.8.21"

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

Modified Files:
	make-config.sh version.lisp-expr 
Log Message:
0.8.20.31:
	Has it been a month already? Bump +FASL-FILE-VERSION+. Reasons:
        * "0.8.20.6: Make FILE-STREAM and STRING-STREAM potential mixins
           in CLOS"
        * "0.8.20.21: Add immediate single-floats on x86-64."
        * Probably others...
        
        Restore a modified version of the "slightly odd-looking stuff"
        that was removed in 0.8.20.30. It's there because the arch name
        is "x86-64" but the config file suffix is "x86_64-linux".


Index: make-config.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/make-config.sh,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- make-config.sh	22 Mar 2005 19:32:34 -0000	1.42
+++ make-config.sh	22 Mar 2005 22:09:18 -0000	1.43
@@ -97,7 +97,11 @@
     Linux)
 	printf ' :linux' >> $ltf
 	sbcl_os="linux"
-	ln -s Config.$sbcl_arch-linux Config
+       if [ $sbcl_arch = "x86-64" ]; then
+           ln -s Config.x86_64-linux Config                                    
+       else                                                                    
+           ln -s Config.$sbcl_arch-linux Config                                
+       fi 
 	ln -s $sbcl_arch-linux-os.h target-arch-os.h
 	ln -s linux-os.h target-os.h
 	;;

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2050
retrieving revision 1.2051
diff -u -d -r1.2050 -r1.2051
--- version.lisp-expr	22 Mar 2005 19:32:34 -0000	1.2050
+++ version.lisp-expr	22 Mar 2005 22:09:18 -0000	1.2051
@@ -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.20.30"
+"0.8.20.31"

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

Modified Files:
	early-fasl.lisp 
Log Message:
0.8.20.31:
	Has it been a month already? Bump +FASL-FILE-VERSION+. Reasons:
        * "0.8.20.6: Make FILE-STREAM and STRING-STREAM potential mixins
           in CLOS"
        * "0.8.20.21: Add immediate single-floats on x86-64."
        * Probably others...
        
        Restore a modified version of the "slightly odd-looking stuff"
        that was removed in 0.8.20.30. It's there because the arch name
        is "x86-64" but the config file suffix is "x86_64-linux".


Index: early-fasl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-fasl.lisp,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -d -r1.51 -r1.52
--- early-fasl.lisp	22 Feb 2005 22:14:07 -0000	1.51
+++ early-fasl.lisp	22 Mar 2005 22:09:21 -0000	1.52
@@ -76,7 +76,7 @@
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.
-(def!constant +fasl-file-version+ 53)
+(def!constant +fasl-file-version+ 54)
 ;;; (record of versions before 2003 deleted in 2003-04-26/0.pre8.107 or so)
 ;;; 38: (2003-01-05) changed names of internal SORT machinery
 ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to
@@ -114,6 +114,9 @@
 ;;; 53: (2005-02-22) Something introduced in SBCL 0.8.19.26 (give or take
 ;;;     a couple of patches) invalidated some FFI-related fasls. Probably
 ;;;     caused by "lazy alien resolution improvements".
+;;; 54: (2005-03-22) At least "0.8.20.6: Make FILE-STREAM and STRING-STREAM
+;;;     potential mixins in CLOS" and "0.8.20.21: Add immediate single-floats
+;;;     on x86-64."
 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3715/src/runtime

Modified Files:
	linux-os.c thread.c 
Log Message:
0.8.20.30:
	Slightly nicer behaviour on non-NPTL systems makes it possible
	to use thread-enabled binaries in thread-unfriendly environments again
	- but a warning is issued at startup and MAKE-THREAD signals an error

	Remove some slightly odd-looking stuff in make-config.sh: once
	again it is possible to "SBCL_ARCH=x86 sh make.sh" on an x86-64


Index: linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- linux-os.c	22 Mar 2005 14:02:22 -0000	1.37
+++ linux-os.c	22 Mar 2005 19:32:39 -0000	1.38
@@ -73,6 +73,7 @@
 #include "gc.h"
 
 int linux_sparc_siginfo_bug = 0;
+int linux_no_threads_p = 0;
 
 void os_init(void)
 {
@@ -100,9 +101,9 @@
     }
 #ifdef LISP_FEATURE_SB_THREAD
     futex_wait(futex,-1);
-    if(errno==ENOSYS) {
-	lose("linux with NPTL support (e.g. kernel 2.6 or newer) required for thread-enabled SBCL");
-    }
+    if(errno==ENOSYS)  linux_no_threads_p = 1;
+    if(linux_no_threads_p) 
+	fprintf(stderr,"Linux with NPTL support (e.g. kernel 2.6 or newer) required for \nthread-enabled SBCL.  Disabling thread support.\n\n");
 #endif
     os_vm_page_size = getpagesize();
 }

Index: thread.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- thread.c	11 Mar 2005 17:10:11 -0000	1.33
+++ thread.c	22 Mar 2005 19:32:40 -0000	1.34
@@ -28,6 +28,7 @@
 struct thread *all_threads;
 volatile lispobj all_threads_lock;
 extern struct interrupt_data * global_interrupt_data;
+extern int linux_no_threads_p;
 
 int
 initial_thread_trampoline(struct thread *th)
@@ -230,9 +231,11 @@
 
 #ifdef LISP_FEATURE_SB_THREAD
 pid_t create_thread(lispobj initial_function) {
-    struct thread *th=create_thread_struct(initial_function);
+    struct thread *th;
     pid_t kid_pid=0;
 
+    if(linux_no_threads_p) return 0;
+    th=create_thread_struct(initial_function);
     if(th==0) return 0;
     kid_pid=clone(new_thread_trampoline,
 		  (((void*)th->control_stack_start)+

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

Modified Files:
	NEWS make-config.sh version.lisp-expr 
Log Message:
0.8.20.30:
	Slightly nicer behaviour on non-NPTL systems makes it possible
	to use thread-enabled binaries in thread-unfriendly environments again
	- but a warning is issued at startup and MAKE-THREAD signals an error

	Remove some slightly odd-looking stuff in make-config.sh: once
	again it is possible to "SBCL_ARCH=x86 sh make.sh" on an x86-64


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.741
retrieving revision 1.742
diff -u -d -r1.741 -r1.742
--- NEWS	22 Mar 2005 14:02:18 -0000	1.741
+++ NEWS	22 Mar 2005 19:32:26 -0000	1.742
@@ -1,8 +1,8 @@
 changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20:
   * incompatible change: thread support for non-NPTL systems has
     been removed - locking is buggy and unreliable.  A threaded 
-    SBCL build will now refuse to start unless futex support is 
-    detected in the kernel
+    SBCL build will now warn at startup and refuse to create
+    new threads, unless futex support is detected in the kernel
   * incompatible change: the top level REPL now has only an ABORT
     restart associated with it, not TOPLEVEL and ABORT as it used to.
     TOP and TOPLEVEL are now available as debugger commands for 

Index: make-config.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/make-config.sh,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- make-config.sh	8 Jan 2005 09:41:47 -0000	1.41
+++ make-config.sh	22 Mar 2005 19:32:34 -0000	1.42
@@ -97,11 +97,7 @@
     Linux)
 	printf ' :linux' >> $ltf
 	sbcl_os="linux"
-	if [ "`uname -m`" = "x86_64" ]; then
-	    ln -s Config.x86_64-linux Config
-	else
-	    ln -s Config.$sbcl_arch-linux Config
-	fi
+	ln -s Config.$sbcl_arch-linux Config
 	ln -s $sbcl_arch-linux-os.h target-arch-os.h
 	ln -s linux-os.h target-os.h
 	;;

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2049
retrieving revision 1.2050
diff -u -d -r1.2049 -r1.2050
--- version.lisp-expr	22 Mar 2005 14:02:19 -0000	1.2049
+++ version.lisp-expr	22 Mar 2005 19:32:34 -0000	1.2050
@@ -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.20.29"
+"0.8.20.30"

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

Modified Files:
	target-thread.lisp 
Log Message:
0.8.20.30:
	Slightly nicer behaviour on non-NPTL systems makes it possible
	to use thread-enabled binaries in thread-unfriendly environments again
	- but a warning is issued at startup and MAKE-THREAD signals an error

	Remove some slightly odd-looking stuff in make-config.sh: once
	again it is possible to "SBCL_ARCH=x86 sh make.sh" on an x86-64


Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- target-thread.lisp	22 Mar 2005 14:02:21 -0000	1.26
+++ target-thread.lisp	22 Mar 2005 19:32:37 -0000	1.27
@@ -185,6 +185,7 @@
 		    (funcall real-function))
 		  0))
 	      (values))))))
+    (when (zerop tid) (error "Can't create a new thread"))
     (with-mutex ((session-lock *session*))
       (pushnew tid (session-threads *session*)))
     tid))

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

Modified Files:
	NEWS base-target-features.lisp-expr version.lisp-expr 
Log Message:
0.8.20.29:
	Merge SB-FUTEX and SB-THREAD: the latter now requires the
	former.  SBCL threads now require Linux kernel 2.6, or an NPTL
	backport to 2.4 such as the Red Hat one

	Lock/unlock functions take long (not int) as arguments: this makes
	a difference on 64 bit ports (or would do if we had threading support
	on either of them)



Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.740
retrieving revision 1.741
diff -u -d -r1.740 -r1.741
--- NEWS	17 Mar 2005 22:51:44 -0000	1.740
+++ NEWS	22 Mar 2005 14:02:18 -0000	1.741
@@ -1,4 +1,8 @@
 changes in sbcl-0.8.21 (0.9alpha.1?) relative to sbcl-0.8.20:
+  * incompatible change: thread support for non-NPTL systems has
+    been removed - locking is buggy and unreliable.  A threaded 
+    SBCL build will now refuse to start unless futex support is 
+    detected in the kernel
   * incompatible change: the top level REPL now has only an ABORT
     restart associated with it, not TOPLEVEL and ABORT as it used to.
     TOP and TOPLEVEL are now available as debugger commands for 

Index: base-target-features.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/base-target-features.lisp-expr,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- base-target-features.lisp-expr	8 Jan 2005 09:41:47 -0000	1.33
+++ base-target-features.lisp-expr	22 Mar 2005 14:02:19 -0000	1.34
@@ -154,21 +154,14 @@
 
  ;; low-level thread primitives support
  ;;
- ;; As of SBCL 0.8,  this is only supposed to work in x86 Linux, on which
- ;; system it's implemented using clone(2) and the %fs segment register.
- ;; Note that no consistent effort to audit the SBCL library code for
- ;; thread safety has been performed, so caveat executor.
+ ;; As of SBCL 0.8, this is only supposed to work in x86 Linux with
+ ;; NPTL support (usually kernel 2.6, though sme Red Hat distributions
+ ;; with older kernels also have it) and is implemented using clone(2)
+ ;; and the %fs segment register.  Note that no consistent effort to
+ ;; audit the SBCL library code for thread safety has been performed,
+ ;; so caveat executor.
  ; :sb-thread
 
- ;; Kernel support for futexes (so-called "fast userspace mutexes") is
- ;; available in Linux 2.6 and some versions of 2.4 (Red Hat vendor
- ;; kernels, possibly other vendors too).  We can take advantage of
- ;; these to do faster and probably more reliable mutex and condition
- ;; variable support.  An SBCL built with this feature will fall back
- ;; to the old system if the futex() syscall is not available at
- ;; runtime
- ; :sb-futex
-
  ;; Support for detection of unportable code (when applied to the
  ;; COMMON-LISP package, or SBCL-internal pacakges) or bad-neighbourly
  ;; code (when applied to user-level packages), relating to material

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2048
retrieving revision 1.2049
diff -u -d -r1.2048 -r1.2049
--- version.lisp-expr	20 Mar 2005 09:03:40 -0000	1.2048
+++ version.lisp-expr	22 Mar 2005 14:02:19 -0000	1.2049
@@ -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.20.28"
+"0.8.20.29"

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

Modified Files:
	cold-init.lisp target-thread.lisp target-unithread.lisp 
Log Message:
0.8.20.29:
	Merge SB-FUTEX and SB-THREAD: the latter now requires the
	former.  SBCL threads now require Linux kernel 2.6, or an NPTL
	backport to 2.4 such as the Red Hat one

	Lock/unlock functions take long (not int) as arguments: this makes
	a difference on 64 bit ports (or would do if we had threading support
	on either of them)



Index: cold-init.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cold-init.lisp,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- cold-init.lisp	6 Jan 2005 12:47:58 -0000	1.53
+++ cold-init.lisp	22 Mar 2005 14:02:21 -0000	1.54
@@ -297,8 +297,7 @@
       ;; see also comment at the previous SET-FLOATING-POINT-MODES
       ;; call site.
       (set-floating-point-modes
-       :traps '(:overflow #!-netbsd :invalid :divide-by-zero))
-      (sb!thread::maybe-install-futex-functions)))
+       :traps '(:overflow #!-netbsd :invalid :divide-by-zero))))
   (thread-init-or-reinit)
   (gc-reinit)
   ;; make sure TIME works correctly from saved cores

Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- target-thread.lisp	6 Jan 2005 12:47:59 -0000	1.25
+++ target-thread.lisp	22 Mar 2005 14:02:21 -0000	1.26
@@ -84,67 +84,19 @@
 (sb!alien:define-alien-routine "block_sigcont"  void)
 (sb!alien:define-alien-routine "unblock_sigcont_and_sleep"  void)
 
-#!+sb-futex
 (declaim (inline futex-wait futex-wake))
-#!+sb-futex
 (sb!alien:define-alien-routine
     "futex_wait" int (word unsigned-long) (old-value unsigned-long))
-#!+sb-futex
 (sb!alien:define-alien-routine
     "futex_wake" int (word unsigned-long) (n unsigned-long))
 
 
-;;; this should only be called while holding the queue spinlock.
-;;; it releases the spinlock before sleeping
-(defun wait-on-queue (queue &optional lock)
-  (let ((pid (current-thread-id)))
-    (block-sigcont)
-    (when lock (release-mutex lock))
-    (sb!sys:without-interrupts
-     (pushnew pid (waitqueue-data queue)))
-    (setf (waitqueue-lock queue) 0)
-    (unblock-sigcont-and-sleep)))
-
-;;; this should only be called while holding the queue spinlock.  It doesn't
-;;; release it
-(defun dequeue (queue)
-  (let ((pid (current-thread-id)))
-    (sb!sys:without-interrupts     
-     (setf (waitqueue-data queue)
-	   (delete pid (waitqueue-data queue))))))
-
-;;; this should only be called while holding the queue spinlock.
-(defun signal-queue-head (queue)
-  (let ((p (car (waitqueue-data queue))))
-    (when p (signal-thread-to-dequeue p))))
-
 ;;;; mutex
 
-;;; i suspect there may be a race still in this: the futex version requires
-;;; the old mutex value before sleeping, so how do we get away without it
 (defun get-mutex (lock &optional new-value (wait-p t))
   "Acquire LOCK, setting it to NEW-VALUE or some suitable default value 
 if NIL.  If WAIT-P is non-NIL and the lock is in use, sleep until it
 is available"
-  (declare (type mutex lock) (optimize (speed 3)))
-  (let ((pid (current-thread-id)))
-    (unless new-value (setf new-value pid))
-    (assert (not (eql new-value (mutex-value lock))))
-    (get-spinlock lock 2 pid)
-    (loop
-     (unless
-	 ;; args are object slot-num old-value new-value
-	 (sb!vm::%instance-set-conditional lock 4 nil new-value)
-       (dequeue lock)
-       (setf (waitqueue-lock lock) 0)
-       (return t))
-     (unless wait-p
-       (setf (waitqueue-lock lock) 0)
-       (return nil))
-     (wait-on-queue lock nil))))
-
-#!+sb-futex
-(defun get-mutex/futex (lock &optional new-value (wait-p t))
   (declare (type mutex lock)  (optimize (speed 3)))
   (let ((pid (current-thread-id))
 	old)
@@ -159,15 +111,7 @@
      (futex-wait (mutex-value-address lock)
 		 (sb!kernel:get-lisp-obj-address old)))))
 
-(defun release-mutex (lock &optional (new-value nil))
-  (declare (type mutex lock))
-  ;; we assume the lock is ours to release
-  (with-spinlock (lock)
-    (setf (mutex-value lock) new-value)
-    (signal-queue-head lock)))
-
-#!+sb-futex
-(defun release-mutex/futex (lock)
+(defun release-mutex (lock)
   (declare (type mutex lock))
   (setf (mutex-value lock) nil)
   (futex-wake (mutex-value-address lock) 1))
@@ -181,22 +125,6 @@
   (assert lock)
   (let ((value (mutex-value lock)))
     (unwind-protect
-	 (progn
-	   (get-spinlock queue 2 (current-thread-id))
-	   (wait-on-queue queue lock))
-      ;; If we are interrupted while waiting, we should do these things
-      ;; before returning.  Ideally, in the case of an unhandled signal,
-      ;; we should do them before entering the debugger, but this is
-      ;; better than nothing.
-      (with-spinlock (queue)
-	(dequeue queue))
-      (get-mutex lock value))))
-
-#!+sb-futex
-(defun condition-wait/futex (queue lock)
-  (assert lock)
-  (let ((value (mutex-value lock)))
-    (unwind-protect
 	 (let ((me (current-thread-id)))
 	   ;; XXX we should do something to ensure that the result of this setf
 	   ;; is visible to all CPUs
@@ -218,11 +146,6 @@
 
 (defun condition-notify (queue)
   "Notify one of the processes waiting on QUEUE"
-  (with-spinlock (queue) (signal-queue-head queue)))
-
-#!+sb-futex
-(defun condition-notify/futex (queue)
-  "Notify one of the processes waiting on QUEUE."
   (let ((me (current-thread-id)))
     ;; no problem if >1 thread notifies during the comment in
     ;; condition-wait: as long as the value in queue-data isn't the
@@ -232,30 +155,11 @@
     (setf (waitqueue-data queue) me)
     (futex-wake (waitqueue-data-address queue) 1)))
 
-#!+sb-futex
-(defun condition-broadcast/futex (queue)
+(defun condition-broadcast (queue)
   (let ((me (current-thread-id)))
     (setf (waitqueue-data queue) me)
     (futex-wake (waitqueue-data-address queue) (ash 1 30))))
 
-(defun condition-broadcast (queue)
-  "Notify all of the processes waiting on QUEUE."
-  (with-spinlock (queue)
-    (map nil #'signal-thread-to-dequeue (waitqueue-data queue))))
-
-;;; Futexes may be available at compile time but not runtime, so we
-;;; default to not using them unless os_init says they're available
-(defun maybe-install-futex-functions ()
-  #!+sb-futex
-  (unless (zerop (extern-alien "linux_supports_futex" int))
-    (sb!ext:without-package-locks
-      (setf (fdefinition 'get-mutex) #'get-mutex/futex
-            (fdefinition 'release-mutex) #'release-mutex/futex
-            (fdefinition 'condition-wait) #'condition-wait/futex
-            (fdefinition 'condition-broadcast) #'condition-broadcast/futex
-            (fdefinition 'condition-notify) #'condition-notify/futex))
-    t))
-
 (defun make-thread (function)
   (let* ((real-function (coerce function 'function))
 	 (tid

Index: target-unithread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-unithread.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- target-unithread.lisp	6 Jan 2005 12:47:59 -0000	1.14
+++ target-unithread.lisp	22 Mar 2005 14:02:21 -0000	1.15
@@ -141,8 +141,6 @@
   "Notify one of the processes waiting on QUEUE"
   (signal-queue-head queue))
 
-(defun maybe-install-futex-functions () nil)
-
 ;;;; job control
 
 (defun init-job-control () t)

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6133/src/runtime

Modified Files:
	alpha-arch.h hppa-arch.h linux-os.c mips-arch.h ppc-arch.h 
	sparc-arch.h x86-64-arch.h x86-arch.h 
Log Message:
0.8.20.29:
	Merge SB-FUTEX and SB-THREAD: the latter now requires the
	former.  SBCL threads now require Linux kernel 2.6, or an NPTL
	backport to 2.4 such as the Red Hat one

	Lock/unlock functions take long (not int) as arguments: this makes
	a difference on 64 bit ports (or would do if we had threading support
	on either of them)



Index: alpha-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/alpha-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- alpha-arch.h	25 Aug 2003 21:00:01 -0000	1.2
+++ alpha-arch.h	22 Mar 2005 14:02:21 -0000	1.3
@@ -3,7 +3,7 @@
 
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
     *word=value;		/* FIXME for threads */
 }

Index: hppa-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- hppa-arch.h	25 Aug 2003 21:00:02 -0000	1.2
+++ hppa-arch.h	22 Mar 2005 14:02:22 -0000	1.3
@@ -3,7 +3,7 @@
 
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
     *word=value;		/* FIXME for threads */
 }

Index: linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- linux-os.c	14 Mar 2005 09:54:49 -0000	1.36
+++ linux-os.c	22 Mar 2005 14:02:22 -0000	1.37
@@ -49,7 +49,7 @@
 #include "thread.h"
 size_t os_vm_page_size;
 
-#ifdef LISP_FEATURE_SB_FUTEX
+#ifdef LISP_FEATURE_SB_THREAD
 #include <linux/unistd.h>
 #include <errno.h>
 
@@ -73,7 +73,6 @@
 #include "gc.h"
 
 int linux_sparc_siginfo_bug = 0;
-int linux_supports_futex=0;
 
 void os_init(void)
 {
@@ -94,17 +93,16 @@
 	     major_version);
     }
     if (!(major_version>2 || minor_version >= 4)) {
-#ifdef LISP_FEATURE_SB_THREAD
-	lose("linux kernel 2.4 required for thread-enabled SBCL");
-#endif
 #ifdef LISP_FEATURE_SPARC
 	FSHOW((stderr,"linux kernel %d.%d predates 2.4;\n enabling workarounds for SPARC kernel bugs in signal handling.\n", major_version,minor_version));
 	linux_sparc_siginfo_bug = 1;
 #endif
     }
-#ifdef LISP_FEATURE_SB_FUTEX
+#ifdef LISP_FEATURE_SB_THREAD
     futex_wait(futex,-1);
-    if(errno!=ENOSYS) linux_supports_futex=1;
+    if(errno==ENOSYS) {
+	lose("linux with NPTL support (e.g. kernel 2.6 or newer) required for thread-enabled SBCL");
+    }
 #endif
     os_vm_page_size = getpagesize();
 }
@@ -288,13 +286,10 @@
 						 sig_stop_for_gc_handler);
     undoably_install_low_level_interrupt_handler(SIG_THREAD_EXIT,
 						 thread_exit_handler);
-    if(!linux_supports_futex)
-	undoably_install_low_level_interrupt_handler(SIG_DEQUEUE,
-						     sigcont_handler);
 #endif
 }
 
-#ifdef LISP_FEATURE_SB_FUTEX
+#ifdef LISP_FEATURE_SB_THREAD
 int futex_wait(int *lock_word, int oldval) {
     int t= sys_futex(lock_word,FUTEX_WAIT,oldval, 0);
     return t;

Index: mips-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/mips-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- mips-arch.h	25 Aug 2003 21:00:02 -0000	1.2
+++ mips-arch.h	22 Mar 2005 14:02:22 -0000	1.3
@@ -3,7 +3,7 @@
 
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
     *word=value;		/* FIXME for threads */
 }

Index: ppc-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/ppc-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- ppc-arch.h	25 Aug 2003 21:00:02 -0000	1.2
+++ ppc-arch.h	22 Mar 2005 14:02:22 -0000	1.3
@@ -2,7 +2,7 @@
 #define _PPC_ARCH_H
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
     *word=value;		/* FIXME for threads */
 }

Index: sparc-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/sparc-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- sparc-arch.h	25 Aug 2003 21:00:02 -0000	1.2
+++ sparc-arch.h	22 Mar 2005 14:02:22 -0000	1.3
@@ -2,7 +2,7 @@
 #define _SPARC_ARCH_H
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
     *word=value;		/* FIXME for threads */
 }

Index: x86-64-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-64-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- x86-64-arch.h	6 Jan 2005 12:48:04 -0000	1.2
+++ x86-64-arch.h	22 Mar 2005 14:02:22 -0000	1.3
@@ -13,7 +13,7 @@
  * architecture-abstracting patches for CSR's SPARC port. -- WHN 2002-02-15) */
 
 static inline void 
-get_spinlock(lispobj *word,int value)
+get_spinlock(lispobj *word,long value)
 {
 #if 0
     u32 eax=0;

Index: x86-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- x86-arch.h	10 Sep 2004 15:36:18 -0000	1.6
+++ x86-arch.h	22 Mar 2005 14:02:22 -0000	1.7
@@ -25,7 +25,7 @@
 extern never_returns lose(char *fmt, ...);
 
 static inline void 
-get_spinlock(volatile lispobj *word,int value)
+get_spinlock(volatile lispobj *word,long value)
 {
     u32 eax=0;
     if(*word==value)

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

Modified Files:
	debug.lisp 
Log Message:
0.8.20.28 pretty backtraces with unavailable arguments & lambda-lists
             * fix issue reported by Juho Snellman on sbcl-devel 2005-03-18,
                and some related problems.
             * minor combinatorial explosion in debug.impure.lisp; most
                tests still skipped on x86/linux :/


              
              


Index: debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/debug.lisp,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -d -r1.76 -r1.77
--- debug.lisp	10 Mar 2005 23:26:24 -0000	1.76
+++ debug.lisp	20 Mar 2005 09:03:40 -0000	1.77
@@ -270,29 +270,44 @@
 (legal-fun-name-p '(lambda ()))
 (defvar *show-entry-point-details* nil)
 
+(defun clean-xep (name args)
+  (values (second name)
+	  (if (consp args)
+	      (let ((count (first args))
+		    (real-args (rest args)))
+		(if (fixnump count)
+		    (subseq real-args 0 
+			    (min count (length real-args)))
+		    real-args))
+	      args)))
+
+(defun clean-&more-processor (name args)
+  (values (second name)
+	  (if (consp args)
+	      (let* ((more (last args 2))
+		     (context (first more))
+		     (count (second more)))		
+		(append
+		 (butlast args 2)
+		 (if (fixnump count)
+		     (multiple-value-list 
+		      (sb!c:%more-arg-values context 0 count))
+		     (list
+		      (make-unprintable-object "more unavailable arguments")))))
+	      args)))
+
 (defun frame-call (frame)
   (labels ((clean-name-and-args (name args)
              (if (and (consp name) (not *show-entry-point-details*))
+		 ;; FIXME: do we need to deal with
+		 ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
+		 ;; &AUX-BINDINGS appear in backtraces, so they are
+		 ;; left alone for now. --NS 2005-02-28
                  (case (first name)
                    ((sb!c::xep sb!c::tl-xep)
-                    (clean-name-and-args 
-                     (second name)
-                     (let ((count (first args))
-                           (real-args (rest args)))
-                       (subseq real-args 0 (min count (length real-args))))))
+		    (clean-xep name args))
                    ((sb!c::&more-processor)
-                    (clean-name-and-args
-                     (second name)
-                     (let* ((more (last args 2))
-                            (context (first more))
-                            (count (second more)))
-                       (append (butlast args 2)
-                               (multiple-value-list 
-                                (sb!c:%more-arg-values context 0 count))))))
-                   ;; FIXME: do we need to deal with
-                   ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
-                   ;; &AUX-BINDINGS appear in backtraces, so they are
-                   ;; left alone for now. --NS 2005-02-28
+		    (clean-&more-processor name args))
                    ((sb!c::hairy-arg-processor 
                      sb!c::varargs-entry sb!c::&optional-processor)
                     (clean-name-and-args (second name) args))
@@ -363,7 +378,7 @@
 	(sb!di:debug-condition (ignore) 
           ignore)
 	(error (c) 
-          (format stream "error finding source: ~A" c))))))
+          (format stream "~&error finding source: ~A" c))))))
 
 ;;;; INVOKE-DEBUGGER

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

Modified Files:
	debug.impure.lisp 
Log Message:
0.8.20.28 pretty backtraces with unavailable arguments & lambda-lists
             * fix issue reported by Juho Snellman on sbcl-devel 2005-03-18,
                and some related problems.
             * minor combinatorial explosion in debug.impure.lisp; most
                tests still skipped on x86/linux :/


              
              


Index: debug.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/debug.impure.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- debug.impure.lisp	15 Mar 2005 18:21:32 -0000	1.15
+++ debug.impure.lisp	20 Mar 2005 09:03:40 -0000	1.16
@@ -68,10 +68,10 @@
 ;;; and hasn't been cut off anywhere.
 (defun verify-backtrace (test-function frame-specs &key (allow-stunted nil))
   (labels ((args-equal (want real)
-             (cond ((endp want)
-                    (endp real))
-                   ((eq '&rest (car want))
+             (cond ((eq '&rest (car want))
                     t)
+                   ((endp want)
+                    (endp real))
                    ((or (eq '? (car want)) (equal (car want) (car real)))
                     (args-equal (cdr want) (cdr real)))
                    (t
@@ -195,20 +195,34 @@
 (defun oops ()
   (error "oops"))
 
-(defun bt.1 (&key key)
+(defmacro defbt (n ll &body body)
+  `(progn
+     ;; normal debug info
+     (defun ,(intern (format nil "BT.~A.1" n)) ,ll 
+       ,@body)
+     ;; no arguments saved
+     (defun ,(intern (format nil "BT.~A.2" n)) ,ll 
+       (declare (optimize (debug 1) (speed 3)))
+       ,@body)
+     ;; no lambda-list saved
+     (defun ,(intern (format nil "BT.~A.3" n)) ,ll 
+       (declare (optimize (debug 0)))
+       ,@body)))
+
+(defbt 1 (&key key)
   (list key))
 
-(defun bt.2 (x)
+(defbt 2 (x)
   (list x))
 
-(defun bt.3 (&key (key (oops)))
+(defbt 3 (&key (key (oops)))
   (list key))
 
 ;;; ERROR instead of OOPS so that tail call elimination doesn't happen
-(defun bt.4 (&optional opt)
+(defbt 4 (&optional opt)
   (list (error "error")))
 
-(defun bt.5 (&optional (opt (oops)))
+(defbt 5 (&optional (opt (oops)))
   (list opt))
 
 #-(and x86 linux)
@@ -216,53 +230,99 @@
              `(let ((sb-debug:*show-entry-point-details* ,bool))
                 ,@body)))
 
-  ;; &MORE-PROCESSOR
+  ;; TL-XEP
+  (print :tl-xep)
   (with-details t
-    (assert (verify-backtrace (lambda () (bt.1 :key))
-                              '(((sb-c::&more-processor bt.1) &rest)))))
+    (assert (verify-backtrace #'namestring
+                              '(((sb-c::tl-xep namestring) 0 ?)))))
   (with-details nil
-    (assert (verify-backtrace (lambda () (bt.1 :key))
-                              '((bt.1 :key)))))
+    (assert (verify-backtrace #'namestring
+                              '((namestring)))))
 
-  ;; XEP
+
+  ;; &MORE-PROCESSOR
   (with-details t
-    (assert (verify-backtrace #'bt.2
-                              '(((sb-c::xep bt.2) 0 ?)))))
+    (assert (verify-backtrace (lambda () (bt.1.1 :key))
+                              '(((sb-c::&more-processor bt.1.1) &rest))))
+    (assert (verify-backtrace (lambda () (bt.1.2 :key))
+                              '(((sb-c::&more-processor bt.1.2) &rest))))
+    (assert (verify-backtrace (lambda () (bt.1.3 :key))
+                              '(((sb-c::&more-processor bt.1.3) &rest)))))
   (with-details nil
-    (assert (verify-backtrace #'bt.2
-                              '((bt.2)))))
+    (assert (verify-backtrace (lambda () (bt.1.1 :key))
+                              '((bt.1.1 :key))))
+    (assert (verify-backtrace (lambda () (bt.1.2 :key))
+                              '((bt.1.2 &rest))))
+    (assert (verify-backtrace (lambda () (bt.1.3 :key))
+                              '((bt.1.3 &rest)))))
 
-  ;; TL-XEP
+  ;; XEP
+  (print :xep)
   (with-details t
-    (assert (verify-backtrace #'namestring
-                              '(((sb-c::tl-xep namestring) 0 ?)))))
+    (assert (verify-backtrace #'bt.2.1
+                              '(((sb-c::xep bt.2.1) 0 ?))))
+    (assert (verify-backtrace #'bt.2.2
+                              '(((sb-c::xep bt.2.2) &rest))))
+    (assert (verify-backtrace #'bt.2.3
+                              '(((sb-c::xep bt.2.3) &rest)))))
   (with-details nil
-    (assert (verify-backtrace #'namestring
-                              '((namestring)))))
+    (assert (verify-backtrace #'bt.2.1
+                              '((bt.2.1))))
+    (assert (verify-backtrace #'bt.2.2
+                              '((bt.2.2 &rest))))
+    (assert (verify-backtrace #'bt.2.3
+                              '((bt.2.3 &rest)))))
 
   ;; VARARGS-ENTRY
+  (print :varargs-entry)
   (with-details t
-    (assert (verify-backtrace #'bt.3
-                             '(((sb-c::varargs-entry bt.3) :key nil)))))
+    (assert (verify-backtrace #'bt.3.1
+                             '(((sb-c::varargs-entry bt.3.1) :key nil))))
+    (assert (verify-backtrace #'bt.3.2
+                             '(((sb-c::varargs-entry bt.3.2) :key ?))))
+    (assert (verify-backtrace #'bt.3.3
+                             '(((sb-c::varargs-entry bt.3.3) &rest)))))
   (with-details nil
-    (assert (verify-backtrace #'bt.3
-                              '((bt.3 :key nil)))))
+    (assert (verify-backtrace #'bt.3.1
+                              '((bt.3.1 :key nil))))
+    (assert (verify-backtrace #'bt.3.2
+                              '((bt.3.2 :key ?))))
+    (assert (verify-backtrace #'bt.3.3
+                              '((bt.3.3 &rest)))))
 
   ;; HAIRY-ARG-PROCESSOR
+  (print :hairy-args-processor)
   (with-details t
-    (assert (verify-backtrace #'bt.4
-                              '(((sb-c::hairy-arg-processor bt.4) ?)))))
+    (assert (verify-backtrace #'bt.4.1
+                              '(((sb-c::hairy-arg-processor bt.4.1) ?))))
+    (assert (verify-backtrace #'bt.4.2
+                              '(((sb-c::hairy-arg-processor bt.4.2) ?))))
+    (assert (verify-backtrace #'bt.4.3
+                              '(((sb-c::hairy-arg-processor bt.4.3) &rest)))))
   (with-details nil
-    (assert (verify-backtrace #'bt.4
-                              '((bt.4 ?)))))
+    (assert (verify-backtrace #'bt.4.1
+                              '((bt.4.1 ?))))
+    (assert (verify-backtrace #'bt.4.2
+                              '((bt.4.2 ?))))
+    (assert (verify-backtrace #'bt.4.3
+                              '((bt.4.3 &rest)))))
 
   ;; &OPTIONAL-PROCESSOR
+  (print :optional-processor)
   (with-details t
-    (assert (verify-backtrace #'bt.5
-                              '(((sb-c::&optional-processor bt.5))))))
+    (assert (verify-backtrace #'bt.5.1
+                              '(((sb-c::&optional-processor bt.5.1)))))
+    (assert (verify-backtrace #'bt.5.2
+                              '(((sb-c::&optional-processor bt.5.2) &rest))))
+    (assert (verify-backtrace #'bt.5.3
+                              '(((sb-c::&optional-processor bt.5.3) &rest)))))
   (with-details nil
-    (assert (verify-backtrace #'bt.5
-                              '((bt.5))))))
+    (assert (verify-backtrace #'bt.5.1
+                              '((bt.5.1))))
+    (assert (verify-backtrace #'bt.5.2
+                              '((bt.5.2 &rest))))
+    (assert (verify-backtrace #'bt.5.3
+                              '((bt.5.3 &rest))))))
 
 ;;; success
 (quit :unix-status 104)

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.20.28 pretty backtraces with unavailable arguments & lambda-lists
             * fix issue reported by Juho Snellman on sbcl-devel 2005-03-18,
                and some related problems.
             * minor combinatorial explosion in debug.impure.lisp; most
                tests still skipped on x86/linux :/


              
              


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2047
retrieving revision 1.2048
diff -u -d -r1.2047 -r1.2048
--- version.lisp-expr	17 Mar 2005 22:51:43 -0000	1.2047
+++ version.lisp-expr	20 Mar 2005 09:03:40 -0000	1.2048
@@ -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.20.27"
+"0.8.20.28"

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

Modified Files:
	version.lisp-expr NEWS 
Log Message:
0.8.20.27:
	Fix x86-64 backend bugs found using Paul Dietz's random tester.
        * Sign-extension in constant LOGAND, + and TRUNCATE VOPs.
        * Sign-extension of literal (unsigned-byte 32) passed as
          arguments on the stack.
        
        Fix handling of :START1 and :START2 in the string comparison
        deftransforms on simple-base-strings (ansi-tests MISC.572/573/574).
        
        Minor cleanup: Use the already defined *cache-expand-threshold*
        instead of magic numbers in pcl/cache.lisp.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2046
retrieving revision 1.2047
diff -u -d -r1.2046 -r1.2047
--- version.lisp-expr	16 Mar 2005 10:21:49 -0000	1.2046
+++ version.lisp-expr	17 Mar 2005 22:51:43 -0000	1.2047
@@ -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.20.26"
+"0.8.20.27"

Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.739
retrieving revision 1.740
diff -u -d -r1.739 -r1.740
--- NEWS	16 Mar 2005 10:21:46 -0000	1.739
+++ NEWS	17 Mar 2005 22:51:44 -0000	1.740
@@ -51,6 +51,9 @@
     ** MISC.564: defined out-of-line version of %ATAN2 on x86.
     ** attempting to create a package with a colliding nickname causes
        correctable errors to be signalled.
+    ** MISC.572-574: :START1 and :START2 broken for simple-base-strings.
+    ** several x86-64 backend bugs related to sign-extension of immediate
+       operands.
 
 changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
   * fixed inspection of specialized arrays. (thanks to Simon Alexander)

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

Modified Files:
	arith.lisp macros.lisp 
Log Message:
0.8.20.27:
	Fix x86-64 backend bugs found using Paul Dietz's random tester.
        * Sign-extension in constant LOGAND, + and TRUNCATE VOPs.
        * Sign-extension of literal (unsigned-byte 32) passed as
          arguments on the stack.
        
        Fix handling of :START1 and :START2 in the string comparison
        deftransforms on simple-base-strings (ansi-tests MISC.572/573/574).
        
        Minor cleanup: Use the already defined *cache-expand-threshold*
        instead of magic numbers in pcl/cache.lisp.


Index: arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/arith.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- arith.lisp	1 Mar 2005 10:54:38 -0000	1.11
+++ arith.lisp	17 Mar 2005 22:51:45 -0000	1.12
@@ -128,7 +128,6 @@
   (:result-types unsigned-num)
   (:note "inline (unsigned-byte 32) arithmetic"))
 
-;; 32 not 64 because it's hard work loading 64 bit constants
 (define-vop (fast-signed-binop-c fast-safe-arith-op)
   (:args (x :target r :scs (signed-reg signed-stack)))
   (:info y)
@@ -268,7 +267,7 @@
 (define-vop (fast-logand-c/signed-unsigned=>unsigned
 	     fast-logand-c/unsigned=>unsigned)
   (:args (x :target r :scs (signed-reg signed-stack)))
-  (:arg-types signed-num (:constant (unsigned-byte 32))))
+  (:arg-types signed-num (:constant (unsigned-byte 31))))
 
 (define-vop (fast-logand/unsigned-signed=>unsigned
 	     fast-logand/unsigned=>unsigned)
@@ -328,7 +327,7 @@
   (:translate +)
   (:args (x :target r :scs (unsigned-reg unsigned-stack)))
   (:info y)
-  (:arg-types unsigned-num (:constant (unsigned-byte 32)))
+  (:arg-types unsigned-num (:constant (unsigned-byte 31)))
   (:results (r :scs (unsigned-reg)
 	       :load-if (not (location= x r))))
   (:result-types unsigned-num)
@@ -503,7 +502,7 @@
   (:translate truncate)
   (:args (x :scs (unsigned-reg) :target eax))
   (:info y)
-  (:arg-types unsigned-num (:constant (unsigned-byte 32)))
+  (:arg-types unsigned-num (:constant (unsigned-byte 31)))
   (:temporary (:sc unsigned-reg :offset eax-offset :target quo
 		   :from :argument :to (:result 0)) eax)
   (:temporary (:sc unsigned-reg :offset edx-offset :target rem

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/macros.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- macros.lisp	6 Jan 2005 12:48:02 -0000	1.2
+++ macros.lisp	17 Mar 2005 22:51:45 -0000	1.3
@@ -57,8 +57,7 @@
 (defmacro storew (value ptr &optional (slot 0) (lowtag 0))
   (once-only ((value value))
     `(cond ((and (integerp ,value) 
-		 (not (typep ,value 
-			     '(or (signed-byte 32) (unsigned-byte 32)))))
+		 (not (typep ,value '(signed-byte 32))))
 	    (multiple-value-bind (lo hi) (dwords-for-quad ,value)
 	      (inst mov (make-ea-for-object-slot-half
 			 ,ptr ,slot ,lowtag) lo)

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

Modified Files:
	string.pure.lisp arith.pure.lisp 
Log Message:
0.8.20.27:
	Fix x86-64 backend bugs found using Paul Dietz's random tester.
        * Sign-extension in constant LOGAND, + and TRUNCATE VOPs.
        * Sign-extension of literal (unsigned-byte 32) passed as
          arguments on the stack.
        
        Fix handling of :START1 and :START2 in the string comparison
        deftransforms on simple-base-strings (ansi-tests MISC.572/573/574).
        
        Minor cleanup: Use the already defined *cache-expand-threshold*
        instead of magic numbers in pcl/cache.lisp.


Index: string.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/string.pure.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- string.pure.lisp	16 Jul 2003 08:26:04 -0000	1.3
+++ string.pure.lisp	17 Mar 2005 22:51:43 -0000	1.4
@@ -76,3 +76,14 @@
 
 (assert (raises-error? (make-string 5 :element-type t)))
 (assert (raises-error? (let () (make-string 5 :element-type t))))
+
+;; MISC.574
+(assert (= (funcall (lambda (a)
+		      (declare (optimize (speed 3) (safety 1)
+					 (debug 1) (space 2))
+			       (fixnum a))
+		      (string<= (coerce "e99mo7yAJ6oU4" 'base-string)
+				(coerce "aaABAAbaa" 'base-string)
+				:start1 a))
+		    9)
+	   9))

Index: arith.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/arith.pure.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- arith.pure.lisp	11 Feb 2005 07:32:53 -0000	1.26
+++ arith.pure.lisp	17 Mar 2005 22:51:43 -0000	1.27
@@ -258,3 +258,9 @@
   (test 32 double-float positive)
   (test 32 single-float negative)
   (test 32 single-float positive))
+
+;; x86-64 sign-extension bug found using pfdietz's random tester.
+(assert (= 286142502
+	   (funcall (lambda () 
+		      (declare (notinline logxor)) 
+		      (min (logxor 0 0 0 286142502))))))

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

Modified Files:
	seqtran.lisp 
Log Message:
0.8.20.27:
	Fix x86-64 backend bugs found using Paul Dietz's random tester.
        * Sign-extension in constant LOGAND, + and TRUNCATE VOPs.
        * Sign-extension of literal (unsigned-byte 32) passed as
          arguments on the stack.
        
        Fix handling of :START1 and :START2 in the string comparison
        deftransforms on simple-base-strings (ansi-tests MISC.572/573/574).
        
        Minor cleanup: Use the already defined *cache-expand-threshold*
        instead of magic numbers in pcl/cache.lisp.


Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -d -r1.55 -r1.56
--- seqtran.lisp	2 Nov 2004 08:37:52 -0000	1.55
+++ seqtran.lisp	17 Mar 2005 22:51:31 -0000	1.56
@@ -624,14 +624,16 @@
 ;;; must be SIMPLE-BASE-STRINGs.
 (macrolet ((def (name lessp equalp)
              `(deftransform ,name ((string1 string2 start1 end1 start2 end2)
-                                    (simple-base-string simple-base-string t t t t) *)
+                                   (simple-base-string simple-base-string t t t t) *)
                 `(let* ((end1 (if (not end1) (length string1) end1))
                         (end2 (if (not end2) (length string2) end2))
                         (index (sb!impl::%sp-string-compare
                                 string1 start1 end1 string2 start2 end2)))
                   (if index
-                      (cond ((= index ,(if ',lessp 'end1 'end2)) index)
-                            ((= index ,(if ',lessp 'end2 'end1)) nil)
+                      (cond ((= index end1)
+                             ,(if ',lessp 'index nil))
+                            ((= (+ index (- start2 start1)) end2)
+                             ,(if ',lessp nil 'index))
                             ((,(if ',lessp 'char< 'char>)
                                (schar string1 index)
                                (schar string2
@@ -639,9 +641,9 @@
                                                  (+ index
                                                     (truly-the fixnum
                                                                (- start2
-								  start1))))))
+                                                                  start1))))))
                              index)
-                            (t nil))
+                	    (t nil))
                       ,(if ',equalp 'end1 nil))))))
   (def string<* t nil)
   (def string<=* t t)

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31901/src/pcl

Modified Files:
	cache.lisp 
Log Message:
0.8.20.27:
	Fix x86-64 backend bugs found using Paul Dietz's random tester.
        * Sign-extension in constant LOGAND, + and TRUNCATE VOPs.
        * Sign-extension of literal (unsigned-byte 32) passed as
          arguments on the stack.
        
        Fix handling of :START1 and :START2 in the string comparison
        deftransforms on simple-base-strings (ansi-tests MISC.572/573/574).
        
        Minor cleanup: Use the already defined *cache-expand-threshold*
        instead of magic numbers in pcl/cache.lisp.


Index: cache.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/cache.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- cache.lisp	29 Jun 2004 08:51:01 -0000	1.33
+++ cache.lisp	17 Mar 2005 22:51:45 -0000	1.34
@@ -941,7 +941,7 @@
   (assert wrappers)
 
   (or (fill-cache-p nil cache wrappers value)
-      (and (< (ceiling (* (cache-count cache) 1.25))
+      (and (< (ceiling (* (cache-count cache) *cache-expand-threshold*))
 	      (if (= (cache-nkeys cache) 1)
 		  (1- (cache-nlines cache))
 		  (cache-nlines cache)))

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.20.26:
	Fix MAKE-PACKAGE.ERROR.[34] (PFD ansi-tests, exposed by removal
	of the TOPLEVEL restart)


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.738
retrieving revision 1.739
diff -u -d -r1.738 -r1.739
--- NEWS	14 Mar 2005 17:39:39 -0000	1.738
+++ NEWS	16 Mar 2005 10:21:46 -0000	1.739
@@ -49,6 +49,8 @@
     on x86-64
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.564: defined out-of-line version of %ATAN2 on x86.
+    ** attempting to create a package with a colliding nickname causes
+       correctable errors to be signalled.
 
 changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
   * fixed inspection of specialized arrays. (thanks to Simon Alexander)

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.2045
retrieving revision 1.2046
diff -u -d -r1.2045 -r1.2046
--- version.lisp-expr	16 Mar 2005 10:11:10 -0000	1.2045
+++ version.lisp-expr	16 Mar 2005 10:21:49 -0000	1.2046
@@ -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.20.25"
+"0.8.20.26"

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

Modified Files:
	target-package.lisp 
Log Message:
0.8.20.26:
	Fix MAKE-PACKAGE.ERROR.[34] (PFD ansi-tests, exposed by removal
	of the TOPLEVEL restart)


Index: target-package.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-package.lisp,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -d -r1.31 -r1.32
--- target-package.lisp	9 Dec 2004 15:32:52 -0000	1.31
+++ target-package.lisp	16 Mar 2005 10:21:52 -0000	1.32
@@ -477,15 +477,17 @@
 	     (push n (package-%nicknames package)))
 	    ((eq found package))
 	    ((string= (the string (package-%name found)) n)
-             (error 'simple-package-error
-                    :package package
-                    :format-control "~S is a package name, so it cannot be a nickname for ~S."
-                    :format-arguments (list n (package-%name package))))
+             (cerror "Ignore this nickname."
+		     'simple-package-error
+		     :package package
+		     :format-control "~S is a package name, so it cannot be a nickname for ~S."
+		     :format-arguments (list n (package-%name package))))
 	    (t
-             (error 'simple-package-error
-                    :package package
-                    :format-control "~S is already a nickname for ~S."
-                    :format-arguments (list n (package-%name found))))))))
+             (cerror "Leave this nickname alone."
+		     'simple-package-error
+		     :package package
+		     :format-control "~S is already a nickname for ~S."
+		     :format-arguments (list n (package-%name found))))))))
 
 (defun make-package (name &key
 			  (use '#.*default-package-use-list*)