diff --git a/src/base.c b/src/base.c index fb3b866..99dce66 100644 --- a/src/base.c +++ b/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; diff --git a/src/base.h b/src/base.h index 79d0443..752c7b0 100644 --- a/src/base.h +++ b/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) { diff --git a/src/function.c b/src/function.c index 99f6bc1..e206524 100644 --- a/src/function.c +++ b/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; } diff --git a/src/function.h b/src/function.h index 0f67331..71b168b 100644 --- a/src/function.h +++ b/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 *); diff --git a/src/gc.h b/src/gc.h index 043b493..6c43239 100644 --- a/src/gc.h +++ b/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; diff --git a/src/lisp.c b/src/lisp.c index aa7e7a6..d2e1e22 100644 --- a/src/lisp.c +++ b/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() {} diff --git a/src/lisp.h b/src/lisp.h index ab3b57b..33f3103 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -6,6 +6,7 @@ #include "hashtable.h" #include "lisp_string.h" #include "list.h" +#include "stack.h" #include diff --git a/src/list.c b/src/list.c index a62b659..159696f 100644 --- a/src/list.c +++ b/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)", diff --git a/src/list.h b/src/list.h index f990d11..c19e009 100644 --- a/src/list.h +++ b/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); diff --git a/src/main.c b/src/main.c index 55b5b68..d65af14 100644 --- a/src/main.c +++ b/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; } diff --git a/src/stack.c b/src/stack.c new file mode 100644 index 0000000..fafbc5b --- /dev/null +++ b/src/stack.c @@ -0,0 +1,92 @@ +#include "stack.h" + +#include "memory.h" + +#include + +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; + } +} diff --git a/src/stack.h b/src/stack.h new file mode 100644 index 0000000..5073794 --- /dev/null +++ b/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