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