ice-9/serialize.scm

   1 ;;;;    Copyright (C) 2003, 2006 Free Software Foundation, Inc.
   2 ;;;;
   3 ;;;; This library is free software; you can redistribute it and/or
   4 ;;;; modify it under the terms of the GNU Lesser General Public
   5 ;;;; License as published by the Free Software Foundation; either
   6 ;;;; version 2.1 of the License, or (at your option) any later version.
   7 ;;;;
   8 ;;;; This library is distributed in the hope that it will be useful,
   9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;;;; Lesser General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU Lesser General Public
  14 ;;;; License along with this library; if not, write to the Free Software
  15 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16 ;;;;
  17 \f
  18 ;;; Commentary:
  19
  20 ;; (serialize FORM1 ...) and (parallelize FORM1 ...) are useful when
  21 ;; you don't trust the thread safety of most of your program, but
  22 ;; where you have some section(s) of code which you consider can run
  23 ;; in parallel to other sections.
  24 ;;
  25 ;; They "flag" (with dynamic extent) sections of code to be of
  26 ;; "serial" or "parallel" nature and have the single effect of
  27 ;; preventing a serial section from being run in parallel with any
  28 ;; serial section (including itself).
  29 ;;
  30 ;; Both serialize and parallelize can be nested.  If so, the
  31 ;; inner-most construct is in effect.
  32 ;;
  33 ;; NOTE 1: A serial section can run in parallel with a parallel
  34 ;; section.
  35 ;;
  36 ;; NOTE 2: If a serial section S is "interrupted" by a parallel
  37 ;; section P in the following manner: S = S1 P S2, S2 is not
  38 ;; guaranteed to be resumed by the same thread that previously
  39 ;; executed S1.
  40 ;;
  41 ;; WARNING: Spawning new threads within a serial section have
  42 ;; undefined effects.  It is OK, though, to spawn threads in unflagged
  43 ;; sections of code where neither serialize or parallelize is in
  44 ;; effect.
  45 ;;
  46 ;; A typical usage is when Guile is used as scripting language in some
  47 ;; application doing heavy computations.  If each thread is
  48 ;; encapsulated with a serialize form, you can then put a parallelize
  49 ;; form around the code performing the heavy computations (typically a
  50 ;; C code primitive), enabling the computations to run in parallel
  51 ;; while the scripting code runs single-threadedly.
  52 ;;
  53
  54 ;;; Code:
  55
  56 (define-module (ice-9 serialize)
  57   :use-module (ice-9 threads)
  58   :export (call-with-serialization
  59            call-with-parallelization)
  60   :export-syntax (serialize
  61                   parallelize))
  62
  63 \f
  64 (define serialization-mutex (make-mutex))
  65 (define admin-mutex (make-mutex))
  66 (define owner #f)
  67
  68 (define (call-with-serialization thunk)
  69   (let ((outer-owner #f))
  70     (dynamic-wind
  71         (lambda ()
  72           (lock-mutex admin-mutex)
  73           (set! outer-owner owner)
  74           (if (not (eqv? outer-owner (dynamic-root)))
  75               (begin
  76                 (unlock-mutex admin-mutex)
  77                 (lock-mutex serialization-mutex)
  78                 (set! owner (dynamic-root)))
  79               (unlock-mutex admin-mutex)))
  80         thunk
  81         (lambda ()
  82           (lock-mutex admin-mutex)
  83           (if (not (eqv? outer-owner (dynamic-root)))
  84               (begin
  85                 (set! owner #f)
  86                 (unlock-mutex serialization-mutex)))
  87           (unlock-mutex admin-mutex)))))
  88
  89 (define-macro (serialize . forms)
  90   `(call-with-serialization (lambda () ,@forms)))
  91
  92 (define (call-with-parallelization thunk)
  93   (let ((outer-owner #f))
  94     (dynamic-wind
  95         (lambda ()
  96           (lock-mutex admin-mutex)
  97           (set! outer-owner owner)
  98           (if (eqv? outer-owner (dynamic-root))
  99               (begin
 100                 (set! owner #f)
 101                 (unlock-mutex serialization-mutex)))
 102           (unlock-mutex admin-mutex))
 103         thunk
 104         (lambda ()
 105           (lock-mutex admin-mutex)
 106           (if (eqv? outer-owner (dynamic-root))
 107               (begin
 108                 (unlock-mutex admin-mutex)
 109                 (lock-mutex serialization-mutex)
 110                 (set! owner outer-owner))
 111               (unlock-mutex admin-mutex))))))
 112
 113 (define-macro (parallelize . forms)
 114   `(call-with-parallelization (lambda () ,@forms)))