mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-23 04:52:42 -08:00
Code Issues Projects Releases Packages Wiki Activity

Simplify mp lambda lists

Browse source 
Remove redundant keyword-name specification from make-locks recursive
and remove dummy &key from barrier-wait (potentially not backward
compatible with C code).
This commit is contained in:
Daniel Kochmański 2016-11-17 22:47:47 +01:00
parent 085fee3d3b
commit c1f485cc31
5 changed files with 34 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/symbols_list.h
View file

@ -1603,7 +1603,7 @@ cl_symbols[] = {
{MP_ "BARRIER", MP_ORDINARY, NULL, -1, OBJNULL},
{MP_ "MAKE-BARRIER", MP_ORDINARY, IF_MP(mp_make_barrier), -1, OBJNULL},
{MP_ "BARRIER-UNBLOCK", MP_ORDINARY, IF_MP(mp_barrier_unblock), -1, OBJNULL},
{MP_ "BARRIER-WAIT", MP_ORDINARY, IF_MP(mp_barrier_wait), -1, OBJNULL},
{MP_ "BARRIER-WAIT", MP_ORDINARY, IF_MP(mp_barrier_wait), 1, OBJNULL},
{MP_ "BARRIER-COUNT", MP_ORDINARY, IF_MP(mp_barrier_count), 1, OBJNULL},
{MP_ "BARRIER-NAME", MP_ORDINARY, IF_MP(mp_barrier_name), 1, OBJNULL},
{MP_ "BARRIER-ARRIVERS-COUNT", MP_ORDINARY, IF_MP(mp_barrier_arrivers_count), 1, OBJNULL},

58
src/c/threads/barrier.d
View file

@ -131,34 +131,36 @@ decrement_counter(cl_fixnum *counter)
} while (1);
}
@(defun mp::barrier-wait (barrier &key)
cl_object
mp_barrier_wait(cl_object barrier)
{
cl_object output;
cl_fixnum counter;
@ {
cl_object own_process = the_env->own_process;
cl_env_ptr the_env = ecl_process_env();
cl_object own_process = the_env->own_process;
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
}
ecl_disable_interrupts_env(the_env);
counter = decrement_counter(&barrier->barrier.arrivers_count);
if (counter == 0) {
print_lock("barrier %p saturated", barrier, barrier);
/* There are (count-1) threads in the queue and we
* are the last one. We thus unblock all threads and
* proceed. */
mp_barrier_unblock(1, barrier);
ecl_enable_interrupts_env(the_env);
output = @':unblocked';
} else if (counter > 0) {
print_lock("barrier %p waiting", barrier, barrier);
ecl_enable_interrupts_env(the_env);
ecl_wait_on(the_env, barrier_wait_condition, barrier);
output = ECL_T;
} else {
print_lock("barrier %p pass-through", barrier, barrier);
/* Barrier disabled */
output = ECL_NIL;
}
@(return output);
} @)
unlikely_if (ecl_t_of(barrier) != t_barrier) {
FEerror_not_a_barrier(barrier);
}
ecl_disable_interrupts_env(the_env);
counter = decrement_counter(&barrier->barrier.arrivers_count);
if (counter == 0) {
print_lock("barrier %p saturated", barrier, barrier);
/* There are (count-1) threads in the queue and we
* are the last one. We thus unblock all threads and
* proceed. */
mp_barrier_unblock(1, barrier);
ecl_enable_interrupts_env(the_env);
output = @':unblocked';
} else if (counter > 0) {
print_lock("barrier %p waiting", barrier, barrier);
ecl_enable_interrupts_env(the_env);
ecl_wait_on(the_env, barrier_wait_condition, barrier);
output = ECL_T;
} else {
print_lock("barrier %p pass-through", barrier, barrier);
/* Barrier disabled */
output = ECL_NIL;
}
return output;
}

2
src/c/threads/mutex.d
View file

@ -53,7 +53,7 @@ ecl_make_lock(cl_object name, bool recursive)
return output;
}
@(defun mp::make-lock (&key name ((:recursive recursive) ECL_NIL))
@(defun mp::make-lock (&key name (recursive ECL_NIL))
@
@(return ecl_make_lock(name, !Null(recursive)));
@)

2
src/c/threads/process.d
View file

@ -628,7 +628,7 @@ mp_process_join(cl_object process)
if (process->process.phase) {
/* We try to acquire a lock that is only owned by the process
* while it is active. */
mp_barrier_wait(1, process->process.exit_barrier);
mp_barrier_wait(process->process.exit_barrier);
}
return cl_values_list(process->process.exit_values);
}

2
src/h/external.h
View file

@ -1749,7 +1749,7 @@ extern ECL_API cl_object mp_make_barrier _ECL_ARGS((cl_narg, cl_object, ...));
extern ECL_API cl_object mp_barrier_count(cl_object);
extern ECL_API cl_object mp_barrier_name(cl_object);
extern ECL_API cl_object mp_barrier_arrivers_count(cl_object);
extern ECL_API cl_object mp_barrier_wait _ECL_ARGS((cl_narg, cl_object, ...));
extern ECL_API cl_object mp_barrier_wait (cl_object);
extern ECL_API cl_object mp_barrier_unblock _ECL_ARGS((cl_narg, cl_object, ...));
/* threads/mailbox.d */