altos/lisp: Add incremental collection

Realizing that long-lived objects will eventually float to the bottom
of the heap, I added a simple hack to the collector that 'remembers'
the top of the heap the last time a full collect was run and then runs
incremental collects looking to shift only objects above that
boundary. That doesn't perfectly capture the bounds of transient
objects, but does manage to reduce the amount of time spent not moving
persistent objects each time through the collector.

Signed-off-by: Keith Packard <keithp@keithp.com>

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index bcb0a17fa7dfd8ba102d52f295b0e79abe5a97fc..e943291314069c141e5e6104117259cc8eec6d53 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -421,7 +421,8 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 
 /* memory functions */
 
-extern int ao_lisp_collects;
+extern int ao_lisp_collects[2];
+extern int ao_lisp_freed[2];
 
 /* returns 1 if the object was already marked */
 int
@@ -445,8 +446,11 @@ ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref);
 void *
 ao_lisp_alloc(int size);
 
-void
-ao_lisp_collect(void);
+#define AO_LISP_COLLECT_FULL           1
+#define AO_LISP_COLLECT_INCREMENTAL    0
+
+int
+ao_lisp_collect(uint8_t style);
 
 void
 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons);

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 416a95d91fa4ddfa4be7d624696bae2c661db4cf..60bb80f01e8059b01c534b7a306d933f59d3579d 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -147,7 +147,7 @@ ao_lisp_macro_pop(void)
        free(m);
 }
 
-#define DBG_MACRO 1
+#define DBG_MACRO 0
 #if DBG_MACRO
 int macro_scan_depth;
 
@@ -355,7 +355,7 @@ main(int argc, char **argv)
        }
 
        /* Reduce to referenced values */
-       ao_lisp_collect();
+       ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
        for (f = 0; f < ao_lisp_frame_num(ao_lisp_frame_global); f++) {
                val = ao_has_macro(ao_lisp_frame_global->vals[f].val);

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 7e7464c4a59495f78752fb89464f48a4a29796a9..37d0af2b3e317194ddf70f07c4ca0b6f849be264 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -36,10 +36,6 @@ uint8_t      ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4
 
 #endif
 
-#if 0
-#define MDBG_POOL
-#endif
-
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
@@ -436,15 +432,19 @@ ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons)
        return ao_lisp_poly_mark(*p, do_note_cons);
 }
 
-int ao_lisp_collects;
+int ao_lisp_collects[2];
+int ao_lisp_freed[2];
 
-void
-ao_lisp_collect(void)
+int ao_lisp_last_top;
+
+int
+ao_lisp_collect(uint8_t style)
 {
+       int     ret;
        int     i;
        int     top;
-#if DBG_MEM
        int     loops = 0;
+#if DBG_MEM
        int     marked;
        int     moved;
        struct ao_lisp_record   *mark_record = NULL, *move_record = NULL;
@@ -453,15 +453,18 @@ ao_lisp_collect(void)
        marked = moved = 0;
 #endif
 
-       ++ao_lisp_collects;
+       ++ao_lisp_collects[style];
 
        /* Clear references to all caches */
        for (i = 0; i < (int) AO_LISP_CACHE; i++)
                *ao_lisp_cache[i] = NULL;
-       chunk_low = 0;
-       top = 0;
+       if (style == AO_LISP_COLLECT_FULL) {
+               chunk_low = top = 0;
+       } else {
+               chunk_low = top = ao_lisp_last_top;
+       }
        for (;;) {
-               MDBG_DO(loops++);
+               loops++;
                MDBG_MOVE("move chunks from %d to %d\n", chunk_low, top);
                /* Find the sizes of the first chunk of objects to move */
                memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
@@ -542,12 +545,18 @@ ao_lisp_collect(void)
                if (chunk_last != AO_LISP_NCHUNK)
                        break;
        }
+       ret = ao_lisp_top - top;
+       ao_lisp_freed[style] += ret;
+
        ao_lisp_top = top;
+       if (style == AO_LISP_COLLECT_FULL || ao_lisp_last_top == 0)
+               ao_lisp_last_top = top;
 
        MDBG_DO(memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
                walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref));
 
