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"
17 static void cons_mark(void *addr)
19 struct ao_scheme_cons *cons = addr;
22 ao_poly cdr = cons->cdr;
24 ao_scheme_poly_mark(cons->car, 1);
27 if (!ao_scheme_is_cons(cdr)) {
28 ao_scheme_poly_mark(cdr, 0);
31 cons = ao_scheme_poly_cons(cdr);
32 if (ao_scheme_mark_memory(&ao_scheme_cons_type, cons))
37 static int cons_size(void *addr)
40 return sizeof (struct ao_scheme_cons);
43 static void cons_move(void *addr)
45 struct ao_scheme_cons *cons = addr;
52 struct ao_scheme_cons *c;
55 MDBG_MOVE("cons_move start %d (%d, %d)\n",
56 MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr)));
57 (void) ao_scheme_poly_move(&cons->car, 1);
61 if (!ao_scheme_is_cons(cdr)) {
62 (void) ao_scheme_poly_move(&cons->cdr, 0);
65 c = ao_scheme_poly_cons(cdr);
66 ret = ao_scheme_move_memory(&ao_scheme_cons_type, (void **) &c);
67 if (c != ao_scheme_poly_cons(cons->cdr))
68 cons->cdr = ao_scheme_cons_poly(c);
69 MDBG_MOVE("cons_move end %d (%d, %d)\n",
70 MDBG_OFFSET(cons), MDBG_OFFSET(ao_scheme_ref(cons->car)), MDBG_OFFSET(ao_scheme_ref(cons->cdr)));
77 const struct ao_scheme_type ao_scheme_cons_type = {
84 struct ao_scheme_cons *ao_scheme_cons_free_list;
86 struct ao_scheme_cons *
87 ao_scheme_cons_cons(ao_poly car, ao_poly cdr)
89 struct ao_scheme_cons *cons;
91 if (ao_scheme_cons_free_list) {
92 cons = ao_scheme_cons_free_list;
93 ao_scheme_cons_free_list = ao_scheme_poly_cons(cons->cdr);
95 ao_scheme_poly_stash(car);
96 ao_scheme_poly_stash(cdr);
97 cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
98 cdr = ao_scheme_poly_fetch();
99 car = ao_scheme_poly_fetch();
108 struct ao_scheme_cons *
109 ao_scheme_cons_cdr(struct ao_scheme_cons *cons)
111 ao_poly cdr = cons->cdr;
112 if (cdr == AO_SCHEME_NIL)
114 if (!ao_scheme_is_cons(cdr)) {
115 (void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
118 return ao_scheme_poly_cons(cdr);
122 ao_scheme_cons(ao_poly car, ao_poly cdr)
124 return ao_scheme_cons_poly(ao_scheme_cons_cons(car, cdr));
127 struct ao_scheme_cons *
128 ao_scheme_cons_copy(struct ao_scheme_cons *cons)
130 struct ao_scheme_cons *head = NULL;
131 struct ao_scheme_cons *tail = NULL;
134 struct ao_scheme_cons *new;
137 ao_scheme_cons_stash(cons);
138 ao_scheme_cons_stash(head);
139 ao_scheme_cons_stash(tail);
140 new = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
141 tail = ao_scheme_cons_fetch();
142 head = ao_scheme_cons_fetch();
143 cons = ao_scheme_cons_fetch();
145 return AO_SCHEME_NIL;
146 new->car = cons->car;
147 new->cdr = AO_SCHEME_NIL;
151 tail->cdr = ao_scheme_cons_poly(new);
154 if (!ao_scheme_is_cons(cdr)) {
158 cons = ao_scheme_poly_cons(cdr);
164 ao_scheme_cons_free(struct ao_scheme_cons *cons)
167 ao_scheme_cons_check(cons);
170 ao_poly cdr = cons->cdr;
171 cons->cdr = ao_scheme_cons_poly(ao_scheme_cons_free_list);
172 ao_scheme_cons_free_list = cons;
173 cons = ao_scheme_poly_cons(cdr);
178 ao_scheme_cons_write(ao_poly c, bool write)
180 struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
181 struct ao_scheme_cons *clear = cons;
185 ao_scheme_print_start();
191 /* Note if there's recursion in printing. Not
192 * as good as actual references, but at least
193 * we don't infinite loop...
195 if (ao_scheme_print_mark_addr(cons)) {
200 ao_scheme_poly_write(cons->car, write);
202 /* keep track of how many pairs have been printed */
206 if (!ao_scheme_is_cons(cdr)) {
208 ao_scheme_poly_write(cdr, write);
211 cons = ao_scheme_poly_cons(cdr);
215 if (ao_scheme_print_stop()) {
217 /* If we're still printing, clear the print marks on
221 ao_scheme_print_clear_addr(clear);
222 clear = ao_scheme_poly_cons(clear->cdr);
228 ao_scheme_cons_length(struct ao_scheme_cons *cons)
233 cons = ao_scheme_cons_cdr(cons);