From: Daniel Barlow Date: Mon, 21 Apr 2003 21:06:24 +0000 (+0000) Subject: 0.pre8.85 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=02c9007b4ca5753406f60019f4fe5e5f8392541a;p=sbcl.git 0.pre8.85 Merge the definitely-maybe-gc branch: Remove all the lispland logic that checks bytes-consed thresholds to see if it's worth GCing: C does these checks anyway. SUB-GC now always GCs unless *GC-INHIBIT* says not to Delete the notify before/after calls and notify-stream. (Planned future change: pass the same information to *{BEFORE,AFTER}-GC-HOOKS* instead) *SOFT-HEAP-LIMIT* and MAYBE-GC are gone (unused). *ALREADY-MAYBE-GCING* is also dead, replaced with a proper mutex that will also prevent simultaneous GCs from multiple threads. This entails moving gc.lisp and purify.lisp after target-thread in the build-order (Unithread WITH-MUTEX now honours its WAIT-P argument, so actually works in this situation) --- diff --git a/NEWS b/NEWS index ee4c576..0ac4b8e 100644 --- a/NEWS +++ b/NEWS @@ -1662,6 +1662,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14 compiled in by default: you need to add :SB-THREAD to the target features. See the "Beyond ANSI" chapter of the manual for details. + * Garbage collection refactoring: user-visible change is that a + call to the GC function during WITHOUT-GCING will not do garbage + collection until the end of the WITHOUT-GCING. If you were doing + this you were probably losing anyway. + * sb-aclrepl module improvements: an integrated inspector, added repl features, and a bug fix to :trace command. * fixed some bugs revealed by Paul Dietz' test suite: diff --git a/build-order.lisp-expr b/build-order.lisp-expr index c31fc9b..7761ef2 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -238,8 +238,6 @@ ("src/code/misc") ("src/code/room" :not-host) - ("src/code/gc" :not-host) - ("src/code/purify" :not-host) ("src/code/stream" :not-host) ("src/code/print" :not-host) @@ -609,6 +607,8 @@ #!-sb-thread ("src/code/target-unithread" :not-host) ;; defines SB!DI:DO-DEBUG-FUN-BLOCKS, needed by target-disassem.lisp + ("src/code/gc" :not-host) + ("src/code/purify" :not-host) ("src/code/debug-int" :not-host) ;; target-only assemblerish stuff diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 72e86e4..12f5e8e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1129,7 +1129,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%MAKE-INSTANCE" "MAKE-VALUE-CELL" "MAKE-VALUES-TYPE" - "MAYBE-GC" "MEMBER-TYPE" "MEMBER-TYPE-MEMBERS" + "MEMBER-TYPE" "MEMBER-TYPE-MEMBERS" "MEMBER-TYPE-P" "MERGE-BITS" "MODIFIED-NUMERIC-TYPE" "MUTATOR-SELF" "NAMED-TYPE" "NAMED-TYPE-NAME" "NAMED-TYPE-P" @@ -1237,6 +1237,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "SPECIFIER-TYPE" "STACK-REF" "STREAMLIKE" "STRINGABLE" "STRUCTURE-RAW-SLOT-TYPE-AND-SIZE" + "SUB-GC" "%INSTANCE-LENGTH" "%INSTANCE-REF" "%INSTANCE-SET" "SYSTEM-AREA-CLEAR" diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 7dfd23c..39d59a6 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -180,24 +180,6 @@ and submit it as a patch." GET-INTERNAL-RUN-TIME)") (declaim (type index *gc-run-time*)) -;;; a limit to help catch programs which allocate too much memory, -;;; since a hard heap overflow is so hard to recover from -;;; -;;; FIXME: Like *GC-TRIGGER*, this variable (1) should probably be -;;; denominated in a larger unit than bytes and (2) should probably be -;;; renamed so that it's clear from the name what unit it's -;;; denominated in. -(declaim (type (or unsigned-byte null) *soft-heap-limit*)) -(defvar *soft-heap-limit* - ;; As long as *GC-TRIGGER* is DECLAIMed as INDEX, we know that - ;; MOST-POSITIVE-FIXNUM is a hard limit on how much memory can be - ;; allocated. (Not necessarily *the* hard limit, which is fairly - ;; likely something like a Unix per-process limit that we don't know - ;; about, but a hard limit anyway.) And this gives us a reasonable - ;; conservative default for the soft limit... - (- most-positive-fixnum - *bytes-consed-between-gcs*)) - ;;;; The following specials are used to control when garbage ;;;; collection occurs. @@ -229,50 +211,10 @@ and submit it as a patch." ;;; When >0, inhibits garbage collection. (defvar *gc-inhibit*) ; initialized in cold init -;;; This flag is used to prevent recursive entry into the garbage -;;; collector. -(defvar *already-maybe-gcing*) ; initialized in cold init - -;;; When T, indicates that the dynamic usage has exceeded the value -;;; *GC-TRIGGER*. +;;; 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 -(defun default-gc-notify-before (notify-stream bytes-in-use) - (declare (type stream notify-stream)) - (format - notify-stream - "~&; GC is beginning with ~:D bytes in use at internal runtime ~:D.~%" - bytes-in-use - (get-internal-run-time)) - (finish-output notify-stream)) -(defparameter *gc-notify-before* #'default-gc-notify-before - #!+sb-doc - "The function bound to this variable is invoked before GC'ing (unless - *GC-NOTIFY-STREAM* is NIL) with the value of *GC-NOTIFY-STREAM* and - current amount of dynamic usage (in bytes). It should notify the - user that the system is going to GC.") - -(defun default-gc-notify-after (notify-stream - bytes-retained - bytes-freed - new-trigger) - (declare (type stream notify-stream)) - (format notify-stream - "~&; GC has finished with ~:D bytes in use (~:D bytes freed)~@ - ; at internal runtime ~:D. The new GC trigger is ~:D bytes.~%" - bytes-retained - bytes-freed - (get-internal-run-time) - new-trigger) - (finish-output notify-stream)) -(defparameter *gc-notify-after* #'default-gc-notify-after - #!+sb-doc - "The function bound to this variable is invoked after GC'ing with the -value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in bytes) now -free, the number of bytes freed by the GC, and the new GC trigger -threshold; or if *GC-NOTIFY-STREAM* is NIL, it's not invoked. The -function should notify the user that the system has finished GC'ing.") - ;;;; internal GC (sb!alien:define-alien-routine collect-garbage sb!alien:int @@ -309,129 +251,61 @@ function should notify the user that the system has finished GC'ing.") (warn "(FUNCALL ~S~{ ~S~}) lost:~%~A" ',function ',args cond) nil)))) -;;; SUB-GC decides when and if to do a garbage collection. The FORCE-P -;;; flags controls whether a GC should occur even if the dynamic usage -;;; is not greater than *GC-TRIGGER*. +;;; SUB-GC does a garbage collection. This is called from three places: +;;; (1) The C runtime will call here when it detects that we've consed +;;; enough to exceed the gc trigger threshold +;;; (2) The user may request a collection using GC, below +;;; (3) At the end of a WITHOUT-GCING section, we are called if +;;; *NEED-TO-COLLECT-GARBAGE* is true ;;; +;;; This is different from the behaviour in 0.7 and earlier: it no +;;; longer decides whether to GC based on thresholds. If you call +;;; SUB-GC you will definitely get a GC either now or when the +;;; WITHOUT-GCING is over + ;;; 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* - (let* ((*already-maybe-gcing* t) - (start-time (get-internal-run-time)) - (pre-gc-dynamic-usage (dynamic-usage)) - ;; Currently we only check *SOFT-HEAP-LIMIT* at GC time, - ;; not for every allocation. That makes it cheap to do, - ;; even if it is a little ugly. - (soft-heap-limit-exceeded? (and *soft-heap-limit* - (> pre-gc-dynamic-usage - *soft-heap-limit*))) - (*soft-heap-limit* (if soft-heap-limit-exceeded? - (+ pre-gc-dynamic-usage - *bytes-consed-between-gcs*) - *soft-heap-limit*))) - (when soft-heap-limit-exceeded? - (cerror "Continue with GC." - "soft heap limit exceeded (temporary new limit=~W)" - *soft-heap-limit*)) - (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* (zerop *gc-inhibit*))) - ;; KLUDGE: Wow, we really mask interrupts all the time we're - ;; collecting garbage? That seems like a long time.. -- WHN 19991129 +(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex")) + +(defun sub-gc (&key (gen 0)) + (when (sb!thread::mutex-value *gc-mutex*) (return-from sub-gc nil)) + (sb!thread:with-mutex (*gc-mutex* :wait-p nil) + (let* ((start-time (get-internal-run-time))) + (setf *need-to-collect-garbage* t) + (when (zerop *gc-inhibit*) (without-interrupts - ;; FIXME: We probably shouldn't do this evil thing to - ;; *STANDARD-OUTPUT* in a binding which is wrapped around - ;; calls to user-settable GC hook functions. - (let ((*standard-output* *terminal-io*)) - (when *gc-notify-stream* - (if (streamp *gc-notify-stream*) - (carefully-funcall *gc-notify-before* - *gc-notify-stream* - pre-gc-dynamic-usage) - (warn - "*GC-NOTIFY-STREAM* is set, but not a STREAM -- ignored."))) - (dolist (hook *before-gc-hooks*) - (carefully-funcall hook)) - (when *gc-trigger* - (clear-auto-gc-trigger)) - (let* (;; We do DYNAMIC-USAGE once more here in order to - ;; get a more accurate measurement of the space - ;; actually freed, since the messing around, e.g. - ;; GC-notify stuff, since the DYNAMIC-USAGE which - ;; triggered GC could've done a fair amount of - ;; consing.) - (pre-internal-gc-dynamic-usage (dynamic-usage)) - (ignore-me (funcall *internal-gc* gen)) - (post-gc-dynamic-usage (dynamic-usage)) - (n-bytes-freed (- pre-internal-gc-dynamic-usage - post-gc-dynamic-usage)) - ;; In sbcl-0.6.12.39, the raw N-BYTES-FREED from - ;; GENCGC could sometimes be substantially negative - ;; (e.g. -5872). I haven't looked into what causes - ;; that, but I suspect it has to do with - ;; fluctuating inefficiency in the way that the - ;; GENCGC packs things into page boundaries. - ;; Bumping the raw result up to 0 is a little ugly, - ;; but shouldn't be a problem, and it's even - ;; possible to sort of justify it: the packing - ;; inefficiency which has caused (DYNAMIC-USAGE) to - ;; grow is effectively consing, or at least - ;; overhead of consing, so it's sort of correct to - ;; add it to the running total of consing. ("Man - ;; isn't a rational animal, he's a rationalizing - ;; animal.":-) -- WHN 2001-06-23 - (eff-n-bytes-freed (max 0 n-bytes-freed))) - (declare (ignore ignore-me)) - (/show0 "got (DYNAMIC-USAGE) and EFF-N-BYTES-FREED") - (incf *n-bytes-freed-or-purified* - eff-n-bytes-freed) - (/show0 "clearing *NEED-TO-COLLECT-GARBAGE*") - (setf *need-to-collect-garbage* nil) - (/show0 "calculating NEW-GC-TRIGGER") - (let ((new-gc-trigger (+ post-gc-dynamic-usage - *bytes-consed-between-gcs*))) - (/show0 "setting *GC-TRIGGER*") - (setf *gc-trigger* new-gc-trigger)) - (/show0 "calling SET-AUTO-GC-TRIGGER") - (set-auto-gc-trigger *gc-trigger*) - (dolist (hook *after-gc-hooks*) - (/show0 "doing a hook from *AFTER-GC--HOOKS*") - ;; FIXME: This hook should be called with the same - ;; kind of information as *GC-NOTIFY-AFTER*. In - ;; particular, it would be nice for the hook function - ;; to be able to adjust *GC-TRIGGER* intelligently to - ;; e.g. 108% of total memory usage. - (carefully-funcall hook)) - (when *gc-notify-stream* - (if (streamp *gc-notify-stream*) - (carefully-funcall *gc-notify-after* - *gc-notify-stream* - post-gc-dynamic-usage - eff-n-bytes-freed - *gc-trigger*) - (warn - "*GC-NOTIFY-STREAM* is set, but not a stream -- ignored."))))) - (scrub-control-stack))) ;XXX again? we did this from C ... - (incf *gc-run-time* (- (get-internal-run-time) - start-time)))) - ;; FIXME: should probably return (VALUES), here and in RETURN-FROM + (dolist (hook *before-gc-hooks*) (carefully-funcall hook)) + (when *gc-trigger* + (clear-auto-gc-trigger)) + (let* ((pre-internal-gc-dynamic-usage (dynamic-usage)) + (ignore-me (funcall *internal-gc* gen)) + (post-gc-dynamic-usage (dynamic-usage)) + (n-bytes-freed (- pre-internal-gc-dynamic-usage + post-gc-dynamic-usage)) + ;; the raw N-BYTES-FREED from GENCGC can sometimes be + ;; substantially negative (e.g. -5872). This is + ;; probably due to fluctuating inefficiency in the way + ;; that the GENCGC packs things into page boundaries. + ;; We bump the raw result up to 0: the space is + ;; allocated even if unusable, so should be counted + ;; for deciding when we've allocated enough to GC + ;; next. ("Man isn't a rational animal, he's a + ;; rationalizing animal.":-) -- WHN 2001-06-23) + (eff-n-bytes-freed (max 0 n-bytes-freed))) + (declare (ignore ignore-me)) + (incf *n-bytes-freed-or-purified* eff-n-bytes-freed) + (setf *need-to-collect-garbage* nil) + (setf *gc-trigger* (+ post-gc-dynamic-usage + *bytes-consed-between-gcs*)) + (set-auto-gc-trigger *gc-trigger*) + (dolist (hook *after-gc-hooks*) + (carefully-funcall hook)))) + (scrub-control-stack)) ;XXX again? we did this from C ... + (incf *gc-run-time* (- (get-internal-run-time) start-time)))) nil) -;;; This routine is called by the allocation miscops to decide whether -;;; a GC should occur. The argument, OBJECT, is the newly allocated -;;; object which must be returned to the caller. -(defun maybe-gc (&optional object) - (sub-gc) - object) + + ;;; This is the user-advertised garbage collection function. (defun gc (&key (gen 0) (full nil) &allow-other-keys) @@ -441,7 +315,7 @@ function should notify the user that the system has finished GC'ing.") #!+(and sb-doc (not gencgc)) "Initiate a garbage collection. GEN may be provided for compatibility with generational garbage collectors, but is ignored in this implementation." - (sub-gc :force-p t :gen (if full 6 gen))) + (sub-gc :gen (if full 6 gen))) ;;;; auxiliary functions diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index fae42e2..dc1358e 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -34,7 +34,7 @@ ,@body) (atomic-incf/symbol *gc-inhibit* -1) (when (and *need-to-collect-garbage* (zerop *gc-inhibit*)) - (maybe-gc nil)))) + (sub-gc)))) ;;; EOF-OR-LOSE is a useful macro that handles EOF. diff --git a/src/code/target-unithread.lisp b/src/code/target-unithread.lisp index c684a3c..e11ec9d 100644 --- a/src/code/target-unithread.lisp +++ b/src/code/target-unithread.lisp @@ -91,8 +91,15 @@ (setf old-value t1)))) (defmacro with-mutex ((mutex &key value (wait-p t)) &body body) - (declare (ignore mutex value wait-p)) - `(progn ,@body)) + (cond ((not wait-p) + `(unless (mutex-value ,mutex) + (unwind-protect + (progn + (setf (mutex-value ,mutex) (or ,value t)) + ,@body) + (setf (mutex-value ,mutex) nil)))) + (t + `(progn ,@body)))) ;;; what's the best thing to do with these on unithread? #+NIl diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index f245850..c05f092 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -25,8 +25,7 @@ ;;; specials initialized by !COLD-INIT ;;; FIXME: These could be converted to DEFVARs. -(declaim (special *gc-inhibit* *already-maybe-gcing* - *need-to-collect-garbage* +(declaim (special *gc-inhibit* *need-to-collect-garbage* *gc-notify-stream* *before-gc-hooks* *after-gc-hooks* #!+x86 *pseudo-atomic-atomic* diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 5bb2213..cb7da46 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -186,7 +186,7 @@ *posix-argv* ;; functions that the C code needs to call - maybe-gc + sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 0de5f03..9bfeeaa 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1253,7 +1253,7 @@ (macrolet ((frob (symbol) `(cold-set ',symbol (cold-fdefinition-object (cold-intern ',symbol))))) - (frob maybe-gc) + (frob sub-gc) (frob internal-error) (frob sb!kernel::control-stack-exhausted-error) (frob sb!di::handle-breakpoint) diff --git a/src/compiler/hppa/parms.lisp b/src/compiler/hppa/parms.lisp index 6be70c6..3624beb 100644 --- a/src/compiler/hppa/parms.lisp +++ b/src/compiler/hppa/parms.lisp @@ -122,7 +122,7 @@ *posix-argv* ;; Functions that the C code needs to call - sb!impl::maybe-gc + sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index 50d4d4e..971f901 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -111,7 +111,7 @@ *posix-argv* - sb!impl::maybe-gc + sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp index 94332f3..d5f88c8 100644 --- a/src/compiler/ppc/parms.lisp +++ b/src/compiler/ppc/parms.lisp @@ -152,7 +152,7 @@ *posix-argv* ;; functions that the C code needs to call - sb!impl::maybe-gc + sb!impl::sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 0b7ae33..4162357 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -201,7 +201,7 @@ sb!impl::*!initial-fdefn-objects* ;; functions that the C code needs to call - maybe-gc + sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 4128ae9..f2c06a1 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -226,7 +226,7 @@ ;; functions that the C code needs to call. When adding to this list, ;; also add a `frob' form in genesis.lisp finish-symbols. - maybe-gc + sub-gc sb!kernel::internal-error sb!kernel::control-stack-exhausted-error sb!di::handle-breakpoint diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index efe76e3..5155c6a 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -288,7 +288,7 @@ interrupt_handle_pending(os_context_t *context) { fake_foreign_function_call(context); } - funcall0(SymbolFunction(MAYBE_GC)); + funcall0(SymbolFunction(SUB_GC)); #ifndef __i386__ if (were_in_lisp) #endif @@ -606,7 +606,7 @@ interrupt_maybe_gc(int signal, siginfo_t *info, void *void_context) else { lispobj *old_free_space=current_dynamic_space; fake_foreign_function_call(context); - funcall0(SymbolFunction(MAYBE_GC)); + funcall0(SymbolFunction(SUB_GC)); undo_fake_foreign_function_call(context); if(current_dynamic_space==old_free_space) /* MAYBE-GC (as the name suggest) might not. If it diff --git a/version.lisp-expr b/version.lisp-expr index b34ce86..f7ac900 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.pre8.84" +"0.pre8.85"