Changeset 13526


Ignore:
Timestamp:
Mar 12, 2010, 9:47:33 PM (9 years ago)
Author:
gz
Message:

From trunk: fix time computations in %timed-wait-on-semaphore-ptr (r13414, r13415, r13525)

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl

  • branches/working-0711/ccl/level-1/linux-files.lisp

    r13303 r13526  
    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 1000)
    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                         (floor diff 1000)
     152                    (multiple-value-bind (remaining-seconds remaining-itus)
     153                        (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.