2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
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.
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.
15 #include "ao_scheme.h"
18 frame_vals_num_size(int num)
20 return sizeof (struct ao_scheme_frame_vals) + num * sizeof (struct ao_scheme_val);
24 frame_vals_size(void *addr)
26 struct ao_scheme_frame_vals *vals = addr;
27 return frame_vals_num_size(vals->size);
31 frame_vals_mark(void *addr)
33 struct ao_scheme_frame_vals *vals = addr;
36 for (f = 0; f < vals->size; f++) {
37 struct ao_scheme_val *v = &vals->vals[f];
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"));
49 frame_vals_move(void *addr)
51 struct ao_scheme_frame_vals *vals = addr;
54 for (f = 0; f < vals->size; f++) {
55 struct ao_scheme_val *v = &vals->vals[f];
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);
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,
74 frame_size(void *addr)
77 return sizeof (struct ao_scheme_frame);
81 frame_mark(void *addr)
83 struct ao_scheme_frame *frame = addr;
86 struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals);
88 MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
89 if (!AO_SCHEME_IS_POOL(frame))
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));
97 if (ao_scheme_mark_memory(&ao_scheme_frame_type, frame))
103 frame_move(void *addr)
105 struct ao_scheme_frame *frame = addr;
108 struct ao_scheme_frame *prev;
109 struct ao_scheme_frame_vals *vals;
112 MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
113 if (!AO_SCHEME_IS_POOL(frame))
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);
122 prev = ao_scheme_poly_frame(frame->prev);
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)),
130 frame->prev = ao_scheme_frame_poly(prev);
138 const struct ao_scheme_type ao_scheme_frame_type = {
145 int ao_scheme_frame_print_indent;
148 ao_scheme_frame_indent(int extra)
152 for (i = 0; i < ao_scheme_frame_print_indent+extra; i++)
157 ao_scheme_frame_write(ao_poly p, bool write)
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);
165 ao_scheme_print_start();
169 if (ao_scheme_print_mark_addr(frame)) {
170 printf("recurse...");
176 for (f = 0; f < frame->num; f++) {
177 ao_scheme_frame_indent(1);
178 ao_scheme_poly_write(vals->vals[f].atom, write);
180 ao_scheme_poly_write(vals->vals[f].val, write);
182 frame = ao_scheme_poly_frame(frame->prev);
183 ao_scheme_frame_indent(0);
186 if (ao_scheme_print_stop()) {
188 ao_scheme_print_clear_addr(clear);
189 clear = ao_scheme_poly_frame(clear->prev);
195 ao_scheme_frame_find(struct ao_scheme_frame *frame, int top, ao_poly atom)
197 struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals);
202 int m = (l + r) >> 1;
203 if (vals->vals[m].atom < atom)
212 ao_scheme_frame_ref(struct ao_scheme_frame *frame, ao_poly atom)
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);
220 if (vals->vals[l].atom != atom)
222 return &vals->vals[l].val;
225 struct ao_scheme_frame *ao_scheme_frame_free_list[AO_SCHEME_FRAME_FREE];
227 static struct ao_scheme_frame_vals *
228 ao_scheme_frame_vals_new(int num)
230 struct ao_scheme_frame_vals *vals;
232 vals = ao_scheme_alloc(frame_vals_num_size(num));
235 vals->type = AO_SCHEME_FRAME_VALS;
237 memset(vals->vals, '\0', num * sizeof (struct ao_scheme_val));
241 struct ao_scheme_frame *
242 ao_scheme_frame_new(int num)
244 struct ao_scheme_frame *frame;
245 struct ao_scheme_frame_vals *vals;
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);
251 frame = ao_scheme_alloc(sizeof (struct ao_scheme_frame));
254 frame->type = AO_SCHEME_FRAME;
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);
263 frame->vals = ao_scheme_frame_vals_poly(vals);
266 frame->prev = AO_SCHEME_NIL;
271 ao_scheme_frame_mark(struct ao_scheme_frame *frame)
274 return AO_SCHEME_NIL;
275 frame->type |= AO_SCHEME_FRAME_MARK;
276 return ao_scheme_frame_poly(frame);
280 ao_scheme_frame_free(struct ao_scheme_frame *frame)
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;
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;
295 static struct ao_scheme_frame *
296 ao_scheme_frame_realloc(struct ao_scheme_frame *frame, int new_num)
298 struct ao_scheme_frame_vals *vals;
299 struct ao_scheme_frame_vals *new_vals;
302 if (new_num == frame->num)
304 ao_scheme_frame_stash(0, frame);
305 new_vals = ao_scheme_frame_vals_new(new_num);
306 frame = ao_scheme_frame_fetch(0);
309 vals = ao_scheme_poly_frame_vals(frame->vals);
311 if (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;
320 ao_scheme_frame_bind(struct ao_scheme_frame *frame, int num, ao_poly atom, ao_poly val)
322 struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(frame->vals);
323 int l = ao_scheme_frame_find(frame, num, atom);
325 memmove(&vals->vals[l+1],
327 (num - l) * sizeof (struct ao_scheme_val));
328 vals->vals[l].atom = atom;
329 vals->vals[l].val = val;
333 ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val)
335 ao_poly *ref = frame ? ao_scheme_frame_ref(frame, atom) : NULL;
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);
345 return AO_SCHEME_NIL;
346 ao_scheme_frame_bind(frame, frame->num - 1, atom, val);
352 struct ao_scheme_frame *ao_scheme_frame_global;
353 struct ao_scheme_frame *ao_scheme_frame_current;
356 ao_scheme_frame_init(void)
358 if (!ao_scheme_frame_global)
359 ao_scheme_frame_global = ao_scheme_frame_new(0);