revised concurrent-lookup

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)
+			      (enqueue! queue result)
 			      (display nameserver)(display "  ")(display result)(newline)
-				  (broadcast-lock-condition (lookup-queue:cond-lock ccl))))))))
+			      (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