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

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

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

File size: 6.8 KB
RevLine 
[56]1/*
2 *  Abuse - dark 2D side-scrolling platform game
3 *  Copyright (c) 1995 Crack dot Com
[494]4 *  Copyright (c) 2005-2011 Sam Hocevar <sam@hocevar.net>
[56]5 *
6 *  This software was released into the Public Domain. As with most public
[555]7 *  domain software, no warranty is made or implied by Crack dot Com, by
8 *  Jonathan Clark, or by Sam Hocevar.
[56]9 */
[2]10
[555]11#if defined HAVE_CONFIG_H
12#   include "config.h"
13#endif
[2]14
[56]15#include <stdlib.h>
16#include <string.h>
[2]17
[481]18#include "lisp.h"
[491]19#include "lisp_gc.h"
[2]20
[481]21#include "stack.h"
[2]22
[480]23/*  Lisp garbage collection: uses copy/free algorithm
24    Places to check:
[124]25      symbol
[56]26        values
[124]27    functions
28    names
[56]29      stack
30*/
[2]31
[75]32// Stack where user programs can push data and have it GCed
[561]33GrowStack<void> l_user_stack(150);
[558]34
[75]35// Stack of user pointers
[561]36GrowStack<void *> PtrRef::stack(1500);
[2]37
[558]38static size_t reg_ptr_total = 0;
39static void ***reg_ptr_list = NULL;
[2]40
[480]41static uint8_t *cstart, *cend, *collected_start, *collected_end;
42
[558]43LArray *LispGC::CollectArray(LArray *x)
[2]44{
[493]45    size_t s = x->len;
[492]46    LArray *a = LArray::Create(s, NULL);
47    LObject **src = x->GetData();
48    LObject **dst = a->GetData();
[491]49    for (size_t i = 0; i < s; i++)
50        dst[i] = CollectObject(src[i]);
[2]51
[483]52    return a;
[2]53}
54
[558]55LList *LispGC::CollectList(LList *x)
[2]56{
[492]57    LList *last = NULL, *first = NULL;
[2]58
[491]59    for (; x && item_type(x) == L_CONS_CELL; )
60    {
[492]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;
[493]67        ((LRedirect *)old_x)->ref = p;
[490]68
[491]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
[2]81}
82
[558]83LObject *LispGC::CollectObject(LObject *x)
[2]84{
[557]85    LObject *ret = x;
[2]86
[557]87    if ((uint8_t *)x >= cstart && (uint8_t *)x < cend)
[2]88    {
[557]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,
[492]123                                  ((LSysFunction *)x)->max_args,
124                                  ((LSysFunction *)x)->fun_number);
[557]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;
[2]155    }
[557]156    else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
[2]157    {
[557]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        }
[2]170    }
171
[557]172    return ret;
[2]173}
174
[558]175void LispGC::CollectSymbols(LSymbol *root)
[2]176{
[493]177    if (!root)
178        return;
179
[491]180    root->value = CollectObject(root->value);
181    root->function = CollectObject(root->function);
[492]182    root->name = (LString *)CollectObject(root->name);
[558]183    CollectSymbols(root->left);
184    CollectSymbols(root->right);
[2]185}
186
[558]187void LispGC::CollectStacks()
[2]188{
[558]189    void **d = l_user_stack.sdata;
[561]190    for (size_t i = 0; i < l_user_stack.m_size; i++, d++)
[558]191        *d = CollectObject((LObject *)*d);
[480]192
[558]193    void ***d2 = PtrRef::stack.sdata;
[561]194    for (size_t i = 0; i < PtrRef::stack.m_size; i++, d2++)
[558]195    {
196        void **ptr = *d2;
197        *ptr = CollectObject((LObject *)*ptr);
198    }
[2]199
[561]200    void ***d3 = reg_ptr_list;
201    for (size_t i = 0; i < reg_ptr_total; i++, d3++)
[558]202    {
[561]203        void **ptr = *d3;
[558]204        *ptr = CollectObject((LObject *)*ptr);
205    }
[2]206}
207
[558]208void LispGC::CollectSpace(int which_space, int grow)
[2]209{
[558]210    int old_space = current_space;
211    cstart = space[which_space];
212    cend = free_space[which_space];
[2]213
[558]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;
[2]223
[558]224    collected_start = new_space;
225    collected_end = new_space + space_size[GC_SPACE];
[2]226
[558]227    CollectSymbols(LSymbol::root);
228    CollectStacks();
[2]229
[558]230    // for debuging clear it out
231    memset(space[which_space], 0, space_size[which_space]);
232    free(space[which_space]);
[2]233
[558]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;
[2]239}
240
Note: See TracBrowser for help on using the repository browser.