altos/lisp: Optimize chunk searching in collect

Note range of existing chunks to exclude objects outside.
Only look at chunks which have been set to reduce loop cost.

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

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index e943291314069c141e5e6104117259cc8eec6d53..ea8d98b5b57eb9cea7d6bc4bbee02007e972a543 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -423,6 +423,7 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 
 extern int ao_lisp_collects[2];
 extern int ao_lisp_freed[2];
+extern int ao_lisp_loops[2];
 
 /* returns 1 if the object was already marked */
 int

diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
index 4dc63bbf8e82c88daf93493c8557f3ba8f159c64..6fbc35b67993fc2798effb659063db749d247c9a 100644 (file)
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -75,32 +75,6 @@
 (defun 1+ (x) (+ x 1))
 (defun 1- (x) (- x 1))
 
-                                       ; boolean operators
-
-(def or (lexpr (l)
-              (let ((ret nil))
-                (while l
-                  (cond ((setq ret (car l))
-                         (setq l nil))
-                        ((setq l (cdr l)))))
-                ret
-                )
-              )
-     )
-
-(def and (lexpr (l)
-              (let ((ret t))
-                (while l
-                  (cond ((setq ret (car l))
-                         (setq l (cdr l)))
-                        ((setq ret (setq l nil)))
-                        )
-                  )
-                ret
-                )
-              )
-     )
-
                                        ; define a set of local
                                        ; variables and then evaluate
                                        ; a list of sexprs
@@ -192,9 +166,37 @@
                )
      )
 
-                                       ; run the let macro once to
-                                       ; evaluate all of the internal
-                                       ; macro calls
+                                       ; boolean operators
+
+(def or (lexpr (l)
+              (let ((ret nil))
+                (while l
+                  (cond ((setq ret (car l))
+                         (setq l nil))
+                        ((setq l (cdr l)))))
+                ret
+                )
+              )
+     )
+
+                                       ; execute to resolve macros
+
+(or nil t)
+
+(def and (lexpr (l)
+              (let ((ret t))
+                (while l
+                  (cond ((setq ret (car l))
+                         (setq l (cdr l)))
+                        ((setq ret (setq l nil)))
+                        )
+                  )
+                ret
+                )
+              )
+     )
+
+                                       ; execute to resolve macros
 
-(let ((let-param 1)))
+(and t nil)
 

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 60bb80f01e8059b01c534b7a306d933f59d3579d..0f243eb0731e8c5407ee0a2d74822a09b89c22fc 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -136,6 +136,7 @@ ao_lisp_macro_push(ao_poly p)
        m->p = p;
        m->next = macro_stack;
        macro_stack = m;
+       return 0;
 }
 
 void
@@ -397,7 +398,7 @@ main(int argc, char **argv)
                fprintf(out, "  0x%04x\n", ao_lisp_atom_poly(a));
        }
        fprintf(out, "#ifdef AO_LISP_CONST_BITS\n");
-       fprintf(out, "const uint8_t ao_lisp_const[] = {");
+       fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {");
        for (o = 0; o < ao_lisp_top; o++) {
                uint8_t c;
                if ((o & 0xf) == 0)

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 37d0af2b3e317194ddf70f07c4ca0b6f849be264..b681dbd547f1bd6d4e7f0b0fa873325d0ca075cc 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -307,18 +307,19 @@ note_cons(void *addr)
        }
 }
 
-static uint16_t        chunk_low;
+static uint16_t        chunk_low, chunk_high;
 static uint16_t        chunk_first, chunk_last;
+static int chunk_busy;
 
 static void
 note_chunk(uint16_t addr, uint16_t size)
 {
        int i;
 
-       if (addr < chunk_low)
+       if (addr < chunk_low || chunk_high < addr)
                return;
 
-       for (i = 0; i < AO_LISP_NCHUNK; i++) {
+       for (i = 0; i < chunk_busy; i++) {
                if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) {
 #if DBG_MEM
                        if (ao_lisp_chunk[i].size != size)
@@ -327,17 +328,30 @@ note_chunk(uint16_t addr, uint16_t size)
                        return;
                }
                if (ao_lisp_chunk[i].old_addr > addr) {
+                       int end = min(AO_LISP_NCHUNK, chunk_busy + 1);
                        memmove(&ao_lisp_chunk[i+1],
                                &ao_lisp_chunk[i],
-                               (AO_LISP_NCHUNK - (i+1)) * sizeof (struct ao_lisp_chunk));
-                       ao_lisp_chunk[i].size = 0;
-               }
-               if (ao_lisp_chunk[i].size == 0) {
-                       ao_lisp_chunk[i].old_addr = addr;
-                       ao_lisp_chunk[i].size = size;
-                       return;
+                               (end - (i+1)) * sizeof (struct ao_lisp_chunk));
+                       break;
                }
        }
