1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 23:20:32 +02:00

lazily init futures worker pool

* module/ice-9/futures.scm (%workers, %create-workers!)
  (create-workers!): Define a mechanism to spawn off the future threads
  only when the first future is created.
  (make-future): Call create-workers! here.
This commit is contained in:
Andy Wingo 2011-05-26 18:14:32 +02:00
parent a8952d1fb7
commit f4e45e91f2

View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*- ;;; -*- mode: scheme; coding: utf-8; -*-
;;; ;;;
;;; Copyright (C) 2010 Free Software Foundation, Inc. ;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;; ;;;
;;; This library is free software; you can redistribute it and/or ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -54,6 +54,7 @@
"Return a new future for THUNK. Execution may start at any point "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 concurrently, or it can start at the time when the returned future is
touched." touched."
(create-workers!)
(let ((future (%make-future thunk #f (make-mutex)))) (let ((future (%make-future thunk #f (make-mutex))))
(register-future! future) (register-future! future)
future)) future))
@ -145,19 +146,27 @@ touched."
(- (current-processor-count) 1) (- (current-processor-count) 1)
0)) 0))
(define %workers ;; A dock of workers that stay here forever.
;; A dock of workers that stay here forever.
;; TODO ;; TODO
;; 1. Allocate lazily. ;; 1. Allow the pool to be shrunk, as in libgomp (though that we'd
;; 2. Allow the pool to be shrunk, as in libgomp (though that we'd ;; need semaphores, which aren't yet in libguile!).
;; need semaphores, which aren't yet in libguile!). ;; 2. Provide a `worker-count' fluid.
;; 3. Provide a `worker-count' fluid. (define %workers '())
(define (%create-workers!)
(lock-mutex %futures-mutex)
(set! %workers
(unfold (lambda (i) (>= i %worker-count)) (unfold (lambda (i) (>= i %worker-count))
(lambda (i) (lambda (i)
(call-with-new-thread process-futures)) (call-with-new-thread process-futures))
1+ 1+
0)) 0))
(set! create-workers! (lambda () #t))
(unlock-mutex %futures-mutex))
(define create-workers!
(lambda () (%create-workers!)))
;;; ;;;