0.8.1.50

	Alpha fixes before 0.8.2
	... correct type declaration for FOREIGN-SYMBOL-ADDRESS-AS-INTEGER
   	    (add N-MACHINE-WORD-BITS to all backends for this purpose)

        ... correct argument order in the depths of DATA-VECTOR-SET-C/
	    (DEF-SMALL-DATA-VECTOR-FROBS), so Alpha now passes bit
	    array tests

	run-tests.sh now prints the filename of the failing test just
	before stopping, which should save on the effort required to
	misinterpret the backtrace

	delete final full stop from  "  cd tests && sh ./run-tests.sh."
        in make.sh so I can triple-click the line to do exactly that

	commit patch for BASE-CHAR-COMPARE/C that Christophe sent me
	(alpha/char.lisp).  I hope this is what he wanted ...

make.sh

@@ -124,7 +124,7 @@ sh make-target-contrib.sh || exit 1
 echo
 echo The build seems to have finished successfully. If you would like
 echo run more extensive tests on the new SBCL, you can try 
-echo "  cd tests && sh ./run-tests.sh."
+echo "  cd tests && sh ./run-tests.sh"
 echo "(but expect some failures on non-x86 platforms)."
 
 date

package-data-list.lisp-expr

@@ -2086,7 +2086,7 @@ structure representations"
              "WEAK-POINTER-BROKEN-SLOT" "WEAK-POINTER-NEXT-SLOT"
              "WEAK-POINTER-SIZE" "WEAK-POINTER-WIDETAG"
 	     "WEAK-POINTER-VALUE-SLOT"
-             "WORD" "N-WORD-BITS" "N-WORD-BYTES"
+             "WORD" "N-WORD-BITS" "N-WORD-BYTES" "N-MACHINE-WORD-BITS"
 	     "WORD-REG-SC-NUMBER" "WORD-SHIFT"
              "ZERO-SC-NUMBER"))
 

src/code/alpha-vm.lisp

@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!VM")
-
-(defvar *number-of-signals* 64)
-(defvar *bits-per-word* 64)
 
 ;;; See x86-vm.lisp for a description of this.
 (define-alien-type os-context-t (struct os-context-t-struct))

src/code/ppc-vm.lisp

@@ -2,9 +2,6 @@
 ;;;
 (in-package "SB!VM")
 
-(defvar *number-of-signals* 64)
-(defvar *bits-per-word* 32)
-
 (define-alien-type os-context-t (struct os-context-t-struct))
 
 

src/code/target-load.lisp

