#include #include #include #include #include #include #include #include "gc.h" #include "builtin.h" #include "interp.h" #include "reader.h" #ifdef HAVE_MOD_IO # include "mods/mod_io.h" #endif static void test_builtins(void); static void test_weak_boxes_and_wills(void); static void test_garbage_collection(bool keep_going); static void test_reader(void); static inline void comma(void) { fputs(", ", stdout); } static inline void nl(void) { putchar('\n'); } void out_of_memory(void) { fprintf(stderr, "Out of memory!\n\n"); print_gc_stats(); abort(); } int main(int argc, char **argv) { srand((unsigned int)time(NULL)); #ifdef __linux__ { FILE *f = fopen("/dev/urandom", "rb"); if (f) { unsigned int seed; if (fread(&seed, sizeof(seed), 1, f)==1) srand(seed); fclose(f); } } #endif gc_init(6*1024*1024, 10*1024*1024, 16*1024*1024); builtin_init(); interpreter_init(); #ifdef HAVE_MOD_IO mod_io_init(); #endif if (argc < 2 || (strcmp(argv[1], "-t") == 0) || (strcmp(argv[1], "--test") == 0)) { test_builtins(); test_weak_boxes_and_wills(); test_garbage_collection(false); } else if ((strcmp(argv[1], "-b") == 0) || (strcmp(argv[1], "--burn-in") == 0)) { test_garbage_collection(true); } else if ((strcmp(argv[1], "-r") == 0) || (strcmp(argv[1], "--reader") == 0)) { test_reader(); } else { gc_root_t argv_root; value_t program; value_t results; register_gc_root(&argv_root, NIL); /* Construct list backward, so that we don't have to reverse it. */ for (int i = argc - 1; i >= 2; --i) { value_t temp = string_to_value(argv[i]); argv_root.value = cons(temp, argv_root.value); } program = read_value_from_path(argv[1]); unregister_gc_root(&argv_root); results = run_interpreter(program, argv_root.value); for (value_t result = results; !is_nil(result); result = _CDR(result)) { print_value(CAR(result)); nl(); } { const char *p = getenv("GC_STATS"); if (p && atoi(p)) { nl(); fflush(stdout); fprint_gc_stats(stderr); } } } return 0; } static void test_builtins(void) { print_value(lookup_builtin(BI_STRUCTURE)); nl(); nl(); print_value(lookup_builtin(BI_TEMPLATE)); nl(); nl(); print_value(lookup_builtin(BI_LAMBDA)); nl(); nl(); } static void print_weak_box_results(value_t box) { value_t v, f; print_value(box); comma(); get_next_finalizer(&v, &f); print_value(v); comma(); print_value(f); nl(); } static void test_weak_boxes_and_wills(void) { gc_root_t box_root, tmp_root; register_gc_root(&box_root, UNDEFINED); register_gc_root(&tmp_root, UNDEFINED); tmp_root.value = cons(fixnum_value(1), cons(fixnum_value(2), NIL)); box_root.value = make_weak_box(tmp_root.value); register_finalizer(tmp_root.value, fixnum_value(10)); print_weak_box_results(box_root.value); collect_garbage(0); print_weak_box_results(box_root.value); tmp_root.value = UNDEFINED; print_weak_box_results(box_root.value); collect_garbage(0); print_weak_box_results(box_root.value); collect_garbage(0); print_weak_box_results(box_root.value); nl(); unregister_gc_root(&box_root); unregister_gc_root(&tmp_root); } static void test_garbage_collection(bool keep_going) { gc_root_t root; gc_root_t root2; int count = 0; register_gc_root(&root, NIL); register_gc_root(&root2, NIL); /* Construct a large, static tree w/ many links. */ for (int i = 0; i < 1000000; ++i) { root2.value = cons(root2.value, root2.value); } while (1) { int r = rand() & 0x1ffff; if (r == 0) { root.value = fixnum_value(rand()); } else { switch (r & 15) { case 0: root.value = cons(fixnum_value(rand()), root.value); break; case 1: root.value = cons(root.value, make_byte_string(256, '\0')); break; case 2: root.value = make_box(root.value); break; case 3: root.value = cons(root.value, cons(fixnum_value(-1), NIL)); _CDDR(root.value) = root.value; WRITE_BARRIER(_CDR(root.value)); break; case 4: { value_t s = make_vector(4, FALSE_VALUE); _get_vector(s)->elements[r & 3] = root.value; root.value = s; } break; default: (void)cons(make_box(NIL), cons(NIL, cons(NIL, NIL))); break; } } if (++count >= 80000000) { print_gc_stats(); nl(); clear_gc_stats(); count = 0; if (!keep_going) break; } } unregister_gc_root(&root); unregister_gc_root(&root2); } static void test_reader(void) { value_t v; do { fputs("> ", stdout); fflush(stdout); v = read_value_from_file(stdin); print_value(v); nl(); nl(); } while (v != NIL); } /* vim:set sw=2 expandtab: */