Commit b1c4a6b6 authored by Elias Pipping's avatar Elias Pipping

Add terminate-process and %posix-send-signal

ECL: terminate-process will not work with ECL 16.1.2 and earlier
parent aeb257a4
......@@ -13,7 +13,8 @@
;;; run-program
#:slurp-input-stream #:vomit-output-stream
#:close-streams #:process-alive-p #:run-program #:wait-process
#:close-streams #:process-alive-p #:run-program #:terminate-process
#:wait-process
#:process-info-error-output #:process-info-input #:process-info-output
#:subprocess-error
#:subprocess-error-code #:subprocess-error-command #:subprocess-error-process
......@@ -783,6 +784,41 @@ 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 %run-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.
(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) :wait t)))
(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 ~a /pid ~a"
(if urgent "/f" "") pid))))
(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
......
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