ref: 9a1bca556796f44f573e7c4b31168e6c54f0e04e
parent: e58eace5b4c5f50e1e1a9b6dd0f8e04122478512
author: Jan-Willem Maessen <jmaessen@fb.com>
date: Wed Jan 31 05:27:37 EST 2024
Use pointer stack for GC This eliminates direct recursion in the GC in favor of using the pointer stack. I did some measurements to make sure I got apps the right way round - the stack overflows, fast, if you bootstrap the other way. This seems to be a bit faster based on bootstrapped timings.
--- a/Makefile
+++ b/Makefile
@@ -100,7 +100,7 @@
#
timecachecompile: bin/mhs
@-rm -f .mhscache
- bin/mhs -CW AllOfLib
+ time bin/mhs +RTS -v -RTS -CW AllOfLib
time bin/mhs +RTS -v -RTS -CR -isrc MicroHs.Main
#
--- a/generated/mhs.c
+++ b/generated/mhs.c
@@ -4660,7 +4660,7 @@
75,32,64,32,64,32,64,32,75,32,64,32,64,32,110,111,77,97,116,99,
104,32,102,114,111,109,85,84,70,56,32,34,115,114,99,47,77,105,99,114,
111,72,115,47,84,121,112,101,67,104,101,99,107,46,104,115,34,32,64,32,
-64,32,35,49,50,48,52,32,64,32,35,50,53,32,64,32,64,32,64,32,
+64,32,35,49,50,48,51,32,64,32,35,50,53,32,64,32,64,32,64,32,
64,32,64,32,64,32,66,32,95,49,48,55,53,32,64,32,95,53,57,32,
95,56,49,49,32,64,32,64,32,64,32,64,32,64,32,64,32,64,32,64,
32,95,52,56,54,32,64,32,64,32,83,39,32,66,32,64,32,66,39,32,
@@ -4673,7 +4673,7 @@
64,32,64,32,64,32,65,32,64,32,64,32,110,111,77,97,116,99,104,32,
102,114,111,109,85,84,70,56,32,34,115,114,99,47,77,105,99,114,111,72,
115,47,84,121,112,101,67,104,101,99,107,46,104,115,34,32,64,32,64,32,
-35,49,50,48,51,32,64,32,35,50,53,32,64,32,64,32,64,32,64,32,
+35,49,50,48,50,32,64,32,35,50,53,32,64,32,64,32,64,32,64,32,
64,32,64,32,64,32,95,50,55,52,32,83,32,80,32,75,50,32,75,32,
64,32,64,32,75,50,32,75,32,64,32,64,32,64,32,90,32,90,32,67,
32,79,32,64,32,75,32,64,32,64,32,64,32,64,32,64,32,64,32,64,
@@ -5269,7 +5269,7 @@
64,32,64,32,90,32,75,32,64,32,64,32,64,32,75,32,64,32,64,32,
110,111,77,97,116,99,104,32,102,114,111,109,85,84,70,56,32,34,115,114,
99,47,77,105,99,114,111,72,115,47,84,121,112,101,67,104,101,99,107,46,
-104,115,34,32,64,32,64,32,35,49,48,56,54,32,64,32,35,50,53,32,
+104,115,34,32,64,32,64,32,35,49,48,56,53,32,64,32,35,50,53,32,
64,32,64,32,64,32,64,32,64,32,64,32,67,39,32,95,49,48,55,53,
32,64,32,95,53,57,32,95,56,49,49,32,64,32,64,32,64,32,64,32,
64,32,64,32,64,32,66,32,66,32,66,32,66,32,66,32,66,32,95,50,
@@ -6870,7 +6870,7 @@
64,32,35,50,49,32,64,32,64,32,110,111,77,97,116,99,104,32,102,114,
111,109,85,84,70,56,32,34,115,114,99,47,77,105,99,114,111,72,115,47,
84,121,112,101,67,104,101,99,107,46,104,115,34,32,64,32,64,32,35,49,
-56,54,51,32,64,32,35,49,55,32,64,32,64,32,64,32,64,32,64,32,
+56,54,50,32,64,32,35,49,55,32,64,32,64,32,64,32,64,32,64,32,
64,32,66,32,66,32,66,32,85,32,64,32,64,32,64,32,66,32,66,32,
66,32,67,39,32,83,39,32,95,48,32,95,52,57,57,32,64,32,64,32,
64,32,95,56,51,55,32,64,32,64,32,64,32,64,32,66,32,66,32,66,
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -267,7 +267,7 @@
*/
struct ioarray {struct ioarray *next; /* all ioarrays are linked together */
- int marked; /* marked during GC */
+ size_t marked; /* marked during GC */
size_t size; /* number of elements in the array */
NODEPTR array[1]; /* actual size may be bigger */
};
@@ -419,6 +419,18 @@
free_map[i / BITS_PER_WORD] &= ~(1ULL << (i % BITS_PER_WORD));
}
+/* Set FREE bit to 1, used to undo marking in GC */
+static INLINE void mark_unused(NODEPTR n)
+{+ heapoffs_t i = LABEL(n);
+#if SANITY
+ if (i < heap_start)
+ ERR("Unmarking invalid heap address.");+ if (i >= free_map_nwords * BITS_PER_WORD) ERR("mark_used");+#endif
+ free_map[i / BITS_PER_WORD] |= 1ULL << (i % BITS_PER_WORD);
+}
+
/* Test if FREE bit is 0 */
static INLINE int is_marked_used(NODEPTR n)
{@@ -736,16 +748,18 @@
#endif
//counter_t mark_depth;
+//counter_t max_mark_depth = 0;
/* Mark all used nodes reachable from *np */
void
mark(NODEPTR *np)
{+ stackptr_t stk = stack_ptr;
NODEPTR n;
+ NODEPTR *to_push;
#if GCRED
value_t val;
#endif
- size_t i;
enum node_tag tag;
// mark_depth++;
@@ -778,86 +792,111 @@
if (n < cells || n > cells + heap_size)
ERR("bad n"); if (is_marked_used(n)) {- // mark_depth--;
- return;
+ goto fin;
}
num_marked++;
mark_used(n);
+ switch (tag) {#if GCRED
- if (want_gc_red) {- /* This is really only fruitful just after parsing. It can be removed. */
- if (tag == T_AP && GETTAG(FUN(n)) == T_AP && GETTAG(FUN(FUN(n))) == T_A) {- /* Do the A x y --> y reduction */
- NODEPTR y = ARG(n);
+ case T_INT:
+#if INTTABLE
+ if (LOW_INT <= (val = GETVALUE(n)) && val < HIGH_INT) {SETTAG(n, T_IND);
- INDIR(n) = y;
- red_a++;
+ INDIR(n) = intTable[val - LOW_INT];
+ red_int++;
goto top;
}
+ break;
+#endif /* INTTABLE */
+ case T_AP:
+ if (want_gc_red) {+ /* This is really only fruitful just after parsing. It can be removed. */
+ if (GETTAG(FUN(n)) == T_AP && GETTAG(FUN(FUN(n))) == T_A) {+ /* Do the A x y --> y reduction */
+ NODEPTR y = ARG(n);
+ SETTAG(n, T_IND);
+ INDIR(n) = y;
+ red_a++;
+ goto top;
+ }
#if 0
- /* This never seems to happen */
- if (tag == T_AP && GETTAG(FUN(n)) == T_AP && GETTAG(FUN(FUN(n))) == T_K) {- /* Do the K x y --> x reduction */
- NODEPTR x = ARG(FUN(n));
- SETTAG(n, T_IND);
- INDIR(n) = x;
- red_k++;
- goto top;
- }
+ /* This never seems to happen */
+ if (GETTAG(FUN(n)) == T_AP && GETTAG(FUN(FUN(n))) == T_K) {+ /* Do the K x y --> x reduction */
+ NODEPTR x = ARG(FUN(n));
+ SETTAG(n, T_IND);
+ INDIR(n) = x;
+ red_k++;
+ goto top;
+ }
#endif /* 0 */
- if (tag == T_AP && GETTAG(FUN(n)) == T_I) {- /* Do the I x --> x reduction */
- NODEPTR x = ARG(n);
- SETTAG(n, T_IND);
- INDIR(n) = x;
- red_i++;
- goto top;
- }
+ if (GETTAG(FUN(n)) == T_I) {+ /* Do the I x --> x reduction */
+ NODEPTR x = ARG(n);
+ SETTAG(n, T_IND);
+ INDIR(n) = x;
+ red_i++;
+ goto top;
+ }
#if 1
- /* This is broken.
- * Probably because it can happen in the middle of the C reduction code.
- */
- if (tag == T_AP && GETTAG(FUN(n)) == T_C) {- NODEPTR q = ARG(n);
- enum node_tag tt, tf;
- while ((tt = GETTAG(q)) == T_IND)
- q = INDIR(q);
- if ((tf = flip_ops[tt])) {- /* Do the C op --> flip_op reduction */
- // PRINT("%s -> %s\n", tag_names[tt], tag_names[tf]);- SETTAG(n, T_IND);
- INDIR(n) = HEAPREF(tf);
- red_flip++;
- return;
- goto top;
+ /* This is broken.
+ * Probably because it can happen in the middle of the C reduction code.
+ */
+ if (GETTAG(FUN(n)) == T_C) {+ NODEPTR q = ARG(n);
+ enum node_tag tt, tf;
+ while ((tt = GETTAG(q)) == T_IND)
+ q = INDIR(q);
+ if ((tf = flip_ops[tt])) {+ /* Do the C op --> flip_op reduction */
+ // PRINT("%s -> %s\n", tag_names[tt], tag_names[tf]);+ SETTAG(n, T_IND);
+ INDIR(n) = HEAPREF(tf);
+ red_flip++;
+ goto fin;
+ }
+ }
}
- }
- }
#endif
-#if INTTABLE
- if (tag == T_INT && LOW_INT <= (val = GETVALUE(n)) && val < HIGH_INT) {- SETTAG(n, T_IND);
- INDIR(n) = intTable[val - LOW_INT];
- red_int++;
- goto top;
- }
-#endif /* INTTABLE */
+#else /* GCRED */
+ case T_AP:
#endif /* GCRED */
- if (tag == T_AP) {- mark(&FUN(n));
- np = &ARG(n);
- goto top; /* Avoid tail recursion */
- } else if (tag == T_ARR) {- struct ioarray *arr = ARR(n);
- /* It really should never happen that we encounter a marked
- * array, since the parent is marked.
- */
- if (!arr->marked) {- arr->marked = 1;
- for(i = 0; i < arr->size; i++)
- mark(&arr->array[i]);
+ /* Avoid tail recursion */
+ np = &FUN(n);
+ to_push = &ARG(n);
+ break;
+ case T_ARR:
+ {+ struct ioarray *arr = ARR(n);
+
+ // arr->marked records marking progress through arr.
+ if (arr->marked >= arr->size) {+ goto fin;
+ }
+ // We unmark the array as a whole and push it as long
+ // as there's more entries to scan.
+ mark_unused(n);
+ to_push = np;
+ np = &arr->array[arr->marked++];
+ break;
}
+ default: goto fin;
}
+ if (!is_marked_used(*to_push)) {+ // mark_depth++;
+ PUSH((NODEPTR)to_push);
+ }
+ goto top;
+ fin:
+ // if (mark_depth > max_mark_depth) {+ // max_mark_depth = mark_depth;
+ // }
+ // mark_depth--;
+ if (stack_ptr > stk) {+ np = (NODEPTR *)POPTOP();
+ goto top;
+ }
+ return;
}
/* Perform a garbage collection:
@@ -2988,6 +3027,7 @@
PRINT("%"PCOMMA"15"PRIcounter" reductions (%"PCOMMA".1f Mred/s)\n", num_reductions, num_reductions / ((double)run_time / 1000) / 1000000); PRINT("%"PCOMMA"15"PRIcounter" array alloc\n", num_arr_alloc); PRINT("%"PCOMMA"15"PRIcounter" array free\n", num_arr_free);+ // PRINT("%"PCOMMA"15"PRIcounter" max mark depth\n", max_mark_depth); PRINT("%15.2fs total expired time\n", (double)run_time / 1000); PRINT("%15.2fs total gc time\n", (double)gc_mark_time / 1000);#if GCRED
--
⑨