Debug GC crashes, add (gc-stats), add support for libedit to lisp
diff --git a/src/libsys/sys.inc b/src/libsys/sys.inc
new file mode 100644
index 0000000..53c2666
--- /dev/null
+++ b/src/libsys/sys.inc
@@ -0,0 +1,2 @@
+%define SYS_GIVEUP 0x100
+%define SYS_INT 0x80
diff --git a/src/lisp/Jmk2 b/src/lisp/Jmk2
index e9f31b2..1f4e6b1 100644
--- a/src/lisp/Jmk2
+++ b/src/lisp/Jmk2
@@ -2,37 +2,39 @@
init lisp
-presets 32 debug warn nasm
-cflags -Ivendor/luajit/dynasm -O0
-
-option NO_READLINE 0
-
-srcs main.c lisp.c compiler.c lib/std.c plat/linux.c istream.c gc.c \
- call_list.s error.c
+# Make this `readline', `edit', or `none'
+option READLINE readline
set lisp_libpath "$::root/lib/lisp"
-if {$options(NO_READLINE) == 0} {
- cflags -lreadline
-} else {
+if {$options(READLINE) == "none"} {
cflags -DNO_READLINE
+} else {
+ cflags -L/usr/lib/i386-linux-gnu -l$options(READLINE)
}
-set lua vendor/luajit/src/host/minilua
+presets 32 debug warn nasm
+cflags -Ivendor/luajit/dynasm -O0
+asmflags -felf32
+
+set lua [pwd]/vendor/luajit/src/host/minilua
rule $lua ${lua}.c {
log CC $::src
cc "$::src -o $::target -lm"
}
-rule compiler.c "compiler.dasc $lua" {
+rule [pwd]/compiler.c "[pwd]/compiler.dasc $lua" {
log DYNASM $::first_src
shell "$::lua vendor/luajit/dynasm/dynasm.lua -o $::target $::first_src"
}
-rule repl lisp {
+rule repl [pwd]/lisp {
log LISP repl
shell "LISP_LIBRARY_PATH=$::lisp_libpath ./lisp $::root/lib/lisp/repl/repl.lisp"
}
+srcs main.c lisp.c compiler.c lib/std.c plat/linux.c istream.c gc.c \
+ call_list.s error.c
+
type executable
diff --git a/src/lisp/gc.c b/src/lisp/gc.c
index 9a9610d..06d8a07 100644
--- a/src/lisp/gc.c
+++ b/src/lisp/gc.c
@@ -4,6 +4,7 @@
value_t *gc_base;
THREAD_LOCAL static unsigned int gc_mark;
+THREAD_LOCAL static unsigned long gc_runs = 0;
void __attribute__((noinline)) gc_set_base_here()
{
@@ -20,6 +21,15 @@
void *pointer = (void *)(value & ~HEAP_MASK);
struct alloc *alloc = pointer - sizeof(struct alloc);
+ if (!pointer)
+ {
+ // TODO: Where are these coming from? Maybe this is a C
+ // stack variable that we are interpreting as beign in
+ // Lisp stack space on accident?
+ fprintf(stderr, "lisp:gc:warning: value %x is a null pointer\n", value);
+ return;
+ }
+
// Only recursively mark if this hasn't been marked yet. i.e. prevent
// marking circular references twice
if (alloc->mark != gc_mark)
@@ -64,6 +74,9 @@
{
for (struct alloc *a = first_a; a;)
{
+ // fprintf(stderr, "[ GC ] %s %p pool? %d\n", (a->mark != gc_mark) ? "Unmarked" : "Marked", a, pool_alive(a->pool));
+ // printval(alloc_to_value(a), 2);
+
if (pool_alive(a->pool) || a->mark == gc_mark)
{
// Marked or in living pool
@@ -71,6 +84,8 @@
}
else
{
+ fprintf(stderr, "[ GC ] freeing: ");
+ printval(alloc_to_value(a), 1);
// Free and remove from allocation list
struct alloc *p = a->prev, *n = a->next;
free_aligned(a);
@@ -86,6 +101,20 @@
}
}
+struct gc_stats gc_get_stats()
+{
+ struct gc_stats stats = {0};
+
+ stats.gc_runs = gc_runs;
+
+ for (struct alloc *a = first_a; a; a = a->next)
+ {
+ stats.total_allocs++;
+ }
+
+ return stats;
+}
+
void _do_gc(unsigned int esp, unsigned int ebp)
{
value_t *esp_p = (value_t *)esp,
@@ -94,6 +123,7 @@
unsigned int num_marked = 0;
gc_mark++;
+ gc_runs++;
// For every stack frame until the base of the stack
while (esp_p < gc_base)
diff --git a/src/lisp/gc.h b/src/lisp/gc.h
index 8623cba..789e124 100644
--- a/src/lisp/gc.h
+++ b/src/lisp/gc.h
@@ -5,6 +5,18 @@
// I hate this
extern value_t *gc_base;
+struct gc_stats
+{
+ // bytes currently used
+ unsigned long bytes_used;
+ // bytes ever freed by the GC
+ unsigned long bytes_freed;
+ // how many total allocations are currently alive
+ unsigned long total_allocs;
+ // how many times has the GC ever been run
+ unsigned long gc_runs;
+};
+
void gc_set_base_here();
value_t alloc_to_value(struct alloc *a);
@@ -12,3 +24,4 @@
void _mark(value_t value, unsigned int *marked);
void _sweep();
void free_all();
+struct gc_stats gc_get_stats();
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 224c086..1afe993 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -1,4 +1,5 @@
#include "std.h"
+#include "../gc.h"
#include "../plat/plat.h"
#include <stdlib.h>
#include <string.h>
@@ -98,7 +99,6 @@
value_t l_read_stdin()
{
-#ifndef NO_READLINE
char *string = read_input_line("lisp> ");
if (!string)
return nil;
@@ -122,9 +122,6 @@
free(string);
return val;
-#else
- return nil;
-#endif
}
value_t l_num_eq(value_t a, value_t b)
@@ -194,6 +191,15 @@
return first;
}
+value_t l_gc_stats()
+{
+ struct gc_stats stats = gc_get_stats();
+
+ return cons(intval(stats.total_allocs),
+ cons(intval(stats.gc_runs),
+ nil));
+}
+
#define LISP_PREDICATE(name) value_t l_##name(value_t v) { return name(v) ? t : nil; }
LISP_PREDICATE(listp)
@@ -235,6 +241,8 @@
add_c_function(env, "elt", l_elt, 2);
+ add_c_function(env, "gc-stats", l_gc_stats, 0);
+
if (!load_library(env, "std"))
{
fprintf(stderr, "Not found std\n");
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 64de5b9..e41ebff 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -112,7 +112,7 @@
/**
* Reserved for the GC.
*/
- unsigned int mark : 24; // + 2 = 16
+ unsigned int mark : 24; // + 3 = 16
// Whatever else
};
diff --git a/src/lisp/lispbugs b/src/lisp/lispbugs
new file mode 100644
index 0000000..67ac030
--- /dev/null
+++ b/src/lisp/lispbugs
@@ -0,0 +1,8 @@
+BUG: "random" segfault in lisp (gc) calls.
+
+Theory: the values we're walking on the stack are garbage, i.e. coming
+from C.
+
+Looks like the GCSegments code got lost, I need to readd that and it
+should fix this. `eval' in `compiler.dasc' is getting it's local
+variables inspected by _do_gc.
\ No newline at end of file
diff --git a/src/lisp/plat/linux.c b/src/lisp/plat/linux.c
index ad7f873..f3ad032 100644
--- a/src/lisp/plat/linux.c
+++ b/src/lisp/plat/linux.c
@@ -51,8 +51,12 @@
#ifndef NO_READLINE
return readline(prompt);
#else
- UNUSED(prompt);
- return "";
+ fprintf(stdout, "%s", prompt);
+ fflush(stdout);
+ char *buffer = malloc(512);
+ fgets(buffer, 512, stdin);
+
+ return buffer;
#endif
}
diff --git a/src/lisp/test-gc.lisp b/src/lisp/test-gc.lisp
new file mode 100644
index 0000000..a41e146
--- /dev/null
+++ b/src/lisp/test-gc.lisp
@@ -0,0 +1,11 @@
+(defun main ()
+ ;; Allocate some garbage
+ (let1 (used "this should NOT be freed")
+ (list 1 2 3 4)
+ (list "this" "is" "a" "list")
+ (gc)
+ (print (list "Current allocations" "GC runs"))
+ (print (gc-stats))))
+
+;; Note: This should print that it is freeing both lists, but not the
+;; string