gnunet-svn
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables.


From: gnunet
Subject: [gnunet-scheme] 16/42: cadet/client: Avoid (mutating) hash tables.
Date: Sat, 10 Sep 2022 19:08:09 +0200

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit a5969fcdf965abe18f701d4a7eed6cb1dc90787e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Sep 9 15:09:33 2022 +0200

    cadet/client: Avoid (mutating) hash tables.
    
    real    0m10,590s
    user    0m18,427s
    sys     0m1,969s
    
    Fits better in (gnu gnunet server) that way.
    
    * gnu/gnunet/cadet/client.scm (reconnect): Use a bbtree instead of a
    hash table, without mutation.
    (connect): Adjust appropriately.
---
 gnu/gnunet/cadet/client.scm | 77 ++++++++++++++++++++++++---------------------
 1 file changed, 41 insertions(+), 36 deletions(-)

diff --git a/gnu/gnunet/cadet/client.scm b/gnu/gnunet/cadet/client.scm
index bc1b8b8..af58f32 100644
--- a/gnu/gnunet/cadet/client.scm
+++ b/gnu/gnunet/cadet/client.scm
@@ -88,12 +88,12 @@
                let^)
          (only (rnrs base)
                begin define lambda assert quote cons apply values
-               case else = define-syntax + expt - let* let and >
-               not if eq?)
+               case else = define-syntax + expt - let and >
+               not if eq? <)
          (only (rnrs control)
                when unless)
-         (only (rnrs hashtables)
-               make-eqv-hashtable hashtable-ref hashtable-set!)
+         (only (pfds bbtrees)
+               bbtree-set  make-bbtree bbtree-ref)
          (only (rnrs records syntactic) define-record-type)
          (only (ice-9 control) let/ec)
          (only (ice-9 match) match)
@@ -104,6 +104,8 @@
                signal-condition!)
          (only (fibers operations)
                wrap-operation choice-operation perform-operation)
+         (only (srfi srfi-26)
+               cut)
          (only (srfi srfi-45)
                delay force))
   (begin
@@ -150,6 +152,8 @@
                    ((%make (losable-lost-and-found server)) server
                     destination options #false #false message-queue 0)))))
 
+    (define empty-bbtree (make-bbtree <))
+
     (define* (connect config #:key (connected values) (disconnected values)
                      (spawn spawn-fiber))
       "Asynchronuously connect to the CADET service, using the configuration
@@ -160,17 +164,15 @@
                       (server-control-channel server)
                       connected disconnected spawn
                       (losable-lost-and-found server)
-                      ;; integers cannot be compares with eq?,
-                      ;; but they can be with eqv?
-                      (make-eqv-hashtable))
+                      empty-bbtree)
       server)
 
     ;; TODO: reduce duplication with (gnu gnunet dht client)
     (define (spawn-procedure spawn . rest)
       (spawn (lambda () (apply reconnect rest))))
 
-    ;; channel-number->channel-hash-map:
-    ;;   A hash map from channel numbers to their corresponding
+    ;; channel-number->channel-map:
+    ;;   A 'bbtree' from channel numbers to their corresponding
     ;;   <channel> object, or nothing if the control loop
     ;;   has not processes 'open-channel!' yet or if the channel
     ;;   has been closed.
@@ -179,7 +181,7 @@
     (define (reconnect config terminal-condition control-channel
                       connected disconnected spawn
                       lost-and-found
-                      channel-number->channel-hash-map)
+                      channel-number->channel-map)
       (define loop-operation
        (choice-operation
         (get-operation control-channel)
@@ -222,13 +224,13 @@
                            control-channel))
       (define mq (connect/fibers config "cadet" handlers error-handler
                                 #:spawn spawn))
-      (define (k/reconnect!)
+      (define (k/reconnect! channel-number->channel-map)
        (reconnect config terminal-condition control-channel connected
                   disconnected spawn lost-and-found
-                  channel-number->channel-hash-map))
-      (define (control next-free-channel-number)
+                  channel-number->channel-map))
+      (define (control channel-number->channel-map next-free-channel-number)
        "The main event loop."
-       (control* next-free-channel-number
+       (control* channel-number->channel-map next-free-channel-number
                  (perform-operation loop-operation)))
       (define (close-if-possible! channel)
        ;; Pre-conditions:
@@ -242,11 +244,13 @@
                          (channel-channel-number channel)))
          ;; We don't need the envelope.
          (values)))
