问题描述

语境

我需要使用多线程进行计算。我使用 SBCL，可移植性不是问题。我知道bordeaux-threads并且lparallel存在，但我想在特定 SBCL 线程实现提供的相对较低的级别上实现一些东西。我需要最大的速度，即使以牺牲可读性/编程工作为代价。

计算密集型操作示例

我们可以定义一个充分计算密集型的函数，该函数将从多线程中受益。

(defun intensive-sqrt (x)
  "Dummy calculation for intensive algorithm.
Approx 50 ms for 1e6 iterations."
  (let ((y x))
    (dotimes (it 1000000 t)
      (if (> y 1.01d0)
          (setf y (sqrt y))
          (setf y (* y y y))))
    y))

将每个计算映射到一个线程并执行

给定一个参数列表列表llarg和一个函数fun，我们想要计算nthreads结果并返回结果列表res-list。这是我使用找到的资源得出的结论（见下文）。

(defmacro splice-arglist-help (fun arglist)
  "Helper macro.
   Splices a list 'arglist' (arg1 arg2 ...) into the function call of 'fun'
   Returns (funcall fun arg1 arg2 ...)"
  `(funcall ,fun ,@arglist))

(defun splice-arglist (fun arglist)
  (eval `(splice-arglist-help ,fun ,arglist)))

(defun maplist-fun-multi (fun llarg nthreads)
  "Maps 'fun' over list of argument lists 'llarg' using multithreading.
   Breaks up llarg and feeds it to each thread.
   Appends all the result lists at the end."
  (let ((thread-list nil)
        (res-list nil))
    ;; Create and run threads
    (dotimes (it nthreads t)
      (let ((larg-temp (elt llarg it)))
        (setf thread-list (append thread-list
                                  (list (sb-thread:make-thread
                                         (lambda ()
                                           (splice-arglist fun larg-temp))))))))
    ;; Join threads
    ;; Threads are joined in order, not optimal for speed.
    ;; Should be joined when finished ?
    (dotimes (it (list-length thread-list) t)
      (setf res-list (append res-list (list (sb-thread:join-thread (elt thread-list it))))))
    res-list))

nthreads不一定与的长度匹配llarg，但为了示例简单起见，我避免了额外的簿记。我也省略了declare用于优化的各种。

我们可以使用以下方法测试多线程并比较时间：

(defparameter *test-args-sqrt-long* nil)
(dotimes (it 10000 t)
  (push (list (+ 3d0 it)) *test-args-sqrt-long*))

(time (intensive-sqrt 5d0))
(time (maplist-fun-multi #'intensive-sqrt *test-args-sqrt-long* 100))

线程数相当高。我认为最佳方案是使用与 CPU 一样多的线程，但我注意到性能下降在时间/操作方面几乎不明显。做更多的操作将涉及将输入列表分解成更小的部分。

上面的代码在 2 核/4 线程机器上输出：

Evaluation took:
  0.029 seconds of real time
  0.015625 seconds of total run time (0.015625 user, 0.000000 system)
  55.17% CPU
  71,972,879 processor cycles
  22,151,168 bytes consed

Evaluation took:
  1.415 seconds of real time
  4.703125 seconds of total run time (4.437500 user, 0.265625 system)
  [ Run times consist of 0.205 seconds GC time, and 4.499 seconds non-GC time. ]
  332.37% CPU
  3,530,632,834 processor cycles
  2,215,345,584 bytes consed

什么困扰着我

我给出的例子效果很好并且很健壮（即结果不会在线程之间混淆，并且我没有遇到崩溃）。速度增益也在那里，并且计算确实在我测试过这段代码的机器上使用了几个内核/线程。但是有几件事我想就以下几点提出意见/帮助：

使用参数列表llarg和larg-temp. 这真的有必要吗？有没有办法避免操纵潜在的巨大列表？
线程按照它们存储在thread-list. 我想如果每个操作都需要不同的时间来完成，这将不是最佳的。有没有办法在完成后加入每个线程，而不是等待？

答案应该在我已经找到的资源中，但我发现更高级的东西很难解决。

目前找到的资源

标签： multithreadingcommon-lispsbcl

解决方案

文体问题

splice-arglist根本不需要助手（所以我也会跳过其中的细节）。apply改为在您的线程函数中使用：
```
(lambda ()
  (apply fun larg-temp))
```
您不需要（也不应该）对列表进行索引，因为每次查找都是O(n) - 您的循环是二次的。用于dolist简单的副作用循环，或者loop当你有并行迭代时：
```
(loop :repeat nthreads
      :for args :in llarg
      :collect (sb-thread:make-thread (lambda () (apply fun args))))
```
要在创建相同长度的新列表时遍历列表，其中每个元素都是根据源列表中的相应元素计算的，请使用mapcar：
```
(mapcar #'sb-thread:join-thread threads)
```

您的功能因此变为：

(defun map-args-parallel (fun arglists nthreads)
  (let ((threads (loop :repeat nthreads
                       :for args :in arglists
                       :collect (sb-thread:make-thread
                                 (lambda ()
                                   (apply fun args))))))
    (mapcar #'sb-thread:join-thread threads)))

表现

您是对的，通常只创建与 ca 一样多的线程。可用的核心数。如果您总是通过创建n 个线程，然后加入它们，然后进入下一批来测试性能，那么您的性能确实不会有太大差异。那是因为低效率在于创建线程。线程与进程一样占用资源。

通常做的是创建一个线程池，其中线程不会加入，而是重用。为此，您需要一些其他机制来传达参数和结果，例如通道（例如 from chanl）。

但是请注意，eglparallel已经提供了一个pmap功能，并且它做的事情是正确的。此类包装库的目的不仅是为用户（程序员）提供一个漂亮的界面，而且还要认真思考问题并进行明智的优化。我非常有信心这pmap将比您的尝试快得多。

multithreading - 在 SBCL 中进行多线程计算的正确方法