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->atom, 0);
  40                 ao_scheme_poly_mark(v->val, 0);
  41                 MDBG_MOVE("frame mark atom %s %d val %d at %d\n",
  42                           ao_scheme_poly_atom(v->atom)->name,
  43                           MDBG_OFFSET(ao_scheme_ref(v->atom)),
  44                           MDBG_OFFSET(ao_scheme_ref(v->val)), f);
  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_mark_memory(&ao_scheme_frame_vals_type, vals))
  90                         frame_vals_mark(vals);
  91                 frame = ao_scheme_poly_frame(frame->prev);
  92                 MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
  93                 if (!frame)
  94                         break;
  95                 if (ao_scheme_mark_memory(&ao_scheme_frame_type, frame))
  96                         break;
  97         }
  98 }
  99
 100 static void
 101 frame_move(void *addr)
 102 {
 103         struct ao_scheme_frame  *frame = addr;
 104
 105         for (;;) {
 106                 struct ao_scheme_frame          *prev;
 107                 struct ao_scheme_frame_vals     *vals;
 108                 int                             ret;
 109
 110                 MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
 111                 vals = ao_scheme_poly_frame_vals(frame->vals);
 112                 if (!ao_scheme_move_memory(&ao_scheme_frame_vals_type, (void **) &vals))
 113                         frame_vals_move(vals);
 114                 if (vals != ao_scheme_poly_frame_vals(frame->vals))
 115                         frame->vals = ao_scheme_frame_vals_poly(vals);
 116
 117                 prev = ao_scheme_poly_frame(frame->prev);
 118                 if (!prev)
 119                         break;
 120                 ret = ao_scheme_move_memory(&ao_scheme_frame_type, (void **) &prev);
 121                 if (prev != ao_scheme_poly_frame(frame->prev)) {
 122                         MDBG_MOVE("frame prev moved from %d to %d\n",
 123                                   MDBG_OFFSET(ao_scheme_poly_frame(frame->prev)),
 124                                   MDBG_OFFSET(prev));
 125                         frame->prev = ao_scheme_frame_poly(prev);
 126                 }
 127                 if (ret)
 128                         break;
 129                 frame = prev;
 130         }
 131 }
 132
 133 const struct ao_scheme_type ao_scheme_frame_type = {
 134         .mark = frame_mark,
 135         .size = frame_size,
 136         .move = frame_move,
 137         .name = "frame",
 138 };
 139
 140 int ao_scheme_frame_print_indent;
 141
 142 static void
 143 ao_scheme_frame_indent(FILE *out, int extra)
 144 {
 145         int                             i;
 146         putc('\n', out);
 147         for (i = 0; i < ao_scheme_frame_print_indent+extra; i++)
 148                 putc('\t', out);
 149 }
 150
 151 void
 152 ao_scheme_frame_write(FILE *out, ao_poly p, bool write)
 153 {
 154         struct ao_scheme_frame          *frame = ao_scheme_poly_frame(p);
 155         struct ao_scheme_frame          *clear = frame;
 156         int                             f;
 157         int                             written = 0;
 158
 159         ao_scheme_print_start();
 160         while (frame) {
 161                 struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 162
 163                 if (written != 0)
 164                         fputs(", ", out);
 165                 if (ao_scheme_print_mark_addr(frame)) {
 166                         fputs("recurse...", out);
 167                         break;
 168                 }
 169
 170                 putc('{', out);
 171                 written++;
 172                 for (f = 0; f < frame->num; f++) {
 173                         ao_scheme_frame_indent(out, 1);
 174                         ao_scheme_poly_write(out, vals->vals[f].atom, write);
 175                         fputs(" = ", out);
 176                         ao_scheme_poly_write(out, vals->vals[f].val, write);
 177                 }
 178                 frame = ao_scheme_poly_frame(frame->prev);
 179                 ao_scheme_frame_indent(out, 0);
 180                 putc('}', out);
 181         }
 182         if (ao_scheme_print_stop()) {
 183                 while (written--) {
 184                         ao_scheme_print_clear_addr(clear);
 185                         clear = ao_scheme_poly_frame(clear->prev);
 186                 }
 187         }
 188 }
 189
 190 static int
 191 ao_scheme_frame_find(struct ao_scheme_frame *frame, int top, ao_poly atom)
 192 {
 193         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 194         int                             l = 0;
 195         int                             r = top - 1;
 196
 197         while (l <= r) {
 198                 int m = (l + r) >> 1;
 199                 if (vals->vals[m].atom < atom)
 200                         l = m + 1;
 201                 else
 202                         r = m - 1;
 203         }
 204         return l;
 205 }
 206
 207 ao_poly *
 208 ao_scheme_frame_ref(struct ao_scheme_frame *frame, ao_poly atom)
 209 {
 210         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 211         int                             l = ao_scheme_frame_find(frame, frame->num, atom);
 212
 213         if (l >= frame->num)
 214                 return NULL;
 215
 216         if (vals->vals[l].atom != atom)
 217                 return NULL;
 218         return &vals->vals[l].val;
 219 }
 220
 221 struct ao_scheme_frame  *ao_scheme_frame_free_list[AO_SCHEME_FRAME_FREE];
 222
 223 static struct ao_scheme_frame_vals *
 224 ao_scheme_frame_vals_new(int num)
 225 {
 226         struct ao_scheme_frame_vals     *vals;
 227
 228         vals = ao_scheme_alloc(frame_vals_num_size(num));
 229         if (!vals)
 230                 return NULL;
 231         vals->type = AO_SCHEME_FRAME_VALS;
 232         vals->size = num;
 233         memset(vals->vals, '\0', num * sizeof (struct ao_scheme_val));
 234         return vals;
 235 }
 236
 237 struct ao_scheme_frame *
 238 ao_scheme_frame_new(int num)
 239 {
 240         struct ao_scheme_frame          *frame;
 241         struct ao_scheme_frame_vals     *vals;
 242
 243         if (num < AO_SCHEME_FRAME_FREE && (frame = ao_scheme_frame_free_list[num])) {
 244                 ao_scheme_frame_free_list[num] = ao_scheme_poly_frame(frame->prev);
 245                 vals = ao_scheme_poly_frame_vals(frame->vals);
 246         } else {
 247                 frame = ao_scheme_alloc(sizeof (struct ao_scheme_frame));
 248                 if (!frame)
 249                         return NULL;
 250                 frame->type = AO_SCHEME_FRAME;
 251                 frame->num = 0;
 252                 frame->prev = AO_SCHEME_NIL;
 253                 frame->vals = AO_SCHEME_NIL;
 254                 ao_scheme_frame_stash(frame);
 255                 vals = ao_scheme_frame_vals_new(num);
 256                 frame = ao_scheme_frame_fetch();
 257                 if (!vals)
 258                         return NULL;
 259                 frame->vals = ao_scheme_frame_vals_poly(vals);
 260                 frame->num = num;
 261         }
 262         frame->prev = AO_SCHEME_NIL;
 263         return frame;
 264 }
 265
 266 ao_poly
 267 ao_scheme_frame_mark(struct ao_scheme_frame *frame)
 268 {
 269         if (!frame)
 270                 return AO_SCHEME_NIL;
 271         frame->type |= AO_SCHEME_FRAME_MARK;
 272         return ao_scheme_frame_poly(frame);
 273 }
 274
 275 void
 276 ao_scheme_frame_free(struct ao_scheme_frame *frame)
 277 {
 278         if (frame && !ao_scheme_frame_marked(frame)) {
 279                 int     num = frame->num;
 280                 if (num < AO_SCHEME_FRAME_FREE) {
 281                         struct ao_scheme_frame_vals     *vals;
 282
 283                         vals = ao_scheme_poly_frame_vals(frame->vals);
 284                         memset(vals->vals, '\0', vals->size * sizeof (struct ao_scheme_val));
 285                         frame->prev = ao_scheme_frame_poly(ao_scheme_frame_free_list[num]);
 286                         ao_scheme_frame_free_list[num] = frame;
 287                 }
 288         }
 289 }
 290
 291 static struct ao_scheme_frame *
 292 ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num)
 293 {
 294         struct ao_scheme_frame_vals     *vals;
 295         struct ao_scheme_frame_vals     *new_vals;
 296         int                             copy;
 297
 298         if (new_num == frame->num)
 299                 return frame;
 300         ao_scheme_frame_stash(frame);
 301         new_vals = ao_scheme_frame_vals_new(new_num);
 302         frame = ao_scheme_frame_fetch();
 303         if (!new_vals)
 304                 return NULL;
 305         vals = ao_scheme_poly_frame_vals(frame->vals);
 306         copy = new_num;
 307         if (copy > frame->num)
 308                 copy = frame->num;
 309         memcpy(new_vals->vals, vals->vals, copy * sizeof (struct ao_scheme_val));
 310         frame->vals = ao_scheme_frame_vals_poly(new_vals);
 311         frame->num = new_num;
 312         return frame;
 313 }
 314
 315 void
 316 ao_scheme_frame_bind(struct ao_scheme_frame *frame, int num, ao_poly atom, ao_poly val)
 317 {
 318         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 319         int                             l = ao_scheme_frame_find(frame, num, atom);
 320
 321         memmove(&vals->vals[l+1],
 322                 &vals->vals[l],
 323                 (num - l) * sizeof (struct ao_scheme_val));
 324         vals->vals[l].atom = atom;
 325         vals->vals[l].val = val;
 326 }
 327
 328 ao_poly
 329 ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val)
 330 {
 331         ao_poly *ref = frame ? ao_scheme_frame_ref(frame, atom) : NULL;
 332
 333         if (!ref) {
 334                 int f = frame->num;
 335                 ao_scheme_poly_stash(atom);
 336                 ao_scheme_poly_stash(val);
 337                 frame = ao_scheme_frame_realloc(frame, f + 1);
 338                 val = ao_scheme_poly_fetch();
 339                 atom = ao_scheme_poly_fetch();
 340                 if (!frame)
 341                         return AO_SCHEME_NIL;
 342                 ao_scheme_frame_bind(frame, frame->num - 1, atom, val);
 343         } else
 344                 *ref = val;
 345         return val;
 346 }
 347
 348 #ifdef AO_SCHEME_FEATURE_UNDEF
 349 ao_poly
 350 ao_scheme_frame_del(struct ao_scheme_frame *frame, ao_poly atom)
 351 {
 352         struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(frame->vals);
 353         int                             l = ao_scheme_frame_find(frame, frame->num, atom);
 354         int                             f = frame->num;
 355         struct ao_scheme_frame          *moved_frame;
 356
 357         if (l >= frame->num)
 358                 return _ao_scheme_bool_false;
 359
 360         if (vals->vals[l].atom != atom)
 361                 return _ao_scheme_bool_false;
 362
 363         /* squash the deleted entry */
 364         memmove(&vals->vals[l],
 365                 &vals->vals[l+1],
 366                 (f - l) * sizeof (struct ao_scheme_val));
 367
 368         /* allocate a smaller vals array */
 369         ao_scheme_frame_stash(frame);
 370         moved_frame = ao_scheme_frame_realloc(frame, f - 1);
 371         frame = ao_scheme_frame_fetch();
 372
 373         /*
 374          * We couldn't allocate a smaller frame, so just
 375          * ignore the last value in the array
 376          */
 377         if (!moved_frame)
 378                 frame->num = f - 1;
 379         return _ao_scheme_bool_true;
 380 }
 381 #endif
 382
 383 struct ao_scheme_frame  *ao_scheme_frame_global;
 384 struct ao_scheme_frame  *ao_scheme_frame_current;
 385
 386 void
 387 ao_scheme_frame_init(void)
 388 {
 389         if (!ao_scheme_frame_global)
 390                 ao_scheme_frame_global = ao_scheme_frame_new(0);
 391 }