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 ao_poly *
 102 ao_lisp_atom_ref(ao_poly atom)
 103 {
 104         ao_poly *ref;
 105         struct ao_lisp_frame *frame;
 106
 107         for (frame = ao_lisp_frame_current; frame; frame = ao_lisp_poly_frame(frame->prev)) {
 108                 ref = ao_lisp_frame_ref(frame, atom);
 109                 if (ref)
 110                         return ref;
 111         }
 112         return ao_lisp_frame_ref(ao_lisp_frame_global, atom);
 113 }
 114
 115 ao_poly
 116 ao_lisp_atom_get(ao_poly atom)
 117 {
 118         ao_poly *ref = ao_lisp_atom_ref(atom);
 119
 120 #ifdef ao_builtin_frame
 121         if (!ref)
 122                 ref = ao_lisp_frame_ref(ao_lisp_poly_frame(ao_builtin_frame), atom);
 123 #endif
 124         if (ref)
 125                 return *ref;
 126         return ao_lisp_error(AO_LISP_UNDEFINED, "undefined atom %s", ao_lisp_poly_atom(atom)->name);
 127 }
 128
 129 ao_poly
 130 ao_lisp_atom_set(ao_poly atom, ao_poly val)
 131 {
 132         ao_poly *ref = ao_lisp_atom_ref(atom);
 133
 134         if (!ref)
 135                 return ao_lisp_error(AO_LISP_UNDEFINED, "undefined atom %s", ao_lisp_poly_atom(atom)->name);
 136         *ref = val;
 137         return val;
 138 }
 139
 140 ao_poly
 141 ao_lisp_atom_def(ao_poly atom, ao_poly val)
 142 {
 143         ao_poly *ref = ao_lisp_atom_ref(atom);
 144
 145         if (ref) {
 146                 if (ao_lisp_frame_current)
 147                         return ao_lisp_error(AO_LISP_REDEFINED, "attempt to redefine atom %s", ao_lisp_poly_atom(atom)->name);
 148                 *ref = val;
 149                 return val;
 150         }
 151         return ao_lisp_frame_add(ao_lisp_frame_current ? ao_lisp_frame_current : ao_lisp_frame_global, atom, val);
 152 }
 153
 154 void
 155 ao_lisp_atom_write(ao_poly a)
 156 {
 157         struct ao_lisp_atom *atom = ao_lisp_poly_atom(a);
 158         printf("%s", atom->name);
 159 }