better error handliung

src/chunk.c

@@ -32,6 +32,7 @@ V chunk_release(Bc *chunk) {
 #if CHUNK_DEBUG
     fprintf(stderr, "DEBUG: freeing chunk %s at %p\n", chunk->name, (V *)chunk);
 #endif
+    yar_free(&chunk->lines);
     yar_free(&chunk->constants);
     yar_free(chunk);
     free(chunk);

src/compile.c

@@ -42,6 +42,7 @@ struct {
   {">",    {OP_GT, 0}},
   {"<=",   {OP_LTE, 0}},
   {">=",   {OP_GTE, 0}},
+  {".",    {OP_PPRINT, 0}},
   {NULL,   {0}},
 };
 // clang-format on
@@ -144,6 +145,8 @@ static I compile_call(Cm *cm, const char *name, I line, I col) {
 static I compile_command(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
   curr = mpc_ast_traverse_next(next);
   const char *name = curr->contents;
+  I name_line = curr->state.row;
+  I name_col = curr->state.col;
   (void)mpc_ast_traverse_next(next);
   curr = mpc_ast_traverse_next(next);
   while (curr != NULL) {
@@ -154,7 +157,7 @@ static I compile_command(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
       return 0;
     curr = mpc_ast_traverse_next(next);
   }
-  compile_call(cm, name, curr->state.row, curr->state.col);
+  compile_call(cm, name, name_line, name_col);
   return 1;
 }
 

src/debug.c

@@ -40,6 +40,15 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
     putchar(' ');
   fflush(stdout);
   printf("%04zu ", offset);
+
+  I col = -1;
+  I line = chunk_get_line(chunk, offset, &col);
+  if (line >= 0) {
+    printf("%4ld:%-3ld ", line + 1, col + 1);
+  } else {
+    printf("        ");
+  }
+
   U8 opcode = chunk->items[offset++];
 
 #define CASE(name) case OP_##name:
@@ -157,6 +166,7 @@ static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
     SIMPLE(GT);
     SIMPLE(LTE);
     SIMPLE(GTE);
+    SIMPLE(PPRINT);
   default:
     printf("??? (%d)\n", opcode);
     return offset;

src/object.h

@@ -29,6 +29,12 @@ typedef struct Hd {
   U32 size, type;
 } Hd;
 
+/** String */
+typedef struct Str {
+  Z len;
+  char data[];
+} Str;
+
 I type(O);
 
 #endif

src/vm.c

@@ -1,3 +1,4 @@
+#include <setjmp.h>
 #include <stdio.h>
 
 #include "arena.h"
@@ -53,38 +54,59 @@ V vm_deinit(Vm *vm) {
   vm->dictionary = NULL;
 }
 
-V vm_push(Vm *vm, O o) { *vm->sp++ = o; }
+static V vm_error(Vm *vm, I error, const char *message) {
+  I col = -1;
+  I line = chunk_get_line(vm->chunk, vm->ip - vm->chunk->items, &col);
+  fprintf(stderr, "error at %ld:%ld: %s\n", line + 1, col + 1, message);
+  longjmp(vm->error, error);
+}
+
+V vm_push(Vm *vm, O o) {
+  if (vm->sp >= vm->stack + STACK_SIZE)
+    vm_error(vm, VM_ERR_STACK_OVERFLOW, "data stack overflow");
+  *vm->sp++ = o;
+}
 O vm_pop(Vm *vm) {
+  if (vm->sp <= vm->stack)
+    vm_error(vm, VM_ERR_STACK_UNDERFLOW, "data stack underflow");
   O o = *--vm->sp;
   *vm->sp = NIL;
   return o;
 }
-O vm_peek(Vm *vm) { return *(vm->sp - 1); }
 
-V vm_rtpush(Vm *vm, O o) { *vm->tsp++ = o; }
+V vm_tpush(Vm *vm, O o) {
-O vm_rtpop(Vm *vm) {
+  if (vm->tsp >= vm->tstack + STACK_SIZE)
+    vm_error(vm, VM_ERR_STACK_OVERFLOW, "retain stack overflow");
+  *vm->tsp++ = o;
+}
+O vm_tpop(Vm *vm) {
+  if (vm->tsp <= vm->tstack)
+    vm_error(vm, VM_ERR_STACK_UNDERFLOW, "retain stack underflow");
   O o = *--vm->tsp;
   *vm->tsp = NIL;
   return o;
 }
 
 V vm_rpush(Vm *vm, Bc *chunk, U8 *ip) {
+  if (vm->rsp >= vm->rstack + STACK_SIZE)
+    vm_error(vm, VM_ERR_STACK_OVERFLOW, "return stack overflow");
   vm->rsp->chunk = chunk;
   vm->rsp->ip = ip;
   vm->rsp++;
 }
-Fr vm_rpop(Vm *vm) { return *--vm->rsp; }
+Fr vm_rpop(Vm *vm) {
-
+  if (vm->rsp <= vm->rstack)
-static I vm_error(Vm *vm, const char *message) {
+    vm_error(vm, VM_ERR_STACK_UNDERFLOW, "return stack underflow");
-  I col = -1;
+  return *--vm->rsp;
-  I line = chunk_get_line(vm->chunk, vm->ip - vm->chunk->items, &col);
-
-  fprintf(stderr, "error at %ld:%ld: %s\n", line + 1, col + 1, message);
-  return 0;
 }
 
 I vm_run(Vm *vm, Bc *chunk, I offset) {
   I mark = gc_mark(&vm->gc);
+  if (setjmp(vm->error) != 0) {
+    gc_reset(&vm->gc, mark);
+    return 0;
+  }
+
   for (Z i = 0; i < chunk->constants.count; i++)
     gc_addroot(&vm->gc, &chunk->constants.items[i]);
 
@@ -93,7 +115,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
     O b = vm_pop(vm);                                                          \
     O a = vm_pop(vm);                                                          \
     if (!IMM(a) || !IMM(b))                                                    \
-      return vm_error(vm, "arithmetic on non-numeric objects");                \
+      vm_error(vm, VM_ERR_TYPE, "arithmetic on non-numeric objects");          \
     vm_push(vm, NUM(ORD(a) op ORD(b)));                                        \
     break;                                                                     \
   }
@@ -103,7 +125,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
     O b = vm_pop(vm);                                                          \
     O a = vm_pop(vm);                                                          \
     if (!IMM(a) || !IMM(b))                                                    \
-      return vm_error(vm, "comparison on non-numeric objects");                \
+      vm_error(vm, VM_ERR_TYPE, "comparison on non-numeric objects");          \
     vm_push(vm, (ORD(a) op ORD(b)) ? NUM(1) : NIL);                            \
     break;                                                                     \
   }
@@ -178,11 +200,11 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       break;
     }
     case OP_TOR: {
-      vm_rtpush(vm, vm_pop(vm));
+      vm_tpush(vm, vm_pop(vm));
       break;
     }
     case OP_FROMR: {
-      vm_push(vm, vm_rtpop(vm));
+      vm_push(vm, vm_tpop(vm));
       break;
     }
     case OP_JUMP: {
@@ -206,7 +228,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       I hash = decode_sleb128(&vm->ip);
       Dt *word = lookup_hash(&vm->dictionary, hash);
       if (!word)
-        return vm_error(vm, "word not found");
+        vm_error(vm, VM_ERR_RUNTIME, "word not found");
       vm_rpush(vm, vm->chunk, vm->ip);
       vm->chunk = word->chunk;
       vm->ip = word->chunk->items;
@@ -221,13 +243,12 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
         vm->chunk = chunk;
         vm->ip = chunk->items;
       } else {
-        return vm_error(vm, "attempt to apply non-quotation object");
+        vm_error(vm, VM_ERR_TYPE, "attempt to apply non-quotation object");
       }
       break;
     }
     case OP_TAIL_CALL: {
       I ofs = decode_sleb128(&vm->ip);
-      // Tail call: reuse current frame, just jump
       vm->ip = chunk->items + ofs;
       break;
     }
@@ -235,8 +256,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       I hash = decode_sleb128(&vm->ip);
       Dt *word = lookup_hash(&vm->dictionary, hash);
       if (!word)
-        return vm_error(vm, "word not found");
+        vm_error(vm, VM_ERR_RUNTIME, "word not found");
-      // Tail call: reuse current frame
       vm->chunk = word->chunk;
       vm->ip = word->chunk->items;
       break;
@@ -246,11 +266,10 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       if (type(quot) == TYPE_QUOT) {
         Bc **ptr = (Bc **)(UNBOX(quot) + 1);
         Bc *chunk = *ptr;
-        // Tail call: reuse current frame
         vm->chunk = chunk;
         vm->ip = chunk->items;
       } else {
-        return vm_error(vm, "attempt to apply non-quotation object\n");
+        vm_error(vm, VM_ERR_TYPE, "attempt to apply non-quotation object\n");
       }
       break;
     }
@@ -260,7 +279,7 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
         vm->chunk = frame.chunk;
         vm->ip = frame.ip;
       } else {
-        goto done;
+        return 1;
       }
       break;
     case OP_CHOOSE: {
@@ -296,20 +315,14 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
       CMPOP(<=);
     case OP_GTE:
       CMPOP(>=);
+    case OP_PPRINT: {
+      O obj = vm_pop(vm);
+      println(obj);
+      break;
+    }
     default:
-      vm_error(vm, "unknown opcode");
+      vm_error(vm, VM_ERR_RUNTIME, "unknown opcode");
-      return 0;
     }
   }
