adding initial support for weak references

Makefile

@@ -108,7 +108,7 @@ COMPILED_LIBS := lib/srfi/18/threads$(SO) lib/srfi/27/rand$(SO) \
 	lib/srfi/98/env$(SO) lib/chibi/ast$(SO) lib/chibi/net$(SO) \
 	lib/chibi/filesystem$(SO) lib/chibi/process$(SO) lib/chibi/time$(SO) \
 	lib/chibi/system$(SO) lib/chibi/io/io$(SO) lib/chibi/stty$(SO) \
-	lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO)
+	lib/chibi/weak$(SO) lib/chibi/heap-stats$(SO) lib/chibi/disasm$(SO)
 
 libs: $(COMPILED_LIBS)
 

gc.c

@@ -96,6 +96,50 @@ int stack_references_pointer_p (sexp ctx, sexp x) {
 #define stack_references_pointer_p(ctx, x) 0
 #endif
 
+#if SEXP_USE_WEAK_REFERENCES
+void sexp_reset_weak_references(sexp ctx) {
+  int i, len, all_reset_p;
+  sexp_heap h = sexp_context_heap(ctx);
+  sexp p, t, end, *v;
+  sexp_free_list q, r;
+  for ( ; h; h=h->next) {   /* just scan the whole heap */
+    p = (sexp) (h->data + sexp_heap_align(sexp_sizeof(pair)));
+    q = h->free_list;
+    end = (sexp) ((char*)h->data + h->size - sexp_heap_align(sexp_sizeof(pair)));
+    while (p < end) {
+      /* find the preceding and succeeding free list pointers */
+      for (r=q->next; r && ((char*)r<(char*)p); q=r, r=r->next)
+        ;
+      if ((char*)r == (char*)p) { /* this is a free block, skip it */
+        p = (sexp) (((char*)p) + r->size);
+        continue;
+      }
+      if (sexp_gc_mark(p)) {
+        t = sexp_object_type(ctx, p);
+        if (sexp_type_weak_base(t) > 0) {
+          all_reset_p = 1;
+          v = (sexp*) ((char*)p + sexp_type_weak_base(t));
+          len = sexp_type_num_weak_slots_of_object(t, p);
+          for (i=0; i<len; i++) {
+            if (v[i] && sexp_pointerp(v[i]) && ! sexp_gc_mark(v[i])) {
+              v[i] = SEXP_FALSE;
+              sexp_brokenp(p) = 1;
+            } else {
+              all_reset_p = 0;
+            }
+          }
+          if (all_reset_p) {      /* ephemerons */
+            len += sexp_type_weak_len_extra(t);
+            for ( ; i<len; i++) v[i] = SEXP_FALSE;
+          }
+        }
+      }
+      p = (sexp) (((char*)p)+sexp_heap_align(sexp_allocated_bytes(ctx, p)));
+    }
+  }
+}
+#endif
+
 sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
   size_t freed, max_freed=0, sum_freed=0, size;
   sexp_heap h = sexp_context_heap(ctx);
@@ -171,6 +215,9 @@ sexp sexp_gc (sexp ctx, size_t *sum_freed) {
   sexp_mark(ctx, ctx);
 #if SEXP_USE_DEBUG_GC
   sexp_sweep_stats(ctx, 2, NULL, "* \x1B[31mFREE:\x1B[0m ");
+#endif
+#if SEXP_USE_WEAK_REFERENCES
+  sexp_reset_weak_references(ctx);
 #endif
   res = sexp_sweep(ctx, sum_freed);
   return res;

include/chibi/features.h

@@ -57,6 +57,9 @@
 /*   if you suspect a bug in the native GC. */
 /* #define SEXP_USE_BOEHM 1 */
 
+/* uncomment this to disable weak references */
+/* #define SEXP_USE_WEAK_REFERENCES 0 */
+
 /* uncomment this to just malloc manually instead of any GC */
 /*   Mostly for debugging purposes, this is the no GC option. */
 /*   You can use just the read/write API and */
@@ -279,6 +282,10 @@
 #define SEXP_USE_BOEHM 0
 #endif
 
+#ifndef SEXP_USE_WEAK_REFERENCES
+#define SEXP_USE_WEAK_REFERENCES 1
+#endif
+
 #ifndef SEXP_USE_MALLOC
 #define SEXP_USE_MALLOC 0
 #endif

include/chibi/sexp.h

@@ -205,6 +205,7 @@ struct sexp_type_struct {
   unsigned short field_len_scale;
   short size_base, size_off;
   unsigned short size_scale;
+  short weak_base, weak_len_base, weak_len_off, weak_len_scale, weak_len_extra;
   char *name;
   sexp_proc2 finalize;
 };
@@ -226,6 +227,7 @@ struct sexp_struct {
   char gc_mark;
   unsigned int immutablep:1;
   unsigned int freep:1;
+  unsigned int brokenp:1;
   unsigned int syntacticp:1;
 #if SEXP_USE_HEADER_MAGIC
   unsigned int magic;
@@ -470,6 +472,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
 #define sexp_flags(x)            ((x)->flags)
 #define sexp_immutablep(x)       ((x)->immutablep)
 #define sexp_freep(x)            ((x)->freep)
+#define sexp_brokenp(x)          ((x)->brokenp)
 #define sexp_pointer_magic(x)    ((x)->magic)
 
 #define sexp_check_tag(x,t)  (sexp_pointerp(x) && (sexp_pointer_tag(x) == (t)))
@@ -817,6 +820,10 @@ SEXP_API struct sexp_struct *sexp_type_specs;
   (((sexp_uint_t*)((char*)x + sexp_type_field_len_off(t)))[0]           \
    * sexp_type_field_len_scale(t)                                       \
    + sexp_type_field_eq_len_base(t))
+#define sexp_type_num_weak_slots_of_object(t, x)                        \
+  (((sexp_uint_t*)((char*)x + sexp_type_weak_len_off(t)))[0]            \
+   * sexp_type_weak_len_scale(t)                                        \
+   + sexp_type_weak_len_base(t))
 
 #define sexp_context_top(x)     (sexp_stack_top(sexp_context_stack(x)))
 
@@ -829,6 +836,11 @@ SEXP_API struct sexp_struct *sexp_type_specs;
 #define sexp_type_size_base(x)         ((x)->value.type.size_base)
 #define sexp_type_size_off(x)          ((x)->value.type.size_off)
 #define sexp_type_size_scale(x)        ((x)->value.type.size_scale)
+#define sexp_type_weak_base(x)         ((x)->value.type.weak_base)
+#define sexp_type_weak_len_base(x)     ((x)->value.type.weak_len_base)
+#define sexp_type_weak_len_off(x)      ((x)->value.type.weak_len_off)
+#define sexp_type_weak_len_scale(x)    ((x)->value.type.weak_len_scale)
+#define sexp_type_weak_len_extra(x)    ((x)->value.type.weak_len_extra)
 #define sexp_type_name(x)              ((x)->value.type.name)
 #define sexp_type_finalize(x)          ((x)->value.type.finalize)
 
@@ -880,6 +892,9 @@ enum sexp_context_globals {
   SEXP_G_ERR_HANDLER,
   SEXP_G_RESUMECC_BYTECODE,
   SEXP_G_FINAL_RESUMER,
+#if SEXP_USE_WEAK_REFERENCES
+  SEXP_G_WEAK_REFERENCE_CACHE,
+#endif
 #if SEXP_USE_GREEN_THREADS
   SEXP_G_THREADS_SCHEDULER,
   SEXP_G_THREADS_FRONT,
@@ -1010,14 +1025,14 @@ SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
 #endif
 
 #if SEXP_USE_TYPE_DEFS
-SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
+SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
 SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp slots);
-SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name);
 SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj);
 #define sexp_register_c_type(ctx, name, finalizer)                      \
   sexp_register_type(ctx, name, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \
                      SEXP_ZERO, sexp_make_fixnum(sexp_sizeof(cpointer)), \
-                     SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer)
+                     SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \
+                     SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer)
 #endif
 
 #define sexp_current_error_port(ctx) sexp_env_global_ref(sexp_context_env(ctx),sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL),SEXP_FALSE)
