/[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.30.12.1 by rtoy, Thu Feb 25 20:34:52 2010 UTC revision 1.33 by rtoy, Tue Apr 20 17:57:45 2010 UTC
# Line 23  Line 23 
23            get-decoded-time encode-universal-time decode-universal-time))            get-decoded-time encode-universal-time decode-universal-time))
24    
25  (defconstant internal-time-units-per-second 100  (defconstant internal-time-units-per-second 100
26    _N"The number of internal time units that fit into a second.  See    "The number of internal time units that fit into a second.  See
27    Get-Internal-Real-Time and Get-Internal-Run-Time.")    Get-Internal-Real-Time and Get-Internal-Run-Time.")
28    
29  (defconstant micro-seconds-per-internal-time-unit  (defconstant micro-seconds-per-internal-time-unit
# Line 42  Line 42 
42  ;;; Get-Internal-Real-Time  --  Public  ;;; Get-Internal-Real-Time  --  Public
43  ;;;  ;;;
44  (defun get-internal-real-time ()  (defun get-internal-real-time ()
45    _N"Return the real time in the internal time format.  This is useful for    "Return the real time in the internal time format.  This is useful for
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)
# Line 129  Line 129 
129  ;;;  ;;;
130  ;;;  ;;;
131  (defun get-universal-time ()  (defun get-universal-time ()
132    _N"Returns a single integer for the current time of    "Returns a single integer for the current time of
133     day in universal time format."     day in universal time format."
134    (multiple-value-bind (res secs) (unix:unix-gettimeofday)    (multiple-value-bind (res secs) (unix:unix-gettimeofday)
135      (declare (ignore res))      (declare (ignore res))
136      (+ secs unix-to-universal-time)))      (+ secs unix-to-universal-time)))
137    
138  (defun get-decoded-time ()  (defun get-decoded-time ()
139    _N"Returns nine values specifying the current time as follows:    "Returns nine values specifying the current time as follows:
140     second, minute, hour, date, month, year, day of week (0 = Monday), T     second, minute, hour, date, month, year, day of week (0 = Monday), T
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    _N"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."
# Line 216  Line 216 
216  ;;;  ;;;
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    _N"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)    (declare (type (mod 60) second)
222             (type (mod 60) minute)             (type (mod 60) minute)
# Line 252  Line 252 
252  ;;;; Time:  ;;;; Time:
253    
254  (defmacro time (form)  (defmacro time (form)
255    _N"Evaluates the Form and prints timing information on *Trace-Output*."    "Evaluates the Form and prints timing information on *Trace-Output*."
256    `(%time #'(lambda () ,form)))    `(%time #'(lambda () ,form)))
257    
258  ;;; MASSAGE-TIME-FUNCTION  --  Internal  ;;; MASSAGE-TIME-FUNCTION  --  Internal
# Line 267  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 378  Line 378 
378            (terpri *trace-output*)            (terpri *trace-output*)
379            (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")            (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")
380              (format *trace-output*              (format *trace-output*
381                      "Evaluation took:~%  ~                      (intl:gettext "Evaluation took:~%  ~
382                       ~S second~:P of real time~%  ~                       ~S seconds of real time~%  ~
383                       ~S second~:P of user run time~%  ~                       ~S seconds of user run time~%  ~
384                       ~S second~:P of system run time~%  ~                       ~S seconds of system run time~%  ")
                      ~:D ~A cycles~%  ~  
                      ~@[[Run times include ~S second~:P GC run time]~%  ~]~  
                      ~S page fault~:P and~%  ~  
                      ~:D bytes consed.~%"  
385                      (max (/ (- new-real-time old-real-time)                      (max (/ (- new-real-time old-real-time)
386                              (float internal-time-units-per-second))                              (float internal-time-units-per-second))
387                           0.0)                           0.0)
388                      (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)                      (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
389                      (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)                      (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)                      (truncate cycle-count)
398                      "CPU"                      "CPU"
399                      (unless (zerop gc-run-time)                      (unless (zerop gc-run-time)
400                        (/ (float gc-run-time)                        (/ (float gc-run-time)
401                           (float internal-time-units-per-second)))                           (float internal-time-units-per-second))))
402                      (max (- new-page-faults old-page-faults) 0)              (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)))                      (max (- bytes-consed (or *time-consing* 0)) 0)))
412            (terpri *trace-output*))            (terpri *trace-output*))
413          (setq *last-time-consing* bytes-consed))))))          (setq *last-time-consing* bytes-consed))))))

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

  ViewVC Help
Powered by ViewVC 1.1.5