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

atomically for non-threaded builds is just a begin

Browse source
This commit is contained in:
Alex Shinn 2012-05-07 08:19:37 +09:00
parent be7a80007b
commit 1ab1008f20
2 changed files with 16 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lib/chibi/ast.c
View file

@ -334,11 +334,13 @@ static sexp sexp_gc_op (sexp ctx, sexp self, sexp_sint_t n) {
return sexp_make_unsigned_integer(ctx, sum_freed);
}
#ifdef SEXP_USE_GREEN_THREADS
static sexp sexp_set_atomic (sexp ctx, sexp self, sexp_sint_t n, sexp new) {
sexp res = sexp_global(ctx, SEXP_G_ATOMIC_P);
sexp_global(ctx, SEXP_G_ATOMIC_P) = new;
return res;
}
#endif
static sexp sexp_string_contains (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
const char *res;
@ -482,7 +484,9 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
#ifdef SEXP_USE_GREEN_THREADS
sexp_define_foreign(ctx, env, "%set-atomic!", 1, sexp_set_atomic);
#endif
sexp_define_foreign(ctx, env, "string-contains", 2, sexp_string_contains);
sexp_define_foreign_opt(ctx, env, "integer->error-string", 1, sexp_error_string, SEXP_FALSE);
sexp_define_foreign(ctx, env, "update-free-vars!", 1, sexp_update_free_vars);

19
lib/chibi/ast.scm
View file

@ -363,10 +363,15 @@
;;> (e.g. running an infinite loop) can render the system unusable.
;;> Never expose to a sandbox.
(define-syntax atomically
(syntax-rules ()
((atomic . body)
(let* ((atomic? (%set-atomic! #t))
(res (begin . body)))
(%set-atomic! atomic?)
res))))
(cond-expand
(threads
(define-syntax atomically
(syntax-rules ()
((atomically . body)
(let* ((atomic? (%set-atomic! #t))
(res (begin . body)))
(%set-atomic! atomic?)
res)))))
(else
(define-syntax atomically
(syntax-rules () ((atomically . body) (begin . body))))))