-      (define (control* next-free-channel-number message)
+      (define (control* channel-number->channel-map next-free-channel-number
+                       message)
        (define (continue)
-         (control next-free-channel-number))
+         (control channel-number->channel-map next-free-channel-number))
        (define (continue* message)
-         (control* next-free-channel-number message))
+         (control* channel-number->channel-map next-free-channel-number
+                   message))
        ;; TODO: what about closed channels?
        (define (send-channel-stuff! channel)
          ;; Send messages one-by-one, keeping in mind that we might not be able
@@ -317,17 +321,17 @@
            (close-if-possible! channel)))
        (match message
          (('open-channel! channel)
-          (let* ((channel-number next-free-channel-number)
+          (let^ ((! channel-number next-free-channel-number)
                  ;; TODO: handle overflow, and respect bounds
-                 (next-free-channel-number (+ 1 next-free-channel-number)))
-            (set-channel-channel-number! channel channel-number)
-            ;; Keep track of the new <channel> object; it will be required
-            ;; later by 'acknowledgement'.
-            (hashtable-set! channel-number->channel-hash-map
-                            channel-number
-                            channel)
-            (send-local-channel-create! mq channel)
-            (control next-free-channel-number)))
+                 (! next-free-channel-number (+ 1 next-free-channel-number))
+                 (_ (set-channel-channel-number! channel channel-number))
+                 ;; Keep track of the new <channel> object; it will be required
+                 ;; later by 'acknowledgement'.
+                 (! channel-number->channel-map
+                    (bbtree-set channel-number->channel-map channel-number
+                                channel)))
+                (send-local-channel-create! mq channel)
+                (control channel-number->channel-map 
next-free-channel-number)))
          (('close-channel! channel)
           ;; 'close-channel!' can only be sent after the <channel> object
           ;; was returned by the procedure 'open-channel!', because only
@@ -358,11 +362,9 @@
           ;; so for now nothing can be done.
           (continue))
          (('acknowledgement channel-number)
-          (let^ ((! channel (hashtable-ref channel-number->channel-hash-map
-                                           channel-number
-                                           #false))
-                 (? (not channel)
-                    ???))
+          ;; TODO: failure case
+          (let^ ((! channel
+                    (bbtree-ref channel-number->channel-map channel-number)))
                 ;; The service is allowing us to send another message;
                 ;; update the number of allowed messages.
                 (set-channel-allow-send!
@@ -377,8 +379,8 @@
          ;; Respond to a query of the msg:cadet:local:data message handler.
          (('channel answer-box channel-number)
           (answer answer-box
-                  (hashtable-ref channel-number->channel-hash-map
-                                 channel-number #false))
+                  (bbtree-ref channel-number->channel-map
+                              channel-number (lambda () #false)))
           (continue))
          (('lost . lost)
           (let loop ((lost lost))
@@ -391,9 +393,12 @@
                   (loop rest))
                  ((? server:cadet? lost)
                   (continue* '(disconnect!))))))))
-         (rest (handle-control-message! rest mq terminal-condition 
k/reconnect!))))
+         (rest
+          (handle-control-message!
+           rest mq terminal-condition
+           (cut k/reconnect! channel-number->channel-map)))))
       ;; Start the main event loop.
-      (control %minimum-local-channel-id))
+      (control channel-number->channel-map %minimum-local-channel-id))
 
     (define-record-type (<cadet-address> make-cadet-address cadet-address?)
       (fields (immutable peer cadet-address-peer)

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]