From 5c72a6dad2e6b9c6411a5b29b0e5a950d62220cc Mon Sep 17 00:00:00 2001
From: cresh <cresh>
Date: Tue, 7 May 2002 09:48:53 +0000
Subject: [PATCH] revised concurrent-lookup

---
 dns.scm | 98 +++++++++++----------------------------------------------
 1 file changed, 19 insertions(+), 79 deletions(-)

diff --git a/dns.scm b/dns.scm
index 00096ed..e71dd02 100644
--- a/dns.scm
+++ b/dns.scm
@@ -802,93 +802,33 @@
 
 
 
-;; lookup-queue record for concurrent-lookup
-(define-record lookup-queue
-  lock
-  cond-lock
-  queue)
-
-;; Lock-Conditions
-(define-record lock-condition
-  lock
-  waiting-locks)
-
-(define (wait-lock-condition lock-cond)
-  (let ((waiting-lock (make-lock)))
-    (obtain-lock waiting-lock)
-    (set-lock-condition:waiting-locks
-     lock-cond
-     (cons waiting-lock
-	   (lock-condition:waiting-locks lock-cond)))
-    (let ((lock (lock-condition:lock lock-cond)))
-      (release-lock lock)
-      (obtain-lock waiting-lock)
-      (obtain-lock lock))))
-
-(define (signal-lock-condition lock-cond)
-  (let ((waiting-locks (lock-condition:waiting-locks lock-cond)))
-    (if (not (null? waiting-locks))
-	(begin
-	  (set-lock-condition:waiting-locks lock-cond
-					     (cdr waiting-locks))
-	  (release-lock (car waiting-locks))))))
-
-(define (broadcast-lock-condition lock-cond)
-  (let ((waiting-locks (lock-condition:waiting-locks lock-cond)))
-    (set-lock-condition:waiting-locks lock-cond '())
-    (let loop ((waiting-locks waiting-locks))
-      (if (not (null? waiting-locks))
-	  (begin
-	    (release-lock (car waiting-locks))
-	    (loop (cdr waiting-locks)))))))
-
-;; with-lock
-(define (with-lock lock thunk)
-  (obtain-lock lock)
-  (let ((value (thunk)))
-    (release-lock lock)
-    value))
-
-
 ;; concurrent-lookup
 ;; starts a <lookup>-lookup to all nameservers in (dns-find-nameserver-list)
 (define (concurrent-lookup lookup name)
-  (let* ((return 'not-terminated-yet)
+  (let* ((return 'no-value)
 	 (lock (make-lock))
-	 (ccl (make-lookup-queue lock (make-lock-condition lock '()) (make-queue))))
+	 (queue (make-queue)))
+
+    (obtain-lock lock)
 
-    (spawn
-     (lambda ()
-       (display "consumer started \n")
-       (with-lock lock 
-		  (lambda ()
-		    (let loop ()
-		      (let ((queue (lookup-queue:queue ccl)))
-			(if (queue-empty? queue)
-			    (begin
-			      (wait-lock-condition (lookup-queue:cond-lock ccl))
-			      (loop))
-			    (let ((value (dequeue! queue)))
-			      (set! return value)
-			      value))))))))
     (spawn (lambda ()
-    (for-each (lambda (nameserver)
-		(spawn
-		 (lambda ()
-		   (display nameserver)(display "  started\n")
-		   (with-lock lock
-			      (lambda ()
-				(let* ((result (apply lookup (list name nameserver))))
-				  (enqueue! (lookup-queue:queue ccl) result)
-				  (display nameserver)(display "  ")(display result)(newline)
-				  (broadcast-lock-condition (lookup-queue:cond-lock ccl))))))))
-	      (dns-find-nameserver-list))))
+	     (for-each (lambda (nameserver)
+			 (spawn
+			  (lambda ()
+			    (display nameserver)(display "  started\n")
+			    (let* ((result (apply lookup (list name nameserver))))
+			      (enqueue! queue result)
+			      (display nameserver)(display "  ")(display result)(newline)
+			      (release-lock lock)))))
+	     (dns-find-nameserver-list))))
 
-;; ### active waiting ?
+    (display "Consumer started\n")
     (let loop ()
-      (if (not (eq? return 'not-terminated-yet))
-	  return
-	  (loop)))))
+      (obtain-lock lock)
+      (let ((result (dequeue! queue)))
+	(if result
+	    result
+	    (loop))))))
 		       
 ;; checks the arguments of the dns-lookup-* functions.
 ;; if a nameserver-name is given and not a nameserver-ip