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(printf("\n"));
  45         }
  46 }
  47
  48 static void
  49 frame_vals_move(void *addr)
  50 {
  51         struct ao_scheme_frame_vals     *vals = addr;
  52         int                             f;
  53
  54         for (f = 0; f < vals->size; f++) {
  55                 struct ao_scheme_val    *v = &vals->vals[f];
  56
  57                 ao_scheme_poly_move(&v->atom, 0);
  58                 ao_scheme_poly_move(&v->val, 0);
  59                 MDBG_MOVE("frame move atom %s %d val %d at %d\n",
  60                           ao_scheme_poly_atom(v->atom)->name,
  61                           MDBG_OFFSET(ao_scheme_ref(v->atom)),
  62                           MDBG_OFFSET(ao_scheme_ref(v->val)), f);
  63         }
  64 }
  65
  66 const struct ao_scheme_type ao_scheme_frame_vals_type = {
  67         .mark = frame_vals_mark,
  68         .size = frame_vals_size,
  69         .move = frame_vals_move,
  70         .name = "frame_vals"
  71 };
  72
  73 static int
  74 frame_size(void *addr)
  75 {
  76         (void) addr;
  77         return sizeof (struct ao_scheme_frame);
  78 }
  79
  80 static void
  81 frame_mark(void *addr)
  82 {
  83         struct ao_scheme_frame  *frame = addr;
  84
  85         for (;;) {
  86                 struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
  87
  88                 MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
  89                 if (!AO_SCHEME_IS_POOL(frame))
  90                         break;
  91                 if (!ao_scheme_mark_memory(&ao_scheme_frame_vals_type, vals))
  92                         frame_vals_mark(vals);
  93                 frame = ao_scheme_poly_frame(frame->prev);
  94                 MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
  95                 if (!frame)
  96                         break;
  97                 if (ao_scheme_mark_memory(&ao_scheme_frame_type, frame))
  98                         break;
  99         }
 100 }
 101
 102 static void
 103 frame_move(void *addr)
 104 {
 105         struct ao_scheme_frame  *frame = addr;
 106
 107         for (;;) {
 108                 struct ao_scheme_frame          *prev;
 109                 struct ao_scheme_frame_vals     *vals;
 110                 int                             ret;
 111
 112                 MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
 113                 if (!AO_SCHEME_IS_POOL(frame))
 114                         break;
 115
 116                 vals = ao_scheme_poly_frame_vals(frame->vals);
 117                 if (!ao_scheme_move_memory(&ao_scheme_frame_vals_type, (void **) &vals))
 118                         frame_vals_move(vals);
 119                 if (vals != ao_scheme_poly_frame_vals(frame->vals))
 120                         frame->vals = ao_scheme_frame_vals_poly(vals);
 121
 122                 prev = ao_scheme_poly_frame(frame->prev);
 123                 if (!prev)
 124                         break;
 125                 ret = ao_scheme_move_memory(&ao_scheme_frame_type, (void **) &prev);
 126                 if (prev != ao_scheme_poly_frame(frame->prev)) {
 127                         MDBG_MOVE("frame prev moved from %d to %d\n",
 128                                   MDBG_OFFSET(ao_scheme_poly_frame(frame->prev)),
 129                                   MDBG_OFFSET(prev));
 130                         frame->prev = ao_scheme_frame_poly(prev);
 131                 }
 132                 if (ret)
 133                         break;
 134                 frame = prev;
 135         }
 136 }
 137
 138 const struct ao_scheme_type ao_scheme_frame_type = {
 139         .mark = frame_mark,
 140         .size = frame_size,
 141         .move = frame_move,
 142         .name = "frame",
 143 };
 144
 145 int ao_scheme_frame_print_indent;
 146
 147 static void
 148 ao_scheme_frame_indent(int extra)
 149 {
 150         int                             i;
 151         putchar('\n');
 152         for (i = 0; i < ao_scheme_frame_print_indent+extra; i++)
 153                 putchar('\t');
 154 }
 155
 156 void
 157 ao_scheme_frame_write(ao_poly p, bool write)
 158 {
 159         struct ao_scheme_frame          *frame = ao_scheme_poly_frame(p);
 160         struct ao_scheme_frame          *clear = frame;
 161         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 162         int                             f;
 163         int                             written = 0;
 164
 165         ao_scheme_print_start();
 166         while (frame) {
 167                 if (written != 0)
 168                         printf(", ");
 169                 if (ao_scheme_print_mark_addr(frame)) {
 170                         printf("recurse...");
 171                         break;
 172                 }
 173
 174                 putchar('{');
 175                 written++;
 176                 for (f = 0; f < frame->num; f++) {
 177                         ao_scheme_frame_indent(1);
 178                         ao_scheme_poly_write(vals->vals[f].atom, write);
 179                         printf(" = ");
 180                         ao_scheme_poly_write(vals->vals[f].val, write);
 181                 }
 182                 frame = ao_scheme_poly_frame(frame->prev);
 183                 ao_scheme_frame_indent(0);
 184                 putchar('}');
 185         }
 186         if (ao_scheme_print_stop()) {
 187                 while (written--) {
 188                         ao_scheme_print_clear_addr(clear);
 189                         clear = ao_scheme_poly_frame(clear->prev);
 190                 }
 191         }
 192 }
 193
 194 static int
 195 ao_scheme_frame_find(struct ao_scheme_frame *frame, int top, ao_poly atom)
 196 {
 197         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 198         int                             l = 0;
 199         int                             r = top - 1;
 200
 201         while (l <= r) {
 202                 int m = (l + r) >> 1;
 203                 if (vals->vals[m].atom < atom)
 204                         l = m + 1;
 205                 else
 206                         r = m - 1;
 207         }
 208         return l;
 209 }
 210
 211 ao_poly *
 212 ao_scheme_frame_ref(struct ao_scheme_frame *frame, ao_poly atom)
 213 {
 214         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 215         int                             l = ao_scheme_frame_find(frame, frame->num, atom);
 216
 217         if (l >= frame->num)
 218                 return NULL;
 219
 220         if (vals->vals[l].atom != atom)
 221                 return NULL;
 222         return &vals->vals[l].val;
 223 }
 224
 225 struct ao_scheme_frame  *ao_scheme_frame_free_list[AO_SCHEME_FRAME_FREE];
 226
 227 static struct ao_scheme_frame_vals *
 228 ao_scheme_frame_vals_new(int num)
 229 {
 230         struct ao_scheme_frame_vals     *vals;
 231
 232         vals = ao_scheme_alloc(frame_vals_num_size(num));
 233         if (!vals)
 234                 return NULL;
 235         vals->type = AO_SCHEME_FRAME_VALS;
 236         vals->size = num;
 237         memset(vals->vals, '\0', num * sizeof (struct ao_scheme_val));
 238         return vals;
 239 }
 240
 241 struct ao_scheme_frame *
 242 ao_scheme_frame_new(int num)
 243 {
 244         struct ao_scheme_frame          *frame;
 245         struct ao_scheme_frame_vals     *vals;
 246
 247         if (num < AO_SCHEME_FRAME_FREE && (frame = ao_scheme_frame_free_list[num])) {
 248                 ao_scheme_frame_free_list[num] = ao_scheme_poly_frame(frame->prev);
 249                 vals = ao_scheme_poly_frame_vals(frame->vals);
 250         } else {
 251                 frame = ao_scheme_alloc(sizeof (struct ao_scheme_frame));
 252                 if (!frame)
 253                         return NULL;
 254                 frame->type = AO_SCHEME_FRAME;
 255                 frame->num = 0;
 256                 frame->prev = AO_SCHEME_NIL;
 257                 frame->vals = AO_SCHEME_NIL;
 258                 ao_scheme_frame_stash(0, frame);
 259                 vals = ao_scheme_frame_vals_new(num);
 260                 frame = ao_scheme_frame_fetch(0);
 261                 if (!vals)
 262                         return NULL;
 263                 frame->vals = ao_scheme_frame_vals_poly(vals);
 264                 frame->num = num;
 265         }
 266         frame->prev = AO_SCHEME_NIL;
 267         return frame;
 268 }
 269
 270 ao_poly
 271 ao_scheme_frame_mark(struct ao_scheme_frame *frame)
 272 {
 273         if (!frame)
 274                 return AO_SCHEME_NIL;
 275         frame->type |= AO_SCHEME_FRAME_MARK;
 276         return ao_scheme_frame_poly(frame);
 277 }
 278
 279 void
 280 ao_scheme_frame_free(struct ao_scheme_frame *frame)
 281 {
 282         if (frame && !ao_scheme_frame_marked(frame)) {
 283                 int     num = frame->num;
 284                 if (num < AO_SCHEME_FRAME_FREE) {
 285                         struct ao_scheme_frame_vals     *vals;
 286
 287                         vals = ao_scheme_poly_frame_vals(frame->vals);
 288                         memset(vals->vals, '\0', vals->size * sizeof (struct ao_scheme_val));
 289                         frame->prev = ao_scheme_frame_poly(ao_scheme_frame_free_list[num]);
 290                         ao_scheme_frame_free_list[num] = frame;
 291                 }
 292         }
 293 }
 294
 295 static struct ao_scheme_frame *
 296 ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num)
 297 {
 298         struct ao_scheme_frame_vals     *vals;
 299         struct ao_scheme_frame_vals     *new_vals;
 300         int                             copy;
 301
 302         if (new_num == frame->num)
 303                 return frame;
 304         ao_scheme_frame_stash(0, frame);
 305         new_vals = ao_scheme_frame_vals_new(new_num);
 306         frame = ao_scheme_frame_fetch(0);
 307         if (!new_vals)
 308                 return NULL;
 309         vals = ao_scheme_poly_frame_vals(frame->vals);
 310         copy = new_num;
 311         if (copy > frame->num)
 312                 copy = frame->num;
 313         memcpy(new_vals->vals, vals->vals, copy * sizeof (struct ao_scheme_val));
 314         frame->vals = ao_scheme_frame_vals_poly(new_vals);
 315         frame->num = new_num;
 316         return frame;
 317 }
 318
 319 void
 320 ao_scheme_frame_bind(struct ao_scheme_frame *frame, int num, ao_poly atom, ao_poly val)
 321 {
 322         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 323         int                             l = ao_scheme_frame_find(frame, num, atom);
 324
 325         memmove(&vals->vals[l+1],
 326                 &vals->vals[l],
 327                 (num - l) * sizeof (struct ao_scheme_val));
 328         vals->vals[l].atom = atom;
 329         vals->vals[l].val = val;
 330 }
 331
 332 ao_poly
 333 ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val)
 334 {
 335         ao_poly *ref = frame ? ao_scheme_frame_ref(frame, atom) : NULL;
 336
 337         if (!ref) {
 338                 int f = frame->num;
 339                 ao_scheme_poly_stash(0, atom);
 340                 ao_scheme_poly_stash(1, val);
 341                 frame = ao_scheme_frame_realloc(frame, f + 1);
 342                 val = ao_scheme_poly_fetch(1);
 343                 atom = ao_scheme_poly_fetch(0);
 344                 if (!frame)
 345                         return AO_SCHEME_NIL;
 346                 ao_scheme_frame_bind(frame, frame->num - 1, atom, val);
 347         } else
 348                 *ref = val;
 349         return val;
 350 }
 351
 352 struct ao_scheme_frame  *ao_scheme_frame_global;
 353 struct ao_scheme_frame  *ao_scheme_frame_current;
 354
 355 void
 356 ao_scheme_frame_init(void)
 357 {
 358         if (!ao_scheme_frame_global)
 359                 ao_scheme_frame_global = ao_scheme_frame_new(0);
 360 }