Keep the log queue on a maximum depth.

main.rkt

@@ -83,53 +83,63 @@
         (l (hash-ref log-hash level 6)))
     (>= l ll)))
 
-(define logger-thread
+(define logger-thread #f)
-  (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@@")
+(when (eq? logger-thread #f)
-               (let ((sem (hash-ref sync-sems topic #f)))
+  (set! logger-thread 
-                 (if (eq? sem #f)
+        (thread
-                     (begin
+         (λ () (let loop ()
-                       (set! msg (format "Cannot synchronize on topic ~a" topic))
+                 (let* ((v (sync log-queue))
-                       (set! level 'error))
+                        (level (vector-ref v 0))
-                     (begin
+                        (msg (vector-ref v 1))
-                       (semaphore-post sem)
+                        (data (vector-ref v 2))
-                       (set! msg (format "Synchronization received on topic ~a" topic))
+                        (dt (car data))
-                       (set! level 'info)
+                        (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)
+                       (begin
+                         (enqueue! buffer-queue (list topic level dt msg))
+                         (let loop ()
+                           (when (> (queue-length buffer-queue) max-log-queue-len)
+                             (dequeue! buffer-queue)
+                             (loop)))
+                         )
+                       (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))
+                         )
                        )
-                     )))
 
-             (if (null? lc)
+                   (loop))))
-                 (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)