Commit | Line | Data |
---|---|---|
0607ebbf | 1 | /* Copyright (C) 1995,1996, 1997, 2000, 2001, 2004, 2005, 2006, 2008, 2011 Free Software Foundation, Inc. |
0f2d19dd | 2 | * |
73be1d9e | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
4 | * modify it under the terms of the GNU Lesser General Public License |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
0f2d19dd | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
0f2d19dd | 12 | * |
73be1d9e MV |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
73be1d9e | 17 | */ |
1bbd0b84 | 18 | |
1bbd0b84 | 19 | |
0f2d19dd | 20 | \f |
dbb605f5 LC |
21 | #ifdef HAVE_CONFIG_H |
22 | # include <config.h> | |
23 | #endif | |
0f2d19dd | 24 | |
a0599745 MD |
25 | #include "libguile/_scm.h" |
26 | #include "libguile/ports.h" | |
27 | #include "libguile/smob.h" | |
20e6290e | 28 | |
a0599745 MD |
29 | #include "libguile/validate.h" |
30 | #include "libguile/arbiters.h" | |
0f2d19dd JB |
31 | |
32 | \f | |
95a58b3c KR |
33 | /* FETCH_STORE sets "fet" to the value fetched from "mem" and then stores |
34 | "sto" there. The fetch and store are done atomically, so once the fetch | |
35 | has been done no other thread or processor can fetch from there before | |
36 | the store is done. | |
37 | ||
38 | The operands are scm_t_bits, fet and sto are plain variables, mem is a | |
39 | memory location (ie. an lvalue). | |
40 | ||
41 | ENHANCE-ME: Add more cpu-specifics. glibc atomicity.h has some of the | |
42 | sort of thing required. FETCH_STORE could become some sort of | |
43 | compare-and-store if that better suited what various cpus do. */ | |
44 | ||
45 | #if defined (__GNUC__) && defined (i386) && SIZEOF_SCM_T_BITS == 4 | |
46 | /* This is for i386 with the normal 32-bit scm_t_bits. The xchg instruction | |
47 | is atomic on a single processor, and it automatically asserts the "lock" | |
48 | bus signal so it's atomic on a multi-processor (no need for the lock | |
49 | prefix on the instruction). | |
50 | ||
51 | The mem operand is read-write but "+" is not used since old gcc | |
52 | (eg. 2.7.2) doesn't support that. "1" for the mem input doesn't work | |
53 | (eg. gcc 3.3) when mem is a pointer dereference like current usage below. | |
54 | Having mem as a plain input should be ok though. It tells gcc the value | |
55 | is live, but as an "m" gcc won't fetch it itself (though that would be | |
56 | harmless). */ | |
57 | ||
58 | #define FETCH_STORE(fet,mem,sto) \ | |
59 | do { \ | |
60 | asm ("xchg %0, %1" \ | |
61 | : "=r" (fet), "=m" (mem) \ | |
62 | : "0" (sto), "m" (mem)); \ | |
63 | } while (0) | |
64 | #endif | |
65 | ||
66 | #ifndef FETCH_STORE | |
67 | /* This is a generic version, with a mutex to ensure the operation is | |
68 | atomic. Unfortunately this approach probably makes arbiters no faster | |
69 | than mutexes (though still using less memory of course), so some | |
70 | CPU-specifics are highly desirable. */ | |
8ff3ca46 KR |
71 | #define FETCH_STORE(fet,mem,sto) \ |
72 | do { \ | |
73 | scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); \ | |
74 | (fet) = (mem); \ | |
75 | (mem) = (sto); \ | |
76 | scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); \ | |
95a58b3c KR |
77 | } while (0) |
78 | #endif | |
9bebea88 | 79 | |
0f2d19dd | 80 | |
92c2555f | 81 | static scm_t_bits scm_tc16_arbiter; |
0f2d19dd | 82 | |
1cc91f1b | 83 | |
95a58b3c KR |
84 | #define SCM_LOCK_VAL (scm_tc16_arbiter | (1L << 16)) |
85 | #define SCM_UNLOCK_VAL scm_tc16_arbiter | |
843524cc | 86 | #define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) |
95a58b3c | 87 | |
c209c88e | 88 | |
0f2d19dd | 89 | static int |
e841c3e0 | 90 | arbiter_print (SCM exp, SCM port, scm_print_state *pstate) |
0f2d19dd | 91 | { |
0607ebbf | 92 | scm_puts_unlocked ("#<arbiter ", port); |
c209c88e | 93 | if (SCM_ARB_LOCKED (exp)) |
0607ebbf | 94 | scm_puts_unlocked ("locked ", port); |
cb87e06a | 95 | scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate); |
0607ebbf | 96 | scm_putc_unlocked ('>', port); |
0f2d19dd JB |
97 | return !0; |
98 | } | |
99 | ||
3b3b36dd | 100 | SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, |
cb87e06a | 101 | (SCM name), |
7305dd20 KR |
102 | "Return an arbiter object, initially unlocked. Currently\n" |
103 | "@var{name} is only used for diagnostic output.") | |
1bbd0b84 | 104 | #define FUNC_NAME s_scm_make_arbiter |
0f2d19dd | 105 | { |
843524cc | 106 | SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); |
0f2d19dd | 107 | } |
1bbd0b84 | 108 | #undef FUNC_NAME |
0f2d19dd | 109 | |
9bebea88 | 110 | |
95a58b3c KR |
111 | /* The atomic FETCH_STORE here is so two threads can't both see the arbiter |
112 | unlocked and return #t. The arbiter itself wouldn't be corrupted by | |
113 | this, but two threads both getting #t would be contrary to the intended | |
114 | semantics. */ | |
9bebea88 | 115 | |
3b3b36dd | 116 | SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, |
cb87e06a | 117 | (SCM arb), |
7305dd20 KR |
118 | "If @var{arb} is unlocked, then lock it and return @code{#t}.\n" |
119 | "If @var{arb} is already locked, then do nothing and return\n" | |
120 | "@code{#f}.") | |
1bbd0b84 | 121 | #define FUNC_NAME s_scm_try_arbiter |
0f2d19dd | 122 | { |
95a58b3c | 123 | scm_t_bits old; |
393301c5 | 124 | scm_t_bits *loc; |
ae0b6bf5 | 125 | SCM_VALIDATE_SMOB (1, arb, arbiter); |
393301c5 AW |
126 | loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); |
127 | FETCH_STORE (old, *loc, SCM_LOCK_VAL); | |
95a58b3c | 128 | return scm_from_bool (old == SCM_UNLOCK_VAL); |
0f2d19dd | 129 | } |
1bbd0b84 | 130 | #undef FUNC_NAME |
0f2d19dd JB |
131 | |
132 | ||
95a58b3c KR |
133 | /* The atomic FETCH_STORE here is so two threads can't both see the arbiter |
134 | locked and return #t. The arbiter itself wouldn't be corrupted by this, | |
135 | but we don't want two threads both thinking they were the unlocker. The | |
136 | intended usage is for the code which locked to be responsible for | |
137 | unlocking, but we guarantee the return value even if multiple threads | |
138 | compete. */ | |
9bebea88 KR |
139 | |
140 | SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, | |
cb87e06a | 141 | (SCM arb), |
7305dd20 KR |
142 | "If @var{arb} is locked, then unlock it and return @code{#t}.\n" |
143 | "If @var{arb} is already unlocked, then do nothing and return\n" | |
144 | "@code{#f}.\n" | |
145 | "\n" | |
146 | "Typical usage is for the thread which locked an arbiter to\n" | |
147 | "later release it, but that's not required, any thread can\n" | |
148 | "release it.") | |
1bbd0b84 | 149 | #define FUNC_NAME s_scm_release_arbiter |
0f2d19dd | 150 | { |
95a58b3c | 151 | scm_t_bits old; |
393301c5 | 152 | scm_t_bits *loc; |
ae0b6bf5 | 153 | SCM_VALIDATE_SMOB (1, arb, arbiter); |
393301c5 AW |
154 | loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0); |
155 | FETCH_STORE (old, *loc, SCM_UNLOCK_VAL); | |
95a58b3c | 156 | return scm_from_bool (old == SCM_LOCK_VAL); |
0f2d19dd | 157 | } |
1bbd0b84 | 158 | #undef FUNC_NAME |
0f2d19dd JB |
159 | |
160 | ||
1cc91f1b | 161 | |
0f2d19dd JB |
162 | void |
163 | scm_init_arbiters () | |
0f2d19dd | 164 | { |
e841c3e0 | 165 | scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); |
e841c3e0 | 166 | scm_set_smob_print (scm_tc16_arbiter, arbiter_print); |
a0599745 | 167 | #include "libguile/arbiters.x" |
0f2d19dd | 168 | } |
89e00824 ML |
169 | |
170 | /* | |
171 | Local Variables: | |
172 | c-file-style: "gnu" | |
173 | End: | |
174 | */ |