diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index ce6e9521f..28e90e3d1 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -15,6 +15,7 @@ * Blocking:: How to block properly in guile mode. * Critical Sections:: Avoiding concurrency and reentries. * Fluids and Dynamic States:: Thread-local variables, etc. +* Futures:: Fine-grain parallelism. * Parallel Forms:: Parallel execution of forms. @end menu @@ -195,6 +196,16 @@ Execute all thunks from the marked asyncs of the list @var{list_of_a}. @cindex Guile threads @cindex POSIX threads +Guile supports POSIX threads, unless it was configured with +@code{--without-threads} or the host lacks POSIX thread support. When +thread support is available, the @code{threads} feature is provided +(@pxref{Feature Manipulation, @code{provided?}}). + +The procedures below manipulate Guile threads, which are wrappers around +the system's POSIX threads. For application-level parallelism, using +higher-level constructs, such as futures, is recommended +(@pxref{Futures}). + @deffn {Scheme Procedure} all-threads @deffnx {C Function} scm_all_threads () Return a list of all threads. @@ -791,6 +802,92 @@ Like @code{scm_with_dynamic_state}, but call @var{func} with @var{data}. @end deftypefn +@node Futures +@subsection Futures +@cindex futures +@cindex fine-grain parallelism +@cindex parallelism + +The @code{(ice-9 futures)} module provides @dfn{futures}, a construct +for fine-grain parallelism. A future is a wrapper around an expression +whose computation may occur in parallel with the code of the calling +thread, and possibly in parallel with other futures. Like promises, +futures are essentially proxies that can be queried to obtain the value +of the enclosed expression: + +@lisp +(touch (future (+ 2 3))) +@result{} 5 +@end lisp + +However, unlike promises, the expression associated with a future may be +evaluated on another CPU core, should one be available. This supports +@dfn{fine-grain parallelism}, because even relatively small computations +can be embedded in futures. Consider this sequential code: + +@lisp +(define (find-prime lst1 lst2) + (or (find prime? lst1) + (find prime? lst2))) +@end lisp + +The two arms of @code{or} are potentially computation-intensive. They +are independent of one another, yet, they are evaluated sequentially +when the first one returns @code{#f}. Using futures, one could rewrite +it like this: + +@lisp +(define (find-prime lst1 lst2) + (let ((f (future (find prime? lst2)))) + (or (find prime? lst1) + (touch f)))) +@end lisp + +This preserves the semantics of @code{find-prime}. On a multi-core +machine, though, the computation of @code{(find prime? lst2)} may be +done in parallel with that of the other @code{find} call, which can +reduce the execution time of @code{find-prime}. + +Guile's futures are implemented on top of POSIX threads +(@pxref{Threads}). Internally, a fixed-size pool of threads is used to +evaluate futures, such that offloading the evaluation of an expression +to another thread doesn't incur thread creation costs. By default, the +pool contains one thread per CPU core, minus one, to account for the +main thread. + +@deffn {Scheme Syntax} future exp +Return a future for expression @var{exp}. This is equivalent to: + +@lisp +(make-future (lambda () exp)) +@end lisp +@end deffn + +@deffn {Scheme Procedure} make-future thunk +Return a future for @var{thunk}, a zero-argument procedure. + +This procedure returns immediately. Execution of @var{thunk} may begin +in parallel with the calling thread's computations, if idle CPU cores +are available, or it may start when @code{touch} is invoked on the +returned future. + +If the execution of @var{thunk} throws an exception, that exception will +be re-thrown when @code{touch} is invoked on the returned future. +@end deffn + +@deffn {Scheme Procedure} future? obj +Return @code{#t} if @var{obj} is a future. +@end deffn + +@deffn {Scheme Procedure} touch f +Return the result of the expression embedded in future @var{f}. + +If the result was already computed in parallel, @code{touch} returns +instantaneously. Otherwise, it waits for the computation to complete, +if it already started, or initiates it. +@end deffn + + @node Parallel Forms @subsection Parallel forms @cindex parallel forms diff --git a/module/Makefile.am b/module/Makefile.am index d2a44b8a9..e16cd557f 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -187,6 +187,7 @@ ICE_9_SOURCES = \ ice-9/documentation.scm \ ice-9/expect.scm \ ice-9/format.scm \ + ice-9/futures.scm \ ice-9/getopt-long.scm \ ice-9/hcons.scm \ ice-9/i18n.scm \ diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm new file mode 100644 index 000000000..b2e4c0da5 --- /dev/null +++ b/module/ice-9/futures.scm @@ -0,0 +1,177 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (ice-9 futures) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (ice-9 match) + #:export (future make-future future? touch)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides an implementation of futures, a mechanism for +;;; fine-grain parallelism. Futures were first described by Henry Baker +;;; in ``The Incremental Garbage Collection of Processes'', 1977, and +;;; then implemented in MultiLisp (an implicit variant thereof, i.e., +;;; without `touch'.) +;;; +;;; This modules uses a fixed thread pool, normally one per CPU core. +;;; Futures are off-loaded to these threads, when they are idle. +;;; +;;; Code: + + +;;; +;;; Futures. +;;; + +(define-record-type + (%make-future thunk done? mutex) + future? + (thunk future-thunk) + (done? future-done? set-future-done?!) + (result future-result set-future-result!) + (mutex future-mutex)) + +(define (make-future thunk) + "Return a new future for THUNK. Execution may start at any point +concurrently, or it can start at the time when the returned future is +touched." + (let ((future (%make-future thunk #f (make-mutex)))) + (register-future! future) + future)) + + +;;; +;;; Future queues. +;;; + +(define %futures '()) +(define %futures-mutex (make-mutex)) +(define %futures-available (make-condition-variable)) + +(define (register-future! future) + ;; Register FUTURE as being processable. + (lock-mutex %futures-mutex) + (set! %futures (cons future %futures)) ;; FIXME: use a FIFO + (signal-condition-variable %futures-available) + (unlock-mutex %futures-mutex)) + +(define (unregister-future! future) + ;; Assume %FUTURES-MUTEX is taken. + (set! %futures (delq future %futures))) + +(define (process-future! future) + ;; Process FUTURE, assuming its mutex is already taken. + (set-future-result! future + (catch #t + (lambda () + (let ((result ((future-thunk future)))) + (lambda () + result))) + (lambda args + (lambda () + (apply throw args))))) + (set-future-done?! future #t)) + +(define (process-futures) + ;; Wait for futures to be available and process them. + (lock-mutex %futures-mutex) + (let loop () + (wait-condition-variable %futures-available + %futures-mutex) + (match %futures + (() (loop)) + ((future _ ...) + (lock-mutex (future-mutex future)) + (or (future-done? future) + (begin + ;; Do the actual work. + (unregister-future! future) + + ;; We want to release %FUTURES-MUTEX so that other workers + ;; can progress. However, to avoid deadlocks, we have to + ;; unlock FUTURE as well, to preserve lock ordering. + (unlock-mutex (future-mutex future)) + (unlock-mutex %futures-mutex) + + (lock-mutex (future-mutex future)) + (or (future-done? future) ; lost the race? + (process-future! future)) + + (lock-mutex %futures-mutex))) + (unlock-mutex (future-mutex future)) + (loop))))) + +(define (touch future) + "Return the result of FUTURE, computing it if not already done." + (lock-mutex (future-mutex future)) + (or (future-done? future) + (begin + ;; Do the actual work. Unlock FUTURE first to preserve lock + ;; ordering. + (unlock-mutex (future-mutex future)) + + (lock-mutex %futures-mutex) + (unregister-future! future) + (unlock-mutex %futures-mutex) + + (lock-mutex (future-mutex future)) + (or (future-done? future) ; lost the race? + (process-future! future)))) + (unlock-mutex (future-mutex future)) + ((future-result future))) + + +;;; +;;; Workers. +;;; + +(define %worker-count + (if (provided? 'threads) + (if (defined? 'getaffinity) + (- (bit-count #t (getaffinity (getpid))) 1) + 3) ;; FIXME: use Gnulib's `nproc' here. + 0)) + +(define %workers + ;; A dock of workers that stay here forever. + + ;; TODO + ;; 1. Allocate lazily. + ;; 2. Allow the pool to be shrunk, as in libgomp (though that we'd + ;; need semaphores, which aren't yet in libguile!). + ;; 3. Provide a `worker-count' fluid. + (unfold (lambda (i) (>= i %worker-count)) + (lambda (i) + (call-with-new-thread process-futures)) + 1+ + 0)) + + +;;; +;;; Syntax. +;;; + +(define-syntax future + (syntax-rules () + "Return a new future for BODY." + ((_ body) + (make-future (lambda () body))))) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 7ca4c54ea..2e43e877b 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -50,6 +50,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/format.test \ tests/fractions.test \ tests/ftw.test \ + tests/future.test \ tests/gc.test \ tests/getopt-long.test \ tests/goops.test \ diff --git a/test-suite/tests/future.test b/test-suite/tests/future.test new file mode 100644 index 000000000..440376d7a --- /dev/null +++ b/test-suite/tests/future.test @@ -0,0 +1,83 @@ +;;;; future.test --- Futures. -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Ludovic Courtès +;;;; +;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-future) + #:use-module (test-suite lib) + #:use-module (ice-9 futures) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26)) + +(define specific-exception-key (gensym)) + +(define specific-exception + (cons specific-exception-key ".*")) + + +(with-test-prefix "futures" + + (pass-if "make-future" + (future? (make-future (lambda () #f)))) + + (pass-if "future" + (future? (future #t))) + + (pass-if "true" + (touch (future #t))) + + (pass-if "(+ 2 3)" + (= 5 (touch (future (+ 2 3))))) + + (pass-if "many" + (equal? (iota 1234) + (map touch + (map (lambda (i) + (make-future (lambda () i))) + (iota 1234))))) + + (pass-if "touch several times" + (let* ((f+ (unfold (cut >= <> 123) + (lambda (i) + (make-future + (let ((x (1- i))) + (lambda () + (set! x (1+ x)) + i)))) + 1+ + 0)) + (r1 (map touch f+)) + (r2 (map touch f+)) + (r3 (map touch f+))) + (equal? (iota 123) r1 r2 r3))) + + (pass-if "nested" + (= (touch (future (+ 2 (touch (future -2)) + (reduce + 0 + (map touch + (map (lambda (i) + (future i)) + (iota 123))))))) + (reduce + 0 (iota 123)))) + + (pass-if "no exception" + (future? (future (throw 'foo 'bar)))) + + (pass-if-exception "exception" + specific-exception + (touch (future (throw specific-exception-key 'test "thrown!")))))