From: Juho Snellman Date: Sat, 3 Sep 2005 18:41:30 +0000 (+0000) Subject: 0.9.4.25: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=2e22486d5a66f899a2aeb08898b0cdd42dfc11f8;p=sbcl.git 0.9.4.25: Fix problem with GET-INTERNAL-REAL-TIME crashing for processes that have been running for over 49.7 days (reported by Gilbert Baumann on #lisp). * Remove the U-B 32 declarations for values that were suspectible to overflowing in such a short time. This introduces a small amount of extra overhead (<10%) for each call to GET-INTERNAL-(REAL|RUN)-TIME. The accuracy or performance of PROFILE and TIME (the only internal users of this) is not measurably affected by the extra overhead. * Remove some dead comments --- diff --git a/NEWS b/NEWS index b8a17a2..37f8e36 100644 --- a/NEWS +++ b/NEWS @@ -20,6 +20,8 @@ changes in sbcl-0.9.5 relative to sbcl-0.9.4: * bug fix: printing objects of type HASH-TABLE signals a PRINT-NOT-READABLE error when *READ-EVAL* is NIL. (reported by Faré Rideau) + * bug fix: GET-INTERNAL-REAL-TIME now works even for processes that + have been running for over 50 days. (reported by Gilbert Baumann) * threads ** bug fix: parent thread now can be gc'ed even with a live child thread diff --git a/src/code/profile.lisp b/src/code/profile.lisp index e2f98f9..5f5c2ff 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -11,11 +11,6 @@ ;;;; reading internal run time with high resolution and low overhead -;;; FIXME: It might make sense to replace this with something -;;; with finer resolution, e.g. milliseconds or microseconds. -;;; For that matter, maybe we should boost the internal clock -;;; up to something faster, like milliseconds. - (defconstant +ticks-per-second+ internal-time-units-per-second) (declaim (inline get-internal-ticks)) diff --git a/src/code/time.lisp b/src/code/time.lisp index 180b6b6..ddc8cbc 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -36,11 +36,9 @@ micro-seconds-per-internal-time-unit))) (declare (type (unsigned-byte 32) uint)) (cond (base - (truly-the (unsigned-byte 32) - (+ (the (unsigned-byte 32) - (* (the (unsigned-byte 32) (- seconds base)) - sb!xc:internal-time-units-per-second)) - uint))) + (+ (* (- seconds base) + sb!xc:internal-time-units-per-second) + uint)) (t (setq *internal-real-time-base-seconds* seconds) uint))))) @@ -49,7 +47,6 @@ #!+sb-doc "Return the run time in the internal time format. (See INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage." - (declare (values (unsigned-byte 32))) (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec) (sb!unix:unix-fast-getrusage sb!unix:rusage_self) (declare (ignore ignore) @@ -59,9 +56,8 @@ ;; documented anywhere and the observed behavior is to ;; sometimes return 1000000 exactly.) (type (integer 0 1000000) utime-usec stime-usec)) - (let ((result (+ (the (unsigned-byte 32) - (* (the (unsigned-byte 32) (+ utime-sec stime-sec)) - sb!xc:internal-time-units-per-second)) + (let ((result (+ (* (+ utime-sec stime-sec) + sb!xc:internal-time-units-per-second) (floor (+ utime-usec stime-usec (floor micro-seconds-per-internal-time-unit 2)) diff --git a/version.lisp-expr b/version.lisp-expr index 221fa69..8b44167 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.4.24" +"0.9.4.25"