diff --git a/bootfiles/19f/boot-2009-07.lisp b/bootfiles/19f/boot-2009-07.lisp new file mode 100644 index 0000000000000000000000000000000000000000..d9c292b26e0afad4de49ea68d56b5cf9c84d9e17 --- /dev/null +++ b/bootfiles/19f/boot-2009-07.lisp @@ -0,0 +1,25 @@ +;; Bootstrap shrink-vector changes. (The previous derive-type +;; optimizer for shrink-vector didn't handle union types.) + +(in-package "C") + +(without-package-locks +(defoptimizer (lisp::shrink-vector derive-type) ((vector new-size)) + ;; The result of shrink-vector is another vector of the same type as + ;; the input. If the size is a known constant, we use it, otherwise + ;; just make the dimension unknown. + (let* ((dim (if (constant-continuation-p new-size) + `(,(continuation-value new-size)) + '(*))) + (vector-type (continuation-type vector)) + (results (mapcar #'(lambda (type) + (let* ((new-type (kernel::copy-array-type type))) + (setf (kernel:array-type-dimensions new-type) dim) + new-type)) + (if (typep vector-type 'union-type) + (union-type-types vector-type) + (list vector-type))))) + (if (rest results) + (make-union-type results) + (first results)))) +) diff --git a/code/hash-new.lisp b/code/hash-new.lisp index f5a366f523bbd2856c09d60bf49a1ead7ab271da..524176239690e2991b7a39d5291950e7591f2ef2 100644 --- a/code/hash-new.lisp +++ b/code/hash-new.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.49 2009/06/11 16:03:57 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.50 2009/07/02 21:00:48 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -439,11 +439,11 @@ (setf (hash-table-next-vector table) new-next-vector) (setf (hash-table-hash-vector table) new-hash-vector) ;; Shrink the old vectors to 0 size to help the conservative GC. - (shrink-vector old-kv-vector 0) - (shrink-vector old-index-vector 0) - (shrink-vector old-next-vector 0) + (setf old-kv-vector (shrink-vector old-kv-vector 0)) + (setf old-index-vector (shrink-vector old-index-vector 0)) + (setf old-next-vector (shrink-vector old-next-vector 0)) (when old-hash-vector - (shrink-vector old-hash-vector 0)) + (setf old-hash-vector (shrink-vector old-hash-vector 0))) (setf (hash-table-rehash-trigger table) new-size)) (undefined-value)) @@ -824,11 +824,11 @@ (setf (hash-table-next-vector hash-table) new-next-vector) (setf (hash-table-hash-vector hash-table) new-hash-vector) ;; Shrink the old vectors to 0 size to help the conservative GC. - (shrink-vector old-kv-vector 0) - (shrink-vector old-index-vector 0) - (shrink-vector old-next-vector 0) + (setf old-kv-vector (shrink-vector old-kv-vector 0)) + (setf old-index-vector (shrink-vector old-index-vector 0)) + (setf old-next-vector (shrink-vector old-next-vector 0)) (when old-hash-vector - (shrink-vector old-hash-vector 0))) + (setf old-hash-vector (shrink-vector old-hash-vector 0)))) hash-table) diff --git a/code/seq.lisp b/code/seq.lisp index 668e6d1c85c6cd504b46727cdd7e65bf985d1300..e5c69ad39e833786cedab5d508fe70bb18d91197 100644 --- a/code/seq.lisp +++ b/code/seq.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.54 2009/06/11 16:03:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.55 2009/07/02 21:00:48 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -1698,8 +1698,7 @@ (do ((index index (1+ index)) ; copy the rest of the vector (jndex jndex (1+ jndex))) ((= index length) - (shrink-vector vector jndex) - vector) + (shrink-vector vector jndex)) (setf (aref vector jndex) (aref vector index)))) (declare (fixnum index jndex)) (setf (aref vector jndex) (aref vector index)) diff --git a/code/unidata.lisp b/code/unidata.lisp index b261d25786abd8144c0e942cda1f75fc026cfe7f..1863bfa7d677c5448ec964f5287791fe56a410b5 100644 --- a/code/unidata.lisp +++ b/code/unidata.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.3 2009/06/16 17:23:15 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.4 2009/07/02 21:00:48 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -942,14 +942,13 @@ (defun %unicode-full-case (code data default) (let* ((n (qref32 data code))) (if (= n 0) - (let ((s (make-string 2))) - (multiple-value-bind (hi lo) - (surrogates (funcall default code)) + (multiple-value-bind (hi lo) + (surrogates (funcall default code)) + (let ((s (make-string (if lo 2 1)))) (setf (schar s 0) hi) - (if lo - (setf (schar s 1) lo) - (shrink-vector s 1))) - s) + (when lo + (setf (schar s 1) lo)) + s)) (let ((off (logand n #xffff)) (len (ldb (byte 6 16) n))) (subseq (full-case-tabl data) off (+ off len)))))) diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index a994d52c7b82b96d5af9b90b415732af7d436f9e..44b8c282a1d44ef7444bd8e301a6ad629aa9f551 100644 --- a/compiler/fndb.lisp +++ b/compiler/fndb.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.137 2009/06/11 16:03:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.138 2009/07/02 21:00:48 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1251,7 +1251,9 @@ (foldable flushable)) (defknown %set-symbol-package (symbol t) t (unsafe)) (defknown %coerce-to-function (t) function (flushable)) -(defknown lisp::shrink-vector (vector fixnum) vector (unsafe)) +(defknown lisp::shrink-vector (vector fixnum) vector + (unsafe) + :result-not-used #'function-result-not-used-p) ;;; Structure slot accessors or setters are magically "known" to be these ;;; functions, although the var remains the Slot-Accessor describing the actual diff --git a/compiler/seqtran.lisp b/compiler/seqtran.lisp index 26d6d12bbc91ed94aa57b62fdb581ec738a1bb84..18e169d714a93241d26e560d99c6bf99cde24cf6 100644 --- a/compiler/seqtran.lisp +++ b/compiler/seqtran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.32 2009/06/11 16:03:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.33 2009/07/02 21:00:48 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -666,11 +666,17 @@ ;; The result of shrink-vector is another vector of the same type as ;; the input. If the size is a known constant, we use it, otherwise ;; just make the dimension unknown. - (let* ((type (continuation-type vector)) - (dim (if (constant-continuation-p new-size) + (let* ((dim (if (constant-continuation-p new-size) `(,(continuation-value new-size)) '(*))) - (new-type (kernel::copy-array-type type))) - (setf (kernel:array-type-dimensions new-type) dim) - new-type)) - + (vector-type (continuation-type vector)) + (results (mapcar #'(lambda (type) + (let* ((new-type (kernel::copy-array-type type))) + (setf (kernel:array-type-dimensions new-type) dim) + new-type)) + (if (typep vector-type 'union-type) + (union-type-types vector-type) + (list vector-type))))) + (if (rest results) + (make-union-type results) + (first results)))) diff --git a/tools/build-unidata.lisp b/tools/build-unidata.lisp index 6ac706223788d6dda2df76529a3bc075f5ae57ac..73adbc2f37f5f880559aaf5909eb5c88041650a1 100644 --- a/tools/build-unidata.lisp +++ b/tools/build-unidata.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/build-unidata.lisp,v 1.2 2009/06/11 16:04:02 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/build-unidata.lisp,v 1.3 2009/07/02 21:00:48 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -455,7 +455,7 @@ (write-vector (ntrie1-hvec data) stm :endian-swap :network-order) (write-vector (ntrie1-mvec data) stm :endian-swap :network-order) (write-vector (ntrie1-lvec data) stm :endian-swap :network-order)) - (updavte-index (val array) + (update-index (val array) (let ((result (vector-push val array))) (unless result (error "Index array too short for the data being written"))))) @@ -707,8 +707,8 @@ (bool mirror) (str name1) (str comment) (chr upper) (chr lower) (chr title))) (incf pos)))) - (lisp::shrink-vector vec pos) - (lisp::shrink-vector range rpos) + (setf vec (lisp::shrink-vector vec pos)) + (setf range (lisp::shrink-vector range rpos)) (flet ((find-ucd (key) (let ((index (gethash key vec-hash))) (if index