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

Last change on this file since 561 was 561, checked in by Sam Hocevar, 10 years ago

lisp: fix a memory leak in the grow stack objets and refactor the class.

File size: 6.8 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
21#include "stack.h"
22
23/*  Lisp garbage collection: uses copy/free algorithm
24    Places to check:
25      symbol
26        values
27    functions
28    names
29      stack
30*/
31
32// Stack where user programs can push data and have it GCed
33GrowStack<void> l_user_stack(150);
34
35// Stack of user pointers
36GrowStack<void *> PtrRef::stack(1500);
37
38static size_t reg_ptr_total = 0;
39static void ***reg_ptr_list = NULL;
40
41static uint8_t *cstart, *cend, *collected_start, *collected_end;
42
43LArray *LispGC::CollectArray(LArray *x)
44{
45    size_t s = x->len;
46    LArray *a = LArray::Create(s, NULL);
47    LObject **src = x->GetData();
48    LObject **dst = a->GetData();
49    for (size_t i = 0; i < s; i++)
50        dst[i] = CollectObject(src[i]);
51
52    return a;
53}
54
55LList *LispGC::CollectList(LList *x)
56{
57    LList *last = NULL, *first = NULL;
58
59    for (; x && item_type(x) == L_CONS_CELL; )
60    {
61        LList *p = LList::Create();
62        LObject *old_car = x->car;
63        LObject *old_cdr = x->cdr;
64        LObject *old_x = x;
65        x = (LList *)CDR(x);
66        ((LRedirect *)old_x)->type = L_COLLECTED_OBJECT;
67        ((LRedirect *)old_x)->ref = p;
68
69        p->car = CollectObject(old_car);
70        p->cdr = CollectObject(old_cdr);
71
72        if (last)
73            last->cdr = p;
74        else
75            first = p;
76        last = p;
77    }
78    if (x)
79        last->cdr = CollectObject(x);
80    return first; // we already set the collection pointers
81}
82
83LObject *LispGC::CollectObject(LObject *x)
84{
85    LObject *ret = x;
86
87    if ((uint8_t *)x >= cstart && (uint8_t *)x < cend)
88    {
89        switch (item_type(x))
90        {
91        case L_BAD_CELL:
92            lbreak("error: collecting corrupted cell\n");
93            break;
94        case L_NUMBER:
95            ret = LNumber::Create(((LNumber *)x)->num);
96            break;
97        case L_SYS_FUNCTION:
98            ret = new_lisp_sys_function(((LSysFunction *)x)->min_args,
99                                        ((LSysFunction *)x)->max_args,
100                                        ((LSysFunction *)x)->fun_number);
101            break;
102        case L_USER_FUNCTION:
103        {
104            LUserFunction *fun = (LUserFunction *)x;
105            LList *arg = (LList *)CollectObject(fun->arg_list);
106            LList *block = (LList *)CollectObject(fun->block_list);
107            ret = new_lisp_user_function(arg, block);
108            break;
109        }
110        case L_STRING:
111            ret = LString::Create(lstring_value(x));
112            break;
113        case L_CHARACTER:
114            ret = LChar::Create(lcharacter_value(x));
115            break;
116        case L_C_FUNCTION:
117            ret = new_lisp_c_function(((LSysFunction *)x)->min_args,
118                                      ((LSysFunction *)x)->max_args,
119                                      ((LSysFunction *)x)->fun_number);
120            break;
121        case L_C_BOOL:
122            ret = new_lisp_c_bool(((LSysFunction *)x)->min_args,
123                                  ((LSysFunction *)x)->max_args,
124                                  ((LSysFunction *)x)->fun_number);
125            break;
126        case L_L_FUNCTION:
127            ret = new_user_lisp_function(((LSysFunction *)x)->min_args,
128                                         ((LSysFunction *)x)->max_args,
129                                         ((LSysFunction *)x)->fun_number);
130            break;
131        case L_POINTER:
132            ret = LPointer::Create(lpointer_value(x));
133            break;
134        case L_1D_ARRAY:
135            ret = CollectArray((LArray *)x);
136            break;
137        case L_FIXED_POINT:
138            ret = LFixedPoint::Create(lfixed_point_value(x));
139            break;
140        case L_CONS_CELL:
141            ret = CollectList((LList *)x);
142            break;
143        case L_OBJECT_VAR:
144            ret = LObjectVar::Create(((LObjectVar *)x)->index);
145            break;
146        case L_COLLECTED_OBJECT:
147            ret = ((LRedirect *)x)->ref;
148            break;
149        default:
150            lbreak("error: collecting bad object 0x%x\n", item_type(x));
151            break;
152        }
153        ((LRedirect *)x)->type = L_COLLECTED_OBJECT;
154        ((LRedirect *)x)->ref = ret;
155    }
156    else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
157    {
158        // Still need to remap cons_cells lying outside of space, for
159        // instance on the stack.
160        for (LObject *cell = NULL; x; cell = x, x = CDR(x))
161        {
162            if (item_type(x) != L_CONS_CELL)
163            {
164                if (cell)
165                    CDR(cell) = CollectObject(CDR(cell));
166                break;
167            }
168            CAR(x) = CollectObject(CAR(x));
169        }
170    }
171
172    return ret;
173}
174
175void LispGC::CollectSymbols(LSymbol *root)
176{
177    if (!root)
178        return;
179
180    root->value = CollectObject(root->value);
181    root->function = CollectObject(root->function);
182    root->name = (LString *)CollectObject(root->name);
183    CollectSymbols(root->left);
184    CollectSymbols(root->right);
185}
186
187void LispGC::CollectStacks()
188{
189    void **d = l_user_stack.sdata;
190    for (size_t i = 0; i < l_user_stack.m_size; i++, d++)
191        *d = CollectObject((LObject *)*d);
192
193    void ***d2 = PtrRef::stack.sdata;
194    for (size_t i = 0; i < PtrRef::stack.m_size; i++, d2++)
195    {
196        void **ptr = *d2;
197        *ptr = CollectObject((LObject *)*ptr);
198    }
199
200    void ***d3 = reg_ptr_list;
201    for (size_t i = 0; i < reg_ptr_total; i++, d3++)
202    {
203        void **ptr = *d3;
204        *ptr = CollectObject((LObject *)*ptr);
205    }
206}
207
208void LispGC::CollectSpace(int which_space, int grow)
209{
210    int old_space = current_space;
211    cstart = space[which_space];
212    cend = free_space[which_space];
213
214    space_size[GC_SPACE] = space_size[which_space];
215    if (grow)
216    {
217        space_size[GC_SPACE] += space_size[which_space] >> 1;
218        space_size[GC_SPACE] -= (space_size[GC_SPACE] & 7);
219    }
220    uint8_t *new_space = (uint8_t *)malloc(space_size[GC_SPACE]);
221    current_space = GC_SPACE;
222    free_space[GC_SPACE] = space[GC_SPACE] = new_space;
223
224    collected_start = new_space;
225    collected_end = new_space + space_size[GC_SPACE];
226
227    CollectSymbols(LSymbol::root);
228    CollectStacks();
229
230    // for debuging clear it out
231    memset(space[which_space], 0, space_size[which_space]);
232    free(space[which_space]);
233
234    space[which_space] = new_space;
235    space_size[which_space] = space_size[GC_SPACE];
236    free_space[which_space] = new_space
237                            + (free_space[GC_SPACE] - space[GC_SPACE]);
238    current_space = old_space;
239}
240
Note: See TracBrowser for help on using the repository browser.