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 3 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 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 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 (current-thread))) 75 (begin 76 (unlock-mutex admin-mutex) 77 (lock-mutex serialization-mutex) 78 (set! owner (current-thread))) 79 (unlock-mutex admin-mutex))) 80 thunk 81 (lambda () 82 (lock-mutex admin-mutex) 83 (if (not (eqv? outer-owner (current-thread))) 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 (current-thread)) 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 (current-thread)) 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))) 115