[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-118-g0d4e6ca

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0d4e6ca38f1c51f5f92effc7d97c8b69eb85d071

The branch, master has been updated
       via  0d4e6ca38f1c51f5f92effc7d97c8b69eb85d071 (commit)
       via  fe613fe25d55ac293fbce510a3ac6057b270fa31 (commit)
      from  50a4533f82e930adc357345e364672ac6c07ea16 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 0d4e6ca38f1c51f5f92effc7d97c8b69eb85d071
Author: Ludovic Courtès <address@hidden>
Date:   Fri Dec 3 00:35:15 2010 +0100

    Add `(ice-9 futures)'.
    
    * doc/ref/api-scheduling.texi (Threads): Add short introduction.
      Mention the `threads' feature.  Add cross-reference to futures.
      (Futures): New node.
    
    * module/Makefile.am (ICE_9_SOURCES): Add `ice-9/futures.scm'.
    
    * module/ice-9/futures.scm: New file.
    
    * test-suite/Makefile.am (SCM_TESTS): Add `tests/future.test'.
    
    * test-suite/tests/future.test: New file.

commit fe613fe25d55ac293fbce510a3ac6057b270fa31
Author: Ludovic Courtès <address@hidden>
Date:   Wed Dec 1 23:58:39 2010 +0100

    Add bindings to GNU `sched_setaffinity' and `sched_getaffinity'.
    
    * configure.ac: Add checks for `sched_setaffinity' and
      `sched_getaffinity'.
    
    * doc/ref/posix.texi (Processes): Document `getaffinity' and
      `setaffinity'.
    
    * libguile/posix.c (cpu_set_to_bitvector,
      scm_getaffinity)[HAVE_SCHED_GETAFFINITY]: New functions.
      (scm_setaffinity)[HAVE_SCHED_SETAFFINITY]: New function.
    
    * libguile/posix.h (scm_getaffinity, scm_setaffinity): New declarations.
    
    * test-suite/tests/posix.test ("affinity"): New test prefix.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac                 |    3 +-
 doc/ref/api-scheduling.texi  |   99 +++++++++++++++++++++++-
 doc/ref/posix.texi           |   22 +++++
 libguile/posix.c             |   85 ++++++++++++++++++++-
 libguile/posix.h             |    2 +
 module/Makefile.am           |    1 +
 module/ice-9/futures.scm     |  177 ++++++++++++++++++++++++++++++++++++++++++
 test-suite/Makefile.am       |    1 +
 test-suite/tests/future.test |   83 ++++++++++++++++++++
 test-suite/tests/posix.test  |   18 ++++
 10 files changed, 488 insertions(+), 3 deletions(-)
 create mode 100644 module/ice-9/futures.scm
 create mode 100644 test-suite/tests/future.test

diff --git a/configure.ac b/configure.ac
index 3446992..631198b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -751,8 +751,9 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
 #   nl_langinfo - X/Open, not available on Windows.
 #   utimensat: posix.1-2008
+#   sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
 #
-AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround 
ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat 
mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select 
setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime 
strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup 
system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill 
getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy 
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale 
nl_langinfo utimensat])
+AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround 
ftime ftruncate fchown getcwd geteuid getsid gettimeofday gmtime_r ioctl lstat 
mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select 
setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime 
strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup 
system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill 
getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy 
rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale 
nl_langinfo utimensat sched_getaffinity sched_setaffinity])
 
 # Reasons for testing:
 #   netdb.h - not in mingw
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index ce6e952..28e90e3 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.
address@hidden Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 
2009
address@hidden 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
address@hidden 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
 
