1 /* -*-comment-start: "//";comment-end:""-*-
2 * Mes --- Maxwell Equations of Software
3 * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5 * This file is part of Mes.
7 * Mes is free software; you can redistribute it and/or modify it
8 * under the terms of the GNU General Public License as published by
9 * the Free Software Foundation; either version 3 of the License, or (at
10 * your option) any later version.
12 * Mes is distributed in the hope that it will be useful, but
13 * WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with Mes. If not, see <http://www.gnu.org/licenses/>.
22 gc_up_arena () ///((internal))
26 void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
28 ARENA_SIZE = ARENA_SIZE * 2;
29 //p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
30 int size = ARENA_SIZE * 2;
33 p = realloc (g_cells-1, size);
38 if (!p) error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
39 g_cells = (struct scm*)p;
43 //g_cells = (struct scm*)p;
50 gc_flip () ///((internal))
52 struct scm *cells = g_cells;
56 if (g_debug) fprintf (stderr, " => jam[%d]\n", g_free);
61 eputs (itoa (g_free));
69 gc_copy (SCM old) ///((internal))
71 if (TYPE (old) == TBROKEN_HEART) return g_cells[old].car;
74 g_news[new] = g_cells[old];
85 if (NTYPE (new) == TVECTOR)
87 NVECTOR (new) = g_free;
88 for (int i=0; i<LENGTH (old); i++)
91 g_news[g_free++] = g_cells[VECTOR (old)+i];
94 //eputs ("gc_copy\n");
109 TYPE (old) = TBROKEN_HEART;
115 gc_relocate_car (SCM new, SCM car) ///((internal))
117 g_news[new].car = car;
118 return cell_unspecified;
122 gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
124 g_news[new].cdr = cdr;
125 return cell_unspecified;
129 gc_loop (SCM scan) ///((internal))
131 while (scan < g_free)
133 if (NTYPE (scan) == TCLOSURE
134 || NTYPE (scan) == TCONTINUATION
135 || NTYPE (scan) == TFUNCTION
136 || NTYPE (scan) == TKEYWORD
137 || NTYPE (scan) == TMACRO
138 || NTYPE (scan) == TPAIR
139 || NTYPE (scan) == TREF
141 || NTYPE (scan) == TSPECIAL
142 || NTYPE (scan) == TSTRING
143 || NTYPE (scan) == TSYMBOL)
145 SCM car = gc_copy (g_news[scan].car);
146 gc_relocate_car (scan, car);
148 if ((NTYPE (scan) == TCLOSURE
149 || NTYPE (scan) == TCONTINUATION
150 || NTYPE (scan) == TMACRO
151 || NTYPE (scan) == TPAIR
152 || NTYPE (scan) == TVALUES)
153 && g_news[scan].cdr) // allow for 0 terminated list of symbols
155 SCM cdr = gc_copy (g_news[scan].cdr);
156 gc_relocate_cdr (scan, cdr);
167 if (g_debug) fprintf (stderr, "***gc[%d]...", g_free);
172 eputs (itoa (g_free));
177 if (g_cells < g_news && ARENA_SIZE < MAX_ARENA_SIZE) gc_up_arena ();
178 for (int i=g_free; i<g_symbol_max; i++)
181 g_symbols = gc_copy (g_symbols);
182 SCM new = gc_copy (g_stack);
184 if (g_debug) fprintf (stderr, "new=%d\n", new);