#include #include #include #include #include #include "gc.h" #include "builtin.h" static gc_root_t builtin_list; /* Returns a byte string w/ bytes from 's' (excl. terminating NUL). */ static value_t string_to_value(const char *s); /* Return value is a new C string which must be free()'d by caller. */ static char *value_to_string(value_t v); /* Like strcmp(), but for byte strings. */ static int byte_strcmp(value_t s1, value_t s2); void builtin_init(void) { gc_root_t ms_root, tmp_root; register_gc_root(&builtin_list, NIL); #define SS(x) STRUCTURE_SLOT_ ## x /* (Meta-)Structure: Instances of this structure describe structures. */ register_gc_root(&ms_root, make_struct(NIL, STRUCTURE_SLOTS)); register_builtin(BI_STRUCTURE, ms_root.value); /* Metastruct is both a structure and a structure description, * and thus is an instance of itself. */ _get_struct(ms_root.value)->type = ms_root.value; /* Slot 1: Name */ _get_struct(ms_root.value)->slots[SS(NAME)] = string_to_value("structure"); /* Slot 2: Super/parent structure type, or NIL */ _get_struct(ms_root.value)->slots[SS(SUPER)] = NIL; /* Slot 3: Vector of slot names; size == total number of slots (excl. type) */ _get_struct(ms_root.value)->slots[SS(SLOTS)] = make_vector(STRUCTURE_SLOTS, NIL); { gc_root_t vec_root; register_gc_root(&vec_root, _get_struct(ms_root.value)->slots[SS(SLOTS)]); _get_vector(vec_root.value)->elements[SS(NAME)] = string_to_value("name"); _get_vector(vec_root.value)->elements[SS(SUPER)] = string_to_value("super"); _get_vector(vec_root.value)->elements[SS(SLOTS)] = string_to_value("slots"); _get_vector(vec_root.value)->elements[SS(CALLABLE)] = string_to_value("callable"); unregister_gc_root(&vec_root); } /* Slot 4: Callable object used as proxy when structure is APPLY'd. */ /* Can be LAMBDA or callable structure instance. */ _get_struct(ms_root.value)->slots[SS(CALLABLE)] = NIL; #define TS(x) TEMPLATE_SLOT_ ## x /* Template: Instances of this structure describe what a LAMBDA * will look like when instanciated with the 'lambda' bytecode. */ register_gc_root(&tmp_root, make_struct(ms_root.value, STRUCTURE_SLOTS)); register_builtin(BI_TEMPLATE, tmp_root.value); /* Slot 1: Name */ _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("template"); /* Slot 2: Super/parent structure type, or NIL */ _get_struct(tmp_root.value)->slots[SS(SUPER)] = NIL; /* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(TEMPLATE_SLOTS, NIL); { gc_root_t vec_root; register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); _get_vector(vec_root.value)->elements[TS(GLOBAL_VARS)] = string_to_value("global-vars"); _get_vector(vec_root.value)->elements[TS(INSTANCE_VARS)] = string_to_value("instance-vars"); _get_vector(vec_root.value)->elements[TS(FRAME_VARS)] = string_to_value("frame-vars"); _get_vector(vec_root.value)->elements[TS(BYTE_CODE)] = string_to_value("byte-code"); _get_vector(vec_root.value)->elements[TS(TAIL_CALL)] = string_to_value("tail-call"); _get_vector(vec_root.value)->elements[TS(ARG_LIST)] = string_to_value("argument-list"); _get_vector(vec_root.value)->elements[TS(CONTINUATION)] = string_to_value("continuation"); _get_vector(vec_root.value)->elements[TS(CONTEXT)] = string_to_value("context"); unregister_gc_root(&vec_root); } /* Slot 4: Callable object used as proxy when structure is apply'd. */ _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = NIL; unregister_gc_root(&tmp_root); #undef TS #define LS(x) LAMBDA_SLOT_ ## x /* Lambda: Instances of this structure are fundamental callable objects. */ register_gc_root(&tmp_root, make_struct(ms_root.value, STRUCTURE_SLOTS)); register_builtin(BI_LAMBDA, tmp_root.value); /* Slot 1: Name */ _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("lambda"); /* Slot 2: Super/parent structure type, or NIL */ _get_struct(tmp_root.value)->slots[SS(SUPER)] = NIL; /* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(LAMBDA_SLOTS, NIL); { gc_root_t vec_root; register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); _get_vector(vec_root.value)->elements[LS(GLOBAL_VARS)] = string_to_value("global-vars"); _get_vector(vec_root.value)->elements[LS(INSTANCE_VARS)] = string_to_value("instance-vars"); _get_vector(vec_root.value)->elements[LS(FRAME_VARS)] = string_to_value("frame-vars"); _get_vector(vec_root.value)->elements[LS(BYTE_CODE)] = string_to_value("byte-code"); _get_vector(vec_root.value)->elements[LS(TAIL_CALL)] = string_to_value("tail-call"); _get_vector(vec_root.value)->elements[LS(ARG_LIST)] = string_to_value("argument-list"); _get_vector(vec_root.value)->elements[LS(CONTINUATION)] = string_to_value("continuation"); _get_vector(vec_root.value)->elements[LS(CONTEXT)] = string_to_value("context"); unregister_gc_root(&vec_root); } /* Slot 4: Callable object used as proxy when structure is apply'd. */ _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = NIL; unregister_gc_root(&tmp_root); #undef LS #undef SS unregister_gc_root(&ms_root); } void register_builtin(const char *name, value_t value) { gc_root_t name_root; register_gc_root(&name_root, string_to_value(name)); builtin_list.value = cons(value, builtin_list.value); builtin_list.value = cons(name_root.value, builtin_list.value); unregister_gc_root(&name_root); } value_t lookup_builtin(const char *name) { value_t name_val = string_to_value(name); for (value_t list = builtin_list.value; !is_nil(list); list = _CDDR(list)) { if (byte_strcmp(_CAR(list), name_val) == 0) { return _CADR(list); } } return FALSE_VALUE; } static value_t string_to_value(const char *s) { size_t len = strlen(s); value_t v = make_byte_string(len, '\0'); memcpy(_get_byte_string(v)->bytes, s, len); return v; } static char *value_to_string(value_t v) { byte_string_t *str = get_byte_string(v); char *s = (char*)malloc(str->size + 1); memcpy(s, str->bytes, str->size); s[str->size] = '\0'; return s; } static int byte_strcmp(value_t s1, value_t s2) { byte_string_t *str1 = get_byte_string(s1); byte_string_t *str2 = get_byte_string(s2); if (str1->size < str2->size) return -1; else if (str1->size > str2->size) return 1; else return memcmp(str1->bytes, str2->bytes, str1->size); } /* vim:set sw=2 expandtab: */