Commit | Line | Data |
---|---|---|
cd5fea8d | 1 | ;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. |
56b97da9 MD |
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 | |
53befeb7 | 6 | ;;;; version 3 of the License, or (at your option) any later version. |
56b97da9 MD |
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 | |
92205699 | 15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
56b97da9 MD |
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))) |