/[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 by rtoy, Sun Aug 9 03:54:42 2009 UTC revision 1.30.10.2 by rtoy, Wed Feb 10 04:01:27 2010 UTC
# Line 16  Line 16 
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))
24    
25  (defconstant internal-time-units-per-second 100  (defconstant internal-time-units-per-second 100
26    "The number of internal time units that fit into a second.  See    _N"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 40  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    "Return the real time in the internal time format.  This is useful for    _N"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 64  Line 66 
66  ;;;  ;;;
67  #-(and sparc svr4)  #-(and sparc svr4)
68  (defun get-internal-run-time ()  (defun get-internal-run-time ()
69    "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
70    finding CPU usage."    finding CPU usage."
71    (declare (values (unsigned-byte 32)))    (declare (values (unsigned-byte 32)))
72    (locally (declare (optimize (speed 3) (safety 0)))    (locally (declare (optimize (speed 3) (safety 0)))
# Line 83  Line 85 
85  ;;;  ;;;
86  #+(and sparc svr4)  #+(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)))    (declare (values (unsigned-byte 32)))
91    (locally (declare (optimize (speed 3) (safety 0)))    (locally (declare (optimize (speed 3) (safety 0)))
# Line 127  Line 129 
129  ;;;  ;;;
130  ;;;  ;;;
131  (defun get-universal-time ()  (defun get-universal-time ()
132    "Returns a single integer for the current time of    _N"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    "Returns nine values specifying the current time as follows:    _N"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    "Converts a universal-time to decoded time format returning the following    _N"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 214  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    "The time values specified in decoded format are converted to    _N"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 250  Line 252 
252  ;;;; Time:  ;;;; Time:
253    
254  (defmacro time (form)  (defmacro time (form)
255    "Evaluates the Form and prints timing information on *Trace-Output*."    _N"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

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.30.10.2

  ViewVC Help
Powered by ViewVC 1.1.5