-
-done:
-  gc_reset(&vm->gc, mark);
-  if (vm->sp != vm->stack) {
-    for (O *i = vm->stack; i < vm->sp; i++) {
-      print(*i);
-      putchar(' ');
-    }
-    putchar('\n');
-  }
   return 1;
 }

src/vm.h

@@ -8,6 +8,7 @@
 #include "dictionary.h"
 #include "gc.h"
 #include "object.h"
+#include <setjmp.h>
 
 enum {
   OP_NOP = 0,
@@ -62,14 +63,17 @@ typedef struct Vm {
   Bc *chunk;
   Dt *dictionary;
   Ar arena;
+  jmp_buf error;
 } Vm;
 
+enum {
+  VM_ERR_STACK_OVERFLOW = 1,
+  VM_ERR_STACK_UNDERFLOW,
+  VM_ERR_TYPE,
+  VM_ERR_RUNTIME
+};
+
 V vm_init(Vm *);
 V vm_deinit(Vm *);
-
-V vm_push(Vm *, O);
-O vm_pop(Vm *);
-O vm_peek(Vm *);
-
 I vm_run(Vm *, Bc *, I);
 #endif

test.grr

@@ -6,4 +6,4 @@ def fib/aux {
 }
 def fib { 0 1 fib/aux }
 
-[ 50 fib ] call
+[ 50 fib ] call .