blob: ffdb2514856d77295f2cc853bfb658049e730074 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;; Fibers: cooperative, event-driven user-space threads.
;;;; Copyright (C) 2016 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
(define-module (fibers)
#:use-module (fibers epoll)
#:use-module (fibers internal)
#:use-module (fibers repl)
#:use-module (fibers timers)
#:use-module ((ice-9 ports internal)
#:select (port-read-wait-fd port-write-wait-fd))
#:use-module (ice-9 suspendable-ports)
#:export ((get-current-fiber . current-fiber)
run-fibers
spawn-fiber
kill-fiber)
#:re-export (sleep))
;; A thunk and not a parameter to prevent users from using it as a
;; parameter.
(define (get-current-fiber)
"Return the current fiber, or @code{#f} if no fiber is current."
(current-fiber))
(define (wait-for-events port fd events)
(let ((revents (suspend-current-fiber
(lambda (fiber)
(add-fd-events! (fiber-scheduler fiber) fd events fiber)))))
(unless (zero? (logand revents EPOLLERR))
(error "error reading from port" port))))
(define (wait-for-readable port)
(wait-for-events port (port-read-wait-fd port) (logior EPOLLIN EPOLLRDHUP)))
(define (wait-for-writable port)
(wait-for-events port (port-write-wait-fd port) EPOLLOUT))
(define* (run-fibers #:optional (init #f)
#:key (scheduler (make-scheduler))
(install-suspendable-ports? #t)
(keep-scheduler? (eq? scheduler (current-scheduler))))
(when install-suspendable-ports? (install-suspendable-ports!))
(with-scheduler
scheduler
(parameterize ((current-read-waiter wait-for-readable)
(current-write-waiter wait-for-writable))
(let ((ret #f))
(spawn-fiber (lambda ()
(call-with-values (or init values)
(lambda vals (set! ret vals))))
scheduler)
(let lp ()
(run-scheduler scheduler)
(unless ret (lp)))
(unless keep-scheduler? (destroy-scheduler scheduler))
(apply values ret)))))
(define (require-current-scheduler)
(or (current-scheduler)
(error "No scheduler current; call within run-fibers instead")))
(define* (spawn-fiber thunk #:optional (sched (require-current-scheduler)))
(create-fiber sched thunk))
(define (kill-fiber fiber)
(pk 'unimplemented-kill-fiber fiber))
|
