mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

Update copyright.

Browse source 
Use `export' and `export-syntax' instead of
`define-public' and `defmacro-public'.

(make-thread): Rename first arg to `proc'; nfc.
(begin-thread, monitor): Rename second arg to `rest'; nfc.
(with-mutex): Rename second arg to `body'; nfc.
This commit is contained in:
Thien-Thi Nguyen 2001-04-06 09:51:25 +00:00
parent b727d0bde1
commit c7a813af89
1 changed files with 47 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

76
ice-9/threads.scm
View file

@ -1,4 +1,4 @@
;;;; Copyright (C) 1996, 1998 Free Software Foundation, Inc.
;;;; Copyright (C) 1996, 1998, 2001 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -19,6 +19,7 @@
;;;; threads.scm -- User-level interface to Guile's thread system
;;;; 4 March 1996, Anthony Green <green@cygnus.com>
;;;; Modified 5 October 1996, MDJ <djurfeldt@nada.kth.se>
;;;; Modified 6 April 2001, ttn
;;;; ----------------------------------------------------------------
;;;;
@ -27,51 +28,62 @@
; --- MACROS -------------------------------------------------------
(define-public (%thread-handler tag . args)
(define (%thread-handler tag . args)
(fluid-set! the-last-stack #f)
(unmask-signals)
(let ((n (length args))
(p (current-error-port)))
(display "In thread:" p)
(newline p)
(if (>= n 3)
(display-error #f
p
(car args)
(cadr args)
(caddr args)
(if (= n 4)
(cadddr args)
'()))
(begin
(display "uncaught throw to " p)
(display tag p)
(display ": " p)
(display args p)
(newline p)))))
(display "In thread:" p)
(newline p)
(if (>= n 3)
(display-error #f
p
(car args)
(cadr args)
(caddr args)
(if (= n 4)
(cadddr args)
'()))
(begin
(display "uncaught throw to " p)
(display tag p)
(display ": " p)
(display args p)
(newline p)))))
(defmacro-public make-thread (fn . args)
; --- MACROS -------------------------------------------------------
(defmacro make-thread (proc . args)
`(call-with-new-thread
(lambda ()
(,fn ,@args))
(,proc ,@args))
%thread-handler))
(defmacro-public begin-thread (first . thunk)
(defmacro begin-thread (first . rest)
`(call-with-new-thread
(lambda ()
(begin
,first ,@thunk))
,first ,@rest))
%thread-handler))
(defmacro-public with-mutex (m . thunk)
(defmacro with-mutex (m . body)
`(dynamic-wind
(lambda () (lock-mutex ,m))
(lambda () (begin ,@thunk))
(lambda () (unlock-mutex ,m))))
(lambda () (lock-mutex ,m))
(lambda () (begin ,@body))
(lambda () (unlock-mutex ,m))))
(defmacro-public monitor (first . thunk)
(defmacro monitor (first . rest)
`(with-mutex ,(make-mutex)
(begin
,first ,@thunk)))
(begin
,first ,@rest)))
;; export
(export %thread-handler)
(export-syntax make-thread
begin-thread
with-mutex
monitor)
;;; threads.scm ends here