Adding more OOM checks (issue #59), thanks rotty.

eval.c

@@ -1,5 +1,5 @@
 /*  eval.c -- evaluator library implementation                */
-/*  Copyright (c) 2009-2010 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2009-2011 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt       */
 
 #include "chibi/eval.h"
@@ -365,8 +365,10 @@ void sexp_init_eval_context_globals (sexp ctx) {
 
 sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size, sexp_uint_t max_size) {
   sexp_gc_var1(res);
-  if (ctx) sexp_gc_preserve1(ctx, res);
   res = sexp_make_context(ctx, size, max_size);
+  if (!res || sexp_exceptionp(res))
+    return res;
+  if (ctx) sexp_gc_preserve1(ctx, res);
   sexp_context_bc(res) = sexp_alloc_bytecode(res, SEXP_INIT_BCODE_SIZE);
   sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
   sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE;
@@ -1530,6 +1532,7 @@ sexp sexp_find_module_file (sexp ctx, const char *file) {
     slash = dir[dirlen-1] == '/';
     len = dirlen+filelen+2-slash;
     path = (char*) malloc(len);
+    if (! path) return sexp_global(ctx, SEXP_G_OOM_ERROR);
     memcpy(path, dir, dirlen);
     if (! slash) path[dirlen] = '/';
     memcpy(path+len-filelen-1, file, filelen);

gc.c

@@ -38,6 +38,14 @@ static size_t sexp_heap_total_size (sexp_heap h) {
   return total_size;
 }
 
+void sexp_free_heap (sexp_heap heap) {
+#if SEXP_USE_MMAP_GC
+  munmap(heap, sexp_heap_pad_size(heap->size));
+#else
+  free(heap);
+#endif
+}
+
 sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x) {
   sexp_uint_t res;
   sexp t;
@@ -451,6 +459,7 @@ sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags) {
     return sexp_user_exception(ctx, NULL, "can't copy a non-contiguous heap", ctx);
   } else if (! dst || sexp_not(dst)) {
     to = sexp_make_heap(from->size, from->max_size);
+    if (!to) return sexp_global(ctx, SEXP_G_OOM_ERROR);
     dst = (sexp) ((char*)ctx + ((char*)to - (char*)from));
   } else if (! sexp_contextp(dst)) {
     return sexp_type_exception(ctx, NULL, SEXP_CONTEXT, dst);

include/chibi/sexp.h

@@ -1105,8 +1105,10 @@ SEXP_API void sexp_maybe_unblock_port (sexp ctx, sexp in);
 #define SEXP_COPY_FREEP   SEXP_ONE
 
 #if SEXP_USE_GLOBAL_HEAP
+#define sexp_free_heap(heap)
 #define sexp_destroy_context(ctx)
 #else
+SEXP_API void sexp_free_heap (sexp_heap heap);
 SEXP_API void sexp_destroy_context (sexp ctx);
 SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
 #endif

main.c

@@ -1,5 +1,5 @@
 /* main.c -- chibi-scheme command-line app                   */
-/* Copyright (c) 2009-2010 Alex Shinn.  All rights reserved. */
+/* Copyright (c) 2009-2011 Alex Shinn.  All rights reserved. */
 /* BSD-style license: http://synthcode.com/license.txt       */
 
 #include "chibi/eval.h"
@@ -95,9 +95,10 @@ static sexp check_exception (sexp ctx, sexp res) {
 }
 
 static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
-  sexp e = sexp_load_standard_env(ctx, env, k), res;
+  sexp e = sexp_load_standard_env(ctx, env, k), p, res;
+  if (sexp_exceptionp(e)) return e;
 #if SEXP_USE_GREEN_THREADS
-  sexp p  = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
+  p  = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
   if (sexp_portp(p)) sexp_maybe_block_port(ctx, p, 1);
 #endif
   res = sexp_make_env(ctx);
@@ -107,6 +108,10 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
 
 #define init_context() if (! ctx) do {                                  \
       ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size, heap_max_size); \
+      if (! ctx) {                                                      \
+        fprintf(stderr, "chibi-scheme: out of memory\n");               \
+        exit_failure();                                                 \
+      }                                                                 \
       env = sexp_context_env(ctx);                                      \
       sexp_gc_preserve2(ctx, tmp, args);                                \
     } while (0)

sexp.c

@@ -1,5 +1,5 @@
 /*  sexp.c -- standalone sexp library implementation          */
-/*  Copyright (c) 2009-2010 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2009-2011 Alex Shinn.  All rights reserved. */
 /*  BSD-style license: http://synthcode.com/license.txt       */
 
 #include "chibi/sexp.h"
@@ -166,6 +166,10 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
       sexp_type_array_size = len;
 #else
       res = sexp_make_vector(ctx, sexp_make_fixnum(len), SEXP_VOID);
+      if (sexp_exceptionp(res)) {
+        sexp_gc_release2(ctx);
+        return res;
+      }
       v1 = sexp_vector_data(res);
       v2 = sexp_vector_data(sexp_global(ctx, SEXP_G_TYPES));
       for (i=0; i<num_types; i++)
@@ -177,6 +181,7 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
     sexp_type_by_index(ctx, num_types) = sexp_alloc_type(ctx, type, SEXP_TYPE);
 #endif
     type = sexp_type_by_index(ctx, num_types);
+    if (!sexp_exceptionp(type)) {
       sexp_pointer_tag(type) = SEXP_TYPE;
       sexp_type_tag(type) = num_types;
       sexp_type_slots(type) = slots;
@@ -210,13 +215,14 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
       }
       sexp_vector_data(sexp_type_cpl(type))[len] = type;
       sexp_type_depth(type) = len;
-    res = type;
 #if SEXP_USE_GLOBAL_TYPES
       sexp_num_types = num_types + 1;
 #else
       sexp_global(ctx, SEXP_G_NUM_TYPES) = sexp_make_fixnum(num_types + 1);
 #endif
     }
