Merge pull request #1428 from lem-project/bordeaux-threads-2

cxxxr · web-flow · commit d02fb3d07dfb · 2024-07-11T22:30:12.000+09:00
change to bordeaux-threads v2
diff --git a/extensions/go-mode/go-mode.lisp b/extensions/go-mode/go-mode.lisp
@@ -277,10 +277,10 @@
 (defvar *fly-thread* nil)
 
 (defun run-flymake (fn)
-  (when (and *fly-thread* (bt:thread-alive-p *fly-thread*))
-    (bt:destroy-thread *fly-thread*))
+  (when (and *fly-thread* (bt2:thread-alive-p *fly-thread*))
+    (bt2:destroy-thread *fly-thread*))
   (setf *fly-thread*
-        (bt:make-thread fn :name "go-flymake")))
+        (bt2:make-thread fn :name "go-flymake")))
 
 (define-command goflymake (buffer)
     ((current-buffer))
diff --git a/extensions/lisp-mode/lisp-mode.lisp b/extensions/lisp-mode/lisp-mode.lisp
@@ -880,13 +880,13 @@
 (defvar *wait-message-thread* nil)
 
 (defun notify-change-connection-to-wait-message-thread ()
-  (bt:interrupt-thread *wait-message-thread*
+  (bt2:interrupt-thread *wait-message-thread*
                        (lambda () (error 'change-connection))))
 
 (defun start-thread ()
   (unless *wait-message-thread*
     (setf *wait-message-thread*
-          (bt:make-thread
+          (bt2:make-thread
            (lambda () (loop
                         :named exit
                         :do
diff --git a/extensions/lisp-mode/v2/lsp-config.lisp b/extensions/lisp-mode/v2/lsp-config.lisp
@@ -48,7 +48,7 @@
     (micros:create-server :port port)))
 
 (defun start-language-server (port)
-  (bt:make-thread (lambda ()
+  (bt2:make-thread (lambda ()
                     (lem-language-server:start-tcp-server port))))
 
 (defmethod lem-lsp-mode::run-server ((spec lisp-spec))
diff --git a/extensions/lsp-mode/lem-stdio-transport.lisp b/extensions/lsp-mode/lem-stdio-transport.lisp
@@ -20,11 +20,11 @@
     (setf (transport-connection transport) connection)
     (setf (transport-threads transport)
           (list
-           (bt:make-thread
+           (bt2:make-thread
             (lambda ()
               (run-processing-loop transport connection))
             :name "lem-lsp-mode/lem-stdio-transport processing")
-           (bt:make-thread
+           (bt2:make-thread
             (lambda ()
               (run-reading-loop transport connection))
             :name "lem-lsp-mode/lem-stdio-transport reading")))
diff --git a/extensions/lsp-mode/lsp-mode.lisp b/extensions/lsp-mode/lsp-mode.lisp
@@ -361,7 +361,7 @@
 
 (defun connect (client continuation)
   (lem-lsp-base/yason-utils:update-jsonrpc-yason-parameters)
-  (bt:make-thread
+  (bt2:make-thread
    (lambda ()
      (loop :with condition := nil
            :repeat 20
diff --git a/extensions/scheme-mode/swank-connection.lisp b/extensions/scheme-mode/swank-connection.lisp
@@ -737,13 +737,13 @@
 (defvar *wait-message-thread* nil)
 
 (defun notify-change-connection-to-wait-message-thread ()
-  (bt:interrupt-thread *wait-message-thread*
+  (bt2:interrupt-thread *wait-message-thread*
                        (lambda () (error 'change-connection))))
 
 (defun start-thread ()
   (unless *wait-message-thread*
     (setf *wait-message-thread*
-          (bt:make-thread
+          (bt2:make-thread
            (lambda () (loop
                         :named exit
                         :do
@@ -975,7 +975,7 @@
     (write-line "(loop (sleep most-positive-fixnum))" out)))
 
 (defun run-swank-server (command port &key (directory (buffer-directory)))
-  (bt:make-thread
+  (bt2:make-thread
    (lambda ()
      (with-input-from-string
          (input (initialize-forms-string port))
@@ -1023,7 +1023,7 @@
 
     (let ((thread (run-swank-server command port :directory directory)))
       (sleep 0.5)
-      (unless (bt:thread-alive-p thread)
+      (unless (bt2:thread-alive-p thread)
         (editor-error "Scheme swank server start error")))
 
     (let ((successp)
diff --git a/frontends/ncurses/mainloop.lisp b/frontends/ncurses/mainloop.lisp
@@ -14,7 +14,7 @@
       (loop
         (handler-case
             (progn
-              (unless (bt:thread-alive-p editor-thread) (return))
+              (unless (bt2:thread-alive-p editor-thread) (return))
               (let ((event (lem-ncurses/input:get-event)))
                 (if (eq event :abort)
                     (send-abort-event editor-thread nil)
@@ -27,7 +27,7 @@
 
 (defun invoke (function)
   (let ((result nil)
-        (input-thread (bt:current-thread)))
+        (input-thread (bt2:current-thread)))
     (unwind-protect
          (when (lem-ncurses/term:term-init)
            (let ((*standard-output* (make-broadcast-stream))
@@ -37,7 +37,7 @@
                      (funcall function
                               nil
                               (lambda (report)
-                                (bt:interrupt-thread
+                                (bt2:interrupt-thread
                                  input-thread
                                  (lambda () (error 'exit :value report)))))))
                (setf result (input-loop editor-thread)))))
diff --git a/frontends/pdcurses/ncurses-pdcurseswin32.lisp b/frontends/pdcurses/ncurses-pdcurseswin32.lisp
@@ -294,15 +294,15 @@
 ;; for resizing display
 (defkeycode "[resize]" #x222)
 (let ((resize-delay-counter 0)
-      (lock (bt:make-lock)))
+      (lock (bt2:make-lock)))
   (defun now-resizing ()
-    (bt:with-lock-held (lock)
+    (bt2:with-lock-held (lock)
       resize-delay-counter))
   (defun (setf now-resizing) (v)
-    (bt:with-lock-held (lock)
+    (bt2:with-lock-held (lock)
       (setf resize-delay-counter v)))
   (defun now-resizing-countdown ()
-    (bt:with-lock-held (lock)
+    (bt2:with-lock-held (lock)
       (decf resize-delay-counter))))
 (defvar *min-cols*  5)
 (defvar *min-lines* 3)
@@ -709,7 +709,7 @@
       (loop
          (handler-case
              (progn
-               (unless (bt:thread-alive-p editor-thread) (return))
+               (unless (bt2:thread-alive-p editor-thread) (return))
                (let ((event (get-event)))
                  (case event
                    ;; retry is necessary to exit lem normally
diff --git a/frontends/sdl2/display.lisp b/frontends/sdl2/display.lisp
@@ -55,7 +55,7 @@
   `(call-with-display (lambda (,display) ,@body)))
 
 (defclass display ()
-  ((mutex :initform (bt:make-lock "lem-sdl2 display mutex")
+  ((mutex :initform (bt2:make-lock :name "lem-sdl2 display mutex")
           :reader display-mutex)
    (font-config :initarg :font-config
                 :accessor display-font-config)
@@ -108,7 +108,7 @@
 
 (defun call-with-renderer (display function)
   (sdl2:in-main-thread ()
-    (bt:with-recursive-lock-held ((display-mutex display))
+    (bt2:with-recursive-lock-held ((display-mutex display))
       (funcall function))))
 
 (defmacro with-renderer ((display) &body body)
@@ -174,7 +174,7 @@
   (nth-value 1 (sdl2:get-window-size (display-window display))))
 
 (defmethod update-texture ((display display))
-  (bt:with-lock-held ((display-mutex display))
+  (bt2:with-lock-held ((display-mutex display))
     (sdl2:destroy-texture (display-texture display))
     (setf (display-texture display)
           (utils:create-texture (display-renderer display)
diff --git a/lib/language-client/request.lisp b/lib/language-client/request.lisp
@@ -14,11 +14,11 @@
 (cl-package-locks:lock-package :lem-lsp-mode/request)
 
 (defvar *log-enable* t)
-(defvar *log-mutex* (bt:make-lock))
+(defvar *log-mutex* (bt2:make-lock))
 
 (defun do-log (string &rest args)
   (when *log-enable*
-    (bt:with-lock-held (*log-mutex*)
+    (bt2:with-lock-held (*log-mutex*)
       (let ((log-pathname (merge-pathnames "language-client.log" (lem:lem-logdir-pathname))))
         (ensure-directories-exist log-pathname)
         (with-open-file (out log-pathname
diff --git a/lib/lsp-base/yason-utils.lisp b/lib/lsp-base/yason-utils.lisp
@@ -1,7 +1,5 @@
 (defpackage :lem-lsp-base/yason-utils
   (:use :cl)
-  (:import-from :bordeaux-threads
-                :*default-special-bindings*)
   (:export :with-yason-bindings
            :update-jsonrpc-yason-parameters
            :parse-json))
@@ -15,9 +13,9 @@
   `(call-with-yason-bindings (lambda () ,@body)))
 
 (defun call-with-yason-bindings (function)
-  (let ((*default-special-bindings*
+  (let ((bt2:*default-special-bindings*
           (append *yason-bindings*
-                  *default-special-bindings*)))
+                  bt2:*default-special-bindings*)))
     (progv (mapcar #'car *yason-bindings*)
         (mapcar #'cdr *yason-bindings*)
       (funcall function))))
diff --git a/lib/process/process.lisp b/lib/process/process.lisp
@@ -36,7 +36,7 @@
                                    ;; :read-thread thread
                                    :output-callback output-callback
                                    :output-callback-type output-callback-type))
-           (thread (bt:make-thread
+           (thread (bt2:make-thread
                     (lambda ()
                       (loop
                         (unless (async-process:process-alive-p pointer)
@@ -65,8 +65,8 @@
          (funcall output-callback string))))))
 
 (defun delete-process (process)
-  (when (bt:thread-alive-p (process-read-thread process))
-    (bt:destroy-thread (process-read-thread process)))
+  (when (bt2:thread-alive-p (process-read-thread process))
+    (bt2:destroy-thread (process-read-thread process)))
   (async-process:delete-process (process-pointer process)))
 
 (defun process-alive-p (process)
diff --git a/src/buffer/interrupt.lisp b/src/buffer/interrupt.lisp
@@ -23,7 +23,7 @@
              (setf *interrupted* nil)
              (error 'lem/buffer/errors:editor-interrupt)))))))
 
-;; 別のスレッドから(bt:interrupt-thread thread #'interrupt)で使う関数
+;; 別のスレッドから(bt2:interrupt-thread thread #'interrupt)で使う関数
 (defun interrupt (&optional force)
   (cond
     (force
diff --git a/src/commands/file.lisp b/src/commands/file.lisp
@@ -176,15 +176,15 @@
   If finding files times out, such as in a HOME directory, stop the operation.
 
   Return a list of files or signal a FALLBACK-TO-FIND-FILE simple condition."
-  (let ((thread (bt:make-thread
+  (let ((thread (bt2:make-thread
                  (lambda ()
                    (get-files-recursively find-program))
                  :name "Lem get-files-recursively")))
     (handler-case
-        (bt:with-timeout (timeout)
-          (bt:join-thread thread))
-      (bt:timeout ()
-        (bt:destroy-thread thread)
+        (bt2:with-timeout (timeout)
+          (bt2:join-thread thread))
+      (bt2:timeout ()
+        (bt2:destroy-thread thread)
         (signal 'fallback-to-find-file)))))
 
 (defun prompt-for-files-recursively ()
diff --git a/src/common/queue.lisp b/src/common/queue.lisp
@@ -39,30 +39,30 @@
   (null (queue-list queue)))
 
 (defstruct (concurrent-queue (:constructor %make-concurrent-queue))
-  (wait (bt:make-condition-variable))
-  (lock (bt:make-lock))
+  (wait (bt2:make-condition-variable))
+  (lock (bt2:make-lock))
   (queue (make-queue)))
 
 (defun make-concurrent-queue ()
   (%make-concurrent-queue))
 
 (defmethod len ((queue concurrent-queue))
-  (bt:with-lock-held ((concurrent-queue-lock queue))
+  (bt2:with-lock-held ((concurrent-queue-lock queue))
     (len (concurrent-queue-queue queue))))
 
 (defmethod enqueue ((queue concurrent-queue) obj)
-  (bt:with-lock-held ((concurrent-queue-lock queue))
+  (bt2:with-lock-held ((concurrent-queue-lock queue))
     (enqueue (concurrent-queue-queue queue) obj)
-    (bt:condition-notify (concurrent-queue-wait queue))))
+    (bt2:condition-notify (concurrent-queue-wait queue))))
 
 (defmethod dequeue ((queue concurrent-queue) &key timeout timeout-value)
-  (bt:with-lock-held ((concurrent-queue-lock queue))
+  (bt2:with-lock-held ((concurrent-queue-lock queue))
     (if (not (empty-p (concurrent-queue-queue queue)))
         (dequeue (concurrent-queue-queue queue))
         (cond ((if timeout
-                   (bt:condition-wait (concurrent-queue-wait queue) (concurrent-queue-lock queue)
+                   (bt2:condition-wait (concurrent-queue-wait queue) (concurrent-queue-lock queue)
                                       :timeout timeout)
-                   (bt:condition-wait (concurrent-queue-wait queue) (concurrent-queue-lock queue)))
+                   (bt2:condition-wait (concurrent-queue-wait queue) (concurrent-queue-lock queue)))
                (dequeue (concurrent-queue-queue queue)))
               (t
                timeout-value)))))
diff --git a/src/common/timer.lisp b/src/common/timer.lisp
@@ -112,24 +112,24 @@
 (defclass timer (<timer>)
   ((mutex
     :accessor timer-mutex
-    :type bt:lock)
+    :type bt2:lock)
    (stop-mailbox
     :accessor timer-stop-mailbox
     :type lem-mailbox:mailbox)
    (thread
     :accessor timer-thread
-    :type bt:thread)))
+    :type bt2:thread)))
 
 (defmethod timer-expired-p ((timer timer))
-  (bt:with-lock-held ((timer-mutex timer))
+  (bt2:with-lock-held ((timer-mutex timer))
     (call-next-method)))
 
 (defmethod expire-timer ((timer timer))
-  (bt:with-lock-held ((timer-mutex timer))
+  (bt2:with-lock-held ((timer-mutex timer))
     (set-timer-expired-p t timer)))
 
 (defmethod inspire-timer ((timer timer))
-  (bt:with-lock-held ((timer-mutex timer))
+  (bt2:with-lock-held ((timer-mutex timer))
     (set-timer-expired-p nil timer)))
 
 (defun make-timer (function &key name handle-function)
@@ -138,8 +138,8 @@
 (defmethod start-timer ((timer timer) ms &key repeat)
   (setf (timer-ms timer) ms
         (timer-repeat-p timer) repeat
-        (timer-mutex timer) 
-        (bt:make-lock "timer internal mutex"))
+        (timer-mutex timer)
+        (bt2:make-lock :name "timer internal mutex"))
   (start-timer-thread timer ms repeat)
   timer)
 
@@ -153,7 +153,7 @@
     (setf (timer-stop-mailbox timer)
           stop-mailbox)
     (setf (timer-thread timer)
-          (bt:make-thread
+          (bt2:make-thread
            (lambda ()
              (loop
                (let ((recv-stop-msg
diff --git a/src/event-queue.lisp b/src/event-queue.lisp
@@ -9,7 +9,7 @@
   (enqueue *editor-event-queue* obj))
 
 (defun send-abort-event (editor-thread force)
-  (bt:interrupt-thread editor-thread
+  (bt2:interrupt-thread editor-thread
                        (lambda ()
                          (interrupt force))))
 
diff --git a/src/interface.lisp b/src/interface.lisp
@@ -121,10 +121,10 @@
 
 (defmacro with-implementation (implementation &body body)
   `(let* ((*implementation* ,implementation)
-          (bt:*default-special-bindings*
+          (bt2:*default-special-bindings*
             (acons '*implementation*
                    *implementation*
-                   bt:*default-special-bindings*)))
+                   bt2:*default-special-bindings*)))
      ,@body))
 
 (defun display-background-mode ()
diff --git a/src/interp.lisp b/src/interp.lisp
@@ -145,7 +145,7 @@
   (signal 'exit-editor :report report))
 
 (defun call-background-job (function cont)
-  (bt:make-thread
+  (bt2:make-thread
    (lambda ()
      (let ((error-text))
        (handler-case
diff --git a/src/lem.lisp b/src/lem.lisp
