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>

6 files changed, 107 insertions, 48 deletions

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index e9432913..ea8d98b5 100644
--- 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 4dc63bbf..6fbc35b6 100644
--- 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 60bb80f0..0f243eb0 100644
--- 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 37d0af2b..b681dbd5 100644
--- 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 720355d2..68e3a202 100644
--- 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 387e696a..7a25656c 100644
--- 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))
+      )
+    )
+  )