From 47eb330ef0f3b99d24c0e24d897b757f16950c4b Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Thu, 11 Aug 2005 14:44:16 +0000 Subject: [PATCH] 0.9.3.41: gc trigger * implementation changes The *NEED-TO-COLLECT-GARBAGE* special is gone. A similar - but per-thread - special: *GC-PENDING* is here. It is set by both gencgc and cheneygc trigger. In threaded builds SIG_STOP_FOR_GC is no longer deferrable by the normal deferral mechanism and rules. It is only deferred in pseudo atomic sections and when *GC-INHIBIT*. There is another per-thread special for this purpose: *STOP-FOR-GC-PENDING*. Whenever *GC-INHI-BIT* is cleared (either by a GC-ON or when exiting a WITHOUT-GCING) the pending gc or the signal handler is run: (when (and (not *gc-inhibit*) (or #!+sb-thread *stop-for-gc-pending* *gc-pending*)) (sb!unix::receive-pending-interrupt)) On the receiving side interrupt_handle_pending is made clever enough not to run pending handlers whose time has not come (i.e. in a WITHOUT-INTERRUPTS it only does gc and leaves the pending handlers alone). * the bugs fixed ** WITHOUT-INTERRUPTS no longer blocks gc from the current or other threads. ** WITHOUT-GCING on the other hand correctly defers gc, be it automatically triggered or explicitly called, and SIG_STOP_FOR_GC. ** GC-{ON,OFF} now work within WITHOUT-GCING, too ** the gc trigger is more reliable as it does not share the interrupt deferral mechanism, most notably sb-sprof does not make triggering gc any harder --- NEWS | 8 ++ package-data-list.lisp-expr | 7 +- src/code/cold-init.lisp | 5 +- src/code/gc.lisp | 60 +++-------- src/code/globals.lisp | 3 +- src/code/sysmacs.lisp | 28 +++-- src/code/target-signal.lisp | 1 - src/code/target-thread.lisp | 9 +- src/code/toplevel.lisp | 4 +- src/compiler/alpha/parms.lisp | 4 +- src/compiler/hppa/parms.lisp | 3 +- src/compiler/mips/parms.lisp | 3 +- src/compiler/ppc/parms.lisp | 5 +- src/compiler/sparc/parms.lisp | 3 +- src/compiler/x86-64/parms.lisp | 5 +- src/compiler/x86/parms.lisp | 5 +- src/runtime/alloc.c | 17 +-- src/runtime/gencgc.c | 35 ++---- src/runtime/interrupt.c | 234 +++++++++++++++++++++++++++++------------ src/runtime/interrupt.h | 2 + src/runtime/thread.c | 13 ++- tests/gc.impure.lisp | 73 +++++++++++++ version.lisp-expr | 2 +- 23 files changed, 343 insertions(+), 186 deletions(-) create mode 100644 tests/gc.impure.lisp diff --git a/NEWS b/NEWS index 842e83283..c60aeda69 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,9 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3: is disabled. * minor incompatible change: SB-KERNEL:INSTANCE-LAMBDA is deprecated, and will go away in a future revision of SBCL. + * minor incompatible change: GC-ON and GC-OFF are no longer + implemented with a counter, it does not matter how many times gc + is switched on or off * bug fix: discriminating functions for generic function classes with non-standard methods for COMPUTE-APPLICABLE-METHODS no longer make invalid assumptions about method precedence order. (reported @@ -28,12 +31,17 @@ changes in sbcl-0.9.4 relative to sbcl-0.9.3: lists in some cases. This partially fixes bug 384. * flush all standard streams before prompting in the REPL and the debugger. + * bug fix: signal handling and triggering gc do not conflict + directly anymore, in particular a high frequency sb-sprof does + not prevent gc from running * threads ** bug fix: RELEASE-FOREGROUND doesn't choke on session lock if there is only one thread in the session ** bug fix: memory leak for streams created in one thread and written to in another ** bug fix: lockup when compiled with gcc4 + ** bug fix: race that allows the gc to be triggered when gc is + inhibited changes in sbcl-0.9.3 relative to sbcl-0.9.2: * New feature: Experimental support for bivalent streams: streams diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 49d099121..30323fc91 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1064,7 +1064,7 @@ retained, possibly temporariliy, because it might be used internally." ;; lots of stuff which currently uses the SB!KERNEL package which ;; doesn't actually use the type system stuff.) And maybe other ;; possible splits too: - ;; * Pull GC stuff (*GC-INHIBIT*, *NEED-TO-COLLECT-GARBAGE*, etc.) + ;; * Pull GC stuff (*GC-INHIBIT*, *GC-PENDING*, etc.) ;; out into SB-GC. ;; * Pull special case implementations of sequence functions (e.g. ;; %MAP-TO-LIST-ARITY-1 and %FIND-POSITION-IF-NOT) and @@ -1137,8 +1137,9 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%SXHASH-SIMPLE-SUBSTRING" "%TAN" "%TAN-QUICK" "%TANH" "%UNARY-ROUND" "%UNARY-TRUNCATE" "%UNARY-FTRUNCATE" "%WITH-ARRAY-DATA" "%WITH-ARRAY-DATA-MACRO" - "*ALREADY-MAYBE-GCING*" "*CURRENT-LEVEL-IN-PRINT*" - "*EMPTY-TYPE*" "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" + "*CURRENT-LEVEL-IN-PRINT*" + "*EMPTY-TYPE*" "*GC-INHIBIT*" "*GC-PENDING*" + #!+sb-thread"*STOP-FOR-GC-PENDING*" "*CONTROL-STACK-EXHAUSTION-SAP*" "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" "WORD-LOGICAL-AND" "WORD-LOGICAL-ANDC1" diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index 33378df7a..202a479cf 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -93,8 +93,9 @@ ;; *TYPE-SYSTEM-INITIALIZED-WHEN-BOUND* so that it doesn't need to ;; be explicitly set in order to be meaningful. (setf *after-gc-hooks* nil - *gc-inhibit* 1 - *need-to-collect-garbage* nil + *gc-inhibit* t + *gc-pending* nil + #!+sb-thread *stop-for-gc-pending* #!+sb-thread nil sb!unix::*interrupts-enabled* t sb!unix::*interrupt-pending* nil *break-on-signals* nil diff --git a/src/code/gc.lisp b/src/code/gc.lisp index a41dec0a4..b9d7fb1e9 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -70,7 +70,7 @@ (format t "Control and binding stack usage is for the current thread only.~%") (format t "Garbage collection is currently ~:[enabled~;DISABLED~].~%" - (> *gc-inhibit* 0))) + *gc-inhibit*)) (defun room-intermediate-info () (room-minimal-info) @@ -140,37 +140,6 @@ and submit it as a patch." "Called after each garbage collection. In a multithreaded environment these hooks may run in any thread.") -;;;; The following specials are used to control when garbage -;;;; collection occurs. - -;;; When the dynamic usage increases beyond this amount, the system -;;; notes that a garbage collection needs to occur by setting -;;; *NEED-TO-COLLECT-GARBAGE* to T. It starts out as NIL meaning -;;; nobody has figured out what it should be yet. -;;; -;;; FIXME: *GC-TRIGGER* seems to be denominated in bytes, not words. -;;; And limiting it to INDEX is fairly reasonable in order to avoid -;;; bignum arithmetic on every allocation, and to minimize the need -;;; for thought about weird gotchas of the GC-control mechanism itself -;;; consing as it operates. But as of sbcl-0.7.5, 512Mbytes of memory -;;; costs $54.95 at Fry's in Dallas but cheap consumer 64-bit machines -;;; are still over the horizon, so gratuitously limiting our heap size -;;; to FIXNUM bytes seems fairly stupid. It'd be reasonable to -;;; (1) allow arbitrary UNSIGNED-BYTE values of *GC-TRIGGER*, or -;;; (2) redenominate this variable in words instead of bytes, postponing -;;; the problem to heaps which exceed 50% of the machine's address -;;; space, or even -;;; (3) redemoninate this variable in CONS-sized two-word units, -;;; allowing it to cover the entire memory space at the price of -;;; possible loss of clarity. -;;; (And whatever is done, it'd also be good to rename the variable so -;;; that it's clear what unit it's denominated in.) -(declaim (type (or index null) *gc-trigger*)) -(defvar *gc-trigger* nil) - -;;; When T, indicates that a GC should have happened but did not due to -;;; *GC-INHIBIT*. -(defvar *need-to-collect-garbage* nil) ; initialized in cold init ;;;; internal GC @@ -210,11 +179,11 @@ environment these hooks may run in any thread.") (defun sub-gc (&key (gen 0)) (unless (eq sb!thread:*current-thread* (sb!thread::mutex-value *already-in-gc*)) - ;; With gencgc, unless *NEED-TO-COLLECT-GARBAGE* every allocation - ;; in this function triggers another gc, potentially exceeding - ;; maximum interrupt nesting. - (setf *need-to-collect-garbage* t) - (when (zerop *gc-inhibit*) + ;; With gencgc, unless *GC-PENDING* every allocation in this + ;; function triggers another gc, potentially exceeding maximum + ;; interrupt nesting. + (setq *gc-pending* t) + (unless *gc-inhibit* (sb!thread:with-mutex (*already-in-gc*) (let ((old-usage (dynamic-usage)) (new-usage 0)) @@ -224,7 +193,7 @@ environment these hooks may run in any thread.") (without-interrupts (gc-stop-the-world) (collect-garbage gen) - (setf *need-to-collect-garbage* nil + (setf *gc-pending* nil new-usage (dynamic-usage)) (gc-start-the-world)) ;; Interrupts re-enabled, but still inside the mutex. @@ -281,19 +250,20 @@ environment these hooks may run in any thread.") (sb!alien:unsigned 32)) val)) -;;; FIXME: Aren't these utterly wrong if called inside WITHOUT-GCING? -;;; Unless something that works there too can be deviced this fact -;;; should be documented. +;;; 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* 0) - (when *need-to-collect-garbage* - (sub-gc)) + (setq *gc-inhibit* nil) + (when (and (not *gc-inhibit*) + (or #!+sb-thread *stop-for-gc-pending* + *gc-pending*)) + (sb!unix::receive-pending-interrupt)) nil) (defun gc-off () #!+sb-doc "Disable the garbage collector." - (setq *gc-inhibit* 1) + (setq *gc-inhibit* t) nil) diff --git a/src/code/globals.lisp b/src/code/globals.lisp index 6ce764ed3..aac1ab20f 100644 --- a/src/code/globals.lisp +++ b/src/code/globals.lisp @@ -22,7 +22,8 @@ sb!debug:*stack-top-hint* *handler-clusters* *restart-clusters* - *gc-inhibit* *need-to-collect-garbage* + *gc-inhibit* *gc-pending* + #!+sb-thread *stop-for-gc-pending* *software-interrupt-vector* *load-verbose* *load-print-stuff* *in-compilation-unit* *aborted-compilation-unit-count* *char-name-alist* diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index 8110d1b8f..a970eef25 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -19,20 +19,32 @@ (declare (optimize (safety 0) (speed 3))) (sb!vm::locked-symbol-global-value-add ',symbol-name ,delta))) -;;; When >0, inhibits garbage collection. -(declaim (type index *gc-inhibit*)) (defvar *gc-inhibit*) ; initialized in cold init +;;; When the dynamic usage increases beyond this amount, the system +;;; notes that a garbage collection needs to occur by setting +;;; *GC-PENDING* to T. It starts out as NIL meaning nobody has figured +;;; out what it should be yet. +(defvar *gc-pending* nil) + +#!+sb-thread +(defvar *stop-for-gc-pending* nil) + (defmacro without-gcing (&body body) #!+sb-doc - "Executes the forms in the body without doing a garbage collection." + "Executes the forms in the body without doing a garbage +collection. It inhibits both automatically and explicitly triggered +gcs. Finally, upon leaving the BODY if gc is not inhibited it runs the +pending gc. Similarly, if gc is triggered in another thread then it +waits until gc is enabled in this thread." `(unwind-protect - (progn - (atomic-incf/symbol *gc-inhibit*) + (let ((*gc-inhibit* t)) ,@body) - (atomic-incf/symbol *gc-inhibit* -1) - (when (and *need-to-collect-garbage* (zerop *gc-inhibit*)) - (sub-gc)))) + ;; the test is racy, but it can err only on the overeager side + (when (and (not *gc-inhibit*) + (or #!+sb-thread *stop-for-gc-pending* + *gc-pending*)) + (sb!unix::receive-pending-interrupt)))) ;;; EOF-OR-LOSE is a useful macro that handles EOF. diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 0d754e541..2bffedeb1 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -45,7 +45,6 @@ ;;; listing the signals that were masked (sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void) -(sb!alien:define-alien-routine "block_blockable_signals" sb!alien:void) ;;;; C routines that actually do all the work of establishing signal handlers (sb!alien:define-alien-routine ("install_handler" install-handler) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 81e349ea2..e24efa0f7 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -93,6 +93,9 @@ in future versions." system-area-pointer (lisp-fun-address unsigned-long)) + (define-alien-routine "block_deferrable_signals_and_inhibit_gc" + void) + (define-alien-routine reap-dead-thread void (thread-sap system-area-pointer)) @@ -494,9 +497,9 @@ returns the thread exits." (funcall real-function) ;; we're going down, can't handle ;; interrupts sanely anymore - (sb!unix::block-blockable-signals))))) - ;; and remove what can be the last reference to - ;; the thread object + (block-deferrable-signals-and-inhibit-gc))))) + ;; and remove what can be the last reference to the + ;; thread object (handle-thread-exit thread) 0)) (values)))))) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index bcf7a422e..830c1c25a 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -25,9 +25,7 @@ ;;; specials initialized by !COLD-INIT ;;; FIXME: These could be converted to DEFVARs. -(declaim (special *gc-inhibit* *need-to-collect-garbage* - *after-gc-hooks* - #!+(or x86 x86-64) *pseudo-atomic-atomic* +(declaim (special #!+(or x86 x86-64) *pseudo-atomic-atomic* #!+(or x86 x86-64) *pseudo-atomic-interrupted* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index fce7a3fe6..bd2780899 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -199,7 +199,9 @@ ;; interrupt handling *free-interrupt-context-index* sb!unix::*interrupts-enabled* - sb!unix::*interrupt-pending*)) + sb!unix::*interrupt-pending* + *gc-inhibit* + *gc-pending*)) (defparameter *static-funs* '(length diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 1bec81977..4ad2bf1a6 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -143,7 +143,8 @@ *free-interrupt-context-index* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* - )) + *gc-inhibit* + *gc-pending*)) (defparameter *static-funs* '(length diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 0575d5bd4..f6fe72ef7 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -155,7 +155,8 @@ *free-interrupt-context-index* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* - )) + *gc-inhibit* + *gc-pending*)) (defparameter *static-funs* '(sb!kernel:two-arg-+ diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index 19c7a2193..51b9474d4 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -168,9 +168,8 @@ *free-interrupt-context-index* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* - - - )) + *gc-inhibit* + *gc-pending*)) (defparameter *static-funs* '(length diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 59b24cac4..5abe8b83e 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -193,7 +193,8 @@ *free-interrupt-context-index* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* - )) + *gc-inhibit* + *gc-pending*)) (defparameter *static-funs* '(length diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index 7d7e3df60..1a6850428 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -190,6 +190,9 @@ sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* *free-interrupt-context-index* + *gc-inhibit* + #!+sb-thread *stop-for-gc-pending* + *gc-pending* *free-tls-index* @@ -199,8 +202,6 @@ *control-stack-start* *control-stack-end* - *need-to-collect-garbage* - ;; the floating point constants *fp-constant-0d0* *fp-constant-1d0* diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 346b892fc..9fc5366ae 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -296,6 +296,9 @@ sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* *free-interrupt-context-index* + *gc-inhibit* + #!+sb-thread *stop-for-gc-pending* + *gc-pending* *free-tls-index* @@ -305,8 +308,6 @@ *control-stack-start* *control-stack-end* - *need-to-collect-garbage* - ;; the floating point constants *fp-constant-0d0* *fp-constant-1d0* diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index e53b2781d..be7998cc3 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -29,13 +29,6 @@ #include "genesis/bignum.h" #include "genesis/sap.h" -#define GET_FREE_POINTER() dynamic_space_free_pointer -#define SET_FREE_POINTER(new_value) \ - (dynamic_space_free_pointer = (new_value)) -#define GET_GC_TRIGGER() current_auto_gc_trigger -#define SET_GC_TRIGGER(new_value) \ - clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); - #define ALIGNED_SIZE(n) (n+LOWTAG_MASK) & ~LOWTAG_MASK #if defined LISP_FEATURE_GENCGC @@ -59,6 +52,16 @@ pa_alloc(int bytes) } #else + +#define GET_FREE_POINTER() dynamic_space_free_pointer +#define SET_FREE_POINTER(new_value) \ + (dynamic_space_free_pointer = (new_value)) +#define GET_GC_TRIGGER() current_auto_gc_trigger +#define SET_GC_TRIGGER(new_value) \ + clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); + +/* FIXME: this is not pseudo atomic at all, but is called only from + * interrupt safe places like interrupt handlers. MG - 2005-08-09 */ static lispobj * pa_alloc(int bytes) { diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 320afda99..e6ed1e2c0 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -4100,10 +4100,10 @@ gc_initialize_pointers(void) char * alloc(long nbytes) { - struct thread *th=arch_os_get_current_thread(); + struct thread *thread=arch_os_get_current_thread(); struct alloc_region *region= #ifdef LISP_FEATURE_SB_THREAD - th ? &(th->alloc_region) : &boxed_region; + thread ? &(thread->alloc_region) : &boxed_region; #else &boxed_region; #endif @@ -4145,35 +4145,16 @@ alloc(long nbytes) * we should GC in the near future */ if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) { - struct thread *thread=arch_os_get_current_thread(); + gc_assert(fixnum_value(SymbolValue(PSEUDO_ATOMIC_ATOMIC,thread))); /* Don't flood the system with interrupts if the need to gc is * already noted. This can happen for example when SUB-GC * allocates or after a gc triggered in a WITHOUT-GCING. */ - if (SymbolValue(NEED_TO_COLLECT_GARBAGE,thread) == NIL) { + if (SymbolValue(GC_PENDING,thread) == NIL) { /* set things up so that GC happens when we finish the PA - * section. We only do this if there wasn't a pending - * handler already, in case it was a gc. If it wasn't a - * GC, the next allocation will get us back to this point - * anyway, so no harm done - */ - struct interrupt_data *data=th->interrupt_data; - sigset_t new_mask,old_mask; - sigemptyset(&new_mask); - sigaddset_blockable(&new_mask); - thread_sigmask(SIG_BLOCK,&new_mask,&old_mask); - - if(!data->pending_handler) { - if(!maybe_defer_handler(interrupt_maybe_gc_int,data,0,0,0)) - lose("Not in atomic: %d.\n", - SymbolValue(PSEUDO_ATOMIC_ATOMIC,thread)); - /* Leave the signals blocked just as if it was - * deferred the normal way and set the - * pending_mask. */ - sigcopyset(&(data->pending_mask),&old_mask); - SetSymbolValue(NEED_TO_COLLECT_GARBAGE,T,thread); - } else { - thread_sigmask(SIG_SETMASK,&old_mask,0); - } + * section */ + SetSymbolValue(GC_PENDING,T,thread); + if (SymbolValue(GC_INHIBIT,thread) == NIL) + arch_set_pseudo_atomic_interrupted(0); } } new_obj = gc_alloc_with_region(nbytes,0,region,0); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 9a5cb5f00..d71185846 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -75,7 +75,7 @@ static void store_signal_data_for_later (struct interrupt_data *data, os_context_t *context); boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *v_context); -void sigaddset_blockable(sigset_t *s) +void sigaddset_deferrable(sigset_t *s) { sigaddset(s, SIGHUP); sigaddset(s, SIGINT); @@ -95,11 +95,20 @@ void sigaddset_blockable(sigset_t *s) sigaddset(s, SIGUSR1); sigaddset(s, SIGUSR2); #ifdef LISP_FEATURE_SB_THREAD - sigaddset(s, SIG_STOP_FOR_GC); sigaddset(s, SIG_INTERRUPT_THREAD); #endif } +void sigaddset_blockable(sigset_t *s) +{ + sigaddset_deferrable(s); +#ifdef LISP_FEATURE_SB_THREAD + sigaddset(s, SIG_STOP_FOR_GC); +#endif +} + +/* initialized in interrupt_init */ +static sigset_t deferrable_sigset; static sigset_t blockable_sigset; inline static void check_blockables_blocked_or_lose() @@ -148,7 +157,17 @@ void reset_signal_mask () thread_sigmask(SIG_SETMASK,&new,0); } -void block_blockable_signals () +void block_deferrable_signals_and_inhibit_gc () +{ + struct thread *thread=arch_os_get_current_thread(); + sigset_t block; + sigemptyset(&block); + sigaddset_deferrable(&block); + thread_sigmask(SIG_BLOCK, &block, 0); + bind_variable(GC_INHIBIT,T,thread); +} + +static void block_blockable_signals () { sigset_t block; sigemptyset(&block); @@ -328,34 +347,64 @@ interrupt_handle_pending(os_context_t *context) struct interrupt_data *data; check_blockables_blocked_or_lose(); - check_interrupts_enabled_or_lose(context); thread=arch_os_get_current_thread(); data=thread->interrupt_data; - /* Pseudo atomic may trigger several times for a single interrupt, - * and while without-interrupts should not, a false trigger by - * pseudo-atomic may eat a pending handler even from - * without-interrupts. */ - if (data->pending_handler) { - - /* If we're here as the result of a pseudo-atomic as opposed - * to WITHOUT-INTERRUPTS, then INTERRUPT_PENDING is already - * NIL, because maybe_defer_handler sets - * PSEUDO_ATOMIC_INTERRUPTED only if interrupts are enabled.*/ - SetSymbolValue(INTERRUPT_PENDING, NIL,thread); - - /* restore the saved signal mask from the original signal (the - * one that interrupted us during the critical section) into the - * os_context for the signal we're currently in the handler for. - * This should ensure that when we return from the handler the - * blocked signals are unblocked */ - sigcopyset(os_context_sigmask_addr(context), &data->pending_mask); - - sigemptyset(&data->pending_mask); - /* This will break on sparc linux: the deferred handler really wants - * to be called with a void_context */ - run_deferred_handler(data,(void *)context); + if (SymbolValue(GC_INHIBIT,thread)==NIL) { +#ifdef LISP_FEATURE_SB_THREAD + if (SymbolValue(STOP_FOR_GC_PENDING,thread) != NIL) { + /* another thread has already initiated a gc, this attempt + * might as well be cancelled */ + SetSymbolValue(GC_PENDING,NIL,thread); + SetSymbolValue(STOP_FOR_GC_PENDING,NIL,thread); + sig_stop_for_gc_handler(SIG_STOP_FOR_GC,NULL,context); + } else +#endif + if (SymbolValue(GC_PENDING,thread) != NIL) { + /* GC_PENDING is cleared in SUB-GC, or if another thread + * is doing a gc already we will get a SIG_STOP_FOR_GC and + * that will clear it. */ + interrupt_maybe_gc_int(0,NULL,context); + } + check_blockables_blocked_or_lose(); + } + + /* we may be here only to do the gc stuff, if interrupts are + * enabled run the pending handler */ + if (!((SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) || + ( +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + (!foreign_function_call_active) && +#endif + arch_pseudo_atomic_atomic(context)))) { + + /* There may be no pending handler, because it was only a gc + * that had to be executed or because pseudo atomic triggered + * twice for a single interrupt. For the interested reader, + * that may happen if an interrupt hits after the interrupted + * flag is cleared but before pseduo-atomic is set and a + * pseudo atomic is interrupted in that interrupt. */ + if (data->pending_handler) { + + /* If we're here as the result of a pseudo-atomic as opposed + * to WITHOUT-INTERRUPTS, then INTERRUPT_PENDING is already + * NIL, because maybe_defer_handler sets + * PSEUDO_ATOMIC_INTERRUPTED only if interrupts are enabled.*/ + SetSymbolValue(INTERRUPT_PENDING, NIL,thread); + + /* restore the saved signal mask from the original signal (the + * one that interrupted us during the critical section) into the + * os_context for the signal we're currently in the handler for. + * This should ensure that when we return from the handler the + * blocked signals are unblocked */ + sigcopyset(os_context_sigmask_addr(context), &data->pending_mask); + + sigemptyset(&data->pending_mask); + /* This will break on sparc linux: the deferred handler really wants + * to be called with a void_context */ + run_deferred_handler(data,(void *)context); + } } } @@ -471,11 +520,10 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) void run_deferred_handler(struct interrupt_data *data, void *v_context) { - /* The pending_handler may enable interrupts (see - * interrupt_maybe_gc_int) and then another interrupt may hit, - * overwrite interrupt_data, so reset the pending handler before - * calling it. Trust the handler to finish with the siginfo before - * enabling interrupts. */ + /* The pending_handler may enable interrupts and then another + * interrupt may hit, overwrite interrupt_data, so reset the + * pending handler before calling it. Trust the handler to finish + * with the siginfo before enabling interrupts. */ void (*pending_handler) (int, siginfo_t*, void*)=data->pending_handler; data->pending_handler=0; (*pending_handler)(data->pending_signal,&(data->pending_info), v_context); @@ -509,6 +557,12 @@ maybe_defer_handler(void *handler, struct interrupt_data *data, * may succeed even when context is null (gencgc alloc()) */ if ( #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + /* FIXME: this foreign_function_call_active test is dubious at + * best. If a foreign call is made in a pseudo atomic section + * (?) or more likely a pseudo atomic section is in a foreign + * call then an interrupt is executed immediately. Maybe it + * has to do with C code not maintaining pseudo atomic + * properly. MG - 2005-08-10 */ (!foreign_function_call_active) && #endif arch_pseudo_atomic_atomic(context)) { @@ -548,7 +602,7 @@ store_signal_data_for_later (struct interrupt_data *data, void *handler, * signals are added to the mask in the context so that we are * running with blocked signals when the handler returns */ sigcopyset(&(data->pending_mask),os_context_sigmask_addr(context)); - sigaddset_blockable(os_context_sigmask_addr(context)); + sigaddset_deferrable(os_context_sigmask_addr(context)); } } @@ -619,31 +673,42 @@ sig_stop_for_gc_handler(int signal, siginfo_t *info, void *void_context) sigset_t ss; int i; - /* need the context stored so it can have registers scavenged */ - fake_foreign_function_call(context); + if ((arch_pseudo_atomic_atomic(context) || + SymbolValue(GC_INHIBIT,thread) != NIL)) { + SetSymbolValue(STOP_FOR_GC_PENDING,T,thread); + if (SymbolValue(GC_INHIBIT,thread) == NIL) + arch_set_pseudo_atomic_interrupted(context); + FSHOW_SIGNAL((stderr,"thread=%lu sig_stop_for_gc deferred\n", + thread->os_thread)); + } else { + /* need the context stored so it can have registers scavenged */ + fake_foreign_function_call(context); - sigemptyset(&ss); - for(i=1;istate!=STATE_RUNNING) { - lose("sig_stop_for_gc_handler: wrong thread state: %ld\n", - fixnum_value(thread->state)); - } - thread->state=STATE_SUSPENDED; + sigemptyset(&ss); + for(i=1;istate!=STATE_RUNNING) { + lose("sig_stop_for_gc_handler: wrong thread state: %ld\n", + fixnum_value(thread->state)); + } + thread->state=STATE_SUSPENDED; + FSHOW_SIGNAL((stderr,"thread=%lu suspended\n",thread->os_thread)); + + sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC); + sigwaitinfo(&ss,0); + FSHOW_SIGNAL((stderr,"thread=%lu resumed\n",thread->os_thread)); + if(thread->state!=STATE_RUNNING) { + lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n", + fixnum_value(thread->state)); + } - sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC); - sigwaitinfo(&ss,0); - if(thread->state!=STATE_RUNNING) { - lose("sig_stop_for_gc_handler: wrong thread state on wakeup: %ld\n", - fixnum_value(thread->state)); + undo_fake_foreign_function_call(context); } - - undo_fake_foreign_function_call(context); } #endif @@ -907,12 +972,26 @@ interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context) struct interrupt_data *data= th ? th->interrupt_data : global_interrupt_data; - if(!data->pending_handler && !foreign_function_call_active && - gc_trigger_hit(signal, info, context)){ + if(!foreign_function_call_active && gc_trigger_hit(signal, info, context)){ + struct thread *thread=arch_os_get_current_thread(); clear_auto_gc_trigger(); - if(!maybe_defer_handler(interrupt_maybe_gc_int, - data,signal,info,void_context)) - interrupt_maybe_gc_int(signal,info,void_context); + /* Don't flood the system with interrupts if the need to gc is + * already noted. This can happen for example when SUB-GC + * allocates or after a gc triggered in a WITHOUT-GCING. */ + if (SymbolValue(GC_PENDING,thread) == NIL) { + if (SymbolValue(GC_INHIBIT,thread) == NIL) { + if (arch_pseudo_atomic_atomic(context)) { + /* set things up so that GC happens when we finish + * the PA section */ + SetSymbolValue(GC_PENDING,T,thread); + arch_set_pseudo_atomic_interrupted(context); + } else { + interrupt_maybe_gc_int(signal,info,void_context); + } + } else { + SetSymbolValue(GC_PENDING,T,thread); + } + } return 1; } return 0; @@ -925,6 +1004,7 @@ boolean interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context) { os_context_t *context=(os_context_t *) void_context; + struct thread *thread=arch_os_get_current_thread(); check_blockables_blocked_or_lose(); fake_foreign_function_call(context); @@ -938,11 +1018,28 @@ interrupt_maybe_gc_int(int signal, siginfo_t *info, void *void_context) * and signal a storage condition from there. */ - /* restore the signal mask from the interrupted context before - * calling into Lisp */ - if (context) + /* Restore the signal mask from the interrupted context before + * calling into Lisp if interrupts are enabled. Why not always? + * + * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an + * interrupt hits while in SUB-GC, it is deferred and the + * os_context_sigmask of that interrupt is set to block further + * deferrable interrupts (until the first one is + * handled). Unfortunately, that context refers to this place and + * when we return from here the signals will not be blocked. + * + * A kludgy alternative is to propagate the sigmask change to the + * outer context. + */ + if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0); - +#ifdef LISP_FEATURE_SB_THREAD + else { + sigset_t new; + sigaddset(&new,SIG_STOP_FOR_GC); + thread_sigmask(SIG_UNBLOCK,&new,0); + } +#endif funcall0(SymbolFunction(SUB_GC)); undo_fake_foreign_function_call(context); @@ -969,7 +1066,7 @@ undoably_install_low_level_interrupt_handler (int signal, lose("bad signal number %d", signal); } - if (sigismember(&blockable_sigset,signal)) + if (sigismember(&deferrable_sigset,signal)) sa.sa_sigaction = low_level_maybe_now_maybe_later; else sa.sa_sigaction = handler; @@ -1008,16 +1105,13 @@ install_handler(int signal, void handler(int, siginfo_t*, void*)) sigaddset(&new, signal); thread_sigmask(SIG_BLOCK, &new, &old); - sigemptyset(&new); - sigaddset_blockable(&new); - FSHOW((stderr, "/data->interrupt_low_level_handlers[signal]=%x\n", (unsigned int)data->interrupt_low_level_handlers[signal])); if (data->interrupt_low_level_handlers[signal]==0) { if (ARE_SAME_HANDLER(handler, SIG_DFL) || ARE_SAME_HANDLER(handler, SIG_IGN)) { sa.sa_sigaction = handler; - } else if (sigismember(&new, signal)) { + } else if (sigismember(&deferrable_sigset, signal)) { sa.sa_sigaction = maybe_now_maybe_later; } else { sa.sa_sigaction = interrupt_handle_now_handler; @@ -1044,7 +1138,9 @@ interrupt_init() { int i; SHOW("entering interrupt_init()"); + sigemptyset(&deferrable_sigset); sigemptyset(&blockable_sigset); + sigaddset_deferrable(&deferrable_sigset); sigaddset_blockable(&blockable_sigset); global_interrupt_data=calloc(sizeof(struct interrupt_data), 1); diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index 1329123f1..ae7202092 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -91,6 +91,8 @@ extern unsigned long install_handler(int signal, extern union interrupt_handler interrupt_handlers[NSIG]; +/* Set all deferrable signals into *s. */ +void sigaddset_deferrable(sigset_t *s); /* Set all blockable signals into *s. */ void sigaddset_blockable(sigset_t *s); diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 733f8a261..9e0e9eb41 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -44,8 +44,8 @@ void check_sig_stop_for_gc_can_arrive_or_lose() thread_sigmask(SIG_BLOCK, &empty, ¤t); if (sigismember(¤t,SIG_STOP_FOR_GC)) lose("SIG_STOP_FOR_GC cannot arrive: it is blocked\n"); - if (SymbolValue(INTERRUPTS_ENABLED,arch_os_get_current_thread()) == NIL) - lose("SIG_STOP_FOR_GC cannot arrive: interrupts disabled\n"); + if (SymbolValue(GC_INHIBIT,arch_os_get_current_thread()) != NIL) + lose("SIG_STOP_FOR_GC cannot arrive: gc is inhibited\n"); if (arch_pseudo_atomic_atomic(NULL)) lose("SIG_STOP_FOR_GC cannot arrive: in pseudo atomic\n"); } @@ -54,8 +54,7 @@ void check_sig_stop_for_gc_can_arrive_or_lose() { \ sigset_t _newset,_oldset; \ sigemptyset(&_newset); \ - sigaddset_blockable(&_newset); \ - sigdelset(&_newset,SIG_STOP_FOR_GC); \ + sigaddset_deferrable(&_newset); \ thread_sigmask(SIG_BLOCK, &_newset, &_oldset); \ check_sig_stop_for_gc_can_arrive_or_lose(); \ FSHOW_SIGNAL((stderr,"/%s:waiting on lock=%ld, thread=%lu\n",name, \ @@ -232,6 +231,10 @@ struct thread * create_thread_struct(lispobj initial_function) { bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,make_fixnum(0),th); bind_variable(INTERRUPT_PENDING, NIL,th); bind_variable(INTERRUPTS_ENABLED,T,th); + bind_variable(GC_PENDING,NIL,th); +#ifdef LISP_FEATURE_SB_THREAD + bind_variable(STOP_FOR_GC_PENDING,NIL,th); +#endif th->interrupt_data = (struct interrupt_data *) os_validate(0,(sizeof (struct interrupt_data))); @@ -286,7 +289,7 @@ boolean create_os_thread(struct thread *th,os_thread_t *kid_tid) sigset_t newset,oldset; boolean r=1; sigemptyset(&newset); - sigaddset_blockable(&newset); + sigaddset_deferrable(&newset); thread_sigmask(SIG_BLOCK, &newset, &oldset); if((pthread_attr_init(&attr)) || diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp new file mode 100644 index 000000000..e1dd98dc8 --- /dev/null +++ b/tests/gc.impure.lisp @@ -0,0 +1,73 @@ +;;;; gc tests + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;; +;;;; This software is in the public domain and is provided with +;;;; absoluely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package :cl-user) + +(defparameter *x* ()) + +(defun cons-madly () + (loop repeat 10000 do + (setq *x* (make-string 100000)))) + +;; check that WITHOUT-INTERRUPTS doesn't block the gc trigger +(sb-sys:without-interrupts (cons-madly)) + +;; check that WITHOUT-INTERRUPTS doesn't block SIG_STOP_FOR_GC +#+sb-thread +(sb-sys:without-interrupts + (let ((thread (sb-thread:make-thread (lambda () (sb-ext:gc))))) + (loop while (sb-thread:thread-alive-p thread)))) + +(let ((gc-happend nil)) + (push (lambda () (setq gc-happend t)) sb-ext:*after-gc-hooks*) + + ;; check GC-{ON,OFF} works and gc is deferred + (gc-off) + (gc) + (assert (not gc-happend)) + (gc-on) + (assert gc-happend) + + ;; check that WITHOUT-GCING defers explicit gc + (setq gc-happend nil) + (sb-sys:without-gcing + (gc) + (assert (not gc-happend))) + (assert gc-happend) + + ;; check that WITHOUT-GCING defers SIG_STOP_FOR_GC + #+sb-thread + (let ((in-without-gcing nil)) + (setq gc-happend nil) + (sb-thread:make-thread (lambda () + (loop while (not in-without-gcing)) + (sb-ext:gc))) + (sb-sys:without-gcing + (setq in-without-gcing t) + (sleep 3) + (assert (not gc-happend))) + ;; give the hook time to run + (sleep 1) + (assert gc-happend)) + + ;; check GC-ON works even in a WITHOUT-GCING + (setq gc-happend nil) + (sb-sys:without-gcing + (gc) + (assert (not gc-happend)) + (gc-on) + (assert gc-happend) + (setq gc-happend nil)) + (assert (not gc-happend))) + +(sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index aa9da18f4..a346d81a5 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.3.40" +"0.9.3.41" -- 2.11.4.GIT