X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Froom.lisp;h=ec6888e608e7fa3f75ce9c95ec91f2c6dd3185d8;hb=cc27e35fc73e6765679d6f426ee144abdfac7c27;hp=87770c1c0551f0dfac6dd5b1020cfe501d80e7e7;hpb=ede711efb19b4a79e50cd577653d69bbdea84646;p=sbcl.git diff --git a/src/code/room.lisp b/src/code/room.lisp index 87770c1..ec6888e 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -10,6 +10,9 @@ ;;;; files for more information. (in-package "SB!VM") + +(declaim (special sb!vm:*read-only-space-free-pointer* + sb!vm:*static-space-free-pointer*)) ;;;; type format database @@ -214,7 +217,7 @@ ;; will be a short. On platforms with larger ones, it'll ;; be an int. (bytes-used (unsigned - #.(if (typep sb!vm:gencgc-page-size + #.(if (typep sb!vm:gencgc-page-bytes '(unsigned-byte 16)) 16 32))) @@ -237,6 +240,9 @@ (if careful (make-lisp-obj tagged-address nil) (values (%make-lisp-obj tagged-address) t)))) + ;; Inlining MAKE-OBJ reduces consing on platforms where dynamic + ;; space extends past fixnum range. + (declare (inline make-obj)) (without-gcing (multiple-value-bind (start end) (space-bounds space) (declare (type system-area-pointer start end)) @@ -259,7 +265,7 @@ (maybe-skip-page () #!+gencgc (when (eq space :dynamic) - (loop with page-mask = #.(1- sb!vm:gencgc-page-size) + (loop with page-mask = #.(1- sb!vm:gencgc-page-bytes) for addr of-type sb!vm:word = (sap-int current) while (>= addr skip-tests-until-addr) do @@ -291,7 +297,7 @@ (return-from maybe-skip-page)) ;; Move CURRENT to start of next page. (setf current (int-sap (+ (logandc2 addr page-mask) - sb!vm:gencgc-page-size))) + sb!vm:gencgc-page-bytes))) (maybe-finish-mapping)))))) (maybe-map (obj obj-tag n-obj-bytes &optional (ok t)) (let ((next (typecase n-obj-bytes @@ -518,8 +524,7 @@ (lambda (obj type size) (when (eql type code-header-widetag) (let ((words (truly-the fixnum (%code-code-size obj))) - (sap (truly-the system-area-pointer - (%primitive code-instructions obj))) + (sap (%primitive code-instructions obj)) (size size)) (declare (fixnum size)) (incf total-bytes size) @@ -779,6 +784,26 @@ space) res))) +;;; Calls FUNCTION with all object that have (possibly conservative) +;;; references to them on current stack. +(defun map-stack-references (function) + (let ((end + (sb!di::descriptor-sap + #!+stack-grows-downward-not-upward *control-stack-end* + #!-stack-grows-downward-not-upward *control-stack-start*)) + (sp (current-sp)) + (seen nil)) + (loop until #!+stack-grows-downward-not-upward (sap> sp end) + #!-stack-grows-downward-not-upward (sap< sp end) + do (multiple-value-bind (obj ok) (make-lisp-obj (sap-ref-word sp 0) nil) + (when (and ok (typep obj '(not (or fixnum character)))) + (unless (member obj seen :test #'eq) + (funcall function obj) + (push obj seen)))) + (setf sp + #!+stack-grows-downward-not-upward (sap+ sp n-word-bytes) + #!-stack-grows-downward-not-upward (sap+ sp (- n-word-bytes)))))) + (defun map-referencing-objects (fun space object) (declare (type spaces space) (inline map-allocated-objects)) (unless *ignore-after*