Adding preservatives.

doc/chibi.scrbl

@@ -94,6 +94,8 @@ are listed below.
 @item{@ccode{SEXP_USE_SIMPLIFY} - use a simplification optimizer pass (enabled by default)}
 @item{@ccode{SEXP_USE_BIGNUMS} - use bignums (enabled by default)}
 @item{@ccode{SEXP_USE_FLONUMS} - use flonums (enabled by default)}
+@item{@ccode{SEXP_USE_RATIOS} - use exact ratios (enabled by default)}
+@item{@ccode{SEXP_USE_COMPLEX} - use complex numbers (enabled by default)}
 @item{@ccode{SEXP_USE_UTF8_STRINGS} - Unicode sopport (enabled by default)}
 @item{@ccode{SEXP_USE_NO_FEATURES} - disable almost all features}
 ]
@@ -549,6 +551,28 @@ If compiled with the Boehm GC, sexp_gc_var@italic{n} just translates to the
 plain declaration, while sexp_gc_preserve@italic{n} and
 sexp_gc_release@italic{n} become noops.
 
+When interacting with a garbage collection system from another
+language, or communicating between different Chibi managed heaps, you
+may want to manually ensure objects are preserved irrespective of any
+references to it from other objects in the same heap.  This can be
+done with the @ccode{sexp_preserve_object} and
+@ccode{sexp_release_object} utilities.
+
+@ccode{
+sexp_preserve_object(ctx, obj)
+}
+
+Increment the absolute reference count for @var{obj}.  So long as the
+reference count is above 0, @var{obj} will not be reclaimed even if
+there are no references to it from other object in the Chibi managed
+heap.
+
+@ccode{
+sexp_release_object(ctx, obj)
+}
+
+Decrement the absolute reference count for @var{obj}.
+
 @subsection{API Index}
 
 @subsubsection{Type Predicates}
@@ -1043,6 +1067,8 @@ namespace.
 
 @item{@hyperlink["lib/chibi/time.html"]{(chibi time) - An interface to the current system time}}
 
+@item{@hyperlink["lib/chibi/trace.html"]{(chibi trace) - A utility to trace procedure calls}}
+
 @item{@hyperlink["lib/chibi/type-inference.html"]{(chibi type-inference) - An easy-to-use type inference system}}
 
 @item{@hyperlink["lib/chibi/uri.html"]{(chibi uri) - Utilities to parse and construct URIs}}

gc.c

@@ -75,6 +75,20 @@ void sexp_free(void* ptr) {
 }
 #endif
 
+void sexp_preserve_object(sexp ctx, sexp x) {
+  sexp_global(ctx, SEXP_G_PRESERVATIVES) = sexp_cons(ctx, x, sexp_global(ctx, SEXP_G_PRESERVATIVES));
+}
+
+void sexp_release_object(sexp ctx, sexp x) {
+  sexp ls1, ls2;
+  for (ls1=NULL, ls2=sexp_global(ctx, SEXP_G_PRESERVATIVES); sexp_pairp(ls2);
+       ls1=ls2, ls2=sexp_cdr(ls2))
+    if (sexp_car(ls2) == x) {
+      if (ls1) sexp_cdr(ls1) = sexp_cdr(ls2);
+      else sexp_global(ctx, SEXP_G_PRESERVATIVES) = ls2;
+    }
+}
+
 sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x) {
   sexp_uint_t res;
   sexp t;

include/chibi/sexp.h

@@ -427,6 +427,9 @@ void sexp_free(void* ptr);
 #define sexp_gc_preserve(ctx, x, y)
 #define sexp_gc_release(ctx, x, y)
 
+#define sexp_preserve_object(ctx, x)
+#define sexp_release_object(ctx, x)
+
 #include "gc/gc.h"
 #define sexp_alloc(ctx, size)        GC_malloc(size)
 #define sexp_alloc_atomic(ctx, size) GC_malloc_atomic(size)
@@ -453,6 +456,9 @@ void sexp_free(void* ptr);
 
 #define sexp_gc_release(ctx, x, y)   (sexp_context_saves(ctx) = y.next)
 
+SEXP_API void sexp_preserve_object(sexp ctx, sexp x);
+SEXP_API void sexp_release_object(sexp ctx, sexp x);
+
 #if SEXP_USE_MALLOC
 #define sexp_alloc(ctx, size)        sexp_malloc(size)
 #define sexp_alloc_atomic(ctx, size) sexp_malloc(size)
@@ -1053,6 +1059,9 @@ enum sexp_context_globals {
 #if SEXP_USE_WEAK_REFERENCES
   SEXP_G_WEAK_REFERENCE_CACHE,
 #endif
+#if ! SEXP_USE_BOEHM
+  SEXP_G_PRESERVATIVES,
+#endif
 #if SEXP_USE_GREEN_THREADS
   SEXP_G_IO_BLOCK_ERROR,
   SEXP_G_THREADS_SCHEDULER,

sexp.c

@@ -351,6 +351,9 @@ void sexp_init_context_globals (sexp ctx) {
 #endif
 #if SEXP_USE_FOLD_CASE_SYMS
   sexp_global(ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(SEXP_DEFAULT_FOLD_CASE_SYMS);
+#endif
+#if ! SEXP_USE_BOEHM
+  sexp_global(ctx, SEXP_G_PRESERVATIVES) = 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_OOS_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of stack space", SEXP_NULL);