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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
/* Copyright 2016,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
Guile 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.
Guile 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 Guile. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "atomics-internal.h"
#include "boolean.h"
#include "extensions.h"
#include "gsubr.h"
#include "ports.h"
#include "version.h"
#include "atomic.h"
SCM_DEFINE (scm_make_atomic_box, "make-atomic-box", 1, 0, 0,
(SCM init),
"Return an atomic box initialized to value @var{init}.")
#define FUNC_NAME s_scm_make_atomic_box
{
SCM ret = scm_cell (scm_tc7_atomic_box, SCM_UNPACK (SCM_UNDEFINED));
scm_atomic_box_set_x (ret, init);
return ret;
}
#undef FUNC_NAME
SCM_DEFINE (scm_atomic_box_p, "atomic-box?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is an atomic-box object, else\n"
"return @code{#f}.")
#define FUNC_NAME s_scm_atomic_box_p
{
return scm_from_bool (scm_is_atomic_box (obj));
}
#undef FUNC_NAME
SCM_DEFINE (scm_atomic_box_ref, "atomic-box-ref", 1, 0, 0,
(SCM box),
"Fetch the value stored in the atomic box @var{box} and\n"
"return it.")
#define FUNC_NAME s_scm_atomic_box_ref
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
return scm_atomic_ref_scm (scm_atomic_box_loc (box));
}
#undef FUNC_NAME
SCM_DEFINE (scm_atomic_box_set_x, "atomic-box-set!", 2, 0, 0,
(SCM box, SCM val),
"Store @var{val} into the atomic box @var{box}.")
#define FUNC_NAME s_scm_atomic_box_set_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
scm_atomic_set_scm (scm_atomic_box_loc (box), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_atomic_box_swap_x, "atomic-box-swap!", 2, 0, 0,
(SCM box, SCM val),
"Store @var{val} into the atomic box @var{box},\n"
"and return the value that was previously stored in\n"
"the box.")
#define FUNC_NAME s_scm_atomic_box_swap_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
return scm_atomic_swap_scm (scm_atomic_box_loc (box), val);
}
#undef FUNC_NAME
SCM_DEFINE (scm_atomic_box_compare_and_swap_x,
"atomic-box-compare-and-swap!", 3, 0, 0,
(SCM box, SCM expected, SCM desired),
"If the value of the atomic box @var{box} is the same as,\n"
"@var{expected} (in the sense of @code{eq?}), replace the\n"
"contents of the box with @var{desired}. Otherwise does not\n"
"update the box. Returns the previous value of the box in\n"
"either case, so you can know if the swap worked by checking\n"
"if the return value is @code{eq?} to @var{expected}.")
#define FUNC_NAME s_scm_atomic_box_compare_and_swap_x
{
SCM_VALIDATE_ATOMIC_BOX (1, box);
return scm_atomic_compare_and_swap_scm (scm_atomic_box_loc (box),
expected, desired);
}
#undef FUNC_NAME
void
scm_i_atomic_box_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<atomic-box ", port);
scm_uintprint (SCM_UNPACK (exp), 16, port);
scm_puts (" value: ", port);
scm_iprin1 (scm_atomic_box_ref (exp), port, pstate);
scm_putc ('>', port);
}
static void
scm_init_atomic (void)
{
#include "atomic.x"
}
void
scm_register_atomic (void)
{
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_atomic",
(scm_t_extension_init_func) scm_init_atomic,
NULL);
}
|
