Changeset 13525


Ignore:
Timestamp:
Mar 12, 2010, 9:44:17 PM (10 years ago)
Author:
gz
Message:

Fix handling of fractional durations in %timed-wait-on-semaphore-ptr. Also, tweak some code I found confusing, in nanoseconds/milliseconds/microseconds functions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/linux-files.lisp

    r13415 r13525  
    5959      (%get-cstring pointer))))
    6060
    61 (defun nanoseconds (n)
    62   (unless (and (typep n 'fixnum)
    63                (>= (the fixnum n) 0))
    64     (check-type n (real 0 #.(1- (ash 1 (1- target::nbits-in-word))))))
     61(defun nanoseconds (seconds)
     62  (when (and (typep seconds 'fixnum)
     63             (>= (the fixnum seconds) 0))
     64    (return-from nanoseconds (values seconds 0)))
     65  (check-type seconds (real 0 #.(1- (ash 1 (1- target::nbits-in-word)))))
    6566  (multiple-value-bind (q r)
    66       (floor n)
     67      (floor seconds)
    6768    (if (zerop r)
    6869      (setq r 0)
     
    7071    (values q r)))
    7172
    72 (defun milliseconds (n)
    73   (unless (and (typep n 'fixnum)
    74                (>= (the fixnum n) 0))
    75     (check-type n (real 0 #.(1- (ash 1 (1- target::nbits-in-word))))))
     73(defun milliseconds (seconds)
     74  (when (and (typep seconds 'fixnum)
     75             (>= (the fixnum seconds) 0))
     76    (return-from milliseconds (values seconds 0)))
     77  (check-type seconds (real 0 #.(1- (ash 1 (1- target::nbits-in-word)))))
    7678  (multiple-value-bind (q r)
    77       (floor n)
     79      (floor seconds)
    7880    (if (zerop r)
    7981      (setq r 0)
     
    8183    (values q r)))
    8284
    83 (defun microseconds (n)
    84   (unless (and (typep n 'fixnum)
    85                (>= (the fixnum n) 0))
    86     (check-type n (real 0 #.(1- (ash 1 (1- target::nbits-in-word))))))
     85(defun microseconds (seconds)
     86  (when (and (typep seconds 'fixnum)
     87             (>= (the fixnum seconds) 0))
     88    (return-from microseconds (values seconds 0)))
     89  (check-type seconds (real 0 #.(1- (ash 1 (1- target::nbits-in-word)))))
    8790  (multiple-value-bind (q r)
    88       (floor n)
     91      (floor seconds)
    8992    (if (zerop r)
    9093      (setq r 0)
     
    133136  (or (%wait-on-semaphore-ptr semptr 0 0 notification)
    134137      (with-process-whostate ("Semaphore timed wait")
    135         (multiple-value-bind (secs millis) (milliseconds duration)
    136           (let* ((now (get-internal-real-time))
    137                  (stop (+ now
    138                           (* secs internal-time-units-per-second)
    139                           millis)))
     138        (let* ((now (get-internal-real-time))
     139               (stop (+ now (floor (* duration internal-time-units-per-second)))))
     140          (multiple-value-bind (secs millis) (milliseconds duration)
    140141            (loop
    141142              (multiple-value-bind (success err)
     
    149150                (unless (zerop duration)
    150151                  (let* ((diff (- stop now)))
    151                     (multiple-value-bind (remaining-seconds remaining-millis)
     152                    (multiple-value-bind (remaining-seconds remaining-itus)
    152153                        (floor diff internal-time-units-per-second)
    153154                      (setq secs remaining-seconds
    154                             millis remaining-millis)))))))))))
     155                            millis (floor remaining-itus (/ internal-time-units-per-second 1000)))))))))))))
    155156
    156157(defun timed-wait-on-semaphore (s duration &optional notification)
Note: See TracChangeset for help on using the changeset viewer.