git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_atom.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; version 2 of the License.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
  16  */
  17
  18 #include "ao_lisp.h"
  19
  20 static int name_size(char *name)
  21 {
  22         return sizeof(struct ao_lisp_atom) + strlen(name) + 1;
  23 }
  24
  25 static int atom_size(void *addr)
  26 {
  27         struct ao_lisp_atom     *atom = addr;
  28         if (!atom)
  29                 return 0;
  30         return name_size(atom->name);
  31 }
  32
  33 static void atom_mark(void *addr)
  34 {
  35         struct ao_lisp_atom     *atom = addr;
  36
  37         for (;;) {
  38                 atom = ao_lisp_poly_atom(atom->next);
  39                 if (!atom)
  40                         break;
  41                 if (ao_lisp_mark_memory(&ao_lisp_atom_type, atom))
  42                         break;
  43         }
  44 }
  45
  46 static void atom_move(void *addr)
  47 {
  48         struct ao_lisp_atom     *atom = addr;
  49         int                     ret;
  50
  51         for (;;) {
  52                 struct ao_lisp_atom *next = ao_lisp_poly_atom(atom->next);
  53
  54                 if (!next)
  55                         break;
  56                 ret = ao_lisp_move_memory(&ao_lisp_atom_type, (void **) &next);
  57                 if (next != ao_lisp_poly_atom(atom->next))
  58                         atom->next = ao_lisp_atom_poly(next);
  59                 if (ret)
  60                         break;
  61                 atom = next;
  62         }
  63 }
  64
  65 const struct ao_lisp_type ao_lisp_atom_type = {
  66         .mark = atom_mark,
  67         .size = atom_size,
  68         .move = atom_move,
  69         .name = "atom"
  70 };
  71
  72 struct ao_lisp_atom     *ao_lisp_atoms;
  73
  74 struct ao_lisp_atom *
  75 ao_lisp_atom_intern(char *name)
  76 {
  77         struct ao_lisp_atom     *atom;
  78
  79         for (atom = ao_lisp_atoms; atom; atom = ao_lisp_poly_atom(atom->next)) {
  80                 if (!strcmp(atom->name, name))
  81                         return atom;
  82         }
  83 #ifdef ao_builtin_atoms
  84         for (atom = ao_lisp_poly_atom(ao_builtin_atoms); atom; atom = ao_lisp_poly_atom(atom->next)) {
  85                 if (!strcmp(atom->name, name))
  86                         return atom;
  87         }
  88 #endif
  89         ao_lisp_string_stash(0, name);
  90         atom = ao_lisp_alloc(name_size(name));
  91         name = ao_lisp_string_fetch(0);
  92         if (atom) {
  93                 atom->type = AO_LISP_ATOM;
  94                 atom->next = ao_lisp_atom_poly(ao_lisp_atoms);
  95                 ao_lisp_atoms = atom;
  96                 strcpy(atom->name, name);
  97         }
  98         return atom;
  99 }
 100
 101 struct ao_lisp_frame    *ao_lisp_frame_global;
 102 struct ao_lisp_frame    *ao_lisp_frame_current;
 103
 104 static void
 105 ao_lisp_atom_init(void)
 106 {
 107         if (!ao_lisp_frame_global)
 108                 ao_lisp_frame_global = ao_lisp_frame_new(0);
 109 }
 110
 111 static ao_poly *
 112 ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom)
 113 {
 114         ao_poly *ref;
 115         ao_lisp_atom_init();
 116         while (frame) {
 117                 ref = ao_lisp_frame_ref(frame, atom);
 118                 if (ref)
 119                         return ref;
 120                 frame = ao_lisp_poly_frame(frame->next);
 121         }
 122         if (ao_lisp_frame_global) {
 123                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 124                 if (ref)
 125                         return ref;
 126         }
 127         return NULL;
 128 }
 129
 130 ao_poly
 131 ao_lisp_atom_get(ao_poly atom)
 132 {
 133         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 134
 135         if (!ref && ao_lisp_frame_global)
 136                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 137 #ifdef ao_builtin_frame
 138         if (!ref)
 139                 ref = ao_lisp_frame_ref(ao_lisp_poly_frame(ao_builtin_frame), atom);
 140 #endif
 141         if (ref)
 142                 return *ref;
 143         return ao_lisp_error(AO_LISP_UNDEFINED, "undefined atom %s", ao_lisp_poly_atom(atom)->name);
 144 }
 145
 146 ao_poly
 147 ao_lisp_atom_set(ao_poly atom, ao_poly val)
 148 {
 149         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 150
 151         if (!ref && ao_lisp_frame_global)
 152                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 153         if (ref)
 154                 *ref = val;
 155         else
 156                 ao_lisp_frame_add(&ao_lisp_frame_global, atom, val);
 157         return val;
 158 }
 159
 160 void
 161 ao_lisp_atom_print(ao_poly a)
 162 {
 163         struct ao_lisp_atom *atom = ao_lisp_poly_atom(a);
 164         printf("%s", atom->name);
 165 }