Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/code gc.lisp,1.43,1.44 sysmacs.lisp,1.14,1.15 target-unithread.lisp,1.4,1.5 toplevel.lisp,1.41,1.42
|
From: Daniel B. <da...@us...> - 2003-04-21 21:07:01
|
Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv2744/src/code
Modified Files:
gc.lisp sysmacs.lisp target-unithread.lisp toplevel.lisp
Log Message:
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)
Index: gc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/gc.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -d -r1.43 -r1.44
--- gc.lisp 18 Apr 2003 03:13:27 -0000 1.43
+++ gc.lisp 21 Apr 2003 21:06:26 -0000 1.44
@@ -180,24 +180,6 @@
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 @@
;;; 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 @@
(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
+(defvar *gc-mutex* (sb!thread:make-mutex :name "GC Mutex"))
-(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
+(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 @@
#!+(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
Index: sysmacs.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/sysmacs.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- sysmacs.lisp 18 Apr 2003 01:29:40 -0000 1.14
+++ sysmacs.lisp 21 Apr 2003 21:06:26 -0000 1.15
@@ -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.
Index: target-unithread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-unithread.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- target-unithread.lisp 7 Apr 2003 13:16:52 -0000 1.4
+++ target-unithread.lisp 21 Apr 2003 21:06:27 -0000 1.5
@@ -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
Index: toplevel.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/toplevel.lisp,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- toplevel.lisp 14 Apr 2003 01:42:54 -0000 1.41
+++ toplevel.lisp 21 Apr 2003 21:06:27 -0000 1.42
@@ -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*
|