projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.9.13.52: Windows installer tweaks
[sbcl.git]
/
src
/
code
/
gc.lisp
diff --git
a/src/code/gc.lisp
b/src/code/gc.lisp
index
b9d7fb1
..
04562f0
100644
(file)
--- a/
src/code/gc.lisp
+++ b/
src/code/gc.lisp
@@
-49,14
+49,14
@@
(defun control-stack-usage ()
#!-stack-grows-downward-not-upward
(- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
(defun control-stack-usage ()
#!-stack-grows-downward-not-upward
(- (sb!sys:sap-int (sb!c::control-stack-pointer-sap))
- (sb!vm:fixnumize sb!vm:*control-stack-start*))
+ (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-start*)))
#!+stack-grows-downward-not-upward
#!+stack-grows-downward-not-upward
- (- (sb!vm:fixnumize sb!vm:*control-stack-end*)
+ (- (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*control-stack-end*))
(sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
(defun binding-stack-usage ()
(- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
(sb!sys:sap-int (sb!c::control-stack-pointer-sap))))
(defun binding-stack-usage ()
(- (sb!sys:sap-int (sb!c::binding-stack-pointer-sap))
- (sb!vm:fixnumize sb!vm:*binding-stack-start*)))
+ (sb!sys:sap-int (sb!di::descriptor-sap sb!vm:*binding-stack-start*))))
\f
;;;; ROOM
\f
;;;; ROOM
@@
-120,7
+120,9
@@
(defun gc-reinit ()
(gc-on)
(gc)
(defun gc-reinit ()
(gc-on)
(gc)
- (setf *n-bytes-freed-or-purified* 0))
+ (setf *n-bytes-freed-or-purified* 0
+ ;; See comment in interr.lisp
+ *heap-exhausted-error-condition* (make-condition 'heap-exhausted-error)))
(declaim (ftype (function () unsigned-byte) get-bytes-consed))
(defun get-bytes-consed ()
(declaim (ftype (function () unsigned-byte) get-bytes-consed))
(defun get-bytes-consed ()
@@
-192,7
+194,10
@@
environment these hooks may run in any thread.")
;; to run as little as possible without them.
(without-interrupts
(gc-stop-the-world)
;; to run as little as possible without them.
(without-interrupts
(gc-stop-the-world)
- (collect-garbage gen)
+ (let ((start-time (get-internal-run-time)))
+ (collect-garbage gen)
+ (incf *gc-run-time*
+ (- (get-internal-run-time) start-time)))
(setf *gc-pending* nil
new-usage (dynamic-usage))
(gc-start-the-world))
(setf *gc-pending* nil
new-usage (dynamic-usage))
(gc-start-the-world))
@@
-208,6
+213,9
@@
environment these hooks may run in any thread.")
;; Outside the mutex, these may cause another GC. FIXME: it can
;; potentially exceed maximum interrupt nesting by triggering
;; GCs.
;; Outside the mutex, these may cause another GC. FIXME: it can
;; potentially exceed maximum interrupt nesting by triggering
;; GCs.
+ ;;
+ ;; Can that be avoided by having the finalizers and hooks run only
+ ;; from the outermost SUB-GC?
(run-pending-finalizers)
(dolist (hook *after-gc-hooks*)
(handler-case
(run-pending-finalizers)
(dolist (hook *after-gc-hooks*)
(handler-case
@@
-250,16
+258,20
@@
environment these hooks may run in any thread.")
(sb!alien:unsigned 32))
val))
(sb!alien:unsigned 32))
val))
+(declaim (inline maybe-handle-pending-gc))
+(defun maybe-handle-pending-gc ()
+ (when (and (not *gc-inhibit*)
+ (or #!+sb-thread *stop-for-gc-pending*
+ *gc-pending*))
+ (sb!unix::receive-pending-interrupt)))
+
;;; These work both regardless of whether we're inside WITHOUT-GCING
;;; or not.
(defun gc-on ()
#!+sb-doc
"Enable the garbage collector."
(setq *gc-inhibit* nil)
;;; These work both regardless of whether we're inside WITHOUT-GCING
;;; or not.
(defun gc-on ()
#!+sb-doc
"Enable the garbage collector."
(setq *gc-inhibit* nil)
- (when (and (not *gc-inhibit*)
- (or #!+sb-thread *stop-for-gc-pending*
- *gc-pending*))
- (sb!unix::receive-pending-interrupt))
+ (maybe-handle-pending-gc)
nil)
(defun gc-off ()
nil)
(defun gc-off ()