[elephant-cvs] CVS elephant/src/utils
ieslick
ieslick at common-lisp.net
Fri Feb 16 03:43:48 UTC 2007
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)
+ , at 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)
)
More information about the Elephant-cvs
mailing list