/[cmucl]/src/code/room.lisp
ViewVC logotype

Diff of /src/code/room.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.32 by rtoy, Tue Apr 13 13:21:52 2004 UTC revision 1.33 by rtoy, Fri Jun 18 17:44:28 2004 UTC
# Line 187  Line 187 
187                           (space-bounds space)                           (space-bounds space)
188        (declare (type system-area-pointer start end))        (declare (type system-area-pointer start end))
189        (declare (optimize (speed 3) (safety 0)))        (declare (optimize (speed 3) (safety 0)))
190        (let ((current start)        (iterate step ((current start))
191              #+nil          (flet ((next (size)
192              (prev nil))                   (let ((c (etypecase size
193          (loop                              (fixnum (sap+ current size))
194                                (memory-size (sap+ current size)))))
195                       (cond ((sap< c end)
196                              (step c))
197                             (t
198                              (assert (sap= c end)))))))
199            (let* ((header (sap-ref-32 current 0))            (let* ((header (sap-ref-32 current 0))
200                   (header-type (logand header #xFF))                   (header-type (logand header #xFF))
201                   (info (svref *room-info* header-type)))                   (info (svref *room-info* header-type)))
# Line 203  Line 208 
208                                                  list-pointer-type))                                                  list-pointer-type))
209                           list-pointer-type                           list-pointer-type
210                           size)                           size)
211                  (setq current (sap+ current size))))                  (next size)))
212               ((eql header-type closure-header-type)               ((eql header-type closure-header-type)
213                (let* ((obj (make-lisp-obj (logior (sap-int current)                (let* ((obj (make-lisp-obj (logior (sap-int current)
214                                                   function-pointer-type)))                                                   function-pointer-type)))
# Line 211  Line 216 
216                              (* (the fixnum (1+ (get-closure-length obj)))                              (* (the fixnum (1+ (get-closure-length obj)))
217                                 word-bytes))))                                 word-bytes))))
218                  (funcall fun obj header-type size)                  (funcall fun obj header-type size)
219                  (setq current (sap+ current size))))                  (next size)))
220               ((eq (room-info-kind info) :instance)               ((eq (room-info-kind info) :instance)
221                (let* ((obj (make-lisp-obj                (let* ((obj (make-lisp-obj
222                             (logior (sap-int current) instance-pointer-type)))                             (logior (sap-int current) instance-pointer-type)))
# Line 224  Line 229 
229                  (when (> size 200000) (break "Implausible size, prev ~S" prev))                  (when (> size 200000) (break "Implausible size, prev ~S" prev))
230                  #+nil                  #+nil
231                  (setq prev current)                  (setq prev current)
232                  (setq current (sap+ current size))))                  (next size)))
233               (t               (t
234                (let* ((obj (make-lisp-obj                (let* ((obj (make-lisp-obj
235                             (logior (sap-int current) other-pointer-type)))                             (logior (sap-int current) other-pointer-type)))
# Line 254  Line 259 
259                    (break "Implausible size, prev ~S" prev))                    (break "Implausible size, prev ~S" prev))
260                  #+nil                  #+nil
261                  (setq prev current)                  (setq prev current)
262                  (setq current (sap+ current size))))))                  (next size))))))
           (unless (sap< current end)  
             (assert (sap= current end))  
             (return)))  
263    
264          #+nil          #+nil
265          prev))))          prev))))

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

  ViewVC Help
Powered by ViewVC 1.1.5