Re: external events api

Roderic Morris <[email protected]> Tue, 2 Aug 2011 22:40:52 -0400
Newsgroups gmane.lisp.scheme.scheme48
Message-ID <[email protected]>
On Jul 25, 2011, at 1:49 AM, Marcus Crestani wrote:
> There is a section "External events" in the development version of the
> documentation that describes how to use external events, see
> doc/src/external.tex.

Ahh, thanks, I was looking in 1.8's manual.

> Right, since the uids have to be shared between Scheme and C anyway,
> they could also be created in Scheme and then exported to C.  This
> functionality is currently only in the VM, though.

Ok. I just created some c functions that do only those actions (note, create, or unregister) to make experimenting with this easier.

I've run into what look like bugs in this API unfortunately. I've tried a few things to try to get wait-for-child-process to use wait-for-external-events, and most have worked in the simple and most common case of only one thread waiting on a particular process id, but all have failed for some reason on the multiple thread case.

In the first one, I tried noting and unregistering a process id's external event uid as soon as the sigchld came in. That didn't work, and it's reasonable that the external events system would require you to unregister after all waiting threads are awake.

In the next, I tried having all threads waiting on a given process id wait on one uid that was a field of the process id. I expected that they'd all be woken up when the uid was noted, but only the first thread to wait did. I didn't think that was right, but I tried to get around it, and at least get wait-for-child-process working.

For the next implementation, i tried having a process id have a queue of uids which would be added to when a process waits on it. All the uids in the queue would be noted when the sigchld comes in, and each thread would unregister the uid it added to the queue. In this case too, only the first thread that waited is woken. Oddly, if I start multiple threads waiting on *different* process-ids, they are all woken if the sigchilds come in at sufficiently long intervals. If the sigchilds come in too close together, it has the same effect as waiting for one process id with multiple threads (some aren't woken up). It seems that this api has trouble with notes happening in quick succession.

Does anyone have any insight as to what's going on? I've attached a patch for the last implementation and example code that demonstrates the problem.

-Roderic
example.scm (application/octet-stream, 553 B) - not displayed
wait-event-queues.patch (application/octet-stream, 5.9 KB)
diff --git a/c/posix/proc.c b/c/posix/proc.c
--- a/c/posix/proc.c
+++ b/c/posix/proc.c
@@ -29,6 +29,9 @@
 				   s48_ref_t env, s48_ref_t args),
   			posix_enter_pid(s48_call_t call, s48_ref_t pid),
   			posix_waitpid(s48_call_t call),
+      posix_create_wait_uid(s48_call_t call),
+      posix_note_wait_uid(s48_call_t call, s48_ref_t wait_uid),
+      posix_unregister_wait_uid(s48_call_t call, s48_ref_t wait_uid),
 			posix_integer_to_signal(s48_call_t call, s48_ref_t sig_int),
 			posix_initialize_named_signals(s48_call_t call),
 			posix_request_interrupts(s48_call_t call, s48_ref_t int_number),  
@@ -90,6 +93,9 @@
   S48_EXPORT_FUNCTION(posix_exec);
   S48_EXPORT_FUNCTION(posix_enter_pid);
   S48_EXPORT_FUNCTION(posix_waitpid);
+  S48_EXPORT_FUNCTION(posix_create_wait_uid);
+  S48_EXPORT_FUNCTION(posix_note_wait_uid);
+  S48_EXPORT_FUNCTION(posix_unregister_wait_uid);
   S48_EXPORT_FUNCTION(posix_integer_to_signal);
   S48_EXPORT_FUNCTION(posix_initialize_named_signals);
   S48_EXPORT_FUNCTION(posix_request_interrupts);
@@ -252,7 +258,7 @@
  * Waiting for children.  We get finished pid's until we reach one for which
  * there is a Scheme pid record.  The exit status or terminating signal is
  * saved in the record which is then returned.
- *
+ * 
  * This does not looked for stopped children, only terminated ones.
  */
 
@@ -289,6 +295,24 @@
   }
 }
 
+static s48_ref_t
+posix_create_wait_uid(s48_call_t call) {
+  long wait_uid = s48_external_event_uid();
+  return s48_enter_long_2(call, wait_uid);
+}
+
+static s48_ref_t
+posix_note_wait_uid(s48_call_t call, s48_ref_t wait_uid) {
+  s48_note_external_event(s48_extract_long_2(call, wait_uid));
+  return s48_unspecific_2(call);
+}
+
+static s48_ref_t
+posix_unregister_wait_uid(s48_call_t call, s48_ref_t wait_uid) {
+  s48_unregister_external_event_uid(s48_extract_long_2(call, wait_uid));
+  return s48_unspecific_2(call);
+}
+
 /*
  * Fork and exec.
  */
