/[cmucl]/src/code/time.lisp
ViewVC logotype

Diff of /src/code/time.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8.1.1 by wlott, Tue Jan 28 08:09:51 1992 UTC revision 1.33 by rtoy, Tue Apr 20 17:57:45 2010 UTC
# Line 3  Line 3 
3  ;;; **********************************************************************  ;;; **********************************************************************
4  ;;; This code was written as part of the CMU Common Lisp project at  ;;; This code was written as part of the CMU Common Lisp project at
5  ;;; Carnegie Mellon University, and has been placed in the public domain.  ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;; If you want to use this code or any part of CMU Common Lisp, please contact  
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.  
6  ;;;  ;;;
7  (ext:file-comment  (ext:file-comment
8    "$Header$")    "$Header$")
# Line 17  Line 15 
15  ;;;  ;;;
16  ;;;    Written by Rob MacLachlan.  ;;;    Written by Rob MacLachlan.
17  ;;;  ;;;
18  (in-package 'lisp)  (in-package "LISP")
19    (intl:textdomain "cmucl")
20    
21  (export '(internal-time-units-per-second get-internal-real-time  (export '(internal-time-units-per-second get-internal-real-time
22            get-internal-run-time get-universal-time            get-internal-run-time get-universal-time
23            get-decoded-time encode-universal-time decode-universal-time))            get-decoded-time encode-universal-time decode-universal-time))
# Line 30  Line 30 
30    (/ 1000000 internal-time-units-per-second))    (/ 1000000 internal-time-units-per-second))
31    
32    
 (defmacro not-leap-year (year)  
   (let ((sym (gensym)))  
     `(let ((,sym ,year))  
        (cond ((eq (mod ,sym 4) 0)  
               (and (eq (mod ,sym 100) 0)  
                    (not (eq (mod ,sym 400) 0))))  
              (T T)))))  
33    
34    
35  ;;; The base number of seconds for our internal "epoch".  We initialize this to  ;;; The base number of seconds for our internal "epoch".  We initialize this to
# Line 53  Line 46 
46    finding elapsed time.  See Internal-Time-Units-Per-Second."    finding elapsed time.  See Internal-Time-Units-Per-Second."
47    (locally (declare (optimize (speed 3) (safety 0)))    (locally (declare (optimize (speed 3) (safety 0)))
48      (multiple-value-bind (ignore seconds useconds) (unix:unix-gettimeofday)      (multiple-value-bind (ignore seconds useconds) (unix:unix-gettimeofday)
49        (declare (ignore ignore))        (declare (ignore ignore) (type (unsigned-byte 32) seconds useconds))
50        (let ((base *internal-real-time-base-seconds*)        (let ((base *internal-real-time-base-seconds*)
51              (uint (truncate useconds              (uint (truncate useconds
52                              micro-seconds-per-internal-time-unit)))                              micro-seconds-per-internal-time-unit)))
53          (declare (type (unsigned-byte 32) uint))          (declare (type (unsigned-byte 32) uint))
54          (cond (base          (cond (base
55                 (+ (* (the (unsigned-byte 32) (- seconds base))                 (truly-the (unsigned-byte 32)
56                       internal-time-units-per-second)                      (+ (the (unsigned-byte 32)
57                    uint))                              (* (the (unsigned-byte 32) (- seconds base))
58                                   internal-time-units-per-second))
59                           uint)))
60                (t                (t
61                 (setq *internal-real-time-base-seconds* seconds)                 (setq *internal-real-time-base-seconds* seconds)
62                 uint))))))                 uint))))))
# Line 69  Line 64 
64    
65  ;;; Get-Internal-Run-Time  --  Public  ;;; Get-Internal-Run-Time  --  Public
66  ;;;  ;;;
67    #-(and sparc svr4)
68    (defun get-internal-run-time ()
69      _N"Return the run time in the internal time format.  This is useful for
70      finding CPU usage."
71      (declare (values (unsigned-byte 32)))
72      (locally (declare (optimize (speed 3) (safety 0)))
73        (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)
74                             (unix:unix-fast-getrusage unix:rusage_self)
75          (declare (ignore ignore)
76                   (type (unsigned-byte 31) utime-sec stime-sec)
77                   (type (mod 1000000) utime-usec stime-usec))
78          (+ (the (unsigned-byte 32)
79                  (* (the (unsigned-byte 32) (+ utime-sec stime-sec))
80                     internal-time-units-per-second))
81             (truncate (+ utime-usec stime-usec)
82                       micro-seconds-per-internal-time-unit)))))
83    
84    ;;; Get-Internal-Run-Time  --  Public
85    ;;;
86    #+(and sparc svr4)
87  (defun get-internal-run-time ()  (defun get-internal-run-time ()
88    "Return the run time in the internal time format.  This is useful for    _N"Return the run time in the internal time format.  This is useful for
89    finding CPU usage."    finding CPU usage."
90      (declare (values (unsigned-byte 32)))
91    (locally (declare (optimize (speed 3) (safety 0)))    (locally (declare (optimize (speed 3) (safety 0)))
92      (multiple-value-bind (ignore utime stime)      (multiple-value-bind (ignore utime stime cutime cstime)
93                           (unix:unix-getrusage unix:rusage_self)          (unix:unix-times)
94        (declare (ignore ignore))        (declare (ignore ignore cutime cstime)
95        (values (truncate (the (unsigned-byte 32) (+ utime stime))                 (type (unsigned-byte 31) utime stime))
96                          micro-seconds-per-internal-time-unit)))))        (the (unsigned-byte 32) (+ utime stime)))))
97    
98    
99    ;;;; Encode and Decode universal times.
100    
101    ;;; CURRENT-TIMEZONE -- internal.
102    ;;;
103    ;;; Returns two values:
104    ;;;  - the minutes west of GMT.
105    ;;;  - T if daylight savings is in effect, NIL if not.
106    ;;;
107    (alien:def-alien-routine get-timezone c-call:void
108      (when c-call:long :in)
109      (minutes-west c-call:int :out)
110      (daylight-savings-p alien:boolean :out))
111    
112    
113  ;;; Subtract from the returned Internal_Time to get the universal time.  ;;; Subtract from the returned Internal_Time to get the universal time.
114  ;;; The offset between our time base and the Perq one is 2145 weeks and  ;;; The offset between our time base and the Perq one is 2145 weeks and
115  ;;; five days.  ;;; five days.
# Line 94  Line 124 
124  (defconstant weekday-november-17-1858 2)  (defconstant weekday-november-17-1858 2)
125  (defconstant unix-to-universal-time 2208988800)  (defconstant unix-to-universal-time 2208988800)
126    
 ;;; Make-Universal-Time  --  Internal  
 ;;;  
 ;;;    Convert a Unix Internal_Time into a universal time.  
 ;;;  
 (defun make-universal-time (weeks msec)  
   (+ (* (- weeks weeks-offset) seconds-in-week)  
      (- (truncate msec 1000) seconds-offset)))  
   
127    
128  ;;; Get-Universal-Time  --  Public  ;;; Get-Universal-Time  --  Public
129  ;;;  ;;;
# Line 119  Line 141 
141     (daylight savings times) or NIL (standard time), and timezone."     (daylight savings times) or NIL (standard time), and timezone."
142    (decode-universal-time (get-universal-time)))    (decode-universal-time (get-universal-time)))
143    
144    
145  (defun decode-universal-time (universal-time &optional time-zone)  (defun decode-universal-time (universal-time &optional time-zone)
146    "Converts a universal-time to decoded time format returning the following    "Converts a universal-time to decoded time format returning the following
147    nine values: second, minute, hour, date, month, year, day of week (0 =     nine values: second, minute, hour, date, month, year, day of week (0 =
148    Monday), T (daylight savings time) or NIL (standard time), and timezone.     Monday), T (daylight savings time) or NIL (standard time), and timezone.
149    Completely ignores daylight-savings-time when time-zone is supplied."     Completely ignores daylight-savings-time when time-zone is supplied."
150    (declare (type (or fixnum null) time-zone))    (multiple-value-bind (daylight timezone)
151    (multiple-value-bind (weeks secs)        (if time-zone
152                         (truncate (+ universal-time seconds-offset)            (values nil (* time-zone 60 60))
153                                   seconds-in-week)            (multiple-value-bind
154      (let ((weeks (+ weeks weeks-offset))                  (ignore minwest dst)
155            (second NIL)                (get-timezone (- universal-time unix-to-universal-time))
156            (minute NIL)              (declare (ignore ignore))
157            (hour NIL)              (values dst (* minwest 60))))
158            (date NIL)      (declare (fixnum timezone))
159            (month NIL)      (multiple-value-bind (weeks secs)
160            (year NIL)          (truncate (+ (- universal-time timezone) seconds-offset)
161            (day NIL)                    seconds-in-week)
162            (daylight NIL)        (let ((weeks (+ weeks weeks-offset)))
163            (timezone (if (null time-zone)          (multiple-value-bind (t1 second)
164                          (multiple-value-bind (res s us tz)              (truncate secs 60)
165                                               (unix:unix-gettimeofday)            (let ((tday (truncate t1 minutes-per-day)))
166                            (declare (ignore s us))              (multiple-value-bind (hour minute)
167                            (if res tz 0))                  (truncate (- t1 (* tday minutes-per-day)) 60)
168                          (* time-zone 60))))                (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
169        (declare (fixnum timezone))                       (tcent (truncate t2 quarter-days-per-century)))
170        (multiple-value-bind (t1 seconds) (truncate secs 60)                  (setq t2 (mod t2 quarter-days-per-century))
171          (setq second seconds)                  (setq t2 (+ (- t2 (mod t2 4)) 3))
172          (setq t1 (- t1 timezone))                  (let* ((year (+ (* tcent 100)
173          (let* ((tday (if (< t1 0)                                  (truncate t2 quarter-days-per-year)))
174                           (1- (truncate (1+ t1) minutes-per-day))                         (days-since-mar0
175                           (truncate t1 minutes-per-day))))                          (1+ (truncate (mod t2 quarter-days-per-year) 4)))
176            (multiple-value-setq (hour minute)                         (day (mod (+ tday weekday-november-17-1858) 7))
177              (truncate (- t1 (* tday minutes-per-day)) 60))                         (t3 (+ (* days-since-mar0 5) 456)))
178            (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))                    (cond ((>= t3 1989)
179                   (tcent (truncate t2 quarter-days-per-century)))                           (setq t3 (- t3 1836))
180              (setq t2 (mod t2 quarter-days-per-century))                           (setq year (1+ year))))
181              (setq t2 (+ (- t2 (mod t2 4)) 3))                    (multiple-value-bind (month t3)
182              (setq year (+ (* tcent 100) (truncate t2 quarter-days-per-year)))                        (truncate t3 153)
183              (let ((days-since-mar0 (1+ (truncate (mod t2 quarter-days-per-year)                      (let ((date (1+ (truncate t3 5))))
184                                                   4))))                        (values second minute hour date month year day
185                (setq day (mod (+ tday weekday-november-17-1858) 7))                                daylight
186                (unless time-zone                                (if daylight
187                  (if (setq daylight (dst-check days-since-mar0 hour day))                                    (1+ (/ timezone 60 60))
188                      (cond ((eq hour 23)                                    (/ timezone 60 60))))))))))))))
189                             (setq hour 0)  
190                             (setq day (mod (1+ day) 7))  
191                             (setq days-since-mar0 (1+ days-since-mar0))  (defun pick-obvious-year (year)
192                             (if (>= days-since-mar0 366)    (declare (type (mod 100) year))
193                                 (if (or (> days-since-mar0 366)    (let* ((current-year (nth-value 5 (get-decoded-time)))
194                                         (not-leap-year (1+ year)))           (guess (+ year (* (truncate (- current-year 50) 100) 100))))
195                                     (setq days-since-mar0 368))))      (declare (type (integer 1900 9999) current-year guess))
196                            (T (setq hour (1+ hour))))))      (if (> (- current-year guess) 50)
197                (let ((t3 (+ (* days-since-mar0 5) 456)))          (+ guess 100)
198                  (cond ((>= t3 1989)          guess)))
199                         (setq t3 (- t3 1836))  
200                         (setq year (1+ year))))  (defun leap-years-before (year)
201                  (multiple-value-setq (month t3) (truncate t3 153))    (let ((years (- year 1901)))
202                  (setq date (1+ (truncate t3 5))))))))      (+ (- (truncate years 4)
203        (values second minute hour date month year day            (truncate years 100))
204                daylight (truncate timezone 60)))))         (truncate (+ years 300) 400))))
205    
206    (defvar *days-before-month*
207      (collect ((results))
208        (results nil)
209        (let ((sum 0))
210          (dolist (days-per-month '(31 28 31 30 31 30 31 31 30 31 30 31))
211            (results sum)
212            (incf sum days-per-month)))
213        (coerce (results) 'vector)))
214    
215  ;;; Encode-Universal-Time  --  Public  ;;; Encode-Universal-Time  --  Public
216  ;;;  ;;;
 ;;;    Just do a TimeUser:T_UserToInt.  If the year is between 0 and 99 we  
 ;;; have to figure out which the "obvious" year is.  
 ;;;  
   
217  (defun encode-universal-time (second minute hour date month year  (defun encode-universal-time (second minute hour date month year
218                                       &optional time-zone)                                       &optional time-zone)
219    "The time values specified in decoded format are converted to    "The time values specified in decoded format are converted to
220     universal time, which is returned."     universal time, which is returned."
221      (declare (type (mod 60) second)
222               (type (mod 60) minute)
223               (type (mod 24) hour)
224               (type (integer 1 31) date)
225               (type (integer 1 12) month)
226               (type (or (integer 0 99) (integer 1900)) year)
227               (type (or null rational) time-zone))
228    (let* ((year (if (< year 100)    (let* ((year (if (< year 100)
229                     (multiple-value-bind (sec min hour day month now-year)                     (pick-obvious-year year)
                                         (get-decoded-time)  
                      (declare (ignore sec min hour day month))  
                      (do ((y (+ year (* 100 (1- (truncate now-year 100))))  
                              (+ y 100)))  
                          ((<= (abs (- y now-year)) 50) y)))  
230                     year))                     year))
231           (zone (if time-zone (* time-zone 60)           (days (+ (1- date)
232                     (multiple-value-bind (res s us tz) (unix:unix-gettimeofday)                    (aref *days-before-month* month)
233                       (declare (ignore s us))                    (if (> month 2)
234                       (if res tz))))                        (leap-years-before (1+ year))
235           (tmonth (- month 3)))                        (leap-years-before year))
236      (cond ((< tmonth 0)                    (* (- year 1900) 365)))
237             (setq tmonth (+ tmonth 12))           (hours (+ hour (* days 24))))
238             (setq year (1- year))))      (if time-zone
239      (let ((days-since-mar0 (+ (truncate (+ (* tmonth 153) 2) 5) date)))          (+ second (* (+ minute (* (+ hours time-zone) 60)) 60))
240        (multiple-value-bind (tcent tyear) (truncate year 100)          (let* ((minwest-guess
241          (let* ((tday (- (+ (truncate (* tcent quarter-days-per-century) 4)                  (nth-value 1
242                             (truncate (* tyear quarter-days-per-year) 4)                             (get-timezone (- (* hours 60 60)
243                             days-since-mar0)                                              unix-to-universal-time))))
244                          november-17-1858))                 (guess (+ minute (* hours 60) minwest-guess))
245                 (daylight (dst-check days-since-mar0 (1- hour)                 (minwest
246                                      (mod (+ tday weekday-november-17-1858) 7)))                  (nth-value 1
247                 (tminutes (+ (* hour 60) minute zone)))                             (get-timezone (- (* guess 60)
248            (if daylight (setq tminutes (- tminutes 60)))                                              unix-to-universal-time)))))
249            (do ((i tminutes (+ i minutes-per-day)))            (+ second (* (+ guess (- minwest minwest-guess)) 60))))))
250                ((>= i 0) (setq tminutes i))  
             (declare (fixnum i))  
             (decf tday 1))  
           (do ((i tminutes (- i minutes-per-day)))  
               ((< i minutes-per-day) (setq tminutes i))  
             (declare (fixnum i))  
             (incf tday 1))  
           (multiple-value-bind (weeks dpart) (truncate tday 7)  
             (make-universal-time weeks (* (+ (* (+ (* dpart minutes-per-day)  
                                                    tminutes) 60)  
                                              second) 1000))))))))  
   
 ;;; Dst-check -- Internal  
 (defconstant april-1 (+ (truncate (+ (* (- 4 3) 153) 2) 5) 1))  
 (defconstant october-31 (+ (truncate (+ (* (- 10 3) 153) 2) 5) 31))  
   
 (eval-when (compile eval)  
   
   (defmacro dst-check-start-of-month-ge (day hour weekday daybound)  
     (let ((d (gensym))  
           (h (gensym))  
           (w (gensym))  
           (db (gensym)))  
       `(let ((,d ,day)  
              (,h ,hour)  
              (,w ,weekday)  
              (,db ,daybound))  
          (declare (fixnum ,d ,h ,w ,db))  
          (cond ((< ,d ,db) NIL)  
                ((> (the fixnum (- ,d ,w)) ,db) T)  
                ((and (eq ,w 6) (> ,h 0)) T)  
                (T NIL)))))  
   
   (defmacro dst-check-end-of-month-ge (day hour weekday daybound)  
     (let ((d (gensym))  
           (h (gensym))  
           (w (gensym))  
           (db (gensym)))  
       `(let ((,d ,day)  
              (,h ,hour)  
              (,w ,weekday)  
              (,db ,daybound))  
          (declare (fixnum ,d ,h ,w ,db))  
          (cond ((< (the fixnum (+ ,d 6)) ,db) NIL)  
                ((> (the fixnum  (- (the fixnum (+ ,d 6)) ,w)) ,db) T)  
                ((and (eq ,w 6) (> ,h 0)) T)  
                (T NIL)))))  
   )  
   
 (defun dst-check (day hour weekday)  
   (and (dst-check-start-of-month-ge day hour weekday april-1)  
        (not (dst-check-end-of-month-ge day hour weekday october-31))))  
251    
252  ;;;; Time:  ;;;; Time:
253    
# Line 288  Line 267 
267        (declare (ignore def))        (declare (ignore def))
268        (cond        (cond
269         (env-p         (env-p
270          (warn "TIME form in a non-null environment, forced to interpret.~@          (warn (intl:gettext "TIME form in a non-null environment, forced to interpret.~@
271                 Compiling entire form will produce more accurate times.")                 Compiling entire form will produce more accurate times."))
272          fun)          fun)
273         (t         (t
274          (compile nil fun)))))          (compile nil fun)))))
# Line 297  Line 276 
276    
277  ;;; TIME-GET-SYS-INFO  --  Internal  ;;; TIME-GET-SYS-INFO  --  Internal
278  ;;;  ;;;
279  ;;;    Return all the files that we want time to report.  ;;;    Return all the values that we want time to report.
280  ;;;  ;;;
281  (defun time-get-sys-info ()  (defun time-get-sys-info ()
282    (multiple-value-bind (user sys faults)    (multiple-value-bind (user sys faults)
283                         (system:get-system-info)                         (system:get-system-info)
284      (values user sys faults (get-bytes-consed))))      (values user sys faults (get-bytes-consed))))
285    
286    #+(or pentium sparc-v9)
287    (defun cycle-count/float ()
288      (multiple-value-bind (lo hi)
289          (vm::read-cycle-counter)
290        (+ (* hi (expt 2.0d0 32)) lo)))
291    #+ppc
292    (progn
293    (alien:def-alien-variable cycles-per-tick c-call:int)
294    (defun cycle-count/float ()
295      (multiple-value-bind (lo hi)
296          (vm::read-cycle-counter)
297        ;; The cycle counter on PPC isn't really a cycle counter.  It
298        ;; counts ticks, so we need to convert ticks to cycles.
299        ;; CYCLES-PER-TICK is the scale factor, computed in C.
300        (* cycles-per-tick (+ (* hi (expt 2.0d0 32)) lo))))
301    )
302    
303    #-(or pentium sparc-v9 ppc)
304    (defun cycle-count/float () 0.0)
305    
306    (defvar *time-consing* nil)
307    (defvar *last-time-consing* nil)
308    (defvar *in-get-time-consing* nil)
309    
310    (defun get-time-consing ()
311      (when (and (null *time-consing*) (not *in-get-time-consing*))
312        (let ((*in-get-time-consing* t))
313          (time nil)
314          (setq *time-consing* *last-time-consing*))))
315    
316    
317  ;;; %TIME  --  Internal  ;;; %TIME  --  Internal
318  ;;;  ;;;
319  ;;;    The guts of the TIME macro.  Compute overheads, run the (compiled)  ;;;    The guts of the TIME macro.  Compute overheads, run the (compiled)
# Line 322  Line 332 
332          real-time-overhead          real-time-overhead
333          run-utime-overhead          run-utime-overhead
334          run-stime-overhead          run-stime-overhead
335            cycle-count
336          page-faults-overhead          page-faults-overhead
337          old-bytes-consed          old-bytes-consed
338          new-bytes-consed          new-bytes-consed
339          cons-overhead)          cons-overhead)
340        (get-time-consing)
341      ;; Calculate the overhead...      ;; Calculate the overhead...
342      (multiple-value-setq      (multiple-value-setq
343          (old-run-utime old-run-stime old-page-faults old-bytes-consed)          (old-run-utime old-run-stime old-page-faults old-bytes-consed)
# Line 346  Line 358 
358      (setq real-time-overhead (- new-real-time old-real-time))      (setq real-time-overhead (- new-real-time old-real-time))
359      (setq cons-overhead (- new-bytes-consed old-bytes-consed))      (setq cons-overhead (- new-bytes-consed old-bytes-consed))
360      ;; Now get the initial times.      ;; Now get the initial times.
361        (setq old-real-time (get-internal-real-time))
362      (multiple-value-setq      (multiple-value-setq
363          (old-run-utime old-run-stime old-page-faults old-bytes-consed)          (old-run-utime old-run-stime old-page-faults old-bytes-consed)
364        (time-get-sys-info))        (time-get-sys-info))
365      (setq old-real-time (get-internal-real-time))      (let ((start-gc-run-time *gc-run-time*))
366        (setq cycle-count (- (cycle-count/float)))
367      (multiple-value-prog1      (multiple-value-prog1
368          ;; Execute the form and return its values.          ;; Execute the form and return its values.
369          (funcall fun)          (funcall fun)
370          (incf cycle-count (cycle-count/float))
371        (multiple-value-setq        (multiple-value-setq
372          (new-run-utime new-run-stime new-page-faults new-bytes-consed)            (new-run-utime new-run-stime new-page-faults new-bytes-consed)
373        (time-get-sys-info))          (time-get-sys-info))
374        (setq new-real-time (- (get-internal-real-time) real-time-overhead))        (setq new-real-time (- (get-internal-real-time) real-time-overhead))
375        (format *trace-output*        (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0))
376                "~&Evaluation took:~%  ~              (bytes-consed (- new-bytes-consed old-bytes-consed cons-overhead)))
377                ~S second~:P of real time~%  ~          (unless *in-get-time-consing*
378                ~S second~:P of user run time~%  ~            (terpri *trace-output*)
379                ~S second~:P of system run time~%  ~            (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")
380                ~S page fault~:P and~%  ~              (format *trace-output*
381                ~S bytes consed.~%"                      (intl:gettext "Evaluation took:~%  ~
382                (max (/ (- new-real-time old-real-time)                       ~S seconds of real time~%  ~
383                        (float internal-time-units-per-second))                       ~S seconds of user run time~%  ~
384                     0.0)                       ~S seconds of system run time~%  ")
385                (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)                      (max (/ (- new-real-time old-real-time)
386                (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)                              (float internal-time-units-per-second))
387                (max (- new-page-faults old-page-faults) 0)                           0.0)
388                (max (- new-bytes-consed old-bytes-consed) 0)))))                      (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
389                        (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0))
390                (format *trace-output*
391                        (intl:ngettext
392                         "~:D ~A cycle~%  ~
393                         ~@[[Run times include ~S seconds GC run time]~%  ~]"
394                         "~:D ~A cycles~%  ~
395                         ~@[[Run times include ~S seconds GC run time]~%  ~]"
396                         (truncate cycle-count))
397                        (truncate cycle-count)
398                        "CPU"
399                        (unless (zerop gc-run-time)
400                          (/ (float gc-run-time)
401                             (float internal-time-units-per-second))))
402                (format *trace-output*
403                        (intl:ngettext "~S page fault and~%  "
404                                       "~S page faults and~%  "
405                                       (max (- new-page-faults old-page-faults) 0))
406                        (max (- new-page-faults old-page-faults) 0))
407                (format *trace-output*
408                        (intl:ngettext "~:D byte consed.~%"
409                                       "~:D bytes consed.~%"
410                                       (max (- bytes-consed (or *time-consing* 0)) 0))
411                        (max (- bytes-consed (or *time-consing* 0)) 0)))
412              (terpri *trace-output*))
413            (setq *last-time-consing* bytes-consed))))))

Legend:
Removed from v.1.8.1.1  
changed lines
  Added in v.1.33

  ViewVC Help
Powered by ViewVC 1.1.5