projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.11.6: canonicalize whitespaces only on updated files
[sbcl.git]
/
src
/
code
/
room.lisp
diff --git
a/src/code/room.lisp
b/src/code/room.lisp
index
6102f23
..
5f6d93c
100644
(file)
--- a/
src/code/room.lisp
+++ b/
src/code/room.lisp
@@
-88,8
+88,10
@@
(make-room-info :name 'closure
:kind :closure))
(make-room-info :name 'closure
:kind :closure))
+;; FIXME: This looks rather brittle. Can we get more of these numbers
+;; from somewhere sensible?
(dolist (stuff '((simple-bit-vector-widetag . -3)
(dolist (stuff '((simple-bit-vector-widetag . -3)
- (simple-vector-widetag . 2)
+ (simple-vector-widetag . #.sb!vm:word-shift)
(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-2-widetag . -2)
(simple-array-unsigned-byte-4-widetag . -1)
(simple-array-unsigned-byte-7-widetag . 0)
@@
-179,7
+181,9
@@
(multiple-value-bind (start end) (space-bounds space)
(- (sap-int end) (sap-int start))))
(multiple-value-bind (start end) (space-bounds space)
(- (sap-int end) (sap-int start))))
-;;; Round SIZE (in bytes) up to the next dualword (eight byte) boundary.
+;;; Round SIZE (in bytes) up to the next dualword boundary. A dualword
+;;; is eight bytes on platforms with 32-bit word size and 16 bytes on
+;;; platforms with 64-bit word size.
#!-sb-fluid (declaim (inline round-to-dualword))
(defun round-to-dualword (size)
(declare (fixnum size))
#!-sb-fluid (declaim (inline round-to-dualword))
(defun round-to-dualword (size)
(declare (fixnum size))
@@
-207,7
+211,14
@@
(define-alien-type (struct page)
(struct page
(start long)
(define-alien-type (struct page)
(struct page
(start long)
- (bytes-used (unsigned 16))
+ ;; On platforms with small enough GC pages, this field
+ ;; will be a short. On platforms with larger ones, it'll
+ ;; be an int.
+ (bytes-used (unsigned
+ #.(if (typep sb!vm:gencgc-page-size
+ '(unsigned-byte 16))
+ 16
+ 32)))
(flags (unsigned 8))
(gen (signed 8))))
(declaim (inline find-page-index))
(flags (unsigned 8))
(gen (signed 8))))
(declaim (inline find-page-index))
@@
-288,13
+299,13
@@
(eq (room-info-kind info) :lowtag))
(let ((size (* cons-size n-word-bytes)))
(funcall fun
(eq (room-info-kind info) :lowtag))
(let ((size (* cons-size n-word-bytes)))
(funcall fun
- (make-lisp-obj (logior (sap-int current)
+ (%make-lisp-obj (logior (sap-int current)
list-pointer-lowtag))
list-pointer-lowtag
size)
(setq current (sap+ current size))))
((eql header-widetag closure-header-widetag)
list-pointer-lowtag))
list-pointer-lowtag
size)
(setq current (sap+ current size))))
((eql header-widetag closure-header-widetag)
- (let* ((obj (make-lisp-obj (logior (sap-int current)
+ (let* ((obj (%make-lisp-obj (logior (sap-int current)
fun-pointer-lowtag)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
fun-pointer-lowtag)))
(size (round-to-dualword
(* (the fixnum (1+ (get-closure-length obj)))
@@
-302,7
+313,7
@@
(funcall fun obj header-widetag size)
(setq current (sap+ current size))))
((eq (room-info-kind info) :instance)
(funcall fun obj header-widetag size)
(setq current (sap+ current size))))
((eq (room-info-kind info) :instance)
- (let* ((obj (make-lisp-obj
+ (let* ((obj (%make-lisp-obj
(logior (sap-int current) instance-pointer-lowtag)))
(size (round-to-dualword
(* (+ (%instance-length obj) 1) n-word-bytes))))
(logior (sap-int current) instance-pointer-lowtag)))
(size (round-to-dualword
(* (+ (%instance-length obj) 1) n-word-bytes))))
@@
-311,7
+322,7
@@
(aver (zerop (logand size lowtag-mask)))
(setq current (sap+ current size))))
(t
(aver (zerop (logand size lowtag-mask)))
(setq current (sap+ current size))))
(t
- (let* ((obj (make-lisp-obj
+ (let* ((obj (%make-lisp-obj
(logior (sap-int current) other-pointer-lowtag)))
(size (ecase (room-info-kind info)
(:fixed
(logior (sap-int current) other-pointer-lowtag)))
(size (ecase (room-info-kind info)
(:fixed
@@
-782,7
+793,8
@@
(when (or (eq (symbol-name obj) object)
(eq (symbol-package obj) object)
(eq (symbol-plist obj) object)
(when (or (eq (symbol-name obj) object)
(eq (symbol-package obj) object)
(eq (symbol-plist obj) object)
- (eq (symbol-value obj) object))
+ (and (boundp obj)
+ (eq (symbol-value obj) object)))
(maybe-call fun obj)))))
space)))
(maybe-call fun obj)))))
space)))