From: William Harold Newman Date: Mon, 7 May 2001 01:37:00 +0000 (+0000) Subject: 0.6.12.2: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=cb7837b769ce190baec60a2159c33099816ea6e3;p=sbcl.git 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 --- 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)) +;;; 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))) +;;; 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 --- 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 --- 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 --- 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)))))) ;;; 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 --- 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 --- 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"