Quellcode durchsuchen

Allow interrupts in sbcl in cron

root vor 7 Jahren
Ursprung
Commit
ee82a1b5a3
1 geänderte Dateien mit 9 neuen und 7 gelöschten Zeilen
  1. 9 7
      macros.lisp

+ 9 - 7
macros.lisp

@@ -137,12 +137,13 @@
         (scheduler (symbol-append name '-scheduler)))
     `(progn
        (defun ,name ()
-         (unwind-protect
-              (handler-case
-                  (let ((*random-state* (make-random-state t)))
-                    ,@body)
-                (error (e) (log:error "~A" e)))
-           (dex:clear-connection-pool)))
+         (with-random-state
+           (unwind-protect
+                (handler-case
+		    +sbcl (sb-sys:with-interrupts ,@body)
+		    -sbcl (progn ,@body)
+                  (error (e) (log:error "~A" e)))
+             (dex:clear-connection-pool))))
        (defun ,scheduler ()
          (clon:schedule-function
           ',name (clon:make-scheduler
@@ -150,6 +151,7 @@
                    ,@schedule)
                   :allow-now-p t)
           :name ',name
-          :thread t)
+          :thread (bt:make-thread (lambda () (loop (sleep 1)))
+                                  :name (format nil "Sleeper '~A'" (symbol-name ',name))))
          (values))
        (add-hook :starting ',scheduler))))