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

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

lisp: if the Lisp permanent space grows out of memory, grow the space
during GCs instead of dying.

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