source: abuse/trunk/src/lisp/lisp_gc.cpp @ 557

Last change on this file since 557 was 557, checked in by Sam Hocevar, 11 years ago

lisp: fix a crash in the garbage collection of cons_cells lying outside
of main space.

File size: 7.4 KB
Line 
1/*
2 *  Abuse - dark 2D side-scrolling platform game
3 *  Copyright (c) 1995 Crack dot Com
4 *  Copyright (c) 2005-2011 Sam Hocevar <sam@hocevar.net>
5 *
6 *  This software was released into the Public Domain. As with most public
7 *  domain software, no warranty is made or implied by Crack dot Com, by
8 *  Jonathan Clark, or by Sam Hocevar.
9 */
10
11#if defined HAVE_CONFIG_H
12#   include "config.h"
13#endif
14
15#include <stdlib.h>
16#include <string.h>
17
18#include "lisp.h"
19#include "lisp_gc.h"
20#ifdef NO_LIBS
21#include "fakelib.h"
22#endif
23
24#include "stack.h"
25
26/*  Lisp garbage collection: uses copy/free algorithm
27    Places to check:
28      symbol
29        values
30    functions
31    names
32      stack
33*/
34
35// Stack where user programs can push data and have it GCed
36grow_stack<void> l_user_stack(150);
37// Stack of user pointers
38grow_stack<void *> PtrRef::stack(1500);
39
40size_t reg_ptr_total = 0;
41size_t reg_ptr_list_size = 0;
42void ***reg_ptr_list = NULL;
43
44static uint8_t *cstart, *cend, *collected_start, *collected_end;
45
46void register_pointer(void **addr)
47{
48  if (reg_ptr_total >= reg_ptr_list_size)
49  {
50    reg_ptr_list_size += 0x100;
51    reg_ptr_list = (void ***)realloc(reg_ptr_list, sizeof(void **) * reg_ptr_list_size);
52  }
53  reg_ptr_list[reg_ptr_total++] = addr;
54}
55
56void unregister_pointer(void **addr)
57{
58  void ***reg_on = reg_ptr_list;
59  for (size_t i = 0; i < reg_ptr_total; i++, reg_on++)
60  {
61    if (*reg_on == addr)
62    {
63      reg_ptr_total--;
64      for (size_t j = i; j < reg_ptr_total; j++, reg_on++)
65        reg_on[0] = reg_on[1];
66      return ;
67    }
68  }
69  fprintf(stderr, "Unable to locate ptr to unregister");
70}
71
72static LObject *CollectObject(LObject *x);
73
74static LArray *CollectArray(LArray *x)
75{
76    size_t s = x->len;
77    LArray *a = LArray::Create(s, NULL);
78    LObject **src = x->GetData();
79    LObject **dst = a->GetData();
80    for (size_t i = 0; i < s; i++)
81        dst[i] = CollectObject(src[i]);
82
83    return a;
84}
85
86inline LList *CollectList(LList *x)
87{
88    LList *last = NULL, *first = NULL;
89
90    for (; x && item_type(x) == L_CONS_CELL; )
91    {
92        LList *p = LList::Create();
93        LObject *old_car = x->car;
94        LObject *old_cdr = x->cdr;
95        LObject *old_x = x;
96        x = (LList *)CDR(x);
97        ((LRedirect *)old_x)->type = L_COLLECTED_OBJECT;
98        ((LRedirect *)old_x)->ref = p;
99
100        p->car = CollectObject(old_car);
101        p->cdr = CollectObject(old_cdr);
102
103        if (last)
104            last->cdr = p;
105        else
106            first = p;
107        last = p;
108    }
109    if (x)
110        last->cdr = CollectObject(x);
111    return first; // we already set the collection pointers
112}
113
114static LObject *CollectObject(LObject *x)
115{
116    LObject *ret = x;
117
118    if ((uint8_t *)x >= cstart && (uint8_t *)x < cend)
119    {
120        switch (item_type(x))
121        {
122        case L_BAD_CELL:
123            lbreak("error: collecting corrupted cell\n");
124            break;
125        case L_NUMBER:
126            ret = LNumber::Create(((LNumber *)x)->num);
127            break;
128        case L_SYS_FUNCTION:
129            ret = new_lisp_sys_function(((LSysFunction *)x)->min_args,
130                                        ((LSysFunction *)x)->max_args,
131                                        ((LSysFunction *)x)->fun_number);
132            break;
133        case L_USER_FUNCTION:
134        {
135            LUserFunction *fun = (LUserFunction *)x;
136            LList *arg = (LList *)CollectObject(fun->arg_list);
137            LList *block = (LList *)CollectObject(fun->block_list);
138            ret = new_lisp_user_function(arg, block);
139            break;
140        }
141        case L_STRING:
142            ret = LString::Create(lstring_value(x));
143            break;
144        case L_CHARACTER:
145            ret = LChar::Create(lcharacter_value(x));
146            break;
147        case L_C_FUNCTION:
148            ret = new_lisp_c_function(((LSysFunction *)x)->min_args,
149                                      ((LSysFunction *)x)->max_args,
150                                      ((LSysFunction *)x)->fun_number);
151            break;
152        case L_C_BOOL:
153            ret = new_lisp_c_bool(((LSysFunction *)x)->min_args,
154                                  ((LSysFunction *)x)->max_args,
155                                  ((LSysFunction *)x)->fun_number);
156            break;
157        case L_L_FUNCTION:
158            ret = new_user_lisp_function(((LSysFunction *)x)->min_args,
159                                         ((LSysFunction *)x)->max_args,
160                                         ((LSysFunction *)x)->fun_number);
161            break;
162        case L_POINTER:
163            ret = LPointer::Create(lpointer_value(x));
164            break;
165        case L_1D_ARRAY:
166            ret = CollectArray((LArray *)x);
167            break;
168        case L_FIXED_POINT:
169            ret = LFixedPoint::Create(lfixed_point_value(x));
170            break;
171        case L_CONS_CELL:
172            ret = CollectList((LList *)x);
173            break;
174        case L_OBJECT_VAR:
175            ret = LObjectVar::Create(((LObjectVar *)x)->index);
176            break;
177        case L_COLLECTED_OBJECT:
178            ret = ((LRedirect *)x)->ref;
179            break;
180        default:
181            lbreak("error: collecting bad object 0x%x\n", item_type(x));
182            break;
183        }
184        ((LRedirect *)x)->type = L_COLLECTED_OBJECT;
185        ((LRedirect *)x)->ref = ret;
186    }
187    else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
188    {
189        // Still need to remap cons_cells lying outside of space, for
190        // instance on the stack.
191        for (LObject *cell = NULL; x; cell = x, x = CDR(x))
192        {
193            if (item_type(x) != L_CONS_CELL)
194            {
195                if (cell)
196                    CDR(cell) = CollectObject(CDR(cell));
197                break;
198            }
199            CAR(x) = CollectObject(CAR(x));
200        }
201    }
202
203    return ret;
204}
205
206static void collect_symbols(LSymbol *root)
207{
208    if (!root)
209        return;
210
211    root->value = CollectObject(root->value);
212    root->function = CollectObject(root->function);
213    root->name = (LString *)CollectObject(root->name);
214    collect_symbols(root->left);
215    collect_symbols(root->right);
216}
217
218static void collect_stacks()
219{
220  long t = l_user_stack.son;
221
222  void **d = l_user_stack.sdata;
223  for (int i = 0; i < t; i++, d++)
224    *d = CollectObject((LObject *)*d);
225
226  t = PtrRef::stack.son;
227  void ***d2 = PtrRef::stack.sdata;
228  for (int i = 0; i < t; i++, d2++)
229  {
230    void **ptr = *d2;
231    *ptr = CollectObject((LObject *)*ptr);
232  }
233
234  d2 = reg_ptr_list;
235  for (size_t i = 0; i < reg_ptr_total; i++, d2++)
236  {
237    void **ptr = *d2;
238    *ptr = CollectObject((LObject *)*ptr);
239  }
240}
241
242void collect_space(int which_space, int grow) // should be tmp or permanent
243{
244  int old_space = current_space;
245  cstart = space[which_space];
246  cend = free_space[which_space];
247
248  space_size[GC_SPACE] = space_size[which_space];
249  if (grow)
250  {
251    space_size[GC_SPACE] += space_size[which_space] >> 1;
252    space_size[GC_SPACE] -= (space_size[GC_SPACE] & 7);
253  }
254  uint8_t *new_space = (uint8_t *)malloc(space_size[GC_SPACE]);
255  current_space = GC_SPACE;
256  free_space[GC_SPACE] = space[GC_SPACE] = new_space;
257
258  collected_start = new_space;
259  collected_end = new_space + space_size[GC_SPACE];
260
261  collect_symbols(LSymbol::root);
262  collect_stacks();
263
264  // for debuging clear it out
265  memset(space[which_space], 0, space_size[which_space]);
266  free(space[which_space]);
267
268  space[which_space] = new_space;
269  space_size[which_space] = space_size[GC_SPACE];
270  free_space[which_space] = new_space
271                          + (free_space[GC_SPACE] - space[GC_SPACE]);
272  current_space = old_space;
273}
274
Note: See TracBrowser for help on using the repository browser.