#include #include #include #include #include #include "gc.h" #include "builtin.h" #include "interp.h" static gc_root_t builtin_list; static void register_structure(gc_root_t *ms_root); static void register_template(gc_root_t *ms_root); static void register_lambda(gc_root_t *ms_root); static void bi_string_to_number(interp_state_t *state); void builtin_init(void) { gc_root_t ms_root; register_gc_root(&builtin_list, NIL); register_gc_root(&ms_root, UNDEFINED); register_builtin(BI_UNDEFINED, UNDEFINED); register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number)); #ifdef NAN register_builtin(BI_POS_NAN, make_float(NAN)); register_builtin(BI_NEG_NAN, make_float(-NAN)); #endif #ifdef INFINITY register_builtin(BI_POS_INFINITY, make_float(INFINITY)); register_builtin(BI_NEG_INFINITY, make_float(-INFINITY)); #endif register_structure(&ms_root); register_template(&ms_root); register_lambda(&ms_root); 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; } #define SS(x) STRUCTURE_SLOT_ ## x static void register_structure(gc_root_t *ms_root) { /* (Meta-)Structure: Instances of this structure describe structures. */ ms_root->value = make_struct(UNDEFINED, STRUCTURE_SLOTS); /* 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"); WRITE_BARRIER(ms_root->value); /* Slot 2: Super/parent structure type, or FALSE_VALUE */ _get_struct(ms_root->value)->slots[SS(SUPER)] = FALSE_VALUE; /* 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, UNDEFINED); WRITE_BARRIER(ms_root->value); { 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"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[SS(SUPER)] = string_to_value("super"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[SS(SLOTS)] = string_to_value("slots"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[SS(CALLABLE)] = string_to_value("callable"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[SS(MUTABLE)] = string_to_value("mutable"); WRITE_BARRIER(vec_root.value); unregister_gc_root(&vec_root); } /* Slot 4: Callable object used as proxy when structure is APPLY'd. */ /* Can be LAMBDA, callable structure instance, or FALSE_VALUE. */ _get_struct(ms_root->value)->slots[SS(CALLABLE)] = FALSE_VALUE; _get_struct(ms_root->value)->slots[SS(MUTABLE)] = FALSE_VALUE; register_builtin(BI_STRUCTURE, ms_root->value); } static void register_template(gc_root_t *ms_root) { gc_root_t tmp_root; #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"); WRITE_BARRIER(tmp_root.value); /* Slot 2: Super/parent structure type, or FALSE_VALUE */ _get_struct(tmp_root.value)->slots[SS(SUPER)] = FALSE_VALUE; /* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(TEMPLATE_SLOTS, UNDEFINED); WRITE_BARRIER(tmp_root.value); { 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"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(INSTANCE_VARS)] = string_to_value("instance-vars"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(FRAME_VARS)] = string_to_value("frame-vars"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(BYTE_CODE)] = string_to_value("byte-code"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(TAIL_CALL)] = string_to_value("tail-call"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(ARG_LIST)] = string_to_value("argument-list"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(CONTINUATION)] = string_to_value("continuation"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[TS(CONTEXT)] = string_to_value("context"); WRITE_BARRIER(vec_root.value); 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)] = FALSE_VALUE; _get_struct(tmp_root.value)->slots[SS(MUTABLE)] = FALSE_VALUE; unregister_gc_root(&tmp_root); #undef TS } static void register_lambda(gc_root_t *ms_root) { gc_root_t tmp_root; #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"); WRITE_BARRIER(tmp_root.value); /* Slot 2: Super/parent structure type, or FALSE_VALUE */ _get_struct(tmp_root.value)->slots[SS(SUPER)] = FALSE_VALUE; /* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(LAMBDA_SLOTS, UNDEFINED); WRITE_BARRIER(tmp_root.value); { 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"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(INSTANCE_VARS)] = string_to_value("instance-vars"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(FRAME_VARS)] = string_to_value("frame-vars"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(BYTE_CODE)] = string_to_value("byte-code"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(TAIL_CALL)] = string_to_value("tail-call"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(ARG_LIST)] = string_to_value("argument-list"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(CONTINUATION)] = string_to_value("continuation"); WRITE_BARRIER(vec_root.value); _get_vector(vec_root.value)->elements[LS(CONTEXT)] = string_to_value("context"); WRITE_BARRIER(vec_root.value); 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)] = FALSE_VALUE; _get_struct(tmp_root.value)->slots[SS(MUTABLE)] = FALSE_VALUE; unregister_gc_root(&tmp_root); #undef LS } #undef SS static void bi_string_to_number(interp_state_t *state) { char *str; char *end; fixnum_t num; value_t rval; str = value_to_string(CAR(state->argv.value)); num = strtol(str, &end, 0); free(str); if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num)) rval = cons(fixnum_value(num), NIL); else rval = cons(FALSE_VALUE, NIL); state->lambda.value = state->k.value; state->argv.value = rval; state->k.value = FALSE_VALUE; state->ctx.value = FALSE_VALUE; } /* vim:set sw=2 expandtab: */