A lot of work

src/base.c

@@ -21,8 +21,8 @@ void *lisp_alloc_object(size_t size, LispValType type) {
     assert(size >= sizeof(LispObject));
     LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size);
     obj->type = type;
-    obj->gc.immortal = false;
     obj->gc.mark = false;
+    obj->gc.local_ref_count = 0;
     // TODO set the below
     obj->gc.entry = NULL;
     return obj;

src/base.h

@@ -97,8 +97,18 @@ typedef struct {
     ObjectGCInfo gc;
 } LispObject;
 
-static ALWAYS_INLINE void MAKE_OBJ_IMMORTAL(LispVal *obj) {
-    ((LispObject *) obj)->gc.immortal = true;
+static ALWAYS_INLINE bool OBJECTP(LispVal *val) {
+    return EXTRACT_TAG(val) == LISP_OBJECT_TAG;
+}
+
+static ALWAYS_INLINE void SET_OBJECT_MARKED(LispVal *val, bool marked) {
+    assert(OBJECTP(val));
+    ((LispObject *) val)->gc.mark = marked;
+}
+
+static ALWAYS_INLINE bool OBJECT_MARKED_P(LispVal *val) {
+    assert(OBJECTP(val));
+    return ((LispObject *) val)->gc.mark;
 }
 
 static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) {

src/function.c

@@ -146,6 +146,9 @@ void parse_lambda_list(LambdaListParseResult *result, LispVal *list) {
             ++out->n_req;
         }
     }
+    if ((seen & KEY) == 0 && out->allow_other_keys) {
+        RETURN_ERROR(LLPS_SYNTAX, list);
+    }
     out->req = Fnreverse(out->req);
     out->opt = Fnreverse(out->opt);
     out->kw = Fnreverse(out->kw);
@@ -185,8 +188,53 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(),
 }
 
 // Calling functions
+// A simple function has only required args
+static ALWAYS_INLINE bool SIMPLE_FUNCTION_P(LispFunction *fobj) {
+    return !fobj->args.n_opt && !fobj->args.n_kw && NILP(fobj->args.rest);
+}
+
+static ALWAYS_INLINE LispVal *
+call_simple_native(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
+    assert(fobj->args.n_req <= MAX_NATIVE_FUNCTION_ARGS);
+    push_stack_frame(orig_func, fobj, args);
+    if (!list_length_eq(args, fobj->args.n_req)) {
+        // TODO incorrect arg count
+        fprintf(stderr, "Wrong arg count!!\n");
+        abort();
+    }
+    FOREACH(args, arg) {
+        add_local_reference(arg);
+    }
+    LispVal *retval;
+    switch (fobj->args.n_req) {
+    case 0:
+        retval = fobj->impl.native.zero();
+    case 1:
+        retval = fobj->impl.native.one(FIRST(args));
+    case 2:
+        retval = fobj->impl.native.two(FIRST(args), SECOND(args));
+    case 3:
+        retval =
+            fobj->impl.native.three(FIRST(args), SECOND(args), THIRD(args));
+    case 4:
+        retval = fobj->impl.native.four(FIRST(args), SECOND(args), THIRD(args),
+                                        FOURTH(args));
+    case 5:
+        retval = fobj->impl.native.five(FIRST(args), SECOND(args), THIRD(args),
+                                        FOURTH(args), FIFTH(args));
+    default:
+        abort();
+    }
+    pop_stack_frame();
+    // TODO probably need to protect retval from GC here
+    return retval;
+}
+
 static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
                                           LispFunction *fobj, LispVal *args) {
+    if (SIMPLE_FUNCTION_P(fobj)) {
+        return call_simple_native(orig_func, fobj, args);
+    }
     return Qnil;
 }
 

src/function.h

@@ -20,6 +20,7 @@ struct LambdaList {
     LispVal *rest; // symbol (non-nil if we have a rest arg)
 };
 
