git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_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_lisp.h"
  16
  17 static inline int
  18 frame_vals_num_size(int num)
  19 {
  20         return sizeof (struct ao_lisp_frame_vals) + num * sizeof (struct ao_lisp_val);
  21 }
  22
  23 static int
  24 frame_vals_size(void *addr)
  25 {
  26         struct ao_lisp_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_lisp_frame_vals       *vals = addr;
  34         int                             f;
  35
  36         for (f = 0; f < vals->size; f++) {
  37                 struct ao_lisp_val      *v = &vals->vals[f];
  38
  39                 ao_lisp_poly_mark(v->val, 0);
  40                 MDBG_MOVE("frame mark atom %s %d val %d at %d    ",
  41                           ao_lisp_poly_atom(v->atom)->name,
  42                           MDBG_OFFSET(ao_lisp_ref(v->atom)),
  43                           MDBG_OFFSET(ao_lisp_ref(v->val)), f);
  44                 MDBG_DO(ao_lisp_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_lisp_frame_vals       *vals = addr;
  53         int                             f;
  54
  55         for (f = 0; f < vals->size; f++) {
  56                 struct ao_lisp_val      *v = &vals->vals[f];
  57
  58                 ao_lisp_poly_move(&v->atom, 0);
  59                 ao_lisp_poly_move(&v->val, 0);
  60                 MDBG_MOVE("frame move atom %s %d val %d at %d\n",
  61                           ao_lisp_poly_atom(v->atom)->name,
  62                           MDBG_OFFSET(ao_lisp_ref(v->atom)),
  63                           MDBG_OFFSET(ao_lisp_ref(v->val)), f);
  64         }
  65 }
  66
  67 const struct ao_lisp_type ao_lisp_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_lisp_frame);
  79 }
  80
  81 static void
  82 frame_mark(void *addr)
  83 {
  84         struct ao_lisp_frame    *frame = addr;
  85
  86         for (;;) {
  87                 MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
  88                 if (!AO_LISP_IS_POOL(frame))
  89                         break;
  90                 ao_lisp_poly_mark(frame->vals, 0);
  91                 frame = ao_lisp_poly_frame(frame->prev);
  92                 MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
  93                 if (!frame)
  94                         break;
  95                 if (ao_lisp_mark_memory(&ao_lisp_frame_type, frame))
  96                         break;
  97         }
  98 }
  99
 100 static void
 101 frame_move(void *addr)
 102 {
 103         struct ao_lisp_frame    *frame = addr;
 104
 105         for (;;) {
 106                 struct ao_lisp_frame    *prev;
 107                 int                     ret;
 108
 109                 MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
 110                 if (!AO_LISP_IS_POOL(frame))
 111                         break;
 112                 ao_lisp_poly_move(&frame->vals, 0);
 113                 prev = ao_lisp_poly_frame(frame->prev);
 114                 if (!prev)
 115                         break;
 116                 ret = ao_lisp_move_memory(&ao_lisp_frame_type, (void **) &prev);
 117                 if (prev != ao_lisp_poly_frame(frame->prev)) {
 118                         MDBG_MOVE("frame prev moved from %d to %d\n",
 119                                   MDBG_OFFSET(ao_lisp_poly_frame(frame->prev)),
 120                                   MDBG_OFFSET(prev));
 121                         frame->prev = ao_lisp_frame_poly(prev);
 122                 }
 123                 if (ret)
 124                         break;
 125                 frame = prev;
 126         }
 127 }
 128
 129 const struct ao_lisp_type ao_lisp_frame_type = {
 130         .mark = frame_mark,
 131         .size = frame_size,
 132         .move = frame_move,
 133         .name = "frame",
 134 };
 135
 136 void
 137 ao_lisp_frame_write(ao_poly p)
 138 {
 139         struct ao_lisp_frame            *frame = ao_lisp_poly_frame(p);
 140         struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
 141         int                             f;
 142
 143         printf ("{");
 144         if (frame) {
 145                 if (frame->type & AO_LISP_FRAME_PRINT)
 146                         printf("recurse...");
 147                 else {
 148                         frame->type |= AO_LISP_FRAME_PRINT;
 149                         for (f = 0; f < frame->num; f++) {
 150                                 if (f != 0)
 151                                         printf(", ");
 152                                 ao_lisp_poly_write(vals->vals[f].atom);
 153                                 printf(" = ");
 154                                 ao_lisp_poly_write(vals->vals[f].val);
 155                         }
 156                         if (frame->prev)
 157                                 ao_lisp_poly_write(frame->prev);
 158                         frame->type &= ~AO_LISP_FRAME_PRINT;
 159                 }
 160         }
 161         printf("}");
 162 }
 163
 164 static int
 165 ao_lisp_frame_find(struct ao_lisp_frame *frame, int top, ao_poly atom)
 166 {
 167         struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
 168         int                             l = 0;
 169         int                             r = top - 1;
 170
 171         while (l <= r) {
 172                 int m = (l + r) >> 1;
 173                 if (vals->vals[m].atom < atom)
 174                         l = m + 1;
 175                 else
 176                         r = m - 1;
 177         }
 178         return l;
 179 }
 180
 181 ao_poly *
 182 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom)
 183 {
 184         struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
 185         int                             l = ao_lisp_frame_find(frame, frame->num, atom);
 186
 187         if (l >= frame->num)
 188                 return NULL;
 189
 190         if (vals->vals[l].atom != atom)
 191                 return NULL;
 192         return &vals->vals[l].val;
 193 }
 194
 195 struct ao_lisp_frame    *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
 196
 197 static struct ao_lisp_frame_vals *
 198 ao_lisp_frame_vals_new(int num)
 199 {
 200         struct ao_lisp_frame_vals       *vals;
 201
 202         vals = ao_lisp_alloc(frame_vals_num_size(num));
 203         if (!vals)
 204                 return NULL;
 205         vals->type = AO_LISP_FRAME_VALS;
 206         vals->size = num;
 207         memset(vals->vals, '\0', num * sizeof (struct ao_lisp_val));
 208         return vals;
 209 }
 210
 211 struct ao_lisp_frame *
 212 ao_lisp_frame_new(int num)
 213 {
 214         struct ao_lisp_frame            *frame;
 215         struct ao_lisp_frame_vals       *vals;
 216
 217         if (num < AO_LISP_FRAME_FREE && (frame = ao_lisp_frame_free_list[num])) {
 218                 ao_lisp_frame_free_list[num] = ao_lisp_poly_frame(frame->prev);
 219                 vals = ao_lisp_poly_frame_vals(frame->vals);
 220         } else {
 221                 frame = ao_lisp_alloc(sizeof (struct ao_lisp_frame));
 222                 if (!frame)
 223                         return NULL;
 224                 frame->type = AO_LISP_FRAME;
 225                 frame->num = 0;
 226                 frame->prev = AO_LISP_NIL;
 227                 frame->vals = AO_LISP_NIL;
 228                 ao_lisp_poly_stash(0, ao_lisp_frame_poly(frame));
 229                 vals = ao_lisp_frame_vals_new(num);
 230                 frame = ao_lisp_poly_frame(ao_lisp_poly_fetch(0));
 231                 frame->vals = ao_lisp_frame_vals_poly(vals);
 232                 frame->num = num;
 233         }
 234         frame->prev = AO_LISP_NIL;
 235         return frame;
 236 }
 237
 238 ao_poly
 239 ao_lisp_frame_mark(struct ao_lisp_frame *frame)
 240 {
 241         if (!frame)
 242                 return AO_LISP_NIL;
 243         frame->type |= AO_LISP_FRAME_MARK;
 244         return ao_lisp_frame_poly(frame);
 245 }
 246
 247 void
 248 ao_lisp_frame_free(struct ao_lisp_frame *frame)
 249 {
 250         if (frame && !ao_lisp_frame_marked(frame)) {
 251                 int     num = frame->num;
 252                 if (num < AO_LISP_FRAME_FREE) {
 253                         struct ao_lisp_frame_vals       *vals;
 254
 255                         vals = ao_lisp_poly_frame_vals(frame->vals);
 256                         memset(vals->vals, '\0', vals->size * sizeof (struct ao_lisp_val));
 257                         frame->prev = ao_lisp_frame_poly(ao_lisp_frame_free_list[num]);
 258                         ao_lisp_frame_free_list[num] = frame;
 259                 }
 260         }
 261 }
 262
 263 static struct ao_lisp_frame *
 264 ao_lisp_frame_realloc(struct ao_lisp_frame *frame, int new_num)
 265 {
 266         struct ao_lisp_frame_vals       *vals;
 267         struct ao_lisp_frame_vals       *new_vals;
 268         int                             copy;
 269
 270         if (new_num == frame->num)
 271                 return frame;
 272         ao_lisp_frame_stash(0, frame);
 273         new_vals = ao_lisp_frame_vals_new(new_num);
 274         if (!new_vals)
 275                 return NULL;
 276         frame = ao_lisp_frame_fetch(0);
 277         vals = ao_lisp_poly_frame_vals(frame->vals);
 278         copy = new_num;
 279         if (copy > frame->num)
 280                 copy = frame->num;
 281         memcpy(new_vals->vals, vals->vals, copy * sizeof (struct ao_lisp_val));
 282         frame->vals = ao_lisp_frame_vals_poly(new_vals);
 283         frame->num = new_num;
 284         return frame;
 285 }
 286
 287 void
 288 ao_lisp_frame_bind(struct ao_lisp_frame *frame, int num, ao_poly atom, ao_poly val)
 289 {
 290         struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
 291         int                             l = ao_lisp_frame_find(frame, num, atom);
 292
 293         memmove(&vals->vals[l+1],
 294                 &vals->vals[l],
 295                 (num - l) * sizeof (struct ao_lisp_val));
 296         vals->vals[l].atom = atom;
 297         vals->vals[l].val = val;
 298 }
 299
 300 ao_poly
 301 ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val)
 302 {
 303         ao_poly *ref = frame ? ao_lisp_frame_ref(frame, atom) : NULL;
 304
 305         if (!ref) {
 306                 int f;
 307                 ao_lisp_poly_stash(0, atom);
 308                 ao_lisp_poly_stash(1, val);
 309                 f = frame->num;
 310                 frame = ao_lisp_frame_realloc(frame, f + 1);
 311                 if (!frame)
 312                         return AO_LISP_NIL;
 313                 atom = ao_lisp_poly_fetch(0);
 314                 val = ao_lisp_poly_fetch(1);
 315                 ao_lisp_frame_bind(frame, frame->num - 1, atom, val);
 316         } else
 317                 *ref = val;
 318         return val;
 319 }
 320
 321 struct ao_lisp_frame    *ao_lisp_frame_global;
 322 struct ao_lisp_frame    *ao_lisp_frame_current;
 323
 324 void
 325 ao_lisp_frame_init(void)
 326 {
 327         if (!ao_lisp_frame_global)
 328                 ao_lisp_frame_global = ao_lisp_frame_new(0);
 329 }