(eval-when (:compile-toplevel :load-toplevel :execute)
(def!struct (room-info (:make-load-form-fun just-dump-it-normally))
- ;; The name of this type.
+ ;; the name of this type
(name nil :type symbol)
- ;; Kind of type (how we determine length).
- (kind (required-argument)
+ ;; kind of type (how we determine length)
+ (kind (missing-arg)
: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)
(defvar *meta-room-info* (make-array 256 :initial-element nil))
(dolist (obj *primitive-objects*)
- (let ((header (primitive-object-header obj))
+ (let ((widetag (primitive-object-widetag obj))
(lowtag (primitive-object-lowtag obj))
(name (primitive-object-name obj))
- (variable (primitive-object-variable-length obj))
+ (variable (primitive-object-var-length obj))
(size (primitive-object-size obj)))
(cond
((not lowtag))
- ((not header)
+ ((not widetag)
(let ((info (make-room-info :name name
:kind :lowtag))
(lowtag (symbol-value lowtag)))
(setf (svref *meta-room-info* (logior lowtag (ash i 3))) info))))
(variable)
(t
- (setf (svref *meta-room-info* (symbol-value header))
+ (setf (svref *meta-room-info* (symbol-value widetag))
(make-room-info :name name
:kind :fixed
:length size))))))
(ecase space
(:static
(values (int-sap static-space-start)
- (int-sap (* *static-space-free-pointer* word-bytes))))
+ (int-sap (* *static-space-free-pointer* n-word-bytes))))
(:read-only
(values (int-sap read-only-space-start)
- (int-sap (* *read-only-space-free-pointer* word-bytes))))
+ (int-sap (* *read-only-space-free-pointer* n-word-bytes))))
(:dynamic
(values (int-sap dynamic-space-start)
(dynamic-space-free-pointer)))))
(:string 1)))))
(declare (type (integer -3 3) shift))
(round-to-dualword
- (+ (* vector-data-offset word-bytes)
+ (+ (* vector-data-offset n-word-bytes)
(the fixnum
(if (minusp shift)
(ash (the fixnum
(cond
((or (not info)
(eq (room-info-kind info) :lowtag))
- (let ((size (* cons-size word-bytes)))
+ (let ((size (* cons-size n-word-bytes)))
(funcall fun
(make-lisp-obj (logior (sap-int current)
list-pointer-lowtag))
fun-pointer-lowtag)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
- word-bytes))))
+ n-word-bytes))))
(funcall fun obj header-widetag size)
(setq current (sap+ current size))))
((eq (room-info-kind info) :instance)
(let* ((obj (make-lisp-obj
(logior (sap-int current) instance-pointer-lowtag)))
(size (round-to-dualword
- (* (+ (%instance-length obj) 1) word-bytes))))
+ (* (+ (%instance-length obj) 1) n-word-bytes))))
(declare (fixnum size))
(funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
(1+ (get-header-data obj)))
(floatp obj)))
(round-to-dualword
- (* (room-info-length info) word-bytes)))
+ (* (room-info-length info) n-word-bytes)))
((:vector :string)
(vector-total-size obj info))
(:header
(round-to-dualword
- (* (1+ (get-header-data obj)) word-bytes)))
+ (* (1+ (get-header-data obj)) n-word-bytes)))
(:code
(+ (the fixnum
- (* (get-header-data obj) word-bytes))
+ (* (get-header-data obj) n-word-bytes))
(round-to-dualword
(* (the fixnum (%code-code-size obj))
- word-bytes)))))))
+ n-word-bytes)))))))
(declare (fixnum size))
(funcall fun obj header-widetag size)
(aver (zerop (logand size lowtag-mask)))
(%primitive code-instructions obj))))
(incf code-words words)
(dotimes (i words)
- (when (zerop (sap-ref-32 sap (* i sb!vm:word-bytes)))
+ (when (zerop (sap-ref-32 sap (* i n-word-bytes)))
(incf no-ops))))))
space)
(#.code-header-widetag
(let ((inst-words (truly-the fixnum (%code-code-size obj))))
(declare (type fixnum inst-words))
- (incf non-descriptor-bytes (* inst-words word-bytes))
+ (incf non-descriptor-bytes (* inst-words n-word-bytes))
(incf descriptor-words
- (- (truncate size word-bytes) inst-words))))
+ (- (truncate size n-word-bytes) inst-words))))
((#.bignum-widetag
#.single-float-widetag
#.double-float-widetag
#.simple-array-complex-single-float-widetag
#.simple-array-complex-double-float-widetag)
(incf non-descriptor-headers)
- (incf non-descriptor-bytes (- size word-bytes)))
+ (incf non-descriptor-bytes (- size n-word-bytes)))
((#.list-pointer-lowtag
#.instance-pointer-lowtag
#.ratio-widetag
#.sap-widetag
#.weak-pointer-widetag
#.instance-header-widetag)
- (incf descriptor-words (truncate size word-bytes)))
+ (incf descriptor-words (truncate size n-word-bytes)))
(t
- (error "Bogus type: ~D" type))))
+ (error "bogus type: ~D" type))))
space))
(format t "~:D words allocated for descriptor objects.~%"
descriptor-words)
(defun print-allocated-objects (space &key (percent 0) (pages 5)
type larger smaller count
(stream *standard-output*))
- (declare (type (integer 0 99) percent) (type sb!c::index pages)
+ (declare (type (integer 0 99) percent) (type index pages)
(type stream stream) (type spaces space)
- (type (or sb!c::index null) type larger smaller count))
+ (type (or index null) type larger smaller count))
(multiple-value-bind (start-sap end-sap) (space-bounds space)
(let* ((space-start (sap-int start-sap))
(space-end (sap-int end-sap))
(defun list-allocated-objects (space &key type larger smaller count
test)
(declare (type spaces space)
- (type (or sb!c::index null) larger smaller type count)
+ (type (or index null) larger smaller type count)
(type (or function null) test)
(inline map-allocated-objects))
(unless *ignore-after* (setq *ignore-after* (cons 1 2)))
projects / sbcl.git / blobdiff