Ignore:
Timestamp:
Jan 25, 2008, 8:08:37 AM (12 years ago)
Author:
gb
Message:

No timeval in MONITOR-EXTERNAL-PROCESS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/linux-files.lisp

    r8267 r8271  
    849849         (token (external-process-token p))
    850850         (terminated))
    851     (rlet ((tv :timeval))
    852       (loop
    853         (when (and terminated (null in-fd))
    854           (signal-semaphore (external-process-completed p))
    855           (return))
    856         (when in-fd
    857           (when (fd-input-available-p in-fd tv)
    858             (%stack-block ((buf 1024))
    859               (let* ((n (fd-read in-fd buf 1024)))
    860                 (declare (fixnum n))
    861                 (if (<= n 0)
    862                   (progn
    863                     (without-interrupts
    864                      (decf (car token))
    865                      (fd-close in-fd)
    866                      (setq in-fd nil)))
    867                   (let* ((string (make-string 1024)))
    868                     (declare (dynamic-extent string))
    869                     (%str-from-ptr buf n string)
    870                     (write-sequence string out-stream :end n)))))))
    871         (let* ((statusflags (check-pid (external-process-pid p)
    872                                        (logior
    873                                         (if in-fd #$WNOHANG 0)
    874                                         #$WUNTRACED)))
    875                (oldstatus (external-process-%status p)))
    876           (cond ((null statusflags)
    877                  (remove-external-process p)
    878                  (setq terminated t))
    879                 ((eq statusflags t))    ; Running.
    880                 (t
    881                  (multiple-value-bind (status code core)
    882                      (cond ((wifstopped statusflags)
    883                             (values :stopped (wstopsig statusflags)))
    884                            ((wifexited statusflags)
    885                             (values :exited (wexitstatus statusflags)))
    886                            (t
    887                             (let* ((signal (wtermsig statusflags)))
    888                               (declare (fixnum signal))
    889                               (values
    890                                (if (or (= signal #$SIGSTOP)
    891                                        (= signal #$SIGTSTP)
    892                                        (= signal #$SIGTTIN)
    893                                        (= signal #$SIGTTOU))
    894                                  :stopped
    895                                  :signaled)
    896                                signal
    897                                (logtest #$WCOREFLAG statusflags)))))
    898                    (setf (external-process-%status p) status
    899                          (external-process-%exit-code p) code
    900                          (external-process-core p) core)
    901                    (let* ((status-hook (external-process-status-hook p)))
    902                      (when (and status-hook (not (eq oldstatus status)))
    903                        (funcall status-hook p)))
    904                    (when (or (eq status :exited)
    905                              (eq status :signaled))
    906                      (remove-external-process p)
    907                      (setq terminated t))))))))))
     851    (loop
     852      (when (and terminated (null in-fd))
     853        (signal-semaphore (external-process-completed p))
     854        (return))
     855      (when in-fd
     856        (when (fd-input-available-p in-fd 0)
     857          (%stack-block ((buf 1024))
     858            (let* ((n (fd-read in-fd buf 1024)))
     859              (declare (fixnum n))
     860              (if (<= n 0)
     861                (progn
     862                  (without-interrupts
     863                   (decf (car token))
     864                   (fd-close in-fd)
     865                   (setq in-fd nil)))
     866                (let* ((string (make-string 1024)))
     867                  (declare (dynamic-extent string))
     868                  (%str-from-ptr buf n string)
     869                  (write-sequence string out-stream :end n)))))))
     870      (let* ((statusflags (check-pid (external-process-pid p)
     871                                     (logior
     872                                      (if in-fd #$WNOHANG 0)
     873                                      #$WUNTRACED)))
     874             (oldstatus (external-process-%status p)))
     875        (cond ((null statusflags)
     876               (remove-external-process p)
     877               (setq terminated t))
     878              ((eq statusflags t))      ; Running.
     879              (t
     880               (multiple-value-bind (status code core)
     881                   (cond ((wifstopped statusflags)
     882                          (values :stopped (wstopsig statusflags)))
     883                         ((wifexited statusflags)
     884                          (values :exited (wexitstatus statusflags)))
     885                         (t
     886                          (let* ((signal (wtermsig statusflags)))
     887                            (declare (fixnum signal))
     888                            (values
     889                             (if (or (= signal #$SIGSTOP)
     890                                     (= signal #$SIGTSTP)
     891                                     (= signal #$SIGTTIN)
     892                                     (= signal #$SIGTTOU))
     893                               :stopped
     894                               :signaled)
     895                             signal
     896                             (logtest #$WCOREFLAG statusflags)))))
     897                 (setf (external-process-%status p) status
     898                       (external-process-%exit-code p) code
     899                       (external-process-core p) core)
     900                 (let* ((status-hook (external-process-status-hook p)))
     901                   (when (and status-hook (not (eq oldstatus status)))
     902                     (funcall status-hook p)))
     903                 (when (or (eq status :exited)
     904                           (eq status :signaled))
     905                   (remove-external-process p)
     906                   (setq terminated t)))))))))
    908907     
    909908(defun run-external-process (proc in-fd out-fd error-fd &optional env)
Note: See TracChangeset for help on using the changeset viewer.