altos/scheme: Use memory manager mark code to note recursive print

This flags any object being printed and checks before recursing to
avoid infinite loops.

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

diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index 48d0149bebacb263281eefb75cb5c31d964d514c..cc7f8f1d5600d4a2c4565c70b057228261d8daa2 100644 (file)
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -555,6 +555,21 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref);
 void *
 ao_scheme_alloc(int size);
 
+/* Marks an object as being printed, returns 1 if it was already marked */
+int
+ao_scheme_print_mark_addr(void *addr);
+
+int
+ao_scheme_print_mark_poly(ao_poly poly);
+
+/* Notes that printing has started */
+void
+ao_scheme_print_start(void);
+
+/* Notes that printing has ended */
+void
+ao_scheme_print_stop(void);
+
 #define AO_SCHEME_COLLECT_FULL         1
 #define AO_SCHEME_COLLECT_INCREMENTAL  0
 

diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c
index 912100a934297137c37160f55a88d11284a16c08..0b3cbf809dc08666427414f66da42a98b88d0e3c 100644 (file)
--- a/src/scheme/ao_scheme_cons.c
+++ b/src/scheme/ao_scheme_cons.c
@@ -181,16 +181,17 @@ ao_scheme_cons_write(ao_poly c)
        ao_poly                 cdr;
        int                     first = 1;
 
+       ao_scheme_print_start();
        printf("(");
        while (cons) {
                if (!first)
                        printf(" ");
-               ao_scheme_poly_write(cons->car);
-               cdr = cons->cdr;
-               if (cdr == c) {
-                       printf(" ...");
+               if (ao_scheme_print_mark_addr(cons)) {
+                       printf("...");
                        break;
                }
+               ao_scheme_poly_write(cons->car);
+               cdr = cons->cdr;
                if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
                        cons = ao_scheme_poly_cons(cdr);
                        first = 0;
@@ -201,6 +202,7 @@ ao_scheme_cons_write(ao_poly c)
                }
        }
        printf(")");
+       ao_scheme_print_stop();
 }
 
 void
@@ -209,13 +211,15 @@ ao_scheme_cons_display(ao_poly c)
        struct ao_scheme_cons   *cons = ao_scheme_poly_cons(c);
        ao_poly                 cdr;
 
+       ao_scheme_print_start();
        while (cons) {
-               ao_scheme_poly_display(cons->car);
-               cdr = cons->cdr;
-               if (cdr == c) {
+               if (ao_scheme_print_mark_addr(cons)) {
                        printf("...");
                        break;
                }
+               ao_scheme_poly_display(cons->car);
+
+               cdr = cons->cdr;
                if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
                        cons = ao_scheme_poly_cons(cdr);
                else {
@@ -223,6 +227,7 @@ ao_scheme_cons_display(ao_poly c)
                        cons = NULL;
                }
        }
+       ao_scheme_print_stop();
 }
 
 int

diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c
index 7f521863da513686dddf5f92539e4b9ff0e14e9c..3f4c91570548b79607f7d30d88ae78b98166aad7 100644 (file)
--- a/src/scheme/ao_scheme_frame.c
+++ b/src/scheme/ao_scheme_frame.c
@@ -41,7 +41,6 @@ frame_vals_mark(void *addr)
                          ao_scheme_poly_atom(v->atom)->name,
                          MDBG_OFFSET(ao_scheme_ref(v->atom)),
                          MDBG_OFFSET(ao_scheme_ref(v->val)), f);
-               MDBG_DO(ao_scheme_poly_write(v->val));
                MDBG_DO(printf("\n"));
        }
 }

diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c
index e7e89b89490ea902b81f23e92bebb987beefd305..c7d6b1f8c2f3c345e5d2305373c182d4f2794e5a 100644 (file)
--- a/src/scheme/ao_scheme_mem.c
+++ b/src/scheme/ao_scheme_mem.c
@@ -280,6 +280,10 @@ static const void ** const ao_scheme_cache[] = {
 
 #define AO_SCHEME_BUSY_SIZE    ((AO_SCHEME_POOL + 31) / 32)
 
+static int     ao_scheme_printing, ao_scheme_print_cleared;
+#if DBG_MEM
+static int     ao_scheme_collecting;
+#endif
 static uint8_t ao_scheme_busy[AO_SCHEME_BUSY_SIZE];
 static uint8_t ao_scheme_cons_note[AO_SCHEME_BUSY_SIZE];
 static uint8_t ao_scheme_cons_last[AO_SCHEME_BUSY_SIZE];
@@ -550,6 +554,7 @@ ao_scheme_collect(uint8_t style)
        MDBG_MOVE("collect %d\n", ao_scheme_collects[style]);
 #endif
        MDBG_DO(ao_scheme_frame_write(ao_scheme_frame_poly(ao_scheme_frame_global)));
+       MDBG_DO(++ao_scheme_collecting);
 
        ao_scheme_reset_stack();
 
@@ -681,6 +686,7 @@ ao_scheme_collect(uint8_t style)
 #if DBG_MEM_STACK
        fprintf(stderr, "max collect stack depth %lu\n", mem_collect_max_depth);
 #endif
+       MDBG_DO(--ao_scheme_collecting);
        return AO_SCHEME_POOL - ao_scheme_top;
 }
 
@@ -1021,3 +1027,53 @@ ao_scheme_frame_fetch(int id)
        save_frame[id] = NULL;
        return frame;
 }
+
+int
+ao_scheme_print_mark_addr(void *addr)
+{
+       int     offset;
+
+#if DBG_MEM
+       if (ao_scheme_collecting)
+               ao_scheme_abort();
+#endif
+
+       if (!AO_SCHEME_IS_POOL(addr))
+               return 1;
+
+       if (!ao_scheme_print_cleared) {
+               ao_scheme_print_cleared = 1;
+               memset(ao_scheme_busy, '\0', sizeof (ao_scheme_busy));
+       }
+       offset = pool_offset(addr);
+       if (busy(ao_scheme_busy, offset))
+               return 1;
+       mark(ao_scheme_busy, offset);
+       return 0;
+}
+
+int
+ao_scheme_print_mark_poly(ao_poly p)
+{
+       uint8_t type = ao_scheme_poly_base_type(p);
+
+       if (type == AO_SCHEME_INT)
+               return 1;
+       return ao_scheme_print_mark_addr(ao_scheme_ref(p));
+}
+
+/* Notes that printing has started */
+void
+ao_scheme_print_start(void)
+{
+       ao_scheme_printing++;
+}
+
+/* Notes that printing has ended */
+void
+ao_scheme_print_stop(void)
+{
+       ao_scheme_printing--;
+       if (ao_scheme_printing == 0)
+               ao_scheme_print_cleared = 0;
+}

diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c
index a4127f64d8b43635c86b423d5291cc1429e128c1..ff2067e25ba440fcbda5735421107f65817969a6 100644 (file)
--- a/src/scheme/ao_scheme_vector.c
+++ b/src/scheme/ao_scheme_vector.c
@@ -78,16 +78,19 @@ ao_scheme_vector_write(ao_poly v)
        struct ao_scheme_vector *vector = ao_scheme_poly_vector(v);
        unsigned int i;
 
-       printf("#(");
-       for (i = 0; i < vector->length; i++) {
-               if (i != 0)
-                       printf(" ");
-               if (vector->vals[i] == v)
-                       printf ("...");
-               else
+       ao_scheme_print_start();
+       if (ao_scheme_print_mark_addr(vector))
+               printf ("...");
+       else {
+               printf("#(");
+               for (i = 0; i < vector->length; i++) {
+                       if (i != 0)
+                               printf(" ");
                        ao_scheme_poly_write(vector->vals[i]);
+               }
+               printf(")");
        }
-       printf(")");
+       ao_scheme_print_stop();
 }
 
 void
@@ -96,10 +99,11 @@ ao_scheme_vector_display(ao_poly v)
        struct ao_scheme_vector *vector = ao_scheme_poly_vector(v);
        unsigned int i;
 
-       for (i = 0; i < vector->length; i++) {
-               if (vector->vals[i] == v)
-                       printf("...");
-               else
+       ao_scheme_print_start();
+       if (ao_scheme_print_mark_addr(vector))
+               printf ("...");
+       else {
+               for (i = 0; i < vector->length; i++)
                        ao_scheme_poly_display(vector->vals[i]);
        }
 }