9cab3e8b68a0792ef3a4e40fb372ddaaefa9e589
[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   GC_SAFETY *= 2;
28 #if _POSIX_SOURCE
29   void *p = realloc (g_cells-1, 2*ARENA_SIZE*sizeof(struct scm));
30 #else
31   char *p = g_cells;
32   p = realloc (p-sizeof (struct scm), 2*ARENA_SIZE*sizeof(struct scm));
33 #endif
34
35 #if _POSIX_SOURCE
36   if (!p)
37     error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list (strerror (errno))), MAKE_NUMBER (g_free)));
38   g_cells = (struct scm*)p;
39   g_cells++;
40 #endif
41   gc_init_news ();
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 > 1)
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   while (scan < g_free)
96     {
97       if (NTYPE (scan) == TCLOSURE
98           || NTYPE (scan) == TCONTINUATION
99           || NTYPE (scan) == TFUNCTION
100           || NTYPE (scan) == TKEYWORD
101           || NTYPE (scan) == TMACRO
102           || NTYPE (scan) == TPAIR
103           || NTYPE (scan) == TREF
104           || scan == 1 // null
105           || NTYPE (scan) == TSPECIAL
106           || NTYPE (scan) == TSTRING
107           || NTYPE (scan) == TSYMBOL
108           || NTYPE (scan) == TVARIABLE)
109         {
110           SCM car = gc_copy (g_news[scan].car);
111           gc_relocate_car (scan, car);
112         }
113       if ((NTYPE (scan) == TCLOSURE
114            || NTYPE (scan) == TCONTINUATION
115            || NTYPE (scan) == TMACRO
116            || NTYPE (scan) == TPAIR
117            || NTYPE (scan) == TVALUES
118            || NTYPE (scan) == TVARIABLE)
119           && g_news[scan].cdr) // allow for 0 terminated list of symbols
120         {
121           SCM cdr = gc_copy (g_news[scan].cdr);
122           gc_relocate_cdr (scan, cdr);
123         }
124       scan++;
125     }
126   return gc_flip ();
127 }
128
129 SCM
130 gc_check ()
131 {
132   if (g_free + GC_SAFETY > ARENA_SIZE)
133     gc_pop_frame (gc (gc_push_frame ()));
134   return cell_unspecified;
135 }
136
137 SCM
138 gc ()
139 {
140   if (g_debug == 1)
141     eputs (".");
142   if (g_debug > 1)
143     {
144       eputs (";;; gc[");
145       eputs (itoa (g_free));
146       eputs (":");
147       eputs (itoa (ARENA_SIZE - g_free));
148       eputs ("]...");
149     }
150   g_free = 1;
151   if (g_cells < g_news && ARENA_SIZE < MAX_ARENA_SIZE)
152     gc_up_arena ();
153   for (int i=g_free; i<g_symbol_max; i++)
154     gc_copy (i);
155   make_tmps (g_news);
156   g_symbols = gc_copy (g_symbols);
157   g_macros = gc_copy (g_macros);
158   SCM new = gc_copy (g_stack);
159   if (g_debug > 1)
160     {
161       eputs ("new=");
162       eputs (itoa (new));
163       eputs ("\n");
164     }
165   g_stack = new;
166   return gc_loop (1);
167 }