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 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