Refactor files

src/stack.c

@@ -2,10 +2,11 @@
 
 #include "function.h"
 #include "hashtable.h"
-#include "lisp.h"
+#include "lisp_string.h"
 #include "list.h"
 #include "memory.h"
 #include "print.h"
+#include "symbol.h"
 
 #include <assert.h>
 #include <stdio.h>
@@ -278,6 +279,15 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
     }
 }
 
+void push_block_frame(LispVal *tag, jmp_buf *target,
+                      LispVal *volatile *value_ptr, StackFrame *unwind_to) {
+    StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_BLOCK);
+    frame->block.tag = tag;
+    frame->block.target = target;
+    frame->block.value_ptr = value_ptr;
+    frame->block.unwind_to = unwind_to;
+}
+
 void unwind_to(StackFrame *frame) {
     while (the_stack.depth && &the_stack.frames[the_stack.depth - 1] > frame) {
         StackFrame *restrict top = &the_stack.frames[--the_stack.depth];
@@ -366,61 +376,6 @@ noreturn void lisp_signal(LispVal *name, LispVal *data) {
     top_of_stack_exception_handler(name, data);
 }
 
-DEFSPECIAL(block, "block", (LispVal * name, LispVal *body), "(name &rest body)",
-           "") {
-    CHECK_TYPE(name, TYPE_SYMBOL);
-    if (!SYMBOLP(name))
-        CHECK_TYPE(name, TYPE_SYMBOL);
-    LispVal *volatile return_value = Qnil;
-    jmp_buf target;
-    StackFrame *stack_ref = LISP_STACK_REF();
-    LispVal *tag = Fmake_symbol(((LispSymbol *) name)->name);
-    LispVal *cur_tags = Fplist_get(Vlexical_environment, name, Qnil);
-    push_copy_lexenv();
-    new_lexical_variable(Qlexical_tags, CONS(CONS(name, tag), cur_tags));
-    StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_BLOCK);
-    frame->block.tag = tag;
-    frame->block.target = &target;
-    frame->block.value_ptr = &return_value;
-    frame->block.unwind_to = stack_ref;
-    if (setjmp(target) == 0) {
-        return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
-    } else {
-        // return-from handles unwinding and putting the return value in a local
-        // references frame
-        return return_value;
-    }
-}
-
-static LispVal *lookup_block_tag(LispVal *name) {
-    LispVal *tags = Fplist_get(Vlexical_environment, Qlexical_tags, Qnil);
-    LispVal *ent = Fassoc(name, tags, Qnil);
-    return CONSP(ent) ? XCDR(ent) : Qunbound;
-}
-
-DEFSPECIAL(return_from, "return-from", (LispVal * name, LispVal *value),
-           "(name &optional value)", "") {
-    CHECK_TYPE(name, TYPE_SYMBOL);
-    value = eval(value);
-    LispVal *tag = lookup_block_tag(name);
-    if (tag != Qunbound) {
-        for (ptrdiff_t i = the_stack.depth; i >= 0; --i) {
-            StackFrame *restrict frame = &the_stack.frames[i];
-            if (frame->kind == STACK_FRAME_BLOCK && EQ(frame->block.tag, tag)) {
-                add_local_reference(frame->block.unwind_to, value);
-                *frame->block.value_ptr = value;
-                unwind_to(frame->block.unwind_to);
-                longjmp(*frame->block.target, 1);
-            }
-        }
-        // block went out of scope
-        lisp_signal(Qblock_out_of_scope_error, LIST(name));
-    } else {
-        // block never existed
-        lisp_signal(Qno_such_block_error, LIST(name));
-    }
-}
-
 DEFUN(backtrace, "backtrace", (void), "()", "") {
     LispVal *out = Qnil;
     for (size_t i = 0; i < the_stack.depth; ++i) {