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

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

lisp: properly manage user functions and reactivate garbage collector.

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