git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_frame.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, either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * General Public License for more details.
  13  */
  14
  15 #include "ao_scheme.h"
  16
  17 static inline int
  18 frame_vals_num_size(int num)
  19 {
  20         return sizeof (struct ao_scheme_frame_vals) + num * sizeof (struct ao_scheme_val);
  21 }
  22
  23 static int
  24 frame_vals_size(void *addr)
  25 {
  26         struct ao_scheme_frame_vals     *vals = addr;
  27         return frame_vals_num_size(vals->size);
  28 }
  29
  30 static void
  31 frame_vals_mark(void *addr)
  32 {
  33         struct ao_scheme_frame_vals     *vals = addr;
  34         int                             f;
  35
  36         for (f = 0; f < vals->size; f++) {
  37                 struct ao_scheme_val    *v = &vals->vals[f];
  38
  39                 ao_scheme_poly_mark(v->val, 0);
  40                 MDBG_MOVE("frame mark atom %s %d val %d at %d    ",
  41                           ao_scheme_poly_atom(v->atom)->name,
  42                           MDBG_OFFSET(ao_scheme_ref(v->atom)),
  43                           MDBG_OFFSET(ao_scheme_ref(v->val)), f);
  44                 MDBG_DO(ao_scheme_poly_write(v->val));
  45                 MDBG_DO(printf("\n"));
  46         }
  47 }
  48
  49 static void
  50 frame_vals_move(void *addr)
  51 {
  52         struct ao_scheme_frame_vals     *vals = addr;
  53         int                             f;
  54
  55         for (f = 0; f < vals->size; f++) {
  56                 struct ao_scheme_val    *v = &vals->vals[f];
  57
  58                 ao_scheme_poly_move(&v->atom, 0);
  59                 ao_scheme_poly_move(&v->val, 0);
  60                 MDBG_MOVE("frame move atom %s %d val %d at %d\n",
  61                           ao_scheme_poly_atom(v->atom)->name,
  62                           MDBG_OFFSET(ao_scheme_ref(v->atom)),
  63                           MDBG_OFFSET(ao_scheme_ref(v->val)), f);
  64         }
  65 }
  66
  67 const struct ao_scheme_type ao_scheme_frame_vals_type = {
  68         .mark = frame_vals_mark,
  69         .size = frame_vals_size,
  70         .move = frame_vals_move,
  71         .name = "frame_vals"
  72 };
  73
  74 static int
  75 frame_size(void *addr)
  76 {
  77         (void) addr;
  78         return sizeof (struct ao_scheme_frame);
  79 }
  80
  81 static void
  82 frame_mark(void *addr)
  83 {
  84         struct ao_scheme_frame  *frame = addr;
  85
  86         for (;;) {
  87                 struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
  88
  89                 MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
  90                 if (!AO_SCHEME_IS_POOL(frame))
  91                         break;
  92                 if (!ao_scheme_mark_memory(&ao_scheme_frame_vals_type, vals))
  93                         frame_vals_mark(vals);
  94                 frame = ao_scheme_poly_frame(frame->prev);
  95                 MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
  96                 if (!frame)
  97                         break;
  98                 if (ao_scheme_mark_memory(&ao_scheme_frame_type, frame))
  99                         break;
 100         }
 101 }
 102
 103 static void
 104 frame_move(void *addr)
 105 {
 106         struct ao_scheme_frame  *frame = addr;
 107
 108         for (;;) {
 109                 struct ao_scheme_frame          *prev;
 110                 struct ao_scheme_frame_vals     *vals;
 111                 int                             ret;
 112
 113                 MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
 114                 if (!AO_SCHEME_IS_POOL(frame))
 115                         break;
 116
 117                 vals = ao_scheme_poly_frame_vals(frame->vals);
 118                 if (!ao_scheme_move_memory(&ao_scheme_frame_vals_type, (void **) &vals))
 119                         frame_vals_move(vals);
 120                 if (vals != ao_scheme_poly_frame_vals(frame->vals))
 121                         frame->vals = ao_scheme_frame_vals_poly(vals);
 122
 123                 prev = ao_scheme_poly_frame(frame->prev);
 124                 if (!prev)
 125                         break;
 126                 ret = ao_scheme_move_memory(&ao_scheme_frame_type, (void **) &prev);
 127                 if (prev != ao_scheme_poly_frame(frame->prev)) {
 128                         MDBG_MOVE("frame prev moved from %d to %d\n",
 129                                   MDBG_OFFSET(ao_scheme_poly_frame(frame->prev)),
 130                                   MDBG_OFFSET(prev));
 131                         frame->prev = ao_scheme_frame_poly(prev);
 132                 }
 133                 if (ret)
 134                         break;
 135                 frame = prev;
 136         }
 137 }
 138
 139 const struct ao_scheme_type ao_scheme_frame_type = {
 140         .mark = frame_mark,
 141         .size = frame_size,
 142         .move = frame_move,
 143         .name = "frame",
 144 };
 145
 146 void
 147 ao_scheme_frame_write(ao_poly p)
 148 {
 149         struct ao_scheme_frame          *frame = ao_scheme_poly_frame(p);
 150         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 151         int                             f;
 152
 153         printf ("{");
 154         if (frame) {
 155                 if (frame->type & AO_SCHEME_FRAME_PRINT)
 156                         printf("recurse...");
 157                 else {
 158                         frame->type |= AO_SCHEME_FRAME_PRINT;
 159                         for (f = 0; f < frame->num; f++) {
 160                                 if (f != 0)
 161                                         printf(", ");
 162                                 ao_scheme_poly_write(vals->vals[f].atom);
 163                                 printf(" = ");
 164                                 ao_scheme_poly_write(vals->vals[f].val);
 165                         }
 166                         if (frame->prev)
 167                                 ao_scheme_poly_write(frame->prev);
 168                         frame->type &= ~AO_SCHEME_FRAME_PRINT;
 169                 }
 170         }
 171         printf("}");
 172 }
 173
 174 static int
 175 ao_scheme_frame_find(struct ao_scheme_frame *frame, int top, ao_poly atom)
 176 {
 177         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 178         int                             l = 0;
 179         int                             r = top - 1;
 180
 181         while (l <= r) {
 182                 int m = (l + r) >> 1;
 183                 if (vals->vals[m].atom < atom)
 184                         l = m + 1;
 185                 else
 186                         r = m - 1;
 187         }
 188         return l;
 189 }
 190
 191 ao_poly *
 192 ao_scheme_frame_ref(struct ao_scheme_frame *frame, ao_poly atom)
 193 {
 194         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 195         int                             l = ao_scheme_frame_find(frame, frame->num, atom);
 196
 197         if (l >= frame->num)
 198                 return NULL;
 199
 200         if (vals->vals[l].atom != atom)
 201                 return NULL;
 202         return &vals->vals[l].val;
 203 }
 204
 205 struct ao_scheme_frame  *ao_scheme_frame_free_list[AO_SCHEME_FRAME_FREE];
 206
 207 static struct ao_scheme_frame_vals *
 208 ao_scheme_frame_vals_new(int num)
 209 {
 210         struct ao_scheme_frame_vals     *vals;
 211
 212         vals = ao_scheme_alloc(frame_vals_num_size(num));
 213         if (!vals)
 214                 return NULL;
 215         vals->type = AO_SCHEME_FRAME_VALS;
 216         vals->size = num;
 217         memset(vals->vals, '\0', num * sizeof (struct ao_scheme_val));
 218         return vals;
 219 }
 220
 221 struct ao_scheme_frame *
 222 ao_scheme_frame_new(int num)
 223 {
 224         struct ao_scheme_frame          *frame;
 225         struct ao_scheme_frame_vals     *vals;
 226
 227         if (num < AO_SCHEME_FRAME_FREE && (frame = ao_scheme_frame_free_list[num])) {
 228                 ao_scheme_frame_free_list[num] = ao_scheme_poly_frame(frame->prev);
 229                 vals = ao_scheme_poly_frame_vals(frame->vals);
 230         } else {
 231                 frame = ao_scheme_alloc(sizeof (struct ao_scheme_frame));
 232                 if (!frame)
 233                         return NULL;
 234                 frame->type = AO_SCHEME_FRAME;
 235                 frame->num = 0;
 236                 frame->prev = AO_SCHEME_NIL;
 237                 frame->vals = AO_SCHEME_NIL;
 238                 ao_scheme_frame_stash(0, frame);
 239                 vals = ao_scheme_frame_vals_new(num);
 240                 frame = ao_scheme_frame_fetch(0);
 241                 if (!vals)
 242                         return NULL;
 243                 frame->vals = ao_scheme_frame_vals_poly(vals);
 244                 frame->num = num;
 245         }
 246         frame->prev = AO_SCHEME_NIL;
 247         return frame;
 248 }
 249
 250 ao_poly
 251 ao_scheme_frame_mark(struct ao_scheme_frame *frame)
 252 {
 253         if (!frame)
 254                 return AO_SCHEME_NIL;
 255         frame->type |= AO_SCHEME_FRAME_MARK;
 256         return ao_scheme_frame_poly(frame);
 257 }
 258
 259 void
 260 ao_scheme_frame_free(struct ao_scheme_frame *frame)
 261 {
 262         if (frame && !ao_scheme_frame_marked(frame)) {
 263                 int     num = frame->num;
 264                 if (num < AO_SCHEME_FRAME_FREE) {
 265                         struct ao_scheme_frame_vals     *vals;
 266
 267                         vals = ao_scheme_poly_frame_vals(frame->vals);
 268                         memset(vals->vals, '\0', vals->size * sizeof (struct ao_scheme_val));
 269                         frame->prev = ao_scheme_frame_poly(ao_scheme_frame_free_list[num]);
 270                         ao_scheme_frame_free_list[num] = frame;
 271                 }
 272         }
 273 }
 274
 275 static struct ao_scheme_frame *
 276 ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num)
 277 {
 278         struct ao_scheme_frame_vals     *vals;
 279         struct ao_scheme_frame_vals     *new_vals;
 280         int                             copy;
 281
 282         if (new_num == frame->num)
 283                 return frame;
 284         ao_scheme_frame_stash(0, frame);
 285         new_vals = ao_scheme_frame_vals_new(new_num);
 286         frame = ao_scheme_frame_fetch(0);
 287         if (!new_vals)
 288                 return NULL;
 289         vals = ao_scheme_poly_frame_vals(frame->vals);
 290         copy = new_num;
 291         if (copy > frame->num)
 292                 copy = frame->num;
 293         memcpy(new_vals->vals, vals->vals, copy * sizeof (struct ao_scheme_val));
 294         frame->vals = ao_scheme_frame_vals_poly(new_vals);
 295         frame->num = new_num;
 296         return frame;
 297 }
 298
 299 void
 300 ao_scheme_frame_bind(struct ao_scheme_frame *frame, int num, ao_poly atom, ao_poly val)
 301 {
 302         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 303         int                             l = ao_scheme_frame_find(frame, num, atom);
 304
 305         memmove(&vals->vals[l+1],
 306                 &vals->vals[l],
 307                 (num - l) * sizeof (struct ao_scheme_val));
 308         vals->vals[l].atom = atom;
 309         vals->vals[l].val = val;
 310 }
 311
 312 ao_poly
 313 ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val)
 314 {
 315         ao_poly *ref = frame ? ao_scheme_frame_ref(frame, atom) : NULL;
 316
 317         if (!ref) {
 318                 int f = frame->num;
 319                 ao_scheme_poly_stash(0, atom);
 320                 ao_scheme_poly_stash(1, val);
 321                 frame = ao_scheme_frame_realloc(frame, f + 1);
 322                 val = ao_scheme_poly_fetch(1);
 323                 atom = ao_scheme_poly_fetch(0);
 324                 if (!frame)
 325                         return AO_SCHEME_NIL;
 326                 ao_scheme_frame_bind(frame, frame->num - 1, atom, val);
 327         } else
 328                 *ref = val;
 329         return val;
 330 }
 331
 332 struct ao_scheme_frame  *ao_scheme_frame_global;
 333 struct ao_scheme_frame  *ao_scheme_frame_current;
 334
 335 void
 336 ao_scheme_frame_init(void)
 337 {
 338         if (!ao_scheme_frame_global)
 339                 ao_scheme_frame_global = ao_scheme_frame_new(0);
 340 }