Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix a couple bugs and perf regression issues (?)

  • Loading branch information...
commit a640810e4cec1d64dbcb4eae09685f6578540aca 1 parent 9a72e83
@pkhuong pkhuong authored
View
3  parallel-futures.lisp
@@ -82,5 +82,4 @@
(append cleanup (list #'future:mark-done))
(list cleanup #'future:mark-done))
arguments)))
- (future:mark-dependencies future)
- (future:thaw future)))
+ (future:mark-dependencies future)))
View
4 parallel-primitives.lisp
@@ -121,8 +121,6 @@
(call-with-future-values
cleanup dependencies)))))
#'make-future)))
- (work-queue:push-self future (work-queue:current-queue
- parallel-future:*context*))
future))
(defun future-value (future)
@@ -174,8 +172,6 @@
:subtask-function (lambda (subtask self index)
(declare (ignore subtask self))
(funcall function index)))))
- (work-queue:push-self future (work-queue:current-queue
- parallel-future:*context*))
future))
(defun call-n-times (count function aggregate-function &optional cleanup)
View
8 thread-pool.lisp
@@ -268,14 +268,14 @@
(defun enqueue (task &optional (queue (current-queue)))
(declare (type task-designator task)
(type queue queue))
- (assert (alive-p queue))
+ (assert (and (alive-p queue) 'enqueue))
(sb-queue:enqueue task (queue-queue queue))
(condition-broadcast (queue-cvar queue))
nil)
(defun enqueue-all (tasks &optional (queue (current-queue)))
(declare (type queue queue))
- (assert (alive-p queue))
+ (assert (and (alive-p queue) 'enqueue-all))
(let ((queue (queue-queue queue)))
(map nil (lambda (task)
(sb-queue:enqueue task queue))
@@ -286,7 +286,7 @@
(defun push-self (task &optional (queue (current-queue)))
(declare (type queue queue)
(type task-designator task))
- (assert (alive-p queue))
+ (assert (and (alive-p queue) 'push-self))
(let ((id *worker-id*))
(cond (id
(assert (eql (aref (queue-threads queue) id)
@@ -297,7 +297,7 @@
(defun push-self-all (tasks &optional (queue (current-queue)))
(declare (type queue queue))
- (assert (alive-p queue))
+ (assert (and (alive-p queue) 'push-self-all))
(let ((id *worker-id*))
(cond (id
(assert (eql (aref (queue-threads queue) id)
View
18 work-stack.lisp
@@ -161,11 +161,13 @@
x))))
(defun push (stack x &optional (hint 0))
- (%push stack (bulk-task-hintify x hint)))
+ (when x
+ (%push stack (bulk-task-hintify x hint))))
(defun push-all (stack values &optional (hint 0))
(map nil (lambda (x)
- (%push stack (bulk-task-hintify x hint)))
+ (when x
+ (%push stack (bulk-task-hintify x hint))))
values))
(defun pop-one-task (stack)
@@ -213,26 +215,26 @@
(declare (type fixnum hint)
(type (or null bulk-task) bulk))
(when (null bulk)
- (return-from bulk-find-task (values nil nil)))
+ (return-from bulk-find-task (values nil nil nil)))
(multiple-value-bind (task index)
(%bulk-find-task bulk hint random-state)
(cond (task
(setf (car hint-and-bulk) index)
- (values task index))
+ (values task index bulk))
(t
(setf (cdr hint-and-bulk) nil)
- (values nil nil))))))
+ (values nil nil nil))))))
(defun run-one (stack random-state)
(let ((task (pop-one-task stack))
- subtask subtask-index)
+ subtask subtask-index bulk-task)
(cond ((not task) nil)
((atom task)
(execute-task task)
t)
- ((setf (values subtask subtask-index)
+ ((setf (values subtask subtask-index bulk-task)
(bulk-find-task task random-state))
- (let* ((bulk-task (cdr task))
+ (let* ((bulk-task bulk-task)
(function (bulk-task-subtask-function bulk-task)))
(declare (type bulk-task bulk-task))
(if function
View
3  work-units.lisp
@@ -24,7 +24,7 @@
(cleanup nil :type (or list symbol function)))
(deftype task-designator ()
- `(or symbol function task bulk-task))
+ `(or (and symbol (not null)) function task bulk-task))
(defun execute-task (task)
(etypecase task
@@ -39,6 +39,7 @@
(declaim (inline random-bit))
(defun random-bit (state max)
+ (return-from random-bit 0)
(let ((random (logand (1- (ash 1 (integer-length max)))
(random (1+ most-positive-fixnum)
state))))
View
4 xecto-impl.lisp
@@ -119,8 +119,8 @@
(let ()
#+nil ((xx (make-xecto '(16 16) :initial-element 1))
(yy (transpose (make-xecto '(16 16) :initial-element 5) 0 1)))
- (setf xx (make-xecto '(16 16) :initial-element 1)
- yy (transpose (make-xecto '(16 16) :initial-element 5) 0 1))
+ (setf xx (make-xecto '(16384 16384) :initial-element 1)
+ yy (transpose (make-xecto '(16384 16384) :initial-element 5) 0 1))
(wait xx :done)
(wait yy :done)
(time (let ((x (map-xecto #'+ xx yy))
Please sign in to comment.
Something went wrong with that request. Please try again.