1.3.1 Finding the GPU🔗ℹ

device-count is the number of visible devices, numbered from 0. The program hands workers out over them round robin:

> (device-count)

1

> (define (device-for-worker i)     (modulo i (device-count)))

> (map device-for-worker '(0 1 2 3))

'(0 0 0 0)

> (device-resources #:device 4)

device-resources: no device 4 among 1

A device the driver does not report raises exn:fail:raft of kind 'logic, named after the procedure you called.

1.3.2 Each worker’s resources🔗ℹ

A worker makes its resources once and keeps them for all its batches: one stream, on which its batches run in order while other workers’ streams overlap, and one set of library handles. device-resources makes new resources on a device:

> (define r (device-resources #:device (device-for-worker 0)))

> r

#<device-resources device 0>

> (resources-device r)

0

> (eq? r (current-device-resources 0))

#f

They are not the thread’s default, current-device-resources, which the array constructors and conversions fall back to without #:resources. Owning its resources lets a worker release them without taking the default from other code on its thread.

The default is per thread and device, and each resources object owns its stream.

1.3.3 Timing a batch🔗ℹ

Operations return once queued. Timing a batch means calling resources-sync! before reading the clock; otherwise it times only the queueing:

> (define (process-batch rows)     (for ([row (in-list rows)])       (unless (= (length row) 2)         (error 'process-batch "row ~a has ~a columns" row (length row))))     (length rows))

> (define (timed r thunk)     (define start (current-inexact-milliseconds))     (define result (thunk))     (resources-sync! r)     (values result (- (current-inexact-milliseconds) start)))

> (define-values (rows ms) (timed r (lambda () (process-batch '((1.0 2.0) (3.0 4.0))))))

> (list rows (real? ms))

'(2 #t)

The milliseconds differ from run to run, so the examples here show the rows and leave the times out.

resources-sync! polls rather than blocking its OS thread, so other threads keep running and a break ends the wait.

1.3.4 A worker🔗ℹ

A worker makes its resources with with-device-resources and times each batch on them:

> (define (run-worker device batches)     (with-device-resources ([r (device-resources #:device device)])       (for/list ([rows (in-list batches)])         (define-values (n ms) (timed r (lambda () (process-batch rows))))         (list n ms))))

> (map first (run-worker 0 (list '((1.0 2.0) (3.0 4.0)) '((5.0 6.0)))))

'(2 1)

The finalizer alone would be correct: it releases resources once they are unreachable. with-device-resources gives their lifetime a clear timeline, a release when the worker returns or fails, because resources hold GPU and driver state the collector cannot see: a CUDA stream and lazily created cuBLAS, cuSOLVER and cuSPARSE handles.

1.3.5 Fanning out🔗ℹ

Each worker runs in its own thread and queues on its own stream. It sends back a thunk that returns its result or re-raises, and the program also watches for a thread that dies without answering:

> (define (run-workers worker jobs)     (define answers       (for/list ([job (in-list jobs)])         (match-define (list device batches) job)         (define done (make-channel))         (define (send thunk) (channel-put done thunk))         (define t           (thread (lambda ()                     (with-handlers ([(lambda (_) #t)                                      (lambda (v) (send (lambda () (raise v))))])                       (define result (worker device batches))                       (send (lambda () result))))))         (choice-evt done                     (handle-evt (thread-dead-evt t)                                 (lambda (_) (lambda () (worker-died device)))))))     (for/list ([answer (in-list answers)])       ((sync answer))))

> (define (worker-died device)     (error 'run-workers "the worker on cuda:~a ended without an answer" device))

> (define (report results)     (for ([batches (in-list results)]           [i (in-naturals)])       (for ([batch (in-list batches)])         (match-define (list n ms) batch)         (printf "worker ~a: ~a rows\n" i n))))

> (define all-batches     (list (list '((1.0 2.0) (3.0 4.0)) '((5.0 6.0)))           (list '((7.0 8.0)))           (list '((9.0 10.0) (11.0 12.0)))))

> (define jobs     (for/list ([batches (in-list all-batches)]                [i (in-naturals)])       (list (device-for-worker i) batches)))

> (report (run-workers run-worker jobs))

worker 0: 2 rows worker 0: 1 rows worker 1: 1 rows worker 2: 2 rows

The channel carries an exception back as a thunk, and calling the thunk re-raises it.

1.3.6 Reporting failed workers🔗ℹ

Every failure raises exn:fail:raft, whose kind tells a full GPU ('out-of-memory) from a bad call ('logic). A worker can return it as its result; here the second job names a missing GPU:

> (define (run-worker/caught device batches)     (with-handlers ([exn:fail:raft? values])       (run-worker device batches)))

> (define (failures results)     (for/list ([result (in-list results)]                [i (in-naturals)]                #:when (exn:fail:raft? result))       (list i (exn:fail:raft-kind result) (exn-message result))))

> (match-define (list batches-0 batches-1 _) all-batches)

> (define results     (run-workers run-worker/caught                  (list (list 0 batches-0) (list 4 batches-1))))

> (failures results)

'((1 logic "device-resources: no device 4 among 1"))

One exception type covers every layer, with the kind as a field.