-//     printf ("collect. top %d loops %d\n", top, loops);
+//     printf ("collect. style %d loops %d freed %d\n", style, loops, ret);
+       return ret;
 }
 
 /*
@@ -737,45 +746,6 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
        return ret;
 }
 
-#ifdef MDBG_POOL
-static int AO_LISP_POOL_CUR = AO_LISP_POOL / 8;
-
-static void
-ao_lisp_poison(void)
-{
-       int     i;
-
-       printf("poison\n");
-       ao_lisp_mark_busy();
-       for (i = 0; i < AO_LISP_POOL_CUR; i += 4) {
-               uint32_t        *a = (uint32_t *) &ao_lisp_pool[i];
-               if (!busy_object(ao_lisp_busy, a))
-                       *a = 0xBEEFBEEF;
-       }
-       for (i = 0; i < AO_LISP_POOL_CUR; i += 2) {
-               ao_poly         *a = (uint16_t *) &ao_lisp_pool[i];
-               ao_poly         p = *a;
-
-               if (!ao_lisp_is_const(p)) {
-                       void    *r = ao_lisp_ref(p);
-
-                       if (ao_lisp_pool <= (uint8_t *) r &&
-                           (uint8_t *) r <= ao_lisp_pool + AO_LISP_POOL_CUR)
-                       {
-                               if (!busy_object(ao_lisp_busy, r)) {
-                                       printf("missing reference from %d to %d\n",
-                                              (int) ((uint8_t *) a - ao_lisp_pool),
-                                              (int) ((uint8_t *) r - ao_lisp_pool));
-                               }
-                       }
-               }
-       }
-}
-
-#else
-#define AO_LISP_POOL_CUR AO_LISP_POOL
-#endif
-
 #if DBG_MEM
 void
 ao_lisp_validate(void)
@@ -789,7 +759,6 @@ int dbg_allocs;
 
 #endif
 
-
 void *
 ao_lisp_alloc(int size)
 {
@@ -798,26 +767,10 @@ ao_lisp_alloc(int size)
        MDBG_DO(++dbg_allocs);
        MDBG_DO(if (dbg_validate) ao_lisp_validate());
        size = ao_lisp_size_round(size);
-       if (ao_lisp_top + size > AO_LISP_POOL_CUR) {
-#ifdef MDBG_POOL
-               if (AO_LISP_POOL_CUR < AO_LISP_POOL) {
-                       AO_LISP_POOL_CUR += AO_LISP_POOL / 8;
-                       ao_lisp_poison();
-               } else
-#endif
-               ao_lisp_collect();
-#ifdef MDBG_POOL
+       if (ao_lisp_top + size > AO_LISP_POOL) {
+               if (!ao_lisp_collect(AO_LISP_COLLECT_INCREMENTAL) &&
+                   !ao_lisp_collect(AO_LISP_COLLECT_FULL))
                {
-                       int     i;
-
-                       for (i = ao_lisp_top; i < AO_LISP_POOL; i += 4) {
-                               uint32_t        *p = (uint32_t *) &ao_lisp_pool[i];
-                               *p = 0xbeefbeef;
-                       }
-               }
-#endif
-
-               if (ao_lisp_top + size > AO_LISP_POOL) {
                        ao_lisp_error(AO_LISP_OOM, "out of memory");
                        return NULL;
                }

diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index d5f28e7daf45c283d6ec6c776c887b402bd479f2..e6e8b65e151ae28ba8bc211bc7ae4b4abb6ce668 100644 (file)
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -23,7 +23,7 @@ ao_lisp_save(struct ao_lisp_cons *cons)
 #ifdef AO_LISP_SAVE
        struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
 
-       ao_lisp_collect();
+       ao_lisp_collect(AO_LISP_COLLECT_FULL);
        os->atoms = ao_lisp_atom_poly(ao_lisp_atoms);
        os->globals = ao_lisp_frame_poly(ao_lisp_frame_global);
        os->const_checksum = ao_lisp_const_checksum;
@@ -64,7 +64,7 @@ ao_lisp_restore(struct ao_lisp_cons *cons)
 
                /* Reset the allocator */
                ao_lisp_top = AO_LISP_POOL;
-               ao_lisp_collect();
+               ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
                /* Re-create the evaluator stack */
                if (!ao_lisp_eval_restart())

diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index bbaa3f9d87eab95da1285433ddaf3368b39327eb..720355d2c99d734243a91c5fce547241c16fd3e1 100644 (file)
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -101,5 +101,10 @@ main (int argc, char **argv)
                ao_lisp_file = NULL;
        }
        ao_lisp_read_eval_print();
-       printf ("%d collects\n", ao_lisp_collects);
+       printf ("collects: full: %d incremental %d\n",
+               ao_lisp_collects[AO_LISP_COLLECT_FULL],
+               ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
+       printf ("freed: full %d incremental %d\n",
+               ao_lisp_freed[AO_LISP_COLLECT_FULL],
+               ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL]);
 }