[Small-cl-src] fork, wait, and waitpid for SBCL-0.8.8

[Thomas F. Burdick]

--- sb-posix/interface.lisp.~1.13.~	Thu Feb 19 23:47:27 2004
+++ sb-posix/interface.lisp	Mon May 10 17:13:46 2004
@@ -112,6 +112,7 @@
 
 ;;; processes, signals
 (define-call "alarm" int never-fails (seconds unsigned))
+(define-call "fork" sb-posix::pid-t minusp)
 (define-call "getpgid" sb-posix::pid-t minusp (pid sb-posix::pid-t))
 (define-call "getpid" sb-posix::pid-t never-fails)
 (define-call "getppid" sb-posix::pid-t never-fails)
@@ -123,6 +124,36 @@
 (define-call "setpgid" int minusp
 	     (pid sb-posix::pid-t) (pgid sb-posix::pid-t))
 (define-call "setpgrp" int minusp)
+
+;; FIXME: The status code we get from the wait functions is only
+;; useful in combination with the macros that let us examine it.
+
+(export 'sb-posix::wait :sb-posix)
+(declaim (inline sb-posix::wait))
+(defun sb-posix::wait (&optional statusptr)
+  (declare (type (or null (simple-array (signed-byte 32) (1))) statusptr))
+  (let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
+	 (pid (alien-funcall
+	       (extern-alien "wait" (function sb-posix::pid-t (* int)))
+	       (sb-sys:vector-sap ptr))))
+    (if (minusp pid)
+	(syscall-error)
+	(values pid (aref ptr 0)))))
+
+(export 'sb-posix::waitpid :sb-posix)
+(declaim (inline sb-posix::waitpid))
+(defun sb-posix::waitpid (pid options &optional statusptr)
+  (declare (type (sb-alien:alien sb-posix::pid-t) pid)
+	   (type (sb-alien:alien int) options)
+	   (type (or null (simple-array (signed-byte 32) (1))) statusptr))
+  (let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
+	 (pid (alien-funcall
+	       (extern-alien "waitpid" (function sb-posix::pid-t
+						 sb-posix::pid-t (* int) int))
+	       pid (sb-sys:vector-sap ptr) options)))
+    (if (minusp pid)
+	(syscall-error)
+	(values pid (aref ptr 0)))))
 
 ;;; mmap, msync
 (define-call "mmap" sb-sys:system-area-pointer