Changeset 6141


Ignore:
Timestamp:
Apr 6, 2007, 10:20:25 AM (13 years ago)
Author:
gb
Message:

Wait in larger chunks when waiting for a semaphore. Don't use
PROCESS-WAIT, but set the whostate manually if we have to wait.
Do the same thing in timed-wait-on-semaphore.


File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/level-1/linux-files.lisp

    r6127 r6141  
    7676
    7777(defun %process-wait-on-semaphore-ptr (s seconds milliseconds &optional
    78                                        (whostate "semaphore wait") flag)
    79   (process-wait whostate #'%wait-on-semaphore-ptr s seconds milliseconds flag))
     78                                         (whostate "semaphore wait") flag)
     79  (or (%wait-on-semaphore-ptr s 0 0 flag)
     80      (with-process-whostate  (whostate)
     81        (loop
     82          (when (%wait-on-semaphore-ptr s seconds milliseconds flag)
     83            (return))))))
     84
    8085 
    8186(defun wait-on-semaphore (s &optional flag (whostate "semaphore wait"))
    8287  "Wait until the given semaphore has a positive count which can be
    8388atomically decremented."
    84   (%process-wait-on-semaphore-ptr (semaphore-value s) 1 0 whostate flag)
     89  (%process-wait-on-semaphore-ptr (semaphore-value s) #xffffff 0 whostate flag)
    8590  t)
    8691
    8792
    8893(defun %timed-wait-on-semaphore-ptr (semptr duration notification)
    89   (multiple-value-bind (secs millis) (milliseconds duration)
    90     (let* ((now (get-internal-real-time))
    91            (stop (+ now
    92                     (* secs 1000)
    93                     millis)))
    94       (loop
    95         (multiple-value-bind (success err)
    96             (progn
    97               (%wait-on-semaphore-ptr semptr secs millis notification))
    98           (when success
    99             (return t))
    100           (when (or (not (eql err #$EINTR))
    101                     (>= (setq now (get-internal-real-time)) stop))
    102             (return nil))
    103           (unless (zerop duration)
    104             (let* ((diff (- stop now)))
    105               (multiple-value-bind (remaining-seconds remaining-millis)
    106                   (floor diff 1000)
    107                 (setq secs remaining-seconds
    108                       millis remaining-millis)))))))))
     94  (or (%wait-on-semaphore-ptr semptr 0 0 notification)
     95      (with-process-whostate ("Semaphore timed wait")
     96        (multiple-value-bind (secs millis) (milliseconds duration)
     97          (let* ((now (get-internal-real-time))
     98                 (stop (+ now
     99                          (* secs 1000)
     100                          millis)))
     101            (loop
     102              (multiple-value-bind (success err)
     103                  (progn
     104                    (%wait-on-semaphore-ptr semptr secs millis notification))
     105                (when success
     106                  (return t))
     107                (when (or (not (eql err #$EINTR))
     108                          (>= (setq now (get-internal-real-time)) stop))
     109                  (return nil))
     110                (unless (zerop duration)
     111                  (let* ((diff (- stop now)))
     112                    (multiple-value-bind (remaining-seconds remaining-millis)
     113                        (floor diff 1000)
     114                      (setq secs remaining-seconds
     115                            millis remaining-millis)))))))))))
    109116
    110117(defun timed-wait-on-semaphore (s duration &optional notification)
Note: See TracChangeset for help on using the changeset viewer.