From 1ab1008f2038c5c0c66666d4dc98afb9bfb846ea Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Mon, 7 May 2012 08:19:37 +0900
Subject: [PATCH] atomically for non-threaded builds is just a begin

---
 lib/chibi/ast.c   |  4 ++++
 lib/chibi/ast.scm | 19 ++++++++++++-------
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c
index 6497c1db..a3520681 100644
--- a/lib/chibi/ast.c
+++ b/lib/chibi/ast.c
@@ -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);
diff --git a/lib/chibi/ast.scm b/lib/chibi/ast.scm
index 4fc58791..ce0fdb37 100644
--- a/lib/chibi/ast.scm
+++ b/lib/chibi/ast.scm
@@ -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))))))