Хамелеончеги: падение злой жабы

[swizard]

Реванш за все то зло, что ты мне причинила =)



Победил, разумеется, за счет ручной расстановки affinity тредов на физически соседние ядра в Core Quad. Отдельное спасибо анонимусам в предыдущем посте и 13_49 за тестовую машину о восьми ядрах и с луниксом.

В качестве подарка зрителям вот исходник биндингов к pthread_*affinity.

(defpackage #:smp-utils
(:use :cl :sb-alien :sb-thread)
(:export #:affinity #:apic-core-map))

(in-package :smp-utils)

(defun cpuset->list (cpuset)
(loop :for i :from 0 :below 128
:unless (zerop (ldb (byte 1 (mod i 8)) (elt cpuset (truncate i 8))))
:collect i))

(defun list->cpuset (cpuset-list)
(loop :with cpuset = (make-array 16 :element-type '(unsigned-byte 8))
:for i :from 0 :below 128
:when (find i cpuset-list :test #'=)
:do (setf (ldb (byte 1 (mod i 8)) (elt cpuset (truncate i 8))) 1)
:finally (return cpuset)))

(defun affinity (thread)
(with-alien ((alien-cpuset (array unsigned-char 16)))
(let ((retcode (alien-funcall (extern-alien "pthread_getaffinity_np"
(function int
unsigned-long
unsigned-long
(* unsigned-char)))
(sb-thread::thread-os-thread thread)
16
(cast alien-cpuset (* unsigned-char)))))
(when (zerop retcode)
(values t (loop :with cpuset = (make-array 16 :element-type '(unsigned-byte 8))
:for i :from 0 :below 16
:do (setf (elt cpuset i) (deref alien-cpuset i))
:finally (return (cpuset->list cpuset))))))))

(defun (setf affinity) (affinity thread)
(with-alien ((alien-cpuset (array unsigned-char 16)))
(loop :with cpuset = (list->cpuset affinity)
:for i :from 0 :below 16
:do (setf (deref alien-cpuset i) (elt cpuset i)))
(zerop (alien-funcall (extern-alien "pthread_setaffinity_np"
(function int
unsigned-long
unsigned-long
(* unsigned-char)))
(sb-thread::thread-os-thread thread)
16
(cast alien-cpuset (* unsigned-char))))))

(defun apic-core-map (cpuset-list)
(let ((default-map (mapcar #'list cpuset-list cpuset-list)))
(unless (probe-file #p"/proc/cpuinfo")
(return-from apic-core-map default-map))
(with-open-file (cpuinfo #p"/proc/cpuinfo")
(flet ((parse-key-value (line key)
(when (and (> (length line) (length key))
(string= line key :end1 (length key)))
(let ((value-offset (position #\: line :start (length key))))
(when value-offset
(parse-integer line :start (1+ value-offset) :junk-allowed t))))))
(loop :with current-cpu = nil
:for line = (read-line cpuinfo nil nil)
:while line
:do (multiple-value-bind (processor apicid)
(values (parse-key-value line "processor")
(parse-key-value line "apicid"))
(cond ((and current-cpu apicid) (setf (first (find current-cpu default-map :key #'second)) apicid
current-cpu nil))
(processor (setf current-cpu processor))))
:finally (return (sort default-map #'< :key #'first)))))))
Использовать примерно так:

CL-USER> (smp-utils:affinity sb-thread:*current-thread*)
T
(0 1 2 3)
CL-USER> (setf (smp-utils:affinity sb-thread:*current-thread*) '(1 3))
T
CL-USER> (smp-utils:affinity sb-thread:*current-thread*)
T
(1 3)
Ну и apic-core-map сортирует номера процессоров (выданные системой) в зависимости от их apic id.