serialize.scm 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  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. ;;; Commentary:
  18. ;; (serialize FORM1 ...) and (parallelize FORM1 ...) are useful when
  19. ;; you don't trust the thread safety of most of your program, but
  20. ;; where you have some section(s) of code which you consider can run
  21. ;; in parallel to other sections.
  22. ;;
  23. ;; They "flag" (with dynamic extent) sections of code to be of
  24. ;; "serial" or "parallel" nature and have the single effect of
  25. ;; preventing a serial section from being run in parallel with any
  26. ;; serial section (including itself).
  27. ;;
  28. ;; Both serialize and parallelize can be nested. If so, the
  29. ;; inner-most construct is in effect.
  30. ;;
  31. ;; NOTE 1: A serial section can run in parallel with a parallel
  32. ;; section.
  33. ;;
  34. ;; NOTE 2: If a serial section S is "interrupted" by a parallel
  35. ;; section P in the following manner: S = S1 P S2, S2 is not
  36. ;; guaranteed to be resumed by the same thread that previously
  37. ;; executed S1.
  38. ;;
  39. ;; WARNING: Spawning new threads within a serial section have
  40. ;; undefined effects. It is OK, though, to spawn threads in unflagged
  41. ;; sections of code where neither serialize or parallelize is in
  42. ;; effect.
  43. ;;
  44. ;; A typical usage is when Guile is used as scripting language in some
  45. ;; application doing heavy computations. If each thread is
  46. ;; encapsulated with a serialize form, you can then put a parallelize
  47. ;; form around the code performing the heavy computations (typically a
  48. ;; C code primitive), enabling the computations to run in parallel
  49. ;; while the scripting code runs single-threadedly.
  50. ;;
  51. ;;; Code:
  52. (define-module (ice-9 serialize)
  53. :use-module (ice-9 threads)
  54. :export (call-with-serialization
  55. call-with-parallelization)
  56. :export-syntax (serialize
  57. parallelize))
  58. (define serialization-mutex (make-mutex))
  59. (define admin-mutex (make-mutex))
  60. (define owner #f)
  61. (define (call-with-serialization thunk)
  62. (let ((outer-owner #f))
  63. (dynamic-wind
  64. (lambda ()
  65. (lock-mutex admin-mutex)
  66. (set! outer-owner owner)
  67. (if (not (eqv? outer-owner (dynamic-root)))
  68. (begin
  69. (unlock-mutex admin-mutex)
  70. (lock-mutex serialization-mutex)
  71. (set! owner (dynamic-root)))
  72. (unlock-mutex admin-mutex)))
  73. thunk
  74. (lambda ()
  75. (lock-mutex admin-mutex)
  76. (if (not (eqv? outer-owner (dynamic-root)))
  77. (begin
  78. (set! owner #f)
  79. (unlock-mutex serialization-mutex)))
  80. (unlock-mutex admin-mutex)))))
  81. (define-macro (serialize . forms)
  82. `(call-with-serialization (lambda () ,@forms)))
  83. (define (call-with-parallelization thunk)
  84. (let ((outer-owner #f))
  85. (dynamic-wind
  86. (lambda ()
  87. (lock-mutex admin-mutex)
  88. (set! outer-owner owner)
  89. (if (eqv? outer-owner (dynamic-root))
  90. (begin
  91. (set! owner #f)
  92. (unlock-mutex serialization-mutex)))
  93. (unlock-mutex admin-mutex))
  94. thunk
  95. (lambda ()
  96. (lock-mutex admin-mutex)
  97. (if (eqv? outer-owner (dynamic-root))
  98. (begin
  99. (unlock-mutex admin-mutex)
  100. (lock-mutex serialization-mutex)
  101. (set! owner outer-owner))
  102. (unlock-mutex admin-mutex))))))
  103. (define-macro (parallelize . forms)
  104. `(call-with-parallelization (lambda () ,@forms)))