X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_atom.c;h=8c9e8ed11346ae5062c3f601ba38b6406f91233d;hp=aaa84b8d1bcf872554548251429fb075ff9c777e;hb=881161fe1c5fb0e2b1220c30572eb2c45bedbafe;hpb=d2408e72d1e0d3459918601712b09860ab17e200 diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c index aaa84b8d..8c9e8ed1 100644 --- a/src/lisp/ao_lisp_atom.c +++ b/src/lisp/ao_lisp_atom.c @@ -35,11 +35,10 @@ static void atom_mark(void *addr) struct ao_lisp_atom *atom = addr; for (;;) { - ao_lisp_poly_mark(atom->val); atom = ao_lisp_poly_atom(atom->next); if (!atom) break; - if (ao_lisp_mark_memory(atom, atom_size(atom))) + if (ao_lisp_mark_memory(&ao_lisp_atom_type, atom)) break; } } @@ -47,16 +46,18 @@ static void atom_mark(void *addr) static void atom_move(void *addr) { struct ao_lisp_atom *atom = addr; + int ret; for (;;) { - struct ao_lisp_atom *next; + struct ao_lisp_atom *next = ao_lisp_poly_atom(atom->next); - atom->val = ao_lisp_poly_move(atom->val); - next = ao_lisp_poly_atom(atom->next); - next = ao_lisp_move_memory(next, atom_size(next)); if (!next) break; - atom->next = ao_lisp_atom_poly(next); + ret = ao_lisp_move_memory(&ao_lisp_atom_type, (void **) &next); + if (next != ao_lisp_poly_atom(atom->next)) + atom->next = ao_lisp_atom_poly(next); + if (ret) + break; atom = next; } } @@ -65,6 +66,7 @@ const struct ao_lisp_type ao_lisp_atom_type = { .mark = atom_mark, .size = atom_size, .move = atom_move, + .name = "atom" }; struct ao_lisp_atom *ao_lisp_atoms; @@ -73,7 +75,6 @@ struct ao_lisp_atom * ao_lisp_atom_intern(char *name) { struct ao_lisp_atom *atom; -// int b; for (atom = ao_lisp_atoms; atom; atom = ao_lisp_poly_atom(atom->next)) { if (!strcmp(atom->name, name)) @@ -85,19 +86,77 @@ ao_lisp_atom_intern(char *name) return atom; } #endif - if (!ao_lisp_atoms) - ao_lisp_root_add(&ao_lisp_atom_type, (void **) &ao_lisp_atoms); + ao_lisp_string_stash(0, name); atom = ao_lisp_alloc(name_size(name)); + name = ao_lisp_string_fetch(0); if (atom) { atom->type = AO_LISP_ATOM; atom->next = ao_lisp_atom_poly(ao_lisp_atoms); ao_lisp_atoms = atom; strcpy(atom->name, name); - atom->val = AO_LISP_NIL; } return atom; } +struct ao_lisp_frame *ao_lisp_frame_global; +struct ao_lisp_frame *ao_lisp_frame_current; + +static void +ao_lisp_atom_init(void) +{ + if (!ao_lisp_frame_global) + ao_lisp_frame_global = ao_lisp_frame_new(0); +} + +ao_poly * +ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom) +{ + ao_poly *ref; + ao_lisp_atom_init(); + while (frame) { + ref = ao_lisp_frame_ref(frame, atom); + if (ref) + return ref; + frame = ao_lisp_poly_frame(frame->prev); + } + if (ao_lisp_frame_global) { + ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom); + if (ref) + return ref; + } + return NULL; +} + +ao_poly +ao_lisp_atom_get(ao_poly atom) +{ + ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom); + + if (!ref && ao_lisp_frame_global) + ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom); +#ifdef ao_builtin_frame + if (!ref) + ref = ao_lisp_frame_ref(ao_lisp_poly_frame(ao_builtin_frame), atom); +#endif + if (ref) + return *ref; + return ao_lisp_error(AO_LISP_UNDEFINED, "undefined atom %s", ao_lisp_poly_atom(atom)->name); +} + +ao_poly +ao_lisp_atom_set(ao_poly atom, ao_poly val) +{ + ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom); + + if (!ref && ao_lisp_frame_global) + ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom); + if (ref) + *ref = val; + else + ao_lisp_frame_add(&ao_lisp_frame_global, atom, val); + return val; +} + void ao_lisp_atom_print(ao_poly a) {