1 /* Copyright (C) 1995,1996, 1997, 2000, 2001 Free Software Foundation, Inc.
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.
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.
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
21 #include "libguile/_scm.h"
22 #include "libguile/ports.h"
23 #include "libguile/smob.h"
25 #include "libguile/validate.h"
26 #include "libguile/arbiters.h"
31 * These procedures implement synchronization primitives. Processors
32 * with an atomic test-and-set instruction can use it here (and not
36 static scm_t_bits scm_tc16_arbiter
;
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));
44 arbiter_print (SCM exp
, SCM port
, scm_print_state
*pstate
)
46 scm_puts ("#<arbiter ", port
);
47 if (SCM_ARB_LOCKED (exp
))
48 scm_puts ("locked ", port
);
49 scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp
)), port
, pstate
);
54 SCM_DEFINE (scm_make_arbiter
, "make-arbiter", 1, 0, 0,
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.")
59 #define FUNC_NAME s_scm_make_arbiter
61 SCM_RETURN_NEWSMOB (scm_tc16_arbiter
, SCM_UNPACK (name
));
65 SCM_DEFINE (scm_try_arbiter
, "try-arbiter", 1, 0, 0,
67 "Return @code{#t} and lock the arbiter @var{arb} if the arbiter\n"
68 "was unlocked. Otherwise, return @code{#f}.")
69 #define FUNC_NAME s_scm_try_arbiter
71 SCM_VALIDATE_SMOB (1, arb
, arbiter
);
73 if (SCM_ARB_LOCKED(arb
))
86 SCM_DEFINE (scm_release_arbiter
, "release-arbiter", 1, 0, 0,
88 "Return @code{#t} and unlock the arbiter @var{arb} if the\n"
89 "arbiter was locked. Otherwise, return @code{#f}.")
90 #define FUNC_NAME s_scm_release_arbiter
92 SCM_VALIDATE_SMOB (1, arb
, arbiter
);
93 if (!SCM_ARB_LOCKED(arb
))
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
);
108 #include "libguile/arbiters.x"