119 lines
3.2 KiB
C
119 lines
3.2 KiB
C
#include "lisp.h"
|
|
|
|
#include "hashtable.h"
|
|
#include "init_globals.h"
|
|
#include "lisp_string.h"
|
|
|
|
LispVal *obarray;
|
|
|
|
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"));
|
|
((LispSymbol *) Qnil)->function = Qnil;
|
|
((LispSymbol *) Qnil)->plist = Qnil;
|
|
Qt = Fmake_symbol(LISP_LITSTR("t"));
|
|
((LispSymbol *) Qt)->value = Qt;
|
|
Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
|
|
((LispSymbol *) Qunbound)->value = Qunbound;
|
|
((LispSymbol *) Qnil)->value = Qunbound;
|
|
|
|
Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
|
|
Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal"));
|
|
}
|
|
|
|
static void register_manual_symbols() {
|
|
#define INTERN(cname) \
|
|
Fputhash(obarray, ((LispSymbol *) Q##cname)->name, Q##cname);
|
|
INTERN(nil);
|
|
INTERN(t);
|
|
INTERN(unbound);
|
|
INTERN(hash_string);
|
|
INTERN(strings_equal);
|
|
#undef INTERN
|
|
}
|
|
|
|
void lisp_init() {
|
|
construct_manual_symbols();
|
|
obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
|
|
// these call Fintern, so they need to have obarray constructed
|
|
((LispSymbol *) Qhash_string)->function = BUILTIN_FUNCTION_OBJ(hash_string);
|
|
((LispSymbol *) Qstrings_equal)->function =
|
|
BUILTIN_FUNCTION_OBJ(hash_string);
|
|
|
|
register_manual_symbols();
|
|
register_globals();
|
|
|
|
lisp_init_stack();
|
|
}
|
|
|
|
void lisp_shutdown() {}
|
|
|
|
void debug_print(FILE *file, LispVal *obj) {
|
|
switch (TYPE_OF(obj)) {
|
|
case TYPE_FIXNUM:
|
|
fprintf(file, "%jd", (intmax_t) XFIXNUM(obj));
|
|
break;
|
|
case TYPE_FLOAT:
|
|
fprintf(file, "%f", (double) XLISP_FLOAT(obj));
|
|
break;
|
|
case TYPE_STRING: {
|
|
LispString *s = obj;
|
|
fputc('"', file);
|
|
fwrite(s->data, 1, s->length, file);
|
|
fputc('"', file);
|
|
break;
|
|
}
|
|
case TYPE_SYMBOL: {
|
|
LispString *name = ((LispSymbol *) obj)->name;
|
|
fwrite(name->data, 1, name->length, file);
|
|
break;
|
|
}
|
|
case TYPE_HASH_TABLE: {
|
|
fprintf(file, "<hash-table count=%zu at 0x%jx>",
|
|
((LispHashTable *) obj)->count, (uintmax_t) obj);
|
|
break;
|
|
}
|
|
case TYPE_FUNCTION: {
|
|
fprintf(file, "<function at 0x%jx>", (uintmax_t) obj);
|
|
break;
|
|
}
|
|
case TYPE_CONS: {
|
|
fputc('(', file);
|
|
FOREACH_TAIL(obj, tail) {
|
|
if (CONSP(tail)) {
|
|
debug_print(file, XCAR(tail));
|
|
if (!NILP(XCDR(tail))) {
|
|
fputc(' ', file);
|
|
}
|
|
} else {
|
|
fwrite(". ", 1, 2, file);
|
|
debug_print(file, tail);
|
|
}
|
|
}
|
|
fputc(')', file);
|
|
break;
|
|
}
|
|
case TYPE_VECTOR: {
|
|
LispVector *v = obj;
|
|
fputc('[', file);
|
|
for (size_t i = 0; i < v->length; ++i) {
|
|
debug_print(file, v->data[i]);
|
|
if (i < v->length - 1) {
|
|
fputc(' ', file);
|
|
}
|
|
}
|
|
fputc(']', file);
|
|
break;
|
|
}
|
|
default:
|
|
abort();
|
|
}
|
|
}
|
|
|
|
void debug_obj_info(FILE *file, LispVal *obj) {
|
|
fprintf(file, "%s -> ", LISP_TYPE_NAMES[TYPE_OF(obj)]);
|
|
debug_print(file, obj);
|
|
fputc('\n', file);
|
|
}
|