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