Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-16 01:17:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

SRFI-18 can now build without error for threadless builds, as an empty library.

Browse source 
Actually importing it in this case reports an error.
This commit is contained in:
Alex Shinn 2013-02-27 20:58:44 +09:00
parent 6af5f46721
commit e281854483
2 changed files with 19 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/srfi/18.sld
View file

@ -15,8 +15,12 @@
join-timeout-exception? abandoned-mutex-exception? join-timeout-exception? abandoned-mutex-exception?
terminated-thread-exception? uncaught-exception? terminated-thread-exception? uncaught-exception?
uncaught-exception-reason) uncaught-exception-reason)
(import (chibi) (srfi 9) (chibi ast) (cond-expand
(except (chibi time) time->seconds seconds->time)) (threads
(include "18/types.scm") (import (chibi) (srfi 9) (chibi ast)
(include-shared "18/threads") (except (chibi time) time->seconds seconds->time))
(include "18/interface.scm")) (include "18/types.scm")
(include-shared "18/threads")
(include "18/interface.scm"))
(else
(error "chibi was not compiled with threading support"))))

10
lib/srfi/18/threads.c
View file

@ -37,6 +37,8 @@ struct sexp_pollfds_t {
/**************************** threads *************************************/ /**************************** threads *************************************/
#if SEXP_USE_GREEN_THREADS
static void sexp_define_type_predicate_by_tag (sexp ctx, sexp env, char *cname, sexp_uint_t type) { static void sexp_define_type_predicate_by_tag (sexp ctx, sexp env, char *cname, sexp_uint_t type) {
sexp_gc_var2(name, op); sexp_gc_var2(name, op);
sexp_gc_preserve2(ctx, name, op); sexp_gc_preserve2(ctx, name, op);
@ -617,12 +619,17 @@ sexp sexp_lookup_named_type (sexp ctx, sexp env, const char *name) {
return sexp_make_fixnum((sexp_typep(t)) ? sexp_type_tag(t) : -1); return sexp_make_fixnum((sexp_typep(t)) ? sexp_type_tag(t) : -1);
} }
#endif /* SEXP_USE_GREEN_THREADS */
sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, sexp_abi_identifier_t abi) { sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, sexp_abi_identifier_t abi) {
sexp t; sexp t;
sexp_gc_var1(name); sexp_gc_var1(name);
if (!(sexp_version_compatible(ctx, version, sexp_version) if (!(sexp_version_compatible(ctx, version, sexp_version)
&& sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER))) && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))
return SEXP_ABI_ERROR; return SEXP_ABI_ERROR;
#if SEXP_USE_GREEN_THREADS
sexp_gc_preserve1(ctx, name); sexp_gc_preserve1(ctx, name);
sexp_global(ctx, SEXP_G_THREADS_MUTEX_ID) = sexp_lookup_named_type(ctx, env, "Mutex"); sexp_global(ctx, SEXP_G_THREADS_MUTEX_ID) = sexp_lookup_named_type(ctx, env, "Mutex");
@ -667,5 +674,8 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env; sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = env;
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
#endif /* SEXP_USE_GREEN_THREADS */
return SEXP_VOID; return SEXP_VOID;
} }