在 SBCL 中获取线程 ID

Question

我正在使用 Lisp sb-thread 包。当我使用 *current-thread* 获取线程 ID 时，最后计算的表达式的结果也与线程 ID 一起返回。我只需要程序的线程 ID。

Answer 1

SBCL 有 setf-able thread names，没有 IDs:

(sb-thread:thread-name SB-THREAD:*CURRENT-THREAD*)
==> "main thread"

您需要身份证件做什么？

Answer 2

生活中有时会非常需要线程的 ID，例如： https://bugs.launchpad.net/sbcl/+bug/1751562

"I had a situation where on SBCL on Linux, I had multiple worker threads on my machine, and one of them was taking 100% of my CPU. I wanted to retrieve the thread object of the offending thread, but this turned out to be non-trivial."

(defun thread-real-id () 
 (sb-alien:alien-funcall 
    (sb-alien:extern-alien "syscall" 
    ;; sb-alien:unsigned is the return value's type and int is the parameter's type
                           (function sb-alien:unsigned int))
    ;; if on your system it returns 0xFFFFFFFF then try 186 instead of 224
    ;; or check the right gettid syscall value for your system. 
    224))

(ql:quickload :bordeaux-threads)

(let ((top-level *standard-output*)) 
  (bt:make-thread (lambda() 
                    (format top-level "my id is ~A~%" (thread-real-id)))))

; output:
my id is 657

在手册页中，syscall 函数的原型是 long syscall(long number, ...)，因此参数和 ret 值的正确类型都是 LONG，但我不确定如何使用 sb-alien 指定它: 类型

我查看了 sbcl 的 src：

find . -name "*alien*" -exec echo {} \; -exec grep define-alien-type-tr {} \;

搜索结果：

./host-alieneval.lisp
  (defun %define-alien-type-translator (name translator)
(define-alien-type-translator system-area-pointer ()
(define-alien-type-translator signed (&optional (bits sb!vm:n-word-bits))
(define-alien-type-translator integer (&optional (bits sb!vm:n-word-bits))
(define-alien-type-translator unsigned (&optional (bits sb!vm:n-word-bits))
(define-alien-type-translator boolean (&optional (bits sb!vm:n-word-bits))
(define-alien-type-translator enum (&whole
(define-alien-type-translator single-float ()
(define-alien-type-translator double-float ()
(define-alien-type-translator * (to &environment env)
(define-alien-type-translator array (ele-type &rest dims &environment env)
(define-alien-type-translator struct (name &rest fields &environment env)
(define-alien-type-translator union (name &rest fields &environment env)
(define-alien-type-translator function (result-type &rest arg-types
(define-alien-type-translator values (&rest values &environment env)
# not sure which of them is the type for LONG

要查看线程，您可以使用此命令：

ps -To pid,tid -p `pidof sbcl` 

;如果您需要 PID，请执行 (sb-posix:getpid) 或调用 "getpid" 外星人：

(sb-alien:alien-funcall 
   (sb-alien:extern-alien "getpid" 
       (function sb-alien:unsigned)) )

如果您使用 Windows，您可以使用以下代码（取自此处：https://www.linux.org.ru/forum/development/11998951）

#|
typedef struct pthread_thread {
  pthread_fn start_routine;
  void* arg;
  HANDLE handle;
...
}
|#

(defun get-thread-handle (thread)
  "Retrieves WIN32 thread HANDLE from SBCL thread"
  (declare (type sb-thread:thread thread))
  (let* ((pthread-pointer
           (sb-sys:int-sap (sb-thread::thread-os-thread thread)))
         (pthread-alien
           (sb-alien:sap-alien
            pthread-pointer (sb-alien:struct nil
                                             (start-addr (* t))
                                             (arg (* t))
                                             (handle (* t))))))
    (sb-alien:alien-sap (sb-alien:slot pthread-alien 'handle))))

(defun get-thread-id (thread)
  "Retrieves WIN32 thread ID from SBCL thread"
  (declare (type sb-thread:thread thread))
  (sb-alien:alien-funcall
   (sb-alien:extern-alien "GetThreadId" (function sb-alien:unsigned
                                                  (* t)))
   (get-thread-handle thread)))

(get-thread-id sb-thread:*current-thread*) ; ==> 62

更新 原来上面的windows代码也可以简化为一行：

(sb-alien:alien-funcall (sb-alien:extern-alien "GetCurrentThreadId" (function sb-alien:unsigned)))