Commit 2eff7385 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Move terminate-process after run-program

This avoids a forward reference on sbcl/windows.

Also add a comment on a use of symbol-call on ECL.
parent e5feddd3
......@@ -773,51 +773,6 @@ or :error-output."
(slot-value process-info 'output-stream)))))
(when stream (close stream))))
;; WARNING: For signals other than SIGTERM and SIGKILL this may not
;; do what you expect it to. Sending SIGSTOP to a process spawned
;; via LAUNCH-PROGRAM, e.g., will stop the shell /bin/sh that is used
;; to run the command (via `sh -c command`) but not the actual
;; command.
#+os-unix
(defun %posix-send-signal (process-info signal)
#+allegro (excl.osi:kill (slot-value process-info 'process) signal)
#+clozure (ccl:signal-external-process (slot-value process-info 'process)
signal :error-if-exited nil)
#+(or cmucl scl) (ext:process-kill (slot-value process-info 'process) signal)
#+sbcl (sb-ext:process-kill (slot-value process-info 'process) signal)
#-(or allegro clozure cmucl sbcl scl)
(if-let (pid (process-info-pid process-info))
(run-program (format nil "kill -~a ~a" signal pid)
:ignore-error-status t)))
;;; this function never gets called on Windows, but the compiler cannot tell
;;; that. [2016/09/25:rpg]
#+os-windows
(defun %posix-send-signal (process-info signal)
(declare (ignore process-info signal))
(values))
(defun terminate-process (process-info &key urgent)
"Cause the process to exit. To that end, the process may or may
not be sent a signal, which it will find harder (or even impossible)
to ignore if URGENT is T. On some platforms, it may also be subject to
race conditions."
(declare (ignorable urgent))
#+abcl (sys:process-kill (slot-value process-info 'process))
#+ecl (symbol-call :ext :terminate-process
(slot-value process-info 'process) urgent)
#+lispworks7+ (sys:pipe-kill-process (slot-value process-info 'process))
#+mkcl (mk-ext:terminate-process (slot-value process-info 'process)
:force urgent)
#-(or abcl ecl lispworks7+ mkcl)
(os-cond
((os-unix-p) (%posix-send-signal process-info (if urgent 9 15)))
((os-windows-p) (if-let (pid (process-info-pid process-info))
(run-program (format nil "taskkill ~:[~;/f ~]/pid ~a"
urgent pid)
:ignore-error-status t)))
(t (not-implemented-error 'terminate-process))))
(defun %call-with-program-io (gf tval stream-easy-p fun direction spec activep returner
&key element-type external-format &allow-other-keys)
;; handle redirection for run-program and system
......@@ -1147,4 +1102,51 @@ or an indication of failure via the EXIT-CODE of the process"
:if-output-exists if-output-exists
:if-error-output-exists if-error-output-exists
:element-type element-type :external-format external-format
keys))))
keys)))
;; WARNING: For signals other than SIGTERM and SIGKILL this may not
;; do what you expect it to. Sending SIGSTOP to a process spawned
;; via LAUNCH-PROGRAM, e.g., will stop the shell /bin/sh that is used
;; to run the command (via `sh -c command`) but not the actual
;; command.
#+os-unix
(defun %posix-send-signal (process-info signal)
#+allegro (excl.osi:kill (slot-value process-info 'process) signal)
#+clozure (ccl:signal-external-process (slot-value process-info 'process)
signal :error-if-exited nil)
#+(or cmucl scl) (ext:process-kill (slot-value process-info 'process) signal)
#+sbcl (sb-ext:process-kill (slot-value process-info 'process) signal)
#-(or allegro clozure cmucl sbcl scl)
(if-let (pid (process-info-pid process-info))
(run-program (format nil "kill -~a ~a" signal pid)
:ignore-error-status t)))
;;; this function never gets called on Windows, but the compiler cannot tell
;;; that. [2016/09/25:rpg]
#+os-windows
(defun %posix-send-signal (process-info signal)
(declare (ignore process-info signal))
(values))
(defun terminate-process (process-info &key urgent)
"Cause the process to exit. To that end, the process may or may
not be sent a signal, which it will find harder (or even impossible)
to ignore if URGENT is T. On some platforms, it may also be subject to
race conditions."
(declare (ignorable urgent))
#+abcl (sys:process-kill (slot-value process-info 'process))
;; On ECL, this will only work on versions later than 2016-09-06,
;; but we still want to compile on earlier versions, so we use symbol-call
#+ecl (symbol-call :ext :terminate-process (slot-value process-info 'process) urgent)
#+lispworks7+ (sys:pipe-kill-process (slot-value process-info 'process))
#+mkcl (mk-ext:terminate-process (slot-value process-info 'process)
:force urgent)
#-(or abcl ecl lispworks7+ mkcl)
(os-cond
((os-unix-p) (%posix-send-signal process-info (if urgent 9 15)))
((os-windows-p) (if-let (pid (process-info-pid process-info))
(run-program (format nil "taskkill ~:[~;/f ~]/pid ~a"
urgent pid)
:ignore-error-status t)))
(t (not-implemented-error 'terminate-process)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment