From 035aa7005c0ec3ea49f67fa8843e792ddb0d72fb Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sat, 5 Dec 2009 17:34:27 +0900
Subject: [PATCH] no longer exit(2)ing on OOM, pre-allocating a global OOM
exception
---
gc.c | 24 ++++++++++++++++++++----
include/chibi/sexp.h | 1 +
sexp.c | 30 ++++++++++++++++++++++--------
3 files changed, 43 insertions(+), 12 deletions(-)
diff --git a/gc.c b/gc.c
index b5c5b2c3..c2933930 100644
--- a/gc.c
+++ b/gc.c
@@ -4,10 +4,26 @@
#include "chibi/sexp.h"
+/* These settings are configurable but only recommended for */
+/* experienced users, so they're not in config.h. */
+
+/* the initial heap size in bytes */
+#ifndef SEXP_INITIAL_HEAP_SIZE
#define SEXP_INITIAL_HEAP_SIZE (2*1024*1024)
-#define SEXP_MAXIMUM_HEAP_SIZE 0
+#endif
+
+/* the maximum heap size in bytes - if 0 there is no limit */
+#ifndef SEXP_MAXIMUM_HEAP_SIZE
+#define SEXP_MAXIMUM_HEAP_SIZE (4*1024*1024)
+#endif
+
+/* if after GC more than this percentage of memory is still in use, */
+/* and we've not exceeded the maximum size, grow the heap */
+#ifndef SEXP_GROW_HEAP_RATIO
+#define SEXP_GROW_HEAP_RATIO 0.75
+#endif
+
#define SEXP_MINIMUM_OBJECT_SIZE (sexp_sizeof(pair))
-#define SEXP_GROW_HEAP_RATIO 0.7
#if SEXP_64_BIT
#define sexp_heap_align(n) sexp_align(n, 5)
@@ -206,12 +222,12 @@ void* sexp_alloc (sexp ctx, size_t size) {
max_freed = sexp_unbox_fixnum(sexp_gc(ctx, &sum_freed));
h = sexp_heap_last(sexp_context_heap(ctx));
if (((max_freed < size)
- || ((h->size - sum_freed) < (h->size*(1 - SEXP_GROW_HEAP_RATIO))))
+ || ((h->size - sum_freed) > (h->size*SEXP_GROW_HEAP_RATIO)))
&& ((! SEXP_MAXIMUM_HEAP_SIZE) || (size < SEXP_MAXIMUM_HEAP_SIZE)))
sexp_grow_heap(ctx, size);
res = sexp_try_alloc(ctx, size);
if (! res)
- errx(80, "out of memory allocating %zu bytes, aborting\n", size);
+ res = sexp_global(ctx, SEXP_G_OOM_ERROR);
}
return res;
}
diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h
index 575eeaad..03b044a0 100644
--- a/include/chibi/sexp.h
+++ b/include/chibi/sexp.h
@@ -668,6 +668,7 @@ enum sexp_context_globals {
#if ! USE_GLOBAL_SYMBOLS
SEXP_G_SYMBOLS,
#endif
+ SEXP_G_OOM_ERROR,
SEXP_G_QUOTE_SYMBOL,
SEXP_G_QUASIQUOTE_SYMBOL,
SEXP_G_UNQUOTE_SYMBOL,
diff --git a/sexp.c b/sexp.c
index 47b7fb2c..9ee6037a 100644
--- a/sexp.c
+++ b/sexp.c
@@ -49,7 +49,7 @@ sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
sexp res = (sexp) sexp_alloc(ctx, size);
- if (res) sexp_pointer_tag(res) = tag;
+ if (res && ! sexp_exceptionp(res)) sexp_pointer_tag(res) = tag;
return res;
}
@@ -187,6 +187,7 @@ void sexp_init_context_globals (sexp ctx) {
#if ! USE_GLOBAL_SYMBOLS
sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL);
#endif
+ sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL);
sexp_global(ctx, SEXP_G_QUOTE_SYMBOL) = sexp_intern(ctx, "quote");
sexp_global(ctx, SEXP_G_QUASIQUOTE_SYMBOL) = sexp_intern(ctx, "quasiquote");
sexp_global(ctx, SEXP_G_UNQUOTE_SYMBOL) = sexp_intern(ctx, "unquote");
@@ -211,6 +212,7 @@ sexp sexp_bootstrap_context (void) {
ctx = sexp_alloc_type(dummy_ctx, context, SEXP_CONTEXT);
sexp_context_heap(dummy_ctx) = NULL;
sexp_context_heap(ctx) = heap;
+ free(dummy_ctx);
return ctx;
}
#endif
@@ -385,6 +387,7 @@ static sexp sexp_read_error (sexp ctx, char *msg, sexp irritants, sexp port) {
sexp sexp_cons (sexp ctx, sexp head, sexp tail) {
sexp pair = sexp_alloc_type(ctx, pair, SEXP_PAIR);
+ if (sexp_exceptionp(pair)) return pair;
sexp_car(pair) = head;
sexp_cdr(pair) = tail;
sexp_pair_source(pair) = SEXP_FALSE;
@@ -559,6 +562,7 @@ sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
#if ! USE_IMMEDIATE_FLONUMS
sexp sexp_make_flonum(sexp ctx, double f) {
sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
+ if (sexp_exceptionp(x)) return x;
sexp_flonum_value(x) = f;
return x;
}
@@ -570,6 +574,7 @@ sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
if (! sexp_fixnump(len)) return sexp_type_exception(ctx, "bad length", len);
if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
+ if (sexp_exceptionp(s)) return s;
sexp_pointer_tag(s) = SEXP_STRING;
sexp_string_length(s) = clen;
if (sexp_charp(ch))
@@ -677,6 +682,7 @@ sexp sexp_intern(sexp ctx, char *str) {
/* not found, make a new symbol */
sexp_gc_preserve1(ctx, sym);
sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
+ if (sexp_exceptionp(sym)) return sym;
sexp_symbol_string(sym) = sexp_c_string(ctx, str, len);
sexp_push(ctx, sexp_context_symbols(ctx)[bucket], sym);
sexp_gc_release1(ctx);
@@ -690,22 +696,25 @@ sexp sexp_string_to_symbol (sexp ctx, sexp str) {
}
sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
- sexp v, *x;
+ sexp vec, *x;
int i, clen = sexp_unbox_fixnum(len);
if (! clen) return sexp_global(ctx, SEXP_G_EMPTY_VECTOR);
- v = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp),
- SEXP_VECTOR);
- x = sexp_vector_data(v);
+ vec = sexp_alloc_tagged(ctx, sexp_sizeof(vector) + clen*sizeof(sexp),
+ SEXP_VECTOR);
+ if (sexp_exceptionp(vec)) return vec;
+ x = sexp_vector_data(vec);
for (i=0; i<clen; i++)
x[i] = dflt;
- sexp_vector_length(v) = clen;
- return v;
+ sexp_vector_length(vec) = clen;
+ return vec;
}
sexp sexp_list_to_vector(sexp ctx, sexp ls) {
sexp x, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
- sexp *elts = sexp_vector_data(vec);
+ sexp *elts;
int i;
+ if (sexp_exceptionp(vec)) return vec;
+ elts = sexp_vector_data(vec);
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
elts[i] = sexp_car(x);
return vec;
@@ -715,6 +724,7 @@ sexp sexp_make_cpointer (sexp ctx, sexp_uint_t typeid, void *value, sexp parent,
sexp ptr;
if (! value) return SEXP_FALSE;
ptr = sexp_alloc_type(ctx, cpointer, typeid);
+ if (sexp_exceptionp(ptr)) return ptr;
sexp_freep(ptr) = freep;
sexp_cpointer_value(ptr) = value;
sexp_cpointer_parent(ptr) = parent;
@@ -910,6 +920,7 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
sexp res = sexp_make_input_port(ctx, NULL, SEXP_FALSE);
+ if (sexp_exceptionp(res)) return res;
sexp_port_cookie(res) = str;
sexp_port_buf(res) = sexp_string_data(str);
sexp_port_offset(res) = 0;
@@ -919,6 +930,7 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
sexp sexp_make_output_string_port (sexp ctx) {
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);
sexp_port_size(res) = SEXP_PORT_BUFFER_SIZE;
sexp_port_offset(res) = 0;
@@ -945,6 +957,7 @@ sexp sexp_get_output_string (sexp ctx, sexp out) {
sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) {
sexp p = sexp_alloc_type(ctx, port, SEXP_IPORT);
+ if (sexp_exceptionp(p)) return p;
sexp_port_stream(p) = in;
sexp_port_name(p) = name;
sexp_port_line(p) = 1;
@@ -957,6 +970,7 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) {
sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) {
sexp p = sexp_make_input_port(ctx, out, name);
+ if (sexp_exceptionp(p)) return p;
sexp_pointer_tag(p) = SEXP_OPORT;
return p;
}