+       if (i < AO_LISP_NCHUNK) {
+               ao_lisp_chunk[i].old_addr = addr;
+               ao_lisp_chunk[i].size = size;
+               if (chunk_busy < AO_LISP_NCHUNK)
+                       chunk_busy++;
+               else
+                       chunk_high = ao_lisp_chunk[AO_LISP_NCHUNK-1].old_addr +
+                               ao_lisp_chunk[AO_LISP_NCHUNK-1].size;
+       }
+}
+
+static void
+reset_chunks(void)
+{
+       memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
+       chunk_high = ao_lisp_top;
+       chunk_busy = 0;
 }
 
 /*
@@ -434,6 +448,7 @@ ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons)
 
 int ao_lisp_collects[2];
 int ao_lisp_freed[2];
+int ao_lisp_loops[2];
 
 int ao_lisp_last_top;
 
@@ -453,7 +468,9 @@ ao_lisp_collect(uint8_t style)
        marked = moved = 0;
 #endif
 
-       ++ao_lisp_collects[style];
+       /* The first time through, we're doing a full collect */
+       if (ao_lisp_last_top == 0)
+               style = AO_LISP_COLLECT_FULL;
 
        /* Clear references to all caches */
        for (i = 0; i < (int) AO_LISP_CACHE; i++)
@@ -467,7 +484,7 @@ ao_lisp_collect(uint8_t style)
                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));
+               reset_chunks();
                walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref);
 #if DBG_MEM
                marked = total_marked;
@@ -501,7 +518,6 @@ ao_lisp_collect(uint8_t style)
                        MDBG_MOVE("chunk %d %d not moving\n",
                                  ao_lisp_chunk[i].old_addr,
                                  ao_lisp_chunk[i].size);
-                       chunk_low = ao_lisp_chunk[i].old_addr + size;
                }
 
                chunk_first = i;
@@ -521,7 +537,6 @@ ao_lisp_collect(uint8_t style)
                                &ao_lisp_pool[ao_lisp_chunk[i].old_addr],
                                size);
                        top += size;
-                       chunk_low = ao_lisp_chunk[i].old_addr + size;
                }
 
                chunk_last = i;
@@ -544,18 +559,25 @@ ao_lisp_collect(uint8_t style)
 
                if (chunk_last != AO_LISP_NCHUNK)
                        break;
+
+               chunk_low = chunk_high;
        }
+
+       /* Compute amount of memory freed */
        ret = ao_lisp_top - top;
+
+       /* Collect stats */
+       ++ao_lisp_collects[style];
        ao_lisp_freed[style] += ret;
+       ao_lisp_loops[style] += loops;
 
        ao_lisp_top = top;
-       if (style == AO_LISP_COLLECT_FULL || ao_lisp_last_top == 0)
+       if (style == AO_LISP_COLLECT_FULL)
                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. style %d loops %d freed %d\n", style, loops, ret);
        return ret;
 }
 

diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index 720355d2c99d734243a91c5fce547241c16fd3e1..68e3a2027d6f3ee1a51250d588b31b70c3fdaea4 100644 (file)
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -101,10 +101,34 @@ main (int argc, char **argv)
                ao_lisp_file = NULL;
        }
        ao_lisp_read_eval_print();
+
        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]);
+
+       printf("loops: full %d incremental %d\n",
+               ao_lisp_loops[AO_LISP_COLLECT_FULL],
+               ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL]);
+
+       printf("loops per collect: full %f incremental %f\n",
+              (double) ao_lisp_loops[AO_LISP_COLLECT_FULL] /
+              (double) ao_lisp_collects[AO_LISP_COLLECT_FULL],
+              (double) ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL] /
+              (double) ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
+
+       printf("freed per collect: full %f incremental %f\n",
+              (double) ao_lisp_freed[AO_LISP_COLLECT_FULL] /
+              (double) ao_lisp_collects[AO_LISP_COLLECT_FULL],
+              (double) ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL] /
+              (double) ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
+
+       printf("freed per loop: full %f incremental %f\n",
+              (double) ao_lisp_freed[AO_LISP_COLLECT_FULL] /
+              (double) ao_lisp_loops[AO_LISP_COLLECT_FULL],
+              (double) ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL] /
+              (double) ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL]);
 }

diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp
index 387e696ae55de1df681ce3ff0bc1bac8ed66e92b..7a25656c06e1a7e5903d8921e5e311ffb19a5954 100644 (file)
--- a/src/test/hanoi.lisp
+++ b/src/test/hanoi.lisp
@@ -126,7 +126,7 @@
     (setq stacks (replace stacks from from-stack))
     (setq stacks (replace stacks to to-stack))
     (display)
-    (delay 100)
+;    (delay 100)
     )
   )
 
@@ -158,3 +158,12 @@
   (clear)
   (_hanoi len 0 1 2)
   )
+
+(defun hanois(n)
+  (while (> n 0)
+    (progn
+      (hanoi)
+      (setq l (1- l))
+      )
+    )
+  )