/* Copyright (C) 1995,1996, 1997, 2000, 2001, 2004 Free Software Foundation, Inc. * * This library 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 2.1 of the License, or (at your option) any later version. * * This library 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 this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include "libguile/_scm.h" #include "libguile/ports.h" #include "libguile/smob.h" #include "libguile/validate.h" #include "libguile/arbiters.h" /* ENHANCE-ME: If the cpu has an atomic test-and-set instruction it could be used instead of a mutex in try-arbiter and release-arbiter. For the i386 family, cmpxchg would suit but it's only available on 80486 and higher so that would have to be checked, perhaps at run-time when setting up the definitions of the scheme procedures, or at compile time if we interpret a host cpu type like "i686" to mean not less than that chip. */ static scm_t_bits scm_tc16_arbiter; #define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16)) #define SCM_LOCK_ARB(arb) (SCM_SET_CELL_WORD_0 ((arb), scm_tc16_arbiter | (1L << 16))); #define SCM_UNLOCK_ARB(arb) (SCM_SET_CELL_WORD_0 ((arb), scm_tc16_arbiter)); static int arbiter_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#', port); return !0; } SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0, (SCM name), "Return an arbiter object, initially unlocked. Currently\n" "@var{name} is only used for diagnostic output.") #define FUNC_NAME s_scm_make_arbiter { SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name)); } #undef FUNC_NAME /* The mutex here is so two threads can't both see the arbiter unlocked and both proceed to lock and return #t. The arbiter itself wouldn't be corrupted by this, but two threads both getting #t would be entirely contrary to the intended semantics. */ SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0, (SCM arb), "If @var{arb} is unlocked, then lock it and return @code{#t}.\n" "If @var{arb} is already locked, then do nothing and return\n" "@code{#f}.") #define FUNC_NAME s_scm_try_arbiter { SCM_VALIDATE_SMOB (1, arb, arbiter); scm_mutex_lock (&scm_i_misc_mutex); if (SCM_ARB_LOCKED(arb)) arb = SCM_BOOL_F; else { SCM_LOCK_ARB(arb); arb = SCM_BOOL_T; } scm_mutex_unlock (&scm_i_misc_mutex); return arb; } #undef FUNC_NAME /* The mutex here is so two threads can't both see the arbiter locked and both proceed to unlock and return #t. The arbiter itself wouldn't be corrupted by this, but we don't want two threads both thinking they were the unlocker. The intended usage is for the code which locked to be responsible for unlocking, but we guarantee the return value even if multiple threads compete. */ SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0, (SCM arb), "If @var{arb} is locked, then unlock it and return @code{#t}.\n" "If @var{arb} is already unlocked, then do nothing and return\n" "@code{#f}.\n" "\n" "Typical usage is for the thread which locked an arbiter to\n" "later release it, but that's not required, any thread can\n" "release it.") #define FUNC_NAME s_scm_release_arbiter { SCM ret; SCM_VALIDATE_SMOB (1, arb, arbiter); scm_mutex_lock (&scm_i_misc_mutex); if (!SCM_ARB_LOCKED(arb)) ret = SCM_BOOL_F; else { SCM_UNLOCK_ARB (arb); ret = SCM_BOOL_T; } scm_mutex_unlock (&scm_i_misc_mutex); return ret; } #undef FUNC_NAME void scm_init_arbiters () { scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0); scm_set_smob_mark (scm_tc16_arbiter, scm_markcdr); scm_set_smob_print (scm_tc16_arbiter, arbiter_print); #include "libguile/arbiters.x" } /* Local Variables: c-file-style: "gnu" End: */