X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Froom.lisp;h=8331d71877876f3768154d89a367f79ba7130369;hb=26ac616b6783b8841ccda8b4f1caa7d898d91b86;hp=4f81df1d0bee13f2aaa92bb414d090cb60fde512;hpb=8b88c2076197247908a5035df1ebbf833c554383;p=sbcl.git

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 4f81df1..8331d71 100644
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -129,6 +129,10 @@
       (make-room-info :name 'instance
                       :kind :instance))
 
+(setf (svref *meta-room-info* funcallable-instance-header-widetag)
+      (make-room-info :name 'funcallable-instance
+                      :kind :closure))
+
 ) ; EVAL-WHEN
 
 (defparameter *room-info* '#.*meta-room-info*)
@@ -188,7 +192,7 @@
 (progn
   (define-alien-type (struct page)
       (struct page
-              (start long)
+              (start signed)
               ;; On platforms with small enough GC pages, this field
               ;; will be a short. On platforms with larger ones, it'll
               ;; be an int.
@@ -200,7 +204,7 @@
               (flags (unsigned 8))
               (gen (signed 8))))
   (declaim (inline find-page-index))
-  (define-alien-routine "find_page_index" long (index long))
+  (define-alien-routine "find_page_index" long (index signed))
   (define-alien-variable "page_table" (* (struct page))))
 
 ;;; Iterate over all the objects allocated in SPACE, calling FUN with
@@ -212,6 +216,7 @@
 #!-sb-fluid (declaim (maybe-inline map-allocated-objects))
 (defun map-allocated-objects (fun space &optional careful)
   (declare (type function fun) (type spaces space))
+  (declare (optimize (sb!c:alien-funcall-saves-fp-and-pc 0)))
   (flet ((make-obj (tagged-address)
            (if careful
                (make-lisp-obj tagged-address nil)
@@ -303,7 +308,7 @@
                                 list-pointer-lowtag
                                 (* cons-size n-word-bytes)
                                 ok)))
-                  ((eql header-widetag closure-header-widetag)
+                  ((eq (room-info-kind info) :closure)
                    (let* ((obj (%make-lisp-obj (logior (sap-int current)
                                                        fun-pointer-lowtag)))
                           (size (round-to-dualword