#ifndef INCLUDED_TYPES_H #define INCLUDED_TYPES_H #include "argcountmacro.h" #include "gc.h" #include "memory.h" #include #include // ################### // # Base value type # // ################### typedef void LispVal; // ########################## // # Fixnum and float stuff # // ########################## typedef intptr_t fixnum_t; #if LISP_WORD_BITS == 32 # define LISP_FLOAT_SCANF "f" typedef lisp_float32_t lisp_float_t; #else # define LISP_FLOAT_SCANF "lf" typedef lisp_float64_t lisp_float_t; #endif #define MOST_POSITIVE_FIXNUM ((intptr_t) ((INTPTR_MAX & ~(intptr_t) 3) >> 2)) #define MOST_NEGATIVE_FIXNUM ((intptr_t) ((INTPTR_MIN & ~(intptr_t) 3) >> 2)) static ALWAYS_INLINE uintptr_t EXTRACT_TAG(LispVal *val) { uintptr_t iv = (uintptr_t) val; return iv & (uintptr_t) 3; } #define LISP_TAG_BITS 2 #define LISP_OBJECT_TAG ((uintptr_t) 0) // 0b01 #define FIXNUM_TAG ((uintptr_t) 1) // 0b10 #define LISP_FLOAT_TAG ((uintptr_t) 2) static ALWAYS_INLINE bool LISP_OBJECT_P(LispVal *val) { return EXTRACT_TAG(val) == LISP_OBJECT_TAG; } static ALWAYS_INLINE bool FIXNUMP(LispVal *val) { return EXTRACT_TAG(val) == FIXNUM_TAG; } static ALWAYS_INLINE fixnum_t XFIXNUM(LispVal *val) { assert(FIXNUMP(val)); return ((fixnum_t) val) >> 2; } static ALWAYS_INLINE LispVal *MAKE_FIXNUM(fixnum_t fn) { return (LispVal *) ((((uintptr_t) fn) << 2) | FIXNUM_TAG); } static ALWAYS_INLINE bool LISP_FLOAT_P(LispVal *val) { return EXTRACT_TAG(val) == LISP_FLOAT_TAG; } static ALWAYS_INLINE lisp_float_t XLISP_FLOAT(LispVal *val) { assert(LISP_FLOAT_P(val)); uintptr_t iv = (uintptr_t) val; iv &= ~(uintptr_t) 3; return INT_TO_FLOAT_BITS(iv); } static ALWAYS_INLINE LispVal *MAKE_LISP_FLOAT(lisp_float_t flt) { uintptr_t bits = FLOAT_TO_INT_BITS(flt); return (LispVal *) ((bits & ~(uintptr_t) 3) | LISP_FLOAT_TAG); } // ############### // # Other types # // ############### typedef enum { TYPE_FIXNUM = 0, TYPE_FLOAT = 1, TYPE_CONS = 2, TYPE_STRING = 3, TYPE_SYMBOL = 4, TYPE_VECTOR = 5, TYPE_HASH_TABLE = 6, TYPE_FUNCTION = 7, N_LISP_TYPES, } LispValType; extern const char *LISP_TYPE_NAMES[N_LISP_TYPES]; typedef struct { LispValType type; ObjectGCInfo gc; } LispObject; extern bool lisp_gc_on_alloc; #define LISP_OBJECT_ALIGNMENT (1 << LISP_TAG_BITS) LispVal *lisp_alloc_object_no_gc(size_t size, LispValType type); LispVal *lisp_alloc_object(size_t size, LispValType type); void lisp_release_object(LispVal *val); static ALWAYS_INLINE bool OBJECTP(LispVal *val) { return EXTRACT_TAG(val) == LISP_OBJECT_TAG; } static ALWAYS_INLINE ObjectGCSet OBJECT_GET_GC_SET(LispVal *val) { assert(OBJECTP(val)); return ((LispObject *) val)->gc.set; } static ALWAYS_INLINE bool OBJECT_GC_SET_P(LispVal *val, ObjectGCSet set) { return OBJECT_GET_GC_SET(val) == set; } static ALWAYS_INLINE bool OBJECT_STATIC_P(LispVal *val) { assert(OBJECTP(val)); return ((LispObject *) val)->gc.is_static; } static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) { if (OBJECTP(val) && OBJECTP(into) && OBJECT_GC_SET_P(into, GC_BLACK) && OBJECT_GC_SET_P(val, GC_WHITE)) { gc_move_to_set(val, GC_GREY); } } static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) { if (FIXNUMP(val)) { return TYPE_FIXNUM; } else if (LISP_FLOAT_P(val)) { return TYPE_FLOAT; } else { return ((LispObject *) val)->type; } } static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) { if (FIXNUMP(val)) { return type == TYPE_FIXNUM; } else if (LISP_FLOAT_P(val)) { return type == TYPE_FLOAT; } else { return ((LispObject *) val)->type == type; } } noreturn void internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count, const LispValType types[count]); static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count, LispValType v1, LispValType v2, LispValType v3, LispValType v4, LispValType v5, LispValType v6) { const LispValType types[] = {v1, v2, v3, v4, v5, v6}; for (size_t i = 0; i < count; ++i) { if (LISP_TYPEP(obj, types[i])) { return; } } // Failed internal_CHECK_TYPE_signal_type_error(obj, count, types); } #define internal_CHECK_TYPE_SUB(obj, count, a1, a2, a3, a4, a5, a6, ...) \ internal_CHECK_TYPE((obj), count, a1, a2, a3, a4, a5, a6) #define CHECK_TYPE(obj, ...) \ internal_CHECK_TYPE_SUB((obj), COUNT_ARGS(__VA_ARGS__), __VA_ARGS__, \ TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM, \ TYPE_FIXNUM, TYPE_FIXNUM, TYPE_FIXNUM) noreturn void signal_type_error(LispVal *obj, LispVal *typespec); #define DEFOBJTYPE(Name, NAME, NAME_P, body) \ typedef struct { \ LispObject header; \ struct body; \ } Lisp##Name; \ static ALWAYS_INLINE bool NAME_P(LispVal *val) { \ return LISP_TYPEP(val, TYPE_##NAME); \ } \ struct __ignored DEFOBJTYPE(String, STRING, STRINGP, { size_t length; char *data; bool owned; }); enum SymbolValueType { SYMBOL_NORMAL, SYMBOL_NATIVE, }; enum SymbolFlags { SYMBOL_DYNAMIC = 1, SYMBOL_CONST_VALUE = 2, SYMBOL_CONST_FUNCTION = 4, }; DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, { LispVal *name; // string enum SymbolValueType value_type : 1; enum SymbolFlags flags : 7; LispVal *function; union { LispVal *normal; LispVal **native; } value; LispVal *plist; }); static ALWAYS_INLINE bool KEYWORDP(LispVal *val) { if (!SYMBOLP(val)) { return false; } LispString *sym = (LispString *) ((LispSymbol *) val)->name; return sym->length && *sym->data == ':'; } DEFOBJTYPE(Vector, VECTOR, VECTORP, { size_t length; LispVal **data; }); // Defined here instead of in function.h so that headers don't have to include // it just to define functions #define DECLARE_SYMBOL(cname) \ extern const char *internal_Q##cname##_name; \ extern const size_t internal_Q##cname##_name_len; \ extern LispVal *Q##cname #define DECLARE_VARIABLE(cname) \ DECLARE_SYMBOL(cname); \ extern LispVal *internal_V##cname##_init(void); \ extern LispVal *V##cname #define DECLARE_FUNCTION(cname, cargs) \ DECLARE_SYMBOL(cname); \ extern const char *internal_F##cname##_argstr; \ extern const size_t internal_F##cname##_argstr_len; \ extern const char *internal_F##cname##_docstr; \ extern const size_t internal_F##cname##_docstr_len; \ LispVal *F##cname cargs #define DEFINE_SYMBOL(cname, lisp_name) \ const char *internal_Q##cname##_name = lisp_name; \ const size_t internal_Q##cname##_name_len = sizeof(lisp_name) - 1; \ LispVal *Q##cname #define DEFVAR(cname, lisp_name, doc, init_val) \ DEFINE_SYMBOL(cname, lisp_name); \ LispVal *internal_V##cname##_init(void) { \ return (init_val); \ } \ LispVal *V##cname #define DEFUN(cname, lisp_name, cargs, lisp_args, doc) \ DEFINE_SYMBOL(cname, lisp_name); \ const char *internal_F##cname##_argstr = lisp_args; \ const size_t internal_F##cname##_argstr_len = sizeof(lisp_args) - 1; \ const char *internal_F##cname##_docstr = doc; \ const size_t internal_F##cname##_docstr_len = sizeof(doc) - 1; \ LispVal *Q##cname; \ LispVal *F##cname cargs #define DEFSPECIAL(cname, lisp_name, cargs, lisp_args, doc) \ DEFUN(cname, lisp_name, cargs, lisp_args, doc) #define REGISTER_GLOBAL_SYMBOL(cname) \ { \ Q##cname = Fintern(make_lisp_string(internal_Q##cname##_name, \ internal_Q##cname##_name_len, \ false, false)); \ ((LispSymbol *) Q##cname)->value_type = SYMBOL_NORMAL; \ lisp_gc_register_static_object(Q##cname); \ } #define REGISTER_GLOBAL_VARIABLE(cname) \ REGISTER_GLOBAL_SYMBOL(cname); \ { \ V##cname = internal_V##cname##_init(); \ ((LispSymbol *) Q##cname)->value_type = SYMBOL_NATIVE; \ ((LispSymbol *) Q##cname)->value.native = &V##cname; \ ((LispSymbol *) Q##cname)->flags |= SYMBOL_DYNAMIC; \ } #define REGISTER_GLOBAL_FUNCTION(cname) \ { \ REGISTER_GLOBAL_SYMBOL(cname); \ ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \ } #define REGISTER_GLOBAL_SPECIAL(cname) \ { \ REGISTER_GLOBAL_SYMBOL(cname); \ ((LispSymbol *) Q##cname)->function = BUILTIN_FUNCTION_OBJ(cname); \ ((LispFunction *) ((LispSymbol *) Q##cname)->function) \ ->impl.native.no_eval_args = true; \ } DECLARE_SYMBOL(nil); DECLARE_SYMBOL(t); DECLARE_SYMBOL(unbound); DECLARE_VARIABLE(lexical_environment); extern LispVal *Vlexical_environment; static ALWAYS_INLINE bool NILP(LispVal *val) { return val == Qnil; } static ALWAYS_INLINE bool EQ(LispVal *val1, LispVal *val2) { return val1 == val2; } // Some core functions DECLARE_FUNCTION(id, (LispVal * obj)); DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2)); DECLARE_FUNCTION(quote, (LispVal * form)); // TODO probably move these to another file LispVal *make_vector(LispVal **data, size_t length, bool take); DECLARE_FUNCTION(make_symbol, (LispVal * name)); DECLARE_FUNCTION(intern, (LispVal * name)); DECLARE_FUNCTION(symbol_value, (LispVal * sym)); DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve)); DECLARE_FUNCTION(symbol_plist, (LispVal * sym)); DECLARE_FUNCTION(set, (LispVal * sym, LispVal *value)); DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *value)); DECLARE_FUNCTION(setplist, (LispVal * sym, LispVal *plist)); DECLARE_FUNCTION(get, (LispVal * sym, LispVal *key, LispVal *def)); DECLARE_FUNCTION(put, (LispVal * sym, LispVal *key, LispVal *val)); static ALWAYS_INLINE LispVal *SYMBOL_VALUE(LispVal *sym) { assert(SYMBOLP(sym)); LispSymbol *s = (LispSymbol *) sym; switch (s->value_type) { case SYMBOL_NORMAL: return s->value.normal; case SYMBOL_NATIVE: return *s->value.native; } } static ALWAYS_INLINE bool CONST_VALUE_P(LispVal *sym) { assert(SYMBOLP(sym)); return ((LispSymbol *) sym)->flags & SYMBOL_CONST_VALUE; } static ALWAYS_INLINE bool CONST_FUNCTION_P(LispVal *sym) { assert(SYMBOLP(sym)); return ((LispSymbol *) sym)->flags & SYMBOL_CONST_FUNCTION; } static ALWAYS_INLINE bool DYNAMIC_SYMBOL_P(LispVal *sym) { assert(SYMBOLP(sym)); return ((LispSymbol *) sym)->flags & SYMBOL_DYNAMIC; } static ALWAYS_INLINE void SET_SYMBOL_VALUE(LispVal *sym, LispVal *value) { assert(SYMBOLP(sym)); LispSymbol *s = (LispSymbol *) sym; if (CONST_VALUE_P(sym)) { // TODO throw abort(); } switch (s->value_type) { case SYMBOL_NORMAL: s->value.normal = value; break; case SYMBOL_NATIVE: *s->value.native = value; break; } } // condition stuff DECLARE_SYMBOL(condition_class); DECLARE_FUNCTION(condition_class_p, (LispVal * val)); DECLARE_FUNCTION(condition_subclass_p, (LispVal * child, LispVal *parent)); // Defined in lisp code (eventually) but used in read.c DECLARE_SYMBOL(backquote); DECLARE_SYMBOL(comma); DECLARE_SYMBOL(comma_at); #endif