altos/lisp: Do better checking for un-evaluated macros in ROM
[fw/altos] / src / lisp / ao_lisp_mem.c
index 60f4bbeeed0b8bd8a2fa1033b8811ac549d1edbb..7e7464c4a59495f78752fb89464f48a4a29796a9 100644 (file)
@@ -43,7 +43,6 @@ uint8_t       ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
-int dbg_collects = 0;
 int dbg_validate = 0;
 
 struct ao_lisp_record {
@@ -212,6 +211,21 @@ static const struct ao_lisp_root   ao_lisp_root[] = {
 
 #define AO_LISP_ROOT   (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
 
+static const void ** const ao_lisp_cache[] = {
+       (const void **) &ao_lisp_cons_free_list,
+       (const void **) &ao_lisp_stack_free_list,
+       (const void **) &ao_lisp_frame_free_list[0],
+       (const void **) &ao_lisp_frame_free_list[1],
+       (const void **) &ao_lisp_frame_free_list[2],
+       (const void **) &ao_lisp_frame_free_list[3],
+};
+
+#if AO_LISP_FRAME_FREE != 4
+#error Unexpected AO_LISP_FRAME_FREE value
+#endif
+
+#define AO_LISP_CACHE  (sizeof (ao_lisp_cache) / sizeof (ao_lisp_cache[0]))
+
 #define AO_LISP_BUSY_SIZE      ((AO_LISP_POOL + 31) / 32)
 
 static uint8_t ao_lisp_busy[AO_LISP_BUSY_SIZE];
@@ -229,14 +243,16 @@ struct ao_lisp_chunk {
        };
 };
 
-#define AO_LISP_NCHUNK 32
+#define AO_LISP_NCHUNK 64
 
 static struct ao_lisp_chunk ao_lisp_chunk[AO_LISP_NCHUNK];
 
 /* Offset of an address within the pool. */
 static inline uint16_t pool_offset(void *addr) {
+#if DBG_MEM
        if (!AO_LISP_IS_POOL(addr))
                ao_lisp_abort();
+#endif
        return ((uint8_t *) addr) - ao_lisp_pool;
 }
 
@@ -246,8 +262,10 @@ static inline uint16_t pool_offset(void *addr) {
  * These are used in the chunk code.
  */
 static inline ao_poly pool_poly(void *addr) {
+#if DBG_MEM
        if (!AO_LISP_IS_POOL(addr))
                ao_lisp_abort();
+#endif
        return ((uint8_t *) addr) - AO_LISP_POOL_BASE;
 }
 
@@ -282,62 +300,11 @@ static inline int limit(int offset) {
 
 static int total_marked;
 
-/*
- * Mark a range of addresses
- */
-static int
-mark_object(uint8_t *tag, void *addr, int size) {
-       int     base;
-       int     bound;
-
-       MDBG_DO(if (!AO_LISP_IS_POOL((uint8_t *) addr + size - 1))
-                       ao_lisp_abort());
-
-       base = pool_offset(addr);
-       bound = base + size;
-
-       MDBG_DO(if (bound > ao_lisp_top) ao_lisp_abort());
-
-       if (busy(tag, base))
-               return 1;
-       if (tag == ao_lisp_busy)
-               total_marked += size;
-       while (base < bound) {
-               mark(tag, base);
-               base += 4;
-       }
-       return 0;
-}
-
-MDBG_DO(
-static int
-clear_object(uint8_t *tag, void *addr, int size) {
-       int     base;
-       int     bound;
-
-       MDBG_DO(if (!AO_LISP_IS_POOL((uint8_t *) addr + size - 1))
-                       ao_lisp_abort());
-
-       base = (uint8_t *) addr - ao_lisp_pool;
-       bound = base + size;
-
-       base = limit(base);
-       bound = limit(bound);
-       if (!busy(tag, base))
-               return 1;
-       total_marked -= size;
-       while (base < bound) {
-               clear(tag, base);
-               base += 4;
-       }
-       return 0;
-})
-
 static void
 note_cons(void *addr)
 {
        if (AO_LISP_IS_POOL(addr)) {
-               int     offset = (uint8_t *) addr - ao_lisp_pool;
+               int     offset = pool_offset(addr);
                MDBG_MOVE("note cons %d\n", MDBG_OFFSET(addr));
                ao_lisp_cons_noted = 1;
                mark(ao_lisp_cons_note, offset);
@@ -357,8 +324,10 @@ note_chunk(uint16_t addr, uint16_t size)
 
        for (i = 0; i < AO_LISP_NCHUNK; i++) {
                if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) {
+#if DBG_MEM
                        if (ao_lisp_chunk[i].size != size)
                                ao_lisp_abort();
+#endif
                        return;
                }
                if (ao_lisp_chunk[i].old_addr > addr) {
@@ -390,7 +359,7 @@ walk(int (*visit_addr)(const struct ao_lisp_type *type, void **addr),
        memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
        memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
        ao_lisp_cons_noted = 0;
-       for (i = 0; i < AO_LISP_ROOT; i++) {
+       for (i = 0; i < (int) AO_LISP_ROOT; i++) {
                if (ao_lisp_root[i].type) {
                        void **a = ao_lisp_root[i].addr, *v;
                        if (a && (v = *a)) {
@@ -467,6 +436,8 @@ 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;
+
 void
 ao_lisp_collect(void)
 {
@@ -478,10 +449,15 @@ ao_lisp_collect(void)
        int     moved;
        struct ao_lisp_record   *mark_record = NULL, *move_record = NULL;
 
-       ++dbg_collects;
-       MDBG_MOVE("collect %d\n", dbg_collects);
+       MDBG_MOVE("collect %d\n", ao_lisp_collects);
        marked = moved = 0;
 #endif
+
+       ++ao_lisp_collects;
+
+       /* Clear references to all caches */
+       for (i = 0; i < (int) AO_LISP_CACHE; i++)
+               *ao_lisp_cache[i] = NULL;
        chunk_low = 0;
        top = 0;
        for (;;) {
@@ -513,8 +489,10 @@ ao_lisp_collect(void)
 
                        if (ao_lisp_chunk[i].old_addr > top)
                                break;
+#if DBG_MEM
                        if (ao_lisp_chunk[i].old_addr != top)
                                ao_lisp_abort();
+#endif
 
                        top += size;
                        MDBG_MOVE("chunk %d %d not moving\n",
@@ -539,14 +517,10 @@ ao_lisp_collect(void)
                        memmove(&ao_lisp_pool[top],
                                &ao_lisp_pool[ao_lisp_chunk[i].old_addr],
                                size);
-                       MDBG_DO(clear_object(ao_lisp_busy, &ao_lisp_pool[ao_lisp_chunk[i].old_addr], size));
-                       MDBG_DO(mark_object(ao_lisp_busy, &ao_lisp_pool[top], size));
                        top += size;
                        chunk_low = ao_lisp_chunk[i].old_addr + size;
                }
 
-               MDBG_MOVE("after moving objects, busy is now:\n");
-               DUMP_BUSY();
                chunk_last = i;
 
                if (chunk_first < chunk_last) {
@@ -587,19 +561,19 @@ ao_lisp_collect(void)
 int
 ao_lisp_mark_memory(const struct ao_lisp_type *type, void *addr)
 {
-       int size;
+       int offset;
        if (!AO_LISP_IS_POOL(addr))
                return 1;
 
-       size = ao_lisp_size(type, addr);
+       offset = pool_offset(addr);
        MDBG_MOVE("mark memory %d\n", MDBG_OFFSET(addr));
-       if (!mark_object(ao_lisp_busy, addr, size)) {
-               note_chunk(pool_offset(addr), size);
-               MDBG_DO(ao_lisp_record(type, addr, size));
-               return 0;
+       if (busy(ao_lisp_busy, offset)) {
+               MDBG_MOVE("already marked\n");
+               return 1;
        }
-       MDBG_MOVE("already marked\n");
-       return 1;
+       mark(ao_lisp_busy, offset);
+       note_chunk(offset, ao_lisp_size(type, addr));
+       return 0;
 }
 
 int
@@ -640,8 +614,10 @@ ao_lisp_poly_mark(ao_poly p, uint8_t do_note_cons)
 
                if (type == AO_LISP_OTHER) {
                        type = ao_lisp_other_type(ao_lisp_poly_other(p));
+#if DBG_MEM
                        if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
                                ao_lisp_abort();
+#endif
                }
 
                lisp_type = ao_lisp_types[ao_lisp_poly_type(p)];
@@ -672,26 +648,29 @@ int
 ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref)
 {
        void            *addr = *ref;
-       int             size;
+       int             offset;
 
        if (!AO_LISP_IS_POOL(addr))
                return 1;
 
+       (void) type;
+
        MDBG_MOVE("move memory %d\n", MDBG_OFFSET(addr));
        addr = move_map(addr);
-       size = ao_lisp_size(type, addr);
        if (addr != *ref) {
                MDBG_MOVE("update ref %d %d -> %d\n",
                          AO_LISP_IS_POOL(ref) ? MDBG_OFFSET(ref) : -1,
                          MDBG_OFFSET(*ref), MDBG_OFFSET(addr));
                *ref = addr;
        }
-       if (!mark_object(ao_lisp_busy, addr, size)) {
-               MDBG_DO(ao_lisp_record(type, addr, size));
-               return 0;
+       offset = pool_offset(addr);
+       if (busy(ao_lisp_busy, offset)) {
+               MDBG_MOVE("already moved\n");
+               return 1;
        }
-       MDBG_MOVE("already moved\n");
-       return 1;
+       mark(ao_lisp_busy, offset);
+       MDBG_DO(ao_lisp_record(type, addr, ao_lisp_size(type, addr)));
+       return 0;
 }
 
 int
@@ -720,16 +699,14 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
        if (!p)
                return 1;
 
-       type = ao_lisp_poly_base_type(p);
        addr = ao_lisp_ref(p);
 
        if (!AO_LISP_IS_POOL(addr))
                return 1;
 
-       if (type == AO_LISP_CONS && do_note_cons) {
-//             addr = move_map(addr);
-               MDBG_DO(if (addr != move_map(addr)) MDBG_MOVE("noting cons at old addr %d instead of new addr %d\n", MDBG_OFFSET(addr), MDBG_OFFSET(move_map(addr))););
+       type = ao_lisp_poly_base_type(p);
 
+       if (type == AO_LISP_CONS && do_note_cons) {
                note_cons(addr);
                addr = move_map(addr);
                ret = 1;
@@ -738,8 +715,10 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
 
                if (type == AO_LISP_OTHER) {
                        type = ao_lisp_other_type(move_map(ao_lisp_poly_other(p)));
+#if DBG_MEM
                        if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
                                ao_lisp_abort();
+#endif
                }
 
                lisp_type = ao_lisp_types[type];
@@ -851,8 +830,6 @@ ao_lisp_alloc(int size)
 void
 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons)
 {
-       if (save_cons[id] != NULL)
-               ao_lisp_abort();
        save_cons[id] = cons;
 }
 
@@ -867,8 +844,6 @@ ao_lisp_cons_fetch(int id)
 void
 ao_lisp_string_stash(int id, char *string)
 {
-       if (save_cons[id] != NULL)
-               ao_lisp_abort();
        save_string[id] = string;
 }