diff --git a/eval.c b/eval.c
index ed4859c3..64a1f85e 100644
--- a/eval.c
+++ b/eval.c
@@ -423,6 +423,7 @@ void sexp_init_eval_context_globals (sexp ctx) {
   sexp_global(ctx, SEXP_G_THREADS_BACK) = SEXP_NULL;
   sexp_global(ctx, SEXP_G_THREADS_SIGNALS) = SEXP_ZERO;
   sexp_global(ctx, SEXP_G_THREADS_SIGNAL_RUNNER) = SEXP_FALSE;
+  sexp_global(ctx, SEXP_G_ATOMIC_P) = SEXP_FALSE;
 #endif
   sexp_gc_release1(ctx);
 }
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index b10c5fcf..62097f1e 100755
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -1195,6 +1195,7 @@ enum sexp_context_globals {
   SEXP_G_THREADS_BLOCKER,
   SEXP_G_THREADS_MUTEX_ID,
   SEXP_G_THREADS_POLLFDS_ID,
+  SEXP_G_ATOMIC_P,
 #endif
   SEXP_G_NUM_GLOBALS
 };
diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c
index 979c2cde..6497c1db 100644
--- a/lib/chibi/ast.c
+++ b/lib/chibi/ast.c
@@ -1,5 +1,5 @@
 /*  ast.c -- interface to the Abstract Syntax Tree            */
-/*  Copyright (c) 2009-2011 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2009-2012 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt       */
 
 #include <chibi/eval.h>
@@ -334,6 +334,12 @@ static sexp sexp_gc_op (sexp ctx, sexp self, sexp_sint_t n) {
   return sexp_make_unsigned_integer(ctx, sum_freed);
 }
 
+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;
+}
+
 static sexp sexp_string_contains (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
   const char *res;
   sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, x);
@@ -476,6 +482,7 @@ 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);
+  sexp_define_foreign(ctx, env, "%set-atomic!", 1, sexp_set_atomic);
   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 99f5975f..4fc58791 100644
--- a/lib/chibi/ast.scm
+++ b/lib/chibi/ast.scm
@@ -1,5 +1,5 @@
 ;; ast.scm -- ast utilities
-;; Copyright (c) 2010-2011 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2010-2012 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
 ;;> Abstract Syntax Tree.  Interface to the types used by
@@ -355,3 +355,18 @@
 
 ;;> Returns the first string cursor of @var{pat} in @var{str},
 ;;> of @scheme{#f} if it's not found.
+
+;;> @subsubsubsection{@scheme{(atomically @var{expr})}}
+
+;;> Run @var{expr} atomically, disabling yields.  Ideally should only
+;;> be used for brief, deterministic expressions.  If used incorrectly
+;;> (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))))
diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld
index 74b90c16..2124e9a8 100644
--- a/lib/chibi/ast.sld
+++ b/lib/chibi/ast.sld
@@ -32,7 +32,7 @@
    port-line port-line-set!
    environment-parent
    type-name type-cpl type-parent type-slots type-num-slots type-printer
-   object-size integer->immediate gc
+   object-size integer->immediate gc atomically
    string-contains integer->error-string
    flatten-dot update-free-vars!)
   (import (scheme))
diff --git a/vm.c b/vm.c
index a92dd837..4e8cbd41 100644
--- a/vm.c
+++ b/vm.c
@@ -872,7 +872,7 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
 #if SEXP_USE_GREEN_THREADS
   if (--fuel <= 0) {
     tmp1 = sexp_global(ctx, SEXP_G_THREADS_SCHEDULER);
-    if (sexp_applicablep(tmp1)) {
+    if (sexp_applicablep(tmp1) && sexp_not(sexp_global(ctx, SEXP_G_ATOMIC_P))) {
       /* save thread */
       sexp_context_top(ctx) = top;
       sexp_context_ip(ctx) = ip;