+    res = type;
+  }
   sexp_gc_release2(ctx);
   return res;
 }
@@ -299,18 +305,21 @@ void sexp_init_context_globals (sexp ctx) {
 
 #if ! SEXP_USE_GLOBAL_HEAP
 sexp sexp_bootstrap_context (sexp_uint_t size, sexp_uint_t max_size) {
-  sexp dummy_ctx, ctx;
+  sexp ctx;
   sexp_heap heap;
+  struct sexp_struct dummy_ctx;
   if (size < SEXP_MINIMUM_HEAP_SIZE) size = SEXP_INITIAL_HEAP_SIZE;
   heap = sexp_make_heap(sexp_heap_align(size), sexp_heap_align(max_size));
-  dummy_ctx = (sexp) malloc(sexp_sizeof(context));
+  if (!heap) return 0;
-  sexp_pointer_tag(dummy_ctx) = SEXP_CONTEXT;
+  sexp_pointer_tag(&dummy_ctx) = SEXP_CONTEXT;
-  sexp_context_saves(dummy_ctx) = NULL;
+  sexp_context_saves(&dummy_ctx) = NULL;
-  sexp_context_heap(dummy_ctx) = heap;
+  sexp_context_heap(&dummy_ctx) = heap;
-  ctx = sexp_alloc_type(dummy_ctx, context, SEXP_CONTEXT);
+  ctx = sexp_alloc_type(&dummy_ctx, context, SEXP_CONTEXT);
-  sexp_context_heap(dummy_ctx) = NULL;
+  if (!ctx || sexp_exceptionp(ctx)) {
+    sexp_free_heap(heap);
+  } else {
     sexp_context_heap(ctx) = heap;
-  free(dummy_ctx);
+  }
   return ctx;
 }
 #endif
@@ -319,8 +328,10 @@ sexp sexp_make_context (sexp ctx, size_t size, size_t max_size) {
   sexp_gc_var1(res);
   if (ctx) sexp_gc_preserve1(ctx, res);
 #if ! SEXP_USE_GLOBAL_HEAP
-  if (! ctx) res = sexp_bootstrap_context(size, max_size);
+  if (! ctx) {
-  else
+    res = sexp_bootstrap_context(size, max_size);
+    if (!res || sexp_exceptionp(res)) return res;
+  } else
 #endif
     {
       res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
@@ -328,6 +339,7 @@ sexp sexp_make_context (sexp ctx, size_t size, size_t max_size) {
       sexp_context_heap(res) = sexp_context_heap(ctx);
 #endif
     }
+  if (!res || sexp_exceptionp(res)) return res;
   sexp_context_parent(res) = ctx;
   sexp_context_lambda(res) = SEXP_FALSE;
   sexp_context_name(res) = sexp_context_specific(res) = SEXP_FALSE;
@@ -364,11 +376,7 @@ void sexp_destroy_context (sexp ctx) {
     sexp_context_heap(ctx) = NULL;
     for ( ; heap; heap=tmp) {
       tmp = heap->next;
-#if SEXP_USE_MMAP_GC
+      sexp_free_heap(heap);
-      munmap(heap, sexp_heap_pad_size(heap->size));
-#else
-      free(heap);
-#endif
     }
   }
 }
@@ -1206,9 +1214,13 @@ sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
   sexp res = sexp_make_output_port(ctx, NULL, SEXP_FALSE);
   if (sexp_exceptionp(res)) return res;
   sexp_port_buf(res) = (char*) malloc(SEXP_PORT_BUFFER_SIZE);
+  if (!sexp_port_buf(res)) {
+    res = sexp_global(ctx, SEXP_G_OOM_ERROR);
+  } else {
     sexp_port_size(res) = SEXP_PORT_BUFFER_SIZE;
     sexp_port_offset(res) = 0;
     sexp_port_cookie(res) = SEXP_NULL;
+  }
   return res;
 }