Internal definitions other

main.rkt

@@ -3,6 +3,7 @@
 (require (for-syntax racket/syntax)
          racket/date
          racket-sprintf
+         racket/async-channel
          data/queue
          )
 
@@ -44,7 +45,8 @@
 (set! log-level 'debug)
 
 (define max-log-queue-len 1000)
-(define log-queue (make-queue))
+(define log-queue (make-async-channel))
+(define buffer-queue (make-queue))
 
 (define (sl-set-log-level l)
   (if (or
@@ -81,52 +83,64 @@
         (l (hash-ref log-hash level 6)))
     (>= l ll)))
 
+(define logger-thread
+  (thread
+   (λ () (let loop ()
+           (let* ((v (sync log-queue))
+                  (level (vector-ref v 0))
+                  (msg (vector-ref v 1))
+                  (data (vector-ref v 2))
+                  (dt (car data))
+                  (topic (cadr data))
+                  (lc log-callbacks)
+                  )
+
+             (when (string=? msg "@@SYNC@@")
+               (let ((sem (hash-ref sync-sems topic #f)))
+                 (if (eq? sem #f)
+                     (begin
+                       (set! msg (format "Cannot synchronize on topic ~a" topic))
+                       (set! level 'error))
+                     (begin
+                       (semaphore-post sem)
+                       (set! msg (format "Synchronization received on topic ~a" topic))
+                       (set! level 'info)
+                       )
+                     )))
+
+             (if (null? lc)
+                 (enqueue! buffer-queue (list topic level dt msg))
+                 (begin
+                   (when (> (queue-length buffer-queue) 0)
+                     (for-each (λ (log-entry)
+                                 (when (needs-logging (cadr log-entry))
+                                   (for-each (λ (e)
+                                               (let ((callback (cdr e)))
+                                                 (apply callback log-entry)))
+                                             lc)))
+                               (queue->list buffer-queue))
+                     (set! buffer-queue (make-queue)))
+                   (when (needs-logging level)
+                     (for-each (λ (e)
+                                 (let ((callback (cdr e)))
+                                   (callback topic level dt msg)))
+                               lc))
+                   )
+                 )
+
+             (loop))))
+   )
+  )
+
 (define (log-to* receiver log-callbacks)
   (void
    (thread
     (λ () (let loop ()
-            (let* ((v (sync receiver))
+            (let* ((v (sync receiver)))
-                   (level (vector-ref v 0))
+              (async-channel-put log-queue v))
-                   (msg (vector-ref v 1))
-                   (data (vector-ref v 2))
-                   (dt (car data))
-                   (topic (cadr data))
-                   (lc (log-callbacks))
-                   )
-
-              (when (string=? msg "@@SYNC@@")
-                (let ((sem (hash-ref sync-sems topic #f)))
-                  (if (eq? sem #f)
-                      (begin
-                        (set! msg (format "Cannot synchronize on topic ~a" topic))
-                        (set! level 'error))
-                      (begin
-                        (semaphore-post sem)
-                        (set! msg (format "Synchronization received on topic ~a" topic))
-                        (set! level 'info)
-                        )
-                      )))
-
-              (enqueue! log-queue (list topic level dt msg))
-              (unless (null? lc)
-                (for-each (λ (log-entry)
-                            (when (needs-logging (cadr log-entry))
-                              (for-each (λ (e)
-                                          (let ((callback (cdr e)))
-                                            (apply callback log-entry)))
-                                        lc))
-                            )
-                          (queue->list log-queue))
-                (set! log-queue (make-queue)))
-              (when (> (queue-length log-queue) max-log-queue-len)
-                (dequeue! log-queue))
-              )
             (loop)
-            )
+            )))
-      )
+   ))
-    )
-   )
-  )
 
 (define-syntax sl-log-to
   (syntax-rules (log-callbacks)