在SBCL中获取线程ID

时间:2015-03-09 17:41:57

标签: common-lisp sbcl

我正在使用Lisp sb-thread包。当我使用*current-thread*来获取线程id时,最后一次计算的表达式的结果也会返回,并带有线程ID。我只需要程序的线程ID。

2 个答案:

答案 0 :(得分:3)

SBCL拥有setf个能thread 名称,而不是 ID

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

您需要什么ID?

答案 1 :(得分:0)

生活中有些情况下你迫切需要线程的ID,例如: https://bugs.launchpad.net/sbcl/+bug/1751562

  

"我遇到过在Linux上使用SBCL的情况,我有多个工作人员   我的机器上的线程,其中一个占用了我100%的CPU。一世   想要检索有问题的线程的线程对象,但是这个   结果证明是非平凡的。"

(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

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

我查看了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)))