add some debugging and test code

.github/workflows/check.yml

@@ -0,0 +1,30 @@
+name: run test file
+
+on:
+  push:
+    branches: ["main"]
+  pull_request:
+    branches: ["main"]
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v3
+    - name: install dependencies
+      run: make deps
+    - name: test
+      run: |
+        make test
+        CODE=$?
+        if [[ $CODE -eq 74 ]] then
+            echo ":watch: Test indicated TODO failure."
+            touch .todo_failure
+            exit 0
+        fi
+    - name: show files
+      run: make show
+    - name: check for leaks
+      run: |
+        if test -f .todo_failure; then exit 0; fi
+        make checkleaks

Makefile

@@ -19,8 +19,6 @@ clean:
 	rm -f pickletest32
 	rm -f vgcore.*
 
-test: buildtest64 valgrind64 buildtest32 valgrind32 clean
-
 deps:
 	sudo dpkg --add-architecture i386
 	sudo apt-get update

pickle.cpp

@@ -1,4 +1,5 @@
 #include "pickle.hpp"
+#include <cerrno>
 
 namespace pickle {
 
@@ -39,19 +40,26 @@ bool needs_escape(char c) {
     return strchr("{}\b\t\n\v\f\r\a\\\"", c) != NULL;
 }
 
-location::location() {}
+location::location() {
+    DBG("location::location() default: <anonymous>:1:1");
+}
 
 location::location(size_t line, size_t col, const char* name)
 : line(line),
   col(col),
-  name(name != NULL ? strdup(name) : NULL) {}
+  name(name != NULL ? strdup(name) : NULL) {
+    DBG("location::location() from parameters: %s:%zu:%zu", name, line, col);
+}
 
 location::location(const location* other)
 : line(other != NULL ? other->line : 1),
   col(other != NULL ? other->col : 1),
-  name(other != NULL && other->name != NULL ? strdup(other->name) : NULL) {}
+  name(other != NULL && other->name != NULL ? strdup(other->name) : NULL) {
+    DBG("location::location() from existing location: %s:%zu:%zu", this->name, this->line, this->col);
+}
 
 location::~location() {
+    DBG("location::~location()");
     free(this->name);
 }
 
@@ -71,6 +79,8 @@ static void finalize_metadata(object* self) {
 
 static void init_c_function(object* self, va_list args) {
     self->as_ptr = (void*)va_arg(args, func_ptr);
+    DBG("Function is eval(): %s", self->as_ptr == funcs::eval ? "true" : "false");
+    DBG("Function is parse(): %s", self->as_ptr == funcs::parse ? "true" : "false");
 }
 
 static int cmp_c_function(object* a, object* b) {
@@ -93,6 +103,8 @@ static void mark_function_partial(object* self) {
 static void init_string(object* self, va_list args) {
     self->cells = new cell[2];
     self->cells[0].as_ptr = (void*)strdup(va_arg(args, char*));
+    DBG("init_string: %s", (char*)self->cells[0].as_ptr);
+    self->cells[1].as_ptr = NULL; // preparsed holder
 }
 
 static int cmp_string(object* a, object* b) {
@@ -105,14 +117,15 @@ static void mark_string(object* self) {
 
 static void del_string(object* self) {
     free(self->cells[0].as_ptr);
-    delete self->cells;
+    delete[] self->cells;
 }
 
 const object_schema metadata_type("object_metadata", init_metadata, NULL, mark_metadata, finalize_metadata);
 const object_schema cons_type("cons", tinobsy::schema_functions::init_cons, cmp_c_function, tinobsy::schema_functions::mark_cons, tinobsy::schema_functions::finalize_cons);
 const object_schema partial_type("function_partial", init_function_partial, NULL, NULL, tinobsy::schema_functions::finalize_cons);
 const object_schema c_function_type("c_function", init_c_function, NULL, NULL, NULL);
 const object_schema string_type("string", init_string, cmp_string, mark_string, del_string);
+const object_schema symbol_type("symbol", tinobsy::schema_functions::init_str, tinobsy::schema_functions::cmp_str, NULL, tinobsy::schema_functions::finalize_str);
 
 object* pickle::cons_list(size_t len, ...) {
     va_list args;
@@ -121,7 +134,7 @@ object* pickle::cons_list(size_t len, ...) {
     object* tail;
     for (size_t i = 0; i < len; i++) {
         object* elem = va_arg(args, object*);
-        object* pair = this->allocate(&cons_type, elem, NULL);
+        object* pair = this->cons(elem, NULL);
         if (i == 0) head = tail = pair;
         else cdr(tail) = pair, tail = pair;
     }
@@ -136,7 +149,7 @@ object* pickle::append(object* l1, object* l2) {
     size_t i = 0;
     for (object* c1 = l1; c1 != NULL; c1 = cdr(c1), i++) {
         object* elem = car(c1);
-        object* pair = this->allocate(&cons_type, elem, NULL);
+        object* pair = this->cons(elem, NULL);
         if (i == 0) head = tail = pair;
         else cdr(tail) = pair, tail = pair;
     }
@@ -147,42 +160,50 @@ object* pickle::append(object* l1, object* l2) {
 
 void pickle::set_retval(object* args, object* env, object* cont, object* fail_cont) {
     if (cont == NULL) return; // No next continuation -> drop the result
-    object* thunk = this->allocate(&partial_type, cont->cells[0].as_obj, this->append(cont->cells[1].as_obj, args), env, cont->cells[3].as_obj, fail_cont);
+    object* thunk = this->make_partial(cont->cells[0].as_obj, this->append(cont->cells[1].as_obj, args), env, cont->cells[3].as_obj, fail_cont);
     this->do_later(thunk);
 }
 
 void pickle::set_failure(object* type, object* details, object* env, object* cont, object* fail_cont) {
     if (fail_cont == NULL) return; // No failure continuation -> ignore the error
     object* args = this->cons_list(3, type, details, cont);
-    object* thunk = this->allocate(&partial_type, fail_cont->cells[0].as_obj, this->append(fail_cont->cells[1].as_obj, args), env, fail_cont->cells[3].as_obj, fail_cont->cells[4].as_obj);
+    object* thunk = this->make_partial(fail_cont->cells[0].as_obj, this->append(fail_cont->cells[1].as_obj, args), env, fail_cont->cells[3].as_obj, fail_cont->cells[4].as_obj);
     this->do_later(thunk);
 }
 
 void pickle::do_later(object* thunk) {
-    object* cell = this->allocate(&cons_type, thunk, NULL);
-    cdr(this->queue_tail) = cell;
+    DBG("do_later: Adding cons to tail");
+    object* cell = this->cons(thunk, NULL);
+    if (this->queue_tail != NULL) cdr(this->queue_tail) = cell;
     this->queue_tail = cell;
     if (this->queue_head == NULL) this->queue_head = cell;
 }
 
 void pickle::do_next(object* thunk) {
-    this->queue_head = this->allocate(&cons_type, thunk, this->queue_head);
+    DBG("do_next");
+    this->queue_head = this->cons(thunk, this->queue_head);
 }
 
 void pickle::run_next_thunk() {
+    DBG("run_next_thunk");
+    if (this->queue_head == NULL) return;
     object* thunk = car(this->queue_head);
+    DBG("Have thunk");
     this->queue_head = cdr(this->queue_head);
+    if (this->queue_head == NULL) this->queue_tail = NULL;
     object* func = thunk->cells[0].as_obj;
+    DBG("Have func");
     if (func->schema == &c_function_type) {
-        ((func_ptr)(func->cells[0].as_ptr))(
+        DBG("Native function");
+        ((func_ptr)(func->as_ptr))(
             this,
             thunk->cells[1].as_obj,
             thunk->cells[2].as_obj,
             thunk->cells[3].as_obj,
             thunk->cells[4].as_obj);
     } else {
-        object* current_cont = this->allocate(
-            &partial_type,
+        DBG("Data function");
+        object* current_cont = this->make_partial(
             this->wrap_func(funcs::eval),
             this->cons_list(1, func), // args is ignored because they should already be added to env
             thunk->cells[2].as_obj,
@@ -197,40 +218,44 @@ void pickle::mark_globals() {
     this->queue_tail->mark(); // in case queue gets detached
 }
 
-object* pickle::wrap_func(func_ptr f) {
-    return this->allocate(&c_function_type, f);
-}
-
 object* pickle::wrap_string(const char* chs) {
     object* s = this->allocate(&string_type, chs);
-    if (s->cells[1].as_obj == NULL) // Not already pre-parsed
-        this->do_later(this->allocate(
-            &partial_type,
+    if (s->cells[1].as_obj == NULL) {// Interned but not already pre-parsed
+        DBG("Starting task to parse string %s", chs);
+        this->do_later(this->make_partial(
             this->wrap_func(funcs::parse),
             this->cons_list(1, s),
             NULL,
             NULL,
             NULL
         ));
+    }
     return s;
 }
 
 // Can be called by the program
 void funcs::parse(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
+    DBG("parsing");
     object* s = car(args);
     const char* str = (const char*)(s->cells[0].as_chars);
     object* result = s->cells[1].as_obj;
-    if (result != NULL) goto success; // Saved preparse
-    // insert magic parse here
+    if (result != NULL) { // Saved preparse
+        goto success;
+    }
+    TODO;
     success:
     runner->set_retval(runner->cons_list(1, result), env, cont, fail_cont);
     s->cells[1].as_obj = result; // Save parse for later if constantly reparsing string (i.e. a loop)
     return;
     failure:
-    runner->set_failure(runner->syntax_error_symbol, runner->cons_list(1, result), env, cont, fail_cont);
+    runner->set_failure(runner->wrap_symbol("SyntaxError"), runner->cons_list(1, result), env, cont, fail_cont);
     // TODO: copy error as cached parse result
 }
 
+static object* get_best_match(pickle* runner, object* ast, object** env) {
+    TODO;
+    return NULL;
+}
 
 // Eval(list) ::= apply_first_pattern(list), then eval(remaining list), else list if no patterns match
 void funcs::eval(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
@@ -240,18 +265,15 @@ void funcs::eval(pickle* runner, object* args, object* env, object* cont, object
     object* matched_pattern = get_best_match(runner, ast, &env);
     if (matched_pattern != NULL) {
         // do next is run body --> cont=apply match cont-> eval again -> original eval cont
-        runner->do_later(runner->allocate(
-            &partial_type,
-            matched_pattern->body(),
+        runner->do_later(runner->make_partial(
+            NULL,//matched_pattern->body(),
             NULL,
             env,
-            runner->allocate(
-                &partial_type,
+            runner->make_partial(
                 runner->wrap_func(funcs::splice_match),
-                runner->cons_list(2, runner->append(ast, NULL), matched_pattern->match_info()),
+                runner->cons_list(2, runner->append(ast, NULL), NULL/*matched_pattern->match_info()*/),
                 oldenv,
-                runner->allocate(
-                    &partial_type,
+                runner->make_partial(
                     runner->wrap_func(funcs::eval),
                     NULL,
                     oldenv,
@@ -269,6 +291,7 @@ void funcs::eval(pickle* runner, object* args, object* env, object* cont, object
 }
 
 void funcs::splice_match(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
+    TODO;
 }
 
 

pickle.hpp

@@ -38,6 +38,9 @@ extern const object_schema cons_type;
 extern const object_schema partial_type;
 extern const object_schema c_function_type;
 extern const object_schema string_type;
+extern const object_schema symbol_type;
+extern const object_schema stream_type;
+extern const object_schema error_type;
 
 class pickle : public tinobsy::vm {
     public:
@@ -50,8 +53,19 @@ class pickle : public tinobsy::vm {
     void do_later(object* thunk);
     void do_next(object* thunk);
     void run_next_thunk();
-    object* wrap_func(func_ptr f);
-    object* wrap_string(const char* s);
+    inline object* wrap_func(func_ptr f) {
+        return this->allocate(&c_function_type, f);
+    }
+    inline object* make_partial(object* func, object* args, object* env, object* continuation, object* failure_continuation) {
+        return this->allocate(&partial_type, func, args, env, continuation, failure_continuation);
+    }
+    object* wrap_string(const char* chs);
+    inline object* wrap_symbol(const char* symbol) {
+        return this->allocate(&symbol_type, symbol);
+    }
+    inline object* cons(object* car, object* cdr) {
+        return this->allocate(&cons_type, car, cdr);
+    }
     private:
     void mark_globals();
 };
@@ -68,6 +82,12 @@ namespace funcs {
 #define car(x) ((x)->cells[0].as_obj)
 #define cdr(x) ((x)->cells[1].as_obj)
 
+#ifdef TINOBSY_DEBUG
+#define TODO do { DBG("%s: %s", __func__, strerror(ENOSYS)); errno = ENOSYS; perror(__func__); exit(74); } while (0)
+#else
+#define TODO
+#endif
+
 #include "pickle.cpp"
 
 #endif

pickle_test.cpp

@@ -1,9 +1,29 @@
+#define TINOBSY_DEBUG
 #include "pickle.hpp"
 
 #include <cstdio>
+#include <csignal>
+
+void on_segfault(int signal, siginfo_t* info, void* arg) {
+    fprintf(stderr, "Segmentation fault at %p\n", info->si_addr);
+    DBG("Segmentation fault at %p", info->si_addr);
+    exit(255);
+}
+
+void start_catch_segfault() {
+    struct sigaction x = { 0 };
+    sigemptyset(&x.sa_mask);
+    x.sa_sigaction = on_segfault;
+    x.sa_flags = SA_SIGINFO;
+    sigaction(SIGSEGV, &x, NULL);
+}
 
 int main() {
-    // compilation test
+    start_catch_segfault();
+    auto vm = new pickle::pickle();
+    auto foo = vm->wrap_string("thisWillCauseASyntaxError");
+    vm->run_next_thunk();
     printf("hello world\n");
+    delete vm;
     return 0;
 }