Commit | Line | Data |
---|---|---|
58ade102 | 1 | /* Copyright (C) 1995,1996, 1997, 2000, 2001 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 | |
15 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
16 | */ | |
1bbd0b84 | 17 | |
1bbd0b84 | 18 | |
0f2d19dd JB |
19 | \f |
20 | ||
a0599745 MD |
21 | #include "libguile/_scm.h" |
22 | #include "libguile/ports.h" | |
23 | #include "libguile/smob.h" | |
20e6290e | 24 | |
a0599745 MD |
25 | #include "libguile/validate.h" |
26 | #include "libguile/arbiters.h" | |
0f2d19dd JB |
27 | |
28 | \f | |
29 | /* {Arbiters} | |
30 | * | |
31 | * These procedures implement synchronization primitives. Processors | |
32 | * with an atomic test-and-set instruction can use it here (and not | |
33 | * SCM_DEFER_INTS). | |
34 | */ | |
35 | ||
92c2555f | 36 | static scm_t_bits scm_tc16_arbiter; |
0f2d19dd | 37 | |
1cc91f1b | 38 | |
843524cc DH |
39 | #define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) |
40 | #define SCM_LOCK_ARB(arb) (SCM_SET_CELL_WORD_0 ((arb), scm_tc16_arbiter | (1L << 16))); | |
41 | #define SCM_UNLOCK_ARB(arb) (SCM_SET_CELL_WORD_0 ((arb), scm_tc16_arbiter)); | |
c209c88e | 42 | |
0f2d19dd | 43 | static int |
e841c3e0 | 44 | arbiter_print (SCM exp, SCM port, scm_print_state *pstate) |
0f2d19dd | 45 | { |
b7f3516f | 46 | scm_puts ("#<arbiter ", port); |
c209c88e | 47 | if (SCM_ARB_LOCKED (exp)) |
b7f3516f | 48 | scm_puts ("locked ", port); |
cb87e06a | 49 | scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate); |
b7f3516f | 50 | scm_putc ('>', port); |
0f2d19dd JB |
51 | return !0; |
52 | } | |
53 | ||
3b3b36dd | 54 | SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, |
cb87e06a MG |
55 | (SCM name), |
56 | "Return an object of type arbiter and name @var{name}. Its\n" | |
57 | "state is initially unlocked. Arbiters are a way to achieve\n" | |
58 | "process synchronization.") | |
1bbd0b84 | 59 | #define FUNC_NAME s_scm_make_arbiter |
0f2d19dd | 60 | { |
843524cc | 61 | SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); |
0f2d19dd | 62 | } |
1bbd0b84 | 63 | #undef FUNC_NAME |
0f2d19dd | 64 | |
3b3b36dd | 65 | SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, |
cb87e06a MG |
66 | (SCM arb), |
67 | "Return @code{#t} and lock the arbiter @var{arb} if the arbiter\n" | |
68 | "was unlocked. Otherwise, return @code{#f}.") | |
1bbd0b84 | 69 | #define FUNC_NAME s_scm_try_arbiter |
0f2d19dd | 70 | { |
cb87e06a | 71 | SCM_VALIDATE_SMOB (1, arb, arbiter); |
0f2d19dd | 72 | SCM_DEFER_INTS; |
c209c88e | 73 | if (SCM_ARB_LOCKED(arb)) |
0f2d19dd JB |
74 | arb = SCM_BOOL_F; |
75 | else | |
76 | { | |
c209c88e | 77 | SCM_LOCK_ARB(arb); |
0f2d19dd JB |
78 | arb = SCM_BOOL_T; |
79 | } | |
80 | SCM_ALLOW_INTS; | |
81 | return arb; | |
82 | } | |
1bbd0b84 | 83 | #undef FUNC_NAME |
0f2d19dd JB |
84 | |
85 | ||
3b3b36dd | 86 | SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, |
cb87e06a MG |
87 | (SCM arb), |
88 | "Return @code{#t} and unlock the arbiter @var{arb} if the\n" | |
89 | "arbiter was locked. Otherwise, return @code{#f}.") | |
1bbd0b84 | 90 | #define FUNC_NAME s_scm_release_arbiter |
0f2d19dd | 91 | { |
cb87e06a MG |
92 | SCM_VALIDATE_SMOB (1, arb, arbiter); |
93 | if (!SCM_ARB_LOCKED(arb)) | |
0f2d19dd | 94 | return SCM_BOOL_F; |
c209c88e | 95 | SCM_UNLOCK_ARB (arb); |
0f2d19dd JB |
96 | return SCM_BOOL_T; |
97 | } | |
1bbd0b84 | 98 | #undef FUNC_NAME |
0f2d19dd JB |
99 | |
100 | ||
1cc91f1b | 101 | |
0f2d19dd JB |
102 | void |
103 | scm_init_arbiters () | |
0f2d19dd | 104 | { |
e841c3e0 KN |
105 | scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); |
106 | scm_set_smob_mark (scm_tc16_arbiter, scm_markcdr); | |
107 | scm_set_smob_print (scm_tc16_arbiter, arbiter_print); | |
a0599745 | 108 | #include "libguile/arbiters.x" |
0f2d19dd | 109 | } |
89e00824 ML |
110 | |
111 | /* | |
112 | Local Variables: | |
113 | c-file-style: "gnu" | |
114 | End: | |
115 | */ |