+#define MAX_NATIVE_FUNCTION_ARGS 5
 union native_function {
     LispVal *(*zero)(void);
     LispVal *(*one)(LispVal *);

src/gc.h

@@ -10,8 +10,8 @@ typedef struct GCEntry {
 } GCEntry;
 
 typedef struct {
-    unsigned int immortal : 1;
     unsigned int mark : 1;
+    unsigned int local_ref_count : 7;
     GCEntry *entry;
 } ObjectGCInfo;
 

src/lisp.c

@@ -10,21 +10,16 @@ static void construct_manual_symbols() {
     // IMPORTANT: the symbols listed here need to also be set as special in
     // gen-init-globals.awk
     Qnil = Fmake_symbol(LISP_LITSTR("nil"));
-    MAKE_OBJ_IMMORTAL(Qnil);
     ((LispSymbol *) Qnil)->function = Qnil;
     ((LispSymbol *) Qnil)->plist = Qnil;
     Qt = Fmake_symbol(LISP_LITSTR("t"));
-    MAKE_OBJ_IMMORTAL(Qt);
     ((LispSymbol *) Qt)->value = Qt;
     Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
-    MAKE_OBJ_IMMORTAL(Qunbound);
     ((LispSymbol *) Qunbound)->value = Qunbound;
     ((LispSymbol *) Qnil)->value = Qunbound;
 
     Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
-    MAKE_OBJ_IMMORTAL(Qhash_string);
     Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal"));
-    MAKE_OBJ_IMMORTAL(Qstrings_equal);
 }
 
 static void register_manual_symbols() {
@@ -48,6 +43,8 @@ void lisp_init() {
 
     register_manual_symbols();
     register_globals();
+
+    lisp_init_stack();
 }
 
 void lisp_shutdown() {}

src/lisp.h

@@ -6,6 +6,7 @@
 #include "hashtable.h"
 #include "lisp_string.h"
 #include "list.h"
+#include "stack.h"
 
 #include <stdio.h>
 

src/list.c

@@ -21,7 +21,7 @@ bool list_length_eq(LispVal *list, intptr_t size) {
     while (size-- && CONSP(list)) {
         list = XCDR(list);
     }
-    return size == 0;
+    return size == 0 && NILP(list);
 }
 
 DEFUN(cons, "cons", (LispVal * car, LispVal *cdr), "(car cdr)",

src/list.h

@@ -91,12 +91,19 @@ static ALWAYS_INLINE LispVal *LIST_N(int count, ...) {
 }
 #define LIST(...) MACRO_CALLN(LIST, __VA_ARGS__)
 
+#define FIRST(x)  XCAR(x)
+#define SECOND(x) XCAR(XCDR(x))
+#define THIRD(x)  XCAR(XCDR(XCDR(x)))
+#define FOURTH(x) XCAR(XCDR(XCDR(XCDR(x))))
+#define FIFTH(x)  XCAR(XCDR(XCDR(XCDR(XCDR(x)))))
+
 #define FOREACH(l, v)                                          \
     for (LispVal *_tail = (l), *v = XCAR(_tail); !NILP(_tail); \
          _tail = XCDR(_tail), v = XCAR(_tail))
 
 #define FOREACH_TAIL(l, v) for (LispVal *v = (l); !NILP(v); v = XCDR_SAFE(v))
 
+// return -1 list is circular
 intptr_t list_length(LispVal *list);
 // Return true if the length of LIST == SIZE
 bool list_length_eq(LispVal *list, intptr_t size);

src/main.c

@@ -5,12 +5,14 @@
 
 int main(int argc, const char **argv) {
     lisp_init();
+    push_stack_frame(Qnil, Qnil, Qnil);
     ReadStream s;
-    const char BUF[] = "t";
+    const char BUF[] = "(a b c d e f g h i j k l m)";
     read_stream_init(&s, BUF, sizeof(BUF) - 1);
     LispVal *l = read(&s);
-    CHECK_TYPE(l, TYPE_FIXNUM);
-    printf("%d\n", l == Qt);
+    l = Ffuncall(Qmake_symbol, LISP_LITSTR("a"));
+    debug_obj_info(stdout, l);
+    pop_stack_frame();
     lisp_shutdown();
     return 0;
 }

src/stack.c

@@ -0,0 +1,92 @@
+#include "stack.h"
+
+#include "memory.h"
+
+#include <assert.h>
+
+struct LispStack the_stack;
+
+void lisp_init_stack() {
+    the_stack.max_depth = DEFAULT_MAX_LISP_EVAL_DEPTH;
+    the_stack.depth = 0;
+    the_stack.first_clear_local_refs = 0;
+    the_stack.frames =
+        lisp_malloc(sizeof(struct StackFrame) * the_stack.max_depth);
+    for (size_t i = 0; i < the_stack.max_depth; ++i) {
+        the_stack.frames->local_refs.num_refs = 0;
+        the_stack.frames->local_refs.num_blocks = 1;
+        the_stack.frames->local_refs.blocks =
+            lisp_malloc(sizeof(struct LocalReferencesBlock *));
+        the_stack.frames->local_refs.blocks[0] =
+            lisp_malloc(sizeof(struct LocalReferencesBlock));
+    }
+}
+
+static ALWAYS_INLINE void init_stack_frame(struct StackFrame *frame,
+                                           LispVal *name, LispVal *args) {
+    frame->name = name;
+    frame->args = args;
+    frame->lexenv = Qnil;
+}
+
+void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args) {
+    assert(the_stack.depth < the_stack.max_depth);
+    struct StackFrame *frame = &the_stack.frames[the_stack.depth++];
+    frame->name = name;
+    frame->fobj = fobj;
+    frame->args = args;
+    frame->lexenv = Qnil;
+}
+
+static void reset_local_refs(struct LocalReferences *refs) {
+    size_t last_block_size = refs->num_refs % LOCAL_REFERENCES_BLOCK_LENGTH;
+    size_t num_full_blocks = refs->num_blocks / LOCAL_REFERENCES_BLOCK_LENGTH;
+    for (size_t i = 0; i < num_full_blocks; ++i) {
+        for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) {
+            assert(OBJECTP(refs->blocks[i]->refs[j]));
+            --((LispObject *) refs->blocks[i]->refs[j])->gc.local_ref_count;
+        }
+    }
+    for (size_t i = 0; i < last_block_size; ++i) {
+        assert(OBJECTP(refs->blocks[num_full_blocks]->refs[i]));
+        --((LispObject *) refs->blocks[num_full_blocks]->refs[i])
+              ->gc.local_ref_count;
+    }
+}
+
+void pop_stack_frame(void) {
+    assert(the_stack.depth > 0);
+    struct StackFrame *frame = &the_stack.frames[--the_stack.depth];
+    reset_local_refs(&frame->local_refs);
+}
+
+// return true if we allocated a block
+static bool store_local_reference_in_frame(struct StackFrame *frame,
+                                           LispVal *obj) {
+    struct LocalReferences *refs = &frame->local_refs;
+    size_t num_full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH;
+    if (num_full_blocks == refs->num_blocks) {
+        refs->blocks =
+            lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *)
+                                           * ++refs->num_blocks);
+        refs->blocks[refs->num_blocks - 1] =
+            lisp_malloc(sizeof(struct LocalReferencesBlock));
+        refs->blocks[refs->num_blocks - 1]->refs[0] = obj;
+        refs->num_refs += 1;
+        return true;
+    } else {
+        refs->blocks[num_full_blocks]
+            ->refs[refs->num_refs++ % LOCAL_REFERENCES_BLOCK_LENGTH] = obj;
+        return false;
+    }
+}
+
+void add_local_reference(LispVal *obj) {
+    assert(the_stack.depth > 0);
+    if (OBJECTP(obj)) {
+        if (store_local_reference_in_frame(LISP_STACK_TOP(), obj)) {
+            the_stack.first_clear_local_refs = the_stack.depth;
+        }
+        ++((LispObject *) obj)->gc.local_ref_count;
+    }
+}

