Applied a patch supplied by Derick Eddington that provides enhanced

functionality for waitpid (nonblocking waitpid and more status info)
as well as the ability to send a signal to a process, e.g., 
  (kill pid 'HUP).

scheme/ikarus.posix.ss

@@ -19,7 +19,8 @@
           nanosleep getenv env environ file-ctime current-directory
           file-regular? file-directory? file-symbolic-link? make-symbolic-link
           directory-list make-directory delete-directory change-mode
-          strerror)
+          kill strerror 
+          wstatus-pid wstatus-exit-status wstatus-received-signal)
   (import 
     (rnrs bytevectors)
     (except (ikarus)
@@ -28,7 +29,8 @@
        getenv env environ file-ctime current-directory
        file-regular? file-directory? file-symbolic-link? make-symbolic-link
        directory-list make-directory delete-directory change-mode
-       strerror))
+       kill strerror
+       wstatus-pid wstatus-exit-status wstatus-received-signal))
 
   (define posix-fork
     (lambda ()
@@ -42,14 +44,87 @@
           [(fx< pid 0) (raise/strerror 'fork pid)]
           [else (parent-proc pid)]))))
   
+  (module (signal-code->signal-name signal-name->signal-code)
+    
+    (define signal-names-al
+      ;; From ikarus-process.c
+      '((1 . SIGABRT) 
+        (2 . SIGALRM)
+        (3 . SIGBUS)
+        (4 . SIGCHLD)                   
+        (5 . SIGCONT) 
+        (6 . SIGFPE)
+        (7 . SIGHUP)
+        (8 . SIGILL)
+        (9 . SIGINT)
+        (10 . SIGKILL)
+        (11 . SIGPIPE)
+        (12 . SIGQUIT)
+        (13 . SIGSEGV)
+        (14 . SIGSTOP)
+        (15 . SIGTERM)
+        (16 . SIGTSTP)
+        (17 . SIGTTIN)
+        (18 . SIGTTOU)
+        (19 . SIGUSR1)
+        (20 . SIGUSR2)
+        (21 . SIGPOLL)
+        (22 . SIGPROF)
+        (23 . SIGSYS)
+        (24 . SIGTRAP)
+        (25 . SIGURG)
+        (26 . SIGVTALRM)
+        (27 . SIGXCPU)
+        (28 . SIGXFSZ)))
+    
+    (define signal-code->signal-name
+      (lambda (sigcode)        
+        (cond
+          [(assv sigcode signal-names-al) => cdr]
+          [else sigcode])))
+    
+    (define signal-name->signal-code
+      (lambda (signame)        
+        (cond
+          [(find (lambda (p) (eqv? (cdr p) signame)) signal-names-al) => car]
+          [else #f])))
+  )
+  
+  (define kill
+    (lambda (pid signame)
+      (define who 'kill)
+      (unless (fixnum? pid) (die who "not a fixnum" pid))
+      (unless (symbol? signame) (die who "not a symbol" signame))
+      (let ([r (foreign-call "ikrt_kill" pid
+                 (or (signal-name->signal-code signame)
+                     (die who "invalid signal name" signame)))])
+        (when (fx< r 0)
+          (error who (strerror r) pid signame)))))
+
+  (define-struct wstatus (pid exit-status received-signal))
+
   (define waitpid
-    (lambda (pid)
+    ;; If block? is #f and waitpid() would have blocked,
-      (unless (fixnum? pid)
+    ;; or if want-error? is #f and there was an error,
-        (die 'waitpid "not a fixnum" pid))
+    ;; the value returned is #f
-      (let ([r (foreign-call "ikrt_waitpid" pid)])
+    (case-lambda
-        (if (fx< r 0)
+      [() (waitpid -1 #t #t)]
-            (raise/strerror 'waitpid r)
+      [(pid) (waitpid pid #t #t)]
-            r))))
+      [(pid block?) (waitpid pid block? #t)]
+      [(pid block? want-error?)
+       (define who 'waitpid)
+       (unless (fixnum? pid) (die who "not a fixnum" pid))
+       (unless (boolean? block?) (die who "not a boolean" block?))
+       (let ([r (foreign-call "ikrt_waitpid" (make-wstatus #f #f #f) pid block?)])
+         (cond 
+           [(wstatus? r)
+            (set-wstatus-received-signal! r
+              (signal-code->signal-name 
+                (wstatus-received-signal r)))
+            r]
+           [want-error?
+            (error who (strerror r) pid)]
+           [else #f]))]))
 
   (define system
     (lambda (x)

scheme/ikarus.strings.ss

@@ -497,7 +497,8 @@
   (define uuid
     (lambda ()
       (let ([s ($make-bytevector 16)])
-        (utf8->string
+        (let ([r (foreign-call "ik_uuid" s)])
-          (or (foreign-call "ik_uuid" s)
+          (if (bytevector? r)
-              (die 'uuid "failed!"))))))
+              (utf8->string r)
+              (error 'uuid "cannot obtain unique id"))))))
   )

scheme/last-revision

@@ -1 +1 @@
-1514
+1515

scheme/makefile.ss

@@ -393,6 +393,10 @@
     [process                                     i]
     [process-nonblocking                         i]
     [waitpid                                     i]
+    [wstatus-pid                                 i]
+    [wstatus-exit-status                         i]
+    [wstatus-received-signal                     i]
+    [kill                                        i]
     [installed-libraries                         i]
     [library-path                                i]
     [library-extensions                          i]

src/ikarus-io.c

@@ -272,7 +272,7 @@ ikrt_accept(ikptr s, ikptr bv /*, ikpcb* pcb */){
 }
 
 ikptr
-ikrt_shutdown(ikptr s, ikpcb* pcb){
+ikrt_shutdown(ikptr s /*, ikpcb* pcb*/){
 #ifdef __CYGWIN__
   int err = close(unfix(s));
 #else

src/ikarus-process.c

@@ -23,6 +23,7 @@
 #include <stdio.h>
 #include <string.h>
 #include <errno.h>
+#include <signal.h>
 #include "ikarus-data.h"
 
 extern ikptr ik_errno_to_code();
@@ -91,14 +92,112 @@ ikrt_process(ikptr rvec, ikptr cmd, ikptr argv /*, ikpcb* pcb */){
   }
 }
 
+typedef struct signal_info {
+  int n;
+  ikptr c;
+} signal_info;
+
+#define signal_info_table_len 28
+
+static signal_info signal_info_table[signal_info_table_len] = {
+  /* Signals from POSIX */
+  {SIGABRT,     fix(1)},
+  {SIGALRM,     fix(2)},
+  {SIGBUS,      fix(3)},
+  {SIGCHLD,     fix(4)},
+  {SIGCONT,     fix(5)},
+  {SIGFPE,      fix(6)},
+  {SIGHUP,      fix(7)},
+  {SIGILL,      fix(8)},
+  {SIGINT,      fix(9)},
+  {SIGKILL,     fix(10)},
+  {SIGPIPE,     fix(11)},
+  {SIGQUIT,     fix(12)},
+  {SIGSEGV,     fix(13)},
+  {SIGSTOP,     fix(14)},
+  {SIGTERM,     fix(15)},
+  {SIGTSTP,     fix(16)},
+  {SIGTTIN,     fix(17)},
+  {SIGTTOU,     fix(18)},
+  {SIGUSR1,     fix(19)},
+  {SIGUSR2,     fix(20)},
+#ifdef SIGPOLL
+  {SIGPOLL,     fix(21)},
+#else
+  {SIGEMT,      fix(21)},
+#endif
+  {SIGPROF,     fix(22)},
+  {SIGSYS,      fix(23)},
+  {SIGTRAP,     fix(24)},
+  {SIGURG,      fix(25)},
+  {SIGVTALRM,   fix(26)},
+  {SIGXCPU,     fix(27)},
+  {SIGXFSZ,     fix(28)}
+};
+
+
 ikptr
-ikrt_waitpid(ikptr pid /*, ikpcb* pcb */){
+ik_signal_num_to_code(int signum){
-  int status;
+  signal_info* si;
-  pid_t r = waitpid(unfix(pid), &status, 0);
+  int i;
-  if(r >= 0){
+  for(i=0; i < signal_info_table_len; i++){
-    return fix(status);
+    si = &signal_info_table[i];
-  } else {
+    if(si->n == signum){
-    return ik_errno_to_code();
+      return si->c;
+    }
   }
+  fprintf(stderr, "\n*** ik_signal_num_to_code: Don't know signal %d ***\n\n", 
+          signum);
+  return fix(99999);
+}
+
+int
+ik_signal_code_to_num(ikptr sigcode){
+  signal_info* si;
+  int i;
+  for(i=0; i < signal_info_table_len; i++){
+    si = &signal_info_table[i];
+    if(si->c == sigcode){
+      return si->n;
+    }
+  }
+  fprintf(stderr, "ik_signal_code_to_num: Don't know code %ld\n",
+          unfix(sigcode));
+  exit(EXIT_FAILURE);
+  return 0;
+}
+
+ikptr
+ikrt_kill(ikptr pid, ikptr sigcode /*, ikpcb* pcb */){
+  int r = kill((pid_t)unfix(pid), ik_signal_code_to_num(sigcode));
+  if(r == 0){
+    return fix(0);
+  }
+  return ik_errno_to_code();
+}
+
+ikptr 
+ikrt_waitpid(ikptr rvec, ikptr pid, ikptr block /*, ikpcb* pcb */){
+  /* rvec is assumed to come in as #(#f #f #f) */
+  int status, options = 0;
+  if(block == false_object){
+    options = WNOHANG;
+  }
+  pid_t r = waitpid(unfix(pid), &status, options);
+  if(r > 0){
+    ref(rvec, off_record_data+0*wordsize) = fix(r);
+    if(WIFEXITED(status)) {
+      ref(rvec, off_record_data+1*wordsize) = fix(WEXITSTATUS(status));
+    }
+    if(WIFSIGNALED(status)) {
+      ref(rvec, off_record_data+2*wordsize) = 
+        ik_signal_num_to_code(WTERMSIG(status));
+    }
+  }else if(r == 0){  /* would have blocked */
+    ;  /* let rvec return as all #f's */
+  }else {
+    return ik_errno_to_code();
+  }
+  return rvec;
 }
 

src/ikarus-runtime.c

@@ -539,13 +539,16 @@ ikptr ik_uuid(ikptr bv){
   if(fd == -1){
     fd = open("/dev/urandom", O_RDONLY);
     if(fd == -1){
-      return false_object;
+      return ik_errno_to_code();
     }
     uuid_strlen = strlen(uuid_chars);
   }
   long int n = unfix(ref(bv, off_bytevector_length));
   unsigned char* data = (unsigned char*)(long)(bv+off_bytevector_data);
-  read(fd, data, n);
+  int r = read(fd, data, n);
+  if(r < 0){
+    return ik_errno_to_code();
+  }
   unsigned char* p = data;
   unsigned char* q = data + n;
   while(p < q){