[elephant-cvs] CVS elephant/src/utils

[ieslick]

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)
   )