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 (file)
--- 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 (file)
--- 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)
 \f
 ;;;; initialization stuff

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index aba0098..558eac1 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -11,14 +11,26 @@
 
 (in-package "SB!IMPL")
 \f
+
+#!-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))))
+
 \f
 ;;; 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 (file)
--- 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"