diff --git a/scheme/posix/packages.scm b/scheme/posix/packages.scm
--- a/scheme/posix/packages.scm
+++ b/scheme/posix/packages.scm
@@ -245,6 +245,8 @@
 
 (define-structure posix-processes posix-processes-interface
   (open scheme
+  (subset external-events (wait-for-external-event))
+  (subset queues (make-queue enqueue! queue->list))
 	define-record-types finite-types
 	reinitializers
 	external-calls load-dynamic-externals
diff --git a/scheme/posix/proc.scm b/scheme/posix/proc.scm
--- a/scheme/posix/proc.scm
+++ b/scheme/posix/proc.scm
@@ -90,7 +90,10 @@
   ; The rest are initially #F and are set as events warrant.
   (exit-status process-id-exit-status)
   (terminating-signal process-id-terminating-signal)
-  (placeholder process-id-placeholder set-process-id-placeholder!))
+  ;; When a thread waits on this process id, it'll add its uid to this queue, and keep a
+  ;; reference. When the event comes in, the event handler will note all the uids in the queue. When
+  ;; each waiting thread wakes up, it'll unregister its uid.
+  (wait-queue process-id-wait-queue set-process-id-wait-queue!))
 
 (define-record-discloser :process-id
   (lambda (process-id)
@@ -116,7 +119,7 @@
 
 ; Wait for a child process.  If the child isn't already known to have terminated
 ; we process any waiting, terminated children and try again.  If it still hasn't
-; finished we created a placeholder for it and block.
+; finished we created an external event uid for it and block.
 
 (define (wait-for-child-process pid)
   (if (not (process-id? pid))
@@ -124,40 +127,49 @@
   (or (process-id-exit-status pid)
       (process-id-terminating-signal pid)
       (begin
-	(process-terminated-children pid)
-	(disable-interrupts!)
-	(or (process-id-exit-status pid)
-	    (process-id-terminating-signal pid)
-	    (let ((placeholder (or (process-id-placeholder pid)
-				   (let ((p (make-placeholder)))
-				     (set-process-id-placeholder! pid p)
-				     p))))
-	      (placeholder-value placeholder)))
-	(enable-interrupts!)))
+        (process-terminated-children pid)
+        (disable-interrupts!)
+        (or (process-id-exit-status pid)
+            (process-id-terminating-signal pid)
+            (really-wait-for-child-process pid))
+        (enable-interrupts!)))
   (values))
 
+(define (really-wait-for-child-process pid)
+  (let ((wait-queue (or (process-id-wait-queue pid)
+                        (let ((new-queue (make-queue)))
+                          (set-process-id-wait-queue! pid new-queue)
+                          new-queue)))
+        (wait-uid (posix-create-wait-uid)))
+    (enqueue! wait-queue wait-uid)
+    (wait-for-external-event wait-uid)
+    (posix-unregister-wait-uid wait-uid)))
+
 ; Waiting for children.  We go through the terminated child processes until we
 ; find the one we are looking for or we run out.  This needs to be called by
 ; the SIGCHLD handler.
 
 (define (process-terminated-children . maybe-pid)
   (let ((pid (if (null? maybe-pid)
-		 #f
-		 (car maybe-pid))))
+                 #f
+                 (car maybe-pid))))
     (let loop ()
       (let ((next (posix-waitpid)))
-	(if next
-	    (let ((placeholder (process-id-placeholder next)))
-	      (if placeholder
-		  (begin
-		    (placeholder-set! placeholder #t)
-		    (set-process-id-placeholder! next #f))) ; no longer needed
-	      (if (not (eq? pid next))
-		  (loop))))))))
+        (if next
+            (let ((wait-queue (process-id-wait-queue next)))
+              (if wait-queue
+                  (begin
+                    (for-each (lambda (x) (posix-note-wait-uid x))
+                              (queue->list wait-queue))
+                    (set-process-id-wait-queue! next #f)))
+              (if (not (eq? pid next))
+                  (loop))))))))
 
 (import-lambda-definition-2 posix-waitpid ())
+(import-lambda-definition-2 posix-create-wait-uid ())
+(import-lambda-definition-2 posix-note-wait-uid (wait-uid))
+(import-lambda-definition-2 posix-unregister-wait-uid (wait-uid))
 
 (define (exit status)
   (force-channel-output-ports!)
   (scheme-exit-now status))
-