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

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

core: Get rid of mostly useless headers, move endianness handling to
common.h (and rewrite functions so that they do not need the SDL headers)
and move a few functions out of sdlport's video.cpp. These functions
were in the original video.cpp (which reappears) and shouldn't be part
of the SDL port.

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