Re: srfi-18 requirements

[Neil Jerram]

"Julian Graham" <address@hidden> writes:

> Find attached the latest revision of the core changes for SRFI-18
> support.  Key changes between this revision and the last are:
>
> * scm_to_timespec -> to_timespec
> * "Timeout values" for timed joins
> * The extension of make-mutex and addition of make_mutex_with_flags to
> support additional configuration options that persist for the lifetime
> of a mutex (unchecked unlocking and external unlocking)
> * fat_mutex_unlock now takes a condition variable and a timeout to
> support SRFI-18's condition-signal unlock semantics; mutex unlocking
> and condition variable waiting are reimplemented in terms of
> fat_mutex_unlock; unnecessary relocking / unlocking is no longer
> performed
> * The threads tests and scheduling documentation have been updated to
> reflect the above.
>
> Let me know what you think!

It looks great.  I still have a few minor queries, but it's close
enough now that I've committed this latest patch to CVS; it'll be much
more convenient to work on the few remaining queries incrementally,
rather than with respect to threads.c as it was prior to all these
changes.

> address@hidden {Scheme Procedure} make-mutex
> address@hidden {Scheme Procedure} make-mutex . flags
>  @deffnx {C Function} scm_make_mutex ()
> -Return a new standard mutex.  It is initially unlocked.
> address@hidden {C Function} scm_make_mutex_with_flags (SCM flag)

flag -> flags here?

> +static void
> +to_timespec (SCM t, scm_t_timespec *waittime)
> +{
> +  if (scm_is_pair (t))
> +    {
> +      waittime->tv_sec = scm_to_ulong (SCM_CAR (t));
> +      waittime->tv_nsec = scm_to_ulong (SCM_CDR (t)) * 1000;
> +    }
> +  else
> +    {
> +      double time = scm_to_double (t);
> +      double sec = scm_c_truncate (time);
> +
> +      waittime->tv_sec = (long) sec;
> +      waittime->tv_nsec = (long) ((time - sec) * 1000000);

1000000 -> 1000000000 ?

> +static SCM unchecked_unlock_sym;
> +static SCM allow_external_unlock_sym;
> +static SCM recursive_sym;

Use SCM_SYMBOL here?  As the init code stands, this means that the
symbols will end up being created in scm_init_thread_procs(), but I
think that will be fine, as the symbols are only useful in procedure
calls.

> +
> +SCM_DEFINE (scm_make_mutex_with_flags, "make-mutex", 0, 0, 1,
> +         (SCM flags),
>           "Create a new mutex. ")
> -#define FUNC_NAME s_scm_make_mutex
> +#define FUNC_NAME s_scm_make_mutex_with_flags
>  {
> -  return make_fat_mutex (0);
> +  int unchecked_unlock = 0, external_unlock = 0, recursive = 0;
> +
> +  SCM ptr = flags;
> +  while (! scm_is_null (ptr))
> +    {
> +      SCM flag = SCM_CAR (ptr);
> +      if (scm_is_eq (flag, unchecked_unlock_sym))
> +     unchecked_unlock = 1;
> +      else if (scm_is_eq (flag, allow_external_unlock_sym))
> +     external_unlock = 1;
> +      else if (scm_is_eq (flag, recursive_sym))
> +     recursive = 1;
> +      else 
> +     SCM_MISC_ERROR ("unsupported mutex option", SCM_EOL);

Perhaps we can generate a more explicit error here, indicating the
actual problem value?  See other calls to scm_misc_error() where the
3rd parameter is not SCM_EOL.

> +static int
> +fat_mutex_unlock (SCM mutex, SCM cond,
> +               const scm_t_timespec *waittime, int relock)
>  {
> -  char *msg = NULL;
> +  fat_mutex *m = SCM_MUTEX_DATA (mutex);
> +  fat_cond *c = NULL;
> +  scm_i_thread *t = SCM_I_CURRENT_THREAD;
> +  int err = 0, ret = 0;
>  
>    scm_i_scm_pthread_mutex_lock (&m->lock);
>    if (!scm_is_eq (m->owner, scm_current_thread ()))
>      {
>        if (scm_is_false (m->owner))
> -     msg = "mutex not locked";
> -      else
> -     msg = "mutex not locked by current thread";
> +     {
> +       if (!m->unchecked_unlock)
> +         scm_misc_error (NULL, "mutex not locked", SCM_EOL);
> +     }
> +      else if (!m->allow_external_unlock)
> +     scm_misc_error (NULL, "mutex not locked by current thread", SCM_EOL);
> +    }

Need to unlock m->lock before raising the error?

>  SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 
> 1, 0,
> @@ -1393,20 +1590,11 @@
>    
>    if (!SCM_UNBNDP (t))
>      {
> -      if (scm_is_pair (t))
> -     {
> -       waittime.tv_sec = scm_to_ulong (SCM_CAR (t));
> -       waittime.tv_nsec = scm_to_ulong (SCM_CAR (t)) * 1000;
> -     }
> -      else
> -     {
> -       waittime.tv_sec = scm_to_ulong (t);
> -       waittime.tv_nsec = 0;
> -     }
> +      to_timespec (t, &waittime);
>        waitptr = &waittime;
>      }
>  
> -  return scm_from_bool (fat_cond_timedwait (cv, mx, waitptr));
> +  return fat_cond_timedwait (cv, mx, waitptr) ? SCM_BOOL_T : SCM_BOOL_F;

Better to eliminate fat_cond_timedwait completely now, I think.
(i.e. Just rewrite the last line as a fat_mutex_unlock() call.)

Finally, please note that we will need a NEWS entry for this work.
Are you happy to write that too?  (You may of course prefer to defer
this until the SRFI-18 Scheme parts are committed too - that's
absolutely fine.)

Regards,
      Neil