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

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

lisp: merge the Lisp and LispGC classes and improve coding style.

File size: 6.7 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
[636]43LArray *Lisp::CollectArray(LArray *x)
[2]44{
[636]45    size_t s = x->m_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
[636]55LList *Lisp::CollectList(LList *x)
[2]56{
[630]57    LList *prev = NULL, *first = NULL;
[2]58
[491]59    for (; x && item_type(x) == L_CONS_CELL; )
60    {
[492]61        LList *p = LList::Create();
[636]62        LObject *old_car = x->m_car;
[492]63        LObject *old_x = x;
64        x = (LList *)CDR(x);
[636]65        ((LRedirect *)old_x)->m_type = L_COLLECTED_OBJECT;
66        ((LRedirect *)old_x)->m_ref = p;
[490]67
[636]68        p->m_car = CollectObject(old_car);
[491]69
[630]70        if (prev)
[636]71            prev->m_cdr = p;
[491]72        else
73            first = p;
[630]74        prev = p;
[491]75    }
76    if (x)
[636]77        prev->m_cdr = CollectObject(x);
[630]78
[491]79    return first; // we already set the collection pointers
[2]80}
81
[636]82LObject *Lisp::CollectObject(LObject *x)
[2]83{
[557]84    LObject *ret = x;
[2]85
[557]86    if ((uint8_t *)x >= cstart && (uint8_t *)x < cend)
[2]87    {
[557]88        switch (item_type(x))
89        {
90        case L_BAD_CELL:
91            lbreak("error: collecting corrupted cell\n");
92            break;
93        case L_NUMBER:
[636]94            ret = LNumber::Create(((LNumber *)x)->m_num);
[557]95            break;
96        case L_SYS_FUNCTION:
97            ret = new_lisp_sys_function(((LSysFunction *)x)->min_args,
98                                        ((LSysFunction *)x)->max_args,
99                                        ((LSysFunction *)x)->fun_number);
100            break;
101        case L_USER_FUNCTION:
102        {
103            LUserFunction *fun = (LUserFunction *)x;
104            LList *arg = (LList *)CollectObject(fun->arg_list);
105            LList *block = (LList *)CollectObject(fun->block_list);
106            ret = new_lisp_user_function(arg, block);
107            break;
108        }
109        case L_STRING:
110            ret = LString::Create(lstring_value(x));
111            break;
112        case L_CHARACTER:
[636]113            ret = LChar::Create(((LChar *)x)->m_ch);
[557]114            break;
115        case L_C_FUNCTION:
116            ret = new_lisp_c_function(((LSysFunction *)x)->min_args,
117                                      ((LSysFunction *)x)->max_args,
118                                      ((LSysFunction *)x)->fun_number);
119            break;
120        case L_C_BOOL:
121            ret = new_lisp_c_bool(((LSysFunction *)x)->min_args,
[492]122                                  ((LSysFunction *)x)->max_args,
123                                  ((LSysFunction *)x)->fun_number);
[557]124            break;
125        case L_L_FUNCTION:
126            ret = new_user_lisp_function(((LSysFunction *)x)->min_args,
127                                         ((LSysFunction *)x)->max_args,
128                                         ((LSysFunction *)x)->fun_number);
129            break;
130        case L_POINTER:
131            ret = LPointer::Create(lpointer_value(x));
132            break;
133        case L_1D_ARRAY:
134            ret = CollectArray((LArray *)x);
135            break;
136        case L_FIXED_POINT:
137            ret = LFixedPoint::Create(lfixed_point_value(x));
138            break;
139        case L_CONS_CELL:
140            ret = CollectList((LList *)x);
141            break;
142        case L_OBJECT_VAR:
[636]143            ret = LObjectVar::Create(((LObjectVar *)x)->m_index);
[557]144            break;
145        case L_COLLECTED_OBJECT:
[636]146            ret = ((LRedirect *)x)->m_ref;
[557]147            break;
148        default:
149            lbreak("error: collecting bad object 0x%x\n", item_type(x));
150            break;
151        }
[636]152        ((LRedirect *)x)->m_type = L_COLLECTED_OBJECT;
153        ((LRedirect *)x)->m_ref = ret;
[2]154    }
[557]155    else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
[2]156    {
[557]157        // Still need to remap cons_cells lying outside of space, for
158        // instance on the stack.
159        for (LObject *cell = NULL; x; cell = x, x = CDR(x))
160        {
161            if (item_type(x) != L_CONS_CELL)
162            {
163                if (cell)
164                    CDR(cell) = CollectObject(CDR(cell));
165                break;
166            }
167            CAR(x) = CollectObject(CAR(x));
168        }
[2]169    }
170
[557]171    return ret;
[2]172}
173
[636]174void Lisp::CollectSymbols(LSymbol *root)
[2]175{
[493]176    if (!root)
177        return;
178
[636]179    root->m_value = CollectObject(root->m_value);
180    root->m_function = CollectObject(root->m_function);
181    root->m_name = (LString *)CollectObject(root->m_name);
182    CollectSymbols(root->m_left);
183    CollectSymbols(root->m_right);
[2]184}
185
[636]186void Lisp::CollectStacks()
[2]187{
[558]188    void **d = l_user_stack.sdata;
[561]189    for (size_t i = 0; i < l_user_stack.m_size; i++, d++)
[558]190        *d = CollectObject((LObject *)*d);
[480]191
[558]192    void ***d2 = PtrRef::stack.sdata;
[561]193    for (size_t i = 0; i < PtrRef::stack.m_size; i++, d2++)
[558]194    {
195        void **ptr = *d2;
196        *ptr = CollectObject((LObject *)*ptr);
197    }
[2]198
[561]199    void ***d3 = reg_ptr_list;
200    for (size_t i = 0; i < reg_ptr_total; i++, d3++)
[558]201    {
[561]202        void **ptr = *d3;
[558]203        *ptr = CollectObject((LObject *)*ptr);
204    }
[2]205}
206
[636]207void Lisp::CollectSpace(LSpace *which_space, int grow)
[2]208{
[635]209    LSpace *old_space = LSpace::Current;
210    cstart = which_space->m_data;
211    cend = which_space->m_free;
[2]212
[635]213    LSpace::Gc.m_size = which_space->m_size;
[558]214    if (grow)
215    {
[635]216        LSpace::Gc.m_size += which_space->m_size >> 1;
217        LSpace::Gc.m_size -= (LSpace::Gc.m_size & 7);
[558]218    }
[635]219    uint8_t *new_data = (uint8_t *)malloc(LSpace::Gc.m_size);
220    LSpace::Current = &LSpace::Gc;
221    LSpace::Gc.m_free = LSpace::Gc.m_data = new_data;
[2]222
[635]223    collected_start = new_data;
224    collected_end = new_data + LSpace::Gc.m_size;
[2]225
[558]226    CollectSymbols(LSymbol::root);
227    CollectStacks();
[2]228
[558]229    // for debuging clear it out
[635]230    memset(which_space->m_data, 0, which_space->m_size);
231    free(which_space->m_data);
[2]232
[635]233    which_space->m_data = new_data;
234    which_space->m_size = LSpace::Gc.m_size;
235    which_space->m_free = new_data + (LSpace::Gc.m_free - LSpace::Gc.m_data);
236    LSpace::Current = old_space;
[2]237}
238
Note: See TracBrowser for help on using the repository browser.