X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Froom.lisp;h=6c8625a1f6d0479af19598ddac4ef9b6765a75f5;hb=5d0643d3b70aade43037e8b7cdf39b7e12f5d3fd;hp=d549fa7378af68372dc7793a8657a0b1907176df;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/code/room.lisp b/src/code/room.lisp index d549fa7..6c8625a 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -80,18 +80,27 @@ (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 + (make-room-info :name 'simple-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)) @@ -123,7 +132,8 @@ (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. @@ -211,7 +221,8 @@ (: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) @@ -489,19 +500,19 @@ (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))