futures: Limit the number of nested futures on the same stack.

Fixes <http://bugs.gnu.org/13188>.
Reported by Nala Ginrut <nalaginrut@gmail.com>.

* module/ice-9/futures.scm (%nesting-level): Rename to...
  (%nesting-level): ... this.  Default to 0 instead of #f.  Update
  users.
  (%max-nesting-level): New variable.
  (touch): When FUTURE is queued and (%nesting-level) is above
  %MAX-NESTING-LEVEL, abort to %FUTURE-PROMPT.
* test-suite/tests/future.test ("nested futures")["loop"]: Remove
  `compile' call.
* test-suite/tests/threads.test ("par-map")["long list"]: New test.
* doc/ref/api-scheduling.texi (Futures): Add a paragraph about stack
  consumption.

doc/ref/api-scheduling.texi

@@ -1037,6 +1037,13 @@ future has completed.  This suspend/resume is achieved by capturing the
 calling future's continuation, and later reinstating it (@pxref{Prompts,
 delimited continuations}).
 
+Note that @code{par-map} above is not tail-recursive.  This could lead
+to stack overflows when @var{lst} is large compared to
+@code{(current-processor-count)}.  To address that, @code{touch} uses
+the suspend mechanism described above to limit the number of nested
+futures executing on the same stack.  Thus, the above code should never
+run into stack overflows.
+
 @deffn {Scheme Syntax} future exp
 Return a future for expression @var{exp}.  This is equivalent to:
 

module/ice-9/futures.scm

@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012, 2013 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
@@ -88,8 +88,14 @@ touched."
 ;; A mapping of nested futures to futures waiting for them to complete.
 (define %futures-waiting '())
 
-;; Whether currently running within a future.
-(define %within-future? (make-parameter #f))
+;; Nesting level of futures.  Incremented each time a future is touched
+;; from within a future.
+(define %nesting-level (make-parameter 0))
+
+;; Maximum nesting level.  The point is to avoid stack overflows when
+;; nested futures are executed on the same stack.  See
+;; <http://bugs.gnu.org/13188>.
+(define %max-nesting-level 200)
 
 (define-syntax-rule (with-mutex m e0 e1 ...)
   ;; Copied from (ice-9 threads) to avoid circular dependency.
@@ -155,7 +161,8 @@ adding it to the waiter queue."
            (thunk (lambda ()
                     (call-with-prompt %future-prompt
                                       (lambda ()
-                                        (parameterize ((%within-future? #t))
+                                        (parameterize ((%nesting-level
+                                                        (1+ (%nesting-level))))
                                           ((future-thunk future))))
                                       suspend))))
       (set-future-result! future
@@ -254,14 +261,16 @@ adding it to the waiter queue."
        (unlock-mutex (future-mutex future)))
       ((started)
        (unlock-mutex (future-mutex future))
-       (if (%within-future?)
+       (if (> (%nesting-level) 0)
            (abort-to-prompt %future-prompt future)
            (begin
              (work)
              (loop))))
-      (else
+      (else                                       ; queued
        (unlock-mutex (future-mutex future))
-       (work)
+       (if (> (%nesting-level) %max-nesting-level)
+           (abort-to-prompt %future-prompt future)
+           (work))
        (loop))))
   ((future-result future)))
 

test-suite/tests/future.test

@@ -2,7 +2,7 @@
 ;;;;
 ;;;; Ludovic Courtès <ludo@gnu.org>
 ;;;;
-;;;; 	Copyright (C) 2010, 2012 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2010, 2012, 2013 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
@@ -22,8 +22,7 @@
   #:use-module (test-suite lib)
   #:use-module (ice-9 futures)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (system base compile))
+  #:use-module (srfi srfi-26))
 
 (define specific-exception-key (gensym))
 
@@ -98,11 +97,8 @@
     (touch (future (1+ (touch (future (1+ (touch (future 0)))))))))
 
   (pass-if-equal "loop" (map - (iota 1000))
-    ;; Compile to avoid stack overflows.
-    (compile '(let loop ((list (iota 1000)))
-                (if (null? list)
-                    '()
-                    (cons (- (car list))
-                          (touch (future (loop (cdr list)))))))
-             #:to 'value
-             #:env (current-module))))
+    (let loop ((list (iota 1000)))
+      (if (null? list)
+          '()
+          (cons (- (car list))
+                (touch (future (loop (cdr list)))))))))

test-suite/tests/threads.test

@@ -1,6 +1,6 @@
 ;;;; threads.test --- Tests for Guile threading.    -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013 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
@@ -86,7 +86,12 @@
                       (equal? (par-map fibo (iota 13))
                               (map fibo (iota 13))))
                    #:to 'value
-                   #:env (current-module))))
+                   #:env (current-module)))
+
+        (pass-if-equal "long list" (map 1+ (iota 10000))
+          ;; In Guile 2.0.7, this would trigger a stack overflow.
+          ;; See <http://bugs.gnu.org/13188>.
+          (par-map 1+ (iota 10000))))
 
       ;;
       ;; par-for-each