0.8.3.10

	Restore the GC hooks.  *BEFORE-GC-HOOKS* and *AFTER-GC-HOOKS*
	are run with interrupts disabled and all other threads
	paused.  They should take no arguments.  This means that
	finalization works again: three cheers.

	Remove all trace of *GC-NOTIFY-{BEFORE,AFTER,STREAM}* : if you
	want to notify the user that G is being C, use a hook.

	test/threads.impure.lisp contains a new test which is known
	to fail.  Don't feel bad about deleting it

	Fix asdf-install to actually chase dependencies recursively
	instead of just finding the first one then stopping.  Now it
	seems to be able to install Araneida

	Restore inadvertently chopped line to version.lisp-expr

diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp
index 799da0f..7be959d 100644 (file)
--- a/contrib/asdf-install/installer.lisp
+++ b/contrib/asdf-install/installer.lisp
@@ -252,17 +252,24 @@ and doesn't begin with one of the prefixes in *SAFE-URL-PREFIXES*")
                                      do (format t "Installing ~A in ~A,~A~%"
                                                 p source system)
                                      append (install-package source system p)))
-                       (handler-case
-                           (asdf:operate 'asdf:load-op asd)
-                         (asdf:missing-dependency (c)
-                           (format t
-                                   "Downloading package ~A, required by ~A~%"
-                                   (asdf::missing-requires c)
-                                   (asdf:component-name
-                                    (asdf::missing-required-by c)))
-                           (one-iter (list
-                                      (symbol-name
-                                       (asdf::missing-requires c)))))))))
+                       (handler-bind
+                           ((asdf:missing-dependency
+                             (lambda (c) 
+                               (format t
+                                       "Downloading package ~A, required by ~A~%"
+                                       (asdf::missing-requires c)
+                                       (asdf:component-name
+                                        (asdf::missing-required-by c)))
+                               (one-iter (list
+                                          (symbol-name
+                                           (asdf::missing-requires c))))
+                               (invoke-restart 'retry))))
+                         (loop
+                          (multiple-value-bind (ret restart-p)
+                              (with-simple-restart
+                                  (retry "Retry installation")
+                                (asdf:operate 'asdf:load-op asd))
+                            (unless restart-p (return))))))))
             (one-iter packages)))
       (dolist (l *temporary-files*)
-           (when (probe-file l) (delete-file l))))))
+       (when (probe-file l) (delete-file l))))))

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 06f78ba..bc7d9f5 100644 (file)
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -92,8 +92,7 @@
   ;; !UNIX-COLD-INIT. And *TYPE-SYSTEM-INITIALIZED* could be changed to
   ;; *TYPE-SYSTEM-INITIALIZED-WHEN-BOUND* so that it doesn't need to
   ;; be explicitly set in order to be meaningful.
-  (setf *gc-notify-stream* nil
-        *before-gc-hooks* nil
+  (setf *before-gc-hooks* nil
         *after-gc-hooks* nil
        *gc-inhibit* 1
        *need-to-collect-garbage* nil

diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp
index 76a0399..a8071c0 100644 (file)
--- a/src/code/dyncount.lisp
+++ b/src/code/dyncount.lisp
@@ -531,8 +531,7 @@ comments from CMU CL:
             classes)))
         (compared (if compare
                       (compare-stats compensated compare)
-                      compensated))
-        (*gc-notify-stream* nil))
+                      compensated)))
     (multiple-value-bind (total-count total-cost) (cost-summary compensated)
       (multiple-value-bind (compare-total-count compare-total-cost)
          (when compare (cost-summary compare))

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index dcff492..0e60184 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -143,19 +143,14 @@ and submit it as a patch."
 (defvar *before-gc-hooks* nil ; actually initialized in cold init
   #!+sb-doc
   "A list of functions that are called before garbage collection occurs.
-  The functions should take no arguments.")
+  The functions are run with interrupts disabled and all other threads
+  paused.  They should take no arguments.")
 
 (defvar *after-gc-hooks* nil ; actually initialized in cold init
   #!+sb-doc
   "A list of functions that are called after garbage collection occurs.
-  The functions should take no arguments.")
-
-(defvar *gc-notify-stream* nil ; (actually initialized in cold init)
-  #!+sb-doc
-  "When non-NIL, this must be a STREAM; and the functions bound to
-  *GC-NOTIFY-BEFORE* and *GC-NOTIFY-AFTER* are called with the
-  STREAM value before and after a garbage collection occurs
-  respectively.")
+  The functions are run with interrupts disabled and all other threads
+  paused.  They should take no arguments.")
 
 (defvar *gc-run-time* 0
   #!+sb-doc
@@ -249,12 +244,14 @@ and submit it as a patch."
       (let ((*already-in-gc* t))
        (without-interrupts
         (gc-stop-the-world)
-        ;; XXX run before-gc-hooks
+        (dolist (h *before-gc-hooks*)
+          (carefully-funcall h))
         (collect-garbage gen)
         (incf *n-bytes-freed-or-purified*
               (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
         (setf *need-to-collect-garbage* nil)
-        ;; XXX run after-gc-hooks
+        (dolist (h *after-gc-hooks*)
+          (carefully-funcall h))
         (gc-start-the-world)))
       (scrub-control-stack)))
   (values))

diff --git a/src/code/globals.lisp b/src/code/globals.lisp
index 1306822..3fa2a75 100644 (file)
--- a/src/code/globals.lisp
+++ b/src/code/globals.lisp
@@ -26,7 +26,6 @@
                  *software-interrupt-vector* *load-verbose*
                  *load-print-stuff* *in-compilation-unit*
                  *aborted-compilation-unit-count* *char-name-alist*
-                 *gc-notify-before* *gc-notify-after*
                  *posix-argv*))
 
 (declaim (ftype (function * *)

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 3f53594..2f17bcf 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -26,7 +26,6 @@
 
 ;;; FIXME: These could be converted to DEFVARs.
 (declaim (special *gc-inhibit* *need-to-collect-garbage*
-                 *gc-notify-stream*
                  *before-gc-hooks* *after-gc-hooks*
                  #!+x86 *pseudo-atomic-atomic*
                  #!+x86 *pseudo-atomic-interrupted*

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 18a3376..8d00ae7 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -121,7 +121,8 @@
                 (lambda ()
                   (with-mutex (lock)
                     (assert (eql (mutex-value lock) (current-thread-id))))
-                  (assert (not (eql (mutex-value lock) (current-thread-id)))))))
+                  (assert (not (eql (mutex-value lock) (current-thread-id))))
+                  (sleep 60))))
     ;;hold onto lock for long enough that child can't get it immediately
     (sleep 20)
     (interrupt-thread child (lambda () (format t "l ~A~%" (mutex-value lock))))
@@ -131,7 +132,7 @@
 (defun alloc-stuff () (copy-list '(1 2 3 4 5)))
 (let ((c (test-interrupt (lambda () (loop (alloc-stuff))))))
   ;; NB this only works on x86
-  (dotimes (i 70)
+  (loop
     (sleep (random 1d0))
     (interrupt-thread c
                      (lambda ()
@@ -152,4 +153,4 @@
 ;; overall exit status is 0, not 104
 (sleep 2) 
 
-(sb-ext:quit :unix-status 104)
+;(sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 823b0d5..e7129a4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -16,4 +16,5 @@
 ;;; with something arbitrary in the fourth field, is used for CVS
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
-"0.8.3.9"
+;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
+"0.8.3.10"