+2008-03-24 Neil Jerram <neil@ossau.uklinux.net>
+
+ Applying patch from Julian Graham, containing minor fixes to his
+ thread enhancements:
+
+ * threads.c (to_timespec): Change 1000000 multiplier to
+ 1000000000.
+ (unchecked_unlock_sym, allow_external_unlock_sym,
+ recursive_sym): Use SCM_SYMBOL.
+ (scm_make_mutex_with_flags): When raising unsupported option
+ error, report what the unsupported option was.
+ (fat_mutex_unlock): When raising errors, unlock m->lock first.
+ (fat_cond_timedwait): Removed.
+ (scm_timed_wait_condition_variable): Call fat_mutex_unlock
+ directly instead of via fat_cond_timedwait.
+
2008-03-10 Ludovic Courtès <ludo@gnu.org>
* eval.c, filesys.c: Enclose `alloca' blob in `#ifndef alloca',
double sec = scm_c_truncate (time);
waittime->tv_sec = (long) sec;
- waittime->tv_nsec = (long) ((time - sec) * 1000000);
+ waittime->tv_nsec = (long) ((time - sec) * 1000000000);
}
}
return scm_make_mutex_with_flags (SCM_EOL);
}
-static SCM unchecked_unlock_sym;
-static SCM allow_external_unlock_sym;
-static SCM recursive_sym;
+SCM_SYMBOL (unchecked_unlock_sym, "unchecked-unlock");
+SCM_SYMBOL (allow_external_unlock_sym, "allow-external-unlock");
+SCM_SYMBOL (recursive_sym, "recursive");
SCM_DEFINE (scm_make_mutex_with_flags, "make-mutex", 0, 0, 1,
(SCM flags),
else if (scm_is_eq (flag, recursive_sym))
recursive = 1;
else
- SCM_MISC_ERROR ("unsupported mutex option", SCM_EOL);
+ SCM_MISC_ERROR ("unsupported mutex option: ~a", scm_list_1 (flag));
ptr = SCM_CDR (ptr);
}
return make_fat_mutex (recursive, unchecked_unlock, external_unlock);
if (scm_is_false (m->owner))
{
if (!m->unchecked_unlock)
- scm_misc_error (NULL, "mutex not locked", SCM_EOL);
+ {
+ scm_i_pthread_mutex_unlock (&m->lock);
+ 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);
+ {
+ scm_i_pthread_mutex_unlock (&m->lock);
+ scm_misc_error (NULL, "mutex not locked by current thread", SCM_EOL);
+ }
}
if (! (SCM_UNBNDP (cond)))
}
#undef FUNC_NAME
-static int
-fat_cond_timedwait (SCM cond, SCM mutex,
- const scm_t_timespec *waittime)
-{
- return fat_mutex_unlock (mutex, cond, waittime, 1);
-}
-
SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1, 0,
(SCM cv, SCM mx, SCM t),
"Wait until @var{cond-var} has been signalled. While waiting, "
waitptr = &waittime;
}
- return fat_cond_timedwait (cv, mx, waitptr) ? SCM_BOOL_T : SCM_BOOL_F;
+ return fat_mutex_unlock (mx, cv, waitptr, 1) ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME
scm_set_smob_print (scm_tc16_mutex, fat_mutex_print);
scm_set_smob_free (scm_tc16_mutex, fat_mutex_free);
- unchecked_unlock_sym =
- scm_permanent_object (scm_from_locale_symbol ("unchecked-unlock"));
- allow_external_unlock_sym =
- scm_permanent_object (scm_from_locale_symbol ("allow-external-unlock"));
- recursive_sym = scm_permanent_object (scm_from_locale_symbol ("recursive"));
-
scm_tc16_condvar = scm_make_smob_type ("condition-variable",
sizeof (fat_cond));
scm_set_smob_mark (scm_tc16_condvar, fat_cond_mark);