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_poly_type(cdr) != AO_SCHEME_CONS) {
28 ao_scheme_poly_mark(cdr, 1);
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_poly_base_type(cdr) != AO_SCHEME_CONS) {
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(0, car);
96 ao_scheme_poly_stash(1, cdr);
97 cons = ao_scheme_alloc(sizeof (struct ao_scheme_cons));
98 cdr = ao_scheme_poly_fetch(1);
99 car = ao_scheme_poly_fetch(0);
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_poly_type(cdr) != AO_SCHEME_CONS) {
115 (void) ao_scheme_error(AO_SCHEME_INVALID, "improper list");
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));
128 ao_scheme_cons_free(struct ao_scheme_cons *cons)
131 ao_scheme_cons_check(cons);
134 ao_poly cdr = cons->cdr;
135 cons->cdr = ao_scheme_cons_poly(ao_scheme_cons_free_list);
136 ao_scheme_cons_free_list = cons;
137 cons = ao_scheme_poly_cons(cdr);
142 ao_scheme_cons_write(ao_poly c)
144 struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
152 ao_scheme_poly_write(cons->car);
158 if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
159 cons = ao_scheme_poly_cons(cdr);
163 ao_scheme_poly_write(cdr);
171 ao_scheme_cons_display(ao_poly c)
173 struct ao_scheme_cons *cons = ao_scheme_poly_cons(c);
177 ao_scheme_poly_display(cons->car);
183 if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
184 cons = ao_scheme_poly_cons(cdr);
186 ao_scheme_poly_display(cdr);
193 ao_scheme_cons_length(struct ao_scheme_cons *cons)
198 cons = ao_scheme_poly_cons(cons->cdr);