ice-9/threads.scm

   1 ;;;;    Copyright (C) 1996, 1998, 2001 Free Software Foundation, Inc.
   2 ;;;;
   3 ;;;; This program is free software; you can redistribute it and/or modify
   4 ;;;; it under the terms of the GNU General Public License as published by
   5 ;;;; the Free Software Foundation; either version 2, or (at your option)
   6 ;;;; any later version.
   7 ;;;;
   8 ;;;; This program 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
  11 ;;;; GNU General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU General Public License
  14 ;;;; along with this software; see the file COPYING.  If not, write to
  15 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16 ;;;; Boston, MA 02111-1307 USA
  17 ;;;;
  18 ;;;; As a special exception, the Free Software Foundation gives permission
  19 ;;;; for additional uses of the text contained in its release of GUILE.
  20 ;;;;
  21 ;;;; The exception is that, if you link the GUILE library with other files
  22 ;;;; to produce an executable, this does not by itself cause the
  23 ;;;; resulting executable to be covered by the GNU General Public License.
  24 ;;;; Your use of that executable is in no way restricted on account of
  25 ;;;; linking the GUILE library code into it.
  26 ;;;;
  27 ;;;; This exception does not however invalidate any other reasons why
  28 ;;;; the executable file might be covered by the GNU General Public License.
  29 ;;;;
  30 ;;;; This exception applies only to the code released by the
  31 ;;;; Free Software Foundation under the name GUILE.  If you copy
  32 ;;;; code from other Free Software Foundation releases into a copy of
  33 ;;;; GUILE, as the General Public License permits, the exception does
  34 ;;;; not apply to the code that you add in this way.  To avoid misleading
  35 ;;;; anyone as to the status of such modified files, you must delete
  36 ;;;; this exception notice from them.
  37 ;;;;
  38 ;;;; If you write modifications of your own for GUILE, it is your choice
  39 ;;;; whether to permit this exception to apply to your modifications.
  40 ;;;; If you do not wish that, delete this exception notice.
  41 ;;;;
  42 ;;;; ----------------------------------------------------------------
  43 ;;;; threads.scm -- User-level interface to Guile's thread system
  44 ;;;; 4 March 1996, Anthony Green <green@cygnus.com>
  45 ;;;; Modified 5 October 1996, MDJ <djurfeldt@nada.kth.se>
  46 ;;;; Modified 6 April 2001, ttn
  47 ;;;; ----------------------------------------------------------------
  48 ;;;;
  49 \f
  50 ;;; Commentary:
  51
  52 ;; This module is documented in the Guile Reference Manual.
  53 ;; Briefly, one procedure is exported: `%thread-handler';
  54 ;; as well as four macros: `make-thread', `begin-thread',
  55 ;; `with-mutex' and `monitor'.
  56
  57 ;;; Code:
  58
  59 (define-module (ice-9 threads))
  60
  61 \f
  62
  63 (define (%thread-handler tag . args)
  64   (fluid-set! the-last-stack #f)
  65   (unmask-signals)
  66   (let ((n (length args))
  67         (p (current-error-port)))
  68     (display "In thread:" p)
  69     (newline p)
  70     (if (>= n 3)
  71         (display-error #f
  72                        p
  73                        (car args)
  74                        (cadr args)
  75                        (caddr args)
  76                        (if (= n 4)
  77                            (cadddr args)
  78                            '()))
  79         (begin
  80           (display "uncaught throw to " p)
  81           (display tag p)
  82           (display ": " p)
  83           (display args p)
  84           (newline p)))))
  85
  86 ; --- MACROS -------------------------------------------------------
  87
  88 (defmacro make-thread (proc . args)
  89   `(call-with-new-thread
  90     (lambda ()
  91       (,proc ,@args))
  92     %thread-handler))
  93
  94 (defmacro begin-thread (first . rest)
  95   `(call-with-new-thread
  96     (lambda ()
  97       (begin
  98         ,first ,@rest))
  99     %thread-handler))
 100
 101 (defmacro with-mutex (m . body)
 102   `(dynamic-wind
 103        (lambda () (lock-mutex ,m))
 104        (lambda () (begin ,@body))
 105        (lambda () (unlock-mutex ,m))))
 106
 107 (defmacro monitor (first . rest)
 108   `(with-mutex ,(make-mutex)
 109      (begin
 110        ,first ,@rest)))
 111
 112 ;; export
 113
 114 (export %thread-handler)
 115
 116 (export-syntax make-thread
 117                begin-thread
 118                with-mutex
 119                monitor)
 120
 121 ;;; threads.scm ends here