From: Daniel Barlow Date: Tue, 25 Mar 2003 01:49:35 +0000 (+0000) Subject: 0.pre8.4 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d61775ee52828f379eb6acedca421d5a55bfa2bd;p=sbcl.git 0.pre8.4 Change *gc-inhibit* into a counter which increments every time without-gcing is called. Now we can call without-gcing recursively or from >1 thread without bad things happening --- diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index e7429a2..eae1527 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -96,7 +96,7 @@ *before-gc-hooks* nil *after-gc-hooks* nil *already-maybe-gcing* t - *gc-inhibit* t + *gc-inhibit* 1 *need-to-collect-garbage* nil sb!unix::*interrupts-enabled* t sb!unix::*interrupt-pending* nil diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 086d683..2389750 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -70,7 +70,7 @@ (format t "Control stack usage is: ~10:D bytes.~%" (control-stack-usage)) (format t "Binding stack usage is: ~10:D bytes.~%" (binding-stack-usage)) (format t "Garbage collection is currently ~:[enabled~;DISABLED~].~%" - *gc-inhibit*)) + (> *gc-inhibit* 0))) (defun room-intermediate-info () (room-minimal-info) @@ -223,7 +223,7 @@ and submit it as a patch." (declaim (type (or index null) *gc-trigger*)) (defvar *gc-trigger* nil) -;;; When non-NIL, inhibits garbage collection. +;;; When >0, inhibits garbage collection. (defvar *gc-inhibit*) ; initialized in cold init ;;; This flag is used to prevent recursive entry into the garbage @@ -300,6 +300,13 @@ function should notify the user that the system has finished GC'ing.") ;;; is not greater than *GC-TRIGGER*. ;;; ;;; For GENCGC all generations < GEN will be GC'ed. + +;;; XXX need (1) some kind of locking to ensure that only one thread +;;; at a time is trying to GC, (2) to look at all these specials and +;;; work out how much of this "do we really need to GC now?" stuff is +;;; actually necessary: I think we actually end up GCing every time we +;;; hit this code + (defun sub-gc (&key force-p (gen 0)) (/show0 "entering SUB-GC") (unless *already-maybe-gcing* @@ -323,7 +330,7 @@ function should notify the user that the system has finished GC'ing.") (when (and *gc-trigger* (> pre-gc-dynamic-usage *gc-trigger*)) (setf *need-to-collect-garbage* t)) (when (or force-p - (and *need-to-collect-garbage* (not *gc-inhibit*))) + (and *need-to-collect-garbage* (zerop *gc-inhibit*))) ;; KLUDGE: Wow, we really mask interrupts all the time we're ;; collecting garbage? That seems like a long time.. -- WHN 19991129 (without-interrupts @@ -452,7 +459,7 @@ function should notify the user that the system has finished GC'ing.") (defun gc-on () #!+sb-doc "Enable the garbage collector." - (setq *gc-inhibit* nil) + (setq *gc-inhibit* 0) (when *need-to-collect-garbage* (sub-gc)) nil) @@ -460,7 +467,7 @@ function should notify the user that the system has finished GC'ing.") (defun gc-off () #!+sb-doc "Disable the garbage collector." - (setq *gc-inhibit* t) + (setq *gc-inhibit* 1) nil) ;;;; initialization stuff diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index aba0098..558eac1 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -11,14 +11,26 @@ (in-package "SB!IMPL") + +#!-sb-thread +(defmacro atomic-incf (symbol-name &optional (delta 1)) + `(incf ,symbol-name ,delta)) + +(defmacro atomic-decf (place &optional (delta 1)) + `(atomic-incf ,place ,(- delta))) + + (defmacro without-gcing (&rest body) #!+sb-doc "Executes the forms in the body without doing a garbage collection." `(unwind-protect - (let ((*gc-inhibit* t)) - ,@body) - (when (and *need-to-collect-garbage* (not *gc-inhibit*)) - (maybe-gc nil)))) + (progn + (atomic-incf *gc-inhibit*) + ,@body) + (atomic-decf *gc-inhibit*) + (when (and *need-to-collect-garbage* (zerop *gc-inhibit*)) + (maybe-gc nil)))) + ;;; EOF-OR-LOSE is a useful macro that handles EOF. (defmacro eof-or-lose (stream eof-error-p eof-value) diff --git a/version.lisp-expr b/version.lisp-expr index e2bec33..70c7f55 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre8.3" +"0.pre8.4"