@@ -1054,7 +1069,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj)
 #define sexp_get_output_string(ctx, out) sexp_get_output_string_op(ctx sexp_api_pass(NULL, 1), out)
 #define sexp_expt(ctx, a, b) sexp_expt_op(ctx sexp_api_pass(NULL, 2), a, b)
 #define sexp_register_simple_type(ctx, a, b) sexp_register_simple_type_op(ctx sexp_api_pass(NULL, 2), a, b)
-#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j) sexp_register_type_op(ctx sexp_api_pass(NULL, 10), a, b, c, d, e, f, g, h, i, j)
+#define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p) sexp_register_type_op(ctx sexp_api_pass(NULL, 15), a, b, c, d, e, f, g, h, i, j, k, l, m, o, p)
 #define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx sexp_api_pass(NULL, 2), a, b)
 #define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx sexp_api_pass(NULL, 2), a, b)
 #define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)

lib/chibi/weak.c

@@ -0,0 +1,49 @@
+/*  weak.c -- weak pointers and ephemerons               */
+/*  Copyright (c) 2010 Alex Shinn.  All rights reserved. */
+/*  BSD-style license: http://synthcode.com/license.txt  */
+
+#include <chibi/eval.h>
+
+static int sexp_ephemeron_id;
+
+#define sexp_ephemeron_key(x) sexp_slot_ref(x, 0)
+#define sexp_ephemeron_value(x) sexp_slot_ref(x, 1)
+
+sexp sexp_make_ephemeron (sexp ctx sexp_api_params(self, n), sexp key, sexp value) {
+  sexp res = sexp_alloc_type(ctx, pair, sexp_ephemeron_id);
+  if (! sexp_exceptionp(res)) {
+    sexp_ephemeron_key(res) = key;
+    sexp_ephemeron_value(res) = value;
+  }
+  return res;
+}
+
+sexp sexp_ephemeron_brokenp_op (sexp ctx sexp_api_params(self, n), sexp eph) {
+  return sexp_make_boolean(sexp_brokenp(eph));
+}
+
+sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
+  sexp_gc_var3(name, t, op);
+  sexp_gc_preserve3(ctx, name, t, op);
+
+  name = sexp_c_string(ctx, "Ephemeron", -1);
+  t = sexp_register_simple_type(ctx, name, SEXP_TWO);
+  sexp_ephemeron_id = sexp_type_tag(t);
+  sexp_type_field_len_base(t) = 0;
+  sexp_type_weak_base(t) = sexp_type_field_base(t);
+  sexp_type_weak_len_base(t) = 1;
+  sexp_type_weak_len_extra(t) = 1;
+
+  op = sexp_make_type_predicate(ctx, name=sexp_c_string(ctx,"ephemeron?",-1), t);
+  sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron?", -1), op);
+  op = sexp_make_getter(ctx, name=sexp_c_string(ctx, "ephemeron-key", -1), t, SEXP_ZERO);
+  sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron-key", -1), op);
+  op = sexp_make_getter(ctx, name=sexp_c_string(ctx, "ephemeron-value", -1), t, SEXP_ONE);
+  sexp_env_define(ctx, env, name=sexp_intern(ctx, "ephemeron-value", -1), op);
+  sexp_define_foreign(ctx, env, "make-ephemeron", 2, sexp_make_ephemeron);
+  sexp_define_foreign(ctx, env, "ephemeron-broken?", 1, sexp_ephemeron_brokenp_op);
+
+  sexp_gc_release3(ctx);
+  return SEXP_VOID;
+}
+

