Add thread-queue/dequeue-no-hang!, rm peek-until, fix -no-hang.

Fix when-non-empty-before, which did not append! to waiting-dequeuers,
and thus would only time out.

Un-export peek-until.  Its TIME argument is... weird -- not universal.
Swat can import it.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index edd60d92271a487d6b882cee4dffa0b2566d52d6..8a7dd8801945f489fe810296f3c603aeec78dd8b 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -577,9 +577,9 @@ USA.
          thread-queue/queue-no-hang!
          thread-queue/push!
          thread-queue/dequeue!
-         thread-queue/peek-no-hang
-         thread-queue/peek-until
-         thread-queue/peek))
+         thread-queue/dequeue-no-hang!
+         thread-queue/peek
+         thread-queue/peek-no-hang))
 
 (define-package (runtime simple-file-ops)
   (files "sfile")

diff --git a/src/runtime/thread-queue.scm b/src/runtime/thread-queue.scm
index fcbae0b3a75ceb42c859e89f65e71d2de13a503b..d3259a34f49161e39b0401dccd9004a8887d9a50 100644 (file)
--- a/src/runtime/thread-queue.scm
+++ b/src/runtime/thread-queue.scm
@@ -75,12 +75,14 @@ USA.
     (%make-thread-queue #f #f 0 max '() '())))
 
 (define (thread-queue/empty? queue)
+  (guarantee-thread-queue queue 'thread-queue/empty?)
   (%empty? queue))
 
 (define-integrable (%empty? queue)
   (zero? (%thread-queue/element-count queue)))
 
 (define (thread-queue/empty! queue)
+  (guarantee-thread-queue queue 'thread-queue/empty!)
   (without-interrupts
    (lambda ()
      (if (not (%empty? queue))
@@ -92,6 +94,7 @@ USA.
   unspecific)
 
 (define (thread-queue/queue! queue item)
+  (guarantee-thread-queue queue 'thread-queue/queue!)
   (if (not item) (error "Cannot queue #F:" queue))
   (without-interrupts
    (lambda ()
@@ -104,6 +107,7 @@ USA.
 
 (define (thread-queue/queue-no-hang! queue item)
   ;; Returns #F when QUEUE is maxed out.
+  (guarantee-thread-queue queue 'thread-queue/queue-no-hang!)
   (if (not item) (error "Cannot queue #F:" queue))
   (without-interrupts
    (lambda ()
@@ -117,15 +121,13 @@ USA.
            #f)
        (%queue! queue item))))
 
-(define (thread-queue/dequeue-no-hang queue msec)
-  (guarantee-thread-queue queue 'thread-queue/dequeue-no-hang)
-  (guarantee-non-negative-fixnum msec 'thread-queue/dequeue-no-hang)
+(define (thread-queue/dequeue-no-hang! queue msec)
+  (guarantee-thread-queue queue 'thread-queue/dequeue-no-hang!)
+  (guarantee-non-negative-fixnum msec 'thread-queue/dequeue-no-hang!)
   (thread-queue/dequeue-until
    queue (+ (real-time-clock) (internal-time/seconds->ticks (/ msec 1000)))))
 
-(define (thread-queue/dequeue-until queue time)
-  (guarantee-thread-queue queue 'thread-queue/dequeue-until)
-  (guarantee-integer time 'thread-queue/dequeue-until)
+(define (thread-queue/dequeue-until! queue time)
   (when-non-empty-before time queue %dequeue!))
 
 (declare (integrate-operator when-non-empty-before))
@@ -139,11 +141,15 @@ USA.
             (if (<= time now)
                 #f
                 (begin
+                  (set-%thread-queue/waiting-dequeuers!
+                   queue (append! (%thread-queue/waiting-dequeuers queue)
+                                  (list (current-thread))))
                   (register-timer-event (- time now) (lambda () unspecific))
                   (suspend-current-thread)
                   (loop)))))))))
 
 (define (thread-queue/dequeue! queue)
+  (guarantee-thread-queue queue 'thread-queue/dequeue!)
   (without-interrupts
    (lambda ()
      (do ()
@@ -161,11 +167,10 @@ USA.
    queue (+ (real-time-clock) (internal-time/seconds->ticks (/ msec 1000)))))
 
 (define (thread-queue/peek-until queue time)
-  (guarantee-thread-queue queue 'thread-queue/peek-until)
-  (guarantee-integer time 'thread-queue/peek-until)
   (when-non-empty-before time queue %peek))
 
 (define (thread-queue/peek queue)
+  (guarantee-thread-queue queue 'thread-queue/peek)
   (without-interrupts
    (lambda ()
      (do ()
@@ -222,6 +227,7 @@ USA.
 
 (define (thread-queue/push! queue item)
   ;; Place ITEM at the head of the queue, instead of the end.
+  (guarantee-thread-queue queue 'thread-queue/push!)
   (if (not item) (error "Cannot queue #F:" queue))
   (without-interrupts
    (lambda ()