Update of /project/elephant/cvsroot/elephant/src/utils In directory clnet:/tmp/cvs-serv26996/src/utils
Modified Files: os.lisp Log Message: Latest changes to launching deadlock processes, all lisps supported (but not tested) except lispworks
--- /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/14 04:38:56 1.1 +++ /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/16 03:43:48 1.2 @@ -1,26 +1,54 @@
(in-package :elephant-utils)
+(defmacro in-directory ((dir) &body body) + `(progn + (#+sbcl sb-posix:chdir + #+cmu unix:unix-chdir + #+allegro excl:chdir + #+lispworks hcl:change-directory + #+openmcl ccl:cwd + ,dir) + ,@body)) + (defun launch-background-program (directory program &key (args nil)) "Launch a program in a specified directory - not all shell interfaces or OS's support this" #+(and allegro (not mswindows)) - (excl:run-shell-command (concat-separated-strings " " (list program) args) - :wait nil - :directory directory) -;; #+(and allegro mswindows) -;; #+(and sbcl unix) -;; (sb-ext:start-process ... -;; #+(and openmcl unix) -;; #+lispworks + (multiple-value-bind (in out pid) + (excl:run-shell-command (concat-separated-strings " " (list program) args) + :wait nil + :directory directory) + (declare (ignore in out)) + pid) + #+(and sbcl unix) + (in-directory (directory) + (sb-ext:run-program program args :wait nil)) + #+cmu + (in-directory (directory) + (ext:run-program program args :wait nil)) + #+openmcl + (in-directory (directory) + (ccl:run-program program args :wait nil)) + #+lispworks + (apply #'sys::call-system + (format nil "~a~{ '~a'~}~@[ &~]" prog args) + :current-directory directory + :wait nil) )
-(defun kill-background-program (pid) +(defun kill-background-program (process-handle) #+(and allegro (not mswindows)) - (progn (excl.osi:kill pid 9) - (system:reap-os-subprocess :pid pid)) -;; #+(and allegro mswindows) + (progn (excl.osi:kill process-handle 9) + (system:reap-os-subprocess :pid process-handle)) #+(and sbcl unix) - (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))) + (sb-ext:process-kill process-handle 9) + #+openmcl + (ccl:signal-external-process process-handle 9) +;; #+lispworks +;; (apply #'sys::call-system +;; (format nil "kill ~A -9" process-handle) +;; :current-directory directory +;; :wait t) )