mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-15 01:10:53 -07:00
Code Issues Projects Releases Packages Wiki Activity

Added two new functions mp:lock-mine-p and mp:lock-count-mine which are used to implement mp:with-lock

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-09-23 22:25:57 +02:00
parent 9c416fbaa1
commit cc052cb792
5 changed files with 27 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/symbols_list.h
View file

@ -1498,6 +1498,8 @@ cl_symbols[] = {
{MP_ "LOCK-NAME", MP_ORDINARY, mp_lock_name, 1, OBJNULL},
{MP_ "LOCK-HOLDER", MP_ORDINARY, mp_lock_holder, 1, OBJNULL},
{MP_ "LOCK-COUNT", MP_ORDINARY, mp_lock_count, 1, OBJNULL},
{MP_ "LOCK-MINE-P", MP_ORDINARY, mp_lock_mine_p, 1, OBJNULL},
{MP_ "LOCK-COUNT-MINE", MP_ORDINARY, mp_lock_count_mine, 1, OBJNULL},
{MP_ "GET-LOCK", MP_ORDINARY, mp_get_lock, -1, OBJNULL},
{MP_ "GIVEUP-LOCK", MP_ORDINARY, mp_giveup_lock, 1, OBJNULL},
{MP_ "MAKE-CONDITION-VARIABLE", MP_ORDINARY, mp_make_condition_variable, 0, OBJNULL},

2
src/c/symbols_list2.h
View file

@ -1498,6 +1498,8 @@ cl_symbols[] = {
{MP_ "LOCK-NAME","mp_lock_name"},
{MP_ "LOCK-HOLDER","mp_lock_holder"},
{MP_ "LOCK-COUNT","mp_lock_count"},
{MP_ "LOCK-MINE-P","mp_lock_mine_p"},
{MP_ "LOCK-COUNT-MINE","mp_lock_count_mine"},
{MP_ "GET-LOCK","mp_get_lock"},
{MP_ "GIVEUP-LOCK","mp_giveup_lock"},
{MP_ "MAKE-CONDITION-VARIABLE","mp_make_condition_variable"},

18
src/c/threads.d
View file

@ -579,6 +579,14 @@ mp_lock_holder(cl_object lock)
@(return lock->lock.holder)
}
cl_object
mp_lock_mine_p(cl_object lock)
{
if (type_of(lock) != t_lock)
FEwrong_type_argument(@'mp::lock', lock);
@(return ((lock->lock.holder == mp_current_process())? Ct : Cnil))
}
cl_object
mp_lock_count(cl_object lock)
{
@ -587,6 +595,16 @@ mp_lock_count(cl_object lock)
@(return MAKE_FIXNUM(lock->lock.counter))
}
cl_object
mp_lock_count_mine(cl_object lock)
{
if (type_of(lock) != t_lock)
FEwrong_type_argument(@'mp::lock', lock);
@(return ((lock->lock.holder == mp_current_process())?
MAKE_FIXNUM(lock->lock.counter) :
MAKE_FIXNUM(0)))
}
cl_object
mp_giveup_lock(cl_object lock)
{

2
src/h/external.h
View file

@ -1610,7 +1610,9 @@ extern ECL_API cl_object mp_make_lock _ARGS((cl_narg narg, ...));
extern ECL_API cl_object mp_recursive_lock_p(cl_object lock);
extern ECL_API cl_object mp_lock_name(cl_object lock);
extern ECL_API cl_object mp_lock_holder(cl_object lock);
extern ECL_API cl_object mp_lock_mine_p(cl_object lock);
extern ECL_API cl_object mp_lock_count(cl_object lock);
extern ECL_API cl_object mp_lock_count_mine(cl_object lock);
extern ECL_API cl_object mp_get_lock _ARGS((cl_narg narg, cl_object lock, ...));
extern ECL_API cl_object mp_giveup_lock(cl_object lock);
extern ECL_API cl_object mp_make_condition_variable(void);

8
src/lsp/mp.lsp
View file

@ -117,15 +117,13 @@ by ALLOW-WITH-INTERRUPTS."
;; the get-lock statement, to ensure that the unlocking is done with
;; interrupts disabled.
#+threads
(ext:with-unique-names (lock my-lock count interrupts)
(ext:with-unique-names (lock count interrupts)
`(let* ((,lock ,lock-form)
(,my-lock (eq (mp:lock-holder ,lock) mp:*current-process*))
(,count (mp:lock-count ,lock)))
(,count (mp:lock-count-mine ,lock)))
(without-interrupts
(unwind-protect
(with-restored-interrupts
(mp::get-lock ,lock)
(locally ,@body))
(when (and (eq (mp:lock-holder ,lock) mp:*current-process*)
(or (not ,my-lock) (> (mp:lock-count ,lock) ,count)))
(when (> (mp:lock-count-mine ,lock) ,count)
(mp::giveup-lock ,lock)))))))