about summary refs log tree commit diff
path: root/third_party/lisp/sclf/sysproc.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/sclf/sysproc.lisp')
-rw-r--r--third_party/lisp/sclf/sysproc.lisp295
1 files changed, 0 insertions, 295 deletions
diff --git a/third_party/lisp/sclf/sysproc.lisp b/third_party/lisp/sclf/sysproc.lisp
deleted file mode 100644
index 1dd559ebe3a2..000000000000
--- a/third_party/lisp/sclf/sysproc.lisp
+++ /dev/null
@@ -1,295 +0,0 @@
-;;;  sysproc.lisp --- system processes
-
-;;;  Copyright (C) 2008, 2009, 2010 by Walter C. Pelissero
-
-;;;  Author: Walter C. Pelissero <walter@pelissero.de>
-;;;  Project: sclf
-
-#+cmu (ext:file-comment "$Module: sysproc.lisp $")
-
-;;; This library is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU Lesser General Public License
-;;; as published by the Free Software Foundation; either version 2.1
-;;; of the License, or (at your option) any later version.
-;;; This library is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Lesser General Public License for more details.
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library; if not, write to the Free
-;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-;;; 02111-1307 USA
-
-(in-package :sclf)
-
-(defvar *bourne-shell* "/bin/sh")
-
-(defvar *run-verbose* nil
-  "If true system commands are displayed before execution and standard
-error is not discarded.")
-
-;;
-;; SIGINFO is missing in both CMUCL and SBCL
-;;
-
-#+cmu
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant unix::siginfo 29)
-  (defvar siginfo (unix::make-unix-signal :siginfo unix::siginfo "Information"))
-  (export '(unix::siginfo) "UNIX")
-  (pushnew siginfo unix::*unix-signals*))
-
-#+sbcl (in-package :sb-posix)
-#+sbcl
-(eval-when (:execute :compile-toplevel :load-toplevel)
-  (unless (find-symbol "SIGINFO" :sb-posix)
-    (sb-ext:with-unlocked-packages (:sb-posix)
-      (defvar siginfo 29)
-      (export '(SIGINFO)))))
-#+sbcl (in-package :sclf)
-
-(defun signal-number (signal-name)
-  (ecase signal-name
-    ((:abrt :abort)
-     #+cmu unix:sigabrt
-     #+sbcl sb-posix:sigabrt)
-    ((:alrm :alarm)
-     #+cmu unix:sigalrm
-     #+sbcl sb-posix:sigalrm)
-    ((:bus :bus-error)
-     #+cmu unix:sigbus
-     #+sbcl sb-posix:sigbus)
-    ((:chld :child)
-     #+cmu unix:sigchld
-     #+sbcl sb-posix:sigchld)
-    ((:cont :continue)
-     #+cmu unix:sigcont
-     #+sbcl sb-posix:sigcont)
-    #+freebsd((:emt :emulate-instruction)
-              #+cmu unix:sigemt
-              #+sbcl sb-posix:sigemt)
-    ((:fpe :floating-point-exception)
-     #+cmu unix:sigfpe
-     #+sbcl sb-posix:sigfpe)
-    ((:hup :hangup)
-     #+cmu unix:sighup
-     #+sbcl sb-posix:sighup)
-    ((:ill :illegal :illegal-instruction)
-     #+cmu unix:sigill
-     #+sbcl sb-posix:sigill)
-    ((:int :interrupt)
-     #+cmu unix:sigint
-     #+sbcl sb-posix:sigint)
-    ((:io :input-output)
-     #+cmu unix:sigio
-     #+sbcl sb-posix:sigio)
-    (:kill
-     #+cmu unix:sigkill
-     #+sbcl sb-posix:sigkill)
-    ((:pipe :broke-pipe)
-     #+cmu unix:sigpipe
-     #+sbcl sb-posix:sigpipe)
-    ((:prof :profiler)
-     #+cmu unix:sigprof
-     #+sbcl sb-posix:sigprof)
-    (:quit
-     #+cmu unix:sigquit
-     #+sbcl sb-posix:sigquit)
-    ((:segv :segmentation-violation)
-     #+cmu unix:sigsegv
-     #+sbcl sb-posix:sigsegv)
-    (:stop
-     #+cmu unix:sigstop
-     #+sbcl sb-posix:sigstop)
-    ((:sys :system-call)
-     #+cmu unix:sigsys
-     #+sbcl sb-posix:sigsys)
-    ((:term :terminate)
-     #+cmu unix:sigterm
-     #+sbcl sb-posix:sigterm)
-    ((:trap)
-     #+cmu unix:sigtrap
-     #+sbcl sb-posix:sigtrap)
-    ((:tstp :terminal-stop)
-     #+cmu unix:sigtstp
-     #+sbcl sb-posix:sigtstp)
-    ((:ttin :tty-input)
-     #+cmu unix:sigttin
-     #+sbcl sb-posix:sigttin)
-    ((:ttou :tty-output)
-     #+cmu unix:sigttou
-     #+sbcl sb-posix:sigttou)
-    ((:urg :urgent)
-     #+cmu unix:sigurg
-     #+sbcl sb-posix:sigurg)
-    ((:usr1 :user1)
-     #+cmu unix:sigusr1
-     #+sbcl sb-posix:sigusr1)
-    ((:usr2 :user2)
-     #+cmu unix:sigusr2
-     #+sbcl sb-posix:sigusr2)
-    ((:vtalrm :virtual-timer-alarm)
-     #+cmu unix:sigvtalrm
-     #+sbcl sb-posix:sigvtalrm)
-    ((:winch :window-change :window-size-change)
-     #+cmu unix:sigwinch
-     #+sbcl sb-posix:sigwinch)
-    ((:xcpu :exceeded-cpu)
-     #+cmu unix:sigxcpu
-     #+sbcl sb-posix:sigxcpu)
-    ((:xfsz :exceeded-file-size)
-     #+cmu unix:sigxfsz
-     #+sbcl sb-posix:sigxfsz)
-    ;; oddly this is not defined by neither CMUCL nor SBCL
-    (:info 29)))
-
-(defun sysproc-kill (process signal)
-  (when (keywordp signal)
-    (setf signal (signal-number signal)))
-  #+cmu (ext:process-kill process signal)
-  #+sbcl (sb-ext:process-kill process signal)
-  #-(or sbcl cmu) (error "Don't know how to kill a process"))
-
-(defun sysproc-exit-code (process)
-  #+cmu (ext:process-exit-code process)
-  #+sbcl (sb-ext:process-exit-code process)
-  #-(or sbcl cmu) (error "Don't know how to get a process exit code"))
-
-(defun sysproc-wait (process)
-  #+cmu (ext:process-wait process)
-  #+sbcl (sb-ext:process-wait process)
-  #-(or sbcl cmu) (error "Don't know how to wait a process"))
-
-(defun sysproc-input (process)
-  #+cmu (ext:process-input process)
-  #+sbcl (sb-ext:process-input process)
-  #-(or sbcl cmu) (error "Don't know how to get the process input"))
-
-(defun sysproc-output (process)
-  #+cmu (ext:process-output process)
-  #+sbcl (sb-ext:process-output process)
-  #-(or sbcl cmu) (error "Don't know how to get the process output"))
-
-(defun sysproc-alive-p (process)
-  #+cmu (ext:process-alive-p process)
-  #+sbcl (sb-ext:process-alive-p process)
-  #-(or sbcl cmu) (error "Don't know how to test wether a process might be running"))
-
-(defun sysproc-pid (process)
-  #+cmu (ext:process-pid process)
-  #+sbcl (sb-ext:process-pid process)
-  #-(or sbcl cmu) (error "Don't know how to get the id of a process"))
-
-(defun sysproc-p (thing)
-  #+sbcl (sb-ext:process-p thing)
-  #+cmu (ext:process-p thing)
-  #-(or sbcl cmu) (error "Don't know how to figure out whether something is a system process"))
-
-(defun run-program (program arguments &key (wait t) pty input output error)
-  "Run PROGRAM with ARGUMENTS (a list) and return a process object."
-  ;; convert arguments to strings
-  (setf arguments
-        (mapcar #'(lambda (item)
-                    (typecase item
-                      (string item)
-                      (pathname (native-namestring item))
-                      (t (format nil "~A" item))))
-                arguments))
-  (when *run-verbose*
-    (unless error
-      (setf error t))
-    (format t "~&; run-pipe ~A~{ ~S~}~%" program arguments))
-  #+cmu (ext:run-program program arguments
-                         :wait wait
-                         :pty pty
-                         :input input
-                         :output output
-                         :error (or error *run-verbose*))
-  #+sbcl (sb-ext:run-program program arguments
-                             :search t
-                             :wait wait
-                             :pty pty
-                             :input input
-                             :output output
-                             :error (or error *run-verbose*))
-  #-(or sbcl cmu)
-  (error "Unsupported Lisp system."))
-
-(defun run-pipe (direction program arguments &key error)
-  "Run PROGRAM with a list of ARGUMENTS and according to DIRECTION
-return the input and output streams and process object of that
-process."
-  (be process (run-program program arguments
-                           :wait nil
-                           :pty nil
-                           :input (when (member direction '(:output :input-output :io))
-                                    :stream)
-                           :output (when (member direction '(:input :input-output :io))
-                                     :stream)
-                           :error error)
-    (values (sysproc-output process)
-            (sysproc-input process)
-            process))
-  #-(or sbcl cmu)
-  (error "Unsupported Lisp system."))
-
-(defun exit-code (process)
-  (sysproc-wait process)
-  (sysproc-exit-code process))
-
-(defun run-shell-command (fmt &rest args)
-  "Run a Bourne Shell command.  Return the exit status of the command."
-  (run-program *bourne-shell* (list "-c" (apply #'format nil fmt args))))
-
-(defun run-async-shell-command (fmt &rest args)
-  "Run a Bourne Shell command asynchronously. Return a process
-object if provided by your Lisp implementation."
-  (run-program *bourne-shell* (list "-c" (apply #'format nil fmt args))
-               :wait nil))
-
-(defmacro with-open-pipe ((in out program arguments &key (process (gensym)) error pty) &body forms)
-  "Run BODY with IN and OUT bound respectively to an input and an
-output stream connected to a system process created by running PROGRAM
-with ARGUMENTS.  If IN or OUT are NIL, then don't create that stream."
-  (with-gensyms (prg args)
-    `(be* ,prg ,program
-          ,args ,arguments
-          ,process (run-program ,prg ,args
-                                :output ,(case in
-                                               ((t nil) in)
-                                               (t :stream))
-                                :input ,(case out
-                                              ((t nil) out)
-                                              (t :stream))
-                                :wait nil
-                                :pty ,pty
-                                ,@(when error `(:error ,error)))
-       (if ,process
-           (let (,@(case in
-                         ((t nil))
-                         (t `((,in (sysproc-output ,process)))))
-                 ,@(case out
-                         ((t nil))
-                         (t `((,out (sysproc-input ,process))))))
-             (unwind-protect
-                  (progn
-                    ,@forms)
-               ,@(case in
-                       ((t nil))
-                       (t `((close ,in))))
-               ,@(case out
-                       ((t nil))
-                       (t `((close ,out))))
-               (when (sysproc-alive-p ,process)
-                 (sysproc-kill ,process :term))))
-           (error "unable to run ~A~{ ~A~}." ,prg ,args)))))
-
-
-(defun sysproc-set-signal-callback (signal handler)
-  "Arrange HANDLER function to be called when receiving the system
-signal SIGNAL."
-  (when (keywordp signal)
-    (setf signal (signal-number signal)))
-  #+cmu (system:enable-interrupt signal handler)
-  #+sbcl (sb-sys:enable-interrupt signal handler)
-  #-(or cmu sbcl) (error "Don't know how to set a system signal callback."))