Fix bug in error handling where __sub would be clobbered.
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 03b0e55..022fcc0 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -54,6 +54,10 @@
status_log(LISP, $(F))
@LISP_LIBRARY_PATH="$(lisp_libpath)" ./lisp $(F)
+repl: lisp
+ status_log(LISP, repl)
+ @LISP_LIBRARY_PATH="$(lisp_libpath)" ./lisp $(ROOT)/lib/lisp/repl/repl.lisp
+
leak-check: lisp
status_log(VALGRIND, lisp $(F))
@LISP_LIBRARY_PATH="$(lisp_libpath)" valgrind --leak-check=full ./lisp $(F)
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index e591ed3..5810f69 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -187,7 +187,7 @@
for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
{
- walk_and_alloc(&local, car(body_));
+ TRY(walk_and_alloc(env, &local, carref(body_)));
}
| setup (local.num_stack_entries);
@@ -269,11 +269,15 @@
OKAY();
}
-void walk_and_alloc(struct local *local, value_t body)
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp)
{
+ E_INIT();
+
+ value_t body = *bp;
+
// TODO: handle macros
if (!listp(body))
- return;
+ OKAY();
value_t args = cdr(body);
@@ -284,7 +288,7 @@
value_t expr = cdr(args);
for (; !nilp(expr); expr = cdr(expr))
{
- walk_and_alloc(local, car(expr));
+ walk_and_alloc(env, local, carref(expr));
}
local_free(local, slot);
@@ -293,15 +297,40 @@
{
// We don't want to walk the lambda because it's another function. When
// the lambda is compiled it will be walked.
- return;
+ OKAY();
}
else
{
- for (; !nilp(args); args = cdr(args))
+ // Is this a macro?
+
+ struct function *mac = NULL;
+
+ if (symbolp(car(body)))
+ mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG));
+ else
+ walk_and_alloc(env, local, carref(body));
+
+ if (mac && mac->namespace == NS_MACRO)
{
- walk_and_alloc(local, car(args));
+ unsigned char pool = push_pool(0);
+ value_t form = call_list(mac, args);
+ pop_pool(pool);
+
+ add_to_pool(form);
+ *bp = form;
+
+ walk_and_alloc(env, local, bp);
+ }
+ else
+ {
+ for (; !nilp(args); args = cdr(args))
+ {
+ walk_and_alloc(env, local, carref(args));
+ }
}
}
+
+ OKAY();
}
bool load(struct environment *env, char *path)
@@ -320,16 +349,31 @@
value_t val;
- while (IS_OKAY(read1(is, &val)))
+ struct error read_error;
+
+ while (IS_OKAY((read_error = read1(is, &val))))
{
if (!IS_OKAY(compile_tl(val, env, path)))
- break;
+ {
+ goto failure;
+ }
+ }
+
+ if (!read_error.safe_state)
+ {
+ goto failure;
}
del_fistream(is);
pop_pool(pop);
return true;
+
+failure:
+ del_fistream(is);
+ pop_pool(pool);
+
+ return false;
}
value_t load_relative(struct environment *env, char *to, value_t name)
@@ -411,6 +455,10 @@
TRY(compile_expression(env, local, car(args), false, Dst));
}
+ else if (symstreq(fsym, "unquote-splice"))
+ {
+
+ }
else
{
| push nil;
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 67c03e6..75abe33 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -166,7 +166,7 @@
/**
* Walk `body` and reserve space in `local` for any variable declarations.
*/
-void walk_and_alloc(struct local *local, value_t body);
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *body);
/**
* Compile a top level definition
diff --git a/src/lisp/error.c b/src/lisp/error.c
index 266f797..bb289e2 100644
--- a/src/lisp/error.c
+++ b/src/lisp/error.c
@@ -42,3 +42,12 @@
}
}
}
+
+void edebug(struct error err, char *file, int line, const char *func, const char *why)
+{
+ if (!err.safe_state)
+ {
+ fprintf(stderr, "\033[43m%s at\033[0m %s:%d %s\n", why, file, line, func);
+ ereport(err);
+ }
+}
diff --git a/src/lisp/error.h b/src/lisp/error.h
index d4c47e8..7f95870 100644
--- a/src/lisp/error.h
+++ b/src/lisp/error.h
@@ -37,56 +37,56 @@
char *message;
};
-#define E_INIT() \
- struct error __error; \
- __error.code = EOK; \
- __error.loc.line = 0; \
- __error.safe_state = false; \
- __error.message = NULL; \
- __error.loc.file = NULL;
-#define NEARVAL(val) \
- __error.loc.line = cons_line(val); \
- __error.loc.file = cons_file(val)
+#define E_DEBUG(_e, _m) // edebug(_e, __FILE__, __LINE__, __func__, _m)
+#define E_INIT() \
+ struct error __error = { 0 };
+#define NEARVAL(val) \
+ __error.loc.line = cons_line(val), \
+ __error.loc.file = cons_file(val)
#define NEARIS(is) (is)->getpos((is), &__error.loc.line, &__error.loc.file)
-#define _TRY(expr, m, c) \
- { \
- struct error __sub = (expr); \
- if (__sub.code) \
- { \
- if (!__sub.loc.file || !__sub.loc.line) \
- __sub.loc.file = __error.loc.file, \
- __sub.loc.line = __error.loc.line; \
- if (c) \
- __sub.code = c; \
- if (m) \
- __sub.message = m; \
- return __sub; \
- } \
+#define _TRY(expr, m, c) \
+ { \
+ struct error __sub = (expr); \
+ if (__sub.code) \
+ { \
+ if (!__sub.loc.file || !__sub.loc.line) \
+ __sub.loc.file = __error.loc.file, \
+ __sub.loc.line = __error.loc.line; \
+ if (c) \
+ __sub.code = c; \
+ char *__m = m; \
+ if (__m) \
+ __sub.message = __m; \
+ E_DEBUG(__sub, #expr); \
+ return __sub; \
+ } \
}
#define TRY(expr) _TRY(expr, NULL, 0)
#define TRY_ELSE(expr, c, ...) _TRY(expr, ehsprintf(__VA_ARGS__), c)
#define OKAY() return __error
-#define THROW(_c, ...) \
- { \
- __error.code = (_c); \
- __error.message = ehsprintf(__VA_ARGS__); \
- return __error; \
+#define THROW(_c, ...) \
+ { \
+ __error.code = (_c); \
+ __error.message = ehsprintf(__VA_ARGS__); \
+ E_DEBUG(__error, "throwing"); \
+ return __error; \
}
-#define THROWSAFE(_c) \
- { \
- __error.code = (_c); \
- __error.safe_state = true; \
- return __error; \
+#define THROWSAFE(_c) \
+ { \
+ __error.code = (_c); \
+ __error.safe_state = true; \
+ E_DEBUG(__error, "safe"); \
+ return __error; \
}
#define IS_OKAY(e) ((e).code == EOK)
-#define OKAY_IF(val) \
- { \
- struct error __sub = (val); \
- if (IS_OKAY(__sub)) \
- OKAY(); \
- if (!__sub.safe_state) \
- TRY(__sub) \
+#define OKAY_IF(val) \
+ { \
+ struct error __sub_of = (val); \
+ if (IS_OKAY(__sub_of)) \
+ OKAY(); \
+ if (!__sub_of.safe_state) \
+ TRY(__sub_of); \
}
#define WARN_UNUSED __attribute__((warn_unused_result))
@@ -96,3 +96,5 @@
char *ehsprintf(const char *msg, ...);
void ereport(struct error err);
+
+void edebug(struct error err, char *file, int line, const char *func, const char *why);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 5ad02bc..0a203b5 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -97,7 +97,7 @@
struct istream *is = new_stristream_nt(string);
value_t val = nil;
- struct error err;
+ struct error err = { 0 };
if (!IS_OKAY((err = read1(is, &val))))
{
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 64ab9ae..e8aed91 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -325,7 +325,8 @@
value_t wrapped;
NEARIS(is);
- TRY_ELSE(read1(is, &wrapped), EEXPECTED, "Expected a form after reader macro char %c", c);
+ struct error read_error = read1(is, &wrapped);
+ TRY_ELSE(read_error, EEXPECTED, "Expected a form after reader macro char %c", c);
value_t symbol = nil;
@@ -577,6 +578,15 @@
return pool != 0;
}
+void add_to_pool(value_t form)
+{
+ if (!heapp(form))
+ return;
+
+ struct alloc *a = (void *)(form & ~0b111);
+ a[-1].pool = current_pool;
+}
+
int cons_line(value_t val)
{
if (!consp(val))
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 430e526..eff35f9 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -147,6 +147,8 @@
*/
void pop_pool(unsigned char pool);
+void add_to_pool(value_t form);
+
/**
* @returns true if pool is still alive (in scope).
*/
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 07e6d4a..f78b3b1 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -20,10 +20,11 @@
goto done;
}
- value_t (*lisp_main)() = find_function(env, "main")->def0;
+ struct function *lisp_main_f = find_function(env, "main");
- if (lisp_main)
+ if (lisp_main_f)
{
+ value_t (*lisp_main)() = lisp_main_f->def0;
gc_set_base_here();
lisp_main();
}