lib/chibi/weak.module

@@ -0,0 +1,7 @@
+
+(define-module (chibi weak)
+  (export make-ephemeron ephemeron? ephemeron-broken?
+          ephemeron-key ephemeron-value
+          make-weak-vector weak-vector? weak-vector-length
+          weak-vector-ref weak-vector-set!)
+  (include-shared "weak"))

lib/srfi/27/rand.c

@@ -175,7 +175,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   op = sexp_register_type(ctx, name, sexp_make_fixnum(sexp_offsetof_slot0),
                           ONE, ONE, ZERO, ZERO,
                           sexp_make_fixnum(sexp_sizeof_random),
-                          ZERO, ZERO, NULL);
+                          ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, ZERO, NULL);
   if (sexp_exceptionp(op))
     return op;
   rs_type_id = sexp_type_tag(op);

sexp.c

@@ -76,47 +76,44 @@ sexp sexp_finalize_port (sexp ctx sexp_api_params(self, n), sexp port) {
 #define SEXP_FINALIZE_PORT NULL
 #endif
 
-#define _DEF_TYPE(t,fb,felb,flb,flo,fls,sb,so,sc,n,f) {t,fb,felb,flb,flo,fls,sb,so,sc,n,f}
-
 static struct sexp_type_struct _sexp_type_specs[] = {
-  _DEF_TYPE(SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, 0, "object", NULL),
+  {SEXP_OBJECT, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "object", NULL},
-  _DEF_TYPE(SEXP_TYPE, 0, 0, 0, 0, 0, sexp_sizeof(type), 0, 0, "type", NULL),
+  {SEXP_TYPE, 0, 0, 0, 0, 0, sexp_sizeof(type), 0, 0, 0, 0, 0, 0, 0, "type", NULL},
-  _DEF_TYPE(SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, 0, "integer", NULL),
+  {SEXP_FIXNUM, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "integer", NULL},
-  _DEF_TYPE(SEXP_NUMBER, 0, 0, 0, 0, 0, 0, 0, 0, "number", NULL),
+  {SEXP_NUMBER, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "number", NULL},
-  _DEF_TYPE(SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, 0, "char", NULL),
+  {SEXP_CHAR, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "char", NULL},
-  _DEF_TYPE(SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, 0, "boolean", NULL),
+  {SEXP_BOOLEAN, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "boolean", NULL},
-  _DEF_TYPE(SEXP_PAIR, sexp_offsetof(pair, car), 2, 3, 0, 0, sexp_sizeof(pair), 0, 0, "pair", NULL),
+  {SEXP_PAIR, sexp_offsetof(pair, car), 2, 3, 0, 0, sexp_sizeof(pair), 0, 0, 0, 0, 0, 0, 0, "pair", NULL},
-  _DEF_TYPE(SEXP_SYMBOL, 0, 0, 0, 0, 0, sexp_sizeof(symbol)+1, sexp_offsetof(symbol, length), 1, "symbol", NULL),
+  {SEXP_SYMBOL, 0, 0, 0, 0, 0, sexp_sizeof(symbol)+1, sexp_offsetof(symbol, length), 1, 0, 0, 0, 0, 0, "symbol", NULL},
-  _DEF_TYPE(SEXP_BYTES, 0, 0, 0, 0, 0, sexp_sizeof(bytes)+1, sexp_offsetof(bytes, length), 1, "byte-vector", NULL),
+  {SEXP_BYTES, 0, 0, 0, 0, 0, sexp_sizeof(bytes)+1, sexp_offsetof(bytes, length), 1, 0, 0, 0, 0, 0, "byte-vector", NULL},
 #if SEXP_USE_PACKED_STRINGS
-  _DEF_TYPE(SEXP_STRING, 0, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, "string", NULL),
+  {SEXP_STRING, 0, 0, 0, 0, 0, sexp_sizeof(string)+1, sexp_offsetof(string, length), 1, 0, 0, 0, 0, 0, "string", NULL},
 #else
-  _DEF_TYPE(SEXP_STRING, sexp_offsetof(string, bytes), 1, 1, 0, 0, sexp_sizeof(string), 0, 0, "string", NULL),
+  {SEXP_STRING, sexp_offsetof(string, bytes), 1, 1, 0, 0, sexp_sizeof(string), 0, 0, 0, 0, 0, 0, 0, "string", NULL},
 #endif
-  _DEF_TYPE(SEXP_VECTOR, sexp_offsetof(vector, data), 0, 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), sizeof(sexp), "vector", NULL),
+  {SEXP_VECTOR, sexp_offsetof(vector, data), 0, 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), sizeof(sexp), 0, 0, 0, 0, 0, "vector", NULL},
-  _DEF_TYPE(SEXP_FLONUM, 0, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, "real", NULL),
+  {SEXP_FLONUM, 0, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, 0, 0, 0, 0, 0, "real", NULL},
-  _DEF_TYPE(SEXP_BIGNUM, 0, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), sizeof(sexp_uint_t), "bignum", NULL),
+  {SEXP_BIGNUM, 0, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), sizeof(sexp_uint_t), 0, 0, 0, 0, 0, "bignum", NULL},
-  _DEF_TYPE(SEXP_CPOINTER, sexp_offsetof(cpointer, parent), 1, 0, 0, 0, sexp_sizeof(cpointer), sexp_offsetof(cpointer, length), 1, "cpointer", NULL),
+  {SEXP_CPOINTER, sexp_offsetof(cpointer, parent), 1, 0, 0, 0, sexp_sizeof(cpointer), sexp_offsetof(cpointer, length), 1, 0, 0, 0, 0, 0, "cpointer", NULL},
-  _DEF_TYPE(SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, "input-port", SEXP_FINALIZE_PORT),
+  {SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, "input-port", SEXP_FINALIZE_PORT},
-  _DEF_TYPE(SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, "output-port", SEXP_FINALIZE_PORT),
+  {SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, "output-port", SEXP_FINALIZE_PORT},
-  _DEF_TYPE(SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, "exception", NULL),
+  {SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, "exception", NULL},
-  _DEF_TYPE(SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, "procedure", NULL),
+  {SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, "procedure", NULL},
-  _DEF_TYPE(SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, "macro", NULL),
+  {SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, "macro", NULL},
-  _DEF_TYPE(SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, "syntactic-closure", NULL),
+  {SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, 0, 0, 0, 0, 0, "syntactic-closure", NULL},
-  _DEF_TYPE(SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, "environment", NULL),
+  {SEXP_ENV, sexp_offsetof(env, parent), 3, 3, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, "environment", NULL},
-  _DEF_TYPE(SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, "bytecode", NULL),
+  {SEXP_BYTECODE, sexp_offsetof(bytecode, name), 3, 3, 0, 0, sexp_sizeof(bytecode), offsetof(struct sexp_struct, value.bytecode.length), 1, 0, 0, 0, 0, 0, "bytecode", NULL},
-  _DEF_TYPE(SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, "core-form", NULL),
+  {SEXP_CORE, 0, 0, 0, 0, 0, sexp_sizeof(core), 0, 0, 0, 0, 0, 0, 0, "core-form", NULL},
-  _DEF_TYPE(SEXP_OPCODE, sexp_offsetof(opcode, data), 7, 7, 0, 0, sexp_sizeof(opcode), 0, 0, "opcode", NULL),
+  {SEXP_OPCODE, sexp_offsetof(opcode, data), 7, 7, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, "opcode", NULL},
-  _DEF_TYPE(SEXP_LAMBDA, sexp_offsetof(lambda, name), 11, 11, 0, 0, sexp_sizeof(lambda), 0, 0, "lambda", NULL),
+  {SEXP_LAMBDA, sexp_offsetof(lambda, name), 11, 11, 0, 0, sexp_sizeof(lambda), 0, 0, 0, 0, 0, 0, 0, "lambda", NULL},
-  _DEF_TYPE(SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, "conditional", NULL),
+  {SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, 0, 0, 0, 0, 0, "conditional", NULL},
-  _DEF_TYPE(SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, "reference", NULL),
+  {SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, 0, 0, 0, 0, 0, "reference", NULL},
-  _DEF_TYPE(SEXP_SET, sexp_offsetof(set, var), 3, 3, 0, 0, sexp_sizeof(set), 0, 0, "set!", NULL),
+  {SEXP_SET, sexp_offsetof(set, var), 3, 3, 0, 0, sexp_sizeof(set), 0, 0, 0, 0, 0, 0, 0, "set!", NULL},
-  _DEF_TYPE(SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, "sequence", NULL),
+  {SEXP_SEQ, sexp_offsetof(seq, ls), 2, 2, 0, 0, sexp_sizeof(seq), 0, 0, 0, 0, 0, 0, 0, "sequence", NULL},
-  _DEF_TYPE(SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, "literal", NULL),
+  {SEXP_LIT, sexp_offsetof(lit, value), 2, 2, 0, 0, sexp_sizeof(lit), 0, 0, 0, 0, 0, 0, 0, "literal", NULL},
-  _DEF_TYPE(SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), "stack", NULL),
+  {SEXP_STACK, sexp_offsetof(stack, data), 1, 1, sexp_offsetof(stack, top), 1, sexp_sizeof(stack), offsetof(struct sexp_struct, value.stack.length), sizeof(sexp), 0, 0, 0, 0, 0, "stack", NULL},
-  _DEF_TYPE(SEXP_CONTEXT, sexp_offsetof(context, bc), 12, 12, 0, 0, sexp_sizeof(context), 0, 0, "context", NULL),
+  {SEXP_CONTEXT, sexp_offsetof(context, bc), 12, 12, 0, 0, sexp_sizeof(context), 0, 0, 0, 0, 0, 0, 0, "context", NULL},
 };
