Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 260 lines (243 sloc) 10.516 kB
bae856f @pkhuong Split up in work-stack and work-queue
authored
1 (defpackage "WORK-STACK"
5e26071 @pkhuong Split up work stack and work units
authored
2 (:use "CL" "SB-EXT" "SB-THREAD" "WORK-UNIT")
bae856f @pkhuong Split up in work-stack and work-queue
authored
3 (:shadow cl:push)
4 (:export "TASK" "TASK-P" "BULK-TASK" "BULK-TASK-P"
5 "TASK-DESIGNATOR"
6 "EXECUTE-TASK"
7 "STACK" "MAKE" "P"
8 "PUSH" "PUSH-ALL" "STEAL" "RUN-ONE"))
9
ffaf272 @pkhuong Actually functional work-stack + docs
authored
10 ;;; Work-unit stack
11 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
12 ;;; Normal task-stealing stack, with special support for tasks composed
13 ;;; of subtasks.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
14 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
15 ;;; A task designator is either a function designator, a task, or a
16 ;;; bulk-task.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
17 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
18 ;;; A function designator is called, and a task's fun is called with the
19 ;;; task as its only argument.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
20 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
21 ;;; When only those are used, the work stack is a normal stack of task
22 ;;; units, with PUSH to insert a new task (PUSH-ALL to insert a sequence
23 ;;; of tasks), STEAL to get one task from the bottom of the stack, and
24 ;;; RUN-ONE to execute and pop the topmost task.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
25 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
26 ;;; Bulk-task objects represent a set of subtasks to be executed, and
27 ;;; a sequence of operations to perform once all the subtasks have been
28 ;;; completed.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
29 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
30 ;;; Task stealing of bulk tasks is special: bulk tasks have multiple
31 ;;; owners, so bulk tasks aren't stolen as much as forcibly shared. All
32 ;;; the workers that share a bulk task cooperate to complete the subtasks;
33 ;;; the last worker to finish executing a subtask then executes the
34 ;;; cleanups.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
35 ;;;
1844cec @pkhuong Reflow docs in work stack
authored
36 ;;; Subtasks and cleanups are functions that are called with the
37 ;;; subtask as their one argument.
38 ;;;
39 ;;; Cooperating threads avoid hammering the same subtasks by
40 ;;; beginning/resuming their search for remaining subtasks from different
41 ;;; indices: PUSH/PUSH-ALL take an optional argument to determine the
42 ;;; fraction of the subtask vector from which to initialise the thread's
43 ;;; search (defaults to 0). Incidentally, this is also useful for
44 ;;; locality, when the subtasks are sorted right.
ffaf272 @pkhuong Actually functional work-stack + docs
authored
45
bae856f @pkhuong Split up in work-stack and work-queue
authored
46 (in-package "WORK-STACK")
47
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
48 (defconstant +stacklet-size+ 128)
49
50 (declaim (inline split-index))
51 (defun split-index (index)
52 (multiple-value-bind (major minor)
53 (truncate index +stacklet-size+)
54 (cond ((plusp minor)
55 (values major minor))
56 ((zerop major)
57 (values 0 0))
58 (t
59 (values (1- major) +stacklet-size+)))))
bae856f @pkhuong Split up in work-stack and work-queue
authored
60
61 (defstruct stack
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
62 (stacklets (error "Foo") :type (array (simple-vector #.+stacklet-size+) 1)
63 :read-only t)
d09489c @pkhuong Cache last found task in work-stack stealing
authored
64 (top 0 :type (and unsigned-byte fixnum))
65 (bottom 0 :type (and unsigned-byte fixnum)))
bae856f @pkhuong Split up in work-stack and work-queue
authored
66
67 (defun make ()
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
68 (make-stack :stacklets (make-array 16 :fill-pointer 0 :adjustable t)))
bae856f @pkhuong Split up in work-stack and work-queue
authored
69
70 (declaim (inline p))
71 (defun p (x)
72 (stack-p x))
73
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
74 (defun %update-stack-top (stack)
75 (declare (type stack stack))
76 (let ((top (stack-top stack)))
77 (when (zerop top)
78 (return-from %update-stack-top))
79 (multiple-value-bind (major minor) (split-index top)
80 (let* ((stacklets (stack-stacklets stack))
81 (stacklet (aref stacklets major))
82 (position (position nil stacklet :from-end t :end minor :test-not #'eql)))
83 (cond (position
84 (setf (stack-top stack) (+ (* major +stacklet-size+)
85 position 1)))
86 (t
87 (setf (stack-top stack) (* major +stacklet-size+))
88 (%update-stack-top stack)))))))
89
90 (defun %push (stack value)
91 (declare (type stack stack) (type (not null) value))
92 (%update-stack-top stack)
93 (multiple-value-bind (stacklet index)
94 (truncate (stack-top stack) +stacklet-size+)
95 (let ((stacklets (stack-stacklets stack)))
96 (loop while (<= (length stacklets) stacklet)
97 do (vector-push-extend (make-array +stacklet-size+ :initial-element nil)
98 stacklets))
99 (let ((stacklet (aref stacklets stacklet)))
100 (setf (aref stacklet index) value)
101 (incf (stack-top stack))
102 value))))
103
104 (defun steal (stack)
105 (declare (type stack stack))
d09489c @pkhuong Cache last found task in work-stack stealing
authored
106 (labels ((update-bottom (i)
107 (when (/= i (stack-bottom stack))
108 (setf (stack-bottom stack) i)))
109 (sub-steal (begin end)
110 (declare (type (and fixnum unsigned-byte) begin end))
111 (loop with stacklets = (stack-stacklets stack)
112 for i from begin below (max end (length stacklets))
113 for stacklet = (aref stacklets i)
114 do
115 (let ((start 0))
116 (loop
117 (let* ((position (position nil stacklet
118 :start start
119 :test-not #'eql))
120 (x (and position
121 (aref stacklet position))))
122 (cond ((null position)
123 (return))
124 ((null x)
125 (setf start (1+ position)))
126 ((consp x)
127 (let ((bulk (cdr x)))
128 (when (and bulk
129 (plusp (bulk-task-waiting bulk)))
130 (update-bottom i)
131 (return-from steal bulk)))
132 (setf (cdr x) nil)
133 (setf start position)
134 (when (eql x (cas (svref stacklet position) x nil))
135 (incf start)))
136 ((eql x (cas (svref stacklet position) x nil))
137 (update-bottom i)
138 (return-from steal x)))))))))
139 (declare (inline update-bottom))
140 (let ((bottom (stack-bottom stack))
141 (top (ceiling (stack-top stack) +stacklet-size+)))
142 (cond ((>= bottom top)
143 (update-bottom 0)
144 (sub-steal 0 top))
145 (t
146 (sub-steal bottom top)
147 (sub-steal 0 bottom)
148 (update-bottom 0)
149 nil)))))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
150
cd89f0e @pkhuong More comments for work-stack
authored
151 ;; bulk tasks are represented, on-stack as conses: the CAR is a hint
152 ;; wrt where to start looking for subtasks, and the CDR is the bulk-task
153 ;; object. When we're done with the bulk-task, the CDR is NIL.
f18a4c7 @pkhuong Reworked bulk-tasks
authored
154 (declaim (inline bulk-task-hintify))
4a863dd @pkhuong Work stack: hint where to find tasks
authored
155 (defun bulk-task-hintify (x &optional (hint 0))
1844cec @pkhuong Reflow docs in work stack
authored
156 (declare (type (real 0 1) hint))
f18a4c7 @pkhuong Reworked bulk-tasks
authored
157 (etypecase x
158 ((or function symbol task) x)
159 (bulk-task
160 (cons (truncate (* hint (length (bulk-task-subtasks x))))
161 x))))
bae856f @pkhuong Split up in work-stack and work-queue
authored
162
4a863dd @pkhuong Work stack: hint where to find tasks
authored
163 (defun push (stack x &optional (hint 0))
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
164 (when x
165 (%push stack (bulk-task-hintify x hint))))
bae856f @pkhuong Split up in work-stack and work-queue
authored
166
4a863dd @pkhuong Work stack: hint where to find tasks
authored
167 (defun push-all (stack values &optional (hint 0))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
168 (map nil (lambda (x)
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
169 (when x
170 (%push stack (bulk-task-hintify x hint))))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
171 values))
bae856f @pkhuong Split up in work-stack and work-queue
authored
172
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
173 (defun pop-one-task (stack)
174 (declare (type stack stack))
175 (loop
176 (when (zerop (stack-top stack))
177 (return nil))
178 (multiple-value-bind (major minor) (split-index (stack-top stack))
179 (let* ((stacklets (stack-stacklets stack))
180 (stacklet (aref stacklets major))
9c6c374 @pkhuong Fix typo in work-stack
authored
181 (position (position nil stacklet :from-end t
182 :end minor
183 :test-not #'eql)))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
184 (cond (position
185 (let ((x (aref stacklet position)))
186 (etypecase x
187 (null)
188 (cons
189 (let ((bulk-task (cdr x)))
190 (when (and bulk-task
191 (plusp (bulk-task-waiting bulk-task)))
b45579b @pkhuong Fix off by one in work-stack pop update
authored
192 (setf (stack-top stack) (+ 1 (* major +stacklet-size+)
193 position))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
194 (return x)))
195 (setf (cdr x) nil
196 (svref stacklet position) nil
197 (stack-top stack) (+ (* major +stacklet-size+)
9c6c374 @pkhuong Fix typo in work-stack
authored
198 position))
199 (barrier (:memory)))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
200 ((or task symbol function)
b45579b @pkhuong Fix off by one in work-stack pop update
authored
201 (setf (stack-top stack) (+ (* major +stacklet-size+)
202 position))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
203 (when (eql (cas (svref stacklet position) x nil) x)
204 (return x))))))
205 ((zerop major)
206 (setf (stack-top stack) 0)
ffaf272 @pkhuong Actually functional work-stack + docs
authored
207 (return nil))
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
208 (t
209 (setf (stack-top stack) (* major +stacklet-size+))))))))
ffaf272 @pkhuong Actually functional work-stack + docs
authored
210
5e26071 @pkhuong Split up work stack and work units
authored
211 (declaim (inline bulk-find-task))
9a72e83 @pkhuong Randomised subtask distribution, task stealing works better with non-…
authored
212 (defun bulk-find-task (hint-and-bulk random-state)
5e26071 @pkhuong Split up work stack and work units
authored
213 (declare (type cons hint-and-bulk))
214 (destructuring-bind (hint . bulk) hint-and-bulk
215 (declare (type fixnum hint)
216 (type (or null bulk-task) bulk))
217 (when (null bulk)
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
218 (return-from bulk-find-task (values nil nil nil)))
9a72e83 @pkhuong Randomised subtask distribution, task stealing works better with non-…
authored
219 (multiple-value-bind (task index)
220 (%bulk-find-task bulk hint random-state)
5e26071 @pkhuong Split up work stack and work units
authored
221 (cond (task
222 (setf (car hint-and-bulk) index)
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
223 (values task index bulk))
5e26071 @pkhuong Split up work stack and work units
authored
224 (t
225 (setf (cdr hint-and-bulk) nil)
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
226 (values nil nil nil))))))
5e26071 @pkhuong Split up work stack and work units
authored
227
9a72e83 @pkhuong Randomised subtask distribution, task stealing works better with non-…
authored
228 (defun run-one (stack random-state)
36ab7fa @pkhuong Lock-free single-pusher work-stack
authored
229 (let ((task (pop-one-task stack))
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
230 subtask subtask-index bulk-task)
ffaf272 @pkhuong Actually functional work-stack + docs
authored
231 (cond ((not task) nil)
232 ((atom task)
233 (execute-task task)
234 t)
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
235 ((setf (values subtask subtask-index bulk-task)
9a72e83 @pkhuong Randomised subtask distribution, task stealing works better with non-…
authored
236 (bulk-find-task task random-state))
a640810 @pkhuong Fix a couple bugs and perf regression issues (?)
authored
237 (let* ((bulk-task bulk-task)
c52d3fd @pkhuong More bugfixes.. also parallel:reduce has :key
authored
238 (function (bulk-task-subtask-function bulk-task)))
394a9f6 @pkhuong Clean slots up in tasks and futures when done with them
authored
239 (declare (type bulk-task bulk-task))
33910a2 @pkhuong More parallel-for-friendly work-stack interface; adapt code and skip …
authored
240 (if function
241 (funcall function subtask bulk-task subtask-index)
242 (funcall subtask bulk-task subtask-index))
ffaf272 @pkhuong Actually functional work-stack + docs
authored
243 (when (= (atomic-decf (bulk-task-remaining bulk-task))
244 1)
cd89f0e @pkhuong More comments for work-stack
authored
245 (setf (cdr task) nil)
67ec2ad @pkhuong more root cleaning in work-stack
authored
246 (setf (bulk-task-subtasks bulk-task) #()
247 (bulk-task-subtask-function bulk-task) nil)
ffaf272 @pkhuong Actually functional work-stack + docs
authored
248 (let ((cleanup (bulk-task-cleanup bulk-task)))
249 (etypecase cleanup
250 (null)
251 (cons
252 (dolist (cleanup cleanup)
253 (funcall cleanup bulk-task)))
254 ((or function symbol)
394a9f6 @pkhuong Clean slots up in tasks and futures when done with them
authored
255 (funcall cleanup bulk-task))))
256 (setf (bulk-task-cleanup bulk-task) nil)))
ffaf272 @pkhuong Actually functional work-stack + docs
authored
257 t)
258 (t
9a72e83 @pkhuong Randomised subtask distribution, task stealing works better with non-…
authored
259 (run-one stack random-state)))))
Something went wrong with that request. Please try again.