-
Notifications
You must be signed in to change notification settings - Fork 32
/
counter.scm
48 lines (40 loc) · 1.7 KB
/
counter.scm
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
;; Counters
;;;; Copyright (C) 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;;;
;;;; 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 program. If not, see <http://www.gnu.org/licenses/>.
;;; General atomic counters; currently used for garbage collection.
(define-module (fibers counter)
#:use-module (ice-9 atomic)
#:export (make-counter
counter-decrement!
counter-reset!))
;;; Counter utilities
;;;
;;; Counters here are an atomic box containing an integer which are
;;; either decremented or reset.
;; How many times we run the block-fn until we gc
(define %countdown-steps 42) ; haven't tried testing for the most efficient number
(define* (make-counter)
(make-atomic-box %countdown-steps))
(define (counter-decrement! counter)
"Decrement integer in atomic box COUNTER."
(let spin ((x (atomic-box-ref counter)))
(let* ((x-new (1- x))
(x* (atomic-box-compare-and-swap! counter x x-new)))
(if (= x* x) ; successful decrement
x-new
(spin x*)))))
(define (counter-reset! counter)
"Reset a counter's contents."
(atomic-box-set! counter %countdown-steps))