-#undef _DEF_TYPE
 
 #if SEXP_USE_GLOBAL_TYPES
 struct sexp_struct *sexp_type_specs = _sexp_type_specs;
@@ -133,7 +130,8 @@ static sexp_uint_t sexp_type_array_size = SEXP_NUM_CORE_TYPES;
 
 sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
                             sexp fb, sexp felb, sexp flb, sexp flo, sexp fls,
-                            sexp sb, sexp so, sexp sc, sexp_proc2 f) {
+                            sexp sb, sexp so, sexp sc, sexp w, sexp wb, sexp wo,
+                            sexp ws, sexp we, sexp_proc2 f) {
 #if SEXP_USE_GLOBAL_TYPES
   struct sexp_struct *new, *tmp;
 #else
@@ -181,6 +179,11 @@ sexp sexp_register_type_op (sexp ctx sexp_api_params(self, n), sexp name,
     sexp_type_size_base(type) = sexp_unbox_fixnum(sb);
     sexp_type_size_off(type) = sexp_unbox_fixnum(so);
     sexp_type_size_scale(type) = sexp_unbox_fixnum(sc);
+    sexp_type_weak_base(type) = sexp_unbox_fixnum(w);
+    sexp_type_weak_len_base(type) = sexp_unbox_fixnum(wb);
+    sexp_type_weak_len_off(type) = sexp_unbox_fixnum(wo);
+    sexp_type_weak_len_scale(type) = sexp_unbox_fixnum(ws);
+    sexp_type_weak_len_extra(type) = sexp_unbox_fixnum(we);
     sexp_type_name(type) = strdup(sexp_string_data(name));
     sexp_type_finalize(type) = f;
     res = type;
@@ -198,7 +201,9 @@ sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name,
   return
     sexp_register_type(ctx, name, sexp_make_fixnum(sexp_offsetof_slot0),
                        slots, slots, SEXP_ZERO, SEXP_ZERO,
-                       sexp_make_fixnum(type_size), SEXP_ZERO, SEXP_ZERO, NULL);
+                       sexp_make_fixnum(type_size), SEXP_ZERO, SEXP_ZERO,
+                       SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,
+                       NULL);
 }
 
 sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) {