git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_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_scheme.h"
  19
  20 static int name_size(char *name)
  21 {
  22         return sizeof(struct ao_scheme_atom) + strlen(name) + 1;
  23 }
  24
  25 static int atom_size(void *addr)
  26 {
  27         struct ao_scheme_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_scheme_atom   *atom = addr;
  36
  37         for (;;) {
  38                 atom = ao_scheme_poly_atom(atom->next);
  39                 if (!atom)
  40                         break;
  41                 if (ao_scheme_mark_memory(&ao_scheme_atom_type, atom))
  42                         break;
  43         }
  44 }
  45
  46 static void atom_move(void *addr)
  47 {
  48         struct ao_scheme_atom   *atom = addr;
  49         int                     ret;
  50
  51         for (;;) {
  52                 struct ao_scheme_atom *next = ao_scheme_poly_atom(atom->next);
  53
  54                 if (!next)
  55                         break;
  56                 ret = ao_scheme_move_memory(&ao_scheme_atom_type, (void **) &next);
  57                 if (next != ao_scheme_poly_atom(atom->next))
  58                         atom->next = ao_scheme_atom_poly(next);
  59                 if (ret)
  60                         break;
  61                 atom = next;
  62         }
  63 }
  64
  65 const struct ao_scheme_type ao_scheme_atom_type = {
  66         .mark = atom_mark,
  67         .size = atom_size,
  68         .move = atom_move,
  69         .name = "atom"
  70 };
  71
  72 struct ao_scheme_atom   *ao_scheme_atoms;
  73
  74 struct ao_scheme_atom *
  75 ao_scheme_atom_intern(char *name)
  76 {
  77         struct ao_scheme_atom   *atom;
  78
  79         for (atom = ao_scheme_atoms; atom; atom = ao_scheme_poly_atom(atom->next)) {
  80                 if (!strcmp(atom->name, name))
  81                         return atom;
  82         }
  83 #ifdef ao_builtin_atoms
  84         for (atom = ao_scheme_poly_atom(ao_builtin_atoms); atom; atom = ao_scheme_poly_atom(atom->next)) {
  85                 if (!strcmp(atom->name, name))
  86                         return atom;
  87         }
  88 #endif
  89         ao_scheme_string_stash(0, name);
  90         atom = ao_scheme_alloc(name_size(name));
  91         name = ao_scheme_string_fetch(0);
  92         if (atom) {
  93                 atom->type = AO_SCHEME_ATOM;
  94                 atom->next = ao_scheme_atom_poly(ao_scheme_atoms);
  95                 ao_scheme_atoms = atom;
  96                 strcpy(atom->name, name);
  97         }
  98         return atom;
  99 }
 100
 101 ao_poly *
 102 ao_scheme_atom_ref(ao_poly atom, struct ao_scheme_frame **frame_ref)
 103 {
 104         ao_poly *ref;
 105         struct ao_scheme_frame *frame;
 106
 107         for (frame = ao_scheme_frame_current; frame; frame = ao_scheme_poly_frame(frame->prev)) {
 108                 ref = ao_scheme_frame_ref(frame, atom);
 109                 if (ref) {
 110                         if (frame_ref)
 111                                 *frame_ref = frame;
 112                         return ref;
 113                 }
 114         }
 115         ref = ao_scheme_frame_ref(ao_scheme_frame_global, atom);
 116         if (ref)
 117                 if (frame_ref)
 118                         *frame_ref = ao_scheme_frame_global;
 119         return ref;
 120 }
 121
 122 ao_poly
 123 ao_scheme_atom_get(ao_poly atom)
 124 {
 125         ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
 126
 127 #ifdef ao_builtin_frame
 128         if (!ref)
 129                 ref = ao_scheme_frame_ref(ao_scheme_poly_frame(ao_builtin_frame), atom);
 130 #endif
 131         if (ref)
 132                 return *ref;
 133         return ao_scheme_error(AO_SCHEME_UNDEFINED, "undefined atom %s", ao_scheme_poly_atom(atom)->name);
 134 }
 135
 136 ao_poly
 137 ao_scheme_atom_set(ao_poly atom, ao_poly val)
 138 {
 139         ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
 140
 141         if (!ref)
 142                 return ao_scheme_error(AO_SCHEME_UNDEFINED, "undefined atom %s", ao_scheme_poly_atom(atom)->name);
 143         *ref = val;
 144         return val;
 145 }
 146
 147 ao_poly
 148 ao_scheme_atom_def(ao_poly atom, ao_poly val)
 149 {
 150         struct ao_scheme_frame  *frame;
 151         ao_poly *ref = ao_scheme_atom_ref(atom, &frame);
 152
 153         if (ref) {
 154                 if (frame == ao_scheme_frame_current)
 155                         return ao_scheme_error(AO_SCHEME_REDEFINED, "attempt to redefine atom %s", ao_scheme_poly_atom(atom)->name);
 156                 *ref = val;
 157                 return val;
 158         }
 159         return ao_scheme_frame_add(ao_scheme_frame_current ? ao_scheme_frame_current : ao_scheme_frame_global, atom, val);
 160 }
 161
 162 void
 163 ao_scheme_atom_write(ao_poly a)
 164 {
 165         struct ao_scheme_atom *atom = ao_scheme_poly_atom(a);
 166         printf("%s", atom->name);
 167 }