address@hidden Futures
address@hidden Futures
address@hidden futures
address@hidden fine-grain parallelism
address@hidden 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:
+
address@hidden
+(touch (future (+ 2 3)))
address@hidden 5
address@hidden lisp
+
+However, unlike promises, the expression associated with a future may be
+evaluated on another CPU core, should one be available.  This supports
address@hidden parallelism}, because even relatively small computations
+can be embedded in futures.  Consider this sequential code:
+
address@hidden
+(define (find-prime lst1 lst2)
+  (or (find prime? lst1)
+      (find prime? lst2)))
address@hidden 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:
+
address@hidden
+(define (find-prime lst1 lst2)
+  (let ((f (future (find prime? lst2))))
+    (or (find prime? lst1)
+        (touch f))))
address@hidden 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.
+
address@hidden {Scheme Syntax} future exp
+Return a future for expression @var{exp}.  This is equivalent to:
+
address@hidden
+(make-future (lambda () exp))
address@hidden lisp
address@hidden deffn
+
address@hidden {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.
address@hidden deffn
+
address@hidden {Scheme Procedure} future? obj
+Return @code{#t} if @var{obj} is a future.
address@hidden deffn
+
address@hidden {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.
address@hidden deffn
+
+
 @node Parallel Forms
 @subsection Parallel forms
 @cindex parallel forms
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 3499404..7149fb6 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1830,6 +1830,28 @@ the highest priority (lowest numerical value) of any of 
the
 specified processes.
 @end deffn
 
address@hidden affinity, CPU
+
address@hidden {Scheme Procedure} getaffinity pid
address@hidden {C Function} scm_getaffinity (pid)
+Return a bitvector representing the CPU affinity mask for
+process @var{pid}.  Each CPU the process has affinity with
+has its corresponding bit set in the returned bitvector.
+The number of bits set is a good estimate of how many CPUs
+Guile can use without stepping on other processes' toes.
+
+Currently this procedure is only defined on GNU variants.
address@hidden deffn
+
address@hidden {Scheme Procedure} setaffinity pid mask
address@hidden {C Function} scm_setaffinity (pid, mask)
+Install the CPU affinity mask @var{mask}, a bitvector, for
+the process or thread with ID @var{pid}.  The return value
+is unspecified.
+
+Currently this procedure is only defined on GNU variants.
address@hidden deffn
+
 
 @node Signals
 @subsection Signals
diff --git a/libguile/posix.c b/libguile/posix.c
index 8301a7e..2a2a77b 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1903,6 +1903,89 @@ SCM_DEFINE (scm_setpriority, "setpriority", 3, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SETPRIORITY */
 
+#ifdef HAVE_SCHED_GETAFFINITY
+
+static SCM
+cpu_set_to_bitvector (const cpu_set_t *cs)
+{
+  SCM bv;
+  size_t cpu;
+
+  bv = scm_c_make_bitvector (sizeof (*cs), SCM_BOOL_F);
+
+  for (cpu = 0; cpu < sizeof (*cs); cpu++)
+    {
+      if (CPU_ISSET (cpu, cs))
+       /* XXX: This is inefficient but avoids code duplication.  */
+       scm_c_bitvector_set_x (bv, cpu, SCM_BOOL_T);
+    }
+
+  return bv;
+}
+
+SCM_DEFINE (scm_getaffinity, "getaffinity", 1, 0, 0,
+           (SCM pid),
+           "Return a bitvector representing the CPU affinity mask for\n"
+           "process @var{pid}.  Each CPU the process has affinity with\n"
+           "has its corresponding bit set in the returned bitvector.\n"
+           "The number of bits set is a good estimate of how many CPUs\n"
+           "Guile can use without stepping on other processes' toes.\n\n"
+           "Currently this procedure is only defined on GNU variants.\n")
+#define FUNC_NAME s_scm_getaffinity
+{
+  int err;
+  cpu_set_t cs;
+
+  CPU_ZERO (&cs);
+  err = sched_getaffinity (scm_to_int (pid), sizeof (cs), &cs);
+  if (err)
+    SCM_SYSERROR;
+
+  return cpu_set_to_bitvector (&cs);
+}
+#undef FUNC_NAME
+
+#endif /* HAVE_SCHED_GETAFFINITY */
+
+#ifdef HAVE_SCHED_SETAFFINITY
+
+SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
+           (SCM pid, SCM mask),
+           "Install the CPU affinity mask @var{mask}, a bitvector, for\n"
+           "the process or thread with ID @var{pid}.  The return value\n"
+           "is unspecified.\n\n"
+           "Currently this procedure is only defined on GNU variants.\n")
+#define FUNC_NAME s_scm_setaffinity
+{
+  cpu_set_t cs;
+  scm_t_array_handle handle;
+  const scm_t_uint32 *c_mask;
+  size_t len, off, cpu;
+  ssize_t inc;
+  int err;
+
+  c_mask = scm_bitvector_elements (mask, &handle, &off, &len, &inc);
+
+  CPU_ZERO (&cs);
+  for (cpu = 0; cpu < len; cpu++)
+    {
+      size_t idx;
+
+      idx = cpu * inc + off;
+      if (c_mask[idx / 32] & (1UL << (idx % 32)))
+       CPU_SET (cpu, &cs);
+    }
+
+  err = sched_setaffinity (scm_to_int (pid), sizeof (cs), &cs);
+  if (err)
+    SCM_SYSERROR;
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#endif /* HAVE_SCHED_SETAFFINITY */
+
 #if HAVE_GETPASS
 SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0, 
             (SCM prompt),
@@ -2078,7 +2161,7 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETHOSTNAME */
 
-
+
 void
 scm_init_posix ()
 {
diff --git a/libguile/posix.h b/libguile/posix.h
index da58835..aa5e12c 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -89,6 +89,8 @@ SCM_API SCM scm_getpass (SCM prompt);
 SCM_API SCM scm_flock (SCM file, SCM operation);
 SCM_API SCM scm_sethostname (SCM name);
 SCM_API SCM scm_gethostname (void);
+SCM_API SCM scm_getaffinity (SCM pid);
+SCM_API SCM scm_setaffinity (SCM pid, SCM cpu_set);
 SCM_INTERNAL void scm_init_posix (void);
 
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex;
diff --git a/module/Makefile.am b/module/Makefile.am
index d2a44b8..e16cd55 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 0000000..b2e4c0d
--- /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 <address@hidden>
+;;;
+;;; 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 <future>
+  (%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 7ca4c54..2e43e87 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 0000000..440376d
--- /dev/null
+++ b/test-suite/tests/future.test
@@ -0,0 +1,83 @@
+;;;; future.test --- Futures.       -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;; Ludovic Courtès <address@hidden>
+;;;;
+;;;;   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!")))))
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 6cfecee..9679042 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -180,3 +180,21 @@
                    (= (stat:mtime info) modified)))))
         (lambda ()
           (delete-file file))))))
+
+;;
+;; affinity
+;;
+
+(with-test-prefix "affinity"
+
+  (pass-if "getaffinity"
+    (if (defined? 'getaffinity)
+        (> (bitvector-length (getaffinity (getpid))) 0)
+        (throw 'unresolved)))
+
+  (pass-if "setaffinity"
+    (if (and (defined? 'setaffinity) (defined? 'getaffinity))
+        (let ((mask (getaffinity (getpid))))
+          (setaffinity (getpid) mask)
+          (equal? mask (getaffinity (getpid))))
+        (throw 'unresolved))))


hooks/post-receive
-- 
GNU Guile