[slime-devel] ABCL getpid implementation

[Mark Evenson]

   * swank-abcl.lisp (getpid):  Implementation for
   ABCL.

Tested under OS X, Linux, FreeBSD.


-- 
<Mark.Evenson at gmx.at>

"[T]his is not a disentanglement from, but a progressive knotting into."

-------------- next part --------------
Index: swank-abcl.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-abcl.lisp,v
retrieving revision 1.43
diff -u -r1.43 swank-abcl.lisp
--- swank-abcl.lisp	4 Sep 2007 15:45:19 -0000	1.43
+++ swank-abcl.lisp	4 Oct 2007 14:59:25 -0000
@@ -144,7 +144,38 @@
 
- ;;there are too many to count
 (defimplementation getpid ()
-  0)
+  (if (not (find :unix *features*))
+      0
+      (let* ((runtime 
+              (java:jstatic "getRuntime" "java.lang.Runtime"))
+	 (command
+	  (java:jnew-array-from-array 
+	   "java.lang.String" #("sh" "-c" "echo $PPID")))
+	 (runtime-exec-jmethod 		
+	  ;; Complicated because java.lang.Runtime.exec() is
+	  ;; overloaded on a non-primitive type (array of
+	  ;; java.lang.String), so we have to use the actual parameter
+	  ;; instance to get java.lang.Class
+	  (java:jmethod "java.lang.Runtime" "exec" 
+                        (java:jcall 
+                         (java:jmethod "java.lang.Object" "getClass")
+                         command)))
+	 (process 
+	  (java:jcall runtime-exec-jmethod runtime command))
+	 (output 
+	  (java:jcall (java:jmethod "java.lang.Process" "getInputStream") 
+		 process)))
+    (java:jcall (java:jmethod "java.lang.Process" "waitFor") process)
+    (loop 
+       :with b
+       :do (setq b 
+		 (java:jcall (java:jmethod "java.io.InputStream" "read")
+			output))
+       :until (member b '(-1 #x0a))	; Either EOF or LF
+       :collecting (code-char b) :into result
+       :finally (return 
+		  (values 
+		   (parse-integer (coerce result 'string))))))))
+
 
 (defimplementation lisp-implementation-type-name ()
   "armedbear")