core: Cleanup make_cell, remove tmp cells.
[mes.git] / src / gc.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2016,2017 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of Mes.
6  *
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.
11  *
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.
16  *
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/>.
19  */
20
21 #include <errno.h>
22
23 SCM
24 gc_up_arena () ///((internal))
25 {
26   ARENA_SIZE *= 2;
27   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
28   if (!p)
29     {
30       eputs ("realloc failed, g_free=");
31       eputs (itoa (g_free));
32       eputs (":");
33       eputs (itoa (ARENA_SIZE - g_free));
34       eputs ("\n");
35       assert (0);
36       exit (1);
37     }
38   g_cells = (struct scm*)p;
39   g_cells++;
40   gc_init_news ();
41
42   return 0;
43 }
44
45 SCM
46 gc_flip () ///((internal))
47 {
48   struct scm *cells = g_cells;
49   g_cells = g_news;
50   g_news = cells;
51   if (g_debug > 2)
52     {
53       eputs (";;;   => jam[");
54       eputs (itoa (g_free));
55       eputs ("]\n");
56     }
57   return g_stack;
58 }
59
60 SCM
61 gc_copy (SCM old) ///((internal))
62 {
63   if (TYPE (old) == TBROKEN_HEART)
64     return g_cells[old].car;
65   SCM new = g_free++;
66   g_news[new] = g_cells[old];
67   if (NTYPE (new) == TVECTOR)
68     {
69       NVECTOR (new) = g_free;
70       for (int i=0; i<LENGTH (old); i++)
71         g_news[g_free++] = g_cells[VECTOR (old)+i];
72     }
73   TYPE (old) = TBROKEN_HEART;
74   CAR (old) = new;
75   return new;
76 }
77
78 SCM
79 gc_relocate_car (SCM new, SCM car) ///((internal))
80 {
81   g_news[new].car = car;
82   return cell_unspecified;
83 }
84
85 SCM
86 gc_relocate_cdr (SCM new, SCM cdr) ///((internal))
87 {
88   g_news[new].cdr = cdr;
89   return cell_unspecified;
90 }
91
92 SCM
93 gc_loop (SCM scan) ///((internal))
94 {
95   SCM car;
96   SCM cdr;
97   while (scan < g_free)
98     {
99       if (NTYPE (scan) == TCLOSURE
100           || NTYPE (scan) == TCONTINUATION
101           || NTYPE (scan) == TFUNCTION
102           || NTYPE (scan) == TKEYWORD
103           || NTYPE (scan) == TMACRO
104           || NTYPE (scan) == TPAIR
105           || NTYPE (scan) == TREF
106           || scan == 1 // null
107           || NTYPE (scan) == TSPECIAL
108           || NTYPE (scan) == TSTRING
109           || NTYPE (scan) == TSYMBOL
110           || NTYPE (scan) == TVARIABLE)
111         {
112           car = gc_copy (g_news[scan].car);
113           gc_relocate_car (scan, car);
114         }
115       if ((NTYPE (scan) == TCLOSURE
116            || NTYPE (scan) == TCONTINUATION
117            || NTYPE (scan) == TMACRO
118            || NTYPE (scan) == TPAIR
119            || NTYPE (scan) == TVALUES
120            || NTYPE (scan) == TVARIABLE)
121           && g_news[scan].cdr) // allow for 0 terminated list of symbols
122         {
123           cdr = gc_copy (g_news[scan].cdr);
124           gc_relocate_cdr (scan, cdr);
125         }
126       scan++;
127     }
128   return gc_flip ();
129 }
130
131 SCM
132 gc_check ()
133 {
134   if (g_free + GC_SAFETY > ARENA_SIZE)
135     gc ();
136   return cell_unspecified;
137 }
138
139 SCM
140 gc_ () ///((internal))
141 {
142   if (g_debug == 2)
143     eputs (".");
144   if (g_debug > 2)
145     {
146       eputs (";;; gc[");
147       eputs (itoa (g_free));
148       eputs (":");
149       eputs (itoa (ARENA_SIZE - g_free));
150       eputs ("]...");
151     }
152   g_free = 1;
153
154   if (g_cells < g_news
155       //&& g_free > ARENA_SIZE >> 2
156       && ARENA_SIZE < MAX_ARENA_SIZE)
157     {
158       if (g_debug == 2)
159         eputs ("+");
160       if (g_debug > 2)
161         {
162           eputs (" up[");
163           eputs (itoa (g_cells));
164           eputs (",");
165           eputs (itoa (g_news));
166           eputs (":");
167           eputs (itoa (ARENA_SIZE));
168           eputs (",");
169           eputs (itoa (MAX_ARENA_SIZE));
170           eputs ("]...");
171         }
172       gc_up_arena ();
173     }
174
175   for (int i=g_free; i<g_symbol_max; i++)
176     gc_copy (i);
177   g_symbols = gc_copy (g_symbols);
178   g_macros = gc_copy (g_macros);
179   SCM new = gc_copy (g_stack);
180   if (g_debug > 3)
181     {
182       eputs ("new=");
183       eputs (itoa (new));
184       eputs ("\n");
185     }
186   g_stack = new;
187   gc_loop (1);
188 }
189
190 SCM
191 gc ()
192 {
193   if (g_debug > 4)
194     {
195       eputs ("symbols: ");
196       write_error_ (g_symbols);
197       eputs ("\n");
198       eputs ("R0: ");
199       write_error_ (r0);
200       eputs ("\n");
201     }
202   gc_push_frame ();
203   gc_ ();
204   gc_pop_frame ();
205   if (g_debug > 4)
206     {
207       eputs ("symbols: ");
208       write_error_ (g_symbols);
209       eputs ("\n");
210       eputs ("R0: ");
211       write_error_ (r0);
212       eputs ("\n");
213     }
214 }