From 4a466c4908db0f6f5c468ae0eabb500ffac07aba Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 24 Jun 2001 01:32:55 +0000 Subject: [PATCH] 0.6.12.39: removed some stuff checking for profile monotonicity (since now I know that OpenBSD get-internal-run-time *isn't* monotonic, since OpenBSD getrusage() isn't monotonic: bug kernel/1065. I've now patched my OpenBSD 2.9 to fix this enough to make GET-INTERNAL-RUN-TIME monotonic, and I'll submit the patch to the OpenBSD maintainers once I straighten out how to diff against the patch branch.) tweaked GET-BYTES-CONSED (aiming to minimize consing in profile.lisp).. ..replaced *TOTAL-BYTES-CONSED* with *N-BYTES-FREED-OR-PURIFIED-PCOUNTER* ..deleted *LAST-BYTES-IN-USE* ..added DEFKNOWN GET-BYTES-CONSED ..incompatible change: made GET-BYTES-CONSED return the number of bytes consed since the system was started, not since the first time the function was called ..renamed GC-COLD-INIT-OR-REINIT, since it's only actually called at reinit time fixed *BYTES-CONSED-BETWEEN-GCS* FIXME; and now DEFAULT-BYTES-CONSED-BETWEEN-GCS no longer needs to be a named definition deleted unused *GC-INHIBIT-HOOK* --- package-data-list.lisp-expr | 6 +- src/code/cold-init.lisp | 2 +- src/code/gc.lisp | 169 +++++++++++++++++++------------------------ src/code/profile.lisp | 20 +---- src/code/time.lisp | 6 +- src/cold/shared.lisp | 8 +- src/compiler/fndb.lisp | 4 + version.lisp-expr | 2 +- 8 files changed, 92 insertions(+), 125 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 72e02f0..cb9e2f2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -828,10 +828,10 @@ retained, possibly temporariliy, because it might be used internally." ;; compelling reasons, but hopefully we can get by ;; without supporting them, at least not as publicly ;; accessible things with fixed interfaces. - "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES" + "GET-FLOATING-POINT-MODES" + "SET-FLOATING-POINT-MODES" "WITH-FLOAT-TRAPS-MASKED" "DEFINE-HASH-TABLE-TEST" - "*GC-INHIBIT-HOOK*" ;; compatibility hacks for old-style CMU CL data formats "UNIX-ENVIRONMENT-CMUCL-FROM-SBCL" @@ -1293,7 +1293,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "!PACKAGE-COLD-INIT" "SIGNAL-COLD-INIT-OR-REINIT" "!POLICY-COLD-INIT-OR-RESANIFY" "!VM-TYPE-COLD-INIT" "!BACKQ-COLD-INIT" "!SHARPM-COLD-INIT" - "!CLASS-FINALIZE" "GC-COLD-INIT-OR-REINIT" + "!CLASS-FINALIZE" "GC-REINIT" ;; Note: These are out of lexicographical order because in CMU CL ;; they were defined as internal symbols in package "CL" diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index e5bce7a..6d10a6a 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -289,7 +289,7 @@ instead (which is another name for the same thing).")) (os-cold-init-or-reinit) (stream-reinit) (signal-cold-init-or-reinit) - (gc-cold-init-or-reinit) + (gc-reinit) (setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t) (set-floating-point-modes :traps '(:overflow diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 00523b3..8949bd5 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -99,69 +99,49 @@ ;;;; GET-BYTES-CONSED -;;; internal state -(defvar *last-bytes-in-use* nil) -(defvar *total-bytes-consed* 0) -(declaim (type (or index null) *last-bytes-in-use*)) -(declaim (type unsigned-byte *total-bytes-consed*)) +;;; the total number of bytes freed so far (including any freeing +;;; which goes on in PURIFY) +;;; +;;; (We save this so that we can calculate the total number of bytes +;;; ever allocated by adding this to the number of bytes currently +;;; allocated and never freed.) +(declaim (type pcounter *n-bytes-freed-or-purified-pcounter*)) +(defvar *n-bytes-freed-or-purified-pcounter* (make-pcounter)) (declaim (ftype (function () unsigned-byte) get-bytes-consed)) (defun get-bytes-consed () #!+sb-doc - "Return the number of bytes consed since the first time this function - was called. The first time it is called, it returns zero." - (declare (optimize (speed 3) (safety 0))) - (cond ((null *last-bytes-in-use*) - (setq *last-bytes-in-use* (dynamic-usage)) - (setq *total-bytes-consed* 0)) - (t - (let ((bytes (dynamic-usage))) - (incf *total-bytes-consed* - (the index (- bytes *last-bytes-in-use*))) - (setq *last-bytes-in-use* bytes)))) - ;; FIXME: We should really use something like PCOUNTER to make this - ;; hold reliably. - (aver (not (minusp *total-bytes-consed*))) - *total-bytes-consed*) + "Return the number of bytes consed since the program began. Typically +this result will be a consed bignum, so if you have an application (e.g. +profiling) which can't tolerate the overhead of consing bignums, you'll +probably want either to hack in at a lower level (as the code in the +SB-PROFILE package does), or to design a more microefficient interface +and submit it as a patch." + (+ (dynamic-usage) + (pcounter->integer *n-bytes-freed-or-purified-pcounter*))) ;;;; variables and constants -;;; the default value of *BYTES-CONSED-BETWEEN-GCS* and *GC-TRIGGER* -(defconstant default-bytes-consed-between-gcs 2000000) - ;;; the minimum amount of dynamic space which must be consed before a ;;; GC will be triggered ;;; ;;; Unlike CMU CL, we don't export this variable. (There's no need to, -;;; since the BYTES-CONSED-BETWEEN-GCS function is SETFable.) -(defvar *bytes-consed-between-gcs* default-bytes-consed-between-gcs) +;;; since our BYTES-CONSED-BETWEEN-GCS function is SETFable.) +(defvar *bytes-consed-between-gcs* (* 2 (expt 10 6))) (declaim (type index *bytes-consed-between-gcs*)) ;;;; GC hooks -;;; These variables are a list of functions which are run before and -;;; after garbage collection occurs. (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.") + (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.") -;;; This hook is invoked whenever SUB-GC intends to GC (unless the GC -;;; was explicitly forced by calling SB!EXT:GC). If the hook function -;;; returns NIL then the GC procedes; otherwise, the GC is inhibited and -;;; *GC-INHIBIT* and *NEED-TO-COLLECT-GARBAGE* are left bound to T. -;;; Presumably someone will call GC-ON later to collect the garbage. -(defvar *gc-inhibit-hook* nil - #!+sb-doc - "This should be bound to a function or NIL. If it is a function, this - function should take one argument, the current amount of dynamic - usage. The function should return NIL if garbage collection should - continue and non-NIL if it should be inhibited. Use with caution.") - (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 @@ -268,9 +248,9 @@ 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 if a GC should occur even if -;;; the dynamic usage is not greater than *GC-TRIGGER*. +;;; 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*. ;;; ;;; For GENCGC all generations < GEN will be GC'ed. (defun sub-gc (&key force-p (gen 0)) @@ -278,53 +258,25 @@ has finished GC'ing.") (unless *already-maybe-gcing* (let* ((*already-maybe-gcing* t) (start-time (get-internal-run-time)) - (pre-gc-dyn-usage (dynamic-usage)) + (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-dyn-usage + (> pre-gc-dynamic-usage *soft-heap-limit*))) (*soft-heap-limit* (if soft-heap-limit-exceeded? - (+ pre-gc-dyn-usage + (+ 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=~D)" *soft-heap-limit*)) - (unless (integerp (symbol-value '*bytes-consed-between-gcs*)) - ;; The noise w/ symbol-value above is to keep the compiler - ;; from optimizing the test away because of the type declaim - ;; for *bytes-consed-between-gcs*. - ;; - ;; FIXME: I'm inclined either to get rid of the DECLAIM or to - ;; trust it, instead of doing this weird hack. It's not - ;; particularly trustable, since (SETF - ;; *BYTES-CONSED-BETWEEN-GCS* 'SEVEN) works. But it's also not - ;; very nice to have the type of the variable specified in two - ;; places which can (and in CMU CL 2.4.8 did, INTEGER vs. - ;; INDEX) drift apart. So perhaps we should just add a note to - ;; the variable documentation for *BYTES-CONSED-BETWEEN-GCS* - ;; that it must be an INDEX, and remove the DECLAIM. Or we - ;; could make a SETFable (BYTES-CONSED-BETWEEN-GCS) function - ;; and enforce the typing that way. And in fact the SETFable - ;; function already exists, so all we need do is make the - ;; variable private, and then we can trust the DECLAIM. - (warn "The value of *BYTES-CONSED-BETWEEN-GCS*, ~S, is not an ~ - integer. Resetting it to ~D." - *bytes-consed-between-gcs* - default-bytes-consed-between-gcs) - (setf *bytes-consed-between-gcs* default-bytes-consed-between-gcs)) - (when (and *gc-trigger* (> pre-gc-dyn-usage *gc-trigger*)) + (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* (not *gc-inhibit*))) - (when (and (not force-p) - *gc-inhibit-hook* - (carefully-funcall *gc-inhibit-hook* pre-gc-dyn-usage)) - (setf *gc-inhibit* t) - (return-from sub-gc nil)) ;; KLUDGE: Wow, we really mask interrupts all the time we're ;; collecting garbage? That seems like a long time.. -- WHN 19991129 (without-interrupts @@ -336,33 +288,58 @@ has finished GC'ing.") (if (streamp *gc-notify-stream*) (carefully-funcall *gc-notify-before* *gc-notify-stream* - pre-gc-dyn-usage) + 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)) - #!-gencgc (funcall *internal-gc*) - ;; FIXME: This EQ test is pretty gross. Among its other - ;; nastinesses, it looks as though it could break if we - ;; recompile COLLECT-GARBAGE. - #!+gencgc (if (eq *internal-gc* #'collect-garbage) - (funcall *internal-gc* gen) - (funcall *internal-gc*)) - (let* ((post-gc-dyn-usage (dynamic-usage)) - (bytes-freed (- pre-gc-dyn-usage post-gc-dyn-usage))) - (/show0 "got (DYNAMIC-USAGE) and BYTES-FREED") - (when *last-bytes-in-use* - (/show0 "doing *LAST-BYTES-IN-USE* thing") - (incf *total-bytes-consed* - (- pre-gc-dyn-usage *last-bytes-in-use*)) - (/show0 "setting *LAST-BYTES-IN-USE*") - (setq *last-bytes-in-use* post-gc-dyn-usage)) + (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 + #!-gencgc (funcall *internal-gc*) + ;; FIXME: This EQ test is pretty gross. Among its other + ;; nastinesses, it looks as though it could break if we + ;; recompile COLLECT-GARBAGE. We should probably just + ;; straighten out the interface so that all *INTERNAL-GC* + ;; functions accept a GEN argument (and then the + ;; non-generational ones just ignore it). + #!+gencgc (if (eq *internal-gc* #'collect-garbage) + (funcall *internal-gc* gen) + (funcall *internal-gc*))) + (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-pcounter *n-bytes-freed-or-purified-pcounter* + 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-dyn-usage + (let ((new-gc-trigger (+ post-gc-dynamic-usage *bytes-consed-between-gcs*))) (/show0 "setting *GC-TRIGGER*") (setf *gc-trigger* new-gc-trigger)) @@ -380,8 +357,8 @@ has finished GC'ing.") (if (streamp *gc-notify-stream*) (carefully-funcall *gc-notify-after* *gc-notify-stream* - post-gc-dyn-usage - bytes-freed + post-gc-dynamic-usage + eff-n-bytes-freed *gc-trigger*) (warn "*GC-NOTIFY-STREAM* is set, but not a stream -- ignored."))))) @@ -430,6 +407,8 @@ has finished GC'ing.") (clear-auto-gc-trigger) (set-auto-gc-trigger *gc-trigger*)) (t + ;; FIXME: If SCRUB-CONTROL-STACK is required here, why + ;; isn't it built into SUB-GC? And *is* it required here? (sb!sys:scrub-control-stack) (sub-gc))))) val) @@ -450,7 +429,7 @@ has finished GC'ing.") ;;;; initialization stuff -(defun gc-cold-init-or-reinit () +(defun gc-reinit () (when *gc-trigger* (if (< *gc-trigger* (dynamic-usage)) (sub-gc) diff --git a/src/code/profile.lisp b/src/code/profile.lisp index def7908..4f4f9ab 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -162,13 +162,7 @@ (aver (typep inner-enclosed-profiles 'unsigned-byte)) (multiple-value-prog1 (let ((start-ticks (get-internal-ticks)) - ;; KLUDGE: We add (THE UNSIGNED-BYTE ..) wrappers - ;; around GET-BYTES-CONSED because as of - ;; sbcl-0.6.4, at the time that the FTYPE of - ;; GET-BYTES-CONSED is DECLAIMed, the - ;; cross-compiler's type system isn't mature enough - ;; to do anything about it. -- WHN 20000503 - (start-consing (the unsigned-byte (get-bytes-consed))) + (start-consing (get-bytes-consed)) (*enclosed-ticks* 0) (*enclosed-consing* 0) (*enclosed-profiles* 0)) @@ -180,22 +174,12 @@ arg-count)) (let ((*computing-profiling-data-for* encapsulated-fun)) (setf dticks (fastbig- (get-internal-ticks) start-ticks) - dconsing (fastbig- (the unsigned-byte - (get-bytes-consed)) - start-consing)) + dconsing (fastbig- (get-bytes-consed) start-consing)) (setf inner-enclosed-profiles (pcounter-or-fixnum->integer *enclosed-profiles*)) - (when (minusp dticks) ; REMOVEME - (unprofile-all) - (error "huh? (GET-INTERNAL-TICKS)=~S START-TICKS=~S" - (get-internal-ticks) start-ticks)) (aver (not (minusp dconsing))) ; REMOVEME (aver (not (minusp inner-enclosed-profiles))) ; REMOVEME (let ((net-dticks (fastbig- dticks *enclosed-ticks*))) - (when (minusp net-dticks) ; REMOVEME - (unprofile-all) - (error "huh? DTICKS=~S, *ENCLOSED-TICKS*=~S" - dticks *enclosed-ticks*)) (fastbig-incf-pcounter-or-fixnum ticks net-dticks)) (let ((net-dconsing (fastbig- dconsing *enclosed-consing*))) (when (minusp net-dconsing) ; REMOVEME diff --git a/src/code/time.lisp b/src/code/time.lisp index 6b9f5de..34d64c3 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -276,14 +276,14 @@ (declare (ignore def)) (cond (env-p - (warn "TIME form in a non-null environment, forced to interpret.~@ - Compiling entire form will produce more accurate times.") + (warn "non-null environment for TIME form, forced to interpret.~@ + Compiling the entire form will produce more accurate times.") fun) (t (compile nil fun))))) (t fun))) -;;; Return all the files that we want time to report. +;;; Return all the data that we want TIME to report. (defun time-get-sys-info () (multiple-value-bind (user sys faults) (sb!sys:get-system-info) (values user sys faults (get-bytes-consed)))) diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index dd77c8e..d088aa2 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -17,10 +17,10 @@ ;;; GC tuning has little effect on the x86 due to the generational ;;; collector. For the older stop & copy collector, it assuredly -;;; does. GC time is proportional to the amount of non-grabage +;;; does. GC time is proportional to the amount of non-garbage ;;; needing collection and copying; when the application involved is -;;; the SBCL compiler, it doesn't take any longer to collect 20Mb than -;;; 2 -dan, 20000819 +;;; the SBCL compiler, it doesn't take any longer to collect 20 Mb than +;;; to collect 2 Mb. -dan, 20000819 ;;; ;;; Actually, tweaking *BYTES-CONSED-BETWEEN-GCS* to 20Mb instead of ;;; the default 2 seemed to make SBCL rebuild O(25%) faster on my 256 @@ -32,7 +32,7 @@ #+(and sbcl alpha) ; SBCL/Alpha uses stop-and-copy, and Alphas have lotso RAM. (progn (sb-ext:gc-off) - (setf sb-kernel::*bytes-consed-between-gcs* (* 20 (expt 10 6))) + (setf (bytes-consed-between-gcs) (* 20 (expt 10 6))) (sb-ext:gc-on) (sb-ext:gc)) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 6b975db..3043ffb 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1239,6 +1239,10 @@ (defknown constantly (t) function (movable flushable)) (defknown complement (function) function (movable flushable)) +;;;; miscellaneous extensions + +(defknown get-bytes-consed () unsigned-byte (flushable)) + ;;;; magical compiler frobs ;;; We can't fold this in general because of SATISFIES. There is a diff --git a/version.lisp-expr b/version.lisp-expr index d7131b4..4519446 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; four numeric fields, is used for versions which aren't released ;;; but correspond only to CVS tags or snapshots. -"0.6.12.38" +"0.6.12.39" -- 1.7.10.4