(size (primitive-object-size obj)))
(cond
((not lowtag))
+ (;; KLUDGE described in dan_b message "Another one for the
+ ;; collection [bug 108]" (sbcl-devel 2004-01-22)
+ ;;
+ ;; In a freshly started SBCL 0.8.7.20ish, (TIME (ROOM T)) causes
+ ;; debugger invoked on a SB-INT:BUG in thread 5911:
+ ;; failed AVER: "(SAP= CURRENT END)"
+ ;; [WHN: Similar things happened on one but not the other of my
+ ;; machines when I just run ROOM a lot in a loop.]
+ ;;
+ ;; This appears to be due to my [DB] abuse of the primitive
+ ;; object macros to define a thread object that shares a lowtag
+ ;; with fixnums and has no widetag: it looks like the code that
+ ;; generates *META-ROOM-INFO* infers from this that even fixnums
+ ;; are thread-sized - probably undesirable.
+ ;;
+ ;; This [the fix; the EQL NAME 'THREAD clause here] is more in the
+ ;; nature of a workaround than a really good fix. I'm not sure
+ ;; what a really good fix is: I /think/ it's probably to remove
+ ;; the :LOWTAG option in DEFINE-PRIMITIVE-OBJECT THREAD, then teach
+ ;; genesis to generate the necessary OBJECT_SLOT_OFFSET macros
+ ;; for assembly source in the runtime/genesis/*.h files.
+ (eql name 'thread))
((not widetag)
(let ((info (make-room-info :name name
:kind :lowtag))
:kind :fixed
:length size))))))
-(dolist (code (list complex-string-widetag simple-array-widetag
+(dolist (code (list complex-base-string-widetag simple-array-widetag
complex-bit-vector-widetag complex-vector-widetag
- complex-array-widetag))
+ complex-array-widetag complex-vector-nil-widetag))
(setf (svref *meta-room-info* code)
(make-room-info :name 'array-header
:kind :header)))
(simple-vector-widetag . 2)
(simple-array-unsigned-byte-2-widetag . -2)
(simple-array-unsigned-byte-4-widetag . -1)
+ (simple-array-unsigned-byte-7-widetag . 0)
(simple-array-unsigned-byte-8-widetag . 0)
+ (simple-array-unsigned-byte-15-widetag . 1)
(simple-array-unsigned-byte-16-widetag . 1)
+ (simple-array-unsigned-byte-31-widetag . 2)
(simple-array-unsigned-byte-32-widetag . 2)
(simple-array-signed-byte-8-widetag . 0)
(simple-array-signed-byte-16-widetag . 1)
+ (simple-array-unsigned-byte-29-widetag . 2)
(simple-array-signed-byte-30-widetag . 2)
(simple-array-signed-byte-32-widetag . 2)
(simple-array-single-float-widetag . 2)
(simple-array-double-float-widetag . 3)
(simple-array-complex-single-float-widetag . 3)
(simple-array-complex-double-float-widetag . 4)))
- (let ((name (car stuff))
- (size (cdr stuff)))
+ (let* ((name (car stuff))
+ (size (cdr stuff))
+ (sname (string name)))
(setf (svref *meta-room-info* (symbol-value name))
- (make-room-info :name name
+ (make-room-info :name (intern (subseq sname
+ 0
+ (mismatch sname "-WIDETAG"
+ :from-end t)))
:kind :vector
:length size))))
-(setf (svref *meta-room-info* simple-string-widetag)
- (make-room-info :name 'simple-string-widetag
+(setf (svref *meta-room-info* simple-base-string-widetag)
+ (make-room-info :name 'simple-base-string
:kind :string
:length 0))
+(setf (svref *meta-room-info* simple-array-nil-widetag)
+ (make-room-info :name 'simple-array-nil
+ :kind :fixed
+ :length 2))
+
(setf (svref *meta-room-info* code-header-widetag)
(make-room-info :name 'code
:kind :code))
(values (int-sap read-only-space-start)
(int-sap (* *read-only-space-free-pointer* n-word-bytes))))
(:dynamic
- (values (int-sap dynamic-space-start)
+ (values (int-sap #!+gencgc dynamic-space-start
+ #!-gencgc (current-dynamic-space-start))
(dynamic-space-free-pointer)))))
;;; Return the total number of bytes used in SPACE.
(:fixed
(aver (or (eql (room-info-length info)
(1+ (get-header-data obj)))
- (floatp obj)))
+ (floatp obj)
+ (simple-array-nil-p obj)))
(round-to-dualword
(* (room-info-length info) n-word-bytes)))
((:vector :string)
((#.bignum-widetag
#.single-float-widetag
#.double-float-widetag
- #.simple-string-widetag
+ #.simple-base-string-widetag
+ #.simple-array-nil-widetag
#.simple-bit-vector-widetag
#.simple-array-unsigned-byte-2-widetag
#.simple-array-unsigned-byte-4-widetag
#.complex-widetag
#.simple-array-widetag
#.simple-vector-widetag
- #.complex-string-widetag
+ #.complex-base-string-widetag
+ #.complex-vector-nil-widetag
#.complex-bit-vector-widetag
#.complex-vector-widetag
#.complex-array-widetag
(when (eql type instance-header-widetag)
(incf total-objects)
(incf total-bytes size)
- (let* ((class (layout-class (%instance-ref obj 0)))
- (found (gethash class totals)))
+ (let* ((classoid (layout-classoid (%instance-ref obj 0)))
+ (found (gethash classoid totals)))
(cond (found
(incf (the fixnum (car found)))
(incf (the fixnum (cdr found)) size))
(t
- (setf (gethash class totals) (cons 1 size)))))))
+ (setf (gethash classoid totals) (cons 1 size)))))))
space)
(collect ((totals-list))
- (maphash (lambda (class what)
+ (maphash (lambda (classoid what)
(totals-list (cons (prin1-to-string
- (class-proper-name class))
+ (classoid-proper-name classoid))
what)))
totals)
(let ((sorted (sort (totals-list) #'> :key #'cddr))
projects / sbcl.git / blobdiff