Ignore:
Timestamp:
Oct 14, 2008, 6:30:00 PM (13 years ago)
Author:
gz
Message:

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/time.lisp

    r7955 r11089  
    4343         (funk (%incf-ptr copy timeval-size)))))))
    4444
    45 (defun get-universal-time ()
    46   "Return a single integer for the current time of
    47    day in universal time format."
    48   (rlet ((tv :timeval))
    49     (#_gettimeofday tv (%null-ptr))
    50     (+ (pref tv :timeval.tv_sec) unix-to-universal-time)))
     45
     46
    5147
    5248;;; This should stop using #_localtime_r: not all times can be represented
     
    5450;;; For now, if the time won't fit in a :time_t, use an arbitrary time
    5551;;; value to get the time zone and assume that DST was -not- in effect.
     52#-windows-target
    5653(defun get-timezone (time)
    5754  (let* ((toobig (not (typep time '(unsigned-byte
     
    6764          (values 0 nil)
    6865          (progn
    69             (values (floor (pref tm :tm.tm_gmtoff) -60)
     66            (values (floor #-solaris-target (pref tm :tm.tm_gmtoff)
     67                           #+solaris-target #&altzone
     68                           -60)
    7069                    (unless toobig (not (zerop (pref tm :tm.tm_isdst)))))))))))
     70
     71#+windows-target
     72(defun get-timezone (time)
     73  (declare (ignore time))
     74  (rlet ((tzinfo #>TIME_ZONE_INFORMATION))
     75    (let* ((id (#_GetTimeZoneInformation tzinfo))
     76           (minutes-west (pref tzinfo #>TIME_ZONE_INFORMATION.Bias))
     77           (is-dst (= id #$TIME_ZONE_ID_DAYLIGHT)))
     78      (values (floor (+ minutes-west
     79                        (if is-dst
     80                          (pref tzinfo #>TIME_ZONE_INFORMATION.DaylightBias)
     81                          0)))
     82              is-dst))))
    7183
    7284
     
    189201
    190202
     203#+windows-target
     204(defun %windows-sleep (millis)
     205  (do* ((start (floor (get-internal-real-time)
     206                      (floor internal-time-units-per-second 1000))
     207               (floor (get-internal-real-time)
     208                      (floor internal-time-units-per-second 1000)))
     209        (millis millis (- stop start))
     210        (stop (+ start millis)))
     211       ((or (<= millis 0)
     212            (not (eql (#_SleepEx millis #$true) #$WAIT_IO_COMPLETION))))))
    191213
    192214(defun sleep (seconds)
     
    194216  be any non-negative, non-complex number."
    195217  (when (minusp seconds) (report-bad-arg seconds '(real 0 *)))
     218  #-windows-target
    196219  (multiple-value-bind (secs nanos)
    197220      (nanoseconds seconds)
    198     (%nanosleep secs nanos)))
    199 
    200 (defun get-internal-run-time ()
    201   "Return the run time in the internal time format. (See
    202   INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
     221    (%nanosleep secs nanos))
     222  #+windows-target
     223  (%windows-sleep (round (* seconds 1000))))
     224
     225
     226(defun %internal-run-time ()
     227  ;; Returns user and system times in internal-time-units as multiple values.
     228  #-windows-target
    203229  (rlet ((usage :rusage))
    204230    (%%rusage usage)
     
    207233           (user-micros (pref usage :rusage.ru_utime.tv_usec))
    208234           (system-micros (pref usage :rusage.ru_stime.tv_usec)))
    209       (+ (* (+ user-seconds system-seconds) internal-time-units-per-second)
    210          (round (+ user-micros system-micros) (floor 1000000 internal-time-units-per-second))))))
     235      (values (+ (* user-seconds internal-time-units-per-second)
     236                 (round user-micros (floor 1000000 internal-time-units-per-second)))
     237              (+ (* system-seconds internal-time-units-per-second)
     238                 (round system-micros (floor 1000000 internal-time-units-per-second))))))
     239  #+windows-target
     240  (rlet ((start #>FILETIME)
     241         (end #>FILETIME)
     242         (kernel #>FILETIME)
     243         (user #>FILETIME))
     244    (#_GetProcessTimes (#_GetCurrentProcess) start end kernel user)
     245    (let* ((user-100ns (dpb (pref user #>FILETIME.dwHighDateTime)
     246                            (byte 32 32)
     247                            (pref user #>FILETIME.dwLowDateTime)))
     248           (kernel-100ns (dpb (pref kernel #>FILETIME.dwHighDateTime)
     249                            (byte 32 32)
     250                            (pref kernel #>FILETIME.dwLowDateTime)))
     251           (convert (floor 10000000 internal-time-units-per-second)))
     252      (values (floor user-100ns convert) (floor kernel-100ns convert)))))
     253
     254(defun get-internal-run-time ()
     255  "Return the run time in the internal time format. (See
     256  INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
     257  (multiple-value-bind (user sys) (%internal-run-time)
     258    (+ user sys)))
    211259
    212260
Note: See TracChangeset for help on using the changeset viewer.