Changeset 9550


Ignore:
Timestamp:
May 19, 2008, 8:32:37 PM (12 years ago)
Author:
andreas
Message:

Working MONITOR-FUNCTION for RUN-PROCESS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/level-1/linux-files.lisp

    r9549 r9550  
    14491449                 (external-process-output proc) out-stream
    14501450                 (external-process-error proc) error-stream)
    1451            (format t "~s ~s ~s" in-fd out-fd error-fd)
    14521451           (process-run-function
    14531452            (format nil "Monitor thread for external process ~a" args)
     
    14871486  ;; stub, stub
    14881487  (let* ((args (external-process-args proc))
    1489          (child-pid (exec-with-io-redirection in-fd out-fd error-fd (car args) (cdr args))))
     1488         (child-pid (exec-with-io-redirection in-fd out-fd error-fd args)))
    14901489    (setf (external-process-pid proc) child-pid)
    14911490    (add-external-process proc)
     
    14931492    (monitor-external-process proc)))
    14941493
    1495 (defun exec-with-io-redirection (new-in new-out new-err command args)
    1496   (with-filename-cstrs ((command command))
     1494(defun join-strings (strings)
     1495  (reduce (lambda (left right) (concatenate 'string left " " right)) strings))
     1496
     1497(defun exec-with-io-redirection (new-in new-out new-err args)
     1498  (with-filename-cstrs ((command (join-strings args)))
    14971499    (rletz ((proc-info #>PROCESS_INFORMATION)
    14981500            (si #>STARTUPINFO))
    14991501      (setf (pref si #>STARTUPINFO.cb) (record-length #>STARTUPINFO))
    1500       (setf (pref si #>STARTUPINFO.dwFlags) #$STARTF_USESTDHANDLES)
     1502      (setf (pref si #>STARTUPINFO.dwFlags)
     1503            (logior #$STARTF_USESTDHANDLES #$STARTF_USESHOWWINDOW))
     1504      (setf (pref si #>STARTUPINFO.wShowWindow) #$SW_HIDE)
    15011505      (setf (pref si #>STARTUPINFO.hStdInput) (#__get_osfhandle new-in))
    15021506      (setf (pref si #>STARTUPINFO.hStdOutput) (#__get_osfhandle new-out))
     
    15131517                                   proc-info))
    15141518          (error "Process creation failed"))
     1519      (#_CloseHandle (pref proc-info #>PROCESS_INFORMATION.hThread))
    15151520      (pref proc-info #>PROCESS_INFORMATION.hProcess))))
    15161521
     
    15261531         (terminated))
    15271532    (loop
    1528       (when (and terminated (null in-fd))
    1529         (signal-semaphore (external-process-completed p))
    1530         (return))
    1531       (when in-fd
    1532         (when (fd-input-available-p in-fd 1000)
    1533           (%stack-block ((buf 1024))
    1534             (let* ((n (fd-read in-fd buf 1024)))
    1535               (declare (fixnum n))
    1536               (if (<= n 0)
    1537                 (progn
    1538                   (without-interrupts
    1539                    (decf (car token))
    1540                    (fd-close in-fd)
    1541                    (setq terminated t) ; need equiv. of waitpid here
    1542                    (setq in-fd nil)))
    1543                 (let* ((string (make-string 1024)))
    1544                   (declare (dynamic-extent string))
    1545                   (%str-from-ptr buf n string)
    1546                   (write-sequence string out-stream :end n))))))))))
     1533       (when terminated
     1534         (without-interrupts
     1535             (decf (car token))
     1536           (if in-fd (fd-close in-fd))
     1537           (setq in-fd nil)
     1538           (#_CloseHandle (external-process-pid p))
     1539           (setf (external-process-pid p) nil)
     1540           (setf (external-process-%status p) :exited)
     1541           (let ((status-hook (external-process-status-hook p)))
     1542             (when status-hook
     1543               (funcall status-hook p)))
     1544           (remove-external-process p)
     1545           (signal-semaphore (external-process-completed p))
     1546           (return)))   
     1547       (if in-fd
     1548         (rlet ((handles (:array #>HANDLE 2)))
     1549           (setf (paref handles (:array #>HANDLE) 0) (external-process-pid p))
     1550           (setf (paref handles (:array #>HANDLE) 1) (#__get_osfhandle in-fd))
     1551           (let ((rc (#_WaitForMultipleObjects 2 handles #$FALSE #$INFINITE)))
     1552             (if (eq rc #$WAIT_OBJECT_0)
     1553               (setf terminated t)
     1554               (%stack-block ((buf 1024))
     1555                 (let* ((n (fd-read in-fd buf 1024)))
     1556                   (declare (fixnum n))
     1557                   (if (<= n 0)
     1558                       (setf terminated t)
     1559                       (let* ((string (make-string 1024)))
     1560                         (declare (dynamic-extent string))
     1561                         (%str-from-ptr buf n string)
     1562                         (write-sequence string out-stream :end n))))))))
     1563         (progn
     1564           (#_WaitForSingleObject (external-process-pid p) #$INFINITE)
     1565           (setf terminated t))))))
    15471566 
    15481567
Note: See TracChangeset for help on using the changeset viewer.