Steel Bank Common Lisp

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

Modified Files:
	version.lisp-expr 
Log Message:
1.0.6.11: PRINT-OBJECT method adjusted for new caches

 * "Oops" -- missed from the original cache commit.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3434
retrieving revision 1.3435
diff -u -d -r1.3434 -r1.3435
--- version.lisp-expr	1 Jun 2007 03:05:10 -0000	1.3434
+++ version.lisp-expr	1 Jun 2007 17:51:53 -0000	1.3435
@@ -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".)
-"1.0.6.10"
+"1.0.6.11"

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

Modified Files:
	cache.lisp print-object.lisp 
Log Message:
1.0.6.11: PRINT-OBJECT method adjusted for new caches

 * "Oops" -- missed from the original cache commit.


Index: cache.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/cache.lisp,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -d -r1.51 -r1.52
--- cache.lisp	28 May 2007 18:52:26 -0000	1.51
+++ cache.lisp	1 Jun 2007 17:51:54 -0000	1.52
@@ -93,6 +93,17 @@
 (defun power-of-two-ceiling (x)
   (ash 1 (integer-length (1- x))))
 
+(defun cache-statistics (cache)
+  (let* ((vector (cache-vector cache))
+         (size (length vector))
+         (line-size (cache-line-size cache))
+         (total-lines (/ size line-size))
+         (free-lines (loop for i from 0 by line-size below size
+                           unless (eq (svref vector i) '..empty..)
+                           count t)))
+    (values (- total-lines free-lines) total-lines
+            (cache-depth cache) (cache-limit cache))))
+
 ;;; Don't allocate insanely huge caches.
 (defconstant +cache-vector-max-length+ (expt 2 14))
 

Index: print-object.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/print-object.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- print-object.lisp	13 Feb 2006 15:59:16 -0000	1.10
+++ print-object.lisp	1 Jun 2007 17:51:54 -0000	1.11
@@ -124,11 +124,17 @@
 
 (defmethod print-object ((cache cache) stream)
   (print-unreadable-object (cache stream :type t :identity t)
-    (format stream
-            "~W ~S ~W"
-            (cache-nkeys cache)
-            (cache-valuep cache)
-            (cache-nlines cache))))
+    (multiple-value-bind (lines-used lines-total max-depth depth-limit)
+        (cache-statistics cache)
+      (format stream
+              "~D key, ~P~:[no value~;value~], ~D/~D lines, depth ~D/~D"
+              (cache-key-count cache)
+              (cache-key-count cache)
+              (cache-value cache)
+              lines-used
+              lines-total
+              max-depth
+              depth-limit))))
 
 (defmethod print-object ((wrapper wrapper) stream)
   (print-unreadable-object (wrapper stream :type t :identity t)

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

Modified Files:
	version.lisp-expr make.sh 
Log Message:
1.0.6.10: put --disable-debugger back where it belongs

	* it was accidentally deleted in a previous commit.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3433
retrieving revision 1.3434
diff -u -d -r1.3433 -r1.3434
--- version.lisp-expr	1 Jun 2007 03:02:11 -0000	1.3433
+++ version.lisp-expr	1 Jun 2007 03:05:10 -0000	1.3434
@@ -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".)
-"1.0.6.9"
+"1.0.6.10"

Index: make.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/make.sh,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -d -r1.49 -r1.50
--- make.sh	19 May 2007 02:14:05 -0000	1.49
+++ make.sh	1 Jun 2007 03:05:10 -0000	1.50
@@ -65,7 +65,7 @@
 else
     DEVNULL=/dev/null
 fi
-SBCL_XC_HOST="${1:-sbcl --userinit $DEVNULL --sysinit $DEVNULL}"
+SBCL_XC_HOST="${1:-sbcl --disable-debugger --userinit $DEVNULL --sysinit $DEVNULL}"
 export DEVNULL
 export SBCL_XC_HOST
 echo //SBCL_XC_HOST=\"$SBCL_XC_HOST\"

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

Modified Files:
	reader.lisp 
Log Message:
1.0.6.9: micro-optimize portions of the reader

	* use the more idiomatic (and better optimized) MAKE-ARRAY/REPLACE
	  combination to grow the read buffer;
	* host some special variable accesses and eliminate bounds checking
	  in CASIFY-READ-BUFFER.


Index: reader.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -d -r1.48 -r1.49
--- reader.lisp	5 Apr 2006 07:08:40 -0000	1.48
+++ reader.lisp	1 Jun 2007 03:02:12 -0000	1.49
@@ -401,12 +401,11 @@
      (setq *ouch-ptr* (1- (the fixnum *ouch-ptr*)))))
 
 (defun grow-read-buffer ()
-  (let ((rbl (length (the simple-string *read-buffer*))))
-    (setq *read-buffer*
-          (concatenate 'simple-string
-                       *read-buffer*
-                       (make-string rbl)))
-    (setq *read-buffer-length* (* 2 rbl))))
+  (let* ((rbl (length *read-buffer*))
+         (new-length (* 2 rbl))
+         (new-buffer (make-string new-length)))
+    (setq *read-buffer* (replace new-buffer *read-buffer*))
+    (setq *read-buffer-length* new-length)))
 
 (defun inchpeek-read-buffer ()
   (if (>= (the fixnum *inch-ptr*) (the fixnum *ouch-ptr*))
@@ -776,16 +775,20 @@
   (let ((case (readtable-case *readtable*)))
     (cond
      ((and (null escapes) (eq case :upcase))
-      (dotimes (i *ouch-ptr*)
-        (setf (schar *read-buffer* i)
-              (char-upcase (schar *read-buffer* i)))))
+      ;; Pull the special variable access out of the loop.
+      (let ((buffer *read-buffer*))
+        (dotimes (i *ouch-ptr*)
+          (declare (optimize (sb!c::insert-array-bounds-checks 0)))
+          (setf (schar buffer i) (char-upcase (schar buffer i))))))
      ((eq case :preserve))
      (t
       (macrolet ((skip-esc (&body body)
                    `(do ((i (1- *ouch-ptr*) (1- i))
+                         (buffer *read-buffer*)
                          (escapes escapes))
                         ((minusp i))
-                      (declare (fixnum i))
+                      (declare (fixnum i)
+                               (optimize (sb!c::insert-array-bounds-checks 0)))
                       (when (or (null escapes)
                                 (let ((esc (first escapes)))
                                   (declare (fixnum esc))
@@ -794,12 +797,12 @@
                                          (aver (= esc i))
                                          (pop escapes)
                                          nil))))
-                        (let ((ch (schar *read-buffer* i)))
+                        (let ((ch (schar buffer i)))
                           ,@body)))))
         (flet ((lower-em ()
-                 (skip-esc (setf (schar *read-buffer* i) (char-downcase ch))))
+                 (skip-esc (setf (schar buffer i) (char-downcase ch))))
                (raise-em ()
-                 (skip-esc (setf (schar *read-buffer* i) (char-upcase ch)))))
+                 (skip-esc (setf (schar buffer i) (char-upcase ch)))))
           (ecase case
             (:upcase (raise-em))
             (:downcase (lower-em))

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

Modified Files:
	version.lisp-expr 
Log Message:
1.0.6.9: micro-optimize portions of the reader

	* use the more idiomatic (and better optimized) MAKE-ARRAY/REPLACE
	  combination to grow the read buffer;
	* host some special variable accesses and eliminate bounds checking
	  in CASIFY-READ-BUFFER.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3432
retrieving revision 1.3433
diff -u -d -r1.3432 -r1.3433
--- version.lisp-expr	1 Jun 2007 02:57:48 -0000	1.3432
+++ version.lisp-expr	1 Jun 2007 03:02:11 -0000	1.3433
@@ -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".)
-"1.0.6.8"
+"1.0.6.9"

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

Modified Files:
	version.lisp-expr 
Log Message:
1.0.6.8: improve (SUBSEQ FOO 0 ...) on arrays with elements >= word-size

	* check for a constant-valued start parameter and pass its value
	  through to the loop-generating machinery.  Before we would have
	  compared 'START to 0, which always fails; now we can recognize
	  that case and generate better code.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3431
retrieving revision 1.3432
diff -u -d -r1.3431 -r1.3432
--- version.lisp-expr	30 May 2007 13:55:59 -0000	1.3431
+++ version.lisp-expr	1 Jun 2007 02:57:48 -0000	1.3432
@@ -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".)
-"1.0.6.7"
+"1.0.6.8"

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

Modified Files:
	seqtran.lisp 
Log Message:
1.0.6.8: improve (SUBSEQ FOO 0 ...) on arrays with elements >= word-size

	* check for a constant-valued start parameter and pass its value
	  through to the loop-generating machinery.  Before we would have
	  compared 'START to 0, which always fails; now we can recognize
	  that case and generate better code.


Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -d -r1.69 -r1.70
--- seqtran.lisp	29 Apr 2007 14:30:49 -0000	1.69
+++ seqtran.lisp	1 Jun 2007 02:57:49 -0000	1.70
@@ -916,7 +916,10 @@
                       (sb!impl::signal-bounding-indices-bad-error seq start end))))
          (let* ((size (- end start))
                 (result (make-array size :element-type ',element-type)))
-           ,(maybe-expand-copy-loop-inline 'seq 'start 'result 0 'size element-type)
+           ,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start)
+                                                    (lvar-value start)
+                                                    'start)
+                                           'result 0 'size element-type)
            result)))))
 
 (deftransform copy-seq ((seq) ((or (simple-unboxed-array (*)) simple-vector)) *)