src/stack.h

@@ -0,0 +1,46 @@
+#ifndef INCLUDED_STACK_H
+#define INCLUDED_STACK_H
+
+#include "base.h"
+
+#define DEFAULT_MAX_LISP_EVAL_DEPTH   1000
+#define LOCAL_REFERENCES_BLOCK_LENGTH 64
+
+struct LocalReferencesBlock {
+    LispVal *refs[LOCAL_REFERENCES_BLOCK_LENGTH];
+};
+
+struct LocalReferences {
+    size_t num_blocks;
+    size_t num_refs;
+    struct LocalReferencesBlock **blocks;
+};
+
+struct StackFrame {
+    LispVal *name; // name of function call
+    LispVal *fobj; // the function object
+    LispVal *args; // arguments of the function call
+    LispVal *lexenv; // lexical environment (plist)
+    struct LocalReferences local_refs;
+};
+
+struct LispStack {
+    size_t max_depth;
+    size_t depth;
+    size_t first_clear_local_refs; // index of the first frame that has local
+                                   // refs that has not been grown
+    struct StackFrame *frames;
+};
+
+extern struct LispStack the_stack;
+
+static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP() {
+    return the_stack.depth ? &the_stack.frames[the_stack.depth - 1] : NULL;
+}
+
+void lisp_init_stack(void);
+void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args);
+void pop_stack_frame(void);
+void add_local_reference(LispVal *obj);
+
+#endif