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(atom, atom_size(atom)))
  42                         break;
  43         }
  44 }
  45
  46 static void atom_move(void *addr)
  47 {
  48         struct ao_lisp_atom     *atom = addr;
  49
  50         for (;;) {
  51                 if (ao_lisp_poly_move(&atom->next, 0))
  52                         break;
  53                 atom = ao_lisp_poly_atom(atom->next);
  54         }
  55 }
  56
  57 const struct ao_lisp_type ao_lisp_atom_type = {
  58         .mark = atom_mark,
  59         .size = atom_size,
  60         .move = atom_move,
  61 };
  62
  63 struct ao_lisp_atom     *ao_lisp_atoms;
  64
  65 struct ao_lisp_atom *
  66 ao_lisp_atom_intern(char *name)
  67 {
  68         struct ao_lisp_atom     *atom;
  69
  70         for (atom = ao_lisp_atoms; atom; atom = ao_lisp_poly_atom(atom->next)) {
  71                 if (!strcmp(atom->name, name))
  72                         return atom;
  73         }
  74 #ifdef ao_builtin_atoms
  75         for (atom = ao_lisp_poly_atom(ao_builtin_atoms); atom; atom = ao_lisp_poly_atom(atom->next)) {
  76                 if (!strcmp(atom->name, name))
  77                         return atom;
  78         }
  79 #endif
  80         atom = ao_lisp_alloc(name_size(name));
  81         if (atom) {
  82                 atom->type = AO_LISP_ATOM;
  83                 atom->next = ao_lisp_atom_poly(ao_lisp_atoms);
  84                 if (!ao_lisp_atoms)
  85                         ao_lisp_root_add(&ao_lisp_atom_type, &ao_lisp_atoms);
  86                 ao_lisp_atoms = atom;
  87                 strcpy(atom->name, name);
  88         }
  89         return atom;
  90 }
  91
  92 struct ao_lisp_frame    *ao_lisp_frame_global;
  93 struct ao_lisp_frame    *ao_lisp_frame_current;
  94
  95 static void
  96 ao_lisp_atom_init(void)
  97 {
  98         if (!ao_lisp_frame_global) {
  99                 ao_lisp_frame_global = ao_lisp_frame_new(0);
 100                 ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_global);
 101                 ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_current);
 102         }
 103 }
 104
 105 static ao_poly *
 106 ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom)
 107 {
 108         ao_poly *ref;
 109         ao_lisp_atom_init();
 110         while (frame) {
 111                 ref = ao_lisp_frame_ref(frame, atom);
 112                 if (ref)
 113                         return ref;
 114                 frame = ao_lisp_poly_frame(frame->next);
 115         }
 116         if (ao_lisp_frame_global) {
 117                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 118                 if (ref)
 119                         return ref;
 120         }
 121         return NULL;
 122 }
 123
 124 ao_poly
 125 ao_lisp_atom_get(ao_poly atom)
 126 {
 127         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 128
 129         if (!ref && ao_lisp_frame_global)
 130                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 131 #ifdef ao_builtin_frame
 132         if (!ref)
 133                 ref = ao_lisp_frame_ref(ao_lisp_poly_frame(ao_builtin_frame), atom);
 134 #endif
 135         if (ref)
 136                 return *ref;
 137         return AO_LISP_NIL;
 138 }
 139
 140 ao_poly
 141 ao_lisp_atom_set(ao_poly atom, ao_poly val)
 142 {
 143         ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_current, atom);
 144
 145         if (!ref && ao_lisp_frame_global)
 146                 ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 147         if (ref)
 148                 *ref = val;
 149         else
 150                 ao_lisp_frame_global = ao_lisp_frame_add(ao_lisp_frame_global, atom, val);
 151         return val;
 152 }
 153
 154 void
 155 ao_lisp_atom_print(ao_poly a)
 156 {
 157         struct ao_lisp_atom *atom = ao_lisp_poly_atom(a);
 158         printf("%s", atom->name);
 159 }