Changeset 8266


Ignore:
Timestamp:
Jan 25, 2008, 7:49:55 AM (12 years ago)
Author:
gb
Message:

Input-wait, output-wait changes (use poll syscall.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-streams.lisp

    r8237 r8266  
    52065206    (- #$ETIMEDOUT)))
    52075207   
    5208 (defun process-input-wait (fd &optional ticks)
     5208(defun process-input-wait (fd &optional timeout)
    52095209  "Wait until input is available on a given file-descriptor."
    5210   (let* ((wait-end (if ticks (+ (get-tick-count) ticks))))
    5211     (loop
    5212       ;; FD-INPUT-AVAILABLE-P can return NIL (e.g., if the
    5213       ;; thread receives an interrupt) before a timeout is
    5214       ;; reached.
    5215       (when (fd-input-available-p fd ticks)
    5216         (return t))
    5217       ;; If it returned and a timeout was specified, check
    5218       ;; to see if it's been exceeded.  If so, return NIL;
    5219       ;; otherwise, adjust the remaining timeout.
    5220       ;; If there was no timeout, continue to wait forever.
    5221       (when ticks
    5222         (let* ((now (get-tick-count)))
    5223           (if (and wait-end (>= now wait-end))
    5224             (return)
    5225             (setq ticks (- wait-end now))))))))
     5210  (rlet ((now :timeval))
     5211    (let* ((wait-end
     5212            (if timeout
     5213              (multiple-value-bind (seconds millis) (milliseconds timeout)
     5214                (#_gettimeofday now +null-ptr+)
     5215                (setq timeout (+ (* seconds 1000) millis))
     5216                (+ (timeval->milliseconds now) timeout)))))
     5217      (loop
     5218        ;; FD-INPUT-AVAILABLE-P can return NIL (e.g., if the
     5219        ;; thread receives an interrupt) before a timeout is
     5220        ;; reached.
     5221        (when (fd-input-available-p fd (or timeout -1))
     5222          (return t))
     5223        ;; If it returned and a timeout was specified, check
     5224        ;; to see if it's been exceeded.  If so, return NIL;
     5225        ;; otherwise, adjust the remaining timeout.
     5226        ;; If there was no timeout, continue to wait forever.
     5227        (when timeout
     5228          (#_gettimeofday now +null-ptr+)
     5229          (setq timeout (- wait-end (timeval->milliseconds now)))
     5230          (if (<= timeout 0)
     5231            (return)))))))
    52265232
    52275233
     
    52315237    (- #$ETIMEDOUT)))
    52325238
    5233 (defun process-output-wait (fd)
     5239(defun process-output-wait (fd &optional timeout)
    52345240  "Wait until output is possible on a given file descriptor."
    5235   (loop
    5236     (when (fd-ready-for-output-p fd nil)
    5237       (return t))))
     5241  (rlet ((now :timeval))
     5242    (let* ((wait-end
     5243            (if timeout
     5244              (multiple-value-bind (seconds millis) (milliseconds timeout)
     5245                (#_gettimeofday now +null-ptr+)
     5246                (setq timeout (+ (* seconds 1000) millis))
     5247                (+ (timeval->milliseconds now) timeout)))))
     5248      (loop
     5249        ;; FD-INPUT-AVAILABLE-P can return NIL (e.g., if the
     5250        ;; thread receives an interrupt) before a timeout is
     5251        ;; reached.
     5252        (when (fd-ready-for-output-p fd (or timeout -1))
     5253          (return t))
     5254        ;; If it returned and a timeout was specified, check
     5255        ;; to see if it's been exceeded.  If so, return NIL;
     5256        ;; otherwise, adjust the remaining timeout.
     5257        ;; If there was no timeout, continue to wait forever.
     5258        (when timeout
     5259          (#_gettimeofday now +null-ptr+)
     5260          (setq timeout (- wait-end (timeval->milliseconds now)))
     5261          (if (<= timeout 0)
     5262            (return)))))))
    52385263
    52395264
     
    52495274              (pref tv :timeval.tv_usec) us)))))
    52505275
    5251 (defun fd-input-available-p (fd &optional ticks)
    5252   (rletZ ((tv :timeval))
    5253     (ticks-to-timeval ticks tv)
    5254     (%stack-block ((infds *fd-set-size*))
    5255       (fd-zero infds)
    5256       (fd-set fd infds)
    5257       (let* ((res (syscall syscalls::select (1+ fd) infds (%null-ptr) (%null-ptr)
    5258                            (if ticks tv (%null-ptr)))))
    5259         (> res 0)))))
    5260 
    5261 (defun fd-ready-for-output-p (fd &optional ticks)
    5262   (rletZ ((tv :timeval))
    5263     (ticks-to-timeval ticks tv)
    5264     (%stack-block ((outfds *fd-set-size*))
    5265       (fd-zero outfds)
    5266       (fd-set fd outfds)
    5267       (let* ((res (#_select (1+ fd) (%null-ptr) outfds (%null-ptr)
    5268                             (if ticks tv (%null-ptr)))))
    5269         (> res 0)))))
     5276(defun fd-input-available-p (fd &optional milliseconds)
     5277  (rlet ((pollfds (:array (:struct :pollfd) 1)))
     5278    (setf (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.fd) fd
     5279          (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.events) #$POLLIN)
     5280    (let* ((res (ignoring-eintr (syscall syscalls::poll pollfds 1 (or milliseconds -1)))))
     5281      (> res 0))))
     5282
     5283
     5284(defun fd-ready-for-output-p (fd &optional milliseconds)
     5285  (rlet ((pollfds (:array (:struct :pollfd) 1)))
     5286    (setf (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.fd) fd
     5287          (pref (paref pollfds (:* (:struct :pollfd)) 0) :pollfd.events) #$POLLOUT)
     5288    (let* ((res (ignoring-eintr (syscall syscalls::poll pollfds 1 (or milliseconds -1)))))
     5289      (> res 0))))
    52705290
    52715291(defun fd-urgent-data-available-p (fd &optional ticks)
     
    55775597         (tem-path (merge-pathnames (make-pathname :name (%integer-to-string date) :type "tem" :defaults nil) path)))
    55785598    (loop
    5579       (when (%create-file tem-path :if-exists nil) (return tem-path))
     5599      (when (not (probe-file tem-path)) (return tem-path))
    55805600      (setf (%pathname-name tem-path) (%integer-to-string (setq date (1+ date)))))))
    55815601
Note: See TracChangeset for help on using the changeset viewer.