better per-thread *random-state* for crons

chatikbot.asd

@@ -19,6 +19,7 @@
                #:log4cl
                #:plump
                #:sqlite
+               #:trivial-garbage
                #:uuid
                #:quri
                #:yason)

common.lisp

@@ -138,6 +138,7 @@
            :error
            :raw-state
            :state
+           :with-random-state
            :defcron
            :on-next-message
            :get-inline-keyboard

macros.lisp

@@ -11,6 +11,7 @@
            :def-callback-section-handler
            :def-oauth-handler
            :def-oauth-section-handler
+           :with-random-state
            :defcron))
 (in-package #:chatikbot.macros)
 
@@ -113,17 +114,34 @@
          ,@body
          t))))
 
+;; On CCL at least, new thread clones origin *random-state* thus
+;; all cron threads generate same random values. To overcome this we'll
+;; generate per-thread *random-state*
+(defvar *random-state-lock* (bt:make-recursive-lock
+                             "random state lock") "per-thread random state lock")
+(defvar *thread-random-state* (tg:make-weak-hash-table :weakness :key) "Per-thread *random-state* storage")
+(defun get-thread-random-state ()
+  (bt:with-recursive-lock-held (*random-state-lock*)
+    (let ((self (bt:current-thread)))
+      (or (gethash self *thread-random-state*)
+          (setf (gethash self *thread-random-state*)
+                (make-random-state t))))))
+
+(defmacro with-random-state (&body body)
+  `(let ((*random-state* (get-thread-random-state)))
+     ,@body))
+
 ;; Schedule
 (defmacro defcron (name (&rest schedule) &body body)
   (let ((schedule (or schedule '(:minute '* :hour '*)))
         (scheduler (symbol-append name '-scheduler)))
     `(progn
        (defun ,name ()
-         (setf *random-state* (make-random-state t))
-         (unwind-protect
-              (handler-case (progn ,@body)
-                (error (e) (log:error "~A" e)))
-           (dex:clear-connection-pool)))
+         (with-random-state
+           (unwind-protect
+                (handler-case (progn ,@body)
+                  (error (e) (log:error "~A" e)))
+             (dex:clear-connection-pool))))
        (defun ,scheduler ()
          (clon:schedule-function
           ',name (clon:make-scheduler