0.6.12.2:

	MNA port of DTC VALUES declarations patch
		sbcl-devel/2001-05-04

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 17c2cec..30327e9 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -21,7 +21,7 @@
     (kind (required-argument)
          :type (member :lowtag :fixed :header :vector
                        :string :code :closure :instance))
-    ;; Length if fixed-length, shift amount for element size if :vector.
+    ;; Length if fixed-length, shift amount for element size if :VECTOR.
     (length nil :type (or fixnum null))))
 
 (eval-when (:compile-toplevel :execute)
@@ -352,16 +352,16 @@
     (format t "  ~10:D bytes for ~9:D ~(~A~) object~2:*~P (space total.)~%"
            total-bytes total-objects (car space-total))))
 
+;;; Print information about the heap memory in use. PRINT-SPACES is a
+;;; list of the spaces to print detailed information for.
+;;; COUNT-SPACES is a list of the spaces to scan. For either one, T
+;;; means all spaces (i.e. :STATIC, :DYNAMIC and :READ-ONLY.) If
+;;; PRINT-SUMMARY is true, then summary information will be printed.
+;;; The defaults print only summary information for dynamic space. If
+;;; true, CUTOFF is a fraction of the usage in a report below which
+;;; types will be combined as OTHER.
 (defun memory-usage (&key print-spaces (count-spaces '(:dynamic))
                          (print-summary t) cutoff)
-  #!+sb-doc
-  "Print out information about the heap memory in use. :Print-Spaces is a list
-  of the spaces to print detailed information for. :Count-Spaces is a list of
-  the spaces to scan. For either one, T means all spaces (:Static, :Dyanmic
-  and :Read-Only.)  If :Print-Summary is true, then summary information will be
-  printed. The defaults print only summary information for dynamic space.
-  If true, Cutoff is a fraction of the usage in a report below which types will
-  be combined as OTHER."
   (declare (type (or single-float null) cutoff))
   (let* ((spaces (if (eq count-spaces t)
                     '(:static :dynamic :read-only)
@@ -379,9 +379,8 @@
 
   (values))
 \f
+;;; Print info about how much code and no-ops there are in SPACE.
 (defun count-no-ops (space)
-  #!+sb-doc
-  "Print info about how much code and no-ops there are in Space."
   (declare (type spaces space))
   (let ((code-words 0)
        (no-ops 0)
@@ -474,12 +473,11 @@
            non-descriptor-bytes non-descriptor-headers)
     (values)))
 \f
+;;; Print a breakdown by instance type of all the instances allocated
+;;; in SPACE. If TOP-N is true, print only information for the the
+;;; TOP-N types with largest usage.
 (defun instance-usage (space &key (top-n 15))
   (declare (type spaces space) (type (or fixnum null) top-n))
-  #!+sb-doc
-  "Print a breakdown by instance type of all the instances allocated in
-  Space. If TOP-N is true, print only information for the the TOP-N types with
-  largest usage."
   (format t "~2&~@[Top ~D ~]~(~A~) instance types:~%" top-n space)
   (let ((totals (make-hash-table :test 'eq))
        (total-objects 0)
@@ -593,12 +591,15 @@
                   (return-from print-allocated-objects (values)))
 
                 (unless count
-                  (let ((this-page (* (the (unsigned-byte 32)
-                                           (truncate addr pagesize))
+                  (let ((this-page (* (the (values (unsigned-byte 32) t)
+                                         (truncate addr pagesize))
                                       pagesize)))
                     (declare (type (unsigned-byte 32) this-page))
                     (when (/= this-page last-page)
                       (when (< pages-so-far pages)
+                        ;; FIXME: What is this? (ERROR "Argh..")? or
+                        ;; a warning? or code that can be removed
+                        ;; once the system is stable? or what?
                         (format stream "~2&**** Page ~D, address ~X:~%"
                                 pages-so-far addr))
                       (setq last-page this-page)

diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp
index 9ad0e36..55482c4 100644 (file)
--- a/src/code/serve-event.lisp
+++ b/src/code/serve-event.lisp
@@ -155,7 +155,7 @@
     (real
      (multiple-value-bind (q r) (truncate (coerce timeout 'single-float))
        (declare (type index q) (single-float r))
-       (values q (the index (truncate (* r 1f6))))))
+       (values q (the (values index t) (truncate (* r 1f6))))))
     (t
      (error "Timeout is not a real number or NIL: ~S" timeout))))
 

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 0ef34ff..7a8e09c 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -849,7 +849,7 @@ a host-structure or string."
 (defun substitute-into (pattern subs diddle-case)
   (declare (type pattern pattern)
           (type list subs)
-          (values (or simple-base-string pattern)))
+          (values (or simple-base-string pattern) list))
   (let ((in-wildcard nil)
        (pieces nil)
        (strings nil))

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index d908ea4..627b660 100644 (file)
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -579,7 +579,7 @@
        (values (logxor (the fixnum (1- cache-size)) (the fixnum (1- line-size)))
                cache-size
                line-size
-               (the fixnum (floor cache-size line-size))))
+               (the (values fixnum t) (floor cache-size line-size))))
       (let* ((line-size (power-of-two-ceiling (if valuep (1+ nkeys) nkeys)))
             (cache-size (if (typep nlines-or-cache-vector 'fixnum)
                             (the fixnum
@@ -592,7 +592,7 @@
        (values (logxor (the fixnum (1- cache-size)) (the fixnum (1- line-size)))
                (the fixnum (1+ cache-size))
                line-size
-               (the fixnum (floor cache-size line-size))))))
+               (the (values fixnum t) (floor cache-size line-size))))))
 \f
 ;;; the various implementations of computing a primary cache location from
 ;;; wrappers. Because some implementations of this must run fast there are

diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp
index 2052f38..e30ca28 100644 (file)
--- a/src/pcl/walk.lisp
+++ b/src/pcl/walk.lisp
@@ -137,7 +137,7 @@
     (let ((entry (assoc macro (sb-c::lexenv-functions env) :test #'eq)))
       (and entry
           (eq (cadr entry) 'sb-c::macro)
-          (function-lambda-expression (cddr entry))))))
+          (values (function-lambda-expression (cddr entry)))))))
 
 (defmacro with-new-definition-in-environment
          ((new-env old-env macrolet/flet/labels-form) &body body)

diff --git a/version.lisp-expr b/version.lisp-expr
index 1f4af4f..5a88ec1 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.12.1"
+"0.6.12.2"