@@ -280,7 +280,7 @@
   (dolist (symbol *!initial-foreign-symbols*)
     (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
 
-(declaim (ftype (function (string) sb!vm:word)
+(declaim (ftype (function (string) (unsigned-byte #.sb!vm:n-machine-word-bits))
 		foreign-symbol-address-as-integer))
 
 

src/compiler/alpha/array.lisp

@@ -259,11 +259,11 @@
                     (:generator 20
                                 (multiple-value-bind (word extra)
 				    (floor index ,elements-per-word)
-                                  (inst ldl object
+                                  (inst ldl old
                                         (- (* (+ word vector-data-offset)
 					      n-word-bytes)
                                            other-pointer-lowtag)
-                                        old)
+                                        object)
                                   (unless (and (sc-is value immediate)
                                                (= (tn-value value)
 						  ,(1- (ash 1 bits))))

src/compiler/alpha/char.lisp

@@ -127,3 +127,37 @@
 (define-vop (fast-char>/base-char base-char-compare)
   (:translate char>)
   (:variant :gt))
+
+(define-vop (base-char-compare/c)
+  (:args (x :scs (base-char-reg)))
+  (:arg-types base-char (:constant base-char))
+  (:temporary (:scs (non-descriptor-reg)) temp)
+  (:conditional)
+  (:info target not-p y)
+  (:policy :fast-safe)
+  (:note "inline constant comparison")
+  (:variant-vars cond)
+  (:generator 2
+    (ecase cond
+      (:eq (inst cmpeq x (sb!xc:char-code y) temp))
+      (:lt (inst cmplt x (sb!xc:char-code y) temp))
+      (:gt (inst cmple x (sb!xc:char-code y) temp)))
+    (if not-p
+	(if (eq cond :gt)
+	    (inst bne temp target)
+	    (inst beq temp target))
+        (if (eq cond :gt)
+	    (inst beq temp target)
+	    (inst bne temp target)))))
+
+(define-vop (fast-char=/base-char/c base-char-compare/c)
+  (:translate char=)
+  (:variant :eq))
+
+(define-vop (fast-char</base-char/c base-char-compare/c)
+  (:translate char<)
+  (:variant :lt))
+
+(define-vop (fast-char>/base-char/c base-char-compare/c)
+  (:translate char>)
+  (:variant :gt))

src/compiler/alpha/parms.lisp

@@ -15,6 +15,10 @@
   #!+sb-doc
   "Number of bits per word where a word holds one lisp descriptor.")
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 64)
+
 (def!constant n-byte-bits 8
   #!+sb-doc
   "Number of bits per byte where a byte is the smallest addressable object.")

src/compiler/hppa/parms.lisp

@@ -6,6 +6,10 @@
 (def!constant n-word-bits 32
   "Number of bits per word where a word holds one lisp descriptor.")
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 32)
+
 (def!constant n-byte-bits 8
   "Number of bits per byte where a byte is the smallest addressable object.")
 

src/compiler/mips/parms.lisp

@@ -3,6 +3,10 @@
 (def!constant n-word-bits 32
   "Number of bits per word where a word holds one lisp descriptor.")
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 32)
+
 (def!constant n-byte-bits 8
   "Number of bits per byte where a byte is the smallest addressable object.")
 

src/compiler/ppc/parms.lisp

@@ -8,6 +8,10 @@
 (def!constant n-word-bits 32
   "Number of bits per word where a word holds one lisp descriptor.")
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 32)
+
 (def!constant n-byte-bits 8
   "Number of bits per byte where a byte is the smallest addressable object.")
 

src/compiler/sparc/parms.lisp

@@ -16,6 +16,10 @@
   #!+sb-doc
   "Number of bits per word where a word holds one lisp descriptor.")
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 32)
+
 (def!constant n-byte-bits 8
   #!+sb-doc
   "Number of bits per byte where a byte is the smallest addressable object.")

src/compiler/x86/parms.lisp

@@ -27,6 +27,10 @@
 ;;; the number of bits per word, where a word holds one lisp descriptor
 (def!constant n-word-bits 32)
 
+;;; the natural width of a machine word (as seen in e.g. register width,
+;;; address space)
+(def!constant n-machine-word-bits 32)
+
 ;;; the number of bits per byte, where a byte is the smallest
 ;;; addressable object
 (def!constant n-byte-bits 8)

tests/run-tests.sh

@@ -47,7 +47,7 @@ tenfour () {
     if [ $1 = 104 ]; then
 	echo ok
     else
-	echo test failed, expected 104 return code, got $1
+	echo test $2 failed, expected 104 return code, got $1
 	exit 1
     fi
 }
@@ -66,7 +66,7 @@ for f in *.pure.lisp; do
     fi
 done
 echo "  (sb-ext:quit :unix-status 104)) ; Return status=success."
-) | $SBCL ; tenfour $?
+) | $SBCL ; tenfour $? "(pure.lisp files)"
 
 # *.impure.lisp files are Lisp code with side effects (e.g. doing
 # DEFSTRUCT or DEFTYPE or DEFVAR, or messing with the read table).
@@ -77,7 +77,7 @@ echo //running '*.impure.lisp' tests
 for f in *.impure.lisp; do
     if [ -f $f ]; then
         echo //running $f test
-        echo "(load \"$f\")" | $SBCL ; tenfour $?
+        echo "(load \"$f\")" | $SBCL ; tenfour $? $f
     fi
 done
 
@@ -89,7 +89,7 @@ echo //running '*.test.sh' tests
 for f in *.test.sh; do
     if [ -f $f ]; then
 	echo //running $f test
-	sh $f "$SBCL"; tenfour $?
+	sh $f "$SBCL"; tenfour $? $f
     fi
 done
 
@@ -99,7 +99,7 @@ echo //running '*.assertoids' tests
 for f in *.assertoids; do
     if [ -f $f ]; then
 	echo //running $f test
-	echo "(load \"$f\")" | $SBCL --eval '(load "assertoid.lisp")' ; tenfour $?
+	echo "(load \"$f\")" | $SBCL --eval '(load "assertoid.lisp")' ; tenfour $? $f
     fi
 done
 
@@ -112,7 +112,7 @@ for f in *.pure-cload.lisp; do
     # to LOAD them all into the same Lisp.)
     if [ -f $f ]; then
 	echo //running $f test
-	$SBCL <<EOF ; tenfour $?
+	$SBCL <<EOF ; tenfour $? $f
 		(compile-file "$f")
                 (progn
                   (unwind-protect
@@ -130,7 +130,7 @@ echo //running '*.impure-cload.lisp' tests
 for f in *.impure-cload.lisp; do
     if [ -f $f ]; then
 	echo //running $f test
-	$SBCL <<EOF ; tenfour $?
+	$SBCL <<EOF ; tenfour $? $f
 		(compile-file "$f")
                 (progn
                   (unwind-protect

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.1.49"
+"0.8.1.50"