/[mcclim]/mcclim/input.lisp
ViewVC logotype

Diff of /mcclim/input.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.32 by hefner1, Sun Oct 31 01:46:31 2004 UTC revision 1.33 by tmoore, Fri Jul 1 12:59:39 2005 UTC
# Line 228  Line 228 
228    (check-schedule eq)    (check-schedule eq)
229    (let ((lock (event-queue-lock eq)))    (let ((lock (event-queue-lock eq)))
230      (with-lock-held (lock)      (with-lock-held (lock)
231    (with-slots (schedule-time) eq        (with-slots (schedule-time) eq
232      (flet ((pred ()          (flet ((pred ()
233               (not (null (event-queue-head eq)))))                   (not (null (event-queue-head eq)))))
234        (cond            (cond
235          (timeout              (timeout
236           (loop as    timeout-time = (+ now timeout)               (loop as    timeout-time = (+ now timeout)
237                 with  now = (now)                  with  now = (now)
238                 do    (when (pred)                  do    (when (pred)
239                         (return t))                          (return t))
240                 do    (when (>= now timeout-time)                  do    (when (>= now timeout-time)
241                         (return nil))                          (return nil))
242                 do    (let ((timeout (if schedule-time                  do    (let ((timeout (if schedule-time
243                                          (min (- schedule-time now)                                           (min (- schedule-time now)
244                                               (- timeout-time now))                                                (- timeout-time now))
245                                          (- timeout-time now))))                                           (- timeout-time now))))
246                             (condition-wait (event-queue-processes eq)                          (condition-wait (event-queue-processes eq)
247                                             lock timeout))                                          lock timeout))
248                 do    (check-schedule eq)))                  do    (check-schedule eq)))
249          (schedule-time              (schedule-time
250           (loop do (when (pred)               (loop do (when (pred)
251                      (return t))                          (return t))
252                     do (condition-wait                  do (condition-wait
253                         (event-queue-processes eq) lock (- schedule-time (now)))                      (event-queue-processes eq) lock (- schedule-time (now)))
254                 do (check-schedule eq)))                  do (check-schedule eq)))
255          (t              (t
256            (or (pred)               (or (pred)
257                (progn                   (progn
258                     (condition-wait (event-queue-processes eq) lock)                     (condition-wait (event-queue-processes eq) lock)
259                     t)))))))))                     t)))))))))
260    

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.33

  ViewVC Help
Powered by ViewVC 1.1.5