From e29e89b56564b0d302f0ded969a298b948722add Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 28 Aug 2003 15:32:28 +0000 Subject: [PATCH] 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 --- contrib/asdf-install/installer.lisp | 31 +++++++++++++++++++------------ src/code/cold-init.lisp | 3 +-- src/code/dyncount.lisp | 3 +-- src/code/gc.lisp | 19 ++++++++----------- src/code/globals.lisp | 1 - src/code/toplevel.lisp | 1 - tests/threads.impure.lisp | 7 ++++--- version.lisp-expr | 3 ++- 8 files changed, 35 insertions(+), 33 deletions(-) diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp index 799da0f..7be959d 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4