* configure: Support a gen-gc configuration variable which

causes CONFIG_GEN_GC to be defined as 1 in config.h.

* eval.c (op_defvar, dwim_loc, op_modplace, transform_op): Handle
mutating assignments via set macro.
(op_dohash): Inform gc about mutated variables. TODO here.

* filter.c (trie_add, trie_compress): Handle mutating assignments
via set macro.

* gc.c (BACKPTR_VEC_SIZE, FULL_GC_INTERVAL): New preprocessor symbols.
(backptr, backptr_idx, partial_gc_count, full): New static variables.
(make_obj): Initialize generation to zero.
(gc): Added logic for deciding between full and partial gc.
(gc_set, gc_mutated): New functions.

* gc.h (gc_set, gc_mutated): Declared.

* hash.c (hash_mark): Changed useless use of vecref_l to vecref.
(gethash_f): Use set when assigning through *found since it
is a possible mutation.

* lib.c (car_l, cdr_l, vecref_l): Got rid of loc macro uses. Using the
value properly is going to be the caller's responsibility.
(push): push may be a mutation, so use set.
(intern): Uset set to mutate a hash entry.
(acons_new_l, aconsq_new_l): Use set when replacing *list.

* lib.h (PTR_BIT): New preprocessor symbol.
(obj_common): New macro for defining common object fields.
type_t is split into two bitfields, half a pointer wide,
allowing for generation to be represented.
(struct any, struct cons, struct string, struct sym, struct package,
struct func, struct vec, struct lazy_cons, struct cobj, struct env,
struct bignum, struct flonum): Use obj_common macro to defined
common fields.
(loc): Macro removed.
(set, mut): Macros conditionally defined for real functionality.
(list_collect, list_collect_nconc, list_collect_append): Replace
mutating operations with set.

* match.c (dest_set, v_cat, v_output, v_filter): Replace
mutating operations with set.

* stream.c (string_in_get_line, string_in_get_char,
strlist_out_put_string, strlist_out_put_char): Replace mutating
operations with set.

* unwind.c (uw_register_subtype): Replace mutating operation with set.

1 files changed, 33 insertions, 18 deletions

diff --git a/lib.h b/lib.h
index 39b590d5..45bfae30 100644
--- a/lib.h
+++ b/lib.h
@@ -37,6 +37,8 @@ typedef int_ptr_t cnum;
 #define NUM_MAX (INT_PTR_MAX/4)
 #define NUM_MIN (INT_PTR_MIN/4)
 
+#define PTR_BIT (SIZEOF_PTR * CHAR_BIT)
+
 typedef enum type {
   NIL, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
   STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV,
@@ -59,39 +61,48 @@ typedef obj_t *val;
 
 typedef unsigned char mem_t;
 
+#if CONFIG_GEN_GC
+#define obj_common \
+  type_t type : PTR_BIT/2; \
+  int gen : PTR_BIT/2
+#else
+#define obj_common \
+  type_t type
+#endif
+
 struct any {
-  type_t type;
+  obj_common;
   void *dummy[2];
   val next; /* GC free list */
 };
 
 struct cons {
-  type_t type;
+  obj_common;
   val car, cdr;
 };
 
 struct string {
-  type_t type;
+  obj_common;
   wchar_t *str;
   val len;
   val alloc;
 };
 
 struct sym {
-  type_t type;
+  obj_common;
   val name;
   val package;
   val value;
 };
 
 struct package {
-  type_t type;
+  obj_common;
   val name;
   val symhash;
 };
 
 struct func {
-  type_t type;
+  obj_common;
   unsigned fixparam : 7; /* total non-variadic parameters */
   unsigned optargs : 7;  /* fixparam - optargs = required args */
   unsigned variadic : 1;
@@ -126,7 +137,7 @@ struct func {
 enum vecindex { vec_alloc = -2, vec_length = -1 };
 
 struct vec {
-  type_t type;
+  obj_common;
   /* vec points two elements down */
   /* vec[-2] is allocated size */
   /* vec[-1] is fill pointer */
@@ -145,7 +156,7 @@ struct vec {
  */
 
 struct lazy_cons {
-  type_t type;
+  obj_common;
   val car, cdr;
   val func; /* when nil, car and cdr are valid */
 };
@@ -155,14 +166,14 @@ struct lazy_cons {
  * of a list of strings.
  */
 struct lazy_string {
-  type_t type;
+  obj_common;
   val prefix;           /* actual string part */
   val list;             /* remaining list */
   val opts;             /* ( separator . limit ) */
 };
 
 struct cobj {
-  type_t type;
+  obj_common;
   mem_t *handle;
   struct cobj_ops *ops;
   val cls;
@@ -185,19 +196,19 @@ void cobj_mark_op(val);
 cnum cobj_hash_op(val);
 
 struct env {
-  type_t type;
+  obj_common;
   val vbindings;
   val fbindings;
   val up_env;
 };
 
 struct bignum {
-  type_t type;
+  obj_common;
   mp_int mp;
 };
 
 struct flonum {
-  type_t type;
+  obj_common;
   double n;
 };
 
@@ -217,9 +228,13 @@ union obj {
   struct flonum fl;
 };
 
+#if CONFIG_GEN_GC
 #define set(place, val) ((place) = (val))
-#define loc(place) (&(place))
 #define mut(obj)
+#else
+#define set(place, val) (gc_set(&(place), val))
+#define mut(obj) (gc_mutated(obj));
+#endif
 
 INLINE cnum tag(val obj) { return ((cnum) obj) & TAG_MASK; }
 INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; }
@@ -654,7 +669,7 @@ INLINE val eq(val a, val b) { return ((a) == (b) ? t : nil); }
   do {                                          \
     if (*PTAIL)                                 \
       PTAIL = tail(*PTAIL);                     \
-    *PTAIL = cons(OBJ, nil);                    \
+    set(*PTAIL, cons(OBJ, nil));                \
     PTAIL = cdr_l(*PTAIL);                      \
   } while(0)
 
@@ -663,16 +678,16 @@ INLINE val eq(val a, val b) { return ((a) == (b) ? t : nil); }
     if (*PTAIL) {                               \
       PTAIL = tail(*PTAIL);                     \
     }                                           \
-    *PTAIL = OBJ;                               \
+    set(*PTAIL, OBJ);                           \
   } while (0)
 
 #define list_collect_append(PTAIL, OBJ)         \
   do {                                          \
     if (*PTAIL) {                               \
-      *PTAIL = copy_list(*PTAIL);               \
+      set(*PTAIL, copy_list(*PTAIL));           \
       PTAIL = tail(*PTAIL);                     \
     }                                           \
-    *PTAIL = OBJ;                               \
+    set(*PTAIL, OBJ);                           \
   } while (0)
 
 #define cons_bind(CAR, CDR, CONS)               \