Squashed 'lispBM/lispBM/' changes from ba29529d..093a6a88

093a6a88 Marking environments with a while loop over the proper list structure

git-subtree-dir: lispBM/lispBM
git-subtree-split: 093a6a887ffa33a198cfb10935aeb8c891b1289e

include/heap.h

@@ -571,6 +571,10 @@ void lbm_nil_freelist(void);
  * \return 1 on success or 0 if the free-list is corrupted.
  */
 int lbm_gc_mark_freelist(void);
+/** Mark all heap cells reachable from an environment.
+ * \param environment.
+ */
+void lbm_gc_mark_env(lbm_value);
 /** Mark heap cells reachable from the lbm_value v.
  * \param  root
  */

src/eval_cps.c

@@ -1467,8 +1467,9 @@ static int find_match(lbm_value plist, lbm_value *earr, lbm_uint num, lbm_value
 static void mark_context(eval_context_t *ctx, void *arg1, void *arg2) {
   (void) arg1;
   (void) arg2;
-  lbm_value roots[4] = { ctx->curr_env, ctx->curr_exp, ctx->program, ctx->r };
-  lbm_gc_mark_roots(roots, 4);
+  lbm_value roots[3] = {ctx->curr_exp, ctx->program, ctx->r };
+  lbm_gc_mark_env(ctx->curr_env);
+  lbm_gc_mark_roots(roots, 3);
   lbm_gc_mark_roots(ctx->mailbox, ctx->num_mail);
   lbm_gc_mark_aux(ctx->K.data, ctx->K.sp);
 }
@@ -1489,7 +1490,7 @@ static int gc(void) {
   }
   // The freelist should generally be NIL when GC runs.
   lbm_nil_freelist();
-  lbm_gc_mark_phase(lbm_get_env());
+  lbm_gc_mark_env(lbm_get_env());
 
   mutex_lock(&qmutex); // Lock the queues.
                        // Any concurrent messing with the queues

src/heap.c

@@ -736,7 +736,7 @@ void lbm_gc_mark_phase(lbm_value root) {
 
 // The free list should be a "proper list"
 // Using a while loop to traverse over the cdrs
-int lbm_gc_mark_freelist() {
+int lbm_gc_mark_freelist(void) {
 
   lbm_value curr;
   lbm_cons_t *t;
@@ -763,6 +763,23 @@ int lbm_gc_mark_freelist() {
   return 1;
 }
 
+//Environments are proper lists with a 2 element list stored in each car.
+void lbm_gc_mark_env(lbm_value env) {
+  lbm_value curr = env;
+  lbm_cons_t *c;
+
+  while (lbm_is_ptr(curr)) {
+    c = lbm_ref_cell(curr);
+    c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure.
+    lbm_cons_t *b = lbm_ref_cell(c->car);
+    b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell.
+    lbm_gc_mark_phase(b->cdr);        // mark the bound object.
+    lbm_heap_state.gc_marked +=2;
+    curr = c->cdr;
+  }
+}
+
+
 void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) {
   for (lbm_uint i = 0; i < aux_size; i ++) {
     if (lbm_is_ptr(aux_data[i])) {