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 #if 0
  21 #define DBG(...)        printf(__VA_ARGS__)
  22 #else
  23 #define DBG(...)
  24 #endif
  25
  26 static int name_size(char *name)
  27 {
  28         return sizeof(struct ao_lisp_atom) + strlen(name) + 1;
  29 }
  30
  31 static int atom_size(void *addr)
  32 {
  33         struct ao_lisp_atom     *atom = addr;
  34         if (!atom)
  35                 return 0;
  36         return name_size(atom->name);
  37 }
  38
  39 static void atom_mark(void *addr)
  40 {
  41         struct ao_lisp_atom     *atom = addr;
  42
  43         DBG ("\tatom start %s\n", atom->name);
  44         for (;;) {
  45                 atom = ao_lisp_poly_atom(atom->next);
  46                 if (!atom)
  47                         break;
  48                 DBG("\t\tatom mark %s %d\n", atom->name, (uint8_t *) atom - ao_lisp_const);
  49                 if (ao_lisp_mark_memory(atom, atom_size(atom)))
  50                         break;
  51         }
  52         DBG ("\tatom done\n");
  53 }
  54
  55 static void atom_move(void *addr)
  56 {
  57         struct ao_lisp_atom     *atom = addr;
  58
  59         DBG("\tatom move start %s %d next %s %d\n",
  60             atom->name, ((uint8_t *) atom - ao_lisp_const),
  61             atom->next ? ao_lisp_poly_atom(atom->next)->name : "(none)",
  62             atom->next ? ((uint8_t *) ao_lisp_poly_atom(atom->next) - ao_lisp_const) : 0);
  63         for (;;) {
  64                 struct ao_lisp_atom     *next;
  65
  66                 next = ao_lisp_poly_atom(atom->next);
  67                 next = ao_lisp_move_memory(next, atom_size(next));
  68                 if (!next)
  69                         break;
  70                 DBG("\t\tatom move %s %d->%d\n", next->name, ((uint8_t *) ao_lisp_poly_atom(atom->next) - ao_lisp_const), ((uint8_t *) next - ao_lisp_const));
  71                 atom->next = ao_lisp_atom_poly(next);
  72                 atom = next;
  73         }
  74         DBG("\tatom move end\n");
  75 }
  76
  77 const struct ao_lisp_type ao_lisp_atom_type = {
  78         .mark = atom_mark,
  79         .size = atom_size,
  80         .move = atom_move,
  81 };
  82
  83 struct ao_lisp_atom     *ao_lisp_atoms;
  84
  85 struct ao_lisp_atom *
  86 ao_lisp_atom_intern(char *name)
  87 {
  88         struct ao_lisp_atom     *atom;
  89
  90         for (atom = ao_lisp_atoms; atom; atom = ao_lisp_poly_atom(atom->next)) {
  91                 if (!strcmp(atom->name, name))
  92                         return atom;
  93         }
  94 #ifdef ao_builtin_atoms
  95         for (atom = ao_lisp_poly_atom(ao_builtin_atoms); atom; atom = ao_lisp_poly_atom(atom->next)) {
  96                 if (!strcmp(atom->name, name))
  97                         return atom;
  98         }
  99 #endif
 100         atom = ao_lisp_alloc(name_size(name));
 101         if (atom) {
 102                 atom->type = AO_LISP_ATOM;
 103                 atom->next = ao_lisp_atom_poly(ao_lisp_atoms);
 104                 if (!ao_lisp_atoms)
 105                         ao_lisp_root_add(&ao_lisp_atom_type, &ao_lisp_atoms);
 106                 ao_lisp_atoms = atom;
 107                 strcpy(atom->name, name);
 108         }
 109         return atom;
 110 }
 111
 112 static struct ao_lisp_frame     *ao_lisp_frame_global;
 113 struct ao_lisp_frame            *ao_lisp_frame_current;
 114
 115 static void
 116 ao_lisp_atom_init(void)
 117 {
 118         if (!ao_lisp_frame_global) {
 119                 ao_lisp_frame_global = ao_lisp_frame_new(0, 0);
 120                 ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_global);
 121                 ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_current);
 122         }
 123 }
 124
 125 static ao_poly *
 126 ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom)
 127 {
 128         ao_poly *ref;
 129         ao_lisp_atom_init();
 130         while (frame) {
 131                 ref = ao_lisp_frame_ref(frame, atom);
 132                 if (ref)
 133                         return ref;
 134                 frame = ao_lisp_poly_frame(frame->next);
 135         }
 136         if (ao_lisp_frame_global) {
 137                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 138                 if (ref)
 139                         return ref;
 140         }
 141         return NULL;
 142 }
 143
 144 ao_poly
 145 ao_lisp_atom_get(ao_poly atom)
 146 {
 147         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 148
 149         if (!ref && ao_lisp_frame_global)
 150                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 151 #ifdef ao_builtin_frame
 152         if (!ref)
 153                 ref = ao_lisp_frame_ref(ao_lisp_poly_frame(ao_builtin_frame), atom);
 154 #endif
 155         if (ref)
 156                 return *ref;
 157         return AO_LISP_NIL;
 158 }
 159
 160 ao_poly
 161 ao_lisp_atom_set(ao_poly atom, ao_poly val)
 162 {
 163         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 164
 165         if (!ref && ao_lisp_frame_global)
 166                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 167         if (ref)
 168                 *ref = val;
 169         else
 170                 ao_lisp_frame_global = ao_lisp_frame_add(ao_lisp_frame_global, atom, val);
 171         return val;
 172 }
 173
 174 void
 175 ao_lisp_atom_print(ao_poly a)
 176 {
 177         struct ao_lisp_atom *atom = ao_lisp_poly_atom(a);
 178         printf("%s", atom->name);
 179 }