Changeset 13536 for release


Ignore:
Timestamp:
Mar 16, 2010, 6:40:24 PM (9 years ago)
Author:
rme
Message:

Merge r13525 from trunk to 1.4 branch (fix fractional durations in
%timed-wait-on-semaphore-ptr).

Location:
release/1.4/source
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/1.4/source

  • release/1.4/source/compiler

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • release/1.4/source/level-0/X86

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • release/1.4/source/level-1/linux-files.lisp

    r13424 r13536  
    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)
  • release/1.4/source/lisp-kernel

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • release/1.4/source/scripts

    • Property svn:mergeinfo changed (with no actual effect on merging)
Note: See TracChangeset for help on using the changeset viewer.